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