home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / f / lbrhlp22.lbr / LH-UNCR.LZB / LH-UNCR.LIB
Text File  |  1992-05-09  |  21KB  |  646 lines
  1. ;========================================================================
  2. ;
  3. ; LH-UNCR.LIB (formerly LBRHLP5.LIB)
  4. ;    Uncrunch routines for LBRHLP
  5. ;
  6. uncrel:
  7.     call    intram        ; init all necessary ram locs
  8.     ld    (stksav),sp
  9.     ld    sp,(topstk)
  10.     call    getchr        ; get a char from the input stream
  11.     cp    76h        ; check for crunched file header "76fe"
  12.     jr    nz,ncrnch    ; br if not
  13.     call    getchr        ;
  14.     cp    0feh        ;
  15.     jr    z,ycrnch    ;
  16.  
  17. ncrnch:
  18.     ld    a,2        ; invalid version
  19.     jr    mainrtn        ; skip file and continue
  20. stkovf:
  21.     ld    a,4
  22.     jr    mainrtn
  23. oldtyp:
  24.     ld    a,1        ; newer revision of this program needed
  25.     jr    mainrtn
  26. uneof:
  27.     ld    a,5
  28.     jr    mainrtn
  29. fatbad:
  30.     ld    a,3
  31. mainrtn:
  32.     scf
  33. mrtn2:
  34.     ld    sp,(stksav)
  35.     ret
  36. retccp:
  37.     xor    a
  38.     jr    mrtn2
  39. ycrnch:
  40.     call    getchr        ; get next char
  41.     or    a        ; a zero byte indicates end of filename
  42.     jr    nz,ycrnch
  43.                 ;
  44.     call    getchr        ; loop absorbs extraneous header info
  45.     call    getchr        ; get a char
  46.     push    af
  47.     call    getchr        ; get revision level, do nothing with it
  48.     call    getchr        ; get significant revision level
  49.     pop    af
  50.     cp    sigrev        ; compare to this prog
  51.     jr    c,oldtyp    ; br if old type1x crunched file
  52.     jr    nz,ncrnch    ; if equal, ok, else...
  53.  
  54. sigok:
  55.     call    initb2        ; initialize the lzw table
  56.     exx            ; switch to alt regs
  57.     ld    bc,0        ; init repeat flag register
  58.     exx
  59.     ld    de,nopred    ; init to "nopred" (null value)
  60. ;______________________________________________________________________________
  61. ;
  62. ;        *** main decoding loop(s). ***
  63. ;
  64. mainlp:    ld    (lastpr),de    ; always keep a copy of the last "pred" here
  65.     call    getcod        ; get bits to form a a new code in "de"
  66.     jr    c,dun        ; br if eof node or physical end-of-file
  67.     push    de        ; push a copy of the new pred
  68.     call    decode        ; decode new pred
  69.  
  70.     ld    hl,entflg    ; flag is "01" if "decode" made the entry
  71.     srl    (hl)        ; check (and zero) the flag
  72.     jr    c,noentr    ; don"t make the same entry twice!
  73.  
  74.     ld    hl,(lastpr)    ; get old pred
  75.     ld    a,(char)    ; and suffix char generated from the new pred
  76.     call    enterx        ; make new table entry from those two
  77.  
  78. noentr:    pop    de        ; get newest pred again (not that new anymore)
  79.     ld    a,(fulflg)    ; monitor the table full flag
  80.     or    a        ;
  81.     jr    z,mainlp    ; continue decoding & entering "till full
  82.  
  83. ;................................
  84.                 ;
  85.     cp    0feh        ; when this becomes "ff", we are done
  86.     jr    nz,fastlp    ; first it will become "fe", though. in that
  87.     inc    a        ; - case perf 1 more loop & change it to "ff"
  88.     ld    (fulflg),a    ;
  89.     jr    mainlp        ; one more!
  90. ;..............................................................................
  91. ;
  92. fastlp:    ld    (lastpr),de    ; table full loop similar to above ,except
  93.     call    getcod        ; - don"t bother checking table full flag
  94.     jr    c,dun        ; - call "entfil", not "enterx" (for possible
  95.     push    de        ; - code reassignment
  96.     call    decode        ; call to actually decode chars
  97.  
  98.     ld    hl,(lastpr)    ; get old pred
  99.     ld    a,(char)    ; and suffix char generated from the new pred
  100.     call    entfil        ; possibly make new table entry from those two
  101.  
  102.     pop    de        ;
  103.     jr    fastlp        ; continue in code reassignment mode
  104. ;
  105. ;        *** end of main processing loop(s)
  106. ;______________________________________________________________________________
  107.  
  108. ; come    here  when one of the special codes is encountered (we    may  not
  109. ; really be "dun").   actually, a null code should have been intercepted
  110. ; by  the  get12 routine,  leaving only eof (actually done) or    adaptive
  111. ; reset.
  112.  
  113. dun:    ld    a,e        ; some kind of special code encountered
  114.     cp    low(eofcod)    ; actually done?
  115.     jr    z,dundun    ; br if do
  116.     cp    low(rstcod)    ; else better be reset (null was intercepted)
  117.     jr    nz,fatbad    ; file is invalid
  118. ;..............................................................................
  119.  
  120.                 ; --- perf an adaptive reset ---
  121.     xor    a        ;
  122.     ld    h,a        ; reset entry# prior to table re-initialization
  123.     ld    l,a
  124.     ld    (entry),hl    ;
  125.     ld    (fulflg),a    ; reset  "table full" flag
  126.  
  127.     call    initb2        ; reset the entire table
  128.  
  129.     ld    a,9        ; reset the code length to "9"
  130.     ld    (codlen),a    ;
  131.     ld    a,02h        ; reset the target mask value accordingly
  132.     ld    (trgmsk),a    ;
  133.  
  134.     ld    de,nopred    ; set pred to "nopred"
  135.     dec    a        ; 1st entry is always a special case (A=1)
  136.     ld    (entflg),a    ; (trick it to make no table entry)
  137.     jr    mainlp        ; and continue where we left off
  138. ;______________________________________________________________________________
  139. ;
  140. dundun    equ    $        ; --- actually done, close things up ---
  141.     xor    a
  142.     jp    retccp        ; else return to ccp (or warm boot)
  143. ;______________________________________________________________________________
  144. ; the  following routine actually performs the decoding.   the top  sec-
  145. ; tion,  "decode",  flags the entry as "referenced".  it then calls  the
  146. ; recursive section below it, "decodr", to do the actual work.
  147.  
  148. decode:    push    de        ; save code. the code provides us an immediate
  149.     ex    de,hl        ; - index into the main logical table
  150.     ld    a,(tablhi)    ; (add offset to beg of table, of course)
  151.     add    a,h
  152.     ld    h,a        ;
  153.  
  154.     set    5,(hl)        ; set bit 5 of pred (hi) to flag entry as
  155.     pop    de        ; - "referenced" (ie not bumpable)
  156. ;..............................................................................
  157. ;
  158. decodr    equ    $        ; decode and output the index supplied in "de"
  159.     ld    iy,(stklim)    ; stack overflow check as a safety precaution
  160.     add    iy,sp        ; (limit allows extra for this invocation lvl)
  161.     jp    nc,stkovf    ; br on overflow (shouldn"t happen)
  162.     push    hl        ; only "hl" need be saved
  163.  
  164.     ld    a,(tablhi)    ; convert index in "de" to address in "hl"
  165.     add    a,d
  166.     ld    h,a        ;
  167.     ld    l,e        ; address now in "hl"
  168.  
  169.     ld    a,(hl)        ; make sure the entry exists
  170.     and    0dfh        ; <
  171.     cp    80h        ; (value for a vacant entry)
  172.     jr    nz,ok1        ; br if so (normal case)
  173.  
  174. ;................................
  175.                 ;
  176.     ld    a,01h        ; the "ugly" exception, wswsw
  177.     ld    (entflg),a    ; set flag so entry isn"t made twice
  178.     push    hl        ; save current stuff.
  179.     ld    hl,(lastpr)    ; get the last pred..
  180.     ld    a,20h        ; (setting this flag will flag the entry as
  181.     ld    (ffflag),a    ; - referenced,)
  182.     ld    a,(char)    ; get the last char
  183.     call    enterx        ; make an on the fly entry...
  184.     xor    a        ;
  185.     ld    (ffflag),a    ; put this back to normal
  186.     pop    hl        ; and presto...
  187.                 ;
  188.     ld    a,(hl)        ; it had better exist now!
  189.     cp    80h        ;
  190.     jp    z,fatbad    ; *** else file is fatally invalid ***
  191. ;................................
  192.  
  193. ok1:    ld    d,(hl)        ; normal code- get "pred" (hi)
  194.     right1            ; move to "pred" (lo)
  195.     ld    e,(hl)        ; get that. if msb of hi byte is set, val must
  196.     bit    7,d        ; - be "ff" (nopred) because it isn"t "80h"
  197.     jr    nz,term        ; if so, branch. this terminates recursion.
  198.  
  199.     res    5,d        ; else clear flag bit & decode pred we found
  200.     call    decodr        ; decode and output the "pred" (recursive call)
  201.     right1            ; move pointer ahead to the "suffix" byte
  202.     ld    a,(hl)        ; get it
  203.  
  204. samabv:    call    send        ; output the "suffix" byte
  205.     pop    hl        ; restore reg and return
  206.     ret
  207.                 ;
  208. term:    right1            ; move pointer ahead to the suffix byte
  209.     ld    a,(hl)        ; get it & save it. it is the 1st char of the
  210.     ld    (char),a    ; - decoded string, and will be used later to
  211.     jr    samabv        ; - attempt to make a new table entry.
  212.                 ; (rest is same as above)
  213. ;______________________________________________________________________________
  214. ;
  215. ; enter { <pred>, <suffix> } into the table, as defined in { hl, a }
  216. ;
  217. enterx:    push    af        ; save the suffix till we"re ready to enter it
  218.  
  219.     push    hl        ; save pred, xferred to "de" just below
  220.     call    figure        ; puts result in "phyloc" only, affects nothing
  221.     pop    de        ; put pred in "de" (pushed as "hl" above)
  222.  
  223.     ld    hl,(entry)    ; get next avail entry#
  224.  
  225.     ld    a,(tablhi)    ; convert that to an address
  226.     add    a,h
  227.     ld    h,a        ;
  228.  
  229. ; entries are made here,  but not normally flagged as "referenced" until
  230. ; the  are received by "decode".  until they are flagged as  referenced,
  231. ; they    are  "bumpable",  that is available for  code  reassignment.  if
  232. ; "ffflag" is set to 20h,  however,  they will be flagged now. this only
  233. ; occurs  during  initialization (bumping an atomic entry would be  most
  234. ; unfortunate) and when a wswsw string encounter initiates an  emergency
  235. ; entry, despite the code never having been received by "decode".
  236.  
  237.     ld    a,(ffflag)    ; normally zero, as described above
  238.     or    d        ;
  239.     ld    (hl),a        ; make the entry- pred (hi) first
  240.  
  241.     right1            ; move to pred (lo) position
  242.     ld    (hl),e        ; put that in
  243.     right1            ; move to suffix position
  244.     pop    af        ; retrieve the suffix, saved on entry
  245.     ld    (hl),a        ; stick it in
  246.  
  247.     ld    hl,(entry)    ; increment the entry# counter
  248.     inc    hl        ;
  249.     ld    (entry),hl    ;
  250.  
  251.     inc    hl        ; see if a new code length is indicated. the
  252.     ld    a,(trgmsk)    ; - extra inc "hl" above is to account for
  253.     cp    h        ; - skew delays of uncruncher vs. cruncher
  254.     ret    nz        ; normally just return
  255.  
  256.     add    a,a        ; change to a new code length
  257.     ld    (trgmsk),a    ; this will be the next target mask
  258.     ld    a,(codlen)    ; get the old code length, as a #of bits
  259.     inc    a        ; increment it, too
  260.     cp    13        ; check for overflow (12 bits is the max)
  261.     jr    z,flgful    ; if so, flag table as full
  262.     ld    (codlen),a    ; else this is the new code length
  263.     ret            ;
  264.  
  265. ;................................
  266.                 ;
  267. flgful:    ld    a,0feh        ; flag table as full
  268.     ld    (fulflg),a    ;
  269.     ret            ;
  270. ;______________________________________________________________________________
  271. ;
  272. ; get the next code by stripping the appropriate #of bits off the  input
  273. ; stream,  based  on  the current code length "codlen".  if the code  is
  274. ; "null",  don"t even return;  just get another one.  if the code is one
  275. ; of the other special codes, return with the carry flag set. "spare" is
  276. ; actually treated like a "null" for the time being,  since it"s use has
  277. ; yet to be defined.
  278. ;
  279. getcod:    ld    de,0000        ; init "shift register" to zero
  280.     ld    a,(codlen)    ; get current code length
  281.     ld    b,a        ; will be used as a loop counter
  282.     ld    a,(csave)    ; "leftover" bits
  283. getlp:
  284.     add    a,a        ; shift out a bit
  285.     call    z,ref        ; refill when necessary
  286.     rl    e        ; shift in the bit shifted out
  287.     rl    d        ; likewise
  288.     djnz    getlp        ; loop for #of bits needed
  289.     ld    (csave),a    ; save "leftover" bits for next time
  290.     ld    a,d        ; if hi-byte = "01", we may have a special code
  291.     dec    a        ; set z if it was "1"
  292.     and    a        ; clr carry
  293.     ret    nz        ; rtn w/ clr carry if byte wasn"t "01"
  294.  
  295. ;................................
  296.                 ;
  297.     ld    a,e        ; else further analysis necessary
  298.     cp    4        ; set carry on 100, 101, 102, 103
  299.     ret    nc        ; else code is normal, rtn with clr carry
  300.  
  301.     cp    low(nulcod)    ; is it the "null" code?
  302.     jr    z,getcod    ; if so, just go get another code
  303.     cp    low(sprcod)    ; (treat the unimplemented "spare" like a null)
  304.     jr    z,getcod    ; as above
  305.  
  306.     scf            ; < rtn w/ carry set indicating special code
  307.     ret            ; (presumably "eof" or "reset")
  308. ;______________________________________________________________________________
  309. ;
  310. ; routine to reload "a" with more bits from the input stream.  note
  311. ; we  pre-shift out the next bit, shifting in a "1" from the  left.
  312. ; since  the leftmost bit in the reg is a  guaranteed "1",  testing
  313. ; the  zero stat of the  accumulator later is a necessary and  suf-
  314. ; ficient condition for determining that all the bits in the accum-
  315. ; ulator have been used up.
  316. ;
  317. ; the only things to be careful of is that the last bit is not used
  318. ; later, and that the bit now in the carry flag is used upon return
  319. ; from    this  subroutine.  (this is the identical  scheme  used  in
  320. ; usqfst.  a  exact complement to it is incorporated  for  shifting
  321. ; bits out in the crunch program).
  322. ;
  323. ref:    call    getchr        ; get the char
  324.     jr    c,phyeof    ; br if unexpected physical eof encountered
  325.     scf            ; to shift in the "1" from the right
  326.     rla            ; do that, shifting out a "real" bit
  327.     ret            ; rtn (w/ that real bit in the carry flag)
  328. ;______________________________________________________________________________
  329. ;
  330. phyeof:
  331.     jp    uneof        ; unexpected eof
  332. ;______________________________________________________________________________
  333. ;
  334. ; send character to the output buffer, plus related processing
  335.  
  336. send:
  337.     exx            ; alt regs used for output processing
  338.     srl    b        ; if reg is "1", repeat flag is set
  339.                 ; (note, clears itself automatically)
  340.     jr    c,repeat    ; go perf the repeat
  341.     cp    90h        ; else see if char is the repeat spec
  342.     jr    z,setrpt    ; br if so
  343.     ld    c,a        ; else nothing special- but always keep
  344.     exx            ; back to normal regs
  345.     jp    out        ; else just output the char;
  346. ;..............................................................................
  347. ;
  348. ; set repeat flag; count value will come as the next byte. (note: don"t
  349. ; clobber c with the "90h"- it still has the prev character, the one to
  350. ; be repeated)
  351. ;
  352. setrpt:    inc    b        ; set flag
  353.     exx            ; switch to primary regs & return.
  354.     ret
  355.  
  356. ;..............................................................................
  357. ;
  358. ; repeat flag was previously set; current byte in a is a count value.
  359. ; a zero count is a special case which means send 90h itself.  otherwise
  360. ; use b (was the flag) as a counter. the byte itself goes in a.
  361. ;
  362. repeat:    or    a        ; check for special case
  363.     jr    z,snd90h    ; jump if so
  364.     dec    a        ; compute "count-1"
  365.     ld    b,a        ; juggle registers
  366.  
  367.     push    bc        ; the count and the char
  368.     ld    b,0        ; zero the count in advance
  369.     exx            ;
  370.     pop    bc        ;
  371. again:
  372.     ld    a,c        ;
  373.     push    bc        ;
  374.     call    out        ; repeat b occurrences of byte in "c"
  375.     pop    bc        ;
  376.     djnz    again        ; leaves b, the rpt flag, 0 as desired
  377.     ret
  378. ;................................
  379.                 ;
  380. snd90h:    ld    a,90h        ; special case code to send the byte 90h
  381.     exx            ;
  382.     jp    out        ;
  383. ;______________________________________________________________________________
  384. ;
  385. ; initialize the table to contain the 256 "atomic" entries-
  386. ; { "nopred", <char> },  for all values of <char> from 0 thru 255
  387.  
  388. initb2:    call    prese2        ; "pre-initializes" the table (mostly zeroes)
  389.     ld    a,20h        ;
  390.     ld    (ffflag),a    ; <
  391.     xor    a        ; start with a suffix of zero
  392.     ld    hl,nopred    ; pred for all 256 atomic entries
  393.  
  394. inilp:    push    hl        ; <
  395.     push    af        ; <
  396.     call    enterx        ;
  397.     pop    af        ; <
  398.     pop    hl        ; <
  399.     inc    a        ; next suffix
  400.     jr    nz,inilp    ; loop 256 times
  401. ;..............................................................................
  402. ;
  403. ; now reserve the four reserved codes 100h - 103h (eof, reset, null, and
  404. ; spare.  this is easily achieved by inserting values in the table which
  405. ; cannot  possibly be matched,    and insuring that they cannot  be  reas-
  406. ; signed.  an occurrence of any of these codes is possible only when the
  407. ; cruncher explicitely outputs them for the special cases for which they
  408. ; are designated.
  409.  
  410.     ld    b,4        ; loop counter for the 4 reserved entries
  411.  
  412. rsrvlp:    push    bc        ; <
  413.     ld    hl,impred    ; an "impossible" pred
  414.     xor    a        ; any old suffix will do
  415.     call    enterx        ; make the entry
  416.     pop    bc        ; <
  417.     djnz    rsrvlp        ; loop 4 times
  418.  
  419.     xor    a        ; now restore this flag to its normal value
  420.     ld    (ffflag),a    ;
  421.     ret            ;
  422. ;..............................................................................
  423. ;
  424. ; low level table preset called before initialization above. this routine
  425. ; presets the main table as follows: (see description of table elsewhere):
  426. ; column 1: 4096 x 80h, columns 2 and 3: 4096 x 00h
  427. ;
  428. prese2:
  429.     ld    hl,(table)    ; beg of main table, 4096 rows x 3 columns
  430.     ld    d,h        ;
  431.     ld    e,l
  432.     inc    de
  433.     ld    bc,1000h    ;
  434.     ld    (hl),80h    ;
  435.     ldir            ; put in 1000h "80h""s
  436.     ld    (hl),c        ; C = 0
  437.     ld    b,high(2*1000h)    ; " " "
  438.     ldir            ; and 2000h more "00h""s
  439. ;..............................................................................
  440. ;
  441. ; the  auxiliary  physical  translation table is 5003  rows,  2  columns
  442. ; (logically speaking). actually 5120 rows, 2 columns are allocated. all
  443. ; entries are initialized to 80h.
  444.  
  445.     ld    hl,(xlatbl)    ; physical <--> logical xlation table
  446.     ld    d,h        ;
  447.     ld    e,l
  448.     inc    de
  449.     ld    bc,2800h    ; total entries = 1400h x 2
  450.     ld    (hl),80h    ;
  451.     push    hl
  452.     ldir            ;
  453.     pop    hl
  454.     dec    (hl)
  455.     ret            ;
  456. ;______________________________________________________________________________
  457. ;
  458. ; figure  out  what  physical location the cruncher put  it"s  entry  by
  459. ; reproducing the hashing process. insert the entry# into the correspon-
  460. ; ding physical location in xlatbl.
  461.  
  462. figure:    ld    b,a        ; < suffix supplied goes into b
  463.     call    hash        ; get initial hash value into  "hl"
  464.  
  465. phylp:    ld    c,h        ; c  <-- extra copy of h
  466.     ld    a,(hl)        ; check if any entry exists at that location
  467.     cp    80h        ; value for a vacant spot
  468.     jr    z,ismt        ; br if vacant
  469.     call    nm        ; else find next in chain
  470.     jr    phylp        ; and continue
  471.  
  472. ;................................
  473.                 ;
  474. ismt:    ld    de,(entry)    ; get the logical entry#
  475.     ld    (hl),d        ; stick in hi-byte
  476.  
  477.     ld    a,h        ; move "right1" for this table
  478.     add    a,14h        ;
  479.     ld    h,a        ;
  480.  
  481.     ld    (hl),e        ; lo-byte goes there
  482.     ret            ;
  483.  
  484. ;................................
  485.                 ;
  486. nm:                ; no match yet... find next "link" in chain
  487.     ld    de,(disp)    ; secondary probe- add disp computed by "hash"
  488.     add    hl,de        ;
  489.     ld    a,(xlatbh)
  490.     cp    h
  491.     ret    c
  492.     ret    z
  493.     ld    de,5003        ; else loop
  494.     add    hl,de        ;
  495.     ret            ;
  496. ;______________________________________________________________________________
  497. ;
  498. entfil:                ; try to enter the pred/suffix in hl|a
  499.     ld    b,a        ;
  500.     ld    a,0ffh        ;
  501.     ld    (avail+1),a    ;
  502.     ld    a,b        ;
  503.     call    hash        ; get initial hash value into  "hl"
  504. ;..............................................................................
  505. ;
  506. phylp2:    ld    c,h        ; c  <-- extra copy of h
  507.  
  508.     ld    a,(hl)        ; check if any entry exists at that location
  509.     cp    80h        ;
  510.     jr    z,makit        ; end-of chain- make entry (elsewhere) if poss
  511.  
  512.     ld    a,(avail+1)    ; got an entry yet?
  513.     inc    a
  514.     jr    nz,nxt1        ; if so, don"t bother with the below
  515. ;................................
  516.  
  517.     push    hl        ; save physical table pointer
  518.  
  519.     ld    d,(hl)        ; get entry#, hi
  520.  
  521.     ld    a,h        ; }
  522.     add    a,14h        ; } right 1 for this table
  523.     ld    h,a        ; }
  524.  
  525.     ld    l,(hl)        ; entry#, lo byte
  526.     ld    a,(tablhi)    ; convert to an addr in "hl"
  527.     add    a,d
  528.     ld    h,a
  529.  
  530.     bit    5,(hl)        ; see if entry is bumpable
  531.     jr    nz,nxtone    ; if not, try the next one
  532.  
  533.     ld    (avail),hl    ; and save resulting entry# here for later use
  534.  
  535. nxtone:    pop    hl        ; restore physical table pointer
  536.  
  537. nxt1:                ; come here if "hl" wasn"t pushed yet
  538.     call    nm        ; find next "link" in chain
  539.     jr    phylp2        ; and continue
  540. ;______________________________________________________________________________
  541. ;
  542. ; reassign the entry pointed to by "avail", if any. re-define the "last
  543. ; pred entered" and "last suffix" variables.
  544. ;
  545. makit:    ld    hl,(avail)    ; get "avail"
  546.     ld    a,h        ;
  547.     inc    a        ; "ff" means no candidate entry was found
  548.     ret    z        ; so forget it
  549.  
  550.     ld    de,(lastpr)    ; else redefine the "last pred entered" var
  551.     ld    a,(char)    ; as well as the "last suffix entered"
  552.     ld    b,a        ; put suffix here, we need to use "a"
  553.  
  554.     ld    (hl),d        ; actually make the entry
  555.     right1            ;
  556.     ld    (hl),e        ; [pred(lo)]
  557.     right1            ;
  558.     ld    (hl),b        ; [suffix]
  559.  
  560.     ret            ; done
  561. ;------------------------------------------------------------------------------
  562. ;
  563. ; for additional details about the hashing algorithm, see crunch.
  564. ;
  565. hash:
  566.     ld    e,l        ; save so low nybble of pred can be used below
  567.     add    hl,hl        ;
  568.     add    hl,hl        ;
  569.     add    hl,hl        ;
  570.     add    hl,hl        ; shift whole pred value left 4 bits
  571.     xor    h        ; xor hi-byte of that with suffix
  572.     ld    l,a        ; goes there as lo-byte of result
  573.     ld    a,e        ; get pred(lo) saved above
  574.     and    0fh        ; want only low nybble of that
  575.  
  576.     ld    h,a
  577.     ld    a,(xlatbh)    ; convenient time to add in table offset
  578.     add    a,h
  579.  
  580.     ld    h,a        ; goes here as hi-byte of result
  581.     inc    hl        ; except add one. this eliminates poss. of 0.
  582.  
  583.     push    hl        ; save hash val for return
  584.  
  585.     ld    de,(hasher)    ; compute displacement value, - (5003-hash)
  586.  
  587.     add    hl,de        ; (displacement has table offset removed again)
  588.     ld    (disp),hl    ; secondary hashing value, a negative number.
  589.     pop    hl        ; get back orig hash address
  590.     ret            ; and return it
  591.  
  592. ;______________________________________________________________________________
  593. ;
  594. ; (re-)initialize  all    necessary ram locs. called once for each file  to  be
  595. ; processed.  this routine gets its info from an initialization block  called
  596. ; "shadow",  which is copied into the working memory.
  597. ;
  598. intram:    ld    hl,shadow    ; contains a copy of all relevant init values
  599.     ld    de,ram        ; target
  600.     ld    bc,eoshad-shadow
  601.     ldir            ; do it
  602.     ret
  603.  
  604. membuf:    call    codend
  605.     ld    (table),hl
  606.     ld    c,l
  607.     ld    b,high(3*1000h)    ; C = 0
  608.     add    hl,bc
  609.     ld    d,h        ; Copy of eotbl pointer to DE
  610.     ld    e,l
  611.     ld    (eotbl),hl
  612.     ld    b,high(2*1400h)    ; C = 0
  613.     add    hl,bc
  614.     ld    (exlatb),hl
  615.     ld    b,high(800h)    ; C = 0
  616.     push    hl        ; Stack exlatb value
  617.     add    hl,bc
  618.     ld    (topstk),hl
  619.     ld    hl,-5003    ; Compute "-5003-eotbl"
  620.     sbc    hl,de        ; Carry had better be clear....
  621.     pop    de        ; Get back exlatb
  622.     ld    (hasher),hl    ; Store "-5003-eotbl" for "hash:"
  623.     ld    h,c        ; C = 0, carry still clear
  624.     ld    l,c
  625.     sbc    hl,de        ; Negate exlatb
  626.     ld    (stklim),hl    ; Stow as stack limit
  627.     ret            ;
  628.  
  629. ;______________________________________________________________________________
  630. ;
  631. shadow    equ    $        ; (for description, see immediately below)
  632.                 ;
  633.     db    00        ; "fulflg"
  634.     dw    nopred        ; "lastpr"
  635.     db    01h        ; "entflg"
  636.     dw    0000h        ; "entry"
  637.     db    80h        ; "csave"
  638.     db    09        ; "codlen"
  639.     db    02h        ; "trgmsk"
  640. eoshad    equ    $
  641. ;______________________________________________________________________________
  642. ;
  643. ; End LH-UNCR.LIB
  644. ;
  645. ;========================================================================
  646.