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