home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / arc-lbr / unarc16s.ark / UNARC.Z80 < prev   
Text File  |  1987-03-27  |  126KB  |  4,126 lines
  1.     TITLE    UNARC   CP/M Archive File Extractor
  2.  
  3. IDENT    MACRO
  4.     DB    'UNARC  1.6  27 Mar 87'
  5. ENDM
  6.  
  7. ; (Remember to update version/date here and maintain history log below)
  8.  
  9. SELF    MACRO            ; Self-unpacking archive file name
  10.     DB    'UNARC16'
  11. ENDM
  12.  
  13. COPR    MACRO
  14.     DB    'Copyright (C) 1986, 1987 by Robert A. Freed'
  15. ENDM
  16.  
  17.     .COMMENT |
  18.  
  19. NOTICE:  This program is the copyrighted property of its author -- it
  20. is NOT in the public domain.  HOWEVER...  Free use, distribution, and
  21. modification of this program is permitted (and encouraged), subject to
  22. the following conditions:
  23.  
  24. (1)  Such use or distribution must be for non-profit purposes only.
  25. (2)  The author's copyright notice may not be altered or removed.
  26. (3)  Modifications to this program may not be distributed without
  27.      notification of and approval by the author.
  28. (4)  The source program code may not be used, in whole or in part,
  29.      in any other publicly-distributed or derivative work without
  30.      similar notification and approval.
  31.  
  32. No fee is requested or expected for the use and distribution of this
  33. program subject to the above conditions.  The author reserves the right
  34. to modify these conditions for any future revisions of this program.
  35. Questions, comments, suggestions, commercial inquiries, and bug reports
  36. or fixes are welcomed by the author:
  37.  
  38.         Bob Freed
  39.         62 Miller Rd.
  40.         Newton Centre, MA  02159
  41.         Telephone (617) 332-3533
  42. |
  43.     PAGE
  44.     SUBTTL    Modification History
  45.  
  46.     .COMMENT |
  47.  
  48. 1.6    27 Mar 87  (RAF)
  49.  
  50. - Murphy's Law strikes again:  Within hours after the release of version
  51.   1.5, a bug was discovered.  Incorrect CRC error messages are generated
  52.   during file extraction in some situations.  This was caused by failure
  53.   to clear carry before a 16-bit subtract (SBC HL,DE), which we changed
  54.   inadvertantly in 1.42.  (So much for Beta-testing!)  Such faulty error
  55.   messages occur only for disk file extraction, not when the 'C' command
  56.   option is used to check an archive.  Furthermore, the bug occurs only
  57.   when (1) a file contains an odd number of 128-byte records and (2) the
  58.   BDOS returns from the last write-record call with carry set.  [Note of
  59.   interest:  The CP/M 2.2 BDOS returns with carry set only if the output
  60.   drive is different than the current default drive.  This assumes, of
  61.   course, that no RSX-type system extensions are in place to intercept
  62.   BDOS calls:  We would have caught this bug, but for such a system
  63.   extension which always clears carry before returning from BDOS calls.]
  64.   Our thanks to Tom Brady for reporting this one.
  65.  
  66. - Zero-fills last record of .COM file.  (Not needed with Z80ASM and/or
  67.   SLRNK, but provided so that M80/L80 will generate identical output to
  68.   that produced by the SLR Systems' tools.)
  69.  
  70. 1.5    24 Mar 87  (RAF)
  71.  
  72. - UNARC is now distributed as a self-unpacking archive, UNARC15.ARK.
  73.   This requires: (1) the non-z80 version (UNARCA.COM) must be the FIRST
  74.   file in the archive, (2) UNARCA.COM must be stored in UNPACKED form
  75.   using compression version 1, (3) the header for UNARCA.COM must be
  76.   preceded by the SINGLE byte, 0C3H (opcode for unconditional jump),
  77.   and (4) the archive must be copied or renamed to UNARCxx.COM on the
  78.   current disk drive (xx = current version, i.e. UNARC15.COM for this
  79.   release).  Then, the file is executed with a single optional parameter
  80.   specifying the disk drive to use for extracting all files (defaults to
  81.   current drive).  For example, assuming UNARC15.ARK is on drive B:
  82.  
  83.   A>B:                ; Set current drive for UNARC15.ARK
  84.   B>REN UNARC15.COM=UNARC15.ARK    ; Rename it to UNARC15.COM
  85.   B>UNARC15 [d:]        ; Extract files to current drive [or d:]
  86.  
  87. - Corrects non-Z80 version emulation of the Z80 16-bit add and subtract
  88.   instructions (ADC_HL and SBC_HL macros), to properly set the Z(ero)
  89.   condition flag.  Previously, Z reflected only the upper byte of the
  90.   16-bit result and was incorrect for non-zero results less than 256.
  91.   This caused a serious bug (in the non-Z80 version, UNARCA.COM, only):
  92.   Failure to output the last 1-255 bytes of an extracted file in cases
  93.   where the final output buffer size was less than 256 bytes.  (In
  94.   particular, ALL files less than 256 bytes in length could not be
  95.   extracted.)  Thanks to Barry Kaufman (Multipath, Inc., P.O. Box 395,
  96.   Montville, NJ  07045) for bringing this to our attention.  [This
  97.   tends to confirm our opinion regarding the prevalence of non-Z80
  98.   systems, since this bug has been present but unreported since the
  99.   release of UNARC 1.2.]
  100.  
  101. - Alters the interpretation of the USELUX definition in the UNARCOVL.ASM
  102.   overlay file.  USELUX = YES now restricts file typeout buffering to
  103.   one page (equivalent to TYPGS = 1) instead of altering the upper TPA
  104.   limit (CCPSV value).  This eliminates the LUXSIZ definition (which
  105.   specified the size of the LUX RSX-type resident code) and avoids the
  106.   confusion introduced by recent multiple new versions of LUX from
  107.   different authors.
  108.  
  109. - Corrects CP/M 2.2 tab alignment for the first displayed line of file
  110.   typeout after continuing from a screen pause ([more] message).
  111.  
  112. - Adds explicit check for CTRL-S (suspend output) in CABORT, to handle
  113.   cases where standard CP/M 2.2 BDOS misses these.  (Also masks console
  114.   input characters to 7 bits, in case this is not done, as it should be,
  115.   by BIOS.  This is an attempt to solve reports of failure to recognize
  116.   CTRL-C and CTRL-S on some systems.)
  117.  
  118. - Allows 0-length "crunched" files (i.e. with no code size byte).  [The
  119.   various MS-DOS ARC utilities differ in their handling of 0-length
  120.   files.  SEA's ARC generates unpacked (version 2), which we feel is
  121.   esthetically best, and ARCA generates packed (version 3).  But PKARC
  122.   generates crunched (version 8), which was regurgitated by earlier
  123.   UNARC versions due to the absence of the code size byte.]
  124.  
  125. - Minor code improvements for version 1.42 changes.
  126.  
  127. - Eliminates DS directives at end of file to avoid wasted space when
  128.   linked with L80 (as opposed to SLRNK, which handles trailing
  129.   uninitialized data intelligently).  This also permits overlaying of
  130.   the self-unpacking initialization code by data in the non-Z80 version.
  131.  
  132. 1.42    07 Jan 87  (RAF)
  133.  
  134. Interim Beta-test release:
  135.  
  136. - Supports 'squashed' files (compression version 9) generated by PKARC
  137.   version 2.0, as defined by Phil Katz' document file SQSHINFO.DOC,
  138.   dated 12/27/86.  (Katz is certainly doing his best to make life
  139.   interesting for us.)  Note:  We've made an educated guess that Katz'
  140.   handling of bypassed output codes after adaptive reset is identical to
  141.   that of crunched (version 8) files.  (Since there is no requirement
  142.   for ARC512 compatibility here, he could have handled this in a less
  143.   brain-damaged manner.  However, on the basis of two very limited test
  144.   examples, our assumption appears to be true.)  This compression method
  145.   requires a minimum TPA size of 30K (Z80) or 31K (8080) for extraction
  146.   (worst case yet).
  147.  
  148. - Lists total of CRC values (mod 64K), as per suggestion of Steven
  149.   Greenberg.  This provides a simple single checksum value for comparing
  150.   files created by different archive programs.  (Since the CRC is
  151.   computed over the UNcompressed files, this value should be the same
  152.   for all archives created from the same set of input files, independent
  153.   of any particular variations in file order or compression methods.)
  154.  
  155. - Adds trailing command line option 'C' to check the validity of one or
  156.   more (or all, via *.*) archive members (i.e. to extract them for
  157.   purposes of CRC and length checking, without storing them as disk
  158.   files).  This is a quick hack, in response to a suggestion by Keith
  159.   Petersen.  This option is currently allowed only if the wheel byte is
  160.   non-zero.  I.e., it is ignored in restricted RCP/M versions (although
  161.   there is no reason why this could not be allowed, subject to a Sysop-
  162.   definable patch byte).  Also, the limited command line syntax prevents
  163.   the simultaneous use of the 'N' option for non-paged typeout (i.e.
  164.   screen pauses will always occur).  Both of these limitations will be
  165.   eliminated with addition of enhanced command line processing
  166.   (including du: user area syntax) in a future release.
  167.  
  168. - Disallows use of 'P' option for printing files in restricted (RCP/M)
  169.   versions.  (We inadvertantly failed to implement this as intended in
  170.   the 1.41 release.  Hopefully, the recipients of that release will
  171.   honor our limited-distribution request!)  Note that the statement
  172.   accompanying the 1.41 release is slightly incorrect:  Both 'P' and 'C'
  173.   options are processed ONLY if the wheel byte is non-zero (and in the
  174.   absence of an output file drive, which always causes extraction to a
  175.   disk file); a zero HODRV byte does not, in itself, inhibit these.
  176.  
  177. - Makes .ARK the preferred default archive filetype.  I.e., first open
  178.   attempt uses .ARK; second attempt tries .ARC if first is unsuccessful.
  179.  
  180. - Expands help message usage examples a bit (now that 4K limit is not a
  181.   concern).
  182.  
  183. Note:  The additions in 1.41 and 1.42 have pushed the size of the Z80
  184. version UNARC.COM file above 4K (which means 6K or 8K disk space on most
  185. systems).  Such is life (and progress):  We've resisted this for a long
  186. time, but it now seems unavoidable.  The UNARCOVL.ASM overlay file
  187. distributed with UNARC 1.4 remains applicable for these releases.
  188.  
  189. 1.41    14 Dec 86  (RAF)
  190.  
  191. Special limited-distribution release:
  192.  
  193. - Adds trailing command line option 'P' to allow printing of an archive
  194.   member file on CP/M list device.  This is a quick hack, in response to
  195.   a user request (Craig Arno, Seattle), to allow direct printing of
  196.   highly-compressed binary plot images (e.g. 1+ MB files which crunch
  197.   to < 5% of their original size).  Accordingly, ALL data is passed to
  198.   the printer in 8-bit form, with no filtering by UNARC (including ^Z).
  199.   This option is allowed under the same conditions as disk extraction
  200.   (non-zero HODRV and wheel byte), and the files which may be printed
  201.   are subject to the filetype exclusion table for typeout.
  202.  
  203. - Defers initializing listing totals until after CHECK is called.
  204.   (This moved in 1.4 to accomodate LPS, without realizing it might
  205.   cause a problem, albeit with an insignificant probability.  LPS
  206.   is now allocated in code and cleared by CHECK.)
  207.  
  208. 1.4    21 Nov 86  (RAF)
  209.  
  210. We had hoped NOT to release another update of this program, but to
  211. replace it entirely by three new programs with enhanced functionality
  212. (UNARK, ADIR, and ATYPE), in conjunction with the upcoming release of
  213. the CP/M archive file builder (NOAH).  However, (sigh).....
  214.  
  215. Corrects bug (exhibited with .ARC's created by version 1.1 or later of
  216. Phil Katz' PKARC program for MS-DOS) which caused files to be extracted
  217. incorrectly (with output file length and CRC warnings) due to string
  218. table reset codes appearing early in crunched files (i.e. before the
  219. output code length reaches 12 bits).  Thanks to Keith Petersen for
  220. identifying and notifying us of this problem.
  221.  
  222. And, while we're at it.....
  223.  
  224. Adds paging of all displayed output, controlled by non-zero patch byte
  225. specifying screen lines between pauses (TYLPS, default value = 23).
  226. This is essentially the feature added by 'Larry Smith' (see version 1.3
  227. below), but we've been able to do it (with enhancements) and still keep
  228. the (Z80 version) .COM file below 4K (just!).  Causes '[more]' message
  229. to appear at bottom of screen.  Space bar scrolls one more line, ^C
  230. aborts, anything else scrolls one more screenful.  (LINE FEED may be
  231. used to avoid overprinting the '[more]' line.)  May be defeated for
  232. continuous typeout by trailing 'N' (after a blank) on command line.
  233.  
  234. Also:
  235.  
  236. - If archive filetype omitted, and the default .ARC filetype not found,
  237.   tries .ARK as an alternate default.  (Anticipates NOAH, and compatible
  238.   with Irv Hoff's KMD22.)
  239.  
  240. - Incorporates option to bypass BDOS function 31 call (Get DPB Address),
  241.   for non-std CP/M clones such as Cromemco CDOS and CP/M-68K emulator
  242.   for 8080 CP/M 2.2.  (Eliminates UNARC12 patch notice, UNARC-P1.NOT.)
  243.  
  244. - Allows program name to be patched (at start of USAGE message).
  245.   Affects all help screen references and abort message.  (E.g., RCP/M
  246.   sysops may prefer 'ADIR' to 'UNARC'.)
  247.  
  248. - Corrects count of bytes skipped due to invalid header when processing
  249.   'self-unpacking' archives with more than 3 preliminary bytes.
  250.  
  251. - Enhances recovery processing for invalid archive headers, and merges
  252.   'invalid format' and 'unexpected eof' errors.  This change tends to
  253.   cause display of a garbage directory entry (before abort) for non-ARC
  254.   files, but it does allow processing of certain new self-unpacking
  255.   archives, such as Phil Katz' PKX32A11.COM.
  256.  
  257. - Changes the replacement for an invalid filename char from '_' to '$'
  258.   (since underline is not allowed as a filename char by CP/M CCP, and
  259.   '$' usually carries a 'temporary' significance in CP/M).
  260.  
  261. - Reduces directory listing width by one column (78 now), to allow
  262.   one more char without extra blank line on terminals which autowrap
  263.   after column 80 (e.g. allows leading semicolon generated by MDM7 and
  264.   IMP during disk file capture of terminal output).
  265.  
  266. - Adds a few bells to warning and fatal messages, along with a patch
  267.   byte to disable these (for those who prefer solitude).
  268.  
  269. - Allows ^K in addition to ^C for program abort requests.  (For certain
  270.   ancient RCP/M systems which never pass ^C back to user programs.)
  271.  
  272. - Adds .ARK and .?Z? (CP/M CRUNCH or MS-DOS ZOO 'Z format' files) to
  273.   list of excluded typeout extensions, and eliminates .CMD (since that
  274.   might be a readable dBASE command file instead of CP/M-86 binary).
  275.  
  276. - Simplifies the Z80 CPU check and removes the 'Z80 Version' message
  277.   in the help display, to save a few bytes in that version.  (Alternate
  278.   version, UNARCA.COM, now displays '8080 Version'.)
  279.  
  280. - Adds 8080 version message recommending Z80 version, when run on a Z80.
  281.  
  282. 1.3    --none--   (RAF)
  283.  
  284. This version bypassed due to appearance of several unauthorized updates
  285. with the name UNARC13 (and not because of superstition).  Most notably,
  286. these include Steve Sanders' unnecessary addition of ^S and ^C checking
  287. during file typeout (because TurboDOS does not properly emulate CP/M's
  288. handling of these in BDOS function 2 calls), and the addition of paged
  289. typeout by 'Larry Smith' (whoever he is; a worthwhile enhancement, but
  290. the release was deficient in several other respects).  WHY CAN'T THESE
  291. 'CONTRIBUTORS' SIMPLY CONTACT THE AUTHOR BEFORE RELEASING THEIR CHANGES
  292. TO THE PUBLIC?!
  293.  
  294. 1.2    24 Jun 86  (RAF)
  295.  
  296. Modified to allow assembly of a version which will execute on 8080/8085
  297. CPU's.  (We resisted this initially but have been made to realize that
  298. this is necessary to achieve true acceptance of UNARC by the full CP/M
  299. user community.  Non-Z80 users, particularly RCP/M sysops, still exert
  300. considerable influence in the world of public domain software.  This,
  301. we believe, is out of proportion to their numbers, since almost all
  302. CP/M systems sold in the last five years are Z80-based.  Nevertheless,
  303. we've accommodated the needs of these users by extensive use of macros
  304. which serve to emulate Z80 instructions on non-Z80 machines.)  However,
  305. no attempt has been made to optimize for either size or speed in the
  306. non-Z80 version (which is 1K larger and 50% or more slower than its
  307. Z80-only counterpart).
  308.  
  309. Also:
  310.  
  311. - Implements a "wheel" byte to simplify use and installation on RCP/M's.
  312. - Lines up file types in directory listing.
  313. - Permits processing of "self-unpacking" archives such as the MS-DOS
  314.   ARC51.COM file (anticipates a future scheme for distributing UNARC).
  315. - Attempts to recover from bad archive headers by skipping extra bytes.
  316. - Eliminates archaic "T:" syntax completely for file typeout.
  317.  
  318. 1.1    24 May 86  (RAF)
  319.  
  320. Minor change to allow file typeout without the "T:" syntax (which
  321. didn't work with almost ANY CCP replacement)...  File will be typed if
  322. it:  (1) has no disk drive name, (2) is a single (UNambiguous) file,
  323. and (3) is not an excluded filetype.  (Else, file will simply be listed
  324. with no error message.)  This change was suggested by Irv Hoff's mod to
  325. UNARC10, which he called ADIR.  (Previous "T:" method can still be
  326. enabled, but it is now undocumented since we will probably drop it
  327. altogether in future.)
  328.  
  329. Also shortened on-line help message, so that COM file size is now
  330. reduced to 4K.  (For RCP/M systems, if HODRV = 0 and/or TYFLG = 0, the
  331. help information relating to disk extraction and/or file typeout,
  332. respectively, is automatically removed.)
  333.  
  334. 1.0    03 May 86  (RAF)
  335.  
  336. First public release.  Supports file formats generated by all versions
  337. of MS-DOS ARC through (at least) version 5.12 dated February 7, 1986.
  338.  
  339. 0.0    01 Mar 86  (RAF)
  340.  
  341. I undertook writing this program to satisfy my curiosity about software
  342. developments in the MS-DOS/PC-DOS world.  The ARC "freeware" program
  343. (copyright by System Enhancement Associates) has been around for over a
  344. year now and has achieved enormous popularity in the 16-bit community.
  345. Unfortunately, the lack of a compatible equivalent for CP/M systems
  346. renders a large amount of public domain software inaccessible to 8-bit
  347. users such as myself.  (Note that 16-bit software can indeed be usable
  348. on 8-bit systems, e.g. Pascal and C language programs.)  Also, an
  349. increasing number of RCP/M systems are catering to both 8-bit and
  350. 16-bit users, and it is my hope that UNARC may find a welcome home on
  351. such systems.
  352.  
  353. Note that I was not (initially) a fan of the sequential .ARC file
  354. format, which is less flexible and slower to process (though certainly
  355. more compact) than the random-access format which Novosielski .LBR
  356. libraries have provided for years.  Therefore, I stopped short of
  357. producing a complete ARC program equivalent which includes creation of
  358. .ARC files.  The LZW "crunching" algorithm is impressive though (see my
  359. editorial comments preceeding the UCR routine), and I now believe there
  360. is a place for .ARC files in the CP/M world (particularly on RCP/M's,
  361. where the name of the game is reducing upload/download time).  But
  362. that's the domain of another program (i.e. my next project: NARC).
  363.  
  364.                     - Bob Freed
  365. Credits:
  366.  
  367. Primary credit is due to System Enhancement Associates' ARC author
  368. Thom Henderson for his fine utility program (even if it's not for
  369. CP/M).  Of course without ARC, UNARC would have no reason to exist.
  370. But special thanks are due SEA for making publicly available the C
  371. language source code, without which we could never have begun. |
  372.  
  373.     PAGE
  374.     SUBTTL    Z80/8080 Version Definitions
  375.  
  376.     .Z80            ; Sorry, if you're an Intel fan
  377.     .COMMENT |
  378.  
  379. This source program uses Zilog mnemonics (author's preference) and may
  380. be assembled with the M80 ((C) Microsoft) or Z80ASM ((C) SLR Systems)
  381. macro assemblers.  (Relocatable code features have been avoided, so
  382. conversion to other assembler formats should be straightforward but
  383. may require manual expansion of the macros defined here.)
  384.  
  385. The following macro definitions enable conditional assembly of a
  386. version which will execute on 8080/8085 CPU's.  Our intent is to
  387. provide a non-Z80 version without imposing a limitation on any
  388. Z80-specific capabilities in the source.  (I.e., in specific cases the
  389. chosen emulation of Z80 opcodes does not necessarily produce the
  390. optimal 8080/8085 implementation, in terms of either size or speed.
  391. This approach allows us to offer a non-Z80 version without worrying too
  392. much about its efficiency.) |
  393.  
  394. NO    EQU    0
  395. YES    EQU    NOT NO
  396.  
  397. ; For Z80ASM only, the following may be left undefined to allow
  398. ; interactive definition at assembly time.  For M80 (which does not
  399. ; support the .ACCEPT directive), the leading semicolon must be removed
  400. ; in order to generate the non-Z80 version.
  401.  
  402. ;Z80    EQU    NO        ; YES for Z80 version, NO for 8080/8085
  403.  
  404. IFNDEF Z80            ; If not defined above (and pass 1),
  405.  
  406. N    EQU    NO        ; (Allows short
  407. Y    EQU    YES        ;  responses)
  408.  
  409.     .ACCEPT    Z80        ; Ask user for definition (Z80ASM only)
  410.  
  411. IFNDEF Z80            ; If still not defined (must be M80),
  412. Z80    EQU    YES        ; Generate the Z80 version
  413. ENDIF
  414.  
  415. ENDIF
  416.  
  417.     PAGE
  418. IF Z80
  419.  
  420. ; Macros for Z80 version (to simplify our effort for the 8080 version)
  421.  
  422. EX_AF    MACRO
  423.     EX    AF,AF'
  424. ENDM
  425.  
  426. LD_DE    MACRO    AA
  427.     LD    DE,AA
  428.     ENDM
  429.  
  430. STO_DE    MACRO    AA
  431.     LD    (AA),DE
  432.     ENDM
  433.  
  434. STO_BC    MACRO    AA
  435.     LD    (AA),BC
  436.     ENDM
  437.  
  438. ADC_HL    MACRO    AA
  439.     ADC    HL,AA
  440.     ENDM
  441.  
  442. SBC_HL    MACRO    AA
  443.     SBC    HL,AA
  444.     ENDM
  445.  
  446. LD_IX    MACRO    AA
  447.     LD    IX,AA
  448.     ENDM
  449.  
  450. STO_IX    MACRO    AA
  451.     LD    (AA),IX
  452.     ENDM
  453.  
  454. PUSH_IX    MACRO
  455.     PUSH    IX
  456.     ENDM
  457.  
  458. POP_IX    MACRO
  459.     POP    IX
  460.     ENDM
  461.  
  462. INC_IX    MACRO
  463.     INC    IX
  464.     ENDM
  465.  
  466. ADD_IX    MACRO    AA
  467.     ADD    IX,AA
  468.     ENDM
  469.  
  470. LD_A_IX    MACRO
  471.     LD    A,(IX)
  472.     ENDM
  473.  
  474. ENDIF                ; Z80
  475. IF NOT Z80
  476.  
  477. ; Macros for 8080 version (to emulate Z80-only opcodes)
  478.  
  479. ; Note:  Many of these emulations of Z80 instructions do not correctly
  480. ; implement the setting of the condition flags (e.g. DJNZ should not
  481. ; alter the Z flag).  In all such cases, we have been careful to ensure
  482. ; that an exact emulation is not required anywhere in the code, but
  483. ; extreme vigilance is needed when making future program changes.
  484. ; (Exact emulation is always possible if necessary, so avoid trying to
  485. ; code around the differences:  Our goal should be to always produce the
  486. ; best possible Z80 version!)
  487.  
  488. JR    MACRO    AA,BB
  489. IF NUL BB
  490.     JP    AA
  491. ELSE
  492.     JP    AA,BB
  493. ENDIF
  494.     ENDM
  495.  
  496. DJNZ    MACRO    AA        ; Destroys SF, ZF
  497.     DEC    B
  498.     JP    NZ,AA
  499.     ENDM
  500.  
  501. EX_AF    MACRO
  502.     PUSH    HL
  503.     PUSH    AF
  504.     LD    HL,(AFSAV)
  505.     EX    (SP),HL
  506.     LD    (AFSAV),HL
  507.     POP    AF
  508.     POP    HL
  509.     ENDM
  510.  
  511. EXX    MACRO            ; Long enough to warrant subroutine
  512.     CALL    EXX
  513.     ENDM
  514.  
  515. LD_DE    MACRO    AA
  516.     EX    DE,HL
  517.     LD    HL,AA
  518.     EX    DE,HL
  519.     ENDM
  520.  
  521. STO_DE    MACRO    AA
  522.     EX    DE,HL
  523.     LD    (AA),HL
  524.     EX    DE,HL
  525.     ENDM
  526.  
  527. STO_BC    MACRO    AA
  528.     PUSH    HL
  529.     LD    H,B
  530.     LD    L,C
  531.     LD    (AA),HL
  532.     POP    HL
  533.     ENDM
  534.  
  535. ADC_HL    MACRO    AA
  536.     ADSBHL    AA,ADC
  537.     ENDM
  538.  
  539. SBC_HL    MACRO    AA
  540.     ADSBHL    AA,SBC
  541.     ENDM
  542.  
  543. ADSBHL    MACRO    AA,BB
  544.     PUSH    AF
  545.     LD    A,L
  546. CC    DEFL    NO
  547.     IRPC    DD,AA
  548. IF CC
  549.     BB    A,DD
  550. ENDIF
  551. CC    DEFL    YES
  552.     ENDM
  553.     LD    L,A
  554.     LD    A,H
  555.     IRPC    DD,AA
  556.     BB    A,DD
  557.     EXITM
  558.     ENDM
  559.     LD    H,A
  560.     JP    NZ,$+5        ;; Test both bytes for zero,
  561.     INC    L        ;; without disturbing carry
  562.     DEC    L        ;; (added in UNARC 1.5)
  563.     EX    (SP),HL
  564.     LD    A,H
  565.     POP    HL
  566.     ENDM
  567.  
  568. LD_IX    MACRO    AA
  569.     PUSH    HL
  570.     LD    HL,AA
  571.     LD    (IXSAV),HL
  572.     POP    HL
  573.     ENDM
  574.  
  575. STO_IX    MACRO    AA
  576.     PUSH    HL
  577.     LD    HL,(IXSAV)
  578.     LD    (AA),HL
  579.     POP    HL
  580.     ENDM
  581.  
  582. PUSH_IX    MACRO
  583.     PUSH    HL
  584.     LD    HL,(IXSAV)
  585.     EX    (SP),HL
  586.     ENDM
  587.  
  588. POP_IX    MACRO
  589.     EX    (SP),HL
  590.     LD    (IXSAV),HL
  591.     POP    HL
  592.     ENDM
  593.  
  594. INC_IX    MACRO
  595.     PUSH    HL
  596.     LD    HL,(IXSAV)
  597.     INC    HL
  598.     LD    (IXSAV),HL
  599.     POP    HL
  600.     ENDM
  601.  
  602. ADD_IX    MACRO    AA
  603.     PUSH    HL
  604.     LD    HL,(IXSAV)
  605. IFIDN <AA>,<IX>
  606.     ADD    HL,HL
  607. ELSE
  608.     ADD    HL,AA
  609. ENDIF
  610.     LD    (IXSAV),HL
  611.     POP    HL
  612.     ENDM
  613.  
  614. LD_A_IX    MACRO
  615.     PUSH    HL
  616.     LD    HL,(IXSAV)
  617.     LD    A,(HL)
  618.     POP    HL
  619.     ENDM
  620.  
  621. LDI    MACRO            ; Does not handle P/V
  622.     PUSH    AF
  623.     LD    A,(HL)
  624.     LD    (DE),A
  625.     INC    HL
  626.     INC    DE
  627.     DEC    BC
  628.     POP    AF
  629.     ENDM
  630.  
  631. LDIR    MACRO            ; Destroys CF
  632.     CALL    LDIR
  633.     ENDM
  634.  
  635. CPIR    MACRO            ; Destroys CF, does not handle P/V
  636.     CALL    CPIR
  637.     ENDM
  638.  
  639. RLD    MACRO            ; Not a true RLD, but suffices for us
  640.     LD    A,(HL)
  641.     RLCA
  642.     RLCA
  643.     RLCA
  644.     RLCA
  645.     ENDM
  646.  
  647. SRL    MACRO    AA
  648.     OR    A
  649.     SHIFT    AA,RRA
  650.     ENDM
  651.  
  652. SRA    MACRO    AA
  653.     SHIFT    AA,<RLCA,RRCA,RRA>
  654.     ENDM
  655.  
  656. RR    MACRO    AA
  657.     SHIFT    AA,RRA
  658.     ENDM
  659.  
  660. RRC    MACRO    AA
  661.     SHIFT    AA,RRCA
  662.     ENDM
  663.  
  664. SHIFT    MACRO    AA,BB
  665. IFDIF <AA>,<A>
  666.     PUSH    AF
  667.     LD    A,AA
  668. ENDIF
  669.     IRP    CC,<BB>
  670.     CC
  671.     ENDM
  672.     INC    A        ;; Set flags without
  673.     DEC    A        ;;  changing carry
  674. IFDIF <AA>,<A>
  675.     LD    AA,A
  676.     EX    (SP),HL
  677.     LD    A,H
  678.     POP    HL
  679. ENDIF
  680.     ENDM
  681.  
  682. BIT    MACRO    AA,BB        ; Destroys CF, SF
  683.     PUSH    AF
  684. IFDIF <BB>,<A>
  685.     LD    A,BB
  686. ENDIF
  687.     AND    1 SHL AA
  688. BITMSK    DEFL    $-1        ;; For squashed files (c.f. STRADD)
  689.     EX    (SP),HL
  690.     LD    A,H
  691.     POP    HL
  692.     ENDM
  693.  
  694. SET    MACRO    AA,BB
  695.     SETRES    AA,BB,OR
  696.     ENDM
  697.  
  698. RES    MACRO    AA,BB
  699.     SETRES    AA,BB,<AND NOT>
  700.     ENDM
  701.  
  702. SETRES    MACRO    AA,BB,CC    ; Destroys flags if register A
  703. IFDIF <BB>,<A>
  704.     PUSH    AF
  705.     LD    A,BB
  706. ENDIF
  707.     CC    (1 SHL AA)
  708. IFDIF <BB>,<A>
  709.     LD    BB,A
  710.     POP    AF
  711. ENDIF
  712.     ENDM
  713.  
  714. ENDIF                ; NOT Z80
  715.     PAGE
  716.     SUBTTL    Definitions
  717.  
  718. ; ARC file parameters
  719.  
  720. ARCMARK    EQU    26        ; Archive header marker byte
  721.  
  722. ; Note:    The following three definitions should not be changed lightly.
  723. ;    These are hard-wired into the code at numerous places!
  724.  
  725. ARCVER    EQU    9        ; Max. header vers. supported for output
  726. CRBITS    EQU    12        ; Max. bits in crunched file input codes
  727. CQBITS    EQU    13        ; Max. bits in squashed file input codes
  728.  
  729. ; CP/M system equates
  730.  
  731. BOOT    EQU    0000H        ; Base of system page / warm boot return
  732. BDOS    EQU    BOOT+005H    ; BDOS entry
  733. MEMTOP    EQU    BDOS+1        ; Contains base of BDOS / top of TPA
  734. DFCB    EQU    BOOT+05CH    ; Command line tail default FCB
  735. SFCB    EQU    BOOT+06CH    ; Command line tail secondary FCB
  736. DBUF    EQU    BOOT+080H    ; Default DMA buffer
  737. TBASE    EQU    BOOT+100H    ; Base of TPA
  738.  
  739. ; BDOS function codes
  740.  
  741. $CONIN    EQU    1        ; Console input
  742. $CONOUT    EQU    2        ; Console output
  743. $LIST    EQU    5        ; Listing output
  744. $PRTSTR    EQU    9        ; Print (console) string
  745. $CONST    EQU    11        ; Get console status
  746. $VERSN    EQU    12        ; Get CP/M version no.
  747. $SELECT    EQU    14        ; Select disk
  748. $OPEN    EQU    15        ; Open file
  749. $CLOSE    EQU    16        ; Close file
  750. $FIND    EQU    17        ; Find file
  751. $DELETE    EQU    19        ; Delete file
  752. $READ    EQU    20        ; Read sequential record
  753. $WRITE    EQU    21        ; Write sequential record
  754. $MAKE    EQU    22        ; Make file
  755. $DISK    EQU    25        ; Get current disk
  756. $SETDMA    EQU    26        ; Set DMA address
  757. $GETDPB    EQU    31        ; Get disk parameter block address
  758. $READR    EQU    33        ; Read random record
  759. $RECORD    EQU    36        ; Set random record no.
  760.  
  761. ; FCB offsets
  762.  
  763. @DR    EQU    0        ; Drive code
  764. @FN    EQU    1        ; File name
  765. @FT    EQU    9        ; File type
  766. @CR    EQU    32        ; Current record
  767. @RN    EQU    33        ; Random record no. (optional)
  768. @FCBSZ    EQU    33        ; FCB size for sequential I/O
  769. @FCBSX    EQU    @FCBSZ+3    ; Extended FCB size for random I/O
  770.  
  771.     PAGE
  772. ; ASCII control codes
  773.  
  774. CTLC    EQU    'C'-'@'        ; Control-C (console abort)
  775. CTLK    EQU    'K'-'@'        ; Control-K (alternate abort)
  776. BEL    EQU    'G'-'@'        ; Bell
  777. HT    EQU    'I'-'@'        ; Horizontal tab
  778. LF    EQU    'J'-'@'        ; Line feed
  779. CR    EQU    'M'-'@'        ; Carriage return
  780. CTLS    EQU    'S'-'@'        ; Control-S (suspend output)
  781. CTLZ    EQU    'Z'-'@'        ; Control-Z (CP/M end-of-file)
  782. DEL    EQU    7FH        ; Delete/rubout
  783. REP    EQU    'P'-'@'+80H    ; Repeated byte flag (DLE with msb set)
  784.  
  785.     PAGE
  786.     SUBTTL    Patchable Options
  787.  
  788. ; Useful options here at start of file to simplify patching
  789.  
  790.     ASEG            ; This simplifies page alignment at end
  791.     ORG    TBASE        ; .COM file starts here
  792.  
  793.     JP    BEGIN        ; Skip over this stuff on program entry
  794.  
  795. ; The default values of all of these options are suitable for standard
  796. ; CP/M 2.2 systems.  In each case an alternate setting is illustrated,
  797. ; but these are primarily of interest to RCP/M sysops or users with
  798. ; non-standard (or very small) systems.  Options followed by ";*" are
  799. ; automatically affected by the wheel byte setting (see below).
  800.  
  801. CCPSV:    DB    8        ; No. high memory pages to save (8 = 2K)
  802. ;CCPSV:    DB    0        ; This to clobber CCP and force reboot
  803.  
  804. ;BLKSZ:    DB    1        ; Default disk allocation block size (K)
  805. BLKSZ:    DB    0        ;*This to use default drive's block size
  806.                 ;  for listing, when no output drive
  807.  
  808. HIDRV:    DB    'P'-'@'        ; Highest input file drive (A=1,B=2,...)
  809. ;HIDRV:    DB    0        ; This restricts input to default drive
  810.  
  811. HODRV:    DB    'P'-'@'        ;*Highest output file drive no.
  812. ;HODRV:    DB    0        ; RCP/M's use this for no disk output
  813.                 ;  (if no wheel byte implemented)
  814.  
  815. ; Note:    As of UNARC 1.2, the following byte serves only as a flag.
  816. ;    I.e., it no longer defines a pseudo typeout "drive".
  817.  
  818. TYFLG:    DB    0FFH        ; This enables single file typeout
  819. ;TYFLG:    DB    0        ;*RCP/M's use this for no file typeout
  820.  
  821. TYPGS:    DB    0        ;*No. buffer pages for typeout (0=max)
  822. ;TYPGS:    DB    1        ; This minimizes viewing waits, but may
  823.                 ;  cause excess floppy motor stop/start
  824.  
  825. TYLIM:    DB    0        ; No line limit for file typeout
  826. ;TYLIM:    DB    80        ;*RCP/M's may prefer non-zero line limit
  827.  
  828. ; Following added in UNARC 1.2 to simplify use by RCP/M sysops.  If byte
  829. ; addressed by WHEEL is zero, no file output allowed (as if HODRV = 0).
  830. ; Also BLKSZ and/or TYPGS are assumed = 1, if these are zero by default.
  831. ; If byte addressed by WHEEL is non-zero (indicates a privileged user),
  832. ; TYFLG and TYLIM are not enforced (unlimited typeout allowed).  The
  833. ; default wheel byte address defined here (HODRV) provides compatibility
  834. ; with previous releases of UNARC for systems which do not implement a
  835. ; wheel byte.  (ZCPR3 users should set this word to the address of their
  836. ; Z3WHL byte, as determined by running SHOW.COM.)
  837.  
  838. WHEEL:    DW    HODRV        ; Address of "wheel" byte (this if none)
  839. ;WHEEL:    DW    BOOT+03EH    ; E.g. if wheel byte stored in base page
  840.  
  841.     PAGE
  842. ; Following added in UNARC 1.4:
  843.  
  844. TYLPS:    DB    23        ; No. lines between typeout pauses
  845. ;TYLPS:    DB    0        ; Forces continuous typeout always
  846.  
  847. DBLSZ:    DB    0        ; Use DPB for disk allocation block size
  848. ;DBLSZ:    DB    1        ; Assumed block size (K) if BDOS 31 call
  849.                 ;  not supported (e.g. CP/M-68K)
  850.  
  851. BELLS:    DB    0FFH        ; Allow bells in warning/error messages
  852. ;BELLS:    DB    0        ; This for solitude
  853.  
  854. ; Table of file types which are disallowed for typeout
  855.  
  856. NOTYP:    DB    'COM'        ; CP/M-80 or MS-DOS binary object
  857.     DB    'CM','D'+80H    ; CP/M-86 binary object (or dBASE file)
  858.     DB    'EXE'        ; MS-DOS executable
  859.     DB    'OBJ'        ; Renamed COM
  860.     DB    'OV?'        ; Binary overlay
  861.     DB    'REL'        ; Relocatable object
  862.     DB    '?RL'        ; Other relocatables (PRL, CRL, etc.)
  863.     DB    'INT'        ; Intermediate compiler code
  864.     DB    'SYS'        ; System file
  865.     DB    'BAD'        ; Bad disk block
  866.     DB    'LBR'        ; Library
  867.     DB    'ARC'        ; Archive (unlikely in an ARC)
  868.     DB    'ARK'        ; Alternate archive (ditto)
  869.     DB    '?Q?'        ; Any SQueezed file (ditto)
  870.     DB    '?Z?'        ; Any CRUNCHed (or ZOO'd) file (ditto)
  871.  
  872. ; Note:    Additional types may be added below.  To remove one of the above
  873. ;    types without replacing it, simply set the msb in any byte (as
  874. ;    shown above for .CMD, since that can be a readable dBASE command
  875. ;    file).
  876.  
  877.     REPT    5        ; Room for more types (20 total)
  878.     DB    0,0,0
  879.     ENDM
  880.  
  881.     DB    0        ; End of table
  882.  
  883.     PAGE
  884.     SUBTTL    Program Usage
  885.  
  886. ; Following displays if no command line parameters
  887. ; (Also on attempts to type the .COM file)
  888.  
  889. ; Note:    All program name output is obtained from the first chars of the
  890. ;    usage message below (up to and including the first blank), and
  891. ;    is generated by a byte value 1 in any typeout string.
  892.  
  893. USAGE:    IDENT            ; Program version identification first
  894.  
  895.     DB    CR,LF
  896.     DB    'CP/M Archive File Extractor'
  897. IF NOT Z80
  898. USEA:    DB    ' (8080 Version)'
  899. ENDIF
  900.     DB    CR,LF,LF,'Usage:  ',1,'[d:]arcfile[.typ] '
  901.  
  902. USE1:    DB    '[d:]'
  903. USE1L    EQU    $-USE1        ; Above cleared if HODRV=0 or non-wheel
  904.  
  905.     DB    '[afn] [N'
  906.  
  907. USE4:    DB    '|P|C'
  908. USE4L    EQU    $-USE4        ; Above cleared if non-wheel
  909.  
  910.     DB    ']',CR,LF,LF
  911.     DB    'Examples:',CR,LF
  912.     DB    'B>',1,'A:SAVE.ARK *.*  '
  913.     DB    '; List all files in CP/M archive SAVE on drive A',CR,LF
  914.     DB    'B>',1,'A:SAVE.ARC *.*  '
  915.     DB    '; List all files in MS-DOS archive SAVE on drive A',CR,LF
  916.     DB    'A>',1,'SAVE            '
  917.     DB    '; Same as either of above',CR,LF
  918.     DB    'A>',1,'SAVE *.* N      '
  919.     DB    '; Same as above (no screen pauses)',CR,LF
  920.     DB    'A>',1,'SAVE *.DOC      '
  921.     DB    '; List just .DOC files',CR,LF
  922.  
  923. USE2:    DB    'A>',1,'SAVE READ.ME    '
  924.     DB    '; Typeout the file READ.ME',CR,LF
  925.     DB    'A>',1,'SAVE READ.ME N  '
  926.     DB    '; Typeout the file READ.ME (no screen pauses)',CR,LF
  927. USE2L    EQU    $-USE2        ; Above cleared if TYFLG=0 and non-wheel
  928.  
  929. USE3:    DB    'A>',1,'SAVE A:         '
  930.     DB    '; Extract all files to drive A',CR,LF
  931.     DB    'A>',1,'SAVE B:*.DOC    '
  932.     DB    '; Extract .DOC files to drive B',CR,LF
  933.     DB    'A>',1,'SAVE C:READ.ME  '
  934.     DB    '; Extract file READ.ME to drive C',CR,LF
  935. USE3L    EQU    $-USE3        ; Above cleared if HODRV=0 or non-wheel
  936.  
  937. USE5:    DB    'A>',1,'SAVE PRN.DAT P  '
  938.     DB    '; Print the file PRN.DAT (no formatting)',CR,LF
  939.     DB    'A>',1,'SAVE *.* C      '
  940.     DB    '; Check validity of all files in archive'
  941. USEC:    DB    CR,LF
  942. USE5L    EQU    $-USE5        ; Above cleared if non-wheel
  943.  
  944.     DB    LF
  945.     COPR            ; Copyright notice last
  946.  
  947. ; (We'd like to be unobtrusive, but please don't remove or patch out)
  948.  
  949. USEB:    DB    0        ; End of message marker
  950.     DB    CTLZ        ; Stop attempted .COM file typeout here
  951.  
  952.     PAGE
  953.     SUBTTL    Beginnings and Endings
  954.  
  955. IF NOT Z80
  956. ; Special entry for self-unpacking archive (non-Z80 version only)
  957.  
  958. ; Note:    This works because the initial file (UNARCA.COM) in a self-
  959. ;    unpacking archive is offset 26 bytes in memory (due to the
  960. ;    initial JP opcode plus 25-byte version 1 header).  I.e., the
  961. ;    first three bytes of such a file are 0C3H, 1AH, 01H = JP 11AH.
  962. ;    Location 11AH contains the instruction normally found at the
  963. ;    base address (100H) of UNARCA.COM, i.e. JP BEGIN.  But because
  964. ;    of the offset, that will jump here instead of to BEGIN.
  965.  
  966.     JP    SELFUP        ; Go setup for self-unpacking
  967.     REPT    5        ; Pad out for 26-byte offset...
  968.     DB    0,0,0,0
  969.     ENDM
  970.     JP    BOOT        ; (Should never reach this!)
  971. ENDIF
  972.  
  973. ; Program begins
  974.  
  975. ; Note:    The program is self-initializing.  Once loaded, it may be
  976. ;    re-executed multiple times (e.g. by a zero-length COM file,
  977. ;    or the ZCPR GO command).
  978.  
  979. BEGIN:
  980. ;;;    XOR    A        ; \ This sets Z80 P/V = 0 (no overflow),
  981. ;;;    DEC    A        ; /  or 8080/8085 P/V = 1 (even parity)
  982.     SUB    A        ; (More elegant, saves a byte: v1.4)
  983.     LD    C,$PRTSTR    ; Setup to print message by BDOS
  984. IF Z80
  985.     LD    DE,NOTZ80    ; Must be a Z80, or forget all else
  986.     JP    PE,BDOS        ; If not, just print message and abort
  987.     LD    (SPSAV),SP    ; Save CCP stack (better be a Z80 now!)
  988. ELSE
  989.     LD    DE,USEZ80    ; Should be an 8080/8085
  990.     CALL    PO,BDOS        ; If not, tell user about Z80 version
  991.  
  992. BEGIN1:    LD    HL,0        ; Entry after self-unpacking relocation
  993.     ADD    HL,SP        ; Save CCP stack (8080 or Z80)
  994.     LD    (SPSAV),HL
  995. ENDIF
  996.     CALL    CHECK        ; Check if we can proceed
  997.     LD    SP,STACK    ; Now setup local stack
  998.     LD    HL,TOTS        ; Zero all listing totals
  999.     LD    BC,TOTC*256+0
  1000.     CALL    FILL
  1001.     CALL    INIT        ; Process command line, open ARC file
  1002.     CALL    OUTSET        ; Check output drive, setup for output
  1003.  
  1004. ; Find first archive header
  1005.  
  1006. ; Note:    As of UNARC 1.2, up to three additional bytes are tolerated
  1007. ;    before first header mark, with no error or warning messages
  1008. ;    (for "self-unpacking" archives).
  1009.  
  1010.     LD    HL,3        ; Assume will skip at least 3 bytes
  1011.     LD    B,L        ; Setup count of allowed extra bytes
  1012.  
  1013. FIRST:    CALL    GET        ; Get next byte
  1014.     CP    ARCMARK        ; Is it header marker?
  1015.     JR    Z,NEXT        ; Yes, skip
  1016.     DJNZ    FIRST        ; Else loop for no. allowed extras
  1017.  
  1018.     PAGE
  1019. ; File processing loop
  1020.  
  1021. LOOP:    CALL    GET        ; Get next byte
  1022.     CP    ARCMARK        ; Is it archive header marker?
  1023.     JR    NZ,BAD        ; No, it's a bad header
  1024.  
  1025. ; Process next file
  1026.  
  1027. NEXT:    CALL    GET        ; Get header version
  1028.     OR    A        ; If zero, that's logical end of file,
  1029.     JR    Z,DONE        ;  and we're done
  1030.  
  1031. NEXT1:    CALL    GETHDR        ; Read archive header
  1032.     CALL    GETNAM        ; Does file name match test pattern?
  1033.     JR    NZ,SKIP        ; No, skip this file
  1034.  
  1035.     CALL    LIST        ; List file info
  1036.     CALL    OUTPUT        ; Output the file (possibly)
  1037.     CALL    TAMBIG        ; Ambiguous output file selection?
  1038.     JR    NZ,EXIT        ; No, quit early
  1039.  
  1040. ; Skip to next file
  1041.  
  1042. SKIP:    LD    HL,SIZE        ; Get two-word remaining file size
  1043.     CALL    LGET        ; (will be 0 if output was completed)
  1044.     CALL    SEEK        ; Seek past it
  1045.     LD    HL,0        ; Reinit count of bytes skipped
  1046.     JR    LOOP        ; Loop for next file
  1047.  
  1048. ; Done with all files
  1049.  
  1050. DONE:    LD    HL,(TFILES)    ; Get no. files processed
  1051.     LD    A,H
  1052.     OR    A
  1053.     JR    NZ,DONE1    ; Skip if many
  1054.  
  1055.     OR    L        ; No files found?
  1056.     LD    DE,NOFILS    ; Yes, setup error message
  1057.     JR    Z,PABORT    ;  and abort
  1058.  
  1059.     DEC    A        ; Test if just one file
  1060.  
  1061. DONE1:    CALL    NZ,LISTT    ; If more than one, list totals
  1062.  
  1063. ; Exit program
  1064.  
  1065. EXIT:    CALL    ICLOSE        ; Close input and output files (if open)
  1066.     LD    A,(CCPSV)    ; Possibly overlaid CCP?
  1067.     OR    A
  1068.     JP    Z,BOOT        ; Yes, reboot CP/M
  1069.  
  1070.     LD    SP,0        ; Restore CCP stack
  1071. SPSAV    EQU    $-2        ; (Original stack ptr saved here)
  1072.     RET            ; Return to CCP
  1073.  
  1074.     PAGE
  1075. ; Bad archive file header
  1076.  
  1077. ; Note:    This added in UNARC 1.2 (mostly compatible with MS-DOS ARC
  1078. ;    5.12) and modified somewhat in UNARC 1.4.  It's a bit kludgy
  1079. ;    now, but it does permit processing of Phil Katz' self-unpacking
  1080. ;    archive, PKX32A11.COM (with a warning message), as well as
  1081. ;    SEA's ARC51.COM (with no warning).  (Although success with
  1082. ;    PKX32A11 hinges on the fact that no ARCMARK's are followed
  1083. ;    by valid non-zero versions in that file, which is probably
  1084. ;    coincidental.)
  1085.  
  1086. BAD:    CALL    BADCNT        ; Count bad header byte
  1087.     CALL    GET        ; Read byte (unless end of file abort)
  1088.  
  1089. BAD1:    CP    ARCMARK        ; Found a header marker?
  1090.     JR    NZ,BAD        ; No, repeat attempt to re-synchronize
  1091.  
  1092.     CALL    GET        ; Ok, found another (possible) header
  1093.     PUSH    AF        ; Save header version
  1094.     DEC    A        ; But ignore archive eof here
  1095.     CP    ARCVER        ; Is it a valid version?
  1096.     JR    NC,BAD2        ; No, skip
  1097.  
  1098.     EX    DE,HL        ; Get count of bytes skipped
  1099.     LD    HL,HDRSKP    ; Store in message
  1100.     LD    BC,0
  1101.     CALL    WTOD
  1102.     LD    (HL),0
  1103.     LD    DE,HDRERR    ; Print warning message
  1104.     CALL    PRINTX
  1105.     POP    AF        ; Recover version
  1106.     JR    NEXT1        ; Go process (assumed valid) next file
  1107.  
  1108. BAD2:    CALL    BADCNT        ; Count bad header byte (1st of 2 seen)
  1109.     POP    AF        ; Restore vesion
  1110.     JR    BAD1        ; Go check if 2 consecutive header marks
  1111.  
  1112.     PAGE
  1113. ; Preliminary checks
  1114.  
  1115. ; Note:    Following is called before local stack is setup.  Primary
  1116. ;    caution    here is that PRINT (called by PABORT and PEXIT) uses no
  1117. ;    more than 5 stack levels.  (Assumes program called from CCP with
  1118. ;    7 stack levels available, and that at most one of these must be
  1119. ;    reserved for interrupts.)
  1120.  
  1121. CHECK:    XOR    A        ; Clear flags in case early abort:
  1122.     LD    (IFLAG),A    ;  Input file open flag
  1123.     LD    (OFLAG),A    ;  Output file open flag
  1124.     LD    (LPS),A        ; Prevent any screen pauses yet
  1125.  
  1126.     LD    C,$VERSN    ; Must be CP/M 2.0 or above, since we
  1127.     CALL    BDOS        ;  use random disk reads
  1128.     CP    20H
  1129.     LD    DE,CPMERR    ; (With a bit of work, this limitation
  1130.     JR    C,EABORT    ;  could be eliminated in future)
  1131.  
  1132.     LD    A,(MEMTOP+1)    ; Get base page of BDOS
  1133.     LD    HL,CCPSV    ; Subtract no. pages reserved for CCP
  1134.     SUB    (HL)        ;  (if any)
  1135.     LD    (HIPAGE),A    ; Save highest usable page (+1)
  1136.     LD    A,HIGH MINMEM    ; Ensure enough memory to do anything
  1137.  
  1138. ; Check for enough memory
  1139.  
  1140. CKMEM:    CP    0        ; Page address to check in A
  1141. HIPAGE    EQU    $-1        ; Must be lower than this
  1142.     RET    C        ; Return if ok
  1143.  
  1144.     LD    DE,NOROOM    ; Else, abort due to no room
  1145.  
  1146. ; Early abort during preliminary checks
  1147.  
  1148. EABORT:    POP    HL        ; Reclaim stack level for extra safety
  1149.  
  1150. ; Print error message and abort
  1151.  
  1152. PABORT:    CALL    PRINT
  1153.  
  1154. ; Abort program
  1155.  
  1156. ABORT:    LD    DE,ABOMSG    ; Print general abort message
  1157.  
  1158. ; Print message and exit
  1159.  
  1160. ; Note:    We call PRINT+CRLF, instead of PRINTX, to save a stack level
  1161.  
  1162. PEXIT:    CALL    PRINT
  1163.     CALL    CRLF
  1164.     JR    EXIT
  1165.  
  1166.     PAGE
  1167. ; Validate command line parameters and open input file
  1168.  
  1169. INIT:    LD    HL,DBUF        ; Point to command line buffer
  1170.     LD    E,(HL)        ; Fetch its length
  1171.     LD    D,0
  1172.     ADD    HL,DE        ; Point to the last byte
  1173.     DEC    HL        ; Point to second-to-last char
  1174.     LD    A,(HL)        ; Is it a blank?
  1175.     CP    ' '
  1176.     JR    NZ,INIT1    ; No, skip (no option)
  1177.  
  1178.     INC    HL        ; Point to option letter
  1179.     LD    A,(HL)        ; Is it 'N' ?
  1180.     CP    'N'
  1181.     JR    Z,INIT2        ; Yes, skip (no paging)
  1182.  
  1183.     CP    'P'        ; Is it 'P' ?
  1184.     JR    NZ,INIT0
  1185.     LD    (PROUTF),A    ; Yes, set printer output flag
  1186.  
  1187. INIT0:    CP    'C'        ; Is it 'C' ?
  1188.     JR    NZ,INIT1    ; No, go enstate paging limit
  1189.     LD    (CHECKF),A    ; Yes, set check archive flag
  1190.  
  1191. INIT1:    LD    A,(TYLPS)    ; Fetch default lines between pauses
  1192.     LD    (LPS),A        ; Set lines per screen (enables pauses)
  1193.     LD    (LPSCT),A    ; Init count of lines until next pause
  1194.  
  1195. INIT2:    LD    A,' '        ; Setup blank for (several) tests
  1196.     LD    HL,SFCB        ; Point to second parameter FCB
  1197.     LD    DE,OFCB        ; Point to file output FCB
  1198.     LDI            ; Save output drive, point to file name
  1199.     LD    DE,TNAME    ; Set to save test pattern
  1200.     LD    BC,11        ; Setup count for file name and type
  1201.     CP    (HL)        ; Output file name specified?
  1202.     JR    NZ,INIT3    ; Yes, go move it
  1203.  
  1204.     LD    H,D        ; No, default to "*.*"
  1205.     LD    L,E
  1206.     LD    (HL),'?'    ; (I.e. all "?" chars)
  1207.     INC    DE
  1208.     DEC    BC
  1209.  
  1210. INIT3:    LDIR            ; Save test name pattern
  1211.     LD    HL,IFCB+@FT    ; Point to ARC file type
  1212.     CP    (HL)        ; Omitted?
  1213.     JR    NZ,INIT4    ; Skip if not
  1214.  
  1215.     LD    (HL),'A'    ; Yes, set default file type (.ARK)
  1216.     INC    HL
  1217.     LD    (HL),'R'
  1218.     INC    HL
  1219.     LD    (HL),'K'
  1220.     LD    (ARKFLG),A    ; Set flag for alternate (.ARC) next
  1221.  
  1222. INIT4:    LD    HL,IFCB+@FN    ; Any ARC file name?
  1223.     CP    (HL)
  1224.     JR    Z,HELP        ; No, go show on-line help
  1225.  
  1226.     PUSH    HL        ; Save name ptr for message generation
  1227.     CALL    FAMBIG        ; Ambiguous ARC file name?
  1228.     LD    DE,NAMERR    ; Yes, report error
  1229. INIT5:    JR    Z,PABORT    ;  and abort
  1230.  
  1231.     POP    DE        ; Recover ptr to FCB name
  1232.     LD    HL,ARCNAM    ; Unparse name for message
  1233.     LD    C,' '        ; (with no blanks)
  1234.     CALL    LNAME
  1235.     XOR    A        ; Cleanup end of message string
  1236.     LD    (HL),A
  1237.  
  1238.     DEC    A        ; Set to read a new record next
  1239.     LD    (GETPTR),A    ; (initializes GET)
  1240.  
  1241.     LD    HL,IFCB        ; Point to ARC file FCB
  1242.     LD    A,(HIDRV)    ; Get highest allowed drive no.
  1243.     CP    (HL)        ; Is ARC file drive in range?
  1244.     LD    DE,BADIDR    ; No, report bad input drive
  1245.     JP    C,PABORT    ;  and abort
  1246.  
  1247. ; Open archive file
  1248.  
  1249.     EX    DE,HL        ; Recover FCB address
  1250.     LD    C,$OPEN        ; Open ARC file
  1251.     CALL    FDOS        ; File found?
  1252.     JR    NZ,INIT6    ; Yes, skip
  1253.  
  1254.     LD    HL,ARKFLG    ; No, but can we retry with alternate
  1255.     OR    (HL)        ;  default file type?
  1256.     LD    DE,OPNERR    ; No, report error
  1257.     JR    Z,INIT5        ;  and abort (via branch aid)
  1258.  
  1259.     LD    (HL),0        ; Clear retry flag for next time
  1260.     LD    HL,IFCB+@FT+2    ; Point to last char of file type
  1261.     LD    (HL),'C'    ; Change from .ARK to .ARC
  1262.     JR    INIT4        ; Go attempt open one more time
  1263.  
  1264. INIT6:    LD    (IFLAG),A    ; Set input file open flag
  1265.     LD    DE,ARCMSG    ; Show ARC file name
  1266.     CALL    PRINTX
  1267.  
  1268.     LD    A,(BLKSZ)    ; Get default disk block size
  1269.     OR    A        ; Explicit default?
  1270.     CALL    Z,WHLCK        ; Or non-wheel if none? (i.e. forces 1K)
  1271.     JR    NZ,SAVBLS    ; Yes, skip
  1272.  
  1273. ; Get current disk's allocation block size for listing
  1274.  
  1275. GETBLS:    LD    A,(DBLSZ)    ; Any default disk block size?
  1276.     OR    A        ; (e.g. if $GETDPB not supported)
  1277.     JR    NZ,SAVBLS    ; Yes, bypass the $GETDPB call
  1278.  
  1279.     LD    C,$GETDPB    ; Get DPB address
  1280.     CALL    BDOS
  1281.     INC    HL        ; Point to block mask
  1282.     INC    HL
  1283.     INC    HL
  1284.     LD    A,(HL)        ; Fetch block mask
  1285.     INC    A        ; Compute block size / 1K bytes
  1286.     RRCA
  1287.     RRCA
  1288.     RRCA
  1289.  
  1290. SAVBLS:    LD    (LBLKSZ),A    ; Save block size for listing
  1291.     RET            ; Return
  1292.  
  1293. ; Display program usage help message
  1294.  
  1295. HELP:    CALL    WHLCK        ; Check wheel byte
  1296.     PUSH    AF        ; Save it
  1297.     DEC    A        ; Privileged user?
  1298.     JR    Z,HELP1        ; No, skip (extraction never allowed)
  1299.  
  1300.     LD    A,(HODRV)    ; File extraction allowed?
  1301.     OR    A
  1302.  
  1303. HELP1:    LD    HL,USE1        ; Setup to clear out usage examples
  1304.     LD    BC,256*USE1L+80H
  1305.     CALL    Z,FILL        ; Do it if not allowed
  1306.     LD    HL,USE3
  1307.     LD    B,USE3L
  1308.     CALL    Z,FILL        ; (Two places)
  1309.     POP    AF        ; Was wheel byte set?
  1310.     JR    Z,HELP2        ; Yes, skip (typeout etc always allowed)
  1311.  
  1312.     LD    HL,USE4        ; Clear out print/check option examples
  1313.     LD    B,USE4L
  1314.     CALL    FILL
  1315.     LD    HL,USE5        ; (Two places)
  1316.     LD    B,USE5L
  1317.     CALL    FILL
  1318.  
  1319.     LD    A,(TYFLG)    ; File typeout allowed?
  1320.     OR    A
  1321.     LD    HL,USE2
  1322.     LD    B,USE2L
  1323.     CALL    Z,FILL        ; No, clear out usage example
  1324.  
  1325. HELP2:    LD    DE,USAGE    ; Just print usage message
  1326.     JP    PEXIT        ;  and exit
  1327.  
  1328. ; Check wheel byte
  1329.  
  1330. WHLCK:    PUSH    HL        ; Save register
  1331.     LD    HL,(WHEEL)    ; Get wheel byte address
  1332.     LD    A,(HL)        ; Fetch wheel byte
  1333.     POP    HL        ; Restore reg
  1334.     OR    A        ; Check wheel byte
  1335.     JR    NZ,WHLCK1
  1336.  
  1337.     INC    A        ; If zero, user is not privileged
  1338.     RET            ; Return A=1 (NZ)
  1339.  
  1340. WHLCK1:    XOR    A        ; If non-zero, he's a big wheel
  1341.     RET            ; Return A=0 (Z)
  1342.  
  1343.     PAGE
  1344. ; Close input and output files (called at program exit)
  1345.  
  1346. ICLOSE:    LD    DE,IFCB        ; Setup ARC file FCB
  1347.     LD    A,0        ; Get input open flag
  1348. IFLAG    EQU    $-1        ; (stored here)
  1349.     CALL    CLOSE        ; Close input file first (e.g. for MP/M)
  1350.  
  1351. ; Close output file
  1352.  
  1353. OCLOSE:    LD    DE,OFCB        ; Setup output file FCB
  1354.     LD    A,0        ; Get output open flag
  1355. OFLAG    EQU    $-1        ; (stored here)
  1356.  
  1357. ; Close a file if open
  1358.  
  1359. CLOSE:    OR    A        ; File is open?
  1360.     LD    C,$CLOSE    ; Yes, close it
  1361.     CALL    NZ,BDOS
  1362.     INC    A        ; Check return code
  1363.     RET            ; Return to caller (Z set if error)
  1364.  
  1365. ; BDOS file functions for output file
  1366.  
  1367. OFDOS:    LD    DE,OFCB        ; Setup output file FCB
  1368.  
  1369. ; BDOS file functions
  1370.  
  1371. FDOS:    CALL    BDOS        ; Perform function
  1372.     INC    A        ; Test directory code
  1373.     RET            ; Return (Z set if file not found)
  1374.  
  1375. ; Set DMA address for file input/output
  1376.  
  1377. SETDMA:    LD    C,$SETDMA    ; DMA address in DE
  1378.     CALL    BDOS        ; This is always a good place to...
  1379.  
  1380. ; Check for CTRL-C abort (and/or read console char if any)
  1381.  
  1382. CABORT:    LD    C,$CONST    ; Get console status
  1383.     CALL    BDOS
  1384.     OR    A        ; Character ready?
  1385.     RET    Z        ; Return (Z set) if not
  1386.  
  1387.     LD    C,$CONIN    ; Input console char (echo if printable)
  1388.     CALL    BDOS
  1389.  
  1390. ; Note:    Following added in UNARC 1.5 to handle any ^S input which is not
  1391. ;    detected by CP/M 2.2 BDOS.
  1392.  
  1393.     AND    7FH        ; Mask to 7 bits
  1394.     CP    CTLS        ; Is it CTRL-S (suspend output)?
  1395.     LD    C,$CONIN
  1396.     CALL    Z,BDOS        ; Yes, wait for another char
  1397.     AND    7FH        ; Mask to 7 bits
  1398.  
  1399.     CP    CTLC        ; Is it CTRL-C?
  1400.     JR    Z,GABORT    ; Yes, go abort
  1401.  
  1402.     CP    CTLK        ; Or is it CTRL-K (RCP/M alternate ^C)?
  1403.     RET    NZ        ; No, return char (and NZ) to caller
  1404.  
  1405. GABORT:    JP    ABORT        ; Go abort program
  1406.  
  1407.     PAGE
  1408.     SUBTTL    Archive File Input Routines
  1409.  
  1410. ; Get counted byte from archive subfile (saves alternate register set)
  1411.  
  1412. ; The alternate register set normally contains values for the low-level
  1413. ; output routines (see PUTSET).  This entry to GETC saves these and
  1414. ; returns with them enstated (for PUT, PUTUP, etc.).  Caller must issue
  1415. ; EXX after call to return these to the alternate set, and must save and
  1416. ; restore any needed values from the original register set.
  1417.  
  1418. ; Note:    At first glance, all this might seem unnecessary, since BDOS
  1419. ;    (might be called by GETREC) does not use the Z80 alternate
  1420. ;    register set (at least with Digital Research CP/M).  But some
  1421. ;    CBIOS implementations (e.g. Osborne's) assume these are fair
  1422. ;    game, so we are extra cautious here.
  1423.  
  1424. GETCX:    EXX            ; Swap in alt regs (GETC saves them)
  1425.  
  1426. ; Get counted byte from component file of archive
  1427.  
  1428. ; GETC returns with carry set (and a zero byte) upon reaching the
  1429. ; logical end of the current subfile.  (This relies on the GET routine
  1430. ; NOT returning with carry set.)
  1431.  
  1432. GETC:    PUSH    BC        ; Save registers
  1433.     PUSH    DE
  1434.     PUSH    HL
  1435.     LD    HL,SIZE        ; Point to remaining bytes in subfile
  1436.     LD    B,4        ; Setup for long (4-byte) size
  1437.  
  1438. GETC1:    LD    A,(HL)        ; Get size
  1439.     DEC    (HL)        ; Count it down
  1440.     OR    A        ; But was it zero? (clears carry)
  1441.     JR    NZ,GET1        ; No, go get byte (must not set carry!)
  1442.  
  1443.     INC    HL        ; Point to next byte of size
  1444.     DJNZ    GETC1        ; Loop for multi-precision decrement
  1445.  
  1446.     LD    B,4        ; Size was zero, now it's -1
  1447.  
  1448. GETC2:    DEC    HL        ; Reset size to zero...
  1449.     LD    (HL),A        ; (SIZE must contain valid bytes to skip
  1450.     DJNZ    GETC2        ;  to get to next subfile in archive)
  1451.  
  1452.     SCF            ; Set carry to indicate end of subfile
  1453.     JR    GET2        ; Go restore registers and return zero
  1454.  
  1455.     PAGE
  1456. ; Get next sequential byte from archive file
  1457.  
  1458. ; Note:    GET and SEEK rely on the fact that the default DMA buffer
  1459. ;    used for file input (DBUF) begins on a half-page boundary.
  1460. ;    I.e. DBUF address = nn80H (nn = 00 for standard CP/M).
  1461.  
  1462. GET:    PUSH    BC        ; Save registers
  1463.     PUSH    DE
  1464.     PUSH    HL
  1465.  
  1466. GET1:    LD    HL,(GETPTR)    ; Point to last byte read
  1467.     INC    L        ; At end of buffer?
  1468.     CALL    Z,GETNXT    ; Yes, read next record and reset ptr
  1469.     LD    (GETPTR),HL    ; Save new buffer ptr
  1470.     LD    A,(HL)        ; Fetch byte from there
  1471.  
  1472. GET2:    POP    HL        ; Restore registers
  1473.     POP    DE
  1474.     POP    BC
  1475.     RET            ; Return
  1476.  
  1477. ; Get next sequential record from archive file
  1478.  
  1479. GETNXT:    LD    C,$READ        ; Setup read-sequential function code
  1480.  
  1481. ; Get record (sequential or random) from archive file
  1482.  
  1483. GETREC:    LD    DE,DBUF        ; Point to default buffer
  1484.     PUSH    DE        ; Save ptr
  1485.     PUSH    BC        ; Save read function code
  1486.     CALL    SETDMA        ; Set DMA address
  1487.     LD    DE,IFCB        ; Setup FCB address
  1488.     POP    BC        ; Restore read function
  1489.     CALL    BDOS        ; Do it
  1490.     POP    HL        ; Restore buffer ptr
  1491.     OR    A        ; End of file?
  1492.     RET    Z        ; Return if not
  1493.  
  1494. ; Unexpected end of file
  1495.  
  1496. EOF:    LD    DE,FMTERR    ; Print bad format message and abort
  1497.     JP    PABORT        ; (not much else we can do)
  1498.  
  1499. ; Count bytes skipped while processing bad archive header
  1500.  
  1501. BADCNT:    INC    HL        ; Bump bad byte count
  1502.     LD    A,H        ; But 64K bytes is enough!
  1503.     OR    L
  1504.     RET    NZ        ; Return if not reached limit
  1505.  
  1506.     JR    EOF        ; Else, report bad format and abort
  1507.  
  1508.     PAGE
  1509. ; Seek to new random position in file (relative to current position)
  1510. ; (BCDE = 32-bit byte offset)
  1511.  
  1512. SEEK:    LD    A,B        ; Most CP/M (2.2) can handle is 23 bits
  1513.     OR    A        ; So highest bits of offset must be 0
  1514.     JR    NZ,EOF        ; Else, that's certainly past eof!
  1515.  
  1516.     LD    A,E        ; Get low bits of offset in A
  1517.     LD    L,D        ; Get middle bits in HL
  1518.     LD    H,C
  1519.     ADD    A,A        ; LSB of record offset -> carry
  1520.     ADC_HL    HL        ; Record offset -> HL
  1521.     JR    C,EOF        ; If too big, report unexpected eof
  1522.  
  1523.     RRA            ; Get byte offset
  1524.     EX    DE,HL        ; Save record offset
  1525.     LD    HL,GETPTR    ; Point to offset (+80H) of last byte in
  1526.     ADD    A,(HL)        ; Add byte offsets
  1527.     LD    (HL),A        ; Update buffer ptr for new position
  1528.     INC    A        ; But does it overflow current record?
  1529.     JP    P,SEEK1        ; Yes, skip
  1530.  
  1531.     LD    A,D        ; Check record offset
  1532.     OR    E
  1533.     RET    Z        ; Return if none (still in same record)
  1534.  
  1535.     DEC    DE        ; Get offset from next record
  1536.     JR    SEEK2        ; Go compute new record no.
  1537.  
  1538. SEEK1:    ADD    A,7FH        ; Get proper byte offset in DMA page
  1539.     LD    (HL),A        ; Save new buffer pointer
  1540.  
  1541. SEEK2:    PUSH    DE        ; Save record offset
  1542.     LD    DE,IFCB
  1543.     LD    C,$RECORD    ; Compute current "random" record no.
  1544.     CALL    BDOS        ; (I.e. next sequential record to read)
  1545.     LD    HL,(IFCB+@RN)    ; Get result
  1546.     POP    DE        ; Restore record offset
  1547.     ADD    HL,DE        ; Compute new record no.
  1548.     JR    C,EOF        ; If >64k, it's past largest (8 Mb) file
  1549.  
  1550.     LD    (IFCB+@RN),HL    ; Save new record no.
  1551.     LD    C,$READR    ; Read the random record
  1552.     CALL    GETREC
  1553.     LD    HL,IFCB+@CR    ; Point to current record in extent
  1554.     INC    (HL)        ; Bump for subsequent sequential read
  1555.     RET            ; Return
  1556.  
  1557.     PAGE
  1558. ; Get archive file header
  1559.  
  1560. GETHDR:    LD    DE,HDRBUF    ; Set to fill header buffer
  1561.     LD    B,HDRSIZ    ; Setup normal header size
  1562.     CP    1        ; But test if version 1
  1563.     PUSH    AF        ; Save test result
  1564.     JR    NZ,GETHD2    ; Skip if not version 1
  1565.  
  1566.     LD    B,HDRSIZ-4    ; Else, header is 4 bytes less
  1567.     JR    GETHD2        ; Go to store loop
  1568.  
  1569. GETHD1:    CALL    GET        ; Get header byte
  1570.  
  1571. GETHD2:    LD    (DE),A        ; Store in buffer
  1572.     INC    DE
  1573.     DJNZ    GETHD1        ; Loop for all bytes
  1574.  
  1575.     POP    AF        ; Version 1?
  1576.     RET    NZ        ; No, all done
  1577.  
  1578.     LD    HL,SIZE        ; Yes, point to compressed size
  1579.     LD    C,4        ; It's 4 bytes
  1580.     LDIR            ; Move to uncompressed length
  1581.     RET            ; Return
  1582.  
  1583.     PAGE
  1584. ; Get, save, and test file name from archive header
  1585.  
  1586. GETNAM:    LD    DE,NAME        ; Point to name in header
  1587.     LD    HL,OFCB+@FN    ; Point to output file name
  1588.     LD_IX    TNAME        ; Point to test pattern
  1589.     LD    B,11        ; Set count for name and type
  1590.  
  1591. GETN1:    LD    A,(DE)        ; Get next name char
  1592.     AND    7FH        ; Ensure no flags, is it end of name?
  1593.     JR    Z,GETN4        ; Yes, go store blank
  1594.  
  1595.     INC    DE        ; Bump name ptr
  1596.     CP    ' '+1        ; Is it legal char for file name?
  1597.     JR    C,GETN2        ; No, if blank or non-printing,
  1598.     CP    DEL        ;  or this
  1599.     JR    NZ,GETN3    ; Skip if ok
  1600.  
  1601. GETN2:    LD    A,'$'        ; Else, change to something legal
  1602.  
  1603. GETN3:    CALL    UPCASE        ; Ensure it's upper case
  1604.     CP    '.'        ; But is it type separator?
  1605.     JR    NZ,GETN5    ; No, go store name char
  1606.  
  1607.     LD    A,B        ; Get count of chars left
  1608.     CP    4        ; Reached type yet?
  1609.     JR    C,GETN1        ; Yes, bypass the separator
  1610.  
  1611.     DEC    DE        ; Backup to re-read separator
  1612.  
  1613. GETN4:    LD    A,' '        ; Set to store a blank
  1614.  
  1615. GETN5:    LD    (HL),A        ; Store char in output name
  1616.     LD_A_IX            ; Get pattern char
  1617.     INC_IX            ; Bump pattern ptr
  1618.     CP    '?'        ; Pattern matches any char?
  1619.     JR    Z,GETN6        ; Yes, skip
  1620.  
  1621.     CP    (HL)        ; Matches this char?
  1622.     RET    NZ        ; Return (NZ) if not
  1623.  
  1624. GETN6:    INC    HL        ; Bump store ptr
  1625.     DJNZ    GETN1        ; Loop until FCB name filled
  1626.  
  1627.     LD    BC,256*(@FCBSZ-@FN-11)+0
  1628.     JP    FILL        ; Zero rest of FCB, return (Z still set)
  1629.  
  1630.     PAGE
  1631.     SUBTTL    File Output Routines
  1632.  
  1633. ; Check output drive and setup for file output
  1634.  
  1635. OUTSET:    LD    A,(HODRV)    ; Get highest allowed output drive
  1636.     LD    B,A        ; Save for later test
  1637.     LD    HL,CHECKF    ; Point to check-only flag
  1638.     CALL    WHLCK        ; Check wheel byte
  1639.     DEC    A        ; Is user privileged?
  1640.     JR    NZ,OUTS1    ; Yes, skip
  1641.  
  1642.     LD    B,A        ; Else, no output drive allowed
  1643.     LD    (HL),A        ; No checking allowed
  1644.     LD    (PROUTF),A    ; No printing allowed
  1645.     LD    A,(TYFLG)    ; Fetch flag for typeout allowed
  1646.  
  1647. OUTS1:    LD    C,A        ; Save typeout flag (always if wheel)
  1648.     LD    A,(OFCB)    ; Any output drive?
  1649.     OR    A
  1650.     JR    NZ,OUTS2    ; Yes, skip to check it
  1651.  
  1652.     OR    (HL)        ; Just checking files?
  1653.     JR    Z,CKTYP        ; No, go see if typeout permitted
  1654.  
  1655.     LD    DE,CHKMSG    ; Yes, show 'Checking...' message
  1656.     CALL    PRINTL
  1657.     LD    A,0FEH        ; Set dummy drive in output FCB
  1658.     LD    (OFCB),A
  1659.     JR    CRCINI        ; Skip to init CRC computations
  1660.  
  1661. OUTS2:    DEC    A        ; Get zero-relative drive no.
  1662.     CP    B        ; In range of allowed drives?
  1663.     LD    DE,BADODR    ; No, report bad output drive
  1664.     JP    NC,PABORT    ;  and abort
  1665.  
  1666.     LD    E,A        ; Save output drive
  1667.     PUSH    DE
  1668.     ADD    A,'A'        ; Convert to ASCII
  1669.     LD    (OUTDRV),A    ; Store drive letter for message
  1670.     LD    DE,OUTMSG    ; Show output drive
  1671.     CALL    PRINTL
  1672.  
  1673.     LD    C,$DISK        ; Get default drive
  1674.     CALL    BDOS
  1675.     POP    DE        ; Recover output drive
  1676.     CP    E        ; Test if same as default
  1677.     PUSH    AF        ; Save default drive (and test result)
  1678.     LD    C,$SELECT    ; Select output drive
  1679.     CALL    NZ,BDOS        ;  (if different than default)
  1680.     CALL    GETBLS        ; Get its block size for listing
  1681.     POP    AF        ; Restore original default drive
  1682.     LD    E,A
  1683.     LD    C,$SELECT    ; Reselect it
  1684.     CALL    NZ,BDOS        ;  (if changed)
  1685.  
  1686.     PAGE
  1687. ; Initialize lookup table for CRC generation
  1688.  
  1689. ; Note:    For maximum speed, the CRC routines rely on the fact that the
  1690. ;    lookup table (CRCTAB) is page-aligned.
  1691.  
  1692. X16    EQU    0        ; x^16 (implied)
  1693. X15    EQU    1 SHL (15-15)    ; x^15
  1694. X2    EQU    1 SHL (15-2)    ; x^2
  1695. X0    EQU    1 SHL (15-0)    ; x^0 = 1
  1696.  
  1697. POLY    EQU    X16+X15+X2+X0    ; Polynomial (CRC-16)
  1698.  
  1699. CRCINI:    LD    HL,CRCTAB+256    ; Point to 2nd page of lookup table
  1700.     LD    A,H        ; Check enough memory to store it
  1701.     CALL    CKMEM
  1702.     LD    DE,POLY        ; Setup polynomial
  1703.  
  1704. ; Loop to compute CRC for each possible byte value from 0 to 255
  1705.  
  1706. CRCIN1:    LD    A,L        ; Init low CRC byte to table index
  1707.     LD    BC,256*8    ; Setup bit count, clear high CRC byte
  1708.  
  1709. ; Loop to include each bit of byte in CRC
  1710.  
  1711. CRCIN2:    SRL    C        ; Shift CRC right 1 bit (high byte)
  1712.     RRA            ; (low byte)
  1713.     JR    NC,CRCIN3    ; Skip if 0 shifted out
  1714.  
  1715.     EX_AF            ; Save lower CRC byte
  1716.     LD    A,C        ; Update upper CRC byte
  1717.     XOR    D        ;  with upper polynomial byte
  1718.     LD    C,A
  1719.     EX_AF            ; Recover lower CRC byte
  1720.     XOR    E        ; Update with lower polynomial byte
  1721.  
  1722. CRCIN3:    DJNZ    CRCIN2        ; Loop for 8 bits
  1723.  
  1724.     LD    (HL),C        ; Store upper CRC byte (2nd table page)
  1725.     DEC    H
  1726.     LD    (HL),A        ; Store lower CRC byte (1st table page)
  1727.     INC    H
  1728.     INC    L        ; Bump table index
  1729.     JR    NZ,CRCIN1    ; Loop for 256 table entries
  1730.  
  1731.     RET
  1732.  
  1733.     PAGE
  1734. ; Check for valid file name for typeout (or printing)
  1735.  
  1736. CKTYP:    OR    C        ; Typeout not allowed?
  1737.     CALL    NZ,TAMBIG    ; Or ambiguous output file name?
  1738.     RET    Z        ; Yes, return (will just list file)
  1739.  
  1740.     LD    DE,NOTYP    ; Point to table of excluded types
  1741.  
  1742. CKTYP1:    LD    HL,TNAME+8    ; Point to type of selected file
  1743.     LD    B,3        ; Setup count for 3 chars
  1744.  
  1745. CKTYP2:    LD    A,(DE)        ; Fetch next table char
  1746.     OR    A        ; End of table?
  1747.     JR    Z,CKTYP5    ; Yes, go set flag to allow typeout
  1748.  
  1749.     CP    '?'        ; Matches any char?
  1750.     JR    Z,CKTYP3    ; Yes, skip
  1751.  
  1752.     CP    (HL)        ; Matches this char?
  1753.  
  1754. CKTYP3:    INC    DE        ; Bump table ptr
  1755.     JR    Z,CKTYP4    ; Matched?
  1756.     DJNZ    CKTYP3        ; No, just advance to next table entry
  1757.     JR    CKTYP1        ; Then loop to try again
  1758.  
  1759. CKTYP4:    INC    HL        ; Char matched, point to next
  1760.     DJNZ    CKTYP2        ; Loop for all chars in file type
  1761.     RET            ; If all matched, return (no typeout)
  1762.  
  1763. CKTYP5:    DEC    A        ; If no match, file name is valid
  1764.     LD    (OFCB),A    ; Set dummy drive (0FFH) in output FCB
  1765.     RET            ; Return
  1766.  
  1767. ; Test for ambiguous output file selection
  1768.  
  1769. TAMBIG:    LD    HL,TNAME    ; Point to test pattern
  1770.  
  1771. ; Check for ambiguous file name (HL = ptr to FCB-type name)
  1772.  
  1773. FAMBIG:    LD    BC,11        ; Setup count for file name and type
  1774.     LD    A,'?'        ; Any "?" chars?
  1775.     CPIR            ; Yes, return with Z set
  1776.     RET            ; No, return NZ
  1777.  
  1778.     PAGE
  1779. ; Extract file for disk or console output
  1780.  
  1781. OUTPUT:    LD    A,(OFCB)    ; Any output drive (or typing files)?
  1782.     OR    A
  1783.     RET    Z        ; No, there's nothing to do here
  1784.  
  1785.     LD    B,A        ; Save output drive
  1786.     LD    A,(VER)        ; Get header version
  1787.     CP    ARCVER+1    ; Supported for output?
  1788.     LD    DE,BADVER    ; No, report unknown version
  1789.     JP    NC,PABORT    ;  and abort
  1790.  
  1791.     LD    L,A        ; Copy version
  1792.     LD    H,0
  1793.     LD    DE,OBUFT-1    ; Use to index table of starting
  1794.     ADD    HL,DE        ;  output buffer pages
  1795.     LD    A,(HL)        ; Get starting page of buffer
  1796.     CALL    CKMEM        ; Ensure enough memory
  1797.     LD    HL,BUFPAG    ; Point to buffer start page
  1798.     LD    (HL),A        ; Save it
  1799.     LD    C,A        ; (also for typeout buffer check)
  1800.     INC    HL        ; Point to buffer limit (BUFLIM)
  1801.     LD    A,(HIPAGE)    ; Get memory limit page
  1802.     LD    (HL),A        ; Assume max possible output buffer
  1803.     INC    B        ; Typing files?
  1804.     JR    NZ,OUTDSK    ; No, go extract to disk
  1805.  
  1806. ; Setup for console (or printer) output
  1807.  
  1808.     LD    A,(TYPGS)    ; Get max. pages to buffer typeout
  1809.     OR    A        ; No limit?
  1810.     CALL    Z,WHLCK        ; And is this privileged user?
  1811.     JR    Z,OUTCON    ; Yes, skip (use 1 page if no privilege)
  1812.  
  1813.     ADD    A,C        ; Compute desired limit page
  1814.     JR    C,OUTCON    ; But skip if exceeds (physical) memory
  1815.     CP    (HL)
  1816.     JR    NC,OUTCON    ; Also if exceeds available memory
  1817.  
  1818.     LD    (HL),A        ; If ok, set lower buffer limit
  1819.  
  1820. OUTCON:    LD    A,(PROUTF)    ; Printing file?
  1821.     OR    A
  1822.     JR    NZ,OUTBEG    ; Yes, skip the separator
  1823.  
  1824.     LD    HL,LINE        ; Fill listing line with dashes
  1825.     LD    BC,256*LINLEN+'-'
  1826.     CALL    FILL
  1827.     CALL    LISTL        ; Print separating line first
  1828.     JR    OUTBEG        ; Go extract file for typeout
  1829.  
  1830.     PAGE
  1831. ; Setup for disk file (or black hole) output
  1832.  
  1833. OUTDSK:    INC    B        ; Just checking file?
  1834.     JR    Z,OUTBEG    ; Yes, skip
  1835.  
  1836.     LD    DE,BUFF        ; Set DMA address to a safe place
  1837.     CALL    SETDMA
  1838.     LD    C,$FIND        ; Find file
  1839.     CALL    OFDOS        ; Already exists?
  1840.     JR    Z,OUTD2        ; No, skip
  1841.  
  1842.     LD    DE,EXISTS    ; Inform user and ask:
  1843.     CALL    PRINTS        ; Should we overwrite existing file?
  1844.  
  1845. OUTD1:    CALL    CABORT        ; Wait for response (or CTRL-C abort)
  1846.     JR    Z,OUTD1
  1847.  
  1848.     LD    E,A        ; Save response
  1849.     CALL    CRLF        ; Start a new line after prompt
  1850.     LD    A,E        ; Get response char
  1851.     CALL    UPCASE        ; Upper and lower case are the same
  1852.     CP    'Y'        ; Answer was yes?
  1853.     RET    NZ        ; No, return (skip file output)
  1854.  
  1855.     LD    C,$DELETE    ; Yes, delete existing file
  1856.     CALL    OFDOS
  1857.  
  1858. OUTD2:    LD    C,$MAKE        ; Create a new file
  1859.     CALL    OFDOS        ; But directory full?
  1860.     LD    DE,DIRFUL    ; Yes, report error
  1861.     JP    Z,PABORT    ;  and abort
  1862.  
  1863.     LD    (OFLAG),A    ; Set flag for output file open
  1864.  
  1865.     PAGE
  1866. ; All set to output file
  1867.  
  1868. OUTBEG:    LD    A,(VER)        ; Check compression type
  1869.     CP    4
  1870.     JR    NC,USQ        ; Skip if squeezed or crunched/squashed
  1871.  
  1872.     CALL    PUTSET        ; Else (simple cases), setup output regs
  1873.     CP    3        ; Packed?
  1874.     JR    Z,UPK        ; Yes, skip
  1875.  
  1876. ; Uncompressed file
  1877.  
  1878. UNC:    CALL    GETC        ; Just copy input to output
  1879.     JR    C,OUTEND    ;  until end of file
  1880.     CALL    PUT
  1881.     JR    UNC
  1882.  
  1883. ; Packed file
  1884.  
  1885. UPK1:    CALL    PUTUP        ; Output with repeated byte expansion
  1886.  
  1887. UPK:    CALL    GETC        ; Get input byte
  1888.     JR    NC,UPK1        ; Loop until end of file
  1889.  
  1890. ; End of output file
  1891.  
  1892. OUTEND:    CALL    PUTBUF        ; Flush final buffer (if any)
  1893.     LD    A,(OFCB)    ; Typing (or printing) file?
  1894.     INC    A
  1895.     RET    Z        ; Yes, all done (no CRC check)
  1896.  
  1897. ; Note:    Following instruction added in UNARC 1.6, since the preceding
  1898. ;    test (altered in 1.42) no longer clears carry.
  1899.  
  1900.     OR    A        ; Clear carry for 16-bit subtract
  1901.     EX    DE,HL        ; Save computed CRC
  1902.     LD    HL,(CRC)    ; Get CRC recorded in archive header
  1903.     SBC_HL    DE        ; Do they match?
  1904.     LD    DE,CRCERR    ; If not,
  1905.     CALL    NZ,OWARN    ;  print warning message
  1906.  
  1907.     LD    HL,LEN        ; Point to remaining (output) length
  1908.     CALL    LGET        ; Fetch length (it's 4 bytes)
  1909.     LD    A,B        ; All should be zero...
  1910.     OR    C
  1911.     OR    D
  1912.     OR    E
  1913.     LD    DE,LENERR    ; If not,
  1914.     CALL    NZ,OWARN    ;  print incorrect length warning
  1915.  
  1916.     CALL    OCLOSE        ; Close output file (if open)
  1917.     LD    HL,OFLAG    ; Clear file open flag
  1918.     LD    (HL),0
  1919.     RET    NZ        ; Return unless error closing file
  1920.  
  1921.     LD    DE,CLSERR    ; Else, report close failure
  1922.     JP    PABORT        ;  and abort
  1923.  
  1924.     PAGE
  1925. ; Unsqueeze (Huffman-coded) file
  1926.  
  1927.     .COMMENT |
  1928.  
  1929. Note:  Although numerous assembly-language implementations of Richard
  1930. Greenlaw's pioneer USQ (C language) program have appeared, all of the
  1931. coding here is original.  At risk of being accused of "re-inventing
  1932. the wheel," we do this primarily for personal satisfaction (not to
  1933. mention protection of our copyright).
  1934.  
  1935. We were tempted to use the super-fast algorithm suggested by Steven
  1936. Greenberg's recent public contribution, UF (aka USQFST, nee FU).
  1937. (After all, we require a Z80, so why not take advantage of the latest
  1938. technology?)  However, some of the speed benefit of Greenberg's method
  1939. is necessarily lost, since we do not buffer the input file and must
  1940. count each input byte against the file size recorded in the archive
  1941. header.  (Input buffering is not advantageous, since we must have
  1942. random access to the archive file.)  Also, the occurence of squeezed
  1943. files in archives is relatively rare, since the "crunching" method
  1944. produces better compression in most cases.  Thus we use a more
  1945. classical approach, albeit at the expense of the ultimate in
  1946. performance, but with a substantial savings in code complexity and
  1947. memory requirements.
  1948.  
  1949. Note also that many authors go to elaborate pains to check the validity
  1950. of the binary decoding tree.  Such checks include:  (1) the node count
  1951. (can be at most 256, although some people mistakenly think it can be
  1952. greater -- c.f. Knuth, vol. 1, 2nd ed., sec. 2.3.4.5, pp. 399-405); (2)
  1953. all node links in the tree must be in the range specified by the node
  1954. count; (3) no infinite loops in the tree (this one's not so easy to
  1955. test); and (4) premature end-of-file in the tree or data.  Instead, we
  1956. take a KISS approach which assumes the tree is valid and relies upon
  1957. the final output file CRC and length checks to warn of any possible
  1958. errors:  (1) the tree is initially cleared (all links point to the root
  1959. node); (2) at most 256 nodes are stored; and (3) decoding terminates
  1960. upon detecting the special end-of-file code in the data (the normal
  1961. case), the physical end-of-file (as determined by the size recorded in
  1962. the archive header), or a tree link to the root node (which indicates a
  1963. diseased tree). |
  1964.  
  1965.     PAGE
  1966. ; Start unsqueezing
  1967.  
  1968. USQ:    JR    NZ,UCR        ; But skip if crunched/squashed file
  1969.  
  1970. ; First clear the decoding tree
  1971.  
  1972.     LD    BC,TREESZ-1    ; Setup bytes to clear - 1
  1973.     CALL    TREECL        ; (Leaves DE pointing past end of tree)
  1974.  
  1975. ; Read in the tree
  1976.  
  1977. ; Note:    The end-of-file condition may be safely ignored while reading
  1978. ;    the node count and tree, since GETC will repeatedly return
  1979. ;    zero bytes in this case.
  1980.  
  1981.     CALL    GETC        ; Get node count, low byte
  1982.     LD    C,A        ; Save for loop
  1983.     CALL    GETC        ; Get high byte (can be ignored)
  1984.     OR    C        ; But is it zero nodes?
  1985.     JR    Z,USQ3        ; Yes (very unlikely), it's empty file
  1986.  
  1987. USQ1:    LD    B,4        ; Setup count for 4 bytes in node
  1988.     LD    A,D        ; Each byte will be stored in a separate
  1989.     SUB    B        ;  page (tree is page-aligned), so
  1990.     LD    D,A        ;  point back to the first page
  1991.  
  1992. USQ2:    CALL    GETC        ; Get next byte
  1993.     LD    (DE),A        ; Store in tree
  1994.     INC    D        ; Point to next page
  1995.     DJNZ    USQ2        ; Loop for all bytes in node
  1996.  
  1997.     INC    E        ; Bump tree index
  1998.     DEC    C        ; Reduce node count
  1999.     JR    NZ,USQ1        ; Loop for all nodes
  2000.  
  2001. USQ3:    CALL    PUTSET        ; Done with tree, setup output regs
  2002.     PUSH    HL        ; Reset current input byte (on stack)
  2003.  
  2004. ; Start of decoding loop for next output byte
  2005.  
  2006. USQ4:    EXX            ; Save output registers
  2007.     XOR    A        ; Reset node index to root of tree
  2008.  
  2009. ; Top of loop for next input bit
  2010.  
  2011. USQ5:    LD    L,A        ; Setup index of next tree node
  2012.     POP    AF        ; Get current input byte
  2013.     SRL    A        ; Shift out next input bit
  2014.     JR    NZ,USQ6        ; Skip unless need a new byte
  2015.  
  2016.     PAGE
  2017. ; Read next input byte
  2018.  
  2019.     PUSH    HL        ; Save tree index
  2020.     CALL    GETCX        ; Get next input byte
  2021.     EXX            ; Save output regs
  2022.     JR    C,USQEND    ; But go stop if reached end of input
  2023.  
  2024.     POP    HL        ; Restore tree index
  2025.     SCF            ; Set flag for end-of-byte detection
  2026.     RRA            ; Shift out first bit of new byte
  2027.  
  2028. ; Process next input bit
  2029.  
  2030. USQ6:    PUSH    AF        ; Save input byte
  2031.     LD    H,HIGH TREE    ; Point to start of current node
  2032.     JR    NC,USQ7        ; Skip if new bit is 0
  2033.  
  2034.     INC    H        ; Bit is 1, point to 2nd word of node
  2035.     INC    H        ; (3rd tree page)
  2036.  
  2037. USQ7:    LD    A,(HL)        ; Get low byte of node word
  2038.     INC    H
  2039.     LD    B,(HL)        ; Get high byte (from next tree page)
  2040.     INC    B
  2041.     JR    NZ,USQ8        ; Skip if high byte not -1
  2042.  
  2043.     CPL            ; We've got output byte (complemented)
  2044.     EXX            ; Restore regs for output
  2045.     CALL    PUTUP        ; Output with repeated byte expansion
  2046.     JR    USQ4        ; Loop for next byte
  2047.  
  2048. USQ8:    DJNZ    USQEND        ; If high byte not 0, it's special EOF
  2049.     OR    A        ; If high byte was 0, its new node link
  2050.     JR    NZ,USQ5        ; Loop for new node (but can't be root)
  2051.  
  2052. ; End of squeezed file (physical, logical, or due to Dutch elm disease)
  2053.  
  2054. USQEND:    POP    HL        ; Cleanup stack
  2055.  
  2056. ; End of unsqueezed or uncrunched file output
  2057.  
  2058. UCREND:    EXX            ; Restore output regs
  2059.     JP    OUTEND        ; Go end output
  2060.  
  2061. ; Clear squeezed file decoding tree (or crunched file string table)
  2062.  
  2063. TREECL:    LD    HL,TREE        ; Point to tree (also string table)
  2064.  
  2065. STRTCL:                ; (Entry for partial string table clear)
  2066.     LD    (HL),L        ; Clear first byte (it's page-aligned)
  2067.     LD    D,H        ; Copy pointer to first byte
  2068.     LD    E,L
  2069.     INC    DE        ; Propogate it thru second byte, etc.
  2070.     LDIR            ; (called with BC = byte count - 1)
  2071.     RET            ; Return
  2072.  
  2073.     PAGE
  2074. ; Uncrunch (LZW-coded) file
  2075.  
  2076.     .COMMENT |
  2077.  
  2078. The Lempel-Ziv-Welch (so-called "LZW") data compression algorithm is
  2079. the most impressive benefit of ARC files.  It performs better than
  2080. Huffman coding in many cases, often achieving 50% or better compression
  2081. of ASCII text files and 15%-40% compression of binary object files.
  2082. The algorithm is named after its inventors:  A. Lempel and J. Ziv
  2083. provided the original theoretical groundwork, while Terry A. Welch
  2084. published an elegant practical implementation of their procedure.  (The
  2085. definitive article is Welch's "A Technique for High-Performance Data
  2086. Compression", in the June 1984 issue of IEEE Computer magazine.)
  2087.  
  2088. The Huffman algorithm encoded each input byte by a variable-length bit
  2089. string (up to 16 bits in Greenlaw's implementation), with bit length
  2090. (approximately) inversely proportional to the frequency of occurrence
  2091. of the encoded byte.  This has the disadvantages of requiring (1) two
  2092. passes over the input file for encoding and (2) the inclusion of the
  2093. decoding information along with the output file (a binary tree of up to
  2094. 1026 bytes in Greenlaw's implementation).  In comparison, LZW is a one-
  2095. pass procedure which encodes variable-length strings of bytes by a
  2096. fixed-length code (12 bits in this implementation), without additional
  2097. overhead in the output file.  In essence, the procedure adapts itself
  2098. dynamically to the redundancy present in the input data.  There is one
  2099. drawback:  LZW requires substantially more memory than the Huffman
  2100. algorithm for both encoding and decoding.  (A 12K-byte string table is
  2101. required in this program; the MS-DOS ARC program uses even more.  Of
  2102. course, 12K is not that much these days:  I don't think they're even
  2103. selling IBM-PC's or MAC's with less than 512K anymore.  But some of us
  2104. in the CP/M world are still concerned with efficiency of memory use.)
  2105.  
  2106. The MS-DOS ARC program by System Enhancement Associates has (to date)
  2107. employed four different variations on the LZW scheme, differentiated by
  2108. the version byte in the archive file header:
  2109.  
  2110.      Version 5:  LZW applied to original input file
  2111.      Version 6:  LZW applied to file after packing repeated bytes
  2112.      Version 7:  Same as version 6 with a new (faster) hash code
  2113.      Version 8:  Completely new (much improved) implementation
  2114.  
  2115. The MS-DOS program PKARC 2.0 introduced another variation ("squashing"):
  2116.  
  2117.      Version 9:  Same as version 8 with 13-bit codes and no pre-packing
  2118.  
  2119. Version 8 (and 9) varies the output code width from 9 to 12 (13) bits
  2120. as the string table grows (benefits small files), performs an adaptive
  2121. reset of the string table after it becomes full if the compression
  2122. ratio drops (benefits large files), and eliminates the need for hash
  2123. computations by the decoder (reduces decoding time and space; in this
  2124. program, an extra 8K-byte table is eliminated).  Although the latest
  2125. release of the ARC program uses only this last version for encoding,
  2126. we, like ARC (PKXARC), support all four (five) versions for
  2127. compatibility with files encoded by earlier releases. |
  2128.  
  2129.     PAGE
  2130. ; Setup for uncrunching (or unsquashing)
  2131.  
  2132. ; We've been able to isolate all of the differences between the five
  2133. ; versions of LZW into just three routines -- input, output, and hash
  2134. ; function.  These are disposed of first, by inserting appropriate
  2135. ; vectors into common coding and initializing version-dependent data.
  2136.  
  2137. ; Note:    Introduction of squashed files in UNARC 1.42 has added some
  2138. ;    extra kludges here.
  2139.  
  2140. UCR:    LD    HL,STRBIT    ; All but version 9 use 4K string table
  2141.     LD    (HL),BIT4H    ;  entries, so setup STRADD bit test
  2142.     CP    8        ; Version 8 or 9?
  2143.     JR    NC,UCR1        ; Yes, skip
  2144.  
  2145.     LD    DE,OGETCR    ; Old versions get fixed 12-bit codes
  2146.     LD    BC,STRSZ+HSHSZ-1;  and need extra table for hashing
  2147.     LD    HL,OHASH    ; Assume old hash function
  2148.     CP    6        ; Test version
  2149.     LD    A,55H        ; Setup initial flags for OGETCR
  2150.     JR    Z,UCR6        ; All set if version 6
  2151.     JR    C,UCR5        ; Skip if version 5
  2152.  
  2153.     LD    HL,FHASH    ; Version 7 uses faster hash function
  2154.     JR    UCR6        ; (but we've never seen one of these!)
  2155.  
  2156. UCR1:    JR    Z,UCR2        ; Skip if version 8
  2157.     LD    (HL),BIT5H    ; Version 9 allows 13-bit codes
  2158.     LD    BC,STQSZ-1    ;  and has larger string table
  2159.     LD    A,8192/256    ;  with 8K entries (less buffer space)
  2160.     JR    UCR4        ; Join common code for versions 8 and 9
  2161.  
  2162. ; Note:    This is the only place that we reference the code size for
  2163. ;    crunched files (CRBITS) symbolically.  Currently, a value of
  2164. ;    12 bits is required and it is assumed throughout the program.
  2165.  
  2166. UCR2:    CALL    GETC        ; Read code size used to crunch file
  2167.     JR    C,UCR3        ; But skip if none (PKARC 0-length file)
  2168.     CP    CRBITS        ; Same as what we expect?
  2169.     LD    DE,UCRERR    ; No, report incompatible format
  2170.     JP    NZ,PABORT    ;  and abort
  2171.  
  2172. UCR3:    LD    BC,STRSZ-1    ; Version 8 provides more buffer space
  2173.     LD    A,4096/256    ;  and only 4K string table entries
  2174.  
  2175. UCR4:    LD    (STRMAX),A    ; Setup NHASH table-full test
  2176.     LD    HL,0        ; Clear code residue and count to init
  2177.     LD    (CODES),HL    ;  NGETCR input (BITSAV and CODES)
  2178.     LD    DE,NGETCR    ; New version has variable-length codes
  2179.     LD    HL,NHASH    ;  and has a very simple "hash"
  2180.     LD    A,9        ; Setup initial code size for NGETCR
  2181.     JR    Z,UCR6        ; Skip if version 8
  2182.  
  2183. UCR5:    LD_IX    PUT        ; Versions 5 and 9 don't unpack
  2184.     JR    UCR7
  2185.  
  2186. UCR6:    LD_IX    PUTUP        ; Versions 6-8 unpack repeated bytes
  2187.  
  2188. UCR7:    STO_IX    PUTCRP        ; Save ptr to output routine
  2189.     LD    (HASHP),HL    ; Save ptr to hash function
  2190.     STO_DE    GETCRP        ; Save ptr to input routine
  2191.     LD    (BITS),A    ; Initialize input routine
  2192.     LD    A,B        ; Get string table pages to clear (-1)
  2193.     SUB    3        ; Less 3 for atomic strings
  2194.     LD    (STRCSZ),A    ; Setup for reset clear in NGETCR
  2195.  
  2196.     PAGE
  2197. ; Start uncrunching
  2198. ; (All version-dependent differences are handled now)
  2199.  
  2200.     CALL    TREECL        ; Clear string (and hash) table(s)
  2201.     STO_BC    STRCT        ; Set no entries in string table
  2202.     DEC    BC        ; Get code for no prefix string (-1)
  2203.     PUSH    BC        ; Save as first-time flag
  2204.     XOR    A        ; Init table with one-byte strings...
  2205.  
  2206. GCR0:    POP    BC        ; Set for no prefix string
  2207.     PUSH    BC        ; (Resave first-time flag)
  2208.     PUSH    AF        ; Save byte value
  2209.     CALL    STRADD        ; Add to table
  2210.     POP    AF        ; Recover byte
  2211.     INC    A        ; Done all 256 bytes?
  2212.     JR    NZ,GCR0        ; No, loop for next
  2213.  
  2214.     CALL    PUTSET        ; Setup output registers
  2215.  
  2216. ; Top of loop for next input code (top of stack holds previous code)
  2217.  
  2218. GCR:    EXX            ; Save output regs first
  2219.  
  2220. GETCR:    CALL    0        ; Get next input code
  2221. GETCRP    EQU    $-2        ; (ptr to NGETCR or OGETCR stored here)
  2222.  
  2223.     POP    BC        ; Recover previous input code (or -1)
  2224.     JP    C,UCREND    ; But all done if end of input
  2225.  
  2226.     PUSH    HL        ; Save new code for next loop
  2227.     CALL    STRPTR        ; Point to string table entry for code
  2228.     INC    B        ; Is this the first one in file?
  2229.     JR    NZ,GCR2        ; No, skip
  2230.  
  2231.     INC    HL        ; Yes,
  2232.     LD    A,(HL)        ; Get first output byte
  2233.  
  2234. GCR1:    CALL    PUTCR        ; Output final byte for this code
  2235.     JR    GCR        ; Loop for next input code
  2236.  
  2237. GCR2:    DEC    B        ; Correct prev code (stays in BC awhile)
  2238.     LD    A,(HL)        ; Is new code in table?
  2239.     OR    A
  2240.     PUSH    AF        ; (Save test result for later)
  2241.     JR    NZ,GCR3        ; Yes, skip
  2242.  
  2243.     LD    H,B        ; Else (special case), setup previous
  2244.     LD    L,C        ;  code (it prefixes the new one)
  2245.     CALL    STRPTR        ; Point to its table entry instead
  2246.  
  2247.     PAGE
  2248. ; At this point, we have the table ptr for the new output string (except
  2249. ; possibly its final byte, which is a special case to be handled later).
  2250. ; Unfortunately, the table entries are linked in reverse order.  I.e.,
  2251. ; we are pointing to the last byte to be output.  Therefore, we trace
  2252. ; through the table to find the first byte of the string, reversing the
  2253. ; link order as we go.  When done, we can output the string in forward
  2254. ; order and restore the original link order.  (This is, we think, an
  2255. ; innovative approach: it saves allocation of an extra 4K-byte stack,
  2256. ; as in the MS-DOS ARC program, or an enormous program stack, as needed
  2257. ; for the recursive algorithm of Steve Greenberg's UNCRunch program.)
  2258.  
  2259. ; Careful:  The following value must be non-zero, so that the old-style
  2260. ; hash (invoked by STRADD below) will not think a re-linked entry is
  2261. ; unused!  (In a development version, we used zero; this worked fine for
  2262. ; newer crunched files, but proved a difficult bug to squash when the
  2263. ; old-style de-crunching failed randomly.)
  2264.  
  2265. GCR3:    LD    D,1        ; Init previous entry ptr (01xxH = none)
  2266.  
  2267. GCR4:    LD    A,(HL)        ; Test this entry
  2268.     CP    HIGH STRT    ; Any prefix string?
  2269.     JR    C,GCR5        ; No, we've reached the first byte
  2270.  
  2271.     LD    (HL),D        ; Relink this entry
  2272.     LD    D,A        ; (i.e. swap prev ptr with prefix ptr)
  2273.     DEC    HL
  2274.     LD    A,(HL)
  2275.     LD    (HL),E
  2276.     LD    E,A
  2277.     INC    HL
  2278.     EX    DE,HL        ; Swap current ptr with prefix ptr
  2279.     JR    GCR4        ; Loop for next entry
  2280.  
  2281. ; HL points to table entry for first byte of output string.  We can now
  2282. ; add the table entry for the string which the encoder placed in his
  2283. ; table before sending us the current code.  (It's the previous code's
  2284. ; string concatenated with the first byte of the new string).  Note that
  2285. ; BC has been holding the previous code all this time.
  2286.  
  2287. GCR5:    INC    HL        ; Point to byte
  2288.     POP    AF        ; Recover special-case flag
  2289.     LD    A,(HL)        ; Fetch byte
  2290.     PUSH    AF        ; Re-save flag along with byte
  2291.     DEC    HL        ; Restore table ptr
  2292.     PUSH    DE        ; Save ptr to prev entry
  2293.     PUSH    HL        ; Save ptr to this entry
  2294.     CALL    STRADD        ; Add new code to table (for BC and A)
  2295.     POP    HL        ; Setup table ptr for output loop
  2296.  
  2297.     PAGE
  2298. ; Top of string output loop
  2299. ; HL points to table entry for byte to output.
  2300. ; Top of stack contains pointer to next table entry (or 01xxH).
  2301.  
  2302. GCR6:    INC    HL        ; Point to byte
  2303.     LD    A,(HL)        ; Fetch it
  2304.     PUSH    HL        ; Save table ptr
  2305.     CALL    PUTCR        ; Output the byte (finally!)
  2306.     EXX            ; Save output regs
  2307.     POP    DE        ; Recover ptr to this byte
  2308.     POP    HL        ; Recover ptr to next byte's entry
  2309.     DEC    H        ; Reached end of string?
  2310.     JR    Z,GCR7        ; Yes, skip out of loop
  2311.  
  2312.     INC    H        ; Correct next entry ptr from above test
  2313.     DEC    DE        ; Restore ptr to this entry's mid byte
  2314.     LD    A,(HL)        ; Relink the next entry
  2315.     LD    (HL),D        ; (i.e. swap its "prefix" ptr with
  2316.     LD    D,A        ;  ptr to this entry)
  2317.     DEC    HL
  2318.     LD    A,(HL)
  2319.     LD    (HL),E
  2320.     LD    E,A
  2321.     INC    HL
  2322.     PUSH    DE        ; Save ptr to 2nd next entry
  2323.     JR    GCR6        ; Loop to output next byte
  2324.  
  2325. ; End of uncrunching loop
  2326. ; All bytes of new string have been output, except possibly the final
  2327. ; byte (which is the same as the first byte in this special case).
  2328.  
  2329. GCR7:    POP    AF        ; Recover special-case flag and byte
  2330.     JR    NZ,GETCR    ; If not set, loop for next input code
  2331.  
  2332.     JR    GCR1        ; Else, go output final byte first
  2333.  
  2334.     PAGE
  2335. ; Add entry to string table
  2336.  
  2337. ; This routine receives a 12-bit prefix string code in BC and a suffix
  2338. ; byte in A.  It then adds an entry to the string table (unless it's
  2339. ; full) for the new string obtained by concatenating these.  Nothing
  2340. ; is (or need be) returned to the caller.
  2341.  
  2342.     .COMMENT |
  2343.  
  2344. String table format:
  2345.  
  2346. The table (STRT) contains 4096 three-byte entries, each of which is
  2347. identified by a 12-bit code (table index).  The third byte (highest
  2348. address) of each entry contains the suffix byte for the string.  The
  2349. first two bytes contain a pointer (low-byte first) to the middle byte
  2350. of the table entry for the prefix string.  The null string (prefix to
  2351. the one-byte strings) is represented by a (16-bit) code value -1, which
  2352. yields a non-zero pointer below the base address of the table.  An
  2353. empty table entry contains a zero prefix pointer.
  2354.  
  2355. Our choice to represent prefix strings by pointers rather than codes
  2356. speeds up almost everything we do.  The high byte of the prefix pointer
  2357. (middle byte of an entry) may be tested for non-zero to determine if an
  2358. entry is occupied, and (since the table is page-aligned) it may be
  2359. further tested against the page address of the table's base (HIGH STRT)
  2360. to decide if it represents the null string.
  2361.  
  2362. Note that the entry for code 256 is not used in the newer version of
  2363. crunching.  This is reserved for a special signal to reset the string
  2364. table (handled by the hash and input routines, NHASH and NGETCR). |
  2365.  
  2366. STRADD:    LD    HL,(STRCT)    ; Get count of strings in table
  2367.     BIT    4,H        ; Is it the full 4K?
  2368.  
  2369. ; Note:    Above test complicated by introduction of squashed files (which
  2370. ;    allow 13-bit codes and 8K string table entries) and the non-Z80
  2371. ;    emulation of the BIT instruction.  Following definitions handle
  2372. ;    this.
  2373.  
  2374. IF Z80
  2375. STRBIT    EQU    $-1        ; Byte to modify BIT instruction
  2376. BIT4H    EQU    64H        ; High byte of BIT 4,H
  2377. BIT5H    EQU    6CH        ; High byte of BIT 5,H
  2378. ELSE
  2379. STRBIT    EQU    BITMSK        ; Byte to modify emulated BIT
  2380. BIT4H    EQU    1 SHL 4        ; Mask to test bit 4
  2381. BIT5H    EQU    1 SHL 5        ; Mask to test bit 5
  2382. ENDIF
  2383.     RET    NZ        ; Yes, forget it
  2384.  
  2385.     INC    HL        ; Bump count for one more
  2386.     LD    (STRCT),HL    ; Save new string count
  2387.     PUSH    AF        ; Save suffix byte
  2388.     PUSH    BC        ; Save prefix code
  2389.     CALL    0        ; Hash them to get pointer to new entry
  2390. HASHP    EQU    $-2        ; (ptr to xHASH routine stored here)
  2391.     EX    (SP),HL        ; Save result, recover prefix code
  2392.     CALL    STRPTR        ; Get pointer to prefix entry
  2393.     EX    DE,HL        ; Save it
  2394.     POP    HL        ; Recover new entry pointer
  2395.     DEC    HL        ; Point to low byte of entry
  2396.     LD    (HL),E        ; Store prefix ptr in entry
  2397.     INC    HL        ;  (low byte first)
  2398.     LD    (HL),D        ;  (then high byte, in mid entry byte)
  2399.     INC    HL        ; Point to high byte of new entry
  2400.     POP    AF        ; Recover suffix byte
  2401.     LD    (HL),A        ; Store
  2402.     RET            ; All done
  2403.  
  2404.     PAGE
  2405. ; Hash function for (new-style) crunched files
  2406.  
  2407. ; Note:    "Hash" is of course a misnomer here, since strings are simply
  2408. ;    added to the table sequentially with the newer crunch method.
  2409. ;    This routine's main responsibility is to update the bit-length
  2410. ;    for expected input codes, and to bypass the table entry for
  2411. ;    code 256 (reserved for adaptive reset), at appropriate times.
  2412.  
  2413. NHASH:    LD    A,L        ; Copy low byte of string count in HL
  2414.     DEC    L        ; Get table offset for new entry
  2415.     OR    A        ; But is count a multiple of 256?
  2416.     JR    NZ,STRPTR    ; No, just return the table pointer
  2417.  
  2418.     LD    A,H        ; Copy high byte of count
  2419.     DEC    H        ; Complete double-register decrement
  2420.     LD    DE,STRCT    ; Set to bump string count (bypasses
  2421.     JR    Z,NHASH1    ;  next entry) if exactly 256
  2422.  
  2423.     CP    4096/256    ; Else, is count the full 4K?
  2424. STRMAX    EQU    $-1        ; (Byte to modify max string count test)
  2425.     JR    Z,STRPTR    ; Yes (last table entry), skip
  2426.  
  2427. ; Note the following cute test.  (It's mentioned in K & R, ex. 2-9.)
  2428.  
  2429.     AND    H        ; Is count a power-of-two?
  2430.     JR    NZ,STRPTR    ; No, skip
  2431.  
  2432.     LD    DE,BITS        ; Yes, next input code is one bit longer
  2433.  
  2434. ; Note:    By definition, there can be no input code residue at this point.
  2435. ;    I.e. (BITSAV) = 0, since we have read a power-of-two (> 256) no.
  2436. ;    of codes at the old length (total no. of bits divisible by 8).
  2437. ;    By the same argument, (CODES) = 0 modulo 8 (see NGETCR).
  2438.  
  2439. NHASH1:    EX    DE,HL        ; Swap in address value to increment
  2440.     INC    (HL)        ; Bump the value (STRCT or BITS)
  2441.     EX    DE,HL        ; Recover table offset
  2442.  
  2443. ; Get pointer to string table entry
  2444.  
  2445. ; This routine is input a 12-bit code in HL (or -1 for the null string).
  2446. ; It returns a pointer in HL to the middle byte of the string table
  2447. ; entry for that code (STRT-2 for the null string).  Destroys DE only.
  2448.  
  2449. STRPTR:    LD    D,H        ; Copy code
  2450.     LD    E,L
  2451.     ADD    HL,HL        ; Get 2 * code
  2452.     ADD    HL,DE        ; Get 3 * code
  2453.     LD    DE,STRT+1    ; Point to table base entry (2nd byte)
  2454.     ADD    HL,DE        ; Compute pointer
  2455.     RET            ; Return
  2456.  
  2457.     PAGE
  2458. ; Get variable-length code from (new-style) crunched file
  2459.  
  2460.     .COMMENT |
  2461.  
  2462. These codes are packed in right-to-left order (lsb first).  The code
  2463. length (stored in BITS) begins at 9 bits and increases up to a maximum
  2464. of 12 bits (13 bits for squashed files) as the string table grows
  2465. (maintained by NHASH).  Location BITSAV holds residue bits remaining in
  2466. the last input byte after each call (must be initialized to 0, code
  2467. assumes BITSAV = BITS-1).
  2468.  
  2469. In comparison, the MS-DOS ARC program buffers 8 codes at a time (i.e.
  2470. n bytes, where n = bits/code) and flushes this buffer whenever the code
  2471. length changes (so that first code at new length begins on an even byte
  2472. boundary).  By coincidence (see NHASH) this buffer is always empty when
  2473. the code length increases as a result of normal string table growth.
  2474. Thus the only time this added bufferring affects us is when the code
  2475. length is reset back to 9 bits upon receipt of the special clear
  2476. request (code 256), at which time we must possibly bypass up to 10
  2477. input bytes (worst case = 7 codes at 1.5 bytes/code).  This is handled
  2478. by a simple down-counter in location CODES, whose mod-8 value indicates
  2479. the no. of codes which should be skipped (must be initialized to 0,
  2480. code assumes that CODES = BITSAV-1). |
  2481.  
  2482. ; Note:    This can probably be made a lot faster (e.g. by unfolding into
  2483. ;    8 separate cases and using a co-routine return), but that's a
  2484. ;    lot of work.  For now, we KISS ("keep it short and simple").
  2485.  
  2486. NGETCR:    LD    HL,CODES    ; First update code counter
  2487.     DEC    (HL)        ;  for clear code processing
  2488.     INC    HL        ; Point to BITSAV
  2489.     LD    A,(HL)        ; Get saved residue bits
  2490.     INC    HL        ; Point to BITS
  2491.     LD    B,(HL)        ; Setup bit counter for new code
  2492.     LD    HL,7FFFH    ; Init code (msb reset for end detect)
  2493.  
  2494. ; Top of loop for next input bit
  2495.  
  2496. NGETC1:    SRL    A        ; Shift out next input bit
  2497.     JR    Z,NGETC7    ; But skip out if new byte needed
  2498.  
  2499. NGETC2:    RR    H        ; Shift bit into high end of code word
  2500.     RR    L        ;  (double-register shift)
  2501.     DJNZ    NGETC1        ; Loop until have all bits needed
  2502.  
  2503. ; Input complete, cleanup code word
  2504.  
  2505. NGETC3:    SRL    H        ; Shift code down,
  2506.     RR    L        ;  to right-justify it in HL
  2507.     JR    C,NGETC3    ; Loop until end flag shifted out
  2508.  
  2509.     LD    (BITSAV),A    ; Save input residue for next call
  2510.     LD    A,H        ; But is it code 256?
  2511.     DEC    A        ; (i.e. adaptive reset request)
  2512.     OR    L
  2513.     RET    NZ        ; No, return (carry clear)
  2514.  
  2515. ; Special handling to reset string table upon receipt of clear code
  2516.  
  2517.     LD    HL,BITS        ; Point to BITS
  2518.     LD    C,(HL)        ; Fetch current code length
  2519.     LD    (HL),9        ; Go back to 9-bit codes
  2520.     DEC    HL        ; Point to BITSAV
  2521.     LD    (HL),A        ; Empty the residue buffer
  2522.     DEC    HL        ; Point to CODES
  2523.     LD    A,(HL)        ; Get code counter
  2524.     AND    7        ; Modulo 8 is no. codes to flush
  2525.     JR    Z,NGETC6    ; Skip if none
  2526.  
  2527. ; Note:    It's a shame we have to do this at all.  With a minor change in
  2528. ;    its implementation, the MS-DOS ARC program could have simply
  2529. ;    shuffled down its buffer and avoided wasting up to 10 bytes in
  2530. ;    the crunched file (not to mention a lot of unnecessary effort).
  2531.  
  2532. ; Note:    Prior to UNARC 1.4, the following coding was simplified by the
  2533. ;    (incorrect) assumption that 12-bit codes are being generated at
  2534. ;    this point.  While true for .ARC files created by ARC 5.12 or
  2535. ;    earlier, this is not necessarily the case for files created by
  2536. ;    PKARC 1.1 or later.  Hence, some added effort here now...
  2537.  
  2538.     LD    B,A        ; Save no. codes to flush
  2539.     XOR    A        ; Reset no. bits to flush
  2540.     LD    (HL),A        ; Reset code counter to 0 for next time
  2541.  
  2542. NGETC4:    ADD    A,C        ; Add no. bits per code
  2543.     DJNZ    NGETC4        ; Loop to compute total bits to flush
  2544.  
  2545.     RRA            ; Divide by 8
  2546.     RRA
  2547.     RRA
  2548.     AND    0FH        ; Max possible result 10 (11 squashed)
  2549.     LD    B,A        ; Obtain no. input bytes to bypass
  2550.  
  2551. NGETC5:    PUSH    BC        ; Loop to flush the (encoder's) buffer
  2552.     CALL    GETCX
  2553.     EXX            ; (No need to test for end-of-file
  2554.     POP    BC        ;  here, we'll pick it up later if
  2555.     DJNZ    NGETC5        ;  it happens)
  2556.  
  2557. NGETC6:    LD    HL,STRT+(3*256)    ; Clear out (all but one-byte) strings
  2558.     LD    BC,STRSZ-(3*256)-1
  2559. STRCSZ    EQU    $-1        ; (Byte to modify string tbl clear size)
  2560.     CALL    STRTCL
  2561.     LD    HL,257        ; Reset count for just one-byte strings
  2562.     LD    (STRCT),HL    ;  plus the unused entry
  2563.  
  2564. ; Kludge:  We rely here on the fact that the previous input code is at
  2565. ;    top of caller's stack, where -1 indicates none.  This should
  2566. ;    properly be done by the caller, but doing it here preserves
  2567. ;    commonality of coding for old-style crunched files (i.e. caller
  2568. ;    never knows this happened).
  2569.  
  2570.     POP    HL        ; Get return address
  2571.     EX    (SP),HL        ; Exchange with top of (caller's) stack
  2572.     LD    HL,-1        ; Set no previous code
  2573.     EX    (SP),HL        ; Replace on stack
  2574.     PUSH    HL        ; Restore return
  2575.     JR    NGETCR        ; Go again for next input code
  2576.  
  2577. ; Read next input byte
  2578.  
  2579. NGETC7:    PUSH    BC        ; Save bit count
  2580.     PUSH    HL        ; Save partial code
  2581.     CALL    GETCX        ; Get next input byte
  2582.     EXX            ; Save output regs
  2583.     POP    HL        ; Restore code
  2584.     POP    BC        ; Restore count
  2585.     RET    C        ; But stop if reached end of file
  2586.  
  2587. ; Special test to speed things up a bit...
  2588. ; (If need the whole byte, might as well save some bit fiddling)
  2589.  
  2590.     BIT    3,B        ; At least 8 more bits needed?
  2591.     JR    NZ,NGETC8    ; Yes, go do it faster
  2592.  
  2593.     SCF            ; Else, set flag for end-of-byte detect
  2594.     RRA            ; Shift out first bit of new byte
  2595.     JR    NGETC2        ; Go back to bit-shifting loop
  2596.  
  2597. ; Update code by (entire) new byte
  2598.  
  2599. NGETC8:    LD    L,H        ; Shift code down 8 bits
  2600.     LD    H,A        ; Insert new byte into code
  2601.     LD    A,B        ; Get bit count
  2602.     SUB    8        ; Reduce by 8
  2603.     LD    B,A        ; Update remaining count
  2604.     JR    NZ,NGETC7    ; Get another byte if still more needed
  2605.  
  2606.     JR    NGETC3        ; Else, go exit early (note A=0)
  2607.  
  2608.     PAGE
  2609. ; Hash functions for (old-style) crunched files
  2610.  
  2611. ; This stuff exists for the sole purpose of processing files which were
  2612. ; created by older releases of MS-DOS ARC (pre-version 5.0).  To quote
  2613. ; that program's author:  "Please note how much trouble it can be to
  2614. ; maintain upwards compatibility."  Amen!
  2615.  
  2616. ; Note:    The multiplications required by the two hash function versions
  2617. ;    are sufficiently specialized that we've hand-coded each of them
  2618. ;    separately, for speed, rather than use a common multiply
  2619. ;    subroutine.
  2620.  
  2621. ; Versions 5 and 6...
  2622. ; Compute hash key = upper 12 of lower 18 bits of unsigned square of:
  2623. ;    (prefix code + suffix byte) OR 800H
  2624.  
  2625. ; Note:    I'm sure there's a faster way to do this, but I didn't want to
  2626. ;    exert myself unduly for an obsolete crunching method.
  2627.  
  2628. OHASH:    LD    DE,0        ; Clear product
  2629.     LD    L,A        ; Extend suffix byte
  2630.     LD    H,D        ;  to 16 bits
  2631.     ADD    HL,BC        ; Sum with prefix code
  2632.     SET    3,H        ; Or in 800H
  2633.  
  2634. ; We now have a 13-bit number which is to be squared, but we are only
  2635. ; interested in the lower 18 bits of the 26-bit product.  The following
  2636. ; reduces this to a 12-bit multiply which yields the correct product
  2637. ; shifted right 2 bits.  This is acceptable (we discard the low 6 bits
  2638. ; anyway) and allows us to compute desired result in a 16-bit register.
  2639.  
  2640. ; For the algebraically inclined...
  2641. ;   If n is even (n = 2m + 0):  n * n = 4(m * m)
  2642. ;   If n is odd  (n = 2m + 1):  n * n = 4(m * (m+1)) + 1
  2643.  
  2644.     SRA    H        ; Divide number by 2 (i.e. "m")
  2645.     RR    L        ; HL will be multiplicand (m or m+1)
  2646.     LD    C,H        ; Copy to multiplier in C (high byte)
  2647.     LD    A,L        ;  and A (low byte)
  2648.     ADC_HL    DE        ; If was odd, add 1 to multiplicand
  2649.  
  2650. ; Note there is one anomalous case:  The first one-byte string (with
  2651. ; prefix = -1 = 0FFFFH and suffix = 0) generates the 16-bit sum 0FFFFH,
  2652. ; which should hash to 800H (not 0).  The following test handles this.
  2653.  
  2654.     JR    C,OHASH3    ; Skip if special case (will get 800H)
  2655.     LD    B,12        ; Setup count for 12 bits in multiplier
  2656.  
  2657. ; Top of multiply loop (vanilla shift-and-add)
  2658.  
  2659. OHASH1:    SRL    C        ; Shift out next multiplier bit
  2660.     RRA
  2661.     JR    NC,OHASH2    ; Skip if 0
  2662.  
  2663.     EX    DE,HL        ; Else, swap in product
  2664.     ADD    HL,DE        ; Add multiplicand (carries ignored)
  2665.     EX    DE,HL        ; Reswap
  2666.  
  2667. OHASH2:    ADD    HL,HL        ; Shift multiplicand
  2668.     DJNZ    OHASH1        ; Loop until done all multiplier bits
  2669.  
  2670. ; Now have the desired hash key in upper 12 bits of the 16-bit product
  2671.  
  2672.     EX    DE,HL        ; Obtain product in HL
  2673.     ADD    HL,HL        ; Shift high bit into carry
  2674.  
  2675. OHASH3:    RLA            ; Shift up 4 bits into A...
  2676.     ADD    HL,HL
  2677.     RLA
  2678.     ADD    HL,HL
  2679.     RLA
  2680.     ADD    HL,HL
  2681.     RLA
  2682.     LD    L,H        ; Move down low 8 bits of final result
  2683.     JR    HASH        ; Join common code to mask high 4 bits
  2684.  
  2685. ; Version 7 (faster)...
  2686. ; Compute hash key = lower 12 bits of unsigned product:
  2687. ;    (prefix code + suffix byte) * 15073
  2688.  
  2689. FHASH:    LD    L,A        ; Extend suffix byte
  2690.     LD    H,0        ;  to 16 bits
  2691.     ADD    HL,BC        ; Sum with prefix code
  2692.  
  2693. ; Note:    15073 = 2785 mod 4096, so we need only multiply by 2785.
  2694.  
  2695.     LD    D,H        ; Copy sum, and compute in HL:
  2696.     LD    E,L        ;    1 * sum
  2697.     ADD    HL,HL        ;    2 * sum
  2698.     ADD    HL,HL        ;    4 * sum
  2699.     ADD    HL,DE        ;    5 * sum
  2700.     ADD    HL,HL        ;   10 * sum
  2701.     ADD    HL,HL        ;   20 * sum
  2702.     ADD    HL,DE        ;   21 * sum
  2703.     ADD    HL,HL        ;   42 * sum
  2704.     ADD    HL,DE        ;   43 * sum
  2705.     ADD    HL,HL        ;   86 * sum
  2706.     ADD    HL,DE        ;   87 * sum
  2707.     ADD    HL,HL        ;  174 * sum
  2708.     ADD    HL,HL        ;  348 * sum
  2709.     ADD    HL,HL        ;  696 * sum
  2710.     ADD    HL,HL        ; 1392 * sum
  2711.     ADD    HL,HL        ; 2784 * sum
  2712.     ADD    HL,DE        ; 2785 * sum
  2713.     LD    A,H        ; Setup high byte of result
  2714.  
  2715. ; Common code for old-style hashing
  2716.  
  2717. HASH:    AND    0FH        ; Mask hash key to 12 bits
  2718.     LD    H,A
  2719.     PUSH    HL        ; Save key as trial string table index
  2720.     CALL    STRPTR        ; Point to string table entry
  2721.     POP    DE        ; Restore its index
  2722.     LD    A,(HL)        ; Is table entry used?
  2723.     OR    A
  2724.     RET    Z        ; No (that was easy), return table ptr
  2725.  
  2726. ; Hash collision occurred.  Trace down list of entries with duplicate
  2727. ; keys (in auxilliary table HSHT) until the last duplicate is found.
  2728.  
  2729.     LD    BC,HSHT        ; Setup collision table base
  2730.     PUSH    HL        ; Create dummy stack level
  2731.  
  2732. HASH1:    POP    HL        ; Discard last index
  2733.     EX    DE,HL        ; Get next trial index
  2734.     PUSH    HL        ; Save it
  2735.     ADD    HL,HL        ; Get ptr to collision table entry
  2736.     ADD    HL,BC
  2737.     LD    E,(HL)        ; Fetch entry
  2738.     INC    HL
  2739.     LD    D,(HL)
  2740.     LD    A,D        ; Is it zero?
  2741.     OR    E
  2742.     JR    NZ,HASH1    ; No, loop for next in chain
  2743.  
  2744. ; We now have the index (top of stack) and pointer (HL) for the last
  2745. ; entry in the duplicate key list.  In order to find an empty spot for
  2746. ; the new string, we search the string table sequentially starting 101
  2747. ; (circular) entries past that of the last duplicate.
  2748.  
  2749.     EX    (SP),HL        ; Save collision ptr, swap its index
  2750.     LD    E,101        ; Move 101 entries past it
  2751.     ADD    HL,DE
  2752.  
  2753. HASH2:    RES    4,H        ; Mask table index to 12 bits
  2754.     PUSH    HL        ; Save index
  2755.     CALL    STRPTR        ; Point to string table entry
  2756.     POP    DE        ; Restore its index
  2757.     LD    A,(HL)        ; Fetch byte from entry
  2758.     OR    A        ; Is it empty?
  2759.     JR    Z,HASH3        ; Yes, found a spot in table
  2760.  
  2761.     EX    DE,HL        ; Else,
  2762.     INC    HL        ; Bump index to next entry
  2763.     JR    HASH2        ; Loop until we find one free
  2764.  
  2765. ; We now have the index (DE) and pointer (HL) for an available entry
  2766. ; in the string table.  We just need to add the index to the chain of
  2767. ; duplicates for this hash key, and then return the pointer to caller.
  2768.  
  2769. HASH3:    EX    (SP),HL        ; Swap ptr to last duplicate key entry
  2770.     LD    (HL),D        ; Add this index to duplicate chain
  2771.     DEC    HL
  2772.     LD    (HL),E
  2773.     POP    HL        ; Recover string table ptr
  2774.     RET            ; Return it to caller
  2775.  
  2776.     PAGE
  2777. ; Get fixed-length code from (old-style) crunched file
  2778.  
  2779. ; These codes are packed in left-to-right order (msb first).  Two codes
  2780. ; fit in three bytes, so we alternate processing every other call based
  2781. ; on a rotating flag word in BITS (initialized to 55H).  Location BITSAV
  2782. ; holds the middle byte between calls (coding assumes BITSAV = BITS-1).
  2783.  
  2784. OGETCR:    CALL    GETCX        ; Get next input byte
  2785.     EXX            ; Save output regs
  2786.     RET    C        ; Return (carry set) if end of file
  2787.  
  2788.     LD    E,A        ; Copy byte (high or low part of code)
  2789.     LD    HL,BITS        ; Point to rotating bit pattern
  2790.     RRC    (HL)        ; Rotate it
  2791.     JR    C,OGETC1    ; Skip if this is high part of code
  2792.  
  2793.     DEC    HL        ; Point to saved byte from last call
  2794.     LD    A,(HL)        ; Fetch saved byte
  2795.     AND    0FH        ; Mask low nibble (high 4 bits of code)
  2796.     EX    DE,HL        ; Get new byte in L (low 8 bits of code)
  2797.     LD    H,A        ; Form 12-bit code in HL
  2798.     RET            ; Return (carry clear from mask)
  2799.  
  2800. OGETC1:    PUSH    DE        ; Save byte just read (high 8 code bits)
  2801.     CALL    GETCX        ; Get next byte
  2802.     EXX            ; Save output regs
  2803.     POP    HL        ; Restore previous byte in L
  2804.     RET    C        ; But return if eof
  2805.  
  2806.     LD    (BITSAV),A    ; Save new byte for next call
  2807.     AND    0F0H        ; Mask high nibble (low 4 bits of code)
  2808.     RLA            ; Rotate once through carry
  2809.     LD    H,A        ; Set for circular rotate of HL & carry
  2810.     REPT    4
  2811.     ADC_HL    HL        ;;Form the 12-bit code
  2812.     ENDM
  2813.     RET            ; Return (carry clear after last rotate)
  2814.  
  2815. ; Output next byte decoded from crunched file
  2816.  
  2817. PUTCR:    EXX            ; Swap in output registers
  2818.     JP    0        ; Vector to the appropriate routine
  2819. PUTCRP    EQU    $-2        ; (ptr to PUT or PUTUP stored here)
  2820.  
  2821.     PAGE
  2822. ; Low-level output routines
  2823.  
  2824. ; Register usage (once things get going):
  2825. ;
  2826. ;  B  = Flag for repeated byte expansion (1 = repeat count expected)
  2827. ;  C  = Last byte output (saved for repeat expansion)
  2828. ;  DE = Output buffer pointer
  2829. ;  HL = CRC value
  2830.  
  2831. ; Setup registers for output (preserves AF)
  2832.  
  2833. PUTSET:    LD    HL,(BUFPAG-1)    ; Get buffer start address
  2834.     LD    L,0        ; (It's always page aligned)
  2835.     EX    DE,HL
  2836.     LD    H,E        ; Clear the CRC
  2837.     LD    L,E
  2838.     LD    B,E        ; Clear repeat flag
  2839.     RET            ; Return
  2840.  
  2841. ; Table of starting output buffer pages
  2842. ; (No. of entries must match ARCVER)
  2843.  
  2844. OBUFT:                ; Header version:
  2845.     DB    HIGH BUFF    ; 1 - Uncompressed (obsolete)
  2846.     DB    HIGH BUFF    ; 2 - Uncompressed
  2847.     DB    HIGH BUFF    ; 3 - Packed
  2848.     DB    HIGH BUFFSQ    ; 4 - Squeezed
  2849.     DB    HIGH BUFFCX    ; 5 - Crunched (unpacked) (old)
  2850.     DB    HIGH BUFFCX    ; 6 - Crunched (packed) (old)
  2851.     DB    HIGH BUFFCX    ; 7 - Crunched (packed, faster) (old)
  2852.     DB    HIGH BUFFCR    ; 8 - Crunched (new)
  2853.     DB    HIGH BUFFCQ    ; 9 - Squashed
  2854.  
  2855.     PAGE
  2856. ; Unpack and output packed byte
  2857.  
  2858. PUTUP:    DJNZ    PUTUP4        ; Expecting a repeat count?
  2859.     LD    B,A        ; Yes ("byte REP count"), save count
  2860.     OR    A        ; But is it zero?
  2861.     JR    NZ,PUTUP2    ; No, enter expand loop (did one before)
  2862.  
  2863.     LD    A,REP        ; Else ("REP 0"),
  2864.     JR    PUT        ; Go output REP code as data
  2865.  
  2866. PUTUP1:    LD    A,C        ; Get repeated byte
  2867.     CALL    PUT        ; Output it
  2868.  
  2869. PUTUP2:    DJNZ    PUTUP1        ; Loop until repeat count exhausted
  2870.     RET            ; Return when done
  2871.  
  2872. PUTUP3:    INC    B        ; Set flag for repeat count next
  2873.     RET            ; Return (must wait for next call)
  2874.  
  2875. PUTUP4:    INC    B        ; Normal byte, reset repeat flag
  2876.     CP    REP        ; But is it the special flag code (REP)?
  2877.     JR    Z,PUTUP3    ; Yes, go wait for next byte
  2878.  
  2879.     LD    C,A        ; Save output byte for later repeat
  2880.  
  2881. ; Output byte (and update CRC)
  2882.  
  2883. PUT:    LD    (DE),A        ; Store byte in buffer
  2884.     XOR    L        ; Include byte in lower CRC
  2885.     LD    L,A        ;  to get lookup table index
  2886.     LD    A,H        ; Save high (becomes new low) CRC byte
  2887.     LD    H,HIGH CRCTAB    ; Point to table value low byte
  2888.     XOR    (HL)        ; Include in CRC
  2889.     INC    H        ; Point to table value high byte
  2890.     LD    H,(HL)        ; Fetch to get new high CRC byte
  2891.     LD    L,A        ; Copy new low CRC byte
  2892.  
  2893.     INC    E        ; Now that CRC updated, bump buffer ptr
  2894.     RET    NZ        ; Return if not end of page
  2895.  
  2896.     INC    D        ; Point to next buffer page
  2897.     LD    A,(BUFLIM)    ; Get buffer limit page
  2898.     CP    D        ; Buffer full?
  2899.     RET    NZ        ; No, return
  2900.  
  2901.     PAGE
  2902. ; Output buffer
  2903.  
  2904. PUTBUF:    PUSH    HL        ; Save register (i.e. CRC)
  2905.     LD    HL,(BUFPAG-1)    ; Get buffer start address
  2906.     XOR    A        ; (it's always page-aligned)
  2907.     LD    L,A
  2908.     EX    DE,HL        ; Swap with buffer end ptr
  2909.     SBC_HL    DE        ; Compute buffer length
  2910.     JR    Z,PUTB2        ; But skip all the work if it's empty
  2911.  
  2912.     PUSH    BC        ; Save register (i.e. repeat flag/byte)
  2913.     LD    B,H        ; Copy buffer length
  2914.     LD    C,L
  2915.     LD    HL,(LEN)    ; Get (remaining) output file length
  2916.     SBC_HL    BC        ; Subtract size of buffer
  2917.     LD    (LEN),HL    ; (Should be zero when we're all done)
  2918.     JR    NC,PUTB1    ; Skip if double-precision not needed
  2919.  
  2920.     LD    HL,(LEN+2)    ; Update upper word of length
  2921.     DEC    HL
  2922.     LD    (LEN+2),HL
  2923.  
  2924. PUTB1:    PUSH    DE        ; Save buffer start
  2925.     CALL    WRTBUF        ; Write the buffer
  2926.     POP    DE        ; Reset output ptr for next refill
  2927.     POP    BC        ; Restore register
  2928.  
  2929. PUTB2:    POP    HL        ; Restore register
  2930.     RET            ; Return to caller
  2931.  
  2932.     PAGE
  2933. ; Write buffer to disk
  2934.  
  2935. WRTBUF:    LD    A,(OFLAG)    ; Output file open?
  2936.     OR    A
  2937.     JR    Z,TYPBUF    ; No, go typeout buffer instead
  2938.  
  2939.     LD    H,D        ; Get buffer end ptr
  2940.     LD    L,E
  2941.     ADD    HL,BC
  2942.     JR    WRTB2        ; Enter loop
  2943.  
  2944. WRTB1:    LD    (HL),CTLZ    ; Fill last record with CP/M EOF...
  2945.     INC    HL
  2946.     INC    BC
  2947.  
  2948. WRTB2:    LD    A,L        ; Buffer ends on a CP/M record boundary?
  2949.     AND    7FH
  2950.     JR    NZ,WRTB1    ; No, loop until it does
  2951.  
  2952.     OR    B        ; At least one page to write?
  2953.     JR    Z,WRTB4        ; Skip if not
  2954.  
  2955. WRTB3:    PUSH    BC        ; Save remaining byte count
  2956.     CALL    WRTREC        ; Output 2 records to disk (i.e. 1 page)
  2957.     CALL    WRTREC        ; (Note returns A=0 as expected below)
  2958.     POP    BC        ; Restore count
  2959.     DJNZ    WRTB3        ; Loop for all (full) pages in buffer
  2960.  
  2961. WRTB4:    OR    C        ; Half-page left?
  2962.     RET    Z        ; No, return
  2963.  
  2964. ; Write record to disk
  2965.  
  2966. WRTREC:    LD    HL,128        ; Get CP/M record length
  2967.     ADD    HL,DE        ; Add buffer ptr
  2968.     PUSH    HL        ; Save next record start
  2969.     CALL    SETDMA        ; Set to write from buffer ptr
  2970.     LD    C,$WRITE    ; Write a record to output file
  2971.     CALL    OFDOS
  2972.     POP    DE        ; Restore ptr for next call
  2973.     DEC    A        ; Write error?
  2974.     RET    Z        ; No, return
  2975.  
  2976.     LD    DE,DSKFUL    ; Disk is full, report error
  2977.     JP    PABORT        ;  and abort
  2978.  
  2979.     PAGE
  2980. ; Typeout buffer
  2981.  
  2982. TYPBUF:    LD    A,(CHECKF)    ; Just checking file?
  2983.     OR    A
  2984.     RET    NZ        ; Yes, ignore buffer
  2985.  
  2986.     LD    A,(PROUTF)    ; Printer output enabled?
  2987.     OR    A
  2988.     JR    NZ,PRTBUF    ; Yes, go print buffer instead
  2989.  
  2990. ; Note:    The file typeout facility was originally added to this program
  2991. ;    as an afterthought.  The primitive nature of this facility has
  2992. ;    been enhanced considerably with the addition of screen pauses in
  2993. ;    UNARC 1.4.  Areas for future improvement include intelligent
  2994. ;    handling of screen width and terminal characteristics.
  2995.  
  2996. TYPB0:    LD    A,(DE)        ; Fetch next byte from buffer
  2997.     CP    CTLZ        ; Is it CP/M end-of-file?
  2998.     JP    Z,EXIT        ; Yes, exit program early
  2999.  
  3000.     PUSH    BC        ; Save remaining byte count
  3001.     INC    A        ; Bump ASCII code (simplifies DEL test)
  3002.     AND    7FH        ; Mask to 7 bits
  3003.     CP    ' '+1        ; Is it a printable char?
  3004.     DEC    A        ; (Restore code)
  3005.     JR    C,TYPB3        ; Skip if non-printable
  3006.  
  3007. TYPB1:    CALL    PCHAR        ; Type char
  3008.  
  3009. TYPB2:    INC    DE        ; Bump ptr to next byte
  3010.     POP    BC        ; Restore byte count
  3011.     DEC    BC        ; Reduce count
  3012.     LD    A,B        ; Done all bytes?
  3013.     OR    C
  3014.     JR    NZ,TYPB0    ; No, loop for next
  3015.     RET            ; Yes, return to caller
  3016.  
  3017. TYPB3:    CP    HT        ; Is (non-printing) char a tab?
  3018.     JR    Z,TYPB1        ; Yes, go type it
  3019.     JR    C,TYPB2        ; But ignore if low control char
  3020.     CP    CR        ; Does char generate a new line?
  3021.     JR    NC,TYPB2    ; No, ignore control char (incl. CR)
  3022.  
  3023.     CALL    CRLF        ; Yes (LF/VT/FF), start a new line
  3024.     PUSH    DE        ; Save buffer ptr
  3025.     CALL    CABORT        ; Good place to check for CTRL-C abort
  3026.     POP    DE        ; Restore ptr
  3027.     LD    HL,LINCT    ; Point to line count
  3028.     INC    (HL)        ; Bump for one more line
  3029.     JR    Z,TYPB2        ; But skip if 256 (must be no limit)
  3030.  
  3031.     LD    A,(TYLIM)    ; Get max allowed lines
  3032.     CP    (HL)        ; Reached limit (e.g. for RCP/M)?
  3033.     JR    NZ,TYPB2    ; No, go back to typeout loop
  3034.     CALL    WHLCK        ; But is wheel byte set?
  3035.     JR    Z,TYPB2        ; Yes, do not enforce limit
  3036.  
  3037.     LD    DE,TYPERR    ; Else, report too many lines
  3038.     JP    PABORT        ;  and abort
  3039.  
  3040.     PAGE
  3041. ; Print buffer
  3042.  
  3043. ; This added in UNARC 1.41 as a quick hack to allow printing of
  3044. ; highly-compressed binary plot images.  It may not be suitable for
  3045. ; general text file listing.  (In particular, CTRL-Z is not treated
  3046. ; as a file terminator.)
  3047.  
  3048. PRTBUF:    EX    DE,HL        ; Buffer ptr -> HL
  3049.  
  3050. PRTB1:    LD    E,(HL)        ; Fetch next byte from buffer
  3051.     PUSH    HL        ; Save buffer ptr
  3052.     PUSH    BC        ; Save remaining byte count
  3053.     LD    C,$LIST        ; Print byte (on listing device)
  3054.     CALL    BDOS
  3055.     CALL    CABORT        ; Check for CTRL-C abort
  3056.     POP    BC        ; Restore byte count
  3057.     POP    HL        ; Restore ptr
  3058.     INC    HL        ; Bump to next byte in buffer
  3059.     DEC    BC        ; Reduce count
  3060.     LD    A,B        ; Done all bytes?
  3061.     OR    C
  3062.     JR    NZ,PRTB1    ; No, loop for next
  3063.  
  3064.     RET            ; Yes, return to caller
  3065.  
  3066.     PAGE
  3067.     SUBTTL    Listing Routines
  3068.  
  3069. ; List file information
  3070.  
  3071. LIST:    LD    HL,(TFILES)    ; Get total files so far
  3072.     LD    A,H        ; Test if this is first file
  3073.     OR    L
  3074.     INC    HL        ; Add one more
  3075.     LD    (TFILES),HL    ; Update total files
  3076.     CALL    Z,LTITLE    ; If first file, list column titles
  3077.  
  3078.     LD    DE,SIZE        ; Point to compressed file size
  3079.     PUSH    DE        ; Save for later
  3080.     LD    HL,TSIZE    ; Update total compressed size
  3081.     CALL    LADD
  3082.  
  3083.     LD    DE,LEN        ; Point to uncompressed length
  3084.     PUSH    DE        ; Save for later
  3085.     LD    HL,TLEN        ; Update total length
  3086.     CALL    LADD
  3087.  
  3088.     LD    HL,LINE        ; Setup listing line pointer
  3089.     LD    DE,OFCB+@FN    ; List file name from output FCB
  3090.     LD    C,0        ; (with blank fill)
  3091.     CALL    LNAME
  3092.  
  3093.     POP    DE        ; Recover file length ptr
  3094.     PUSH    DE        ; Save again for factor calculation
  3095.     CALL    LTODA        ; List file length
  3096.     CALL    LDISK        ; Compute and list disk space
  3097.     CALL    LSTOW        ; List stowage method and version
  3098.     POP    BC        ; Restore uncompressed length ptr
  3099.     POP    DE        ; Restore compressed size ptr
  3100.     CALL    LSIZE        ; List size and compression factor
  3101.     LD    A,(DATE)    ; Check for valid file date
  3102.     OR    A        ; (This anticipates no-date CP/M files)
  3103.     JR    NZ,LIST1    ; Skip if valid
  3104.  
  3105.     LD    B,18        ; Else, clear out date and time fields
  3106.     CALL    FILLB
  3107.     JR    LIST2        ; Skip
  3108.  
  3109. LIST1:    CALL    LDATE        ; List file date
  3110.     CALL    LTIME        ; List file time
  3111.  
  3112. LIST2:    CALL    LCRC        ; List CRC value
  3113.  
  3114.     PAGE
  3115. ; Terminate and print listing line
  3116.  
  3117. LISTL:    LD    DE,LINE        ; Setup listing line ptr
  3118.     JR    LIST3        ; Go finish up and list it
  3119.  
  3120. ; List file totals
  3121.  
  3122. LISTT:    LD    HL,LINE        ; Setup listing line ptr
  3123.     LD_DE    (TFILES)    ; List total files
  3124.     CALL    WTODA
  3125.     LD    DE,TLEN        ; List total file length
  3126.     PUSH    DE        ;  and save ptr for factor calculation
  3127.     CALL    LTODA
  3128.     LD_DE    (TDISK)        ; List total disk space
  3129.     CALL    LDISK1
  3130.     LD    B,13        ; Fill next columns with blanks
  3131.     CALL    FILLB
  3132.     POP    BC        ; Recover total uncompressed length ptr
  3133.     LD    DE,TSIZE    ; Get total compressed size ptr
  3134.     CALL    LSIZE        ; List overall size, compression factor
  3135.     LD    B,20        ; Fill next columns with blanks
  3136.     CALL    FILLB
  3137.     LD_DE    (TCRC)        ; List sum of all CRC values
  3138.     CALL    WHEX
  3139.     LD    DE,TOTALS    ; Point to totals string (precedes line)
  3140.  
  3141. LIST3:    LD    (HL),0        ; Terminate listing line
  3142.     JR    PRINTL        ; Go print it, followed by new line
  3143.  
  3144. ; Print character
  3145.  
  3146. PCHAR:    CP    BEL        ; Is it a noisy one?
  3147.     JR    NZ,PCHAR1    ; No, skip
  3148.     LD    HL,BELLS    ; Yes, is silence desired?
  3149.     AND    (HL)
  3150.     RET    Z        ; Yes, keep quiet
  3151.  
  3152. PCHAR1:    PUSH    DE        ; Save register
  3153.  
  3154. PCHAR2:    LD    E,A        ; Setup char
  3155.     DEC    A        ; But is it special program name marker?
  3156.     JR    Z,PNAME        ; Yes, go insert name
  3157.  
  3158.     LD    C,$CONOUT    ; Send to BDOS console output
  3159.     CALL    BDOS
  3160.     POP    DE        ; Restore register
  3161.     RET            ; Return
  3162.  
  3163. ; Print program name string, followed by blank
  3164.  
  3165. PNAME:    LD    DE,USAGE    ; Point to name string in help message
  3166.  
  3167. PNAME1:    LD    A,(DE)        ; Reached trailing blank?
  3168.     CP    ' '
  3169.     JR    Z,PCHAR2    ; Yes, back to PCHAR to print it
  3170.  
  3171.     CALL    PCHAR        ; Print name char
  3172.     INC    DE        ; Point to next
  3173.     JR    PNAME1        ; Loop until blank delimiter
  3174.  
  3175. ; Print string on new line, then start another
  3176.  
  3177. PRINTX:    CALL    CRLF
  3178.  
  3179. ; Print string, then start new line
  3180.  
  3181. PRINTL:    CALL    PRINTS
  3182.  
  3183. ; Start new line
  3184. ; Note:    Must preserve DE
  3185.  
  3186. CRLF:    LD    A,CR
  3187.     CALL    PCHAR
  3188.     LD    A,LF
  3189.     CALL    PCHAR
  3190.  
  3191.     LD    HL,LPSCT    ; Reached end of screen?
  3192.     DEC    (HL)
  3193.     RET    NZ        ; No, return
  3194.  
  3195.     LD    A,0        ; But are screen pauses enabled?
  3196. LPS    EQU    $-1        ; (lines per screen = 0 if not)
  3197.     OR    A
  3198.     RET    Z        ; No, return
  3199.  
  3200.     LD    (HL),A        ; Reset count of lines left
  3201.     PUSH    DE        ; Save register
  3202.     LD    DE,MORE        ; Print '[more]' on the new line
  3203.     CALL    PRINTS
  3204.  
  3205. CRLF1:    CALL    CABORT        ; Wait for char (or ^C abort)
  3206.     JR    Z,CRLF1
  3207.  
  3208.     PUSH    AF        ; Save input response
  3209.     LD    DE,NOMORE    ; Blank out the '[more]' line
  3210.     CALL    PRINTS
  3211.     POP    AF        ; Restore response
  3212.     POP    DE        ; Restore register
  3213.     XOR    ' '        ; Was response the space bar?
  3214.     RET    NZ        ; Anything else scrolls another screen
  3215.  
  3216.     INC    A        ; Yes, set to pause after one more line
  3217.     LD    (LPSCT),A
  3218.     RET            ; Return
  3219.  
  3220.     PAGE
  3221. ; Print string on new line
  3222.  
  3223. ; Note:    Restricted to at most 5 stack levels (c.f. CHECK).  CRLF will
  3224. ;    not perform page pause during this restriction, but PCHAR will
  3225. ;    execute PNAME (during ABOMSG print), so we're now at the limit!
  3226.  
  3227. PRINT:    CALL    CRLF
  3228.  
  3229. ; Print NUL-terminated string
  3230.  
  3231. PRINTS:    LD    A,(DE)
  3232.     OR    A
  3233.     RET    Z
  3234.  
  3235.     CALL    P,PCHAR        ; (Ignore help msg chars with MSB set)
  3236.     INC    DE
  3237.     JR    PRINTS
  3238.  
  3239. ; Output warning message about extracted file
  3240.  
  3241. OWARN:    PUSH    DE
  3242.     LD    DE,WARN
  3243.     CALL    PRINTS
  3244.     POP    DE
  3245.     JR    PRINTL
  3246.  
  3247.     PAGE
  3248. ; List column titles
  3249.  
  3250. ; Note:    This saves some much-needed space, by using the same template
  3251. ;    to generate the title line and the 'equal signs' separator line.
  3252.  
  3253. LTITLE:    CALL    CRLF
  3254.     LD    DE,TITLES
  3255.     PUSH    DE
  3256.     LD    A,(DE)
  3257.  
  3258. LTITL1:    CP    '='        ; For titles, convert '=' to blank
  3259.     JR    NZ,LTITL2
  3260.     LD    A,' '
  3261.  
  3262. LTITL2:    CALL    PCHAR
  3263.     INC    DE
  3264.     LD    A,(DE)
  3265.     OR    A
  3266.     JR    NZ,LTITL1
  3267.  
  3268.     POP    DE
  3269.     CALL    CRLF
  3270.  
  3271. LTITL3:    LD    A,(DE)
  3272.     OR    A
  3273.     JR    Z,CRLF
  3274.  
  3275.     CP    ' '        ; Separator converts non-blank to '='
  3276.     JR    Z,LTITL4
  3277.     LD    A,'='
  3278.  
  3279. LTITL4:    CALL    PCHAR
  3280.     INC    DE
  3281.     JR    LTITL3
  3282.  
  3283.     PAGE
  3284. ; List file name
  3285.  
  3286. ; Note:    We use name in output file FCB, rather than original name in
  3287. ;    archive header (illegal chars already filtered by GETNAM).
  3288. ;    This routine also called by INIT to unparse ARC file name.
  3289.  
  3290. LNAME:    LD    B,12        ; Setup count for name, '.', and type
  3291.  
  3292. LNAME1:    LD    A,B        ; Get count
  3293.     CP    4        ; At end of name?
  3294.     LD    A,'.'
  3295.     JR    Z,LNAME2    ; Yes, go store separator
  3296.  
  3297.     LD    A,(DE)        ; Get next char
  3298.     INC    DE
  3299.     CP    C        ; Ignore blanks (possibly)
  3300.     JR    Z,LNAME3
  3301.  
  3302. LNAME2:    LD    (HL),A        ; Store char
  3303.     INC    HL
  3304.  
  3305. LNAME3:    DJNZ    LNAME1        ; Loop for all chars in name and type
  3306.     RET            ; Return to caller
  3307.  
  3308.     PAGE
  3309. ; Compute and list disk space for uncompressed file
  3310.  
  3311. LDISK:    PUSH    HL        ; Save line ptr
  3312.     LD    HL,(LEN)    ; Convert file length to 1k disk space
  3313.     LD    A,(LEN+2)    ; (Most we can handle here is 16 Mb)
  3314.     LD    DE,1023        ; First, round up to next 1k
  3315.     ADD    HL,DE
  3316.     ADC    A,0
  3317.     RRA            ; Now, shift to divide by 1k
  3318.     RR    H
  3319.     RRA
  3320.     RR    H
  3321.     AND    3FH
  3322.     LD    L,H        ; Result -> HL
  3323.     LD    H,A
  3324.     LD    A,(LBLKSZ)    ; Get disk block size
  3325.     DEC    A        ; Round up result accordingly
  3326.     LD    E,A
  3327.     LD    D,0
  3328.     ADD    HL,DE
  3329.     CPL            ; Form mask for lower bits
  3330.     AND    L
  3331.     LD    E,A        ; Final result -> DE
  3332.     LD    D,H
  3333.     LD    HL,(TDISK)    ; Update total disk space used
  3334.     ADD    HL,DE
  3335.     LD    (TDISK),HL
  3336.     POP    HL        ; Restore line ptr
  3337.  
  3338. LDISK1:    CALL    WTODA        ; List result
  3339.     LD    (HL),'k'
  3340.     INC    HL
  3341.     RET
  3342.  
  3343.     PAGE
  3344. ; List stowage method and version
  3345.  
  3346. LSTOW:    CALL    FILL2B        ; Blanks first
  3347.     EX    DE,HL
  3348.     LD    HL,STOWTX    ; Point to stowage text table
  3349.     LD    A,(VER)        ; Get header version no.
  3350.     PUSH    AF        ; Save for next column
  3351.     LD    BC,8        ; Use to get correct text ptr
  3352.     CP    3
  3353.     JR    C,LSTOW1
  3354.     ADD    HL,BC
  3355.     JR    Z,LSTOW1
  3356.     ADD    HL,BC
  3357.     CP    4
  3358.     JR    Z,LSTOW1
  3359.     ADD    HL,BC
  3360.     CP    9
  3361.     JR    C,LSTOW1
  3362.     ADD    HL,BC
  3363.     JR    Z,LSTOW1
  3364.     ADD    HL,BC
  3365.  
  3366. LSTOW1:    LDIR            ; List stowage text
  3367.     EX    DE,HL        ; Restore line ptr
  3368.     POP    AF        ; Recover version no.
  3369.  
  3370. LSTOW2:    LD    B,3        ; List in 3 cols, blank-filled
  3371.     JP    BTODB        ;  and return
  3372.  
  3373.     PAGE
  3374. ; List compressed file size and compression factor
  3375.  
  3376. LSIZE:    PUSH    DE        ; Save compressed size ptr
  3377.     PUSH    BC        ; Save uncompressed length ptr
  3378.     CALL    LTODA        ; List compressed size
  3379.     POP    DE        ; Recover length ptr
  3380.     EX    (SP),HL        ; Save line ptr, recover size ptr
  3381.  
  3382. ; Compute compression factor = 100 - [100*size/length]
  3383. ; (HL = ptr to size, DE = ptr to length, A = result)
  3384.  
  3385.     PUSH    DE        ; Save length ptr
  3386.     CALL    LGET        ; Get BCDE = size
  3387.     LD    H,B        ; Compute 100*size
  3388.     LD    L,C        ;  in HLIX:
  3389.     PUSH    DE
  3390.     POP_IX            ;     size
  3391.     ADD_IX    IX
  3392.     ADC_HL    HL        ;   2*size
  3393.     ADD_IX    DE
  3394.     ADC_HL    BC        ;   3*size
  3395.     ADD_IX    IX
  3396.     ADC_HL    HL        ;   6*size
  3397.     ADD_IX    IX
  3398.     ADC_HL    HL        ;  12*size
  3399.     ADD_IX    IX
  3400.     ADC_HL    HL        ;  24*size
  3401.     ADD_IX    DE
  3402.     ADC_HL    BC        ;  25*size
  3403.     ADD_IX    IX
  3404.     ADC_HL    HL        ;  50*size
  3405.     ADD_IX    IX
  3406.     ADC_HL    HL        ; 100*size
  3407.     EX    (SP),HL        ; Swap back length ptr, save upper
  3408.     CALL    LGET        ; Get BCDE = length
  3409.     PUSH_IX
  3410.     POP    HL        ; Now have (SP),HL = 100*size
  3411.     LD    A,B        ; Length = 0?
  3412.     OR    C        ; (Unlikely, but possible)
  3413.     OR    D
  3414.     OR    E
  3415.     JR    Z,LSIZE2    ; Yes, go return result = 0
  3416.  
  3417.     LD    A,101        ; Initialize down counter for result
  3418.  
  3419. LSIZE1:    DEC    A        ; Divide by successive subtractions
  3420.     SBC_HL    DE
  3421.     EX    (SP),HL
  3422.     SBC_HL    BC
  3423.     EX    (SP),HL
  3424.     JR    NC,LSIZE1    ; Loop until remainder < length
  3425.  
  3426. LSIZE2:    POP    HL        ; Clean stack
  3427.     POP    HL        ; Restore line ptr
  3428.     CALL    BTODA        ; List the factor
  3429.     LD    (HL),'%'
  3430.     INC    HL
  3431.     RET            ; Return
  3432.  
  3433.     PAGE
  3434. ; List file creation date
  3435.  
  3436. ; ARC files use MS-DOS 16-bit date format:
  3437. ;
  3438. ; Bits [15:9] = year - 1980
  3439. ; Bits  [8:5] = month of year
  3440. ; Bits  [4:0] = day of month
  3441. ;
  3442. ; (All zero means no date, checked before call to this routine)
  3443.  
  3444. LDATE:    LD    A,(DATE)    ; Get date
  3445.     AND    1FH        ; List day
  3446.     CALL    BTODA
  3447.     LD    (HL),' '    ; Then a blank
  3448.     INC    HL
  3449.     EX    DE,HL        ; Save listing line ptr
  3450.     LD    HL,(DATE)    ; Get date again
  3451.     PUSH    HL        ; Save for listing year (in upper byte)
  3452.     ADD    HL,HL        ; Shift month into upper byte
  3453.     ADD    HL,HL
  3454.     ADD    HL,HL
  3455.     LD    A,H        ; Get month
  3456.     AND    0FH
  3457.     CP    13        ; Make sure it's valid
  3458.     JR    C,LDATE1
  3459.     XOR    A        ; (Else will show as "???")
  3460. LDATE1:    LD    C,A        ; Use to index to 3-byte string table
  3461.     LD    B,0
  3462.     LD    HL,MONTX
  3463.     ADD    HL,BC
  3464.     ADD    HL,BC
  3465.     ADD    HL,BC
  3466.     LD    C,3
  3467.     LDIR            ; Move month text into listing line
  3468.     EX    DE,HL        ; Restore line ptr
  3469.     LD    (HL),' '    ; Then a blank
  3470.     INC    HL
  3471.     POP    AF        ; Recover high byte of date
  3472.     SRL    A        ; Get 1980-relative year
  3473.     ADD    A,80        ; Get true year in century
  3474.  
  3475. LDATE2:    LD    BC,256*2+'0'    ; Setup for 2 digits with high-zero fill
  3476.     JR    BTOD        ;  and convert binary to decimal ASCII
  3477.  
  3478.     PAGE
  3479. ; List file creation time
  3480.  
  3481. ; ARC files use MS-DOS 16-bit time format:
  3482. ;
  3483. ; Bits [15:11] = hour
  3484. ; Bits [10:5]  = minute
  3485. ; Bits  [4:0]  = second/2 (not shown here)
  3486.  
  3487. LTIME:    EX    DE,HL        ; Save listing line ptr
  3488.     LD    HL,(TIME)    ; Fetch time
  3489.     LD    A,H        ; Copy high byte
  3490.     RRA            ; Get hour
  3491.     RRA
  3492.     RRA
  3493.     AND    1FH
  3494.     LD    B,'a'        ; Assume am
  3495.     JR    Z,LTIME1    ; Skip if 0 (12 midnight)
  3496.  
  3497.     CP    12        ; Is it 1-11 am?
  3498.     JR    C,LTIME2    ; Yes, skip
  3499.  
  3500.     LD    B,'p'        ; Else, it's pm
  3501.     SUB    12        ; Convert to 12-hour clock
  3502.     JR    NZ,LTIME2    ; Skip if not 12 noon
  3503.  
  3504. LTIME1:    LD    A,12        ; Convert 0 to 12
  3505.  
  3506. LTIME2:    PUSH    BC        ; Save am/pm indicator
  3507.     ADD    HL,HL        ; Shift minutes up to high byte
  3508.     ADD    HL,HL
  3509.     ADD    HL,HL
  3510.     PUSH    HL        ; Save minutes
  3511.     EX    DE,HL        ; Recover listing line ptr
  3512.     CALL    LSTOW2        ; List hour
  3513.     LD    (HL),':'    ; Then ":"
  3514.     INC    HL
  3515.     POP    AF        ; Restore and list minutes
  3516.     AND    3FH
  3517.     CALL    LDATE2
  3518.     POP    AF        ; Restore and list am/pm letter
  3519.     LD    (HL),A
  3520.     INC    HL
  3521.     RET            ; Return
  3522.  
  3523.     PAGE
  3524. ; List hex CRC value
  3525.  
  3526. LCRC:    CALL    FILL2B
  3527.     LD_DE    (CRC)
  3528.     PUSH    HL
  3529.     LD    HL,(TCRC)    ; Update CRC total
  3530.     ADD    HL,DE
  3531.     LD    (TCRC),HL
  3532.     POP    HL
  3533.  
  3534. ; List hex word in DE
  3535.  
  3536. WHEX:    CALL    DHEX
  3537.     LD    D,E
  3538.  
  3539. ; List hex byte in D
  3540.  
  3541. DHEX:    LD    (HL),D
  3542.     RLD
  3543.     CALL    AHEX
  3544.     LD    A,D
  3545.  
  3546. ; List hex nibble in A
  3547.  
  3548. AHEX:    OR    0F0H
  3549.     DAA
  3550.     CP    60H
  3551.     SBC    A,1FH
  3552.     LD    (HL),A
  3553.     INC    HL
  3554.     RET
  3555.  
  3556. ; A few decimal ASCII conversion callers, for convenience
  3557.  
  3558. WTODA:    LD    B,5        ; List blank-filled word in 5 cols
  3559. WTODB:    LD    C,' '        ; List blank-filled word in B cols
  3560.     JR    WTOD        ; List C-filled word in B cols
  3561.  
  3562. BTODA:    LD    B,4        ; List blank-filled byte in 4 cols
  3563. BTODB:    LD    C,' '        ; List blank-filled byte in B cols
  3564.     JR    BTOD        ; List C-filled byte in B cols
  3565.  
  3566. LTODA:    LD    BC,9*256+' '    ; List blank-filled long in 9 cols
  3567. ;    JR    LTOD
  3568.  
  3569.     PAGE
  3570. ; Convert Long (or Word or Byte) Binary to Decimal ASCII
  3571. ; R. A. Freed
  3572. ; 2.0    15 Mar 85
  3573.  
  3574. ; Entry:    A  = Unsigned 8-bit byte value (BTOD)
  3575. ;        DE = Unsigned 16-bit word value (WTOD)
  3576. ;        DE = Pointer to low byte of 32-bit long value (LTOD)
  3577. ;        B  = Max. string length (0 implies 256, i.e. no limit)
  3578. ;        C  = High-zero fill (0 to suppress high-zero digits)
  3579. ;        HL = Address to store ASCII byte string
  3580. ;
  3581. ; Return:    HL = Adress of next byte after last stored
  3582. ;
  3583. ; Stack:    n+1 levels, where n = no. significant digits in output
  3584. ;
  3585. ; Notes:    If B > n, (B-n) leading fill chars (C non-zero) stored.
  3586. ;        If B < n, high-order (n-B) digits are suppressed.
  3587. ;        If only word or byte values need be converted, use the
  3588. ;         shorter version of this routine (WTOD or BTOD) instead.
  3589.  
  3590. RADIX    EQU    10        ; (Will work with any radix <= 10)
  3591.  
  3592. LTOD:    PUSH    DE        ; Entry for 32-bit long pointed to by DE
  3593.     EXX            ; Save caller's regs, swap in alt set
  3594.     POP    HL        ; Get pointer and fetch value to HADE
  3595.     LD    E,(HL)
  3596.     INC    HL
  3597.     LD    D,(HL)
  3598.     INC    HL
  3599.     LD    A,(HL)
  3600.     INC    HL
  3601.     LD    H,(HL)
  3602.     EX    DE,HL        ; Value now in DAHL
  3603.     JR    LTOD1        ; Join common code
  3604.  
  3605. BTOD:    LD    E,A        ; Entry for 8-bit byte in A
  3606.     LD    D,0        ; Copy to 16-bit word in DE
  3607.  
  3608. WTOD:    PUSH    DE        ; Entry for 16-bit word in DE, save it
  3609.     EXX            ; Swap in alt regs for local use
  3610.     POP    HL        ; Recover value in HL
  3611.     XOR    A        ; Set to clear upper bits in DE
  3612.     LD    D,A
  3613.  
  3614. ; Common code for all entries
  3615.  
  3616. LTOD1:    LD    E,A        ; Now have 32-bit value in DEHL
  3617.     LD    C,RADIX        ; Setup radix for divides
  3618.     SCF            ; Set first-time flag
  3619.     PUSH    AF        ; Save for stack emptier when done
  3620.  
  3621.     PAGE
  3622. ; Top of conversion loop
  3623.  
  3624. ; Method:  Generate output digits on stack in reverse order.  Each loop
  3625. ; divides the value by the radix.  Remainder is the next output digit,
  3626. ; quotient becomes the dividend for the next loop.  Stop when get zero
  3627. ; quotient or no. of digits = max. string length.  (Always generates at
  3628. ; least one digit, i.e. zero value has one "significant" digit.)
  3629.  
  3630. LTOD2:    CALL    DIVLB        ; Divide to get next digit
  3631.     OR    '0'        ; Convert to ASCII (clears carry)
  3632.     EXX            ; Swap in caller's regs
  3633.     DJNZ    LTOD5        ; Skip if still more room in string
  3634.  
  3635. ; All done (value fills string), this is the output loop
  3636.  
  3637. LTOD3:    LD    (HL),A        ; Store digit in string
  3638.     INC    HL        ; Bump string ptr
  3639.  
  3640. LTOD4:    POP    AF        ; Unstack next digit
  3641.     JR    NC,LTOD3    ; Loop if any
  3642.  
  3643.     RET            ; Return to caller
  3644.  
  3645. ; Still more room in string, test if more significant digits
  3646.  
  3647. LTOD5:    PUSH    AF        ; Stack this digit
  3648.     EXX            ; Swap back local regs
  3649.     LD    A,H        ; Last quotient = 0?
  3650.     OR    L
  3651.     OR    D
  3652.     OR    E
  3653.     JR    NZ,LTOD2    ; No, loop for next digit
  3654.  
  3655. ; Can stop early (no more digits), handle leading zero-fill (if any)
  3656.  
  3657.     EXX            ; Swap back caller's regs
  3658.     OR    C        ; Any leading fill wanted?
  3659.     JR    Z,LTOD4        ; No, go to output loop
  3660.  
  3661. LTOD6:    LD    (HL),A        ; Store leading fill
  3662.     INC    HL        ; Bump string ptr
  3663.     DJNZ    LTOD6        ; Repeat until fill finished
  3664.     JR    LTOD4        ; Then go store the digits
  3665.  
  3666.     PAGE
  3667.     SUBTTL    Miscellaneous Support Routines
  3668.  
  3669. ; Note:    The following general-purpose routine is currently used in this
  3670. ;    program only to divide longs by 10 (by decimal convertor, LTOD).
  3671. ;    Thus, a few unneeded code locations have been commented out.
  3672. ;    (May be restored if program requirements change.)
  3673.  
  3674. ; Unsigned Integer Division of Long (or Word or Byte) by Byte
  3675. ; R. A. Freed
  3676.  
  3677. ; Divisor in C, dividend in (A)DEHL or (A)HL or L (depends on call used)
  3678. ; Quotient returned in DEHL (or just HL), remainder in A
  3679.  
  3680. ;DIVXLB:OR    A        ; 40-bit dividend in ADEHL (A < C)
  3681. ;    JR    NZ,DIVLB1    ; Skip if have more than 32 bits
  3682.  
  3683. DIVLB:    LD    A,D        ; 32-bit dividend in DEHL
  3684.     OR    E        ; But is it really only 16 bits?
  3685.     JR    Z,DIVWB        ; Yes, skip (speeds things up a lot)
  3686.  
  3687.     XOR    A        ; Clear high quotient for first divide
  3688.  
  3689. DIVLB1:    CALL    DIVLB2        ; Get upper quotient first, then swap:
  3690. DIVLB2:    EX    DE,HL        ; Upper quotient in DE, lower in HL
  3691.  
  3692. DIVXWB:    OR    A        ; 24-bit dividend in AHL (A < C)
  3693.     JR    NZ,DIVWB1    ; Skip if have more than 16 bits
  3694.  
  3695. DIVWB:    LD    A,H        ; 16-bit dividend in HL
  3696.     CP    C        ; Will quotient be less than 8 bits?
  3697.     JR    C,DIVBB1    ; Yes, skip (small dividend speed-up)
  3698.  
  3699.     XOR    A        ; Clear high quotient
  3700.  
  3701. DIVWB1:    LD    B,16        ; Setup count for 16-bit divide
  3702.     JR    DIVB        ; Skip to divide loop
  3703.  
  3704. ;DIVBB:    XOR    A        ; 8-bit dividend in L
  3705. DIVBB1:    LD    H,L        ; For very small nos., pre-shift 8 bits
  3706.     LD    L,0        ; High byte of quotient will be zero
  3707.     LD    B,8        ; Setup count for 8-bit divide
  3708.  
  3709. ; Top of divide loop (vanilla in-place shift-and-subtract)
  3710.  
  3711. DIVB:    ADD    HL,HL        ; Divide AHL (B=16) or AH (B=8) by C
  3712.     RLA            ; Shift out next remainder bit
  3713. ;    JR    C,DIVB1        ; (This needed only for divsors > 128)
  3714.     CP    C        ; Greater than divisor?
  3715.     JR    C,DIVB2        ; No, skip (next quotient bit is 0)
  3716.  
  3717. DIVB1:    SUB    C        ; Yes, reduce remainder
  3718.     INC    L        ;  and set quotient bit to 1
  3719.  
  3720. DIVB2:    DJNZ    DIVB        ; Loop for no. bits in quotient
  3721.     RET            ; Done (quotient in HL, remainder in A)
  3722.  
  3723.     PAGE
  3724. ; Fetch a long (4-byte) value
  3725.  
  3726. LGET:    LD    E,(HL)        ; Fetch BCDE from (HL)
  3727.     INC    HL
  3728.     LD    D,(HL)
  3729.     INC    HL
  3730.     LD    C,(HL)
  3731.     INC    HL
  3732.     LD    B,(HL)
  3733.     RET
  3734.  
  3735. ; Add two longs
  3736.  
  3737. LADD:    LD    B,4        ; (DE) + (HL) -> (HL)
  3738.     OR    A
  3739.  
  3740. LADD1:    LD    A,(DE)
  3741.     ADC    A,(HL)
  3742.     LD    (HL),A
  3743.     INC    HL
  3744.     INC    DE
  3745.     DJNZ    LADD1
  3746.  
  3747.     RET
  3748.  
  3749. ; Fill routines
  3750.  
  3751. FILL2B:    LD    B,2        ; Fill 2 blanks
  3752.  
  3753. FILLB:    LD    C,' '        ; Fill B blanks
  3754.  
  3755. FILL:    LD    (HL),C        ; Fill B bytes with char in C
  3756.     INC    HL
  3757.     DJNZ    FILL
  3758.  
  3759.     RET
  3760.  
  3761. ; Convert character to upper case
  3762.  
  3763. UPCASE:    CP    'a'
  3764.     RET    C
  3765.     CP    'z'+1
  3766.     RET    NC
  3767.  
  3768.     ADD    A,'A'-'a'
  3769.     RET
  3770.  
  3771.     PAGE
  3772. IF NOT Z80
  3773.  
  3774. ; EXX instruction emulator
  3775.  
  3776. EXX:
  3777.     IRP    AA,<HL,DE,BC>
  3778.     PUSH    AA
  3779.     LD    HL,(AA&SAV)
  3780.     EX    (SP),HL
  3781.     LD    (AA&SAV),HL
  3782.     ENDM
  3783.     POP    BC
  3784.     POP    DE
  3785.     POP    HL
  3786.     RET
  3787.  
  3788. ; LDIR instruction emulator
  3789.  
  3790. LDIR:    PUSH    AF
  3791.  
  3792. LDIR1:    LD    A,(HL)
  3793.     LD    (DE),A
  3794.     INC    HL
  3795.     INC    DE
  3796.     DEC    BC
  3797.     LD    A,B
  3798.     OR    C
  3799.     JP    NZ,LDIR1
  3800.  
  3801.     POP    AF
  3802.     RET
  3803.  
  3804. ; CPIR instruction emulator
  3805.  
  3806. CPIR1:    POP    AF
  3807.  
  3808. CPIR:    CP    (HL)
  3809.     INC    HL
  3810.     DEC    BC
  3811.     RET    Z
  3812.  
  3813.     PUSH    AF
  3814.     LD    A,B
  3815.     OR    C
  3816.     JP    NZ,CPIR1
  3817.  
  3818.     POP    AF
  3819.     RET
  3820.  
  3821. ENDIF
  3822.     PAGE
  3823.     SUBTTL    Messages and Initialized Data
  3824.  
  3825. IF Z80
  3826. NOTZ80:    DB    BEL,'Z80 required!$'
  3827. ELSE
  3828. USEZ80:    DB    'NOTE: The Z80 version is smaller and faster!',CR,LF,'$'
  3829. ENDIF
  3830. ABOMSG:    DB    BEL,1,'aborted!',0
  3831. CPMERR:    DB    'CP/M version 2 or higher required',0
  3832. NOROOM:    DB    'Not enough memory',0
  3833. NAMERR:    DB    'Ambiguous archive file name',0
  3834. OPNERR:    DB    'Cannot find archive file',0
  3835. FMTERR:    DB    'Invalid archive file format',0
  3836. HDRERR:    DB    BEL,'Warning: Bad archive file header, bytes skipped = '
  3837. HDRSKP:    DB    '00000',0
  3838. NOFILS:    DB    'No matching file(s) in archive',0
  3839. BADIDR:    DB    'Invalid archive file drive',0
  3840. BADODR:    DB    'Invalid output drive',0
  3841. ARCMSG:    DB    'Archive File = '
  3842. ARCNAM:    DB    'FILENAME.ARC',0
  3843. OUTMSG:    DB    'Output Drive = '
  3844. OUTDRV:    DB    'A:',0
  3845. CHKMSG:    DB    'Checking archive...',0
  3846. BADVER:    DB    'Cannot extract file (need newer version of UNARC?)',0
  3847. EXISTS:    DB    BEL,'Replace existing output file (y/n)? ',0
  3848. DSKFUL:    DB    'Disk full',0
  3849. DIRFUL:    DB    'Directory full',0
  3850. CLSERR:    DB    'Cannot close output file',0
  3851. UCRERR:    DB    'Incompatible crunched file format',0
  3852. TYPERR:    DB    'Typeout line limit exceeded',0
  3853. WARN:    DB    BEL,'Warning: Extracted file has incorrect ',0
  3854. CRCERR:    DB    'CRC',0
  3855. LENERR:    DB    'length',0
  3856. MORE:    DB    '[more]',0
  3857. NOMORE:    DB    CR,'       ',HT,CR,0
  3858.  
  3859. ; Note:    Tab (HT) added above in UNARC 1.5 for proper following tab
  3860. ;    expansion (since CP/M 2.2 BDOS does not reset its column
  3861. ;    position after raw CR output).  The blanks are still generated
  3862. ;    in case of BDOS implementations which do not expand tabs.
  3863.  
  3864. MONTX:    DB    '???JanFebMarAprMayJunJulAugSepOctNovDec'
  3865.  
  3866. STOWTX:    DB    'Unpacked'
  3867.     DB    ' Packed '
  3868.     DB    'Squeezed'
  3869.     DB    'Crunched'
  3870.     DB    'Squashed'
  3871.     DB    'Unknown!'
  3872.  
  3873. TITLES:    DB    'Name========  =Length  Disk  =Method= Ver =Stored Save'
  3874.     DB    'd ===Date== =Time=  CRC='
  3875. LINLEN    EQU    $-TITLES
  3876.     DB    0
  3877.  
  3878. TOTALS:    DB    '        ====  =======  ====               =======  ==='
  3879.     DB    '                    ===='
  3880.     DB    CR,LF
  3881.     DB    'Total  '    ; (LINE must follow!)
  3882.  
  3883. ; .COM file ends here (except for non-Z80 self-unpacking startup code)
  3884.  
  3885. COMLEN    EQU    $-TBASE        ; Length of initialized code and data
  3886.  
  3887.     PAGE
  3888.     SUBTTL    Data Storage
  3889.  
  3890. ; Unitialized data last (does not contribute to .COM file size)
  3891.  
  3892. ; Note:    Following macro introduced in UNARC 1.5 to avoid use of the
  3893. ;    assembler DS directive, which generates unneeded records in the
  3894. ;    .COM file when linked with L80 (unlike SLRNK).  (Also preserves
  3895. ;    location counter for self-unpacking initialization code in the
  3896. ;    non-Z80 version.)
  3897.  
  3898. DSS    MACRO    SYM,BYTES
  3899. SYM    EQU    $D
  3900. $D    DEFL    $D+(BYTES)
  3901.     ENDM
  3902.  
  3903. $D    DEFL    $        ; Start of data storage (pseudo PC)
  3904.     DSS    LINE,LINLEN+1    ; Listing line buffer (follow TOTALS!)
  3905.  
  3906. $D    DEFL    $D+(25*2)    ; Program stack (25 levels)
  3907. STACK    EQU    $D        ; (Too small will only garbage listing)
  3908.  
  3909. TOTS    EQU    $D        ; Start of listing totals
  3910.     DSS    TFILES,2    ;  Total files processed
  3911.     DSS    TLEN,4        ;  Total uncompressed bytes
  3912.     DSS    TDISK,2        ;  Total 1K disk blocks
  3913.     DSS    TSIZE,4        ;  Total compressed bytes
  3914.     DSS    TCRC,2        ;  Total of all CRC values
  3915.     DSS    LINCT,1        ; Line count for file typeout
  3916.     DSS    ARKFLG,1    ; Default file type flag (allows .ARC)
  3917.     DSS    PROUTF,1    ; Printer output flag
  3918.     DSS    CHECKF,1    ; Check archive validity flag
  3919. TOTC    EQU    $D-TOTS        ; Count of bytes to clear
  3920.  
  3921.     DSS    GETPTR,2    ; Input buffer pointer
  3922.     DSS    LPSCT,1        ; Lines per screen counter
  3923.     DSS    LBLKSZ,1    ; Disk allocation block size for listing
  3924.     DSS    TNAME,11    ; Test pattern for selecting file names
  3925.     DSS    OFCB,@FCBSZ    ; Output file FCB
  3926. ;    DSS    IFCB,@FCBSX    ; Input file FCB
  3927. IFCB    EQU    DFCB        ; (Currently using default FCB instead)
  3928.  
  3929. HDRBUF    EQU    $D        ; Archive file header buffer...
  3930.     DSS    VER,1        ; Header version no. (stowage type)
  3931.     DSS    NAME,13        ; Name string (NUL-terminated)
  3932.     DSS    SIZE,4        ; Compressed bytes
  3933.     DSS    DATE,2        ; Creation date
  3934.     DSS    TIME,2        ; Creation time
  3935.     DSS    CRC,2        ; Cyclic check of uncompressed file
  3936.     DSS    LEN,4        ; Uncompressed bytes (version > 1)
  3937. HDRSIZ    EQU    $D-HDRBUF    ; Header size (4 less if version = 1)
  3938.  
  3939. IF NOT Z80
  3940.  
  3941. ; Data for Z80 instruction emulation
  3942.  
  3943.     DSS    HLSAV,2        ; HL'
  3944.     DSS    DESAV,2        ; DE'
  3945.     DSS    BCSAV,2        ; BC'
  3946.     DSS    AFSAV,2        ; AF'
  3947.     DSS    IXSAV,2        ; IX
  3948.  
  3949. ENDIF
  3950.  
  3951. MINMEM    EQU    $D-1        ; Min memory limit (no file output)
  3952.  
  3953.     PAGE
  3954. ; Data for file output processing only
  3955.  
  3956.                 ; Following order required:
  3957.     DSS    BUFPAG,1    ;  Output buffer start page
  3958.     DSS    BUFLIM,1    ;  Output buffer limit page
  3959.  
  3960.                 ; Following order required:
  3961.     DSS    CODES,1        ;  Code count for crunched input
  3962.     DSS    BITSAV,1    ;  Bits save for crunched input
  3963.     DSS    BITS,1        ;  Bit count for crunched input
  3964.  
  3965.     DSS    STRCT,2        ; No. entries in crunched string table
  3966.  
  3967. ; Tables and buffers for file output
  3968. ; (All of the following must be page-aligned)
  3969.  
  3970. $D    DEFL    ($D+255) AND 0FF00H ; Align to page boundary
  3971.  
  3972.     DSS    CRCTAB,256*2    ; CRC lookup table (256 2-byte values)
  3973.  
  3974. BUFF    EQU    $D        ; Output buff for non-squeezed/crunched
  3975.  
  3976.                 ; or:
  3977.  
  3978. TREE    EQU    $D        ; Decoding tree for squeezed files
  3979. TREESZ    EQU    256*4        ; (256 4-byte nodes)
  3980. BUFFSQ    EQU    TREE+TREESZ    ; Output buffer for squeezed files
  3981.  
  3982.                 ; or:
  3983.  
  3984. STRT    EQU    $D        ; String table for crunched files
  3985. STRSZ    EQU    4096*3        ; (4K 3-byte entries)
  3986. BUFFCR    EQU    STRT+STRSZ    ; Output buffer for newer crunched files
  3987.  
  3988.                 ; plus (for old-style crunched files):
  3989.  
  3990. HSHT    EQU    BUFFCR        ; Extra table for hash code chaining
  3991. HSHSZ    EQU    4096*2        ; (4K 2-byte entries)
  3992. BUFFCX    EQU    HSHT+HSHSZ    ; Output buffer for older crunched files
  3993.  
  3994.                 ; or (for squashed files):
  3995.  
  3996. STQSZ    EQU    8192*3        ; (8K 3-byte string table entries)
  3997. BUFFCQ    EQU    STRT+STQSZ    ; Output buffer for squashed files
  3998.  
  3999.     PAGE
  4000. IF NOT Z80
  4001.  
  4002. ; Initialization for self-unpacking archive file (non-Z80 version only)
  4003.  
  4004. ; Note:    Following is needed only when UNARCA.COM is executed from a
  4005. ;    self-unpacking archive file.  It is subsequently overlayed by
  4006. ;    data during program execution, so the only additional run-time
  4007. ;    overhead for self-unpacking support is the 26 bytes immediately
  4008. ;    preceding BEGIN.  (The added disk space for this code is also
  4009. ;    minimal, and none of this is included in the Z80-only version,
  4010. ;    UNARC.COM, which applies to the majority of users.)
  4011.  
  4012.     .PHASE    $+26        ; This code is offset 26 bytes in memory
  4013.  
  4014. SELFUP:    LD    C,$DISK        ; Get current default disk drive no.
  4015.     CALL    BDOS        ; (archive file drive)
  4016.     LD    B,A        ; Save default for extracted files
  4017.     ADD    A,'A'        ; Get ASCII drive letter
  4018.     LD    (SELFMD),A    ; Store in archive file name message
  4019.     LD    DE,DFCB        ; Point to default FCB
  4020.     LD    A,(DE)        ; Disk drive specified on command line?
  4021.     OR    A
  4022.     JP    NZ,SELFU1    ; Yes, skip to use it
  4023.  
  4024.     LD    A,B        ; Recover default disk no.
  4025.     INC    A        ; Convert to drive code
  4026.  
  4027. SELFU1:    LD    (SELFXD),A    ; Store drive code for extracted files
  4028.     ADD    A,'A'-1        ; Get ASCII drive letter
  4029.     LD    (SELFCD),A    ; Store in command line
  4030.     LD    HL,SELFCB    ; Point to fixed internal FCB
  4031.     LD    BC,SELFSZ    ; Get no. bytes to move to system page
  4032.     CALL    SELFMV        ; Move down fixed command parameters
  4033.  
  4034.     LD    DE,TBASE    ; Setup normal .COM file base
  4035.     LD    HL,TBASE+26    ; Setup current (offset) base in memory
  4036.     LD    BC,COMLEN    ; Setup .COM file length
  4037.     CALL    SELFMV        ; Relocate .COM file to its proper place
  4038.  
  4039.     LD    (CCPSV),A    ; Force reboot later (and max. buffer)
  4040.     INC    A        ; Set default disk block size to 1K
  4041.     LD    (DBLSZ),A    ; (e.g., might be running CP/M-68K)
  4042.  
  4043.     LD    A,'$'        ; Patch usage message
  4044.     LD    (USEA),A    ;  for program identification
  4045.     LD    (USEB),A    ;  and copyright displays only
  4046.     LD    DE,SELFCR    ; Start with a blank display line
  4047.     CALL    SELFPR
  4048.     LD    DE,USAGE    ; Show program id
  4049.     CALL    SELFPR
  4050.     LD    DE,USEC        ; Show copyright
  4051.     CALL    SELFPR
  4052.     LD    DE,SELFMS    ; Show archive file name (new user aid)
  4053.     CALL    SELFPR
  4054.     JP    BEGIN1        ; Go begin (skip Z80 warning note)
  4055.  
  4056. ; Brute force memory mover (can't use LDIR emulation yet)
  4057.  
  4058. SELFMV:    LD    A,(HL)
  4059.     LD    (DE),A
  4060.     INC    HL
  4061.     INC    DE
  4062.     DEC    BC
  4063.     LD    A,B
  4064.     OR    C
  4065.     JP    NZ,SELFMV
  4066.     RET            ; Return with A = 0
  4067.  
  4068. ; Print message via BDOS (can't use internal print routines yet)
  4069.  
  4070. SELFPR:    LD    C,$PRTSTR
  4071.     JP    BDOS
  4072.  
  4073. ; Fixed FCB's and command line for self-unpacking file extraction
  4074.  
  4075. SELFCB:    DB    0        ; Archive file drive (default always)
  4076.     SELF            ; Archive file name
  4077.     REPT    SELFCB+9-$    ; (pad with blanks to 8 chars)
  4078.     DB    ' '
  4079.     ENDM
  4080.     DB    'COM'        ; Archive file type (always .COM)
  4081.     DB    0,0,0,0        ; Extent descriptor bytes
  4082.  
  4083. SELFXD:    DB    0        ; Drive code for file extraction
  4084.     DB    '           '    ; Files to extract (defaults to *.*)
  4085.     DB    0,0,0,0        ; Extent descriptor bytes
  4086.     DB    0,0,0,0        ; Current and random record nos.
  4087.  
  4088.     DB    SELFCE-SELFCL    ; Command line length (moves to DBUF)
  4089. SELFCL:    DB    ' '        ; Command line tail...
  4090.     SELF
  4091.     DB    '.COM '        ; (e.g. ' UNARC15.COM A: N')
  4092. SELFCD:    DB    'A: N'        ; (extract all files, no screen pauses)
  4093. SELFCE:    DB    0        ; (end of command line)
  4094.  
  4095. SELFSZ    EQU    $-SELFCB    ; Size of fixed command data to move
  4096.  
  4097. ; Message naming self-unpacking archive file
  4098.  
  4099. SELFMS:    DB    CR,LF,LF,'(Self-unpacking file '
  4100. SELFMD:    DB    'A:'
  4101.     SELF
  4102.     DB    '.COM)'
  4103. SELFCR:    DB    CR,LF,'$'
  4104.  
  4105.     .DEPHASE
  4106.  
  4107. ; End of special self-unpacking code for non-Z80 version
  4108.  
  4109. ENDIF
  4110.  
  4111. ; That's all, folks!
  4112.  
  4113.     IF    ($ AND 7FH) NE 0
  4114.  
  4115. ; Clear out final record of the .COM file
  4116. ; (Needed only for precise M80/L80 compatibility with Z80ASM/SLRNK)
  4117.  
  4118.     REPT    128-($ AND 7FH)
  4119.     DB    0
  4120.     ENDM
  4121.  
  4122.     ENDIF
  4123.  
  4124.     END    BEGIN
  4125.  type (always .COM)
  4126.     DB    0,0,0,0        ; Exte