-- XeroxCompressImpl.mesa
-- Copyright (C) 1985 by Xerox Corporation.  All rights reserved.
-- last edited by castillo   10-Jul-85  9:57:58

DIRECTORY
  Environment USING [bitsPerByte, bitsPerWord],
  XeroxCompress,
  Inline USING [
    BITAND, BITSHIFT, BITXOR, DBITXOR, HighByte, HighHalf, LongMult, LowByte,
    LowHalf],
  Space USING [ScratchMap],
  Runtime USING [CallDebugger];

XeroxCompressImpl: PROGRAM
  IMPORTS Inline, Runtime, Space
  EXPORTS XeroxCompress =
  BEGIN OPEN XeroxCompress, Env: Environment;
  -- This module should be identical to XeroxCompress except the
  -- tool's output routine, NakedComment, is called to output stats.

  -- =========
  -- CONSTANTS
  -- =========
  wrdsInScanLine: CARDINAL = 256;
  dWrdsInScanLine: CARDINAL = wrdsInScanLine / 2;
  
  -- =====
  -- TYPES
  -- =====
  BitWrdIndex: TYPE = [0..wrdsInScanLine);
  ScanLine: TYPE = ARRAY [0..wrdsInScanLine) OF CARDINAL;
  ScanLinePtr: TYPE = LONG POINTER TO ScanLine;
  DWScanLine: TYPE = ARRAY [0..dWrdsInScanLine) OF LONG CARDINAL;
  DWScanLinePtr: TYPE = LONG POINTER TO DWScanLine;

  -- ================
  -- GLOBAL VARIABLES
  -- ================
  htnBuf: ScanLinePtr ← NIL;  -- Buffer to store HTN prediction results
  linBuf: DWScanLinePtr ← NIL;  -- Buffer to store LIN prediction results

  -- =================
  -- PUBLIC PROCEDURES
  -- =================

  CompressPlate: PUBLIC PROCEDURE [
    scanLen: CARDINAL, scanLineProc: ScanLineProc, putBitsProc: PutBitsProc]
    RETURNS [xPixels: CARDINAL, byteSize: LONG CARDINAL] =
    BEGIN
    
    -- =========
    -- CONSTANTS
    -- =========
    nNibs: CARDINAL = 4;  -- Number of nibbles in a word
    nRange: CARDINAL = 8;  -- HTN predictor sample (bits)

    -- IMG code
    enc: CARDINAL = 2;  -- ENC mode
    eoi: CARDINAL = 113;  -- End of image
    htn: CARDINAL = 3;  -- HTN mode
    lin: CARDINAL = 1;  -- LIN mode
    raw: CARDINAL = 0;  -- Raw (ie., no encoding)
    soi: CARDINAL = 112;  -- Start of image

    maxLINCount: CARDINAL = 15;  -- Maximum consequtive LIN mode lines
    nibMask: ARRAY [0..nNibs) OF CARDINAL = [170000B, 7400B, 360B, 17B];
    -- Mask array to get nibbles from a word
    nibVal: ARRAY [0..15] OF INTEGER = [
      0, 3, 2, -4, 1, -5, -6, -7, 0, -9, -10, -11, -12, -13, -14, -15];
      -- This table of values enable the appropriate bit
      -- representation and descriptor employment for encoding a
      -- given nibble of prediction output.
      --  IF nibVal[nibble] < 0 THEN prediction output has more
      --    than one bit on.
      --  IF nibVal[nibble] >= 0 THEN prediction output has only
    --    one bit on.
    --  Note: nibVal[0] is not used.

    --
    -- Local variables used during CompressPlate
    --
  
    -- Parameters used in estimating feasibility of various modes
    iRAWPercent: INTEGER ← 67;
    iRAWCt: INTEGER ← 0;
      -- A limit representing the point at which to output a 
      -- raster line in its raw form rather than in one of the
      -- encoded forms.
    minNibPercent: INTEGER ← 1;
    minNibCt: INTEGER ← 0;
      -- A limit repesenting the point at which an encoded
      -- prediction result indicates that a desirable level of
      -- compression is achievable.  The value of minNibCt 
      -- represents the percentage for comparison with the given
      -- predicted results.

    debugLine: CARDINAL ← LAST[CARDINAL];

    cBits: LONG CARDINAL ← 0;  -- Total bits in compressed image
    blankLn: CARDINAL ← 0;  -- Current # of contiguous blank lines
    currLine: ScanLinePtr ← NIL;  -- Current scan line used by  GoENC.
    -- It should be equal to nwLine,
    -- pvLine or address of htnBuf.
    encLines: CARDINAL ← 0;  -- Number lines in ENC mode
    htnLines: CARDINAL ← 0;  -- Number of lines in HTN mode
    htnNibCt: INTEGER ← 0;  -- Number of non-zero nibble resulting
    -- from HTN predicition mode
    iFirst: CARDINAL ← 0;  -- Index of first dword in currLine used by
    -- GoEnc when encoding.
    iRun: CARDINAL ← 0;  -- Running count of zero words
    iLast: CARDINAL ← 0;  -- Index of last dword in currLine used by
    -- GoEnc when encoding.
    linCount: CARDINAL ← 0;  -- Consecutive # of LIN mode lines
    linLines: CARDINAL ← 0;  -- Number of lines in LIN mode
    linNibCt: INTEGER ← 0;  -- Number of non-zero nibble
    -- resulting from LIN prediction mode.
    lastWord: BitWrdIndex ← 0;  -- Last word in a line
    nwLine: DWScanLinePtr ← NIL;  -- Pointer to current scan line
    nwNibCt: INTEGER ← 0;  -- non-zero nibble count in current line
    nw1st: BitWrdIndex ← 0;  -- Index to 1st non-zero dword in
    -- current line
    nwLast: BitWrdIndex ← 0;  -- Index to last non-zero dword in
    -- current line 
    pvLine: DWScanLinePtr ← NIL;  -- Pointer to last scan line.  If
    -- LIN mode is utilized, the XORed
    -- bits of the line will be put here.
    pvNibCt: INTEGER;  -- non-zero nibble count in previous line
    pv1st: BitWrdIndex ← 0;  -- Pointer to 1st non-zero dword in
    -- previous line
    pvLast: BitWrdIndex ← 0;  -- Pointer to last non-zero dword in
    -- previous line
    rawLines: CARDINAL ← 0;  -- Number of lines in RAW mode
    scnLines: CARDINAL ← 0;  -- Total number of scan lines
    totalBits: LONG CARDINAL ← 0;  -- Total number of bits in image

    PutBits: PutBitsProc ← NIL;
    
    dummyLine1: ScanLinePtr;
    dummyLine2: ScanLinePtr;
          
    -- ==========
    FlushBlankLines: PROCEDURE = INLINE
      BEGIN
      IF blankLn # 0 THEN {
        FOR i: CARDINAL IN [0..blankLn) DO
          PutByte[enc]; encLines ← encLines + 1; ENDLOOP;
        blankLn ← 0;
        };
      END;  -- FlushBlankLines

    -- ==========
    GetEstimateAndLimits: PROCEDURE
      RETURNS [
        c: INTEGER, nw1st: BitWrdIndex, nwLast: BitWrdIndex,
        iRun: CARDINAL] =
      BEGIN
      -- This routine will compute various limits that are used
      -- later in determining which prediction model to use.
      lWord, hWord: CARDINAL;
      nw1st ← 0;
      c ← 0;
      
      FOR i: CARDINAL IN [0..lastWord] DO  -- For every dword
        IF nwLine[i] # 0 THEN { -- found non zero word.
	  nw1st ← i;
	  FOR ind: CARDINAL IN [i..lastWord] DO -- every dword
	    IF nwLine[ind] # 0 THEN {
	      nwLast ← ind;
              IF (lWord ← Inline.LowHalf[nwLine[ind]]) # 0 THEN {
                IF Inline.BITAND[lWord, 17B] # 0 THEN c ← c + 1;
                IF Inline.BITAND[lWord, 360B] # 0 THEN c ← c + 1;
                IF Inline.BITAND[lWord, 7400B] # 0 THEN c ← c + 1;
                IF Inline.BITAND[lWord, 170000B] # 0 THEN c ← c + 1;
                };
              IF (hWord ← Inline.HighHalf[nwLine[ind]]) # 0 THEN {
                IF Inline.BITAND[hWord, 17B] # 0 THEN c ← c + 1;
                IF Inline.BITAND[hWord, 360B] # 0 THEN c ← c + 1;
                IF Inline.BITAND[hWord, 7400B] # 0 THEN c ← c + 1;
                IF Inline.BITAND[hWord, 170000B] # 0 THEN c ← c + 1;
                };
	      }; -- nwLine[ind] # 0
	    ENDLOOP;
	  EXIT;
	  }; -- nwLine[i] # 0
	ENDLOOP;
      iRun ← nw1st;  -- running count of zero words
      END;  --GetEstimateAndLimits

    -- ==========
    GetHTNPredictData: PROCEDURE RETURNS [nibCt: INTEGER] =
      BEGIN
      -- This routine will compute htnNibCt which are used later
      -- in determining whethter HTN mode is feasible for the line.
      first: CARDINAL ← nw1st * 2;
      last: CARDINAL;
      lastDWord: CARDINAL ← lastWord;
      kWord: CARDINAL;
      pvByte: CARDINAL ← 0;
      nLine: ScanLinePtr ← LOOPHOLE[nwLine];
      
      nibCt ← 0;
      -- Get that last word.  Had to add 2 since we are usually 
      -- dealing with double words.
      last ← MIN[((nwLast * 2) + 2) + 1, (lastWord * 2) + 1];
      FOR i: CARDINAL IN [first..last] DO  --every word
        kWord ← Inline.BITXOR[
          Inline.BITSHIFT[pvByte, 8] + Inline.HighByte[nLine[i]], nLine[i]];
        -- Count the number of non-zero nibbles
        IF kWord # 0 THEN {
          IF Inline.BITAND[kWord, 17B] # 0 THEN nibCt ← nibCt + 1;
          IF Inline.BITAND[kWord, 360B] # 0 THEN nibCt ← nibCt + 1;
          IF Inline.BITAND[kWord, 7400B] # 0 THEN nibCt ← nibCt + 1;
          IF Inline.BITAND[kWord, 170000B] # 0 THEN nibCt ← nibCt + 1;
          };
        htnBuf[i] ← kWord;
        pvByte ← Inline.LowByte[nLine[i]];
        ENDLOOP;  -- every byte
      END;  -- GetHTNPredictData

    -- ==========
    GetLINPredictData: PROCEDURE [nwLine: DWScanLinePtr, pvLine: DWScanLinePtr]
      RETURNS [c: INTEGER] =
      BEGIN
      -- This routine will compute linNibCt (count of non-zero
      -- nibble used in LIN mode.  iFirst and iLast which are used
      -- when encoding the line difference are also obtained.
      -- obtain the limits where the XOR can start
      kWord: LONG CARDINAL;
      lWord, hWord: CARDINAL;
      iFirst ← MIN[nw1st, pv1st];
      iLast ← MAX[nwLast, pvLast];
      -- set the pointer of line used by encoding routines to
      -- pvLine (LIN XOR results are stored in linBuf)
      c ← -1;

      FOR i: CARDINAL IN [iFirst..iLast] DO  -- every non-zero dword
        -- XOR line
        kWord ← linBuf[i] ← Inline.DBITXOR[nwLine[i], pvLine[i]];
	IF kWord # 0 THEN {
          IF (lWord ← Inline.LowHalf[kWord]) # 0 THEN {
            IF Inline.BITAND[lWord, 17B] # 0 THEN c ← c + 1;
            IF Inline.BITAND[lWord, 360B] # 0 THEN c ← c + 1;
            IF Inline.BITAND[lWord, 7400B] # 0 THEN c ← c + 1;
            IF Inline.BITAND[lWord, 170000B] # 0 THEN c ← c + 1;
            };
          IF (hWord ← Inline.HighHalf[kWord]) # 0 THEN {
            IF Inline.BITAND[hWord, 17B] # 0 THEN c ← c + 1;
            IF Inline.BITAND[hWord, 360B] # 0 THEN c ← c + 1;
            IF Inline.BITAND[hWord, 7400B] # 0 THEN c ← c + 1;
            IF Inline.BITAND[hWord, 170000B] # 0 THEN c ← c + 1;
	    };
	  };
        ENDLOOP;  -- every non-zero dword
      c ← c + 1;
      END;  --GetLINPredictData

    -- ============
    GoENC: PROCEDURE [iRun: CARDINAL] =
      -- iRun passed as argument for efficiency reason
      BEGIN
      kmpVal: CARDINAL;
      kWd: CARDINAL;
      nibble: CARDINAL;
      nibInd: INTEGER;
      nibTrn: INTEGER;
      shftr: CARDINAL;

      -- ======
      Go11ggggggabcd: PROCEDURE = INLINE
        BEGIN
        Put3Nibbles[
          6000B + Inline.BITAND[Inline.BITSHIFT[iRun, 4], 1760B] + nibble];
        iRun ← 0;
        END;  --Go11ggggggabcd

      -- ======
      Go10XXorA: PROCEDURE = INLINE
        BEGIN

        IF iRun = 0 THEN
          -- Output if the form 10XXorA
          PutNibble[8 + nibTrn]
        ELSE {
          PutByte[Inline.BITAND[Inline.BITSHIFT[iRun, 2], 174B] + nibTrn];
          iRun ← 0;
          };
        END;  -- Go10XXorA 

      -- ======
      -- Main of GoENC
      -- change running count of non-zero words to non-zero nibbles
      iRun ← iRun * nNibs * 2;
      -- change iFirst and iLast to words indices
      iFirst ← iFirst * 2;
      iLast ← (iLast * 2) + 1;
      FOR i: CARDINAL IN [iFirst..iLast] DO  -- every word
        kWd ← currLine[i];
        nibInd ← 0;
        WHILE kWd # 0 DO  -- every nibble
          nibble ← Inline.BITAND[kWd, nibMask[nibInd]];
          nibInd ← nibInd + 1;
          IF nibble = 0 THEN iRun ← iRun + 1
          ELSE
            BEGIN
            kWd ← kWd - nibble;
            nibble ← Inline.BITSHIFT[nibble, -(Env.bitsPerWord - 4 * nibInd)];
            -- nonZero Nibble obtained. Encode run length
            shftr ← Inline.BITSHIFT[iRun, -2];
            kmpVal ← Inline.BITAND[shftr, 1760B];
            IF kmpVal # 0 THEN {
              -- 11gggggg0000 case
              Put3Nibbles[kmpVal + 6000B];  -- get rid of most iRun
              iRun ← Inline.BITAND[iRun, 77B]};
            -- Determine Descriptor to be used for data nibble
            IF iRun > 25 THEN {
              Go11ggggggabcd[];
              LOOP;  -- done with this nibble
              };
            -- Descriptor determination requires nibble be evaluated 
            nibTrn ← nibVal[nibble];
            IF nibTrn >= 0 THEN {
              Go10XXorA[];
              LOOP;  -- done with this nibble
              };
            -- Nibble has more than one bit on
            IF iRun > 1 THEN {
              Go11ggggggabcd[];
              LOOP;  -- done with this nibble
              };
            -- Encode using Type 'B short descriptor
            PutByte[140B - (nibTrn + nibTrn) + iRun];
            iRun ← 0;
            END;  -- IF nibble = 0 ELSE
          ENDLOOP;  -- every nibble
        -- adjust for trailing zero nibbles of word
        iRun ← iRun + (nNibs - nibInd);
        ENDLOOP;  -- every word

      END;  -- GoENC

    -- ============
    GoENCorRAW: PROCEDURE =
      BEGIN
      -- This routine will decide whether RAW mode or ENC mode is
      -- more feasible.
      IF nwNibCt >= iRAWCt THEN GoRAW[]
      ELSE
        BEGIN
        -- Scan line to be encoded with no prediction
        linCount ← 0;
        encLines ← encLines + 1;
        PutByte[enc];
        currLine ← LOOPHOLE[nwLine];
        iFirst ← nw1st;
        iLast ← nwLast;
        GoENC[iRun];
        END;
      END;  -- GoENCorRAW

    -- ===========
    GoLINorRAW: PROCEDURE =
      BEGIN
      -- This routine will decide whether LIN mode or RAW mode is
      -- more feasible.
      IF linNibCt >= iRAWCt THEN GoRAW[]
      ELSE {
        -- Use LIN mode.  Remember that pvLine was used as buffer
        -- for XORed bits
        linCount ← linCount + 1;
        linLines ← linLines + 1;
        currLine ← LOOPHOLE[linBuf];
        PutByte[lin];
        iRun ← iFirst;  -- adjust running count of zero words
        GoENC[iRun];  -- encode
        };
      END;  -- GoLINorRAW

    -- ============
    GoLINorHTNorRAW: PROCEDURE =
      BEGIN
      -- This routine is faced with a decision whether to go with
      -- LIN, HTN or RAW mode
      IF (linNibCt < htnNibCt) AND (linNibCt > 0) THEN GoLINorRAW[]
      ELSE {
        IF htnNibCt > iRAWCt THEN GoRAW[]
        ELSE {
          -- HTN mode seems most feasible
          linCount ← 0;
          htnLines ← htnLines + 1;
          PutByte[htn];
          iFirst ← nw1st;
          iLast ← MIN[nwLast + 1, lastWord];
          currLine ← htnBuf;
          -- iRun should remain the same.
          GoENC[iRun];  -- encode
          };
        };
      END;  --GoLINorHTNorRAW

    -- ============
    GoRAW: PROCEDURE =
      BEGIN
      -- Go RAW!
      linCount ← 0;
      rawLines ← rawLines + 1;
      PutByte[0];
      FOR i: CARDINAL IN [0..lastWord] DO
        PutWord[Inline.LowHalf[nwLine[i]]];
	PutWord[Inline.HighHalf[nwLine[i]]];
        ENDLOOP;
      END;  -- GoRAW;
    -- =====
    Put3Nibbles: PROCEDURE [val: CARDINAL] = INLINE {
      PutBits[val, 12]; cBits ← cBits + 12};

    -- =====
    PutByte: PROCEDURE [val: CARDINAL] = INLINE {
      PutBits[val, Env.bitsPerByte]; cBits ← cBits + Env.bitsPerByte};

    -- =====
    PutNibble: PROCEDURE [val: CARDINAL] = INLINE {
      PutBits[val, 4]; cBits ← cBits + 4};

    -- =====
    PutWord: PROCEDURE [val: CARDINAL] = INLINE {
      PutBits[val, Env.bitsPerWord]; cBits ← cBits + Env.bitsPerWord};

    -- 
    -- Main of CompressPlate
    --
    -- Change prediction estimate parameter from % to nibbles
    iRAWCt ← Inline.LowHalf[Inline.LongMult[iRAWPercent, scanLen] / 400];
    minNibCt ← Inline.LowHalf[Inline.LongMult[minNibPercent, scanLen] / 400];
    PutBits ← putBitsProc;
    lastWord ← ((scanLen + 31) / 32) - 1;
    PutWord[0];  -- Reserved
    PutWord[nRange];
    PutWord[scanLen];  -- scan length    
    PutByte[soi];  -- Put start of image
    blankLn ← 0;
    iRun ← 0;
    nw1st ← 0;
    nwLast ← 0;
    nwNibCt ← 0;
    linCount ← 0;

    DO  -- every scan line

      scnLines ← scnLines + 1;
      totalBits ← totalBits + scanLen;
      [dummyLine1, dummyLine2] ← scanLineProc[];
      nwLine ← LOOPHOLE[dummyLine1];
      pvLine ← LOOPHOLE[dummyLine2];
      IF nwLine = NIL THEN EXIT;  -- no more    
      -- Set up predictor parameters from previous line
      pvNibCt ← nwNibCt;
      pv1st ← nw1st;
      pvLast ← nwLast;
      IF scnLines = debugLine THEN
        Runtime.CallDebugger["Desired line encountered"L];
      -- Compute estimate and limits for encoding this line
      [nwNibCt, nw1st, nwLast, iRun] ← GetEstimateAndLimits[];
      --     
      IF nwNibCt = 0 THEN blankLn ← blankLn + 1
      ELSE
        BEGIN
        -- Output deferred blank lines, if any
        FlushBlankLines[];
        -- See if short-cut estimate for encoding data can be used
        IF nwNibCt < minNibCt THEN {
          GoENCorRAW[];  -- output current line in ENC or RAW mode
          LOOP;
          };  -- done with this line
        -- See if LIN mode is feasible 
        linNibCt ← -1;
        IF ((2 * ABS[nwNibCt - pvNibCt]) < nwNibCt) AND (linCount < maxLINCount)
          THEN
          BEGIN
          -- get linNibCt for LIN mode
          linNibCt ← GetLINPredictData[nwLine, pvLine];
          -- Try short-cut estimate for LIN mode
          IF linNibCt < minNibCt THEN {
            GoLINorRAW[];
            LOOP;  -- done with this line
            };
          END;
        -- Short-cut method for LIN failed, see if HTN can be used
        htnNibCt ← GetHTNPredictData[];  -- htnNibCt obtained

        -- Results from feasible prediction modes have been
        -- obtained.  Use results to estimate most compressable
        -- mode to employ
        IF nwNibCt > htnNibCt THEN {
          GoLINorHTNorRAW[];  --  Try LIN, HTN, or RAW 
          LOOP;  -- done with this line
          };
        IF linNibCt < 0 OR linNibCt >= nwNibCt THEN {
          GoENCorRAW[];  -- all prediction not feasible, ENC or RAW
          LOOP;  -- done with this line
          };
        --Try Raw or LIN mode
        GoLINorRAW[];
        END;

      ENDLOOP;  -- every scan line

    -- Ensure at least one line is output
    IF rawLines + encLines + linLines + htnLines = 0 THEN {
      PutByte[enc];
      encLines ← encLines + 1;};
    PutByte[eoi];  -- End of image

    xPixels ← encLines + linLines + htnLines + rawLines;
    byteSize ← (cBits + Env.bitsPerByte - 1) / Env.bitsPerByte;
    
    END;  -- CompressPlate

  -- =====
  Initialize: PUBLIC PROCEDURE [heap: UNCOUNTED ZONE ← NIL] =
    BEGIN
    IF heap # NIL THEN {htnBuf ← heap.NEW[ScanLine]; linBuf ← heap.NEW[DWScanLine]}
    ELSE {
      htnBuf ← Space.ScratchMap[count: 1]; linBuf ← Space.ScratchMap[count: 1]};
    END;  -- Initialize
    
  END.
 
LOG
14Sep84 - Okamoto - Creation
31Jan85 - Okamoto - Performance improvement by using double words.
28Feb85 - Okamoto - For blank page, xpixels is set one.
10Jul85 - castillo - copyright notice.