� ** Text compression **
� C.R.Dewhurst 5/4/2000
�6:�23;8202;0;0;0;
(
input=&70
2output=&72
<
inptr=&74
Foutptr=&75
Pfrom=&76
Zmask=&78
doswrch=&FFEE
n:
x� pass=0 � 2 � 2
�P%=&900
�
[OPT pass
�
.compress
�
LDA #0
�
STA inptr
�STA outptr
�STA mask
�:
�.cloop LDY inptr
�LDA (input),Y
�CMP #13:BNE notend
�LDA #2:JMP wrtnib
�.notend STY inptr


INC inptr

 JSR chkcomm  \common letter?

BMI notcomm

"TYA:JSR wrtnib

,
JMP cloop

6'.notcomm JSR chkrare  \rare letter?

@BPL okay

JBRK

TEQUB &FF

^EQUS "Illegal chararacter"

hBRK

r.okay STY from

|3LDA #0:JSR wrtnib  \0=next nibble a rare letter

�LDA from:JSR wrtnib

�
JMP cloop

�:

�.chkcomm

�LDX #commtab � 256

�LDY #commtab � 256

�JMP scantab

�:

�.chkrare

�LDX #raretab � 256

�LDY #raretab � 256

�:

�.scantab
STX from
STY from+1
LDY #15
&.stloop CMP (from),Y
0
BEQ match
:DEY:BPL stloop
D
.match
N\so N=1=fail N=0=found
XRTS
b:
l.wrtnib
vLDY outptr
�LDX mask
�BEQ left
�INC mask  \now =0
��A (output),Y
�STA (output),Y
�INC outptr
�RTS
�.left ASLA:ASLA:ASLA:ASLA
�STA (output),Y
�DEC mask  \now =&FF
�RTS
�:
�.commtab
EQUW 0:BRK
 \0=next nibble a rare letter
\1=token
 \2=end of text
*\3-15=common letter:
4EQUS "etaonrishdlf "
>.raretab
HEQUS "cmugypwbvkxjqz,."
R:
\.expand
fLDA #0:STA mask
p
STA inptr
z
.eloop
�JSR getnib
�TAX:BNE notrar2
�JSR getnib
�LDX #raretab � 256
�LDY #raretab � 256
�
JSR print
�
JMP eloop
�.notrar2 DEX
�DEX
�BNE notend3
�RTS
�.notend3 LDX #commtab � 256
�LDY #commtab � 256

JSR print

JMP eloop
:
$
.print
.STX from:STY from+1
8TAY:LDA (from),Y
BJMP oswrch
L:
V.getnib
`
LDY inptr
jLDA (input),Y
tLDX mask
~
BNE right
�LSRA:LSRA:LSRA:LSRA
�	� #15
�DEC mask  \now =&FF
�RTS
�.right � #15
�INC mask  \now =0
�
INC inptr
�RTS
�]
��
� 
� � intext% &100,outtext% &100
$� �'"Type in some text",$intext%

oldlen%=� $intext%
!input=intext%
!output=outtext%
(� compress
2newlen%=?outptr
< �'"Original length:";oldlen%
F!�'"Compacted length:";newlen%
P6�'"Compaction factor:";100-newlen%/oldlen%*100;"%"
Z!input=outtext%
d� expand
�

00000000  0d 00 0a 1c f4 20 2a 2a  20 54 65 78 74 20 63 6f  |..... ** Text co|
00000010  6d 70 72 65 73 73 69 6f  6e 20 2a 2a 0d 00 14 1b  |mpression **....|
00000020  f4 20 43 2e 52 2e 44 65  77 68 75 72 73 74 20 35  |. C.R.Dewhurst 5|
00000030  2f 34 2f 32 30 30 30 0d  00 1e 16 eb 36 3a ef 32  |/4/2000.....6:.2|
00000040  33 3b 38 32 30 32 3b 30  3b 30 3b 30 3b 0d 00 28  |3;8202;0;0;0;..(|
00000050  0d 69 6e 70 75 74 3d 26  37 30 0d 00 32 0e 6f 75  |.input=&70..2.ou|
00000060  74 70 75 74 3d 26 37 32  0d 00 3c 0d 69 6e 70 74  |tput=&72..<.inpt|
00000070  72 3d 26 37 34 0d 00 46  0e 6f 75 74 70 74 72 3d  |r=&74..F.outptr=|
00000080  26 37 35 0d 00 50 0c 66  72 6f 6d 3d 26 37 36 0d  |&75..P.from=&76.|
00000090  00 5a 0c 6d 61 73 6b 3d  26 37 38 0d 00 64 10 6f  |.Z.mask=&78..d.o|
000000a0  73 77 72 63 68 3d 26 46  46 45 45 0d 00 6e 05 3a  |swrch=&FFEE..n.:|
000000b0  0d 00 78 14 e3 20 70 61  73 73 3d 30 20 b8 20 32  |..x.. pass=0 . 2|
000000c0  20 88 20 32 0d 00 82 0b  50 25 3d 26 39 30 30 0d  | . 2....P%=&900.|
000000d0  00 8c 0d 5b 4f 50 54 20  70 61 73 73 0d 00 96 0d  |...[OPT pass....|
000000e0  2e 63 6f 6d 70 72 65 73  73 0d 00 a0 0a 4c 44 41  |.compress....LDA|
000000f0  20 23 30 0d 00 aa 0d 53  54 41 20 69 6e 70 74 72  | #0....STA inptr|
00000100  0d 00 b4 0e 53 54 41 20  6f 75 74 70 74 72 0d 00  |....STA outptr..|
00000110  be 0c 53 54 41 20 6d 61  73 6b 0d 00 c8 05 3a 0d  |..STA mask....:.|
00000120  00 d2 14 2e 63 6c 6f 6f  70 20 4c 44 59 20 69 6e  |....cloop LDY in|
00000130  70 74 72 0d 00 dc 11 4c  44 41 20 28 69 6e 70 75  |ptr....LDA (inpu|
00000140  74 29 2c 59 0d 00 e6 16  43 4d 50 20 23 31 33 3a  |t),Y....CMP #13:|
00000150  42 4e 45 20 6e 6f 74 65  6e 64 0d 00 f0 15 4c 44  |BNE notend....LD|
00000160  41 20 23 32 3a 4a 4d 50  20 77 72 74 6e 69 62 0d  |A #2:JMP wrtnib.|
00000170  00 fa 15 2e 6e 6f 74 65  6e 64 20 53 54 59 20 69  |....notend STY i|
00000180  6e 70 74 72 0d 01 04 0d  49 4e 43 20 69 6e 70 74  |nptr....INC inpt|
00000190  72 0d 01 0e 20 4a 53 52  20 63 68 6b 63 6f 6d 6d  |r... JSR chkcomm|
000001a0  20 20 5c 63 6f 6d 6d 6f  6e 20 6c 65 74 74 65 72  |  \common letter|
000001b0  3f 0d 01 18 0f 42 4d 49  20 6e 6f 74 63 6f 6d 6d  |?....BMI notcomm|
000001c0  0d 01 22 12 54 59 41 3a  4a 53 52 20 77 72 74 6e  |..".TYA:JSR wrtn|
000001d0  69 62 0d 01 2c 0d 4a 4d  50 20 63 6c 6f 6f 70 0d  |ib..,.JMP cloop.|
000001e0  01 36 27 2e 6e 6f 74 63  6f 6d 6d 20 4a 53 52 20  |.6'.notcomm JSR |
000001f0  63 68 6b 72 61 72 65 20  20 5c 72 61 72 65 20 6c  |chkrare  \rare l|
00000200  65 74 74 65 72 3f 0d 01  40 0c 42 50 4c 20 6f 6b  |etter?..@.BPL ok|
00000210  61 79 0d 01 4a 07 42 52  4b 0d 01 54 0c 45 51 55  |ay..J.BRK..T.EQU|
00000220  42 20 26 46 46 0d 01 5e  1e 45 51 55 53 20 22 49  |B &FF..^.EQUS "I|
00000230  6c 6c 65 67 61 6c 20 63  68 61 72 61 72 61 63 74  |llegal chararact|
00000240  65 72 22 0d 01 68 07 42  52 4b 0d 01 72 12 2e 6f  |er"..h.BRK..r..o|
00000250  6b 61 79 20 53 54 59 20  66 72 6f 6d 0d 01 7c 33  |kay STY from..|3|
00000260  4c 44 41 20 23 30 3a 4a  53 52 20 77 72 74 6e 69  |LDA #0:JSR wrtni|
00000270  62 20 20 5c 30 3d 6e 65  78 74 20 6e 69 62 62 6c  |b  \0=next nibbl|
00000280  65 20 61 20 72 61 72 65  20 6c 65 74 74 65 72 0d  |e a rare letter.|
00000290  01 86 17 4c 44 41 20 66  72 6f 6d 3a 4a 53 52 20  |...LDA from:JSR |
000002a0  77 72 74 6e 69 62 0d 01  90 0d 4a 4d 50 20 63 6c  |wrtnib....JMP cl|
000002b0  6f 6f 70 0d 01 9a 05 3a  0d 01 a4 0c 2e 63 68 6b  |oop....:.....chk|
000002c0  63 6f 6d 6d 0d 01 ae 16  4c 44 58 20 23 63 6f 6d  |comm....LDX #com|
000002d0  6d 74 61 62 20 83 20 32  35 36 0d 01 b8 16 4c 44  |mtab . 256....LD|
000002e0  59 20 23 63 6f 6d 6d 74  61 62 20 81 20 32 35 36  |Y #commtab . 256|
000002f0  0d 01 c2 0f 4a 4d 50 20  73 63 61 6e 74 61 62 0d  |....JMP scantab.|
00000300  01 cc 05 3a 0d 01 d6 0c  2e 63 68 6b 72 61 72 65  |...:.....chkrare|
00000310  0d 01 e0 16 4c 44 58 20  23 72 61 72 65 74 61 62  |....LDX #raretab|
00000320  20 83 20 32 35 36 0d 01  ea 16 4c 44 59 20 23 72  | . 256....LDY #r|
00000330  61 72 65 74 61 62 20 81  20 32 35 36 0d 01 f4 05  |aretab . 256....|
00000340  3a 0d 01 fe 0c 2e 73 63  61 6e 74 61 62 0d 02 08  |:.....scantab...|
00000350  0c 53 54 58 20 66 72 6f  6d 0d 02 12 0e 53 54 59  |.STX from....STY|
00000360  20 66 72 6f 6d 2b 31 0d  02 1c 0b 4c 44 59 20 23  | from+1....LDY #|
00000370  31 35 0d 02 26 18 2e 73  74 6c 6f 6f 70 20 43 4d  |15..&..stloop CM|
00000380  50 20 28 66 72 6f 6d 29  2c 59 0d 02 30 0d 42 45  |P (from),Y..0.BE|
00000390  51 20 6d 61 74 63 68 0d  02 3a 12 44 45 59 3a 42  |Q match..:.DEY:B|
000003a0  50 4c 20 73 74 6c 6f 6f  70 0d 02 44 0a 2e 6d 61  |PL stloop..D..ma|
000003b0  74 63 68 0d 02 4e 1a 5c  73 6f 20 4e 3d 31 3d 66  |tch..N.\so N=1=f|
000003c0  61 69 6c 20 4e 3d 30 3d  66 6f 75 6e 64 0d 02 58  |ail N=0=found..X|
000003d0  07 52 54 53 0d 02 62 05  3a 0d 02 6c 0b 2e 77 72  |.RTS..b.:..l..wr|
000003e0  74 6e 69 62 0d 02 76 0e  4c 44 59 20 6f 75 74 70  |tnib..v.LDY outp|
000003f0  74 72 0d 02 80 0c 4c 44  58 20 6d 61 73 6b 0d 02  |tr....LDX mask..|
00000400  8a 0c 42 45 51 20 6c 65  66 74 0d 02 94 15 49 4e  |..BEQ left....IN|
00000410  43 20 6d 61 73 6b 20 20  5c 6e 6f 77 20 3d 30 0d  |C mask  \now =0.|
00000420  02 9e 11 84 41 20 28 6f  75 74 70 75 74 29 2c 59  |....A (output),Y|
00000430  0d 02 a8 12 53 54 41 20  28 6f 75 74 70 75 74 29  |....STA (output)|
00000440  2c 59 0d 02 b2 0e 49 4e  43 20 6f 75 74 70 74 72  |,Y....INC outptr|
00000450  0d 02 bc 07 52 54 53 0d  02 c6 1d 2e 6c 65 66 74  |....RTS.....left|
00000460  20 41 53 4c 41 3a 41 53  4c 41 3a 41 53 4c 41 3a  | ASLA:ASLA:ASLA:|
00000470  41 53 4c 41 0d 02 d0 12  53 54 41 20 28 6f 75 74  |ASLA....STA (out|
00000480  70 75 74 29 2c 59 0d 02  da 17 44 45 43 20 6d 61  |put),Y....DEC ma|
00000490  73 6b 20 20 5c 6e 6f 77  20 3d 26 46 46 0d 02 e4  |sk  \now =&FF...|
000004a0  07 52 54 53 0d 02 ee 05  3a 0d 02 f8 0c 2e 63 6f  |.RTS....:.....co|
000004b0  6d 6d 74 61 62 0d 03 02  0e 45 51 55 57 20 30 3a  |mmtab....EQUW 0:|
000004c0  42 52 4b 0d 03 0c 20 5c  30 3d 6e 65 78 74 20 6e  |BRK... \0=next n|
000004d0  69 62 62 6c 65 20 61 20  72 61 72 65 20 6c 65 74  |ibble a rare let|
000004e0  74 65 72 0d 03 16 0c 5c  31 3d 74 6f 6b 65 6e 0d  |ter....\1=token.|
000004f0  03 20 12 5c 32 3d 65 6e  64 20 6f 66 20 74 65 78  |. .\2=end of tex|
00000500  74 0d 03 2a 18 5c 33 2d  31 35 3d 63 6f 6d 6d 6f  |t..*.\3-15=commo|
00000510  6e 20 6c 65 74 74 65 72  3a 0d 03 34 18 45 51 55  |n letter:..4.EQU|
00000520  53 20 22 65 74 61 6f 6e  72 69 73 68 64 6c 66 20  |S "etaonrishdlf |
00000530  22 0d 03 3e 0c 2e 72 61  72 65 74 61 62 0d 03 48  |"..>..raretab..H|
00000540  1b 45 51 55 53 20 22 63  6d 75 67 79 70 77 62 76  |.EQUS "cmugypwbv|
00000550  6b 78 6a 71 7a 2c 2e 22  0d 03 52 05 3a 0d 03 5c  |kxjqz,."..R.:..\|
00000560  0b 2e 65 78 70 61 6e 64  0d 03 66 13 4c 44 41 20  |..expand..f.LDA |
00000570  23 30 3a 53 54 41 20 6d  61 73 6b 0d 03 70 0d 53  |#0:STA mask..p.S|
00000580  54 41 20 69 6e 70 74 72  0d 03 7a 0a 2e 65 6c 6f  |TA inptr..z..elo|
00000590  6f 70 0d 03 84 0e 4a 53  52 20 67 65 74 6e 69 62  |op....JSR getnib|
000005a0  0d 03 8e 13 54 41 58 3a  42 4e 45 20 6e 6f 74 72  |....TAX:BNE notr|
000005b0  61 72 32 0d 03 98 0e 4a  53 52 20 67 65 74 6e 69  |ar2....JSR getni|
000005c0  62 0d 03 a2 16 4c 44 58  20 23 72 61 72 65 74 61  |b....LDX #rareta|
000005d0  62 20 83 20 32 35 36 0d  03 ac 16 4c 44 59 20 23  |b . 256....LDY #|
000005e0  72 61 72 65 74 61 62 20  81 20 32 35 36 0d 03 b6  |raretab . 256...|
000005f0  0d 4a 53 52 20 70 72 69  6e 74 0d 03 c0 0d 4a 4d  |.JSR print....JM|
00000600  50 20 65 6c 6f 6f 70 0d  03 ca 10 2e 6e 6f 74 72  |P eloop.....notr|
00000610  61 72 32 20 44 45 58 0d  03 d4 07 44 45 58 0d 03  |ar2 DEX....DEX..|
00000620  de 0f 42 4e 45 20 6e 6f  74 65 6e 64 33 0d 03 e8  |..BNE notend3...|
00000630  07 52 54 53 0d 03 f2 1f  2e 6e 6f 74 65 6e 64 33  |.RTS.....notend3|
00000640  20 4c 44 58 20 23 63 6f  6d 6d 74 61 62 20 83 20  | LDX #commtab . |
00000650  32 35 36 0d 03 fc 16 4c  44 59 20 23 63 6f 6d 6d  |256....LDY #comm|
00000660  74 61 62 20 81 20 32 35  36 0d 04 06 0d 4a 53 52  |tab . 256....JSR|
00000670  20 70 72 69 6e 74 0d 04  10 0d 4a 4d 50 20 65 6c  | print....JMP el|
00000680  6f 6f 70 0d 04 1a 05 3a  0d 04 24 0a 2e 70 72 69  |oop....:..$..pri|
00000690  6e 74 0d 04 2e 17 53 54  58 20 66 72 6f 6d 3a 53  |nt....STX from:S|
000006a0  54 59 20 66 72 6f 6d 2b  31 0d 04 38 14 54 41 59  |TY from+1..8.TAY|
000006b0  3a 4c 44 41 20 28 66 72  6f 6d 29 2c 59 0d 04 42  |:LDA (from),Y..B|
000006c0  0e 4a 4d 50 20 6f 73 77  72 63 68 0d 04 4c 05 3a  |.JMP oswrch..L.:|
000006d0  0d 04 56 0b 2e 67 65 74  6e 69 62 0d 04 60 0d 4c  |..V..getnib..`.L|
000006e0  44 59 20 69 6e 70 74 72  0d 04 6a 11 4c 44 41 20  |DY inptr..j.LDA |
000006f0  28 69 6e 70 75 74 29 2c  59 0d 04 74 0c 4c 44 58  |(input),Y..t.LDX|
00000700  20 6d 61 73 6b 0d 04 7e  0d 42 4e 45 20 72 69 67  | mask..~.BNE rig|
00000710  68 74 0d 04 88 17 4c 53  52 41 3a 4c 53 52 41 3a  |ht....LSRA:LSRA:|
00000720  4c 53 52 41 3a 4c 53 52  41 0d 04 92 09 80 20 23  |LSRA:LSRA..... #|
00000730  31 35 0d 04 9c 17 44 45  43 20 6d 61 73 6b 20 20  |15....DEC mask  |
00000740  5c 6e 6f 77 20 3d 26 46  46 0d 04 a6 07 52 54 53  |\now =&FF....RTS|
00000750  0d 04 b0 10 2e 72 69 67  68 74 20 80 20 23 31 35  |.....right . #15|
00000760  0d 04 ba 15 49 4e 43 20  6d 61 73 6b 20 20 5c 6e  |....INC mask  \n|
00000770  6f 77 20 3d 30 0d 04 c4  0d 49 4e 43 20 69 6e 70  |ow =0....INC inp|
00000780  74 72 0d 04 ce 07 52 54  53 0d 04 d8 05 5d 0d 04  |tr....RTS....]..|
00000790  e2 05 ed 0d 04 ec 05 20  0d 04 f6 20 de 20 69 6e  |....... ... . in|
000007a0  74 65 78 74 25 20 26 31  30 30 2c 6f 75 74 74 65  |text% &100,outte|
000007b0  78 74 25 20 26 31 30 30  0d 05 00 24 e8 20 86 27  |xt% &100...$. .'|
000007c0  22 54 79 70 65 20 69 6e  20 73 6f 6d 65 20 74 65  |"Type in some te|
000007d0  78 74 22 2c 24 69 6e 74  65 78 74 25 0d 05 0a 16  |xt",$intext%....|
000007e0  6f 6c 64 6c 65 6e 25 3d  a9 20 24 69 6e 74 65 78  |oldlen%=. $intex|
000007f0  74 25 0d 05 14 12 21 69  6e 70 75 74 3d 69 6e 74  |t%....!input=int|
00000800  65 78 74 25 0d 05 1e 14  21 6f 75 74 70 75 74 3d  |ext%....!output=|
00000810  6f 75 74 74 65 78 74 25  0d 05 28 0e d6 20 63 6f  |outtext%..(.. co|
00000820  6d 70 72 65 73 73 0d 05  32 13 6e 65 77 6c 65 6e  |mpress..2.newlen|
00000830  25 3d 3f 6f 75 74 70 74  72 0d 05 3c 20 f1 27 22  |%=?outptr..< .'"|
00000840  4f 72 69 67 69 6e 61 6c  20 6c 65 6e 67 74 68 3a  |Original length:|
00000850  22 3b 6f 6c 64 6c 65 6e  25 0d 05 46 21 f1 27 22  |";oldlen%..F!.'"|
00000860  43 6f 6d 70 61 63 74 65  64 20 6c 65 6e 67 74 68  |Compacted length|
00000870  3a 22 3b 6e 65 77 6c 65  6e 25 0d 05 50 36 f1 27  |:";newlen%..P6.'|
00000880  22 43 6f 6d 70 61 63 74  69 6f 6e 20 66 61 63 74  |"Compaction fact|
00000890  6f 72 3a 22 3b 31 30 30  2d 6e 65 77 6c 65 6e 25  |or:";100-newlen%|
000008a0  2f 6f 6c 64 6c 65 6e 25  2a 31 30 30 3b 22 25 22  |/oldlen%*100;"%"|
000008b0  0d 05 5a 13 21 69 6e 70  75 74 3d 6f 75 74 74 65  |..Z.!input=outte|
000008c0  78 74 25 0d 05 64 0c d6  20 65 78 70 61 6e 64 0d  |xt%..d.. expand.|
000008d0  ff                                                |.|
000008d1