; dossys15/asm - sjp/mss - kjw/bqsd - 08/82
;
*TITLE	'<Dos+ II.A - SYS15/SYS>'
;
;	THIS SYSTEM IS HIGH RESIDING (2200-27FF)
;	IT CONTAINS THE FOLLOWING ROUTINES:
;
;	1 -	$CLEAR	- CLEAR FILE/RAM
;	2 -	$CREATE - CREATE FILE
;	3 -	$DUMP	- DUMP RAM TO FILE
;	4 -	$BUILD	- CREATE ASCII FILE
;	5 -	$LOAD	- LOAD FILE IN RAM
;	6 -	$RENAME - RENAME FILE/DEVICE
;
;	Created: 27-JUN-82	SJP/MSS
;	Revised: 27-JUN-82	SJP/MSS
;
*EJECT
;	LOCAL SUPPORT EQUIVALENCES
;
CR	EQU	13		;ASCII C/R
VT	EQU	11		;ASCII VT
ETX	EQU	3		;ASCII ETX
ETB	EQU	23		;ASCII ETB
;
BADF	EQU	1		;BAD FUNCTION CALL
PERR	EQU	3		;PARAMETER ERROR
FERR	EQU	19		;INVALID FILESPEC
MERR	EQU	47		;MISSING PARAMETER
EERR1	EQU	28		;END-OF-FILE ERROR
EERR2	EQU	29		;PAST EOF ERROR
LDB	EQU	01H		;LD BC,NNNN
ERR19	EQU	19		;invalid filespec
ERR35	EQU	35		;memory fault
ERR47	EQU	47		;required param
ERR48	EQU	48		;invalid data
ERR68	EQU	68		;invalid devicespec
ERR83	EQU	83		;device already exists
ERR98	EQU	98		;data out of range
;
;	EXTERNAL SVC EQUIVALENCES
;
GET	EQU	77		;input from device
KBCHAR	EQU	4		;keyboard character
VDCHAR	EQU	8		;video character
SLOAD	EQU	86		;load program
FEXT	EQU	88		;add default extension
PUT	EQU	78		;output to device
KBLINE	EQU	5		;fetch line from keyboard
PEOF	EQU	82		;position file to end
READNX	EQU	34		;READ NEXT RECORD
ERROR	EQU	39		;POST ERROR MESSAGE
OPEN	EQU	40		;OPEN DEVICE/FILE
CLOSE	EQU	42		;CLOSE DEVICE/FILE
WRITNX	EQU	43		;WRITE NEXT RECORD
DIRWR	EQU	44		;DIRECT RECORD WRITE
REWD	EQU	81		;REWIND FILE
EVAL	EQU	83		;EVALUATE CMD LINE
PARAM	EQU	87		;FETCH OPTIONAL PARAMS
FSPEC	EQU	84		;fetch filespec
;
;	EXTERNAL SUPPORT EQUIVALENCES
;
SVC	EQU	08H		;EXECUTE SVC
DIO	EQU	10H		;DISK I/O MANAGER
OVLAY	EQU	18H		;EXECUTE OVERLAY
;
DEVTBL	EQU	0100H		;start device table
KEYBUFF EQU	01B0H		;sys1 input buffer
DATAK5	EQU	016FH		;sys1 input pointer
DATAK6	EQU	0171H		;low memory
LOWMEM	EQU	DATAK6		;START FREE MEMORY
DATAK7	EQU	0173H		;top free memory
TOPMEM	EQU	DATAK7		;TOP FREE MEMORY
DMULT	EQU	0312H		;8 X 16 MULTIPLY
LOCDCT	EQU	032DH		;LOCATE DRIVE DCT
BUFER1	EQU	1A00H		;user buffer
UCASE	EQU	031EH		;A to upper case
;
*EJECT
;	TABLE OF VECTORED ROUTINES
;
	ORG	2200H		;HIGH OVERLAY
;
VECTORS DEFW	RETURN		;0  - NOTHING DONE
	DEFW	CLEAR		;1  - CLEAR RAM/FILE
	DEFW	CREATE		;2  - CREATE FILE
	DEFW	DUMP		;3  - DUMP FILE
	DEFW	BUILD		;5  - BUILD ASCII FILE
	DEFW	LOAD		;5  - LOAD FILE
	DEFW	RENAME		;6  - RENAME FILE/DEVICE
	DEFW	UNDEF		;7  - UNDEFINED
	DEFW	UNDEF		;8  - UNDEFINED
	DEFW	UNDEF		;9  - UNDEFINED
	DEFW	UNDEF		;10 - UNDEFINED
	DEFW	UNDEF		;11 - UNDEFINED
	DEFW	UNDEF		;12 - UNDEFINED
	DEFW	UNDEF		;13 - UNDEFINED
	DEFW	UNDEF		;14 - UNDEFINED
	DEFW	UNDEF		;15 - UNDEFINED
;
;	UNDEFINED ROUTINE HANDLER
;
UNDEF	LD	A,BADF		;BAD FUNCTION CALL
	OR	A		;NZ STATUS
	RET			;EXIT
;
;	error program exit
;
POSTE	AND	7FH		;assure a return
	LD	B,A		;pass error code
POSTEB	LD	A,ERROR 	;SVC #
	RST	SVC		;display error
RETURN	XOR	A		;return ZERO
	RET			;back to caller
;
*EJECT
;	$CLEAR - CLEAR FILE/MEMORY
;
;	ENT	HL =>	COMMAND LINE
;
;	INITIALIZE PARAMETERS
;
CLEAR	PUSH	HL		;save input pointer
	LD	HL,0		;DATA = 0
	LD	(DATPAR),HL	;save data
	LD	HL,(LOWMEM)	;GET LOW MEM
	LD	(STPAR),HL	;INIT START
	LD	HL,(TOPMEM)	;GET TOP MEM
	LD	(ENDPAR),HL	;INIT END
;
	LD	HL,POSTE	;error exit
	EX	(SP),HL 	;leave vector, get input
;
;	fetch CLEAR parameters
;
	LD	DE,PLIST1	;clear param block
	CALL	EVALIT		;evaluate input
	RET	NZ		;error!
;
;	check if file specified
;
	LD	A,(IX)		;get eval flags
	AND	6		;bits 2&1
	JR	Z,CLRMEM	;nope, must be memory
;
;	CLEAR DATA FILE HERE
;
	LD	DE,DCB@1+1	;DCB to use
;
;	locate the file
;
	LD	BC,3<8+'E'      ;CODE + EXTENDED FIXED
	XOR	A		;LRL = 256
	CALL	OPEN$		;OPEN FILE
	RET	NZ		;error
;
	CALL	FCLR		;FILL FILE
	RET	NZ		;error
	POP	AF		;remove error exit
	XOR	A		;return ZERO
	RET
;
;	CLEAR MEMORY HERE
;
CLRMEM	LD	HL,(TOPMEM)	;get top memory
	LD	BC,(ENDPAR)	;get end param
	OR	A		;clear carry
	SBC	HL,BC		;compare
	LD	A,ERR98 	;invalid data
	RET	C		;out of range
;
	LD	HL,0		;start mem to clear
STPAR	EQU	$-2
	CALL	CKPARM		;compare start<>end
	RET	C		;end < start!
	LD	BC,(LOWMEM)	;get low memory
	PUSH	HL		;save start
	SBC	HL,BC		;compare, must be >=
	POP	HL
	RET	C		;error!
;
;	fetch data to fill
;
	POP	BC		;remove error vector
	LD	BC,0		;get data param
DATPAR	EQU	$-2
	INC	B		;any MSB?
	DEC	B		;B=0?
	JR	NZ,MCLR 	;nope, two byte fill
	LD	B,C		;one byte fill
;
;	FILL MEMORY BLOCK
;
MCLR	CALL	CKPARM		;at end?
	RET	Z		;done, return ZERO
	LD	(HL),C		;LSB DATA
	INC	HL		;NEXT
	CALL	CKPARM		;END?
	RET	Z		;DONE!
	LD	(HL),B		;MSB DATA
	INC	HL		;NEXT
	JR	MCLR		;TIL DONE
;
;	CHECK START & END PARAMS
;
CKPARM	LD	DE,0		;end of block
ENDPAR	EQU	$-2
	EX	DE,HL		;HL => END
	OR	A		;CLR CRY
	SBC	HL,DE		;DE <= END?
	EX	DE,HL		;RESTORE
	RET
;
*EJECT
;
;	FILL FILE ROUTINE
;
;	ENT	DE =>	OPEN DCB
;
FCLR	LD	BC,(DATPAR)	;GET DATA
	INC	B
	DEC	B		;ANY MSB?
	JR	NZ,$+3		;IF YES
	LD	B,C		;1 CHAR FILL
	LD	HL,BUFER1	;HL => DATA BUFFER
	LD	A,80H		;128 pairs of bytes
FCLR1	LD	(HL),C		;TO BUFF
	INC	HL		;NEXT
	LD	(HL),B		;TO BUFF
	INC	HL		;NEXT
	DEC	A		;NEXT
	JR	NZ,FCLR1	;TIL DONE
;
;	FETCH FILE LENGTH
;
	PUSH	DE
	POP	IX		;IX => FILE DCB
	LD	B,(IX+12)
	LD	H,(IX+13)
	LD	L,(IX+14)	;BHL = ERN
	LD	A,(IX+11)	;ERN BYTE
	OR	A		;PARTIAL SECTOR?
	JR	Z,FCLR2 	;IF NOT
	INC	L		;CORRECT
	JR	NZ,FCLR2
	INC	H		;CORRECT
	JR	NZ,FCLR2
	INC	B		;CORRECT
;
;	WRITE FILLED RECORD(S)
;
FCLR2	LD	A,L
	OR	H
	OR	B		;DONE?
	RET	Z		;IF YES
	LD	A,WRITNX	;WRITE RECORD
	RST	SVC		;DO IT!
	RET	NZ		;i/o error
	CALL	DECBHL		;DEC BHL
	JR	FCLR2		;TIL DONE
;
;	BACKSPACE RECORD BHL
;
DECBHL	LD	A,-1
	DEC	L		;NEXT
	CP	L
	RET	NZ
	DEC	H		;NEXT
	CP	H
	RET	NZ
	DEC	B		;NEXT
	RET
;
*EJECT
;	$EVAL BLOCK FOR $CLEAR
;
PBLOCK	DEFB	0		;FLAGS
	DEFW	DCB@1		;DCB
	DEFW	DCB@1		;DCB
	DEFW	DCB@1		;DCB
	DEFW	PLIST1		;PARAMETER LIST
;
;	$PARAM LIST FOR $CLEAR
;
PLIST1	DEFB	40H+4-1 	;(D)ATA
	DEFW	DATPAR
	DEFM	'DATA'
	DEFB	40H+5-1 	;(S)TART
	DEFW	STPAR
	DEFM	'START'
	DEFB	40H+3-1 	;(E)ND
	DEFW	ENDPAR
	DEFM	'END'
	DEFB	0		;END LIST
;
*EJECT
;	$CREATE - CREATE DISK FILE
;
;	ENT	HL =>	COMMAND LINE
;
;	INITIALIZE PARAMETERS
;
CREATE	LD	BC,0		;DEFAULT
	LD	(VERPAR),BC	;INIT VERIFY SWITCH
	LD	(KEEPAR),BC	;INIT KEEP SWITCH
	LD	(SIZPAR),BC	;INIT SIZE IN RECDS
	LD	(LRLPAR),BC	;INIT LRL
	LD	(KILPAR),BC	;INIT SIZE IN K
	LD	(GRAPAR),BC	;INIT SIZE IN GRANS
	DEC	BC		;BC = FFFF
	LD	(DATPAR),BC	;save for data param
;
	LD	BC,POSTE	;error exit
	PUSH	BC		;leave on stack
;
;	FETCH OPTIONAL PARAMETERS
;
	LD	DE,PLIST2	;PARAMETER BLOCK
	CALL	EVALIT		;evaluate input
	RET	NZ		;error, go!
	LD	A,(IX+0)	;EVAL FLAGS
	AND	6		;ANY FIELD?
	LD	A,MERR		;missing filespec
	RET	Z		;go error!
;
;	OPEN/INIT TARGET FILE
;
	LD	BC,1<8+'E'      ;CODE + EXTENDED
LRLPAR	EQU	$+1
	LD	DE,0		;DE = LRL
	LD	A,E		;A = LRL MOD 256
	LD	DE,DCB@1+1	;DE => FILE DCB
	CALL	OPEN$		;OPEN FILE
	RET	NZ		;error
;
;	ALLOCATE FILE SPACE
;
	CALL	GTSIZE		;GET FILE SIZE
	JR	Z,POPPER	;no records!
	CALL	DECBHL		;RELATIVE 0
	LD	IX,REC		;IX => TEMP STORAGE
	LD	(IX+0),B
	LD	(IX+1),H
	LD	(IX+2),L
	LD	BC,REC		;BC => RECORD
	LD	A,DIRWR 	;DIRECT WRITE
	RST	SVC		;DO IT!
	RET	NZ		;i/o error
;
	LD	HL,DCB@1+1+1	;HL => DCB FLAGS
	RES	7,(HL)		;FORCE NOT BLK'D
	LD	A,REWD		;REWIND FILE
	RST	SVC		;DO IT!
	RET	NZ		;if error
;
;	FILL SPACE OPTIONAL DATA
;
	LD	BC,(DATPAR)	;DE = DATA
	LD	A,B
	AND	C		;ANY DATA?
	INC	A		;BC = FFFF?
	CALL	NZ,FCLR 	;WRITE DATA!
	RET	NZ		;go error!
;
;	VERIFY ALLOCATED SPACE
;
VERPAR	EQU	$+1
	LD	BC,0		;VERIFY SWITCH
	INC	C
	DEC	C		;VERIFY?
	JR	Z,CREATE2	;IF NOT
;
;	rewind file to beginning
;
	LD	A,REWD		;SVC #
	RST	SVC		;rewind the file
	RET	NZ		;error!
;
CREATE1 LD	A,READNX	;READ NEXT RECORD
	RST	SVC		;DO IT!
	JR	Z,CREATE1	;AGAIN
	CP	EERR1		;EOF?
	JR	Z,CREATE2	;ALL OK
	CP	EERR2		;PAST EOF?
	RET	NZ		;I/O error!
;
;	CLOSE TARGET FILE & EXIT
;
KEEPAR	EQU	$+1
CREATE2 LD	BC,0		;KEEP FLAG
	INC	C
	DEC	C		;KEEP?
	JR	Z,$+7		;IF NOT
	LD	HL,DCB@1+1+2	;HL => DCB FLAGS
	SET	6,(HL)		;KEEP!
	CALL	CLOSER		;close the file
	RET	NZ		;go error!
POPPER	POP	AF		;remove error vector
	XOR	A		;return zero
	RET			;on to the next
;
REC	DEFS	3		;RECORD STORAGE
;
*EJECT
;	GET FILE SIZE IN RECORDS
;
SIZPAR	EQU	$+1
GTSIZE	LD	HL,0		;SIZE PARAM
	LD	A,H
	OR	L		;ANY SIZE?
	JR	Z,GTSIZ1	;IF NOT
	LD	B,0		;BHL = RECS
	RET
;
;	GET FILE SIZE IN K
;
KILPAR	EQU	$+1
GTSIZ1	LD	HL,0		;KILO PARAM
	LD	A,H
	OR	L		;ANY KILO?
	JR	Z,GTSIZ2	;IF NOT
	LD	A,4		;SEC/K
	JR	GTSIZ3		;SKIP
;
;	GET FILE SIZE IN GRANS
;
GRAPAR	EQU	$+1
GTSIZ2	LD	HL,0		;GRANS PARAM
	LD	A,H
	OR	L		;ANY GRANS?
	RET	Z		;IF NOT
	LD	A,(DCB@1+1+16)	;GET DRIVE
	LD	C,A		;C = DRIVE
	CALL	LOCDCT		;LOCATE DCT
	LD	A,(IY+19)	;SEC/GRAN
;
;	CALCULATE FILE SIZE
;
GTSIZ3	PUSH	DE		;SAVE
	CALL	DMULT		;GET SECTORS!
	POP	DE		;RESTORE
	LD	B,H
	LD	H,L
	LD	L,A		;BHL = RECS
	OR	-1		;NZ STATUS
;
;	set non-blocked records for correct allocation
;
	PUSH	HL		;save # recs
	LD	HL,DCB@1+1+1	;point to flag
	RES	7,(HL)		;blocked OFF
	POP	HL		;restore
	RET
;
*EJECT
;
;	$PARAM LIST FOR $CREATE
;
PLIST2	DEFB	40H+4-1 	;(D)ATA
	DEFW	DATPAR
	DEFM	'DATA'
	DEFB	20H+6-1 	;(V)ERIFY
	DEFW	VERPAR
	DEFM	'VERIFY'
	DEFB	20H+4-1 	;(K)EEP
	DEFW	KEEPAR
	DEFM	'KEEP'
	DEFB	40H+4-1 	;(S)IZE
	DEFW	SIZPAR
	DEFM	'SIZE'
	DEFB	40H+3-1 	;(L)RL
	DEFW	LRLPAR
	DEFM	'LRL'
	DEFB	40H+4-1 	;KILO
	DEFW	KILPAR
	DEFM	'KILO'
	DEFB	40H+5-1 	(G)RANS
	DEFW	GRAPAR
	DEFM	'GRANS'
	DEFB	0		;END LIST
;
*EJECT
;	GENERAL PURPOSE OPEN ROUTINE
;
;	ENT	 A =	LRL (0-255)
;		 B =	OPEN CODE (0-3)
;		 C =	OPEN TYPE (F,V,E)
;
OPEN$	PUSH	HL		;SAVE
	LD	HL,OLIST+7	;open list
	LD	(HL),A		;set LRL
	INC	HL
	LD	(HL),C		;Fixed or Extended
	INC	HL
	LD	(HL),B		;open type
	LD	HL,OLIST	;BUFADR
	LD	A,OPEN		;OPEN FILE
	RST	SVC		;DO IT!
	POP	HL		;RESTORE
	RET
;
;	$OPEN PARAMETER LIST
;
OLIST	DEFW	BUFER1		;BUFADR
	DEFW	0		;RECADR
	DEFW	0		;EOFADR
	DEFM	'W'             ;READ/WRITE
	DEFB	0		;LRL = 256
	DEFM	'F'             ;FIXED FILES
	DEFB	3		;OPEN NEW LRL
;
*EJECT
;
;	$BUILD - copy keyboard lines to file
;
BUILD	LD	BC,0		;default param
	LD	(APPPAR),BC	;append param
;
	LD	BC,POSTE	;error exit
	PUSH	BC		;to the stack
	LD	DE,PLIST3	;build params
	CALL	EVALIT		;evaluate input
	RET	NZ		;display error
;
	LD	A,(IX)		;get params
	AND	6		;any filespecs here?
	LD	A,ERR47 	;required param
	RET	Z		;error, no channel
;
	LD	DE,DCB@1+1	;DCB area
	LD	HL,TXTEXT	;/TXT extension
	LD	A,FEXT		;SVC #
	RST	SVC		;add default extension
	LD	BC,0		;get append param
APPPAR	EQU	$-2
	INC	C		;yes?
	LD	B,2		;create if not found
	JR	Z,$+4		;go if append
	LD	B,2		;open/create
	LD	C,'E'           ;extended mode
	XOR	A		;LRL = 0
	CALL	OPEN$		;open the file
	RET	NZ		;error!
	LD	A,(APPPAR)	;get append param again
	INC	A		;yes?
	JR	NZ,BUILDST	;nope, go!
;
;	operation is APPEND, position file
;
	LD	A,PEOF		;SVC #
	RST	SVC		;position to end
	JR	Z,BUILDST	;no error, go!
	CP	28		;end of file?
	JR	Z,BUILDST	;no error, go!
	CP	29		;beyond?
	RET	NZ		;display error
;
;	file is set to go, display header message
;
BUILDST LD	HL,BLDMSG	;text
	CALL	LINE$		;display it
	RET	NZ		;display error
;
;
BUILDLP LD	HL,STRING	;alt input buffer
	LD	B,79		;max chars/line
	LD	A,KBLINE	;fetch from keyboard
	RST	SVC		;fetch it
	RET	NZ		;error, abort!
	PUSH	AF		;save flags
	POP	DE		;in DE
	JR	NC,BLDPUT	;not break, go!
	DEC	B		;less last C/R
	JR	Z,CLOSIT	;done, close it up!
	LD	C,-1		;no C/R to end!
;
;	write line to file
;
BLDPUT	LD	A,(HL)		;fetch a character
	CALL	PUTCHR		;write char to file
	INC	HL		;bump pointer
	DJNZ	BLDPUT		;finish off the line
;
;	check if terminator passed to input string
;
	INC	C		;C = 0 ?
	DEC	C
	JR	NZ,BLDFIN	;nope, go!
	LD	A,13		;send C/R to file
	CALL	PUTCHR		;write to file
;
BLDFIN	PUSH	DE		;get flags back
	POP	AF		;C = end of file
	JR	NC,BUILDLP	;fetch next line
;
;	completed, close the file
;
CLOSIT	CALL	CLOSER		;close the file
	RET	NZ		;error, display!
	POP	AF		;remove error vector
	XOR	A		;return ZERO
	RET
;
CLOSER	LD	DE,DCB@1+1	;DCB
	LD	A,CLOSE 	;SVC #
	RST	SVC		;close the file
	RET
;
PUTCHR	PUSH	BC		;save 'em
	PUSH	DE
	LD	DE,DCB@1+1	;channel DCB
	LD	B,A		;pass char to B
	LD	A,PUT		;SVC #
	RST	SVC		;write char to file
	POP	DE		;unstack
	POP	BC
	RET	Z		;return if OK
	POP	HL		;back to next level
	RET			;with error!
;
GETCHR	PUSH	DE
	LD	DE,DCB@1+1	;channel DCB
	LD	A,GET		;SVC #
	RST	SVC		;fetch byte
	JR	NZ,GETERR	;error, see why
	LD	A,(DE)		;see if file device
	CPL			;reverse bits
	OR	A		;clear carry
	BIT	7,A		;is it?
	LD	A,B		;get character
	POP	DE		;restore stack
	RET	Z		;file, return
	CP	3		;ETX marker?
	SCF			;carry = end
	RET	Z		;yes, return
	CP	A		;Z, NC
	RET			;return it
;
GETERR	POP	DE		;restore stack
	CP	28		;end of file?
	SCF
	RET	Z
	CP	29
	SCF
	RET	Z
	OR	A		;return with error
	RET
;
;	$EVALIT - evaluate user input
;
EVALIT	LD	(PBLOCK+7),DE	;save param pointer
	LD	IX,PBLOCK	;evaluate block
	LD	A,EVAL		;SVC #
	RST	SVC		;eval user input
	RET			;return with status
;
;	param list for build
;
PLIST3	DEFB	20H+5		;switch + length-1
	DEFW	APPPAR		;param vector
	DEFM	'APPEND'        ;param word
	DEFB	0		;terminator
;
TXTEXT	DEFM	'TXT'           ;build extension
;
BLDMSG	DEFM	'Enter text (79 chars/line)'
	DEFB	CR
	DEFB	CR
	DEFB	ETX
;
*EJECT
;
;	$DUMP - dump memory to channel
;
DUMP	PUSH	HL		;save cmd line
	LD	HL,(LOWMEM)	;get low memory
	LD	(STPAR),HL	;save start param
	LD	HL,(TOPMEM)	;get top memory
	LD	(ENDPAR),HL	;save end param
	LD	HL,0
	LD	(TRAPAR),HL	;transfer address
	LD	(DATPAR),HL	;data param (core image)
	LD	(RELPAR),HL	;relocation address
;
	LD	HL,POSTE	;error exit
	EX	(SP),HL 	;to the stack
;
	LD	DE,PLIST4	;dump param list
	CALL	EVALIT		;evaluate input
	RET	NZ		;error, show why
;
;	check for destination path
;
	LD	A,(IX)		;get eval flags
	AND	6		;source/dest
	LD	A,ERR47 	;required param
	RET	Z		;error, abort!
;
	LD	DE,DCB@1+1	;point to DCB
	LD	HL,CMDEXT	;/CMD extension
	LD	A,(DATPAR)	;get data param
	INC	A		;yes?
	JR	NZ,ADDEXT	;nope, use cmd
	LD	HL,CIMEXT	;/CIM extension
ADDEXT	LD	A,FEXT		;SVC #
	RST	SVC		;add extension
;
;	check for valid memory params
;
	LD	HL,(ENDPAR)	;get end of dump
	LD	BC,(STPAR)	;get start of dump
	OR	A		;clear carry
	SBC	HL,BC		;test start < end
	LD	A,ERR98 	;illegal data range
	RET	C		;start < end!
;
	LD	BC,2<8+'F'      ;open code + fixed
	XOR	A		;LRL = 0
	CALL	OPEN$		;open the file
	RET	NZ		;abort error!
;
	CALL	WRDATA		;write data to file
	RET	NZ		;display error!
;
	JP	CLOSIT		;close the file!
;
WRDATA	LD	DE,0		;relocate param
RELPAR	EQU	$-2
	LD	A,D		;anything here?
	OR	E
	JR	NZ,WRDAT1	;yes, go!
	LD	DE,(STPAR)	;else use actual
WRDAT1	LD	BC,(STPAR)	;data start
	LD	HL,(ENDPAR)	;get end of data
	PUSH	BC		;save start
	SBC	HL,BC		;get data length
	INC	HL		;+ 1 for inclusive addr's
	LD	B,H		;pass to BC
	LD	C,L		;BC = length to write
	POP	HL		;HL = start of data
;
;	HL = start of data to write
;	DE = address where data is to load
;	BC = length of data
;
WRDAT2	INC	B		;any full pages?
	DEC	B		;B=0?
	JR	NZ,WRDAT3	;full block, do it
;
	INC	C		;any partial pages?
	DEC	C
	JR	Z,WRDAT4	;done!
	CALL	WRDAT5		;write partial block
	RET	NZ		;error!
;
;	all data saved to channel
;
WRDAT4	LD	A,(DATPAR)	;core image?
	INC	A		;FF = yes
	RET	Z		;yes, no transfer address
;
;	insert entry block
;
	LD	A,02
	CALL	PUTCHR		;write to file
	LD	A,02
	CALL	PUTCHR
	LD	DE,0		;get transfer address
TRAPAR	EQU	$-2
	LD	A,E		;get LSB
	CALL	PUTCHR		;to the file
	LD	A,D		;get MSB
	CALL	PUTCHR		;to the file
	RET			;return status
;
WRDAT3	PUSH	BC		;save counter
	LD	C,0		;one full block
	CALL	WRDAT5		;write it out
	POP	BC		;get counter
	RET	NZ		;error, return
	DEC	B		;less page just written
	JR	WRDAT2		;continue
;
WRDAT5	LD	A,(DATPAR)	;core image?
	INC	A		;FF = yes
	JR	Z,WRDAT6	;yes, no load marker
;
;	insert load marker in file
;
	LD	A,01
	CALL	PUTCHR		;to the file
	LD	A,C		;get length
	ADD	A,2		;+ load address
	CALL	PUTCHR
;
	LD	A,E		;get load address
	CALL	PUTCHR
	LD	A,D		;MSB address
	CALL	PUTCHR
;
WRDAT6	LD	A,(HL)		;get data byte
	CALL	PUTCHR		;write to file
	INC	HL		;bump data pointer
	INC	DE		;bump relocate pointer
	DEC	C		;less counter
	JR	NZ,WRDAT6	;finish it off
	RET			;return zero
;
;	param block for $DUMP
;
PLIST4	DEFB	40H+4		;value + length-1
	DEFW	STPAR		;data vector
	DEFM	'START'         ;param
;
	DEFB	40H+2
	DEFW	ENDPAR
	DEFM	'END'
;
	DEFB	40H+2
	DEFW	TRAPAR
	DEFM	'TRA'
;
	DEFB	20H+3
	DEFW	DATPAR
	DEFM	'DATA'
;
	DEFB	40H+3
	DEFW	RELPAR
	DEFM	'RELO'
;
	DEFB	0
;
CMDEXT	DEFM	'CMD'           ;for command files
CIMEXT	DEFM	'CIM'           ;for core image files
;
*EJECT
;
;	$LOAD - load data/file to memory
;
LOAD	LD	BC,0
	LD	(PROPAR),BC	;prompt
	LD	(RUNPAR),BC	;run
	LD	(STPAR),BC	;start
	LD	(TRAPAR),BC	;transfer
;
	LD	BC,POSTE	;error exit
	PUSH	BC		;save it
;
	LD	DE,PLIST5	;param block
	CALL	EVALIT		;evaluate user input
	RET	NZ		;display error
;
	LD	A,(IX)		;get filled fields
	AND	6		;source/dest
	LD	A,ERR47 	;required not found
	RET	Z		;display error
	LD	(SAVEHL),HL	;save input pointer
;
;	load in SYS4 in case of single drive load
;
	CALL	FETCH4		;load in sys4
	RET	NZ		;error!
;
	CALL	TMOUNT		;mount target disk
;
	LD	DE,DCB@1+1	;DCB
	LD	HL,(STPAR)	;any start address
	LD	A,H		;any bits on?
	OR	L
	LD	HL,CMDEXT	;/CMD extension
	JR	Z,$+5		;no, load file
	LD	HL,CIMEXT	;/CIM extension
	LD	A,FEXT		;SVC #
	RST	SVC		;add default extension
;
;	check for core image type load
;
	LD	HL,(STPAR)	;get start param
	LD	A,H		;any bits on?
	OR	L
	JR	NZ,LOADCIM	;yes, load core image
;
	LD	A,SLOAD 	;SVC #
	RST	SVC		;load the file
	RET	NZ		;display error
;
LOADIN	POP	AF		;remove error vector
	PUSH	HL		;save entry
	CALL	SMOUNT
;
	LD	DE,0		;run the file?
RUNPAR	EQU	$-2
	LD	A,E		;get LSB
	OR	A		;zero?
	POP	HL		;get vector
	RET	Z		;yes, return to caller
;
	LD	DE,(TOPMEM)	;get top memory
	PUSH	HL		;save program vector
	LD	HL,(TRAPAR)	;get transfer address
	LD	A,H		;anything?
	OR	L
	JR	Z,$+3		;nope, use real address
	EX	(SP),HL 	;put new address
	LD	HL,0		;get input pointer
SAVEHL	EQU	$-2
	RET			;execute program!
;
LOADCIM LD	BC,3<8+'E'      ;type + mode
	XOR	A		;LRL = 0
	CALL	OPEN$		;open the file
	RET	NZ		;display why error!
	LD	(SAVADR),HL	;save beginning load addr
;
LOADLP	CALL	GETCHR		;get a character
	RET	NZ		;error!
	JR	C,LOADFE	;done, see if run
	LD	(HL),A		;put into buffer
	CP	(HL)		;still there?
	LD	A,ERR35 	;memory fault
	RET	NZ		;display error
	INC	HL		;bump pointer
	JR	LOADLP		;get more
LOADFE	LD	HL,0		;get start vector
SAVADR	EQU	$-2
	JR	LOADIN		;execute!
;
;	param block for $LOAD
;
PLIST5	DEFB	20H+5		;switch + length-1
	DEFW	PROPAR		;data vector
	DEFM	'PROMPT'
;
	DEFB	20H+2
	DEFW	RUNPAR
	DEFM	'RUN'
;
	DEFB	40H+4
	DEFW	STPAR
	DEFM	'START'
;
	DEFB	40H+2
	DEFW	TRAPAR
	DEFM	'TRA'
;
	DEFB	0		;end param table
;
;
TMOUNT	LD	HL,TARGET	;target message
	JR	MOUNT		;go common
SMOUNT	LD	HL,SYSTEM	;system message
;
MOUNT	LD	BC,0		;get prompt param
PROPAR	EQU	$-2
	INC	C		;yes?
	RET	NZ		;nope, no need
;
MOUNTL	LD	BC,1000 	;delay
	LD	A,(BLINK)	;blink flag
	XOR	ETB		;erase code
	LD	(BLINK),A	;put it back
	PUSH	AF		;save flag
	CALL	NZ,DSP$ 	;display it
	POP	AF		;restore flag
	PUSH	HL		;save prompt
	CALL	Z,LINE$ 	;display text
	POP	HL		;restore prompt
;
FLASH	LD	A,KBCHAR	;SVC #
	RST	SVC		;fetch a key
	LD	A,ETB		;erase
	JR	Z,DSP$		;clear and return
	DEC	BC		;less counter
	LD	A,B		;any bits left?
	OR	C
	JR	NZ,FLASH	;yes, wait more
	JR	MOUNTL		;reverse message
;
DSP$	PUSH	BC		;save it
	LD	B,A		;pass char
	LD	A,VDCHAR	;SVC #
	RST	SVC		;display char
	POP	BC		;restore
	RET			;done
;
LINE$	LD	A,(HL)		;fetch a character
	CP	ETX		;done?
	RET	Z		;yes, return
	CALL	DSP$		;display the char
	RET	NZ
	INC	HL		;bump pointer
	JR	LINE$		;continue
;
TARGET	DEFM	'Mount TARGET Disk'
	DEFB	CR
	DEFB	VT
	DEFB	ETX
;
SYSTEM	DEFM	'Mount SYSTEM Disk'
	DEFB	CR
	DEFB	VT
	DEFB	ETX
BLINK	DEFB	ETB		;blink flag
;
;	RESERVED DATA AREAS
;
DCB@1	DEFS	41		;FILE DCB#1
STRING	DEFS	80		;for key input
;
*EJECT
;
;	$RENAME - rename file/device
;
RENAME	CALL	POSHL		;move HL to significant
	LD	DE,DCB@1	;DCB area
	LD	A,FSPEC 	;SVC #
	RST	SVC		;fetch file/device
	JR	NZ,POSTEE	;invalid!
;
;	position HL to next field
;
	CALL	POSHL		;move it
	LD	A,(DE)		;get type
	INC	DE		;point to specifier
	BIT	6,A		;filespec here?
	JR	NZ,RENFILE	;yes, rename the file
;
;	locate source device SLOT
;
	AND	0FH		;get device number
	ADD	A,A		;*2
	ADD	A,A		;*4
	LD	C,A		;pass to C
	LD	B,DEVTBL<-8	;BC => device name
	PUSH	BC		;pass to IX
	POP	IX		;IX => old name
;
;	check for device/drive
;
	LD	A,(DE)		;get it
	CP	(HL)		;same?
	INC	HL		;bump pointer to name
	LD	A,ERR48 	;invalid parameter
	JR	NZ,POSTEE	;go error if wrong type!
;
;	check if device exists now
;
	CALL	FINDEV		;find the device
	LD	A,ERR83 	;device exists
	JP	Z,POSTE 	;go error!
	DEC	DE		;DE => DCB
	LD	A,FSPEC 	;VALID?
	RST	SVC
	JP	NZ,POSTE	;IF NOT
	LD	A,(DE)		;GET FLAGS
	INC	DE		;DE => NAME
	AND	0E0H		;7,6,5
	CP	40H		;FILESPEC?
	LD	A,ERR68 	;invalid devicespec
	JR	NZ,POSTEE	;go error if wrong type!
;
;	device is new, change the name
;
	LD	A,(DE)		;get new char
	CALL	UCASE		;make it upper
	LD	(IX+2),A	;put into table
	INC	DE		;bump pointer
	LD	A,(DE)		;get 2'nd char
	LD	(IX+3),' '      ;default to nil
	CP	ETX		;terminator?
	JR	Z,RENRET	;yes, done!
	CALL	UCASE		;make it upper
	LD	(IX+3),A	;else save 2nd char
RENRET	XOR	A		;return zero
	RET
;
;
;	rename file routine
;
RENFILE EX	DE,HL		;HL=>old, DE=>new
	CALL	RNAME		;rename file
POSTEE	JP	NZ,POSTE	;error, go!
	JR	RENRET		;else ok, return
;
RNAME	LD	A,2-1<4+2	;sys 2, #2
	RST	OVLAY		;do it!
;
;	Position HL to 1st significant char
;
	INC	HL		;bump pointer
POSHL	LD	A,(HL)		;fetch a char
	CP	' '             ;separator?
	JR	Z,POSHL-1	;yes, skip
	CP	','             ;sep?
	JR	Z,POSHL-1	;skip too
	RET			;else HL => significant
;
;	check if device exists
;
FINDEV	LD	A,1-1<4+5	;sys 1, #5
	RST	OVLAY		;search device table
;
;	load in SYS4
;
FETCH4	LD	A,4-1<4+0	;sys 4, #0
	RST	OVLAY		;load it!
;
ZZZZZ	EQU	$
;
	END	VECTORS
 