Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - language-sources/qsrt20.mac
There are 36 other files named qsrt20.mac in the archive. Click here to see a list.
	TITLE	QSRT20  --  Operating System Interface for QUASAR-20

;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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,ORNMAC	;PARAMETER FILE

	PROLOGUE(QSRT20)	;GENERATE THE NECESSARY SYMBOLS


	IFE FTJSYS,<
		PASS2			;DON'T BOTHER FOR TOPS-10 ASSEMBLY
		END
		> ;END OF IFE FTJSYS
COMMENT \
	TOPS20 Field Interpretation

1)  External Owner ID is a User Name
2)  Owner ID (Internal) is a User Number

\
SUBTTL	Module Storage

LVL1PC:	BLOCK	1			;PC AT INTERRUPT
FILJFN:	BLOCK	1			;JFN OF MASTER QUEUE FILE
FSPAGN:	BLOCK	1			;SCRATCH PAGE FOR I$READ/I$WRIT
FSADDR:	BLOCK	1			; SAME AS FSPAGN BUT AS AN ADDRESS

UNILST:	BLOCK	1			;LIST NUMBER OF UNIQUE LIST
					; DIRECTORY FOR /UNIQUE CHECK

;LEVTAB AND CHNTAB MUST BE CONTIGUOUS AND IN THE FOLLOWING ORDER.

INTBLK==:<XWD LEVTAB,CHNTAB>		;USED FOR INTIALIZATION

LEVTAB:	EXP	LVL1PC			;POINTER TO OLD PC STORAGE
	0				;2ND AND
	0				;3RD LEVELS ARE UNUSED

CHNTAB:	XWD	INT.PL,C$INT##		;IPCF ON CHANNEL 0
	0,,0				;NOTHING ON CHANNEL 1
	XWD	INT.PL,N$INT##		;NETWORK CHANGE INTRPTS ON CHANNEL 2
	BLOCK	^D33			;FILL IN REST OF TABLE


	INTERN	USR			;THESE 2 ITEXTS ARE USED BY THE QUEUE'S
	INTERN	STRUCT			; LISTING ROUTINES IN QSRDSP
	INTERN	MNTUSR			;SAME AS USR EXCEPT FOR MOUNT DISPLAYS

USR:	ITEXT	(<^T/.QEOWN(AP)/>)	;ASCIZ TOPS-20 OWNER NAME.
MNTUSR:	ITEXT	(<^T/.MRNAM(AP)/>)	;ASCIZ TOPS-20 USER NAME
STRUCT:	ITEXT	(<^T/STRNAM(S1)/>)	;ASCIZ TOPS-20 STRUCTURE NAME

	DEFINE	X(QUE),<
	<SIXBIT/QUE/>!<.OT'QUE> >

RETSEQ:	BLOCK	1			;SEQUENCE COUNTER FOR RET QUEUE

QLIST:	DEVQUE
	NDEVS==.-QLIST
	SUBTTL	Initialization Routine

;ROUTINE TO INITIALIZE THE WORLD.  I$INIT INITIALIZES THE I/O
;	SYSTEM.
;

I$INIT:: CIS				;CLEAR THE INTERRUPT SYSTEM
	PUSHJ	P,.SAVET		;SAVE T REGS
	MOVEI	S1,.MUMPS		;FUNCTION FOR MAX PACKET SIZE
	MOVEM	S1,INIT.B		;STORE AWAY
	ZERO	INIT.B+1		;CLEAR SECOND WORD
	MOVEI	S1,2			;GET BLOCK SIZE
	MOVEI	S2,INIT.B		;AND ADDRESS OF BLOCK
	MUTIL				;GET THE INFO
	  $STOP(CGP,CAN'T GET PACKET SIZE)
	MOVE	S1,INIT.B+1		;GET THE ANSWER
	MOVEM	S1,G$MPS##		;SAVE IT
	SKIPE	DEBUGW			;ARE WE [PRIVATE]QUASAR?
	JRST	INIT.1			;YES, NO NEED TO QUERY <SPOOL>
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,[ASCIZ /PS:<SPOOL>/]	;DIRECTORY OF SPOOL
	RCDIR				;RECOGNIZE IT
	TXNE	S1,RC%NOM		;MATCH?
	$STOP(NSD,NO SPOOLING DIRECTORY)
	MOVE	S1,T1			;COPY DIR NUMBER INTO S1
	MOVEI	S2,TMPBFR		;LOAD ADDR OF BLOCK
	ZERO	T1			;DON'T WANT THE PASSWORD
	GTDIR				;GET DIRECTORY INFO
	  ERCAL	S..NSD			;
	HRRZ	S1,TMPBFR+7		;GET DEFAULT PROTECTION
	MOVEM	S1,G$SPRT##		;AND STORE IT
INIT.1:	ZERO	G$MCOR##		;THERE IS NO SYSTEM MINIMUM
	MOVEI	S1,777777		;512 PAGES
	MOVEM	S1,G$XCOR##		;IS MAXIMUM CORE LIMIT
	SETO	S1,			;-1 = MY JOB
	HRROI	S2,T2			;POINT TO ARG BLOCK
	SETZ	T1,			;WORD 0
	GETJI				;GET MY JOB NUMBER
	  $STOP(CGJ,CANT GET JOB NUMBER)
	$SITEM	T2,QJOB			;AND STORE IT
	PUSHJ	P,I%ION			;ENABLE INTERRUPTS
	PUSHJ	P,L%CLST		;CREATE A LIST
	MOVEM	S1,UNILST		;SAVE LIST NAME
	MOVX	S1,.SFAVR		;GET ACCOUNT VALIDATION CODE
	TMON				;FIND OUT IF ITS SET
	ERJMP	.+2			;NO GOOD,,VALIDATION NOT ON !!!
	SETOM	G$ACTV##		;ELSE WE'RE ACCOUNT VALIDATING..

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

	;FLUSH THE RETREIVAL QUEUES FOR JOBS WHICH WERE WAITING.

	SETOM	G$APID##		;SET ACCOUNTING PID TO -1
	ZERO	P1			; and initialize sequence number
	MOVEI	H,HDRRET##		; Point to RET queue header
	LOAD	E,.QHLNK(H),QH.PTF	; Point to first entry
INIT.2:	JUMPE	E,INIT.4		; Quit if end of queue
	LOAD	P2,.QESEQ(E),QE.SEQ	; Get sequence number
	CAMGE	P1,P2			; Biggest yet?
	 MOVE	P1,P2			; Yes, update max
	LOAD	P3,.QESEQ(E),QE.PRI	; Get priority
	CAIE	P3,.RETRW		; Was this job waiting?
	 JRST INIT.3			; No, skip it
	LOAD	S1,.QESTN(E),QE.DPA
	MOVE	AP,E
	PUSHJ	P,F$RLRQ##		; Release failsoft copy
	MOVE	AP,E			; To be safe
	LOAD	E,.QELNK(E),QE.PTN	; Do this before freeing
	PUSHJ	P,M$RFRE##		; Delink and free the cell

INIT.3:	LOAD	E,.QELNK(E),QE.PTN	; Point to next in Q
	JRST	INIT.2			; Continue

INIT.4:	MOVEM	P1,RETSEQ		; Remember sequence number

	MOVE	S1,G$LNAM##		;GET THE HOST NODE NAME
	STORE	S1,COMSTA##+.OHDRS+ARG.DA+OBJ.ND ;SAVE IT
	MOVEI	S1,.OTXFR		;GET THE FILE TRANSFER OBJ TYPE
	STORE	S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
	MOVEI	M,COMSTA##		;ISSUE THE STARTUP COMMAND
	PUSHJ	P,A$OSTA##		;FOR THE FILE TRANSFER PROCESSOR

	MOVEI	S1,.OTRET		;GET THE RETRIEVAL OBJ TYPE
	STORE	S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
	MOVEI	M,COMSTA##		;ISSUE THE STARTUP COMMAND
	PUSHJ	P,A$OSTA##		;FOR THE RETRIEVAL PROCESSOR

	MOVEI	S1,.OTNOT		;GET THE NOTIFICATION OBJ TYPE
	STORE	S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
	MOVEI	M,COMSTA##		;ISSUE THE STARTUP COMMAND
	PUSHJ	P,A$OSTA##		;FOR THE NOTIFICATION PROCESSOR
	PUSHJ	P,NTIMER		;GO SET THE NOTIFICATION TIMER

	$RETT				;RETURN WHEN DONE


INIT.B:	BLOCK	2		;MUTIL BLOCK
TMPBFR:	BLOCK	^D14		;GTDIR BLOCK
SUBTTL	Information

;ENTRY POINTS

	INTERN	I$SYSV		;READ AND REMEMBER TIME-DEPENDENT SYSTEM VARIABLES
	INTERN	I$WHEEL		;CHECK IF CURRENT SENDER IS SOME FLAVOR OF OPERATOR
	INTERN	I$AGE		;COMPUTE AGE USING INTERNAL FORMAT DATE/TIME
	INTERN	I$AFT		;MODIFY AN INTERNAL TIME BY ADDITION
	INTERN	I$CHAC		;CHECK ACCESS
	INTERN	I$NINT		;TURN ON NETWORK 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 TOPS20 these are:
;
;	Variable			Memeory
;	--------			-------
;
;	Time till KSYS			G$KSYS  = > 0 --- seconds till  KSYS
;						= = 0 --- no KSYS set
;						= < 0 --- timesharing is over
;	Batch logins allowed		G$LOGN	= 0 --- no
;						= -1 --- yes
;	Time of day			G$NOW


I$SYSV:	PUSHJ	P,I%NOW			;GET TIME OF DAY
	MOVEM	S1,G$NOW##		;STORE IT
	MOVE	S1,[SIXBIT/DWNTIM/]	;THE SYSTEM TABLE NAME
	SYSGT				;GET THE TABLE NUMBER AND ENTRY 0
	SKIPN	S2			;SKIP IF THE TABLE EXISTS
	ZERO	S1			;ELSE RETURN A ZERO
	JUMPE	S1,SYSV.2		;EXIT IF NONE PENDING
	PUSH	P,S1			;SAVE TIME FOR NOW
	MOVEI	S1,1			;FIND NOW PLUS 1 MINUTE
	PUSHJ	P,I$AFT			;COMPUTE IT
	POP	P,S2			;NOW GET WHEN SCHEDULED
	SUB	S2,S1			;CALC # OF JIFFIES TILL SHUTDOWN
	IDIVI	S2,3			;CALC # OF SECONDS TILL SHUTDOWN
	SKIPN	S1,S2			;GET # OF SECONDS IN S1
	SETOM	S1			;IF 0,,THEN MAKE IT NEGATIVE
SYSV.2:	MOVEM	S1,G$KSYS##		;AND STORE RESULT

	SETOM	G$LOGN##		;ASSUME LOGINS ALLOWED
	MOVX	S1,.SFPTY		;PTY LOGINS BIT
	TMON				;TEST IT
	SKIPN	S2			;CAN WE?
	SETZM	G$LOGN##		;NOPE!
	$RETT				;AND RETURN
SUBTTL	I$WHEEL  --  Determine whether sender of current message is privileged

;Call to determine whether the send of the current IPCF message has lots of
;	privs.

;Call:	No arguments
;T Ret:	If caller is a wheel (or operator)
;F Ret:	If caller has no special privs

I$WHEEL:
	MOVE	S1,G$PRVS##		;GET PRIVS WORD
	SKIPN	DEBUGW			;IF DEBUGGING, ALWAYS SUCCEED
	TXNE	S1,MD.PWH!MD.POP	;WHEEL OR OPERATOR?
	$RETT				;YES, RETURN TRUE
	$RETF				;NOW RETURN FALSE
SUBTTL	I$AGE  --  Routine to compare two times in internal format

;ROUTINE TO COMPUTE THE AGE IN SECONDS BASED ON THE INTERNAL DATE/TIME FORMAT
;
;CALL:
;	S1 AND S2 ARE THE TIMES TO COMPUTE AGES
;	PUSHJ	P,I$AGE
;	  RETURNS HERE WITH AGE IN SECONDS IN S1
;DESTROYS S1,S2 IN THE PROCESS

I$AGE:	CAMGE	S1,S2		;ORDERING CHECK
	EXCH	S1,S2		;WANT THE LARGEST IN S1
	SUB	S1,S2		;SUBTRACT THEM
	IDIVI	S1,3		;RESOLUTION IS APPROX. 1/3 SEC
	SKIPG	S1		;ANY TIME HERE ???
	MOVEI	S1,1		;NO,,RETURN 1 SECOND
	$RETT			;RETURN
SUBTTL	I$AFT  --  Routine to modify an internal time

;ROUTINE TO RETURN G$NOW + A SPECIFIED INTERVAL.
;
;CALL:
;	S1 CONTAINS INTERVAL IN MINUTES
;	PUSHJ P,I$AFT
;	  RETURN HERE WITH S1=G$NOW+SPECIFIED INTERVAL

I$AFT:	ZERO	S2			;ZERO FOR A SHIFT
	ASHC	S1,-^D17		;GENERATE DOUBLE CONSTANT
					; = ARG*2^18
	DIVI	S1,^D1440		;DIVIDE BY MIN/DAY
	ADD	S1,G$NOW##		;ADD IN NOWTIM
	$RETT				;AND RETURN
SUBTTL	I$CHAC  --  Routine to Check File Access

;ROUTINE TO CHECK FILE AND QUEUE REQUEST ACCESS
;
;CALL:
;	MOVE	S1,[ACCESS CODE,,PROTECTION]
;	MOVE	S2,DIRECTORY OF FILE OR REQUEST
;	PUSHJ	P,I$CHAC
;	  RETURN HERE ALWAYS
;
;CHECK IS MADE AGAINST SENDER OF CURRENT REQUEST
;TRUE RETURN:	ACCESS ALLOWED
;FALSE RETURN:	ACCESS NOT ALLOWED

I$CHAC:	LOAD	S1,G$SID##		;GET SENDER'S ID
	CAME	S1,S2			;IS HE THE OWNER
	PJRST	I$WHEEL			;NO, WIN ONLY IF WHEEL
	$RETT				;YES, LET HIM DO IT
	SUBTTL	I$NINT - ROUTINE TO SETUP FOR NETWORK CHANGE INTERRUPTS

I$NINT:	MOVX	S1,.NDSIC		;GET ADD CHANNEL TO INTRPT SYS FUNCTION
	MOVEI	S2,T1			;GET THE ARGUMENT BLOCK ADDRESS
	MOVEI	T1,2			;WANT INTERRUPTS ON CHANNEL 2
	NODE				;TELL THE SYSTEM WHAT WE WANT
	 ERJMP	.RETT			;ON AN ERROR,,JUST IGNORE IT
	MOVX	S1,.FHSLF		;GET MY PROCESS HANDLE
	MOVX	S2,1B2			;WANT CHANNEL 2
	AIC				;ACTIVATE NETWORK CHANGE INTERRUPTS
	 ERJMP	.+1			;IGNORE ANY ERROR
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface

;ENTRY POINTS

	INTERN	I$IPS			;IPCF SEND
	SUBTTL	I$IPS  --  Send an IPCF Message

;ROUTINE TO SEND AN IPCF MESSAGE.
;CALL:
;	MOVE	S1,PDB SIZE
;	MOVE	S2,ADDRESS OF PDB
;	PUSHJ	P,I$IPS
;
;TRUE RETURN:	IF SEND IS OK
;FALSE RETURN:	IF SEND FAILS, ERROR CODE IN S1

I$IPS:	MSEND				;SEND THE MESSAGE
	  $RETF				;ERROR RETURN
	$RETT				;WIN, RETURN ALL OK
	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,.SAVET		;SAVE T1-T4 FOR USE HERE
	MOVE	T1,[CSM.A,,CSM.A+1]	;SET UP TO ZERO CSM AREA
	ZERO	CSM.A			;ZERO FIRST WORD
	BLT	T1,CSM.A+CSMSIZ-1	;AND ALL THE REST
	LOAD	T1,SPL.JB(M),SP.JOB	;GET THE JOB NUMBER
	STORE	T1,CSM.A+CSM.JB,CS.JOB	;AND SAVE IT IN CSM
	LOAD	T1,SPL.FL(M),SP.DFR	;GET THE DEFER BIT
	STORE	T1,CSM.A+CSM.JB,CS.DFR	;AND SAVE IT@IN SPOOL MESSAGE
	LOAD	T1,SPL.FL(M),SP.LOC	;GET THE STATION NUMBER
	STORE	T1,CSM.A+CSM.JB,CS.LOC	;AND SAVE IT IN CSM
	MOVE	S1,[POINT 7,G$LOCN##]	;POINT TO THE JOBS LOCATION (IN ASCII)
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	STORE	S2,CSM.A+CSM.RO+.ROBND	;SAVE IT AS THE DESTINATION NODE
	LOAD	T1,G$SID##		;GET THE USERS ID
	STORE	T1,CSM.A+CSM.OI		;STORE IT IN CSM
	LOAD	T1,SPL.BV(M),SP.SIZ	;GET THE FILE SIZE IN PAGES
	STORE	T1,CSM.A+CSM.FS		;SAVE IT IN CSM
	MOVE	T1,CSM.F		;GET THE STANDARD FLAGS FOR SPOOLING
	STORE	T1,CSM.A+CSM.FP		;INTO THE CSM
	MOVEI	S1,SPL.FI-1(M)		;GET THE ADDRESS OF THE FD
	SETZM	.FDLEN(S1)		;CLEAR THE COUNT FOR NOW
	MOVEI	T1,.FDSTG(S1)		;POINT T1 TO THE FILESPEC
	STORE	S1,CSM.A+CSM.FD,CS.FDA	;AND SAVE IT AS THE ADDRESS OF THE CSM FD
	HRLI	T1,(POINT 7,0)		;MAKE T1 A BYTE POINTER TO THE FD
	ZERO	T2			;BUT DON'T STORE THIS 
	MOVX	T3,<76,,0>		;TERMINATE ON RIGHT  ANGLE BRACKET
	ZERO	T4			;NO COUNT
	PUSHJ	P,FBREAK		;SKIP TO END OF DIRECTORY
	SKIPN	S1			;IF NOT NULL,,OK.
	PUSHJ	P,CSM.3			;ELSE LEAVE A TRACK AND STOPCODE.
	MOVE	T2,[POINT 6,CSM.A+CSM.RO+.ROBTY] ;STORE NEXT STUFF AS DEVICE
	MOVEI	T4,6			;ONLY 6 CAHRACTERS
	MOVE	T3,["-",,"A"-'A']	;STOP ON -, CONVERT TO SIXBIT
	PUSHJ	P,FBREAK		;PICK UP DEVICE NAME
	SKIPN	S1			;IF NOT NULL,,OK.
	PUSHJ	P,CSM.3			;ELSE LEAVE A TRACK AND STOPCODE.
	ZERO	T2			;DON'T STORE ANYTHING
	ZERO	T4			;NO COUNT
	MOVSI	T3,"-"			;STOP ON MINUS
	PUSHJ	P,FBREAK		;SKIP THE STATION NUMBER
	SKIPN	S1			;IF NOT NULL,,OK.
	PUSHJ	P,CSM.3			;ELSE LEAVE A TRACK AND STOPCODE.

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

	ZERO	T4			;NO COUNT
	ZERO	T2			;NO DESTINATION
	MOVSI	T3,"-"			;STOP ON MINUS
	PUSHJ	P,FBREAK		;AND THE DIRECTORY NUMBER
	SKIPN	S1			;IF NOT NULL,,OK.
	PUSHJ	P,CSM.3			;ELSE LEAVE A TRACK AND STOPCODE.
	MOVE	T2,[POINT 6,CSM.A+CSM.EN] ;SET UP TO STORE THE ENTERED NAME
	MOVEI	T4,6			;ONLY 6 CHARACTERS
	MOVE	T3,[".",,"A"-'A']	;ENDED WITH ., CONVERTED TO SIXBIT
	PUSHJ	P,FBREAK		;PICK UP THE ENTERED NAME
	SKIPN	S1			;IF NOT NULL,,OK
	PUSHJ	P,CSM.3			;ELSE LEAVE A TRACK AND STOPCODE.
	SKIPN	S1,CSM.A+CSM.EN		;GET ENTERED NAME INTO S1
	LOAD	S1,SPL.PG(M)		;IF NO ENTERED NAME,USE PROGRAM NAME
	STORE	S1,CSM.A+CSM.EN		;SAVE AS ENTERED NAME
CSM.1:	ILDB	T2,T1			;PICK UP NEXT CHARACTER
	JUMPN	T2,CSM.1		;LOOP UNTIL A NUL
	TLZ	T1,-1			;CONVERT BYTE POINTER TO ADDRESS
	SUBI	T1,SPL.FI-2(M)		;AND MAKE INTO LENGTH OF FD
	LOAD	T2,CSM.A+CSM.FD,CS.FDA	;GET ADDRESS OF THE FD
	STORE	T1,.FDLEN(T2),FD.LEN	;AND STORE THE LENGTH
	MOVSI	S1,-NDEVS		;CREATE AN AOBJN AC.
	HLLZ	T1,CSM.A+CSM.RO+.ROBTY	;GET THE DEVICE NAME.
	HRRZ	T2,CSM.A+CSM.RO+.ROBTY	;GET THE DEVICE NUMBER
CSM.2:	HLLZ	S2,QLIST(S1)		;FIND THE DEVICE TYPE
	CAME	S2,T1			;  FROM THE SPOOL MSG IN THE LIST OF Q'S
	JRST	[AOBJN S1,CSM.2		;NO MATCH,,TRY THE NEXT ENTRY
		 PUSHJ P,CSM.3	]	;NO THERE,,LEAVE A TRACK AND STOPCODE.
	HRRZ	S2,QLIST(S1)		;PICK UP THE .OT??? SYMBOL (Q TYPE)
	MOVEM	S2,CSM.A+CSM.RO+.ROBTY	;SAVE IT AS THE OBJECT TYPE.
	JUMPE	T2,CSM.2A		;NO DEVICE SPECIFIED,,JUST RETURN
	LSH	T2,-^D12		;RIGHT JUSTIFY THE DEVICE NUMBER
	SUBI	T2,'0'			;MAKE IT BINARY
	TXO	T2,RO.PHY		;TURN ON PHYSICAL BIT
	STORE	T2,CSM.A+CSM.RO+.ROBAT	;SAVE AS DEVICE ATTRIBUTES
CSM.2A:	MOVEI	S1,CSM.A		;PUT ADDRESS OF CSM IN S1 FOR CALLER
	$RETT				;AND RETURN

CSM.3:	$STOP(BSD,Bad SPOOL data)

CSM.A:	BLOCK	CSMSIZ			;PLACE FOR CSM

CSM.F:	INSVL.(.FPFAS,FP.FFF)!INSVL.(1,FP.FSP)!FP.DEL!FP.SPL!INSVL.(1,FP.FCY)
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.FL(S1),LG.BAT	;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$QESM			;Move fields from QE to CSM
	INTERN	I$SMEQ			;Move fields from CSM to EQ
	INTERN	I$RMCH			;Match a request and an RDB
	INTERN	I$DFEQ			;Default and check an EQ
	INTERN	I$LGFD			;BUILD A LOG FILE FD.
	INTERN	I$MUSR			;MOVE A USER ID TO AN RDB.
	INTERN	I$ONOD			;Default the batch ONOD limit word
	INTERN	I$CACV			;'CREATE' ACCT STRING VALIDATION
	INTERN	I$SACV			;'SCHEDULE' ACCT STRING VALIDATION
	INTERN	I$ACTV			;A NO-OP ON THE -20
	INTERN	I$DFMR			;FILL IN SYSTEM DEPENDENT DATA IN MDR
	SUBTTL	I$EQQE  -  Move fields from EQ to QE

;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE EXTERNAL
;	QUEUE REQUEST (EQ) TO THE INTERNAL QUEUE ENTRY (QE).
;
;CALL:
;	MOVE  S1,<ADDRESS OF EQ>
;	MOVE  AP,<ADDRESS OF QE>
;	PUSHJ P,I$EQQE
;	  ALWAYS RETURN HERE

I$EQQE:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE THE EQ ADDRESS
	MOVSI	S2,.EQOWN(P1)		;SETUP TO BLT THE OWNER'S NAME
	HRRI	S2,.QEOWN(AP)		;FORM EQ TO QE
	BLT	S2,.QEOWN+7(AP)		;ZAP!!
	MOVSI	S2,.EQCON(P1)		;POINT TO CONNCECTED DIRECTORY
	HRRI	S2,.QECON(AP)		;PLACE TO BLT TO
	BLT	S2,.QECON+11(AP)	;AND BLT IT
	$RETT				;RETURN
	SUBTTL	I$QESM - Move fields from the QE to CSM

I$QESM:	$RETT				;THIS IS A NO-OP ON THE -20
	SUBTTL	I$SMEQ - ROUTINE TO MOVE FIELDS FROM THE CSM TO 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 THE OWNER ID
	STORE	S2,.EQOID(AP)		;SAVE IT IN THE EQ
	HRROI	S1,.EQOWN(AP)		;POINT TO EQ
	DIRST				;CONVERT TO STRING
	  $STOP(ODE,OWNER DOESNT EXIST)
	$RETT				;AND 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)		;IS THERE A JOB ID NUMBER ???
	JRST	RMCH.0			;NO,,THEN CONTINUE ON.
	CAME	S2,[-1]			;IS IT ALL JOBS ???
	CAMN	S2,.QERID(AP)		;   OR DO WE MATCH ???
	$RETT				;YES,,THEN RETURN OK
	$RETF				;ELSE RETURN NO GOOD !!
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

	MOVEI	P1,.RDBOW(S1)		;GET THE USER NAME ADDRESS
	SKIPE	0(P1)			;IS THERE A USER NAME ???
	JRST	RMCH.2			;YES,,CONTINUE
	SKIPE	G$QOPR##		;NOT THERE,,IS THIS AN OPERATOR REQUEST
	$RETT				;YES,,THEN WE MATCH.
	HRRO	S1,P1			;NO,,CONVERT THE
	MOVE	S2,G$SID##		;SENDERS ID TO HIS
	DIRST				;ASCIZ USER NAME
	ERJMP	.RETF			;IF AN ERROR,,NO MATCH !!
RMCH.2:	MOVE	S2,P1			;GET THE ADDRESS
	HRLI	S2,(POINT 7,0)		;AND MAKE A BYTE POINTER
	MOVX	S1,<POINT 7,.QEOWN(AP)>	;POINT TO REQUEST OID
	PJRST	STGWLD			;MATCH AND PROPAGATE TRUE OR FALSE
	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:	PUSHJ	P,.SAVET		;SAVE T REGS
	MOVE	T2,S1			;COPY EQ ADR INTO T2
	SETZB	T3,T4			;CLEAR SOME FLAGS
	MOVE	S1,[POINT 7,G$LOCN##]	;GET THE REQUESTS LOCATION
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	SKIPN	.EQROB+.ROBND(T2)	;IS THE NODE SPECIFIED ???
	MOVEM	S2,.EQROB+.ROBND(T2)	;NO,,SAVE THIS AS THE DESTINATION NODE

	SKIPE	.EQOWN(T2)		;IS OWNER SET?
	JRST	DFEQ.0			;YES, CONTINUE
	SETOM	T3			;FLAG DEFAULT ON .EQOWN
	HRROI	S1,.EQOWN(T2)		;NO, POINT TO LOCATION
	LOAD	S2,G$SID##		;GET DEFAULT
	STORE	S2,.EQOID(T2)		;SAVE THE USER ID IN THE EQ
	DIRST				;AND GET DEFAULT ONWER STRING
	ERJMP	E$CDU##			;RETURN THROUGH CANT DEFAULT USER ERROR

DFEQ.0:	SKIPE	.EQCON(T2)		;IS CON DIR SET?
	JRST	DFEQ.1			;YES, DONT DEFAULT IT
	SETOM	T4			;FLAG DEFAULTED .EQCON
	HRROI	S1,.EQCON(T2)		;POINT TO BLOCK
	LOAD	S2,G$CDI##		;GET THE DEFAULT
	DIRST				;GET THE CONNECTED DIRECTORY
	ERJMP	E$CDD##			;RETURN THROUGH CANT DEFAULT DIRECTORY

DFEQ.1:	JUMPL	T3,DFEQ.2		;DON'T CHECK IF EQOWN WAS DEFAULT
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,.EQOWN(T2)		;POINT TO THE OWNER BLOCK
	RCUSR				;GET THE NUMBER
	ERJMP	.RETF			;IF IT FAILS,,TRASH THE REQUEST
	TXNE	S1,RC%NOM		;NO MATCH?
	$RETF				;YES, NO MATCH
	STORE	T1,.EQOID(T2)		;SAVE THE USER ID IN THE EQ.
	CAMN	T1,G$SID##		;MATCH, IS IT OK?
	JRST	DFEQ.2			;YES,,CONTINUE ON..
	PUSHJ	P,I$WHEEL		;NO, WIN ONLY IF HE'S A WHEEL
	JUMPF	.RETF			;NOT A WHEEL,,TOUGH BREAKEEE

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

DFEQ.2:	JUMPL	T4,DFEQ.3		;IF CON DIR WAS DEFAULTED,,CHECK JOBNAME
	MOVX	S1,RC%EMO		;EXACT MATCH ONLY
	HRROI	S2,.EQCON(T2)		;NOW CHECK CONNECTED
	RCDIR				;CHECK IT
	ERJMP	E$ICD##			;IF IT FAILS,,TRASH THE REQUEST
	TXNE	S1,RC%NOM		;MATCH?
	PJRST	E$ICD##			;NO, LOSE
	CAMN	T1,G$CDI##		;IS IT OK?
	JRST	DFEQ.3			;YES,,CONTINUE ON..
	PUSHJ	P,I$WHEEL		;NO,,WIN ONLY IF HE IS A WHEEL
	JUMPF	E$ICD##			;NOT A WHEEL,,LETS LEAVE.

DFEQ.3:	LDB	S1,[POINT 7,.EQACT(T2),6] ;GET THE FIRST BYTE OF THE ACCT STRING
	JUMPN	S1,DFEQ.5		;IF THERE IS ONE THERE,,VERIFY IT.
	MOVE	S1,G$ACCT##		;GET THE SENDERS ACCOUNT STR ADDRESS.
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER.
	MOVE	S2,[POINT 7,.EQACT(T2)]	;THIS IS WHERE WE WANT IT TO GO.
DFEQ.4:	ILDB	T1,S1			;COPY THE ACCOUNT STRING
	IDPB	T1,S2			;   TO THE EQ ENTRY.
	JUMPN	T1,DFEQ.4		;END ON A NULL,,ELSE CONTINUE.
	JRST	DFEQ.6			;SKIP OVER THE ACCOUNT VALIDATION

DFEQ.5:	MOVE	S1,T2			;GET THE EQ ADDRESS
	PUSHJ	P,I$CACV		;GO VALIDATE THE ACCOUNT STRING
	JUMPF	E$IAS##			;NO GOOD,,RETURN WITH AN ERROR

DFEQ.6:	SKIPE	.EQJOB(T2)		;IS THERE A JOB NAME ???
	$RETT				;YES,,DONT DEFAULT IT.
	LOAD	T1,.EQLEN(T2),EQ.LOH	;GET THE HEADER LENGTH
	ADD	T1,T2			;POINT TO THE FIRST FP
	LOAD	S1,.FPLEN(T1),FP.LEN	;GET THE FP LENGTH
	ADDI	T1,.FDFIL(S1)		;POINT TO THE FIRST FILE-SPEC
	HRLI	T1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVSI	T3,76			;STOP AT THE '>'
	SETZ	T4,			;DONT STORE ANY DATA
	PUSHJ	P,FBREAK		;STRIP THE FILE-SPEC UP TO THE FILENAME
	SKIPN	S1			;ANYTHING THERE ???
	PJRST	E$IFS##			;MUST BE AN INVALID FILESPEC
	MOVEI	T4,6			;COUNT 6 BYTES
	MOVE	S2,[POINT 6,.EQJOB(T2)]	;GET OUTPUT BYTE POINTER
	SKIPA	T3,[0]			;SKIP THE FIRST TIME THROUGH
DFEQ.7:	SETOM	T3			;INDICATE A ^V WAS READ
DFEQ.8:	ILDB	S1,T1			;GET A FILESPEC BYTE
	CAIN	S1,26			;IS IT ^V ???
	JRST	DFEQ.7			;YES,,IGNORE IT AND SET FLAG
	CAILE	S1," "			;LESS OR EQUAL TO A BLANK ???
	CAILE	S1,"z"			;   OR GREATER THEN "z"
	MOVEI	S1,"?"			;YES,,MAKE IT A "?"

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

	CAIL	S1,"a"			;IF ITS LOWER CASE THEN
	SUBI	S1,40			;   MAKE IT UPPER CASE
	SUBI	S1,40			;CONVERT IT TO SIXBIT
	CAIN	S1,'.'			;END ON A PERIOD (UNLESS ^V)
	JUMPE	T3,.RETT		;NO ^V,,THEN WE ARE DONE
	CAIN	S1,'-'			;ALSO CHECK FOR A '-' AS THE
	CAIE	T4,1			;   LAST CHARACTER IN THE JOB NAME
	SKIPA				;HERE,,HE IS OK...
	$RETT				;HERE,,DONT SAVE THE '-', JUST RETURN
	IDPB	S1,S2			;SAVE IT
	SETZM	T3			;CLEAR ^V FLAG
	SOJG	T4,DFEQ.8		;CONTINUE FOR 6 BYTES
	$RETT				;AND RETURN
	SUBTTL	I$LGFD - ROUTINE TO BUILD A LOG FILE FD.


;I$LGFD IS CALLED BY THE INPUT QUEUE DEFAULT FILLER TO GENERATE AN FD
;	FOR A LOG FILE ON A JOB WHERE NO LOG FILE IS GIVEN.


;CALL:	S1/ ADDRESS OF THE LOCATION TO START BUILDING THE FD.
;	S2/ THE FP ADDRESS
;	M/  THE EQ ADDRESS

;T RET:	ALWAYS

I$LGFD:	MOVE	S2,.FPINF(S2)		;GET THE FP FLAG WORD FOR THIS FILE
	TXNN	S2,FP.SPL		;IS IT SUPPOSED TO BE 'SPOOLED' ???
	JRST	LGFD.1			;NO,,CREATE A USER LOG FILESPEC
	$TEXT	(<-1,,.FDSTG(S1)>,<^T/SPOOL/^O/.EQITN(M)/.LOG>^0)
	MOVEI	S2,13			;GET THE FD LENGTH.
	STORE	S2,.FDLEN(S1),FD.LEN	;AND SET IT
	$RETT				;RETURN.

	;HERE IF WE HAVE TO DEFAULT THE LOG FILE SPEC FOR THE USER

LGFD.1:	PUSHJ	P,.SAVET		;SAVE THE 'T' AC'S
	MOVE	T4,S1			;SAVE THE FD ADDRESS FOR A MINUTE
	HRROI	S1,.FDSTG(S1)		;POINT TO WHERE WE WANT THE CONNECTED
	MOVE	S2,G$CDI##		;   DIRECTORY PUT
	DIRST				;GEN THE CONNECTED DIRECTORY
	 ERJMP	E$IFS##			;ON AN ERROR,,'INVALID FILE SPEC'
	PUSH	P,S1			;SAVE THE UPDATED BYTE POINTER
	LOAD	S1,.EQLEN(M),EQ.LOH	;GET THE HEADER LENGTH
	ADD	S1,M			;POINT TO THE FIRST FP
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FP LENGTH
	ADD	S1,S2			;POINT TO THE FIRST FD
	HRROI	S2,.FDSTG(S1)		;POINT TO THE ACTUAL FILE-SPEC
	MOVX	S1,GJ%SHT+GJ%OFG	;SHORT + PARSE ONLY JFN
	GTJFN				;GET A JFN
	 JRST	E$IFS##			;ON AN ERROR,,'INVALID FILE SPEC'
	MOVE	S2,S1			;GET THE JFN IN S2
	POP	P,S1			;GET THE DESTINATION POINTER
	MOVX	T1,JS%NAM		;WANT FILE NAME ONLY
	SETZM	T2			;NO ADDITION POINTERS
	JFNS				;GET THE FILENAME
	EXCH	S1,S2			;GET JFN IN S1,,UPDATED PTR IN S2
	RLJFN				;RELEASE THE JFN
	 JFCL				;IGNORE THE ERROR

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

	MOVE	S1,[POINT 7,LOG]	;GET THE .LOG EXTENSION BYTE POINTER
LGFD.2:	ILDB	T1,S1			;GET A BYTE
	IDPB	T1,S2			;SAVE IT
	SKIPE	T1			;END ON THE NULL
	JRST	LGFD.2			;ELSE CONTINUE
	HRRZS	S2			;GET END FILESPEC ADDRESS ONLY
	SUBI	S2,-1(T4)		;GET FD LENGTH
	STORE	S2,.FDLEN(T4),FD.LEN	;SAVE IT
	$RETT				;AND RETURN


LOG:	ASCIZ/.LOG/
SPOOL:	ASCIZ/PS:<SPOOL>BATCH-/
SUBTTL	I$MUSR - MOVE AN RDB OWNER ID TO AN RDB BLOCK.

;ROUTINE TO MOVE AN RDB OWNER ID INTO AN RDB BLOCK FOR A
;	HOLD/RELEASE MESSAGE.

;CALL:	
;	MOVE	S1,OWNER ID ADDRESS.
;	MOVEI	S2,OUTPUT RDB ADDRESS
;	PUSHJ	P,I$MUSR##
;	 ALWAYS RETURN HERE
;
I$MUSR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S2			;SAVE THE OUTPUT RDB ADDRESS
	SKIPN	S1			;CHECK IF THERE IS ONE.
	JRST	MUSR.2			;NONE THERE,,SET TO 0 AND RETURN.
	MOVE	S2,0(S1)		;GET THE 36 BIT USER ID.
	HRROI	S1,.RDBOW(P1)		;THIS IS WHERE WE WANT IT.
	DIRST				;TRANSLATE IT.
	ERJMP	MUSR.1			;ON ERROR,,TOUGH BREAKEEE
	$RETT				;ELSE RETURN OK.
MUSR.1:	SETOM	.RDBOW(P1)		;MAKE IT SO IT NEVER WORKS.
	$RETT				;AND RETURN.
MUSR.2:	SETZM	.RDBOW(P1)		;CLEAR THE FIRST WORD OF THE RDB OWNER
	$RETT				;AND RETURN




	SUBTTL	I$ONOD - ROUTINE TO DEFAULT THE BATCH ONOD LIMIT WORD

	;CALL:	M/ The EQ address
	;
	;RET:	TRUE ALWAYS

I$ONOD:	MOVE	S1,[POINT 7,G$LOCN##]	;GET THE USERS LOCATION
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	STOLIM	S2,.EQLIM(M),ONOD	;DEFAULT THE OUTPUT NODE NAME
	$RETT				;AND RETURN
	SUBTTL	I$CACV - ROUTINE TO VALIDATE THE ACCOUNT STRING FOR 'CREATE'

	;CALL:	S1/EQ ADDRESS
	;
	;RET:	TRUE IF VALID
	;      FALSE IF NOT

I$CACV:	SKIPN	G$ACTV##		;ARE WE VALIDATING AT ALL ???
	$RETT				;NO,,JUST RETURN
	MOVE	S2,S1			;PUT EQ ADDRESS INTO S2
	LOAD	S1,.EQOID(S2)		;GET THE USER NUMBER.
	HRROI	S2,.EQACT(S2)		;POINT TO THE USERS ACCOUNT STRING
	VACCT				;VERIFY THE ACCOUNT STRING FOR THE USER.
	ERJMP	.RETF			;NO GOOD,,RETURN NOW.
	$RETT				;OK,,RETURN SAYING SO.
	SUBTTL	I$SACV - ROUTINE TO VALIDATE ACCT STRINGS FOR 'SCHEDULING'

	;CALL:	S1/ EQ ADDRESS
	;	AP/ QE ADDRESS
	;
	;RET:	TRUE IF ACCT OK
	;       IF ACCT INVALID. IF THE ACCT IS INVALID,
	;	     THE EQ.IAS BIT IS LIT SO THAT THE SPOOLER CAN KILL IT

I$SACV:	PUSHJ	P,I$CACV		;GO VALIDATE THE ACCOUNT STRING
	MOVX	S2,QE.IAS		;GET THE INVALID ACCOUNT STRING BIT
	SKIPT				;IS THE ACCOUNT STRING VALID ??.
	IORM	S2,.QESEQ(AP)		;NO,,LIGHT IAS BIT.
	$RETT				;AND RETURN


	SUBTTL	I$ACTV - A NO-OP ON THE -20

I$ACTV:	$RETT				;JUST RETURN
	SUBTTL	I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT DATA INTO MDR

	;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			;GET THE MDR ADDRESS IN P1
	HRROI	S1,.MRNAM(P1)		;POINT TO THE DESTINATION AREA
	MOVE	S2,.MRUSR(P1)		;GET THE USERS NUMBER
	DIRST				;CONVERT NUMBER TO NAME
	JFCL				;IGNORE THE ERROR
	MOVE	S1,G$ACCT##		;GET THE ACCOUNT STRING ADDRESS
	HRLI	S1,(POINT 7,0)		;CONVERT TO A BYTE POINTER
	MOVEI	S2,.MRACT(P1)		;GET THE DESTINATION ADDRESS
	HRLI	S2,(POINT 7,0)		;CONVERT TO A BYTE POINTER
DFMR.1:	ILDB	P1,S1			;GET A BYTE
	IDPB	P1,S2			;SAVE IT
	JUMPN	P1,DFMR.1		;CONTINUE TILL ASCIZ
	$RETT				;AND RETURN
	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 STREAM NUMBER
	MOVE	S1,UNILST		;GET LIST NAME
	MOVEI	S2,^D12			;AND ENTRY SIZE
	PUSHJ	P,L%CENT		;CREATE AN ENTRY
	POP	P,0(S2)			;PUT STREAM NUMBER IN 1ST WORD
	GETLIM	S1,.QELIM(AP),UNIQ	;GET UNIQUE SETTING
	STORE	S1,1(S2)		;SAVE IT
	HRLI	S1,.QECON(AP)		;GET SOURCE ADDRESS
	HRRI	S1,2(S2)		;AND DESTINATION
	BLT	S1,^D11(S2)		;STORE THE DIRECTORY
	$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 ENTRY
	MOVE	S2,S1			;PUT IT INTO S2.
	MOVE	S1,UNILST		;GET THE 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:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	S1,UNILST		;GET LIST NAME
	PUSHJ	P,L%FIRST		;POSITION TO THE BEGINNING
	JUMPF	.RETT			;EMPTY LIST WINS!!

UQCH.1:	HRLI	S2,-12			;MAKE IT AN AOBJN POINTER ALSO
	ADDI	S2,2			;AND POINT TO FIRST DIRECTORY WORD
	MOVEI	S1,.QECON(AP)		;POINT TO FIRST WORD IN QE

UQCH.2:	MOVE	P1,0(S2)		;GET A WORD
	CAME	P1,0(S1)		;COMPARE
	JRST	UQCH.3			;NO MATCH, NEXT ENTRY
	ADDI	S1,1			;BUMP S1
	AOBJN	S2,UQCH.2		;LOOP
	MOVE	S1,UNILST		;GET LIST NAME
	PUSHJ	P,L%CURRENT		;GET ADDRESS OF CURRENT ENTRY AGAIN
	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.3:	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
	$STOP(USM,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.

I$WRIT:	PUSHJ	P,.SAVET		;SAVE T1-T4
	MOVE	T1,S1			;GET BLOCK NUMBER
	IDIVI	T1,FSSBPS		;DIVIDE BY BLOCKS/SECTION
	CAIN	T2,FSSFIB		;IS IT AN INDEX BLOCK?
	  JRST	WRIT.1			;YES, DO SOMETHING SPECIAL
	DMOVEM	S1,WRIT.A		;STORE INPUT ARGUMENTS
	HRR	T3,FSADDR		;ADDRESS OF SCRATCH PAGE
	HRL	T3,WRIT.A+1		;GET SOURCE,,DEST IN T3
	HLRZ	T4,WRIT.A+1		;GET LENGTH OF DATA
	ADDI	T4,-1(T3)		;ADD IN BASE ADR-1
	BLT	T3,(T4)			;AND BLT THE DATA
	MOVE	S1,FSPAGN		;GET 0,,SOURCE-PAGE
	HRLI	S1,.FHSLF		;<FORK-HANDLE>,,<SOURCE-PAGE>
	MOVE	S2,WRIT.A		;GET 0,,<DEST-PAGE>
	HRL	S2,FILJFN		;GET <JFN>,,<DEST-PAGE>
	MOVX	T1,PM%RD!PM%WT		;READ AND WRITE ACCESS
	PMAP				;AND MAP THE PAGE OUT
	HRL	S1,FILJFN		;GET <JFN>,,0
	HRR	S1,WRIT.A		;GET <JFN>,,<FILE-PAGE>
	MOVEI	S2,1			;AND A REPEAT COUNT
	UFPGS				;UPDATE THE DISK
	  $STOP(CUF,CANT UPDATE FILE)
	MOVE	T1,WRIT.A		;GET FILE PAGE NUMBER
	CAMG	T1,G$NBW##		;HIGHEST PAGE YET
	$RETT				;NO, RE-USING SAME SPACE
	MOVEM	T1,G$NBW##		;YES, SAVE NEW FILE SIZE
	MOVSI	S1,.FBUSW		;FILL IN USER-SPECIFIED-WORD
	HRR	S1,FILJFN		;FOR MASTER FILE
	SETO	S2,			;FILL ENTIRE WORD WITH T1
	CHFDB				;CHANGE THE FILE BLOCK
	$RETT				;AND RETURN

;HERE IF WRITING AN INDEX PAGE

WRIT.1:	HRL	S1,FILJFN		;GET <JFN>,,<PAGE-NUMBER>
	MOVEI	S2,1			;AND A REPEAT COUNT
	UFPGS				;AND UPDATE THE INDEX
	  $STOP(CUI,CANT UPDATE INDEX)
	$RETT				;AND RETURN

WRIT.A:	BLOCK	2			;INPUT ARGUMENTS
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:	PUSHJ	P,.SAVET		;SAVE T1-T4
	MOVE	T1,S1			;GET BLOCK NUMBER
	IDIVI	T1,FSSBPS		;DIVIDE BY BLOCKS/SECTION
	CAIN	T2,FSSFIB		;IS IT AN INDEX BLOCK?
	  JRST	READ.1			;YES, GO MAP IT IN
	DMOVE	T1,S1			;COPY ARGS FROM S TO T
	MOVE	S1,T1			;GET 0,,<SOURCE-PAGE>
	HRL	S1,FILJFN		;GET <JFN>,,<SOURCE-PAGE>
	MOVE	S2,FSPAGN		;GET 0,,<DEST-PAGE>
	HRLI	S2,.FHSLF		;<FORK-HANDLE>,,<DEST-PAGE>
	MOVX	T1,PM%RD		;AND READ ACCESS
	PMAP				;AND MAP IN THE PAGE
	HRL	T1,FSADDR		;GET <SOURCE-ADR>,,0
	HRR	T1,T2			;GET <SOURCE-ADR>,,<DEST-ADR>
	HLRZ	T3,T2			;GET LENGTH OF DATA
	ADDI	T3,-1(T2)		;ADD IN BASE ADR -1
	BLT	T1,(T3)			;AND BLT TO REQUESTORS PAGE
	SETO	S1,			;NOW SETUP TO RELEASE THE
	HRRZ	S2,FSPAGN		; MAPPED SCRATCH PAGE FROM
	HRLI	S2,.FHSLF		; OUR ADDRESS SPACE
	SETZ	T1,			;FLAGS ARE MEANINGLESS
	PMAP				;DO IT!!
	$RETT				;AND RETURN

;HERE TO MAP IN AN INDEX PAGE

READ.1:	HRL	S1,FILJFN		;GET JFN,,SOURCE-PAGE
	TLZ	S2,-1			;GET 0,,<DEST-ADR>
	ADR2PG	S2			;GET 0,,<DEST-PAGE>
	HRLI	S2,.FHSLF		;<FORK-HANDLE>,,<DEST-PAGE>
	MOVX	T1,PM%RWX		;READ/WRITE/EXECUTE
	PMAP				;MAP IT!
	$RETT				;AND RETURN
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		;NUMBER OF WORDS TO WRITE
	PUSHJ	P,.SAVET		;SAVE T REGS
	DMOVE	T3,S1			;SAVE ARGS IN T3 AND T4
	HRRZ	S1,S2			;GET 0,,<SOURCE-ADR>
	ADR2PG	S1			;GET 0,,<SOURCE-PAGE>
	HRLI	S1,.FHSLF		;GET <FHANDLE>,,<SOURCE-PAGE>
	HRRZ	S2,T3			;GET 0,,<DEST-PAGE>
	HRL	S2,FILJFN		;GET <JFN>,,<DEST-PAGE>
	MOVX	T1,PM%WR		;WRITE ACCESS REQUIRED
	PMAP				;MAP THE PAGE OUT
	DMOVE	S1,T3			;RECOVER THE ARGS
	PUSHJ	P,I$READ		;MAP THE PAGE IN
	DMOVE	S1,T3			;RECOVER THE ARGS AGAIN
	PJRST	I$WRIT			;UPDATE THE WORLD AND RETURN
SUBTTL	I$OQUE  --  Open master queue files

;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
;	THE MASTER QUEUE FILE.

I$OQUE:	ZERO	OQUE.A			;FIRST TIME THRU
OQUE.1:	MOVX	S1,<GJ%SHT!GJ%OLD!GJ%NS>	;DO A SHORT GTJFN, OLD FILE ONLY,NO SEARCH
	SKIPE	DEBUGW			;ARE WE DEBUGGING?
	SKIPA	S2,[-1,,[DMQFNM]]	;YES, USE PRIVATE MASTER QUEUE FILE
	HRROI	S2,[MQFNAM]		;POINT TO MASTER QUEUE NAME
	GTJFN				;GO GET IT
	  JRST	OQUE.2			;NOT THERE, CREATE IT
	HRRZM	S1,FILJFN		;SAVE THE JFN
	HRRZS	S1			;AND ZERO THE LEFT HALF OUT
	PUSH	P,T1			;SAVE T1
	MOVX	S2,<1,,.FBUSW>		;READ USER SUPPLIED ARGUMENT
	MOVEI	T1,OQUE.B		;INTO LOCAL STORAGE
	GTFDB				;READ FILE BLOCK INFORMATION
	MOVE	T1,OQUE.B		;WE FILL IN HIGHEST PAGE NUMBER
	MOVEM	T1,G$NBW##		;SAVE THE FILE SIZE
	POP	P,T1			;AND RESTORE T1
	MOVE	S1,FILJFN		;GET THE JFN
	MOVX	S2,<OF%RD+OF%WR+OF%NWT>	;GET OPENF BITS
	OPENF				;OPEN THE FILE
	  PUSHJ	P,OQUE.4		;LOSE!!
	PUSHJ	P,M%ACQP		;GET A PAGE FOR I$READ/I$WRITE
	MOVEM	S1,FSPAGN		;FOR THEIR SCRATCH USE
	PG2ADR	S1			;CONVERT TO ADDRESS ALSO
	MOVEM	S1,FSADDR		;FOR EASIER USE
	$RETT				;AND RETURN

OQUE.2:	SKIPE	OQUE.A			;FIRST TIME THRU?
	PUSHJ	P,OQUE.3		;NO, GIVE A STOPCD
	MOVX	S1,<GJ%NEW!GJ%SHT!GJ%FOU> ;NEW FILE, OUTPUT, SHORT GTJFN
	SKIPE	DEBUGW			;ARE WE DEBUGGING?
	SKIPA	S2,[-1,,[DMQFNM]]	;YES, USE PRIVATE MASTER QUEUE FILE
	HRROI	S2,[MQFNAM]		;POINT TO MASTER QUEUE NAME
	GTJFN				;GET IT
	  PUSHJ	P,OQUE.3		;LOSE?
	MOVX	S2,OF%WR		;WRITE
	HRRZS	S1			;CLEAR LH
	PUSH	P,S1			;AND SAVE JFN
	OPENF				;OPEN THE FILE
	  PUSHJ	P,OQUE.3		;CAN'T?
	POP	P,S1			;RESTORE THE JFN
	CLOSF				;CLOSE THE FILE
	  JFCL				;REALLY SHOULDN'T HAPPEN
	SETOM	OQUE.A			;WE'VE BEEN HERE ONCE ALREADY
	JRST	OQUE.1			;AND TRY AGAIN

OQUE.3:	$STOP(COP,Cannot Open Prime Queue)
OQUE.4:	CAIE	S1,OPNX9		;IS IT ILLEGAL SIMUL ACCESS?
	JRST	OQUE.3			;NO
	$STOP(PQI,Prime Queue is Interlocked)

OQUE.A:	BLOCK	1			;LOCAL STORAGE
OQUE.B:	BLOCK	1			;LOCAL STORAGE
SUBTTL	FBREAK  --  Find a break character

;FBREAK IS USED TO SEPARATE PIECES OUT OF CHARACTER STRINGS.  IT WILL
;ALSO DO A FIXED OFFSET CONVERSION OF THE CHARACTERS
;IT IS CALLED WITH:
;	T1 = BYTE POINTER TO SOURCE STRING
;	T2 = BYTE POINTER TO DESTINATION STRING
;	T3 = CHARACTER TO STOP ON,,CONVERSION OFFSET (SUBTRACTED FROM SOURCE CHARACTER
;	T4 = COUNT OF CHARACTERS TO STORE (OTHERS TO BREAK ARE SKIPPED)
;IT RETURNS:
;	T1 = BYTE POINTER TO FIRST CHARACTER AFTER BREAK IN SOURCE
;	S1 = TERMINATION CHARACTER (EITHER BREAK AS SPECIFIED IN T3 OR NULL
;	S2,T2-T3 UNDEFINED

FBREAK:	HLRZ	S2,T3			;GET CHARACTER TO STOP ON
	HRRES	T3			;AND MAKE T3 CONVERSION OFFSET
FBRE.1:	ILDB	S1,T1			;GET A CHARACTER FROM THE SOURCE
	JUMPE	S1,.RETT		;ALWAYS STOP ON NULL
	CAMN	S1,S2			;IS IT THE BREAK CHARACTER
	POPJ	P,			;YES, RETURN
	SUB	S1,T3			;DO THE CONVERSION
	SOSL	T4			;DECREMENT NUMBER OF CHARACTERS TO STORE
	IDPB	S1,T2			;STORE IT
	JRST	FBRE.1			;AND LOOP BACK FOR MORE
SUBTTL	STGWLD  --  Match a "wild" string

;STGWLD IS CALLED WITH S1 CONTAINING A POINTER TO A "BASE" STRING
;	LIKE A JOBNAME OR FILENAME AND S2 CONTAINING A POINTER TO
;	A STRING WITH POSSIBLE WILDCARD CHARACTERS * AND % IN IT.
;	IT THE BASE STRING MATCHES THE WILD STRING, TRUE IS RETURNED
;	OTHERWISE FALSE.

STGWLD:	PUSHJ	P,.SAVET		;SAVE T REGS

STGW.1:	ZERO	T1			;CLEAR * FLAG
STGW.2:	ILDB	T4,S2			;GET A CHARACTER FROM "WILD"
STGW.3:	CAIL	T4,"A"+40		;CHECK FOR LOWER CASE
	CAILE	T4,"Z"+40		; "
	SKIPA				;ITS NOT LC
	SUBI	T4,40			;IT IS, MAKE IT UPPER CASE
STGW.4:	ILDB	T3,S1			;GET A CHARACTER FROM "BASE"
	CAIL	T3,"A"+40		;CHECK IT FOR LOWER CASE
	CAILE	T3,"Z"+40
	SKIPA				;ITS NOT LOWER
	SUBI	T3,40			;IT IS, MAKE IT UC
	CAME	T3,T4			;MATCH?
	JRST	STGW.5			;NO, THAT WOULD BE TOO SIMPLE
	JUMPE	T3,.RETT		;YES, RETURN IF END OF STRINGS
	JRST	STGW.1			;ELSE JUST LOOP

STGW.5:	CAIN	T4,"*"			;IS "WILD" A *?
	JUMPE	T3,.RETT		;YES, WIN IF END OF STRING
	JUMPN	T1,STGW.4		;IF LAST "WILD" WAS *, KEEP GOING
	JUMPE	T3,.RETF		;IF NOT END-OF-STRING DOES NOT MATCH
	CAIN	T4,"%"			;IS "WILD" A %
	JRST	STGW.7			;YES, MATCH AND GO AROUND AGAIN
	CAIE	T4,"*"			;NO, IS IT A *
	$RETF				;NO, LOSE
STGW.6:	AOSA	T1			;YES, SET * FLAG
STGW.7:	ZERO	T1			;CLEAR * FLAG
STGW.8:	ILDB	T4,S2			;GET NEXT "WILD" CHARACTER
	CAIN	T4,"*"			;IS IT A *?
	JRST	STGW.6			;YES, "**"="*"
	CAIE	T4,"%"			;NO, A %  ?
	JRST	STGW.3			;NO, PLAIN OLD ALPHANUMERIC
	JRST	STGW.8			;YES, "*%" = "*"
	SUBTTL	I$MINI - ROUTINE TO INITIALIZE THE TAPE MOUNT PROCESSOR

	INTERN	I$MINI			;MAKE INITIALIZATION GLOBAL

MNTPDB:	IP%CFV				;MSG PDB - PAGE MODE
	0,,0				;	 - SENDERS PID
	0,,0				;	 - RECEIVERS PID
	1000,,0				;	 - LENGTH,,PAGE #

I$MINI:	MOVE	S1,MDRQUE##		;GET THE MDR QUEUE LIST ID
	PUSHJ	P,L%FIRST		;GET THE FIRST MDR ENTRY
	JUMPF	MINI.0			;NONE THERE,,JUST CONTINUE
MINI.A:	MOVE	AP,S2			;SAVE THE MDR ADDRESS IN AP
	PUSHJ	P,D$DMDR##		;DELETE THE MDR ET AL
	MOVE	S1,MDRQUE##		;GET THE MDR QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT MDR ENTRY
	JUMPT	MINI.A			;CONTINUE THROUGH ALL MDR'S

MINI.0:	LOAD	AP,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST PSB
	MOVEI	H,HDRPSB##		;SETUP THE HEADER
	SKIPA				;SKIP THE FIRST TIME THROUGH

MINI.1:	LOAD	AP,.QELNK(AP),QE.PTN	;GET THE NEXT PSB ADDRESS
MINI.2:	JUMPE	AP,.RETT		;NO MORE,,RETURN
	LOAD	S1,PSBOBJ(AP)		;GET THE FIRST OBJECT TYPE
	CAIE	S1,.OTMNT		;IS IT A MOUNT PSB ???
	JRST	MINI.1			;NO,,TRY THE NEXT ONE
	LOAD	S1,.QELNK(AP),QE.PTN	;GET THE NEXT PSB ADDRESS NOW
	PUSH	P,S1			; SINCE WE ARE DELETING THIS ENTRY
	PUSHJ	P,M$RFRE##		;DE-LINK/DELETE THIS PSB
	POP	P,AP			;RESTORE NEXT PSB ADDRESS
	JRST	MINI.2			;AND CONTINUE
	SUBTTL	I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS

	INTERN	I$MNTR

	;CALL:	AP/ The MDR Entry Address
	;	M/  The Mount Message Address
	;
	;RET:	TRUE RETURN or ERRORS:IMM, MPN, DRN

I$MNTR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	PUSHJ	P,FNDPSB		;GO FIND A MTCON PSB
	JUMPF	E$MPN##			;NOT THERE,,THATS AN ERROR
	MOVE	S1,PSBPID(S1)		;GET THE PROCESSORS PID
	MOVEM	S1,MNTPDB+.IPCFR	;SAVE IT IN THE PDB
	PUSHJ	P,M%ACQP		;GO GET A PAGE WE CAN USE FOR IPCF
	HRRM	S1,MNTPDB+.IPCFP	;SAVE THE PAGE NUMBER IN THE PDB
	PG2ADR	S1			;CONVERT THE PAGE TO AN ADDRESS
	MOVE	P1,S1			;SAVE THE ADDRESS

	LOAD	S1,.MRRID(AP),MR.RID	;GET THE REQUEST ID
	MOVEM	S1,.MMITN(P1)		;SAVE IT IN THE MESSAGE ALSO
	MOVE	S1,.MRUSR(AP)		;GET THE USER NUMBER
	MOVEM	S1,.MMUNO(P1)		;SAVE IT IN THE MESSAGE
	MOVE	S1,G$SND##		;GET THE SENDERS PID
	MOVEM	S1,.MMPID(P1)		;SAVE IT IN THE MESSAGE
	MOVE	S1,G$MCOD##		;GET THE SENDERS ACK CODE
	MOVEM	S1,.MMUCD(P1)		;SAVE IT IN THE MESSAGE
	MOVE	S1,.MRJOB(AP)		;GET THE USERS CAPABILITIES
	MOVEM	S1,.MMCAP(P1)		;SAVE IT IN THE MESSAGE
	MOVE	S1,[POINT 7,.MRACT(AP)] ;GET POINTER TO MDR ACCOUNT STRING
	MOVE	S2,[POINT 7,.MMACT(P1)] ;GET POINTER TO DESTINATION
MNT.0:	ILDB	TF,S1			;COPY ACCOUNT 
	IDPB	TF,S2			;    STRING FROM MDR
	JUMPN	TF,MNT.0		;          TO THE MESSAGE

	LOAD	S1,.MSTYP(M),MS.CNT	;GET THE SENDERS MESSAGE LENGTH
	STORE	S1,.MMUMS(P1)		;SAVE IT IN THE MESSAGE
	ADD	S1,P1			;GET THE END ADDRESS (FOR BLT)
	HRL	S2,M			;GET THE SOURCE ADDRESS
	HRR	S2,P1			;AND THE DESTINATION ADDRESS
	BLT	S2,0(S1)		;COPY IT OVER
	MOVEI	S1,1000			;GET THE PAGE LENGTH
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IT AS THE NEW MESSAGE LENGTH
	PUSH	P,AP			;SAVE AP FOR A MINUTE
	MOVEI	AP,MNTPDB		;POINT TO THE MESSAGE PDB
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF TO MOUNTR
	POP	P,AP			;RESTORE AP
	$RETT				;AND RETURN
	SUBTTL	I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES

	;CALL:	M/RELEASE MESSAGE ADDRESS (SAME AS .QOREL)
	;
	;RET:	FALSE - ERROR MESSAGE (MTS, MTL, SNY)
	;	TRUE  - REQUEST DELETED

	INTERN	I$MTR			;CREATE THE ENTRY POINT

I$MTR:	PUSHJ	P,.SAVE1		;SAVE P1
	LOAD	S1,.MSTYP(M),MS.CNT	;GET THE MESSAGE LENGTH
	CAIGE	S1,REL.SZ		;IS IT LESS THEN RELEASE MSG SIZE ??
	JRST	E$MTS##			;YES,,THATS AN ERROR
	CAIE	S1,REL.SZ		;IS IT GREATER THEN RELSE MSG SIZE ???
	JRST	E$MTL##			;THAT TOO IS AN ERROR
	MOVE	S1,MDRQUE##		;GET THE MOUNT QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST QUEUE ENTRY
	JUMPF	E$SNY##			;NONE THERE,,THATS AN ERROR

MTR.1:	MOVE	AP,S2			;SAVE THE MDR ADDRESS IN AP
	LOAD	S1,.MRRID(AP),MR.RID	;GET THIS REQUESTS ID
	CAMN	S1,REL.IT(M)		;IS THIS THE ONE WE WANT ???
	PJRST	D$DMDR##		;YES,,DELETE IT AND RETURN
	MOVE	S1,MDRQUE##		;GET THE MOUNT QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT QUEUE ENTRY
	JUMPT	MTR.1			;FOUND,,GO CHECK IT
	JRST	E$SNY##			;NO MORE,,THATS AN ERROR
	SUBTTL	OPERATOR TAPE/DISK MOUNT MESSAGES

	;CALL:	M/MESSAGE ADDRESS
	;	T4/MESSAGE LENGTH
	;	P1/MESSAGE TYPE
	;
	;RET:	TRUE ALWAYS

	INTERN	I$OMNT			;MAKE THE ROUTINE GLOBAL

I$OMNT:	PUSHJ	P,FNDPSB		;GET MTCON'S PSB
	JUMPF	OMNT.1			;NOT THERE,,TELL OPERATOR
	MOVE	S1,PSBPID(S1)		;GET MTCONS PID
	MOVEM	S1,MNTPDB+.IPCFR	;SAVE IT IN THE PDB
	PUSHJ	P,M%ACQP		;GO GET A PAGE FOR IPCF
	HRRM	S1,MNTPDB+.IPCFP	;SAVE THE PAGE NUMBER IN THE PDB
	PG2ADR	S1			;CONVERT IT TO AN ADDRESS
	ADD	T4,S1			;CALC BLT END ADDRESS
	HRL	S1,M			;GET THE SOURCE ADDRESS
	BLT	S1,0(T4)		;COPY THE MESSAGE OVER
	MOVEI	AP,MNTPDB		;GET THE PDB ADDRESS
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	$RETT				;AND RETURN

OMNT.1:	$ACK	(Mount Request Processor Not Running,,,.MSCOD(M))
	$RETT				;RETURN
	SUBTTL	TAPE MOUNT CHECKPOINT ROUTINE

	;CALL:	M/ADDRESS OF CHECKPOINT MESSAGE
	;
	;RET:	FALSE - ERROR MESSAGE (SNY, IPE)
	;	TRUE  - REQUEST IS CHECKPOINTED

	INTERN	I$CHKP			;MAKE IT GLOBAL

I$CHKP:	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	PUSHJ	P,I$WHEEL		;MAKE SURE THE GUY HAS PRIVS.
	JUMPF	E$IPE##			;NO,,THE GUY IS A FRAUD
	MOVE	S1,MDRQUE##		;GET THE QUEUE LIST ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	CHKP.2			;SKIP THE FIRST TIME THROUGH

	;Find the MDR in the Request queue

CHKP.1:	MOVE	S1,MDRQUE##		;GET THE MDR QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT MDR ENTRY
CHKP.2:	JUMPF	E$SNY##			;NOT FOUND,,THATS AN ERROR
	LOAD	S1,.MRRID(S2),MR.RID	;GET THIS MDR'S RID IN S1
	CAME	S1,CHE.IT(M)		;HAVE WE FOUND THE MDR WE WANT ???
	JRST	CHKP.1			;NO,,TRY THE NEXT MDR

	MOVE	AP,S2			;SAVE THE MDR ADDRESS
	MOVE	S1,.MRVSL(AP)		;GET THE VSL ADDRESS
	LOAD	P2,.VSCVL(S1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	P2,.VSVOL(S1)		;POINT TO THE CURRENT VOLUME ADDRESS
	MOVE	P2,0(P2)		;GET THE CURRENT VOLUME 
	MOVE	S1,CHE.IN+.MTVOL(M)	;GET THE VOLUME (PERHAPS) IN S1
	CAXE	S1,%VOLBL		;IS THE VOLUME NAME BLANK ???
	CAXN	S1,%VOLSC		;OR IS IT A SCRATCH VOLUME ???
	JRST	[MOVX	S1,VL.SCR	;YES,,GET THE SCRATCH VOLUME BIT
		 IORM	S1,.VLFLG(P2)	;MAKE THE VOLUME A SCRATCH VOLUME
		 JRST	CHK.2A ]	;AND CONTINUE
	MOVEM	S1,.VLNAM(P2)		;SAVE THE NEW VOLUME ID
	ZERO	.VLFLG(P2),VL.SCR	;CLEAR SCRATCH BIT

CHK.2A:	ZERO	.VLOWN(P2),VL.OFF	;MAKE THIS GUY THE CURRENT OWNER
	MOVE	S2,CHE.IN+.MTSTA(M)	;GET THE DEVICE NAME (POSSIBLY)
	CAXE	S2,%STAWT		;IS IT WAITING ???
	CAXN	S2,%STAAB		;OR IS IT 'ABORTED' ???
	JRST	[STORE S2,.VLFLG(P2),VL.STA ;YES,,SAVE THE NEW VOLUME STATUS
		 $RETT    ]		;AND RETURN
	HRROI	S1,TMPBFR		;NO,,POINT TO ASCIZ DEVICE NAME BUFFER
	DEVST				;TRY TO CONVERT TO ASCIZ DEVICE NAME
	$RETT				;STILL NO GOOD,,JUST RETURN
	HRROI	S1,TMPBFR		;POINT TO THE ASCIZ DEVICE NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	P1,S2			;SAVE THE DEVICE NAME IN P1

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

	;Find the UCB in the Device queue. If not there, create a UCB for the device

	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST UCB ENTRY
	JRST	CHKP.4			;JUMP THE FIRST TIME THROUGH
CHKP.3:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB
CHKP.4:	SKIPT				;THERE WAS ONE,,CHECK IT OUT
	PUSHJ	P,CHKP.6		;NO MORE UCB'S,,CREATE ONE
	CAME	P1,.UCBNM(S2)		;HAVE WE FOUND THE UCB IN QUESTION ??
	JRST	CHKP.3			;NO,,TRY THE NEXT ONE
	MOVE	P1,S2			;SAVE THE UCB ADDRESS IN P1
	SKIPE	S1,.UCBVL(P1)		;ANY VOLUME POINTER ???
	SETZM	.VLUCB(S1)		;YES,,CLEAR THE VOL UCB POINTER
	SETZM	.UCBVL(P1)		;AND CLEAR THE UCB VOL POINTER
	MOVEM	P2,.UCBVL(P1)		;LINK THE VOL TO THE UCB
	MOVEM	P1,.VLUCB(P2)		;LINK THE UCB TO THE VOL
	MOVX	S1,%STAMN		;GET 'VOLUME' MOUNTED STATUS CODE
	STORE	S1,.VLFLG(P2),VL.STA	;SAVE THE NEW VOLUME STATUS
	$RETT				;AND RETURN

	;Subroutine to create a UCB entry for the device in the status message

CHKP.6:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	MOVX	S2,UCBLEN		;GET THE LENGTH OF A UCB
	PUSHJ	P,L%CENT		;CREATE A UCB FOR THE DEVICE IN P1
	MOVEM	P1,.UCBNM(S2)		;SAVE THE DEVICE NAME
	MOVX	S1,%TAPE		;WANT 'TAPE' DEVICE TYPE
	STORE	S1,.UCBST(S2),UC.DVT	;SAVE AS THE DEVICE TYPE
	$RETT				;RETURN
	SUBTTL	I$MATR - ROUTINE TO SETUP AND PASS MNT ATTRIBUTE MSGS TO MTCON

	;CALL:	M/ MAT REQUEST ADDRESS
	;
	;RET:	TRUE IF SENT OK
	;      FALSE IF MTCON NOT RUNNING

	INTERN	I$MATR			;MAKE IT GLOBAL

I$MATR:	PUSHJ	P,.SAVE1		;SAVE P1
	PUSHJ	P,FNDPSB		;FIND MTCON'S PSB
	JUMPF	E$MPN##			;NOT THERE,,SEND ERROR MSG
	MOVE	S1,PSBPID(S1)		;GET THE PID
	MOVEM	S1,MNTPDB+.IPCFR	;SAVE IT IN THE PDB
	PUSHJ	P,M%ACQP		;GET A PAGE FOR IPCF
	HRRM	S1,MNTPDB+.IPCFP	;SAVE THE PAGE NUMBER
	PG2ADR	S1			;MAKE IT AN ADDRESS
	MOVE	P1,S1			;SAVE IT IN P1
	HRL	S1,M			;GET THE SOURCE ADDRESS (FOR BLT)
	BLT	S1,.MATQS-1(P1)		;COPY THE MESSAGE OVER
	MOVX	S1,.MATQS		;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IT IN THE MESSAGE
	LOAD	S1,G$PRVS##		;GET PRVS,,JOB NUMBER
	STORE	S1,.MATCP(P1)		;SAVE IT IN THE MESSAGE
	LOAD	S1,G$SND##		;GET THE SENDERS PID
	STORE	S1,.MATPD(P1)		;SAVE IT IN THE MESSAGE
	MOVEI	AP,MNTPDB		;GET THE PDB ADDRESS
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	$RETT				;AND RETURN
	SUBTTL	I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS

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

	INTERN	I$KMNT			;MAKE IT GLOBAL

I$KMNT:	PUSHJ	P,.SAVE3		;SAVE P1, P2, AND P3
	PUSHJ	P,FNDPSB		;IS TAPE PROCESSOR RUNNING ???
	JUMPF	E$MPN##			;NO,,THATS AN ERROR
	MOVE	S1,PSBPID(S1)		;ELSE GET THE PROCESSOR'S PID
	MOVEM	S1,MNTPDB+.IPCFR	;SAVE IT AS THE RECIEVERS PID
	MOVEI	P1,KIL.RQ(M)		;GET THE RDB ADDRESS
	SETZB	P2,P3			;ZERO P2 AND P3
	MOVE	S1,MDRQUE##		;GET THE MOUNT QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JUMPF	E$SNY##			;NONE THERE,,THATS AN ERROR

KMNT.1:	MOVE	AP,S2			;SAVE THE ENTRY ADDRESS
	MOVE	S1,.MRUSR(AP)		;GET THE USER ID
	CAME	S1,G$SID##		;IS IT THE SAME USER ???
	JRST	KMNT.4			;NO,,TRY NEXT ENTRY

KMNT.2:	SKIPN	S1,.RDBRQ(P1)		;DID HE SPECIFY A REQUEST ID ???
	JRST	KMN.2A			;NO,,SKIP THIS
	LOAD	S2,.MRRID(AP),MR.RID	;GET THE REQUEST ID IN S2
	CAIE	S1,0(S2)		;DO THE REQUEST ID'S MATCH ???
	JRST	KMNT.4			;NO,,TRY NEXT ENTRY
	JRST	KMN.2B			;YES,,CHECK JOB NUMBERS

KMN.2A:	MOVE	S1,.MRREQ(AP)		;GET THE REQUEST NAME
	XOR	S1,.RDBJB(P1)		;ZERO IDENTICAL BITS
	AND	S1,.RDBJM(P1)		;AND IT WITH THE MASK
	JUMPN	S1,KMNT.4		;NOT ZERO, WE DONT MATCH, TRY NEXT ENTRY

KMN.2B:	LOAD	S1,G$PRVS##,MD.PJB	;GET THE USERS JOB NUMBER
	LOAD	S2,.MRJOB(AP),MD.PJB	;GET THE REQUESTS JOB NUMBER
	CAME	S1,S2			;FROM THE SAME JOB ???
	JRST	KMNT.4			;NO,,TRY THE NEXT ENTRY
	SKIPE	P2			;HAVE WE SETUP THE IPCF MSG PAGE ???
	JRST	KMNT.3			;YES,,CONTINUE ON

	PUSHJ	P,M%ACQP		;DONT DO THIS UNLESS WE HAVE TO !!
	HRRM	S1,MNTPDB+.IPCFP	;SAVE THE PAGE NUMBER IN THE PDB
	PG2ADR 	S1			;CONVERT IT TO AN ADDRESS
	MOVE	P2,S1			;SAVE IT IN P2
	MOVX	S1,.QOMTA		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(P2),MS.TYP	;SAVE IT
	MOVEI	S1,1000			;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(P2),MS.CNT	;SAVE IT

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

	MOVE	S1,.MSCOD(M)		;GET THE USERS ACK CODE
	MOVEM	S1,.MSCOD(P2)		;SAVE IT IN OUR MSG
	MOVE	S1,.MSFLG(M)		;GET THE USERS FLAG WORD
	MOVEM	S1,.MSFLG(P2)		;SAVE IT IN OUR MSG
	MOVEI	S1,2			;GET THE BLOCK COUNT
	STORE	S1,.OARGC(P2)		;SAVE IT
	MOVEI	P2,.OHDRS(P2)		;POINT TO THE FIRST BLOCK
	MOVX	S1,.MTPID		;GET THE BLOCK TYPE
	STORE	S1,ARG.HD(P2),AR.TYP	;SAVE IT
	MOVEI	S1,2			;GET THE BLOCK LENGTH
	STORE	S1,ARG.HD(P2),AR.LEN	;SAVE IT
	MOVE	S1,G$SND##		;GET THE SENDERS PID
	STORE	S1,ARG.DA(P2)		;SAVE IT
	MOVEI	P2,2(P2)		;POINT TO THE NEXT BLOCK
	MOVX	S1,.MTITN		;GET THE BLOCK TYPE
	STORE	S1,ARG.HD(P2),AR.TYP	;SAVE IT
	PUSH	P,P2			;SAVE THIS BLOCK ADDRESS
	MOVEI	P2,ARG.DA(P2)		;POINT TO THE DATA AREA
KMNT.3:	LOAD	S1,.MRRID(AP),MR.RID	;GET THIS REQUESTS ITN
	STORE	S1,0(P2)		;SAVE IT IN THE MESSAGE
	MOVEI	P2,1(P2)		;GET THE NEXT ITN ADDRESS
	AOS	P3			;BUMP THE ITN COUNT

KMNT.4:	MOVE	S1,MDRQUE##		;GET THE QUEUE LIST ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
	JUMPT	KMNT.1			;FOUND ONE,,CONTINUE

	JUMPE	P2,E$SNY##		;FIND ANYTHING ???,,NO SEND AN ERROR
	POP	P,P2			;RESTORE THE LAST BLOCK ADDRESS
	AOS	P3			;ADD THE HEADER LENGTH
	STORE	P3,ARG.HD(P2),AR.LEN	;SAVE THE BLOCK LENGTH

	MOVEI	AP,MNTPDB		;POINT TO THE PDB
	PUSHJ	P,C$SEND		;SEND THE MESSAGE
	SETZM	G$ACK##			;DONT ACK USERS MSG (LET MTCON DO IT)
	$RETT				;AND RETURN
	SUBTTL	TAPE MOUNT UTILITY ROUTINES


	;FNDPSB - ROUTINE TO FIND THE MOUNT PROCESSOR'S PSB

	;CALL:	PUSHJ P,FNDPSB
	;	 RETURN HERE ALWAYS
	;RET:	S1/ADDRESS OF MOUNT PSB

FNDPSB:	MOVEI	S1,HDRPSB##		;POINT TO THE PSB QUEUE
	LOAD	S1,.QHLNK(S1),QH.PTF	;GET THE FIRST PSB ENTRY
	MOVEI	S2,.OTMNT		;GET THE OBJECT TYPE
FNDP.1:	JUMPE	S1,.RETF		;NO MORE,,RETURN FALSE
	CAMN	S2,PSBOBJ(S1)		;DO WE MATCH ???
	$RETT				;YES,,RETURN TRUE
	LOAD	S1,.QELNK(S1),QE.PTN	;POINT TO THE NEXT ENTRY
	JRST	FNDP.1			;AND GO CHECK IT OUT
	SUBTTL	FILE ARCHIVING SCHEDULING ROUTINES

	INTERN	I$ARCHIVE		;PROCESS A MONITOR ARCHIVE MSG
	INTERN	I$RLNK			;LINK A RETREIVAL REQUEST INTO THE QUEUE
	INTERN	I$RSCH			;SCHEDULE A JOB FOR AN OBJECT
	INTERN	I$RDEF			;FILL IN DEFAULTS FOR A JOB
	INTERN	I$RFJB			;FIND A JOB FOR SCHEDULING
SUBTTL  ARCHIVE -- IPCC Function .IPCSR (41)

; The ARCHIVE message is sent by the operating system whenever a
;	retrieval request is made, and whenever the tape pointers
;	of an archived file are destroyed.
;
;	CALL:	M/ Monitor Archive/Notification Msg Address
;	

I$ARCHIVE:
	PUSHJ	P,M%GPAG		;GET A PAGE FOR THE EQ
	MOVE	P1,S1			;SAVE ITS ADDRESS
	MOVE	S1,[EQHSIZ+FPMSIZ+FDXSIZ,,.QIRET] ;GET LENGTH,,TYPE
	STORE	S1,.MSTYP(P1)		;SAVE IT IN THE MESSAGE
	MOVE	S1,[%%.QSR,,EQHSIZ]	;GET QUASAR VERSION,,HEADER SIZE
	STORE	S1,.EQLEN(P1)		;SAVE IT IN THE MESSAGE
	LOAD	S1,ARC.FN(M),AR.FNC	;GET THE FUNCTION CODE
	LOAD	S1,[.OTRET		;USE AS AN OFFSET TO GET THE
		    .OTNOT](S1)		;CORRECT OBJECT TYPE
	STORE	S1,.EQROB+.ROBTY(P1)	;SAVE IT IN THE MESSAGE
	MOVE	S1,G$LNAM##		;GET THE LOCAL NODE NAME
	MOVEM	S1,.EQROB+.ROBND(P1)	;SAVE IN THE OBJECT BLOCK
	LOAD	S1,ARC.PR(M),AR.PRT	;GET THE PROTECTION BITS
	STORE	S1,.EQSPC(P1),EQ.PRO	;SAVE THEM IN THE MESSAGE
	LOAD	S1,ARC.FN(M),AR.MOD	;GET THE REASON VALUE
	STORE	S1,.EQSEQ(P1),EQ.PRI	;MAKE IT THE REQUESTS PRIORITY
	MOVEI	S1,1			;GET A 1
	STORE	S1,.EQSPC(P1),EQ.NUM	;ONE FILE IN THIS EQ
	HRLI	S1,ARC.T1(M)		;SETUP SOURCE POINTER
	HRRI	S1,.EQLIM+1(P1)		;AND THE DESTINATION POINTER
	BLT	S1,.EQLIM+4(P1)		;COPY OVER THE TAPE 1 INFO
	MOVX	T1,EQHSIZ		;GET THE HEADER SIZE
	ADD	T1,P1			;POINT TO THE FP AREA
	MOVX	S1,FPMSIZ		;GET THE FP LENGTH
	STORE	S1,.FPLEN(T1),FP.LEN	;SAVE IT IN THE FP
	ADD	T1,S1			;POINT TO THE FP
	MOVX	S1,FDXSIZ		;GET THE FD SIZE
	STORE	S1,.FDLEN(T1),FD.LEN	;SAVE IT IN THE FD
	HRLI	S1,ARC.FL(M)		;POINT TO THE FILE-SPEC
	HRRI	S1,.FDFIL(T1)		;AND ITS DESTINATION
	BLT	S1,FDXSIZ-1(T1)		;COPY THE FILE-SPEC OVER TO THE EQ

	PUSH	P,M			;SAVE THE ARCHIVE MSG ADDRESS
	MOVE	M,P1			;RESET M TO POINT TO THE EQ
	PUSHJ	P,Q$CREATE##		;CREATE THE QUEUE ENTRY
	SKIPE	G$ERR##			;ANY ERRORS ???
	 $STOP(CRA,CREATE REJECTED ARCHIVE DATA) ;YES,,SERIOUS ERROR !!!
	POP	P,M			;RESTORE THE ARCHIVE MESSAGE ADDRESS
	LOAD	S1,ARC.FN(M),AR.FNC	;GET THE FINCTION CODE
	CAXN	S1,.RETM		;IS IT A FILE RETRIEVAL REQUEST ???
	$WTO	(< Request From ^T/.EQOWN(P1)/ >,<File: ^T/ARC.FL(M)/>,.EQROB+.ROBTY(P1))
	MOVE	S1,P1			;GET THE EQ ADDRESS
	PJRST	M%RPAG			;RELEASE IT AND RETURN
	SUBTTL	Retrieval Queue Subroutines


; Routine to link a retrieval request into the queue.  Requests are ordered
; by their tape pointers.

I$RLNK:	PUSHJ	P,.SAVET		; Save T1-T4
	MOVE	S1,AP			; S1 points to new entry
	MOVEI	S2,RETL.A		; S2 points to tape info block
	PUSHJ	P,GETAPE		; Get the relevant tape numbers
	LOAD	E,.QHLNK(H),QH.PTF	; Get pointer to first in Q
RETL.1:	JUMPE	E,M$ELNK##		; If end of queue, tack on to end
	MOVE	S1,E			; S1 points to queued entry
	MOVEI	S2,T1			; Tape info to T1 and T2
	PUSHJ	P,GETAPE		; Get tape info
	CAMLE	T1,RETL.A+0		; Compare tape ID's
	 PJRST	M$LINK##		; Link in here
	CAME	T1,RETL.A+0		; Compare ID's again
	 JRST	RETL.2			; Move to next queued entry
	CAMLE	T2,RETL.A+1		; Compare TSN,,TFN
	 PJRST	M$LINK##		; Link in here
RETL.2:	LOAD	E,.QELNK(E),QE.PTN	; Get next entry in Q
	JRST	RETL.1			; And continue

RETL.A:	BLOCK	2			; Tape info

	;Routine to fill in tape information of a new retrieval request.

I$RDEF:	SETZ	S1,
	STOLIM	S1,.EQLIM(M),TDTD	;Clear timestamp
	HRLI	S1,.EQLIM(M)		; Make BLT pointer
	HRRI	S1,.EQCHK(M)		; Copy the tape info
	BLT	S1,.EQCHK+<EQLMSZ-1>(M)	; Into the limit words
	AOS	S1,RETSEQ		; Get new sequence #
	STORE	S1,.EQSEQ(M),EQ.SEQ	; Sequence the request
	LOAD	S1,.EQLEN(M),EQ.LOH	;GET THE MSG HEADER LENGTH
	ADD	S1,M			;POINT TO THE FP
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FP LENGTH
	ADDI	S1,.FDSTG(S2)		;POINT TO THE FILE NAME
	HRL	S1,S1			;MOVE SOURCE TO LEFT HALF
	HRRI	S1,.EQCON(M)		;GET THE DESTINATION ADDRESS
	BLT	S1,.EQCON+11(M)		;PUT THE FILE NAME IN THE CONN DIR AREA
	SETZM	S1			;GET A NULL BYTE
	DPB	S1,[POINT 7,.EQCON+11(M),34] ;MAKE SURE ITS ASCIZ
	$RETT				; (A REAL HACK !!!)  RETURN

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

I$RSCH:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S2			;SAVE THE OBJECT ADDRESS
	MOVEI	S2,OBJPRM+.OBTAP(P1)	; Point to OBJ tape info
	PUSHJ	P,GETAPE		; Copy tape info into OBJ
	MOVE	S1,G$NOW##		;GET THE CURRENT UDT
	EXCH	S1,OBJPRM+.OBSTM(P1)	;SWAP THE CURRENT TIME WITH OBJECT TIME
	CAIE	S1,0			;WAS OBJECT TIME 0
	CAXN	S1,<1B1>		;OR WAS IT 200000,,0
	$RETT				;YES TO EITHER,,JUST RETURN
	MOVEM	S1,OBJPRM+.OBSTM(P1)	;NO,,RESTORE OLD OBJECT TIME
	$RETT				;RETURN AND SEND NEXTJOB MSG

; Routine to find a retrieval request.  If DUMPER is not already
; processing one, the next retrieval to be processed is found by skipping
; through the queue until a request which sorts after the most recently
; processed request.  Starting with that request, the timestamps are
; checked.  If a request is found which was not already processed  (and
; rejected) by the current instance of DUMPER, that is the chosen request.

I$RFJB:	PUSHJ	P,.SAVE1		; Save P1
	SETZM	RETS.A			; Clear flag
	MOVE	P1,S1			; Save OBJ address
	LOAD	S1,HDRRET##+.QHLNK,QH.PTF ; Get first item in the QUEUE
	JUMPE	S1,RETS.5		;NOTHING THERE,,JUST RETURN

RETS.0:	MOVEI	S2,T1			; Point to T1-T2
	PUSHJ	P,GETAPE		; Get tape info
	CAMGE	T1,OBJPRM+.OBTAP(P1)	; Compare tape ID's
	JRST	RETS.1			; Already been tried this pass
	CAME	T1,OBJPRM+.OBTAP(P1)	; Compare again
	JRST	RETS.3			; Start with this one
	CAMGE	T2,OBJPRM+.OBSSN(P1)	; Compare TSN,,TFN
	JRST	RETS.1			; Already tried this pass
	CAME	T2,OBJPRM+.OBSSN(P1)	; Compare again
	JRST	RETS.3			; Start here
RETS.1:	LOAD	S1,.QELNK(S1),QE.PTN	; Get next in Q
	JUMPN	S1,RETS.0		; Continue if anything there
	PUSHJ	P,RETS.9		; Otherwise start new pass

; Now that we have found the place to start looking, start looking.

RETS.3:	GETLIM	T1,.QELIM(S1),TDAT	;Get date/time last tried
	CAMLE	T1,OBJPRM+.OBSTM(P1)	; In the past?
	JRST	RETS.4			; No, keep looking
	$RETT				; Schedule this one

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

RETS.4:	LOAD	S1,.QELNK(S1),QE.PTN	; Get next in Q
	JUMPN	S1,RETS.3		; Continue if anything there
	SKIPE	RETS.A			; Just start a new pass?
	JRST	RETS.5			; Yes, no more to do
	PUSHJ	P,RETS.9		; No, start one
	JRST	RETS.3			; Resume loop

; Here when there are no more suitable requests.

RETS.5:	MOVX	S1,OBSINT		;GET INTERNAL SHUTDOWN BIT
	IORM	S1,OBJSCH(P1)		;LITE IT
	SETZM	OBJPRM+.OBTAP(P1)	;CLEAR THE LAST TAPE ID
	SETZM	OBJPRM+.OBSSN(P1)	;CLEAR THE LAST SAVE SET NUMBER
	MOVX	S1,<1B1>		;CREATE A VERY LARGE TIME STAMP
	MOVEM	S1,OBJPRM+.OBSTM(P1)	;AND SET IT FOR LATER
	$RETF				;AND RETURN

; Subroutine used by RETSCH to begin a new pass through the queue.

RETS.9:	SETZM	OBJPRM+.OBTAP(P1)	; Reset watermark
	SETZM	OBJPRM+.OBSSN(P1)	; Ditto
	LOAD	S1,HDRRET##+.QHLNK,QH.PTF ; Point to first in Q
	SETOM	RETS.A			; Flag the new pass
	POPJ	P,

RETS.A:	BLOCK	1			; -1 implies new pass started
	SUBTTL	GETAPE - ROUTINE TO EXTRACT TAPE NBRS FROM A RETREIVAL REQUEST

; The GETAPE routine is used by RETLNK and RETFJB to extract the tape
; numbers by which a retrieval request should be sorted.
; Call	S1 = pointer to retrieval request (QE)
;	S2 = pointer to 2 word block, as follows:
;		0:  Tape ID
;		1:  TSN,,TFN
; Returns +1 always.

GETAPE:	PUSHJ	P,.SAVE2		; Save P1-P3
	GETLIM	P1,.QELIM(S1),TID2	; Assume using 2nd set
	GETLIM	P2,.QELIM(S1),TTN2
	DMOVEM	P1,0(S2)		; Store it wherever
	GETLIM	P1,.QELIM(S1),TUFT	; Get 1st/2nd flag bit
	JUMPE	P1,.RETT		; If not set, assumption correct
	GETLIM	P1,.QELIM(S1),TID1	; Was set, get 1st set
	GETLIM	P2,.QELIM(S1),TTN1
	DMOVEM	P1,0(S2)		; Return those instead
	$RETT				; Done
	SUBTTL	FILE ARCHIVING NOTIFICATION SCHEDULING ROUTINES

	INTERN	I$NLNK			;LINK IN A JOB
	INTERN	I$NDEF			;FILL IN DEFAULTS FOR A JOB
	INTERN	I$NFJB			;FIND A JOB FOR SCHEDULING

; Routine to link entries in the notification queue.  The entries are
; sorted first by the directory number, and second by the reason
; for notification (either the file was expunged or the archive
; pointers were explicitly discarded.)

I$NLNK:	PUSHJ	P,.SAVE3		; Save P1-P3
	LOAD	E,.QHLNK(H),QH.PTF	; Get first in Q
	GETLIM	P1,.QELIM(AP),TDTD	; Get timestamp
	LOAD	P2,.QESEQ(AP),QE.PRI	; Get reason for notification
NOTL.1:	JUMPE	E,M$ELNK##		; If end, link there
	CAMGE	P1,.QELIM(E)		; Compare dir #s
	 PJRST	M$LINK##		; Link in here
	CAME	P1,.QELIM(E)		; Compare again
	 JRST	NOTL.2			; Scan further
	LOAD	P3,.QESEQ(E),QE.PRI	; Get reason of Q'd entry
	CAMG	P2,P3			; Compare
	 PJRST	M$LINK##		; Link in here
NOTL.2:	LOAD	E,.QELNK(E),QE.PTN	; Get next in Q
	JRST	NOTL.1			; And keep comparing
	SUBTTL	I$NDEF - ROUTINE TO FILL IN NOTIFICATION DEFAULTS

; Routine to fill in the tape pointers and directory number associated
; with the file in a NOTIFICATION queue entry.

I$NDEF:	LOAD	S1,.EQLEN(M),EQ.LOH	;GET THE HEADER LENGTH
	ADD	S1,M			;POINT TO THE FP
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FP LENGTH
	ADDI	S2,.FDFIL(S1)		;POINT TO THE FD FILENAME
	HRLI	S2,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVE	S1,[POINT 7,DIRCTY]	;GET THE DESTINATION PTR

NDEF.1:	ILDB	T1,S2			;GET A FILESPEC BYTE
	IDPB	T1,S1			;SAVE IT
	JUMPE	T1,.RETF		;IF 0,,THATS A NO-NO
	CAIE	T1,76			;WAS IT THE END OF THE DIRECTORY ???
	JRST	NDEF.1			;NO,,KEEP ON GOING
	SETZM	T1			;GET A NULL BYTE
	IDPB	T1,S1			;MAKE IT ASCIZ

	MOVX	S1,RC%EMO		;WANT EXACT MATCH ONLY
	HRROI	S2,DIRCTY		;GET THE ASCIZ STRUCTURE ADDRESS
	SETZM	T1			;CLEAR AC 3 
	RCDIR				;GET THE FILE'S DIRECTORY NUMBER
	 ERJMP	.RETF			;NO GOOD,,END IT ALL
	STOLIM	T1,.EQLIM(M),TDTD	;SAVE THE CONNECTED DIR IN THE LIMIT WRD
	$RETT

DIRCTY:	BLOCK	10			;TEMP DIRECTORY STORAGE
REASON==DIRCTY+1			;REASON BLOCK USED IN I$NTFY


I$NFJB:	LOAD	S1,HDRNOT##+.QHLNK,QH.PTF ; Hand 'em first guy in queue
	JUMPE	S1,.RETF		; Return if nothing there
	$RETT
	SUBTTL	I$NTFY - ROUTINE TO PERFORM FILE ARCHIVING NOTIFICATION

	INTERN	I$NTFY			;MAKE IT GLOBAL


I$NTFY:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	SETZM	G$NTFY##		;CLEAR THE NOTIFY FLAG
	MOVEI	H,HDRNOT##		;SET UP THE NOTIFICATION HEADER PTR
	SETZM	DIRCTY			;CLEAR THE DIRECTORY NUMBER
	SETZM	P1			;CLEAR THE OUTPUT PAGE ADDRESS

NTFY.1:	LOAD	AP,.QHLNK(H),QH.PTF	;GET THE FIRST ENTRY
	JUMPE	AP,NTFY.2		;NO MORE,,RETURN
	GETLIM	S1,.QELIM(AP),TDTD	;GET THE USERS DIRECTORY NUMBER
	CAME	S1,DIRCTY		;IF THE SAME,,THEN CONTINUE
	PUSHJ	P,NSETUP		;ELSE GO SETUP A PAGE FOR OUTPUT
	LOAD	S1,.QESEQ(AP),QE.PRI	;GET THE REASON CODE (SAVED IN PRIO FLD)
	CAME	S1,REASON		;IF THE SAME,,THEN CONTINUE
	PUSHJ	P,NHEADR		;ELSE GO SETUP THE HEADER
	PUSHJ	P,NXFILE		;OUTPUT THE FILE DATA
	JRST	NTFY.1			;AND GO GET ANOTHER ENTRY

NTFY.2:	SKIPE	P1			;NOTHING THERE,,JUST RETURN
	PUSHJ	P,NSNDIT		;ELSE SEND THE DATA OFF TO ORION
	PUSHJ	P,NTIMER		;GO RESET THE NOTIFICATION TIMER
	$RETT				;RETURN
	SUBTTL	NSETUP - ROUTINE TO SETUP A PAGE FOR NOTIFICATION

	;CALL:	AP/.QE ADDRESS
	;
	;RET:	P1/OUTPUT PAGE ADDRESS

NSETUP:	PUSH	P,S1			;SAVE S1 FOR A MINUTE
	SKIPE	P1			;DO WE ALREADY HAVE A PAGE SETUP ???
	PUSHJ	P,NSNDIT		;YES,,SEND IT OFF
	POP	P,S1			;RESTORE THE DIRECTORY NUMBER
	MOVEM	S1,DIRCTY		;SAVE IT FOR LATER
	PUSHJ	P,M%ACQP		;GET A PAGE FOR THE DATA
	MOVE	P1,S1			;GET THE PAGE NUMBER IN P1
	PG2ADR	P1			;CONVERT IT TO AN ADDRESS
	MOVEI	S1,.OMNFY		;GET THE NOTIFY MSG TYPE
	STORE	S1,.MSTYP(P1),MS.TYP	;SAVE IT IN THE MESSAGE
	MOVX	S1,NT.MLU		;GET THE 'MAIL TO USER' FLAG BITS
	MOVEM	S1,.OFLAG(P1)		;SAVE IT IN THE FLAG WORD
	MOVEI	S1,3			;GET THE ARGUMENT COUNT
	MOVEM	S1,.OARGC(P1)		;SAVE IT IN THE MESSAGE
	MOVEI	S1,.CMTXT		;GET THE DATA BLOCK TYPE
	STORE	S1,.OHDRS+ARG.HD(P1)	;SAVE IT IN THE MESSAGE
	MOVEI	S1,.OHDRS+ARG.DA(P1)	;POINT TO THE DATA BLOCK
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,BYTPTR		;SAVE IT FOR LATER
	SETZM	P2			;CLEAR THE FLAG AC
	SETOM	REASON			;RESET THE REASON
	$RETT				;AND RETURN
	SUBTTL	NHEADR - ROUTINE TO SETUP THE DATA HEADER LINE

	;CALL:	S1/THE REASON (MUST BE 0 OR 1)
	;
	;RET:	P2/THE ENCODED REASON

NHEADR:	MOVEM	S1,REASON		;SAVE THE REASON
	TRO	P2,1(S1)		;LITE THE APPROPRIATE BITS
	CAIN	S1,0			;IS THE REASON 'EXPUNGED' ???
	$TEXT	(OUTBYT,<The Following Archived File(s) have been Expunged:>)
	CAIN	S1,1			;IS THE REASON 'DISCARDED' ???
	$TEXT	(OUTBYT,<The Archive Status of the Following File(s) has been Discarded:>)
	$RETT				;RETURN


	SUBTTL	NXFILE - ROUTINE TO OUTPUT THE FILE DATA

	;CALL:	AP/.QE ADDRESS
	;
	;RET:	TRUE ALWAYS

NXFILE:	LOAD	S1,.QESTN(AP),QE.DPA	;GET THE EXTERNAL QUEUE DISK ADDRESS
	PUSHJ	P,F$RDRQ##		;READ IT IN
	PUSH	P,S1			;SAVE THE ADDRESS FOR A MINUTE
	LOAD	S2,.EQLEN(S1),EQ.LOH	;GET THE HEADER LENGTH
	ADD	S1,S2			;POINT TO THE FP
	LOAD	S2,.FPLEN(S1),FP.LEN	;GET THE FP LENGTH
	ADDI	S1,.FDFIL(S2)		;POINT TO THE FD FILESPEC
	GETLIM	T1,.QELIM(AP),TTS1	;FILE #1 SAVESET #
	GETLIM	T2,.QELIM(AP),TTF1	;FILE #1 FILE #
	GETLIM	T3,.QELIM(AP),TTS2	;FILE #2 SAVESET #
	GETLIM	T4,.QELIM(AP),TTF2	;FILE #2 FILE #
	LOAD	S2,.QELIM+1(AP)		;GET THE TAPE VOLUME ID
	TLNN	S2,777777		;IS IT DECIMAL ???
	$TEXT	(OUTBYT,<	^T/0(S1)/    Tape 1:^D/.QELIM+1(AP)/,^D/T1/,^D/T2/   Tape 2:^D/.QELIM+3(AP)/,^D/T3/,^D/T4/>)
	TLNE	S2,777777		;IS IT SIXBIT ???
	$TEXT	(OUTBYT,<	^T/0(S1)/    Tape 1:^W/.QELIM+1(AP)/,^D/T1/,^D/T2/   Tape 2:^W/.QELIM+3(AP)/,^D/T3/,^D/T4/>)
	LOAD	S1,.QESTN(AP),QE.DPA	;GET THE DISK ADDRESS AGAIN
	PUSHJ	P,F$RLRQ##		;RELEASE THE REQUEST
	POP	P,S1			;GET THE IN-CORE ADDRESS
	PUSHJ	P,M%RPAG		;RELEASE IT
	PUSHJ	P,M$RFRE##		;RELEASE THE QE ALSO
	$RETT				;AND RETURN

OUTBYT:	IDPB	S1,BYTPTR		;OUTPUT THE BYTE
	$RETT				;AND RETURN

BYTPTR:	BLOCK	1			;BYTE POINTER FOR NOTIFICATION
	SUBTTL	NSNDIT - ROUTINE TO SEND THE NOTIFICATION

	;CALL:	P1/THE DATA PAGE ADDRESS
	;
	;RET:	TRUE ALWAYS

NSNDIT:	$SAVE	AP			;SAVE AP ACROSS THE SUBROUTINE CALL
	HRRZ	S1,BYTPTR		;GET THE END ADDRESS
	SUBI	S1,.OHDRS-1(P1)		;GET THE BLOCK LENGTH
	STORE	S1,.OHDRS+ARG.HD(P1),AR.LEN	;SAVE IT IN THE MESSAGE
	ADDI	S1,.OHDRS(P1)		;POINT TO THE NEXT BLOCK
	MOVE	S2,[2,,.CMDIR]		;SET UP THE DIRECTORY BLK HEADER
	MOVEM	S2,ARG.HD(S1)		;SAVE IT
	MOVE	S2,DIRCTY		;GET THE USERS DIRECTORE NUMBER
	MOVEM	S2,ARG.DA(S1)		;SAVE IT
	ADDI	S1,2			;POINT TO THE NEXT BLOCK
	PUSH	P,S1			;SAVE ITS ADDRESS FOR A MINUTE
	MOVX	S2,.NTSUB		;GET THE SUBJECT BLK TYPE
	STORE	S2,ARG.HD(S1)		;SAVE IT IN THE MESSAGE
	MOVEI	S1,ARG.DA(S1)		;POINT TO THE DATA BLOCK
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,BYTPTR		;SAVE IT
	$TEXT	(OUTBYT,<^T/@REATBL(P2)/>) ;OUTPUT THE SUBJECT STRING
	HRRZ	S1,BYTPTR		;GET THE END ADDRESS
	POP	P,S2			;GET THE START ADDRESS
	SUBI	S1,-1(S2)		;GET THE BLOCK LENGTH
	STORE	S1,ARG.HD(S2),AR.LEN	;SAVE IT IN THE MESSAGE
	HRRZ	S1,BYTPTR		;GET THE END ADDRESS AGAIN
	SUBI	S1,-1(P1)		;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IT
	ADR2PG	P1			;CONVERT THE ADDRESS TO A PAGE NUMBER
	HRRM	P1,MNTPDB+.IPCFP	;SAVE THE PAGE NUMBER
	MOVE	S1,G$OPR##		;GET ORION'S PID
	MOVEM	S1,MNTPDB+.IPCFR	;SAVE AS RECIEVERS PID
	MOVEI	AP,MNTPDB		;GET THE PDB ADDRESS
	PUSHJ	P,C$SEND##		;SEND IT OFF
	$RETT				;AND RETURN

REATBL:	[0,,0]				;NOT USED
	[ASCIZ/Expunged Archive File(s)/]
	[ASCIZ/Discarded Archive Status/]
	[ASCIZ\Expunged File(s)/Discarded Archive Status\]
	SUBTTL	NTIMER - ROUTINE TO SET/RESET THE NOTIFICATION TIMER


NTIMER:	MOVEI	S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;POINT TO THE OBJECT BLOCK
	PUSHJ	P,A$FOBJ##		;GO FIND IT
	JUMPF	.RETF			;NOT THERE,,JUST RETURN
	MOVE	P1,S1			;SAVE THE OBJECT ADDRESS
	MOVX	S1,OBSIGN		;GET THE IGNORE BIT
	IORM	S1,OBJSCH(P1)		;SET IT
	MOVEI	S1,^D240		;GET FOUR HOURS IN MINUTES
	PUSHJ	P,I$AFT			;GET CURRENT TIME+4 HOURS
	STORE	S1,OBJTIM(P1)		;SAVE IT
	$RETT				;AND RETURN
	END