home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / sharware / utility / PACKERS / LZH / LZHUFE / LZHUFE.LST < prev    next >
File List  |  1989-04-27  |  35KB  |  822 lines

  1. NOTE: This file can serve as both source and documentation.  You
  2.       can compile by stripping the 1st few lines (these notes) and
  3.       the last portion (the cross-references), and then deleting
  4.       the left hand 8 columns of what remains.  Wordstar can do
  5.       this column deletion, and I believe EDLIN can also. CBF
  6.  
  7. NOTE: The procedural cross referencer (refrence) will not run
  8.       with the procedure type definitions in lines 58 to 59
  9.       below.  They were commented out for the run.  Thus the
  10.       calls to readbyte and putbyte within decode are not shown.
  11.  
  12. NOTE: This program has been deliberately written to isolate the
  13.       decode operation, and make it useful in other operations.
  14.       One anomaly with LZHUF (and LHARC) is that they become
  15.       very slow when compressing a long string of identical
  16.       bytes (i.e. a file full of blanks, or nuls).  I believe
  17.       this would be improved by preceding the encoding with
  18.       run length compression, using 90h as the encodeing signal,
  19.       so that <char> 90h nn (with 2 <= nn <= 255) represents
  20.       <char> followed by nn repetitions, i.e. at least a total
  21.       of nn+1 occurences of <char>.  <90h 0> would represent 90h
  22.       itself, and 90h cannot be run length encoded.  <90h 1>
  23.       would represent EOF, thus embedding a specific EOF marker
  24.       in the file.  This allows use where the actual file length
  25.       is unknown before it is reached, i.e. in communications.
  26.  
  27. NOTE: The attached LZHUFE.EXE file was compiled with the $r-
  28.       option.  However for any development etc the source should
  29.       be compiled with $r+ (run-time range checks on) option.
  30.       This found many evil gotchas.
  31.  
  32. NOTE: LZHUFE.EXE is just as fast, within crude measurements, as
  33.       LZHUF.  This shows that even Turbo Pascals relatively
  34.       crude code generation competes favorably with C.  There
  35.       is much room for optimization left.  However I believe
  36.       the Pascal source is much clearer than the C source.
  37.  
  38. NOTE: The debug mechanism is guarded both by the Turbo {$IFDEF}
  39.       construct, and by individual constants.  The latter is
  40.       ISO compatible.  However, Turbo does not strip inaccessible
  41.       IF statements, as does PascalP, thus the dual mechanism.
  42.  
  43.      1  {$M 12000,0,0}  (* see notes to "decode" *)
  44.      2
  45.      3  PROGRAM lzhufe(infile, outfile, output);
  46.      4  (* Based on decode section of lzhuf.c               *)
  47.      5  (* Written by Haruyasu Yoshizaki 1988/11/20         *)
  48.      6  (* Some minor changes 1989/4/6                      *)
  49.      7  (* Comments translated by Haruhiko Okumura 1989/4/7 *)
  50.      8
  51.      9  (* Converted to Pascal by C.B. Falconer, 1989/4/25  *)
  52.     10  (* I have attempted to use only ISO constructs, but *)
  53.     11  (* some Turboisms have remained, especially in the  *)
  54.     12  (* file access area, and the use of inc/dec, hex    *)
  55.     13  (* constants, longints, bytes and words.  I have    *)
  56.     14  (* also attempted to use the maximum range checking *)
  57.     15
  58.     16    (********** LZSS compression **********)
  59.     17
  60.     18    CONST            (* These only take effect if 'dbg' is defined *)
  61.     19      debuga         = false;     (* show recorded size *)
  62.     20      debugb         = true;      (* display output chars *)
  63.     21
  64.     22      iobuffsize     = 4096;      (* for Turbo block i/o only *)
  65.     23      eofmark        = $1a;       (* textfile eof mark *)
  66.     24
  67.     25      (* These constants are used by the file-handling *)
  68.     26      (* procedures when opening and closing disk      *)
  69.     27      (* files. The mode fields of Turbo Pascal's file *)
  70.     28      (* variables will contain one of these values    *)
  71.     29      fmclosed       = $d7b0;
  72.     30      fminput        = $d7b1;     (* reference data *)
  73.     31      fmoutput       = $d7b2;
  74.     32      fminout        = $d7b3;
  75.     33
  76.     34    TYPE
  77.     35      iobuffer       = ARRAY[1..iobuffsize] OF byte;
  78.     36      iobufptr       = 0..iobuffsize;  (* 0 = empty *)
  79.     37
  80.     38      (* reference data, actual contents of FILE type *)
  81.     39      filerec        = RECORD (* typed and untyped file record *)
  82.     40        handle         : word;
  83.     41        mode           : word;
  84.     42        recsize        : word;
  85.     43        private        : ARRAY[1..26] OF byte;
  86.     44        userdata       : ARRAY[1..16] OF byte;
  87.     45        name           : ARRAY[0..79] OF char;
  88.     46        END; (* filerec *)
  89.     47
  90.     48      fcb            = RECORD
  91.     49        fid            : FILE;      (* Turbo untyped block i/o *)
  92.     50        fwrtaccess     : boolean;
  93.     51        feof           : boolean;
  94.     52        bufflast,                   (* posn of last in buffer *)
  95.     53        buffndx        : iobufptr;  (* last read from buffer *)
  96.     54        buff           : iobuffer;  (*   0 = empty *)
  97.     55        END; (* fcb *)
  98.     56
  99.     57      (* Non-standard method of passing procedures *)
  100.     58      putbproc       = PROCEDURE(b : byte);
  101.     59      getbfunc       = FUNCTION(VAR b : byte) : boolean;
  102.     60
  103.     61    VAR
  104.     62      infile,
  105.     63      outfile        : fcb;
  106.     64      endofinput     : boolean;
  107.     65
  108.     66    (* 1---------------1 *)
  109.     67
  110.     68    (* In this group we attempt to follow standard Pascal semantics *)
  111.     69    (* i.e. output files always have feof true, and it is an error  *)
  112.     70    (* to write to a file without this condition.                   *)
  113.     71    (* The system is incomplete, intended for this program only.    *)
  114.     72
  115.     73    FUNCTION freset(VAR f : fcb; fn : string) : boolean;
  116.     74    (* equivalent to assign/reset pair *)
  117.     75
  118.     76      BEGIN (* freset *)
  119.     77      WITH f DO BEGIN
  120.     78        buffndx := 0; bufflast := 0; (* mark empty *)
  121.     79        fwrtaccess := false;
  122.     80        assign(fid, fn);
  123.     81  {$i-} reset(fid, 1); {$i+}
  124.     82        feof := ioresult <> 0;
  125.     83        freset := NOT feof; END;
  126.     84      END; (* freset *)
  127.     85
  128.     86    (* 1---------------1 *)
  129.     87  {$F+}                      (* passed procs must be FAR *)
  130.     88    FUNCTION readbyte(VAR c : byte) : boolean;
  131.     89    (* assumes using infile. Returns false at eof *)
  132.     90
  133.     91      BEGIN (* readbyte *)
  134.     92      WITH infile DO BEGIN
  135.     93        IF (buffndx >= bufflast) AND NOT feof THEN BEGIN (* reload *)
  136.     94  {$i-}   blockread(fid, buff, iobuffsize, bufflast); {$i+}
  137.     95          buffndx := 0;
  138.     96          feof := (ioresult <> 0) OR (bufflast = 0); END;
  139.     97        IF feof THEN c := eofmark
  140.     98        ELSE BEGIN
  141.     99          buffndx := succ(buffndx); c := buff[buffndx]; END;
  142.    100        readbyte := NOT feof; END;
  143.    101      END; (* readbyte *)
  144.    102  {$F-}
  145.    103    (* 1---------------1 *)
  146.    104
  147.    105    FUNCTION frewrite(VAR f : fcb; fn : string) : boolean;
  148.    106    (* equivalent to assign/rewrite pair *)
  149.    107
  150.    108      BEGIN (* frewrite *)
  151.    109      WITH f DO BEGIN
  152.    110        buffndx := 0; bufflast := 0; (* mark empty *)
  153.    111        fwrtaccess := true;
  154.    112        assign(fid, fn);
  155.    113  {$i-} rewrite(fid, 1); {$i+}
  156.    114        feof := ioresult = 0;
  157.    115        frewrite := feof; END;
  158.    116      END; (* frewrite *)
  159.    117
  160.    118    (* 1---------------1 *)
  161.    119
  162.    120    PROCEDURE fflush(VAR f : fcb);
  163.    121    (* empty output buffers to disk. Not checking status *)
  164.    122
  165.    123      BEGIN (* fflush *)
  166.    124      WITH f DO BEGIN
  167.    125        IF (bufflast > 0) AND feof AND fwrtaccess THEN BEGIN
  168.    126  {$i-}   blockwrite(fid, buff, bufflast, buffndx); {$i+}
  169.    127          IF (ioresult <> 0) OR (buffndx <> bufflast) THEN
  170.    128            feof := false;         (* no longer writeable *) END;
  171.    129        buffndx := 0; bufflast := 0;  (* mark empty *)  END;
  172.    130      END; (* fflush *)
  173.    131
  174.    132    (* 1---------------1 *)
  175.    133  {$F+}                            (* passed procs must be FAR *)
  176.    134    PROCEDURE putbyte(c : byte);
  177.    135    (* assumes using outfile *)
  178.    136
  179.    137      BEGIN (* putbyte *)
  180.    138      WITH outfile DO
  181.    139        IF fwrtaccess AND feof THEN BEGIN
  182.    140          inc(bufflast); buff[bufflast] := c;
  183.    141          IF bufflast = iobuffsize THEN fflush(outfile); END;
  184.    142      (* buffer cannot be full on exit *)
  185.    143      END; (* putbyte *)
  186.    144  {$F-}
  187.    145    (* 1---------------1 *)
  188.    146
  189.    147    PROCEDURE fclose(VAR f : fcb);
  190.    148
  191.    149      VAR
  192.    150        fr   : filerec ABSOLUTE f; (* depends on turbo alignments *)
  193.    151
  194.    152      BEGIN (* fclose *)
  195.    153      WITH f DO BEGIN
  196.    154        IF ((fr.mode = fmoutput) OR (fr.mode = fminout)) AND feof THEN
  197.    155          fflush(f);
  198.    156        IF fr.mode <> fmclosed THEN close(fid); END;
  199.    157      END; (* fclose *)
  200.    158
  201.    159    (* 1---------------1 *)
  202.    160
  203.    161    PROCEDURE error(message : string);
  204.    162
  205.    163      BEGIN
  206.    164      writeln; writeln(message); halt(1);
  207.    165      END;
  208.    166
  209.    167    (* 1---------------1 *)
  210.    168
  211.    169    PROCEDURE decode(readbyte : getbfunc;    (* get data *)
  212.    170                     putbyte  : putbproc;    (* put data *)
  213.    171                     monitor  : boolean);    (* show activity *)
  214.    172    (* This uses about 9k of stack space for local variables.   *)
  215.    173    (* They might be better assigned on the heap.  However that *)
  216.    174    (* reduces the clarity, and I wanted to isolate the decoder *)
  217.    175    (* Unfortunately Turbos memory scheme does not allow the    *)
  218.    176    (* stack to expand automatically.  A 16k stack suffices.    *)
  219.    177
  220.    178      CONST
  221.    179        n              = 4096;      (* buffer size. Power of 2 *)
  222.    180        f              = 60;        (* lookahead buffer size *)
  223.    181        encodemin      = 3;         (* min encode string length *)
  224.    182        max_freq       = $8000;     (* updates tree when the root *)
  225.    183                                    (* frequency reaches this value.*)
  226.    184
  227.    185        (* derived constants. No expression for ISO compatibility *)
  228.    186        threshold      = 2;         (* encodemin - 1 *)
  229.    187        bufmax         = 4155;      (* n+f-1 *)
  230.    188        codemax        = 313;       (* 256-encodemin+f *)
  231.    189        n_char         = 314;       (* codemax + 1; kinds of chars *)
  232.    190
  233.    191        (* Huffman coding *)
  234.    192        tblsize        = 627;       (* 2*n_char - 1 *) (* was T *)
  235.    193                                    (* Root at tblsize, others nodes *)
  236.    194        huffroot       = 626;       (* tblsize - 1 *)  (* was R *)
  237.    195        tblmax         = 628;       (* tblsize + 1 *)
  238.    196        parentmax      = 941;       (* tblsize + n_char *)
  239.    197
  240.    198      TYPE
  241.    199        bufindex       = 0..bufmax;
  242.    200        charindex      = 0..codemax;
  243.    201
  244.    202      VAR
  245.    203        i, j, k, r, c  : integer;
  246.    204        count          : longint;
  247.    205        textsize       : longint;
  248.    206        printcount     : longint;
  249.    207        getbuf         : word;
  250.    208        getlen         : byte;
  251.    209
  252.    210        (* Huffman coding *)
  253.    211
  254.    212        (* table to encode/decode the upper 6 bits of position *)
  255.    213        huffcode       : ARRAY[0..255] OF RECORD
  256.    214          code, len      : byte;
  257.    215          END; (* huffcode *)
  258.    216
  259.    217        freq           : ARRAY[0..tblmax] OF word;  (* freq table *)
  260.    218
  261.    219        (* pointers to parent nodes, except for    *)
  262.    220        (* the elements[T..T + N_CHAR - 1] which   *)
  263.    221        (* are used to get the positions of leaves *)
  264.    222        (* corresponding to the codes.             *)
  265.    223        parent         : ARRAY[0..parentmax] OF word;
  266.    224
  267.    225        (* pointers to child nodes (son[], son[] + 1) *)
  268.    226        son            : ARRAY[0..tblsize] OF integer;
  269.    227
  270.    228        (* LZSS table *)
  271.    229        histbuff       : ARRAY[bufindex] OF byte;
  272.    230
  273.    231      (* 2---------------2 *)
  274.    232
  275.    233      PROCEDURE starthuff;
  276.    234      (* initialization of tree *)
  277.    235
  278.    236        VAR
  279.    237          i              : integer;
  280.    238          j              : integer;
  281.    239
  282.    240        (* 3---------------3 *)
  283.    241
  284.    242        PROCEDURE ihuff;
  285.    243        (* Form decoding tables huffcode.len and huffcode.code *)
  286.    244        (* This replaces the original initialized data area,   *)
  287.    245        (* and is compatible with standard Pascal.             *)
  288.    246
  289.    247          VAR
  290.    248            i, nxtcode   : integer;
  291.    249
  292.    250          (* 4---------------4 *)
  293.    251
  294.    252          PROCEDURE enter(ix, lgh : integer);
  295.    253
  296.    254            BEGIN (* enter *)
  297.    255            WITH huffcode[ix] DO BEGIN
  298.    256              len := lgh; code := nxtcode; END;
  299.    257            IF succ(ix) MOD (1 shl (8-lgh)) = 0 THEN
  300.    258              nxtcode := succ(nxtcode);
  301.    259            END; (* enter *)
  302.    260
  303.    261          (* 4---------------4 *)
  304.    262
  305.    263          BEGIN (* ihuff *)
  306.    264          nxtcode := 0;
  307.    265          FOR i :=   0 TO  31 DO enter(i, 3);
  308.    266          FOR i :=  32 TO  79 DO enter(i, 4);
  309.    267          FOR i :=  80 TO 143 DO enter(i, 5);
  310.    268          FOR i := 144 TO 191 DO enter(i, 6);
  311.    269          FOR i := 192 TO 239 DO enter(i, 7);
  312.    270          FOR i := 240 TO 255 DO enter(i, 8);
  313.    271          END; (* ihuff *)
  314.    272
  315.    273        (* 3---------------3 *)
  316.    274
  317.    275        BEGIN (* starthuff *)
  318.    276        ihuff;
  319.    277        FOR i := 0 TO pred(n_char) DO BEGIN
  320.    278          freq[i] := 1;
  321.    279          son[i] := i + tblsize; parent[i + tblsize] := i; END;
  322.    280        i := 0; j := n_char;
  323.    281        WHILE (j <= huffroot) DO BEGIN
  324.    282          freq[j] := freq[i] + freq[succ(i)];
  325.    283          son[j] := i; parent[i] := j; parent[succ(i)] := j;
  326.    284          i := i + 2; j := succ(j); END;
  327.    285        freq[tblsize] := $ffff; parent[huffroot] := 0;
  328.    286        END; (* starthuff *)
  329.    287
  330.    288      (* 2---------------2 *)
  331.    289
  332.    290      PROCEDURE nextbyte;
  333.    291
  334.    292        VAR
  335.    293          c    : byte;
  336.    294
  337.    295        BEGIN (* nextbyte *)
  338.    296        IF endofinput THEN BEGIN
  339.    297          fclose(outfile);
  340.    298          error('Read past eof'); END;
  341.    299        WHILE (getlen <= 8) DO BEGIN
  342.    300          IF NOT readbyte(c) THEN BEGIN  (* delay eof for buffer *)
  343.    301            endofinput := true; c := 0; END;
  344.    302          getbuf := getbuf OR (c shl (8 - getlen));
  345.    303          getlen := getlen + 8; END;
  346.    304        END; (* nextbyte *)
  347.    305
  348.    306      (* 2---------------2 *)
  349.    307
  350.    308      FUNCTION getbit : boolean;      (* get one bit *)
  351.    309
  352.    310        BEGIN (* getbit *)
  353.    311        IF getlen <= 8 THEN nextbyte;
  354.    312        getbit := (getbuf AND $8000) <> 0;
  355.    313        getbuf := getbuf shl 1; getlen := pred(getlen);
  356.    314        END; (* getbit *)
  357.    315
  358.    316      (* 2---------------2 *)
  359.    317
  360.    318      FUNCTION getbyte : integer;     (* get one byte *)
  361.    319
  362.    320        BEGIN (* getbyte *)
  363.    321        IF getlen <= 8 THEN nextbyte;
  364.    322        getbyte := getbuf shr 8;
  365.    323        getbuf := getbuf shl 8; getlen := getlen - 8;
  366.    324        END; (* getbyte *)
  367.    325
  368.    326      (* 2---------------2 *)
  369.    327
  370.    328      FUNCTION decodechar : integer;
  371.    329
  372.    330        VAR
  373.    331          c              : word;
  374.    332
  375.    333        (* 3---------------3 *)
  376.    334
  377.    335        PROCEDURE update (c : integer);
  378.    336        (* advance frequency of code c, and update tree *)
  379.    337
  380.    338          VAR
  381.    339            i, j, k, l     : integer;
  382.    340
  383.    341          (* 4---------------4 *)
  384.    342
  385.    343          PROCEDURE reconst;
  386.    344          (* reconstruction of tree *)
  387.    345
  388.    346            VAR
  389.    347              i, j, k        : integer;
  390.    348              f, l           : word;
  391.    349
  392.    350            BEGIN (* reconst *)
  393.    351            (* collect leaf nodes in the first half of the   *)
  394.    352            (* table and replace the freq by (freq + 1) / 2. *)
  395.    353            j := 0;
  396.    354            FOR i := 0 TO huffroot DO BEGIN
  397.    355              IF (son[i] >= tblsize) THEN BEGIN
  398.    356                freq[j] := succ(freq[i]) shr 1 (* DIV 2 *);
  399.    357                son[j] := son[i]; j := succ(j); END;
  400.    358              END;
  401.    359
  402.    360            (* begin constructing tree by connecting sons *)
  403.    361            i := 0;
  404.    362            FOR j := n_char TO huffroot DO BEGIN
  405.    363              k := succ(i);
  406.    364              f := freq[i] + freq[k]; freq[j] := f;
  407.    365              k := pred(j);
  408.    366              WHILE (f < freq[k]) DO k := pred(k);
  409.    367              k:= succ(k); l := (j - k) * 2;
  410.    368              move(freq[k], freq[k+1], l); freq[k] := f;
  411.    369              move(son[k], son[k+1], l); son[k] := i;
  412.    370              i := i + 2; END;
  413.    371
  414.    372            (* connect parent *)
  415.    373            FOR i := 0 TO huffroot DO BEGIN
  416.    374              k := son[i]; parent[k] := i;
  417.    375              IF k < tblsize THEN parent[succ(k)] := i; END;
  418.    376            END; (* reconst *)
  419.    377
  420.    378          (* 4---------------4 *)
  421.    379
  422.    380          BEGIN (* update *)
  423.    381          IF (freq[tblmax] = max_freq) THEN reconst;
  424.    382          c := parent[c + tblsize];
  425.    383          REPEAT
  426.    384            k := succ(freq[c]); freq[c] := k;
  427.    385            (* if the order is disturbed, exchange nodes *)
  428.    386            l := succ(c);
  429.    387            IF (k > freq[l]) THEN BEGIN
  430.    388              REPEAT
  431.    389                inc(l);
  432.    390              UNTIL k <= freq[l];
  433.    391              dec(l);
  434.    392
  435.    393              freq[c] := freq[l]; freq[l] := k;
  436.    394
  437.    395              i := son[c]; parent[i] := l;
  438.    396              IF (i < tblsize) THEN parent[succ(i)] := l;
  439.    397              j := son[l]; son[l] := i;
  440.    398
  441.    399              parent[j] := c;
  442.    400              IF (j < tblsize) THEN parent[succ(j)] := c;
  443.    401              son[c] := j;
  444.    402
  445.    403              c := l; END;
  446.    404            c := parent[c];
  447.    405          UNTIL c = 0;                 (* repeat up to root *)
  448.    406          END; (* update *)
  449.    407
  450.    408        (* 3---------------3 *)
  451.    409
  452.    410        BEGIN (* decodechar *)
  453.    411        c := son[huffroot];
  454.    412        (* travel from root to leaf, choosing the smaller *)
  455.    413        (* child node (son[]) if the read bit is 0, the   *)
  456.    414        (* bigger (son[] +1; if the read bit is 1         *)
  457.    415        WHILE (c < tblsize) DO c := son[c + ord(getbit)];
  458.    416        c := c - tblsize;
  459.    417        update(c); decodechar := c;
  460.    418        END; (* decodechar *)
  461.    419
  462.    420      (* 2---------------2 *)
  463.    421
  464.    422      FUNCTION decodeposition : integer;
  465.    423
  466.    424        VAR
  467.    425          i, j, c        : word;
  468.    426
  469.    427        BEGIN (* decodeposition *)
  470.    428        (* recover upper 6 bits from table *)
  471.    429        i := getbyte;
  472.    430        WITH huffcode[i] DO BEGIN
  473.    431          c := code shl 6; j := len; END;
  474.    432        (* read lower 6 bits verbatim *)
  475.    433        (* comment/code dont match *)
  476.    434        dec(j, 2);
  477.    435        WHILE j <> 0 DO BEGIN
  478.    436          dec(j); i := i + i + ord(getbit); END;
  479.    437        decodeposition := c OR (i AND $3f);
  480.    438        END; (* decodeposition *)
  481.    439
  482.    440      (* 2---------------2 *)
  483.    441
  484.    442      FUNCTION readlong : longint;
  485.    443      (* Read 4 bytes, convert into LSByte 1st 32 bit integer *)
  486.    444
  487.    445        VAR
  488.    446          i         : integer;
  489.    447          buff      : RECORD
  490.    448            CASE boolean OF
  491.    449  false :   ( long    : longint);
  492.    450  true  :   (  bytes  : ARRAY[0..3] OF byte);
  493.    451            END; (* buff record *)
  494.    452
  495.    453        BEGIN (* readlong *)
  496.    454        FOR i := 0 TO 3 DO
  497.    455          IF NOT readbyte(buff.bytes[i]) THEN buff.long := 0;
  498.    456        readlong := buff.long;
  499.    457        END; (* readlong *)
  500.    458
  501.    459      (* 2---------------2 *)
  502.    460
  503.    461      BEGIN (* decode *)
  504.    462      textsize := 0; printcount := 0; count := 0;
  505.    463      getbuf := 0; getlen := 0;
  506.    464      textsize := readlong;              (* header is size of text *)
  507.    465      IF textsize > 0 THEN BEGIN
  508.    466  {$IFDEF dbg}
  509.    467        IF debuga THEN writeln('Size=', textsize);
  510.    468  {$ENDIF}
  511.    469        starthuff;
  512.    470        FOR i := 0 TO n - f - 1 DO (* prefill with common char *)
  513.    471          histbuff[i] := ord(' ');
  514.    472        r := n - f;
  515.    473
  516.    474        WHILE count < textsize DO BEGIN
  517.    475          c := decodechar;
  518.    476          IF (c < 256) THEN BEGIN        (* a verbatim character *)
  519.    477  {$IFDEF dbg}
  520.    478            IF debugb THEN write(chr(c));
  521.    479  {$ENDIF}
  522.    480            putbyte(c);
  523.    481            histbuff[r] := c;            (* record in history buff *)
  524.    482            r := succ(r) AND pred(n);    (* advance MODULO n *)
  525.    483            inc(count); END
  526.    484          ELSE BEGIN                     (* posn/lgh in buffer *)
  527.    485            i := pred(r - decodeposition) AND pred(n);
  528.    486            j := c - 255 + threshold;
  529.    487  {$IFDEF dbg}
  530.    488            IF debugb THEN write('<', j, '>');   (* show size *)
  531.    489  {$ENDIF}
  532.    490            FOR k := 0 TO j - 1 DO BEGIN (* copy the string *)
  533.    491              c := histbuff[(i + k) AND pred(n)];
  534.    492  {$IFDEF dbg}
  535.    493              IF debugb THEN write(chr(c));
  536.    494  {$ENDIF}
  537.    495              putbyte(c);
  538.    496              histbuff[r] := c;          (* revising the buffer *)
  539.    497              r := succ(r) AND pred(n); inc(count); END;
  540.    498            END;
  541.    499          IF monitor AND (count > printcount) THEN BEGIN
  542.    500            write(count : 12, #13);      (* show progress *)
  543.    501            printcount := printcount + 1024; END;
  544.    502          END;
  545.    503        END;
  546.    504      IF monitor THEN writeln(count : 12);
  547.    505      END; (* decode *)
  548.    506
  549.    507    (* 1---------------1 *)
  550.    508
  551.    509    BEGIN (* lzhufe *)
  552.    510    filemode := 0;          (* so Turbo handles r/o files *)
  553.    511    IF paramcount <> 2 THEN BEGIN
  554.    512      writeln('Decodes files encoded by LZHUF');
  555.    513      error('Usage: lzhufe infile outfile'); END
  556.    514    ELSE IF NOT freset(infile, paramstr(1)) THEN
  557.    515      error('Can''t open: ' + paramstr(1))
  558.    516    ELSE BEGIN
  559.    517      endofinput := false;
  560.    518      IF NOT frewrite(outfile, paramstr(2)) THEN BEGIN
  561.    519        error('Can''t create: ' + paramstr(2)); END
  562.    520      ELSE BEGIN
  563.    521        decode(readbyte, putbyte, true);      (* do the real work *)
  564.    522        fclose(outfile); END;
  565.    523      fclose(infile); END;
  566.    524    END. (* lzhufe *)
  567.  
  568. Files cross referenced on 1989 Apr 27  8:18 :
  569.   lzhufe.pas
  570.  
  571. IDENTIFIER         OCCURRENCES
  572. ==========         ===========
  573. absolute           150
  574. assign              80    112
  575. b                   58     59
  576. blockread           94
  577. blockwrite         126
  578. boolean             50     51     59     64     73     88    105    171
  579.                .   308    448
  580. buff                54     94     99    126    140    447    455    456
  581. bufflast            52     78     93     94     96    110    125    126
  582.                .   127    129    140    141
  583. buffndx             53     78     93     95     99    110    126    127
  584.                .   129
  585. bufindex           199    229
  586. bufmax             187    199
  587. byte                35     43     44     58     59     88    134    208
  588.                .   214    229    293    450
  589. bytes              450    455
  590. c                   88     97     99    134    140    203    293    300
  591.                .   301    302    331    335    382    384    386    393
  592.                .   395    399    400    401    403    404    405    411
  593.                .   415    416    417    425    431    437    475    476
  594.                .   478    480    481    486    491    493    495    496
  595. char                45
  596. charindex          200
  597. chr                478    493
  598. close              156
  599. code               214    256    431
  600. codemax            188    200
  601. count              204    462    474    483    497    499    500    504
  602. debuga              19    467
  603. debugb              20    478    488    493
  604. dec                391    434    436
  605. decode             169    521
  606. decodechar         328    417    475
  607. decodeposition     422    437    485
  608. encodemin          181
  609. endofinput          64    296    301    517
  610. enter              252    265    266    267    268    269    270
  611. eofmark             23     97
  612. error              161    298    513    515    519
  613. f                   73     77    105    109    120    124    147    150
  614.                .   153    155    180    348    364    366    368    470
  615.                .   472
  616. false               19     79    128    449    517
  617. fcb                 48     63     73    105    120    147
  618. fclose             147    297    522    523
  619. feof                51     82     83     93     96     97    100    114
  620.                .   115    125    128    139    154
  621. fflush             120    141    155
  622. fid                 49     80     81     94    112    113    126    156
  623. filemode           510
  624. filerec             39    150
  625. fmclosed            29    156
  626. fminout             32    154
  627. fminput             30
  628. fmoutput            31    154
  629. fn                  73     80    105    112
  630. fr                 150    154    156
  631. freq               217    278    282    285    356    364    366    368
  632.                .   381    384    387    390    393
  633. freset              73     83    514
  634. frewrite           105    115    518
  635. fwrtaccess          50     79    111    125    139
  636. getbfunc            59    169
  637. getbit             308    312    415    436
  638. getbuf             207    302    312    313    322    323    463
  639. getbyte            318    322    429
  640. getlen             208    299    302    303    311    313    321    323
  641.                .   463
  642. halt               164
  643. handle              40
  644. histbuff           229    471    481    491    496
  645. huffcode           213    255    430
  646. huffroot           194    281    285    354    362    373    411
  647. i                  203    237    248    265    266    267    268    269
  648.                .   270    277    278    279    280    282    283    284
  649.                .   339    347    354    355    356    357    361    363
  650.                .   364    369    370    373    374    375    395    396
  651.                .   397    425    429    430    436    437    446    454
  652.                ,   455    470    471    485    491
  653. ihuff              242    276
  654. inc                140    389    483    497
  655. infile               3     62     92    514    523
  656. integer            203    226    237    238    248    252    318    328
  657.                .   335    339    347    422    446
  658. iobuffer            35     54
  659. iobuffsize          22     35     36     94    141
  660. iobufptr            36     53
  661. ioresult            82     96    114    127
  662. ix                 252    255    257
  663. j                  203    238    280    281    282    283    284    339
  664.                .   347    353    356    357    362    364    365    367
  665.                .   397    399    400    401    425    431    434    435
  666.                .   436    486    488    490
  667. k                  203    339    347    363    364    365    366    367
  668.                .   368    369    374    375    384    387    390    393
  669.                .   490    491
  670. l                  339    348    367    368    369    386    387    389
  671.                .   390    391    393    395    396    397    403
  672. len                214    256    431
  673. lgh                252    256    257
  674. long               449    455    456
  675. longint            204    205    206    442    449
  676. lzhufe               3
  677. max_freq           182    381
  678. message            161    164
  679. mode                41    154    156
  680. monitor            171    499    504
  681. move               368    369
  682. n                  179    470    472    482    485    491    497
  683. n_char             189    277    280    362
  684. name                45
  685. nextbyte           290    311    321
  686. nxtcode            248    256    258    264
  687. ord                415    436    471
  688. outfile              3     63    138    141    297    518    522
  689. output               3
  690. paramcount         511
  691. paramstr           514    515    518    519
  692. parent             223    279    283    285    374    375    382    395
  693.                .   396    399    400    404
  694. parentmax          196    223
  695. pred               277    313    365    366    482    485    491    497
  696. printcount         206    462    499    501
  697. private             43
  698. putbproc            58    170
  699. putbyte            134    170    480    495    521
  700. r                  203    472    481    482    485    496    497
  701. readbyte            88    100    169    300    455    521
  702. readlong           442    456    464
  703. reconst            343    381
  704. recsize             42
  705. reset               81
  706. rewrite            113
  707. shl                257    302    313    323    431
  708. shr                322    356
  709. son                226    279    283    355    357    369    374    395
  710.                .   397    401    411    415
  711. starthuff          233    469
  712. string              73    105    161
  713. succ                99    257    258    282    283    284    356    357
  714.                .   363    367    375    384    386    396    400    482
  715.                .   497
  716. tblmax             195    217    381
  717. tblsize            192    226    279    285    355    375    382    396
  718.                .   400    415    416
  719. textsize           205    462    464    465    467    474
  720. threshold          186    486
  721. true                20    111    301    450    521
  722. update             335    417
  723. userdata            44
  724. word                40     41     42    207    217    223    331    348
  725.                .   425
  726. write              478    488    493    500
  727. writeln            164    467    504    512
  728.  
  729.    124 Identifiers   728 Occurences
  730.      1 Collisions      2 Misses
  731.  
  732. Procedural Cross-Referencer - Version T2.0
  733. ==========================================
  734.  
  735.  Line   Program/procedure/function heading
  736. -------------------------------------------
  737.  
  738.     3   PROGRAM lzhufe(infile, outfile, output);
  739.    73     FUNCTION freset(VAR f : fcb; fn : string) : boolean;
  740.    88     FUNCTION readbyte(VAR c : byte) : boolean;
  741.   105     FUNCTION frewrite(VAR f : fcb; fn : string) : boolean;
  742.   120     PROCEDURE fflush(VAR f : fcb);
  743.   134     PROCEDURE putbyte(c : byte);
  744.   147     PROCEDURE fclose(VAR f : fcb);
  745.   161     PROCEDURE error(message : string);
  746.   169     PROCEDURE decode(readbyte : getbfunc;    (* get data *)
  747.   170                      putbyte  : putbproc;    (* put data *)
  748.   171                      monitor  : boolean);    (* show activity *)
  749.   233       PROCEDURE starthuff;
  750.   242         PROCEDURE ihuff;
  751.   252           PROCEDURE enter(ix, lgh : integer);
  752.   290       PROCEDURE nextbyte;
  753.   308       FUNCTION getbit : boolean;      (* get one bit *)
  754.   318       FUNCTION getbyte : integer;     (* get one byte *)
  755.   328       FUNCTION decodechar : integer;
  756.   335         PROCEDURE update (c : integer);
  757.   343           PROCEDURE reconst;
  758.   422       FUNCTION decodeposition : integer;
  759.   442       FUNCTION readlong : longint;
  760.   524   END. (* lzhufe *)
  761.  
  762.  
  763. Procedural Cross-Referencer - Version T2.0
  764. ==========================================
  765.  
  766.  Head   Body   Notes                    Calls made to
  767. ------------------------------------------------------
  768.   169    461          decode          : readlong        starthuff
  769.                                         decodechar      decodeposition
  770.   328    410          decodechar      : getbit          update
  771.   422    427          decodeposition  : getbyte         getbit
  772.   252    254          enter           :
  773.   161    163          error           :
  774.   147    152          fclose          : fflush
  775.   120    123          fflush          :
  776.    73     76          freset          :
  777.   105    108          frewrite        :
  778.   308    310          getbit          : nextbyte
  779.   318    320          getbyte         : nextbyte
  780.   242    263          ihuff           : enter
  781.     3    509          lzhufe          : error           freset
  782.                                         frewrite        decode
  783.                                         readbyte        putbyte
  784.                                         fclose
  785.   290    295          nextbyte        : fclose          error
  786.   134    137          putbyte         : fflush
  787.    88     91          readbyte        :
  788.   442    453          readlong        :
  789.   343    350          reconst         :
  790.   233    275          starthuff       : ihuff
  791.   335    380          update          : reconst
  792.  
  793.  
  794. Procedural Cross-Referencer - Version T2.0
  795. ==========================================
  796.  
  797.  Head   Body   Notes                    Called by
  798. ------------------------------------------------------
  799.   169    461          decode          : lzhufe
  800.   328    410          decodechar      : decode
  801.   422    427          decodeposition  : decode
  802.   252    254          enter           : ihuff
  803.   161    163          error           : nextbyte        lzhufe
  804.   147    152          fclose          : nextbyte        lzhufe
  805.   120    123          fflush          : putbyte         fclose
  806.    73     76          freset          : lzhufe
  807.   105    108          frewrite        : lzhufe
  808.   308    310          getbit          : decodechar      decodeposition
  809.   318    320          getbyte         : decodeposition
  810.   242    263          ihuff           : starthuff
  811.     3    509          lzhufe          :
  812.   290    295          nextbyte        : getbit          getbyte
  813.   134    137          putbyte         : lzhufe
  814.    88     91          readbyte        : lzhufe
  815.   442    453          readlong        : decode
  816.   343    350          reconst         : update
  817.   233    275          starthuff       : decode
  818.   335    380          update          : decodechar
  819.  
  820. Files scanned on 1989 Apr 27  8:19
  821.   lzhufe.pas
  822. àê