.TITLE	LOGON
	.SBTTL	INTRO. PAGE
	.IDENT	/V02/
;
; FOLLOWING DEFINITION FOR IAS V3.0
;
IASV3	=1
	.MCALL	QIOW$,DIR$,FDBDF$,FDOP$A,FINIT$,GCMLB$,FSRSZ$,RQST$
	.MCALL	CMKT$,GTIM$,NMBLK$,CLOSE$,FDAT$R,FDOP$R,OPEN$R,GET$,GET$R
	.MCALL	FDAT$A,FDRC$A,GMCR$,OPEN$,FDRC$R,WTSE$S
	.IF	DF	IASV3
	.MCALL	SPWN$
	.IFF
	.MCALL	QIO$	MRKT$S
	.ENDC
;DISSASSEMBLY OF HEL
;ANNOTATION BY F. BORGER
;DEPT. OF MEDICAL PHYSICS
;MICHAEL REESE MEDICAL CENTER
;MARCH/76
;
;MAIN PURPOSE OF DISASSEMBLY TO MODIFY HELLO SO THAT IT
;SUPPORTS REESE VARIABLE DEFAULT DEVICE OPTION
;
;A/	...HEL NOW ACCESSES THE PDS USER PROFILE FILE TO READ AND COMPARE
;	USERNAME AND PASSWORD PROVIDED BY THE PERSON LOGGING ON. IF THE
;	COMPARISON IS SUCCESSFUL ...HEL WILL:
;
;B/	RESET THE USER'S UIC AND DEFAULT DEVICE AS SPECIFIED IN THE USER
;	PROFILE FILE. IN ADDITION HE WILL
;
;C/	SET THE PRIVILEGE WORD FROM THE USER PROFILE FILE INTO LOCATION
;	U.LBN OF THE TI PUD AND WILL SET HOSTILE AND PRIVILEGED BITS IN
;	U.TF OF THE PUD AS SPECIFIED FROM THE APPROPRIATE BIT FLAGS OF
;	THE PRIVILEGE WORD
;
;D/	TO BE MORE TIME-SHARING LIKE, ...HEL NOW
;	1/ PUTS OUT A STANDARD 2 LINE LOG ON MESSAGE OF THE FORM
;		MEDICAL PHYSICS COMPUTER SYSTEM
;		NN-MON-YR HH:MM:SS
;	2/ ATTEMPTS TO OUTPUT STANDARD MESSAGE FILE [1,1]HELLO.LOG
;	   TO THE TERMINAL AFTER SUCCESSFUL LOG ON
;
;	3/ ATTEMPTS TO OUTPUT USERS MESSAGE FILE [USERS UIC]HELLO.LOG
;	   TO THE TERMINAL AFTER THE STANDARD HELLO.LOG FILE
;
;
;E/	MODIFIED TO SUPPORT () AS WELL AS [] IN UIC SPEC
;
;F/	28-JUN-78 MODIFIED FOR IAS V3.0 BY L.S.
;
;G/	WILL LOOK FOR OPTIONAL COMMAND LINE IN [1,100]AUTOSTART.DAT
;		"XXXXXXXXXXXXNNNNNNNNNNNNNNN...."
;	WHERE XXXXXXXXXXXX IS A 12 CHARACTER USER NAME
;	      NNNNNNNNN.. IS A MCR COMMAND
;	IF HE FINDS A MATCH TO THE USER NAME HE WILL EXECUTE THE MCR COMMAND
;	LINE INSTEAD OF CALLING MCR. THIS PROVIDES AUTOMATIC LOG ON AND EXEC-
;	UTION OF A GIVEN PROGRAM (A MENU SELECTION PROGRAM FOR EXAMPLE)
;
;H/	06-JUN-85 MODIFIED TO ACCEPT LOWER CASE, F.B.
;
;DEFINE SOME VARIABLES HERE
UT.HO=10	;REESE HOSTILE TERMINAL
PR.MCR=2000	;REESE PRIV FLAG FOR HOSTILE TERMINAL
PR.RTC=100000	;REESE FLAG FOR MAKE HIM PRIV. USER
;
.PAGE
.SBTTL	PURE DATA AREA 
;
	.PSECT	PURE
	.enable	lc				;VARIOUS ASCII MESSAGES
PWDPRM:	.ASCII	<12><15>/Password>/
	PWDLEN=.-PWDPRM
;
;
BADPWD:	.ASCII	/HEL -- Illegal Password/
	BADPWL=.-BADPWD
;
;
NAMPRM:	.ASCII	<12><15>/User Name> /
	NAMLEN=.-NAMPRM
;
;
SYNBAD:	.ASCII	/HEL -- Syntax Error/
	SYNBAL=.-SYNBAD
	.EVEN
;
;
READBA:	.ASCII	/HEL  -- Logon Disabled/
	READBL=.-READBA
	.EVEN
;
;
	;DIRECTIVE TO REPORT DIRECTORY ENTRY READ FAILURE
RDFDIR:	QIOW$	IO.WVB,5,1,,IOSTAT,,<READBA,READBL,44>
;
;ASCII MESSAGE FOR DIRECTIVE FAILURE
DIRBAD:	.ASCII	/HEL -- Directive Failure/
	DIRBAL=.-DIRBAD
	.EVEN
NODIR:	.ASCII	/HEL -- Non Existent User Name/
	NODIRL=.-NODIR
;TABLE OF DAY NAMES
daytab:	.ASCII	/Sunday    Monday    Tuesday   Wednesday Thursday  /
	.ASCII	/Friday    Saturday  /
	.EVEN
	.EVEN
;
;
	;DIRECTIVE TO REPORT FAILURE OF SOME OTHER DIRECTIVE
DFADIR:	QIOW$	IO.WVB,5,1,,IOSTAT,,<DIRBAD,DIRBAL,44>
;
;
;DIRECTIVE TO REPORT NON-EXISTENT ACCOUNT
DIRDPB:	QIOW$	IO.WVB,5,1,,IOSTAT,,<NODIR,NODIRL,44>
;
;
;DIRECTIVE TO PUT OUT STANDARD 2-LINE SYSTEM HEADER
MSGDIR:	QIOW$	IO.WVB,5,1,,IOSTAT,,<MSGONE,MSGLEN,40>
;
;
	;DIRECTIVE TO ISSUE 'PASSWORD>' PROMPT
PWDDIR:	QIOW$	IO.RPR!TF.TMO!TF.RNE,5,1,,IOSTAT,,<PDSBUF,80.,3,PWDPRM,PWDLEN>
;
;
	;DIRECTIVE TO REPORT SYNTAX ERROR
SYNDIR:	QIOW$	IO.WVB,5,1,,IOSTAT,,<SYNBAD,SYNBAL,44>
;
;
	;DIRECTIVE TO REPORT WRONG PASSWORD
ILLDIR:	QIOW$	IO.WVB,5,1,,IOSTAT,,<BADPWD,BADPWL,44>
;
;
	;DIRECTIVE TO READ USER NAME (WITH PROMPT)
USNDIR:	QIOW$	IO.RPR!TF.TMO,5,1,,IOSTAT,,<PDSBUF,80.,3,NAMPRM,NAMLEN>
;
;TABLE OF ASCII MONTHS
MONTAB:	.ASCII	/JanFebMarAprMayJunJulAugSepOctNovDec/
;
;DIRECTIVE TO GET SYSTEM TIME
GETTIM:	GTIM$	TIMBUF
REQMCR:	RQST$	...MCR		;TRY TO GET MCR BACK
	.IF	NDF	IASV3
REQBYE:	RQST$	...BYE
	.ENDC
ONEONE:	.ASCII	/[1,1]/
	ONELEN=.-ONEONE
	.EVEN
ONEHUN:	.ASCII	/[1,100]/
	HUNLEN=.-ONEHUN
	.EVEN
			;IN PDSUPF FILE
.PAGE
.SBTTL	IMPURE STORAGE AREA
	.PSECT	
PDSBUF:	.BLKB	200		;PDS RECORD
				;ALSO USED FOR GENERAL IO THINGS
	FSRSZ$	1
FDB:	FDBDF$			;DEFINE FDB FOR USER PROFILE FILE
	FDOP$A	4,,PDSDFN,FO.RD	;SET LUN
	FDAT$A	R.FIX,,100
	FDRC$A	FD.RAN,PDSBUF,100
PDSDFN:	NMBLK$	PDSUPF,DAT
AUTFDB:	FDBDF$			;DEFINE FDB
	FDOP$A	4,,AUTDFN,FO.RD	;SET LUN
	FDAT$A	R.VAR,,100
	FDRC$A	,PDSBUF
AUTDFN:	NMBLK$	AUTOSTART,DAT
TIMBUF:	.BLKW	8.		;BUFFER TO RECEIVE SYSTEM TIME INFO
DATSET:	.WORD	0		;DATA SET DESCRIPTOR
	.WORD	0
UICSIZ:	.WORD	0		;UIC DESCRIPTOR (SIZE)
UICSTA:	.WORD	0		;AND START ADDRESS
	.WORD	0		;DEFAULT FILE NAME DESCRIPTOR
	.WORD	0
	.BLKW	3
R50USN:	.BLKW	4		;SLOT TO STORE RAD50 USER NAME READ IN
R50PWD:	.BLKW	2		;LIKEWISE FOR PASSWORD
UIC:	.WORD	0		;OCTAL VALUE OF UIC STRING
MODULO:	.WORD	0		;MODULO OF UIC STRING (8. OR 10.)
PRIFLA:	.WORD	0		;FLAG FOR PRIVILEDGED UIC
IOSTAT:	.BLKW	4
DFDEV:	.WORD	0		;DEFAULT DEVICE ASCII STRING
DFUNIT:	.WORD	0		;DEFAULT UNIT NUMBER (OCTAL)
ERRFLG:	.WORD	0		;ERROR FLAG FOR FCS
ONEFLG:	.WORD	0		;FLAG FOR [1,1]HELLO.LOG ALREADY TRIED
FCCFLG:	.WORD	0		;FLAG THAT FILE HAS FORTRAN CARR CONTROL
FIRSTU:	.WORD	0		;RECORD NUMBER OF FIRST USER REOCRD IN PDSUPF
GMCR:	GMCR$
;
;QIO DPB TO WRITE HELLO.LOG FILE TO TI:
XFRDPB:	QIOW$	IO.WVB,5,1,,IOSTAT,,<PDSBUF,0,40>
	.IF	DF	IASV3
SPWDIR:	SPWN$	...BYE,,,,,2
	.IFF
MCDIR:	QIO$	IO.WVB,2,,,,,<0,0>
	.ENDC
;
;STANDARD HEADER MESSAGE HERE CAUSE WE WRITE TIME INTO IT
MSGONE:	.ASCII	<12><15>/Radiation Therapy Computer System/<12><15>
MSGTWO:	.ASCII	/                            /
	MSGLEN=.-MSGONE
	.EVEN
NAMBLK:	NMBLK$	HELLO,LOG		;DEFINE FILE NAME FOR MESSAGE FILE
.PAGE
.SBTTL	START OF ACTIVE (PURE) CODE
	.PSECT	PURE
SYNJMP:	JMP	SYNERR		;BRANCH AID NEEDED BECAUSE OF ADDED CODE
START:	MOV	.CRTSK,R0	;MY ATL POINTER IN R0
	MOV	PS.EXP,-(SP)		;SAVE OLD STATUS
	BIS	#140,PS.EXP		;DISABLE TSK SW SO ATL NOT RELINKED
	MOV	.ATLLH,R1	;START OF ATL IN R1
1$:	MOV	(R1),R1		;GET NEXT OR FIRST ATL ENTRY
	CMP	R0,R1		;IS THIS ME
	BEQ	1$		;SKIP IF IT IS
	CMP	R1,.ATLLH+2	;OR ARE WE THROUGH ATL ?
	BEQ	2$		;YES CAN SAFELY RUN
	CMP	A.TD(R0),A.TD(R1) ;NO IS THIS ANOTHER ...HEL ?
	BNE	1$		;NO
	CMP	A.TI(R0),A.TI(R1) ;YES IS TI THE SAME ?
	BNE	1$		;NO TRY AGAIN
	JSR	PC,..ENB0	;NOW RE-ENABLE TASK SWITCHING
	JMP	SCRAM		;HEL ALREADY ACTIVE SO SCRAM RIGHT NOW
2$:	JSR	PC,..ENB0	;NO OTHER HEL, RE-ENABLE TASK SWITCHING
	JSR	PC,.FINIT	;INIT FSR AREA
	MOV	A.TI(R0),R0	;TI PUD -> R0
	MOVB	U.UN(R0),R3	;UNIT # -> R3
	MUL	#20.,R3		;OFFSET INTO COMMON -> R3
	ADD	#HELBYE,R3	;ADD IN BASE
	TST	(R3)		;ANYONE PREVIOUSLY LOGGED IN?
	BEQ	4$		;IF NOT, BRANCH
	.IF	DF	IASV3
	DIR$	#SPWDIR		;IF SO, REQUEST ...BYE
	WTSE$S	#2		;WAIT FOR BYE TO FINISH
	.IFF
	DIR$	#REQBYE		;REQUEST ...BYE
3$:	MRKT$S	#2,#15.,#1	;WAIT FOR 15. TICKS
	WTSE$S	#2
	TST	(R3)		;IS BYE DONE YET?
	BNE	3$		;IF NOT, GO WAIT AGAIN
	.ENDC
4$:
	.SBTTL	OUTPUT STANDARD HEADER LINE
DOMKT:
	MOV	#ONEHUN,R2	;SET UP ADDRESS AND
	MOV	#HUNLEN,R1	;LEN FOR DEFAULT DIRECTORY
	JSR	PC,.WDFDR	;AND WRITE IT
	DIR$	#GETTIM		;GET SYSTEM TIME
	MOV	#MSGTWO,R0	;POINT TO ASCII OUTPUT BUFFER
	MOV	#TIMBUF,R1	;POINT TO TIME BUFFER
	JSR	PC,DAYOFW	;CALC DAY OF WEEK
	MUL	#10.,R1		;MAKE R1 OFFSET
	ADD	#DAYTAB,R1	;INT ASCII DAY TABLE
	MOV	#10.,R2		;COUNTER
111$:	MOVB	(R1)+,(R0)+	;FILL IN DAY OF WEEK
	SOB	R2,111$
	CLR	R2		;SUPPRESS LEADING ZEROES
	MOV	TIMBUF+4,R1	;GET DAY IN R1
	JSR	PC,$CBDMG	;CONVERT TO ASCII
	MOVB	#'-,(R0)+	;INSERT A "-"
	MOV	TIMBUF+2,R1	;GET MONTH IN R1
	DEC	R1		;ADJUST TO BASE 0
	MUL	#3,R1		;CONVERT TO 3-BYTE OFFSET
	ADD	#MONTAB,R1	;ADD BASE OF MONTH TABLE
	MOVB	(R1)+,(R0)+	;XFR 3-CHAR MONTH
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOVB	#'-,(R0)+	;INSERT A "-"
	CLR	R2		;SUPPRESS LEADING ZEROES
	MOV	TIMBUF,R1	;NOW GET YEAR
	JSR	PC,$CBDMG	;CONVERT TO ASCII
	INC	R0		;SKIP OVER A SPACE
	MOV	#3,R4		;SET TO LOOP FOR HOUR,MIN,SEC
	MOV	#TIMBUF+6,R5
11$:	MOV	(R5)+,R1	;NUMBER IN R1
	CMP	R1,#10.		;2-DIGIT NUMBER ?
	BGE	12$		;SKIP IF IT IS
	MOVB	#'0,(R0)+	;PUT IN A '0' SO IT'S NEAT
12$:	JSR	PC,$CBDMG	;CONVERT TO ASCII
	MOVB	#':,(R0)+	;INSERT A ":"
	SOB	R4,11$		;LOOP FOR 3 TIMES
	MOVB	#' ,-(R0)	;ERASE LAST ":"
	DIR$	#MSGDIR		;OUTPUT HEADER LINE
	.PAGE
	.SBTTL	DO SIGN ON DIALOG
;
; START OF DIALOG
;
DIALOG:
	DIR$	#GMCR		;GET MCR COMMAND LINE
	MOV	@#$DSW,R4	;LEN OF LINE -> R4
	BMI	3$		;IF NOT THERE, GO PROMPT
	MOV	#GMCR+G.MCRB,R3	;ADDRESS -> R3
1$:	MOVB	(R3)+,R2	;NOW LOOK FOR
	CMPB	R2,#40		;SPACE OR
	BEQ	2$		;TAB
	CMPB	R2,#11		;IF FOUND,
	BEQ	2$		;GO CHECK
	SOB	R4,1$		;
	BR	3$		;IF NO DELIMITER, PROMPT
2$:	DEC	R4		;KNOCK OFF COUNT FOR SPACE OR TAB
	BGT	4$		;IF WE STILL HAVE SOMETHING, BRANCH
3$:	DIR$	#USNDIR		;GET USER NAME
	MOV	#PDSBUF,R3	;ADDRESS OF LINE -> R3
	MOV	IOSTAT+2,R4	;LEN -> R4
	CMP	R4,#1		;IF NOTHING THERE
	BGE	4$		;scram
	JMP	SCRAM		;
4$:	JSR	PC,SKIP		;FIND FIRST NON-BLANK
	JSR	PC,CONVT	;CONVERT POSSIBLE LOWER CASE
	MOV	#R50USN,R0	;START OF SLOT TO STORE RAD50 USER NAME
	MOV	#4,R1		;# OF WORDS -> R1
5$:	CLR	(R0)+		;CLEAR IT OUT
	SOB	R1,5$
	MOV	#4,-(SP)	;COUNT OF WORDS ON STACK
	MOV	#R50USN,R5	;ADDRESS AGAIN -> R5
	MOV	R3,R0		;ADDRESS OF INPUT TEXT -> R0
6$:	CLR	R1		;NO PERIODS TO BE INCLUDED
	JSR	PC,$CAT5	;CONVERT 1ST 3 CHARS
	MOV	R1,(R5)+	;SAVE IT
	BCS	7$		;IF TERMINATED EARLY, BRANCH
	MOV	R0,R3		;UPDATE OUT TEXT PTR
	SUB	#3,R4		;AND REMAINING COUNT
	BLE	7$		;IF NOTHING LEFT, BRANCH
	DEC	(SP)		;DECREMENT COUNT ON STACK
	BGT	6$		;IF STILL PLUS, GO AROUND AGAIN
	MOVB	(R3)+,R2	;NEXT CHAR -> R2
	DEC	R4		;DECREMENT REMAINING COUNT
	BR	8$
7$:	SUB	R0,R4		;UPDATE REMAINING COUNT
	ADD	R3,R4
	MOV	R0,R3		;AND PTR TO REST OF LINE
8$:	TST	(SP)+		;POP COUNTER ON STACK
	CMPB	R2,#40		;LOOK FOR NEXT
	BEQ	9$		;ENTRY - DELIMITED
	CMPB	R2,#11		;BY SPACE OR
	BNE	10$		;TAB
9$:	TST	R4		;IF STILL SOMETHING THERE,
	BGT	11$		;USE IT
10$:	CLR	PDSBUF		;CLEAR OUT CAUSE IF USER NAME
	CLR	PDSBUF+2	;IS LONGER THAN PASSWORD, OLD
	CLR	PDSBUF+4	;USER NAME SCREWS UP PASSWORD
	DIR$	#PWDDIR		;ELSE PROMPT FOR PASSWORD
	MOV	#PDSBUF,R3	;AND SET UP ADDRESS
	MOV	IOSTAT+2,R4	;AND LEN OF PASSWORD STRING
	CMP	R4,#1		;SOMETHING THERE ?
	BGE	11$		;BR IF YES
	JMP	SCRAM		;ELSE QUIT
11$:	JSR	PC,SKIP		;SKIP LEADING BLANKS
	JSR	PC,CONVT	;CONVERT POSSIBLE LOWER CASE
	CLR	R50PWD		;CLEAR OUT SPACE FOR RAD50 PASSWORD
	CLR	R50PWD+2
	MOV	R3,R0		;SET UP FOR RAD50 CONVERSION
	CLR	R1		;NO PERIODS!
	JSR	PC,$CAT5	;DO CONVERSION
	MOV	R1,R50PWD	;PUT IN 1ST PART OF RESULT
	BCS	12$		;IF ENDED ALREADY, BRANCH
	CLR	R1
	JSR	PC,$CAT5	;CONVERT SECOND HALF
	MOV	R1,R50PWD+2	;AND PUT IT AWAY
12$:
	.PAGE
	.SBTTL	ACCESS USER PROFILE FILE & CHECK PASSWORD
;
; FINISHED DIALOG
; NOW ACCESS PDSUPF
;
PDSACC:
	OPEN$	#FDB		;OPEN UP PDSUPF.DAT
	BCC	9$		;IF OK, BRANCH
	JMP	REAFAI		;ELSE PRINT NO LOGIN MESSAGE
9$:	GET$R	,,,#1		;GET FIRST RECORD OF PDSUPF FILE
	MOV	PDSBUF,FIRSTU	;SAVE RECORD NUMBER OF FIRST USER
	MOV	#2,R1		;RECORD NUMBER OF START OF NAME TABLE
4$:	GET$R	,,,R1		;GET RECORD WITH RECORD # -> R1
	MOV	R0,-(SP)	;SAVE FDB PTR
	MOV	#PDSBUF,R3	;ADDRESS OF RECORD -> R3
	MOV	#10,R2		;COUNT -> R2
3$:	MOV	#4,R0		;# OF WORDS TO CHECK -> R0
	MOV	#R50USN,R4	;ADDRESS OF READ-IN PASSWORD -> R4
	MOV	R3,R5		;START OF USER NAME FROM PDSUPF -> R5
1$:	CMP	(R5)+,(R4)+	;CHECK ON ON DISK VS
	BNE	2$		;ONE WE READ
	SOB	R0,1$
	BR	5$		;IF MATCH, FOUND IT (BRANCH)
2$:	ADD	#10,R3		;OFFSET TO NEXT NAME
	SOB	R2,3$		;AND KEEP SEARCHING
	INC	R1		;IF NOT IN THIS RECORD,
	MOV	(SP)+,R0	;TRY ANOTHER
	CMP	R1,FIRSTU	;UNTIL END OF USER NAMES
	BLT	4$
	JMP	DIRFAI		;ELSE NO SUCH USER
5$:	SUB	#2,R1		;MAKE REC # RELATIVE TO FIRST NAME TABLE RECORD
	ASH	#3,R1		;CONVERT TO A RELATIVE USER NUMBER
	ADD	FIRSTU,R1	;ADD IN REC # OF FIRST PROFILE
	NEG	R2		;CALC POSITION WITHIN
	ADD	#10,R2		;RECORD AND ADD TO REC #
	ADD	R2,R1		;FOR PROFILE.
	GET$R	(SP)+,,,R1	;GET PROFILE RECORD
	CLOSE$			;THAT'S ALL FOR PDSUPF.DAT!
	MOV	PDSBUF+12,R2	;COM OF PASSWORD -> R2 (1ST PART)
	XOR	R2,R50PWD	;EXCLUSIVE OR (SHOULD BE -1)
	INC	R50PWD		;SO MAKE ZERO
	BNE	6$		;IF NOT, BAD PASSWORD
	MOV	PDSBUF+14,R2	;SECOND HALF OF PWD -> R2
	XOR	R2,R50PWD+2	;DO SAME THING AGAIN
	INC	R50PWD+2
	BEQ	7$
6$:	JMP	ILLPWD		;GO REPORT BAD PASSWORD
	.PAGE
	.SBTTL	WRITE START TIME IN HELBYE
	.SBTTL	RESET DEFAULT DEVICE
	.SBTTL	SET HOSTILE & PRIVILEGED FLAGS
;
; PASSWORD CHECKED OK
;
7$:	MOV	PDSBUF+10,UIC	;SAVE UIC
	CMPB	UIC+1,#10	;CHECK FOR PRIVILEGED ACCOUNT
	BHI	8$		;IF NOT, BRANCH
	BIS	#UT.PR,PRIFLA	;ELSE SET PRIVILEGE
8$:
PWDOK:	MOV	.CRTSK,R5	;GET MY ATL INDICATOR
	MOV	A.TI(R5),R5	;GET MY TI INDICATOR
	MOV	UIC,U.UI(R5)	;NEW UIC TO TI PUD
	.IF	DF	IASV3
	MOV	UIC,SPWDIR+S.PWPC ;SET PROPER UIC
	.ENDC
	BIS	#UT.LG,U.TF(R5)	;SAY I'M LOGGED ON
	MOV	U.DACP(R5),REQMCR+R.QSTN+2 ;CHANGE MCR REQUEST TO CORRECT CLI
	BIC	#UT.PR!UT.HO,U.TF(R5)	;CLEAR PRIV. AND HOSTILE BITS
	BIS	PRIFLA,U.TF(R5)	;MAKE ME PRIVILEDGED ONLY IF GROUP <= 10
	MOV	PDSBUF+20,U.LBN(R5) ;PUT PDS PRIVILEDGE IN PUD FOR MCR ACCESS
	BIT	#PR.RTC,U.LBN(R5) ;OVER-RIDE PRIVILEGED BIT BY UIC ?
	BEQ	112$		;NO
	BIS	#UT.PR,U.TF(R5)	;YES
112$:	BIT	#PR.MCR,U.LBN(R5) ;SHOULD HE BE HOSTILE ?
	BNE	111$		;NO
	BIS	#10,U.TF(R5)	;YES, MAKE HOSTILE
111$:	MOVB	U.UN(R5),R3	;UNIT # -> R3
	MUL	#20.,R3		;SLOT OFFSET -> R3
	ADD	#HELBYE,R3	;NOW POINTING TO OUR SLOT IN COMMON
	MOV	#TIMBUF,R0	;POINT TO TIME PARAMS
	MOV	#10,R2		;10(8) WORDS TO XFER
2$:	MOV	(R0)+,(R3)+	;DO IT
	SOB	R2,2$
	MOV	R1,(R3)+	;RECORD # FOR PDSUPF
	.PAGE
	.SBTTL	FILL IN DEFAULT DEVICE INFO
;
;	ADDED CODE TO SUPPORT DEFAULT DEVICE INFO
	MOV	R5,-(SP)	;SAVE TI PUD POINTER
	MOV	PDSBUF+50,DFDEV	;STORE DEFAULT DEVICE ASCII NAME
1$:	MOVB	PDSBUF+52,DFUNIT ;STORE DEFAULT UNIT NUMBER
	BIC	#60,DFUNIT	;CHANGE IT FROM ASCII TO OCTAL
RECHK:	MOV	.PUDBA,R5	;FIRST PUD ADDRESS -> R5
CKPUD:	CMP	(R5),DFDEV	;ASCII DEVICE NAME SAME ?
	BEQ	333$		;BR IF THE SAME
222$:	JMP	NOMAT		;ELSE AN ERROR
333$:	CMPB	2(R5),DFUNIT	;UNIT NUMBERS SAME ?
	BNE	222$		;BR IF NOT
	JSR	PC,..REDT	;FOUND PUD, GO THROUGH REDIRECT CHAIN
				;TO BE COMPATIBLE WITH REESE VERS 6.2
				;IF SY: IS REDIRECTED TO ITSELF, REPLACE
				;IT BY DP:
	CMP	(R5),#"SY	;IS IT STILL SY: AFTER REDIRECT ?
	BNE	444$
	MOV	#"SD,DFDEV	;CHANGE ASCII DEFAULT DEVICE TO DP:
	CLR	DFUNIT		;A PSEUDO COULD BE REDIRECTED TO SY
	BR	RECHK		;AND DO PUD SEARCH AGAIN
444$:	MOV	R5,R0		;PUD POINTER -> R0
	MOV	(SP)+,R5	;RESTORE TI PUD POINTER
	MOV	R0,U.LBH(R5)	;STORE DF DEV PUD POINTER IN TI PUD FOR
	JMP	DOHEL		;GUY NOW LOGGING ON
;
;
NOMAT:	ADD	#U.SZ,R5	;BUMP R5 TO NEXT PUD ENTRY
	CMP	R5,.PUDEA	;AT END OF PUD ?
	BHIS	NODFDV		;DIDN'T FIND PUD, USE SY AS DEFAULT
	JMP	CKPUD		;ANOTHER PUD EXISTS, CHECK IT
NODFDV:	;NO DEFAULT DEVICE, OR COULDN'T FIND PUD
	MOV	#"SD,DFDEV	;CHANGE DEFAULT DEVICE TO SD
	CLR	DFUNIT		;AND CLEAR UNIT NUMBER
	JMP	RECHK		;AND LOOK FOR SY PUD
.PAGE
.SBTTL	OUTPUT HELLO.LOG FILE(S)
;
;
;FIRST TRY TO TRANSFER FILE NAMED 'HELLO.LOG' (UNDER [1,1]) TO TERMINAL
;
DOHEL:	MOV	#FDB,R0		;SET UP R0 FOR FILE ACCESS
	MOV	#ONEONE,R2	;POINT R2 TO '[1,1]' ASCII STRING
	MOV	#ONELEN,R1	;LENGTH OF STRING -> R1
	JSR	PC,.WDFDR	;RESET DEFAULT UIC DIRECTORY
	FDAT$R	,#R.VAR,#FD.CR	;RESET FILE ATTRIBUTES
	FDRC$R	,#0,#PDSBUF,#80.	;CLEAR RANDOM ACCESS FILE ATTRIBUTE
REGO:	FDOP$R	,#4,,#NAMBLK,#FO.RD	;OPEN BY DEFAULT FILE NAME BLOCK
	OPEN$R	,#4,,,,,ERR	;OPEN FILE, IF ERROR ASSUME NO FILE
	TST	ERRFLG		;DID IT GO ?
	BNE	NOFIL		;BR IF ERROR (PROBABLY NO FILE)
	MOV	#40,XFRDPB+Q.IOPL+4 ;RESET SOME THINGS (COULD BE SECOND FILE)
	MOV	#PDSBUF,XFRDPB+Q.IOPL
	CLR	FCCFLG
	BITB	#FD.CR,FDB+F.RATT ;STANDARD CARRIAGE CONTROL ?
	BNE	GET		;IF SO SKIP NEXT
	CLR	XFRDPB+Q.IOPL+4	;ELSE INDICATE IMBEDDED CARRIAGE CONTROL
	BITB	#FD.FTN,FDB+F.RATT ;FORTRAN CARRIAGE CONTROL ?
	BEQ	GET
	INC	FCCFLG		;SHOW FLAG FOR LATER USE
	INC	XFRDPB+Q.IOPL	;AND START OUTPUT XFR PAST CAR CONT CHARACTER
GET:	GET$	,#PDSBUF,#80.,ERR ;READ A RECORD, IF ERROR ASSUME EOF
	TST	ERRFLG		;CHECK FOR ERRORS
	BNE	ENDFIL		;ASSSUME ERROR WAS END OF FILE
	MOV	FDB+F.NRBD,XFRDPB+Q.IOPL+2 ;FILL IN RECORD LENGTH IN QIO DPB
	TST	FCCFLG		;IS THIS FORTRAN CARRIAGE CONTROL ?
	BEQ	11$		;SKIP IF NOT
	MOVB	PDSBUF,XFRDPB+Q.IOPL+4 ;TRANS CARR CONTROL CHAR TO DPB
	DEC	XFRDPB+Q.IOPL+2	;ACCOUNT FOR IT IN LENGTH
	BNE	11$		;BR IF STILL SOME CHARACTERS
	INC	XFRDPB+Q.IOPL+2	;IF 0 CHARACTERS, FAKE IT TO ONE
	CLRB	PDSBUF+1	;AND MAKE SURE IT ISN'T LEFT OVER FROM BEFORE
11$:	DIR$	#XFRDPB			;WRITE LINE TO TERMINAL
	BR	GET		;AND TRY FOR ANOTHER LINE
ENDFIL:	CLOSE$	#FDB		;IF END OF FILE, CLOSE IT
NOFIL:	TST	ONEFLG		;DID WE ALREADY TRY FOR THIS UIC ?
	BNE	ENDRUN		;IF SO EXIT CPU LEFT
	CMP	UIC,#401	;OR DID WE LOG IN UNDER 1,1 ?
	BEQ	ENDRUN		;ALSO EXIT
	MOV	#TIMBUF,R0	;USE TIME BUFFER FOR UIC CONVERSION
	CLR	R2		;INDICATE SUPRESS LEADING 0'S
	MOVB	#'[,(R0)+	;INSERT FIRST '['
	MOVB	UIC+1,R1	;GROUP CODE TO R1
	BIC	#177400,R1	;IN CASE ITS 200 OR MORE
	JSR	PC,$CBOMG	;CONVERT TO ASCII
	MOVB	#',,(R0)+	;INSERT THE ','
	MOV	UIC,R1		;GET USER CODE
	BIC	#177400,R1	;CLEAR OUT UPPER BYTE
	JSR	PC,$CBOMG	;CONVERT USER CODE
	MOVB	#'],(R0)+	;FINISH OFF THE UIC STRING
	MOV	R0,R1		;END IN R1
	SUB	#TIMBUF,R1	;MINUS START = LENGTH
	MOV	#TIMBUF,R2	;START IN R2
	MOV	#FDB,R0		;PUT FDB ADDR BACK IN R0
	JSR	PC,.WDFDR	;WRITE UIC STRING IN FDB
	INC	ONEFLG		;SHOW WE DID THIS ONCE
	CLR	ERRFLG		;AND CLEAR PREV NOFILE OR ENDFILE FLAG
	BR	REGO		;AND LOOK FOR HELLO.LOG UNDER [1,1]
	.PAGE
	.SBTTL	TRY TO ACCESS AUTOSTART FILE
ENDRUN:
	MOV	#ONEHUN,R2	;SET TO RESET DEFAULT UIC TO 
	MOV	#HUNLEN,R1	;1,100 AGAIN
	JSR	PC,.WDFDR
	OPEN$	#AUTFDB		;OPEN AUTORSTART FILE FDB
	BCS	22$		;JUST DO MCR ON ERROR
3$:	GET$	#AUTFDB,#PDSBUF,#80.,22$ ;GET A RECORD, ON ERROR ASSUME END
	MOV	#PDSBUF,R0	;TEXT POINTER TO R0
	MOV	#R50USN,R5	;RAD 50 USERNAME BUFFER AT R5
	MOV	#4,R4		;SET TO CHECK 4-WORD NAME
33$:	CLR	R1		;'.' NOT VALID RAD50 CHARACTER
	JSR	PC,$CAT5	;CONVERT 3-CHAR NAME TO RAD-50
	CMP	R1,(R5)+	;COMPARE OUR USER, FILE USER
	BNE	3$		;IF NO MATCH, TRY NEXT LINE IN FILE
	SOB	R4,33$		;CHECK 4 NAMES
	MOV	#PDSBUF+12.,R0	;POINT R0 PAST 12 CHARACTER USER NAME
	MOV	AUTFDB+F.NRBD,R1 ;GET LAST RECORD SIZE
	ADD	#PDSBUF,R1	;POINT PAST LAST CHAR OF RECORD
	SUB	R0,R1		;NOW HAVE LENGTH OF COMMAND
	MOV	R0,-(SP)	;SAVE CMD START POINTER
	CLOSE$	#AUTFDB		;CLOSE COMMAND FILE
	MOV	(SP)+,R0	;RESTORE CMD POINTER
	BR	4$		;AND TRY TO EXECUTE
22$:	CLOSE$	#AUTFDB		;NO COMMAND IN FILE, SO CLOSE IT
	DIR$	#REQMCR		;AND REQUEST MCR
	BR	SCRAM		;AND GIT
4$:	;MATCHED USERS NAME IN AUTOSTART FILE
	MOV	.CRTSK,R5	;GET MY ATL ENTRY -> R5
	MOV	#77406,-(SP)	;SET UP STACK FOR RE-MAP
	MOV	A.HA(R5),-(SP)	;HEADER ADDRESS ON STACK
	JSR	PC,..SPD3	;NOW DO THE RE-MAP
	MOV	UIC,60000+H.UIC	;PUT AWAY THE NEW UIC
	BIC	#HF.RMC,60000+H.EAF ;CLEAR MY MCR RECALL FLAG
	JSR	PC,..SPD3	;NOW CLEAN UP
	ADD	#4,SP
;
	.IF	DF	IASV3
	MOV	R0,SPWDIR+S.PWCA	;PUT IN ADDRESS
	MOV	R1,SPWDIR+S.PWCL	;AND LENGTH OF COMMAND LINE
	CLR	R1
	JSR	PC,$CAT5		;CONVERT LINE
	MOV	(PC)+,R0	;PUT IN RAD50 FOR
	.RAD50	/.../			;...
	MOV	R0,SPWDIR+S.PWTN
	MOV	R1,SPWDIR+S.PWTN+2	;AND THREE LETTER TASK NAME
	DIR$	#SPWDIR			;DO IT
	.IFF
	MOV	R0,MCDIR+Q.IOPL		;ADDRESS
	MOV	R1,MCDIR+Q.IOPL+2	;AND LEN OF COMMAND STRING
	DIR$	#MCDIR			;GIVE COMMAND TO MC:
	.ENDC
	BR	SCRAM			;AND EXIT
;
;SUB FOR FCS ERRORS, JUST SET FLAG
ERR:	INC	ERRFLG		;SET FLAG
	RTS	PC		;AND RETURN
.PAGE
.SBTTL	VARIOUS ERROR EXITS
;
;
SYNERR:	DIR$	#SYNDIR		;REPORT SYNTAX ERROR
	BR	SCRAM		;AND LEAVE
REAFAI:	DIR$	#RDFDIR		;REPORT READ ATTRIBUTES FAILURE
	BR	SCRAM		;AND LEAVE
DIRFAI:	CMPB	#IE.NSF,F.ERR(R0)	;WAS ERROR PDS USER FILE DOESN'T EXIST ?
	BEQ	REAFAI		;YES - REPORT NO PDS USER FILE EXISTS
	DIR$	#DIRDPB		;NO - REPORT USER NAME NOT THERE
	BR	SCRAM
ILLPWD:	DIR$	#ILLDIR		;REPORT WRONG PASSWORD
	BR	SCRAM		;AND LEAVE
SCRAM:	MOV	#FDB,R0		;POINT TO FDB
	TST	F.BDB(R0)	;IS FILE OPEN ?
	BEQ	1$
	CLOSE$
1$:	MOV	#463,-(SP)	;AN EXIT DPB -> STACK
	EMT	377
.PAGE
.SBTTL	MISC. SUBROUTINES
;
; SUBROUTINE TO FIND NEXT NON-BLANK OR TAB
SKIP:
	MOVB	(R3)+,R2	;NEXT CHAR -> R2
	CMPB	R2,#40		;IS IT SPACE?
	BEQ	2$		;IF SO, BRANCH
	CMPB	R2,#11		;IS IT TAB?
	BEQ	2$		;IF SO, BRANCH
	DEC	R3		;IF NEITHER, WE FOUND IT, SO BACK UP
1$:	RTS	PC		;AND RETURN
2$:	DEC	R4		;BACK OFF THE COUNT
	BEQ	1$		;IF ZERO, RETURN
	BR	SKIP		;ELSE GO AROUND AGAIN
;
; SUBROUTINE TO CONVERT POSSIBLE LOWER CASE INPUT
CONVT:
	MOV	R3,-(SP)	;SAVE TEXT POINTER
	MOV	R4,-(SP)	;AND COUNT
1$:	CMPB	(R3)+,#140	;LOWER CASE
	BLO	2$		;BR IF NOT
	BICB	#40,-1(R3)	;CHANGE TO UPPER CASE
2$:	SOB	R4,1$		;DO ALL CHARACTERS
	MOV	(SP)+,R4	;RESTORE
	MOV	(SP)+,R3	;REGS
	RTS	PC
	.END	START