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