;SYS11/ASM - LS-DOS 6.2
*MOD
	TITLE	<SYS11 - LS-DOS 6.2>
;
LF	EQU	10
CR	EQU	13
*LIST	OFF			;Get SYS0/EQU
*GET	SYS0/EQU:2		;Xref from lowcore/sysres
*LIST	ON
*GET	COPYCOM:3		;Copyright message
;
	ORG	1E00H
;
SYS11	AND	70H
	RET	Z		;Back on zero entry
	PUSH	HL
	LD	HL,KFLAG$	;Reset the <ENTER>
	RES	2,(HL)		;  bit every time
	POP	HL
	CP	20H		;New @EXIT?
	JR	Z,NEWEXIT
	CP	40H		;New keyboard request
	JP	Z,KEYREQ	;  after input of a line?
	CP	50H		;//INPUT followup
	JP	Z,GETKEY
	CP	10H		;Initial entry to DO?
	RET	NZ
;
;	<DO> initialization of sysres hooks
;
	DI			;Clock off for now
	LD	HL,KFLAG$	;Reset break bit only on
	RES	0,(HL)		;  initial entry
	LD	HL,SFLAG$
	BIT	5,(HL)		;If DO already in effect
	SET	5,(HL)		;  don't rehook
	JR	NZ,IPLDO1
	LD	A,0ADH		;Change @EXIT,@ABORT to use
	LD	(@EXIT+1),A	;  SYS11 rather than SYS1
IPLDO1	LD	SP,STACK$
	EI			;Clock back on
	LD	DE,JFCB$	;At end of SYSTEM/JCL?
	CALL	@CKEOF
	JP	NZ,@ERROR
	LD	DE,IPLDO2	;Init JCLCB$
	LD	(JCLCB$+1),DE
	CALL	GETLINE		;Get a line from the file
	LD	DE,@DOKEY	;Change vector to SYS11,
	LD	(JCLCB$+1),DE	;  entry 4
	JR	$?1		;Go interpret it
IPLDO2	LD	DE,JFCB$	;JCLCB$ input routine
	JP	@GET
;
;	New @EXIT processing
;
NEWEXIT	LD	SP,STACK$	;Reset the stack
	EI
	LD	A,H		;Ck for error return
	OR	L
	JR	NZ,ABORT
	LD	HL,SFLAG$
	BIT	4,(HL)		;BREAK key disabled?
	JR	NZ,NEWEX1
	CALL	@CKBRKC		;Check on <BREAK>
	JR	NZ,ABORT
NEWEX1	LD	DE,JFCB$	;Exit if end of JCL
	CALL	@CKEOF
	JR	NZ,EXIT
	CALL	GETLINE		;Grab a JCL line
$?1	JP	@CMNDI
GETLINE	LD	HL,INBUF$	;Pt to line buffer
	LD	BC,79<8		;Max 79 chars
	JP	@KEYIN
;
;	New ABORT processor
;
ABORT	LD	HL,ABORT$	;"Job abort...
	LD	DE,@ABORT
	JR	EXIT1
;
;	Scan for ENTER or BREAK
;
KSCN	LD	A,(SFLAG$)	;Only test BREAK if
	BIT	4,A		;  BREAK key enabled
	LD	A,(KFLAG$)
	JR	NZ,KSCN1
	BIT	0,A		;BREAK detected?
	JR	NZ,ABORT
KSCN1	BIT	2,A		;Test <ENTER>
	RET	Z		;Back if not
KSCN2	CALL	@KBD		;Clear the type ahead
	JR	Z,KSCN2
	LD	HL,KFLAG$	;Reset the ENTER bit
	RES	2,(HL)
	PUSH	BC
	LD	B,3000<-8
	CALL	@PAUSE
	POP	BC
	LD	A,(HL)		;Don't return until clear
	AND	4
	XOR	4
	JR	Z,KSCN2
	RET
;
;	Continuation of EXIT processing
;
EXIT	LD	HL,JOBDUN$	;"Job done...
	LD	DE,@EXIT
EXIT1	PUSH	DE
	CALL	@LOGOT		;Log & fall thru
;
;	Turn off the DO processor
;
DOOFF	EQU	$
	DI
	LD	HL,SFLAG$	;Reset <DO> flag
	RES	5,(HL)
	XOR	A
	LD	(JFCB$),A	;Show fcb is closed
	LD	H,A		;Set = 0 for @EXIT
	LD	L,A
	LD	DE,KIDCB$	;Clear any type ahead
	LD	A,3
	CALL	@CTL		;  buffer (no streaming)
	LD	A,93H		;Restore @EXIT SVC
	LD	(@EXIT+1),A	;  back to SYS1
	RET
;
;	Keyboard request processor
;
KEYREQ	LD	HL,10		;Back stack up 5 words
	ADD	HL,SP		;SYS0,RET,DE,HL,IX,BC
	LD	C,(HL)		;Get contents of BC
	INC	HL		;  prior to keyboard
	LD	B,(HL)		;  request & DRIVER save
;
;	@KEYIN is requesting an entire line
;
KEYLINE	LD	DE,JFCB$	;Ck on end of JCL file
	PUSH	BC
	CALL	@CKEOF
	POP	BC
	JR	NZ,EXIT
	LD	A,B		;Do we need to re-read
	CP	C		;  the JCL sector?
	JP	NZ,@GET
	CALL	@RREAD		;Get the sector back
	JP	NZ,@ERROR
	CALL	@GET
	OR	A
	JR	Z,EXIT
	CP	'/'		;Is this line execution
	JR	Z,GOTSLSH	;  JCL code to parse?
	CP	A		;Set Z-flag
	RET
;
;	Found an execution code line
;
GOTSLSH	PUSH	BC
	PUSH	DE
	IF	@BLD631G
	LD	B,80		;<631G>Only 79+CR char line
	ELSE
	LD	B,79		;Only 79 char line
	ENDIF
	LD	HL,INBUF$	;Get rest of line
	PUSH	HL		;  into JCL buffer
GOTSL1	LD	(HL),A		;Compare for CR as end
	INC	HL		;  of line
	CP	CR
	JR	Z,GOTSL2
	CALL	@GET		;Get a character
	DJNZ	GOTSL1		;  up to 79 max
	JR	BADJCL		;Line too long
GOTSL2	POP	HL		;Rcvr pointer to buf
	PUSH	HL
	INC	HL		;Pt to 2nd char
	LD	A,(HL)
	CP	'/'		;Found a //?
	JR	NZ,REKEY2
	INC	HL		;Ck on ///
	SUB	(HL)
	JP	Z,KEYIN6	;Jump if ///
	SUB	0F6H
	JP	NC,KEYIN5	;Jump if 3rd char is 0-9
	EX	(SP),HL		;P/u start of command
	CALL	@LOGER		;  line & log it
	EX	(SP),HL
GOTSL3	LD	A,(HL)		;Was char ENTER?
	CP	CR
	JR	Z,REKEY2
	CP	' '		;Ignore leading spaces
	INC	HL
	JR	Z,GOTSL3
	DEC	HL
	LD	DE,LILBUF	;Put possible parm -> buf
	LD	B,5		;Max length of parm
	CALL	PARSER		;Parse parm
	JR	NZ,REKEY2
	LD	DE,LILBUF
	LD	BC,PARMTBL	;Is the parm a macro?
	CALL	FNDPARM
	JR	NZ,REKEY2	;Bypass if not in tbl
	PUSH	DE		;Stack routine's entry
	RET			;  & go to it
REKEY1	POP	BC
REKEY2	POP	HL
	POP	DE
	POP	BC
	JR	KEYLINE
BADJCL	LD	HL,BADJCL$	;"invalid JCL...
	JP	ABORT+3
;
;	Process //STOP
;
STOP	CALL	DOOFF		;Turn off DO proc
	POP	HL
	POP	DE
	POP	BC
	EI
	JP	@KEY		;Go back to keyboard
;
;	Process //DELAY
;
DELAY	EX	(SP),HL		;Pt to //delay  line
	CALL	@DSPLY		;  and display it
	EX	(SP),HL
	CALL	@DECHEX		;Cvrt entry to binary
	LD	B,C		;Set count
DELAY1	CALL	SILEN1		;Delay a bit
	DJNZ	DELAY1
	JR	REKEY2
;
;	Process //PAUSE
;
PAUSE	POP	HL		;Display "pause..
	PUSH	HL
	CALL	@DSPLY
PAUSE1	CALL	KSCN		;Loop for BREAK or ENTER
	JR	Z,PAUSE1
	IF	@BLD631
REKEY22
	ENDIF
	JR	REKEY2
;
;	Process //KEYIN
;
KEYIN	POP	HL		;Rcvr pointer to "KEYIN
	PUSH	HL
KEYIN1	LD	A,(HL)		;Display JCL command line
	INC	HL
	CP	CR
	JR	Z,KEYIN2
	CALL	@DSP
	JR	KEYIN1
KEYIN2	CALL	@KEY		;Get & display the char
	CALL	@DSP
	LD	(KEYIN5+1),A	;Stuff for compare
	LD	A,CR
	CALL	@DSP		;Write new line
KEYIN3	POP	HL
	PUSH	HL
	LD	DE,JFCB$	;Ck for end of JCL
	CALL	@CKEOF
	JP	NZ,EXIT
KEYIN4
	IF	@BLD631
	IF	@BLD631G
	LD	B,80		;<631G>
	ELSE
	LD	B,79		;<631>
	ENDIF
KEYIN4B
	ENDIF
	CALL	@GET		;Xfer a line of JCL
	LD	(HL),A		;  to buffer
	INC	HL
	CP	CR
	IF	@BLD631
	JR	Z,KEYIN4A	;<631>
	DJNZ	KEYIN4B		;<631>
	JR	BADJCL		;<631>
KEYIN4A
	ELSE
	JR	NZ,KEYIN4
	ENDIF
	POP	HL
	PUSH	HL
	LD	A,(HL)		;Look for // to find
	CP	'/'		;Start of procedure block
	JR	NZ,KEYIN3
	INC	HL
	CP	(HL)		;//?
	JR	NZ,KEYIN3
	INC	HL		;Point to proc label
	SUB	(HL)		;Is label a '/' noting
	JR	Z,KEYIN6	;  exec phase cond's end?
	LD	A,(HL)		;Nope, get proc label
KEYIN5	CP	0		;Same as key entry?
	JR	NZ,KEYIN3	;No match? check next one
KEYIN6	LD	(KEYIN5+1),A	;Stuff 0 if ///
	POP	HL
	PUSH	HL
	CALL	@LOGER		;Log the command
	IF	@BLD631
	JR	REKEY22		;<631>
	ELSE
	JR	REKEY2
	ENDIF
;
;	Process //ALERT
;
ALERT	XOR	A
	LD	(ALERT4+1),A	;Start with clean flag
ALERT1	LD	A,(HL)		;Ignore spaces
	INC	HL
	CP	' '
	JR	Z,ALERT1
	CP	','		;Comma separator?
	JR	Z,ALERT1
	CP	CR		;End of line?
	JP	Z,REKEY2
	CP	')'		;Closing paren?
	JR	Z,ALERT2
	CP	'('		;Start of parms?
	JR	NZ,ALERT3	;If none of the above...
	LD	(ALERT2+1),HL	;Save ptr to parm start
	JR	ALERT1
;
;	Check here when closing parm received
;
ALERT2	LD	HL,0		;P/u ptr to '(' if there
	LD	A,H		;If the //ALERT1 started
	OR	L		;  with a '(', then
	JR	NZ,ALERT1	;  repeat the parm
	JP	BADJCL		;  parsing else exit
;
;	Assumed integer parm found
;
ALERT3	DEC	HL		;Backup pointer
	CALL	@DECHEX		;Cvrt value to binary
	LD	B,C		;Keep value as counter
ALERT4	LD	A,0		;Flip flag: entries 1, 3,
	XOR	0FFH		;  5, ... are noise, 2,
	LD	(ALERT4+1),A	;  4, 6, ... are silence
	LD	C,A
	BIT	0,C		;Test noise or silence
	CALL	NZ,@SOUND	;Call for sound out
	BIT	0,C		;  then test again
	CALL	Z,SILENCE	;Silence is golden
	CALL	KSCN		;Ck BREAK or ENTER
	JP	NZ,REKEY2	;Go on enter
	JR	ALERT1		;Loop if not
;
;	Silence routine
;
SILENCE	OR	B		;A was zero
	RET	Z
	CALL	SILEN1		;Delay a bit
	DJNZ	SILENCE		;  for duration
	RET
SILEN1	PUSH	BC		;Delay for 0.1 sec
	LD	BC,6555
	CALL	@PAUSE
	POP	BC
	RET
;
;	Process //FLASH
;
FLASH	CALL	@DECHEX
	LD	B,C		;P/u the flash count
	POP	HL
	PUSH	HL
FLASH1	PUSH	BC
	CALL	@DSPLY		;Display the prompt
	LD	BC,4000H	;Countdown to flash msg
FLASH2	CALL	KSCN		;Keep testing <ENTER>
	JP	NZ,REKEY1	;  key during countdown
	DEC	BC		;BREAK would abort
	LD	A,B
	OR	C
	JR	NZ,FLASH2	;Loop until count=0
	LD	A,27		;Erase the message line
	CALL	@DSP
	LD	A,30
	CALL	@DSP
	CALL	SILEN1		;Delay while blanked
	POP	BC
	DJNZ	FLASH1
FLASH3	JP	REKEY2
;
;	Process //SLEEP and //WAIT
;
SLEEP	DB	3EH		;Make it LD A,0AFH
WAIT	XOR	A
	LD	(SLPWT+1),A	;Save entry state
	EX	(SP),HL		;Display the JCL line
	CALL	@DSPLY
	EX	(SP),HL
	LD	DE,TIMFLD	;Pt to time field
	LD	B,3		;Set up loop counter
	JR	PAKTIM1
PAKTIM	CP	':'-30H		;Test valid separator
	JP	NZ,BADJCL
PAKTIM1	PUSH	BC
	CALL	@DECHEX		;Cvrt the hours
	LD	(HL),C		;Store time parm
	LDI			;Shift & bump HL & DE
	POP	BC		;Rcvr the loop counter
	DJNZ	PAKTIM		;Loop for 3 values
SLPWT	LD	A,0		;P/u sleep/wait flag
	OR	A
	JR	Z,TSTIME	;Go if //WAIT
	LD	HL,TIMFLD+2	;Point to seconds
	LD	DE,TIME$
	LD	B,2
SLP1	LD	A,(DE)		;Add secs/mins
	ADD	A,(HL)
	LD	(HL),A		;Store
	SUB	60		;Ck overflow to mins/hrs
	JR	C,SLP2		;Go if none
	LD	(HL),A		;Update value mod 60
	DEC	HL		;  & bump next field
	INC	(HL)
	INC	HL		;Adj for dec
SLP2	INC	DE		;Bump time$
	DEC	HL		;Bump user field
	DJNZ	SLP1
	LD	A,(DE)		;Add hours
	ADD	A,(HL)
	LD	(HL),A
	SUB	24		;Wrap past midnight?
	JR	C,TSTIME	;Go if not else
	LD	(HL),A		;  adjust mod 24
;
;	Wait until the system clock advances to request
;
TSTIME	CALL	KSCN		;Scan for BREAK
	LD	HL,TIMFLD
	LD	DE,TIME$+2
	LD	B,3		;Set loop counter
CKTIME	LD	A,(DE)		;P/u a time value
	CP	(HL)		;Match user input?
	JR	NZ,TSTIME	;Go if no match
	INC	HL		;Inc the user req ptr
	DEC	DE		;Dec the time string ptr
	DJNZ	CKTIME		;Loop for 3 values
	JR	FLASH3		;All match, exit!
;
;	Process //INPUT request
;
INPUT	POP	HL		;Recover JCL line &
	CALL	@DSPLY		;  pump it to screen
	LD	A,0DDH		;Change sysres hook
	LD	(@DOKEY+1),A
	POP	DE		;Stack integrity
	POP	BC		;Get @KEYIN values
;
;	This next routine will satisfy the request
;
GETKEY	CALL	@KEY		;Fetch from keyboard
	PUSH	AF		;Don't disturb flag
	DEC	A
	JR	Z,UNHOOK	;Change back on BREAK
	CP	CR-1		;  or ENTER
	JR	Z,UNHOOK
	POP	AF
	RET
UNHOOK	LD	A,0CDH		;Restore sysres hook
	LD	(@DOKEY+1),A
	POP	AF		;Get saved character
	RET
;
;	Parameter list & scanners
;
;	Parse a field
;	(HL) => command line
;	(DE) => FCB area
;	Z    <= found valid field
;	NZ   <= found invalid field
;
PARSER	LD	B,8		;Set length
PAR1	LD	A,B
	LD	(PAR6+1),A
	INC	B
PAR2	LD	A,(HL)
	CP	3		;ETX?
	JR	Z,PAR5
	CP	CR		;<ENTER>?
	JR	Z,PAR5
	CP	'('		;Begin of parm?
	JR	Z,PAR5
	INC	HL		;Bump pointer to next
	CALL	TST09AZ		;Test if 0-9,A-Z
	JR	NC,PAR3		;Go if one of the above
	CP	'a'		;Check on lower case
	JR	C,PAR5		;Jump on non-alpha
	CP	'z'+1		;Is it a-z?
	JR	NC,PAR5		;Jump on non-alpha
	RES	5,A		;Convert lower to upper
PAR3	DEC	B		;Count down
	JR	Z,PAR4
	LD	(DE),A		;Xfer the char
	XOR	A		;Show at least 1 valid
	LD	(PAR6+1),A	;  char was detected
	INC	DE		;Bump FCB pointer
	JR	PAR2		;Loop
;
PAR4	INC	B		;Here on max chars ck'd
	JR	PAR2
PAR5	LD	C,A		;Save separator
	LD	A,3		;Stuff ETX
	LD	(DE),A
PAR6	LD	A,0		;Set Z-flag if at least
	OR	A		;  1 valid char detected
	LD	A,C		;Recover separator char
	RET
TST09AZ	CP	'0'		;Special character?
	RET	C		;Go if not in range
	CP	'9'+1		;Jump on digit 0-9
	JR	C,EXITC		;Go if 0-9 & make NC
	CP	'A'		;Jump on spec char
	RET	C		;Go with C-flag if 3B-40
	CP	'Z'+1		;Jump on A-Z
EXITC	CCF			;Switch flag of result
	RET
;
;	Find parameter in table
;	(HL) => pointer to line
;	(DE) => pointer to buffer area
;	(BC) => pointer to parameter table
;	  C  <= entry # of parm in table
;	(DE) <= parm vector address
;	  Z <= set if found
;	 NZ <= if not found in table
;	Routine similar as FIND.PARM in SYS1 - dif width
;
FNDPARM	PUSH	HL
	LD	H,B		;Xfer the table address
	LD	L,C
FND1	LD	A,(DE)		;P/u input byte
	CP	(HL)		;Match 1st char of table?
	JR	Z,FND3		;Jump if 1st matches
FND2	PUSH	BC		;  else bypass that entry
	LD	BC,7		;Width of table
	ADD	HL,BC
	POP	BC
	LD	A,(HL)		;Test for table end
	OR	A
	JR	NZ,FND1		;Loop if not at end
	POP	HL
	INC	A		;  else set NZ return
	RET
;
;	1st matches, does the rest?
;
FND3	LD	B,4		;# chars remaining
	PUSH	HL
	PUSH	DE
FND4	INC	DE
	INC	HL
	LD	A,(DE)		;P/u input char
	CP	3		;ETX?
	JR	Z,FND7
	CP	CR		;End of line?
	JR	Z,FND7
	CP	(HL)		;Match with table?
	JR	NZ,FND6		;Exit & test the char
	DJNZ	FND4		;Loop for limit
FND5	POP	DE		;Must be a match
	POP	BC
	LD	HL,5		;Point to vector
	ADD	HL,BC
	LD	E,(HL)		;Xfer vector to DE
	INC	HL
	LD	D,(HL)
	POP	HL
	XOR	A		;  & show it found
	RET
;
;	No match if alphanumeric unless a space
;
FND6	CALL	TST09AZ		;Ck for 0-9, A-Z
	JR	NC,FND8		;Go if one of the above
FND7	LD	A,(HL)		;Loop if table has
	CP	' '		;  trailing spaces
	JR	Z,FND5
FND8	POP	DE
	POP	HL
	JR	FND2
;
LILBUF	DS	6
TIMFLD	EQU	LILBUF
BADJCL$	DB	'Bad JCL, '
ABORT$	DB	'Job aborted',CR
JOBDUN$	DB	'Job done',CR
PARMTBL	DB	'ABORT'
	DW	ABORT
	DB	'ALERT'
	DW	ALERT
	DB	'DELAY'
	DW	DELAY
	DB	'EXIT '
	DW	EXIT
	DB	'FLASH'
	DW	FLASH
	DB	'KEYIN'
	DW	KEYIN
	DB	'PAUSE'
	DW	PAUSE
	DB	'SLEEP'
	DW	SLEEP
	DB	'STOP '
	DW	STOP
	DB	'WAIT '
	DW	WAIT
	DB	'INPUT'
	DW	INPUT
	NOP
LAST	EQU	$
	IFGT	$,DIRBUF$
	ERR	'Module too big'
	ENDIF
	ORG	MAXCOR$-2
	DW	LAST-SYS11	;Overlay size
;
	END	SYS11