> CPsrc  ! Program : CodePressor (% Purpose : Code compressor 2 Version : 0.03 < Requires : RISC OS FK Remark : The algorithm of looking back in a sliding dictionary PK on a per word basis and looking for equal nibbles was Z- created by Tony Haines. dJ The further compression of the markers and bit masks nJ as well as the runs of uncompressable words was done x by myself. B Author : Eli-Jean R. Leyssens, alias Pervect of Topix ! First version : 1 June 2000 ! Last update : 2 June 2000 * Copyright : Eli-Jean R. Leyssens   $;" at line ";:  /OutFile$=".CodePressr"  @fSize% = : Print required slotsize when assembly's done?  ErrorBufferSize% = 256 ACmdArgsSize% = 1024 : Size of output buffer for OS_ReadArgs  IBase% = &8100 : Hey, we want to be able to compress this program as ' well of course :) " Code% 1024*16 , Pass%=4 6 2 6O% = Code% @P% = Base% J link=14 T[OPT Pass% ^ h.KeywordDefinition% r equs "/A,/A" | equb 0 .errZeroFile & ErrorTemplate( "%0 is empty") .errNotAFile + ErrorTemplate( "%0 is not a file") .errNotExist , ErrorTemplate( "%0 does not exist")  ALIGN0 .errUntypedOnly _ ErrorTemplate( "Can only handle untyped files with a LOAD address of &8100 or higher")  ALIGN0 .errSlotSizeTooBig ; ErrorTemplate( "slotsizeandcheck only upto 8192K")   ALIGN0  .CodeStartsHere && ; r1 = command line parameters 0! mov r13, #StackSpace% :< adr r0, KeywordDefinition% ; Keyword definition D7 mov r2, #CmdArgs% ; Output buffer N? mov r3, #CmdArgsSize% ; Size of output buffer X swi "OS_ReadArgs" b l/ ; CmdArgs%!0 /points/ to the input file v0 ; CmdArgs%!4 /points/ to the output file   ;  ; Get input file info  ;  mov r0, #23 4 ldr r1, [ r2, #0*4] ; Input file 2 swi "OS_File" ; PRM 2-43 @ add r4, r4, #3 ; Make size word aligned 6 bics r4, r4, #3 ; Is it empty? B adreq r0, errZeroFile ; Yes, then generate error ) beq Error ;  8 cmp r0, #0 ; Does it exist? A adreq r0, errNotExist ; No, then generate error  ) beq Error ; 7 cmp r0, #1 ; Is it a file?  A adrne r0, errNotAFile ; No, then generate error *) bne Error ; 4@ cmn r6, #1 ; Is it an untyped file? >A adrne r0, errUntypedOnly ; No, then generate error H) bne Error ; RJ cmp r2, #&8100 ; Is the load address high enough? \A adrlt r0, errUntypedOnly ; No, then generate error f) blt Error ; p z ; Input file info  ;  ; r2 = load address  ; r3 = execution address  ; r4 = object length   ;  ; $ ; Build up uncompressed data  ;  ; & mov r5, #UncompressedData%  ; $ ; Start with the depack code  ; 0 sub r8, r2, #8 + DepackCodeSize% + 4 M mov r0, #24 ; Is the address to depack to MOVable? $( mov r6, #&ff ; ..CheckLoadMOV_Loop 8" bics r7, r8, r6, lsl r0 B! beq CheckLoadMOV_Done L subs r0, r0, #2 V! bge CheckLoadMOV_Loop `.CheckLoadMOV_Done j+ ; r0 = shift, or < 0 if not MOVable t cmp r0, #0 ~ ( ldrlt r0, DepackCodeMARKER_LDR 4 sublt r6, r2, #4 + 8 + DepackCodeSize% + 4 ( ldrlt r7, opLDR_R0_BaseAddress , ldrlt r8, opLDR_R0_BaseAddress + 4 & stmltia r5!, { r0, r6, r7, r8} 5 movlt r11, #8 ; Start offset   movge r7, r8, lsr r0  rsbgt r0, r0, #32 $ orrge r0, r7, r0, lsl #8-1  ldrge r7, opMOV_R0_num $ ldrge r8, opMOV_R0_num + 4  orrge r7, r7, r0  ( ldrge r0, DepackCodeMARKER_MOV " stmgeia r5!, { r0, r7, r8} 5 movge r11, #4 ; Start offset ( 2 adr r0, opDepackCode <$ mov r7, #DepackCodeSize% F.CopyDepackCode_Loop P ldr r8, [ r0], #4 Z str r8, [ r5], #4 d subs r7, r7, #4 n# bgt CopyDepackCode_Loop x G add r12, r2, r4 ; Load address of PACKED version   add r6, r12, r11 4 add r6, r6, #8 + DepackBranchOffset% + 8  sub r6, r3, r6  mov r6, r6, lsr #2  bic r6, r6, #&ff<<24  orr r8, r6, #&ea<<24 & mov r7, #UncompressedData%  add r7, r7, r11 3 str r8, [ r7, #8 + DepackBranchOffset%]   mov r9, r5 - ; r10 = address of original file data + ; r11 = start offset in packed code . ; r12 = load address of PACKED version " , ; 6" ; Append the original data @ ; J mov r0, #16 T ; r1 = input filename ^ mov r0, #0 h add r6, r9, r4 r str r0, [ r6, #-4] | mov r0, #16  mov r2, r9  mov r3, #0 1 swi "OS_File" ; PRM 2-40  E add r4, r4, #3 ; Make size word aligned again ( bic r4, r4, #3 ;   add r10, r9, r4  # ; r4 = original file length , ; r9 = address of original file data 5 ; r10 = address after last original file data + ; r11 = start offset in packed code . ; r12 = load address of PACKED version   ; & ; 0 ; Now, go pack the data! : ; D ; N X ; b7 ; First off, we'll do a fake compress, where we l3 ; only find out how well each word would be v ; compressed. 8 ; When this is done we can go look for sequences ! ; of uncompressable data.  ;  J mov r0, r9 ; Only compress original file data. K mov r8, r10 ; Store our fake compress data here. .FakeCompress_MainLoop ! bl FindBestInHistory  cmp r2, #6<<16 ) bgt FakeCompress_Uncompressed  sub r3, r0, r1  sub r3, r3, #4  mov r3, r3, lsr #2  tst r3, #&f0   moveq r5, #5  movne r5, #9   tst r2, #&f0 * addeq r5, r5, #5 4 addne r5, r5, #9 > mov r2, r2, lsr #16 H" add r5, r5, r2, lsl #2 R% b FakeCompress_MainNext \.FakeCompress_Uncompressed f mov r5, #41 p.FakeCompress_MainNext z str r5, [ r8], #4  add r0, r0, #4  subs r4, r4, #4 % bgt FakeCompress_MainLoop   ; I ; Scan the fake compressed data for runs of non compressable data  ; > mov r0, r10 ; Fake data starts here .FindRuns_MainLoop  ldr r1, [ r0], #4 F cmp r1, #36 ; Will this word do any damage? = blt FindRuns_MainNext ; Nope (or not enough) > cmp r0, r8 ; Is there a next word? @ bge FindRuns_MainNext ; No, then skip run check I ldr r1, [ r0], #4 ; Is the next word also "damaging" = cmp r1, #36 ; Nope (or not enough) $@ blt FindRuns_MainNext ; No, then skip run check . mov r2, #1 8 sub r3, r0, #8 B.FindRuns_SubLoop L5 cmp r0, r8 ; End of data? V: bge FindRuns_SubDone ; Yes, then end run `L ldr r1, [ r0], #4 ; Is this word compressable enough to j: cmp r1, #28 ; stop the run for? t: blt FindRuns_SubDone ; Yes, then end run ~; add r2, r2, #1 ; Increase run count B cmp r2, #255 ; Max = 256 (stored as 255) ( blt FindRuns_SubLoop ; .FindRuns_SubDone I rsb r2, r2, #0 ; Make negative, to indicate a run  str r2, [ r3] .FindRuns_MainNext  cmp r0, r8 ! blt FindRuns_MainLoop  ;  ; Compress it!!! ; = sub r5, r10, r9 ; Original data length 6 mov r0, r9 ; Original data ; mov r7, #0 ; Bit stream "cache" G mov r6, #0 ; Number of bits in stream cache (; stream is written to r8 2.ReallyCompress_MainLoop  blne InsertBits H movs r1, r1, lsl #4 R9 bne ReallyCompress_CompressedWord_NibblesLoop \ add r0, r0, #4 f.ReallyCompress_MainNext p subs r5, r5, #4 z' bgt ReallyCompress_MainLoop O cmp r6, #0 ; Any bits left in the bit stream cache? F movne r3, #0 ; Then flush out remaining bits ( rsbne r4, r6, #32 ; ( blne InsertBits ;  J ; ; ; Compressed stream at [r10 ... r8[  ; ;  ; Write to output file! ; ;  ? mov r0, #&83 ; Create the output file 8 mov r1, #CmdArgs% ; Output filename ( ldr r1, [ r1, #1*4] ; $1 swi "OS_Find" ; PRM 2-75 .3 mov r1, r0 ; Filehandle 8: mov r0, #2 ; Write depack code B( mov r2, #UncompressedData% ; L( sub r3, r9, r2 ; V1 swi "XOS_GBPB" ; PRM 2-65 `( bvs ErrorWhileWriting ; j> mov r2, r10 ; Write compressed code t( sub r3, r8, r10 ; ~1 swi "XOS_GBPB" ; PRM 2-65 ( bvs ErrorWhileWriting ; 3 mov r0, #0 ; Close file 1 swi "OS_Find" ; PRM 2-74   ; , ; Set load/execute addresses on file  ;  8 mov r1, #CmdArgs% ; Output filename ( ldr r1, [ r1, #1*4] ; 9 mov r0, #2 ; Set load address ( mov r2, r12 ; 1 swi "OS_File" ; PRM 2-34  < mov r0, #3 ; Set execute address ( add r3, r12, r11 ; 1 swi "OS_File" ; PRM 2-34 ( 29 swi "OS_Exit" ; Quit our program < F.ErrorWhileWriting P mov r2, r0 Z mov r0, #0 d swi "XOS_GBPB" n mov r0, r2 x" swi "OS_GenerateError"  .DepackCodeMARKER_LDR V equd ( &1ff << 23) ( 1 << 22) ( ( 3 + (DepackCodeSize% 4) - 1) << 14) .opLDR_R0_BaseAddress , ldr r0, opLDR_R0_BaseAddress - 4 0 adr r2, opLDR_R0_BaseAddress - 8 - 4 .DepackCodeMARKER_MOV V equd ( &1ff << 23) ( 1 << 22) ( ( 2 + (DepackCodeSize% 4) - 1) << 14) .opMOV_R0_num  mov r0, #0 ( adr r2, opMOV_R0_num - 4 - 4  .opDepackCode 9 ; Assumes r0 points to where everything should be  ; depacked to MINUS 4. 3 add r8, r2, #4 ; bit-stream "9 ldr r7, [ r8], #4 ; bit-stream cache ,I mov r9, #(18+1)<<27 ; number of bits left in cache + 1 6.DepackCode_MainLoop @ bl GetNiceByte J cmp r3, #&fe T' ldrlt r10, [ r0, -r3, lsl #2] ^ blne GetNiceByte h movle r11, #0 r movgt r11, r3 |#.DepackCode_DecompressWordsLoop  movge r10, #0  movlt r5, r3, lsl #24  movge r5, #255<<24  orr r5, r5, #1<<23 &.DepackCode_DecompressNibbles_Loop  movs r5, r5, lsl #1  blhi GetBits % eorhi r10, r10, r3, lsl #28 # movne r10, r10, ror #32-4 1 bne DepackCode_DecompressNibbles_Loop  str r10, [ r0, #4]!  subs r11, r11, #1 . bge DepackCode_DecompressWordsLoop  cmp r0, r2 # blt DepackCode_MainLoop  & mov r0, #0 0* swi "XOS_SynchroniseCodeAreas" :] D. DepackBranchOffset% = P% - opDepackCode N[OPT Pass% X equd &ea<<24 ; Branch b l.GetNiceByte v mov r6, link  mvn r4, #2 ; = -3  bl GetBits  mov r4, r3, lsl #2  mov link, r6  .GetBits  add r4, r4, #4  mov r3, #0 .GetBits_Loop  subs r9, r9, #1<<27  ldreq r7, [ r8], #4  movs r7, r7, lsl #1  adc r3, r3, r3  subs r4, r4, #1  bgt GetBits_Loop   movs pc, link   .opDepackCode_End *] 49 DepackCodeSize% = opDepackCode_End - opDepackCode >[OPT Pass% H R.FindBestInHistory \; On Entry f,; r0 = pointer to current word p; On Exit z; r0 preserved 5; r1 = pointer to best word (if r2 < 8) >; r2 = bits 16-23 number of nibbles not the same P; bits 0-7 is nibbles mask (per bit, 0 = same, 1 = different) + stmfd r13!, { r0, r3 - r12, link}  sub r3, r0, #254*4 & cmp r3, #UncompressedData% & movle r3, #UncompressedData%  addle r3, r3, #4  mov r2, #8<<16  ldr r4, [ r0] @ mov r10, r0 ; Remember start location .FindBestInHistory_MainLoop  ldr r5, [ r0, #-4]!  eor r5, r5, r4  mov r6, #&f<<28 = mov r7, #0 ; Non-matching nibbles $5 mov r8, #0 ; Nibbles mask ..FindBestInHistory_SubLoop 8 tst r5, r6 B addne r7, r7, #1 L mov r8, r8, lsl #1 V orrne r8, r8, #1 ` movs r6, r6, lsr #4 j) bne FindBestInHistory_SubLoop t6 cmp r7, r2, lsr #16 ; Better match? ~? orrlt r2, r8, r7, lsl #16 ; Yes, remember this one ( movlt r1, r0 ; . bne FindBestInHistory_MatchChecked  cmp r7, #8 . beq FindBestInHistory_MatchChecked K ; This one has just as many different nibbles as the currently best J ; one. However, this might still be a better one though, depending E ; on which nibbles. The location should not interfere though.  tst r8, #&f0 . bne FindBestInHistory_MatchChecked  tst r2, #&f0 . beq FindBestInHistory_MatchChecked K ; Right then, this new one has all the top nibbles match, while the $ ; currently best one hasn't.  J ; However, if current best location was < 16 away, and the current I ; one is >= 16 then it doesn't matter as for the current best the F ; location can be compressed (top 4 bits zero) and the new one ( ; can't. 2 sub r9, r10, r1 < cmp r9, #16*4 F6 bgt FindBestInHistory_BetterOneNonetheless P sub r9, r10, r0 Z cmp r9, #16*4 d. bgt FindBestInHistory_MatchChecked n+.FindBestInHistory_BetterOneNonetheless x: orr r2, r8, r7, lsl #16 ; Remember this one ( mov r1, r0 ; #.FindBestInHistory_MatchChecked   cmp r0, r3 * bgt FindBestInHistory_MainLoop  * ldmfd r13!, { r0, r3 - r12, pc}^  .InsertBits ; On Entry 8; r3 = data to be inserted (lower r4 bits) -; r4 = number of bits to insert "; r6 = bits in cache %; r7 = bit-stream cache -; r8 = the bit stream in memory ; On Exit " ; r3, r4 preserved ,"; r6, r7, r8 updated 6 ; Flags @; Preserved J; T0 stmfd r13!, { r0 - r5, r9 - r12, link} ^.InsertBits_Loop h movs r1, r3, lsr r4 r adc r7, r7, r7 | add r6, r6, #1  cmp r6, #32  streq r7, [ r8], #4 B ; don't need to clear cache, it clears itself by inserting  ; new bits...  moveq r6, #0  subs r4, r4, #1  bgt InsertBits_Loop / ldmfd r13!, { r0 - r5, r9 - r12, pc}^   .Error 9 ; r0 = 1 byte length, followed by template string  ; r1 = argument list 9 mov r3, r0 ; Template string C ldrb r4, [ r3], #1 ; Length of template string 7 orr r0, r1, #1<<31 ; Argument list B mov r1, #ErrorBuffer% ; Buffer for result string & mov r2, #0 0 str r2, [ r1], #4 :: mov r2, #ErrorBufferSize% ; Length of buffer D3 swi "OS_SubstituteArgs" ; PRM 1-463 N X! mov r0, #ErrorBuffer% b" swi "OS_GenerateError" l v.EndOfCode%  ; ?; Nothing from here on down is written to the executable!!! ; .pCompressedData%  ReserveMemory( 4)   MovePointers  ReserveMemory( 1024) .StackSpace%   MovePointers  .CmdArgs% % ReserveMemory( CmdArgsSize%)    MovePointers  .ErrorBuffer% *- ReserveMemory( 4 + ErrorBufferSize%) 4 > MovePointers H.UncompressedData% R] \ f p z fSize% E "Slotsize required " + ( ( P% - &8000 + 1023) 1024) + "K"   Wș "OS_File", 0, OutFile$, Base%, CodeStartsHere, Code%, EndOfCode% - Base% + Code%   :  FindShift( Value%) B Note that this will not find correctly things like &fc000003 5 but that's not what I wrote this one for, so...  MovIx%=24 9 ȕ ( ((&c0<= 0)  MovIx%-=2   MovIx% < 0 MovIx%=0  =MovIx% $: . Movify( Address%) 8" MovIx%=FindShift( Address%) B2 ( Address% ( &ff< Address% L- There were bits set below the shift V* Address%=Address% ( &ff<> ByteBit%) 1) << ( 7 - ByteBit%))  = ReversedByte%