Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/galsrc/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
	SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH	QSRMAC,GLXMAC,ORNMAC,NEBMAC	;PARAMETER FILE

	PROLOGUE(QSRT20)	;GENERATE THE NECESSARY SYMBOLS

	IFE FTJSYS,<
		PASS2			;DON'T BOTHER FOR TOPS-10 ASSEMBLY
		END
		> ;END OF IFE FTJSYS

	T20MAN==:37			;Maintenance edit number
	T20DEV==:35			;Development edit number
	VERSIN (T20)			;Generate edit number

	EXTERNAL MEMEDT,NETEDT,QUEEDT,SCHEDT
	QSRED3==:MEMEDT+NETEDT+QUEEDT+SCHEDT+T20EDT
	Subttl	Table of Contents

;		     Table of Contents for QSRT20
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   4
;    2. Module Storage . . . . . . . . . . . . . . . . . . . .   6
;    3. Initialization Routine . . . . . . . . . . . . . . . .   7
;    4. Information  . . . . . . . . . . . . . . . . . . . . .   9
;    5. I$SYSV - Read time-dependent system variables  . . . .  10
;    6. I$CHAC - Routine to Check File Access  . . . . . . . .  11
;    7. IPCF Interface . . . . . . . . . . . . . . . . . . . .  12
;    8. I$IPS - Send an IPCF Message . . . . . . . . . . . . .  13
;    9. FD Manipulation Routines . . . . . . . . . . . . . . .  14
;   10. I$CSM - Create a Canonical SPOOL Message . . . . . . .  15
;   11. I$CLM - Create a Canonical LOGOUT Message  . . . . . .  17
;   12. Routines to handle system dependent fields . . . . . .  18
;   13. I$EQQE - Move fields from EQ to QE . . . . . . . . . .  19
;   14. I$LPPT - Update Remote LPT QE  . . . . . . . . . . . .  20
;   15. I$QESM - Move fields from the QE to CSM  . . . . . . .  21
;   16. I$SMEQ - ROUTINE TO MOVE FIELDS FROM THE CSM TO EQ . .  22
;   17. I$RMCH - Match a request and an RDB  . . . . . . . . .  23
;   18. I$DFEQ - Default and check the EQ  . . . . . . . . . .  24
;   19. I$LGFD - ROUTINE TO BUILD A LOG FILE FD. . . . . . . .  27
;   20. Spooled CDR file support . . . . . . . . . . . . . . .  29
;   21. I$CACV - ROUTINE TO VALIDATE THE ACCOUNT STRING FOR 'C  32
;   22. I$SACV - ROUTINE TO VALIDATE ACCT STRINGS FOR 'SCHEDUL  33
;   23. I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT DATA INTO  34
;   24. Batch Stream Unique Directory Routines . . . . . . . .  35
;   25. I$UQST - Set Directory for a Stream  . . . . . . . . .  36
;   26. I$UQCL - Clear the directory for a stream  . . . . . .  37
;   27. I$UQCH - Check for directory match . . . . . . . . . .  38
;   28. UNIFST - Find stream's unique entry  . . . . . . . . .  39
;   29. Failsoft System Interface  . . . . . . . . . . . . . .  40
;   30. I$WRIT - Write something into master queue file  . . .  41
;   31. I$READ - Read something from master queue file . . . .  42
;   32. I$CRIP - Create an index page in master file . . . . .  43
;   33. I$OQUE - Open master queue files . . . . . . . . . . .  44
;   34. FBREAK - Find a break character  . . . . . . . . . . .  45
;   35. STGWLD - Match a "wild" string . . . . . . . . . . . .  46
;   36. I$MINI - ROUTINE TO INITIALIZE THE TAPE MOUNT PROCESSO  47
;   37. INITIALIZE RESTARTED MOUNTR  . . . . . . . . . . . . .  48
;   38. I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS  . . .  49
;   39. I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES  . .  50
;   40. OPERATOR TAPE/DISK MOUNT MESSAGES  . . . . . . . . . .  51
;   41. TAPE MOUNT CHECKPOINT ROUTINE  . . . . . . . . . . . .  52
;   42. I$MATR - ROUTINE TO SETUP AND PASS MNT ATTRIBUTE MSGS   54
;   43. I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS .  55
;   44. FILE ARCHIVING ROUTINES  . . . . . . . . . . . . . . .  56
;   45. ARCHIVE - IPCC Function .IPCSR (41)  . . . . . . . . .  57
;   46. Retrieval Queue Subroutines  . . . . . . . . . . . . .  58
;   47. GETAPE - ROUTINE TO EXTRACT TAPE NBRS FROM A RETREIVAL  61
	Subttl	Table of Contents (page 2)

;		     Table of Contents for QSRT20
;
;				  Section		      Page
;
;
;   48. FILE ARCHIVING NOTIFICATION SCHEDULING ROUTINES  . . .  62
;   49. I$NDEF - ROUTINE TO FILL IN NOTIFICATION DEFAULTS  . .  63
;   50. I$NTFY - ROUTINE TO PERFORM FILE ARCHIVING NOTIFICATIO  64
;   51. NSETUP - ROUTINE TO SETUP A PAGE FOR NOTIFICATION  . .  65
;   52. NHEADR - ROUTINE TO SETUP THE DATA HEADER LINE . . . .  66
;   53. NSNDIT - ROUTINE TO SEND THE NOTIFICATION  . . . . . .  67
;   54. NTIMER - ROUTINE TO SET/RESET THE NOTIFICATION TIMER .  68
SUBTTL	Revision history

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

1			7-Jan-83
	Currently no edits

2	4.2.1552	15-Sep-83
	In routine I$SMEQ, ignore errors from DIRST instead of
stopcoding.  Remove ODE stopcd completely.  Return from I$SMEQ without
setting TF since it is not used.  Old QSRMAC edit 1217.

3	4.2.1556	26-Oct-83
	In routine I$RMCH, if both a request ID and a seq. # are specified,
require them both to be correct.  Old QSRMAC edit 1221.

4	4.2.1592	17-Sep-84
	Correct the way I$SYSV calculates the remaining time until system 
shutdown.

5	4.2.1594	20-Sep-84
	Do not crash upon a PMAP% failure, instead sleep for 2 seconds and
retry, up to MAXFAL tries before crashing.

6	4.2.1597	7-Nov-84
	For mount requests, send an ACK to the user before sending the mount
message to MOUNTR. This prevents a race between MOUNTR's ACK and QUASAR's ACK.

7	4.2.1604	29-Jan-85
	Increase the size of DIRCTY to prevent overwriting routine I$NFJB
when archiving/retrieving files with structure/directory names in excess of
40. characters. 

10	4.2.1610	28-Feb-85
	Insure that notification requests have an after time (.EQAFT) later
than G$NOW so the DELETE, ARCHIVE event will be reported to the user.

*****  Release 5.0 -- begin development edits  *****

10	5.1003		7-Jan-83
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

11	5.1137		20-Apr-84
	Subtotal QUASAR edit version number due to restriction in MACRO into
QSRED3.

12	5.1182		29-Nov-84
	Do not trash structure mount requests made after QUASAR startup and
before MOUNTR startup. Also, do not trash structure mount requests made
after MOUNTR crashes and before it is restarted.

13	5.1183		30-Nov-84
	Don't interrupt for network changes anymore (get rid of I$NINT).

14	5.1200		6-Feb-85
	Restrict access to JFNs by turning on bit GJ%ACC on GTJFN calls.

15	5.1209		25-Mar-85	QAR# 838146.
	Added 4.2 patch allowing enable users to use the /ACCOUNT switch.

*****  Release 5 -- begin maintenance edits  *****

20	Increment maintenance edit level for GALAXY 5.

*****  Release 6.0 -- begin development edits  *****

25	6.1042		29-Oct-87
	Add support for remote printer requests.

26	6.1057		4-Nov-87
	Change PS: to BS: and PS:[SPOOL] to SPOOL: for Non PS: login feature.

27	6.1097		22-Nov-87
	Use the $QACK and $QWTO macros instead of the $ACK and $WTO macros
when sending .OMACK and .OMWTO messages.

30	6.1100		22-Nov-87
	If a message send for a mount request fails due to MOUNTR not running,
then check if the mount request originated from a remote node in the cluster.
If it has, then include a remote node display block in the .OMACK message
and turn on bit MF.NEB in the flag word.

31	6.1123		6-Dec-87
	If a create request does not include a node name, then set bit EQ.NND
in the EQ.

32	6.1162		5-Jan-88
	If an IPCF send to MOUNTR fails due to MOUNTR not running and if the
message originated remotely, then check the message type. If the message is not
a dismount message, then send to ORION an .OMACK message; otherwise, send ORION
a FROM NEBULA DISMOUNT ACK message.

33	6.1175		7-Feb-88
	Add a check to routine I$RMCH to ensure that a KILL request from a
remote node only cancels print requests that originated from that node.

34	6.1185		17-Feb-88
	If a CANCEL command is given with an explicit request i.d. and a
request matches that i.d. number, then do not consider a match unless the
/USER, /SEQUENCE , and /JOBNAME also match.

35	6.1225		8-Mar-88
	Update copyright notice.

*****  Release 6.0 -- begin maintenance edits  *****

36	6.1269		18-Oct-88
	In routine RMCH.1, if the request is from an operator then there is no
need to check for the node name.  The check is only needed if the request is
from a user.

37	6.1289		29-Nov-89
	Declare location G$NULA as external. G$NULA is used by the Q$xxx
macros.

\   ;End of Revision History
COMMENT \
	TOPS20 Field Interpretation

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

\

	MAXFAL==^D40      		;For now

	EXTERN	G$REMN			;[27]REMOTE NODE WHERE MSG CAME FROM
	EXTERN	G$NEBF			;[27]REMOTE MESSAGE FLAG
;**;[37]At EXTERN G$NEBF add 1 line  JCR  11/29/89
	EXTERN	G$NULA			;[37]Required by the $Qxxx macros
SUBTTL	Module Storage

SPLCDR:	BLOCK	FDXSIZ			;SCRATCH SPACE FOR SPOOLED CDR FILESPEC
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
FAILP:	BLOCK	1      			;COUNTER FOR PMAP RETRYS
MTRPID:	BLOCK	1			;MOUNTR'S PID

;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
	BLOCK	^D34			;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 /SPOOL:/]	;[26]DIRECTORY OF SPOOL
	RCDIR				;RECOGNIZE IT
	 ERCAL	S..NSD			;NOPE, WE MUST DIE
	MOVEM	T1,G$SPLD##		;SAVE FOR POSTERITY
	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$MDA##			; Turn on tape/disk support
	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
IFN FTFTS,<
	MOVEI	S1,.OTFTS		;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
>  ;End IFN FTFTS
	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

	SETOM	G$NTFY##		;PURGE NOTIFICATION REQUESTS
	MOVNI	TF,MAXFAL		;ARM THE PMAP FAILURE
	MOVEM	TF,FAILP		;FOR MAXFAL FAILURES

	$RETT				;RETURN

	  $STOP	(NSD,<No spooling directory>)

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$CHAC		;CHECK ACCESS
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
;	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:	PUSHJ	P,I%NOW			;GET TIME OF DAY
	MOVEM	S1,G$NOW##		;STORE IT
	MOVE	S1,['DWNTIM']		;GET ^ECEASE SCHEDULING PARAMETER
	SYSGT				;HOW MUCH TIME DO WE HAVE LEFT???
	SKIPN	S2			;DOES THE TABLE ENTRY EXIST???
	SETZM	S1			;NO,,ASSUME NO SCHEDULED SHUTDOWN
	JUMPLE	S1,SYSV.1		;NONE PENDING,,SKIP THIS
	SUB	S1,G$NOW##		;CALCULATE TIME DIFFERENCE
	HRRZ	S2,S1			;Place fraction into S2
	HLRZS	S1			;Move days to the right half
	IMULI	S1,^D86400		;Convert days to seconds
	IMULI	S2,^D86400		;Convert the fraction
	LSH	S2,-^D18		;into seconds
	ADD	S1,S2			;Get the total number of seconds
	CAIGE	S1,^D60			;MORE THEN 1 MINUTE LEFT ???
	SETOM	S1			;NO,,ASSUME TIMESHARING IS OVER
SYSV.1:	JUMPL	S1,SYSV.2		;IF TIMESHARING IS OVER THEN RETURN
	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 TIMER
	SETOM	G$LOGN##		;ASSUME BATCH LOGINS ALLOWED
	MOVX	S1,.SFPTY		;ARGUMENT
	TMON				;READ MONITOR'S FLAG SETTING
	 ERCAL	[$STOP (TJF,TMON JSYS FAILED)]	;TMON FAILED, DIE
	SKIPN	S2			;LOGINS ALLOWED?
	SETZM	G$LOGN##		;NOPE
	SETOM	G$OPRA##		;ASSUME OPERATOR ON DUTY
	MOVX	S1,.SFOPR		;GET FUNCTION CODE
	TMON				;ASK MONITOR FOR OPR IN ATTENDANCE
	 ERCAL	S..TJF			;TMON FAILED, DIE
	SKIPN	S2			;ANYONE AROUND ???
	SETZM	G$OPRA##		;NO
	$RETT				;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	A$WHEEL##		;NO, WIN ONLY IF WHEEL
	$RETT				;YES, LET HIM DO IT
	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$LPPT - Update Remote LPT QE

	INTERN	I$LPTT

;Call is: AP/ QE address
;          M/ CREATE message address

I$LPTT:	LOAD	S1,.EQROB+.ROBTY(M),AR.TYP ;[25]PICK UP OBJECT TYPE
	CAIE	S1,.OTLPT		;[25]IS THIS A LPT OBJECT?
	$RET				;[25]NO, RETURN NOW
	LOAD	S1,.EQSEQ(M),EQ.DLR	;[25]PICK UP REMOTE LPT BIT
	SKIPN	S1			;[25]IS THIS A REMOTE LPT?
	$RET				;[25]NO, RETURN NOW

	SKIPN	.EQRPN(M)		;[25]REMOTE LPT NAME?
	JRST	I$LP.1			;[25]NO, THEN MUST BE A CLUSTER LPT

	MOVEI	S1,.QEONM+ARG.DA(AP)	;[25]PICK UP WHERE TO PLACE LPT NAME
	HRLI	S1,.EQRPN(M)		;[25]PICK UP LPT NAME ADDRESS
	MOVEI	S2,.QEONM+LPTNLN-1(AP)	;[25]END OF DESTINATION ADDRESS
	BLT	S1,(S2)			;[25]COPY REMOTE LPT NAME TO QE

	MOVX	S2,.UNLPT		;[25]ASSUME UNKNOWN REMOTE LPT TYPE
	SKIPN	S1,.EQNAM(M)		;[25]REMOTE LPT TYPE KNOWN?
	JRST	I$LP.2			;[25]NO, INDICATE IN QE
	MOVEM	S1,.QEONM(AP)		;[25]STORE LPT NAME TYPE IN THE QE
	HRRZS	S1			;[25]ISOLATE THE NAME TYPE
	MOVX	S2,.DQLPT		;[25]ASSUME A DQS LPT
	CAIE	S1,.KYDQS		;[25]IS IT?
	MOVX	S2,.LALPT		;[25]NO, IT IS A LAT LPT
	SKIPA				;[25]SKIP CHANGING LPT TYPE
I$LP.1:	MOVX	S2,.CLLPT		;[25]INDICATE A CLUSTER LPT
I$LP.2:	IORM	S2,.QEROB+.ROBTY(AP)	;[25]INDICATE LPT TYPE IN THE QE
	$RET				;[25]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
	  JFCL				;Ignore any directory errors
	$RET				;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 ???
	SKIPA				;[34]CHECK FOR A SEQUENCE NUMBER
	$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
;**;[36]At RMCH.1:+4L replace 1 line with 2 JYCW Oct-18-88
	SKIPE	P1,G$REMN##		;[33][36]PICK UP REQUESTOR'S NODE NAME
	SKIPE	G$QOPR##		;[36]IS THIS AN OPERATOR REQUEST
	JRST	RMCH.2			;[33]NONE, SO MUST BE LOCAL
	CAME	P1,.QENOD(AP)		;[33]SAME REMOTE NODE?
	$RETF				;[33]NO, STOP NOW

RMCH.2:	MOVEI	P1,.RDBOW(S1)		;[33]GET THE USER NAME ADDRESS
	SKIPE	0(P1)			;IS THERE A USER NAME ???
	JRST	RMCH.3			;[33]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.3:	MOVE	S2,P1			;[33]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
	SKIPE	.EQROB+.ROBND(T2)	;[31]IS THE NODE SPECIFIED?
	JRST	DFEQ.A			;[31]YES, CHECK FOR OWNER SET
	MOVE	S1,[POINT 7,G$LOCN##]	;[31]GET THE REQUESTS LOCATION
	PUSHJ	P,S%SIXB		;[31]CONVERT IT TO SIXBIT
	MOVEM	S2,.EQROB+.ROBND(T2)	;[31]NO, SAVE LOCAL NODE NAME
	MOVX	S1,EQ.NND		;[31]PICK DEFAULT NODE NAME BIT
	IORM	S1,.EQSEQ(T2)		;[31]INDICATE IN THE EQ
DFEQ.A:	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,A$WHEEL##		;NO, WIN ONLY IF HE'S A WHEEL
	JUMPF	E$IPE##			;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,A$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,[POINT 7,G$ACTS##]	;GET PTR TO SENDERS ACCOUNT STRING
	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.

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
	PUSH	P,S2			;Save the pointer of the file-spec
	MOVX	S1,GJ%SHT+GJ%OFG	;SHORT + PARSE ONLY JFN
	LOAD	S2,IB##+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as value of JFN access
	POP	P,S2			;Restore the file-spec pointer
	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
	 ERCAL	[$STOP(JJF,JFNS JSYS CANT GET MQF NAME STRING)]	;CAN'T, SO DIE
	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/SPOOL:BATCH-/		;[26]
SUBTTL	Spooled CDR file support


; Get spooled CDR unique filename handle
; Call:	MOVE	S1,EQ address
;	PUSHJ	P,I$GCDR
;
; On return, S1:= handle from .EQSIS
;
I$GCDR::MOVE	S1,.EQSIS(S1)		;PICK UP HANDLE (IF ANY)
	POPJ	P,			;RETURN


; Lite EQ.SPL if queued request has spooled CDR files associated with it
; Call:	MOVE	S1,EQ address
;	PUSHJ	P,I$QCDR
;
I$QCDR::MOVX	S2,EQ.SPL		;GET 'SPOOLED FILES IN THIS REQUEST' BIT
	SKIPE	.EQSIS(S1)		;HAVE SPOOLED CDR FILES?
	IORM	S2,.EQSEQ(S1)		;YES - TURN ON THE BIT
	POPJ	P,			;RETURN
; Delete spooled CDR files (only orange beasts need this).
; Call:	MOVE	S1,directory number
;	MOVE	S2,unique code
;	PUSHJ	P,I$DCDR
;
; This routine deletes files whos names are:
;
;		 DSK:[SPOOL]CDR-xxx.CDyyy.*
;
; where xxx is a user's directory number in octal and yyyy are four unique
; characters conjured up by SPRINT (stored as SIXBIT/CDyyyy/ in .EQSIS).
;
I$DCDR::$TEXT	(<-1,,SPLCDR>,<SPOOL:CDR-^O/S1,RHMASK/.^W/S2/.*^0>);[26]
	MOVX	S1,GJ%OLD!GJ%IFG!GJ%SHT	;LOAD GTJFN BITS
	LOAD	S2,IB##+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as value of JFN access
	HRROI	S2,SPLCDR		;POINT TO FILE-NAME
	GTJFN				;GET A JFN
	  POPJ	P,			;FAILED, RETURN
	MOVE	T1,S1			;SAVE THE JFN
	JRST	DCDR.2			;JUMP INTO THE LOOP

DCDR.1:	GNJFN				;GET THE NEXT FILE
	  JRST	DCDR.3			;DONE - EXPUNGE THE AREA

DCDR.2:	TLZ	S1,-1			;CLEAR LEFT HALF OF JFN WORD
	TXO	S1,DF%NRJ		;DONT RELEASE THE JFN
	DELF				;DELETE THE FILE
	  JFCL				;IGNORE ERRORS
	MOVE	S1,T1			;RELOAD INDEXABLE JFN
	JRST	DCDR.1			;GET THE NEXT ONE

DCDR.3:	MOVEI	S1,0			;NO SPECIAL FLAGS
	MOVE	S2,G$SPLD##		;GET DIRECTORY NUMBER OF PS:[SPOOL]
	DELDF				;EXPUNGE IT
	  ERJMP	.+1			;IGNORE ERROR..
	POPJ	P,			;AND RETURN
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
	PUSHJ	P,A$WHEEL##		;Does user have privileges
	JUMPT	.RETT			;Yes, no need to validate
	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 USE
	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,G$SID##		;GET THE USERS NUMBER
	DIRST				;CONVERT NUMBER TO NAME
	JFCL				;IGNORE THE ERROR
	MOVE	S1,[POINT 7,G$ACTS##]	;GET PTR TO USERS ACCOUNT STRING
	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
	SKIPT				;Did we get an entry successfully?
	PUSHJ	P,S..CCE##		;Stop if not
	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
RETMPO:	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
	 ERJMP	[$CALL	RTPMAP
		JRST	RETMPO]		;CAN'T MAP THE PAGE OUT!
	MOVNI	S1,MAXFAL		;DID IT!
	MOVEM	S1,FAILP		;RESET THE FAILURE COUNTER
	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
	 ERCAL	S..CJF			;CAN'T SO DIE
	$RETT				;AND RETURN

	$STOP (CJF,CHFDB JSYS FAILED)

RTPMAP:	MOVEI	S1,2			;Sleep for 2 seconds
	$CALL	I%SLP
	AOSE	FAILP			;COUNT THE FAILURE
	POPJ	P,	     		;AND TRY AGAIN
	$STOP (PJF,PMAP JSYS ON MQF FAILED)	;RAN OUT OF CHANCES, STOPCODE.

;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
	DMOVEM	S1,READ.A      		;SAVE THE ARGS
	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
RETMPI:	DMOVE	T1,READ.A		;GET ARGS INTO T REGS
	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
	 ERJMP	[$CALL	RTPMAP
		JRST	RETMPI]		;CANT PMAP PAGE IN!
	MOVNI	S1,MAXFAL      		;DID IT!
	MOVEM	S1,FAILP		;RESET THE FAILURE COUNTER
	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
RETSCP:	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!!
	 ERJMP	[$CALL	RTPMAP
		JRST	RETSCP]		;CANT SCRAP PAGE!
	MOVNI	S1,MAXFAL      		;DID IT!
	MOVEM	S1,FAILP		;RESET THE FAILURE COUNTER
	$RETT				;AND RETURN

READ.A:	BLOCK	2			;SPACE FOR ARGS

;HERE TO MAP IN AN INDEX PAGE

READ.1:	DMOVE	S1,READ.A		;GET THE ARGS BACK
	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!
	 ERJMP	[$CALL	RTPMAP
		JRST	READ.1]		;CANT PMAP INDEX PAGE IN!
	MOVNI	S1,MAXFAL      		;DID IT!
	MOVEM	S1,FAILP		;RESET THE FAILURE COUNTER
	$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:	PUSHJ	P,.SAVET		;SAVE T REGS
	DMOVE	T3,S1			;SAVE ARGS IN T3 AND T4
	HRLI	S2,FSSWPI		;NUMBER OF WORDS TO WRITE
RETPOP:	DMOVE	S1,T3			;GET ARGS BACK
	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
	 ERJMP	[$CALL	RTPMAP
		JRST	RETPOP]		;CANT, MUST DIE!
	MOVNI	S1,MAXFAL      		;DID IT!
	MOVEM	S1,FAILP		;RESET THE FAILURE COUNTER
	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
	LOAD	S2,IB##+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as value of JFN access
	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
	 ERCAL	S..GJF			;CAN'T SO DIE
	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

	$STOP (GJF,GTFDB JSYS FAILED)

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
	LOAD	S2,IB##+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as value of JFN access
	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

I$MINI:	PUSHJ	P,.SAVE3		;Save P1 through P3
	MOVE	S1,MDRQUE##		;Get the MDR queue list ID
	PUSHJ	P,L%FIRST		;Get the first MDR
	JUMPF	.RETT			;Error, process and return
	MOVE	S1,G$SND##		;Get MOUNTR's PID
	MOVEM	S1,MTRPID		;Save for later
	JRST	I$MIN2			;Continue processing
I$MIN1:	MOVE	S1,MDRQUE##		;Get the MDR queue list ID
	PUSHJ	P,L%NEXT		;Get the next MDR
	JUMPF	.RETT			;Finished, clean up and return
I$MIN2:	MOVE	AP,S2			;Place the MDR address in AP
	LOAD	P3,.MRCNT(AP),MR.CNT	;Pick up the number of VSLs
	MOVNS	P3			;Make it into a
	MOVSS	P3			;AOJBN counter
	HRR	P3,AP			;Finish with the address
I$MIN3:	MOVE	P2,.MRVSL(P3)		;Pick up the first VSL address
	LOAD	S1,.VSFLG(P2),VS.TYP	;Get the mount type
	CAIE	S1,.MNTST		;Is this a structure mount?
	JRST	[ MOVE  S1,P2		   ;Place VSL address in S1
		  PUSHJ P,D$DVSL##	   ;No, so delete this VSL
		  SUBI	P3,1		   ;Next VSL is where this one was
		  JRST I$MIN5 ]		   ;Go for the next VSL
	PUSHJ	P,NXTPAG		;Get a page for the message
	PUSHJ	P,BLDHDR		;Build the message header
	PUSHJ	P,BLDBLK		;Build the blocks
	PUSHJ	P,BLDEND		;Build the rest of the message
I$MIN4:	MOVE	S1,MTRPID		;Get MOUNTR's PID
	MOVEM	S1,G$SAB##+SAB.PD	;And store it in the SAB
	PUSHJ	P,C$SEND##		;Send the message to MOUNTR
	JUMPF	I$MIN4 			;Failed, try again
I$MIN5:	AOBJN	P3,I$MIN3		;Go for the next VSL
	LOAD	S1,.MRCNT(AP),MR.CNT	;Pick up the number of remaining VSLs
	SKIPN	S1			;Any remaining?
	PUSHJ	P,MDRRID		;No, so delete the MDR	
	JRST	I$MIN1			;Go for the next MDR
BLDHDR: MOVE	S1,[PAGSIZ,,.QOMNT]	;Pick up 1st GALAXY header word
	MOVEM	S1,.MSTYP(P1)		;And store it
	MOVX	S1,MM.WAT		;User is waiting for an ACK
	MOVEM	S1,.MSFLG(P1)		;And store it in GALAXY flag word
	MOVE	S1,.MRACK(AP)		;Get the ACK code
	MOVEM	S1,.MSCOD(P1)		;And store in the header
	LOAD	S1,.MRFLG(AP),MR.FLG	;Pick up the MDR flag word
	MOVEM	S1,.MMFLG(P1)		;And store it in mount flag word
	MOVE	S1,.VSLNM(P2)		;Pick up sixbit mount request name
	MOVEM	S1,.MMNAM(P1)		;And store it in the header
	MOVEI	S1,1			;Pick up the mount entry count
	MOVEM	S1,.MMARC(P1)		;And store it in the header
	$RETT				;Finished with the header

BLDBLK:	ADDI	P1,.MMHSZ		;Point the mountr request header
	MOVE	S1,[7,,.MNTST]		;Pick up length,,type
	MOVEM	S1,.MEHDR(P1)		;And store
	SETZM	.MEFLG(P1)		;No flags are lit
	MOVEI	S1,2			;Get the number of subentries
	MOVEM	S1,.MECNT(P1)		;And store
	ADDI	P1,.MEHSZ		;Point to the first subentry block
	MOVE	S1,[2,,.SMALI]		;Get length,,type
	MOVEM	S1,0(P1)		;And store it
	MOVE	S1,.VSLNM(P2)		;Pick up the alias from the VSL
	MOVEM	S1,1(P1)		;And store it
	MOVE	S1,[2,,.SMNAM]		;Pick up first word of next entry
	MOVEM	S1,2(P1)		;And store it
	HRROI	S1,.VSVSN(P2)		;Pick up ASCIZ struture name
	PUSHJ	P,S%SIXB		;And convert it to sixbit
	MOVEM	S2,3(P1)		;And store it
	$RETT				;Finished with the blocks

BLDEND:	SUBI	P1,.MMHSZ+.MEHSZ	;Point to the last part of the message
	LOAD	S1,.VSRID(P2),VS.RID	;Get the ITN
	MOVEM	S1,.MMITN(P1)		;And store it
	MOVE	S1,.MRPID(AP)		;Get the sender's PID
	MOVEM	S1,.MMPID(P1)		;And store it
	MOVEI	S1,15			;Get the original message size
	MOVEM	S1,.MMUMS(P1)		;And store it
	MOVE	S1,.MRACK(AP)		;Get the ACK code
	MOVEM	S1,.MMUCD(P1)		;And store it
	MOVE	S1,.MRUSR(AP)		;Get the user number
	MOVEM	S1,.MMUNO(P1)		;And store it
	MOVE	S1,.MRJOB(AP)		;Get the user's capabilities
	MOVEM	S1,.MMCAP(P1)		;And store
	MOVE	S1,[POINT 7,.MRACT(AP)]	;Get pointer to the account string
	MOVE	S2,[POINT 7,.MMACT(P1)]	;Get pointer to message account
BLDEN0:	ILDB	TF,S1			;Copy the account string from
	IDPB	TF,S2			;The MDR to the message
	JUMPN	TF,BLDEN0		;Continue until finished
	$RETT				;Finished with the message

NXTPAG:	PUSHJ	P,M%GPAG		;Get a page for the message
	MOVEM	S1,G$SAB##+SAB.MS	;Save the address in the SAB
	MOVEM	S1,P1			;Save for later
	MOVX	S1,PAGSIZ		;Get the size of the message
	MOVEM	S1,G$SAB##+SAB.LN	;And save it in the SAB
	$RETT				;And return

MDRRID:	MOVE	S1,MDRQUE##		;Get the MDR QUEUE ID
	MOVE	S2,AP			;Get the MDR address
	PUSHJ	P,L%APOS		;Position to the MDR entry
	PUSHJ	P,L%DENT		;And delete it
	$RETT				;Return
	SUBTTL	INITIALIZE RESTARTED MOUNTR

	INTERN 	I$MID

I$MID:	PUSHJ	P,.SAVE3		;Save P1 through P3
	MOVE	S1,MDRQUE##		;Get the MDR queue list ID
	PUSHJ	P,L%FIRST		;Get the first MDR
	JUMPF	.RETT			;There are none so return
	JRST	I$MID1			;Check if it's for a tape
I$MID0:	MOVE	S1,MDRQUE##		;Get the MDR queue list ID
	PUSHJ	P,L%NEXT		;Get the next MDR
	JUMPF	.RETT			;None left, so return
I$MID1:	MOVE	AP,S2			;Place the MDR address in AP
	LOAD	P3,.MRCNT(AP),MR.CNT	;Get the number of VSLs
	MOVNS	P3			;Make it into a
	MOVSS	P3			;AOBJN counter
	HRR	P3,AP			;Finish with the address
I$MID2:	MOVE	P2,.MRVSL(P3)		;Pick up the next VSL address
	LOAD	S1,.VSFLG(P2),VS.TYP	;Get the mount type
	CAIE	S1,.MNTST		;Is this a structure mount?
	JRST	[ MOVE	S1,P2		;No, place VSL address in S1
		  PUSHJ P,D$DVSL##	;Delete the VSL
		  SUBI	P3,1		;Next VSL is where this one was
		  JRST	I$MID3 ]	;Go for the next VSL
I$MID3:	AOBJN	P3,I$MID2		;Go for the next VSL
	LOAD	S1,.MRCNT(AP),MR.CNT	;Pick up the number of remaining VSLs
	SKIPN	S1			;Any remaining?
	PUSHJ	P,MDRRID		;No, so delete the MDR
	JRST	I$MID0			;Go for the next MDR

	SUBTTL	Dummy tape subroutines (used only on TOPS10)

I$LOGN:: $RETT				;RETURN

I$RENA:: $RETT				;RETURN

I$CHKL:: $RETT				;RETURN

I$BMDR:: $RETT				;RETURN

I$CUNK:: $RETT				;RETURN

I$RALC:: PJRST	S$INPS##		;CHECK SCHEDULABILITY

I$CGEN:: $RETF				;RETURN
	SUBTTL	I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS

	INTERN	I$MNTR

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

I$MNTR:	PUSHJ	P,.SAVE2		;Save P1 and P2 for a minute
	MOVX	S1,.OTMNT		;Want the MOUNT Processor PSB
	MOVX	S2,%GENRC		;Want the generic MOUNT Processor
	PUSHJ	P,A$LPSB##		;Locate the PSB
	SETZM	P4			;Assume MOUNTR is there
	JUMPF	[ LOAD P2,.VSFLG(P1),VS.TYP   ;Not there, pick up mount type
	 	  CAIE P2,.MNTST	      ;Was it for a structure?
		  SETOM	P4		      ;No, set MOUNTR not running flag
		  PUSHJ P,USRACK##	      ;Yes, so ACK the user
		  CAIE P2,.MNTST	      ;Was it for a structure
		  JRST E$MPN##		      ;No, so return an error
		  $RETT ]		      ;Yes, so return
	PUSHJ	P,USRACK##		;ACK the user
	MOVE	S1,P1			;Restore the VSL address
	PUSH	P,.VSRID(S1)		;SAVE THE REQUEST ID
	PUSHJ	P,M%GPAG		;GO GET A PAGE WE CAN USE FOR IPCF
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE THE MESSAGE ADDRESS
	MOVE	P1,S1			;SAVE THE ADDRESS

	POP	P,S1			;RESTORE THE REQUEST ID
	LOAD	S1,S1,VS.RID		;GET JUST 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
MNTR.1:	ILDB	TF,S1			;COPY ACCOUNT
	IDPB	TF,S2			;    STRING FROM MDR
	JUMPN	TF,MNTR.1		;          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
	MOVX	S1,PAGSIZ		;GET THE PAGE LENGTH
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IT AS THE NEW MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IN THE SAB ALSO

MNTR.2:	MOVX	S1,.OTMNT		;WANT MOUNT PROCESSOR PSB
	MOVX	S2,%GENRC		;WANT GENERIC MOUNT PROCESSOR
	PUSHJ	P,A$LPSB##		;LOCATE THE PSB
	JUMPF	[MOVE  S1,G$SAB##+SAB.MS ;NOT THERE,,GET THE MSG ADDRESS
		 PUSHJ P,M%RPAG		;RETURN THE MEMORY
		 MOVE  S1,.MRVSL(AP)	;Get the VSL address
		 LOAD  S1,.VSFLG(S1),VS.TYP ;Get the mount type
		 CAIE  S1,.MNTST	;Was it a structure request?
		 PJRST E$MPN##  	;No, so return an error
		 $RETT ]		;Yes, so return
	MOVE	S1,PSBPID(S1)		;GET THE PROCESSORS PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE THE PID
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF TO MOUNTR
	JUMPF	MNTR.2			;LOSE,,TRY AGAIN
	$RETT				;WIN,,RETURN
	SUBTTL	I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES

	;CALL:	M/RELEASE MESSAGE ADDRESS (SAME AS .QOREL)
	;
	;RET:	TRUE  - REQUEST DELETED OR NOT FOUND
	;	FALSE - INVALID MESSAGE RECIEVED

	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,REL.IT(M)		;GET THE REQUEST ID
	PUSHJ	P,D$FVSL##		;FIND THE VSL
	JUMPF	.RETT			;NOT THERE,,FINE
	PUSHJ	P,D$DVSL##		;FOUND IT,,DELETE IT
	LOAD	S1,.MRCNT(AP),MR.CNT	;ANY REQUESTS LEFT ???
	JUMPG	S1,.RETT		;YES,,RETURN
	PJRST	D$DMDR##		;NO,,DELETE THE MDR & RETURN
	SUBTTL	OPERATOR TAPE/DISK MOUNT MESSAGES

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

	INTERN	I$OMNT			;MAKE THE ROUTINE GLOBAL

I$OMNT:	MOVX	S1,.OTMNT		;WANT MOUNT PROCESSOR
	MOVX	S2,%GENRC		;WANT GENERIC MOUNT PROCESSOR
	PUSHJ	P,A$LPSB##		;LOCATE THE MOUNT PROCESSOR PSB
	JUMPF	OMNT.1			;NOT THERE,,TELL OPERATOR
	MOVE	S1,PSBPID(S1)		;GET MOUNTRS PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS RECIEVERS PID
	MOVX	S1,.CMDEV		;FIND DEVICE NAME BLOCK
	PUSHJ	P,A$FNDB##		;LOOK FOR IT
	MOVX	S2,.TAPDV		;CHANGE TO TAPE BLOCK
	SKIPF				;WAS A DEVICE BLOCK FOUND ???
	STORE	S2,-ARG.DA(S1),AR.TYP	;YES,,CHANGE IT TO TAPE BLOCK
	PUSHJ	P,M%GPAG		;GO GET A PAGE FOR IPCF
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE THE ADDRESS IN THE SAB
	LOAD	S2,.MSTYP(M),MS.CNT	;GET THE MESSAGE LENGTH
	ADD	S2,S1			;CALC BLT END ADDRESS
	HRL	S1,M			;GET THE SOURCE ADDRESS
	BLT	S1,0(S2)		;COPY THE MESSAGE OVER
	MOVX	S1,PAGSIZ		;GET LENGTH OF A PAGE
	MOVEM	S1,G$SAB##+SAB.LN	;SET IT
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	JUMPF	I$OMNT			;FAILED,,TRY AGAIN !!!
	$RETT				;ELSE RETURN OK

OMNT.1:	SKIPN	G$NEBF			;[32]REQUEST ORIGINATE REMOTELY?
	JRST	OMNT.2			;[32]NO, SEND AN ACK MESSAGE
	LOAD	S1,.MSTYP(M),MS.TYP	;[32]PICK UP THE MESSAGE TYPE
	CAIE	S1,.ODDSM		;[32]IS IT A DISMOUNT MESSAGE?
	JRST	OMNT.2			;[32]NO, SO SEND AN ACK

	$CALL	M%GPAG			;[32]PICK UP A MESSAGE PAGE
	MOVE	S2,[.OHDRS+.ERRSZ,,.NFDAK] ;[30]PICK UP THE HEADER WORD
	MOVEM	S2,.MSTYP(S1)		;[30]PLACE IN THE MESSAGE
	MOVE	S2,G$MCOD##		;[30]PICK UP THE ACK CODE
	MOVEM	S2,.MSCOD(S1)		;[30]PLACE IN THE MESSAGE
	MOVX	S2,MF.NEB		;[30]PICK UP THE NEBULA BIT
	MOVEM	S2,.MSFLG(S1)		;[30]PLACE IN THE MESSAGE
	MOVX	S2,FA%QER		;[30]INDICATE ERROR FROM QUASAR
	MOVEM	S2,.OFLAG(S1)		;[30]PLACE IN THE MESSAGE
	AOS	.OARGC(S1)		;[30]INCREMENT THE ARGUMENT COUNT

	MOVE	S2,[.ERRSZ,,.ERRBK]	;[30]PICK UP ERROR BLOCK HEADER
	MOVEM	S2,.OHDRS+ARG.HD(S1)	;[30]PLACE IN THE MESSAGE
	MOVEI	S2,IPCFX4		;[30]PICK UP THE ERROR CODE
	MOVEM	S2,.OHDRS+ARG.DA(S1)	;[30]PLACE IN THE MESSAGE

	MOVE	S2,G$SND##		;[30]PICK UP ORION'S PID
	MOVEM	S2,G$SAB##+SAB.PD	;[30]PLACE IN THE SAB
	MOVEM	S1,G$SAB##+SAB.MS	;[30]PLACE MESSAGE ADDRESS IN THE SAB
	MOVEI	S1,PAGSIZ		;[30]PICK UP THE PAGE SIZE
	MOVEM	S1,G$SAB##+SAB.LN	;[30]PLACE IN THE SAB

	$CALL	C$SEND##		;[30]SEND THE MESSAGE
	$RETT				;[30]RETURN TO THE CALLER

OMNT.2:	$QACK	(Mount Request Processor Not Running,,,.MSCOD(M)) ;[32]
	$RETT				;[32]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,.SAVE3		;SAVE P1 & P2 & P3
	PUSHJ	P,A$WHEEL##		;MAKE SURE THE GUY HAS PRIVS.
	JUMPF	E$IPE##			;NO,,THE GUY IS A FRAUD
	MOVE	S1,CHE.IT(M)		;GET THE REQUEST ID
	PUSHJ	P,D$FVSL##		;LOCATE THE VSL
	JUMPF	.RETT			;NOT THERE,,FORGET IT
	MOVE	P3,S1			;SAVE THE VSL ADDRESS

	LOAD	P2,.VSCVL(P3),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	P2,.VSVOL(P3)		;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:	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

;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
	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
	MOVE	S1,P3			;GET THE VSL ADDRESS
	PUSHJ	P,D$SETO##		;LITE OWNERSHIP FLAG BITS
	$RETT				;AND RETURN

	;CONTINUED ON THE NEXT PAGE
	;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
	SKIPT				;Did we get an entry successfully?
	PUSHJ	P,S..CCE##		;Stop if not
	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 MOUNTR

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

	INTERN	I$MATR			;MAKE IT GLOBAL

I$MATR:	PUSHJ	P,.SAVE1		;SAVE P1
MATR.1:	MOVX	S1,.OTMNT		;WANT MOUNT PROCESSOR
	MOVX	S2,%GENRC		;WANT GENERIC MOUNT PROCESSOR
	PUSHJ	P,A$LPSB##		;LOCATE THE MOUNT PROCESSOR PSB
	JUMPF	E$MPN##			;NOT THERE,,SEND ERROR MSG
	MOVE	P1,S1			;Save MOUNTR's PSB adress
	PUSHJ	P,G$STGS##		;Build ACK and send
	MOVE	S1,P1			;Restore MOUNTR's PSB address
	MOVE	S1,PSBPID(S1)		;GET MOUNTRS PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS RECIEVERS PID
	PUSHJ	P,M%GPAG		;GO GET A PAGE FOR IPCF
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE THE ADDRESS IN THE SAB
	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
	MOVE	S1,G$PRVS##		;GET PRVS,,JOB NUMBER
	STORE	S1,.MATCP(P1)		;SAVE IT IN THE MESSAGE
	MOVE	S1,G$SND##		;GET THE SENDERS PID
	STORE	S1,.MATPD(P1)		;SAVE IT IN THE MESSAGE
	MOVX	S1,PAGSIZ		;GET THE LENGTH OF A PAGE
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE AS THE MESSAGE LENGTH
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE OFF
	JUMPF	MATR.1			;FAILED,,TRY AGAIN
	$RETT				;WIN,,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,.SAVE4		;SAVE P1, P2, AND P3 AND P4
KMNT.1:	MOVX	S1,.OTMNT		;WANT MOUNT PROCESSOR
	MOVX	S2,%GENRC		;WANT GENERIC MOUNT PROCESSOR
	PUSHJ	P,A$LPSB##		;LOCATE THE MOUNT PROCESSOR PSB
	JUMPF	E$MPN##			;NOT THERE,,SEND ERROR MSG
	MOVE	S1,PSBPID(S1)		;GET MOUNTRS PID
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS RECIEVERS PID
	LOAD	S1,G$PRVS##,MD.PJB	;GET THE USERS JOB NUMBER
	PUSHJ	P,D$FMDR##		;LOCATE THIS GUYS MDR
	JUMPF	E$SNY##			;NOTHING THERE !!!
	PUSHJ	P,M%GPAG		;GO GET A PAGE FOR IPCF
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE THE ADDRESS IN THE SAB
	MOVE	P4,S1			;SAVE IT IN P2
	MOVX	S1,.QOMTA		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(P4),MS.TYP	;SAVE IT
	MOVEI	S1,PAGSIZ		;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(P4),MS.CNT	;SAVE IT
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE THE LENGTH IN THE SAB
	MOVE	S1,.MSCOD(M)		;GET THE USERS ACK CODE
	MOVEM	S1,.MSCOD(P4)		;SAVE IT IN OUR MSG
	MOVE	S1,.MSFLG(M)		;GET THE USERS FLAG WORD
	MOVEM	S1,.MSFLG(P4)		;SAVE IT IN OUR MSG
	MOVEI	S1,2			;GET THE BLOCK COUNT
	STORE	S1,.OARGC(P4)		;SAVE IT
	MOVEI	P4,.OHDRS(P4)		;POINT TO THE FIRST BLOCK
	MOVX	S1,.MTPID		;GET THE BLOCK TYPE
	STORE	S1,ARG.HD(P4),AR.TYP	;SAVE IT
	MOVEI	S1,2			;GET THE BLOCK LENGTH
	STORE	S1,ARG.HD(P4),AR.LEN	;SAVE IT
	MOVE	S1,G$SND##		;GET THE SENDERS PID
	STORE	S1,ARG.DA(P4)		;SAVE IT
	MOVEI	P4,2(P4)		;POINT TO THE NEXT BLOCK
	MOVE	S1,[1,,.MTITN]		;GET THE ITN BLOCK HEADER
	MOVEM	S1,ARG.HD(P4)		;SAVE IT

	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL SEARCH AC

KMNT.2:	MOVE	P3,0(P1)		;GET A VSL ADDRESS
	MOVE	P2,KIL.RQ+.RDBRQ(M)	;GET ANY SPECIFIED REQUEST ID
	JUMPE	P2,KMNT.3		;NO REQUEST ID,,SKIP THIS
	LOAD	S1,.VSRID(P3),VS.RID	;GET THE REQUEST ID IN S2
	CAME	S1,P2			;DO WE MATCH ???
	JRST	KMNT.5			;NO,,TRY NEXT ENTRY
	JRST	KMNT.4			;YES,,WIN !!!

KMNT.3:	HRROI	S1,.VSVSN(P3)		;POINT TO THE VOL SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	XOR	S2,KIL.RQ+.RDBJB(M)	;ZERO IDENTICAL BITS
	AND	S2,KIL.RQ+.RDBJM(M)	;AND IT WITH THE MASK
	JUMPN	S2,KMNT.5		;NOT ZERO, WE DONT MATCH, TRY NEXT ENTRY

KMNT.4:	LOAD	S1,ARG.HD(P4),AR.LEN	;GET THE BLOCK LENGTH
	ADD	S1,P4			;CALC ENTRY ADDRESS
	LOAD	S2,.VSRID(P3),VS.RID	;GET THE REQUEST ID IN S2
	MOVEM	S2,0(S1)		;INSERT INTO THE MESSAGE
	INCR	ARG.HD(P4),AR.LEN	;BUMP THE BLOCK LENGTH

KMNT.5:	AOBJN	P1,KMNT.2		;CHECK ALL VSL'S

	LOAD	S1,ARG.HD(P4),AR.LEN	;GET THE ITN COUNT
	SOJLE	S1,[MOVE  S1,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS
		    PUSHJ P,M%RPAG	;RETURN THE PAGE
		    PJRST E$SNY## ]	;RETURN AN ERROR TO THE USER
	PUSHJ	P,C$SEND		;OK,,SEND THE MESSAGE
	SETZM	G$ACK##			;DONT ACK USERS MSG (LET MOUNTR DO IT)
	$RETT				;AND RETURN
	SUBTTL	FILE ARCHIVING 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
	CAIN	S1,.OTNOT		;Notification?
	JRST	[ MOVE S1,G$NOW##	  ;Get the time of day
		  AOS	S1		  ;Make it the future
		  CAMLE S1,.EQAFT(P1)	  ;Compare with after time
		  MOVEM S1,.EQAFT(P1)	  ;Make after time future time
		  JRST	I$ARC1 ]	  ;Rejoin
I$ARC1:	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 ???
	$QWTO 	(<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	^D10			;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

NTFY.0:	SETOM	DIRCTY			;RESET THE DIRECTORY NUMBER
	SETOM	REASON			;RESET THE REASON
	SETZB	P1,P2			;ZAP BUFFER ADDRESS AND FLAGS

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
	SKIPLE	BYTCNT			;ANY ROOM LEFT IN THE BUFFER ???
	JRST	NTFY.1			;YES,,GO GET ANOTHER ENTRY
	PUSHJ	P,NSNDIT		;SEND THIS BUFFER
	JRST	NTFY.0			;GET THE NEXT 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%GPAG		;GET A PAGE FOR THE DATA
	MOVE	P1,S1			;GET THE PAGE NUMBER IN P1
	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
	MOVEI	S1,<PAGSIZ-200>*5	;GET BYTE COUNT (SAVE 200 WORDS)
	MOVEM	S1,BYTCNT		;SAVE IT
	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:	SOS	BYTCNT			;ADJUST BYTE COUNT
	IDPB	S1,BYTPTR		;OUTPUT THE BYTE
	$RETT				;AND RETURN

BYTPTR:	BLOCK	1			;BYTE POINTER FOR NOTIFICATION
BYTCNT:	BLOCK	1			;BYTE COUNT
	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
	MOVEM	P1,G$SAB##+SAB.MS	;SAVE THE MSG ADDRESS IN THE SAB
	MOVX	S1,SI.FLG+SP.OPR	;SEND THIS TO ORION
	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IN THE SAB
	SETZM	G$SAB##+SAB.PD		;ZAP ANY PREVIOUS PID IN THE BLOCK
	MOVX	S1,PAGSIZ		;A page message
	MOVEM	S1,G$SAB##+SAB.LN	;Save in the SAB for C%SEND
	PUSHJ	P,C$SEND##		;SEND IT OFF
	$RETT				;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:	MOVX	S1,^D60			;GET IGNORE TIME (60 MINUTES)
	PUSHJ	P,A$AFT##		;GET TIME FOR FIRST CHECKPOINT
	MOVEM	S1,G$MSG##+.EVUDT	;SAVE IT IN THE ENTRY
	MOVEI	S1,[SETOM G$NTFY##	;GET INTERRUPT ADDRESS
		    $RETT  ]		;WHICH WILL FLAG THE TIMER REQUEST
	MOVEM	S1,G$MSG##+.EVRTN	;SAVE IT IN THE ENTRY
	MOVX	S1,%EVAFT		;GET THE /AFTER ENTRY TYPE
	MOVEM	S1,G$MSG##+.EVTYP	;SAVE IT IN THE ENTRY
	MOVX	S1,.EVMSZ		;GET THE ENTRY LENGTH
	MOVEI	S2,G$MSG##		;AND THE ENTRY ADDRESS
	PUSHJ	P,S$EVENT##		;ADD IT TO THE EVENT QUEUE
	$RETT				;RETURN
	END