;	title	'LX - RUN PROGRAM FROM COMMAND.LBR'

;  PROGRAM: LX
;  ORIGINAL AUTHOR: RICHARD CONN
;  VERSION: 1.0
;  DATE: 10 Aug 85

VERS	EQU	21
REV	EQU	' '
TYPE	EQU	1		; ZCPR program type to assemble LX for
;TYPE is 1,3, or 4. If type 4 is elected, then the resulting REL object
;must be linked to a PRL file whose 256 byte header contains a Type 4
;Loader. See the notes for rev 2.0c by Cam Cotrill in LX.HST.

;=========================================================
;ASSEMBLY/LINK using ZMAC assembler and ZML linker (aeh)

;for Type equ 1
;	ZMAC LX20
;	ZML LX20,LX-1/N

;For Type equ 3 and execution at 8000h
;	ZMAC LX20
;	ZML LX20,LX-3.COM/N /A:8000

;for Type equ 4
;	ZMAC LX20
;	ZML LX20,LX-4.COM/N,T4LDR/P
;		(T4LDR.HDR is in current dir or ZML's alternate dir)
; T4LDR.HDR is a binary file containing the type 4 loader code
; required by ZCPR34. It is exactly 256 bytes long.

;=========================================================

;abbreviated LX revision history. See LX.HST for full change notes.

; 2.1				08/13/90		Howard Goldstein
;	Fix bugs in type 4 version, shorten code

; 2.0f				08/07/90		Al Hawley (aeh)
;	Clean up source & reorganize configuration block.

; 2.0e				08/05/90		Howard Goldstein
;	Add local stack, fix bugs. OK for type 2 programs now

; 2.0d				07/22/90		Al Hawley (aeh)
;	Define configuration data block for ZCNFG configuration.

; 2.0c				11/05/89		Cameron W. Cotrill
;	Revise code for ease of making proper Type 4 version of LX

; 2.0b							Cameron W. Cotrill
; 	Implemented Howard Goldstein's corrected ECP code in CHEKWS.

; 2.0a							Cameron W. Cotrill
;	Massive rewrite to allow LX to run as type 1,3,4 and extract
;       and load type 1,3,4 files.

; 1.9d							Cameron W. Cotrill
;	Code optimization for LX running as type 3 or 4

; 1.9a			19 Aug 89.			Harold F. Bower
;	Modified to use SARGV and Z33GMTOP routines.  Other minor optimization

; 1.9			April 1, 1988			Bruce Morgen
; 	Added type 3 safety header, restore wheel response options

; 1.8 			Howard Goldstein, November 29, 1987
;	Rewrote the ADJCML routine to adjust the command line properly

; 1.7			Howard Goldstein, November 21, 1987
;	Changed code to parse file names via resident Z33/34 code.

; 1.6			Bruce Morgen @23:55:56 June 4, 1987
;	Added WS and ARUNZ compatibility features. '/' syntax.
;	Errors abort to error handler.

; 1.5			Bruce Morgen @15:03:03 April 24, 1987
;	Code revisions for WS, Z33 compatibility. Remove self modifying code.

; 1.2			3 September 1986 - Michael Bate
;	Auto-installs ZCPR3 utilities. 

; 1.1				27 Feb 86  jww
;	Changed ARGV to recognize '=' argument delimiter

; 1.0 - Release version

; LX is like the old LRUN tools in that it looks at its arguments as a command
; line to be executed.  LX locks onto a library file, searches for the command
; verb COM file in it, extracts the COM file into memory at 100H, and sets up
; the various buffers to look like the COM file was executed by the ZCPR3
; command processor.

; Unlike the other LRUN tools I've seen and heard of (with the possible
; exception of LRUNZ), LX truly acts as the ZCPR3 command processor, parsing
; the command line as ZCPR3 itself would.  Named directory references are
; allowed, the External FCB is loaded if available, etc.  Any ZCPR3 tool
; executed by LX sees the environment as it would if ZCPR3 itself executed the
; tool.

; For security, no directory references are allowed (they are ignored) for any
; arguments if the wheel byte is not set.

	PUBLIC	COUT		; b/m, April 24, 1987
	public	print		; hg, 08/05/90

; Externals

	.request z3lib		; From Z3LIB Get...

	EXT	Z3INIT, ZPRSFN, Z3LOG, Z33CHK, Z33FNAME, GZMTOP
	EXT	PUTER3, GETQUIET, GETCST, PUTCST, PFIND
	EXT	GETMSG, GETEFCB, GETWHL, GETCL1
	ext	prttype

	.request syslib		; From SYSLIB Get...

	 if	type ne 4
	EXT	CODEND
	 endif
	EXT	EPRINT, RETUD, PUTUD, LOGUD, GETUD, PFN2
	EXT	INITFCB, F$EXIST, BOUT
	ext	LUINIT, LUOPEN, LUREAD, ARGV
	ext	setdma

; Symbol definitions

CR	EQU	0DH
LF	EQU	0AH
BDOSE	EQU	5
FCB1	EQU	5CH
FCB2	EQU	6CH
TBUFF	EQU	80H
TPA	EQU	100H
;LNSIZE	EQU	22		; Number of chars allowed for library name
LNSIZE	EQU	21		; Number of chars allowed for library name

;---------- ZCPR3x Program header -------------

ENTRY:	jr	start			; bypass header and data
					; must be JR for type 3 safety code
	defb	0			; space filler required.

Z3ENAME: DEFB	'Z3ENV'
Z3LTYP:	 DEFB	TYPE			; TYPE is 1,3, or 4
Z3EADR:	 DEFW	0			; Filled in by Z33

	  if	type eq 4
	public	$memry
$memry:	 defs	2			; Offset of top of lx+1.  Only
					; valid prior to relocation.
	  else
	 DEFW	ENTRY			; Intended load address
	  endif

;-------------- Configuration Data ---------------

	DEFB	'LX21    ',0		;CFG filename, terminator

OPTION:	 DEFB	0FFH			; Make zero for wheel byte
					; control of default LBR

;  Names of Library Files

LIBNAM1: DEFB	'ROOT:COMMAND.LBR'	; Wheel's library
	 DEFS	LNSIZE-($-LIBNAM1),' '
	 defb	0

LIBNAM2: DEFB	'ROOT:USERCMD.LBR'	; Non-wheel library
	 DEFS	LNSIZE-($-LIBNAM2),' '
	 defb	0

; Default Filetype strings	; moved from Data area (aeh)

LBRTYP:	DEFB	'LBR'		; Default lbr file type
COMTYP:	DEFB	'COM'		; Default com file type

;----------- End of Configuration Data ---------------
; Beginning of code

start:
	 IF	TYPE EQ 3
; TYPE 3 HEADER
; Code modified as suggested by Charles Irvine to function correctly with
; interrupts enabled.  Program will abort with an error message when not
; loaded to the correct address (attempt to run it under CP/M or Z30).

	LD	HL,0			; Point to warmboot entry
	LD	A,(HL)			; Save the byte there
	DI				; Protect against interrupts
	LD	(HL),0C9H		; Replace warmboot with a return opcode
	RST	0			; Call address 0, pushing RETADDR
					; onto stack
RETADDR: LD	(HL),A			; Restore byte at 0
	DEC	SP			; Get stack pointer to point
	DEC	SP			; To the value of RETADDR
	POP	HL			; Get it into HL and restore stack
	EI				; We can allow interrupts again
	LD	DE,RETADDR		; This is where we should be
	XOR	A			; Clear carry flag
	PUSH	HL			; Save address again
	SBC	HL,DE			; Subtract -- we should have 0 now
	POP	HL			; Restore value of RETADDR
	JR	Z,START1		; If addresses matched, begin real code

	LD	DE,NOTZ33MSG-RETADDR	; Offset to message
	ADD	HL,DE
	EX	DE,HL			; Switch pointer to message into DE
	LD	C,9
	JP	BDOSE			; Return via BDOS print string function
NOTZ33MSG:
	DEFB	'Not Z33+$'		; Abort message if not Z33-compatible
START1:
	 ENDIF			;type 3

	LD	(OLDSTK),SP	; Save system stack
	LD	SP,STACK	; Set up local stack
	LD	HL,(Z3EADR)	; Pt to zcpr3 environment
	CALL	Z3INIT		; Init zcpr3 environment
	CALL	GZMTOP		; Get base Address of CCP
	LD	(TPAEND),hl	; Set end of TPA
	LD	A,10
	LD	(ERRCD),A	; Assume error code 10 (for now)
	LD	HL,ARGV2	; Usual command tail start ptr.
	LD	(TAILST),HL

; Set name of default library file

	LD	HL,LIBNAM1
	LD	A,(OPTION)
	OR	A
	CALL	Z,GETWHL
	JR	NZ,NOGWHL
	LD	HL,LIBNAM2
NOGWHL:	LD	(LIBNAME),HL

; Save home directory

	CALL	PUTUD

; First parse of command line to determine if help needed, name of library

	LD	DE,TBUFF+1	; Pt to command line
	LD	HL,ARGS		; Pt to argument table
	LD	(HL),5		; Init. for five arguments
	EX	DE,HL
	XOR	A		; Do not delimit tokens (A=0)
	CALL	ARGV		; Generate vector
	LD	A,(ARGC)	; Check count
	LD	B,A		; Save arg count in b
	OR	A		; Help if no args
	JR	Z,HELP
	LD	HL,(ARGV1)	; Get ptr to first arg
	LD	A,(HL)		; Get first char of first arg
	CP	'/'
	JP	NZ,GO1		; Skip help if not /
	DEC	B		; Reduce arg count by one
	JP	NZ,GOECP	; If only one arg with slash, assume help

; Print Help Message

HELP:	CALL	EPRINT
	DEFB	'LX, Version '
	DEFB	vers/10+'0','.',(vers mod 10)+'0',REV,' ',0
	LD	HL,ENTRY
	LD	A,(Z3LTYP)
	CALL	PRTTYPE		; Identify what type and where we are
	CALL	EPRINT
	DEFB	cr,lf,' Syntax: LX [/] [-[dir:]library] command_line'
	DEFB	cr,lf,' (Use "/" option when chaining from ARUNZ'
	DEFB	' default alias)',0
	LD	SP,(OLDSTK)	; Restore system stack
	RET

; Adjust vectors for forced-ECP mode

GOECP:	LD	DE,ARGV2
	LD	HL,ARGV3
	LD	(TAILST),HL
	LD	HL,(ARGV2)
	LD	A,(HL)
	JR	GOECP1

; Continue processing; check for and process library reference

GO1:	LD	DE,ARGV1	; Set pointer for first token
GOECP1:	CP	'-'		; Library reference?
	JR	NZ,GO2
	DEC	B		; Reduce argument count by 1
	JP	Z,HELP		; Library name by itself is not enough

; Extract and store library reference

	PUSH	BC		; Save arg count
	LD	DE,(LIBNAME)	; Set library name
	PUSH	DE		; Save on stack
	INC	HL		; Pt to name
	LD	BC,LNSIZE	; Size of buffer
	LDIR			; BC=00
	POP	HL		; Terminate name with zero
LNSCAN:	LD	A,(HL)		; Get next char
	CP	' '		; Done?
	JR	Z,LNSCAN1
	OR	A
	JR	Z,LNSCAN1
	INC	HL		; Pt to next
	JR	LNSCAN

LNSCAN1: LD	(HL),B		; B=0
	LD	DE,(TAILST)	; Set ptr to first token
	POP	BC		; Get arg count

; DE pts to first token of command line
; Store command line (next token) into TBUFF

GO2:	PUSH	DE		; Save ptr to first token
	DJNZ	GO3		; See if any tokens follow the command name
				; If no more tokens, then zero gbuff
	LD	HL,GBUFF	; Store empty command line into gbuff
	LD	(HL),B		; B=0.
	INC	HL
	LD	(HL),B
	JR	GCLINE

; Save command line tail into GBUFF

GO3:	EX	DE,HL		; Switch regs around
	INC	HL		; Pt to next token
	INC	HL
	LD	E,(HL)		; Get address
	INC	HL
	LD	D,(HL)		; DE pts to first token of command line tail
	LD	HL,GBUFF+1	; Pt to command line buffer (char after)
	LD	(HL),' '	; Store leading space
	INC	HL
	EX	DE,HL		; ..restore regs position
	LD	B,1		; Set char count to 1
CLTSAVE: LD	A,(HL)		; Get next char
	LD	(DE),A		; Store it
	OR	A		; Eol?
	JR	Z,CLTSDON
	INC	HL		; Pt to next
	INC	DE
	INC	B		; Increment count
	JR	CLTSAVE

CLTSDON: LD	A,B		; Get count
	LD	(GBUFF),A	; Set count in local buffer.
GCLINE:	CALL	RETUD		; C=current user
	LD	HL,FCB1		; Clear fcb1
	CALL	CLRFCB
	LD	HL,FCB2		; Clear fcb2
	CALL	CLRFCB
	POP	HL		; Get ptr to first token
	LD	A,(HL)		; Get address
	INC	HL
	LD	H,(HL)
	LD	L,A		; Hl pts to first token
	LD	DE,ARGS		; Use same argument vector table
	LD	A,0FFH		; Null-terminate arguments
	CALL	ARGV
	LD	C,0		; Up to 3 tokens to obtain
	LD	DE,ARGV1	; Pt to first token
	LD	A,(ARGC)	; Get argument count
	CP	4		; Range?
	JR	C,GO4
	LD	A,3		; Set 3 tokens
GO4:	LD	B,A		; In c

; There are three tokens (max) to be extracted:
;	Program name (external FCB - done below)
;	FCB 1
;	FCB 2

GO5:	PUSH	BC		; Save counters
	CALL	NAMEBLD		; Build token
	POP	BC		; Get counters
	INC	C		; Increment token id
	DJNZ	GO5

; Extract program name and put in local FCB for lbr file open.

	LD	DE,ARGV1	; Pt to command name string
	LD	A,(DE)		; Get address in hl
	LD	L,A
	INC	DE
	LD	A,(DE)
	LD	H,A
	LD	DE,LFCB		; Pt to fcb
	CALL	PARSE		; Parse into fcb
	LD	HL,9		; Set type of file to 'com'
	ADD	HL,DE
	LD	DE,COMTYP	; File type
	EX	DE,HL
	LD	BC,3		; 3 bytes
	LDIR

; Copy program name to Z3EFCB

	CALL	GETEFCB		; Set file type to com for external fcb
	JR	Z,GO6		; No external fcb
	LD	DE,LFCB
	EX	DE,HL
	LD	BC,33
	LDIR			; Copy name to external fcb

; Locate LBR file

GO6:
	CALL	FINDLF
	JP	NZ,CHEKWS	; Abort if not found

; Load Command from Library into Memory

	CALL	LOADCOM		; Extract and load to high RAM.
				; ..also installs z3 utils
	JP	Z,CHEKWS	; If error

; Set up TBUFF area

INSTALL:
	LD	HL,GBUFF	; Ptr to local buffer
	LD	DE,TBUFF	; Ptr to tbuff
	LD	BC,128		; 128 bytes
	LDIR			; move new command tail into place
	CALL	GETUD		; Return to home directory
	LD	HL,TBUFF	; Set default dma address
	CALL	SETDMA

; Set up to Copy member and execute

	LD	HL,(LOADAT)
	LD	A,0C7H		; is first byte rst 0?
	CP	(HL)
	JR	NZ,INSTA0	; if not
	LD	(HL),0C3H	; make it a jp
INSTA0:
	LD	BC,CPYSIZ	; size of cpycod routine
	LD	A,(CPYFLG)
	AND	A
	JR	Z,INSTA3	; If load and run address same

; See where we can stick the cpycod routine

	INC	A		; loaded below lx and moving up?
	JR	NZ,INSTA1	; if above lx and moving down
	SBC	HL,BC		; point below loaded module
	LD	A,H
	AND	A		; legal address? (>0)
	JR	NZ,INSTA2	; if ok
	LD	HL,(LOADAT)	; try top of mem otherwise

; Loaded above lx, moving down.  Stick cpycod above load image.

INSTA1:	LD	DE,(CPYCNT)
	ADD	HL,DE		; top of loaded code
	LD	D,H
	LD	E,L
	ADD	HL,BC		; add in size of copy code
	EX	DE,HL
	LD	A,(TPAEND+1)
	CP	D		; see if overflows tpa
	JP	C,LCOMER	; if overflow
	JR	NZ,INSTA2	; if ok to load
	LD	A,(TPAEND)
	CP	E
	JP	C,LCOMER	; if overflow

; Move cpycod into place

INSTA2:	PUSH	HL		; stack copy routine address
	EX	DE,HL
	LD	HL,CPYCOD
	LDIR
	POP	HL		; relocated copy routine
	JR	INSTA4

; Finish the last few details and run the program

INSTA3:	LD	HL,CPYCOD
INSTA4:	LD	A,(CPYFLG)	; Get the copy flag back
	LD	SP,(OLDSTK)	; Restore system stack
	LD	DE,(RUNAT)	; Destination address
	PUSH	DE		; stack it
	PUSH	HL		; stack the copy routine address
	LD	BC,(CPYCNT)	; Size of program in bytes
	LD	HL,(Z3EADR)
	AND	A		; clear z flag if relocation needed
	RET			; Go to cpycod, wherever it is...

;==========================================================
; Copy routine - this will be placed wherever needed.
;  Cpycod exits to the entry point of the loaded program.
;==========================================================

CPYCOD:	RET	Z		; If nothing moves, run it
	PUSH	HL		; save env address
	LD	HL,(LOADAT)	; Start address
	INC	A
	JR	Z,COPYC1	; if moving up

; Moving down, standard head to tail copy ok

	LDIR			; Do copy (in place is ok)
	POP	HL		; restore env address
	RET			; Jump to program

; Moving up in memory, use tail to head copy

COPYC1:	DEC	BC
	ADD	HL,BC		; Point to last byte of source
	EX	DE,HL
	ADD	HL,BC		; Point to last byte of destination
	EX	DE,HL
	INC	BC
	LDDR			; tail to head copy
	POP	HL		; restore env address
	RET

CPYSIZ	EQU	$-CPYCOD

;==========================================================
; Failed to find either library or member, so clean up
;==========================================================

CHEKWS:	LD	SP,(OLDSTK)	; Restore system stack
	LD	A,(1)		; Test for the WordStar kludge.
	CP	3
	JP	NZ,GETUD	; Reassert orig. DU and exit.
	CALL	GETCL1		; Point hl to mcl
	LD	E,(HL)		; Get address of command delimiter
	INC	HL
	LD	D,(HL)
	INC	HL
	INC	HL
	INC	HL
	EX	DE,HL		; DE pts to 1st char of mcl, HL TO CHAR
				; ...FOLLOWING command that invoked LX
	XOR	A
	SBC	HL,DE		; Number of chars in mcl to this point
	LD	B,H		;  ...to BC
	LD	C,L
	ADD	HL,DE		; Restore pointer
	DEC	HL		; Point to last char of LX command
	LD	A,';'		; Search back for end of previous command
	CPDR			; ...or beginning of mcl
	INC	HL		;adjust pointer
	JR	NZ,PRSMCL	; pointer now correct if no previous cmd
	INC	HL		; Adjust again, skip '2'
PRSMCL:	PUSH	HL		; save pointer to first char in command
	LD	DE,ARGS		; Pt to ARGV table
	XOR	A		; Don't delimit tokens
	CALL	ARGV		; Get vector of tokens in MCL
	LD	HL,(ARGV2)
	LD	A,(HL)		; Get first character.
	CP	'/'		; Were we forced ECP (/)?
	JR	Z,ADJMCL	; Then adjust MCL bffr.
	POP	HL		; stack cleanup
	CALL	GETCST		; Get Command Status Flag.
	LD	B,A
	BIT	2,A		; Real ECP?
	JR	NZ,ERREXT	; Then just set CSF error bit.
	CALL	Z33CHK		; Running ZCPR 3.3?
	JR	NZ,GOTER3	; Then just set ECP, error bits.
	SET	3,B		; Otherwise external source...
	LD	A,(ERRCD)	; Get our error code
	CALL	PUTER3		; Store for error handler
GOTER3:	LD	A,B		; Get back CSF.
	JR	ERREXT		; Set ECP, error bits and stuff.

ADJMCL:	POP	DE		; Point to cmd start, save new first token
	LD	HL,(ARGV3)	; Pt to 3rd token
	LD	A,(HL)		; Get first char
	CP	'-'		; '-' means LBR name
	JR	NZ,FOUNDL	; If not, MCL begins here
	LD	HL,(ARGV4)	; else, get next token

FOUNDL:	LD	A,(HL)
	LD	(DE),A		; copy a character
	INC	HL
	INC	DE		; bump pointers
	AND	A		; end of string?
	JR	NZ,FOUNDL	; continue until null found	

	CALL	GETCST		; Get Cmd. Status Flag
ERREXT:	OR	110B		; Set ECP and error bits.
	JP	PUTCST		; Put 'em in CSF and we're done,
				; return via Z3LIB routine

;==========================================================
; Clear FCB pted to by HL
; Current user area is in C
;==========================================================

CLRFCB:	LD	(HL),0		; Current disk
	INC	HL		; Pt to name
	LD	B,11		; 11 bytes
	LD	A,' '		; Space fill
	CALL	FILL
	XOR	A		; Get a Null for now and later
	LD	(HL),A
	INC	HL
	LD	(HL),C		; User area (byte 13)
	INC	HL
	LD	B,4		; Number of bytes w/zeros (in A)
			;..fall through to FILL

; Fill B bytes pted to by HL with A

FILL:	LD	(HL),A		; Fill
	INC	HL		; Pt to next
	DJNZ	FILL
	RET

;==========================================================
; Build name of token whose address is pted to by DE
; On input, C=flag:
;	0	Name of program
;	1	FCB 1
;	2	FCB 2
;==========================================================

NAMEBLD: LD	A,(DE)		; Get address of token in hl
	LD	L,A
	INC	DE
	LD	A,(DE)
	LD	H,A
	INC	DE
	LD	A,C		; Check flag
	CP	1		; Middle value
	RET	C		; Token 0 handled elsewhere

	PUSH	DE		; Save ptr to next
	LD	DE,FCB1		; Assume fcb
	JR	Z,NAMEB1	; Fcb 1 if 1
	LD	DE,FCB2		; Else fcb2

; DE pts to FCB to build into, HL pts to token

NAMEB1:	PUSH	DE		; Save fcb ptr
	LD	DE,LFCB		; Pt to local fcb
	CALL	PARSE		; Parse into local fcb
	CALL	GETWHL		; Check wheel byte
	JR	NZ,NAMEB2	; Continue with name build if wheel

; User is not a wheel, so force all directory references to current dir

	CALL	RETUD		; Get current user in c
	LD	HL,LFCB		; Pt to fcb
	LD	(HL),0		; Set current disk
	LD	DE,13		; Offset to user
	ADD	HL,DE
	LD	(HL),C		; Set current user into lfcb

; Store FCB data into FCB

NAMEB2:	POP	DE		; Get ptr to target fcb
	LD	HL,LFCB		; Pt to fcb
	LD	BC,17		; Copy 17 bytes
	LDIR
	POP	DE		; Get ptr to next token
	RET

;==========================================================
; Locate Library File
; On exit, A=0 if library file found
;==========================================================

FINDLF: LD	HL,(LIBNAME)	; Parse library file name
	LD	DE,LUDFCB
	CALL	PARSE
	LD	DE,LUDFCB+9	; Set library file type
	LD	HL,LBRTYP	; Default file type
	LD	BC,3		; 3 bytes
	LDIR

; Set specified directory as default

	LD	DE,LUDFCB	; Pt to fcb
	CALL	Z3LOG		; Log into it for default

; Look into directory pted to by user (or current if user did not spec one)

	CALL	INITFCB		; Reset fcb
	CALL	F$EXIST		; Is file there?
	JR	NZ,FLF2A

; Look along path from current dir (not including current)

	CALL	GETUD		; Log into original home directory
	XOR	A		; Don't search current dir also
	CALL	PFIND		; Search for file
	JR	NZ,FLF2		; File found, so process

; File not found

flf1:	CALL	GETQUIET	; Are we muzzled?
	RET	NZ		; Return NZ if so (A=FFh).
	CALL	EPRINT
	DEFB	' Library File ',0
	LD	DE,LUDFCB+1	; Print file name
	CALL	PFN2
	CALL	EPRINT
	DEFB	' Not Found',0
	OR	0FFH		; Error code (NZ & A=FFh)
	RET


; File found

flf2:	CALL	LOGUD		; Log into directory
flf2a:	LD	DE,LUD		; Pt to lud
	CALL	LUINIT		; Read to use library
	JR	NZ,flf1		; Error
	RET


;==========================================================
; Load COM file into memory
; on exit, NZ if OK and HL = next block
;==========================================================

LOADCOM:
	LD	DE,LUD		; Pt to lud
	LD	HL,LFCB+1	; Pt to fcb (file name part)
	CALL	LUOPEN		; Open file
	JP	NZ,LDCOME	; if not found in lbr

; Set up load and exe addresses

	 IF	TYPE NE 4
	CALL	CODEND
	LD	(LXTOP),HL	; Save our top address
	EX	DE,HL
	LD	HL,(TPAEND)
	AND	A
	SBC	HL,DE		; Calculate high elbowroom
	JR	NC,LOADC1
	 ENDIF		; not type 4

	LD	HL,0		; Fix underflow
LOADC1:	LD	(HIGHBUF),HL	; Save high buffer size
	LD	HL,ENTRY
	LD	DE,TPA
	XOR	A
	LD	(CPYFLG),A	; indicate no copy needed (yet)
	SBC	HL,DE
	LD	(LOWBUF),HL	; Save low buffer size

	LD	HL,TBUFF
	CALL	SETDMA		; Load first sector to TBUFF
	LD	DE,LUD
	CALL	LUREAD		; First sector in tbuff

; See if Z3 utility and install it if so

	LD	HL,TBUFF+3
	LD	DE,Z3ENAME	; DE -> "Z3ENV" in this program
	LD	B,5		; compare 5 bytes
LOADC2: LD	A,(DE)		; Compare "Z3ENV" with location in
	CP	(HL)		; the loaded program that would have it
	JP	NZ,LOADC9	; jump if no match - NOT a ZCPR3 utility
	INC	DE
	INC	HL		; index through the 5 bytes
	DJNZ	LOADC2
	LD	A,(HL)		; Get env type byte
	CP	2
	JP	Z,LOADC9	; Type 2 - don't auto-install
	CP	4
	JP	NZ,LT13

; Type 4, so we need to do some fancy footwork.  If lx is also a
;  type 4, the member will load and run immediately below lx.  If
;  lx is a type 3 high in memory, the member will load above lx if
;  there is room.  Otherwise, the member is loaded below lx.  All
;  type 4's are loaded at the address they will run.

LT4:
	 IF	TYPE NE 4
	LD	A,(HIGHBUF+1)
	AND	A		; See if we have room above lx
	LD	HL,(LXTOP)	; Assume there is
	JR	NZ,LOADC4	; If assumption correct
	 ENDIF

	LD	HL,ENTRY-100H	; Else load 2 records below lx
LOADC4:	LD	B,2		; Number of records to load
	LD	(HDRADR),HL
LOADC4A:
	CALL	SETDMA
	LD	DE,LUD
	CALL	LUREAD		; Read a record
	LD	DE,128
	ADD	HL,DE		; point to next load address
	DJNZ	LOADC4A		; again until records 1 and 2 loaded
	LD	DE,11-128
	ADD	HL,DE		; point to size word
	LD	C,(HL)
	INC	HL
	LD	B,(HL)		; Move size to bc
	DEC	B
	LD	A,B
	OR	C		; any reserved memory?
	JR	NZ,LOADC5	; Yes, take it into account
	CALL	FSIZE
LOADC5:
	 IF	TYPE NE 4
	LD	HL,(HIGHBUF)
	AND	A
	SBC	HL,BC		; enough room to load above lx?
	LD	DE,(TPAEND)	; if so, memtop is tpaend
	JR	NC,LOADC6
	 ENDIF

	LD	HL,(LOWBUF)
	AND	A
	SBC	HL,BC		; see if enough room to load low
	LD	DE,ENTRY	; if so, we load member under lx
	JP	C,LCOMER	; give mem full error if can't load
LOADC6:	LD	HL,LT4X
	PUSH	HL		; vector exit thru this routine to clear z
	LD	HL,(Z3EADR)	; env address
	INC	B		; Adjust for loader
	LD	A,-1
	CALL	TBUFF+9		; call loader.  Inserts return to part 2
	LD	(RUNAT),HL
	LD	(LOADAT),HL	; save load and run addresses
	LD	HL,(HDRADR)
	LD	DE,TBUFF
	LD	BC,128
	LDIR			; copy 2nd loader record to tbuff
	LD	DE,(LOADAT)
	LD	C,128
	LDIR			; copy first record of member to load address
	PUSH	DE
	LD	HL,(LOADAT)
	LD	C,8
	ADD	HL,BC
	LD	(HL),4		; change load type to 4
	INC	HL
	LD	DE,(Z3EADR)
	LD	(HL),E
	INC	HL
	LD	(HL),D		; install env address in util
	POP	HL		; move next load address to hl
	JR	LCOM		; load remainder of file

LT4X:	OR	0FFH		; insure z flag clear
	RET

; Load absolute file (type 1-3, non-z).  Lx will first try to load
;  the member at the address it will run.  If it can't because lx
;  itself is in the way, lx will try and load the member above
;  itself.  Failing that, it will load the member below itself if 
;  possible.

LOADC9:	LD	DE,TPA		; not z3 util, load in tpa
	JR	LOADC3

LT13:	INC	HL
	LD	DE,(Z3EADR)	; This is a ZCPR3 utility
	LD	(HL),E
	INC	HL
	LD	(HL),D		; Store the environment address
	LD	DE,TPA		; assume program runs at 100h
	INC	HL
	CP	3		; Check for type 3
	JR	NZ,LOADC3	; Branch if standard-TPA tool
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		; Runtime address to de
LOADC3:	LD	(RUNAT),DE	; save run time address
	CALL	FSIZE		; return file load size in bc
	LD	H,D
	LD	L,E		; copy run address to hl
	ADD	HL,BC		; top address of running program
	EX	DE,HL
	PUSH	HL
	LD	HL,(TPAEND)
	XOR	A		; indicate no relocation
	SBC	HL,DE		; See if program will run
	POP	DE
	JR	C,LCOMER	; If program would overflow memory

	 IF	TYPE NE 4
	LD	HL,(LXTOP)
	SBC	HL,DE		; check for base of runtime inside lx
	JR	C,LD13A		; base is above lx, ok to load
	 ENDIF

	LD	H,D
	LD	L,E		; copy run address to hl
	ADD	HL,BC		; top address of running program
	PUSH	DE
	LD	DE,ENTRY
	AND	A
	SBC	HL,DE		; check for overlap on the low side
	POP	DE
	JR	C,LD13A		; top of program is below lx, ok to load

	 IF	TYPE NE 4
	LD	HL,(HIGHBUF)
	LD	A,1		; flag for load above lx
	SBC	HL,BC
	LD	DE,(LXTOP)
	JR	NC,LD13A	; if ok to load above lx
	 ENDIF

	LD	HL,(LOWBUF)
	OR	-1		; flag for load below lx and clear cy
	SBC	HL,BC
	JR	C,LCOMER	; if can't load beneath lx either
	LD	HL,ENTRY
	SBC	HL,BC		; calculate load address
	EX	DE,HL		; and place in de
LD13A:	LD	(CPYFLG),A	; indicate if load and run addresses differ
	LD	(LOADAT),DE
	LD	HL,TBUFF
	LD	BC,128
	LDIR			; move first record into place
	EX	DE,HL		; next load address in hl

LCOM:	CALL	SETDMA		; Set dma address
	LD	DE,LUD		; Pt to lud
	CALL	LUREAD		; Read block
	RET	NZ
	LD	DE,128		; Pt to next block
	ADD	HL,DE
	JR	LCOM

; Memory full error

LCOMER:	CALL	GETQUIET
	JR	NZ,QLCOM
	CALL	EPRINT
	DEFB	' Memory Full',0
QLCOM:	LD	A,12
	LD	(ERRCD),A
	XOR	A		; Error code
	RET

; LBR member not found error

ldcome:	CALL	GETQUIET	; Muzzled?
	JR	NZ,NOPRNT	; Skip msg. if so
	CALL	EPRINT		; Otherwise fall through
	DEFB	' File ',0
	LD	DE,LFCB+1	; Pt to FBC's file name ASCII.
	CALL	PFN2
	CALL	EPRINT
	DEFB	' Not Found in Library ',0
	LD	DE,LUDFCB+1	; Pt to library file name
	CALL	PFN2
NOPRNT:	XOR	A		; Error
	RET


; Calculate file size after loading first record

FSIZE:	XOR	A
	LD	BC,(LUDBLR)	; Get size in records -1 of member
	INC	BC
	SRL	B		; assume no file larger than 65k
	RR	C		; r1-r8
	RRA			; shift r0 into a
	LD	B,C
	LD	C,A		; file size in bytes
	LD	(CPYCNT),BC	; save for copy routine
	RET

;==========================================================
; Console character output "routine".  Unlike SYSLIB's COUT, this one
; will work under WordStar's "R" option.	b/m, June 3, 1987
;==========================================================

COUT:	JP	BOUT		; PUBLIC label for EPRINT, etc.


;==========================================================
; Insure that all references to PRINT in syslib routines actually call
; EPRINT
;==========================================================

PRINT:	JP	EPRINT


;==========================================================
; Parses token pointed to by HL into FCB pointed to
; by DE.  If Z33 running, uses resident CPR code, otherwise
; uses ZPRSFN.	This ensures full ZCPR33 compatibility.
;==========================================================

PARSE:	CALL	Z33CHK
	LD	A,0		; DIR first for ZPRSFN
	JP	NZ,ZPRSFN
	JP	Z33FNAME


;==========================================================
; Data Area
;==========================================================

	DSEG			; To minimize COMfile size

; ARGV argument table

ARGS:	 DEFS	1		; Will init. to allow up to 5
ARGC:	 DEFS	1		; Argument count
ARGV1:	 DEFS	2		; First argument
ARGV2:	 DEFS	2		; Second argument
ARGV3:	 DEFS	2		; Third argument
ARGV4:	 DEFS	2*3		; 3 more arguments

TAILST:	 DEFS	2		; Start of actual command tail

;data structure for calls to LUOPEN
LUD:	 DEFS	4		; Dummy used by LU* routines
LUDBLR:	 DEFS	2		; Blocks remaining in member file
	 DEFS	11		; scratch area for LUOPEN, etc.
LUDFCB:  DEFS	36		; Fcb containing library file data

; General-purpose LX Buffers & Pointers.

TPAEND:	 DEFS	2		; Top of TPA
GBUFF:	 DEFS	128		; Command line save area
LFCB:	 DEFS	36		; Local FCB
LXTOP:	 DEFS	2		; First free address after lx
HIGHBUF: DEFS	2		; Size of buffer above lx and below memtop
LOWBUF:	 DEFS	2		; Size of buffer below lx
HDRADR:	 DEFS	2		; Address of second and third records of t4
LOADAT:  DEFS	2		; Load address for lbr member
LIBNAME: DEFS	2		; Pointer to lbr name string
CPYFLG:	 DEFS	1		; NZ if loaded member needs copying
ERRCD:	DEFS	1		; Error code storage

; For relocated CPYCOD routine

RUNAT:	 DEFS	2		; COMfile runtime origin
CPYCNT:	 DEFS	2		; COMfile length in bytes

OLDSTK:	DS	2		; Save system stack pointer here
	DS	64		; Room for 32-level stack
STACK	EQU	$

	END