home *** CD-ROM | disk | FTP | other *** search
/ Shareware Supreme Volume 6 #1 / swsii.zip / swsii / 172 / CRUNCH24.ZIP / CRUNCH24.ARK / CRUNCH.Z80 < prev    next >
Text File  |  1990-05-26  |  47KB  |  1,357 lines
  1. ;***********************************************************************
  2. ;*                                       *
  3. ;*                 CRUNCH                    *
  4. ;*               v2.4  15 Sept 1987                   *
  5. ;*                        - Steven Greenberg     *
  6. ;*                                       *
  7. ;***********************************************************************
  8.  
  9.     .Z80
  10.     .SALL
  11.     TITLE 'Crunch v2.4  15 Sept 1987'
  12.  
  13.     EXTRN    PARSEU
  14.     CSEG
  15. ;
  16. ;=======================================================================
  17. ;
  18. MEMPAG    EQU    1A00H        ; <=== set! [see comment near end of program]
  19. ;
  20. ;=======================================================================
  21. ;
  22. ;.......................................................................
  23. ;
  24. ; v2.4    Update Note:  As explained in the CRUNCH24 general release .LBR,
  25. ; v2.4 will generate identical    files  (except    embedded  revision level
  26. ; byte) to  CRUNCH v2.3.  The great  majority of  the  changes    are user
  27. ; interface related,  and are described  in the  CRUNCH24  documentation
  28. ; files.  Some changes were made  in the implementation of the "core" of
  29. ; the algorithms  for both CRUNCH and UNCRunch - in the case  of CRUNCH,
  30. ; conditionals were removed by    splitting into three separate loops.  In
  31. ; the case  of UNCRunch, an  unnecessary  chase to  the  end  of"virtual
  32. ; links" was eliminated by aborting  the search as soon as  an available
  33. ; reassignments lot  is found.    Other performance  improving changes in-
  34. ; clude less  time updating  the screen and  dynamic I/O  buffer sizing.
  35. ; Non-time-critical  "user-interface" changes (eg. the "tag  mode" code,
  36. ; etc.)  were  coded in as straightforward  a manner  as  possible, with
  37. ; little regard to code space minimization and even less to speed.
  38. ;
  39. ; While some documentation  of the code  has been cleaned up in the sev-
  40. ; eral month interim between the CRUNCH24.LBR release and the release of
  41. ; this source code, I have been very careful to  avoid any temptation to
  42. ; change any of the code itself, thus insuring that this source code can
  43. ; be used to create the identical COM files included in the v2.4 release
  44. ; of CRUNCH.
  45. ;
  46. ;.......................................................................
  47. ;
  48. NO    EQU    0
  49. YES    EQU    NOT NO
  50. CRUNCH    EQU    YES        ; Yes for CRUNCH, No for UNCR (for common)
  51.  
  52. REV    EQU    24H        ; Program revision level
  53. SIGREV    EQU    20H        ; "Significant" revision level (compatibility)
  54.  
  55. NOPRED    EQU    0FFFFH        ; "No predecessor"
  56. IMPRED    EQU    07FFFH        ; Pred that can't be matched or bumped
  57.  
  58. SCRUPT1    EQU    03H        ; Screen update speeds
  59. SCRUPT2    EQU    0FH
  60. ;
  61. ; --- Reserved codes ---
  62. ;
  63. EOFCOD    EQU    100H        ; EOF code
  64. RSTCOD    EQU    101H        ; Adaptive reset code
  65. NULCOD    EQU    102H        ; Null code
  66. SPRCOD    EQU    103H        ; Spare code
  67. ;
  68. ; --- Ascii equates ---
  69. ;
  70. CTRLC    EQU    03H        ; ^c
  71. BELL    EQU    07H        ; Beep
  72. BS    EQU    08H        ; Backspace
  73. LF    EQU    0AH        ; Linefeed
  74. CR    EQU    0DH        ; Carriage return
  75. ;
  76. ; --- CP/M address equates ---
  77. ;
  78. DFCB    EQU    5CH        ; Default FCB #1
  79. DFCB2    EQU    6CH        ; Default FCG #2
  80. DDMA    EQU    80H        ; Default DMA address
  81. BDOS    EQU    0005H        ; BDOS entry point
  82. ;
  83. ; --- BDOS function equates ---
  84. ;
  85. CONIN    EQU    1        ; Input a character from the console
  86. CONOUT    EQU    2        ; Output single char to console
  87. PRTSTR    EQU    9        ; Print string to console
  88. CONST    EQU    11        ; Get console status
  89. GETVER    EQU    12        ; Get CP/M version#
  90. SELDSK    EQU    14        ; Select disk
  91. OPEN    EQU    15        ; Open file
  92. CLOSE    EQU    16        ; Close file
  93. SFIRST    EQU    17        ; Search for first file
  94. SNEXT    EQU    18        ; Search for next file
  95. ERASE    EQU    19        ; Erase file
  96. READ    EQU    20        ; Read file (sequential)
  97. WRITE    EQU    21        ; Write file (sequential)
  98. MAKE    EQU    22        ; Make file
  99. GETDSK    EQU    25        ; Get currently logged drive
  100. SETDMA    EQU    26        ; Set DMA address
  101. SETATR    EQU    30        ; Set file attributes
  102. GSUSER    EQU    32        ; Get/set user code
  103. RSTDRV    EQU    37        ; Reset disk drive
  104. SETMS    EQU    44        ; Set multi-sector count (CP/M+ only)
  105. ;
  106. ;.......................................................................
  107. ;
  108. ; Macros to facilitate "horizontal" movement through the table.
  109. ; See "Table structure" comment near "initbl" for more information.
  110. ;
  111. RIGHT1     MACRO
  112.     LD    A,H        ; }
  113.     ADD    A,14H        ; } Move "right" one column (same row)
  114.     LD    H,A        ; }
  115.      ENDM
  116. ;
  117. ;.......................................................................
  118. ;
  119. START:    JP    STRT        ; <--- entry
  120.     DB    'Z3ENV',01H    ; ZCPR3 environment descriptor
  121.  
  122. Z3ED:    DB    00H,00H
  123. ;
  124. ;-----------------------------------------------------------------------
  125. ;
  126. Z3FLG:    DB    0        ; ZCPR flag
  127. ARCHIV:    DB    0        ; Archive bit mode flag
  128. INSREV:    DB    23H        ; Program rev for install purposes
  129. QUIFL:    DB    0        ; Quiet mode flag
  130. NPROFL:    DB    0        ; No prompt before overwrite flag
  131. TRBOFL:    DB    0        ; Defeat multi-sector i/o flag
  132. CNFRFL:    DB    0        ; Confirm every file flag
  133. WRMFLG:    DB    0        ; Warm boot flag
  134. BIGFLG:    DB    0        ; Bigger file prompt flag
  135. MAXDRV:    DB    0FFH        ; Maximum drive allowed by program
  136. MAXUSR:    DB    0FFH        ; Maximum user# allowed by program
  137. SPARFL:    DB    0FFH        ; Spare flag (or value)
  138. ;
  139. ;.......................................................................
  140. ;
  141. ; File type exclusion list. Must end with zero.
  142.  
  143. ;           |<-1->|<-2->|<-3->|<-4->|<-5->|
  144. EXTBL:    DB    'ARC','ARK','LBR',0,0,0,0,0,0
  145.  
  146. ;           |<-6->|<-7->|<-8->|<-9->|<10->|
  147.     DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  148.  
  149.     DB    0        ; Must leave this terminating zero.
  150. ;
  151. ;=*=-=*=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=
  152. ;
  153. CPYRT:    DB    'CRUNCH  v2.4  Copyright (c)  S. Greenberg  09/15/87',CR,LF
  154.     DB    'May be reproduced for non-profit use only','$'
  155.     DB    ' 201-670-8724'
  156. ;
  157. ;=*=-=*=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=
  158.  
  159. STRT:    SUB    A        ; Z-80 test [RAF]
  160.     JP    PO,Z80        ;
  161.     LD    DE,WRNGUP    ; "Program requires Z-80 Processor"
  162.     JP    MESS80        ; Special no frills exit w/ message
  163.  
  164. Z80:    LD    (OLDSTK),SP    ; Save os's stack
  165.     LD    SP,TOPSTK    ; Set local stack
  166.     CALL    STRTUP        ; Does a lot of stuff
  167. ;
  168. ;.......................................................................
  169. ;
  170. ;    *****    Re-enter here for each matching file *****
  171. ;
  172. ; General wildcard operation:  When the program is first invoked, all
  173. ; matching filenames are put end to end in FNBUFF, 12 bytes each, in
  174. ; alphabetical order.  Since a filename is only 11 characters long the
  175. ; spare byte, which precedes each filename, is used as a "tag/flag".  By
  176. ; the time file processing starts (now), a number of routines have al-
  177. ; ready run (parts of the STRTUP routine).  These routines set the tag-
  178. ; flag which indicates to us now in what manner the file should be pro-
  179. ; cessed: "00" = "skip it", "01" = process it", "02" = "perform a direct
  180. ; copy (if possible)", "FF" = "no more files".
  181. ;
  182. NXTFIL:    LD    SP,TOPSTK    ; Reset SP
  183.     LD    A,(QUIFM)
  184.     OR    A
  185.     CALL    Z,CRLF        ; Extra CR/LF if not in "quiet" mode
  186.     LD    DE,INFCB    ; Input file's fcb
  187.     CALL    CLRFCB        ; Init it to blanks and zeroes
  188.     INC    DE        ; Leave "DE" pointing at "INFCB+1" for below
  189.     LD    HL,(BUFPTR)    ; Pntr to name of next file from expansion bfr
  190. NXTSEL:    LD    A,(HL)
  191.     OR    A        ; If zero, the file is "unselected"
  192.     JR    NZ,ISSEL    ; Br if it is selected
  193.     LD    BC,12        ; Else just quietly skip to the next file
  194.     ADD    HL,BC
  195.     LD    (BUFPTR),HL
  196.     JR    NXTSEL
  197. ;
  198. ;...............................
  199. ;
  200. ; The file is "selected"; prepare to process it
  201. ;
  202. ISSEL:    CP    0FFH        ; (FF means done)
  203.     JP    Z,RETCCP    ; Br if that is the case
  204.     PUSH    AF        ; Save stat (to see if file is "excluded" blw)
  205.     INC    HL        ; Skip to 1st filename char
  206.     LD    BC,11        ; Filename character count
  207.     LDIR            ; Put next file name into input fcb
  208.     LD    (BUFPTR),HL    ; Save new pointer for next file
  209.     CALL    INTRAM        ; Initialize all ram
  210.     LD    A,01H        ; This loc req's diff init for crunch vs uncr
  211.     LD    (CSAVE),A    ; Goes there
  212.     POP    AF        ; Get file's status byte back again
  213.  
  214.     CP    02H        ; 02 if file matched the "exclusion" list
  215.     JR    NZ,COPNIN    ; If not, definitely attempt to compress it
  216.     LD    A,(WLDFLG)    ; If so, see if prgm was invoked w/ wildcards
  217.     OR    A
  218.     JR    Z,COPNIN    ; If not, go attempt compression
  219.     LD    A,(DIFDU)    ; Else see if a direct copy is in order
  220.     OR    A        ; (flag set if data flow is to distinct DU:'s)
  221.     JP    Z,NXTFIL    ; If not, forget the whole thing
  222. ;
  223. ;.......................................................................
  224. ;
  225. ; Perform a direct straight copy of the file
  226. ;
  227.     LD    DE,DASHES    ; "-----" for visual separation
  228.     CALL    MESAG2
  229.     JP    COPY9        ; Performs the copy
  230. ;
  231. ;.......................................................................
  232. ;
  233. ; Normal Processing;  Prepare to compress the input file.  First, open
  234. ; the input file.  A failure here is unusual, since the file existed at
  235. ; the time the filename expansion took place.  There are "normal" series
  236. ; of events which could lead up to this, however.
  237. ;
  238. COPNIN:    LD    DE,DASHES    ; "-----" for visual separation
  239.     CALL    MESAG2
  240.     CALL    OPNIN        ; Attempt to open the next input file "INFCB"
  241.     JR    NC,OPOK        ; Br if ok
  242.     LD    DE,ERR1        ; "input file not found"
  243.     JP    SKIP1        ; Skip to next file
  244.  
  245. OPOK:    CALL    GETC        ; "gtlogc" needs initialization to get started
  246.     JR    NC,NOTMT    ; If carry is set on 1st byte, file is empty
  247.     LD    DE,ERR0        ; "input file empty"
  248.     JP    SKP991
  249.  
  250. NOTMT:    CP    76H        ; If file starts with "76FF" or "76FF", it is
  251.     JR    NZ,NOTSQ    ; - already crunched or squeezed respectively
  252.     PUSH    AF        ; 1st byte was "76H", take advance peek at 2nd
  253.     EXX            ; Carefully check next byte, w/o norm call
  254.     LD    A,(HL)
  255.     EXX
  256.     INC    A        ; Well?
  257.     JR    Z,ALRDSQ    ; Br if already squeezed
  258.     INC    A
  259.     JR    Z,ALRDCR    ; Br if already crunched
  260.     POP    AF
  261.  
  262. NOTSQ:    LD    (LIMBO),A    ; Else ok; put 1st char there manually
  263.     JR    CBL        ; Continue below
  264. ;
  265. ;.......................................................................
  266. ;
  267. ALRDCR:    POP    AF
  268.     LD    DE,MSGCR    ; "Already crunched"
  269.     JP    SKP991
  270.  
  271. ALRDSQ:    POP    AF
  272.     LD    DE,MSGSQ    ; "Agalready squeezed"
  273.     JP    SKP991
  274. ;
  275. ;.......................................................................
  276. ;
  277. ; So far the input file is open. The output file is not.
  278. ;
  279. CBL:    LD    A,' '        ; For aesthetic alignment purposes
  280.     CALL    TYPE
  281.     LD    HL,INFCB    ; Print input filename to console
  282.     CALL    PRNFIL
  283.     LD    DE,OUTFCB    ; Now for the output fcb
  284.     CALL    CLRFCB        ; Clear it
  285.     INC    DE        ; Leave "DE" pointing at filename area
  286.     CALL    CPYNAM        ; Copies filename from input fcb to output fcb
  287.     LD    HL,(OUTFCB+9)    ; Get 1st & 2nd letters of ext for analysis
  288.     LD    A,' '        ; See if extension is blank
  289.     CP    L
  290.     JR    Z,FORZZZ    ; If so, force an extension of "ZZZ"
  291.     LD    A,'Z'        ; See if middle letter is "Z"
  292.     CP    H
  293.     JR    NZ,NZZZ        ; Normal condition- simply force 2nd ltr to z
  294. ;
  295. ;...............................
  296. ;
  297. ; Middle letter is Z, use "ZZZ" if possible
  298. ;
  299.     CP    L        ; Make sure it isn't "ZZZ" already!
  300.     JR    NZ,FORZZZ    ; Ok...
  301.     LD    HL,(OUTFCB+10)
  302.     CP    H
  303.     JR    NZ,FORZZZ    ; Ok...
  304.     LD    DE,ERR7        ; If this happens, user better rename his file
  305.     JP    SKP991        ; But give him a straight copy, anyway
  306. ;
  307. ;...............................
  308. ;
  309. NZZZ:    LD    HL,OUTFCB+10    ; Normal condition- force 2nd letter to "Z"
  310.     JR    NORMZ        ; (note- "A" already has a "Z" in it)
  311. ;
  312. ;...............................
  313. ;
  314. FORZZZ:    LD    HL,OUTFCB+9    ; Come here if an extension of "ZZZ" is needed
  315.     LD    A,'Z'
  316.     LD    (HL),A        ; (A future version will rename "XZY" files
  317.     INC    HL        ; To "XZZ" rather than "ZZZ", a better idea)
  318.     LD    (HL),A
  319.     INC    HL
  320. ;
  321. ;...............................
  322. ;
  323. NORMZ:    LD    (HL),A
  324. ;
  325. ;.......................................................................
  326. ;
  327. ; Now open the output file. "OPNOUT" will check for duplicate filenames,
  328. ; and prompt if indicated.  If carry is set on return, the file was not
  329. ; opened.  DE points to an appropriate error message, if any.  The rou-
  330. ; tine also types an arrow to the screen, followed by a "PRNFIL" call to
  331. ; type the DU: and filename to the screen.
  332. ;
  333.     CALL    OPNOUT        ; Do all that
  334.     JP    C,SKIP2A    ; Skips to next file if so deemed by "OPNOUT"
  335. ;
  336. ;.......................................................................
  337. ;
  338. ; Now both files are open. Eventually either both will be closed, or the
  339. ; input closed and the output deleted.
  340.  
  341.     CALL    INITBL        ; Initialize the lzw table
  342.     LD    A,76H        ; Output the "76FE" header
  343.     CALL    OUTB        ; Each call to "OUTB" outputs one byte
  344.     LD    A,0FEH
  345.     CALL    OUTB
  346.     LD    HL,INFCB    ; Pointer to original (input) file's name
  347.     CALL    OUTFIL        ; Embed it into the output file at bytes 2+
  348.     LD    HL,STAMP    ; Pointer to possible additional "stamp" chars
  349.  
  350. IDOULP:    LD    A,(HL)        ; Possibly get a stamp char
  351.     INC    HL        ; Incr bfr pntr
  352.     CALL    OUTB        ; (output at least one zero no matter what)
  353.     OR    A        ; End of stamp bfr?
  354.     JR    NZ,IDOULP    ; Loop till so
  355.  
  356.     LD    A,REV        ; Output revision level of this program
  357.     CALL    OUTB
  358.     LD    A,SIGREV    ; Output "significant revision" level
  359.     CALL    OUTB
  360.     XOR    A
  361.     CALL    OUTB        ; Output a checksum flag byte of zero
  362.     LD    A,5
  363.     CALL    OUTB        ; Output a spare byte of "5"
  364. ;
  365. ;.......................................................................
  366. ;
  367.     LD    A,(QUIFM)    ; Print "heading" if in verbose mode
  368.     OR    A
  369.     JR    NZ,QUIET1
  370.     LD    DE,HEADNG    ; (the "in / out  ca  cr" stuff)
  371.     CALL    MESAGE
  372.  
  373. QUIET1:    LD    IY,STATE0    ; Set the initial state of the "input machine"
  374.     LD    HL,NOPRED    ; Initialize "pred" to "NOPRED"
  375. ;
  376. ;=======================================================================
  377. ;
  378. ;            *** Main encoding loop ***
  379. ;
  380. ; "Match" will determine if the combination { <pred>, <suffix> }, as
  381. ; supplied in { HL, A }, is already in the table.  If it is, the match-
  382. ; ing index value is returned in DE.  If it isn't, it will be added to
  383. ; the  table in an appropriate location (assuming the table is not yet
  384. ; filled).  If    the table is filled, it may or may not still be added.
  385. ; The carry flag will be set to indicate when a match was NOT found.
  386. ;
  387. MAINLP:    CALL    GTLOGC        ; A <-- next byte from "logical" input stream
  388.     JR    C,FINISH    ; Branch on end-of-file
  389.  
  390. MAINL2:    CALL    MATCH        ; Is { pred, suffix } in the table?
  391.     JR    NC,FOUND    ; Branch if found
  392.     CALL    OUTPUT        ; If not, output that pred (still in hl)
  393.     LD    HL,RSTFLG    ; See if an adaptive reset has been requested
  394.     SRL    (HL)        ; Check (& zero if set) the adaptive rst flag
  395.     LD    HL,NOPRED    ; Meanwhile, reset pred to "NOPRED"
  396.     JR    NC,MAINL2    ; Loop without getting another char (normally)
  397.     JP    ADPRST        ; (unless an adaptive reset was indicated)
  398.  
  399. FOUND:    EX    DE,HL        ; Match- discard old pred & replace with new
  400.     JP    MAINLP        ; Get a new character and loop
  401.  
  402. ;           *** End of main encoding loop ***
  403. ;.......................................................................
  404. ;
  405. ; --- End-of file processing ---
  406. ;
  407. FINISH:    CALL    PREINC        ; Update the count for the upcoming output
  408.     CALL    OUTPUT        ; Output the "leftover" code
  409.     CALL    PREINC        ; Update again
  410.     LD    HL,EOFCOD    ; Send an (otherwise disallowed) "EOF" code
  411.     CALL    OUTPUT        ; That does that
  412.     LD    A,(CSAVE)    ; Get the var that accumulates bits until 8
  413.     CP    01H        ; The 1 out of 8 chance we're on a byte bndry
  414.     JR    Z,ONBND
  415.     XOR    A
  416.     CALL    OUTB
  417.  
  418. ONBND:    LD    A,(CHKSUM+0)    ; Now output the checksum
  419.     CALL    OUTB        ; (lo byte)
  420.     LD    A,(CHKSUM+1)
  421.     CALL    OUTB        ; (high byte). This completes all output.
  422.  
  423.     CALL    DONE        ; Writes out partial output bfr, thru cur loc
  424.     CALL    CLSOUT        ; Close the output file
  425.     CALL    CLSIN        ; Close the input file (prevents inadvertent
  426.                 ; Accumulation of open files).
  427. ;
  428. ;.......................................................................
  429. ;
  430. ; Now we are done with the file.  The size of the resulting file will be
  431. ; compared with the original.  If the resulting file is larger, the file
  432. ; will be erased and the original will be copied in uncompressed format
  433. ; instead.  This will only be done if the source and destination DU:'s
  434. ; are different (obviously a direct copy to the same drive and user is
  435. ; nonsensical).  When this is the case, the user will be given the op-
  436. ; tion of saving the "crunched" file - if he doesn't, then it will be
  437. ; erased.
  438. ;
  439.     LD    A,(BIGFLG)    ; Get size question override flag
  440.     AND    A        ; Check if non-0, clear carry at same time
  441.     JP    NZ,NEXT        ; Skip if bigger
  442.     LD    DE,(INCTR)    ; Size of input file
  443.     LD    HL,(OUTCTR)    ; Size of resulting file
  444.     SBC    HL,DE        ; Compare
  445.     JP    C,NEXT        ; (normally the case)
  446.  
  447.     LD    A,(DIFDU)    ; Dest du: differ from origin?
  448.     OR    A
  449.     JP    Z,ASKHIM    ; If not, give option of saving larger file
  450.  
  451.     LD    DE,MSG998    ; "not smaller..."
  452.     CALL    MESAG2
  453.     CALL    ERAOUT        ; Erase the output file
  454.  
  455. COPY9:    CALL    COPY        ; Perform a straight copy
  456.     JP    C,NXTFIL    ; If the copy did not actually take place
  457.     JR    NEXT        ; If it did, count it
  458. ;
  459. ;.......................................................................
  460. ;
  461. SKP991:    CALL    MESAG2        ; Type predefined message
  462.     LD    A,(DIFDU)    ; Dest du: differ from origin?
  463.     OR    A
  464.     JP    Z,NXTFIL
  465.     JR    COPY9
  466. ;
  467. ;.......................................................................
  468. ;
  469. ASKHIM:    LD    DE,QUES1    ; Result file not smaller than original
  470.     CALL    MESAGE        ; Ask the guy if he wants it anyway
  471.     CALL    RSPNSE        ; Get his response
  472.     PUSH    AF        ; Nec?
  473.     CALL    CRLF
  474.     POP    AF
  475.     JR    NZ,SKIP4A    ; "skip4a" erases output file, goes to next
  476. ;
  477. ;.......................................................................
  478. ;
  479. NEXT:    LD    HL,NFP        ; Increment #of files processed
  480.     INC    (HL)
  481.     CALL    ARCIT        ; Flag input file as archived
  482.     JP    NXTFIL        ; Repeat if still more files
  483. ;
  484. ;.......................................................................
  485. ;
  486. ;...............................
  487. ;
  488. SKIP1:    CALL    MESAGE        ; Entry if neither input nor output files
  489.                 ;   have been opened yet
  490. SKIP1A:    JP    NXTFIL        ; (Entry here if no error text desired)
  491. ;
  492. ;...............................
  493. ;
  494. SKIP2:    CALL    MESAGE        ; Entry here if only input file open
  495.  
  496. SKIP2A:    CALL    CLSIN        ; (Entry here for no message)
  497.     JP    NXTFIL
  498. ;
  499. ;...............................
  500. ;
  501. SKIP3:    CALL    MESAGE        ; Entry here if both input and output
  502.                 ;   files need to be closed
  503. SKIP3A:    CALL    CLSIN
  504.     CALL    CLSOUT
  505.     JP    NXTFIL
  506. ;
  507. ;................................
  508. ;
  509. SKIP4:    CALL    MESAGE        ; Entry here to erase output & close input file
  510.  
  511. SKIP4A:    CALL    CLSOUT        ; (Entry here for no message)
  512.     LD    DE,OUTFCB    ; Close, then erase output file
  513.     LD    C,ERASE
  514.     CALL    BDOSAV
  515.     CALL    CLSIN        ; Close input file as well
  516.     JP    NXTFIL
  517. ;
  518. ;...............................
  519. ;
  520. ;.......................................................................
  521. ;
  522. ; --- Perform an adaptive reset ---
  523. ;
  524. ADPRST:    LD    (SAVSUF),A    ; Save the suffix which has yet to be output
  525.     LD    HL,RSTCOD    ; Send an (otherwise disallowed) reset code
  526.     CALL    OUTPUT
  527.     LD    HL,0000        ; Reset entry# prior to table re-initialization
  528.     LD    (ENTRY),HL
  529.     LD    (TTOTAL),HL    ; Also reset "codes reassigned" to zero
  530.     XOR    A
  531.     LD    (FULFLG),A    ; Reset the adaptive reset flag back to zero
  532.     CALL    INITBL        ; Re-initialize the entire lzw table
  533.     LD    A,9        ; Reset the code length to "9"
  534.     LD    (CODLEN),A    ;
  535.     LD    (CODLE0),A    ; This gets that also
  536.     LD    A,02H        ; Reset the target mask value accordingly
  537.     LD    (TRGMSK),A    ;
  538.     LD    A,0FFH        ; Init the target compression ratio to max
  539.     LD    (LOWPER),A    ; Goes there
  540.  
  541.     LD    HL,NOPRED    ; Set pred to "nopred"
  542.     LD    A,(SAVSUF)    ; Restore the suffix char, patiently waiting
  543.     JP    MAINL2        ; And continue where we left off
  544. ;
  545. ;=======================================================================
  546. ;
  547. ; Find a match for { <pred> <suffix> }, as supplied in { HL, A }.  Does
  548. ; one of the following two things:
  549. ;
  550. ; (1) Returns the index# of a match in DE, with carry flag clear
  551. ; (2) Sets carry flag & adds new combo to to the appropriate place in
  552. ;     "table".
  553. ;
  554. ENTERX:
  555. MATCH:    LD    B,A        ; Suffix will stay in b for the duration
  556.     LD    A,(FULFLG)    ; Use separate search loop if table full
  557.     OR    A        ; Is it?
  558.     JP    NZ,MATCH2    ; Yes, use "match2" rather than "match1"
  559. ;
  560. ;.......................................................................
  561. ;
  562. ; "Match1": Table is not yet full; find a matching entry or else make a new
  563. ; one in the next available location. No code reassingnment here.
  564. ;
  565.     PUSH    HL
  566.     PUSH    HL        ; This will be popped into "DE" below
  567.     CALL    HASH        ; Get initial hash value into "HL"
  568.     POP    DE        ; "de" <-- "pred" (pushed as hl above)
  569.  
  570. MTCHL1:    LD    C,H        ; C  <-- extra copy of h
  571.     LD    A,(HL)        ; Check if any entry exists at that location
  572.     CP    80H        ; "80" is indicative of an empty entry
  573.     JP    Z,EMPT11    ; If empty, use the spot to create a new entry
  574.     JR    NC,SKIPD1    ; If carry, must be "FF"- leave it alone
  575.     AND    0DFH        ; Else mask out flag bit (5) before matching
  576.  
  577. SKIPD1:    CP    D        ; Does entry match pred (hi) ?
  578.     JR    NZ,NM1        ; Br if not
  579.  
  580.     RIGHT1            ; Move to pred (lo)
  581.     LD    A,E
  582.     CP    (HL)        ; Match?
  583.     JR    NZ,NM1        ; Oh well
  584.  
  585.     RIGHT1            ; Alright then, move to suffix
  586.     LD    A,B
  587.     CP    (HL)        ; Well?
  588.     JR    NZ,NM1        ; 2 out of 3 aint bad
  589. ;
  590. ;.......................................................................
  591. ;
  592. ; Match found!    Return the entry# (from the next two columns of the
  593. ; table).
  594. ;
  595.     RIGHT1            ; To entry#, hi-byte
  596.     LD    D,(HL)        ; Get it
  597.     RIGHT1            ; Move to entry#, lo byte
  598.     LD    E,(HL)        ; Get that
  599.     LD    H,C        ; Normalize. (ie reverse all those "right"'s)
  600.     SET    5,(HL)        ; Flag the entry as "referenced" with this bit
  601.     LD    A,B        ; Restore "a" to its value on entry
  602.     POP    HL        ; Likewise "HL" (won't be used, but gotta pop)
  603.     AND    A        ; Clear carry flag (return status)
  604.     RET            ; And return
  605. ;
  606. ;.......................................................................
  607. ;
  608. ; Match not found.  Perform standard hash collision processing and try
  609. ; again.  Add "DISP", a variable  displacement value, for the "secondary
  610. ; probe".  DISP was pre-calculated at the time the original hash value
  611. ; was computed.
  612. ;
  613. NM1:    LD    H,C        ; Normalize to beg of entry.
  614.     PUSH    DE        ; Save target values in d & e
  615.     LD    DE,(DISP)    ; Get pre-computed displacement value
  616.     ADD    HL,DE        ; Add displacement to current physical loc
  617.     LD    A,H
  618.     CP    TABLHI        ; And check for looping back to beg of table
  619.     JR    NC,NC91        ; (br if no loop)
  620.     LD    DE,5003
  621.     ADD    HL,DE        ; Else 5003 for loop around
  622.  
  623. NC91:    POP    DE
  624.     JP    MTCHL1        ; Repeat to see if this "link" matches
  625. ;
  626. ;.......................................................................
  627. ;
  628. ; All "links" to the hashed entry have been checked and none have
  629. ; matched.  Since the table is not full, we make a new entry at this
  630. ; unused location.
  631. ;
  632. EMPT11:    LD    (HL),D        ; Put in pred (high)
  633.     RIGHT1
  634.     LD    (HL),E        ; Pred (low)
  635.     RIGHT1
  636.     LD    (HL),B        ; Suffix
  637.     LD    DE,(ENTRY)    ; Now put the entry's number next to the entry
  638.     RIGHT1            ; Move to entry# (lo) column
  639.     LD    (HL),D        ; Put that in
  640.     RIGHT1
  641.     LD    (HL),E        ; Likewise entry# (hi)
  642.     CALL    PREIN2        ; Increments "ENTRY" and associated stuff
  643.  
  644. SCFRET:    SCF            ; Set carry to indicate new entry (no match)
  645.     LD    A,B        ; Return with carry set and "HL" & "A" intact
  646.     POP    HL
  647.     RET
  648. ;
  649. ;.......................................................................
  650. ;
  651. ; Subroutine to pre-incr for next code.  Called from various places in
  652. ; these loops.
  653. ;
  654. PREINC:    LD    DE,(ENTRY)    ; Pre-incr for next code.
  655.  
  656. PREIN2:    INC    DE        ; (entry here if "DE" already = "ENTRY")
  657.     LD    (ENTRY),DE    ; Save the new value
  658.     LD    A,(TRGMSK)    ; See if new code length is necessitated
  659.     CP    D        ; Check hi-byte against target value
  660.     RET    NZ        ; Simply return if not
  661.  
  662.     SLA    A        ; Yes, code length will change
  663.     LD    (TRGMSK),A    ; Next target mask
  664.     LD    A,(CODLEN)    ; Previous code length value (#of bits)
  665.     INC    A        ; Incr code length
  666.     CP    13        ; Too long?
  667.     JR    Z,FLAGFL    ; Yes, this means table just filled.
  668.     LD    (CODLEN),A    ; Else just update new length
  669.     RET            ; And return
  670.  
  671. FLAGFL:    LD    A,0FFH        ; If table just filled, flag this fact
  672.     LD    (FULFLG),A    ; ( = "FF" )
  673.     RET            ; And return w/o updating "CODLEN" past 12
  674. ;
  675. ;-----------------------------------------------------------------------
  676. ;
  677. ; "Match2":  This loop is executed after the table is full.  Continue
  678. ; search searching until a match is found.  If no match, but the entry
  679. ; is suitable for reassignment, save the position and do further search-
  680. ; ing in "Match3" loop below which skips the "reassingnment suitability"
  681. ; stuff since the candidate slot has already been found.
  682. ;
  683. ; This loop used after table is full
  684. ;
  685. MATCH2:    PUSH    HL        ; This save for the benefit of the "caller"
  686.     PUSH    HL        ; This will be popped into "DE" below
  687.     CALL    HASH        ; Get initial hash value into "HL"
  688.     POP    DE        ; "de" <-- "pred" (pushed as hl above)
  689. ;
  690. ;.......................................................................
  691. ;
  692. MTCHL2:    LD    C,H        ; C  <-- extra copy of h
  693.     LD    A,(HL)        ; Check if any entry exists at that location
  694.     CP    80H        ; "80" is indicative of an empty entry
  695.     JP    Z,SCFRET    ; Nothin doin'
  696.     JR    NC,SKIPD2    ; If so, leave "FF" intact for matching process
  697.     AND    0DFH        ; Else mask out flag bit (5) before matching
  698. SKIPD2:    CP    D        ; Does entry match pred (hi)
  699.     JR    NZ,NM2        ; Branch if not
  700.  
  701.     RIGHT1            ; Move to pred (lo)
  702.     LD    A,E
  703.     CP    (HL)        ; Match?
  704.     JR    NZ,NM2        ; Oh well
  705.  
  706.     RIGHT1            ; Alright then, move to suffix
  707.     LD    A,B
  708.     CP    (HL)        ; Well?
  709.     JR    NZ,NM2        ; 2 out of 3 ain't bad
  710. ;
  711. ;.......................................................................
  712. ;
  713. ; We have a match!  But there is one very important "but" - if the table
  714. ; is full and we are in "code reassignment" mode, we must pre-empt the
  715. ; possibility of generating the WsWsW *** string here in the cruncher.
  716. ; This is because it is impossible to detect these in the uncruncher
  717. ; once all codes are defined.
  718. ;
  719.     LD    A,(LPR+0)    ; If so, see if this whole pred/suffix combo
  720.     CP    E        ; - is identical to the last one generated
  721.     JP    NZ,NTUGLY    ; Pred (lo) doesn't match, so everything's ok
  722.     LD    A,(LSUFX)    ; Check suffix. the order of these 3 checks
  723.     CP    B        ; - is intended to optimized speed (most
  724.     JP    NZ,NTUGLY    ; - likely "non-matches" first)
  725.     LD    A,(LPR+1)    ; 2 out of 3 same- check pred (hi)
  726.     CP    D
  727.     JR    Z,NM2        ; Ugly situation-- pretend there's no match
  728. ;
  729. ;.......................................................................
  730. ;
  731. NTUGLY:    RIGHT1            ; A good match!
  732.     LD    D,(HL)        ; Get the entry# for return.
  733.     RIGHT1            ; Move to entry#, lo byte
  734.     LD    E,(HL)        ; Get that
  735.     LD    H,C        ; Normalize. (ie reverse all those "right"'s)
  736.     SET    5,(HL)        ; Flag the entry as "referenced" with this bit
  737.     LD    A,B        ; Restore "a" to its value on entry
  738.     POP    HL        ; Likewise "HL"
  739.     AND    A        ; Clear carry flag (return status) & return
  740.     RET
  741. ;
  742. ;.......................................................................
  743. ;
  744. NM2:    LD    H,C        ; No match yet. normalize to beg of entry.
  745.     BIT    5,(HL)        ; Is entry is available for poss re-assignment?
  746.     JR    NZ,NAVAIL    ; Branch if not
  747.     LD    (AVAIL),HL    ; Else this physical loc is the candidate
  748.     JP    NAVAI3        ; And jump into the "Match3" loop below
  749. ;
  750. ;.......................................................................
  751. ;
  752. ; Standard hash collision processing.  Add "DISP", a variable  displace-
  753. ; ment value, for the "secondary probe".  DISP was conveniently pre-
  754. ; calculated at the time the original hash value was computed.
  755. ;
  756. NAVAIL:    PUSH    DE        ; Process standard hash collision.
  757.     LD    DE,(DISP)    ; Get pre-computed displacement value
  758.     ADD    HL,DE        ; Add displacement to current physical loc
  759.     LD    A,H
  760.     CP    TABLHI        ; And check for looping back to beg of table
  761.     JR    NC,NC92        ; (Branch if no loop)
  762.     LD    DE,5003
  763.     ADD    HL,DE        ; Else 5003 for loop around
  764.  
  765. NC92:    POP    DE
  766.     JP    MTCHL2        ; Repeat to see if this "link" matches
  767.                 ; (end of "Match2")
  768. ;
  769. ;=======================================================================
  770. ;
  771. ; "Match3":  Like "Match2" above, but don't bother checking for a reas-
  772. ; signable entry, we already have one.    If all matches fail, perform
  773. ; that reassingment.
  774. ;
  775. MTCHL3:    LD    C,H        ; C  <-- extra copy of h
  776.     LD    A,(HL)        ; Check if any entry exists at that location
  777.     CP    80H        ; "80" is indicative of an empty entry
  778.     JP    Z,EMPTY3    ; If empty, use the spot to create a new entry
  779.     JR    NC,SKIPD3    ; If so, leave "FF" intact for matching process
  780.     AND    0DFH        ; Else mask out flag bit (5) before matching
  781. SKIPD3:    CP    D        ; Does entry match pred (hi)
  782.     JR    NZ,NM3        ; Branch if not
  783.  
  784.     RIGHT1            ; Move to pred (lo)
  785.     LD    A,E
  786.     CP    (HL)        ; Match?
  787.     JR    NZ,NM3        ; Oh well
  788.  
  789.     RIGHT1            ; Alright then, move to suffix
  790.     LD    A,B
  791.     CP    (HL)        ; Well?
  792.     JR    NZ,NM3        ; 2 out of 3 ain't bad
  793. ;
  794. ;.......................................................................
  795. ;
  796. ; We have a match!  But there is one very important "but" - if the table
  797. ; is full, and we are in "code reassignment" mode, we must pre-empt the
  798. ; possibility  of generating the WsWsW *** string here in the cruncher.
  799. ; This is because it is impossible to detect these in the uncruncher
  800. ; once all codes are defined.
  801. ;
  802.     LD    A,(LPR+0)    ; If so, see if this whole pred/suffix combo
  803.     CP    E        ; - is identical to the last one generated
  804.     JP    NZ,NTUGL3    ; Pred (lo) doesn't match, so everything's ok
  805.  
  806.     LD    A,(LSUFX)    ; Check suffix. the order of these 3 checks
  807.     CP    B        ; - is intended to optimized speed (most
  808.     JP    NZ,NTUGL3    ; - likely "non-matches" first)
  809.  
  810.     LD    A,(LPR+1)    ; 2 out of 3 same- check pred (hi)
  811.     CP    D
  812.     JR    Z,NM3        ; Ugly situation-- pretend there's no match
  813. ;
  814. ;.......................................................................
  815. ;
  816. NTUGL3:    RIGHT1            ; A good match!
  817.     LD    D,(HL)        ; Get the entry# for return.
  818.     RIGHT1            ; Move to entry#, lo byte
  819.     LD    E,(HL)        ; Get that
  820.     LD    H,C        ; Normalize. (ie reverse all those "right"'s)
  821.     SET    5,(HL)        ; Flag the entry as "referenced" with this bit
  822.     LD    A,B        ; Restore "a" to its value on entry
  823.     POP    HL        ; Likewise "HL"
  824.     AND    A        ; Clear carry flag (return status) & return
  825.     RET
  826. ;
  827. ;.......................................................................
  828. ;
  829. NM3:    LD    H,C        ; No match yet, normalize to beg of entry.
  830. ;
  831. ; Standard hash collision processing.  Add "DISP", a variable displace-
  832. ; ment value, for the "secondary probe".  DISP was conveniently pre-
  833. ; calculated at the time the original hash value was computed.
  834. ;
  835. NAVAI3:    PUSH    DE        ; Process standard hash collision.
  836.     LD    DE,(DISP)    ; Get pre-computed displacement value
  837.     ADD    HL,DE        ; Add displacement to current physical loc
  838.     LD    A,H
  839.     CP    TABLHI        ; And check for looping back to beg of table
  840.     JR    NC,NC93        ; (Branch if no loop)
  841.     LD    DE,5003
  842.     ADD    HL,DE        ; Else 5003 for loop around
  843.  
  844. NC93:    POP    DE
  845.     JP    MTCHL3        ; Repeat to see if this "link" matches
  846. ;
  847. ;.......................................................................
  848. ;
  849. ; All "links" to the hashed entry have been checked and none  of them
  850. ; have matched.  We therefore make a new entry.
  851. ;
  852. EMPTY3:    LD    HL,(TTOTAL)    ; Incr "codes reassigned" ("cr")
  853.     INC    HL
  854.     LD    (TTOTAL),HL
  855.     LD    HL,(AVAIL)    ; Was defined during "Match2" loop
  856.     LD    (LPR),DE    ; Save last entry made for "ugly" detection
  857.     LD    A,B        ;
  858.     LD    (LSUFX),A    ; "lpr" <-- last pred, "lsufx" <-- last suffix
  859.     LD    (HL),D        ; Re-assign the entry. leave it's # alone.
  860.     RIGHT1
  861.     LD    (HL),E        ; Pred (low)
  862.     RIGHT1
  863.     LD    (HL),B        ; Suffix
  864.     JP    SCFRET
  865. ;
  866. ;=======================================================================
  867. ;
  868. ; Insert the pred now in HL into the output stream.
  869. ;
  870. OUTPUT:    PUSH    AF        ; Save caller's "A"
  871.     ADD    HL,HL        ; Must always pre-shift left at least 4 times
  872.     ADD    HL,HL        ; (for case of left justifying 12 bit codes)
  873.     ADD    HL,HL        ; 3 of those are done here.
  874.     LD    A,(CODLE0)    ; Compute number of additional pre-shifts (+1)
  875.     LD    C,A        ; This value is (13 - codelength)
  876.     NEG            ; Also leave code length in "C" for use below
  877.     ADD    A,13        ; (the +1 simply ensures at least one execution
  878.     LD    B,A        ; - of the loop below)
  879.  
  880. ADDHLP:    ADD    HL,HL        ; Additional necessary pre-shifting
  881.     DJNZ    ADDHLP
  882.     LD    A,(CSAVE)    ; Get "leftover" bits from last time
  883.     LD    B,C        ; Put code length, still in "C", in "B"
  884.  
  885. PUTLP1:    ADD    HL,HL        ; Now we start shifting out bits for real
  886.     RLA            ; Bits coming out of "HL" go into "A"
  887.     JR    NC,ENDLP1    ; Skip if not time to dump the contents
  888.     CALL    OUTB        ; Dump when necessary
  889.     LD    A,01H        ; Re-init to flag bit only
  890.  
  891. ENDLP1:    DJNZ    PUTLP1        ; Loop for as many bits as need to be output
  892.     LD    (CSAVE),A    ; Leftover bits get saved here
  893.     LD    A,(CODLEN)    ; "codle0" is always equal to "codlen" delayed
  894.     LD    (CODLE0),A    ; -by one code output call. update here.
  895.     POP    AF        ; Restore callers "A" & return
  896.     RET
  897. ;
  898. ;=======================================================================
  899. ;
  900. ; Subroutine gets a character from the input stream and adds its value
  901. ; to running checksum.
  902. ;
  903. GETC:    CALL    GETCHR        ; Get a character into A
  904.     RET    C        ; Don't add in the garbage char recv'd on eof
  905.     CALL    CKSUM        ; Add it in
  906.     AND    A        ; Guarantee clear carry when no eof
  907.     RET            ; That's it
  908. ;
  909. ;=======================================================================
  910. ;
  911. ; Subroutine to initialize the table to contain the 256 "atomic" entries
  912. ; { "NOPRED", <char> },  for all values of <char> from 0 thru 255.
  913. ;
  914. INITBL:    CALL    PRESET        ; "pre-initializes" the table (mostly zeroes)
  915.     XOR    A        ; Start with 0
  916.  
  917. INITLP:    PUSH    AF
  918.     LD    HL,NOPRED    ; Will stay at this value for all 256 loops
  919.     CALL    ENTERX        ; Make the entry  { hl, a }
  920.     POP    AF
  921.     INC    A        ; Incr the suffix char
  922.     JR    NZ,INITLP    ; Loop 256 times
  923.     LD    HL,IMPRED    ; "impossible pred". Not bumpable or matchable.
  924.     CALL    ENTERX        ; Reserve entries 100h thru 103h
  925.     CALL    ENTERX        ; (namely eof, reset, null & spare)
  926.     CALL    ENTERX
  927.     CALL    ENTERX
  928.     XOR    A        ; Put this back to zero for normal execution
  929.     LD    (FFLAG),A
  930.     RET
  931. ;
  932. ;.......................................................................
  933. ;
  934. ; Low-level pre-preset called from INITBL above
  935. ;
  936. PRESET:    LD    HL,TABLE    ; Beginning of table (1st entry, first column)
  937.     LD    DE,TABLE+1
  938.     LD    A,80H        ; Initialize whole 1st column to empty flags
  939.     LD    BC,1400H
  940.     LD    (HL),A        ; Initialize 1st location
  941.     LDIR            ; And the rest
  942.  
  943.     LD    (HL),0        ; Next 4 x 1400h locs all get zeroes
  944.     LD    BC,4*1400H-1    ; "-1" so we don't go one too far
  945.     LDIR
  946.     RET
  947. ;
  948. ;-----------------------------------------------------------------------
  949. ;
  950. ; Hash subroutine.
  951. ;
  952. ; Notes about the hashing.  The "open-addressing, double hashing" scheme
  953. ; used, where the actual codes output are the logical entry#, contained
  954. ; in the table along with the entry itself, would normally make the
  955. ; codes output independent of the exact hashing scheme used (codes are
  956. ; simply assigned  in order, their physical location is irrelevant).
  957. ; However, with code reassignment implemented, the re-assignments are
  958. ; obviously not made in any particular order and are hash function de-
  959. ; pendent.  Thus the hash function must not be changed.
  960. ;
  961. ; Called with pred in HL (3 nybble quantity) and suffix in A (2 nybbles).
  962. ; Exclusive OR's the upper 2 nybbles of the pred with the suffix for the
  963. ; two least significant nybbles of the result.    The lower nybble of the
  964. ; pred becomes the highest of 3 nybble result.    Adds one to that as well
  965. ; as the table offset, resulting in a usable address, returned in HL.
  966. ; Also compute "DIFF", the secondary hash displacement value, as a nega-
  967. ; tive number.
  968. ;
  969. HASH:    LD    A,B
  970.     LD    E,L        ; Save so low nybble of pred can be used below
  971.     ADD    HL,HL
  972.     ADD    HL,HL
  973.     ADD    HL,HL
  974.     ADD    HL,HL        ; Shift whole pred value left 4 bits
  975.     XOR    H        ; Xor hi-byte of that with suffix
  976.     LD    L,A        ; Goes there as lo-byte of result
  977.     LD    A,E        ; Get pred(lo) saved above
  978.     AND    0FH        ; Want only low nybble of that
  979.     ADD    A,TABLHI    ; Convenient time to add in table offset
  980.     LD    H,A        ; Goes here as hi-byte of result
  981.     INC    HL        ; Except add one. this eliminates poss. of 0.
  982.     PUSH    HL        ; Save hash val for return
  983.     LD    DE,-5003-TABLE    ; Compute displacement value, - (5003-hash)
  984.     ADD    HL,DE        ; (displacement has table offset removed again)
  985.     LD    (DISP),HL    ; Secondary hashing value, a negative number.
  986.     POP    HL        ; Get back orig hash address
  987.     RET            ; And return it
  988. ;
  989. ;-----------------------------------------------------------------------
  990. ;
  991. ; Like "PRNFIL", but send chars to the output stream instead of typing.
  992. ; This routine WILL explicitly output blanks in the filename extension.
  993. ;
  994. OUTFIL:    LD    BC,0C20H    ; B = loop counter, c = blank character
  995.  
  996. CHARL2:    INC    HL        ; Pre-incr pointer
  997.     LD    A,(HL)        ; Get a char
  998.     CP    C        ; Blank?
  999.     JR    Z,SKPTY2    ; Suppress them (but not in the .ext)
  1000.  
  1001. TYPEI2:    CALL    OUTB        ; Send char to the output stream
  1002.  
  1003. SKPTY2:    DEC    B        ; Loop counter
  1004.     RET    Z        ; Return when done
  1005.  
  1006.     LD    A,B        ; Check loop counter
  1007.     CP    4        ; At this point, type a "."
  1008.     JR    NZ,CHARL2
  1009.     LD    A,"."        ; This is also a convenient char to set "C" to
  1010.     LD    C,A        ; A "." cannot be found in an fcb filename
  1011.     JR    TYPEI2        ; Type the ".".  do no incr hl.
  1012. ;
  1013. ;=======================================================================
  1014. ;
  1015. ; Return one "logical" character from the input stream.  The logical in-
  1016. ; put stream consists of the characters from the physical (actual) input
  1017. ; stream after RLL (repeat byte) encoding has been performed.
  1018. ;
  1019. GTLOGC:    PUSH    HL        ; Call "GETLOG" from here if hl must be saved
  1020.     CALL    GETLOG
  1021.     POP    HL
  1022.     RET
  1023. ;
  1024. ;.......................................................................
  1025. ;
  1026. ; Entry here similar to "GTLOGC" (above) except HL is not saved.
  1027. ;
  1028. ; --- Common entry point for all states ---
  1029. ;
  1030. GETLOG:    LD    A,(LIMBO)    ; Last physical character read, hasn't been outputed yet
  1031.     LD    D,A        ; (All states want "limbo" in "d")
  1032.     JP    (IY)        ; Go to the appropriate state
  1033. ;
  1034. ;.......................................................................
  1035. ;
  1036. ; <State 0>  normal state
  1037. ;
  1038. STATE0:    CALL    GETC        ; Get next byte from physical input stream
  1039.     JR    C,EOF        ; Branch if no more data
  1040.     CP    90H
  1041.     JR    Z,IS90H
  1042.     CP    D        ; Compare to last char
  1043.     JR    Z,SWTO1        ; Br if same. will change to <state 1>
  1044.  
  1045. RETURN:    LD    (LIMBO),A    ; Update "limbo" with new byte just read
  1046.     LD    A,D        ; And output the old val of "limbo"
  1047.     AND    A        ; Clear carry flag
  1048.     RET            ; Return, leaving at <state 0>
  1049. ;
  1050. ;...............................
  1051. ;
  1052. SWTO1:    LD    IY,STATE1    ; Set next state to <state 1>
  1053.     RET            ; Need not update "limbo" or ld a, (are same)
  1054. ;
  1055. ;...............................
  1056. ;
  1057. EOFS:    DEC    D        ; (Entry here if "d" contained a count)
  1058.  
  1059.  EOF:    LD    IY,STATEX    ; Set next state to <state x> (spec. eof state)
  1060.     LD    A,D
  1061.     AND    A        ; Return with clear carry one more time
  1062.     RET
  1063. ;
  1064. ;...............................
  1065. ;
  1066. IS90H0:    DEC    D        ; (Entry here if "d" contained a count)
  1067.  
  1068. IS90H:    LD    IY,STA9A    ; Set next state to <state 9a> (spec. 90 state)
  1069.     LD    A,D
  1070.     AND    A
  1071.     RET
  1072. ;
  1073. ;.......................................................................
  1074. ;
  1075. ; <State 1>  A second occurrence of the same character has already been
  1076. ; detected.  So far only one occurrence has been output.
  1077. ;
  1078. STATE1:    CALL    GETC        ; Get new byte from input stream
  1079.     JR    C,EOF
  1080.     CP    90H        ; (repeats of 90h cannot be packed)
  1081.     JR    Z,IS90H
  1082.     CP    D        ; Another repeat (3rd contiguous occurrence)?
  1083.     JR    Z,SWTO2        ; If so, switch to <state 2>
  1084.     LD    IY,STATE0    ; Else switch back to <state 0>
  1085.     JR    RETURN        ; Rest is same as above
  1086. ;
  1087. ;...............................
  1088. ;
  1089. SWTO2:    LD    A,90H        ; Don't get any new input now, but output "90H"
  1090.     LD    IY,STATE2    ; Change to <state 2>
  1091.     RET
  1092. ;
  1093. ;.......................................................................
  1094. ;
  1095. ; <State 2>  Three contiguous occurrences of a byte been detected.  The
  1096. ; byte itself and the  90H have already been output.  Now it is time to
  1097. ; suck up characters (up to 255 of them).
  1098. ;
  1099. STATE2:    LD    E,D        ; Byte to be matched will be kept in e
  1100.     LD    D,3        ; Init d, repeat byte counter, to 3
  1101.  
  1102. RPTLP:    CALL    GETC        ; Get next byte
  1103.     INC    D        ; & incr repeat byte counter
  1104.     JR    C,EOFS        ; Branch on EOF from "GETC" call
  1105.     JR    Z,RETRN3    ; In case of more than 255 contig occurrences
  1106.     CP    90H
  1107.     JR    Z,IS90H0    ; Branch out if 90h is encountered
  1108.     CP    E        ; Still the same?
  1109.     JR    Z,RPTLP        ; Loop if so
  1110. ;
  1111. ;...............................
  1112. ;
  1113. RETRN3:    DEC    D        ; Adjust count
  1114.     LD    IY,STATE3    ; Change to <state 3> (final state)
  1115.     JR    RETURN        ; Rest is same as above
  1116. ;
  1117. ;.......................................................................
  1118. ;
  1119. ; <State 3>  Like State zero, but don't look for a match (because the
  1120. ; last byte output was a count).
  1121. ;
  1122. STATE3:    CALL    GETC        ; Get next character
  1123.     JR    C,EOF        ; Branch on end-of-file
  1124.     CP    90H
  1125.     JR    Z,IS90H        ; Branch if 90h encountered
  1126.     LD    IY,STATE0    ; Next state will be "0"
  1127.     JR    RETURN        ; Rest is same as above
  1128. ;
  1129. ;.......................................................................
  1130. ;
  1131. ; <State 9A>  90H has been encountered, byte before it has been output.
  1132. ; Now output 90H, next output "0".
  1133. ;
  1134. STA9A:
  1135.     LD    A,90H        ; Note this state doesn't get another phys char
  1136.     LD    IY,STA9B    ; Next state will be <state 9b> outputs the "0"
  1137.     AND    A        ; Be sure to return with clr carry flag
  1138.     RET
  1139. ;
  1140. ;.......................................................................
  1141. ;
  1142. ; <State 9B>  90H has been encountered, & 90H has been output. Now output "00"
  1143. ;
  1144. STA9B:    CALL    GETC        ; Get next physical char for "limbo"
  1145.     LD    D,1        ; Will get decr'd and cause a zero output
  1146.     JR    C,EOFS        ; (Branch on end-of-file)
  1147.     CP    90H        ;
  1148.     JR    Z,IS90H0    ; Branch if another 90h is encountered
  1149.     JR    RETRN3        ; Rest is same as above
  1150. ;
  1151. ;.......................................................................
  1152. ;
  1153. ; <State X>  EOF has been encountered, and all bytes have been output.
  1154. ;  Set carry flag and return.
  1155.  
  1156. STATEX:    SCF            ; As described above.
  1157.     RET
  1158. ;
  1159. ;=======================================================================
  1160. ;
  1161. ; "Stamp" processing.
  1162. ;
  1163. PRCSTM:    PUSH    DE        ; Called w/ "HL" pointing to text of "stamp"
  1164.     LD    DE,STAMP    ; Buffer for holding the date stamp or text
  1165.     LD    B,7FH        ; Put a limit on its length
  1166.  
  1167. STMPLP:    LD    A,(HL)        ; Get a character
  1168.     LD    (DE),A        ; Put it in the buffer
  1169.     INC    DE
  1170.     OR    A        ; Zero denotes end of cmnd tail, ending stamp
  1171.     JR    Z,PRCDN1
  1172.     INC    HL
  1173.     SUB    ']'        ; The "proper" way the stamp should end
  1174.     JR    Z,PRCDN2
  1175.     DJNZ    STMPLP        ; Get more chars
  1176.  
  1177. ERR8:    LD    DE,PRSER8    ; Stamp overflow, probably impossible
  1178.     JP    FATALU
  1179.  
  1180. PRCDN1:    POP    DE        ; Come here if null terminated the stamp
  1181.     RET            ; Return with the null in "A" & z set
  1182.  
  1183. PRCDN2:    LD    (DE),A        ; Make sure a null (a has one now) gets here
  1184.  
  1185. NBLP:    LD    A,(HL)        ; Advance to first non-blank after stamp
  1186.     CP    ' '
  1187.     JR    NZ,NBC        ; Branch if we have one
  1188.     INC    HL        ; Else advance
  1189.     DJNZ    NBLP        ; And continue
  1190.     JR    ERR8        ; Overflow error
  1191.  
  1192. NBC:    POP    DE        ; Rtn with "HL" pointing to 1st non-blank char
  1193.     OR    A        ; (Return z stat if that character is null)
  1194.     RET
  1195. ;
  1196. ;.......................................................................
  1197. ;
  1198. ; Flag files matching the "exclusion list"
  1199. ;
  1200. EXCLUD:    LD    BC,12        ; Leave 12 in bc for incrementing ix
  1201.     LD    IX,FNBUFF    ; Points to beg of filenames
  1202.  
  1203. OUTLP:    LD    A,(IX+0)    ; Get flag byte for this entry
  1204.     CP    0FFH        ; Final [non-] entry?
  1205.     RET    Z        ; (return if so)
  1206.     OR    A        ; Is it an untagged filename?
  1207.     JR    Z,NXTFN        ; If so, leave it that way & move to next
  1208.     LD    HL,EXTBL-3    ; Beginning of "exclusion" list
  1209.  
  1210. INRLP0:    INC    HL
  1211.  
  1212. INRLP1:    INC    HL        ; (If HL already incremnted once)
  1213.  
  1214. INRLP2:    INC    HL        ; ( "          "    twice)
  1215.     LD    A,(HL)        ; Get a char from list
  1216.     OR    A        ; End of list?
  1217.     JR    Z,NXTFN        ; If so, move on to next filename in "fnbuff"
  1218.     CP    '?'        ; Wildcard?
  1219.     JR    Z,AUTOM1    ; Yes, automatically matches
  1220.     CP    (IX+9)        ; Else see if it matches first ft char
  1221.     JR    NZ,INRLP0    ; No match, forget it and move to next filename
  1222.  
  1223. AUTOM1:    INC    HL
  1224.     LD    A,(HL)        ; Repeat twice more for other 2 chars
  1225.     CP    '?'
  1226.     JR    Z,AUTOM2
  1227.     CP    (IX+10)
  1228.     JR    NZ,INRLP1
  1229.  
  1230. AUTOM2:    INC    HL
  1231.     LD    A,(HL)        ; As above
  1232.     CP    '?'
  1233.     JR    Z,AUTOM3
  1234.     CP    (IX+11)
  1235.     JR    NZ,INRLP2
  1236.  
  1237. AUTOM3:    LD    A,02H        ; File type matches; flag file as "excluded"
  1238.     LD    (IX+0),A
  1239.  
  1240. NXTFN:    ADD    IX,BC        ; Move to next filename in "fnbuff"
  1241.     JR    OUTLP
  1242. ;
  1243. ;=======================================================================
  1244. ;
  1245. ; All ASCII centralized here as a service to disassembly hobbyists.
  1246. ;
  1247. VUNITS    EQU    (REV/16)+'0'      ; Version, units dig, in ascii
  1248. VTNTHS    EQU    (REV AND 0FH)+'0' ; Version, tenths dig, in ascii
  1249.  
  1250. INTRO:    DB    'GEL Cruncher v',VUNITS,'.',VTNTHS,CR,LF,'$'
  1251. ERR7:    DB    ' [ Can''t crunch .ZZZ files ]$'
  1252. MSGCR:    DB    ' [ Already crunched ] $'
  1253. MSGSQ:    DB    ' [ Already squeezed ] $'
  1254. MSG998:    DB    CR,LF,' [ Result not smaller ] $'
  1255. QUES1:    DB    'Result not smaller. Save anyway? <N>: ',BELL,'$'
  1256. USAGE:    DB    CR,LF,LF,'Usage:',CR,LF,LF
  1257.  
  1258.     DB    '                 Filename       Date, etc.    '
  1259.     DB    'Option letters',CR,LF
  1260.     DB    '                /              /             /',CR,LF
  1261.     DB    'CRUNCH  {du:}<afn>  {du:}  { [id] }  { /<options> }'
  1262.     DB    CR,LF
  1263.     DB    '          \           \               |',CR,LF
  1264.     DB    '           Source      Destination   (space)'
  1265.     DB    CR,LF,LF
  1266.     DB    ' <options> is up to 4 letters immediately following '
  1267.     DB    'a " /".',CR,LF
  1268.     DB    '   "Q" = Quiet mode       "C" = Confirm (tag) mode',
  1269.     DB    CR,LF
  1270.     DB    '   "O" = Overwrite mode   "A" = Archive bit mode',CR,LF
  1271.     DB    ' Option letters toggle (reverse) the corresponding '
  1272.     DB    'default setup.',CR,LF
  1273.     DB    CR,LF
  1274.     DB    ' Both "du:" are of form DU:, UD:, D:, or U:',CR,LF
  1275.     DB    ' "[id]" is date or any text enclosed in "[ ]".',CR,LF
  1276.     DB    CR,LF
  1277.     DB    '  Everything is optional except filename.',CR,LF,'$'
  1278. ;
  1279. ;=======================================================================
  1280. ;
  1281. ; ** Include file begins here **
  1282. ;
  1283.     INCLUDE    COMMON.LIB
  1284. ;
  1285. ; ** Include file ends here **
  1286. ;
  1287. ;=======================================================================
  1288. ;
  1289. ; Additional misc ram locs which need not be initialized, or are init-
  1290. ; ialized by the routines which use them.
  1291. ;
  1292. LIMBO:    DS    1        ; Storage for 1 char in pipeline delay
  1293. AVAIL:    DS    2
  1294. LPR:    DS    2
  1295. LSUFX:    DS    1
  1296. SAVSUF:    DS    1
  1297. FFLAG:    DS    1
  1298. CSAVE:    DS    1
  1299. ;
  1300. ;...............................
  1301. ;
  1302. SAFETY:    DS    16        ; Safety region beyond stack limit check
  1303. ENDPRG    EQU    $        ; (approx bottom of stack)
  1304. ;
  1305. ;_______________________________________________________________________
  1306. ;
  1307. STKSZ    EQU    8        ; Minimum stack size (pages)
  1308. IBUFSZ    EQU    8        ; Input buffer size (pages)
  1309. ;
  1310. ;=======================================================================
  1311. ;
  1312. ; ===> All tables will begin at "MEMPAG", defined at the top of the
  1313. ;      program.  This should be set to a page aligned value i.e., ad-
  1314. ;      dress that ends in "00")  which is ABOVE the end all program and
  1315. ;      data segments.  You may have to do one test link to determine the
  1316. ;      proper value (changing "MEMPAG" will not change the length of the
  1317. ;      segments on the subsequent link).
  1318. ;
  1319. ; "MEMPAG" is defined at the beginning of this program to remind you to
  1320. ; set it properly.  If you set it higher than necessary, there will be
  1321. ; no negative effect other than an increase in the TPA required to run
  1322. ; the program.    If you set it too low, you will be in big trouble.  The
  1323. ; value must be set manually because most linkers cannot resolve an
  1324. ; "and", "shift" or "hi" byte extraction at link time to determine the
  1325. ; page boundary.
  1326. ;
  1327. ;=======================================================================
  1328. ;
  1329. ; "MAXFLS" is  buffer size (in files) for wildcard expansions.    Room for
  1330. ; this many files will be allocated.
  1331. ;
  1332. MAXFLS    EQU    256
  1333.  
  1334. TOPSTK    EQU    MEMPAG+(STKSZ*256) ; Top of stack
  1335. IBUF    EQU    TOPSTK           ; (= beginning of input buffer)
  1336. EIBUF    EQU    IBUF+(IBUFSZ*256)  ; End of input buffer
  1337. TABLE    EQU    EIBUF           ; (= beginning of table)
  1338. EOTBL    EQU    TABLE+(5*20*256)   ; End of table
  1339. FNBUFF    EQU    EOTBL           ; (= beginning of wildcard expansion buffer)
  1340. ENDFNB    EQU    FNBUFF+(12*MAXFLS) ; End of expansion buffer
  1341.  
  1342. STAMP    EQU    ENDFNB           ; File "stamp" buffer ** size temp ***
  1343. ENDALL    EQU    STAMP+100H       ; End of everything, except output buffer
  1344. OBUF    EQU    ENDALL           ; Beginning of dynamically sized output buffer
  1345. ;
  1346. ;-----------------------------------------------------------------------
  1347. ;
  1348. IBUFHI    EQU    HIGH IBUF    ; Input buffear address, high byte (low byte = 0)
  1349. EIBFHI    EQU    HIGH EIBUF    ; End of input buffer address, high byte, likewise
  1350. TABLHI    EQU    HIGH TABLE    ; Beginning of table, high byte, likewise
  1351. ETBLHI    EQU    HIGH EOTBL    ; End of table, high byte, likewise
  1352. EFNBHI    EQU    HIGH ENDFNB    ; End of expansion buffer, likewise
  1353. ENDHI    EQU    HIGH ENDALL    ;
  1354. OBUFHI    EQU    HIGH OBUF    ; Output buffer addrress, high byte likewise
  1355.  
  1356.     END
  1357.