TITLE	GEXIT,<EG SPECIAL FUNCTIONS>,39,14-JUL-83,MHB/AWR/KPH

;
;		COPYRIGHT (c) 1974, 1983 BY
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
; ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
; COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
; AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY  OF ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;

.SBTTL	MACROS

.MACRO	CHKERR	CODE,SRC=FIRQB
.DSABL	CRF
.GLOBL	CODE
.ENABL	CRF
	 CMPB	#CODE,SRC
.ENDM	CHKERR

.MACRO	SETERR	CODE,DST=FIRQB
.DSABL	CRF
.GLOBL	CODE
.ENABL	CRF
	 MOV	#CODE,DST
.ENDM	SETERR

.MACRO	VECTOR	AT,TO
	ORG	VE,AT-P.OFF
	 .WORD	TO
.ENDM	VECTOR

.SBTTL	DEFINITIONS

.PSECT	EGFUNC,RO,I,GBL,REL,OVR
	ORG	EGFUNC

.PSECT	VE,    RO,D,GBL,REL,OVR
	ORG	VE

.SBTTL	OVERLAY TECO'S VECTORS FOR KEYBOARD MONITOR VECTORS

	VECTOR	P.FLAG,	PF.KBM	;THIS TECO IS A KEYBOARD MONITOR

	VECTOR	P.NEW,	NEWENT	;THIS TECO HAS A "NEW" ENTRY POINT

.SBTTL	SPECIAL FUNCTIONS FOR KEYBOARD MONITOR TECO'S

	ORG	EGFUNC

.ENABL	LSB

EGFUNC:	CALLX	SAVREG,R4	;SAVE ALL REGISTERS
	MOV	FILBUF(R5),R2	;GET THE STRING POINTER
	CALL	220$,R4,<'C>	;CHECK FOR "CCL"
	BNE	10$		;IT CAN'T BE "CCL"...
	CALL	220$,R4,<'C>	;CHECK THE "C"
	BNE	80$		;NOPE, EXIT VALUE=0
	CALL	220$,R4,<'L>	;CHECK THE "L"
	BNE	80$		;NOPE AGAIN, EXIT VALUE=0
	CALL	260$		;SKIP ANY EXTRA JUNKY CHARACTER(S)
	MOVB	R0,-(R2)	; BUT REPLACE THAT LAST CHARACTER
	CALL	DOCCL		;TRY THAT CCL COMMAND
	JMP	180$		;GO CHECK FOR ERROR(S)

GLOBAL	<FILBUF>

10$:	CMP	R0,#'E		;CHECK FOR "EMT"
	BNE	60$		;IT CAN'T BE "EMT"...
	CALL	220$,R4,<'M>	;CHECK THE "M"
	BNE	80$		;NOPE, EXIT VALUE=0
	CALL	220$,R4,<'T>	;CHECK THE "T"
	BNE	80$		;NOPE AGAIN, EXIT VALUE=0
	CALL	260$		;CHECK FOR CORRECT STRING TERMINATION
	BNE	80$		;NOT THE END, EXIT VALUE=0
	MOV	#QARRAY+<FQBSIZ+XRBSIZ*2>,R1 ;POINT INTO Q-REGISTERS
	ADD	R5,R1		; ABSOLUTELY
	MOV	#XRB+XRBSIZ,R2	;POINT INTO FIRQB, XRB
20$:	MOV	-(R1),-(R2)	;LOAD FIRQB, XRB FROM Q-REGISTER
	TST	-(R1)		; THEN SKIP Q-REGISTER'S SIZE
	CMP	R2,#FIRQB+FQJOB	;DONE?
	BHI	20$		;NOT YET, LOOP...
	TSTB	-(R1)		;USE TEXT PART OF Q-REGISTER "A"?
	BEQ	30$		;NOPE
	MOV	#XRB,R2		;YEP, GET XRB POINTER AGAIN
	MOV	-3(R1),(R2)	;SET TEXT SIZE OF Q-REGISTER "A"
	MOV	(R2)+,(R2)+	; IN BOTH PLACES
	MOV	QRSTOR(R5),(R2)	;POINT TO Q-REGISTER "A"
	TSTB	(R1)		;WHICH DIRECTION DESIRED?
	BPL	30$		;>0 => "WRITE", FROM Q-REG TO MONITOR
	CLR	-(R2)		;<0 => "READ", FROM MONITOR TO Q-REG
30$:	MOV	(PC)+,-(SP)	;SET ENDING SP STACK INSTRUCTION
		JSR	SP,@(SP)+
	MOV	(PC)+,-(SP)	;SET SP STACK MONITOR CALL PROTOTYPE
		EMT	0
	MOVB	-(R1),(SP)	;NOW SET THE MONITOR CALL CODE
	CALL	(SP)		; AND GO DO IT!!!
40$:	MOV	#FIRQB,R1	;GET A POINTER TO FIRQB, XRB
	MOV	#QARRAY,R2	;GET A POINTER TO Q-REGISTERS
	ADD	R5,R2		; ABSOLUTELY
50$:	TST	(R2)+		;SKIP THE SIZE
	MOV	(R1)+,(R2)+	; THEN MOVE FROM FIRQB, XRB TO Q-REGISTERS
	CMP	R1,#XRB+XRBSIZ	;DONE?
	BLO	50$		;NOT YET, LOOP...
	RETURN			;EXIT

GLOBAL	<QARRAY,QRSTOR>

60$:	CMP	R0,#'R		;CHECK FOR "RUN" OR "RTS"
	BNE	100$		;IT CAN'T BE "RUN" OR "RTS"...
	CALL	220$,R4,<'U>	;CHECK FOR "RUN"
	BNE	70$		;IT CAN'T BE "RUN"...
	CALL	220$,R4,<'N>	;CHECK THE "N"
	BR	90$		;GO DO FINAL CHECK

70$:	CMP	R0,#'T		;CHECK FOR "RTS"
80$:	BNE	190$		;NOPE, EXIT VALUE=0
	CALL	220$,R4,<'S>	;CHECK THE "S"
90$:	BNE	190$		;NOPE AGAIN, EXIT VALUE=0
	BR	110$		;O.K. (R0 = 'N IF "RUN"; R0 = 'S IF "RTS")

100$:	CMP	R0,#'F		;CHECK FOR "FSS"
	BNE	190$		;IT CAN'T BE "FSS", EXIT VALUE=0
	CALL	220$,R4,<'S>	;CHECK THE "S"
	BNE	190$		;NOPE, EXIT VALUE=0
	CALL	220$,R4,<'S>	;CHECK THE SECOND "S"
	BNE	190$		;NOPE AGAIN, EXIT VALUE=0
	TST	(PC)+		;SET C=0 FOR .FSS BY ITSELF
110$:	SEC			;SET C=1 FOR DO .FSS AND THEN .RUN/.RTS
	MOV	R0,R1		;COPY THE "RUN"/"RTS" INDICATION
	ROR	R1		; AND SAVE BOTH INDICATORS
	CALL	260$		;SKIP ANY EXTRA JUNKY CHARACTER(S)
	MOVB	R0,-(R2)	; BUT REPLACE THAT LAST CHARACTER
	CALL	DOFSS		;GO DO THAT .FSS
120$:	CALL	240$		;GO CHECK FOR ERROR(S)
	ASL	R1		;WHAT WERE WE DOING?
	BCC	40$		;JUST THE .FSS, GO SET ANSWER(S) AND EXIT

	SETERR	BADNAM		;"RUN"/"RTS", PRESET THE ILLEGAL NAME ERROR
	MOV	#XRB+10,R3	;FIND THE TRANSLATION FLAGS
	BIT	#101546,(R3)	;ANYTHING WILD?
	BNE	120$		;YUP, GO AWAY WITH ERROR
	BIT	#10,(R3)	;WAS THERE AN EXTENSION?
	BNE	130$		;YES, SO LEAVE IT ALONE
	MOV	#-1,FIRQB+FQEXT	;NO, SO SUPPLY A WILD ONE
130$:	MOV	#XRB+XRBC,R2	;GET POINTER TO # REMAINING, REMAINING POINTER
	CMP	R1,#'S/2*2	;IS IT "RTS"?
	BNE	150$		;NOPE, IT IS "RUN"
	TST	(R2)		;YEP, DID .FSS EAT IT ALL?
	BNE	120$		;NOT EATEN, AN ERROR
	BIT	#1,(R3)		;SPECIFY AN RTS NAME?
	BEQ	140$		;NOPE, GO SWITCH TO SYSTEM DEFAULT
	.RTS			;YEP, THINK CAN WE DO IT?
	BR	180$		;GO CHECK FOR ERROR(S)

140$:	.EXIT			;BACK TO SYSTEM DEFAULT RTS

150$:	BIT	#1,(R3)		;"RUN", FILENAME SPECIFIED?
	BEQ	120$		;NOPE, GO AWAY WITH ERROR
	TST	(R2)+		;DID .FSS EAT IT ALL?
	BEQ	170$		;YES, SO DO NOTHING SPECIAL
	MOV	(R2),R2		;NO, GET POINTER TO REMAINING STRING
	CALL	220$,R4,<'=>	;DELIMITED BY "="?
	BNE	120$		;AIN'T GONNA DO THIS TO THAT...
	MOV	#CORCMN,R3	;FIND START OF CORE COMMON
	CLRB	(R3)+		;START LENGTH OFF AT ZERO
160$:	MOVB	(R2)+,R0	;GET A CHARACTER
	BEQ	170$		;END OF STRING, QUIT
	CALL	200$		;UPCASE CHARACTER IF POSSIBLE
	MOVB	R0,(R3)+	;DUMP IT INTO CORE COMMON
	INCB	CORCMN		; AND COUNT IT
	BPL	160$		;LOOP UNLESS WE'VE FILLED CORCMN
170$:	.RUN			;TRY TO DO IT
180$:	CALL	240$		;AH WELL, WE TRIED
190$:	CLR	N(R5)		;SET RETURNED VALUE AS 0
	RETURN			;EXIT

GLOBAL	<N>

200$:	CMP	R0,#'A+40	;IS IT LOWER CASE?
	BLO	210$		;NOPE
	CMP	R0,#'Z+40	;WITHIN RANGE?
	BHI	210$		;NOPE
	BIC	#40,R0		;YEP, MAKE IT UPPER CASE
210$:	RETURN			;EXIT

220$:	CALL	260$		;SKIP JUNKY CHARACTER(S)
	BEQ	230$		;END OF STRING, SO EXIT
	CALL	200$		;UPCASE CHARACTER IF POSSIBLE
	CMP	R0,(R4)+	;DO THE SPECIFIED COMPARISON
	RETURN	R4		; AND EXIT WITH CC'S SET

230$:	MOV	(SP)+,R4	;POP THE SAVED R4
	BR	190$		; AND GO EXIT VALUE=0

240$:	TSTB	FIRQB		;AN ERROR?
	BEQ	250$		;NOPE, RETURN
	MOV	FIRQB,N(R5)	;YEP, SET ERROR AS RETURNED VALUE
	TST	(SP)+		;POP THE RETURN ADDRESS
250$:	RETURN			;RETURN

260$:	MOVB	(R2)+,R0	;GET NEXT STRING CHARACTER
	BEQ	270$		;END OF STRING, EXIT Z=1 (SINCE 'BEQ')
	CMP	R0,#040		;SPACE OR CONTROL CHARACTER?
	BLOS	260$		;YES, SIMPLY SKIP IT
	CMP	R0,#177		;A RUBOUT?
	BEQ	260$		;YES, SIMPLY SKIP THAT ALSO
	;CLZ			;OTHER, EXIT Z=0 (SINCE NOT 'BEQ')
270$:	RETURN			;EXIT WITH Z-BIT INDICATION

.DSABL	LSB

GLOBAL	<N>

DOFSS:	TST	(PC)+		;SET C=0 FOR .FSS
DOCCL:	SEC			;SET C=1 FOR .CCL
	ROR	-(SP)		;SAVE THE C-BIT INDICATION
	CALLX	SETFQB,R0,<0*400> ;TIDY UP THE FIRQB
	CLR	FIRQB		; AND SET NO ERROR INITIALLY
	MOV	#XRB+XRBSIZ,R3	;POINT TO END OF XRB
	CLR	-(R3)		;CLEAR XRB+14
	CLR	-(R3)		;CLEAR XRB+12 (PTR TO NON-STD LOGICALS)
	CLR	-(R3)		;CLEAR XRB+10 (LEN OF NON-STD LOGICALS)
	CLR	-(R3)		;CLEAR XRB+6
	MOV	R2,-(R3)	;POINT TO THE STRING
.IIF	NE	XRBSIZ-2-2-2-2-2-XRLOC, .ERROR ;THE ABOVE WON'T WORK
10$:	TSTB	(R2)+		;SKIP STRING
	BNE	10$		; LOOKING FOR THAT NULL BYTE
	DEC	R2		;END, BACK UP OVER THE NULL
	SUB	(R3),R2		; AND FIND LENGTH OF CCL COMMAND
	ASL	(SP)+		;SET THE C-BIT INDICATOR
	MOV	R2,-(R3)	;SET LENGTH IN XRB @ XRBC AND
	MOV	R2,-(R3)	; IN XRB @ XRLEN
	BEQ	30$		;NO LENGTH, JUST RETURN
	BCC	20$		;IF C=0 THEN DO .FSS
	.CCL			;IF C=1 THEN DO .CCL
	RETURN			; AND EXIT

20$:	.FSS			;IS IT DECIPHERABLE?
30$:	RETURN			;RETURN WITH EVERYTHING SET UP

.SBTTL	"NEW" ENTRY POINT

.ENABL	LSB

NEWENT:	MOV	#USRSP,SP	;RESET THE SP STACK
	TST	XRB+2		;SWITCH TYPE ENTRY?
	BNE	30$		;YEP, SOMEONE WAS PREVIOUS TO US
	TST	FIRQB+FQPPN	;NOPE, SPAWNED OR NEW JOB ENTRY?
	BEQ	20$		;A NEW JOB, GO LOG IT IN
	MOV	#CORCMN,R0	;SPAWNED JOB, GET CORE COMMON POINTER
	MOV	#11.,R1		; AND WHAT WILL BE ITS SIZE
	MOVB	R1,(R0)+	;SET CORRECT CORE COMMON SIZE
	MOV	#FIRQB+16,R2	;GET POINTER TO PASSED DATA
10$:	MOVB	(R2)+,(R0)+	;MOVE DATA TO CORE COMMON
	SOB	R1,10$		; UNTIL DONE...
	MOVB	FIRQB+4,-(R0)	;SET LAST BYTE TO SPAWNER'S JOB # *2
	BR	50$		;NOW GO DO THE RUNNING

20$:	MOV	#70$,R2		;GET POINTER TO "$LOGIN"
	MOV	#32000.!100000,-(SP) ;SAVE THE (COMPATIBLE) PARAMETER WORD
	BR	40$		;GO DO THE LOGIN CALL

30$:	CALLX	ZOTALL		;RESET ALL CHANNELS
	MOV	#-1,XRB		;DO A CLEAR
	.CLEAR			; OF ALL FLAGS
	MOV	#90$,R2		;GET POINTER TO "TECKBM"
	CALL	DOFSS		; AND .FSS IT
	MOV	@#P.DEXT,FIRQB+FQEXT ;SET OUR RUNNABLE EXTENSION
	.CHAIN			;TRY TO RUN IT (NOTE: SP = #USRSP)
	MOV	#80$,R2		;FAILED, GET POINTER TO "TECO$:TECKBM"
	CALL	DOFSS		; AND .FSS IT
	MOV	@#P.DEXT,FIRQB+FQEXT ;SET OUR RUNNABLE EXTENSION
	.CHAIN			;TRY TO RUN IT (NOTE: SP = #USRSP)
	BR	60$		;FAILED, GO SAY SO

40$:	CALL	DOFSS		;GO DO THAT .FSS
	MOV	(SP)+,FIRQB+FQNENT ;SET THE PARAMETER WORD
	MOV	#-1,FIRQB+FQEXT	;WILD CARD THE RUNNABLE EXTENSION
50$:	.RUN			;TRY TO .RUN IT
60$:	JMPX	RESTRT		;DO THIS ON ERROR(S)

70$:	.ASCIZ	"$LOGIN"	;LOGIN FILE ACCOUNT, NAME
80$:	.ASCII	"TECO$:"	;Location of keyboard monitor program
90$:	.ASCIZ	"TECKBM"	;Name of keyboard monitor program
	.EVEN

.DSABL	LSB

.END