home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BDOS / DOSPLSOR.ARK / CCPXTEND.MAC < prev    next >
Text File  |  1986-11-14  |  34KB  |  1,274 lines
  1. TITLE 'CCPXTEND 2.0.8 & LRUN - extends CCP operation (86/11/14)'
  2. subttl    'Definitions etc.'
  3. ;
  4. ;        USER MODIFIABLE EQUATES
  5. ;
  6. ; Define a secondary search drive and user if .LBR or file is
  7. ; not found after initial search of current area:
  8. ;
  9. ; configures byte at 0103h.  If COMMAND.LBR exists on the
  10. ; default drive, this (if <> '@') forces a further search
  11. ; when the module is not found.
  12. ssdrv    equ    'A';    Valid values are 'A' through 'P'.
  13. ;            set to "@" to defeat drive search
  14. ;
  15. ; configures byte at 0104h.  For use with DOS+ paths should
  16. ; normally be disabled, and rely on $SYS file visibility.
  17. ssusr    equ    0ffh;    Valid values are  0  through 31.
  18. ;            set to 0ffh to defeat user search.
  19. ;
  20. ; The (8 char) name at 0109h defines a further default program.
  21. ;
  22. ; Default library may also be modified.  See label DFLTNAM.
  23. ;--------------------------------------------------------------
  24. ;
  25. ; Revisions copyright (c) 1985 by C.B. Falconer.  Released under
  26. ; the identical conditions to those of Gary Novosielski, below.
  27. ;
  28. ; A revision of Gary Novosielski's LRUN program to co-operate
  29. ; with CCPLUS.  When reached (automatically) from CCPLUS both the
  30. ; default and system disks have been searched for the file.  No
  31. ; alternate user value has yet been used.
  32. ;
  33. ; Use with CCPLUS results in the following syntax at the CCP level
  34. ; when this program is named "CCPXTEND.SYS" (before the planned 
  35. ; extensions below)
  36. ;
  37. ; B>name [command tail]            executes name as a .COM on the
  38. ;                    default or alternate drives, or
  39. ;                    as a component of COMMAND.LBR
  40. ;                    on either drive.  Alt. user is
  41. ;                    also searched.
  42. ;
  43. ; B>-d: name [command tail]        Executes name as a component
  44. ;                    of d:COMMAND.LBR only.
  45. ;
  46. ; B>-lbrname name [command tail]    Executes name as a component of
  47. ;                    lbrname.LBR on either drive/usr
  48. ;
  49. ; B>-d:lbrname name [command tail]  Executes name as a component of
  50. ;                    d:lbrname.LBR only
  51. ;
  52. ; B>-d:lbrname.ext name [command tail] Executes name as a component
  53. ;                    of d:lbrname.ext only.
  54. ;
  55. ; Overall, the search path for a command without disk spec. is:
  56. ;    1. default drive, current user (normal CPM stops here)
  57. ;    2. system drive, current user (CCPLUS alone stops here)
  58. ;    3. default drive, user 0 (if current user not 0)
  59. ;    4. system drive, user 0
  60. ;    5. default drive, current user, in COMMAND.LBR
  61. ;    6. system drive, current user, in COMMAND.LBR
  62. ;    7. default drive, user 0, in COMMAND.LBR
  63. ;    8. system drive, user 0, in COMMAND.LBR
  64. ;               . . .
  65. ;    9. repeats 3 thru 8 to find RUNPCD.COM.  Can easily be
  66. ;       modified to attempt for JOB or SUBMIT or anything else
  67. ;       desired. If found it is up to RUNPCD to find the file.
  68. ;
  69. ; The alternate user (shown as 0 above) and drive (shown as system
  70. ; drive above) are easily reconfigured (locations 103..104h)
  71. ;
  72. ; Since this program receives the complete command line from CCPLUS
  73. ; it can also implement DU style disk/user specifications in future
  74. ;
  75. ; NOTE that if a file -nnn.COM exists it can be executed by CCPLUS
  76. ; before this system is reached.
  77. ;
  78. ; CAVEAT: the normal SYSGEN program expects to be loaded without
  79. ; disturbing memory from 0900h up through about 237fh (varies with
  80. ; system).  Even the 0900h may be invalid for some systems (this is
  81. ; where the bootstrap image goes).  To use SYSGEN from COMMAND.LBR
  82. ; without taking special precautions (for altering systems, e.g.
  83. ; installing CCPLUS) this program must not disturb this area. This
  84. ; version (LRUN 2.0.4 or CCPXTEND 1.4) does not disturb 0880h up,
  85. ; except for the 128 bytes below the CCP.
  86. ;
  87. ; The plan is:
  88. ;  (* [n] indicates revision implemented, if any *)
  89. ;        (using the first successful search)
  90. ; 1 [4]    Search the defined alternate user, if different
  91. ; 2 [2]    Do the library search.  If no library specification
  92. ;    check alternate disk, and then alternate user.  Success
  93. ;    is finding the component so that libraries can exist
  94. ;    in more than one place and still be searched.
  95. ; 3 [6]    If RUNPCD exists in any of the areas, pass it the line.
  96. ;    It will purge any $$$.SUB if unable to load/execute.
  97. ; 3a.   Alternatively pass the command to JOB to execute a submit
  98. ;       job stream.  Since JOB nests this is executable within it.
  99. ; 4.    GIVE UP
  100. ;
  101. revision equ    8;    Modified $$$.SUB erasure for use with CCP+
  102. ; (86/11/14)        which always uses A0: for the file.
  103. ;
  104. ;        7;    Corrected RUNPCD search. Uninitialized var.
  105. ; (86/05/15)        occasionaly prevented search. cbf
  106. ;
  107. ; (86/05/18)        Code unchanged, source m80 compatible. If
  108. ;            using m80/l80 truncate output file to 2k
  109. ;
  110. ;        6;    Installed search for RUNPCD executor
  111. ; (85/10/24)        (or other installed master name). cbf
  112. ;
  113. ; (85/10/23)        Unchanged.  Back to Intel mnemnonics.
  114. ;
  115. ;        5;    Fixed fopen again to reset current rcd no.
  116. ; (84/07/20)        Silly omission.  cbf.
  117. ;
  118. ;        4;    Added alternate user search for a file
  119. ; (84/07/17)        rather than a library component.  cbf
  120. ;
  121. ;        3;      Altered to use sequential reads on load.
  122. ; (84/07/16)        Repaired file open bug (reset recd no)
  123. ; cbf            This is in preparation for COM file loads.
  124. ;            Added user search defeat provision.
  125. ;            Since CCPLUS can be told to NOT upshift
  126. ;            command lines, added upshift in parsing
  127. ;            FCBs only.  We can pass lower case lines.
  128. ;
  129. ;        2;    For lrun operation.  Quietened error
  130. ; (84/07/14)        messages to act like CCP(lus)
  131. ; cbf 
  132. ;            84/07/14 Converted to Z80 mnemnonics
  133. ;            (still only 8080 opcodes used)
  134. ; (83/10/23)    1;    suppressed sign-on except for help. cbf
  135. ;
  136. version    equ    20;    82-11-19 Added equates for user
  137. ;             area to search for command.lbr.
  138. ;
  139. ;        1$0;    82-08-06 Initial source release
  140. ;
  141. ; Can be assembled with SLR's SLRMAC or uSoft's M80 - cbf.
  142. ;
  143. ; Due to the complexity of the relocation macros, this program may
  144. ; take a while to assemble.  Be prepared for periods of no disk
  145. ; activity on both passes before pressing panic button.    G.P.N.
  146. ;
  147. ;
  148. ;--------------------------NOTICE------------------------------
  149. ;
  150. ;   (c) Copyright 1982    Gary P. Novosielski
  151. ;    All rights reserved.
  152. ;
  153. ;   The following features courtesy of Ron Fowler:
  154. ;    1) command line reparsing and repacking (this allows
  155. ;    the former load-only program to become a load & run
  156. ;    utility).
  157. ;    2) code necessary to actually execute the loaded file
  158. ;    3) the HELP facility (LRUN with no arguments)
  159. ;    4) modified error routines to avoid warm-boot delay
  160. ;       (return to CCP directly instead)
  161. ;
  162. ;    Permission to distribute this program in source or
  163. ;    object form without prior written aproval is granted
  164. ;    only under the following conditions.
  165. ;
  166. ;        1. No charge is imposed for the program.
  167. ;        2. Charges for incidental costs including
  168. ;           but not limited to media, postage, tele-
  169. ;           communications, and data storage do not
  170. ;           exceed those costs actually incurred.
  171. ;        3. This Notice and any copright notices in
  172. ;           the object code remain intact 
  173. ;
  174. ;            (signed)  Gary P. Novosielski
  175. ;
  176. ;     -----------------------------------------------------
  177. ;
  178. ; LRUN is intended to be used in conjunction with libraries
  179. ; created with LU.COM, a library utility based upon the
  180. ; groundwork laid by Michael Rubenstein, with some additional
  181. ; inspiration from Leor Zolman's CLIB librarian for .CRL files.
  182. ;
  183. ; The user can place the less frequently used command (.COM)
  184. ; files in a library to save space, and  still be able to run
  185. ; them when required, by typing:
  186. ;     LRUN <normal command line>.
  187. ; The name of the library can be specified, but the greatest
  188. ; utility will be achieved by placing all commands in one
  189. ; library called COMMAND.LBR, or some locally defined name,
  190. ; and always letting LRUN use that name as the default.
  191. ;
  192. ;
  193. ; Syntax:
  194. ;    LRUN [-<lbrname>] <command> [<parameters>]
  195. ;
  196. ; where:
  197. ; <lbrname>    is the optional library name.  In the
  198. ;        distrubution version, this defaults to
  199. ;        COMMAND.LBR.  If the user wishes to use a
  200. ;        different name for the default, the 8-byte
  201. ;        literal at DFLTNAM below may be changed to
  202. ;        suit local requirements. The current drive
  203. ;        is searched for the .LBR file, and if not
  204. ;        found there, the A: drive is searched.
  205. ;        **Note that the leading minus sign (not a part
  206. ;        of the name) is required to indicate an
  207. ;        override library name is being entered.
  208. ;
  209. ; <command>    is the name of the .COM file in the library
  210. ;
  211. ; <line>    is the (possibly empty) set of parameters
  212. ;        which are to be passed to <command>, as in
  213. ;        normal CP/M syntax.  Notice that if the
  214. ;        library name is defaulted, the syntax is
  215. ;        simply:
  216. ;     LRUN <command line>
  217. ;        which is just the normal command line with
  218. ;        LRUN prefixed to it.
  219. ;
  220. ;--------------------------------------------------------------
  221. ;
  222. stackspace    equ    64;    Minimum assignment
  223. ;
  224. query        equ    -1
  225. @con        equ    2
  226. @msg        equ    9
  227. @ver        equ    12
  228. @opn        equ    15
  229. @del        equ    19
  230. @frd        equ    20
  231. @dma        equ    26
  232. @usr        equ    32
  233. @rrd        equ    33
  234. ;
  235. cpmbase        equ    0
  236. boot        equ    cpmbase
  237. bdos        equ    boot+5
  238. tfcb        equ    boot+5CH
  239. tfcb1        equ    tfcb
  240. tfcb2        equ    tfcb+16
  241. tbuff        equ    boot+80H
  242. tpa        equ    boot+100H
  243. ctrl        equ    ' '-1;        Ctrl char mask
  244. cr        equ    ctrl AND 'M'
  245. lf        equ    ctrl AND 'J'
  246. tab        equ    ctrl AND 'I'
  247. ff        equ    ctrl AND 'L'
  248. bs        equ    ctrl AND 'H'
  249. FALSE        equ    0
  250. TRUE        equ    NOT FALSE
  251. ;
  252. cpm    macro    func,oprnd,condtn
  253.     if    NOT NUL oprnd
  254.      lxi    d,oprnd
  255.     endif        ;;    of not nul oprnd
  256.     if    NOT NUL func
  257.      mvi    c,@&func
  258.     endif
  259.     if    NUL condtn
  260.      call    bdos
  261.     else
  262.      c&condtn bdos    ;;     call condtn,bdos (for Zilog mnems)
  263.     endif
  264.     endm
  265. ;
  266. ; Macro Definitions for relocatable code
  267. ;
  268. overlay    set    0;    default puts bits after code. Can be set
  269. ;            non-zero to define overlayable area
  270. ;
  271. ; Sub-macros for system
  272. rtag    macro    LBL
  273. ??R&LBL    equ    $+2-@base
  274.     endm
  275. ;
  276. rgrnd    macro    LBL
  277. ??R&LBL    equ    0FFFFH
  278.     endm
  279. ;
  280. ; The usable macros for coding
  281. ;
  282. ; "RR    <lxi    d,address>"
  283. RR    macro    INST
  284. @rlbl    set    @rlbl+1
  285.     rtag    %@rlbl
  286.     INST-@base
  287.     endm
  288. ;
  289. ; Following needed if coded in Zilog mnemnonics
  290. ; "SR    <ld>    <(location)>,<hl>"
  291. SR    macro    op,opnd,reg
  292. @rlbl    set    @rlbl+1
  293.     rtag    %@rlbl
  294.     op    (opnd-@base),reg
  295.     endm
  296. ;
  297. ; "LR    <ld>    <hl>,<(location)>"
  298. LR    macro    op,reg,opnd
  299. @rlbl    set    @rlbl+1
  300.     rtag    %@rlbl
  301.     op    reg,(opnd-@base)
  302.     endm
  303. ;
  304. ; More sub-macros for bit map generation
  305. nxtrld    macro    NN
  306. @rld    set    ??R&NN
  307. @nxtrld    set    @nxtrld + 1
  308.     endm
  309. ;
  310.     subttl    'Outer Block'
  311. ;
  312. ; Enter here from Console Command Processor (CCP)
  313. ;
  314.     aseg;            for m80
  315.     org    tpa
  316. ccpin:    jmp    begin;        leave space for parameters
  317. ;
  318. ; These are the only use of ssdrv and ssusr.
  319. altdrv:    db    ssdrv;        Put here to allow easy patching
  320. altusr:    db    ssusr
  321.     db    0,0,0,0;    spares for configuration
  322. ;
  323. ; Change this name to run a different default file.
  324. ; (e.g. JOB or SUBMIT) if desired. Blank name disables
  325. runpcd:    db    'RUNPCD  ';    executed if component not found
  326. ;
  327. ;    the HELP message and authorship notice
  328. ;
  329. hlpmsg:
  330.  db    'LRUN Ver ';    Signon message
  331.  db    version/10+'0'
  332.  db    '.'
  333.  db    version MOD 10+'0','.',revision+'0'
  334.  db    ' & CCPXTEND.SYS',cr,lf
  335.  db    ' Copyright (c) 1982  Gary P. Novosielski',cr,lf
  336.  db    tab,'   (c) 1985  C.B. Falconer'
  337.  db    cr,lf,'Correct syntax is:'
  338.  db    cr,lf
  339.  db    lf,tab,'LRUN [-<lbrname>] <command line>'
  340.  db    cr,lf
  341.  db    lf,'Where <lbrname> is the optional library name'
  342.  db    cr,lf,'(Note the preceding "-".  ) If omitted,'
  343.  db    cr,lf,'the default command library is used.'
  344.  db    lf
  345.  db    cr,lf,'<command line> is the name and parameters'
  346.  db    cr,lf,'of the command being run from the library,'
  347.  db    cr,lf,'just as if a separate .COM file were being run.'
  348.  db    cr,lf,lf
  349.  db    'Also implements a search path',cr,lf
  350.  db    'Under CCPLUS operation is automatic$'
  351. ;
  352. comlit:    db    'COM'
  353. ;
  354. dfltnam:
  355.     db    'COMMAND ';     <---change this if you like---
  356. lbrlit:    db    'LBR'
  357. ;
  358. begin:    lxi    h,0;        get the CCP entry stackpointer
  359.     dad    sp;        (used only if HELP request
  360.     shld    spsave;         is encountered)
  361.     lda    bdos+2
  362.     sui    8;        allow for ccp space
  363.     mov    h,a
  364.     mvi    l,0
  365.     sphl;            ensure adequate stack room
  366. ;    "    "
  367. ; Initialize, find library entry, etc.
  368.     call    setup
  369.     cc    trypcd;        try for RUNPCD
  370.     jc    nomemb;        cannot find it
  371. ;    "    "
  372. ; Move the armed loader into high memory
  373.     lhld    bdos+1;        find top of memory
  374.     mov    a,h;        page address
  375.     sui    pages;        Form destination address in
  376.     mov    d,a;        DE pair.
  377.     mvi    e,0
  378.     push    d;        save on stack
  379.     lxi    h,@base
  380.     lxi    b,seglen
  381.     call    move;        Move the active segment.
  382. ;    "    "
  383. ; The segment is now moved to high memory, but not properly
  384. ; relocated.  The bit table which specifies which addresses need
  385. ; to be adjusted is located just after the last byte of the source
  386. ; segment, so (HL) is now pointing at it.
  387.     pop    d;        beginning of newly moved code.
  388.     lxi    b,seglen;    length of segment
  389.     push    h;        save pointer to reloc info
  390.     mov    h,d;        offset page address
  391. ;    "    "
  392. ; Scan through the newly moved code, and adjust any page addresses
  393. ; by adding (H) to them.  The word on top of the stack points to
  394. ; the next byte of the relocation bit table.  Each bit in the table
  395. ; corresponds to one byte in the destination code.
  396. ; A value of 1 indicates the byte is to be adjusted.
  397. ; A value of 0 indicates the byte is to be unchanged.
  398. ;
  399. ; Thus one byte of relocation information serves to mark 8 bytes of
  400. ; object code.  The bits which have not been used yet are saved in
  401. ; L until all 8 are used.
  402. ;    "    "
  403. fixup:    dcx    b;        count down. Not zero on entry
  404.     mov    a,e
  405.     ani    07H;        on 8-byte boundary?
  406.     jnz    fixup1
  407.     xthl;            Get next byte of relocation bits
  408.     mov    a,m
  409.     inx    h
  410.     xthl    
  411.     mov    l,a;        save in register L
  412. ;    "    "
  413. fixup1:    mov    a,l;        remaining bits from L
  414.     ral;            next bit to CARRY
  415.     mov    l,a;        save the rest
  416.     jnc    fixup2;        No relocation here
  417.     ldax    d;        fix this byte
  418.     add    h;        (H) is the page offset
  419.     stax    d
  420. fixup2:    inx    d;        advance to next address
  421.     mov    a,b
  422.     ora    c;        test if finished
  423.     jnz    fixup;        more
  424. ;    "    "
  425. ; Finished.  Jump to the first address in the new
  426. ; segment in high memory.
  427.     inx    sp;        Remove the reloc info pointer
  428.     inx    sp;        (h) still has the page address
  429.     mov    l,a;        move zero to l
  430.     pchl;            Stack is valid
  431. ;
  432.     subttl    'Subroutines'
  433. ;
  434. ; Try for a RUNPCD available.  If so, let it try for the command
  435. trypcd:    lxi    h,runpcd
  436.     mov    a,m
  437.     cpi    ' ';        blank name inhibits this section
  438.     stc
  439.     rz
  440.     lxi    d,tbuff + 1;    move the RUNPCD (or whatever is
  441.     mvi    b,8;         specified) into the command line
  442.     call    insert
  443.     lxi    h,member
  444.     mov    a,m
  445.     ora    a
  446.     stc
  447.     rnz;            drive specified
  448.     inx    h
  449.     mvi    b,8;        do it all over again for searchee
  450.     call    insert
  451.     lxi    h,hold;        copy the original command line tail
  452.     mov    b,m;        size
  453. tryp2:    inx    h;
  454.     mov    a,m
  455.     cpi    ' '
  456.     jnz    tryp3;        scan off any leading blanks
  457.     dcr    b;        (already forced one in)
  458.     jnz    tryp2
  459.     inr    b
  460. tryp3:    mov    a,m
  461.     stax    d
  462.     inx    d
  463.     inx    h
  464.     ora    a
  465.     jz    tryp5;        terminator, installed
  466.     inr    e
  467.     dcr    e
  468.     stc
  469.     jz    tryp4;        past page end, abort transfer
  470.     dcr    b
  471.     jnz    tryp3
  472.     jmp    tryp5;        not oversized line
  473. tryp4:    dcx    d;        oversized line, truncate it
  474. tryp5:    xra    a
  475.     stax    d;        terminate line
  476.     lxi    h,-tbuff
  477.     dad    d;        compute line length
  478.     mov    a,l
  479.     sta    tbuff
  480.     jmp    setup0;        now go all around again
  481. ;
  482. ; Any one-shot initialization code goes here.
  483. setup:    lxi    h,noload
  484.     shld    ccpin+1;    Prevent reentry
  485.     mvi    a,@ver
  486.     call    dos;        Test version of CP/M in use
  487.     cpi    20H;        2.0 or better?
  488.     jc    badver;        No, bitch and quit.
  489.     call    getusr;        What's the current user area?
  490.     sta    entusr;        Save for later.
  491. ;    "    "
  492. ; entry point for trypcd 
  493. setup0:    call    parse;        Re-parse command line
  494.     lxi    d,member+9;    Check member filetype
  495.     ldax    d
  496.     cpi    ' ';        If blank,
  497.     jnz    setup1;        Not blank, 
  498.     lxi    h,comlit
  499.     call    move3;        else default to COM.
  500. setup1:    lxi    d,lbrfil+9;    Check library filetype
  501.     ldax    d
  502.     cpi    ' ';        If blank,
  503.     jnz    setup2
  504.     lxi    h,lbrlit
  505.     call    move3;         default to LBR
  506. setup2:    lxi    d,lbrfil+1;    Check name
  507.     ldax    d
  508.     cpi    ' ';        If blank,
  509.     jnz    setup3
  510.     lxi    b,8
  511.     lxi    h,dfltnam
  512.     call    move;         use default name.
  513. ;    "    "
  514. ; Now test for a file on the alternate user.
  515. ; I am not too proud of this code, but it seems to work. cbf
  516. setup3:    lxi    h,lbrfil
  517.     mov    a,m
  518.     sta    lbrdsk;        Save for future restoration
  519.     lxi    d,lbrnam
  520.     lxi    b,16
  521.     call    move;        save lbr file name
  522.     lda    altusr
  523.     inr    a
  524.     jz    lopen;        alt user defeated, try lbr
  525.     call    tryalt
  526.     jc    setup4;        NOT found as file on altusr
  527.     lxi    h,hold
  528.     call    packup;        restore the command line
  529.     ora    a;        clear carry, success
  530.     ret 
  531. setup4:    lda    entusr
  532.     mov    e,a
  533.     mvi    a,@usr
  534.     call    dos;        back to default user
  535.     lxi    d,lbrfil
  536.     lxi    h,lbrnam
  537.     lxi    b,16
  538.     call    move;        restore any altered lbrfil name.
  539. ;    "    "
  540. ; Open the library and search for component
  541. ; This routine controls the search path.
  542. lopen:    lxi    d,lbrfil;
  543.     call    fopen;        Open for directory read.
  544.     inr    a;        Was it found?
  545.     jz    lopen1;        No, see if search continues
  546.     call    lsrch
  547.     rnc;            successful, lbr is positioned
  548. lopen1:    lxi    d,lbrfil;    lbr/component not found
  549.     ldax    d;        test drive spec to see if
  550.     ora    a;         it's explicit
  551.     jnz    lopen2;        explicit or trying altdrv
  552.     lda    altdrv
  553.     sui    '@'
  554.     stax    d;        Look on secondary drive,
  555.     jnz    lopen;        if enabled, before giving up.
  556. lopen2:    xchg    
  557.     call    getusr
  558.     xchg    
  559.     lxi    h,entusr
  560.     cmp    m
  561.     stc
  562.     rnz;            Failure, have tried alt usr/alt drv
  563.     lda    altusr
  564.     cmp    m
  565.     stc
  566.     rz;            Failure, was already on altuser
  567.     lda    lbrdsk
  568.     sta    lbrfil;        Set back to entry condition
  569.     ora    a
  570.     stc
  571.     rnz;            Failure, was explicit on entry 
  572.     lda    altusr
  573.     mov    e,a
  574.     inr    a;        Carry already set, check for 0ffh
  575.     rz;            Failure, user search defeated
  576.     mvi    a,@usr
  577.     call    dos;        Try alternate user/default drive
  578.     jmp    lopen;        on default drive first
  579. ;
  580. ; tryalt searches for component (member) under the alternate user
  581. ; If successful leave lbrfil opened to the "member" id and reset
  582. ; to access from the beginning, with lenx set to 65535.
  583. ; Carry for failure.
  584. tryalt:    lxi    h,65535;    Will need if success
  585.     shld    lenx;        otherwise lsrch will set it up
  586.     call    getusr
  587.     mov    b,a
  588.     lda    altusr
  589.     cmp    b
  590.     stc
  591.     rz;            Alt same as user, no search needed
  592.     mov    e,a
  593.     mvi    a,@usr
  594.     call    dos;        set user access
  595.     lxi    d,lbrfil
  596.     lxi    h,member
  597.     lxi    b,16
  598.     call    move;        set lbrfile to access member
  599. tryalt1:
  600.     lxi    d,lbrfil
  601.     call    fopen
  602.     inr    a
  603.     ora    a;        clear any carrys from bdos etc
  604.     rnz;            found it, go load
  605.     ldax    d
  606.     ora    a
  607.     stc
  608.     rnz;            this was the alternate disk try
  609.     lda    altdrv
  610.     sui    '@'
  611.     stc
  612.     rz;            alternate disk disabled
  613.     stax    d
  614.     jmp    tryalt1;    go try on alternate disk
  615. ;
  616. ;        End of setup.
  617. ;
  618. ; Search library directory.  Carry for failure
  619. ; a,f,b,c,d,e,h,l
  620. lsrch:    lxi    d,tbuff;    Library open, search it
  621.     mvi    a,@dma
  622.     call    dos
  623. lsrch1:    lxi    d,lbrfil
  624.     mvi    a,@frd
  625.     call    dos;        Read the directory
  626.     ora    a
  627.     stc
  628.     rnz;            Empty file, Give up.
  629.     lxi    h,tbuff;    Validate directory entry
  630.     mov    a,m
  631.     ora    a
  632.     stc
  633.     rnz;            Directory not active??
  634.     mvi    b,8+3;        Check for blanks
  635.     mvi    a,' '
  636. lsrch2:    inx    h
  637.     cmp    m
  638.     stc
  639.     rnz;            This is not a library
  640.     dcr    b
  641.     jnz    lsrch2
  642.     lhld    tbuff+1+8+3;    Index must be 0000
  643.     mov    a,h
  644.     ora    l
  645.     stc
  646.     rnz;            This is not a library
  647.     lhld    tbuff+1+8+3+2;    Get directory size
  648.     dcx    h;        We already read one.
  649.     push    h;        Save on stack
  650. ;    "    "
  651. ; Search one chunk of directory
  652. lsrch3:    lxi    h,tbuff-32;    Point before buffer.
  653.     mvi    c,128/32;    Number of directory entries
  654. lsrch5:    lxi    d,32
  655.     dad    d;        Advance buffer pointer
  656.     call    chkeq;        Check if found yet.
  657.     jz    lsrch7;        Found member in .DIR
  658.     dcr    c;        test next entry
  659.     jnz    lsrch5;        Else need another chunk
  660.     pop    h;        Read sector count from TOS
  661.     mov    a,h
  662.     ora    l;        0 ?
  663.     stc
  664.     rz;            Member not found in this library
  665.     dcx    h;        Count down
  666.     push    h;        and put it back.
  667.     lxi    d,lbrfil
  668.     mvi    a,@frd
  669.     call    dos;        Get next directory sector
  670.     ora    a
  671.     jz    lsrch3
  672.     pop    h;        clean the stack
  673.     stc
  674.     ret;            Empty - not a library
  675. ;
  676. ; The name was found.  Now get index and length
  677. lsrch7:    pop    b;        Clear stack garbage
  678.     xchg;            Pointer to sector address.
  679.     mov    e,m;        Get First
  680.     inx    h
  681.     mov    d,m
  682.     xchg    
  683.     shld    random;        Save it in "random"
  684.     xchg    
  685.     inx    h;        Get Size to DE
  686.     mov    e,m
  687.     inx    h
  688.     mov    d,m
  689.     xchg;             Size to HL
  690.     shld    lenx    
  691.     mov    a,h
  692.     ora    l
  693.     stc
  694.     rz;            Can't handle zero length component
  695.     lxi    d,lbrfil;    Position the file at the first
  696.     mvi    a,@rrd;          sector of the component so
  697.     call    dos;          that further reads are sequential
  698.     ora    a
  699.     stc
  700.     rnz;            Failure
  701.     push    h
  702.     lxi    h,hold
  703.     call    packup;        Repack command line arguments
  704.     pop    h;        return the component length
  705.     ora    a;        clear carry, success
  706.     ret
  707. ;
  708. ;
  709.     subttl    'Utility subroutines'
  710. ;
  711. ; insert moves a name from hl^ to de^, max b chars
  712. ; terminates on first blank, leaving de pointing past
  713. ; the moved blank.  If no blank encounted, add one in
  714. ; The move is protected against extending the line
  715. ; beyond a page boundary (for moving to tbuff)
  716. ; a,f,b,d,e,h,l
  717. insert:    mov    a,m
  718.     stax    d
  719.     inx    d
  720.     inx    h
  721.     cpi    ' '
  722.     rz;            terminator, installed
  723.     inr    e
  724.     dcr    e
  725.     stc
  726.     rz;            past page end, abort transfer
  727.     dcr    b
  728.     jnz    insert
  729.     mvi    a,' ';        add in the terminator blank
  730.     stax    d
  731.     inx    d
  732.     ora    a;        clear any carry
  733.     ret
  734. ;
  735. ; Move 3 bytes from (hl) to (de) up
  736. ; a,f,b,c,d,e,h,l
  737. move3:    lxi    b,3
  738. ;    "    "
  739. ; Move (bc) bytes from (hl) to (de) up
  740. ; a,f,b,c,d,e,h,l
  741. move:    mov    a,b
  742.     ora    c
  743.     rz;            done
  744.     dcx    b
  745.     mov    a,m
  746.     inx    h
  747.     stax    d
  748.     inx    d
  749.     jmp    move
  750. ;
  751. ; REPARSE re-parses the fcbs from the command line,
  752. ; to allow the "-" character to prefix the library name
  753. ;
  754. parse:    lxi    d,member;    first reinitialize both fcbs
  755.     call    nitf
  756.     lxi    d,lbrfil
  757.     call    nitf
  758.     lxi    h,tbuff;    store a null at the end of
  759.     mov    e,m;         the command line (this is
  760.     mvi    d,0;         done by CP/M usually, except
  761.     xchg;             in the case of a full com-
  762.     dad    d;         mand line
  763.     inx    h
  764.     mvi    m,0
  765.     xchg;            tbuff pointer back in hl
  766. parse1:    inx    h;        bump to next char position
  767.     mov    a,m;        fetch next char
  768.     ora    a;        reached a null? (no arguments)
  769.     jz    help;        interpret as a call for help
  770.     cpi    ' ';        not null, skip blanks
  771.     jz    parse1
  772.     cpi    '-';        library name specifier?
  773.     jnz    parse2;        skip if not
  774.     inx    h;        it is, skip over flag character
  775.     lxi    d,lbrfil;    parse library name into FCB
  776.     call    getfn
  777. parse2:    lxi    d,member;    now parse the command name
  778.     call    getfn
  779.     lxi    d,hold+1;    pnt to temp storage for rest of cmd line
  780.     mvi    b,-1;        init a counter
  781. parse3:    inr    b;        bump up counter
  782.     mov    a,m;        fetch a char
  783.     stax    d;        move it to hold area
  784.     inx    h;        bump pointers
  785.     inx    d
  786.     ora    a;        test whether char was a terminator
  787.     jnz    parse3;        continue moving line if not
  788.     mov    a,b;        it was, get count
  789.     sta    hold;        save it in hold area
  790.     ret
  791. ;
  792. ; Here when HELP is requested (indicated
  793. ; by LRUN with no arguments)
  794. ;
  795. help:    lxi    d,hlpmsg
  796.     mvi    a,@msg
  797.     call    dos;        print the HELP message
  798. exit:    lhld    spsave;        find CCP re-entry adrs
  799.     sphl;            fix & return
  800.     ret
  801. ;
  802. ; Test status, name and type of dir. entry (hl)^ against "member"
  803. ; At exit DE points to last match+1 in directory entry, 
  804. ;         HL points to beginning of matchee
  805. ;         Z flag for a match.
  806. ; a,f,b,d,e
  807. chkeq:    push    h
  808.     mvi    b,1+8+3;    size to match
  809.     xchg;            with the one we're
  810.     lxi    h,member;    looking for.
  811. chkeq1:    ldax    d
  812.     cmp    m
  813.     jnz    chkeq2;        decided, not equal
  814.     inx    d
  815.     inx    h
  816.     dcr    b
  817.     jnz    chkeq1;        check more
  818. chkeq2:    pop    h
  819.     ret
  820. ;
  821. ;
  822. ;    File name parsing subroutines
  823. ;
  824. ; PACKUP retrieves the command line stored at hl^
  825. ; and moves it back to tbuff, then reparses
  826. ; the default file control blocks so the command
  827. ; will never know it was run from a library
  828. ; a,f,b,c,d,e,h,l
  829. packup:    mov    c,m;        get length byte in BC
  830.     mvi    b,0
  831.     inx    b;        bump up to because length byte doesn't
  832.     inx    b;          include itself or null terminator
  833.     lxi    d,tbuff
  834.     call    move;        moving everybody to Tbuff
  835.     lxi    h,tbuff+1;    point to the command tail
  836.     lxi    d,tfcb1;    first parse out tfcb1
  837.     call    getfn
  838.     lxi    d,tfcb2;    then tfcb2
  839. ;    "    "
  840. ; getfn gets a file name from text pointed to by reg hl into
  841. ; an fcb pointed to by reg de.    leading delimiters are ignored.
  842. ; entry hl    first character to be scanned
  843. ;    de    first byte of fcb
  844. ; exit    hl    character following file name
  845. ;
  846. getfn:    call    nitf;        init 1st half of fcb
  847.     call    gstart;        scan to first character of name
  848.     rz;            end of line found - leave fcb blank
  849.     call    getdrv;        get drive spec. if present
  850. ;    "    "
  851. ; getps gets the primary and secondary names into the fcb.
  852. ; entry hl    text pointer
  853. ; exit    hl    character following secondary name (if present)
  854. ; a,f,c,d,e,h,l
  855. getps:    mvi    c,8;        max length of primary name
  856.     call    getnm;        pack primary name into fcb
  857.     mov    a,m;        see if terminated by a period
  858.     cpi    '.';        If no secondary name then
  859.     rnz;            return default (blanks)
  860.     inx    h;        yup - move text pointer over period
  861. getps1:    mov    a,c;        update fcb pointer to secondary
  862.     ora    a
  863.     jz    getps2
  864.     inx    d
  865.     dcr    c
  866.     jmp    getps1
  867. getps2:    mvi    c,3;        pack secondary name into fcb
  868. ;    "    "
  869. ; getnm copies a name from the text pointer into the fcb for a
  870. ; given maximum length or until a delimiter is found, whichever
  871. ; occurs first.  if more than the maximum number of characters is
  872. ; present, characters are ignored until a a delimiter is found.
  873. ; entry hl    first character of name to be scaned
  874. ;    de    pointer into fcb name field
  875. ;    c    maximum length
  876. ; exit    hl    pointing to terminating delimiter
  877. ;    de    next empty byte in fcb name field
  878. ;    c    max length - number of characters transfered
  879. ; a,f,c,d,e,h,l
  880. getnm:    call    getch;        are we pointing to a delimiter yet?
  881.     rz;            if so, name is transfered
  882.     inx    h;        if not, move over character
  883.     cpi    '*';        ambigious file reference?
  884.     jz    getnm1;        if so, fill rest of field with '?'
  885.     call    upshft;        ensure upper case in FCB
  886.     stax    d;        if not, just copy into name field
  887.     inx    d;        increment name field pointer
  888.     dcr    c;        if name field full?
  889.     jnz    getnm;        nope - keep filling
  890.     jmp    getnm3;        yup - ignore until delimiter
  891. getnm1:    mvi    a,'?';        fill character for wild card match
  892. getnm2:    stax    d;        fill until field is full
  893.     inx    d
  894.     dcr    c
  895.     jnz    getnm2;        fall thru to ingore rest of name
  896. getnm3:    call    getch;        pointing to a delimiter?
  897.     rz;            yup - all done
  898.     inx    h;        nope - ignore another one
  899.     jmp    getnm3
  900. ;
  901. ; Upshift (a) if lower case only. Carry if (a) was lower case.
  902. ; a,f
  903. upshft:    cpi    'z'+1
  904.     rnc;            > 'z', not lower case
  905.     cpi    'a'
  906.     cmc
  907.     rnc;            < 'a', not lower case
  908.     ani    05fh;        actual upshift
  909.     stc;            signal an upshift performed
  910.     ret
  911. ;
  912. ; nitf fills the fcb with dflt info - 0 in drive field
  913. ; all-blank in name field, and 0 in ex,s1,s2 and rc flds
  914. ; a,f,b,c
  915. nitf:    push    d;        save fcb loc
  916.     xchg;            move it to hl
  917.     mvi    m,0;        zap dr field
  918.     inx    h;        bump to name field
  919.     mvi    b,11;        zap all of name fld
  920. nitlp1:    mvi    m,' '
  921.     inx    h
  922.     dcr    b
  923.     jnz    nitlp1
  924.     mvi    b,4;        zero others
  925. nitlp2:    mvi    m,0
  926.     inx    h
  927.     dcr    b
  928.     jnz    nitlp2
  929.     xchg;            restore hl
  930.     pop    d;        restore fcb pointer
  931.     ret
  932. ;
  933. ; gstart advances the text pointer (reg hl) to the first
  934. ; non delimiter character (i.e. ignores blanks).  returns a
  935. ; flag if end of line (00h or ';') is found while scaning.
  936. ; exit    hl    pointing to first non delimiter
  937. ;    a    clobbered
  938. ;    zero    set if end of line was found
  939. ; a,f,h,l
  940. gstart:    call    getch;        see if pointing to delim?
  941.     rnz;            nope - return
  942.     cpi    ';';        end of line?
  943.     rz;            yup - return w/flag
  944.     ora    a
  945.     rz;            yup - return w/flag
  946.     inx    h;        nope - move over it
  947.     jmp    gstart;        and try next char
  948. ;
  949. ; getdrv checks for the presence of a drive spec at the text
  950. ; pointer, and if present formats it into the fcb and
  951. ; advances the text pointer over it.
  952. ; entry hl    text pointer
  953. ;    de    pointer to first byte of fcb
  954. ; exit    hl    possibly updated text pointer
  955. ;    de    pointer to second (primary name) byte of fcb
  956. ; a,f,d,e,h,l
  957. getdrv:    inx    d;        point to name if spec not found
  958.     inx    h;        look ahead to see if ':' present
  959.     mov    a,m
  960.     dcx    h;        put back in case not present
  961.     cpi    ':';        is a drive spec present?
  962.     rnz;            nope - return
  963.     mov    a,m;        yup - get the ascii drive name
  964.     sui    'A'-1;        convert to fcb drive spec
  965.     dcx    d;        point back to drive spec byte
  966.     stax    d;        store spec into fcb
  967.     inx    d;        point back to name
  968.     inx    h;        skip over drive name
  969.     inx    h;        and over ':'
  970.     ret
  971. ;
  972. ; getch gets the character pointed to by the text pointer
  973. ; and sets the zero flag if it is a delimiter.
  974. ; entry hl    text pointer
  975. ; exit    hl    preserved
  976. ;    a    character at text pointer
  977. ;    z    set if a delimiter
  978. ;
  979. getch:    mov    a,m;        get the character
  980. ;    "    "
  981. ; Test (a) for a delimiter. Z flag if so
  982. qdelim:    cpi    '.'
  983.     rz    
  984.     cpi    ','
  985.     rz    
  986.     cpi    ';'
  987.     rz    
  988.     cpi    ' '
  989.     rz    
  990.     cpi    ':'
  991.     rz    
  992.     cpi    '='
  993.     rz    
  994.     cpi    '<'
  995.     rz    
  996.     cpi    '>'
  997.     rz    
  998.     ora    a;        Set zero flag on end of text
  999.     ret
  1000. ;
  1001. ; Output char (a) to console
  1002. ; f
  1003. couta:    push    d
  1004.     mov    e,a
  1005.     mvi    a,@con
  1006.     call    dos
  1007.     mov    a,e
  1008.     pop    d
  1009.     ret
  1010. ;
  1011. ; get current user value
  1012. ; a,f
  1013. getusr:    push    d
  1014.     mvi    e,query
  1015.     mvi    a,@usr
  1016.     call    dos
  1017.     pop    d
  1018.     ret
  1019. ;
  1020. ; Open file (de) for sequential access from beginning.
  1021. ; a,f
  1022. fopen:    push    h
  1023.     lxi    h,12
  1024.     dad    d;        point to recd. no. etc.
  1025.     xra    a
  1026.     mov    m,a;        reset to zero
  1027.     inx    h
  1028.     mov    m,a;        (is all this, apart from
  1029.     inr    m;         recd no. and hi random, needed?)
  1030.     mov    m,a
  1031.     inx    h
  1032.     mov    m,a;        reset recd. no
  1033.     lxi    h,32
  1034.     dad    d
  1035.     mvi    m,0;        reset current rcd no
  1036.     inx    h
  1037.     inx    h
  1038.     inx    h
  1039.     mvi    m,0;        reset hi random byte
  1040.     pop    h
  1041.     mvi    a,@opn
  1042. ;    "    "
  1043. ; Bdos call (a), preserving registers.  Result in (a) only
  1044. ; a,f
  1045. dos:    push    h
  1046.     push    d
  1047.     push    b
  1048.     mov    c,a
  1049.     call    bdos
  1050.     pop    b
  1051.     pop    d
  1052.     pop    h
  1053.     ret
  1054. ;
  1055. ; Showmember - list the name in "member" up to the first blank
  1056. ; or null or for a max of 8 chars.  For error exits
  1057. ; a,f,h,l
  1058. showmem:
  1059.     lxi    h,member
  1060.     mov    a,m
  1061.     inx    h
  1062.     ora    a
  1063.     jz    showm1;        no disk specifier
  1064.     adi    '@'
  1065.     call    couta
  1066.     mvi    a,':'
  1067.     call    couta
  1068. showm1:    mvi    b,-8;        max chars to list
  1069. showm2:    mov    a,m
  1070.     ora    a
  1071.     rz    
  1072.     cpi    ' '
  1073.     rz    
  1074.     call    couta
  1075.     inx    h
  1076.     inr    b
  1077.     jm    showm2
  1078.     ret
  1079. ;
  1080. ;
  1081. ; Error routines:
  1082. ;
  1083. badver:    call    abend
  1084.     db    'Can''t run under CP/M 1.4'
  1085.     db    '$'
  1086. nomemb:    call    showmem;    List the not-found file name
  1087.     call    abend
  1088.     db    '?$';        Act just like CCP
  1089. noload:    call    abend
  1090.     db    'No program in memory'
  1091.     db    '$'
  1092. nofit:    call    abend
  1093.     db    'NO SPACE';    Just like CCPLUS again. 
  1094.     db    '$'
  1095. ;
  1096. abend:    pop    d
  1097.     mvi    a,@msg
  1098.     call    dos
  1099.     mvi    a,@usr;            Rev. 8 
  1100.     mvi    e,0
  1101.     call    dos;        select user 0;    Rev. 8
  1102.     lxi    d,subfile
  1103.     mvi    a,@del
  1104.     call    dos;        delete subfile
  1105.     lda    entusr
  1106.     mov    e,a
  1107.     mvi    a,@usr
  1108.     call    dos;        Reset to entry user.
  1109.     jmp    exit
  1110. ;
  1111. ;
  1112.     subttl    'Relocatable segment'
  1113. ;
  1114. ; Adjust location counter to next 256-byte boundry
  1115. @base    equ    ($ + 0FFH) AND 0FF00H
  1116.     org    @base
  1117. @rlbl    set    0
  1118. ;
  1119. ;    The segment to be relocated goes here.
  1120. ;    Any position dependent (3-byte) instructions
  1121. ;    are handled by the "RR", "SR", "LR" macros.
  1122. ; *******************************************************
  1123. ;
  1124. ; This is a loader, which loads the content of "LBRFIL" (already
  1125. ; opened and positioned) to either the end of file or for a maximum
  1126. ; of (lenx) records.  If lenx is previously set to 65535 loading
  1127. ; will continue to the end of file.
  1128. ;
  1129. ; The open FCB has been moved up here into high memory
  1130. ; together with the loader code and entry stack setting.
  1131. ;
  1132. load:    lxi    h,tpa
  1133.   RR    <shld    loaddr>
  1134. ;    "    "
  1135. ; This high memory address and above, including CCP, must be
  1136. ; protected from being overlaid by loaded program.  For use of
  1137. ; sequential read this must be checked at each read.  Note that
  1138. ; this address is slighly north of a page boundary.
  1139. protect:
  1140. ;    "    "
  1141. ; The active loader loop
  1142. load1:
  1143.   RR    <lhld    loaddr>;     Increment for next time
  1144.     mov    d,h
  1145.     mov    e,l
  1146.     lxi    b,80H
  1147.     dad    b
  1148.   RR    <lxi    b,protect>;    check for over size
  1149.     mov    a,l
  1150.     sub    c;        If the next is above "protect"
  1151.     mov    a,h;        then this read will overwrite it
  1152.     sbb    b
  1153.   RR    <jnc    loadx>;        too large
  1154.   RR    <shld    loaddr>
  1155.     cpm    dma;        but use old value (DE)
  1156. ;    "    "
  1157.   RR    <lxi    d,lbrfil>
  1158.     cpm    frd;        Read the sector (sequential)
  1159.     ora    a;        Ok?
  1160.   RR    <jnz    load2>;        eof, bail out.
  1161. ;    "    "
  1162.   RR    <lhld    lenx>;        See if done yet.
  1163.     mov    a,l
  1164.     ora    h
  1165.     dcx    h
  1166.   RR    <shld    lenx>
  1167.   RR    <jnz    load1>;        Until done.
  1168. ;    "    "        Done - go run it
  1169. load2:
  1170.   RR    <lda    entusr>
  1171.     mov    e,a
  1172.     cpm    usr;        Restore USR number from setup.
  1173.     cpm    dma,tbuff;    Restore DMA adrs for user pgm
  1174.   RR    <lhld    spsave>;    Restore stack so application
  1175.     sphl;            can "ret" to ccp.
  1176.     jmp    tpa
  1177. ;
  1178. ; A loading error (too large) occurred 
  1179. loadx:    mvi    a,0c3h;        (JMP) Prevent execution of bad code
  1180.     sta    tpa    
  1181.   RR    <lxi    h,loadxx>;    Gyrations to reset usr/dma
  1182.     shld    tpa+1    
  1183.   RR    <jmp    load2>;        Execute dummy program instead
  1184. loadxx:
  1185.   RR    <lxi    d,ldmsg>;    Give message, like CCPLUS
  1186.     cpm    msg
  1187.     mvi    e,0
  1188.     cpm    usr;        Select user 0; Rev. 8
  1189.   RR    <lxi    d,subfile>;    Abort SUBMIT if in progress
  1190.     cpm    del
  1191.   RR    <lda    entusr>
  1192.     mov    e,a
  1193.     cpm    usr;        Restore USR number from setup.
  1194.      jmp    boot
  1195. ;
  1196. ldmsg:    db    'NO SPACE$'
  1197. lenx:    dw    0
  1198. entusr:    db    0
  1199. ;
  1200. subfile:
  1201.     db    1,'$$$     SUB',0,0,0,0
  1202. ; If used, this FCB will clobber the following one.
  1203. ; but it's only used on a fatal error, anyway.
  1204. ;
  1205. lbrdsk:    ds    1;    Save entry disk id for restoration
  1206. lbrfil:    ds    32;    Name/dsk placed here at setup
  1207.     db    0;    Normal FCB plus...
  1208. random:    ds    3;    ...Random access bytes
  1209. spsave:    ds    2;    stack pointer save
  1210. ;
  1211. overlay    set    $;    This defines the start of the bit map
  1212. maxmem:    ds    2
  1213. loaddr:    ds    2
  1214. ;
  1215. ;  **  NOTE BENE  **
  1216. ; The space from here to the end of the page, which resides just
  1217. ; below the CCP after relocation, is used as run-time stack space
  1218.     ds    stackspace;    make sure we retain enough
  1219. ;
  1220. ;    *******************************
  1221. ;    End of segment to be relocated.
  1222.     if    overlay EQ 0
  1223. overlay     set    $;    then start bitmap here
  1224.     endif
  1225. ;
  1226. pages    equ    ($-@base+0FFH)/256+8; (8 for ccp retention)
  1227. ;
  1228. seglen    equ    overlay-@base
  1229. ;
  1230. ;
  1231.     subttl    'Relocation bits'
  1232. ;
  1233.     org    @base+seglen
  1234. ;
  1235. ; Build the relocation information into a bit table immediately
  1236. ; following.  This area is not moved/relocated.
  1237. ;
  1238. @x    set    0
  1239. @bitcnt    set    0
  1240. @rld    set    ??R1
  1241. @nxtrld    set    2
  1242.     rgrnd    %@rlbl+1;    define one more label
  1243. ;
  1244.     REPT    seglen+8
  1245.     if    @bitcnt GT @rld
  1246.      nxtrld    %@nxtrld;    next value
  1247.     endif
  1248.     if    @bitcnt EQ @rld
  1249. @x     set    @x OR 1;    mark a bit
  1250.     endif
  1251. @bitcnt    set    @bitcnt + 1
  1252.     if    (@bitcnt MOD 8) EQ 0
  1253.      db    @x
  1254. @x     set    0;        clear hold variable for more
  1255.     else
  1256. @x     set    @x SHL 1;    not 8 yet. move over.
  1257.     endif
  1258.     endm
  1259. ;
  1260. ; Space to retain the original command line while checking
  1261. ; This area is not moved/relocated upwards.
  1262.     db    0
  1263. althld:    db    0,0;        to extend command line
  1264. hold:    db    0,0;        0 length, null terminator
  1265.     ds    128-2;        rest of HOLD area
  1266. ;
  1267. ; Holds the file name being searched
  1268. member:    ds    16;        input dsk/name like FCB
  1269. lbrnam:    ds    16;        Save library name
  1270. ;
  1271. ; blank the subtitle because slrmac leaves it from pass 1
  1272.     subttl
  1273.     END
  1274. ░