home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / DRIPAK.ZIP / CPM_3-0 / SOURCES / CCP3.ASM < prev    next >
Assembly Source File  |  1982-12-31  |  64KB  |  2,807 lines
  1. title    'CP/M 3 - Console Command Processor - November 1982'
  2. ;    version 3.00  Nov 30 1982 - Doug Huskey
  3.  
  4.  
  5. ;  Copyright (C) 1982
  6. ;  Digital Research
  7. ;  P.O. Box 579
  8. ;  Pacific Grove, CA 93950
  9.  
  10. ;  Revised: (date/name of person modifying this source)
  11.  
  12. ;    ****************************************************
  13. ;    *****  The following equates must be set to 100H ***
  14. ;    *****  + the addresses specified in LOADER.PRN   ***
  15. ;    *****                                            ***
  16. equ1    equ    rsxstart  ;does this adr match loader's?
  17. equ2    equ    fixchain  ;does this adr match loader's?
  18. equ3    equ    fixchain1 ;does this adr match loader's?
  19. equ4    equ    fixchain2 ;does this adr match loader's?
  20. equ5    equ    rsx$chain ;does this adr match loader's?
  21. equ6    equ    reloc     ;does this adr match loader's?
  22. equ7    equ    calcdest  ;does this adr match loader's?
  23. equ8    equ    scbaddr   ;does this adr match loader's?
  24. equ9    equ    banked    ;does this adr match loader's?
  25. equ10    equ    rsxend    ;does this adr match loader's?
  26. equ11    equ    ccporg    ;does this adr match loader's?
  27. equ12    equ    ccpend    ;This should be 0D80h
  28.     rsxstart    equ    0100h
  29.     fixchain    equ    01D0h
  30.     fixchain1    equ    01EBh
  31.     fixchain2    equ    01F0h
  32.     rsx$chain    equ    0200h
  33.     reloc        equ    02CAh
  34.     calcdest    equ    030Fh
  35.     scbaddr        equ    038Dh
  36.     banked        equ    038Fh
  37.     rsxend        equ    0394h
  38.     ccporg        equ    041Ah
  39. ;    ****************************************************
  40. ;    NOTE: THE ABOVE EQUATES MUST BE CORRECTED IF NECESSARY
  41. ;    AND THE JUMP TO START AT THE BEGINNING OF THE LOADER
  42. ;    MUST BE SET TO THE ORIGIN ADDRESS BELOW:
  43.  
  44.     org    ccporg        ;LOADER is at 100H to 3??H
  45.  
  46. ;    (BE SURE THAT THIS LEAVES ENOUGH ROOM FOR THE LOADER BIT MAP)
  47.  
  48.  
  49. ;  Conditional Assembly toggles:
  50.  
  51. true    equ    0ffffh
  52. false    equ    0h
  53. newdir    equ    true
  54. newera    equ    true        ;confirm any ambiguous file name
  55. dayfile    equ    true        
  56. prompts    equ    false
  57. func152    equ    true
  58. multi    equ    true        ;multiple command lines
  59.                 ;also shares code with loader (100-2??h)
  60. ;
  61. ;************************************************************************
  62. ;
  63. ;    GLOBAL EQUATES
  64. ;
  65. ;************************************************************************
  66. ;
  67. ;
  68. ;    CP/M BASE PAGE
  69. ;
  70. wstart    equ    0        ;warm start entry point
  71. defdrv    equ    4        ;default user & disk
  72. bdos    equ    5        ;CP/M BDOS entry point
  73. osbase    equ    bdos+1        ;base of CP/M BDOS
  74. cmdrv    equ    050h        ;command drive
  75. dfcb    equ    05ch        ;1st default fcb
  76. dufcb    equ    dfcb-1        ;1st default fcb user number
  77. pass0    equ    051h        ;1st default fcb password addr
  78. len0    equ    053h        ;1st default fcb password length
  79. dfcb1    equ    06ch        ;2nd default fcb
  80. dufcb1    equ    dfcb1-1        ;2nd default fcb user number
  81. pass1    equ    054h        ;2nd default fcb password addr
  82. len1    equ    056h        ;2nd default fcb password length
  83. buf    equ    80h        ;default buffer
  84. tpa    equ    100h        ;transient program area
  85.     if multi
  86. comlen    equ    100h-19h    ;maximum size of multiple command
  87.                 ;RSX buffer with 16 byte header &
  88.                 ;terminating zero
  89.     else
  90. comlen    equ    tpa-buf
  91.     endif
  92. ;
  93. ;    BDOS FUNCTIONS
  94. ;
  95. vers    equ    31h        ;BDOS vers 3.1
  96. cinf    equ    1        ;console input
  97. coutf    equ    2        ;console output
  98. crawf    equ    6        ;raw console input 
  99. pbuff    equ    9        ;print buffer to console
  100. rbuff    equ    10        ;read buffer from console
  101. cstatf    equ    11        ;console status
  102. resetf    equ    13        ;disk system reset
  103. self    equ    14        ;select drive
  104. openf    equ    15        ;open file
  105. closef    equ    16        ;close file
  106. searf    equ    17        ;search first
  107. searnf    equ    18        ;search next
  108. delf    equ    19        ;delete file
  109. readf    equ    20        ;read file
  110. makef    equ    22        ;make file
  111. renf    equ    23        ;rename file
  112. dmaf    equ    26        ;set DMA address
  113. userf    equ    32        ;set/get user number
  114. rreadf    equ    33        ;read file
  115. flushf    equ    48        ;flush buffers
  116. scbf    equ    49        ;set/get SCB value
  117. loadf    equ    59        ;program load
  118. allocf    equ    98        ;reset allocation vector
  119. trunf    equ    99        ;read file
  120. parsef    equ    152        ;parse file
  121. ;
  122. ;    ASCII characters
  123. ;
  124. ctrlc:    equ    'C'-40h
  125. cr:    equ    'M'-40h
  126. lf:    equ    'J'-40h
  127. tab:    equ    'I'-40h
  128. eof:    equ    'Z'-40h
  129. ;
  130. ;
  131. ;    RSX MEMORY MANAGEMENT EQUATES
  132. ;
  133. ;         RSX header equates
  134. ;    
  135. entry        equ    06h        ;RSX contain jump to start
  136. nextadd        equ    0bh        ;address of next RXS in chain
  137. prevadd        equ    0ch        ;address of previous RSX in chain
  138. warmflg        equ    0eh        ;remove on wboot flag
  139. endchain    equ    18h        ;end of RSX chain flag
  140. ;
  141. ;    LOADER.RSX equates
  142. ;
  143. module        equ    100h        ;module address
  144. ;
  145. ;    COM file header equates
  146. ;
  147. comsize        equ    tpa+1h        ;size of the COM file
  148. rsxoff        equ    tpa+10h        ;offset of the RSX in COM file
  149. rsxlen        equ    tpa+12h        ;length of the RSX
  150. ;
  151. ;
  152. ;    SYSTEM CONTROL BLOCK OFFSETS
  153. ;
  154. pag$off        equ    09ch
  155. ;
  156. olog        equ    pag$off-0ch    ; removeable media open vector
  157. rlog        equ    pag$off-0ah    ; removeable media login vector
  158. bdosbase    equ    pag$off-004h    ; real BDOS entry point
  159. hashl        equ    pag$off+000h    ; system variable
  160. hash        equ    pag$off+001h    ; hash code
  161. bdos$version    equ    pag$off+005h    ; BDOS version number
  162. util$flgs    equ    pag$off+006h    ; utility flags
  163. dspl$flgs    equ    pag$off+00ah    ; display flags
  164. clp$flgs    equ    pag$off+00eh    ; CLP flags
  165. clp$drv        equ    pag$off+00fh    ; submit file drive
  166. prog$ret$code    equ    pag$off+010h    ; program return code
  167. multi$rsx$pg    equ    pag$off+012h    ; multiple command buffer page
  168. ccpdrv        equ    pag$off+013h    ; ccp default drive
  169. ccpusr        equ    pag$off+014h    ; ccp default user number
  170. ccpconbuf    equ    pag$off+015h    ; ccp console buffer address
  171. ccpflag1    equ    pag$off+017h    ; ccp flags byte 1
  172. ccpflag2    equ    pag$off+018h    ; ccp flags byte 2
  173. ccpflag3    equ    pag$off+019h    ; ccp flags byte 3
  174. conwidth    equ    pag$off+01ah    ; console width
  175. concolumn    equ    pag$off+01bh    ; console column position
  176. conpage        equ    pag$off+01ch    ; console page length (lines)
  177. conline        equ    pag$off+01dh    ; current console line number
  178. conbuffer    equ    pag$off+01eh    ; console input buffer address
  179. conbuffl    equ    pag$off+020h    ; console input buffer length
  180. conin$rflg    equ    pag$off+022h    ; console input redirection flag
  181. conout$rflg    equ    pag$off+024h    ; console output redirection flag
  182. auxin$rflg    equ    pag$off+026h    ; auxillary input redirection flag
  183. auxout$rflg    equ    pag$off+028h    ; auxillary output redirection flag
  184. listout$rflg    equ    pag$off+02ah    ; list output redirection flag
  185. page$mode    equ    pag$off+02ch    ; page mode flag 0=on, 0ffH=off
  186. page$def    equ    pag$off+02dh    ; page mode default
  187. ctlh$act    equ    pag$off+02eh    ; ctl-h active
  188. rubout$act    equ    pag$off+02fh    ; rubout active (boolean)
  189. type$ahead    equ    pag$off+030h    ; type ahead active
  190. contran        equ    pag$off+031h    ; console translation subroutine
  191. con$mode    equ    pag$off+033h    ; console mode (raw/cooked)
  192. ten$buffer    equ    pag$off+035h    ; 128 byte buffer available
  193.                     ; to banked BIOS
  194. outdelim    equ    pag$off+037h    ; output delimiter
  195. listcp        equ    pag$off+038h    ; list output flag (ctl-p)
  196. q$flag        equ    pag$off+039h    ; queue flag for type ahead
  197. scbad        equ    pag$off+03ah    ; system control block address
  198. dmaad        equ    pag$off+03ch    ; dma address
  199. seldsk        equ    pag$off+03eh    ; current disk
  200. info        equ    pag$off+03fh    ; BDOS variable "info"
  201. resel        equ    pag$off+041h    ; disk reselect flag
  202. relog        equ    pag$off+042h    ; relog flag
  203. fx        equ    pag$off+043h    ; function number
  204. usrcode        equ    pag$off+044h    ; current user number
  205. dcnt        equ    pag$off+045h    ; directory record number
  206. searcha        equ    pag$off+047h    ; fcb address for searchn function
  207. searchl        equ    pag$off+049h    ; scan length for search functions
  208. multcnt        equ    pag$off+04ah    ; multi-sector I/O count
  209. errormode    equ    pag$off+04bh    ; BDOS error mode
  210. drv0        equ    pag$off+04ch    ; search chain - 1st drive
  211. drv1        equ    pag$off+04dh    ; search chain - 2nd drive
  212. drv2        equ    pag$off+04eh    ; search chain - 3rd drive
  213. drv3        equ    pag$off+04fh    ; search chain - 4th drive
  214. tempdrv        equ    pag$off+050h    ; temporary file drive
  215. patch$flag    equ    pag$off+051h    ; patch flags
  216. date        equ    pag$off+058h    ; date stamp 
  217. com$base    equ    pag$off+05dh    ; common memory base address
  218. error        equ    pag$off+05fh    ; error jump...all BDOS errors
  219. top$tpa        equ    pag$off+062h    ; top of user TPA (address at 6,7)
  220. ;
  221. ;    CCP FLAG 1 BIT MASKS
  222. ;    (used with getflg, setflg and resetflg routines)
  223. ;
  224. chainflg    equ    080h        ; program chain (funct 49)
  225. not$chainflg    equ    03fh        ; mask to reset chain flags
  226. chainenv    equ    040h        ; preserve usr/drv for chained prog
  227. comredirect    equ    0b320h        ; command line redirection active
  228. menu        equ    0b310h        ; execute ccp.ovl for menu systems
  229. echo        equ    0b308h        ; echo commands in batch mode
  230. userparse    equ    0b304h        ; parse user numbers in commands
  231. subfile        equ    0b301h        ; $$$.SUB file found or active
  232. subfilemask    equ    subfile-0b300h
  233. rsx$only$set    equ    02h        ; RSX only load (null COM file)
  234. rsx$only$clr    equ     0FDh        ; reset RSX only flag
  235. ;
  236. ;    CCP FLAG 2 BIT MASKS
  237. ;    (used with getflg, setflg and resetflg routines)
  238. ;
  239. ccp10        equ    0b4a0h        ; CCP function 10 call (2 bits)
  240. ccpsub        equ    0b420h        ; CCP present (for SUBMIT, PUT, GET)
  241. ccpbdos        equ    0b480h        ; CCP present (for BDOS buffer save)
  242. dskreset    equ    20h        ; CCP does disk reset on ^C from prompt
  243. submit        equ    0b440h        ; input redirection active
  244. submitflg    equ    40h        ; input redirection flag value
  245. order        equ    0b418h        ; command order
  246.                     ;  0 - COM only
  247.                     ;  1 - COM,SUB
  248.                     ;  2 - SUB,COM
  249.                     ;  3 - reserved
  250. datetime    equ    0b404h        ; display date & time of load
  251. display        equ    0b403h        ; display filename & user/drive
  252. filename    equ    02h        ; display filename loaded 
  253. location    equ    01h        ; display user & drive loaded from
  254.  
  255. ;
  256. ;    CCP FLAG 3 BIT MASKS
  257. ;    (used with getflg, setflg and resetflg routines)
  258. ;
  259. rsxload        equ    1h        ; load RSX, don't fix chain
  260. coldboot    equ    2h        ; try to exec profile.sub
  261. ;
  262. ;       CONMODE BIT MASKS
  263. ;
  264. ctlc$stat    equ    0cf01h        ;conmode CTL-C status
  265.  
  266. ;
  267. ;
  268. ;************************************************************************
  269. ;
  270. ;    Console Command Processor - Main Program
  271. ;
  272. ;************************************************************************
  273. ;
  274. ;
  275. ;
  276. start:
  277. ;
  278.     lxi    sp,stack
  279.     lxi    h,ccpret        ;push CCPRET on stack, in case of
  280.     push    h            ; profile error we will go there
  281.     lxi    d,scbadd
  282.     mvi    c,scbf
  283.     call    bdos
  284.     shld    scbaddr            ;save SCB address
  285.     mvi    l,com$base+1
  286.     mov    a,m            ;high byte of commonbase
  287.     sta    banked            ;save in loader
  288.     mvi    l,bdosbase+1        ;HL addresses real BDOS page
  289.     mov    a,m            ;BDOS base in H
  290.     sta     realdos            ;save it for use in XCOM routine
  291. ;
  292.     lda    osbase+1        ;is the LOADER in memory?
  293.     sub    m            ;compare link at 6 with real BDOS
  294.     jnz    reset$alloc        ;skip move if loader already present
  295. ;
  296. ;
  297. movldr:
  298.     lxi    b,rsxend-rsxstart    ;length of loader RSX
  299.     call    calcdest    ;calculate destination and (bias+200h)
  300.     mov    h,e        ;set to zero
  301.     mov    l,e
  302. ;    lxi    h,module-100h    ;base of loader RSX (less 100h)
  303.     call    reloc        ;relocate loader
  304.     lhld    osbase        ;HL = BDOS entry, DE = LOADER base
  305.     mov    l,e        ;set L=0
  306.     mvi    c,6
  307.     call    move        ;move the serial number down
  308.     mvi    e,nextadd
  309.     call    fixchain1
  310. ;
  311. ;
  312. reset$alloc:
  313.     mvi    c,allocf
  314.     call    bdos
  315. ;
  316. ;    
  317. ;
  318. ;************************************************************************
  319. ;
  320. ;    INITIALIZE SYSTEM CONTROL BLOCK
  321. ;
  322. ;************************************************************************
  323. ;
  324. ;
  325. scbinit:
  326.     ;
  327.     ;    # dir columns, page size & function 9 delimiter
  328.     ;
  329.     mvi     b,conwidth    
  330.     call    getbyte
  331.     inr    a        ;get console width (rel 1)
  332.     rrc
  333.     rrc    
  334.     rrc
  335.     rrc
  336.     ani    0fh        ;divide by 16
  337.     lxi    d,dircols
  338.     stax    d        ;dircols = conwidth/16
  339.     mvi    l,conpage
  340.     mov    a,m
  341.     dcr    a        ;subtract 1 for space before prompt
  342.     inx    d
  343.     stax    d        ;pgsize = conpage
  344.     xra    a
  345.     inx    d
  346.     stax    d        ;line=0
  347.     mvi    a,'$'
  348.     inx    d
  349.     stax    d        ;pgmode = nopage (>0)
  350.     mvi    l,outdelim
  351.     mov    m,a        ;set function 9 delimiter 
  352.     ;
  353.     ;    multisector count, error mode, console mode 
  354.     ;        & BDOS version no.
  355.     ;
  356.     mvi     l,multcnt 
  357.     mvi     m,1         ;set multisector I/O count = 1
  358.     inx    h        ;.errormode
  359.     xra     a
  360.     mov    m,a        ;set return error mode = 0
  361.     mvi    l,con$mode
  362.     mvi    m,1        ;set ^C status mode
  363.     inx    h
  364.     mov    m,a        ;zero 2nd conmode byte
  365.     mvi    l,bdos$version
  366.     mvi    m,vers        ;set BDOS version no.
  367.     ;
  368.     ;    disk reset check 
  369.     ;
  370.     mvi    l,ccpflag2
  371.     mov    a,m
  372.     ani    dskreset    ;^C at CCP prompt?
  373.     mvi    c,resetf
  374.     push    h
  375.     cnz    bdos        ;perform disk reset if so
  376.     pop    h
  377.     ;
  378.     ;    remove temporary RSXs (those with remove flag on)
  379.     ;
  380. rsxck:
  381.     mvi    l,ccpflag1    ;check CCP flag for RSX only load
  382.     mov    a,m
  383.     ani    rsx$only$set    ;bit = 1 if only RSX has been loaded
  384.     push    h
  385.     cz    rsx$chain    ;don't fix-up RSX chain if so
  386.     pop    h
  387.     mov    a,m
  388.     ani    rsx$only$clr    ;clear RSX only loader flag
  389.     mov    m,a        ;replace it
  390.     ;
  391.     ;    chaining environment
  392.     ;
  393.     ani    chain$env    ;non-zero if we preserve programs
  394.     push    h        ;user & drive for next transient
  395.     ;
  396.     ;    user number
  397.     ;
  398.     mvi     l,ccpusr    ; HL = .CCP USER (saved in SCB)
  399.     lxi    b,usernum    ; BC = .CCP'S DEFAULT USER
  400.     mov    d,h
  401.     mvi    e,usrcode    ; DE = .BDOS USER CODE
  402.     ldax    d
  403.     stax    b        ; usernum = bdos user number
  404.     mov     a,m        ; ccp user
  405.     jnz    scb1        ; jump if chaining env preserved
  406.     stax    b        ; usernum = ccp default user
  407. scb1:    stax    d        ; bdos user = ccp default user
  408.     ;
  409.     ;    transient program's current disk
  410.     ;
  411.     inx    b        ;.CHAINDSK
  412.     mvi    e,seldsk    ;.BDOS CURRENT DISK
  413.     ldax    d
  414.     jnz    scb2        ; jump if chaining env preserved
  415.     mvi    a,0ffh
  416. ;    cma            ; make an invalid disk
  417. scb2:    stax     b        ; chaindsk = bdos disk (or invalid)
  418.     ;
  419.     ;    current disk
  420.     ;
  421.     dcx    h        ;.CCP's DISK (saved in SCB)
  422.     inx    b        ;.CCP's CURRENT DISK
  423.     mov    a,m
  424.     stax    b
  425.     stax    d        ; BDOS current disk
  426.     ;
  427.     ;    $$$.SUB drive 
  428.     ;
  429.     mvi     l,tempdrv 
  430.     inx     b         ;.SUBFCB
  431.     mov     a,m
  432.     stax     b        ; $$$.SUB drive = temporary drive
  433.     ;    
  434.     ;    check for program chain
  435.     ;
  436.     pop    h        ;HL =.ccpflag1
  437.     mov    a,m
  438.     ani    chainflg    ;is it a chain function (47)
  439.     jz     ckboot        ;jump if not
  440.     lxi     h,buf 
  441. chain:    lxi     d,cbufl 
  442.     mvi     c,tpa-buf-1
  443.     mov    a,c
  444.     stax    d
  445.     inx    d
  446.     call     move        ;hl = source, de = dest, c = count
  447.     jmp     ccpparse
  448.     ;    
  449.     ;    execute profile.sub ?
  450.     ;
  451. ckboot:    mvi    l,ccpflag3
  452.     mov    a,m
  453.     ani    coldboot    ;is this a cold start
  454.     jnz    ccpcr        ;jump if not
  455.     mov    a,m
  456.     ori    coldboot    ;set flag for next time
  457.     mov    m,a
  458.     sta    errflg        ;set to ignore errors
  459.     lxi    h,profile
  460.     jmp    chain        ;attempt to exec profile.sub
  461. profile:
  462.     db    'PROFILE.S',0
  463. ;
  464. ;
  465. ;
  466. ;************************************************************************
  467. ;
  468. ;    BUILT-IN COMMANDS (and errors) RETURN HERE
  469. ;
  470. ;************************************************************************
  471. ;
  472. ;
  473. ccpcr:
  474.     ;    enter here on each command or error condition
  475.     call    setccpflg
  476.     call     crlf
  477. ccpret:
  478.     lxi    h,stack-2    ;reset stack in case of error
  479.     sphl            ;preserve CCPRET on stack
  480.     xra    a
  481.     sta    line
  482.     lxi    h,ccpret    ;return for next builtin
  483.     push    h
  484.     call    setccpflg
  485.     dcx    h        ;.CCPFLAG1
  486.     mov    a,m
  487.     ani     subfilemask    ;check for $$$.SUB submit
  488.     jz     prompt
  489. ;
  490. ;
  491. ;
  492. ;************************************************************************
  493. ;
  494. ;    $$$.SUB file processing
  495. ;
  496. ;************************************************************************
  497. ;
  498. ;
  499.     lxi    d,cbufl        ;set DMA to command buffer
  500.     call    setbuf
  501.     mvi     c,openf
  502.     call     sudos        ;open it if flag on
  503.     mvi    c,cstatf    ;check for break if successful open
  504.     cz    sudos        ;^C typed?
  505.     jnz    subclose    ;delete $$$.SUB if break or open failed
  506.     lxi    h,subrr2
  507.     mov    m,a        ;zero high random record #
  508.     dcx    h
  509.     mov    m,a        ;zero middle random record #
  510.     dcx    h
  511.     push    h
  512.     lda     subrc 
  513.     dcr     a     
  514.     mov    m,a        ;set to read last record of file
  515.     mvi    c,rreadf
  516.     cp    sudos
  517.     pop    h
  518.     dcr    m        ;record count (truncate last record)
  519.     mvi    c,delf
  520.     cm    sudos
  521.     ora    a        ;error on read?
  522.     ;
  523.     ;
  524. subclose:
  525.     push    psw
  526.     mvi    c,trunf        ;truncate file (& close it)
  527.     call    sudos
  528.     pop    psw        ;any errors ?
  529.     jz    ccpparse    ;parse command if not
  530.     ;
  531.     ;
  532. subkill:
  533.     lxi     b,subfile
  534.     call     resetflg    ;turn off submit flag
  535.     mvi     c,delf
  536.     call     sudos        ;kill submit
  537. ;
  538. ;
  539. ;
  540. ;************************************************************************
  541. ;
  542. ;    GET NEXT COMMAND
  543. ;
  544. ;************************************************************************
  545. ;
  546. ;
  547.     ;
  548.     ;     prompt user
  549.     ;
  550. prompt:
  551.     lda     usernum
  552.     ora     a 
  553.     cnz     pdb        ;print user # if non-zero
  554.     call    dirdrv1
  555.     mvi     a,'>' 
  556.     call     putc
  557.     ;
  558.     if multi
  559.     ;move ccpconbuf addr to conbuffer addr
  560.     lxi    d,ccpconbuf*256+conbuffer
  561.     call    wordmov        ;process multiple command, unless in submit
  562.     ora    a        ;non-zero => multiple commands active
  563.     push    psw        ;save A=high byte of ccpconbuf
  564.     lxi    b,ccpbdos
  565.     cnz    resetflg    ;turn off BDOS flag if multiple commands
  566.     endif
  567.     call    rcln        ;get command line from console
  568.     call    resetccpflg    ;turn off BDOS, SUBMIT & GET ccp flags
  569.     if multi
  570.     pop    psw        ;D=high byte of ccpconbuf
  571.     cnz    multisave    ;save multiple command buffer
  572.     endif
  573. ;
  574. ;
  575. ;
  576. ;************************************************************************
  577. ;
  578. ;    PARSE COMMAND
  579. ;
  580. ;************************************************************************
  581. ;
  582. ;
  583. ccpparse:    
  584.     ;
  585.     ;    reset default page mode 
  586.     ;    (in case submit terminated)
  587.     ;
  588.     call    subtest        ;non-zero if submit is active
  589.     jnz    get$pg$mode    ;skip, if so
  590. set$pg$mode:
  591.     mvi    l,page$def
  592.     mov    a,m        ;pick up default
  593.     dcx    h
  594.     mov    m,a        ;place in mode
  595. get$pg$mode:
  596.     mvi    l,page$mode
  597.     mov    a,m
  598.     sta    pgmode
  599.     ;
  600.     ;check for multiple commands
  601.     ;convert to upper case
  602.     ;reset ccp flag, in case entered from a CHAIN (or profile)
  603.     ;
  604.     call    uc        ;convert to upper case, ck if multiple command
  605.     rz            ;get another line if null or comment
  606.     ;
  607.     ;transient or built-in command?
  608.     ;
  609.     lxi    d,ufcb        ;include user number byte in front of FCB
  610.     call    gcmd        ;parse command name
  611.     lda    fcb+9        ;file type specified?
  612.     cpi    ' '
  613.     jnz    ccpdisk2    ;execute from disk, if so
  614.     lxi    h,ufcb        ;user or drive specified?
  615.     mov    a,m        ;user number
  616.     inx    h
  617.     ora    m        ;drive
  618.     inx    h
  619.     mov    a,m        ;get 1st character of filename
  620.     jnz    ccpdisk3    ;jump if so
  621.     ;
  622.     ;BUILT-IN HANDLER
  623.     ;
  624. ccpbuiltin:
  625.     lxi    h,ctbl        ;search table of internal commands
  626.     lxi    d,fcb+1
  627.     lda    fcb+3
  628.     cpi    ' '+1        ;is it shorter that 3 characters?
  629.     cnc    tbls        ;is it a built-in?
  630.     jnz    ccpdisk0    ;load from disk if not
  631.     lda    option        ;[ in command line?
  632.     ora    a        ;options specified?
  633.     mov    a,b        ;built-in index from tbls
  634.     lhld    parsep
  635.     shld    errsav        ;save beginning of command tail
  636.     lxi    h,ptbl        ;jump to processor if options not
  637.     jz    tblj        ;specified
  638.     cpi    4
  639.     jc    trycom
  640.     lxi    h,fcb+4
  641.     jnz    ccpdisk0    ;if DIRS then look for DIR.COM
  642.     mvi    m,' '
  643.     ;
  644.     ;LOAD TRANSIENT (file type unspecified)
  645.     ;
  646. ccpdisk0:
  647.     lxi    b,order
  648.     call    getflg        ;0=COM   8=COM,SUB  16=SUB,COM
  649.     jz    ccpdisk2    ;search for COM file only
  650.     mvi    b,8        ;=> 2nd choice is SUB
  651.     sub    b        ;now a=0 (COM first) or 8 (SUB first)
  652.     jz    ccpdisk1    ;search for COM first then SUB
  653.     mvi    b,0        ;search for SUB first then COM
  654.  
  655. ccpdisk1:
  656.     push    b        ;save 2nd type to try
  657.     call    settype        ; A = offset of type in type table
  658.     call    exec        ;try to execute, return if unsuccessful
  659.     pop    psw        ;try 2nd type 
  660.     call    settype
  661.     ;
  662.     ;LOAD TRANSIENT (file type specified)
  663.     ;
  664. ccpdisk2:
  665.     call    exec
  666.     jmp    perror        ;error if can't find it
  667.     ;
  668.     ;DRIVE SPECIFIED (check for change drives/users command)
  669.     ;
  670. ccpdisk3:
  671.     cpi    ' '        ;check for filename
  672.     jnz    ccpdisk0    ;execute from disk if specified
  673.     call    eoc        ;error if not end of command
  674.     lda    ufcb        ;user specified?
  675.     sui    1
  676.     jc    ccpdrive
  677.  
  678. ccpuser:
  679.     sta    usernum        ;CCP's user number
  680.     mvi    b,ccpusr
  681.     call    setbyte        ;save it in SCB
  682.     call    setuser        ;set current user
  683.  
  684. ccpdrive:
  685.     lda    fcb        ;drive specified?
  686.     dcr    a
  687.     rm            ;return if not
  688.     push    psw
  689.     call    select
  690.     pop    psw
  691.     sta    disk        ;CCP's drive
  692.     mvi    b,ccpdrv
  693.     jmp    setbyte        ;save it in SCB
  694.  
  695. ;;
  696. ;
  697. ;************************************************************************
  698. ;
  699. ;    BUILT-IN COMMANDS 
  700. ;
  701. ;************************************************************************
  702. ;
  703. ;
  704. ;    Table of internal ccp commands
  705. ;
  706. ;
  707. ctbl:    db    'DIR '
  708.     db    'TYPE '
  709.     db    'ERASE '
  710.     db    'RENAME '
  711.     db    'DIRSYS '
  712.     db    'USER '
  713.     db    0
  714. ;
  715. ptbl:    dw    dir
  716.     dw    type
  717.     dw    era
  718.     dw    ren
  719.     dw    dirs
  720.     dw    user
  721. ;;
  722. ;;-----------------------------------------------------------------------
  723. ;;
  724. ;;    DIR Command
  725. ;;
  726. ;;    DIR        list directory of current default user/drive
  727. ;;    DIR <X>:    list directory of user/drive <X>
  728. ;;    DIR <AFN>    list all files on the current default user/drive
  729. ;;            with names that match <AFN>
  730. ;;    DIR <X>:<AFN>    list all files on user/drive <X> with names that
  731. ;;            match <AFN>
  732. ;;
  733. ;;-----------------------------------------------------------------------
  734. ;;
  735. ;
  736.     if newdir
  737. dirdrv:
  738.     lda    dfcb        ;get disk number
  739.     endif
  740.  
  741. dirdrv0:
  742.     dcr    a
  743.     jp    dirdrv2
  744.  
  745. dirdrv1:
  746.     lda    disk        ;get current disk
  747. dirdrv2:
  748.     adi    'A'
  749.     jmp    pfc        ;print it (save BC,DE)
  750. ;
  751. ;
  752.     if newdir
  753. dir:
  754.     mvi    c,0        ;flag for DIR (normal)
  755.     lxi    d,sysfiles
  756.     jmp    dirs1
  757. ;
  758. ;
  759. dirs:
  760.     mvi    c,080h        ;flag for DIRS (system)
  761.     lxi    d,dirfiles
  762.  
  763. dirs1:    push    d
  764.     call    direct
  765.     pop    d        ;de = .system files message
  766.     jz    nofile        ;jump if no files found
  767.     mov    a,l        ;A = number of columns
  768.     cmp    b        ;did we print any files?
  769.     cnc    crlf        ;print crlf if so
  770.     lxi    h,anyfiles
  771.     dcr    m
  772.     inr    m
  773.     rz            ;return if no files 
  774.                 ;except those requested
  775.     dcr    m        ;set to zero
  776.     jmp    pmsgnl        ;tell the operator other files exist
  777. ;
  778. ;
  779. direct:
  780.     push    b        ;save DIR/DIRS flag
  781.     call    sbuf80        ;set DMA = 80h
  782.     call    gfn        ;parse file name
  783.     lxi    d,dfcb+1
  784.     ldax    d
  785.     cpi    ' '
  786.     mvi    b,11
  787.     cz    setmatch    ;use "????????.???" if none
  788.     call    eoc        ;make sure there's nothing else
  789.     call    srchf        ;search for first directory entry
  790.     pop    b
  791.     rz            ;if no files found
  792. dir0:
  793.     lda    dircols        ;number of columns for dir
  794.     mov    l,a
  795.     mov    b,a
  796.     inr    b        ;set # names to print per line (+1)
  797. dir1:
  798.     push    h        ;L=#cols, B=curent col, C=dir/dirs 
  799.     lxi    h,10        ;get byte with SYS bit
  800.     dad    d
  801.     mov    a,m
  802.     pop    h
  803.     ani    80h        ;look at SYS bit
  804.     cmp    c        ;DIR/DIRS flag in C
  805.     jz    dir2        ;display, if modes agree
  806.     mvi    a,1        ;set anyfiles true
  807.     sta    anyfiles
  808.     jmp    dir3        ;don't print anything
  809. ;
  810. ;    display the filename
  811. ;
  812. dir2:
  813.     dcr    b
  814.     cz    dirln        ;sets no. of columns, puts crlf
  815.     mov    a,b        ;number left to print on line
  816.     cmp    l        ;is current col = number of cols
  817.     cz    dirdrv        ;display the drive, if so
  818.     mvi    a,':'
  819.     call    pfc        ;print colon
  820.     call    space
  821.     call    pfn        ;print file name
  822.     call    space        ;pad with space
  823. dir3:    
  824.     push    b        ;save current col(B), DIR/DIRS(C)
  825.     push    h        ;save number of columns(L)
  826.     call    break        ;drop out if keyboard struck
  827.     call    srchn        ;search for another match
  828.     pop    h
  829.     pop    b
  830.     jnz    dir1
  831. direx:
  832.     inr    a        ;clear zero flag 
  833.     ret
  834.  
  835.     else
  836.  
  837. dirs:    ; display system files only
  838.     mvi    a,0d2h        ; JNC instruction
  839.     sta    dir11        ; skip on non-system files
  840. ;
  841. dir:    ; display non-system files only
  842.     lxi    h,ccpcr
  843.     push    h        ; push return address
  844.     call    gfn        ;parse file name
  845.     inx    d
  846.     ldax    d
  847.     cpi    ' '
  848.     mvi    b,11
  849.     cz    setmatch    ;use "????????.???" if none
  850.     call    eoc        ;make sure there's nothing else
  851.     call    findone        ;search for first directory entry
  852.     jz    dir4
  853.     mvi    b,5        ;set # names to print per line
  854. dir1:    lxi    h,10        ;get byte with SYS bit
  855.     dad    d
  856.     mov    a,m
  857.     ral            ;look at SYS bit
  858. dir11:    jc    dir3        ;don't print it if SYS bit set
  859.     mov    a,b
  860.     push    b
  861. dir2:    lxi    h,9        ;get byte with R/O bit
  862.     dad    d
  863.     mov    a,m
  864.     ral            ;look at R/O bit
  865.     mvi    a,' '        ;print space if not R/O
  866.     jnc    dir21        ;jump if not R/O
  867.     mvi    a,'*'        ;print star if R/O
  868. dir21:    call    pfc        ;print character
  869.     call    pfn        ;print file name
  870.     mvi    a,13        ;figure out how much padding is needed
  871.     sub    c
  872. dir25:    push    psw
  873.     call    space        ;pad it out with spaces
  874.     pop    psw
  875.     dcr    a
  876.     jnz    dir25        ;loop if more required
  877.     pop    b
  878.     dcr    b        ;decrement # names left on line
  879.     jnz    dir3
  880.     call    crlf        ;go to new line
  881.     mvi    b,5        ;set # names to print on new line
  882. dir3:    push    b
  883.     call    break        ;drop out if keyboard struck
  884.     call    srchn        ;search for another match
  885.     pop    b
  886.     jnz    dir1
  887.  
  888. dir4:    mvi    a,0dah        ;JC instruction
  889.     sta    dir11        ;restore normal dir mode (skip system files)
  890.     jmp    ccpcr
  891.  
  892.     endif
  893.  
  894. ;;
  895. ;;-----------------------------------------------------------------------
  896. ;;
  897. ;;    TYPE command
  898. ;;
  899. ;;    TYPE <UFN>    Print the contents of text file <UFN> on
  900. ;;            the console.
  901. ;;
  902. ;;-----------------------------------------------------------------------
  903. ;;
  904. type:    lxi    h,ccpcr
  905.     push    h        ;push return address
  906.     call    getfn        ;get and parse filename
  907.     mvi    a,127        ;initialize buffer pointer
  908.     sta    bufp
  909.     mvi    c,openf
  910.     call    sbdosf        ;open file if a filename was typed
  911. type1:    call    break        ;exit if keyboard struck
  912.     call    getb        ;read byte from file
  913.     rnz            ;exit if physical eof or read error
  914.     cpi    eof        ;check for eof character
  915.     rz            ;exit if so
  916.     call    putc        ;print character on console
  917.     jmp    type1        ;loop
  918. ;
  919. ;;-----------------------------------------------------------------------
  920. ;;
  921. ;;    USER command
  922. ;;
  923. ;;    USER <NN>    Set the user number
  924. ;;
  925. ;;-----------------------------------------------------------------------
  926. ;;
  927. user:
  928.     lxi    d,unmsg        ;Enter User #:
  929.     call    getprm
  930.     call    gdn        ;convert to binary
  931.     rz            ;return if nothing typed
  932.     jmp    ccpuser        ;set user number 
  933. ;
  934. ;;-----------------------------------------------------------------------
  935. ;;
  936. ;;    ERA command
  937. ;;
  938. ;;    ERA <AFN>    Erase all file on the current user/drive
  939. ;;            which match <AFN>.
  940. ;;    ERA <X>:<AFN>    Erase all files on user/drive <X> which
  941. ;;            match <AFN>.
  942. ;;
  943. ;;-----------------------------------------------------------------------
  944. ;;
  945. era:    call    getfn        ;get and parse filename
  946.     jz    era1
  947.     call    ckafn        ;is it ambiguous?
  948.     jnz    era1
  949.     lxi    d,eramsg
  950.     call    pmsg
  951.     lhld    errorp
  952.     mvi    c,' '        ;stop at exclamation mark or 0
  953.     call    pstrg        ;echo command
  954.     lxi    d,confirm
  955.     call    getc
  956.     call    crlf
  957.     mov    a,l        ;character in L after CRLF routine
  958.     ani    5fh        ;convert to U/C
  959.     cpi    'Y'        ;Y (yes) typed?
  960.     rnz            ;return, if not
  961.     ora    a        ;reset zero flag
  962. era1:    mvi    c,delf    
  963.     jmp    sbdosf
  964.  
  965. ;;-----------------------------------------------------------------------
  966. ;;
  967. ;;
  968. ;;    REN command
  969. ;;
  970. ;;-----------------------------------------------------------------------
  971. ;;
  972. ren:    call    gfn        ;zero flag set if nothing entered
  973.     push    psw        
  974.     lxi    h,16
  975.     dad    d
  976.     xchg
  977.     push    d        ;DE = .dfcb+16
  978.     push    h        ;HL = .dfcb
  979.     mvi    c,16
  980.     call    move        ;DE = dest, HL = source
  981.     call    gfn
  982.     pop    h        ;HL=.dfcb
  983.     pop    d        ;DE=.dfcb+16
  984.     call    drvok
  985.     mvi    c,renf        ;make rename call
  986.     pop    psw        ;zero flag set if nothing entered
  987. ;
  988. ;;-----------------------------------------------------------------------
  989. ;;
  990. ;;    BUILT-IN COMMAND BDOS CALL & ERROR HANDLERS
  991. ;;
  992. ;;-----------------------------------------------------------------------
  993. ;
  994. sbdosf:
  995.     push    psw
  996.     cnz    eoc        ;make sure there's nothing else
  997.     pop    psw
  998.     lxi    d,dfcb
  999.     mvi    b,0ffh
  1000.     mvi    h,1        ;execute disk command if we don't call
  1001.     cnz    bdosf        ;call if something was entered
  1002.     rnz            ;return if successful
  1003.  
  1004. ferror:
  1005.     dcr    h        ;was it an extended error?
  1006.     jm    nofile
  1007.     lhld    errsav
  1008.     shld    parsep
  1009. trycom:    call    exec
  1010.     call     pfn
  1011.     lxi    d,required
  1012.     jmp    builtin$err
  1013. ;
  1014. ;;-----------------------------------------------------------------------
  1015. ;
  1016. ;
  1017. ;    check for drive conflict
  1018. ;    HL =  FCB 
  1019. ;    DE =  FCB+16
  1020. ;
  1021. drvok:    ldax    d        ;get byte from 2nd fcb
  1022.     cmp    m        ;ok if they match
  1023.     rz
  1024.     ora    a        ;ok if 2nd is 0
  1025.     rz
  1026.     inr    m        ;error if the 1st one's not 0
  1027.     dcr    m
  1028.     jnz    perror
  1029.     mov    m,a        ;copy from 2nd to 1st
  1030.     ret
  1031. ;;-----------------------------------------------------------------------
  1032. ;;
  1033. ;;    check for ambiguous reference in file name/type
  1034. ;;
  1035. ;;    entry:    b  = length of string to check (ckafn0)
  1036. ;;        de = fcb area to check (ckafn0) - 1
  1037. ;;    exit:    z  = set if any ? in file reference (ambiguous)
  1038. ;;        z  = clear if unambiguous file reference
  1039. ;;
  1040. ckafn:
  1041.         mvi    b,11        ;check entire name and type
  1042. ckafn0:        inx    d
  1043.         ldax    d
  1044.         cpi    '?'        ;is it an ambiguous file name
  1045. if newera
  1046.         rz            ;return true if any afn
  1047. else
  1048.         rnz            ;return true only if *.*
  1049. endif
  1050.         dcr    b
  1051.         jnz    ckafn0
  1052. if newera
  1053.         dcr    b        ;clear zero flag to return false
  1054. endif
  1055.         ret            ;remove above DCR to return true
  1056. ;;
  1057. ;;-----------------------------------------------------------------------
  1058. ;;
  1059. ;;    get parameter (generally used to get a missing one)
  1060. ;;
  1061. getprm:
  1062.     call    skps        ;see if already there
  1063.     rnz            ;return if so
  1064. getp0:
  1065.     if prompts
  1066.     push    d
  1067.     lxi    d,enter
  1068.     call    pmsg
  1069.     pop    d
  1070.     endif
  1071.     call    pmsg        ;print prompt
  1072.     call    rcln        ;get response
  1073.     jmp    uc        ;convert to upper case
  1074. ;
  1075. ;;
  1076. ;;-----------------------------------------------------------------------
  1077.     if    not newdir
  1078. ;;
  1079. ;;    search for first file, print "No File" if none
  1080. ;;
  1081. findone:
  1082.     call    srchf
  1083.     rnz            ;found
  1084.     endif
  1085. ;;-----------------------------------------------------------------------
  1086.  
  1087. nofile:
  1088.     lxi    d,nomsg        ;tell user no file found
  1089. builtin$err:
  1090.     call    pmsgnl
  1091.     jmp    ccpret
  1092.  
  1093. ;
  1094. ;
  1095. ;************************************************************************
  1096. ;
  1097. ;    EXECUTE DISK RESIDENT COMMAND
  1098. ;
  1099. ;************************************************************************
  1100. ;
  1101. ;
  1102. xfcb:    db    0,'SUBMIT  COM'    ;processor fcb
  1103. ;
  1104. ;
  1105. ;    execute submit file  (or any other processor)
  1106. ;
  1107. xsub:                ;DE = .fcb
  1108.     ldax    d
  1109.     mvi    b,clp$drv
  1110.     call    setbyte        ;save submit file drive
  1111.     lxi    h,xfcb
  1112.     mvi    c,12
  1113.     call    move        ;copy processor into fcb
  1114.     lxi    h,cbufl        ;set parser pointer back to beginning
  1115.     mvi    m,' '
  1116.     inx    h        ;move past blank
  1117.     shld    parsep
  1118. ;                 execute SUBMIT.COM
  1119. ;
  1120. ;    
  1121. ;    execute disk resident command (return if not found or error)
  1122. ;
  1123. exec:
  1124.     ;try to open and execute fcb
  1125.     lxi    d,fcb+9
  1126.     lxi    h,typtbl
  1127.     call    tbls        ;search for type in type table
  1128.     rnz            ;return if no match
  1129.     lxi    d,ufcb
  1130.     ldax    d        ;check to see if user specified
  1131.     ora    a
  1132.     rnz            ;return if so
  1133.     inx    d
  1134.     ldax    d        ;check if drive specified
  1135.     mov    c,a
  1136.     push    b        ;save type (B) and drive (C)
  1137.     mvi    c,0        ;try only 1 open if drive specified
  1138.     ora    a
  1139.     jnz    exec1        ;try to open as specified
  1140.     lxi    b,(drv0-1)*256+4;try upto four opens from drv chain
  1141.     lda    disk
  1142.     inr    a
  1143.     mov    h,a        ;save default disk in H
  1144.     mvi    l,1        ;allow only 1 match to default disk
  1145. exec0:    inr    b        ;next drive to try in SCB drv chain
  1146.     dcr    c        ;any more tries?
  1147.     mov    a,c
  1148.     push    h
  1149.     cp    getbyte
  1150.     pop    h
  1151.     ora    a
  1152.     jm    exec3
  1153.     jz    exec01        ;jump if drive is 0 (default drive)
  1154.     cmp    h        ;is it the default drive
  1155.     jnz    exec02        ;jump if not
  1156. exec01:    mov    a,h        ;set drive explicitly
  1157.     dcr    l        ;is it the 2nd reference 
  1158.     jm    exec0        ;skip, if so
  1159. exec02:    stax    d        ;put drive in FCB
  1160. exec1:    push    b        ;save drive offset(B) & count(C)
  1161.     push    h
  1162.     call    opencom        ;on default drive & user
  1163.     pop    h
  1164.     pop    b
  1165.     jz    exec0        ;try next if open unsuccessful
  1166. ;
  1167. ;    successful open, now jump to processor
  1168. ;    
  1169. exec2:
  1170.     if    dayfile
  1171.     lxi    b,display
  1172.     call    getflg
  1173.     jz    exec21
  1174.     ldax    d
  1175.     call    dirdrv0
  1176.     mvi    a,':'
  1177.     call    pfc
  1178.     push    d
  1179.     call    pfn
  1180.     pop    d
  1181.     push    d
  1182.     lxi    h,8
  1183.     dad    d
  1184.     mov    a,m
  1185.     ani    80h
  1186.     lxi    d,userzero
  1187.     cnz    pmsg
  1188.     call    crlf
  1189.     pop    d
  1190.     endif
  1191. exec21:    pop    psw        ;recover saved command type
  1192.     lxi    h,xptbl
  1193. ;
  1194. ;    table jump
  1195. ;
  1196. ;    entry:    hl = address of table of addresses
  1197. ;        a  = entry # (0 thru n-1)
  1198. ;
  1199. tblj:    add    a        ;adjust for two byte entries
  1200.     call    addhla        ;compute address of entry
  1201.     push    d
  1202.     mov    e,m        ;fetch entry
  1203.     inx    h
  1204.     mov    d,m
  1205.     xchg
  1206.     pop    d
  1207.     pchl            ;jump to it
  1208. ;
  1209. typtbl:    db    'COM '
  1210.     db    'SUB '
  1211.     db    'PRL '
  1212.     db    0
  1213. ;
  1214. xptbl:    dw    xcom
  1215.     dw    xsub
  1216.     dw    xcom
  1217.  
  1218.  
  1219. ;
  1220. ;    unsuccessful attempt to open command file
  1221. ;
  1222. exec3:    pop    b        ;recover drive
  1223.     mov    a,c
  1224.     stax    d        ;replace in fcb
  1225.     ret
  1226. ;
  1227. ;
  1228. settype:
  1229.     ;set file type specified from type table
  1230.     ;a = offset (x2) of desired type (in bytes)
  1231.     rrc
  1232.     lxi    h,typtbl
  1233.     call    addhla        ;hl = type in type table
  1234.     lxi    d,fcb+9
  1235.     mvi    c,3
  1236.     jmp    move        ;move type into fcb
  1237. ;
  1238. ;
  1239. ;
  1240. ;    EXECUTE COM FILE
  1241. ;
  1242. xcom:                ;DE = .fcb
  1243.     ;
  1244.     ;    set up FCB for loader to use
  1245.     ;
  1246.     lxi    h,tpa
  1247.     shld    fcbrr        ;set load address to 100h
  1248.     lhld    realdos-1    ;put fcb in the loader's stack
  1249.     dcr    h        ;page below LOADER (or bottom RSX)
  1250.     mvi    l,0C0h        ;offset for FCB in page below the BDOS
  1251.     push    h        ;save for LOADER call
  1252.     ldax    d        ;get drive from fcb(0)
  1253.     sta    cmdrv        ;set command drive field in base page
  1254.     xchg
  1255.     mvi    c,35
  1256.     call    move        ;now move FCB to the top of the TPA
  1257.     ;    
  1258.     ;    set up base page
  1259.     ;
  1260.     lxi    h,errflg    ;tell parser to ignore errors
  1261.     inr    m
  1262. xcom3:    lhld    parsep
  1263.     dcx    h        ;backup over delimiter
  1264.     lxi    d,buf+1
  1265.     xchg
  1266.     shld    parsep        ;set parser to 81h
  1267.     call    copy0        ;copy command tail to 81h with
  1268.                 ;terminating 0 (returns A=length)
  1269.     sta    buf        ;put command tail length at 80h
  1270. xcom5:    call    gfn        ;parse off first argument
  1271.     shld    pass0
  1272.     mov    a,b
  1273.     sta    len0
  1274.     lxi    d,dfcb1
  1275.     call    gfn0        ;parse off second argument
  1276.     shld    pass1
  1277.     mov    a,b
  1278.     sta    len1
  1279. xcom7:    lxi    h,chaindsk        ;.CHAINDSK
  1280.     mov    a,m
  1281.     ora    a
  1282.     cp    select
  1283.     lda    usernum
  1284.     call    setuser        ;set default user, returns H=SCB
  1285.     add    a        ;shift user to high nibble
  1286.     add    a
  1287.     add    a
  1288.     add    a
  1289.     mvi    l,seldsk
  1290.     ora    m        ;put disk in low nibble
  1291.     sta    defdrv        ;set location 4 
  1292.     ;
  1293.     ;     initialize stack
  1294.     ;
  1295. xcom8:    pop    d            ;DE = .fcb
  1296.     lhld    realdos-1        ;base page of BDOS
  1297.     xra    a
  1298.     mov    l,a            ;top of stack below BDOS
  1299.     sphl                ;change the stack pointer for CCP
  1300.     mov     h,a            ;push warm start address on stack
  1301.     push     h            ;for programs returning to the CCP
  1302.     inr    h            ;Loader will return to TPA
  1303.     push    h            ;after loading a transient program
  1304.     ;
  1305.     ;    initialize fcb0(CR), console mode, program return code
  1306.     ;    & removable media open and login vectors
  1307.     ;
  1308. xcom9:    sta    7ch            ;clear next record to read
  1309.     mvi    b,con$mode
  1310.     call    setbyte            ;set to zero (turn off ^C status)
  1311.     mvi    l,olog
  1312.     mov    m,a            ;zero removable open login vector
  1313.     inx    h
  1314.     mov    m,a
  1315.     inx    h
  1316.     mov    m,a            ;zero removable media login vector
  1317.     inx    h
  1318.     mov    m,a
  1319.     mvi    l,ccpflag1
  1320.     mov    a,m
  1321.     ani    chain$flg        ;chaining?
  1322.     jnz    loader            ;load program without clearing
  1323.     mvi    l,prog$ret$code        ;the program return code
  1324.     mov    m,a            ;A=0
  1325.     inx    h
  1326.     mov    m,a            ;set program return = 0000h
  1327.     ;
  1328.     ;    call loader
  1329.     ;
  1330. loader:
  1331.     mov    a,m            ;reset chain flag if set,
  1332.     ani    not$chainflg        ;has no effect if we fell through
  1333.     mov    m,a
  1334.     mvi    c,loadf            ;use load RSX to load file
  1335.     jmp    bdos            ;now load it
  1336. ;
  1337. ;
  1338. ;
  1339. ;
  1340. ;************************************************************************
  1341. ;
  1342. ;    BDOS FUNCTION INTERFACE - Non FCB functions
  1343. ;
  1344. ;************************************************************************
  1345. ;
  1346. ;
  1347. ;
  1348. ;;-----------------------------------------------------------------------
  1349. ;;
  1350. ;;
  1351. ;;
  1352. ;;    print character on terminal
  1353. ;;    pause if screen is full
  1354. ;;    (BDOS function #2)
  1355. ;;
  1356. ;;    entry:    a  = character (putc entry)
  1357. ;;        e  = character (putc2 entry)
  1358. ;;
  1359.  
  1360. putc:    cpi    lf        ;end of line?
  1361.     jnz    putc1        ;jump if not
  1362.     lxi    h,pgsize    ;.pgsize
  1363.     mov    a,m        ;check page size
  1364.     inx    h        ;.line
  1365.     inr    m        ;line=line+1
  1366.     sub    m        ;line=page?
  1367.     jnz    putc0        
  1368.     mov    m,a        ;reset line=0 if so
  1369.     inx    h        ;.pgmode
  1370.     mov    a,m        ;is page mode off?
  1371.     ora    a        ;page=0 if so
  1372.     lxi    d,more
  1373.     cz    getc        ;wait for input if page mode on
  1374.     cpi    ctrlc
  1375.     jz    ccpcr
  1376.     mvi    e,cr
  1377.     call    putc2        ;print a cr
  1378. putc0:    mvi    a,lf        ;print the end of line char
  1379. putc1:    mov    e,a
  1380. putc2:    mvi    c,coutf
  1381.     jmp    bdos
  1382.  
  1383. ;;
  1384. ;;-----------------------------------------------------------------------
  1385. ;;
  1386. ;;    get character from console
  1387. ;;    (BDOS function #1)
  1388. ;;
  1389. getc:    call    pmsg
  1390. getc1:    mvi    c,cinf
  1391.     jmp    bdos
  1392. ;;
  1393. ;;-----------------------------------------------------------------------
  1394. ;;
  1395. ;;    print message string on terminal
  1396. ;;    (BDOS function #9)
  1397. ;;
  1398. pmsg:    mvi    c,pbuff
  1399.     jmp    bdos
  1400. ;;
  1401. ;;-----------------------------------------------------------------------
  1402. ;;
  1403. ;;    read line from console
  1404. ;;    (calls BDOS function #10)
  1405. ;;
  1406. ;;    exit:    z  = set if null line
  1407. ;;
  1408. ;;    This function uses the buffer "cbuf" (see definition of
  1409. ;;    function 10 for a description of the buffer).  All input
  1410. ;;    is converted to upper case after reading and the pointer
  1411. ;;    "parsep" is set to the begining of the first non-white
  1412. ;;    character string.
  1413. ;;
  1414. rcln:    lxi    h,cbufmx    ;get line from terminal
  1415.     mvi    m,comlen    ;set maximum buffer size
  1416.     xchg
  1417.     mvi    c,rbuff
  1418.     call    bdos
  1419.     lxi    h,cbufl        ;terminate line with zero byte
  1420.     mov    a,m
  1421.     inx    h
  1422.     call    addhla
  1423.     mvi    m,0        ;put zero at the end 
  1424.     jmp    crlf        ;advance to next line
  1425. ;
  1426. ;;
  1427. ;;-----------------------------------------------------------------------
  1428. ;;
  1429. ;;    exit routine if keyboard struck
  1430. ;;    (calls BDOS function #11)
  1431. ;;
  1432. ;;    Control is returned to the caller unless the console
  1433. ;;    keyboard has a character ready, in which case control
  1434. ;;    is transfer to the main program of the CCP.
  1435. ;;
  1436. break:    call    break1    
  1437.     rz
  1438.     jmp    ccpcr
  1439.  
  1440. break1:    mvi    c,cstatf
  1441.     call    rw
  1442.     rz
  1443.     mvi    c,cinf
  1444.     jmp    rw
  1445.  
  1446.  
  1447. ;;
  1448. ;;-----------------------------------------------------------------------
  1449. ;;
  1450. ;;    set disk buffer address
  1451. ;;    (BDOS function #26)
  1452. ;;
  1453. ;;    entry:    de -> buffer ("setbuf" only)
  1454. ;;
  1455. sbuf80:    lxi    d,buf
  1456. setbuf:    mvi    c,dmaf
  1457.     jmp    bdos
  1458. ;;
  1459. ;;-----------------------------------------------------------------------
  1460. ;;
  1461. ;;    select disk
  1462. ;;    (BDOS function #14)
  1463. ;;
  1464. ;;    entry:    a  = drive
  1465. ;;
  1466. select:
  1467.     mov    e,a
  1468.     mvi     c,self
  1469.     jmp     bdos
  1470. ;
  1471. ;;
  1472. ;;-----------------------------------------------------------------------
  1473. ;;
  1474. ;;    set user number
  1475. ;;    (BDOS function #32)
  1476. ;;
  1477. ;;    entry:    a  = user # 
  1478. ;;    exit:    H  = SCB page
  1479. ;;
  1480. setuser:
  1481.     mvi     b,usrcode 
  1482.     jmp     set$byte
  1483. ;
  1484. ;
  1485. ;
  1486. ;************************************************************************
  1487. ;
  1488. ;    BDOS FUNCTION INTERFACE - Functions with a FCB Parameter
  1489. ;
  1490. ;************************************************************************
  1491. ;
  1492. ;
  1493. ;;
  1494. ;;    open file 
  1495. ;;    (BDOS function #15)
  1496. ;;
  1497. ;;    exit:    z  = set if file not found
  1498. ;;
  1499. ;;
  1500. opencom:            ;open command file (SUB, COM or PRL)
  1501.     lxi    b,openf        ;b=0 => return error mode of 0
  1502.     lxi    d,fcb        ;use internal FCB
  1503.  
  1504. ;;    BDOS CALL ENTRY POINT   (used by built-ins)
  1505. ;;
  1506. ;;    entry:    b  = return error mode (must be 0 or 0ffh)
  1507. ;;        c  = function no.
  1508. ;;        de = .fcb
  1509. ;;    exit:    z  = set if error
  1510. ;;        de = .fcb
  1511. ;;
  1512. bdosf:    lxi    h,32        ;offset to current record
  1513.     dad    d        ;HL = .current record
  1514.     mvi    m,0        ;set to zero for read/write
  1515.     push    b        ;save function(C) & error mode(B)
  1516.     push    d        ;save .fcb
  1517.     ldax    d        ;was a disk specified?
  1518.     ana    b        ;and with 0 or 0ffh
  1519.     dcr    a        ;if so, select it in case
  1520.     cp    select        ;of permanent error (if errmode = 0ffh)
  1521.     lxi    d,passwd
  1522.     call    setbuf        ;set dma to password
  1523.     pop    d        ;restore .fcb
  1524.     pop    b        ;restore function(C) & error mode(B)
  1525.     push    d
  1526.     lhld    scbaddr
  1527.     mvi    l,errormode
  1528.     mov    m,b        ;set error mode
  1529.     push    h        ;save .errormode
  1530.     call    bdos
  1531.     pop    d        ;.errormode
  1532.     xra    a
  1533.     stax    d        ;reset error mode to 0
  1534.     lda    disk
  1535.     mvi    e,seldsk
  1536.     stax    d        ;reset current disk to default
  1537.     push    h        ;save bdos return values
  1538.     call    sbuf80
  1539.     pop    h        ;bdos return
  1540.     inr    l        ;set z flag if error
  1541.     pop    d        ;restore .fcb
  1542.     ret
  1543. ;;
  1544. ;;-----------------------------------------------------------------------
  1545. ;;
  1546. ;;    close file 
  1547. ;;    (BDOS function #16)
  1548. ;;
  1549. ;;    exit:    z  = set if close error
  1550. ;;
  1551. ;;close:    mvi    c,closef
  1552. ;;        jmp    oc
  1553. ;;
  1554. ;;-----------------------------------------------------------------------
  1555. ;;
  1556. ;;    delete file 
  1557. ;;
  1558. ;;    exit:    z  = set if file not found
  1559. ;;
  1560. ;;    The match any character "?" may be used without restriction
  1561. ;;    for this function.  All matched files will be deleted.
  1562. ;;
  1563. ;;
  1564. ;;delete:
  1565. ;;    mvi    c,delf
  1566. ;;    jmp    oc
  1567. ;;
  1568. ;;-----------------------------------------------------------------------
  1569. ;;
  1570. ;;    create file 
  1571. ;;    (BDOS function #22)
  1572. ;;
  1573. ;;    exit:    z  = set if create error
  1574. ;;
  1575. ;;make:        mvi    c,makef
  1576. ;;        jmp    oc
  1577. ;;-----------------------------------------------------------------------
  1578. ;;
  1579. ;;    search for first filename match (using "DFCB" and "BUF")
  1580. ;;    (BDOS function #17)
  1581. ;;
  1582. ;;    exit:    z  = set if no match found
  1583. ;;        z  = clear if match found
  1584. ;;        de -> directory entry in buffer
  1585. ;;
  1586. srchf:    mvi    c,searf        ;set search first function
  1587.     jmp    srch
  1588. ;;
  1589. ;;-----------------------------------------------------------------------
  1590. ;;
  1591. ;;    search for next filename match (using "DFCB" and "BUF")
  1592. ;;    (BDOS function #18)
  1593. ;;
  1594. ;;    exit:    z  = set if no match found
  1595. ;;        z  = clear if match found
  1596. ;;        de -> directory entry in buffer
  1597. ;;
  1598. srchn:    mvi    c,searnf    ;set search next function
  1599. srch:    lxi    d,dfcb        ;use default fcb
  1600.     call    bdos
  1601.     inr    a        ;return if not found
  1602.     rz
  1603.     dcr    a        ;restore original return value
  1604.     add    a        ;shift to compute buffer pos'n
  1605.     add    a
  1606.     add    a
  1607.     add    a
  1608.     add    a
  1609.     lxi    h,buf        ;add to buffer start address
  1610.     call    addhla
  1611.     xchg            ;de -> entry in buffer
  1612.     xra    a        ;may be needed to clear z flag
  1613.     dcr    a        ;depending of value of "buf"
  1614.     ret
  1615. ;;
  1616. ;;-----------------------------------------------------------------------
  1617. ;;
  1618. ;;    read file 
  1619. ;;    (BDOS function #20)
  1620. ;;
  1621. ;;    entry:    hl = buffer address (readb only)
  1622. ;;    exit    z  = set if read ok
  1623. ;;
  1624. read:    xra    a        ;clear getc pointer
  1625.     sta    bufp
  1626.     mvi    c,readf
  1627.     lxi    d,dfcb
  1628. rw:    call    bdos
  1629.     ora    a
  1630.     ret
  1631. ;
  1632. ;;
  1633. ;;-----------------------------------------------------------------------
  1634. ;;
  1635. ;;    $$$.SUB interface
  1636. ;;
  1637. ;;    entry:    c = bdos function number
  1638. ;;    exit    z  = set if successful
  1639.  
  1640. sudos:    lxi    d,subfcb
  1641.     jmp    rw
  1642. ;
  1643. ;
  1644. ;
  1645. ;************************************************************************
  1646. ;
  1647. ;    COMMAND LINE PARSING SUBROUTINES 
  1648. ;
  1649. ;************************************************************************
  1650. ;
  1651. ;------------------------------------------------------------------------
  1652. ;
  1653. ;    COMMAND LINE PREPARSER
  1654. ;    reset function 10 flag
  1655. ;    set up parser
  1656. ;    convert to upper case
  1657. ;
  1658. ;    All input is converted to upper case and the pointer
  1659. ;    "parsep" is set to the begining of the first non-blank
  1660. ;    character string.  If the line begins with a ; or :, it
  1661. ;    is treated specially:
  1662. ;
  1663. ;        ;    comment     the line is ignored
  1664. ;        :    conditional    the line is ignored if a fatal
  1665. ;                    error occured during the previous
  1666. ;                    command, otherwise the : is 
  1667. ;                    ignored
  1668. ;
  1669. ;    An exclamation point is used to separate multiple commands on a 
  1670. ;    a line.  Two adjacent exclaimation points translates into a single 
  1671. ;    exclaimation point in the command tail for compatibility.
  1672. ;------------------------------------------------------------------------
  1673. ;
  1674. ;
  1675. uc:
  1676.     call    resetccpflg
  1677.     xchg            ;DE = .SCB
  1678.     xra    a
  1679.     sta    option        ;zero option flag
  1680.     lxi    h,cbuf
  1681.     call    skps1        ;skip leading spaces/tabs
  1682.     xchg
  1683.     cpi    ';'        ;HL = .scb
  1684.     rz
  1685.     cpi    '!'
  1686.     jz    uc0
  1687.     cpi    ':'
  1688.     jnz    uc1
  1689.     mvi    l,prog$ret$code
  1690.     inr    m
  1691.     inr    m        ;was ^C typed? (low byte 0FEh)
  1692.     jz    uc0        ;successful, if so
  1693.     inx    h
  1694.     inr    m        ;is high byte 0FFh?
  1695.     rz            ;skip command, if so
  1696. uc0:    inx    d        ;skip over 1st character
  1697. uc1:    xchg            ;HL=.command line
  1698.     shld    parsep        ;set parse pointer to beginning of line
  1699. uc3:    mov    a,m        ;convert lower case to upper
  1700.     cpi    '['
  1701.     jnz    uc4
  1702.     sta    option        ;'[' is the option delimiter => command option
  1703. uc4:    cpi    'a'
  1704.     jc    uc5
  1705.     cpi    'z'+1
  1706.     jnc    uc5
  1707.     sui    'a'-'A'
  1708.     mov    m,a
  1709. uc5:
  1710.     if multi
  1711.     cpi    '!'
  1712.     cz    multistart    ;HL=.char, A=char
  1713.     endif
  1714.     inx    h        ;advance to next character
  1715.     ora    a        ;loop if not end of line
  1716.     jnz    uc3
  1717. ;
  1718. ;    skip spaces
  1719. ;    return with zero flag set if end of line
  1720. ;
  1721. skps:    lhld    parsep        ;get current position
  1722. skps1:    shld    parsep        ;save position
  1723.     shld    errorp        ;save position for error message
  1724.     mov    a,m
  1725.     ora    a        ;return if end of command
  1726.     rz
  1727.     cpi    ' '
  1728.     jz    skps2
  1729.     cpi    tab        ;skip spaces & tabs
  1730.     rnz
  1731. skps2:    inx    h        ;advance past space/tab
  1732.     jmp    skps1        ;loop
  1733. ;
  1734. ;-----------------------------------------------------------------------
  1735. ;
  1736. ;    MULTIPLE COMMANDS PER LINE HANDLER
  1737. ;
  1738. ;-----------------------------------------------------------------------
  1739.     if multi
  1740.  
  1741. multistart:
  1742.     ;
  1743.     ;    A  = current character in command line
  1744.     ;    HL = address of current character in command line
  1745.     ;
  1746.     ;double exclaimation points become one
  1747.     mov    e,l
  1748.     mov    d,h
  1749.     inx    d
  1750.     ldax    d
  1751.     cpi    '!'        ;double exclaimation points
  1752.     push    psw
  1753.     push    h
  1754.     cz    copy0        ;convert to one, if so
  1755.     pop    h
  1756.     pop    psw
  1757.     rz
  1758.     ;we have a valid multiple command line
  1759.     mvi    m,0        ;terminate command line here
  1760.     xchg
  1761.     ;multiple commands not allowed in submits
  1762.     ;NOTE: submit unravels multiple commands making the
  1763.     ;following test unnecessary.  However, with GET[system]
  1764.     ;or CP/M 2.2 SUBMIT multiple commands will be posponed 
  1765.     ;until the entire submit completes...  
  1766. ;    call    subtest        ;submit active
  1767. ;    mvi    a,0        
  1768. ;    rnz            ;return with A=0, if so
  1769.     ;set up the RSX buffer
  1770.     lhld    osbase        ;get high byte of TPA address
  1771.     dcr    h        ;subtract 1 page for buffer
  1772.     mvi    l,endchain    ;HL = RSX buffer base-1
  1773.     mov    m,a        ;set end of chain flag to 0
  1774.     push    h        ;save it 
  1775. multi0:    inx    h
  1776.     inx    d
  1777.     ldax    d        ;get character from cbuf
  1778.     mov    m,a        ;place in RSX
  1779.     cpi    '!'
  1780.     jnz    multi1
  1781.     mvi    m,cr        ;change exclaimation point to cr
  1782. multi1:    ora    a
  1783.     jnz    multi0
  1784.     mvi    m,cr        ;end last command with cr
  1785.     inx    h
  1786.     mov    m,a        ;terminate with a zero
  1787.     ;set up RSX prefix
  1788.     mvi    l,6        ;entry point
  1789.     mvi    m,jmp        ;put a jump instruction there
  1790.     inx    h
  1791.     mvi    m,9        ;make it a jump to base+9 (RSX exit)
  1792.     inx    h
  1793.     mov    m,h    
  1794.     inx    h        ;HL = RSX exit point
  1795.     mvi    m,jmp        ;put a jump instruction there
  1796.     mvi    l,warmflg    ;HL = remove on warm start flag
  1797.     mov    m,a        ;set (0) for RSX to remain resident
  1798.     mov    l,a        ;set low byte to 0 for fixchain
  1799.     xchg            ;DE = RSX base
  1800.     call    fixchain    ;add the RSX to the chain
  1801.     ;save buffer address
  1802.     lhld    scbaddr
  1803.     mvi    l,ccpconbuf    ;save buffer address in CCP conbuf field
  1804.     pop    d        ;DE = RSX base
  1805.     inx    d
  1806.     mov    m,e
  1807.     inx    h
  1808.     mov    m,d
  1809.     mvi    l,multi$rsx$pg
  1810.     mov    m,d        ;save the RSX base
  1811.     xra    a        ;zero in a to fall out of uc
  1812.     ret
  1813.     ;
  1814.     ;
  1815.     ;    save the BDOS conbuffer address and
  1816.     ;    terminate RSX if necessary.
  1817.     ;
  1818. multisave:
  1819.     lxi    d,conbuffer*256+ccpconbuf
  1820.     call    wordmov        ;first copy conbuffer in case SUBMIT 
  1821.     ora    a        ;and/or GET are active
  1822.     lxi    d,conbuffl*256+ccpconbuf
  1823.     cz    wordmov        ;if conbuff is zero then conbufl has the 
  1824.     push    h        ;next address
  1825.     call    break1
  1826.     pop    h        ;H = SCB page
  1827.     mvi    l,ccpconbuf
  1828.     jnz    multiend
  1829.     mov    e,m
  1830.     inx    h
  1831.     mov    d,m        ;DE = next conbuffer address
  1832.     inr    m
  1833.     dcr    m        ;is high byte zero? 
  1834.     dcx    h        ;HL = .ccpconbuf
  1835.     jz    multiend    ;remove multicmd RSX if so
  1836.     ldax    d        ;check for terminating zero
  1837.     ora    a
  1838.     rnz            ;return if not
  1839.     ;
  1840.     ;    we have exhausted all the commands
  1841. multiend:
  1842.     ;    HL = .ccpconbuf
  1843.     xra    a
  1844.     mov    m,a        ;set buffer to zero
  1845.     inx    h
  1846.     mov    m,a
  1847.     mvi    l,multi$rsx$pg
  1848.     mov    h,m
  1849.     mvi    l,0eh        ;HL=RSX remove on warmstart flag
  1850.     dcr    m        ;set to true for removal
  1851.     jmp    rsx$chain    ;remove the multicmd rsx buffer
  1852.  
  1853.     endif
  1854. ;;
  1855. ;************************************************************************
  1856. ;
  1857. ;    FILE NAME PARSER
  1858. ;
  1859. ;************************************************************************
  1860. ;
  1861. ;
  1862. ;
  1863. ;    get file name (read in if none present)
  1864. ;
  1865. ;
  1866. ;;    The file-name parser in this CCP implements
  1867. ;;    a user/drive specification as an extension of the normal
  1868. ;;    CP/M drive selection feature.  The syntax of the
  1869. ;;    user/drive specification is given below.  Note that a
  1870. ;;    colon must follow the user/drive specification.
  1871. ;;
  1872. ;;    <a>:    <a> is an alphabetic character A-P specifing one
  1873. ;;        of the CP/M disk drives.
  1874. ;;
  1875. ;;    <n>:    <n> is a decimal number 0-15 specifying one of the
  1876. ;;        user areas.
  1877. ;;
  1878. ;;    <n><a>:    A specification of both user area and drive.
  1879. ;;
  1880. ;;    <a><n>:    Synonymous with above.
  1881. ;;
  1882. ;;    Note that the user specification cannot be included
  1883. ;;    in the parameters of transient programs or precede a file
  1884. ;;    name.  The above syntax is parsed by gcmd (get command).
  1885. ;;
  1886. ;; ************************************************************
  1887.  
  1888. getfn:
  1889.     if prompts
  1890.     lxi    d,fnmsg
  1891. getfn0:
  1892.     call    getprm
  1893.     endif
  1894. gfn:    lxi    d,dfcb
  1895. gfn0:    call    skps        ;sets zero flag if eol
  1896.     push    psw
  1897.     call     gfn2
  1898.     pop    psw
  1899.     ret
  1900.     ;
  1901.     ;    BDOS FUNCTION 152 INTERFACE
  1902.     ;
  1903.     ;entry:    DE = .FCB
  1904.     ;    HL = .buffer
  1905.     ;flags/A reg preserved
  1906.     ;exit:  DE = .FCB
  1907.     ;
  1908.     ;
  1909. gfn2:    shld    parsep
  1910.     shld    errorp
  1911.     push    d        ;save .fcb
  1912.     lxi    d,pfncb
  1913.     mvi    c,parsef
  1914. if func152
  1915.     call    bdos
  1916. else
  1917.     call    parse
  1918. endif
  1919.     pop    d        ;.fcb
  1920.     mov    a,h
  1921.     ora    l        ;end of command? (HL = 0)
  1922.     mov    b,m        ;get delimiter
  1923.     inx    h        ;move past delimiter
  1924.     jnz    gfn3
  1925.     lxi    h,zero+2    ;set HL = .0
  1926. gfn3:    mov    a,h
  1927.     ora    l        ;parse error? (HL = 0ffffh)
  1928.     jnz    gfn4
  1929.     lxi    h,zero+2
  1930.     call    perror        
  1931. gfn4:    mov    a,b
  1932.     cpi    '.'
  1933.     jnz    gfn6
  1934.     dcx    h
  1935. gfn6:    shld    parsep        ;update parse pointer
  1936. gfnpwd:    mvi    c,16
  1937.     lxi    h,pfcb
  1938.     push    d
  1939.     call    move
  1940.     lxi    d,passwd    ;HL = .disk map in pfcb
  1941.     mvi    c,10
  1942.     call    move        ;copy to passwd
  1943.     pop    d        ;HL = .password len
  1944.     mov    a,m
  1945. zero:    lxi    h,0        ;must be an "lxi h,0"
  1946.     ora    a        ;is there a password?
  1947.     mov    b,a
  1948.     jz    gfn8
  1949.     lhld    errorp        ;HL = .filename
  1950. gfn7:    mov    a,m
  1951.     cpi    ';'
  1952.     inx    h
  1953.     jnz    gfn7
  1954. gfn8:    ret            ;B = len, HL = .password
  1955.  
  1956. ;
  1957. ;    PARSE CP/M 3 COMMAND
  1958. ;    entry:    DE  = .UFCB  (user no. byte in front of FCB)
  1959. ;        PARSEP = .command line
  1960. gcmd:
  1961.     push    d
  1962.     xra    a
  1963.     stax    d        ;clear user byte
  1964.     inx    d
  1965.     stax    d        ;clear drive byte
  1966.     inx    d
  1967.     call    skps        ;skip leading spaces
  1968. ;
  1969. ;    Begin by looking for user/drive-spec.  If none if found,
  1970. ;    fall through to main file-name parsing section.  If one is found
  1971. ;    then branch to the section that handles them.  If an error occurs
  1972. ;    in the user/drive spec; treat it as a filename for compatibility
  1973. ;    with CP/M 2.2.  (e.g. STAT VAL: etc.)
  1974. ;
  1975.     lhld    parsep        ;get pointer to current parser position
  1976.     pop    d
  1977.     push    d        ;DE = .UFCB
  1978.     mvi    b,4        ;maximum length of user/drive spec
  1979. gcmd1:    mov    a,m        ;get byte
  1980.     cpi    ':'        ;end of user/drive-spec?
  1981.     jz    gcmd2        ;parse user/drive if so
  1982.     ora    a        ;end of command?
  1983.     jz    gcmd8        ;parse filename (Func 152), if so 
  1984.     dcr    b        ;maximum user/drive spec length exceeded?
  1985.     inx    h
  1986.     jnz    gcmd1        ;loop if not
  1987.     ;
  1988.     ;    Parse filename, type and password
  1989.     ;
  1990. gcmd8:
  1991.     pop    d
  1992.     xra    a
  1993.     stax    d        ;set user = default
  1994.     lhld    parsep
  1995. gcmd9:    inx    d        ;past user number byte
  1996.     ldax    d        ;A=drive
  1997.     push     psw
  1998.     call    gfn2        ;BDOS function 152 interface
  1999.     pop    psw
  2000.     stax    d
  2001.     ret
  2002.     ;
  2003.     ;    Parse the user/drive-spec
  2004.     ;
  2005. gcmd2:
  2006.     lhld    parsep        ;get pointer to beginning of spec
  2007.     mov    a,m        ;get character
  2008. gcmd3:    cpi    '0'        ;check for user number
  2009.     jc    gcmd4        ;jump if not numeric
  2010.     cpi    '9'+1
  2011.     jnc    gcmd4
  2012.     call    gdns        ;get the user # (returned in B)
  2013.     pop    d
  2014.     push    d
  2015.     ldax    d        ;see if we already have a user #
  2016.     ora    a
  2017.     jnz    gcmd8        ;skip if we do
  2018.     mov    a,b        ;A = specified user number 
  2019.     inr    a        ;save it as the user-spec
  2020.     stax    d
  2021.     jmp    gcmd5
  2022. gcmd4:    cpi    'A'        ;check for drive-spec
  2023.     jc    gcmd8        ;skip if not a valid drive character
  2024.     cpi    'P'+1
  2025.     jnc    gcmd8
  2026.     pop    d
  2027.     push    d
  2028.     inx    d
  2029.     ldax    d        ;see if we already have a drive
  2030.     ora    a
  2031.     jnz    gcmd8        ;skip if so
  2032.     mov    a,m
  2033.     sui    '@'        ;convert to a drive-spec
  2034.     stax    d
  2035.     inx    h
  2036. gcmd5:    mov    a,m        ;get next character
  2037.     cpi    ':'        ;end of user/drive-spec?
  2038.     jnz    gcmd3        ;loop if not
  2039.     inx    h
  2040.     pop    d        ;.ufcb
  2041.     jmp    gcmd9        ;parse the file name
  2042.  
  2043.  
  2044. ;
  2045. ;************************************************************************
  2046. ;
  2047. ;        TEMPORARY PARSE CODE
  2048. ;
  2049. ;************************************************************************
  2050. ;
  2051. if not func152
  2052. ;    version 3.0b  Oct 08 1982 - Doug Huskey
  2053. ;
  2054. ;
  2055.  
  2056. passwords    equ    true
  2057.  
  2058. parse:    ; DE->.(.filename,.fcb)
  2059.     ;
  2060.     ; filename = [d:]file[.type][;password]
  2061.     ;             
  2062.     ; fcb assignments
  2063.     ;
  2064.     ;   0     => drive, 0 = default, 1 = A, 2 = B, ...
  2065.     ;   1-8   => file, converted to upper case,
  2066.     ;            padded with blanks (left justified)
  2067.     ;   9-11  => type, converted to upper case,
  2068.     ;         padded with blanks (left justified)
  2069.     ;   12-15 => set to zero
  2070.     ;   16-23 => password, converted to upper case,
  2071.     ;         padded with blanks
  2072.     ;   26    => length of password (0 - 8)
  2073.     ;
  2074.     ; Upon return, HL is set to FFFFH if DE locates
  2075.     ;            an invalid file name;
  2076.     ; otherwise, HL is set to 0000H if the delimiter
  2077.     ;            following the file name is a 00H (NULL)
  2078.     ;          or a 0DH (CR);
  2079.     ; otherwise, HL is set to the address of the delimiter
  2080.     ;            following the file name.
  2081.     ;
  2082.     xchg
  2083.     mov    e,m        ;get first parameter
  2084.     inx    h
  2085.     mov    d,m
  2086.     push    d        ;save .filename
  2087.     inx    h
  2088.     mov    e,m        ;get second parameter
  2089.     inx    h
  2090.     mov    d,m
  2091.     pop    h        ;DE=.fcb  HL=.filename
  2092.     xchg
  2093. parse0:
  2094.     push    h        ;save .fcb
  2095.     xra    a
  2096.     mov    m,a        ;clear drive byte
  2097.     inx    h
  2098.     lxi    b,20h*256+11
  2099.     call    pad        ;pad name and type w/ blanks
  2100.     lxi    b,4
  2101.     call    pad        ;EXT, S1, S2, RC = 0
  2102.     lxi    b,20h*256+8
  2103.     call    pad        ;pad password field w/ blanks
  2104.     lxi    b,12
  2105.     call    pad
  2106.     call    skip
  2107. ;
  2108. ;    check for drive
  2109. ;
  2110.     ldax    d
  2111.     cpi    ':'        ;is this a drive?
  2112.     dcx    d
  2113.     pop    h
  2114.     push    h        ;HL = .fcb
  2115.     jnz    parse$name
  2116. ;
  2117. ;    Parse the drive-spec
  2118. ;
  2119. parsedrv:
  2120.     ldax    d        ;get character
  2121.     ani    5fh        ;convert to upper case
  2122.     sui    'A'
  2123.     jc    perr1
  2124.     cpi    16
  2125.     jnc    perr1
  2126.     inx    d
  2127.     inx    d        ;past the ':'
  2128.     inr    a        ;set drive relative to 1
  2129.     mov    m,a        ;store the drive in FCB(0)
  2130. ;
  2131. ;    Parse the file-name
  2132. ;
  2133. parse$name:
  2134.     inx    h        ;HL = .fcb(1)
  2135.     call    delim
  2136.     jz    parse$ok
  2137. if passwords
  2138.     lxi    b,7*256
  2139. else
  2140.     mvi    b,7
  2141. endif
  2142. parse6:    ldax    d        ;get a character
  2143.     cpi    '.'        ;file-type next?
  2144.     jz    parse$type    ;branch to file-type processing
  2145.     cpi    ';'
  2146.     jz    parsepw
  2147.     call    gfc        ;process one character
  2148.     jnz    parse6        ;loop if not end of name
  2149.     jmp    parse$ok
  2150. ;
  2151. ;    Parse the file-type
  2152. ;
  2153. parse$type:    
  2154.     inx    d        ;advance past dot
  2155.     pop    h
  2156.     push    h        ;HL =.fcb
  2157.     lxi    b,9
  2158.     dad    b        ;HL =.fcb(9)
  2159. if passwords
  2160.     lxi    b,2*256
  2161. else
  2162.     mvi    b,2
  2163. endif
  2164. parse8:    ldax    d
  2165.     cpi    ';'
  2166.     jz    parsepw
  2167.     call    gfc        ;process one character
  2168.     jnz    parse8        ;loop if not end of type
  2169. ;
  2170. parse$ok:
  2171.     pop    b
  2172.     push    d
  2173.     call    skip
  2174.     call    delim
  2175.     pop    h
  2176.     rnz
  2177.     lxi    h,0
  2178.     ora    a
  2179.     rz
  2180.     cpi    cr
  2181.     rz
  2182.     xchg
  2183.     ret
  2184. ;
  2185. ;    handle parser error
  2186. ;
  2187. perr:
  2188.     pop    b            ;throw away return addr
  2189. perr1:
  2190.     pop    b
  2191.     lxi    h,0ffffh
  2192.     ret
  2193. ;
  2194. if passwords
  2195. ;
  2196. ;    Parse the password
  2197. ;
  2198. parsepw:
  2199.     inx    d
  2200.     pop    h
  2201.     push    h
  2202.     lxi    b,16
  2203.     dad    b
  2204.     lxi    b,7*256+1
  2205. parsepw1:
  2206.     call    gfc
  2207.     jnz    parsepw1
  2208.     mvi    a,7
  2209.     sub    b
  2210.     pop    h
  2211.     push    h
  2212.     lxi    b,26
  2213.     dad    b
  2214.     mov    m,a
  2215.     ldax    d            ;delimiter in A
  2216.     jmp    parse$ok
  2217. else
  2218. ;
  2219. ;    skip over password
  2220. ;
  2221. parsepw:
  2222.     inx    d
  2223.     call    delim
  2224.     jnz    parsepw
  2225.     jmp    parse$ok
  2226. endif
  2227. ;
  2228. ;    get next character of name, type or password
  2229. ;
  2230. gfc:    call    delim        ;check for end of filename
  2231.     rz            ;return if so
  2232.     cpi    ' '        ;check for control characters
  2233.     inx    d
  2234.     jc    perr        ;error if control characters encountered
  2235.     inr    b        ;error if too big for field
  2236.     dcr    b
  2237.     jm    perr
  2238. if passwords
  2239.     inr    c
  2240.     dcr    c
  2241.     jnz    gfc1
  2242. endif
  2243.     cpi    '*'        ;trap "match rest of field" character
  2244.     jz    setwild
  2245. gfc1:    mov    m,a        ;put character in fcb
  2246.     inx    h
  2247.     dcr    b        ;decrement field size counter
  2248.     ora    a        ;clear zero flag
  2249.     ret
  2250. ;;
  2251. setwild:
  2252.     mvi    m,'?'        ;set match one character
  2253.     inx    h
  2254.     dcr    b
  2255.     jp    setwild
  2256.     ret
  2257. ;
  2258. ;    skip spaces
  2259. ;
  2260. skip0:    inx    d
  2261. skip:    ldax    d
  2262.     cpi    ' '        ;skip spaces & tabs
  2263.     jz     skip0
  2264.     cpi    tab
  2265.     jz    skip0
  2266.     ret
  2267. ;    
  2268. ;    check for delimiter
  2269. ;
  2270. ;    entry:    A = character
  2271. ;    exit:    z = set if char is a delimiter
  2272. ;
  2273. delimiters:    db    cr,tab,' .,:;[]=<>|',0
  2274.  
  2275. delim:    ldax    d        ;get character
  2276.     push    h
  2277.     lxi    h,delimiters
  2278. delim1:    cmp    m        ;is char in table
  2279.     jz    delim2
  2280.     inr    m
  2281.     dcr    m        ;end of table? (0)
  2282.     inx    h
  2283.     jnz    delim1
  2284.     ora    a        ;reset zero flag
  2285. delim2:    pop    h
  2286.     rz
  2287.     ;
  2288.     ;    not a delimiter, convert to upper case
  2289.     ;
  2290.     cpi    'a'
  2291.     rc
  2292.     cpi    'z'+1
  2293.     jnc    delim3
  2294.     ani     05fh
  2295. delim3:    ani    07fh    
  2296.     ret            ;return with zero set if so
  2297. ;
  2298. ;    pad with blanks
  2299. ;
  2300. pad:    mov    m,b
  2301.     inx    h
  2302.     dcr    c
  2303.     jnz    pad
  2304.     ret
  2305. ;
  2306. endif
  2307. ;
  2308. ;
  2309. ;************************************************************************
  2310. ;
  2311. ;    SUBROUTINES 
  2312. ;
  2313. ;************************************************************************
  2314. ;
  2315.     if multi
  2316. ;
  2317. ;    copy SCB memory word
  2318. ;    d = source offset e = destination offset
  2319. ;
  2320. wordmov:
  2321.     lhld    scbaddr
  2322.     mov    l,d
  2323.     mov    d,h
  2324.     mvi     c,2
  2325. ;
  2326.     endif
  2327. ;
  2328. ;    copy memory bytes 
  2329. ;    de = destination  hl = source  c = count
  2330. ;
  2331. move:
  2332.     mov     a,m 
  2333.     stax     d         ;move byte to destination
  2334.     inx     h 
  2335.     inx     d        ;advance pointers
  2336.     dcr     c        ;loop if non-zero
  2337.     jnz    move
  2338.     ret
  2339. ;
  2340. ;    copy memory bytes with terminating zero
  2341. ;    hl = destination  de = source  
  2342. ;    returns c=length
  2343.  
  2344. copy0:    mvi    c,0
  2345. copy1:    ldax    d
  2346.     mov    m,a
  2347.     ora    a
  2348.     mov    a,c
  2349.     rz
  2350.     inx    h
  2351.     inx    d
  2352.     inx    b
  2353.     jmp    copy1
  2354.  
  2355. ;;
  2356. ;;-----------------------------------------------------------------------
  2357. ;;
  2358. ;;    get byte from file
  2359. ;;
  2360. ;;    exit:    z  = set if byte gotten
  2361. ;;        a  = byte read
  2362. ;;        z  = clear if error or eof
  2363. ;;        a  = return value of bdos read call
  2364. ;;
  2365. getb:    xra    a        ;clear accumulator
  2366.     lxi    h,bufp        ;advance buffer pointer
  2367.     inr    m
  2368.     cm    read        ;read sector if buffer empty
  2369.     ora    a
  2370.     rnz            ;return if read error or eof
  2371.     lda    bufp        ;compute pointer into buffer
  2372.     lxi    h,buf
  2373.     call    addhla
  2374.     xra    a        ;set zero flag
  2375.     mov    a,m        ;get byte
  2376.     ret
  2377. ;;
  2378. ;;-----------------------------------------------------------------------
  2379. ;;
  2380. ;;
  2381. ;;    system control block flag routines
  2382. ;;
  2383. ;;    entry:    c  = bit mask (1 bit on)
  2384. ;;        b  = scb byte offset
  2385. ;;
  2386. subtest:
  2387.     lxi    b,submit
  2388. getflg:
  2389. ;    return flag value
  2390. ;    exit:    zero flag set if flag reset
  2391. ;        c  = bit mask
  2392. ;        hl = flag byte address
  2393. ;
  2394.     lhld     scbaddr 
  2395.     mov     l,b
  2396.     mov     a,m
  2397.     ana     c         ; a = bit
  2398.     ret
  2399. ;
  2400. setccpflg:
  2401.     lxi    b,ccp10
  2402.  
  2403. ;
  2404. setflg:
  2405. ;    set flag on (bit = 1)
  2406. ;
  2407.     call     getflg
  2408.     mov     a,c
  2409.     ora     m
  2410.     mov     m,a
  2411.     ret
  2412. ;
  2413. resetccpflg:
  2414.     lxi    b,ccp10
  2415. ;
  2416. resetflg:
  2417. ;    reset flag off (bit = 0)
  2418. ;
  2419.     call     getflg
  2420.     mov     a,c
  2421.     cma 
  2422.     ana     m 
  2423.     mov     m,a
  2424.     ret
  2425. ;;
  2426. ;;
  2427. ;;    SET/GET SCB BYTE
  2428. ;;
  2429. ;;    entry:     A  = byte ("setbyte" only)
  2430. ;;         B  = SCB byte offset from page
  2431. ;;
  2432. ;;    exit:     A  = byte ("getbyte" only)
  2433. ;;
  2434. setbyte:
  2435.     lhld     scbaddr 
  2436.     mov     l,b 
  2437.     mov     m,a
  2438.     ret
  2439. ;
  2440. getbyte:
  2441.     lhld     scbaddr 
  2442.     mov     l,b 
  2443.     mov     a,m
  2444.     ret
  2445. ;
  2446.  
  2447.  
  2448.  
  2449. ;;-----------------------------------------------------------------------
  2450. ;;
  2451. ;;
  2452. ;;    print message followed by newline
  2453. ;;
  2454. ;;    entry:    de -> message string
  2455. ;;
  2456. pmsgnl:    call    pmsg
  2457. ;
  2458. ;    print crlf
  2459. ;
  2460. dirln:    mov    b,l            ;number of columns for DIR
  2461. crlf:    mvi    a,cr
  2462.     call    pfc
  2463.     mvi    a,lf
  2464.     jmp    pfc
  2465. ;;
  2466. ;;-----------------------------------------------------------------------
  2467. ;;
  2468. ;;    print decimal byte
  2469. ;;
  2470. pdb:    sui    10
  2471.     jc    pdb2
  2472.     mvi    e,'0'
  2473. pdb1:    inr    e
  2474.     sui    10
  2475.     jnc    pdb1
  2476.     push    psw
  2477.     call    putc2
  2478.     pop    psw
  2479. pdb2:    adi    10+'0'
  2480.     jmp    putc
  2481. ;;-----------------------------------------------------------------------
  2482. ;;
  2483. ;;
  2484. ;;    print string terminated by 0 or char in c
  2485. ;;
  2486. pstrg:    mov    a,m        ;get character
  2487.     ora    a
  2488.     rz
  2489.     cmp    c
  2490.     rz
  2491.     call    pfc        ;print character
  2492.     inx    h        ;advance pointer
  2493.     jmp    pstrg        ;loop
  2494. ;;
  2495. ;;-----------------------------------------------------------------------
  2496. ;;
  2497. ;;    check for end of command (error if extraneous parameters)
  2498. ;;
  2499. eoc:    call    skps
  2500.     rz
  2501. ;
  2502. ;    handle parser error
  2503. ;
  2504. perror:
  2505.     lxi    h,errflg
  2506.     mov    a,m
  2507.     ora    a        ;ignore error????
  2508.     mvi    m,0        ;clear error flag
  2509.     rnz            ;yes...just return to CCPRET
  2510.     lhld    errorp        ;get pointer to what we're parsing
  2511.     mvi    c,' '
  2512.     call    pstrg
  2513. perr2:    mvi    a,'?'        ;print question mark
  2514.     call    putc
  2515.     jmp    ccpcr
  2516. ;
  2517. ;;-----------------------------------------------------------------------
  2518. ;;
  2519. ;;
  2520. ;;    print error message and exit processor
  2521. ;;
  2522. ;;    entry:    bc -> error message
  2523. ;;
  2524. ;;msgerr:    push    b
  2525. ;;    call    crlf
  2526. ;;    pop    d
  2527. ;;    jmp    pmsgnl
  2528. ;;
  2529. ;;-----------------------------------------------------------------------
  2530. ;;
  2531. ;;    get decimal number (0 <= N <= 255)
  2532. ;;
  2533. ;;    exit:    a  = number
  2534. ;;
  2535. gdn:    call    skps        ;skip initial spaces
  2536.     lhld    parsep        ;get pointer to current character
  2537.     shld    errorp        ;save in case of parsing error
  2538.     rz            ;return if end of command
  2539.     mov    a,m        ;get it
  2540.     cpi    '0'        ;error if non-numeric
  2541.     jc    perror
  2542.     cpi    '9'+1
  2543.     jnc    perror
  2544.     call    gdns        ;convert number
  2545.     shld    parsep        ;save new position
  2546.     ori    1        ;clear zero and carry flags
  2547.     mov    a,b
  2548.     ret
  2549. ;
  2550. gdns:    mvi    b,0
  2551. gdns1:    mov    a,m
  2552.     sui    '0'
  2553.     rc
  2554.     cpi    10
  2555.     rnc
  2556.     push    psw
  2557.     mov    a,b        ;multiply current accumulator by 10
  2558.     add    a
  2559.     add    a
  2560.     add    b
  2561.     add    a
  2562.     mov    b,a
  2563.     pop    psw
  2564.     inx    h        ;advance to next character
  2565.     add    b        ;add it in to the current accumulation
  2566.     mov    b,a
  2567.     cpi    16
  2568.     jc    gdns1        ;loop unless >=16
  2569.     jmp    perror        ;error if invalid user number
  2570. ;;
  2571. ;;-----------------------------------------------------------------------
  2572. ;;
  2573. ;;    print file name
  2574. ;;
  2575.     if newdir
  2576. pfn:    inx    d        ;point to file name
  2577.     mvi    h,8        ;set # characters to print, clear # printed
  2578.     call    pfn1        ;print name field
  2579.     call    space
  2580.     mvi    h,3        ;set # characters to print
  2581. pfn1:    ldax    d        ;get character
  2582.     ani    7fh
  2583.     call    pfc        ;print it if not
  2584.     inx    d        ;advance pointer
  2585.     dcr    h        ;loop if more to print
  2586.     jnz    pfn1
  2587.     ret
  2588. ;
  2589. space:    mvi    a,' '
  2590. ;
  2591. pfc:    push    b
  2592.     push    d
  2593.     push    h
  2594.     call    putc
  2595.     pop    h
  2596.     pop    d
  2597.     pop    b
  2598.     ret
  2599.     
  2600.     else
  2601.  
  2602. pfn:    inx    d        ;point to file name
  2603.     lxi    b,8*256        ;set # characters to print, clear # printed
  2604.     call    pfn1        ;print name field
  2605.     ldax    d        ;see if there's a type
  2606.     ani    7fh
  2607.     cpi    ' '
  2608.     rz            ;return if not
  2609.     mvi    a,'.'        ;print dot
  2610.     call    pfc
  2611.     mvi    b,3        ;set # characters to print
  2612. pfn1:    ldax    d        ;get character
  2613.     ani    7fh
  2614.     cpi    ' '        ;is it a space?
  2615.     cnz    pfc        ;print it if not
  2616.     inx    d        ;advance pointer
  2617.     dcr    b        ;loop if more to print
  2618.     jnz    pfn1
  2619.     ret
  2620. ;
  2621. space:    mvi    a,' '
  2622. ;
  2623. pfc:    inr    c        ;increment # characters printed
  2624.     push    b
  2625.     push    d
  2626.     call    putc
  2627.     pop    d
  2628.     pop    b
  2629.     ret
  2630.     endif
  2631. ;;
  2632. ;;-----------------------------------------------------------------------
  2633. ;;
  2634. ;;    add a to hl
  2635. ;;
  2636. addhla:    add    l
  2637.     mov    l,a
  2638.     rnc
  2639.     inr    h
  2640.     ret
  2641. ;;
  2642. ;;-----------------------------------------------------------------------
  2643. ;;
  2644. ;;    set match-any string into fcb
  2645. ;;
  2646. ;;    entry:    de -> fcb area
  2647. ;;        b  = # bytes to set
  2648. ;;
  2649. setmatch:
  2650.     mvi    a,'?'        ;set match one character
  2651. setm1:    stax    d        ;fill rest of field with match one
  2652.     inx    d
  2653.     dcr    b        ;loop if more to fill
  2654.     jnz    setm1
  2655.     ora    a
  2656.     ret
  2657. ;;
  2658. ;;-----------------------------------------------------------------------
  2659. ;;
  2660. ;;    table search
  2661. ;;
  2662. ;;    Search table of strings separated by spaces and terminated 
  2663. ;;    by 0.  Accept abbreviations, but set string = matched string
  2664. ;;    on exit so that we don't try to execute abbreviation.
  2665. ;;
  2666. ;;    entry:    de -> string to search for
  2667. ;;        hl -> table of strings to match (terminate table with 0)
  2668. ;;    exit:    z  = set if match found
  2669. ;;        a  = entry # (0 thru n-1)
  2670. ;;        z  = not set if no match found
  2671. ;;
  2672. tbls:    lxi    b,0ffh        ;clear entry & entry length counters
  2673. tbls0:    push    d        ;save match string addr
  2674.     push    h        ;save table string addr
  2675. tbls1:    ldax    d        ;compare bytes
  2676.     ani    7fh        ;kill upper bit (so SYS + R/O match)
  2677.     cpi    ' '+1        ;end of search string?
  2678.     jc    tbls2        ;skip compare, if so
  2679.     cmp    m
  2680.     jnz    tbls3        ;jump if no match
  2681. tbls2:    inx    d        ;advance string pointer
  2682.     inr    c        ;increment entry length counter
  2683.     mvi    a,' '
  2684.     cmp    m
  2685.     inx    h        ;advance table pointer
  2686.     jnz    tbls1        ;continue with this entry if more
  2687.     pop    h        ;HL = matched string in table
  2688.     pop    d        ;DE = string address
  2689.     call    move        ; C = length of string in table
  2690.     mov    a,b        ;return current entry counter value
  2691.     ret
  2692. ;
  2693. tbls3:    mvi    a,' '        ;advance hl past current string
  2694. tbls4:    cmp    m
  2695.     inx    h
  2696.     jnz    tbls4
  2697.     pop    d        ;throw away last table address
  2698.     pop    d        ;DE = string address
  2699.     inr    b        ;increment entry counter
  2700.     mvi    c,0ffh
  2701.     mov    a,m        ;check for end of table
  2702.     sui    1
  2703.     jnc    tbls0        ;loop if more entries to test
  2704.     ret
  2705. ;
  2706. ;************************************************************************
  2707. ;************************************************************************
  2708. ;
  2709. ;************************************************************************
  2710. ;
  2711. ;    DATA AREA
  2712. ;
  2713. ;************************************************************************
  2714. ;    ;Note uninitialized data placed at the end (DS)
  2715. ;
  2716. ;
  2717.     if    prompts
  2718. enter:    db    'Enter $'
  2719. unmsg:    db    'User #: $'
  2720. fnmsg:    db    'File: $'
  2721.     else
  2722. unmsg:    db    'Enter User #: $'
  2723.     endif
  2724. nomsg:    db    'No File$'
  2725. required:
  2726.     db    ' required$'
  2727. eramsg:
  2728.     db    'ERASE $'
  2729. confirm:
  2730.     db    ' (Y/N)? $'
  2731. more:    db    cr,lf,cr,lf,'Press RETURN to Continue $'
  2732.     if    dayfile
  2733. userzero    db    '  (User 0)$'
  2734.     endif
  2735. ;
  2736. ;
  2737. ;
  2738.     if     newdir
  2739. anyfiles:    db    0    ;flag for SYS or DIR files exist
  2740. dirfiles:    db    'NON-'
  2741. sysfiles:    db    'SYSTEM FILE(S) EXIST$'
  2742.     endif
  2743.  
  2744. errflg:    db    0        ;parse error flag
  2745.     if multi
  2746. multibufl:
  2747.     dw    0        ;multiple commands buffer length
  2748.     endif
  2749. scbadd:    db    scbad-pag$off,0
  2750.     ;********** CAUTION FOLLOWING DATA MUST BE IN THIS ORDER *********
  2751. pfncb:                ;BDOS func 152 (parse filename)
  2752. parsep:    dw    0        ;pointer to current position in command
  2753. pfnfcb:    dw    pfcb        ;.fcb for func 152
  2754. usernum:            ;CCP current user
  2755.     db    0
  2756. chaindsk:
  2757.     db    0        ;transient's current disk
  2758. disk:    db    0        ;CCP current disk
  2759. subfcb:    db    1,'$$$     SUB',0
  2760. ccpend:                ;end of file (on disk)
  2761.     ds    1
  2762. submod:    ds    1
  2763. subrc:    ds    1
  2764.     ds    16
  2765. subcr:    ds    1
  2766. subrr:    ds    2
  2767. subrr2:    ds    1
  2768.  
  2769. dircols:
  2770.     ds    1        ;number of columns for DIR/DIRS
  2771. pgsize:    ds    1        ;console page size
  2772. line:    ds    1        ;console line #
  2773. pgmode:    ds    1        ;console page mode
  2774.     ;*****************************************************************
  2775. errorp:    ds    2        ;pointer to beginning of current param.
  2776. errsav:    ds    2        ;pointer to built-in command tail
  2777. bufp:    ds    1        ;buffer pointer for getb
  2778. realdos:
  2779.     ds    1        ;base page of BDOS
  2780. ;
  2781. option:    ds    1        ;'[' in line?
  2782. passwd:    ds    10        ;password
  2783. ufcb:    ds    1        ;user number (must procede fcb)
  2784. FCB:
  2785.     ds    1        ; drive code
  2786.     ds    8        ; file name
  2787.     ds    3        ; file type
  2788.     ds    4        ; control info
  2789.     ds    16        ; disk map
  2790. fcbcr:    ds    1        ; current record
  2791. fcbrr:    ds    2        ; random record
  2792. pfcb:    ds    36        ; fcb for parsing
  2793. ;
  2794. ;
  2795. ;
  2796. ;
  2797. ;     command line buffer
  2798. ;
  2799. cbufmx:    ds    1
  2800. cbufl:    ds    1
  2801. cbuf:    ds    comlen
  2802.     ds    50h
  2803. stack:
  2804. ccptop:         ;top page of CCP
  2805.     end
  2806.  
  2807.