You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

4045 lines
124 KiB

; PROGRAM: ZCPR
; VERSION: 3.3
; DERIVATION: ZCPR30
; AUTHOR: Jay Sage
; DATE: May 28, 1987
; ZCPR33 is copyright 1987 by Echelon, Inc. All rights reserved. End-user
; distribution and duplication permitted for non-commercial purposes only.
; Any commercial use of ZCPR33, defined as any situation where the duplicator
; recieves revenue by duplicating or distributing ZCPR33 by itself or in
; conjunction with any hardware or software product, is expressly prohibited
; unless authorized in writing by Echelon.
;
; Echelon specifically disclaims any warranties, expressed or implied,
; including but not limited to implied warranties of merchantability and
; fitness for a particular purpose. In no event will Echelon be liable for
; any loss of profit or any other commercial damage, including but not limited
; to special, incidental, consequential, or other damages.
;
; Echelon can be contacted at:
; Echelon, Inc.
; 885 N. San Antonio Road
; Los Altos, California USA 94022
; (415) 948-3820
;-----------------------------------------------------------------------------
;
; A C K N O W L E D G M E N T S
;
;-----------------------------------------------------------------------------
; Many people have played a role in the development of ZCPR in general and
; ZCPR33 in particular. It all started when "The CCP Group," including
; Richard Conn, Ron Fowler, Keith Petersen, Frank Wancho, Charlie Strom, and
; Bob Mathias decided that by rewriting the CP/M command processor to take
; advantage of Zilog-specific opcodes they could save enough code to enhance
; some of the features. Richard Conn then extended that development through
; ZCPR2 to ZCPR3 (3.0). Just a little over two years ago, I took the first
; step to enhance ZCPR3 by making it get the maximum drive and user values
; from the environment instead of hard coding them in. This version was
; distributed privately as ZCPR31. Along the way to what is now ZCPR
; version 3.3 a number of others have made valuable contributions: Steve
; Kitahata, Michael Bate, Bruce Morgen, Roger Warren, Dreas Nielsen, Bob Freed,
; Al Hawley, Howard Goldstein, and many others who have stimulated developments
; by pointing out problems or asking questions.
; I would like particularly to acknowledge two people who have played a very
; significant role in these developments. One is Al Hawley. He introduced
; the idea of having the DUOK flag in the environment control how the CPR
; would respond to the DU: form of directory reference. He also originated
; the idea of using the high bit of the first character of each command name
; to control whether or not it would be wheel restricted. Finally, he
; contributed the basic structure of the highly efficient, elegant, and more
; general number evaluation routines in the code.
; My biggest debt of gratitude is to Howard Goldstein. His role in the
; development of ZCPR33 goes back about a year, when he contributed the first
; correct implementation of the minpath feature. More recently, during the
; period of intense development since Echelon expressed its interest in my
; writing the official 3.3 version, he and I have shared an especially
; enjoyable and fruitful relationship. Most of the newest ideas have been
; worked out jointly, and Howard has done a great deal to keep my code and
; concepts on track. He discovered many ways to pare the code down and, more
; importantly, uncovered numerous subtle bugs. He recoded the SAVE command
; to make it more compact and reliable.
;
; Jay Sage
; May 28,1987
;-----------------------------------------------------------------------------
;
; U S E R C O N F I G U R A T I O N
;
;-----------------------------------------------------------------------------
; The following MACLIB statements load all the user-selected equates
; which are used to customize ZCPR33 for the user's working environment.
; NOTE -- TRUE & FALSE are defined in Z3BASE.
memtop equ 0FFE0H - 1 ; Reserve memory above this for HBIOS
base equ 0
maclib z3basen.lib
maclib z33hdr.lib
; Check that the configuration includes the required facilities
; A ZCPR33 system is assumed to include certain minimal features, including
; an external file control block, external path, shell stack, message buffer,
; external environment descriptor, multiple command line, and external stack.
; If wheel checking is enabled in the Z33HDR.LIB file, then there must be
; an address defined for the wheel byte in the Z3BASE.LIB file.
errflag defl extfcb eq 0 ; External command FCB
errflag defl errflag or [ expath eq 0 ] ; Symbolic path
errflag defl errflag or [ shstk eq 0 ] ; Shell stack
errflag defl errflag or [ z3msg eq 0 ] ; Message buffer
errflag defl errflag or [ z3env eq 0 ] ; Environment descriptor
errflag defl errflag or [ z3cl eq 0 ] ; Multiple command line
errflag defl errflag or [ extstk eq 0 ] ; External stack
if wheel or wdu or wpass or wprefix or whldir
errflag defl errflag or [ z3whl eq 0 ] ; Wheel byte
endif ;wheel or wdu or wpass or wprefix or whldir
if errflag
*** NOT ALL REQUIRED ZCPR3 FACILITIES ARE SUPPORTED ***
else ; go ahead with the assembly
;-----------------------------------------------------------------------------
;
; D E F I N I T I O N S S E C T I O N
;
;-----------------------------------------------------------------------------
; ---------- Macro definitions
maclib z33mac.lib ; Library of macros for ZCPR33
; ---------- ASCII definitions
ctrlc equ 03h
bell equ 07h
tab equ 09h
lf equ 0ah
cr equ 0dh
; ---------- Operating system addresses
wboot equ base+0000h ; CP/M warm boot address
udflag equ base+0004h ; User number in high nybble, disk in low
bdos equ base+0005h ; BDOS function call entry point
tfcb equ base+005ch ; Default FCB buffer
tfcb2 equ tfcb+16 ; 2nd FCB
tbuff equ base+0080h ; Default disk I/O buffer
tpa equ base+0100h ; Base of TPA
;bios equ ccp+0800h+0e00h ; BIOS location
; ---------- Error codes
; ZCPR33 uses the error byte at the beginning of the message buffer as a flag
; to show what kind of error occurred. Advanced error handlers will be able
; to help the user further by suggesting the possible cause of the error.
; Error code 6 for an ECP error is determined by the code and cannot be
; changed (without increasing code length).
ecduchg equ 1 ; Directory change error -- attempt to change
; ..logged directory when under control of
; ..wheel byte and wheel is off
ecbaddir equ 2 ; Bad directory specification -- logging of
; ..user number beyond legal range,
; ..nonexistent named directory
ecbadpass equ 3 ; Bad password -- incorrect password entered
ecbadcmd equ 5 ; Bad command form -- wildcard or file type
; ..present in command verb
ececperr equ 6 ; ECP error -- command could not be executed
; ..by ECP, error handling was forced by a
; ..transient for its own reasons
; (DO NOT CHANGE FROM 6)
ecnocmd equ 7 ; Command file not found -- command that skips
; ..ECP could not be executed, GET could not
; ..find file to load
ecambig equ 8 ; Ambiguous file specification where not
; ..allowed (SAVE, GET, REN)
ecbadnum equ 9 ; Bad numerical value -- not a number where
; ..number expected, number out of range
ecnofile equ 10 ; File not found -- REN, TYPE, LIST could not
; ..find a specified file
ecdiskfull equ 11 ; Disk directory or data area full
ectpafull equ 12 ; TPA overflow error
; ---------- Multiple command line equates
; The multiple command line buffer is located in a protected area in memory so
; that it is not overwritten during warm boots. It includes some pointers so
; that when ZCPR33 starts it can tell where to start reading the command line.
; BUFSIZ and CHRCNT are not used by ZCPR33 but are provided so that the BDOS
; line input function can be used to read in a command line.
nxtchr equ z3cl ; Address where pointer to next command to
; ..process is kept
bufsiz equ z3cl+2 ; Address where size of buffer is kept
chrcnt equ z3cl+3 ; Address where length of string actually in
; ..the buffer is kept (not always reliable)
cmdlin equ z3cl+4 ; Address of beginning of command line buffer
buflen equ z3cls ; Length of command line buffer
; ---------- Command file control block
; In ZCPR33 the file control block for commands must be located in protected
; memory. This not only frees up valuable space in the command processor for
; code but also makes it possible for programs to determine by what name they
; were invoked.
cmdfcb equ extfcb
; ---------- External CPR stack
stack equ extstk+48 ; Set top-of-stack address
pwlin equ extstk ; Place line at bottom of stack
; ---------- Environment
quietfl equ z3env+28h ; Quiet flag
maxdrenv equ z3env+2ch ; Maximum drive value
maxusrenv equ z3env+2dh ; Maximum user value
duokfl equ z3env+2eh ; Flag indicating acceptance of DU: form
crttxt0 equ z3env+33h ; Address of number of lines of text on the
; ..screen of CRT0
; ---------- Message buffer
ecflag equ z3msg ; Error return code flag
ifptrfl equ z3msg+1 ; Pointer to current IF level
ifstatfl equ z3msg+2 ; Flow control status byte
cmdstatfl equ z3msg+3 ; Command status flag
cmdptr equ z3msg+4 ; Pointer to currently running command
zexinpfl equ z3msg+7 ; ZEX input status/control flag
zexrunfl equ z3msg+8 ; ZEX running flag
errcmd equ z3msg+10h ; Error handling command line
xsubflag equ z3msg+2ch ; XSUB input redirection flag
subflag equ z3msg+2dh ; Submit running flag
curusr equ z3msg+2eh ; Currently logged user
curdr equ z3msg+2fh ; Currently logged drive
;-----------------------------------------------------------------------------
;
; C O D E M O D U L E S S E C T I O N
;
;-----------------------------------------------------------------------------
page
; ZCPR33-1.Z80
;=============================================================================
;
; E N T R Y P O I N T S A N D H E A D E R S T R U C T U R E
;
;=============================================================================
if not rel ; If generating absolute code
org ccp
else
common /_BIOS_/
bios equ $
cseg
endif ;not rel
; ENTRY POINTS INTO ZCPR33
;
; For compatibility with CP/M, two entry points are provided here. In
; standard CP/M if the code is entered from the first entry point, then the
; command in the resident command buffer is executed; if entered from the
; second entry point, the command line is flushed. With ZCPR33 and its
; multiple command line buffer, these two entry points function identically
; and go to the same address.
;
; We have kept the entry points in their standard locations but have used a
; relative jump for the second entry point and replaced the last byte with the
; version number. In this way the version number occupies a position that
; would otherwise contain the page number at which the CPR runs. It will
; always be possible, therefore, to distinguish ZCPR33 and later versions
; from other command processors. The first jump is kept as an absolute jump
; so that 1) the code will be compatible with Z-COM and Z3-DOT-COM and 2) the
; execution address of a CPR module can always be determined.
entry:
jp zcpr
jr zcpr
version:
defb 33h ; Version ID squeezed in here (offset = 5)
;-----------------------------------------------------------------------------
; Configuration information
options: ; (offset = 6)
optflag badduecp,rootonly,ndrenv,fcpenv,rcpenv,inclenv,aduenv,duenv
optflag highuser,drvprefix,scancur,incldir,incldu,dufirst,accptdir,accptdu
optflag no,pwcheck,pwnoecho,wdu,wpass,wprefix,fastecp,skippath
attdir defl [ comatt eq 80h ] or [ comatt eq 01h ] or [ not attchk ]
attsys defl [ comatt eq 00h ] or [ comatt eq 01h ] or [ not attchk ]
subquiet defl [ subnoise eq 1 ]
subecho defl [ subnoise gt 1 ]
optflag shellif,attsys,attdir,attchk,subecho,subquiet,subclue,subon
; Byte with information about the alternate colon option. If the byte is
; zero, the option is not supported. Otherwise the byte contains the
; prefix character that serves as an alias for a colon prefix. Offset = 10.
if altcolon
defb altchar
else
defb 0
endif ;altcolon
; Byte with information about the FASTECP implementation (option bit above
; indicates whether the feature is enabled at all). If no character appears
; here (zero byte), then only a leading space can be used. Otherwise, the
; first seven bits contain the character, and the high bit, if set, indicates
; that ONLY this character will be recognized and not a space. Offset = 11.
if fastecp and altspace
if altonly
defb ecpchar + 80h
else ;not altonly
defb ecpchar
endif ;altonly
else ;no alternate character
defb 0
endif ;fastecp and altspace
defb 0,0,0,0 ; Space reserved for expansion
;-----------------------------------------------------------------------------
; Entry points to file name parsing code.
; Entry point REPARSE. A call to this point can be used to parse a command
; line tail into the default file control blocks at 5CH and 6CH. Each time
; the parser is called it leaves the starting address of the second token in
; the PARESPTR address below so that successive calls to the routine reparse
; the command tail one token later. A program can load its own pointer into
; PARSEPTR as well. Offset = 16 (10h).
reparse:
parseptr equ $+1 ; Pointer for in-the-code modification
ld hl,0
jp parsetail
; Entry point SCAN. A call to this point can be used to parse a single token
; pointed to by HL into the FCB pointed to by DE. Offset 22 (16h).
scan:
jp scanner
;-----------------------------------------------------------------------------
; BUFFERS
;
; In this area various data items are kept. First comes the list of commands
; supported by ZCPR33; then comes the name of the extended command processor
; (ECP). By putting these items here, an 'H' command in the RCP or a utility
; like SHOW.COM can find this information and report it to the user.
; ---------- RESIDENT COMMAND TABLE
; The command table entry is structured as follows: First there is a byte
; which indicates the number of characters in each command. Then there is a
; series of entries comprising the name of a command followed by the address
; of the entry point to the code for carrying out that command. Finally,
; there is a null byte (00h) to mark the end of the table. Offset = 25 (19h).
cmdtbl:
defb cmdsize ; Length of command names
ctable ; Define table via macro in Z33HDR.LIB
defb 0 ; End of table
; ---------- NAME FOR EXTENDED COMMAND PROCESSOR
; The name of the extended command processor is placed here after the command
; table so that utilities like SHOW or an RCP 'H' command can find it.
ecpfcb:
ecpname ; From Z33HDR.LIB
; ---------- FILE TYPE FOR TRANSIENT COMMANDS (usually COM)
; This file type also applies to the extended command processor name.
commsg:
comtyp ; From Z33HDR.LIB
; ---------- SUBMIT FILE CONTROL BLOCK
if subon ; If submit facility enabled ...
subfcb:
defb subdrv-'A'+1 ; Explicit drive for submit file
defb '$$$ ' ; File name
subtyp ; From Z33HDR.LIB
defb 0 ; Extent number
defb 0 ; S1 (user number 0)
subfs2:
defs 1 ; S2
subfrc:
defs 1 ; Record count
defs 16 ; Disk group map
subfcr:
defs 1 ; Current record number
endif ; subon
; End ZCPR33-1.Z80
page
; ZCPR33-2.Z80
;=============================================================================
;
; C O M M A N D L I N E P R O C E S S I N G C O D E
;
;=============================================================================
; MAIN ENTRY POINT TO CPR
; This is the main entry point to the command processor. On entry the C
; register must contain the value of the user/drive to be used as the current
; directory.
zcpr:
ld sp,stack ; Reset stack
if pwnoecho
ld a,0c3h ; Reenable BIOS conout routine
ld (bios+0ch),a ; ..after a warmboot
endif ;pwnoecho
ld b,0fh ; Keep nibble mask in B
; If the HIGHUSER option is enabled, we compare the user/drive in the login
; byte in C to the values stored in the message buffer. If, ignoring bit 4
; of the user number, they match, then we remain in the current area, which
; may be a user area above 15.
if highuser
ld a,c ; Copy user/drive byte to A
and b ; Isolate drive
ld d,a ; ..and move to D
ld a,c ; Get full byte back
swap ; Swap nibbles
and b ; Isolate user number
ld e,a ; ..and move to E
ld hl,(curusr) ; Get old curdr/curusr into HL
sbc hl,de ; Subtract new values from old (carry is clear)
ex de,hl ; Switch new values into HL, diff into DE
ld a,d ; Combine two parts of difference
or e
and b ; Ignore bit for high user numbers
jr z,zcpr1 ; Skip update if no change in DU
ld (curusr),hl ; Update values of current drive and user
zcpr1:
else ;not highuser
ld a,c ; Copy user/drive byte to A
and b ; Isolate drive
ld h,a ; ..and move to H
ld a,c ; Get full byte back
swap ; Swap nibbles
and b ; Isolate user number
ld l,a ; ..and move to L
ld (curusr),hl ; ..and save them
endif ;highuser
; This block of code is executed when submit processing is enabled. We log
; into user area 0, where the submit file is kept, and we search the
; designated drive for the file. The result is kept in SUBFLAG. This code
; only has to be executed on reentry to the command processor at the main
; entry point. Commands that do not reboot but simply return to the CPR will
; execute without the disk reset and file search required here. Ron Fowler
; pointed out a shortcut based on the fact that after a disk reset, the A
; regiser contains a value of 0 if there is no file on drive A with a '$' in
; the file name and 0FFH if there is such a file. Thus if A = 0, there can
; be no '$$$.SUB' file on drive A. This trick is, unfortunately, not reliable
; under some versions of ZRDOS. Therefore, an option has been included to
; use or not use this shortcut.
if subon ; If submit facility enabled ..
call defltdma ; Set DMA address to 80H
ld a,0 ; Log into user area 0
call setuser
ld c,0dh ; Reset disk system (returns 0FFH if a $$$.SUB
call bdossave ; ..file might exist in user 0)
ld de,subfcb ; Point to submit file FCB with explicit drive
if subclue
call nz,srchfst ; Search only if flag says it could exist
else ;not subclue
call srchfst ; Search for the file unconditionally
endif ;subclue
ld (subflag),a ; Set flag for result (0 = no $$$.SUB)
else ;not subon
ld c,0dh ; Reset disk system
call bdossave
endif ; subon
jr nextcmd ; Go to entry point for processing next command
;-----------------------------------------------------------------------------
; NEW COMMAND LINE ENTRY POINT
; This entry point is used when ZCPR33 finds the command line empty. A call to
; READBUF gets the next command line from the following possible sources in
; this order:
; 1) a running ZEX script
; 2) the submit file $$$.SUB (if enabled)
; 3) the shell stack
; 4) the user
; If the line comes from the shell stack, then the shell bit in the command
; status flag is set.
restart:
ld sp,stack ; Reset stack
xor a
ld (cmdstatfl),a ; Reset ZCPR3 command status flag
inc a ; Set ZEX message byte to 1 to
ld (zexinpfl),a ; ..indicate command prompt
if subon
ld (xsubflag),a ; Ditto for XSUB flag
endif ;subon
ld hl,cmdlin ; HL --> beginning of command line buffer
ld (nxtchr),hl ; Save as pointer to next character to process
ld (hl),0 ; Zero out command line (in case of warm boot)
push hl ; Save pointer to command line
call readbuf ; Input command line (ZEX, submit, shell,
; ..or user)
pop hl ; Get back pointer to command line
ld a,(hl) ; Check for comment line
cp comment ; Begins with comment character?
jr z,restart ; If so, go back for another line
; Otherwise, fall through
;-----------------------------------------------------------------------------
; COMMAND CONTINUATION PROCESSING ENTRY POINT
; This is the entry point for continuing the processing of an existing command
; line. The current drive and user values as known to the CPR are combined
; and made into the user/drive byte that CP/M keeps at location 0004. If the
; HIGHUSER option is enabled, the user number for this byte is forced to be
; in the range 0..15. Next the command status flag is processed. The error
; and ECP bits in the actual flag are reset, and the original flag is checked
; for an ECP error return (both ECP bit and error bit set). In that case,
; control is transferred to the error handler.
nextcmd:
ld hl,(curusr) ; Get currently logged drive and user
ld a,l ; Work on user number
if highuser
and 0fh ; Keep value modulo 16
endif ;highuser
swap ; Get user into high nibble
or h ; ..and drive into low nibble
ld (udflag),a ; Set user/disk flag in page 0
ld a,2 ; Turn ZEX input redirection off
ld (zexinpfl),a
if subon
ld (xsubflag),a ; Turn off XSUB input redirection
endif ;subon
ld hl,cmdstatfl ; Point to the command status flag (CSF)
ld a,(hl) ; Get a copy into register A
res 1,(hl) ; Reset the actual error bit
res 2,(hl) ; Reset the actual ECP bit
and 110b ; Select ECP and error bits in original flag
cp 110b ; Test for an ECP error
jp z,error ; Process ECP error with error handler
nextcmd1:
ld sp,stack ; Reset stack
call logcurrent ; Return to default directory
ld hl,(nxtchr) ; Point to first character of next command
push hl ; Save pointer to next character to process
; We have to capitalize the command line each time because an alias or other
; command line generator may have stuck some new text in. The code is shorter
; if we simply capitalize the entire command rather than trying to capitalize
; only the one command we are about to execute.
capbuf: ; Capitalize the command line
ld a,(hl) ; Get character
call ucase ; Convert to upper case
ld (hl),a ; Put it back
inc hl ; Point to next one
or a ; See if end of line (marked with null)
jr nz,capbuf ; If not, loop back
pop hl ; Restore pointer to next character to process
nextcmd3:
; ZCPR33 provides a convenience feature to make it easier to enter a leading
; colon to force the current directory to be scanned and to make the CPR skip
; resident commands. If ALTCOLON is active, an alternate character can be
; entered as the first character of a command. The default (and recommended)
; alternative character is the period (it could not have any other meaning
; here). If FASTECP (see below) is not enabled or if ALTONLY is enabled,
; leading spaces on the command line are skipped before looking for the
; alternate character for the colon
if [ not fastecp ] or [ fastecp and altonly ]
call sksp
endif ;[ not fastecp ] or [ fastecp and altonly ]
if altcolon ; If allowing alias character for leading colon
; Set B = ':' and C = alias character ('.')
ld bc,':' shl 8 + altchar
ld a,(hl) ; Get first character in new command line
cp c ; If first character is ALTCHAR, treat as ':'
jr nz,nextcmd3a ; Branch if not '.'
ld (hl),b ; Else replace with colon
nextcmd3a:
endif ;altcolon
; ZCPR33 supports three new options that can speed up command processing.
; FASTECP allows commands with a leading space to bypass the search for
; resident commands or transient commands (COM files) along the path and go
; directly to the extended command processor. With SKIPPATH enabled, when
; a command is prefixed by an explicit directory specification (but not a
; lone colon), searching of the path and invocation of the ECP are disabled.
; If the command is not found in the specified directory, the error handler
; is invoked immediately. Finally, if BADDUECP is enabled, when an attempt
; is made to log into an invalid directory, the command is sent directly to
; the ECP, which can provide special handling. To implement these three
; features, the first actual character of the command line is saved as a
; flag in FIRSTCHAR. My apologies for the complexity of these nested
; conditionals.
if fastecp or skippath or badduecp
; With FASTECP we store the first actual
; ..character and then skip over spaces (unless ALTONLY is
; ..enabled, in which case we skipped spaces above)
if fastecp
if altspace ; If allowing alias character for leading space
; Set B = ' ' and C = alias character ('/')
ld bc,' ' shl 8 + ecpchar
ld a,(hl) ; Get first character in new command line
cp c ; If first character is ECPCHAR treat as ' '
jr nz,nextcmd3b ; Branch if not '/' (alternate character)
ld (hl),b ; Else replace with space
nextcmd3b:
endif ;altspace
ld a,(hl) ; Get first character in command line
ld (firstchar),a ; Save it in flag
call sksp ; Then skip leading spaces
endif ;fastecp
; With SKIPPATH but not FASTECP we store the first
; ..character of the command (spaces were skipped above)
if [ not fastecp ] and skippath
ld (firstchar),a ; Store first nonspace character
endif ;[ not fastecp ] and skippath
; With only BADDUECP (and neither SKIPPATH nor FASTECP)
; ..we store a null in the FIRSTCHAR flag
if [ not fastecp ] and [ not skippath ]
xor a
ld (firstchar),a
endif ;[ not fastecp ] and [ not skippath ]
endif ;fastecp or skippath or badduecp
; Resume processing of the command line
or a ; Now at end of line?
jr z,restart ; If so, get a new command line
cp ctrlc ; Flush ^C to prevent error-handler
jr z,restart ; ..invocation on warm boots
cp cmdsep ; Is it a command separator?
jr nz,nextcmd4 ; If not, skip ahead to process the command
inc hl ; If it is, skip over it
jr nextcmd3 ; ..and process next command
nextcmd4:
; Unless we are now running the external error handler, the following code
; saves the address of the current command in Z3MSG+4 for use by programs
; to determine the command line with which they were invoked.
ld a,(cmdstatfl) ; Get command status flag
bit 1,a ; Test for error handler invocation
jr nz,nextcmd5 ; If so, skip over next instruction
ld (cmdptr),hl
nextcmd5:
call parser ; Parse entire command line, then look for
; ..the command
;=============================================================================
; C O M M A N D S E A R C H C O D E
;=============================================================================
; CODE FOR FINDING AND RUNNING THE COMMAND
; Here is the code for running a command. Commands are searched for and
; processed in the following order:
;
; 1) flow control package (FCP) commands and IF state testing
; 2) resident command package (RCP)
; 3) command processor (CPR)
; 4) transient (COM file or extended command processor)
; 5) external error handler
; 6) internal error message and processing
;
; Special notes:
;
; a) If the current command is a shell command, special handling of flow
; control is required. If SHELLIF is enabled so that flow commands are
; allowed in shell alias scripts, then we reset the flow state to its
; initial condition (none) with each shell invocation (and after each
; command is run, we reset the shell bit in the code after CALLPROG).
; In this case shells will run regardless of flow state, and residual
; conditionals from the last running of the shell are flushed. Each
; shell input sequence begins afresh. On the other hand, if SHELLIF is
; off, flow control commands inside a shell script must be flushed so
; that they do not interfere with user entered commands.
; b) Directory prefixes are ignored for flow commands, since all flow control
; processing must pass through the FCP (the command must run even when
; the current flow state is false).
; c) If the command is not found in the FCP, then the current flow state is
; tested. If it is false, the command is flushed and the code branches
; back to get the next command.
; d) If the command had a directory prefix (a colon alone is sufficient),
; then steps #2 and #3 are skipped over,and the command is processed
; immediately as a transient program.
; e) In ZCPR33, unlike ZCPR30, RCP commands are scanned before CPR commands.
; This has been done so that more powerful RCP commands can supercede
; CPR commands.
; f) If the SKIPPATH option is enabled, when an explicit directory is
; specified with a command (but not just a colon), searching of the path
; is bypassed. If the FASTECP option is enabled, commands with leading
; spaces are sent directly to the ECP for processing.
; g) If no external command can be found, ZCPR33 performs extensive error
; handling. If the command error occurred while looking for a shell
; program, then the shell stack is popped. Otherwise, ZCPR33 tries to
; invoke an external, user-specified error handling command line. If
; none was specified or if the error handler invoked by that command
; line cannot be found, the internal error message (step #6) is displayed.
;-----------------------------------------------------------------------------
runcmd:
if shellif ; If shells reininitialize flow control...
ld a,(cmdstatfl) ; Get command status flag
bit 0,a ; Shell bit set?
jr z,fcpcmd ; If not a shell, process command
xor a ; Otherwise, shell is running, so
ld (ifptrfl),a ; ..reinitialize the IF system and continue
endif ;shellif
; ---------- Module <<1>>: Flow Control Processing
; An option is supported here to allow the address of the FCP to be obtained
; from the environment descriptor. This is logically consistent with the
; pholosopy of the Z-System and is useful when one wants to have a single block
; of FCP/RCP memory that can be allocated dynamically between FCP and RCP
; functions.
fcpcmd:
if fcp ne 0 ; Omit code if FCP not implemented
if fcpenv ; If getting FCP address from Z3ENV
ld e,12h ; Offset in Z3ENV to FCP address
call pkgoff ; Set HL to FCP+5
jr z,runcmd1 ; Skip if no FCP present
else ; using fixed FCP address
ld hl,fcp+5 ; Get address from Z3BASE.LIB
endif ;fcpenv
; If flow control processing is not allowed in shell aliases (scripts running
; as shell commands), then we have to make sure that we flush any flow control
; commmands, otherwise the CPR will attempt to execute them as transients,
; with dire consequences. In the code below we check the shell bit. If it
; is not set, we proceed normally. If it is set, we scan for flow commands
; and then jump past the flow testing to RUNFCP2, where the code will flush
; the command if it was a flow command and execute it unconditionally if not.
if not shellif
ld a,(cmdstatfl) ; Get command status flag
bit 0,a ; If shell bit not set,
jr z,runfcp1 ; ..we do normal processing
call cmdscan ; Otherwise, check for flow command
jr runfcp2 ; ..and flush if so using code below
endif ;not shellif
runfcp1:
call cmdscan ; Scan command table in the module
jr z,callprog ; Run if found (with no leading CRLF)
; This is where we test the current IF state. If it is false, we skip this
; command.
call iftest ; Check current IF status
runfcp2: ; If false, skip this command and go on to next
if drvprefix ; If DRVPREFIX we can use code below
jr z,jpnextcmd ; ..to save a byte
else ; Otherwise, we have to do an
jp z,nextcmd ; ..absolute jump
endif ;drvprefix
endif ;fcp ne 0
runcmd1:
if fastecp or badduecp
ld a,(firstchar) ; If FIRSTCHAR flag set for ECP invocation,
cp ' ' ; ..then go straight to transient processing
jr z,com
endif ;fastecp or badduecp
colon equ $+1 ; Flag for in-the-code modification
ld a,0 ; If command had a directory prefix (even just
or a ; ..a colon) then skip over resident commands
jr nz,comdir
; ---------- Module <<2>>: RCP Processing
; An option is supported here to allow the address of the RCP to be obtained
; from the environment descriptor. This is logically consistent with the
; pholosopy of the Z-System and is useful when one wants to have a single block
; of FCP/RCP memory that can be allocated dynamically between FCP and RCP
; functions.
if rcp ne 0 ; Omit code if RCP not implemented
rcpcmd:
if rcpenv ; If getting address of rcp from Z3ENV
ld e,0ch ; Offset in Z3ENV to RCP address
call pkgoff ; Set HL to address of RCP+5
jr z,cprcmd ; Skip if no RCP
else ; using fixed RCP address
ld hl,rcp+5 ; Get address from Z3BASE.LIB
endif ; rcpenv
call cmdscan ; Check for command in RCP
jr z,callproglf ; If so, run it (with leading CRLF)
endif ;rcp ne 0
; ---------- Module <<3>>: CPR-Resident Command Processing
cprcmd:
ld hl,cmdtbl ; Point to CPR-resident command table
call cmdscan ; ..and scan for the command
jr z,callprog ; If found, run it (with no leading CRLF)
; ---------- Module <<4>>: Transient Command Processing
comdir: ; Test for DU: or DIR: only (directory change)
if drvprefix
ld a,(cmdfcb+1) ; Any command name?
cp ' '
jr nz,com ; If so, must be transient or error
; Entry point for change of directory only
if wdu ; If controlled by wheel..
ld a,(z3whl) ; Get wheel byte
or a ; If wheel on, go on ahead
jr nz,comdir1
if badduecp
ld (colon),a ; Pretend there is no colon
ld a,' ' ; Force invocation of ECP
ld (firstchar),a
jr com
else ;not badduecp
ld a,ecduchg
jr z,error
endif ;badduecp
endif ; wdu
comdir1:
ld hl,(tempusr) ; Get temporary drive and user bytes
if not highuser ; If only users 0..15 can be logged
ld a,l ; Get user number and
cp 16 ; ..make sure not above 15
jr nc,baddirerr ; If out of range, invoke error handling
endif ;not highuser
dec h ; Shift drive to range 0..15
ld (curusr),hl ; Make the temporary DU into the current DU
call logcurrent ; Log into the new current directory
jpnextcmd:
jp nextcmd ; Resume command line processing
else ;not drvprefix
if badduecp
xor a ; Pretend there is no colon
ld (colon),a
ld a,' ' ; Force invocation of ECP
ld (firstchar),a
else ;not badduecp
ld a,ecduchg
jr z,error
endif ;badduecp
endif ;drvprefix
com: ; Process transient command
ld a,(cmdstatfl) ; Check command status flag to see if
and 2 ; ..error handler is running
ld (zexinpfl),a ; Store result in ZEX control flag (2 will turn
; ..ZEX input redirection off (0 = on)
if subon
ld (xsubflag),a ; Turn off XSUB input redirection also
endif ;subon
ld hl,tpa ; Set default execution/load address
ld a,3 ; Dynamically load type-3 and above ENVs
call mload ; Load memory with file specified in cmd line
ld a,(cmdstatfl) ; Check command status flag to see if
and 100b ; ..ECP running (and suppress leading CRLF)
; CALLPROG is the entry point for the execution of the loaded program. At
; alternate entry point CALLPROGLF if the zero flag is set, a CRLF is sent to
; the console before running the program.
callproglf:
call z,crlf ; Leading new line
callprog:
; Copy command tail into TBUFF
tailsv equ $+1 ; Pointer for in-the-code modification
ld hl,0 ; Address of first character of command tail
ld de,tbuff ; Point to TBUFF
push de ; Save pointer
ld bc,7e00h ; C=0 (byte counter) and B=7E (max bytes)
inc de ; Point to first char
tail:
ld a,(hl) ; Get character from tail
call tsteol ; Check for EOL
jr z,tail1 ; Jump if we are done
ld (de),a ; Put character into TBUFF
inc hl ; Advance pointers
inc de
inc c ; Increment character count
djnz tail ; If room for more characters, continue
call print ; Display overflow message
db bell ; ..ring bell
db 'Ovf','l'+80h ; ..then continue anyway
tail1:
xor a ; Store ending zero
ld (de),a
pop hl ; Get back pointer to character count byte
ld (hl),c ; Store the count
; Run loaded transient program
call defltdma ; Set DMA to 0080h standard value
; Perform automatic installation of Z3 programs (unless type-2 environment)
ld hl,(execadr) ; Get current execution address
call z3chk ; See if file is a Z3 program
jr nz,noinstall ; Branch if not
cp 2 ; If type-2 (internal) environment
jr z,noinstall ; ..do not perform installation
inc hl ; Advance to place for ENV address
ld (hl),low z3env ; Put in low byte of environment address
inc hl
ld (hl),high z3env ; Put in high byte
noinstall:
; Execution of the program occurs here by calling it as a subroutine
ld hl,z3env ; Pass environment address to program in HL
execadr equ $+1 ; Pointer for in-line code modification
call 0 ; Call transient
; Return from execution
if shellif ; If flow processing allowed in shells...
ld hl,cmdstatfl ; Reset the shell bit in the command status
res 0,(hl) ; ..flag so multiple-command shells will work
endif ;shellif
; Continue command processing
if drvprefix ; If DRVPREFIX we can save a byte by
jr jpnextcmd ; ..doing a two-step relative jump
else ; Otherwise, we just have to do
jp nextcmd ; ..the absolute jump
endif ;drvprefix
; ---------- Module <<5>>: External Error Handler Processing
baddirerr:
ld a,ecbaddir ; Error code for bad directory specification
error:
; If we are returning from an external command to process an error, we want
; to leave the error return code as it was set by the transient program.
ld hl,cmdstatfl ; Point to command status flag
bit 3,(hl) ; Check transient error flag bit
jr nz,error1 ; If set, leave error code as set externally
ld (ecflag),a ; Otherwise, save error code from A register
error1:
res 2,(hl) ; Reset the ECP bit to prevent recursion of
; ..error handler by programs that don't
; ..clear the bit
bit 0,(hl) ; Was error in attempting to run a shell?
jr nz,errsh ; If so, pop shell stack
; The following code is included to avoid a catastrophic infinite loop when
; the external error handler cannot be found. After one unsuccessful try,
; the internal code is invoked.
bit 1,(hl) ; Was an error handler already called?
jr nz,errintrnl ; If so, use internal error handler
; If the current IF state is false, we would like to ignore the error and just
; go on with the next command. Unfortunately, for some errors (e.g., a bad
; command format such as a command with a wildcard character) the error handler
; is invoked before the pointer in the multiple command line buffer is set up
; to the next command. In that case, we fall into an infinite loop. We also
; must not allow the external error handler to run, since it will not run and
; we will again fall into an infinite loop. The present code is not so bad, of
; course, since even a command in a false part of a command sequence should not
; have a true error in it. We have already put in code to bypass password
; checking during a false IF state, since a command with a password is not an
; invalid command.
if fcp ne 0
call iftest ; If we are in a false IF state, external
jr z,errintrnl ; ..handler will not run, so use built-in
endif ;fcp ne 0
set 1,(hl) ; Set command status flag for error invocation
ld hl,errcmd ; Point to error handler command line
ld a,(hl) ; Check first byte for presence of an
or a ; ..error command line
jr z,errintrnl ; If no error handler, use built-in one
ld (nxtchr),hl ; Else, use error command line as next command
jp nextcmd1 ; Run command without resetting status flag
; ---------- Module <<6>>: Resident Error Handler Code
; If the error is with the invocation of a shell command, we pop the bad shell
; command off the stack to prevent recursion of the error. We then use the
; the internal error handler to echo the bad shell command.
errsh:
ld de,shstk ; Point to current entry in shell stack
ld hl,shstk+shsize ; Point to next entry in stack
ld bc,[shstks-1]*shsize ; Bytes to move
ldir ; Pop the stack
xor a ; Clear the last entry position
ld (de),a
errintrnl:
if subon
call subkil ; Terminate active submit file if any
endif ;subon
call crlf ; New line
ld hl,(cmdptr) ; Point to beginning of bad command
call printhl ; Echo it to console
call print ; Print '?'
defb '?'+80h
jp restart ; Restart CPR
; End ZCPR33-2.Z80
page
; ZCPR33-3.Z80
;=============================================================================
;
; C O M M A N D L I N E P A R S I N G C O D E
;
;=============================================================================
; This code parses the command line pointed to by HL. The command verb is
; parsed, placing the requested program name into the command file control
; block. The drive and user bytes are set. If an explicit DU or DIR was
; given, the COLON flag is set so that the processor knows about this later
; when the command search path is built.
parser:
ld de,cmdfcb ; Point to the command FCB
push de
call initfcb ; Initialize the FCB
pop de
ld (duerrflag),a ; Store zero (INITFCB ends with A=0) into flag
call scanner ; Parse first token on command line into FCB
jr nz,badcmd ; Invoke error handler if '?' in command
duerrflag equ $+1 ; Pointer for in-the-code modification
ld a,0 ; See if bad DU/DIR specified with command verb
or a
if badduecp
jr z,parser1 ; If DU/DIR is OK, skip ahead
ld a,(cmdstatfl) ; If ECP already running
bit 2,a ; ..skip ahead
jr nz,parser1
ld a,(cmdfcb+1) ; If not a directory change command
sub ' ' ; ..invoke error handler
jr nz,baddirerr
; If bad directory change attempt,
ld (tmpcolon),a ; ..pretend there is no colon (A=0)
ld a,' ' ; ..and force immediate ECP invocation
ld (firstchar),a ; ..when command is processed
else ; If errors not processed by ECP then
jr nz,baddirerr ; ..invoke error handler
endif ; badduecp
parser1:
ld de,cmdfcb+9 ; Make sure no explicit file type was given
ld a,(de) ; Get first character of file type
cp ' ' ; Must be blank
badcmd:
ld a,ecbadcmd ; Error code for illegal command form
jr nz,error ; If not, invoke error handler
push hl ; Save pointer to next byte of command
ld hl,commsg ; Place default file type (COM) into FCB
ld bc,3
ldir
pop hl ; Get command line pointer back
; The following block of code is arranged so that the COLON flag is set only
; when an explicit directory specification is detected in the command verb.
; Other parses also change the TMPCOLON flag, but only when passing here does
; the flag get transferred to COLON.
tmpcolon equ $+1 ; Pointer for in-the-code modification
ld a,0 ; ..by SCANNER routine
ld (colon),a ; If explicit DU/DIR, set COLON flag
; Find the end of this command and set up the pointer to the next command.
push hl ; Save command line pointer
dec hl ; Adjust for preincrementing below
parser2: ; Find end of this command
inc hl ; Point to next character
ld a,(hl) ; ..and get it
call tsteol ; Test for end of command
jr nz,parser2 ; Keep looping if not
ld (nxtchr),hl ; Set pointer to next command
pop hl ; Get back pointer to current command tail
; This block of code parses two tokens in the command line into the two
; default FCBs at 5Ch and 6Ch. It also sets a pointer to the command tail
; for later copying into the command tail buffer at 80h. This code is used
; first when attempting to parse a normal command line and possibly again
; later when the entire user's command is treated as a tail to the extended
; command processor. The resident JUMP and SAVE commands use it also, and
; the entry point is available at location CCP+9 for use by other programs.
parsetail:
ld (tailsv),hl ; Save pointer to command tail
; Process first token
ld de,tfcb ; Point to first default FCB
push de ; Save pointer while initializing
call initfcb ; Initialize both default FCBs
pop de
call sksp ; Skip over spaces in command line
call nz,scanner ; If not end of line, parse the token
; ..into first FCB
ld (parseptr),hl ; Save pointer to second token for reparsing
; Process second token
call sksp ; Skip over spaces
ret z ; Done if end of line or end of command
ld de,tfcb2 ; Point to second default FCB
; ..and fall through to SCANNER routine
;-----------------------------------------------------------------------------
; This routine processes a command line token pointed to by HL. It attempts
; to interpret the token according to the form [DU:|DIR:]NAME.TYP and places
; the corresponding values into the FCB pointed to by DE. On exit, HL points
; to the delimiter encountered at the end of the token. The Z flag is set if
; a wild card was detected in the token.
scanner:
xor a ; Initialize various flags
ld (tmpcolon),a ; Set no colon
ld bc,(curusr) ; Get current drive and user into BC
inc b ; Shift drive range from 0..15 to 1..16
ld (tempusr),bc ; Initialize temporary DU
call scanfld8 ; Extract possible file name
cp ':' ; Was terminating character a colon?
jr nz,scantype ; If not, go on to extract file type
ld (tmpcolon),a ; Otherwise, set colon and process DU/DIR
inc hl ; Point to character after colon
; Code for resolving directory specifications (macro RESOLVE is defined in
; Z33MAC.LIB). RESOLVE returns with a nonzero value and a NZ flag setting
; if the DU/DIR specification cannot be resolved. There are quite a few
; possibilities here.
; Case where both forms are accepted
if accptdir and accptdu
if dufirst
resolve du,dir ; Check DU: form before DIR: form
else
resolve dir,du ; Check DIR: form before DU: form
endif ;dufirst
endif ;accptdir and accptdu
; Cases of only one form accepted
if accptdu and not accptdir
resolve du, ; Check only DU: form
endif ;accptdu and not accptdir
if accptdir and not accptdu
resolve dir, ; Check only DIR: form
endif ;accptdir and not accptdu
; Case of neither form accepted
if not accptdir and not accptdu
push hl ; Save pointer to command string
inc de ; Point to first character of name
ld a,(de) ; Get it
dec de ; Restore the pointer
sub ' ' ; If no name is there, A=0 and Z flag set
endif ;not accptdir and not accptdu
push de ; Save pointer to FCB again
push af ; Save bad directory flag
ld a,(tempdr) ; Set designated drive
ld (de),a ; ..into FCB
inc de ; Point to file name field
call ifcb ; Perform partial init (set user code)
pop af ; Get bad directory flag back
ld (duerrflag),a ; Save flag in parser code
jr z,scanner1 ; Branch if valid directory specified
dec de ; Back up to record count byte
dec de
ld (de),a ; Store error flag there (NZ if error)
scanner1:
pop de ; Get FCB pointer back
pop hl ; Restore pointer to command string
call scanfld8 ; Scan for file name
; This code processes the file type specification in the token
scantype:
ld a,(hl) ; Get ending character of file name field
ex de,hl ; Switch FCB pointer into HL
ld bc,8 ; Offset to file type field
add hl,bc
ex de,hl ; Switch pointers back
ld b,3 ; Maximum characters in file type
cp '.' ; See if file type specified
jr nz,scantype2 ; If not, skip over file type parsing
inc hl ; Point to character after '.'
push de ; Save pointer to FCB file type
call scanfield ; Parse file type into FCB
pop de
scantype2:
ex de,hl ; Swap pointers again
ld bc,5 ; Offset from file type to S1 field in FCB
add hl,bc
ex de,hl ; Swap pointers back
ld a,(tempusr) ; Get specified user number
ld (de),a ; ..and store in S1 byte of FCB
scan3: ; Skip to space character, character after an
; ..equal sign, or to end of command
ld a,(hl) ; Get next character
cp ' '+1 ; Done if less than space
jr c,scan4
call tsteol ; Done if end of line or end of command
jr z,scan4
inc hl ; Skip on to next character
cp '=' ; If not equal sign
jr nz,scan3 ; ..keep scanning
scan4: ; Set zero flag if '?' in filename.typ
qmcnt equ $+1 ; Pointer for in-the-code modification
ld a,0 ; Number of question marks
or a ; Set zero flag
ret
; This routine invokes SCANFIELD for a file name field. It initializes the
; question mark count and preserves the FCB pointer.
scanfld8:
xor a ; Initialize question mark count
ld (qmcnt),a
push de ; Save pointer to FCB
ld b,8 ; Scan up to 8 characters
call scanfield
pop de ; Restore pointer to FCB
ret
; This routine scans a command-line token pointed to by HL for a field whose
; maximum length is given by the contents of the B register. The result is
; placed into the FCB buffer pointed to by DE. The FCB must have had its name
; and type fields initialized before this routine is called. Wild cards of
; '?' and '*' are expanded. On exit, HL points to the terminating delimiter.
scanfield:
call sdelm ; Done if delimiter encountered
ret z
inc de ; Point to next byte in FCB
cp '*' ; Is character a wild card?
jr nz,scanfld1 ; Continue if not
ld a,'?' ; Process '*' by filling with '?'s
ld (de),a
call qcountinc ; Increment count of question marks
jr scanfld2 ; Skip so HL pointer left on '*'
scanfld1: ; Not wildcard character '*'
ld (de),a ; Store character in FCB
inc hl ; Point to next character in command line
cp '?' ; Check for question mark (wild)
call z,qcountinc ; Increment question mark count
scanfld2:
djnz scanfield ; Decrement char count until limit reached
scanfld3:
call sdelm ; Skip until delimiter
ret z ; Zero flag set if delimiter found
inc hl ; Pt to next char in command line
jr scanfld3
; Subroutine to increment the count of question mark characters in the
; parsed file name.
qcountinc:
push hl
ld hl,qmcnt ; Point to count
inc (hl) ; Increment it
pop hl
ret
;-----------------------------------------------------------------------------
; Validate the password pointed to by HL. Prompt user for password entry
; and return zero if it is correct.
if pwcheck
passck:
push hl ; Save pointer to password
call print ; Prompt user
defb cr,lf,'PW?',' '+80h
ld hl,pwlin ; Set up buffer for user input
ld bc,90ah ; Set 0ah (BDOS readln function) in C
ld (hl),b ; ..and 9 (max character count) in B
ex de,hl ; Switch buffer pointer to DE
if pwnoecho
ld a,0c9h ; Disable BIOS conout routine to
ld (bios+0ch),a ; ..suppress password echoing
call bdossave ; Get user input
ld a,0c3h ; Reenable BIOS conout routine
ld (bios+0ch),a
else ;not pwnoecho
call bdossave ; Get user input
endif ;pwnoecho
ex de,hl ; Restore pointer to HL
inc hl ; Point to count of characters entered
ld a,(hl) ; Get character count
inc hl ; Point to first character
push hl ; Save pointer while marking end of input
call addah ; Advance HL to just past last character
ld (hl),' ' ; Place space there
pop de ; Restore pointer to beginning of user input
pop hl ; Restore pointer to password from NDR
ld b,8 ; Maximum characters to compare
pwck:
ld a,(de) ; Get next user character
call ucase ; Capitalize it
cp (hl) ; Compare to NDR
ret nz ; No match
cp ' ' ; If last user character matched space in
ret z ; ..NDR, then we have a complete match
inc hl ; If not done, point to next characters
inc de
djnz pwck ; (flags not affected by DJNZ)
xor a ; Set zero flag and
ret ; ..return Z to show success
endif ; pwcheck
;-----------------------------------------------------------------------------
; This code attempts to interpret the token in the FCB pointed to by register
; pair DE as a DIR (named directory) prefix. If it is successful, the drive
; and user values are stored in TEMPDR and TEMPUSR, the zero flag is set, and
; a value of zero is returned in register A.
;
; If the named directory is found to be password restricted, then the user is
; asked for the password (unless the directory is the one currently logged or
; the current IF state is false). If an incorrect password is entered, the
; error handler is generally invoked directly. The exception to this is when
; the transient program bit is set in the command status flag (this bit would
; be set by a non-CPR program that calls REPARSE). In this case the default
; directory is returned, the zero flag is reset, and a nonzero value in
; returned in register A to show a bad directory. In addition, the code in
; SCANNER will set record-count byte in the FCB to a nonzero value so that
; the calling program can detect the error. [Note: if DU processing is also
; allowed and it follows DIR processing, DUSCAN will also be called. Unless
; there is a passworded directory with a DU form, this will cause no trouble.]
if accptdir
dirscan:
; If the DU form is not allowed, we have to detect a colon-only condition here.
; Otherwise DUSCAN will take care of it.
inc de ; Point to first byte of directory form
if not accptdu
ld a,(de) ; Get first character of directory
sub ' ' ; If it is a blank space
ret z ; ..we have a successful directory resolution
endif ;not accptdu
ex de,hl ; Switch pointer to FCB to HL
if ndrenv ; If getting NDR address for Z3ENV
ld e,15h ; Offset to NDR address
push hl ; Preserve pointer to FCB
call pkgoff ; Get NDR address from ENV into DE
pop hl
jr z,direrr ; Branch if no NDR implemented
else ; using fixed address of NDR buffer
ld de,z3ndir ; Point to first entry in NDR
endif ; ndrenv
dirscan1:
ld a,(de) ; Get next character
or a ; Zero if end of NDR
jr z,direrr
inc de ; Point to name of directory
inc de
push hl ; Save pointer to name we are looking for
push de ; Save pointer to NDR entry
ld b,8 ; Number of characters to compare
dirscan2:
ld a,(de)
cp (hl)
jr nz,dirscan3 ; If no match, quit and go on to next DIR
inc hl ; Point to next characters to compare
inc de
djnz dirscan2 ; Count down
dirscan3:
pop de ; Restore pointers
pop hl
jr z,dirscan4 ; Branch if we have good match
ex de,hl ; Advance to next entry in NDR
ld bc,16 ; 8 bytes for name + 8 bytes for password
add hl,bc
ex de,hl
jr dirscan1 ; Continue comparing
; If ACCPTDU is enabled, we can share similar code in DUSCAN and do not need
; the code here.
if not accptdu
direrr: ; No match found
dec a
ret
endif ;not accptdu
dirscan4: ; Match found
ex de,hl ; Switch pointer to NDR entry into HL
push hl ; ..and save it for later
dec hl ; Point to user corresponding to the DIR
ld c,(hl) ; Get user value into C
dec hl ; Point to drive
ld b,(hl) ; Get it into B
if pwcheck
ld hl,(curusr) ; Get current drive/user into HL
inc h ; Shift drive to range 1..16
xor a ; Clear carry flag
sbc hl,bc ; Compare
pop hl ; Restore pointer to NDR entry
jr z,setdu ; If same, accept values without PW checking
; If WPASS is set, then password checking is bypassed when the wheel byte is
; set.
if wpass
ld a,(z3whl) ; Get wheel byte
or a ; If wheel byte set
jr nz,setdu ; ..skip checking passwords
endif ;wpass
; This code is a bit tricky. We do not want to be asked for passwords for
; named directory references in commands when the current IF state is false.
; So, first we check to see if there is a password on the directory. If not,
; we proceed to set the temporary DU to the specified directory. If there is
; a password, we check the current IF state. If it is false, we do not check
; passwords and pretend there was no password. However, we leave the current
; directory in effect. This will work properly in all but one rare
; circumstance. When the command is an 'OR' command with a reference to a
; passworded named directory (e.g., "OR EXIST SECRET:FN.FT"), the password
; will not be requested and the current directory will be used instead of the
; specified one.
push bc ; Save requested drive/user
ld bc,8 ; Point to password in NDR
add hl,bc
ld a,(hl) ; Get first character of password
cp ' ' ; Is there a password?
if fcp eq 0 ; If FCP not implemented ...
call nz,passck ; Perform password checking if pw present
else ;fcp ne 0 ; FCP implemented ...
jr z,dirscan5 ; If no pw, skip ahead
call iftest ; Otherwise, test current IF state
pop bc ; Restore BC in case we return now
ret z ; If false IF in effect, fake success without
; ..checking password (but TEMPDR/TEMPUSR not
; ..set)
push bc ; Otherwise, save BC again
call passck ; Perform password checking
endif ;fcp eq 0
dirscan5:
pop bc ; Restore requested drive/user
jr z,setdu ; If not bad password, set it up
ld a,(cmdstatfl) ; See if external invocation (disable
bit 3,a ; ..error handling if so)
ret nz ; Return NZ to show bad directory
ld a,ecbadpass ; Error code for bad password
jp error
else ;not pwcheck
pop hl ; Clean up stack
if accptdu ; If we cannot fall through, branch
jr setdu
endif ;accptdu
endif ;pwcheck
if not accptdu ; If NOT ACCPTDU, we have to supply code here
setdu:
ld (tempusr),bc
xor a ; Set Z to flag success
ret
endif ;not accptdu
endif ;accptdir
;-----------------------------------------------------------------------------
; This code attempts to interpret the token in the FCB pointed to by register
; pair DE as a DU (drive/user) prefix. If it is successful, the drive and
; user values are stored in TEMPDR and TEMPUSR, the zero flag is set, and a
; value of zero is returned in register A. Otherwise the zero flag is reset
; and a nonzero value is returned in register A.
;
; The ADUENV option allows acceptance of the DU form to be controlled by the
; DUOK flag in the environment descriptor. An additional feature of this code
; when the ADUENV option is enabled is that a DU value is always accepted,
; even if DUOK is off and even if it is outside the normally allowed range,
; if it corresponds to a named directory with no password. The currently
; logged directory is unconditionally acceptable (if you got there once, you
; can stay as long as you like without further hassles).
if accptdu ; Allow DU: form
direrr: ; This code may do double duty for DIRSCAN
; ..above
duerr:
xor a ; Return NZ to show failure
dec a
ret
duscan:
ex de,hl ; Switch FCB pointer to HL
inc hl ; Point to first byte of file name in FCB
ld bc,(curusr) ; Preset C to current user, B to current drive
ld a,(hl) ; Get possible drive specification
sub 'A' ; Otherwise convert to number 0..15
jr c,duscan1 ; If < 0, leave B as is
cp 16
jr nc,duscan1 ; If > 15, leave B as is
ld b,a ; Otherwise use value given
inc hl ; ..and point to next character
duscan1:
inc b ; Shift drive to range 1..16
ld a,(hl) ; Get possible user specification
cp ' '
jr z,duscan2 ; If none present, leave C as is
push bc ; Save DU values in BC
call decimal1 ; Get specified decimal user number into BC
pop hl ; Restore values to HL
jr c,duerr ; Return NZ if invalid decimal conversion
ld a,b ; Get high byte of result
or a ; Make sure it is zero
ret nz ; If not, return NZ to show bad user number
ld b,h ; DU value is now in BC
; If the specified directory is the currently logged directory, accept it
; even if it is out of range and/or password protected.
duscan2:
ld hl,(curusr) ; Get current drive/user into HL
inc h ; Shift drive to range 1..16
xor a ; Clear carry flag
sbc hl,bc ; Compare values
jr z,setdu
; If the specified DU corresponds to a named directory with no password, or
; if WPASS is enabled so that password checking is not performed when the
; wheel byte is set, then accept it.
if z3ndir ne 0
call du2dir ; See if there is a matching named directory
jr z,duscan3 ; If not, skip on
if pwcheck ; If passwords are being checked...
if wpass
ld a,(z3whl) ; Get wheel byte
or a ; If wheel byte set, skip checking passwords
jr nz,setdu ; ..and accept the DU values
endif ;wpass
ld de,9 ; Advance to password
add hl,de
ld a,(hl) ; Get first character of password
cp ' '
jr z,setdu ; If none, we have a valid DU
else ;not pwcheck
jr setdu ; Set the DU
endif ;pwcheck
endif ;z3ndir ne 0
duscan3:
if aduenv ; Check DUOK flag in ENV
ld a,(duokfl) ; Get flag
or a ; If DU not accepted
jr z,duerr ; ..skip over the DU scan
endif ;aduenv
if duenv ; If getting max drive and user from ENV
ld hl,(maxdrenv) ; Get max drive into L and max user into H
ld a,l ; Test drive value
cp b
jr c,duerr
ld a,h ; Test user value
cp c
jr c,duerr
else ; Using fixed values of max DU
ld a,maxdisk
cp b
jr c,duerr
ld a,maxusr
cp c
jr c,duerr
endif ;duenv
setdu:
ld (tempusr),bc
xor a ; Set Z to flag success
ret
endif ; accptdu
; End ZCPR33-3.Z80
page
; ZCPR33-4.Z80
;=============================================================================
;
; G E N E R A L S U B R O U T I N E S S E C T I O N
;
;=============================================================================
;-----------------------------------------------------------------------------
;
; CHARACTER I/O BDOS ROUTINES
;
;-----------------------------------------------------------------------------
; Get uppercase character from console (with ^S processing). Registers B,
; D, H, and L are preserved. The character is returned in A.
conin:
ld c,1 ; BDOS conin function
call bdossave
; Fall through to UCASE
;--------------------
; Convert character in A to upper case. All registers except A are preserved.
ucase:
and 7fh ; Mask out msb
cp 61h ; Less than lower-case 'a'?
ret c ; If so, return
cp 7bh ; Greater than lower-case 'z'?
ret nc ; If so, return
and 5fh ; Otherwise capitalize
ret
;----------------------------------------
; Output CRLF
crlf:
call print
db cr
db lf or 80h
ret
;----------------------------------------
; Output character in A to the console. All registers are preserved.
conout:
push de
push bc
ld c,2 ; BDOS conout function
output: ; Entry point for LCOUT below
ld e,a
call bdossave
pop bc
pop de
ret
;----------------------------------------
; Print the character string immediately following the call to this routine.
; The string terminates with a character whose high bit is set or with a null.
; At entry point PRINTC the string is automatically preceded by a
; carriage-return-linefeed sequence. All registers are preserved except A.
printc:
call crlf ; New line
print:
ex (sp),hl ; Get pointer to string
call printhl ; Print string
ex (sp),hl ; Restore HL and set return address
ret
;----------------------------------------
; Print the character string pointed to by HL. Terminate on character with
; the high bit set or on a null character. On return HL points to the byte
; after the last character displayed. All other registers except A are
; preserved.
printhl:
ld a,(hl) ; Get a character
inc hl ; Point to next byte
or a ; End of string null?
ret z
push af ; Save flags
and 7fh ; Mask out msb
call conout ; Print character
pop af ; Get flags
ret m ; String terminated by msb set
jr printhl
;-----------------------------------------------------------------------------
;
; FILE I/O BDOS ROUTINES
;
;-----------------------------------------------------------------------------
; Read a record from a file to be listed or typed
if lton ; Only needed for LIST and TYPE functions
readf:
ld de,tfcb
jr read
endif ; lton
;----------------------------------------
; Read a record from the command file named in CMDFCB
readcmd:
ld de,cmdfcb
; Read a record from file whose FCB is pointed to by DE
read:
ld c,14h ; Read-sequential function
; Fall through to BDOSSAVE
;--------------------
; Call BDOS for read and write operations. The flags are set appropriately.
; The BC, DE, and HL registers are preserved.
bdossave:
putreg
call bdos
getreg
or a ; Set flags
note: ; This return is used for NOTE command, too
ret
;-----------------------------------------------------------------------------
;
; MISCELLANEOUS BDOS ROUTINES
;
;-----------------------------------------------------------------------------
; Set DMA address. At the entry point DEFLTDMA the address is set to the
; default value of 80H. At the entry point DMASET it is set to the value
; passed in the DE registers.
defltdma:
ld de,tbuff
dmaset:
ld c,1ah
jr bdossave
;----------------------------------------
; Log in the drive value passed in the A register (A=0).
setdrive:
ld e,a
ld c,0eh
jr bdossave
;----------------------------------------
; Open a file. At entry point OPENCMD the file is the one specified in
; CMDFCB, and the current record is set to zero. At entry point OPEN
; the file whose FCB is pointed to by DE is used.
opencmd:
xor a ; Set current record to 0
ld (cmdfcb+32),a
ld de,cmdfcb ; Command file control block
; Fall through to open
open:
ld c,0fh ; BDOS open function
; Fall through to BDOSTEST
;--------------------
; Invoke BDOS for disk functions. This routine increments the return code in
; register A so that the zero flag is set if there was an error. Registers
; BC, DE, and HL are preserved.
bdostest:
call bdossave
inc a ; Set zero flag for error return
ret
;----------------------------------------
; Close file whose FCB is pointed to by DE.
if saveon or subon
close:
ld c,10h
jr bdostest
endif ;saveon or subon
;----------------------------------------
; Search for first matching file. At entry point SRCHFST1 the first default FCB
; is used. At entry point SRCHFST the FCB pointed to by DE is used.
if diron or eraon or renon or saveon
srchfst1:
ld de,tfcb ; Use first default FCB
endif ;diron or eraon or renon or saveon
srchfst:
ld c,11h
jr bdostest
;-----------------------------------------------------------------------------
; Search for next matching file whose FCB is pointed to by DE.
if diron or eraon ; Only needed by DIR and ERA functions
srchnxt:
ld c,12h
jr bdostest
endif ; diron or eraon
;-----------------------------------------------------------------------------
; Kill any submit file that is executing.
if subon
subkil:
ld hl,subflag ; Check for submit file in execution
ld a,(hl)
or a ; 0=no
ret z ; If none executing, return now
; Kill submit file
xor a
ld (hl),a ; Zero submit flag
call setuser ; Log in user 0
ld de,subfcb ; Delete submit file
; ..by falling through to delete routine
endif ; subon
;--------------------
; Delete file whose FCB is pointed to by DE.
if eraon or renon or saveon or subon
delete:
ld c,13h
jr bdossave
endif ;eraon or renon or saveon or subon
;-----------------------------------------------------------------------------
; Get and set user number. Registers B, D, H, and L are preserved. Register
; E is also preserved at entry point SETUSER1.
getuser:
ld a,0ffh ; Get current user number
setuser:
ld e,a ; User number in E
setuser1:
ld c,20h ; Get/Set BDOS function
jr bdossave
;-----------------------------------------------------------------------------
;
; GENERAL UTILITY ROUTINES
;
;-----------------------------------------------------------------------------
; This subroutine checks to see if a program loaded at an address given by HL
; has a Z3ENV header. If the header is not present, the zero flag is reset.
; If it is present, the zero flag is set, and on return HL points to the
; environment-type byte and A contains that byte.
z3chk:
ld de,z3env+3 ; Point to 'Z3ENV' string in ENV
inc hl ; Advance three bytes to possible program
inc hl ; ..header
inc hl
ld b,5 ; Characters to compare
z3chk1: ; Check for Z3 ID header
ld a,(de) ; Get character from ENV descriptor
cp (hl) ; Compare it to loaded file
ret nz ; Quit now if mismatch
inc hl ; If same, advance to next characters
inc de ; ..and continue comparing
djnz z3chk1 ; (flags not affected by DJNZ)
ld a,(hl) ; Return the environment type in A
ret ; Return Z if all 5 characters match
;----------------------------------------
; Subroutine to skip over spaces in the buffer pointed to by HL. On return,
; the zero flag is set if we encountered the end of the line or a command
; separator character.
sksp:
ld a,(hl) ; Get next character
inc hl ; Point to the following character
cp ' ' ; Space?
jr z,sksp ; If so, keep skipping
dec hl ; Back up to non-space
; ..and fall through
;--------------------
; Subroutine to check if character is the command separator or marks the end
; of the line.
tsteol:
or a ; End of command line?
ret z ; Return with zero flag set
cp cmdsep ; Command separator?
ret ; Return with flag set appropriately
;----------------------------------------
; Initialize complete FCB pointed to by DE
initfcb:
xor a
ld (de),a ; Set default disk (dn byte is 0)
inc de ; Point to file name field
call ifcb ; Fill 1st part of FCB
; Fall through to IFCB to run again
;--------------------
; Initialize part of FCB whose file name field is pointed to by DE on entry.
; The file name and type are set to space characters; the EX, S2, RC, and the
; following CR (current record ) or DN (disk number) fields are set to zero.
; The S1 byte is set to the current user number. On exit, DE points to the
; byte at offset 17 in the FCB (two bytes past the record count byte).
ifcb:
ld b,11 ; Store 11 spaces for file name and type
ld a,' '
call fill
xor a
ld (de),a ; Set extent byte to zero
inc de
ld a,(curusr)
ld (de),a ; Set S1 byte to current user
inc de
ld b,3 ; Store 3 zeroes
xor a ; Fall thru to fill
;--------------------
; Fill memory pointed to by DE with character in A for B bytes
fill:
ld (de),a ; Fill with byte in A
inc de ; Point to next
djnz fill
ret
;----------------------------------------
; Subroutine to display the 'no file' error message for the built-in
; commands DIR, ERA, LIST, TYPE, and/or REN.
if diron or eraon
prnnf:
call printc ; No file message
defb 'No Fil','e'+80h
ret
endif ; diron or eraon
;----------------------------------------
; Calculate address of command table in package from Z3ENV. On entry, E
; contains the offset to the address of the package in the environment. On
; exit, DE points to the beginning of the package and HL points to the fifth
; byte (where the command table starts in the RCP and FCP modules). The zero
; flag is set on return if the package is not supported.
if fcpenv or rcpenv or ndrenv
pkgoff:
ld hl,z3env ; Point to beginning of ENV descriptor
ld d,0 ; Make DE have offset
add hl,de ; ..and add it
ld a,(hl) ; Get low byte of package address
inc hl ; Point to high byte
ld h,(hl) ; ..and get it
ld l,a ; Move full address into HL
or h ; Set zero flag if no package
ld de,5 ; Offset to start of table
ex de,hl ; Preserve start address of package in DE
add hl,de ; Pointer to 5th byte of package in HL
ret ; Return with zero flag set appropriately
endif ;fcpenv or rcpenv or ndrenv
;----------------------------------------
; This subroutine checks to see if we are in a false IF state. If that is
; the case, the routine returns with the zero flag set. If there is not active
; IF state or if it is true, then the zero flag is reset.
if fcp ne 0 ; Omit code if FCP not implemented
iftest:
ld bc,(ifptrfl) ; Current IF pointer into C, IF status into B
ld a,c ; See if any IF in effect
or a
jr z,iftest1 ; Branch if no IF state is active
and b ; Mask the current IF status
ret
iftest1:
dec a ; Reset the zero flag
ret
endif ;fcp ne 0
;----------------------------------------
; Print the command prompt with DU and/or DIR (but without any trailing
; character). This is also the code in which the current drive and user
; will be stored. The conditional assemblies are somewhat involved because
; of the possibilities of either or both of the DU or DIR forms being omitted
; from the prompt.
prompt:
call crlf
if incldu ; If drive/user in prompt
ld hl,(curusr) ; Get current drive/user into HL
; If INCLENV is enabled, the drive and user (DU) will be included in the
; prompt based on the state of the DUOK flag in the environment. If INCLENV
; is disabled, the DU form will always be included if INCLDU is on.
if inclenv
ld a,(duokfl) ; If ENV disallows DU,
or a ; ..then don't show it in
jr z,prompt2 ; ..the prompt, either
endif ;inclenv
ld a,h ; Get current drive
add a,'A' ; Convert to ascii A-P
call conout
ld a,l ; Get current user
if supres ; If suppressing user # report for user 0
or a
jr z,prompt2
endif
cp 10 ; User < 10?
jr c,prompt1
if highuser ; If allowing users 16..31
ld c,'0'-1
prompt0:
inc c
sub 10
jr nc,prompt0
add a,10
ld b,a
ld a,c
call conout
ld a,b
else ;using only standard user numbers 0..15
sub 10 ; Subtract 10 from user number
push af ; Save low digit
call print ; Display a '1' for tens digit
defb '1' or 80h
pop af
endif ;highuser
prompt1:
add a,'0' ; Output 1's digit (convert to ascii)
call conout
prompt2:
endif ; incldu
; Display named directory
if incldir
if incldu
ld b,h ; Copy drive/user from HL to BC
ld c,l ; ..(saves a byte)
else
ld bc,(curusr) ; Get current drive and user into BC
endif ;incldu
inc b ; Switch drive to range 1..16
call du2dir ; See if there is a corresponding DIR form
ret z ; If not, return now
if incldu ; Separate DU and DIR with colon
if inclenv
ld a,(duokfl) ; If not displaying DU, then
or a ; ..don't send separator, either
ld a,':' ; Make the separator
call nz,conout ; ..and send if permitted
else
call print ; Put in colon separator
defb ':' or 80h
endif ;inclenv
endif ; incldu
ld b,8 ; Max of 8 chars in DIR name
prompt3:
inc hl ; Point to next character in DIR name
ld a,(hl) ; ..and get it
cp ' ' ; Done if space
ret z
call conout ; Print character
djnz prompt3 ; Count down
endif ; incldir
ret
;-----------------------------------------------------------------------------
; Subroutine to convert DU value in BC into pointer to a matching entry in
; the NDR. If there is no match, the routine returns with the zero flag set.
; If a match is found, the zero flag is reset, and the code returns with HL
; pointing to the byte before the directory name.
if z3ndir ne 0
du2dir:
if ndrenv ; If getting NDR address from environment
ld e,15h ; Offset to NDR in Z3ENV
call pkgoff ; Get address of NDR into DE
ex de,hl ; ..and switch into HL
ret z ; If no NDR, return with zero flag set
jr du2dir2
else
ld hl,z3ndir-17 ; Scan directory for match
endif ;ndrenv
du2dir1: ; Advance to next entry in NDR
ld de,16+1 ; Skip user (1 byte) and name/pw (16 bytes)
add hl,de
du2dir2:
ld a,(hl) ; End of NDR?
or a
ret z ; If so, return with zero flag set
inc hl ; Point to user number in NDR entry
cp b ; Compare drive values
jr nz,du2dir1 ; If mismatch, back for another try
ld a,(hl) ; Get user number
sub c ; ..and compare
jr nz,du2dir1 ; If mismatch, back for another try
dec a ; Force NZ to show successful match
ret
endif ;z3ndir ne 0
;-----------------------------------------------------------------------------
; This routine gets the next line of input for the command buffer. The
; following order of priority is followed:
; If ZEX is active, the next line is obtained from ZEX
; If a submit file is running, its last record provides the input
; If there is a command line on the shell stack, use it
; Finally, if none of the above, the input is obtained from the user
readbuf:
ld a,(zexrunfl) ; Get ZEX-running flag
or a
jr nz,userinput ; If ZEX running, go directly to user input
if subon ; If submit facility is enabled, check for it
ld a,(subflag) ; Test for submit file running
or a
jr z,shellinput ; If not, go on to possible shell input
xor a ; Log into user 0
call setuser
call defltdma ; Initialize DMA pointer
ld de,subfcb ; Point to submit file FCB
call open ; Try to open file
jr z,readbuf1 ; Branch if open failed
ld hl,subfrc ; Point to record count in submit FCB
ld a,(hl) ; Get the number of records in file
dec a ; Reduce to number of last record
ld (subfcr),a ; ..and put into current record field
call read ; Attempt to read submit file
jr nz,readbuf1 ; Branch if read failed
dec (hl) ; Reduce file record cound
dec hl ; Point to S2 byte of FCB (yes, this is req'd!)
ld (hl),a ; Stuff a zero in there (A=0 from call to READ)
call close ; Close the submit file one record smaller
jr z,readbuf1 ; Branch if close failed
; Now we copy the line read from the file into the multiple command line
; buffer
ld de,chrcnt ; Point to command length byte in command buffer
ld hl,tbuff ; Point to sector read in from submit file
if buflen gt 7fh ; If command line buffer is longer than record,
ld bc,80h ; ..then copy entire record from $$$.SUB file
else ;buflen le 7fh ; Otherwise copy only enough to fill
ld bc,buflen+1 ; ..the command line buffer
endif ;buflen gt 7fh
ldir ; Transfer line from submit file to buffer
; We now deal with various options that control the display of commands fed
; to the command processor from a submit file.
if subnoise gt 0 ; If subnoise = 0 we omit all this display code
if subnoise eq 1 ; If subnoise = 1 we follow the quiet flag
ld a,(quietfl)
or a
jr nz,readbuf0 ; If quiet, skip echoing the command
endif ;subnoise eq 1
call prompt ; Print prompt
call print ; Print submit prompt trailer
defb sprmpt or 80h
ld hl,cmdlin ; Print command line
call printhl
endif ;subnoise gt 0
readbuf0:
call break ; Check for abort (any char)
ret nz ; If no ^C, return to caller and run
readbuf1:
call subkil ; Kill submit file and abort
jp restart ; Restart CPR
endif ; subon
shellinput:
ld hl,shstk ; Point to shell stack
ld a,(hl) ; Check first byte
cp ' '+1 ; See if any entry
jr c,userinput ; Get user input if none
ld de,cmdlin ; Point to first character of command line
ld bc,shsize ; Copy shell line into command line buffer
ldir ; Do copy
ex de,hl ; HL points to end of line
ld a,1 ; Set command status flag to show
ld (cmdstatfl),a ; ..that a shell has been invoked
jr readbuf3 ; Store ending zero and exit
userinput:
call prompt ; Print prompt
call print ; Print prompt trailer
defb cprmpt or 80h
ld c,0ah ; Read command line from user
ld de,bufsiz ; Point to buffer size byte of command line
call bdos
; Store null at end of line
ld hl,chrcnt ; Point to character count
ld a,(hl) ; ..and get its value
inc hl ; Point to first character of command line
call addah ; Make pointer to byte past end of command line
readbuf3:
ld (hl),0 ; Store ending zero
ret
;-----------------------------------------------------------------------------
; Check for any character from the user console. Return with the character
; in A. If the character is a control-C, then the zero flag will be set.
if subon or diron or eraon or lton
break:
ld c,0bh ; BDOS console status function
call bdossave ; Call BDOS and set flags
call nz,conin ; Get input character if there is one
cp 'C'-'@' ; Check for abort
ret
endif ; subon or diron or eraon or lton
;-----------------------------------------------------------------------------
; Add A to HL (HL=HL+A)
addah:
add a,l
ld l,a
ret nc
inc h
ret
;-----------------------------------------------------------------------------
; The routine NUMBER evaluates a string in the first FCB as either a decimal
; or, if terminated with the NUMBASE hexadecimal marker, a HEX number. If the
; conversion is successful, the value is returned as a 16-bit quantity in BC.
; If an invalid character is encountered in the string, the routine returns
; with the carry flag set and HL pointing to the offending character.
if saveon
number:
ld hl,tfcb+8 ; Set pointer to end of number string
ld bc,8 ; Number of characters to scan
ld a,numbase ; Scan for HEX identifier
cpdr ; Do the search
jr nz,decimal ; Branch if HEX identifier not found
inc hl ; Point to HEX marker
ld (hl),' ' ; Replace HEX marker with valid terminator
; ..and fall through to HEXNUM
endif ;saveon
;----------------------------------------
; At this entry point the character string in the first default FCB is
; converted as a hexadecimal number (there must NOT be a HEX marker).
hexnum:
ld hl,tfcb+1 ; Point to string in first FCB
; At this entry point the character string pointed to by HL is converted
; as a hexadecimal number (there must be NO HEX marker at the end).
hexnum1:
ld de,16 ; HEX radix base
jr radbin ; Invoke the generalized conversion routine
;----------------------------------------
; This entry point performs decimal conversion of the string in the first
; default FCB.
decimal:
ld hl,tfcb+1 ; Set pointer to number string
; This entry point performs decimal conversion of the string pointed to
; by HL.
decimal1:
ld de,10 ; Decimal radix base
; Fall through to generalized
; ..radix conversion routine
; This routine converts the string pointed to by HL using the radix passed in
; DE. If the conversion is successful, the value is returned in BC. HL points
; to the character that terminated the number, and A contains that character.
; If an invalid character is encountered, the routine returns with the carry
; flag set, and HL points to the offending character.
radbin:
ld bc,0 ; Initialize result
radbin1:
or a ; Make sure carry is reset
call sdelm ; Test for delimiter (returns Z if delimiter)
ret z ; Return if delimiter encountered
sub '0' ; See if less than '0'
ret c ; Return with carry set if so
cp 10 ; See if in range '0'..'9'
jr c,radbin2 ; Branch if it is valid
cp 'A'-'0' ; Bad character if < 'A'
ret c ; ..so we return with carry set
sub 7 ; Convert to range 10..15
radbin2:
cp e ; Compare to radix in E
ccf ; Carry should be set; this will clear it
ret c ; If carry now set, we have an error
inc hl ; Point to next character
push bc ; Push the result we are forming onto the stack
ex (sp),hl ; Now HL=result, (sp)=source pointer
call mpy16 ; HLBC = previous$result * radix
ld h,0 ; Discard high 16 bits and
ld l,a ; ..move current digit into HL
add hl,bc ; Form new result
ld c,l ; Move it into BC
ld b,h
pop hl ; Get string pointer back
jr radbin1 ; Loop until delimiter
;-----------------------------------------------------------------------------
; This routine multiplies the 16-bit values in DE and HL and returns the
; 32-bit result in HLBC (HL has high 16 bits; BC has low 16 bits). Register
; pair AF is preserved.
mpy16:
ex af,af' ; Save AF
ld a,h ; Transfer factor in HL to A and C
ld c,l
ld hl,0 ; Initialize product
ld b,16 ; Set bit counter
rra ; Shift AC right so first multiplier bit
rr c ; ..is in carry flag
mp161:
jr nc,mp162 ; If carry not set, skip the addition
add hl,de ; Add multiplicand
mp162:
rr h ; Rotate HL right, low bit into carry
rr l
rra ; Continue rotating through AC, with
rr c ; ..next multiplier bit moving into carry
djnz mp161 ; Loop through 16 bits
ld b,a ; Move A to B so result is in HLBC
ex af,af' ; Restore original AF registers
ret
;-----------------------------------------------------------------------------
; This routine checks for a delimiter character pointed to by HL. It returns
; with the character in A and the zero flag set if it is a delimiter. All
; registers are preserved except A.
sdelm:
ld a,(hl) ; Get the character
exx ; Use alternate register set (shorter code)
ld hl,deldat ; Point to delimiter list
ld bc,delend-deldat; Length of delimiter list
cpir ; Scan for match
exx ; Restore registers
ret ; Returns Z if delimiter
deldat: ; List of delimiter characters
db ' '
db '='
db '_'
db '.'
db ':'
db ';'
db '<'
db '>'
db ','
db 0
if cmdsep ne ';'
db cmdsep
endif ;cmdsep ne ';'
delend:
;-----------------------------------------------------------------------------
; Log into DU contained in FCB pointed to by DE. Registers DE are preserved;
; all others are changed. Explicit values for the temporary drive and user
; are extracted from the FCB. If the record-count byte has an FF in it, that
; is a signal that the directory specification was invalid. We then invoke
; the error handler.
if diron or eraon or lton or renon or saveon
fcblog:
push de ; Save pointer to FCB
ex de,hl
ld a,(hl) ; Get drive
ld bc,13 ; Offset to S1 field
add hl,bc
ld c,(hl) ; Get user into C
or a ; See if drive value was 0
jr nz,fcblog1 ; If not, branch ahead
ld a,(curdr) ; Otherwise substitute current drive
inc a ; ..shifted to range 1..16
fcblog1:
ld b,a ; Get drive into B
ld (tempusr),bc ; Set up temporary DU values
call logtemp ; ..and log into it
pop de ; Restore pointer to FCB
; Now check to make sure that the directory specification was valid.
inc hl ; Advance pointer to record-count byte
inc hl
ld a,(hl) ; See if it is nonzero
or a
jp nz,baddirerr ; If so, invoke error handler
ret ; Otherwise return
endif ;diron or eraon or lton or renon or saveon
;-----------------------------------------------------------------------------
; Log into the temporary directory. Registers B, H, and L are preserved.
logtemp:
ld de,(tempusr) ; Set D = tempdr, E = tempusr
call setuser1 ; Register D is preserved during this call
ld a,d ; Move drive into A
dec a ; Adjust for drive range 0..15
jp setdrive ; Log in new drive and return
;-----------------------------------------------------------------------------
; This routine scans the command table pointed to by HL for the command name
; stored in the command FCB. If the command is not found, the routine returns
; with the zero flag reset. If the command is found, the address vector is
; stored in EXECADR and the zero flag is set.
cmdscan:
ld b,(hl) ; Get length of each command
inc hl ; Point to first command name
scannext:
ld a,(hl) ; Check for end of table
or a
jr z,scanend ; Branch if end
ld de,cmdfcb+1 ; Point to name of requested command
push bc ; Save size of commands in table
if wheel
; Ignore commands with high bit set in first
; ..char of command name if wheel is false
ld a,(z3whl) ; Get the wheel byte
or a
ld c,0ffh ; Make a mask that passes all characters
jr z,scancmp ; Use this mask if wheel not set
endif ; wheel
ld c,7fh ; Use mask to block high bit if wheel set
; ..or not in use
scancmp:
ld a,(de) ; Compare against table entry
xor (hl)
and c ; Mask high bit of comparison
jr nz,scanskip ; No match, so skip rest of command name
inc de ; Advance to next characters to compare
inc hl
res 7,c ; Mask out high bit on characters after first
djnz scancmp ; Count down
ld a,(de) ; See if next character in input command
cp ' ' ; ..is a space
jr nz,scanbad ; If not, user command is longer than commands
; ..in the command table
; Matching command found
pop bc ; Clear stack
ld a,(hl) ; Get address from table into HL
inc hl
ld h,(hl)
ld l,a
ld (execadr),hl ; Set execution address
xor a ; Set zero flag to show that command found
ret
scanskip:
inc hl ; Skip to next command table entry
djnz scanskip
scanbad:
pop bc ; Get back size of each command
inc hl ; Skip over address vector
inc hl
jr scannext ; Try scanning next entry in table
scanend:
xor a ; Reset zero flag to show
dec a ; ..that command was not found
ret
; End ZCPR33-4.Z80
page
; ZCPR33-5.Z80
;=============================================================================
;
; R E S I D E N T C O M M A N D C O D E
;
;=============================================================================
; Command: DIR
; Function: To display a directory of the files on disk
; Forms:
; DIR <afn> Displays the DIR-attribute files
; DIR Same as DIR *.*
; DIR <afn> S Displays the SYS-attribute files
; DIR /S Same as DIR *.* S
; DIR <afn> A Display both DIR and SYS files
; DIR /A Same as DIR *.* A
if diron
dir:
ld de,tfcb ; Point to target FCB
push de ; ..and save the pointer for later
inc de ; Point to file name
ld a,(de) ; Get first character
if slashfl ; If allowing "DIR /S" and "DIR /A" formats
cp '/' ; If name does not start with '/'
jr nz,dir1 ; ..branch and process normally
inc de ; Point to second character
ld a,(de) ; Get option character after slash
ld (tfcb2+1),a ; ..and put it into second FCB
dec de ; Back to first character
ld a,' ' ; Simulate empty FCB
endif ;slashfl
dir1:
cp ' ' ; If space, make all wild
jr nz,dir2
ld b,11
ld a,'?'
call fill
dir2:
pop de ; Restore pointer to FCB
call fcblog ; Log in the specified directory
if whldir
ld a,(z3whl) ; Check wheel status
or a ; If not set, then ignore options
jr z,dir2a
endif ;whldir
ld a,(tfcb2+1) ; Check for any option letter
ld b,1 ; Flag for both DIR and SYS files
cp allchar ; See if all (SYS and DIR) option letter
jr z,dirpr ; Branch if so
dec b ; B = 0 for SYS files only
cp syschar ; See if SYS-only option letter
jr z,dirpr ; Branch if so
dir2a:
ld b,80h ; Flag for DIR-only selection
; Drop into DIRPR to print directory
endif ; diron
;--------------------
; Directory display routine
; On entry, if attribute checking is required, the B register is
; set as follows:
; 00H for SYS files only
; 80H for DIR files only
; 01H for both
if diron or eraon
dirpr:
if diron ; Attribute checking needed only for DIR
ld a,b ; Get flag
ld (systst),a ; Set system test flag
endif
ld e,0 ; Set column counter to zero
push de ; Save column counter (E)
call srchfst1 ; Search for specified file (first occurrence)
jr nz,dir3
call prnnf ; Print no-file message
pop de ; Restore DE
xor a ; Set Z to show no files found
ret
; Entry selection loop. On entering this code, A contains the offset in the
; directory block as returned by the search-first or search-next call.
dir3:
if diron ; Attribute checking needed only for DIR cmd
call getsbit ; Get and test for type of files
jr z,dir6
else ;not diron
dec a ; Adjust returned value from 1..4 to 0..3
rrca ; Multiply by 32 to convert number to
rrca ; ..offset into TBUFF
rrca
ld c,a ; C = offset to entry in TBUFF
endif ;diron
pop de ; Restore count of
ld a,e ; ..entries displayed
inc e ; Increment entry counter
push de ; Save it
and 03h ; Output CRLF if 4 entries printed in line
jr nz,dir4
call crlf ; New line
jr dir5
dir4:
call print
if wide
defb ' ' ; 2 spaces
defb fence ; Then fence char
defb ' ',' '+80h ; Then 2 more spaces
else ;not wide
defb ' ' ; Space
defb fence ; Then fence char
defb ' '+80h ; Then space
endif ; wide
dir5:
ld a,1
call dirptr ; HL now points to 1st byte of file name
call prfn ; Print file name
dir6:
call break ; Check for abort
jr z,dir7
call srchnxt ; Search for next file
jr nz,dir3 ; Continue if file found
dir7:
pop de ; Restore stack
dec a ; Set NZ flag
ret
endif ; diron or eraon
;-----------------------------------------------------------------------------
if diron or attchk or eraon
; This routine returns a pointer in HL to the directory entry in TBUFF that
; corresponds to the offset specified in registers C (file offset) and C
; (byte offset within entry).
dirptr:
ld hl,tbuff
add a,c ; Add the two offset contributions
call addah ; Set pointer to desired byte
ld a,(hl) ; Get the desired byte
ret
endif ; diron or attchk or eraon
;-----------------------------------------------------------------------------
; Test File in FCB for existence, ask user to delete if so, and abort if he
; choses not to
if saveon or renon
extest:
ld de,tfcb ; Point to FCB
push de ; ..and save it for later
call fcblog ; Log into specified directory
call srchfst1 ; Look for specified file
pop de ; Restore pointer
ret z ; OK if not found, so return
call printc
if bellfl
defb bell
endif ;bellfl
defb 'Erase',' '+80h
ld hl,tfcb+1 ; Point to file name field
call prfn ; Print it
call print ; Add question mark
defb '?' or 80h
call conin ; Get user response
cp 'Y' ; Test for permission to erase file
jp nz,restart ; If not, flush the entire command line
jp delete ; Delete the file
endif ; saveon or renon
;-----------------------------------------------------------------------------
; Print file name pointed to by HL
if diron or renon or saveon
prfn:
ld b,8 ; Display 8 characters in name
call prfn1
call print ; Put in dot
defb '.' or 80h
ld b,3 ; Display 3 characters in type
prfn1:
ld a,(hl) ; Get character
inc hl ; Point to next
call conout ; Print character
djnz prfn1 ; Loop through them all
ret
endif ;diron or renon or saveon
;-----------------------------------------------------------------------------
; This routine returns NZ if the file has the required attributes and Z if
; it does not. It works by performing the 'exclusive or' of the mask passed
; in register A and the filename attribute obtained by masking out all but
; the highest bit of the character. For the 'both' case, setting any bit
; in the mask other than bit 7 will guarantee a nonzero result.
;
; File name: : X 0 0 0 0 0 0 0 (After 80H mask, X=1 if SYS, 0 if DIR)
;
; SYS-ONLY : 0 0 0 0 0 0 0 0 (XOR gives 00H if X=0 and 80H if X=1)
; DIR-ONLY : 1 0 0 0 0 0 0 0 (XOR gives 80H if X=0 and 00H if X=1)
; BOTH : 0 0 0 0 0 0 0 1 (XOR gives 01H if X=0 and 81H if X=1)
if diron or attchk
getsbit:
dec a ; Adjust to returned value from 1..4 to 0..3
rrca ; Multiply by 32 to convert number to
rrca ; ..offset into TBUFF
rrca
ld c,a ; Save offset in TBUFF in C
ld a,10 ; Add 10 to point to SYS attribute bit
call dirptr ; A = SYS byte
and 80h ; Look only at attribute bit
systst equ $+1 ; In-the-code variable
xor 0 ; If SYSTST=0, SYS only; if SYSTST=80H, DIR
; ..only; if SYSTST=1, both SYS and DIR
ret ; NZ if OK, Z if not OK
endif ;diron or attchk
;-----------------------------------------------------------------------------
; Command: REN
; Function: To change the name of an existing file
; Forms: REN <New UFN>=<Old UFN>
; Notes: If either file spec is ambiguous, or if the source file does
; not exist, the error handler will be entered. If a file with
; the new name already exists, the user is prompted for deletion
; and ZEX is turned off during the prompt.
if renon
ren:
ld hl,tfcb ; Check for ambiguity in first file name
call ambchk
call fcblog ; Login to fcb
ld hl,tfcb2 ; Check for ambiguity in second file name
call ambchk
xor a ; Use current drive for 2nd file
ld (de),a
call srchfst ; Check for old file's existence
jr nz,ren0a ; Branch if file exists
jpnofile:
ld a,ecnofile ; Set error code for file not found
jp error ; ..and invoke error handler
ren0a:
call extest ; Test for file existence and return if not
ld b,12 ; Exchange new and old file names
push de ; Save pointer to FCB
ld hl,tfcb2 ; Point to FCB for old file name
ren0:
ld a,(de) ; Get character of old name
ld c,a ; ..into C register
ld a,(hl) ; Get character of new name
ld (de),a ; ..into place in old name
ld (hl),c ; Put character of old name into new name
inc hl ; Advance pointers
inc de
djnz ren0
; Perform rename function
pop de ; Restore pointer to FCB
ld c,17h ; BDOS rename function
jp bdostest
endif ;renon
;-----------------------------------------------------------------------------
; Command: ERA
; Function: Erase files
; Forms:
; ERA <afn> Erase specified files and dislay their names
; ERA <afn> I Display names of files to be erased and prompt for
; inspection before erase is performed. (Character 'I'
; is defined by INSPCH in Z33HDR.LIB; if it is ' ', then
; any character triggers inspection.)
if eraon
era:
if inspfl and eraok; 'I' flag and verification enabled?
ld a,(tfcb2+1) ; Get flag, if any, entered by user
ld (eraflg),a ; Save it in code below
endif ;erav and eraok
ld de,tfcb ; Point to target FCB
call fcblog ; ..and log into the specified directory
if diron or attchk ; Attribute checking only in these cases
ld b,1 ; Display all matching files
endif ;diron or attchk
call dirpr ; Print directory of erased files
ret z ; Abort if no files
if eraok ; Print prompt
if inspfl ; Test verify flag
eraflg equ $+1 ; Address of flag (in-the-code modification)
ld a,0
cp inspch ; Is it an inspect option?
if inspch ne ' ' ; If an explicit inspect character is specified
jr nz,era2 ; ..skip prompt if it is not that character
else ; If INSPCH is the space character
jr z,era2 ; ..then skip prompt only if FCB has a space
endif ;inspch ne ' '
endif ;inspfl
call printc
defb 'OK to Erase','?'+80h
call conin ; Get reply
cp 'Y' ; Yes?
ret nz ; Abort if not
endif ; eraok
era2:
ld de,tfcb
jp delete ; Delete files and return
endif ; Eraon
;-----------------------------------------------------------------------------
; Command: LIST
; Function: Print out specified file on the LST: device
; Forms: LIST <ufn> Print file (No Paging)
; Notes: The flags which apply to TYPE do not take effect with LIST
if lton
list:
ld a,0ffh ; Turn on printer flag
jr type0
;-----------------------------------------------------------------------------
; Command: TYPE
; Function: Print out specified file on the CON: Device
; Forms: TYPE <ufn> Print file with default paging option
; TYPE <ufn> P Print file with paging option reversed
type:
xor a ; Turn off printer flag
; Common entry point for LIST and TYPE functions
type0:
ld (prflg),a ; Set printer/console flag
ld a,(tfcb2+1) ; Check for user page toggle ('P') option
ld (pgflg),a ; Save it as a flag in code below
ld hl,tfcb ; Point to target file FCB
call ambchk ; Check for ambiguous file spec (vectors to
; ..error handler if so)
call fcblog ; Log into specified directory
call open ; Open the file
if renon ; If REN on, share code
jr z,jpnofile
else ;not renon ; Otherwise repeat code here
ld a,ecnofile
jp z,error
endif ;renon
call crlf ; New line
ld a,(crttxt0) ; Set line count using value from the
; ..environment for CRT0
inc a ; One extra the first time through
ld (pagcnt),a
ld bc,080h ; Set character position and tab count
; (B = 0 = tab, C = 080h = char position)
; Main loop for loading next block
type2:
ld a,c ; Get character count
cp 80h ; If not end of disk record
jr c,type3 ; ..then skip
call readf ; Read next record of file
ret nz ; Quit if end of file
ld c,0 ; Reset character count
ld hl,tbuff ; Point to first character
; Main loop for printing characters in TBUFF
type3:
ld a,(hl) ; Get next character
and 7fh ; Mask out MSB
cp 1ah ; Check for end of file (^z)
ret z ; Quit if so
; Output character to CON: or LST: device with tabulation
cp cr ; If carriage return,
jr z,type4 ; ..branch to reset tab count
cp lf ; If line feed, then output
jr z,type4a ; ..with no change in tab count
cp tab ; If tab
jr z,type5 ; ..expand to spaces
; Output character and increment character count
call lcout ; Output character
inc b ; Increment tab count
jr type6
; Output CR and reset tab count
type4:
ld b,0 ; Reset tab counter
; Output LF and leave tab count as is
type4a:
call lcout ; Output <cr> or <lf>
jr type6
; Process tab character
type5:
ld a,' ' ; Space
call lcout
inc b ; Increment tab count
ld a,b
and 7
jr nz,type5 ; Loop until column = n * 8 + 7
; Continue processing
type6:
inc c ; Increment character count
inc hl ; Point to next character
push bc
call break ; Check for user abort
pop bc
ret z ; Quit if so
jr type2 ; Else back for more
;--------------------
; Output character in A to console or list device depending on a flag.
; Registers are preserved. This code is used only by the LIST and TYPE
; commands.
lcout:
push af ; Save character
prflg equ $+1 ; Pointer for in-the-code modification
ld a,0 ; ..to determine destination (CON or LST)
or a ; Z=type, NZ=list
jr z,lc1
; Output to list device
pop af ; Get character back
push de
push bc
ld c,5 ; LISTOUT function
jp output
; Output to console with paging
lc1:
pop af ; Get character back
push af ; Save it again for page check
call conout ; Output to console
pop af ; Get character back again
cp lf ; Check for new line (paging)
ret nz ; If not new line, we are done
; Paging routines
pager:
push hl
ld hl,pagcnt ; Decrement lines remaining on screen
dec (hl)
jr nz,pager1 ; Jump if not end of page
; New page
ld a,(crttxt0) ; Get full page count from environment
ld (hl),a ; Reset count to a full page
pgflg equ $+1 ; Pointer to in-the-code buffer pgflg
ld a,0
cp pagech ; Page default override option wanted?
if pagech ne ' ' ; If using explicit character for page toggle
if pagefl ; If paging is default
jr z,pager1 ; ..PAGECH means no paging
else ; If paging not default
jr nz,pager1 ; ..PAGECH means please paginate
endif ;pagefl
else ; Any character toggles paging
if pagefl ; If paging is default
jr nz,pager1 ; ..any character means no paging
else ; If paging not default
jr z,pager1 ; ..any character means please paginate
endif ;pagefl
endif ;pagech ne ' '
; End of page
push bc
call bios+9 ; Wait for user input (BIOS console input)
pop bc
cp 'C'-'@' ; Did user enter control-c?
jp z,nextcmd ; If so, terminate this command
pager1:
pop hl ; Restore HL
ret
endif ; lton
;-----------------------------------------------------------------------------
; Command: SAVE
; Function: To save the contents of the TPA onto disk as a file
; Forms:
; SAVE <Number of Pages> <ufn>
; Save specified number of pages (starting at 100H) from TPA
; into specified file
;
; SAVE <Number of Sectors> <ufn> <S>
; Like SAVE above, but numeric argument specifies
; number of sectors rather than pages
if saveon
; Entry point for SAVE command
save:
call number ; Extract number from command line
jr c,badnumber ; Invoke error handler if bad number
push bc ; Save the number
call reparse ; Reparse tail after number of sectors/pages
pop hl ; Get sector/page count back into HL
ld a,(tfcb2+1) ; Check sector flag in second FCB
cp sectch
if sectch ne ' ' ; If using a specific character, then jump
jr z,save0 ; ..if it is that character
else ; If allowing any character (SECTCH=' ')
jr nz,save0 ; ..jump if it is anything other than space
endif ;sectch ne ' '
add hl,hl ; Double page count to get sector count
save0:
ld a,1 ; Maximum allowed value in H
cp h ; Make sure sector count < 512 (64K)
jr c,badnumber ; If >511, invoke error handler
push hl ; Save sector count
ld hl,tfcb
call ambchk ; Check for ambiguous file spec (vectors to
; ..error handler if so)
call extest ; Test for existence of file and abort if so
ld c,16h ; BDOS make file function
call bdostest
jr z,save3 ; Branch if error in creating file
pop bc ; Get sector count into BC
ld hl,tpa-80h ; Set pointer to one record before TPA
save1:
ld a,b ; Check for BC = 0
or c
dec bc ; Count down on sectors (flags unchanged,
; ..B=0FFH if all records written successfully)
jr z,save2 ; If BC=0, save is done so branch
push bc ; Save sector count
ld de,80h ; Advance address by one record
add hl,de
push hl ; Save address on stack
ex de,hl ; Put address into DE for BDOS call
call dmaset ; Set DMA address for write
ld de,tfcb ; Write sector
ld c,15h ; BDOS write sector function
call bdossave
pop hl ; Get address back into HL
pop bc ; Get sector count back into BC
jr z,save1 ; If write successful, go back for more
ld b,0 ; B=0 if write failed
save2:
call close ; Close file even if last write failed
and b ; Combine close return code with
; ..write success flag
ret nz ; Return if all ok
save3: ; Disk must be full
ld a,ecdiskfull ; Disk full error code
jr jperror
endif ; saveon
;-----------------------------------------------------------------------------
if lton or saveon or renon or geton
; Check file control block pointed to by HL for any wildcard characters ('?').
; Return to calling program if none found. Otherwise branch to error handler.
; The routine also treats an empty file name as ambiguous.
ambchk:
push hl ; Save pointer to FCB
inc hl ; Point to first character in file name
ld a,(hl) ; See if first character is a space
cp ' '
jr z,ambchk1 ; If so, branch to error return
ld a,'?' ; Set up for scan for question mark
ld bc,11 ; Scan 11 characters
cpir
pop de ; Restore pointer to FCB in DE
ret nz ; Return if no '?' found
ambchk1:
ld a,ecambig ; Error code for ambiguous file name
jr jperror
endif ;lton or renon or saveon or geton
if lton or renon or saveon or geton or jumpon
badnumber:
ld a,ecbadnum ; Error code for bad number value
jperror: ; Local entry point for relative jump
jp error ; ..to go to error handler
endif ;lton or renon or saveon or geton or jumpon
;-----------------------------------------------------------------------------
; Command: JUMP
; Function: To execute a program already loaded into some specified memory
; address
; Forms: JUMP <adr> <tail>
; The address is in hex; the tail will be parsed as usual
if jumpon
jump:
call hexnum ; Get load address into BC
jr c,badnumber ; If bad number, invoke error handling
push bc ; ..and save it
call reparse ; Reparse tail after address value
pop hl ; Restore execution address to HL
jr getproglf ; Perform call via code below
endif ;jumpon
;-----------------------------------------------------------------------------
; Command: GO
; Function: To Call the program in the TPA without loading
; loading from disk. Same as JUMP 100H, but much
; more convenient, especially when used with
; parameters for programs like STAT. Also can be
; allowed on remote-access systems with no problems.
;
;Form: GO <tail>
if goon
go:
ld hl,tpa ; Set up TPA as the execution address
endif ; goon
if jumpon or goon ; Common code
getproglf:
ld (execadr),hl
xor a ; Set zero flag to enable leading CRLF
jp callproglf ; Perform call (with leading CRLF)
endif ;jumpon or goon
;-----------------------------------------------------------------------------
; Command: GET
; Function: To load the specified file from disk to the specified address
; Forms: GET <adr> <ufn>
; Loads the specified file to the specified hexadecimal address
; Note that the normal file search path is used to find the file.
; If SCANCUR is off, the file may not be found in the current
; directory unless a colon is included in the file spec.
if geton
get:
; TMPCOLON was set when the file name was parsed. We use that as the colon
; flag so that the file will be loaded from a directory just as if it had
; been entered as the command name.
if drvprefix and [not scancur]
ld a,(tmpcolon) ; Allow GET to load from specified
ld (colon),a ; directory
endif ;drvprefix and [not scancur]
ld hl,tfcb2 ; Copy TFCB2 to CMDFCB for load
push hl
ld de,cmdfcb
ld bc,14
ldir
pop hl
call ambchk ; Make sure file is not ambiguous (vectors
; ..to error handler if so)
; If GET fails to find the specified file along the search path, we do not
; want the ECP to be engaged. To prevent that, we fool the command processor
; by telling it that the ECP is already engaged.
ld hl,cmdstatfl ; Point to command status flag
set 2,(hl) ; Turn on ECP flag to prevent use of ECP
call hexnum ; Get load address into BC
jr c,badnumber ; If invalid number, invoke error handler
if not fullget
ld a,b ; If trying to load into base page
or a ; ..treat as error
jr z,badnumber
endif ;not fullget
ld h,b ; Move address into HL
ld l,c
ld a,0ffh ; Disable dynamic loading
; Fall through to mload
endif ; geton
; End ZCPR33-5.Z80
page
; ZCPR33-6.Z80
;=============================================================================
;
; P A T H S E A R C H A N D F I L E L O A D I N G C O D E
;
;=============================================================================
; This block of code loads a file into memory. The normal address at which
; loading is to begin is passed to the routine in the HL register. The name
; of the file to load is passed in the command file control block.
;
; This code supports an advanced option that loads files to a dynamic address
; specified in the header to the file using a new type-3 environment. In a
; type-3 environment, the execution/load address is stored in the word
; following the environment descriptor address. A value is passed to MLOAD in
; the A register that controls this dynamic loading mechanism. The value
; specifies the lowest environment type value for which dynamic loading will
; be performed. This value will be 3 when MLOAD is called for normal COM file
; execution and will be 0FFH when chained to from the GET command. In the
; latter case, the user-specified load address must be used.
;
; MLOAD guards against loading a file over the operating system. It computes
; the lower of the following two addresses: 1) the CPR entry point; 2) the
; bottom of protected memory as indicated by the DOS entry address stored at
; address 0006H. If the load would exceed this limit, error handling is
; engaged (except for the GET command when FULLGET is enabled).
mload:
ld (envtype),a ; Set up in-the-code modification below
ld (execadr),hl ; Set up execution/load address
call defltdma ; Set DMA address to 80H for file searches
; This code sets the attributes of COM files which are acceptable. If both
; SYS and DIR type files are acceptable, there is no need to include this code,
; and ATTCHK can be set to false.
if attchk ; Only if attribute checking enabled
ld a,comatt ; Attributes specified in Z33HDR.LIB
ld (systst),a ; Set flag
endif ;attchk
;-----------------------------------------------------------------------------
; PATH BUILDING CODE
; In ZCPR33 the minpath feature, optional in ZCPR30, is always used. To
; minimize the size of the CPR code, however, there is an option to place the
; minpath in an external buffer (outside the CPR). If the path is short
; enough, the minpath can be placed at the bottom of the system stack.
ld de,path ; Point to first element in user's symbolic path
ld hl,mpath ; Point to minpath buffer
xor a
ld (hl),a ; Initialize to empty minpath
; If DRVPREFIX is enabled, the CPR will recognize an explicit directory
; reference in a command. The first element of the path will then be this
; explicit directory. If no explicit directory was given in the command,
; then no entry is made into the search path. If the WPREFIX option is
; on, explicit directory prefixes will be recognized only when the wheel
; byte is on.
if drvprefix ; Pay attention to du:com prefix?
ld a,(colon) ; See if colon was present in command
or a
jr z,makepath2 ; If not, skip ahead
if wprefix
ld a,(z3whl) ; See if wheel byte is on
or a
jr z,makepath2 ; If not, skip ahead
endif ;wprefix
ld a,(cmdfcb) ; Get drive from command FCB
ld (hl),a ; Put drive into minpath
inc hl ; Advance pointer
ld a,(cmdfcb+13) ; Get user number from command FCB
ld (hl),a ; Put it into minpath
inc hl ; Advance pointer to next path element
xor a ; A=0
ld (hl),a ; Store ending 0 in mpath
makepath2:
endif ; drvprefix
; If SCANCUR is enabled in Z33HDR.LIB, then we always include the current
; directory automatically, even without a '$$' element in the user's path.
; If WPREFIX is enabled, however, we do not want to allow the current
; directory to be included, but we must make sure that it is included in
; the building of the root path, in case the user's symbolic path is empty.
if scancur ; Scan current directory at all times?
ld bc,(curusr) ; C = current user, B = current drive
inc b ; Set drive to range 1..16
if wprefix
ld a,(z3whl) ; See if wheel byte is on
or a
jr nz,addpath ; If it is, add element to path; if not,
; ..fall through to MAKEPATH3
else ;not wprefix
jr addpath ; Begin loop of placing entries into mpath
endif ;wprefix
else ;not scancur
; If SCANCUR is off and ROOTONLY is in effect, we have to make sure that some
; directory values are put into the root path in the case where the user's
; path is completely empty. To do so, we preset BC for directory A0.
if rootonly
ld bc,0100h ; Setup for drive A (B=1), user 0 (C=0)
endif ;rootonly
endif ;scancur
; Convert symbolic entries in user's path into absolute DU values in minpath.
; Entries are read one-by-one from the symbolic path. If the 'current' drive
; or user indicator is present (default symbol is '$'), then the current
; drive or user value is fetched. Otherwise the explicit binary value from the
; path is used. After each absolute DU value is formed, the minpath as it
; exists so far is scanned to see if this DU value is already there. If it is
; not, then the DU value is appended to the path. Otherwise it is ignored.
makepath3:
ld a,(de) ; Get next symbolic path entry
or a ; If 0, we are at end of path
jr z,makepath6
ld bc,(curusr) ; C = current user, B = current drive
inc b ; Set drive to range 1..16
cp curind ; Check for current drive symbol (default '$')
jr z,makepath4 ; If so, leave current drive in B
ld b,a ; Else move specified drive into B
makepath4:
inc de ; Point to user value in symbolic path
ld a,(de) ; Get user
inc de ; Point to next element in symbolic path
cp curind ; Check for current user symbol (default '$')
jr z,makepath5 ; If so, leave current drive in C
ld c,a ; Else move specified user into C
makepath5:
; At this point in the code we have a potential path element in BC. We first
; have to scan the minpath we have so far to see if that element is already
; there. In that case we ignore it; otherwise we add it to the end of the path.
addpath:
; Skip path if directory given explicitly
if skippath
if wprefix
ld a,(z3whl) ; See if wheel byte is on
or a
call nz,skipchk ; If not, fall through
else ;not wprefix
call skipchk ; See if path should be skipped
endif ;wprefix
jr nz,makepath3 ; If so, branch out of ADDPATH
endif ;skippath
ld hl,mpath ; Point to beginning of minpath
addpath1: ; Point of reentry
ld a,(hl) ; Get drive value
or a ; Check for end of minpath
jr z,addpath2 ; If end, jump and add BC to minpath
inc hl ; Increment pointer to user
cp b ; Check for drive match
ld a,(hl) ; Get user from minpath
inc hl ; Point to next minpath entry
jr nz,addpath1 ; If drive was different, loop back again
cp c ; Check for user match
jr nz,addpath1 ; If user is different, loop back again
jr makepath3 ; Branch if we have a duplicate
; We have a new DU; add it to minpath
addpath2:
ld (hl),b ; Store drive
inc hl
ld (hl),c ; Store user
inc hl
ld (hl),0 ; Store ending 0
jr makepath3 ; Continue scanning user's path
; If the ECP facility is set up to use the root directory, then create a
; root path. BC presently contains the proper DU.
makepath6:
if rootonly
ld hl,rootpth ; Point to special path to contain root
ld (hl),b ; Store disk
inc hl
ld (hl),c ; Store user
endif ;rootonly
;-----------------------------------------------------------------------------
; This is the code for loading the specified file by searching the minpath.
xor a ; Always use current disk specification in the
ld (cmdfcb),a ; ..command FCB
mload1:
ld hl,mpath ; Point to beginning of minpath
mload2:
; Either the FASTECP or BADDUECP option may have set FIRSTCHAR to a space
; character as a signal to go directly to extended command processing. If
; neither option is enabled but SKIPPATH is, then the FIRSTCHAR data is
; stored in the routine below where path skipping is implemented.
if fastecp or badduecp
ld a,(cmdstatfl) ; If ECP is running
bit 2,a ; ..we branch to look for ECP along path
jr nz,mload2a
firstchar equ $+1 ; Pointer for in-the-code modification
ld a,0
cp ' ' ; Was command invoked with leading space?
jr z,ecprun ; If so, go directly to ECP code
endif ;fastecp or badduecp
mload2a:
ld a,(hl) ; Get drive from path
or a ; If end of path, command not found
jr nz,mload3 ; If not end of path, skip over ECP code
;-----------------------------------------------------------------------------
; EXTENDED COMMAND PROCESSING
; At this point we have exhausted the search path. We now engage the
; extended command processor.
ecprun:
if skippath
call skipchk ; See if path should be skipped
jr nz,jnzerror ; If so, invoke error handler
endif ;skippath
ld hl,cmdstatfl ; Point to command status flag
ld a,(hl) ; ..and get value
and 110b ; Isolate ECP and error handler bits
jnzerror: ; If either is set,
ld a,ecnocmd ; Error code for command not found
jp nz,error ; ..process as an error
set 2,(hl) ; Set ECP bit
ld hl,ecpfcb ; Copy name of ECP to command FCB
ld de,cmdfcb
ld bc,12 ; Only 12 bytes required
ldir
ld hl,(cmdptr) ; Get pointer to current command line
call parsetail ; Parse entire command as the command tail
if rootonly ; Look for ECP in root directory only
ld hl,rootpth ; Point to path containing root directory only
jr mload2 ; Search for command
else ; not rootonly
jr mload1 ; Search the entire minpath for the ECP
endif ; rootonly
;-----------------------------------------------------------------------------
mload3:
ld b,a ; Drive into B
inc hl ; Point to user number
ld c,(hl) ; User into C
ld (tempusr),bc ; Save the values
inc hl ; Point to next entry in path
call logtemp ; Log in path-specified user/drive
if attchk ; If allowing execution only of COM files with
; ..specific attributes
ld de,cmdfcb ; Point to command FCB
call srchfst ; Look for directory entry for file
jr z,mload2a ; Continue path search if file not found
push hl ; Save path pointer
call getsbit ; Check system attribute bit
pop hl ; Restore path pointer
jr z,mload2a ; Continue if attributes do not match
call opencmd ; Open file for input
jr z,mload2a ; If open failed, back to next path element
else ;not attchk
call opencmd ; Open file for input
jr z,mload2a ; If open failed, back to next path element
endif ; attchk
call readcmd ; Read first record into default DMA address
jr nz,mload5 ; Branch if zero-length file
xor a ; Set file current record back to zero
ld (cmdfcb+20h),a
ld hl,80h ; Pointer to start of code
call z3chk
jr nz,mload3a ; If not Z3 file, branch
; The following test is modified by earlier code. For normal COM file loading,
; a 3 is inserted for the minimum environment type for dynamic load address
; determination. For the GET command, where the user-specified address should
; be used, a value of 0FFH is put in here so the carry flag will always be set.
envtype equ $+1 ; Pointer for in-the-code modification
cp 3 ; See if no higher than a type-3 environment
jr c,mload3a ; If higher than type 3, branch
inc hl ; Advance to load address word
inc hl
inc hl
ld a,(hl) ; Get load address into HL
inc hl
ld h,(hl)
ld l,a
ld (execadr),hl ; Set new execution/load address
mload3a:
ld hl,(execadr) ; Get initial loading address
; Load the file, making sure neither CPR nor protected memory is overwritten
mload4:
if fullget
ld a,(envtype) ; If ENVTYPE is FF (from GET command)
inc a ; ..then skip memory limit checking
jr z,mload4b
endif ;fullget
if rel
ld bc,entry ; We have to use a relocatable form to get
dec b ; ..highest page below the CPR
else ;not rel
ld b,high entry - 1 ; We can use shorter code for absolute form
endif ;rel
ld a,(0007h) ; Get highest page below
dec a ; ..protected memory
cp b ; If A is lower value,
jr c,mload4a ; ..branch
ld a,b ; Otherwise use lower value in B
mload4a:
cp h ; Are we going to overwrite protected memory?
ld a,ectpafull ; Get ready with TPA overflow error code
jp c,error ; Error if about to overwrite protected memory
mload4b:
push hl ; Save this load address
ex de,hl ; Set DMA address
call dmaset
call readcmd
pop hl ; Get last load address back
jr nz,mload5 ; Read error or eof?
ld de,128 ; Increment load address by 128
add hl,de
jr mload4 ; Continue loading
; In case a program would like to find out in what directory the command
; processor found the program, temporary DU is stored in bytes 13 (user) and
; 14 (drive) in the command FCB.
mload5:
tempusr equ $+1 ; Pointers for in-the-code modification
tempdr equ $+2
ld hl,0
ld (cmdfcb+13),hl
logcurrent: ; Return to original logged directory
ld hl,(curusr) ; Set L = current user, H = current drive
ld a,h
call setdrive ; Login current drive
ld a,l
jp setuser ; Log in new user and return from MLOAD
;----------------------------------------
; This routine checks to see if building the path or running the ECP should
; be skipped. If there is a colon in the command (an explicit directory
; given) but it was not a lone colon (indicating desire to skip resident
; commands), then the routine returns with the zero flag reset.
if skippath
skipchk:
ld a,(colon) ; Was there a colon in the command?
or a
ret z ; Return with zero flag set if not
if fastecp or badduecp
ld a,(firstchar) ; See if the first character was the colon
else
firstchar equ $+1 ; Put data here if other two options are
ld a,0 ; ..false (in-the-code modification)
endif ;fastecp or badduecp
cp ':'
ret ; Return: Z if lone colon, NZ otherwise
endif ;skippath
; End ZCPR33-6.Z80
page
;-----------------------------------------------------------------------------
;
; D A T A A R E A D E F I N I T I O N S
;
;-----------------------------------------------------------------------------
; ---------- Page line count buffer
if lton ; Needed only if TYPE command included
pagcnt:
defs 1 ; Lines left on page (filled in by code)
endif ;lton
; ---------- Minpath/Rootpth buffers
if extmpath
mpath equ extmpathadr ; Assign external minpath address
else
mpath:
if drvprefix
defs 2 ; Two bytes for specified DU
endif
if scancur
defs 2 ; Two bytes for current DU
endif
defs 2 * expaths ; Space for path from path buffer
defs 1 ; One byte for ending null
endif ; not extmpath
if rootonly
rootpth:
defs 2 ; Special path for root dir only
defb 0 ; End of path
endif ; rootonly
;-----------------------------------------------------------------------------
; The following will cause an error message to appear if
; the size of ZCPR33 is over 2K bytes.
if [ $ - entry ] gt 800h
*** ZCPR33 IS LARGER THAN 2K BYTES ***
endif
endif ;errflag
end ; ZCPR33