.TITLE	STACK
	.IDENT	/V1.08/

;******************************************************************
;
;	THIS TASK IMPLEMENTS THE STACK COMMAND. THIS COMMAND IS
;	USED IN A BATCH JOB TO QUEUE A LINE OF INPUT READY TO
;	BE COPIED TO THE USER'S BUFFER WHEN A TERMINAL READ REQUEST
;	IS MADE. RSX11M V3.2 ONLY.
;
;	THE FOLLOWING UCB OFFSETS ARE DEFINED IN THE VIRTUAL TERMINAL
;	DRIVER'S DATA BASE, AND ARE INCLUDED IN THIS TASK THROUGH THE
;	SYMBOL TABLE FILE RSX11M.STB:  (1) U.STHD (2) U.STSZ
;
;	S.M. THOMPSON, NOVEMBER 1979
;
;*****************************************************************

	.MCALL	GMCR$,DIR$,EXST$,QIOW$

;
; LOCAL DATA
;

LUN1	=	1		; TI: LUN
EFN1	=	1		; EVENT FLAG FOR TI: I/O

GMCR:	GMCR$			; GET COMMAND LINE DPB
BUF	=	GMCR+2		; INPUT BUFFER

;
; MACROS
;

	.MACRO	PRINT	ERR
	MOV	ERR,DPB+Q.IOPL
	MOV	ERR'SZ,DPB+Q.IOPL+2
	DIR$	#DPB
	.ENDM

;
; ERROR MESSAGES
;

	.NLIST	BEX

	.ENABL	LC

ERR1:	.ASCII	/STA -- Command input error/
ERR1SZ=.-ERR1
ERR2:	.ASCII	/STA -- Illegal context/
ERR2SZ=.-ERR2
ERR3:	.ASCII	/STA -- Insufficient stack left for this request/
ERR3SZ=.-ERR3
ERR4:	.ASCII	/STA -- Memory allocation failure/
ERR4SZ=.-ERR4

	.EVEN

STOP:	EXST$	EX$SUC
DPB:	QIOW$	IO.WVB,LUN1,EFN1,,,,<0,0,40>

$STKEP:	DIR$	#GMCR		; GET MCR COMMAND LINE
	BCC	2$		; OK, GOT ONE
1$:	PRINT	#ERR1		; COMMAND I/O ERROR
	BR	EXSEV		; SO EXIT
2$:	MOV	#BUF,R0		; GET BUFFER ADDRESS
3$:	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	1$		; END OF LINE IS ERROR
	TST	R1		; ANY BLANKS SEEN?
	BEQ	3$		; NO, KEEP GOING
	DEC	R0		; STEP BACK TO FIRST BYTE OF COMMAND
	MOV	$DSW,R1		; GET COMMAND LINE LENGTH
	ADD	#BUF,R1		; POINT TO LAST CHARACTER
				; (TERMINATOR DOES NOT FORM PART OF STACK;
				; THE VIRTUAL TERMINAL DRIVER ALWAYS PUTS
				; CARRIAGE RETURN AS TERMINATOR)
	SUB	R0,R1		; CALCULATE LENGTH OF STACK LINE
	BLE	1$		; IT SHOULD BE POSITIVE
	MOV	$TKTCB,R5	; GET OUR TCB ADDRESS
	MOV	T.UCB(R5),R4	; AND OUR TI: UCB ADDRESS
	MOV	U.DCB(R4),R5	; POINT TO DCB
	CMP	D.NAM(R5),#"VT	; ARE WE ON A VIRTUAL TERMINAL?
	BEQ	4$		; YES
31$:	PRINT	#ERR2		; NO IS ERROR
	BR	EXSEV		; SO EXIT
4$:	CMP	R4,#$VIRT0	; OK, IT'S A VT:, BUT IS IT VT0:?
	BEQ	31$		; YES IS ILLEGAL
	MOV	#$STKMX,R3	; GET MAXIMUM ALLOWABLE STACK SIZE
	SUB	U.STSZ(R4),R3	; SUBTRACT CURRENT STACK SIZE
	SUB	R1,R3		; SUBTRACT CURRENT REQUEST SIZE
	BGE	5$		; IF GE IT WILL FIT OK
	PRINT	#ERR3		; TELL USER STACK IS FULL
	BR	EXSEV		; AND EXIT
5$:	MOV	R0,-(SP)	; SAVE BUFFER ADDRESS
	MOV	R1,-(SP)	; AND REQUEST LENGTH
	CLR	BUF		; SET FLAG TO SHOW NO DSR PACKET
	ADD	#4,R1		; SET SIZE OF PACKET NEEDED
	CALL	$SWSTK,10$	; SWITCH STACKS
	CALL	$ALOCB		;; GET A DSR PACKET
	BCS	6$		;; COULDN'T GET ONE
	MOV	R0,BUF		;; OK, STORE BUFFER ADDRESS
6$:	RETURN			;; BACK TO USER LEVEL
10$:	MOV	BUF,R0		; DID WE GET A PACKET?
	BNE	15$		; YES
	CMP	(SP)+,(SP)+	; NO, CLEAN STACK
	PRINT	#ERR4		; SAY WHAT HAPPENED
	BR	EXSEV		; AND EXIT
15$:	MOV	(SP)+,R2	; GET REQUEST LENGTH
	ADD	R2,U.STSZ(R4)	; UPDATE USER'S STACK LENGTH
	CLR	(R0)+		; ZERO LINK WORD
	MOV	R2,(R0)+	; SET REQUEST LENGTH IN PACKET
	MOV	(SP)+,R1	; GET BUFFER ADDRESS
20$:	MOVB	(R1)+,(R0)+	; MOVE A BYTE
	DEC	R2		; DONE YET?
	BNE	20$		; NO
	MOV	BUF,R1		; YES, GET PACKET ADDRESS
	MOV	R4,R0		; COPY VT: UCB ADDRESS TO R0
	ADD	#U.STHD,R0	; MAKE IT STACK LISTHEAD ADDRESS
	CALL	$SWSTK,EXIT	; SWITCH STACKS
	CALL	$QINSF		;; LINK PACKET INTO STACK
	RETURN			;; BACK TO TASK LEVEL
EXSEV:	MOV	#EX$SEV,STOP+E.XSTS ; SET SEVERE ERROR CODE
EXIT:	DIR$	#STOP		; EXIT

	.END	$STKEP