home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol077 / zcpr-16.asm < prev    next >
Assembly Source File  |  1984-04-29  |  67KB  |  2,483 lines
  1.     TITLE    'NZCPR V 1.6 OF 08/03/82'
  2. ;
  3. ;  CP/M Z80 Command Processor Replacement (CPR) Version 1.6 in
  4. ; the NZCPR line.
  5. ;
  6. ;    CCPZ CREATED AND CUSTOMIZED FOR ARIES-II BY RLC
  7. ;    ZCPR VERSION 1.0 CREATED FROM CCPZ VERSION 4.0 BY RLC IN
  8. ;        A COORDINATED EFFORT WITH CCP-GROUP
  9. ;
  10. ;    ZCPR is a group effort by CCP-GROUP, whose active membership involved
  11. ; in this project consists of the following:
  12. ;        RLC - Richard Conn
  13. ;        RGF - Ron Fowler
  14. ;        KBP - Keith Peterson
  15. ;        FJW - Frank Wancho
  16. ;    The following individuals also provided a contribution:
  17. ;        SBB - Steve Bogolub
  18. ;
  19. ;  Since RLC has decided that ZCPR V1.0 is the last official version
  20. ; sanctioned by the CCPZ group, changes beyond that point are being
  21. ; called by consensus of a group of new changers "NZCPR Vx.x". The
  22. ; following individuals have put in their code or opinions:
  23. ;
  24. ;        SBB - Steve Bogolub
  25. ;        PST - Paul Traina
  26. ;        HLB - Howard Booker
  27. ;        CAF - Chuck Forsberg
  28. ;        RAF - Bob Fischer
  29. ;        BB  - Ben Bronson
  30. ;        PRG - Paul Grupp
  31. ;        PJH - Paul Homchick
  32. ;        HEW - Hal Walchli
  33. ;
  34. ;   In an attempt to maintain a link to the past, changes between the
  35. ; current version of NZCPR are provided as both a difference file
  36. ; between NZCPR's (NZ14-16.DIF) and as a difference between the current
  37. ; version and the "official" ZCPR V1.0 (NZCPR-16.DIF).  These changes
  38. ; are made and supported by individuals in contact with each other through
  39. ; the Hyde Park RCPM in Chicago. Make comments or complaints there, to
  40. ; SBB or PST or anyone else interested.
  41. ;
  42. ;   The most obvious differences between NZCPR and ZCPR are the security
  43. ; features, controlled by additional conditional assembly flags. Such
  44. ; features restrict access to ZCPR intrinsic commands, add additional
  45. ; levels of .COM file searching, and prevent access to higher drives
  46. ; or user levels, with either internal or external password control of
  47. ; these features. Less obvious differences involve code optimization to
  48. ; gain space, and some minor bug fixes in the TYPE command.
  49. ;
  50. ;******** Structure Notes ********
  51. ;
  52. ;    This CPR is divided into a number of major sections.  The following
  53. ; is an outline of these sections and the names of the major routines
  54. ; located therein.
  55. ;
  56. ; Section    Function/Routines
  57. ; -------    -----------------
  58. ;
  59. ;   --        Opening Comments, Equates, and Macro Definitions
  60. ;
  61. ;    0        JMP Table into CPR
  62. ;
  63. ;    1        Buffers
  64. ;
  65. ;    2        CPR Starting Modules
  66. ;            CPR1    CPR    RESTRT    RSTCPR    RCPRNL
  67. ;            PRNNF    CMDTBL
  68. ;
  69. ;    3        Utilities
  70. ;            CRLF    CONOUT    CONIN    LCOUT    LSTOUT
  71. ;            READF    READ    BDOSB    PRINTC    PRINT
  72. ;            GETDRV    DEFDMA    DMASET    RESET    BDOSJP
  73. ;            LOGIN    OPENF    OPEN    GRBDOS    CLOSE
  74. ;            SEARF    SEAR1    SEARN    SUBKIL    DELETE
  75. ;            RESETUSR GETUSR    SETUSR    PAGER    UCASE
  76. ;            NOECHO
  77. ;
  78. ;     4        CPR Utilities
  79. ;            SETUD    SETU0D    REDBUF    CNVBUF    CMDSER
  80. ;            BREAK    USRNUM    ERROR    SDELM    ADVAN
  81. ;            SBLANK    ADDAH    NUMBER    NUMERR    HEXNUM
  82. ;            DIRPTR    SLOGIN    DLOGIN    COMLOG    SCANER
  83. ;
  84. ;     5        CPR-Resident Commands and Functions
  85. ;     5A        DIR    DIRPR    FILLQ
  86. ;     5B        ERA
  87. ;     5C        LIST
  88. ;     5D        TYPE
  89. ;     5E        SAVE
  90. ;     5F        REN
  91. ;     5G        USER
  92. ;     5H        DFU
  93. ;     5I        JUMP
  94. ;     5J        GO
  95. ;     5K        COM    CALLPROG    ERRLOG    ERRJMP
  96. ;     5L        GET    MEMLOAD    PRNLE
  97. ;     5M        PASS    NORM
  98. ;
  99. ;
  100. FALSE    EQU    0
  101. TRUE    EQU    NOT FALSE
  102. ;
  103. ;  CUSTOMIZATION EQUATES
  104. ;
  105. ;  The following equates may be used to customize this CPR for the user's
  106. ;    system and integration technique.  The following constants are provided:
  107. ;
  108. ;    REL - TRUE if integration is to be done via MOVCPM
  109. ;        - FALSE if integration is to be done via DDT and SYSGEN
  110. ;
  111. ;    SECURE -  TRUE to conditionally disable potentially-harmful
  112. ;           commands (GO, ERA, SAVE, REN, DFU, GET, JUMP). Under
  113. ;           SECURE, if WHEEL contains RESTRCT, do not accept those
  114. ;           commands, and search for COM files under current user
  115. ;           then user "DEFUSR" only. If WHEEL does not contain
  116. ;           RESTRCT (presumably from passworded change), allow
  117. ;           all commands, and search current user, then last user
  118. ;           set by DFU (originally "RESUSR"), then user "DEFUSR"
  119. ;           for COM files, giving access with password to an
  120. ;           additional level of COM files.
  121. ;
  122. ;           (Note: WHEEL must point to a safe place in memory that
  123. ;        won't be overlayed)
  124. ;
  125. ;    If you have chosen a SECURE system,  all resident commands may be
  126. ; activated by entering:  PASS <password> <cr>  Where <password> is a sequence
  127. ; of characters placed at PASSID (if INPASS is true, otherwise, see
  128. ; documentation in PST's PASS.ASM).  If the password is incorrect. the system
  129. ; will come back with PASS? as if it was looking for a COM file.
  130. ;    NORM is the reverse of PASS, it will disable the WHEEL mode.
  131. ;
  132. ;    INPASS -  If in the SECURE mode, you wish to use a program similar
  133. ;           to PST's PASS.ASM, set this false, otherwise, ZCPR will
  134. ;           handle the PASSword coding with a built in command.
  135. ;
  136. ;    DRUSER -  Set this EQU false if you wish to disable RAF's neat hack
  137. ;           that allows you the type B: 7 to move to drive B: user area
  138. ;           seven.  This also removes the USER command.  Basically, set
  139. ;           this equate false if you want to use USERPW or some other pgm.
  140. ;
  141. ;    RAS    -  Remote-Access System; setting this equate to TRUE disables
  142. ;           certain CPR commands that are considered harmful in a Remote-
  143. ;           Access environment; use under Remote-Access Systems (RBBS) for
  144. ;           security purposes.  Note: SECURE is the direct enemy of RAS,
  145. ;           DON'T define both equates or you will be VERY sorry.
  146. ;           The advantage SECURE has over RAS is that by saying a magic
  147. ;           word, all of the normal commands pop into existance.
  148. ;
  149. ;    MAXDRIV - Maximum legal drive number stored in this location.
  150. ;           (0 means only A:, etc.)  0000H disables this feature.
  151. ;           The value MAXDR is stuffed into MAXDRIV at cold boot,
  152. ;           and presumably will be changed later by a passworded
  153. ;           program if desired.
  154. ;
  155. ;           (This code is in addition to BIOS checks. It's needed here
  156. ;           because X: can hang if X: is off line in some BIOS
  157. ;           implementations. Personally, I think CAF and others should fix
  158. ;           their BIOS instead. Mine works right...SBB).
  159. ;
  160. ;    USRMAX -  Maximum legal user # + 1 stored in this location. 0000H
  161. ;           disables this feature, and uses the value of MAXUSR+1 instead.
  162. ;
  163. ;    BASE - Base Address of user's CP/M system (normally 0 for DR version)
  164. ;           This equate allows easy modification by non-standard CP/M (eg,H89)
  165. ;
  166. ;    CPRLOC - Base Page Address of CPR; this value can be obtained by running
  167. ;          the BDOSLOC program on your system, or by setting the
  168. ;          MSIZE and BIOSEX equates to the system memory size in
  169. ;          K-bytes and the "extra" memory required by your BIOS
  170. ;          in K-bytes. BIOSEX is zero if your BIOS is normal size,
  171. ;          and can be negative if your BIOS is in PROM or in
  172. ;          non-contiguous memory.
  173. ;
  174. ;    EPRMPT - Set TRUE to be prompted "OK?" after seeing what files will
  175. ;          be erased. No, this is NOT for individual file prompting,
  176. ;          it is just to confirm deletion of all selected files at once.
  177. ;
  178. ;  Various individuals keep trying to yank out the TYPE, LIST, and DIR
  179. ; commands, either to use the space for other options or just because
  180. ; they prefer replacement COM files. To these individuals, I (SBB) say
  181. ; keep your paws off these commands. For compatibility with the stock
  182. ; CCP, intrinsic DIR and TYPE commands are required. And many users in
  183. ; MY neighborhood find it more convenient to use the intrinsic LIST
  184. ; command than to have a LIST/PRINT program on every disk. If you want
  185. ; to call a transient program by an intrinsic, then CHANGE THE INTRINSIC
  186. ; NAME IN THE TABLE. Even setting the name to blanks is fine to get
  187. ; rid of it. The point is, don't remove features others may want, just
  188. ; because you disagree, then throw it back in our laps. For those who
  189. ; simply MUST be rid of these commands, the following symbols control
  190. ; generation of the code in a CLEAN ACCEPTABLE fashion that allows
  191. ; others to have these features:
  192. ;
  193. ;    CPRTYP -    Set to TRUE to generate code for intrinsic TYPE command.
  194. ;
  195. ;    WSTYPE -    Set to TRUE to generate an extra three lines of code
  196. ;        to correctly interpret the WordStar (tm) internal
  197. ;        end of line hyphen for display, which is the ASCII
  198. ;        NEWLINE code (1FH) and normally non-printing or
  199. ;        troublemaking -- thanks to PJH for this one. CPRTYP
  200. ;        must be TRUE, or this symbol will be ignored.
  201. ;
  202. ;    CPRLST -    Set to TRUE to generate code for intrinsic LIST command.
  203. ;        Since almost all of the LIST code is common to the
  204. ;        TYPE code, CPRTYP must be set TRUE as well, or this
  205. ;        symbol will be ignored.
  206. ;
  207. ;    CPRDIR -    Set to TRUE to generate code for intrinsic DIR command.
  208. ;        Note that unlike the various directory programs, a
  209. ;        restricted DIR command here allows displaying the names
  210. ;        of SYS file ONLY, so many RCPM operators WANT this code.
  211. ;
  212. ;  Remember, you only get a total of 2048 (0800H) bytes of space for
  213. ; ALL of the generated code, or many other areas of your system
  214. ; generation will be affected. For example, to be fully SECURE, you
  215. ; would set SECURE to TRUE, and define MAXDRIV and USRMAX, and maybe
  216. ; use the internal password by setting INPASS to TRUE (external is
  217. ; MUCH recommended for easier modification). Those options absolutely
  218. ; generate too much code unless either CPRTYP or CPRDIR or both are
  219. ; set FALSE. A system with SECURE set to FALSE is right on the edge,
  220. ; and requires a give and take on options to fit, i.e. you can have
  221. ; MAXDRIV and USRMAX with DIR and TYPE if you leave out LIST and
  222. ; querying on ERASE, and so on.
  223. ;
  224. ***************************************************************************
  225. ** Be careful when playing with different combinations of these equates. **
  226. ** You might not have enough memory to some combinations.  Check this    **
  227. ** if you have problems, if they still persist, gripe to me (PST).       **
  228. ***************************************************************************
  229. ;
  230. REL    EQU    FALSE    ;SET TO TRUE FOR MOVCPM INTEGRATION
  231. ;
  232. BASE    EQU    0    ;BASE OF CP/M SYSTEM (SET FOR STANDARD CP/M)
  233. ;
  234.     IF    REL
  235. CPRLOC    EQU    0    ;MOVCPM IMAGE
  236.     ELSE
  237. ;
  238. ; If REL is FALSE, the value of CPRLOC may be set in one
  239. ; of two ways.  The first way is to set MSIZE and BIOSEX
  240. ; as described above using the following three lines:
  241. ;
  242. MSIZE    EQU    56    ;SIZE OF MEM IN K-BYTES
  243. BIOSEX    EQU    2    ;EXTRA # K-BYTES IN BIOS
  244. CPRLOC    EQU    3400H+(MSIZE-20-BIOSEX)*1024    ;CPR ORIGIN
  245. ;
  246. ; The second way is to obtain the origin of your current
  247. ; CPR using BDSLOC or its equivalent, then merely set CPRLOC
  248. ; to that value as in the following line:
  249. ;
  250. ;CPRLOC    EQU    0DA00H    ;FILL IN WITH BDOSLOC SUPPLIED VALUE
  251. ;
  252. ; Note that you should only use one method or the other.
  253. ; Do NOT define CPRLOC twice!
  254. ;
  255. ; The following gives the required offset to load the CPR into the
  256. ; CP/M SYSGEN Image through DDT (the Roffset command); Note that this
  257. ; value conforms with the standard value presented in the CP/M reference
  258. ; manuals, but it may not necessarily conform with the location of the
  259. ; CCP in YOUR CP/M system; several systems (Morrow Designs, P&T, Heath
  260. ; Org-0 to name a few) have the CCP located at a non-standard address in
  261. ; the SYSGEN Image
  262. ;
  263. ;CPRR    EQU    0E00H-CPRLOC    ;DDT LOAD OFFSET FOR APPLE SOFTCARD 56K
  264. CPRR    EQU    0980H-CPRLOC    ;DDT LOAD OFFSET
  265. ;CPRR    EQU    1600H-CPRLOC    ;DDT LOAD OFFSET FOR COMPUPRO DISK-1
  266. ;CPRR    EQU    1100H-CPRLOC    ;DDT LOAD OFFSET FOR MORROW DESIGNS
  267.     ENDIF
  268. ;
  269. RAS    EQU    FALSE    ;SET TO TRUE IF CPR IS FOR A REMOTE-ACCESS SYSTEM
  270.             ;AND YOU DON'T WANT TO RUN SECURE (FOO...)
  271. ;
  272. USRMAX    EQU    0000H        ;LOCATION OF BYTE IN MEMORY CONTAINING
  273.                 ; NUMBER OF HIGHEST ALLOWABLE USER CODE + 1
  274.                 ; THIS VALUE IS SET BY CPR ON COLD BOOT,
  275.                 ; AND PRESUMABLY CONTROLLED AFTER THAT
  276.                 ; BY A PASSWORD PROGRAM. IF USRMAX=0, THEN
  277.                 ; MAXUSR BELOW IS USED FOR CHECKING ONLY.
  278.                 ; 03FH IS RECOMMENDED IF USED  ***
  279. MAXUSR    EQU    15        ;MAX ALLOWED USER NUMBER, THIS + 1 IS STUFFED
  280.                 ; INTO USRMAX ON COLD BOOT, OR USED DIRECTLY
  281.                 ; IF USRMAX=0
  282. ;
  283. MAXDRIV    EQU    0000H    ;LOCATION THAT HAS MAX LEGAL DRIVE #
  284.             ;SET IT TO ZERO TO DISABLE THIS CHECK
  285.             ;03DH IS RECOMMENDED IF USED ***
  286. MAXDR    EQU    1    ;MAX DRIVE # TO SET INTO MAXDRIV ON COLD BOOT
  287. ;
  288. SECURE    EQU    FALSE    ;SET TRUE FOR SECURE ENVIRONMENT...
  289. ;
  290. DEFUSR    EQU    0        ;DEFAULT USER FOR UNRESTRICTED COM FILES
  291. ;
  292.     IF    SECURE
  293. WHEEL    EQU    3EH    ;SET TO "RESTRCT" FOR LIMITED ACCESS
  294. RESTRCT EQU    0    ;WHEN (WHEEL)==RESTRCT, LIMIT COMMANDS
  295. RESUSR    EQU    15    ;CHECK HERE FOR RESTRICTED ACCESS COM FILES (LIKE PIP)
  296.             ; UNTIL CHANGED BY DFU OR WARM BOOT
  297.     ENDIF    ;SECURE
  298. ;
  299. INPASS    EQU    FALSE    ;SET TRUE IF RUNNING SECURE AND NOT PASS.COM
  300. ;
  301. DRUSER    EQU    TRUE    ;TRUE TO ALLOW USER COMMAND AND DRIVE/USER HACK
  302. ;
  303. EPRMPT    EQU    FALSE    ;TRUE TO PROMPT BEFORE ERASING ALL FILES
  304. ;
  305. CPRTYP    EQU    TRUE    ;TRUE TO GENERATE TYPE CODE
  306. WSTYPE    EQU    TRUE    ;TRUE TO GENERATE WORDSTAR HYPHEN CHECK (CPRTYP
  307.             ; MUST BE TRUE TOO)
  308. CPRLST    EQU    TRUE    ;TRUE TO GENERATE LIST CODE (CPRTYP MUST BE TRUE TOO)
  309. CPRDIR    EQU    TRUE    ;TRUE TO GENERATE DIR CODE
  310. ;
  311. ;  ***  Note to Apple Softcard Users  ***
  312. ;
  313. ;  In their infinite (?) wisdom (???), Microsoft decided that the way to
  314. ; get a two-column directory display instead of four-column (narrow 40-col
  315. ; screen, remember) was to have their BIOS poke CCP every time it was
  316. ; loaded, if there was no terminal interface card in I/O slot 3.
  317. ; Naturally, that will turn into a random poke on any non-standard
  318. ; CCP, like this one.  The best way to get this CPR up on the Apple is to
  319. ; load it into CPM56.COM, at location 0E00H in the image.  The BIOS code
  320. ; that pokes the CPR can also be modified at that time.  The poke is done
  321. ; by "STA 0C8B2H", found at 24FEH in the CPM56 image.  To keep this
  322. ; feature, change the 0C8B2H address in that instruction by hand to
  323. ; the value generated for the symbol TWOPOK in the DIR routine.  If
  324. ; you have assembled out the DIR code by setting CPRDIR to FALSE, then
  325. ; disable this feature by changing the "STA" to "LDA", i.e. set the
  326. ; contents of location 24FEH from 32H to 3AH. If you wish to force
  327. ; a two-column display in all cases, set the TWOCOL switch below to a
  328. ; value of TRUE, and disable the poke.
  329. ;
  330. TWOCOL    EQU    FALSE        ;TRUE IF TWO COL DIR INSTEAD OF FOUR
  331. ;
  332. ; The following is presented as an option, but is not generally user-customiz-
  333. ; able.  A basic design choice had to be made in the design of ZCPR concerning
  334. ; the execution of SUBMIT files.  The original CCP had a problem in this sense
  335. ; in that it ALWAYS looked for the SUBMIT file from drive A: and the SUBMIT
  336. ; program itself (SUBMIT.COM) would place the $$$.SUB file on the currently
  337. ; logged-in drive, so when the user was logged into B: and he issued a SUBMIT
  338. ; command, the $$$.SUB was placed on B: and did not execute because the CCP
  339. ; looked for it on A: and never found it.
  340. ;
  341. ;    After much debate it was decided to have ZCPR perform the same type of
  342. ; function as CCP (look for the $$$.SUB file on A:), but the problem with
  343. ; SUBMIT.COM still exists.  Hence, RGF designed SuperSUB and RLC took his
  344. ; SuperSUB and designed SUB from it; both programs are set up to allow the
  345. ; selection at assembly time of creating the $$$.SUB on the logged-in drive
  346. ; or on drive A:.
  347. ;
  348. ;    A final definition of the Indirect Command File ($$$.SUB or SUBMIT
  349. ; File) is presented as follows:
  350. ;
  351. ;        "An Indirect Command File is one which contains
  352. ;         a series of commands exactly as they would be
  353. ;         entered from a CP/M Console.  The SUBMIT Command
  354. ;         (or SUB Command) reads this files and transforms
  355. ;         it for processing by the ZCPR (the $$$.SUB File).
  356. ;         ZCPR will then execute the commands indicated
  357. ;         EXACTLY as if they were typed at the Console."
  358. ;
  359. ;    Hence, to permit this to happen, the $$$.SUB file must always
  360. ; be present on a specific drive, and A: is the choice for said drive.
  361. ; With this facility engaged as such, Indirect Command Files like:
  362. ;
  363. ;        DIR
  364. ;        A:
  365. ;        DIR
  366. ;
  367. ; can be executed, even though the currently logged-in drive is changed
  368. ; during execution.  If the $$$.SUB file was present on the currently
  369. ; logged-in drive, the above series of commands would not work since the
  370. ; ZCPR would be looking for $$$.SUB on the logged-in drive, and switching
  371. ; logged-in drives without moving the $$$.SUB file as well would cause
  372. ; processing to abort.
  373. ;
  374. SUBA    EQU    TRUE     ; Set to TRUE to have $$$.SUB always on A:
  375.             ; Set to FALSE to have $$$.SUB on the logged-in drive
  376. ;
  377. ;   The following flag enables extended processing for user-program supplied
  378. ; command lines.  This is for Command Level 3 of ZCPR.  Under the current
  379. ; ZCPR philosophy, three command levels exist:
  380. ;
  381. ;    (1) that command issued by the user from his console at the '>' prompt
  382. ;    (2) that command issued by a $$$.SUB file at the '$' prompt
  383. ;    (3) that command issued by a user program by placing the command into
  384. ;        CIBUFF and setting the character count in CBUFF
  385. ;
  386. ;   Setting CLEVEL3 to TRUE enables extended processing of the third level of
  387. ; ZCPR command.  All the user program need do is to store the command line and
  388. ; set the character count; ZCPR will initialize the pointers properly, store
  389. ; the ending zero properly, and capitalize the command line for processing.
  390. ; Once the command line is properly stored, the user executes the command line
  391. ; by reentering the ZCPR through CPRLOC [NOTE:  The C register MUST contain
  392. ; a valid User/Disk Flag (see location 4) at this time.]
  393. ;
  394. CLEVEL3    EQU    TRUE        ;ENABLE COMMAND LEVEL 3 PROCESSING
  395. ;
  396. ;
  397. ;*** TERMINAL AND 'TYPE' CUSTOMIZATION EQUATES
  398. ;
  399. NLINES    EQU    24        ;NUMBER OF LINES ON CRT SCREEN
  400. WIDE    EQU    TRUE        ;TRUE IF WIDE DIR DISPLAY
  401. FENCE    EQU    '|'        ;SEP CHAR BETWEEN DIR FILES
  402. ;
  403. PGDFLT    EQU    TRUE          ;SET TO FALSE TO DISABLE PAGING BY DEFAULT
  404. PGDFLG    EQU    'P'        ;FOR TYPE COMMAND: PAGE OR NOT (DEP ON PGDFLT)
  405.                 ;  THIS FLAG REVERSES THE DEFAULT EFFECT
  406. ;
  407. SYSFLG    EQU    'A'         ;FOR DIR COMMAND: LIST $SYS AND $DIR
  408. ;
  409. SOFLG    EQU    'S'        ;FOR DIR COMMAND: LIST $SYS FILES ONLY
  410. ;
  411. SUPRES    EQU    TRUE         ;SUPRESSES USER # REPORT FOR USER 0
  412. ;
  413. SPRMPT    EQU    '$'        ;CPR PROMPT INDICATING SUBMIT COMMAND
  414. CPRMPT    EQU    '>'        ;CPR PROMPT INDICATING USER COMMAND
  415. ;
  416. NUMBASE    EQU    'H'        ;CHARACTER USED TO SWITCH FROM DEFAULT
  417.                 ; NUMBER BASE
  418. ;
  419. SECTFLG    EQU    'S'        ;OPTION CHAR FOR SAVE COMMAND TO SAVE SECTORS
  420. ;
  421. ; END OF CUSTOMIZATION SECTION
  422. ;
  423. CR    EQU    0DH
  424. LF    EQU    0AH
  425. TAB    EQU    09H
  426. FFEED    EQU    0CH
  427. BEL    EQU    07H
  428. ;
  429. WBOOT    EQU    BASE+0000H        ;CP/M WARM BOOT ADDRESS
  430. UDFLAG    EQU    BASE+0004H        ;USER NUM IN HIGH NYBBLE, DISK IN LOW
  431. BDOS    EQU    BASE+0005H        ;BDOS FUNCTION CALL ENTRY PT
  432. TFCB    EQU    BASE+005CH        ;DEFAULT FCB BUFFER
  433. TBUFF    EQU    BASE+0080H        ;DEFAULT DISK I/O BUFFER
  434. TPA    EQU    BASE+0100H        ;BASE OF TPA
  435. ;
  436. ;
  437. ; MACROS TO PROVIDE Z80 EXTENSIONS
  438. ;   MACROS INCLUDE:
  439. ;
  440. $-MACRO         ;FIRST TURN OFF THE EXPANSIONS
  441. ;
  442. ;    JR    - JUMP RELATIVE
  443. ;    JRC    - JUMP RELATIVE IF CARRY
  444. ;    JRNC    - JUMP RELATIVE IF NO CARRY
  445. ;    JRZ    - JUMP RELATIVE IF ZERO
  446. ;    JRNZ    - JUMP RELATIVE IF NO ZERO
  447. ;    DJNZ    - DECREMENT B AND JUMP RELATIVE IF NO ZERO
  448. ;    LDIR    - MOV @HL TO @DE FOR COUNT IN BC
  449. ;    LXXD    - LOAD DOUBLE REG DIRECT
  450. ;    SXXD    - STORE DOUBLE REG DIRECT
  451. ;
  452. ;
  453. ;
  454. ;    @GENDD MACRO USED FOR CHECKING AND GENERATING
  455. ;    8-BIT JUMP RELATIVE DISPLACEMENTS
  456. ;
  457. @GENDD    MACRO    ?DD    ;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS
  458.     IF (?DD GT 7FH) AND (?DD LT 0FF80H)
  459.     DB    100H    ;Displacement Range Error on Jump Relative
  460.     ELSE
  461.     DB    ?DD
  462.     ENDIF
  463.     ENDM
  464. ;
  465. ;
  466. ; Z80 MACRO EXTENSIONS
  467. ;
  468. JR    MACRO    ?N    ;;JUMP RELATIVE
  469.     DB    18H
  470.     @GENDD    ?N-$-1
  471.     ENDM
  472. ;
  473. JRC    MACRO    ?N    ;;JUMP RELATIVE ON CARRY
  474.     DB    38H
  475.     @GENDD    ?N-$-1
  476.     ENDM
  477. ;
  478. JRNC    MACRO    ?N    ;;JUMP RELATIVE ON NO CARRY
  479.     DB    30H
  480.     @GENDD    ?N-$-1
  481.     ENDM
  482. ;
  483. JRZ    MACRO    ?N    ;;JUMP RELATIVE ON ZERO
  484.     DB    28H
  485.     @GENDD    ?N-$-1
  486.     ENDM
  487. ;
  488. JRNZ    MACRO    ?N    ;;JUMP RELATIVE ON NO ZERO
  489.     DB    20H
  490.     @GENDD    ?N-$-1
  491.     ENDM
  492. ;
  493. DJNZ    MACRO    ?N    ;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
  494.     DB    10H
  495.     @GENDD    ?N-$-1
  496.     ENDM
  497. ;
  498. LDIR    MACRO        ;;LDIR
  499.     DB    0EDH,0B0H
  500.     ENDM
  501. ;
  502. LDED    MACRO    ?N    ;;LOAD DE DIRECT
  503.     DB    0EDH,05BH
  504.     DW    ?N
  505.     ENDM
  506. ;
  507. LBCD    MACRO    ?N    ;;LOAD BC DIRECT
  508.     DB    0EDH,4BH
  509.     DW    ?N
  510.     ENDM
  511. ;
  512. SDED    MACRO    ?N    ;;STORE DE DIRECT
  513.     DB    0EDH,53H
  514.     DW    ?N
  515.     ENDM
  516. ;
  517. SBCD    MACRO    ?N    ;;STORE BC DIRECT
  518.     DB    0EDH,43H
  519.     DW    ?N
  520.     ENDM
  521. ;
  522. ; END OF Z80 MACRO EXTENSIONS
  523. ;
  524. ;
  525. ;**** Section 0 ****
  526. ;
  527.     ORG    CPRLOC
  528. ;
  529. ;  ENTRY POINTS INTO ZCPR
  530. ;
  531. ;    If the ZCPR is entered at location CPRLOC (at the JMP to CPR), then
  532. ; the default command in CIBUFF will be processed.  If the ZCPR is entered
  533. ; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
  534. ; CIBUFF will NOT be processed.
  535. ;
  536. ;    NOTE:  Entry into ZCPR in this way is permitted under this version,
  537. ; but in order for this to work, CIBUFF and CBUFF MUST be initialized properly
  538. ; AND the C register MUST contain a valid User/Disk Flag (see Location 4: the
  539. ; most significant nybble contains the User Number and the least significant
  540. ; nybble contains the Disk Number).
  541. ;
  542. ;    Some user programs (such as SYNONYM3) attempt to use the default
  543. ; command facility.  Under the original CCP, it was necessary to initialize
  544. ; the pointer after the reserved space for the command buffer to point to
  545. ; the first byte of the command buffer.  Under current versions, this is
  546. ; no longer the case.  The CIBPTR (Command Input Buffer PoinTeR) is located
  547. ; to be compatible with such programs (provided they determine the buffer
  548. ; length from the byte at MBUFF [CPRLOC + 6]), but under ZCPR this is
  549. ; no longer necessary, since this buffer pointer is automatically
  550. ; initialized in all cases.
  551. ;
  552. ENTRY:
  553.     JMP    CPR    ; Process potential default command, and set
  554.             ; USRMAX to MAXUSR default
  555.     JMP    CPR1    ; Do NOT process potential default command
  556. ;    
  557. ;**** Section 1 ****
  558. ; BUFFERS ET AL
  559. ;
  560. ; INPUT COMMAND LINE AND DEFAULT COMMAND
  561. ;
  562. ;   The command line to be executed is stored here.  This command line
  563. ; is generated in one of three ways:
  564. ;
  565. ;    (1) by the user entering it through the BDOS READLN function at
  566. ;        the du> prompt [user input from keyboard]
  567. ;    (2) by the SUBMIT File Facility placing it there from a $$$.SUB
  568. ;        file
  569. ;    (3) by an external program or user placing the required command
  570. ;        into this buffer
  571. ;
  572. ;   In all cases, the command line is placed into the buffer starting at
  573. ; CIBUFF.  This command line is terminated by the last character (NOT Carriage
  574. ; Return), and a character count of all characters in the command line
  575. ; up to and including the last character is placed into location CBUFF
  576. ; (immediately before the command line at CIBUFF).  The placed command line
  577. ; is then parsed, interpreted, and the indicated command is executed.
  578. ; If CLEVEL3 is permitted, a terminating zero is placed after the command
  579. ; (otherwise the user program has to place this zero) and the CIBPTR is
  580. ; properly initialized (otherwise the user program has to init this ptr).
  581. ; If the command is placed by a user program, entering at CPRLOC is enough
  582. ; to have the command processed.  Again, under the current ZCPR, it is not
  583. ; necessary to store the pointer to CIBUFF in CIBPTR; ZCPR will do this for
  584. ; the calling program if CLEVEL3 is made TRUE.
  585. ;
  586. ;   WARNING:  The command line must NOT exceed BUFLEN characters in length.
  587. ; For user programs which load this command, the value of BUFLEN can be
  588. ; obtained by examining the byte at MBUFF (CPRLOC + 6).
  589. ;
  590. BUFLEN    EQU    80        ;MAXIMUM BUFFER LENGTH
  591. MBUFF:
  592.     DB    BUFLEN        ;MAXIMUM BUFFER LENGTH
  593. CBUFF:
  594.     DB    0        ;NUMBER OF VALID CHARS IN COMMAND LINE
  595. CIBUFF:
  596.     DB    '              '    ;DEFAULT (COLD BOOT) COMMAND
  597. ;
  598. ;  The copyright notice from Digital Research is genned into the
  599. ; stock CCP at this location. It should be maintained in ZCPR,
  600. ; since Digital Research grants permission for ZCPR to exist.
  601. ;
  602.     DB    '  COPYRIGHT (C) 1979, DIGITAL RESEARCH  '
  603. CIBUF:
  604.     DB    0            ;COMMAND STRING TERMINATOR
  605.     DB    'NZCPR V 1.6 of 08/03/82 ' ;ZCPR ID FOR DISK DUMP
  606.     DS    BUFLEN-($-CIBUFF)+1    ;TOTAL IS 'BUFLEN' BYTES
  607. ;
  608. CIBPTR:
  609.     DW    CIBUFF        ;POINTER TO COMMAND INPUT BUFFER
  610. CIPTR:
  611.     DW    CIBUF        ;POINTER TO CURR COMMAND FOR
  612.                 ; ERROR REPORTING
  613. ;
  614.     DS    26        ;STACK AREA
  615. STACK    EQU    $        ;TOP OF STACK
  616. ;
  617. ; FILE TYPE FOR COMMAND
  618. ;
  619. COMMSG:
  620.     DB    'COM'
  621. ;
  622. ; SUBMIT FILE CONTROL BLOCK
  623. ;
  624. SUBFCB:
  625.     IF    SUBA        ;IF $$$.SUB ON A:
  626.     DB    1        ;DISK NAME SET TO DEFAULT TO DRIVE A:
  627.     ENDIF
  628. ;
  629.     IF    NOT SUBA    ;IF $$$.SUB ON CURRENT DRIVE
  630.     DB    0        ;DISK NAME SET TO DEFAULT TO CURRENT DRIVE
  631.     ENDIF
  632. ;
  633.     DB    '$$$'        ;FILE NAME
  634.     DB    '     '
  635.     DB    'SUB'        ;FILE TYPE
  636.     DB    0        ;EXTENT NUMBER
  637.     DB    0        ;S1
  638. SUBFS2:
  639.     DS    1        ;S2
  640. SUBFRC:
  641.     DS    1        ;RECORD COUNT
  642.     DS    16        ;DISK GROUP MAP
  643. SUBFCR:
  644.     DS    1        ;CURRENT RECORD NUMBER
  645. ; COMMAND FILE CONTROL BLOCK
  646. ;
  647. FCBDN:
  648.     DS    1        ;DISK NAME
  649. FCBFN:
  650.     DS    8        ;FILE NAME
  651. FCBFT:
  652.     DS    3        ;FILE TYPE
  653.     DS    1        ;EXTENT NUMBER
  654.     DS    2        ;S1 AND S2
  655.     DS    1        ;RECORD COUNT
  656. FCBDM:
  657.     DS    16        ;DISK GROUP MAP
  658. FCBCR:
  659.     DS    1        ;CURRENT RECORD NUMBER
  660. ;
  661. ; OTHER BUFFERS
  662. ;
  663. PAGCNT:
  664.     DB    NLINES-2    ;LINES LEFT ON PAGE
  665. CHRCNT:
  666.     DB    0        ;CHAR COUNT FOR TYPE
  667. QMCNT:
  668.     DB    0        ;QUESTION MARK COUNT FOR FCB TOKEN SCANNER
  669. ;
  670. ;
  671. ;**** Section 2 ****
  672. ; CPR STARTING POINTS.  NOTE THAT SOME CP/M IMPLEMENTATIONS
  673. ; REQUIRE THE COLD START ADDRESS TO BE IN THE STARTING PAGE
  674. ; OF THE CPR, FOR DYNAMIC CCP LOADING.  CMDTBL WAS MOVED FOR
  675. ; THIS REASON.
  676. ;
  677. ; SET USRMAX AND/OR MAXDRIV TO DEFAULT VALUES ON COLD BOOT
  678. ; IF REQUIRED. NOTE THAT SOME BIOS IMPLEMENTATIONS WILL END
  679. ; UP HERE INSTEAD OF AT THE WARM BOOT, DEFEATING PASSWORDING
  680. ; OF THESE OPTIONS. RECOMMEND SUCH A BIOS BE FIXED.
  681. ;
  682.     IF    USRMAX OR MAXDRIV
  683. CPR:
  684.     IF    USRMAX
  685.     MVI    A,MAXUSR+1    ;SET USRMAX ON COLD BOOT
  686.     STA    USRMAX
  687.     ENDIF    ;USRMAX
  688. ;
  689.     IF    MAXDRIV
  690.     MVI    A,MAXDR        ;SET MAXDRIV ON COLD BOOT
  691.     STA    MAXDRIV
  692.     ENDIF    ;MAXDRIV
  693. ;
  694.     JR    CPR2        ; THEN PROCEED
  695.     ENDIF    ;USRMAX OR MAXDRIV
  696. ;
  697. ; START CPR AND DON'T PROCESS DEFAULT COMMAND STORED
  698. ;
  699. CPR1:
  700.     XRA    A        ;SET NO DEFAULT COMMAND
  701.     STA    CBUFF
  702. ;
  703. ; START CPR AND POSSIBLY PROCESS DEFAULT COMMAND
  704. ;
  705. ; NOTE ON MODIFICATION BY RGF: BDOS RETURNS 0FFH IN
  706. ; ACCUMULATOR WHENEVER IT LOGS IN A DIRECTORY, IF ANY
  707. ; FILE NAME CONTAINS A '$' IN IT.  THIS IS NOW USED AS
  708. ; A CLUE TO DETERMINE WHETHER OR NOT TO DO A SEARCH
  709. ; FOR SUBMIT FILE, IN ORDER TO ELIMINATE WASTEFUL SEARCHES.
  710. ;
  711.     IF    USRMAX OR MAXDRIV
  712. CPR2:
  713.     ELSE
  714. CPR:
  715.     ENDIF    ;USRMAX OR MAXDRIV
  716. ;
  717.     LXI    SP,STACK    ;RESET STACK
  718.     PUSH    B
  719.     MOV    A,C        ;C=USER/DISK NUMBER (SEE LOC 4)
  720.     RAR            ;EXTRACT USER NUMBER
  721.     RAR
  722.     RAR
  723.     RAR
  724.     ANI    0FH
  725.     MOV    E,A        ;SET USER NUMBER
  726.     CALL    SETUSR
  727.     CALL    RESET        ;RESET DISK SYSTEM
  728.     STA    RNGSUB        ;SAVE SUBMIT CLUE FROM DRIVE A:
  729.     POP    B
  730.     MOV    A,C        ;C=USER/DISK NUMBER (SEE LOC 4)
  731.     ANI    0FH        ;EXTRACT DEFAULT DISK DRIVE
  732.     STA    TDRIVE        ;SET IT
  733.     JRZ    NOLOG        ;SKIP IF 0...ALREADY LOGGED
  734.     CALL    LOGIN        ;LOG IN DEFAULT DISK
  735. ;
  736.     IF    NOT SUBA    ;IF $$$.SUB IS ON CURRENT DRIVE
  737.     STA    RNGSUB        ;BDOS '$' CLUE
  738.     ENDIF
  739. ;
  740. NOLOG:
  741.     LXI    D,SUBFCB    ;CHECK FOR $$$.SUB ON CURRENT DISK
  742. RNGSUB    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  743.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS THE RNGSUB FLAG
  744.     ORA    A        ;SET FLAGS ON CLUE
  745.     CMA            ;PREPARE FOR COMING 'CMA'
  746.     CNZ    SEAR1
  747.     CMA            ;0FFH IS RETURNED IF NO $$$.SUB, SO COMPLEMENT
  748.     STA    RNGSUB        ;SET FLAG (0=NO $$$.SUB)
  749.     LDA    CBUFF        ;EXECUTE DEFAULT COMMAND?
  750.     ORA    A        ;0=NO
  751.     JRNZ    RS1
  752. ;
  753. ; PROMPT USER AND INPUT COMMAND LINE FROM HIM
  754. ;
  755. RESTRT:
  756.     LXI    SP,STACK    ;RESET STACK
  757. ;
  758. ; PRINT PROMPT (DU>)
  759. ;
  760.     CALL    CRLF        ;PRINT PROMPT
  761.     CALL    GETDRV        ;CURRENT DRIVE IS PART OF PROMPT
  762.     ADI    'A'        ;CONVERT TO ASCII A-P
  763.     CALL    CONOUT
  764.     CALL    GETUSR        ;GET USER NUMBER
  765. ;
  766.     IF    SUPRES        ;IF SUPPRESSING USR # REPORT FOR USR 0
  767.     ORA    A
  768.     JRZ    RS000
  769.     ENDIF
  770. ;
  771.     CPI    10        ;USER < 10?
  772.     JRC    RS00
  773.     SUI    10        ;SUBTRACT 10 FROM IT
  774.     PUSH    PSW        ;SAVE IT
  775.     MVI    A,'1'        ;OUTPUT 10'S DIGIT
  776.     CALL    CONOUT
  777.     POP    PSW
  778. RS00:
  779.     ADI    '0'        ;OUTPUT 1'S DIGIT (CONVERT TO ASCII)
  780.     CALL    CONOUT
  781. ;
  782. ; READ INPUT LINE FROM USER OR $$$.SUB
  783. ;
  784. RS000:
  785.     CALL    REDBUF        ;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
  786. ;
  787. ; PROCESS INPUT LINE
  788. ;
  789. RS1:
  790. ;
  791.     IF    CLEVEL3        ;IF THIRD COMMAND LEVEL IS PERMITTED
  792.     CALL    CNVBUF        ;CAPITALIZE COMMAND LINE, PLACE ENDING 0,
  793.                 ; AND SET CIBPTR VALUE
  794.     ENDIF
  795. ;
  796.     CALL    DEFDMA        ;SET TBUFF TO DMA ADDRESS
  797.     CALL    GETDRV        ;GET DEFAULT DRIVE NUMBER
  798.     STA    TDRIVE        ;SET IT
  799.     CALL    SCANER        ;PARSE COMMAND NAME FROM COMMAND LINE
  800.     CNZ    ERROR        ;ERROR IF COMMAND NAME CONTAINS A '?'
  801.     LXI    D,RSTCPR    ;PUT RETURN ADDRESS OF COMMAND
  802.     PUSH    D        ;ON THE STACK
  803.     LDA    TEMPDR        ;IS COMMAND OF FORM 'D:COMMAND'?
  804.     ORA    A        ;NZ=YES
  805.     JNZ    COM        ; IMMEDIATELY
  806.     CALL    CMDSER        ;SCAN FOR CPR-RESIDENT COMMAND
  807.     JNZ    COM        ;NOT CPR-RESIDENT
  808.     MOV    A,M        ;FOUND IT:  GET LOW-ORDER PART
  809.     INX    H        ;GET HIGH-ORDER PART
  810.     MOV    H,M        ;STORE HIGH
  811.     MOV    L,A        ;STORE LOW
  812.     PCHL            ;EXECUTE CPR ROUTINE
  813. ;
  814. ; ENTRY POINT FOR RESTARTING CPR AND LOGGING IN DEFAULT DRIVE
  815. ;
  816. RSTCPR:
  817.     CALL    DLOGIN        ;LOG IN DEFAULT DRIVE
  818. ;
  819. ; ENTRY POINT FOR RESTARTING CPR WITHOUT LOGGING IN DEFAULT DRIVE
  820. ;
  821. RCPRNL:
  822.     CALL    SCANER        ;EXTRACT NEXT TOKEN FROM COMMAND LINE
  823.     LDA    FCBFN        ;GET FIRST CHAR OF TOKEN
  824.     SUI    ' '        ;ANY CHAR?
  825.     LXI    H,TEMPDR
  826.     ORA    M
  827.     JNZ    ERROR
  828.     JR    RESTRT
  829. ;
  830. ; No File Error Message
  831. ;
  832. PRNNF:
  833.     CALL    PRINTC        ;NO FILE MESSAGE
  834.     DB    'No Fil','e'+80H
  835.     RET
  836. ;
  837. ; CPR BUILT-IN COMMAND TABLE
  838. ;
  839. NCHARS    EQU    4        ;NUMBER OF CHARS/COMMAND
  840. ;
  841. ; CPR COMMAND NAME TABLE
  842. ;   EACH TABLE ENTRY IS COMPOSED OF THE 4-BYTE COMMAND AND 2-BYTE ADDRESS
  843. ;
  844. CMDTBL:
  845. ;
  846.     IF    INPASS AND SECURE
  847.     DB    'PASS'            ;ENABLE WHEEL (SYSOP) MODE
  848.     DW    PASS
  849.     ENDIF    ;INPASS AND SECURE
  850. ;
  851.     IF    DRUSER
  852.     DB    'USER'            ;CHANGE USER AREAS
  853.     DW    USER
  854.     ENDIF    ;DRUSER
  855. ;
  856.     IF    CPRTYP
  857.     DB    'TYPE'            ;TYPE A FILE TO CON:
  858.     DW    TYPE
  859.     ENDIF    ;CPRTYP
  860. ;
  861.     IF    CPRDIR
  862.     DB    'DIR '            ;PULL A DIRECTORY OF DISK FILES
  863.     DW    DIR
  864.     ENDIF    ;CPRDIR
  865.  
  866. NRCMDS    EQU    ($-CMDTBL)/(NCHARS+2)    ;PUT ANY COMMANDS THAT ARE OK TO
  867.                     ;RUN WHEN NOT UNDER WHEEL MODE
  868.                     ;IN FRONT OF THIS LABEL
  869.     IF    CPRLST AND CPRTYP
  870.     DB    'LIST'            ;LIST FILE TO PRINTER
  871.     DW    LIST
  872.     ENDIF    ;CPRLST AND CPRTYP
  873. ;
  874.     IF    INPASS AND SECURE
  875.     DB    'NORM'            ;DISABLE WHEEL MODE
  876.     DW    NORM
  877.     ENDIF    ;INPASS AND SECURE
  878. ;
  879.     IF    NOT RAS        ;FOR NON-RAS
  880.     DB    'GO  '            ;JUMP TO 100H
  881.     DW    GO
  882.     DB    'ERA '            ;ERASE FILE
  883.     DW    ERA
  884.     DB    'SAVE'            ;SAVE MEMORY IMAGE TO DISK
  885.     DW    SAVE
  886.     DB    'REN '            ;RENAME FILE
  887.     DW    REN
  888.     DB    'DFU '            ;SET DEFAULT USER
  889.     DW    DFU
  890.     DB    'GET '            ;LOAD FILE INTO MEMORY
  891.     DW    GET
  892.     DB    'JUMP'            ;JUMP TO LOCATION IN MEMORY
  893.     DW    JUMP
  894.     ENDIF    ;RAS
  895. ;
  896. NCMNDS    EQU    ($-CMDTBL)/(NCHARS+2)
  897. ;
  898. ;**** Section 3 ****
  899. ; I/O UTILITIES
  900. ;
  901. ; OUTPUT CHAR IN REG A TO CONSOLE AND DON'T CHANGE BC
  902. ;
  903. ;
  904. ; OUTPUT <CRLF>
  905. ;
  906. CRLF:
  907.     MVI    A,CR
  908.     CALL    CONOUT
  909.     MVI    A,LF    ;FALL THRU TO CONOUT
  910. ;
  911. CONOUT:
  912.     PUSH    B
  913.     MVI    C,02H
  914. OUTPUT:
  915.     ANI    7FH    ;PREVENT INADVERTANT GRAPHIC OUTPUT
  916.             ; TO EPSON-TYPE PRINTERS
  917.     MOV    E,A
  918.     PUSH    H
  919.     CALL    BDOS
  920.     POP    H
  921.     POP    B
  922.     RET
  923. ;
  924. CONIN:
  925.     MVI    C,01H    ;GET CHAR FROM CON: WITH ECHO
  926.     CALL    BDOSB
  927. ;
  928. ; CONVERT CHAR IN A TO UPPER CASE
  929. ;
  930. UCASE:
  931.     CPI    61H        ;LOWER-CASE A
  932.     RC
  933.     CPI    7BH        ;GREATER THAN LOWER-CASE Z?
  934.     RNC
  935.     ANI    5FH        ;CAPITALIZE
  936.     RET
  937. ;
  938. NOECHO:
  939.     PUSH    D    ;SAVE D
  940.     MVI    C,6    ;DIRECT CONSOLE I/O
  941.     MVI    E,0FFH    ;INPUT
  942.     CALL    BDOSB
  943.     POP    D
  944.     ORA    A    ;DID WE GET A CHAR?
  945.     JRZ    NOECHO    ;WAIT FOR IT IF NOT, IT'S EXPECTED
  946.     RET
  947. ;
  948.     IF    CPRTYP
  949. LCOUT:
  950.     ENDIF    ;CPRTYP
  951. ;
  952.     IF    CPRTYP AND CPRLST
  953.     PUSH    PSW    ;OUTPUT CHAR TO CON: OR LST: DEP ON PRFLG
  954. PRFLG    EQU    $+1    ;POINTER FOR IN-THE-CODE MODIFICATION
  955.     MVI    A,0    ;2ND BYTE (IMMEDIATE ARG) IS THE PRINT FLAG
  956.     ORA    A    ;0=TYPE
  957.     JRZ    LC1
  958.     POP    PSW    ;GET CHAR
  959. ;
  960. ; OUTPUT CHAR IN REG A TO LIST DEVICE
  961. ;
  962. LSTOUT:
  963.     PUSH    B
  964.     MVI    C,05H
  965.     JR    OUTPUT
  966. LC1:
  967.     POP    PSW    ;GET CHAR
  968.     ENDIF    ;CPRTYP AND CPRLST
  969. ;
  970.     IF    CPRTYP
  971.     PUSH    PSW
  972.     CALL    CONOUT    ;OUTPUT TO CON:
  973.     POP    PSW
  974.     CPI    LF    ;CHECK FOR PAGING
  975.     RNZ            ;DONE IF NOT EOL YET
  976. ;
  977. ;  COUNT DOWN LINES AND PAUSE FOR INPUT (DIRECT) IF COUNT EXPIRES
  978. ;
  979.     PUSH    H
  980.     LXI    H,PAGCNT    ;COUNT DOWN
  981.     DCR    M
  982.     JRNZ    PGBAK        ;JUMP IF NOT END OF PAGE
  983.     MVI    M,NLINES-2    ;REFILL COUNTER
  984. ;
  985. PGFLG    EQU    $+1        ;POINTER TO IN-THE-CODE BUFFER PGFLG
  986.     MVI    A,0        ;0 MAY BE CHANGED BY PGFLG EQUATE
  987.     CPI    PGDFLG        ;PAGE DEFAULT OVERRIDE OPTION WANTED?
  988. ;
  989.     IF    PGDFLT        ;IF PAGING IS DEFAULT
  990.     JRZ    PGBAK        ;  PGDFLG MEANS NO PAGING, PLEASE
  991.     ELSE            ;IF PAGING NOT DEFAULT
  992.     JRNZ    PGBAK        ;  PGDFLG MEANS PLEASE PAGINATE
  993.     ENDIF
  994. ;
  995.     CALL    NOECHO        ;GET CHAR BUT DON'T ECHO TO SCREEN
  996.     CPI    'C'-'@'     ;^C
  997.     JZ    RSTCPR        ;RESTART CPR
  998. PGBAK:
  999.     POP    H        ;RESTORE HL
  1000.     RET
  1001.     ENDIF    ;CPRTYP
  1002. ;
  1003. READF:
  1004.     LXI    D,FCBDN ;FALL THRU TO READ
  1005. READ:
  1006.     MVI    C,14H    ;FALL THRU TO BDOSB
  1007. ;
  1008. ; CALL BDOS AND SAVE BC
  1009. ;
  1010. BDOSB:
  1011.     PUSH    B
  1012.     CALL    BDOS
  1013.     POP    B
  1014.     ORA    A
  1015.     RET
  1016. ;
  1017. ; PRINT STRING ENDING WITH ZERO BYTE OR CHAR WITH HIGH BIT SET
  1018. ; PT'ED TO BY RET ADDR, START WITH <CR><LF>
  1019. ;
  1020. PRINTC:
  1021.     PUSH    PSW        ;SAVE FLAGS
  1022.     CALL    CRLF        ;NEW LINE
  1023.     POP    PSW
  1024. ;
  1025. PRINT:
  1026.     XTHL            ;GET PTR TO STRING
  1027.     PUSH    PSW        ;SAVE FLAGS
  1028.     CALL    PRIN1        ;PRINT STRING
  1029.     POP    PSW        ;GET FLAGS
  1030.     XTHL            ;RESTORE HL AND RET ADR
  1031.     RET
  1032. ;
  1033. ; PRINT STRING ENDING WITH ZERO BYTE OR CHAR WITH HIGH BIT SET
  1034. ; PT'ED TO BY HL
  1035. ;
  1036. PRIN1:
  1037.     MOV    A,M        ;GET NEXT BYTE
  1038.     CALL    CONOUT        ;PRINT CHAR
  1039.     MOV    A,M        ;GET NEXT BYTE AGAIN FOR TEST
  1040.     INX    H        ;PT TO NEXT BYTE
  1041.     ORA    A        ;SET FLAGS
  1042.     RZ            ;DONE IF ZERO
  1043.     RM            ;DONE IF MSB SET
  1044.     JR    PRIN1
  1045. ;
  1046. ; BDOS FUNCTION ROUTINES
  1047. ;
  1048. ;
  1049. ; RETURN NUMBER OF CURRENT DISK IN A
  1050. ;
  1051. GETDRV:
  1052.     MVI    C,19H
  1053.     JR    BDOSJP
  1054. ;
  1055. ; SET 80H AS DMA ADDRESS
  1056. ;
  1057. DEFDMA:
  1058.     LXI    D,TBUFF     ;80H=TBUFF
  1059. DMASET:
  1060.     MVI    C,1AH
  1061.     JR    BDOSJP
  1062. ;
  1063. RESET:
  1064.     MVI    C,0DH
  1065. BDOSJP:
  1066.     JMP    BDOS
  1067. ;
  1068. LOGIN:
  1069.     MOV    E,A        ;MOVE DESIRED # TO BDOS REG
  1070. ;
  1071.     IF    MAXDRIV
  1072.     LDA    MAXDRIV        ;CHECK FOR LEGAL DRIVE #
  1073.     CMP    E
  1074.     JC    ERROR        ;DON'T DO IT IF TOO HIGH
  1075.     ENDIF    ;MAXDRIV
  1076. ;
  1077.     MVI    C,0EH
  1078.     JR    BDOSJP    ;SAVE SOME CODE SPACE
  1079. ;
  1080. OPENF:
  1081.     XRA    A
  1082.     STA    FCBCR
  1083.     LXI    D,FCBDN ;FALL THRU TO OPEN
  1084. ;
  1085. OPEN:
  1086.     MVI    C,0FH    ;FALL THRU TO GRBDOS
  1087. ;
  1088. GRBDOS:
  1089.     CALL    BDOS
  1090.     INR    A    ;SET ZERO FLAG FOR ERROR RETURN
  1091.     RET
  1092. ;
  1093. CLOSE:
  1094.     MVI    C,10H
  1095.     JR    GRBDOS
  1096. ;
  1097. SEARF:
  1098.     LXI    D,FCBDN ;SPECIFY FCB
  1099. SEAR1:
  1100.     MVI    C,11H
  1101.     JR    GRBDOS
  1102. ;
  1103. SEARN:
  1104.     MVI    C,12H
  1105.     JR    GRBDOS
  1106. ;
  1107. ; CHECK FOR SUBMIT FILE IN EXECUTION AND ABORT IT IF SO
  1108. ;
  1109. SUBKIL:
  1110.     LXI    H,RNGSUB    ;CHECK FOR SUBMIT FILE IN EXECUTION
  1111.     MOV    A,M
  1112.     ORA    A        ;0=NO
  1113.     RZ
  1114.     MVI    M,0        ;ABORT SUBMIT FILE
  1115.     LXI    D,SUBFCB    ;DELETE $$$.SUB
  1116. ;
  1117. DELETE:
  1118.     MVI    C,13H
  1119.     JR    BDOSJP    ;SAVE MORE SPACE
  1120. ;
  1121. ; RESET USER NUMBER IF CHANGED
  1122. ;
  1123. RESETUSR:
  1124. TMPUSR    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  1125.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS TMPUSR
  1126.     MOV    E,A        ;PLACE IN E
  1127.     JR    SETUSR        ;THEN GO SET USER
  1128. GETUSR:
  1129.     MVI    E,0FFH        ;GET CURRENT USER NUMBER
  1130. SETUSR:
  1131.     MVI    C,20H        ;SET USER NUMBER TO VALUE IN E (GET IF E=FFH)
  1132.     JR    BDOSJP        ;MORE SPACE SAVING
  1133. ;
  1134. ; END OF BDOS FUNCTIONS
  1135. ;
  1136. ;
  1137. ;**** Section 4 ****
  1138. ; CPR UTILITIES
  1139. ;
  1140. ; SET USER/DISK FLAG TO CURRENT USER AND DEFAULT DISK
  1141. ;
  1142. SETUD:
  1143.     CALL    GETUSR        ;GET NUMBER OF CURRENT USER
  1144.     ADD    A        ;PLACE IT IN HIGH NYBBLE
  1145.     ADD    A
  1146.     ADD    A
  1147.     ADD    A
  1148.     LXI    H,TDRIVE    ;MASK IN DEFAULT DRIVE NUMBER (LOW NYBBLE)
  1149.     ORA    M        ;MASK IN
  1150.     STA    UDFLAG        ;SET USER/DISK NUMBER
  1151.     RET
  1152. ;
  1153. ; SET USER/DISK FLAG TO USER 0 AND DEFAULT DISK
  1154. ;
  1155. SETU0D:
  1156. TDRIVE    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  1157.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS TDRIVE
  1158.     STA    UDFLAG        ;SET USER/DISK NUMBER
  1159.     RET
  1160. ;
  1161. ; INPUT NEXT COMMAND TO CPR
  1162. ;    This routine determines if a SUBMIT file is being processed
  1163. ; and extracts the command line from it if so or from the user's console
  1164. ;
  1165. REDBUF:
  1166.     LDA    RNGSUB        ;SUBMIT FILE CURRENTLY IN EXECUTION?
  1167.     ORA    A        ;0=NO
  1168.     JRZ    RB1        ;GET LINE FROM CONSOLE IF NOT
  1169.     LXI    D,SUBFCB    ;OPEN $$$.SUB
  1170.     PUSH    D        ;SAVE DE
  1171.     CALL    OPEN
  1172.     POP    D        ;RESTORE DE
  1173.     JRZ    RB1        ;ERASE $$$.SUB IF END OF FILE AND GET CMND
  1174.     LDA    SUBFRC        ;GET VALUE OF LAST RECORD IN FILE
  1175.     DCR    A        ;PT TO NEXT TO LAST RECORD
  1176.     STA    SUBFCR        ;SAVE NEW VALUE OF LAST RECORD IN $$$.SUB
  1177.     CALL    READ        ;DE=SUBFCB
  1178.     JRNZ    RB1        ;ABORT $$$.SUB IF ERROR IN READING LAST REC
  1179.     LXI    D,CBUFF     ;COPY LAST RECORD (NEXT SUBMIT CMND) TO CBUFF
  1180.     LXI    H,TBUFF     ;  FROM TBUFF
  1181.     LXI    B,BUFLEN    ;NUMBER OF BYTES
  1182.     LDIR
  1183.     LXI    H,SUBFS2    ;PT TO S2 OF $$$.SUB FCB
  1184.     MVI    M,0        ;SET S2 TO ZERO
  1185.     INX    H        ;PT TO RECORD COUNT
  1186.     DCR    M        ;DECREMENT RECORD COUNT OF $$$.SUB
  1187.     LXI    D,SUBFCB    ;CLOSE $$$.SUB
  1188.     CALL    CLOSE
  1189.     JRZ    RB1        ;ABORT $$$.SUB IF ERROR
  1190.     MVI    A,SPRMPT    ;PRINT SUBMIT PROMPT
  1191.     CALL    CONOUT
  1192.     LXI    H,CIBUFF    ;PRINT COMMAND LINE FROM $$$.SUB
  1193.     CALL    PRIN1
  1194.     CALL    BREAK        ;CHECK FOR ABORT (ANY CHAR)
  1195. ;
  1196.     IF    CLEVEL3        ;IF THIRD COMMAND LEVEL IS PERMITTED
  1197.     RZ            ;IF <NULL> (NO ABORT), RETURN TO CALLER AND RUN
  1198.     ENDIF
  1199. ;
  1200.     IF    NOT CLEVEL3    ;IF THIRD COMMAND LEVEL IS NOT PERMITTED
  1201.     JRZ    CNVBUF        ;IF <NULL> (NO ABORT), CAPITALIZE COMMAND
  1202.     ENDIF
  1203. ;
  1204.     CALL    SUBKIL        ;KILL $$$.SUB IF ABORT
  1205.     JMP    RESTRT        ;RESTART CPR
  1206. ;
  1207. ; INPUT COMMAND LINE FROM USER CONSOLE
  1208. ;
  1209. RB1:
  1210.     CALL    SUBKIL        ;ERASE $$$.SUB IF PRESENT
  1211.     CALL    SETUD        ;SET USER AND DISK
  1212.     MVI    A,CPRMPT    ;PRINT PROMPT
  1213.     CALL    CONOUT
  1214.     MVI    C,0AH        ;READ COMMAND LINE FROM USER
  1215.     LXI    D,MBUFF
  1216.     CALL    BDOS
  1217. ;
  1218.     IF    CLEVEL3        ;IF THIRD COMMAND LEVEL IS PERMITTED
  1219.     JMP    SETU0D        ;SET CURRENT DISK NUMBER IN LOWER PARAMS
  1220.     ENDIF
  1221. ;
  1222.     IF    NOT CLEVEL3    ;IF THIRD COMMAND LEVEL IS NOT PERMITTED
  1223.     CALL    SETU0D        ;SET CURRENT DISK NUMBER IF LOWER PARAMS
  1224.                 ; AND FALL THRU TO CNVBUF
  1225.     ENDIF
  1226. ;
  1227. ; CAPITALIZE STRING (ENDING IN 0) IN CBUFF AND SET PTR FOR PARSING
  1228. ;
  1229. CNVBUF:
  1230.     LXI    H,CBUFF     ;PT TO USER'S COMMAND
  1231.     MOV    B,M        ;CHAR COUNT IN B
  1232.     INR    B        ;ADD 1 IN CASE OF ZERO
  1233. CB1:
  1234.     INX    H        ;PT TO 1ST VALID CHAR
  1235.     MOV    A,M        ;CAPITALIZE COMMAND CHAR
  1236.     CALL    UCASE
  1237.     MOV    M,A
  1238.     DJNZ    CB1        ;CONTINUE TO END OF COMMAND LINE
  1239. CB2:
  1240.     MVI    M,0        ;STORE ENDING <NULL>
  1241.     LXI    H,CIBUFF    ;SET COMMAND LINE PTR TO 1ST CHAR
  1242.     SHLD    CIBPTR
  1243.     RET
  1244. ;
  1245. ; CHECK FOR ANY CHAR FROM USER CONSOLE;RET W/ZERO SET IF NONE
  1246. ;
  1247. BREAK:
  1248.     PUSH    D        ;SAVE DE
  1249.     MVI    C,11        ;CSTS CHECK
  1250.     CALL    BDOSB
  1251.     CNZ    CONIN        ;GET INPUT CHAR
  1252. BRKBK:
  1253.     POP    D
  1254.     RET
  1255. ;
  1256. ; GET THE REQUESTED USER NUMBER FROM THE COMMAND LINE AND VALIDATE IT.
  1257. ;
  1258. USRNUM:        
  1259.     CALL    NUMBER
  1260. ;
  1261.     IF    USRMAX
  1262.     LXI    H,USRMAX ;PT TO MAXUSR + 1
  1263.     CMP    M    ;NEW VALUE ALLOWED?
  1264.     ELSE
  1265.     CPI    MAXUSR+1 ;NEW VALUE ALLOWED?
  1266.     ENDIF    ;USRMAX
  1267. ;
  1268.     RC        ;RETURN TO CALLER IF SO,
  1269.             ; ELSE FLAG AS ERROR
  1270. ;
  1271. ; INVALID COMMAND -- PRINT IT
  1272. ;
  1273. ERROR:
  1274.     CALL    CRLF        ;NEW LINE
  1275.     LHLD    CIPTR        ;PT TO BEGINNING OF COMMAND LINE
  1276. ERR2:
  1277.     MOV    A,M        ;GET CHAR
  1278.     CPI    ' '+1        ;SIMPLE '?' IF <SP> OR LESS
  1279.     JRC    ERR1
  1280.     PUSH    H        ;SAVE PTR TO ERROR COMMAND CHAR
  1281.     CALL    CONOUT        ;PRINT COMMAND CHAR
  1282.     POP    H        ;GET PTR
  1283.     INX    H        ;PT TO NEXT
  1284.     JR    ERR2        ;CONTINUE
  1285. ERR1:
  1286.     CALL    PRINT        ;PRINT '?'
  1287.     DB    '?'+80H
  1288.     CALL    SUBKIL        ;TERMINATE ACTIVE $$$.SUB IF ANY
  1289.     JMP    RESTRT        ;RESTART CPR
  1290. ;
  1291. ; CHECK TO SEE IF DE PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
  1292. ;
  1293. SDELM:
  1294.     LDAX    D
  1295.     ORA    A        ;0=DELIMITER
  1296.     RZ
  1297.     CPI    ' '        ;ERROR IF < <SP>
  1298.     JRC    ERROR
  1299.     RZ            ;<SP>=DELIMITER
  1300.     CPI    '='        ;'='=DELIMITER
  1301.     RZ
  1302.     CPI    5FH        ;UNDERSCORE=DELIMITER
  1303.     RZ
  1304.     CPI    '.'        ;'.'=DELIMITER
  1305.     RZ
  1306.     CPI    ':'        ;':'=DELIMITER
  1307.     RZ
  1308.     CPI    ';'        ;';'=DELIMITER
  1309.     RZ
  1310.     CPI    '<'        ;'<'=DELIMITER
  1311.     RZ
  1312.     CPI    '>'        ;'>'=DELIMITER
  1313.     RET
  1314. ;
  1315. ; ADVANCE INPUT PTR TO FIRST NON-BLANK AND FALL THROUGH TO SBLANK
  1316. ;
  1317. ADVAN:
  1318.     LDED    CIBPTR
  1319. ;
  1320. ; SKIP STRING PTED TO BY DE (STRING ENDS IN 0) UNTIL END OF STRING
  1321. ;   OR NON-BLANK ENCOUNTERED (BEGINNING OF TOKEN)
  1322. ;
  1323. SBLANK:
  1324.     LDAX    D
  1325.     ORA    A
  1326.     RZ
  1327.     CPI    ' '
  1328.     RNZ
  1329.     INX    D
  1330.     JR    SBLANK
  1331. ;
  1332. ; ADD A TO HL (HL=HL+A)
  1333. ;
  1334. ADDAH:
  1335.     ADD    L
  1336.     MOV    L,A
  1337.     RNC
  1338.     INR    H
  1339.     RET
  1340. ;
  1341. ; EXTRACT DECIMAL NUMBER FROM COMMAND LINE
  1342. ;   RETURN WITH VALUE IN REG A;ALL REGISTERS MAY BE AFFECTED
  1343. ;
  1344. NUMBER:
  1345.     CALL    SCANER        ;PARSE NUMBER AND PLACE IN FCBFN
  1346.     LXI    H,FCBFN+10     ;PT TO END OF TOKEN FOR CONVERSION
  1347.     MVI    B,11        ;11 CHARS MAX
  1348. ;
  1349. ; CHECK FOR SUFFIX FOR HEXADECIMAL NUMBER
  1350. ;
  1351. NUMS:
  1352.     MOV    A,M        ;GET CHARS FROM END, SEARCHING FOR SUFFIX
  1353.     DCX    H        ;BACK UP
  1354.     CPI    ' '        ;SPACE?
  1355.     JRNZ    NUMS1        ;CHECK FOR SUFFIX
  1356.     DJNZ    NUMS        ;COUNT DOWN
  1357.     JR    NUM0        ;BY DEFAULT, PROCESS
  1358. NUMS1:
  1359.     CPI    NUMBASE        ;CHECK AGAINST BASE SWITCH FLAG
  1360.     JRZ    HNUM0
  1361. ;
  1362. ; PROCESS DECIMAL NUMBER
  1363. ;
  1364. NUM0:
  1365.     LXI    H,FCBFN        ;PT TO BEGINNING OF TOKEN
  1366.     LXI    B,1100H        ;C=ACCUMULATED VALUE, B=CHAR COUNT
  1367.                 ; (C=0, B=11)
  1368. NUM1:
  1369.     MOV    A,M        ;GET CHAR
  1370.     CPI    ' '        ;DONE IF <SP>
  1371.     JRZ    NUM2
  1372.     INX    H        ;PT TO NEXT CHAR
  1373.     SUI    '0'        ;CONVERT TO BINARY (ASCII 0-9 TO BINARY)
  1374.     CPI    10        ;ERROR IF >= 10
  1375.     JRNC    NUMERR
  1376.     MOV    D,A        ;DIGIT IN D
  1377.     MOV    A,C        ;NEW VALUE = OLD VALUE * 10
  1378.     RLC
  1379.     RLC
  1380.     RLC
  1381.     ADD    C        ;CHECK FOR RANGE ERROR
  1382.     JRC    NUMERR
  1383.     ADD    C        ;CHECK FOR RANGE ERROR
  1384.     JRC    NUMERR
  1385.     ADD    D        ;NEW VALUE = OLD VALUE * 10 + DIGIT
  1386.     JRC    NUMERR        ;CHECK FOR RANGE ERROR
  1387.     MOV    C,A        ;SET NEW VALUE
  1388.     DJNZ    NUM1        ;COUNT DOWN
  1389. ;
  1390. ; RETURN FROM NUMBER
  1391. ;
  1392. NUM2:
  1393.     MOV    A,C        ;GET ACCUMULATED VALUE
  1394.     RET
  1395. ;
  1396. ; NUMBER ERROR ROUTINE FOR SPACE CONSERVATION
  1397. ;
  1398. NUMERR:
  1399.     JMP    ERROR        ;USE ERROR ROUTINE - THIS IS RELATIVE PT
  1400. ;
  1401. ; EXTRACT HEXADECIMAL NUMBER FROM COMMAND LINE
  1402. ;   RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
  1403. ;
  1404. HEXNUM:
  1405.     CALL    SCANER        ;PARSE NUMBER AND PLACE IN FCBFN
  1406. HNUM0:
  1407.     LXI    H,FCBFN        ;PT TO TOKEN FOR CONVERSION
  1408.     LXI    D,0        ;DE=ACCUMULATED VALUE
  1409.     MVI    B,11        ;B=CHAR COUNT
  1410. HNUM1:
  1411.     MOV    A,M        ;GET CHAR
  1412.     CPI    ' '        ;DONE?
  1413.     JRZ    HNUM3        ;RETURN IF SO
  1414.     CPI    NUMBASE        ;DONE IF NUMBASE SUFFIX
  1415.     JRZ    HNUM3
  1416.     SUI    '0'        ;CONVERT TO BINARY
  1417.     JRC    NUMERR        ;RETURN AND DONE IF ERROR
  1418.     CPI    10        ;0-9?
  1419.     JRC    HNUM2
  1420.     SUI    7        ;A-F?
  1421.     CPI    10H        ;ERROR?
  1422.     JRNC    NUMERR
  1423. HNUM2:
  1424.     INX    H        ;PT TO NEXT CHAR
  1425.     MOV    C,A        ;DIGIT IN C
  1426.     MOV    A,D        ;GET ACCUMULATED VALUE
  1427.     RLC            ;EXCHANGE NYBBLES
  1428.     RLC
  1429.     RLC
  1430.     RLC
  1431.     ANI    0F0H        ;MASK OUT LOW NYBBLE
  1432.     MOV    D,A
  1433.     MOV    A,E        ;SWITCH LOW-ORDER NYBBLES
  1434.     RLC
  1435.     RLC
  1436.     RLC
  1437.     RLC
  1438.     MOV    E,A        ;HIGH NYBBLE OF E=NEW HIGH OF E,
  1439.                 ;  LOW NYBBLE OF E=NEW LOW OF D
  1440.     ANI    0FH        ;GET NEW LOW OF D
  1441.     ORA    D        ;MASK IN HIGH OF D
  1442.     MOV    D,A        ;NEW HIGH BYTE IN D
  1443.     MOV    A,E
  1444.     ANI    0F0H        ;MASK OUT LOW OF E
  1445.     ORA    C        ;MASK IN NEW LOW
  1446.     MOV    E,A        ;NEW LOW BYTE IN E
  1447.     DJNZ    HNUM1        ;COUNT DOWN
  1448. ;
  1449. ; RETURN FROM HEXNUM
  1450. ;
  1451. HNUM3:
  1452.     XCHG            ;RETURNED VALUE IN HL
  1453.     MOV    A,L        ;LOW-ORDER BYTE IN A
  1454.     RET
  1455. ;
  1456. ; PT TO DIRECTORY ENTRY IN TBUFF WHOSE OFFSET IS SPECIFIED BY A AND C
  1457. ;
  1458. DIRPTR:
  1459.     LXI    H,TBUFF     ;PT TO TEMP BUFFER
  1460.     ADD    C        ;PT TO 1ST BYTE OF DIR ENTRY
  1461.     CALL    ADDAH        ;PT TO DESIRED BYTE IN DIR ENTRY
  1462.     MOV    A,M        ;GET DESIRED BYTE
  1463.     RET
  1464. ;
  1465. ; CHECK FOR SPECIFIED DRIVE AND LOG IT IN IF NOT DEFAULT
  1466. ;
  1467. SLOGIN:
  1468.     XRA    A        ;SET FCBDN FOR DEFAULT DRIVE
  1469.     STA    FCBDN
  1470.     CALL    COMLOG        ;CHECK DRIVE
  1471.     RZ
  1472.     JR    DLOG5        ;DO LOGIN OTHERWISE
  1473. ;
  1474. ; CHECK FOR SPECIFIED DRIVE AND LOG IN DEFAULT DRIVE IF SPECIFIED<>DEFAULT
  1475. ;
  1476. DLOGIN:
  1477.     CALL    COMLOG        ;CHECK DRIVE
  1478.     RZ            ;ABORT IF SAME
  1479.     LDA    TDRIVE        ;LOG IN DEFAULT DRIVE
  1480. ;
  1481. DLOG5:    JMP    LOGIN
  1482. ;
  1483. ; ROUTINE COMMON TO BOTH LOGIN ROUTINES; ON EXIT, Z SET MEANS ABORT
  1484. ;
  1485. COMLOG:
  1486. TEMPDR    EQU    $+1        ;POINTER FOR IN-THE-CODE MODIFICATION
  1487.     MVI    A,0        ;2ND BYTE (IMMEDIATE ARG) IS TEMPDR
  1488.     ORA    A        ;0=NO
  1489.     RZ
  1490.     DCR    A        ;COMPARE IT AGAINST DEFAULT
  1491.     LXI    H,TDRIVE
  1492.     CMP    M
  1493.     RET            ;ABORT IF SAME
  1494. ;
  1495. ; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCBDN;
  1496. ;   FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP);
  1497. ;   ON INPUT, CIBPTR PTS TO CHAR AT WHICH TO START SCAN;
  1498. ;   ON OUTPUT, CIBPTR PTS TO CHAR AT WHICH TO CONTINUE AND ZERO FLAG IS RESET
  1499. ;     IF '?' IS IN TOKEN
  1500. ;
  1501. ; ENTRY POINTS:
  1502. ;    SCANER - LOAD TOKEN INTO FIRST FCB
  1503. ;    SCANX - LOAD TOKEN INTO FCB PTED TO BY HL
  1504. ;
  1505. SCANER:
  1506.     LXI    H,FCBDN     ;POINT TO FCBDN
  1507. SCANX:
  1508.     XRA    A        ;SET TEMPORARY DRIVE NUMBER TO DEFAULT
  1509.     STA    TEMPDR
  1510.     CALL    ADVAN        ;SKIP TO NON-BLANK OR END OF LINE
  1511.     SDED    CIPTR        ;SET PTR TO NON-BLANK OR END OF LINE
  1512.     LDAX    D        ;END OF LINE?
  1513.     ORA    A        ;0=YES
  1514.     JRZ    SCAN2
  1515.     SBI    'A'-1        ;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
  1516.     MOV    B,A        ;STORE NUMBER (A:=0, B:=1, ETC) IN B
  1517.     INX    D        ;PT TO NEXT CHAR
  1518.     LDAX    D        ;SEE IF IT IS A COLON (:)
  1519.     CPI    ':'
  1520.     JRZ    SCAN3        ;YES, WE HAVE A DRIVE SPEC
  1521.     DCX    D        ;NO, BACK UP PTR TO FIRST NON-BLANK CHAR
  1522. SCAN2:
  1523.     LDA    TDRIVE        ;SET 1ST BYTE OF FCBDN AS DEFAULT DRIVE
  1524.     MOV    M,A
  1525.     JR    SCAN4
  1526. SCAN3:
  1527.     MOV    A,B        ;WE HAVE A DRIVE SPEC
  1528.     STA    TEMPDR        ;SET TEMPORARY DRIVE
  1529.     MOV    M,B        ;SET 1ST BYTE OF FCBDN AS SPECIFIED DRIVE
  1530.     INX    D        ;PT TO BYTE AFTER ':'
  1531. ;
  1532. ; EXTRACT FILENAME FROM POSSIBLE FILENAME.TYP
  1533. ;
  1534. SCAN4:
  1535.     XRA    A        ;A=0
  1536.     STA    QMCNT        ;INIT COUNT OF NUMBER OF QUESTION MARKS IN FCB
  1537.     MVI    B,8        ;MAX OF 8 CHARS IN FILE NAME
  1538.     CALL    SCANF        ;FILL FCB FILE NAME
  1539. ;
  1540. ; EXTRACT FILE TYPE FROM POSSIBLE FILENAME.TYP
  1541. ;
  1542.     MVI    B,3        ;PREPARE TO EXTRACT TYPE
  1543.     CPI    '.'        ;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE
  1544.     JRNZ    SCAN15        ;FILL FILE TYPE BYTES WITH <SP>
  1545.     INX    D        ;PT TO CHAR IN COMMAND LINE AFTER '.'
  1546.     CALL    SCANF        ;FILL FCB FILE TYPE
  1547.     JR    SCAN16        ;SKIP TO NEXT PROCESSING
  1548. SCAN15:
  1549.     CALL    SCANF4        ;SPACE FILL
  1550. ;
  1551. ; FILL IN EX, S1, S2, AND RC WITH ZEROES
  1552. ;
  1553. SCAN16:
  1554.     MVI    B,4        ;4 BYTES
  1555. SCAN17:
  1556.     INX    H        ;PT TO NEXT BYTE IN FCBDN
  1557.     MVI    M,0
  1558.     DJNZ    SCAN17
  1559. ;
  1560. ; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN
  1561. ;
  1562.     SDED    CIBPTR
  1563. ;
  1564. ; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP
  1565. ;
  1566.     LDA    QMCNT        ;GET NUMBER OF QUESTION MARKS
  1567.     ORA    A        ;SET ZERO FLAG TO INDICATE ANY '?'
  1568.     RET
  1569. ;
  1570. ;  SCANF -- SCAN TOKEN PTED TO BY DE FOR A MAX OF B BYTES; PLACE IT INTO
  1571. ;    FILE NAME FIELD PTED TO BY HL; EXPAND AND INTERPRET WILD CARDS OF
  1572. ;    '*' AND '?'; ON EXIT, DE PTS TO TERMINATING DELIMITER
  1573. ;
  1574. SCANF:
  1575.     CALL    SDELM        ;DONE IF DELIMITER ENCOUNTERED - <SP> FILL
  1576.     JRZ    SCANF4
  1577.     INX    H        ;PT TO NEXT BYTE IN FCBDN
  1578.     CPI    '*'        ;IS (DE) A WILD CARD?
  1579.     JRNZ    SCANF1        ;CONTINUE IF NOT
  1580.     MVI    M,'?'        ;PLACE '?' IN FCBDN AND DON'T ADVANCE DE IF SO
  1581.     CALL    SCQ        ;SCANNER COUNT QUESTION MARKS
  1582.     JR    SCANF2
  1583. SCANF1:
  1584.     MOV    M,A        ;STORE FILENAME CHAR IN FCBDN
  1585.     INX    D        ;PT TO NEXT CHAR IN COMMAND LINE
  1586.     CPI    '?'        ;CHECK FOR QUESTION MARK (WILD)
  1587.     CZ    SCQ        ;SCANNER COUNT QUESTION MARKS
  1588. SCANF2:
  1589.     DJNZ    SCANF        ;DECREMENT CHAR COUNT UNTIL 8 ELAPSED
  1590. SCANF3:
  1591.     CALL    SDELM        ;8 CHARS OR MORE - SKIP UNTIL DELIMITER
  1592.     RZ            ;ZERO FLAG SET IF DELIMITER FOUND
  1593.     INX    D        ;PT TO NEXT CHAR IN COMMAND LINE
  1594.     JR    SCANF3
  1595. ;
  1596. ;  FILL MEMORY POINTED TO BY HL WITH SPACES FOR B BYTES
  1597. ;
  1598. SCANF4:
  1599.     INX    H        ;PT TO NEXT BYTE IN FCBDN
  1600.     MVI    M,' '        ;FILL FILENAME PART WITH <SP>
  1601.     DJNZ    SCANF4
  1602.     RET
  1603. ;
  1604. ;  INCREMENT QUESTION MARK COUNT FOR SCANNER
  1605. ;    THIS ROUTINE INCREMENTS THE COUNT OF THE NUMBER OF QUESTION MARKS IN
  1606. ;    THE CURRENT FCB ENTRY
  1607. ;
  1608. SCQ:
  1609.     LDA    QMCNT        ;GET COUNT
  1610.     INR    A        ;INCREMENT
  1611.     STA    QMCNT        ;PUT COUNT
  1612.     RET
  1613. ;
  1614. ; CMDTBL (COMMAND TABLE) SCANNER
  1615. ;   ON RETURN, HL PTS TO ADDRESS OF COMMAND IF CPR-RESIDENT
  1616. ;   ON RETURN, ZERO FLAG SET MEANS CPR-RESIDENT COMMAND
  1617. ;
  1618. CMDSER:
  1619.     LXI    H,CMDTBL    ;PT TO COMMAND TABLE
  1620. ;
  1621.     IF    SECURE
  1622.     MVI    C,NRCMDS
  1623.     LDA    WHEEL        ;SEE IF NON-RESTRCTED
  1624.     CPI    RESTRCT
  1625.     JRZ    CMS1        ;PASS IF RESTRCTED
  1626.     ENDIF    ;SECURE
  1627. ;
  1628.     MVI    C,NCMNDS    ;SET COMMAND COUNTER
  1629. CMS1:
  1630.     LXI    D,FCBFN     ;PT TO STORED COMMAND NAME
  1631.     MVI    B,NCHARS    ;NUMBER OF CHARS/COMMAND (8 MAX)
  1632. CMS2:
  1633.     LDAX    D        ;COMPARE AGAINST TABLE ENTRY
  1634.     CMP    M
  1635.     JRNZ    CMS3        ;NO MATCH
  1636.     INX    D        ;PT TO NEXT CHAR
  1637.     INX    H
  1638.     DJNZ    CMS2        ;COUNT DOWN
  1639.     LDAX    D        ;NEXT CHAR IN INPUT COMMAND MUST BE <SP>
  1640.     CPI    ' '
  1641.     JRNZ    CMS4
  1642.     RET            ;COMMAND IS CPR-RESIDENT (ZERO FLAG SET)
  1643. CMS3:
  1644.     INX    H        ;SKIP TO NEXT COMMAND TABLE ENTRY
  1645.     DJNZ    CMS3
  1646. CMS4:
  1647.     INX    H        ;SKIP ADDRESS
  1648.     INX    H
  1649.     DCR    C        ;DECREMENT TABLE ENTRY NUMBER
  1650.     JRNZ    CMS1
  1651.     INR    C        ;CLEAR ZERO FLAG
  1652.     RET            ;COMMAND IS DISK-RESIDENT (ZERO FLAG CLEAR)
  1653. ;
  1654. ;**** Section 5 ****
  1655. ; CPR-Resident Commands
  1656. ;
  1657. ;
  1658. ;Section 5A
  1659. ;Command: DIR
  1660. ;Function:  To display a directory of the files on disk
  1661. ;Forms:
  1662. ;    DIR <afn>    Displays the DIR files
  1663. ;    DIR <afn> S    Displays the SYS files
  1664. ;    DIR <afn> A    Display both DIR and SYS files
  1665. ;
  1666.     IF    CPRDIR
  1667. ;
  1668. DIR:
  1669.     MVI    A,80H        ;SET SYSTEM BIT EXAMINATION
  1670.     PUSH    PSW
  1671.     CALL    SCANER        ;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN
  1672.     CALL    SLOGIN        ;LOG IN DRIVE IF NECESSARY
  1673.     LXI    H,FCBFN     ;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
  1674.     MOV    A,M        ;GET FIRST CHAR OF FILENAME.TYP
  1675.     CPI    ' '        ;IF <SP>, ALL WILD
  1676.     CZ    FILLQ
  1677.     CALL    ADVAN        ;LOOK AT NEXT INPUT CHAR
  1678.     MVI    B,0        ;SYS TOKEN DEFAULT
  1679.     JRZ    DIR2        ;JUMP; THERE ISN'T ONE
  1680.     CPI    SYSFLG        ;SYSTEM FLAG SPECIFIER?
  1681.     JRZ    GOTSYS        ;GOT SYSTEM SPECIFIER
  1682.     CPI    SOFLG        ;SYS ONLY?
  1683.     JRNZ    DIR2
  1684.     MVI    B,80H        ;FLAG SYS ONLY
  1685. GOTSYS:
  1686.     INX    D
  1687.     SDED    CIBPTR
  1688.     CPI    SOFLG        ;SYS ONLY SPEC?
  1689.     JRZ    DIR2        ;THEN LEAVE BIT SPEC UNCHAGNED
  1690.     POP    PSW        ;GET FLAG
  1691.     XRA    A        ;SET NO SYSTEM BIT EXAMINATION
  1692.     PUSH    PSW 
  1693. DIR2:
  1694.     POP    PSW        ;GET FLAG
  1695. DIR2A:
  1696.                 ;DROP INTO DIRPR TO PRINT DIRECTORY
  1697.                 ; THEN RESTART CPR
  1698.     ENDIF    ;CPRDIR
  1699. ;
  1700. ; DIRECTORY PRINT ROUTINE; ON ENTRY, MSB OF A IS 1 (80H) IF SYSTEM FILES
  1701. ; EXCLUDED. THIS ROUTINE IS ALSO USED BY ERA.
  1702. ;
  1703. DIRPR:
  1704.     MOV    D,A        ;STORE SYSTEM FLAG IN D
  1705.     MVI    E,0        ;SET COLUMN COUNTER TO ZERO
  1706.     PUSH    D        ;SAVE COLUMN COUNTER (E) AND SYSTEM FLAG (D)
  1707.     MOV    A,B        ;SYS ONLY SPECIFIER
  1708.     STA    SYSTST
  1709.     CALL    SEARF        ;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE)
  1710.     CZ    PRNNF        ;PRINT NO FILE MSG;REG A NOT CHANGED
  1711. ;
  1712. ; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN
  1713. ;
  1714. DIR3:
  1715.     JRZ    DIR11        ;DONE IF ZERO FLAG SET
  1716.     DCR    A        ;ADJUST TO RETURNED VALUE
  1717.     RRC            ;CONVERT NUMBER TO OFFSET INTO TBUFF
  1718.     RRC
  1719.     RRC
  1720.     ANI    60H
  1721.     MOV    C,A        ;OFFSET INTO TBUFF IN C (C=OFFSET TO ENTRY)
  1722.     MVI    A,10        ;ADD 10 TO PT TO SYSTEM FILE ATTRIBUTE BIT
  1723.     CALL    DIRPTR
  1724.     POP    D        ;GET SYSTEM BIT MASK FROM D
  1725.     PUSH    D
  1726.     ANA    D        ;MASK FOR SYSTEM BIT
  1727. SYSTST    EQU    $+1        ;POINTER TO IN-THE-CODE BUFFER SYSTST
  1728.     CPI    0
  1729.     JRNZ    DIR10
  1730.     POP    D        ;GET ENTRY COUNT (=<CR> COUNTER)
  1731.     MOV    A,E        ;ADD 1 TO IT
  1732.     INR    E
  1733.     PUSH    D        ;SAVE IT
  1734. ;
  1735.     IF    TWOCOL
  1736.     ANI    01H        ;OUTPUT <CRLF> IF 2 ENTRIES PRINTED IN LINE
  1737.     ENDIF    ;TWOCOL
  1738. ;
  1739.     IF    NOT TWOCOL
  1740. TWOPOK    EQU    $+1        ;FOR APPLE PATCHING
  1741.     ANI    03H        ;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
  1742.     ENDIF    ;NOT TWOCOL
  1743. ;
  1744.     PUSH    PSW
  1745.     JRNZ    DIR4
  1746.     CALL    CRLF        ;NEW LINE
  1747.     JR    DIR5
  1748. DIR4:
  1749.     CALL    PRINT
  1750. ;
  1751.     IF    WIDE
  1752.     DB    '  '        ;2 SPACES
  1753.     DB    FENCE        ;THEN FENCE CHAR
  1754.     DB    ' ',' '+80H    ;THEN 2 MORE SPACES
  1755.     ENDIF
  1756. ;
  1757.     IF    NOT WIDE
  1758.     DB    ' '        ;SPACE
  1759.     DB    FENCE        ;THEN FENCE CHAR
  1760.     DB    ' '+80H        ;THEN SPACE
  1761.     ENDIF
  1762. ;
  1763. DIR5:
  1764.     MVI    B,01H        ;PT TO 1ST BYTE OF FILE NAME
  1765. DIR6:
  1766.     MOV    A,B        ;A=OFFSET
  1767.     CALL    DIRPTR        ;HL NOW PTS TO 1ST BYTE OF FILE NAME
  1768.     ANI    7FH        ;MASK OUT MSB
  1769.     CPI    ' '        ;NO FILE NAME?
  1770.     JRNZ    DIR8        ;PRINT FILE NAME IF PRESENT
  1771.     POP    PSW
  1772.     PUSH    PSW
  1773.     CPI    03H
  1774.     JRNZ    DIR7
  1775.     MVI    A,09H        ;PT TO 1ST BYTE OF FILE TYPE
  1776.     CALL    DIRPTR        ;HL NOW PTS TO 1ST BYTE OF FILE TYPE
  1777.     ANI    7FH        ;MASK OUT MSB
  1778.     CPI    ' '        ;NO FILE TYPE?
  1779.     JRZ    DIR9        ;CONTINUE IF SO
  1780. DIR7:
  1781.     MVI    A,' '        ;OUTPUT <SP>
  1782. DIR8:
  1783.     CALL    CONOUT        ;PRINT CHAR
  1784.     INR    B        ;INCR CHAR COUNT
  1785.     MOV    A,B
  1786.     CPI    12        ;END OF FILENAME.TYP?
  1787.     JRNC    DIR9        ;CONTINUE IF SO
  1788.     CPI    09H        ;END IF FILENAME ONLY?
  1789.     JRNZ    DIR6        ;PRINT TYP IF SO
  1790.     MVI    A,'.'        ;PRINT DOT BETWEEN FILE NAME AND TYPE
  1791.     CALL    CONOUT
  1792.     JR    DIR6
  1793. DIR9:
  1794.     POP    PSW
  1795. DIR10:
  1796.     CALL    BREAK        ;CHECK FOR ABORT
  1797.     JRNZ    DIR11
  1798.     CALL    SEARN        ;SEARCH FOR NEXT FILE
  1799.     JR    DIR3        ;CONTINUE
  1800. DIR11:
  1801.     POP    D        ;RESTORE STACK
  1802.     RET
  1803. ;
  1804. ; FILL FCB @HL WITH '?'
  1805. ;
  1806. FILLQ:
  1807.     MVI    B,11        ;NUMBER OF CHARS IN FN & FT
  1808. FQLP:
  1809.     MVI    M,'?'        ;STORE '?'
  1810.     INX    H
  1811.     DJNZ    FQLP
  1812.     RET
  1813. ;
  1814. ;Section 5B
  1815. ;Command: ERA
  1816. ;Function:  Erase files
  1817. ;Forms:
  1818. ;    ERA <afn>    Erase Specified files and print their names
  1819. ;
  1820.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1821. ;
  1822. ERA:
  1823.     CALL    SCANER        ;PARSE FILE SPECIFICATION
  1824.     CPI    11        ;ALL WILD (ALL FILES = 11 '?')?
  1825.     JRNZ    ERA1        ;IF NOT, THEN DO ERASES
  1826.     CALL    PRINTC
  1827.     DB    'All','?'+80H
  1828.     CALL    CONIN        ;GET REPLY
  1829.     CPI    'Y'        ;YES?
  1830. ERARJ:
  1831.     JNZ    RESTRT        ;RESTART CPR IF NOT
  1832.     CALL    CRLF        ;NEW LINE
  1833. ERA1:
  1834.     CALL    SLOGIN        ;LOG IN SELECTED DISK IF ANY
  1835.     XRA    A        ;PRINT ALL FILES (EXAMINE SYSTEM BIT)
  1836.     MOV    B,A        ;NO SYS-ONLY OPT TO DIRPR
  1837.     CALL    DIRPR        ;PRINT DIRECTORY OF ERASED FILES
  1838. ;
  1839.     IF    EPRMPT
  1840. ;
  1841. ;  QUERY USER AFTER FILES ARE SEEN, AND GIVE ONE LAST CHANCE TO BACK OUT
  1842. ;
  1843.     MOV    A,E        ;HOW MANY FILES DISPLAYED?
  1844.     ORA    A
  1845.     JZ    RESTRT        ;IF NONE, DON'T ASK OR DELETE
  1846.     CALL    PRINTC        ;PROMPT
  1847.     DB    'Ok','?'+80H
  1848.     CALL    CONIN        ;GET REPLY FOLDED
  1849.     CPI    'Y'        ;YES?
  1850.     JRNZ    ERARJ        ;GET OUT IF NOT
  1851.     ENDIF    ;EPRMPT
  1852. ;
  1853.     LXI    D,FCBDN     ;DELETE FILE(S) SPECIFIED
  1854.     JMP    DELETE        ;RESTART CPR AFTER DELETE
  1855. ;
  1856.     ENDIF            ;RAS
  1857. ;
  1858. ;Section 5C
  1859. ;Command: LIST
  1860. ;Function:  Print out specified file on the LST: Device
  1861. ;Forms:
  1862. ;    LIST <ufn>    Print file (NO Paging)
  1863. ;
  1864.     IF    CPRLST
  1865. LIST:
  1866.     MVI    A,0FFH        ;TURN ON PRINTER FLAG
  1867.     JR    TYPE0
  1868.     ENDIF    ;CPRLST
  1869. ;
  1870. ;Section 5D
  1871. ;Command: TYPE
  1872. ;Function:  Print out specified file on the CON: Device
  1873. ;Forms:
  1874. ;    TYPE <ufn>    Print file
  1875. ;    TYPE <ufn> P    Print file with paging flag    
  1876. ;
  1877.     IF    CPRTYP
  1878. TYPE:
  1879.     ENDIF    ;CPRTYP
  1880. ;
  1881.     IF    CPRTYP AND CPRLST
  1882.     XRA    A        ;TURN OFF PRINTER FLAG
  1883. ;
  1884. ; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
  1885. ;
  1886. TYPE0:
  1887.     STA    PRFLG        ;SET FLAG
  1888.     ENDIF    ;CPRTYP AND CPRLST
  1889. ;
  1890.     IF    CPRTYP
  1891.     CALL    SCANER        ;EXTRACT FILENAME.TYP TOKEN
  1892.     JNZ    ERROR        ;ERROR IF ANY QUESTION MARKS
  1893.     CALL    ADVAN        ;GET PGDFLG IF IT'S THERE
  1894.     STA    PGFLG        ;SAVE IT AS A FLAG
  1895.     JRZ    NOSLAS        ;JUMP IF INPUT ENDED
  1896.     INX    D        ;PUT NEW BUF POINTER
  1897.     XCHG
  1898.     SHLD    CIBPTR
  1899. NOSLAS:
  1900.     CALL    SLOGIN        ;LOG IN SELECTED DISK IF ANY
  1901.     CALL    OPENF        ;OPEN SELECTED FILE
  1902.     JZ    TYPE4        ;ABORT IF ERROR
  1903.     CALL    CRLF        ;NEW LINE
  1904.     MVI    A,NLINES-1    ;SET LINE COUNT
  1905.     STA    PAGCNT
  1906.     LXI    H,CHRCNT    ;SET CHAR POSITION/COUNT
  1907.     MVI    M,0FFH        ;EMPTY LINE
  1908.     MVI    B,0        ;SET TAB CHAR COUNTER
  1909. TYPE1:
  1910.     LXI    H,CHRCNT    ;PT TO CHAR POSITION/COUNT
  1911.     MOV    A,M        ;END OF BUFFER?
  1912.     CPI    80H
  1913.     JRC    TYPE2
  1914.     PUSH    H        ;READ NEXT BLOCK
  1915.     CALL    READF
  1916.     POP    H
  1917.     JRNZ    TYPE3        ;ERROR?
  1918.     XRA    A        ;RESET COUNT
  1919.     MOV    M,A
  1920. TYPE2:
  1921.     INR    M        ;INCREMENT CHAR COUNT
  1922.     LXI    H,TBUFF     ;PT TO BUFFER
  1923.     CALL    ADDAH        ;COMPUTE ADDRESS OF NEXT CHAR FROM OFFSET
  1924.     MOV    A,M        ;GET NEXT CHAR
  1925.     ANI    7FH        ;MASK OUT MSB
  1926.     CPI    1AH        ;END OF FILE (^Z)?
  1927.     RZ            ;RESTART CPR IF SO
  1928. ;
  1929. ; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
  1930. ;
  1931.     IF    WSTYPE        ;WORDSTAR HYPHEN CHECK
  1932.     CPI    1FH        ;IS CHAR WORDSTAR EOL HYPHEN?
  1933.     JRNZ    NOHYPH        ;PASS IF NOT
  1934.     MVI    A,'-'        ;YES, MAKE IT A REAL HYPHEN
  1935. NOHYPH:
  1936.     ENDIF    ;WSTYPE
  1937. ;
  1938.     CPI    ' '        ;IS CHAR CONTROL CODE?
  1939.     JRNC    PRT        ;GO BOP CHAR COUNT AND PRINT IF NOT
  1940.     CPI    CR        ;IS CHAR A CR?
  1941.     JRZ    YESCR        ;IF SO, GO ZERO B THEN PRINT
  1942.     CPI    FFEED        ;FORM FEED?
  1943.     JRZ    YESCR        ;MANY PRINTERS RETURN CARRIAGE ON THIS
  1944.     CPI    LF        ;LINE FEED?
  1945.     JRZ    NOBOP        ;PRINT, BUT DON'T BOP B
  1946.     CPI    BEL        ;BELL?
  1947.     JRZ    NOBOP        ;GO RING BUT DON'T BOP B
  1948.     CPI    TAB        ;TAB?
  1949.     JRNZ    TYPE2L        ;IF NOT, NO OTHER CHOICES, TOSS CONTROL
  1950. LTAB:
  1951.     MVI    A,' '        ;<SP>
  1952.     CALL    LCOUT
  1953.     INR    B        ;INCR POS COUNT
  1954.     MOV    A,B
  1955.     ANI    7
  1956.     JRNZ    LTAB
  1957.     JR    TYPE2L
  1958. ;
  1959. YESCR:    MVI    B,0FFH        ;COMBINE WITH INC BELOW TO GET ZERO
  1960. ;
  1961. PRT:    INR    B        ;INCREMENT CHAR COUNT
  1962. NOBOP:    CALL    LCOUT        ;PRINT IT
  1963. ;
  1964. ; CONTINUE PROCESSING
  1965. ;
  1966. ;
  1967. TYPE2L:
  1968.     CALL    BREAK        ;CHECK FOR ABORT
  1969.     JRZ    TYPE1        ;CONTINUE IF NO CHAR
  1970.     CPI    'C'-'@'     ;^C?
  1971.     RZ            ;RESTART IF SO
  1972.     JR    TYPE1
  1973. TYPE3:
  1974.     DCR    A        ;NO ERROR?
  1975.     RZ            ;RESTART CPR
  1976. TYPE4:
  1977.     JMP    ERRLOG
  1978.     ENDIF    ;CPRTYP
  1979. ;
  1980. ;Section 5E
  1981. ;Command: SAVE
  1982. ;Function:  To save the contents of the TPA onto disk as a file
  1983. ;Forms:
  1984. ;    SAVE <Number of Pages> <ufn>
  1985. ;                Save specified number of pages (start at 100H)
  1986. ;                from TPA into specified file; <Number of
  1987. ;                Pages> is in DEC
  1988. ;    SAVE <Number of Sectors> <ufn> S
  1989. ;                Like SAVE above, but numeric argument specifies
  1990. ;                number of sectors rather than pages
  1991. ;
  1992.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  1993. ;
  1994. SAVE:
  1995.     CALL    NUMBER        ;EXTRACT NUMBER FROM COMMAND LINE
  1996.     MOV    L,A        ;HL=PAGE COUNT
  1997.     MVI    H,0
  1998.     PUSH    H        ;SAVE PAGE COUNT
  1999.     CALL    EXTEST        ;TEST FOR EXISTENCE OF FILE AND ABORT IF SO
  2000.     MVI    C,16H        ;BDOS MAKE FILE
  2001.     CALL    GRBDOS
  2002.     POP    H        ;GET PAGE COUNT
  2003.     JRZ    SAVE3        ;ERROR?
  2004.     XRA    A        ;SET RECORD COUNT FIELD OF NEW FILE'S FCB
  2005.     STA    FCBCR
  2006.     CALL    ADVAN        ;LOOK FOR 'S' FOR SECTOR OPTION
  2007.     INX    D        ;PT TO AFTER 'S' TOKEN
  2008.     CPI    SECTFLG
  2009.     JRZ    SAVE0
  2010.     DCX    D        ;NO 'S' TOKEN, SO BACK UP
  2011.     DAD    H        ;DOUBLE IT FOR HL=SECTOR (128 BYTES) COUNT
  2012. SAVE0:
  2013.     SDED    CIBPTR        ;SET PTR TO BAD TOKEN OR AFTER GOOD TOKEN
  2014.     LXI    D,TPA        ;PT TO START OF SAVE AREA (TPA)
  2015. SAVE1:
  2016.     MOV    A,H        ;DONE WITH SAVE?
  2017.     ORA    L        ;HL=0 IF SO
  2018.     JRZ    SAVE2
  2019.     DCX    H        ;COUNT DOWN ON SECTORS
  2020.     PUSH    H        ;SAVE PTR TO BLOCK TO SAVE
  2021.     LXI    H,128        ;128 BYTES PER SECTOR
  2022.     DAD    D        ;PT TO NEXT SECTOR
  2023.     PUSH    H        ;SAVE ON STACK
  2024.     CALL    DMASET        ;SET DMA ADDRESS FOR WRITE (ADDRESS IN DE)
  2025.     LXI    D,FCBDN     ;WRITE SECTOR
  2026.     MVI    C,15H        ;BDOS WRITE SECTOR
  2027.     CALL    BDOSB        ;SAVE BC
  2028.     POP    D        ;GET PTR TO NEXT SECTOR IN DE
  2029.     POP    H        ;GET SECTOR COUNT
  2030.     JRZ    SAVE1        ;CONTINUE IF NO WRITE ERROR
  2031.     JR    PRNLE        ;GO PRINT ERROR AND RESET DMA
  2032. SAVE2:
  2033.     LXI    D,FCBDN     ;CLOSE SAVED FILE
  2034.     CALL    CLOSE
  2035.     INR    A        ;ERROR?
  2036.     JRNZ    SAVE3        ;PASS IF OK
  2037. ;
  2038. ;  PRNLE IS ALSO USED BY MEMLOAD FOR TPA FULL ERROR
  2039. ;
  2040. PRNLE:    CALL    PRINTC        ;DISK OR MEM FULL
  2041.     DB    'Ful','l'+80H
  2042. ;
  2043. SAVE3:    JMP    DEFDMA        ;SET DMA TO 0080 AND RESTART CPR
  2044.                 ; OR RETURN TO MLERR
  2045. ;
  2046. ; Test File in FCB for existence, ask user to delete if so, and abort if he
  2047. ;  choses not to
  2048. ;
  2049. EXTEST:
  2050.     CALL    SCANER        ;EXTRACT FILE NAME
  2051.     JNZ    ERROR        ;'?' IS NOT PERMITTED
  2052.     CALL    SLOGIN        ;LOG IN SELECTED DISK
  2053.     CALL    SEARF        ;LOOK FOR SPECIFIED FILE
  2054.     LXI    D,FCBDN        ;PT TO FILE FCB
  2055.     RZ            ;OK IF NOT FOUND
  2056.     PUSH    D        ;SAVE PTR TO FCB
  2057.     CALL    PRINTC
  2058.     DB    'Delete File','?'+80H
  2059.     CALL    CONIN        ;GET RESPONSE
  2060.     POP    D        ;GET PTR TO FCB
  2061.     CPI    'Y'        ;KEY ON YES
  2062.     JNZ    RSTCPR        ;RESTART IF NO, SP RESET EVENTUALLY
  2063.     PUSH    D        ;SAVE PTR TO FCB
  2064.     CALL    DELETE        ;DELETE FILE
  2065.     POP    D        ;GET PTR TO FCB
  2066.     RET
  2067. ;
  2068.     ENDIF            ;RAS
  2069. ;
  2070. ;Section 5F
  2071. ;Command: REN
  2072. ;Function:  To change the name of an existing file
  2073. ;Forms:
  2074. ;    REN <New ufn>=<Old ufn>    Perform function
  2075. ;
  2076.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  2077. ;
  2078. REN:
  2079.     CALL    EXTEST        ;TEST FOR FILE EXISTENCE AND RETURN
  2080.                 ; IF FILE DOESN'T EXIST; ABORT IF IT DOES
  2081.     LDA    TEMPDR        ;SAVE CURRENT DEFAULT DISK
  2082.     PUSH    PSW        ;SAVE ON STACK
  2083. REN0:
  2084.     LXI    H,FCBDN     ;SAVE NEW FILE NAME
  2085.     LXI    D,FCBDM
  2086.     LXI    B,16        ;16 BYTES
  2087.     LDIR
  2088.     CALL    ADVAN        ;ADVANCE CIBPTR
  2089.     CPI    '='        ;'=' OK
  2090.     JRNZ    REN4
  2091. REN1:
  2092.     XCHG            ;PT TO CHAR AFTER '=' IN HL
  2093.     INX    H
  2094.     SHLD    CIBPTR        ;SAVE PTR TO OLD FILE NAME
  2095.     CALL    SCANER        ;EXTRACT FILENAME.TYP TOKEN
  2096.     JRNZ    REN4        ;ERROR IF ANY '?'
  2097.     POP    PSW        ;GET OLD DEFAULT DRIVE
  2098.     MOV    B,A        ;SAVE IT
  2099.     LXI    H,TEMPDR    ;COMPARE IT AGAINST CURRENT DEFAULT DRIVE
  2100.     MOV    A,M        ;MATCH?
  2101.     ORA    A
  2102.     JRZ    REN2
  2103.     CMP    B        ;CHECK FOR DRIVE ERROR
  2104.     MOV    M,B
  2105.     JRNZ    REN4
  2106. REN2:
  2107.     MOV    M,B
  2108.     XRA    A
  2109.     STA    FCBDN        ;SET DEFAULT DRIVE
  2110.     LXI    D,FCBDN     ;RENAME FILE
  2111.     MVI    C,17H        ;BDOS RENAME FCT
  2112.     CALL    GRBDOS
  2113.     RNZ
  2114. REN3:
  2115.     CALL    PRNNF        ;PRINT NO FILE MSG
  2116. REN4:
  2117.     JMP    ERRLOG
  2118. ;
  2119.     ENDIF            ;RAS
  2120. ;
  2121. ;Section 5G
  2122. ;Command: USER
  2123. ;Function:  Change current USER number
  2124. ;Forms:
  2125. ;    USER <unum>    Select specified user number;<unum> is in DEC
  2126. ;
  2127.     IF    DRUSER        ;IF DRIVE/USER CODE OK...
  2128. USER:
  2129.     CALL    USRNUM        ;EXTRACT USER NUMBER FROM COMMAND LINE
  2130.     MOV    E,A        ;PLACE USER NUMBER IN E
  2131. SUSER:    CALL    SETUSR        ;SET SPECIFIED USER
  2132.     ENDIF    ;DRUSER
  2133. RSTJMP:
  2134.     JMP    RCPRNL        ;RESTART CPR
  2135. ;
  2136. ;Section 5H
  2137. ;Command: DFU
  2138. ;Function:  Set the Default User Number for the command/file scanner
  2139. ;         (MEMLOAD)
  2140. ;        Note: When under SECURE mode, this will select the second
  2141. ;              user area to check for programs (normally user 15).
  2142. ;
  2143. ;Forms:
  2144. ;    DFU <unum>    Select Default User Number;<unum> is in DEC
  2145. ;
  2146.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  2147. DFU:
  2148.     CALL    USRNUM        ;GET USER NUMBER
  2149.     STA    DFUSR        ;PUT IT AWAY
  2150.     JR    RSTJMP        ;RESTART CPR (NO DEFAULT LOGIN)
  2151.     ENDIF    ;NOT RAS
  2152. ;
  2153. ;Section 5I
  2154. ;Command: JUMP
  2155. ;Function:  To Call the program (subroutine) at the specified address
  2156. ;         without loading from disk
  2157. ;Forms:
  2158. ;    JUMP <adr>        Call at <adr>;<adr> is in HEX
  2159. ;
  2160.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  2161. ;
  2162. JUMP:
  2163.     CALL    HEXNUM        ;GET LOAD ADDRESS IN HL
  2164.     JR    CALLPROG    ;PERFORM CALL
  2165. ;
  2166.     ENDIF            ;RAS
  2167. ;
  2168. ;Section 5J
  2169. ;Command: GO
  2170. ;Function:  To Call the program in the TPA without loading
  2171.  
  2172. ;         loading from disk. Same as JUMP 100H, but much
  2173. ;         more convenient, especially when used with
  2174. ;         parameters for programs like STAT. Also can be
  2175. ;         allowed on remote-access systems with no problems.
  2176. ;
  2177. ;Form:
  2178. ;    GO <parameters like for COMMAND>
  2179. ;
  2180.     IF    NOT RAS        ;ONLY IF RAS
  2181. ;
  2182. GO:    LXI    H,TPA        ;Always to TPA
  2183.     JR    CALLPROG    ;Perform call
  2184. ;
  2185.     ENDIF            ;END OF GO FOR RAS
  2186. ;
  2187. ;Section 5K
  2188. ;Command: COM file processing
  2189. ;Function:  To load the specified COM file from disk and execute it
  2190. ;Forms:
  2191. ;    <command>
  2192. ;
  2193. COM:
  2194.     LDA    FCBFN        ;ANY COMMAND?
  2195.     CPI    ' '        ;' ' MEANS COMMAND WAS 'D:' TO SWITCH
  2196.     JRNZ    COM1        ;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
  2197.     LDA    TEMPDR        ;LOOK FOR DRIVE SPEC
  2198.     ORA    A        ;IF ZERO, JUST BLANK
  2199.     JZ    RCPRNL
  2200.     DCR    A        ;ADJUST FOR LOG IN
  2201.     STA    TDRIVE        ;SET DEFAULT DRIVE
  2202.     CALL    SETU0D        ;SET DRIVE WITH USER 0
  2203.     CALL    LOGIN        ;LOG IN DRIVE
  2204. ;
  2205.     IF    DRUSER        ;DRIVE/USER HACKERY OK?
  2206.     CALL    USRNUM        ;GET USER #, IF ANY
  2207.     MOV    E,A        ;GET IT READY FOR BDOS
  2208.     LDA    FCBFN        ;SEE IF # SPECIFIED
  2209.     CPI    ' '
  2210.     JRNZ    SUSER        ;SELECT IF WANTED
  2211.     ENDIF    ;DRUSER
  2212. ;
  2213.     JMP    RCPRNL        ;RESTART CPR
  2214. COM1:
  2215.     LDA    FCBFT        ;FILE TYPE MUST BE BLANK
  2216.     CPI    ' '
  2217.     JNZ    ERROR
  2218.     LXI    H,COMMSG    ;PLACE DEFAULT FILE TYPE (COM) INTO FCB
  2219.     LXI    D,FCBFT        ;COPY INTO FILE TYPE
  2220.     LXI    B,3        ;3 BYTES
  2221.     LDIR
  2222.     LXI    H,TPA        ;SET EXECUTION/LOAD ADDRESS
  2223.     PUSH    H        ;SAVE FOR EXECUTION
  2224.     CALL    MEMLOAD        ;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
  2225.                 ; (NO RETURN IF ERROR OR TOO BIG)
  2226.     POP    H        ;GET EXECUTION ADDRESS
  2227. ;
  2228. ; CALLPROG IS THE ENTRY POINT FOR THE EXECUTION OF THE LOADED
  2229. ;   PROGRAM. ON ENTRY TO THIS ROUTINE, HL MUST CONTAIN THE EXECUTION
  2230. ;   ADDRESS OF THE PROGRAM (SUBROUTINE) TO EXECUTE
  2231. ;
  2232. CALLPROG:
  2233.     SHLD    EXECADR        ;PERFORM IN-LINE CODE MODIFICATION
  2234.     CALL    DLOGIN        ;LOG IN DEFAULT DRIVE
  2235.     CALL    SCANER        ;SEARCH COMMAND LINE FOR NEXT TOKEN
  2236.     LXI    H,TEMPDR    ;SAVE PTR TO DRIVE SPEC
  2237.     PUSH    H
  2238.     MOV    A,M        ;SET DRIVE SPEC
  2239.     STA    FCBDN
  2240.     LXI    H,FCBDN+10H    ;PT TO 2ND FILE NAME
  2241.     CALL    SCANX        ;SCAN FOR IT AND LOAD IT INTO FCBDN+16
  2242.     POP    H        ;SET UP DRIVE SPECS
  2243.     MOV    A,M
  2244.     STA    FCBDM
  2245.     XRA    A
  2246.     STA    FCBCR
  2247.     LXI    D,TFCB        ;COPY TO DEFAULT FCB
  2248.     LXI    H,FCBDN     ;FROM FCBDN
  2249.     LXI    B,33        ;SET UP DEFAULT FCB
  2250.     LDIR
  2251.     LXI    H,CIBUFF-1
  2252. COM4:
  2253.     INX    H
  2254.     MOV    A,M        ;SKIP TO END OF 2ND FILE NAME
  2255.     ORA    A        ;END OF LINE?
  2256.     JRZ    COM5
  2257.     CPI    ' '        ;END OF TOKEN?
  2258.     JRNZ    COM4
  2259. ;
  2260. ; LOAD COMMAND LINE INTO TBUFF
  2261. ;
  2262. COM5:
  2263.     MVI    B,-1        ;SET CHAR COUNT
  2264.     LXI    D,TBUFF        ;PT TO CHAR POS
  2265.     DCX    H
  2266. COM6:
  2267.     INR    B        ;INCR CHAR COUNT
  2268.     INX    H        ;PT TO NEXT
  2269.     INX    D
  2270.     MOV    A,M        ;COPY COMMAND LINE TO TBUFF
  2271.     STAX    D
  2272.     ORA    A        ;DONE IF ZERO
  2273.     JRNZ    COM6
  2274. ;
  2275. ; RUN LOADED TRANSIENT PROGRAM
  2276. ;
  2277. COM7:
  2278.     MOV    A,B        ;SAVE CHAR COUNT
  2279.     STA    TBUFF
  2280.     CALL    CRLF        ;NEW LINE
  2281.     CALL    DEFDMA        ;SET DMA TO 0080
  2282.     CALL    SETUD        ;SET USER/DISK
  2283. ;
  2284. ; EXECUTION (CALL) OF PROGRAM (SUBROUTINE) OCCURS HERE
  2285. ;
  2286. EXECADR    EQU    $+1        ;CHANGE ADDRESS FOR IN-LINE CODE MODIFICATION
  2287.     CALL    TPA        ;CALL TRANSIENT
  2288.     CALL    DEFDMA        ;SET DMA TO 0080, IN CASE
  2289.                 ;PROG CHANGED IT ON US
  2290.     CALL    SETU0D        ;SET USER 0/DISK
  2291.     CALL    LOGIN        ;LOGIN DISK
  2292.     JMP    RESTRT        ;RESTART CPR
  2293. ;
  2294. ;Section 5L
  2295. ;Command: GET
  2296. ;Function:  To load the specified file from disk to the specified address
  2297. ;Forms:
  2298. ;    GET <adr> <ufn>    Load the specified file at the specified page;
  2299. ;            <adr> is in HEX
  2300. ;
  2301.     IF    NOT RAS        ;NOT FOR REMOTE-ACCESS SYSTEM
  2302. ;
  2303. GET:
  2304.     CALL    HEXNUM        ;GET LOAD ADDRESS IN HL
  2305.     PUSH    H        ;SAVE ADDRESS
  2306.     CALL    SCANER        ;GET FILE NAME
  2307.     POP    H        ;RESTORE ADDRESS
  2308.     JNZ    ERROR        ;MUST BE UNAMBIGUOUS
  2309. ;
  2310. ; FALL THRU TO MEMLOAD
  2311. ;
  2312.     ENDIF            ;RAS
  2313. ;
  2314. ; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE
  2315. ;   ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD
  2316. ;
  2317. ;  EXIT BACK TO CALLER IF NO ERROR.  IF COM FILE TOO BIG OR
  2318. ; OTHER ERROR, EXIT DIRECTLY TO MLERR.
  2319. ;
  2320. MEMLOAD:
  2321.     SHLD    LOADADR        ;SET LOAD ADDRESS
  2322.     CALL    GETUSR        ;GET CURRENT USER NUMBER
  2323.     STA    TMPUSR        ;SAVE IT FOR LATER
  2324.     STA    TSELUSR     ;TEMP USER TO SELECT
  2325. ;
  2326. ;   MLA is a reentry point for a non-standard CP/M Modification
  2327. ; This is the return point for when the .COM (or GET) file is not found the
  2328. ; first time, Drive A: is selected for a second attempt
  2329. ;
  2330. MLA:
  2331.     CALL    SLOGIN        ;LOG IN SPECIFIED DRIVE IF ANY
  2332.     CALL    OPENF        ;OPEN COMMAND.COM FILE
  2333.     JRNZ    MLA1        ;FILE FOUND - LOAD IT
  2334. ;
  2335.     IF    SECURE
  2336. ;
  2337. ;  IF SECURE ENABLED, SEARCH CURRENT DRIVE, CURRENT USER, THEN
  2338. ; IF IN WHEEL MODE, SEARCH UNDER LAST USER SET BY DFU (ORIG
  2339. ; "RESUSR" AFTER WARM BOOT) ON CURRENT DRIVE. IF NOT FOUND, OR
  2340. ; NOT IN WHEEL MODE, THEN SEARCH ON CURRENT DRIVE, UNDER USER
  2341. ; "DEFUSR". IF STILL NOT FOUND, LOOK AT SAME SERIES OF USERS
  2342. ; ON DRIVE A.
  2343. ;
  2344. DFLAG    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
  2345.     MVI    A,0        ;HAVE WE CHECKED THIS DRIVE ALREADY?
  2346.     ORA    A
  2347.     JRNZ    MLA0        ;PASS IF SO TO GO TO DRIVE A:
  2348.     LDA    WHEEL        ;RESTRICTED PROGS ALLOWED?
  2349.     CPI    RESTRCT
  2350.     JRZ    MLA00        ;PASS IF NOT
  2351.     PUSH    B        ;PUSH BC
  2352.     LDA    DFUSR        ;LOAD DEFAULT USER
  2353.     MOV    B,A        ;PUT IT IN B
  2354.     LDA    TSELUSR        ;CHECK CURR USER
  2355. DFUSR    EQU    $+1        ;DEFAULT USER LOCATION
  2356.     CPI    RESUSR        ;RESTRICTED USER?
  2357.     MOV    A,B        ;ASSUME NOT
  2358.     POP    B        ;RESTORE BC
  2359.     JRNZ    SETTSE        ;GO TRY IF NOT
  2360. MLA00:                ;SS IF NOT
  2361. TSELUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
  2362.     MVI    A,0        ;GET CURR USER
  2363.     SUI    DEFUSR        ;IS IT UNRESTRICTED COM AREA?
  2364.     JRZ    MLA0        ;NO MORE CHOICES IF SO
  2365.     STA    DFLAG        ;MAKE DFLAG NON-ZERO IF NOT
  2366.     MVI    A,DEFUSR    ; AND TRY UNRESTRICTED COM AREA
  2367. SETTSE:
  2368.     ENDIF    ;SECURE
  2369. ;
  2370.     IF    NOT SECURE
  2371. DFUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
  2372.     MVI    A,DEFUSR    ;GET DEFAULT USER
  2373. TSELUSR    EQU    $+1        ;MARK IN-THE-CODE VARIABLE
  2374.     CPI    DEFUSR        ;CHECK FOR THE USER AREA..
  2375.     JRZ    MLA0        ;..EQUAL DEFAULT, AND JUMP IF SO
  2376.     ENDIF    ;NOT SECURE
  2377. ;
  2378.     STA    TSELUSR        ;PUT DOWN NEW ONE
  2379.     MOV    E,A
  2380.     CALL    SETUSR        ;GO SET NEW USER NUMBER
  2381.     JR    MLA        ;AND TRY AGAIN
  2382. ;
  2383. ; ERROR ROUTINE TO SELECT DRIVE A: IF DEFAULT WAS ORIGINALLY SELECTED
  2384. ;
  2385. MLA0:
  2386.     LXI    H,TEMPDR    ;GET DRIVE FROM CURRENT COMMAND
  2387.     XRA    A        ;A=0
  2388. ;
  2389.     IF    SECURE
  2390.     STA    DFLAG        ;ALLOW A: SEARCH
  2391.     ENDIF    ;SECURE
  2392. ;
  2393.     ORA    M
  2394.     JNZ    MLERR        ;ERROR IF ALREADY DISK A:
  2395.     MVI    M,1        ;SELECT DRIVE A:
  2396. ;
  2397.     IF    NOT SECURE
  2398.     JR    MLA
  2399.     ENDIF    ;NOT SECURE
  2400. ;
  2401.     IF    SECURE
  2402.     LDA    TMPUSR        ;GO TO 'CURRENT' USER CODE
  2403.     JR    SETTSE
  2404.     ENDIF    ;SECURE
  2405. ;
  2406. ; FILE FOUND -- PROCEED WITH LOAD
  2407. ;
  2408. MLA1:
  2409. LOADADR    EQU    $+1
  2410.     LXI    H,TPA
  2411. ML2:
  2412.     MVI    A,ENTRY/256-1    ;GET HIGH-ORDER ADR OF JUST BELOW CPR
  2413.     CMP    H        ;ARE WE GOING TO OVERWRITE THE CPR?
  2414.     JRC    ML4        ;ERROR IF SO
  2415.     PUSH    H        ;SAVE ADDRESS OF NEXT SECTOR
  2416.     XCHG            ;... IN DE
  2417.     CALL    DMASET        ;SET DMA ADDRESS FOR LOAD
  2418.     LXI    D,FCBDN     ;READ NEXT SECTOR
  2419.     CALL    READ
  2420.     POP    H        ;GET ADDRESS OF NEXT SECTOR
  2421.     JRNZ    ML3        ;READ ERROR OR EOF?
  2422.     LXI    D,128        ;MOVE 128 BYTES PER SECTOR
  2423.     DAD    D        ;PT TO NEXT SECTOR IN HL
  2424.     JR    ML2
  2425. ;
  2426. ML3:
  2427.     DCR    A        ;LOAD COMPLETE
  2428.     JZ    RESETUSR    ;IF ZERO, OK, GO RESET CORRECT USER #
  2429.                 ; ON WAY OUT, ELSE FALL THRU TO PRNLE
  2430. ;
  2431. ;  TPA FULL
  2432. ;
  2433. ML4:    CALL    PRNLE        ;PRINT MSG AND RESET DEF DMA
  2434. ;
  2435. ; TRANSIENT LOAD ERROR
  2436. ;
  2437. MLERR:
  2438.         ;NOTE THAT THERE IS AN EXTRA RETURN ADDRESS ON
  2439.         ; THE STACK.  IT WILL BE TOSSED WHEN ERROR EXITS
  2440.         ; TO RESTRT, WHICH RELOADS SP.
  2441.     CALL    RESETUSR    ;RESET CURRENT USER NUMBER
  2442.                 ;  RESET MUST BE DONE BEFORE LOGIN
  2443. ERRLOG:
  2444.     CALL    DLOGIN        ;LOG IN DEFAULT DISK
  2445.     JMP    ERROR        ;FLAG ERROR
  2446. ;
  2447. ;
  2448. ;Section: 5M
  2449. ;PASS:  Enable wheel mode.
  2450. ;NORM:    Disable wheel mode.
  2451. ;
  2452. ;  Type PASS <password> <cr> to CP/M prompt to enter wheel mode.
  2453. ; This code can be replaced with PST's PASS.ASM which gives many
  2454. ; nice little options like no keyboard echo, etc.
  2455. ;
  2456.     IF    INPASS        ;WE WANT TO USE THIS CODE, NOT PASS.COM
  2457. PASS:
  2458.     LXI    H,PASSWD        ;SET UP POINTERS
  2459.     LXI    D,CIBUFF+NCHARS+1
  2460.     MVI    B,PRGEND-PASSWD        ;B= LENGTH
  2461. CKPASS:    LDAX    D        ;TRIAL PW TO A
  2462.     CMP    M        ;CHECK FOR MATCH
  2463.     JNZ    COM        ;NOPE.. LOOK FOR PASS.COM
  2464.     INX    H        ;INCREMENT COUNTER
  2465.     INX    D
  2466.     DJNZ    CKPASS        ;CONTINUE IF MORE
  2467.     MVI    A,NOT RESTRCT    ;WHEEL = NOT RESTRCT
  2468.  
  2469. PWOUT:    STA    WHEEL
  2470.     JMP    RESTRT
  2471. ;
  2472. NORM:
  2473.     MVI    A,RESTRCT
  2474.     JR    PWOUT
  2475. ;
  2476. PASSWD:
  2477.     DB    'YOURPW'        ;YOUR PASSWORD
  2478. PRGEND:    EQU    $            ;END OF PASSWORD
  2479. ;
  2480.     ENDIF    ;INPASS
  2481. ;
  2482.     END
  2483.