Trailing-Edge
-
PDP-10 Archives
-
cuspmar86binsrc_2of2_bb-fp63a-sb
-
10,7/galaxy/quasar/qsrque.mac
There are 44 other files named qsrque.mac in the archive. Click here to see a list.
TITLE QSRQUE -- Batch Queue Message Handlers 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,ORNMAC,GLXMAC ;PARAMETER FILE
PROLOGUE(QSRQUE) ;GENERATE THE NECESSARY SYMBOLS
%%.QSR==:%%.QSR
QSRVRS==:QSRVRS
COMMENT\
STOPCDs found in QSRQUE
BDN BAD DEVICE NAME INTERNALLY GENERATED
CRD CREATE REJECTED DEFER DATA
CRL CREATE REJECTED LOGOUT DATA
CRM CREATE REJECTED MODIFY
CRS CREATE REJECTED SPOOLING DATA
IDN INVALID DIRECTORY NUMBER
IUN INVALID USER NUMBER
\
SUBTTL Queue Headers and Module Storage
;BUILD THE QUEUE HEADERS
TBLHDR::QUEHDR
NQUEUE==:<.-TBLHDR>/QHSIZE
LSTITN: BLOCK 1 ;LAST ITN ASSIGNED
PRCBLK: BLOCK 1 ;[1230]IBMCOM PROCESS NODE CTL FLD
CRQETB: BLOCK 1 ;ADDRESS OF SHORT CREATE TABLE
REQIDN::EXP 0 ;REQUEST ID
THSPSB: BLOCK 1 ;ADDRESS OF THE PSB OF THE
;SENDER OF THE CURRENT MESSAGE
;FILLED IN BY VALMSG
DELLST: BLOCK 1 ;LIST NUMBER FOR DELETE LIST
DELNUM: BLOCK 1 ;# DELETE ENTRIES IN CORE
;DEFINE TABLE OF VALID OBJECT TYPES FOR ATTRIBUTES
;EACH ATTRIBUTE TYPE WILL HAVE A BIT MASK FOR EACH VALID OBJECT TYPE
;**;[1146]CHANGE 2 LINES AT ATRCDS:-2L 15-AUG-83/DPM
DEFINE X(TEXT,SYM,OBJ) <
ZZ==0
IRP OBJ,<IFLE OBJ,<ZZ==OBJ>
IFG OBJ,<ZZ==ZZ+1B<OBJ>>> ;[1146]
EXP ZZ> ;[1146]
ATRCDS: ATTRIB ;;BUILD THE TABLE
REQUEUE: EXP 0 ;REQUEUE FLAG FOR Q$LOGOUT
SUBTTL Queue Database Initialization
Q$INIT::PUSHJ P,I%NOW ;GET NOW
MOVEM S1,LSTITN ;AND SAVE IT AS LAST ITN
PUSHJ P,L%CLST ;CREATE A LIST
MOVEM S1,DELLST ;SAVE THE LIST NUMBER
SETZM DELNUM ;ZERO DELETE LIST COUNT
$RETT ;RETURN
SUBTTL Batch and Spooling Message Handlers
;THE MESSAGE HANDLERS ARE TOP LEVEL ROUTINES WHICH PROCESS THE
; VARIOUS MESSAGES THAT ARE SENT TO QUASAR. THEY ARE
; CALLED DIRECTLY OUT OF THE MAIN PROCESSING LOOP WITH
; ACCUMULATOR "M" POINTING TO THE FIRST WORD OF THE MESSAGE.
; THE MESSAGE HANDLERS HAVE FULL USE OF ALL ACCUMULATORS
; EXCEPTING "M" AND THE "P" REGS.
INTERN Q$RELEASE ;FUNCTION 2 -- RELEASE
INTERN Q$CHECKPOINT ;FUNCTION 3 -- CHECKPOINT
INTERN Q$REQUEUE ;FUNCTION 4 -- REQUEUE
INTERN Q$CREATE ;FUNCTION 7 -- CREATE
INTERN Q$CRER ; -- REBUILD FAILSOFT ENTRY
INTERN Q$CRQE ;FUNCTION 37 -- SHORT CREATE MESSAGE
INTERN Q$MODIFY ;FUNCTION 11 -- MODIFY
INTERN Q$KILL ;FUNCTION 12 -- KILL
INTERN Q$DEFER ;FUNCTION 16 -- DEFER
INTERN Q$HOLD ;FUNCTION 25 -- HOLD/RELEASE
;SOME IPCC MESSAGES ARE SENT TO QUASAR FROM THE MONITOR EXEC PROCESS.
; THEY ARE TREATED IN THE SAME MANNER AS USER GENERATED
; CALLS (I.E. ACCUMULATOR "M" POINTS TO THE MESSAGE)
INTERN Q$SPOOL ;SPOOLING FILE REQUEST -- FUNCTION .IPCSU (26)
INTERN Q$LOGOUT ;LOGOUT OF A JOB -- FUNCTION .IPCSL (27)
;IF .QIFNC IS SET IN THE OPERATION FIELD OF A MESSAGE, THE CALL IS
; CONSIDERED INTERNAL, AND SPECIAL HANDLING OR INTERPRETATION
; OF THE VARIOUS FIELDS IN THE MESSAGE, (PARTICULARLY THE
; OTHER 17 BITS OF THE TYPE FIELD) MAY OCCUR. ANY SPECIAL
; HANDLING OF THIS FORM WILL BE DESCRIBED IN THE ROUTINE
; HEADER COMMENTS. IF .QIFNC IS SET THE REST OF THE TYPE FIELD
; DOES NOT HAVE TO REFLECT THE MESSAGE TYPE SINCE IF Q$CREATE
; RECEIVES AN INTERNAL CALL, THE MESSAGE IS OBVIOUSLY A CREATE
; MESSAGE.
SUBTTL Q$EQR - "EQ request" message processing
Q$EQR:: PUSHJ P,A$WHEEL## ;MUST BE PRIV'ED
; MOVX S1,MD.POK ;BIT TO TEST
; TDNN S1,G$PRVS## ;POKE PRIVS?
JUMPF E$IPE## ;LOSER
MOVEI S1,.OROBJ ;GET THE OBJECT BLOCK TYPE
PUSHJ P,A$FNDB ;FIND THE OBJECT BLOCK IN THE MESSAGE
JUMPF E$IER## ;INVALID EQ REQUEST MESSAGE FORMAT
MOVX S2,OU.HRG ;GET HIGH RANGE MASK
SKIPE OBJ.TY(S1) ;NEED AN OBJECT TYPE
TDNE S2,OBJ.UN(S1) ;RANGES ARE ILLEGAL
JRST E$IER## ;GIVE UP
PUSH P,S1 ;SAVE MESSAGE ADDRESS
SKIPN S1,OBJ.ND(S1) ;GET NODE NAME
MOVE S1,G$LNAM## ;DEFAULT TO OURS
PUSHJ P,N$GNOD## ;FIND NET QUEUE ENTRY
POP P,S1 ;GET MESSAGE ADDRESS BACK
SKIPT ;KNOWN NODE?
SKIPA S2,OBJ.UN(S1) ;NO
MOVE S2,NETNAM(S2) ;GET NAME
MOVEM S2,OBJ.ND(S1) ;UPDATE
PUSHJ P,A$FOBJ## ;FIND THE OBJECT BLOCK
JUMPF E$UOS## ;UNKNOWN OBJECT SPECIFIED
MOVE S1,OBJITN(S1) ;GET ITN
PUSHJ P,Q$SUSE ;SEARCH THE USE QUEUE
JUMPF E$SNY## ;SPECIFIED REQUEST IS NOT YOURS
LOAD S1,.QESTN(S1),QE.DPA ;GET THE RETREIVAL POINTER
PUSHJ P,F$RDRQ## ;READ IN THE REQUEST FROM DISK
JUMPF E$SNY## ;SPECIFIED REQUEST IS NOT YOURS
MOVEM S1,G$SAB##+SAB.MS ;SAVE ADDRESS
MOVEI S2,.QOEQA ;GET FUNCTION (EQ ANSWER)
STORE S2,.MSTYP(S1),MS.TYP ;SAVE IN OUTGOING MESSAGE
MOVE S2,.MSCOD(M) ;GET SENDER'S ACK CODE
MOVEM S2,.MSCOD(S1) ;SAVE IN OUTGOING MESSAGE
MOVEI S1,PAGSIZ ;SENDING A FULL PAGE
MOVEM S1,G$SAB##+SAB.LN ;SAVE IN SAB
MOVE S1,G$SND## ;GET SENDER'S PID
MOVEM S1,G$SAB##+SAB.PD ;SAVE IN SAB
PJRST C$SEND## ;SEND MESSAGE
SUBTTL Event Queue -- Q$EVTC - Create
; This routine handles special create processing unique to the
; Event Queue. It's called by Q$CREATE sometime after the limit
; words are copied from the EQ to the QE.
; Call: MOVE M, EQ address
; MOVE AP, QE address
; PUSHJ P,Q$EVTC
Q$EVTC::LOAD S1,.EQROB+.ROBTY(M) ;GET REQUESTED OBJECT TYPE
CAIE S1,.OTEVT ;EVENT QUEUE?
POPJ P, ;NOPE
MOVEI S1,0 ;ZERO
STOLIM S1,.QELIM(AP),TEXT ;INITIALIZE TEXT BLOCK ADDRESS
STOLIM S1,.QELIM(AP),FILE ;INITIALIZE FD ADDRESS
EVTC.1: SKIPN .EQTXT(M) ;TEXT BLOCK?
JRST EVTC.2 ;NO
MOVEI S1,STSSIZ ;WORD COUNT
$CALL M%GMEM ;GET CORE
STOLIM S2,.QELIM(AP),TEXT ;SAVE ADDRESS
ADD S1,S2 ;COMPUTE END BLT ADDRESS
HRLI S2,.EQTXT(M) ;BUILD BLT POINTER
BLT S2,-1(S1) ;COPY DATA
EVTC.2: LOAD S1,.EQSPC(M),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
JUMPE S1,EVTC.3 ;NO FILESPEC
MOVEI S1,FDXSIZ ;WORD COUNT
$CALL M%GMEM ;GET CORE
STOLIM S2,.QELIM(AP),FILE ;SAVE ADDRESS
LOAD S1,.EQLEN(M),EQ.LOH ;GET LENGTH OF HEADER
ADD S1,M ;OFFSET TO THE FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET LENGTH OF THIS FP
ADD S1,S2 ;S1 NOW HAS THE FD ADDRESS
GETLIM S2,.QELIM(AP),FILE ;GET ADDRESS BACK AGAIN
HRL S2,S1 ;MAKE A BLT POINTER
HRR S1,S2 ;GET DESTINATION
BLT S2,FDXSIZ-1(S1) ;COPY FD
EVTC.3: POPJ P, ;RETURN
SUBTTL Event Queue -- Q$EVTD - Delete old requests
; Routine called by the main loop to delete old events
; whose expiration time has passed. equests marked for
; requeuing ona daily or weekly basis will have their
; expiration date/time incremented by the one or seven
; days until the exipration date/time is past the current
; time.
; Call: PUSHJ P,Q$EVTD
Q$EVTD::$SAVE <H> ;SAVE H
$SAVE <AP> ;SAVE AP
MOVEI H,HDREVT ;POINT TO EVENT QUEUE HEADER
EVTD.0: LOAD AP,.QHLNK(H),QH.PTF ;POINT TO THE FIRST ENTRY
EVTD.1: JUMPE AP,.RETT ;END OF QUEUE?
MOVX S1,QE.RDE ;BIT TO TEST
TDNN S1,.QESEQ(AP) ;REQUEST REALLY EXIST?
JRST EVTD.5 ;TRY TO FIND ANOTHER
GETLIM S1,.QELIM(AP),REPT ;GET REPEAT BITS
TXNN S1,QB.NOW ;ONLY ONE SHOT?
TXNN S1,QB.DLY!QB.WKY ;ONLY VALID BITS WE CARE ABOUT
JRST EVTD.4 ;REMOVE FROMTHE QUEUE
TXNE S1,QB.DLY ;WHAT TYPE?
SKIPA S1,[1,,0] ;DAILY INCREMENT
MOVSI S1,7 ;WEEKLY INCREMENT
MOVE S2,.QECRE(AP) ;GET EXPIRATION DATE/TIME
EVTD.2: CAML S2,G$NOW## ;PAST THE CURRENT TIME YET?
JRST EVTD.3 ;YES
ADD S2,S1 ;INCREMENT
JRST EVTD.2 ;CHECK IT AGAIN
EVTD.3: MOVE S1,S2 ;GET NEW EXPIRATION DATE/TIME
PUSHJ P,Q$EVTM ;PERFORM REQUEUE VIA STRANGE MODIFY
JUMPT EVTD.0 ;IF MODIFIED, START AT BEGINNING
JRST EVTD.5 ;ELSE USE NEXT IN THE QUEUE
EVTD.4: PUSH P,AP ;SAVE AP
PUSHJ P,Q$KPRO ;REMOVE FROM QUEUE
POP P,AP ;RESTORE AP
EVTD.5: LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST EVTD.1 ;LOOP
SUBTTL Event Queue -- Q$EVTI - Initialize a create message
; This routine will build a "generic" Event Queue message (EQ).
; It is called generic, since most of the EQ is returned empty
; to the caller.
; Call: MOVE S1, event type code (.EVxxx)
; PUSHJ P,Q$EVTI
;
; On return, M contains the address of the new EQ.
Q$EVTI::PUSH P,S1 ;SAVE EVENT TYPE
$CALL M%GPAG ;GET A PAGE
MOVE M,S1 ;COPY ADDRESS
MOVE S1,[EQHSIZ,,.QIFNC] ;INITIAL MESSAGE LENGTH,,INTERNAL FNC
MOVEM S1,.MSTYP(M) ;SAVE
MOVE S1,[%%.QSR,,EQHSIZ] ;VERSION,,HEADER SIZE
MOVEM S1,.EQLEN(M) ;SAVE
POP P,S1 ;GET TYPE CODE BACK
STOLIM S1,.EQLIM(M),TYPE ;SAVE IT
MOVSI S1,EVTROB ;COPY
HRRI S1,.EQROB(M) ; REQUEST
BLT S1,.EQROB+ROBSIZ-1(M) ; OBJECT BLOCK
POPJ P, ;RETURN
; PROTOTYPE REQUEST OBJECT BLOCK
EVTROB: $BUILD (ROBSIZ) ;LENGTH
$SET (.ROBTY,,.OTEVT) ;OBJECT TYPE
$SET (.ROBAT,RO.ATR,%GENRC) ;DEC ATTRIBUTES
$SET (.ROBND,,0) ;NODE NAME
$SET (.ROBUA,,0) ;CUSTOMER ATTRIBUTES
$EOB ;END OF BLOCK
SUBTTL Event Queue -- Q$EVTK - Kill
; Routine to delete Event Queue specific data blocks associated
; with a QE. This gets called near the end of kill processing by
; Q$KPRO, just before the EQ (if any) is deleted.
; Call: MOVE AP, QE address
; PUSHJ P,Q$EVTK
Q$EVTK::LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
CAIE S1,.OTEVT ;EVENT QUEUE?
POPJ P, ;NO--JUST RETURN
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT TYPE
HRRZ S1,EVTDSP##(S1) ;AND THE ASSOCIATED KILL ROUTINE
SKIPE S1 ;DEFEND AGAINST ILL MEM REFS
PUSHJ P,(S1) ;EXECUTE IT
MOVEI S1,STSSIZ ;TEXT BLOCK SIZE
GETLIM S2,.QELIM(AP),TEXT ;TEXT BLOCK ADDR
SKIPE S2 ;HAVE ONE?
$CALL M%RMEM ;YES--DELETE IT
MOVEI S1,FDXSIZ ;FD SIZE
GETLIM S2,.QELIM(AP),FILE ;FD ADDR
SKIPE S2 ;HAVE ONE?
$CALL M%RMEM ;YES--DELETE IT
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT TYPE
CAIN S1,.EVKSY ;KSYS?
PUSHJ P,EVTREL ;YES--RELEASE ALL PENDING REQUESTS
POPJ P, ;RETURN
SUBTTL Event Queue -- Q$EVTM - Modify
; This routine will modify the expiration date/time of a given
; request.
; Call: MOVE S1, new expiration date/time
; MOVE AP, QE address
; PUSHJ P,A$EVTM
Q$EVTM::$SAVE <M> ;SAVE M
PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,S1 ;COPY NEW EXPIRATION DATE/TIME
MOVE P2,AP ;SAVE CURRENT QE (WILL BECOME OLD ONE)
LOAD S1,.QESTN(AP),QE.DPA ;GET THE RETREIVAL POINTER
PUSHJ P,F$RDRQ## ;READ IN THE ORIGINAL REQUEST
MOVE M,S1 ;COPY ADDRESS
CAMN P1,.EQAFT(M) ;COMPARE WITH OLD
JRST [PUSHJ P,M%RPAG ;RELEASE PAGE REQUEST WAS READ INTO
$RETF] ;INDICATE NO MODIFY
MOVEM P1,.EQAFT(M) ;ELSE SET NEW DATE/TIME
SETZM .EQITN(M) ;MAKE OLD EQ LOOK VIRGIN
MOVEI S1,1 ;GET A BIT
STOLIM S1,.EQLIM(M),REQT ;INDICATE REQUEUE TIME ALREADY SET UP
MOVEI S1,.QIFNC ;THIS IS AN INTERNAL CALL
STORE S1,.MSTYP(M),MS.TYP ;SET FOR Q$CREATE
PUSHJ P,Q$CREATE ;PUT MODIFIED REQUEST BACK IN PLACE
SKIPE G$ERR## ;DID THE CREATE WORK
$STOP (EMF,<Event Modify Failed>)
MOVE AP,P2 ;GET OLD QE
PUSHJ P,Q$KPRO ;DELETE IT
MOVE S1,M ;RELEASE PAGE USED FOR REQUEST
PUSHJ P,M%RPAG
POPJ P, ;AND RETURN
SUBTTL Event Queue -- Q$EVTP - Post create cleanup
Q$EVTP::LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
CAIE S1,.OTEVT ;EVENT QUEUE ?
POPJ P, ;NO--JUST RETURN
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT TYPE
CAIN S1,.EVKSY ;KSYS?
PUSHJ P,EVTHLD ;SET THE APPROPRIATE HOLD STATUS
MOVX S1,.QIFNC ;BIT TO TEST
GETLIM S2,.QELIM(AP),FAIL ;GET FAILSOFT BIT
SKIPE S2 ;FAILSOFTED?
TDNN S1,.MSTYP(M) ;AND AN INTERNAL FUNCTION?
POPJ P, ;NO, RETURN
MOVE S1,.QECRE(AP) ;GET EXPIRATION DATE/TIME
MOVE S2,G$NOW## ;GET CURRENT TIME
SUB S1,S2 ;GET DIFFERENCE
MOVMS S1 ;ACCOUNT FOR + OR -
CAILE S1,^D59*3 ;WITHIN FUDGE FACTOR?
POPJ P, ;NO
MOVX S1,QE.RDE ;BIT TO SET
IORM S1,.QESEQ(AP) ;MARK FOR DELETION
MOVEI S1,1 ;BIT TO SET
STOLIM S1,.QELIM(AP),INVS ;MARK IT INVISIBLE TOO
POPJ P, ;RETURN
SUBTTL Event Queue -- Q$EVTR - Release
Q$EVTR::JUMPE AP,.RETT ;PROTECT OURSELVES
LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
CAIE S1,.OTEVT ;EVENT QUEUE?
POPJ P, ;NO--JUST RETURN
$SAVE <H> ;SAVE H
MOVEI H,HDREVT ;POINT TO QUEUE HEADER
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT TYPE
CAIN S1,.EVKSY ;KSYS?
PUSHJ P,EVTREL ;SET THE APPROPRIATE HOLD STATUS
LOAD S1,.QHPAG(H),QH.SCH ;BASE OF SCHEDULING ENTRIES
PUSHJ P,SCHRJI(S1) ;RELEASE JOB
$COUNT (MREL) ;COUNT THE RELEASE
LOAD S1,.QESEQ(AP),QE.NOT ;GET NOTIFY BITS
SKIPE S1 ;NONE SET,,SKIP THE NOTIFY
PUSHJ P,NOTIFY ;YES,,GO DO IT
$RETT ;RETURN
SUBTTL Event Queue -- Miscellaneous
; EVTREL - RELEASE next request in queue
; EVTHLD - HOLD all other requests in queue
EVTREL: TDZA S2,S2 ;RELEASE
EVTHLD: MOVEI S2,1 ;HOLD
PUSHJ P,.SAVE1 ;SAVE P1
$SAVE <AP> ;SAVE AP
MOVE P1,S1 ;COPY TARGET EVENT TYPE
MOVE S1,S2 ;GET HOLD/RELEASE STATUS
MOVNI TF,1 ;INIT COUNT
LOAD AP,HDREVT+.QHLNK,QH.PTF ;POINT TO THE FIRST ENTRY
EVTX.1: JUMPE AP,.RETT ;RETURN IF NO MORE ENTRIES
GETLIM S2,.QELIM(AP),TYPE ;GET EVENT CODE
CAIE S2,(P1) ;DESIRED EVENT TYPE?
JRST EVTX.2 ;NO
MOVX S2,QE.HBO ;BIT TO TWIDDLE
ANDCAM S2,.QESEQ(AP) ;INITIALLY CLEAR HOLD BIT
AOJE TF,EVTX.2 ;SKIP OVER THE FIRST ONE
XCT EVTTAB(S1) ;SET/CLEAR HOLD BIT
MOVEI S2,0 ;NOW CLEAR THE
STOLIM S2,.QELIM(AP),ACTV ; ACTIVE STATUS
JUMPE S1,.POPJ ;RETURN IF RELEASING FIRST
EVTX.2: LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST EVTX.1 ;AND LOOP
EVTTAB: ANDCAM S2,.QESEQ(AP) ;CLEAR
IORM S2,.QESEQ(AP) ;SET
SUBTTL RELEASE -- Function 2
;THE RELEASE MESSAGE IS SENT TO QUASAR BY ONE OF THE KNOWN SYSTEM
; COMPONENTS TO RELEASE A JOB FROM THE QUEUE.
Q$RELEASE:
MOVEI T1,REL.SZ ;LOAD MINIMUM SIZE
PUSHJ P,VALMSG ;VALIDATE THE MESSAGE
SKIPE G$ERR## ;DID VALMSG SET THE ERROR FLAGS
$RETT ;YES, REJECT THIS MESSAGE
MOVE S1,REL.IT(M) ;GET THE TASKS ITN
PUSHJ P,Q$SUSE ;SEARCH THE USE QUEUE
JUMPF E$SNY## ;NOT FOUND
MOVE AP,S1 ;COPY ENTRY ADR INTO AP
PUSHJ P,D$PPRL## ;RELEASE THE MDR IF THERE IS ONE
MOVE T1,.QEOBJ(AP) ;GET OBJECT QUEUE ENTRY FOR REQUEST
MOVE T2,OBJPID(T1) ;THE PID FOR THE PROCESSOR
CAME T2,G$SND## ;DOES REQUEST BELONG TO HIM?
PJRST E$SNY## ;NO, GIVE "NOT YOURS" ERROR
LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER ADR
PUSH P,S1 ;SAVE THE HEADER
CAIN S1,HDRINP ;IS IT THE INPUT QUEUE
PUSHJ P,S$INRL## ;YES, RELEASE THE SPOOLED STUFF
MOVE S1,(P) ;GET HDR ADDRESS BACK
LOAD S1,.QHPAG(S1),QH.SCH ;GET ADDRESS OF SCHED VECTOR
PUSHJ P,SCHRJI(S1) ;AND CALL RELEASE ENTRY POINT
LOAD S1,.QESTN(AP),QE.DPA ;GET THE DISK ADDRESS
PUSHJ P,F$RLRQ## ;AND RELS SPACE
$COUNT (MREL)
PUSHJ P,Q$DDEP ;DELETE DEPENDENCY LIST
POP P,H ;GET HEADER BACK
LOAD S1,.QESEQ(AP),QE.NOT ;GET NOTIFY BITS
SKIPE S1 ;NONE SET,,SKIP THE NOTIFY
PUSHJ P,NOTIFY ;YES,,GO DO IT
MOVEI H,HDRUSE ;LOAD ADR OF USE HEADER
PJRST M$RFRE## ;AND RETURN THE ENTRY
SUBTTL CHECKPOINT -- Function 3
;A CHECKPOINT message is sent periodically by the various known processors
; so that QUASAR can update the request for restart in case of system
; failure and/or to update active job status in-core.
Q$CHECKPOINT:
MOVEI T1,CHE.MS ;LOAD MINIMUM MESSAGE SIZE
PUSHJ P,VALMSG ;VALIDATE THE MESSAGE
SKIPE G$ERR## ;DID VALMSG SET THE ERROR FLAGS
$RETT ;YES, REJECT THIS MESSAGE
MOVE S1,CHE.IT(M) ;GET THE SPECIFIED ITN
PUSHJ P,Q$SUSE ;SEARCH THE USE QUEUE
JUMPF E$SNY## ;NOT THERE!!
MOVE T1,S1 ;COPY ADDRESS INTO T1
MOVE T2,.QEOBJ(T1) ;GET OBJECT ADDRESS
MOVE T3,OBJPID(T2) ;GET PID OF OWNER
CAME T3,G$SND## ;SAME AS SENDER?
PJRST E$SNY## ;NO, GIVE AN ERROR
$COUNT(MCHK)
LOAD S1,CHE.FL(M) ;GET FLAGS WORD
TXNN S1,CH.FCH ;DOING A CHECKPOINT?
JRST CHEC.1 ;NO, SEE IF DOING A STATUS
LOAD S1,.QESTN(T1),QE.DPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
MOVE T2,S1 ;SAVE PAGE ADR IN T2
HRRI S2,.EQCHK(S1) ;AND PLACE TO PUT IT
HRLI S2,CHE.IN(M) ;FIRST OF THE INFORMATION WORDS
BLT S2,.EQCHK+<EQCKSZ-1>(S1) ;AND BLT IT
MOVEI T3,1 ;LOAD A BIT
STORE T3,.EQSEQ(S1),EQ.JBC ;JOB HAS BEEN CHECKPOINTED!!
PUSHJ P,F$WRRQ## ;WRITE IT OUT
LOAD S2,.QESTN(T1),QE.DPA ;GET PREVIOUS DPA
STORE S1,.QESTN(T1),QE.DPA ;STORE NEW DPA
MOVE S1,S2 ;GET OLD DPA INTO S1
PUSHJ P,F$RLRQ## ;AND RELEASE IT
MOVE S1,T2 ;GET ADDRESS OF PAGE
PUSHJ P,M%RPAG ;AND RELEASE THE PAGE
CHEC.1: LOAD S1,CHE.FL(M) ;GET FLAG WORD
TXNN S1,CH.FST ;DOES HE WANT TO SET STATUS?
$RETT ;NO, RETURN
LOAD S1,.MSTYP(M),MS.CNT ;GET MESSAGE LENGTH
SUBI S1,CHE.ST ;SUBTRACT START OF STATUS BLOCK
JUMPLE S1,.RETT ;IF NO STATUS, FORGET IT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
LOAD S2,.QEOBJ(T1) ;GET ADDRESS OF OBJ BLOCK
ADDI S2,OBJST1 ;POINT TO THE STATUS BLOCK
ADDI S1,-1(S2) ;GET DESTINATION OF BLT
HRLI S2,CHE.ST(M) ;AND SOURCE
BLT S2,0(S1) ;AND MOVE THE STATUS
$RETT ;RETURN
SUBTTL REQUEUE -- Function 4
;The REQUEUE message is sent by a known component when the job currently
; being processed by a particular object is to be released from the
; object and placed back into the queue.
Q$REQUEUE:
MOVEI T1,REQ.SZ ;MINIMUM SIZE OF THE MESSAGE
PUSHJ P,VALMSG ;VALIDATE THE SIZE OF IT
SKIPE G$ERR## ;IS IT OK
$RETT ;NO, RETURN NOW
MOVE S1,REQ.IT(M) ;GET THE ITN OF THE TASK
PUSHJ P,Q$SUSE ;SEARCH THE USE QUEUE
JUMPF E$SNY## ;NOT THERE!!
MOVE AP,S1 ;COPY ADDRESS INTO AP
MOVE T2,.QEOBJ(AP) ;GET OBJECT ADDRESS
MOVE S1,OBJPID(T2) ;GET PID OF OWNER
CAME S1,G$SND## ;SAME AS SENDER?
PJRST E$SNY## ;NO, GIVE AN ERROR
LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER ADR
MOVE H,S1 ;COPY QUE HDR INTO H
CAIE H,HDRRET ;THE RETRIEVAL QUEUE?
JRST REQU.1 ;NO, PROCEED NORMALLY
HRRI S1,.QELIM(AP) ;ACTUALLY POINTING TO TIMESTAMP WORD
HRLI S1,REQ.IN(M)
BLT S1,.QELIM+4(AP) ;COPY TAPE INFO INTO .EQ
REQU.1: LOAD S1,.QHPAG(H),QH.SCH ;GET ADDRESS OF SCHED VECTOR
PUSHJ P,SCHRJI(S1) ;AND RELEASE THE INTERLOCK
PUSH P,H ;SAVE OUR HEADER ADDRESS
MOVE S1,H ;PUT DESTINATION QUE IN S1
MOVEI H,HDRUSE ;LOAD H WITH SOURCE QUEUE
PUSHJ P,M$MOVE## ;MOVE THE ENTRY OUT OF THE USE QUEUE
SKIPE S1,.QEMDR(AP) ;CHECK AND LOAD THE MDR ADDRESS
MOVEM AP,.MRQEA(S1) ;RELINK THE QE TO THE MDR
$COUNT (MREQ) ;COUNT'EM UP !!!
MOVE S1,OBJTYP(T2) ;GET THE OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
JRST REQ.1A ;NO,,SKIP THIS
SETOM REQUEUE ;LITE THE REQUEUE FLAG
PUSHJ P,S$REQU## ;PRINT ANY SPOOLED OUTPUT NOW
SETZM REQUEUE ;CLEAR THE REQUEUE FLAG
MOVE S1,AP ;GET THE QE ADDRESS IN S1
PUSHJ P,D$PPRE## ;RESET THE JOB MDR TO A PSEUDO PROCESS
REQ.1A: LOAD S1,REQ.FL(M),RQ.HBO ;GET THE REQUEUE-HOLD BIT
JUMPN S1,REQU.2 ;IF LIT,,SKIP THIS
LOAD S1,REQ.FL(M),RQ.TIM ;GET TIME TO WAIT IN MINUTES
JUMPE S1,REQU.2 ;NONE THERE,,SKIP THIS
PUSHJ P,A$AFT## ;CREATE UDT WITH THAT TIME
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEM S1,.QECRE(AP) ;SAVE A NEW /AFTER TIME.
PUSHJ P,S$AFTR## ;SCHEDULE WAKEUP IN 'N' MINUTES
REQU.2: POP P,H ;RESTORE OUR QUEUE HEADER ADDRESS
LOAD S1,.QESEQ(AP),QE.RDE ;WAS THIS REQUEST CANCELLED ???
JUMPN S1,Q$KPRO ;YES,,GO DELETE IT FROM THE QUEUE
MOVE S1,REQ.FL(M) ;GET THE REQUEUE FLAGS
TXNN S1,RQ.HBO ;HOLD BY OPERATOR?
TXNN S1,RQ.RLC ;NO, USE LAST CHECKPOINT?
SKIPA ;NO, WE MUST READ/WRITE DISK
$RETT ;NO DISK MODS,,JUST RETURN
LOAD S1,.QESTN(AP),QE.DPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
MOVE T1,S1 ;SAVE THE ADDRESS FOR A WHILE
HRRI S2,.EQCHK(T1) ;AND PLACE TO PUT IT
HRLI S2,REQ.IN(M) ;FIRST OF THE INFORMATION WORDS
MOVX T2,RQ.RLC ;RESTART AT LAST CHECKPOINT?
TDNN T2,REQ.FL(M) ;TEST AND SKIP IF SO
BLT S2,.EQCHK+<EQCKSZ-1>(T1) ;ELSE, BLT IT
LOAD S2,REQ.FL(M),RQ.HBO ;HOLD THE JOB?
JUMPE S2,REQU.3 ;NO, CONTINUE ON
MOVX S2,QE.HBO ;GET HOLD BY OPERATOR
IORM S2,.QESEQ(AP) ;SET IT
MOVX S2,EQ.HBO ;GET THE EQ VERSION
IORM S2,.EQSEQ(T1) ;AND SET IT
REQU.3: PUSHJ P,F$WRRQ## ;RE-WRITE THE REQUEST
LOAD S2,.QESTN(AP),QE.DPA ;GET THE OLD DPA
STORE S1,.QESTN(AP),QE.DPA ;STORE THE NEW DPA
MOVE S1,S2 ;GET THE OLD DPA
PUSHJ P,F$RLRQ## ;RELEASE THE OLD ONE
MOVE S1,T1 ;GET PAGE ADDRESS
PUSHJ P,M%RPAG ;RETURN THE PAGE
$RETT ;RETURN
SUBTTL CREATE -- Function 7
;The CREATE message is sent to QUASAR by any unknown component to place
; something in one of the INPUT or OUTPUT queues.
; The Q$CRER is called by the failsoft system initialization to
; place an entry into one of the queues from the failsoft file.
; That entry is called with S1 containing the address of the request
; and S2 containing the DPA.
Q$CRER: PUSHJ P,.SAVE4 ;SAVE P1-P4
$SAVE M ;SAVE M
MOVE M,S1 ;PUT EQ ADDRESS INTO M
MOVX S1,.QIFNC ;LOAD THE INTERNAL FUNCTION CODE
STORE S1,.MSTYP(M),MS.TYP ;STORE IT
MOVE P4,S2 ;PUT THE DPA IN S2
ZERO .EQSEQ(M),EQ.NOT ;NO /NOTIFY FOR RESTARTS
JRST CREA.0 ;AND GO DO THE CREATE
Q$CREATE:
PUSHJ P,.SAVE4 ;SAVE P1 THRU P4
SETZ P4,G$ACKO## ;NO DPA, NOT ACKING OPR CREATES (YET)
CREA.0: MOVE S1,G$SND## ;GET SENDER'S PID
CAMN S1,G$OPR## ;SAME AS ORION'S?
MOVEM S1,G$ACKO## ;YES--SET FLAG NON-ZERO
LOAD S1,.MSTYP(M),MS.CNT ;GET LENGTH OF MESSAGE
CAIGE S1,EQHSIZ ;MUST BE AT LEAST EQHSIZ
PJRST E$MTS## ;INDICATE MESSAGE TOO SHORT
LOAD S1,.EQLEN(M),EQ.LOH ;MUST CHECK HEADER SIZE AS WELL
CAIGE S1,EQHSIZ ;THAT IS ALSO THE MINIMUM VALUE
PJRST E$MTS## ;TOO BAD, GIVE MESSAGE TOO SHORT
LOAD S1,.EQROB+.ROBTY(M) ;GET REQUESTED OBJECT TYPE
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER
JUMPF E$UQS## ;UNKNOWN QUEUE SPECIFIED
MOVE H,S1 ;LOAD COPY
LOAD P3,.MSTYP(M),MS.TYP ;GET THE TYPE FIELD
TXNE P3,.QIFNC ;IS IT INTERNAL?
SKIPN S1,.EQITN(M) ;YES, LOAD OLD ITN IF NON-ZERO
AOS S1,LSTITN ;GET A NEW ITN
STORE S1,.EQITN(M) ;AND STORE IN MSG FOR LATER
TXNN P3,.QIFNC+.QIRET ;INTERNAL CALL OR ARCHIVE MSG ???
PUSHJ P,CHKQUE ;OBJECT QUEUE AVAILABLE ???
AOS S1,REQIDN ;GET REQUEST ID
MOVEM S1,.EQRID(M) ;SAVE IT IN THE MESSAGE
LOAD S1,.QHPAG(H),QH.SCH ;BASE OF SCHEDULING ENTRIES
PUSHJ P,SCHDEF(S1) ;GO FILL THE DEFAULTS FOR THIS QUEUE
SKIPE G$ERR## ;DID IT GET PAST THE CHECKS
$RETT ;NO, SCHDEF REJECTED IT!!
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE S1,.EQROB+.ROBTY(M) ;GET REQUEST TYPE
LOAD S2,.MSTYP(M),MS.TYP ;GET MESSAGE TYPE
CAIN S1,.OTEVT ;EVENT?
CAIE S2,.QIFNC ;INTERNAL REQUEST?
TRNA ;NO TO EITHER
JRST CREA.2 ;YES TO BOTH
CREA.1: MOVE S1,M ;GET CREATE REQUEST ADDRESS
PUSHJ P,I$QCDR## ;CHECK FOR SPOOLED CDR FILES IN REQUEST
MOVE S1,.EQAFT(M) ;GET THE AFTER PARAMETER
CAMGE S1,G$NOW## ;NO, IS IT BEFORE NOW?
MOVE S1,G$NOW## ;YES, USE NOW. THIS DISALLOWS
MOVEM S1,.EQAFT(M) ;/AFT:YESTERDAY TO GIVE HI-PRIO
CREA.2: PUSHJ P,M$GFRE## ;GET A FREE CELL
PUSHJ P,L%CLST ;CREATE THE DEPENDENCY LIST
STORE S1,.QEDIN(AP),QE.DLN ;AND STORE THE LIST NUMBER
LOAD S1,.EQROB+.ROBTY(M) ;GET REQUESTED OBJECT TYPE
LOAD T1,.EQSPC(M),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
CAIN S1,.OTEVT ;EVENT?
JUMPE T1,CRE.3C ;NO STR CHECKING IF NO FILES
LOAD T2,.EQLEN(M),EQ.LOH ;GET LENGTH OF HEADER
ADD T2,M ;MAKE T2 POINT TO FIRST FP
SETZ T3, ;CLEAR PREVIOUS STR FIRST TIME THRU
CRE.3A: MOVE P1,T3 ;GET PREVIOUS STRUCTURE (SMALL CODE BUM)
LOAD S1,.FPLEN(T2),FP.LEN ;GET LENGTH OF THIS FP
ADDB T2,S1 ;PUT FD ADDRESS IN T2 AND S1
PUSHJ P,D$ESTR## ;EXTRACT THE STRUCTURE FROM THE FD
JUMPF E$IFS## ;GIVE ERROR IF BAD STRUCTURE
MOVE T3,S1 ;PUT STR QUEUE POINTER IN T3
CAMN T3,P1 ;SAME AS LAST FILE (MAY SAVE SOME TIME)
JRST CRE.3B ;YES, ON TO NEXT FILE
MOVE S2,AP ;PUT QE ADDRESS IN S2
PUSHJ P,D$ASTD## ;ADD A STRUCTURE DEPENDENCY
CRE.3B: LOAD S1,.FDLEN(T2),FD.LEN ;GET THE FD LENGTH
ADD T2,S1 ;POINT TO NEXT FP (IF THERE IS ONE)
SOJG T1,CRE.3A ;AND LOOP FOR ALL FILES
CRE.3C: SKIPN S1,.EQROB+.ROBND(M) ;DID HE SPECIFY A HOST ID
MOVE S1,G$LNAM## ;NO,,GET THE HOST SITE ID
PUSHJ P,N$NODE## ;MAKE SURE ITS IN OUR DATA BASE
MOVEM S1,.EQROB+.ROBND(M) ;SAVE HOST ID
JUMPN P4,CREA.3 ;SKIP THIS IF WE HAVE A DPA
LOAD S1,.EQROB+.ROBTY(M) ;GET REQUESTED OBJECT TYPE
GETLIM S2,.EQLIM(M),FAIL ;GET FAILSOFT BIT
CAIN S1,.OTEVT ;EVENT?
CAIN S2,1 ;WANT TO FAILSOFT THIS REQUEST?
SKIPA S1,M ;POINT TO THE EQ THE ADDRESS
JRST CREA.3 ;DON'T FAILSOFT
PUSHJ P,F$WRRQ## ;AND FAILSOFT IT
MOVE P4,S1 ;PUT THE DPA IN P4
CREA.3: STORE P4,.QESTN(AP),QE.DPA ;STORE THE DISK ADDRESS
MOVE S1,.EQITN(M) ;GET THE ITN
MOVEM S1,.QEITN(AP) ;AND STORE IT
MOVE S1,M ;POINT S1 TO THE EQ
PUSHJ P,I$EQQE## ;MOVE INFO FROM EQ TO QE
MOVSI S1,.EQJBB(M) ;GET THE SOURCE ADDRESS
HRRI S1,.QEJBB(AP) ;GET THE DESTINATION ADDRESS
BLT S1,.QEJBB+JIBSIZ-1(AP) ;COPY THE JIB OVER
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVSI S1,.EQACT(M) ;GET SOURCE ACCOUNT STRING
HRRI S1,.QEACT(AP) ;GET DESTINATION
BLT S1,.QEACT+7(AP) ;COPY THE ACCOUNT STRING
LOAD S1,.EQSPC(M),EQ.PRO ;GET THE PROTECTION FIELD
STORE S1,.QEPRT(AP),QE.PRO ;STORE IT
HRLI S1,.EQROB(M) ;POINT TO ROB IN EQ
HRRI S1,.QEROB(AP) ;AND POINT TO ROB IN QE
BLT S1,.QEROB+ROBSIZ-1(AP) ;AND MOVE THE BLOCK
MOVSI S1,.EQLIM(M) ;SOURCE OF 'EQLMSZ' LIMIT WORDS
HRRI S1,.QELIM(AP) ;DESTINATION OF 'EQLMSZ' LIMIT WORDS
BLT S1,.QELIM+EQLMSZ-1(AP) ;BLT THEM ACROSS
PUSHJ P,Q$EVTC ;DO SPECIAL EVENT CREATE PROCESSING
LOAD S1,.EQSEQ(M),EQ.NOT ;GET THE NOTIFY BITS
SKIPE S1 ;DOES HE WANT /NOTIFY ???
PUSHJ P,Q$NOTIFY ;YES,,SET IT UP !!!
MOVE S1,.EQAFT(M) ;GET CREATE OR AFTER TIME
MOVEM S1,.QECRE(AP) ;AND STORE IT
PUSHJ P,S$AFTR## ;SCHEDULE /AFTER IF WE HAVE TO
CREA.4: LOAD S1,.QHPAG(H),QH.SCH ;GET BASE OF SCHED VECTOR
PUSHJ P,SCHLNK(S1) ;AND LINK IN THE REQUEST
$COUNT (SCRE) ;NUMBER OF SUCCESSFUL CREATES
MOVE S1,AP ;GET THE QE ADDR IN S1
PUSHJ P,I$BMDR## ;BUILD THE MDR THE THE REQUEST
PUSHJ P,Q$EVTP ;DO POST CREATE EVENT CLEANUP
DOSCHD ;LETS TRY TO SCHEDULE IT
SKIPN G$ACK## ;DOES CALLER WANT ACKNOWLEDGEMENT
$RETT ;NO, ALL DONE
;**;[1161] Insert 6 lines after CREA.4+8L. 17-Nov-83 /LWS
MOVX S1,EQ.CHG ;[1161] GET PRIORITY CHANGED BIT
TDNN S1,.EQSEQ(M) ;[1161] IS IT LIT?
JRST CRE.4B ;[1161] NO,,CONTINUE
ANDCAM S1,.EQSEQ(M) ;[1161] YES,,TURN IT OFF
MOVX S1,MXUPRI ;[1161] GET PRIORITY REQUEST WAS CHANGED TO
$TEXT (G$CCHR##,<[Requested priority changed to user maximum of ^D/S1/]>) ;[1161]
CRE.4B: MOVEI S1,"[" ;START OF USER ACK
SKIPN G$ACKO## ;ACKING AN OPR CREATE?
PUSHJ P,G$CCHR## ;NO
MOVE S1,.QEROB+.ROBTY(AP) ;[1161] GET THE OBJECT TYPE
CAIE S1,.OTBIN ;IS IT THE BATCH INPUT QUEUE ???
CAIN S1,.OTBAT ; OR IS IT BATCH QUEUE ???
JRST CREA.5 ;YES,,GO DO IT
MOVEI S2,[ITEXT (<^1/S1/ job>)] ;ASSUME NORMAL QUEUE
CAIN S1,.OTEVT ;EVENT?
MOVEI S2,[ITEXT (<^1/S1/>)] ;YES
$TEXT (G$CCHR##,<^I/(S2)/ ^W/.QEJOB(AP)/ queued, request #^D/.QERID(AP)/^A>)
GETLIM S2,.QELIM(AP),OLIM ;GET OUTPUT LIMIT
CAIE S1,.OTFTS ;FILE TRANSFER?
CAIN S1,.OTEVT ;OR EVENT?
JRST CRE.4A ;YES--ALMOST DONE
$TEXT(G$CCHR##,<, limit ^D/S2/^A>) ;[FTS]
LOAD S1,.EQSPC(M),EQ.NUM ;GET THE NUMBER OF FILES
CAILE S1,1 ;MORE THEN 1 ???
$TEXT (G$CCHR##,<, ^D/S1/ files^A>) ;YES,,SAY SO
CRE.4A: MOVEI S1,"]" ;GET TERMINATING BRACKET
SKIPN G$ACKO## ;ACKING OPR CREATE?
PUSHJ P,G$CCHR## ;NO--TYPE IT
MOVEI S1,.CHNUL ;GET A <NUL>
PUSHJ P,G$CCHR## ;MAKE IT ASCIZ
PJRST G$MSND## ;GO SEND THIS ACK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CREA.5: GETLIM T1,.QELIM(AP),TIME ;NUMBER OF SECONDS EQUESTED
IDIVI T1,^D3600 ;HOURS IN T1
IDIVI T2,^D60 ;MINUTES IN T2, SECONDS IN T3
$TEXT(G$CCHR##,<Batch job ^W/.QEJOB(AP)/ queued, request #^D/.QERID(AP)/, limit ^D/T1/:^D2R0/T2/:^D2R0/T3/^A>)
MOVEI S1,"]" ;END OF NORMAL ACK
SKIPN G$ACKO## ;ACKING AN OPR CREATE?
PUSHJ P,G$CCHR## ;NO
SETZ S1, ;DONT ACK AGAIN.
PJRST G$MSND## ;SEND THE "ACK" AND RETURN
SUBTTL SHORT CREATE MESSAGE PROCESSOR (SOON TO BE ONLY CREATE MSG)
;CALL: M/SHORT CREATE MESSAGE ADDRESS
;
;RET: TRUE ALWAYS
;
;THE FOLLOWING AC'S ARE USED:
;
; P1/ The Base Create Message Address
; P2/ The Queue Type (set by the .QCQUE block) (Input or Output)
;
; T1/ The Message Block Type (Set by A$GBLK)
; T2/ The Message Block Length (Set by A$GBLK)
; T3/ The Message Block Address (Set by A$GBLK)
; T4/ The First Data Word of the Message Block (Set at CRQE.3)
Q$CRQE: PUSHJ P,.SAVE2 ;SAVE P1 WHILE WE ARE HERE
$SAVE M ;SAVE THE MESSAGE ADDRESS ALSO
SETZM P2 ;CLEAR P2 (WILL BE USED FOR QUEUE TYPE)
SETZM PRCBLK ;CLEAR PROCESS BLOCK FLAG
PUSHJ P,M%GPAG ;GET A PAGE FOR THE CREATE MESSAGE
MOVE P1,S1 ;SAVE THE PAGE ADDRESS
MOVE S1,[%%.QSR,,EQHSIZ] ;SETUP .EQLEN
STORE S1,.EQLEN(P1) ;SAVE IT
MOVE S1,[EQHSIZ,,.QOCRE] ;SETUP LENGTH,,MSG TYPE
STORE S1,.MSTYP(P1) ;SAVE IT
MOVE S1,.MSFLG(M) ;GET THE USERS FLAG WORD
STORE S1,.MSFLG(P1) ;PUT IT IN OUR MESSAGE
MOVE S1,.MSCOD(M) ;GET THE USERS ACK CODE
STORE S1,.MSCOD(P1) ;PUT IT IN OUR MESSAGE
MOVX S1,.QCQUE ;GET THE QUEUE TYPE BLOCK
PUSHJ P,A$FNDB## ;FIND IT IN THE MESSAGE
JUMPF CRQE.5 ;NOT THERE,,THATS AN ERROR
MOVE S1,0(S1) ;GET THE QUEUE TYPE
MOVEM S1,.EQROB+.ROBTY(P1) ;SAVE IT IN THE MESSAGE
PUSHJ P,A$OB2Q## ;FIND THE QUEUE HEADER
LOAD P2,.QHTYP(S1),QH.TYP ;GET THE GENERIC QUEUE TYPE
MOVEI S1,0 ;DON'T KNOW WHAT DISPATCH TABLE YET
CAXE P2,.QHTOU ;IS IT FOR THE OUTPUT QUEUES ???
CAXN P2,.QHTIP ;OR IS IT FOR THE INPUT QUEUES ???
MOVE S1,[-TBLEN,,BLKTBL] ;YES
CAIN P2,.QHTEV ;EVENT QUEUE?
MOVE S1,[-EVTLEN,,EVTTBL] ;YES
JUMPN S1,CRQE.0 ;CONTINUE IF KNOWN DISPATCH
MOVE S1,.EQROB+.ROBTY(P1) ;GET THE OBJECT TYPE
CAXN P2,.QHFRR ;ARE WE FREE RUNNING
CAXE S1,.OTDBM ;AND DBMS ???
JRST CRQE.5 ;NO,,THATS NOT GOOD SO RETURN
CRQE.0: MOVEM S1,CRQETB ;SAVE DISPATCH TABLE ADDRESS
CRQE.1: PUSHJ P,A$GBLK## ;GET THE FIRST/NEXT MESSAGE BLOCK
JUMPF CRQE.4 ;NO MORE,,LETS TRY THE CREATE
MOVE S1,CRQETB ;GET AOBJN POINTER TO DISPATCH TABLE
SOJG T2,CRQE.2 ;MAKE SURE LENGTH IS CORRECT
CAIN T1,.QCACT ;ACCOUNT STRING BLOCK?
JRST CRQE.2 ;YES, THAT MAY BE ZERO LENGTH
JRST CRQE.5 ;NO, THAT'S AN ERROR
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQE.2: HRRZ S2,(S1) ;GET A BLOCK TYPE
CAMN S2,T1 ;DO WE MATCH ???
JRST CRQE.3 ;WE MATCH,,SO GO PROCESS THE BLOCK
AOBJN S1,CRQE.2 ;NO MATCH,,TRY THE NEXT BLOCK
JRST CRQE.5 ;BLOCK NOT FOUND,,THATS AN ERROR
CRQE.3: MOVE T4,0(T3) ;GET THE FIRST DATA WORD OF MSG BLK
HLRZ S1,(S1) ;GET THE PROCESSOR ADDRESS
PUSHJ P,0(S1) ;GO DO IT !!!
JUMPT CRQE.1 ;ALL OK,,CONTINUE PROCESSING
JRST CRQE.5 ;ELSE GO FINISH UP
CRQE.4: MOVE M,P1 ;POINT TO OUR NEW CREATE MSG
PUSHJ P,Q$CREATE ;GO TRY TO CREATE THE QUEUE ENTRY
SKIPA ;SKIP OVER THE ERROR CALL
CRQE.5: PUSHJ P,E$ICM## ;SET 'INVALID CREATE MSG' ERROR
MOVE S1,P1 ;GET 'OUR' CREATE MSG ADDRESS
PUSHJ P,M%RPAG ;RELEASE THE PAGE
$RETT ;RETURN
EVTTBL: .RETT,,.QCQUE ;QUEUE TYPE
CRQEVT,,.QBEVT ;EVENT TYPE
CRQAFT,,.QBAFT ;EXPIRATION DATE/TIME
CRQREP,,.QBREP ;REPEAT FLAGS
CRQFIL,,.QBFIL ;AUTO-FILE
CRQPTP,,.QBPTP ;FILE TYPE (ASCII, FORTRAN, ETC.)
CRQMSG,,.QBMSG ;MESSAGE BLOCK
CRQESW,,.QBESW ;EVENT SWITCH BLOCK (2 DATA WORDS)
EVTLEN==.-EVTTBL ;LENGTH OF TABLE
BLKTBL: CRQFIL,,.QCFIL ;FILESPEC BLOCK
CRQCOP,,.QCCOP ;/COPIES BLOCK
CRQFRM,,.QCFRM ;/FORM: BLOCK
CRQPTP,,.QCPTP ;PRINT TYPE (ASCII,FORTRAN, ETC)
CRQODP,,.QCODP ;OUTPUT DISPOSITION (/DISP:)
CRQUNT,,.QCUNT ;UNIT TYPE BLOCK (LOWER, UPPER,UNIT:)
CRQAFT,,.QCAFT ;/AFTER: BLOCK
CRQLIM,,.QCLIM ;/LIMIT: BLOCK
CRQUNI,,.QCUNI ;/UNIQUE: BLOCK
CRQRES,,.QCRES ;/RESTART: BLOCK
CRQLOG,,.QCLOG ;/OUTPUT: BLOCK
CRQACT,,.QCACT ;/ACCOUNT: BLOCK
.RETT,,.QCQUE ;QUEUE TYPE (BATCH, PRINT, ETC)
CRQNOD,,.QCNOD ;DESTINATION NODE BLOCK
CRQNAM,,.QCNAM ;USERS NAME BLOCK
CRQOID,,.QCOID ;USERS NUMBER BLOCK
CRQNOT,,.QCNOT ;/NOTIFY BLOCK
CRQBLT,,.QCBLT ;INPUT DISPOSITION (/BATLOG:)
CRQJBN,,.QCJBN ;JOB NAME BLOCK
CRQCDI,,.QCCDI ;CONNECTED DIRECTORY BLOCK
CRQNTE,,.QCNTE ;/NOTE: BLOCK
CRQBGN,,.QCBGN ;/BEGIN: BLOCK
CRQPRI,,.QCPRI ;/PRIORITY BLOCK
CRQFRR,,.QCFRR ;LIMIT WORD BLOCK FOR FREE RUNNING OBJS
CRQAST,,.QCAST ;/ASSIST BLOCK
CRQPRC,,.QCPRC ;/PROCESSING BLOCK - IBMCOM
CRQOPT,,.QBOPT ;/BATOPT
CRQDIS,,.QBDIS ;/DISTRIBUTION:"TEXT"
CRQUSR,,.QBUSR ;/USERNAME:"TEXT"
CRQUTY,,.QBUTY ;SIXBIT UNIT TYPE
TBLEN==.-BLKTBL
SUBTTL CHKQUE -- CHECK IF QUEUE IS ENABLED/DISABLED
; CHECK FOR QUEUE BEING DISABLED
; CALL: MOVE H, QUEUE HEADER
; PUSHJ P,CHKQUE
;
; NOTE: BATCH JOBS ARE ALWAYS IMMUNE TO DISABLED QUEUES. THIS IS
; AKIN TO THE BEHAVIOR OF LOCKED STRUCTURES.
CHKQUE: MOVX S1,QH.DIS ;BIT TO TEST
TDNN S1,.QHTYP(H) ;DISABLED?
$RETT ;NO
LOAD S1,.QHTYP(H),QH.TYP ;GET QUEUE TYPE
CAIE S1,.QHTOU ;OUTPUT?
CAIN S1,.QHTIP ;INPUT?
SKIPA S1,G$SND## ;GET SENDER'S ID
$RETT ;ALLOW CREATE
PUSHJ P,C%PIDJ ;CONVERT TO A JOB NUMBER
JUMPF .RETT ;ASSUME NOT BATCH
PUSHJ P,I$BATJ## ;SEE IF A BATCH JOB
JUMPT .POPJ ;ALWAYS LET BATCH JOBS DO CREATES
MOVE S1,.QHLQN(H) ;GET QUEUE LISTING NAME
$TEXT (<-1,,@G$ACKB##>,<^T/(S1)/ queue is disabled^0>)
PUSHJ P,E$XXX## ;SET THE ERROR CODE
MOVEI S1,'QID' ;GET PREFIX FOR QUEUE PROGRAM
HRLM S1,G$ERR## ;SAVE
$RETF ;AND RETURN
SUBTTL SHORT CREATE MESSAGE ACTION ROUTINES
CRQFIL: CAILE T2,FDXSIZ ;MUST BE LESS OR EQUAL TO MAX FD SIZE
$RETF ;NO,,RETURN NOW
MOVEI S1,EQHSIZ(P1) ;POINT TO THE FP
SKIPE 0(S1) ;ONLY SUPPORT ONE FILESPEC FOR NOW !!!
$RETF ;MORE THEN ONE,,RETURN NOW
MOVEI S2,EQHSIZ+FPMSIZ+1(T2) ;GET THE TOTAL MESSAGE LENGTH
STORE S2,.MSTYP(P1),MS.CNT ;SAVE IT IN THE MESSAGE
MOVX S2,FPMSIZ ;GET THE FP LENGTH
STORE S2,.FPLEN(S1),FP.LEN ;SAVE IT IN THE FP
ADD S1,S2 ;POINT TO THE FD
MOVEI S2,1(T2) ;GET THE TOTAL FD LENGTH IN S2
STORE S2,.FDLEN(S1),FD.LEN ;SAVE IT IN THE FD
ADD T2,S1 ;GET THE END BLT ADDRESS
HRRI S1,.FDFIL(S1) ;POINT TO THE ACTUAL FILESPEC AREA
HRL S1,T3 ;GET THE SOURCE ADDRESS
BLT S1,0(T2) ;COPY THE FILESPEC OVER
AOS .EQSPC(P1) ;MAKE THE FILE COUNT = 1
$RETT ;RETURN OK
CRQCOP: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAIE P2,.QHTOU ;AND QUEUE TYPE MUST BE 'OUTPUT'
$RETF ;NO,,RETURN NOW
MOVEI S1,EQHSIZ(P1) ;POINT TO THE FP
STORE T4,.FPINF(S1),FP.FCY ;SAVE IT IN THE FP
$RETT ;RETURN OK
CRQFRM: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAIE P2,.QHTOU ;AND QUEUE TYPE MUST BE 'OUTPUT'
$RETF ;NO,,THATS AN ERROR
STOLIM T4,.EQLIM(P1),FORM ;SAVE THE FORM TYPE
$RETT ;RETURN OK
CRQPTP: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAILE T4,.FPMAX ;FORMAT MUST BE LESS OR EQUAL TO MAX
$RETF ;NO,,THATS AN ERROR
JUMPLE T4,.RETF ;CANT BE LESS OR EQUAL TO 0
MOVEI S1,EQHSIZ(P1) ;POINT TO THE FP
STORE T4,.FPINF(S1),FP.FFF ;SAVE THE FILE FORMAT
$RETT ;RETURN OK
;**;[1171] Change 1 line and delete 1 line at CRQODP+0L. /LWS
CRQODP: CAIE T2,1 ;[1171] BLOCK LENGTH MUST BE 1
$RETF ;NO,,THATS AN ERROR
CAIL T4,0 ;CAN'T BE NEGATIVE
CAILE T4,%RENAME ;WITHIN RANGE?
$RETF ;NO,,THATS AN ERROR
MOVEI S1,EQHSIZ(P1) ;POINT TO THE FP
MOVE T4,[EXP 0,FP.DEL,FP.REN](T4) ;RECODE THE DISPOSITION
IORM T4,.FPINF(S1) ;AND SET IT
$RETT ;RETURN OK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQUNT: SOJN T2,.RETF ;BLOCK LENGTH MUST BE 1
LOAD S1,T4,RO.ATR ;GET DEVICE ATTRIBUTES IN S1
CAILE S1,%ATMAX ;WITHIN RANGE?
$RETF ;NO,,THATS AN ERROR
LOAD T1,.EQROB+.ROBTY(P1) ;GET THE OBJECT TYPE
MOVX S2,1B0 ;GET A BIT FOR TEST
MOVN T1,T1 ;SETUP TO DO RIGHT SHIFT
LSH S2,(T1)
TDNN S2,ATRCDS(S1) ;VALID FOR THIS OBJECT?
$RETF ;NO,,THATS AN ERROR
STORE S1,.EQROB+.ROBAT(P1),RO.ATR ;STORE THE ATTRIBUTE
CAIE S1,%PHYCL ;IS IT PHYSICAL?
$RETT ;NO,,JUST RETURN
LOAD S2,T4,RO.UNI ;YES,,GET THE UNIT
CAILE S2,7 ;WITHIN RANGE?
$RETF ;NO,,THATS AN ERROR
STORE S2,.EQROB+.ROBAT(P1),RO.UNI ;STORE THE UNIT NUMBER
$RETT
CRQAFT: SOJN T2,.RETF ;BLOCK SIZE MUST BE 1
MOVEM T4,.EQAFT(P1) ;SAVE THE /AFTER PARM
$RETT ;AND RETURN
CRQLIM: SOJN T2,.RETF ;BLOCK LENGTH MUST BE 1
CAIN P2,.QHTOU ;IS THIS AN OUTPUT QUEUE ???
STOLIM T4,.EQLIM(P1),OLIM ;YES,,SAVE IT HERE
CAIN P2,.QHTIP ;OR IS IT AN INPUT QUEUE ???
STOLIM T4,.EQLIM(P1),TIME ;YES,,SAVE IT HERE
$RETT ;AND RETURN
CRQUNI: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAIE P2,.QHTIP ;AND QUEUE TYPE MUST BE INPUT
$RETF ;NO,,RETURN NOW
CAIL T4,%EQUNO ;MUST BE EQUAL TO NO
CAILE T4,%EQUYE ; OR YES
$RETF ;ELSE THATS AN ERROR
STOLIM T4,.EQLIM(P1),UNIQ ;OK,,SAVE THE /UNIQUE VALUE
$RETT ;AND RETRUN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQRES: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAIE P2,.QHTIP ;AND QUEUE TYPE MUST BE INPUT
$RETF ;NO,,RETURN NOW
CAIL T4,%EQRNO ;MUST BE EQUAL TO NO
CAILE T4,%EQRYE ; OR YES
$RETF ;IF NOT,,THATS AN ERROR
STOLIM T4,.EQLIM(P1),REST ;OK,,SAVE THE /RESTART VALUE
$RETT ;AND RETURN
CRQLOG: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAIE P2,.QHTIP ;AND QUEUE TYPE MUST BE INPUT
$RETF ;NO,,RETURN NOW
CAIL T4,%EQONL ;MUST BE NO LOG, ALWAYS LOG,
CAILE T4,%EQOLE ; OR LOG ON ERROR ONLY
$RETF ;NO,,THATS AN ERROR
STOLIM T4,.EQLIM(P1),OUTP ;OK,,SAVE THE /OUTPUT: VALUE
$RETT ;AND RETRUN
CRQACT: CAILE T2,10 ;ACCOUNT STRING MUST BE LESS THEN 10
$RETF ;ELSE THATS AN ERROR
JUMPE T2,.RETT ;QUIT IF ZERO-LENGTH ACCOUNT STRING
MOVEI S1,.EQACT(P1) ;GET THE DESTINATION ADDRESS
ADDI T2,-1(S1) ;GET THE END ADDRESS
HRL S1,T3 ;GET THE SOURCE ADDRESS
BLT S1,0(T2) ;COPY IT OVER
$RETT ;AND RETURN
CRQNOD: CAIE P2,.QHTIP ;[1230]INPUT QUEUE CREATE ??
JRST CQPC.1 ;[1230]NO, GO WRITE THE ROB WORD
CAIE T2,1 ;[1230]BLOCK LENGTH MUST BE 1
$RETF ;[1230]NO, THATS AN ERROR
MOVE S1,G$LNBR## ;[1230]DEFAULT, TO LOCAL NODE NUMBER
SKIPN PRCBLK ;[1230]PREVIOUS .QBPRC BLOCK ???
STORE S1,.EQROB+.ROBND(P1) ;[1230]NO, SAVE PROCESS NODE INFO
SKIPN T4 ;[1230]HE SET IT, SO SKIP THIS
MOVE T4,G$LNBR## ;[1230]DEFAULT, TO LOCAL NODE NUMBER
STOLIM T4,.EQLIM(P1),ONOD ;[1230]YES, SAVE IN LIMIT WORDS
TLNN T4,600000 ;[1230]IS IT BINARY ?
$RETT ;[1230]YES, DON'T CONVERT AND RETURN
MOVE S1,T4 ;[1230]NO, GET NODE NAME/NUMBER
PUSHJ P,N$GNOD## ;[1230]LET'S FIND THE NODE
JUMPF .RETT ;[1230]DID WE FIND THE NODE ???
SKIPE S1,NETNBR(S2) ;[1230]YES, GET THE NUMBER IF ANY
STOLIM S1,.EQLIM(P1),ONOD ;[1230]SAVE IN THE LIMIT WORDS
$RETT ;[1230]AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQPRC: CAIE P2,.QHTIP ;[1230]INPUT QUEUE CREATE ??
$RETF ;[1230]NO, TAKE ERROR RETURN
SETOM PRCBLK ;[1230]REMEMBER WE CAME THIS WAY
CQPC.1: CAIE T2,1 ;[1230]BLOCK LENGTH MUST BE 1
$RETF ;[1230]NO, THATS AN ERROR
SKIPN T4 ;[1230]HE SET IT, SO SKIP THIS
MOVE T4,G$LNBR## ;[1230]DEFAULT, TO LOCAL NODE NUMBER
STORE T4,.EQROB+.ROBND(P1) ;[1230]NO, SAVE THE NODE NAME/NUMBER
TLNN T4,600000 ;[1230]IS IT BINARY ?
$RETT ;[1230]YES, DON'T CONVERT
MOVE S1,T4 ;[1230]NO, GET NODE NAME/NUMBER
PUSHJ P,N$GNOD## ;[1230]LET'S FIND THE NODE
JUMPF .RETT ;[1230]DID WE FIND THE NODE ???
SKIPE S1,NETNBR(S2) ;[1230]YES, GET THE NUMBER IF ANY
STORE T4,.EQROB+.ROBND(P1) ;[1230]SAVE THE NODE NAME/NUMBER
$RETT ;[1230]NO, RETURN
CRQNAM: CAILE T2,EQNMSZ ;SIZE MUST BE VALID
$RETF ;ELSE THATS AN ERROR
MOVEI S1,.EQOWN(P1) ;GET THE DESTINATION ADDRESS
ADDI T2,-1(S1) ;GET THE END ADDRESS
HRL S1,T3 ;GET THE SOURCE ADDRESS
BLT S1,0(T2) ;COPY IT OVER
$RETT ;AND RETURN
CRQOID: CAIE T2,1 ;BLOCK LENGTH MUST BE 1
$RETF ;NO, THATS AN ERROR
STORE T4,.EQOID(P1) ;SAVE THE USER NUMBER
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQNOT: CAIE T2,1 ;BLOCK LENGTH MUST BE 1
$RETF ;NO, THATS AN ERROR
CAIL T4,%NOTTY ;CANT BE LESS THEN %NOTTY OR
CAILE T4,%NOTJB ;GREATER THEN %NOTJB
$RETF ;ELSE THATS AN ERROR
STORE T4,.EQSEQ(P1),EQ.NOT ;SAVE IT
$RETT ;AND RETURN
CRQBLT: CAIN T2,1 ;BLOCK LENGTH MUST BE 1
CAIE P2,.QHTIP ;AND QUEUE TYPE MUST BE INPUT
$RETF ;NO, THATS AN ERROR
CAIL T4,%BAPND ;VALUE MUST BE APPEND OR SUPERCEDE,
CAILE T4,%BSPOL ; OR SPOOL
$RETF ;IF NOT, THATS AN ERROR
STOLIM T4,.EQLIM(P1),BLOG ;OK, SAVE IT
$RETT ;AND RETURN
CRQJBN: CAIE T2,1 ;BLOCK LENGTH MUST BE 1
$RETF ;ELSE THATS AN ERROR
STORE T4,.EQJOB(P1) ;SAVE IT AS THE JOB NAME
$RETT ;AND RETURN
CRQCDI: MOVEI S1,-1(T3) ;GET THE BLOCK ADDRESS
MOVE S2,P1 ;AND THE EQ PAGE ADDRESS
PJRST I$QCDI## ;AND GO PROCESS THE CONNECTED DIRECTORY
CRQNTE: CAIG T2,2 ;LENGTH MUST BE LESS OR EQUAL TO 2
CAIE P2,.QHTOU ;AND MUST BE AN OUTPUT QUEUE
$RETF ;ELSE THATS AN ERROR
DMOVE S1,0(T3) ;GET 2 WORDS OF THE BLOCK
STOLIM S1,.EQLIM(P1),NOT1 ;SAVE THE FIRST NOTE WORD
CAIN T2,2 ;ARE THERE 2 WORDS ???
STOLIM S2,.EQLIM(P1),NOT2 ;YES, SAVE THE SECOND NOTE WORD
$RETT ;AND RETURN
CRQBGN: CAIE T2,1 ;LENGTH MUST BE 1
$RETF ;ELSE THATS AN ERROR
CAIE P2,.QHTIP ;SIXBIT TAG ONLY LEGAL IF INPUT QUEUE
JUMPL T4,.RETF ;GIVE AN ERROR OTHERWISE
MOVEI S1,EQHSIZ(P1) ;POINT TO THE FP
STORE T4,.FPFST(S1) ;AND SAVE THE STARTING PAGE NUMBER
$RETT ;RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQPRI: CAIE T2,1 ;LENGTH MUST BE 1
$RETF ;ELSE THATS AN ERROR
PUSHJ P,A$WHEEL## ;SEE IF THE GUY IS A WHEEL !!!
CAXLE T4,MXUPRI ;GREATER THEN THE MAX USER PRIORITY ?
SKIPF ;YES, IS THE GUY A WHEEL ???
SKIPA ;YES, HE WINS
MOVX T4,MXUPRI ;NO, MAKE IT THE MAX USER PRIORITY
STORE T4,.EQSEQ(P1),EQ.PRI ;SAVE THE PRIORITY
$RETT ;AND RETURN
CRQFRR: CAXN P2,.QHFRR ;ONLY VALID FOR FREE RUNNING DEVICES
CAXLE T2,EQLMSZ ;LENGTH MUST FIT IN LIMIT WORDS
$RETF ;NO, THATS AN ERROR
MOVSS T3 ;GET SOURCE ADDRESS,,0
HRRI T3,.EQLIM(P1) ;GET SOURCE,,DESTINATION
ADDI T2,.EQLIM(P1) ;GET END ADDRESS
BLT T3,-1(T2) ;COPY LIMIT WORDS OVER
$RETT ;RETURN
CRQEVT: SOJN T2,.RETF ;BLOCK SIZE MUST BE 1
STOLIM T4,.EQLIM(P1),TYPE ;SAVE
$RETT ;AND RETURN
CRQMSG: CAILE T2,STSSIZ ;CHECK MESSAGE (REASON) TEXT LENGTH
$RETF ;TOO BIG
MOVEI S1,.EQTXT(P1) ;GET THE DESTINATION ADDRESS
ADDI T2,-1(S1) ;GET THE END ADDRESS
HRL S1,T3 ;GET THE SOURCE ADDRESS
BLT S1,0(T2) ;COPY IT OVER
$RETT ;AND RETURN
CRQREP: SOJN T2,.RETF ;BLOCK SIZE MUST BE 1
STOLIM T4,.EQLIM(P1),REPT ;SAVE REPEAT FLAGS
$RETT ;AND RETURN
CRQESW: CAIE T2,2 ;BLOCK SIZE MUST BE 2
$RETF ;NOT CORRECT SIZE
STOLIM T4,.EQLIM(P1),SWIT ;STORE EVENT DEPENDENT SWITCHES
MOVSI S1,-XSWTSZ ;GET SIZE OF LOAD/STORE XCT TABLE
HRRI S1,XSWTTB ;FINISH AOBJN POINTER
CRQES1: HLRZ S2,(S1) ;GET ADDRESS OF INSTR THAT GETS SWITCH
XCT (S2) ;LOAD THE SWITCH VALUE
HRRZ S2,(S1) ;GET ADDRESS OF INSTR THAT STORES VALUE
XCT (S2) ;PUT SWITCH VALUE IN RIGHT PLACE
AOBJN S1,CRQES1 ;LOOP FOR ALL SWITCHES
$RETT ;RETURN
XSWTTB: [LOAD T4,.QBESI(T3),QB.FSF],,[STOLIM T4,.EQLIM(P1),FAIL] ;/FAILSOFT
[LOAD T4,.QBESI(T3),QB.NFS],,[STOLIM T4,.EQLIM(P1),NOFS] ;/NOFAILSOFT
XSWTSZ==.-XSWTTB
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CRQAST: CAIN T2,1 ;[1230]BLOCK LENGTH MUST BE 1
CAIE P2,.QHTIP ;[1230]AND QUEUE TYPE MUST BE INPUT
$RETF ;[1230]NO, RETURN NOW
CAIL T4,.OPINY ;[1230]MUST BE EQUAL TO NO
CAILE T4,.OPINN ;[1230] OR YES
$RETF ;[1230]IF NOT, THATS AN ERROR
STOLIM T4,.EQLIM(P1),OINT ;[1230]OK, SAVE THE /ASSIST VALUE
$RETT ;[1230]AND RETURN
CRQOPT: CAIN T2,1 ;LENGTH MUST BE ONE
CAIE P2,.QHTIP ;AND IT MUST BE THE BATCH QUEUE
$RETF ;BAD MESSAGE
STOLIM T4,.EQLIM(P1),OPTN ;SAVE BATCH OPTION NAME
$RETT ;RETURN
CRQDIS: CAILE T2,12 ;LIMIT OF 39 CHARACTERS
$RETF ;ERROR
MOVEI S1,.EQBOX(P1) ;STORAGE ADDRESS
ADDI T2,-1(S1) ;COMPUTE END OF BLT
HRL S1,T3 ;MESSAGE ADDRESS
BLT S1,0(T2) ;COPY /DISTRIBUTION:"TEXT"
$RETT ;RETURN
CRQUSR: CAILE T2,12 ;LIMIT OF 39 CHARACTERS
$RETF ;ERROR
MOVEI S1,.EQUSR(P1) ;STORAGE ADDRESS
ADDI T2,-1(S1) ;COMPUTE END OF BLT
HRL S1,T3 ;MESSAGE ADDRESS
BLT S1,0(T2) ;COPY /USERNAME:"TEXT"
$RETT ;RETURN
CRQUTY: SOJN T2,.RETF ;ONLY ONE WORD IS LEGAL
CAIE P2,.QHTOU ;MUST BE AN OUTPUT QUEUE
$RETF ;ISN'T
MOVEM T4,.QEROB+.ROBUT(P1) ;SAVE IN ROB
$RETT ;RETURN
SUBTTL MODIFY -- Function 11
;THE MODIFY MESSAGE IS SENT TO QUASAR BY ANY UNKNOWN COMPONENT TO CHANGE
; THE PARAMETERS OF A REQUEST IN A PROCESSING OR AFTER QUEUE
;MODIFY PREFORMS THE FOLLOWING FUNCTIONS:
; 1 ) VALIDATE THE ARGUMENTS
; 2 ) BUILD A TEMPORARY QUEUE OF REQUESTS THAT MATCH
; 3 ) PERFORM THE MODIFY REQUEST ON EACH ELEMENT OF THE TEMPORARY QUEUE
; 4 ) CALL Q$CREATE FOR THE RESULTANT MODIFIED REQUEST
Q$MODIFY:
PUSHJ P,.SAVE4 ;SAVE P1-P4
$COUNT (MMOD) ;NUMBER OF MODIFY MESSAGES
LOAD P1,.MSTYP(M),MS.CNT ;GET THE COUNT FIELD
CAIGE P1,MOD.SZ ;TOO SMALL
PJRST E$MTS## ;INDICATE MESSAGE TOO SHORT
LOAD S1,MOD.OT(M) ;GET THE OBJECT TYPE
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER
JUMPF E$UQS## ;"UNKNOWN QUEUE SPECIFIED"
MOVE H,S1 ;COPY HEADER ADDRESS
MOVEM H,MODI.H ;SAVE
;BEFORE ACTUAL PROCESSING, CHECK THE REQUEST FOR INVALID LENGTHS AND GROUPS
ADDI P1,(M) ;P1 = FIRST WORD NOT IN THE MESSAGE
MOVEI P2,MOD.FG(M) ;P2 = THE FIRST GROUP HEADER
MODI.1: CAIG P1,MOD.GN(P2) ;OFF THE END OF THE MESSAGE
JRST MODI.2 ;YES, NOW BEGIN PROCESSING
LOAD P3,MOD.GN(P2),MODGPN ;GET THE GROUP NUMBER
LOAD P4,MOD.GN(P2),MODGLN ;AND NUMBER OF GROUP ELEMENTS
JUMPE P4,E$BMG## ;CANNOT BE ZERO
ADDI P4,(P2) ;P4 = NEXT GROUP HEADER
CAIG P3,NGROUP ;INVALID GROUP NUMBER
CAIGE P1,(P4) ;OR INVALID LENGTH
PJRST E$BMG## ;YES, BAD MESSAGE FORMAT
MOVEI P2,(P4) ;POINT TO THE NEXT GROUP
JRST MODI.1 ;CONTINUE FOR ALL PROVIDED GROUPS
;HAVING VERIFIED THE LENGTHS, BEGIN FINDING THE SPECIFIED REQUESTS
MODI.2: PUSH P,G$ACK## ;SAVE CALLERS "ACK" STATUS
ZERO G$ACK## ;SO DON'T GET MESSAGES FROM CREATE
ZERO MODI.C+0 ;ZERO NUMBER OF REQUESTS MODIFIED
SETOM MODI.C+1 ;INITIALLY, DON'T PRINT NUMBER OF FILES
ZERO MODI.C+2 ;NOT CANCELLING JOBS
ZERO MODHDR+.QHLNK ;CLEAR LINKS OF FAKE HEADER
PUSHJ P,MODSET ;SET UP ARGUMENTS FOR FNDREQ
PUSHJ P,FNDREQ ;FIND REQUESTS IN REQUESTED QUEUE
MOVEM S1,MODI.C+3 ;START COUNTING PROTECTION FAILURES
MOVEM M,MODI.A ;SAVE ORIGINAL MESSAGE ADDRESS
;"MODIFY" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;NOW, FLUSH THE TEMPORARY QUEUE, MODIFYING, RE-CREATING AS WE GO
MODI.3: LOAD AP,MODHDR+.QHLNK,QH.PTF ;GET THE TOP OF THE TEMPORARY QUEUE
JUMPE AP,MODI.6 ;PROCESSED THEM ALL (OR NONE)
LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER ADR
MOVE H,S1 ;AND PUT IT IN H
PUSH P,.QERID(AP) ;SAVE THIS REQUESTS ID FOR LATER
PUSH P,.QENID(AP) ;SAVE /NOTIFY ID
PUSH P,.QEJBN(AP) ;SAVE JOB NUMBER
LOAD S1,.QESTN(AP),QE.DPA ;GET THE RETREIVAL POINTER
PUSHJ P,F$RDRQ## ;READ IN THE ORIGINAL REQUEST
MOVEM S1,MODI.B ;SAVE FOR LATER RELEASE
MOVE AP,S1 ;ARGUMENT FOR MODIFIER ROUTINES
MOVE M,MODI.A ;GET MODIFY MESSAGE BACK
LOAD P1,.MSTYP(M),MS.CNT ;NOW LOOP FOR ALL GROUP HEADERS
ADDI P1,(M) ;P1 = FIRST WORD NOT IN THE MESSAGE
MOVEI P2,MOD.FG(M) ;P2 = THE FIRST GROUP
MODI.4: CAIG P1,MOD.GN(P2) ;OFF THE END OF THE MESSAGE
JRST MODI.5 ;YES, DONE WITH THIS MATCH
LOAD P3,MOD.GN(P2),MODGPN ;GET THE GROUP NUMBER
MOVEI S1,(P2) ;ARGUMENT FOR MODIFIERS
PUSHJ P,@GRPDIS(P3) ;CALL THE PROPER MODIFIER FOR THIS GROUP
LOAD P3,MOD.GN(P2),MODGLN ;ADJUST FOR THE NEXT GROUP
ADDI P2,(P3) ;P2 = THE NEXT GROUP
JRST MODI.4 ;CONTINUE FOR ALL GROUPS PROVIDED
;HERE AFTER ALL GROUP MODIFIES HAVE BEEN DONE, LINK IN THE NEW REQUEST
MODI.5: MOVE M,MODI.B ;ARGUMENT FOR CREATE = MODIFIED REQUEST
MOVX T1,.QIFNC ;THIS IS AN INTERNAL CALL
STORE T1,.MSTYP(M),MS.TYP ;SET FOR Q$CREATE
PUSHJ P,Q$CREATE ;PUT MODIFIED REQUEST BACK IN PLACE
SKIPE G$ERR## ;DID THE CREATE WORK
$STOP(CRM,CREATE REJECTED MODIFY)
POP P,S1 ;GET THE USERS JOB NUMBER BACK
LOAD S1,S1,QE.UJN ;GET JUST HIS JOB NUMBER
STORE S1,.QEJBN(AP),QE.UJN ;AND SAVE IT
POP P,.QENID(AP) ;RESTORE THE OLD /NOTIFY ID
LOAD AP,MODHDR+.QHLNK,QH.PTF ;GET OLD QUEUE ENTRY BACK
LOAD S1,.QESTN(AP),QE.DPA ;THE RETREIVAL POINTER
PUSHJ P,F$RLRQ## ;RELEASE OLD FAILSOFT COPY
PUSHJ P,Q$DDEP ;GET RID OF THE DEPENDENCY LIST
MOVEI H,MODHDR ;POINT TO THE TEMPORARY QUEUE
PUSHJ P,M$DLNK## ;REMOVE ENTRY ALREADY MODIFIED
LOAD H,.QEOBJ(AP) ;QUEUE THIS ENTRY CAME FROM (PROC, OR AFTER)
PUSHJ P,M$PFRE## ;RETURN TO PROPER FREE LIST
MOVE S1,MODI.B ;ADDRESS OF OLD FAILSOFT COPY
PUSHJ P,M%RPAG ;NO LONGER NEED IT
POP P,S1 ;RESTORE THE OLD REQUEST ID
TXO S1,BA%JOB ;GEN THE OLD REQUEST JOB NUMBER
PUSHJ P,D$LOGO## ;DELETE THE MDA QUEUE ENTRY
JRST MODI.3 ;GET ANY OTHER MATCHING REQUESTS
;NOW, GENERATE "ACK" AND RETURN TO THE CALLER
MODI.6: POP P,G$ACK## ;RESTORE "ACK" STATUS
MOVE M,MODI.A ;GET MODIFY MESSAGE BACK
MOVEI T1,MODI.C ;ARGUMENT BLOCK FOR BLDKMS
MOVEI T2,[ASCIZ/ modified/] ;TEXT TO APPEND
MOVE H,MODI.H ;RESTORE H
PJRST BLDKMS ;BUILD KILL/MODIFY STRING AND RETURN
; SUBROUTINES USED BY MODIFY
;ROUTINE CALL BE MODIFY LOOP TO SET UP ARGUMENTS FOR FNDREQ
MODSET: MOVNI T1,1 ;INDICATE MODIFY REQUEST
MOVEI T2,MOD.RQ(M) ;RDB FOR KILL/MODIFY
MOVE T3,MOD.OT(M) ;GET OBJECT TYPE
MOVEI T4,MODS.1 ;SUBROUTINE TO CALL FOR MATCHES
$RETT ;RETURN FOR CALL TO FNDREQ
;HERE WHEN FNDREQ FINDS A MATCH FOR THE MODIFY BLOCK, ACCUMULATE IN THE TEMP QUEUE
MODS.1: STORE H,.QEOBJ(AP) ;SAVE QUEUE THAT CONTAINED THIS ENTRY
PUSHJ P,M$DLNK## ;REMOVE FROM PROCESSING OR AFTER QUEUE
MOVEI H,MODHDR ;POINT TO THE TEMPORARY QUEUE
PUSHJ P,M$ELNK## ;LINK IN AT THE END
AOS MODI.C+0 ;INCREMENT COUNT OF MODIFIED REQS
$RETT ;RETURN FOR NEXT MATCH
;THE DISPATCH TABLE FOR GROUP MODIFIES
GRPDIS: EXP MAJMOD ;GROUP 0 = MAJOR QUEUE PARAMETERS
EXP GRPMOD ;GROUP 1 = QUEUE DEPENDENT PARAMETERS
NGROUP==<.-GRPDIS>-1 ;HIGHEST KNOWN GROUP NUMBER
GRPMOD: LOAD P3,.QHPAG(H),QH.SCH ;GET SCHEDULING BASE
PJRST SCHMOD(P3) ;DO QUEUE DEPENDENT MODIFY
MODHDR: BLOCK QHSIZE ;HEADER FOR THE TEMPORARY QUEUE
MODI.A: BLOCK 1 ;ORIGINAL 'M'
MODI.B: BLOCK 1 ;WHERE REQUEST WAS READ BY FAILSOFT
MODI.C::BLOCK 4 ;ARGUMENT BLOCK FOR BLDKMS
MODI.H: BLOCK 1 ;SAVED QUEUE HEADER
SUBTTL KILL -- Function 12
;THE KILL MESSAGE IS SENT TO QUASAR BY ANY UNKNOWN COMPONENT TO
; DELETE AN ENTRY FROM A QUEUE.
;KILL PERFORMS THE FOLLOWING FUNCTIONS:
; 1) LOOP THROUGH THE USE QUEUE ABORTING MATCHES.
; 2) LOOP THROUGH THE PROCESSING QUEUE DELETING MATCHES.
Q$KILL: PUSHJ P,.SAVE3 ;SAVE P1-P3
KILL.0: $COUNT (MKIL) ;NUMBER OF KILL MESSAGES
LOAD T1,.MSTYP(M),MS.CNT ;GET MESSAGE SIZE
CAIGE T1,KIL.SZ-<RDBSIZ-.RDBVS> ;BIG ENOUGH?
PJRST E$MTS## ;INDICATE MESSAGE TOO SHORT
LOAD S1,KIL.OT(M) ;GET THE OBJECT TYPE
CAIN S1,.OTMNT ;IS IT A MOUNT REQUEST CANCEL ???
PJRST I$KMNT## ;YES,,GO PROCESS IT AND EXIT
PUSHJ P,A$OB2Q## ;CONVERT TO QUEUE HEADER ADDRESS
JUMPF E$UQS## ;ERROR IF UNKNOWN QUEUE
MOVE H,S1 ;LOAD HDR ADDRESS INTO H
MOVEM H,KILL.H ;SAVE
SETZM P1 ;INDICATE KILL REQUEST (FOR FNDREQ)
MOVEI P2,KIL.RQ(M) ;REQUEST DESCR BLOCK FOR FNDREQ
LOAD P3,KIL.OT(M) ;GET OBJECT TYPE FOR FNDREQ
ZERO KILL.A+0 ;ZERO NUMBER KILLED
SETOM KILL.A+1 ;DON'T COUNT FILES
ZERO KILL.A+2 ;NUMBER CANCELLED
;NOW, SETUP AND LOOP THRU THE NECESSARY QUEUES
KILL.1: PUSH P,H ;SAVE PROCESSING QUEUE HDR
MOVE T4,[P1,,T1] ;MOVE PERMENANT ARGS TO REAL ARGS
BLT T4,T3 ;COPY P1 - P3
MOVEI T4,KILUSE ;SUBROUTINE TO CALL
MOVEI H,HDRUSE ;LOAD ADR OF USE QUEUE HDR
PUSHJ P,FNDREQ ;FIND A MATCHING REQUEST
MOVEM S1,KILL.A+3 ;START COUNTING PROT FAILURES
MOVE T4,[P1,,T1] ;NEED ARGUMENTS AGAIN
BLT T4,T3 ;SO MOVE THEM
MOVEI T4,Q$KPRO ;SUBROUTINE TO CALL
POP P,H ;GET ADR OF PROCESSING Q HDR
PUSHJ P,FNDREQ ;AND CHECK IT
ADDM S1,KILL.A+3 ;COUNT PROTECTION FAILURES
MOVE T1,KILL.A+2 ;GET NUMBER OF ABORTS SENT
ADDM T1,KILL.A ;ADD TO TOTAL JOBS KILLED
MOVEI T1,KILL.A ;ARGUMENT BLOCK FOR BLDKMS
MOVEI T2,[ASCIZ/ canceled/] ;TEXT TO APPEND
MOVE H,KILL.H ;RESTORE H
PJRST BLDKMS ;BUILD KILL/MODIFY STRING AND RETURN
KILL.A: BLOCK 4 ;ARGUMENT BLOCK FOR BLDKMS
KILL.H: BLOCK 1 ;SAVED QUEUE HEADER
SUBTTL DEFER -- Function 16
;THE DEFER MESSAGE IS SENT TO QUASAR BY ANY UNKNOWN COMPONENT TO
; RELEASE OR KILL DEFERED SPOOL REQUESTS
;
;DEFER PERFORMS THE FOLLOWING FUNCTIONS:
; 1)VALIDATE THE ARGUMENTS
; 2)LOOP THROUGH THE SPOOL QUEUE FINDING ENTRIES FOR THIS JOB
; 3)CALL Q$CREATE FOR MATCHES, SETTING EQ.RDE IF THIS IS A KILL
; 4)RETURN AN ACK IF WANTED SAYING HOW MANY JOBS, FILES WERE
; RELEASED OR KILLED; ALSO HOW MANY "PROTECTION" FAILURES
; I.E. JOB NUMBER MATCHES WITH WRONG DIRECTORY
Q$DEFER:$SAVE <H> ;SAVE H
PUSHJ P,.SAVE4 ;SAVE P1-P4
$COUNT (MDEF) ;NUMBER OF DEFER MESSAGES
LOAD T1,.MSTYP(M),MS.CNT ;GET LENGTH OF MESSAGE
CAIGE T1,DFR.SZ ;IS IT ALL THERE
PJRST E$MTS## ;NOT LONG ENOUGH, GIVE ERROR
ZERO DEFE.A+0 ;CLEAR COUNT OF JOBS AFFECTED
ZERO DEFE.A+1 ;AND OF FILES
ZERO DEFE.A+2 ;NOT CANCELLING JOBS
ZERO DEFE.A+3 ;AND OF PROTECTION FAILURES
MOVEI H,HDRSPL ;POINT TO QUEUE HEADER
LOAD P1,DFR.JB(M),DF.JOB ;GET JOB NUMBER FROM MESSAGE
LOAD P2,.QHLNK(H),QH.PTF ;GET THE FIRST ENTRY IN THE SPOOL QUEUE
LOAD T1,DFR.JB(M),DF.FNC ;GET THE FUNCTION REQUESTED
ZERO P3 ;INDICATE RELEASE (FOR LOOP)
CAIN T1,.DFKIL ;IS IT KILL?
MOVEI P3,1 ;YES, INDICATE FOR LOOP
LOAD P4,DFR.OT(M) ;GET OBJECT TYPE
DEFE.1: JUMPE P2,DEFE.6 ;END OF SPOOL QUEUE, RETURN
LOAD T2,SPLJOB(P2),SPYJOB ;GET THE JOB # FROM THIS QUEUE ENTRY
CAME P4,SPLROB+.ROBTY(P2) ;IS IT THE RIGHT OBJECT TYPE?
JUMPN P4,DEFE.5 ;NO, JUMP IF REQUESTED SPECIFIC QUEUE
CAME T2,P1 ;IS THIS FOR THE RIGHT JOB
JRST DEFE.5 ;WRONG JOB OR WRONG QUEUE
LOAD T1,SPLOID(P2) ;GET OWNER ID OF THIS ENTRY
LOAD T2,G$SID## ;GET SENDER'S ID
CAME T1,T2 ;IS IT THE SAME AS SENDER'S?
JRST DEFE.4 ;NO,PROTECTION FAILURE
AOS DEFE.A+0 ;FOUND A MATCHING JOB, COUNT IT
LOAD S1,SPLJOB(P2),SPYDPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
LOAD T1,.EQSPC(S1),EQ.NUM ;PICK UP THE # OF FILES IN THE REQUEST
ADDM T1,DEFE.A+1 ;COUNT THEM FOR ACK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVX S2,.QIFNC ;LOAD INTERNAL FUNCTION CODE
STORE S2,.MSTYP(S1),MS.TYP ;AND SAVE IN REQUEST
JUMPE P3,DEFE.2 ;KILL ???,,NO THEN CREATE
PUSHJ P,DLFREQ ;CALL DELETE FILES
JRST DEFE.3 ;CONTINUE ON.
DEFE.2: PUSH P,M ;SAVE THE MESSAGE ADDRESS
PUSH P,S1 ;SAVE THE EQ ADDRESS.
MOVE M,S1 ;MAKE M POINT TO THE EQ
PUSHJ P,Q$CREATE ;CREATE THE QUEUE ENTRY.
SKIPE G$ERR## ;WAS THERE AN ERROR ???
$STOP(CRD,CREATE REJECTED DEFER DATA)
POP P,S1 ;RESTORE THE EQ ADDRESS TO S1.
PUSHJ P,M%RPAG ;RELEASE THE EQ.
POP P,M ;RESTORE THE MESSAGE ADDRESS.
DEFE.3: LOAD S1,SPLJOB(P2),SPYDPA ;GET THE POINTER TO THE DISK
PUSHJ P,F$RLRQ## ;RELEASE THE OLD REQUEST
MOVEI H,HDRSPL ;GET THE HEADER OF THE SPOOL QUEUE
MOVE AP,P2 ;GET THE CURRENT ENTRY
LOAD P2,.QELNK(P2),QE.PTN ;STEP TO NEXT ENTRY
PUSHJ P,M$RFRE## ;FREE UP THIS ONE
JRST DEFE.1 ;GO LOOP THROUGH QUEUE
DEFE.4: AOS DEFE.A+3 ;COUNT PROTECTION FAILURES
DEFE.5: LOAD P2,.QELNK(P2),QE.PTN ;STEP TO NEXT ENTRY
JRST DEFE.1 ;AND LOOP ON
DEFE.6: MOVEI T1,DEFE.A ;ARGUMENT BLOCK FOR BLDKMS
MOVEI T2,[ASCIZ/ killed/] ;ASSUME WE KILLED THEM
SKIPN P3 ;DID WE
MOVEI T2,[ASCIZ/ released/] ;NO, SAY RELEASED
PJRST BLDKMS ;SEND ACK IF REQUESTED
DEFE.A: BLOCK 4 ;ARGUMENT BLOCK FOR BLDKMS
SUBTTL HOLD/RELEASE -- Function 25
Q$HOLD: PUSHJ P,A$WHEEL## ;SEE IF CALLER WAS PRIV'ED
JUMPF E$IPE## ;LOSE IF NOT
LOAD S1,HBO.OT(M) ;GET THE OBJECT TYPE
PUSHJ P,A$OB2Q## ;MAKE INTO A QUEUE HEADER
JUMPF E$UQS## ;COULDN'T FIND IT!!
MOVE H,S1 ;PUT QUEUE HEADER IN H
SETO T1, ;MAKE FNDREQ THINK IT IS A MODIFY
MOVEI T2,HBO.RQ(M) ;POINT TO THE RDB TO MATCH
LOAD T3,HBO.OT(M) ;GET THE OBJECT TYPE
MOVEI T4,HOLD.1 ;AND ROUTINE TO CALL
SETZM HOLD.A ;CLEAR THE COUNTER
PUSHJ P,FNDREQ ;GO MATCH REQUESTS
MOVE S1,HOLD.A ;GET # OF JOBS AFFECTED.
MOVE S2,.QHSQN(H) ;GET "QUANTITY" NAME
SKIPN G$ACK ;DOES HE WANT AN ACK?
$RETT ;NO, JUST RETURN
PUSHJ P,TYPPLR ;TYPE '1 JOB' '2 JOBS' ETC.
MOVEI T1,[ASCIZ / held/] ;GET THE ACTION
LOAD S1,HBO.FL(M),HB.FRL ;GET THE RELEASE FLAG
SKIPE S1 ;IS IT ON?
MOVEI T1,[ASCIZ / released/] ;YES
$TEXT(G$CCHR##,<^T/0(T1)/^A>)
SETZ S1, ;CLEAR THE FLAGS
PUSHJ P,G$MSND## ;SEND THE ACK
$RETT ;AND RETURN
;HERE ON CALL FROM FNDREQ - AP POINTS TO THE .QE
HOLD.1: LOAD T1,HBO.FL(M),HB.FRL ;GET RELEASE FLAG
LOAD T2,.QESEQ(AP),QE.HBO ;GET CURRENT STATE OF JOB
XOR T2,T1 ;COMBINE THEM TO SEE IF THIS IS A NOOP
JUMPN T2,.RETT ;JUMP IF IT IS
TXC T1,1 ;FLIP THE BIT
LOAD S1,.QESTN(AP),QE.DPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
STORE T1,.QESEQ(AP),QE.HBO ;STORE IN QE
STORE T1,.EQSEQ(S1),EQ.HBO ;STORE IN EQ
MOVE T1,S1 ;SAVE THE ADDRESS
PUSHJ P,F$WRRQ## ;REWRITE THE REQUEST
LOAD S2,.QESTN(AP),QE.DPA ;GET THE OLD DPA
STORE S1,.QESTN(AP),QE.DPA ;STORE THE NEW ONE
MOVE S1,S2 ;LOAD THE OLD ONE INTO S1
PUSHJ P,F$RLRQ## ;RELEASE THE REQUEST
MOVE S1,T1 ;GET THE PAGE
PUSHJ P,M%RPAG ;RELEASE IT
MOVE S1,AP ;GET THE QE ADDRESS
LOAD S2,HBO.FL(M),HB.FRL ;GET RELEASE FLAG
PUSHJ P,D$HOLD## ;FIX UP MOUNT QUEUES
AOS HOLD.A ;INCREMENT THE COUNT
DOSCHD ;FORCE A SCHEDULE, SOMETHING CHANGED
$RETT ;AND RETURN
HOLD.A: BLOCK 1 ;COUNTER FOR JOBS HELD/RELEASED
SUBTTL SPOOL -- IPCC Function .IPCSU (26)
;THE SPOOL MESSAGE IS SENT TO QUASAR BY THE OPERATING SYSTEM UPON
; THE CLOSE OF A SPOOLED FILE.
;AFTER CONVERTING THE ACTUAL SPOOL MESSAGE FROM [SYSTEM]IPCC INTO THE
; CANONICAL FORM, ALL SPOOLING HANDLERS WILL USE THAT DATA STRUCTURE
Q$SPOOL: PUSHJ P,I$CSM## ;CONVERT TO STANDARD FORMAT
MOVEI T1,(S1) ;USE THAT FROM NOW ON
MOVX T2,CS.DFR ;CHECK FOR DEFERRED MODE SPOOLING
TDNE T2,CSM.JB(T1) ;DID THE USER REQUEST IT
JRST SPOO.1 ;YES, GO ADD TO THE SPL QUEUE
$COUNT (ISPL) ;NUMBER OF IMMEDIATE SPOOLS
PUSHJ P,SPROTO ;BUILD EXTERNAL PROTOTYPE
PUSHJ P,Q$INCL ;INCLUDE THE NEW FILE (ONLY)
PUSH P,AP ;SAVE ADDR OF PROTOTYPE BUILT
MOVE M,AP ;MAKE IT THE MESSAGE
PUSHJ P,Q$CREATE ;CALL THE CREATE PROCESSOR
SKIPE G$ERR## ;WAS THERE AN ERROR?
$STOP(CRS,CREATE REJECTED SPOOLING DATA)
POP P,S1 ;ADDR OF REQUEST
ADR2PG S1 ;MAKE IT A PAGE NUMBER
PJRST M%RELP ;RETURN THROUGH RELEASE PAGE
SPOO.1: $COUNT (DSPL) ;NUMBER OF DEFERED SPOOLS
PUSHJ P,Q$FSPL ;FIND THE MATCHING REQUEST
PUSHJ P,Q$INCL ;INCLUDE THIS FILE
LOAD S1,.MSTYP(AP),MS.CNT ;GET CURRENT REQUEST SIZE
STORE S1,SPLRQZ(E),SPYLEN ;SAVE IN SPOOL QUEUE
MOVE S1,AP ;GET REQUEST ADDRESS
PUSHJ P,F$WRRQ## ;WRITE IT OUT
LOAD S2,SPLJOB(E),SPYDPA ;LOAD THE OLD DPA INTO S2
STORE S1,SPLJOB(E),SPYDPA ;SAVE THE NEW RETRIEVAL POINTER
SKIPE S1,S2 ;GET OLD DPA ( 0 IF INITIAL BUILD)
PUSHJ P,F$RLRQ## ;RELEASE OLD COPY IF THERE IS ONE
MOVE S1,AP ;COPY ADDRESS
PJRST M%RPAG ;RETURN THE PAGE AND EXIT
SUBTTL LOGOUT -- IPCC Function .IPCSL (27)
;THE LOGOUT MESSAGE IS SENT BY THE OPERATING SYSTEM UPON
; EXECUTION OF A LOGOUT UUO OR LGOUT JSYS.
;IF .QIFNC IS SET INDICATING AN INTERNAL CALL, THEN COMING FROM S$RELEASE
; AT THE END OF A BATCH JOB. CL.BQE IN CLM.JB IS THE ADDRESS OF THE
; .QExxx FORM OF THAT BATCH JOB
Q$LOGOUT:
PUSHJ P,.SAVE4 ;SAVE P1-P4
ZERO P4 ;INDICATE NOT A BATCH CALL
LOAD T1,.MSTYP(M),.QIFNC ;GET INTERNAL CALL INDICATOR
SKIPE T1 ;A QUICK CHECK FOR INTERNAL CALL
LOAD P4,CLM.JB(M),CL.BQE ;IS, GET THE BATCH JOB QUEUE ENTRY
MOVEI S1,(M) ;GET ADDRESS OF SYSTEM LOGOUT MESSAGE
JUMPN T1,LOGO.1 ;JUMP IF INTERNAL CALL NOW
PUSHJ P,I$CLM## ;CONVERT TO CANONICAL LOGOUT MESSAGE
LOAD T1,CLM.JB(S1),CL.BAT ;GET THE BATCH JOB BIT
JUMPN T1,.RETT ;IGNORE IT HERE, BATCON WILL RELEASE IT
LOGO.1: LOAD P1,CLM.JB(S1),CL.JOB ;GET THE JOB NUMBER FOR THE LOOP
LOAD P2,<HDRSPL+.QHLNK>,QH.PTF ;GET THE FIRST IN THE SPL QUEUE
JUMPE P4,LOGO.2 ;JUMP IF NOT A BATCH JOB
LOAD S1,.QESTN(P4),QE.DPA ;ELSE GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE INPUT REQUEST
MOVE P4,S1 ;AND STORE ADDRESS IN P4
LOGO.2: JUMPE P2,LOGO.5 ;END OF THE QUEUE, RETURN
LOAD T1,SPLJOB(P2),SPYJOB ;JOB NUMBER OF THIS ENTRY
CAME T1,P1 ;SAME JOB
JRST LOGO.4 ;NO, TRY THE NEXT
LOAD S1,SPLJOB(P2),SPYDPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
JUMPE P4,LOGO.3 ;JUMP IF THIS IS NOT A BATCH JOB
ZERO S2 ;IN CASE WE DON'T FIND A MATCH
LOAD T1,SPLROB+.ROBTY(P2) ;GET OBJECT TYPE
CAIN T1,.OTLPT ;WATCH THIS BRUTE FORCE METHOD
GETLIM S2,.EQLIM(P4),SLPT ;YES, GET SPOOLED LPT LIMIT
CAIN T1,.OTCDP ;LOOKING AT THE PUNCH QUEUE
GETLIM S2,.EQLIM(P4),SCDP ;YES, GET SPOOLED CDP LIMIT
CAIN T1,.OTPTP ;THE PAPER TAPE QUEUE
GETLIM S2,.EQLIM(P4),SPTP ;YES, GET SPOOLED PTP LIMIT
CAIN T1,.OTPLT ;LAST CHANCE, THE PLOTTER
GETLIM S2,.EQLIM(P4),SPLT ;YES, GET SPOOLED PLT LIMIT
SKIPE S2 ;FIND ONE ( OR DON'T LIMIT IT)
STOLIM S2,.EQLIM(S1),OLIM ;STORE SOMETHING AS JOB LIMIT
LOAD T1,.EQJOB(P4) ;GET BATCH JOB NAME
STORE T1,.EQJOB(S1) ;AS OUTPUT NAME
LOAD T1,.EQSEQ(P4),EQ.SEQ ;GET SEQUENCE NUMBER
STORE T1,.EQSEQ(S1),EQ.SEQ ;STORE IT
LOAD T1,.EQSEQ(P4),EQ.PRI ;GET EXT-PRIO FIELD
STORE T1,.EQSEQ(S1),EQ.PRI ;STORE IT
LOAD T1,.EQSEQ(P4),EQ.PRV ;GET THE PRIVS
STORE T1,.EQSEQ(S1),EQ.PRV ;STORE THEM
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
HRLI T1,.EQACT(P4) ;GET THE ORIGIONAL ACCT STRING ADDRESS
HRRI T1,.EQACT(S1) ;GET ITS DESTINATION ADDRESS
BLT T1,.EQACT+7(S1) ;COPY IT OVER !!!
LOAD T1,.EQSPC(P4),EQ.PRO ;GET REQUEST PROTECTION
STORE T1,.EQSPC(S1),EQ.PRO ;STORE IT AWAY
MOVEI T1,EQHSIZ ;GET THE EQ HEADER SIZE
CAXG T1,EQISIZ ;MAKE SURE THERE IS SOMETHING TO MOVE
JRST LOGO.3 ;NO,,THEN JUST CONTINUE ON
MOVSI T1,EQISIZ(P4) ;BEGINING OF OS DEP DATA
HRRI T1,EQISIZ(S1) ;IN BOTH REQUESTS
BLT T1,EQHSIZ-1(S1) ;AND BLT IT
; NOW, CREATE THE REQUEST POINTED TO BY 'S1'
LOGO.3: PUSH P,S1 ;SAVE REQUEST ADDRESS
MOVE M,S1 ;POINT TO IT
MOVX S1,.QIFNC ;LOAD INTERNAL FUNCTION CODE
STORE S1,.MSTYP(M),MS.TYP ;AND SAVE IN THE REQUEST
PUSHJ P,Q$CREATE ;CREATE THE REQUEST
SKIPE G$ERR## ;WAS THERE AN ERROR?
$STOP(CRL,CREATE REJECTED LOGOUT DATA)
POP P,S1 ;ADDR OF REQUEST
PUSHJ P,M%RPAG ;RELEASE IT
LOAD S1,SPLJOB(P2),SPYDPA ;GET THE RETRIEVAL POINTER
PUSHJ P,F$RLRQ## ;AND DELETE THE OLD REQUEST
MOVEI H,HDRSPL ;GET A QUEUE HEADER
MOVE AP,P2 ;CURRENT ENTRY
LOAD P2,.QELNK(P2),QE.PTN ;FIND THE NEXT
PUSHJ P,M$RFRE## ;RETURN SPL QUEUE CELL
JRST LOGO.2 ;GET THE NEXT ENTRY
LOGO.4: LOAD P2,.QELNK(P2),QE.PTN ;FIND THE NEXT
JRST LOGO.2 ;GET THE NEXT ENTRY
;HERE WHEN WE ARE ALL DONE
LOGO.5: SKIPE S1,P4 ;CHECK AND LOAD THE BATCH PAGE ADDRESS
PUSHJ P,M%RPAG ;RETURN THE PAGE IF FROM BATCH
MOVE S1,P1 ;PUT THE JOB NUMBER IN S1
SKIPN REQUEUE ;IF WE ARE NOT REQUEUE'ING,,THEN
PJRST D$LOGOUT## ;RETURN THROUGH THE MDA LOGOUT CODE
$RETT ;IF REQUEUE'ING,,RETURN
SUBTTL Global Subroutines
;ENTRY POINTS
INTERN Q$FSPL ;FIND A MATCHING SPOOLING REQUEST
INTERN Q$INCL ;INCLUDE A FILE INTO A PROTOTYPE AREA
INTERN Q$SUSE ;SEARCH USE QUEUE FOR A GIVEN ITN
INTERN Q$DDEP ;DESTROY JOBS DEPENDENCY LIST
INTERN Q$CDEP ;CHECK THE DEPENDENCY LIST FOR A JOB
INTERN Q$KPRO ;ROUTINE TO KILL A JOB IN THE PROCESSING QUEUE
SUBTTL Q$FSPL -- Find a SPL Queue entry
;Q$FSPL IS CALLED WITH T1 POINTING TO THE CANONICAL SPOOL MESSAGE.
; IT WILL FIND THE APPROPRIATE REQUEST IN THE SPL QUEUE THAT
; CAN ACCEPT ANOTHER FILE (Q$INCL) FOR THE CRITERIA DESCRIBED
; IN THE DEFINITION OF THE CANONICAL SPOOL MESSAGE
;RETURN E = THE SPL QUEUE ENTRY (WILL MAKE ONE IF NONE)
; AP = THE EXTERNAL QUEUE REQUEST READY FOR CREATE CALL
Q$FSPL: PUSHJ P,.SAVE2 ;SAVE A REGISTER
LOAD S2,CSM.OI(T1) ;S2 = THE OWNER ID
LOAD T2,CSM.JB(T1),CS.JOB ;T2 = THE USERS JOB NUMBER
LOAD T4,CSM.FD(T1),CS.FDA ;GET ADDRESS OF THE FD
LOAD T4,.FDLEN(T4),FD.LEN ;AND GET THE FD LENGTH
LOAD E,<HDRSPL+.QHLNK>,QH.PTF ;FIND FIRST IN SPL QUEUE
JUMPE E,FSPL.6 ;EMPTY QUEUE, START IT
FSPL.1: LOAD P1,SPLOID(E) ;GET THE OWNER ID FOR THE REQUEST
CAME S2,P1 ;FOR THE SAME USER
JRST FSPL.5 ;NO, TRY NEXT
LOAD P1,SPLJOB(E),SPYJOB ;GET THE JOB NUMBER
CAME P1,T2 ;FOR THE SAME JOB
JRST FSPL.5 ;NO, TRY NEXT
LOAD P1,SPLRQZ(E),SPYLEN ;GET CURRENT SIZE
ADDI P1,FPMSIZ(T4) ;SIZE OF FILE TO BE INCLUDED
CAILE P1,1000 ;REQUEST BECOME TOO BIG
JRST FSPL.5 ;YES, LOOK FOR ANOTHER
LOAD P1,CSM.AF(T1) ;GET AFTER PARAMETER FROM CSM
CAME P1,SPLAFT(E) ;SAME AS THIS SPL ENTRY?
JRST FSPL.5 ;NO, LOSE
LOAD P1,CSM.FM(T1) ;GET FORMS TYPE FROM CSM
CAME P1,SPLFRM(E) ;SAME AS THIS SPL ENTRY?
JRST FSPL.5 ;NO, TRY ANOTHER
DMOVE P1,CSM.NT(T1) ;GET THE TWO NOTE WORDS
CAMN P1,SPLNOT(E) ;IS THE FIRST WORD THE SAME?
CAME P1,SPLNOT+1(E) ;YES, THE SECOND?
JRST FSPL.5 ;LOSE ON ONE OF THEM
LOAD P1,CSM.RO+.ROBTY(T1) ;GET OBJECT TYPE
CAME P1,SPLROB+.ROBTY(E) ;IS IT THE SAME?
JRST FSPL.5 ;NO, TRY AGAIN
LOAD P1,CSM.RO+.ROBND(T1) ;GET THE NODE
CAME P1,SPLROB+.ROBND(E) ;IS IT THE SAME
JRST FSPL.5 ;NO, LOSE
LOAD P1,CSM.RO+.ROBAT(T1) ;GET DEC ATTRIBUTES (OR UNIT #)
LOAD P2,CSM.RO+.ROBUA(T1) ;GET CUST. ATTRIBUTES
SKIPN P1 ;IF BOTH ARE = 0,
JUMPE P2,FSPL.4 ; GENERIC REQUEST MATCHES ANYTHING
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SKIPN SPLROB+.ROBAT(E) ;SEE IF SPL ENTRY IS GENERIC
SKIPE SPLROB+.ROBUA(E) ; IF BOTH ARE 0
JRST FSPL.2 ;NOT GENERIC, DO THE COMPARE
MOVEM P1,SPLROB+.ROBAT(E) ;STORE NEW VALUES
MOVEM P2,SPLROB+.ROBUA(E) ; " " "
JRST FSPL.4 ;AND CONTINUE ON
FSPL.2: CAMN P1,SPLROB+.ROBAT(E) ;DO ATTRIBUTES MATCH?
CAME P2,SPLROB+.ROBUA(E) ; AND CUSTOMER DEFINED ONES?
JRST FSPL.5 ;NO, LOSE
FSPL.4: LOAD S1,SPLJOB(E),SPYDPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
MOVE AP,S1 ;SAVE ADR IN AP
MOVSI S1,SPLROB(E) ;POINT TO ROB IN SPL QUEUE
HRRI S1,.EQROB(AP) ;POINT TO ROB IN THE EQ
BLT S1,.EQROB+ROBSIZ-1(AP) ;AND MOVE IT
$RETT ;AND RETURN
FSPL.5: LOAD E,.QELNK(E),QE.PTN ;FIND THE NEXT
JUMPN E,FSPL.1 ;LOOK AT IT IF THERE
FSPL.6: MOVEI H,HDRSPL ;GET A QUEUE HEADER
PUSHJ P,M$GFRE## ;GET A CELL
MOVE E,AP ;WANT IT IN E
PUSHJ P,M$ELNK## ;LINK IT IN AT THE END
MOVSI S1,CSM.RO(T1) ;POINT TO THE ROB IN THE CSM
HRRI S1,SPLROB(E) ;AND TO THE NEW SPL ENTRY
BLT S1,SPLROB+ROBSIZ-1(E) ;AND MOVE IT
LOAD S1,CSM.OI(T1) ;GET THE USERS ID
STORE S1,SPLOID(E) ;STORE THAT TOO
LOAD S1,CSM.JB(T1),CS.JOB ;GET THE JOB NUMBER
STORE S1,SPLJOB(E),SPYJOB ;SAVE THAT TOO
ZERO SPLJOB(E),SPYDPA ;NOT FAILSOFT YET
MOVEI S1,EQHSIZ ;ALL REQUEST START AT THIS SIZE
STORE S1,SPLRQZ(E),SPYLEN ;STORE THE INITIAL LENGTH
PJRST SPROTO ;BUILD THE PROTOTYPE AND RETURN
SUBTTL Q$INCL -- Append a File to a Request
;Q$INCL IS CALLED WITH:
; AP = THE CURRENT SPOOL REQUEST
; T1 = THE CANONICAL SPOOL MESSAGE FOR THE NEW FILE
;RETURNS WITH THE NEW FILE INCLUDED IN THE REQUEST AP
Q$INCL: PUSHJ P,.SAVE1 ;GET A WORK REGISTER
MOVE S2,CSM.FP(T1) ;GET THE FLAG SETTINGS
MOVEI S1,1 ;GET A BIT
TXNE S2,FP.SPL ;IS IT A SPOOLED FILE?
STORE S1,.EQSEQ(AP),EQ.SPL ;YES, SET SPOOLING REQUEST FLAG
LOAD P1,.MSTYP(AP),MS.CNT ;GET LENGTH OF CURRENT MESSAGE
MOVE S2,P1 ;MAKE A COPY
LOAD S1,CSM.FD(T1),CS.FDA ;S1 = ADDRESS OF FD FOR FILE
LOAD S1,.FDLEN(S1),FD.LEN ;S1 = LENGTH OF THE FD
ADDI P1,FPMSIZ(S1) ;P1 = LENGTH OF NEW REQUEST
STORE P1,.MSTYP(AP),MS.CNT ;INCLUDE LENGTH FOR THIS FILE
ADD S2,AP ;AP + OLD LEN = NEXT FILE POINTER
MOVEI P1,FPMSIZ ;LENGTH OF DEFAULT FP AREA
STORE P1,.FPLEN(S2),FP.LEN ;STORE THAT AS WELL
MOVE P1,CSM.FP(T1) ;GET FLAGS REQUESTED BY THE CALLER
STORE P1,.FPINF(S2) ;AS FILE INFORMATION
MOVEI P1,1 ;START AT LINE 1
STORE P1,.FPFST(S2) ;STORE STARTING POINT
ZERO .FPFR1(S2) ;/REPORT WORD 1
ZERO .FPFR2(S2) ; AND WORD 2
MOVEI S2,FPMSIZ(S2) ;BUMP TO FD AREA
LOAD P1,CSM.FD(T1),CS.FDA ;POINT TO THE FD TO INCLUDE
HRLS P1 ;SET UP FOR BLT
HRRI P1,(S2) ;DESTINATION
ADDI S2,(S1) ;COMPUTE THE LAST LOCATION (S1 FROM ABOVE)
BLT P1,-1(S2) ;MOVE THE NEW FILE SPEC INTO THE REQUEST
INCR .EQSPC(AP),EQ.NUM ;BUMP NUMBER OF FILES IN REQUEST
LOAD S1,CSM.FS(T1) ;GET THE NUMBER OF BLOCKS IN THE FILE
GETLIM S2,.EQLIM(AP),NBLK ;GET BLOCKS IN REQUEST
ADD S1,S2 ;INCLUDE THE NEW FILE
STOLIM S1,.EQLIM(AP),NBLK ;UPDATE COUNTERS
SKIPE .EQJOB(AP) ;ANY JOB NAME YET
$RETT ;YES, RETURN NOW
LOAD S1,CSM.EN(T1) ;GET THE 'ENTERED' NAME
STORE S1,.EQJOB(AP) ;MAKE THAT THE REQUEST NAME
$RETT ;AND RETURN
SUBTTL Q$SUSE -- Search USE for an ITN
;Call: S1/ ITN
;
;T Return S1/ address of .QE
;
;F Return ITN not found
Q$SUSE: MOVE S2,S1 ;COPY ARGUMENT TO S2
LOAD S1,HDRUSE+.QHLNK,QH.PTF ;POINT TO FIRST USE ITEM
SUSE.1: JUMPE S1,.RETF ;NO MORE THERE, LOSE
CAMN S2,.QEITN(S1) ;DOES THIS MATCH?
$RETT ;YES, RETURN
LOAD S1,.QELNK(S1),QE.PTN ;POINT TO THE NEXT
JRST SUSE.1 ;AND LOOP
SUBTTL Q$ADEP -- Add a dependency to a jobs dependency list
SUBTTL Q$DDEP -- Destroy a jobs dependency list
;Q$DDEP is called to destroy the dependency list for a job. This
; will include any cleanup that is necessary for each
; dependency.
;Call: AP/ the address of the QE
;
;T Ret: always
Q$DDEP: LOAD S1,.QEDIN(AP),QE.DLN ;GET THE LIST NUMBER
PJRST L%DLST ;AND DESTROY IT
SUBTTL Q$CDEP -- Check a jobs dependency list
;Q$CDEP is called to determine whether or not all of a job's dependencies
; have been satisfied.
;Call: AP/ address of the job's QE
;
;T Ret: if all dependencies have been satisfied
;
;F Ret: if there are any unsatisfied dependencies
Q$CDEP: PUSHJ P,.SAVE1 ;SAVE P1
LOAD S1,.QEDIN(AP),QE.DLN ;GET LIST NUMBER
MOVE P1,S1 ;AND SAVE IT IN P1
PUSHJ P,L%FIRST ;AND POSITION TO THE FIRST
JUMPF .RETT ;NO DEPENDENCIES, ALL IS WELL
JRST CDEP.2 ;SKIP INTO THE LOOP
CDEP.1: MOVE S1,P1 ;GET THE LIST NUMBER
PUSHJ P,L%NEXT ;POSITION TO THE NEXT ONE
JUMPF .RETT ;NO MORE, JUST RETURN
CDEP.2: LOAD S1,.DIBDS(S2),DI.TYP ;GET DEPENDENCY TYPE
CAIE S1,.DTSTR ;IS IT A STRUCTURE?
JRST CDEP.1 ;NO, ON TO THE NEXT ONE
MOVE S1,.DIBDT(S2) ;YES, GET STR ADDRESS
PUSHJ P,D$CSTR## ;CHECK IT OUT
JUMPT CDEP.1 ;KEEP LOOPING IF ON-LINE
$RETF ;AND FAIL
SUBTTL Subroutines to maintain DELETE list
;The following subroutines are used to maintain a list of files (primarily
; spooled files) which must be deleted by QUASAR.
INTERN Q$DLFL ;DELETE A FILE
INTERN Q$DLFR ;REBUILD DELETE LIST ENTRY POINT
; DLFREQ ;ADD ALL SPOOLED FILES FROM EQ
;The entries in this DELETE list have the following format:
; !=======================================================!
; ! Address of in-core copy of request !
; !-------------------------------------------------------!
; ! DPA of on-disk copy of request !
; !-------------------------------------------------------!
; ! Number of files in request (decremented) !
; !-------------------------------------------------------!
; ! Offset of next FP !
; !-------------------------------------------------------!
; ! File-structure containing next file to delete !
; !-------------------------------------------------------!
; ! Spooled CDR unique filename handle !
; !=======================================================!
DLF.AD==0 ;ADR OF IN-CORE COPY (0 IF ON-DISK ONLY)
DLF.DP==1 ;DPA OF ON-DISK COPY
DLF.NF==2 ;NUMBER OF FILES IN REQUEST
DLF.FP==3 ;OFFSET OF NEXT FP TO DELETE
DLF.ST==4 ;FILE STRUCTURE OF REQUEST (STR ADDRESS)
DLF.CD==5 ;SPOOLED CDR UNIQUE FILENAME HANDLE
DLF.SZ==6 ;SIZE OF DLF LIST ENTRY
MAXDEL==5 ;MAX NUMBER OF DELETE REQUESTS TO
; KEEP IN CORE
SUBTTL Q$DLFL -- Delete a spooled file
;Q$DLFL is called to delete one file from the list of requests which
; require deleting spooled files.
;
;Call: no arguments
;
;T Ret: a request was found
;
;F Ret: no request was found
Q$DLFL: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,DELLST ;GET LIST NUMBER OF DELETE LIST
PUSHJ P,L%FIRST ;GET TO FIRST ENTRY
JUMPF .RETF ;NOTHING TO DELETE, RETURN
;**;[1212]MOVE LABEL AT Q$DLFL:+4L 29-MAY-84/CTK
DLFL.1: MOVE P1,S2 ;[1212]SAVE ADDRESS IN P1
MOVE S1,DLF.ST(P1) ;[1212]GET THE STRUCTURE
JUMPN S1,DLF.1A ;JUMP IF THERE IS ONE
MOVE S1,DLF.AD(P1) ;[1222]GET THE ADDRESS OF THE PAGE (EQ)
JUMPN S1,DLF.1B ;[1222]JUMP IF IT IS IN CORE
MOVE S1,DLF.DP(P1) ;[1222]GET THE DPA
PUSHJ P,F$RDRQ## ;[1222]AND READ THE REQUEST
MOVEM S1,DLF.AD(P1) ;[1222]SAVE THE ADDRESS
AOS DELNUM ;[1222]INCREMENT THE IN-CORE COUNT
DLF.1B: PUSHJ P,DLFSTR ;[1222]EXTRACT THE STRUCTURE
JUMPF DLFL.4 ;IF BAD, ON TO NEXT FILE
MOVEM S1,DLF.ST(P1) ;ELSE, SAVE STR ADDRESS
DLF.1A: PUSHJ P,D$CSTR## ;VERIFY ON-LINENESS
JUMPT DLFL.2 ;JUMP IF OK
MOVE S1,DLF.AD(P1) ;[1222]GET THE ADDRESS OF THE PAGE (EQ)
JUMPE S1,DLF.1C ;[1222]JUMP IF IT IS NOT IN CORE
SETZM DLF.AD(P1) ;[1222]IT IS NO LONGER IN CORE
PUSHJ P,M%RPAG ;[1222]RETURN THE PAGE
SOS DELNUM ;[1222]DECREMENT THE IN-CORE COUNT
DLF.1C: MOVE S1,DELLST ;[1222]GET LIST NUMBER
PUSHJ P,L%NEXT ;ON TO NEXT ENTRY
JUMPF .RETF ;RETURN IF DONE
JRST DLFL.1 ;ELSE LOOP
DLFL.2: MOVX S1,FOB.SZ ;GET FOB SIZE
MOVEI S2,DLFL.A ;AND FOB ADDRESS
PUSHJ P,.ZCHNK ;ZERO IT OUT
MOVE S1,DLF.AD(P1) ;GET THE ADDRESS OF THE PAGE (EQ)
JUMPN S1,DLFL.3 ;JUMP IF IT IS IN CORE
MOVE S1,DLF.DP(P1) ;GET THE DPA
PUSHJ P,F$RDRQ## ;AND READ THE REQUEST
MOVEM S1,DLF.AD(P1) ;SAVE THE ADDRESS
AOS DELNUM ;INCREMENT THE IN-CORE COUNT
DLFL.3: ADD S1,DLF.FP(P1) ;GET ADDRESS OF THE NEXT FP
LOAD S2,.FPINF(S1),FP.SPL ;GET THE SPOOLED FILE BIT
JUMPE S2,DLFL.4 ;JUMP IF NOT SPOOLED
LOAD S2,.FPLEN(S1),FP.LEN ;GET FP LENGTH
ADD S2,S1 ;POINT TO THE FD
MOVEM S2,DLFL.A+FOB.FD ;STORE IN THE FOB
MOVX S1,FOB.SZ ;LOAD THE FOB SIZE
MOVEI S2,DLFL.A ;AND THE FOB ADDRESS
PUSHJ P,F%DEL ;DELETE THE FILE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
DLFL.4: SOSG DLF.NF(P1) ;DECREMENT FILE COUNT
JRST DLFL.5 ;DONE WITH THIS REQUEST, DELETE IT
MOVE S1,DLF.FP(P1) ;GET CURRENT FP OFFSET
ADD S1,DLF.AD(P1) ;ADD BASE TO GET ADDRESS
LOAD S2,.FPLEN(S1),FP.LEN ;GET FP LENGTH
ADDM S2,DLF.FP(P1) ;BUMP THE ENTRY
ADD S1,S2 ;AND POINT TO THE FD
LOAD S2,.FDLEN(S1),FD.LEN ;GET THE FD LENGTH
ADDM S2,DLF.FP(P1) ;AND GET OFFSET OF NEXT FP
PUSHJ P,DLFSTR ;EXTRACT THE STR
JUMPF DLFL.4 ;ON TO NEXT FILE IF STR IS BAD
$RETT ;ELSE, JUST RETURN
DLFL.5: SKIPN S2,DLF.CD(P1) ;GET SPOOLED FILENAME HANDLE
JRST DLFL.6 ;THERE ISN'T ONE
MOVE S1,DLF.AD(P1) ;GET EQ ADDRESS
MOVE S1,.EQOID(S1) ;GET DIRECTORY NUMBER
PUSHJ P,I$DCDR## ;DELETE SPOOLED CDR FILES
DLFL.6: MOVE S1,DLF.AD(P1) ;GET THE PAGE ADDRESS
PUSHJ P,M%RPAG ;AND RELEASE IT
SOS DELNUM ;DECREMENT THE COUNT
MOVE S1,DLF.DP(P1) ;GET THE DPA
PUSHJ P,F$RLRQ## ;RELEASE THE REQUEST
MOVE S1,DELLST ;GET LIST NUMBER
PUSHJ P,L%DENT ;DELETE THE CURRENT ENTRY
$RETT ;AND RETURN
DLFL.A: BLOCK FOB.SZ ;A FOB
SUBTTL Q$DLFR -- Rebuild an entry in the DELETE list
;Q$DLFR is the rebuild routine for the failsoft initialization code on
; entries with rebuild code %RBDEL.
;
;Call: S1/ the EQ address
; S2/ the DPA
Q$DLFR: PUSHJ P,.SAVE2 ;SAVE P1-P2
DMOVE P1,S1 ;SAVE ARGS IN P1, P2
PUSHJ P,M%GPAG ;GET A PAGE
EXCH S1,P1 ;SAVE IT AS THE ARGUMENT
HRLS S1 ;GET SOURCE,,0
HRR S1,P1 ;GET SOURCE,,DEST
BLT S1,PAGSIZ-1(P1) ;AND MOVE THE DATA SINCE THE
; ARGUMENT PAGE IS RETURNED
JRST DLFR.1 ;AND HANDLE THE REST SORT OF NORMALLY
SUBTTL DLFREQ -- Add an EQ to the DELETE list
;DLFREQ is called to place an EQ into the list of requests for file
; deletion.
;
;Call: S1/ address of the EQ
DLFREQ: PUSHJ P,.SAVE2 ;SAVE P1 - P2
MOVE P1,S1 ;SAVE THE ADDRESS
SETZ P2, ;NO DPA HERE
DLFR.1: MOVE S1,DELLST ;GET LIST NUMBER
PUSHJ P,L%LAST ;POSITION TO THE END
MOVEI S2,DLF.SZ ;GET ENTRY SIZE
MOVE S1,DELLST ;GET THE LIST NUMBER
PUSHJ P,L%CENT ;CREATE THE ENTRY
SKIPT ;Did we get an entry successfully?
$STOP (CCE,<Cannot create linked list entry>)
MOVEM P1,DLF.AD(S2) ;SAVE THE EQ ADDRESS
LOAD S1,.MSTYP(P1),MS.CNT ;GET THE EQ LENGTH
HRLZS S1 ;GET LEN,,0
HRR S1,P1 ;GET LEN,,ADR
MOVE P1,S2 ;SAVE ADDRESS OF THE ENTRY
MOVX S2,%RBDEL ;GET REBUILD CODE
JUMPN P2,DLFR.2 ;JUMP IF WE HAVE A DPA
PUSHJ P,F$FSRQ## ;FAILSOFT THE REQUEST
MOVE P2,S1 ;GET THE DPA IN P2
DLFR.2: MOVEM P2,DLF.DP(P1) ;SAVE THE DPA
LOAD S1,DLF.AD(P1) ;GET THE EQ ADDRESS
LOAD S2,.EQSPC(S1),EQ.NUM ;GET THE NUMBER OF FILES
MOVEM S2,DLF.NF(P1) ;STORE IT
LOAD S2,.EQLEN(S1),EQ.LOH ;GET LENGTH OF HEADER
MOVEM S2,DLF.FP(P1) ;STORE OFFSET OF FIRST FP
SETZM DLF.ST(P1) ;[1222]CLEAR THE STR WORD
PUSHJ P,I$GCDR## ;GET SPOOLED CDR FILENAME HANDLE IF ANY
MOVEM S1,DLF.CD(P1) ;STORE IT
AOS S1,DELNUM ;INCREMENT THE COUNT
CAIG S1,MAXDEL ;TOO MANY?
$RETT ;NO, JUST RETURN
SETZ S1, ;CLEAR A AC
EXCH S1,DLF.AD(P1) ;LOAD ADDRESS AND CLEAR STORAGE
SOS DELNUM ;DECREMENT IN-CORE COUNT
PJRST M%RPAG ;GIVE UP THE PAGE AND RETURN
;HERE TO EXTRACT THE STRUCTURE FROM THE 'CURRENT' FILE [DLF.FP(P1)] AND
; STORE IT IN DLF.ST(P1). RETURNS FALSE IF STR NAME IS BAD.
DLFSTR: MOVE S1,DLF.FP(P1) ;GET OFFSET OF THE FP
ADD S1,DLF.AD(P1) ;AND GET THE ADDRESS
LOAD S2,.FPLEN(S1),FP.LEN ;GET FP LENGTH
ADD S1,S2 ;AND POINT TO FIRST FD
PUSHJ P,D$ESTR## ;EXTRACT THE STRUCTURE
JUMPF .RETF ;FAIL???
MOVEM S1,DLF.ST(P1) ;STORE IT
$RETT ;AND RETURN
SUBTTL Q$NOTIFY - ROUTINE TO VALIDATE A /NOTIFY REQUEST
;CALL: S1/ The Notify Type (%NOTTY, %NOTML, %NOTJB)
;
;RET: TRUE ALWAYS
Q$NOTIFY: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;SAVE THE NOTIFY CODE
PUSHJ P,NOTBIN ;CARD-READER-INTERPRETER NOTIFY?
JUMPT NOTI.2 ;YES - GO PLUG IN SOME GOOD NUMBERS
LOAD S1,G$PRVS##,MR.JOB ;GET THE SENDERS JOB NUMBER
TXZ S1,BA%JOB ;DON'T CARE ABOUT THIS BIT
LOAD S2,HDRUSE+.QHLNK,QH.PTF ;GET THE FIRST ENTRY IN THE USE QUEUE
NOTI.1: JUMPE S2,NOTI.3 ;NO MORE,,SET UP NORMAL NOTIFY
LOAD T1,.QEJBN(S2),QE.BJN ;GET THE BATCH JOB NBR (IF THERE IS ONE)
CAMN S1,T1 ;DOES SNDRS # = QUEUE # ???
JRST NOTI.2 ;YES,,MUST BE REQUEST FROM A BATCH JOB
LOAD S2,.QELNK(S2),QE.PTN ;NO,,GET THE NEXT USE QUEUE ENTRY
JRST NOTI.1 ;AND GO CHECK IT OUT
NOTI.2: LOAD S1,.QEJBN(S2),QE.UJN ;GET THE ORIGIONAL JOB NUMBER
MOVEM S1,.QEJBN(AP) ;SAVE IT
MOVE S1,.QENID(S2) ;GET THE ORIGIONAL NOTIFY ID
MOVEM S1,.QENID(AP) ;SAVE IT
LOAD S1,.QESEQ(S2),QE.NOT ;GET THE ORIGIONAL NOTIFY TYPE
STORE S1,.QESEQ(AP),QE.NOT ;SAVE IT
$RETT ;AND RETURN
NOTI.3: STORE S1,.QEJBN(AP) ;NOT FROM BATCH,,SAVE THE USERS JOB #
CAXN P1,%NOTJB ;IS THIS A NOTIFY JOB REQUEST ???
MOVE S2,G$SND## ;YES,,GET HIS PID
CAXN P1,%NOTML ;DO WE WANT TO NOTIFY VIA MAIL ???
MOVX P1,%NOTTY ;YES,,TO BAD ITS NOT SUPPORTED !!!
CAXE P1,%NOTTY ;DO WE WANT TO NOTIFY HIS TERMINAL ???
JRST NOTI.4 ;NO,,CONTINUE ON
MOVX S2,JI.JLT ;GET 'LOGIN-TIME' FUNCTION CODE
PUSHJ P,I%JINF ;GET THE JOBS LOGIN TIME
JUMPF NOTI.5 ;IF AN ERROR,,RESET /NOTIFY VALUES
NOTI.4: STORE S2,.QENID(AP) ;ELSE SAVE THE JOBS LOGIN TIME
MOVX S2,JI.USR ;MAKE ONE LAST CHECK...
PUSHJ P,I%JINF ;GET THE USER NUMBER
JUMPF NOTI.5 ;NOT THERE,,RESET /NOTIFY VALUES
CAMN S2,G$SID## ;JOBS USER MUST = SENDERS ID.
$RETT ;IT DOES,,SO RETURN
NOTI.5: ZERO .QESEQ(AP),QE.NOT ;CLEAR THE NOTIFY BITS
SETZM .QEJBN(AP) ;ZAP THE JOB NUMBER
SETZM .QENID(AP) ;AND THE NOTIFY ID
$RETT ;AND RETURN
; Here to check for SPRINT submitting a batch job. We want to notify
; the original submitter of the job SPRINT is currently processing.
; This routine KNOWS that there can only be one card-reader-interpreter
; job running at a time.
; Call: PUSHJ P,NOTBIN
;
; TRUE return: S2:= originating QE address
; FALSE return: cannot determine original EQ
;
NOTBIN: MOVEI S1,.QEROB(AP) ;GET REQUEST OBJECT BLOCK ADDRESS
MOVE S2,.ROBTY(S1) ;GET OBJECT TYPE WORD
CAIE S2,.OTBAT ;BATCH JOB BEING SUBMITTED?
$RETF ;NOPE
MOVE S1,G$SND## ;GET PID OF CURRENT SENDER
$SAVE <H> ;SAVE FROM DESTRUCTION
PUSHJ P,A$FPSB## ;SEARCH FOR THE PID IN THE PSB CHAIN
JUMPF .RETF ;NOT FROM A KNOWN COMPONENT
LOAD S2,PSBLIM(S1),PSLCUR ;GET NUMBER OF CURRENT JOBS FOR SPOOLER
JUMPE S2,.RETF ;SANITY CHECK SAYS SHOULD BE AT LEAST 1
LOAD S2,PSBFLG(S1),PSFNOT ;GET NUMBER OF OBJECT TYPES
MOVNS S2 ;NEGATE THE COUNT
HRLI S2,PSBOBJ(S1) ;GET ADDRESS OF OBJECT BLOCKS
MOVSS S2 ;MAKE AN AOBJN POINTER
NOTB.2: HRRZ S1,(S2) ;GET AN OBJECT TYPE
CAIE S1,.OTBIN ;CARD-READER-INTERPRETER?
AOBJN S2,NOTB.2 ;NOPE
JUMPGE S2,.RETF ;CHECKED ALL OBJECT TYPES?
LOAD S2,HDRUSE+.QHLNK,QH.PTF ;POINT TO FIRST ENTRY IN THE USER QUEUE
SKIPA ;SKIP FIRST TIME THROUGH
NOTB.3: LOAD S2,.QELNK(S2),QE.PTN ;GET NEXT ENTRY ADDRESS
JUMPE S2,.RETF ;CHECK FOR ENF OF QUEUE
MOVE S1,.QEOBJ(S2) ;GET OBJECT BLOCK ADDRESS
MOVE S1,OBJTYP(S1) ;GET OBJECT TYPE
CAIE S1,.OTBIN ;FOUND SPRINT YET?
JRST NOTB.3 ;TRY ANOTHER QUEUE ENTRY
$RETT ;RETURN WITH S2:= QE ADDRESS
SUBTTL Q$KPRO - ROUTINE TO TAKE A REQUEST OUT OF A PROCESSING QUEUE
;CALL: AP/Request Address
; H/ Queue Header Address
;
;RET: True Always
Q$KPRO: AOS KILL.A+0 ;INCREMENT KILLED COUNT
LOAD T1,.QESEQ(AP),QE.SPL ;GET SPOOLED BIT
JUMPE T1,KILP.2 ;JUMP IF NO SPOOLED FILES IN REQUEST
MOVX S1,FOB.SZ ;LOAD SIZE OF A FOB
MOVEI S2,KILFOB ;AND ADDRESS
PUSHJ P,.ZCHNK ;AND ZERO THE FOB FOR LATER
LOAD S1,.QESTN(AP),QE.DPA ;LOAD THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
MOVE T2,S1 ;SAVE THE ADDRESS
LOAD S2,.EQSPC(S1),EQ.NUM ;GET NUMBER OF FILES
CAIE S2,1 ;ONLY ONE FILE?
JRST KILP.1 ;MORE THAN 1 OR SPOOLED CDR FILES
LOAD S2,.EQLEN(S1),EQ.LOH ;GET LENGTH OF HEADER
ADD S1,S2 ;POINT TO FIRST FP
LOAD S2,.FPINF(S1),FP.SPL ;GET THE SPOOLED BIT
JUMPE S2,KILP.2 ;NOT SPOOLED, JUST KILL REQUEST
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADD S1,S2 ;POINT TO THE FD
MOVEM S1,KILFOB+FOB.FD ;STORE FD ADR IN THE FOB
MOVX S1,FOB.SZ ;LOAD THE FOB SIZE
MOVEI S2,KILFOB ;AND THE FOB ADDRESS
PUSHJ P,F%DEL ;DELETE THE FILE
MOVE S1,T2 ;GET THE ADDRESS
PUSHJ P,M%RPAG ;RELEASE THE PAGE
JRST KILP.2 ;AND FINISH UP
KILP.1: MOVE S1,T2 ;GET THE EQ ADDRESS
PUSHJ P,DLFREQ ;GO ADD TO LIST OF FILES TO DELETE
KILP.2: PUSHJ P,Q$DDEP ;DELETE THE DEPENDENCY LIST
PUSHJ P,Q$EVTK ;DO SPECIAL EVENT QUEUE KILL PROCESSING
MOVE S1,AP ;GET THE QE ADDRESS IN S1
PUSHJ P,D$PPRL## ;DELETE THE MDR FOR THIS REQUEST
LOAD S1,.QESTN(AP),QE.DPA ;GET THE DPA
SKIPE S1 ;HAVE A DPA?
PUSHJ P,F$RLRQ## ;YES--RELEASE IT
PUSHJ P,M$RFRE## ;RELEASE THE REQUEST
$RETT ;AND RETURN
KILFOB: BLOCK FOB.SZ ;A FOB FOR F%DEL
SUBTTL Subroutines
; VALMSG VALIDATE MESSAGES FROM KNOWN COMPONENTS
; FNDREQ UTILITY FOR KILL/MODIFY TO FIND ALL MATCHES IN A QUEUE
; SPROTO BUILD SPOOL TO QUEUE PROTOTYPE
; MAJMOD PERFORM MODIFY ON GLOBAL QUEUE PARAMETERS
; BLDKMS BUILD THE KILL/MODIFY/DEFER ACKNOWLEDGEMENT STRING
; TYPPLR ROUTINE TO PLURALIZE A MESSAGE
; NOTIFY ;ROUTINE TO SEND A NOTIFY MESSAGE TO ORION
SUBTTL VALMSG -- Routine to validate message from known component
;VALMSG IS CALLED WITH THE MINIMUM SIZE OF THE MESSAGE IN T1. IF
; THE MESSAGE IS INVALID, EXIT THROUGH QSR??% TO SET GLOBAL ERROR
; CALLER MUST CHECK G$ERR TO DETERMINE IF OK TO PROCEED
;
;ON SUCCESS, LOCATION THSPSB IS FILLED WITH THE ADDRESS OF THE PSB
; FOR THE SENDER
VALMSG: LOAD T2,.MSTYP(M),MS.CNT ;GET SIZE OF MESSAGE
CAMGE T2,T1 ;GREATER OR EQUAL?
PJRST E$MTS## ;INDICATE MESSAGE TOO SHORT
MOVE S1,G$SND## ;GET PID OF CURRENT SENDER
PUSHJ P,A$FPSB## ;FIND HIS PSB
JUMPE S1,E$NKC## ;INDICATE NO PSB
MOVEM S1,THSPSB ;SAVE THE PSB
$RETT ;AND RETURN
SUBTTL KILUSE - ROUTINE TO ABORT A JOB IN THE USE QUEUE
;CALL: AP/Queue Entry Address
;
;RET: True Always
KILUSE: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,.SAVET ;SAVE ALL T AC'S
MOVEI T3,G$MSG## ;LOAD ADR OF THE MESSAGE
LOAD T4,.QEOBJ(AP) ;GET OBJECT ADDRESS
LOAD S1,OBJPID(T4) ;GET PROCESSORS PID
MOVEM S1,G$SAB##+SAB.PD ;STORE AS RECIEVERS PID
MOVX S1,ABO.SZ ;GET THE MESSAGE LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
MOVEM T3,G$SAB##+SAB.MS ;SAVE THE MSG ADDRESS IN THE SAB
MOVEI S1,OBJTYP(T4) ;POINT TO OBJECT TYPE
MOVEI S2,ABO.TY(T3) ;POINT TO MOVE OBJECT BLOCK TO
PUSHJ P,A$CPOB## ;COPY IT
MOVE T4,[ABO.SZ,,.QOABO] ;LOAD THE MESSAGE HDR
STORE T4,.MSTYP(T3) ;AND STORE IT
LOAD P1,.QEITN(AP) ;GET THE ITN
STORE P1,ABO.IT(T3) ;STORE IN ABORT MESSAGE
MOVX T4,ABOUSR ;"ABORTED BY USER"
STORE T4,ABO.CD(T3) ;STORE THE CODE
LOAD T4,G$SID## ;GET ID OF SENDER
STORE T4,ABO.ID(T3) ;AND STORE IN THE MESSAGE
PUSHJ P,C$SEND## ;SEND THE MESSAGE
MOVE S1,P1 ;GET THE ITN
PUSHJ P,Q$SUSE ;SEE IF STILL IN THE USE QUEUE
JUMPF .RETT ;NO, WE DID NOT ABORT IT
MOVX S2,QE.RDE ;GET THE RDE BIT
IORM S2,.QESEQ(S1) ;AND SET IT
AOS KILL.A+2 ;INCREMENT ABORTED COUNT
$RETT ;AND RETURN
SUBTTL FNDREQ -- Utility for KILL/MODIFY to find all matches
;FNDREQ IS CALLED WITH THE FOLLOWING ARGUMENTS
; H = THE QUEUE TO SEARCH
; T1 = CODE (0 = KILL, -1 = MODIFY)
; T2 = ADDRESS OF AN RDB TO MATCH AGAINST
; T3 = OBJECT TYPE
; T4 = SUBROUTINE TO CALL UPON FINDING A MATCH
;USES AP TO TRAVERSE THE QUEUE
;THE SUBROUTINE WHICH IS CALLED UPON FINDING A MATCHING REQUEST (@T4)
; IS CALLED WITH THE ADDRESS OF THE REQUEST IN "AP", AND "H"
; SETUP. IT MAY USE T1-T4,AP, AND H.
;
;RETURNS NUMBER OF PROTECTION FAILURES IN S1
FNDREQ: SETZB S1,FNDR.E ;CLEAR THE # PROT FAILS
LOAD AP,.QHLNK(H),QH.PTF ;GET FIRST IN QUEUE
JUMPE AP,.RETT ;DON'T BOTHER IF EMPTY
PUSHJ P,.SAVE1 ;NEED ANOTHER REG
MOVEM T1,FNDR.A ;SAVE THE ORIGINAL ARGUMENTS
MOVEM T2,FNDR.B ;SO THAT THE CALLER CAN USE
MOVEM T3,FNDR.C ;THEM WHEN I CALL THE SUBROUTINE
MOVEM T4,FNDR.D ;UPON FINDING A MATCH
FNDR.1: LOAD T4,.QEROB+.ROBTY(AP) ;GET OBJECT TYPE OF THIS ENTRY
CAME T4,FNDR.C ;FOR THE SAME QUEUE
JRST FNDR.4 ;NO, TRY THE NEXT IN THE QUEUE
MOVE S1,FNDR.B ;POINT TO THE MASK BLOCK FOR CHKMCH
PUSHJ P,I$RMCH## ;SEE IF THIS THE A MATCHING REQUEST
JUMPF FNDR.4 ;JUMP IF NOT A MATCH
;WITH A REQUEST IN AP THAT MATCHES, DO A LITTLE ACCESS CHECKING
LOAD S1,.QESEQ(AP),QE.RDE ;REQUEST ALREADY GONE?
JUMPN S1,FNDR.4 ;YES, DON'T GET IT AGAIN
SKIPN G$QOPR## ;IS THIS AN OPERATOR REQUEST ???
JRST FNDR.2 ;NO,,SKIP THIS CHECK
SKIPN S1,G$RMTE## ;ANY REMOTE STATION SPECIFIED ???
JRST FNDR.3 ;NO NODE SPECIFIED,,HE WINS !!!
MOVE S2,.QEROB+.ROBND(AP) ;GET THE REQUESTS DESTINATION NODE
PUSHJ P,N$MTCH## ;DO THEY MATCH ???
JUMPT FNDR.3 ;YES,,HE WINS
JUMPF FNDR.4 ;NO,,HE LOSES
FNDR.2: LOAD S1,G$SID## ;GET MESSAGE SENDER ID
LOAD S2,.QEOID(AP) ;REQUEST OWNER ID
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
CAMN S2,S1 ;DOING SOMETHING TO OWN REQUEST
SKIPL FNDR.A ;YES, TRYING TO MODIFY IT
SKIPA ;NO, NEED TO DO ACCESS CHECKS
JRST FNDR.3 ;USER MAY ALWAYS MODIFY OWN REQUEST
LOAD S1,.QEPRT(AP),QE.PRO ;GET REQUEST PROTECTION
HRLI S1,ACC.KM ;CHECK ACCESS TYPE
PUSHJ P,I$CHAC## ;CHECK REQUESTORS RIGHTS
JUMPT FNDR.3 ;JUMP IF ACCESS ALLOWED
AOS FNDR.E ;COUNT PROTECTION FAILURES
JRST FNDR.4 ;AND TRY THE NEXT
;SINCE ITS OK TO KILL/MODIFY THIS REQUEST, CALL THE CALLERS SUBROUTINE
FNDR.3: LOAD P1,.QELNK(AP),QE.PTN ;FIND NEXT IN CASE ITS REMOVED
PUSH P,H ;MAKE US IMMUNE FROM IT
PUSHJ P,@FNDR.D ;DO SOMETHING TO THIS REQUEST
POP P,H ;RESTORE ORIGINAL HEADER
SKIPA AP,P1 ;NOW POINT TO THE NEXT
FNDR.4: LOAD AP,.QELNK(AP),QE.PTN ;FIND THE NEXT
JUMPN AP,FNDR.1 ;CHECK FOR ALL ENTRIES
MOVE S1,FNDR.E ;LOAD NUMBER OF PROT FAILURES
$RETT ;QUEUE EXHAUSTED, RETURN
;LOCAL STORAGE
FNDR.A: BLOCK 1 ; KILL = 0, MODIFY = -1
FNDR.B: BLOCK 1 ;KILL/MODIFY REQ DESC BLOCK
FNDR.C: BLOCK 1 ;RQP OF REQUESTED QUEUE
FNDR.D: BLOCK 1 ;ADDRESS OF PROCESSING ROUTINE
FNDR.E: BLOCK 1 ;# OF PROTECTION FAILURES
SUBTTL SPROTO -- Build a CREATE Message Prototype
SUBTTL SPROTO -- Build a CREATE Message Prototype
;SPROTO IS CALLED WITH T1 = THE CANONICAL SPOOL MESSAGE TO BUILD THE
; PROTOTYPE EXTERNAL QUEUE ENTRY FOR THE FIRST FILE IN DEFERRED
; MODE OR THE ONLY FILE IF IMMEDIATE MODE
;RETURN AP = THE BUILT PROTOTYPE READY FOR Q$INCL
SPROTO: PUSHJ P,M%ACQP ;GET A PAGE FOR THE PROTOTYPE
MOVE AP,S1 ;COPY FOR CALLER
PG2ADR AP ;TO AN ADDRESS
MOVX T2,<INSVL.(EQHSIZ,MS.CNT)!.QIFNC> ;GET SIZE AND INTERNAL CREATE
STORE T2,.MSTYP(AP) ;AS THE MESSAGE HEADER
MOVX T2,<%%.QSR,,EQHSIZ> ;VERSION,,HEADER SIZE
STORE T2,.EQLEN(AP) ;AS EXTERNAL QUEUE LENGTHS
MOVSI T2,CSM.RO(T1) ;POINT TO CSM'S ROB
HRRI T2,.EQROB(AP) ;AND THE EQ'S ROB
BLT T2,.EQROB+ROBSIZ-1(AP) ;AND MOVE IT
MOVE T2,G$SPRT## ;GET SYSTEM PROTECTION OF SPOOLED FILES
STORE T2,.EQSPC(AP),EQ.PRO ;AS THE REQUEST PROTECTION
MOVE S1,[POINT 7,G$ACTS##] ;GET THE ACCOUNT STRING BYTE POINTER
MOVE S2,[POINT 7,.EQACT(AP)] ;GET THE DESTINATION BYTE POINTER
SPRO.1: ILDB T2,S1 ;GET A BYTE
IDPB T2,S2 ;SAVE IT
JUMPN T2,SPRO.1 ;CONTINUE TILL ASCIZ
LOAD T2,CSM.AF(T1) ;GET THE AFTER PARAMETER
STORE T2,.EQAFT(AP) ;STORE IT
LOAD T2,CSM.FM(T1) ;GET THE FORMS PARAMETER
STOLIM T2,.EQLIM(AP),FORM ;STORE IT
DMOVE T2,CSM.NT(T1) ;GET THE NOTE WORDS
STOLIM T2,.EQLIM(AP),NOT1 ;SAVE FIRST HALF
STOLIM T3,.EQLIM(AP),NOT2 ;AND SECOND HALF
LOAD T2,CSM.LM(T1) ;GET SPOOL LIMIT
STOLIM T2,.EQLIM(AP),OLIM ;AND STORE IT IN THE EQ
MOVE S1,T1 ;POINT S1 TO CSM
PJRST I$SMEQ## ;AND MOVE SYSTEM DEPENDENT
; STUFF AN RETURN
SUBTTL MAJMOD -- Perform MODIFY on Major Queue Items
;CALLED BY Q$MODIFY WITH
; AP = THE ENTRY BEING MODIFIED (.EQxxx FORM)
; S1 = GROUP 0 MODIFY BLOCK
MAJMOD: PUSHJ P,.SAVE3 ;SAVE A FEW REGS FIRST
LOAD P1,MOD.GN(S1),MODGLN ;NUMBER OF GROUP 0 ELEMENTS
SOJLE P1,.RETT ;0 IS ACCEPTABLE, ADJUST FOR THE LOOP
CAILE P1,NMAJPM ;MORE THAN CURRENTLY IMPLEMENTED
MOVEI P1,NMAJPM ;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
MAJM.1: MOVE P3,0(P2) ;GET AN ELEMENT
CAME P3,[-1] ;DID IT CHANGE
XCT MAJMTB(P1) ;YES, STORE NEW VALUE
INCR P2 ;TO NEXT ELEMENT
AOBJN P1,MAJM.1 ;GET THEM ALL
$RETT ;RETURN TO Q$MODIFY FOR NEXT GROUP
MAJMTB: STORE P3,.EQAFT(AP) ; 0 = /AFTER
PUSHJ P,MODPRI ; 1 = /PRIORITY
JFCL ; 2 = *SPARE*
STORE P3,.EQSPC(AP),EQ.PRO ; 3 = /PROTECTION
PUSHJ P,MODATR ; 4 = /UNIT: or /LOWER or /UPPER
STORE P3,.EQROB+.ROBND(AP) ; 5 = /NODE:
STORE P3,.EQROB+.ROBUA(AP) ; 6 = CUSTOMER DEFINED ATTRIBUTES
NMAJPM==<.-MAJMTB> ;NUMBER CURRENTLY IMPLEMENTED
MODPRI: PUSHJ P,A$WHEEL## ;IS USER A WHEEL?
JUMPT MODP.1 ;YES, LET HIM DO WHAT HE WANTS
CAILE P3,MXUPRI ;NO, DID HE SPECIFY MORE THAN MAX
MOVX P3,MXUPRI ;YES, LOAD THE MAX
MODP.1: STORE P3,.EQSEQ(AP),EQ.PRI ;STORE IT
$RETT ;AND RETURN
MODATR: TLNN P3,-1 ;ANYTHING SET?
HRLI P3,%GENRC ;NO,,THEN GET GENERIC
TXZE P3,RO.PHY ;PHYSICAL?
HRLI P3,%PHYCL ;YES,,GET PROPER VALUE
TXZE P3,OBDLLC ;LOWER?
HRLI P3,%LOWER ;YES,,GET PROPER VALUE
TXZE P3,OBDLUC ;UPPER?
HRLI P3,%UPPER ;YES,,GET PROPER VALUE
STORE P3,.EQROB+.ROBAT(AP)
$RETT
SUBTTL BLDKMS -- Routine to build KILL/MODIFY/DEFER acknowledgement string
;BLDKMS IS CALLED WITH T1 POINTING TO AN ARGUMENT BLOCK CONTAINING:
; +0 = NUMBER OF "THINGS" DONE (KILLED, MODIFIED, DEFERRED)
; +1 = NUMBER OF FILES (MODIFY, DEFER)
; +2 = NUMBER OF CANCEL MESSAGES SENT (KILL ONLY)
; +3 = NUMBER OF PROTECTION FAILURES
; AND T2 = "THING" STRING ADDRESS (ASCIZ FORMAT)
;ASSEMBLES THE CORRECT MESSAGE (USES TYPPLR TO PLURALIZE THE PARTS) AND CALLS G$MSND
BLDKMS: MOVE S1,0(T1) ;GET "THINGS" DONE
MOVE S2,.QHSQN(H) ;COPY "QUANTITY" NAME
SKIPN (S2) ;NO NAME?
MOVEI S2,[ASCIZ /request/] ;USE GENERIC TERM TO DESCRIBE QUANTITY
SKIPN G$ACK## ;CALLER WANT THIS MESSAGE
$RETT ;OH,THATS DIFFERENT,... NEVER MIND
MOVEI S1,"[" ;START MESSAGE
PUSHJ P,G$CCHR## ;WITH A BRACKET
MOVE S1,0(T1) ;GET "THINGS" DONE
MOVE S2,.QHSQN(H) ;COPY "QUANTITY" NAME
SKIPN (S2) ;NO NAME?
MOVEI S2,[ASCIZ /request/] ;USE GENERIC TERM TO DESCRIBE QUANTITY
PUSHJ P,TYPPLR ;TYPE CORRECT "JOB(S)"
SKIPL T3,1(T1) ;DON'T TYPE FILES
SKIPN 0(T1) ;YES, BUT WERE THERE ANY JOBS
JRST BLDK.1 ;DONT BOTHER
MOVEI S1,[ASCIZ/ (/] ;ALIGN THE OUTPUT
SKIPN T3 ;ANY FILES
MOVEI S1,[ASCIZ/ (But /] ;NO, POINT THAT OUT
$TEXT(G$CCHR##,<^T/0(S1)/^A>) ;INCLUDE PROPER STRING
MOVE S1,T3 ;GET NUMBER OF FILES
MOVEI S2,[ASCIZ/ file/] ;SAY FILE(S) INSTEAD OF JOB(S)
PUSHJ P,TYPPLR ;OUTPUT CORRECT ENGLISH
$TEXT(G$CCHR##,<)^A>) ;CLOSE UP THE MESSAGE
BLDK.1: $TEXT(G$CCHR,<^T/0(T2)/^A>) ;NOW FOR THE "THING" STRING
SKIPN T2,2(T1) ;ANY JOBS CANCELLED
JRST BLDK.2 ;NO, AVOID THE OUTPUT
MOVEI T3,[ASCIZ / were/]
CAIN T2,1 ;JUST ONE?
MOVEI T3,[ASCIZ / was/] ;YES
$TEXT(G$CCHR##,< (^D/T2/^T/0(T3)/ in progress)^A>)
BLDK.2: SKIPN T3,3(T1) ;ANY PROTECTION FAILURES
JRST BLDK.3 ;NO, AVOID THAT TOO
$TEXT(G$CCHR##,<, ^A>) ;PUNCTUATION
MOVE S1,T3 ;GET THE COUNT OF PROTECTION FAILURES
MOVEI S2,[ASCIZ/ protection failure/]
PUSHJ P,TYPPLR ;TYPE NUMBER AND PLURALIZE THE MESSAGE
BLDK.3: MOVEI S1,"]" ;GET BRACKET
PUSHJ P,G$CCHR## ;TERMINATE TEXT
MOVEI S1,.CHNUL ;GET A <NUL>
PUSHJ P,G$CCHR## ;MAKE ASCIZ
PJRST G$MSND## ;SEND "ACK" AND RETURN
SUBTTL TYPPLR -- Routine to pluralize a message
;TYPPLR IS CALLED WITH S1 CONTAINING A NUMBER "N" AND S2 CONTAINING
; THE ADDRESS OF AN ASCIZ STRING "FOO". IF N IS 0, TYPPLR
; WILL SEND TO THE CURRENT TEXT MESSAGE "NO FOOS". IF N IS 1,
; "1 FOO" WILL BE SENT, OTHERWISE, "N FOOS" WILL BE SENT.
;
TYPPLR: JUMPN S1,TYPP.1 ;ANY THINGS?
$TEXT(G$CCHR##,<No ^T/0(S2)/^A>) ;NO, SO SAY "NO THING"
SKIPA ;AND DONT GIVE THE NUMBER
TYPP.1: $TEXT(G$CCHR##,<^D/S1/ ^T/0(S2)/^A>) ;SAY "N THING"
CAIE S1,1 ;UNLESS ITS EXACTLY 1 THING
$TEXT(G$CCHR##,<s^A>) ;ADD THE PLURALIZING "S"
$RETT ;RETURN TO CALLER
SUBTTL NOTIFY - ROUTINE TO NOTIFY THE USER HIS JOB IS DONE
;CALL: AP/ QE Address
; S1/ The Notify Type Code
;
;RET: TRUE ALWAYS
NOTIFY: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S2,G$OPR## ;GET ORION'S PID
CAXN S1,%NOTJB ;UNLESS WE WANT TO NOTIFY A JOB,
MOVE S2,.QENID(AP) ; THEN GET THE JOBS PID
MOVEM S2,G$SAB##+SAB.PD ;SAVE AS RECIEVERS PID
PUSHJ P,M%ACQP ;GO GET A PAGE FOR IPCF
PG2ADR S1 ;CONVERT TO A PAGE NUMBER
MOVEM S1,G$SAB##+SAB.MS ;SAVE THE MESSAGE ADDRESS
MOVE P1,S1 ;SAVE IT IN P1 ALSO
MOVX S1,PAGSIZ ;GET THE PAGE LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
MOVX S1,.OMNFY ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(P1),MS.TYP ;SAVE IT
MOVEI S1,^D44 ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IT
MOVEI S1,3 ;GET THE BLOCK COUNT
STORE S1,.OARGC(P1) ;SAVE IT
MOVEI P1,.OHDRS(P1) ;POINT TO THE FIRST BLOCK
MOVE S1,[JBI.SZ,,.JOBID] ;GET THE JOB ID BLOCK HEADER
MOVEM S1,ARG.HD(P1) ;SAVE IT
LOAD S1,.QEJBN(AP),QE.UJN ;GET THE USERS JOB NUMBER
STORE S1,JBI.JB(P1) ;SAVE IT
MOVE S1,.QENID(AP) ;GET THE NOTIFY ID
STORE S1,JBI.LI(P1) ;SAVE IT
MOVEI P1,JBI.SZ(P1) ;POINT TO THE NEXT BLOCK
MOVE S1,[^D34,,.CMTXT] ;GET THE TEXT BLOCK HEADER
MOVEM S1,ARG.HD(P1) ;SAVE IT
LOAD S2,REL.FL(M),RF.ABO ;LOAD ABORT BIT
SKIPN REL.TX(M) ;ANY MESSAGE TEXT?
$TEXT (<-1,,ARG.DA(P1)>,<^M^J[From SYSTEM: Job ^W/.QEJOB(AP)/ request #^D/.QERID(AP)/ ^T/@CODTAB(S2)/ ^T/@.QHNOT(H)/ at ^C/[-1]/^T/BELLS/]>)
SKIPE REL.TX(M) ;ANY MESSAGE TEXT?
$TEXT (<-1,,ARG.DA(P1)>,<^M^J[From SYSTEM: Job ^W/.QEJOB(AP)/ request #^D/.QERID(AP)/ ^T/@CODTAB(S2)/ ^T/@.QHNOT(H)/ at ^C/[-1]/^T/BELLS/]^M^J[^T/@STSTAB(S2)/: ^T/REL.TX(M)/]>)
MOVEI P1,^D34(P1) ;-;POINT TO THE NEXT BLOCK
MOVE S1,[2,,.QCJBN] ;GET JOBNAME BLOCK HEADER
MOVEM S1,ARG.HD(P1) ;SAVE IT
MOVE S1,.QEJOB(AP) ;GET THE JOB NAME
MOVEM S1,ARG.DA(P1) ;SAVE IT
PUSHJ P,C$SEND## ;SEND THE MESSAGE
$RETT ;AND RETURN
BELLS:: BYTE(7) .CHBEL,.CHBEL,0,0,0 ;NOISE
CODTAB: [ASCIZ/finished/] ;FINISHED
[ASCIZ/aborted/] ;ABORTED
STSTAB: [ASCIZ/Status/] ;STATUS
[ASCIZ/Reason/] ;REASON
END