home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / FILE / JLPAK10.ZIP / JLUNPAK.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-08-19  |  36.6 KB  |  1,130 lines

  1. DEFINT A-Z
  2.  
  3. DECLARE SUB GetCommNames ()
  4. DECLARE FUNCTION FileExists! (testfile$)
  5. DECLARE FUNCTION GetBit ()
  6. DECLARE SUB OutputSub (OctetValue)
  7. '  $INCLUDE: 'qb.bi'
  8.  
  9.  
  10. CONST IBUF% = 100
  11. REM IBUF% is the input buffer size for obtaining the ascii value of each
  12. REM byte.  Speed seems relatively independent of the IBUF% size.
  13.  
  14. CONST ISIZE% = 32000
  15. REM This is the hunk of the old file that we work with.   We read in the first
  16. REM 32000 (or all if less),  and discard as commanded in the compressed format.
  17. REM This is a parameter of the FCM format.
  18.  
  19. CONST ISIZE2% = 24000
  20. REM This is the amount of FCM we do before moving it.
  21.  
  22. CONST ISIZE3% = 12000
  23. REM And this is the amount we move it down each time.
  24.  
  25. CONST ISEG% = 16
  26. REM This is the size of typeA and no match blocks,  and is a parameter of the
  27. REM compressed (FCM) format.
  28.  
  29. REM $DYNAMIC
  30.  
  31. DIM bytesold(ISIZE%)
  32. REM This is the array of bytes from the old version
  33.  
  34. DIM bytesfcm(ISIZE%)
  35. REM This is the array of bytes from the FCM format file
  36.  
  37. DIM bits$(0 TO 255)
  38. REM holds the bitstring for each of the values of an octet.
  39.  
  40. DIM gdiff(4)
  41. REM Used to hold the global difference values we maintain.
  42.  
  43. REM SHARED reffile$,  fcmfile$,  newfile$, workfile$,  diaglevel$,  diagoutput$
  44.  
  45. COLOR 15, 1, 1
  46.  
  47. Trace = 1
  48.  
  49. CALL GetCommNames
  50. IF Workfile$ = "DEFAULT" then Workfile$ = "TEMP.TMP"
  51.  
  52. done& = 0
  53. usedold& = 0
  54. donefcm& = 0
  55. REM This is the amount of the fcm file that we have already processed as a
  56. REM previous hunk,  and of the old file that we have used.
  57.  
  58. bitval$ = "00000000"
  59. FOR i = 0 TO 254
  60. bits$(i) = bitval$
  61. ptr = 8
  62. doneadd = 0
  63. WHILE doneadd = 0
  64.   IF MID$(bitval$, ptr, 1) = "0" THEN
  65.      MID$(bitval$, ptr, 1) = "1"
  66.      doneadd = 1
  67.   ELSE
  68.      MID$(bitval$, ptr, 1) = "0"
  69.      ptr = ptr - 1
  70.   END IF
  71. WEND
  72. NEXT i
  73. bits$(255) = bitval$
  74.  
  75. dgf = 0
  76. IF INSTR(diaglevel$,"T") <> 0 THEN
  77. dgf = FREEFILE
  78. OPEN diagoutput$ FOR OUTPUT AS #dgf
  79. END IF
  80.  
  81. IF INSTR(Diaglevel$, "P") <> 0 THEN
  82.    CLS
  83.    LOCATE 2, 25
  84.    COLOR 14, 4, 1
  85.    PRINT "Forward decompression program";
  86.    COLOR 15, 1, 1
  87. END IF
  88.  
  89. IF INSTR(diaglevel$,"B") <> 0 THEN
  90. PRINT "JLUNPAK Copyright IT Institute 1990 - Forward decompression program version 1.0"
  91. PRINT " "
  92. bline = CSRLIN
  93. locate bline,1
  94. PRINT "Percent done is: 0%     Reading in files for processing - please wait ..." ;
  95. END IF
  96.  
  97. fpfcm = FREEFILE
  98. buff$ = STRING$(IBUF%, " ")
  99. IF FileExists(Fcmfile$) THEN
  100.    OPEN Fcmfile$ FOR BINARY AS #fpfcm
  101. ELSE
  102. PRINT "**** ERROR - File to be decompressed (" + Fcmfile$ + ") does not exist"
  103.    if dgf <> 0 then CLOSE #dgf
  104.    END
  105. END IF
  106.  
  107. WHILE NOT EOF(fpfcm)
  108.        GET #fpfcm, , buff$
  109. WEND
  110. lengthfcm& = LOC(fpfcm)
  111.  
  112. CLOSE #fpfcm
  113. OPEN Fcmfile$ FOR BINARY AS #fpfcm
  114.  
  115. ICNT2 = 0
  116. WHILE NOT EOF(fpfcm) AND ICNT2 + IBUF% <= ISIZE%
  117.      GET #fpfcm, , buff$
  118.      FOR i = 1 TO IBUF%
  119.      ICNT2 = ICNT2 + 1
  120.      bytesfcm(ICNT2) = ASC(MID$(buff$, i, 1))
  121.      NEXT i
  122. WEND
  123.  
  124. realendfcm = ISIZE%
  125. endfcm = ISIZE2%
  126. IF lengthfcm& < ISIZE% THEN 
  127.      endfcm = lengthfcm&
  128.      realendfcm = lengthfcm&
  129. END IF
  130.  
  131. IF INSTR(Diaglevel$, "P") <> 0 THEN
  132.       LOCATE 11, 1
  133.       PRINT "First hunk of fcm file loaded - total length is " + STR$(lengthfcm&) + " bytes";
  134. END IF
  135.  
  136. fcmpointer = 1
  137.  
  138. ' 1.  a length count (one octet)for the next item.
  139. ' 2.  the full path name of the file that is to be compressed
  140. '     (on decompression,  a file TEMP.TMP will be created in the current
  141. '     directory,  and then copied to the original destination path when
  142. '     decompression is complete,  unless overridden by a different target).
  143. ' 3.  two octets of sum check for the whole of this file;  the sum check
  144. '     is the standard one of SIGMA(Ai) and SIGMA(iAi),  all MOD 255.
  145. ' 4.  a length count for the next item.
  146. ' 5.  the full path name of the reference file (this can be overridden
  147. '     on decompression)
  148. ' 6.  two octets of sum check for the first 1K of the reference file.
  149.  
  150. octlen = bytesfcm(fcmpointer)
  151. newfiledef$ = ""
  152. for ijl = 1 to octlen
  153. newfiledef$ = newfiledef$ + chr$(bytesfcm(fcmpointer + ijl))
  154. next ijl
  155. if newfile$ = "DEFAULT" then newfile$ = newfiledef$
  156. fcmpointer = fcmpointer + octlen + 1
  157. sumcheckval1 = bytesfcm(fcmpointer)
  158. sumcheckval2 = bytesfcm(fcmpointer + 1)
  159. fcmpointer = fcmpointer + 2
  160. octlen = bytesfcm(fcmpointer)
  161. oldfiledef$ = ""
  162. for ijl = 1 to octlen
  163. oldfiledef$ = oldfiledef$ + chr$(bytesfcm(fcmpointer + ijl))
  164. next ijl
  165. if reffile$ = "DEFAULT" then reffile$ = oldfiledef$
  166. fcmpointer = fcmpointer + octlen + 1
  167. oldsumcheckval1 = bytesfcm(fcmpointer)
  168. oldsumcheckval2 = bytesfcm(fcmpointer + 1)
  169. fcmpointer =fcmpointer + 2
  170.  
  171. IF INSTR(Diaglevel$, "P") <> 0 THEN
  172.    LOCATE 5, 1
  173.    PRINT "Decompressing " + Fcmfile$ + " using " + Reffile$ + " as a reference file";
  174. END IF
  175.  
  176. fpold = FREEFILE
  177. buff$ = STRING$(IBUF%, " ")
  178. IF FileExists(Reffile$) THEN
  179.    OPEN Reffile$ FOR BINARY AS #fpold
  180. ELSE
  181. PRINT "**** ERROR - Reference file " + Reffile$ + " does not exist"
  182.    if dgf <> 0 then CLOSE #dgf
  183.    CLOSE #fpfcm
  184.    END
  185. END IF
  186.  
  187. checked = 0
  188. oldsumcheck1 = 0
  189. oldsumcheck2 = 0
  190. WHILE NOT EOF(fpold)
  191.        GET #fpold, ,buff$
  192. if checked < 10 then
  193.    checked = checked + 1
  194.    if not eof(fpold) then
  195.        for i = 1 to IBUF%
  196.        octval = ASC(MID$(buff$,i,1))
  197.        oldsumcheck1 = (oldsumcheck1 + octval) MOD 255
  198.        oldsumcheck2 = (oldsumcheck2 + oldsumcheck1) MOD 255
  199.        next i
  200.    else
  201.        lengthold& = loc(fpold)
  202.        for i = 1 to (lengthold& MOD IBUF%)
  203.        octval = ASC(MID$(buff$,i,1))
  204.        oldsumcheck1 = (oldsumcheck1 + octval) MOD 255
  205.        oldsumcheck2 = (oldsumcheck2 + oldsumcheck1) MOD 255
  206.        next i
  207.    end if
  208. end if
  209. WEND
  210. lengthold& = loc(fpold)
  211.  
  212. CLOSE #fpold
  213.  
  214. IF oldsumcheckval1 <> oldsumcheck1 OR oldsumcheckval2 <> oldsumcheck2 THEN
  215.      PRINT "**** ERROR - Sumcheck of reference file differs from original"
  216.      if dgf <> 0 then CLOSE #dgf
  217.      CLOSE #fpfcm
  218.      END
  219. END IF
  220.  
  221. OPEN Reffile$ FOR BINARY AS #fpold
  222.  
  223. ICNT1 = 0
  224. WHILE NOT EOF(fpold) AND ICNT1 + IBUF% <= ISIZE%
  225.      GET #fpold, , buff$
  226.      FOR i = 1 TO IBUF%
  227.      ICNT1 = ICNT1 + 1
  228.      bytesold(ICNT1) = ASC(MID$(buff$, i, 1))
  229.      NEXT i
  230. WEND
  231.  
  232. endold = ISIZE%
  233. IF lengthold& < ISIZE% THEN endold = lengthold&
  234.  
  235. IF INSTR(Diaglevel$, "P") <> 0 THEN
  236.        LOCATE 10, 1
  237.        PRINT "First hunk of reference file loaded - total length is " + STR$(lengthold&) + " bytes";
  238. END IF
  239.  
  240. REM Now we initialise all variables,  ready to start the first hunk
  241. REM decompression
  242.  
  243.  
  244. 'The receivers state is set up with ptroffset = 0,  diffa = 0,  and
  245. 'diffb = 0 and donefcm& = 0 and usedold& = 0. 
  246. 'These values are retained unless explicitly
  247. 'changed.  The difference is new - old
  248.  
  249. ptr = 0
  250. FOR i = 1 TO 4
  251. gdiff(i) = 0
  252. NEXT i
  253. ptroffset = 0
  254. cnt = 0
  255. lastperc& = 0
  256. outputcnt& = 0
  257. obuff$ = ""
  258. reallyfinished = 0
  259.  
  260. IF FileExists(Workfile$) THEN KILL Workfile$
  261. fp = FREEFILE
  262. OPEN Workfile$ FOR BINARY AS #fp
  263.  
  264. DO: REM This is the outer loop,  LOOP UNTIL finished,  for each hunk.
  265.  
  266. 'We take each octet of fcmbytes in turn.
  267.  
  268. WHILE fcmpointer <= endfcm
  269.  
  270. IF INSTR(Diaglevel$, "P") <> 0 THEN
  271.        perc& = fcmpointer - 1
  272.        realperc& = ((perc& + donefcm&) * 1000) \ lengthfcm&
  273.        LOCATE 20, 1
  274.        PRINT "Percent done is: " + LEFT$(STR$(realperc& / 10.0), 5) + "%     ";
  275. END IF
  276.  
  277. IF INSTR(diaglevel$,"B") <> 0  THEN
  278. perc& = fcmpointer - 1
  279. realperc& = ((perc& + donefcm&) * 1000)\lengthfcm&
  280. locate bline,1
  281. PRINT "Percent done is: " + left$(STR$(realperc&/10.0),5) + " %                                                      " ;
  282. END IF
  283.  
  284. code = bytesfcm(fcmpointer)
  285.  
  286. 'On decompression,  we branch on bit 1 equals 1 or 0,  and if bit 1 is
  287. '1,  then we branch on 10 or 11.
  288.  
  289. codecase = 0
  290. IF code >= 128 THEN
  291.      IF code \ 64 = 2 THEN
  292. '
  293. 'codecase = 1 - no match
  294. 'For 10,  we pick up nnnnnn,  and copy
  295. 'ISEG% * nnnnnn octetcs from the fcm to the target.
  296. '
  297.      codecase = 1: REM Bits are 10 - no match for count segments
  298.      count = code MOD 64
  299.      IF count = 0 THEN count = 64
  300.      ELSE
  301. '
  302. 'codecase = 2 - total match (type A)
  303. 'This is the branch from first bit 1,  first two 11.
  304. 'We copy ISEG% * nnnnnn octets from the old file,  starting at cnt +
  305. 'ptroffset + 1.  nnnnnn is in count.
  306. '
  307.      codecase = 2: REM Bits are 11 - total match for count segments
  308.      count = code MOD 64
  309.      IF count = 0 THEN count = 64
  310.      END IF
  311. ELSE
  312. '
  313. 'codecase = 3 - pointer change
  314. 'If there is a pointer change,  we need to signal it in the output.
  315. 'We have four cases for the value of the ptr change:
  316. '             positive and less than (or equals) 256
  317. '             negative and less than (or equals) 256
  318. '             positive and over 256
  319. '             negative and over 256
  320. 'We use 00000000,  00000001, 00010000, and 00010001 for these four cases.
  321. 'In the first two cases,  we follow with a single octet,  and in the last
  322. 'two with two octets.  In the case of the single octet,  zero means 256.
  323. 'On decompression,  we are in the first bit zero case,  and branch first on
  324. 'the bottom four bits,  taking the 0 and 1 cases here.  For zero,  we are
  325. 'collecting a positive value, and for 1 a negative.  Next we branch on the
  326. 'value of nnn in 0nnn000x.  For 0 we have a single octet following and
  327. 'a value to be added (after negation if necessary) to ptroffset.  For 1
  328. 'we have a two octet value (most significant first).
  329.   REM Bit 1 is zero - further analysis needed
  330.   subcode = code \ 16: REM pick up nnn
  331.   code1 = code MOD 16
  332.   IF code1 = 0 OR code1 = 1 THEN
  333. '
  334. 'codecase = 4 - diff change
  335. 'If a change of a diff is needed,  we
  336. 'have the following cases for the diff:
  337. '             positive and less than 256
  338. '             negative and less than 256
  339. 'We use 00100000 and 00100001 for these cases for diffa,  00110000 and
  340. '00110001 for these cases for diffb,  01000000 and 01000001 for diffc,
  341. 'and 0101000 and 01010001 for diffd,  followed by a single byte which gives
  342. 'the fcm diff value.
  343. 'On decompression, this is the nnn = 2 (diffa), 3 (diffb), 4 (diffc) and
  344. '5 (diffd) cases described under pointer above.
  345. '
  346. 'This completes the use of the 0mmm0000 and 0mmm0001 values
  347. 'except for 110 which is used in termination below,  and 111 which is spare.
  348. 'Remaining codes are
  349. '0mmmxxxx where xxxx is above 0001.
  350.  
  351.      negate = code1: REM 1 if we are to negate
  352.      SELECT CASE subcode
  353.      CASE 0
  354.       octets = 1
  355.       codecase = 3: REM Pointer change
  356.      CASE 1
  357.       octets = 2
  358.       codecase = 3: REM Pointer change
  359.      CASE 2
  360.       codecase = 4: REM diffa change
  361.       diffindx = 1
  362.      CASE 3
  363.       codecase = 4: REM diffb change
  364.       diffindx = 2
  365.      CASE 4
  366.       codecase = 4: REM diffc change
  367.       diffindx = 3
  368.      CASE 5
  369.       codecase = 4: REM diffd change
  370.       diffindx = 4
  371.      CASE 6
  372. '
  373. 'codecase = 5
  374. 'Where we have discarded some old file and refilled the buffers,  we
  375. 'signal this
  376. 'in the output by putting out a single octet of 01100000 followed by
  377. 'two octets giving the amount of the move.
  378. 'On decompression,  this is a signal to move the new file by the full
  379. '10K,  and to move the old file by the specified amount.
  380. '       
  381. 'codecase = 6
  382. 'Finally,  we have to cope with the residual set of up to 15 octets at the
  383. 'end of the file.   We simply output 01100001,  then a single octet saying
  384. 'how many follow,  then the octets.  If there are none,  we still output
  385. 'the single octet and the null count.  On decompression,  we copy octets
  386. 'across.
  387.       IF code1 = 0 THEN
  388.        codecase = 5: REM Move the reference file down
  389.       ELSE
  390.        codecase = 6: REM Copy the residual octets from the fcm file
  391.       END IF
  392.      CASE 7
  393.       PRINT "**** ERROR - FCM format error - Value 6 or 7 with code1 = 0 or 1"
  394.       END: REM Do nothing - value 7 is spare.
  395.      END SELECT
  396.  
  397.   ELSE
  398. REM Now we have cases of code1 above 0 and 1, with the subcode holding
  399. REM a count.
  400.     count = subcode
  401.     IF count = 0 THEN count = 8
  402.     SELECT CASE code1
  403. '
  404. 'codecase = 7
  405. 'For a type B match,  we determine whether to use diffa,  b, c,  or d (based
  406. 'on this segment alone,  and possibly with a diff change).  We then merge in
  407. 'up to 8 segments (nnn = 000 means 8) with the same pointer and diff value
  408. '(after juggling diffs if necessary).  The coding is 0nnn0010 for use of diffa
  409. '0nnn0011 for use of diffb,  0nnn0100 for use of diffc,  and 0nnn0101 for use of
  410. 'diffd.  nnn is the number of segments merged in.  We then follow with a
  411. 'string of bits,  one per byte in each of the segments,  where 0 means no
  412. 'addition, and 1 means add in the selected diff.   Bits up to the next octet
  413. 'boundary are ignored.
  414. 'On decompression,  we use nnn to determine the number of octets to be
  415. 'produced (16 * nnn),  and then take as many octets as necessary to give
  416. 'us the additions of diffa,  b etc.  We start the old at cnt + ptroffset + 1
  417. 'and we set new to old + diff. (Diff was defined as new - old)
  418. '
  419.     CASE 2
  420.      codecase = 7: REM Type B
  421.      diffindx = 1: REM use diffa
  422.     CASE 3
  423.      codecase = 7
  424.      diffindx = 2: REM use diffb
  425.     CASE 4
  426.      codecase = 7
  427.      diffindx = 3: REM use diffc
  428.     CASE 5
  429.      codecase = 7
  430.      diffindx = 4: REM use diffd
  431. '
  432. 'codecase = 8
  433. 'For a type C match,  we have six possible diff selections to use, coded as
  434. 'follows (again,  merging in up to 8 possible segments):
  435. '           diffa and diffb    0nnn0110
  436. '           diffa and diffc    0nnn0111
  437. '           diffa and diffd    0nnn1000
  438. '           diffb and diffc    0nnn1001
  439. '           diffb and diffd    0nnn1010
  440. '           diffc and diffd    0nnn1011
  441.  
  442. 'We then follow with a string of bits,  one per byte in each of the segments,
  443. 'where 0 means no addition,  and 10 means the first mentioned diff is added in,
  444. 'and 11 means the second mentionned diff is added in.
  445. 'On decompression,  this is values 6 to 11 of the bottom four octets. We
  446. 'proceed as for case B, except that we need to use two diffs,  diff1 and diff2
  447. 'taken from diffa to diffd according to the case being considered.
  448. '
  449.     CASE 6
  450.      codecase = 8
  451.      diffindx1 = 1
  452.      diffindx2 = 2
  453.     CASE 7
  454.      codecase = 8
  455.      diffindx1 = 1
  456.      diffindx2 = 3
  457.     CASE 8
  458.      codecase = 8
  459.      diffindx1 = 1
  460.      diffindx2 = 4
  461.     CASE 9
  462.      codecase = 8
  463.      diffindx1 = 2
  464.      diffindx2 = 3
  465.     CASE 10
  466.      codecase = 8
  467.      diffindx1 = 2
  468.      diffindx2 = 4
  469.     CASE 11
  470.      codecase = 8
  471.      diffindx1 = 3
  472.      diffindx2 = 4
  473. '
  474. 'codecases 9 and 10
  475. 'For a type D match,  we encode the segments
  476. 'as 0nnn1100 (for up to 8 segments) where we have four differs,  and
  477. '0nnn1101 where diffa is omitted, 0nnn1101 where diffb is omitted,  0nnn1110
  478. 'where diffc is omitted,  and 0nnn1111 where diffd is omitted.
  479. 'This is followed by a bitstring for each
  480. 'octet in each of the segments,  where we have 0 if no diff is to
  481. 'be added in,  then,  for the three differs in use,
  482. '100 if the first is to be added in, 101 for the second,  and 11 for the third.
  483. 'For four differs,  we have
  484. '100 if diffa is to be added in,  101 for diffb,  110 for diffc,
  485. '111 for diffd.
  486. 'On decompression,  this is again similar to CASE C,  except that we have
  487. 'three or four differs depending on the value 12 (four) or 13 to 16 (three)
  488. 'of the case.  The value of the case says which differ is omitted.
  489. '
  490.     CASE 12
  491.      codecase = 9
  492.      diffindx1 = 1
  493.      diffindx2 = 2
  494.      diffindx3 = 3
  495.      diffindx4 = 4
  496.     CASE 13
  497.      codecase = 10
  498.      diffindx1 = 2
  499.      diffindx2 = 3
  500.      diffindx3 = 4
  501.     CASE 14
  502.      codecase = 10
  503.      diffindx1 = 1
  504.      diffindx2 = 3
  505.      diffindx3 = 4
  506.     CASE 15
  507.      codecase = 10
  508.      diffindx1 = 1
  509.      diffindx2 = 2
  510.      diffindx3 = 4
  511. REM CASE 16 cannot occur because of lack of code space
  512.  
  513.      END SELECT
  514.       
  515. END IF
  516. END IF
  517.  
  518. IF INSTR(diaglevel$,"T") <> 0 then
  519. PRINT #dgf, "Attempting codecase "; codecase; "Ptroffset ";ptroffset;"Cnt ";cnt
  520. PRINT #dgf, "           Differences: ";gdiff(1);gdiff(2);gdiff(3);gdiff(4)
  521. end if
  522.  
  523. SELECT CASE codecase
  524.  
  525. CASE 1: REM Copy ISEG% * count octets from the fcm to the target.
  526.      FOR ijl = 1 TO ISEG% * count
  527.      CALL OutputSub(bytesfcm(fcmpointer + ijl))
  528.      NEXT ijl
  529.      fcmpointer = fcmpointer + 1 + ISEG% * count
  530.      cnt = cnt + ISEG% * count
  531.  
  532. CASE 2: REM Copy ISEG% * count octets from the old file,  starting at
  533. REM cnt + ptroffset + 1.
  534.      FOR ijl = 1 TO ISEG% * count
  535.      CALL OutputSub(bytesold(cnt + ptroffset + ijl))
  536.      NEXT ijl
  537.      fcmpointer = fcmpointer + 1
  538.      cnt = cnt + ISEG% * count
  539.  
  540. CASE 3: REM Add to ptroffset,  a one octet value (octets = 1) or a two
  541. REM octet value (octets =2),  or subtract if negate = 1
  542.      octval = bytesfcm(fcmpointer + 1)
  543.      IF octets = 2 THEN octval = octval * 256 + bytesfcm(fcmpointer + 2)
  544.      IF octets = 1 and octval = 0 then octval = 256
  545.      IF negate = 1 THEN octval = -octval
  546.      ptroffset = ptroffset + octval
  547.      fcmpointer = fcmpointer + octets + 1
  548.  
  549. CASE 4: REM Set gdiff(diffindx) to the one octet value which follows,
  550. REM negated if negate is one.
  551.      octval = bytesfcm(fcmpointer + 1)
  552.      IF negate = 1 THEN octval = -octval
  553.      gdiff(diffindx) = octval
  554.      fcmpointer = fcmpointer + 2
  555.  
  556. CASE 5: REM The next two octets code up the move down of old.
  557.  
  558. IF INSTR(diaglevel$,"B") <> 0  THEN
  559. perc& = fcmpointer - 1
  560. realperc& = ((perc& + donefcm&) * 1000)\lengthfcm&
  561. locate bline,1
  562. PRINT "Percent done is: " + left$(STR$(realperc&/10.0),5) + " % Reading next hunk of reference file - please wait ..." ;
  563. END IF
  564.  
  565. REM Now we have to move the old and adjust pointers
  566.       move = bytesfcm(fcmpointer + 1) * 256 + bytesfcm(fcmpointer + 2)
  567.       fcmpointer = fcmpointer + 3
  568. REM move oldarray down by move and adjust cnt
  569.       cnt = cnt - move
  570.       usedold& = usedold& + move
  571.       endold = endold - move
  572.  
  573.       FOR i = 1 TO endold
  574.       bytesold(i) = bytesold(i + move)
  575.       NEXT i
  576.  
  577. IF INSTR(diaglevel$,"T") <> 0 THEN
  578. PRINT #dgf,"Moving old file by "; move
  579. END IF
  580.  
  581. REM Now read in as much as possible of the old file to fill the buffer.
  582.  
  583. buff$ = STRING$(IBUF%, " ")
  584. ICNT1 = endold
  585. WHILE NOT EOF(fpold) AND ICNT1 + IBUF% <= ISIZE%
  586.      GET #fpold, , buff$
  587.      FOR i = 1 TO IBUF%
  588.      ICNT1 = ICNT1 + 1
  589.      bytesold(ICNT1) = ASC(MID$(buff$, i, 1))
  590.      NEXT i
  591. WEND
  592.  
  593. endold = ISIZE%
  594. IF lengthold& - usedold& < ISIZE% THEN endold = lengthold& - usedold&
  595.  
  596. IF INSTR(Diaglevel$, "P") <> 0 THEN
  597.       LOCATE 10, 1
  598.       PRINT STRING$(80, " ");
  599.       LOCATE 10, 1
  600.       PRINT "Next hunk of old file loaded - proceeding with decompression";
  601.       LOCATE 11, 1
  602.       PRINT STRING$(80, " ");
  603. END IF
  604.  
  605. CASE 6: REM Copy a number of octets given by the next octet from the
  606. REM fcm file to the new file.  This is the last up to 15 octets,  and
  607. REM we are finished.  The fcm file should be exhausted.
  608.       reallyfinished = 1
  609.       copybytes = bytesfcm(fcmpointer + 1)
  610.       FOR ijl = 2 TO copybytes + 1
  611.       CALL OutputSub(bytesfcm(fcmpointer + ijl))
  612.       NEXT ijl
  613.       fcmpointer = fcmpointer + 2 + copybytes
  614.       cnt = cnt + copybytes
  615.       
  616. CASE 7: REM Produce count * ISEG% octets of new file by taking the old
  617. REM and adding gdiff(diffindx) if the bit in the following octets is one.
  618.      bitstringptr = 0
  619.      fcmpointer = fcmpointer + 1
  620.      numocts = count * ISEG%
  621.      WHILE numocts <> 0
  622.       IF GetBit = 0 THEN
  623.          CALL OutputSub(bytesold(cnt + ptroffset + 1))
  624.       ELSE
  625.          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx))
  626.       END IF
  627.       numocts = numocts - 1
  628.       cnt = cnt + 1
  629.       WEND
  630.  
  631. CASE 8: REM Produce count * ISEG% octets of new file by taking the old
  632. REM and adding gdiff(diffindx1) for 10, and gdiff(diffindx2) for 11, and
  633. REM nothing for 0
  634.      bitstringptr = 0
  635.      fcmpointer = fcmpointer + 1
  636.      numocts = count * ISEG%
  637.      WHILE numocts <> 0
  638.       IF GetBit = 0 THEN
  639.          CALL OutputSub(bytesold(cnt + ptroffset + 1))
  640.          
  641.       ELSE
  642.         IF GetBit = 0 THEN
  643.          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx1))
  644.      ELSE
  645.          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx2))
  646.      END IF
  647.       END IF
  648.       numocts = numocts - 1
  649.       cnt = cnt + 1
  650.       WEND
  651.      
  652. CASE 9: REM Produce count * ISEG% octets of new file by taking the old
  653. REM and adding nothing for 0,  gdiff(1) for 100, gdiff(2) for 101,  gdiff(3)
  654. REM for 110,  and gdiff(4) for 111.
  655.      bitstringptr = 0
  656.      fcmpointer = fcmpointer + 1
  657.      numocts = count * ISEG%
  658.      WHILE numocts <> 0
  659.       IF GetBit = 0 THEN
  660.          CALL OutputSub(bytesold(cnt + ptroffset + 1))
  661.       ELSE
  662.         IF GetBit = 0 THEN
  663.             IF GetBit = 0 THEN
  664.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx1))
  665.          ELSE
  666.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx2))
  667.          END IF
  668.      ELSE
  669.             IF GetBit = 0 THEN
  670.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx3))
  671.          ELSE
  672.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx4))
  673.          END IF
  674.      END IF
  675.       END IF
  676.       numocts = numocts - 1
  677.       cnt = cnt + 1
  678.       WEND
  679.  
  680. CASE 10: REM Produce count * ISEG% octets of new file by taking the old
  681. REM and adding nothing for 0, gdiff(diffindx1) for 100, and gdiff(diffindx2)
  682. REM for 101, gdiff(diffindx3) for 11.
  683.      bitstringptr = 0
  684.      fcmpointer = fcmpointer + 1
  685.      numocts = count * ISEG%
  686.      WHILE numocts <> 0
  687.       IF GetBit = 0 THEN
  688.          CALL OutputSub(bytesold(cnt + ptroffset + 1))
  689.       ELSE
  690.         IF GetBit = 0 THEN
  691.             IF GetBit = 0 THEN
  692.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx1))
  693.          ELSE
  694.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx2))
  695.          END IF
  696.      ELSE
  697.                          CALL OutputSub(bytesold(cnt + ptroffset + 1) + gdiff(diffindx3))
  698.      END IF
  699.       END IF
  700.       numocts = numocts - 1
  701.       cnt = cnt + 1
  702.       WEND
  703.  
  704. CASE ELSE
  705.      PRINT  "**** ERROR - FCM format error - Bad codecase"
  706.      END
  707.  
  708. END SELECT
  709.  
  710. WEND
  711.  
  712. REM Now loop to do another hunk if necessary
  713. finished = 0
  714. IF lengthfcm& <= endfcm + donefcm& THEN
  715.      finished = 1
  716.      CLOSE #fpold
  717.      CLOSE #fpfcm
  718. ELSE
  719.  
  720. IF INSTR(diaglevel$,"B") <> 0  THEN
  721. perc& = fcmpointer - 1
  722. realperc& = ((perc& + donefcm&) * 1000)\lengthfcm&
  723. locate bline,1
  724. PRINT "Percent done is: " + left$(STR$(realperc&/10.0),5) + " %  Reading in next hunk of files.  Please wait ....    " ;
  725. END IF
  726.  
  727. REM Prepare for next hunk
  728.  
  729. fcmpointer = fcmpointer - ISIZE3%
  730. donefcm& = donefcm& + ISIZE3%
  731. REM move fcm array down by ISIZE3%
  732.  
  733. realendfcm = realendfcm - ISIZE3%
  734. FOR ijl = 1 TO realendfcm
  735. bytesfcm(ijl) = bytesfcm(ijl + ISIZE3%)
  736. NEXT ijl
  737.  
  738. REM Now read in as much as possible of the fcm file to fill the buffer.
  739.  
  740. buff$ = STRING$(IBUF%, " ")
  741. ICNT2 = realendfcm
  742. WHILE NOT EOF(fpfcm) AND ICNT2 + IBUF% <= ISIZE%
  743.      GET #fpfcm, , buff$
  744.      FOR i = 1 TO IBUF%
  745.      ICNT2 = ICNT2 + 1
  746.      bytesfcm(ICNT2) = ASC(MID$(buff$, i, 1))
  747.      NEXT i
  748. WEND
  749.  
  750. realendfcm = ISIZE%
  751. endfcm = ISIZE2%
  752. IF lengthfcm& - donefcm& <= ISIZE% THEN 
  753.        endfcm = lengthfcm& - donefcm&
  754.        realendfcm = endfcm
  755. END IF
  756.  
  757. IF INSTR(Diaglevel$, "P") <> 0 THEN
  758.       LOCATE 10, 1
  759.       PRINT STRING$(80, " ");
  760.       LOCATE 10, 1
  761.       PRINT "Next hunk of fcm file loaded - proceeding with decompression";
  762.       LOCATE 11, 1
  763.       PRINT STRING$(80, " ");
  764. END IF
  765.  
  766. REM This ends the preparation for the next hunk.
  767. END IF
  768.  
  769. LOOP UNTIL finished = 1
  770.  
  771. IF reallyfinished <> 1 THEN
  772.     PRINT  "**** ERROR - FCM format error - Ran out of FCM file before finished"
  773.     CLOSE #fp
  774.     CLOSE #fpfcm
  775.     CLOSE #fpold
  776.     if dgf <> 0 then CLOSE #dgf
  777.     KILL Workfile$
  778.     END
  779. END IF
  780.  
  781. PUT #fp, , obuff$
  782. CLOSE #fp
  783. CLOSE #fpfcm
  784. CLOSE #fpold
  785.  
  786. IF sumcheckval1 <> sumcheck1 OR sumcheckval2 <> sumcheck2 THEN
  787.    PRINT "**** ERROR - Sumcheck of reconstituted file differs from original"
  788. ELSE
  789.    SHELL "COPY " + Workfile$ + " " + Newfile$ + " > NUL"
  790.    KILL Workfile$
  791. END IF
  792.  
  793. IF INSTR(Diaglevel$, "P") <> 0 THEN
  794. LOCATE 13, 1
  795. PRINT STRING$(80, " ");
  796. LOCATE 13, 1
  797. COLOR 14, 4, 1
  798. PRINT "Decompression complete.  Number of octets output is ", outputcnt&;
  799. LOCATE 18, 1
  800. PRINT "Forward decompression finished.";
  801. LOCATE 24, 1
  802. END IF
  803.  
  804. if dgf <> 0 then CLOSE #dgf
  805. END
  806.       
  807. 'REM This is part of the eventual documentation,  and describes the
  808. 'compressed format based on this approach. 
  809. '
  810. 'There will be an initial block containing:
  811. ' 1.  a length count (one octet)for the next item.
  812. ' 2.  the full path name of the file that is to be compressed
  813. '     (on decompression,  a file TEMP.TMP will be created in the current
  814. '     directory,  and then copied to the original destination path when
  815. '     decompression is complete,  unless overridden by a different target).
  816. ' 3.  two octets of sum check for the whole of this file;  the sum check
  817. '     is the standard one of SIGMA(Ai) and SIGMA(iAi),  all MOD 255.
  818. ' 4.  a length count for the next item.
  819. ' 5.  the full path name of the reference file (this can be overridden
  820. '     on decompression)
  821. ' 6.  two octets of sum check for the first 1K of the reference file.
  822. '
  823. 'Decompression will be abandonned if the reference file is not found
  824. 'on the receiving system,  with the correct sumcheck,  and TEMP.TMP will
  825. 'not be copied unless the sum-checks of the original file match with the
  826. 'decompressed one.
  827. '
  828. 'The receivers state is set up with ptroffset = 0, gdiff(1) = 0, gdiff(2) = 0,
  829. 'gdiff(3) = 0,  gdiff(4) = 0.   These values are retained unless explicitly
  830. 'changed.  The target value is old plus difference. (Difference is new - old).
  831. 'The old values to be used are at cnt + ptroffset + 1 to
  832. 'cnt + ptroffset + ISEG%,  where cnt is the number
  833. 'of new octets generated so far.  A positive pointer change is an addition
  834. 'to ptroffset.
  835. '(A ptroffset is old posn - new posn for compression).
  836. '
  837. 'The following algorithm determines the compressed format:
  838. '
  839. 'We take each ISEG block in turn.
  840. '
  841. 'If there is no match, we output 10nnnnnn followed by the nnnnnn sets of
  842. '16 octets for up to 64 (nnnnnn of 0 means 64) segments.
  843. 'Note that 11nnnnnn is used for total matches (see below).  All other
  844. 'codes are 0xxxxxxx.
  845. 'On decompression,  we branch on bit 1 equals 1 or 0,  and if bit 1 is
  846. '1,  then we branch on 10 or 11.  For 10,  we pick up nnnnnn,  and copy
  847. 'ISEG% * nnnnnn octetcs from the fcm to the target.
  848. '
  849. 'If there is a pointer change,  we need to signal it in the output.
  850. 'We have four cases for the value of the ptr change:
  851. '             positive and less than (or equals) 256
  852. '             negative and less than (or equals) 256
  853. '             positive and over 256
  854. '             negative and over 256
  855. 'We use 00000000,  00000001, 00010000, and 00010001 for these four cases.
  856. 'In the first two cases,  we follow with a single octet,  and in the last
  857. 'two with two octets.  In the case of the single octet,  zero means 256.
  858. 'On decompression,  we are in the first bit zero case,  and branch first on
  859. 'the bottom four bits,  taking the 0 and 1 cases here.  For zero,  we are
  860. 'collecting a positive value, and for 1 a negative.  Next we branch on the
  861. 'value of nnn in 0nnn000x.  For 0 we have a single octet following and
  862. 'a value to be added (after negation if necessary) to ptroffset.  For 1
  863. 'we have a two octet value (most significant first).
  864. '
  865. 'Next we look at whether a diffa, diffb, diffc,  diffd change is needed.
  866. 'If a change of a diff is needed,  we
  867. 'have the following cases for the diff:
  868. '             positive and less than 256
  869. '             negative and less than 256
  870. 'We use 00100000 and 00100001 for these cases for diffa,  00110000 and
  871. '00110001 for these cases for diffb,  01000000 and 01000001 for diffc,
  872. 'and 0101000 and 01010001 for diffd,  followed by a single byte which gives
  873. 'the fcm diff value.
  874. 'On decompression, this is the nnn = 2 (diffa), 3 (diffb), 4 (diffc) and
  875. '5 (diffd) cases described under pointer above.
  876. '
  877. 'This completes the use of the 0mmm0000 and 0mmm0001 values
  878. 'except for 110 which is used in termination below,  and 111 which is spare.
  879. 'Remaining codes are
  880. '0mmmxxxx where xxxx is above 0001.
  881. '
  882. 'In all cases,  apart from no match,  we first code any pointer change
  883. 'needed,  then any one or more diff changes that are needed,  then we code
  884. 'the type.
  885. '
  886. 'For a type A match,  we look
  887. 'to see if the next block is also type A with no pointer change.  If so,
  888. 'we count the number of blocks we can merge in,  up to a maximum of 64,
  889. 'and output 11nnnnnn,  where n is the count of the number of merged-in
  890. 'blocks
  891. '(nnnnnn all zeros means 64).
  892. 'On decompression,  this is the branch from first bit 1,  first two 11.
  893. 'We copy ISEG% * nnnnnn octets from the old file,  starting at cnt +
  894. 'ptroffset + 1.
  895. '
  896. 'For a type B match,  we determine whether to use diffa,  b, c,  or d (based
  897. 'on this segment alone,  and possibly with a diff change).  We then merge in
  898. 'up to 8 segments (nnn = 000 means 8) with the same pointer and diff value
  899. '(after juggling diffs if necessary).  The coding is 0nnn0010 for use of diffa
  900. '0nnn0011 for use of diffb,  0nnn0100 for use of diffc,  and 0nnn0101 for use of
  901. 'diffd.  nnn is the number of segments merged in.  We then follow with a
  902. 'string of bits,  one per byte in each of the segments,  where 0 means no
  903. 'addition, and 1 means add in the selected diff.   Bits up to the next octet
  904. 'boundary are ignored.
  905. 'On decompression,  we use nnn to determine the number of octets to be
  906. 'produced (16 * nnn),  and then take as many octets as necessary to give
  907. 'us the additions of diffa,  b etc.  We start the old at cnt + ptroffset + 1
  908. 'and we set new to old + diff. (Diff was defined as new - old)
  909. '
  910. 'For a type C match,  we have six possible diff selections to use, coded as
  911. 'follows (again,  merging in up to 8 possible segments):
  912. '           diffa and diffb    0nnn0110
  913. '           diffa and diffc    0nnn0111
  914. '           diffa and diffd    0nnn1000
  915. '           diffb and diffc    0nnn1001
  916. '           diffb and diffd    0nnn1010
  917. '           diffc and diffd    0nnn1011
  918.  
  919. 'We then follow with a string of bits,  one per byte in each of the segments,
  920. 'where 0 means no addition,  and 10 means the first mentioned diff is added in,
  921. 'and 11 means the second mentionned diff is added in.
  922. 'On decompression,  this is values 6 to 11 of the bottom four octets. We
  923. 'proceed as for case B, except that we need to use two diffs,  diff1 and diff2
  924. 'taken from diffa to diffd according to the case being considered.
  925. '
  926. 'For a type D match,  we encode the segments
  927. 'as 0nnn1100 (for up to 8 segments) where we have four differs,  and
  928. '0nnn1101 where diffa is omitted, 0nnn1110 where diffb is omitted,  0nnn1111
  929. 'where diffc is omitted.  For diffd omitted,  we have no code space left,
  930. 'and treat that as if it were a four differ (code 0nnn1100).
  931. 'This is followed by a bitstring for each
  932. 'octet in each of the segments,  where we have 0 if no diff is to
  933. 'be added in,  then,  for the three differs in use,
  934. '100 if the first is to be added in, 101 for the second,  and 11 for the third.
  935. 'For four differs,  we have
  936. '100 if diffa is to be added in,  101 for diffb,  110 for diffc,
  937. '111 for diffd.
  938. 'On decompression,  this is again similar to CASE C,  except that we have
  939. 'three or four differs depending on the value 12 (four) or 13 to 16 (three)
  940. 'of the case.  The value of the case says which differ is omitted.
  941. '
  942. 'Finally,  we have to cope with the residual set of up to 15 octets at the
  943. 'end of the file.   We simply output 00001110,  then a single octet saying
  944. 'how many follow,  then the octets.  If there are none,  we still output
  945. 'the single octet and the null count.  On decompression,  we copy octets
  946. 'across.
  947. '
  948. 'Where we have discarded some old file and refilled the buffers,  we
  949. 'signal this
  950. 'in the output by putting out a single octet of 00011110 followed by
  951. 'two octets giving the amount of the move.
  952. 'On decompression,  this is a signal to move the new file by the full
  953. '12K,  and to move the old file by the specified amount.
  954. '
  955. 'This ends the use of the 0nnnxxxx codes.  The value 1111 of xxxx is
  956. 'spare.
  957. '
  958. 'Thus,  we get the following counts:
  959. '    first no match                  17
  960. '    subsequent no match (up to 128) 16
  961. '    ptr change (<256)                2
  962. '    ptr change (>256)                3
  963. '    diff change                      2
  964. '    type A                           1 (?+3 - ptr change)
  965. '    subsequent A (up to 128)         0
  966. '    type B                           3 (?+5 - ptr + 1 diff)
  967. '    subsequent B (up to 8)           2
  968. '    type C                           4 to 5 bytes (?+7 - ptr + 2 diff)
  969. '    subsequent C (up to 8)           2 to 4 bytes
  970. '    type D or E                      4 to 7 bytes (?+5/4 - ptr/diff +  diff)
  971. 'NOTE - We recognise D or E only if there is at most 1 ptr and one diff,  or
  972. 'two diff changes.
  973. '
  974.  
  975. FUNCTION FileExists! (testfile$)
  976.  
  977. DIM InRegs AS RegType, OutRegs AS RegType
  978.  
  979. checkname$ = testfile$ + CHR$(0)
  980.  
  981. InRegs.ax = &H4300
  982. InRegs.dx = SADD(checkname$)
  983.  
  984. CALL INTERRUPT(&H21, InRegs, OutRegs)
  985.  
  986. IF (&H1 AND OutRegs.flags) <> 0 THEN
  987.        FileExists = 0
  988. ELSE
  989.        FileExists = 1
  990. END IF
  991.  
  992. END FUNCTION
  993.  
  994. FUNCTION GetBit
  995.  
  996. SHARED bitstringptr, bitstring$, bits$(), bytesfcm(), fcmpointer
  997.  
  998.       IF bitstringptr = 0 THEN
  999.             bitstring$ = bits$(bytesfcm(fcmpointer))
  1000.          bitstringptr = 1
  1001.          fcmpointer = fcmpointer + 1
  1002.       END IF
  1003.       bit$ = MID$(bitstring$, bitstringptr, 1)
  1004.       IF bit$ = "1" THEN
  1005.        GetBit = 1
  1006.       ELSE
  1007.        GetBit = 0
  1008.       END IF
  1009.       bitstringptr = bitstringptr + 1
  1010.       IF bitstringptr = 9 THEN bitstringptr = 0
  1011.  
  1012. END FUNCTION
  1013.  
  1014. SUB GetCommNames
  1015.  
  1016. SHARED Reffile$, Fcmfile$, Newfile$, Workfile$, Diaglevel$, diagoutput$
  1017.     
  1018.      DIM z$(6)
  1019.      Maxargs = 6
  1020.      Numargs = 0: in = 0
  1021.      Cl$ = COMMAND$
  1022.      l = LEN(Cl$)
  1023.      FOR i = 1 TO l
  1024.        c$ = MID$(Cl$, i, 1)
  1025.        IF (c$ <> " " AND c$ <> CHR$(9)) THEN
  1026.       IF in = 0 THEN
  1027.                                 IF Numargs = Maxargs THEN EXIT FOR
  1028.                                 Numargs = Numargs + 1
  1029.                                 in = 1
  1030.       END IF
  1031.       z$(Numargs) = z$(Numargs) + c$
  1032.        ELSE
  1033.       in = 0
  1034.        END IF
  1035.      NEXT i
  1036.  
  1037. IF Numargs < 1 THEN
  1038.      PRINT "You have to specify the fcm file name to be processed. This is optionally"
  1039.      PRINT "followed (in order) by:"
  1040.      PRINT "        the verbosity level (B or P),  and optionally T;"
  1041.      PRINT "        (B is brief,  P is progress messages, T is trace);"
  1042.      PRINT "        (if and only if T is selected) the name of the trace file"
  1043.      PRINT "        the name of the new file to be created"
  1044.      PRINT "        the name of the file to be used as the reference file"
  1045.      PRINT "        the name of the file to be used as the work file"
  1046.      PRINT " "
  1047.      PRINT "If an optional argument is present,  all earlier optional arguments"
  1048.      PRINT "have to be present."
  1049.      PRINT " "
  1050.      PRINT "If the filename for an optional argument is given as the string DEFAULT"
  1051.      PRINT "(all upper case),  or if an optional argument is omitted,  then the"
  1052.      PRINT "following defaults apply:"
  1053.      PRINT " "
  1054.      PRINT "Verbosity = B"
  1055.      PRINT "Trace file = not applicable (mandatory if T requested)"
  1056.      PRINT "New file to create = as specified when JLPAK was executed"
  1057.      PRINT "Reference file = as specified when JLPAK was executed"
  1058.      PRINT "Work file = TEMP.TMP in current directory"
  1059.      PRINT " "
  1060.      END
  1061. END IF
  1062.  
  1063. Fcmfile$ = UCASE$(z$(1))
  1064.  
  1065. Diaglevel$ = "B"
  1066. IF numargs >=2 then diaglevel$ = ucase$(z$(2))
  1067.  
  1068. IF INSTR(diaglevel$,"T") <> 0 THEN
  1069.     IF INSTR(diaglevel$,"P") <> 0 THEN
  1070.           diaglevel$ = "TP"
  1071.     ELSE
  1072.           diaglevel$ = "TB"
  1073.     END IF
  1074. ELSE
  1075.     IF INSTR(diaglevel$,"P") <> 0 THEN
  1076.           diaglevel$ = "P"
  1077.     ELSE
  1078.           diaglevel$ = "B"
  1079.     END IF
  1080. END IF
  1081.  
  1082. IF INSTR(diaglevel$,"T") <> 0 AND Numargs < 3 THEN
  1083.      PRINT "Tracing requested but no trace file name.  Please respecify"
  1084. END IF
  1085.  
  1086. arginc = 0
  1087. IF INSTR(diaglevel$,"T") <> 0 THEN 
  1088.      diagoutput$ = UCASE$(z$(3))
  1089.      arginc = 1
  1090. END IF
  1091.  
  1092. Newfile$ = "DEFAULT"
  1093. If numargs >= (3 + arginc) then Newfile$ = z$(3 + arginc)
  1094.  
  1095.  
  1096. Reffile$ = "DEFAULT"
  1097. If numargs >= (4 + arginc) then Reffile$ = z$(4 + arginc)
  1098.  
  1099.  
  1100. Workfile$ = "DEFAULT"
  1101. If numargs >= (5 + arginc) then Workfile$ = z$(5 + arginc)
  1102.  
  1103. END SUB
  1104.  
  1105. SUB OutputSub (OctetValue)
  1106.  
  1107. SHARED obuff$, sumcheck1,  sumcheck2, fp, trace
  1108.  
  1109. IF LEN(obuff$) > 100 THEN
  1110.        PUT #fp, , obuff$
  1111.        obuff$ = ""
  1112. END IF
  1113.  
  1114. useoctetvalue = octetvalue
  1115.  
  1116. IF trace = 1 then
  1117. IF octetvalue < 0 or octetvalue > 255 then
  1118.   PRINT "**** ERROR - FCM format error - Octetvalue out of range (bug)"; octetvalue
  1119.   useoctetvalue = 0
  1120.   END
  1121. END IF
  1122. end if
  1123. sumcheck1 = (sumcheck1 + octetvalue) MOD 255
  1124. sumcheck2 = (sumcheck2 + sumcheck1) MOD 255
  1125. obuff$ = obuff$ + CHR$(useOctetValue)
  1126. outputcnt& = outputcnt& + 1
  1127.  
  1128. END SUB
  1129.  
  1130.