Trailing-Edge
-
PDP-10 Archives
-
BB-F494Z-DD_1986
-
10,7/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
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
; 1983, 1984, 1985, 1986
; DIGITAL EQUIPMENT CORPORATION
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC,D60UNV ;PARAMETER FILE
PROLOG(QSRSCH) ;GENERATE NECESSARY SYMBOLS
SEARCH ORNMAC ;GET WTO PARAMETERS.
%%.QSR==:%%.QSR
QSRVRS==:QSRVRS
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.6 ;NO GOOD, TRY NEXT
TXNN S1,OBSSEJ ;DO WE WANT TO SHUT IT DOWN ??
JRST SCHD.2 ;NO,,KEEP ON GOING ...
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+OBSFCH ;[1163] ARE WE IGNORING OR STOPPED BY OPR
;[1163] OR CHANGING FORMS?
JRST SCHD.6 ;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
TDNE S1,OBJSCH(P1) ;WHAT ARE WE DOING ?
JRST SCHD.3 ;SPOOLING TO A DEVICE
JUMPT SCHD.3 ;JUMP IF NODE ONLINE
IFN FTDQS,<
MOVX S1,NETSRV ;SERVER BIT
TDNN S1,NETSTS(S2) ;IS IT A SERVER NODE?
>; END IFN FTDQS
JRST SCHD.6 ;NODE OFF-LINE OR NOT SPOOLING
SCHD.3: LOAD P2,OBJSCH(P1),OBSQUH ;GET ADDRESS OF QUEUE HEADER
LOAD S1,.QHTYP(P2),QH.IKS ;GET "IMMUNE TO KSYS" BIT
PUSH P,S1 ;SAVE FOR A SECOND
LOAD P2,.QHPAG(P2),QH.SCH ;GET ADDRESS OF SCHEDULING VECTOR
SKIPE S1,OBJRID(P1) ;CHECK AND LOAD NEXT REQUEST-ID
PUSHJ P,[PUSHJ P,A$FREQ## ;LOCATE THE REQUEST
SETZM OBJRID(P1) ;ZAP OLD REQUEST ID
SKIPT ;FIND IT?
SETZ S1, ;NO
POPJ P,] ;RETURN
POP P,S2 ;GET BIT BACK
SKIPGE G$KSYS## ;KSYS TIME OUT YET?
JUMPE S2,SCHD.6 ;YES--JUMP IF QUEUE SHUT OFF BY KSYS
JUMPN S1,SCHD.4 ;JUMP IF HAVE 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.5 ;NO JOBS,SEE IF REMOTE AND GET NEXT OBJ
SCHD.4: 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.5: PUSHJ P,CHKOBJ ;Q IS EMPTY,,DO END-OF-QUEUE PROCESSING
SCHD.6: LOAD P1,.QELNK(P1),QE.PTN ;POINT TO NEXT OBJECT
JRST SCHD.1 ;AND LOOP
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!OBSFCH ;[1163] 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
IFN FTDQS,<
MOVX S1,NETSRV ;SERVER BIT
TDNE S1,NETSTS(S2) ;IS IT A SERVER NODE?
JRST SCH2.0 ;YES, PRETEND IT'S ON-LINE
>; END IFN FTDQS
;Here if Node is Offline
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 !
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: MOVE S1,P1 ;COPY OBJ
PUSHJ P,S$FPSB ;FIND THE PROCESSOR STATUS BLOCK
JUMPF SCH2.5 ;NO PROCESSOR,,TRY NEXT OBJECT
PUSHJ P,S$SETU ;SEND SETUP MSG TO 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
SUBTTL S$FPSB - Find PSB for setup/scheduling
; Find the processor status block and perform the appropriate
; translations for DN60 mutilation mode.
; Call: MOVE S1, address of OBJ
; PUSHJ P,S$FPSB
;
; TRUE return: S1 contains the PSB and S2 contains the OBJ
; FALSE return: No PSB for object
S$FPSB::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;COPY OBJ BLOCK ADDRESS
MOVE S1,OBJNOD(P1) ;GET OBJECT'S NODE NUMBER
PUSHJ P,N$NODE## ;FIND QUEUE ENTRY
MOVE S1,OBJTYP(P1) ;GET THE OBJECT TYPE
LOAD S2,NETSTS(S2),NT.MOD ;GET THE OBJECT MODE
CAIN S2,DF.EMU ;EMULATION NODE?
MOVEI S1,.OTIBM ;YES--SEARCH FOR EMULATION SPOOLER
FPSB.1: LOAD S2,OBJDAT(P1),RO.ATR ;GET THE OBJECT ATTRIBUTES
PUSHJ P,A$GPSB## ;GET A PSB FOR THIS OBJECT
$RETIF ;NO PROCESSOR YET
MOVE S2,P1 ;GET OBJ BACK
$RETT ;RETURN
SUBTTL S$SETU -- 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
S$SETU::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
MOVE S2,(S1) ;GET OBJECT TYPE
CAIE S2,.OTFAL ;FAL?
JRST SETU.A ;NO, SKIP THIS
MOVE S2,OBJPRM+.OBNTY(P2) ;YES, GET FAL NETWORK TYPE
MOVEM S2,SUP.CN(P3) ;PUT IN CONDITION WORD OF SETUP MSG
SETU.A: MOVEI S2,SUP.TY(P3) ;POINT TO THE DESTINATION OBJECT IN MSG
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),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:
IFN FTDQS,<
LOAD S1,NETSTS(P4),NETSRV ;GET SERVER BIT
STORE S1,SUP.FL(P3),SUFSRV ;COPY TO SETUP MESSAGE
>; END IFN FTDQS
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
SETU.1: LOAD S1,NETSTS(P4),NETIBM ;IS THIS AN IBM (DN60) REMOTE STATION
JUMPN S1,SETU.2 ;YES--SKIP DEVICE CHARACTERISTICS STUFF
MOVE S1,OBJPRM+.OOUNT(P2) ;GET UNIT TYPE
MOVEM S1,SUP.UT(P3) ;SET FOR SMART LPT DRIVERS
MOVE S1,OBJPRM+.OOMTA(P2) ;GET MAGTAPE CHARACTERISTICS
MOVEM S1,SUP.MT(P3) ;DITTO
MOVSI S1,OBJPRM+.OOVSN(P2) ;POINT TO VOLUME-SET NAME
HRRI S1,SUP.VS(P3) ;MAKE A BLT POINTER
BLT S1,SUP.VS+VSNLEN-1(P3) ;COPY
SETU.2: 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
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
SKIPE S2 ;NORMAL SHUTDOWN?
SKIPA S1,[%GENRC] ;YES
LOAD S1,OBJDAT(P1),RO.ATR ;ELSE PRESERVE ATTRIBUTES IF INTERNAL
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
MOVE S2,OBJTYP(P1) ;GET OBJECT TYPE
TXNE S1,OBSFRR ;IS THIS FREE RUNNING?
CAXN S2,.OTFAL ;YES, BUT IS IT FAL?
TRNA ;NOT FREE RUNNING OR IS FAL
$RETT ;FREE RUNNING, NOT FAL, RETURN
;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
LOAD S1,NETSTS(S2),NETIBM ;GET THE IBM REMOTE INDICATOR
JUMPE S1,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,.SAVE3 ;SAVE SOME ACS
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 P3,S1 ;SAVE PSB ADDRESS
MOVE P1,PSBPID(P3) ;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.1 ;YES,,SKIP BUSY CHECK
LOAD S1,OBJSCH(P1),OBSFRR ;GET FREE RUNNING BIT.
JUMPN S1,RSET.1 ;IF SET,,THEN DONT RE-QUEUE.
LOAD S1,OBJSCH(P1),OBSBUS ;GET BUSY BIT
JUMPE S1,RSET.1 ;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.1: SETZM P2 ;CLEAR P2
MOVE S1,OBJNOD(P1) ;GET THIS GUYS NODE NAME/NUMBER
PUSHJ P,N$NODE## ;FIND IT IN OUR DATA BASE
LOAD S1,NETSTS(S2),NETIBM ;IS THIS AN IBM REMOTE STATION ???
SKIPE S1 ;CHECK THE BIT !!
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.3 ;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
MOVE S1,RSU.UT(M) ;GET SIXBIT UNIT TYPE IF ANY
MOVEM S1,OBJPRM+.OOUNT(P1) ;SAVE FOR SCHEDULING
LOAD S1,OBJDAT(P1),RO.ATR ;GET ATTRIBUTES
HRLZS S1 ;PUT IN LH
HRR S1,OBJTYP(P1) ;INCLUDE OBJECT TYPE
MOVE S2,P3 ;GET PSB ADDRESS
PUSHJ P,A$APSB## ;ADJUST PSB OBJECT/ATTRIBUTE PARAMETERS
MOVX S1,OBSDAA ;REMEMBER WE HAVE THE
IORM S1,OBJSCH(P1) ; DEVICE ATTRIBUTES NOW
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.3: 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.4 ;NO, TRY OTHERS
;Here if the Object Does Not Exist.
SETZM OBJPRM+.OOUNT(P1) ;CLEAR POSSIBLY STALE UNIT TYPE
MOVX S1,OBSSUP+OBSSIP+OBSDAA ;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.4: 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
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
;**;[1145]CHANGE 1 LINE AT SETIGN:+5L 15-AUG-83/CTK
MOVX S1,TIMONA ;[1145]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.2 ;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 ;IS THIS AN IBM TYPE NODE ???
$RETT ;YES,,NO INTERNAL SHUTDOWN
PUSH P,S1 ;SAVE NODE
MOVE S1,OBJTYP(P1) ;GET OBJECT TYPE
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER
JUMPF CHKO.1 ;SHOULD NEVER FAIL
LOAD S1,.QHTYP(S1),QH.TYP ;GET QUEUE TYPE
CAIN S1,.QHTOU ;OUTPUT?
SKIPN S1,OBJPRM+.OOTAP(P1) ;GET DEVICE NAME
JRST CHKO.1 ;NOT OUTPUT OR NO DEVICE NAME
PUSHJ P,N$WHERE## ;GET DEVICE'S STATION NUMBER
JUMPF CHKO.1 ;NOT CURRENTLY ONLINE
MOVEM S1,(P) ;SAVE
CHKO.1: POP P,S1 ;GET NODE
PUSHJ P,N$LOCL## ;SEE IF IT IS THE CENTRAL SITE.
JUMPT .RETT ;IF SO,,NO SHUTDOWN
MOVE S1,OBJSCH(P1) ;[1163] GET SCHEDULING BITS
TXNE S1,OBSFCH ;[1163] CHANGING FORMS
$RETT ;[1163] YES,,DON'T SHUTDOWN YET
CHKO.2: MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1.
PUSHJ P,SHTINT ;SHUT DOWN THE OBJECT
MOVX S1,OBSSUP+OBSBUS+OBSSEJ+OBSSIP+OBSINT+OBSSTP+OBSFCH ;[1163] 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.
;**;[1132]REVAMP CODE AT INPF.1:+23L 15-APR-83/CTK
LOAD P2,OBJPRM+.OBTIM(P1),OBPMIN ;GET MIN
IMULI P2,^D60 ;[1132]MINUTES TO SECONDS
LOAD P3,OBJPRM+.OBTIM(P1),OBPMAX ;GET MAX
IMULI P3,^D60 ;[1132]MINUTES TO SECONDS
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
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 ALLOWED
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
;**;[1201]ADD 8 LINES BEFORE INPF.3:+0L 30-MAR-84/CTK
GETLIM S1,.QELIM(P4),ONOD ;[1201]GET /DESTINATION SWITCH
;**;[1206]ADD 1 LINE AT EDIT 1201+1L 20-APR-84/CTK
JUMPE S1,INPF.3 ;[1206]CENTRAL SITE ???
PUSHJ P,N$GNOD## ;[1201]NO, DOES THE NODE EXIST ???
JUMPF INPF.4 ;[1201]DID WE FIND THE NODE ???
MOVE S1,NETNBR(S2) ;[1201]YES, GET THE NUMBER
JUMPE S1,INPF.4 ;[1201]IS THERE A NODE NUMBER ???
STOLIM S1,.QELIM(P4),ONOD ;[1201]YES, SAVE IT IN THE QE
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/NAME
SKIPN S1 ;HE SET IT, SO SKIP THIS
;**;[1201]REVAMP CODE AT INPDEF:+18L 30-MAR-84/CTK
MOVE S1,G$LNBR## ;[1201]DEFAULT, TO LOCAL NODE NUMBER
TLNN S1,600000 ;[1201]IS IT BINARY ?
JRST INPD.0 ;[1201]YES, DON'T CONVERT
PUSHJ P,N$GNOD## ;[1201]CONVERT NODE NAME TO NUMBER
JUMPF INPD.0 ;[1201]DID WE FIND THE NODE ???
SKIPE S1,NETNBR(S2) ;[1201]GET THE NUMBER IF ANY
INPD.0: STOLIM S1,.EQLIM(M),ONOD ;[1201]SAVE IT IN THE EQ
GETLIM S1,.EQLIM(M),CORE ;GET /CORE VALUE
MOVEI S2,INPCOR ;GET DEFAULT
CAMGE S2,G$MCOR## ;LESS THAN MINMAX?
MOVE S2,G$MCOR## ;MUST RAISE
CAMLE S2,G$XCOR## ;GREATER THAN CORMAX?
MOVE S2,G$XCOR## ;MUST LOWER
SKIPN S1 ;/CORE SUPPLIED?
MOVE S1,S2 ;NO--DEFAULT IT
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
$RETIF ;CHECK FOR ERRORS
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
;**;[1214]ADD 1 ENTRY TO INPMTP TABLE 14-MAY-84/CTK
;THIS REFLECTS CHANGES TO QMANGR AND QUENCH, THE /BEGIN
;WORD IN THE MODIFY MESSAGE IS NOW THE 12TH ENTRY.
;THIS EDIT REQUIRES QMANGR EDIT 2255.
STOLIM P3,.EQLIM(AP),OINT ;[1214]11 = /ASSIST
PUSHJ P,MODBEG ;[1214]12 = /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
;**;[1213]ADD 6 LINES AT LPTDEF:+4L 6-MAY-84/CTK
LOAD S2,.EQLEN(M),EQ.LOH ;[1213]GET LENGTH OF HEADER
ADDI S2,(M) ;[1213]POINT TO FIRST FP
LOAD S2,.FPINF(S2),FP.FCY ;[1213]GET NUMBER OF COPIES
GETLIM S1,.EQLIM(M),OLIM ;[1213]GET OUTDEF LIMIT
CAMGE S1,S2 ;[1213]OUTDEF LIMIT < # OF COPIES
STOLIM S2,.EQLIM(M),OLIM ;[1213]YES,SAVE THE NUMBER OF COPIES
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 EVT -- Event queue dependent functions
;The EVT queue scheduler vector
S$EVT:: JRST EVTLNK ;LINK IN A NEW REQUEST
JRST EVTSCH ;SCHEDULE A REQUEST
JRST EVTDEF ;FILL IN DEFAULTS FOR A REQUEST
JRST EVTMOD ;MODIFY EVT PARAMETERS
JRST EVTRJI ;RELEASE A REQUEST INTERLOCK
JRST EVTFJB ;FIND A REQUEST
;<- - - - - - - - - - - - - - - - - - - - - - - - ->
EVTLNK: DOSCHD ;FORCE A SCHEDULING PASS
$SAVE E ;SAVE E
MOVE S1,.QECRE(AP) ;GET EXPIRATION TIME
LOAD E,.QHLNK(H),QH.PTF ;AND POINT TO THE FIRST IN THE QUEUE
EVTL.1: JUMPE E,EVTL.2 ;END-OF-LIST, LINK AT THE END
CAMGE S1,.QECRE(E) ;NEW EXP TIME BEFORE THIS ONE?
JRST EVTL.2 ;YES
LOAD E,.QELNK(E),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST EVTL.1 ;AND LOOP
EVTL.2: PUSHJ P,M$LINK## ;LINK INTO QUEUE
$RETT ;AND RETURN
EVTDEF: PUSHJ P,A$WHEEL## ;IS THIS GUY PRIVED?
MOVX S1,.QIFNC ;BIT TO TEST
TDNN S1,.MSTYP(M) ;INTERNAL FUNCION?
JUMPF .POPJ ;NO--REQUESTOR MUST BE PRIV'ED
GETLIM S1,.EQLIM(M),TYPE ;GET EVENT TYPE CODE
JUMPLE S1,.RETF ;CODE 0 IS ILLEGAL
CAILE S1,.EVMAX ;REASONABLE?
$RETF ;NO
MOVE S2,EVTNAM(S1) ;TRANSLATE TO EVENT NAME
MOVEM S2,.EQJOB(M) ;STORE AS "JOB" NAME
SKIPN .EQAFT(M) ;HAVE AN AFTER PARAMETER?
SETOM .EQAFT(M) ;SET IT TO NOW
MOVX S2,.QIFNC ;BIT TO TEST
TDNE S2,.MSTYP(M) ;INTERNAL FUNCTION?
JRST EVTD.0 ;WE TRUST OUTSELF
MOVE S2,EVTBIT(S1) ;GET SCHEDULER BITS
TXNE S2,EV.INT ;INTERNAL?
$RETF ;GIVE UP
EVTD.0: GETLIM S1,.EQLIM(M),REPT ;GET REPEAT TIMES
TXNN S1,QB.DLY!QB.WKY ;DAILY OR WEEKLY IMPLY FAILSOFTING
JRST [GETLIM S1,.EQLIM(M),FAIL ;ELSE GET FAILSOFT BIT
JRST EVTD.1] ;AND CONTINUE
MOVEI S1,1 ;IMPLIED FAILSOFT
EVTD.1: GETLIM S2,.EQLIM(M),NOFS ;GET NOFAILSOFT FLAG
TRZ S1,(S2) ;NOFAILSOFT TAKES PRECEDENCE
STOLIM S1,.EQLIM(M),FAIL ;SET THE BIT CORRECTLY.
GETLIM S1,.EQLIM(M),REQT ;GET REQUEUE TIME SET BIT
JUMPN S1,.RETT ;JUST RETURN IF ALREADY IN QUEUE
PUSHJ P,EVTTIM ;NO--SETUP INITIAL EXPIRATION DATE/TIME
JUMPF E$ICM## ;ILLEGAL CREATE
PUSHJ P,EVTFIL ;DO AUTO-FILE DEFAULTING
JUMPF E$ICM## ;ILLEGAL CREATE
PUSHJ P,EVTCMP ;COMPARE ENTRIES
JUMPF E$APE## ;ALREADY PENDING ENTRY
$RETT
EVTMOD: $RETT
EVTSCH: MOVE AP,S1 ;COPY QE ADDRESS
MOVE S1,OBJSCH(S2) ;GET SCHEDULER STATUS BITS
TXZ S1,OBSBUS ;EVENT PROCESSOR IS NEVER BUSY
TXO S1,OBSINV ; AND IS ALWAYS INVISIBLE
MOVEM S1,OBJSCH(S2) ;UPDATE
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT TYPE
HLRZ S1,EVTDSP(S1) ;GET SCHEDULER ROUTINE
SKIPE S1 ;AVOID ILL MEM REFS
PUSHJ P,(S1) ;DISPATCH
$RETT ;AND RETURN
EVTRJI: MOVEI S1,0 ;FIRST CLEAR THE
STOLIM S1,.QELIM(AP),ACTV ; ACTIVE STATUS
GETLIM S1,.QELIM(AP),FILE ;SEE IF AUTO-FILE
SKIPE S1 ; PROCESSING WAS
PUSHJ P,A$AUTO## ; REQUESTED
GETLIM S1,.QELIM(AP),REPT ;GET REPEAT FLAGS
TXNN S1,QB.NOW ;ONLY ONE SHOT?
TXNN S1,QB.DLY!QB.WKY ;ONLY VALID BITS WE CARE ABOUT
PJRST Q$KPRO## ;REMOVE FROM QUEUE
TXNE S1,QB.DLY ;DAILY?
MOVSI S2,1 ;YES
TXNE S1,QB.WKY ;WEEKLY?
MOVSI S2,7 ;YES
MOVE S1,S2 ;COPY INCREMENT
ADD S1,.QECRE(AP) ;ADVANCE DATE
PJRST Q$EVTM## ;GO DO SPECIAL MODIFY
MOVEI H,HDREVT## ;POINT TO QUEUE HEADER
PUSHJ P,M$DLNK## ;UNLINK ENTRY FROM QUEUE
PUSHJ P,EVTLNK ;RELINK ENTRY BACK INTO THE QUEUE
$RETT
EVTFJB: LOAD S1,HDREVT##+.QHLNK,QH.PTF ;GET FIRST ITEM IN THE QUEUE
EVTF.1: JUMPE S1,.RETF ;FAIL IF NO JOBS
GETLIM S2,.QELIM(S1),ACTV ;GET ACTIVE BIT
JUMPN S2,EVTF.2 ;SKIP THIS ENTRY IF SET
MOVX S2,QE.HBO!QE.RDE ;GET THE HELD BY OPR BIT
TDNE S2,.QESEQ(S1) ;HELD BY OPR (REALLY QUASAR HERE)
JRST EVTF.2 ;YES--TRY ANOTHER
GETLIM S2,.QELIM(S1),TYPE ;GET EVENT TYPE CODE
MOVE S2,EVTBIT(S2) ;AND ASSOCIATED BITS
TXNE S2,EV.CHK ;ALWAYS CHECK THIS ONE?
$RETT ;YES
MOVE S2,.QECRE(S1) ;GET EXPIRATION DATE/TIME
CAMG S2,G$NOW## ;PAST CURRENT UDT YET?
$RETT ;YES--SCHEDULER THIS EVENT
EVTF.2: LOAD S1,.QELNK(S1),QE.PTN ;GET NEXT
JRST EVTF.1 ;AND LOOP
SUBTTL FAL -- FAL Queue Dependent Routines
;FAL scheduler vector
S$FAL:: JRST FALLNK ;LINK IN A JOB
JRST FALSCH ;SCHEDULE A JOB FOR AN OBJECT
JRST FALDEF ;FILL IN DEFAULTS FOR A JOB
JRST FALMOD ;MODIFY RDR PARAMETERS
JRST FALRJI ;RELEASE A JOB INTERLOCK
JRST FALFJB ;FIND A JOB FOR AN OBJECT
;<- - - - - - - - - - - - - - - - - - - - - - - - ->
FALLNK: $RETT
FALSCH: MOVE TF,OBJSTS(S2) ;GET OBJECT STATUS
MOVE S1,OBJSCH(S2) ;GET SCHEDULING BITS
CAXE TF,%IDLE ;FAL STREAM IDLE?
TXOA S1,OBSBUS ;NO, SET BUSY BIT
TXZ S1,OBSBUS ;YES, SET BUSY BIT
MOVEM S1,OBJSCH(S2) ;PUT FLAGS BACK
$RETT ;RETURN
FALDEF: $RETT
FALMOD: $RETT
FALRJI: $RETT
FALFJB: $RETT
; Routine to compare events. This is needed to avoid
; conflicting entries in the queue for the same event
; type, repeat bits, and optional filespec.
EVTCMP: PUSHJ P,.SAVE3 ;SAVE SOME ACS
$SAVE <AP> ;SAVE AP
GETLIM P1,.EQLIM(M),TYPE ;GET NEW EVENT TYPE CODE
MOVE P2,.EQAFT(M) ;GET NEW EXPIRATION DATE/TIME
LOAD P3,.EQSPC(M),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
JUMPE P3,EVTC.1 ;SKIP LOTS OF WORK IF THERE ISN'T ONE
LOAD P3,.EQLEN(M),EQ.LOH ;GET LENGTH OF HEADER
ADD P3,M ;POINT TO THE FP
LOAD S1,.FPLEN(P3),FP.LEN ;GET LENGTH OF FP
ADD P3,S1 ;POINT TO THE FD
HRLI P3,-FDXSIZ ;MAKE AN AOBJN POINTER
EVTC.1: LOAD AP,.QHLNK(H),QH.PTF ;POINT TO THE FIRST ENTRY
EVTC.2: JUMPE AP,.RETT ;CHECK FOR END OF LIST
GETLIM S1,.QELIM(AP),TYPE ;GET EXISTING EVENT TYPE CODE
CAME P1,S1 ;SAME?
JRST EVTC.4 ;NO
MOVE S1,.QECRE(AP) ;GET EXISTING EXPIRATION DATE/TIME
GETLIM S2,.QELIM(AP),REPT ;GET EXISTING REPEAT BITS
TXNE S2,QB.DLY!QB.WKY ;DAILY OR WEEKLY?
TLZA S1,-1 ;YES--ONLY COMPARE TIMES, NOT DATES
SKIPA S2,P2 ;GET NEW DATE/TIME
HRRZS S2,P2 ;GET NEW TIME
CAME S1,S2 ;SAME?
JRST EVTC.4 ;NO
CAIE P1,.EVATO ;ONLY CHECK FILE STUFF FOR AUTO-FILE
$RETF ;SAME KSYS TIME, BOMB NEW REQUEST
MOVE S1,P3 ;GET AOBJN POINTER TO NEW FD
GETLIM S2,.QELIM(AP),FILE ;POINT TO EXISTING FD
CAMN S1,S2 ;NO FILE IN EITHER REQUEST?
$RETF ;THEN THEY'RE IDENTICAL REQUESTS
SKIPE S1 ;NEW REQUEST HAVE A FILE?
SKIPN S2 ;EXISTING REQUEST HAVE A FILE?
JRST EVTC.4 ;NO TO EITHER
HRLI S2,-FDXSIZ ;MAKE AN AOBJN POINTER TO OLD FD
EVTC.3: MOVE TF,(S1) ;GET OLD FD WORD
CAME TF,(S2) ;COMPARE TO NEW FD WORD
JRST EVTC.4 ;NO MATCH
AOBJN S1,.+1 ;ADVANCE
AOBJN S2,EVTC.3 ;AND LOOP
$RETF ;ALREADY PENDING EVENT
EVTC.4: LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST EVTC.2 ;AND LOOP
; Defaulting subroutine to compute the correct starting
; expiration date/time.
EVTTIM: MOVE S1,.EQAFT(M) ;GET EXPIRATION DATE/TIME
GETLIM S2,.EQLIM(M),REPT ;GET REPEAT FLAGS
TXNN S2,QB.NOW ;IS IT A 'NOW' EVENT?
JRST EVTT.1 ;NO--CONTINUE
MOVE S1,G$NOW## ;YES--GET CURRENT TIME
JRST EVTT.5 ;FINISH UP
EVTT.1: TXNN S2,QB.DLY!QB.WKY ;DAILY OR WEEKLY?
JRST EVTT.5 ;NO
PUSHJ P,.SAVE4 ;SAVE SOME ACS
HRRZ P2,G$NOW## ;GET CURRENT DATE/TIME
HLRZ P1,G$NOW## ;AND JUST THE DATE PORTION
TLZ S1,777777 ;CLEAR DATE FROM TIME OPR TIME ARGUMENT
TXNN S2,QB.DLY ;DAILY?
JRST EVTT.2 ;NO--MUST BE WEEKLY
CAIG S1,(P2) ;TIME COMPONENT BEYOND CURRENT TIME?
AOS P1 ;YES--ROUND UP TO THE NEXT DAY
HRL S1,P1 ;COMPLETE INITIAL DATE/TIME WORD
JRST EVTT.5 ;FINISH UP
EVTT.2: TXNN S2,QB.WKY ;SANITY CHECK FOR WEEKLY FLAG
$RETF ;OR WE'LL HAVE TO GIVE UP
LOAD S2,S2,QB.DAY ;KEEP ONLY DAY OF WEEK INDEX
CAIL S2,0 ;RANGE CHECK DAY-OF-WEEK INDEX
CAILE S2,6 ;WEDNESDAY=0 , THURSDAY=1, ETC.
$RETF ;BAD MESSAGE
DMOVE P3,P1 ;P3 = CURRENT DATE, P4 = CURRENT TIME
IDIVI P1,7 ;GET DAY INDEX FROM UDT INTO P2
SUB S2,P2 ;GET DIFFERENCE BETWEEN TODAY & OPR ARG
JUMPE S2,EVTT.3 ;JUMP IF THEY'RE THE SAME
SKIPG S2 ;IN THE FUTURE?
ADDI S2,7 ;ELSE ROUND UP TO SAME DAY NEXT WEEK
ADDI P3,(S2) ;OFFSET BY DAY SPECIFIED BY OPR
JRST EVTT.4 ;GO FINISH UP
EVTT.3: CAIG S1,(P4) ;CURRENT TIME PAST REQUESTED TIME?
ADDI P3,7 ;YES--ADVANCE TO NEXT WEEK
EVTT.4: HRL S1,P3 ;FORM INITIAL DATE/TIME ARGUMENT
EVTT.5: GETLIM S2,.EQLIM(M),TYPE ;GET NEW EVENT TYPE CODE
CAIN S2,.EVKSY ;KSYS?
PUSHJ P,I$KTIM## ;STRIP OFF SECONDS
MOVEM S1,.EQAFT(M) ;UPDATE EXPIRATION DATE/TIME
$RETT ;AND RETURN
; Routine to handle special auto-file defaulting
EVTFIL: LOAD S1,.EQSPC(M),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
JUMPE S1,.RETT ;RETURN IF NONE
CAIE S1,1 ;CAN ONLY HAVE 1
$RETF ;CUZ MORE THAN ONE DOESN'T MAKE SENSE
LOAD S1,.EQLEN(M),EQ.LOH ;GET LENGTH OF THE HEADER
ADD S1,M ;POINT TO THE FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADD S1,S2 ;OFFSET TO THE FD
SKIPE S2,.FDSTR(S1) ;GET STR NAME
CAMN S2,['DSK '] ;GENERIC DSK?
MOVE S2,G$QSTR## ;DEFAULT TO QUEUE STRUCTURE
MOVEM S2,.FDSTR(S1) ;UPDATE
SKIPN S2,.FDNAM(S1) ;GET NAME
MOVSI S2,'OPR' ;DEFAULT TO OPR
MOVEM S2,.FDNAM(S1) ;UPDATE
HLLZ S2,.FDEXT(S1) ;GET EXTENSION
SKIPN S2 ;HAVE ONE?
MOVSI S2,'CMD' ;DEFAULT TO .CMD
HLLM S2,.FDEXT(S1) ;UPDATE
SKIPN S2,.FDPPN(S1) ;HAVE A PPN?
MOVE S2,G$SPLD## ;DEFAULT TO QUEUE PPN
MOVEM S2,.FDPPN(S1) ;UPDATE
$RETT ;RETURN
; Event "JOB" name table
DEFINE X (ABV,NAME,SCHED,KILL,BITS,TEXT),<EXP <SIXBIT/NAME/>>
EVTNAM: EXP 0 ;EVENT CODE 0 IS ILLEGAL
EVENTS
; Event scheduler,,kill routines
DEFINE X (ABV,NAME,SCHED,KILL,BITS,TEXT),<
GLOB <SCHED,KILL>
XWD SCHED,KILL
>
EVTDSP::EXP 0 ;EVENT CODE 0 IS ILLEGAL
EVENTS
; Event scheduler bits
DEFINE X (ABV,NAME,SCHED,KILL,BITS,TEXT),<BITS>
EVTBIT: EXP 0 ;EVENT CODE 0 IS ILLEGAL
EVENTS
; Event default description text
DEFINE X (ABV,NAME,SCHED,KILL,BITS,TEXT),<
IFDIF <TEXT><>,<
EXP [ASCIZ\TEXT\]
>
IFIDN <TEXT><>,<EXP 0>
>
EVTDSC::EXP 0
EVENTS
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
;**;[1137]ADD 9 LINES AT OUFS.1:-1L 14-JUL-83/CTK
HRRZ S1,P4 ;[1137]GET INDEX
CAIE S1,4 ;[1137]PRESERVE/DELETE ???
JRST OUFS.1 ;[1137]NO...NORMAL PROCESSING
MOVE S1,.FPINF(T1) ;[1137]YES..GET THE WORD
TXNN S1,FP.REN ;[1137]OLD FILE /DISP:RENAME ???
JRST OUFS.1 ;[1137]NO...
SOS MODI.C##+0 ;[1137]YES WE CAN'T DO THAT !!!
AOS MODI.C##+3 ;[1137]GIVE AN ERROR MESSAGE
$RETT ;[1137]RETURN WITHOUT MODIFING
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
IFN FTDQS,<
DMOVE S1,[ASCIZ /NORMAL/] ;DEFAULT LONG FORMS NAME
SKIPN .EQFRM(M) ;...
DMOVEM S1,.EQFRM(M) ;...
>; END IFN FTDQS
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
SKIPE G$ERR## ;ANY ERRORS YET?
POPJ P, ;YES, DON'T RENAME FILES
$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
SKIPN S1,.QEROB+.ROBUT(P1) ;GET THE REQUESTED UNIT TYPE
MOVE S1,OBJPRM+.OOUNT(P2) ;NONE--ALWAYS MATCH THAT OF OBJECT
CAME S1,OBJPRM+.OOUNT(P2) ;SAME?
$RETF ;NO
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
IFN FTDQS,<
MOVE S1,OBJNOD(P2) ;GET THE NODE NAME
PUSHJ P,N$GNOD## ;GET THE NODE ENTRY
JUMPF .RETF ;FAIL IF NOT DEFINED (HUH?)
LOAD S1,NETSTS(S2),NETSRV ;SEE IF A SERVER NODE
JUMPN S1,OUTF.1 ;IF SO, SKIP FORMS CHECK
>; END IFN FTDQS
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
OUTF.1: $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.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 EQDF.0 ;[1161] EITHER A WHEEL OR PRIO IS OK
MOVX S1,EQ.CHG ;[1161] GET PRIORITY WAS CHANGED BIT
IORM S1,.EQSEQ(M) ;[1161] LITE IT IN EQ
MOVX S2,MXUPRI ;LOAD MAX PRIO
EQDF.0: STORE S2,.EQSEQ(M),EQ.PRI ;[1161] 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