Google
 

Trailing-Edge - PDP-10 Archives - bb-h138e-bm_tops20_v6_1_distr - galaxy-sources/qsrsch.mac
There are 48 other files named qsrsch.mac in the archive. Click here to see a list.
	TITLE	QSRSCH  -  Scheduler and queue-dependent functions for QUASAR
	SUBTTL	Preliminaries

;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
;     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,D60UNV	;PARAMETER FILE

	PROLOG(QSRSCH)			;GENERATE NECESSARY SYMBOLS

	SEARCH	ORNMAC			;GET WTO PARAMETERS.

	SCHMAN==:4			;Maintenance edit number
	SCHDEV==:11			;Development edit number
	VERSIN (SCH)			;Generate edit number
	SUBTTL	Table of Contents


;		Table of Contents for QSRSCH
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision history . . . . . . . . . . . . . . . . . . .    3
;   4. Macro definitions. . . . . . . . . . . . . . . . . . .    4
;   5. S$INIT
;        5.1.   Scheduler Initialization Point. . . . . . . .    5
;   6. S$SCHD
;        6.1.   Scheduler Entry Point . . . . . . . . . . . .    6
;   7. PASS 2 OF THE SCHEDULER. . . . . . . . . . . . . . . .    8
;   8. SETUP
;        8.1.   Set up and do accounting for object setup . .    9
;   9. S$SHUT
;        9.1.   Send a SHUTDOWN message to a component for an object  11
;  10. RESPONSE-TO-SETUP
;       10.1.   Function 23 . . . . . . . . . . . . . . . . .   13
;  11. CHKTIM - ROUTINE TO GLANCE THROUGH THE EVENT QUEUE . .   15
;  12. S$AFTR - ROUTINE TO SCHEDULE A /AFTER EVENT. . . . . .   15
;  13. S$EVENT - ROUTINE TO ADD AN ENTRY TO THE EVENT QUEUE .   16
;  14. MISC ROUTINES TO ADD ENTRIES TO THE EVENT QUEUE. . . .   17
;  15. EVENT QUEUE ACTION ROUTINES. . . . . . . . . . . . . .   18
;  16. CHKOBJ - ROUTINE TO CHK OBJECTS AND SHUT THEM DOWN IF NECESSARY  19
;  17. Queue Dependent Functions. . . . . . . . . . . . . . .   20
;  18. INP
;       18.1.   Input queue dependent functions . . . . . . .   21
;  19. S$INPS - Routine to check the schedulability of a batch request  23
;  20. INPDEF - ROUTINE TO DEFAULT THE BATCH EQ ENTRY . . . .   24
;  21. S$INRL - ROUTINE TO PROCESS BATCH RELEASE MESSAGES . .   27
;  22. S$REQU - ROUTINE TO PROCESS BATCH REQUEUE MESSAGES . .   29
;  23. LPT
;       23.1.   Lineprinter queue dependent functions . . . .   30
;  24. CDP
;       24.1.   Card-punch queue dependent functions. . . . .   33
;  25. PTP
;       25.1.   Papertape punch queue dependent functions . .   34
;  26. PLT
;       26.1.   Plotter queue dependent functions . . . . . .   35
;  27. BIN
;       27.1.   Batch-Input queue dependent functions . . . .   36
;  28. RDR
;       28.1.   Reader queue dependent functions. . . . . . .   37
;  29. RET
;       29.1.   Retrieval queue dependant functions . . . . .   38
;  30. NOT - Notification queue dependant functions . . . . .   39
;  31. DBMS SCHEDULING VECTOR . . . . . . . . . . . . . . . .   40
;  32. Local Subroutines. . . . . . . . . . . . . . . . . . .   41
;  33. OUTMOD
;       33.1.   Do queue dependent MODIFY for Output queues .   42
;  34. OUTDEF
;       34.1.   Fill in defaults for Output queues. . . . . .   44
;  35. RENDEF - Check for /DISPOSE:RENAME . . . . . . . . . .   45
;  36. OUTKSYS - Job scheduling check during KSYS . . . . . .   46
;  37. OUTFJB
;       37.1.   Common routine for picking an output job. . .   47
;  38. EQDFLT
;       38.1.   Default queue-independent fields in an EQ . .   48
;  39. LNKPRI
;       39.1.   Compute linkin priority and do linkin . . . .   50
;  40. NEXTJB
;       40.1.   Function 5. . . . . . . . . . . . . . . . . .   51
;  41. JOBDUN
;       41.1.   Common job release routine. . . . . . . . . .   52
SUBTTL	Revision history

COMMENT \

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

0			7-Jan-83
	Currently no edits

2	4.2.1582	20-Jul-84
	Check if the priority of a request has been changed and if so,
turn on EQ.CHP in word .EQSEQ in the EQ of the request.

3	4.2.1610	28-Feb-85
	In S$AFTR, for notification requests, set G$NTFY to -1. This will
insure that the notification request is sent to ORION.

4	4.2.1613	17-Apr-85
	Before an IBM node is shut down, ensure that both the reader and
printer are idle.

*****  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.1162		21-Sep-84
	Add code to build SETUP message for starting SNA Workstation. Do
not allow requests to be scheduled for SNA Workstation printers and punches.

\   ;End of Revision History
SUBTTL	Macro definitions

;VDFALT macro is used to default a field with a particular value

DEFINE VDFALT(AC,LOCN,FIELD,DEFALT,%DUMMY),<
	LOAD	(AC,LOCN,FIELD)
	XLIST
	JUMPN	AC,%DUMMY
	MOVX	(AC,DEFALT)
	STORE	(AC,LOCN,FIELD)
%DUMMY:
	LIST
	SALL
>  ;END DEFINE VDFALT

;LDFALT macro is used to default a field with the contents of a specified location

DEFINE LDFALT(AC,LOCN,FIELD,LOC2,%DUMMY),<
	LOAD	(AC,LOCN,FIELD)
	XLIST
	JUMPN	AC,%DUMMY
	MOVE	AC,LOC2
	STORE	(AC,LOCN,FIELD)
%DUMMY:
	LIST
	SALL
>  ;END DEFINE LDFALT

;PDFALT macro is used to default a 'limit parameter' with a particular value

DEFINE PDFALT(AC,BLOCK,NAME,DEFALT,%DUMMY),<
	GETLIM	(AC,BLOCK,NAME)
	XLIST
	JUMPN	AC,%DUMMY
	MOVX	AC,DEFALT
	STOLIM	(AC,BLOCK,NAME)
%DUMMY:
	LIST
	SALL
>  ;END DEFINE PDFALT
	SUBTTL	S$INIT  --  Scheduler Initialization Point

;This routine is called at once-only to initialize the data base
;	for the scheduler.


		ENTRY	S$INIT

S$INIT:	PUSHJ	P,L%CLST		;CREATE THE EVENT QUEUE LIST
	MOVEM	S1,G$EVENT##		;SAVE THE QUEUE ID
	DOSCHD				;FORCE INITIAL SCHEDULING PASS
	$RETT
SUBTTL	S$SCHD  --  Scheduler Entry Point

;S$SCHD is called from the main program to execute a scheduling pass
;	through the OBJ queue.
;
;The algorithm for scheduling is as follows:

;**************put a flowchart or something impressive here***************
S$SCHD:: PUSHJ	P,CHKTIM		;CHECK OBJECT TIMERS
	PUSHJ	P,I$SYSV##		;READ SYSTEM VARIABLES
	AOSE	G$SCHD##		;COUNT DOWN THE SCHED FLAG
	$RETT				;DON'T SCHEDULE NOW
	$COUNT(SLCD)			;WE EXHAUSTED THE COUNTER
	PUSHJ	P,.SAVE4		;SAVE P1-P4
	PUSHJ	P,D$CLSV##		;CLEAR VALID STATUS BITS FOR ALL STRS

	LOAD	P1,HDROBJ##+.QHLNK,QH.PTF ;GET POINTER TO FIRST OBJECT

SCHD.1:	JUMPE	P1,SCH2.1		;DONE WITH PASS1, DO PASS2
	MOVE	S1,OBJSCH(P1)		;GET SCHEDULER STATE INFO
	TXC	S1,OBSSTA!OBSSUP	;COMPLEMENTS BITS WE WANT ON
	TXNE	S1,OBSSTA!OBSSUP!OBSBUS	;MUST BE STARTED+SETUP+NOTBUSY
	JRST	SCHD.4			;NO GOOD, TRY NEXT
	TXNN	S1,OBSSEJ		;DO WE WANT TO SHUT IT DOWN ??
	JRST	SCHD.2			;NO,,KEEP ON GOING ...
	TXNN	S1,OBSIBM		;Object belong to an IBM node?
	JRST	SCHD1A			;No, so shut it down now
	PUSHJ	P,SHTNOW		;See if the node can be shut down
	JUMPF	[LOAD P1,.QELNK(P1),QE.PTN  ;No, get the next object
		 JRST SCHD.1]		;Continue processing
SCHD1A:	LOAD	P4,.QELNK(P1),QE.PTN	;Get nxt entry now,current being deleted
	MOVE	S1,P1			;PUT THE OBJECT ADDRESS INTO S1.
	PUSHJ	P,S$SHUT		;SHUT IT DOWN
	LOAD	P1,P4			;GET THE NEXT LINK (AFTER DELETE)
	JRST	SCHD.1			;AND CONTINUE PROCESSING.

SCHD.2:	TXNE	S1,OBSIGN+OBSSTP	;ARE WE IGNORING or STOPPED BY OPR ??
	JRST	SCHD.4			;YES, DON'T SCHEDULE IT
	MOVE	S1,OBJNOD(P1)		;GET NODE NAME
	PUSHJ	P,N$NODE##		;SEE IF NODE IS ON-LINE
	MOVX	S1,OBSSPL		;GET SPOOLING TO DEVICE BIT
	TDNN	S1,OBJSCH(P1)		;WHAT ARE WE DOING ?
	JUMPF	SCHD.4			;NODE OFF-LINE OR NOT SPOOLING
	LOAD	S1,OBJSCH(P1),OBSSNA	;IF SNA PRINTER OR PUNCH
	JUMPN	S1,SCHD.4		; DON'T SCHEDULE ANY JOBS
	LOAD	P2,OBJSCH(P1),OBSQUH	;GET ADDRESS OF QUEUE HEADER
	LOAD	P2,.QHPAG(P2),QH.SCH	;GET ADDRESS OF SCHEDULING VECTOR
	SKIPE	S1,OBJRID(P1)		;[NXT] CHECK AND LOAD NEXT REQUEST-ID
	JRST	[PUSHJ P,A$FREQ##	;[NXT] LOCATE THE REQUEST
		 JUMPT SCH.A2		;[NXT] FOUND IT,,SCHEDULE IT
		 SETZM OBJRID(P1)	;[NXT] NOT THERE,,ZAP OLD REQUEST ID
		 JRST  .+1 ]		;[NXT] AND GO FIND ANY OLD JOB !!!
	SKIPGE	G$KSYS##		;KSYS TIME OUT YET?
	JRST	SCHD.4			;KEEP LOOKING FOR A NEXT'ED REQUEST
	MOVE	S1,P1			;PUT THE OBJECT ADDRESS INTO S1.
	PUSHJ	P,SCHFJB(P2)		;FIND A JOB FOR THE OBJECT
	JUMPF	SCHD.3			;NO JOBS,,SEE IF REMOTE AND GET NEXT OBJ
SCH.A2:	MOVX	S2,OBSBUS		;[NXT] SET 'BUSY' SO KILPSB WILL
	IORM	S2,OBJSCH(P1)		;  CLEAN UP ON A SEND FAILURE
	MOVX	S2,OBSFRM		;GET FORMS CHANGR REQUIRED STATUS
	ANDCAM	S2,OBJSCH(P1)		;CLEAR IT
	MOVE	S2,P1			;PUT OBJECT IN S2
	PUSHJ	P,SCHSCH(P2)		;AND SCHEDULE THE JOB
	SKIPA				;SKIP TO NEXT OBJECT

SCHD.3:	PUSHJ	P,CHKOBJ		;Q IS EMPTY,,DO END-OF-QUEUE PROCESSING

SCHD.4:	LOAD	P1,.QELNK(P1),QE.PTN	;POINT TO NEXT OBJECT
	JRST	SCHD.1			;AND  LOOP

SHTNOW:	$SAVE	P2			;Save P2
	MOVE	S1,OBJNOD(P1)		;Pick up the object's node word
	PUSHJ	P,N$NODE##		;Pick up the node's flag word
	LOAD	S1,NETSTS(S2),NT.MOD	;Pick up the network mode
	CAIE	S1,DF.TRM		;Termination node?
	$RETT				;No, so shut the object down
	MOVE	S1,P1			;Point to the object entry
	MOVE	S2,OBJTYP(P1)		;Pick up the object type
	PUSHJ	P,SHTTYP		;Check for idle reader 
	JUMPF	.RETF			;Reader wasn't idle
	LOAD	P2,HDROBJ##+.QHLNK,QH.PTF ;Must check all the objects
SHTN.1:	JUMPE	P2,.RETT		;No more objects, success
	MOVE	S1,OBJNOD(P2)		;Get the current object's node
	CAMN	S1,OBJNOD(P1)		;Same node as one we're looking for
	CAMN	P2,P1			;Yes, is it the same object
	JRST	SHTN.2			;Yes, don't care about it
	MOVE	S1,OBJSCH(P2)		;Get the scheduling word
	TXC	S1,OBSSTA!OBSSUP	;Complement the bits we want
	TXNE	S1,OBSSTA!OBSSUP!OBSBUS ;Must be started+setup+not busy
	$RETF				;No, must wait to shut down
	MOVE	S1,P2			;Point to the object entry
	MOVE	S2,OBJTYP(P2)		;Get the object type
	PUSHJ	P,SHTTYP		;Check if it is an idle reader
	JUMPF	.RETF			;No, so must wait to shut down
SHTN.2:	LOAD	P2,.QELNK(P2),QE.PTN	;All is well, get the next object
	JRST	SHTN.1			;And continue processing

SHTTYP:	CAIE	S2,.OTRDR		;Is this object a reader?
	$RETT				;No, so continue on
	MOVE	S2,OBJSTS(S1)		; Get the reader's status
	CAIE	S2,%IDLE		;Is it idle?
	$RETF				;No, so can not shut down
	$RETT				;Yes, so continue on
	SUBTTL	PASS 2 OF THE SCHEDULER

SCH2.1:	LOAD	P1,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJECT
SCH2.2:	JUMPE	P1,.RETT		;RETURN WHEN DONE
	LOAD	S1,OBJSCH(P1)		;GET THE SCHEDULING BITS
	TXC	S1,OBSSTA		;COMPLIMENT 'STARTED'
	TXNE	S1,OBSSTA!OBSSUP!OBSSIP!OBSSTP	;STARTED+NOTSETUP+NOTSIP+NOT STOPPED
	JRST	SCH2.5			;NO, TRY NEXT OBJECT

	MOVE	S1,OBJNOD(P1)		;GET NODE NAME
	PUSHJ	P,N$NODE##		;SEE IF NODE IS ON-LINE
	MOVE	P3,NETSTS(S2)		;SAVE NODE STATUS BITS IN P3
	MOVX	S1,OBSSPL		;GET SPOOLING TO DEVICE BIT
	TDNE	S1,OBJSCH(P1)		;WHAT ARE WE DOING ?
	JRST	SCH2.0			;SPOOLING THE DEVICE
	JUMPT	SCH2.0			;NOT SPOOLING, MAKE SURE IT'S ON-LINE

	;Here if Node is Offline

	TXNE	P3,NETSNA		; Is this an SNA Workstation
	JRST	SCH2.6 			;  Yes, process it
	TXNN	P3,NETIBM		;IS THIS AN IBM REMOTE STATION ???
	JRST	SCH2.5 			;NO,,JUST PROCESS NEXT OBJECT
	LOAD	S1,OBJTYP(P1)		;YES,,GET THE OBJECT TYPE
	CAXE	S1,.OTBAT		;IF ITS A BATCH OBJECT OR
	CAXN	S1,.OTRDR		;   CARD READER THEN OK
	JRST	SCH.2A			;YES TO EITHER,,LETERRIP !!!
	JRST	SCH2.5			;NO,,JUST PROCESS NEXT OBJECT

	;Here if Node Is Online - Check for any Requests to be Processed

SCH2.0:	SKIPE	OBJRID(P1)		;[NXT] NEXT REQUEST WAITING ???
	JRST	SCH.2A			;[NXT] YES,,LETERRIP !!!
	MOVE	S1,OBJSCH(P1)		;GET THE SCHEDULING BITS
	TXNN	S1,OBSFRM		;FORMS CHANGE REQUIRED ???
	TXNE	P3,NETIBM		;OR IS THIS AN IBM REMOTE STATION ???
	JRST	SCH.2A			;YES,,DONT CARE IF THERE ARE ANY JOBS !
	TXNE	P3,NETSNA		; Is it an SNA Workstation?
	JRST	SCH.2A			;YES,,DONT CARE IF THERE ARE ANY JOBS !
	LOAD	S2,OBJSCH(P1),OBSQUH	;GET ADDRESS OF QUEUE HEADER
	LOAD	S2,.QHPAG(S2),QH.SCH	;GET ADDRESS OF SCHEDULING VECTOR
	MOVE	S1,P1			;COPY OBJ ADDRESS IN S1
	PUSHJ	P,SCHFJB(S2)		;AND SEE IF THERE IS A JOB
	JUMPF	SCH2.5			;NO JOB, NEXT OBJECT

	;Here to Check to see if we we're Temporarily shut down

SCH.2A:	MOVE	S1,OBJSCH(P1)		;GET SCHEDULING BITS
	TXZE	S1,OBSHUT		;ARE WE TEMP SHUT DOWN ???
	PUSHJ	P,[TXZ   S1,OBSIGN	;YES,,CLEAR THE IGNORE BIT
		   MOVEM S1,OBJSCH(P1)	;   SAVE THE NEW SCHEDULING BITS
		   POPJ   P,  ]		;         AND CONTINUE SCHEDULING
	TXNE	S1,OBSIGN		;IS THE IGNORE BIT SET ???
	JRST	SCH2.5			;YES,,TRY THE NEXT OBJECT

	;Here to find a PSB to send the SETUP Message to.

SCH2.3:	LOAD	S1,OBJTYP(P1)		;GET THE OBJECT TYPE
	LOAD	S2,P3,NT.MOD		;GET THE OBJECT MODE (FROM STATUS BITS)
	CAXN	S2,DF.EMU		;IS THIS AN EMULATION NODE ???
	MOVX	S1,.OTIBM		;YES,,THEN SEARCH FOR EMULATION SPOOLER
	TXNE	P3,NETSNA		; Is this an SNA node
	MOVX	S1,.OTSNA		;  Yes, then search for SNA spooler
	LOAD	S2,OBJDAT(P1),RO.ATR	;GET THE OBJECT ATTRIBUTES
	PUSHJ	P,A$GPSB##		;GET A PSB FOR THIS OBJECT
	JUMPF	SCH2.5			;NO PROCESSOR,,TRY NEXT OBJECT
	MOVE	S2,P1			;S1 HAS PSB ADDR, S2 HAS OBJ POINTER
	PUSHJ	P,SETUP			;SEND SETUP MSG TO APPROPRIATE PROCESSOR
	JUMPF	SCH2.3			;FAILED,,TRY ANOTHER PSB...

SCH2.5:	LOAD	P1,.QELNK(P1),QE.PTN	;GET POINTER TO NEXT OBJ
	JRST	SCH2.2			;AND LOOP

; Here if node is an SNA workstation and node is Offline
;  only the main batch stream can be started

SCH2.6:
	LOAD	S1,OBJTYP(P1)		; Get the object type
	LOAD	S2,OBJUNI(P1)		; Get the object unit
	CAXN	S1,.OTBAT		; Is it the main batch object
	CAXE	S2,1			; That is batch stream 1
	JRST	SCH2.5			;  No, just process next object
	JRST	SCH.2A			;  Yes, leterrip !!!
	SUBTTL SETUP  --  Set up and do accounting for object setup

;SETUP is called with an object and appropriate PSB to accomplish the
;	sending of a SETUP message.  It also accounts for the OBJ
;	being added to the PSB's list and checks for the processor going
;	away.

;CALL IS:	S1/	Pointer to PSB
;		S2/	Pointer to OBJ
;
;TRUE RETURN:	Processor has been sent a setup message
;FALSE RETURN:	PID of PSB was dropped, indicating it is gone

SETUP:	PUSHJ	P,.SAVE4		;SAVE FOUR PERM ACS
	DMOVE	P1,S1			;AND SAVE OUR INPUT ARGUMENTS
	MOVEI	S1,SUP.SZ		;GET THE MESSAGE SIZE
	MOVEI	S2,G$MSG##		;GET THE MESSAGE ADDRESS
	PUSHJ	P,.ZCHNK		;CLEAR IT OUT
	MOVEI	P3,G$MSG##		;GET THE MESSAGE ADDRESS

	MOVX	S1,SUP.SZ		;GET SIZE OF SETUP MESSAGE
	STORE	S1,.MSTYP(P3),MS.CNT	;STORE INTO MESSAGE BLOCK
	MOVX	S1,.QOSUP		;GET CODE FOR SETUP MESSAGE
	STORE	S1,.MSTYP(P3),MS.TYP	;STORE INTO MESSAGE BLOCK
	MOVEI	S1,OBJTYP(P2)		;POINT TO THE SOURCE OBJECT
	MOVEI	S2,SUP.TY(P3)		;POINT TO THE DESTINATION
	PUSHJ	P,A$CPOB##		;AND COPY THE OBJECT BLOCK
	MOVE	S1,SUP.NO(P3)		;GET THE NODE WE ARE HEADING TO
	PUSHJ	P,N$NODE##		;FIND IT IN OUR DATA BASE
	MOVE	P4,S2			;SAVE THE NODE DB ENTRY ADDRESS
	LOAD	S1,NETSTS(S2),NETSNA	; Is this an SNA workstation?
	JUMPN	S1,SETU.2		;  Yes, go process it
	LOAD	S1,NETSTS(S2),NETIBM	;IS THIS AN IBM (DN60) REMOTE STATION
	JUMPE	S1,SETU.0		;NO,,CHECK IF LOCAL AND SPECIAL DEVICE

	LOAD	S1,NETPTL(P4),NT.PRT	;GET THE NODE PORT NUMBER
	STORE	S1,SUP.CN(P3),CN$PRT	;SAVE IT IN THE MESSAGE
	LOAD	S1,NETPTL(P4),NT.LIN	;GET THE NODE LINE NUMBER
	STORE	S1,SUP.CN(P3),CN$LIN	;SAVE IT IN THE MESSAGE
	LOAD	S1,NETSTS(P4),NT.TYP	;GET THE REMOTE TYPE
	STORE	S1,SUP.CN(P3),CN$TYP	;SAVE IT IN THE MESSAGE
	MOVEI	S2,1			;GET A 1
	LOAD	S1,NETSTS(P4),NT.MOD	;GET THE REMOTE MODE
	CAIN	S1,DF.EMU		;IS IT EMULATION ???
	STORE	S2,SUP.CN(P3),CN$ETF	;YES,,SAVE EMULATION/TERMINATION FLAG
	LOAD	S1,NETSTS(P4),NT.TOU	;GET THE PROTOCOL CATAGORY
	CAIN	S1,ST.PRI		;IS IT 'PRIMARY' ???
	STORE	S2,SUP.CN(P3),CN$PSP	;YES,,SAVE PRIMARY PROTOCALL FLAG
	LOAD	S1,NETSTS(P4),NT.TRA	;GET THE TRANSPARENCY CODE
	CAIN	S1,ST.ON		;IS IT ON ???
	STORE	S2,SUP.CN(P3),CN$TRA	;YES,,SAVE TRANSPARENCY ON FLAG

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

	MOVE	S1,NETCSD(P4)		;GET THE CLEAR-TO-SEND DELAY
	STORE	S1,SUP.CN(P3),CN$CTS	;SAVE IT IN THE MESSAGE
	MOVE	S1,NETSWL(P4)		;GET THE SILO WARNING LEVEL
	STORE	S1,SUP.CN(P3),CN$WRN	;SAVE IT IN THE MESSAGE
	MOVE	S1,NETBPM(P4)		;GET THE BYTES PER MESSAGE
	STORE	S1,SUP.CN(P3),CN$BPM	;SAVE IT IN THE MESSAGE
	MOVE	S1,NETRPM(P4)		;GET THE RECORDS PER MSG
	STORE	S1,SUP.CN(P3),CN$RPM	;SAVE IT IN THE MESSAGE
	MOVE	S1,NETIDN(P4)		;GET THE PORT/LINE HANDLE
	STORE	S1,SUP.CN(P3),CN$SIG	;SAVE IT IN THE MESSAGE
	MOVE	S1,NETSTS(P4)		;GET THE NODE STATUS/FLAG BITS
	MOVEM	S1,SUP.ST(P3)		;SAVE THEM FOR THE PROCESSOR
	JRST	SETU.1			;CONTINUE ON !!!

SETU.0:	LOAD	S1,OBJSCH(P2),OBSSPL	;GET THE SPOOLING TO TAPE BITS
	JUMPE	S1,SETU.1		;NOT SPOOLING TO TAPE,,SKIP THIS
	SKIPN	S1,OBJPRM+.OOTAP(P2)	;CHECK AND LOAD THE SPOOL DEVICE
	JRST	SETU.1			;NO SPOOL DEVICE,,SKIP THIS
	MOVEM	S1,SUP.ST(P3)		;SAVE THE DEVICE NAME FOR LPTSPL
	MOVX	S1,SPLTAP		;GET THE SPOOL TO TAPE FLAG BIT
	MOVEM	S1,SUP.FL(P3)		;SAVE IT FOR THE PROCESSOR

SETU.1:	MOVE	S1,PSBPID(P1)		;GET PID FOR THIS PROCESSOR
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS THE RECIEVERS PID
	MOVEI	S1,G$MSG##		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVEI	S1,SUP.SZ		;GET THE MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE MESSAGE
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE AWAY
	MOVE	S1,PSBPID(P1)		;GET PID FOR THIS PROCESSOR
	PUSHJ	P,A$FPSB##		;TRY TO LOOK UP THIS PSB AGAIN
	JUMPF	.RETF			;NOT FOUND,,MUST BE GONE !!!
	INCR	PSBLIM(S1),PSLCUR	;ADD ONE TO CURRENT ACTIVE SLOTS
	LOAD	S1,PSBPID(S1)		;GET THE PROGRAM'S PID
	STORE	S1,OBJPID(P2)		;AND STORE IT
	MOVX	S1,OBSSIP		;GET "SET UP IN PROGRESS" BIT
	IORM	S1,OBJSCH(P2)		;AND STORE INTO STATUS FOR THIS OBJECT
	$RETT				;RETURN

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

SETU.2:					; Here to set up for SNA Workstation
	MOVE	S1,NETSTS(P4)		; Get the node status/flag bits
	MOVEM	S1,SUP.ST(P3)		; Save them for the processor
	MOVE	S1,NETGWY(P4)		; Get the Gateway node
	MOVEM	S1,SUP.GW(P3)		; Save it for the processor
	DMOVE	S1,NETACC(P4)		; Get the Access Name
	DMOVEM	S1,SUP.AN(P3)		; Save it for the processor
	MOVE	S1,NETACC+2(P4)		; Get all of access name
	MOVEM	S1,SUP.AN+2(P3)		; Save it for the processor
	MOVE	S1,OBJTYP(P2)		; Get object type
	CAIE	S1,.OTBAT		; Is it batch?
	JRST	SETU.3			;  No
	LOAD	S1,NETNAB(P4),NA.ADR	;  Yes, Get the Node Attribute Block
	MOVEI	S2,SUP.AB(P3)		; Where it goes in SETUP msg
	HRL	S2,S1			;  source,,destination
	BLT	S2,SUP.AB+NABSIZ-1(P3)	; Move it
	JRST	SETU.1			; Continue on !!!

SETU.3:	MOVE	S1,NETNOB(P4)		; Get the list index
	PUSH	P,P1			; Save P1
	MOVE	P1,P2			; P1 points to object
	$CALL	FNDNOB##		; Get the NOB
	POP	P,P1			; P1 points to PSB again
	JUMPF	SETU.1			;  No NOB entry, continue on
	MOVEI	S2,SUP.AB(P3)		; Where it goes in SETUP msg
	HRL	S2,S1			;  source,,destination
	BLT	S2,SUP.AB+NOBSIZ-1(P3)	; Move it
	JRST	SETU.1			; Continue on !!!
	SUBTTL	S$SHUT  --  Send a SHUTDOWN message to a component for an object

;A SHUTDOWN message is sent for an object for a number of reasons:

;	1. Operator requested shutdown
;	2. Node is no longer on-line
;	3. If Object is remote and no queue entries
;Call:	S1/  address of OBJ

	INTERN	S$SHUT			;MARK SHUTDOWN AS GLOBAL

SHTINT:	TDZA	S2,S2			;INDICATE AN INTERNAL CALL TO SHUTDOWN
S$SHUT: SETOM	S2			;INDICATE NORMAL CALL TO SHUTDOWN
	PUSHJ	P,.SAVE1		;SAVE A PERM AC
	MOVE	P1,S1			;AND SAVE OUR INPUT ARGUMENT
	STKVAR	<SHUTYP>		;GEN STORAGE FOR ENTRY POINT INDICATOR
	MOVEM	S2,SHUTYP		;SAVE IT FOR LATER
	DOSCHD				;FORCE ANOTHER SCHEDULING PASS
	MOVX	S1,%GENRC		;GET GENERIC DEVICE ATTRIBUTES
	MOVE	S2,OBJSCH(P1)		;GET SCHEDULER FLAGS
	TXZE	S2,OBSATR		;WERE ATTRIBUTES SET BY THE PROCESSOR ?
	STORE	S1,OBJDAT(P1),RO.ATR	;YES,,RESET THE ATTRIBUTES
	MOVEM	S2,OBJSCH(P1)		;SAVE THE SCHEDULER FLAGS
	TXNN	S2,OBSSUP+OBSSIP	;IS IT SETUP OR SETUP IN PROGRESS ???
	JRST	SHUT.1			;NO,,JUST SHUT IT DOWN.

	MOVEI	S1,SUP.SZ		;ZERO OUT THE MESSAGE
	MOVEI	S2,G$MSG##		;BLOCK SINCE IT MAY BE RE-USED
	PUSHJ	P,.ZCHNK		;FOR OTHER THINGS
	MOVX	S1,SUP.SZ		;GET SIZE OF SETUP MESSAGE
	STORE	S1,G$MSG##+.MSTYP,MS.CNT ;STORE INTO MESSAGE BLOCK
	MOVX	S1,.QOSUP		;GET CODE FOR SETUP MESSAGE
	STORE	S1,G$MSG##+.MSTYP,MS.TYP ;STORE INTO MESSAGE BLOCK
	MOVEI	S1,OBJTYP(P1)		;GET ADR OF SOURCE OBJ
	MOVEI	S2,G$MSG##+SUP.TY	;GET ADR OF DESTINATION OBJ
	PUSHJ	P,A$CPOB##		;AND COPY THEM
	MOVX	S1,SUFSHT		;MOST IMPORTANTLY, GET THE
	IORM	S1,G$MSG##+SUP.FL	; SHUTDOWN FLAG AND SET IT
	MOVE	S1,OBJPID(P1)		;GET PID TO SEND TO
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS THE RECIEVERS PID
	MOVEI	S1,G$MSG##		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVEI	S1,SUP.SZ		;GET THE MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	PUSHJ	P,C$SEND##		;SEND THE MESSAGE AWAY
	MOVE	S1,OBJSCH(P1)		;GET THE SCHEDULING BITS.
	TXZ	S1,OBSSEJ		;CLEAR SHUTDOWN AT EOJ BIT
	MOVEM	S1,OBJSCH(P1)		;SAVE THE SCHEDULING BITS BACK
	TXNE	S1,OBSFRR		;IF THIS IS FREE RUNNING
	$RETT				;IF SO,,THEN RETURN NOW

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

SHUT.1:	MOVE	S1,OBJPID(P1)		;GET THE GUY'S PID
	PUSHJ	P,A$FPSB##		;FIND THE PSB
	SKIPF				;IF NOT THERE,,JUST CONTINUE
	DECR	PSBLIM(S1),PSLCUR	;ELSE, GIVE HIM 1 OFF
	SETZM	OBJPID(P1)		;ZAP THE CONTROLLING PID.
	SKIPE	SHUTYP			;IF NOT INTERNAL,,TELL THE OPERATOR
	$WTO	(Shutdown,,OBJTYP(P1))	;    WHAT HAPPENED

	MOVE	S1,OBJNOD(P1)		;GET THIS GUYS NODE
	PUSHJ	P,N$NODE##		;FIND IT IN OUR DATA BASE
	MOVE	S1,NETSTS(S2)		;GET THE NODE STATUS BITS
	TXNN	S1,NETIBM!NETSNA	;IS THIS AN IBM TYPE NODE ???
	JRST	SHUT.2			;NOT AN IBM REMOTE,,SKIP THIS
	MOVE	S1,S2			;GET NODE DB ADDRESS IN S1
	MOVE	S2,P1			;AND THE OBJECT ADDRESS IN S2
	PUSHJ	P,N$NOFF##		;SET POSSIBLE NODE OFFLINE !!!
	JUMPF	.RETT			;NOT A PROTOTYPE,,RETURN

SHUT.2:	SKIPN	SHUTYP			;IF THIS IS AN INTERNAL CALL
	$RETT				;    THEN JUST RETURN

	LOAD	S1,OBJTYP(P1)		;GET THE OBJECT TYPE.
	CAIN	S1,.OTBAT		;IS IT A BATCH STREAM ???
	AOS	G$NBAT##		;YES,,BUMP BATCH COUNT BY 1.
	MOVE	AP,P1			;GET THE CELL ADDRESS.
	$SAVE	H			;SAVE H JUST IN CASE
	MOVEI	H,HDROBJ##		;GET THE HEADER ADDRESS.
	PJRST	M$RFRE##		;DELETE THE OBJECT ENTRY AND RETURN.
	SUBTTL	RESPONSE-TO-SETUP  --  Function 23

;The RESPONSE-TO-SETUP message is sent to QUASAR by a known component as
;	the response to a SETUP message.

S$RSETUP::
	DOSCHD				;SCHEDULE!!
	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	LOAD	S1,.MSTYP(M),MS.CNT	;GET MESSAGE LENGTH
	CAIGE	S1,RSU.SZ		;BIG ENOUGH?
	PJRST	E$MTS##			;NO, LOSE
	MOVE	S1,G$SND##		;GET THE SENDER'S PID
	PUSHJ	P,A$FPSB##		;FIND HIS PSB
	JUMPE	S1,E$NKC##		;NOT A KNOWN COMPONENT
	MOVE	P1,PSBPID(S1)		;GET THE PID

	MOVEI	S1,RSU.TY(M)		;POINT TO THE SPECIFIED OBJECT
	PUSHJ	P,A$FOBJ##		;FIND THE OBJ ENTRY
	JUMPF	E$NYO##			;ITS NOT HIS
	CAME	P1,OBJPID(S1)		;SEE IF IT REALLY IS HIS
	PJRST	E$NYO##			;ITS NOT
	MOVE	P1,S1			;SAVE THE OBJECT ADDRESS IN P1

	;Check the OBJECT Status

	LOAD	S1,OBJSCH(P1),OBSSIP	;IS SETUP IN PROGRESS?
	JUMPN	S1,RSET.0		;YES,,SKIP BUSY CHECK
	LOAD	S1,OBJSCH(P1),OBSFRR	;GET FREE RUNNING BIT.
	JUMPN	S1,RSET.0		;IF SET,,THEN DONT RE-QUEUE.
	LOAD	S1,OBJSCH(P1),OBSBUS	;GET BUSY BIT
	JUMPE	S1,RSET.0		;RETURN IF NOT BUSY

	;If Busy, Gen a Requeue MSG and Requeue the Request Being Processed

	MOVX	S1,REQ.SZ		;GET MESSAGE SIZE
	PUSH	P,M			;SAVE THE ORIGIONAL MESSAGE ADDRESS
	PUSHJ	P,M%GMEM		;GET SOME MEMORY
	MOVE	M,S2			;PUT THE ADDRESS IN M
	MOVX	S2,REQ.SZ		;GET SIZE OF REQUUE MESSAGE
	STORE	S2,.MSTYP(M),MS.CNT	;STORE IT
	MOVX	S2,.QOREQ		;GET REQUEUE FUNCTION
	STORE	S2,.MSTYP(M),MS.TYP	;STORE IT
	LOAD	S2,OBJITN(P1)		;GET THE ITN
	STORE	S2,REQ.IT(M)		;STORE IT
	MOVX	S2,RQ.RLC		;RESTART AT LAST CHECKPOINT
	STORE	S2,REQ.FL(M)		;STORE FLAGS
	PUSH	P,M			;SAVE M
	PUSHJ	P,Q$REQUE##		;REQUEUE THE JOB
	POP	P,S2			;GET MESSAGE BLOCK BACK
	MOVX	S1,REQ.SZ		;AND THE LENGTH
	PUSHJ	P,M%RMEM		;RETURN THE CORE
	POP	P,M			;RESTORE ORIGIONAL MSG ADDRESS.

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

RSET.0:	SETZM	P2			;CLEAR P2
	MOVE	S1,OBJNOD(P1)		;GET THIS GUYS NODE NAME/NUMBER
	PUSHJ	P,N$NODE##		;FIND IT IN OUR DATA BASE
	MOVE	S1,NETSTS(S2)		;GET THE NODE STATUS BITS
	TXNE	S1,NETIBM!NETSNA	;IS THIS AN IBM TYPE NODE ???
	MOVE	P2,S2			;YES,,SAVE THE DATA BASE ENTRY ADDRESS

	MOVE	S1,RSU.CO(M)		;GET RESPONSE CODE
	CAXE	S1,%RSUOK		;SETUP OK?
	JRST	RSET.1			;NO, TRY OTHERS

	;Here if the Object Was Setup OK.

	MOVX	S1,OBSSUP		;GET 'OBJECT SETUP' STATUS
	IORM	S1,OBJSCH(P1)		;YES, SET THE SETUP FLAG
	ZERO	OBJSCH(P1),OBSSIP	;CLEAR SETUP-IN-PROGRESS
	LOAD	S1,RSU.DA(M),RO.ATR	;GET THE ATTRIBUTES
	MOVX	S2,OBSATR		;GET ATTRIBUTES SET BY PROCESSOR FLAG
	JUMPE	S1,.+3			;SKIP IF NONE RETURNED
	STORE	S1,OBJDAT(P1),RO.ATR	;ELSE STORE IN THE OBJ
	IORM	S2,OBJSCH(P1)		;   AND SET THE FLAG
	JUMPE	P2,.RETT		;NOT AN IBM REMOTE,,RETURN NOW
	MOVE	S1,P2			;PASS THE NODE DB ADDRESS IN S1
	MOVE	S2,P1			;PASS THE OBJECT ADDRESS IN S2
	PUSHJ	P,N$NONL##		;IF IBM,,SET ONLINE AND TELL THE WORLD
	$RETT				;RETURN

RSET.1:	MOVX	S1,%GENRC		;GET 'GENERIC' DEVICE ATTRIBUTES
	MOVE	S2,OBJSCH(P1)		;GET THE SCHEDULER FLAG BITS
	TXZE	S2,OBSATR		;WERE ATTRIBUTES SET BY PROCESSOR ??
	STORE	S1,OBJDAT(P1),RO.ATR	;YES,,RESET THEM
	MOVEM	S2,OBJSCH(P1)		;   AND SAVE THE FLAG BITS
	MOVE	S1,RSU.CO(M)		;GET THE RESPONSE-2-SETUP CODE.
	CAXE	S1,%RSUDE		;OBJECT DOESN'T EXIST?
	JRST	RSET.2			;NO, TRY OTHERS

	;Here if the Object Does Not Exist.

	MOVX	S1,OBSSUP+OBSSIP	;GET OBJECT SETUP+IN PROGRESS BIT
	ANDCAM	S1,OBJSCH(P1)		;CLEAR IT (WE DONT SEND SHUTDOWN MSG)
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,S$SHUT		;SHUT DOWN THE OBJECT
	$RETT				;AND RETURN

RSET.2:	CAXE	S1,%RSUNA		;OBJECT NOT AVAIL NOW?
	$RETT				;NO,,JUST RETURN

	;Here if the Object is Not Available Right Now.

	MOVE	S2,P1			;GET THE OBJECT ADDRESS IN S2
	SKIPE	S1,P2			;CHECK AND LOAD THE IBM NODE DB ADDRESS
	PUSHJ	P,N$NOFF##		;IF IBM,,SET OFFLINE AND TELL THE WORLD
	MOVX	S1,OBSBUS+OBSSUP+OBSSIP+OBSSEJ ;GET LOTS OF BITS
	ANDCAM	S1,OBJSCH(P1)		;   AND CLEAR THEM
	MOVX	S1,OBSIGN		;GET IGNORE BIT.
	IORM	S1,OBJSCH(P1)		;AND TURN IT ON.
	MOVE	S1,P1			;GET THE OBJ ADDRESS.
	PUSHJ	P,A$OBST##		;UPDATE THE STATUS.
	SKIPE	S1,RSU.CD(M)		;DID HE SEND BACK A SPECIFIC STATUS CODE
	MOVEM	S1,OBJSTS(P1)		;YES,,SAVE IT
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PUSHJ	P,SETIGN		;ADD AN IGNORE ENTRY TO THE EVENT QUEUE
	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	PJRST	SHTINT			;RETURN THROUGH SHUTDOWN CODE
	SUBTTL	CHKTIM - ROUTINE TO GLANCE THROUGH THE EVENT QUEUE

	;CALL:	No Calling Args
	;
	;RET:	True Always

CHKTIM:	MOVE	S1,G$EVENT##		;GET THE EVENT QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JUMPF	.RETT			;NO MORE,,RETURN
	LOAD	S1,.EVUDT(S2)		;GET ITS UDT
	CAMLE	S1,G$NOW##		;TIME TO PROCESS IT ???
	JRST	[MOVEM S1,G$WTIM##	;SAVE THE NEW WAKE UP TIME
		 $RETT ]		;AND RETURN
	MOVE	S1,S2			;GET THE ENTRY ADDRESS IN S1
	PUSHJ	P,@.EVRTN(S2)		;GO OFF AND PROCESS THE EVENT
	MOVE	S1,G$EVENT##		;GET THE EVENT QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE ENTRY BACK
	PUSHJ	P,L%DENT		;DELETE IT
	JRST	CHKTIM			;AND GO TRY AGAIN

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	SUBTTL	S$AFTR - ROUTINE TO SCHEDULE A /AFTER EVENT

	;CALL:	S1/ The UDT to schedule
	;
	;RET:	True Always

	INTERN	S$AFTR			;GLOBALIZE IT

S$AFTR:	CAMG	S1,G$NOW##		;IN THE FUTURE ???
	JRST	[DOSCHD			;NO,,FORCE A SCHEDULING PASS
		 $RETT ]		;AND RETURN
	MOVEM	S1,G$MSG##+.EVUDT	;SAVE IT IN THE EVENT QUEUE ENTRY
	MOVX	S1,%EVAFT		;GET THE /AFTER ENTRY TYPE
	MOVEM	S1,G$MSG##+.EVTYP	;SAVE IT IN THE ENTRY
	MOVEI	S1,[DOSCHD		;GET THE PROCESSING ROUTINE
		    $RETT ]		;    ADDRESS
	CAIN	S2,.OTNOT		;Notification request?
	MOVEI	S1,[ SETOM G$NTFY##	 ;Get the processing routine
		     $RETT ]		 ;Address
	MOVEM	S1,G$MSG##+.EVRTN	;SAVE IT IN THE ENTRY
	MOVEI	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
	SUBTTL	S$EVENT - ROUTINE TO ADD AN ENTRY TO THE EVENT QUEUE

	;CALL:	S1/ The Entry Length
	;	S2/ The Entry Address
	;
	;RET:	True Always

	INTERN	S$EVENT			;MAKE IT GLOBAL

S$EVENT: PUSHJ	P,.SAVE3		;SAVE P1 AND P2 AND P3 FOR A SECOND
	DMOVE	P1,S1			;MOVE ARGS INTO P AC'S
	CAXGE	P1,.EVMSZ		;IS LENGTH VALID ???
	$STOP	(AIE,Attempt to Add Invalid Event Queue Entry)
	MOVE	P3,.EVUDT(P2)		;GET THE NEW ENTRY UDT
	CAMG	P3,G$NOW##		;MUST BE IN THE FUTURE !!
	PUSHJ	P,S..AIE		;NO,,DEEEEP TROUBLE !!!!
	MOVE	S1,G$EVENT##		;GET THE EVENT QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	EVEN.2			;JUMP THE FIRST TIME THROUGH

EVEN.1:	MOVE	S1,G$EVENT##		;GET THE EVENT QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT QUEUE ENTRY
EVEN.2:	JUMPF	[MOVE	S1,G$EVENT##	;NO MORE,,GET THE EVENT QUEUE ID
		 MOVE	S2,P1		;GET THE NEW ENTRY LENGTH
		 PUSHJ	P,L%CENT	;CREATE THE NEW ENTRY AFTER THE CURRENT
		 JRST	EVEN.3 ]	;AND CONTINUE
	CAML	P3,.EVUDT(S2)		;LESS THEN CURRENT ENTRY ???
	JRST	EVEN.1			;YES,,TRY NEXT ENTRY
	MOVE	S1,G$EVENT##		;GET THE EVENT QUEUE ID
	MOVE	S2,P1			;GET THE NEW ENTRY LENGTH
	PUSHJ	P,L%CBFR		;CREATE THE NEW ENTRY BEFORE THE CURRENT
EVEN.3:	SKIPT				;Did we get an entry successfully?
	PUSHJ	P,S..CCE##		;Stop if not
	HRL	S2,P2			;GET SOURCE,,DESTINATION
	ADDI	P1,0(S2)		;GET END ADDRESS
	BLT	S2,-1(P1)		;COPY NEW QUEUE ENTRY
	$RETT				;AND RETURN
	SUBTTL	MISC ROUTINES TO ADD ENTRIES TO THE EVENT QUEUE

	;SETIGN - ADD A IGNORE OBJECT ENTRY
	;
	;CALL:	S1/ THE OBJECT BLOCK ADDRESS
	;
	;RET:	True Always

SETIGN:	MOVE	S2,S1			;SAVE THE OBJ ADDRESS IN S2
	DMOVE	TF,OBJTYP(S2)		;GET OBJECT TYPE AND UNIT NUMBER
	DMOVEM	TF,G$MSG##+.EVMSZ	;SAVE IT IN THE ENTRY
	MOVE	S1,OBJNOD(S2)		;GET THE NODE NAME
	MOVEM	S1,G$MSG##+.EVMSZ+OBJ.ND ;SAVE IT IN THE ENTRY
	MOVX	S1,3			;GET IGNORE TIME (3 MINUTES)
	PUSHJ	P,A$AFT##		;GET TIME FOR FIRST CHECKPOINT
	MOVEM	S1,G$MSG##+.EVUDT	;SAVE IT IN THE ENTRY
	MOVEI	S1,IGNORE		;GET THE IGNORE ROUTINE ADDRESS
	MOVEM	S1,G$MSG##+.EVRTN	;SAVE IT IN THE ENTRY
	MOVX	S1,%EVIGN		;GET TYPE 'CHECKPOINT'
	MOVEM	S1,G$MSG##+.EVTYP	;SAVE IT IN THE ENTRY
	MOVX	S1,.EVMSZ+3		;GET THE ENTRY LENGTH
	MOVEI	S2,G$MSG##		;AND THE ENTRY ADDRESS
	PUSHJ	P,S$EVENT		;ADD IT TO THE EVENT QUEUE
	$RETT				;RETURN
	SUBTTL	EVENT QUEUE ACTION ROUTINES


	;ROUTINE - IGNORE (CLEAR IGNORE BITS FOR AN OBJECT)
	;
	;RETURNS TRUE

IGNORE: MOVEI	S1,.EVMSZ(S1)		;POINT TO THE OBJECT BLOCK
	PUSHJ	P,A$FOBJ##		;FIND IT IN OUR DATA BASE
	JUMPF	.RETT			;NOT THERE,,RETURN
	ZERO	OBJSCH(S1),OBSIGN	;CLEAR THE IGNORE BIT
	DOSCHD				;FORCE A SCHEDULING PASS
	$RETT				;AND RETURN
	SUBTTL	CHKOBJ - ROUTINE TO CHK OBJECTS AND SHUT THEM DOWN IF NECESSARY

	;CALL:	P1/ OBJECT ADDRESS
	;
	;RET:	TRUE ALWAYS

CHKOBJ:	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1
	MOVE	S2,OBJSCH(P1)		;GET SCHEDULING BITS
	TXNE	S2,OBSFRM		;FORMS CHANGE REQUIRED ???
	PUSHJ	P,A$FRMC##		;YES,,DO IT
	LOAD	S1,OBJSCH(P1),OBSINT	;WANT AN INTERNAL SHUTDOWN ???
	JUMPN	S1,CHKO.1		;YES,,LETS DO IT !!!
	MOVE	S1,OBJNOD(P1)		;GET THE NODE NAME/NUMBER
	PUSHJ	P,N$NODE##		;FIND THE NODE IN OUR DATA BASE
	MOVE	S2,NETSTS(S2)		;GET THE NODE STATUS BITS
	TXNE	S2,NETIBM!NETSNA	;IS THIS AN IBM TYPE NODE ???
	$RETT				;YES,,NO INTERNAL SHUTDOWN
	PUSHJ	P,N$LOCL##		;SEE IF IT IS THE CENTRAL SITE.
	JUMPT	.RETT			;IF SO,,NO SHUTDOWN
CHKO.1:	MOVE	S1,P1			;GET THE OBJECT ADDRESS IN S1.
	PUSHJ	P,SHTINT		;SHUT DOWN THE OBJECT
	MOVX	S1,OBSSUP+OBSBUS+OBSSEJ+OBSSIP+OBSINT ;GET LOTS OF BITS
	ANDCAM	S1,OBJSCH(P1)		;AND CLEAR THEM
	MOVX	S1,OBSIGN+OBSHUT	;GET THE IGNORE+SHUTDOWN BIT
	IORM	S1,OBJSCH(P1)		;AND SET IT
	MOVE	S1,P1			;GET THE OBJECT ADDRESS
	PUSHJ	P,A$OBST##		;UPDATE THE OBJECT STATUS
	$RETT				;RETURN
SUBTTL	Queue Dependent Functions

;The functions which vary from queue to queue are handled via a
;	'scheduling vector' associated with each queue.  The address
;	of this vector is part of the queue header.  A queue dependent
;	routine is called by:

;	load arguments in correct ACs
;	LOAD	xx,<HDRyyy+.QHPAG>,QH.SCH
;	PUSHJ	P,disp(xx)

;The entries are (not in order):

; SCHLNK	called by everybody to link an entry into a queue
;	call:	AP/ address of entry
;		H/  address of queue header


; SCHFJB	called by scheduler (S$SCHD) to find a job for an object
;	call:	S1/ address of OBJ entry
;	T rtn:	S1/  address of available .QE
;	F rtn:	no jobs available for the object


; SCHDEF	called by Q$CREATE to fill in defaults in CREATE message
;	call:	M/  address of CREATE message


; SCHMOD	call by Q$MODIFY to do modify queue dependent parameters
;	call:	S1/  address of group header
;		AP/  address of request (.EQ)


; SCHSCH	called by the scheduler (S$SCHD) to actually schedule and
;		interlock a job on an OBJECT.
;	call:	S1/  address of the queue request
;		S2/  address of the OBJ entry


; SCHRJI	called by Q$RELEASE, Q$REQUEUE, KILPSB (in QSRADM) to clean up
;		a job-OBJECT interlock.
;	call:	AP/  address of request being un-interlocked
SUBTTL	INP  --  Input queue dependent functions


;The INP queue scheduler vector
S$INPT:: JRST	INPLNK			;LINK IN A NEW ENTRY
	JRST	INPSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	INPDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	INPMOD			;MODIFY INP PARAMETERS
	JRST	INPRJI			;RELEASE JOB INTERLOCK
	JRST	INPFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

INPLNK:	GETLIM	S1,.QELIM(AP),TIME	;GET /TIME PARAMETER
	GETLIM	S2,.QELIM(AP),DEPN	;GET /DEPEND
	SKIPE	S2			;IS THERE A DEPENDENCY?
	HRLOI	S1,777			;YES, MAKE IT LOOK BAD
	MOVEI	S2,^D10			;LOAD AGING FACTOR
	JRST	LNKPRI			;AND LINK IT IN

INPSCH:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	DMOVE	P1,S1			;SAVE THE .QE AND OBJ ADDRESSES
	MOVE	S1,OBJNOD(P2)		;GET THE PROCESSING NODE
	PUSHJ	P,N$LOCL##		;IS IT THE HOST STATION ???
	JUMPF	INPS.1			;NO,,CONTINUE
	LOAD	S1,OBJDAT(P2),RO.ATR	;GET THE OBJECT ATTRIBUTES
	CAXE	S1,%GENRC		;IS IT GENERIC ???
	JRST	INPS.1			;NO,,NO UNIQUE CHECK
	MOVE	AP,P1			;PUT REQUEST ADDRESS IN AP
	LOAD	S1,OBJUNI(P2)		;GET 'STREAM NUMBER' IN S1
	PUSHJ	P,I$UQST##		;SET THE UNIQNESS ENTRY
INPS.1:	DMOVE	S1,P1			;GET ARGS BACK
	PJRST	NEXTJB			;SEND THE NEXTJOB AND RETURN


INPRJI:	PUSHJ	P,.SAVE1		;SAVE P1
	LOAD	P1,.QEOBJ(AP)		;GET ADDRESS OF OBJECT
	MOVE	S1,OBJNOD(P1)		;GET THE PROCESSING NODE
	PUSHJ	P,N$LOCL##		;IS IT THE HOST STATION ???
	JUMPF	JOBDUN			;NO,,JUST FINISH UP
	LOAD	S1,OBJDAT(P1),RO.ATR	;GET THE OBJECT ATTRIBUTES
	CAXE	S1,%GENRC		;IS IT GENERIC ???
	JRST	JOBDUN			;NO,,JUST FINISH UP
	LOAD	S1,OBJUNI(P1)		;GET UNIT NUMBER
	PUSHJ	P,I$UQCL##		;CLEAR IT
	PJRST	JOBDUN			;AND FINISH UP
INPFJB:	PUSHJ	P,.SAVE4		;SAVE P1-P4
	MOVE	P1,S1			;COPY OBJ ADR INTO P1
	LOAD	P4,HDRINP##+.QHLNK,QH.PTF  ;POINT TO THE FIRST ENTRY

INPF.1:	JUMPE	P4,.RETF		;NO JOBS, JUST RETURN
	MOVE	S1,OBJNOD(P1)		;GET THE PROCESSING NODE
	PUSHJ	P,N$LOCL##		;IS IT THE LOCAL STATION?
	  SKIPF				;NO - TRY TO SCHEDULE THE JOB
	SKIPE	G$LOGN##		;BATCH LOGINS ALLOWED?
	SKIPA				;YES - TRY TO SCHEDULE THE JOB
	JRST	INPF.4			;TRY ANOTHER REQUEST
	MOVE	S1,P4			;GET THE .QE ADDRESS IN S1
	PUSHJ	P,I$RALC##		;SCAN FOR SCHEDULABILITY !!!
	JUMPF	INPF.4			;DID NOT MEET OUR RIGID STANDARDS,,SKIP
	MOVEI	S1,.QEROB(P4)		;GET THIS JOBS REQUESTED OBJ BLK ADDR
	MOVE	S2,P1			;GET THE OBJECT ADDRESS IN S2
	PUSHJ	P,N$CSTN##		;CONVERT FOR ROUTING.
	JUMPF	INPF.4			;NO GOOD FOR THIS OBJECT,,TRY NEXT
	LOAD	S2,.QESEQ(P4),QE.PRI	;GET EXTERNAL PRIORITY
	LOAD	P2,OBJPRM+.OBPRI(P1),OBPMIN  ;GET MINIMUM
	LOAD	P3,OBJPRM+.OBPRI(P1),OBPMAX  ;GET MAXIMUM
	CAML	S2,P2			;GREATER THAN MIN?
	CAMLE	S2,P3			;LESS THAN MAX?
	JRST	INPF.4			;NO, LOSE
	GETLIM	S1,.QELIM(P4),TIME	;GET TIME LIMIT IN SECONDS.
	ADDI	S1,^D59			;FORCE ROUND UP TO NEXT MINUTE
	IDIVI	S1,^D60			;CALC TIME LIMIT IN MINUTES.
	LOAD	P2,OBJPRM+.OBTIM(P1),OBPMIN  ;GET MIN
	LOAD	P3,OBJPRM+.OBTIM(P1),OBPMAX  ;GET MAX
	CAML	S1,P2			;GREATER THAN MIN?
	CAMLE	S1,P3			;AND LESS THAN MAX?
	JRST	INPF.4			;NO, LOSE

INPF.2:	GETLIM	S2,.QELIM(P4),OINT	;GET QUEUE ENTRY INTRVN BITS
	CAIE	S2,.OPINY		; Does he require opr intervention?
	 SKIPN	G$QUEUE##		; And are the queues disabled?
	  TRNA				; None of that, he wins
	   JRST	INPF.4			; Lose for now
	LOAD	S1,OBJPRM+.OBFLG(P1),.OPRIN ;GET OBJECT'S INTRVN BITS
	CAME	S1,S2			;MUST BE THE SAME..
	CAIN	S1,.OPINY		;   OR OBJECT MUST BE OPR INTRVN ALLOWD
	SKIPA				;IF EITHER OF THE ABOVE HE WINS !!
	JRST	INPF.4			;ELSE THIS QUEUE ENTRY LOSES !!!

IFN INPCOR,<
	GETLIM	S2,.QELIM(P4),CORE	;GET /CORE SWITCH
	LOAD	P2,OBJPRM+.OBCOR(P1),OBPMIN  ;GET MIN
	LOAD	P3,OBJPRM+.OBCOR(P1),OBPMAX  ;GET MAX
	CAML	S2,P2			;CHECK THE RANGE
	CAMLE	S2,P3			;TO SEE IF IT WILL FIT
	JRST	INPF.4			;GUESS NOT
	CAMLE	S2,G$XCOR##		;IS IT LESS THAN CORMAX?
	JRST	INPF.4			;NO, LOSE
>  ;END IFN INPCOR

INPF.3:	MOVE	S1,P4			;LOAD THE WINNER
	$RETT				;AND RETURN

INPF.4:	LOAD	P4,.QELNK(P4),QE.PTN	;GET THE NEXT
	JRST	INPF.1			;AND LOOP
	SUBTTL	S$INPS - Routine to check the schedulability of a batch request

	;CALL:	S1/ The .QE address
	;
	;RET:	True if OK to schedule, False otherwise

S$INPS::
	$SAVE	<AP>			;Save AP
	MOVE	AP,S1			;Save the QE address
	SKIPE	.QEOBJ(AP)		;Are we already running ???
	$RETT				;Yes, return good
	LOAD	S1,.QESEQ(AP),QE.HBO	;In operator hold ???
	JUMPN	S1,.RETF		;Yes,,return now
	MOVE	S1,.QECRE(AP)		;Get the request creation time
	GETLIM	S2,.QELIM(AP),DEPN	;Get the dependancy count
	SKIPG	S2			;If dependancy count greater then 0,,
	CAMLE	S1,G$NOW##		;     or /AFTER is set,,
	$RETF				;	then return now !!!

TOPS10	<
	SKIPE	G$MDA##			;Only TOPS10 can do this right
	JRST	INPX.1			; But only if MDA is turned on
>
	PUSHJ	P,Q$CDEP##		;Evaluate dependencies
	JUMPF	.RETF			;Lose,,return now

INPX.1:	MOVE	S1,.QEROB+.ROBND(AP)	;Get the node ID
	PUSHJ	P,N$LOCL##		;For a remote processor ???
	JUMPF	INPX.2			;Yes,,check for locked structure
	PUSHJ	P,I$UQCH##		;See if we can run this one
	JUMPF	.RETF			;No,,return now
	GETLIM	S2,.QELIM(AP),TIME	;Get the time limit in seconds
	SKIPE	G$KSYS##		;Check # of seconds till KSYS
	CAMGE	S2,G$KSYS##		;Is runtime less then time till KSYS
	SKIPA				;Win,,continue
	$RETF				;Lose,,return

INPX.2:	MOVE	S1,AP			;Get the QE address in S1
	SKIPE	AP,.QEMDR(AP)		;Check and load the MDR address
	PJRST	I$CHKL##		;Have one,,return checking pending locks
	$RETT				;No MDR,,return OK
	SUBTTL	INPDEF - ROUTINE TO DEFAULT THE BATCH EQ ENTRY

	;CALL:	M/ Create Msg Address
	;
	;RET:	True Always

INPDEF:	MOVE	S1,G$LNAM##		;GET OUR CENTRAL SITE NODE ID
	SKIPN	.EQROB+.ROBND(M)	;DID HE SPECIFY A PROCESSING NODE ???
	MOVEM	S1,.EQROB+.ROBND(M)	;NO,,SAVE CENTRAL SITE ID
	ZERO	.EQROB+.ROBAT(M),RO.UNI	;MAKE SURE THAT IS NO UNIT SPECIFIED
	PUSHJ	P,EQDFLT		  ;DEFAULT THE EQ
TOPS10<	PUSHJ	P,RENDEF>		;PROCESS /DISPOSE:RENAME REQUESTS
	PDFALT	S1,.EQLIM(M),OUTP,INPLOG  ;SET DEFAULT /OUTPUT:
	PDFALT	S1,.EQLIM(M),UNIQ,%EQUYE  ;SET DEFAULT /UNIQUE:YES
	PDFALT	S1,.EQLIM(M),REST,%EQRNO  ;SET DEFAULT /RESTART:NO
	PDFALT	S1,.EQLIM(M),TIME,INPTIM  ;SET DEFAULT TIME VALUE
	PDFALT	S1,.EQLIM(M),SLPT,INPPGS  ;SET DEFAULT PAGE VALUE
	PDFALT	S1,.EQLIM(M),SCDP,INPCDS  ;SET DEFAULT CARD VALUE
	PDFALT	S1,.EQLIM(M),SPTP,INPPTP  ;SET DEFAULT PAPER TAPE VALUE
	PDFALT	S1,.EQLIM(M),SPLT,INPPLT  ;SET DEFAULT PLOTTER VALUE
	PDFALT	S1,.EQLIM(M),OINT,.OPINY  ;OPERATOR INTERVENTION REQUIRED
	PDFALT	S1,.EQLIM(M),BLOG,%BAPND  ;SET DEFAULT BATCH LOG TYPE
	GETLIM	S1,.EQLIM(M),ONOD	;GET OUTPUT NODE NUMBER
	SKIPN	S1			;HE SET IT, SO SKIP THIS
	PUSHJ	P,I$ONOD##		;NOT SET,,GO DEFAULT IT
	GETLIM	S1,.EQLIM(M),CORE	;GET /CORE VALUE
	SKIPN	S1			;IS THERE ONE?
	MOVX	S1,INPCOR		;NO, USE DEFAULT
	CAMGE	S1,G$MCOR##		;IS IT GREATER THAN MINIMUM
	MOVE	S1,G$MCOR##		;NO, GET MINIMUM
	STOLIM	S1,.EQLIM(M),CORE	;NO, SET TO SYSTEM MINIMUM
	LOAD	S1,.EQSPC(M),EQ.NUM	;GET NUMBER OF FILES IN REQUEST
	GETLIM	T1,.EQLIM(M),BLOG	;GET THE LOG FILE TYPE
	CAIE	T1,%BSPOL		;IS IT A SPOOLED LOG FILE,
	CAIG	S1,1			;   OR IS THERE NO LOG FILE ???
	SKIPA				;YES TO EITHER,,SKIP
	$RETT				;ELSE RETURN
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,M			;GET ADDRESS OF THE EQ
	LOAD	S2,.EQLEN(P1),EQ.LOH	;GET LENGTH OF THE HEADER
	ADD	P1,S2			;POINT TO FIRST FP
	LOAD	S2,.FPLEN(P1),FP.LEN	;GET LENGTH OF THE FP
	ADD	P1,S2			;POINT TO THE FD
	LOAD	S2,.FDLEN(P1),FD.LEN	;GET FD LENGTH
	ADD	P1,S2			;HERE'S WHERE WE PUT THE NEXT FP
	MOVE	S1,P1			;GET THE NEXT FILE-SPEC ADDR IN S2
	SUB	S1,M			;CALC THE REAL MESSAGE LENGTH
	STORE	S1,.MSTYP(M),MS.CNT	;AND SAVE IT IN THE MESSAGE
	MOVEI	S1,2			;GET THE FILE COUNT
	STORE	S1,.EQSPC(M),EQ.NUM	;SAVE IT IN THE MESSAGE
	MOVEI	S1,FPMSIZ		;GET THE FP SIZE
	STORE	S1,.FPLEN(P1),FP.LEN	;STORE IT
	MOVEI	S1,1			;GET THE STARTING POINT
	STORE	S1,.FPFST(P1)		;STORE IT

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

	MOVX	S1,FP.FLG		;GET THE LOG FLAG BIT
	CAIE	T1,%BSPOL		;IS IT A SPOOLED FILE ???
	JRST	INPD.1			;NO,,SKIP THIS 'SPOOL' ONLY CODE
	MOVX	S2,EQ.SPL		;GET "SPOOLED FILES HERE" BIT
	IORM	S2,.EQSEQ(M)		;   THEN STORE IT
	TXO	S1,FP.SPL+FP.DEL	;ADD 'SPOOL+DELETE' TO FP INFO

INPD.1:	STORE	S1,.FPINF(P1)		;STORE THE FP FLAGS
	MOVE	S2,P1			;GET THE FP ADDRESS IN S2
	ADDI	P1,FPMSIZ		;POINT TO THE FD
	MOVE	S1,P1			;GET THE FD ADDRESS IN S1
	PUSHJ	P,I$LGFD##		;GENERATE THE LOG FILE FD
	LOAD	S2,.MSTYP(M),MS.CNT	;GET MESSAGE LENGTH
	ADDI	S2,FPMSIZ		;ADD THE FP SIZE
	LOAD	S1,.FDLEN(P1),FD.LEN	;GET THE FD SIZE
	ADD	S2,S1			;ADD IT IN
	STORE	S2,.MSTYP(M),MS.CNT	;STORE THE MESSAGE LENGTH AWAY
	$RETT				;AND RETURN
;ROUTINE TO DO INP QUEUE SPECIFIC REQUEST MODIFICATION

INPMOD:	PUSHJ	P,.SAVE4		;SAVE A FEW REGS FIRST
	LOAD	P1,MOD.GN(S1),MODGLN	;NUMBER OF GROUP 1 ELEMENTS
	SOJLE	P1,.RETT		;0 IS ACCEPTABLE, ADJUST FOR THE LOOP
	CAILE	P1,NINPPM		;MORE THAN CURRENTLY IMPLEMENTED
	MOVEI	P1,NINPPM		;YES, USE ONLY THE KNOWN VALUES
	MOVNS	P1			;NEGATE IT
	HRLZS	P1			;P1 = AOBJN POINTER
	MOVEI	P2,MOD.GE(S1)		;POINT TO FIRST GROUP ELEMENT
INPM.1:	MOVE	P3,0(P2)		;GET AN ELEMENT
	CAME	P3,[-1]			;DID IT CHANGE
	XCT	INPMTB(P1)		;YES, STORE NEW VALUE
	INCR	P2			;TO NEXT ELEMENT
	AOBJN	P1,INPM.1		;GET THEM ALL
	$RETT				;RETURN TO Q$MODIFY FOR NEXT GROUP

INPMTB:	STOLIM	P3,.EQLIM(AP),CORE	; 0 = /CORE
	STOLIM	P3,.EQLIM(AP),TIME	; 1 = /TIME
	STOLIM	P3,.EQLIM(AP),SLPT	; 2 = /PAGES
	STOLIM	P3,.EQLIM(AP),SCDP	; 4 = /CARDS
	STOLIM	P3,.EQLIM(AP),SPTP	; 4 = /FEET
	STOLIM	P3,.EQLIM(AP),SPLT	; 5 = /TPLOT
	PUSHJ	P,MODDEP		; 6 = /DEPENDENCY
	STOLIM	P3,.EQLIM(AP),UNIQ	; 7 = /UNIQUE
	STOLIM	P3,.EQLIM(AP),REST	; 8 = /RESTART
	STOLIM	P3,.EQLIM(AP),OUTP	; 9 = /OUTPUT
	STOLIM	P3,.EQLIM(AP),ONOD	;10 = /DESTINATION NODE
	PUSHJ	P,MODBEG		;11 = /BEGIN

NINPPM==<.-INPMTB>			;NUMBER CURRENTLY IMPLEMENTED

MODDEP:	HLRZ	P4,P3			;GET CHANGE TYPE
	HRRZS	P3			;CLEAR THE CHANGE TYPE
	CAIN	P4,.MODAB		;ABSOLUTE CHANGE
	JRST	MODD.2			;YES, GO STORE IT
	CAIN	P4,.MODPL		;ADDITIVE
	JRST	MODD.1			;YES, GO ADD THEM TOGETHER
	CAIE	P4,.MODMI		;SUBTRACTIVE
	$RETT				;NO, DON'T STORE FOR UNKNOWN TYPE
	MOVNS	P3			;SUBTRACTING, NEGATE THE VALUE
MODD.1:	GETLIM	P4,.EQLIM(AP),DEPN	;GET OLD VALUE
	ADDB	P3,P4			;ADD (OR SUBTRACT) THEM
	SKIPGE	P3			;DON'T LET IT GO NEGATIVE
	ZERO	P3			;IT DID, MAKE IT ZERO
	CAILE	P3,177777		;OR DON'T LET IT GET TOO BIG
	MOVEI	P3,177777		;IT DID, SET TO MAXIMUM
MODD.2:	STOLIM	P3,.EQLIM(AP),DEPN	;STORE NEW (OR ADJUSTED) VALUE
	$RETT				;RETURN FOR NEXT

MODBEG:	LOAD	P4,.EQLEN(AP),EQ.LOH	;GET LENGTH OF HEADER
	ADD	P4,AP			;GET ADDRESS OF FIRST FP
	STORE	P3,.FPFST(P4)		;STORE THE /BEGIN IN CTL FP
	$RETT				;AND RETURN
	SUBTTL	S$INRL - ROUTINE TO PROCESS BATCH RELEASE MESSAGES

;This routine is called by Q$RELEASE to process the special extended RELEASE
;	 message for INP jobs.

;Call:	M  = THE RELEASE MESSAGE
;	AP = ENTRY BEING RELEASED (.QExxx)

S$INRL:: PUSHJ	P,.SAVE1		;SAVE P1
	PUSHJ	P,.SAVET		;SAVE T1 THRU T4
	$SAVE	AP			;SAVE AP
	$SAVE	M			;SAVE M
	LOAD	P1,.MSTYP(M),MS.CNT	;GET LENGTH OF RELEASE MESSAGE
	SUBI	P1,REL.SZ		;EXPECT A LONG ONE FROM BATCON
	JUMPLE	P1,.RETT		;NOT FROM BATCON (OR A BUG IN BATCON)
	STORE	AP,<BATLGO+CLM.JB>,CL.BQE  ;SAVE THE BATCH QUEUE ENTRY ADDRESS
	LOAD	T2,REL.BJ(M),RL.JOB	;GET BATCH JOB NUMBER
	STORE	T2,<BATLGO+CLM.JB>,CL.JOB ;SAVE FOR EVENTUAL FAKE LOGOUT
	SOJE	P1,BJLOGO		;ADJUST P1, JUMP IF WAS /OUTPUT:0
	CAIGE	P1,FDMSIZ		;MESSAGE TOO SMALL
	  JRST	BJLOGO			;ANOTHER BUG IN BATCON
	MOVEI	T1,BATSPL		;POINT TO 'MY' CANONICAL SPOOL MESSAGE
	STORE	T2,CSM.JB(T1),CS.JOB	;STORE JOB NUMBER, CLEAR THE REST
	ZERO	CSM.JB(T1),CS.FLG	;NO FLAGS HERE
	MOVX	S1,.OTLPT		;GET DEVICE LPT
	STORE	S1,CSM.RO+.ROBTY(T1)	;STORE IN THE CSM
	GETLIM	S1,.QELIM(AP),ONOD	;GET OUTPUT NODE
	STORE	S1,CSM.RO+.ROBND(T1)	;AND STORE IT
	MOVE	T2,.QEOID(AP)		;GET OWNER ID
	STORE	T2,CSM.OI(T1)		;SAVE THAT
	PUSHJ	P,I$QESM##		;MOVE SYS DEPENDANT INFO FROM QE TO CSM
	MOVEI	S1,REL.FD(M)		;POINT TO THE LOG FILE FD AREA
	LOAD	S2,.FDLEN(S1),FD.LEN	;GET THE FD LENGTH
	CAME	S2,P1			;THE RIGHT LENGTH?
	JRST	BJLOGO			;NO, LOSE
	STORE	S1,CSM.FD(T1),CS.FDA	;SAVE FOR Q$INCL
	PUSHJ	P,Q$FSPL##		;FIND MATCHING SPOOL REQUEST
	MOVX	T2,FP.FLG		;GET THE LOG FILE FLAG
	LOAD	S1,REL.BJ(M)		;GET RELEASE INFO WORD
	TXNE	S1,RL.DLG		;/DISP:DELETE
	TXO	T2,FP.DEL		;YES, SET THE DELETE BIT
	TXNE	S1,RL.SPL		;IS THE LOG FILE SPOOLED?
	TXO	T2,FP.SPL		;YES, SET THE SPOOLED BIT
	MOVEM	T2,CSM.FP(T1)		;STORE THE FLAG SETTINGS
	PUSHJ	P,Q$INCL##		;INCLUDE THE LOG FILE
	MOVE	S1,AP			;GET THE ADDRESS INTO S1
	PUSHJ	P,F$WRRQ##		;SAVE THE REQUEST
	LOAD	S2,SPLJOB(E),SPYDPA	;GET THE OLD DPA
	STORE	S1,SPLJOB(E),SPYDPA	;STORE NEW RETREIVAL POINTER

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

	SKIPE	S1,S2			;GET OLD DPA IF THERE IS ONE
	  PUSHJ	P,F$RLRQ##		;AND RELEASE OLD FAILSOFT COPY
	MOVE	S1,AP			;COPY THE PAGE OVER
	PUSHJ	P,M%RPAG		;RELEASE OLD COPY
BJLOGO:	MOVEI	M,BATLGO		;POINT TO THE LOGOUT BLOCK
	MOVX	S1,.QIFNC		;GET THE INTERNAL FLAG
	IORM	S1,.MSTYP(M)		;INDICATE BATCH CALL TO LOGOUT
	PJRST	Q$LOGOUT##		;FAKE A LOGOUT MESSAGE

BATSPL:	BLOCK	CSMSIZ			;ARGUMENT BLOCK FOR Q$FSPL, Q$INCL
BATLGO: BLOCK	CLMSIZ			;LOGOUT BLOCK
	SUBTTL	S$REQU - ROUTINE TO PROCESS BATCH REQUEUE MESSAGES

;This routine is called by Q$REQUEUE to generate a fake LOGOUT
;  so that spooled files generated before the REQUEUE will be
;    printed now.

;Call:	AP = ENTRY BEING REQUEUED (.QExxx)
;Ret:	True Through Q$LOGOUT

	INTERN	S$REQU			;MAKE IT GLOBAL

S$REQU:	$SAVE	AP			;SAVE AP ACROSS THE Q$LOGOUT CALL
	$SAVE	M			;SAVE M  ACROSS THE Q$LOGOUT CALL
	MOVEI	M,BATLGO		;GET THE LOGOUT MESSAGE ADDRESS
	LOAD	S1,.QEJBN(AP),QE.BJN	;GET THE BATCH JOB NUMBER
	JUMPE	S1,.RETT		;NONE THERE,,JUST RETURN
	STORE	S1,CLM.JB(M),CL.JOB	;SAVE THE JOB NBR IN THE LOGOUT MSG
	STORE	AP,CLM.JB(M),CL.BQE	;SAVE THE BATCH QE ENTRY ADDRESS
	MOVX	S1,.QIFNC		;GET THE INTERNAL FUNCTION BIT
	STORE	S1,.MSTYP(M)		;SAVE IT IN THE LOGOUT MSG
	PJRST	Q$LOGOUT##		;LEAVE THROUGH Q$LOGOUT
SUBTTL	LPT  --  Lineprinter queue dependent functions

;The LPT queue scheduler vector
S$LPT::	JRST	LPTLNK			;LINK IN A NEW ENTRY
	JRST	LPTSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	LPTDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	LPTMOD			;MODIFY LPT PARAMETERS
	JRST	LPTRJI			;RELEASE A JOB INTERLOCK
	JRST	LPTFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

LPTLNK:	GETLIM	S1,.QELIM(AP),OLIM	;GET OUTPUT LIMIT
	MOVEI	S2,^D60			;AND AGING FACTOR
	PJRST	LNKPRI			;AND LINK IT IN

LPTMOD:	JRST	OUTMOD			;MODIFY IS SAME FOR ALL OUTPUT QUEUES

LPTSCH:	JRST	NEXTJB			;JUST SEND A NEXTJOB MESSAGE

LPTRJI:	JRST	JOBDUN			;USE COMMON ROUTINE TO CLEAN UP
LPTFJB:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE OBJ ADDRESS IN P1
	LOAD	P2,HDRLPT##+.QHLNK,QH.PTF  ;GET FIRST ITEM IN THE QUEUE

LPTF.1:	JUMPE	P2,.RETF		;FAIL IF NO JOBS
	MOVX	S1,LPTARF		;LOAD ARF VALUE
	MOVX	S2,LPTKTL		;LOAD KTL VALUE
	MOVE	T1,P2			;GET QE ADDRESS
	PUSHJ	P,OUTKSYS		;CHECK LIMITS BASED ON KSYS
	  JUMPF	LPTF.2			;NOT THIS JOB
	MOVE	S1,P2			;COPY OVER THE REQUEST ADDRESS
	MOVE	S2,P1			;PUT OBJ ADR INTO S2
	PUSHJ	P,OUTFJB		;RUN THRU SOME COMMON CODE
	JUMPT	.RETT			;WIN IF HE DID

LPTF.2:	LOAD	P2,.QELNK(P2),QE.PTN	;GET NEXT
	JRST	LPTF.1			;AND LOOP

LPTDEF:	MOVX	S1,LPTDIV		;GET THE PER DISKBLK DIVISOR
	MOVX	S2,LPTMUL		;GET THE PER DSIKBLK MULTIPLIER
	MOVX	T1,INPPGS		;GET THE DEFAULT LIMIT
	PUSHJ	P,OUTDEF		;USE SOME COMMON CODE
	LOAD	S1,.EQSPC(M),EQ.NUM	;GET NUMBER OF FILES
	LOAD	S2,.EQLEN(M),EQ.LOH	;GET LENGTH OF HEADER
	ADDI	S2,(M)			;POINT TO FIRST FP
	PUSH	P,P1			;SAVE P1

LPTD.1:	VDFALT	P1,.FPINF(S2),FP.FFF,.FPFAS	;DEFAULT /FILE:ASCII
	VDFALT	P1,.FPINF(S2),FP.FPF,%FPLAS	;DEFAULT /PRINT:ASCII
	VDFALT	P1,.FPINF(S2),FP.FCY,1		;DEFAULT /COPIES:1
	VDFALT	P1,.FPINF(S2),FP.FSP,1		;DEFAULT /SPACE:SINGLE
	VDFALT	P1,.FPFST(S2),,1		;DEFAULT /BEGIN:1
	LOAD	P1,.FPLEN(S2),FP.LEN	;GET LENGTH OF THE FP
	ADD	S2,P1			;POINT TO THE FD
	LOAD	P1,.FDLEN(S2),FD.LEN	;GET LENGTH OF THE FD
	ADD	S2,P1			;POINT TO THE NEXT FP
	SOJG	S1,LPTD.1		;AND LOOP

	POP	P,P1			;RESTORE P1
	$RETT				;AND RETURN
SUBTTL	CDP  --  Card-punch queue dependent functions

;The CDP queue scheduler vector

S$IBM::					;SCHEDULE IBM QUEUE SAME AS CDP QUEUE
S$CDP::	JRST	CDPLNK			;LINK IN A NEW JOB
	JRST	CDPSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	CDPDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	CDPMOD			;MODIFY CDP PARAMETERS
	JRST	CDPRJI			;RELEASE A JOB INTERLOCK
	JRST	CDPFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

CDPDEF:	MOVX	S1,CDPDIV		;GET THE PER DISKBLK DIVISOR
	MOVX	S2,CDPMUL		;GET THE PER DISKBLK MULTIPLIER
	MOVX	T1,INPCDS		;GET THE DEAFULT LIMIT
	JRST	OUTDEF			;AND USE COMMON CODE

CDPLNK:	GETLIM	S1,.QELIM(AP),OLIM	;GET OUTPUT LIMIT
	MOVEI	S2,^D60			;AND AGING FACTOR
	PJRST	LNKPRI			;AND LINK IT IN

CDPMOD:	JRST	OUTMOD			;MODIFY IS SAME FOR ALL OUTPUT QUEUES

CDPSCH:	JRST	NEXTJB			;SEND A NEXTJOB MESSAGE

CDPRJI:	JRST	JOBDUN			;COMMON CLEANUP ROUTINE

CDPFJB:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE OBJ ADDRESS IN P1
	LOAD	P2,HDRCDP##+.QHLNK,QH.PTF  ;GET FIRST ITEM IN THE QUEUE

CDPF.1:	JUMPE	P2,.RETF		;FAIL IF NO JOBS
	MOVX	S1,CDPARF		;LOAD ARF VALUE
	MOVX	S2,CDPKTL		;LOAD KTL VALUE
	MOVE	T1,P2			;GET QE ADDRESS
	PUSHJ	P,OUTKSYS		;CHECK LIMITS BASED ON KSYS
	  JUMPF	CDPF.2			;NOT THIS JOB
	MOVE	S1,P2			;COPY OVER THE REQUEST ADDRESS
	MOVE	S2,P1			;PUT OBJ ADR INTO S2
	PUSHJ	P,OUTFJB		;RUN THRU SOME COMMON CODE
	JUMPT	.RETT			;WIN IF HE DID

CDPF.2:	LOAD	P2,.QELNK(P2),QE.PTN	;GET NEXT
	JRST	CDPF.1			;AND LOOP
SUBTTL	PTP  --  Papertape punch queue dependent functions

;The PTP queue scheduler vector
S$PTP::	JRST	PTPLNK			;LINK IN A NEW JOB
	JRST	PTPSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	PTPDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	PTPMOD			;MODIFY PTP PARAMETERS
	JRST	PTPRJI			;RELEASE A JOB INTERLOCK
	JRST	PTPFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

PTPLNK:	GETLIM	S1,.QELIM(AP),OLIM	;GET OUTPUT LIMIT
	MOVEI	S2,^D60			;AND AGING FACTOR
	PJRST	LNKPRI			;AND LINK IT IN

PTPDEF:	MOVX	S1,PTPDIV		;GET THE PER DISKBLK DIVISOR
	MOVX	S2,PTPMUL		;GET THE PER DISKBLK MULTIPLIER
	MOVX	T1,INPPTP		;GET THE DEFAULT LIMIT
	JRST	OUTDEF			;AND USE COMMON CODE

PTPMOD:	JRST	OUTMOD			;OUTPUT IS SAME FOR ALL OUTPUT QUEUES

PTPSCH:	JRST	NEXTJB			;SEND NEXTJOB MESSAGE

PTPRJI:	JRST	JOBDUN			;CLEANUP AFTERWARDS

PTPFJB:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE OBJ ADDRESS IN P1
	LOAD	P2,HDRPTP##+.QHLNK,QH.PTF  ;GET FIRST ITEM IN THE QUEUE

PTPF.1:	JUMPE	P2,.RETF		;FAIL IF NO JOBS
	MOVX	S1,PTPARF		;LOAD ARF VALUE
	MOVX	S2,PTPKTL		;LOAD KTL VALUE
	MOVE	T1,P2			;GET QE ADDRESS
	PUSHJ	P,OUTKSYS		;CHECK LIMITS BASED ON KSYS
	  JUMPF	PTPF.2			;NOT THIS JOB
	MOVE	S1,P2			;COPY OVER THE REQUEST ADDRESS
	MOVE	S2,P1			;PUT OBJ ADR INTO S2
	PUSHJ	P,OUTFJB		;RUN THRU SOME COMMON CODE
	JUMPT	.RETT			;WIN IF HE DID

PTPF.2:	LOAD	P2,.QELNK(P2),QE.PTN	;GET NEXT
	JRST	PTPF.1			;AND LOOP
SUBTTL	PLT  --  Plotter queue dependent functions

;The PLT queue scheduler vector
S$PLT::	JRST	PLTLNK			;LINK IN A NEW JOB
	JRST	PLTSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	PLTDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	PLTMOD			;MODIFY PLT PARAMETERS
	JRST	PLTRJI			;RELEASE A JOB INTERLOCK
	JRST	PLTFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

PLTLNK:	GETLIM	S1,.QELIM(AP),OLIM	;GET OUTPUT LIMIT
	MOVEI	S2,^D60			;AND AGING FACTOR
	PJRST	LNKPRI			;AND LINK IT IN

PLTDEF:	MOVX	S1,PLTDIV		;GET THE PER DISKBLK DIVISOR
	MOVX	S2,PLTMUL		;GET THE PER DISKBLK MULTIPLIER
	MOVX	T1,INPPLT		;GET THE DEFAULT LIMIT
	JRST	OUTDEF			;AND USE COMMON CODE

PLTMOD:	JRST	OUTMOD			;OUTPUT IS SAME FOR ALL OUTPUT QUEUES

PLTSCH:	JRST	NEXTJB			;SEND A NEXTJOB MESSAGE

PLTRJI:	JRST	JOBDUN			;CLEANUP AFTERWARDS

PLTFJB:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE OBJ ADDRESS IN P1
	LOAD	P2,HDRPLT##+.QHLNK,QH.PTF  ;GET FIRST ITEM IN THE QUEUE

PLTF.1:	JUMPE	P2,.RETF		;FAIL IF NO JOBS
	MOVX	S1,PLTARF		;LOAD ARF VALUE
	MOVX	S2,PLTKTL		;LOAD KTL VALUE
	MOVE	T1,P2			;GET QE ADDRESS
	PUSHJ	P,OUTKSYS		;CHECK LIMITS BASED ON KSYS
	  JUMPF	PLTF.2			;NOT THIS JOB
	MOVE	S1,P2			;COPY OVER THE REQUEST ADDRESS
	MOVE	S2,P1			;PUT OBJ ADR INTO S2
	PUSHJ	P,OUTFJB		;RUN THRU SOME COMMON CODE
	JUMPT	.RETT			;WIN IF HE DID

PLTF.2:	LOAD	P2,.QELNK(P2),QE.PTN	;GET NEXT
	JRST	PLTF.1			;AND LOOP
SUBTTL	BIN  --  Batch-Input queue dependent functions

;The BIN queue scheduler vector
S$BIN::	JRST	BINLNK			;LINK IN A NEW JOB
	JRST	BINSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	BINDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	BINMOD			;MODIFY BIN PARAMETERS
	JRST	BINRJI			;RELEASE A JOB INTERLOCK
	JRST	BINFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

BINDEF:	PUSH	P,.EQLIM+3(M)		;SAVE THE CNOD LIMIT WORD
	PUSHJ	P,INPDEF		;DEFAULT THE EQ
	POP	P,.EQLIM+3(M)		;RESTORE THE CNOD LIMIT WORD
	LOAD	S1,.EQLEN(M),EQ.LOH	;SKIP OVER THE HEADER
	ADD	S1,M			;POINT TO THE FP
	VDFALT	S2,.FPINF(S1),FP.RCF,.FPFAI ;DEFAULT THE RECORD TYPE
	VDFALT	S2,.FPINF(S1),FP.RCL,^D80   ;DEFAULT RECORD LENGTH TO 80
	$RETT				;AND RETURN

BINLNK:	JRST	M$ELNK##		;LINK IN AT THE END

BINSCH:	JRST	NEXTJB			;JUST SEND A NEXTJOB MESSAGE

BINRJI:	JRST	JOBDUN			;CLEAN UP THE INTERLOCK

BINMOD:	$RETT

BINFJB:	LOAD	S1,HDRBIN##+.QHLNK,QH.PTF  ;GET POINTER TO FIRST
	JUMPE	S1,.RETF		;RETURN IF NOTHING THERE
	$RETT				;ELSE, WIN
SUBTTL	RDR  --  Reader queue dependent functions

;The RDR queue scheduler vector
S$RDR::	JRST	RDRLNK			;LINK IN A JOB
	JRST	RDRSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	RDRDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	RDRMOD			;MODIFY RDR PARAMETERS
	JRST	RDRRJI			;RELEASE A JOB INTERLOCK
	JRST	RDRFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->


RDRLNK:	$RETT

RDRSCH:	MOVE	S1,S2			;GET THE OBJECT ADDRESS.
	PUSHJ	P,A$OBST		;UPDATE THE STATUS
	$RETT				;RETURN

RDRDEF:	$RETT

RDRMOD:	$RETT

RDRRJI:	SETZM	OBJITN(S1)		;CLEAR THE ITN WORD
	ZERO	OBJSCH(S1),OBSBUS	;CLEAR THE BUSY BIT
	PUSHJ	P,A$OBST##		;UPDATE THE STATUS
	$RETT				;RETURN

RDRFJB:	$RETT
SUBTTL  RET  --  Retrieval queue dependant functions

S$RET:: JRST	RETLNK			;LINK IN A JOB REQUEST
	JRST	RETSCH			;SCHEDULE A JOB FOR THE OBJECT
	JRST	RETDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	RETMOD			;GO PERFORM THE MODIFY
	JRST	RETRJI			;GO RELEASE THE JOB INTERLOCKS
	JRST	RETFJB			;FIND A JOB FOR AN OBJECT

RETLNK:	PJRST	I$RLNK##		;LINK IN A JOB

RETSCH:	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	DMOVE	P1,S1			;SAVE QUEUE REQUEST & OBJECT ADDRESS
	PUSHJ	P,I$RSCH##		;GO FIND A JOB TO SCHEDULE
	JUMPF	.RETF			;NONE THERE,,JUST RETURN
	DMOVE	S1,P1			;RESTORE QUEUE REQUEST & OBJECT ADDRESS
	PJRST	NEXTJB			;GO SCHEDULE IT

RETDEF:	PUSHJ	P,EQDFLT		;GO DEFAULT THE EQ
	PJRST	I$RDEF##		;DEFAULT THE REST AND RETURN

RETMOD:	$RETT				;JUST RETURN

RETRJI:	PJRST	JOBDUN			;GO RELEASE THE JOB INTERLOCKS

RETFJB:	PJRST	I$RFJB##		;FIND A JOB FOR AN OBJECT
SUBTTL  NOT - Notification queue dependant functions

S$NOT::	JRST	NOTLNK			;LINK IN A JOB
	JRST	NOTSCH			;SCHEDULE A JOB
	JRST	NOTDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	NOTMOD			;MODIFY A JOB
	JRST	NOTRJI			;RELEASE JOB INTERLOCKS
	JRST	NOTFJB			;GO FIND A JOB FOR SCHEDULING

NOTLNK:	PJRST	I$NLNK##		;LINK THE JOB IN

NOTSCH:	$RETT				;JUST RETURN

NOTDEF:	PUSHJ	P,I$NDEF##		;GO FILL IN THE DEFAULTS

NOTMOD:	$RETT				;JUST RETURN

NOTRJI:	PJRST	JOBDUN			;GO RELEASE THE JOB INTERLOCKS

NOTFJB:	PJRST	I$NFJB##		;GO FIND A JOB
	SUBTTL	DBMS SCHEDULING VECTOR

S$DBM::	JRST	DBMLNK			;LINK IN A NEW ENTRY
	JRST	DBMSCH			;SCHEDULE A JOB FOR AN OBJECT
	JRST	DBMDEF			;FILL IN DEFAULTS FOR A JOB
	JRST	DBMMOD			;MODIFY DBM PARAMETERS
	JRST	DBMRJI			;RELEASE A JOB INTERLOCK
	JRST	DBMFJB			;FIND A JOB FOR AN OBJECT

;<- - - - - - - - - - - - - - - - - - - - - - - - ->

DBMLNK:	JRST	M$ELNK##		;LINK IN AT THE END

DBMSCH:	ZERO	OBJSCH(S2),OBSBUS	;CLEAR BUSY BIT
	MOVE	S2,OBJPID(S2)		;GET THE PROCESSORS PID
	MOVEM	S2,G$SAB##+SAB.PD	;SAVE IT IN THE SAB
	MOVX	S2,QE.HBO		;GET THE HELD BY OPR BIT
	IORM	S2,.QESEQ(S1)		;SET IT FOR THIS REQUEST
	LOAD	S1,.QESTN(S1),QE.DPA	;GET THE DPA
	PUSHJ	P,F$RDRQ##		;READ THE REQUEST IN
	SKIPN	0(S1)			;VALIDATE A LITTLE
	PUSHJ	P,S..NBR		;NO GOOD !!!
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE THE MESSAGE ADDRESS
	MOVX	S1,PAGSIZ		;SEND A PAGE
	MOVEM	S1,G$SAB##+SAB.LN	;SET THE LENGTH
	SETZM	G$SAB##+SAB.SI		;NO SPECIAL PID INDEX
	SETZM	G$SAB##+SAB.PB		;AND NO IN BEHALF OF PIB
	PUSHJ	P,C$SEND$$		;SEND THE MESSAGE OFF
	DOSCHD				;FORCE ANOTHER SCHEDULING PASS
	$RETT				;AND RETURN

DBMDEF:	PUSHJ	P,EQDFLT		;COMMON DEFAULTS
	$RETT				;AND RETURN

DBMMOD:	$RETT				;JUST RETURN

DBMRJI:	MOVX	S1,QE.HBO		;GET THE HELD BY OPR BIT
	LOAD	S2,HDRDBM##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
DBMR.1:	JUMPE	S2,.RETT		;NONE THERE,,FINISH UP
	ANDCAM	S1,.QESEQ(S2)		;CLEAR THE HELD BY OPR BIT
	LOAD	S2,.QELNK(S2),QE.PTN	;GET THE NEXT ENTRY
	JRST	DBMR.1			;AND PROCESS IT

DBMFJB:	LOAD	S1,HDRDBM##+.QHLNK,QH.PTF ;GET POINTER TO FIRST
DBMF.1:	JUMPE	S1,.RETF		;RETURN IF NOTHING THERE
	LOAD	S2,.QESEQ(S1),QE.HBO	;GET THE HELD BY OPR BIT
	JUMPE	S2,.RETT		;NOT LIT,,RETURN THIS ENTRY
	LOAD	S1,.QELNK(S1),QE.PTN	;GET THE NEXT ENTRY
	JRST	DBMF.1			;AND TRY IT
SUBTTL	Local Subroutines

;	OUTMOD			Queue specific modify for LPT, PTP, PLT, CDP
;	OUTDEF			Fill in defaults for LPT, PTP, PLT, CDP
;	OUTKSY			Routine to check job scheduling during KSYS
;	OUTFJB			Common routine for picking an output job
;	EQDFLT			Fill in queue-independent defaults in an EQ
;	LNKPRI			Compute priority and do linkin
;	NEXTJB			Send a NEXTJB message to schedule a job
;	JOBDUN			Clean up a job-OBJ interlock for some queues
	SUBTTL	OUTMOD  --  Do queue dependent MODIFY for Output queues

;OUTMOD is dispatched to by the scheduling vector of the Output
;	queues.  See the description of the SCHMOD entry for details.


OUTMOD:	PUSHJ	P,.SAVE4		;SAVE A FEW REGS FIRST
	LOAD	P1,MOD.GN(S1),MODGLN	;NUMBER OF GROUP 1 ELEMENTS
	SOJLE	P1,.RETT		;0 IS ACCEPTABLE, ADJUST FOR THE LOOP
	CAILE	P1,NOUTPM		;MORE THAN CURRENTLY IMPLEMENTED
	MOVEI	P1,NOUTPM		;YES, USE ONLY THE KNOWN VALUES
	MOVNS	P1			;NEGATE IT
	HRLZS	P1			;P1 = AOBJN POINTER
	MOVEI	P2,MOD.GE(S1)		;POINT TO FIRST GROUP ELEMENT
OUTM.1:	MOVE	P3,0(P2)		;GET AN ELEMENT
	CAME	P3,[-1]			;DID IT CHANGE
	XCT	OUTMTB(P1)		;YES, STORE NEW VALUE
	INCR	P2			;TO NEXT ELEMENT
	AOBJN	P1,OUTM.1		;GET THEM ALL
	$RETT				;RETURN TO Q$MODIFY FOR NEXT GROUP

OUTMTB:	STOLIM	P3,.EQLIM(AP),FORM	; 0 = /FORMS
	STOLIM	P3,.EQLIM(AP),OLIM	; 1 = /LIMIT
	STOLIM	P3,.EQLIM(AP),NOT1	; 2 = /NOTE (1ST HALF)
	STOLIM	P3,.EQLIM(AP),NOT2	; 3 = /NOTE (2ND HALF)
	PUSHJ	P,MOUTHD		; 4 = /HEADER
	PUSHJ	P,MOUTSP		; 5 = /SPACING
	PUSHJ	P,MOUTPF		; 6 = /PRINT (/PAPER)
	PUSHJ	P,MOUTFF		; 7 = /FILE
	PUSHJ	P,MOUTDL		;10 = /DELETE
	PUSHJ	P,MOUTCP		;11 = /COPIES
	PUSHJ	P,MOUTR1		;12 = /REPORT (1ST HALF)
	PUSHJ	P,MOUTR2		;13 = /REPORT (2ND HALF)
	PUSHJ	P,MOUTBG		;14 = /BEGIN

NOUTPM==<.-OUTMTB>			;NUMBER CURRENTLY IMPLEMENTED


				;OUTMOD IS CONTINUED ON THE NEXT PAGE
;HERE TO MODIFY FILE-SPECIFIC OUTPUT PARAMETERS

MOUTFP:				;BEGINNING OF FILE-SPECIFIC PARMS
MOUTHD:	JSP	P4,OUFSLP		; /HEADER
MOUTSP:	JSP	P4,OUFSLP		; /SPACING
MOUTPF:	JSP	P4,OUFSLP		; /PAPER
MOUTFF:	JSP	P4,OUFSLP		; /FILE
MOUTDL:	JSP	P4,OUFSLP		; /DELETE
MOUTCP:	JSP	P4,OUFSLP		; /COPIES
MOUTR1:	JSP	P4,OUFSLP		; /REPORT (1ST HALF)
MOUTR2:	JSP	P4,OUFSLP		; /REPORT (2ND HALF)
MOUTBG:	JSP	P4,OUFSLP		; /BEGIN


MOUTAB:	STORE	P3,.FPINF(T1),FP.NFH	; /HEADER
	STORE	P3,.FPINF(T1),FP.FSP	; /SPACING
	STORE	P3,.FPINF(T1),FP.FPF	; /PAPER
	STORE	P3,.FPINF(T1),FP.FFF	; /FILE
	STORE	P3,.FPINF(T1),FP.DEL	; /DELETE
	STORE	P3,.FPINF(T1),FP.FCY	; /COPIES
	STORE	P3,.FPFR1(T1)		; /REPORT (1ST HALF)
	STORE	P3,.FPFR2(T1)		; /REPORT (2ND HALF)
	STORE	P3,.FPFST(T1)		; /BEGIN

OUFSLP:	PUSHJ	P,.SAVET		;SAVE T1 THRU T4
	SUBI	P4,MOUTFP+1		;GET INDEX IN MOUTFD TABLE
	LOAD	T1,.EQLEN(AP),EQ.LOH	;GET LENGTH OF HEADER IN EQ
	ADD	T1,AP			;GET ADDRESS OF FIRST FP
	LOAD	T2,.EQSPC(AP),EQ.NUM	;GET NUMBER OF FILESPECS
OUFS.1:	XCT	MOUTAB(P4)		;STORE THE PARAMETER
	SOJLE	T2,.RETT		;RETURN WHEN DONE
	LOAD	T3,.FPLEN(T1),FP.LEN	;GET LENGTH OF FP
	ADD	T1,T3			;BUMP TO THE FD
	LOAD	T3,.FDLEN(T1),FD.LEN	;GET LENGTH OF FD
	ADD	T1,T3			;BUMP TO THE NEXT FP
	JRST	OUFS.1			;AND LOOP
SUBTTL	OUTDEF  --  Fill in defaults for Output queues

;OUTDEF is called by the queue-specific default fillers.
;
;CALL:	S1/ The Per-Diskblk Divisor for calculating the limits
;	S2/ The Per-Dsikblk Multiplier for calculating the limits
;	T1/ Default limit if size of the files is not available
;	M/  The CREATE message address

OUTDEF:	PUSHJ	P,.SAVE2		;SAVE P1 & P2
	GETLIM	P1,.EQLIM(M),NBLK	;GET THE NUMBER OF DISK BLOCKS
	JUMPE	P1,OUTD.1		;NOT SPECIFIED,,SKIP THIS & SAVE DEFAULT
	IMUL	P1,S2			;CALCULATE THE NUMBER
	IDIV	P1,S1			;   OF PAGES, CARDS, FEET,
	SKIPE	P2			;      ETC. CONTAINED IN X
	ADDI	P1,1			;         NUMBER OF DISK BLOCKS (PAGES)
	SKIPA				;SKIP THE DEFAULT LOADING
OUTD.1:	 MOVE	P1,T1			;GET THE DEFAULT IF BLOCKS NOT SPECIFIED
	CAXLE	P1,MAXLIM(OLIM)		;P1 BIGGER THAN MAX VALUE?
	 MOVX	P1,MAXLIM(OLIM)		;YES--SET TO MAX VALUE
	GETLIM	S2,.EQLIM(M),OLIM	;DID HE ALREADY SPECIFY A LIMIT ???
	SKIPN	S2			;YES,,DONT SAVE THE CALCULATED LIMIT
	STOLIM	P1,.EQLIM(M),OLIM	;NO,,SAVE THE CALCULATED LIMIT
	PDFALT	S1,.EQLIM(M),FORM,FRMNOR  ;FILL IN DEFAULT FORMS
	PUSHJ	P,EQDFLT		;GO DEFAULT THE REST OF THE EQ.
TOPS10	<
	PUSHJ	P,RENDEF		;CHECK FOR /DISP:REN
>
	$RETT				;AND RETURN
SUBTTL	RENDEF - Check for /DISPOSE:RENAME


; This routine is called by OUTDEF to check for and process /DISPOSE:RENAME
; requests on a per file basis.
;
RENDEF:	LOAD	S1,.MSTYP(M),.QIFNC	;GET INTERNAL FUNCTION BIT
	JUMPN	S1,.POPJ		;NO RENAME STUFF IF REBUILDING QE
	$SAVE	<P1,P2>			;SAVE SOME ACS
	LOAD	P1,.EQSPC(M),EQ.NUM	;GET NUMBER OF FILES
	JUMPE	P1,.RETT		;NO FILES! NO WORK.
	LOAD	P2,.EQLEN(M),EQ.LOH	;GET LENGTH OF HEADER
	ADDI	P2,(M)			;POINT TO FIRST FP

REND.1:	MOVEI	S1,(P2)			;GET THE FP ADDRESS
	MOVX	S2,FP.REN		;GET RENAME BIT
	TDNE	S2,.FPINF(P2)		;CHECK THE BIT
	PUSHJ	P,I$RENA##		;DO THE RENAME
	JUMPT	REND.2			;CHECK FOR ERRORS
	LOAD	S1,.FPLEN(P2),FP.LEN	;GET SIZE OF FP
	ADDI	S1,(P2)			;POINT TO FD IN QUESTION
	$TEXT	(G$CCHR##,<% File ^F/(S1)/ not renamed; ^E/[-1]/>)

REND.2:	LOAD	S1,.FPLEN(P2),FP.LEN	;GET LENGTH OF THE FP
	ADDI	P2,(S1)			;POINT TO THE FD
	LOAD	S1,.FDLEN(P2),FD.LEN	;GET LENGTH OF THE FD
	ADDI	P2,(S1)			;POINT TO THE NEXT FP
	SOJG	P1,REND.1		;AND LOOP
	POPJ	P,			;RETURN
SUBTTL	OUTKSYS - Job scheduling check during KSYS


; This routine will check limits when KSYS is pending
; Call:	S1/	ARF value
;	S2/	KTL value
;	T1/	QE address
;
; TRUE return:	OK to scheduler
; FALSE return: Find another job
;
OUTKSYS:JUMPE	S2,.RETT		;IF NO KTL, THEN NO CHECK NEEDED
	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	SKIPN	P1,G$KSYS##		;GET KSYS TIMER
	$RETT				;NONE THERE
	IDIVI	P1,^D60			;CONVERT TO MINUTES
	CAMLE	P1,S2			;WITHIN THE KSYS THRESHOLD ?
	$RETT				;NOPE
	GETLIM	P2,.QELIM(T1),OLIM	;GET LIMIT
	IDIV	P2,S1			;CONVERT UNITS TO MINUTES USING ARF
	CAMLE	P2,P1			;WITHIN RANGE ?
	$RETF				;NO
	$RETT				;YES
	SUBTTL	OUTFJB  --  Common routine for picking an output job

;Called by the queue-dependent routines (SCHFJB entry) to decide whether
;	a particular job fits all the parameter contstraints of an OBJ.
;
;Call:	S1/  address of the queue request
;	S2/  address of the OBJ entry
;
;True return: S1/  address of the queue entry picked

OUTFJB:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	DMOVE	P1,S1			;COPY THE ARGS OVER
	LOAD	S2,OBJSCH(P2),OBSQUH	;GET ADDRESS OF QUEUE HEADER
	LOAD	S1,.QECRE(P1)		;GET JOB CREATION TIME
	CAMLE	S1,G$NOW##		;IN THE FUTURE?
	$RETF				;YES,,IGNORE THE JOB
	LOAD	S1,.QESEQ(P1),QE.HBO	;JOB HELD BY THE OPERATOR?
	JUMPN	S1,.RETF		;YUP, RETURN LOSSAGE
	MOVEI	S1,.QEROB(P1)		;GET THIS JOBS REQUESTED OBJ BLK ADDR
	MOVE	S2,P2			;GET THE OBJECT ADDRESS IN S2
	PUSHJ	P,N$CSTN##		;CONVERT FOR ROUTING.
	JUMPF	.RETF			;NO GOOD FOR THIS OBJECT,,TRY NEXT

OUTF.1:	LOAD	S1,.QESEQ(P1),QE.PRI	;GET JOBS EXTERNAL PRIORITY
	LOAD	P3,OBJPRM+.OOPRI(P2),OBPMIN  ;GET MINIMUM
	LOAD	P4,OBJPRM+.OOPRI(P2),OBPMAX  ;GET MAXIMUM
	CAML	S1,P3			;SKIP IF LESS THAN MINIMUM
	CAMLE	S1,P4			;SKIP IF LE THAN MAXIMUM
	$RETF				;LOSE
	GETLIM	S1,.QELIM(P1),OLIM	;GET OUTPUT LIMIT
	LOAD	P3,OBJPRM+.OOLIM(P2),OBPMIN  ;LOAD MINIMUM
	LOAD	P4,OBJPRM+.OOLIM(P2),OBPMAX  ;LOAD MAXIMUM
	CAML	S1,P3			;CHECK LOWER LIMIT
	CAMLE	S1,P4			;CHECK UPPER LIMIT
	$RETF				;LOSE
	GETLIM	S1,.QELIM(P1),FORM	;GET FORMS TYPE
	XOR	S1,OBJPRM+.OOFRM(P2)	;XOR WITH MOUNTED FORMS TYPE
	AND	S1,[EXP FRMSK1]		;AND WITH MASK TO CLEAR THE NOISE
	JUMPN	S1,.RETF		;LOSE IF DIFFERENT
	$SAVE	AP			;SAVE AP FOR A SECOND
	MOVE	AP,P1			;POINT TO THE QE
	PUSHJ	P,Q$CDEP##		;EVALUATE ALL DEPENDENCIES
	JUMPF	.RETF			;AND FAIL
	MOVE	S1,P1			;GET THE WINNER
	PUSHJ	P,I$ACTV##		;CHECK FOR VALID ACCOUNT STRING
	JUMPF	.RETF			;NO GOOD,,RETURN
	MOVE	S1,P1			;RETURN THE EQ ADDRESS IN S1
	$RETT				;AND RETURN
SUBTTL	EQDFLT  --  Default queue-independent fields in an EQ

;EQDFLT is called by the various default fillers to fill in the queue-
;	independent fields in an EQ (i.e. a CREATE message).
;
;CALL:	M/	address of CREATE message

EQDFLT:	LOAD	S1,.MSTYP(M),.QIFNC	;GET INTERNAL FCN BIT
	JUMPN	S1,EQDF.1		;JUMP IF SET
	LOAD	S1,.EQLEN(M),EQ.VRS	;GET VERSION NUMBER
	CAIE	S1,%%.QSR		;IS IT CORRECT?
	JRST	E$WVN##			;WRONG VERSION NUMBER
	MOVX	S1,EQ.CHP!EQ.RDE!EQ.SPL!EQ.JBC	;Load some bits
	ANDCAM	S1,.EQSEQ(M)		;AND ZERO THEM
	PUSHJ	P,A$WHEEL##		;IS SENDER A WHEEL?
	MOVEI	S1,1			;ASSUME YES
	SKIPT				;SKIP IF YES
	SETZ	S1,			;IT WAS NO
	STORE	S1,.EQSEQ(M),EQ.PRV	;AND STORE IT
	LOAD	S2,.EQSEQ(M),EQ.PRI	;GET SPECIFIED PRIORITY
	SKIPN	S1			;IS USER A WHEEL?
	CAIG	S2,MXUPRI		;NO, DID HE SPECIFY TOO HIGH A PRIO
	JRST	NONCHK			;Either a wheel or prio is ok
	MOVEI	S1,1			;Turn on the
	STORE	S1,.EQSEQ(M),EQ.CHP 	;Priority changed bit
	MOVX	S2,MXUPRI		;LOAD MAX PRIO
NONCHK:	STORE	S2,.EQSEQ(M),EQ.PRI	;And re-store it
	MOVEI	S1,EQCKSZ		;SIZE OF THE CHECKPOINT BLOCK
	MOVEI	S2,.EQCHK(M)		;AND THE ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO IT OUT
	MOVE	S1,M			;POINT TO THE EQ
	PUSHJ	P,I$DFEQ##		;DEFAULT O/S DEPENDENT STUFF
	JUMPT	EQDF.1			;SUCCESS,,CONTINUE ON.
	SKIPN	G$ERR##			;DO WE HAVE AN ERROR YET ??
	JRST	E$ICM##			;NO,,SET INVALID CREATE MESSAGE.
	$RETF				;YES,,JUST RETURN.

EQDF.1:	MOVE	S1,[SIXBIT/XXXXXX/]	;GET A DUMMY JOB NAME
	SKIPN	.EQJOB(M)		;DO WE HAVE A JOB NAME YET ???
	MOVEM	S1,.EQJOB(M)		;NO,,SAVE THIS ONE !!!
	LOAD	S1,.EQSPC(M),EQ.NUM		;GET NUMBER OF FILES
	JUMPE	S1,E$INF##			;ILLEGAL NUMBER OF FILES
	LOAD	S2,.EQITN(M)			;GET THE ITN
	ANDI	S2,7777				;AND IT DOWN SOME
	ADDI	S2,1				;AND DONT ALLOW ZERO
	LDFALT	S1,.EQSEQ(M),EQ.SEQ,S2		;DEFAULT SEQUENCE NUMBER
	VDFALT	S1,.EQSEQ(M),EQ.PRI,SPLPRI	;DEFAULT EXTERNAL PRIORITY
	LDFALT	S1,.EQSPC(M),EQ.PRO,G$SPRT##	;DEFAULT REQUEST PROTECTION
	LDFALT	S1,.EQAFT(M),,G$NOW##		;DEFAULT AFTER PARAMETER

	;"EQDFLT" IS CONTINUED ON THE NEXT PAGE
	;Check Requested Attributes

	MOVE	S1,.EQROB+.ROBAT(M)	;GET ROB ATTRIBUTES
	TLNN	S1,-1			;WAS ANYTHING SPECIFIED?
	HRLZI	S1,%GENRC		;NO DEFAULT TO GENERIC
	TXZE	S1,RO.PHY		;OLD PHYSICAL?
	HRLI	S1,%PHYCL		;YES,,GET CORRECT VALUE
	TXZE	S1,OBDLLC		;OLD LOWER?
	HRLZI	S1,%LOWER		;YES,,GET CORRECT VALUE
	TXZE	S1,OBDLUC		;OLD UPPER?
	HRLZI	S1,%UPPER		;YES,,GET CORRECT VALUE
	MOVEM	S1,.EQROB+.ROBAT(M)	;STORE CORRECT VALUE

;The following routine is a major part of QUASAR's security enforcement.
;	There are two parts involved.  The first is to insure that the
;	FP.SPL is off since this bit causes the spoolers to not access
;	check the file.  The second is to insure (very carefully) that
;	the lengths throughout the CREATE message are correct and con-
;	sistent.

	PUSHJ	P,.SAVE4		;SAVE P1-P4
	LOAD	S1,.EQSPC(M),EQ.NUM	;GET NUMBER OF FILES
	LOAD	S2,.EQLEN(M),EQ.LOH	;GET LENGTH OF HEADER
	LOAD	P1,.MSTYP(M),MS.CNT	;GET LENGTH OF MESSAGE
	SUB	P1,S2			;DECREMENT IT
	JUMPLE	P1,E$MTS##		;LOSE
	ADD	S2,M			;POINT TO THE FIRST FP

EQDF.2:	CAIGE	P1,.FPLEN+1		;CAN I GET THE LENGTH?
	PJRST	E$MTS##			;NO, LOSE
	LOAD	P2,.FPLEN(S2),FP.LEN	;GET THE FP LENGTH
	CAIGE	P2,FPMSIZ		;GREATER THAN MINIMUM?
	PJRST	E$ICM##			;NO LOSE
	SUB	P1,P2			;DECREMENT THE COUNTER
	JUMPLE	P1,E$MTS##		;LOSE
	LOAD	P3,.MSTYP(M),.QIFNC	;GET INTERNAL FUNCTION BIT
	LOAD	P4,.EQSEQ(M),EQ.PRV	;GET THE PRIV BIT
	ADD	P3,P4			;COMBINE THE PRIV & INTERNAL FCN BITS
	SKIPN	P3			;SKIP IF EITHER ARE SET
	ZERO	.FPINF(S2),FP.SPL	;NOT PRIV OR INTERNAL,,ZERO THE SPL BIT
	ADD	S2,P2			;POINT TO THE FD
	CAIGE	P1,.FDLEN+1		;CAN I GET THE FD LENGTH
	PJRST	E$MTS##			;NO, LOSE
	LOAD	P2,.FDLEN(S2),FD.LEN	;GET THE FD SIZE
	CAIGE	P2,FDMSIZ		;BIG ENOUGH?
	PJRST	E$ICM##			;NO, LOSE
	SUB	P1,P2			;DECREMENT
	JUMPL	P1,E$MTS##		;LOSE IF WE DONT HAVE THE WHOLE FD
	ADD	S2,P2			;POINT TO THE NEXT FP
	SOJG	S1,EQDF.2		;AND LOOP
	$RETT				;AND RETURN
SUBTTL	LNKPRI  --  Compute linkin priority and do linkin

;LNKPRI is called by the various queue dependent linkin routines
;	with parameters setup to compute the entrace priority and aging.
;	The priority is computed and the entry is linked-in.

;CALL:	S1/	Internal priority factor
;	S2/	aging factor
;	AP/	address of entry
;	H/	queue header address

LNKPRI:	DOSCHD				;SCHEDULE!!
	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	$SAVE	E			;AND E
	MOVE	P2,S2			;SAVE AGING FACTOR IN P2
	MOVEM	S1,.QEIPR(AP)		;SAVE PRIO FACTOR AS THE IPR
	LOAD	P1,.QESEQ(AP),QE.PRI	;GET THE PRIORITY
	CAIN	P1,1			;IS IT PRIORITY 1 ???
	PJRST	M$ELNK##		;YES,,LINK IT IN AT THE END !!!
	LOAD	S1,.QESEQ(AP),QE.JBC	;HAS JOB BEEN CHECKPOINTED?
	SKIPE	S1			;SKIP IF NOT
	ADDI	P1,1			;IT HAS, MAKE PRIORITY A BIT HIGHER
	LOAD	E,.QHLNK(H),QH.PTF	;AND POINT TO THE FIRST IN THE QUEUE

LNKP.1:	JUMPE	E,M$ELNK##		;END-OF-LIST, LINK AT THE END
	LOAD	S1,.QESEQ(E),QE.PRI	;GET PRIO OF REQUEST
	CAMGE	S1,P1			;IS OLD REQUEST LESS PRIO?
	PJRST	M$LINK##		;YES, LINK NEW ONE BEFORE IT
	CAME	S1,P1			;NO, SKIP IF THEY ARE EQUAL
	JRST	LNKP.2			;OLD REQUEST IS MORE, GET THE NEXT
	PUSHJ	P,LNKP.3		;AGE THE OLD REQUEST
	CAMLE	S1,.QEIPR(AP)		;IS OLD REQUEST LESS?
	PJRST	M$LINK##		;YES, LINK NEW ONE IN BEFORE IT

LNKP.2:	LOAD	E,.QELNK(E),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	LNKP.1			;AND LOOP

;SUBROUTINE TO "AGE"  ENTRY 'E'
LNKP.3:	MOVE	S2,.QECRE(E)		;GET CREATION TIME
	MOVE	S1,.QECRE(AP)		;GET CREATION TIME OF NEW ONE
	PUSHJ	P,A$AGE##		;GET DIFFERENCE IN SECONDS
	IDIVI	S1,(P2)			;DIVIDE BY THE FACTOR
	MOVE	S2,.QECRE(E)		;GET CREATION TIME OF OLD ONE
	CAMG	S2,.QECRE(AP)		;IS IT OLDER OR NEWER?
	MOVNS	S1			;OLDER, NEGATE IT
	ADD	S1,.QEIPR(E)		;ADD IN THE ENTRY PRIOITY
	$RETT				;AND RETURN
	SUBTTL	NEXTJB  --  Function 5

;NEXTJB is called by a number of the queue dependent scheduling routines
;	(SCHSCH entry) to send a NEXTJOB message to a known component.
;
;CALL IS:	S1/ Pointer to the .QE
;		S2/ Pointer to the OBJect block
;
;NEXTJB performs the following operations:
;	1)  Read the request from disk
;	2)  Move the queue entry from the processing queue to the USE queue
;	3)  Validate the account string
;	4)  Copy changable data from the .QE to the .EQ
;	5)  Send the request to the known component
;
;If the IPCF send fails when sending the NEXTJOB messages, the A$KLPD
;	routine gets called and all the data-structure associated with
;	the component and the OBJ will be cleaned up.  This implies that
;	they must be in a consistent state before NEXTJB is called.

NEXTJB:	PUSHJ	P,.SAVE2		;SAVE TWO PERM ACS
	MOVE	AP,S1			;GET ARGUMENT POINTER SET UP
	MOVE	P1,S2			;AND POINTER TO OBJECT BLOCK
	MOVEM	P1,.QEOBJ(AP)		;STORE POINTER TO OBJECT BLOCK
	LOAD	S1,.QESTN(AP),QE.DPA	;GET THE DPA
	PUSHJ	P,F$RDRQ##		;READ THE REQUEST
	SKIPN	0(S1)			;DO A SMALL VALIDITY CHECK
	$STOP(NBR,Nextjob'ing bad request)
	MOVE	P2,S1			;COPY ADR INTO P2

	PUSHJ	P,I$SACV##		;GO MAKE SURE THE ACCOUNT IS STILL VALID

	MOVEI	S1,HDRUSE##		;LOAD DESTINATION QUEUE HDR
	LOAD	H,OBJSCH(P1),OBSQUH	;POINT TO PROPER QUEUE HEADER
	PUSHJ	P,M$MOVE##		;AND MOVE THE ENTRY
	SKIPE	S1,.QEMDR(AP)		;CHECK AND LOAD MDR ADDRESS
	MOVEM	AP,.MRQEA(S1)		;RELINK QE TO THE MDR

	$COUNT	(MNXT)			;COUNT TOTAL NEXTJOBS
	LOAD	S1,.EQROB+.ROBTY(P2)	;get type of object
	$COUNT	(MNXT(S1))		;increment object count
	LOAD	S1,.QEITN(AP)		;NOW MAKE SURE ITN EXISTS
	STORE	S1,.EQITN(P2)		;STORE IT
	STORE	S1,OBJITN(P1)		;LET OBJECT REMEMBER IT TOO
	MOVEI	S1,.QONEX		;GET NEXTJOB FUNCTION
	STORE	S1,.MSTYP(P2),MS.TYP	;AND STORE IT IN THE MESSAGE
	MOVSI	S1,.QEJBB(AP)		;GET THE JIB SOURCE ADDRESS
	HRRI	S1,.EQJBB(P2)		;GET THE JIB DESTINATION ADDRESS
	BLT	S1,.EQJBB+JIBSIZ-1(P2)	;COPY THE JIB OVER
	LOAD	S1,.QECRE(AP)		;CREATION TIME
	STORE	S1,.EQAFT(P2)		;STORE THAT AS WELL
	HRLI	S1,.QELIM(AP)		;MOVE LIMIT WORDS FROM INTERNAL
	HRRI	S1,.EQLIM(P2)		;TO EXTERNAL REQUEST
	BLT	S1,.EQLIM+EQLMSZ-1(P2)	;FOR EXTRA DEFAULTED VALUES

	;CONTINUED ON THE NEXT PAGE

	;CONTINUED FROM THE PREVIOUS PAGE

	HRLI	S1,.QEACT(AP)		;MOVE ACCOUNT STRING FROM INTERNAL
	HRRI	S1,.EQACT(P2)		;TO EXTERNAL REQUEST
	BLT	S1,.EQACT+7(P2)		;FOR POSSIBLY MODIFIED ACCOUNT STRING
	MOVEI	S1,OBJTYP(P1)		;POINT TO OBJECT TYPE
	MOVEI	S2,.EQROB+.ROBTY(P2)	;AND PLACE TO MOVE IT
	PUSHJ	P,A$CPOB##		;AND COPY THE OBJECT BLOCK OVER
	LOAD	S1,OBJTYP(P1)		;GET THE OBJECT TYPE
	PUSHJ	P,A$OB2Q##		;CONVERT IT TO A QUEUE HEADER
	LOAD	S1,.QHTYP(S1),QH.TYP	;GET THE QUEUE TYPE
	LOAD	S2,OBJPRM+.OOFLG(P1),.OFLEA ;GET THE QUEUE'S LIMIT-EX-ACTION
	CAIN	S1,.QHTOU		;IS THIS AN OUTPUT QUEUE ???
	STOLIM	S2,.EQLIM(P2),FLEA	;YES,,SAVE THE LIMIT-EX-ACTION
	MOVE	S1,P1			;GET OBJECT ADDRESS
	PUSHJ	P,A$OBST##		;SETUP OBJECT STATUS
	MOVEI	S1,OBJST1(P1)		;POINT TO SPOOLER'S STATUS BLOCK
	PUSHJ	P,G$STTX##		;SETUP STRING
	$TEXT(G$TEXT##,<Started at ^C/[-1]/^0>)
	MOVE	S1,OBJPID(P1)		;GET PID OF OWNER
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS THE RECIEVERS PID
	MOVEM	P2,G$SAB##+SAB.MS	;SAVE THE MESSAGE ADDRESS
	MOVX	S1,PAGSIZ		;GET A PAGE SIZE
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	PUSHJ	P,C$SEND##		;SHIP THE MESSAGE OFF
	$RETT				;AND RETURN
SUBTTL	JOBDUN  --  Common job release routine

;JOBDUN is called by a number of the queue dependent release routines
;	(SCHRJI entry) to clean up the interlock between a job and an object.
;
;CALL:	AP/  address of the .QE being released

JOBDUN:	DOSCHD				;SCHEDULE!!
	LOAD	S1,.QEOBJ(AP)		;GET THE ADDRESS OF THE ALLEDGED OBJ
	LOAD	S2,.QEITN(AP)		;GET THIS GUY'S ITN
	CAME	S2,OBJITN(S1)		;MATCH?
	$STOP(RUJ,Releasing Uninterlocked Job)
	ZERO	OBJITN(S1)		;CLEAR THE ITN WORD
	MOVE	S2,OBJSCH(S1)		;GET THE SCHEDULING STATUS BITS
	TXZ	S2,OBSBUS		;NO LONGER BUSY !!!
	TXNE	S2,OBSSER		;ARE WE STOPPING BETWEEN REQUESTS ???
	TXO	S2,OBSSTP		;YES,,LIGHT THE STOP BIT
	MOVEM	S2,OBJSCH(S1)		;SAVE THE NEW STATUS BITS
	ZERO	.QEOBJ(AP)		;CLEAR THE REVERSE INTERLOCK
	PUSHJ	P,A$OBST##		;AND UPDATE THE STATUS
	$RETT				;AND RETURN
	END