TITLE	"MYLOAD - Mload look-alike for ZCPR 3.x and NZ-COM"
;========================================================================
;  M Y L O A D  -  MLOAD for NZ-COM and ZCPR 3.x
;------------------------------------------------------------------------
; This program was developed out of frustration with other MLOAD programs
; which are supposed to overlay COM files with HEX overlays.  It senses
; an extended ZCPR3 Environment Descriptor and protects the CPR.  This
; somewhat limits the size of files which can be handled, but operates
; faster in most cases.
;				17 February 1990	Harold F. Bower
; Revisions:
;  15 May 93	1.3 - Deleted ZSLIB calls in favor of built-in routines
;			with Modula-2 pseudocode, Added Date macro for
;			printing current date in banner.	HFB
;  05 Feb 92	1.2 - Fixed parsing and last-
;		      record testing bugs,
;		      used shorter ZSLIB calls
;		      in place of VLIB for
;		      highlighted video.
;		      Replaced CIN with BIN
;		      for consistency with
;		      other CON: I/O calls,
;		      fixed HL contents for
;		      WHRENV (was DOS vector,
;		      now ENV pointer @109h).
;		      Trivial help screen mod.			BM
;  21 Mar 91	1.1 - Fixed bugs under non-Z			BM
;  19 Mar 91	1.1 - Added TINIT/DINIT calls,
;		      Program Error Flag
;		      support, more precise
;		      Z3 parsing, use actual
;		      program name in syntax
;		      help screen - Bruce Morgen		BM
;  17 Feb 90	1.0 - First Release version			HFB
;  16 Sep 89 to 17 Feb 90 - Test Versions 0.2 - 0.5		HFB
;------------------------------------------------------------------------
; The syntax for MYLOAD is:

;   MYLOAD [dir][comfil[.com][=][dir][oldcom[.hex]][,fil1[.hex]][,...]

; If no destination file is specified, the name of the first input file
; is taken for the output file.  If the first specified file is of type
; HEX, then a simple HEX load is assumed, followed by optional HEX over-
; lays.  Addresses are validated to insure that no HEX overlay specifies
; an address less than 100H (if overlaying COM) or the first HEX load
; address if loading a HEX file.

; The following decimal values are stored in the ZCPR3 Program Error 
; Flag by MYLOAD.  The Program Error Flag is unaffected by executing
; MYLOAD for its built-in syntax help screen only.

;	0	No error detected, normal MYLOAD run
;	1	DOS File Open error
;	2	DOS File Read error or unexpected EOF
;	3	DOS File Write or Close error
;	4	DOS insufficient directory space error
;	5	No file contents to save to disk
;	6	Memory overflow error
;	7	HEXfile lower bound exceeded error
;	8	HEXfile checksum error
;	9	One or more requested files not found
;=======================================================================

VER	EQU	13		; First Test Version
rev	equ	' '		; Bug fix version
DATE	  MACRO
	DEFB	'15 May 93'	; Date of current fix
	  ENDM
;.....
;  CP/M Equates

WBOOT	EQU	0
BDOS	EQU	5
FCB	EQU	005CH
FCB2	EQU	006CH
BUFF	EQU	0080H

; Character and Miscellaneous Equates

BELL	EQU	07H
TAB	EQU	09H
CR	EQU	0DH
FF	EQU	0CH
LF	EQU	0AH

NO	EQU	0
YES	EQU	NOT NO


; Set Public equates to "Fool" linkers into using BDOS instead of BIOS I/O

	PUBLIC	COUT, COUT7	; BOUT call will be COUT to SYSLIB routines

; From Z3LIB Get..

	EXT	Z3INIT, Z3LOG, WHRENV, ZPRSFN, GETQUIET, @SDELM, GETEFCB
	EXT	DUTDIR, PUTER2, Z33CHK, Z33FNAME, PRTNAME

; From SYSLIB Get..

	EXT	CODEND, RETUD, LOGUD, INITFCB, SETDMA
	EXT	COMPBC, COMPHD, BIN, CAPS
	EXT	BOUT, PFN2, CRLF, PAFDC, PHL4HC, PHLFDC
	EXT	F$MAKE, F$OPEN, F$CLOSE, F$READ, F$WRITE, F$EXIST, F$DELETE

;=====================================================================
;		 S T A R T    T H E    P R O G R A M
;=====================================================================

ENTER:	JP	START		; Bypass header and start execution

	DEFB	'Z3ENV'		; This is a ZCPR3 Utility
	DEFB	1		; External Environment Descriptor
ENVADR:	DEFW	0001		; Set Non-zero to force search
	DEFW	ENTER		; Filler for Type 4 Header
	DEFB	'MYLOAD  ',0	; Use this Configuration File w/ZCNFG

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	    C o n f i g u r a t i o n    S e c t i o n
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

ZQUIET:	DEFB	YES		; Set YES to use Z3 Quiet flag if ZCPR 3.x
				;  Environment Descriptor located
SILENT:	DEFB	NO		; Set YES to be Quiet, NO to be verbose
USEBEL:	DEFB	YES		; Set YES to ring bell on Errors, Else NO

;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Begin program Execution

START:	LD	HL,OFCB		; Clear workspace RAM
	LD	E,L
	LD	D,H
	INC	DE
	LD	BC,STACK+1-OFCB
	LD	(HL),0
	LDIR
	LD	(STACK),SP	; Save entry stack
	LD	SP,STACK	; .and set up a local one
	CALL	RETUD		; Get the current Drive and User
	LD	(CUSER),BC	; ..and save locally
	LD	HL,(ENVADR)	; Get possible Z3ENV pointer
	CALL	WHRENV		; .and try to confirm it or find another.
	LD	(ENVADR),HL	; ..save in header
	CALL	Z3INIT		; Initialize Lib routines in any case
	LD	A,(SILENT)	; .get local Silent flag
	LD	(QUIET),A	; ..and save as local Quiet flag
	LD	A,H
	OR	L		; Set Zero Flag based on ENV presence
	LD	(ZSYSFL),A
	JR	Z,NOENV		; Bypass next checks if No Env

; We have a Z-System.  Initialize Libraries and maybe reset Quiet flag

	CALL	TINIT
	XOR	A
	CALL	PUTER2
	LD	A,(ZQUIET)	; Should we use the Z3 Quiet Flag?
	OR	A
	JR	Z,NOZQT		; ..jump if Not
	CALL	GETQUIET	; Else get the Z-System Quiet Flag
	LD	(QUIET),A	; ..and use that one

; Test for extended Environment.  Return or calculate addresses

NOZQT:	EX	DE,HL		; Put ENV addr in DE
	LD	HL,8		; .and offset to Extended flag
	ADD	HL,DE
	BIT	7,(HL)		; Is it Extended?
	JR	Z,NOENV		; ..jump if not to calculate CPR Base
	LD	HL,3FH		; Else offset to CPR Base addr
	ADD	HL,DE		; Point to it
	LD	E,(HL)		; .and retrieve
	INC	HL
	LD	D,(HL)
	EX	DE,HL		; Move CPR Base addr to HL
	JR	HAVBAS		; ..and jump to save it

; No Z3 Environment, calculate the base of CCP/CPR

NOENV:	LD	HL,(WBOOT+1)	; Get Vector to BIOS WB vector
	LD	DE,-1603H	; .set negative offset to CPR Base
	ADD	HL,DE		; ..and calculate
HAVBAS:	EX	DE,HL		; Put the results in DE
	LD	HL,(BDOS+1)	; ..and see if RSX present
	CALL	COMPHD		; Is CPR Base above BDOS vector?
	JR	C,HAVRSX	; ..jump if so to save RSX entry vector
	EX	DE,HL		; Else put CPR base addr back in HL
HAVRSX:	LD	(TOPADR),HL	; Store the Base of OS (CPR or RSX)

; Copy Default Command Buffer to local storage to save Command Tail

	CALL	CODEND		; Get base of Buffer space
	LD	E,L		; .put to DE
	LD	D,H
	INC	H		; ..offset by one sector worth
	LD	(BASADR),HL	; Save pointer to User base
	LD	(WRKPTR),HL	; .as base of Work Area
	LD	(TOPFIL),HL	; ..and as the top of Work Area
	LD	HL,BUFF		; Point source to Default Buffer
	LD	BC,128
	LDIR			; ..and copy Command tail to buffer

; Everything basically set up.  Initialize Terminal and print signon banner

	CALL	VPRINT
	DEFB	CR,LF,1,'MYLOAD',2,'  Ver ',VER/10+'0','.',VER MOD 10 +'0',rev
	DEFB	' - by Harold F. Bower	'
	DATE
	DEFB	CR,LF,LF,0

; Check for Help Request

	LD	A,(FCB+1)	; Get first FCB's first character
	CP	'/'		; Is it a Help request?
	JP	NZ,START0	; ..jump if not

HELP:	CALL	VPRINT
	DEFB	1,'Purpose:',2,'  Load Hex File, or Overlay COM with HEX '
	DEFB	'file(s)',CR,LF,LF,1,' Syntax:',2,CR,LF
	DEFB	'  (file specs may contain DU:',0
	LD	A,(ZSYSFL)
	OR	A
	JR	Z,HELP2
	CALL	VPRINT
	DEFB	' or DIR:',0
HELP2:	CALL	VPRINT
	DEFB	')',CR,LF,LF,0
	CALL	MYLNAM
	CALL	VPRINT
	DEFB	' //                 ',TAB,'<-- Print this message',CR,LF
	DEFB	0
	CALL	MYLNAM
	CALL	VPRINT
	DEFB	' prog               ',TAB,'<-- Load prog.HEX to prog.COM'
	DEFB	CR,LF,0
	CALL	MYLNAM
	CALL	VPRINT
	DEFB	' prog,prog1,..      ',TAB
	DEFB	'<-- Overlay prog.COM w/prog1.HEX',CR,LF
	DEFB	'				    or load prog.HEX then over-',CR,LF
	DEFB	'				    lay with prog1.HEX',CR,LF
	DEFB	0
	CALL	MYLNAM
	CALL	VPRINT
	DEFB	' prog2=prog1.prl,prog2,..   '
	DEFB	'<-- Overlay prog1.PRL with',CR,LF
	DEFB	'				    prog2.HEX forming prog2.COM'
	DEFB	0
EXIT:	CALL	CRLF		; Give a New Line
	CALL	DINIT
	LD	BC,(CUSER)	; Get Current Drive and User
	CALL	LOGUD		; ..and restore
	LD	SP,(STACK)
	RET

; Start program by printing some statistics

START0:	LD	A,(QUIET)	; Operate Quietly?
	OR	A
	JR	NZ,STRT0V	; ..don't print this if so
	CALL	VPRINT
	DEFB	'   Base',0
	LD	HL,BUFSTR
	CALL	VPSTR
	LD	HL,(BASADR)
	CALL	PHL4HC
	CALL	CRLF
	CALL	VPRINT
	DEFB	'    Top'
BUFSTR:	DEFB	' of Output Buffer = ',0
	LD	HL,(TOPADR)
	CALL	PHL4HC
	CALL	CRLF		; Give a couple of lines separation
	CALL	CRLF

; Zero the entire buffer for "cleanliness"

STRT0V:	LD	DE,(BASADR)	; Get Beginning of Buffer
	LD	HL,(TOPADR)	; .and top address in Memory
	XOR	A
	SBC	HL,DE		; ..then calculate the Buffer space
	LD	C,L		; Move count to BC
	LD	B,H
	LD	L,E		; .and starting Addr to HL
	LD	H,D
	DEC	BC		; ..down one count
	INC	DE		; ...and dest up one
	LD	(HL),A		; Set first byte to Zero
	LDIR			; ..and move it along

	LD	DE,FCB		; Set up to parse the Command Tail
	CALL	INITFCB		; .initialize the FCB
	CALL	CODEND		; Get start of Command Tail
	INC	HL		; ..bypassing the Count byte
	CALL	SKWSP		; Skip over "White Space"
	JP	Z,HELP		; ..jump to Help if No arguments
	CALL	ZPARSE		; Parse the next token
	PUSH	HL		; ..save ptr to delimiter
	LD	DE,OFCB		; .to the Output FCB
	CALL	INITFCB		; ..initializing it first
	LD	HL,FCB		; Move from this FCB
	LD	BC,16		; Move just first 16 bytes
	LDIR
	LD	DE,OFCB+9	; Check the Output file type
	POP	HL		; Retrieve delimiter addr
	PUSH	HL		; ..keeping on stack
	LD	A,(HL)
	CP	'='		; Explicit Output file specified?
	LD	HL,COMTYP	; .prepare to set to COM
	LD	BC,3
	JR	NZ,STRT1V	; ..jump to set COM type if Not explicit
	LD	A,(DE)		; Else get first char of file name
	CP	' '		; Anything entered?
	JR	NZ,START1	; ..accept specified type if so
STRT1V:	LDIR			; Else move COM type to Output file
START1:	POP	HL		; Restore pointer to delimiter
	LD	A,(HL)		; .get the delimiter
	CP	'='		; Is an explicit output file specified?
	JR	NZ,START2	; ..bypass first HEX read if Not (default out)
	INC	HL		; Else bypass equal sign
	CALL	SKWSP		; .and bypass any space chars
	JR	Z,START3	; ..jumping to simple Load if EOL
	LD	DE,FCB		; Set up to parse next file name
	CALL	ZPARSE		; Parse
	LD	DE,OFCB+1	; .point to first char of File Name
	LD	A,(DE)
	CP	' '		; Anything there?
	JR	NZ,START3	; ..jump if we have an output file name
	PUSH	HL		; Else save input line pointer
	LD	HL,FCB+1	; .point to second file name
	LD	BC,8
	LDIR			; ..and move 8-char name
	POP	HL		; Restore input line pointer
	JR	START3		; ..and continue on

; If we come here, same root name used for input and output.  Set output
; file to current DU, and use specified one for source

START2:	LD	BC,(CUSER)	; Get Current DU
	LD	A,B		; Load Drive
	INC	A		; .setting base 1..16
	LD	(OFCB),A	; ..save in Output FCB
	LD	A,C		; Load User
	LD	(OFCB+13),A	; .and save in Output FCB also

; Input and output files now all set up

START3:	LD	(SCNPTR),HL	; Save pointer to scan line
	LD	DE,FCB+9	; Check for COM type of first Input file
	LD	HL,HEXTYP
	LD	BC,3
	CALL	COMPBC		; Input file of type COM?
	JP	Z,STAR5A	; ..jump if HEX
	LD	HL,COMTYP	; (load COM ptr in case)
	LD	A,(DE)		; Else..
	CP	' '		; .Was any type explicitly entered?
	JR	NZ,START4	; ..jump to load if so
	LDIR			; ..else set it to COM

; See if the specified Input File exists as COM

START4:	CALL	SRCHF		; Does the first file exist?
	JR	Z,START5	; ..jump if COM Not found to check HEX
	LD	HL,0100H	; Use this offset for Later HEX overlays
	LD	(HOFFST),HL
	OR	0FFH		; ..and show it is set
	LD	(HFLAG1),A
	CALL	OPENIN		; Else Open the file for Reading
	JP	NZ,OPNERR	; ..Jump to error if Problem
	CALL	LODMSG		; Print Loading message
	LD	HL,(WRKPTR)	; Get Base address

INPLOP:	LD	(WRKPTR),HL	; Save working ptr
	LD	(TOPFIL),HL	; ..and top-of-file pointer
	CALL	SETDMA		; Set the Transfer Address
	CALL	RDSEC		; Read a sector there
	JR	NZ,READY	; ..jump to close file if EOF or Error
	LD	BC,128		; Offset to next sector
	ADD	HL,BC
	CALL	CKOVFL		; Will we go too far?  (abort on Err)
	JR	INPLOP		; .loop if not

; See if the specified Input File exists as HEX

START5:	CALL	QPRINT		; Space in a little
	DEFB	'   ',0
	INC	DE
	LD	A,(QUIET)
	OR	A
	CALL	Z,PFN2		; Print the file name if Not quiet
	DEC	DE
	CALL	QPRINT
	DEFB	' Not Found...changing to HEX..',CR,LF,0
	LD	HL,9		; Advance to Type
	ADD	HL,DE
	PUSH	DE		; Save FCB pointer
	EX	DE,HL
	LD	HL,HEXTYP	; Point to HEX file type
	LD	BC,3
	LDIR			; ..and move type field
	POP	DE		; Restore FCB pointer
STAR5A:	CALL	SRCHF		; .and try to find Hex version
	JR	NZ,START6	; ..jump to continue if File Found
	CALL	NFERR		; Else print error
	JP	EXIT		; ..and abort

START6:	CALL	OPENIN		; Else try to open it
	JP	NZ,OPNERR	; ..abort with error if unable to open

	CALL	LODMSG		; Else program exists..Announce it
	CALL	RDHEX		; ..and Load the Hex file

; This is the main loop for loading overlays.  loops here til done

READY:	CALL	CLOSIN		; Close the Input file, restoring defaults
READY0:	LD	DE,FCB
	CALL	INITFCB		; Initialize the FCB for any overlay
	LD	HL,(SCNPTR)	; Get pointer into argument line
	CALL	SKWSP		; Scan for text
	JR	Z,DONE		; ..jump to Closing code if no more
	CALL	ZPARSE		; Else parse the filename
	LD	(SCNPTR),HL	; ..and save the delimiter address

	LD	HL,9		; Advance to Type
	ADD	HL,DE
	LD	A,(HL)		; Get the first char of Type
	CP	' '		; Anything entered?
	JR	NZ,HAVTYP	; ..jump if we have user-entered type
	PUSH	DE		; Else save FCB pointer
	EX	DE,HL
	LD	HL,HEXTYP	; .Point to HEX file type
	LD	BC,3
	LDIR			; ..and move HEX type field
	POP	DE		; Restore FCB pointer

HAVTYP:	CALL	SRCHF		; Does the file exist?
	JR	NZ,READY1	; ..jump if Ok
	CALL	NFERR		; Else print an error
	CALL	RESTOR		; .restore defaults
	JR	READY0		; ..and back for more

READY1:	CALL	OPENIN		; Try to open the file
	JP	NZ,OPNERR	; ..jumping to error if a problem

	CALL	OVLMSG		; Announce this file
	CALL	RDHEX		; .then load the file
	JR	READY		; ..and back for more

; All loading is done at this point.  Finish up the effort

DONE:	CALL	VPRINT		; Print another statistic
	DEFB	CR,LF,' Done.',0
	CALL	QPRINT
	DEFB	'  Saving ',0
	LD	HL,(TOPFIL)	; Calculate size of new image
	LD	DE,(BASADR)
	OR	A
	SBC	HL,DE		; ..and Top of all loads
	JP	Z,NULFIL	; Jump to Error Exit if No contents
	PUSH	HL		; .(save)
	LD	A,(QUIET)	; Print permitted?
	OR	A
	CALL	Z,PHLFDC	; Print in decimal if so
	CALL	QPRINT
	DEFB	' (',0
	CALL	QPRHEX		; ..and hex
	CALL	QPRINT
	DEFB	'H) Bytes to : ',0
	LD	DE,OFCB
	CALL	PRNAME
	POP	HL		; Get the value back

; Now calculate the number of sectors to write

	LD	A,L		; Get Low byte to A
	LD	L,H		; Number of pages to L
	LD	H,0		; ..nulling Hi byte
	ADD	A,A		; Shift MSB to Carry
	ADC	HL,HL		; .Mult pages by 2 for records and shift
				; ..Carry to LSB of L
	LD	C,L		; Put record count in BC
	LD	B,H
	OR	A		; Partial page?
	JR	Z,NOPART	; ..jump if not
	INC	BC		; Else bump record count by one
NOPART:	LD	DE,OFCB		; Now attempt to locate the file
	CALL	SRCHF0		; Does it exist?
	JR	Z,DONE0		; ..jump if not to make it

; A search for the file showed that it exists.  Ask for replacement

	CALL	RING		; File exists...wake up the operator
	CALL	VPRINT		; ..then message
	DEFB	'    +++ File Exists...Replace it? (Y/[N]) : ',0
	CALL	BIN		; Get the answer and echo it
	CALL	CAPS		; ..in uppercase
	CALL	CRLF		; ..and go to new line
	CP	'Y'		; Was it a YES?
	JP	NZ,EXIT		; ..exit if Not
	CALL	F$DELETE	; Else delete the file, fall thru to Make

; The Destination File does not exist.  Create it and write the buffer.

DONE0:	CALL	F$MAKE		; Create the file in current DU:
	INC	A		; Any Error?  (FF-->0)
	JP	Z,MAKERR	; ..jump to error exit if No Dir space
	LD	HL,(BASADR)	; Get the starting address
OUTLOP:	LD	(WRKPTR),HL	; ..save top of file
	CALL	SETDMA		; Set the Transfer Address
	CALL	F$WRITE		; Write a sector from there
	JR	NZ,DONE1	; ..jump to close file if Error
	PUSH	BC		; Save count
	LD	BC,128		; Offset to next sector
	ADD	HL,BC
	POP	BC		; restore count
	DEC	BC		; Count down sector count
	LD	A,B
	OR	C		; Are we finished?
	JR	NZ,OUTLOP	; ..loop if Not

DONE1:	PUSH	AF		; Save status (0=Ok, else Error)
	CALL	F$CLOSE		; .close the file (good or bad)
	POP	BC		; ..and check for Close or Write errors
	OR	B
	JR	Z,DONEOK	; Jump if No errors

	CALL	RING		; We had errors, notify operator
	CALL	VPRINT
	DEFB	'  +++ Write or Close Errors..Erasing file!',0
	CALL	F$DELETE
	LD	A,(ZSYSFL)
	OR	A
	LD	A,3
	CALL	NZ,PUTER2
	JR	EXITV		; ..and quit

DONEOK:	CALL	VPRINT		; Give status
	DEFB	'  ..Ok',0
EXITV:	JP	EXIT		; ..and exit properly

;---------------------------------------------------------------------------
;		     U T I L I T Y    R O U T I N E S
;---------------------------------------------------------------------------

COUT7:	AND	7FH		; Mask off MSB of print
COUT:	JP	BOUT		; Use BOUT for all COUT references

;.....
; Skip over "White Space" delimiter chars in string addressed by HL.
;  Return Zero if End-Of-Line.

SKWSP:	CALL	@SDELM		; Use New Z3LIB routine
	RET	NZ
	OR	A
	RET	Z		; Return Zero Set if EOL
	INC	HL		; Not EOL, so advance
	JR	SKWSP		; ..and loop

;.....
; Read a Hex input file to the memory area addressed by HL

RDHEX:	CALL	GETBIN		; Get a raw byte
	CP	':'		; Start of record?
	JR	NZ,RDHEX	; ..loop til we have it
	LD	D,0		; Initialize the Checksum reg
	CALL	GETBYT		; Then get the count byte
	LD	B,A		; Else store in reg
	ADD	A,D		; Update cksum
	LD	D,A
	CALL	GETBYT		; .High Address
	LD	H,A
	ADD	A,D		; Update cksum
	LD	D,A
	CALL	GETBYT		; ..Low Address	
	LD	L,A
	ADD	A,D
	LD	D,A

; Check for End-of-file Record

	LD	A,B		; Are Count..
	OR	A		; Just check count (v1.2 mod.)
	RET	Z		; Return if End

; Check for Address Offset and set if not already

	LD	A,(HFLAG1)	; Get Flag
	OR	A		; Is it set?
	JR	NZ,RDHEX0	; ..jump if so
	CPL			; Else change to 0FFH
	LD	(HFLAG1),A	; .save flag
	LD	(HOFFST),HL	; ..and offset value

RDHEX0:	PUSH	DE		; Save checksum
	LD	DE,(HOFFST)	; Get offset value for ORG
	XOR	A
	SBC	HL,DE		; Subtract from this block
	JR	C,RDHXER	; ..jump to Error if reverse ORG

	LD	DE,(BASADR)	; Get Base of Buffer area
	ADD	HL,DE		; ..and add this record's address
	PUSH	HL		; Save the real load addr
	LD	E,B		; .move the count down
	LD	D,0
	ADD	HL,DE		; ..and calculate the end
	CALL	CKOVFL		; Will we go too far?  (abort if so)
	POP	HL		; Restore Load pointer
	POP	DE		; ..and Checksum

	CALL	GETBYT		; Skip over Type byte
	ADD	A,D
	LD	D,A
RDHEX1:	CALL	GETBYT		; Get a data byte
	LD	(HL),A		; .store
	INC	HL		; ..bump pointer
	ADD	A,D		; Add this byte to Checksum
	LD	D,A		; ..and save
	DJNZ	RDHEX1		; Count down, loop til done
	CALL	GETBYT		; Get the checksum byte
	ADD	A,D		; Same?
	JP	NZ,CKSERR	; ..jump to Checksum Error if Bad

	LD	DE,(WRKPTR)	; Get the current working Top of buffer
	CALL	COMPHD		; Have we exceeded the old top of used mem?
	JR	C,RDHEX		; .loop if not
	LD	(WRKPTR),HL	; ..else save new top
	LD	DE,(TOPFIL)	; Get old top of Used Memory
	CALL	COMPHD		; Have we expanded the Image size?
	JR	C,RDHEX		; .loop if not
	LD	(TOPFIL),HL	; ..else save new Top
	JR	RDHEX		; ...then loop

;.....
; Error Exit from Hex load.

RDHXER:	CALL	RING		; Ring bell if possible
	CALL	QPRINT		; Else Print an Error message
	DEFB	'   +++ Lower Bound Exceeded +++',0
	LD	A,(ZSYSFL)
	OR	A
	LD	A,7
	JP	NZ,PUTER2	; ..and return after setting err.
	RET			; or not if non-Z

;.....
; Convert Hex char in A to binary digit in range 0..15

HEX2BIN: SUB	'0'		; Subtract numeric bias
	CP	10		; In range 0..9?
	RET	C		; ..return if so
	SUB	7		; Subtract difference between 9 and A
	RET			; ..and quit

;.....
; Search for the file addressed by ZCPR3 style FCB in DE

SRCHF:	LD	DE,FCB		; Use Input FCB if entered here
SRCHF0:	CALL	Z3LOG		; Log into DU for file
	JP	F$EXIST

;.....
; Use most precise available ZCPR3 filename-to-FCB parser

ZPARSE:	LD	A,(ZSYSFL)
	OR	A
	JR	Z,ZPARS2
	CALL	Z33CHK
	JP	Z,Z33FNAME
	XOR	A
ZPARS2:	JP	ZPRSFN

;.....
; Read a sector of the file to the current DMA address

RDSEC:	LD	DE,FCB		; Point to the Input FCB
	JP	F$READ		; ..and read a sector

;.....
; Open the file at the Input FCB

OPENIN:	LD	DE,FCB		; Point to the Input FCB
OPENF:	CALL	F$OPEN		; ..and Open it
	LD	HL,BUFF+128	; Set ptr to force read in GETBIN
	LD	(INPTR),HL
	RET

;.....
; Close the file at the input FCB and restore the current DU:

CLOSIN:	LD	DE,FCB		; Point to the Input FCB
CLOSF:	CALL	F$CLOSE		; ..and Close it
RESTOR:	LD	HL,BUFF		; Get default DMA buffer
	CALL	SETDMA		; ..and Set Transfer Addr
	LD	BC,(CUSER)	; Get current DU:
	JP	LOGUD		; ..log it and return

;.....
; Print Null-Length Error message and exit

NULFIL:	CALL	RING
	CALL	VPRINT
	DEFB	'  +++ Nothing to Save +++',0
	LD	A,5
	JP	ERREX0

;.....
; Print Overlaying message followed by File ID

OVLMSG:	CALL	QPRINT		; Announce this file
	DEFB	'  Overlaying --> ',0
	JR	PRNAME		; ..then print file name

;.....
; Print File name with Drive and User from Z3 FCB addressed by DE

LODMSG:	CALL	QPRINT		; Announce this file
	DEFB	'  Loading    --> ',0
PRNAME:	LD	A,(QUIET)	; Print permitted?
	OR	A
	RET	NZ		; ..exit here if Not
PRNAM1:	LD	A,(DE)
	OR	A		; Default?
	JR	NZ,PRNAM2	; ..jump if not
	LD	A,(CUSER+1)	; Else get current
	INC	A
PRNAM2:	DEC	A
	LD	B,A		; Put in the correct reg
	LD	HL,13		; .offset to User
	ADD	HL,DE
	LD	C,(HL)		; .and get to right reg
	RES	7,C		; ..clear any MSB
	CALL	DUTDIR		; Check for any named DIR
	JR	Z,PRNAM3	; ..jump if Not to print DU:
	PUSH	DE		; Save ptr to FCB
	LD	E,8		; ..and set count
PRNAML:	LD	A,(HL)		; Get a char
	INC	HL		; .bumping ptr
	CP	' '		; Is it a space?
	CALL	NZ,COUT		; ..print if not
	DEC	E		; Count down
	JR	NZ,PRNAML	; .loop til done
	POP	DE
	JR	PRNAM4		; ..then rejoin code

PRNAM3:	LD	A,B		; Print DU: by first getting Drive #
	ADD	A,'A'
	CALL	COUT		; Print Drive Letter
	LD	A,C		; Get User #
	CALL	PAFDC		; ..and Print
PRNAM4:	LD	A,':'
	CALL	COUT
	INC	DE
	CALL	PFN2		; Print File Name & Type
	DEC	DE
	JP	CRLF		; .go to new line

;.....
; Print File Not Found Error and Exit

NFERR:	CALL	RING
	CALL	QPRINT		; Print Not Found error and abort
	DEFB	'  -- Can''t find : ',0
	LD	A,(ZSYSFL)
	OR	A
	LD	A,9
	CALL	NZ,PUTER2
	JR	PRNAME		; Print name, Drive, User and return

;.....
; Check for overflow of Address in HL (HL > TOPADR) aborting if so

CKOVFL:	PUSH	DE		; Preserve regs
	LD	DE,(TOPADR)	; Get the base of protected memory
	CALL	COMPHD		; Is DE still greater than HL?
	POP	DE		; .(restore regs)
	RET	C		; ..return if so
	CALL	RING
	CALL	QPRINT		; Else print an error
	DEFB	'   +++ Memory Overflow at : ',0
	CALL	QPRHEX
	LD	A,6
	JR	ERREX0		; ..and exit

;.....
; Print Checksum Error message and Exit

CKSERR:	CALL	RING
	CALL	QPRINT
	DEFB	CR,LF,'   +++ Checksum Error +++',0
	LD	A,8
ERREX0:	LD	B,A
	LD	A,(ZSYSFL)
	OR	A
	LD	A,B
	CALL	NZ,PUTER2
	JP	EXIT		; ..abort

;.....
; File Open Error on file described by FCB in DE

OPNERR:	CALL	RING
	CALL	QPRINT
	DEFB	CR,LF,'  Can''t Open : ',0
ERREX:	CALL	PRNAME		; Print Name, Drive & User
	LD	A,1
ERREX1:	JR	ERREX0		; ..and take error exit

;.....
; File Read Error on file described by FCB in DE

RDERR:	CALL	RING
	CALL	QPRINT
	DEFB	CR,LF,'  Error or EOF Reading : ',0
	LD	DE,FCB
	LD	A,2
	JR	ERREX1

;.....
; File creation error on completion

MAKERR:	CALL	RING
	CALL	QPRINT
	DEFB	CR,LF,'  No Directory Space for : ',0
	LD	A,4
	JR	ERREX1

;.....
; Get a byte (2 ascii Hex chars) from the Input file.
;  Jump to Read Error and Exit if Read Error or Read Past EOF
; Uses: A,C

GETBYT:	CALL	GETBIN		; Get a Hex char
	CP	' '		; Is it a Control char (ff,cr,lf..)?
	JR	C,GETBYT	; ..loop back for another if so
	CALL	HEX2BIN		; Convert Hex to Binary
	RLCA			; Rotate
	RLCA			; .to
	RLCA			; ..High
	RLCA			; ...Nybble
	LD	C,A		; Preserve
	CALL	GETBIN		; Get next Hex digit
	CALL	HEX2BIN		; Convert to Binary
	ADD	A,C		; .and add Hi Nybble
	RET

;.....
; Return the next available byte from Sector Buffer in the A register.
;  Carry Flag is Set if attempt to read past End-of-File or Read Error.

GETBIN:	PUSH	HL		; Preserve all regs
	LD	HL,(INPTR)	; Check the pointer for disk read
	LD	A,H		; Has it overflowed?
	OR	A
	JR	Z,GETBI0	; ..jump if not to get the byte
	PUSH	DE		; Save rest of the regs
	PUSH	BC
	CALL	RDSEC		; Else Read the disk and reset pointer
	POP	BC		; Restore regs
	POP	DE
	JR	NZ,RDERR	; .jump if Error
	LD	HL,BUFF		; ..else reset the pointer
GETBI0:	LD	A,(HL)		; Get the next byte
	INC	HL		; .bump pointer
	LD	(INPTR),HL	; ..save
	POP	HL		; Restore all regs
	RET

;.....
; Ring the bell if so configured

RING:	LD	A,(USEBEL)	; Get the flag
	OR	A		; Ring?
	RET	Z		; ..return if Not
	LD	A,BELL		; Else set up the char
	JP	COUT		; ..and do it!

;.....
; Print message only if the ZCPR3 Quiet (or Silent) Flags permit

QPRINT:	LD	A,(QUIET)	; Get the local quiet flag
	OR	A		; Print permitted?
	JP	Z,VPRINT	; ..jump to do it if so
	EX	(SP),HL		; Else get the string addr
	XOR	A		; .scan for this char
QPLOOP:	CP	(HL)
	INC	HL		; ..bumping ptr
	JR	NZ,QPLOOP	; ...til found
	EX	(SP),HL		; Then restore regs & stack
	RET			; ..and return

;.....
; Print the value in HL as 4 Hex chars if the Quiet flag permits

QPRHEX:	LD	A,(QUIET)	; Are we quiet?
	OR	A
	RET	NZ		; ..exit here if so
	JP	PHL4HC		; Else go print it

; Print best approximation of program's actual name

MYLNAM:	CALL	VPRINT
	DEFB	'   ',0
	LD	A,(ZSYSFL)
	OR	A
	JR	Z,DEFNAM
	CALL	GETEFCB
	JP	NZ,PRTNAME
DEFNAM:	CALL	VPRINT
	DEFB	'MYLOAD',0
	RET

;---------------------------------------------------------------------------
;	      V I D E O    C O N T R O L    R O U T I N E S
;---------------------------------------------------------------------------
;.....
; Skip a control string in the ZCPR3 TCAP storage area.

;  PROCEDURE  VidSkp (ptr : ADDRESS) : ADDRESS;
;    BEGIN
;      tp := ptr;
;      WHILE  tp^ # 0C  DO
;	IF  tp^ = '\'  THEN
;	  INC (ptr, 2)
;	ELSE  INC (ptr);
;	  END;
;	tp := ptr;
;	END;
;      INC (ptr);
;      RETURN  ptr;
;    END  VidSkp;

VIDSKP:	LD	A,(HL)		; Get a character
	INC	HL		; .bump pointer
	OR	A
	RET	Z		; ..exit if null character
	CP	'/'		; Literal character?
	JR	NZ,VIDSKP	; ..loop for next if Not
	INC	HL		; Else skip next character
	JR	VIDSKP		; ..then loop again

;.....
; Print a string from the ZCPR3 TCAP storage area.

;  PROCEDURE  VidOut (dly : CHAR; ptr : ChPtr);
;    BEGIN
;      WHILE  ptr^ # 0C  DO
;	ch := ptr^;  INC (ptr);
;	IF  ch = '\'  THEN
;	  ch := ptr^;  INC (ptr);
;	  END;
;	Cout (ORD (ch));
;        END;	(* while *)

;      rslt := ORD (dly);		(* Set up for Delay routine *)
;      WHILE  rslt # 0 DO
;	INC(rslt);  DEC(rslt);  INC(rslt);  DEC(rslt);    (* Waste some time *)
;	INC(rslt);  DEC(rslt);  INC(rslt);  DEC(rslt);
;	DEC(rslt);
;	END;
;    END  VidOut;

VIDOUT:	LD	A,(HL)		; Get currently addressed char
	INC	HL		; .(advance to next)
	OR	A		; Anything there?
	RET	Z		; ..exit if Not
	CP	'/'		; Literal flag?
	JR	NZ,VIDOU1	; ..jump if Not to print it
	LD	A,(HL)		; Else get literal argument
	INC	HL		; .advance to next
VIDOU1:	CALL	COUT		; Print a character
	JR	VIDOUT		; ..and loop for more

; NOTE: Delays are not implemented here because they are not needed
;	for the minimal subset used in this program

;(****************************************************************)
;(*        Initialize the Terminal with TCAP Parameters	         *)
;(****************************************************************)
;PROCEDURE Tinit ();
;  BEGIN
;    ptr := vidptr;
;    IF  (ptr^ > ' ') AND (vidptr # 0)  THEN
;      INC (ptr, 23);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      VidOut (0C, ptr);
;      END;
;  END  Tinit;

TINIT:	LD	HL,(ENVADR)	; Get Environment pointer
	LD	DE,128		; .set offset to TCAP
	LD	A,H
	OR	L		; Any ENV defined?
	JR	Z,NOVID		; ..jump if Not to set false
	ADD	HL,DE		; Else point to TCAP start
	LD	A,(HL)		; Get first char of Name, or space
	LD	E,23		; .(set offset to string start)
	ADD	HL,DE		; ..(point there in case good)
	CP	' '+1		; Anything defined?
	JR	NC,VIDOK	; ..jump to set current address if So
NOVID:	LD	HL,0000		; Else Load undefined pointer
VIDOK:	LD	(VIDPTR),HL	; .set TCAP pointer address
	LD	A,H
	OR	L		; Any TCAP Present?
	RET	Z		; ..quit here if Not
	JR	VIDSK5		; Else jump elsewhere to skip 5 and print

;(****************************************************************)
;(*  Restore Terminal to Default conditions with TCAP Parameters *)
;(****************************************************************)
;PROCEDURE Dinit ();
;  BEGIN
;    ptr := vidptr;
;    IF  (ptr^ > ' ') AND (vidptr # 0)  THEN
;      INC (ptr, 23);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      VidOut (0C, ptr);
;      END;
;  END  Dinit;

DINIT:	LD	HL,(VIDPTR)	; Get pointer to Video strings
	LD	A,H
	OR	L		; Anything there?
	RET	Z		; ..quit if Not
	CALL	VIDSKP		; Else skip some strings to De-Init one
VIDSK5:	CALL	VIDSKP
VIDSK4:	CALL	VIDSKP
VIDSK3:	CALL	VIDSKP
	CALL	VIDSKP
	CALL	VIDSKP
	JR	VIDOUT		; Print the string and exit

;(****************************************************************)
;(*	Switch Display to Highlighted Mode (Reverse, etc)	*)
;(****************************************************************)

;PROCEDURE  InvOn ();
;  BEGIN
;    ptr := vidptr;
;    IF  (ptr^ > ' ') AND (vidptr # 0)  THEN
;      INC (ptr, 23);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      VidOut (0C, ptr);
;      END;
;  END  InvOn;

INVON:	PUSH	HL		; Save regs
	LD	HL,(VIDPTR)	; Get TCAP Pointer
	LD	A,H
	OR	L		; Anything there?
	CALL	NZ,VIDSK3	; ..skip 3 and print if So
	POP	HL		; Restore regs
	RET			; ..exit

;(****************************************************************)
;(*	Switch Display to Normal Intensity/Attribute Mode	*)
;(****************************************************************)

;PROCEDURE InvOff ();
;  BEGIN
;    ptr := vidptr;
;    IF  (ptr^ > ' ') AND (vidptr # 0)  THEN
;      INC (ptr, 23);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      ptr := VidSkp (ptr);
;      VidOut (0C, ptr);
;      END;
;  END  InvOff;

INVOFF:	PUSH	HL		; Save regs
	LD	HL,(VIDPTR)	; Get TCAP Pointer
	LD	A,H
	OR	L		; Anything there?
	CALL	NZ,VIDSK4	; ..skip 4 and print if So
	POP	HL		; Restore regs
	RET			; ..exit

;(****************************************************************)
;(*     Print string with Highlight/Normal attribute sensing     *)
;(****************************************************************)
; Inline print of string with Highlight attribute sensing.
; No Pseudocode exists for these routines since they do not conform
;  to the style of Modula-2 nor the existing library support code.

VPRINT:	EX	(SP),HL		; Swap return address and pointer
	CALL	VPSTR		; .print the line with attribute sensing
	EX	(SP),HL		; ..swap back again
	RET			; ...and quit

; Print line addressed by HL with attribute sensing

VPSTR:	LD	A,(HL)		; Get a character
	INC	HL		; .advance to next
	OR	A		; End of string?
	RET	Z		; ..quit if so
	CP	1		; Highlight On?
	CALL	Z,INVON		; ..switch attribute On if so, returning Zero
	CP	2		; Highlight Off?
	CALL	Z,INVOFF	; ..switch attribute Off if so, returning Zero
	OR	A		; Any valid character?
	JR	Z,VPSTR		; ..loop if we did an attribute (Zero present)

	CALL	COUT7		; Else print the character
	JR	VPSTR		; ..and loop

;---------------------------------------------------------------------------
;	       S T R I N G S    A N D    C O N S T A N T S
;---------------------------------------------------------------------------

COMTYP:	DEFB	'COM'
HEXTYP:	DEFB	'HEX'

;---------------------------------------------------------------------------
;	     U N I N I T I A L I Z E D    D A T A    A R E A
;---------------------------------------------------------------------------

	DSEG			; Uninitialized Data goes here

OFCB:	DEFS	36		; Output File Control Block
HFLAG1:	DEFS	1		; 0=Offset Not set, FF=Offset Set
HOFFST:	DEFS	2		; Offset in buffer for Hex ORG compensation
QUIET:	DEFS	1		; Flag to operate in Quiet Mode
INPTR:	DEFS	2		; Pointer into input file buffer
CUSER:	DEFS	2		; Current User and Drive
TUSER:	DEFS	2		; Temporary User and Drive for File IO
SCNPTR:	DEFS	2		; Scan pointer into Command Tail
ZSYSFL:	DEFS	1		; 0 if not running under ZCPR3
VIDPTR:	DEFS	2		; Storage for Video String Pointer in TCAP

; Pointers relating to the Buffer Image and Area

BASADR:	DEFS	2		; Base of available RAM for work space
TOPADR:	DEFS	2		; Top of available RAM protecting CPR
TOPFIL:	DEFS	2		; Top address of Output File
WRKPTR:	DEFS	2		; Working pointer

	DEFS	64		; Space for a stack
STACK:	DEFS	2		; Storage for entry stack pointer

	END