;LBSYSTEM/ASM - SYSTEM Command
	TITLE	<SYSTEM - LS-DOS 6.2>
;
MODPORT	EQU	0ECH
CR	EQU	13
;
*GET	SVCMAC:3		;SVC Macro equivalents
*LIST	OFF			;Get SYS0/EQU
*GET	LDOS60/EQU:2		;<631>
*GET	SYS0/EQU:2		;Xref from lowcore/sysres
*LIST	ON
;
	ORG	2400H
;
	IF	@BLD631
	JP	LSYSTEM		;<631>
NOMEM$	DB	'No memory space available',CR		;<631>
PRMERR$	DB	'Parameter error',CR			;<631>
NOCYL8$	DB	'CYL=c invalid on 8" drive',CR		;<631>
BADCYL$	DB	'Cylinder count out of range <35-96>',CR;<631>
BADSYS$	DB	'Can''t SYSRES requested module',CR	;<631>
MODRES$	DB	'System module already resident',CR	;<631>
EIPMPT	DM	'Enter DCT driver <BREAK=default> : ',3	;<631>
BADBS$	DB	'Boot step out of range <0-3>',CR	;<631>
DCTEXT	DM	'DCT'					;<631>
;
PRMTBL$	EQU	$		;<631>
	DB	'ALIVE '	;<631>
	DW	ALIVE+1		;<631>
	DB	'AMPM  '	;<631>
	DW	AMPM+1		;<631>
	DB	'BSTEP '	;<631>
	DW	BSPARM+1	;<631>
	DM	'DRIVER'	;<631>
	DW	DVRPARM+1	;<631>
	DB	'FAST  '	;<631>
	DW	FPARM+1		;<631>
	DB	'SLOW  '	;<631>
	DW	SLOW+1		;<631>
	DB	'SWAP  '	;<631>
	DW	SWAP+1		;<631>
	DB	'SYSRES'	;<631>
	DW	SYSRES+1	;<631>
	DB	'SYSTEM'	;<631>
	DW	SYSPRM+1	;<631>
	DB	'TYPE  '	;<631>
	DW	TYPE+1		;<631>
	DB	'WP    '	;<631>
	DW	WPARM+1		;<631>
	DB	'BLINK '	;<631>
	DW	BLINK+1		;<631>
	DB	'BREAK '	;<631>
	DW	BREAK+1		;<631>
	DB	'CYL   '	;<631>
	DW	CYLPRM+1	;<631>
	DB	'DATE  '	;<631>
	DW	DATE+1		;<631>
	DB	'DELAY '	;<631>
	DW	DELAY+1		;<631>
	DB	'CKDRV '	;<631>
	DW	CKDRV+1		;<631>
	DB	'DISABL'	;<631>
	DW	DISABL+1	;<631>
	DB	'DRIVE '	;<631>
	DW	DRIVE+1		;<631>
	DB	'ENABLE'	;<631>
	DW	ENABLE+1	;<631>
	DB	'GRAPHI'	;<631>
	DW	GRAPHI+1	;<631>
	DB	'LARGE '	;<631>
	DW	LARGE+1		;<631>
	DB	'RESTOR'	;<631>
	DW	RPARM+1		;<631>
	DB	'SMALL '	;<631>
	DW	SMALPRM+1	;<631>
	DB	'PRTIME'	;<631>
	DW	PRTIME+1	;<631>
	DB	'STEP  '	;<631>
	DW	STEP+1		;<631>
	DB	'TIME  '	;<631>
	DW	TIME+1		;<631>
	DB	'TRACE '	;<631>
	DW	TRACE+1		;<631>
	DB	'SMOOTH'	;<631>
	DW	SMOOTH+1	;<631>
	DB	'HERTZ5'	;<631>
	DW	HERTZ50+1	;<631>
	DB	'HERTZ6'	;<631>
	DW	HERTZ60+1	;<631>
	NOP			;<631>

LSYSTEM:LD	(LSAVESP+1),SP	;<631>Save the stack
	ELSE
SYSTEM
	ENDIF
	@@CKBRKC		;Check for <BREAK>
	IF	@BLD631
	JP	NZ,ABORT	;<631>Abort
	ELSE
	JR	Z,SYSTEM1	;Go if not
	LD	HL,-1		;  else abort
	RET
;
LSAVESP	LD	SP,$-$		;P/u original stack
	@@CKBRKC		;Clear any <BREAK>
	RET			;Ret to DOS
;
;	Internal Error Message Handling
;
NOMEM	LD	HL,NOMEM$	;"No memroy available
	DB	0DDH
PRMERR	LD	HL,PRMERR$	;"Parm error
SETERR	@@LOGOT
FRCERR	LD	HL,-1		;Set abort code
	JR	LSAVESP		;Exit
;
;	I/O Error Handler
;
IOERR	LD	L,A		;Error # to HL
	LD	H,0
	OR	0C0H		;Set brief to return
	LD	C,A
	@@ERROR			;Display the error
	JR	LSAVESP		;Exit
;
;	SYSTEM1 - Set the O/S's parameters
;
SYSTEM1
	LD	(LSAVESP+1),SP	;Save the stack
;
	ENDIF
	LD	DE,PRMTBL$	;Get parms
	@@PARAM
	JP	NZ,PRMERR	;Jump on parm error
	@@FLAGS			;Get IY = flagtab
SLOW	LD	BC,0		;Test SLOW parm
	LD	A,B
	OR	C
	JR	NZ,SETSLOW	;Jump if SLOW entered
FPARM	LD	BC,0		;P/u FAST parm
	LD	A,B
	OR	C
	JR	Z,FPEND		;Neither SLOW nor FAST?
	SET	3,(IY+'S'-'A')	;Set fast in flag
	IF	@MOD4
	SET	6,(IY+'M'-'A')	;Set bit 6 in port mask
	ENDIF
	LD	B,55H		;Init time slice byte
	JR	SETCLK		;Go set it
;
;	Turn off FAST
;
SETSLOW	RES	3,(IY+'S'-'A')	;Reset the FAST bit
	IF	@MOD4
	RES	6,(IY+'M'-'A')	;Reset bit in port mask
	ENDIF
SETCLK	LD	A,B
	LD	(TIMSL$),A	;Set 55H=fast, FFH=slow
	IF	@MOD4
	LD	A,(IY+'M'-'A')	;Update the port
	OUT	(MODPORT),A
	ENDIF
FPEND	EQU	$
;
;	Trace entry
;
TRACE	LD	BC,1		;Init to pass by
	LD	A,B
	OR	C
	JR	Z,TROFF		;Go if Trace off
	INC	A
	JR	NZ,TREND	;Go if not entered
	IF	@MOD4
	LD	DE,TRACE_INT	;Pt to trace SYSRES rtn
	ENDIF
	IF	@MOD2
	LD	DE,DO_TRACE	;Address
	ENDIF
	LD	C,7		;Init to task 7
	@@ADTSK			;Turn TRACE (ON)
	JR	TREND
TROFF	LD	C,7		;Init to task 7
	@@RMTSK			;Remove TRACE task
TREND	EQU	$
	IF	@BLD631
AMPM:	LD	BC,1		;<631>
	LD	A,B		;<631>
	OR	C		;<631>
	JR	Z,L2651		;<631>
	LD	A,B		;<631>
	AND	C		;<631>
	INC	A		;<631>
	JR	NZ,BREAK	;<631>
	RES	4,(IY+'I'-'A')	;<631>
	JR	BREAK		;<631>
L2651:	SET	4,(IY+'I'-'A')	;<631>
	ENDIF
;
;	Routine to handle BREAK
;
BREAK	LD	BC,1		;Init BREAK=ON
	LD	A,B
	OR	C
	JR	Z,BRKOFF	;Jump if BREAK=OFF
	INC	A		;Check Break=ON
	JR	NZ,BRKEND	;Go if no parm used
	RES	4,(IY+'S'-'A')	;Correct system flag
	JR	BRKEND
;
;	Disable <BREAK> key
;
BRKOFF	SET	4,(IY+'S'-'A')
BRKEND	EQU	$
;
;	Date prompt suppression during BOOT
;
PRTIME:	LD	BC,1		;Init to pass by
	IF	@BLD631
	LD	HL,@PRTIMO	;<631>DEC DE opcode in Printer driver
	LD	A,B		;<631>
	OR	C		;<631>
	JR	Z,DISTIMO	;<631>Load a NOP over DEC DE
	LD	A,B		;<631>
	AND	C		;<631>
	INC	A		;<631>
	JR	NZ,DATE		;<631>
	LD	A,1BH		;<631>DEC DE opcode (default)
DISTIMO:LD	(HL),A		;<631>
DATE:	LD	BC,1		;<631>
	ENDIF
	LD	A,B
	OR	C
	LD	B,0FFH		;Init to DATE Suppress
	JR	Z,DOFF		;Go if suppress
	INC	A
	JR	NZ,DATEND	;Go if not entered
	LD	B,A		;B=0 on no suppress
DOFF	CALL	GETCFG		;Get track 0, sector 2
	LD	A,B		;Get back the code byte
	LD	(DTPMT$&0FFH+SBUFF$),A
	CALL	PUTCFG		;Write it back
DATEND	EQU	$
;
;	Time prompt suppression during BOOT
;
TIME	LD	BC,1		;Init to pass by
	LD	A,B
	OR	C
	LD	B,0FFH		;Init to TIME Suppress
	JR	Z,TOFF		;Go if suppress
	INC	A
	JR	NZ,TIMEND	;Go if not entered
	LD	B,A		;B=0 on no suppress
TOFF	CALL	GETCFG		;Get track 0, sector 2
	LD	A,B		;Get back the code byte
	LD	(TMPMT$&0FFH+SBUFF$),A
	CALL	PUTCFG		;Write it back
TIMEND	EQU	$
;
;	BOOT Step rate adjust
;
BSPARM	LD	BC,-1		;P/u parm
	INC	B		;User entry?
	JR	Z,BSPEND	;Go if not entered
	LD	A,C		;Transfer parm
	CP	4
	JR	C,GUDBS		;Ok if < 4
	LD	HL,BADBS$	;  else bad step rate
	CALL	SETERR
	JR	BSPEND
GUDBS	LD	B,A		;Save step
	CALL	GETCFG		;Get System Info Sector
	LD	L,70H+3		;Offset to data
	LD	A,(HL)		;P/u DCT+3 parms
	AND	0FCH		;Strip off boot step
	OR	B		;Merge new
	LD	(HL),A		;Stuff back
	CALL	PUTCFG		;Write it back
BSPEND	EQU	$
;
;	BLINK parm
;
BLINK	LD	BC,1		;P/U parm
	LD	A,B
	OR	C
	DEC	A		;Specified?
	JR	Z,BLIEND	;Go if not
	INC	A
	JR	NZ,BLNKON	;Go if BLINK=ON
	SET	6,(IY+'V'-'A')	;Turn off blinking
	IF	@MOD2
	LD	A,($CRSCHAR)	;Get current char
	AND	1FH		;Keep size only
	JR	SETBLK		;Setup
	ENDIF
	IF	@MOD4
	JR	BLIEND		;Continue
	ENDIF
BLNKON	RES	6,(IY+'V'-'A')	;Turn on blinking
	CP	0FFH		;If not just BLINK,
	IF	@MOD4
	JR	NZ,SETBLK	;  set user cursor
	ENDIF
	IF	@MOD2
	JR	Z,LARGE		;Go if not
BLIADJ	SUB	7		;Force in range 0-7
	JR	NC,BLIADJ	;Go till in range
	ADD	A,7		;Add back last sub
	OR	01000000B	;Set blink enable 1/16
	JR	SETBLK		;Continue
	ENDIF
LARGE	LD	BC,0		;  else test if large,
	INC	C		;  small, or default
	IF	@MOD2
	LD	A,01000111B	;Standard cursor
	ENDIF
	IF	@MOD4
	LD	A,'_'		;Standard cursor
	ENDIF
	JR	NZ,SMALPRM
	IF	@MOD2
	LD	A,01000000B	;To large
	ENDIF
	IF	@MOD4
	LD	A,8FH		;To large
	ENDIF
SMALPRM	LD	BC,0
	INC	C
	JR	NZ,SETBLK
	IF	@MOD2
	LD	A,01000101B	;Small
	ENDIF
	IF	@MOD4
	LD	A,88H		;Small
	ENDIF
SETBLK	LD	C,A		;Xfer cursor char to C
	LD	B,8		;Cursor update function
	@@VDCTL
BLIEND	EQU	$
;
;	RESTORE parameter
;
RPARM	LD	BC,1		;P/U parm
	LD	A,B
	OR	C
	DEC	A		;Specified?
	JR	Z,REND		;Go if not
	INC	A
	JR	NZ,RSTRON	;Go if RESTORE=on
	DB	3EH		;Make LD A,n
RSTRON	XOR	A
	LD	B,A		;Save step
	CALL	GETCFG		;Get config sector
	LD	L,RSTOR$&0FFH	;Pt to RESTORE flag
	LD	(HL),B		;Stuff back
	CALL	PUTCFG		;Put it back
REND	EQU	$
;
;	Type ahead processing
;
TYPE	LD	BC,1		;P/u Type parm value
	LD	A,B
	OR	C
	DEC	A		;Was Type used?
	JR	Z,TYPEND	;Jump if TYPE not entered
	INC	A
	JR	NZ,TYPEON	;Jump if TYPE=ON
	RES	1,(IY+'D'-'A')	;Turn TYPE off
	JR	TYPEND
TYPEON	SET	1,(IY+'D'-'A')	;Turn TYPE on
TYPEND	EQU	$
;
;	Process SMOOTH
;
SMOOTH	LD	BC,1		;P/u Smooth parm value
	LD	A,B
	OR	C
	DEC	A		;Was Smooth used?
	JR	Z,SMEND		;Skip if not entered
	INC	A
	JR	NZ,SMON		;Go if Smooth=ON
	IF	@MOD4
	RES	3,(IY+'D'-'A')	;Show OFF in DFLAG$
	LD	A,00		;Set to store NOP
	LD	(FDDINT$),A	;  put it there
	ENDIF
	JR	SMEND
SMON	EQU	$
	IF	@MOD4
	SET	3,(IY+'D'-'A')	;Show ON in DFLAG$
	LD	A,0F3H		;DI opcode
	LD	(FDDINT$),A	;  put it there
	ENDIF
SMEND	EQU	$
;
;	Routine to process HERTZ selection
;
HERTZ50	LD	BC,1		;P/u H50 parm value
	LD	A,B
	OR	C
	DEC	A		;Check if parm entered
	JR	Z,HZ50END	;Go if not
	LD	A,25		;Init 25 ints/sec
	LD	(HERTZ$),A	;Put value in timer code
HZ50END	EQU	$
HERTZ60	LD	BC,1		;P/u H60 parm value
	LD	A,B
	OR	C
	DEC	A		;Check if parm entered
	JR	Z,HZ60END	;Go if not
	LD	A,30		;Init 30 ints/sec
	LD	(HERTZ$),A	;  & load it to timer
HZ60END	EQU	$
;
;	Routine to process GRAPHIC
;
GRAPHI	LD	BC,1		;Init for bypass
	LD	A,B
	OR	C
	DEC	A		;Check if parm entered
	JR	Z,GRAEND	;Go if not entered
	INC	A		;Test of GRAPHIC=off
	JR	Z,GROFF		;Go if off
	SET	7,(IY+'D'-'A')	;  else turn on
	JR	GRAEND
GROFF	RES	7,(IY+'D'-'A')	;Turn graphic off
GRAEND	EQU	$
;
;	Routine to process ALIVE
;
ALIVE	LD	BC,1		;P/u Alive parm value
	LD	A,B
	OR	C
	DEC	A		;Check if entered
	JR	Z,ALVEND	;Bypass if parm omitted
	INC	A
	JR	NZ,ALIVEON	;Jump if ALIVE=ON
	IF	@MOD2
	LD	C,6		;Slot alive
	ENDIF
	IF	@MOD4
	LD	C,3		;Slot alive
	ENDIF
	@@RMTSK			;Remove it if OFF
	JR	ALVEND
;
ALIVEON	EQU	$
	IF	@MOD2
	LD	C,6		;Slot alive
	LD	DE,DO_ALIVE	;Task address
	@@ADTSK			;Add task
	ENDIF
	IF	@MOD4
	CALL	GOTMEM?		;Is HIGH$ frozen?
	JP	C,NOMEM		;Quit if so
	CALL	GETHI$		;Get address for Alive
	LD	(ALVBGN+2),HL	;Stuff last byte used
	LD	BC,ALVEND-ALVBGN	;Get len of code
	XOR	A
	SBC	HL,BC		;Calc new HIGH$
	LD	B,0
	@@HIGH$			;Stuff new HIGH$
	INC	HL		;Point to module start
	PUSH	HL		;Save start
	LD	C,ALVTCB-ALVBGN+2
	ADD	HL,BC		;Point to alive task
	LD	(ALVTCB),HL	;  & stuff ALIVE TCB
	EX	(SP),HL		;Rcvr start of module
	EX	DE,HL		;  into DE
	LD	HL,ALVBGN
	LD	BC,ALVEND-ALVBGN
	LDIR			;Move to high memory
	POP	DE		;Rcvr start of task
	DEC	DE		;Back up to TCB
	DEC	DE
	LD	C,3		;Add as task 3
	@@ADTSK
	JR	ALVEND
	ENDIF
;
;	ALIVE high memory module
;
	IF	@MOD4
ALVBGN	JR	$
	DW	$-$
	DB	5,'ALIVE'
	DW	0,0
ALVTCB	DW	0
	LD	HL,79		;Get character at 0,79
	PUSH	HL
	LD	B,1		;Set function 1
	CALL	@VDCTL		;P/u character currently
	CP	0A3H		;  on the screen and
	LD	A,93H		;  exchange it
	JR	Z,ALIVE1
	LD	A,0A3H
ALIVE1	POP	HL
	LD	B,2		;Function to put char
	LD	C,A
	CALL	@VDCTL		;  at row,col
	RET
	ENDIF
ALVEND	EQU	$
;
;	Routine to process SYSRES
;
SYSRES	LD	BC,-1		;P/u Sysres parm value
	INC	B		;Test if parm entered
	JP	Z,RESEND	;Go if not
	CALL	GOTMEM?		;Is high memory available
	JP	C,NOMEM		;Quit if not
	LD	A,C		;Get module to reside
	OR	A
	JR	Z,BADSYS	;Cannot sysres 0
	CP	2		;Check if it is SYS2
	JR	NZ,TEST6	;Go if not
	LD	HL,DCT$+4	;Point to SYSTEM DCT
	RES	7,(HL)		;  & allow CKDRV now
TEST6	CP	6
	JR	C,GUDSYS	;Can sysres 1-5
	CP	9
	JR	C,BADSYS	;Cannot sysres 6-8
	CP	13
	JR	NC,BADSYS	;Nothing > 12 yet
GUDSYS	PUSH	AF		;Save sysres req
	LD	HL,HKRES$+1	;Check if the driver
	LD	E,(HL)		;  is already resident
	INC	HL
	LD	D,(HL)
	LD	HL,CKMOD@	;Standard address
	OR	A		;Reset carry
	SBC	HL,DE		;No driver if =
	JR	Z,PUTDVR	;Go and install driver
	LD	HL,-32		;Find restab$ pos
	ADD	HL,DE		;Pt to vector table
	RLCA			;Request x 2
	ADD	A,L
	LD	L,A
	JR	NC,$+3
	INC	H		;RESTAB$ + entry index
	INC	HL		;Pt to hi order
	LD	A,(HL)		;P/u hi order
	OR	A
	JR	Z,MOVITIN	;Go if not there
	LD	HL,MODRES$	;  else show already res'ed
	DB	0DDH
BADSYS	LD	HL,BADSYS$
	CALL	SETERR		;Log & Set error
	POP	AF
	JP	GETSEC2
RES1	JR	$		;No real entry
	DW	$-$		;Last used
	DB	4,'SYS '
	DW	0,0
RES1E	EQU	$-1
MOVITIN	LD	(OVRLY$),A	;Show no overlay res
	POP	AF		;Rcvr requested SYS
	PUSH	AF
	ADD	A,2		;Adjust for dec
	OR	80H		;Set Sys request
	PUSH	HL		;Save restab$ addr
	CALL	CKMOD@		;Load SYSn, no exec
	CALL	GETHI$		;P/u HIGH$
	LD	(RES1+2),HL	;Save in header
	EX	DE,HL
	LD	BC,(MAXCOR$-2)	;P/u length of SYSx
	LD	HL,1E00H	;Pt to start of overlay
	ADD	HL,BC
	DEC	HL		;Point to last byte
	PUSH	BC		;Save length
	LDDR
	POP	BC		;Rcvr length of SYSx
	LD	A,B		;  & stuff in front
	LD	(DE),A		;  of SYSRESed module
	DEC	DE
	LD	A,C
	LD	(DE),A
	POP	HL		;Rcvr RESTAB ptr
	LD	(HL),D		;Save hi order addr
	DEC	HL
	LD	(HL),E		;Save low order addr
	POP	AF		;Rcvr module requested
	CP	10		;Convert to ASCII
	JR	C,$+4
	ADD	A,7
	ADD	A,'0'
	LD	HL,RES1+8
	LD	(HL),A		;Stuff module name
	DEC	DE		;Pt to 1st free byte
				;  & move in the
	LD	BC,13		;  linkage protocol
	LD	HL,RES1E
	LDDR
	EX	DE,HL
	@@HIGH$			;Stuff new HIGH$ (B=0)
	JP	RESEND
;
PUTDVR	CALL	GETHI$		;P/u high mem
	LD	(RESBGN+2),HL	;Stuff last used
	LD	BC,RESEND-RESBGN
	SBC	HL,BC		;Make space for driver
	LD	B,0
	@@HIGH$			;Stuff new value
	PUSH	HL		;Save new HIGH$
	LD	DE,13		;Pt to RESTAB$-3
	ADD	HL,DE
	LD	(RESD1+1),HL	;Stuff ptr to RESTAB$-3
	POP	HL
	INC	HL		;Resbgn
	PUSH	HL
	EX	DE,HL		;Where it goes to DE
	LD	HL,RESBGN	;Where it's now
	LDIR			;Move up to high
	POP	HL		;Rcvr where it got to
	LD	DE,32+RESTAB$-RESBGN	;Index start of dvr
	ADD	HL,DE		;Pt to driver entry
	LD	(HKRES$+1),HL	;Hook into SYS0
	POP	AF		;Rcvr code & loop
	JP	GUDSYS		;  to get the request
;
RESBGN	JR	$		;No real entry
	DW	$-$
	DB	6,'SYSRES'
	DW	0,0
RESTAB$	DW	1,0,0,0,0,0,1,1
	DW	0,0,0,0,0,0,0,0
;
RESDVR	PUSH	HL
	PUSH	AF		;Save SYS needed
	LD	HL,OVRLY$	;Check if already in
	XOR	(HL)		;  overlay area
	AND	0FH		;Strip garbage
	JR	Z,NOTRES
	POP	AF
RESD1	LD	HL,RESTAB$+1	;P/u table ptr
	PUSH	AF
	AND	0FH		;Check if in high mem
	RLCA			;X 2
	ADD	A,L
	LD	L,A
	JR	NC,$+3
	INC	H
	LD	A,(HL)		;P/u hi order
	OR	A
	JR	Z,NOTRES	;Go if not in high
	DEC	HL		;Pt to low
	LD	L,(HL)		;P/u lo order vector
	LD	H,A		;Xfer hi order
	PUSH	DE		;Save these regs
	PUSH	BC
	LD	C,(HL)		;P/u module length
	INC	HL		;  into BC
	LD	B,(HL)
	INC	HL		;Point to module start
	LD	DE,1E00H	;Point to overlay region
	LD	(HKRES$+9),DE	;Upd TRAADR
	PUSH	BC		;Save the length
	LDIR
	POP	HL		;Rcvr the length
	LD	(MAXCOR$-2),HL	;Stuff pointer
	POP	BC		;Restore regs
	POP	DE
	POP	AF
	LD	(HKRES$+4),A	;Show its resident
	POP	HL		;  in tempy loc'n
	RET
NOTRES	POP	AF
	POP	HL
	JP	CKMOD@
RESEND	EQU	$
;
;	Routine to process DRIVE parameter
;
GETSEC2	LD	A,(CYLPRM+1)	;If CYL=c entered,
	OR	A		;  get config sector
	CALL	NZ,GETCFG
DRIVE	LD	BC,-1
	LD	IX,SBUFF$+70H	;Pt to DCT sector fields
	LD	IY,DCT$		;Init to do all DCT$'s *
	INC	B
	JR	Z,CKEI		;Go if Drive not entered
	LD	A,C
	CP	8		;Drive in range?
	JP	NC,PRMERR	;Go if > 7
	@@GTDCT			;Get its DCT
	PUSH	IY		;Save the DCT address
CKEI	EQU	$
;
ADJEI	PUSH	IY		;Calc IY offset into
	POP	HL		;  DCTs to adjust IX
	LD	DE,-DCT$	;  without affecting IY
	ADD	HL,DE
	EX	DE,HL
	ADD	IX,DE
DRVLOOP	EQU	$
;
;	Routine to process WP parameter
;
WPARM	LD	BC,1		;P/u WP parm value
	LD	A,B
	OR	C
	DEC	A		;Check if entered
	JR	Z,WPEND		;  and go if not
	INC	A
	JR	Z,WPOFF		;Go if OFF
WPON	SET	7,(IY+3)	;Turn on write protect
	JR	WPEND
WPOFF	RES	7,(IY+3)	;Turn off write protect
WPEND	EQU	$
;
;	Routine to process CYL parameter
;
CYLPRM	LD	BC,0		;P/u Cyl parm value
	LD	A,B
	OR	C
	JR	Z,CYLEND	;Go if parm not entered
	BIT	5,(IX+3)	;If drive is 8",
	JR	Z,CYL1		;  can't do it
	LD	A,(DRIVE+1)	;If drive entered,
	OR	A		;  give error msg
	LD	HL,NOCYL8$	;'Can't CYL on 8" drive '
	CALL	NZ,SETERR	;Msg if DRIVE=d
	JR	DISABL
CYL1	LD	A,C		;P/u user entry
	DEC	A
	CP	34		;Not < 35 allowed
	JR	C,BADCYL	;Go if bad
	CP	96		;Max for 5-1/4" floppy
	JR	C,GUDCYL	;Good if < 96
BADCYL	LD	HL,BADCYL$	;"Cyl out of range
	CALL	SETERR		;Dsply and quit
	XOR	A
	LD	(CYLPRM+1),A
	JR	DISABL
GUDCYL	LD	(IX+6),A	;Stuff default DCT
CYLEND	EQU	$
;
;	Routine to process DISABL parameter
;
DISABL	LD	BC,0		;P/u parm value
	LD	A,B
	OR	C
	JR	Z,ENABLE	;Go if not DISABLE
	LD	A,(DRIVE+1)	;Don't permit disable
	INC	A		;  if DRIVE parm not
	JR	Z,STEP		;  entered
	LD	A,0C9H		;Init disable byte
	JR	ENADIS
ENABLE	LD	BC,0		;P/u parm value
	LD	A,B
	OR	C
	JR	Z,STEP		;Go if not ENABLE
	LD	A,0C3H		;Init enable byte
ENADIS	LD	(IY),A		;Stuff Ena or Dis byte
;
;	Routine to process STEP parameter
;
STEP	LD	BC,-1		;P/u Step parm value
	INC	B
	JR	Z,STEPEND	;Go if STEP not entered
	LD	A,C
	CP	4		;Step must be < 4
	JP	NC,PRMERR	;Quit if out of range
	BIT	4,(IY+4)	;Alien controller?
	JR	NZ,WDESD	;Bypass if alien
	LD	A,(IY+3)	;P/u DCT byte and
	AND	0FCH		;  mask out old step
	OR	C		;Or in the new value
	LD	(IY+3),A	;  and put back in DCT
STEPEND	EQU	$
;
;	Routine to process DELAY parameter
;
DELAY	LD	BC,1		;P/u the parm value
	LD	A,B
	OR	C
	DEC	A		;Check if entered
	JR	Z,CKDRV		;Go if no delay entered
	INC	A		;Check if OFF
	LD	B,0		;Init delay=on
	JR	NZ,DELAY1	;Go if ON
	LD	B,4		;Init delay=off
DELAY1	LD	A,(IY+3)	;Update delay
	AND	0FBH		;  in DCT
	OR	B
	LD	(IY+3),A
;
;	Routine to process CKDRV parameter
;
CKDRV	LD	BC,1		;P/u Ckdrv parm value
	LD	A,B
	OR	C
	DEC	A		;Check if entered
	JR	Z,WDESD		;Go if not entered
	INC	A		;See if OFF or ON
	LD	B,0		;Init ckdrv=on
	JR	NZ,CKDRV1	;Go if ON
	LD	B,80H		;Set bit 7, ckdrv off
CKDRV1	LD	A,(IY+4)	;Update ckdrv bit
	AND	7FH		;  by removing old state,
	OR	B		;  merging 0 or 80H
	LD	(IY+4),A	;  and putting back in DCT
WDESD	LD	A,(DRIVE+1)	;Drive parm used prev ?
	INC	A
	JR	NZ,PUTSEC2	;Go if DRIVE entered
	LD	DE,10		;  else loop thru all DCTs
	ADD	IX,DE		;Advance to next DCT
	ADD	IY,DE
	PUSH	IY
	POP	HL		;Xfer DCT start to HL
	LD	A,L		;Ck on end of DCTs
	CP	80+70H		;Offset is 70H
	JP	C,DRVLOOP	;Loop until done
	LD	HL,0		;Show no DCT given
	PUSH	HL
PUTSEC2	LD	A,(CYLPRM+1)	;If CYL=c entered
	OR	A		;  put config sector
	CALL	NZ,PUTCFG
;
;	Routine to process DRIVER parameter
;
DVRPARM	LD	DE,0		;P/u parm value
	LD	A,D
	OR	E
	JP	Z,DVR4		;Go if DRIVER not entered
	INC	A		;Full name given?
	JR	Z,GETN3		;Go if not & prompt
	LD	HL,FCB1+1	;  else pick it up
	PUSH	HL		;Save ptr to start
GETN1	LD	A,(DE)		;P/u name char
	CP	CR
	JR	Z,GETN2		;Exit on eol
	CP	','
	JR	Z,GETN2		;Exit on end of parm
	CP	'"'
	JR	Z,GETN2		;Exit on closing quote
	CP	')'
	JR	Z,GETN2		;Exit on end of parms
	CP	3
	JR	Z,GETN2		;Exit on JCL line end
	LD	(HL),A		;  else xfer the char
	INC	DE
	INC	HL
	JR	GETN1		;Loop
GETN2	LD	(HL),CR		;End with CR
	POP	HL		;Recover name ptr
	JR	DVR2
GETN3	@@DSPLY	EIPMPT		;"Enter dct dvr name
	LD	HL,FCB1+1	;Pt to buffer
	LD	BC,24<8		;24 char max
	@@KEYIN			;Get filespec
	JR	NC,DVR2		;Go if not BREAK
;
;	BREAK entered on DRIVER request
;	Reset all drive code table positions
;	if DRIVE not entered
;
	CALL	GETCFG		;Get SIS
	LD	HL,SBUFF$+70H-DCT$	;Pt to tables "offset"
DDCT1	LD	A,(DRIVE+1)	;Was Drive entered?
	INC	A
	POP	DE		;Rcvr drive #
	JR	NZ,DDCT2
	LD	DE,DCT$		;Else use all 8
DDCT2	ADD	HL,DE		;Index the specific DCT
DVRA	LD	A,E
	CP	40+70H
	LD	A,0C9H		;Disable drives 4-7
	JR	NC,DVRB
	LD	A,0C3H
DVRB	LD	(HL),A		;Stuff vector (JP/RET)
	INC	L		;Pt to default DCT+3
	INC	L
	INC	L
	INC	E		;Pt to resident DCT+3
	INC	E
	INC	E
	LD	BC,7		;Shift defaults to
	LDIR			;  resident DCT
DVRC	LD	A,(DRIVE+1)	;Test if drive entered
	INC	A
	IF	@BLD631
	JR	NZ,SYSPRM$	;<631>
	ELSE
	JR	NZ,SYSPRM	;Go if yes
	ENDIF
	LD	A,E		;Ck on end of DCTs
	CP	80+70H
	JR	NC,DVRA		;Loop until all 8
	IF	@BLD631
SYSPRM$:JP	SYSPRM		;<631>
	ELSE
	JR	SYSPRM
	ENDIF
DVR2	LD	A,(HL)		;Is first char <ENTER>?
	CP	CR
	JR	Z,DVR4		;Bypass if default
	CALL	GOTMEM?
	POP	DE		;Pop to keep stack
	JP	C,NOMEM		;  straight if error
	PUSH	DE
	LD	DE,FCB1		;Else fetch spec
	@@FSPEC
	LD	HL,DCTEXT	;Use /DCT as the
	@@FEXT			;  default extension
	@@FLAGS
	SET	2,(IY+'S'-'A')	;Set RUN bit
	@@LOAD			;Load the prog
	POP	DE		;Recover drive table
	JP	NZ,IOERR	;Quit on load error
	PUSH	DE
	PUSH	HL		;Save prog's traadr
	LD	HL,DVR4		;Pt to our return
	EX	(SP),HL		;Exch with his
	SET	3,(IY+'C'-'A')	;Set system request
	JP	(HL)		;Go to prog
	IF	@BLD631
ABORT:	LD	HL,0FFFFH	;<631>
;
LSAVESP	LD	SP,$-$		;<631>P/u original stack
	@@CKBRKC		;<631>Clear any <BREAK>
	RET			;<631>Ret to DOS
;
;	Internal Error Message Handling
;
MANABT:	LD	HL,MANABT$	;<631>
	DB	0DDH		;<631>
JCLON:	LD	HL,JCLON$	;<631>
	DB	0DDH		;<631>
SPCERR:	LD	HL,SPCERR$	;<631>
	DB	0DDH		;<631>
SAMDRV:	LD	HL,SAMDRV$	;<631>
	DB	0DDH		;<631>
NOMEM	LD	HL,NOMEM$	;<631>"No memory available
	DB	0DDH		;<631>
PRMERR:	LD	HL,PRMERR$	;<631>
SETERR	@@LOGOT			;<631>
	JR	ABORT		;<631>Exit
;
;	I/O Error Handler
;
IOERR	LD	L,A		;<631>Error # to HL
	LD	H,0		;<631>
	OR	0C0H		;<631>Set brief to return
	LD	C,A		;<631>
	@@ERROR			;<631>Display the error
	JR	LSAVESP		;<631>Exit
	ENDIF
DVR4	POP	DE		;Rcvr drive table
;
;	System = new system drive
;
SYSPRM	LD	BC,-1		;P/u parm value
	LD	A,B
	IF	@BLD631
	AND	C		;<631>
	INC	A		;<631>
	JR	Z,SWAP		;<631>
	LD	(SWAP$),BC	;<631>
	LD	HL,0		;<631>
	LD	(DRIVE+1),HL	;<631>
SWAP$:	EQU	$+1
SWAP:	LD	BC,0FFFFH	;<631>
	LD	A,B		;<631>
	AND	C		;<631>
	INC	A		;<631>
	JR	Z,L2B7D		;<631>
	LD	A,C		;<631>
	CP	8		;<631>
	JP	NC,SPCERR	;<631>
	LD	(L2B48),A	;<631>
	LD	HL,L2B58	;<631>
	OR	A		;<631>
	JR	Z,L2B22		;<631>
	LD	(HL),A		;<631>
	LD	HL,L2B48	;<631>
L2B22:	ADD	A,30H		;<631>
	LD	(SRCDRV$),A	;<631>
	LD	A,(DRIVE+1)	;<631>
	CP	8		;<631>
	JP	NC,SPCERR	;<631>
	LD	(HL),A		;<631>
	ADD	A,'0'		;<631>
	LD	(DSTDRV$),A	;<631>
	LD	A,(HL)		;<631>
	XOR	C		;<631>
	JP	Z,SAMDRV	;<631>
L2B3A:	LD	A,(L2B48)	;<631>
	OR	A		;<631>
	LD	A,(L2B58)	;<631>
	CALL	Z,L2BA3		;<631>
	CALL	L2B81		;<631>
L2B48:	EQU	$+1		;<631>
	LD	C,0		;<631>
	@@GTDCT			;<631>
	BIT	7,(IY+4)	;<631>
	RES	7,(IY+4)	;<631>
	PUSH	AF		;<631>
	PUSH	IY		;<631>
L2B58:	EQU	$+1		;<631>
	LD	C,0		;<631>
	@@GTDCT			;<631>
	POP	HL		;<631>
	POP	AF		;<631>
	RES	7,(IY+4)	;<631>
	JR	Z,L2B68		;<631>
	SET	7,(IY+4)	;<631>
L2B68:	PUSH	IY		;<631>
	POP	DE		;<631>
L2B6C:	EQU	$+1		;<631>
	LD	BC,000AH	;<631>
L2B6E:	LD	A,(DE)		;<631>
	LDI			;<631>
	DEC	HL		;<631>
	LD	(HL),A		;<631>
	INC	HL		;<631>
	JP	PE,L2B6E	;<631>
	LD	HL,ARESWP$	;<631>
	@@DSPLY			;<631>
L2B7D:	LD	HL,0		;<631>
	RET			;<631>

L2B81:	LD	HL,SFLAG$	;<631>
	BIT	5,(HL)		;<631>
	RET	Z		;<631>
	LD	HL,JFCB$+6	;<631>
	LD	A,(L2B48)	;<631>
	LD	B,A		;<631>
	XOR	(HL)		;<631>
	AND	07H		;<731>
	LD	A,(L2B58)	;<631>
	JR	NZ,L2B9D	;<631>
	LD	B,A		;<631>
L2B97:	LD	A,(HL)		;<631>
	AND	0F8H		;<631>
	OR	B		;<631>
	LD	(HL),A		;<631>
	RET			;<631>

L2B9D:	XOR	(HL)		;<631>
	AND	07H		;<631>
	JR	Z,L2B97		;<631>
	RET			;<631>

L2BA3:	LD	(L2BAC),A	;<631>
	ADD	A,'0'		;<631>
	LD	(NDRIVE$),A	;<631>
	ELSE
	JP	PATCH1		;Set HL=0, no abort if exit
;
CONT1	DEC	A
	CP	8		;Drive in range?
	JP	NC,PRMERR	;Go if > 7
	ENDIF
	IF	@BLD631
L2BAC:	EQU	$+1
L2BAB:	LD	C,0		;<631>
	ENDIF
;
;	Check on diskette in place
;
	@@CKDRV
	JR	NZ,SYSP2	;Prompt if no diskette
	@@GTDCT			;Get its DCT
;
;	Perform minimal check for SYSTEM disk
;
SYSP1	LD	D,(IY+9)	;P/u the dir cyl
	LD	HL,SBUFF$
	LD	E,L		;Init for GAT read
	@@RDSSC			;Read the sector
	JP	NZ,IOERR	;Quit on read error
	LD	L,0CDH		;Check the SYSTEM bit
	BIT	7,(HL)
	JR	NZ,SYSP2	;Not system? Go prompt
	LD	HL,SBUFF$	;Point to buffer
	LD	E,5		;Point to dir sec #5
	@@RDSSC			;Read the sector
	LD	A,(HL)		;P/u the byte
	AND	01010000B	;Check for a system file
	CP	01010000B	;  and not killed
				;  in this slot, (SYS1)
	IF	@BLD631
	RET	Z		;<631>
SYSP2:	LD	HL,SFLAG$	;<631>
	BIT	5,(HL)		;<631>
	JP	NZ,JCLON	;<631>
	LD	HL,NDSYS$	;<631>
	@@DSPLY			;<631>
	LD	HL,FCB1		;<631>
	LD	BC,0		;<631>
	@@KEYIN			;<631>
	JR	NC,L2BAB	;<631>
	JP	MANABT		;<631>
	ELSE
	JR	Z,SYSP3		;Alive and a SYS file
;
;	Diskette is not a SYSTEM diskette
;
SYSP2	LD	A,C		;Stuff drive # in msg
	ADD	A,'0'		;Cvrt drive to ASCII
	LD	(NDRIVE$),A
	@@DSPLY	NDSYS$		;"Need system diskette..
	LD	HL,FCB1		;Create response buffer
	LD	BC,0<8		;Only  BREAK or ENTER
	@@KEYIN			;Wait for entry
	RET	C		;Exit on <BREAK>
	JR	SYSPRM		;Continue to check
;
SYSP3	LD	HL,DCT$+4
	BIT	7,(HL)		;Check Ckdrv bit in DCT
	RES	7,(HL)		;Enable it for now
	LD	HL,DCT$
	LD	DE,FCB1		;Use FCB space
	PUSH	DE		;Save where temp
	PUSH	HL		;Save where new SYSTEM
	LD	BC,10		;Save current SYS's DCT
	LDIR
	RES	7,(IY+4)	;Make sure OFF
	JR	Z,NOSET		;Only set if it was set
				;  on the SYSTEM drive
	SET	7,(IY+4)	;CKDRV inhibit drive 0
NOSET	PUSH	IY		;New DCT to HL
	POP	HL
	POP	DE		;Rcvr SYS DCT now
	PUSH	HL		;Save where it goes
	LD	C,10
	LDIR			;New DCT into SYSTEM
	POP	DE		;P/u where old SYS goes
	POP	HL		;P/u temp address
	LD	C,10		;Move old SYS to new DCT
	LDIR
	LD	HL,NWSYS$	;"New sys drive installed
	JP	SETERR		;Display and exit w/abort
				;  in case JCL active
	ENDIF
;
;	Routines to read/write the config sector
;
PUTCFG	LD	A,53		;@WRSEC
;
	IF	@MOD4
	DB	21H		;Ignore next with LD HL,
	ENDIF
	IF	@MOD2
	JR	PUTGETC		;Jump over if mod2
	ENDIF
;
GETCFG	EQU	$
	IF	@MOD4
	LD	A,49		;@RDSEC
	LD	DE,0<8+2	;Config sector
	ENDIF
;
	IF	@MOD2
	LD	A,(DCT$+3)	;Drive 0 dct data
	AND	28H		;Bit 5/3
	CP	20H		;8" floppy?
	JR	NZ,SETSYS1	;Go if not
	LD	A,(DCT$+4)	;Get data
	AND	50H		;Bit 6/4
	CP	40H		;DD not alien?
	JR	NZ,SETSYS1	;Go if not
;
	LD	HL,SBUFF$	;System buffer
	LD	A,(DCT$+9)	;Get dir cylinder
	LD	D,A		;Pass to D
	LD	E,0		;Init sector 0
	LD	C,E		;Init drive 0
	@@RDSSC			;Read directory
	JR	NZ,PUTGETE	;Go on disk error
	LD	A,(SBUFF$+0CDH)	;Get gat data byte
	BIT	7,A		;Is data disk?
SETSYS1	LD	DE,0<8+2	;Init sysinfo sector
	JR	NZ,$+3		;Go if data disk
	INC	D		;Else new sysinfo
	LD	A,49		;Init RDSEC
	ENDIF
;
PUTGETC	LD	HL,SBUFF$	;System buffer
	IF	@BLD631
	LD	C,L		;<631>
	ELSE
	LD	C,0		;  in system drive
	ENDIF
	RST	40		;Read or Write
	RET	Z		;Back if good i/o
PUTGETE	POP	HL
	JP	IOERR		;  else abort
;
;	Routine to get HIGH$
;
GETHI$	LD	B,0		;Init to get HIGH$
	LD	H,B
	LD	L,B
	@@HIGH$			;Get current HIGH$
	RET
;
;	Routine to test if HIGH$ is frozen
;
GOTMEM?	LD	A,(CFLAG$)	;Check if memory can
	RRCA			;  be altered
	RET
;
	IF	@BLD631
JCLON$:	DB	'Can''t prompt for SYSTEM disk during JCL!',CR	;<631>
NDSYS$:	DB	'Insert SYSTEM diskette in drive '	;<631>
NDRIVE$:DB	'X ',CR					;<631>
ARESWP$:DB	'Drives :'				;<631>
SRCDRV$:DB	'S and :'				;<631>
DSTDRV$:DB	'D now swapped',CR			;<631>
SAMDRV$:DB	'Source & Destination are the same drive!',CR	;<631>
SPCERR$:DB	'Drive specification error <0-7>!',CR	;<631>
MANABT$:DB	'Manual <BREAK> abort!',CR		;<631>
	ELSE
NOMEM$	DB	'No memory space available',CR
PRMERR$	DB	'Parameter error',CR
NOCYL8$	DB	'CYL=c invalid on 8" drive',CR
BADCYL$	DB	'Cylinder count out of range <35-96>',CR
BADSYS$	DB	'Can''t SYSRES requested module',CR
MODRES$	DB	'System module already resident',CR
EIPMPT	DM	'Enter DCT driver <BREAK=default> : ',3
NWSYS$	DB	'New SYSTEM drive installed',CR
NDSYS$	DB	'Insert SYSTEM diskette in drive X ',CR
BADBS$	DB	'Boot step out of range <0-3>',CR
DCTEXT	DM	'DCT'
;
PRMTBL$	EQU	$
	DB	'ALIVE '
	DW	ALIVE+1
	DB	'BSTEP '
	DW	BSPARM+1
	DM	'DRIVER'
	DW	DVRPARM+1
	DB	'FAST  '
	DW	FPARM+1
	DB	'SLOW  '
	DW	SLOW+1
	DB	'SYSRES'
	DW	SYSRES+1
	DB	'SYSTEM'
	DW	SYSPRM+1
	DB	'TYPE  '
	DW	TYPE+1
	DB	'WP    '
	DW	WPARM+1
	DB	'BLINK '
	DW	BLINK+1
	DB	'BREAK '
	DW	BREAK+1
	DB	'CYL   '
	DW	CYLPRM+1
	DB	'DATE  '
	DW	DATE+1
	DB	'DELAY '
	DW	DELAY+1
	DB	'CKDRV '
	DW	CKDRV+1
	DB	'DISABL'
	DW	DISABL+1
	DB	'DRIVE '
	DW	DRIVE+1
	DB	'ENABLE'
	DW	ENABLE+1
	DB	'GRAPHI'
	DW	GRAPHI+1
	DB	'LARGE '
	DW	LARGE+1
	DB	'RESTOR'
	DW	RPARM+1
	DB	'SMALL '
	DW	SMALPRM+1
	DB	'STEP  '
	DW	STEP+1
	DB	'TIME  '
	DW	TIME+1
	DB	'TRACE '
	DW	TRACE+1
	DB	'SMOOTH'
	DW	SMOOTH+1
	DB	'HERTZ5'
	DW	HERTZ50+1
	DB	'HERTZ6'
	DW	HERTZ60+1
	NOP
	ENDIF
;
	IF	@BLD631
	DC	32,'S'		;<631>Patch space (Roys special edition?)
	ELSE
PATCH1	LD	HL,0		;Set HL=0 "NO ERRORS"
	OR	C
	INC	A		;Parm entered?
	RET	Z		;Exit if not
	JP	CONT1		;Continue on now
;
	DC	16,0		;Patch space
	ENDIF
FCB1	DC	32,0
;
	END	LSYSTEM
