10 REM SAVE"HUFF.SRC"
20 SYS700
30 *=49152
40 .OPT OO
50 FSTAT = $90; FILE STATUS
100 GETIN = $FFE4
101 CHKIN = $FFC6
102 CHRIN = $FFCF
103 CLRCHN = $FFCC
104 CLOSE = $FFC3
105 CHKOUT = $FFC9
106 CHROUT = $FFD2
149 BB = $C500
150 CFREQLO = BB+0;  CHARACTERS' FREQUENCY
151 CFREQHI = BB+$100
152 CCODE = BB+$200; CODE (00=0, FF=1)
153 CPNODE = BB+$300;  PARENT NODE
154 NFREQLO = BB+$400;  NODES' FREQ
155 NFREQHI = BB+$500
156 NCODE = BB+$600; CODE
157 NPNODE = BB+$700; PARENT (0=TOP)
158 LIST = BB+$800;  SORTED LIST
159 TYPE = BB+$900;  TYPE 00=CHAR, FF=NODE
160 HBITS = BB+$A00;  MY OWN STACK
170 CH0TYPE = BB+0;  REUSED VARIABLE SPACE--CHILD 0 TYPE
172 CH0NAME = BB+$100;  CHILD 0 NAME
174 CH1TYPE = BB+$200
176 CH1NAME = BB+$300
200 JMP EPASS1; ENCODE PASS ONE
210 JMP EPASS2; ENCODE PASS TWO
220 JMP DECODE; DECODE
230 ;
250 EPASS1 = *
260 LDX #2:JSR CHKIN;  OPEN CHANNEL 2 FOR INPUT
265 JSR ZEROMEM;  ZERO OUT MEMORY
270 JSR COUNTEM;  COUNT THE BYTES
272 LDA #2:JSR CLOSE:JSR CLRCHN;  CLOSE UP CHANNEL 2
275 JSR SORTEM;  SORT THE LIST
280 JSR MAKETREE;  BUILD THE TREE
285 JSR NODE0;  THE TIP OF THE TREE
290 RTS
299 ;
300 ZEROMEM = *
310 LDA #0:TAY
320 ZELOOP STA CFREQLO,Y
321 STA CFREQHI,Y
322 STA CCODE,Y
323 STA CPNODE,Y
324 STA NCODE,Y
325 STA TYPE,Y
326 STA LIST,Y
327 DEY:BNE ZELOOP
330 STA FILELEN:STA FILELEN+1:STA NUMCHAR:STA NUMNODE
335 INC NUMNODE;  SAVE NODE 0 FOR THE TOP
340 RTS
349 ;
350 COUNTEM = *
360 JSR CHRIN;  GET A CHARACTER FROM DISK
364 TAX;  INDEX BY .X
366 INC CFREQLO,X;  ONE MORE IN THAT SLOT
368 BNE BYTECOUNT:INC CFREQHI,X;  IF 0, THEN INC THE HIGH BYTE
370 BYTECOUNT INC FILELEN:BNE COTEST:INC FILELEN+1
380 COTEST LDY FSTAT; FILE STATUS (0 = MORE TO COME)
382 BEQ COUNTEM;  (null) BACK FOR MORE BYTES
383 LDX FILELEN:LDA FILELEN+1:JSR $BDCD:LDA #62:JSR CHROUT; PRINT LENGTH, >
384 RTS;
399 ;
400 SORTEM = *
410 LDY #0
412 STY LISTLEN;  USED BY THE ISORT ROUTINE
413 STY LC
415 SOLOOP LDY LC:LDA CFREQLO,Y:ORA CFREQHI,Y;  CHECK IF FREQ <> 0
416 BEQ NOCHAR;  IF EQ, THEN NO CHARACTERS
418 TYA;  ADD IT TO THE LIST
420 LDY NUMCHAR:STA LIST,Y;  THIS IS THE ASCII CODE
422 INC NUMCHAR;  ONE MORE CHARACTER
424 JSR ISORT;  INSERTION SORT
426 INC LISTLEN;  THE LIST HAS ONE MORE MEMBER
428 NOCHAR INC LC:BNE SOLOOP;  KEEP (null)ING WITH LC 0 TO 255
430 RTS
440 ISORT = *
450 LDY LISTLEN;  LENGTH OF THE LIST
452 BNE IS01;
454 RTS;  IF = 0, SKIP THIS
456 IS01 LDA LIST,Y:STA ISLIST:TAX:LDA TYPE,Y:STA ISTYPE;  SAVE THESE VALUES
458 BNE ANODE;  IF <>0, IT'S A NODE
460 LDA CFREQLO,X:STA ISLO:LDA CFREQHI,X:STA ISHI; SAVE FREQUENCIES
462 JMP IS02;  (null) COMPARE THEM
464 ANODE LDA NFREQLO,X:STA ISLO:LDA NFREQHI,X:STA ISHI; SAVE FREQUENCIES
466 IS02 = *
468 DEY;  COUNT BACKWARD IN THE LIST
470 LDX LIST,Y:LDA TYPE,Y
472 BNE ANODE2;  ANOTHER NODE
474 LDA CFREQLO,X:STA TESTLO:LDA CFREQHI,X:STA TESTHI:JMP IS03
476 ANODE2 LDA NFREQLO,X:STA TESTLO:LDA NFREQHI,X:STA TESTHI
478 IS03 = *
480 LDA ISHI:CMP TESTHI;  COMPARE
482 BCC INSERT;  INSERT IN THE LIST HERE
484 BNE IS04;  KEEP LOOPING, MAYBE
486 LDA ISLO:CMP TESTLO;  NOT SURE, SO CHECK LOW BYTE
488 BEQ INSERT;  IF EQUAL, INSERT
490 BCC INSERT;  IF ISLO < TESTLO, INSERT
492 ;  ELSE DROP THROUGH
494 IS04 CPY #0:BNE IS02;  IF .Y = 0, DROP THROUGH TO INSERT
496 DEY
498 INSERT = *
500 INY:STY TEMPY;  SAVE THE VALUE
501 CPY LISTLEN:BNE DOIT:RTS
502 DOIT LDY LISTLEN;  START AT THE END
504 ISLOOP DEY:LDA LIST,Y:INY:STA LIST,Y:DEY
506 LDA TYPE,Y:INY:STA TYPE,Y:DEY
508 CPY TEMPY:BNE ISLOOP
510 LDA ISLIST:STA LIST,Y:LDA ISTYPE:STA TYPE,Y
512 RTS
549 ;
550 MAKETREE = *
560 LDX NUMCHAR:DEX:STX LISTLEN
565 MAMAIN LDY LISTLEN
570 JSR FIXCN;  FIX THE CODES & NODES FOR Y AND Y-1
572 JSR FIXFREQ;  FIX THE NEW NODE'S FREQUENCY
574 JSR ADDNODE;  ADD THE NODE TO THE LIST
576 JSR ISORT;  SORT IT
578 INC NUMNODE
580 LDA LISTLEN:CMP #1:BNE MAMAIN;  QUIT WHEN ONLY TWO NODES REMAIN
582 RTS
584 FIXCN = *
586 LDY LISTLEN
588 LDA #$FF;  THIS MEANS CODE = 1
590 JSR FIXSR;  SET THE CODE/NODE
591 DEY:LDA #0:JSR FIXSR; CODE = 0 ON THE LEFT
592 RTS
600 FIXSR LDX TYPE,Y:BEQ TSACHAR;  ITSA CHAR
601 LDX LIST,Y
602 STA NCODE,X;  IT'S A NODE
604 LDA NUMNODE:STA NPNODE,X:RTS
606 TSACHAR LDX LIST,Y:STA CCODE,X:LDA NUMNODE:STA CPNODE,X:RTS
620 FIXFREQ = *
630 LDY LISTLEN
632 LDX TYPE,Y:BEQ ANOTCHAR;  ANOTHER CHAR
634 LDX LIST,Y:LDA NFREQLO,X:STA LOW1:LDA NFREQHI,X:STA HI1
636 JMP AHEAD
638 ANOTCHAR LDX LIST,Y:LDA CFREQLO,X:STA LOW1:LDA CFREQHI,X:STA HI1
640 AHEAD DEY:LDX TYPE,Y:BEQ ITSCHAR;  ANOTHER CHAR
642 LDX LIST,Y:LDA NFREQLO,X:STA LOW2:LDA NFREQHI,X:STA HI2
644 JMP ADDEM
646 ITSCHAR LDX LIST,Y:LDA CFREQLO,X:STA LOW2:LDA CFREQHI,X:STA HI2
648 ADDEM LDX NUMNODE:CLC:LDA LOW1:ADC LOW2:STA NFREQLO,X
650 LDA HI1:ADC HI2:STA NFREQHI,X
652 RTS
654 ;
670 ADDNODE = *
672 DEC LISTLEN
674 LDX LISTLEN:LDA #$FF:STA TYPE,X;  TYPE OF A PARENT IS ALWAYS A NODE
676 LDA NUMNODE:STA LIST,X;  ADD THE NODE NUMBER TO THE LIST
678 RTS
699 ;
700 NODE0 = *
710 LDY #1
712 LDX LIST,Y
714 LDA #$FF:STA NCODE,X
716 LDA #0:STA NPNODE,X;  THE PARENT IS NODE 0 AT THE TOP
718 DEY:LDX LIST,Y
720 STA NCODE,X:STA NPNODE,X
722 RTS
799 ;
800 EPASS2 = *
812 LDX #4:JSR CHKOUT;  CHANNEL 4 FOR WRITING
814 LDA #0:STA OUTLEN:STA OUTLEN+1;  ZERO OUT FILE LENGTH
816 JSR HEADER;  SEND THE HEADER BYTES
818 JSR ENCFILE;  SEND THE ENCODED FILE
820 LDA #4:JSR CLOSE:LDA #3:JSR CLOSE
822 JSR CLRCHN
824 LDX OUTLEN:LDA OUTLEN+1:JSR $BDCD;  PRINT CRUNCHED LENGTH
826 RTS
828 ;
840 HEADER = *
850 LDA FILELEN:JSR CHROUT:LDA FILELEN+1:JSR CHROUT;  LENGTH OF INPUT FILE
852 LDY #0:LDX #0
854 CHAR0 LDA CFREQLO,X:ORA CFREQHI,X;  IS THIS CHAR IN FILE
855 BEQ HEAD0;  IF NO FREQ, DOESN'T EXIST
856 LDA CCODE,X:BNE HEAD0;  IGNORE $FF
857 TXA:STA HBITS,Y:INY;  PUSH ON TEMP STACK
858 HEAD0 INX:BNE CHAR0
859 TYA:PHA:JSR CHROUT:JSR SENDCHAR;  SEND # OF 0CHILDREN AND THEN NAMES
860 ;
862 LDY #0:LDX #0
866 CHAR1 LDA CCODE,X:BEQ HEAD1;  IGNORE $00
867 TXA:STA HBITS,Y:INY;  PUSH ON TEMP STACK
868 HEAD1 INX:BNE CHAR1
869 TYA:PHA:JSR CHROUT:JSR SENDCHAR;  SEND # OF 1CHILDREN AND THEN NAMES
870 ;
872 LDY #0:LDX #1
876 PNODE0 LDA NCODE,X:BNE HEAD2;  IGNORE $FF
877 TXA:STA HBITS,Y:INY;  PUSH ON TEMP STACK
878 HEAD2 INX:CPX NUMNODE:BNE PNODE0
879 TYA:PHA:JSR CHROUT:JSR SENDNODE;  SEND # OF 0NODES AND THEN NAMES
880 ;
882 LDY #0:LDX #1
886 PNODE1 LDA NCODE,X:BEQ HEAD3;  IGNORE $00
887 TXA:STA HBITS,Y:INY;  PUSH ON TEMP STACK
888 HEAD3 INX:CPX NUMNODE:BNE PNODE1
889 TYA:PHA:JSR CHROUT:JSR SENDNODE;  SEND # OF 1NODES AND THEN NAMES
890 ;
891 LDY #4
892 ADDLOOP PLA:CLC:ADC OUTLEN:STA OUTLEN
893 LDA #0:ADC OUTLEN+1:STA OUTLEN+1:DEY:BNE ADDLOOP
894 ASL OUTLEN:ROL OUTLEN+1:CLC:LDA OUTLEN:ADC #6:STA OUTLEN
895 LDA #0:ADC OUTLEN+1:STA OUTLEN+1:RTS
896 ;
902 SENDCHAR DEY:LDX HBITS,Y:LDA CPNODE,X:JSR CHROUT;  SEND PARENT'S NAME
903 TXA:JSR CHROUT;  SEND NAME
904 CPY #0:BNE SENDCHAR:RTS
905 ;
906 SENDNODE DEY:LDX HBITS,Y:LDA NPNODE,X:JSR CHROUT;  SEND PARENT'S NAME
907 TXA:JSR CHROUT;  SEND NAME
908 CPY #0:BNE SENDNODE:RTS
909 ;
950 ENCFILE = *
960 INC FILELEN+1
970 LDA #8:STA OUTBITS;  8 BITS IN A BYTE
972 ENLOOP JSR WALKUP;  WALK UP THE TREE
974 JSR WALKDOWN;  OUTPUT THE BYTE
976 DEC FILELEN:BNE ENLOOP
978 DEC FILELEN+1:BNE ENLOOP;  KEEP (null)ING WHILE THE CHARACTERS ARE COMING
980 LDX OUTBITS:CPX #8:BEQ FINISH
982 LASTONE ASL OUTBYTE:DEX:BNE LASTONE
984 LDX #4:JSR CHKOUT:LDA OUTBYTE:JSR CHROUT;  SEND THE LAST ONE
985 INC OUTLEN:BNE FINISH:INC OUTLEN+1
986 FINISH RTS
988 ;
990 WALKUP = *
1000 LDX #3:JSR CHKIN:JSR CHRIN:TAX;  GET THE NEXT INPUT BYTE
1002 LDY #0
1004 LDA CCODE,X:STA HBITS,Y:INY;  FIRST CODE
1006 LDA CPNODE,X:BEQ UPOUT;  IF PARENT IS ZERO, EXIT
1008 UPLOOP TAX
1010 LDA NCODE,X:STA HBITS,Y:INY;  GET THE CODE AND SAVE IT
1012 LDA NPNODE,X:BNE UPLOOP;  BRANCH IF NOT PARENT 0
1014 UPOUT DEY:RTS
1016 ;
1020 WALKDOWN = *
1030 LDA HBITS,Y
1032 ROL:ROL OUTBYTE;  BUILD A BYTE A BIT AT A TIME
1034 DEC OUTBITS
1036 BEQ (null)TABYTE;  IF OUTBITS = 0, 8 BITS ARE READY
1038 DOWNTEST DEY:CPY #255:BNE WALKDOWN
1040 RTS;  END OF WALKDOWN
1042 ;
1044 (null)TABYTE STY TEMPY
1045 LDX #4:JSR CHKOUT:LDA OUTBYTE:JSR CHROUT;  SEND A CHARACTER
1046 LDY TEMPY:INC OUTLEN;  INCREMENT LENGTH OF OUTPUT FILE
1048 BNE RESET8:INC OUTLEN+1
1050 RESET8 LDA #8:STA OUTBITS
1052 BNE DOWNTEST;  BRANCH ALWAYS
1054 ;
1100 DECODE = *
1110 LDX #5:JSR CHKIN;  CHANNEL 5 IS INPUT
1120 JSR CHRIN:STA FILELEN:JSR CHRIN:STA FILELEN+1:INC FILELEN+1
1122 CHI0 JSR CHRIN;  HOW MANY CHILD0'S
1124 BEQ CHI1:STA LC;  LOOP COUNTER
1126 DELP1 JSR CHRIN:TAX:JSR CHRIN
1128 STA CH0NAME,X:LDA #0:STA CH0TYPE,X
1129 DEC LC:BNE DELP1
1130 ;
1132 CHI1 JSR CHRIN;  HOW MANY CHILD1'S
1134 BEQ PAR0:STA LC;  LOOP COUNTER
1136 DELP2 JSR CHRIN:TAX:JSR CHRIN
1138 STA CH1NAME,X:LDA #0:STA CH1TYPE,X
1139 DEC LC:BNE DELP2
1140 ;
1142 PAR0 JSR CHRIN;  HOW MANY PARENT0'S
1144 BEQ PAR1:STA LC;  LOOP COUNTER
1146 DELP3 JSR CHRIN:TAX:JSR CHRIN
1148 STA CH0NAME,X:LDA #$FF:STA CH0TYPE,X
1149 DEC LC:BNE DELP3
1150 ;
1152 PAR1 JSR CHRIN;  HOW MANY PARENT1'S
1154 BEQ BITTER:STA LC;  LOOP COUNTER
1156 DELP4 JSR CHRIN:TAX:JSR CHRIN
1158 STA CH1NAME,X:LDA #$FF:STA CH1TYPE,X
1159 DEC LC:BNE DELP4
1160 ;
1170 BITTER = *
1180 LDA #0:STA NODE
1182 OUTLOOP LDX #5:JSR CHKIN:JSR CHRIN
1184 STA HUFFER;  (null)T 8 BITS
1188 LDA #8:STA NUMBITS
1190 INLOOP LDY NODE;  THE NODE IS THE PARENT
1192 ROL HUFFER;  GET A BIT INTO CARRY
1194 BCS ITSA1;  IF CS, THE BIT IS 1
1196 ITSA0 = *
1198 LDA CH0NAME,Y;  GET THE NAME OF CHILD 0
1200 STA NODE;  WHO IS THE NEW PARENT/NODE
1202 LDX CH0TYPE,Y;  DOES IT TERMINATE
1204 BEQ PRINTIT;  YES, (null) PRINT
1206 NEXTBIT = *
1208 DEC NUMBITS
1210 BNE INLOOP
1212 BEQ OUTLOOP
1216 ;
1220 ITSA1 = *
1222 LDA CH1NAME,Y;  GET THE NAME OF CHILD 1
1224 STA NODE;  WHO IS THE NEW PARENT/NODE
1226 LDX CH1TYPE,Y;  DOES IT TERMINATE
1228 BEQ PRINTIT;  YES, (null) PRINT
1230 BNE NEXTBIT
1240 ;
1250 PRINTIT = *
1260 LDX #6:JSR CHKOUT
1262 LDA NODE:JSR CHROUT
1264 DEC FILELEN:BNE TOTHETOP:DEC FILELEN+1
1266 TOTHETOP LDA #0:STA NODE;  BACK UP TO NODE 0 AT THE TOP
1268 LDA FILELEN:ORA FILELEN+1:BNE NEXTBIT
1270 ;
1280 CLEANUP = *
1290 LDA #5:JSR CLOSE:LDA #6:JSR CLOSE
1292 JSR CLRCHN
1294 RTS
1296 ;
9000 FILELEN = *;  LENGTH OF SRC FILE
9002 NUMCHAR = *+2;  # OF CHARS
9004 NUMNODE = *+3;  # OF NODES
9006 LC = *+4;  LOOP COUNTER
9008 LISTLEN = *+5;  LENGTH OF LIST, USED BY ISORT ROUTINE
9010 ISLIST = *+6;  TEMPORARY STORAGE FOR LIST, TYPE, FREQLO, AND FREQHI
9012 ISTYPE = *+7
9014 ISLO = *+8
9016 ISHI = *+9
9018 TESTLO = *+10;  ISLO/HI IS TESTED AGAINST TESTLO/HI FOR INSERTION SORT
9020 TESTHI = *+11
9022 TEMPY = *+12;  TEMP STORAGE FOR .Y
9024 LOW1 = ISLO
9026 HI1 = ISHI
9028 LOW2 = TESTLO
9030 HI2 = TESTHI
9040 OUTLEN = *+13;  OUTPUT FILE LENGTH
9042 OUTBYTE = *+15;  THE (CRUNCHED) HUFFMAN BYTE TO SEND OUT
9044 OUTBITS = *+16;  NUMBER OF BITS (WHEN IT = 8, THE BYTE GETS SENT)
9046 HUFFER = ISLO;  HUFFMAN BYTE (WHEN UNCRUNCHING)
9048 NODE = ISHI;  THE CHILD NODE (EITHER ANOTHER NODE OR A CHAR)
9050 NUMBITS = TESTLO;  NUMBER OF BITS