Trailing-Edge
-
PDP-10 Archives
-
BB-JR93L-BB_1990
-
10,7/galaxy/quasar/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) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1985,1986,1987. ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC,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::SETOM G$PASS## ;INDICATE PASS 1
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
MOVX S1,NETLAT!NETSRV ;LAT and SERVER bits
TDNN S1,NETSTS(S2) ;IS IT A SERVER NODE?
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
JUMPN S1,SCHD.4 ;JUMP IF HAVE A NEXT'ED REQUEST
SKIPGE G$KSYS## ;KSYS TIME OUT YET?
JUMPE S2,SCHD.6 ;YES--JUMP IF QUEUE SHUT OFF BY KSYS
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: AOS G$PASS## ;INDICATE PASS 2
LOAD P1,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJECT
SCH2.2: JUMPE P1,SCH3.1 ;DO PASS 3 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
MOVX S1,NETLAT!NETSRV ;LAT and SERVER bits
TDNE S1,NETSTS(S2) ;IS IT A SERVER NODE?
JRST SCH2.0 ;YES, PRETEND IT'S ON-LINE
;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: MOVE S1,OBJTYP(P1) ;GET OBJECT TYPE
CAIN S1,.OTNQC ;NETWORK QUEUE CONTROLLER?
JRST SCH2.5 ;IGNORE IT (SAVE FOR PASS 3)
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
TXO S1,OBSINT ; FLAG INTERNAL SETUP
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 Pass 3 of the scheduler
;PASS 3 SCHEDULES JOBS FOR THE NETWORK QUEUE CONTROLLER
SCH3.1: AOS G$PASS## ;INDICATE PASS 3
LOAD P1,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJECT
MOVEI P2,HDRQNM## ;POINT TO NET QUEUE NAME HEADER
LOAD P2,.QHPAG(P2),QH.SCH ;GET SCHEDULING VECTOR ADDRESS
SKIPA ;ENTER LOOP
SCH3.2: LOAD P1,.QELNK(P1),QE.PTN ;GET POINTER TO NEXT OBJ
JUMPE P1,.RETT ;RETURN WHEN DONE
MOVEI S1,.OTNQC ;OBJECT TYPE
MOVE P3,OBJSCH(P1) ;GET THE SCHEDULING BITS
TXC P3,OBSSTA ;COMPLEMENT STARTED
CAMN S1,OBJTYP(P1) ;NETWORK QUEUE CONTROLLER?
TXNE P3,OBSSTA+OBSBUS+OBSSTP+OBSSIP ;MUST BE STARTED, NOT BUSY,
;NOT STOPPED AND NOT SETUP-IN-PROGRESS
JRST SCH3.2 ;NO, TRY NEXT OBJECT
LOAD S1,OBJDAT(P1),RO.ATR ;YES, GET ATTRIBUTES
CAIN S1,%NQOUT ;OUTPUT STREAM?
SKIPA S1,P1 ;YES, COPY OBJ ADDRESS
JRST SCH3.2 ;NO, TRY NEXT OBJECT
SKIPE OBJRID(P1) ;"NEXT" REQUEST PENDING?
JRST SCH3.3 ;GO START IT
PUSHJ P,SCHFJB(P2) ;FIND A JOB TO RUN
JUMPF SCH3.2 ;IF NONE, TRY NEXT OBJECT
TXNN P3,OBSSUP ;SETUP?
JRST SCH3.5 ;NO, GO SET IT UP
TXNN P3,OBSSEJ ;DO WE WANT TO SHUT IT DOWN ??
JRST SCH3.4 ;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 SCH3.2 ;ON TO NEXT OBJECT
SCH3.3: TXNN P3,OBSSUP ;SETUP YET?
JRST SCH3.5 ;MUST BE DONE FIRST
MOVE S1,OBJRID(P1) ;GET "NEXT" REQUEST ID
PUSHJ P,A$FREQ## ;RETURN QE ADDR IN S1
JUMPT SCH3.4 ;CONTINUE IF NO ERRORS
$WTO (<Request ^D/OBJRID(P1)/ does not exist>,,OBJTYP(P1))
SETZM OBJRID(P1) ;ZAP BOGUS REQUEST ID
JRST SCH3.2 ;AND TRY ANOTHER OBJECT
SCH3.4: TXNE P3,OBSIGN ;IGNORING FOR NOW?
JRST SCH3.2 ;YES, ON TO NEXT OBJECT
TXO P3,OBSBUS ;SETUP ALREADY, LITE BUSY BIT
IORM P3,OBJSCH(P1) ;TURN IT ON IN OBJECT BLOCK
MOVE S2,P1 ;ADDRESS OF OBJECT BLOCK
PUSHJ P,SCHSCH(P2) ;SCHEDULE JOB
JRST SCH3.2 ;ON TO THE NEXT OBJECT
SCH3.5: TXZE P3,OBSHUT ;INTERNAL SHUTDOWN?
PUSHJ P,[TXZ P3,OBSIGN ;YES, CLEAR IGNORE
MOVEM P3,OBJSCH(P1) ;SAVE THE FLAGS
POPJ P,]
TXNE P3,OBSIGN ;IGNORING?
JRST SCH3.2 ;YES, ON TO NEXT OBJECT
MOVE S1,P1 ;GET OBJ BLOCK ADDRESS
PUSHJ P,S$FPSB ;FIND ITS PSB
JUMPF .RETT ;WAIT TILL LATER
PUSHJ P,S$SETU ;SEND A SETUP MSG TO NEBULA
$RETT
SUBTTL S$FPSB - Find PSB for setup/scheduling
; Find the processor status block based on object type and
; attributes.
;
; Call: MOVE S1, address of OBJ
; PUSHJ P,S$FPSB
;
; TRUE return: S1 contains the PSB and S2 contains the OBJ
; FALSE return: "waiting" for processor
S$FPSB::PUSHJ P,.SAVE3 ;SAVE P1 - P3
MOVE P1,S1 ;COPY OBJ BLOCK ADDRESS
MOVE S1,OBJTYP(P1) ;GET THE OBJECT TYPE
MOVE P2,S1 ;SAVE OBJECT TYPE
LOAD S2,OBJDAT(P1),RO.ATR ;GET THE OBJECT ATTRIBUTES
MOVE P3,S2 ;SAVE ATTRIBUTES
PUSHJ P,A$GPSB## ;GET A PSB FOR THIS OBJECT
JUMPF FPSB.1 ;GO CHECK ON OBJECT PROCESSOR
MOVE S2,P1 ;GET OBJ BACK
$RETT ;RETURN
;Look for object processor PSB that's in the process of starting
;up. If not found, set it so one is started
FPSB.1: SKIPE DEBUGW ;DEBUGGING?
$RETF ;YES, FORGET IT
DMOVE S1,P2 ;GET OBJECT TYPE & ATTRIBUTES
PUSHJ P,I$GOPD## ;GET OBJECT PROCESSOR CJB
$RETIF
PUSHJ P,A$WPSB## ;FIND/CREATE "WAITING" PSB OF OBJECT
JUMPT .RETF ;IF "WAITING" PSB EXISTS, WAIT MORE
MOVEI TF,^D5 ;DEMAND SPOOLERS GET 5 TRIES
STORE TF,PSBFLG(S2),PSFCNT ;STORE IN PSB
$RETF
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?
CAIN S2,.OTNQC ;OR NETWORK QUEUE CONTROLLER?
SKIPA ;YES
JRST SETU.A ;NO, SKIP THIS
CAIE S2,.OTFAL ;FAL?
SKIPA S2,OBJDAT(P2) ;NO, GET DEVICE ATTRIBUTES AND SKIP
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
MOVX S1,OBSINT ;GET INTERNAL SETUP BIT TO TEST
MOVX S2,SUFINT ;GET INTERNAL SETUP BIT TO SET
TDNE S1,OBJSCH(P2) ;IS THIS AN INTERNAL SETUP?
IORM S2,SUP.FL(P3) ;YES, LITE BIT IN SETUP MSG
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:
HRLI S1,NETLNM(P4) ;Source,,0
HRRI S1,SUP.LN(P3) ;Source,,destination
BLT S1,SUP.LN+LPTNLN(P3) ;Copy LAT server/service/port
LOAD S1,NETSTS(P4),NETLAT ;
STORE S1,SUP.FL(P3),SUFLAT ;Copy the LAT bit
LOAD S1,NETSTS(P4),NETSRV ;GET SERVER BIT
STORE S1,SUP.FL(P3),SUFSRV ;COPY TO SETUP MESSAGE
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,OBJPRM+.OOFLG(P2),OF.LP2 ;LP20 SIMULATION
STORE S1,SUP.FL(P3),SUFLP2
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
SETZM S2 ;DON'T USE NAME FOR SEARCH
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,.SAVE2 ;SAVE P1 & P2
DMOVE P1,S1 ;SAVE OUR INPUT ARG AND ENTRY POINT
DOSCHD ;FORCE ANOTHER SCHEDULING PASS
MOVE S2,OBJSCH(P1) ;GET SCHEDULING BITS
SKIPE P2 ;DON'T CLEAR ON INTERNAL SHUTDOWN
TXZ S2,OBSDAA ;DON'T KNOW ATTRIBUTES ANYMORE
MOVX S1,%GENRC ;GET GENERIC ATTRIBUTES
TXNE S2,OBSATR ;WERE OTHERS SET IN RSETUP?
JRST SHUT.0 ;YES,,LEAVE THEM ALONE
STORE S1,OBJDAT(P1),RO.ATR ;NO,,RESET THE ATTRIBUTES
TXZ S2,OBSATR ;CLEAR ATTRIBUTES FLAGS
SHUT.0: 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 ;GET THE SHUTDOWN FLAG
SKIPN P2 ;INTERNAL SHUTDOWN?
TXO S1,SUFINT ;YES, LITE THAT BIT TOO
IORM S1,G$MSG##+SUP.FL ;SET FLAG(S) IN MESSAGE
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!OBSINT ;CLEAR SHUT AT EOJ AND INTERNAL SETUP
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
SETZM S2 ;DON'T USE NAME FOR SEARCH
PUSHJ P,A$FPSB## ;FIND THE PSB
JUMPF SHUT.A ;IF NO PSB, DONT DECR PSLCUR
LOAD S2,PSBLIM(S1),PSLCUR ;GET NUMBER OF OBJECTS SETUP
SOSL S2 ;DECREMENT COUNT, BUT DON'T STORE
STORE S2,PSBLIM(S1),PSLCUR ; IF NEGATIVE
SHUT.A: SKIPE P2 ;IF INTERNAL, DONT TELL OPERATOR
$WTO (Shutdown,,OBJTYP(P1)) ;TELL OPR IF NOT INTERNAL
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 P2 ;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
SETZM S2 ;DON'T USE NAME FOR SEARCH
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
SKIPE S1,RSU.UT(M) ;GET SIXBIT UNIT TYPE IF ANY
MOVEM S1,OBJPRM+.OOUNT(P1) ;SAVE FOR SCHEDULING
MOVE TF,OBJTYP(P1) ;GET OBJECT TYPE
LOAD S2,RSU.FL(M),OF.LP2 ;GET EXTRA ATTRIBUTES
;(MAKE A TABLE WHEN MORE)
CAXN TF,.OTLPT ;ONLY LPTS FOR NOW
STORE S2,OBJPRM+.OOFLG(P1),OF.LP2 ;SAVE LP20 SIMULATION
LOAD S1,OBJDAT(P1),RO.ATR ;GET ATTRIBUTES
HRLZS S1 ;PUT IN LH
HRR S1,TF ;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: CAXN S1,%RSUNA ;OBJECT NOT AVAILABLE NOW?
JRST RSET.4 ;YES, GO DO THE RIGHT THINGS
;Here if the Object Does Not Exist or something else
CAXE S1,%RSUDE ;OBJECT DOESN'T EXIST?
$RETT ;NO, JUST RETURN
MOVX S1,%GENRC ;GET 'GENERIC' DEVICE ATTRIBUTES
MOVE S2,OBJSCH(P1) ;GET THE SCHEDULER FLAG BITS
JUMPN P2,RSET3A ;JUMP IF IBM REMOTE OBJECT
TXZE S2,OBSATR!OBSDAA ;WERE ATTRIBUTES SET BY PROCESSOR ??
STORE S1,OBJDAT(P1),RO.ATR ;YES,,RESET THEM
MOVEM S2,OBJSCH(P1) ;SAVE THE FLAGS
RSET3A: SETZM OBJPRM+.OOUNT(P1) ;CLEAR POSSIBLY STALE UNIT TYPE
TXZ S2,OBSSUP+OBSSIP ;CLEAR SOME MORE BITS
MOVEM S2,OBJSCH(P1) ; AND SAVE THE FLAG BITS
MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1
PUSHJ P,S$SHUT ;SHUT DOWN THE OBJECT
$RETT ;AND RETURN
;Here if the Object is Not Available Right Now.
RSET.4: 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 ???
STOPCD (AIE,HALT,,<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
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
CAIE S1,.OPINS ;DEPEND ON SYSTEM SCHEDULE?
JRST INF.2A ;NO
MOVEI S1,.OPINN ;ASSUME NO-INTRVN
SKIPE G$OPRA## ;SKIP IF NO OPR AVAIL
MOVEI S1,.OPINY ;OPR ON, OBJECT ALLOWS INTERVN
INF.2A: 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
PJRST FILCHK ;MAKE SURE FILESPECS ARE OK
;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,[1,,2] ;DEFAULT TO PRIV'D PPN
SKIPN .EQOID(M) ;PPN THERE?
MOVEM S2,.EQOID(M) ;NOPE, DEFAULT IT
MOVE TF,G$SPRT##
LOAD S2,.EQSPC(M),EQ.PRO ;DEFAULT PROTECTION TOO
SKIPN S2
STORE TF,.EQSPC(M),EQ.PRO
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
; 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
MOVE S2,.FDSTR(S1) ;GET STR NAME
MOVEM S2,EVTPTH ;STORE IT
MOVE S2,[.PTPPN+1,,EVTPTH] ;POINT AT ARGS
PATH. S2, ;SEE IF IMPLIED PPN
SETZM EVTPTH+.PTSWT ;UUO FAILED, NO IMPLIED PPN
MOVX S2,PT.IPP ;GET THE BIT
TDNN S2,EVTPTH+.PTSWT ;SEE IF ERSATZ DEVICE
JRST EVTI.1 ;NOPE
MOVE S2,EVTPTH+.PTPPN ;GET THE IMPLIED PPN
JRST EVTI.2 ;OVERRIDE ANY PPN THEY SPECIFIED
EVTI.1: SKIPN S2,.FDPPN(S1) ;HAVE A PPN?
MOVE S2,G$SYSD## ;DEFAULT TO SYS PPN
EVTI.2: MOVEM S2,.FDPPN(S1) ;UPDATE
$RETT ;RETURN
EVTPTH: BLOCK .PTPPN+1 ;FOR CHECKING IMPLIED PPN
; 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 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, CLEAR BUSY BIT
MOVEM S1,OBJSCH(S2) ;PUT FLAGS BACK
$RETT ;RETURN
FALDEF: $RETT
FALMOD: $RETT
FALRJI: $RETT
FALFJB: $RETT
SUBTTL NQC -- Network Queue Controller dependent functions
;The NQC scheduler vector
S$NQC:: JRST NQCLNK ;LINK IN A NEW ENTRY
JRST NQCSCH ;SCHEDULE A JOB FOR AN OBJECT
JRST NQCDEF ;FILL IN DEFAULTS FOR A JOB
JRST NQCMOD ;MODIFY PARAMETERS
JRST NQCRJI ;RELEASE A JOB INTERLOCK
JRST NQCFJB ;FIND A JOB FOR AN OBJECT
NQCSTP::STOPCD (NQC,HALT,,<Unimplemented network queue control function>)
;<- - - - - - - - - - - - - - - - - - - - - - - - ->
;LINK QUEUE-NAME ENTRY INTO THE QUEUE
NQCLNK: $SAVE <E> ;SAVE E
PUSHJ P,.SAVE1 ;SAVE P1
SETZ P1, ;INIT "PREVIOUS" ENTRY
LOAD E,.QHLNK(H),QH.PTF ;POINT TO FIRST ENTRY
NQCL.1: JUMPE E,NQCL.3 ;ALMOST DONE
MOVEI S1,DFQ.QN(AP) ;TEST STRING
MOVEI S2,QNM.QN(E) ;BASE STRING
HRLI S1,(POINT 8) ;BOTH 8-BIT ASCII STRINGS
HRLI S2,(POINT 8) ;...
PUSHJ P,S%SCMP ;COMPARE THE STRINGS
SKIPF ;DID IT MATCH?
JUMPE S1,.RETT ;RETURN IF ALREADY IN QUEUE
JUMPG E,NQCL.2 ;CONTINUE IF POSITION FOUND
TXNN S1,SC%GTR ;NEW NAME GREATER THAN OLD?
MOVE P1,E ;REMEMBER POSITION IN QUEUE
NQCL.2: LOAD E,.QELNK(E),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST NQCL.1 ;CHECK FOR THAT
NQCL.3: SKIPG E,P1 ;KNOW WHERE TO PUT NEW ENTRY?
LOAD E,.QHLNK(H),QH.PTF ;STICK AT FRONT OF QUEUE
PUSHJ P,M$LINK## ;LINK IT IN
$RETT ;RETURN
;SCHEDULE A JOB
NQCSCH: PJRST NEXTJB ;SEND A NEXTJOB MESSAGE
NQCDEF: JSP TF,NQCSTP ;NOT IMPLEMENTED
NQCMOD: JSP TF,NQCSTP ;NOT IMPLEMENTED
NQCRJI: PJRST JOBDUN ;COMMON ROUTINE TO CLEAN UP
;FIND A JOB TO RUN
NQCFJB: $SAVE <H,AP> ;SAVE H AND AP
PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,S1 ;SAVE OBJECT ADDRESS
MOVE H,[-NQUEUE##,,TBLHDR##] ;AOBJN POINTER TO QUEUE HEADERS
NQCF.1: LOAD S1,.QHTYP(H),QH.TYP ;QUEUE TYPE
CAIE S1,.QHTIP ;INPUT?
CAIN S1,.QHTOU ;OUTPUT?
SKIPA S1,.QHTYP(H) ;YES
JRST NQCF.2 ;TRY NEXT QUEUE
TXNN S1,QH.IKS ;IMMUNE TO KSYS?
SKIPL G$KSYS## ;KSYS TIME OUT YET?
SKIPA ;OK TO USE THIS ONE
JRST NQCF.2 ;TRY NEXT QUEUE
LOAD AP,.QHLNK(H),QH.PTF ;ADDRESS OF FIRST QE
JRST NQCF.4 ;ENTER LOOP
NQCF.2: ADDI H,QHSIZE-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN H,NQCF.1 ;LOOP THROUGH THE QUEUE HEADERS
$RETF ;NO JOBS TO SCHEDULE
NQCF.3: LOAD AP,.QELNK(AP),QE.PTN ;POINT TO NEXT QE
NQCF.4: JUMPE AP,NQCF.2 ;ADVANCE TO NEXT QUEUE
SKIPN .QEQNM(AP) ;MUST BE A REMOTE QUEUE ENTRY
JRST NQCF.3 ;NOT, TRY ANOTHER
PUSHJ P,Q$CDEP## ;EVALUATE ALL DEPENDENCIES
JUMPF NQCF.3 ;TRY ANOTHER REQUEST
PUSHJ P,I$ACTV## ;CHECK FOR VALID ACCOUNT STRING
JUMPF NQCF.3 ;TRY ANOTHER REQUEST
MOVX S1,QE.WAL!QE.WAM!QE.HBO ;BITS TO PREVENT SCHEDULING
TDNE S1,.QESEQ(AP) ;READY TO RUN?
JRST NQCF.3 ;TRY ANOTHER REQUEST
MOVEI P2,HDRQNM## ;QUEUE HEADER
LOAD P2,.QHLNK(P2),QH.PTF ;GET FIRST ENTRY
SKIPA ;ENTER LOOP
NQCF.5: LOAD P2,.QELNK(P2),QE.PTN ;GET NEXT ENTRY
JUMPE P2,NQCF.3 ;TRY ANOTHER REQUEST
MOVEI S1,.QEQNM(AP) ;TEST STRING
MOVEI S2,QNM.QN(P2) ;BASE STRING
HRLI S1,(POINT 8) ;BOTH 8-BIT ASCII STRINGS
HRLI S2,(POINT 8) ;...
PUSHJ P,S%SCMP ;COMPARE THE STRINGS
JUMPN S1,NQCF.5 ;ONLY ACCEPT EXACT MATCH
MOVE S1,AP ;COPY QE ADDRESS
$RETT ;RETURN GOODNESS
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 FILCHK - CHECK ALL FILESPECS IN AN EQ
;CHECK FOR GENERIC DEVICES IN FILESPECS
;CALL: MOVE M, CREATE MESSAGE
; PUSHJ P,FILCHK
;
; TRUE RETURN: ALL FILESPECS ARE OK
; FALSE RETURN: A DISCREPANCY IN SOME FILESPEC
FILCHK: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
LOAD P1,.EQSPC(M),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
LOAD P2,.EQLEN(M),EQ.LOH ;GET LENGTH OF THE HEADER
ADDI P2,(M) ;OFFSET TO START OF FIRST FP
FILC.1: LOAD S1,.FPLEN(P2),FP.LEN ;GET LENGTH OF THE FP
ADDB P2,S1 ;POINT TO THE FD
PUSHJ P,I$FLCK## ;CHECK IT OUT
$RETIF ;AND RETURN ON FAILURES
LOAD S1,.FDLEN(P2),FD.LEN ;GET FD LENGTH
ADDI P2,(S1) ;ADVANCE POINTER TO NEXT FP
SOJG P1,FILC.1 ;LOOP FOR ALL FILES IN REQUEST
$RETT ;RETURN
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
DMOVE S1,[ASCIZ /NORMAL/] ;DEFAULT LONG FORMS NAME
SKIPN .EQFRM(M) ;...
DMOVEM S1,.EQFRM(M) ;...
PUSHJ P,EQDFLT ;GO DEFAULT THE REST OF THE EQ.
TOPS10 <
PUSHJ P,RENDEF ;CHECK FOR /DISP:REN
>
PJRST FILCHK ;MAKE SURE FILESPECS ARE OK
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
SKIPE .QEQNM(P1) ;REMOTE QUEUE FOR THIS ENTRY?
$RETF ;YES,,IGNORE THE JOB
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
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
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
;Check for queue name on create, and default node from that
LOAD S1,.MSTYP(M),.QIFNC ;GET INTERNAL FCN BIT
JUMPN S1,EQDF.5 ;JUMP IF SET
SKIPN .EQQNM(M) ;QUEUE NAME SPECIFIED?
JRST EQDF.2 ;NO, MAYBE MATCH NODE/UNIT?
MOVEI S1,.EQCHR(M) ;GET ADDRESS OF STRING
PUSHJ P,CNVCHR## ;CHECK IT OUT
JUMPF EQDF.E ;IF ERROR OCCURS
MOVEI S1,.EQFRM(M) ;GET ADDRESS OF STRING
PUSHJ P,CNVFRM## ;CHECK IT OUT
JUMPF EQDF.E ;IF ERROR OCCURS
MOVEI S1,.EQQNM(M) ;POINT AT THE QUEUE NAME STRING
HRLI S1,(POINT 8) ;IT'S 8-BIT ASCII
PUSHJ P,ASCUPR## ;MAKE SURE IT'S ALL UPPER CASE
MOVEI S1,.EQQNM(M) ;POINT AT THE NAME STRING
PUSHJ P,A$FQNM## ;TRANSLATE THE QUEUE NAME
JUMPF E$UQN## ;IF ERROR, DON'T LET THIS PASS
MOVE S2,QNM.RO+.ROBND(S1) ;GET NODE
MOVEM S2,.EQROB+.ROBND(M) ;STORE IT
MOVE S2,QNM.FL(S1) ;GET FLAGS
TXNN S2,QN.LCL ;LOCAL DEFINITION?
JRST EQDF.5 ;NO, LEAVE IT FOR NQC
MOVSI S2,QNM.RO(S1) ;COPY THE OBJECT BLOCK OVER
HRRI S2,.EQROB(M)
BLT S2,.EQROB+ROBSIZ-1(M)
MOVX S1,QNMLEN ;LENGTH OF STRING
MOVEI S2,.EQQNM(M) ;ADDRESS
PUSHJ P,.ZCHNK ;ZERO IT TO AVOID CONFUSION
JRST EQDF.5 ;CONTINUE
EQDF.2: $SAVE <AP> ;WE'LL NEED ANOTHER AC
LOAD AP,HDRQNM##+.QHLNK,QH.PTF ;GET POINTER TO FIRST ENTRY
EQDF.3: JUMPE AP,EQDF.5 ;IF END, NOTHING ELSE TO DO
MOVX S1,QN.LCL ;IS THIS A LOCAL DEFINITION?
TDNE S1,QNM.FL(AP)
JRST EQDF.4 ;IF SO, SKIP THIS ENTRY
MOVE S1,.EQROB+.ROBTY(M) ;OBJECT TYPE
MOVE S2,.EQROB+.ROBND(M) ;NODE NAME
CAMN S1,QNM.RO+.ROBTY(AP) ;MATCH?
CAME S2,QNM.RO+.ROBND(AP) ;MATCH
JRST EQDF.4 ;TRY ANOTHER ENTRY
SKIPN S1,.EQROB+.ROBUT(M) ;UNIT TYPE IF NON-ZERO
MOVE S1,QNM.RO+.ROBUT(AP) ;ELSE ANY WILL DO
CAME S1,QNM.RO+.ROBUT(AP) ;MATCH?
JRST EQDF.4 ;TRY ANOTHER ENTRY
LOAD S1,.EQROB+.ROBTY(M),RO.UNI ;UNIT NUMBER
CAME S1,QNM.RO+.ROBTY(AP) ;UNIT NUMBERS MATCH?
JRST EQDF.4 ;TRY ANOTHER ENTRY
MOVSI S1,QNM.QN(AP) ;GET SOURCE OF BLT
HRRI S1,.EQQNM(M) ;WHERE IT GOES
BLT S1,.EQQNM+QNMLEN-1(M) ;COPY IT OVER
MOVEI S1,.EQCHR(M) ;GET ADDRESS OF STRING
PUSHJ P,CNVCHR## ;CHECK IT OUT
JUMPF EQDF.E ;IF ERROR OCCURS
MOVEI S1,.EQFRM(M) ;GET ADDRESS OF STRING
PUSHJ P,CNVFRM## ;CHECK IT OUT
JUMPF EQDF.E ;IF ERROR OCCURS
JRST EQDF.5 ;CONTINUE
EQDF.4: LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT
JRST EQDF.3 ;TRY ANOTHER ENTRY
;"EQDFLT" IS CONTINUED ON THE NEXT PAGE
;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.
EQDF.5: 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.6: 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.6 ;AND LOOP
$RETT ;AND RETURN
EQDF.E: HRRZ S2,CFERRT##(S1) ;GET ADDRESS OF TEXT STRING
$TEXT (<-1,,@G$ACKB##>,<^T/0(S2)/^0>) ;STUFF THE ERROR MESSAGE
PUSHJ P,E$XXX## ;GENERIC ERROR
HLRZ S2,CFERRT##(S1) ;GET SIXBIT PREFIX
HRLM S2,G$ERR## ;SAVE FOR STGSND
$RETF ;AN ERROR
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
STOPCD (NBR,HALT,,<Nextjob'ing bad request>)
MOVE P2,S1 ;COPY ADR INTO P2
PUSHJ P,I$SACV## ;MAKE SURE THE ACCOUNT IS STILL VALID
MOVE S1,OBJTYP(P1) ;OBJECT TYPE
CAIE S1,.OTNQC ;NETWORK QUEUE CONTROLLER?
JRST NEXT.1 ;NO
MOVX S1,QE.STR ;BIT TO SET
IORM S1,.QENQC(AP) ;LITE SPOOLING TO REMOTE IN PROGRESS
MOVE S1,.QEROB+.ROBTY(AP) ;OBJECT TYPE FROM REQUEST
PUSHJ P,A$OB2Q## ;TRANSLATE TO QUEUE HEADER
SKIPT ;CHECK FOR ERRORS
STOPCD (OQT,HALT,,<NEXTJB object to queue header translation failed>)
SKIPA H,S1 ;COPY QUEUE HEADER
NEXT.1: LOAD H,OBJSCH(P1),OBSQUH ;POINT TO PROPER QUEUE HEADER
MOVEI S1,HDRUSE## ;LOAD DESTINATION QUEUE HDR
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
MOVE S1,OBJTYP(P1) ;GET OBJECT TYPE
CAIN S1,.OTNQC ;NETWORK QUEUE CONTROLLER?
JRST NEXT.2 ;YES, DON'T OVERWRITE OBJECT BLOCK
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
NEXT.2: 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?
STOPCD (RUJ,HALT,,<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