ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/UTILITY/FILE/JLPAK10.ZIP/JLUNPAK.BAS

BASIC Source File | 1990-08-19 | 36.6 KB | 1,130 lines

DEFINT A-Z

DECLARE SUB GetCommNames ()
DECLARE FUNCTION FileExists! (testfile$)
DECLARE FUNCTION GetBit ()
DECLARE SUB OutputSub (OctetValue)
'  $INCLUDE: 'qb.bi'


CONST IBUF% = 100
REM IBUF% is the input buffer size for obtaining the ascii value of each
REM byte.  Speed seems relatively independent of the IBUF% size.

CONST ISIZE% = 32000
REM This is the hunk of the old file that we work with.   We read in the first
REM 32000 (or all if less),  and discard as commanded in the compressed format.
REM This is a parameter of the FCM format.

CONST ISIZE2% = 24000
REM This is the amount of FCM we do before moving it.

CONST ISIZE3% = 12000
REM And this is the amount we move it down each time.

CONST ISEG% = 16
REM This is the size of typeA and no match blocks,  and is a parameter of the
REM compressed (FCM) format.

REM $DYNAMIC

DIM bytesold(ISIZE%)
REM This is the array of bytes from the old version

DIM bytesfcm(ISIZE%)
REM This is the array of bytes from the FCM format file

DIM bits$(0 TO 255)
REM holds the bitstring for each of the values of an octet.

DIM gdiff(4)
REM Used to hold the global difference values we maintain.

REM SHARED reffile$,  fcmfile$,  newfile$, workfile$,  diaglevel$,  diagoutput$

COLOR 15, 1, 1

Trace = 1

CALL GetCommNames
IF Workfile$ = "DEFAULT" then Workfile$ = "TEMP.TMP"

done& = 0
usedold& = 0
donefcm& = 0
REM This is the amount of the fcm file that we have already processed as a
REM previous hunk,  and of the old file that we have used.

bitval$ = "00000000"
FOR i = 0 TO 254
bits$(i) = bitval$
ptr = 8
doneadd = 0
WHILE doneadd = 0
  IF MID$(bitval$, ptr, 1) = "0" THEN
     MID$(bitval$, ptr, 1) = "1"
     doneadd = 1
  ELSE
     MID$(bitval$, ptr, 1) = "0"
     ptr = ptr - 1
  END IF
WEND
NEXT i
bits$(255) = bitval$

dgf = 0
IF INSTR(diaglevel$,"T") <> 0 THEN
dgf = FREEFILE
OPEN diagoutput$ FOR OUTPUT AS #dgf
END IF

IF INSTR(Diaglevel$, "P") <> 0 THEN
   CLS
   LOCATE 2, 25
   COLOR 14, 4, 1
   PRINT "Forward decompression program";
   COLOR 15, 1, 1
END IF

IF INSTR(diaglevel$,"B") <> 0 THEN
PRINT "JLUNPAK Copyright IT Institute 1990 - Forward decompression program version 1.0"
PRINT " "
bline = CSRLIN
locate bline,1
PRINT "Percent done is: 0%     Reading in files for processing - please wait ..." ;
END IF

fpfcm = FREEFILE
buff$ = STRING$(IBUF%, " ")
IF FileExists(Fcmfile$) THEN
   OPEN Fcmfile$ FOR BINARY AS #fpfcm
ELSE
PRINT "**** ERROR - File to be decompressed (" + Fcmfile$ + ") does not exist"
   if dgf <> 0 then CLOSE #dgf
   END
END IF

WHILE NOT EOF(fpfcm)
       GET #fpfcm, , buff$
WEND
lengthfcm& = LOC(fpfcm)

CLOSE #fpfcm
OPEN Fcmfile$ FOR BINARY AS #fpfcm

ICNT2 = 0
WHILE NOT EOF(fpfcm) AND ICNT2 + IBUF% <= ISIZE%
     GET #fpfcm, , buff$
     FOR i = 1 TO IBUF%
     ICNT2 = ICNT2 + 1
     bytesfcm(ICNT2) = ASC(MID$(buff$, i, 1))
     NEXT i
WEND

realendfcm = ISIZE%
endfcm = ISIZE2%
IF lengthfcm& < ISIZE% THEN
     endfcm = lengthfcm&
     realendfcm = lengthfcm&
END IF

IF INSTR(Diaglevel$, "P") <> 0 THEN
      LOCATE 11, 1
      PRINT "First hunk of fcm file loaded - total length is " + STR$(lengthfcm&) + " bytes";
END IF

fcmpointer = 1

' 1.  a length count (one octet)for the next item.
' 2.  the full path name of the file that is to be compressed
'     (on decompression,  a file TEMP.TMP will be created in the current
'     directory,  and then copied to the original destination path when
'     decompression is complete,  unless overridden by a different target).
' 3.  two octets of sum check for the whole of this file;  the sum check
'     is the standard one of SIGMA(Ai) and SIGMA(iAi),  all MOD 255.
' 4.  a length count for the next item.
' 5.  the full path name of the reference file (this can be overridden
'     on decompression)
' 6.  two octets of sum check for the first 1K of the reference file.

octlen = bytesfcm(fcmpointer)
newfiledef$ = ""
for ijl = 1 to octlen
newfiledef$ = newfiledef$ + chr$(bytesfcm(fcmpointer + ijl))
next ijl
if newfile$ = "DEFAULT" then newfile$ = newfiledef$
fcmpointer = fcmpointer + octlen + 1
sumcheckval1 = bytesfcm(fcmpointer)
sumcheckval2 = bytesfcm(fcmpointer + 1)
fcmpointer = fcmpointer + 2
octlen = bytesfcm(fcmpointer)
oldfiledef$ = ""
for ijl = 1 to octlen
oldfiledef$ = oldfiledef$ + chr$(bytesfcm(fcmpointer + ijl))
next ijl
if reffile$ = "DEFAULT" then reffile$ = oldfiledef$
fcmpointer = fcmpointer + octlen + 1
oldsumcheckval1 = bytesfcm(fcmpointer)
oldsumcheckval2 = bytesfcm(fcmpointer + 1)
fcmpointer =fcmpointer + 2

IF INSTR(Diaglevel$, "P") <> 0 THEN
   LOCATE 5, 1
   PRINT "Decompressing " + Fcmfile$ + " using " + Reffile$ + " as a reference file";
END IF

fpold = FREEFILE
buff$ = STRING$(IBUF%, " ")
IF FileExists(Reffile$) THEN
   OPEN Reffile$ FOR BINARY AS #fpold
ELSE
PRINT "**** ERROR - Reference file " + Reffile$ + " does not exist"
   if dgf <> 0 then CLOSE #dgf
   CLOSE #fpfcm
   END
END IF

checked = 0
oldsumcheck1 = 0
oldsumcheck2 = 0
WHILE NOT EOF(fpold)
       GET #fpold, ,buff$
if checked < 10 then
   checked = checked + 1
   if not eof(fpold) then
       for i = 1 to IBUF%
       octval = ASC(MID$(buff$,i,1))
       oldsumcheck1 = (oldsumcheck1 + octval) MOD 255
       oldsumcheck2 = (oldsumcheck2 + oldsumcheck1) MOD 255
       next i
   else
       lengthold& = loc(fpold)
       for i = 1 to (lengthold& MOD IBUF%)
       octval = ASC(MID$(buff$,i,1))
       oldsumcheck1 = (oldsumcheck1 + octval) MOD 255
       oldsumcheck2 = (oldsumcheck2 + oldsumcheck1) MOD 255
       next i
   end if
end if
WEND
lengthold& = loc(fpold)

CLOSE #fpold

IF oldsumcheckval1 <> oldsumcheck1 OR oldsumcheckval2 <> oldsumcheck2 THEN
     PRINT "**** ERROR - Sumcheck of reference file differs from original"
     if dgf <> 0 then CLOSE #dgf
     CLOSE #fpfcm
     END
END IF

OPEN Reffile$ FOR BINARY AS #fpold

ICNT1 = 0
WHILE NOT EOF(fpold) AND ICNT1 + IBUF% <= ISIZE%
     GET #fpold, , buff$
     FOR i = 1 TO IBUF%
     ICNT1 = ICNT1 + 1
     bytesold(ICNT1) = ASC(MID$(buff$, i, 1))
     NEXT i
WEND

endold = ISIZE%
IF lengthold& < ISIZE% THEN endold = lengthold&

IF INSTR(Diaglevel$, "P") <> 0 THEN
       LOCATE 10, 1
       PRINT "First hunk of reference file loaded - total length is " + STR$(lengthold&) + " bytes";
END IF

REM Now we initialise all variables,  ready to start the first hunk
REM decompression


'The receivers state is set up with ptroffset = 0,  diffa = 0,  and
'diffb = 0 and donefcm& = 0 and usedold& = 0.
'These values are retained unless explicitly
'changed.  The difference is new - old

ptr = 0
FOR i = 1 TO 4
gdiff(i) = 0
NEXT i
ptroffset = 0
cnt = 0
lastperc& = 0
outputcnt& = 0
obuff$ = ""
reallyfinished = 0

IF FileExists(Workfile$) THEN KILL Workfile$
fp = FREEFILE
OPEN Workfile$ FOR BINARY AS #fp

DO: REM This is the outer loop,  LOOP UNTIL finished,  for each hunk.

'We take each octet of fcmbytes in turn.

WHILE fcmpointer <= endfcm

IF INSTR(Diaglevel$, "P") <> 0 THEN
       perc& = fcmpointer - 1
       realperc& = ((perc& + donefcm&) * 1000) \ lengthfcm&
       LOCATE 20, 1
       PRINT "Percent done is: " + LEFT$(STR$(realperc& / 10.0), 5) + "%     ";
END IF

IF INSTR(diaglevel$,"B") <> 0  THEN
perc& = fcmpointer - 1
realperc& = ((perc& + donefcm&) * 1000)\lengthfcm&
locate bline,1
PRINT "Percent done is: " + left$(STR$(realperc&/10.0),5) + " %                                                      " ;
END IF

code = bytesfcm(fcmpointer)

'On decompression,  we branch on bit 1 equals 1 or 0,  and if bit 1 is
'1,  then we branch on 10 or 11.

codecase = 0
IF code >= 128 THEN
     IF code \ 64 = 2 THEN
'
'codecase = 1 - no match
'For 10,  we pick up nnnnnn,  and copy
'ISEG% * nnnnnn octetcs from the fcm to the target.
'
     codecase = 1: REM Bits are 10 - no match for count segments
     count = code MOD 64
     IF count = 0 THEN count = 64
     ELSE
'
'codecase = 2 - total match (type A)
'This is the branch from first bit 1,  first two 11.
'We copy ISEG% * nnnnnn octets from the old file,  starting at cnt +
'ptroffset + 1.  nnnnnn is in count.
'
     codecase = 2: REM Bits are 11 - total match for count segments
     count = code MOD 64
     IF count = 0 THEN count = 64
     END IF
ELSE
'
'codecase = 3 - pointer change
'If there is a pointer change,  we need to signal it in the output.
'We have four cases for the value of the ptr change:
'             positive and less than (or equals) 256
'             negative and less than (or equals) 256
'             positive and over 256
'             negative and over 256
'We use 00000000,  00000001, 00010000, and 00010001 for these four cases.
'In the first two cases,  we follow with a single octet,  and in the last
'two with two octets.  In the case of the single octet,  zero means 256.
'On decompression,  we are in the first bit zero case,  and branch first on
'the bottom four bits,  taking the 0 and 1 cases here.  For zero,  we are
'collecting a positive value, and for 1 a negative.  Next we branch on the
'value of nnn in 0nnn000x.  For 0 we have a single octet following and
'a value to be added (after negation if necessary) to ptroffset.  For 1
'we have a two octet value (most significant first).
  REM Bit 1 is zero - further analysis needed
  subcode = code \ 16: REM pick up nnn
  code1 = code MOD 16
  IF code1 = 0 OR code1 = 1 THEN
'
'codecase = 4 - diff change
'If a change of a diff is needed,  we
'have the following cases for the diff:
'             positive and less than 256
'             negative and less than 256
'We use 00100000 and 00100001 for these cases for diffa,  00110000 and
'00110001 for these cases for diffb,  01000000 and 01000001 for diffc,
'and 0101000 and 01010001 for diffd,  followed by a single byte which gives
'the fcm diff value.
'On decompression, this is the nnn = 2 (diffa), 3 (diffb), 4 (diffc) and
'5 (diffd) cases described under pointer above.
'
'This completes the use of the 0mmm0000 and 0mmm0001 values
'except for 110 which is used in termination below,  and 111 which is spare.
'Remaining codes are
'0mmmxxxx where xxxx is above 0001.

     negate = code1: REM 1 if we are to negate
     SELECT CASE subcode
     CASE 0
      octets = 1
      codecase = 3: REM Pointer change
     CASE 1
      octets = 2
      codecase = 3: REM Pointer change
     CASE 2
      codecase = 4: REM diffa change
      diffindx = 1
     CASE 3
      codecase = 4: REM diffb change
      diffindx = 2
     CASE 4
      codecase = 4: REM diffc change
      diffindx = 3
     CASE 5
      codecase = 4: REM diffd change
      diffindx = 4
     CASE 6
'
'codecase = 5
'Where we have discarded some old file and refilled the buffers,  we
'signal this
'in the output by putting out a single octet of 01100000 followed by
'two octets giving the amount of the move.
'On decompression,  this is a signal to move the new file by the full
'10K,  and to move the old file by the specified amount.
'
'codecase = 6
'Finally,  we have to cope with the residual set of up to 15 octets at the
'end of the file.   We simply output 01100001,  then a single octet saying
'how many follow,  then the octets.  If there are none,  we still output
'the single octet and the null count.  On decompression,  we copy octets
'across.
      IF code1 = 0 THEN
       codecase = 5: REM Move the reference file down
      ELSE
       codecase = 6: REM Copy the residual octets from the fcm file
      END IF
     CASE 7
      PRINT "**** ERROR - FCM format error - Value 6 or 7 with code1 = 0 or 1"
      END: REM Do nothing - value 7 is spare.
     END SELECT

  ELSE
REM Now we have cases of code1 above 0 and 1, with the subcode holding
REM a count.
    count = subcode
    IF count = 0 THEN count = 8
    SELECT CASE code1
'
'codecase = 7
'For a type B match,  we determine whether to use diffa,  b, c,  or d (based
'on this segment alone,  and possibly with a diff change).  We then merge in
'up to 8 segments (nnn = 000 means 8) with the same pointer and diff value
'(after juggling diffs if necessary).  The coding is 0nnn0010 for use of diffa
'0nnn0011 for use of diffb,  0nnn0100 for use of diffc,  and 0nnn0101 for use of
'diffd.  nnn is the number of segments merged in.  We then follow with a
'string of bits,  one per byte in each of the segments,  where 0 means no
'addition, and 1 means add in the selected diff.   Bits up to the next octet
'boundary are ignored.
'On decompression,  we use nnn to determine the number of octets to be
'produced (16 * nnn),  and then take as many octets as necessary to give
'us the additions of diffa,  b etc.  We start the old at cnt + ptroffset + 1
'and we set new to old + diff. (Diff was defined as new - old)
'
    CASE 2
     codecase = 7: REM Type B
     diffindx = 1: REM use diffa
    CASE 3
     codecase = 7
     diffindx = 2: REM use diffb
    CASE 4
     codecase = 7
     diffindx = 3: REM use diffc
    CASE 5
     codecase = 7
     diffindx = 4: REM use diffd
'
'codecase = 8
'For a type C match,  we have six possible diff selections to use, coded as
'follows (again,  merging in up to 8 possible segments):
'           diffa and diffb    0nnn0110
'           diffa and diffc    0nnn0111
'           diffa and diffd    0nnn1000
'           diffb and diffc    0nnn1001
'           diffb and diffd    0nnn1010
'           diffc and diffd    0nnn1011

'We then follow with a string of bits,  one per byte in each of the segments,
'where 0 means no addition,  and 10 means the first mentioned diff is added in,
'and 11 means the second mentionned diff is added in.
'On decompression,  this is values 6 to 11 of the bottom four octets. We
'proceed as for case B, except that we need to use two diffs,  diff1 and diff2
'taken from diffa to diffd according to the case being considered.
'
    CASE 6
     codecase = 8
     diffindx1 = 1
     diffindx2 = 2
    CASE 7
     codecase = 8
     diffindx1 = 1
     diffindx2 = 3
    CASE 8
     codecase = 8
     diffindx1 = 1
     diffindx2 = 4
    CASE 9
     codecase = 8
     diffindx1 = 2
     diffindx2 = 3
    CASE 10
     codecase = 8
     diffindx1 = 2
     diffindx2 = 4
    CASE 11
     codecase = 8
     diffindx1 = 3
     diffindx2 = 4
'
'codecases 9 and 10
'For a type D match,  we encode the segments
'as 0nnn1100 (for up to 8 segments) where we have four differs,  and
'0nnn1101 where diffa is omitted, 0nnn1101 where diffb is omitted,  0nnn1110
'where diffc is omitted,  and 0nnn1111 where diffd is omitted.
'This is followed by a bitstring for each
'octet in each of the segments,  where we have 0 if no diff is to
'be added in,  then,  for the three differs in use,
'100 if the first is to be added in, 101 for the second,  and 11 for the third.
'For four differs,  we have
'100 if diffa is to be added in,  101 for diffb,  110 for diffc,
'111 for diffd.
'On decompression,  this is again similar to CASE C,  except that we have
'three or four differs depending on the value 12 (four) or 13 to 16 (three)
'of the case.  The value of the case says which differ is omitted.
'
    CASE 12
     codecase = 9
     diffindx1 = 1
     diffindx2 = 2
     diffindx3 = 3
     diffindx4 = 4
    CASE 13
     codecase = 10
     diffindx1 = 2
     diffindx2 = 3
     diffindx3 = 4
    CASE 14
     codecase = 10
     diffindx1 = 1
     diffindx2 = 3
     diffindx3 = 4
    CASE 15
     codecase = 10
     diffindx1 = 1
     diffindx2 = 2
     diffindx3 = 4
REM CASE 16 cannot occur because of lack of code space

     END SELECT

END IF
END IF

IF INSTR(diaglevel$,"T") <> 0 then
PRINT #dgf, "Attempting codecase "; codecase; "Ptroffset ";ptroffset;"Cnt ";cnt
PRINT #dgf, "           Differences: ";gdiff(1);gdiff(2);gdiff(3);gdiff(4)
end if

SELECT CASE codecase

CASE 1: REM Copy ISEG% * count octets from the fcm to the target.
     FOR ijl = 1 TO ISEG% * count
     CALL OutputSub(bytesfcm(fcmpointer + ijl))
     NEXT ijl
     fcmpointer = fcmpointer + 1 + ISEG% * count
     cnt = cnt + ISEG% * count

CASE 2: REM Copy ISEG% * count octets from the old file,  starting at
REM cnt + ptroffset + 1.
     FOR ijl = 1 TO ISEG% * count
     CALL OutputSub(bytesold(cnt + ptroffset + ijl))
     NEXT ijl
     fcmpointer = fcmpointer + 1
     cnt = cnt + ISEG% * count

CASE 3: REM Add to ptroffset,  a one octet value (octets = 1) or a two
REM octet value (octets =2),  or subtract if negate = 1
     octval = bytesfcm(fcmpointer + 1)
     IF octets = 2 THEN octval = octval * 256 + bytesfcm(fcmpointer + 2)
     IF octets = 1 and octval = 0 then octval = 256
     IF negate = 1 THEN octval = -octval
     ptroffset = ptroffset + octval
     fcmpointer = fcmpointer + octets + 1

CASE 4: REM Set gdiff(diffindx) to the one octet value which follows,
REM negated if negate is one.
     octval = bytesfcm(fcmpointer + 1)
     IF negate = 1 THEN octval = -octval
     gdiff(diffindx) = octval
     fcmpointer = fcmpointer + 2

CASE 5: REM The next two octets code up the move down of old.

IF INSTR(diaglevel$,"B") <> 0  THEN
perc& = fcmpointer - 1
realperc& = ((perc& + donefcm&) * 1000)\lengthfcm&
locate bline,1
PRINT "Percent done is: " + left$(STR$(realperc&/10.0),5) + " % Reading next hunk of reference file - please wait ..." ;
END IF

REM Now we have to move the old and adjust pointers
      move = bytesfcm(fcmpointer + 1) * 256 + bytesfcm(fcmpointer + 2)
      fcmpointer = fcmpointer + 3
REM move oldarray down by move and adjust cnt
      cnt = cnt - move
      usedold& = usedold& + move
      endold = endold - move

      FOR i = 1 TO endold
      bytesold(i) = bytesold(i + move)
      NEXT i

IF INSTR(diaglevel$,"T") <> 0 THEN
PRINT #dgf,"Moving old file by "; move
END IF

REM Now read in as much as possible of the old file to fill the buffer.

buff$ = STRING$(IBUF%, " ")
ICNT1 = endold
WHILE NOT EOF(fpold) AND ICNT1 + IBUF% <= ISIZE%
     GET #fpold, , buff$
     FOR i = 1 TO IBUF%
     ICNT1 = ICNT1 + 1
     bytesold(ICNT1) = ASC(MID$(buff$, i, 1))
     NEXT i
WEND

endold = ISIZE%
IF lengthold& - usedold& < ISIZE% THEN endold = lengthold& - usedold&

IF INSTR(Diaglevel$, "P") <> 0 THEN
      LOCATE 10, 1
      PRINT STRING$(80, " ");
      LOCATE 10, 1
      PRINT "Next hunk of old file loaded - proceeding with decompression";
      LOCATE 11, 1
      PRINT STRING$(80, " ");
END IF

CASE 6: REM Copy a number of octets given by the next octet from the
REM fcm file to the new file.  This is the last up to 15 octets,  and
REM we are finished.  The fcm file should be exhausted.
      reallyfinished = 1
      copybytes = bytesfcm(fcmpointer + 1)
      FOR ijl = 2 TO copybytes + 1
      CALL OutputSub(bytesfcm(fcmpointer + ijl))
      NEXT ijl
      fcmpointer = fcmpointer + 2 + copybytes
      cnt = cnt + copybytes

CASE 7: REM Produce count * ISEG% octets of new file by taking the old
REM and adding gdiff(diffindx) if the bit in the following octets is one.
     bitstringptr = 0
     fcmpointer = fcmpointer + 1
     numocts = count * ISEG%
     WHILE numocts <> 0
      IF GetBit = 0 THEN
         CALL OutputSub(bytesold(cnt + ptroffset + 1))
      ELSE
         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx))
      END IF
      numocts = numocts - 1
      cnt = cnt + 1
      WEND

CASE 8: REM Produce count * ISEG% octets of new file by taking the old
REM and adding gdiff(diffindx1) for 10, and gdiff(diffindx2) for 11, and
REM nothing for 0
     bitstringptr = 0
     fcmpointer = fcmpointer + 1
     numocts = count * ISEG%
     WHILE numocts <> 0
      IF GetBit = 0 THEN
         CALL OutputSub(bytesold(cnt + ptroffset + 1))

      ELSE
        IF GetBit = 0 THEN
         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx1))
     ELSE
         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx2))
     END IF
      END IF
      numocts = numocts - 1
      cnt = cnt + 1
      WEND

CASE 9: REM Produce count * ISEG% octets of new file by taking the old
REM and adding nothing for 0,  gdiff(1) for 100, gdiff(2) for 101,  gdiff(3)
REM for 110,  and gdiff(4) for 111.
     bitstringptr = 0
     fcmpointer = fcmpointer + 1
     numocts = count * ISEG%
     WHILE numocts <> 0
      IF GetBit = 0 THEN
         CALL OutputSub(bytesold(cnt + ptroffset + 1))
      ELSE
        IF GetBit = 0 THEN
            IF GetBit = 0 THEN
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx1))
         ELSE
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx2))
         END IF
     ELSE
            IF GetBit = 0 THEN
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx3))
         ELSE
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx4))
         END IF
     END IF
      END IF
      numocts = numocts - 1
      cnt = cnt + 1
      WEND

CASE 10: REM Produce count * ISEG% octets of new file by taking the old
REM and adding nothing for 0, gdiff(diffindx1) for 100, and gdiff(diffindx2)
REM for 101, gdiff(diffindx3) for 11.
     bitstringptr = 0
     fcmpointer = fcmpointer + 1
     numocts = count * ISEG%
     WHILE numocts <> 0
      IF GetBit = 0 THEN
         CALL OutputSub(bytesold(cnt + ptroffset + 1))
      ELSE
        IF GetBit = 0 THEN
            IF GetBit = 0 THEN
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx1))
         ELSE
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx2))
         END IF
     ELSE
                         CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx3))
     END IF
      END IF
      numocts = numocts - 1
      cnt = cnt + 1
      WEND

CASE ELSE
     PRINT  "**** ERROR - FCM format error - Bad codecase"
     END

END SELECT

WEND

REM Now loop to do another hunk if necessary
finished = 0
IF lengthfcm& <= endfcm + donefcm& THEN
     finished = 1
     CLOSE #fpold
     CLOSE #fpfcm
ELSE

IF INSTR(diaglevel$,"B") <> 0  THEN
perc& = fcmpointer - 1
realperc& = ((perc& + donefcm&) * 1000)\lengthfcm&
locate bline,1
PRINT "Percent done is: " + left$(STR$(realperc&/10.0),5) + " %  Reading in next hunk of files.  Please wait ....    " ;
END IF

REM Prepare for next hunk

fcmpointer = fcmpointer - ISIZE3%
donefcm& = donefcm& + ISIZE3%
REM move fcm array down by ISIZE3%

realendfcm = realendfcm - ISIZE3%
FOR ijl = 1 TO realendfcm
bytesfcm(ijl) = bytesfcm(ijl + ISIZE3%)
NEXT ijl

REM Now read in as much as possible of the fcm file to fill the buffer.

buff$ = STRING$(IBUF%, " ")
ICNT2 = realendfcm
WHILE NOT EOF(fpfcm) AND ICNT2 + IBUF% <= ISIZE%
     GET #fpfcm, , buff$
     FOR i = 1 TO IBUF%
     ICNT2 = ICNT2 + 1
     bytesfcm(ICNT2) = ASC(MID$(buff$, i, 1))
     NEXT i
WEND

realendfcm = ISIZE%
endfcm = ISIZE2%
IF lengthfcm& - donefcm& <= ISIZE% THEN
       endfcm = lengthfcm& - donefcm&
       realendfcm = endfcm
END IF

IF INSTR(Diaglevel$, "P") <> 0 THEN
      LOCATE 10, 1
      PRINT STRING$(80, " ");
      LOCATE 10, 1
      PRINT "Next hunk of fcm file loaded - proceeding with decompression";
      LOCATE 11, 1
      PRINT STRING$(80, " ");
END IF

REM This ends the preparation for the next hunk.
END IF

LOOP UNTIL finished = 1

IF reallyfinished <> 1 THEN
    PRINT  "**** ERROR - FCM format error - Ran out of FCM file before finished"
    CLOSE #fp
    CLOSE #fpfcm
    CLOSE #fpold
    if dgf <> 0 then CLOSE #dgf
    KILL Workfile$
    END
END IF

PUT #fp, , obuff$
CLOSE #fp
CLOSE #fpfcm
CLOSE #fpold

IF sumcheckval1 <> sumcheck1 OR sumcheckval2 <> sumcheck2 THEN
   PRINT "**** ERROR - Sumcheck of reconstituted file differs from original"
ELSE
   SHELL "COPY " + Workfile$ + " " + Newfile$ + " > NUL"
   KILL Workfile$
END IF

IF INSTR(Diaglevel$, "P") <> 0 THEN
LOCATE 13, 1
PRINT STRING$(80, " ");
LOCATE 13, 1
COLOR 14, 4, 1
PRINT "Decompression complete.  Number of octets output is ", outputcnt&;
LOCATE 18, 1
PRINT "Forward decompression finished.";
LOCATE 24, 1
END IF

if dgf <> 0 then CLOSE #dgf
END

'REM This is part of the eventual documentation,  and describes the
'compressed format based on this approach.
'
'There will be an initial block containing:
' 1.  a length count (one octet)for the next item.
' 2.  the full path name of the file that is to be compressed
'     (on decompression,  a file TEMP.TMP will be created in the current
'     directory,  and then copied to the original destination path when
'     decompression is complete,  unless overridden by a different target).
' 3.  two octets of sum check for the whole of this file;  the sum check
'     is the standard one of SIGMA(Ai) and SIGMA(iAi),  all MOD 255.
' 4.  a length count for the next item.
' 5.  the full path name of the reference file (this can be overridden
'     on decompression)
' 6.  two octets of sum check for the first 1K of the reference file.
'
'Decompression will be abandonned if the reference file is not found
'on the receiving system,  with the correct sumcheck,  and TEMP.TMP will
'not be copied unless the sum-checks of the original file match with the
'decompressed one.
'
'The receivers state is set up with ptroffset = 0, gdiff(1) = 0, gdiff(2) = 0,
'gdiff(3) = 0,  gdiff(4) = 0.   These values are retained unless explicitly
'changed.  The target value is old plus difference. (Difference is new - old).
'The old values to be used are at cnt + ptroffset + 1 to
'cnt + ptroffset + ISEG%,  where cnt is the number
'of new octets generated so far.  A positive pointer change is an addition
'to ptroffset.
'(A ptroffset is old posn - new posn for compression).
'
'The following algorithm determines the compressed format:
'
'We take each ISEG block in turn.
'
'If there is no match, we output 10nnnnnn followed by the nnnnnn sets of
'16 octets for up to 64 (nnnnnn of 0 means 64) segments.
'Note that 11nnnnnn is used for total matches (see below).  All other
'codes are 0xxxxxxx.
'On decompression,  we branch on bit 1 equals 1 or 0,  and if bit 1 is
'1,  then we branch on 10 or 11.  For 10,  we pick up nnnnnn,  and copy
'ISEG% * nnnnnn octetcs from the fcm to the target.
'
'If there is a pointer change,  we need to signal it in the output.
'We have four cases for the value of the ptr change:
'             positive and less than (or equals) 256
'             negative and less than (or equals) 256
'             positive and over 256
'             negative and over 256
'We use 00000000,  00000001, 00010000, and 00010001 for these four cases.
'In the first two cases,  we follow with a single octet,  and in the last
'two with two octets.  In the case of the single octet,  zero means 256.
'On decompression,  we are in the first bit zero case,  and branch first on
'the bottom four bits,  taking the 0 and 1 cases here.  For zero,  we are
'collecting a positive value, and for 1 a negative.  Next we branch on the
'value of nnn in 0nnn000x.  For 0 we have a single octet following and
'a value to be added (after negation if necessary) to ptroffset.  For 1
'we have a two octet value (most significant first).
'
'Next we look at whether a diffa, diffb, diffc,  diffd change is needed.
'If a change of a diff is needed,  we
'have the following cases for the diff:
'             positive and less than 256
'             negative and less than 256
'We use 00100000 and 00100001 for these cases for diffa,  00110000 and
'00110001 for these cases for diffb,  01000000 and 01000001 for diffc,
'and 0101000 and 01010001 for diffd,  followed by a single byte which gives
'the fcm diff value.
'On decompression, this is the nnn = 2 (diffa), 3 (diffb), 4 (diffc) and
'5 (diffd) cases described under pointer above.
'
'This completes the use of the 0mmm0000 and 0mmm0001 values
'except for 110 which is used in termination below,  and 111 which is spare.
'Remaining codes are
'0mmmxxxx where xxxx is above 0001.
'
'In all cases,  apart from no match,  we first code any pointer change
'needed,  then any one or more diff changes that are needed,  then we code
'the type.
'
'For a type A match,  we look
'to see if the next block is also type A with no pointer change.  If so,
'we count the number of blocks we can merge in,  up to a maximum of 64,
'and output 11nnnnnn,  where n is the count of the number of merged-in
'blocks
'(nnnnnn all zeros means 64).
'On decompression,  this is the branch from first bit 1,  first two 11.
'We copy ISEG% * nnnnnn octets from the old file,  starting at cnt +
'ptroffset + 1.
'
'For a type B match,  we determine whether to use diffa,  b, c,  or d (based
'on this segment alone,  and possibly with a diff change).  We then merge in
'up to 8 segments (nnn = 000 means 8) with the same pointer and diff value
'(after juggling diffs if necessary).  The coding is 0nnn0010 for use of diffa
'0nnn0011 for use of diffb,  0nnn0100 for use of diffc,  and 0nnn0101 for use of
'diffd.  nnn is the number of segments merged in.  We then follow with a
'string of bits,  one per byte in each of the segments,  where 0 means no
'addition, and 1 means add in the selected diff.   Bits up to the next octet
'boundary are ignored.
'On decompression,  we use nnn to determine the number of octets to be
'produced (16 * nnn),  and then take as many octets as necessary to give
'us the additions of diffa,  b etc.  We start the old at cnt + ptroffset + 1
'and we set new to old + diff. (Diff was defined as new - old)
'
'For a type C match,  we have six possible diff selections to use, coded as
'follows (again,  merging in up to 8 possible segments):
'           diffa and diffb    0nnn0110
'           diffa and diffc    0nnn0111
'           diffa and diffd    0nnn1000
'           diffb and diffc    0nnn1001
'           diffb and diffd    0nnn1010
'           diffc and diffd    0nnn1011

'We then follow with a string of bits,  one per byte in each of the segments,
'where 0 means no addition,  and 10 means the first mentioned diff is added in,
'and 11 means the second mentionned diff is added in.
'On decompression,  this is values 6 to 11 of the bottom four octets. We
'proceed as for case B, except that we need to use two diffs,  diff1 and diff2
'taken from diffa to diffd according to the case being considered.
'
'For a type D match,  we encode the segments
'as 0nnn1100 (for up to 8 segments) where we have four differs,  and
'0nnn1101 where diffa is omitted, 0nnn1110 where diffb is omitted,  0nnn1111
'where diffc is omitted.  For diffd omitted,  we have no code space left,
'and treat that as if it were a four differ (code 0nnn1100).
'This is followed by a bitstring for each
'octet in each of the segments,  where we have 0 if no diff is to
'be added in,  then,  for the three differs in use,
'100 if the first is to be added in, 101 for the second,  and 11 for the third.
'For four differs,  we have
'100 if diffa is to be added in,  101 for diffb,  110 for diffc,
'111 for diffd.
'On decompression,  this is again similar to CASE C,  except that we have
'three or four differs depending on the value 12 (four) or 13 to 16 (three)
'of the case.  The value of the case says which differ is omitted.
'
'Finally,  we have to cope with the residual set of up to 15 octets at the
'end of the file.   We simply output 00001110,  then a single octet saying
'how many follow,  then the octets.  If there are none,  we still output
'the single octet and the null count.  On decompression,  we copy octets
'across.
'
'Where we have discarded some old file and refilled the buffers,  we
'signal this
'in the output by putting out a single octet of 00011110 followed by
'two octets giving the amount of the move.
'On decompression,  this is a signal to move the new file by the full
'12K,  and to move the old file by the specified amount.
'
'This ends the use of the 0nnnxxxx codes.  The value 1111 of xxxx is
'spare.
'
'Thus,  we get the following counts:
'    first no match                  17
'    subsequent no match (up to 128) 16
'    ptr change (<256)                2
'    ptr change (>256)                3
'    diff change                      2
'    type A                           1 (?+3 - ptr change)
'    subsequent A (up to 128)         0
'    type B                           3 (?+5 - ptr + 1 diff)
'    subsequent B (up to 8)           2
'    type C                           4 to 5 bytes (?+7 - ptr + 2 diff)
'    subsequent C (up to 8)           2 to 4 bytes
'    type D or E                      4 to 7 bytes (?+5/4 - ptr/diff +  diff)
'NOTE - We recognise D or E only if there is at most 1 ptr and one diff,  or
'two diff changes.
'

FUNCTION FileExists! (testfile$)

DIM InRegs AS RegType, OutRegs AS RegType

checkname$ = testfile$ + CHR$(0)

InRegs.ax = &H4300
InRegs.dx = SADD(checkname$)

CALL INTERRUPT(&H21, InRegs, OutRegs)

IF (&H1 AND OutRegs.flags) <> 0 THEN
       FileExists = 0
ELSE
       FileExists = 1
END IF

END FUNCTION

FUNCTION GetBit

SHARED bitstringptr, bitstring$, bits$(), bytesfcm(), fcmpointer

      IF bitstringptr = 0 THEN
            bitstring$ = bits$(bytesfcm(fcmpointer))
         bitstringptr = 1
         fcmpointer = fcmpointer + 1
      END IF
      bit$ = MID$(bitstring$, bitstringptr, 1)
      IF bit$ = "1" THEN
       GetBit = 1
      ELSE
       GetBit = 0
      END IF
      bitstringptr = bitstringptr + 1
      IF bitstringptr = 9 THEN bitstringptr = 0

END FUNCTION

SUB GetCommNames

SHARED Reffile$, Fcmfile$, Newfile$, Workfile$, Diaglevel$, diagoutput$

     DIM z$(6)
     Maxargs = 6
     Numargs = 0: in = 0
     Cl$ = COMMAND$
     l = LEN(Cl$)
     FOR i = 1 TO l
       c$ = MID$(Cl$, i, 1)
       IF (c$ <> " " AND c$ <> CHR$(9)) THEN
      IF in = 0 THEN
                                IF Numargs = Maxargs THEN EXIT FOR
                                Numargs = Numargs + 1
                                in = 1
      END IF
      z$(Numargs) = z$(Numargs) + c$
       ELSE
      in = 0
       END IF
     NEXT i

IF Numargs < 1 THEN
     PRINT "You have to specify the fcm file name to be processed. This is optionally"
     PRINT "followed (in order) by:"
     PRINT "        the verbosity level (B or P),  and optionally T;"
     PRINT "        (B is brief,  P is progress messages, T is trace);"
     PRINT "        (if and only if T is selected) the name of the trace file"
     PRINT "        the name of the new file to be created"
     PRINT "        the name of the file to be used as the reference file"
     PRINT "        the name of the file to be used as the work file"
     PRINT " "
     PRINT "If an optional argument is present,  all earlier optional arguments"
     PRINT "have to be present."
     PRINT " "
     PRINT "If the filename for an optional argument is given as the string DEFAULT"
     PRINT "(all upper case),  or if an optional argument is omitted,  then the"
     PRINT "following defaults apply:"
     PRINT " "
     PRINT "Verbosity = B"
     PRINT "Trace file = not applicable (mandatory if T requested)"
     PRINT "New file to create = as specified when JLPAK was executed"
     PRINT "Reference file = as specified when JLPAK was executed"
     PRINT "Work file = TEMP.TMP in current directory"
     PRINT " "
     END
END IF

Fcmfile$ = UCASE$(z$(1))

Diaglevel$ = "B"
IF numargs >=2 then diaglevel$ = ucase$(z$(2))

IF INSTR(diaglevel$,"T") <> 0 THEN
    IF INSTR(diaglevel$,"P") <> 0 THEN
          diaglevel$ = "TP"
    ELSE
          diaglevel$ = "TB"
    END IF
ELSE
    IF INSTR(diaglevel$,"P") <> 0 THEN
          diaglevel$ = "P"
    ELSE
          diaglevel$ = "B"
    END IF
END IF

IF INSTR(diaglevel$,"T") <> 0 AND Numargs < 3 THEN
     PRINT "Tracing requested but no trace file name.  Please respecify"
END IF

arginc = 0
IF INSTR(diaglevel$,"T") <> 0 THEN
     diagoutput$ = UCASE$(z$(3))
     arginc = 1
END IF

Newfile$ = "DEFAULT"
If numargs >= (3 + arginc) then Newfile$ = z$(3 + arginc)


Reffile$ = "DEFAULT"
If numargs >= (4 + arginc) then Reffile$ = z$(4 + arginc)


Workfile$ = "DEFAULT"
If numargs >= (5 + arginc) then Workfile$ = z$(5 + arginc)

END SUB

SUB OutputSub (OctetValue)

SHARED obuff$, sumcheck1,  sumcheck2, fp, trace

IF LEN(obuff$) > 100 THEN
       PUT #fp, , obuff$
       obuff$ = ""
END IF

useoctetvalue = octetvalue

IF trace = 1 then
IF octetvalue < 0 or octetvalue > 255 then
  PRINT "**** ERROR - FCM format error - Octetvalue out of range (bug)"; octetvalue
  useoctetvalue = 0
  END
END IF
end if
sumcheck1 = (sumcheck1 + octetvalue) MOD 255
sumcheck2 = (sumcheck2 + sumcheck1) MOD 255
obuff$ = obuff$ + CHR$(useOctetValue)
outputcnt& = outputcnt& + 1

END SUB