; 07-OCT-76  11:05:09 >SM:=DK:MCR.OBJ
	.TITLE	RSX11D
	.IDENT	/V41   /
	.LIST	MEB
.SBTTL	INTRO
;	MODIFIED BY F. BORGER, MICHAEL REESE MED CENTER TO
;	A/	DIRECTLY CALL ...HEL IF TERM NOT LOGGED ON
;	B/	DO BELL IN PROMPT STRING
;	C/	INTERACT WITH MCI (INDIRECT MCR PROGRAM)
;	D/	MAJOR OPERATION CHANGE INCLUDED 2 77
;		IF TERMINAL PRIVILEGE BYTE HAS UT.HO (=10) BIT SET
;		INDICATING THAT TERMINAL IS IN A HOSTILE ENVIROMENT
;		WITH FUMBLE FINGERED OPERATORS, MCR WILL SCAN THE
;		CTL FOR THE GEN PARTITION. IF ANY CTL TASK IS ACTIVE
;		AT SAME TERMINAL, MCR WILL GET OUT QUICKLY.
;		THUS CAN NOT HAVE TWO ...BAS, ONE BAS AND MCR, ETC 
;		CLOGGING UP A TERMINAL
	UT.HO=10	;DEFINE "HOSTILE TERMINAL" FLAG
;	E/	MODIFIED SO IF HOSTILE TERMINAL ENCOUNTERS MCR TIMEOUT
;		TERMINAL WILL ALSO BE LOGGED OFF
;	F/	MODIFIED 5/77 TO REFLECT DEC V6B MCR CHANGES
;	G/	MODIFIED 6/77 TO USE INTERNAL ASCII -> RAD-50 CODE
;		WHICH ALSO ACCOUNTS FOR LOWER CASE LETTERS AND SHOULD MAKE
;
;	H/	MODIFIED 11/77 TO CONVERT ( AND ) TO [ AND ] FOR ODD-BALL
;		AND DEC TERMINALS WHICH HAVE [ AND ] IN ODD PLACES
;	I/	MOD 6/78 FOR VERSION 6.3/IAS 3.0 (USE SPAWN DIRECTIVE)
;	J/	4/82  MODIFY SO SETS ACTIVITY BIT IN TI PUD AT EACH CALL,
;		FOR AUTOMATIC LOG-OUT PURPOSES
;		DEFINE TERMINAL ACTIVITY BYTE
	UT.AC=20
;
	.MCALL	DIR$,VSDR$,QIOW$,EXIT$S
	.MCALL	SPWN$
.PAGE
.SBTTL	CHECK FOR MULTIPLE MCR'S, TASK ACTIVE FOR HOSTILE TERM
START:	MOV	.CRTSK,R0	;GET MY ATL POINTER -> R0
	CLR	ACTCNT		;CLEAR ACTIVE TASK COUNTER
	MOV	#.ATLLH,R1	;AND ATL LISTHEAD IN R1
	MOV	PS.EXP,-(SP)	;SAVE PROCESSOR STATUS WORD
	BIS	#140,PS.EXP	;INHIBIT TASK SWITCHING
24$:	MOV	(R1),R1		;START (CONTINUE) GOING THROUGH ATL
	CMP	R1,.ATLLH+2	;THROUGH ATL YET ?
	BEQ	25$		;BR IF WE FELL THROUGH
	CMP	A.TI(R1),A.TI(R0) ;IS THIS TASK ACTIVE FOR MY TERMINAL ?
	BNE	242$		;SKIP IF NOT
	BIT	#AF.IA,A.TF(R1)	;IS THIS SCHEDULER CONTROLLED TASK ?
	BEQ	242$		;BRANCH IF NOT
	MOV	A.TD(R1),R5	;GET STD
	CMP	S.TN+2(R5),ATRAD ;IS IT ...AT. ?
	BEQ	242$		;SKIP IF IT IS
	INC	ACTCNT		;COUNT ONE TASK ACTIVE HERE
242$:	CMP	R0,R1		;IS THIS TASK ME ?
	BEQ	24$		;IF SO, CONTINUE CHECKING ATL
	CMP	A.TD(R0),A.TD(R1) ;IF STD IS SAME, THIS IS AN MCR
	BNE	24$		;IF NOT, CONTINUE CHECKING ATL
	CMP	A.TI(R0),A.TI(R1) ;IF MCR TI SAME, ALREADY RUNNING HERE
	BNE	24$		;IF NO MATCH, TRY AGAIN
	JSR	PC,..ENB0	;RE-ENABLE TASK SWITCHING
	JMP	16$		;MCR IS ALREADY ACTIVE AT SAME TI, DONT HAVE 2
25$:	;OK, ANOTHER MCR NOT ACTIVE HERE CHECK FOR HOSTILE TERMINAL
	JSR	PC,..ENB0	;ENABLE TASK SWITCHING
	MOV	A.TI(R0),R5	;MY TI POINTER -> R5
	BITB	#UT.HO,U.PR(R5)	;IS THIS A HOSTILE TERMINAL ?
	BEQ	255$		;NO SKIP NEXT TEST
	TST	ACTCNT		;IS THERE ONE RUNNING ?
	BLE	255$		;CONTINUE IF NOT
	JMP	16$		;ONE PROGRAM GOING, SO SCRAM
255$:	BITB	#UT.LG,U.PR(R5)	;IS TERMINAL LOGGED ON ?
	BNE	35$		;OK IF HE IS
	MOV	HELRAD,SPWDPB+S.PWTN+2 ;ELSE CHANGE TASK NAME TO ...HEL
	MOV	#401,SPWDPB+S.PWPC	;AND RUN HIM AS A PRIV TASK
	DIR$	#SPWDPB		;AND REQUEST HIM DIRECTLY
30$:	JMP	16$		;AND EXIT
.PAGE
.SBTTL	ISSUE PROMPT AND GET COMMAND LINE
35$:
	MOV	U.TF(R5),TERFLA	;SAVE THIS TERMINALS FLAGS
	MOV	.CRTSK,R0	;POINT R0 TO MY ATL NODE
	MOV	A.TI(R0),R0	;NOW GET TI INDICATOR
	MOV	U.UI(R0),SPWDPB+S.PWPC ;FILL IN UIC IN DPB
27$:	MOV	.MCRTO,R3	;GET MCR TIME OUT IN SECONDS
	CLR	R2		;SET FOR DIVIDE
	DIV	#10.,R2		;CONVERT TIME TO 10-SEC UNITS FOR TT
	MOV	R2,QIN+Q.IOPL+4	;AND SET TIME IN THE READ QIO DPB
	DIR$	#QIN		;DO READ COMMAND DIRECTIVE
	BCS	23$		;BR IF DIRECTIVE FAILS
	CMPB	RSTAT,#IS.TMO	;DID THE READ TIME OUT ?
	BNE	212$		;BR IF DIDN'T
	MOV	R0,-(SP)	;SAVE R0
	MOV	.CRTSK,R0	;GET MY ATL
	MOV	A.TI(R0),R0	;AND GO TO PUD POINTER FOR TI
	BITB	#UT.HO,U.PR(R0)	;IS THIS A HOSTILE TERMINAL ?
	BEQ	211$		;BR IF IT ISN'T
	MOV	BYERAD,SPWDPB+S.PWTN+2 ;ELSE CHANGE TASK NAME TO ...BYE
	MOV	#401,SPWDPB+S.PWPC	;AND RUN HIM AS A PRIV TASK
	DIR$	#SPWDPB		;AND REQUEST HIM DIRECTLY
211$:	MOV	(SP)+,R0	;RESTORE R0
	BR	22$		;AND SCRAM
212$:	TSTB	RSTAT		;CHECK STATUS OF READ QIO
	BMI	22$		;BR IF READ FAILED
				;SET ACTIVITY BIT IN PRIVILEGES BYTE
	BISB	#UT.AC,U.PR(R0)	;FOR AUTOMATIC LOG-OUT OPTION
	TST	RSTAT+2		;CHECK # OF CHARACTERS RECIEVED
	BNE	1$		;BR IF SOME RECEIVED
22$:	JMP	15$		;TIMED OUT OR GOT NULL LINE - EXIT
23$:	JMP	21$		;DIRECTIVE FAILED SCRAM
.PAGE
.SBTTL	CLEAN UP COMMAND LINE
1$:	CLR	R3		;RECEIVED COMMAND LINE
	MOV	#READIN,R4	;INPUT BUFFER ADDRESS TO R4
	MOV	R4,R5		;BUFFER ADDR -> R5
	MOV	R4,R1		;AND TO R1
	MOV	R4,R2		;AND TO R2
	ADD	RSTAT+2,R5	;BUMP R5 TO END OF INPUT LINE
20$:	CMPB	#11,(R2)	;CHARACTER A TAB ?
	BNE	2$		;BR IF NOT
	MOVB	#40,(R2)	;CHANGE TAB TO A SPACE FOR COMMAND WORK
				;CONCATENATE TABS OR MULT SPACES TO ONE SPACE
2$:	CMPB	#40,(R2)+	;IS CHARACTER A SPACE
	BNE	3$		;BR IF NOT A SPACE
	CMP	R1,R4		;HAVE WE FOUND A GOOD CHARACTER YET ?
	BEQ	222$		;IF NOT, SKIP THIS LEADING SPACE
	CMPB	#40,-1(R1)	;NOT A LEADING SPACE, MULTIPLE SPACES ?
	BNE	3$		;IF NOT MULTIPLE SPACES, STORE THIS SPACE
222$:	INC	R3		;SKIP THIS CHARACTER,COUNT SKIPPED CHARACTER
	BR	4$		;LOOK FOR NEXT CHARACTER
3$:	MOVB	-1(R2),(R1)+	;PACK CHARACTER OF COMMAND INTO BUFFER
	CMPB	-1(R1),#'(	;A LEFT PAREN ?
	BNE	37$		;BR IF NOT
	MOVB	#'[,-1(R1)	;CHANGE THE ( TO [ FOR SYNTAX
	BR	4$		;AND SKIP NEXT
37$:	CMPB	-1(R1),#')	;OR COULD BE A )
	BNE	4$		;SO SKIP TOO
	MOVB	#'],-1(R1)	;NO CHANGE ) TO ]
4$:	CMPB	-1(R1),#141	;LOWER CASE ?
	BLT	44$		;BR IF NOT
	BICB	#40,-1(R1)	;ELSE CONVERT TO UPPER CASE
44$:	CMP	R2,R5		;END OF BUFFER YET ?
	BNE	20$		;IF NOT FILLED KEEP GOING
	SUB	R3,R5		;ACCOUNT FOR IGNORED SPACES AND TABS
	SUB	R3,RSTAT+2	;AT THIS COUNTER ALSO
	MOV	#SPWDPB,DPBPTR	;SET FOR STANDARD DIRECTIVE
	CMPB	RSTAT+1,#15	;TERMINATED WITH CARRET ?
	BNE	276$		;BR IF NOT
	MOV	#RECDPB,DPBPTR	;IF SO, DIDDLE DPB ADDRESS
276$:	MOV	R4,R0		;ADDRESS OF BUFFER -> R0
	JSR	PC,CAT5		;CONVERT FIRST 3 CHAR OF NAME -> RAD50 (IN R1)
	BIT	#UT.LG,TERFLA	;IS THIS TERMINAL LOGGED ON ?
	BNE	5$		;BR IF HE IS
	CMP	HELRAD,R1	;NOT LOGGED ON, BETTER LET HIM RUN 'HELLO'
	BEQ	19$		;SO HE CAN LOG ON
	MOV	#PLSLO,R4	;PLEASE LOGON MESSAGE ADDR -> R4
	CLR	RSTAT+2		;CLEAR STATUS WORD
	MOV	HELRAD,VSDBLK+4
	BR	9$		;ASK HIM TO LOG ON
5$:	CMPB	#'@,(R4)	;IS FIRST CHAR ON LINE A '@' ?
	BNE	51$		;NO, GO ON
	MOV	ATRAD,R1	;YES SET TO REQUEST ...AT. DIRECTLY
	BR	66$		;AND GO THERE
51$:	CMP	LOGRAD,R1	;DOES HE WANT TO LOG A MESSAGE (ON CL:) ?
	BEQ	18$		;IF SO LET HIM
	CMPB	#73,(R4)	;JUST A COMMENT LINE ?
	BEQ	18$		;SAME AS LOG !!
	CMPB	#41,(R4)	;LEADING ! ?
	BEQ	18$		;DO IT TOO
.PAGE
.SBTTL	CHECK FOR MFT, MASSAGE NAMES
19$:	MOV	#8.,R5		;SET TO CHECK FOR 8. MFT NAMES
	MOV	#MFTNAM,R4	;SET TO START OF MFT NAME TABLE
	MOV	MFTRAD,SPWDPB+S.PWTN+2 ;CHANGE REQUESTED TASK TO ...MFT
6$:	CMP	R1,(R4)+	;COMPARE REQ'D TASK WITH MFT TASK
	BEQ	7$		;BR IF WE MATCH
	SOB	R5,6$		;LOOP TILL 8. NAMES CHECKED
				;NOW CHECK FOR 14. MASSAGE NAMES, LAST 4 ARE
				;DUMMIES WHICH CAN BE CHANGED VIA A ONE-WORD
				;ZAP TO ADD MFT FUNCTIONS WITHOUT CHANGING MCR
				;SEE MASNAM TABLE
	MOV	#14.,R5		;SET LOOP COUNT FOR 14. MASSAGE NAMES
	MOV	#MASNAM,R4	;SET TO START OF MASSAGE NAME TABLE
	MOV	MASRAD,SPWDPB+S.PWTN+2 ;CHANGE REQUESTED TASK TO ...MAS
666$:	CMP	R1,(R4)+	;COMPARE REQ'D TASK NAME WITH MASSAGE NAME
	BEQ	7$		;BR IF WE MATCH
	SOB	R5,666$		;ELSE TRY 7 MASSAGE NAMES
66$:	MOV	R1,SPWDPB+S.PWTN+2 ;PUT IN ACTUAL TASK NAME
7$:	MOV	.CRTSK,R0	;GET MY ATL AGAIN
	MOV	A.TI(R0),R0	;NOW HAVE PUD POINTER
	MOV	U.LBN(R0),R0	;NOW HAVE PRIVILEGE WORD IN R0
				;REQUESTED NAME (NOT MFT OR MAS) IN R1
	JSR	PC,PRICHK	;CHECK USERS PRIVILEGES
	TST	R0		;CAN HE DO THIS
	BPL	77$		;YES HE CAN
	MOV	#PRIMES,QOUT+Q.IOPL ;FILL IN MESSAGE THINGS
	MOV	#PRILEN,QOUT+Q.IOPL+2
	JMP	12$		;AND REPORT ERROR
.PAGE
.SBTTL	SPAWN THE TASK
77$:	MOV	...RAD,SPWDPB+S.PWTN ;FIRST PART TOO
	MOV	RSTAT+2,SPWDPB+S.PWCL ;PUT CMD LENGTH IS SPAWN DPB
78$:	DIR$	DPBPTR		;DO DIRECTIVE TO REQUEST TASK
	BCC	14$		;BR IF DIRECTIVE SUCCESSFUL
	CMPB	$DSW,#IE.INS	;IS ERROR TASK NOT INSTALLED ?
	BNE	21$		;IF NO, LET MCRERR HANDLE IT
	MOV	MASRAD,SPWDPB+S.PWTN+2 ;ELSE LET MASSAGE HANDLE THIS ONE
	BR	78$		;AND TRY AGAIN
21$:	MOV	#NODERR,QOUT+Q.IOPL ;INSETT MESS START IN PARAM LIST
	MOV	#NODERL,QOUT+Q.IOPL+2 ;AND MESSAGE LENGTH
	CMP	#-1,$DSW	;WAS ERROR INSUFFICIENT NODES ?
	BEQ	12$		;IF TRUE, BRANCH
	MOV	#ERRTAB,R5	;POINT R5 TO BYTE TABLE OF ERROR VALUES
	MOV	MCRRAD,VSDBLK+4 ;RAD50 'MCR' TO SEND REQ BLOCK (FOR MCRERR)
8$:	MOVB	(R5)+,R4	;FIRST/NEXT ERROR CODE -> R4
	BEQ	9$		;IF 0, FELL THROUGH TABLE
	CMPB	(R5)+,$DSW	;ERRORS MATCH ?
	BNE	8$		;TRY ANOTHER IF NOT
9$:	MOVB	R4,VSDBLK+0	;MATCH (OR FELL THROUGH) DSW OR 0 ->BLOCK
	MOVB	RSTAT+2,VSDBLK+1 ;QIO STATUS -> BLOCK
	BEQ	13$		;SKIP NEXT IF NO QIO WENT
	MOV	RSTAT+2,R3	;CHARACTER COUNT -> R3
	CMP	#22,R3		;CHECK CHARACTER COUNT
	BGE	10$		;BR IF CHAR COUNT < 18.
	MOV	#22,R3		;ELSE LIMIT IT TO 18
10$:	MOV	#VSDBLK+10,R4
	MOV	#READIN,R5	;RESTORE INPUT BUFFER ADDR -> R5
11$:	MOVB	(R5)+,(R4)+	;XFER BYTE OF MESSAGE
	SOB	R3,11$		;TILL DONE
13$:	MOV	...RAD,VSDBLK+2 ;INSERT RAD50 '...'
	DIR$	#SRQDPB		;REQUEST MCRERR TASK
	BR	15$
12$:	DIR$	#QOUT		;WRITE ERROR MESS
	BCS	15$		;BR IF DIRECTIVE FAILED
	TSTB	RSTAT		;CHECK QIO STATUS
	BMI	15$		;BR IF QIO FAILED
18$:	JMP	27$
14$:	CMPB	#15,RSTAT+1	;WAS TERMINATOR A CARRET ?
	BEQ	16$		;BR IF IT WAS
15$:	MOV	#1,QOUT+Q.IOPL+2 ;ELSE MAKE OUT QIO ONE CHARACTER
	CLR	QOUT+Q.IOPL+4	;NO CARRIAGE CONTROL
	DIR$	#QOUT		;PUT CAR. BACK TO MARGIN
16$:	EXIT$S			;SCRAM HERE
.PAGE
.SBTTL	CONVERT ASCII -> RAD 50
;
;THIS INTERNAL SUB REPLACES $CAT5 SO THAT IT CAN BE INCLUDED IN THE
;PURE CODE AREA OF MCR
;
;CALLING CONVENTION
;
;R0 POINTS TO ASCII BUFFER
;	WILL CONVERT NEXT THREE CHARACTERS.  '.' IS LEGAL AND ANY ILLEGAL
;	CHARACTERS WILL BE IGNORED (ALSO CONVERTS TO UPPER CASE)
;
;RETURN WITH
;R1 CONTAINING 3-CHARACTERS IN RAD 50
;R0 BUMPED PAST SAME 3 CHARACTERS
;
CAT5:	MOV	#3,R2		;LOOP COUNT TO R2
	CLR	R1		;CLEAR ANSWER AT START
LOOP:	MOVB	(R0)+,R3	;GET A CHARACTER
	CMPB	R3,#100		;AN '@' ?
	BEQ	RETURN		;IF SO WANTS INDIRECT MCR, SO RETURN
	BLT	4$		;IF LT, NOT ALPHA CHARACTER
	BIC	#40,R3		;CONVERT TO UPPER CASE
	SUB	#100,R3		;AND THEN TO RAD 50
	BR	25$		;AND DO CONVERSION
	;IGNORE '$','.', AND 'SPACE' SINCE THOSE SHOULDN'T BE IN TASK NAME
4$:	CMPB	R3,#'0		;BETTER BE A DIGIT IF NOT ALPHA
	BLT	23$
	CMPB	R3,#'9
	BGT	23$
	SUB	#22,R3		;CONVERT TO RAD-50 BASE
	BR	25$
23$:	CLR	R3		;BAD RAD-50 CHAR, SO IGNORE HIM
25$:	MUL	#50,R1		;MUL PREV CHARACTER BY BASE
	ADD	R3,R1		;ADD CURRENT CHARACTER
	SOB	R2,LOOP		;AND LOOP FOR 3 CHARACTERS
RETURN:	RTS	PC		;AND RETURN
.PAGE
.SBTTL	PURE ERROR DPB'S AND MESSAGES
SRQDPB:	VSDR$	MCRERR,,,,,VSDBLK	;SEND/REQUEST FOR MCRERR
NODERR:	.ASCII	<15>/MCR -- NO NODES/
	NODERL=.-NODERR
	.EVEN
PRIMES:	.ASCII	<15>/CURRENT USER PRIVILEGES DO NOT ALLOW THAT FUNCTION/
	PRILEN=.-PRIMES
	.EVEN
;
;LOCAL VALUES FOR ERROR TABLE
;OTHER VALUES (POSITIVE) ARE GLOBALS
IE.ACT=-7	;TASK NOT ACTIVE
IE.INS=-2	;TASK NOT INSTALLED
IE.HWR=-6	;HANDLER NOT RESIDENT
IE.ITS=-8.	;INCONSISTENT DIRECTIVE
ERRTAB:	;BYTE TABLE OF ERRORS
	.BYTE	NTINS		;TASK NOT INSTALLED
	.BYTE	IE.INS
	.BYTE	HNNRE		;HANDLER NOT RESIDENT
	.BYTE	IE.HWR
	.BYTE	TACTI		;TASK ALREADY ACTIVE
	.BYTE	IE.ACT
	.BYTE	DSABL		;TASK DISABLED
	.BYTE	IE.ITS
	.BYTE	UNKDI		;UNKNOWN DIRECTIVE
	.BYTE	0
.PAGE
.SBTTL	OTHER PURE CODE DATA
HELRAD:	.RAD50	/HEL/
BYERAD:	.RAD50	/BYE/
MCRRAD:	.RAD50	/MCR/
MFTRAD:	.RAD50	/MFT/
MASRAD:: .RAD50	/MAS/
LOGRAD:	.RAD50	/LOG/
...RAD:	.RAD50	/.../
ATRAD:	.RAD50	/AT./
MCIRAD:	.RAD50	/MCI/
PROMPT:	.ASCII	<15><12>/MCR>/<7>	;USER PROMPT STRING
	.EVEN
MFTNAM:	;TABLE OF POSSIBLE MFT TASK NAMES
	.RAD50	/ABOALTCANDISENAFIXRESUNF/
MASNAM:	;TABLE OF POSSIBLE MASSAGE TASK NAMES
	.RAD50	/PRITYPPURDIRBLORECFRESUB/
	.RAD50	/PROUNP/
MASPAT:: .WORD	0,0,0,0		;ROOM FOR 4 ADDED MASSAGE FUNCTIONS
.PAGE
.SBTTL	IMPURE CODE
VSDBLK:	.BLKW	13		;BUFFER FOR SEND/REQ TO MCRERR
				;READ C PROMPT AND TIME-OUT
QIN:	QIOW$	IO.RPR!TF.TMO,1,1,,RSTAT,,<READIN,80.,6,PROMPT,7>
QOUT:	QIOW$	IO.WLB,1,1,,,,<PROMPT,5,44>  ;ERROR REPORT QIO
RECDPB:	.WORD	-1
SPWDPB:	SPWN$	...MCR,,,,,,,,READIN,,
TERFLA:	.WORD	0	;STORAGE FOR TERMINAL FLAGS WORD
DPBPTR:	.WORD	0	;POINTER TO SPAWN DPB
RSTAT:	.BLKW	2
KLSTAT:	.BLKW	2
ACTCNT:	.WORD	0	;COUNT OF TASKS ACTIVE HERE FOR HOSTILE TERMINAL
READIN:	.BLKW	66.
	.END	START