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