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