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 / MBUG / MBUG084.ARC / ZCPR.MAC < prev    next >
Text File  |  1979-12-31  |  52KB  |  2,054 lines
  1. ;;    TITLE    'ZCPR Version 1.0'
  2. ;
  3. ;  CP/M Z80 Command Processor Replacement (CPR) Version 1.0
  4.     .xlist
  5. ;    CCPZ CREATED AND CUSTOMIZED FOR ARIES-II BY RLC
  6. ;    FURTHER MODIFIED BY RGF AS V2.0
  7. ;    FURTHER MODIFIED BY RLC AS V2.1
  8. ;    FURTHER MODIFIED BY KBP AS V2.2
  9. ;    FURTHER MODIFIED BY RLC AS V2.4 (V2.3 skipped)
  10. ;    FURTHER MODIFIED BY RLC AS V2.5
  11. ;    FURTHER MODIFIED BY RLC AS V2.6
  12. ;    FURTHUR MODIFIED BY SBB AS V2.7
  13. ;    FURTHER MODIFIED BY RLC AS V2.8
  14. ;    FURTHER MODIFIED BY RLC AS V2.9
  15. ;    FURTHER MODIFIED BY RLC AS V3.0
  16. ;    FURTHER MODIFIED BY RLC AS V3.1
  17. ;    FURTHER MODIFIED BY RLC AS V4.0
  18. ;    ZCPR VERSION 1.0 CREATED FROM CCPZ VERSION 4.0 BY RLC IN
  19. ;        A COORDINATED EFFORT WITH CCP-GROUP
  20. ;
  21. ;    ZCPR is a group effort by CCP-GROUP, whose active membership involved
  22. ; in this project consists of the following:
  23. ;        RLC - Richard Conn
  24. ;        RGF - Ron Fowler
  25. ;        KBP - Keith Peterson
  26. ;        FJW - Frank Wancho
  27. ;    The following individual also provided a contribution:
  28. ;        SBB - Steve Bogolub
  29. ;
  30. ;
  31. ;******** Structure Notes ********
  32. ;
  33. ;    This CPR is divided into a number of major sections.  The following
  34. ; is an outline of these sections and the names of the major routines
  35. ; located therein.
  36. ;
  37. ; Section    Function/Routines
  38. ; -------    -----------------
  39. ;
  40. ;   --        Opening Comments, Equates, and Macro Definitions
  41. ;
  42. ;    0        JMP Table into CPR
  43. ;
  44. ;    1        Buffers
  45. ;
  46. ;    2        CPR Starting Modules
  47. ;            CPR1    CPR    RESTRT    RSTCPR    RCPRNL
  48. ;            PRNNF
  49. ;
  50. ;    3        Utilities
  51. ;            CRLF    CONOUT    CONIN    LCOUT    LSTOUT
  52. ;            READF    READ    BDOSB    PRINTC    PRINT
  53. ;            GETDRV    DEFDMA    DMASET    RESET    BDOSJP
  54. ;            LOGIN    OPENF    OPEN    GRBDOS    CLOSE
  55. ;            SEARF    SEAR1    SEARN    SUBKIL    DELETE
  56. ;            RESETUSR GETUSR    SETUSR
  57. ;
  58. ;     4        CPR Utilities
  59. ;            SETUD    SETU0D    UCASE    REDBUF    CNVBUF
  60. ;            BREAK    USRNUM    ERROR    SDELM    ADVAN
  61. ;            SBLANK    ADDAH    NUMBER    NUMERR    HEXNUM
  62. ;            DIRPTR    SLOGIN    DLOGIN    COMLOG    SCANER
  63. ;            CMDSER
  64. ;
  65. ;     5        CPR-Resident Commands and Functions
  66. ;     5A        DIR    DIRPR    FILLQ
  67. ;     5B        ERA
  68. ;     5C        LIST
  69. ;     5D        TYPE    PAGER
  70. ;     5E        SAVE
  71. ;     5F        REN
  72. ;     5G        USER
  73. ;     5H        DFU
  74. ;     5I        JUMP
  75. ;     5J        GO
  76. ;     5K        COM    CALLPROG    ERRLOG    ERRJMP
  77. ;     5L        GET    MEMLOAD    PRNLE
  78. ;
  79. ;
  80. FALSE    EQU    0
  81. TRUE    EQU    NOT FALSE
  82. ;
  83. ;  CUSTOMIZATION EQUATES
  84. ;
  85. ;  The following equates may be used to customize this CPR for the user's
  86. ;    system and integration technique.  The following constants are provided:
  87. ;
  88. ;    REL - TRUE if integration is to be done via MOVCPM
  89. ;        - FALSE if integration is to be done via DDT and SYSGEN
  90. ;
  91. ;    BASE - Base Address of user's CP/M system (normally 0 for DR version)
  92. ;           This equate allows easy modification by non-standard CP/M (eg,H89)
  93. ;
  94. ;    CPRLOC - Base Page Address of CPR; this value can be obtained by running
  95. ;          the BDOSLOC program on your system, or by setting the
  96. ;          MSIZE and BIOSEX equates to the system memory size in
  97. ;          K-bytes and the "extra" memory required by your BIOS
  98. ;          in K-bytes. BIOSEX is zero if your BIOS is normal size,
  99. ;          and can be negative if your BIOS is in PROM or in
  100. ;          non-contiguous memory.
  101. ;
  102. ;    RAS - Remote-Access System; setting this equate to TRUE disables
  103. ;       certain CPR commands that are considered harmful in a Remote-
  104. ;       Access environment; use under Remote-Access Systems (RBBS) for
  105. ;       security purposes
  106. ;
  107. REL    EQU    FALSE    ;SET TO TRUE FOR MOVCPM INTEGRATION
  108. ;
  109. BASE    EQU    0    ;BASE OF CP/M SYSTEM (SET FOR STANDARD CP/M)
  110. ;
  111.     IF    REL
  112. CPRLOC    EQU    0    ;MOVCPM IMAGE
  113.     ELSE
  114. ;
  115. ; If REL is FALSE, the value of CPRLOC may be set in one
  116. ; of two ways.  The first way is to set MSIZE and BIOSEX
  117. ; as described above using the following three lines:
  118. ;
  119. ;MSIZE    EQU    56    ;SIZE OF MEM IN K-BYTES
  120. ;BIOSEX    EQU    0    ;EXTRA # K-BYTES IN BIOS
  121. ;CPRLOC    EQU    3400H+(MSIZE-20-BIOSEX)*1024    ;CPR ORIGIN
  122. ;
  123. ; The second way is to obtain the origin of your current
  124. ; CPR using BDSLOC or its equivalent, then merely set CPRLOC
  125. ; to that value as as in the following line:
  126.  
  127. CPRLOC    EQU    0DC00H    ;FILL IN WITH CCPLOC SUPPLIED VALUE D00+F200-2300=DC00
  128.  
  129. ; Note that you should only use one method or the other.
  130. ; Do NOT define CPRLOC twice!
  131. ;
  132. ; The following gives the required offset to load the CPR into the
  133. ; CP/M SYSGEN Image through DDT (the Roffset command); Note that this
  134. ; value conforms with the standard value presented in the CP/M reference
  135. ; manuals, but it may not necessarily conform with the location of the
  136. ; CPR in YOUR CP/M system; several systems (Morrow Designs, P&T, Heath
  137. ; Org-0 to name a few) have the CPR located at a non-standard address in
  138. ; the SYSGEN Image
  139. ;
  140. ;CPRR    EQU    0980H-CPRLOC    ;DDT LOAD OFFSET
  141. ;CPRR    EQU    1100H-CPRLOC    ;DDT LOAD OFFSET FOR MORROW DESIGNS
  142. CPRR    EQU    0980H-CPRLOC    ; MD3
  143.     ENDIF    ; REL
  144. ;
  145. RAS    EQU    FALSE    ;SET TO TRUE IF CPR IS FOR A REMOTE-ACCESS SYSTEM
  146. ;
  147. ; The following is presented as an option, but is not generally user-customiz-
  148. ; able.  A basic design choice had to be made in the design of ZCPR concerning
  149. ; the execution of SUBMIT files.  The original CCP had a problem in this sense
  150. ; in that it ALWAYS looked for the SUBMIT file from drive A: and the SUBMIT
  151. ; program itself (SUBMIT.COM) would place the $$$.SUB file on the currently
  152. ; logged-in drive, so when the user was logged into B: and he issued a SUBMIT
  153. ; command, the $$$.SUB was placed on B: and did not execute because the CCP
  154. ; looked for it on A: and never found it.
  155. ;    After much debate it was decided to have ZCPR perform the same type of
  156. ; function as CCP (look for the $$$.SUB file on A:), but the problem with
  157. ; SUBMIT.COM still exists.  Hence, RGF designed SuperSUB and RLC took his
  158. ; SuperSUB and designed SUB from it; both programs are set up to allow the
  159. ; selection at assembly time of creating the $$$.SUB on the logged-in drive
  160. ; or on drive A:.
  161. ;    A final definition of the Indirect Command File ($$$.SUB or SUBMIT
  162. ; File) is presented as follows:
  163. ;        "An Indirect Command File is one which contains
  164. ;         a series of commands exactly as they would be
  165. ;         entered from a CP/M Console.  The SUBMIT Command
  166. ;         (or SUB Command) reads this file and transforms
  167. ;         it for processing by the ZCPR (the $$$.SUB File).
  168. ;         ZCPR will then execute the commands indicated
  169. ;         EXACTLY as if they were typed at the Console."
  170. ;    Hence, to permit this to happen, the $$$.SUB file must always
  171. ; be present on a specific drive, and A: is the choice for said drive.
  172. ; With this facility engaged as such, Indirect Command Files like:
  173. ;        DIR
  174. ;        A:
  175. ;        DIR
  176. ; can be executed, even though the currently logged-in drive is changed
  177. ; during execution.  If the $$$.SUB file was present on the currently
  178. ; logged-in drive, the above series of commands would not work since the
  179. ; ZCPR would be looking for $$$.SUB on the logged-in drive, and switching
  180. ; logged-in drives without moving the $$$.SUB file as well would cause
  181. ; processing to abort.
  182. ;
  183. SUBA    equ    TRUE     ; Set to TRUE to have $$$.SUB always on A:
  184.             ; Set to FALSE to have $$$.SUB on the logged-in drive
  185. ;
  186. ;   The following flag enables extended processing for user-program supplied
  187. ; command lines.  This is for Command Level 3 of ZCPR.  Under the CCPZ Version
  188. ; 4.0 philosophy, three command levels exist:
  189. ;    (1) that command issued by the user from his console at the '>' prompt
  190. ;    (2) that command issued by a $$$.SUB file at the '$' prompt
  191. ;    (3) that command issued by a user program by placing the command into
  192. ; CIBUFF and setting the character count in CBUFF
  193. ;   Setting CLEVEL3 to TRUE enables extended processing of the third level of
  194. ; ZCPR command.  All the user program need do is to store the command line and
  195. ; set the character count; ZCPR will initialize the pointers properly, store
  196. ; the ending zero properly, and capitalize the command line for processing.
  197. ; Once the command line is properly stored, the user executes the command line
  198. ; by reentering the ZCPR through CPRLOC [NOTE:  The C register MUST contain
  199. ; a valid User/Disk Flag (see location 4) at this time.]
  200. ;
  201. CLEVEL3    equ    true        ;ENABLE COMMAND LEVEL 3 PROCESSING
  202. ;
  203. ;
  204. ;*** TERMINAL AND 'TYPE' CUSTOMIZATION EQUATES
  205. ;
  206. NLINES    EQU    24        ;NUMBER OF LINES ON CRT SCREEN
  207. WIDE    EQU    TRUE        ;TRUE IF WIDE DIR DISPLAY
  208. FENCE    EQU    '|'        ;SEP CHAR BETWEEN DIR FILES
  209. ;
  210. PGDFLT    EQU    TRUE          ;SET TO FALSE TO DISABLE PAGING BY DEFAULT
  211. PGDFLG    EQU    'P'        ;FOR TYPE COMMAND: PAGE OR NOT (DEP ON PGDFLT)
  212.                 ;  THIS FLAG REVERSES THE DEFAULT EFFECT
  213. ;
  214. MAXUSR    EQU    15         ;MAXIMUM USER NUMBER ACCESSABLE
  215. ;
  216. SYSFLG    EQU    'A'         ;FOR DIR COMMAND: LIST $SYS AND $DIR
  217. ;
  218. SOFLG    EQU    'S'        ;FOR DIR COMMAND: LIST $SYS FILES ONLY
  219. ;
  220. SUPRES    EQU    FALSE        ;SUPRESSES USER # REPORT FOR USER 0
  221. ;
  222. DEFUSR    EQU    0         ;DEFAULT USER NUMBER FOR COM FILES
  223. ;
  224. SPRMPT    EQU    '$'        ;CPR PROMPT INDICATING SUBMIT COMMAND
  225. CPRMPT    EQU    '>'        ;CPR PROMPT INDICATING USER COMMAND
  226. ;
  227. NUMBASE    EQU    'H'        ;CHARACTER USED TO SWITCH FROM DEFAULT
  228.                 ; NUMBER BASE
  229. ;
  230. SECTFLG    EQU    'S'        ;OPTION CHAR FOR SAVE COMMAND TO SAVE SECTORS
  231. ;
  232. ; END OF CUSTOMIZATION SECTION
  233. ;
  234. CR    EQU    0DH
  235. LF    EQU    0AH
  236. TAB    EQU    09H
  237. ;
  238. WBOOT    EQU    BASE+0000H        ;CP/M WARM BOOT ADDRESS
  239. UDFLAG    EQU    BASE+0004H        ;USER NUM IN HIGH NYBBLE, DISK IN LOW
  240. BDOS    EQU    BASE+0005H        ;BDOS FUNCTION CALL ENTRY PT
  241. TFCB    EQU    BASE+005CH        ;DEFAULT FCB BUFFER
  242. TBUFF    EQU    BASE+0080H        ;DEFAULT DISK I/O BUFFER
  243. TPA    EQU    BASE+0100H        ;BASE OF TPA
  244. ;
  245. ;
  246. ; MACROS TO PROVIDE Z80 EXTENSIONS
  247. ;   MACROS INCLUDE:
  248. ;
  249. ;;M80 doesn't like this! $-MACRO         ;FIRST TURN OFF THE EXPANSIONS
  250. ;
  251. ;    JR    - JUMP RELATIVE
  252. ;    JRC    - JUMP RELATIVE IF CARRY
  253. ;    JRNC    - JUMP RELATIVE IF NO CARRY
  254. ;    JRZ    - JUMP RELATIVE IF ZERO
  255. ;    JRNZ    - JUMP RELATIVE IF NO ZERO
  256. ;    DJNZ    - DECREMENT B AND JUMP RELATIVE IF NO ZERO
  257. ;    LDIR    - MOV @HL TO @DE FOR COUNT IN BC
  258. ;    LXXD    - LOAD DOUBLE REG DIRECT
  259. ;    SXXD    - STORE DOUBLE REG DIRECT
  260. ;
  261. ;
  262. ;
  263. ;    @GENDD MACRO USED FOR CHECKING AND GENERATING
  264. ;    8-BIT JUMP RELATIVE DISPLACEMENTS
  265. ;
  266. @GENDD    MACRO    ?DD    ;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS
  267. ;;    IF  (?DD GT 7FH) AND (?DD LT 0FF80H)
  268. ;;    DB    100H    ;Displacement Range Error on Jump Relative
  269. ;;    ELSE        ;FUDGED SO M80 won't complain about forward
  270.     DB    ?DD
  271. ;;    ENDIF        ;references in conditionals
  272.     ENDM
  273. ;
  274. ;
  275. ; Z80 MACRO EXTENSIONS
  276. ;
  277. JR    MACRO    ?N    ;;JUMP RELATIVE
  278.     DB    18H
  279.     @GENDD    ?N-$-1
  280.     ENDM
  281. ;
  282. JRC    MACRO    ?N    ;;JUMP RELATIVE ON CARRY
  283.     DB    38H
  284.     @GENDD    ?N-$-1
  285.     ENDM
  286. ;
  287. JRNC    MACRO    ?N    ;;JUMP RELATIVE ON NO CARRY
  288.     DB    30H
  289.     @GENDD    ?N-$-1
  290.     ENDM
  291. ;
  292. JRZ    MACRO    ?N    ;;JUMP RELATIVE ON ZERO
  293.     DB    28H
  294.     @GENDD    ?N-$-1
  295.     ENDM
  296. ;
  297. JRNZ    MACRO    ?N    ;;JUMP RELATIVE ON NO ZERO
  298.     DB    20H
  299.     @GENDD    ?N-$-1
  300.     ENDM
  301. ;
  302. DJNZ    MACRO    ?N    ;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
  303.     DB    10H
  304.     @GENDD    ?N-$-1
  305.     ENDM
  306. ;
  307. LDIR    MACRO        ;;LDIR
  308.     DB    0EDH,0B0H
  309.     ENDM
  310. ;
  311. LDED    MACRO    ?N    ;;LOAD DE DIRECT
  312.     DB    0EDH,05BH
  313.     DW    ?N
  314.     ENDM
  315. ;
  316. LBCD    MACRO    ?N    ;;LOAD BC DIRECT
  317.     DB    0EDH,4BH
  318.     DW    ?N
  319.     ENDM
  320. ;
  321. SDED    MACRO    ?N    ;;STORE DE DIRECT
  322.     DB    0EDH,53H
  323.     DW    ?N
  324.     ENDM
  325. ;
  326. SBCD    MACRO    ?N    ;;STORE BC DIRECT
  327.     DB    0EDH,43H
  328.     DW    ?N
  329.     ENDM
  330. ;
  331. ; END OF Z80 MACRO EXTENSIONS
  332. ;
  333. ;
  334. ;**** Section 0 ****
  335. ;
  336. ; M80 stuff
  337.     aseg
  338.     org    100H
  339.     .phase    CPRLOC
  340. ;
  341. ;  ENTRY POINTS INTO ZCPR
  342. ;    If the ZCPR is entered at location CPRLOC (at the JMP to CPR), then
  343. ; the default command in CIBUFF will be processed.  If the ZCPR is entered
  344. ; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
  345. ; CIBUFF will NOT be processed.
  346. ;    NOTE:  Entry into ZCPR in this way is permitted under ZCPR Version 4.0,
  347. ; but in order for this to work, CIBUFF and CBUFF MUST be initialized properly
  348. ; AND the C register MUST contain a valid User/Disk Flag (see Location 4: the
  349. ; most significant nybble contains the User Number and the least significant
  350. ; nybble contains the Disk Number).
  351. ;    Some user programs (such as SYNONYM3) attempt to use the default
  352. ; command facility.  Under the original CPR, it was necessary to initialize
  353. ; the pointer after the reserved space for the command buffer to point to
  354. ; the first byte of the command buffer.  Under Version 4.x of ZCPR, this is
  355. ; no longer the case.  The CIBPTR (Command Input Buffer PoinTeR) is located
  356. ; to be compatable with such programs (provided they determine the buffer
  357. ; length from the byte at MBUFF [CPRLOC + 6]), but under Version 4.x of ZCPR
  358. ; this is no longer necessary.  ZCPR Version 4.x automatically initializes
  359. ; this buffer pointer in all cases.
  360. ;
  361.     .list
  362. ENTRY:
  363.     JMP    CPR    ; Process potential default command
  364.     JMP    CPR1    ; Do NOT process potential default command
  365.     .xlist
  366. ;
  367. ;**** Section 1 ****
  368. ; BUFFERS ET AL
  369. ;
  370. ; INPUT COMMAND LINE AND DEFAULT COMMAND
  371. ;   The command line to be executed is stored here.  This command line
  372. ; is generated in one of three ways:
  373. ;    (1) by the user entering it through the BDOS READLN function at
  374. ; the du> prompt [user input from keyboard]
  375. ;    (2) by the SUBMIT File Facility placing it there from a $$$.SUB
  376. ; file
  377. ;    (3) by an external program or user placing the required command
  378. ; into this buffer
  379. ;   In all cases, the command line is placed into the buffer starting at
  380. ; CIBUFF.  This command line is terminated by the last character (NOT Carriage
  381. ; Return), and a character count of all characters in the command line
  382. ; up to and including the last character is placed into location CBUFF
  383. ; (immediately before the command line at CIBUFF).  The placed command line
  384. ; is then parsed, interpreted, and the indicated command is executed.
  385. ; If CLEVEL3 is permitted, a terminating zero is placed after the command
  386. ; (otherwise the user program has to place this zero) and the CIBPTR is
  387. ; properly initialized (otherwise the user program has to init this ptr).
  388. ; If the command is placed by a user program, entering at CPRLOC is enough
  389. ; to have the command processed.  Again, under CCPZ Version 4.0, it is not
  390. ; necessary to store the pointer to CIBUFF in CIBPTR; ZCPR will do this for
  391. ; the calling program if CLEVEL3 is made TRUE.
  392. ;   WARNING:  The command line must NOT exceed BUFLEN characters in length.
  393. ; For user programs which load this command, the value of BUFLEN can be
  394. ; obtained by examining the byte at MBUFF (CPRLOC + 6).
  395. ;
  396.     .list
  397. BUFLEN    EQU    80        ;MAXIMUM BUFFER LENGTH
  398. MBUFF:
  399.     DB    BUFLEN        ;MAXIMUM BUFFER LENGTH
  400. CBUFF:
  401.     DB    0        ;NUMBER OF VALID CHARS IN COMMAND LINE
  402. CIBUFF:
  403.     DB    '               '    ;DEFAULT (COLD BOOT) COMMAND
  404. CIBUF:
  405.     DB    0            ;COMMAND STRING TERMINATOR
  406.     DS    BUFLEN-($-CIBUFF)+1    ;TOTAL IS 'BUFLEN' BYTES
  407. ;
  408. CIBPTR:
  409.     DW    CIBUFF        ;POINTER TO COMMAND INPUT BUFFER
  410. CIPTR:
  411.     DW    CIBUF        ;CURRENT POINTER
  412. ;
  413.     DS    26        ;STACK AREA
  414. STACK    EQU    $        ;TOP OF STACK
  415. ;
  416. ; FILE TYPE FOR COMMAND
  417. ;
  418. COMMSG:
  419.     DB    'COM'
  420. ;
  421. ; SUBMIT FILE CONTROL BLOCK
  422. ;
  423. SUBFCB:
  424.     IF    SUBA        ;IF $$$.SUB ON A:
  425.     DB    1        ;DISK NAME SET TO DEFAULT TO DRIVE A:
  426.     ENDIF
  427. ;
  428.     IF    NOT SUBA    ;IF $$$.SUB ON CURRENT DRIVE
  429.     DB    0        ;DISK NAME SET TO DEFAULT TO CURRENT DRIVE
  430.     ENDIF
  431. ;
  432.     DB    '$$$'        ;FILE NAME
  433.     DB    '     '
  434.     DB    'SUB'        ;FILE TYPE
  435.     DB    0        ;EXTENT NUMBER
  436.     DB    0        ;S1
  437. SUBFS2:
  438.     DS    1        ;S2
  439. SUBFRC:
  440.     DS    1        ;RECORD COUNT
  441.     DS    16        ;DISK GROUP MAP
  442. SUBFCR:
  443.     DS    1        ;CURRENT RECORD NUMBER
  444. ;
  445. ; COMMAND FILE CONTROL BLOCK
  446. ;
  447. FCBDN:
  448.     DS    1        ;DISK NAME
  449. FCBFN:
  450.     DS    8        ;FILE NAME
  451. FCBFT:
  452.     DS    3        ;FILE TYPE
  453.     DS    1        ;EXTENT NUMBER
  454.     DS    2        ;S1 AND S2
  455.     DS    1        ;RECORD COUNT
  456. FCBDM:
  457.     DS    16        ;DISK GROUP MAP
  458. FCBCR:
  459.     DS    1        ;CURRENT RECORD NUMBER
  460. ;
  461. ; OTHER BUFFERS
  462. ;
  463. PAGCNT:
  464.     DB    NLINES-2    ;LINES LEFT ON PAGE
  465. CHRCNT:
  466.     DB    0        ;CHAR COUNT FOR TYPE
  467. QMCNT:
  468.     DB    0        ;QUESTION MARK COUNT FOR FCB TOKEN SCANNER
  469. ;
  470. ; CPR BUILT-IN COMMAND TABLE
  471. ;
  472. NCHARS    EQU    4        ;NUMBER OF CHARS/COMMAND
  473. ;
  474. ; CPR COMMAND NAME TABLE
  475. ;   EACH TABLE ENTRY IS COMPOSED OF THE 4-BYTE COMMAND AND 2-BYTE ADDRESS
  476. ;
  477. CMDTBL:
  478.     DB    'DIR '
  479.     DW    DIR
  480.     DB    'LIST'
  481.     DW    LIST
  482.     DB    'TYPE'
  483.     DW    TYPE
  484.     DB    'USER'
  485.     DW    USER
  486.     DB    'DFU '
  487.     DW    DFU
  488. ;
  489.     IF    NOT RAS        ;FOR NON-RAS
  490.     DB    'GO  '
  491.     DW    GO
  492.     DB    'ERA '
  493.     DW    ERA
  494.     DB    'SAVE'
  495.     DW    SAVE
  496.     DB    'REN '
  497.     DW    REN
  498.     DB    'GET '
  499.     DW    GET
  500.     DB    'JUMP'
  501.     DW    JUMP
  502.     ENDIF
  503. ;
  504. NCMNDS    EQU    ($-CMDTBL)/(NCHARS+2)
  505. ;
  506. ;
  507. ;**** Section 2 ****
  508. ; CPR STARTING POINTS
  509. ;
  510. ; START CPR AND DON'T PROCESS DEFAULT COMMAND STORED
  511. ;
  512. CPR1:
  513.     XRA    A        ;SET NO DEFAULT COMMAND
  514.     STA    CBUFF
  515. ;
  516. ; START CPR AND POSSIBLY PROCESS DEFAULT COMMAND
  517. ;
  518. ; NOTE ON MODIFICATION BY RGF: BDOS RETURNS 0FFH IN
  519. ; ACCUMULATOR WHENEVER IT LOGS IN A DIRECTORY, IF ANY
  520. ; FILE NAME CONTAINS A '$' IN IT.  THIS IS NOW USED AS
  521. ; A CLUE TO DETERMINE WHETHER OR NOT TO DO A SEARCH
  522. ; FOR SUBMIT FILE, IN ORDER TO ELIMINATE WASTEFUL SEARCHES.
  523. ;
  524. CPR:
  525.     LXI    SP,STACK    ;RESET STACK
  526.     PUSH    B
  527.     MOV    A,C        ;C=USER/DISK NUMBER (SEE LOC 4)
  528.     RAR            ;EXTRACT USER NUMBER
  529.     RAR
  530.     RAR
  531.     RAR
  532.     ANI    0FH
  533.     MOV    E,A        ;SET USER NUMBER
  534.     CALL    SETUSR
  535.     CALL    RESET        ;RESET DISK SYSTEM
  536.     STA    RNGSUB        ;SAVE SUBMIT CLUE FROM DRIVE A:
  537.     POP    B
  538.     MOV    A,C        ;C=USER/DISK NUMBER (SEE LOC 4)
  539.     ANI    0FH        ;EXTRACT DEFAULT DISK DRIVE
  540.     STA    TDRIVE        ;SET IT
  541.     JRZ    NOLOG        ;SKIP IF 0...ALREADY LOGGED
  542.     CALL    LOGIN        ;LOG IN DEFAULT DISK
  543. ;
  544.     IF    NOT SUBA    ;IF $$$.SUB IS ON CURRENT DRIVE
  545.     STA    RNGSUB        ;BDOS '$' CLUE
  546.     ENDIF
  547. ;
  548.     .xlist
  549. NOLOG:
  550.     LXI    D,SUBFCB    ;CHECK FOR $$$.SUB ON CURRENT DISK
  551. RNGSUB    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  552.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS THE RNGSUB FLAG
  553.     ORA    A        ;SET FLAGS ON CLUE
  554.     CMA            ;PREPARE FOR COMING 'CMA'
  555.     CNZ    SEAR1
  556.     CMA            ;0FFH IS RETURNED IF NO $$$.SUB, SO COMPLEMENT
  557.     STA    RNGSUB        ;SET FLAG (0=NO $$$.SUB)
  558.     LDA    CBUFF        ;EXECUTE DEFAULT COMMAND?
  559.     ORA    A        ;0=NO
  560.     JRNZ    RS1
  561. ;
  562. ; PROMPT USER AND INPUT COMMAND LINE FROM HIM
  563. ;
  564. RESTRT:
  565.     LXI    SP,STACK    ;RESET STACK
  566. ;
  567. ; PRINT PROMPT (DU>)
  568. ;
  569.     CALL    CRLF        ;PRINT PROMPT
  570.     CALL    GETDRV        ;CURRENT DRIVE IS PART OF PROMPT
  571.     ADI    'A'        ;CONVERT TO ASCII A-P
  572.     CALL    CONOUT
  573.     CALL    GETUSR        ;GET USER NUMBER
  574. ;
  575.     IF    SUPRES        ;IF SUPPRESSING USR # REPORT FOR USR 0
  576.     ORA    A
  577.     JRZ    RS000
  578.     ENDIF
  579. ;
  580.     CPI    10        ;USER < 10?
  581.     JRC    RS00
  582.     SUI    10        ;SUBTRACT 10 FROM IT
  583.     PUSH    PSW        ;SAVE IT
  584.     MVI    A,'1'        ;OUTPUT 10'S DIGIT
  585.     CALL    CONOUT
  586.     POP    PSW
  587. RS00:
  588.     ADI    '0'        ;OUTPUT 1'S DIGIT (CONVERT TO ASCII)
  589.     CALL    CONOUT
  590. ;
  591. ; READ INPUT LINE FROM USER OR $$$.SUB
  592. ;
  593. RS000:
  594.     CALL    REDBUF        ;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
  595. ;
  596. ; PROCESS INPUT LINE
  597. ;
  598. RS1:
  599. ;
  600.     IF    CLEVEL3        ;IF THIRD COMMAND LEVEL IS PERMITTED
  601.     CALL    CNVBUF        ;CAPITALIZE COMMAND LINE, PLACE ENDING 0,
  602.                 ; AND SET CIBPTR VALUE
  603.     ENDIF
  604. ;
  605.     CALL    DEFDMA        ;SET TBUFF TO DMA ADDRESS
  606.     CALL    GETDRV        ;GET DEFAULT DRIVE NUMBER
  607.     STA    TDRIVE        ;SET IT
  608.     CALL    SCANER        ;PARSE COMMAND NAME FROM COMMAND LINE
  609.     CNZ    ERROR        ;ERROR IF COMMAND NAME CONTAINS A '?'
  610.     LXI    D,RSTCPR    ;PUT RETURN ADDRESS OF COMMAND
  611.     PUSH    D        ;ON THE STACK
  612.     LDA    TEMPDR        ;IS COMMAND OF FORM 'D:COMMAND'?
  613.     ORA    A        ;NZ=YES
  614.     JNZ    COM        ; IMMEDIATELY
  615.     CALL    CMDSER        ;SCAN FOR CPR-RESIDENT COMMAND
  616.     JNZ    COM        ;NOT CPR-RESIDENT
  617.     MOV    A,M        ;FOUND IT:  GET LOW-ORDER PART
  618.     INX    H        ;GET HIGH-ORDER PART
  619.     MOV    H,M        ;STORE HIGH
  620.     MOV    L,A        ;STORE LOW
  621.     PCHL            ;EXECUTE CPR ROUTINE
  622. ;
  623. ; ENTRY POINT FOR RESTARTING CPR AND LOGGING IN DEFAULT DRIVE
  624. ;
  625. RSTCPR:
  626.     CALL    DLOGIN        ;LOG IN DEFAULT DRIVE
  627. ;
  628. ; ENTRY POINT FOR RESTARTING CPR WITHOUT LOGGING IN DEFAULT DRIVE
  629. ;
  630. RCPRNL:
  631.     CALL    SCANER        ;EXTRACT NEXT TOKEN FROM COMMAND LINE
  632.     LDA    FCBFN        ;GET FIRST CHAR OF TOKEN
  633.     SUI    ' '        ;ANY CHAR?
  634.     LXI    H,TEMPDR
  635.     ORA    M
  636.     JNZ    ERROR
  637.     JR    RESTRT
  638. ;
  639. ; No File Error Message
  640. ;
  641. PRNNF:
  642.     CALL    PRINTC        ;NO FILE MESSAGE
  643.     DB    'No Fil','e'+80H
  644.     RET
  645. ;
  646. ;**** Section 3 ****
  647. ; I/O UTILITIES
  648. ;
  649. ; OUTPUT CHAR IN REG A TO CONSOLE AND DON'T CHANGE BC
  650. ;
  651. ;
  652. ; OUTPUT <CRLF>
  653. ;
  654. CRLF:
  655.     MVI    A,CR
  656.     CALL    CONOUT
  657.     MVI    A,LF    ;FALL THRU TO CONOUT
  658. ;
  659. CONOUT:
  660.     PUSH    B
  661.     MVI    C,02H
  662. OUTPUT:
  663.     ani    7FH    ;M.S. 5/6/83
  664.     MOV    E,A
  665.     PUSH    H
  666.     CALL    BDOS
  667.     POP    H
  668.     POP    B
  669.     RET
  670. ;
  671. CONIN:
  672.     MVI    C,01H    ;GET CHAR FROM CON: WITH ECHO
  673.     CALL    BDOSB
  674.     JMP    UCASE    ;CAPITALIZE
  675. ;
  676. LCOUT:
  677.     PUSH    PSW    ;OUTPUT CHAR TO CON: OR LST: DEP ON PRFLG
  678. PRFLG    EQU    $+1    ;POINTER FOR IN-THE-CODE MODIFICATION
  679.     MVI    A,0    ;2ND BYTE (IMMEDIATE ARG) IS THE PRINT FLAG
  680.     ORA    A    ;0=TYPE
  681.     JRZ    LC1
  682.     POP    PSW    ;GET CHAR
  683. ;
  684. ; OUTPUT CHAR IN REG A TO LIST DEVICE
  685. ;
  686. LSTOUT:
  687.     PUSH    B
  688.     MVI    C,05H
  689.     JR    OUTPUT
  690. LC1:
  691.     POP    PSW    ;GET CHAR
  692.     PUSH    PSW
  693.     CALL    CONOUT    ;OUTPUT TO CON:
  694.     POP    PSW
  695.     CPI    LF    ;CHECK FOR PAGING
  696.     JZ    PAGER
  697.     RET
  698. ;
  699. READF:
  700.     LXI    D,FCBDN ;FALL THRU TO READ
  701. READ:
  702.     MVI    C,14H    ;FALL THRU TO BDOSB
  703. ;
  704. ; CALL BDOS AND SAVE BC
  705. ;
  706. BDOSB:
  707.     PUSH    B
  708.     CALL    BDOS
  709.     POP    B
  710.     ORA    A
  711.     RET
  712. ;
  713. ; PRINT STRING (ENDING IN 0) PTED TO BY RET ADR;START WITH <CRLF>
  714. ;
  715. PRINTC:
  716.     PUSH    PSW        ;SAVE FLAGS
  717.     CALL    CRLF        ;NEW LINE
  718.     POP    PSW
  719. ;
  720. PRINT:
  721.     XTHL            ;GET PTR TO STRING
  722.     PUSH    PSW        ;SAVE FLAGS
  723.     CALL    PRIN1        ;PRINT STRING
  724.     POP    PSW        ;GET FLAGS
  725.     XTHL            ;RESTORE HL AND RET ADR
  726.     RET
  727. ;
  728. ; PRINT STRING (ENDING IN 0) PTED TO BY HL
  729. ;
  730. PRIN1:
  731.     MOV    A,M        ;GET NEXT BYTE
  732.     CALL    CONOUT        ;PRINT CHAR
  733.     MOV    A,M        ;GET NEXT BYTE AGAIN FOR TEST
  734.     INX    H        ;PT TO NEXT BYTE
  735.     ORA    A        ;SET FLAGS
  736.     RZ            ;DONE IF ZERO
  737.     RM            ;DONE IF MSB SET
  738.     JR    PRIN1
  739. ;
  740. ; BDOS FUNCTION ROUTINES
  741. ;
  742. ;
  743. ; RETURN NUMBER OF CURRENT DISK IN A
  744. ;
  745. GETDRV:
  746.     MVI    C,19H
  747.     JR    BDOSJP
  748. ;
  749. ; SET 80H AS DMA ADDRESS
  750. ;
  751. DEFDMA:
  752.     LXI    D,TBUFF     ;80H=TBUFF
  753. DMASET:
  754.     MVI    C,1AH
  755.     JR    BDOSJP
  756. ;
  757. RESET:
  758.     MVI    C,0DH
  759. BDOSJP:
  760.     JMP    BDOS
  761. ;
  762. LOGIN:
  763.     MOV    E,A
  764.     MVI    C,0EH
  765.     JR    BDOSJP    ;SAVE SOME CODE SPACE
  766. ;
  767. OPENF:
  768.     XRA    A
  769.     STA    FCBCR
  770.     LXI    D,FCBDN ;FALL THRU TO OPEN
  771. ;
  772. OPEN:
  773.     MVI    C,0FH    ;FALL THRU TO GRBDOS
  774. ;
  775. GRBDOS:
  776.     CALL    BDOS
  777.     INR    A    ;SET ZERO FLAG FOR ERROR RETURN
  778.     RET
  779. ;
  780. CLOSE:
  781.     MVI    C,10H
  782.     JR    GRBDOS
  783. ;
  784. SEARF:
  785.     LXI    D,FCBDN ;SPECIFY FCB
  786. SEAR1:
  787.     MVI    C,11H
  788.     JR    GRBDOS
  789. ;
  790. SEARN:
  791.     MVI    C,12H
  792.     JR    GRBDOS
  793. ;
  794. ; CHECK FOR SUBMIT FILE IN EXECUTION AND ABORT IT IF SO
  795. ;
  796. SUBKIL:
  797.     LXI    H,RNGSUB    ;CHECK FOR SUBMIT FILE IN EXECUTION
  798.     MOV    A,M
  799.     ORA    A        ;0=NO
  800.     RZ
  801.     MVI    M,0        ;ABORT SUBMIT FILE
  802.     LXI    D,SUBFCB    ;DELETE $$$.SUB
  803. ;
  804. DELETE:
  805.     MVI    C,13H
  806.     JR    BDOSJP    ;SAVE MORE SPACE
  807. ;
  808. ; RESET USER NUMBER IF CHANGED
  809. ;
  810. RESETUSR:
  811. TMPUSR    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  812.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS TMPUSR
  813.     MOV    E,A        ;PLACE IN E
  814.     JR    SETUSR        ;THEN GO SET USER
  815. GETUSR:
  816.     MVI    E,0FFH        ;GET CURRENT USER NUMBER
  817. SETUSR:
  818.     MVI    C,20H        ;SET USER NUMBER TO VALUE IN E (GET IF E=FFH)
  819.     JR    BDOSJP        ;MORE SPACE SAVING
  820. ;
  821. ; END OF BDOS FUNCTIONS
  822. ;
  823. ;
  824. ;**** Section 4 ****
  825. ; CPR UTILITIES
  826. ;
  827. ; SET USER/DISK FLAG TO CURRENT USER AND DEFAULT DISK
  828. ;
  829. SETUD:
  830.     CALL    GETUSR        ;GET NUMBER OF CURRENT USER
  831.     ADD    A        ;PLACE IT IN HIGH NYBBLE
  832.     ADD    A
  833.     ADD    A
  834.     ADD    A
  835.     LXI    H,TDRIVE    ;MASK IN DEFAULT DRIVE NUMBER (LOW NYBBLE)
  836.     ORA    M        ;MASK IN
  837.     STA    UDFLAG        ;SET USER/DISK NUMBER
  838.     RET
  839. ;
  840. ; SET USER/DISK FLAG TO USER 0 AND DEFAULT DISK
  841. ;
  842. SETU0D:
  843. TDRIVE    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  844.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS TDRIVE
  845.     STA    UDFLAG        ;SET USER/DISK NUMBER
  846.     RET
  847. ;
  848. ; CONVERT CHAR IN A TO UPPER CASE
  849. ;
  850. UCASE:
  851.     CPI    61H        ;LOWER-CASE A
  852.     RC
  853.     CPI    7BH        ;GREATER THAN LOWER-CASE Z?
  854.     RNC
  855.     ANI    5FH        ;CAPITALIZE
  856.     RET
  857. ;
  858. ; INPUT NEXT COMMAND TO CPR
  859. ;    This routine determines if a SUBMIT file is being processed
  860. ; and extracts the command line from it if so or from the user's console
  861. ;
  862. REDBUF:
  863.     LDA    RNGSUB        ;SUBMIT FILE CURRENTLY IN EXECUTION?
  864.     ORA    A        ;0=NO
  865.     JRZ    RB1        ;GET LINE FROM CONSOLE IF NOT
  866.     LXI    D,SUBFCB    ;OPEN $$$.SUB
  867.     PUSH    D        ;SAVE DE
  868.     CALL    OPEN
  869.     POP    D        ;RESTORE DE
  870.     JRZ    RB1        ;ERASE $$$.SUB IF END OF FILE AND GET CMND
  871.     LDA    SUBFRC        ;GET VALUE OF LAST RECORD IN FILE
  872.     DCR    A        ;PT TO NEXT TO LAST RECORD
  873.     STA    SUBFCR        ;SAVE NEW VALUE OF LAST RECORD IN $$$.SUB
  874.     CALL    READ        ;DE=SUBFCB
  875.     JRNZ    RB1        ;ABORT $$$.SUB IF ERROR IN READING LAST REC
  876.     LXI    D,CBUFF     ;COPY LAST RECORD (NEXT SUBMIT CMND) TO CBUFF
  877.     LXI    H,TBUFF     ;  FROM TBUFF
  878.     LXI    B,BUFLEN    ;NUMBER OF BYTES
  879.     LDIR
  880.     LXI    H,SUBFS2    ;PT TO S2 OF $$$.SUB FCB
  881.     MVI    M,0        ;SET S2 TO ZERO
  882.     INX    H        ;PT TO RECORD COUNT
  883.     DCR    M        ;DECREMENT RECORD COUNT OF $$$.SUB
  884.     LXI    D,SUBFCB    ;CLOSE $$$.SUB
  885.     CALL    CLOSE
  886.     JRZ    RB1        ;ABORT $$$.SUB IF ERROR
  887.     MVI    A,SPRMPT    ;PRINT SUBMIT PROMPT
  888.     CALL    CONOUT
  889.     LXI    H,CIBUFF    ;PRINT COMMAND LINE FROM $$$.SUB
  890.     CALL    PRIN1
  891.     CALL    BREAK        ;CHECK FOR ABORT (ANY CHAR)
  892. ;
  893.     IF    CLEVEL3        ;IF THIRD COMMAND LEVEL IS PERMITTED
  894.     RZ            ;IF <NULL> (NO ABORT), RETURN TO CALLER AND RUN
  895.     ENDIF
  896. ;
  897.     IF    NOT CLEVEL3    ;IF THIRD COMMAND LEVEL IS NOT PERMITTED
  898.     JRZ    CNVBUF        ;IF <NULL> (NO ABORT), CAPITALIZE COMMAND
  899.     ENDIF
  900. ;
  901.     CALL    SUBKIL        ;KILL $$$.SUB IF ABORT
  902.     JMP    RESTRT        ;RESTART CPR
  903. ;
  904. ; INPUT COMMAND LINE FROM USER CONSOLE
  905. ;
  906. RB1:
  907.     CALL    SUBKIL        ;ERASE $$$.SUB IF PRESENT
  908.     CALL    SETUD        ;SET USER AND DISK
  909.     MVI    A,CPRMPT    ;PRINT PROMPT
  910.     CALL    CONOUT
  911.     MVI    C,0AH        ;READ COMMAND LINE FROM USER
  912.     LXI    D,MBUFF
  913.     CALL    BDOS
  914. ;
  915.     IF    CLEVEL3        ;IF THIRD COMMAND LEVEL IS PERMITTED
  916.     JMP    SETU0D        ;SET CURRENT DISK NUMBER IN LOWER PARAMS
  917.     ENDIF
  918. ;
  919.     IF    NOT CLEVEL3    ;IF THIRD COMMAND LEVEL IS NOT PERMITTED
  920.     CALL    SETU0D        ;SET CURRENT DISK NUMBER IF LOWER PARAMS
  921.                 ; AND FALL THRU TO CNVBUF
  922.     ENDIF
  923. ;
  924. ; CAPITALIZE STRING (ENDING IN 0) IN CBUFF AND SET PTR FOR PARSING
  925. ;
  926. CNVBUF:
  927.     LXI    H,CBUFF     ;PT TO USER'S COMMAND
  928.     MOV    B,M        ;CHAR COUNT IN B
  929.     INR    B        ;ADD 1 IN CASE OF ZERO
  930. CB1:
  931.     INX    H        ;PT TO 1ST VALID CHAR
  932.     MOV    A,M        ;CAPITALIZE COMMAND CHAR
  933.     CALL    UCASE
  934.     MOV    M,A
  935.     DJNZ    CB1        ;CONTINUE TO END OF COMMAND LINE
  936. CB2:
  937.     MVI    M,0        ;STORE ENDING <NULL>
  938.     LXI    H,CIBUFF    ;SET COMMAND LINE PTR TO 1ST CHAR
  939.     SHLD    CIBPTR
  940.     RET
  941. ;
  942. ; CHECK FOR ANY CHAR FROM USER CONSOLE;RET W/ZERO SET IF NONE
  943. ;
  944. BREAK:
  945.     PUSH    D        ;SAVE DE
  946.     MVI    C,11        ;CSTS CHECK
  947.     CALL    BDOSB
  948.     CNZ    CONIN        ;GET INPUT CHAR
  949. BRKBK:
  950.     POP    D
  951.     RET
  952. ;
  953. ; GET THE REQUESTED USER NUMBER FROM THE COMMAND LINE AND VALIDATE IT.
  954. ;
  955. USRNUM:
  956.     CALL    NUMBER
  957.     CPI    MAXUSR+1
  958.     RC
  959. ;
  960. ; INVALID COMMAND -- PRINT IT
  961. ;
  962. ERROR:
  963.     CALL    CRLF        ;NEW LINE
  964.     LHLD    CIPTR        ;PT TO BEGINNING OF COMMAND LINE
  965. ERR2:
  966.     MOV    A,M        ;GET CHAR
  967.     CPI    ' '+1        ;SIMPLE '?' IF <SP> OR LESS
  968.     JRC    ERR1
  969.     PUSH    H        ;SAVE PTR TO ERROR COMMAND CHAR
  970.     CALL    CONOUT        ;PRINT COMMAND CHAR
  971.     POP    H        ;GET PTR
  972.     INX    H        ;PT TO NEXT
  973.     JR    ERR2        ;CONTINUE
  974. ERR1:
  975.     CALL    PRINT        ;PRINT '?'
  976.     DB    '?'+80H
  977.     CALL    SUBKIL        ;TERMINATE ACTIVE $$$.SUB IF ANY
  978.     JMP    RESTRT        ;RESTART CPR
  979. ;
  980. ; CHECK TO SEE IF DE PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
  981. ;
  982. SDELM:
  983.     LDAX    D
  984.     ORA    A        ;0=DELIMITER
  985.     RZ
  986.     CPI    ' '        ;ERROR IF < <SP>
  987.     JRC    ERROR
  988.     RZ            ;<SP>=DELIMITER
  989.     CPI    '='        ;'='=DELIMITER
  990.     RZ
  991.     CPI    5FH        ;UNDERSCORE=DELIMITER
  992.     RZ
  993.     CPI    '.'        ;'.'=DELIMITER
  994.     RZ
  995.     CPI    ':'        ;':'=DELIMITER
  996.     RZ
  997.     CPI    ';'        ;';'=DELIMITER
  998.     RZ
  999.     CPI    '<'        ;'<'=DELIMITER
  1000.     RZ
  1001.     CPI    '>'        ;'>'=DELIMITER
  1002.     RET
  1003. ;
  1004. ; ADVANCE INPUT PTR TO FIRST NON-BLANK AND FALL THROUGH TO SBLANK
  1005. ;
  1006. ADVAN:
  1007.     LDED    CIBPTR
  1008. ;
  1009. ; SKIP STRING PTED TO BY DE (STRING ENDS IN 0) UNTIL END OF STRING
  1010. ;   OR NON-BLANK ENCOUNTERED (BEGINNING OF TOKEN)
  1011. ;
  1012. SBLANK:
  1013.     LDAX    D
  1014.     ORA    A
  1015.     RZ
  1016.     CPI    ' '
  1017.     RNZ
  1018.     INX    D
  1019.     JR    SBLANK
  1020. ;
  1021. ; ADD A TO HL (HL=HL+A)
  1022. ;
  1023. ADDAH:
  1024.     ADD    L
  1025.     MOV    L,A
  1026.     RNC
  1027.     INR    H
  1028.     RET
  1029. ;
  1030. ; EXTRACT DECIMAL NUMBER FROM COMMAND LINE
  1031. ;   RETURN WITH VALUE IN REG A;ALL REGISTERS MAY BE AFFECTED
  1032. ;
  1033. NUMBER:
  1034.     CALL    SCANER        ;PARSE NUMBER AND PLACE IN FCBFN
  1035.     LXI    H,FCBFN+10     ;PT TO END OF TOKEN FOR CONVERSION
  1036.     MVI    B,11        ;11 CHARS MAX
  1037. ;
  1038. ; CHECK FOR SUFFIX FOR HEXADECIMAL NUMBER
  1039. ;
  1040. NUMS:
  1041.     MOV    A,M        ;GET CHARS FROM END, SEARCHING FOR SUFFIX
  1042.     DCX    H        ;BACK UP
  1043.     CPI    ' '        ;SPACE?
  1044.     JRNZ    NUMS1        ;CHECK FOR SUFFIX
  1045.     DJNZ    NUMS        ;COUNT DOWN
  1046.     JR    NUM0        ;BY DEFAULT, PROCESS
  1047. NUMS1:
  1048.     CPI    NUMBASE        ;CHECK AGAINST BASE SWITCH FLAG
  1049.     JRZ    HNUM0
  1050. ;
  1051. ; PROCESS DECIMAL NUMBER
  1052. ;
  1053. NUM0:
  1054.     LXI    H,FCBFN        ;PT TO BEGINNING OF TOKEN
  1055.     LXI    B,1100H        ;C=ACCUMULATED VALUE, B=CHAR COUNT
  1056.                 ; (C=0, B=11)
  1057. NUM1:
  1058.     MOV    A,M        ;GET CHAR
  1059.     CPI    ' '        ;DONE IF <SP>
  1060.     JRZ    NUM2
  1061.     INX    H        ;PT TO NEXT CHAR
  1062.     SUI    '0'        ;CONVERT TO BINARY (ASCII 0-9 TO BINARY)
  1063.     CPI    10        ;ERROR IF >= 10
  1064.     JRNC    NUMERR
  1065.     MOV    D,A        ;DIGIT IN D
  1066.     MOV    A,C        ;NEW VALUE = OLD VALUE * 10
  1067.     RLC
  1068.     RLC
  1069.     RLC
  1070.     ADD    C        ;CHECK FOR RANGE ERROR
  1071.     JRC    NUMERR
  1072.     ADD    C        ;CHECK FOR RANGE ERROR
  1073.     JRC    NUMERR
  1074.     ADD    D        ;NEW VALUE = OLD VALUE * 10 + DIGIT
  1075.     JRC    NUMERR        ;CHECK FOR RANGE ERROR
  1076.     MOV    C,A        ;SET NEW VALUE
  1077.     DJNZ    NUM1        ;COUNT DOWN
  1078. ;
  1079. ; RETURN FROM NUMBER
  1080. ;
  1081. NUM2:
  1082.     MOV    A,C        ;GET ACCUMULATED VALUE
  1083.     RET
  1084. ;
  1085. ; NUMBER ERROR ROUTINE FOR SPACE CONSERVATION
  1086. ;
  1087. NUMERR:
  1088.     JMP    ERROR        ;USE ERROR ROUTINE - THIS IS RELATIVE PT
  1089. ;
  1090. ; EXTRACT HEXADECIMAL NUMBER FROM COMMAND LINE
  1091. ;   RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
  1092. ;
  1093. HEXNUM:
  1094.     CALL    SCANER        ;PARSE NUMBER AND PLACE IN FCBFN
  1095. HNUM0:
  1096.     LXI    H,FCBFN        ;PT TO TOKEN FOR CONVERSION
  1097.     LXI    D,0        ;DE=ACCUMULATED VALUE
  1098.     MVI    B,11        ;B=CHAR COUNT
  1099. HNUM1:
  1100.     MOV    A,M        ;GET CHAR
  1101.     CPI    ' '        ;DONE?
  1102.     JRZ    HNUM3        ;RETURN IF SO
  1103.     CPI    NUMBASE        ;DONE IF NUMBASE SUFFIX
  1104.     JRZ    HNUM3
  1105.     SUI    '0'        ;CONVERT TO BINARY
  1106.     JRC    NUMERR        ;RETURN AND DONE IF ERROR
  1107.     CPI    10        ;0-9?
  1108.     JRC    HNUM2
  1109.     SUI    7        ;A-F?
  1110.     CPI    10H        ;ERROR?
  1111.     JRNC    NUMERR
  1112. HNUM2:
  1113.     INX    H        ;PT TO NEXT CHAR
  1114.     MOV    C,A        ;DIGIT IN C
  1115.     MOV    A,D        ;GET ACCUMULATED VALUE
  1116.     RLC            ;EXCHANGE NYBBLES
  1117.     RLC
  1118.     RLC
  1119.     RLC
  1120.     ANI    0F0H        ;MASK OUT LOW NYBBLE
  1121.     MOV    D,A
  1122.     MOV    A,E        ;SWITCH LOW-ORDER NYBBLES
  1123.     RLC
  1124.     RLC
  1125.     RLC
  1126.     RLC
  1127.     MOV    E,A        ;HIGH NYBBLE OF E=NEW HIGH OF E,
  1128.                 ;  LOW NYBBLE OF E=NEW LOW OF D
  1129.     ANI    0FH        ;GET NEW LOW OF D
  1130.     ORA    D        ;MASK IN HIGH OF D
  1131.     MOV    D,A        ;NEW HIGH BYTE IN D
  1132.     MOV    A,E
  1133.     ANI    0F0H        ;MASK OUT LOW OF E
  1134.     ORA    C        ;MASK IN NEW LOW
  1135.     MOV    E,A        ;NEW LOW BYTE IN E
  1136.     DJNZ    HNUM1        ;COUNT DOWN
  1137. ;
  1138. ; RETURN FROM HEXNUM
  1139. ;
  1140. HNUM3:
  1141.     XCHG            ;RETURNED VALUE IN HL
  1142.     MOV    A,L        ;LOW-ORDER BYTE IN A
  1143.     RET
  1144. ;
  1145. ; PT TO DIRECTORY ENTRY IN TBUFF WHOSE OFFSET IS SPECIFIED BY A AND C
  1146. ;
  1147. DIRPTR:
  1148.     LXI    H,TBUFF     ;PT TO TEMP BUFFER
  1149.     ADD    C        ;PT TO 1ST BYTE OF DIR ENTRY
  1150.     CALL    ADDAH        ;PT TO DESIRED BYTE IN DIR ENTRY
  1151.     MOV    A,M        ;GET DESIRED BYTE
  1152.     RET
  1153. ;
  1154. ; CHECK FOR SPECIFIED DRIVE AND LOG IT IN IF NOT DEFAULT
  1155. ;
  1156. SLOGIN:
  1157.     XRA    A        ;SET FCBDN FOR DEFAULT DRIVE
  1158.     STA    FCBDN
  1159.     CALL    COMLOG        ;CHECK DRIVE
  1160.     RZ
  1161.     JR    DLOG5        ;DO LOGIN OTHERWISE
  1162. ;
  1163. ; CHECK FOR SPECIFIED DRIVE AND LOG IN DEFAULT DRIVE IF SPECIFIED<>DEFAULT
  1164. ;
  1165. DLOGIN:
  1166.     CALL    COMLOG        ;CHECK DRIVE
  1167.     RZ            ;ABORT IF SAME
  1168.     LDA    TDRIVE        ;LOG IN DEFAULT DRIVE
  1169. ;
  1170. DLOG5:    JMP    LOGIN
  1171. ;
  1172. ; ROUTINE COMMON TO BOTH LOGIN ROUTINES; ON EXIT, Z SET MEANS ABORT
  1173. ;
  1174. COMLOG:
  1175. TEMPDR    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  1176.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS TEMPDR
  1177.     ORA    A        ;0=NO
  1178.     RZ
  1179.     DCR    A        ;COMPARE IT AGAINST DEFAULT
  1180.     LXI    H,TDRIVE
  1181.     CMP    M
  1182.     RET            ;ABORT IF SAME
  1183. ;
  1184. ; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCBDN;
  1185. ;   FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP);
  1186. ;   ON INPUT, CIBPTR PTS TO CHAR AT WHICH TO START SCAN;
  1187. ;   ON OUTPUT, CIBPTR PTS TO CHAR AT WHICH TO CONTINUE AND ZERO FLAG IS RESET
  1188. ;     IF '?' IS IN TOKEN
  1189. ;
  1190. ; ENTRY POINTS:
  1191. ;    SCANER - LOAD TOKEN INTO FIRST FCB
  1192. ;    SCANX - LOAD TOKEN INTO FCB PTED TO BY HL
  1193. ;
  1194. SCANER:
  1195.     LXI    H,FCBDN     ;POINT TO FCBDN
  1196. SCANX:
  1197.     XRA    A        ;SET TEMPORARY DRIVE NUMBER TO DEFAULT
  1198.     STA    TEMPDR
  1199.     CALL    ADVAN        ;SKIP TO NON-BLANK OR END OF LINE
  1200.     SDED    CIPTR        ;SET PTR TO NON-BLANK OR END OF LINE
  1201.     LDAX    D        ;END OF LINE?
  1202.     ORA    A        ;0=YES
  1203.     JRZ    SCAN2
  1204.     SBI    'A'-1        ;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
  1205.     MOV    B,A        ;STORE NUMBER (A:=0, B:=1, ETC) IN B
  1206.     INX    D        ;PT TO NEXT CHAR
  1207.     LDAX    D        ;SEE IF IT IS A COLON (:)
  1208.     CPI    ':'
  1209.     JRZ    SCAN3        ;YES, WE HAVE A DRIVE SPEC
  1210.     DCX    D        ;NO, BACK UP PTR TO FIRST NON-BLANK CHAR
  1211. SCAN2:
  1212.     LDA    TDRIVE        ;SET 1ST BYTE OF FCBDN AS DEFAULT DRIVE
  1213.     MOV    M,A
  1214.     JR    SCAN4
  1215. SCAN3:
  1216.     MOV    A,B        ;WE HAVE A DRIVE SPEC
  1217.     STA    TEMPDR        ;SET TEMPORARY DRIVE
  1218.     MOV    M,B        ;SET 1ST BYTE OF FCBDN AS SPECIFIED DRIVE
  1219.     INX    D        ;PT TO BYTE AFTER ':'
  1220. ;
  1221. ; EXTRACT FILENAME FROM POSSIBLE FILENAME.TYP
  1222. ;
  1223. SCAN4:
  1224.     XRA    A        ;A=0
  1225.     STA    QMCNT        ;INIT COUNT OF NUMBER OF QUESTION MARKS IN FCB
  1226.     MVI    B,8        ;MAX OF 8 CHARS IN FILE NAME
  1227.     CALL    SCANF        ;FILL FCB FILE NAME
  1228. ;
  1229. ; EXTRACT FILE TYPE FROM POSSIBLE FILENAME.TYP
  1230. ;
  1231.     MVI    B,3        ;PREPARE TO EXTRACT TYPE
  1232.     CPI    '.'        ;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE
  1233.     JRNZ    SCAN15        ;FILL FILE TYPE BYTES WITH <SP>
  1234.     INX    D        ;PT TO CHAR IN COMMAND LINE AFTER '.'
  1235.     CALL    SCANF        ;FILL FCB FILE TYPE
  1236.     JR    SCAN16        ;SKIP TO NEXT PROCESSING
  1237. SCAN15:
  1238.     CALL    SCANF4        ;SPACE FILL
  1239. ;
  1240. ; FILL IN EX, S1, S2, AND RC WITH ZEROES
  1241. ;
  1242. SCAN16:
  1243.     MVI    B,4        ;4 BYTES
  1244. SCAN17:
  1245.     INX    H        ;PT TO NEXT BYTE IN FCBDN
  1246.     MVI    M,0
  1247.     DJNZ    SCAN17
  1248. ;
  1249. ; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN
  1250. ;
  1251.     SDED    CIBPTR
  1252. ;
  1253. ; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP
  1254. ;
  1255.     LDA    QMCNT        ;GET NUMBER OF QUESTION MARKS
  1256.     ORA    A        ;SET ZERO FLAG TO INDICATE ANY '?'
  1257.     RET
  1258. ;
  1259. ;  SCANF -- SCAN TOKEN PTED TO BY DE FOR A MAX OF B BYTES; PLACE IT INTO
  1260. ;    FILE NAME FIELD PTED TO BY HL; EXPAND AND INTERPRET WILD CARDS OF
  1261. ;    '*' AND '?'; ON EXIT, DE PTS TO TERMINATING DELIMITER
  1262. ;
  1263. SCANF:
  1264.     CALL    SDELM        ;DONE IF DELIMITER ENCOUNTERED - <SP> FILL
  1265.     JRZ    SCANF4
  1266.     INX    H        ;PT TO NEXT BYTE IN FCBDN
  1267.     CPI    '*'        ;IS (DE) A WILD CARD?
  1268.     JRNZ    SCANF1        ;CONTINUE IF NOT
  1269.     MVI    M,'?'        ;PLACE '?' IN FCBDN AND DON'T ADVANCE DE IF SO
  1270.     CALL    SCQ        ;SCANNER COUNT QUESTION MARKS
  1271.     JR    SCANF2
  1272. SCANF1:
  1273.     MOV    M,A        ;STORE FILENAME CHAR IN FCBDN
  1274.     INX    D        ;PT TO NEXT CHAR IN COMMAND LINE
  1275.     CPI    '?'        ;CHECK FOR QUESTION MARK (WILD)
  1276.     CZ    SCQ        ;SCANNER COUNT QUESTION MARKS
  1277. SCANF2:
  1278.     DJNZ    SCANF        ;DECREMENT CHAR COUNT UNTIL 8 ELAPSED
  1279. SCANF3:
  1280.     CALL    SDELM        ;8 CHARS OR MORE - SKIP UNTIL DELIMITER
  1281.     RZ            ;ZERO FLAG SET IF DELIMITER FOUND
  1282.     INX    D        ;PT TO NEXT CHAR IN COMMAND LINE
  1283.     JR    SCANF3
  1284. ;
  1285. ;  FILL MEMORY POINTED TO BY HL WITH SPACES FOR B BYTES
  1286. ;
  1287. SCANF4:
  1288.     INX    H        ;PT TO NEXT BYTE IN FCBDN
  1289.     MVI    M,' '        ;FILL FILENAME PART WITH <SP>
  1290.     DJNZ    SCANF4
  1291.     RET
  1292. ;
  1293. ;  INCREMENT QUESTION MARK COUNT FOR SCANNER
  1294. ;    THIS ROUTINE INCREMENTS THE COUNT OF THE NUMBER OF QUESTION MARKS IN
  1295. ;    THE CURRENT FCB ENTRY
  1296. ;
  1297. SCQ:
  1298.     LDA    QMCNT        ;GET COUNT
  1299.     INR    A        ;INCREMENT
  1300.     STA    QMCNT        ;PUT COUNT
  1301.     RET
  1302. ;
  1303. ; CMDTBL (COMMAND TABLE) SCANNER
  1304. ;   ON RETURN, HL PTS TO ADDRESS OF COMMAND IF CPR-RESIDENT
  1305. ;   ON RETURN, ZERO FLAG SET MEANS CPR-RESIDENT COMMAND
  1306. ;
  1307. CMDSER:
  1308.     LXI    H,CMDTBL    ;PT TO COMMAND TABLE
  1309.     MVI    C,NCMNDS    ;SET COMMAND COUNTER
  1310. CMS1:
  1311.     LXI    D,FCBFN     ;PT TO STORED COMMAND NAME
  1312.     MVI    B,NCHARS    ;NUMBER OF CHARS/COMMAND (8 MAX)
  1313. CMS2:
  1314.     LDAX    D        ;COMPARE AGAINST TABLE ENTRY
  1315.     CMP    M
  1316.     JRNZ    CMS3        ;NO MATCH
  1317.     INX    D        ;PT TO NEXT CHAR
  1318.     INX    H
  1319.     DJNZ    CMS2        ;COUNT DOWN
  1320.     LDAX    D        ;NEXT CHAR IN INPUT COMMAND MUST BE <SP>
  1321.     CPI    ' '
  1322.     JRNZ    CMS4
  1323.     RET            ;COMMAND IS CPR-RESIDENT (ZERO FLAG SET)
  1324. CMS3:
  1325.     INX    H        ;SKIP TO NEXT COMMAND TABLE ENTRY
  1326.     DJNZ    CMS3
  1327. CMS4:
  1328.     INX    H        ;SKIP ADDRESS
  1329.     INX    H
  1330.     DCR    C        ;DECREMENT TABLE ENTRY NUMBER
  1331.     JRNZ    CMS1
  1332.     INR    C        ;CLEAR ZERO FLAG
  1333.     RET            ;COMMAND IS DISK-RESIDENT (ZERO FLAG CLEAR)
  1334. ;
  1335. ;**** Section 5 ****
  1336. ; CPR-Resident Commands
  1337. ;
  1338. ;
  1339. ;Section 5A
  1340. ;Command: DIR
  1341. ;Function:  To display a directory of the files on disk
  1342. ;Forms:
  1343. ;    DIR <afn>    Displays the DIR files
  1344. ;    DIR <afn> S    Displays the SYS files
  1345. ;    DIR <afn> A    Display both DIR and SYS files
  1346. ;
  1347. DIR:
  1348.     MVI    A,80H        ;SET SYSTEM BIT EXAMINATION
  1349.     PUSH    PSW
  1350.     CALL    SCANER        ;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN
  1351.     CALL    SLOGIN        ;LOG IN DRIVE IF NECESSARY
  1352.     LXI    H,FCBFN     ;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
  1353.     MOV    A,M        ;GET FIRST CHAR OF FILENAME.TYP
  1354.     CPI    ' '        ;IF <SP>, ALL WILD
  1355.     CZ    FILLQ
  1356.     CALL    ADVAN        ;LOOK AT NEXT INPUT CHAR
  1357.     MVI    B,0        ;SYS TOKEN DEFAULT
  1358.     JRZ    DIR2        ;JUMP; THERE ISN'T ONE
  1359.     CPI    SYSFLG        ;SYSTEM FLAG SPECIFIER?
  1360.     JRZ    GOTSYS        ;GOT SYSTEM SPECIFIER
  1361.     CPI    SOFLG        ;SYS ONLY?
  1362.     JRNZ    DIR2
  1363.     MVI    B,80H        ;FLAG SYS ONLY
  1364. GOTSYS:
  1365.     INX    D
  1366.     SDED    CIBPTR
  1367.     CPI    SOFLG        ;SYS ONLY SPEC?
  1368.     JRZ    DIR2        ;THEN LEAVE BIT SPEC UNCHAGNED
  1369.     POP    PSW        ;GET FLAG
  1370.     XRA    A        ;SET NO SYSTEM BIT EXAMINATION
  1371.     PUSH    PSW 
  1372. DIR2:
  1373.     POP    PSW        ;GET FLAG
  1374. DIR2A:
  1375.                 ;DROP INTO DIRPR TO PRINT DIRECTORY
  1376.                 ; THEN RESTART CPR
  1377. ;
  1378. ; DIRECTORY PRINT ROUTINE; ON ENTRY, MSB OF A IS 1 (80H) IF SYSTEM FILES EXCL
  1379. ;
  1380. DIRPR:
  1381.     MOV    D,A        ;STORE SYSTEM FLAG IN D
  1382.     MVI    E,0        ;SET COLUMN COUNTER TO ZERO
  1383.     PUSH    D        ;SAVE COLUMN COUNTER (E) AND SYSTEM FLAG (D)
  1384.     MOV    A,B        ;SYS ONLY SPECIFIER
  1385.     STA    SYSTST
  1386.     CALL    SEARF        ;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE)
  1387.     CZ    PRNNF        ;PRINT NO FILE MSG;REG A NOT CHANGED
  1388. ;
  1389. ; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN
  1390. ;
  1391. DIR3:
  1392.     JRZ    DIR11        ;DONE IF ZERO FLAG SET
  1393.     DCR    A        ;ADJUST TO RETURNED VALUE
  1394.     RRC            ;CONVERT NUMBER TO OFFSET INTO TBUFF
  1395.     RRC
  1396.     RRC
  1397.     ANI    60H
  1398.     MOV    C,A        ;OFFSET INTO TBUFF IN C (C=OFFSET TO ENTRY)
  1399.     MVI    A,10        ;ADD 10 TO PT TO SYSTEM FILE ATTRIBUTE BIT
  1400.     CALL    DIRPTR
  1401.     POP    D        ;GET SYSTEM BIT MASK FROM D
  1402.     PUSH    D
  1403.     ANA    D        ;MASK FOR SYSTEM BIT
  1404. SYSTST    EQU    $+1        ;POINTER TO IN-THE-CODE BUFFER SYSTST
  1405.     CPI    0
  1406.     JRNZ    DIR10
  1407.     POP    D        ;GET ENTRY COUNT (=<CR> COUNTER)
  1408.     MOV    A,E        ;ADD 1 TO IT
  1409.     INR    E
  1410.     PUSH    D        ;SAVE IT
  1411.     ANI    03H        ;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
  1412.     PUSH    PSW
  1413.     JRNZ    DIR4
  1414.     CALL    CRLF        ;NEW LINE
  1415.     JR    DIR5
  1416. DIR4:
  1417.     CALL    PRINT
  1418. ;
  1419.     IF    WIDE
  1420.     DB    '  '        ;2 SPACES
  1421.     DB    FENCE        ;THEN FENCE CHAR
  1422.     DB    ' ',' '+80H    ;THEN 2 MORE SPACES
  1423.     ENDIF
  1424. ;
  1425.     IF    NOT WIDE
  1426.     DB    ' '        ;SPACE
  1427.     DB    FENCE        ;THEN FENCE CHAR
  1428.     DB    ' '+80H        ;THEN SPACE
  1429.     ENDIF
  1430. ;
  1431. DIR5:
  1432.     MVI    B,01H        ;PT TO 1ST BYTE OF FILE NAME
  1433. DIR6:
  1434.     MOV    A,B        ;A=OFFSET
  1435.     CALL    DIRPTR        ;HL NOW PTS TO 1ST BYTE OF FILE NAME
  1436.     ANI    7FH        ;MASK OUT MSB
  1437.     CPI    ' '        ;NO FILE NAME?
  1438.     JRNZ    DIR8        ;PRINT FILE NAME IF PRESENT
  1439.     POP    PSW
  1440.     PUSH    PSW
  1441.     CPI    03H
  1442.     JRNZ    DIR7
  1443.     MVI    A,09H        ;PT TO 1ST BYTE OF FILE TYPE
  1444.     CALL    DIRPTR        ;HL NOW PTS TO 1ST BYTE OF FILE TYPE
  1445.     ANI    7FH        ;MASK OUT MSB
  1446.     CPI    ' '        ;NO FILE TYPE?
  1447.     JRZ    DIR9        ;CONTINUE IF SO
  1448. DIR7:
  1449.     MVI    A,' '        ;OUTPUT <SP>
  1450. DIR8:
  1451.     CALL    CONOUT        ;PRINT CHAR
  1452.     INR    B        ;INCR CHAR COUNT
  1453.     MOV    A,B
  1454.     CPI    12        ;END OF FILENAME.TYP?
  1455.     JRNC    DIR9        ;CONTINUE IF SO
  1456.     CPI    09H        ;END IF FILENAME ONLY?
  1457.     JRNZ    DIR6        ;PRINT TYP IF SO
  1458.     MVI    A,'.'        ;PRINT DOT BETWEEN FILE NAME AND TYPE
  1459.     CALL    CONOUT
  1460.     JR    DIR6
  1461. DIR9:
  1462.     POP    PSW
  1463. DIR10:
  1464.     CALL    BREAK        ;CHECK FOR ABORT
  1465.     JRNZ    DIR11
  1466.     CALL    SEARN        ;SEARCH FOR NEXT FILE
  1467.     JR    DIR3        ;CONTINUE
  1468. DIR11:
  1469.     POP    D        ;RESTORE STACK
  1470.     RET
  1471. ;
  1472. ; FILL FCB @HL WITH '?'
  1473. ;
  1474. FILLQ:
  1475.     MVI    B,11        ;NUMBER OF CHARS IN FN & FT
  1476. FQLP:
  1477.     MVI    M,'?'        ;STORE '?'
  1478.     INX    H
  1479.     DJNZ    FQLP
  1480.     RET
  1481. ;
  1482. ;Section 5B
  1483. ;Command: ERA
  1484. ;Function:  Erase files
  1485. ;Forms:
  1486. ;    ERA <afn>    Erase Specified files and print their names
  1487. ;
  1488.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1489. ;
  1490. ERA:
  1491.     CALL    SCANER        ;PARSE FILE SPECIFICATION
  1492.     CPI    11        ;ALL WILD (ALL FILES = 11 '?')?
  1493.     JRNZ    ERA1        ;IF NOT, THEN DO ERASES
  1494.     CALL    PRINTC
  1495.     DB    'All','?'+80H
  1496.     CALL    CONIN        ;GET REPLY
  1497.     CPI    'Y'        ;YES?
  1498.     JNZ    RESTRT        ;RESTART CPR IF NOT
  1499.     CALL    CRLF        ;NEW LINE
  1500. ERA1:
  1501.     CALL    SLOGIN        ;LOG IN SELECTED DISK IF ANY
  1502.     XRA    A        ;PRINT ALL FILES (EXAMINE SYSTEM BIT)
  1503.     MOV    B,A        ;NO SYS-ONLY OPT TO DIRPR
  1504.     CALL    DIRPR        ;PRINT DIRECTORY OF ERASED FILES
  1505.     LXI    D,FCBDN     ;DELETE FILE SPECIFIED
  1506.     CALL    DELETE
  1507.     RET            ;REENTER CPR
  1508. ;
  1509.     ENDIF            ;RAS
  1510. ;
  1511. ;Section 5C
  1512. ;Command: LIST
  1513. ;Function:  Print out specified file on the LST: Device
  1514. ;Forms:
  1515. ;    LIST <ufn>    Print file (NO Paging)
  1516. ;
  1517. LIST:
  1518.     MVI    A,0FFH        ;TURN ON PRINTER FLAG
  1519.     JR    TYPE0
  1520. ;
  1521. ;Section 5D
  1522. ;Command: TYPE
  1523. ;Function:  Print out specified file on the CON: Device
  1524. ;Forms:
  1525. ;    TYPE <ufn>    Print file
  1526. ;    TYPE <ufn> P    Print file with paging flag    
  1527. ;
  1528. TYPE:
  1529.     XRA    A        ;TURN OFF PRINTER FLAG
  1530. ;
  1531. ; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
  1532. ;
  1533. TYPE0:
  1534.     STA    PRFLG        ;SET FLAG
  1535.     CALL    SCANER        ;EXTRACT FILENAME.TYP TOKEN
  1536.     JNZ    ERROR        ;ERROR IF ANY QUESTION MARKS
  1537.     CALL    ADVAN        ;GET PGDFLG IF IT'S THERE
  1538.     STA    PGFLG        ;SAVE IT AS A FLAG
  1539.     JRZ    NOSLAS        ;JUMP IF INPUT ENDED
  1540.     INX    D        ;PUT NEW BUF POINTER
  1541.     XCHG
  1542.     SHLD    CIBPTR
  1543. NOSLAS:
  1544.     CALL    SLOGIN        ;LOG IN SELECTED DISK IF ANY
  1545.     CALL    OPENF        ;OPEN SELECTED FILE
  1546.     JZ    TYPE4        ;ABORT IF ERROR
  1547.     CALL    CRLF        ;NEW LINE
  1548.     MVI    A,NLINES-1    ;SET LINE COUNT
  1549.     STA    PAGCNT
  1550.     LXI    H,CHRCNT    ;SET CHAR POSITION/COUNT
  1551.     MVI    M,0FFH        ;EMPTY LINE
  1552.     MVI    B,0        ;SET TAB CHAR COUNTER
  1553. TYPE1:
  1554.     LXI    H,CHRCNT    ;PT TO CHAR POSITION/COUNT
  1555.     MOV    A,M        ;END OF BUFFER?
  1556.     CPI    80H
  1557.     JRC    TYPE2
  1558.     PUSH    H        ;READ NEXT BLOCK
  1559.     CALL    READF
  1560.     POP    H
  1561.     JRNZ    TYPE3        ;ERROR?
  1562.     XRA    A        ;RESET COUNT
  1563.     MOV    M,A
  1564. TYPE2:
  1565.     INR    M        ;INCREMENT CHAR COUNT
  1566.     LXI    H,TBUFF     ;PT TO BUFFER
  1567.     CALL    ADDAH        ;COMPUTE ADDRESS OF NEXT CHAR FROM OFFSET
  1568.     MOV    A,M        ;GET NEXT CHAR
  1569.     ANI    7FH        ;MASK OUT MSB
  1570.     CPI    1AH        ;END OF FILE (^Z)?
  1571.     RZ            ;RESTART CPR IF SO
  1572. ;
  1573. ; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
  1574. ;
  1575.     CPI    CR        ;RESET TAB COUNT?
  1576.     JRZ    TABRST
  1577.     CPI    LF        ;RESET TAB COUNT?
  1578.     JRZ    TABRST
  1579.     CPI    TAB        ;TAB?
  1580.     JRZ    LTAB
  1581.     CALL    LCOUT        ;OUTPUT CHAR
  1582.     INR    B        ;INCREMENT CHAR COUNT
  1583.     JR    TYPE2L
  1584. TABRST:
  1585.     CALL    LCOUT        ;OUTPUT <CR> OR <LF>
  1586.     MVI    B,0        ;RESET TAB COUNTER
  1587.     JR    TYPE2L
  1588. LTAB:
  1589.     MVI    A,' '        ;<SP>
  1590.     CALL    LCOUT
  1591.     INR    B        ;INCR POS COUNT
  1592.     MOV    A,B
  1593.     ANI    7
  1594.     JRNZ    LTAB
  1595. ;
  1596. ; CONTINUE PROCESSING
  1597. ;
  1598. TYPE2L:
  1599.     CALL    BREAK        ;CHECK FOR ABORT
  1600.     JRZ    TYPE1        ;CONTINUE IF NO CHAR
  1601.     CPI    'C'-'@'     ;^C?
  1602.     RZ            ;RESTART IF SO
  1603.     JR    TYPE1
  1604. TYPE3:
  1605.     DCR    A        ;NO ERROR?
  1606.     RZ            ;RESTART CPR
  1607. TYPE4:
  1608.     JMP    ERRLOG
  1609. ;
  1610. ; PAGING ROUTINES
  1611. ;   PAGER COUNTS DOWN LINES AND PAUSES FOR INPUT (DIRECT) IF COUNT EXPIRES
  1612. ;   PAGSET SETS LINES/PAGE COUNT
  1613. ;
  1614. PAGER:
  1615.     PUSH    H
  1616.     LXI    H,PAGCNT    ;COUNT DOWN
  1617.     DCR    M
  1618.     JRNZ    PGBAK        ;JUMP IF NOT END OF PAGE
  1619.     MVI    M,NLINES-2    ;REFILL COUNTER
  1620. ;
  1621. PGFLG    EQU    $+1        ;POINTER TO IN-THE-CODE BUFFER PGFLG
  1622.     MVI    A,0        ;0 MAY BE CHANGED BY PGFLG EQUATE
  1623.     CPI    PGDFLG        ;PAGE DEFAULT OVERRIDE OPTION WANTED?
  1624. ;
  1625.     IF    PGDFLT        ;IF PAGING IS DEFAULT
  1626.     JRZ    PGBAK        ;  PGDFLG MEANS NO PAGING, PLEASE
  1627.     ELSE            ;IF PAGING NOT DEFAULT
  1628.     JRNZ    PGBAK        ;  PGDFLG MEANS PLEASE PAGINATE
  1629.     ENDIF
  1630. ;
  1631.     CALL    CONIN        ;GET CHAR TO CONTINUE
  1632.     CPI    'C'-'@'     ;^C
  1633.     JZ    RSTCPR        ;RESTART CPR
  1634. PGBAK:
  1635.     POP    H        ;RESTORE HL
  1636.     RET
  1637. ;
  1638. ;Section 5E
  1639. ;Command: SAVE
  1640. ;Function:  To save the contents of the TPA onto disk as a file
  1641. ;Forms:
  1642. ;    SAVE <Number of Pages> <ufn>
  1643. ;                Save specified number of pages (start at 100H)
  1644. ;                from TPA into specified file; <Number of
  1645. ;                Pages> is in DEC
  1646. ;    SAVE <Number of Sectors> <ufn> S
  1647. ;                Like SAVE above, but numeric argument specifies
  1648. ;                number of sectors rather than pages
  1649. ;
  1650.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1651. ;
  1652. SAVE:
  1653.     CALL    NUMBER        ;EXTRACT NUMBER FROM COMMAND LINE
  1654.     MOV    L,A        ;HL=PAGE COUNT
  1655.     MVI    H,0
  1656.     PUSH    H        ;SAVE PAGE COUNT
  1657.     CALL    EXTEST        ;TEST FOR EXISTENCE OF FILE AND ABORT IF SO
  1658.     MVI    C,16H        ;BDOS MAKE FILE
  1659.     CALL    GRBDOS
  1660.     POP    H        ;GET PAGE COUNT
  1661.     JRZ    SAVE3        ;ERROR?
  1662.     XRA    A        ;SET RECORD COUNT FIELD OF NEW FILE'S FCB
  1663.     STA    FCBCR
  1664.     CALL    ADVAN        ;LOOK FOR 'S' FOR SECTOR OPTION
  1665.     INX    D        ;PT TO AFTER 'S' TOKEN
  1666.     CPI    SECTFLG
  1667.     JRZ    SAVE0
  1668.     DCX    D        ;NO 'S' TOKEN, SO BACK UP
  1669.     DAD    H        ;DOUBLE IT FOR HL=SECTOR (128 BYTES) COUNT
  1670. SAVE0:
  1671.     SDED    CIBPTR        ;SET PTR TO BAD TOKEN OR AFTER GOOD TOKEN
  1672.     LXI    D,TPA        ;PT TO START OF SAVE AREA (TPA)
  1673. SAVE1:
  1674.     MOV    A,H        ;DONE WITH SAVE?
  1675.     ORA    L        ;HL=0 IF SO
  1676.     JRZ    SAVE2
  1677.     DCX    H        ;COUNT DOWN ON SECTORS
  1678.     PUSH    H        ;SAVE PTR TO BLOCK TO SAVE
  1679.     LXI    H,128        ;128 BYTES PER SECTOR
  1680.     DAD    D        ;PT TO NEXT SECTOR
  1681.     PUSH    H        ;SAVE ON STACK
  1682.     CALL    DMASET        ;SET DMA ADDRESS FOR WRITE (ADDRESS IN DE)
  1683.     LXI    D,FCBDN     ;WRITE SECTOR
  1684.     MVI    C,15H        ;BDOS WRITE SECTOR
  1685.     CALL    BDOSB        ;SAVE BC
  1686.     POP    D        ;GET PTR TO NEXT SECTOR IN DE
  1687.     POP    H        ;GET SECTOR COUNT
  1688.     JRNZ    SAVE3        ;WRITE ERROR?
  1689.     JR    SAVE1        ;CONTINUE
  1690. SAVE2:
  1691.     LXI    D,FCBDN     ;CLOSE SAVED FILE
  1692.     CALL    CLOSE
  1693.     INR    A        ;ERROR?
  1694.     JRNZ    SAVE4
  1695. SAVE3:
  1696.     CALL    PRNLE        ;PRINT 'NO SPACE' ERROR
  1697. SAVE4:
  1698.     CALL    DEFDMA        ;SET DMA TO 0080
  1699.     RET            ;RESTART CPR
  1700. ;
  1701. ; Test File in FCB for existence, ask user to delete if so, and abort if he
  1702. ;  choses not to
  1703. ;
  1704. EXTEST:
  1705.     CALL    SCANER        ;EXTRACT FILE NAME
  1706.     JNZ    ERROR        ;'?' IS NOT PERMITTED
  1707.     CALL    SLOGIN        ;LOG IN SELECTED DISK
  1708.     CALL    SEARF        ;LOOK FOR SPECIFIED FILE
  1709.     LXI    D,FCBDN        ;PT TO FILE FCB
  1710.     RZ            ;OK IF NOT FOUND
  1711.     PUSH    D        ;SAVE PTR TO FCB
  1712.     CALL    PRINTC
  1713.     DB    'Delete File','?'+80H
  1714.     CALL    CONIN        ;GET RESPONSE
  1715.     POP    D        ;GET PTR TO FCB
  1716.     CPI    'Y'        ;KEY ON YES
  1717.     JNZ    RSTCPR        ;RESTART IF NO
  1718.     PUSH    D        ;SAVE PTR TO FCB
  1719.     CALL    DELETE        ;DELETE FILE
  1720.     POP    D        ;GET PTR TO FCB
  1721.     RET
  1722. ;
  1723.     ENDIF            ;RAS
  1724. ;
  1725. ;Section 5F
  1726. ;Command: REN
  1727. ;Function:  To change the name of an existing file
  1728. ;Forms:
  1729. ;    REN <New ufn>=<Old ufn>    Perform function
  1730. ;
  1731.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1732. ;
  1733. REN:
  1734.     CALL    EXTEST        ;TEST FOR FILE EXISTENCE AND RETURN
  1735.                 ; IF FILE DOESN'T EXIST; ABORT IF IT DOES
  1736.     LDA    TEMPDR        ;SAVE CURRENT DEFAULT DISK
  1737.     PUSH    PSW        ;SAVE ON STACK
  1738. REN0:
  1739.     LXI    H,FCBDN     ;SAVE NEW FILE NAME
  1740.     LXI    D,FCBDM
  1741.     LXI    B,16        ;16 BYTES
  1742.     LDIR
  1743.     CALL    ADVAN        ;ADVANCE CIBPTR
  1744.     CPI    '='        ;'=' OK
  1745.     JRNZ    REN4
  1746. REN1:
  1747.     XCHG            ;PT TO CHAR AFTER '=' IN HL
  1748.     INX    H
  1749.     SHLD    CIBPTR        ;SAVE PTR TO OLD FILE NAME
  1750.     CALL    SCANER        ;EXTRACT FILENAME.TYP TOKEN
  1751.     JRNZ    REN4        ;ERROR IF ANY '?'
  1752.     POP    PSW        ;GET OLD DEFAULT DRIVE
  1753.     MOV    B,A        ;SAVE IT
  1754.     LXI    H,TEMPDR    ;COMPARE IT AGAINST CURRENT DEFAULT DRIVE
  1755.     MOV    A,M        ;MATCH?
  1756.     ORA    A
  1757.     JRZ    REN2
  1758.     CMP    B        ;CHECK FOR DRIVE ERROR
  1759.     MOV    M,B
  1760.     JRNZ    REN4
  1761. REN2:
  1762.     MOV    M,B
  1763.     XRA    A
  1764.     STA    FCBDN        ;SET DEFAULT DRIVE
  1765.     LXI    D,FCBDN     ;RENAME FILE
  1766.     MVI    C,17H        ;BDOS RENAME FCT
  1767.     CALL    GRBDOS
  1768.     RNZ
  1769. REN3:
  1770.     CALL    PRNNF        ;PRINT NO FILE MSG
  1771. REN4:
  1772.     JMP    ERRLOG
  1773. ;
  1774.     ENDIF            ;RAS
  1775. ;
  1776. ;Section 5G
  1777. ;Command: USER
  1778. ;Function:  Change current USER number
  1779. ;Forms:
  1780. ;    USER <unum>    Select specified user number;<unum> is in DEC
  1781. ;
  1782. USER:
  1783.     CALL    USRNUM        ;EXTRACT USER NUMBER FROM COMMAND LINE
  1784.     MOV    E,A        ;PLACE USER NUMBER IN E
  1785.     CALL    SETUSR        ;SET SPECIFIED USER
  1786. RSTJMP:
  1787.     JMP    RCPRNL        ;RESTART CPR
  1788. ;
  1789. ;Section 5H
  1790. ;Command: DFU
  1791. ;Function:  Set the Default User Number for the command/file scanner
  1792. ;         (MEMLOAD)
  1793. ;Forms:
  1794. ;    DFU <unum>    Select Default User Number;<unum> is in DEC
  1795. ;
  1796. DFU:
  1797.     CALL    USRNUM        ;GET USER NUMBER
  1798.     STA    DFUSR        ;PUT IT AWAY
  1799.     JR    RSTJMP        ;RESTART CPR (NO DEFAULT LOGIN)
  1800. ;
  1801. ;Section 5I
  1802. ;Command: JUMP
  1803. ;Function:  To Call the program (subroutine) at the specified address
  1804. ;         without loading from disk
  1805. ;Forms:
  1806. ;    JUMP <adr>        Call at <adr>;<adr> is in HEX
  1807. ;
  1808.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1809. ;
  1810. JUMP:
  1811.     CALL    HEXNUM        ;GET LOAD ADDRESS IN HL
  1812.     JR    CALLPROG    ;PERFORM CALL
  1813. ;
  1814.     ENDIF            ;RAS
  1815. ;
  1816. ;Section 5J
  1817. ;Command: GO
  1818. ;Function:  To Call the program in the TPA without loading
  1819. ;         loading from disk. Same as JUMP 100H, but much
  1820. ;         more convenient, especially when used with
  1821. ;         parameters for programs like STAT. Also can be
  1822. ;         allowed on remote-access systems with no problems.
  1823. ;
  1824. ;Form:
  1825. ;    GO <parameters like for COMMAND>
  1826. ;
  1827.     IF    NOT RAS        ;ONLY IF RAS
  1828. ;
  1829. GO:    LXI    H,TPA        ;Always to TPA
  1830.     JR    CALLPROG    ;Perform call
  1831. ;
  1832.     ENDIF            ;END OF GO FOR RAS
  1833. ;
  1834. ;Section 5K
  1835. ;Command: COM file processing
  1836. ;Function:  To load the specified COM file from disk and execute it
  1837. ;Forms:
  1838. ;    <command>
  1839. ;
  1840. COM:
  1841.     LDA    FCBFN        ;ANY COMMAND?
  1842.     CPI    ' '        ;' ' MEANS COMMAND WAS 'D:' TO SWITCH
  1843.     JRNZ    COM1        ;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
  1844.     LDA    TEMPDR        ;LOOK FOR DRIVE SPEC
  1845.     ORA    A        ;IF ZERO, JUST BLANK
  1846.     JZ    RCPRNL
  1847.     DCR    A        ;ADJUST FOR LOG IN
  1848.     STA    TDRIVE        ;SET DEFAULT DRIVE
  1849.     CALL    SETU0D        ;SET DRIVE WITH USER 0
  1850.     CALL    LOGIN        ;LOG IN DRIVE
  1851.     JMP    RCPRNL        ;RESTART CPR
  1852. COM1:
  1853.     LDA    FCBFT        ;FILE TYPE MUST BE BLANK
  1854.     CPI    ' '
  1855.     JNZ    ERROR
  1856.     LXI    H,COMMSG    ;PLACE DEFAULT FILE TYPE (COM) INTO FCB
  1857.     LXI    D,FCBFT        ;COPY INTO FILE TYPE
  1858.     LXI    B,3        ;3 BYTES
  1859.     LDIR
  1860.     LXI    H,TPA        ;SET EXECUTION/LOAD ADDRESS
  1861.     PUSH    H        ;SAVE FOR EXECUTION
  1862.     CALL    MEMLOAD        ;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
  1863.     POP    H        ;GET EXECUTION ADDRESS
  1864.     RNZ            ;RETURN (ABORT) IF LOAD ERROR
  1865. ;
  1866. ; CALLPROG IS THE ENTRY POINT FOR THE EXECUTION OF THE LOADED
  1867. ;   PROGRAM;ON ENTRY TO THIS ROUTINE, HL MUST CONTAIN THE EXECUTION
  1868. ;   ADDRESS OF THE PROGRAM (SUBROUTINE) TO EXECUTE
  1869. ;
  1870. CALLPROG:
  1871.     SHLD    EXECADR        ;PERFORM IN-LINE CODE MODIFICATION
  1872.     CALL    DLOGIN        ;LOG IN DEFAULT DRIVE
  1873.     CALL    SCANER        ;SEARCH COMMAND LINE FOR NEXT TOKEN
  1874.     LXI    H,TEMPDR    ;SAVE PTR TO DRIVE SPEC
  1875.     PUSH    H
  1876.     MOV    A,M        ;SET DRIVE SPEC
  1877.     STA    FCBDN
  1878.     LXI    H,FCBDN+10H    ;PT TO 2ND FILE NAME
  1879.     CALL    SCANX        ;SCAN FOR IT AND LOAD IT INTO FCBDN+16
  1880.     POP    H        ;SET UP DRIVE SPECS
  1881.     MOV    A,M
  1882.     STA    FCBDM
  1883.     XRA    A
  1884.     STA    FCBCR
  1885.     LXI    D,TFCB        ;COPY TO DEFAULT FCB
  1886.     LXI    H,FCBDN     ;FROM FCBDN
  1887.     LXI    B,33        ;SET UP DEFAULT FCB
  1888.     LDIR
  1889.     LXI    H,CIBUFF
  1890. COM4:
  1891.     MOV    A,M        ;SKIP TO END OF 2ND FILE NAME
  1892.     ORA    A        ;END OF LINE?
  1893.     JRZ    COM5
  1894.     CPI    ' '        ;END OF TOKEN?
  1895.     JRZ    COM5
  1896.     INX    H
  1897.     JR    COM4
  1898. ;
  1899. ; LOAD COMMAND LINE INTO TBUFF
  1900. ;
  1901. COM5:
  1902.     MVI    B,0        ;SET CHAR COUNT
  1903.     LXI    D,TBUFF+1    ;PT TO CHAR POS
  1904. COM6:
  1905.     MOV    A,M        ;COPY COMMAND LINE TO TBUFF
  1906.     STAX    D
  1907.     ORA    A        ;DONE IF ZERO
  1908.     JRZ    COM7
  1909.     INR    B        ;INCR CHAR COUNT
  1910.     INX    H        ;PT TO NEXT
  1911.     INX    D
  1912.     JR    COM6
  1913. ;
  1914. ; RUN LOADED TRANSIENT PROGRAM
  1915. ;
  1916. COM7:
  1917.     MOV    A,B        ;SAVE CHAR COUNT
  1918.     STA    TBUFF
  1919.     CALL    CRLF        ;NEW LINE
  1920.     CALL    DEFDMA        ;SET DMA TO 0080
  1921.     CALL    SETUD        ;SET USER/DISK
  1922. ;
  1923. ; EXECUTION (CALL) OF PROGRAM (SUBROUTINE) OCCURS HERE
  1924. ;
  1925. EXECADR    EQU    $+1        ;CHANGE ADDRESS FOR IN-LINE CODE MODIFICATION
  1926.     CALL    TPA        ;CALL TRANSIENT
  1927.     CALL    DEFDMA        ;SET DMA TO 0080, IN CASE
  1928.                 ;PROG CHANGED IT ON US
  1929.     CALL    SETU0D        ;SET USER 0/DISK
  1930.     CALL    LOGIN        ;LOGIN DISK
  1931.     JMP    RESTRT        ;RESTART CPR
  1932. ;
  1933. ; TRANSIENT LOAD ERROR
  1934. ;
  1935. COM8:
  1936.     POP    H        ;CLEAR RETURN ADDRESS
  1937.     CALL    RESETUSR    ;RESET CURRENT USER NUMBER
  1938.                 ;  RESET MUST BE DONE BEFORE LOGIN
  1939. ERRLOG:
  1940.     CALL    DLOGIN        ;LOG IN DEFAULT DISK
  1941. ERRJMP:
  1942.     JMP    ERROR
  1943. ;
  1944. ;Section 5L
  1945. ;Command: GET
  1946. ;Function:  To load the specified file from disk to the specified address
  1947. ;Forms:
  1948. ;    GET <adr> <ufn>    Load the specified file at the specified page;
  1949. ;            <adr> is in HEX
  1950. ;
  1951.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1952. ;
  1953. GET:
  1954.     CALL    HEXNUM        ;GET LOAD ADDRESS IN HL
  1955.     PUSH    H        ;SAVE ADDRESS
  1956.     CALL    SCANER        ;GET FILE NAME
  1957.     POP    H        ;RESTORE ADDRESS
  1958.     JRNZ    ERRJMP        ;MUST BE UNAMBIGUOUS
  1959. ;
  1960. ; FALL THRU TO MEMLOAD
  1961. ;
  1962.     ENDIF            ;RAS
  1963. ;
  1964. ; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE
  1965. ;   ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD
  1966. ;
  1967. MEMLOAD:
  1968.     CALL    MLOAD        ;USER MEMORY LOAD SUBROUTINE
  1969.     PUSH    PSW        ;SAVE RETURN STATUS
  1970.     CALL    RESETUSR    ;RESET USER NUMBER
  1971.     POP    PSW        ;GET RETURN STATUS
  1972.     RET
  1973.  
  1974. ;
  1975. ;  MEMORY LOAD SUBROUTINE
  1976. ;    EXIT POINTS ARE A SIMPLE RETURN WITH THE ZERO FLAG SET IF NO ERROR,
  1977. ; A SIMPLE RETURN WITH THE ZERO FLAG RESET (NZ) IF MEMORY FULL, OR A JMP TO
  1978. ; COM8 IF COM FILE NOT FOUND
  1979. ;
  1980. MLOAD:
  1981.     SHLD    LOADADR        ;SET LOAD ADDRESS
  1982.     CALL    GETUSR        ;GET CURRENT USER NUMBER
  1983.     STA    TMPUSR        ;SAVE IT FOR LATER
  1984.     STA    TSELUSR     ;TEMP USER TO SELECT
  1985. ;
  1986. ;   MLA is a reentry point for a non-standard CP/M Modification
  1987. ; This is the return point for when the .COM (or GET) file is not found the
  1988. ; first time, Drive A: is selected for a second attempt
  1989. ;
  1990. MLA:
  1991.     CALL    SLOGIN        ;LOG IN SPECIFIED DRIVE IF ANY
  1992.     CALL    OPENF        ;OPEN COMMAND.COM FILE
  1993.     JRNZ    MLA1        ;FILE FOUND - LOAD IT
  1994. ;
  1995. ; ERROR ROUTINE TO SELECT USER 0 IF ALL ELSE FAILS
  1996. ;
  1997. DFUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
  1998.     MVI    A,DEFUSR    ;GET DEFAULT USER
  1999. TSELUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
  2000.     CPI    DEFUSR        ;SAME?
  2001.     JRZ    MLA0        ;JUMP IF
  2002.     STA    TSELUSR        ;ELSE PUT DOWN NEW ONE
  2003.     MOV    E,A
  2004.     CALL    SETUSR        ;GO SET NEW USER NUMBER
  2005.     JR    MLA        ;AND TRY AGAIN
  2006. ;
  2007. ; ERROR ROUTINE TO SELECT DRIVE A: IF DEFAULT WAS ORIGINALLY SELECTED
  2008. ;
  2009. MLA0:
  2010.     LXI    H,TEMPDR    ;GET DRIVE FROM CURRENT COMMAND
  2011.     XRA    A        ;A=0
  2012.     ORA    M
  2013.     JNZ    COM8        ;ERROR IF ALREADY DISK A:
  2014.     MVI    M,1        ;SELECT DRIVE A:
  2015.     JR    MLA
  2016. ;
  2017. ; FILE FOUND -- PROCEED WITH LOAD
  2018. ;
  2019. MLA1:
  2020. LOADADR    EQU    $+1        ;MEMORY LOAD ADDRESS (IN-LINE CODE MOD)
  2021.     LXI    H,TPA        ;SET START ADDRESS OF MEMORY LOAD
  2022. ML2:
  2023.     MVI    A,ENTRY/256-1    ;GET HIGH-ORDER ADR OF JUST BELOW CPR
  2024.     CMP    H        ;ARE WE GOING TO OVERWRITE THE CPR?
  2025.     JRC    PRNLE        ;ERROR IF SO
  2026.     PUSH    H        ;SAVE ADDRESS OF NEXT SECTOR
  2027.     XCHG            ;... IN DE
  2028.     CALL    DMASET        ;SET DMA ADDRESS FOR LOAD
  2029.     LXI    D,FCBDN     ;READ NEXT SECTOR
  2030.     CALL    READ
  2031.     POP    H        ;GET ADDRESS OF NEXT SECTOR
  2032.     JRNZ    ML3        ;READ ERROR OR EOF?
  2033.     LXI    D,128        ;MOVE 128 BYTES PER SECTOR
  2034.     DAD    D        ;PT TO NEXT SECTOR IN HL
  2035.     JR    ML2
  2036. ;
  2037. ML3:
  2038.     DCR    A        ;LOAD COMPLETE
  2039.     RZ            ;OK IF ZERO, ELSE FALL THRU TO PRNLE
  2040. ;
  2041. ; LOAD ERROR
  2042. ;
  2043. PRNLE:
  2044.     CALL    PRINTC
  2045.     DB    'Ful','l'+80H
  2046.     MVI    A,1        ;SET NON-ZERO TO INDICATE ERROR
  2047.     ORA    A        ;SET FLAG
  2048. .list
  2049.     RET
  2050. ;
  2051.     .dephase
  2052.     .xlist
  2053.     END
  2054.