TITLE	'LRUN  Library Run--a utility for .LBR files'
VERSION	EQU	2$0	;82-11-19 Added equates for user
;			 area to search for command.lbr.
;
;		1$0	;82-08-06 Initial source release
	PAGE	60
;
; Requires MAC for assembly.  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.
;
;--------------------------------------------------------------
;		USER MODIFIABLE EQUATES
;
;	Define a secondary search drive and user if .LBR is
;	not found after initial search of current area:
;
SSDRV:	EQU	'A'	;Valid values are 'A' through 'P'.
SSUSR:	EQU	0	;Valid values are  0  through 31.
;
;Default library may also be modified.  See label DFLTNAM.
;--------------------------------------------------------------
;
QUERY	SET	-1
@SYS	SET	0
@KEY	SET	1
@CON	SET	2
@RDR	SET	3
@PUN	SET	4
@LST	SET	5
@DIO	SET	6
@RIO	SET	7
@SIO	SET	8
@MSG	SET	9
@INP	SET	10
@RDY	SET	11
@VER	SET	12
@LOG	SET	13
@DSK	SET	14
@OPN	SET	15
@CLS	SET	16
@DIR	SET	17
@NXT	SET	18
@DEL	SET	19
@FRD	SET	20
@FWR	SET	21
@MAK	SET	22
@REN	SET	23
@CUR	SET	25
@DMA	SET	26
@CHG	SET	30
@USR	SET	32
@RRD	SET	33
@RWR	SET	34
@SIZ	SET	35
@REC	SET	36
@LOGV	SET	37	;2.2 only
@RWR0	SET	40	;2.2 only
;
CPMBASE EQU	0
BOOT	SET	CPMBASE
BDOS	SET	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	SET	CTRL AND 'M'
LF	SET	CTRL AND 'J'
TAB	SET	CTRL AND 'I'
FF	SET	CTRL AND 'L'
BS	SET	CTRL AND 'H'
FALSE	SET	0
TRUE	SET	NOT FALSE
;
CPM	MACRO	FUNC,OPERAND,CONDTN
	LOCAL	PAST
	IF	NOT NUL CONDTN
	DB	( J&CONDTN ) XOR 8
	DW	PAST
	ENDIF		;;of not nul condtn
	IF	NOT NUL OPERAND
	LXI	D,OPERAND
	ENDIF		;;of not nul operand
	IF	NOT NUL FUNC
	MVI	C,@&FUNC
	ENDIF
	CALL	BDOS
PAST:
	ENDM
;
BLKMOV	MACRO	DEST,SRCE,LEN,COND
	LOCAL	PAST
	JMP	PAST
@BMVSBR:
	MOV	A,B
	ORA	C
	RZ
	DCX	B
	MOV	A,M
	INX	H
	STAX	D
	INX	D
	JMP	@BMVSBR
BLKMOV	MACRO	DST,SRC,LN,CC
	LOCAL	PST
	IF	NOT NUL CC
	DB	( J&CC ) XOR 8
	DW	PST
	ENDIF
	IF	NOT NUL DST
	LXI	D,DST
	ENDIF
	IF	NOT NUL SRC
	LXI	H,SRC
	ENDIF
	IF	NOT NUL LN
	LXI	B,LN
	ENDIF
	CALL	@BMVSBR
	IF	NOT NUL CC
PST:
	ENDIF
	ENDM
PAST:	BLKMOV	DEST,SRCE,LEN,COND
	ENDM

;
OVERLAY SET	0
; Macro Definitions
;
RTAG	MACRO	LBL
??R&LBL EQU	$+2-@BASE
	ENDM
;
RGRND	MACRO	LBL
??R&LBL EQU	0FFFFH
	ENDM
;
R	MACRO	INST
@RLBL	SET	@RLBL+1
	RTAG	%@RLBL
	INST-@BASE
	ENDM
;
NXTRLD	MACRO	NN
@RLD	SET	??R&NN
@NXTRLD SET	@NXTRLD + 1
	ENDM
;
;
; Enter here from Console Command Processor (CCP)
;
CCPIN	ORG	TPA
	JMP	INTRO		;Jump around signon
;
SIGNON:
	DB	'LRUN Ver '	;Signon message
	DB	VERSION/10+'0'
	DB	'.'
	DB	VERSION MOD 10+'0'
	DB	CR,LF
	DB	' Copyright (c) 1982  Gary P. Novosielski '
	DB	'$',CTRL AND 'Z'
;
INTRO:
	LXI	H,0		;get the CCP entry stackpointer
	DAD	SP		;(used only if HELP request
	SHLD	SPSAVE		; is encountered)
	CPM	MSG,SIGNON;	;Display signon
	CALL	SETUP		;initialize.
	LHLD	BDOS+1		;find top of memory
	MOV	A,H		;page address
				;Form destination...
	SUI	PAGES	 	;...address in
	MOV	D,A		;DE pair.
	MVI	E,0
	PUSH	D		;save on stack
;
	BLKMOV	,@BASE,SEGLEN	;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
;
FIXLOOP:
;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.
;
	MOV	A,B
	ORA	C		;test if finished
	JZ	FIXDONE
	DCX	B		;count down
	MOV	A,E
	ANI	07H		;on 8-byte boundry?
	JNZ	NEXTBIT
;
NEXTBYT:
;Get another byte of relocation bits
	XTHL
	MOV	A,M
	INX	H
	XTHL
	MOV	L,A		;save in register L
;
NEXTBIT MOV	A,L		;remaining bits from L
	RAL			;next bit to CARRY
	MOV	L,A		;save the rest
	JNC	NEXTADR
;
;CARRY was = 1.  Fix this byte.
	LDAX	D
	ADD	H		;(H) is the page offset
	STAX	D
;
NEXTADR INX	D
	JMP	FIXLOOP
;
FIXDONE:
;Finished.  Jump to the first address in the new
;segment in high memory.
;
;First adjust the stack.  One garbage word was
;left by fixloop.
	INX	SP
	INX	SP
;
;(HL) still has the page address
	MOV	L,A	;move zero to l
	PCHL		;Stack is valid
SETUP:
;Any one-shot initialization code goes here.
;
	LXI	H,NOLOAD
	SHLD	CCPIN+1 	;Prevent reentry
;
;
	CPM	VER		;Test version of CP/M in use
	CPI	20H		;2.0 or better?
	JC	BADVER		;No, bitch and quit.
;
	CPM	USR,QUERY	;What's the current user area?
	STA	ENTUSR		;Save for later.
;
	CALL	REPARS		;Re-parse command line
;
	LXI	D,MEMBER+9	;Check member filetype
	LDAX	D
	CPI	' '		;If blank,
	BLKMOV	,COMLIT,3,Z	; default to COM.
;
	LXI	D,LBRFIL+9	;Check library filetype
	LDAX	D
	CPI	' '		;If blank,
	BLKMOV	,LBRLIT,3,Z	; default to LBR
;
	LXI	D,LBRFIL+1	;Check name
	LDAX	D
	CPI	' '		;If blank,
	BLKMOV	,DFLTNAM,8,Z	; use default name.
;
;
DIROPN: CPM	OPN,LBRFIL	;Open for directory read.
	INR	A		;Was it found?
	JNZ	DIROK		;yes, ok
	LXI	H,LBRFIL	;No, test drive spec
	MOV	A,M		; to see if it's
	ORA	A		; explicit
	JNZ	NODIR		;It is explicit.  Out of luck
	MVI	M,SSDRV-'@'	;Look on secondary drive,
	CPM	USR,SSUSR	; in secondary user.
	JMP	DIROPN		; before giving up.
;
DIROK:
	CPM	DMA,TBUFF
FINDMBR:
	CPM	FRD,LBRFIL	;Read the directory
	ORA	A
	JNZ	FISHY		;Empty file, Give up.
	LXI	H,TBUFF
	MOV	A,M
	ORA	A
	JNZ	FISHY		;Directory not active??
	MVI	B,8+3		;Check for blanks
	MVI	A,' '
VALIDLOOP:
	INX	H
	CMP	M
	JNZ	FISHY
	DCR	B
	JNZ	VALIDLOOP
;
	LHLD	TBUFF+1+8+3	;Index must be 0000
	MOV	A,H
	ORA	L
	JNZ	FISHY
;
	LHLD	TBUFF+1+8+3+2	;Get directory size
	DCX	H		;We already read one.
	PUSH	H		;Save on stack
	JMP	FINDMBRN	;Jump into loop
FINDMBRL:
	POP	H		;Read sector count from TOS
	MOV	A,H
	ORA	L		;0 ?
	JZ	NOMEMB		;Member not found in library
	DCX	H		;Count down
	PUSH	H		;and put it back.
	CPM	FRD,LBRFIL	;Get next directory sector
	ORA	A
	JNZ	FISHY


FINDMBRN:
	LXI	H,TBUFF   	;Point to buffer.
	MVI	C,128/32	;Number of directory entries
;
FINDMBR1:
	CALL	COMPARE 	;Check if found yet.
	JZ	GETLOC		;Found member in .DIR
	DCR	C
	JZ	FINDMBRL
;
	LXI	D,32		;No match, point to next one.
	DAD	D
	JMP	FINDMBR1
;
GETLOC: 	;The name was found now get index and length
	POP	B	;Clear stack garbage
	XCHG		;Pointer to sector address.
	MOV	E,M	;Get First
	INX	H
	MOV	D,M
	XCHG
	SHLD	INDEX	;Save it
	XCHG
	INX	H	;Get Size to DE
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG		; Size to HL
	SHLD	LENX
	CALL	PACKUP	;Repack command line arguments
	CPM	CON,CR	;do <cr> only (look like CCP)
	RET
;		End of setup.
;
;	Utility subroutines
NEGDE:			;DE = -DE
	MOV	A,D
	CMA
	MOV	D,A
;
	MOV	A,E
	CMA
	MOV	E,A
	INX	D
	RET
;
;	REPARSE re-parses the fcbs from the command line,
;	to allow the "-" character to prefix the library name
;
REPARS: 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
SCANBK: 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	SCANBK
	CPI	'-'		;library name specifier?
	JNZ	NOTLBR		;skip if not
	INX	H		;it is, skip over flag character
	LXI	D,LBRFIL	;parse library name into FCB
	CALL	GETFN
NOTLBR: 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
CLSAVE: 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	CLSAVE		;continue moving line if not
	MOV	A,B		;it was, get count
	STA	HOLD		;save it in hold area
	RET
;
;	PACKUP retrieves the command line stored at
;	HOLD 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
;
PACKUP: LXI	H,HOLD		;point to length byte of HOLD
	MOV	C,M		;get length in BC
	MVI	B,0
	INX	B		;bump up to because length byte doesn't
	INX	B		;  include itself or null terminator
	BLKMOV	TBUFF		;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
	CALL	GETFN
	RET
;
;	Here when HELP is requested (indicated
;	by LRUN with no arguments)
;
HELP:	CPM	MSG,HLPMSG	;print the HELP message
EXIT:	LHLD	SPSAVE		;find CCP re-entry adrs
	SPHL			;fix & return
	RET
;
;	the HELP message
;
HLPMSG: 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,'$'
;
;
COMPARE:		;Test status, name and type of
	PUSH	H		;a directory entry.
	MVI	B,1+8+3
	XCHG			;with the one we're
	LXI	H,MEMBER	;looking for.
COMPAR1:
	LDAX	D
	CMP	M
	JNZ	COMPEXIT
	INX	D
	INX	H
	DCR	B
	JNZ	COMPAR1
COMPEXIT:			;Return with DE pointing to
	POP	H		;last match + 1, and HL still
	RET			;pointing to beginning.
;
;
;	File name parsing subroutines
;
; getfn gets a file name from text pointed to by reg hl into
; an fcb pointed to by reg de.	leading delimeters 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 was found - leave fcb blank
	CALL	GETDRV	;get drive spec. if present
	CALL	GETPS	;get primary and secondary name
	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
;
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
;
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
;
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
;
; getps gets the primary and secondary names into the fcb.
; entry hl	text pointer
; exit	hl	character following secondary name (if present)
;
GETPS:	MVI	C,8	;max length of primary name
	CALL	GETNAM	;pack primary name into fcb
	MOV	A,M	;see if terminated by a period
	CPI	'.'
	RNZ		;nope - secondary name not given
			;return default (blanks)
	INX	H	;yup - move text pointer over period
FTPOINT:MOV	A,C	;yup - update fcb pointer to secondary
	ORA	A
	JZ	GETFT
	INX	D
	DCR	C
	JMP	FTPOINT
GETFT:	MVI	C,3	;max length of secondary name
	CALL	GETNAM	;pack secondary name into fcb
	RET
;
; getnam copies a name from the text pointer into the fcb for
; a given maximum length or until a delimiter is found, which
; ever 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
;
GETNAM: 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	AMBIG	;if so, fill the rest of field with '?'
	STAX	D	;if not, just copy into name field
	INX	D	;increment name field pointer
	DCR	C	;if name field full?
	JNZ	GETNAM	;nope - keep filling
	JMP	GETDEL	;yup - ignore until delimiter
AMBIG:	MVI	A,'?'	;fill character for wild card match
QFILL:	STAX	D	;fill until field is full
	INX	D
	DCR	C
	JNZ	QFILL	;fall thru to ingore rest of name
GETDEL: CALL	GETCH	;pointing to a delimiter?
	RZ		;yup - all done
	INX	H	;nope - ignore another one
	JMP	GETDEL
;
; 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
	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
;
;
; Error routines:
;
BADVER: 
	CALL	ABEND
	DB	'Can''t run under CP/M 1.4'
	DB	'$'
NODIR:
	CALL	ABEND
	DB	'Library not found'
	DB	'$'
FISHY:
	CALL	ABEND
	DB	'Name after "-" isn''t a library'
	DB	'$'
NOMEMB:
	CALL	ABEND
	DB	'Command not in directory'
	DB	'$'
NOLOAD:
	CALL	ABEND
	DB	'No program in memory'
	DB	'$'
NOFIT:
	CALL	ABEND
	DB	'Program too large to load'
	DB	'$'
;
COMLIT: DB	'COM'
;
DFLTNAM:DB	'COMMAND ' ; <---change this if you like---
LBRLIT: DB	'LBR'
;
ABEND:
	LDA	ENTUSR
	MOV	E,A
	CPM	USR		;Reset to entry user.
	CPM	MSG,NEWLIN
	POP	D
	CPM	MSG
	CPM	DEL,SUBFILE
	CPM	MSG,ABTMSG
	JMP	EXIT
ABTMSG: DB	'...ABORTED.$'
NEWLIN:	DB	CR,LF,'$'
SPSAVE: DS	2		;stack pointer save
;
	PAGE
;Adjust location counter to next 256-byte boundry
@BASE	ORG	($ + 0FFH) AND 0FF00H
@RLBL	SET	0
;
; The segment to be relocated goes here.
; Any position dependent (3-byte) instructions
; are handled by the "R" macro.
;*************************************************
 R	<LHLD	LENX>	;Get length of .COM member to load.
	MVI	A,TPA/128
	ADD	L	;Calculate highest address
	MOV	L,A	;To see if it will fit in
	ADC	H	;available memory
	SUB	L
	MOV	H,A
	REPT	7
	DAD	H
	ENDM
	XCHG	
	CALL	NEGDE	;IT'S STILL IN LOW MEMORY
 R	<LXI	H,PROTECT>
	DAD	D
	JNC	NOFIT	;Haven't overwritten it yet.
LBROPN:
; The library file is still open.  The open FCB has been
; moved up here into high memory with the loader code.
;
 R	<LHLD	INDEX>		;Set up for random reads
 R	<SHLD	RANDOM>
	XRA	A
 R	<STA	RANDOM+2>
;
	LXI	H,TPA
 R	<SHLD	LOADDR>

; This high memory address and above, including CCP, must be
; protected from being overlaid by loaded program
PROTECT:
;
LOADLOOP:			;Load that sucker.
 R	<LHLD	LENX>		;See if done yet.
	MOV	A,L
	ORA	H
 R	<JZ	LOADED>
	DCX	H
 R	<SHLD	LENX>
;
 R	<LHLD	LOADDR> 	;Increment for next time
	MOV	D,H
	MOV	E,L
	LXI	B,80H
	DAD	B
 R	<SHLD	LOADDR>
	CPM	DMA		;but use old value (DE)
;
 R	<LXI	D,LBRFIL>
	CPM	RRD		;Read the sector
	ORA	A		;Ok?
 R	<JNZ	ERR>		;No, bail out.
;
 R	<LHLD	RANDOM> 	;Increment random record field
	INX	H
 R	<SHLD	RANDOM>
;
 R	<JMP	LOADLOOP>	;Until done.
;
ERR:
	MVI	A,( JMP )	;Prevent execution of bad code
	STA	TPA
 R	<LXI	H,ERRX>
	SHLD	TPA+1
 R	<JMP	LOADED>		;Execute dummy program instead
ERRX:
 	LXI	H,BOOT		;One more time, but this time
	SHLD	TPA+1		;Jump to BOOT
;
 R	<LXI	D,LDMSG>
	CPM	MSG
 R	<LXI	D,SUBFILE>	;Abort SUBMIT if in progress
	CPM	DEL
LOADED:
 R	<LDA	ENTUSR>
	MOV	E,A
	CPM	USR		;Restore USR number from setup.
	CPM	DMA,TBUFF	;Restore DMA adrs for user pgm
	CPM	CON,LF		;Turn up a new line on console
	JMP	TPA
;
LDMSG:
	DB	'BAD LOAD$'
INDEX	DW	0
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.
LBRFIL:
	DS	32		;Name placed here at setup
	DB	0		;Normal FCB plus...
OVERLAY SET	$		;(Nothing past here but DS's)
RANDOM	DS	3		;...Random access bytes
MAXMEM	DS	2
LOADDR	DS	2
;*************************************************
;End of segment to be relocated.
	IF	OVERLAY EQ 0
OVERLAY SET	$
	ENDIF
;
PAGES	EQU	($-@BASE+0FFH)/256+8
;
SEGLEN	EQU	OVERLAY-@BASE
	ORG	@BASE+SEGLEN
	PAGE
;	Build the relocation information into a
; bit table immediately following.
;
@X	SET	0
@BITCNT SET	0
@RLD	SET	??R1
@NXTRLD SET	2
	RGRND	%@RLBL+1	;define one more label
;
	REPT	SEGLEN+8
	IF	@BITCNT>@RLD
	NXTRLD	%@NXTRLD	;next value
	ENDIF
	IF	@BITCNT=@RLD
@X	SET	@X OR 1 	;mark a bit
	ENDIF
@BITCNT SET	@BITCNT + 1
	IF	@BITCNT MOD 8 = 0
	DB	@X
@X	SET	0	;clear hold variable for more
	ELSE
@X	SET	@X SHL 1	;not 8 yet. move over.
	ENDIF
	ENDM
;
	DB	0
HOLD:	DB	0,0		;0 length, null terminator
	DS	128-2		;rest of HOLD area
MEMBER:
	DS	16
;
	END	CCPIN
