Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93h-bb - 7,6/ap020/qsrt10.x20
There are 4 other files named qsrt10.x20 in the archive. Click here to see a list.
	TITLE	QSRT10  --  TOPS10 Operating System Interface for QUASAR

;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1985,1986,1987.  ALL RIGHTS RESERVED.
;
;     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.

	SEARCH	QSRMAC,GLXMAC	;PARAMETER FILE
	SEARCH	ORNMAC		;ORION PARAMETER FILE.
	.DIRECT FLBLST

	PROLOGUE(QSRT10)	;GENERATE THE NECESSARY SYMBOLS

	QSRVRS==:QSRVRS		;REFERENCE QUASAR'S VERSION
	%%.QSR==:%%.QSR		;AND QSRMAC'S

	IFE FTUUOS,<	
			PASS2		;DONT'T BOTHER FOR A TOPS-20 ASSEMBLY
			END
		   > ;END OF IFE FTUUOS

	SEARCH	ACTSYM		;GET ACCOUNTING SYMBOLS

	;Define a MACRO for FACT file accounting

	DEFINE	FACT,<IFN FTFACT>
	COMMENT \

	TOPS10 Interpretation of Fields

1)  External Owner ID is a PPN
2)  Onwer ID (Internal) is a PPN

\

	EXTERN	MDADBP			;MDA $TEXT ACTION ROUTINE
	EXTERN	MDBPTR			;MDA $TEXT BYTE POINTER
	EXTERN	BELLS
	EXTERN	DEMOT			;MDA DEMOGRAPHIC ITEXT


	SUBTTL	Module Storage


PRMDIR:	BLOCK	1			;DIRECTORY FOR PRIME QUEUE
INDPPN:	BLOCK	1			;INDEPENDANT PPN FLAG
UNILST:	BLOCK	1			;LIST NUMBER FOR /UNIQUE LIST
PPNPTR:	BLOCK	1			;BYTE POINTER

FACT<	EXP	.FACT			;DAEMON FACT FUNCTION
FACTBL:	BLOCK	13  >			;WORDS IN MOUNT/DISMOUNT RECORDS

ACTMSG:	UGVAL$				;MESSAGE TYPE (UGVAL$)
ACTACK:	0,,0				;ACK CODE
ACTPPN:	0,,0				;PPN
ACTSTR:	BLOCK	.DCMAX			;GENERAL PURPOSE ARGUMENT BLOCK

IFN FTRQUE,<
REDDIR:	BLOCK	1			;DIRECTORY FOR REDUNDANT QUEUE
>  ;END IFN FTRQUE

RENFRB:	BLOCK	FRB.SZ			;FRB FOR /DISP:REN
RENFD:	BLOCK	FDXSIZ			;FD FOR RENAME
RENUDT:	EXP	-1			;BASE UDT FOR RENAME

;INTERRUPT CONTROL CELLS MUST BE IN THE FOLLOWING ORDER
;	THEY ARE REFERENCED BY THE OFFSET FROM THE BASE

INTBLK::BLOCK	0			;BASE ADDRESS OF INTERRUPT VECTOR
IPCBLK::EXP	C$INT##			;PROCESSOR IPCF INTERRUPTS
	BLOCK	3			;PLACES FOR FLAGS,OLD PC, ETC
NETBLK::EXP	N$INT##			;PROCESSOR FOR NETWORK INTERRUPTS.
	BLOCK	3			;SPACE FOR INTERRUPT DATA
JOBBLK::EXP	I$JINT			;PROCESSOR FOR JOB INTERRUPTS
	BLOCK	3			;SPACE FOR INTERRUPT DATA
KSYBLK::EXP	-1			;PROCESSOR (-1 UNTIL ENABLED)
	BLOCK	2			;INTERRUPT DATA BLOCK
KSYS:	BLOCK	1			;KSYS TIME IN MINUTES FROM MONITOR
DTCBLK::EXP	-1			;PROCESSOR (-1 UNTIL ENABLED)
	BLOCK	2			;INTERRUPT DATA BLOCK
DTCDIF:	BLOCK	1			;DATE/TIME DIFFERENCE IN UDT UNITS
INTEND==.-1				;END OF INTERRUPT VECTOR

	INTERN	USR			;THIS ITEXT IS USED FOR QUEUE LISTINGS,
	INTERN	MNTUSR			;THIS ITEXT IS USED FOR MOUNT QUEUE LISTINGS

	INTERN	STRUCT			;THIS ITEXT IS USED FOR QUEUE LISTINGS
					;AND DEFINES THE STRUCTURE NAME

					;AND DEFINES THE OWNER OF THE Q ENTRY.
USR:	ITEXT	(<^W6L /.QEUSR(AP)/^W/.QEUSR+1(AP)/ ^P/.QEOID(AP)/>)
MNTUSR:	ITEXT	(<^W6L /.MRNAM(AP)/^W/.MRNAM+1(AP)/ ^P/.MRUSR(AP)/>)
STRUCT:	ITEXT	(<^W/STRNAM(S1)/>)

DEFINE DEVOBJ,<XLIST
	X	LPT,.TYLPT,.OTLPT
	X	CDP,.TYCDP,.OTCDP
	X	PTP,.TYPTP,.OTPTP
	X	PLT,.TYPLT,.OTPLT
	X	LL,.TYLPT,.OTLPT
	X	LU,.TYLPT,.OTLPT
LIST >  ;END DEFINE DEVOBJ

DEFINE X(DV,OBJ,TYP),<
DEV'DV:	<SIXBIT	/DV/>
>  ;END DEFINE X

DEVTAB:	DEVOBJ
	NDEVS==.-DEVTAB

DEFINE X(DEV,OBJ,TYP),<
	XWD	TYP,OBJ
>  ;END DEFINE X

OBJDEV:	DEVOBJ
	SUBTTL	Initialization Routine

;The nominal number of resources to start with

	MINRES==^D10			;TYPICALLY, A GOOD STARTING # OF RESOURCES

I$INIT::PUSHJ	P,I%NOW			;GET THE CURRENT TIME
	MOVEM	S1,G$NOW##		;AND SAVE IT
	MOVX	S1,%CNTIC		;GETTAB FOR CLOCK TICKS/SECOND
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,G$TIC##		;AND SAVE IT
	MOVEI	S1,PRMSTR		;GET PERMANENT STRUCTURE FLAG
	MOVEM	S1,G$PERM##		;AND SET IT

INIT.0:	MOVSI	S1,.STSPL		;SET SPOOL FUNCTION CODE
	SETUUO	S1,			;TURN OFF SPOOLING
	  JFCL				;WE TRIED
	MOVX	S1,%LDSPP		;GETTAB TO SPOOLED FILE PROTECTION
	PUSHJ	P,DOGTAB		;GET IT
	LSH	S1,-^D27		;RIGHT-JUSTIFY IT
	MOVEM	S1,G$SPRT##		;AND STORE AWAY
	MOVX	S1,%LDQUE		;GETTAB TO SPOOLING DIRECTORY
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,G$SPLD##		;AND STORE IT AWAY
	MOVX	S1,%LDSYS		;GETTAB FOR "SYS"
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,PRMDIR		;AND SAVE THE DIRECTORY
	MOVEM	S1,G$SYSD##		;SAVE HERE FOR OTHER FOLKS
	SETZM	INDPPN			;CLEAR INDEPENDANT PPN FLAG
	MOVX	S1,%CNSTS		;GETTAB TO READ STATES WORD
	PUSHJ	P,DOGTAB		;GET IT
	TXNE	S1,ST%IND		;INDEPENDANT PPNS ?
	SETOM	INDPPN			;YES
	MOVX	S1,%CNST2		;GETTAB TO READ 2ND STATES WORD
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,G$MST2##		;SAVE FOR USE LATER
IFN FTRQUE,<
	MOVX	S1,%LDQUE		;GETTAB FOR "QUE"
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,REDDIR		;AND SAVE IT
>  ;END IFN FTRQUE

	MOVX	S1,%IPCML		;GETTAB FOR MAX PACKET SIZE
	PUSHJ	P,DOGTAB		;GET IT
	MOVEM	S1,G$MPS##		;AND STORE IT
	MOVX	S1,%CNMMX		;GET SMALLEST LEGAL CORMAX
	PUSHJ	P,DOGTAB		;FROM THE CONFIG TABLE
	ADR2PG	S1			;CONVERT WORDS TO PAGES
	MOVEM	S1,G$MCOR##		;SAVE FOR THE SCHEDULER
	PJOB	S1,			;GET JOB NUMBER
	$SITEM	S1,QJOB			;AND SET THE ITEM
	PUSHJ	P,I%ION			;ENABLE THE INTERRUPT SYSTEM
	PUSHJ	P,L%CLST		;CREATE A LIST
	MOVEM	S1,UNILST		;SAVE THE ADDRESS AWAY

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVEI	S1,<MINRES+1>*AMALEN	;GET THE TYPICAL MINIMUM SPACE
	$CALL	M%GMEM			;GET THE SPACE
	MOVEM	S2,AMATRX##		;STUFF THAT IN AS OUR MATRIX
	STORE	S1,.AMHDR(S2),AM.LEN	;MARK LENGTH IN WORDS
	MOVEI	S1,MINRES		;AND COUNT IN RH
	STORE	S1,.AMHDR(S2),AM.MCN	;SAVE HIGHEST AVAILABLE INDEX
	MOVX	S1,%CNST2		;GET SECOND MONITOR STATES WORD
	PUSHJ	P,DOGTAB		;READ IT IN
	TXNE	S1,ST%ACV		;ACCOUNT VALIDATION ENABLED ???
	SETOM	G$ACTV##		;YES,,LITE ACCOUNTING FLAG
	TXNE	S1,ST%MDA		;MDA SUPPORT IN THIS MONITOR ???
	SETOM	G$MDA##			;YES,,LITE MDA FLAG
	SKIPE	DEBUGW			;ARE WE DEBUGGING ???
	SETZM	G$ACTV##		;YES,,NO ACCOUNT VALIDATION !!!
	HRROI	S1,.GTPPN		;GET OUR PPN
	PUSHJ	P,DOGTAB		;REQUEST IT
	CAME	S1,[1,,2]		;ARE WE RUNNING [1,2] ???
	SETZM	G$MDA##			;NO,,CAN'T RUN WITH MDA ENABLED !!!
	SKIPN	G$MDA##			;MDA SUPPORT HERE ???
	JRST	INIT.1			;NO,,DON'T GET SPECIAL MDA PIDS

	;Here to set up special MDA Pids

	MOVX	S1,SP.MDA		;GET MDA'S SPECIAL PID INDEX
	STORE	S1,G$PIB##+PB.INT,IP.SPI ;SAVE IT IN THE PIB
	MOVX	S1,PB.MXS		;GET THE PIB LENGTH
	MOVEI	S2,G$PIB##		;AND THE PIB ADDRESS
	PUSHJ	P,C%CPID		;MAKE US SYSTEM[TAPE AVR]
	MOVE	S1,G$PIB##+PB.PID	;GET THE MDA PID
	MOVEM	S1,G$MPID##		;AND SAVE IT FOR LATER

	MOVX	S1,SP.TOL		;GET TAP AVR'S SPECIAL PID INDEX
	STORE	S1,G$PIB##+PB.INT,IP.SPI ;SAVE IT IN THE PIB
	MOVX	S1,PB.MXS		;GET THE PIB LENGTH
	MOVEI	S2,G$PIB##		;AND THE PIB ADDRESS
	SKIPN	DEBUGW			;IF DEBUGGING,,DONT GET PID
	PUSHJ	P,C%CPID		;ELSE MAKE US SYSTEM[TAPE AVR]

	MOVX	S1,SP.DOL		;GET DISK AVR'S SPECIAL PID INDEX
	STORE	S1,G$PIB##+PB.INT,IP.SPI ;SAVE IT IN THE PIB
	MOVX	S1,PB.MXS		;GET THE PIB LENGTH
	MOVEI	S2,G$PIB##		;AND THE PIB ADDRESS
	SKIPN	DEBUGW			;IF DEBUGGING,,DONT GET PID
	PUSHJ	P,C%CPID		;ELSE MAKE US SYSTEM[DISK AVR]

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;Here to wait for ORION and ACTDAE and PULSAR to start up

INIT.1:	SKIPE	G$MDA			;IF MDA SUPPORT THEN..
	PUSHJ	P,I$SLBR		;..START UP PULSAR
	SKIPT
	STOPCD	(PSF,HALT,,<PULSAR Startup Failed>)
	PUSHJ	P,I$SORN		;START UP ORION
	SKIPT
	STOPCD	(OSF,HALT,,<ORION Startup Failed>)
	MOVEM	S1,G$OPR##		;SAVE IT FOR FUTURE REFERENCE
	MOVEI	S1,ACTCJB		;MUST WAIT FOR ACTDAE BECAUSE
	$CALL	I%CJOB			;WAIT FOREVER FOR PID TO EMERGE
	SKIPT
	$WTO	(<Could not get Accounting Daemon pid>,<Error: ^E/S1/>,,<$WTFLG(WT.SJI)>)

	;Start object processors that are started once at QUASAR startup

	$SAVE	<T1,T2>			;NEED SOME ACS
	MOVX	T2,CJ.D60		;CANT TELL ABOUT DN60 (YET)
	MOVE	T1,[SIXBIT |LOCAL|]	;GET CROCKY NODE NAME GIVEN
	CAME	T1,G$LNAM##		;WHEN ANF-10 IS NOT PRESENT
	TXO	T2,CJ.ANF		;WE HAVE ANF-10
	MOVX	T1,ST%D36!ST%END	;GET DECNET STATE BITS
	TDNE	T1,G$MST2##		;LIT IN 2ND STATES WORD?
	TXO	T2,CJ.DCN		;WE HAVE DECNET
	MOVSI	S2,-OPDTSZ		;MAKE AOBJN POINTER TO OPDTAB
	HRRI	S2,OPDTAB
INIT.2:	MOVE	S1,(S2)			;GET ADDRESS OF DATA
	MOVEI	S1,OPDCJB(S1)		;GET ADDR OF PROCESSOR'S CJB
	LOAD	TF,CJB.FL(S1),CJ.QSR	;GET QUASAR'S PRIVATE FIELD
	CAXE	TF,%ONCE		;PROCESSOR TO START NOW?
	AOBJN	S2,INIT.2		;NO, TRY NEXT
	JUMPGE	S2,INIT.3		;JUMP IF NO MORE
	LOAD	TF,CJB.FL(S1),CJ.DEP	;GET DEPENDENCIES BITS
	JUMPE	TF,INIT2A		;SKIP TEST IF NO DEPENDENCIES
	TDNN	T2,CJB.FL(S1)		;DO WE HAVE THE REQUIRED STUFF?
	JRST	INIT2B			;NOPE, TRY NEXT ENTRY
INIT2A:	HRLZ	TF,S1			;YES, COPY OBJECT'S CJB TO QUASAR'S
	HRRI	TF,QSRCJB
	BLT	TF,QSRCJB+CJB.SZ-1
	MOVEI	TF,^D60			;WAIT 1 MINUTE FOR FRCLIN IF NEED BE
	STORE	TF,QSRCJB+CJB.TP,CJ.TIM	;PLACE SECONDS IN CJB
	MOVEI	S1,QSRCJB		;GET CJB ADDRESS
	PUSH	P,S2			;SAVE AOBJN POINTER
	PUSHJ	P,I$SXXX		;GO DO THE WORK
	JUMPF	[POP	P,S2		;GET AOBJN POINTER BACK
		 JRST   INIT2B]		;IF IT DIDN'T WORK, DON'T GET A PSB
	SETZB	S1,S2
	PUSHJ	P,GETPSB##		;GET US A PSB
	MOVE	S2,QSRCJB+CJB.NM	;GET THE PROCESSOR'S NAME
	MOVEM	S2,PSBNAM(S1)		;SAVE IN PSB
	MOVX	S2,PS.WAT		;GET "WAITING" STATUS
	STORE	S2,PSBFLG(S1),PSFSTS	;STORE IN PSB
	MOVE	S2,S1			;GET PSB ADDRESS IN S1
	$CALL	I%NOW			;GET CURRENT TIME
	ADD	S1,[EXP  ^D2*^D60*^D3]	;GIVE IT 2 MINUTES
	MOVEM	S1,PSBUDT(S2)		;STORE TIME IN PSB
	POP	P,S2			;GET AOBJN POINTER BACK
INIT2B:	AOBJN	S2,INIT.2		;TRY NEXT TABLE ENTRY

INIT.3:	SKIPN	G$MDA##			;MDA SUPPORT ???
	$RETT				;NO,,RETURN
	MOVX	S1,%CNSJN		;GET CONFIG TABLE, JOB COUNTS ENTRY
	PUSHJ	P,DOGTAB		;GET IT
	HRRZM	S1,G$MAXJ##		;SAVE THE MAX JOB COUNT SUPPORTED

	;Create Tape UCB's

	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A MINUTE
	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE UCB CHAIN
	MOVEM	S1,UCBQUE##		;SAVE THE ID FOR LATER
	MOVX	S1,.TYMTA		;GET TYPE CODE FOR MTA'S
	MOVEM	S1,ACTSTR		;STORE IN THE DVPHY PARM BLOCK
	SETZM	ACTSTR+1		;CLEAR DRIVE WORD
INIT.4:	MOVE	S1,[2,,ACTSTR]		;GET DVPHY. PARMS
	DVPHY.	S1,			;GET NEXT MTA UNIT
	JRST	INIT.5			;NO MAG TAPES,,LOOK FOR DISKS
	SKIPN	S1,ACTSTR+1		;GET THE DEVICE NAME
	JRST	INIT.5			;NO MORE,,CREATE DISK UCB'S
	LDB	S2,[POINT 6+6,S1,6+6-1]	;GET LEFT 2 CHARACTERS OF DEVICE NAME
	CAIN	S2,' ''L'		;IS IT A LABEL DEVICE ???
	JRST	INIT.4			;YES,,IGNORE IT
	MOVE	P1,S1			;SAVE THE DEVICE NAME
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	MOVX	S2,UCBLEN		;GET THE UCB ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE AN ENTRY IN THE UCB CHAIN
	MOVEM	P1,.UCBNM(S2)		;SAVE THE DEVICE NAME
	MOVE	S1,S2			;GET THE DEVICE ADDRESS IN S1
	PUSHJ	P,I$GATR		;GO SETUP THE DEVICE ATTRIBUTES
	JRST	INIT.4			;AND CONTINUE PROCESSING

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;Create Disk UCB's

INIT.5:	SETZM	T1			;WANT FIRST PHYSICAL DISK UNIT
INIT.6:	SYSPHY	T1,			;GET FIRST/NEXT PHYSICAL DISK UNIT
	STOPCD	(CGD,HALT,,<Can't get disk physical unit>)
	JUMPE	T1,INIT.7		;NO MORE,,CHECK FOR DECTAPES
	MOVE	S1,T1			;GET THE UNIT NAME IN S1
	PUSHJ	P,D$GUCB##		;FIND THE UCB IN THE UCB CHAIN
	JUMPT	INIT.6			;FOUND IT,,SKIP IT !!!
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	MOVX	S2,UCBLEN		;AND THE UCB LENGTH
	PUSHJ	P,L%CENT		;CREATE THE DISK UCB ENTRY
	MOVE	P2,S2			;SAVE THE UCB ADDRESS
	MOVEM	T1,.UCBNM(S2)		;SAVE THE PHYSICAL DEVICE NAME
	MOVE	S1,S2			;GET THE DEVICE ADDRESS IN S1
	PUSHJ	P,I$GATR		;GET THE DEVICE ATTRIBUTES
	LOAD	S1,.UCBST(P2),UC.AVA	;GET THE AVAILABLE STATUS BITS
	JUMPN	S1,INIT.6		;IF SET,,CONTINUE
	MOVE	S1,UCBQUE##		;NO,,GET UCB QUEUE ID
	PUSHJ	P,L%DENT		;DELETE THE UCB WE JUST ADDED
	JRST	INIT.6			;AND CONTINUE

INIT.7:	MOVX	S1,.TYDTA		;GET TYPE CODE FOR DECTAPES
	MOVEM	S1,ACTSTR		;STORE IN THE DVPHY PARM BLOCK
	SETZM	ACTSTR+1		;CLEAR DRIVE WORD
INIT.8:	MOVE	S1,[2,,ACTSTR]		;GET DVPHY. PARMS
	DVPHY.	S1,			;GET NEXT DTA UNIT
	  $RETT				;DONE
	SKIPN	P1,ACTSTR+1		;GET THE DEVICE NAME
	$RETT				;DONE
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	MOVX	S2,UCBLEN		;GET THE UCB ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE AN ENTRY IN THE UCB CHAIN
	MOVEM	P1,.UCBNM(S2)		;SAVE THE DEVICE NAME
	MOVE	S1,S2			;GET THE DEVICE ADDRESS IN S1
	PUSHJ	P,I$GATR		;GO SETUP THE DEVICE ATTRIBUTES
	JRST	INIT.8			;AND CONTINUE PROCESSING
SUBTTL	CJBs used by QUASAR

;Build CJBs for starting the "always needed" components

ORNCJB::$BUILD	(CJB.SZ)
	  $SET	(CJB.NM,,<SIXBIT |ORION|>) 
	  $SET	(CJB.TP,CJ.TIM,777777)	;WAIT "FOREVER"
	  $SET	(CJB.TP,CJ.SPI,SP.OPR)	;ORION'S SPECIAL PID INDEX
	$EOB

LBRCJB::$BUILD	(CJB.SZ)
	  $SET	(CJB.NM,,<SIXBIT |PULSAR|>) 
	  $SET	(CJB.TP,CJ.TIM,777777)	;WAIT "FOREVER"
	  $SET	(CJB.TP,CJ.SPI,SP.TLP)	;PULSAR'S SPECIAL PID INDEX
	$EOB

CATCJB::$BUILD	(CJB.SZ)
	  $SET	(CJB.NM,,<SIXBIT |CATLOG|>) 
	  $SET	(CJB.TP,CJ.TIM,777777)	;WAIT "FOREVER"
	  $SET	(CJB.TP,CJ.SPI,SP.CAT)	;CATLOG'S SPECIAL PID INDEX
	$EOB

ACTCJB::$BUILD	(CJB.SZ)
	  $SET	(CJB.TP,CJ.TIM,777777)	;WAIT "FOREVER"
	  $SET	(CJB.TP,CJ.SPI,SP.ACT)	;ACTDAE'S SPECIAL PID INDEX
	$EOB

;Reserve a dummy CJB for use by QUASAR when he needs it

QSRCJB::BLOCK	CJB.SZ
SUBTTL	I$Sxxx - Start Various Galactic Components

	INTERN	I$SORN		;ROUTINE TO STARTUP ORION
	INTERN	I$SLBR		;ROUTINE TO STARTUP PULSAR
	INTERN	I$SCAT		;ROUTINE TO STARTUP CATLOG
	INTERN	I$SXXX		;ROUTINE TO STARTUP AN OBJECT PROCESSOR
	INTERN	I$GOPD		;ROUTINE TO GET OBJECT PROCESSOR DATA
	INTERN	I$FCJB		;ROUTINE TO FIND A PROCESSOR'S CJB

;Start up ORION

I$SORN::SKIPE	DEBUGW			;DEBUGGING?
	SETZM	ORNCJB+CJB.NM		;YES, JUST WAIT FOR PID
	MOVEI	S1,ORNCJB		;GET ADDRESS OF ORION'S CJB
	PJRST	I$SXXX			;GO TO COMMON CODE

;Start up PULSAR

I$SLBR::SKIPE	DEBUGW			;DEBUGGING?
	SETZM	LBRCJB+CJB.NM		;YES, JUST WAIT FOR PID
	MOVEI	S1,LBRCJB		;GET ADDRESS OF PULSAR'S CJB
	PJRST	I$SXXX			;HIT COMMON CODE

;Start up CATLOG

I$SCAT::SKIPE	DEBUGW			;DEBUGGING?
	SETZM	CATCJB+CJB.NM		;YES, JUST WAIT FOR PID
	MOVEI	S1,CATCJB		;GET ADDRESS OF CATLOG'S CJB
;	PJRST	I$SXXX			;FALL INTO COMMON CODE

;I$SXXX - Common code to call I%CJOB
;
;	Call:	S1/ address of CJB for I%CJOB
;	Return:	Propagated from I%CJOB

I$SXXX:	$SAVE	<T1>
	MOVE	T1,S1			;SAVE CJB ADDRESS
	$CALL	I%CJOB			;STARTUP ORION
	$RETIT				;RETURN IF OK
	$WTO	(<^W/CJB.NM(T1)/ startup failed>,<Error: ^E/S1/>,,<$WTFLG(WT.SJI)>)
	$RETF
SUBTTL	I$GOPD - Get Object Processor Data


;Define table that contains object types, and a pointer to a CJB
;that contains the other object processor info needed.


DEFINE	X (OBJ,PRG,TYP,ATR,DEP,TXT),<
	XLIST
	...OCT==0
	...ACT==0
	...TXT==0
	IRP OBJ,<...OCT==...OCT+1>	;;COUNT OBJECT TYPES
	IRP ATR,<...ACT==...ACT+1>	;;COUNT ATTRIBUTES
	IRP TXT,<...TXT==...TXT+1>	;;COUNT TEXT STRINGS

	IFG ...TXT - %CJSTC,<PRINTX ?Too many text strings in PRCDAT>

	EXP	[XWD	-...OCT,[	;;CONSTRUCT AOBJN POINTER
		IRP OBJ,<		;;AND TABLE OF OBJECTS TYPES
			EXP .OT'OBJ
		>
		]

		XWD	-...ACT,[	;;CONSTRUCT AOBJN POINTER
		IRP OBJ,<		;;AND TABLE OF ATTRIBUTES
			EXP 'ATR
		>
		]
	 	$BUILD (CJB.SZ)		;;BUILD THE CJB
			$SET (CJB.NM,,<SIXBIT |'PRG|>)
			$SET (CJB.FL,CJ.QSR,'TYP)
			$SET (CJB.FL,CJ.STC,...TXT)
       		IRP DEP,<
			IFIDN <DEP><ANF10>, <$SET (CJB.FL,CJ.ANF,1)>
			IFIDN <DEP><DECNET>,<$SET (CJB.FL,CJ.DCN,1)>
			IFIDN <DEP><DN60>,  <$SET (CJB.FL,CJ.D60,1)>
		>
		...CNT==0
		IRP TXT,<
			$SET (CJB.ST+...CNT,,<[ASCIZ\'TXT\]>)
	        ...CNT==...CNT+1
		>
		$EOB
		]
	.XCREF	...OCT,...ACT,...TXT,...CNT
	PURGE	...OCT,...ACT,...TXT,...CNT
	LIST
>
;PRCDAT defined in QSRMAC

OPDTAB::PRCDAT
OPDTSZ==.-OPDTAB			;SIZE OF TABLE

;Define OPDTAB entry offsets

	PHASE	0
OBJPTR:	BLOCK	1			;AOBJN POINTER TO OBJECT TYPES
ATRPTR:	BLOCK	1			;AOBJN POINTER TO ATTRIBUTES
OPDCJB:	BLOCK	0			;START OF CJB
	DEPHASE

;This routine returns the address of a CJB which contains the
;information about the object processor.
;
;	Call:	S1/	object type (.OTxxx)
;		S2/	object attribute
;
;	Return:	TRUE	S1/ address of CJB
;		FALSE	object type not found in table


I$GOPD::PUSHJ	P,.SAVE3		;SAVE P1 - P3
	MOVSI	P2,-OPDTSZ		;MAKE AOBJN POINTER INTO OPDTAB
	HRRI	P2,OPDTAB
GOPD.1:	MOVE	P3,(P2)			;GET ADDRESS OF DATA
	MOVE	P1,OBJPTR(P3)		;GET AOBJN POINTER OBJECT TYPES
	CAME	S1,(P1)			;OBJECT TYPE MATCH?
	AOBJN	P1,.-1			;NO, CHECK NEXT OBJECT TYPE
	JUMPGE	P1,GOPD.2		;IF NO MATCHES, CHECK NEXT TABLE SLOT
	MOVE	P1,ATRPTR(P3)		;OBJ'S MATCH. GET AOJBN TO ATTRIBS
	CAME	S2,(P1)			;ATTRIBUTES MATCH?
	AOBJN	P1,.-1			;NO, CHECK NEXT ATTRIBUTE
	JUMPGE	P1,GOPD.2		;IF NO MATCHES, CHECK NEXT TABLE SLOT
	MOVEI	S1,OPDCJB(P3)		;OBJECT AND ATTRIB MATCH. GET CJB ADDR
	$RETT				;RETURN SUCCESS
GOPD.2:	AOBJN	P2,GOPD.1		;POINT TO NEXT TABLE ENTRY
	$RETF				;NOT FOUND

SUBTTL	I$FCJB - Find an Object Processor's CJB


;I$FCJB - Find an object processor's CJB given it's program name
;
;	Call:	S1/ SIXBIT program name
;
;	Return:	TRUE	S1/ CJB address
;		FALSE	CJB not found

I$FCJB::MOVSI	S2,-OPDTSZ		;MAKE AOBJN POINTER TO TABLE
	HRRI	S2,OPDTAB
	MOVE	TF,S1			;GET PROCESSOR NAME FROM CALLER
FCJB.1:	MOVE	S1,(S2)			;GET ADDRESS OF DATA
	MOVEI	S1,OPDCJB(S1)		;GET ADDRESS OF CJB
	CAMN	TF,CJB.NM(S1)		;CJB WE WANT?
	$RETT				;YES, RETURN CJB ADDRESS
	AOBJN	S2,FCJB.1		;NO, KEEP LOOKING
	$RETF				;NOT FOUND
SUBTTL	I$RENA - Process /DISPOSE:RENAME


; System dependant routine to rename files from user's PPNs into the queue
; PPN[3,3]. Called from QSRSCH (RENDEF) if /DISPOSE:RENAME was specified.
; Call:	MOVE	M,create message address
;	MOVE	S1,FP address in create message
;	PUSHJ	P,I$RENA
;
; TRUE return:	file renamed
; FALSE return:	rename failed, GLXFIL error code in AC 'S1'
;
; AC usage:	All ACs saved except for S1 and S2
;
I$RENA:	$SAVE	<T1,T2,T3>		;SAVE SOME ACS
	MOVEI	T1,(S1)			;COPY FP ADDRESS
	LOAD	T2,.FPLEN(T1),FP.LEN	;GET SIZE OF FP
	ADDI	T2,(T1)			;POINT TO FD IN QUESTION

RENA.1:	AOSN	S1,RENUDT		;GET CURRENT RENAME SEED
	MOVE	S1,G$NOW##		;ADD TO THE CURRENT UDT
	MOVEM	S1,RENUDT		;SET IT FOR NEXT TIME
	MOVEI	S2,'Q'			;GET A Q FOR THE FIRST CHARACTER
	DPB	S2,[POINT 6,RENFD+.FDNAM,5] ;MAKE IT LIKE THE MONITOR DOES
	MOVE	T3,[POINT 6,RENFD+.FDNAM,5] ;MAKE A BYTE POINTER TO THE NEW NAME

RENA.2:	IDIVI	S1,^D26			;DIVIDE BY RADIX 26
	ADDI	S2,'A'			;MAKE IT SIXBIT
	IDPB	S2,T3			;STORE CHARACTER
	TLNE	T3,770000		;DONE ?
	JRST	RENA.2			;NO - LOOP
	MOVSI	S1,'SPL'		;GET A GOOD EXTENSION
	MOVEM	S1,RENFD+.FDEXT		;STASH IT AWAY
	MOVE	S1,.FDSTR(T2)		;GET DEVICE
	MOVEM	S1,RENFD+.FDSTR		;FOR DOCUMENTATION PURPOSES
	MOVE	S1,G$SPLD##		;GET PPN
	MOVEM	S1,RENFD+.FDPPN		;STORE IT
	HRLZI	S1,FDMSIZ		;GET SIZE OF MINIMUM FD
	MOVEM	S1,RENFD+.FDLEN		;STORE IT
	MOVE	S1,.FDNAM(T2)		;GET ORIGINAL FILE NAME
	MOVEM	S1,.FPONM(T1)		;REMENBER IT
	MOVE	S1,.FDEXT(T2)		;GET ORIGINAL EXTENSION
	MOVEM	S1,.FPOXT(T1)		;REMEMBER IT TOO
	MOVEM	T2,RENFRB+FRB.SF	;STORE SOURCE FD ADDRESS
	MOVEI	S1,RENFD		;GET DESTINATION FD
	MOVEM	S1,RENFRB+FRB.DF	;STORE IT
	MOVE	S1,.EQOID(M)		;GET USER'S PPN
	MOVEM	S1,RENFRB+FRB.US	;STORE IN-BEHALF-PPN
	MOVEI	S1,[EXP	3		;3 WORD BLOCK
		    1B17+.FIPRO		;PROTECTION CODE SUB-FUNCTION
		    EXP	G$SPRT##]	;FILE PROTECTION TO SET
	MOVEM	S1,RENFRB+FRB.AB	;TELL GLXFIL
	MOVEI	S1,FRB.SZ		;GET LENGTH
	MOVEI	S2,RENFRB		;POINT TO FRB
	$CALL	F%REN			;RENAME FILE TO [3,3]
	JUMPT	RENA.3			;CHECK FOR ERRORS
	CAXN	S1,ERFAE$		;FILE ALREADY EXISTS ?
	JRST	RENA.1			;YES - TRY AGAIN
	MOVX	S1,FP.DEL		;GET DELETE BIT
	IORM	S1,.FPINF(T1)		;THATS THE BEST WE CAN DO
	MOVX	S1,FP.REN		;GET THE RENAME BIT
	ANDCAM	S1,.FPINF(T1)		;AND CLEAR IT
	$RETF				;AND RETURN

RENA.3:	MOVE	S1,RENFD+.FDNAM		;GET FUNNY NAME
	MOVEM	S1,.FDNAM(T2)		;CHANGE FILE NAME IN EQ
	HLLZ	S1,RENFD+.FDEXT		;GET NEW EXTENSION
	HLLM	S1,.FDEXT(T2)		;CHANGE IT TOO
	MOVE	S1,G$SPLD##		;GET QUEUE PPN
	MOVEM	S1,.FDPPN(T2)		;CHANGE IT IN THE FD
	LOAD	S1,.FDLEN(T2),FD.LEN	;GET FD LENGTH
	CAILE	S1,.FDPAT		;HAVE ANY SFDS ?
	SETZM	.FDPAT(T2)		;YES - TERMINATE PATH
	MOVEI	S1,1			;GET A 1
	STORE	S1,.FPINF(T1),FP.SPL	;LIGHT THE SPOOLED BIT
	STORE	S1,.EQSEQ(M),EQ.SPL	;HERE TOO
	$RETT				;RETURN
	SUBTTL	I$JINT - ROUTINE TO PROCESS JOB INTERRUPTS.

I$JINT:	$BGINT	1,
	$DEBRK
SUBTTL	Information

;ENTRY POINTS

	INTERN	I$RENA		;ROUTINE TO DO RENAME FOR /DISPOSE:RENAME
	INTERN	I$SYSV		;ROUTINE TO READ TIME-DEPENDENT SYSTEM VARIABLES
	INTERN	I$CHAC		;CHECK ACCESS
	INTERN	I$LOGN		;LOGIN MESSAGE PROCESSOR
	INTERN	I$NINT		;ENABLE FOR NETWORK CHANGE INTERRUPTS
	INTERN	I$MNTC		;GET MOUNT COUNT FOR A STRUCTURE
	INTERN	I$GATR		;GET DEVICE ATTRIBUTES AND SAVE IN UCB
	INTERN	I$ATCH		;ATTACH UNIT MONITOR COMMAND PROCESSOR
	INTERN	I$DTCH		;DETACH UNIT MONITOR COMMAND PROCESSOR
	INTERN	I$SLCM		;SEARCH LIST CHANGE MESSAGE (FROM MONITOR)
	INTERN	I$BMDR		;ROUTINE TO GENERATE AN MDR FOR A BATCH REQUEST
	INTERN	I$UMDR		;ROUTINE TO UPDATE A USERS ALLOC FOR BATCH
	INTERN	I$KINT		;ROUTINE TO SET PSI INTERRUPTS ON KSYS
	INTERN	I$KSYS		;ROUTINE TO CHECKS KSYS DATA FROM MONITOR
	INTERN	I$SKSM		;ROUTINE TO SEND KSYS MSG TO BATCON
	INTERN	I$MSTR		;ROUTINE TO HANDLE MONITOR STR MOUNTED MSG
	INTERN	I$DINT		;ROUTINE TO INIT DATE/TIME CHANGE INTERRUPTS
	SUBTTL	I$SYSV  --  Read time-dependent system variables

;I$SYSV is called to read and remember all relevent system variables
;	which could change with time.  On TOPS10 these are:
;
;	Variable			Memory
;	--------			------
;
;	Time till KSYS			G$KSYS  =  # --- seconds till  KSYS
;						=  0 --- no KSYS set
;						= -1 --- timesharing is over
;	CORMAX				G$XCOR
;	Time of day			G$NOW
;	Batch LOGIN flag		G$LOGN  =  0 --- No LOGINs
;						= -1 --- LOGINs allowed
;	Operator available flag		G$OPRA	=  0 --- SCHED 400 set
;						= -1 --- Operator on duty

I$SYSV:	SKIPGE	G$KSYI##		;INTERRUPT OCCUR?
	PUSHJ	P,I$KSYS		;YES,,PROCESS
	SKIPL	KSYBLK+.PSVNP		;KSYS INTERRUPTS ENABLED?
	 JRST	[MOVE S1,KSYS		;YES,,GET LAST TIME GIVEN BY MONITOR
		 JRST SYSV.0]		;DON'T DO GETTAB
	MOVX	S1,%NSKTM		;GETTAB FOR KSYS
	GETTAB	S1,			;ASK THE MONITOR
	SETZM	S1			;NO,,ASSUME NO SCHEDULED SHUTDOWN
SYSV.0:	JUMPL	S1,SYSV.2		;NONE PENDING,,SKIP THIS
	SKIPE	S1			;DON'T MULTIPLY IF ZERO
	IMULI	S1,^D60			;MONITOR RETURNS MINS, MAKE SECS
	CAMN	S1,G$KSYS##		;ANY CHANGE FROM BEFORE ???
	JRST	SYSV.2			;NO,,CONTINUE ONWARD
	SKIPL	G$KSYS##		;WAS LAST STATE 'TIMESHARING OVER' ???
	SKIPG	S1			;NO,,IS NEW STATE 'NO KSYS SET' ???
	DOSCHD				;YES,,FORCE A SCHEDULING PASS
SYSV.2:	MOVEM	S1,G$KSYS##		;SETUP KSYS FOR SCHEDULER
	JUMPL	S1,.RETT		;TIMESHARING OVER,,RETURN
	PUSHJ	P,I%NOW			;GET TIME OF DAY
	MOVEM	S1,G$NOW##		;STORE IT
	MOVX	S1,%NSCMX		;GETTAB FOR CORMAX
	GETTAB	S1,			;ASK THE MONITOR
	  SETZM	S1			;NO CORMAX SET
	ADR2PG	S1			;CONVERT WORDS TO PAGES
	MOVEM	S1,G$XCOR##		;SETUP CORMAX FOR SCHEDULER
	SETOM	G$LOGN##		;ASSUME BATCH LOGINS ALLOWED
	MOVX	S1,%CNSTS		;GETTAB ARGS
	GETTAB	S1,			;GET THE MONITOR'S STATES WORD
	  SETZ	S1,			;SICK MONITOR
	TXNE	S1,ST%NRL!ST%NLG	;LOGINS ALLOWED?
	SETZM	G$LOGN##		;NOPE
	MOVE	S2,G$OPRA##		;SAVE OLD OPR ON DUTY VALUE
	SETOM	G$OPRA##		;ASSUME OPERATOR ON DUTY
	TXNE	S1,ST%NOP		;CHECK
	SETZM	G$OPRA##		;NO OPERATOR ON DUTY
	SKIPN	S2			;IF OPR WAS ON DUTY, CHANGE DOESN'T HELP
	SKIPN	G$OPRA##		;IF NOT BEFORE, BUT IS NOW
	CAIA				;(FALSE)
	DOSCHD				;SYSTEM-OPR STREAMS MAY BE SCHEDULABLE
	$RETT				;RETURN
SUBTTL	I$CHAC  --  Routine to Check File Access

; Routine to check queue request access
;
; Call:	MOVE	S1,queue request protection code
;	MOVE	S2,queue request PPN
;	PUSHJ	P,I$CHAC
;	  RETURN HERE ALWAYS
; TRUE RETURN:	ACCESS ALLOWED
; FALSE RETURN:	ACCESS DENIED
;
I$CHAC:	MOVEM	S1,CHAC.A		;SAVE CODE AND PROTECTION
	PUSHJ	P,A$WHEEL##		;CHECK FOR GODLY PRIVS
	JUMPT	.RETT			;AND RETURN IF USER HAS THEM
	XOR	S2,G$SID##		;COMPARE THE PPNS
	JUMPE	S2,.RETT		;OWNER GETS FULL ACCESS
	MOVEM	S2,CHAC.B		;AND SAVE THE DIFFERENCE
	SKIPN	INDPPN			;INDPPN SET ?
	HRRZS	S2			;NO - CHECK PROGRAMMER NUMBER ONLY
CHAC.1:	MOVE	S1,[POINT 3,CHAC.A,29]	;SET UP BYTE POINTER
	JUMPE	S2,CHAC.2		;IS THIS THE OWNER ?
	IBP	S1			;NO - TRY PROJECT
	HLRZ	S2,CHAC.B		;GET PROJECT NUMBER DIFFERENCE
	SKIPE	S2			;IS IT THE SAME PROJECT ?
	IBP	S1			;NO - TRY THE REST OF THE WORLD
CHAC.2:	LDB	S2,S1			;GET THE PROTECTION CODE
	TRZ	S2,400			;400 ONLY ASKS FOR FILDAE HELP
	CAIGE	S2,.PTWRI		;ALLOW WRITE ACCESS?
	$RETT				;YES
	$RETF				;OTHERWISE, HE'S A LOSER

CHAC.A:	BLOCK	1			;LOCAL STORAGE
CHAC.B:	BLOCK	1			;LOCAL STORAGE
	SUBTTL	I$LOGN - LOGIN MESSAGE PROCESSOR

	;CALL:	M/ The Message Address
	;
	;RET:	True Always

I$LOGN:	MOVX	S1,LG.BSS		;GET 'BATCH STREAM SET' BIT
	TDNN	S1,LGN.JB(M)		;IS IT SET ?
	JRST	LOGN.1			;NO,,TRY SOMETHING ELSE
	LOAD	S1,LGN.JB(M),LG.STR	;YES,,GET THE BATCH STREAM NUMBER
	MOVEM	S1,COMSTA##+OBJ.UN	;SAVE IT
	MOVX	S1,.OTBAT		;WANT OBJECT TYPE BATCH 
	MOVEM	S1,COMSTA##+OBJ.TY	;SAVE IT
	MOVE	S1,G$LNBR##		;GET LOCAL NODE NUMBER
	MOVEM	S1,COMSTA##+OBJ.ND	;SAVE IT
	MOVEI	S1,COMSTA##		;POINT AT OUR OBJECT BLOCK
	PUSHJ	P,A$FOBJ##		;FIND THE OBJECT BLOCK
	JUMPF	.RETT			;NOT THERE,,SOMETHINGS WRONG !!!
	SKIPN	S1,OBJITN(S1)		;IS A JOB PROCESSING ???
	$RETT				;NO,,RETURN
	PUSHJ	P,Q$SUSE##		;FIND THE REQUEST IN THE USE QUEUE
	JUMPF	.RETT			;NONE THERE,,JUST RETURN
	LOAD	P1,LGN.JB(M),LG.JOB	;GET THE USERS JOB NUMBER
	STORE	P1,.QEJBN(S1),QE.BJN	;SAVE IT IN THE QE
	SKIPE	G$MDA##			;IS MDA ENABLED ???
	SKIPN	AP,.QEMDR(S1)		;CHECK AND LOAD THE MDR ADDRESS
	$RETT				;NOT THERE,,RETURN
	PUSHJ	P,D$BMTX##		;LOCATE THE PROCESS 'B' MATRIX
	SKIPF				;LOSE,,MAY NOT HAVE ONE !!!
	MOVEM	P1,.SMJOB(BM)		;RESET THE 'B' MATRIX ID
	PUSHJ	P,D$CMTX##		;LOCATE THE PROCESS 'C' MATRIX
	SKIPF				;LOSE,,MAY NOT HAVE ONE !!!
	MOVEM	P1,.SMJOB(CM)		;RESET THE 'C' MATRIX ID
	STORE	P1,.MRJOB(AP),MR.JOB	;CONVERT THIS MDR TO A REAL MDR
	MOVE	S1,P1			;GET THE JOB NUMBER BACK
	PUSHJ	P,I$SSRL		;VERIFY THE SEARCH LIST
	JRST	LOGN.2			;MEET AT THE PASS !!!

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

LOGN.1:	SKIPN	G$MDA##			;IS MDA ENABLED ???
	$RETT				;NO,,RETURN NOW
	LOAD	S1,LGN.JB(M),LG.JOB	;GET THE USERS JOB NUMBER
	PUSHJ	P,D$FMDR##		;FIND HIS MDR (MOUNT QUEUE)
	JUMPF	.RETT			;NOT THERE,,JUST RETURN

LOGN.2:	DMOVE	S1,LGN.US(M)		;GET THE USERS NAME
	DMOVEM	S1,.MRNAM(AP)		;SAVE IT
	$RETT				;RETURN
	SUBTTL	I$NINT - ROUTINE TO SET QUASAR UP FOR NETWORK INTERRUPTS

I$NINT:	MOVX	T1,.PCNET		;GET NETWORK INTERRUPT CODE
	MOVSI	T2,4			;GET OFFSET TO INTERRUPT VECTOR
	SETZM	T3			;CLEAR LAST WORD OF ARG BLOCK
	MOVX	S1,<PS.FON+PS.FAC+T1>	;GET PISYS. ARGUMENT BLOCK ADDRESS
	PISYS.	S1,			;ENABLE FOR NETWORK INTERRUPTS
	$RETT				;IGNORE ANY ERRORS
	$RETT				;RETURN OK
	SUBTTL	DOGTAB  --  Routine to do necessary gettabs

	;CALL WITH S1 CONTAINING THE GETTAB TO BE DONE.

DOGTAB:	GETTAB	S1,			;DO THE GETTAB
	STOPCD	(NGF,HALT,,<Necessary GETTAB failed>)
	$RETT				;AND RETURN


	SUBTTL	GETTTY  -- GET TERMINAL DATA ON A PARTICULAR JOB

	;CALL:	S1/ The Job Number
	;
	;RET:	S1/ The terminal Designator
	;	S2/ Located node number,,line number

GETTTY:	MOVE	S2,S1			;GET THE JOB NUMBER IN S2
	TRMNO.	S2,			;GET THE CONTROLLING TTY
	JRST	GETT.1			;CAN'T,,RETURN
	HRRZ	TF,S2			;GET THE LINE NUMBER
	GETLCH	TF			;GET THE TTY LINE CHARACTERISTICS
	MOVE	S1,[ASCII/T/]		;DEFAULT TO A TTY
	TXNE	TF,GL.ITY		;ARE WE A PTY ???
	MOVE	S1,[ASCII/P/]		;YES,,SAY SO
	TXNE	TF,GL.CTY		;ARE WE THE CTY ???
	MOVE	S1,[ASCII/C/]		;YES,,SAY SO
	GTNTN.	S2,			;GET THE NODE,,LINE NUMBER
	JRST	GETT.1			;CAN'T,,RETURN
	$RETT				;RETURN

GETT.1:	MOVE	S1,[ASCII/D/]		;MAKE US DETAHCED
	HRLZ	S2,G$LNBR##		;GET HOST NUMBER,,0
	$RETT				;RETURN


	SUBTTL	I$MNTC - Get mount count for a structure

	;CALL:	S1/ SIXBIT structure name
	;
	;RET:	S1/ Mount count
	;	S2/ Free blocks

I$MNTC:	STKVAR	<<BUFR,20>>		;GET SPACE FOR DSKCHR
	MOVEI	S2,BUFR			;GET THE DSKCHR BUFFER ADDRESS
	MOVEM	S1,.DCNAM(S2)		;SET THE STR NAME IN THE ARG BLOCK
	HRLI	S2,.DCSMT+1		;GET BLOCK LENGTH,,ADDRESS
	DSKCHR	S2,			;GET THE INFO FROM THE MONITOR
	JRST	MNTC.1			;CAN'T, SO RETURN FALSE
	MOVEI	S1,BUFR			;GET THE BUFFER ADDRESS
	MOVE	S2,.DCFCT(S1)		;AND GET THE NUMBER OF FREE BLOCKS
	MOVE	S1,.DCSMT(S1)		;GET THE MOUNT COUNT
	$RETT				;RETURN

MNTC.1:	SETZB	S1,S2			;CLEAR MOUNT COUNT, # FREE
	$RETF

	SUBTTL	I$GATR - ROUTINE TO GET A DEVICE'S ATTRIBUTES AND SAVE IN UCB

	;CALL:	S1/ The UCB Address
	;
	;RET:	True Always

I$GATR:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A MINUTE
	MOVE	P2,S1			;SAVE THE UCB ADDRESS
	MOVE	P1,.UCBNM(P2)		;GET THE UNIT NAME
	MOVE	S1,P1			;HERE ALSO
	DEVTYP	S1,			;GET THE DEVICE TYPE
	$RETT				;DEVTYP FAILED,,JUST RETURN
	LOAD	S1,S1,TY.DEV		;GET THE TYPE CODE IN S1
	CAIN	S1,.TYDTA		;IS IT A DECTAPE?
	JRST	GATR.3			;YES
	CAXN	S1,.TYMTA		;IS IT A MAG TAPE ???
	JRST	GATR.1			;YES,,GO PROCESS IT
	CAXN	S1,.TYDSK		;IS IT A DISK ???
	JRST	GATR.0			;YES - GO PROCESS IT
	$RETT				;NON OF THE ABOVE

	;Here to update device attributes for disks

GATR.0:	$SAVE	T1			;SAVE T1 FOR A SECOND
	MOVEM	P1,ACTSTR		;SAVE DEVICE NAME IN DSKCHR BUFFER
	MOVE	S1,[30,,ACTSTR]		;GET DSKCHR PARMS
	DSKCHR	S1,			;GET DISK CHARACTERISTICS
	STOPCD	(CDC,HALT,,<Can't get disk characteristics for unit (in T1)>)
	MOVE	T1,S1			;SAVE THE DISK STATUS BITS FOR A MINUTE
	LOAD	S1,ACTSTR+.DCALT	;GET ALTERNATE UNIT NAME
	STORE	S1,.UCBAU(P2)		;SAVE IT
	SETZM	S2			;CLEAR S2
	MOVX	S1,%DISK		;THIS IS A DISK UCB
	STORE	S1,S2,UC.DVT		;SO SAVE IT AS THE DEVICE TYPE
	LOAD	S1,T1,DC.STS		;GET THE DEVICE STATUS BITS
	CAXE	S1,.DCSTD		;IS THE DEVICE DOWN ???
	TXO	S2,UC.AVA+UC.AVR	;NO,,LITE AVAILABLE+AVR
	LOAD	S1,T1,DC.CNT		;GET THE CONTROLLER TYPE
	STORE	S1,S2,UC.KTP		;SAVE IT
	LOAD	S1,T1,DC.UNT		;GET THE UNIT TYPE
	STORE	S1,S2,UC.UTP		;SAVE IT
	MOVEM	S2,.UCBST(P2)		;SAVE THE DEVICE STATUS WORD
	MOVE	S1,S2			;GET THE UCB STATUS BITS
	PUSHJ	P,D$DNRS##		;GET THE RESOURCE NUMBER
	JUMPF	GATR.2			;THAT LOSES,,HMMMMM
	STORE	S1,.UCBST(P2),UC.RSN	;AND SAVE IT
	$RETT				;DONE,,RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;Here to update device attributes for Tapes

GATR.1:	$SAVE	<T1,T2>			;SAVE T1 AND T2
	SETZM	S2			;CLEAR S2
	MOVX	T1,.TFTRK		;GET 'READ TRACK STATUS' FUNCTION
	MOVE	T2,P1			;GET THE DEVICE NAME IN T2
	MOVE	S1,[2,,T1]		;GET TAPOP. PARAMETERS
	TAPOP.	S1,			;GET DEVICE TRACK STATUS
	STOPCD	(CDT,HALT,,<Can't determine tape track status>)
	MOVE	S1,[EXP %TRK9,%TRK7](S1) ;GET THE TRACK STATUS CODE
	STORE	S1,S2,UC.TRK		;SAVE THE TRACK STATUS CODE
	MOVX	T1,.TFPDN		;GET 'READ DENSITIES' FUNCTION
	MOVE	S1,[2,,T1]		;GET TAPOP. PARAMETERS
	TAPOP.	S1,			;READ POSSIBLE DENSITIES
	STOPCD	(CDD,HALT,,<Can't determine tape densities>)
	TXNE	S1,TF.DN1		;SUPPORT 200 BPI ???
	TXO	S2,UC.200		;YES,,SET IT
	TXNE	S1,TF.DN2		;SUPPORT 556 BPI ???
	TXO	S2,UC.556		;YES,,SET IT
	TXNE	S1,TF.DN3		;SUPPORT 800 BPI ???
	TXO	S2,UC.800		;YES,,SET IT
	TXNE	S1,TF.DN4		;SUPPORT 1600 BPI ??
	TXO	S2,UC.1600		;YES,,SET IT
	TXNE	S1,TF.DN5		;SUPPORT 6250 BPI ??
	TXO	S2,UC.6250		;YES,,SET IT
	MOVX	T1,.TFSTS		;GET CODE TO READ DEVICE STATUS
	MOVE	S1,[2,,T1]		;GET THE TAPOP. PARM BLOCK
	TAPOP.	S1,			;GET THE DEVICE STATUS BITS
	STOPCD	(CGS,HALT,,<Can't get status of tape drive (in P1)>)
	TXNE	S1,TF.OFL		;IS THE DRIVE OFFLINE ???
	TXO	S2,UC.OFL		;YES,,SET IT
	MOVX	T1,.TFKTP		;GET 'GET CONTROLLER TYPE' FUNCTION
	MOVE	S1,[2,,T1]		;GET TAPOP. PARM BLOCK
	TAPOP.	S1,			;GET THE CONTROLLER TYPE
	STOPCD	(CGC,HALT,,<Can't get controller type for tape drive (in P1)>)
	STORE	S1,S2,UC.KTP		;SAVE THE CONTROLLER TYPE
	MOVX	S1,%TAPE		;GET 'MAG TAPE' UCB TYPE
	STORE	S1,S2,UC.DVT		;SAVE AS THE DEVICE TYPE
	MOVE	S1,P1			;GET DEVICE NAME
	PUSHJ	P,I$CKAV		;SEE IF ANYONE OWNS IT
	SKIPT				;SKIP IF OWNED..
	TXO	S2,UC.AVA		;[1151]DEFAULT TO 'AVAILABLE'
	LOAD	S1,.UCBST(P2),UC.AVR	;PRESERVE AVR BIT
	STORE	S2,.UCBST(P2)		;SAVE THE DEVICE STATUS BITS
	STORE	S1,.UCBST(P2),UC.AVR	;RESTORE ORIGINAL AVR SETTING
	MOVE	S1,P1			;GET THE DEVICE NAME IN S1
	TXNE	S2,UC.AVA		;ARE WE MAKING IT AVAILABLE?
	PUSHJ	P,I$MDAS		;MAKE THE DEVICE CONTROLLED BY US
	MOVE	S1,.UCBST(P2)		;GET THE UCB STATUS BITS
	AND	S1,[UC.200+UC.556+UC.800+UC.1600+UC.6250] ;SAVE ONLY THESE BITS
	LOAD	S2,.UCBST(P2),UC.TRK	;GET THE TRACK CODE
	PUSHJ	P,D$TNRS##		;GET THE RESOURCE NUMBER
	JUMPF	GATR.2			;THAT LOSES,,HMMMMM
	STORE	S1,.UCBST(P2),UC.RSN	;AND SAVE IT
	$RETT				;DONE,,RETURN

GATR.2:	MOVX	S1,UC.AVA		;GET AVR BIT
	ANDCAM	S1,.UCBST(P2)		;CLEAR THEM (DEVICE IS UNKNOWN)
	$RETF				;RETURN

GATR.3:	SETZ	S2,			;INIT STATUS FLAG WORD
	MOVX	S1,%DTAP		;GET 'DECTAPE' UCB TYPE
	STORE	S1,S2,UC.DVT		;SAVE AS THE DEVICE TYPE
;	MOVE	S1,P1			;GET DEVICE NAME
;	PUSHJ	P,I$CKAV		;SEE IF ANYONE OWNS IT
;	SKIPT				;SKIP IF OWNED..
	TXO	S2,UC.AVA		;DEFAULT TO 'AVAILABLE'
	MOVEM	S2,.UCBST(P2)		;SAVE THE DEVICE STATUS BITS
	MOVE	S1,P1			;GET THE DEVICE NAME IN S1
	TXNE	S2,UC.AVA		;ARE WE MAKING IT AVAILABLE?
	PUSHJ	P,I$MDAC		;MAKE SURE DVCMDA IS ALWAYS CLEAR
	PUSHJ	P,D$ONRS##		;GET THE RESOURCE NUMBER
	JUMPF	GATR.2			;THAT LOSES,,HMMMMM
	STORE	S1,.UCBST(P2),UC.RSN	;AND SAVE IT
	$RETT				;DONE,,RETURN
SUBTTL	I$SDEN - Set density for a magtape drive


; Here on a call from QSRMDA's reassign code to set the density of
; of a drive before we give it away.
; Call:	MOVE	S1, sixbit unit name
;	MOVE	S2, density code
;	PUSHJ	P,I$SDEN
;
I$SDEN::PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,[3,,TF]		;SET UP UUO
	MOVEI	TF,.TFDEN+.TFSET	;FUNCTION CODE TO SET DENSITY
	TAPOP.	P1,			;SET THE DENSITY
	  $RETF				;SHOULDN'T FAIL
	$RETT				;RETURN
SUBTTL	I$GDEN - Get density for a magtape drive

;CALL:	MOVE	S1,sixbit unit name
;	PUSHJ	P,I$GDEN
;RET:	S2/	Density of drive
;
I$GDEN::PUSHJ	P,.SAVE1		;[1133]SAVE P1
	MOVE	P1,[3,,TF]		;[1133]SET UP UUO
	MOVEI	TF,.TFDEN		;[1133]FUNCTION CODE TO READ DENSITY
	TAPOP.	P1,			;[1133]READ THE DENSITY
	 $RETF				;[1133]SHOULD NOT FAIL
	MOVE	S2,P1			;[1133]RETURN IN S2
	 $RETT				;[1133]AND RETURN
SUBTTL	I$SLBT - Set label type for a magtape drive


; Here on a call from QSRMDA's reassign code to set the label type
; of a drive before we give it away.
; Call:	MOVE	S1, sixbit unit name
;	MOVE	S2, label type code
;	PUSHJ	P,I$SLBT
;
I$SLBT::PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,[3,,TF]		;SET UP UUO
	MOVEI	TF,.TFLBL+.TFSET	;FUNCTION CODE TO SET LABEL TYPE
	TAPOP.	P1,			;SET THE LABEL TYPE
	  $RETF				;SHOULDN'T FAIL
	$RETT				;RETURN
SUBTTL	I$MTAC - Magtape unit accessible message progessing


; Here when we get a message from the monitor telling us there is a
; new magtape unit we ought to know about.
; Call:	M/ message address
;
; TRUE return:	always
; FALSE return:	can't happen
;
I$MTAC::PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,.MTAUN(M)		;GET UNIT FROM MESSAGE
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	$CALL	L%FIRST			;GET THE FIRST UCB ENTRY
	SKIPA				;SKIP THE FIRST TIME

MTAC.1:	$CALL	L%NEXT			;GET THE NEXT UCB ENTRY
	  JUMPF	MTAC.2			;NO MATCHES - THATS OK
	CAME	P1,.UCBNM(S2)		;A MATCH?
	JRST	MTAC.1			;NO - TRY ANOTHER UCB
	$RETT				;ALREADY KNOW ABOUT THIS ONE

MTAC.2:	MOVE	S1,UCBQUE##		;GET UCB QUEUE ID
	MOVEI	S2,UCBLEN		;GET UCB LENGTH
	$CALL	L%CENT			;CREATE A NEW UCB FOR THIS UNIT
	  JUMPF	.RETT			;CAN'T - IGNORE THE ERROR
	MOVEM	P1,.UCBNM(S2)		;SAVE UNIT NAME
	MOVE	P1,S2			;COPY UCB ADDRESS
	MOVE	S1,P1			;GET UCB ADDRESS
	PUSHJ	P,I$GATR		;SETUP THE UNITS ATTRIBUTES
	MOVE	S1,P1			;GET UCB ADDRESS
	PUSHJ	P,D$INCA##		;INCRIMENT THE 'A' MATRIX
	$WTO	(<Device ^W/.MTAUN(M)/ accessible>,,,<$WTFLG(WT.SJI)>)
	MOVE	S1,.MTAUN(M)		;GET THE UNIT NAME
	$RETT				;RETURN

SUBTTL	I$MSTR - PROCESS MONITOR STRUCTURE MOUNTED MSG

;This routine extracts each unit from the .IPCST message and kicks
;PULSAR to recognize labels on the device. If the UCB for the unit
;doesn't exist, one is created. The UC.FRC bit is lit in the UCB
;indicating that the volume(s) is/are being mounted by someone other
;than PULSAR.

;CALL: 	M/ The message address

;RET: 	True always

I$MSTR:	PUSHJ	P,.SAVE3		;[1217] SAVE P1-P3
	HLRZ	P2,.IPCS0(M)		;[1217] GET LENGTH OF MSG
	CAIGE	P2,3			;[1217] MUST CONTAIN AT LEAST STR AND UNIT
	$RETT				;[1217] IGNORE IF TOO SHORT
	MOVNI	P2,-2(P2)		;[1217] BUILD AOBJN
	HRLI	P2,.IPCS2(M)		;[1217]   PTR TO PICK UP
	MOVSS	P2			;[1217]     UNITS IN MESSAGE
MSTR.1:	SKIPN	P1,(P2)			;[1217] GET SIXBIT UNIT NAME
	STOPCD	(MUN,HALT,,<Missing unit name in .IPCST message>) ;[1217] SO THERE!
	MOVE	S1,P1			;[1217] GET UNIT NAME IN S1
	PUSHJ	P,D$GUCB##		;[1217] GO SEE IF UCB EXISTS
	JUMPT	MSTR.3			;[1217] UCB EXISTS, GO KICK PULSAR
	MOVE	S1,UCBQUE##		;[1217] NO UCB, CREATE ONE
	MOVX	S2,UCBLEN		;[1217] FOR THIS UNIT.
	PUSHJ	P,L%CENT		;[1217]
	MOVE	S1,S2			;[1217] GET THE ADDRESS OF UCB
	MOVE	P3,S1			;[1217] SAVE ACROSS NEXT CALL
	MOVEM	P1,.UCBNM(S1)		;[1217] STORE UNIT NAME IN UCB
	PUSHJ	P,I$GATR		;[1217] GO FILL IN SPECIFICS
	MOVE	S1,P3			;[1217] GET UCB ADDRESS BACK
	PUSHJ	P,D$INCA##		;[1217] UPDATE 'A' MATRIX
	MOVE	S1,P3			;[1217] GET UCB ADDRESS AGAIN

MSTR.3:	MOVX	S2,UC.AVR!UC.AVA	;[1217] THIS DEVICE IS AVAILABLE AND
	IORM	S2,.UCBS0(S1)		;[1217] WE'RE GOING TO READ LABELS!
	MOVX	S2,U1.FRC		;[1217] GET 'FORCED MOUNT' BIT
	IORM	S2,.UCBS1(S1)		;[1217] LITE IN SECOND UCB STATUS WORD
	MOVE	S1,P1			;[1217] GET SIXBIT UNIT NAME AGAIN
	PUSHJ	P,D$SREC##		;[1217] SEND RECOGNIZE MSG TO PULSAR
	AOBJN	P2,MSTR.1		;[1217] LOOP FOR ALL UNITS IN MSG
	$RETT				;[1217] RETURN AND WAIT FOR PULSAR ACK
	SUBTTL	I$ATCH/I$DTCH - ATTACH/DEATCH MESSAGE PROCESSING ROUTINES

	;CALL:	M/ The Message Address
	;
	;RET:	True Always

I$ATCH:	TDZA	TF,TF			;INDICATE ATTACH ENTRY
I$DTCH:	SETOM	TF			;INDICATE DETACH ENTRY
	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,TF			;SAVE THE ENTRY POINT
	MOVSI	P2,-3			;WANT 3 WORDS
	HRRI	P2,.ATTUN(M)		;POINT TO THE FIRST UNIT
DTCH.0:	MOVE	S1,0(P2)		;GET A UNIT
	PUSHJ	P,DTCH.X		;GET ITS UCB
	SKIPT				;FOUND,,CONTINUE
	AOBJN	P2,DTCH.0		;NOT THERE,,TRY ANOTHER
	JUMPL	P2,DTCH.1		;GO IF FOUND A MATCH
	JUMPN	P1,.RETT		;NONE FOUND, IF DETACH THEN RETURN
	MOVE	S1,UCBQUE##		;IF ATTACH,,THEN GET UCB QUEUE ID
	MOVX	S2,UCBLEN		;  AND GET A UCB LENGTH
	PUSHJ	P,L%CENT		;CREATE A NEW UCB FOR THIS UNIT
	MOVE	S1,.ATTUN(M)		;GET THE NEW UNIT NAME
	MOVEM	S1,.UCBNM(S2)		;SAVE IT
	MOVE	S1,S2			;GET THE ADDRESS IN S1
DTCH.1:	MOVE	P2,S1			;SAVE THE UCB ADDRESS
	MOVEI	S1,[ASCIZ/Attached/]	;DEFAULT TO ATTACH
	SKIPE	P1			;UNLESS THIS IS DEATCH
	MOVEI	S1,[ASCIZ/Detached/]	; THEN MAKE IT DEATCHED
	$WTO	(<Device ^W/.ATTUN(M)/ ^T/0(S1)/>,,,<$WTFLG(WT.SJI)>)
	JUMPE	P1,ATCH.2		;IF ATTCH,,SKIP DETACH CODE

	;  .DETACH xxx processing routine

	SKIPN	S1,.ATTPR(M)		;NEW PRIME UNIT?
	JRST	DTCH.2			;NO, DETACHED ONLY PORT, DESTROY UCB
	SETZ	S2,			;GET A ZERO
	EXCH	S2,.UCBAU(P2)		;NO ALTERNATE NOW
	CAMN	S1,S2			;IS NEW PRIME OLD ALTERNATE?
	MOVEM	S1,.UCBNM(P2)		;YES, RESET THE NAME IN THE UCB
	$RETT				;DONE

DTCH.2:	MOVE	S1,P2			;GET THE UCB ADDRESS IN S1
	PUSHJ	P,D$DECA##		;DECRIMENT THE 'A' MATRIX
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	MOVE	S2,P2			;GET THE UCB ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THIS ENTRY
	PUSHJ	P,L%DENT		;   AND DELETE IT
	PUSHJ	P,D$DLOK##		;TAKE A RUN THROUGH THE DEADLOCK CHECK
	JUMPT	.RETT			;OK,,WHEW !!!
	$WTO	(<Warning: ^T/BELLS/System Deadlock Detected>,<Reason: Unit ^W/.ATTUN(M)/ was Detached>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	; .ATTACH xxxx processing routine

ATCH.2:	LOAD	S1,.UCBST(P2),UC.AVA	;GET THE AVAILABLE BIT
	JUMPN	S1,ATCH.3		;IF SET,,DON'T ALTER AVAILABLE COUNT
	MOVE	S1,P2			;GET THE UCB ADDRESS
	PUSHJ	P,I$GATR		;SETUP THE UNITS ATTRIBUTES
	MOVE	S1,P2			;GET THE UCB ADDRESS IN S1
	PUSHJ	P,D$INCA##		;INCRIMENT THE 'A' MATRIX

ATCH.3:	MOVE	S1,.ATTPR(M)		;GET THE NEW PRIMARY PORT
	MOVEM	S1,.UCBNM(P2)		;SAVE IT
	MOVE	S2,.ATTSC(M)		;GET THE SECONDARY PORT
	MOVEM	S2,.UCBAU(P2)		;SAVE IT
	MOVE	TF,[.DUCLM,,S1]		;GET DISK. ARG PARMS
	DISK.	TF,			;CLEAR MDA WAIT FOR PRIMARY PORT
	JFCL				;IGNORE ANY ERROR
	MOVE	TF,[.DUCLM,,S2]		;GET DISK. ARG PARMS
	DISK.	TF,			;CLEAR MDA WAIT FOR SECONDARY PORT
	JFCL				;IGNORE ANY ERROR
	JUMPN	P1,.RETT		;IF 'DETACH',,THEN JUST RETURN
	SKIPE	.UCBVL(P2)		;UNIT PART OF A MOUNTED STRUCTURE?
	$RETT				;YES--JUST RECOGNIZE IS REDUNDANT
	MOVE	S1,.ATTUN(M)		;GET UNIT THAT WAS ATTACHED
	PJRST	D$SREC##		;RECOGNIZE IT

	;Locate the attached/detached units UCB

DTCH.X:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	SKIPN	P1,S1			;SAVE THE UNIT WE WRE LOOKING FOR
	$RETF				;UNIT IS 0,,RETURN NOW
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST UCB ENTRY
	SKIPA				;SKIP THE FIRST TIME
DTCH.Y:	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ENTRY
	JUMPF	.RETF			;NO MORE,,RETURN
	CAME	P1,.UCBNM(S2)		;DO WE MATCH PRIMARY PORTS ???
	CAMN	P1,.UCBAU(S2)		;  OR SECONDARY PORTS ???
	SKIPA				;FOUND,,CONTINUE
	JRST	DTCH.Y			;NO,,TRY NEXT UCB
	MOVE	S1,S2			;GET THE UCB ADDRESS IN S1
	$RETT				;AND RETURN

	SUBTTL	I$SLCM - PROCESS MONITOR SEARCH LIST CHANGE MESSAGES

	;CALL:	M/ The Message Address
	;
	;RET:	True Always

I$SLCM:	PUSHJ	P,.SAVE3		;[1155]SAVE P1 - P3 FOR A MINUTE
	$SAVE	<M>			;[1155]SAVE M ALSO
	MOVE	S1,1(M)			;[1155]GET THE JOBS JOB NUMBER
	PUSHJ	P,D$FMDR##		;[1155]LOCATE ITS MDR
	JUMPT	SLCM.0			;[1155]FOUND,,CONTINUE
	HRL	S1,1(M)			;[1155]GET THE JOB NUMBER BACK
	HRRI	S1,.GTOBI		;[1172] GET BATCH/WTOR WORD
	GETTAB	S1,			;READ JOBS LIMITS
	$RETT				;FAILED,,RETURN
	TXNE	S1,OB.BSS		;[1172] IS THIS A BATCON BATCH JOB?
	$RETT				;[1172] YES,,LEAVE
	SETZM	AP			;[1155]NO MDR YET !!!

SLCM.0:	PUSHJ	P,REMSTR		;[1155]GET RID OF DELETED STRUCTURES
	LOAD	P2,.MSTYP(M),MS.CNT	;[1155]GET THE MONITOR MESSAGE LENGTH
	SUBI	P2,2			;[1155]DELETE HEADER AND JOB NBR LENGTHS
	JUMPLE	P2,.RETT		;[1155]STRUCTURE COUNT ZERO, RETURN
	PUSHJ	P,M%GPAG		;GET A PAGE FOR DUMMY MESSAGE
	MOVE	P1,S1			;SAVE ITS ADDRESS
	MOVEM	P1,ACTSTR		;HERE ALSO (MORE PERMENANT)
	MOVX	S1,.MMHSZ		;GET THE MESSAGE HEADER LENGTH
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IT
	MOVEI	P3,.MMHSZ(P1)		;POINT TO BLOCK AREA
	MOVEI	T2,1(M)			;SKIP OVER THE MSG HEADER

SLCM.1:	AOS	T2			;POINT TO THE NEXT STRUCTURE NAME
	MOVE	S1,0(T2)		;GET A STRUCTURE NAME
	PUSHJ	P,D$FNDV##		;GO FIND IT
	JUMPF	SLCM.2			;NOT THERE,,TRY NEXT
	LOAD	S1,.VLFLG(S1),VL.STA	;GET THE VOLUME STATUS
	CAXE	S1,%STAMN		;IF MOUNTED,,CONTINUE
	JRST	SLCM.2			;SHOULD NOT HAPPEN
	AOS	.MMARC(P1)		;BUMP ENTRY COUNT BY 1
	AOS	.MECNT(P3)		;BUMP VOLUME SET COUNT BY 1
	MOVE	T1,[.MEHSZ+ARG.DA+1,,.MNTST] ;GET THE ENTRY BLOCK HEADER
	MOVEM	T1,.MEHDR(P3)		;SAVE IT
	MOVE	T1,[2,,.TMSET]		;GET THE VOL SET NAME BLOCK HEADER
	MOVEM	T1,.MEHSZ+ARG.HD(P3)	;SAVE IT
	$TEXT	(<-1,,.MEHSZ+ARG.DA(P3)>,<^W/0(T2)/^0>)
	MOVSI	T1,.MEHSZ+ARG.DA+1	;GET THE ENTRY LENGTH
	ADDM	T1,0(P1)		;ADD IT TO THE TOTAL MSG LENGTH
	MOVEI	P3,.MEHSZ+ARG.DA+1(P3)	;POINT TO THE NEXT MSG ENTRY

SLCM.2:	SOJG	P2,SLCM.1		;CONTINUE FOR ALL STRUCTURES
	SKIPN	.MMARC(P1)		;ANY STRUCTURES PROCESSED ???
	JRST	SLCM.6			;NO,,SKIP THIS

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	HRL	S1,1(M)			;GET THE USERS JOB NUMBER
	HRRI	S1,.GTNM1		;GET FIRST 6 CHARS OF HIS NAME
	GETTAB	S1,			;ASK MONITOR
	 JRST	SLCM.6			;NO GOOD,,MUST HAVE LOGGED OUT
	MOVEM	S1,.MMUSR(P1)		;SAVE IT
	HRL	S1,1(M)			;GET THE USERS JOB NUMBER
	HRRI	S1,.GTNM2		;GET SECOND 6 CHARS OF HIS NAME
	GETTAB	S1,			;ASK MONITOR
	 JRST	SLCM.6			;NO GOOD,,MUST HAVE LOGGED OUT
	MOVEM	S1,.MMUSR+1(P1)		;SAVE IT
	HRL	S1,1(M)			;GET THE USERS JOB NUMBER
	HRRI	S1,.GTPPN		;GET THE USERS PPN
	GETTAB	S1,			;ASK MONITOR
	 JRST	SLCM.6			;NO GOOD,,MUST HAVE LOGGED OUT
	MOVEM	S1,G$SID##		;SAVE IT
	SETOM	G$SND##			;INVALID SENDERS PID
	SETZM	G$ACK##			;NO ACK HERE !!!
	MOVE	S1,1(M)			;GET THE USERS JOB NUMBER
	STORE	S1,G$PRVS##,MR.JOB	;SAVE IT
	MOVE	M,P1			;GET THE MSG ADDRESS IN 'M'
	PUSHJ	P,D$CMDR##		;CREATE/MODIFY THE USERS MDR
	JUMPF	SLCM.6			;NO GOOD,,JUST LEAVE !!!

	;Create won, so check users allocation and make sure its ok

	MOVE	P1,S1			;SAVE THE VSL ADDRESS (FROM D$CMDR)
	PUSHJ	P,D$ALOC##		;TRY TO PERFORM ALLOCATION
	JUMPF	SLCM.7			;CAN'T,,USERS IN DEEP TROUBLE !!!

	;Allocation won, so make sure there is no Deadlock possible

	MOVE	S1,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,D$DLCK##		;PERFORM DEADLOCK CHECK
	JUMPF	SLCM.7			;UH OH,,TOOO BAD !!!

	;OK, Loop through all users VSL's and Mount those structures we added

	LOAD	T1,.VSLNK(P1),VS.LNK	;GET THE VSL LINK CODE
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;POINT TO THE USERS VSL LIST

SLCM.3:	MOVE	S1,0(P2)		;GET A VSL ADDRESS
	LOAD	S2,.VSLNK(S1),VS.LNK	;GET ITS LINK CODE
	CAMN	S2,T1			;DO THEY MATCH ???
	PUSHJ	P,D$SETO##		;YES,,SET UP OWNERSHIP !!!
	AOBJN	P2,SLCM.3		;CONTINUE THROUGH ALL VSL'S

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

SLCM.6:	MOVE	S1,ACTSTR		;GET THE MESSAGE ADDRESS
	PJRST	M%RPAG			;RETURN THROUGH MEMORY MANAGER

SLCM.7:	PUSHJ	P,MDASBP##		;SET UP FOR CALLS TO MDADBP
	$TEXT	(MDADBP,<Deadlock Detected^M^J Structure(s) ^A>)
	LOAD	T1,.VSLNK(P1),VS.LNK	;GET THE VOLUME SET LINK CODE
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	MOVEI	T2,.MRVSL(AP)		;POINT TO THE VSL LIST

SLCM.8:	MOVE	S1,0(T2)		;GET A VSL ADDRESS
	LOAD	S2,.VSLNK(S1),VS.LNK	;GET ITS LINK CODE
	CAMN	S2,T1			;DO THEY MATCH ???
	SKIPE	.VSUCB(S1)		;YES,,IS IT MOUNTED ???
	JRST	SLCM.9			;NO MATCH OR MOUNTED,,TRY NEXT VSL
	$TEXT	(MDADBP,<^T5/.VSVSN(S1)/^A>)
	MOVE	S2,.VSVOL(S1)		;POINT TO THE VOL BLOCK
	PUSH	P,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$DSLM##		;DELETE THE STR FROM THE USER (HEE HEE)
	POP	P,S1			;RESTORE THE VSL ADDRESS
	PUSHJ	P,D$DVSL##		;DELETE THE VSL !!!
	SKIPA				;SKIP OVER VSL POINTER UPDATE

SLCM.9:	AOS	T2			;POINT TO THE NEXT VSL ADDRESS
	SOJG	P1,SLCM.8		;CONTINUE FOR ALL VSL'S

	$TEXT	(MDADBP,<Removed From Search List^0>)
	PUSH	P,.MRFLG(AP)		;SAVE THE USERS FLAG WORD
	SETZB	S1,.MRFLG(AP)		;[1173] MAKE SURE MDR ACK FLAGS LOOK VALID
	MOVX	S1,MR.NOT		;GET THE NOTIFY BIT
	IORM	S1,.MRFLG(AP)		;LITE THE NOTIFY FLAG
	SETOM	ERRACK##		;THIS IS AN ERROR !!!
	SETOM	S2			;[1173] USE MDR ACK FLAGS!
	PUSHJ	P,D$USRN##		;NOTIFY THE USER
	POP	P,.MRFLG(AP)		;RESTORE THE USERS FLAGS
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	SKIPN	S1			;SKIP IF NOT 0
	PUSHJ	P,D$DMDR##		;ELSE DELETE THE MDR
	MOVE	S1,ACTSTR		;GET THE MESSAGE ADDRESS
	PJRST	M%RPAG			;RETURN THROUGH MEMORY MANAGER

	SUBTTL	REMSTR - ROUTINE TO VALIDATE THE SEARCH LIST CHANGE MESSAGE

	;CALL:	AP/ The MDR Address
	;	M/  The Search list change message
	;
	;RET:	True always

REMSTR:	JUMPE	AP,.RETT		;NO MDR,,RETURN
	PUSHJ	P,.SAVE3		;SAVE P1 AND P2 AND P3
	LOAD	P1,.MSTYP(M),MS.CNT	;GET THE MONITOR MESSAGE LENGTH
	SUBI	P1,2			;DELETE HEADER AND JOB NBR LENGTHS
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;POINT TO THE USERS VSL LIST
	PUSH	P,[-1]			;CREATE A QUEUE FOR VSL ADDRESSES

REMS.1:	MOVE	S1,0(P2)		;GET A VSL ADDRESS
	LOAD	S2,.VSFLG(S1),VS.TYP	;GET THE TYPE
	MOVX	TF,VS.CTL		;GET 'INITIAL PROC ALLOC' FLAG BIT
	TDNN	TF,.VSFLG(S1)		;PART OF INITIAL PSEUDO PROC ALLOC ??
	CAXE	S2,%DISK		;   OR IS IT A STRUCTURE ???
	JRST	REMS.2			;INITIAL ALLOC OR NOT A STR,,GET NEXT VSL
	PUSHJ	P,D$FOWN##		;DOES HE HAVE IT MOUNTED ???
	JUMPF	REMS.2			;NO,,GET NEXT VSL
	MOVX	S2,VL.ASK		;GET THE 'ASK' BIT
	TDNE	S2,0(S1)		;DOES HE REALLY HAVE IT MOUNTED ???
	JRST	REMS.2			;NO,,GET NEXT VSL
	MOVE	S1,0(P2)		;GET THE VSL ADDRESS BACK
	MOVE	S1,.VSVOL(S1)		;GET THE PRIMARY VOL BLK ADDRESS
	MOVE	S1,.VLNAM(S1)		;GET THE STRUCTURE NAME IN SIXBIT
	MOVEI	P3,2(M)			;[1160]POINT TO THE SEARCH LIST
	MOVE	S2,P1			;[1160]GET THE STRUCTURE COUNT IN S2
REM.1A:	JUMPLE	S2,REM.1B		;[1160]ANY MORE ????
	CAMN	S1,0(P3)		;[1160]FIND THE USERS STRUCTURE
	 JRST	REMS.2			;[1160]IF FOUND,,THEN ALLS OK
	AOS	P3			;[1160]POINT TO THE NEXT STRUCTURE
	SOS	S2			;[1160]DECREMENT THE STRUCTURE COUNT
	 JRST	REM.1A			;[1160]AND LOOP
REM.1B:	PUSH	P,0(P2)			;NOT THERE,,HE MUST HAVE DELETED IT
					;SO QUEUE UP THE VSL AND CONTINUE
					;CHECKING
REMS.2:	AOBJN	P2,REMS.1		;CHECK ALL VOLUME SETS

REMS.3:	POP	P,S1			;DE-QUEUE A VSL ADDRESS
	CAMN	S1,[-1]			;[1153]DONE ???
	 JRST	REMS.4			;[1153]YES!!!
	PUSH	P,S1			;[1153]SAVE VSL FOR A MINUTE
	PUSHJ P,D$DVSL##		;[1153]NO,,DELETE THE VSL
	POP	P,S1			;[1153]RESTORE VSL POINTER
	MOVE	S1,.VSVOL(S1)		;[1153]GET THE PRIMARY VOL BLK ADDRESS
	PUSHJ 	P,D$CCHK##		;[1153]HANDLE LOCKED STRUCTURES
	 JRST  REMS.3   		;[1153]CONTINUE TILL DONE
REMS.4:	LOAD	S1,.MRCNT(AP),MR.CNT	;[1153]FINISHED,,GET THE REQUEST COUNT
	SKIPN	S1			;NO MORE REQUESTS ???
	PUSHJ	P,D$DMDR##		;   THEN DELETE THE MDR
	$RETT				;RETURN
	SUBTTL	I$SSRL - ROUTINE TO BUILD A SEARCH LIST CHANGE MSG FOR A JOB

	;CALL:	S1/ THE JOB NUMBER
	;
	;RET:	TRUE ALWAYS

	INTERN	I$SSRL			;MAKE IT GLOBAL

I$SSRL:	$SAVE	M			;SAVE 'M' FOR A SECOND
	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	MOVE	P4,[IOWD ^D50,SSLMSG]	;ALLOCATE SPACE FOR THE MSG
	PUSH	P4,[2,,0]		;PUT IN HEADER
	PUSH	P4,S1			;AND JOB NUMBER
	MOVEI	M,SSLMSG		;POINT 'M' AT THE MSG
	MOVE	P1,S1			;SETUP GOBSTR PARM (JOB #)
	HRL	P2,P1			;GET JOB # IN LEFT HALF
	HRRI	P2,.GTPPN		;GET GETTAB PARM
	GETTAB	P2,			;SETUP GOBSTR PARM (PPN)
	$RETT				;CAN'T,,RETURN
	SETOM	P3			;FIRST STR IN SEARCH LIST

SSRL.1:	MOVE	S1,[3,,P1]		;GET GOBSTR PARM LIST
	GOBSTR	S1,			;GET A STRUCTURE
	$RETT				;RETURN ON AN ERROR
	JUMPE	P3,SSRL.1		;SKIP FENCE
	CAMN	P3,[-1]			;END OF LIST ???
	PJRST	I$SLCM			;YES,,GO PROCESS IT
	PUSH	P4,P3			;ADD THE STR TO THE MSG
	INCR	SSLMSG,LHMASK		;BUMP MSG LENGTH
	JRST	SSRL.1			;AND CONTINUE

SSLMSG:	BLOCK	^D50			;SPACE TO BUILD S/L CHANGE MESSAGE
	SUBTTL	I$BMDR - ROUTINE TO GENERATE AN MDR FOR A BATCH REQUEST

	;CALL:	M/ The Create Message Address
	;	S1/ The .QE Address
	;
	;RET:	True Always

I$BMDR:	LOAD	S2,.EQROB+.ROBTY(M)	;GET THE OBJECT TYPE
	SKIPE	G$MDA##			;WE MUST BE RUNNING WITH MDA ENABLED
	CAXE	S2,.OTBAT		;   AND THIS MUST BE A BATCH REQUEST
	$RETT				;NO,,RETURN NOW
	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	$SAVE	<M,AP,BM,CM,G$ACK##,G$PRVS##>	;SAVE LOTS OF VARIABLES !!!
	MOVE	P1,M			;SAVE THE MESSAGE ADDRESS
	MOVE	P4,S1			;SAVE THE QE ADDREESS
	MOVE	S1,.EQROB+.ROBND(M)	;GET THE DESTINATION NODE NAME
	PUSHJ	P,N$LOCL##		;CHECK FOR THE HOST SITE
	MOVX	S1,QE.WAL		;GET WAITING FOR ALLOCATION STATUS
	SETZM	S2			;ZAP ATTRIBUTES
	SKIPF				;IF DESTINED FOR THE HOST SYSTEM,,THEN
	LOAD	S2,.EQROB+.ROBAT(M),RO.ATR ;GET REQUEST ATTRIBUTES
	CAXN	S2,%GENRC		;IF HOST SYSTEM AND GENERIC,,THEN
	IORM	S1,.QESEQ(P4)		;   SET ALLOCATE FOR THIS REQUEST
	PUSHJ	P,M%GPAG		;GET A PAGE FOR SOME SCRATCH WORK
	MOVE	M,S1			;SAVE THE PAGE ADDRESS
	MOVX	S1,.MMHSZ		;GET THE MESSAGE HEADER LENGTH
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE IT
	MOVX	S1,.QIFNC		;GET THE INTERNAL FUNCTION CODE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE IT
	MOVEI	P3,.MMHSZ(M)		;POINT TO BLOCK AREA
	LOAD	P2,.EQLEN(P1),EQ.LOH	;GET THE HEADER LENGTH
	ADD	P2,P1			;POINT TO THE CONTROL FILE FP
	LOAD	S1,.FPLEN(P2),FP.LEN	;GET THE FP LENGTH
	ADD	P2,S1			;POINT TO THE CONTROL FILE FD
	MOVE	S1,.FDSTR(P2)		;GET THE CONTROL FILE STRUCTURE NAME
	PUSHJ	P,BMDR.A		;CREATE THE ENTRY FOR IT
	LOAD	S1,.FDLEN(P2),FD.LEN	;GET THE FD LENGTH
	ADD	P2,S1			;POINT TO THE LOG FILE FP
	LOAD	S1,.FPLEN(P2),FP.LEN	;GET THE LOG FILE FP LENGTH
	ADD	P2,S1			;POINT TO THE LOG FILE FD
	MOVE	S1,.FDSTR(P2)		;GET THE LOG FILE STRUCTURE NAME
	PUSHJ	P,BMDR.A		;CREATE THE ENTRY FOR IT
	DMOVE	S1,.EQOWN(P1)		;GET THE USERS NAME
	DMOVEM	S1,.MMUSR(M)		;SAVE IT
	MOVSI	S1,.EQACT(P1)		;GET THE ACCOUNT STRING ADDR
	HRRI	S1,.MMUAS(M)		;GET SOURCE,,DESTINATION
	BLT	S1,.MMUAS+10-1(M)	;COPY IT OVER
	MOVE	S1,.EQOID(P1)		;GET THE SENDERS PPN
	MOVEM	S1,G$SID##		;SET IT UP
	SETZM	G$ACK##			;ZAP THE ACK REQUEST FLAG
	MOVE	S1,.EQRID(P1)		;GET THE BATCH REQUEST ID
	TXO	S1,BA%JOB		;LITE THE BATCH FLAG BIT
	STORE	S1,G$PRVS##,MR.JOB	;AND SAVE IT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVE	S1,P4			;GET THE QE ADDRESS
	PUSHJ	P,D$MNTP##		;TRY TO MOUNT THE CTL & LOG FILE STRS

	SKIPN	AP,.QEMDR(P4)		;GET THE MDR ADDRESS (IF WE MADE IT)
	JRST	BMDR.2			;OH WELL,,CONTINUE ONWARD !!!
	LOAD	S1,G$PRVS##,MR.JOB	;GET THE 'JOB NUMBER'
	STORE	S1,.QEJBN(P4),QE.BJN	;SAVE THE JOB NUMBER IN THE QE
	LOAD	S2,.EQROB+.ROBTY(P1)	;[1176] GET THE OBJECT TYPE
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE REQUEST COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL AOBJN AC
	MOVX	P2,VS.UAL+VS.CTL	;'USER ALLOCATED+PSEUDO PROC ALLOC' BITS

BMDR.1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	IORM	P2,.VSFLG(S1)		;LITE THE FLAG BITS
	STORE	S2,.VSRFL(S1),MR.QUE	;[1176] STORE OBJECT TYPE
	AOBJN	P1,BMDR.1		;  FOR ALL VSL'S

BMDR.2:	MOVE	S1,M			;GET THE PAGE ADDRESS BACK
	PJRST	M%RPAG			;RETURN THROUGH THE MEMORY MANAGER

	;Routine to create  a mount message entry

BMDR.A:	CAMN	S1,[SIXBIT/NUL/]	;GOING TO NUL: ???
	$RETT				;YES,,THEN DON'T ENTER
	AOS	.MMARC(M)		;BUMP ENTRY COUNT BY 1
	AOS	.MECNT(P3)		;BUMP VOLUME SET COUNT BY 1
	MOVE	S2,[.MEHSZ+ARG.DA+1,,.MNTST] ;GET THE ENTRY BLOCK HEADER
	MOVEM	S2,.MEHDR(P3)		;SAVE IT
	MOVE	S2,[2,,.TMSET]		;GET THE VOL SET NAME BLOCK HEADER
	MOVEM	S2,.MEHSZ+ARG.HD(P3)	;SAVE IT
	$TEXT	(<-1,,.MEHSZ+ARG.DA(P3)>,<^W/S1/^0>)
	MOVSI	S2,.MEHSZ+ARG.DA+1	;GET THE ENTRY LENGTH
	ADDM	S2,0(M)			;ADD IT TO THE TOTAL MSG LENGTH
	MOVEI	P3,.MEHSZ+ARG.DA+1(P3)	;POINT TO THE NEXT MSG ENTRY
	$RETT				;RETURN

	SUBTTL	I$UMDR - ROUTINE TO PROCESS ALLOC UPDATE MSGS FROM BATCON

	;CALL:	M/ The Message Address
	;
	;RET:	True Always

I$UMDR:	PUSHJ	P,.SAVE3		;SAVE P1 AND P2 & P3 
	LOAD	S1,.OFLAG(M),PR.RID	;GET THE REQUEST ID
	PUSHJ	P,A$FREQ##		;FIND THE REQUEST QE ENTRY
	JUMPF	.RETT			;NOT THERE,,RETURN
	MOVE	P3,S1			;SAVE THE QE ADDRESS
	MOVX	S1,QE.WAL+QE.ALR	;GET 'ALLOCATION' BITS
	ANDCAM	S1,.QESEQ(P3)		;   AND CLEAR THEM
	LOAD	S1,.OFLAG(M),PR.NON	;ANY DATA IN THE MESSAGE ???
	JUMPN	S1,UMDR.3		;NO,,NO UPDATE TO PERFORM
	LOAD	S1,.OFLAG(M),PR.RID	;GET THE REQUEST ID
	TXO	S1,BA%JOB		;MAKE THIS A PSEUDO PROCESS
	STORE	S1,G$PRVS##,MR.JOB	;  SAVE THE 'JOB' NUMBER
	MOVE	S1,.QEOID(P3)		;GET THE REAL USER PPN
	MOVEM	S1,G$SID##		;AND SET IT
	MOVX	S1,.QIFNC		;GET THE INTERNAL FUNCTION CODE
	STORE	S1,.MSTYP(M),MS.TYP	;AND SET IT FOR THIS MSG
	PUSHJ	P,D$CMDR##		;UPDATE THE MDR
	JUMPF	UMDR.3			;FAILED,,IGNORE THE ALLOCATION
	MOVE	P2,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$ALOC##		;PERFORM ALLOCATION
	JUMPF	[JUMPL	S1,.RETT	;ALLOC POSTPONED,,JUST RETURN
		 MOVE	S1,P2		;ALLOC FAILED,,GET VSL ADDR BACK
		 PUSHJ	P,D$DLVS## 	;   DELETE ALL NEWLY ADDED VSL'S
		 JRST	UMDR.3 ]	;AND IGNORE THE ALLOCATION
	INCR	.MRCNT(AP),MR.LNK	;GEN A NEW LINK CODE
	LOAD	P2,.MRCNT(AP),MR.LNK	;AND LOAD IT
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE REQUEST NUMBER
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC

UMDR.1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	LOAD	S2,.VSFLG(S1),VS.ALC	;JUST ALLOCATING ???
	SKIPN	S2			;YES,,SKIP THIS
	STORE	P2,.VSLNK(S1),VS.LNK	;NO,,LINK THIS VSL TO ALL OTHER MOUNTS
	AOBJN	P1,UMDR.1		;LOOK AT ALL VSL'S
	JRST	UMDR.4			;AND MEET AT THE PASS

UMDR.3:	LOAD	S1,.QESEQ(P3),QE.WAM	;WAITING TO BE MOUNTED ???
	JUMPE	S1,[DOSCHD		;NO,,FORCE A SCHEDULING PASS
		    $RETT ]		;   AND RETURN
	MOVE	AP,.QEMDR(P3)		;GET THE MDR ADDRESS

UMDR.4:	MOVE	S1,.MRVSL(AP)		;GET THE FIRST VSL ADDRESS
	PUSHJ	P,D$MNTV##		;TRY TO MOUNT THE DEVICES
	$RETT				;AND RETURN
	SUBTTL	I$RALC - ROUTINE TO REQUEST ALLOCATION PROCESSING FOR A REQUEST

	;CALL:	AP/ The MDR Address
	;	S1/ The QE Address 
	;
	;RET:	True Always

	INTERN	I$RALC			;MAKE IT GLOBAL

I$RALC:	$SAVE	<M,P1,P2>		;SAVE M AND P1 AND P2
	MOVE	P1,S1			;SAVE THE QE ADDRESS
	PUSHJ	P,S$INPS##		;CHECK SCHEDULABILITY !!!
	JUMPF	.RETF			;FAILED,,RETURN NOW .....
	MOVE	S1,.QESEQ(P1)		;LOAD UP THE FLAG BITS
	TXNE	S1,QE.WAM+QE.ALR	;WAITING OR ALLOC ALREADY REQUESTED ???
	$RETF				;YES,,RETURN
	TXNN	S1,QE.WAL		;ARE WE WAITING FOR ALLOCATION ???
	$RETT				;NO,,HE WINS

RALC.1:	MOVX	S1,.OTBAT		;WANT BATCH OBJECT TYPE
	MOVX	S2,%GENRC		;WANT GENERIC BATCH PROCESSOR
	PUSHJ	P,A$LPSB##		;FIND THE BATCH PROCESSOR
	JUMPF	[SKIPN  G$PASS##	;PASS 2? NEED BATCON STARTED?
		 $RETT			;YES, LET IT SLIDE TILL NEXT TIME
		 $RETF]			;NO, SOMETHING'S AMISS
	MOVE	S1,PSBPID(S1)		;GET THE PID OF THE BATCH ALLOC PROC
	MOVEM	S1,G$SAB##+SAB.PD	;SET IT IN THE SAB

	MOVX	S1,QE.ALR		;GET ALLOCATION REQUESTED STATUS BIT
	IORM	S1,.QESEQ(P1)		;LITE THE BIT
	LOAD	S1,.QESTN(P1),QE.DPA	;GET THE REQUESTS DPA
	PUSHJ	P,F$RDRQ##		;READ IN THE EQ
	SKIPN	0(S1)			;A LITTLE SAFETY CHECK
	PUSHJ	P,S..NBR##		;SOMETHINGS WRONG !!!
	MOVE	P2,S1			;SAVE THE EQ ADDRESS
	MOVE	S1,.QERID(P1)		;GET THE QE RID
	MOVEM	S1,.EQRID(P2)		;AND SAVE IT

	MOVX	S1,.QOALC		;GET THE ALLOCATE MESSAGE TYPE
	STORE	S1,.MSTYP(P2),MS.TYP	;SET IT
	MOVEM	P2,G$SAB##+SAB.MS	;SAVE THE MESSAGE ADDRESS IN THE SAB
	MOVX	S1,PAGSIZ		;GET A PAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SET IT IN THE SAB
	SETZM	G$SAB##+SAB.SI		;NO SPECIAL PID INEDX
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	JUMPT	.RETF			;WIN,,RETURN
	ZERO	.QESEQ(P1),QE.ALR	;CLEAR REQUESTED STATUS
	JRST	RALC.1			;AND TRY AGAIN !!!
	SUBTTL	I$CHKL - ROUTINE TO CHECK TO SEE IF A JOB IS SCHEDULABLE

	;CALL:	S1/ The QE Address
	;	AP/ The MDR address
	;
	;RET:	True if OK, False otherwise

	INTERN	I$CHKL			;Make it global

I$CHKL:	$SAVE	<P1,P2>			;Save required ACs
	MOVE	P1,S1			;Save the QE address

	LOAD	P2,.MRCNT(AP),MR.CNT	;Get the request count
	MOVNS	P2			;Negate it
	MOVSS	P2			;Move right to left
	HRRI	P2,.MRVSL(AP)		;Create VSL search AC

CHKL.1:	MOVE	S1,0(P2)		;Get a VSL address in S1
	LOAD	S2,.VSFLG(S1),VS.TYP	;Get the request type
	CAXE	S2,%DISK		;For a structure ???
	JRST	CHKL.2			;No,,get next request
	MOVE	S1,.VSVOL(S1)		;Get the primary VOL block address
	LOAD	S2,.VLFLG(S1),VL.LCK	;Get the VOL lock status
	CAXE	S2,%LOCKD		;Is the structure locked ???
	CAXN	S2,%ULCKP		;   or locked with pending unlock ???
	$RETF				;Yes,,can't schedule this request
	CAXE	S2,%LOCKP		;Is it unlocked with a pending lock ???
	JRST	CHKL.2			;No,,check next request
	MOVE	S1,.VLLTM(S1)		;Yes,,load up the lock time
	SUB	S1,G$NOW##		;Calc number of jiffies remaining
	JUMPLE	S1,.RETF		;Already locked,,can't schedule
	IDIVI	S1,3			;Calc number of seconds remaining
	GETLIM	S2,.QELIM(P1),TIME	;Get the jobs run time in seconds
	CAMLE	S2,S1			;Can the job fit in the time remaining ?
	$RETF				;No,,can't schedult it

CHKL.2:	AOBJN	P2,CHKL.1		;Check all structure requests
	$RETT				;Done,,return
	SUBTTL	I$CUNK - CHECK FOR 'UNKNOWN' REQUEST TYPES IN MOUNT/ALLOCATE

	;CALL:	S1/ The VSL Address
	;
	;RET:	True Always
	;If the device is a DECtape, the %DTAP will be set in the VSL

	INTERN	I$CUNK			;MAKE IT GLOBAL

I$CUNK:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;GET THE VSL ADDRESS
	LOAD	S1,.VSFLG(P1),VS.TYP	;GET THE VOLUME SET TYPE
	CAXE	S1,%UNKN		;IS IT TYPE 'UNKNOWN' ???
	CAXN	S1,%DISK		;[1226] OR 'DISK' ???
	TRNA				;[1226] YES TO EITHER
	$RETT				;NO,,RETURN
	MOVE	S1,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,I$CGEN		;CONVERT THE VSN TO A DEVICE AND INDEX
	JUMPF	CUNK.1			;NOT SUPPORTED,,MAKE IT A DISK
	MOVX	S1,VS.FDV		;BIT TO SET
	IORM	S1,.VSFLG(P1)		;IT'S A FOREIGN DEVICE (UNIT RECORD)
	$RETT				;AND RETURN

CUNK.1:	MOVE	S1,P1			;[1226] GET VSL ADDRESS
	PUSHJ	P,DEVCHK		;[1226] CHECK OUT DEVICE
	$RETIF				;[1226] RETURN IF PROBLEMS
	STORE	S1,.VSFLG(P1),VS.TYP	;[1226] SAVE THE REQUEST TYPE
	$RETT				;AND RETURN

;DEVCHK - ROUTINE TO ENSURE DEVICE STRING IS VALID

;ACCEPTS	S1/ VSL ADDRESS

;RETURNS TRUE	S1/ DEVICE TYPE (%DISK OR %TAPE)
;		S2/ SIXBIT DEVICE NAME
;	G$ERR IS SET WITH ERROR CODE IF PROBLEMS

DEVCHK: PUSHJ	P,.SAVE4	        ;[1226] SAVE P1-P4
	MOVE	P1,S1			;[1226] COPY VSL ADDRESS
	HRROI	S1,.VSVSN(P1)		;[1226] GET ADDRESS OF VOLUME SET NAME
	PUSHJ	P,S%SIXB		;[1226] CONVERT TO SIXBIT
	$SAVE	<S2>			;[1226] SAVE DEVICE NAME FOR RETURN
	ILDB	P4,S1			;[1226] GET TERMINATOR
	JUMPN	P4,DEVC.3		;[1226] GO SEE IF REELID SPECIFIED
	MOVE	P2,S2			;[1226] SAVE THE DEVICE NAME
	MOVE	TF,[1,,P2]		;[1226] YES, GET DSKCHR PARMS
	DSKCHR	TF,			;[1226] GET STRUCTURE STATUS BITS
	JRST	DEVC.1			;[1226] NOT A DISK
	LOAD	TF,TF,DC.TYP		;[1226] GET THE DEVICE TYPE
	CAXN	TF,.DCTAB		;[1226] AMBIGUOUS?
	PJRST	E$ASN##			;[1226] YES - SAY SO
	CAXE	TF,.DCTUF		;[1226] UNIT WITHIN STRUCTURE?
	CAXN	TF,.DCTCN		;[1226] CONTROLLER CLASS?
	PJRST	E$ISN##			;[1226] YES - INVALID STRUCTURE
	CAXE	TF,.DCTCC	    	;[1226] CONTROLLER CLASS?
	CAXN	TF,.DCTPU		;[1226] PHYSICAL UNIT?
	PJRST	E$ISN##			;[1226] YES, ILLEGAL STRUCTURE
	CAXN	TF,.DCTDS		;[1226] GENERIC OR ERSATZ?
	JRST	DEVC.2			;[1226] YES, CHECK IT OUT SOME MORE
	MOVX	S1,%DISK		;[1226] ITS A DISK
	$RETT				;[1226] AND RETURN

DEVC.1:	DEVTYP	S2,			;[1226] GET DEVICE TYPE
	JRST	DEVC.4			;[1226] CHECK FOR REELID
	JUMPE	S2,DEVC.4		;[1226] GO LOOK FOR REELID
	TXNE	S2,TY.GEN		;[1226] A GENERIC DEVICE ?
	PJRST	E$GDN##			;[1226] YES
	LOAD	TF,S2,TY.DEV		;[1460] LOAD THE DEVICE TYPE
	CAIE	TF,.TYMTA		;[1460] IS IT TAPE??
	CAIN	TF,.TYDTA		;[1460] OR IS IT A DECTAPE??
	TRNA				;[1460] YES
	PJRST	E$DNM##	 		;[1226] NO,,UNSUPPORTED DEVICE
	MOVX	S1,%TAPE		;[1226] ASSUME MAGTAPE
	CAIE	TF,.TYMTA		;[1460] WAS IT?
	MOVX	S1,%DTAP		;[1460] NO, MUST HAVE BEEN DECTAPE
	$RETT				;[1226] RETURN

DEVC.2:	MOVE	TF,[3,,P2]		;[1226] GET PATH. ARGS
	PATH.	TF,			;[1226] FIND OUT SOME MORE
	PJRST	E$UST##			;[1226] CATCH ALL
	TXNE	P3,PT.DLN!PT.EDA	;[1226] PATHOLOGICAL NAME?
	PJRST	E$PLD##			;[1226] YES, SAY SO
	TXNE	P3,PT.IPP		;[1226] IMPLIED PPN? (ERSATZ)
	PJRST	E$ERZ##			;[1226] YES, SAY SO
	PJRST	E$GDN##			;[1226] ELSE CALL IT GENERIC

DEVC.3:	DEVTYP	S2,			;GET DEVICE TYPE
	  SETZ	S2,			;NO SUCH DEVICE
	LOAD	S2,S2,TY.DEV		;[1226] LOAD THE DEVICE TYPE
	CAIN	S2,.TYDTA		;DECTAPE?
	SKIPA	S1,[%DTAP]		;YES

DEVC.4:	MOVX	S1,%TAPE		;[1226] ASSUME TAPE
	LOAD	TF,.VSFLG(P1),VS.REL	;[1226] GET REELID SPECIFIED FLAG
	JUMPN	TF,.RETT		;[1226] RETURN TRUE IF REELID THERE
	JUMPN	P4,E$IVN##		;[1226] MORE THAN 6 CHARS AND NO REELID
	MOVX	S1,%UNKN		;CALL IT UNKNOWN
	$RETT				;[1226] RETURN OK
	SUBTTL	I$CGEN - CONVERT A VSN TO A DEVICE TYPE AND TRANSLATION INDEX

	;CALL:	S1/ The VSL address
	;
	;RET:	S1/ The Translation index into table DEVNTB
	;	S2/ The device type

	INTERN	I$CGEN			;GLOBALIZE IT

I$CGEN:	HRROI	S1,.VSVSN(S1)		;POINT TO THE VOLUME SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	DEVTYP	S2,			;GET THE DEVICE TYPE
	$RETF				;LOSE,,RETURN (TOO BAD)
	LOAD	S2,S2,TY.DEV		;GET THE TYPE CODE
	MOVSI	S1,-DEVLEN		;CREATE SEARCH AOBJN AC
	CAME	S2,DEVTBL(S1)		;DO WE MATCH ALLOWABLE DEVICES ???
	AOBJN	S1,.-1			;NO,,TRY NEXT
	JUMPGE	S1,.RETF		;NO MATCH,,LOSE
	HRRZS	S1			;GET JUST THE INDEX
	$RETT				;AND RETURN

DEVTBL:	.TYTTY				;TTY
	.TYPTR				;PAPER TAPE READER
	.TYPTP				;PAPER TAPE PUNCH
	.TYDIS				;DISPLAY DEVICE
	.TYLPT				;LINE PRINTER
	.TYCDR				;CARD READER
	.TYCDP				;CARD PUNCH
	.TYPTY				;PTY
	.TYPLT				;PLOTTER

DEVLEN==.-DEVTBL			;TABLE LENGTH

DEVNTB::EXP	[ASCIZ/Terminal/]
	EXP	[ASCIZ/Paper tape reader/]
	EXP	[ASCIZ/Paper tape punch/]
	EXP	[ASCIZ/Display/]
	EXP	[ASCIZ/Line printer/]
	EXP	[ASCIZ/Card reader/]
	EXP	[ASCIZ/Card punch/]
	EXP	[ASCIZ/Pseudo-terminal/]
	EXP	[ASCIZ/Plotter/]
SUBTTL	Device validation


; Check for a valid (existing) device.
; Call:	MOVE	S1, sixbit device name
;	PUSHJ	P,I$VDEV
;
; TRUE return:	device exists
; FALSE return:	non-existant device
;
I$VDEV::DEVTYP	S1,			;DOES IT EXIST?
	  SETZ	S1,			;DEVTYP NOT IMPLEMENTED??
	JUMPE	S1,.RETF		;NO SUCH DEVICE
	$RETT				;DEVICE EXISTS
	SUBTTL	FD Manipulation Routines

	INTERN	I$CSM			;Create a Canonical SPOOL Message
	INTERN	I$CLM			;Create a Canonical LOGOUT Message
	SUBTTL	I$CSM  --  Create a Canonical SPOOL Message

;CALL I$CSM TO CONVERT A SPOOL MESSAGE RECEIVED FROM THE OPERATING SYSTEM
;	INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL:	M/SPOOL MESSAGE ADDRESS
;   PUSHJ  P,I$CSM
;	  RETURN HERE WITH S1 CONTAINING THE ADR OF THE CSM

I$CSM:	PUSHJ	P,.SAVE3		;SAVE P1-P3
	MOVEI	S1,CSMSIZ+FDMSIZ	;GET THE CSM+FD LENGTH
	MOVEI	S2,CSM.A		;LOAD ADR OF BLOCK 
	PUSHJ	P,.ZCHNK		;ZERO THE CSM AND FD
	MOVEI	S2,CSM.A		;RESTORE CSM ADDRESS
	LOAD	P1,SPL.JB(M),SP.JOB	;GET THE JOB NUMBER
	STORE	P1,CSM.JB(S2),CS.JOB	;AND STORE IT
	LOAD	P1,SPL.JB(M),SP.DFR	;GET DEFER'ED SPOOLING BIT
	LOAD	P2,SPL.SF(M),SP.FLG	;GET SPOOLING FLAGS
	CAIN	P2,.SPDFD		;IS IT DEFERED SPOOLING ???
	MOVEI	P1,1			;YES,,GET A BIT
	CAIN	P2,.SPDFI		;IS IT IMMEDIATE SPOOLING ???
	MOVEI	P1,0			;YES,,GET A NULL BIT
	STORE	P1,CSM.JB(S2),CS.DFR	;AND STORE IT
	DMOVE	P1,SPL.US(M)		;GET THE USER NAME
	DMOVEM	P1,CSM.US(S2)		;AND STORE IT
	MOVSI	P1,SPL.AC(M)		;GET ACCOUNT STRING ADDRESS
	HRRI	P1,CSM.AC(S2)		;GET DESTINATION ADDRESS
	BLT	P1,CSM.AC+7(S2)		;YES,,COPY THE ACCOUNT STRING OVER
	LOAD	P1,G$SID##		;GET USER'S DIRECTORY
	STORE	P1,CSM.OI(S2)		;AND STORE IT
	LOAD	P3,SPL.SF(M),SP.TYP	;GET THE SPOOL TYPE
	SKIPE	P3			;IS THERE ONE ???
	SETZM	SPL.DV(M)		;YES,,MAKE DEVICE NULL
	HLLZ	P1,SPL.DV(M)		;LOAD THE DEVICE
	HRLZI	P2,-NDEVS		;MAKE AOBJN AC (FOR DEVICE SEARCH)
CSM.1:	HLLZ	P3,DEVTAB(P2)		;GET THE DEVICE TYPE FROM THE TABLE
	CAMN	P1,P3			;DO WE MATCH ???
	JRST	CSM.2			;YES,,CONTINUE ON.
	AOBJN	P2,CSM.1		;ELSE TRY THE NEXT TABLE ENTRY
	SETZM	SPL.DV(M)		;NOT THERE,,MAKE DEVICE NULL
	LOAD	P1,SPL.SF(M),SP.TYP	;GET THE SPOOL TYPE
	SKIPN	P1			;IS THERE ONE ???
	MOVX	P1,.TYLPT		;NO,,DEFAULT TO LPT
	HRLZI	P2,-NDEVS		;MAKE AOBJN AC

CSM.1A:	HRRZ	P3,OBJDEV(P2)		;GET THE OBJECT TYPE
	CAMN	P1,P3			;DO WE MATCH ???
	JRST	CSM.2			;YES,,CONTINUE ON
	AOBJN	P2,CSM.1A		;NO,,TRY THE NEXT ENTRY
	SKIPA	P1,[EXP .OTLPT]		;NONE THERE,,DEFAULT TO LPT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

CSM.2:	HLRZ	P1,OBJDEV(P2)		;GET THE OBJECT TYPE
	STORE	P1,CSM.RO+.ROBTY(S2)	;SAVE IT
	SKIPN	P1,SPL.DV(M)		;DID THE USER SPECIFY A DEVICE ???
	JRST	CSM.3			;NO,,USE SPL.DA
	SETZ	P2,			;ZAP A TEMP AC
	CAMN	P1,DEVLL		;WAS IT LL: ???
	MOVX	P2,OBDLLC		;YES,,MAKE IT LOWER CASE
	CAMN	P1,DEVLU		;WAS IT LU: ???
	MOVX	P2,OBDLUC		;YES,,MAKE IT UPPER CASE
	JUMPN	P2,CSM.2A		;IF LOWER OR UPPER,,GO SAVE IT
	TXNE	P1,7700			;DID HE SPECIFY A NODE NUMBER ???
	WHERE	P1,UU.PHY		;GET THE NODE NUMBER
	SKIPA				;DONT SAVE IF AN ERROR
	STORE	P1,CSM.RO+.ROBND(S2)	;ELSE SAVE THE NODE NUMBER
	MOVE	P1,SPL.DV(M)		;GET THE DEVICE NAME
	LDB	P2,[POINT 6,P1,35]	;GET UNIT NUMBER
	TXNN	P1,7700			;IS THERE A NODE FIELD ???
	LDB	P2,[POINT 6,P1,23]	;NO,,UNIT IS 4TH DIGIT
	JUMPE	P2,CSM.3		;NO UNIT,,CONTINUE ON
	SUBI	P2,'0'			;MAKE UNIT BINARY
	TXO	P2,RO.PHY		;TURN ON THE PHYSICAL BIT
CSM.2A:	STORE	P2,CSM.RO+.ROBAT(S2)	;AND SAVE IT
	JRST	CSM.4			;AND CONTINUE

CSM.3:	MOVE	P1,SPL.DA(M)		;GET THE DEVICE NAME
	LOAD	P2,P1,SP.UNI		;GET THE UNIT NUMBER
	JUMPE	P1,CSM.3A		;NONE THERE,,CONTINUE
	TXO	P2,RO.PHY		;GET 'PHYSICAL' BIT
	TXNE	P1,SP.PHY		;IS IT 'PHYSICAL' ???
	JRST	CSM.3A			;YES,,SAVE IT
	TXNE	P1,SP.LWC		;IS IT LL: ???
	MOVX	P2,OBDLLC		;YES,,MAKE IT LOWER
	TXNE	P1,SP.UPC		;OR IS IT UPPER CASE ???
	MOVX	P2,OBDLUC		;YES,,MAKE IT UPPER CASE
CSM.3A:	STORE	P2,CSM.RO+.ROBAT(S2)	;SAVE THE DEVICE ATTRIBUTES

CSM.4:	LOAD	P1,SPL.ST(M)		;GET THE FILESTRUCTURE
	STORE	P1,CSM.B+.FDSTR		;AND STORE IN THE FD AREA
	LOAD	P1,SPL.EN(M)		;GET THE ENTER'ED FILENAME
	STORE	P1,CSM.EN(S2)		;AND STORE IT
	LOAD	P1,SPL.FS(M)		;GET THE FILE SIZE
	STORE	P1,CSM.FS(S2)		;STORE IT AWAY
	LOAD	P1,SPL.CP(M)		;GET THE # OF COPIES
	STORE	P1,P1,FP.FCY		;MOVE TO THE CORRECT PLACE
	TXO	P1,FP.SPL		;TURN ON SPL BITS
	STORE	P1,CSM.FP(S2)		;SAVE FOR Q$INCL
	LOAD	P1,SPL.FM(M)		;GET THE FORMS TYPE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	STORE	P1,CSM.FM(S2)		;SAVE THEM
	LOAD	P1,SPL.LM(M)		;GET THE LIMIT
	STORE	P1,CSM.LM(S2)		;SAVE IT
	LOAD	P1,SPL.AF(M)		;GET /AFTER
	STORE	P1,CSM.AF(S2)		;SAVE IT
	SKIPN	P1,SPL.ND(M)		;GET THE NODE NAME
	LOAD	P1,SPL.JB(M),SP.LOC	;NOT THERE,,GET FROM HERE
	SKIPN	CSM.RO+.ROBND(S2)	;IS THE NODE ALREADY FILLED IN ???
	STORE	P1,CSM.RO+.ROBND(S2)	;NO,,THEN SAVE IT

	MOVEI	P1,CSM.B		;WHERE WE BUILD THE FD
	STORE	P1,CSM.FD(S2),CS.FDA	;STORE IT
	MOVEI	P2,FDMSIZ		;GET SIZE OF THE FD
	STORE	P2,.FDLEN(P1),FD.LEN	;AND STORE IT

	;NOW FINISH MOVING THE FD AREA

	LOAD	P1,SPL.FN(M)		;GET THE FILE NAME
	STORE	P1,CSM.B+.FDNAM		;STORE IT
	LOAD	P1,G$SPLD##		;GET SPOOLING DIRECTORY
	STORE	P1,CSM.B+.FDPPN		;STORE IT
	HLRZ	S2,SPL.DV(M)		;LOAD DEVICE SPECIFIED
	CAIE	S2,'LL '		;WAS IT LL?
	CAIN	S2,'LU '		;NO, LU?
	MOVEI	S2,'LPT'		;ONE OR THE OTHER, USE LPT
	LOAD	S1,SPL.EX(M),SP.EXT	;GET THE SPOOL EXTENSION
	SKIPE	S1			;IS THERE ONE ???
	MOVE	S2,S1			;YES,,SAVE IT IN S2
	HRLZM	S2,CSM.B+.FDEXT		;AND STORE GENERIC DEV AS EXTENSION
	MOVEI	S1,CSM.A		;LOAD THE ANSWER
	$RETT				;AND RETURN

CSM.A:	BLOCK	CSMSIZ			;THE CSM TO RETURN
CSM.B:	BLOCK	FDMSIZ			;THE FD AREA
SUBTTL	I$CLM  --  Create a Canonical LOGOUT Message

;CALL I$CLM TO CONVERT A LOGOUT MESSAGE RECEIVED FROM THE OPERATING SYSTEM
;	INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL:
;	MOVE S1,[ADR OF LOGOUT MESSAGE FROM OPERATING SYSTEM]
;	PUSHJ P,I$CLM
;	  RETURN HERE WITH S1 CONTAINING THE ADR OF THE CLM

I$CLM:	MOVX	S2,.IPCSL		;GET FUNCTION CODE
	STORE	S2,<CLM.A+CLM.FC>	;STORE THE FUNCTION
	LOAD	S2,LGO.JB(S1),LG.JOB	;GET JOB NUMBER
	STORE	S2,<CLM.A+CLM.JB>,CL.JOB ;STORE IT
	LOAD	S2,LGO.JB(S1),LG.BSS	;GET BATCH STREAM FLAG SETTING
	SKIPE	S2			;IS IT SET ?
	LOAD	S2,LGO.JB(S1),LG.BAT	;YES - GET THE BATCH BIT
	STORE	S2,<CLM.A+CLM.JB>,CL.BAT ;STORE IT
	MOVEI	S1,CLM.A		;LOAD ADR OF THE CLM
	$RETT				;AND RETURN

CLM.A:	BLOCK	CLMSIZ			;BLOCK TO RETURN CLM
SUBTTL	Routines to handle system dependent fields

	INTERN	I$EQQE			;Move fields from EQ to QE
	INTERN	I$SMEQ			;Move fields from CSM to EQ
	INTERN	I$QESM			;Move fields from QE to CSM
	INTERN	I$RMCH			;Make request and RDB
	INTERN	I$DFEQ			;Default and check the EQ
	INTERN	I$LGFD			;Build a logfile FD
	INTERN	I$MUSR			;Move a RDB user into a message.
	INTERN	I$ONOD			;Default the ONOD limit word for batch

	INTERN	I$VACT			;ACTDAE ACCT VALIDATION MSG PROCSR
	INTERN	I$CACV			;'CREATE' ACCT STRING VALIDATION
	INTERN	I$SACV			;'SCHEDULE' ACCT STRING VALIDATION
	INTERN	I$ACTV			;VALIDATE ACCOUNT USING QE

	INTERN	I$DFMR			;FILL IN SYSTEM DEPENDENT MDR DATA
	INTERN	I$QCDI			;CONNECTED DIRECTORY ON SHORT CREATE
	INTERN	I$MNTR			;JUST A NOOP ON THE -10
	INTERN	I$GOFR			;IPCF [SYSTEM]GOPHER MESSAGE PROCESSOR
	SUBTTL	I$EQQE  -  Move fields from EQ to QE

	;CALL:	S1/ The EQ Address
	;	AP/ The QE Address

	; ***NOTE*** There are no system dependent fields to move on the -10,
	;	so we will just exit through the account validation routine.

I$EQQE:	LOAD	S2,.QHTYP(H),QH.TYP ;GET QUEUE TYPE
	CAIE	S2,.QHTOU	;OUTPUT?
	CAIN	S2,.QHTIP	;INPUT?
	PJRST	I$CACV		;YES--GO DO ACCOUNT VALIDATION
	$RETT			;RETURN
	SUBTTL	I$SMEQ  --  Move fields from CSM to EQ

;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE CANONICAL
;	SPOOL MESSAGE (CSM) TO THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
;	MOVE  S1,<ADDRESS OF CSM>
;	MOVE  AP,<ADDRESS OF EQ>
;	PUSHJ P,I$SMEQ
;	  ALWAYS RETURN HERE

I$SMEQ:	LOAD	S2,CSM.OI(S1)		;GET OWNER ID
	STORE	S2,.EQOID(AP)		;SAVE IT IN THE EQ
	MOVSI	S2,CSM.AC(S1)		;GET THE ACCOUNT STRING ADDRESS
	HRRI	S2,.EQACT(AP)		;GET THE DESTINATION ADDRESS
	BLT	S2,.EQACT+7(AP)		;COPY THE ACCOUNT STRING OVER
	DMOVE	S1,CSM.US(S1)		;GET USER NAME
	DMOVEM	S1,.EQOWN(AP)		;SAVE IN THE EQ
	$RETT				;AND RETURN

	SUBTTL	I$QESM - Move fields from the QE to the CSM

	;CALL:	AP/ QE Address
	;	T1/ CSM Address
	;
	;RET:	True Always

I$QESM:	DMOVE	S1,.QEUSR(AP)		;GET THE USER NAME
	DMOVEM	S1,CSM.US(T1)		;INSERT INTO THE CSM
	$RETT				;RETURN
SUBTTL	I$RMCH  --  Match a request and an RDB

;ROUTINE TO DETERMINE WHETHER OR NOT A PARTICULAR QUEUE ENTRY MATCHES
;	THE REQUEST DESCRIPTION IN A PARTICULAR REQUEST DESCRIPTION
;	BLOCK (RDB)
;
;CALL:
;	MOVE  S1,<ADDRESS OF RDB>
;	MOVE  AP,<ADDRESS OF QE>
;	PUSHJ P,I$RMCH
;	  ALWAYS RETURN HERE

I$RMCH:	SKIPN	S2,.RDBRQ(S1)		;GET AND CHECK FOR REQUEST ID.
	JRST	RMCH.0			;NONE THERE,,CONTINUE NORMALLY
	CAME	S2,[-1]			;IS IT 'ALL' REQUESTS ???
	CAMN	S2,.QERID(AP)		;   OR DO WE MATCH ???
	$RETT				;YES,,RETURN OK
	$RETF				;NO,,RETURN INVALID

RMCH.0:	PUSHJ	P,.SAVE1		;SAVE P1
	SKIPN	P1,.RDBES(S1)		;LOAD EXTERNAL SEQ #
	JRST	RMCH.1			;ZERO ASSUME A MATCH
	LOAD	S2,.QESEQ(AP),QE.SEQ	;GET SEQUENCE NUMBER FROM THE QE
	CAME	S2,P1			;DO THEY MATCH?
	$RETF				;NO, STOP NOW

RMCH.1:	LOAD	S2,.QEJOB(AP)		;GET JOBNAME FROM QE
	XOR	S2,.RDBJB(S1)		;FIND WHATS DIFFERENT
	AND	S2,.RDBJM(S1)		;MASK OUT INSIGNIFICANT PARTS
	JUMPN	S2,.RETF		;AND RETURN IF NO MATCH

	LOAD	S2,.QEOID(AP)		;GET OWNER ID
	SKIPN	P1,.RDBOI(S1)		;LOAD SPECIFIED OID
	 SKIPE	G$QOPR##		;IS THE REQUEST FROM THE OPERATOR ??
	  SKIPA				;YES,,KEEP ON GOING.
	   MOVE	P1,G$SID##		;NO,,USE THE DEFAULT IF 0
	XOR	S2,P1			;FIND OUT WHATS DIFFERENT
	AND	S2,.RDBOM(S1)		;MASK OUT INSIGNIFICANT PARTS
	JUMPN	S2,.RETF		;NO MATCH IF NOT 0
	$RETT				;WIN!!
SUBTTL	I$DFEQ  --  Default and check the EQ

;ROUTINE TO DEFAULT AND CHECK THE OPERATING SYSTEM DEPENDENT VALUES
;	IN THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
;	MOVE  S1,<ADDRESS OF EQ>
;	PUSHJ P,I$DFEQ
;	  ALWAYS RETURN HERE WITH T/F INDICATION

I$DFEQ:	LOAD	S2,.EQOID(S1)		;GET OWNER
	CAME	S2,G$SID##		;SAME AS SENDER?
	JUMPN	S2,A$WHEEL##		;IF NOT, AND IF NOT 0, RETURN THRU WHEEL
	LOAD	S2,G$SID##		;LOAD  CURRENT SENDER
	STORE	S2,.EQOID(S1)		;STORE IT
	MOVEI	S2,.EQOWN(S1)		;GET ADDRESS OF USER NAME
	HRLI	S2,(POINT 6,)		;MAKE A BYTE POINTER
	MOVEM	S2,PPNPTR		;SAVE IT
	MOVE	S2,.EQOWN+0(S1)		;GET USER NAME WORD 1
	IOR	S2,.EQOWN+1(S1)		;OR WITH USER NAME WORD 2
	SKIPN	S2			;WAS A USER NAME SPECIFIED?
	$TEXT	(PPNTYO,<^P12L /.EQOID(S1)/^A>) ;STORE [PPN]
	SKIPE	.EQJOB(S1)		;SKIP IF WE MUST DEFAULT THE JOBNAME
	$RETT				;ELSE, RETURN
	PUSH	P,S1			;SAVE ADDRESS OF .EQ
	LOAD	S2,.EQLEN(S1),EQ.LOH	;GET LENGTH OF HEADER
	ADD	S1,S2			;GET ADDRESS OF FIRST FP
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FPLENGTH
	ADD	S1,S2			;POINT TO THE FIRST FD
	LOAD	S2,.FDNAM(S1)		;GET THE FIRST FILENAME
	POP	P,S1			;GET THE .EQ ADDRESS
	STORE	S2,.EQJOB(S1)		;STORE THE JOBNAME
	$RETT				;AND RETURN


; Character sticker routine to build a [PPN]
;
PPNTYO:	SUBI	S1," "			;CONVERT ASCII TO SIXBIT
	IDPB	S1,PPNPTR		;STORE CHARACTER
	$RETT				;RETURN
SUBTTL	I$LGFD  --  Build a LOG file FD

;I$LGFD is called by the INP queue default filler to generate an FD
;	for a LOG file on a job where no log file is given.
;
;The filename created is SIXBIT<ITN>.LOG[3,3]
;
;Call:	S1/  address of the location to start building FD
;	S2/  FD Address
;	M/   EQ Address
;
;T Ret:	always

I$LGFD:	PUSHJ	P,.SAVE3		;SAVE P1 AND P2 AND P3
	MOVE	S2,.FPINF(S2)		;GET THE STATUS BITS FOR THIS FILE
	TXNN	S2,FP.SPL		;DO WE WANT A NORMAL 'SPOOL' FD
	JRST	LGFD.2			;NO,,CREATE A USER LOG FILE FD
	PUSHJ	P,LGFD.0		;YES,,GO SETUP THE SPOOL FILE NAME

	MOVSI	S2,'LOG'		;GET THE EXTENSION
	STORE	S2,.FDEXT(S1)		;SAVE IT
	MOVE	S2,G$SPLD##		;GET SPOOL DIRECTORY
	STORE	S2,.FDPPN(S1)		;SAVE IT
	MOVE	S2,G$QSTR##		;[1226] GET A STRUCTURE
	STORE	S2,.FDSTR(S1)		;AND STORE IT
	MOVEI	S2,FDMSIZ		;GET MINIMUM FD SIZE
	STORE	S2,.FDLEN(S1),FD.LEN	;SAVE IT
	$RETT				;AND RETURN


LGFD.0:	LOAD 	P1,.EQITN(M)		;GET THE ITN.
	MOVE	S2,[POINT 6,.FDNAM(S1)]	;GET THE OUTPUT BYTE POINTER
	MOVEI	P3,6			;ONLY 6 CHARACTERS !!!

LGFD.1:	IDIVI	P1,^D36			;GET RADIX 36
	PUSH	P,P2			;SAVE THE REMAINDER
	SOSE	P3			;COUNT DOWN THE CHARACTERS
	PUSHJ	P,LGFD.1		;MORE,,GO BACK.
	POP	P,P1			;GET AN ANSWER.
	ADDI	P1,'0'			;MAKE IT SIXBIT
	CAILE	P1,'9'			;IS IT A NUMBER ???
	ADDI	P1,'A'-'9'-1		;NO,,MAKE IT A LETTER
	IDPB	P1,S2			;SAVE THE BYTE
	POPJ	P,			;THEN PROCESS THE NEXT ONE

LGFD.2:	MOVE	P1,S1			;SAVE THE LOG FILE FD ADDRESS
	LOAD	S1,.EQLEN(M),EQ.LOH	;GET LENGTH OF EQ HEADER
	ADDI	S1,(M)			;INDEX TO THE CTL FILE FP
	LOAD	P2,.FPLEN(S1),FP.LEN	;[1500] GET FP LENGTH
	ADDI	P2,(S1)			;[1500] INDEX TO THE CTL FILE FD
	MOVEI	S1,.FDSTR(P2)		;[1500] POINT TO STRUCTURE
	HRLI	S1,1			;ONE WORD
	DSKCHR	S1,			;MAKE SURE IT'S A DISK
	  SETZ	S1,			;IT'S NOT
	LOAD	S1,S1,DC.TYP		;GET ARGUMENT TYPE
	CAIN	S1,.DCTFS		;FILE STRUCTURE?
	JRST	LGFD.3			;YES
	MOVE	S1,.FDSTR(P2)		;[1500] GET OFFENDING DEVICE
	$TEXT	(<-1,,@G$ACKB##>,<"^W/S1/" is not a file structure^0>)
	PUSHJ	P,E$XXX##		;SET THE ERROR CODE
	MOVEI	S1,'NFS'		;GET PREFIX FOR QUEUE PROGRAM
	HRLM	S1,G$ERR##		;SAVE
	$RETF				;AND RETURN

LGFD.3:	MOVE	S1,.EQJOB(M)		;GET THE JOB NAME
	MOVEM	S1,.FDNAM(P1)		;SAVE IT
	MOVSI	S1,'LOG'		;GET THE EXTENSION
	MOVEM	S1,.FDEXT(P1)		;SAVE IT
	MOVX	S1,FDXSIZ		;GET THE FD LENGTH+HDR LENGTH
	STORE	S1,.FDLEN(P1),FD.LEN	;SAVE IT
	MOVSI	S1,.EQPAT(M)		;GET THE PATH SOURCE ADDRESS
	HRRI	S1,.FDPPN(P1)		;GET THE DESTINATION PATH ADDRESS
	BLT	S1,.FDPPN+6-1(P1)	;COPY THE PATH OVER
	MOVE	S1,.EQOID(M)		;GET THE USER'S PPN
	SKIPN	.FDPPN(P2)		;[1500] WAS A PATH SPECIFIED IN CTL FD???
	MOVEM	S1,.FDPPN(P2)		;[1500] NO,,SAVE USER PPN
	SKIPN	.FDPPN(P1)		;WAS A PATH SPECIFIED IN LOG FD???
	MOVEM	S1,.FDPPN(P1)		;NO,,SAVE USER PPN
	LOAD	S1,.EQLEN(M),EQ.LOH	;GET THE HEADER LENGTH
	ADD	S1,M			;POINT TO THE FIRST FD
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FP LENGTH
	ADD	S1,S2			;POINT TO THE FIRST FD
	MOVE	S1,.FDSTR(S1)		;GET THE STRUCTURE
	MOVEM	S1,.FDSTR(P1)		;SAVE IT
	$RETT				;RETURN
SUBTTL	Spooled CDR file support


; Dummy routines not needed under TOPS-10

I$GCDR::POPJ	P,			;RETURN

I$QCDR::POPJ	P,			;RETURN

I$DCDR::POPJ	P,			;RETURN
	SUBTTL	I$MUSR - Move an RDB user PPN into an RDB block.

	;ROUTINE TO MOVE AN RDB USER PPN INTO AN RDB BLOCK IN AN
	;	HOLD/RELEASE MESSAGE.
	;
	;CALL:
	;	MOVE	S1,USER PPN ADDRESS.
	;	MOVEI	S2,OUTPUT RDB ADDRESS
	;	PUSHJ	P,I$MUSR##
	;	  ALWAYS RETURN HERE

I$MUSR:	SKIPE	S1			;NO USER PPN,,STORE 0'S.
	LOAD	S1,0(S1)		;LOAD THE PPN.
	STORE	S1,.RDBOI(S2)		;SAVE IT IN THE MESSAGE.
	SETZM	.RDBOM(S2)		;DEFAULT TO A MASK OF ALL 0'S.
	SKIPE	S1			;IF NO [PPN] THEN RETURN.
	SETOM	.RDBOM(S2)		;SET THE MASK TO ALL 1'S.
	$RETT				;RETURN.




	SUBTTL	I$ONOD - ROUTINE TO DEFAULT THE ONOD LIMIT WORD FOR BATCH EQ'S

	;CALL:	M/ The EQ Address
	;
	;RET:	True Always

I$ONOD:	MOVE	S1,G$LNBR##		;GET THE LOCAL NODE NUMBER
	STOLIM	S1,.EQLIM(M),ONOD	;SAVE IT IN THE EQ
	$RETT				;AND RETURN
	SUBTTL	Structure mount/dismount accounting routines

	;CALL:	AP/ The MDR Address
	;	S1/ The VSL Address
	;
	;RET:	True Always

	INTERN	I$SMNT			;GLOBALIZE MOUNT ENTRY POINT
	INTERN	I$SDSM			;GLOBALIZE DISMOUNT ENTRY POINT

I$SMNT:	SKIPA	S2,[UGFDM$]		;PICK UP MOUNT MSG TYPE
I$SDSM:	MOVX	S2,UGFDD$		;PICK UP DISMOUNT MSG TYPE
	SKIPE	DEBUGW			;ARE WE DEBUGGING ???
	$RETT				;YES,,RETURN
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	S1,S2			;GET THE MSG TYPE IN S1
	PUSHJ	P,ACTINI		;INITIALIZE THE MESSAGE
	MOVE	S1,.VSVOL(P1)		;GET THE PRI VOL BLOCK ADDRESS
	MOVE	S2,.VLNAM(S1)		;GET THE SIXBIT STR NAME
	MOVEM	S2,ACTSTR+UF$DEV	;SAVE IT

FACT<	MOVEM	S2,FACTBL+10 >		;STORE FOR DAEMON ALSO

	MOVE	TF,[1,,S2]		;GET DSKCHR PARM BLOCK LENGTH,,ADDRESS
	DSKCHR	TF,			;GET STRUCTURE STATUS BITS
	SETZM	TF			;SHOULD NOT HAPPEN !!!
	LOAD	TF,TF,DC.PRV		;GET THE PRIVATE STR BIT
	AOS	TF			;RECODE IT
	MOVEM	TF,ACTSTR+UF$STY	;SAVE IT
	SETZM	S2			;CLEAR # OF PACKS COUNTER
	LOAD	S1,.VLPTR(S1),VL.NXT	;GET THE NEXT PACK IN THE STR
	AOS	S2			;COUNT NUMBER OF PACKS IN STRUCTURE
	JUMPN	S1,.-2			;ANOTHER,,COUNT IT UP
	MOVEM	S2,ACTSTR+UF$PNO	;SAVE # OF PACKS
	MOVE	S1,.VSUCB(P1)		;GET THE UCB OF THE PRIMARY VOL BLK
	LOAD	S2,.UCBST(S1),UC.KTP	;GET THE CONTROLLER TYPE
	MOVEM	S2,ACTSTR+UF$CTY	;SAVE IT
	LOAD	S2,.UCBST(S1),UC.UTP	;GET THE UNIT TYPE
	MOVEM	S2,ACTSTR+UF$DTY	;SAVE IT
	MOVE	S1,.VSCRE(P1)		;GET THE REQUEST CREATION DATE
	MOVEM	S1,ACTSTR+UF$CDT	;SAVE IT
	SKIPN	S1,.VSSCH(P1)		;GET THE SCHEDULED DATE
	MOVE	S1,G$NOW##		;NONE,,USE CURRENT TIME
	MOVEM	S1,ACTSTR+UF$SDT	;SAVE IT
	MOVE	S1,G$NOW##		;GET SERVICED DATE
	MOVEM	S1,ACTSTR+UF$VDT	;SAVE IT
	MOVE	S1,ACTSTR+UF$DEV	;GET THE SIXBIT STRUCTURE NAME BACK
	PUSHJ	P,I$MNTC		;GET THE MOUNT COUNT
	MOVE	S2,ACTSTR+UX$TYP	;GET THE MESSAGE TYPE
	CAXN	S2,UGFDM$		;IS THIS A MOUNT REQUEST ???
	SUBI	S1,1			;YES,,PHASE MOUNT COUNT
	MOVEM	S1,ACTSTR+UF$CBR	;SAVE THE MOUNT COUNT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVEM	S1,ACTSTR+UF$SCT	;SAVE IT HERE ALSO
	LOAD	S1,.VSFLG(P1),VS.SIN	;GET SINGLE ACCESS BIT
	AOS	S1			;RECODE IT
	MOVEM	S1,ACTSTR+UF$ACC	;SAVE IT
	MOVEI	S1,ACTSTR		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT
	MOVX	S1,UF$SCT+1		;GET THE MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT
	MOVX	S1,SI.FLG+SP.ACT	;GET SPECIAL PID 'ACTDAE'
	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IT
	SETZM	G$SAB##+SAB.PD		;NO PID HERE
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF

FACT<	MOVE	S1,[14,,FACTBL-1]	;LENGTH,,ADDR OF FACT BLOCK
	DAEMON	S1,			;WRITE FACT FILE
	  JFCL  >			;REALLY OUGHT TO COMPLAIN

	$RETT				;RETURN
	SUBTTL	I$TMNT - Tape mount accounting routines
	;	I$TDSM -  "     "     "   "      "   "

	;CALL:	S1/ The VSL Address
	;	AP/ The MDR Address
	;
	;RET:	True Always

	INTERN	I$TMNT			;GLOBALIZE TAPE MOUNT ENTRY POINT
	INTERN	I$TDSM			;GLOBALIZE TAPE DISMOUNT ENTRY POINT

I$TMNT:	SKIPA	S2,[UGMGM$]		;GET MOUNT MESSAGE TYPE
I$TDSM:	MOVX	S2,UGMGD$		;GET DISMOUNT MESSAGE TYPE
	SKIPE	DEBUGW			;ARE WE DEBUGGING ???
	$RETT				;YES,,RETURN
	PUSHJ	P,.SAVE1		;YES,,SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	S1,S2			;GET THE MSG TYPE IN S1
	PUSH	P,S1			;[1234] SAVE MSG TYPE
	PUSHJ	P,ACTINI		;PERFORM ACCOUNTING INITIALIZATION
	POP	P,S2			;[1234] GET MSG TYPE BACK
	LOAD	S1,.TDDVT(M),TDD.FL	;[1234] GET MONITOR FLAGS
	CAXE	S2,UGMGM$		;[1234] MOUNT STATS?
	TXNN	S1,TD.VSW		;[1234] VOLUME SWITCH STATS?
	JRST	TMNT.A			;[1234] NO, MOUNT OR REGULAR DISMOUNT
	MOVE	S1,.TDDEV(M)		;[1234] YES, GET DEVICE NAME
	MOVEM	S1,ACTSTR+UM$DEV	;[1234] SAVE IT
	JRST	TMNT.B			;[1234] GO GET STATS

TMNT.A:	MOVE	S1,.VSCRE(P1)		;[1234] GET THE CREATION DATE
	MOVEM	S1,ACTSTR+UM$CDT	;SAVE IT
	MOVE	S1,.VSSCH(P1)		;GET THE SCHEDULED DATE
	MOVEM	S1,ACTSTR+UM$SDT	;SAVE IT
	MOVE	S1,G$NOW##		;GET THE SERVICED DATE
	MOVEM	S1,ACTSTR+UM$VDT	;SAVE IT
	LOAD	S1,.VSFLG(P1),VS.LBT	;GET THE LABEL TYPE
	MOVEI	S2,1			;DEFAULT TO UNLABELED
	CAXN	S1,.TFLAL		;DO WE HAVE ANSI LABELS ???
	MOVEI	S2,2			;YES,,SAY SO
	CAXN	S1,.TFLIL		;DO WE HAVE EBCDIC LABELS ???
	MOVEI	S2,3			;YES,,SAY SO
	MOVEM	S2,ACTSTR+UM$LTY	;SAVE IT
	MOVE	S1,.VSUCB(P1)		;GET THE UCB ADDRESS
	MOVE	S2,.UCBNM(S1)		;GET THE DEVICE NAME
	MOVEM	S2,ACTSTR+UM$DEV	;SAVE IT

FACT<	MOVEM	S2,FACTBL+10 >		;STORE FOR DAEMON ALSO

	LOAD	S1,.UCBST(S1),UC.KTP	;GET THE CONTROLLER TYPE
	MOVEM	S1,ACTSTR+UM$CTY	;SAVE IT
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT TO THE VOL BLK ADDRESS
	MOVE	S1,0(S1)		;AND LOAD IT
	MOVE	S2,.VLNAM(S1)		;GET THE VOLID
	MOVEM	S2,ACTSTR+UM$VID	;SAVE IT
	LOAD	S1,ACTSTR+.MSTYP,MS.TYP	;GET THE MESSAGE TYPE
	LOAD	S2,.MSTYP(M),MS.CNT	;[1165] GET LENGTH OF MESSAGE FROM MONITOR
	CAIN	S1,UGMGD$		;[1165] IS IT A DISMOUNT ???
	CAIG	S2,.TDMIN		;[1165] DOES IT CONTAIN NEW STATISTICS STUFF?
	JRST	TMNT.1			;NO,,SEND THE MESSAGE OFF

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

TMNT.B:	MOVE	S1,.TDCRD(M)		;[1234][1165] GET THE CHARACTERS READ
	MOVEM	S1,ACTSTR+UM$MRD	;SAVE IT
	MOVE	S1,.TDCWR(M)		;[1165] GET THE CHARACTERS WRITTEN
	MOVEM	S1,ACTSTR+UM$MWR	;SAVE IT
	MOVE	S1,.TDSRE(M)		;[1165] GET SOFT READ ERRORS
	MOVEM	S1,ACTSTR+UM$SRE	;SAVE IT
	MOVE	S1,.TDSWE(M)		;[1165] GET SOFT WRITE ERRORS
	MOVEM	S1,ACTSTR+UM$SWE	;SAVE IT
	MOVE	S1,.TDHRE(M)		;[1165] GET HARD READ ERRORS
	MOVEM	S1,ACTSTR+UM$HRE	;SAVE IT
	MOVE	S1,.TDHWE(M)		;[1165] GET HARD WRITE ERRORS
	MOVEM	S1,ACTSTR+UM$HWE	;SAVE IT
TMNT.0:	SKIPA	S1,[UM$HWE+1]		;GET THE MSG LENGTH
TMNT.1:	MOVX	S1,UM$FSI+1		;GET THE MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT
	MOVEI	S1,ACTSTR		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT
	MOVX	S1,SI.FLG+SP.ACT	;GET SPECIAL PID 'ACTDAE'
	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IT
	SETZM	G$SAB##+SAB.PD		;NO PID HERE
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF

FACT<	MOVE	S1,[14,,FACTBL-1]	;LENGTH,,ADDR OF FACT BLOCK
	DAEMON	S1,			;WRITE FACT FILE
	  JFCL  >			;REALLY OUGHT TO COMPLAIN

	$RETT				;RETURN
	SUBTTL	ACTINI - MDA ACCOUNTING INITIALIZATION ROUTINE

	;CALL:	AP/ The MDR Address
	;	S1/ The Message Type
	;
	;RET:	True Always


ACTINI:	$SAVE	<T1,T2>			;SAVE T1 AND T2
	SETZM	ACTSTR			;CLEAR THE FIRST ACCOUNT BUFFER WORD
	MOVE	S2,[ACTSTR,,ACTSTR+1]	;GET SOURCE,,DESTINATION
	BLT	S2,ACTSTR+^D50-1	;CLEAR THE ACCOUNT MESSAGE BUFFER
	MOVEM	S1,ACTSTR+UX$TYP	;SAVE THE MESSAGE TYPE
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	MOVEM	S1,ACTSTR+UF$JOB	;SAVE IT
	MOVE	S1,[SIXBIT/QUASAR/]	;GET OUR PEOGRAM NAME
	MOVEM	S1,ACTSTR+UF$PNM	;SAVE IT
	MOVE	S1,.JBVER		;GET OUR VERSION NUMBER
	MOVEM	S1,ACTSTR+UF$PVR	;SAVE IT
	MOVE	S1,.MRUSR(AP)		;GET THE USERS PPN
	MOVEM	S1,ACTSTR+UF$PPN	;SAVE IT
	DMOVE	S1,.MRNAM(AP)		;GET THE USERS NAME
	DMOVEM	S1,ACTSTR+UF$NM1	;SAVE IT
	MOVE	S1,[1,,S2]		;GET ACCT. PARM LIST
	MOVEI	S2,2			;GET LIST LENGTH
	LOAD	T1,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	HRROI	T2,ACTSTR+UF$ACT	;POINT TO OUTOUT AREA
	ACCT.	S1,			;GET THE USERS ACCOUNT STRING
	SETZM	ACTSTR+UF$ACT		;FAILED,,ZERO THE ACCOUNT STRING
	MOVE	S1,.MRTTY(AP)		;GET TERMINAL DESIGNATOR,,LINE NUMBER
	STORE	S1,ACTSTR+UF$TNO,MR.TNO	;SAVE THE LINE NUMBER
	TRZ	S1,-1			;ZAP LINE NUMBER
	MOVEM	S1,ACTSTR+UF$TRD	;SAVE THE TERMINAL DESIGNATOR
	MOVE	S1,.MRNOD(AP)		;GET THE USERS LOCATED NODE
	MOVEM	S1,ACTSTR+UF$NOD	;SAVE IT

FACT<	SETZM	FACTBL			;ZERO FACT TABLE
	MOVE	S1,[FACTBL,,FACTBL+1]	;GET BLT PARMS
	BLT	S1,FACTBL+12		;ZAP IT ALL
	LOAD	S1,ACTSTR+UF$TNO,MR.TNO	;GET TERMINAL NUMBER AGAIN
	LDB	S2,[POINT 7,ACTSTR+UF$TRD,6] ;GET TERMINAL DESIGNATOR
	CAIN	S2,"C"			;THE CTY
	MOVEI	S1,7777			;YES, USE THIS INSTEAD
	CAIN	S2,"D"			;OR DETACHED
	MOVEI	S1,7776			;YES
	LSH	S1,6			;POSITION TO BITS 18-29
	HRL	S1,ACTSTR+UF$JOB	;INSERT THE JOB NUMBER
	IOR	S1,[271000,,13]		;INSERT FACT TYPE AND LENGTH
	MOVEM	S1,FACTBL+0		;STORE
	MOVE	S1,ACTSTR+UF$PPN	;GET THE USERS PPN
	MOVEM	S1,FACTBL+1		;STORE
	MOVE	S1,[%CNSER]		;BOOT CPU SERIAL NUMBER
	GETTAB	S1,			;ASK THE MONITOR
	  SETZ	S1,			;WHAT!
	MOVE	S2,[.NDRNN,,T1]		;CONVERT NODE NAME TO NODE NUMBER
	MOVEI	T1,2			;2 ARGUMENTS
	MOVE	T2,ACTSTR+UF$NOD	;GET THE USERS NODE
	NODE.	S2,			;CONVERT IT
	  SETZ	S2,			;WHAT!
	HRL	S1,S2			;INSERT NODE NUMBER
	TLZ	S1,777700		;IN CASE NODE .GT. 77
	MOVE	S2,ACTSTR+UX$TYP	;GET MOUNT/DISMOUNT TYPE
	CAIE	S2,UGDTD$		;A DECTAPE DISMOUNT
	CAIN	S2,UGMGD$		; OR A MAGTAPE DISMOUNT
	CAIA				;YES
	CAIN	S2,UGFDD$		; OR A FILE STRUCTURE DISMOUNT
	TLOA	S1,'UD '		;YES, SOME TYPE OF DISMOUNT
	TLO	S1,'UM '		;MUST BE MOUNT (SPINDLES DON'T GO TO FACT)
	MOVEM	S1,FACTBL+3		;STORE
	MOVSI	S1,1			;AND ALL MOUNT/DISMOUNTS ARE SUCCESSFUL
	MOVEM	S1,FACTBL+12		;STORE
> ;END FACT ACCOUNTING

	$RETT				;RETURN
	SUBTTL	I$STRM - Structure mount/dismount accounting routines
	;	I$STRD -     "       "       "       "   "      "

	;CALL:	S1/ The primary VOL block address
	;
	;RET:	True always

	INTERN	I$STRM			;GLOBALIZE MOUNT ENTRY POINT
	INTERN	I$STRD			;GLOBALIZE DISMOUNT ENTRY POINT

I$STRM:	SKIPA	S2,[UGSPM$]		;GET MOUNT MESSAGE TYPE
I$STRD:	MOVX	S2,UGSPD$		;GET DISMOUNT MESSAGE TYPE
	SKIPE	DEBUGW			;ARE WE DEBUGGING ???
	$RETT				;YES,,RETURN
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE PRIMARY VOL ADDRESS
	SETZM	ACTSTR			;ZAP FIRST WORD OF MESSAGE BUFFER
	MOVE	S1,[ACTSTR,,ACTSTR+1]	;GET SOURCE,,DESTINATION
	BLT	S1,ACTSTR+^D50-1	;CLEAR COMPLETE MESSAGE BUFFER
	STORE	S2,ACTSTR+.MSTYP,MS.TYP	;SAVE THE MESSAGE TYPE
	MOVE	S1,[SIXBIT/QUASAR/]	;GET OUR NAME
	MOVEM	S1,ACTSTR+US$PNM	;SAVE IT
	MOVE	S1,.JBVER		;GET OUR VERSION
	MOVEM	S1,ACTSTR+US$PVR	;SAVE IT
	MOVE	S1,G$LNAM##		;GET OUR LOCATION
	MOVEM	S1,ACTSTR+US$NOD	;SAVE IT
	PJOB	S1,			;GET OUR JOB NUMBER
	MOVEM	S1,ACTSTR+US$JOB	;SAVE IT
	PUSHJ	P,GETTTY		;GET THE TTY DATA
	MOVEM	S1,ACTSTR+US$TRD	;SAVE TERMINAL DESIGNATOR
	HRRZM	S2,ACTSTR+US$TNO	;SAVE TERMINAL NUMBER
	SETZM	S2			;CLEAR STR PACK COUNTER
	MOVE	S1,P1			;GET THE VOL BLK ADDRESS IN S1
	LOAD	S1,.VLPTR(S1),VL.NXT	;GET THE NEXT VOL POINTER
	AOS	S2			;BUMP PACK COUNT BY 1
	JUMPN	S1,.-2			;CONTINUE TILL DONE
	MOVEM	S2,ACTSTR+US$PNO	;SAVE THE STRUCTURE PACK COUNT
	MOVE	S1,G$NOW##		;GET THE CURRENT TIME
	MOVEM	S1,ACTSTR+US$DTM	;SAVE IT
	MOVE	S1,.VLNAM(P1)		;GET THE STRUCTURE NAME
	MOVEM	S1,ACTSTR+US$FSN	;SAVE IT
	MOVE	TF,[1,,S1]		;GET DSKCHR PARM BLOCK LENGTH,,ADDRESS
	DSKCHR	TF,			;GET STRUCTURE STATUS BITS
	SETZM	TF			;SHOULD NOT HAPPEN !!!
	LOAD	TF,TF,DC.PRV		;GET THE PRIVATE STR BIT
	AOS	TF			;RECODE IT
	MOVEM	TF,ACTSTR+US$STY	;SAVE IT
STRM.1:	MOVE	S1,.VLUCB(P1)		;GET THE UCB ADDRESS
	MOVE	S2,.UCBNM(S1)		;GET THE DRIVE NAME
	MOVEM	S2,ACTSTR+US$DEV	;SAVE IT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	AOS	ACTSTR+US$MTH		;THIS IS PACK N of M
	MOVE	S2,.VLVID(P1)		;GET THE VOLUME IDENTIFIER
	MOVEM	S2,ACTSTR+US$DPI	;SAVE IT
	LOAD	S2,.UCBST(S1),UC.UTP	;GET THE UNIT TYPE
	MOVEM	S2,ACTSTR+US$DTY	;SAVE IT
	LOAD	S2,.UCBST(S1),UC.KTP	;GET THE CONTROLLER TYPE
	MOVEM	S2,ACTSTR+US$CTY	;SAVE IT
	MOVEI	S1,ACTSTR		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT
	MOVX	S1,US$DTM+1		;GET THE MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT
	MOVX	S1,SI.FLG+SP.ACT	;GET SPECIAL PID 'ACTDAE'
	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IT
	SETZM	G$SAB##+SAB.PD		;NO PID HERE
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	LOAD	P1,.VLPTR(P1),VL.NXT	;GET THE SECONDARY VOL BLK ADDRESS
	JUMPN	P1,STRM.1		;CONTINUE IF MORE
	$RETT				;RETURN IF NONE
	SUBTTL	I$DMNT - DECtape mount accounting routines
	;	I$DDSM -  "  "     "     "   "      "   "

	;CALL:	S1/ The VSL Address 
	;	AP/ The MDR Address
	;
	;RET:	True Always

	INTERN	I$DMNT			;GLOBALIZE DECTAPE MOUNT ENTRY POINT
	INTERN	I$DDSM			;GLOBALIZE DECTAPE DISMOUNT ENTRY POINT

I$DMNT:	SKIPA	S2,[UGDTM$]		;GET 'MOUNT' MESSAGE TYPE
I$DDSM:	MOVX	S2,UGDTD$		;GET 'DISMOUNT' MESSAGE TYPE
	SKIPE	DEBUGW			;ARE WE DEBUGGING ???
	$RETT				;YES,,RETURN
	PUSHJ	P,.SAVE1		;YES,,SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	S1,S2			;GET THE MSG TYPE IN S1
	PUSHJ	P,ACTINI		;PERFORM ACCOUNTING INITIALIZATION
	MOVE	S1,.VSCRE(P1)		;GET THE CREATION DATE
	MOVEM	S1,ACTSTR+UD$CDT	;SAVE IT
	MOVE	S1,.VSSCH(P1)		;GET THE SCHEDULED DATE
	MOVEM	S1,ACTSTR+UD$SDT	;SAVE IT
	MOVE	S1,G$NOW##		;GET THE SERVICED DATE
	MOVEM	S1,ACTSTR+UD$VDT	;SAVE IT
	MOVE	S1,.VSUCB(P1)		;GET THE UCB ADDRESS
	MOVE	S1,.UCBNM(S1)		;GET THE DEVICE NAME
	MOVEM	S1,ACTSTR+UD$DEV	;SAVE THE DEVICE NAME

FACT<	MOVEM	S1,FACTBL+10  >		;STORE FOR DAEMON ALSO

	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT TO THE VOL BLK ADDRESS
	MOVE	S1,0(S1)		;AND LOAD IT
	MOVE	S2,.VLNAM(S1)		;GET THE VOLID
	MOVEM	S2,ACTSTR+UD$VID	;SAVE IT

	LOAD	S1,ACTSTR+.MSTYP,MS.TYP	;GET THE MESSAGE TYPE
	LOAD	S2,.MSTYP(M),MS.CNT	;[1165] GET LENGTH OF MESSAGE FROM MONITOR
	CAIN	S1,UGDTD$		;[1165] IS IT A DISMOUNT ???
	CAIG	S2,.TDMIN		;[1165] DOES IT CONTAIN NEW STATISTICS STUFF?
	JRST	DMNT.1			;NO,,SEND THE MESSAGE OFF
	MOVE	S1,.TDDTR(M)		;[1165] GET DECTAPE READS
	MOVEM	S1,ACTSTR+UD$DRD	;[1165] STORE
	MOVE	S1,.TDDTW(M)		;[1165] GET DECTAPE WRITES
	MOVEM	S1,ACTSTR+UD$DWR	;[1165] STORE
	SKIPA	S1,[UD$DWR+1]		;GET THE MSG LENGTH

DMNT.1:	MOVX	S1,UD$RID+1		;GET THE MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT
	MOVEI	S1,ACTSTR		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT
	MOVX	S1,SI.FLG+SP.ACT	;GET SPECIAL PID 'ACTDAE'
	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IT
	SETZM	G$SAB##+SAB.PD		;NO PID HERE
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF

FACT<	MOVE	S1,[14,,FACTBL-1]	;LENGTH,,ADDR OF FACT BLOCK
	DAEMON	S1,			;WRITE FACT FILE
	  JFCL  >			;REALLY OUGHT TO COMPLAIN

	$RETT				;RETURN
	SUBTTL	I$VACT - ACCT DAEMON ACCT VALIDATION MSG PROCESSOR

	;CALL:	M/MESSAGE ADDRESS
	;
	;RET:	TRUE ALWAYS

	ACTFMT==6			;PROFILE FORMAT VERSION WE KNOW ABOUT

I$VACT:	DOSCHD				;FORCE ANOTHER SCHEDULING PASS
	SETZM	VACT.W			;CLEAR EQ REWRITE FLAG
	PUSHJ	P,.SAVE2		;[1471] SAVE P1 & P2 FOR A MINUTE
	HLRZ	S1,UC$ACK(M)		;GET THE OBJECT TYPE
	PUSHJ	P,A$OB2Q##		;GET THE QUEUE HEADER
	JUMPF	VACT.O			;GO COMPLAIN ABOUT BAD OBJECT TYPE
	LOAD	P1,.QHLNK(S1),QH.PTF	;GET POINTER TO FIRST QE ENTRY
	HRRZ	S2,UC$ACK(M)		;GET THE REQUEST ID
	SKIPA

VACT.1:	LOAD	P1,.QELNK(P1),QE.PTN	;GET THE NEXT QE ENTRY ADDRESS
	JUMPE	P1,.RETT		;NOT THERE,,JUST RETURN
	CAME	S2,.QERID(P1)		;FIND THE QE WE WANT ???
	JRST	VACT.1			;NO,,TRY NEXT
	MOVE	S1,.QESEQ(P1)		;GET THE QE STATUS BITS
	MOVX	S2,%VALID		;GET ACCOUNT VALIDATION COMPLETE STATUS
	STORE	S2,S1,QE.ACT		;SAVE IT
	MOVE	S2,UC$RES(M)		;GET THE VALIDATION CODE
	HLRZ	TF,UC$ACK(M)		;GET OBJECT CODE AGAIN
	CAIE	TF,.OTBAT		;BATCH?
	CAXN	S2,UGTRU$		;IS THE ACCOUNT STRING VALID ???
	TRNA				;BATCH ALWAYS VALID
	TXO	S1,QE.IAS		;NO,,LITE INVALID ACCOUNT STRING
	MOVEM	S1,.QESEQ(P1)		;RESTORE QE STATUS BITS
	HRLI	S1,UC$ACT(M)		;GET ACCOUNT STRING RETURNED BY ACTDAE
	HRRI	S1,.QEACT(P1)		;POINT TO QE
	CAXN	S2,UGTRU$		;SUCESSFUL VALIDATION?
	BLT	S1,.QEACT+7(P1)		;YES--REMEMBER NEW ACCOUNT STRING

;Here to default .EQUSR and .EQBOX from user profile it needed.

	MOVEI	P2,UGTRU$		;[1471] GET SUCCESS RESPONSE CODE
	CAME	P2,UC$PRF(M)		;[1471] PROFILE PRESENT?
	$RETT				;[1471] NO, DONE
	MOVEI	S1,ACTFMT		;[1471] VERSION WE EXPECT
	LOAD	S2,UC$PRO+.AEVRS(M),AE.VRS ;[1471] VERSION WE WERE GIVEN
	CAIE	S1,(S2)			;[1471] COMPARE
	JRST	VACT.V			;[1471] GO COMPLAIN ABOUT SKEW
	SKIPN	UC$PRO+.AEPNM(M)	;"PERSONAL NAME" IN PROFILE?
	SKIPE	UC$PRO+.AEBOX(M)	;WHAT ABOUT "DISTRIBUTION LOC"?
	JRST	VACT.2			;YES
	SKIPN	UC$PRO+.AELOG(M)	;DEFAULT LOG FILE?
	$RETT				;NO--DONE
VACT.2:	LOAD	S1,.QESTN(P1),QE.DPA	;GET THE DPA
	PUSHJ	P,F$RDRQ##		;READ THE REQUEST
	JUMPF	.RETT			;IF FAILURE, CATCH IT SOMEWHERE ELSE
	MOVE	P2,S1			;SAVE THE ADDRESS
	SKIPN	.EQUSR(P2)		;PERSONAL NAME IN EQ?
	SKIPN	UC$PRO+.AEPNM(M)	;NO, IS THERE A DEFAULT IN PROFILE?
	JRST	VACT.3			;NO DEFAULT
	MOVSI	S1,.EQUSR(P2)		;POINT TO START OF STORAGE
	HRRI	S1,.EQUSR+1(P2)		;MAKE A BLT POINTER
	SETZM	.EQUSR(P2)		;CLEAR FIRST WORD
	BLT	S1,.EQUSR+.APNLW-1(P2)	;CLEAR OUT ENTIRE BLOCK
	HRRZ	S1,UC$PRO+.AEPNM(M)	;GET RELATIVE OFFSET OF BLOCK
	ADDI	S1,UC$PRO(M)		;INDEX INTO PROFILE
	HRLZS	S1			;PUT IN LH
	HRRI	S1,.EQUSR(P2)		;MAKE A BLT POINTER
	HLRE	S2,UC$PRO+.AEPNM(M)	;GET NEGATIVE LENGTH OF BLOCK
	MOVMS	S2			;MAKE POSITIVE
	ADDI	S2,.EQUSR(P2)		;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY PERSONAL NAME
	AOS	VACT.W			;EQ NEEDS REWRITING
VACT.3:	SKIPN	.EQBOX(P2)		;DISTRIBUTION LOCATION IN EQ?
	SKIPN	UC$PRO+.AEBOX(M)	;NO, IS THERE A DEFAULT IN PROFILE?
	JRST	VACT.4			;NO DEFAULT
	MOVSI	S1,.EQBOX(P2)		;POINT TO START OF STORAGE
	HRRI	S1,.EQBOX+1(P2)		;MAKE A BLT POINTER
	SETZM	.EQBOX(P2)		;CLEAR FIRST WORD
	BLT	S1,.EQBOX+.ADLLW-1(P2)	;CLEAR OUT ENTIRE BLOCK
	HRRZ	S1,UC$PRO+.AEBOX(M)	;GET RELATIVE OFFSET OF BLOCK
	ADDI	S1,UC$PRO(M)		;INDEX INTO PROFILE
	HRLZS	S1			;PUT IN LH
	HRRI	S1,.EQBOX(P2)		;MAKE A BLT POINTER
	HLRE	S2,UC$PRO+.AEBOX(M)	;GET NEGATIVE LENGTH OF BLOCK
	MOVMS	S2			;MAKE POSITIVE
	ADDI	S2,.EQBOX(P2)		;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY DISTRIBUTION LOCATION
	AOS	VACT.W			;EQ NEEDS REWRITING
VACT.4:	MOVE	S1,P2			;POINT TO THE EQ
	PUSHJ	P,DLOGFL		;DO DEFAULT LOG FILE PROCESSING
	SKIPN	VACT.W			;NEED TO REWRITE THE EQ?
	JRST	VACT.5			;NO
	MOVE	S1,P2			;POINT TO THE EQ
	PUSHJ	P,F$WRRQ##		;REWRITE THE REQUEST
	LOAD	S2,.QESTN(P1),QE.DPA	;GET THE OLD DPA
	STORE	S1,.QESTN(P1),QE.DPA	;STORE THE NEW ONE
	MOVE	S1,S2			;LOAD THE OLD ONE INTO S1
	PUSHJ	P,F$RLRQ##		;RELEASE THE REQUEST
VACT.5:	MOVE	S1,P2			;GET THE PAGE
	PUSHJ	P,M%RPAG		;RELEASE IT
	$RETT

VACT.W:	BLOCK	1		;NON-ZERO IF EQ NEEDS REWRITING

VACT.A:	ASCIZ	/Accounting system error/
VACT.F:	ITEXT	(<Wrong profile format
Expecting format ^O/S1/ but received ^O/S2/>)

VACT.O:	$WTO	(<^T/VACT.A/>,<Unknown ACK code ^O/S1/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

VACT.V:	$WTO	(<^T/VACT.A/>,<^I/VACT.F/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN
; HERE TO LOAD THE DEFAULT LOG FILE IF NEEDED
DLOGFL:	HLRZ	T1,UC$ACK(M)		;GET OBJECT TYPE
	CAIE	T1,.OTBAT		;BATCH?
	POPJ	P,			;NO - COMPLETELY IGNORE IT
	LOAD	T1,.EQSPC(S1),EQ.NUM	;YES- GET NUMBER OF FILES
	SKIPE	UC$PRO+.AELOG(M)	;HAVE A DEFAULT LOG FILE?
	CAIE	T1,2			;EXACTLY 2 FILES?
	JRST	DLOG.7			;NO - DON'T BOTHER.
	GETLIM	T1,.EQLIM(S1),DLOG	;YES - GET DEFAULT LOG FILE BIT
	JUMPE	T1,.POPJ		;JUMP IF NOT SET
	MOVEI	T1,(S1)			;COPY MESSAGE ADDRESS TO T1
	LOAD	T2,.EQLEN(S1),EQ.LOH	;GET LENGTH OF HEADER
	ADDI	T1,(T2)			;ADVANCE TO FIRST FP
	LOAD	T2,.FPLEN(T1),FP.LEN	;GET LENGTH OF FP
	ADDI	T1,(T2)			;ADVANCE TO FIRST FD
	LOAD	T2,.FDLEN(T1),FD.LEN	;GET LENGTH OF FIRST FD
	ADDI	T1,(T2)			;ADVANCE TO SECOND FP
	MOVE	T2,.FPINF(T1)		;GET THE STATUS BITS
	TXNN	T2,FP.FLG		;IS THIS THE LOG FILE?
	JRST	DLOG.7			;NO - MUST BE CONFUSED (LEAVE IT BE...)
	LOAD	T2,.FPLEN(T1),FP.LEN	;YES- GET LENGTH OF 2ND FP
	ADDI	T1,(T2)			;ADVANCE TO 2ND FD
	MOVE	T2,UC$PRO+.AELOG(M)	;GET OFFSET TO FILESPEC
	ADDI	T2,UC$PRO(M)		;INDEX INTO PROFILE
;NOW THAT WE'VE DONE ALL THAT, WE COPY WHAT WE NEED TO FROM USER PROFILE
;TO LOGFILE ENTRY.  WE'LL ONLY COPY NON-BLANK STUFF.  ALSO, WE WILL HAVE TO
;MAKE SURE THAT, IF SFDS ARE INVOLVED, WE DO THE RIGHT THING.
;SINCE THE USER PROFILE CAN CONCEIVABLY CONTAIN ANY OF:
;
;	DEV:FILNAM.EXT[PROJ,PROG,SFD1,SFD2,SFD3,SFD4,SFD5]
;
;EXCEPT FOR THE PUNCTUATION, WE HAVE TO BE SMART IN WHAT WE COPY.
;CHECK AND MOVE THE NORMAL STUFF FIRST, DON'T MOVE A FIELD UNLESS IT
;IS NONZERO.
DLOG.1:	MOVE	T3,(T2)			;GET STRUCTURE
	JUMPE	T3,DLOG.2		;JUMP IF NONE SPECIFIED
	MOVEM	T3,.FDSTR(T1)		;STORE IT
	AOS	VACT.W			;EQ NEEDS REWRITING

DLOG.2:	AOBJP	T2,.POPJ		;RETURN IF END OF FILESPEC
	MOVE	T3,(T2)			;GET FILE NAME
	JUMPE	T3,DLOG.3		;JUMP IF THERE ISN'T ONE
	MOVEM	T3,.FDNAM(T1)		;STORE THAT
	AOS	VACT.W			;EQ NEEDS REWRITING

DLOG.3:	AOBJP	T2,.POPJ		;RETURN IF END OF FILESPEC
	HLLZ	T3,(T2)			;GET
	JUMPE	T3,DLOG.4		;JUMP IF THERE ISN'T AN EXTENSION
	MOVEM	T3,.FDEXT(T1)		;STORE THE SUCKER
	AOS	VACT.W			;EQ NEEDS REWRITING

DLOG.4:	AOBJP	T2,.POPJ		;RETURN IF END OF FILESPEC
	MOVE	T3,(T2)			;GET THE PPN
	JUMPE	T3,DLOG.5		;JUMP IF NONE SET
	MOVEM	T3,.FDPPN(T1)		;STORE IT
	AOS	VACT.W			;EQ NEEDS REWRITING

;HANDLE MOVING A SFD PATH IF SPECIFIED.  CRITERIA OF THE MOVING IS
;AS FOLLOWS:
;	IF 1ST SFD IS ZERO  - DON'T BOTHER, NO DEFAULT SFD PATH
;			      IN USER PROFILE ENTRY.
;	IF FD IS SHORT      - DON'T BOTHER, FD IS TOO SMALL.
;IF THESE TWO TESTS ARE PASSED, START MOVING SFDS UNTIL ONE OF THE
;FOLLOWING HAPPENS:
;	WE RUN OUT OF NONZERO SFDS IN THE PROFILE
;	WE RUN OUT OF PATH SLOTS IN THE FD (FDMSIZ .LT. .FDLEN .LT. FDXSIZ)
;	WE MOVE 5 SFDS (.FDLEN = FDXSIZ).

DLOG.5:	SKIPN	(T2)			;HAVE AN SFD?
	POPJ	P,			;NO - FINISH UP
	LOAD	T3,.FDLEN(T1),FD.LEN	;GET THE LENGTH OF THE FD
	CAIG	T3,FDMSIZ		;BIGGER THAN MINIMUM SIZE?
	POPJ	P,			;NO - NO SFDS PRESENT, FINISH UP
	MOVE	T4,T1			;PUT A DUPLICATE FD PTR INTO T4

DLOG.6:	MOVE	T3,(T2)			;GET AN SFD
	MOVEM	T3,.FDPAT(T4)		;STORE IN FD PATH BLOCK
	ADDI	T4,1			;INCREMENT DUPLICATE FD PTR	
	AOS	VACT.W			;EQ NEEDS REWRITING
	AOBJN	T2,DLOG.6		;DECREMENT COUNT & LOOP
	POPJ	P,			;ALL FINISHED

DLOG.7:	MOVEI	T2,0			;CLEAR
	STOLIM	T2,.EQLIM(S1),DLOG	;THE DEFAULT LOG FILE BIT
	AOS	VACT.W			;NEED TO REWRITE THE EQ
	POPJ	P,			;RETURN
	SUBTTL	I$CACV - ROUTINE TO VALIDATE AN ACCT STRING DURING 'CREATE'

	;CALL:	S1/ The EQ Address
	;	AP/ The QE Address
	;
	;RET:	True Always

I$CACV:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE EQ ADDRESS IN P1
	LOAD	S2,.EQROB+.ROBTY(P1)	;GET THE QUEUE TYPE
	MOVX	S1,UGVUP$		;VALIDATE ACCT STRING, RETURN PROFILE
	MOVEM	S1,ACTMSG		;PUT MESSAGE FOR ACTDAE
	MOVX	S2,%VALRQ		;GET 'NEED ACCOUNT VALIDATION' STATUS
	STORE	S2,.EQSEQ(P1),EQ.ACT	;LITE IT IN THE EQ
	LOAD	S2,.EQAFT(P1)		;GET THE CREATION DATE OF THIS REQUEST
	CAMLE	S2,G$NOW##		;IS IT IN THE FURURE ???
	$RETT				;YES,,JUST RETURN

	MOVX	S2,%VALPD		;GET VALIDATION PENDING STATUS
	STORE	S2,.EQSEQ(P1),EQ.ACT	;SAVE IT
	LOAD	S2,.EQOID(P1)		;GET THE OWNERS PPN
	STORE	S2,ACTPPN		;SAVE IT IN THE MESSAGE
	LOAD	S2,.EQRID(P1)		;GET THE REQUEST ID
	HRL	S2,.EQROB+.ROBTY(P1)	;ADD IN OBJECT TYPE
	MOVEM	S2,ACTACK		;SAVE IT AS THE ACK CODE
	MOVEI	S1,.EQACT(P1)		;POINT TO THE USERS ACCOUNT STRING
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVE	S2,[POINT 7,ACTSTR]	;GET OUTPUT BYTE POINTER
CACV.1:	ILDB	TF,S1			;COPY THE ACCOUNT STRING
	IDPB	TF,S2			;   TO THE ACCT VALIDATION MESSAGE
	JUMPN	TF,CACV.1		;CONTINUE TILL ASCIZ
	MOVX	S1,UV$MAX		;GET ACCT VALIDATION MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SET IT IN THE SAB
	MOVX	S1,SI.FLG+SP.ACT	;GET ACCOUNTING DAEMON SPECIAL INDEX
	MOVEM	S1,G$SAB##+SAB.SI	;SET IT IN THE SAB
	MOVEI	S1,ACTMSG		;GET THE ACCOUNT MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SET IT IN THE SAB
	SETZM	G$SAB##+SAB.PD		;CLEAR RECIEVERS PID
	PUSHJ	P,C$SEND##		;VALIDATE THE ACCOUNT STRING
	$RETT				;AND RETURN

	SUBTTL	I$SACV - ROUTINE TO VALIDATE AN ACCT STRING DURING 'SCHEDULING'

	;CALL:	S1/ The EQ Address
	;	AP/ The QE Address
	;
	;RET:	True Always


I$SACV:	LOAD	TF,.QESEQ(AP),QE.IAS	;GET 'INVALID ACCT STRING' BIT
	STORE	TF,.EQSEQ(S1),EQ.IAS	;SAVE IT IN THE EQ
	$RETT				;AND RETURN
	SUBTTL	I$ACTV - ROUTINE TO VALIDATE AN ACCOUNT STRING

	;CALL:	S1/ The QE Address
	;
	;RET:	True Always

	;This routine validates an account string using the QE as the
	;account string source.

I$ACTV:	LOAD	TF,.QESEQ(S1),QE.ACT	;GET THE ACCT VALIDATION STATUS
	CAXN	TF,%VALRQ		;IS VALIDATION REQUIRED ???
	JRST	ACTV.1			;YES,,GO DO IT...
	CAXN	TF,%VALID		;IS THE ACCOUNT VALID ???
	$RETT				;YES,,RETURN OK
	$RETF				;NO,,WAIT FOR ACTDAE'S ACK

ACTV.1:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE QE ADDRESS
	LOAD	S2,.QEROB+.ROBTY(P1)	;GET THE QUEUE TYPE
	CAIN	S2,.OTBAT		;IS IT BATCH ???
	$RETT				;YES, NOTHING TO DO
	MOVX	S2,UGVUP$		;GET MESSAGE TYPE
	MOVEM	S2,ACTMSG		;SAVE IN MESSAGE
	LOAD	S2,.QEOID(P1)		;GET THE OWNERS PPN
	STORE	S2,ACTPPN		;SAVE IT IN THE MESSAGE
	LOAD	S2,.QERID(P1)		;GET THE REQUEST ID
	HRL	S2,.QEROB+.ROBTY(P1)	;ADD IN OBJECT TYPE
	MOVEM	S2,ACTACK		;SAVE IT AS THE ACK CODE
	MOVEI	S1,.QEACT(P1)		;POINT TO THE USERS ACCOUNT STRING
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVE	S2,[POINT 7,ACTSTR]	;GET OUTPUT BYTE POINTER
ACTV.2:	ILDB	TF,S1			;COPY THE ACCOUNT STRING
	IDPB	TF,S2			;   TO THE ACCT VALIDATION MESSAGE
	JUMPN	TF,ACTV.2		;CONTINUE TILL ASCIZ
	MOVX	S1,UV$MAX		;GET ACCT VALIDATION MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SET IT IN THE SAB
	MOVX	S1,SI.FLG+SP.ACT	;GET ACCOUNTING DAEMON SPECIAL INDEX
	MOVEM	S1,G$SAB##+SAB.SI	;SET IT IN THE SAB
	MOVEI	S1,ACTMSG		;GET THE ACCOUNT MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SET IT IN THE SAB
	SETZM	G$SAB##+SAB.PD		;CLEAR RECIEVERS PID
	PUSHJ	P,C$SEND##		;VALIDATE THE ACCOUNT STRING
	MOVX	S1,%VALPD		;GET VALIDATION PENDING STATUS
	STORE	S1,.QESEQ(P1),QE.ACT	;SAVE IT IN THE QE
	$RETF				;AND RETURN
	SUBTTL	I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT MDR DATA

	;CALL:	S1/ The MDR address
	;	M/  The Mount Message Address
	;
	;RET:	True Always

I$DFMR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE MDR ADDRESS
	DMOVE	S1,.MMUSR(M)		;GET THE USERS NAME IN S1 & S2
	DMOVEM	S1,.MRNAM(P1)		;SAVE IT 
	MOVE	S1,G$LNAM##		;GET THE HOST NODE NAME
	MOVEM	S1,.MRNOD(P1)		;SAVE IT FOR NOW
	LOAD	S1,G$PRVS##,MD.PJB	;GET THE USERS JOB NUMBER
	PUSHJ	P,GETTTY		;GET TTY INFO
	STORE	S2,S1,MR.TNO		;CREATE LINE DESGINATOR,,LINE NUMBER
	MOVEM	S1,.MRTTY(P1)		;SAVE TERMINAL DESIGNATOR,,LINE NUMBER
	HLRZ	S1,S2			;GET 0,,NODE NUMBER
	PUSHJ	P,N$NODE##		;LOCATE IT IN OUR DATA BASE
	MOVE	S1,NETNAM(S2)		;GET THE NODE NAME
	MOVEM	S1,.MRNOD(P1)		;SAVE IT
	$RETT				;RETURN


	SUBTTL	I$QCDI - ROUTINE TO PROCESS CONNECTED DIRECTORY ON SHORT CREATES

	;CALL:	S1/ The Connected Directory (PATH) Block Address
	;	S2/ The EQ Page Address
	;
	;RET:	True if a valid block


I$QCDI:	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	DMOVE	P1,S1			;SAVE THE CALLING ARGS
	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIL	S1,2			;MUST BE GREATER THEN 1
	CAILE	S1,7			;AND LESS THEN 7
	PJRST	E$IPB##			;NO GOOD,,RETURN AN ERROR
	SUBI	S1,1			;GET THE BLOCK DATA LENGTH
	HRLI	S2,ARG.DA(P1)		;GET THE BLOCK DATA ADDRESS
	HRRI	S2,.EQPAT(P2)		;GET THE DESTINATION ADDRESS
	ADDI	S1,.EQPAT(P2)		;GET THE DESTINATION END ADDRESS
	BLT	S2,-1(S1)		;COPY THE PATH BLOCK ACROSS
	$RETT				;AND RETURN


	SUBTTL	I$MNTR - JUST A NOOP ON THE -10

I$MNTR:	$RETT				;JUST RETURN TRUE

	SUBTTL	I$GOFR - ROUTINE TO PROCESS [SYSTEM]GOPHER IPCF MESSAGES

	;CALL:	M/ The Message Address
	;
	;RET:	Through the Function Processing Routine

I$GOFR:	MOVE	S1,G$ENT##		;GET THE MDB ADDRESS
	MOVE	S1,MDB.FG(S1)		;GET THE MDB FLAG BITS
	TXNE	S1,<77B29>		;IS THIS A RETURNED MESSAGE ???
	$RETT				;YES,,JUST RETURN

	MOVEI	S1,<MD.PJH-MD.PJB>	;GET MASK TO CLEAR JCH
	ANDCAM	S1,G$PRVS##		;CLEAR JCH
	LOAD	S1,.MSFLG(M),MF.ACK	;GET THE USER ACK BIT
	MOVEM	S1,G$ACK##		;AND SAVE IT
	MOVX	S1,.QBFNC		;NO,,GET THE FUNCTION BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	ERROR			;NOT THERE,,THATS AN ERROR
	MOVE	S2,0(S1)		;GET THE FUNCTION CODE
	CAILE	S2,0			;LESS OR EQUAL TO 0
	CAILE	S2,GFRLEN		;  OR GREATER THEN MAX FUNCTION
	SETZM	S2			;YES,,FORCE AN ERROR
	PJRST	@GFRTAB(S2)		;NO,,GO PROCESS THE MESSAGE

GFRTAB:	ERROR				;FUNCTION 0  INVALID FUNCTION CODE
	QUEUE				;FUNCTION 1  PRINT
	QUEUE				;FUNCTION 2  PUNCH ON CARDS
	QUEUE				;FUNCTION 3  PUNCH ON PAPER TAPE
	QUEUE				;FUNCTION 4  PLOT
	QUEUE				;FUNCTION 5  SUBMIT
	MOUNT				;FUNCTION 6  ALLOCATE
	MOUNT				;FUNCTION 7  DEALLOCATE
	MOUNT				;FUNCTION 10 MOUNT
	MOUNT				;FUNCTION 11 DISMOUNT
	ERROR				;FUNCTION 12 WTO
	ERROR				;FUNCTION 13 WTOR
	ERROR				;FUNCTION 14 VALIDATE ACCOUNT STRING
	ERROR				;FUNCTION 15 ACCOUNTING MESSAGE
	ERROR				;FUNCTION 16 CATALOG DAEMON MESSAGE
	ERROR				;FUNCTION 17 MAIL MESSAGE
	QUEUE				;FUNCTION 20 EVENT CREATE
GFRLEN==.-GFRTAB			;TABLE LENGTH

	;Here if an error occurs

ERROR:	PUSHJ	P,E$IFC##		;SET INVALID FUNCTION CODE
	PUSHJ	P,G$STGS##		;GEN THE ACK AND SEND IT
	$RETT				;RETURN

	;Here to process QUEUE related messages

QUEUE:	SETZM	TF			;CLEAR TF FOR A MINUTE
	CAXN	S2,.QUPRT		;WAS IT PRINT ???
	MOVX	TF,.OTLPT		;YES,,MAKE IT PRINT
	CAXN	S2,.QUCDP		;WAS IT CARD PUNCH ???
	MOVX	TF,.OTCDP		;YES,,MAKE IT CARD PUNCH
	CAXN	S2,.QUPTP		;WAS IT PAPER TAPE ???
	MOVX	TF,.OTPTP		;YES,,MAKE IT PAPER TAPE
	CAXN	S2,.QUPLT		;WAS IT PLOT ???
	MOVX	TF,.OTPLT		;YES,,MAKE IT PLOT
	CAXN	S2,.QUBAT		;WAS IT BATCH ???
	MOVX	TF,.OTBAT		;YES,,MAKE IT BATCH
	JUMPE	TF,ERROR		;SHOULD NOT HAPPEN !!!
	MOVEM	TF,0(S1)		;SAVE THE OBJECT TYPE
	PUSHJ	P,Q$CRQE##		;TRY TO CREATE A QUEUE ENTRY
	SKIPE	G$ERR##			;WAS THERE AN ERROR ???
	PUSHJ	P,G$STGS##		;YES,,GEN THE ACK AND SEND IT
	$RETT				;RETURN

	;Here to process MOUNT related messages

MOUNT:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	CAXE	S2,.QUDAL		;IS THIS A DEALLOCATE
	CAXN	S2,.QUDIS		;   OR A DISMOUNT ???
	JRST	MOUN.7			;YES,,THEN GEN A DISMOUNT/DEALLOCATE MSG

	;Here to gen a MOUNT/ALLOCATE message

	SETZM	P2			;ASSUME A 'MOUNT' REQUEST
	CAXN	S2,.QUALC		;UNLESS THIS IS AN ALLOCATE
	MOVX	P2,ME%ALC		;THEN MAKE THIS AN ALLOCATE REQUEST
	PUSHJ	P,M%GPAG		;GET A PAGE TO BUILD THE MSG IN
	MOVE	P1,S1			;SAVE ITS ADDRESS
	SETZM	G$BLKA##		;START RECIEVED MSG SCAN AT BEGINNING
	MOVE	S1,[.MMHSZ,,.QIFNC]	;GET HDR LENGTH,,INTERNAL FUNCTION
	MOVEM	S1,.MSTYP(P1)		;START THE MESSAGE
	MOVE	S1,.MSCOD(M)		;GET [SYSTEM]GOPHER'S ACK CODE
	MOVEM	S1,.MSCOD(P1)		;SET IT IN THE NEW MESSAGE
	MOVEI	P3,.MMHSZ(P1)		;POINT TO THE FIRST 'ME' ENTRY
	SETZM	P4			;NO DATA BLOCKS YET !!!

MOUN.1:	PUSHJ	P,A$GBLK##		;GET A MESSAGE BLOCK
	JUMPF	MOUN.4			;NO MORE,,TRY THE MOUNT/ALLOCATE
	CAXE	T1,.QBFNC		;IS THIS THE FUNCTION TYPE BLOCK
	CAXN	T1,.QBNOD		;OR THE LOCATED NODE BLOCK ???
	JRST	MOUN.1			;YES,,IGNORE THEM
	CAXN	T1,.QBACT		;ACCOUNT STRING BLOCK ???
	JRST	MOUACT			;YES,,PROCESS IT
	CAXN	T1,.QBNAM		;USER NAME BLOCK ???
	JRST	MOUNAM			;YES,,PROCESS IT
	CAXN	T1,.QBNOT		;/NOTIFY BLOCK ???
	JRST	MOUNOT			;YES,,PROCESS IT
	CAXN	T1,.QBMFG		;MOUNT FLAG BITS ???
	JRST	MOUMFG			;YES,,PROCESS IT
	SETZM	S1			;CLEAR S1
	CAXN	T1,.QBVSN		;VOLUME SET NAME BLOCK ???
	MOVX	S1,.TMSET		;YES,,GET CORRECT BLOCK TYPE
	CAXN	T1,.QBLNM		;LOGICAL NAME BLOCK ???
	MOVX	S1,.TMLNM		;YES,,GET CORRECT BLOCK TYPE
	CAXN	T1,.QBVOL		;VOLUME ID'S BLOCK ???
	MOVX	S1,.TMVOL		;YES,,GET CORRECT BLOCK TYPE
	CAXN	T1,.QBDEN		;DENSITY BLOCK ???
	MOVX	S1,.TMDEN		;YES,,GET CORRECT BLOCK TYPE
	CAXN	T1,.QBTRK		;TRACK BLOCK ???
	MOVX	S1,.TMDRV		;YES,,GET CORRECT BLOCK TYPE
	CAXN	T1,.QBLTP		;LABEL TYPE BLOCK ???
	MOVX	S1,.TMLT		;YES,,GET CORRECT BLOCK TYPE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	CAXN	T1,.QBRMK		;REMARK BLOCK ???
	MOVX	S1,.TMRMK		;YES,,GET CORRECT BLOCK TYPE
	JUMPE	S1,MOUN.5		;TYPE NOT DEFINED,,THATS AN ERROR
	MOVEI	T3,-ARG.DA(T3)		;RE-POSITION TO THE BLOCK HEADER
	STORE	S1,ARG.HD(T3),AR.TYP	;SAVE THE RECODED BLOCK TYPE

	;Here to setup a new ME for a .QBVSN (.TMSET) block

	CAXE	S1,.TMSET		;IS THIS THE VOLUME SET BLOCK ???
	JRST	MOUN.3			;NO,,SKIP THIS
	LOAD	S1,.MEHDR(P3),AR.LEN	;GET THE CURRENT 'ME' LENGTH
	ADD	P3,S1			;POINT TO THE NEXT 'ME' ENTRY
	AOS	.MMARC(P1)		;BUMP THE 'ME' COUNT BY 1
	MOVEI	P4,.MEHSZ(P3)		;POINT TO THE 'ME' BLOCK AREA
	MOVSI	S1,.MEHSZ		;GET THE 'ME' HEADER LENGTH,,0
	ADDM	S1,.MEHDR(P3)		;NO,,BUMP THE ME LENGTH
	ADDM	S1,.MSTYP(P1)		;AND BUMP THE TOTAL MESSAGE LENGTH
	MOVEM	P2,.MEFLG(P3)		;ALSO SET MOUNT ENTRY TYPE (MOUNT/ALLOC)

MOUN.3:	JUMPE	P4,[PUSHJ P,E$IVN##	;MUST HAVE PROCESSED A VSN BLOCK !!!
		    JRST  MOUN.5 ]	;IF NOT,,THATS AN ERROR
	AOS	.MECNT(P3)		;BUMP THE ENTRY BLOCK COUNT BY 1
	MOVSS	T3			;GET SOURCE,,0
	HRR	T3,P4			;GET SOURCE,,DESTINATION
	ADD	T2,P4			;CALC END ADDRESS
	BLT	T3,-1(T2)		;COPY OLD MSG BLK TO NEW MSG
	LOAD	S1,ARG.HD(P4),AR.LEN	;GET THE BLOCK LENGTH
	ADD	P4,S1			;CALC NEXT OUTPUT BLOCK ADDRESS
	MOVSS	S1			;GET LENGTH,,0
	ADDM	S1,.MSTYP(P1)		;BUMP TOTAL MESSAGE LENGTH
	ADDM	S1,.MEHDR(P3)		;BUMP TOTAL MOUNT ENTRY LENGTH
	JRST	MOUN.1			;GO GET THE NEXT BLOCK

	;Here to try the MOUNT/ALLOCATE

MOUN.4:	$SAVE	<M>			;SAVE 'M'
	MOVE	M,P1			;POINT TO OUR 'NEW' MESSAGE
	MOVX	S1,MM.GFR		;[1170] LITE "FROM [SYSTEM]GOPHER" BIT
	SKIPE	G$ACK##			;[1170] WAITING FOR ACK?
	TXO	S1,MM.WAT		;[1170] YES,,LITE WAITING FOR ACK BIT
	IORM	S1,.MMFLG(P1)		;LITE THE BITS
	PUSHJ	P,D$MOUNT##		;LETERRIP !!!
	SKIPN	G$ERR##			;ANY ERRORS ???
	JRST	MOUN.6			;NO,,RETURN

	;Here on an error

MOUN.5:	SKIPN	G$ERR##			;ANY ERROR YET ???
	PUSHJ	P,E$IMM##		;NO,,SET INVALID MOUNT MMSSAGE
	PUSHJ	P,G$STGS##		;GEN THE ACK AND SEND IT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

MOUN.6:	MOVE	S1,P1			;GET THE PAGE ADDRESS BACK
	PUSHJ	P,M%RPAG		;RETURN IT
	$RETT				;RETURN

	;Here to gen DISMOUNT/DEALLOCATE message

MOUN.7:	SETZM	P2			;DEFAULT TO DISMOUNT
	CAXN	S2,.QUDAL		;IS THIS A DEALLOCATE
	MOVX	P2,MM.DLC		;YES,,MAKE THIS DEALLOCATE
	PUSHJ	P,M%GPAG		;GET A PAGE TO BUILD THE MSG IN
	MOVE	P1,S1			;SAVE ITS ADDRESS
	SETZM	G$BLKA##		;START RECIEVED MSG SCAN AT BEGINNING
	MOVE	S1,[.OHDRS,,.QIFNC]	;GET HEADER LENGTH,,INTERNAL CALL
	MOVEM	S1,.MSTYP(P1)		;START THE MESSAGE
	MOVE	S1,.MSCOD(M)		;GET [SYSTEM]GOPHER'S ACK CODE
	MOVEM	S1,.MSCOD(P1)		;SET IT IN THE NEW MESSAGE
	MOVEM	P2,.OFLAG(P1)		;SAVE THE DISMOUNT/DEALLOCATE FLAGS
	MOVX	S1,MM.GFR		;[1170] LITE "FROM [SYSTEM]GOPHER" BIT
	SKIPE	G$ACK##			;[1170] WAITING FOR ACK?
	TXO	S1,MM.WAT		;[1170] YES,,LITE THE BIT
	IORM	S1,.OFLAG(P1)		;[1170] LITE THE FLAG(S)

MOUN.8:	PUSHJ	P,A$GBLK##		;GET A MESSAGE BLOCK
	JUMPF	MOUN.9			;NO MORE,,TRY THE MESSAGE
	CAXE	T1,.QBFNC		;IS THIS THE FUNCTION TYPE BLOCK
	CAXN	T1,.QBNOD		;OR THE LOCATED NODE BLOCK ???
	JRST	MOUN.8			;YES,,IGNORE IT
	CAXE	T1,.QBACT		;ACCOUNT STRING BLOCK ???
	CAXN	T1,.QBNAM		;OR USER NAME BLOCK ???
	JRST	MOUN.8			;YES,,IGNORE IT
	CAXN	T1,.QBMFG		;MOUNT FLAG BITS ???
	JRST	[LOAD  S1,0(T3),QB.REM	    ;GET THE /REMOVE BIT
		 STORE S1,.OFLAG(P1),MM.REM ;SET/CLEAR IT
		 JRST  MOUN.8 ]		    ;AND CONTINUE
	CAXE	T1,.QBVSN		;VOLUME SET NAME BLOCK ???
	JRST	[PUSHJ P,E$IFC##	;NO,,THEN INVALID CODE SPECIFIED
		 JRST  MOUN.5 ]		;SET IT AND RETURN
	AOS	S1,.OARGC(P1)		;BUMP BLOCK COUNT
	CAIE	S1,1			;CAN ONLY SPECIFY 1 VOL SET NAME !!!
	JRST	[PUSHJ P,E$MVB##	;GEN MULTIPLE VOL SET BLOCKS ERROR
		 JRST  MOUN.5 ]		;SET IT AND RETURN
	MOVX	S1,.RCTVS		;GET VOLUME SET BLOCK TYPE
	STORE	S1,-ARG.DA(T3),AR.TYP	;AND SET IT FOR THIS MESSAGE
	MOVE	S1,T2			;GET THE BLOCK LENGTH IN S1
	CAILE	S1,1			;LENGTH MUST BE FROM 2 TO 11
	CAILE	S1,11			;MUST BE REASONABLE !!!
	JRST	[PUSHJ P,E$IVN##	;NO,,GEN THE ERROR
		 JRST  MOUN.5 ]		;SET IT AND RETURN
	MOVSS	S1			;GET LENGTH,,0
	ADDM	S1,.MSTYP(P1)		;BUMP TOTAL MSG LENGTH
	ADDI	T2,.OHDRS+ARG.HD(P1)	;CALC END ADDRESS
	MOVSI	T3,-ARG.DA(T3)		;GET SOURCE,,0
	HRRI	T3,.OHDRS+ARG.HD(P1)	;GET SOURCE,,DESTINATION
	BLT	T3,-1(T2)		;COPY THE VOLUME SET NAME
	JRST	MOUN.8			;AND CONTINUE

MOUN.9:	$SAVE	<M>			;SAVE 'M'
	MOVE	M,P1			;POINT TO OUR 'NEW' MESSAGE
	SKIPG	.OARGC(M)		;MUST HAVE THE VSN BLOCK !!!
	JRST	[PUSHJ P,E$IVN##	;NO,,GEN THE ERROR
		 JRST  MOUN.5 ]		;SET IT AND RETURN
	PUSHJ	P,D$DVS##		;LETERRIP !!!
	SKIPE	G$ERR##			;ANY ERROR ???
	JRST	MOUN.5			;YES,,EXIT SENDING AN ACK
	JRST	MOUN.6			;NO,,EXIT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

MOUACT:	CAIN	T2,1			;ZERO-LENGTH ACCOUNT STRING?
	JRST	MOUN.1			;YES (JUST THE HEADER)
	CAIL	T2,2			;VALIDATE BLOCK LENGTH
	CAILE	T2,11			;MUST BE BETWEEN 2 AND 11
	JRST	MOUN.5			;NO,,THATS AN ERROR
	ADDI	T2,.MMUAS(P1)		;CALC END ADDRESS
	MOVSS	T3			;GET SOURCE,,0
	HRRI	T3,.MMUAS(P1)		;GET SOURCE,,DESTINATION
	BLT	T3,-2(T2)		;COPY THE ACCOUNT STRING
	JRST	MOUN.1			;AND CONTINUE

MOUNAM:	CAILE	T2,1			;VALIDATE BLOCK LENGTH
	CAILE	T2,3			;MUST BE BETWEEN 2 AND 3
	JRST	MOUN.5			;NO,,THATS AN ERROR
	ADDI	T2,.MMUSR(P1)		;CALC END ADDRESS
	MOVSS	T3			;GET SOURCE,,0
	HRRI	T3,.MMUSR(P1)		;GET SOURCE,,DESTINATION
	BLT	T3,-2(T2)		;COPY THE USER NAME
	JRST	MOUN.1			;AND CONTINUE

MOUNOT:	CAIE	T2,2			;VALIDATE BLOCK LENGTH (MUST BE 2)
	JRST	MOUN.5			;NO,,THATS AN ERROR
	MOVX	S1,MM.NOT		;GET THE NOTIFY BIT
	IORM	S1,.MMFLG(P1)		;LITE IT
	JRST	MOUN.1			;AND CONTINUE

MOUMFG:	JUMPE	P4,[PUSHJ P,E$IVN##	;MUST HAVE PROCESSED A VSN BLOCK !!!
		    JRST  MOUN.5 ]	;IF NOT,,THATS AN ERROR
	CAIE	T2,2			;VALIDATE BLOCK LENGTH (MUST BE 2)
	JRST	MOUN.5			;NO,,THATS AN ERROR
	MOVE	T3,0(T3)		;LOAD UP THE FLAG BITS
	MOVE	S1,.MEFLG(P3)		;GET THE MOUNT ENTRY FLAG WORD
	TXNE	T3,QB.PAS		;IS /PASSIVE REQUESTED ???
	TXO	S1,SM%PAS		;YES,,SET IT
	TXNE	T3,QB.EXC		;/SINGLE (EXCLUSIVE) REQUESTED ???
	TXO	S1,SM%EXC		;YES,,SET IT
	TXNE	T3,QB.WLK		;WRITE LOCKED ???
	TXO	S1,TM%WLK		;YES,,SET IT
	TXNE	T3,QB.WEN		;WRITE ENABLED ???
	TXO	S1,TM%WEN		;YES,,SET IT
	TXNE	T3,QB.NOC		;IS /NOCREATE REQUESTED ???
	TXO	S1,SM%NOC		;YES,,SET IT
	TXNE	T3,QB.ARD		;WANT TO ALWAYS RECOMPUTE DISK USAGE?
	TXO	S1,SM%ARD		;YES
	TXNE	T3,QB.SCR		;IS /SCRATCH REQUESTED ???
	TXO	S1,TM%SCR!TM%WEN	;YES,,SET IT
	MOVEM	S1,.MEFLG(P3)		;SAVE THE ENTRY FLAG BITS
	TXNN	T3,QB.DSK+QB.TAP	;SPECIFY DISK OR TAPE ???
	JRST	MOUN.1			;NO,,RETURN NOW
	TXNE	T3,QB.DSK		;SPECIFY DISK ???
	MOVX	S1,.MNTST		;YES,,SET STRUCTURE MOUNT
	TXNE	T3,QB.TAP		;SPECIFY TAPE ???
	MOVX	S1,.MNTTP		;YES,,SET TAPE MOUNT
	STORE	S1,.MEHDR(P3),AR.TYP	;SAVE THE MOUNT ENTRY TYPE
	JRST	MOUN.1			;GET THE NEXT BLOCK
	SUBTTL	Batch Stream Unique Directory Routines

	INTERN	I$UQST			;SET DIRECTORY FOR A STREAM
	INTERN	I$UQCL			;CLEAR DIRECTORY FOR A STREAM
	INTERN	I$UQCH			;COMPARE STREAM FOR UNIQNESS
	SUBTTL	I$UQST  --  Set Directory for a Stream

;ROUTINE TO SET THE DIRECTORY FOR A STREAM FROM THE BATCH QUEUE ENTRY
;
;CALL:
;	MOVEI	S1,<STREAM NUMBER>
;	MOVE	AP,<BATCH QUEUE ENTRY (QE)>
;	PUSHJ	P,I$UQST
;	  ALWAYS RETURN HERE

I$UQST:	PUSH	P,S1			;SAVE S1
	MOVE	S1,UNILST		;GET LIST NUMBER
	MOVEI	S2,3			;AND ENTRY SIZE
	PUSHJ	P,L%CENT		;CREATE AN ENTRY
	POP	P,0(S2)			;GET STREAM NUMBER IN FIRST WORD
	GETLIM	S1,.QELIM(AP),UNIQ	;GET UNIQUE VALUE
	STORE	S1,1(S2)		;AND STORE IT
	MOVE	S1,.QEOID(AP)		;GET THE PPN
	MOVEM	S1,2(S2)		;STORE IT
	$RETT				;AND RETURN
SUBTTL	I$UQCL  --  Clear the directory for a stream

;ROUTINE TO CLEAR OUT THE DIRECTORY FOR A STREAM
;
;CALL:
;	MOVEI	S1,<STREAM NUMBER>
;	PUSHJ	P,I$UQCL
;	  ALWAYS RETURN HERE

I$UQCL:	PUSHJ	P,UNIFST		;FIND THE STREAM'S ENTRY
	MOVE	S2,S1			;PUT IT IN S2
	MOVE	S1,UNILST		;GET LIST NUMBER
	PUSHJ	P,L%DENT		;DESTROY ENTRY
	$RETT				;AND RETURN
SUBTTL	I$UQCH  --  Check for directory match

;Routine to determine whether a job meets all necessary UNIQNESS criteria
;	to be scheduled.
;
;CALL:	AP/  BATCH QUEUE ENTRY
;
;T RET:	IF JOB CAN BE SCHEDULED
;F RET: IF JOB CANNOT BE SCHEDULED

I$UQCH:	MOVE	S1,UNILST		;GET LIST NAME
	PUSHJ	P,L%FIRST		;POSITION TO THE BEGINNING
	JUMPF	.RETT			;EMPTY LIST WINS!!

UQCH.1:	LOAD	S1,.QEOID(AP)		;GET PPN FROM REQUEST
	CAME	S1,2(S2)		;MATCH?
	JRST	UQCH.2			;NO, ON TO NEXT ENTRY
	MOVE	S2,1(S2)		;GET UNIQNESS OF ENTRY
	GETLIM	S1,.QELIM(AP),UNIQ	;GET UNIQNESS OF NEW REQUEST
	CAIE	S1,%EQUYE		;IF EITHER ONE IS UNIQUE,
	CAIN	S2,%EQUYE		; THEN THE NEW ONE IS NO GOOD
	$RETF				;GOTCHA!!

UQCH.2:	MOVE	S1,UNILST		;GET LIST NAME
	PUSHJ	P,L%NEXT		;POSITION TO NEXT
	JUMPT	UQCH.1			;AND LOOP
	$RETT				;NO MORE, RETURN SUCCESS
SUBTTL	UNIFST  -  Find stream's unique entry

;UNIFST is called by the 'clear' and 'compare' routines to find the
;	list entry associated with a particular stream number.
;	Upon return the list entry is CURRENT.

;CALL:	S1/  STREAM NUMBER
;
;T RET	S1/  ADDRESS OF UNIQUE ENTRY FOR STREAM

UNIFST:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;COPY STREAM NUMBER OVER
	MOVE	S1,UNILST		;GET LIST NUMBER
	PUSHJ	P,L%FIRST		;POSITION IT
	JUMPF	S..USM			;LOSE BIG
UNIF.1:	CAMN	P1,0(S2)		;MATCH?
	JRST	[MOVE S1,S2
		 $RETT]			;YES, RETURN
	PUSHJ	P,L%NEXT		;POSITION TO NEXT
	JUMPT	UNIF.1			;AND LOOP
	STOPCD	(USM,HALT,,<Unique stream missing>)
SUBTTL	Failsoft System Interface

;ENTRY POINTS

	INTERN	I$WRIT			;WRITE SOMETHING INTO THE MASTER
	INTERN	I$READ			;READ SOMETHING FROM THE MASTER
	INTERN	I$CRIP			;CREATE AN INDEX PAGE
	INTERN	I$OQUE			;OPEN MASTER QUEUE FILES
SUBTTL	I$WRIT  --  Write something into master queue file

;ROUTINE TO WRITE SOMETHING INTO THE MASTER QUEUE FILES.  CALL WITH S1
;	CONTAINING THE BLOCK NUMBER TO WRITE, AND S2 CONTAINING AN
;	IO-POINTER OF THE FORM:
;
;		XWD	LENGTH,ADDRESS
;
;	WHERE 'LENGTH' IS THE NUMBER OF WORDS TO WRITE, AND 'ADDRESS'
;	IS THE PLACE TO START WRITING FROM.
;
;NOTE:  WRITES "BOTH" MASTERS.

I$WRIT:	MOVEM	S1,WRIT.A		;SAVE BLOCK NUMBER
	MOVEM	S2,WRIT.B		;SAVE POINTER WORD
	HLRZ	S1,S2			;GET THE LENGTH
	SKIPLE	S1			;LE 0
	CAILE	S1,1000			;OR GREATER THAN A PAGE?
	STOPCD	(WBL,HALT,,<Writing bad length>)
	MOVNS	S1			;NEGATE IT
	HRLZS	S1			;GET -LEN,,0
	SUBI	S2,1			;MAKE ADR-1
	HRR	S1,S2			;AND MAKE AN IOWD
	MOVEM	S1,WRIT.C		;SAVE IT
	CLEARM	WRIT.C+1		;SET END OF LIST
WRIT.1:	MOVE	S1,WRIT.A		;GET BLOCK NUMBER BACK
	USETO	CMQ1,(S1)		;SET IT
	OUT	CMQ1,WRIT.C		;AND WRITE FILE 1
	  JRST	WRIT.2			;WIN!! GO ON
	GETSTS	CMQ1,S1			;GET I/O STATUS
	TXZN	S1,IO.BKT		;RUN OUT OF ROOM?
	STOPCD	(PWE,HALT,,<Prime write error>)
	SETSTS	CMQ1,(S1)		;YES, CLEAR INDICATOR
	MOVEI	S1,12			;LOOP 10 SECS
	SLEEP	S1,			;SLEEP SOME
	JRST	WRIT.1			;AND TRY AGAIN
WRIT.2:
IFN FTRQUE,<
	MOVE	S1,WRIT.A		;GET BLOCK NUMBER BACK
	USETO	CMQ2,(S1)		;SET IT
	OUT	CMQ2,WRIT.C		;WRITE FILE 2
	  JRST	WRIT.3			;WIN! GO ON
	GETSTS	CMQ2,S1			;GET I/O STATUS
	TXZN	S1,IO.BKT		;RUN OUT OF ROOM?
	STOPCD	(RWE,HALT,,<Redundant write error>)
	SETSTS	CMQ2,(S1)		;YES, CLEAR INDICATOR
	MOVEI	S1,12			;LOOP 10 SECS
	SLEEP	S1,			;SLEEP SOME
	JRST	WRIT.2			;AND TRY AGAIN
>  ;END IFN FTRQUE

				;"I$WRIT" IS CONTINUED ON THE NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

WRIT.3:	HLRZ	S1,WRIT.B		;GET NUMBER OF WORDS
	SUBI	S1,1			;ROUND DOWN
	IDIVI	S1,FSSBKS		;AND GET NUMBER OF BLOCKS
	ADD	S1,WRIT.A		;ADD IN DPA OF FIRST BLOCK
	CAMG	S1,G$NBW##		;GREATER THAN PREVIOUS LAST BLOCK?
	$RETT				;NO, USING SAME SPACE
	MOVEM	S1,G$NBW##		;YES, SAVE AS GREATEST
	MOVX	S1,<FO.PRV!<CMQ1>B17!.FOURB>
	MOVE	S2,[1,,S1]		;LOAD ARGBLOCK
	FILOP.	S2,			;UPDATE THE RIB FOR THE FIRST ONE
	STOPCD	(EEP,HALT,,<Error expanding prime queue>)

IFN FTRQUE,<
	MOVX	S1,<FO.PRV!<CMQ2>B17!.FOURB>
	MOVE	S2,[1,,S1]		;LOAD THE ARGBLOCK
	FILOP.	S2,			;UPDATE THE RIB FOR THE SECOND ONE
	STOPCD	(EER,HALT,,<Error expanding redundant queue>)
>  ;END IFN FTRQUE

	$RETT				;AND RETURN

WRIT.A:	BLOCK	1			;LOCAL STORAGE
WRIT.B:	BLOCK	1			;LOCAL STORAGE
WRIT.C:	BLOCK	2			;LOCAL STORAGE
SUBTTL	I$READ  --  Read something from master queue file


;ROUTINE TO READ SOMETHING FROM THE MASTER QUEUE FILE.  CALL WITH S1
;	CONTAINING A BLOCK TO START THE READ AT AND S2 CONTAINING AN
;	IO-POINTER OF THE FORM:
;
;		XWD	LENGTH,ADDRESS
;
;	WHERE 'LENGTH' IS THE NUMBER OF WORDS TO READ, AND 'ADDRESS'
;	IS THE PLACE TO START READING THEM INTO.

I$READ:	MOVEM	S1,READ.A		;SAVE BLOCK NUMBER
	MOVEM	S2,READ.B		;SAVE IO-POINTER
	USETI	CMQ1,(S1)		;SET THE INPUT BLOCK
	HLRZ	S1,S2			;GET THE LENGTH
	MOVNS	S1			;NEGATE IT
	HRLZS	S1			;GET -LEN,,0
	SUBI	S2,1			;MAKE ADR-1
	HRR	S1,S2			;MAKE AN IOWD
	MOVEM	S1,READ.C		;SAVE IT
	CLEARM	READ.C+1		;SET END-OF-LIST
	IN	CMQ1,READ.C		;READ THE BLOCK
	  $RETT				;NO ERROR, SO RETURN GOOD RETURN NOW
	GETSTS	CMQ1,S1			;I/O ERROR, GET THE STATUS
	TXNE	S1,IO.EOF		;WAS IT AN EOF?
	STOPCD	(REF,HALT,,<Reading end of file>)
	STOPCD	(RIE,HALT,,<Read I/O error>)

READ.A:	BLOCK	1			;LOCAL STORAGE
READ.B:	BLOCK	1			;LOCAL STORAGE
READ.C:	BLOCK	2			;LOCAL STORAGE
SUBTTL	I$CRIP  --  Create an index page in master file

;I$CRIP IS CALLED WHEN THE FAILSOFT SYSTEM DECIDES TO START A NEW FILE
;	SECTION (INCLUDING THE VERY FIRST) TO WRITE OUT THE NEW INDEX
;	PAGE INTO THE FILE.  CALL WITH S1 CONTAINING THE BLOCK NUMBER OF
;	THE PAGE, AND S2 CONTAINING THE ADDRESS OF THE PAGE.

I$CRIP:	HRLI	S2,FSSWPI		;GET LENGTH TO WRITE
	PJRST	I$WRIT			;AND WRITE IT OUT
SUBTTL	I$OQUE  --  Open master queue files

;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
;	THE MASTER QUEUE FILE(S).  OPENS ONE FILE IF FTRQUE IS
;	OFF AND TWO IF FTRQUE IS ONE

I$OQUE:	PUSHJ	P,.SAVE1		;SAVE P1
	PUSHJ	P,SETOQF		;SETUP CONSTANT PARAMETERS
	MOVE	P1,[MQFNM1]		;GET NAME OF PRIME QUEUE
	MOVEM	P1,.RBNAM(S2)		;STORE IT
	SKIPE	DEBUGW			;IF DEBUGGING,
	SKIPA	P1,.RBPPN(S2)		;  GET DEFAULT DIRECTORY AND SKIP
	MOVE	P1,PRMDIR		;GET DIRECTORY OF PRIME QUEUE
	MOVEM	P1,.RBPPN(S2)		;STORE IT
	MOVSI	P1,CMQ1			;GET CHANNEL FOR PRIME QUEUE
	IORM	P1,.FOFNC(S1)		;STORE IT
	HRLI	S1,6			;GET LEN,,ADR
	FILOP.	S1,			;AND OPEN THE PRIME QUEUE!
	  JRST	OQUE.1			;DO SOME EVALUATION
	MOVE	S1,.RBSIZ(S2)		;GET THE SIZE OF FILE (WRITTEN)
	ADDI	S1,FSSBKS-1		;ROUND UP
	IDIVI	S1,FSSBKS		;AND CONVERT TO BLOCKS
	MOVEM	S1,G$NBW##		;AND SAVE AS NUMBER OF BLOCKS WRITTEN

IFN FTRQUE,<
	PUSHJ	P,SETOQF		;SETUP CONSTANT PARAMETERS
	MOVE	P1,[MQFNM2]		;GET NAME OF REDUNDANT QUEUE
	MOVEM	P1,.RBNAM(S2)		;STORE IT
	SKIPE	DEBUGW			;IF DEBUGGING,
	SKIPA	P1,.RBPPN(S2)		;  GET DEFAULT DIRECTORY AND SKIP
	MOVE	P1,REDDIR		;GET DIRECTORY OF REDUNDANT QUEUE
	MOVEM	P1,.RBPPN(S2)		;STORE IT
	MOVSI	P1,CMQ2			;GET THE CHANNEL NUMBER
	IORM	P1,.FOFNC(S1)		;STORE IT
	HRLI	S1,6			;GET LEN,,ADR
	FILOP.	S1,			;OPEN THE REDUNDANT QUEUE!!
	STOPCD	(COR,HALT,,<Cannot open redundant queue>)
>  ;END IFN FTRQUE

	SKIPE	DEBUGW			;DEBUGGING?
	$RETT				;YES - THEN DON'T SET QUESTR
	MOVE	S1,[.DCMAX,,ACTSTR]	;SET UP UUO AC
	MOVEI	S2,CMQ1			;GET CHANNEL NUMBER
	MOVEM	S2,ACTSTR+.DCNAM	;SAVE AS THE ARGUMENT
	DSKCHR	S1,			;GET STRUCTURE NAME
	  $RETT				;STRANGE
	MOVE	S1,[.STQST,,ACTSTR+.DCSNM] ;SET UP AC
	SETUUO	S1,			;SET THE QUEUE STRUCTURE IN THE MONITOR
	  JFCL				;CAN'T
	MOVE	S1,ACTSTR+.DCSNM	;GET STR NAME
	MOVEM	S1,G$QSTR##		;SAVE
	$RETT				;RETURN

;HERE ON A FILOP. FAILURE FOR THE PRIME QUEUE

OQUE.1:	CAIN	S1,ERFBM%		;SPECIAL CASE: FILE BEING MODIFIED
	STOPCD	(PQI,HALT,,<Prime queue is interlocked>)
	STOPCD	(COP,HALT,,<Cannot open prime queue>)
SUBTTL	SETOQF  --  Setup to OPEN master queue files

;SETOQF IS CALLED BY I$OQUE TO SETUP THE INVARIANT PART OF THE FILOP AND
;	LOOKUP UUO BLOCKS.  INTO THE LOOKUP BLOCK IT FILLS IN:
;		BLOCK LENGTH
;		FILE-NAME EXTENSION
;		PROTECTION
;		ESTIMATED LENGTH
;		FILE STATUS BITS
;INTO THE FILOP BLOCK IT PUTS
;		FILOP FUNCTION
;		I/O STATUS
;		FILE-STRUCTURE NAME
;		ADDRESS OF LOOKUP BLOCK

;RETURN WITH S1 CONTAINING ADDRESS OF FILOP BLOCK AND S2 CONTAINING THE
;	ADDRESS OF THE LOOKUP BLOCK

SETOQF:	CLEARM	SETO.A			;CLEAR FIRST WORD OF LOOKUP BLOCK
	MOVE	S1,[SETO.A,,SETO.A+1]
	BLT	S1,SETO.A+.RBSTS	;AND CLEAR THE REST
	CLEARM	SETO.B			;CLEAR THE FIRST WORD OF FILOP BLOCK
	MOVE	S1,[SETO.B,,SETO.B+1]
	BLT	S1,SETO.B+5		;AND CLEAR THE REST

	MOVEI	S1,.RBSTS		;GET LENGTH OF LKP BLOCK
	MOVEM	S1,SETO.A+.RBCNT	;SAVE IT
	MOVSI	S1,'QSR'		;GET THE EXTENSION
	MOVEM	S1,SETO.A+.RBEXT	;SAVE IT
	MOVSI	S1,FSSPRT_9		;GET FILE PROTECTION
	MOVEM	S1,SETO.A+.RBPRV	;STORE IT AWAY
	MOVEI	S1,1000			;ESTIMATE 1 FILE SECTION
	MOVEM	S1,SETO.A+.RBEST	;SAVE IT
	MOVX	S1,RP.ABC		;ALWAYS BAD CHECKSUM
	MOVEM	S1,SETO.A+.RBSTS	;AND SAVE IT

	MOVX	S1,<FO.PRV+.FOSAU>	;SINGLE ACCESS UPDATE
	MOVEM	S1,SETO.B+.FOFNC	;SAVE FUNCTION WORD
	MOVX	S1,<UU.PHS+.IODMP>	;PHONLY DUMP MODE
	MOVEM	S1,SETO.B+.FOIOS	;SAVE STATUS
	SKIPE	DEBUGW			;ARE WE DEBUGGING?
	SKIPA	S1,[EXP DFSSTR]		;YES, USE DEBUGGING STRUCTURE
	MOVX	S1,FSSSTR		;OTHERWISE, GET THE STR NAME
	MOVEM	S1,SETO.B+.FODEV	;SAVE IT
	SKIPN	DEBUGW			;IF WE ARE NOT DEBUGGING,,
	JRST	SETO.1			;    RETURN NOW


	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	SETOM	ACTSTR+.PTFCN		;SET MY JOB #,,READ PATH FCN
	SETZM	ACTSTR+.PTSWT		;NO SWITCHES
	MOVE	S1,[ACTSTR+.PTSWT,,ACTSTR+.PTSWT+1] ;GET SOURCE,,DEST
	BLT	S1,ACTSTR+.PTMAX-1	;ZERO THE REST OF THE PATH BLOCK
	MOVE	S1,[.PTMAX,,ACTSTR]	;GET PATH. UUO PARM LIST
	PATH.	S1,			;GET USERS PATH
	JRST	SETO.1			;IF AN ERROR,,JUST RETURN
	MOVEI	S1,ACTSTR		;POINT TO PATH BLOCK
	MOVEM	S1,SETO.A+.RBPPN	;SET IT IN THE FILOP. BLOCK
SETO.1:	MOVEI	S2,SETO.A		;GET ADDRESS OF LKP BLOCK
	MOVEM	S2,SETO.B+.FOLEB	;SAVE IT
	MOVEI	S1,SETO.B		;LOAD ADR OF FILOP BLOCK
	$RETT				;AND RETURN


SETO.A:	BLOCK	.RBSTS+1		;THE LOOKUP BLOCK
SETO.B:	BLOCK	6			;THE FILOP BLOCK
	SUBTTL	TAPE MOUNT MESSAGE DISPATCHER


	INTERN	I$OMNT			;MAKE IT GLOBAL
	INTERN	I$MINI			;A NOOP ON THE -10
	INTERN	I$KMNT			;KILL A USER MOUNT REQUEST
	INTERN	I$ISTR			;INITIALIZE SYSTEM STRUCTURE LIST
	INTERN	I$PERM			;MARK PERMANENT STRUCTURES AS SUCH

	EXTERN	TXTTBL			;TABLE OR ADRS OF ERROR TEXTS
	EXTERN	MDAOBJ			;MDA OBJECT BLOCK FOR $ACK

I$OMNT:	SKIPN	G$MDA##			;IS THERE MDA SUPPORT ???
	JRST	OMNT.3			;NO,,SKIP THIS
	MOVSI	S1,-MNTLEN		;GET THE DISPATCH TABLE LENGTH
	HRRI	S1,MNTDSP		;AND THE TABLE ADDRESS
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
OMNT.1:	LOAD	TF,0(S1),RHMASK		;GET THE DISPATCH TABLE MESSAGE TYPE
	CAMN	TF,S2			;HAVE WE FOUND A MATCH ???
	JRST	OMNT.2			;YES,,GO PROCESS IT
	AOBJN	S1,OMNT.1		;CONTINUE THROUGH THE DISPATCH TABLE
	JRST	[$WTO(<Internal Error>,<Invalid Operator Mount Message Type ^O/S2/>,,$WTFLG(WT.SJI))
		$RETT]			;KEEP RUNNING

OMNT.2:	LOAD	S1,0(S1),LHMASK		;GET THE MESSAGE PROCESSOR ADDRESS
	PUSHJ	P,0(S1)			;RETURN THROUGH THE MESSAGE PROCESSOR
	JUMPT	.RETT			;ALL WENT WELL, MOVE ALONG
	SKIPN	S1,G$ERR##		;GET THE ERROR CODE
	$RETT				;OR NO ERROR CODE, QUIT
	$ACK (<Operator Command Processing Error>,<^T/@TXTTBL(S1)/>,MDAOBJ,.MSCOD(M))
	$RETT

OMNT.3:	$ACK	(<MDA is not Supported in this Monitor>,,,.MSCOD(M))
	$RETT				;RETURN

;Each of the processing routines is resonsible for
;either 1) ACKing the OPR directly and returning TRUE, or
;	2) Returning FALSE via one of the E$xxx routines.

MNTDSP:	D$STAP##,,.ODSHT		;SHOW STATUS TAPE DRIVES
	D$SDSK##,,.ODSHD		;SHOW STATUS DISK DRIVES
	D$ENAB##,,.ODENA		;ENABLE TAPE DRIVE AVR
	D$DISA##,,.ODDIS		;DISABLE TAPE DRIVE AVR
	D$ALIAS##,,.ODMTS		;MOUNT A STRUCTURE (WITH ALIAS)
	D$DISM##,,.ODDSM		;DISMOUNT STRUCTURE
	I$CNI,,.ODSDK			;SET DISK
	D$SMDA##,,.ODSTP		;SET TAPE
	I$CNI,,.ODSST			;SET STRUCTURE
	D$RECO##,,.ODREC		;RECOGNIZE TAPE
	D$UNLO##,,.ODUNL		;UNLOAD TAPE
	D$IDEN##,,.ODIDN		;IDENTIFY TAPE
	D$DELE##,,.ODDMT		;DELETE MOUNT REQUEST
	D$SSTR##,,.ODSTR		;SHOW STATUS STRUCTURES
	D$LOCK##,,.ODLOC		;LOCK A STRUCTURE
	D$ULOK##,,.ODULC		;UNLOCK A STRUCTURE
	I$CLST,,.ODCSL			;CHANGE THE SYSTEM LISTS
	I$SLST,,.ODSSL			;SHOW THE SYSTEM LISTS
	D$SALC##,,.ODSAL		;SHOW ALLOCATION

	MNTLEN==.-MNTDSP		;DISPATCH TABLE LENGTH

I$CNI::$ACK	(Command Not Yet Implemented,,,.MSCOD(M))
	$RETT				;RETURN

	SUBTTL	I$ISTR - ROUTINE TO INITIALIZE THE SYSTEM STRUCTURE LIST

I$ISTR:	PUSHJ	P,.SAVET		;SAVE ALL T AC'S
	PUSHJ	P,.SAVE1		;SAVE P1 ALSO
	SETZM	T1			;CLEAR T1
ISTR.1:	SYSSTR	T1,			;GET FIRST STRUCTURE IN SYSTEM
	STOPCD	(CSS,HALT,,<Can't get system structure list>)
	JUMPE	T1,.RETT		;NO MORE,,RETURN
	PUSHJ	P,D$CVOL##		;CREATE AN ENTRY IN THE VOLUME QUEUE
	MOVE	P1,S1			;SAVE THE VOL ADDRESS
	MOVE	T2,S1			;PUT HERE ALSO (FOR ISTR.5)
	MOVEM	T1,.VLNAM(P1)		;SAVE THE STRUCTURE NAME
	MOVEM	T1,ACTSTR+.DCNAM	;SAVE FOR DSKCHR
	MOVE	S1,[.DCMAX,,ACTSTR]	;SET UP UUO
	DSKCHR	S1,			;READ DISK CHARACTERISTICS
	  TDZA	S1,S1			;CAN'T
	MOVE	S1,ACTSTR+.DCOWN	;GET OWNER PPN
	MOVEM	S1,.VLOID(P1)		;SAVE IT
	MOVE	S1,P1			;AIM AT THE VOL BLOCK
	PUSHJ	P,D$SVRS##		;GENERATE A RESOURCE NUMBER
	MOVE	S1,T1			;GET THE STRUCTURE NAME IN S1
	PUSHJ	P,ISTR.5		;GEN THE VOL BLOCK FOR IT
	MOVX	S1,%STAMN		;GET 'STRUCTURE MOUNTED' STATUS BITS
	STORE	S1,.VLFLG(P1),VL.STA	;SAVE AS THE NEW VOLUME STATUS
	MOVE	S1,G$NOW##		;GET THE CURRENT TIME
	MOVEM	S1,.VLMTM(P1)		;AND SET IT
	MOVX	S1,.TFLAL		;GET 'ANSI LABELED' LABEL TYPE
	STORE	S1,.VLFLG(P1),VL.LBT	;   AND SET IT
	MOVE	T3,[POINT 6,ACTSTR]	;GET BYTE PTR TO STRUCTURE NAME
	MOVEI	S1,5			;ONLY SCAN 5 BYTES
ISTR.2:	ILDB	S2,T3			;GET A STRUCTURE BYTE
	SKIPE	S2			;IS IT NULL ???
	SOJG	S1,ISTR.2		;OR IS BYTE COUNT EXHAUSTED ???
	MOVEI	S1,20			;GET A SIXBIT '0'
	DPB	S1,T3			;CREATE A LOGICAL UNIT NAME 
	MOVE	T2,P1			;START LINKING WITH THE PRIMARY VOL BLK
ISTR.3:	LDB	S1,T3			;GET THE LAST BYTE
	AOS	T4,S1			;BUMP TO NEXT LOGICAL UNIT NAME
	DPB	S1,T3			;AND SAVE IT
	MOVE	S1,[.DCMAX,,ACTSTR]	;GET DSKCHR PARMS
	DSKCHR	S1,			;GET THE DISK PARAMETERS
	JRST	ISTR.4			;CAN'T,,MAKE SURE THE STR IS IN THE CAT
	PUSHJ	P,D$CVOL##		;CREATE A VOLUME ENTRY FOR THIS VOLUME
	MOVE	S2,ACTSTR+.DCUID	;GET THE VOLUME ID (HOME BLOCK)
	MOVEM	S2,.VLNXT(T2)		;SET NEXT VOL NAME IN PREVIOUS VOL BLK
	MOVE	S2,ACTSTR+.DCOWN	;GET OWNER PPN
	MOVEM	S2,.VLOID(T2)		;SET IT
	STORE	S1,.VLPTR(T2),VL.NXT	;POINT LAST VOL TO NEXT VOL
	STORE	T2,.VLPTR(S1),VL.PRV	;POINT NEXT VOL TO LAST VOL
	MOVE	T2,S1			;MAKE NEXT VOL THE CURRENT VOL
	SUBI	T4,20			;GET THE LOGICAL UNIT NUMBER (OCTAL)
	STORE	T4,.VLFLG(T2),VL.LUN	;SAVE IT
	PUSHJ	P,ISTR.6		;UPDATE UCB POINTERS
	JRST	ISTR.3			;AND TRY NEXT VOLUME

ISTR.4:	MOVE	S1,P1			;GET THE PRIMARY VOL BLK ADDR BACK
	PUSHJ	P,V$CREA##		;ADD IT TO THE INCORE CATALOG
	MOVE	S1,P1			;GET THE PRIMARY VOL BLOCK ADDRESS
	PUSHJ	P,I$STRM		;PERFORM STRUCTURE ACCOUNTING
	JRST	ISTR.1			;AND GO GET THE NEXT STRUCTURE

	;CONTINUED ONE THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;Here to get disk parms for the volume in S1

ISTR.5:	MOVEM	S1,ACTSTR		;SAVE THE DISK/STRUCTURE NAME
	MOVE	S1,[30,,ACTSTR]		;GET DSKCHR PARMS
	DSKCHR	S1,			;GET STRUCTURE PARMS
	PUSHJ	P,S..CDC		;CAN'T,,STOPCODE !!!

ISTR.6:	MOVE	S1,ACTSTR+.DCUID	;GET THE HOME BLOCK ID
	MOVEM	S1,.VLVID(T2)		;SAVE IT IN THE VOL BLOCK
	MOVE	S1,ACTSTR+.DCSNM	;GET THE STRUCTURE NAME
	MOVEM	S1,.VLSTR(T2)		;SAVE IT IN THE VOL BLOCK
	MOVE	S1,ACTSTR+.DCUPN	;GET THE UNIT THIS STR IS MOUNTED ON
	PUSHJ	P,D$GUCB##		;FIND IT IN OUR UCB CHAIN
	SKIPT				;IT MUST BE THERE !!!
	STOPCD	(CFU,HALT,,<Can't find UCB for unit (see ACTSTR+.DCUPN)>)
	MOVEM	T2,.UCBVL(S1)		;LINK THE VOL TO THE UCB
	MOVEM	S1,.VLUCB(T2)		;AND LINK THE UCB TO THE VOL
	MOVX	S2,UC.SWP		;GET THE UNIT SWAP BIT
	SKIPL	ACTSTR+.DCPAS		;ANY SWAPPING SPACE HERE ???
	IORM	S2,.UCBST(S1)		;YES,,LITE THE SWAP BIT IN UCB
	$RETT				;RETURN

	SUBTTL	I$PERM - ROUTINE TO MODIFY THE 'A' MATRIX REFLECTING PERM STRS

	;CALL:	NO ARGS
	;
	;RET:	TRUE

I$PERM:	SKIPN	G$PERM##		;PERMANENT STRUCTURES TURNED ON?
	$RETT				;NO
	PUSHJ	P,.SAVET		;SAVE T1 - T4
	SETZB	T1,T2			;ZERO T1 AND T2
	SETOM	T3			;WANT FIRST STR IN SYSTEM SEARCH LIST

PERM.1:	MOVE	S1,[3,,T1]		;SETUP GOBSTR ARG BLOCK
	GOBSTR	S1,			;GET THE SYSTEM SEARCH LIST STR
	JRST	PERM.2			;ON ERROR,,LOOK AT UCB'S
	CAMN	T3,[-1]			;DONE WITH THE SEARCH LIST ???
	JRST	PERM.2			;YES,,LOOK AT THE UCB'S
	MOVE	S1,T3			;GET THE STR NAME IN S1
	PUSHJ	P,SETPRM		;SETUP THE 'A' MATRIX
	JRST	PERM.1			;AND CONTINUE

PERM.2:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST UCB ENTRY
	JRST	PERM.4			;JUMPT THE FIRST TIME THROUGH

PERM.3:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB QUEUE ENTRY
PERM.4:	JUMPF	.RETT			;NO MORE,,RETURN
	LOAD	S1,.UCBST(S2),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%DISK		;IS IT A DISK ???
	JRST	PERM.3			;NO,,SKIP IT
	LOAD	S1,.UCBST(S2),UC.SWP	;DOES IT HAVE SWAP SPACE ON IT ??
	JUMPE	S1,PERM.3		;NO,,SKIP IT
	SKIPN	S1,.UCBVL(S2)		;LOAD AND CHECK THE VOL ADDRESS
	JRST	PERM.3			;NO VOLUME MOUNTED,,SKIP IT
	MOVE	S1,.VLSTR(S1)		;GET THE VOL STRUCTURE NAME
	PUSHJ	P,SETPRM		;MODIFY THE 'A' MATRIX
	JRST	PERM.3			;CONTINUE FOR ALL UCB'S

	SUBTTL	SETPRM - ROUTINE TO MODIFY THE 'A' MATRIX FOR PERM STRUCTURES

	;CALL:	S1/ THE STR NAME
	;
	;RET:	TRUE ALWAYS

SETPRM:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE STRUCTURE NAME
	JUMPE	P1,.RETT		;JUST CHECKING !!!
	PUSHJ	P,D$SRSN##		;GET THE STRUCTURE RESOURCE NUMBER
	IMULI	S1,AMALEN		;GET 'A' MATRIX OFFSET
	ADD	S1,AMATRX##		;GET THE ENTRY ADDRESS
	LOAD	S2,.AMNAM(S1),AM.PRR	;GET THE PERMANENT RESOURCE BIT
	JUMPN	S2,.RETT		;ALREADY SET,,JUST RETURN
	MOVX	S2,AM.PRR		;GET THE PERMANENT STRUCTURE BIT
	IORM	S2,.AMNAM(S1)		;LITE IT FOR THIS STRUCTURE
	LOAD	S1,.AMNAM(S1),AM.NAM	;GET ADDRESS OF RESOURCE NAME
	PUSHJ	P,V$FIND##		;GET THE CATALOG ENTRY
	SKIPT				;IT MUST BE THERE !!!
	PUSHJ	P,S..SCE##		;NO,,THATS AN ERROR
	MOVEI	S2,.CQVSL(S1)		;POINT THE THE CAT VOL LIST
	MOVE	S1,.CQNVL(S1)		;GET THE VOL COUNT
SETP.1:	MOVE	P1,.CQRSN(S2)		;GET THE VOL RESOURCE NUMBER
	IMULI	P1,AMALEN		;GET THE ENTRY OFFSET
	ADD	P1,AMATRX##		;GET THE ENTRY ADDRESS
	DECR	.AMCNT(P1),AM.AVA	;DECRIMENT THE AVAILABLE COUNT BY 1
	ADDI	S2,2			;POINT TO THE NEXT VOL BLK
	SOJG	S1,SETP.1		;CONTINUE FOR ALL VOLUMES
	$RETT				;RETURN WHEN DONE

	SUBTTL	I$MDAS,I$MDAC - Set and clear MDA control bit for a device

;These routines will set or clear the monitor's 'device controlled by MDA' bit.

	;CALL:	S1/ The Sixbit Device Name
	;
	;RET:	True if alls ok, False if we Can't do it.


I$MDAS::SKIPA	S2,[.DFMDS]		;CODE TO SET MDA BIT
I$MDAC::MOVX	S2,.DFMDC		;CODE TO CLEAR MDA BIT

	;Enter here with S1/SIXBIT device name, S2/ function code

	EXCH	S1,S2			;PUT CODE IN S1, DEV NAME IN S2
	MOVE	TF,[XWD 2,S1]		;AIM AT THE ARG BLOCK
	DEVOP.	TF,			;TELL THE MONITOR TO DO IT
	$RETF				;CAN'T CHANGE DEVICE STATUS

	;Having cleared the DVCMDA bit, Clear the label type for the drive

	$SAVE	<T1>			;SAVE A REG
	MOVX	T1,.TFLBP		;CODE FOR BYPASS LABELS
	MOVX	S1,.TFPLT+.TFSET	;PRIV'D LABEL TYPE SET
	MOVE	TF,[XWD 3,S1]		;LENGTH,, ADDR
	TAPOP.	TF,			;MAKE THE DRIVE BYPASS LABELS
	$RETF				;CAN'T DO IT ALL
	$RETT				;WINS


I$MINI:	$RETT				;JUST RETURN

	SUBTTL	I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS

	;CALL:	M/  Kill Message Address
	;
	;RET:	TRUE ALWAYS

I$KMNT:: PUSHJ	P,.SAVE2		;SAVE P1 - P2
	MOVEI	P1,KIL.RQ(M)		;GET THE RDB ADDRESS
	SETZM	P2			;CLEAR DELETE COUNTER
	SKIPN	S1,.RDBRQ(P1)		;DID HE SPECIFY A REQUEST ID ???
	JRST	KMNT.1			;NO,,SKIP THIS
	PUSHJ	P,D$FVSL##		;FIND THE VSL HE WANTS
	JUMPF	E$SNY##			;NOT THERE,,THATS AN ERROR
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	AP,.VSMDR(P1)		;AND THE MDR ADDRESS
	LOAD	S1,G$PRVS##,MD.PJB	;GET THE SENDERS JOB NUMBER
	LOAD	S2,.MRJOB(AP),MD.PJB	;GET THE MDR JOB NUMBER
	CAME	S1,S2			;THEY MUST MATCH !!!
	JRST	E$SNY##			;NO,,THATS AN ERROR
	MOVE	S1,P1			;GET THE VSL ADDRESS
	JRST	KMNT.2			;AND GO COMPLETE THE PROCESSING

KMNT.1:	LOAD	S1,G$PRVS##,MD.PJB	;GET THE SENDERS JOB NUMBER
	PUSHJ	P,D$FMDR##		;FIND THE USERS MDR
	JUMPF	E$SNY##			;NOT THERE,,THATS AN ERROR
	MOVEI	S1,.RDBVS(P1)		;POINT TO ASCIZ VOLUME SET NAME
	PUSHJ	P,D$FLNM##		;LOOK FOR LOGICAL NAME FIRST
	JUMPT	KMNT.2			;FOUND IT,,CONTINUE
	MOVEI	S1,.RDBVS(P1)		;POINT TO ASCIZ VOLUME SET NAME
	PUSHJ	P,D$FVSN##		;LOOK FOR REQUEST BY THIS VOL SET NAME
	JUMPF	E$SNY##			;NOT THERE,,THATS AN ERROR

KMNT.2:	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	LOAD	S1,.VSFLG(P1),VS.ALC	;HAS HE TRIED TO MOUNT IT YET ???
	JUMPN	S1,E$CDA##		;NO,,THEN ITS STILL ALLOCATED
	SKIPE	.VSUCB(P1)		;DOES HE ALREADY HAVE THE VOLUME MOUNTED
	PJRST	E$MRP##			;YES,,THATS AN ERROR
	MOVE	S1,P1			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,D$FOWN##		;DOES HE OWN THE VOLUME
	JUMPT	E$MRP##			;YES,,HE CAN'T DO THIS !!!
	$WTO	(<Mount Request #^D/.VSRID(P1)/ cancelled by user>,<  ^I/DEMOT/^M^J  Volume-set-name: ^T/.VSVSN(P1)/>,,<$WTFLG(WT.SJI)>)
	SKIPE	G$ACK##			;DOES HE WANT AN ACK ???
	$TEXT	(G$CCHR##,<Mount Request for ^T/.VSVSN(P1)/ Canceled^0>) 
	MOVE	S1,P1			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,D$ALCV##		;RETURN HIS RESOURCES
	LOAD	S1,.MRCNT(AP),MR.CNT	;ANY REQUESTS LEFT ???
	SKIPN	S1			;YES,,SKIP 
	PUSHJ	P,D$DMDR##		;NO,,DELETE THE MDR
	$RETT				;AND RETURN

	SUBTTL	I$CKAV - See if a device is owned by anyone.

;This routine takes a device name in S1.  It asks the monitor if anyone
;owns the drive.  This is useful on intialization, wheen MDA may have
;been restarted, and unaware of the state of the world,
;or when a drive has been set unavailable,  and MDA
;has not been tracking its usage.

;Returns: TRUE if someone owns the device, false if nobody does

I$CKAV::DEVCHR	S1,			;SEE IF THE DEVICE IS AVAILABLE
	TXNE	S1,DV.ASC!DV.ASP	;IS THE DEVICE AVAILABLE?
	$RETT				;SOMEBODY OWNS IT!!
	$RETF				;NOBODY OWNS IT
	SUBTTL	I$GOWN - Get device owner

;This routine takes a sixbit device name in S1 and returns its
;controlling job number in S1.

;Return: TRUE if owned, FALSE if not.

I$GOWN::DEVTYP	S1,			;Get physical device properties
	 $RETF				;Return false if error
	LOAD	S1,S1,TY.JOB		;Get the job number seperated
	JUMPE	S1,.RETF		;No such device
	$RETT				;Return true
	SUBTTL	FILE ARCHIVING ENTRY POINTS

	;ALL FILE ARCHIVING ENTRY POINTS RETURN FALSE

I$NDEF:: $RETF				;JUST RETURN
I$NFJB:: $RETF				; ''    ''
I$NTFY:: $RETF				; ''    ''
I$NLNK:: $RETF				; ''    ''
I$RDEF:: $RETF				; ''    ''
I$RFJB:: $RETF				; ''    ''
I$RSCH:: $RETF				; ''    ''
I$RLNK:: $RETF				; ''    ''
I$ARCH:: $RETF				; ''    ''

	SUBTTL	LOCK and UNLOCK support

	;These routines just try to tell the operating system that
	;	a file structure is to be locked from further access.
	;	Or cleared from such restriction
	;
	;CALL:	S1/	File structure name
	;
	;RET:	TRUE 	if the monitor allows the call,
	;	FALSE	if not

	INTERN	I$LOCK		;MAKE IT GLOBAL
	INTERN	I$UNLK		; ""  ""   ""

I$LOCK:	MOVX	TF,.FSLOK		;FUNCTION CODE TO DO LOCK
	SKIPA				;DO IT
I$UNLK:	MOVX	TF,.FSCLR		;FUNCTION CODE TO DO UNLOCK
	MOVX	S2,<XWD 2,TF>		;AIM AT THE ARGUMENT LIST
	SKIPE	DEBUGW			;NEVER DO IT IF DEBUGGING!
	$RETT				;PRETEND IT WON, THOUGH
	STRUUO	S2,			;DO IT
	$RETF				;CAN'T
	$RETT				;DONE
	SUBTTL	I$SLST - CHANGE SYSTEM LISTS

;Since some of the actions involved in adding and
; removing units and structures from various system lists,
; all the work is done by PULSAR.
;All this routine does is forward the message (in M) to PULSAR

I$SLST:
I$CLST:
	PJRST	I$FPLR			;FORWARD THE MESSAGE TO PULSAR
	SUBTTL	I$FPLR - Forward a message to PULSAR

;This routine is used when all or some of the functionality
; provided by some OPR message will be provided by the tape labeler.
; This routine makes a copy of the incoming message, and
; sends the copy to the tape labeler.
;Call -
;	M/	Incoming message adrs
;Returns -
;	TRUE	(ALWAYS)

I$FPLR::
	$CALL	M%GPAG			;GET A PAGE
	STORE	S1,G$SAB##+SAB.MS	;SAVE ADRS OF THE MESSAGE
	MOVX	S2,PAGSIZ		;GET A PAGE LENGTH (1000)
	MOVEM	S2,G$SAB##+SAB.LN	;SEND MESSAGE AS A PAGE
	LOAD	S2,.MSTYP(M),MS.CNT	;GET LENGTH OF THE MESSAGE
	ADDI	S2,0(S1)		;FIGURE TERMINATION ADRS
	HRLI	S1,0(M)			;MOVE FROM THE INCOMING MESSAGE
	BLT	S1,-1(S2)		;MOVE THE MESSAGE OVER
	MOVX	S1,SI.FLG+SP.TLP	;SEND TO TAPE LABELER (PULSAR)

;S1 = PID index. SAB should contain everything else.

SNDMSG:	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IN SAB
	SETZM	G$SAB##+SAB.PB		;NO IN BEHALF OF PIB
	SETZM	G$SAB##+SAB.PD		;NO RECIEVERS PID (USING INDEX)
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	$RETT				;RETURN
	SUBTTL	I$OCLS	Operator Log File Closure Event

;Called by scheduler. Message .QOOLC

I$OCLS::PUSHJ	P,M%GPAG		;GET A PAGE FOR MESSAGE
	$SAVE	<M>			;SAVE M
	MOVE	M,S1			;GET PAGE ADDRESS IN M
	MOVEI	S1,.QOOLC		;GET MESSAGE TYPE
	STORE	S1,.MSTYP(M),MS.TYP	;STORE IN MESSAGE
	MOVEI	S1,.OHDRS		;GET MESSAGE SIZE
	STORE	S1,.MSTYP(M),MS.CNT	;STORE IN MESSAGE
	MOVEM	S1,G$SAB##+SAB.LN	;AND IN SAB
	MOVEM	M,G$SAB##+SAB.MS	;PUT MESSAGE ADDRESS IN SAB
	MOVX	S1,SI.FLG+SP.OPR	;GET ORION'S PID INDEX
	PUSHJ	P,SNDMSG		;SEND THE MESSAGE TO ORION
	PUSHJ	P,Q$EVTR##		;RELEASE THE EVENT
	$RETT				;RETURN
	SUBTTL	Usage File and Billing Closure -- ACTDAE functions 10 and 11

;Called by scheduler with S1 = QE address, S2 = object block address

I$UFIL::MOVEI	TF,UGUFC$		;LOAD FILE CLOSURE CODE
	TRNA				;"SKIPA 0,FOO" DOESN'T LOAD AC
I$UBIL::MOVEI	TF,UGEBC$		;LOAD BILLING CLOSURE CODE
	$SAVE	<M,T1>			;SAVE A COUPLE ACS
	MOVE	T1,TF			;COPY MESSAGE TYPE AND .QE ADDRESS
	PUSHJ	P,M%GPAG		;GET A PAGE FOR MESSAGE
	MOVE	M,S1			;COPY ADDRESS
	STORE	T1,.MSTYP(M),MS.TYP	;SAVE MESSAGE TYPE
	MOVEI	S1,.OHDRS		;GET MESSAGE SIZE
	STORE	S1,.MSTYP(M),MS.CNT	;STORE IN MESSAGE
	MOVEM	S1,G$SAB##+SAB.LN	;AND IN SAB
	CAIE	T1,UGUFC$		;IS IT FILE CLOSURE?
	JRST	USAG.1			;NO, NO SWITCHES THEN
	GETLIM	S1,.QELIM(AP),SWIT	;YES, GET DEPENDENT SWITCHES
	MOVEM	S1,.OFLAG(M)		;SAVE FOR ACTDAE
USAG.1:	MOVEM	M,G$SAB##+SAB.MS	;SAVE MESSAGE ADDRESS IN THE SAB
	MOVX	S1,SI.FLG+SP.ACT	;GET ACTDAE'S PID INDEX
	PUSHJ	P,SNDMSG		;SEND OFF TO ACTDAE
	PUSHJ	P,Q$EVTR##		;RELEASE THE EVENT
	$RETT				;RETURN
	SUBTTL	I$KINT & I$KSYI - QUASAR'S ROUTINES FOR KSYS INTERRUPTS

;Enable KSYS interrupts

I$KINT:	MOVEI	S1,KSYTAB		;GET WARNING TIME TABLE ADDRESS
	MOVEM	S1,KSYTIM		;INTIALIZE INDIRECT POINTER
	MOVX	S1,%NSKTM		;SEE IF KSYS ALREADY SET
	GETTAB	S1,
	SETZM	S1			;ASSUME NONE SET IF ERROR
	MOVEM	S1,KSYS			;INIT KSYS WORD IN INTERRUPT BLOCK
	MOVEM	S1,KSYOLD		;INIT "OLD KSYS" VALUE ALSO
	JUMPLE	S1,KINT.2		;IF NO KSYS PENDING SKIP TABLE INIT
KINT.1:	CAMLE	S1,@KSYTIM		;KSYS PENDING. SET WARNING TIME 
	JRST	KINT.2			;INDEX INTO KSYTAB.
	AOS	KSYTIM
	JRST	KINT.1
KINT.2:	IMULI	S1,^D60			;CONVERT TO SECONDS FOR G$KSYS
	MOVEM	S1,G$KSYS##		;STORE SECONDS FOR I$SYSV
	MOVX	T1,.PCKSY		;GET KSYS INTERRUPT FUNCTION CODE
	MOVSI	T2,<KSYBLK-INTBLK>	;GET OFFSET FROM BEGINNING OF VECTOR
	SETZB	T3,G$KSYI##		;DON'T NEED T3,,INIT KSYS INTR FLAG
	MOVEI	S1,I$KSYI		;GET ADDRESS OF INTERRUPT ROUTINE
	MOVEM	S1,KSYBLK+.PSVNP	;SAVE ADDRESS
	MOVX	S1,<PS.FON+PS.FAC+T1>	;BUILD ARG AC
	PISYS.	S1,			;DO THE ENABLE
	 SKIPF				;COMPLAIN
	$RETT				;RETURN
	$WTO	(<Couldn't enable for KSYS interrupts via PSI system>,<OPSER will have to be run>)
	SETOM	KSYBLK+.PSVNP		;INVALIDATE INTERRUPT ROUTINE ADDRESS
	$RETT				;RETURN

;KSYS interrupt routine

I$KSYI:	$BGINT	1,
	SETOM	G$KSYI##		;FLAG INTERRUPT OCCURRED
	$DEBRK
	SUBTTL	I$KSYS - ROUTINE TO CHECK KSYS INFO FROM MONITOR

;I$KSYS is called from MAIN loop or I$SYSV when G$KSYI is negative.
;	KSYS warnings are broadcasted to users at intervals specified
;	in KSYSTB.

KSYOLD::BLOCK	1			;LAST KSYS VALUE
KSYTIM:	BLOCK	1			;POINTER INTO KSYTAB
	RADIX 10
KSYTAB:	EXP	24*60,12*60,8*60,4*60,2*60,60,30,15,10,5,4,3,2,1 ;MINUTES TILL KSYS (WARNING TIMES)
	RADIX 8

I$KSYS:	SKIPL	G$KSYI##		;INTERRUPT HAPPEN?
	$RETT				;NO,,RETURN (HOW'D THAT HAPPEN?)
	SETZM	G$KSYI##		;YES,,CLEAR FLAG
	SKIPE	DEBUGW			;DEBUGGING?
	$RETT				;YES, DON'T DO KSYS STUFF
	MOVE	S1,KSYS			;GET NEW VALUE
	MOVE	S2,KSYOLD		;GET OLD VALUE
	MOVEM	S1,KSYOLD		;REMEMBER NEW VALUE
	JUMPL	S1,KSYS.0		;JUMP IF TIMESHARING OVER
	JUMPG	S1,KSYS.6		;IF POSITIVE,,SEE IF TIME FOR WARNING
	JUMPG	S2,KSYS0		;JUMP IF KSYS HAS BEEN CANCELLED

;KSYS going from off to on. Check to see if we're waiting for BATCON
;to "fire up" for KSYS duties.

	SETZM	G$KUDT##		;KSYS GOING FROM OFF TO ON
	MOVX	S1,.OTBAT		;GET BATCON'S OBJECT TYPE
	MOVX	S2,%GENRC		;AND HIS ATTRIBUTE
	PUSHJ	P,I$GOPD		;FIND HIS CJB
	JUMPF	.RETT			;?????
	MOVE	S2,CJB.NM(S1)		;GET BATCON'S NAME
	SETZ	S1,			;SEARCH BY NAME, NOT BY PID
	PUSHJ	P,A$FPSB##		;FIND HIS PSB
	JUMPF	.RETT			;IF NOT THERE THAT'S OK
	LOAD	S2,PSBFLG(S1),PSFSTS	;GET THE PSB STATUS
	CAXE	S2,PS.KSY		;FIRED UP BECAUSE OF KSYS AND TOOK ITS
	$RETT				;TIME ABOUT IT?
	MOVX	S2,PS.WAT		;YES, SET TO "WAITING". WE DON'T WANT
	STORE	S2,PSBFLG(S1),PSFSTS	;TO SEND AN ERRONEOUS KSYS MSG TO BATCON
	$RETT

;Here when KSYS has been cancelled. S1=0 S2 .GT. 0

KSYS0:	MOVEI	S1,KSYTAB		;REINIT WARNING TIME TYPEOUT TABLE
	MOVEM	S1,KSYTIM
	CAMLE	S2,KSYTAB		;WAS KSYS WARNING EVER BROADCASTED?
	JRST	KSYS.A			;PROBABLY NOT
	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S2			;SAVE S2
	MOVE	S1,[POINT 7,KSYBUF]	;INIT BYTE POINTER
	MOVEM	S1,KSYPTR		;..
	MOVEI	S1,[ASCIZ\KSYS cancelled\] ;GET A KEY STRING ADDRESS
	$TEXT	(KSYPUT,<SEND ^W/KSYTTY/ ^T/(S1)/. Timesharing will not end^A>)
	$WTO	(<^T/(S1)/>,,,$WTFLG(WT.SJI))
	PUSHJ	P,KSYMSG		;GO SEND MESSAGE TO USERS
KSYS.A:	SETZM	G$KUDT##		;CLEAR GLOBAL KSYS TIME
	$SAVE	<H,AP>			;SAVE H AND AP
	MOVEI	H,HDREVT		;GET EVENT QUEUE HEADER	ADDRESS
	LOAD	AP,.QHLNK(H),QH.PTF	;GET POINTER TO FIRST ENTRY
KSYS.B:	JUMPE	AP,.RETT		;JUST RETURN IF NONE
	GETLIM	S1,.QELIM(AP),TYPE	;GET EVENT TYPE
	CAIE	S1,.EVKSY		;KSYS EVENT?
	JRST	[LOAD AP,.QELNK(AP),QE.PTN ;NO, GET POINTER TO NEXT ENTRY
		 JRST KSYS.B]
	GETLIM	S1,.QELIM(AP),ACTV	;GET ACTIVE BIT
	JUMPE	S1,.RETT		;RETURN IF NOT ACTIVE
	MOVE	S1,G$NOW##		;GET CURRENT UDT
	PUSHJ	P,.UD2SC##		;CONVERT TO SECONDS
	EXCH	S1,P1			;SWAP OLD KSYS MINUTES AND SECONDS
	IMULI	S1,^D60			;CONVERT MINUTES TO SECONDS
	ADD	P1,S1			;GET LAST KSYS UDT IN SECONDS
	MOVE	S1,.QECRE(AP)		;GET KSYS EVENT UDT
	PUSHJ	P,.UD2SC##		;CONVERT TO SECONDS
	SUB	P1,S1			;GET DIFFERENCE
	MOVMS	P1			;GET POSITIVE DIFFERNCE
	CAIG	P1,^D60*2		;WITHIN 2 MINUTES?
	PUSHJ	P,Q$EVTR##		;YES, RELEASE THE EVENT
	$RETT				;RETURN
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Here when KSYS has just expired.

KSYS.0:	CAME	S1,[-1]			;CLOCK1 BUG KEEPS REMINDING US
	$RETT				;RETURN UNTIL MONITOR FIXED
	$WTO	(<Timesharing is over>,<Wait for "KSYS processing complete" message before SHUTDOWN>,,$WTFLG(WT.SJI)) ;TELL OPERATORS
	$SAVE	<AP,H>			;SAVE AP & H
	LOAD	AP,HDREVT##+.QHLNK,QH.PTF ;POINT TO THE FIRST ENTRY

KSYS.1:	JUMPE	AP,KSYS.2		;RETURN IF NO MORE ENTRIES
	GETLIM	S2,.QELIM(AP),TYPE	;GET EVENT TYPE
	CAIN	S2,.EVKSY		;KSYS?
	JRST	KSYS.2			;YES
	LOAD	AP,.QELNK(AP),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	KSYS.1			;AND LOOP

KSYS.2:	PUSHJ	P,Q$EVTR##		;DO EVENT RELEASE
	SETOM	G$KUDT##		;INDICATE IN UDT WORD

;Start BATCON if not already running

	MOVX	S1,.OTBAT		;GET OUR BATCON'S OBJECT TYPE
	MOVX	S2,%GENRC		;AND HIS ATTRIBUTE
	PUSHJ	P,I$GOPD		;GET BATCON'S CJB
	JUMPT	KSYS2A			;JUMP IF WE GOT IT
	$WTO	(<BATCON can't be started. CJB not found.>,<KSYS logouts will not be done>,,$WTFLG(WT.SJI))
	PJRST	KSYS5A			;GO DO SEND ALL
KSYS2A:	MOVE	S2,CJB.NM(S1)		;GET BATCON'S PROCESSOR NAME
	PUSH	P,S1			;SAVE CJB ADDRESS
	SETO	S1,			;SEARCH BY NAME, DON'T CARE ABOUT PID
	PUSHJ	P,A$FPSB##		;FIND BATCON'S PSB
	POP	P,S2			;GET CJB ADDRESS BACK IN S2
	JUMPF	KSYS2B			;JUMP IF NO PSB

;We have the PSB. Check to its status.

	LOAD	TF,PSBFLG(S1),PSFSTS	;GET PSB STATUS VALUE
	CAXN	TF,PS.RUN		;RUNNING?
	JRST	[PUSHJ	P,KSYS.5	;YES, SEND KSYS MSG
		 PJRST	KSYS5A]		;DO THE SEND ALL
	CAXE	TF,PS.FIR		;NO, WAITING TO BE FIRED UP?
	JRST	KSYS2D			;NO, MUST BE WAITING

;PSB needs to be fired.
; S1 continas PSB address, 0, or -1
; S2 contains CJB address

KSYS2B:	PUSH	P,S1			;SAVE PSB ARG
	PUSH	P,S2			;SAVE CJB ADDRESS
	HRLZ	S1,S2			;COPY BATCON'S CJB TO QUASAR'S
	HRRI	S1,QSRCJB
	BLT	S1,QSRCJB+CJB.SZ-1
	MOVEI	S1,QSRCJB
	MOVEI	TF,^D10			;WAIT 10 SECONDS FOR FRCLIN
	STORE	TF,CJB.TP(S1),CJ.TIM	;PUT IN CJB
	PUSHJ	P,I$SXXX		;GO START UP BATCON
	POP	P,S2			;GET CJB ADDRESS BACK
	POP	P,S1			;GET PSB ADDRESS BACK
	JUMPF	KSYS.4			;WE TRIED
	JUMPG	S1,KSYS2D		;IF PSB, DON'T CREATE ONE

;Create a PSB, BATCON is in the process of firing up

KSYS2C:	PUSH	P,S2			;SAVE CJB ADDRESS
	SETZB	S1,S2			;CLEAR ARG ACS
	PUSHJ	P,GETPSB##		;GET US A PSB
	POP	P,S2			;GET CJB ADDRESS BACK
	MOVE	TF,CJB.NM(S2)		;GET BATCON'S NAME
	MOVEM	TF,PSBNAM(S1)		;PUT IN PSB

;Set PSB status up for KSYS 

KSYS2D:	MOVX	TF,PS.KSY		;SET SPECIAL BATCON STATUS
	STORE	TF,PSBFLG(S1),PSFSTS
	SETZM	TF			;NO, MORE TRIES
	STORE	TF,PSBFLG(S1),PSFCNT	;ALL
	MOVE	S2,S1			;SAVE PSB ADDRESS
	$CALL	I%NOW			;GET CURRENT TIME
	ADD	S1,[EXP ^D30*^D3]	;WAIT 30 SECONDS FOR BATCON
	MOVEM	S1,PSBUDT(S2)		;SAVE UDT IN PSB
	$WTO	(<Waiting for BATCON to start for KSYS logouts>,,,$WTFLG(WT.SJI))
	MOVE	S1,S2			;GET PSB IN S1
	PJRST	KSYS5A			;GO DO SEND ALL

KSYS.4:	$WTO	(<BATCON startup failed>,<KSYS logouts will not be done>,,$WTFLG(WT.SJI))
	PJRST	KSYS5A			;GO DO SEND ALL

;Call here from A$HELLO when BATCON says hello and PS.KSY is set in PSFSTS.

I$SKSM::

;Send KSYS message to BATCON
;S1 = PSB ADDRESS

KSYS.5:	MOVE	S2,PSBPID(S1)		;GET BATCON'S PID
	MOVEM	S2,G$SAB##+SAB.PD	;SAVE PID IN SAB
	MOVEI	S2,MSHSIZ		;GET MESSAGE SIZE
	MOVEM	S2,G$SAB##+SAB.LN	;SAVE IT IN SAB
	STORE	S2,G$MSG##+.MSTYP,MS.CNT ;AND IN MESSAGE
	MOVX	S2,.QOKSY		;GET KSYS MESSAGE TYPE
	STORE	S2,G$MSG##+.MSTYP,MS.TYP ;STORE IT IN MESSAGE
	SETZM	G$MSG##+.MSFLG		;NO FLAGS
	SETZM	G$MSG##+.MSCOD		;NO ACK CODE
	MOVEI	S2,G$MSG##		;GET MESSAGE ADDRESS
	MOVEM	S2,G$SAB##+SAB.MS	;STORE IN SAB
	SETZM	G$SAB##+SAB.SI		;NO SPECIAL INFO NEEDED
	$CALL	C$SEND			;SEND MESSAGE TO BATCON
	$RETIT
	$WTO	(<KSYS message send to BATCON failed>,<Error: ^E/S1/>,,$WTFLG(WT.SJI))
	$WTO	(<BATCON not available>,<KSYS logouts will not be done>,,$WTFLG(WT.SJI))
	$RETT

;Do a SEND ALL to say "Timesharing is over!"

KSYS5A:	MOVE	S1,[POINT 7,KSYBUF]	;INIT BYTE POINTER
	MOVEM	S1,KSYPTR		;..
	$TEXT	(KSYPUT,<SEND ^W/KSYTTY/ Timesharing is over!^M^J^0>)	;BUILD MSG
	MOVEI	S1,KSYBUF		;GET ADDRESS OF BUFFER
	PUSHJ	P,FRCTYP		;OUTPUT FOR ALL TO SEE
	PUSHJ	P,TYPRSN		;TYPE REASON TOO
	MOVEI	S1,KSYTAB		;REINITIALIZE WARNING TIME
	MOVEM	S1,KSYTIM		;TYPEOUT TABLE
	$RETT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Here to check if a "Timesharing ends" message is appropriate.
;S1 = New KSYS value (greater than zero)
;S2 = Old KSYS value

;First see if a KSYS event exists. If not, create one.

KSYS.6:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	LOAD	S1,HDREVT##+.QHLNK,QH.PTF ;POINT TO FIRST EVENT ENTRY
KSYS6A:	JUMPE	S1,KSYS6B		;EMPTY MEANS NO KSYS EVENT
	GETLIM	S2,.QELIM(S1),TYPE	;GET EVENT TYPE
	CAIE	S2,.EVKSY		;KSYS EVENT?
	JRST	[LOAD S1,.QELNK(S1),QE.PTN ;NO, GET NEXT EVENT ENTRY AND LOOP
		 JRST KSYS6A]
	GETLIM	S2,.QELIM(S1),ACTV	;YES, GET ACTIVE BIT
	JUMPN	S2,KSYS6C		;CONTINUE ON IF KSYS EVENT ACTIVE
KSYS6B:	PUSH	P,M			;SAVE M
	MOVEI	S1,.EVKSY		;GET KSYS EVENT CODE
	PUSHJ	P,Q$EVTI##		;GO CREATE SKELETON EQ
	MOVE	S1,G$NOW##		;GET CURRENT UDT
	PUSHJ	P,.UD2SC##		;CONVERT TO SECONDS
	MOVE	S2,-2(P)		;GET NEW MINUTES TILL KSYS
	IMULI	S2,^D60			;CONVERT TO SECONDS
	ADD	S1,S2			;GET KSYS UDT IN SECONDS
	PUSHJ	P,.SC2UD##		;CONVERT TO UDT
	MOVEM	S1,.EQAFT(M)		;STORE IN EQ
	MOVX	S1,.QIFNC		;GET INTERNAL FUNCTION BIT
	IORM	S1,.MSTYP(M)		;LITE IT IN MESSAGE
	PUSHJ	P,Q$CREATE##		;CREATE THE KSYS EVENT FOR REAL
	POP	P,M			;RESTORE M
KSYS6C:	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	DMOVE	P1,S1			;COPY NEW AND OLD TIME-TILL-KSYS VALUES
	SUB	S2,S1			;COMPUTE DIFFERENCE BETWEEN THE TWO
	JUMPE	P2,KSYS.7		;JUMP IF FIRST KSYS WARNING
	CAIN	S2,1			;NEW KSYS TIME SPECIFIED?
	JRST	KSYS.9			;NO, 1 MIN DIFFERENCE. IGNORE TOADS
					;SETTING A NEW KSYS 1 MIN BEFORE CURRENT
KSYS.7:	MOVEI	S2,KSYTAB		;NEW KSYS. REINIT WARNING TIME TABLE 
	MOVEM	S2,KSYTIM		;  POINTER IN EITHER CASE
	IMULI	S1,^D60			;CONVERT MINS TILL KSYS TO SECONDS
	PUSH	P,S1			;SAVE FOR A LATER
	MOVE	S1,G$NOW##		;GET CURRENT TIME IN UDT FORMAT
	PUSHJ	P,.UD2SC##		;CONVERT UDT TO SECONDS
	ADD	S1,(P)			;COMPUTE FUTURE TIME IN SECONDS
	PUSHJ	P,.SC2UD##		;CONVERT FUTURE TIME TO UDT FORMAT
	MOVEM	S1,G$KUDT##		;SAVE FOR ALL TO SEE
	POP	P,(P)			;RESYNCH STACK
	SETZM	P2			;MAKE SURE REASON IS TYPED
	CAMLE	P1,KSYTAB		;TIME TO KSYS GREATER THAN 1ST WARNING
	$RETT				;YES--RETURN
KSYS.8:	CAML	P1,@KSYTIM		;NO--SET KSYTIM POINTER TO TIME IN
	JRST	KSYS.9			;  KSYTAB THAT IS LESS THAN TIME TILL
	AOS	KSYTIM			;  KSYS.
	JRST	KSYS.8

;Determine whether a warning and reason should be broadcasted

KSYS.9:	CAMG	P1,@KSYTIM		;TIME FOR A WARNING?
	JRST	KSYS10			;YES
	JUMPN	P2,.RETT		;NOT IF IT'S NOT THE FIRST TIME
	TRNA				;IT IS THE FIRST TIME
KSYS10:	AOS	KSYTIM			;YES--POINT TO NEXT WARNING TIME
	PUSHJ	P,TIMMSG		;TYPE THE WARNING TO ALL
	JUMPE	P2,TYPRSN		;GIVE REASON IF FIRST KSYS INTERRUPT
	CAME	P1,KSYTAB		;  OR FIRST WARNING TABLE TIME
	$RETT				;RETURN OTHERWISE

;Here to type reason for KSYS

TYPRSN:	LOAD	S1,HDREVT##+.QHLNK,QH.PTF ;POINT TO THE FIRST ENTRY

TYPR.1:	JUMPE	S1,.RETT		;RETURN IF NO MORE ENTRIES
	GETLIM	S2,.QELIM(S1),TYPE	;GET EVENT CODE
	CAIE	S2,.EVKSY		;KSYS?
	TDZA	S2,S2			;NO
	GETLIM	S2,.QELIM(S1),ACTV	;GET ACTIVE BIT
	JUMPN	S2,TYPR.2		;ONLY VALID IF ACTIVE
	LOAD	S1,.QELNK(S1),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	TYPR.1			;AND LOOP

TYPR.2:	GETLIM	S2,.QELIM(S1),TEXT	;GET TEXT BUFFER ADDRESS
	SKIPN	S2			;REASON MESSAGE?
	$RETT				;NO,,RETURN
	MOVE	S1,[POINT 7,KSYBUF]	;YES,,REINIT BYTE POINTER
	MOVEM	S1,KSYPTR		;STORE IT
	$TEXT	(KSYPUT,<SEN ^W/KSYTTY/ Reason: ^T/(S2)/^M^J^0>) ;COPY REASON
	MOVEI	S1,KSYBUF		;GET ADDRESS OF REASON
	PUSHJ	P,FRCTYP		;SEND IT FOR ALL
	$RETT				;RETURN
; ROUTINE TO STRIP SECONDS OFF KSYS UDT
; CALL:	MOVE	S1, KSYS UDT
;	PUSHJ	P,I$KTIM
;
; ON RETURN, S1 CONTAINS A POSSIBLY UPDATED UDT
I$KTIM::PUSH	P,S1			;SAVE UDT
	HRRZS	S1			;KEEP ONLY THE FRACTION OF THE DAY
	PUSHJ	P,.UD2SC		;CONVERT TO SECONDS
	IDIVI	S1,^D60			;S1 = MINUTES, S2 = SECONDS
	CAIL	S2,^D30			;GREATER THAN 30 SECONDS?
	ADDI	S1,1			;ROUND UP TO THE NEXT MINUTE
	IMULI	S1,^D60			;CONVERT MINUTES BACK TO SECONDS
	PUSHJ	P,.SC2UD		;AND BACK TO UDT FORMAT
	POP	P,S2			;GET UDT BACK
	HLL	S1,S2			;INCLUDE DATE PORTION
	POPJ	P,			;RETURN
	SUBTTL	Support routines for KSYS countdown

;TIMMSG builds the ASCIZ string "Timesharing ends in x days, y hours and
;	z minutes" part of the KSYS warning message.
;	KSYS word should contain correct time in minutes.

TIMMSG:	SKIPG	S1,KSYS			;JUST IN CASE
	$RETT
	$SAVE	<T1,T2,T3>		;SAVE A FEW
	SETZM	T3			;CLEAR T3
	MOVE	T1,S1			;GET TIME
	MOVE	S1,[POINT 7,KSYBUF]	;INIT BYTE POINTER
	MOVEM	S1,KSYPTR		;..
	$TEXT	(KSYPUT,<SEN ^W/KSYTTY/ Timesharing ends in^A>) ;FIRST PART
	IDIVI	T1,<^D60*^D24>		;COMPUTE NUMBER OF DAYS
	JUMPE	T1,TIMM.1		;JUMP IF LESS THAN DAY
	ADDI	T3,1			;INDICATE DAY(S) IN MESSAGE
	MOVEI	S1,[ASCIZ\day\]		;GET PART OF MESSAGE
	$TEXT	(KSYPUT,< ^D/T1/ ^T/(S1)/^A>) ;DUMP IN BUFFER
	CAIE	T1,1			;MORE THAN 1 DAY?
	PUSHJ	P,TIMM.7		;YES,,GO ADD "s"
TIMM.1:	MOVE	T1,T2			;GET NUMBER OF MINUTES REMAINING
	IDIVI	T1,^D60			;COMPUTE NUMBER OF HOURS
	SKIPN	T1			;HOURS VALID?
	JUMPE	T3,TIMM.2		;NO,,ONLY TYPE "0" IF DAYS WERE TYPED
	MOVEI	S1,[ASCIZ\hr\]		;GET SOME TEXT
	$TEXT	(KSYPUT,< ^D/T1/ ^T/(S1)/^A>) ;DUMP HOURS
	CAILE	T1,1			;MORE THAN 1 HOUR?
	PUSHJ	P,TIMM.7		;YES,,GO ADD "s"
TIMM.2:	JUMPE	T2,TIMM.3		;JUMP IF NO MINUTES
	MOVEI	S1,[ASCIZ\min\]	;GET SOME MORE TEXT
	$TEXT	(KSYPUT,< ^D/T2/ ^T/(S1)/^A>) ;DUMP MINUTE(S)
	CAIE	T2,1			;MORE THAN 1 MINUTE?
	PUSHJ	P,TIMM.7		;YES,,GO ADD "s"
TIMM.3:	PUSHJ	P,KSYMSG		;TYPE IT OUT
	POPJ	P,			;RETURN

TIMM.7:	MOVEI	S1,"s"			;GET AN "s"
	PUSHJ	P,KSYPUT		;ADD IT TO BUFFER
	POPJ	P,			;RETURN

;KSYPUT - Put a char in KSYBUF using KSYPTR.
;	S1 = char to deposit

KSYPUT:	IDPB	S1,KSYPTR		;DEPOSIT THE CHARACTER
	POPJ	P,			;RETURN

KSYPTR:	POINT 7,KSYBUF			;INITIAL BYTE POINTER
KSYBUF:	BLOCK	<^D100/5+1>		;SHOULD BE ENOUGH ROOM
KSYTTY:	SIXBIT	/ALL/			;DEFAULT KSYS SEND ALL TTY

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;KSYMSG - This routine appends " at dd-mmm-yy hh:mm" to
;	string in KSYBUF. G$KUDT is assumed to be correct.

KSYMSG:	SKIPN	S1,G$KUDT##		;DON'T USE ZERO
	JRST	KSYM.1			;GO TERMINATE LINE
	PUSHJ	P,I$KTIM		;STRIP OFF SECONDS
	$TEXT	(KSYPUT,< at ^H/S1/^A>) ;DATE/TIME OF KSYS
KSYM.1:	$TEXT	(KSYPUT,<^M^J^0>)	;ADD CRLF
	MOVEI	S1,KSYBUF		;GET ADDRESS OF TEXT TO SEND
	PUSHJ	P,FRCTYP		;GO SEND IT
	POPJ	P,			;RETURN

;FRCTYP - Type string down FRCLIN's throat.
;	S1 = string address (ASCIZ)

FRCTYP:	MOVX	S2,%CNFLN		;GET FRCLIN'S TTY
	GETTAB	S2,			;..
	 PJRST	S..NGF			;SHOULDN'T HAPPEN
	TXO	S2,.UXTRM		;MAKE INTO UDX
	MOVEM	S2,FRCUDX		;STORE UDX
	MOVEM	S1,FRCADR		;STORE ADDRESS
	MOVEI	S2,.TOTYP		;GET FUNCTION
	MOVEM	S2,FRCFCN		;STORE IT
	MOVE	S1,[3,,FRCFCN]		;GET TRMOP ARG
	TRMOP.	S1,			;DO IT
	 PJRST	S..NGF			;SO WE LIE A LITTLE BIT
	$RETT				;RETURN

FRCFCN:	BLOCK	1
FRCUDX:	BLOCK	1
FRCADR:	BLOCK	1
; Routine called by the scheduler
I$SKSY::SKIPGE	G$KSYS##		;TIMESHARING ENABLED?
	$RETT				;NO--DON'T SET TIMER
	GETLIM	S1,.QELIM(AP),ACTV	;GET ACTIVE BIT
	JUMPN	S1,.RETT		;ACTIVE MEANS WE ALREADY SET TIMER
	GETLIM	S1,.QELIM(AP),REPT	;GET REPEAT BITS
	TXNE	S1,QB.NOW		;IS IT RIGHT NOW?
	JRST	SKSY.1			;THEN DO IT RIGHT NOW!
	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	S1,.QECRE(AP)		;GET EXPIRATION TIME
	$CALL	.UD2SC			;CONVERT TO SECONDS
	MOVE	P1,S1			;SAVE
	MOVE	S1,G$NOW##		;GET CURRENT TIME
	$CALL	.UD2SC			;CONVERT TO SECONDS
	SUB	P1,S1			;COMPUTE DIFFERENCE
	SKIPG	S1,P1			;HAS THIS REQUEST EXPIRED?
	JRST	SKSY.1			;YES
	IDIVI	S1,^D60			;CONVERT TO MINUTES
	CAIL	S2,^D30			;OVERFLOW?
	ADDI	S1,1			;ROUND UP
	CAILE	S1,-2			;SEE IF BEYOND 181 DAYS + 23:59
	$RETT				;YES--THIS ONE CAN WAIT
	JRST	SKSY.2			;ENTER COMMON CODE

SKSY.1:	MOVNI	S1,1			;SET KSYS NOW

SKSY.2:	HRLI	S1,.STKSY		;GET SET KSYS FUNCTION
	SKIPN	DEBUGW			;DEBUGGING?
	SETUUO	S1,			;SET KSYS
	  JFCL				;SHOULDN'T FAIL
	CAIE	S1,0			;CLEARING THE TIMER?
	MOVEI	S1,1			;NO--THEN MARK AS ACTIVE
	STOLIM	S1,.QELIM(AP),ACTV	;SET/CLEAR ACTIVE FLAG
	$RETT				;RETURN


; Routine called by the kill code
I$KKSY::GETLIM	S1,.QELIM(AP),ACTV	;GET A BIT
	JUMPE	S1,.RETT		;RETURN IF REQUEST NOT PENDING
	MOVEI	S1,0			;TURN ON TIMESHARING
	SKIPL	G$KSYS##		;TIMESHARING OVER?
	PUSHJ	P,SKSY.2		;ENABLE TIMESHARING
	POPJ	P,			;RETURN
SUBTTL	I$DINT & I$DTCI - Date/Time Change Interrupt Routines

; Initialize for Date/Time change interrupts
I$DINT:	MOVX	T1,.PCDTC		;GET DATE/TIME INTERRUPT FUNCTION CODE
	MOVSI	T2,<DTCBLK-INTBLK>	;GET OFFSET FROM BEGINNING OF VECTOR
	SETZB	T3,G$DTCI##		;DON'T NEED T3,,INIT DTC INTR FLAG
	MOVEI	S1,I$DTCI		;GET ADDRESS OF INTERRUPT ROUTINE
	MOVEM	S1,DTCBLK+.PSVNP	;SAVE ADDRESS
	MOVX	S1,<PS.FON+PS.FAC+T1>	;BUILD ARG AC
	PISYS.	S1,			;DO THE ENABLE
	 SKIPF				;COMPLAIN
	$RETT				;RETURN
	$WTO	(<Couldn't enable for Date/Time Change interrupts via PSI system>,,,$WTFLG(WT.SJI))
	SETOM	DTCBLK+.PSVNP		;INVALIDATE INTERRUPT ROUTINE ADDRESS
	$RETT				;RETURN

SUBTTL	I$DTCI - Date/Time Change Interrupt Routine

I$DTCI:	$BGINT	1,
	AOS	G$DTCI##		;COUNT DATE/TIME CHANGE INTERRUPTS
	SETOM	G$SCHD##		;FORCE A SCHEDULING PASS
	MOVE	S1,G$NOW##		;GET CURRENT TIME
	MOVEM	S1,G$OUDT##		;SAVE PREVIOUS UDT
	MOVE	P1,DTCDIF		;GET DATE/TIME CHANGE DIFFERENCE
	ADDM	P1,G$NOW##		;UPDATE G$NOW

; Change login times in MDR queue.

	MOVE	S1,MDRQUE##		;GET MDR LIST HANDLE
	PUSHJ	P,L%FIRST		;GET THE FIRST MDR ENTRY
	TRNA				;SKIP 1ST TIME THRU
MDTC.1:	PUSHJ	P,L%NEXT		;GET NEXT MDR
	JUMPF	MDTC.2			;CONTINUE ON IF NO MORE
	ADDM	P1,.MRLOG(S2)		;ADJUST LOGIN TIME
	JRST	MDTC.1			;LOOP FOR ALL MDRS

; Change volume set creation time and operator mount notification time.

MDTC.2:	MOVE	S1,VSLQUE##		;GET VSL LIST HANDLE
	PUSHJ	P,L%FIRST		;GET FIRST ENTRY
	TRNA				;SKIP 1ST TIME THRU
MDTC.3:	PUSHJ	P,L%NEXT		;GET NEXT VSL
	JUMPF	MDTC.4			;IF NO MORE , CONTINUE
	ADDM	P1,.VSCRE(S2)		;ADJUST VSL CREATION TIME
	SKIPE	.VSSCH(S2)		;ONLY CHANGE SCHEDULED TIME IS NONZERO
	ADDM	P1,.VSSCH(S2)
	JRST	MDTC.3			;LOOP FOR ALL VSLS

; Change volume mount time and volume (un)lock time

MDTC.4:	MOVE	S1,VOLQUE##		;GET VOL QUEUE LIST HANDLE
	PUSHJ	P,L%FIRST		;GET FIRST ENTRY
	TRNA				;SKIP 1ST TIME THRU
MDTC.5:	PUSHJ	P,L%NEXT		;GET NEXT VOL BLOCK
	JUMPF	MDTC.6			;IF NO MORE, CONTINUE
	SKIPE	.VLMTM(S2)		;ADJUST STRUCTURE MOUNT TIME
	ADDM	P1,.VLMTM(S2)
	JRST	MDTC.5			;CONTINUE FOR ALL VOL BLOCKS

; Here to change the UDTs in the internal event list

MDTC.6:	MOVE	S1,G$EVENT##		;GET EVENT LIST HANDLE
	PUSHJ	P,L%FIRST		;GET FIRST ENTRY
	TRNA				;SKIP 1ST TIME THRU
MDTC.7:	PUSHJ	P,L%NEXT		;GET NEXT LIST ENTRY
	SKIPT
	$DEBRK				;RETURN FROM INTERRUPT IF NO MORE
	ADDM	P1,.EVUDT(S2)		;UPDATE EVENT TIME
	JRST	MDTC.7			;LOOP FOR ALL EVENTS
SUBTTL	I$BATJ - Check for a batch job


; THIS ROUTINE WILL CHECK FOR EITHER A BATCON OR MIC BATCH
; JOB BASED ON THE JOB NUMBER SUPPLIED IN S1

I$BATJ::HRLZS	S1			;PUT IN LH
	HRRI	S1,.GTLIM		;GETTAB ARGUMENT
	GETTAB	S1,			;ASK MONITOR
	  MOVEI	S1,0			;ASSUME NOT
	TXNE	S1,JB.LBT		;BATCH BIT SET (EITHER BATCON OR MIC)?
	$RETT				;YES--A BATCH JOB
	$RETF				;ELSE NOT
SUBTTL	I$AUTO - Initiate processing of SYS:SYSTEM.CMD


; THIS ROUTINE WILL QUEUE AN EVENT TO TAKE THE GALAXY STARTUP COMMAND
; FILE SYS:SYSTEM.CMD

I$AUTO::SKIPE	DEBUGW			;DEBUGGING?
	$RETT				;YES, DON'T CONFUSE THE ISSUE
	MOVEI	S1,.EVATO		;GET AUTO FILE EVENT CODE
	PUSHJ	P,Q$EVTI##		;GO CREATE SKELETON EQ
	MOVX	S1,QB.NOW		;ONLY ONE SHOT
	STOLIM	S1,.EQLIM(M),REPT	;STORE REPEAT FLAGS
	$TEXT	(<-1,,.EQTXT(M)>,<GALAXY start-up command file^0>) ;REASON TEXT
	LOAD	S1,.EQLEN(M),EQ.LOH	;GET OFFSET TO FP/FD AREA
	ADD	S1,M			;POINT AT START OF FP/FD AREA
	MOVE	S2,S1			;GET A COPY
	HRLI	S1,ATOFF		;SET SOURCE FOR BLT
	BLT	S1,ATOFFL-1(S2)		;COPY THE FP/FD INTO THE EQ
	MOVEI	S1,1			;SET COUNT OF FILES
	STORE	S1,.EQSPC(M),EQ.NUM	;...
	MOVX	S1,.QIFNC		;GET INTERNAL FUNCTION BIT
	IORM	S1,.MSTYP(M)		;LITE IT IN MESSAGE
	PUSHJ	P,Q$CREATE##		;CREATE THE AUTO FILE EVENT FOR REAL
	$RETT

;FP/FD areas for GALAXY startup command file

ATOFF:	$BUILD	(FPMSIZ)		;BUILD FP
	 $SET	(.FPLEN,FP.LEN,FPMSIZ)	;LENGTH OF FP
	$EOB

	$BUILD	(FDMSIZ)		;BUILD FD
	 $SET	(.FDLEN,FD.LEN,FDMSIZ)	;LENGTH OF FD
	 $SET	(.FDSTR,,'SYS   ')	;DEVICE
	 $SET	(.FDNAM,,'SYSTEM')	;FILE NAME
	 $SET	(.FDEXT,,'CMD   ')	;EXTENSION
	$EOB
ATOFFL==.-ATOFF				;LENGTH OF COMBINED FP/FD
SUBTTL	I$SCDM - Process Schedule Bits Change Message

I$SCDM::DOSCHD				;[1502] FLAG THAT A SCHEDULING
	$RETT				;[1502] PASS IS NEEDED.

	END