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