home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / arc-lbr / lt31.lbr / LT31.MYC / LT31.MYC
Encoding:
Text File  |  1992-10-10  |  54.9 KB  |  2,007 lines
  1. title    LT31 Types/Extracts/Uncrunch/USQ/UNLZH LBR/Files (15 Dec 1991)
  2. ;
  3. ver    equ    31;        Current version number
  4. ;
  5. ; LT types normal, lzh-encoded, crunched or squeezed files, either directly
  6. ; or from .LBR members.  Wild cards access a series of library members.
  7. ;
  8. ; Recommended Assembler/Linker - SLRMAC and SLRNKP.  Others will work,
  9. ; but normally require a two pass link operation and file truncation
  10. ; to avoid generating useless uninitialized data space in the code file.
  11. ;
  12. ;    SLRMAC LTxx/R
  13. ;    SLRNKP LTxx/N,/A:100,/J,LTxx,UNLZH,UNC,/E
  14. ;
  15. ; For other linkers see the documentation in BUFFERS.  To check your
  16. ; methods first assemble and link this release and compare the object
  17. ; files.  If they are different you do not have the full technique.
  18. ;
  19. ;---------------------------------------------------------------------
  20. ;                 updates
  21. ;
  22. ; 15 Dec 91 Modified as follows to enable assembly with ancient (about 1979)
  23. ;   v31     version of M80 by changing the names of the following symbols which
  24. ;        exceeded 6 characters.  (This will not effect assembly with any
  25. ;        other assembler.)
  26. ;        OLD LABEL  NEW LABEL   OLD LABEL  NEW LABEL   OLD LABEL  NEW LABEL
  27. ;        setnam2    setnm2       setfld1    setfd1      setfld2    setfd2
  28. ;        setfld3    setfd3       setfld4    setfd4      setfld5    setfd5
  29. ;        Also modified routine labelled start: to fix a bug dating from v25
  30. ;        that prevented LT from accepting USER specifications as a SOURCE
  31. ;        of data.  (Many thanks to Roger Warren, Sysop, Elephant's Graveyard
  32. ;        San Diego, California for the suggestions for fixing this problem.)
  33. ;                     Modified by Brian Murphy (BCM)
  34. ;                     Vancouver Kaypro Users Group
  35. ;                     Richmond, British Columbia, Canada
  36. ;                     BBS phone:  (604) 271-5934
  37. ;
  38. ; 17 Jul 91 Incorporated version 2.0 of LZH encoding.  This program is
  39. ;   v30     necessary to decode files encoded with version 2.0 of LZH
  40. ;        compression, but will AUTOMATICALLY handle files encoded with
  41. ;        version 1.x LZH encoding. Added appropriate documentation changes.
  42. ;        Added instruction to reset MSB in output FCBs.
  43. ;        Corrected error message pointer for UNC & UNL errors
  44. ;        (sent garbage to screen).
  45. ;                    -R Warren
  46. ;                     Sysop, Elephant's Graveyard
  47. ;                     San Diego, CA (619)270-3148
  48. ;
  49. ; 02 Sep 89 Added ability to handle LZH-encoded files (extensions
  50. ;   v29     of the form .?Y?).    Added appropriate docs. No functional
  51. ;        changes to the program, otherwise.
  52. ;                    -R Warren
  53. ;                     Sysop, Elephant's Graveyard
  54. ;                     San Diego, CA (619)270-3148
  55. ;
  56. ;
  57. ;        ****     DIATRIBE    ****
  58. ; 18 May 88 Reformatted again, and repaired.  If Mr Hoff wishes to
  59. ;   v28     to reformat this source I wish he would retain such for
  60. ;        his own benefit, and not foul the distributed version.
  61. ;        He ingeniously makes it virtually impossible to detect the
  62. ;        changes made using a text comparator.  If this request is
  63. ;        a problem to him he is welcome to call me at the number 
  64. ;        below.  V27 had totally lost any indication of what file
  65. ;        was being typed, and without a convenient comparison I
  66. ;        had to restore from V25.  Thus V26 changes have been lost.
  67. ;        and I do not know whether V26 or V27 was the problem.
  68. ;        I also request that Mr. Hoff refrain from removing my
  69. ;        comments in the future (I have restored my comments to
  70. ;        version 25 below).    Will all modifiers kindly refrain from
  71. ;        altering the file dates of modules that have not changed.
  72. ;        For example, UNC.REL and UNC.SLR are still the '86 versions.
  73. ;        LBR distributions can use LSETDATE, and ARCs are automatic.
  74. ;        The gain from a large value of REC is miniscule and prevents
  75. ;        use on systems with limited memory.  V28 does not produce
  76. ;        extra lines between extractions to file now, and this was
  77. ;        done with less, not more, code.
  78. ;    
  79. ;        THINGS to be done: Incorporate checksum testing of results;
  80. ;        slave ZCPR linkages to Z3ENV if on ZCPR system (signal
  81. ;        is non-zero environment pointer).  I hope to have a
  82. ;        DOS+/CCP+ version that respects the ENV for wheel/user
  83. ;        levels some time.
  84. ;
  85. ;        If I am mistaken as to the culprit, I apologize for the
  86. ;        vented spleen.        - C.B. Falconer
  87. ;
  88. ; 05/11/88  Rewrote display section when  extracting files to disk.  Was
  89. ;   v27     triple spacing with no tabulation. Was unsightly if library
  90. ;        had more than 1-2 files.  (Still under 5k.)  If TPA is under
  91. ;        48k, might need to change  "REC"  from 128 to 96 or even 64.
  92. ;                    - Irv Hoff, Sysop
  93. ;                      PRACSA Sysop RCPM
  94. ;
  95. ; 04/15/88  When typing a crunched file  with a comment attached, it was
  96. ;   v26     running off the end of the screen, to display the uncrunched
  97. ;        file name with comment.    - Ed Minton
  98. ;                      Columbus, OH
  99. ;
  100. ; 10 Apr 88 Reformatted to my original system, which shows the action
  101. ;  v25        of conditionals clearly.  Someone had reformatted the
  102. ;        entire source, and I suspect the promulgator of a certain
  103. ;        reformatting program.  There is no need to keep conditionals
  104. ;        un-nested, since linking requires a reasonable assembler
  105. ;        (not ASM) anyhow.  Added .OVR type prohibition.
  106. ;        Wheel control is now unified, with a single patch point.
  107. ;        Now organized so that all options are patchable - Set maxusr
  108. ;        to 0ffh to use the ZCPR mxusr value.  Pausecheck on every
  109. ;        character is now an option (useful for Braille).  The 
  110. ;        conditionals should be used only where a smaller object
  111. ;        file is required for some reason, not for configuration.
  112. ;        Space has been reserved for ZCPR addicts (environment).
  113. ;    **  PATCH POINTS HAVE CHANGED (for the last time??!!).
  114. ;        I have also restored some of the "regs affected" comments
  115. ;        which had been removed.  Please update and maintain them,
  116. ;        they greatly ease future modifications.
  117. ;        I have attached a slightly later version of UNC, functionally
  118. ;        identical, but 5 bytes shorter.
  119. ;        I am glad to see many people actively enhancing this.  When
  120. ;        originally released I did not expect it to attain such
  121. ;        popularity.  Too bad it grew over 4k.  Now should add the
  122. ;        checksum tests.
  123. ;                - C.B. Falconer (203) 281-1438
  124. ;
  125. ; 02/18/88  Fixed bug in PARSE4 routine. If no USER AREA specified for
  126. ;   v24     disk output then it defaulted to input file user area rather
  127. ;        than the CURRENT user area. Modified to allow abort during
  128. ;        disk output. Added $U command line option to allow disk
  129. ;        output of squeezed/crunched files WITHOUT unsqueeze/uncrunch.
  130. ;        (see the NOUQZ byte added to the patch area at 103H).
  131. ;        Added REC equate to allow more than one sector in the file
  132. ;        output buffer to reduce wear and tear on floppy drives.
  133. ;                    - Tom Head
  134. ;
  135. ; 08/12/87  Fixed to properly handle 0-length files.  Modified to
  136. ;   v23     check for pause and abort from console after every typed
  137. ;        character rather than at the end of each line.  This was
  138. ;        necessary to prevent loss of data on some very slow
  139. ;        terminals such as the one I use, and to enable the typing
  140. ;        of a file with no linefeeds to be aborted.    Also fixed the
  141. ;        tab expansion routine to work correctly with files con-
  142. ;        taining unusual control characters such as backspace, and
  143. ;        made the "turn up one line" feature more foolproof.
  144. ;                    - Howard Goldstein
  145. ;
  146. ; 07/30/87  Added the long needed ZCPR/ZCMD support of maximum user
  147. ;   v22     area.  When the UZCPR option is set, the page 0 value
  148. ;        will be examined to determine if the requested user area
  149. ;        is within the allowable range.  This is primarily useful
  150. ;        on RCP/M's (but I suspect that is where LT is primarily
  151. ;        used).  Added code to allow overriding the line counter
  152. ;        and user area restrictions when the wheel is active.
  153. ;                    - Gary Inman, Sysop
  154. ;                      West Los Angeles RCP/M
  155. ;
  156. ; 07/21/87  When at a [more] pause, the space bar now turns up one
  157. ;   v21     line at a time.  LTxx is often used on RCPM systems as
  158. ;        their general purpose TYPE.COM program.  This makes it
  159. ;        compatible with UNARC16.  These two  programs are used
  160. ;        in the popular LUX program to type ASCII files in ARC,
  161. ;        ARK or LBR files.  I have always liked this feature in
  162. ;        UNARC16 and decided to add it to LT20.  I believe most
  163. ;        users will find this quite useful and hope CB Falconer
  164. ;        does not mind my adding this feature.  This version is
  165. ;        a little over 4k.  If this makes any problem, just use
  166. ;        an earlier version.     - Irv Hoff, Sysop
  167. ;                      PRACSA RCPM
  168. ;
  169. ; 07/17/87  Able to use wheel byte in conjunction with OUTFLG flag.
  170. ;   v20     One byte added in ddt modifiable area at program start.
  171. ;        WHLFLG and/or WHEEL now tested in conjunction with the
  172. ;        OUTFLG flag eliminating need for two copies of program
  173. ;        when used on a remote system.  Found that it would not
  174. ;        assemble properly using M80/L80 because of YES/NO, now
  175. ;        corrected.    Restored program name, version number, and
  176. ;        author credit. Other minor mods to keep code size <4k.
  177. ;                    - G.F. Reding [72436,45]
  178. ;
  179. ; 06/10/87  Change to only display characters between "[" and "]" in
  180. ;   v19     the header of crunched files as other characters in this
  181. ;        area are reserved.    Removed the redundant "IF NOT UNCR"
  182. ;        (marked ";;;;") following an "ELSE" which prevented LT18
  183. ;        from being assembled in its distributed form. Slight text
  184. ;        changes to keep <4k.    - Steven Greenberg
  185. ;
  186. ; 12/28/86  Allows access to .LBR files > 512k.  Was using CPM 1.4
  187. ;   v18     variety of direct access.  Mods to keep under 4k total.
  188. ;        Should CP/M v1.4 check and refusal.
  189. ;                    - C.B. Falconer
  190. ;
  191. ; 12/13/86  Prevent junk file names on "LT fn.t d:" where fn.t is not
  192. ;   v17     squeezed or crunched. Thanks to Bill Duerr for calling my
  193. ;        attention to this.     Set default "drvsup" to all drives.
  194. ;        Fixed OUTFLF usage when extract false, per Frank Whitman.
  195. ;                    - C.B. Falconer
  196. ;
  197. ; 11/24/86  Using UNC module, executable on 8080.   Can extract all
  198. ;   v16     files to disk. Needed because NULU 1.51 cannot uncrunch
  199. ;        during extractions.  Disk extraction ignores "BADTBL".
  200. ;        For RCPM use, assemble with the "extract" equate set to
  201. ;        NO.  Clean-ups.        - C.B. Falconer
  202. ;
  203. ; 11/17/86  Added ability to extract to a file with "LT lbr d:fn.ft",
  204. ;   v15     where the "d:" signifies extraction.  01Ah is EOF, so not
  205. ;        suitable for binary files.    The code has become a mess to
  206. ;        preserve the ability to generate minimum version.
  207. ;                    - C.B. Falconer
  208. ;
  209. ; 86/11/15  Added hooks to include Steve Greenbergs UNCR system. These
  210. ;   v14     are guarded by 'UNCR' equate to setup options.  Use requires
  211. ;        linking and creation of relocatable object.  Any uncrunching
  212. ;        requires a Z80 cpu.     - C.B. Falconer
  213. ;
  214. ; 02/12/86  Added expansion of UCSD style "dle/code" indentation codes.
  215. ;   v13     These also appear in the PASCALP system.
  216. ;                    - C.B. Falconer
  217. ;
  218. ; 12/05/84  Stole some features from TYPELxx '?' for forbidden file
  219. ;   v12     type table, list output enable on du version, location of
  220. ;        BADTBL for patching.  Checked "LIMITT" and "LMITL" options
  221. ;        functioning with wild cards.  Version display shows options
  222. ;        enabled.  Added bit vector for drives available.  Added du
  223. ;        option under "DUSPEC" conditional.    The minimum version
  224. ;        remains under 0500h bytes, with options disabled.  If an
  225. ;        operator is already logged into a drive/user area then that
  226. ;        drive/user area remains available even though the configured
  227. ;        restrictions should prevent it.  This allows for privileged
  228. ;        users.  John Doe can't get there at all.
  229. ;                    - C.B. Falconer
  230. ;
  231. ; 12/04/84  Deleted unused variables and labels, also variables that
  232. ;   v11     are better kept on the stack.  Arranged for LBRFCB to be
  233. ;        fully initializable via parameter, for straight type.
  234. ;        Thus:
  235. ;               A>LT fname.typ
  236. ;
  237. ;        will type/unsqueeze FNAME, while "LT LBRFILE component"
  238. ;        extracts as before.     - C.B. Falconer
  239. ;
  240. ; 10/02/84  Adapted from Steven R. Holtzclaw's "LUXTYP (06/10/83)"
  241. ;   v10     for independent use without the complete LUX system.
  242. ;        Eliminated Z80-only opcodes.  Added file searches.    Added
  243. ;        simple usage message, assembly time constants to eliminate
  244. ;        limits on lines and file types, ^Z stops pauses. CRT lines
  245. ;        measured acrossfiles.
  246. ;                - C.B. Falconer
  247. ;
  248. ; ---------------------------------------------------------------------
  249. ;
  250.     aseg ;    Needed for M80, ignored by SLRMAC, else ignore error
  251. ;
  252. no    equ    0;    For conditional assembly
  253. yes    equ    not no; (Some assemblers don't like 0FFh)
  254. ;
  255. ;    -------- Configuration -------
  256. ; Assembly time configurable areas.  Each increases COM file size.
  257. extract equ    yes;    *File extraction ability, wheel controllable
  258. rec    equ    32;    Sectors in file output buffer.    DO NOT make
  259. ;              too large, else uncruncher wont work
  260. ;
  261. limitl    equ    yes;    Yes allows output line limits
  262. limitt    equ    yes;    Yes allows file type restriction
  263. duspec    equ    yes;    Use DU style drive/user specifications
  264. xpnd    equ    yes;    Expand UCSD style "DLE/code" indentation codes
  265. paws    equ    no;    Check pause/abort on each output char (braille)
  266. ;
  267. ; Next is used with EXTRACT so that 1 copy only needed for RCPM systems
  268. ; Note: the wheel also over-rides the line count restriction, if any
  269. whlat    equ    0;    Location of wheel byte, 0 disables wheel check
  270. ;            (usually 03eh, patch into option area)
  271. ;            Value only used to set this word (1 place)
  272. ;
  273. ; For added security on RCP/M's to prevent access to files outside
  274. ; the callers permitted drive user areas.  See whlat above also
  275. mxdrv    equ    03dh;    Location of max drive byte
  276. mxusr    equ    03fh;    Location of max user byte
  277. ;
  278. ; Configurable values.    Also see "DRVSUP" configurable vector
  279. pagsz    equ    20;    Default lines per CRT page
  280. lnmax    equ    0;    0 for no limit, else max file size (to 255)
  281. noctrl    equ    yes;    Yes to prevent control char. output
  282. usrmax    equ    15;    Maximum user area accessible
  283. ;             0-15 for CP/M 3, 0-31 for CP/M 2.2 or DOSPLUS
  284. ;    ZCPR    . .    SPECIAL VALUE - 0ffh causes ZCPR mxusr to be
  285. ;            loaded into maxusr.
  286. ;    ------- END configuration equates --------
  287. ;
  288. ; Ascii control chars
  289. bell    equ    07h
  290. bs    equ    08h
  291. tab    equ    09h
  292. lf    equ    0ah
  293. cr    equ    0dh
  294. dle    equ    010h
  295. eof    equ    01ah
  296. sqzdle    equ    090h;    special in squeezed/crunched files
  297. ;
  298. ; CP/M-DOS+ system values
  299. bdos    equ    0005h
  300. fcb1    equ    05ch
  301. fcb2    equ    06ch
  302. cmdln    equ    080h
  303. ;
  304. ; BDOS calls
  305. cio    equ    6;    Direct console I/O
  306. setdrv    equ    14
  307. open    equ    15
  308. close    equ    16
  309. srchf    equ    17
  310. delete    equ    19
  311. fread    equ    20
  312. fwrt    equ    21
  313. make    equ    22
  314. getdrv    equ    25
  315. setdma    equ    26
  316. gsuser    equ    32;    Get/set user
  317. frdran    equ    33;    Read random record
  318. ;
  319.     cseg
  320. ;
  321. ; Linkages to unc module
  322.     extrn    unc, endu
  323.     entry    getbyt, out
  324. ;
  325. ; Linkages to UNLZH module
  326.     extrn    unl
  327.     entry    glzhun,plzhun
  328. ;
  329. ;    --------------
  330. ;    PROGRAM BEGINS
  331. ;    --------------
  332. begin:    jmp    start;        past configuration area
  333. ;
  334. ; Unused, but space reserved to fix patch locations
  335.     db    'Z3ENV';    Special signature
  336.     db    1;        External environment
  337. @env:    dw    0;        And ZCPR can patch this location
  338. ;
  339. ; Configuration values, even if unused via "limit" options
  340. ; These may be patched to configure the COM file at installation
  341. whladr: dw    whlat;        Non-zero if wheel controlled
  342. pagsiz: db    pagsz;        Lines per page, 0 = no pauses
  343. maxlin: db    lnmax;        Max lines to type, 0 = unlimited
  344. typflg: db    limitt;     0 for all file types, else selective
  345. pawsfg: db    paws;        To check pause on each output char.
  346. ctlflg: db    noctrl;     Non zero allows control char print
  347. altdrv: db    0;        Alternate drive to search, 0 = none
  348. maxusr: db    usrmax;     Max accessible user, for du entries
  349. ;                Set 0ffh to use ZCPR mxusr value
  350. drvsup: dw    1111111111111111b; Vector of available drives
  351. ;        ABCDEFGHIJKLMNOP-; Drive ids (No N..P under PascalP)
  352. ; (example)    1100000000001000B; (shown set for A, B and M drives)
  353. nouqz:    db    0;        0 to allow unsqueezing/uncrunching
  354. ;                of files during disk output. The $U
  355. ;                command line option will toggle this.
  356. xpdle:    db    NOT noctrl;    Set NO = 0 to suppress DLE expansion.
  357. ;                Useful if noctrl is set NO.
  358.     db    0;        spare for future use
  359. ;
  360. ; '?' matches any character. Alpha order for convenience only,
  361. ; a complete sequential scan is done.  An existing name can be
  362. ; made to disappear by setting its high order bit somewhere.
  363.     if    limitt;     Table of invalid file types
  364. badtbl:  db    'ABS';        Intended to disable
  365.      db    'ARC';        ===================
  366.      db    'ARK'
  367.      db    'BAD'
  368.      db    'CRL'
  369.      db    'C?M';        COM, CQM, CZM, CPM (v20 executes on PCs)
  370.      db    'E?E';        EXE, EQE, EZE    (MSDOS executable)
  371.      db    'IRL'
  372.      db    'I?T';        INT, IQT, IZT
  373.      db    'LBR'
  374.      db    'O??';        OBJ, OQJ, OZJ, OVL, OVR etc
  375.      db    'P?D';        PCD, PQD, PZD    (executable by RUNPCD)
  376.      db    'TX#'
  377.      db    'RBM'
  378.      db    'R?L';        REL, RQL, RZL
  379.      db    'S?R';        SLR, SQR, SZR    (SLR format rel files)
  380.      db    'SYS'
  381.      db    0,0,0
  382.      db    0,0,0;        Spares, for user configuration
  383.      db    0,0,0
  384.      db    0;        Table end marker
  385.     endif;        limitt
  386.  
  387. start:    lxi    h,0;        Set up HL for add to stack
  388.     shld    memcnt;     Zero the memory count
  389.     dad    sp;        Add stack pointer
  390.     shld    stack;        Keep stack contents
  391.     lxi    sp,stack;    Set up local stack
  392.     lda    maxusr
  393.     inr    a;        Special 0ffh max causes
  394.     lda    mxusr;        revision to mxusr
  395.     jnz    start1;     (Changed from jz to fix bug BCM 15/12/91)
  396.     sta    maxusr;     Revise if ZCPR user system
  397. start1: lxi    d,lbrbuf
  398.     mvi    a,setdma;    Do all I/O thru this buffer
  399.     call    sys
  400. ;    "       "
  401.     if    extract
  402.      mvi    a,' '
  403.      sta    outfcb+1;    Default none
  404.     endif;        extract
  405. ;    "       "
  406.     if    duspec;     Parse the command line
  407.      call    parse
  408.      lda    savusr
  409.      call    sguser;     Set the user access
  410.     endif;        duspec
  411. ;    "       "
  412.     call    lbropn;     Set up the library name buffer
  413.     push    psw;        Save extract/type flag
  414.     jnz    start2;     Type only
  415.     lhld    memcnt;     Get member count
  416.     mov    a,l;        Get member count lsb
  417.     ora    h;        Any members?
  418.     lxi    d,nfound
  419.     jz    exeunt;     No - exit
  420. ;    "       "
  421. start2: lxi    d,sign1;    Give name, version, credit
  422.     call    tstrc
  423.     pop    psw
  424.     jnz    dump;        Type only
  425. ;    "       "
  426. ; Per component loop
  427. next:    call    initlp;     Initialize the "next" loop
  428.     call    getmem;     Get next member FCB
  429.     jc    exit;        All done...
  430.     call    lbrset;     Set up to read the library file
  431. ;    "       "
  432. ; Input setup, do the extraction and/or unsqueezing
  433. dump:    if    limitt;     Test the type of file
  434.      call    tsttyp
  435.     endif;        limitt
  436. ;    "       "
  437.     call    get2hl;     Get the first 2 bytes from the file
  438.     jnz    zerprt;     Special processing for 0-length file
  439. ;    "       "
  440. ; This allows disk output WITHOUT any unsqueezing or uncrunching.
  441.     push    h
  442.     lxi    h,outflg;    File output flag
  443.     lda    nouqz;        No unsq/uncr flag
  444.     ana    m;        If (no unsq/uncr) AND (disk output)
  445.     pop    h
  446.     jnz    asprt;        Then skip uncompression routines.
  447. ;    "       "
  448.     mvi    a,076h
  449.     cmp    l
  450.     jnz    asprt;        Not squeezed - print an ascii file
  451.     mvi    a,0ffh
  452.     cmp    h
  453.     jz    dumpsq;     Squeezed, dump it
  454.     dcr    a;        To 0feh
  455.     cmp    h
  456.     jz    dumpcr;     Crunched, dump it
  457.     dcr    a;        To 0fdh
  458.     cmp    h
  459.     jnz    asprt;        Not compressed - print an ascii file
  460. ;    "       "
  461. ; Output from a LZH compressed file
  462.     call    nmshow;     Show actual name etc, absorb header
  463.     lhld    namptr;     Free memory area, above names
  464.     call    unl;        UNLZH.REL.  Uncompress
  465.     lxi    d,badfile
  466.     jc    donem;        something went wrong
  467.     jmp    done
  468. ;    "       "
  469. ; Output from a crunched file
  470. dumpcr: call    nmshow;     Show actual name etc, absorb header
  471.     lhld    namptr;     Free memory area, above names
  472.     call    unc;        UNC.REL.  Uncrunch
  473.     lxi    d,badfile
  474.     jc    donem;        something went wrong
  475.     jmp    done
  476. ;
  477. ; Output from a squeezed component
  478. dumpsq: call    get2hl;     Get and discard the next 2 bytes
  479.     call    nmshow;     Actual name, and absorb header
  480.     call    sqsetu;     Setup the squeezed file
  481. ;    "       "
  482. ; List a squeezed component
  483. sqloop: call    getsqb;     Get a byte from the file
  484.     jc    done;        Eof - get next file name in queue
  485.     call    crtype;     Else print the char
  486.     jmp    sqloop;     And loop for more
  487. ;
  488. ; Show UNSQ/UNCR member name, etc.  Optionally revise output name.
  489. ; This has the side function of absorbing the sqz/crn header.
  490. ; a,f,b,d,e,h,l
  491. nmshow: lxi    d,ffsep
  492.     call    tstr;        Make the file-file seperator
  493. ;    "       "
  494.     if    extract
  495.      lxi    h,outfcb+1
  496.      mvi    b,11
  497. nmshw1:  mvi    m,' ';        Pre-blank the output name
  498.      inx    h
  499.      dcr    b
  500.      jnz    nmshw1
  501.      mov    m,b
  502.      lxi    d,outfcb+1
  503.      mvi    b,8;        Size of name field
  504.     endif;        extract
  505. ;    "       "
  506. ; This section types the filename to the console and puts it into
  507. ; "OUTFCB".  A null character terminates all header processing.  Other
  508. ; characters after filename are ignored, unless they follow a "["
  509. ; character.  These will be echoed to the console, until either a null
  510. ; character is detected (terminate processing) or a "]" character is
  511. ; detected (start scanning for null again).
  512. nmshw2: push    d;        Filename area of OUTFCB
  513.     call    lbrget;     Get character from the file
  514.     pop    d;        Restore pointer
  515.     ora    a;        Check for null
  516.     jz    nmshw9;     If found, terminate header processing
  517.     cpi    '['
  518.     jz    nmshw7;     "[", go display "stamp" text
  519.     cpi    '.';        Was the character a "."?
  520.     jnz    nmshw3;     If not update cnt, display char, put in FCB
  521.     call    ctype;        "." is displayed, but not put into FCB
  522.     mvi    b,3;        set filename char counter to "3"
  523. ;    "       "
  524.     if    extract;        
  525.      lxi    d,outfcb+9;    adv filename dest pointer accordingly
  526.     endif;        extract
  527. ;    "       "
  528.     jmp    nmshw2;     Continue processing filename ext chars
  529.  
  530. nmshw3: inr    b;        Check filename character limit
  531.     dcr    b;        
  532.     jz    nmshw6;     If down to zero, exit this section
  533.     ani    07fh;        Strip MS bit before placing in FCB
  534.     call    ctype;        Else display char
  535. ;    "       "
  536.     if    extract;        
  537.      stax    d;        put char in the FCB if appropriate
  538.     endif;        extract
  539. ;    "       "
  540.     inx    d;        Bump filename dest pntr
  541.     dcr    b;        Count it
  542.     jmp    nmshw2;     Continue filename processing
  543. ;
  544. ; Filename has been fully processed. Continue header analysis.
  545. nmshw4: call    ctype;        (entry here to display extra char)
  546. ;    "       "
  547. nmshw5: call    lbrget
  548.     ora    a;        Loop swallows characters until either
  549.     jz    nmshw9;       a null or a "[" char is detected
  550. ;    "       "
  551. nmshw6: cpi    '['
  552.     jnz    nmshw5
  553. ;    "       "
  554. nmshw7: mvi    a,' ';        "[" found. Insert blank for aesthetics
  555.     call    ctype
  556.     mvi    a,'[';        But display the "[" char as well
  557. nmshw8: call    ctype
  558.     call    lbrget
  559.     cpi    ']';        Loop to display characters to the con-
  560.     jz    nmshw4;       sole until a null or a "]" is found
  561.     ora    a
  562.     jnz    nmshw8
  563. ;    "       "
  564. ; All paths to here have a=0 and z flag set
  565. nmshw9: if    extract
  566.      call    outtst;     Test if output to disk
  567.      cnz    opnout;     If to file, create it (outfcb), set nz
  568.     endif;        extract
  569. ;    "       "
  570.     cz    crlflf;     only when typing
  571.     ret
  572. ;
  573. ; Output an unsqueezed file/component.
  574. ;
  575. zerprt: sta    zerlen;     Save zero length file flag
  576. ;    "       "
  577. asprt:    if    extract
  578.      push    h
  579.      lda    outfcb+1;    Kludge to prevent file copying
  580.      sui    ' '
  581.      jnz    asprt0
  582.      lxi    h,nouqz
  583.      ora    m;        If we override unsq/uncr
  584.      jnz    abort;        we would trash the screen.
  585.      sta    outflg;     i.e. a zero, following fails
  586. asprt0:  call    outtst;     Test if output to disk
  587.      cnz    opnout;     If to file, create it (outfcb), sets nz
  588.      pop    h
  589.      cz    crlflf;     if typing. Opened output has set nz
  590.     else;        not extract
  591.      call    crlflf;     we are typeing
  592.     endif;        not extract
  593. ;    "       "
  594.     lda    zerlen
  595.     ora    a
  596.     jnz    done;        Don't type anything for 0-length file
  597.     mov    a,l;        Print
  598.     push    h
  599.     call    crtype;     First
  600.     pop    h;        (file out clobbers hl)
  601.     mov    a,h;        Two
  602. ;    "       "
  603. asprt1: call    crtype;     Bytes
  604.     call    lbrget;     Get a byte from the file
  605.     jz    asprt1;     Not eof, print and get more
  606.     jmp    done
  607. ;
  608. ; Done, send message
  609. donem:    call    tstr
  610. ;    "       '
  611. ; Done, no message
  612. done:    lxi    sp,stack;    SP uncertain here - reset the stack
  613. ;    "       "
  614.     if    extract
  615.      call    outtst;     Test if output to disk
  616.      cnz    fclose;     close file if so
  617.     endif;        extract
  618. ;    "       "
  619.     jmp    next
  620. ;
  621. ; Initialize the "next" loop
  622. ; a,f,b,h,l
  623. initlp: lda    paglns
  624.     ora    a
  625.     jnz    initl1;     Paging was not stopped
  626.     sta    lincn1;     Else clear for fresh start
  627.     lda    pagsiz
  628.     sta    paglns;     Restart any page pauses
  629. initl1: lxi    h,zeros;    Fill flag area with zeros
  630.     mvi    b,lastz-zeros;    Count of zeroes to load
  631.     xra    a;        Fill (HL) up for (B) with zeroes
  632. initl2: mov    m,a;        Put a byte
  633.     inx    h;        Next location
  634.     dcr    b
  635.     jnz    initl2;     Fill all 11 bytes
  636.     ret
  637. ;
  638. ; Open the FILENAME.LBR file and the MEMBER.EXT files, returns Z-flag
  639. ; for library extraction, NZ for pure type
  640. ;
  641. lbropn: mvi    b,12;        Field size for .LBR file
  642.     lxi    h,fcb1;     Move first file FCB
  643.     lxi    d,lbrfcb;    To LBRFCB
  644.     call    move
  645.     xra    a;        Set ext & rec # to 0 for proper open
  646.     sta    lbrext
  647.     sta    lbrsno
  648.     lxi    h,fcb2+1;    Source is member FCB name, no drive
  649.     mov    a,m;        First member character
  650.     cpi    ' ';        Is it a space or control ?
  651.     jc    helper;     Control, exit with help
  652.     jz    tfile;        Space, type one file only
  653.     lxi    d,memnam;    Move FCB2 to MEMNAM
  654.     mvi    b,11;        Bytes to move
  655.     call    move;        Member name to local area
  656. ;    "       "
  657. ; Open the .LBR file
  658.     lxi    h,'BL'
  659.     shld    lbrtyp;     Force .LBR type
  660.     mvi    a,'R'
  661.     sta    lbrtyp+2
  662.     call    fopnlb;     Open .LBR file
  663.     inr    a;        Open ok?
  664.     jz    nofile;     Failure, abort with help
  665. ;    "       "
  666. ; Read the first record of the library directory
  667.     call    lbread;     Read a sector
  668.     lhld    lbrbuf+14;    Get directory size
  669. ;    "       "
  670. ; Test for a valid library file
  671.     lda    lbrbuf
  672.     ora    a;        Test first byte
  673.     lxi    d,corrpt
  674.     jnz    exeunt;     Non-zero, bad .LBR file
  675. ;    "       "
  676. ; Read the next library directory record
  677. lbrop5: push    h;        Save DIRSIZE
  678.     cnz    lbread;     Read a sector, except 1st pass
  679. ;    "       "
  680. ; Search for the member name in the library directory
  681.     lxi    h,lbrbuf;    Process first entry
  682.     call    addmem;     To memory buffer
  683.     lxi    h,lbrbuf+20h;    Process second entry
  684.     call    addmem;     To memory buffer
  685.     lxi    h,lbrbuf+40h;    Process third entry
  686.     call    addmem;     To memory buffer
  687.     lxi    h,lbrbuf+60h;    Process fourth entry
  688.     call    addmem;     To memory buffer
  689.     pop    h;        Count of dir entries
  690.     dcx    h;        -1
  691.     mov    a,h;        Zero directory entries left ?
  692.     ora    l
  693.     jnz    lbrop5;     Now read another directory sector
  694.     ret
  695. ;
  696. ; The second parameter is missing, just type the main file,
  697. ; returns NZ flag to signal no library extraction
  698. ;
  699. tfile:    lxi    d,lbrfcb+1
  700.     ldax    d
  701.     dcx    d
  702.     cpi    ' '
  703.     jz    helper
  704.     call    fopenf
  705.     inr    a
  706.     jz    nofile
  707. ;    "       "
  708.     if    limitt
  709.      inx    d
  710.      xchg
  711.      lxi    d,memfcb
  712.      mvi    b,11
  713.      call    move;        Name to memnam for checking
  714.     endif;        limitt
  715. ;    "       "
  716.     call    initlp;     Other one pass initializers
  717.     ori    0ffh;        Set NZ flag
  718.     jmp    initpt;     Set up pointers, leave NZ flag
  719. ;
  720. ; Setup access to the library component
  721. ; a,f,b,d,e,h,l
  722. lbrset: lxi    d,mbrmsg
  723.     call    tstrc
  724.     lxi    h,memfcb;    Index member FCB
  725. ;    "       "
  726.     if    extract
  727.      push    h
  728.      lxi    d,outfcb+1
  729.      mvi    b,11;        Set default output file name
  730.      call    move;        (will revise if squeezed/crunched)
  731.      xra    a
  732.      stax    d;        And clear extent field
  733.      pop    h
  734.     endif;        extract
  735. ;    "       "
  736.     call    fname
  737.     mov    e,m;        Get member starting record LSB
  738.     inx    h
  739.     mov    d,m;        And MSB
  740.     push    d;        Save
  741.     inx    h
  742.     mov    e,m;        Get member size LSB
  743.     inx    h
  744.     mov    d,m;        And MSB
  745.     xchg;            Into 'HL'
  746.     inx    h;        +1
  747.     shld    rcnt;        Save it in record count
  748.     pop    h;        Restore starting record number
  749.     shld    lbrrno
  750.     xra    a
  751.     sta    lbrrno+2;    Set random rcd no
  752.     sta    lbrext
  753.     call    fopnlb;     Open the LBR file again
  754.     inr    a
  755.     jz    preeof;     Should not happen
  756.     mvi    a,frdran
  757.     call    sys;        Do a random read to put in sequential
  758.     ora    a
  759.     jnz    preeof;     No such record
  760. ;    "       '
  761. ; Initialize pointers to read from LBRFCB
  762. ; a,h,l (flags preserved)
  763. initpt: mvi    a,080h
  764.     sta    chrcnt;     Set char count to force read
  765.     lxi    h,lbrbuf-1
  766.     shld    bufptr
  767.     ret
  768. ;
  769. ; Get a byte from the .LBR member. GETBYT for UNCREL. GLZHUN for UNLZH use
  770. ; a,f,d,e,h,l
  771. glzhun:
  772. getbyt:
  773. lbrget: lda    chrcnt;     Get pointer
  774.     inr    a;        Point to next position
  775.     sta    chrcnt;     Put pointer back
  776.     jp    lbrge1;     Buffer not empty
  777.     call    zbuff;        Empty, reset pointers, read sector
  778.     lhld    rcnt;        Get record count
  779.     dcx    h;        -1
  780.     shld    rcnt;        Set new record count
  781.     mov    a,l
  782.     ora    h
  783.     jz    lbrge2;     If all records read
  784.     call    lbread;     Read a sector
  785.     ora    a
  786.     jnz    lbrge2;     If read was unsuccessful
  787. ;    "       "
  788. lbrge1: lhld    bufptr
  789.     inx    h
  790.     shld    bufptr
  791.     mov    a,m;        No  - get the next byte
  792.     cmp    a;        Set zero - no error
  793.     ret
  794. ;
  795. lbrge2: mvi    a,0ffh
  796.     ora    a
  797.     ret;            Return non-zero for error
  798. ;
  799. ; Zero the buffer pointers (for reaccess from start)
  800. ; a,f,h,l
  801. zbuff:    xra    a;        Empty, read another record
  802.     sta    chrcnt;     Clear the character count
  803.     lxi    h,lbrbuf-1
  804.     shld    bufptr
  805.     ret
  806. ;
  807. ; Read a sector from library file
  808. ; a,f,d,e
  809. lbread: mvi    a,fread
  810.     lxi    d,lbrfcb;    .LBR FCB
  811.     jmp    sys;        Read a block, and exit
  812. ;
  813. ; Get 2 bytes from input file into HL
  814. ; a,f,d,e,h,l
  815. get2hl: call    lbrget;     Get a byte from the input file
  816.     rnz;            May be an empty component
  817.     push    psw
  818.     call    lbrget;     Get a byte from the input file
  819.     mov    h,a
  820.     pop    psw;        first byte of the pair
  821.     mov    l,a
  822.     ret
  823. ;
  824. nofile: lxi    d,nofmsg
  825.     jmp    exeunt
  826. ;
  827. helper: lxi    d,signon;    Give name, version, credit
  828.     call    tstr
  829.     lxi    d,usage;    Give help menu
  830.     call    tstrc
  831.     call    qwhl
  832.     lxi    d,whlusg
  833.     cnz    tstrc;        Added help when wheel enabled
  834.     jmp    exit;        without wasting CRT space.
  835. ;
  836. preeof: lxi    d,eofmsg
  837. ;    "       "
  838. ; Error exit, crlf and message (DE)^
  839. exeunt: call    tstrc;        Print message
  840. ;    "       "
  841. exit:    if    duspec;     Restore entry conditions
  842.      call    restor
  843.     endif;        duspec
  844. ;    "       "
  845.     lhld    stack
  846.     sphl;            Restore original stack
  847.     ret;            --exit-- to cp/m
  848. ;
  849.     if    extract
  850. ; Close any output file
  851. ; a,f,d,e,h,l 
  852. fclose:  lda    bytes;        Get bytes in current sector
  853.      ora    a
  854.      jz    fcls2;        None
  855.      lhld    outptr;     Get buffer pointer
  856. fcls1:     mvi    m,eof;        Put in EOF
  857.      inx    h;        Bump pointer
  858.      inr    a;        And byte count
  859.      jp    fcls1;        Fill out sector with EOF
  860.      lda    sector
  861.      inr    a
  862.      sta    sector;     Bump sector count
  863. fcls2:     call    fput;        Write buffer, maybe
  864.      lda    outusr;     Shift to output user
  865.      call    sguser
  866.      lxi    d,outfcb
  867.      mvi    a,close
  868.      call    sys
  869.      lda    inuser
  870.      jmp    sguser;     Restore and exit
  871. ;
  872. ; Put character (TOS) to file.    Unclean hook for CRTYPE.
  873. ; a,f,h,l
  874. fputch:  pop    psw;        Get char. to ACC.
  875.      lhld    outptr;     Pointer
  876.      mov    m,a;        Put char in buffer
  877.      inx    h
  878.      shld    outptr;     Update pointer
  879.      lda    bytes
  880.      inr    a
  881.      sta    bytes;        Update bytes in this sector
  882.      rp;            Exit if not full sector
  883.      xra    a
  884.      sta    bytes;        Init. byte count
  885.      lda    sector
  886.      inr    a
  887.      sta    sector;     Update sectors in buffer
  888.      cpi    rec;        Buffer full?
  889.      rnz;            Exit if not
  890. ;     "      "
  891. ; Write output buffer to file
  892. ; a,f,h,l
  893. fput:     push    d
  894.      lda    outusr;     User for output file
  895.      call    sguser
  896.      call    pbuf;        Write the sectors
  897.      lxi    d,lbrbuf
  898.      mvi    a,setdma;    Back to input buffer
  899.      call    sys
  900.      lda    inuser;     Restore input user
  901.      call    sguser
  902. ;     "      "
  903. ; This code allows aborting a disk file output
  904.      call    cistat;     Check for console input
  905.      jz    fput2;        Continue if none
  906.      cpi    'C'-40h
  907.      jz    abort;        Abort on CTL-C
  908. fput2:     pop    d;        Else continue
  909.      ret
  910. ;
  911. ; Unload the stored buffer (up to rec sectors long)
  912. ; a,f,d,e,h,l
  913. pbuf:     lda    sector;     Get sector count
  914.      inr    a;        Prepare for upcomming DCR A
  915.      lxi    h,outbuff;    Start of output buffer
  916.      shld    outptr;     Init. byte pointer
  917. pbuf1:     shld    dmaadd;      and write address
  918.      dcr    a
  919.      sta    sector;     Update sector count
  920.      rz;            Exit if none left to write
  921.      push    psw;        Save sector count
  922.      xchg;            Setup DE
  923.      mvi    a,setdma;    Write address
  924.      call    sys
  925.      lxi    d,outfcb
  926.      mvi    a,fwrt;     Now write it
  927.      call    sys
  928.      ora    a
  929.      jnz    fullup;     Write error, abort everything
  930.      lhld    dmaadd
  931.      lxi    d,128;        Get next write address
  932.      dad    d
  933.      pop    psw;        Get sector count
  934.      jmp    pbuf1;        And loop
  935.     endif;        extract
  936. ;
  937. ; Output to CRT or file.  Entry name "out" for UNC or UNCREL, 'plzhun' for
  938. ; UNLZH or UNL use
  939. ; CRT output tracks column and line.
  940. ; a,f,e,h,l
  941. plzhun:
  942. out:
  943. crtype: if    extract
  944.      push    psw
  945.      call    outtst;     Test if output to disk
  946.      jnz    fputch
  947.      pop    psw
  948.     endif;        extract
  949. ;    "       "
  950. ; Not creating a file, this char goes to the console.
  951.     cpi    eof
  952.     jz    done;        EOF on 01Ah for ASCII output
  953. ;    "       "
  954.     if    xpnd
  955.      push    psw
  956.      lda    dleflg
  957.      ora    a
  958.      jnz    crtyp6
  959.      pop    psw
  960.      cpi    dle
  961.      jnz    crtyp1
  962.      lda    xpdle
  963.      ora    a
  964.      jnz    crtyp5
  965.      mvi    a,dle
  966.     endif;        xpnd
  967. ;    "       "
  968. crtyp1: ani    7fh;        Make sure its ASCII
  969.     push    psw;        Save the character
  970.     call    cout
  971.     lda    pawsfg
  972.     ora    a
  973.     cnz    pauser;     For slow terminals (Braille, etc)
  974.     pop    psw;        Restore character
  975.     cpi    lf;        Was it a line feed
  976.     rnz;            No - continue
  977.     call    qwhl;        Load wheel byte if enabled
  978.     jnz    crtyp2;     Bypass line count tests on wheel
  979. ;    "       "
  980.     if    limitl;     Check for too many lines typed
  981.      lda    lincnt;     Advance line counter
  982.      inr    a
  983.      sta    lincnt
  984.      mov    b,a;        Line number in 'B'
  985.      lda    maxlin;     Max number of lines to type
  986.      ora    a;        Test flag
  987.      jz    crtyp2;     If null function
  988.      cmp    b;        Else compare to max lines
  989.      lxi    d,excess
  990.      jz    donem;        Announce too much
  991.     endif;        limitl
  992. ;    "       "
  993. crtyp2: lda    lincn1;     Get line counter
  994.     mov    b,a;        Keep in 'B'
  995.     lda    paglns;     Number of lines per page
  996.     dcr    a;        Decrement and test flag
  997.     jm    pauser;     Function is null
  998.     cmp    b;        Compare to lines per page
  999.     jnc    pauser;     If not at maximum count
  1000.     xra    a;        Clear lines counter
  1001.     sta    lincn1
  1002.     lxi    d,more
  1003.     call    tstr;        Announce the pause
  1004.     call    pause;        Get input from console
  1005.     cpi    ' '-eof;    Space for line at a time?
  1006.     jnz    crtyp3
  1007.     mov    a,b;        Get original line count back
  1008.     dcr    a;        And set to "one line left"
  1009.     sta    lincn1
  1010. crtyp3: lxi    d,clean
  1011.     call    tstr;        Clear out the "[more]"
  1012. ;    "       "
  1013. ; Check for user pause or abort
  1014. ; a,f,e (unless aborted)
  1015. pauser: call    cistat;     Check the keyboard
  1016.     call    pschk
  1017.     cpi    'S'-40h;    CTL-S to pause?
  1018.     jz    pause
  1019.     ani    5fh
  1020.     cpi    'S'
  1021.     rnz;            Not CTL-S, return
  1022. ;    "       "
  1023. ; Returns input-01Ah.    Aborts on c,C,^C or k,K,^K - next on CTL-X, etc.
  1024. ; a,f,e
  1025. pause:    call    cistat;     Check the keyboard
  1026.     jz    pause;        Nothing yet so wait
  1027.     call    pschk
  1028.     sui    eof
  1029.     rnz;            Not ^Z
  1030.     sta    paglns;     End pauses permanently on ^Z
  1031.     ret
  1032. ;
  1033.     if    xpnd
  1034. crtyp6:  xra    a;        Indentation expansion
  1035.      sta    dleflg
  1036.      pop    psw
  1037.      sui    ' '
  1038.      rc
  1039.      rz;            Else 'A' is count of spaces to send
  1040. crtyp7:  sta    dlecnt
  1041.      mvi    e,' '
  1042.      call    cout3
  1043.      lda    dlecnt
  1044.      dcr    a
  1045.      jnz    crtyp7
  1046. crtyp5:  sta    dleflg
  1047.      ret
  1048.     endif;        xpnd
  1049. ;
  1050. ; Console status
  1051. ; a,f,e
  1052. cistat: mvi    a,cio;        BDOS function
  1053.     mvi    e,0ffh
  1054.     call    sys;        Direct console in call
  1055.     ora    a;        Was a key entered ?
  1056.     ret
  1057. ;
  1058. ; Pause check for special characters
  1059. ; a,f (unless aborted)
  1060. pschk:    cpi    'C'-40h;    Want to abort?
  1061.     jz    abort;        If yes, quit
  1062.     cpi    'K'-40h
  1063.     jz    abort
  1064.     cpi    'X'-40h;    Jumping to next file?
  1065.     jz    pschk1
  1066.     cpi    ' ';        Space for "line at a time"?
  1067.     rz
  1068.     ani    5fh;        Insure in upper case
  1069.     cpi    'C'
  1070.     jz    abort
  1071.     cpi    'K'
  1072.     jz    abort
  1073.     cpi    'X'
  1074.     rnz;            If not, keep going
  1075. pschk1: call    crlf
  1076.     jmp    done;        Next file on CTL-X
  1077. ;
  1078. ; Abort the run with message
  1079. abort:    lxi    d,abrmsg
  1080.     jmp    exeunt
  1081. ;
  1082. ; Output char a to console, expanding tabs, tracking column
  1083. ; a,f,e
  1084. cout:    mov    e,a;        Save output character
  1085.     cpi    tab
  1086.     jz    tabber;     Expand a tab
  1087.     cpi    cr;        Carriage return
  1088.     jnz    cout1
  1089.     xra    a;        CR sets COLUMN to 0
  1090.     jmp    cout4
  1091.  
  1092. cout1:    cpi    bs;        Is char a backspace?
  1093.     jnz    cout2
  1094.     lda    column;     Backspace sets COLUMN back one
  1095.     dcr    a
  1096.     rm;            Ignore if at column 0 already
  1097.     jmp    cout4
  1098.  
  1099. cout2:    cpi    ' ';        
  1100.     jc    coute;        Other controls don't affect COLUMN
  1101. ;    "       "
  1102. ; Callable entry point here to display e
  1103. cout3:    lda    column;     Advance column counter
  1104.     inr    a
  1105. cout4:    sta    column
  1106. ;    "       "
  1107. ; Output e to console if printable
  1108. coute:    call    qctl;        Test control
  1109.     mov    a,e;        Get char back
  1110.     jz    ctype;        no suppression, print the char
  1111.     ret;            absorb it, Return to caller
  1112. ;
  1113. ; Expand a tab, at least one space emitted
  1114. tabber: mvi    e,' '
  1115.     call    cout3;        Print a space
  1116.     lda    column
  1117.     ani    7;        At next tab stop ?
  1118.     jnz    tabber;     Yes, continue
  1119.     ret
  1120. ;
  1121. ; Test for control char output (from e). Z flag for no suppression.
  1122. ; a,f
  1123. qctl:    lda    ctlflg;     Get controls active
  1124.     ora    a;        Test flag
  1125.     rz;            Return if not
  1126.     mov    a,e;        Get output char
  1127.     cpi    ' '
  1128.     jnc    qctl1;        Not control, clear flags
  1129.     cpi    cr
  1130.     rz
  1131.     cpi    bs
  1132.     rz
  1133.     cpi    bell
  1134.     rz
  1135.     cpi    lf
  1136.     rnz;            Non-typable control char
  1137. qctl1:    cmp    a;        Set Z-flag, typable
  1138.     ret
  1139. ;
  1140.     if    limitt;     Test for typable file
  1141. ; Test for typeable file, abort with message to "DONE" if not
  1142. ; a,f,b,d,e,h,l
  1143. tsttyp:  lda    typflg;     Get test flag
  1144.      ora    a;        Test it
  1145.      rz;            Return if ok to type all types
  1146. ;     "      "
  1147.      if    extract; AND limitt
  1148.       call    outtst;     Test if output to disk
  1149.       rnz;            Return if outputting to disk
  1150.      endif;     extract AND limitt
  1151. ;     "      "
  1152.      mvi    b,3
  1153.      lxi    h,badtbl-3;    Index bad file type table
  1154. tstty1:  inx    h;        Next table address pointer
  1155.      dcr    b;        Bump loop counter
  1156.      jnz    tstty1;     Do until at next table entry
  1157.      mov    a,m;        Get a byte
  1158.      ora    a
  1159.      rz;            end of table - ok to type this one
  1160.      mvi    b,3;        3 char extension
  1161.      lxi    d,memfcb+8;    Index file name extension
  1162. tstty2:  ldax    d;        Get a byte from extension
  1163.      ani    7fh;        Strip any file attribute bits
  1164.      cmp    m
  1165.      jz    tstty3;     Match, continue scan
  1166.      mov    a,m
  1167.      cpi    '?';        '?' in table matches all
  1168.      jnz    tstty1;     No match, next entry
  1169. tstty3:  inx    h;        Bump table address pointer
  1170.      inx    d;        Bump extent pointer
  1171.      dcr    b;        Bump counter
  1172.      jnz    tstty2;     Continue for 3 chars
  1173.      lxi    h,memfcb+8;    User name
  1174.      lxi    d,cant
  1175.      call    tstr;        "CAN't type a '"
  1176.      mvi    b,3;        3 byte file type
  1177. tstty5:  mov    a,m;        Get byte
  1178.      call    ctype;        Give a chance to abort here
  1179.      inx    h;        Next byte
  1180.      dcr    b
  1181.      jnz    tstty5;     Type all 3 bytes
  1182.      lxi    d,cant2;    "' FILE ",CR,LF
  1183.      jmp    donem;        And do next file
  1184.     endif;        limitt
  1185. ;
  1186. ; This part is adapted from TYPE109 by David Rand
  1187. ; a,f,b,c,d,e,h,l
  1188. getsqb: lda    rptcnt;     Get repeat flag
  1189.     ora    a;        Any chars to repeat ?
  1190.     jnz    getsq1;     Yes - get and count
  1191.     call    nxtch;        Get a character
  1192.     rc;            Eof
  1193.     cpi    sqzdle;     Repeat byte flag
  1194.     jnz    getsq3;     No -
  1195.     call    nxtch;        Yes - get another character
  1196.     rc;            EOF
  1197.     ora    a;        If null
  1198.     jnz    getsq2
  1199.     mvi    a,sqzdle;    Dle is encoded as dle,0
  1200.     ret;            Return with it, carry clear
  1201. ;
  1202. getsq2: dcr    a;        Bump counter twice
  1203.     jz    getsqb;     1 repeat is a null event
  1204. getsq1: dcr    a
  1205.     sta    rptcnt;     Set repeat count
  1206.     lda    rptchr;     Return repeat character
  1207. getsq3: sta    rptchr;     Set repeat char
  1208.     ora    a;        Clear any carry, not EOF
  1209.     ret
  1210. ;
  1211. ; Next decoded byte from file, ignoring repeat characters
  1212. ; a,f,b,c,d,e,h,l
  1213. nxtch:    lxi    d,0;        Pointer @ star of text
  1214.     lda    char
  1215.     mov    c,a
  1216. nxtch1: lda    numflt
  1217.     ora    a
  1218.     jnz    nxtch2
  1219.     push    d;        Save 'DE'
  1220.     call    lbrget;     Get a byte from the input file
  1221.     jnz    preeof;     Not expecting an eof here
  1222.     pop    d;        Restore 'DE'
  1223.     mov    c,a
  1224.     mvi    a,8;        'A' is counter
  1225. nxtch2: dcr    a;        Bump count
  1226.     sta    numflt;     Save it
  1227.     mov    a,c;        Get character
  1228.     rrc;            Shift right
  1229.     mov    c,a;        Save character
  1230.     push    psw;        Save character
  1231.     lxi    h,xlatbl;    Index ram area
  1232.     dad    d;        HL=HL+(4*DE)
  1233.     dad    d
  1234.     dad    d
  1235.     dad    d
  1236.     pop    psw;        Restore char
  1237.     jnc    nxtch3;     If no carry
  1238.     inx    h
  1239.     inx    h
  1240. nxtch3: mov    e,m
  1241.     inx    h
  1242.     mov    d,m
  1243.     mov    a,d
  1244.     ani    80h
  1245.     jz    nxtch1
  1246.     mov    a,c
  1247.     sta    char
  1248.     mov    a,d
  1249.     cpi    0feh;        Special end of file ?
  1250.     mvi    a,eof;        Yes - return with EOF character
  1251.     stc
  1252.     rz;            And carry for EOF
  1253.     mov    a,e
  1254.     cmc
  1255.     cma
  1256.     ret;            With carry clear, not EOF
  1257. ;
  1258. ; Set up the translation table for the squeezed file
  1259. ; a,f,d,e,h,l
  1260. sqsetu: call    get2hl;     Get 2 bytes from input file into HL
  1261.     lxi    d,xlatbl;    Index ram area
  1262. sqset1: mov    a,h;        Get MSB
  1263.     ora    l;        Test LSB
  1264.     rz
  1265.     push    h;        Save table size counter
  1266.     push    d;        Save ram area index
  1267.     call    get2hl;     Get 2 bytes from input file into HL
  1268.     pop    d;        Restore ram area index
  1269.     xchg;            Into 'HL'
  1270.     mov    m,e;        Save the LSB byte
  1271.     inx    h
  1272.     mov    m,d;        And MSB byte
  1273.     inx    h
  1274.     push    h;        Bump & save pointer
  1275.     call    get2hl;     Get 2 bytes from input file into HL
  1276.     xchg;            Into DE
  1277.     pop    h;        Restore pointer
  1278.     mov    m,e;        Save the LSB byte
  1279.     inx    h
  1280.     mov    m,d;        And the MSB byte
  1281.     inx    h;        Bump pointer
  1282.     xchg;            Restore pointer to 'DE'
  1283.     pop    h;        Restore table size counter
  1284.     dcx    h;        Decrement it the byte count
  1285.     jmp    sqset1;     And loop for more
  1286. ;
  1287. ; Add a library member to the name queue buffer if a match to MEMNAM
  1288. ; a,f,b,d,e,h,l
  1289. addmem: mov    a,m;        Get first byte of member entry
  1290.     ora    a
  1291.     rnz;            Non zero - must be deleted or null entry
  1292.     inx    h;        Go to the second byte
  1293.     push    h;        Save source address for coming 'LDIR'
  1294.     push    h;        Save it again
  1295.     mvi    b,11;        11 byte filename
  1296. addme0: mov    a,m;        Get byte
  1297.     cpi    ' '
  1298.     jnz    addme1;     Not space - continue
  1299.     inx    h;        Next char
  1300.     dcr    b
  1301.     jnz    addme0;     Continue searching for spaces
  1302.     pop    h;        Must be the directory
  1303.     jmp    addme4;     So abort this one
  1304. ;
  1305. addme1: pop    h
  1306.     lxi    d,memnam;    Index member FCB name
  1307.     mvi    b,11;        11 byte compare
  1308. addme2: ldax    d;        Get byte from member name FCB
  1309.     cpi    '?';        '?' matches all entries
  1310.     jz    addme3;     Match
  1311.     cmp    m;        Same as member entry?
  1312.     jnz    addme4;     No - abort this process
  1313. addme3: inx    h
  1314.     inx    d
  1315.     dcr    b
  1316.     jnz    addme2;     Compare all 11 bytes
  1317.     lhld    namptr;     Get destination address
  1318.     xchg
  1319.     pop    h;        Get source address back again
  1320.     mvi    b,15
  1321.     call    move;        Move 15 byte block into memory
  1322.     xchg
  1323.     shld    namptr;     Save name pointer
  1324.     lhld    memcnt;     Get member number count
  1325.     inx    h;        Bump it up one
  1326.     shld    memcnt;     Set next member memory address
  1327.     ret
  1328.  
  1329. addme4: pop    h;        Balance stack
  1330.     ret
  1331. ;
  1332. ; Get the next member name from the memory name queue buffer, 
  1333. ; return carry set if no more members left
  1334. ; a,f,b,d,e,h,l
  1335. getmem: lhld    memcnt;     Get member count
  1336.     mov    a,l
  1337.     ora    h
  1338.     stc
  1339.     rz;            Zero count - set error condition
  1340.     dcx    h;        Bump count down
  1341.     shld    memcnt;     And reset member count
  1342.     lhld    nampt1;     Get source address for move
  1343.     lxi    d,memfcb;    Get destination for move
  1344.     mvi    b,15;        11 byte filename + 4 byte file info
  1345.     call    move;        The block
  1346.     shld    nampt1;     Reset the next source address
  1347.     ora    a;        Clear any cy
  1348.     ret
  1349. ;
  1350. ; Double CRLF to console
  1351. ; a
  1352. crlflf: call    crlf
  1353. ;    "       "
  1354. ; CR and LF to console
  1355. ; a
  1356. crlf:    mvi    a,cr
  1357.     call    ctype
  1358.     mvi    a,lf
  1359. ;    "       "
  1360. ; Character to console, preserve all registers, track lines
  1361. ctype:    push    psw
  1362.     push    d
  1363.     mov    e,a
  1364.     cpi    lf
  1365.     jnz    ctype1
  1366.     lda    lincn1
  1367.     inr    a
  1368.     sta    lincn1
  1369. ctype1: mvi    a,cio;        Direct console output
  1370.     call    sys
  1371.     pop    d
  1372.     pop    psw
  1373.     ret
  1374. ;
  1375. ; CRLF, then fall through to TSTR
  1376. ; a,f
  1377. tstrc:    call    crlf
  1378. ;    "       "
  1379. ; Output string (DE)^
  1380. ; a,f
  1381. tstr:    push    d
  1382. tstr1:    ldax    d
  1383.     ora    a
  1384.     jz    tstrx
  1385.     call    ctype
  1386.     inx    d
  1387.     jmp    tstr1
  1388. ;
  1389. tstrx:    pop    d
  1390.     ret
  1391. ;
  1392.     if    extract
  1393. ; Query for file purge
  1394. ; a,f
  1395. query:     push    d
  1396.      lxi    d,exists
  1397.      call    tstr
  1398.      call    pause
  1399.      pop    d
  1400.      adi    eof;        Correct output
  1401.      ani    05fh;        Upshift
  1402.      call    ctype;        And echo
  1403. ;     push    psw
  1404. ;     call    crlf
  1405. ;     pop    psw
  1406.      cpi    'Y'
  1407.      ret;            Purge wanted if z flag
  1408. ;
  1409. ; Open (create) file OUTFCB^. Returns NZ when all well
  1410. ; a,f,d,e
  1411. opnout:  lda    outusr
  1412.      call    sguser
  1413.      lxi    d,outfcb
  1414.      mvi    a,open
  1415.      call    sys
  1416.      inr    a
  1417.      ora    a;        Ensure carry reset
  1418.      cnz    query;        When file already exists
  1419.      jnz    done;        Abort if not to be purged
  1420.      xra    a
  1421.      sta    bytes;        Reset byte count
  1422.      sta    sector;     and sector count
  1423.      sta    outfcb+32;    Reset output record number
  1424.      mvi    a,delete
  1425.      call    sys;        Remove any old file
  1426.      mvi    a,make
  1427.      call    sys;        And create a new one
  1428.      inr    a
  1429.      push    psw
  1430.      lda    inuser
  1431.      call    sguser;     Go back to input access
  1432.      pop    psw
  1433.      rnz;            All well
  1434. ;     "      "
  1435. ; Fullup message and abort
  1436. fullup:  lxi    d,noroom
  1437.      jmp    exeunt;     Abort everything
  1438.     endif;        extract
  1439. ;
  1440. ; Open LBRFCB file
  1441. ; a,f
  1442. fopnlb: lxi    d,lbrfcb
  1443. ;    "       "
  1444. ; Open file (DE)^, doing any searches, return BDOS response
  1445. ; a,f
  1446. fopenf: call    fopen
  1447.     cpi    0ffh
  1448.     rnz;            Success
  1449.     ldax    d
  1450.     ora    a
  1451.     mvi    a,0ffh;     Failure flag
  1452.     rnz;            Because a drive was specified
  1453.     lda    altdrv;     Set system drive and retry
  1454.     stax    d;        (a zero value causes useless retry)
  1455. ;    "       "
  1456. ; Open file (DE)^, return BDOS response in (A),
  1457. ; assumes DMA is preset to LBRBUF.
  1458. ; a,f
  1459. fopen:    if    limitt;     Ensure non-ambiguous name
  1460.      mvi    a,srchf
  1461.      call    sys;        Search for openee
  1462.      cpi    0ffh
  1463.      rz;            Failure, not found
  1464.      push    h
  1465.      push    d
  1466.      push    b
  1467.      lxi    h,lbrbuf+1;    Copy the non-ambiguous name
  1468.      add    a
  1469.      add    a;        4*
  1470.      add    a
  1471.      add    a;        16*
  1472.      add    a;        32*
  1473.      add    l
  1474.      mov    l,a;        Index into the DMA area
  1475.      adc    h
  1476.      sub    l
  1477.      mov    h,a;        Point to the "found" file
  1478.      mvi    b,11
  1479.      inx    d
  1480.      call    move;        Exact name into FCB
  1481.      pop    b
  1482.      pop    d
  1483.      pop    h
  1484.     endif;        limitt
  1485. ;    "       "
  1486.     mvi    a,open
  1487. ;    "       '
  1488. ; Execute BDOS function (A), preserve registers
  1489. ; a,f
  1490. sys:    push    h
  1491.     push    d
  1492.     push    b
  1493.     mov    c,a
  1494.     call    bdos
  1495.     pop    b
  1496.     pop    d
  1497.     pop    h
  1498.     ret
  1499. ;
  1500. ; Move (B) bytes from (HL)^ to (DE)^
  1501. ; a,f,b,d,e,h,l
  1502. move:    mov    a,m
  1503.     stax    d
  1504.     inx    h
  1505.     inx    d
  1506.     dcr    b
  1507.     jnz    move
  1508.     ret
  1509. ;
  1510. ; List filename from FCB (HL)^
  1511. ; a,f,h,l
  1512. fname:    push    b
  1513.     mvi    b,8;        Size of name field
  1514. fname1: mov    a,m;        Get a byte
  1515.     ani    07fh
  1516.     cpi    ' '
  1517.     cnz    ctype;        print non-space
  1518.     inx    h;        Next char
  1519.     dcr    b
  1520.     jnz    fname1;     Continue name
  1521.     mvi    a,'.'
  1522.     call    ctype;        Print seperator
  1523.     mvi    b,3;        3 character extent
  1524. fname2: mov    a,m;        Get byte
  1525.     ani    07fh
  1526.     cpi    ' '
  1527.     cnz    ctype;        print non-space
  1528.     inx    h;        Next char
  1529.     dcr    b
  1530.     jnz    fname2;     Continue ext
  1531.     pop    b
  1532.     ret
  1533. ;
  1534. ; This must parse the command line into FCB1 and FCB2, setting the
  1535. ; appropriate drives and user values, and saving old values.  Note that
  1536. ; this routine should NOT assume that the command line is upshifted, to
  1537. ; allow use with CCPLUS when the noupshift option is selected, and thus
  1538. ; enabling use of Software Tools etc.  This routine does not deny
  1539. ; access to the currently logged in drive or user, so that a privileged
  1540. ; operator can always use the program on his own area, even though
  1541. ; normally restricted.    Note that the fact of logging in establishes
  1542. ; the existance of the drive unit.
  1543.     if    duspec;     Parse command line
  1544. parse:     mvi    a,getdrv;    Save entry drive
  1545.      call    sys
  1546.      sta    olddrv
  1547.      call    getusr;     and user values
  1548.      sta    oldusr;     first so any error restores
  1549.      lxi    h,cmdln
  1550.      mov    a,m;        Line length
  1551.      push    h
  1552.      inr    a
  1553.      add    l
  1554.      mov    l,a
  1555.      mvi    m,0;        Mark line end
  1556. ;     "      "
  1557. ; Check for command line option $U to toggle unsq/uncr flag
  1558.      mvi    a,' '
  1559. parse1:  dcx    h
  1560.      cmp    m
  1561.      jz    parse1;     ignore trailing blanks
  1562.      mov    a,m
  1563.      ani    05fh
  1564.      cpi    'U'
  1565.      jnz    parse4;     not $U option
  1566.      dcx    h;        Backup 3 chars.
  1567.      mov    a,m
  1568.      cpi    '$'
  1569.      jnz    parse4;     not $U option
  1570.      dcx    h
  1571.      mov    a,m
  1572.      cpi    ' '
  1573.      jnz    parse4;     not delimited, may be part of fname
  1574.      mvi    m,0;        Found " $U" at end, remove from line
  1575.      lda    nouqz;        Get flag
  1576.      cma;            Toggle it
  1577.      sta    nouqz;        And put it back
  1578. ;     "      "
  1579. parse4:  pop    h;        line beginning ptr
  1580.      lxi    d,fcb1
  1581.      call    skipbl;     Skip any leading blanks
  1582.      call    setdu
  1583.      jc    helper;     Bad specification
  1584.      mov    b,a
  1585.      lda    oldusr
  1586.      cmp    b
  1587.      jz    parse6;     User ok if already logged on to it
  1588.      lda    maxusr;     Load maximum user value
  1589. parse5:  cmp    b
  1590.      jc    noacc;        Illegal on system
  1591. parse6:  push    d
  1592.      mov    a,b
  1593. ;     "      "
  1594.      if    extract
  1595.       sta    inuser;     Preserve for output flipping
  1596.      endif;     extract
  1597. ;     "      "
  1598.      sta    savusr;     Save for later
  1599.      pop    d
  1600.      ldax    d
  1601.      call    chkdv
  1602.      jc    noacc;        No access or no such drive
  1603.      inx    d;        Drive is already set
  1604.      call    setnam;     Setup first file name
  1605.      cnz    skipbl;     Dont skip past eol marker
  1606.      lxi    d,fcb2
  1607.      xra    a
  1608.      stax    d;        Kill the 2nd drive spec.
  1609. ;     "      "
  1610.      if    extract
  1611.       sta    outflg;     Default no output file created
  1612.      endif;     extract
  1613. ;     "      "
  1614.      call    setdu;        To skip over any du spec
  1615.      jc    helper
  1616. ;     "      '
  1617.      if    extract
  1618.       jz    parse7;     No DU specified
  1619.       mov    a,b
  1620.       sta    outusr
  1621.       ldax    d
  1622.       sta    outfcb
  1623.       xra    a
  1624.       stax    d;        Reset drive field.
  1625.       dcr    a;        To 0ffh
  1626.       sta    outflg;     Flag doing output
  1627.      else    ;    NOT extract
  1628.       jnz    helper
  1629.      endif;     NOT extract
  1630. ;     "      "
  1631. parse7:  inx    d
  1632. ;     "      "
  1633. ; Parse filename from (HL)^ into FCB at (DE)^
  1634. ; Z-flag if end of line reached
  1635. ; a,f,b,d,e,h,l
  1636. setnam:  mvi    b,8
  1637.      call    setfld
  1638.      cpi    '.'
  1639.      jnz    setnm2;        No extension specified
  1640.      inx    h
  1641. setnm2: mvi    b,3
  1642. ;     "      "
  1643. ; Set field length (B) in (DE)^ from (HL)^ up, blank padding, Z- flag
  1644. ; for end of line.  Leave HL pointing to delimiter.  (a) := delimiter.
  1645. ; Truncate any fields longer than expected.
  1646. ; a,f,b,d,e,h,l
  1647. setfld:  call    qdelim;     Load and upshift char
  1648.      jz    setfd4;        Delimiter, go blank pad
  1649.      cpi    '*'
  1650.      jnz    setfd1
  1651.      mvi    a,'?';        Expand '*' to '?'s
  1652.      jmp    setfd2;        Without advancing input pointr
  1653.  
  1654. setfd1: inx    h
  1655. setfd2: stax   d
  1656.      inx    d
  1657.      dcr    b
  1658.      jnz    setfld
  1659. setfd3: call   qdelim;           Skip to first delimiter
  1660.      jz    setfd5;        At a delimiter
  1661.      inx    h;        Else truncate
  1662.      jmp    setfd3
  1663.  
  1664. setfd4: mvi    a,' ';           Blank pad
  1665.      stax    d
  1666.      inx    d
  1667.      dcr    b
  1668.      jnz    setfd4
  1669. setfd5: mov    a,m
  1670.      ora    a;        Z flag for eol only
  1671.      ret
  1672. ;
  1673. ; (A) := (HL)^ upshifted.  Z flag if a delimiter for file names
  1674. ; a,f
  1675. qdelim:  mov    a,m
  1676.      ani    07fh;        Just in case
  1677.      call    upshft
  1678.      cpi    07fh
  1679.      rz;            A rubout is a delimiter
  1680.      cpi    '='
  1681.      rz
  1682.      cpi    ','
  1683.      rz
  1684.      cpi    '_'
  1685.      rz
  1686.      cpi    '.'
  1687.      rz
  1688.      cpi    ':'
  1689.      rz
  1690.      cpi    ';'
  1691.      rz
  1692.      cpi    '<'
  1693.      rz
  1694.      cpi    '>'
  1695.      rz
  1696.      cpi    '['
  1697.      rz
  1698.      cpi    ']'
  1699.      rz
  1700.      cpi    ' '
  1701.      rz
  1702.      rnc;            
  1703.      cmp    a;        All controls are delimiters
  1704.      ret;            Including EOL
  1705. ;
  1706. ; Skip to non-blank in (hl)^.  Z-flag if EOL reached.
  1707. ; At entry (HL) points to byte previous to first testee.
  1708. ; a,f,h,l
  1709. skipbl:  inx    h
  1710.      mov    a,m
  1711.      ora    a
  1712.      rz;            Empty line, Z-flag
  1713.      cpi    ' '
  1714.      jz    skipbl;     Skip leading blanks
  1715.      ret;            Nz, found something
  1716. ;
  1717. ; No access exit
  1718. noacc:     lxi    d,illegl
  1719.      jmp    exeunt
  1720. ;
  1721. ; Parse drive/user from line (HL)^  return user in (A), set drive in (DE)^
  1722. ; At exit (HL) points past any drive/user specification. Drive/user
  1723. ; validity is not checked here.  Carry for any error, z-flag for no entry
  1724. ; a,f,b,c,h,l
  1725. setdu:     mvi    a,':';        Scan for ':'
  1726.      call    scan;        Returns (A) = position
  1727.      jc    setdu2;     No drive/user specified
  1728.      cpi    4
  1729.      jnc    setdu2;     Not in 1st 4 characters, not du spec
  1730.      mov    c,a;        Save position
  1731.      mov    a,m
  1732.      call    upshft
  1733.      sui    '@'
  1734.      rc;            Illegal, catches initial ':'
  1735.      stax    d;        Preventing any searches unless '@'
  1736.      inx    h
  1737.      call    getusr;     Default, if none specified
  1738.      mov    b,a
  1739.      dcr    c;        Range 0...2
  1740.      jz    setdu1;     No user spec
  1741.      mvi    b,0
  1742.      call    decin
  1743.      rc;            Illegal character
  1744.      dcr    c;        Range 0..1
  1745.      jz    setdu1;     One char in user spec only
  1746.      call    decin
  1747.      rc;            Illegal character
  1748. setdu1:  ori    1;        Reset Z-flag, have values
  1749.      mov    a,b
  1750.      inx    h;        Now point past the ':'
  1751.      ret
  1752.  
  1753. setdu2:  call    getusr;     No spec, set z flag & default usr
  1754.      cmp    a;        Set z flag
  1755.      ret
  1756. ;
  1757. ; Return current user in (A)
  1758. ; a,f
  1759. getusr:  mvi    a,0ffh
  1760. ;     "      "
  1761. ; Set current user to (A)
  1762. ; a,f
  1763. sguser:  push    d
  1764.      mov    e,a
  1765.      mvi    a,gsuser
  1766.      call    sys
  1767.      pop    d
  1768.      ret
  1769. ;
  1770. ; Check for valid drive specification (A).  Carry for invalid value.
  1771. ; Uses global "DRVSUP" value and "OLDDRV" values
  1772. ; a,f
  1773. chkdv:     ora    a
  1774.      rz;            Default is always ok
  1775.      push    h
  1776.      lhld    olddrv
  1777.      cmp    l
  1778.      pop    h;        Specific reference to
  1779.      rz;            Logged in drive is ok
  1780.      push    h
  1781.      lhld    drvsup
  1782. chkdv2:  dad    h
  1783.      dcr    a
  1784.      jnz    chkdv2;     Shift access bit into carry
  1785.      pop    h;        Carry for access at this point
  1786.      cmc
  1787.      ret
  1788. ;
  1789. ; Incorporate character (HL)^ into the value (E) (decimal).
  1790. ; Carry for llegal character, else advance (HL).
  1791. ; a,f,b
  1792. decin:     mov    a,m
  1793.      sui    '0'
  1794.      rc;            Illegal
  1795.      cpi    9+1
  1796.      cmc
  1797.      rc;            Illegal
  1798.      inx    h
  1799.      push    psw
  1800.      mov    a,b
  1801.      add    a;        2*
  1802.      add    a;        4*
  1803.      add    b;        5*
  1804.      add    a;        10*
  1805.      mov    b,a
  1806.      pop    psw
  1807.      add    b
  1808.      mov    b,a
  1809.      ret
  1810. ;
  1811. ; Scan (HL) up for (A) or to EOL (marked by null).
  1812. ; Return (A) = relative position (0 based), carry if not found.
  1813. ; a,f
  1814. scan:     push    b
  1815.      push    h
  1816.      mvi    c,-1
  1817.      dcx    h
  1818. scan1:     inx    h
  1819.      inr    c
  1820.      cmp    m
  1821.      jz    scan2;        Found, carry clear
  1822.      push    b;        Check for end of string
  1823.      mov    c,m;        This test occurs after the char test
  1824.      inr    c;        So that a null will be found. Else
  1825.      dcr    c;        A null signifies end of string.
  1826.      pop    b;        Don't play with memory, may be ROM.
  1827.      jnz    scan1;        Not EOS, continue
  1828.      stc;            End of line, not found
  1829. scan2:     mov    a,c
  1830.      pop    h
  1831.      pop    b
  1832.      ret
  1833. ;
  1834. ; This restores the entry drive/user value
  1835. ; a,f,e
  1836. restor:  lda    oldusr
  1837.      call    sguser
  1838.      lda    olddrv
  1839.      mov    e,a
  1840.      mvi    a,setdrv
  1841.      call    sys
  1842.      ret
  1843. ;
  1844. ; Upshift (A)
  1845. ; a,f
  1846. upshft:  cpi    'a'
  1847.      rc
  1848.      cpi    'z'+1
  1849.      rnc
  1850.      ani    05fh
  1851.      ret
  1852.     endif;        duspec
  1853. ;
  1854.     if    extract
  1855. ; See if we use wheel test.  If so, test wheel byte.
  1856. ; Returns Z set if wheel not set, or no file output,
  1857. ; else returns with Z not set for output to file.
  1858. ; a,f
  1859. outtst:  call    qwhl
  1860.      rz;            wheel not set
  1861.      lda    outflg;     Get output flag
  1862.      ora    a;        True for output to file
  1863.      ret
  1864.     endif;        extract
  1865. ;
  1866. ; Cheek wheel status.  WHLADR = 0 acts as if wheel on, else checks
  1867. ; NZ flag for priviledged operation
  1868. ; a,f
  1869. qwhl:    push    h
  1870.     lhld    whladr
  1871.     mov    a,m;        Gets 0c3 or 0cd at lcn 0 if whladr=0
  1872.     pop    h
  1873.     ora    a;        Non-zero means priviledged
  1874.     ret
  1875. ;
  1876. nfound: db    'Member '
  1877. nofmsg: db    'Not found',cr,lf,lf,0
  1878.  
  1879. signon: db    cr,lf,'LT',ver/10+'0',ver mod 10+'0'
  1880.     db    ' [d[u]:]lbr/filename [d[u]:][component] [$u]'
  1881.     db    '     by C.B. Falconer',cr,lf
  1882. sign1:    db    '^S pause, ^C abort, ^X next'
  1883.     db        ' file, ^Z stops paging',0
  1884.  
  1885. usage:    db    cr,lf,'   Type/uncrunch/unsqueeze/unLZH '
  1886.     db        'files or LBR members',cr,lf
  1887.     db    '   Drive/user after lbr/filename '
  1888.     db        'causes file output.',cr,lf
  1889.     db    '   $U at end disables unsq/uncr/unlzh '
  1890.     db        'of compressed files',cr,lf
  1891.     db    '   (wildcards permitted)'
  1892.     db    cr,lf,lf
  1893.     db    'Examples:',cr,lf
  1894.     db    '   B>LT A3:HELLO SOURCE.AZM     '
  1895.     db        '   [console]     (defaults to HELLO.LBR)',cr,lf
  1896.     db    '   A>LT LZHENCOD.DYC            '
  1897.     db        '   [console]     (handles LZH encoding)',cr,lf
  1898.     db    '   A>LT SQUEEZE.DQC             '
  1899.     db        '   [console]',cr,lf
  1900.     db    '   A>LT HELLO *.*               '
  1901.     db        '   [console, all typable]',0
  1902. ;
  1903. ; 2nd part when wheel set or disabled
  1904. whlusg: db    '   B>LT B:HELLO A4:SOURCE.AQM   '
  1905.     db        '   [file]',cr,lf
  1906.     db    '   B>LT B:HELLO A4:SOURCE.AQM $U'
  1907.     db        '   [file with no unsqueeze]',cr,lf
  1908.     db    '   A>LT B:CRUNCH.AZM A:         '
  1909.     db        '   [file]',0
  1910.  
  1911. abrmsg: db    cr,lf,'++ ABORTED ++',cr,lf,0
  1912. clean:    db    cr,'        ',cr,0;        Erase the "more"
  1913. eofmsg: db    'Early EOF, aborted',0
  1914. exists: db    ' exists, purge (y/n)? ',0
  1915. ffsep:    db    ' =>> ',0;            File-file separator
  1916. corrpt: db    'LBR file corrupt',0
  1917. mbrmsg: db    'Member: ',0
  1918. more:    db    '[more] ',0
  1919. badfile:db    cr,lf,lf,bell,'Corrupt or unknown format file',cr,lf,0
  1920.  
  1921.     if    limitt
  1922. cant:     db    bell," ...Can't type a '",0
  1923. cant2:     db    "' file",cr,lf,0
  1924.     endif;        limitt
  1925.  
  1926.     if    extract
  1927. noroom:  db    cr,lf,lf,bell,'No space, aborting',0
  1928.     endif;        extract
  1929.  
  1930.     if    limitl
  1931. excess:  db    bell,'Too long, transfer with KMD',cr,lf,0
  1932.     endif;        limitl
  1933.  
  1934.     if    duspec
  1935. illegl:  db    bell,'Access denied',cr,lf,0
  1936.     endif;        duspec
  1937. ;
  1938. ; -------------------------------------------------------------------
  1939. ;
  1940.     dseg
  1941. ; Link the data segment after the code.  Use 2 passes if necessary.
  1942. ;
  1943. ; Temporary storage area
  1944. bufptr: dw    0
  1945. chrcnt: db    0
  1946.     db    0
  1947. lincn1: db    0;        Lines printed since [more]
  1948. paglns: db    0;        Ln/page before pause, 0 causes setup
  1949.  
  1950. nampt1: dw    endu;        NAMBUF
  1951. namptr: dw    endu;        NAMBUF
  1952. rcnt:    dw    65535;        Maximum. record count for type
  1953.  
  1954. outptr: dw    outbuff;    File output buffer
  1955. ; It is helpful to ensure that the LAST initialized data item
  1956. ; is NON-ZERO.    Eases any final truncation, ensures CCITCRC can run.
  1957. ;;
  1958. ; This (uninitialized) portion takes up no space in the code file
  1959. ; (with reasonable linkers - l80 zero fills)
  1960. bytes:    ds    1;        in current outbuff sector
  1961. sector: ds    1;        no. in outbuff filling
  1962. memcnt: ds    2;        members in current library
  1963. lbrfcb: ds    9
  1964. lbrtyp: ds    3
  1965. lbrext: ds    20;        Lbrfcb+12; file extent
  1966. lbrsno: ds    1;        Lbrfcb+32; sector #
  1967. lbrrno: ds    3;        Lbrfcb+33; random rcd no.
  1968. memfcb: ds    16
  1969. memnam: ds    16
  1970.  
  1971. oldusr: ds    1
  1972. olddrv: ds    1
  1973. savusr: ds    1
  1974.  
  1975.     if    extract
  1976. inuser:  ds    1;        To restore after file output
  1977. outflg:  ds    1;        Do file output if true
  1978. outusr:  ds    1;        Output FCB usr
  1979. outfcb:  ds    33;        Output file FCB
  1980. dmaadd:  ds    2;        Write address
  1981. outbuff: ds    128*rec;    Output buffer
  1982.     endif;        extract
  1983. ;
  1984. ; Mark start of zeroed area, per component loop
  1985. zeros:
  1986.  
  1987. numflt: ds    1
  1988. char:    ds    1
  1989. rptchr: ds    1;        Char to repeat
  1990. rptcnt: ds    1;        Count of repeat characters
  1991. lincnt: ds    1;        Number of lines printed total
  1992. column: ds    1;        Crt column position
  1993. zerlen: ds    1
  1994.     if    xpnd
  1995. dleflg:  ds    1;        Flag a dle just received
  1996. dlecnt:  ds    1;        Count of blanks to emit
  1997.     endif;        xpnd
  1998. lastz:    ds    64;        Mark end of zeroed area, stack space
  1999.  
  2000. stack:    ds    2;        Store entry stack pointer
  2001. lbrbuf: ds    128;        Member read buffer
  2002. xlatbl: ds    258*4
  2003.  
  2004.     end    begin
  2005. , stack space
  2006.  
  2007.