home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / compress / ql40.arc / UNC.LIB < prev    next >
Text File  |  1991-08-11  |  21KB  |  978 lines
  1. ;------------------------------------------------------------------------------
  2. ; unc.asm
  3. ; xlate2 translation of unc.mac to z80mr & z1 format
  4. ; orig    09-09-87
  5. ; rev    11-30-87
  6. ; v2.5    02-14-88
  7. ;
  8. ; QL v2.5 changes: MEMTOP (top of memory) is retreived from previously
  9. ; defined variable "BDOSBASE" rather than reading directly from 0006H.
  10. ; Also, all data has been moved to QL's DSEG data area, where it should be.
  11. ;
  12. ;  unc & uncrel uncrunch module'
  13. ;  original version by steven greenberg.  revised by c.b. falconer
  14. ;  QL specific version re-revised by steven greenberg
  15. ;
  16. ;    copyright (c) 86/11/24 by
  17. ;    steven greenberg  201-670-8724
  18. ;    and c.b. falconer  203-281-1438.
  19. ;    may be reproduced for non-profit use only.
  20.  
  21. ; error codes (0 for no error)
  22.  
  23. VERSION    EQU    1        ; Newer uncrunch version required
  24. ISNOTCR    EQU    2        ; File is not crunched
  25. FOULED    EQU    3        ; File is fouled
  26. MEMORY    EQU    4        ; Memory or stack overflow
  27. OBSLETE    EQU    5        ; "Older uncrunch version required"
  28.  
  29. ; move right n columns, same row
  30.  
  31.      IF    M80
  32. RIGHT     MACRO    N        ; Macro syntax for m80 / z80asm
  33.     LD    A,H
  34.     ADD    A,&N*10H
  35.     LD    H,A
  36.      ENDM
  37.  
  38.      ELSE
  39.  
  40. RIGHT     MACRO    #N        ; Macro syntax for z80mr / z1
  41.     LD    A,H
  42.     ADD    A,#N*10H
  43.     LD    H,A
  44.      ENDM            ; RIGHT
  45.      ENDIF            ; M80
  46.  
  47. SIGREV    EQU    20H        ; Significant revision level
  48. IMPRED    EQU    07FFFH        ; Impossible pred, can never be matched
  49. NOPRED    EQU    0FFFFH        ; No predecessor code
  50. VACANT    EQU    080H        ; Value for a vacant entry
  51. GUARD    EQU    07FH        ; Protect table entry from use
  52. ESCAPE    EQU    090H        ; Repeated byte encoding
  53.  
  54. ; for version 2 algorithm
  55.  
  56. INITW    EQU    9        ; Initial cell width
  57. MAXWIDE    EQU    12        ; Max width of cells
  58. TBLSIZE    EQU    5003
  59.  
  60. ; version 2 special codes
  61.  
  62. EOFCOD    EQU    0100H
  63. RSTCOD    EQU    0101H        ; Adaptive reset signal
  64. NULCOD    EQU    0102H        ; Nop
  65. SPRCOD    EQU    0103H        ; Spare for future use
  66.  
  67. ; Following are lo-bytes of above, expressed in a manner generically accept-
  68. ; able to a variety of assemblers. Eqiv to "LO(x)" or  "x AND 0FFH", etc.
  69.  
  70. LO_EOFCOD EQU    EOFCOD-256*(EOFCOD/256)
  71. LO_RSTCOD EQU    RSTCOD-256*(RSTCOD/256)
  72. LO_NULCOD EQU    NULCOD-256*(NULCOD/256)
  73. LO_SPRCOD EQU    SPRCOD-256*(SPRCOD/256)
  74.  
  75. N01    EQU    1
  76. N02    EQU    2
  77. N08    EQU    8
  78. N0F    EQU    000FH
  79. N10    EQU    0010H
  80. N14    EQU    0014H
  81. N20    EQU    0020H
  82. N28    EQU    0028H
  83. N30    EQU    0030H
  84. NDF    EQU    00DFH
  85. NFE    EQU    00FEH
  86. NFF    EQU    00FFH
  87. T0FFF    EQU    0FFFH
  88. T1000    EQU    1000H
  89. T2000    EQU    2000H
  90. T2800    EQU    2800H
  91. T4000    EQU    4000H
  92.  
  93. ; Various error exits
  94.  
  95. XNOTCR:    LD    A,ISNOTCR
  96.     JR    ERROR
  97.  
  98. XSTKOV:    LD    A,MEMORY
  99.     JR    ERROR
  100.  
  101. XBADF:    LD    A,FOULED
  102.     JR    ERROR
  103.  
  104. XNEWV:    LD    A,VERSION
  105.     JR    ERROR
  106.  
  107. TOOLD:    LD    A,OBSLETE
  108.  
  109. ERROR:    SCF
  110.  
  111. EXIT:    LD    HL,(SPSAVE)
  112.     LD    SP,HL
  113.     RET
  114.  
  115. EXITOK:    XOR    A
  116.     JR    EXIT
  117.  
  118. ; entry here if application has already read the header, and
  119. ; validated the initial id bytes.  this avoids rewinding the file.
  120. ; the next input byte must be the revision level.
  121.  
  122. UNC:    CALL    MALLOC        ; Returns hl = new stack
  123.     JR    C,XSTKOV
  124.     LD    SP,HL        ; Ok, now switch stacks
  125.     JR    UNCRB
  126. ;
  127. ; set up memory allocation.  base pointer in hl
  128. ; carry if insufficient space (stack overflow incipient)
  129.  
  130. MALLOC:    EX    DE,HL
  131.     LD    HL,2        ; Allow for call malloc
  132.     ADD    HL,SP
  133.     LD    (SPSAVE),HL    ; Save return from main
  134.     LD    HL,255
  135.     ADD    HL,DE        ; Round up to page boundary
  136.     LD    L,0
  137.     LD    (@TABLE),HL
  138.     LD    A,N30        ; '0'
  139.     ADD    A,H
  140.     LD    H,A
  141.     LD    (XLATBL),HL    ; For version 2 system
  142.     LD    A,N28        ; '('
  143.     ADD    A,H
  144.     LD    H,A
  145.     PUSH    HL
  146.     CPL
  147.     LD    H,A        ; 4 less bytes than z80 coding
  148.     INC    H        ; L was zero
  149.     LD    (STKLIM),HL
  150.     POP    HL
  151.     LD    A,H
  152.     ADD    A,N08        ; Proposed stack page
  153.     LD    H,A        ; Check stack page a suitable
  154.     LD    L,0
  155.     EX    DE,HL        ; Check memory against memtop
  156.     LD    HL,(BDOSBASE)    ; (was MEMTOP)
  157.     LD    A,H        ; @table thru newstack
  158.     SUB    D        ; (can exit because stack saved)
  159.     RET    C        ; Not enough system memory
  160.     LD    A,(SPSAVE+1)
  161.     LD    HL,(@TABLE)
  162.     CP    H
  163.     JR    C,STKCK1    ; Input stack below table, ok
  164.     LD    H,A        ; Input stack page
  165.     LD    A,D        ; New stack page
  166.     CP    H
  167.  
  168. STKCK1:    CCF
  169.     EX    DE,HL
  170.     RET            ; With carry if stack overflow
  171.  
  172. UNCRB:    CALL    INIT        ; Variables etc
  173.     CALL    GETBYT        ; Ignore revision level
  174.     CALL    GETBYT        ; Significant revision level
  175.     PUSH    AF
  176.     CALL    GETBYT        ; Ignore checksum flag
  177.     CALL    GETBYT        ; And spare byte
  178.     POP    AF
  179.     CP    SIGREV+1
  180.     JR    NC,XNEWV    ; Need newer version
  181.     CP    SIGREV
  182.     JR    NC,UNCRC    ; Ver 20 uncrunching
  183.  
  184. ; ver 10 uncrunching
  185.  
  186.      IF    VER1        ;
  187.     CALL    UNC1I
  188.     JR    UNC1
  189.      ELSE            ; Not ver1
  190.     JR    TOOLD        ; (ie ver1 types not supported, rtn w/ error)
  191.      ENDIF            ; Not ver1
  192.  
  193. UNCRC:    CALL    UNC2I        ; Ver. 2, initialize tables
  194.     JR    UNC2
  195.  
  196.      IF    VER1
  197. ; version 10 uncrunching initialize. returns de := nopred
  198.  
  199. UNC1I:    LD    HL,T0FFF
  200.     LD    (TROOM),HL
  201.     CALL    CLRMEM
  202.     LD    A,12
  203.     LD    (WIDTH),A    ; Ver 10 tokens are 12 bits
  204.     XOR    A
  205.     LD    (KIND),A    ; 0 for version 10 operation
  206.  
  207.      ENDIF            ; Ver1
  208.  
  209. ; initialize atomic entries. set de := nopred
  210.  
  211. ATOMS:    XOR    A
  212.     LD    HL,NOPRED
  213.  
  214. ATOMS1:    PUSH    AF
  215.     PUSH    HL
  216.     CALL    ENTERX        ; Make entry { hl, a }
  217.     POP    HL
  218.     POP    AF
  219.     INC    A
  220.     JR    NZ,ATOMS1
  221.     EX    DE,HL        ; De := nopred
  222.     RET
  223.     
  224. ; version 20 setup.  returns de := nopred
  225.  
  226. UNC2I:    CALL    CLRTBL
  227.     LD    A,1
  228.     LD    (KIND),A    ; Version 20 signal
  229.     LD    A,N20        ; Force non-bumpable atomic entries
  230.     LD    (FFFLAG),A
  231.     CALL    ATOMS        ; Init atomic entries
  232.     LD    B,LO_SPRCOD+1    ;
  233.  
  234. UNC2I2:    PUSH    BC
  235.     LD    HL,IMPRED    ; Impossible pred
  236.     XOR    A
  237.     CALL    ENTERX        ; Reserve eof thru sprcod
  238.     POP    BC        ; Unmatchable and unbumpable
  239.     DEC    B
  240.     JR    NZ,UNC2I2    ;
  241.     XOR    A
  242.     LD    (FFFLAG),A    ; Reset flag
  243.     LD    H,A
  244.     LD    L,A
  245.     LD    (TROOM),HL    ; Re-used as re-assignment counter
  246.     LD    DE,NOPRED
  247.     RET
  248.  
  249.      IF    VER1
  250.  
  251. ; ver 10 uncrunching loop
  252.  
  253. UNC1:
  254.     EX    DE,HL
  255.     LD    (LASTPR),HL
  256.     CALL    GETOK        ; New 12 bit code to de
  257.     JP    C,EXITOK    ; Eof or eof node
  258.     PUSH    DE
  259.     CALL    DECODE
  260.     LD    HL,ENTFLG
  261.     LD    A,(HL)
  262.     LD    (HL),0
  263.     OR    A
  264.     CALL    Z,ENTLAST    ; Make new table entry if not done
  265.     POP    DE
  266.     LD    A,(FULFLG)
  267.     OR    A
  268.     JR    Z,UNC1        ; Continue
  269.  
  270. ; speed up when table full, no more entries need be made/checked
  271.  
  272. UNC1B:    CALL    GETOK
  273.     JP    C,EXITOK
  274.     PUSH    DE
  275.     CALL    DECODE
  276.     POP    DE
  277.     JR    UNC1B        ; Continue
  278.     
  279.      ENDIF            ; Ver1
  280.  
  281. ; version 2 uncrunching
  282.  
  283. UNC2:    EX    DE,HL
  284.     LD    (LASTPR),HL
  285.     CALL    GETKN
  286.     JR    C,UNC2C        ; Eof or reset etc.
  287.     PUSH    DE
  288.     CALL    DECODE
  289.     LD    HL,ENTFLG
  290.     LD    A,(HL)
  291.     LD    (HL),0
  292.     OR    A
  293.     CALL    Z,ENTLAST    ; If not made, then make entry
  294.     POP    DE
  295.     LD    A,(FULFLG)
  296.     OR    A
  297.     JR    Z,UNC2        ; Adaptive system reset
  298.     CP    NFE        ; When this becomes 0ffh all done. first
  299.     JR    NZ,UNC2B    ; It becomes 0feh, when one more loop
  300.     INC    A        ; Is required, and set it to 0ffh.
  301.     LD    (FULFLG),A
  302.     JR    UNC2        ; Do the extra loop
  303.  
  304. ; table is full.  no new entries needed
  305.  
  306. UNC2B:    EX    DE,HL
  307.     LD    (LASTPR),HL
  308.     CALL    GETKN
  309.     JR    C,UNC2C        ; Eof etc
  310.     PUSH    DE
  311.     CALL    DECODE
  312.     LD    HL,(LASTPR)
  313.     LD    A,(CHAR)
  314.     CALL    RECOD        ; Check for code re-assignment
  315.     POP    DE
  316.     JR    UNC2B
  317.  
  318. ; here for input codes in range 100h..103h (eof..sprcod).
  319.  
  320. UNC2C:    LD    A,E        ; Special code, (eof or adaptive reset)
  321.     CP    LO_EOFCOD
  322.     JP    Z,EXITOK    ; Done
  323.     CP    LO_RSTCOD
  324.     JP    NZ,XNOTCR
  325.  
  326. ; adaptive reset
  327.  
  328.     XOR    A
  329.     LD    H,A
  330.     LD    L,A
  331.     LD    (CODES),HL    ; Init current code to 0
  332.     LD    (FULFLG),A    ; Clear
  333.     CALL    UNC2I
  334.     LD    A,INITW
  335.     LD    (WIDTH),A    ; Reset input code width
  336.     LD    A,N02
  337.     LD    (TRGMSK),A
  338.     LD    A,N01
  339.     LD    (ENTFLG),A    ; 1st entry always a special case
  340.     JR    UNC2
  341.  
  342. ; var b : byte; (* global *)
  343. ;
  344. ; procedure decode(x : index);
  345. ;
  346. ;   var ix : index;    (* index is a record *)
  347. ;
  348. ;   begin (* decode *)
  349. ;   ix := lookup(x);
  350. ;   if ix.pred = nil then enter(x, b);
  351. ;   if ix.pred = nopred then b := ix.byte
  352. ;   else decode(ix.pred);
  353. ;   send(ix.byte);
  354. ;   end; (* decode *)
  355. ;
  356. ; the char associated with the bottomost recursion level is saved in
  357. ; "char" and is used later to make the next table entry.
  358. ;
  359. ; the code at "ugly" has to do with a peculiar string sequence where
  360. ; the encode "knows" about a string before the decoder so the decoder
  361. ; has to make an emergency entry.  fortunately there is enough inform-
  362. ; ation available to do this.  it has been shown that this case is
  363. ; unique and that the assumptions are valid.  to understand the lzw
  364. ; algorithm the "ugly" code may be ignored.
  365. ;
  366. ; universal decoder
  367. ; a,f,b,c,d,e,h,l
  368.  
  369. DECODE:    LD    A,(KIND)
  370.     OR    A
  371.     JR    Z,DCDA        ; Version 1, no setup needed
  372.     PUSH    DE
  373.     EX    DE,HL
  374.     LD    A,(@TABLE+1)
  375.     ADD    A,H
  376.     LD    H,A        ; Convert code to table adr.
  377.     LD    A,(HL)
  378.     OR    020H        ; Mark referenced (not bumpable)
  379.     LD    (HL),A
  380.     POP    DE
  381.  
  382. ; decode/output the index in de. recursive
  383. ; a,f,b,c,d,e,h,l
  384.  
  385. DCDA:    LD    HL,(STKLIM)
  386.     ADD    HL,SP
  387.     JP    NC,XSTKOV    ; Stack overflow
  388.     LD    A,(@TABLE+1)    ; Convert index de to address hl
  389.     ADD    A,D
  390.     LD    H,A
  391.     LD    L,E
  392.     LD    A,(HL)
  393.     AND    NDF        ; (for 2 only)
  394.     CP    VACANT
  395.     JR    NZ,DCDA1    ; Not vacant, normal case
  396.  
  397. ; the "ugly" exception.  term due to k. williams
  398.  
  399.     LD    A,N01
  400.     LD    (ENTFLG),A
  401.     PUSH    HL
  402.     LD    A,N20        ; (for 2 only)
  403.     LD    (FFFLAG),A
  404.     CALL    ENTLAST        ; Make emergency entry
  405.     XOR    A
  406.     LD    (FFFLAG),A    ; (for 2 only)
  407.     POP    HL
  408.     LD    A,(HL)
  409.     CP    VACANT
  410.     JP    Z,XBADF        ; If vacant file is invalid
  411.  
  412. DCDA1:    LD    D,(HL)        ; Get "pred" (hi)
  413.     RIGHT    1        ; Move to "pred" (lo)
  414.     LD    E,(HL)        ; Get it. if msb of hi byte is set value
  415.     LD    A,D        ; Must be ff (nopred) because not 80h
  416.     AND    0DFH        ; ~20h
  417.     JP    M,DECODX    ; Nopred, terminate recursion
  418.     LD    D,A        ; (for 2, remove any accessed flag)
  419.     PUSH    HL
  420.     CALL    DCDA        ; Recursive
  421.     POP    HL
  422.     RIGHT    1        ; Move ahead to "suffix" byte
  423.     LD    A,(HL)
  424.     JR    SEND        ; Output suffix byte & exit
  425.  
  426. ; exit from decoding recursion.  unloads all the stacked items.
  427.  
  428. DECODX:    RIGHT    1        ; Move ahead to "suffix" byte
  429.     LD    A,(HL)        ; Get & save as 1st char of decoded
  430.     LD    (CHAR),A    ; String.  used later to make a new
  431.                 ; Table entry.    send & exit
  432.  
  433. ; send char with repeat expansion etc.
  434. ; a,f,b,c,h,l
  435.  
  436. SEND:    LD    C,A        ; Output char
  437.     LD    HL,(OUTFLG)
  438.     INC    H
  439.     DEC    H
  440.     JR    NZ,SEND2    ; Repeat flag set
  441.     CP    ESCAPE
  442.     JR    Z,SEND1        ; Escape char, set flag
  443.     LD    L,A        ; Save char for possible repeat coming
  444.     DEC    H        ; Cancel coming inr, not repeat
  445.     CALL    OUT
  446.  
  447. SEND1:    INC    H        ; Set repeat flag
  448.     LD    (OUTFLG),HL
  449.     RET
  450.  
  451. SEND2:    LD    H,0        ; Clear repeat flag
  452.     LD    (OUTFLG),HL    ; Save result (with l = repeat char)
  453.     OR    A
  454.     JR    Z,SEND4        ; Escape 0 represents escape
  455.     DEC    A
  456.     RET    Z        ; Take care of repeat = 1
  457.     LD    H,A        ; Set repeat count
  458.     LD    A,L        ; Repeaat char
  459.  
  460. SEND3:    CALL    OUT
  461.     DEC    H
  462.     JR    NZ,SEND3
  463.     RET
  464.  
  465. SEND4:    LD    A,ESCAPE
  466.     JP    OUT
  467.  
  468. ; enter lastpr/char into table
  469. ; a,f,b,c,d,e,h,l
  470.  
  471. ENTLAST:
  472.     LD    HL,(LASTPR)
  473.     LD    A,(CHAR)
  474.  
  475. ; enter { <pred>, <suffix> } into table, passed in {hl, a} regs.
  476. ; a,f,b,c,d,e,h,l
  477.  
  478. ENTERX:
  479.     LD    B,A
  480.     LD    A,(KIND)
  481.     OR    A
  482.     LD    A,B
  483.     JR    NZ,ENT2X    ; Version 2 decoding
  484.  
  485.      IF    VER1
  486.  
  487. ; else ...  version 1 decoding
  488. ; enter { <pred>, <suffix> } into table, passed in {hl, a} regs.
  489. ; a,f,b,c,d,e,h,l
  490.  
  491. ENT1X:    PUSH    AF
  492.     PUSH    HL
  493.     CALL    MIDSQ        ; Hash index into al
  494.     LD    H,A
  495.     LD    A,(@TABLE+1)    ; Page address
  496.     ADD    A,H
  497.     LD    H,A        ; Into address
  498.     POP    DE        ; Pred
  499.     POP    AF        ; Suffix
  500.     LD    C,A
  501.  
  502. ENT1X1:    LD    B,H        ; Check for match
  503.     LD    A,(HL)
  504.     CP    VACANT
  505.     JR    Z,ENT1X3    ; Entry does not exist, make it
  506.     RIGHT    3        ; Move to link column
  507.     LD    A,(HL)        ; Link(hi)
  508.     OR    A
  509.     JR    Z,ENT1X2    ; No link
  510.     LD    B,A        ; Save
  511.     RIGHT    1        ; Move to link(lo) field
  512.     LD    L,(HL)
  513.     LD    H,B        ; Hl := link address
  514.     JR    ENT1X1        ; And repeat
  515.  
  516. ENT1X2:    LD    H,B        ; Restore h to left hand column
  517.     CALL    FFREE        ; Find new spot and link in. returns
  518.  
  519. ; HL pointing to new entry.
  520.  
  521. ENT1X3:    CALL    LINK        ; Make the entry.  pred(hi)
  522.     RIGHT    1
  523.     LD    (HL),C        ; Suffix
  524.     LD    HL,(TROOM)
  525.     DEC    HL
  526.     LD    (TROOM),HL
  527.     LD    A,H
  528.     OR    L
  529.     RET    NZ        ; Not full
  530.     DEC    A
  531.     LD    (FULFLG),A    ; Else set full flag
  532.     RET
  533.     
  534.      ENDIF            ; Ver1
  535.  
  536. ; link entry de at location hl^
  537.  
  538. LINK:    LD    (HL),D        ; High
  539.     RIGHT    1
  540.     LD    (HL),E        ; Lo
  541.     RET
  542.     
  543. ; version 2 table entry
  544.  
  545. ENT2X:    PUSH    AF
  546.     PUSH    HL
  547.     CALL    TBLADR        ; To physical loc only, affects nothing
  548.     POP    DE        ; And check width etc??
  549.     LD    HL,(CODES)
  550.     LD    A,(@TABLE+1)
  551.     ADD    A,H
  552.     LD    H,A        ; Convert to address
  553.  
  554. ; entry is made here, but normally flagged as "unreferenced" (until
  555. ; received by decode).    until then entries are "bumpable".  if ffflag
  556. ; is 020h the reference is flagged now, to protect atomic entries and
  557. ; wswsw string emergency entries (from decode, despite not received)
  558.  
  559.     LD    A,(FFFLAG)
  560.     OR    D        ; May set "referenced" bit
  561.     LD    (HL),A        ; Pred(hi)
  562.     RIGHT    1
  563.     LD    (HL),E        ; Pred(lo)
  564.     RIGHT    1
  565.     POP    AF
  566.     LD    (HL),A        ; Suffix
  567.     LD    HL,(CODES)    ; Advance entry counter
  568.     INC    HL
  569.     LD    (CODES),HL
  570.     INC    HL        ; Allow for crunch/uncrunch skew delay
  571.     LD    A,(TRGMSK)    ; See if new code length needed
  572.     CP    H
  573.     RET    NZ
  574.     RLA            ; Carry was clear.  change to new length
  575.     LD    (TRGMSK),A    ; New target mask
  576.     LD    A,(WIDTH)
  577.     INC    A
  578.     CP    MAXWIDE+1
  579.     JR    Z,ENT2X1    ; Mark table full
  580.     LD    (WIDTH),A    ; Advance to new width
  581.     RET
  582.  
  583. ENT2X1:    LD    A,NFE        ; Mark table full, at max width
  584.     LD    (FULFLG),A
  585.     RET
  586.  
  587. CLRMEM:    LD    HL,(@TABLE)
  588.     LD    (HL),GUARD    ; Disallow entry #0
  589.     INC    HL        ; (used, but unmatchable)
  590.     LD    E,VACANT
  591.     LD    BC,T1000    ; Mark entries vacant
  592.     CALL    FILL
  593.     LD    BC,T4000
  594.  
  595. ; fill hl^ for bc with zero
  596.  
  597. FILLZ:    LD    E,0
  598.  
  599. ; fill hl^ for bc with e
  600.  
  601. FILL:    LD    (HL),E
  602.     INC    HL
  603.     DEC    BC
  604.     LD    A,B
  605.     OR    C
  606.     JR    NZ,FILL
  607.     RET
  608.  
  609.      IF    VER1
  610.  
  611. ; find a free entry in the event of a hash collision.  algorithm is to
  612. ; first add 101 (decimal) to the current (end-of-chain) entry.    if
  613. ; that entry is not free keep adding 1.  when a free entry is found
  614. ; the link pointer of the original entry is set to the found entry.
  615.  
  616. ; called with adr of an entry in hl, returns hl = adr of new entry.
  617. ; a,f,h,l
  618.  
  619. FFREE:    PUSH    BC
  620.     PUSH    DE
  621.     PUSH    HL        ; Save pointer to old entry for update
  622.     LD    A,L
  623.     ADD    A,101        ; Relatively prime to table size
  624.     LD    L,A
  625.     JR    NC,FFREE1    ; No carry, thus no wrap
  626.     INC    H
  627.     LD    A,(@TABLE+1)
  628.     ADD    A,N10
  629.     CP    H
  630.     JR    NZ,FFREE1    ; No wrap-around
  631.     LD    A,(@TABLE+1)    ; Set to table bottom
  632.     LD    H,A
  633.  
  634. FFREE1:    LD    A,(@TABLE+1)    ; Compute # of remaining entries,
  635.     ADD    A,N0F        ; Counting up (last entry + 1
  636.     SUB    H        ; - current entry)
  637.     LD    B,A
  638.     LD    A,L        ; As far as the low byte is concerned
  639.     CPL            ; We know we are subtracting from 0.
  640.     INC    A
  641.     JR    NZ,FFREE2
  642.     INC    B
  643.  
  644. FFREE2:    LD    C,A        ; Result in bc
  645.     LD    D,H        ; Keep copy
  646.     LD    E,L
  647.     CALL    CMPM        ; Search for empty entry
  648.     JR    NC,FFREE3    ; Found vacant entry
  649.     LD    HL,(@TABLE)    ; Else wrap to start of table
  650.     LD    A,(@TABLE+1)
  651.     LD    B,A
  652.     LD    A,D
  653.     SUB    B        ; (adr to index# conversion)
  654.     LD    B,A
  655.     LD    C,E        ; Target value
  656.     CALL    CMPM        ; Continue search
  657.     JP    C,XNOTCR    ; Not found.  should not occur
  658.  
  659. FFREE3:    EX    DE,HL
  660.     POP    HL        ; Original pointer to link
  661.     RIGHT    3        ; Move to link(hi) field
  662.     CALL    LINK        ; Link to new entry
  663.     EX    DE,HL        ; Returned in hl
  664.     POP    DE
  665.     POP    BC
  666.     RET
  667.  
  668. ; search for vacant entry from hl^ up. carry if not found
  669. ; carry clear if found when hl points to found entry
  670. ; a,f,b,c,h,l
  671.  
  672. CMPM:    LD    A,(HL)
  673.     CP    VACANT
  674.     RET    Z
  675.     INC    HL
  676.     DEC    BC
  677.     LD    A,B
  678.     OR    C
  679.     JR    NZ,CMPM
  680.     SCF            ; Signal not found
  681.     RET
  682. ;..............................................................................
  683. ;
  684. ; return the mid-square of number of "pred" + "suffix" (actually the
  685. ; mid-square of # or 0800h). entry a = suffix, hl = pred.  returns
  686. ; result in a|l (not hl), ready to add a table offset.
  687. ;
  688. ; mid-square means the midddle n bits of the square of an n-bit num.
  689. ; here n is 12.  results accumulate in a 16 bit register, with
  690. ; extraneous information overflowing off both ends of the register.
  691. ;
  692. ; hash via mid-square of 12 bit input or'd with 800h.
  693. ; input is hl + a.  output in al registers.
  694. ; note anomalous results for input out of range.  special handling
  695. ; since really needs to operate on 13 bit words to match the original.
  696. ; the algorithm is due to robert a. freed.  this runs on 8080s, takes
  697. ; the identical code space as mr. freeds z80 implementation, and has
  698. ; miniscule or no average performance penalty.    by c.b. falconer.
  699. ;
  700. ; entry: a = suffix; hl = pred.  exit al = midsq
  701. ; a,f,b,c,d,e,h,l
  702.  
  703. MIDSQ:    ADD    A,L        ; Hl := hl + a
  704.     LD    L,A        ; Max result fffh+0ffh=010feh
  705.     ADC    A,H        ; (normal, except special case)
  706.     SUB    L
  707.     LD    D,A        ; Save for special test
  708.     OR    8        ; Or with 800h.  max 18feh
  709.  
  710. ; following should be 0fh, but modified to agree with original
  711.  
  712.     AND    1FH        ; Mask to 13 bits. max 1fffh
  713.     RRA
  714.     LD    H,A        ; Max 7ffh
  715.     LD    B,A        ; M := bc := hl := input div 2
  716.     LD    A,L        ; Using n*n = 4 * (m * m)     (n even)
  717.     RRA            ; Or          4 * m * (m+1)+1 (n odd)
  718.     LD    L,A        ; And any final "1" gets discarded.
  719.     LD    C,A
  720.     JR    NC,MIDSQ1    ; Even, use m
  721.     INC    HL        ; Hl := m+1
  722.  
  723. ; special case test, input = 0ffffh+0 must hash to 800h
  724. ; from initial 1 byte string prefix = nopred, suffix = 0.
  725.     LD    A,D
  726.     OR    A        ; Did input have high bit?
  727.     LD    A,H        ; Holds 800h in this case
  728.     RRA            ; Because using 13, not 12 bits
  729.     RET    M        ; Yes, return 0800h
  730.  
  731. ; multiplication. hl := bc * hl (12 lo bits of hl only)
  732.  
  733. MIDSQ1:    LD    A,12        ; Bits in m * m' multiplication
  734.     ADD    HL,HL
  735.     ADD    HL,HL        ; Reposition multiplier
  736.     ADD    HL,HL
  737.     ADD    HL,HL        ; Using 12, not 16 bit multiply
  738.     EX    DE,HL        ; Multiplier to de
  739.     LD    L,0        ; Clear necessary portion
  740.  
  741. MIDSQ2:    ADD    HL,HL        ; Left shift accum. main loop.
  742.     EX    DE,HL        ; Discarding overflow past 16 bits
  743.     ADD    HL,HL        ; Left shift multiplier
  744.     EX    DE,HL
  745.     JR    NC,MIDSQ3    ; Multiplier bit = 0
  746.     ADD    HL,BC        ; =1, add in
  747.  
  748. MIDSQ3:    DEC    A
  749.     JR    NZ,MIDSQ2    ; More bits
  750.     ADD    HL,HL        ; Reposition 12 bit result
  751.     RLA
  752.     ADD    HL,HL        ; Shift 4 bits to a
  753.     RLA
  754.     ADD    HL,HL
  755.     RLA
  756.     ADD    HL,HL
  757.     RLA
  758.     LD    L,H        ; Move down low 8 bits of result
  759.     AND    0FH        ; Mask off. result in a & l
  760.     RET
  761.     
  762.      ENDIF            ; Ver1
  763.  
  764. ; get input token, variable width.  check nops etc
  765. ; carry for eof
  766. ; a,f,b,c,d,e
  767.  
  768. GETKN:    CALL    GETOK
  769.     LD    A,D
  770.     DEC    A
  771.     AND    A        ; Clear any carry
  772.     RET    NZ        ; Code not 01xx
  773.     LD    A,E
  774.     CP    LO_SPRCOD+1    ; Codes used
  775.     RET    NC
  776.     CP    LO_NULCOD    ; Lo byte of "nulcod"
  777.     JR    NC,GETKN    ; Ignore null and spare codes, nop
  778.     RET            ; Must be rstcod or eof, cy set
  779.  
  780. ; get input token, variable width
  781. ; a,f,b,c,d,e
  782.  
  783. GETOK:    LD    DE,0
  784.     LD    A,(WIDTH)
  785.     LD    B,A
  786.     LD    A,(LFTOVR)
  787.     LD    C,A
  788.  
  789. GETOK1:    LD    A,C
  790.     ADD    A,A        ; Bit to cy, flags on remainder
  791.     CALL    Z,MOREIN    ; Lftovr was empty, get more
  792.     LD    C,A        ; And keep the remainder
  793.     LD    A,E
  794.     RLA
  795.     LD    E,A        ; Shift into de
  796.     LD    A,D
  797.     RLA
  798.     LD    D,A
  799.     DEC    B
  800.     JR    NZ,GETOK1    ; More bits to unpack
  801.     LD    A,C
  802.     LD    (LFTOVR),A    ; Save any remainder
  803.     LD    A,D
  804.     OR    E
  805.     RET    NZ
  806.     SCF            ; Carry for 0 value (eof)
  807.     RET
  808.  
  809. ; subroutine for getok.  next input byte positioned etc.
  810.  
  811. MOREIN:    CALL    GETBYT
  812.     SCF
  813.     RLA            ; Bit to carry, set end marker
  814.     RET
  815.  
  816. ; clear version 2 tables ??
  817.  
  818. CLRTBL:    LD    HL,(@TABLE)    ; 4096 rows * 3 cols, main table
  819.     LD    BC,T1000
  820.     LD    E,VACANT
  821.     CALL    FILL
  822.     LD    BC,T2000
  823.     CALL    FILLZ
  824.     LD    HL,(XLATBL)    ; Physical to logical translation table
  825.     LD    (HL),GUARD
  826.     INC    HL
  827.     LD    BC,T2800    ; 1400h * 2 entries
  828.     LD    E,VACANT
  829.     JP    FILL
  830.  
  831. ; figure out what physical loc'n the cruncher put its entry at by
  832. ; reproducing the hashing process.  insert the entry # into the
  833. ; corresponding physical location in xlatbl.
  834.  
  835. TBLADR:    LD    B,A
  836.     CALL    HASH        ; To hl
  837.  
  838. TBLAD1:    LD    C,H
  839.     LD    A,(HL)
  840.     CP    VACANT
  841.     JR    Z,TBLAD2    ; No entry, make it
  842.     CALL    REHASH
  843.     JR    TBLAD1
  844.  
  845. TBLAD2:    EX    DE,HL
  846.     LD    HL,(CODES)    ; Logical entry #
  847.     EX    DE,HL
  848.     LD    (HL),D
  849.     LD    A,H        ; Right 1 for this table
  850.     ADD    A,N14
  851.     LD    H,A
  852.     LD    (HL),E
  853.     LD    A,(XLATBL+1)
  854.     LD    H,A
  855.     LD    A,C
  856.     SUB    H
  857.     LD    H,A
  858.     RET
  859.  
  860. ; rehash
  861.  
  862. REHASH:    EX    DE,HL
  863.     LD    HL,(NEXTX)    ; Displacement from hash
  864.     ADD    HL,DE
  865.     LD    A,(XLATBL+1)    ; Page address
  866.     LD    D,A
  867.     LD    A,H
  868.     CP    D
  869.     RET    NC
  870.     LD    DE,TBLSIZE
  871.     ADD    HL,DE
  872.     RET
  873.  
  874. ; check for code reassignment?
  875.  
  876. RECOD:    LD    B,A
  877.     LD    A,NFF
  878.     LD    (AVAIL+1),A
  879.     LD    A,B
  880.     CALL    HASH        ; To hl
  881.  
  882. RECOD1:    LD    C,H
  883.     LD    A,(HL)
  884.     CP    VACANT
  885.     JR    Z,RECOD4    ; End chain. try make entry (elsewhere)
  886.     LD    A,(AVAIL+1)
  887.     CP    NFF
  888.     JR    NZ,RECOD3    ; Have an entry
  889.     PUSH    HL        ; Physical table pointer
  890.     LD    D,(HL)        ; Entry # (hi)
  891.     LD    A,H
  892.     ADD    A,N14        ; Right 1
  893.     LD    H,A
  894.     LD    L,(HL)        ; Entry # (lo)
  895.     LD    A,(@TABLE+1)    ; Convert to addres
  896.     ADD    A,D
  897.     LD    H,A
  898.     LD    A,(HL)
  899.     AND    020H
  900.     JR    NZ,RECOD2    ; Not bumpable, try next
  901.     LD    (AVAIL),HL    ; Save resulting entry # for later use
  902.  
  903. RECOD2:    POP    HL
  904.  
  905. RECOD3:    CALL    REHASH        ; To next link in chain
  906.     JR    RECOD1
  907.  
  908. RECOD4:    LD    HL,(AVAIL)    ; Reassign the entry pointed to by avail
  909.     LD    A,H        ; (if any), redefine "last pred entrd"
  910.     CP    NFF        ; And "last suffix" vars.
  911.     RET    Z        ; None available
  912.     EX    DE,HL
  913.     LD    HL,(TROOM)
  914.     INC    HL
  915.     LD    (TROOM),HL    ; Keep track of codes re-assigned
  916.     LD    HL,(LASTPR)
  917.     EX    DE,HL
  918.     LD    A,(CHAR)
  919.     LD    B,A
  920.     CALL    LINK
  921.     RIGHT    1
  922.     LD    (HL),B
  923.  
  924. HASH:    LD    E,L
  925.     ADD    HL,HL
  926.     ADD    HL,HL
  927.     ADD    HL,HL
  928.     ADD    HL,HL
  929.     XOR    H
  930.     LD    L,A
  931.     LD    A,E
  932.     AND    N0F
  933.     LD    H,A
  934.     LD    A,(XLATBL+1)    ; Add in table offset
  935.     ADD    A,H
  936.     LD    H,A
  937.     INC    HL        ; Eliminate 0 case
  938.     PUSH    HL
  939.     EX    DE,HL
  940.     LD    HL,(TBLTOP)
  941.     ADD    HL,DE        ; Make index dependant, not address
  942.     LD    (NEXTX),HL    ; Rehash value, -ve no.
  943.     POP    HL
  944.     RET
  945.  
  946. ; initialize variables, pointers, limits
  947.  
  948. INIT:    LD    HL,(XLATBL)    ; Hi byte is 0
  949.     LD    DE,-TBLSIZE
  950.     LD    A,E
  951.     SUB    L
  952.     LD    L,A
  953.     LD    A,D
  954.     SBC    A,H
  955.     LD    H,A
  956.     LD    (TBLTOP),HL    ; -(xlatbl + tblsize)
  957.     LD    HL,ITABLE
  958.     LD    DE,FULFLG    ; Copy the "shadow"
  959.     LD    BC,ITBSIZE
  960.     LDIR
  961.     RET
  962.  
  963. ; initializing table ("shadow") for data area
  964.  
  965. ITABLE:    DEFB    0
  966.     DEFW    NOPRED
  967.     DEFB    1
  968.     DEFW    0
  969.     DEFB    VACANT
  970.     DEFB    INITW        ; Initial cell width
  971.     DEFB    2
  972.     DEFW    0
  973. ITBSIZE    EQU    $-ITABLE
  974.  
  975. ;    end of    UNC.ASM include file
  976. ;
  977. ;------------------------------------------------------------------------------
  978.