.TITLE	PUTMCR -- MCR COMMAND STUFFER
	.IDENT	-000000-
	.SBTTL	TITLE PAGE
;+
; ABSTRACT:	PUTMCR
;
;	THIS PROGRAM IS USED TO STUFF MCR COMMANDS FROM A NONPRIVILEGED
;	USER PROGRAM. IT WILL NOT WAIT FOR THE COMMAND TO COMPLETE.
;
; OPERATING PROCEDURES:
;
;	THIS PROGRAM MUST BE INVOKED WITH A SEND DATA AND REQUEST
;	RECEIVER DIRECTIVE. THE DATA BUFFER MUST CONTAIN AN MCR
;	COMMAND LINE WHICH THE USER WISHES TO BE EXECUTED.
;
; SUBROUTINES:
;
;	$CAT5	CONVERT ASCII TO RADIX-50
;	.DIRDL	EXECUTE A DIRECTIVE AND WAIT IF NO NODES.
;	..ENB0	RE-ENABLE CONTEXT SWITCHING.
;	..NADD	ADD A NODE TO THE MCR LIST.
;	..NADV	RETURN A NODE TO THE NODE POOL
;	..PICV	PICK A NODE FROM THE NODE POOL.
;
; WRITTEN: 03-AUG-78, -0.0.0-, BRUCE C. WRIGHT
; MODIFIED:
; VERIFIED:
;-

	.SBTTL	GLOBAL REFERENCES
;
	.DSABL	GBL
;
; SUBROUTINES
;
	.GLOBL	$CAT5	;CONVERT ASCII TO RADIX-50
	.GLOBL	.DIRDL	;DIRECTIVE SUBROUTINE
	.GLOBL	..ENB0	;RE-ENABLE CONTEXT SWITCHING
	.GLOBL	..NADD	;ADD NODE TO MCR LIST
	.GLOBL	..NADV	;RETURN NODE TO NODE POOL
	.GLOBL	..PICV	;PICK NODE FROM NODE POOL
;
; QIO FUNCTION CODES
;
	.GLOBL	IO.WVB	;WRITE VIRTUAL BLOCK OF DATA
;
; SPECIAL LOCATIONS IN MEMORY
;
	.GLOBL	$DSW	;DIRECTIVE STATUS WORD
	.GLOBL	.CRTSK	;CURRENT TASK ATL POINTER
	.GLOBL	.MCRLH	;MCR COMMAND LINE LISTHEAD
	.GLOBL	PS.EXP	;PSW IN EXTERNAL PAGE
;
; OFFSETS FROM SYSTEM TABLES
;
; ATL NODE
;
	.GLOBL	A.TI	;TASK'S PUD ADDRESS
;
; MCR COMMAND LINE
;
	.GLOBL	M.BC	;BYTE COUNT FOR MCR COMMAND LINE
	.GLOBL	M.BF	;BUFFER FOR MCR COMMAND LINE
	.GLOBL	M.TI	;PUD ADDRESS FOR MCR COMMAND LINE
	.GLOBL	M.TN	;TASK NAME FOR MCR COMMAND LINE
;
; PUD BLOCK
;
	.GLOBL	U.UI	;USER IDENTIFICATION CODE (UIC)

	.SBTTL	MACRO CALLS
	.MCALL	DIR$,WSIG$S,RQST$,VRCX$,QIOW$
;
	.MACRO	ERROR	STRING
	.NCHR	N,<STRING>
	JSR	R0,ERROR
	.WORD	N
	.ASCII	"STRING"
	.EVEN
	.ENDM
;
	.SBTTL	MAIN LINE CODE
;
PUTMCR::
	MOV	SP,STACK	;SAVE STACK ADDRESS
RESTART:MOV	STACK,SP	;RECOVER STACK ADDRESS
	MOV	#BUFFER,R0	;
	MOV	#<BUFLEN/2>,R1	;
CLRLP:	CLR	(R0)+		;CLEAR OUT THE BUFFER.
	SOB	R1,CLRLP	;
	DIR$	#VRCX		;GET A COMMAND LINE.
	BCC	1$		;SKIP IF OK.
	ERROR	<PUTMCR -- CANNOT READ MCR COMMAND LINE>
	BR	RESTART		;AND TRY AGAIN.
1$:	MOV	#BUFFER,R5	;
	MOV	R5,R2		;SAVE BUFFER ADDR
	MOV	R5,R4		;AND SAVE IN R4.
2$:	TSTB	(R5)+		;
	BNE	2$		;LOOP UNTIL DONE.
	SUB	R2,R5		;FIND LENGTH OF BUFFER.
	DEC	R5		;
	MOV	R5,R3		;REMEMBER BUFFER LENGTH
30$:	CMPB	(R2),#'A+40	;IS IT ABOVE LOWER CASE A?
	BLO	31$		;NO
	CMPB	(R2),#'Z+40	;IS IT LOWER CASE?
	BHI	31$		;NO
	BICB	#40,(R2)	;MAKE IT UPPER CASE FOR $CAT5
31$:	INC	R2		;POINT TO NEXT CHAR.
	SOB	R5,30$		;AND LOOP.
	MOV	R4,R0		;POINT TO THE START OF THE STRING
	MOV	#^RAT.,R1	;ASSUME THAT THIS IS ...AT.
	CMPB	(R0),#'@	;IS THE FIRST CHARACTER AN @?
	BEQ	32$		;YES -- NO RAD50.
	CALL	$CAT5		;CONVERT FIRST CHARS TO RADIX-50.
32$:	MOV	#MFTFNS,R2	;GET THE MFT FUNCTIONS
	MOV	#MFTNUM,R0	;AND THEIR NUMBER
33$:	CMP	R1,(R2)+	;IS THIS ONE OF THEM?
	BEQ	34$		;YES -- FIX IT.
	SOB	R0,33$		;LOOP OVER MFT FUNCTIONS.
	BR	35$		;SKIP MFT MOVE
34$:	MOV	#^RMFT,R1	;GET ....MFT REQUEST.
35$:	MOV	R1,RQST+R.QSTN+2 ;SAVE TASK IN RQST DPB.
	MOV	R4,-(SP)	;SAVE CURRENT ADDRESS
	MOV	R3,-(SP)	;SAVE REMAINING LENGTH.
36$:	MOV	#6,R3		;GET NUMBER OF NODES TO PICK
	CALL	..PICV		;PICK NODES FOR MCR COMMAND BUFFER
	BCC	38$		;SKIP IF OK
	WSIG$S			;WAIT A BIT FOR A NODE.
	BR	36$		;AND TRY AGAIN.
38$:	MOV	.CRTSK,R0	;
	MOV	A.TI(R0),R0	;GET PUT ADDR THIS TERMINAL.
	MOV	R0,M.TI(R4)	;SET THE TI ADDRESS IN NODE
	MOV	RQST+R.QSTN+2,M.TN(R4) ;SAVE THE TASK NAME.
	MOV	(SP)+,R2	;RECOVER LENGTH REMAINING
	MOV	(SP)+,R1	;RECOVER ADDRESS
	MOV	U.UI(R0),RQST+R.QSPC ;MOVE IN REQUESTOR.
	MOV	R4,R5		;MOVE BUFFER ADDRESS INTO R5
	ADD	#M.BF,R5	;POINT TO BEGINNING OF BUFFER
	MOV	R2,M.BC(R4)	;SAVE BYTE COUNT.
40$:	MOVB	(R1)+,(R5)+	;MOVE IN THE CHARACTERS.
	SOB	R2,40$		;LOOP OVER ENTIRE REMAINING STRING
	MOVB	#ESC,(R5)+	;TERMINATE THE LINE WITH <ESC>
	MOV	R4,R1		;GET NODE ADDRESS INTO R1
	MOV	#.MCRLH,R4	;GET MCR LISTHEAD.
	MOV	@#PS.EXP,-(SP)	;SAVE PSW.
	BIS	#140,@#PS.EXP	;DISABLE CONTEXT SWITCHING.
	MOV	#RQST,-(SP)	;;;REQUEST TASK.
	CALL	.DIRDL		;;;DO THE REQUEST
	BCS	50$		;;;BAD -- SEND MESSAGE.
	CALL	..NADD		;;;ADD THIS NODE TO HIS LIST.
	CALL	..ENB0		;;;ENABLE CONTEXT SWITCHING.
	JMP	RESTART		;AND TRY TO DEQUEUE ANOTHER COMMAND.
50$:	CALL	..ENB0		;;;ENABLE CONTEXT SWITCHING.
	MOV	#6,R3		;GET THE LENGTH OF THE BUFFER
	CALL	..NADV		;RETURN THE BUFFER TO THE POOL.
	CMP	#-2,@#$DSW	;TASK NOT INSTALLED?
	BNE	103$		;NO
	ERROR	<PUTMCR -- TASK NOT INSTALLED>
103$:	CMP	#-3,@#$DSW	;PARTITION TOO SMALL?
	BNE	106$		;NO
	ERROR	<PUTMCR -- PARTITION TOO SMALL FOR TASK>
106$:	CMP	#-6,@#$DSW	;HANDLER NOT RESIDENT?
	BNE	107$		;NO
	ERROR	<PUTMCR -- HANDLER TASK NOT RESIDENT>
107$:	CMP	#-7,@#$DSW	;TASK ALREADY ACTIVE?
	BNE	108$		;NO
	ERROR	<PUTMCR -- TASK ALREADY ACTIVE>
108$:	CMP	#-8.,@#$DSW	;TASK DISABLED?
	BNE	180$		;NO
	ERROR	<PUTMCR -- TASK DISABLED>
180$:	CMP	#-80.,@#$DSW	;ISSUED BY BACKGROUND TASK?
	BNE	191$		;NO
	ERROR	<PUTMCR -- CANNOT BE ISSUED FROM BACKGROUND>
191$:	CMP	#-91.,@#$DSW	;INVALID UIC?
	BNE	194$		;NO
	ERROR	<PUTMCR -- INVALID UIC>
194$:	CMP	#-94.,@#$DSW	;PARTITION NOT IN SYSTEM?
	BNE	195$		;NO
	ERROR	<PUTMCR -- PARTITION NOT IN SYSTEM>
195$:	CMP	#-95.,@#$DSW	;INVALID PRIORITY?
	BNE	198$		;NO
	ERROR	<PUTMCR -- INVALID PRIORITY>
198$:	ERROR	<PUTMCR -- INTERNAL ERROR OR UNKNOWN DSW ERROR>

	.SBTTL	SUBROUTINE TO PRINT ERROR MESSAGES
;
; THIS SUBROUTINE IS INVOKED BY THE "ERROR" MACRO. IT
; PRINTS THE ARGUMENT GENERATED BY THE "ERROR" MACRO ON
; THE USER'S TERMINAL.
;
; CALLING SEQUENCE:
;
;	JSR	R0,ERROR
;	.WORD	STRINGLENGTH
;	.ASCII	"STRING"
;
; THE SUBROUTINE WILL NEVER RETURN TO THE CALLER.
;
ERROR:	MOV	(R0)+,QIO+Q.IOPL+2 ;MOVE IN QIO LENGTH
	MOV	R0,QIO+Q.IOPL	;GET THE QIO ADDRESS
	MOV	#QIO,-(SP)	;AND PRINT ERROR MESSAGE
	CALL	.DIRDL
	JMP	RESTART		;AND TRY TO DEQUEUE ANOTHER COMMAND.

	.SBTTL	DATA AREA
;
; MFT COMMANDS
;
MFTFNS:	.RAD50	/ABOALTCANDISENAFIXLOARESUNF/
MFTNUM	=	<.-MFTFNS>/2
;
; MISCELLANEOUS DATA AREAS
;
CR	=	15		;CARRIAGE RETURN FOR TERMCH
ESC	=	33		;ESCAPE FOR TERMCH
TASK:	.WORD	0,0		;THE SENDER'S TASK NAME
BUFFER:	.BLKB	82.		;THE RECEIVER BUFFER.
BUFLEN	=	.-BUFFER	;BUFFER LENGTH.
STACK:	.WORD	0		;STACK STORAGE.
;
; DIRECTIVE PARAMETER BLOCKS
;
VRCX:	VRCX$	,TASK,40.
RQST:	RQST$	...MCR
QIO:	QIOW$	IO.WVB,1,1,,,,<0,0,40>
	.END	PUTMCR