Topspeed_JPI/TS-V3/REP16/MEMCOMPR.LST

Listing:

    1  IMPLEMENTATION MODULE MemCompress;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/memcompr.mov   1.5   10 Mar 1991 15:29:32   coleb  $
   12   *
   13   *
   14   *  Written and contributed by Doug Whitfield of Hornby Island,
   15   *  British Columbia.
   16   *
   17   *)
   18  
   19  
   20    IMPORT SYSTEM;
   21    IMPORT LowLevel;
   22    IMPORT VStorage;
   23  
   24  VAR
   25    Initialized : BOOLEAN;
   26  
   27    PROCEDURE Init();
   28      BEGIN
   29        IF Initialized THEN
   30          RETURN;
   31        ELSE
   32          Initialized := TRUE;
   33        END;
   34        LowLevel.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   35        VStorage.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   36      END Init;
*****          ^ not supported yet
   37  
   38  
   39  (* These procedures perform run-length coding compression and
   40  decompression of memory blocks.  InAddress and InSize are input
   41  parameters specifing the starting address and length (in bytes)
   42  of the memory block to be compressed or decompressed.  If
   43  OutAlloc is TRUE, OutAddress and OutSize are taken as input
   44  parameters by Compress and the compressed block is put at the
   45  specified location.  If OutAlloc is FALSE, Compress attempts to
   46  allocate memory for the compressed block. If the allocation
   47  fails, the compression is abandoned and Compress returns the
   48  value FALSE with ErrorFlag set to AllocationFailed.  If the
   49  allocation is successful, Compress returns the allocated area's
   50  address and size.  The maximum size of memory block it will
   51  allocate is InSize bytes.  If, during compression, the compressed
   52  block exceeds the specified  OutSize (when OutAlloc is TRUE) or
   53  InSize (when OutAlloc is FALSE), the compression is abandoned and
   54  Compress returns the value FALSE, with ErrorFlag set to
   55  CompressedTooLarge.  (A compressed block can exceed the size of
   56  the uncompressed block from which it is derived if the latter
   57  contains characters with ordinal value 254, as this value is used
   58  as a designator for the start of a run, and isolated occurences
   59  of this character must be translated into two successive
   60  characters to avoid ambiguity.)  If compression is successfully
   61  completed, Compress returns the value TRUE with ErrorFlag set to
   62  NoCompressError.
   63  
   64  Decompress performs no error testing, and thus assumes that the
   65  size of memory specified to receive the decompressed block is
   66  sufficiently large.  If Decompress is called with OutSize equal
   67  to the value of InSize used during compression, this will be
   68  true.
   69  
   70  Compress will yield a useful degree of compression if the input
   71  memory block contains runs of successive bytes containing the
   72  same value.  Such may be the case, for example, in CGA and EGA
   73  graphics mode screen images. *)
   74  
   75  
   76    TYPE
   77      Address8086 =
   78        RECORD
   79          CASE : CARDINAL OF
*****          ^ not supported yet
*****                          ^ 'POINTER' expected
   80            1 :
   81            a : SYSTEM.ADDRESS;
   82           |2 :
   83            b : POINTER TO CHAR;
   84          END;
   85        END;
   86  
   87    VAR
   88      NewCharOrd, OldCharOrd, TempOutSize: CARDINAL;
   89      InCount, OutCount, RunCount, MaxRunCount, CharOrd, Index:
   90          CARDINAL;
   91      InAddress, OutAddress: SYSTEM.ADDRESS;
   92      InCharPointer, OutCharPointer: Address8086;
   93      Char: CHAR;
   94  
   95    PROCEDURE GetChar():CARDINAL;
   96    BEGIN
   97      Char := InCharPointer.b^;
   98      LowLevel.IncAddr( InCharPointer.a, 1 );
   99      INC (InCount);
  100      RETURN ORD(Char);
  101    END GetChar;
  102  
  103    PROCEDURE PutChar (CharOrd:CARDINAL);
  104    BEGIN
  105      Char := CHR (CharOrd);
  106      OutCharPointer.b^ := Char;
  107      LowLevel.IncAddr( OutCharPointer.a, 1 );
  108      INC(OutCount);
  109    END PutChar;
  110  
  111    PROCEDURE CompOut (CharOrd:CARDINAL;RunCount:CARDINAL);
  112    BEGIN
  113      IF CharOrd = 254 THEN
  114        IF RunCount > 1 THEN
  115          PutChar(254); PutChar(RunCount); PutChar(254)
  116        ELSE
  117          PutChar(254); PutChar(254)
  118        END (*IF*);
  119      ELSE
  120        IF RunCount = 1 THEN
  121          PutChar(CharOrd)
  122        ELSIF RunCount = 2 THEN
  123          PutChar(CharOrd); PutChar(CharOrd)
  124        ELSE
  125          PutChar(254); PutChar(RunCount);PutChar(CharOrd)
  126        END (*IF*);
  127      END (*IF*);
  128    END CompOut;
  129  
  130    PROCEDURE Compress (InAddress: SYSTEM.ADDRESS; InSize:CARDINAL;
  131                   VAR OutAddress: SYSTEM.ADDRESS; VAR OutSize:CARDINAL;
  132                   OutAlloc:BOOLEAN):BOOLEAN;
  133    BEGIN
  134      ErrorFlag := Corruption;
  135      IF NOT OutAlloc THEN
  136        IF VStorage.DosAvail (InSize + 5) THEN
  137          VStorage.DosAlloc(OutAddress, InSize + 5);
  138          TempOutSize := InSize
  139        ELSE
  140          ErrorFlag := AllocationFailed;
  141          RETURN FALSE;
  142        END;
  143      ELSE
  144        TempOutSize := OutSize
  145      END;
  146      InCharPointer.a := InAddress; OutCharPointer.a := OutAddress;
  147      InCount := 0; OutCount :=0;
  148      OldCharOrd := GetChar();
  149      LOOP
  150        RunCount := 1;
  151        MaxRunCount := InSize - InCount + 1;
  152        IF MaxRunCount > 253 THEN MaxRunCount := 253 END;
  153        LOOP
  154          NewCharOrd :=GetChar();
  155          IF NewCharOrd = OldCharOrd THEN
  156            INC (RunCount);
  157            IF RunCount = MaxRunCount THEN EXIT END
  158          ELSE
  159            EXIT
  160          END (*IF*)
  161        END (*LOOP*);
  162        CompOut (OldCharOrd,RunCount);
  163        IF OutCount >= TempOutSize THEN;
  164          IF NOT OutAlloc THEN
  165            VStorage.DosDealloc(OutAddress,InSize + 5);
  166          END;
  167          ErrorFlag := CompressedTooLarge;
  168          RETURN FALSE
  169        END;
  170        OldCharOrd := NewCharOrd;
  171        IF InCount = InSize THEN
  172          IF RunCount # MaxRunCount THEN CompOut (OldCharOrd,1) END;
  173          EXIT
  174        END (*IF*)
  175      END (*LOOP*);
  176      IF NOT OutAlloc THEN
  177        OutSize := OutCount;
  178        VStorage.DosDealloc(OutCharPointer.a,InSize + 5 - OutSize);
  179      END;
  180      ErrorFlag := NoCompressError;
  181      RETURN TRUE;
  182  
  183    END Compress;
  184  
  185    PROCEDURE Decompress (InAddress: SYSTEM.ADDRESS; InSize:CARDINAL;
  186                   OutAddress: SYSTEM.ADDRESS; OutSize:CARDINAL);
  187    BEGIN
  188      InCharPointer.a := InAddress; OutCharPointer.a := OutAddress;
  189      InCount := 0; OutCount := 0;
  190      WHILE InCount < InSize DO
  191        CharOrd := GetChar();
  192        IF CharOrd = 254 THEN
  193          RunCount := GetChar();
  194          IF RunCount = 254 THEN
  195            PutChar (254)
  196          ELSE
  197            CharOrd := GetChar();
  198            FOR Index := 1 TO RunCount DO
  199              PutChar (CharOrd);
  200            END (*FOR*)
  201          END (*IF*);
  202        ELSE
  203          PutChar (CharOrd)
  204        END (*IF*)
  205      END (*WHILE*);
  206      OutSize := OutCount;
  207    END Decompress;
  208  
  209  BEGIN
  210    Initialized := FALSE;
  211    Init();
  212  END MemCompress.

    9 errors