home *** CD-ROM | disk | FTP | other *** search
| Text File | 1986-11-14 | 33.4 KB | 1,274 lines |
- TITLE 'CCPXTEND 2.0.8 & LRUN - extends CCP operation (86/11/14)'
- subttl 'Definitions etc.'
- ;
- ; USER MODIFIABLE EQUATES
- ;
- ; Define a secondary search drive and user if .LBR or file is
- ; not found after initial search of current area:
- ;
- ; configures byte at 0103h. If COMMAND.LBR exists on the
- ; default drive, this (if <> '@') forces a further search
- ; when the module is not found.
- ssdrv equ 'A'; Valid values are 'A' through 'P'.
- ; set to "@" to defeat drive search
- ;
- ; configures byte at 0104h. For use with DOS+ paths should
- ; normally be disabled, and rely on $SYS file visibility.
- ssusr equ 0ffh; Valid values are 0 through 31.
- ; set to 0ffh to defeat user search.
- ;
- ; The (8 char) name at 0109h defines a further default program.
- ;
- ; Default library may also be modified. See label DFLTNAM.
- ;--------------------------------------------------------------
- ;
- ; Revisions copyright (c) 1985 by C.B. Falconer. Released under
- ; the identical conditions to those of Gary Novosielski, below.
- ;
- ; A revision of Gary Novosielski's LRUN program to co-operate
- ; with CCPLUS. When reached (automatically) from CCPLUS both the
- ; default and system disks have been searched for the file. No
- ; alternate user value has yet been used.
- ;
- ; Use with CCPLUS results in the following syntax at the CCP level
- ; when this program is named "CCPXTEND.SYS" (before the planned
- ; extensions below)
- ;
- ; B>name [command tail] executes name as a .COM on the
- ; default or alternate drives, or
- ; as a component of COMMAND.LBR
- ; on either drive. Alt. user is
- ; also searched.
- ;
- ; B>-d: name [command tail] Executes name as a component
- ; of d:COMMAND.LBR only.
- ;
- ; B>-lbrname name [command tail] Executes name as a component of
- ; lbrname.LBR on either drive/usr
- ;
- ; B>-d:lbrname name [command tail] Executes name as a component of
- ; d:lbrname.LBR only
- ;
- ; B>-d:lbrname.ext name [command tail] Executes name as a component
- ; of d:lbrname.ext only.
- ;
- ; Overall, the search path for a command without disk spec. is:
- ; 1. default drive, current user (normal CPM stops here)
- ; 2. system drive, current user (CCPLUS alone stops here)
- ; 3. default drive, user 0 (if current user not 0)
- ; 4. system drive, user 0
- ; 5. default drive, current user, in COMMAND.LBR
- ; 6. system drive, current user, in COMMAND.LBR
- ; 7. default drive, user 0, in COMMAND.LBR
- ; 8. system drive, user 0, in COMMAND.LBR
- ; . . .
- ; 9. repeats 3 thru 8 to find RUNPCD.COM. Can easily be
- ; modified to attempt for JOB or SUBMIT or anything else
- ; desired. If found it is up to RUNPCD to find the file.
- ;
- ; The alternate user (shown as 0 above) and drive (shown as system
- ; drive above) are easily reconfigured (locations 103..104h)
- ;
- ; Since this program receives the complete command line from CCPLUS
- ; it can also implement DU style disk/user specifications in future
- ;
- ; NOTE that if a file -nnn.COM exists it can be executed by CCPLUS
- ; before this system is reached.
- ;
- ; CAVEAT: the normal SYSGEN program expects to be loaded without
- ; disturbing memory from 0900h up through about 237fh (varies with
- ; system). Even the 0900h may be invalid for some systems (this is
- ; where the bootstrap image goes). To use SYSGEN from COMMAND.LBR
- ; without taking special precautions (for altering systems, e.g.
- ; installing CCPLUS) this program must not disturb this area. This
- ; version (LRUN 2.0.4 or CCPXTEND 1.4) does not disturb 0880h up,
- ; except for the 128 bytes below the CCP.
- ;
- ; The plan is:
- ; (* [n] indicates revision implemented, if any *)
- ; (using the first successful search)
- ; 1 [4] Search the defined alternate user, if different
- ; 2 [2] Do the library search. If no library specification
- ; check alternate disk, and then alternate user. Success
- ; is finding the component so that libraries can exist
- ; in more than one place and still be searched.
- ; 3 [6] If RUNPCD exists in any of the areas, pass it the line.
- ; It will purge any $$$.SUB if unable to load/execute.
- ; 3a. Alternatively pass the command to JOB to execute a submit
- ; job stream. Since JOB nests this is executable within it.
- ; 4. GIVE UP
- ;
- revision equ 8; Modified $$$.SUB erasure for use with CCP+
- ; (86/11/14) which always uses A0: for the file.
- ;
- ; 7; Corrected RUNPCD search. Uninitialized var.
- ; (86/05/15) occasionaly prevented search. cbf
- ;
- ; (86/05/18) Code unchanged, source m80 compatible. If
- ; using m80/l80 truncate output file to 2k
- ;
- ; 6; Installed search for RUNPCD executor
- ; (85/10/24) (or other installed master name). cbf
- ;
- ; (85/10/23) Unchanged. Back to Intel mnemnonics.
- ;
- ; 5; Fixed fopen again to reset current rcd no.
- ; (84/07/20) Silly omission. cbf.
- ;
- ; 4; Added alternate user search for a file
- ; (84/07/17) rather than a library component. cbf
- ;
- ; 3; Altered to use sequential reads on load.
- ; (84/07/16) Repaired file open bug (reset recd no)
- ; cbf This is in preparation for COM file loads.
- ; Added user search defeat provision.
- ; Since CCPLUS can be told to NOT upshift
- ; command lines, added upshift in parsing
- ; FCBs only. We can pass lower case lines.
- ;
- ; 2; For lrun operation. Quietened error
- ; (84/07/14) messages to act like CCP(lus)
- ; cbf
- ; 84/07/14 Converted to Z80 mnemnonics
- ; (still only 8080 opcodes used)
- ; (83/10/23) 1; suppressed sign-on except for help. cbf
- ;
- version equ 20; 82-11-19 Added equates for user
- ; area to search for command.lbr.
- ;
- ; 1$0; 82-08-06 Initial source release
- ;
- ; Can be assembled with SLR's SLRMAC or uSoft's M80 - cbf.
- ;
- ; Due to the complexity of the relocation macros, this program may
- ; take a while to assemble. Be prepared for periods of no disk
- ; activity on both passes before pressing panic button. G.P.N.
- ;
- ;
- ;--------------------------NOTICE------------------------------
- ;
- ; (c) Copyright 1982 Gary P. Novosielski
- ; All rights reserved.
- ;
- ; The following features courtesy of Ron Fowler:
- ; 1) command line reparsing and repacking (this allows
- ; the former load-only program to become a load & run
- ; utility).
- ; 2) code necessary to actually execute the loaded file
- ; 3) the HELP facility (LRUN with no arguments)
- ; 4) modified error routines to avoid warm-boot delay
- ; (return to CCP directly instead)
- ;
- ; Permission to distribute this program in source or
- ; object form without prior written aproval is granted
- ; only under the following conditions.
- ;
- ; 1. No charge is imposed for the program.
- ; 2. Charges for incidental costs including
- ; but not limited to media, postage, tele-
- ; communications, and data storage do not
- ; exceed those costs actually incurred.
- ; 3. This Notice and any copright notices in
- ; the object code remain intact
- ;
- ; (signed) Gary P. Novosielski
- ;
- ; -----------------------------------------------------
- ;
- ; LRUN is intended to be used in conjunction with libraries
- ; created with LU.COM, a library utility based upon the
- ; groundwork laid by Michael Rubenstein, with some additional
- ; inspiration from Leor Zolman's CLIB librarian for .CRL files.
- ;
- ; The user can place the less frequently used command (.COM)
- ; files in a library to save space, and still be able to run
- ; them when required, by typing:
- ; LRUN <normal command line>.
- ; The name of the library can be specified, but the greatest
- ; utility will be achieved by placing all commands in one
- ; library called COMMAND.LBR, or some locally defined name,
- ; and always letting LRUN use that name as the default.
- ;
- ;
- ; Syntax:
- ; LRUN [-<lbrname>] <command> [<parameters>]
- ;
- ; where:
- ; <lbrname> is the optional library name. In the
- ; distrubution version, this defaults to
- ; COMMAND.LBR. If the user wishes to use a
- ; different name for the default, the 8-byte
- ; literal at DFLTNAM below may be changed to
- ; suit local requirements. The current drive
- ; is searched for the .LBR file, and if not
- ; found there, the A: drive is searched.
- ; **Note that the leading minus sign (not a part
- ; of the name) is required to indicate an
- ; override library name is being entered.
- ;
- ; <command> is the name of the .COM file in the library
- ;
- ; <line> is the (possibly empty) set of parameters
- ; which are to be passed to <command>, as in
- ; normal CP/M syntax. Notice that if the
- ; library name is defaulted, the syntax is
- ; simply:
- ; LRUN <command line>
- ; which is just the normal command line with
- ; LRUN prefixed to it.
- ;
- ;--------------------------------------------------------------
- ;
- stackspace equ 64; Minimum assignment
- ;
- query equ -1
- @con equ 2
- @msg equ 9
- @ver equ 12
- @opn equ 15
- @del equ 19
- @frd equ 20
- @dma equ 26
- @usr equ 32
- @rrd equ 33
- ;
- cpmbase equ 0
- boot equ cpmbase
- bdos equ boot+5
- tfcb equ boot+5CH
- tfcb1 equ tfcb
- tfcb2 equ tfcb+16
- tbuff equ boot+80H
- tpa equ boot+100H
- ctrl equ ' '-1; Ctrl char mask
- cr equ ctrl AND 'M'
- lf equ ctrl AND 'J'
- tab equ ctrl AND 'I'
- ff equ ctrl AND 'L'
- bs equ ctrl AND 'H'
- FALSE equ 0
- TRUE equ NOT FALSE
- ;
- cpm macro func,oprnd,condtn
- if NOT NUL oprnd
- lxi d,oprnd
- endif ;; of not nul oprnd
- if NOT NUL func
- mvi c,@&func
- endif
- if NUL condtn
- call bdos
- else
- c&condtn bdos ;; call condtn,bdos (for Zilog mnems)
- endif
- endm
- ;
- ; Macro Definitions for relocatable code
- ;
- overlay set 0; default puts bits after code. Can be set
- ; non-zero to define overlayable area
- ;
- ; Sub-macros for system
- rtag macro LBL
- ??R&LBL equ $+2-@base
- endm
- ;
- rgrnd macro LBL
- ??R&LBL equ 0FFFFH
- endm
- ;
- ; The usable macros for coding
- ;
- ; "RR <lxi d,address>"
- RR macro INST
- @rlbl set @rlbl+1
- rtag %@rlbl
- INST-@base
- endm
- ;
- ; Following needed if coded in Zilog mnemnonics
- ; "SR <ld> <(location)>,<hl>"
- SR macro op,opnd,reg
- @rlbl set @rlbl+1
- rtag %@rlbl
- op (opnd-@base),reg
- endm
- ;
- ; "LR <ld> <hl>,<(location)>"
- LR macro op,reg,opnd
- @rlbl set @rlbl+1
- rtag %@rlbl
- op reg,(opnd-@base)
- endm
- ;
- ; More sub-macros for bit map generation
- nxtrld macro NN
- @rld set ??R&NN
- @nxtrld set @nxtrld + 1
- endm
- ;
- subttl 'Outer Block'
- ;
- ; Enter here from Console Command Processor (CCP)
- ;
- aseg; for m80
- org tpa
- ccpin: jmp begin; leave space for parameters
- ;
- ; These are the only use of ssdrv and ssusr.
- altdrv: db ssdrv; Put here to allow easy patching
- altusr: db ssusr
- db 0,0,0,0; spares for configuration
- ;
- ; Change this name to run a different default file.
- ; (e.g. JOB or SUBMIT) if desired. Blank name disables
- runpcd: db 'RUNPCD '; executed if component not found
- ;
- ; the HELP message and authorship notice
- ;
- hlpmsg:
- db 'LRUN Ver '; Signon message
- db version/10+'0'
- db '.'
- db version MOD 10+'0','.',revision+'0'
- db ' & CCPXTEND.SYS',cr,lf
- db ' Copyright (c) 1982 Gary P. Novosielski',cr,lf
- db tab,' (c) 1985 C.B. Falconer'
- db cr,lf,'Correct syntax is:'
- db cr,lf
- db lf,tab,'LRUN [-<lbrname>] <command line>'
- db cr,lf
- db lf,'Where <lbrname> is the optional library name'
- db cr,lf,'(Note the preceding "-". ) If omitted,'
- db cr,lf,'the default command library is used.'
- db lf
- db cr,lf,'<command line> is the name and parameters'
- db cr,lf,'of the command being run from the library,'
- db cr,lf,'just as if a separate .COM file were being run.'
- db cr,lf,lf
- db 'Also implements a search path',cr,lf
- db 'Under CCPLUS operation is automatic$'
- ;
- comlit: db 'COM'
- ;
- dfltnam:
- db 'COMMAND '; <---change this if you like---
- lbrlit: db 'LBR'
- ;
- begin: lxi h,0; get the CCP entry stackpointer
- dad sp; (used only if HELP request
- shld spsave; is encountered)
- lda bdos+2
- sui 8; allow for ccp space
- mov h,a
- mvi l,0
- sphl; ensure adequate stack room
- ; " "
- ; Initialize, find library entry, etc.
- call setup
- cc trypcd; try for RUNPCD
- jc nomemb; cannot find it
- ; " "
- ; Move the armed loader into high memory
- lhld bdos+1; find top of memory
- mov a,h; page address
- sui pages; Form destination address in
- mov d,a; DE pair.
- mvi e,0
- push d; save on stack
- lxi h,@base
- lxi b,seglen
- call move; Move the active segment.
- ; " "
- ; The segment is now moved to high memory, but not properly
- ; relocated. The bit table which specifies which addresses need
- ; to be adjusted is located just after the last byte of the source
- ; segment, so (HL) is now pointing at it.
- pop d; beginning of newly moved code.
- lxi b,seglen; length of segment
- push h; save pointer to reloc info
- mov h,d; offset page address
- ; " "
- ; Scan through the newly moved code, and adjust any page addresses
- ; by adding (H) to them. The word on top of the stack points to
- ; the next byte of the relocation bit table. Each bit in the table
- ; corresponds to one byte in the destination code.
- ; A value of 1 indicates the byte is to be adjusted.
- ; A value of 0 indicates the byte is to be unchanged.
- ;
- ; Thus one byte of relocation information serves to mark 8 bytes of
- ; object code. The bits which have not been used yet are saved in
- ; L until all 8 are used.
- ; " "
- fixup: dcx b; count down. Not zero on entry
- mov a,e
- ani 07H; on 8-byte boundary?
- jnz fixup1
- xthl; Get next byte of relocation bits
- mov a,m
- inx h
- xthl
- mov l,a; save in register L
- ; " "
- fixup1: mov a,l; remaining bits from L
- ral; next bit to CARRY
- mov l,a; save the rest
- jnc fixup2; No relocation here
- ldax d; fix this byte
- add h; (H) is the page offset
- stax d
- fixup2: inx d; advance to next address
- mov a,b
- ora c; test if finished
- jnz fixup; more
- ; " "
- ; Finished. Jump to the first address in the new
- ; segment in high memory.
- inx sp; Remove the reloc info pointer
- inx sp; (h) still has the page address
- mov l,a; move zero to l
- pchl; Stack is valid
- ;
- subttl 'Subroutines'
- ;
- ; Try for a RUNPCD available. If so, let it try for the command
- trypcd: lxi h,runpcd
- mov a,m
- cpi ' '; blank name inhibits this section
- stc
- rz
- lxi d,tbuff + 1; move the RUNPCD (or whatever is
- mvi b,8; specified) into the command line
- call insert
- lxi h,member
- mov a,m
- ora a
- stc
- rnz; drive specified
- inx h
- mvi b,8; do it all over again for searchee
- call insert
- lxi h,hold; copy the original command line tail
- mov b,m; size
- tryp2: inx h;
- mov a,m
- cpi ' '
- jnz tryp3; scan off any leading blanks
- dcr b; (already forced one in)
- jnz tryp2
- inr b
- tryp3: mov a,m
- stax d
- inx d
- inx h
- ora a
- jz tryp5; terminator, installed
- inr e
- dcr e
- stc
- jz tryp4; past page end, abort transfer
- dcr b
- jnz tryp3
- jmp tryp5; not oversized line
- tryp4: dcx d; oversized line, truncate it
- tryp5: xra a
- stax d; terminate line
- lxi h,-tbuff
- dad d; compute line length
- mov a,l
- sta tbuff
- jmp setup0; now go all around again
- ;
- ; Any one-shot initialization code goes here.
- setup: lxi h,noload
- shld ccpin+1; Prevent reentry
- mvi a,@ver
- call dos; Test version of CP/M in use
- cpi 20H; 2.0 or better?
- jc badver; No, bitch and quit.
- call getusr; What's the current user area?
- sta entusr; Save for later.
- ; " "
- ; entry point for trypcd
- setup0: call parse; Re-parse command line
- lxi d,member+9; Check member filetype
- ldax d
- cpi ' '; If blank,
- jnz setup1; Not blank,
- lxi h,comlit
- call move3; else default to COM.
- setup1: lxi d,lbrfil+9; Check library filetype
- ldax d
- cpi ' '; If blank,
- jnz setup2
- lxi h,lbrlit
- call move3; default to LBR
- setup2: lxi d,lbrfil+1; Check name
- ldax d
- cpi ' '; If blank,
- jnz setup3
- lxi b,8
- lxi h,dfltnam
- call move; use default name.
- ; " "
- ; Now test for a file on the alternate user.
- ; I am not too proud of this code, but it seems to work. cbf
- setup3: lxi h,lbrfil
- mov a,m
- sta lbrdsk; Save for future restoration
- lxi d,lbrnam
- lxi b,16
- call move; save lbr file name
- lda altusr
- inr a
- jz lopen; alt user defeated, try lbr
- call tryalt
- jc setup4; NOT found as file on altusr
- lxi h,hold
- call packup; restore the command line
- ora a; clear carry, success
- ret
- setup4: lda entusr
- mov e,a
- mvi a,@usr
- call dos; back to default user
- lxi d,lbrfil
- lxi h,lbrnam
- lxi b,16
- call move; restore any altered lbrfil name.
- ; " "
- ; Open the library and search for component
- ; This routine controls the search path.
- lopen: lxi d,lbrfil;
- call fopen; Open for directory read.
- inr a; Was it found?
- jz lopen1; No, see if search continues
- call lsrch
- rnc; successful, lbr is positioned
- lopen1: lxi d,lbrfil; lbr/component not found
- ldax d; test drive spec to see if
- ora a; it's explicit
- jnz lopen2; explicit or trying altdrv
- lda altdrv
- sui '@'
- stax d; Look on secondary drive,
- jnz lopen; if enabled, before giving up.
- lopen2: xchg
- call getusr
- xchg
- lxi h,entusr
- cmp m
- stc
- rnz; Failure, have tried alt usr/alt drv
- lda altusr
- cmp m
- stc
- rz; Failure, was already on altuser
- lda lbrdsk
- sta lbrfil; Set back to entry condition
- ora a
- stc
- rnz; Failure, was explicit on entry
- lda altusr
- mov e,a
- inr a; Carry already set, check for 0ffh
- rz; Failure, user search defeated
- mvi a,@usr
- call dos; Try alternate user/default drive
- jmp lopen; on default drive first
- ;
- ; tryalt searches for component (member) under the alternate user
- ; If successful leave lbrfil opened to the "member" id and reset
- ; to access from the beginning, with lenx set to 65535.
- ; Carry for failure.
- tryalt: lxi h,65535; Will need if success
- shld lenx; otherwise lsrch will set it up
- call getusr
- mov b,a
- lda altusr
- cmp b
- stc
- rz; Alt same as user, no search needed
- mov e,a
- mvi a,@usr
- call dos; set user access
- lxi d,lbrfil
- lxi h,member
- lxi b,16
- call move; set lbrfile to access member
- tryalt1:
- lxi d,lbrfil
- call fopen
- inr a
- ora a; clear any carrys from bdos etc
- rnz; found it, go load
- ldax d
- ora a
- stc
- rnz; this was the alternate disk try
- lda altdrv
- sui '@'
- stc
- rz; alternate disk disabled
- stax d
- jmp tryalt1; go try on alternate disk
- ;
- ; End of setup.
- ;
- ; Search library directory. Carry for failure
- ; a,f,b,c,d,e,h,l
- lsrch: lxi d,tbuff; Library open, search it
- mvi a,@dma
- call dos
- lsrch1: lxi d,lbrfil
- mvi a,@frd
- call dos; Read the directory
- ora a
- stc
- rnz; Empty file, Give up.
- lxi h,tbuff; Validate directory entry
- mov a,m
- ora a
- stc
- rnz; Directory not active??
- mvi b,8+3; Check for blanks
- mvi a,' '
- lsrch2: inx h
- cmp m
- stc
- rnz; This is not a library
- dcr b
- jnz lsrch2
- lhld tbuff+1+8+3; Index must be 0000
- mov a,h
- ora l
- stc
- rnz; This is not a library
- lhld tbuff+1+8+3+2; Get directory size
- dcx h; We already read one.
- push h; Save on stack
- ; " "
- ; Search one chunk of directory
- lsrch3: lxi h,tbuff-32; Point before buffer.
- mvi c,128/32; Number of directory entries
- lsrch5: lxi d,32
- dad d; Advance buffer pointer
- call chkeq; Check if found yet.
- jz lsrch7; Found member in .DIR
- dcr c; test next entry
- jnz lsrch5; Else need another chunk
- pop h; Read sector count from TOS
- mov a,h
- ora l; 0 ?
- stc
- rz; Member not found in this library
- dcx h; Count down
- push h; and put it back.
- lxi d,lbrfil
- mvi a,@frd
- call dos; Get next directory sector
- ora a
- jz lsrch3
- pop h; clean the stack
- stc
- ret; Empty - not a library
- ;
- ; The name was found. Now get index and length
- lsrch7: pop b; Clear stack garbage
- xchg; Pointer to sector address.
- mov e,m; Get First
- inx h
- mov d,m
- xchg
- shld random; Save it in "random"
- xchg
- inx h; Get Size to DE
- mov e,m
- inx h
- mov d,m
- xchg; Size to HL
- shld lenx
- mov a,h
- ora l
- stc
- rz; Can't handle zero length component
- lxi d,lbrfil; Position the file at the first
- mvi a,@rrd; sector of the component so
- call dos; that further reads are sequential
- ora a
- stc
- rnz; Failure
- push h
- lxi h,hold
- call packup; Repack command line arguments
- pop h; return the component length
- ora a; clear carry, success
- ret
- ;
- ;
- subttl 'Utility subroutines'
- ;
- ; insert moves a name from hl^ to de^, max b chars
- ; terminates on first blank, leaving de pointing past
- ; the moved blank. If no blank encounted, add one in
- ; The move is protected against extending the line
- ; beyond a page boundary (for moving to tbuff)
- ; a,f,b,d,e,h,l
- insert: mov a,m
- stax d
- inx d
- inx h
- cpi ' '
- rz; terminator, installed
- inr e
- dcr e
- stc
- rz; past page end, abort transfer
- dcr b
- jnz insert
- mvi a,' '; add in the terminator blank
- stax d
- inx d
- ora a; clear any carry
- ret
- ;
- ; Move 3 bytes from (hl) to (de) up
- ; a,f,b,c,d,e,h,l
- move3: lxi b,3
- ; " "
- ; Move (bc) bytes from (hl) to (de) up
- ; a,f,b,c,d,e,h,l
- move: mov a,b
- ora c
- rz; done
- dcx b
- mov a,m
- inx h
- stax d
- inx d
- jmp move
- ;
- ; REPARSE re-parses the fcbs from the command line,
- ; to allow the "-" character to prefix the library name
- ;
- parse: lxi d,member; first reinitialize both fcbs
- call nitf
- lxi d,lbrfil
- call nitf
- lxi h,tbuff; store a null at the end of
- mov e,m; the command line (this is
- mvi d,0; done by CP/M usually, except
- xchg; in the case of a full com-
- dad d; mand line
- inx h
- mvi m,0
- xchg; tbuff pointer back in hl
- parse1: inx h; bump to next char position
- mov a,m; fetch next char
- ora a; reached a null? (no arguments)
- jz help; interpret as a call for help
- cpi ' '; not null, skip blanks
- jz parse1
- cpi '-'; library name specifier?
- jnz parse2; skip if not
- inx h; it is, skip over flag character
- lxi d,lbrfil; parse library name into FCB
- call getfn
- parse2: lxi d,member; now parse the command name
- call getfn
- lxi d,hold+1; pnt to temp storage for rest of cmd line
- mvi b,-1; init a counter
- parse3: inr b; bump up counter
- mov a,m; fetch a char
- stax d; move it to hold area
- inx h; bump pointers
- inx d
- ora a; test whether char was a terminator
- jnz parse3; continue moving line if not
- mov a,b; it was, get count
- sta hold; save it in hold area
- ret
- ;
- ; Here when HELP is requested (indicated
- ; by LRUN with no arguments)
- ;
- help: lxi d,hlpmsg
- mvi a,@msg
- call dos; print the HELP message
- exit: lhld spsave; find CCP re-entry adrs
- sphl; fix & return
- ret
- ;
- ; Test status, name and type of dir. entry (hl)^ against "member"
- ; At exit DE points to last match+1 in directory entry,
- ; HL points to beginning of matchee
- ; Z flag for a match.
- ; a,f,b,d,e
- chkeq: push h
- mvi b,1+8+3; size to match
- xchg; with the one we're
- lxi h,member; looking for.
- chkeq1: ldax d
- cmp m
- jnz chkeq2; decided, not equal
- inx d
- inx h
- dcr b
- jnz chkeq1; check more
- chkeq2: pop h
- ret
- ;
- ;
- ; File name parsing subroutines
- ;
- ; PACKUP retrieves the command line stored at hl^
- ; and moves it back to tbuff, then reparses
- ; the default file control blocks so the command
- ; will never know it was run from a library
- ; a,f,b,c,d,e,h,l
- packup: mov c,m; get length byte in BC
- mvi b,0
- inx b; bump up to because length byte doesn't
- inx b; include itself or null terminator
- lxi d,tbuff
- call move; moving everybody to Tbuff
- lxi h,tbuff+1; point to the command tail
- lxi d,tfcb1; first parse out tfcb1
- call getfn
- lxi d,tfcb2; then tfcb2
- ; " "
- ; getfn gets a file name from text pointed to by reg hl into
- ; an fcb pointed to by reg de. leading delimiters are ignored.
- ; entry hl first character to be scanned
- ; de first byte of fcb
- ; exit hl character following file name
- ;
- getfn: call nitf; init 1st half of fcb
- call gstart; scan to first character of name
- rz; end of line found - leave fcb blank
- call getdrv; get drive spec. if present
- ; " "
- ; getps gets the primary and secondary names into the fcb.
- ; entry hl text pointer
- ; exit hl character following secondary name (if present)
- ; a,f,c,d,e,h,l
- getps: mvi c,8; max length of primary name
- call getnm; pack primary name into fcb
- mov a,m; see if terminated by a period
- cpi '.'; If no secondary name then
- rnz; return default (blanks)
- inx h; yup - move text pointer over period
- getps1: mov a,c; update fcb pointer to secondary
- ora a
- jz getps2
- inx d
- dcr c
- jmp getps1
- getps2: mvi c,3; pack secondary name into fcb
- ; " "
- ; getnm copies a name from the text pointer into the fcb for a
- ; given maximum length or until a delimiter is found, whichever
- ; occurs first. if more than the maximum number of characters is
- ; present, characters are ignored until a a delimiter is found.
- ; entry hl first character of name to be scaned
- ; de pointer into fcb name field
- ; c maximum length
- ; exit hl pointing to terminating delimiter
- ; de next empty byte in fcb name field
- ; c max length - number of characters transfered
- ; a,f,c,d,e,h,l
- getnm: call getch; are we pointing to a delimiter yet?
- rz; if so, name is transfered
- inx h; if not, move over character
- cpi '*'; ambigious file reference?
- jz getnm1; if so, fill rest of field with '?'
- call upshft; ensure upper case in FCB
- stax d; if not, just copy into name field
- inx d; increment name field pointer
- dcr c; if name field full?
- jnz getnm; nope - keep filling
- jmp getnm3; yup - ignore until delimiter
- getnm1: mvi a,'?'; fill character for wild card match
- getnm2: stax d; fill until field is full
- inx d
- dcr c
- jnz getnm2; fall thru to ingore rest of name
- getnm3: call getch; pointing to a delimiter?
- rz; yup - all done
- inx h; nope - ignore another one
- jmp getnm3
- ;
- ; Upshift (a) if lower case only. Carry if (a) was lower case.
- ; a,f
- upshft: cpi 'z'+1
- rnc; > 'z', not lower case
- cpi 'a'
- cmc
- rnc; < 'a', not lower case
- ani 05fh; actual upshift
- stc; signal an upshift performed
- ret
- ;
- ; nitf fills the fcb with dflt info - 0 in drive field
- ; all-blank in name field, and 0 in ex,s1,s2 and rc flds
- ; a,f,b,c
- nitf: push d; save fcb loc
- xchg; move it to hl
- mvi m,0; zap dr field
- inx h; bump to name field
- mvi b,11; zap all of name fld
- nitlp1: mvi m,' '
- inx h
- dcr b
- jnz nitlp1
- mvi b,4; zero others
- nitlp2: mvi m,0
- inx h
- dcr b
- jnz nitlp2
- xchg; restore hl
- pop d; restore fcb pointer
- ret
- ;
- ; gstart advances the text pointer (reg hl) to the first
- ; non delimiter character (i.e. ignores blanks). returns a
- ; flag if end of line (00h or ';') is found while scaning.
- ; exit hl pointing to first non delimiter
- ; a clobbered
- ; zero set if end of line was found
- ; a,f,h,l
- gstart: call getch; see if pointing to delim?
- rnz; nope - return
- cpi ';'; end of line?
- rz; yup - return w/flag
- ora a
- rz; yup - return w/flag
- inx h; nope - move over it
- jmp gstart; and try next char
- ;
- ; getdrv checks for the presence of a drive spec at the text
- ; pointer, and if present formats it into the fcb and
- ; advances the text pointer over it.
- ; entry hl text pointer
- ; de pointer to first byte of fcb
- ; exit hl possibly updated text pointer
- ; de pointer to second (primary name) byte of fcb
- ; a,f,d,e,h,l
- getdrv: inx d; point to name if spec not found
- inx h; look ahead to see if ':' present
- mov a,m
- dcx h; put back in case not present
- cpi ':'; is a drive spec present?
- rnz; nope - return
- mov a,m; yup - get the ascii drive name
- sui 'A'-1; convert to fcb drive spec
- dcx d; point back to drive spec byte
- stax d; store spec into fcb
- inx d; point back to name
- inx h; skip over drive name
- inx h; and over ':'
- ret
- ;
- ; getch gets the character pointed to by the text pointer
- ; and sets the zero flag if it is a delimiter.
- ; entry hl text pointer
- ; exit hl preserved
- ; a character at text pointer
- ; z set if a delimiter
- ;
- getch: mov a,m; get the character
- ; " "
- ; Test (a) for a delimiter. Z flag if so
- qdelim: cpi '.'
- rz
- cpi ','
- rz
- cpi ';'
- rz
- cpi ' '
- rz
- cpi ':'
- rz
- cpi '='
- rz
- cpi '<'
- rz
- cpi '>'
- rz
- ora a; Set zero flag on end of text
- ret
- ;
- ; Output char (a) to console
- ; f
- couta: push d
- mov e,a
- mvi a,@con
- call dos
- mov a,e
- pop d
- ret
- ;
- ; get current user value
- ; a,f
- getusr: push d
- mvi e,query
- mvi a,@usr
- call dos
- pop d
- ret
- ;
- ; Open file (de) for sequential access from beginning.
- ; a,f
- fopen: push h
- lxi h,12
- dad d; point to recd. no. etc.
- xra a
- mov m,a; reset to zero
- inx h
- mov m,a; (is all this, apart from
- inr m; recd no. and hi random, needed?)
- mov m,a
- inx h
- mov m,a; reset recd. no
- lxi h,32
- dad d
- mvi m,0; reset current rcd no
- inx h
- inx h
- inx h
- mvi m,0; reset hi random byte
- pop h
- mvi a,@opn
- ; " "
- ; Bdos call (a), preserving registers. Result in (a) only
- ; a,f
- dos: push h
- push d
- push b
- mov c,a
- call bdos
- pop b
- pop d
- pop h
- ret
- ;
- ; Showmember - list the name in "member" up to the first blank
- ; or null or for a max of 8 chars. For error exits
- ; a,f,h,l
- showmem:
- lxi h,member
- mov a,m
- inx h
- ora a
- jz showm1; no disk specifier
- adi '@'
- call couta
- mvi a,':'
- call couta
- showm1: mvi b,-8; max chars to list
- showm2: mov a,m
- ora a
- rz
- cpi ' '
- rz
- call couta
- inx h
- inr b
- jm showm2
- ret
- ;
- ;
- ; Error routines:
- ;
- badver: call abend
- db 'Can''t run under CP/M 1.4'
- db '$'
- nomemb: call showmem; List the not-found file name
- call abend
- db '?$'; Act just like CCP
- noload: call abend
- db 'No program in memory'
- db '$'
- nofit: call abend
- db 'NO SPACE'; Just like CCPLUS again.
- db '$'
- ;
- abend: pop d
- mvi a,@msg
- call dos
- mvi a,@usr; Rev. 8
- mvi e,0
- call dos; select user 0; Rev. 8
- lxi d,subfile
- mvi a,@del
- call dos; delete subfile
- lda entusr
- mov e,a
- mvi a,@usr
- call dos; Reset to entry user.
- jmp exit
- ;
- ;
- subttl 'Relocatable segment'
- ;
- ; Adjust location counter to next 256-byte boundry
- @base equ ($ + 0FFH) AND 0FF00H
- org @base
- @rlbl set 0
- ;
- ; The segment to be relocated goes here.
- ; Any position dependent (3-byte) instructions
- ; are handled by the "RR", "SR", "LR" macros.
- ; *******************************************************
- ;
- ; This is a loader, which loads the content of "LBRFIL" (already
- ; opened and positioned) to either the end of file or for a maximum
- ; of (lenx) records. If lenx is previously set to 65535 loading
- ; will continue to the end of file.
- ;
- ; The open FCB has been moved up here into high memory
- ; together with the loader code and entry stack setting.
- ;
- load: lxi h,tpa
- RR <shld loaddr>
- ; " "
- ; This high memory address and above, including CCP, must be
- ; protected from being overlaid by loaded program. For use of
- ; sequential read this must be checked at each read. Note that
- ; this address is slighly north of a page boundary.
- protect:
- ; " "
- ; The active loader loop
- load1:
- RR <lhld loaddr>; Increment for next time
- mov d,h
- mov e,l
- lxi b,80H
- dad b
- RR <lxi b,protect>; check for over size
- mov a,l
- sub c; If the next is above "protect"
- mov a,h; then this read will overwrite it
- sbb b
- RR <jnc loadx>; too large
- RR <shld loaddr>
- cpm dma; but use old value (DE)
- ; " "
- RR <lxi d,lbrfil>
- cpm frd; Read the sector (sequential)
- ora a; Ok?
- RR <jnz load2>; eof, bail out.
- ; " "
- RR <lhld lenx>; See if done yet.
- mov a,l
- ora h
- dcx h
- RR <shld lenx>
- RR <jnz load1>; Until done.
- ; " " Done - go run it
- load2:
- RR <lda entusr>
- mov e,a
- cpm usr; Restore USR number from setup.
- cpm dma,tbuff; Restore DMA adrs for user pgm
- RR <lhld spsave>; Restore stack so application
- sphl; can "ret" to ccp.
- jmp tpa
- ;
- ; A loading error (too large) occurred
- loadx: mvi a,0c3h; (JMP) Prevent execution of bad code
- sta tpa
- RR <lxi h,loadxx>; Gyrations to reset usr/dma
- shld tpa+1
- RR <jmp load2>; Execute dummy program instead
- loadxx:
- RR <lxi d,ldmsg>; Give message, like CCPLUS
- cpm msg
- mvi e,0
- cpm usr; Select user 0; Rev. 8
- RR <lxi d,subfile>; Abort SUBMIT if in progress
- cpm del
- RR <lda entusr>
- mov e,a
- cpm usr; Restore USR number from setup.
- jmp boot
- ;
- ldmsg: db 'NO SPACE$'
- lenx: dw 0
- entusr: db 0
- ;
- subfile:
- db 1,'$$$ SUB',0,0,0,0
- ; If used, this FCB will clobber the following one.
- ; but it's only used on a fatal error, anyway.
- ;
- lbrdsk: ds 1; Save entry disk id for restoration
- lbrfil: ds 32; Name/dsk placed here at setup
- db 0; Normal FCB plus...
- random: ds 3; ...Random access bytes
- spsave: ds 2; stack pointer save
- ;
- overlay set $; This defines the start of the bit map
- maxmem: ds 2
- loaddr: ds 2
- ;
- ; ** NOTE BENE **
- ; The space from here to the end of the page, which resides just
- ; below the CCP after relocation, is used as run-time stack space
- ds stackspace; make sure we retain enough
- ;
- ; *******************************
- ; End of segment to be relocated.
- if overlay EQ 0
- overlay set $; then start bitmap here
- endif
- ;
- pages equ ($-@base+0FFH)/256+8; (8 for ccp retention)
- ;
- seglen equ overlay-@base
- ;
- ;
- subttl 'Relocation bits'
- ;
- org @base+seglen
- ;
- ; Build the relocation information into a bit table immediately
- ; following. This area is not moved/relocated.
- ;
- @x set 0
- @bitcnt set 0
- @rld set ??R1
- @nxtrld set 2
- rgrnd %@rlbl+1; define one more label
- ;
- REPT seglen+8
- if @bitcnt GT @rld
- nxtrld %@nxtrld; next value
- endif
- if @bitcnt EQ @rld
- @x set @x OR 1; mark a bit
- endif
- @bitcnt set @bitcnt + 1
- if (@bitcnt MOD 8) EQ 0
- db @x
- @x set 0; clear hold variable for more
- else
- @x set @x SHL 1; not 8 yet. move over.
- endif
- endm
- ;
- ; Space to retain the original command line while checking
- ; This area is not moved/relocated upwards.
- db 0
- althld: db 0,0; to extend command line
- hold: db 0,0; 0 length, null terminator
- ds 128-2; rest of HOLD area
- ;
- ; Holds the file name being searched
- member: ds 16; input dsk/name like FCB
- lbrnam: ds 16; Save library name
- ;
- ; blank the subtitle because slrmac leaves it from pass 1
- subttl
- END
- ░
