Trailing-Edge
-
PDP-10 Archives
-
bb-bt99m-bb
-
nebula.mac
There are 23 other files named nebula.mac in the archive. Click here to see a list.
TITLE NEBULA - DECsystem-10 Network Queue Controller
SUBTTL D. P. Mastrovito & Joseph A. Dziedzic /DPM/JAD
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 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 NEBPRM
MODULE (NEBULA)
.REQUE CHRFRM ;GET CHARACTERISTICS/FORMS FILE HANDLER
LOC .JBVER ;VERSION
EXP %%.NEB ; NUMBER
RELOC ; ...
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983,1987. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
SUBTTL Initialization
NEBULA::JFCL ;NO CCL
RESET ;STOP I/O
MOVE P,[IOWD PDLMSZ,PDL] ;SET UP STACK
MOVEI S1,IB.SZ ;IB SIZE
MOVEI S2,IB ;IB ADDR
PUSHJ P,I%INIT## ;FIRE UP GLXLIB
PUSHJ P,INITIA ;INITIALIZE
PUSHJ P,I%ION ;TURN ON THE PSI SYSTEM
$LOG (<^T/G$NAM/ %^V/.JBVER/ starting>,,,<$WTFLG(WT.SJI)>)
MOVEI M,HELLO ;POINT TO HELLO HESSAGE
PUSHJ P,G$SQSR ;GREET QUASAR
SUBTTL Main scheduling loop
MAIN: PUSHJ P,I%NOW ;GET "NOW"
MOVEM S1,G$NOW ;SAVE IT
PUSHJ P,IPCF ;PROCESS IPCF MESSAGES
PUSHJ P,RESEND ;RESEND ANY THAT DIDN'T MAKE IT
AOSN CLKTIC ;TIMER GONE OFF?
PUSHJ P,CLKCHK ;COUNTDOWN THE CLOCK REQUEST QUEUE
AOSN G$CLNC ;NEED TO GARBAGE COLLECT PAGES?
PUSHJ P,M%CLNC## ;YES, SHRINK DOWN IF WE CAN
MOVSI P1,-JOBN ;AOBJN POINTER
SETZM RUNCNT ;CLEAR COUNT OF JOBS RUN ON THIS PASS
MAIN1: SKIPN R,G$ADR(P1) ;HAVE A STREAM?
JRST RSCHED ;NO
MOVEM P1,CURJOB ;SAVE CURRENT STREAM
MOVE S1,.JBFLG(R) ;GET FLAGS
TXNE S1,JB.KIL ;KILL JOB?
JRST KILJOB ;YES
TXNE S1,JB.ABO ;ABORT JOB?
JRST ABOJOB ;YES
.CREF .WSRUN ;SHOW WHAT WE'RE TESTING
SKIPE .JBWSC(R) ;AND IS IT RUNNABLE?
JRST RSCHED ;NO
HRLZI 0,.JBACS+1(R) ;SET UP BLT
HRRI 0,1 ;START WITH AC 1
BLT 0,17 ;LOAD ACS 1 THROUGH 17
MOVE 0,.JBACS(R) ;LOAD AC 0
AOS RUNCNT ;REMEMBER WE RAN A JOB
POPJ P, ;RETURN TO INTERRUPTED PROCESS
SUBTTL Scheduler -- Rescheduling and job context switching
SSCHED::PUSH P,S1 ;SAVE S1
PUSHJ P,I%IOFF ;TURN OFF PSI
MOVE S1,@-1(P) ;GET WORD FOLLOWING CALL
TRC S1,-1 ;IF TIME IS -1
TRCN S1,-1 ; THEN IGNORE IT
MOVEM S1,.JBTIM(R) ;SET TIMER
HLRZS S1 ;ISOLATE WAIT STATE IN RH
ANDI S1,777 ;STRIP OFF JUNK
CAIE S1,777 ;IGNORE?
MOVEM S1,.JBWSC(R) ;SET NEW CODE
PUSHJ P,I%ION ;TURN ON PSI
POP P,S1 ;RESTORE S1
POPJ P, ;RETURN
WSCHED::MOVEM 0,.JBACS(R) ;SAVE AC 0
HRLZI 0,1 ;START WITH AC 1
HRRI 0,.JBACS+1(R) ;SET UP BLT
BLT 0,.JBACS+17(R) ;SAVE THE ACS
PUSHJ P,UPDATE ;UPDATE STREAM STATUS IF REQUIRED
SETZM .JBFCT(R) ;RESET FAIRNESS COUNTER
XSCHED: MOVE P,[IOWD PDLMSZ,PDL] ;RESET PDL
MOVE P1,CURJOB ;GET CURRENT (NOW LAST) JOB POINTER
RSCHED: AOBJN P1,MAIN1 ;LOOP IF MORE TO CHECK
MOVEM P1,CURJOB ;UPDATE
MOVEI S1,ZZTIME ;SNOOZE TIME
SKIPN RUNCNT ;RUN ANY JOB LAST TIME?
PUSHJ P,I%SLP ;ZZZZZZ
JRST MAIN ;LOOP BACK
SUBTTL Scheduler -- Clock queue/Timer control
;TIMER INTERRUPT
TIMINT: $BGINT (1) ;SWITCH TO INTERRUPT CONTEXT
SETOM CLKTIC ;SET FLAG
$DEBRK ;DISMISS INTERRUPT
;CLEAR A TIMER REQUEST FOR A STREAM
;CALL: PUSHJ P,TIMCLR
TIMCLR::MOVEI S1,1 ;TIME IS ONE SECOND
SETZ S2, ;NO SUBROUTINE
;SET A TIMER REQUEST TO RUN A SUBROUTINE IN THE JOB'S CONTEXT
;CALL: MOVE S1, TIME IN SECONDS
; MOVE S2, SUBROUTINE
; PUSHJ P,TIMJOB
TIMJOB::MOVEM S1,.JBTIM(R) ;STORE TIME IN SECONDS
MOVEM S2,.JBTQS(R) ;STORE TIMER QUEUED SUBROUTINE ADDRESS
MOVX S1,JB.SPR ;SCHEDULER BIT
ANDCAM S1,.JBFLG(R) ;CLEAR IT
JRST TIMCHK ;SEE IF WE NEED TO RESET TIMER
;SET A STREAM TIMER TO RUN A SUBROUTINE IN THE SCHEDULER'S CONTEXT
;CALL: MOVE S1, TIME IN SECONDS
; MOVE S2, SUBROUTINE
; PUSHJ P,TIMSCD
TIMSCD::MOVEM S1,.JBTIM(R) ;STORE TIME IN SECONDS
MOVEM S2,.JBTQS(R) ;STORE TIMER QUEUED SUBROUTINE ADDRESS
MOVX S1,JB.SPR ;SCHEDULER BIT
IORM S1,.JBFLG(R) ;SET IT
TIMCHK: MOVE S1,.JBTIM(R) ;GET TIME BACK
CAMG S1,CLKTIM ;NEED TO RESET TIMER?
PUSHJ P,CLKCHK ;YES
POPJ P, ;RETURN
;CHECK ALL STREAMS FOR EXPIRED TIMERS
CLKCHK: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,I%NOW ;GET CURRENT TIME
MOVE S2,S1 ;COPY
EXCH S2,CLKTIM ;SWAP WITH TIME ON LAST SCAN
SUB S1,S2 ;COMPUTE DIFFERENCE
MULI S1,250600 ;MULTIPLY BY SECONDS PER DAY
ASHC S1,17 ;POSITION RESULT IN SECONDS
MOVSI P1,-JOBN ;AOBJN POINTER
MOVE P2,S1 ;COPY TIME
CLKCH1: SKIPE R,G$ADR(P1) ;HAVE A STREAM?
SKIPE .JBTIM(R) ;AND IS A TIMER RUNNING?
JRST CLKCH4 ;NO
MOVN S1,P2 ;GET TIME
ADDB S1,.JBTIM(R) ;COUNT IT DOWN
JUMPG S1,CLKCH4 ;JUMP IF NOT TIMED OUT YET
MOVX S1,JB.SPR ;BIT TO TEST
TDNE S1,.JBFLG(R) ;SCHEDULER PROCESSED TIMER REQUEST?
JRST CLKCH2 ;YES
MOVE S1,.JBACS+P(R) ;GET STREAM STACK
SKIPE .JBTQS(R) ;HAVE A TIMER QUEUED SUBROUTINE?
PUSH S1,.JBTQS(R) ;PUT IT ON THE STACK
MOVEM S1,.JBACS+P(R) ;UPDATE
JRST CLKCH3 ;ONWARD
CLKCH2: ANDCAM S1,.JBFLG(R) ;CLEAR SCHEDULER BIT
PUSHJ P,@.JBTQS(R) ;CALL SUBROUTINE
CLKCH3: SETZM .JBTIM(R) ;CLEAR TIMER (MIGHT HAVE GONE NEGATIVE)
SETZM .JBTQS(R) ;CLEAR OUT TIMER QUEUED SUBROUTINE
SETZ S1, ;CLEAR TIME REMAINING
CLKCH4: JUMPE S1,CLKCH5 ;IGNORE ZERO
CAMGE S1,CLKNEW ;SMALLER INTERVAL?
MOVEM S1,CLKNEW ;YES
CLKCH5: AOBJN P1,CLKCH1 ;LOOP FOR ALL STREAMS
MOVE S1,CLKNEW ;GET NEW TIME
SETOM CLKTIC ;RESET FLAG
PITMR. S1, ;ENABLE TIMER INTERRUPT
JFCL ;???
POPJ P,
SUBTTL Scheduler -- Update job status
UPDATE: PUSHJ P,I%NOW ;GET "NOW"
SUB S1,.JQLUT(R) ;GET TIME SINCE LAST UPDATE
CAXGE S1,UPDTIM ;TIME FOR AN UPDATE?
POPJ P, ;NO, RETURN
FSTATU: MOVE S1,.JQOBJ+OBJ.UN(R) ;GET STREAM NUMBER
CAIL S1,PRCN ;PROCESSING STREAM?
POPJ P, ;NO, NO UPDATE REQUIRED
MOVX S1,STU.MX ;SIZE OF MESSAGE
MOVEI S2,G$MSG ;SCRATCH SPACE
PUSHJ P,.ZCHNK ;ZERO IT
MOVEI M,G$MSG ;POINT AT THE MESSAGE
MOVX S1,STU.MX ;SIZE OF MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;STUFF IT
MOVX S1,.QOSTU ;MESSAGE TYPE
STORE S1,.MSTYP(M),MS.TYP ;STUFF IT
MOVSI S1,.JQOBJ(R) ;OBJECT BLOCK ADDRESS
HRRI S1,STU.RB(M) ;WHERE IT GOES
BLT S1,STU.RB+OBJ.SZ-1(M) ;COPY IT
MOVX S1,%ACTIV ;ASSUME ACTIVE
MOVE S2,.JBWSC(R) ;GET STREAM WAIT STATE
CAXN S2,.WSIDL ;IDLE?
MOVX S1,%IDLE ;YES
CAXE S2,.WSWCC ;WAITING FOR A CONNECTION?
CAXN S2,.WSWRC ;...
MOVX S1,%CNECT ;YES
MOVEM S1,STU.CD(M) ;STORE STATE CODE
MOVE S1,.JBNOD(R) ;GET NODE NAME
MOVEM S1,STU.PR+.ONNOD(M) ;STORE IT
PUSHJ P,I%NOW ;GET NOW
MOVEM S1,.JQLUT(R) ;SAVE AS LAST UPDATE TIME
SUB S1,.JQTRS(R) ;SUBTRACT TIME STARTED
IMULI S1,^D60*^D60*^D24 ;CONVERT UDT FRACTION TO SECONDS
HLRZM S1,STU.PR+.ONCON(M) ;STORE CONNECT TIME (SECONDS)
MOVE S1,.JNIOV+.IONTY(R) ;GET NETWORK TYPE
MOVEM S1,STU.PR+.ONLNK(M) ;STORE IT
MOVE S1,.JQBYT(R) ;GET NUMBER OF BYTES TRANSFERRED
MOVEM S1,STU.PR+.ONBYT(M) ;STORE IT
MOVEI T1,[ITEXT (<, transferring file ^D/S1/ of ^D/S2/>)]
SKIPN S1,.JQRFN(R) ;GET THE RELATIVE FILE NUMBER
MOVEI T1,[ITEXT ()] ;NOTHING MORE TO SAY HERE
LOAD S2,.EQSPC(R),EQ.NUM ;GET NUMBER OF FILES IN REQUEST
$TEXT (<-1,,STU.ST(M)>,<Started at ^C/.JQTRS(R)/^I/0(T1)/^0>)
; $TEXT (<-1,,STU.ST(M)>,<Transferring file ^F/.JQCFD(R)/>)
PJRST G$SQSR ;SEND TO QUASAR AND RETURN
SUBTTL Scheduler -- ABORTJ - Abort job
ABORTJ::MOVE S1,.JBACS+P(R) ;GET STREAM STACK
PUSH S1,.JNIOV+.IOABO(R) ;WILL RETURN TO "ABORT LINK" ROUTINE
MOVEM S1,.JBACS+P(R) ;UPDATE
$WTO (<Stream aborting>,<^T/.JBIDN(R)/>,.JQOBJ(R))
POPJ P, ;RETURN
SUBTTL Scheduler -- KILJOB - Kill a job
KILJOB: SKIPE .JNIOV+.IOABO(R) ;WE MAY NOT HAVE A DRIVER, SO CHECK FIRST
PUSHJ P,@.JNIOV+.IOABO(R) ;MAKE SURE LINK IS CLOSED (ABORTED)
JFCL ;IGNORE ERRORS
HRRZ S1,CURJOB ;JOB NUMBER
MOVE P,[IOWD PDLMSZ,PDL] ;RESET PDL
PUSHJ P,ZAPJOB ;DELETE DATA BASE
JRST XSCHED ;JUMP BACK INTO SCHEDULER LOOP
SUBTTL Scheduler -- ABOJOB - Abort active job
ABOJOB: SKIPE .JNIOV+.IOABO(R) ;WE MAY NOT HAVE A DRIVER, SO CHECK FIRST
PUSHJ P,@.JNIOV+.IOABO(R) ;MAKE SURE LINK IS CLOSED (ABORTED)
JFCL ;IGNORE ERRORS
MOVX S1,JB.KIL ;WE DON'T REALLY WANT TO KILL THE JOB
ANDCAM S1,.JBFLG(R) ; SO CLEAR THE FLAG
PJRST IDLJOB ;IDLE THE STREAM
SUBTTL Scheduler -- IDLJOB - Make a job idle
IDLJOB: SKIPE .JNIOV+.IOABO(R) ;WE MAY NOT HAVE A DRIVER, SO CHECK FIRST
PUSHJ P,@.JNIOV+.IOABO(R) ;MAKE SURE LINK IS CLOSED (ABORTED)
JFCL ;IGNORE ERRORS
MOVX S1,.WSIDL ;GET THE IDLE WAIT STATE
MOVEM S1,.JBWSC(R) ;STUFF IT
JRST XSCHED ;JUMP BACK INTO SCHEDULER LOOP
SUBTTL Scheduler -- ZAPJOB - Delete job data base
ZAPJOB: PUSH P,S1 ;SAVE STREAM INDEX
SKIPE S1,.JBPSI(R) ;GET PSI VECTOR ADDRESS
SETZM (S1) ;RECYCLE BLOCK
MOVE S2,R ;COPY STREAM RELOCATION
ADR2PG S2 ;CONVERT TO PAGE NUMBER
POP P,S1 ;STREAM INDEX
SETZB R,G$ADR(S1) ;ERASE ALL MEMORY OF IT
MOVEI S1,.JPAGS ;PAGES IN DATA BASE
PUSHJ P,M%RLNP ;DEALLOCATE CORE
SETOM G$CLNC ;GARBAGE COLLECT NEXT PASS THROUGH MAIN
POPJ P, ;RETURN
SUBTTL Scheduler -- TIMOUT - Link timeout
TIMOUT::PUSHJ P,JOBIDN ;GENERATE IDENTIFYING TEXT
$WTO (<Link timeout error>,<^T/.JBIDN(R)/>,.JQOBJ(R))
PUSHJ P,ABORTJ ;QUEUE UP TO ABORT JOB
HALT .
SUBTTL Scheduler -- Generate connect and disconnect messages
;GENERATE CONNECT MESSAGE
CONMSG: MOVEI T1,@.JNIOV+.IONAM(R) ;POINT TO NAME STRING
MOVE T2,.JBNOD(R) ;NODE NAME
MOVEI T3,[ITEXT ()] ;NULL ITEXT
IFN OLDDQS,<
MOVX S1,JB.OLD ;
TDNE S1,.JBFLG(R) ;TALKING TO THE OLD VERSION?
MOVEI T3,[ITEXT (< (old Distributed Job Manager)>)]
>
$WTO (<Connect>,<^T/(T1)/ link to ^N/T2/ established^I/(T3)/>,.JQOBJ(R))
POPJ P, ;RETURN
;GENERATE DISCONNECT MESSAGE
DISMSG: MOVEI T1,@.JNIOV+.IONAM(R) ;POINT TO NAME STRING
MOVE T2,.JBNOD(R) ;NODE NAME
$WTO (<Disconnect>,<^T/(T1)/ link to ^N/T2/ terminated>,.JQOBJ(R))
POPJ P, ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- IPCF interrupt processing
IPCINT: $BGINT (1) ;SWITCH TO INTERRUPT CONTEXT
PUSHJ P,C%INTR ;TELL LIBRARY WE HAVE A MESSAGE
$DEBRK ;DISMISS INTERRUPT
SUBTTL IPCF/Operator/QUASAR interface -- IPCF message processing
IPCF: PUSHJ P,C%RECV ;TRY TO RECEIVE A MESSAGE
JUMPF .POPJ ;NONE THERE--RETURN
PUSHJ P,IPCSET ;SET UP ALL SORTS OF VARIABLES
JRST IPCF.X ;ERROR OF SOME SORT
LOAD S1,.MSTYP(M),MS.TYP ;GET MESSAGE TYPE
PUSH P,S1 ;SAVE IT
MOVE S1,[-NUMMSG,,MSGTAB] ;GET POINTER TO MESSAGE TABLE
IPCF.1: HLRZ S2,(S1) ;GET TYPE FROM TABLE
CAME S2,(P) ;A MATCH?
AOBJN S1,IPCF.1 ;KEEP SEARCHING
SKIPL S1 ;POINTER POSITIVE IF NO MATCH
MOVEI S1,MSGTAB ;UNKNOWN MESSAGE TYPE
POP P,(P) ;TRIM STACK
HRRZ S1,(S1) ;GET PROCESSOR ADDRESS
PUSHJ P,(S1) ;DISPATCH
IPCF.X: PUSHJ P,C%REL ;RELEASE MESSAGE
JRST IPCF ;TRY FOR ANOTHER PACKET
; Message dispatch table
MSGTAB: XWD 000000,UNKMSG ;?????? UNKNOWN MESSAGES
XWD MT.TXT,ACK ;ACKS
XWD .OMSHQ,SHOWQ ;ORION SHOW QUEUES
XWD .QONEX,NXTJOB ;CREATE REMOTE QUEUE ENTRY
XWD .QOABO,ABORT ;QUASAR ABORT JOB
XWD .QOLIS,LIST ;QUASAR LIST REMOTE
XWD .QOSUP,SETUP ;QUASAR SETUP
NUMMSG==.-MSGTAB ;LENGTH OF TABLE
;Routine to set up for IPCF message processing
IPCSET: SETZM G$ACK ;ASSUME NO ACK WANTED
MOVE S2,MDB.SP(S1) ;GET THE SENDERS PID
MOVEM S2,G$SND ;AND SAVE IT
MOVE S2,MDB.SD(S1) ;GET THE SENDERS ID
MOVEM S2,G$SID ;AND SAVE IT
MOVE S2,MDB.PV(S1) ;GET SENDERS CAPABILITIES
MOVEM S2,G$PRV ;SAVE THAT AS WELL
MOVE S2,MDB.SI(S1) ;GET THE SENDERS SPECIAL PID INDEX
MOVEM S2,G$IDX ;STORE IT
MOVE S2,MDB.FG(S1) ;GET FLAG WORD
MOVEM S2,G$FLG ;SAVE
LOAD M,MDB.MS(S1),MD.ADR ;POINT M AT INCOMMING PACKET
MOVE S1,.MSCOD(M) ;GET THE MESSAGE ACK CODE
MOVEM S1,G$COD ;AND SAVE IT
MOVEI S1,.OHDRS+ARG.HD(M);POINT TO FIRST BLOCK IN MESSAGE
MOVEM S1,MSGBLK ;SAVE
MOVE S1,.OARGC(M) ;GET ARGUMENT BLOCK COUNT
MOVEM S1,MSGCNT ;SAVE
SETZM G$ACK ;ASSUME NO ACK WANTED
MOVX S1,MF.ACK ;GET ACK BIT
TDNE S1,.MSFLG(M) ;IS IT SET?
SETOM G$ACK ;SENDER WANTS AN ACK
LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIE S1,SP.QSR ;QUASAR?
CAIN S1,SP.OPR ;ORION?
AOS (P) ;YES
POPJ P, ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- Resend messages
RESEND: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZB P1,P2 ;CLEAR PREVIOUS PID AND INDEX
MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
PUSHJ P,L%FIRS ;POSITION TO FIRST ENTRY
JRST RESE.2 ;ENTER LOOP
RESE.1: MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
PUSHJ P,L%NEXT ;POSITION TO NEXT ENTRY
RESE.2: JUMPF .POPJ ;RETURN IF END OF LIST
MOVSI S1,(S2) ;POINT TO SAVED SAB
HRRI S1,G$SAB ;AND WORKING COPY
BLT S1,G$SAB+SAB.SZ-1 ;RETRIEVE FROM LIST
MOVE M,G$SAB+SAB.MS ;POINT TO THE MESSAGE
MOVE S1,G$SAB+SAB.LN ;GET MESSAGE LENGTH
TRNN M,PAGSIZ-1 ;ON A PAGE BOUNDRY?
CAIE S1,PAGSIZ ;AND A PAGE IN LENGTH?
MOVEI M,SAB.SZ(S2) ;NO--POINT TO SAVED MESSAGE
MOVEM M,G$SAB+SAB.MS ;UPDATE
CAMN P1,G$SAB+SAB.PD ;THIS PID SAME AS LAST ONE?
CAME P2,G$SAB+SAB.SI ;INDEX THE SAME TOO?
JRST RESE.1 ;YES--IGNORE SINCE LAST SEND FAILED
MOVEI S1,SAB.SZ ;SAB LENGTH
MOVEI S2,G$SAB ;SAB ADDRESS
PUSHJ P,C%SEND ;SEND MESSAGE
JUMPT RESE.3 ;DELETE FROM QUEUE IF SUCESSFUL
CAIE S1,ERNSP$ ;NO SUCH PID?
CAIN S1,ERPWA$ ;PID WENT AWAY?
JRST RESE.3 ;JUST REMOVE FROM QUEUE
MOVE P1,G$SAB+SAB.PD ;COPY PID
MOVE P2,G$SAB+SAB.SI ;AND INDEX
JRST RESE.1 ;TRY ANOTHER TO RESEND TO ANOTHER PID
RESE.3: SETZB P1,P2 ;CLEAR PREVIOUS PID AND INDEX
MOVE S1,IPCQUE ;ELSE MUST DELETE
PUSHJ P,L%DENT ;THE QUEUE ENTRY
SOSE RSENDC ;COUNT DOWN
JRST RESE.1 ;GO TRY ANOTHER RESEND
POPJ P, ;QUEUE IS EMPTY
SUBTTL IPCF/Operator/QUASAR interface -- Message block processing
; Get the next block of a message
; Call: PUSHJ P,G$BLK
; <NON-SKIP> ;END OF MESSAGE
; <SKIP> ;NEXT BLOCK FOUND
;
; On error return, T1, T2 and T3 left unchanged
; On sucessful return, T1= type, T2= length, T3= data address
;
; AC usage: Destroys S1
;
G$BLK:: SOSGE MSGCNT ;SUBTRACT 1 FROM THE BLOCK COUNT
POPJ P, ;ERROR RETURN IF NO MORE
MOVE S1,MSGBLK ;GET THE PREVIOUS BLOCK ADDRESS
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;GET THE BLOCK DATA ADDRESS
ADD S1,T2 ;POINT TO THE NEXT MESSAGE BLOCK
MOVEM S1,MSGBLK ;SAVE IT FOR THE NEXT CALL
JRST .POPJ1 ;RETURN SUCESSFUL
SUBTTL IPCF/Operator/QUASAR interface -- Unknown message
UNKMSG: $WTO (<^T/G$NAM/ Error>,<^I/UNKTXT/>)
POPJ P, ;RETURN
UNKTXT: ITEXT (< Unknown IPCF message
Sender: ^O12R0/G$SND/, ^U/G$SID/
Header: ^O12R0/.MSTYP(M)/, ^O12R0/.MSFLG(M)/, ^O12R0/.MSCOD(M)/>)
SUBTTL IPCF/Operator/QUASAR interface -- ACK message #700000
ACK: SKIPE .OARGC(M) ;QUASAR SNIFFING AROUND?
$WTO (<^T/G$NAM/ error>,<^I/ACKTXT/>,,<$WTFLG(WT.SJI!WT.NFO)>)
POPJ P, ;RETURN
ACKTXT: ITEXT (< Unexpected ACK
Sender: ^O12R0/G$SND/, ^U/G$SID/
Header: ^O12R0/.MSTYP(M)/, ^O12R0/.MSFLG(M)/, ^O12R0/.MSCOD(M)/
^T/.OHDRS+ARG.DA(M)/>)
SUBTTL IPCF/Operator/QUASAR interface -- QUASAR message #5 (NEXTJOB)
NXTJOB: PUSHJ P,FNDPRC ;FIND AN IDLE PROCESSING STREAM
JRST NXTJ.1 ;NONE? QUASAR BLEW IT
PUSHJ P,COPMSG ;COPY THE REQUEST TO THE STREAM DATABASE
MOVE S1,.EQROB+.ROBND(R) ;GET DESTINATION NODE
MOVEM S1,.JBNOD(R) ;STORE FOR ASSORTED TEXT MESSAGES
PUSHJ P,SELDRV ;SELECT A NETWORK DRIVER
JRST NXTJ.2 ;NONE AVAILABLE, REQUEUE THE REQUEST
MOVE S1,.JBACS+P(R) ;GET STREAM STACK
PUSH S1,[IDLJOB] ;WHERE TO END UP
PUSH S1,[RCREAT] ;WHERE TO START JOB
MOVEM S1,.JBACS+P(R) ;UPDATE
MOVE S1,G$NOW ;GET "NOW"
MOVEM S1,.JQTRS(R) ;SAVE TIME REQUEST STARTED PROCESSING
SETZM .JQLUT(R) ;NO UPDATE SENT YET
SETZM .JQRFN(R) ;INITIALIZE RELATIVE FILE NUMBER TO ZERO
SETZM .JQCFD(R) ;NO CURRENT FILE
SETZM .JQBYT(R) ;NOTHING SENT YET
.CREF .WSRUN ;SHOW NEW STATE
SETZM .JBWSC(R) ;MAKE THE STREAM RUNNABLE
POPJ P, ;RETURN
NXTJ.1:;STOPCD (NFS,HALT,,<No free processing streams>) ;debug
$WTO (<^T/G$NAM/ error>,<No free processing streams>,,<$WTFLG(WT.SJI)>)
PJRST REQMSG ;BE NICE AND REQUEUE THE JOB
NXTJ.2: $WTO (<Node ^N/.EQROB+.ROBND(M)/ not accessible>,,.JQOBJ(R),<$WTFLG(WT.SJI)>)
MOVX S1,%RSUNA ;GET "NOT AVAILABLE" RESPONSE CODE
SETZ S2, ;NO ATTRIBUTES
PJRST RSETUP ;SEND RESPONSE TO SETUP MSG TO QUASAR
SUBTTL IPCF/Operator/QUASAR interface -- QUASAR message #6 (ABORT)
ABORT: MOVE S1,ABO.IT(M) ;GET INTERNAL TASK NAME
PUSHJ P,FNDITN ;FIND THE OBJECT
POPJ P, ;DUH?
$ACK (Aborting,<^R/.EQJBB(R)/>,.JQOBJ(R),.MSCOD(M)) ;TELL THE OPR
MOVX S1,JB.ABO ;INDICATE ABORT IN PROGRESS
IORM S1,.JBFLG(R)
.CREF .WSRUN ;STATE CODE
SETZM .JBWSC(R) ;MAKE STREAM RUNNABLE
POPJ P, ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- QUASAR message #10 (LIST)
LIST: TDZA S1,S1 ;GET A ZERO AND SKIP
SHOWQ: SETO S1, ;GET -1
PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;PRESERVE REQUEST TYPE INDICATION
PUSHJ P,FNDLST ;FIND AN IDLE LISTING STREAM
JRST LIST.3 ;NONE, CAN WE DEFER THE REQUEST?
PUSH P,P1 ;SAVE REQUEST TYPE INDICATION
MOVE P1,S1 ;COPY STREAM NUMBER
PUSHJ P,SETU.1 ;DO BASIC STREAM SETUP
POP P,.JLTYP(R) ;SAVE REQUEST TYPE INDICATION
PUSHJ P,COPMSG ;COPY REQUEST MESSAGE TO STREAM DATABASE
MOVE S1,G$COD ;GET SENDER'S ACK CODE
MOVEM S1,.JLCOD(R) ;SAVE IT
LIST.1: PUSHJ P,G$BLK ;GET THE NEXT BLOCK FROM THE MESSAGE
JRST LIST.2 ;DONE
MOVE S1,0(T3) ;GET THE DATA ITEM
CAIN T1,.LSPID ;PID OF REQUESTOR?
MOVEM S1,.JLPID(R) ;YES
CAIN T1,.LSDND ;DESTINATION NODE?
MOVEM S1,.JBNOD(R) ;YES
CAIN T1,.ORNOD ;VIA OPR REQUEST?
MOVEM S1,.JBNOD(R) ;YES
;CHECK FOR OTHER USEFUL ONES HERE
CAIE T1,.LSQNM ;QUEUE NAME BLOCK?
JRST LIST.1 ;NO, LOOK FOR MORE
SUBI T2,ARG.DA ;SUBTRACT OVERHEAD WORDS
MOVEI T1,.JLQNM(R) ;WHERE TO COPY THE QUEUE NAME STRING
HRL T1,T3 ;SET SOURCE ADDRESS
ADDI T2,-1(T1) ;COMPUTE END ADDRESS
BLT T1,(T2) ;COPY THE QUEUE NAME OVER
JRST LIST.1 ;LOOK FOR MORE
;Now check for consistancy
LIST.2: SKIPE .JBNOD(R) ;MUST HAVE A NODE
SKIPN .JLPID(R) ;MUST ALSO HAVE REQUESTOR'S PID
JRST LIST.5 ;ERROR
MOVE S1,.JBNOD(R) ;GET REMOTE NODE
PUSHJ P,SELDRV ;SELECT A NETWORK DRIVER
JRST LIST.4 ;NONE ACCEPTABLE
MOVE S1,.JBACS+P(R) ;GET STREAM STACK
PUSH S1,[LLIST] ;WHERE TO START JOB
MOVEM S1,.JBACS+P(R) ;UPDATE
POPJ P, ;RETURN
LIST.3: HALT . ;SURE WOULD BE NICE TO DEFER THIS!
LIST.4: MOVEI S1,[ASCIZ / Remote Queue Listing /] ;HEADER TEXT
PUSHJ P,SETPAG ;SET UP A DISPLAY TEXT PAGE
$TEXT (DEPBYT,<Node ^N/.JBNOD(R)/ is not accessible>)
PJRST SENDIT ;SEND OFF THE ACK AND RETURN
LIST.5: MOVEI S1,[ASCIZ / Remote Queue Listing /] ;HEADER TEXT
PUSHJ P,SETPAG ;SET UP A DISPLAY TEXT PAGE
$TEXT (DEPBYT,<Invalid list request message>)
PJRST SENDIT ;SEND OFF THE ACK AND RETURN
SUBTTL IPCF/Operator/QUASAR interface -- QUASAR message #22 (SETUP)
SETUP: PUSHJ P,.SAVE1 ;SAVE P1
MOVX S1,SUFSHT ;SEE IF A SHUTDOWN
TDNE S1,SUP.FL(M) ;...
JRST SHUTDN ;IF SO, SHUT IT DOWN
MOVSI P1,-PRCN ;CHECK FOR A FREE PROCESSING STREAM
SKIPN G$ADR(P1) ;A FREE STREAM?
JRST SETU.1 ;YES
AOBJN P1,.-2 ;KEEP LOOKING
STOPCD (TMS,HALT,,<Too many SETUP messages>)
;ENTERED HERE FOR LIST/SHOW QUEUE STREAM SETUP
SETU.1: MOVEM P1,CURJOB ;SAVE CURRENT STREAM
MOVEI S1,.JPAGS ;NUMBER OF PAGES
PUSHJ P,M%AQNP ;ALLOCATE CORE
PG2ADR S1 ;CONVERT PAGE NUMBER TO ADDRESS
MOVEM S1,G$ADR(P1) ;SAVE IN TABLE
MOVE R,S1 ;SET UP STREAM RELOCATION
;SET UP ACS
MOVEM R,.JBACS+R(R) ;SAVE RELOCATION
MOVSI S1,-PDLSSZ ;PDL LENGTH
HRRI S1,.JBPDL-1(R) ;ADDRESS
PUSH S1,[KILJOB] ;WHERE FINAL POPJ GOES
MOVEM S1,.JBACS+P(R) ;SAVE
;FILL IN OBJECT BLOCK
MOVEI S1,.OTNQC ;OBJECT TYPE
MOVEM S1,.JQOBJ+OBJ.TY(R)
MOVE S1,G$HNBR ;GET HOST NODE NUMBER
MOVEM S1,.JQOBJ+OBJ.ND(R) ;STUFF IN OBJECT BLOCK
HRRZM P1,.JQOBJ+OBJ.UN(R) ;STREAM NUMBER
;SET UP PSI INTERRUPT WORDS
MOVE S1,[$BGINT (1)] ;SWITCH TO INTERRUPT STACK
MOVEM S1,.JBPSR+0(R)
MOVSI S1,(MOVEI R,) ;WILL NEED RELOCATION
HRR S1,R ; TO PROCESS INTERRUPT
MOVEM S1,.JBPSR+1(R)
HRLOI S1,(JRST) ;AND A DISPATCH
MOVEM S1,.JBPSR+2(R)
;INITIALIZE BUFFER POINTERS
PUSHJ P,INIOBF ;INITIALIZE OUTPUT BUFFER STUFF
;ALL SETUP COMMON TO PROCESSING AND LISTING STREAMS MUST BE DONE
;BEFORE THIS POINT
HRRZ S1,P1 ;ISOLATE STREAM NUMBER
CAIL S1,PRCN ;IS THIS A LISTING STREAM?
POPJ P, ;YES, THAT'S ALL SHE WROTE
;SET STATE TO "IDLE"
MOVX S1,.WSIDL ;GET THE STATE
MOVEM S1,.JBWSC(R) ;PREVENT SCHEUDLING UNTIL A NEXTJOB RECEIVED
;CHECK ATTRIBUTES
MOVE S1,SUP.CN(M) ;GET CONDITION WORD (WE STUFF ATTRIBUTES THERE)
CAXE S1,%NQINP ;INPUT STREAM?
TDZA S1,S1 ;NO
MOVX S1,JB.INP ;YES
IORM S1,.JBFLG(R) ;SET THE FLAG
;FIRE UP STREAM IF INPUT
.CREF JB.INP ;BIT WE'RE TESTING
SKIPGE .JBFLG(R) ;INPUT STREAM?
; PUSHJ P,FIREUP ;YES
; MOVX S1,%RSUNA ;NOT AVAILABLE
JFCL
;SEND RESPONSE TO QUASAR'S SETUP MESSAGE
MOVX S1,%RSUOK ;TELL QUASAR ALL IS WELL
MOVE S2,SUP.CN(M) ;GET ATTRIBUTE
PUSHJ P,RSETUP ;SEND RESPONSE TO SETUP MESSAGE
POPJ P, ;ALL DONE
;The SETUP message was really a SHUTDOWN message
SHUTDN: MOVE S1,SUP.UN(M) ;GET UNIT NUMBER
MOVE S2,SUP.NO(M) ;GET NODE IDENTIFIER
PUSHJ P,FNDOBJ ;FIND THE OBJECT
POPJ P, ;DUH?
MOVX S1,JB.KIL ;KILL
IORM S1,.JBFLG(R) ; JOB
.CREF .WSRUN ;SHOW NEW STATE
SETZM .JBWSC(R) ;MAKE RUNNABLE
POPJ P, ;RETURN
SUBTTL SETUP message processing -- Response to SETUP
; Call: S1/ response code
; S2/ attribute (%NQINP or %NQOUT)
RSETUP: PUSH P,S1 ;SAVE RESPONSE CODE
PUSH P,S2 ;AND ATTRIBUTE
MOVX S1,RSU.SZ ;MESSAGE LENGTH
MOVEI S2,G$MSG ;SCRATCH SPACE
PUSHJ P,.ZCHNK ;ZERO IT OUT
MOVEI M,G$MSG ;GET THE ADDRESS
MOVX S1,RSU.SZ ;MESSAGE LENGTH
STORE S1,.MSTYP(M),MS.CNT ;STORE IT
MOVX S1,.QORSU ;MESSAGE TYPE
STORE S1,.MSTYP(M),MS.TYP ;STORE IT
MOVSI S1,.JQOBJ(R) ;ADDRESS OF OBJECT BLOCK
HRRI S1,RSU.TY(M) ;WHERE IT GOES
BLT S1,RSU.TY+OBJ.SZ-1(M) ;COPY IT TO THE RESPONSE MESSAGE
POP P,S1 ;GET ATTRIBUTE BACK
STORE S1,RSU.DA(M),RO.ATR ;PUT IN MSG
POP P,S1 ;GET RESPONSE CODE BACK
MOVEM S1,RSU.CO(M) ;STORE IT
PUSHJ P,G$SQSR ;SEND RESPONSE TO QUASAR
POPJ P, ;RETURN
SUBTTL Stream setup -- Copy request message to stream database
COPMSG: MOVX S1,PAGSIZ ;SIZE OF MESSAGE STORAGE
MOVEI S2,.JQEQP(R) ;ADDRESS OF IT
PUSHJ P,.ZCHNK ;CLEAR IT OUT
MOVS S1,M ;COPY MESSAGE ADDRESS
HRRI S1,.JQEQP(R) ;WHERE IT GOES
LOAD S2,.MSTYP(M),MS.CNT ;LENGTH OF THE MESSAGE
ADDI S2,.JQEQP(R) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY THE MESSAGE
POPJ P, ;RETURN
FNDOBJ: $SAVE <T1> ;SAVE AN AC
MOVSI T1,-PRCN ;NUMBER OF PROCESSING STREAMS
FNDO.1: SKIPN R,G$ADR(T1) ;GET THE DATABASE
JRST FNDO.2 ;NONE
CAMN S1,.JQOBJ+OBJ.UN(R) ;CHECK UNIT NUMBER
CAME S2,.JQOBJ+OBJ.ND(R) ; AND NODE IDENTIFIER
FNDO.2: AOBJN T1,FNDO.1 ;LOOP
JUMPGE T1,.POPJ ;DIDN'T FIND IT
JRST .POPJ1 ;SKIP RETURN
FNDITN: $SAVE <T1> ;SAVE AN AC
MOVSI T1,-PRCN ;NUMBER OF PROCESSING STREAMS
FNDI.1: SKIPN R,G$ADR(T1) ;GET THE DATABASE
JRST FNDI.2 ;NONE
CAME S1,.EQITN(R) ;INTERNAL TASK NAME MATCH?
FNDI.2: AOBJN T1,FNDI.1 ;LOOP
JUMPGE T1,.POPJ ;DIDN'T FIND IT
JRST .POPJ1 ;SKIP RETURN
SUBTTL IPCF/Operator/QUASAR interface -- Send to OPR or QUASAR
G$SQSR::SKIPA S2,[SI.FLG+SP.QSR] ;SEND TO [SYSTEM]QUASAR
G$SOPR::MOVE S2,[SI.FLG+SP.OPR] ;SEND TO [SYSTEM]OPERATOR
MOVEI S1,0 ;DON'T USE A REAL PID
G$SEND::MOVEM S1,G$SAB+SAB.PD ;SAVE PID
MOVEM S2,G$SAB+SAB.SI ;SAVE SPECIAL PID INDEX WORD
LOAD S1,.MSTYP(M),MS.CNT ;GET LENGTH
MOVEM S1,G$SAB+SAB.LN ;SAVE
MOVEM M,G$SAB+SAB.MS ;SAVE MESSAGE ADDRESS
SEND.0: PUSHJ P,FNDPID ;FIND THE PID IN THE RESEND QUEUE
JRST SEND.1 ;ALREADY THERE
MOVEI S1,SAB.SZ ;SAB LENGTH
MOVEI S2,G$SAB ;SAB ADDRESS
PUSHJ P,C%SEND ;SEND MESSAGE
JUMPT .POPJ ;RETURN IF NO ERRORS
CAIE S1,ERNSP$ ;NO SUCH PID?
CAIN S1,ERPWA$ ;PID WENT AWAY?
POPJ P, ;JUST GIVE UP
SEND.1: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,IPCQUE ;GET RESEND QUEUE HANDLE
PUSHJ P,L%LAST ;POSITION TO END OF LIST
MOVE M,G$SAB+SAB.MS ;GET MESSAGE ADDRESS
MOVE S2,G$SAB+SAB.LN ;GET MESSAGE LENGTH
TRNN M,PAGSIZ-1 ;MESSAGE ON A PAGE BOUNDRY?
CAIE S2,PAGSIZ ;AND A PAGE IN LENGTH?
JRST SEND.2 ;NO--RANDOM PACKET
SETZ S2, ;ONLY SAVE THE SAB
SEND.2: ADDI S2,SAB.SZ ;PLUS THE SAB
MOVE P1,S2 ;SAVE ENTRY SIZE
MOVE S1,IPCQUE ;GET LINKED LIST HANDLE AGAIN
PUSHJ P,L%CENT ;CREATE LIST ENTRY
SKIPT ;DID IT WORK?
STOPCD (CCE,HALT,,<Can't create list entry>)
MOVSI S1,G$SAB ;POINT TO THE SAB
HRRI S1,(S2) ;AND TO THE LINKED LIST STORAGE
BLT S1,SAB.SZ-1(S2) ;COPY SAB
CAIG P1,SAB.SZ ;SAVING JUST THE SAB (PAGE MODE)?
JRST SEND.3 ;YES
MOVSI S1,(M) ;POINT TO MESSAGE
HRRI S1,SAB.SZ(S2) ;POINT PAST THE SAB STORAGE
ADD S2,G$SAB+SAB.LN ;COMPUTE END BLT ADDRESS
BLT S1,SAB.SZ-1(S2) ;COPY MESSAGE INTO LIST
SEND.3: AOS RSENDC ;COUNT THE RESEND NEEDED LATER
POPJ P, ;RETURN
FNDPID: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,G$SAB+SAB.PD ;GET PID
MOVE P2,G$SAB+SAB.SI ;GET SPECIAL INDEX WORD
MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
PUSHJ P,L%FIRS ;POSITION TO FIRST ENTRY
JRST FNDP.2 ;ENTER LOOP
FNDP.1: MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
PUSHJ P,L%NEXT ;POSITION TO NEXT ENTRY
FNDP.2: JUMPF .POPJ1 ;RETURN IF END OF LIST
CAMN P1,SAB.PD(S2) ;BOTH THE PID
CAME P2,SAB.SI(S2) ;AND THE INDEX MUST MATCH
JRST FNDP.1 ;KEEP SEARCHING
POPJ P, ;RETURN
SUBTTL Find an idle processing or listing stream
;This nonsense is required because a SETUP message does nothing
;really useful other than create the stream database. When a
;NEXTJOB message is received, we have to find a idle processing
;stream to run the job in.
;Call:
; PUSHJ P,FNDPRC
; <Return if no free streams>
; <Return if found a free stream>
; R/ Address of stream database
FNDPRC: MOVSI S1,-PRCN ;NUMBER OF PROCESSING STREAMS
MOVX S2,.WSIDL ;WAIT STATE WE REQUIRE
SKIPE R,G$ADR(S1) ;IS THERE A STREAM THERE?
CAME S2,.JBWSC(R) ;YES, IT IT IDLE?
AOBJN S1,.-2 ;NO, KEEP LOOKING
JUMPGE S1,.POPJ ;RETURN IF DIDN'T FIND IDLE STREAM (QUASAR ERROR?)
JRST .POPJ1 ;SKIP RETURN
;Listing streams are somewhat easier. We create them as
;needed as we receive LIST request messages.
;Call:
; PUSHJ P,FNDLST
; <Return if no free listing streams>
; <Return if found a free stream>
; S1/ Stream index
FNDLST: MOVE S1,[-LSTN,,PRCN] ;LISTING STREAMS FOLLOWING PROCESSING STREAMS
SKIPN R,G$ADR(S1) ;IS THIS ONE FREE?
JRST .POPJ1 ;YES
AOBJN S1,.-2 ;KEEP LOOKING
POPJ P, ;NO FREE LISTING STREAMS
SUBTTL Select a network driver
;Routine to select a network driver to process a request.
;Call:
; S1/ Node name
; PUSHJ P,SELDRV
; <Here if no driver can handle specified node>
; <Here with I/O driver vector filled in>
SELDRV: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,NETIOV ;GET START OF NETWORK I/O DRIVER CHAIN
SKIPA P2,S1 ;COPY THE NODE NAME
SELD.1: MOVE S1,P2 ;GET THE NODE NAME BACK
PUSHJ P,@.IOINF(P1) ;CAN THIS DRIVER HANDLE IT?
SKIPA P1,.IOLNK(P1) ;NO, GET LINK TO NEXT
JRST SELD.2 ;YES
JUMPN P1,SELD.1 ;LOOP IF MORE DRIVERS
POPJ P, ;CAN'T HANDLE IT, NON-SKIP RETURN
SELD.2: MOVSI S1,(P1) ;POINT TO I/O DRIVER VECTOR
HRRI S1,.JNIOV(R) ;MAKE A BLT POINTER
BLT S1,.JNIOV+.IOLEN-1(R) ;COPY
JRST .POPJ1 ;RETURN
SUBTTL Initialization
INITIA: MOVE S1,[%%.MOD] ;GET OUR PROGRAM NAME
MOVEM S1,G$PGM ;SAVE
MOVEI S1,[ITEXT (<[SYSTEM]>)] ;PRODUCTION NAME
SKIPE DEBUGW ;DEBUGGING?
MOVEI S1,[ITEXT (<^U/DEBUGW/>)] ;YES
LOAD S2,PIB+PB.FLG,IP.SPF ;GET SYSTEM PID BIT
CAIE S2,1 ;SYSTEM PID?
MOVEI S1,[ITEXT (<>)] ;NO
$TEXT (<-1,,G$NAM>,<^I/(S1)/^W/[%%.MOD]/^0>) ;GENERATE NAME
PUSHJ P,L%CLST ;CREATE A NEW ONE
MOVEM S1,IPCQUE ;SAVE HANDLE
INITI1: MOVEI S1,SP.QSR ;GET PID INDEX FOR [SYSTEM]QUASAR
PUSHJ P,C%RPRM ;ASK FOR THE PID
JUMPF INITI1 ;WAIT FOR QUASAR
MOVEM S1,QSRPIB+PB.PID ;SAVE FOR IN BEHALF OF QUASAR SENDS
PUSHJ P,I%HOST ;GET NAME OF HOST NODE
MOVEM S1,G$HNAM ;SAVE IT
MOVEM S2,G$HNBR ;DITTO FOR NUMBER
MOVE S1,[%LDQUE] ;NEED THE QUEUE PPN
GETTAB S1, ;ASK MONITOR
MOVE S1,[3,,3] ;DEFAULT
SKIPE DEBUGW ;DEBUGGING?
MOVEI S1,0 ;YES--USE OUR PPN
MOVEM S1,G$QPPN ;SAVE
MOVE S1,[%LDSPP] ;NEED THE SPOOLED FILE PROTECTION
GETTAB S1, ;ASK MONITOR
MOVSI S1,(<077>B8) ;DEFAULT TO <077>
MOVEM S1,G$QPRT ;SAVE
MOVSI S1,-5 ;AOBJN POINTER
INITI2: HRLZ S2,S1 ;GET OFFSET
ADD S2,[%CNFG0] ;FORM GETTAB ARGUMENT
GETTAB S2, ;FETCH WORD OF MONITOR NAME
SETZ S2, ;???
MOVEM S2,CONFIG(S1) ;STUFF AWAY
AOBJN S1,INITI2 ;LOOP
MOVEI S1,IPCINT ;IPCF INTERRUPT ROUTINE
MOVEM S1,IPCVEC+.PSVNP
MOVEI S1,TIMINT ;TIMER INTERRUPT ROUTINE
MOVEM S1,TIMVEC+.PSVNP
HRREI T1,.PCTMR ;CONDITION CODE
MOVSI T2,<TIMVEC-VECTOR> ;OFFSET,,0
MOVSI T3,TIMLVL ;INTERRUPT PRIORITY LEVEL
MOVE S1,[PS.FAC+T1] ;ADD CONDITION BIT + ADDRESS
PISYS. S1, ;PUT TIMER ON INTERRUPT SYSTEM
JSP S2,UUOERR ;FAILED
SKIPN R,NETIOV ;POINT TO START OF NETWORK I/O VECTORS
STOPCD (NID,HALT,,<No I/O drivers included>)
INITI3: PUSHJ P,@.IOINI(R) ;INITIALIZE
$WTO (<^T/G$NAM/ error>,<^T/@.IONAM(R)/ initialization failure>,,<$WTFLG(WT.SJI)>)
SKIPE R,.IOLNK(R) ;GET ADDRESS OF NEXT
JRST INITI3 ;LOOP
POPJ P, ;RETURN
SUBTTL PSI system control
;ASSIGN PSI VECTOR BLOCKS
;CALL: PUSHJ P,PSIAVG ;ASSIGN GLOBAL VECTOR
; PUSHJ P,PSIAVJ ;ASSIGN JOB VECTOR
; <ERROR> ;NONE AVAILABLE
; <SKIP> ;S1 HAS ADDRESS OF ZEROED VECTOR BLOCK
; ;S2 HAS -OFFSET,,0
PSIAVG::SKIPA S1,[-GLBPSV,,GLBVEC] ;POINTER TO GLOBAL VECTORS
PSIAVJ::MOVE S1,[-JOBPSV,,JOBVEC] ;POINTER TO JOB VECTORS
PSIAV1: SKIPN .PSVNP(S1) ;VECTOR IN USE?
JRST PSIAV2 ;NO
ADDI S1,3 ;ACCOUNT FOR MULTI-WORD BLOCKS
AOBJN S1,PSIAV1 ;LOOP
POPJ P, ;NONE AVAILABLE
PSIAV2: HRRZS S1 ;STRIP OFF COUNT
SETZM .PSVOP(S1) ;CLEAR OLD PC
SETZM .PSVFL(S1) ;CLEAR FLAGS
SETZM .PSVIS(S1) ;CLEAR STATUS
MOVSI S2,-VECTOR(S1) ;GET OFFSET IN LH OF S2
JRST .POPJ1 ;RETURN
;DEASSIGN PSI VECTOR BLOCKS
PSIDVJ::MOVE S1,.JBPSI(R) ;GET PSI BLOCK ADDRESS
PSIDVG::SETZM .PSVNP(S1) ;CLEAR NEW PC
POPJ P, ;RETURN
SUBTTL Job processing -- Remote CREATE request
RCREAT: PUSHJ P,@.JNIOV+.IOOPN(R) ;OPEN A LINK TO REMOTE
JRST RCRE.9 ;OPEN FAILED, REQUEUE US
PUSHJ P,CONMSG ;TELL THE WORLD WE'RE CONNECTED
$WTOJ (Begin,<^R/.EQJBB(R)/>,.JQOBJ(R))
PUSHJ P,LOGINI ;INIT RUN LOG STUFF
;Steps in request creation:
; Connect to remote DJM
; Send create message
; For each file,
; Send FILESPEC message
; Send FILEDATA message(s)
; Send EOF message
; Send EOR message
; Receive ERROR or SUMMARY message
; Send COMMIT message (no errors) or WITHDRAW message (errors)
; Receive END message from remote DJM
; Disconnect from remote DJM
;AC usage in this routine:
;
; P1/ Number of files in this request
; P2/ Address of current FP
; P3/ Address of current FD
MOVX S1,.MTCRE ;TYPE = CREATE REQUEST
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
;Job number
MOVX S1,.BTRJN ;TYPE = REQUESTOR JOB NUMBER
MOVE S2,.EQRID(R) ;USE REQUEST NUMBER
PUSHJ P,G$PWRD ;STUFF IT
;Job name
$TEXT <-1,,TMPBUF>,<^W/.EQJOB(R)/^0>
MOVX S1,.BTJNA ;TYPE = JOB NAME
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF IT
;Job owner
$TEXT <-1,,TMPBUF>,<^W/G$HNAM/::^W6/.EQOWN(R)/^W/.EQOWN+1(R)/^0>
MOVX S1,.BTJOW ;TYPE = JOB OWNER
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF IT
;Queue name
$TEXT <-1,,TMPBUF>,<^Q/QUENAM/^0>
MOVX S1,.BTQUE ;TYPE = QUEUE NAME
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF IT
;Priority
MOVX S1,.BTPRI ;TYPE = PRIORITY
LOAD S2,.EQSEQ(R),EQ.PRI ;GET EXTERNAL PRIORITY
CAILE S2,4 ;IN RANGE FOR DQS?
MOVEI S2,4 ;NO, USE THE MAXIMUM
PUSHJ P,G$PWRD ;STUFF IT
;Characteristics
MOVEI S1,.EQCHR(R) ;ADDRESS OF STRING
SKIPN (S1) ;CHARACTERISTICS SPECIFIED?
MOVEI S1,[ASCIZ /LANDSCAPE/] ;NO, USE A DEFAULT
PUSHJ P,CNVCHR## ;CONVERT CHARACTERISTICS STRING TO BITMAP
JUMPF RCRE.A ;ERROR
HRLI S1,(POINT 8) ;SET BYTE POINTER
MOVE S2,S1 ;WHERE IT BELONGS
MOVE S1,[.LNCHR,,.BTCHR] ;LENGTH = 16, TYPE = CHARACTERISTICS
PUSHJ P,G$PCST ;STUFF IT
;Forms code
MOVEI S1,.EQFRM(R) ;ADDRESS OF STRING
SKIPN (S1) ;FORMS SPECIFIED?
MOVEI S1,[ASCIZ /NORMAL/] ;NO, USE A DEFAULT
PUSHJ P,CNVFRM## ;CONVERT FORMS TYPE STRING
JUMPF RCRE.A ;ERROR
MOVE S2,S1 ;WHERE G$PBYT WANTS IT
MOVX S1,.BTFRM ;TYPE = FORMS CODE
PUSHJ P,G$PBYT ;STUFF IT
;Notify action
MOVX S1,.BTNOA ;TYPE = NOTIFY ACTION
MOVEI S2,NA.CMP!NA.CHG ;NOTIFY ON COMPLETION OR CHANGE
PUSHJ P,G$PBYT ;STUFF IT
;Time queued
$TEXT <-1,,TMPBUF>,<^H9/.EQAFT(R)/^0> ;JUST DD-MMM-YY PART OF DATE/TIME
MOVE S2,[POINT 7,TMPBUF+1,13] ;NOW "VAX-IZE" THE YEAR
ILDB TF,S2 ;GET FIRST CHARACTER
ILDB S1,S2 ;GET SECOND CHARACTER
MOVE S2,[POINT 7,TMPBUF+1,13] ;BACK TO START
MOVEI T1,"1" ;THIS CENTURY
IDPB T1,S2
MOVEI T1,"9"
IDPB T1,S2
IDPB TF,S2 ;NOW ADD IN 2 DIGITS OF YEAR
IDPB S1,S2
MOVEM S2,TMPPTR ;SAVE THE BYTE POINTER
$TEXT TMPDPB,< ^C/.EQAFT(R)/^0> ;NOW INCLUDE THE TIME
MOVX S1,.BTTMQ ;TYPE = AFTER TIME
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF IT
;Note string
GETLIM S1,.EQLIM(R),NOT1 ;GET THE FIRST HALF OF /NOTE:
GETLIM S2,.EQLIM(R),NOT2 ;GET THE SECOND HALF
SKIPN S1 ;SKIP IF NOT NULL
JUMPE S2,RCRE.0 ;IF NULL, IGNORE IT
$TEXT <-1,,TMPBUF>,<^W6/S1/^W/S2/^0>
MOVX S1,.BTNOT ;TYPE = NOTE
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF IT
RCRE.0: PUSHJ P,FINMSG ;FINISH MESSAGE
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND OUTPUT DATA
PJRST ABORTJ ;ABORT THE JOB
;Now loop for each file, sending a FILESPEC message, one or more
;FILEDATA messages, and an EOF message.
LOAD P1,.EQSPC(R),EQ.NUM ;GET NUMBER OF FILES
LOAD P2,.EQLEN(R),EQ.LOH ;GET LENGTH OF HEADER
ADD P2,R ;POINT AT FIRST FP
MOVE P3,P2 ;COPY IT
LOAD S1,.FPLEN(P2),FP.LEN ;GET LENGTH OF THE FP
ADD P3,S1 ;POINT AT FIRST FD
RCRE.1: PUSHJ P,@.JNIOV+.IOSIA(R) ;HAS THE DJM OBJECTED TO SOMETHING IT ATE?
SKIPA ;NOPE, ALL IS WELL
JSP S1,RCRE.E ;YES, HANDLE DJM INDIGESTION
AOS .JQRFN(R) ;INCREMENT RELATIVE FILE NUMBER
MOVEM P3,.JQCFD(R) ;SAVE CURRENT FD ADDRESS
PUSHJ P,FSTATU ;TELL QUASAR OUR NEW STATUS
PUSHJ P,SNDFSP ;SEND FILESPEC MESSAGE
PUSHJ P,INPOPN ;OPEN THE NEXT FILE
JRST RCRE.6 ;ERROR
;Output the data here (similar to calling G$PSTG)
RCRE.2: PUSHJ P,@.JNIOV+.IOSIA(R) ;HAS THE DJM OBJECTED TO SOMETHING IT ATE?
SKIPA ;NOPE, ALL IS WELL
JSP S1,RCRE.E ;YES, HANDLE DJM INDIGESTION
MOVX S1,.MTFDT ;TYPE = FILEDATA
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
AOS BLKCNT ;COUNT ANOTHER BLOCK
MOVX S1,.BTDAT ;TYPE = FILEDATA
PUSHJ P,PUTBYT ;STUFF THE BLOCK TYPE
PUSH P,.JIOBP(R) ;SAVE THE POINTER TO THE HIGH ORDER LENGTH BYTE
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;STORE LENGTH OF ZERO TEMPORARILY
PUSHJ P,PUTBYT ;...
PUSH P,.JIOBC(R) ;SAVE OUTPUT BYTE COUNT
MOVE T1,.JIOBC(R) ;GET MAXIMUM NUMBER OF BYTES WE CAN SEND IN MSG
SETZ P4, ;ASSUME WE'LL HIT EOF THIS BUFFER FULL
RCRE.3: MOVE S1,.JFIFN(R) ;GET IFN
PUSHJ P,F%IBYT ;GET A BYTE
JUMPF RCRE.4 ;END OF FILE PROBABLY
SKIPN S1,S2 ;COPY THE CHARACTER
JRST RCRE.3 ;NULL, THROW IT AWAY
PUSHJ P,PUTBYT ;STUFF THE BYTE
SOJG T1,RCRE.3 ;LOOP FOR THE REST WE CAN DO
SETO P4, ;REMEMBER THERE'S MORE OUTPUT TO DO
RCRE.4: POP P,S1 ;GET BYTE COUNT BEFORE STRING
SUB S1,.JIOBC(R) ;MINUS NUMBER LEFT GIVES NUMBER STORED
ADDM S1,.JQBYT(R) ;INCLUDE IN COUNT SENT
POP P,S2 ;RETRIEVE BYTE POINTER TO LENGTH BYTE
ROT S1,-^D8 ;SHIFT HIGH BYTE OVER
IDPB S1,S2 ;STORE THE HIGH ORDER LENGTH BYTE
ROT S1,^D8 ;SHIFT LOW BYTE BACK
IDPB S1,S2 ;STORE THE LOW ORDER LENGTH BYTE
PUSHJ P,FINMSG ;FINISH MESSAGE
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND THE DATA
PJRST ABORTJ ;ABORT THE JOB
JUMPE P4,RCRE.5 ;JUMP IF NOTHING MORE TO DO
AOS S1,.JBFCT(R) ;BUMP FAIRNESS COUNTER
CAXLE S1,OUTFCT ;TIME TO DESCHED?
PUSHJ P,WSCHED ;GIVE OTHER STREAMS A CHANCE
JRST RCRE.2 ;LOOP FOR MORE OUTPUT
RCRE.5: MOVE S1,.JFIFN(R) ;GET IFN
PUSHJ P,F%REL ;RELEASE THE FILE
$TEXT (LOGCHR,<^I/NBMSG/Finished file ^F/(P3)/>)
JRST RCRE.7 ;DONE
;File LOOKUP error
RCRE.6: $TEXT (LOGCHR,<^I/NBERR/Can't access file ^F/0(P3)/, ^E/[-1]/^0>)
$TEXT (<-1,,TMPBUF>,<Can't access file ^F/0(P3)/, ^E/[-1]/^0>)
MOVX S1,.MTFDT ;TYPE = FILEDATA
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
MOVX S1,.BTDAT ;TYPE = DATA TRANSFER
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF THE STRING
PUSHJ P,FINMSG ;FINISH UP MESSAGE
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND OUTPUT DATA
PJRST ABORTJ ;ABORT THE JOB
RCRE.7: PUSHJ P,@.JNIOV+.IOSIA(R) ;HAS THE DJM OBJECTED TO SOMETHING IT ATE?
SKIPA ;NOPE, ALL IS WELL
JSP S1,RCRE.E ;YES, HANDLE DJM INDIGESTION
MOVX S1,.MTEOF ;TYPE = END OF FILE
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
PUSHJ P,FINMSG ;FINISH UP MESSAGE (NO BODY)
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND OUTPUT DATA
PJRST ABORTJ ;ABORT THE JOB
SOJLE P1,RCRE.8 ;DONE IF NO MORE FILES
LOAD S1,.FDLEN(P3),FD.LEN ;GET LENGTH OF FD
ADD P3,S1 ;POINT AT NEXT FP
MOVE P2,P3 ;GET A COPY
LOAD S1,.FPLEN(P2),FP.LEN ;GET LENGTH OF THE FP
ADD P3,S1 ;POINT TO NEXT FD
JRST RCRE.1 ;GO PROCESS NEXT FILE
;All the files have been sent, send the END (COMMIT) message
RCRE.8: PUSHJ P,LOGSUM ;GENERATE RUN LOG SUMMARY
MOVX S1,.MTEOR ;TYPE = END OF RECORD
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
PUSHJ P,FINMSG ;FINISH UP MESSAGE (NO BODY)
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND THE MESSAGE
PJRST ABORTJ ;ABORT THE JOB
;Now wait for a response from the DJM
PUSHJ P,@.JNIOV+.IOINP(R) ;GET SOME INPUT
PJRST ABORTJ ;ABORT THE JOB
LDB S1,P.ITYP ;GET MESSAGE TYPE
CAIE S1,.MTSUM ;SUMMARY MESSAGE?
PJRST ABORTJ ;ABORT THE JOB
;MIGHT WANT TO PROPAGATE REMOTE REQUEST (JOB) NUMBER TO QUEUER?
MOVX S1,.MTCOM ;TYPE = COMMIT
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
PUSHJ P,FINMSG ;FINISH UP MESSAGE (NO BODY)
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND THE MESSAGE
PJRST ABORTJ ;ABORT THE JOB
PUSHJ P,@.JNIOV+.IOINP(R) ;GET SOME INPUT
PJRST ABORTJ ;ABORT THE JOB
LDB S1,P.ITYP ;GET MESSAGE TYPE
CAIE S1,.MTEND ;END MESSAGE?
PJRST ABORTJ ;ABORT THE JOB
PUSHJ P,FILDIS ;DISPOSE OF SPOOLED FILES
$WTOJ (End,<^R/.JQEQP+.EQJBB(R)/>,.JQOBJ(R))
PUSHJ P,RLSMSG ;SEND RELEASE MESSAGE
RCRE.X: PUSHJ P,@.JNIOV+.IOCLS(R) ;DO DISCONNECT
PJRST ABORTJ ;ABORT JOB
PJRST DISMSG ;GENERATE DISCONNECT MESSAGE AND RETURN
;Remote node not accessible
RCRE.9: $WTO (<Job requeued>,<Node ^N/.JBNOD(R)/ not accessible^I/0(S1)/>,.JQOBJ(R))
PJRST REQMSG ;SEND REQUEUE MESSAGE TO QUASAR AND RETURN
QUENAM: POINT 8, .EQQNM(R) ;WHERE QUASAR STUFFS THE QUEUE NAME FOR US
;CNFCHR or CNVFRM gave an error return; clunk the job
RCRE.A: HRRZ S1,CFERRT##(S1) ;GET THE ASCII ERROR TEXT
$WTO (<Job aborted>,<^T/0(S1)/>,.JQOBJ(R))
JRST RCRE.K ;KLUNK THE JOB
;DJM sent something back, probably an error message
RCRE.E: PUSHJ P,@.JNIOV+.IOINP(R) ;GET THE INPUT
PJRST ABORTJ ;WHAT?!
LDB S1,P.ITYP ;GET THE MESSAGE TYPE
CAXE S1,.MTERR ;ERROR MESSAGE?
JRST RCRE.P ;NO, PROTOCOL ERROR
PUSHJ P,UNPERR ;UNPACK THE ERROR MESSAGE
$WTO (<^T/G$NAM/ error>,<Remote DJM rejected request^M^J^T/ERRBUF/>,.JQOBJ(R))
MOVE S1,ERRLVL ;GET ERROR LEVEL
CAXE S1,.ELFAT ;FATAL ERROR?
JRST RCRE.R ;NO, PROBABLY SAFE TO REQUEUE IT
RCRE.K: $WTOJ (Abort,<^R/.JQEQP+.EQJBB(R)/>,.JQOBJ(R))
PUSHJ P,RLSMSG ;FAKE LIKE WE FINISHED IT
JRST RCRE.X ;QUIT WHILE WE'RE AHEAD
RCRE.P: $WTO (<^T/G$NAM/ error>,<DQS protocol error>,.JQOBJ(R))
RCRE.R: PUSHJ P,REQMSG ;SEND REQUEUE MESSAGE
JRST RCRE.X ;QUIT WHILE WE'RE AHEAD
SUBTTL Remote create routines -- Open input file
INPOPN: MOVX S1,FOB.SZ ;GET THE FOB SIZE
MOVEI S2,.JFFOB(R) ;AND THE FOR ADDRESS
PUSHJ P,.ZCHNK ;ZERO IT OUT
MOVEM P3,.JFFOB+FOB.FD(R) ;SAVE FD ADDRESS
MOVEI S1,7 ;LOAD NORMAL BYTE SIZE
STORE S1,.JFFOB+FOB.CW(R),FB.BSZ ;AND SAVE THE BYTE SIZE
SETZM .JFFOB+FOB.US(R) ;DEFAULT TO NO ACCESS CHECKING
SETZM .JFFOB+FOB.CD(R) ;HERE ALSO
LOAD S1,.EQSEQ(R),EQ.PRV ;GET THE USERS PRIVILEGE BITS
JUMPN S1,INPO.1 ;IF SET, AVOID ACCESS CHECK
LOAD S1,.FPINF(P2),FP.SPL ;LIKEWISE IF SPOOLED
JUMPN S1,INPO.1 ; ...
MOVE S1,.EQOID(R) ;GET THE PPN
MOVEM S1,.JFFOB+FOB.US(R) ;AND SAVE IT
INPO.1: MOVX S1,FOB.SZ ;GET FOB SIZE
MOVEI S2,.JFFOB(R) ;AND ADDRESS
PUSHJ P,F%IOPN ;OPEN THE FILE
JUMPF INPO.2 ;JUMP IF FAILED
MOVEM S1,.JFIFN(R) ;ELSE, SAVE THE IFN
JRST .POPJ1 ;AND RETURN
INPO.2: ZERO .FPINF(P2),FP.DEL ;CLEAR THE 'DELETE FILE' BIT
POPJ P, ;RETURN
SUBTTL Remote create routines -- Send FILESPEC message
SNDFSP: MOVE S1,.FPINF(P2) ;GET FLAGS FOR FILE
TXNE S1,FP.REN ;IS IT /DISPOSE:RENAME?
JRST SFSP.3 ;YES, PROCESS THAT
TXNN S1,FP.SPL ;IS IT A SPOOLED FILE?
JRST SFSP.2 ;NO, CONTINUE ON
TXNN S1,FP.FLG ;IS IT ALSO A LOG FILE?
JRST SFSP.1 ;NO, JUST A PLAIN SPOOLED FILE
CAIE P2,LOGFP ;SPOOLED BATCH LOG?
$TEXT (<-1,,TMPBUF>,<Batch Log File^0>)
CAIN P2,LOGFP ;CHECK AGAIN
$TEXT (<-1,,TMPBUF>,<NEBULA Run Log^0>)
JRST SFSP.5 ;CONTINUE
SFSP.1: MOVE S1,.JFIFN(R) ;GET THE FILE'S IFN
MOVX S2,FI.SPL ;GET THE SPOOL NAME INFO CODE
$CALL F%INFO ;GET THE SPOOLED NAME
JUMPE S1,SFSP.4 ;NOTHING
$TEXT (<-1,,TMPBUF>,<^W/S1/^0>) ;GENERATE THE SPOOLED NAME
JRST SFSP.5 ;CONTINUE
SFSP.2: $TEXT (<-1,,TMPBUF>,<^W/.FDNAM(P3)/.^W3/.FDEXT(P3)/^0>)
JRST SFSP.5 ;CONTINUE
SFSP.3: $TEXT (<-1,,TMPBUF>,<^W/.FPONM(P2)/.^W3/.FPOXT(P2)/^0>)
JRST SFSP.5 ;CONTINUE
SFSP.4: $TEXT (<-1,,TMPBUF>,<Spooled Printer File^0>)
SFSP.5: MOVX S1,.MTFSP ;TYPE = FILE SPEC
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
;Filename string
MOVX S1,.BTFNM ;TYPE = FILENAME
MOVE S2,[POINT 7,TMPBUF]
PUSHJ P,G$PSTG ;STUFF IT
;Data type
MOVX S1,.BTFTY ;TYPE = DATA TYPE
SETZ S2, ;I DON'T KNOW
PUSHJ P,G$PBYT ;STUFF IT
;Copy count
MOVX S1,.BTFCC ;TYPE = COPY COUNT
LOAD S2,.FPINF(P2),FP.FCY ;GET THE COUNT
CAILE S2,1 ;DON'T BOTHER IF JUST ONE COPY
PUSHJ P,G$PWRD ;STUFF IT
;Separator
MOVX S1,.BTFSE ;TYPE = SEPARATOR
MOVE S2,.FPINF(P2) ;GET FILE INFO BITS
TXNE S2,FP.NFH ;NO FILE HEADERS?
TDZA S2,S2 ;YES, CLEAR S2 AND SKIP
MOVX S2,SE.HDR ;GET THE HEADER BIT
IFN FTFBST,<
TRO S2,SE.BST ;SET THE "BURST" FLAG
>
IFN FTFTRL,<
TRO S2,SE.TRL ;SET THE "TRAILER" FLAG
>
PUSHJ P,G$PBYT ;STUFF IT
;Blank lines
MOVX S1,.BTFBL ;TYPE = BLANK LINE COUNT
LOAD S2,.FPINF(P2),FP.FSP ;GET THE SPACING
SUBI S2,1 ;CONVERT TO NUMBER OF BLANK LINES
PUSHJ P,G$PBYT ;STUFF IT
;Page options
MOVX S1,.BTFPO ;TYPE = PAGE OPTIONS
SETZ S2, ;NONE YET
PUSHJ P,G$PBYT ;STUFF IT
;Start page
MOVX S1,.BTFSP ;TYPE = START PAGE
MOVE S2,.FPFST(P2) ;GET STARTING PAGE
CAILE S2,1 ;DON'T BOTHER IF STARTING AT BEGINNING
PUSHJ P,G$PWRD ;STUFF IT
;End of blocks
PUSHJ P,FINMSG ;FINISH MESSAGE
PUSHJ P,@.JNIOV+.IOOUT(R) ;OUTPUT IT
PJRST ABORTJ ;ABORT THE JOB
CAIE P2,LOGFP ;NEBULA RUN LOG?
$TEXT (LOGCHR,<^I/NBMSG/Starting file ^F/(P3)/>)
POPJ P, ;EVENTUALLY
SUBTTL Remote create routines -- Dispose of spooled files
FILDIS: LOAD P3,.EQLEN(R),EQ.LOH ;GET THE HEADER LENGTH
ADD P3,R ;POINT TO FIRST FILE
LOAD T1,.EQSPC(R),EQ.NUM ;GET THE NUMBER OF FILES
FILD.1: MOVE T2,.FPINF(P3) ;GET THE FILE INFO BITS
LOAD S2,.FPLEN(P3),FP.LEN ;GET THE FILE INFO LENGTH
ADD P3,S2 ;POINT TO FILE SPEC
MOVEM P3,.JFFOB+FOB.FD(R) ;SAVE THE FD ADDRESS IN THE FOB
LOAD S2,.FPLEN(P3),FD.LEN ;GET THE FD LENGTH
ADD P3,S2 ;POINT P3 AT NEXT FILE
SETZM .JFFOB+FOB.US(R) ;DEFAULT TO NO ACCESS CHECKING
SETZM .JFFOB+FOB.CD(R) ;HERE ALSO
LOAD S1,.EQSEQ(R),EQ.PRV ;GET THE USERS PRIVILGE BITS
JUMPN S1,FILD.2 ;IF SET, AVOID ACCESS CHECK
TXNE T2,FP.SPL ;WAS IT A SPOOLED FILE?
JRST FILD.2 ;YES,,THEN NO ACCESS CHECK
MOVE S1,.EQOID(R) ;GET THE PPN
MOVEM S1,.JFFOB+FOB.US(R) ;AND SAVE IT
FILD.2: MOVX S1,FOB.SZ ;GET THE FOB LENGTH
MOVEI S2,.JFFOB(R) ;AND THE FOB ADDRESS
TXNE T2,FP.SPL ;SPOOL FILE?
JRST FILD.3 ;YES, DELETE THE FILE IN ANY CASE
TXNE T2,FP.DEL ;/DELETE?
FILD.3: $CALL F%DEL ;YES, HERE TO DELETE
SOJG T1,FILD.1 ;GO PROCESS THE NEXT FILE
$RETT ;RETURN
SUBTTL Remote create routines -- Send release message
RLSMSG: MOVX S1,REL.SZ ;MESSAGE LENGTH
MOVEI S2,G$MSG ;SCRATCH SPACE
PUSHJ P,.ZCHNK ;ZERO IT OUT
MOVEI M,G$MSG ;POINT AT SCRATCH SPACE
MOVX S1,REL.SZ ;SIZE OF MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;STORE SIZE
MOVX S1,.QOREL ;TYPE OF MESSAGE
STORE S1,.MSTYP(M),MS.TYP ;STORE TYPE
MOVE S1,.EQITN(R) ;GET INTERNAL TASK NAME
MOVEM S1,REL.IT(M) ;STUFF IT
;ANY TEXT FROM THE DJM'S RESPONSE?
PUSHJ P,G$SQSR ;TELL QUASAR
SKIPE S1,.JRLNK(R) ;HAVE A RUN LOG?
PUSHJ P,L%DLST ;DELETE IT
SETZM .JRLNK(R) ;INVALIDATE
POPJ P, ;RETURN
SUBTTL Run Log routines -- LOGINI - Initialize at start of job
LOGINI: POPJ P, ;*** TEMP ***
PUSHJ P,L%CLST ;CREATE LINKED LIST
JUMPF .POPJ ;RETURN ON ERRORS
MOVEM S1,.JRLNK(R) ;SAVE HANDLE FOR POSTERITY
$TEXT (LOGCHR,<^T/LOGHDR/>)
MOVE T1,.JBVER ;OUR VERSION
MOVE T2,G$HNBR ;OUR NODE
MOVEI T3,CONFIG ;MONITOR NAME
$TEXT (LOGCHR,<^I/NBCFG/NEBULA %^V/T1/ ^N/T2/ ^T/(T3)/>)
MOVEI T1,@.JNIOV+.IONAM(R) ;POINT TO NAME STRING
MOVE T2,.JBNOD(R) ;NODE NAME
MOVEI T3,[ITEXT ()] ;NULL ITEXT
IFN OLDDQS,<
MOVX S1,JB.OLD ;
TDNE S1,.JBFLG(R) ;TALKING TO THE OLD VERSION?
MOVEI T3,[ITEXT (< (old Distributed Job Manager)>)]
>
$TEXT (LOGCHR,<^I/NBNET/Connected via ^T/(T1)/ to node ^N/T2/^I/(T3)/>)
MOVE T1,.JQEQP+.EQJOB(R) ;JOB NAME
LOAD T2,.JQEQP+.EQSEQ(R),EQ.SEQ ;SEQUENCE NUMBER
MOVEI T3,.JQOBJ(R) ;OBJECT BLOCK
$TEXT (LOGCHR,<^I/NBJOB/Job /^W/T1/ sequence #^D/T2/ running in ^B/@T3/>)
MOVE T1,.JQEQP+.EQAFT(R) ;REQUEST CREATION DATE/TIME
MOVEI T2,.JQEQP+.EQACT(R) ;ACCOUNT STRING
$TEXT (LOGCHR,<^I/NBJOB/Request created ^H/T1/ Account "^T/(T2)/">)
MOVEI T1,.JQEQP+.EQUSR(R) ;USER NAME
HRLI T1,(POINT 8,) ;8-BIT ASCII
SKIPE .JQEQP+.EQUSR(R) ;HAVE SOMETHING?
$TEXT (LOGCHR,<^I/NBJOB/Spooled for ^Q/T1/>)
MOVEI T1,.JQEQP+.EQBOX(R) ;DISTRIBUTION
HRLI T1,(POINT 8,) ;8-BIT ASCII
SKIPE .JQEQP+.EQBOX(R) ;HAVE SOMETHING?
$TEXT (LOGCHR,<^I/NBJOB/Distribution to ^Q/T1/>)
POPJ P, ;RETURN
SUBTTL Run Log routines -- LOGCHR - Character output
LOGCHR::SKIPN .JRLNK(R) ;WANT RUN LOG?
$RETT ;NO
SOSL .JRCNT(R) ;COUNT CHARACTERS
JRST LOGCH1 ;GO STORE
PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
MOVE S1,.JRLNK(R) ;GET LINKED LIST HANDLE
MOVEI S2,RLGBSZ ;BUFFER SIZE
PUSHJ P,L%CENT ;CREATE AN ENTRY
JUMPF LOGCH2 ;FAILED
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM S2,.JRPTR(R) ;SAVE
MOVEI S2,<RLGBSZ*5>-1 ;BYTE COUNT
MOVEM S2,.JRCNT(R) ;SAVE
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
LOGCH1: IDPB S1,.JRPTR(R) ;STUFF CHARACTER AWAY
$RETT ;RETURN
LOGCH2: MOVX S1,JB.RLE ;BIT TO SET
IORM S1,.JBFLG(R) ;REMBER FOR LATER
SKIPE S1,.JRLNK(R) ;GET LINKED LIST HANDLE IF ANY
PUSHJ P,L%DLST ;DELETE LIST
SETZM .JRLNK(R) ;INVALIDATE
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
$RETT ;RETURN
SUBTTL Run Log routines -- LOGSUM - Generate summary
LOGSUM: SKIPN .JRLNK(R) ;HAVE A RUN LOG?
POPJ P, ;NO
MOVE S1,.JQRFN(R) ;FILES TRANSFERED
$TEXT (LOGCHR,<^I/NBSUM/Summary:^D5/S1/ files transfered>)
MOVEI S1,0 ;DISK BLOCKS READ
$TEXT (LOGCHR,<^I/NBSUM/ ^D5/S1/ disk blocks read>)
$TEXT (LOGCHR,<^I/NBQUE/Request queued for processing in "^Q/QUENAM/" queue>)
AOS .JQRFN(R) ;INCREMENT RELATIVE FILE NUMBER
MOVEI P2,LOGFP ;DUMMY FP
MOVEI P3,LOGFD ;DUMMY FD
PUSHJ P,SNDFSP ;SEND FILESPEC
PUSHJ P,@.JNIOV+.IOSIA(R) ;HAS THE DJM OBJECTED TO SOMETHING IT ATE?
SKIPA ;NOPE, ALL IS WELL
JSP S1,RCRE.E ;YES, HANDLE DJM INDIGESTION
MOVX S1,.MTFDT ;TYPE = FILEDATA
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
AOS BLKCNT ;COUNT ANOTHER BLOCK
MOVX S1,.BTDAT ;TYPE = FILEDATA
PUSHJ P,PUTBYT ;STUFF THE BLOCK TYPE
PUSH P,.JIOBP(R) ;SAVE THE POINTER TO THE HIGH ORDER LENGTH BYTE
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;STORE LENGTH OF ZERO TEMPORARILY
PUSHJ P,PUTBYT ;...
MOVE S1,.JRLNK(R) ;GET LINKED LIST HANDLE
PUSHJ P,L%FIRS ;POSITION TO FIRST ENTRY
JUMPF LOGSU6 ;SHOULDN'T FAIL
JRST LOGSU2 ;ONWARD
LOGSU1: MOVE S1,.JRLNK(R) ;GET LINKED LIST HANDLE
PUSHJ P,L%NEXT ;POSITION TO NEXT ENTRY
JUMPF LOGSU6 ;DONE?
LOGSU2: HRLI S2,(POINT 7,) ;BYTE POINTER
MOVEM S2,.JRPTR(R) ;SAVE
MOVEI S2,<RLGBSZ*5>-1 ;BYTE COUNT
MOVEM S2,.JRCNT(R) ;SAVE
PUSH P,.JIOBC(R) ;SAVE OUTPUT BYTE COUNT
LOGSU3: MOVE T1,.JIOBC(R) ;GET MAX NUMBER OF BYTES WE CAN SEND IN MSG
SETZ P4, ;ASSUME WE'LL HIT EOF
LOGSU4: ILDB S1,.JRPTR(R) ;GET A CHARACTER
JUMPE S1,LOGSU5 ;RUN LOG BUFFER RUN OUT?
PUSHJ P,PUTBYT ;STUFF IN NETWORK BUFFER
SOJG T1,LOGSU4 ;LOOP 'TIL NET BUFFER FULL
SETO P4, ;REMEMBER THERE'S MORE OUTPUT TO DO
LOGSU5: POP P,S1 ;GET BYTE COUNT BEFORE STRING
SUB S1,.JIOBC(R) ;MINUS NUMBER LEFT GIVES NUMBER STORED
POP P,S2 ;RETRIEVE BYTE POINTER TO LENGTH BYTE
ROT S1,-^D8 ;SHIFT HIGH BYTE OVER
IDPB S1,S2 ;STORE THE HIGH ORDER LENGTH BYTE
ROT S1,^D8 ;SHIFT LOW BYTE BACK
IDPB S1,S2 ;STORE THE LOW ORDER LENGTH BYTE
PUSHJ P,FINMSG ;FINISH MESSAGE
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND THE DATA
PJRST ABORTJ ;ABORT THE JOB
AOS S1,.JBFCT(R) ;BUMP FAIRNESS COUNTER
CAXLE S1,OUTFCT ;TIME TO DESCHED?
PUSHJ P,WSCHED ;GIVE OTHER STREAMS A CHANCE
JUMPE P4,LOGSU1 ;LOOP BACK FOR ANOTHER RUN LOG BUFFER
JRST LOGSU3 ;ELSE CONTINE TO EMPTY CURRENT
LOGSU6: PUSHJ P,@.JNIOV+.IOSIA(R) ;HAS THE DJM OBJECTED TO SOMETHING IT ATE?
SKIPA ;NOPE, ALL IS WELL
JSP S1,RCRE.E ;YES, HANDLE DJM INDIGESTION
MOVX S1,.MTEOF ;TYPE = END OF FILE
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
PUSHJ P,FINMSG ;FINISH UP MESSAGE (NO BODY)
PUSHJ P,@.JNIOV+.IOOUT(R) ;SEND OUTPUT DATA
PJRST ABORTJ ;ABORT THE JOB
MOVE S1,.JRLNK(R) ;GET LINKED LIST HANDLE
PUSHJ P,L%DLST ;DELETE RUN LOG BUFFERS
SETZM .JRLNK(R) ;INVALIDATE
POPJ P, ;RETURN
SUBTTL Run Log routines -- Miscellaneous
LOGHDR: ASCIZ /
* * * N E B U L A R u n L o g * * *
/
LOGFP: $BUILD (FPXSIZ) ;BLOCK SIZE
$SET (.FPLEN,FP.LEN,FPXSIZ) ;LENGTH
$SET (.FPINF,FP.FFF,.FPFAS) ;FILE FORMAT = ASCII
$SET (.FPINF,FP.FPF,%FPLAR) ;PRINT FORMAT = ARROW
$SET (.FPINF,FP.FSP,1) ;SPACING = 1
$SET (.FPINF,FP.FLG,1) ;LOG FILE
$SET (.FPINF,FP.NFH,1) ;NO FILE HEADERS
$SET (.FPINF,FP.SPL,1) ;SPOOLED FILE
$SET (.FPINF,FP.FCY,1) ;COPY COUNT = 1
$EOB ;END OF BLOCK
LOGFD: $BUILD (FDXSIZ) ;BLOCK SIZE
$SET (.FDLEN,FD.LEN,FDXSIZ) ;LENGTH
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE MODE
$SET (.FDSTR,,<'SPL '>) ;DEVICE
$SET (.FDNAM,,<'NEBULA'>) ;FILE NAME
$SET (.FDEXT,,<'LOG '>) ;EXTENSION
$SET (.FDPPN,,0) ;DEFAULT FROM DEVICE
$EOB ;END OF BLOCK
;TIME STAMPS
NBCFG:: ITEXT (<^C/[-1]/ NEBCFG >)
NBDAT:: ITEXT (<^C/[-1]/ NEBDAT >)
NBERR:: ITEXT (<^C/[-1]/ NEBERR ? >)
NBJOB:: ITEXT (<^C/[-1]/ NEBJOB >)
NBMSG:: ITEXT (<^C/[-1]/ NEBMSG >)
NBNET:: ITEXT (<^C/[-1]/ NEBNET >)
NBOPR:: ITEXT (<^C/[-1]/ NEBOPR >)
NBQUE:: ITEXT (<^C/[-1]/ NEBQUE >)
NBSUM:: ITEXT (<^C/[-1]/ NEBSUM >)
SUBTTL Send requeue message
REQMSG: MOVX S1,REQ.SZ ;MESSAGE LENGTH
MOVEI S2,G$MSG ;SCRATCH SPACE
PUSHJ P,.ZCHNK ;ZERO IT OUT
MOVEI M,G$MSG ;POINT AT SCRATCH SPACE
MOVX S1,REQ.SZ ;SIZE OF MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;STORE SIZE
MOVX S1,.QOREQ ;TYPE OF MESSAGE
STORE S1,.MSTYP(M),MS.TYP ;STORE TYPE
MOVE S1,.EQITN(R) ;GET INTERNAL TASK NAME
MOVEM S1,REQ.IT(M) ;STUFF IT
MOVX S1,REQTIM ;REQUEUE TIME
STORE S1,REQ.FL(M),RQ.TIM ;STORE IT FOR QUASAR
PUSHJ P,G$SQSR ;SEND TO QUASAR
SKIPE S1,.JRLNK(R) ;HAVE A RUN LOG?
PUSHJ P,L%DLST ;DELETE IT
SETZM .JRLNK(R) ;INVALIDATE
POPJ P, ;RETURN
SUBTTL Job processing -- Local LIST request
LLIST: SETZM .JLMPT(R) ;ASSUME QUEUE IS EMPTY
SETZM .JLNRM(R) ;INITIALIZE LISTING CONTROL FLAGS
SETZM .JLBPT(R)
SETOM .JLNJL(R)
SETZM .JLNAJ(R)
PUSHJ P,@.JNIOV+.IOOPN(R) ;OPEN A LINK TO REMOTE
JRST LLST.7 ;OPEN FAILED
PUSHJ P,CONMSG ;TELL THE WORLD WE'RE CONNECTED
MOVEI S1,.MTDIS ;TYPE = DISPLAY QUEUES
PUSHJ P,SETMSG ;SET UP MESSAGE HEADER
MOVEI S1,.BTJOW ;TYPE = JOB OWNER
MOVEI S2,G$NAM ;OUR NAME
PUSHJ P,G$PSTG ;STORE THE ASCII STRING BLOCK
PUSHJ P,FINMSG ;FINISH UP MESSAGE, SET LENGTH, ETC.
PUSHJ P,@.JNIOV+.IOOUT(R) ;OUTPUT BUFFER
PJRST ABORTJ ;ABORT JOB
LLST.1: PUSHJ P,@.JNIOV+.IOINP(R) ;READ A BUFFER
PJRST ABORTJ ;ABORT JOB
LDB S1,P.ITYP ;GET MESSAGE TYPE BYTE
CAIN S1,.MTEND ;END?
JRST LLST.2 ;YES
CAIE S1,.MTSUM ;SUMMARY?
JRST LLST.6 ;NO, MIGHT BE ERROR, BUT BAD NEWS IN ANY CASE
PUSHJ P,LISTEM ;DECODE MESSAGE
JRST LLST.1 ;LOOP BACK FOR MORE
LLST.2: PUSHJ P,LSTM.6 ;PRINT SUMMARY LINE IF NEEDED
SKIPE .JLMPT(R) ;ARE THE QUEUES EMPTY?
JRST LLST.4 ;NO
SKIPN .JLTYP(R) ;OPERATOR REQUEST?
JRST LLST.3 ;NO
$ACK (<The remote queues are empty>,,,.JLCOD(R))
JRST LLST.5 ;WIND DOWN THE STREAM
LLST.3: MOVEI S1,[ASCIZ / Remote Queue Listing /] ;FOR OPR
PUSHJ P,SETPAG ;SET UP THE OUTPUT PAGE
$ASCII (<The remote queues are empty>)
LLST.4: PUSHJ P,CRLF ;END WITH A CRLF
PUSHJ P,SENDIT ;SEND THE LAST PAGE
LLST.5: PUSHJ P,@.JNIOV+.IOCLS(R) ;DO DISCONNECT
PJRST ABORTJ ;ABORT JOB
PJRST DISMSG ;GENERATE DISCONNECT MESSAGE AND RETURN
LLST.6: $WTO (<^T/G$NAM/ error>,<Unknown message type ^O/S1/ received in lister>,.JQOBJ(R))
PJRST ABORTJ ;STOMP THIS GUY
LLST.7: PUSH P,S1 ;SAVE ERROR TEXT
MOVEI S1,[ASCIZ / Remote Queue Listing /] ;FOR OPR
PUSHJ P,SETPAG ;SET UP THE OUTPUT PAGE
POP P,S1 ;RESTORE ERROR TEXT
$TEXT (DEPBYT,<^M^JConnect to node ^N/.JBNOD(R)/ failed^T/0(S1)/>)
PJRST SENDIT ;SEND THE LAST PAGE
LISTEM: PUSHJ P,GETBYT ;SKIP TYPE
PUSHJ P,GETBYT ;SKIP FLAGS
PUSHJ P,GETBYT ;SKIP CONTEXT
PUSHJ P,GETBYT ;GET BLOCK COUNT
MOVE P1,S1 ;SAVE BLOCK COUNT
PUSHJ P,GETWRD ;GET MESSAGE LENGTH
MOVEI S2,BFSBYT-.HDSIZ ;SEE IF IT MATCHES
SUB S2,.JNARG+.NSAA1(R) ; WHAT WE RECEIVED
CAME S1,S2 ;...
JRST LENERR ;LENGTH ERROR
SETZM LISBEG ;ZERO OUT TEMPORARIES
MOVE S1,[LISBEG,,LISBEG+1]
BLT S1,LISEND ;ALL THE WAY
;Remove the blocks from the message and store them temporarily,
;then do the real listing.
LSTM.1: SOJL P1,LSTM.4 ;DONE IF NO MORE BLOCKS
PUSHJ P,GETBYT ;GET THE BLOCK TYPE
MOVE T1,S1 ;SAVE IT
PUSHJ P,GETBYT ;SKIP FLAGS
PUSHJ P,GETBYT ;GET LENGTH
MOVE T2,S1 ;SAVE IT
;See if we're interested in this block type, and store the data
;temporarily if so. Otherwise just skip this block.
MOVSI S1,-LSTTBL ;LENGTH OF TABLE
LSTM.2: HLRZ S2,LSTTAB(S1) ;GET A BLOCK TYPE
CAME S2,T1 ;MATCH THE ONE WE HAVE?
AOBJN S1,LSTM.2 ;NO, LOOP
JUMPGE S1,LSTM.3 ;IF NO MATCH, JUST SKIP THE BLOCK
HRRZ S1,LSTTAB(S1) ;GET THE PROCESSING ROUTINE
PUSHJ P,(S1) ;CALL IT
JRST LSTM.1 ;LOOP
LSTM.3: SOJL T2,LSTM.1 ;DONE WHEN ALL BYTES PROCESSED
PUSHJ P,GETBYT ;GET A BYTE
JRST LSTM.3 ;ONWARD
;Now do the actual listing
LSTM.4: SKIPN LISJNB ;REAL JOB?
JRST LSTM.6 ;NOPE, MUST BE START OF NEW QUEUE
SKIPN .JLQNM(R) ;DID THE REQUESTOR SPECIFY A QUEUE NAME?
JRST LSTM.5 ;NO
MOVEI S1,.JLQNM(R) ;GET ADDRESS OF THE QUEUE NAME STRING
HRLI S1,(POINT 8) ;IT'S 8-BIT ASCII
HRROI S2,LISQNM ;THIS QUEUE NAME IS IN 7-BIT ASCII
PUSHJ P,S%SCMP ;COMPARE THE STRINGS
JUMPN S1,.POPJ ;RETURN IF THEY DIDN'T COMPARE
LSTM.5: SKIPE .JLNRM(R) ;RUNNING OUT OF LISTING PAGE SPACE?
PUSHJ P,PAGOVF ;YES, SEND IT OUT AND GET ANOTHER
AOSG .JLNJL(R) ;FIRST ONE?
PUSHJ P,LSTHDR ;YES, PUT OUT HEADER
MOVE S1,LISSTS ;GET STATUS
CAIN S1,.STEXC ;EXECUTING?
SKIPA S1,[ASCIZ /* /] ;YES
SKIPA S1,[ASCIZ / /] ;NO
AOS .JLNAJ(R) ;COUNT AN ACTIVE JOB
$TEXT DEPBYT,<^5/S1/^T20/LISNAM/ ^D7R/LISJNB/ ^D6R/LISPGL/ ^T20/LISOWN/>
SETOM .JLMPT(R) ;REMEMBER SOME QUEUE WAS NON-EMPTY
POPJ P, ;DONE
LSTM.6: AOSG S1,.JLNJL(R) ;GET NUMBER ACTUALLY LISTED
JRST LSTM.7 ;NONE THERE
SKIPN .JLNAJ(R) ;ANY ACTIVE JOBS?
SKIPA S2,[[ITEXT (<(none in progress)>)]]
MOVEI S2,[ITEXT (<(^D/.JLNAJ(R)/ in progress)>)]
CAIN S1,1 ;JUST ONE?
$TEXT DEPBYT,<^M^JThere is 1 job in the queue ^I/0(S2)/>
CAIE S1,1 ;MORE THAN ONE?
$TEXT DEPBYT,<^M^JThere are ^D/S1/ jobs in the queue ^I/0(S2)/>
LSTM.7: SETOM .JLNJL(R) ;START OVER WITH THE NEXT QUEUE
SETZM .JLNAJ(R)
POPJ P, ;RETURN
LSTHDR: MOVEI S1,[ASCIZ / Remote Queue Listing /] ;FOR OPR
SKIPN .JLBPT(R) ;ALREADY DONE SO?
PUSHJ P,SETPAG ;SET UP THE OUTPUT PAGE
$TEXT (DEPBYT,<^M^JRemote queue ^T/LISQNM/:^T/HEADER/^A>)
POPJ P, ;RETURN
HEADER: ASCIZ |
Job Name Req # Limit User
---------------------- ------- ------ --------------------
|
SUBTTL Block type dispatch table
LSTTAB: XWD .BTJNB,JNB ;JOB NUMBER
XWD .BTJNA,JNA ;JOB NAME
XWD .BTJOW,JOW ;JOB OWNER
XWD .BTJBS,JBS ;STATE
XWD .BTPGL,JPL ;PAGE LIMIT
XWD .BTPRI,PRI ;PRIORITY
XWD .BTFRM,FRM ;FORMS TYPE
XWD .BTNOT,NOT ;NOTE STRING
XWD .BTQUE,QUE ;QUEUE NAME STRING
LSTTBL==.-LSTTAB ;LENGTH OF TABLE
;Here for job number block
JNB: PUSHJ P,GETITM ;GET IT
MOVEM S1,LISJNB ;SAVE IT
$RETT
;Here for job name block
JNA: MOVEI S1,LISNAM ;POINT WHERE IT GOES
PJRST GETSTG ;GET IT AND RETURN
;Here for job owner block
JOW: MOVEI S1,LISOWN ;POINT WHERE IT GOES
PJRST GETSTG ;GET IT AND RETURN
;Here for job state block
JBS: PUSHJ P,GETITM ;GET IT
MOVEM S1,LISSTS ;SAVE IT
$RETT
;Here for page limit block
JPL: PUSHJ P,GETITM ;GET IT
MOVEM S1,LISPGL ;SAVE IT
$RETT
;Here for priority block
PRI: PUSHJ P,GETITM ;GET IT
MOVEM S1,LISPRI ;SAVE IT
$RETT
;Here for forms type block
FRM: PUSHJ P,GETITM ;GET IT(?)
MOVEM S1,LISFRM ;SAVE IT
$RETT
;Here for NOTE block
NOT: MOVEI S1,LISNOT ;POINT AT WHERE IT GOES
PJRST GETSTG ;GET IT
;Here for queue name block
QUE: MOVEI S1,LISQNM ;POINT AT WHERE IT GOES
PJRST GETSTG ;GET IT
SUBTTL Error message unpacking routine
UNPERR: PUSHJ P,.SAVE1## ;FREE UP P1
PUSHJ P,GETBYT ;SKIP TYPE
PUSHJ P,GETBYT ;SKIP FLAGS
PUSHJ P,GETBYT ;SKIP CONTEXT
PUSHJ P,GETBYT ;GET BLOCK COUNT
MOVE P1,S1 ;SAVE BLOCK COUNT
PUSHJ P,GETWRD ;GET MESSAGE LENGTH
MOVEI S2,BFSBYT-.HDSIZ ;SEE IF IT MATCHES
SUB S2,.JNARG+.NSAA1(R) ; WHAT WE RECEIVED
CAME S1,S2 ;...
JRST LENERR ;LENGTH ERROR
SETZM ERRBEG ;ZERO OUT TEMPORARIES
MOVE S1,[ERRBEG,,ERRBEG+1]
BLT S1,ERREND ;ALL THE WAY
;Remove the blocks from the message and store them.
UNPE.1: SOJL P1,.POPJ ;DONE IF NO MORE BLOCKS
PUSHJ P,GETBYT ;GET THE BLOCK TYPE
MOVE T1,S1 ;SAVE IT
PUSHJ P,GETBYT ;SKIP FLAGS
PUSHJ P,GETBYT ;GET LENGTH
MOVE T2,S1 ;SAVE IT
;See if we're interested in this block type, and store the data
;temporarily if so. Otherwise just skip this block.
MOVSI S1,-ERRTBL ;LENGTH OF TABLE
UNPE.2: HLRZ S2,ERRTAB(S1) ;GET A BLOCK TYPE
CAME S2,T1 ;MATCH THE ONE WE HAVE?
AOBJN S1,UNPE.2 ;NO, LOOP
JUMPGE S1,UNPE.3 ;IF NO MATCH, JUST SKIP THE BLOCK
HRRZ S1,ERRTAB(S1) ;GET THE PROCESSING ROUTINE
PUSHJ P,(S1) ;CALL IT
JRST UNPE.1 ;LOOP
UNPE.3: SOJL T2,UNPE.1 ;DONE WHEN ALL BYTES PROCESSED
PUSHJ P,GETBYT ;GET A BYTE
JRST UNPE.3 ;ONWARD
ERRTAB: XWD .BTEEL,LVL ;ERROR LEVEL
XWD .BTEEC,CLS ;ERROR CLASS
XWD .BTECD,COD ;ERROR CODE
XWD .BTETX,TXT ;ERROR TEXT
;Here on error level, class, or code
LVL: PUSHJ P,GETITM ;GET IT
MOVEM S1,ERRLVL ;SAVE IT
$RETT ;RETURN
CLS: PUSHJ P,GETITM ;GET IT
MOVEM S1,ERRCLS ;SAVE IT
$RETT ;RETURN
COD: PUSHJ P,GETITM ;GET IT
MOVEM S1,ERRCOD ;SAVE IT
$RETT ;RETURN
;Here on error text
TXT: MOVEI S1,ERRBUF ;POINT AT WHERE IT GOES
PJRST GETSTG ;GET IT
SUBTTL Message unpacking routines
;Get a byte from the input message
GETBYT: SOSGE .JIIBC(R) ;STILL ROOM?
JRST LENERR ;NOPE
ILDB S1,.JIIBP(R) ;GET IT
POPJ P, ;RETURN
;Get a word (byte swapped) from the input message
GETWRD: PUSHJ P,GETBYT ;GET FIRST BYTE (LOW ORDER)
PUSH P,S1 ;SAVE IT
PUSHJ P,GETBYT ;GET SECOND BYTE (HIGH ORDER)
LSH S1,^D8 ;POSITION IT
IOR S1,(P) ;INCLUDE LOW ORDER
ADJSP P,-1 ;POP OFF THE JUNK
POPJ P, ;RETURN
;Get a longword (swapped) from the input message
GETLWD: PUSHJ P,GETWRD ;GET FIRST WORD (LOW ORDER)
PUSH P,S1 ;SAVE IT
PUSHJ P,GETWRD ;GET SECOND WORD (HIGH ORDER)
LSH S1,^D16 ;POSITION IT
IOR S1,(P) ;INCLUDE LOW ORDER
ADJSP P,-1 ;POP OFF THE JUNK
POPJ P, ;RETURN
;Get a byte/word/longword (based on length in T2)
GETITM: SETZ S1, ;ASSUME NO MATCH
CAIN T2,1 ;SINGLE BYTE?
MOVEI S1,GETBYT ;YES
CAIN T2,2 ;WORD?
MOVEI S1,GETWRD ;YES
CAIN T2,4 ;LONGWORD?
MOVEI S1,GETLWD ;YES
JUMPN S1,(S1) ;DO IT
POPJ P, ;ON SECOND THOUGHT, DON'T DO IT
;Get a string (length in T2) and store it in block pointed to by S1
GETSTG: TLNN S1,-1 ;POINTER SUPPLIED?
HRLI S1,(POINT 7) ;NOPE
MOVE T1,S1 ;SAVE POINTER
GETS.1: SOJL T2,.RETT ;WHEN DONE
PUSHJ P,GETBYT ;GET A BYTE
IDPB S1,T1 ;STORE IT
JRST GETS.1 ;LOOP
SUBTTL Message packing routines
;SETMSG - set up message header.
;Call:
; S1/ message type
SETMSG: SETZM BLKCNT ;NO BLOCKS IN THIS MESSAGE YET
PUSHJ P,PUTBYT ;STUFF THE TYPE
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;NO FLAGS
MOVE S1,.JQOBJ+OBJ.UN(R) ;SENDER'S CONTEXT(?)
PUSHJ P,PUTBYT ;STUFF IT
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;NO BLOCKS YET
PUSHJ P,PUTBYT ;NO BODY LENGTH
PJRST PUTBYT ;RETURN
;FINMSG - finish a message
FINMSG: MOVX S1,BFSBYT ;GET BUFFER SIZE
SUB S1,.JIOBC(R) ;SUBTRACT AMOUNT FREE TO GET LENGTH
SUBI S1,.HDSIZ ;LENGTH DOESN'T INCLUDE HEADER
DPB S1,P.OLNL ;STORE LOW BYTE OF LENGTH
LSH S1,-^D8 ;SHIFT OFF THE LOW BYTE
DPB S1,P.OLNH ;STORE HIGH BYTE OF LENGTH
MOVE S1,BLKCNT ;GET NUMBER OF BLOCKS
DPB S1,P.OBLK ;STORE IN MESSAGE
POPJ P, ;RETURN
;G$PBYT - Put a byte
;G$PWRD - Put a word (2 bytes)
;G$PLWD - Put a longword (4 bytes)
;G$PSTG - Put a string
;G$PCST - Put a counted string
;Call:
; S1/ block type
; S2/ data item (or pointer if string)
G$PBYT: AOS BLKCNT ;COUNT ANOTHER BLOCK
PUSHJ P,PUTBYT ;STORE THE BLOCK TYPE
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;STORE HIGH ORDER LENGTH BYTE
MOVEI S1,1 ;LENGTH
PUSHJ P,PUTBYT ;STORE LOW ORDER LENGTH BYTE
MOVE S1,S2 ;DATA ITEM
PJRST PUTBYT ;STORE IT AND RETURN
G$PWRD: AOS BLKCNT ;COUNT ANOTHER BLOCK
PUSHJ P,PUTBYT ;STORE THE BLOCK TYPE
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;STORE HIGH ORDER LENGTH BYTE
MOVEI S1,2 ;LENGTH
PUSHJ P,PUTBYT ;STORE LOW ORDER LENGTH BYTE
MOVE S1,S2 ;COPY THE WORD TO STORE
PUSHJ P,PUTBYT ;STORE LOW ORDER BYTE OF WORD
LSH S1,-^D8 ;SHIFT OVER HIGH ORDER BYTE
PJRST PUTBYT ;STORE IT AND RETURN
G$PLWD: AOS BLKCNT ;COUNT ANOTHER BLOCK
PUSHJ P,PUTBYT ;STORE THE BLOCK TYPE
SETZ S1, ;GET A ZERO
PUSHJ P,PUTBYT ;STORE HIGH ORDER LENGTH BYTE
MOVEI S1,4 ;LENGTH
PUSHJ P,PUTBYT ;STORE LOW ORDER LENGTH BYTE
MOVE S1,S2 ;COPY LONG WORD
PUSHJ P,PUTBYT ;STORE LOW ORDER BYTE
LSH S1,-^D8 ;SHIFT NEXT BYTE INTO POSITION
PUSHJ P,PUTBYT ;STORE IT
LSH S1,-^D8 ;SHIFT NEXT BYTE INTO POSITION
PUSHJ P,PUTBYT ;STORE IT
LSH S1,-^D8 ;SHIFT HIGH ORDER BYTE INTO POSITION
PJRST PUTBYT ;STORE IT AND RETURN
G$PSTG: AOS BLKCNT ;COUNT ANOTHER BLOCK
PUSHJ P,PUTBYT ;STORE THE BLOCK TYPE
SETZ S1, ;GET A ZERO
PUSH P,.JIOBP(R) ;SAVE THE POINTER TO THE HIGH ORDER LENGTH BYTE
PUSHJ P,PUTBYT ;STORE LENGTH OF ZERO TEMPORARILY
PUSHJ P,PUTBYT ;...
PUSH P,.JIOBC(R) ;SAVE OUTPUT BYTE COUNT
TLNN S2,-1 ;IS THERE A POINTER?
HRLI S2,(POINT 7) ;NO, ASSUME REGULAR ASCII
PSTG.1: ILDB S1,S2 ;GET A BYTE
JUMPE S1,PSTG.2 ;JUMP IF END
PUSHJ P,PUTBYT ;STORE IT
JRST PSTG.1 ;LOOP
PSTG.2: POP P,S1 ;GET BYTE COUNT BEFORE STRING
SUB S1,.JIOBC(R) ;MINUS NUMBER LEFT GIVES NUMBER STORED
POP P,S2 ;RETRIEVE BYTE POINTER TO LENGTH BYTE
ROT S1,-^D8 ;SHIFT HIGH BYTE OVER
IDPB S1,S2 ;STORE THE HIGH ORDER LENGTH BYTE
ROT S1,^D8 ;SHIFT LOW BYTE BACK
IDPB S1,S2 ;STORE THE LOW ORDER LENGTH BYTE
POPJ P, ;RETURN
G$PCST: AOS BLKCNT ;COUNT ANOTHER BLOCK
PUSHJ P,PUTBYT ;STUFF THE TYPE
HLRZS S1 ;ISOLATE LENGTH
ROT S1,-^D8 ;SHIFT HIGH BYTE OVER
PUSHJ P,PUTBYT ;STUFF IT
ROT S1,^D8 ;SHIFT LOW BYTE BACK
PUSHJ P,PUTBYT ;STUFF IT
MOVE TF,S1 ;COPY COUNT
ILDB S1,S2 ;GET A BYTE
PUSHJ P,PUTBYT ;STUFF IT
SOJG TF,.-2 ;LOOP AS REQUIRED
POPJ P, ;RETURN
POPJ P, ;FOR NOW
PUTBYT: SOSGE .JIOBC(R) ;ROOM FOR THIS BYTE?
JRST LENERR ;NOPE
IDPB S1,.JIOBP(R) ;STORE IT
POPJ P, ;RETURN
SUBTTL SETPAG - Routine to set up an IPCF ACK page
;CALL: S1/ The Address of an ASCIZ Type Line String
;
;RET: True Always
SETPAG: MOVE T3,S1 ;SAVE THE HEADER ADDRESS
PUSHJ P,M%GPAG ;GET A PAGE FOR OUTPUT
MOVEM S1,.JLPAG(R) ;SAVE ITS ADDRESS
MOVE S2,[.OHDRS,,.OMACS] ;GET MSG TYPE PARMS
MOVEM S2,.MSTYP(S1) ;SAVE IT IN THE MSG
MOVE S2,.JLCOD(R) ;GET THE OPR ACK CODE
MOVEM S2,.MSCOD(S1) ;SAVE IT IN THE MSG
MOVX S2,WT.SJI+WT.NFO ;GET JOB INFO SUPPRESS BITS
MOVEM S2,.OFLAG(S1) ;SAVE IT IN THE MSG
AOS .OARGC(S1) ;ADD 1 TO THE ARGUMENT COUNT
MOVEI S1,.OHDRS(S1) ;POINT TO THE FIRST MESSAGE BLK
SKIPE T3 ;SKIP IF NO HEADER WANTED
PUSHJ P,SETHDR ;ELSE GO PUT IT IN
MOVEI T4,.CMTXT ;GET THE TEXT BLOCK TYPE
MOVEM T4,ARG.HD(S1) ;SAVE IT IN THE MESSAGE
MOVEI T4,ARG.DA(S1) ;POINT TO DATA AREA
MOVEM T4,.JLDAA(R) ;SAVE THE START DATA ADDRESS
MOVE S1,.JLPAG(R) ;GET THE MESSAGE START ADDRESS
SUB S1,T4 ;CALC NEG. NUMBER OF WORDS USED
ADDI S1,^D512-^D75 ;CALC NUMBER OF WORDS LEFT
IMULI S1,5 ;CALC NUMBER OF BYTES LEFT
MOVEM S1,.JLBCT(R) ;AND SAVE IT
SETZM .JLNRM(R) ;RESET NO MORE ROOM FLAG
HRLI T4,(POINT 7) ;GEN THE BYTE POINTER
MOVEM T4,.JLBPT(R) ;AND SAVE IT
$RETT ;RETURN
SUBTTL SETHDR - Routine to insert the message header
;Here with
; S1/ Adrs of free slot in message
; T3/ Adrs of ASCIZ string
;Returns
; display block into message
; S1 points to new first free location in message
SETHDR: $SAVE <P1> ;PRESERVE A REG
MOVE S2,.JLPAG(R) ;GET THE MESSAGE ADDRESS
AOS .OARGC(S2) ;ALSO BUMP THE BLOCK COUNT BY 1
MOVX P1,.ORDSP ;GET BLOCK TYPE
STORE P1,ARG.HD(S1),AR.TYP ;SAVE IT IN THE MSG
MOVE P1,G$NOW ;GET THE TIME
MOVEM P1,ARG.DA(S1) ;SAVE TIME STAMP
MOVEI P1,ARG.DA+1(S1) ;POINT TO BLOCK DATA AREA
HRLI P1,(POINT 7) ;MAKE A BYTE POINTER OF IT
MOVEM P1,.JLBPT(R) ;SAVE FOR TEXT OUTPUT ROUTINE
$TEXT (DEPBYT,<^T/0(T3)/^A>) ;DUMP THE HEAD INTO THE MESSAGE
HRRZ P1,.JLBPT(R) ;GET LAST ADRS USED
SUBI P1,-1(S1) ;FIGURE LENGTH OF THIS BLOCK
STORE P1,ARG.HD(S1),AR.LEN ;MARK LENGTH OF THIS BLOCK
ADDI S1,0(P1) ;POINT TO NEXT SLOT AFTER THIS BLOCK
MOVSS P1 ;LENGTH TO LEFT HALF
ADDM P1,.MSTYP(S2) ;UPDATE MESSAGE LENGTH, TOO
$RETT
SUBTTL SENDIT - End-of-message processing routine
SNDMSG: MOVX S1,WT.MOR ;GET THE MORE PAGES COMMING BIT
MOVE S2,.JLPAG(R) ;GET THE MESSAGE ADDRESS
IORM S1,.OFLAG(S2) ;LIGHT THE BIT
SENDIT: HRRZ S1,.JLBPT(R) ;GET FINAL MESSAGE ADDRESS
SUB S1,.JLDAA(R) ;SUBTRACT THE START ADDRESS
ADDI S1,2 ;ADD THE HEADER LENGTH+1
MOVSS S1 ;SHIFT RIGHT TO LEFT
MOVE S2,.JLDAA(R) ;GET THE BLOCK DATA START ADDRESS
ADDM S1,-1(S2) ;BUMP TEXT BLOCK LENGTH
ADDM S1,@.JLPAG(R) ;BUMP TOTAL MSG LENGTH
MOVE S1,.JLPID(R) ;GET SENDER'S PID
MOVEM S1,G$SAB+SAB.PD ;AND SAVE IT
MOVEI S1,QSRPIB ;POINT AT PIB FOR SENDING IN BEHALF OF QUASAR
MOVEM S1,G$SAB+SAB.PB ;TELL GLXIPC
MOVX S1,SF.PRV ;IN YOUR BEHALF OF SENDS REQUIRE PRIVILEGES
MOVEM S1,G$SAB+SAB.FL ; SO LET GLXIPC KNOW
MOVX S1,PAGSIZ ;LENGTH OF THE PACKET
MOVEM S1,G$SAB+SAB.LN ;SAVE IT
MOVE S1,.JLPAG(R) ;ADDRESS OF THE PACKET
MOVEM S1,G$SAB+SAB.MS ;SAVE IT
SETZM G$SAB+SAB.SI ;NO SPECIAL PID INDEX
PUSHJ P,SEND.0 ;SEND IT OFF
SETZM G$SAB+SAB.MS ;ZERO THE SAB MSG ADDRESS
SETZM G$SAB+SAB.PB ;NOT IN QUASAR'S BEHALF ANY MORE
SETZM G$SAB+SAB.FL ;NO FLAGS EITHER
$RETT ;RETURN
SUBTTL Listing output routines
DEPBYT: IDPB S1,.JLBPT(R) ;PUT THE BYTE INTO THE MESSAGE
SOSG .JLBCT(R) ;CHECK THE BYTES REMAINING
SETOM .JLNRM(R) ;NO MORE ROOM,,TURN ON FLAG
SETZM .JLCRF(R) ;CLEAR THE CRLF FLAG
$RETT ;RETURN
PAGOVF: PUSHJ P,SNDMSG ;SEND THE MESSAGE OFF
SETZ S1, ;INDICATE WE DONT HAVE ANY HEADER
PUSHJ P,SETPAG ;GO SET UP A NEW OUTPUT PAGE
$RETT ;AND RETURN
CRLF: MOVEI S1,[BYTE(7) .CHCRT,.CHLFD,0] ;GET THE CRLF
PUSHJ P,ASCOUT ;DUMP IT OUT
SETOM .JLCRF(R) ;SAY LAST THING OUT WAS CRLF
$RETT ;AND RETURN
ASCOUI: PUSH P,S1 ;SAVE S1
HRRZ S1,@-1(P) ;GET THE ADRS OF THE MESSAGE
AOS -1(P) ;SKIP OVER THE ARG POINTER
PUSHJ P,ASCOUT ;DUMP IT OUT
POP P,S1 ;RESTORE S1
$RETT ;AND WIN
ASCOUT: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE THE INPUT ADDRESS
HRLI P1,(POINT 7) ;MAKE IT A BYTE POINTER
ASCO.1: ILDB S1,P1 ;GET A BYTE
JUMPE S1,.RETT ;DONE,,RETURN
PUSHJ P,DEPBYT ;PUT IT OUT
JRST ASCO.1 ;AND DO ANOTHER
CHKSPC: ADD S1,T3 ;ADD FIELD LENGTH AND LAST BYTE ADDRESS
CAMG S1,.JLBCT(R) ;IS THERE ROOM FOR THE FIELD ???
$RETT ;YES,,RETURN
PUSHJ P,CRLF ;INSERT A CRLF
$ASCII (< >) ;INSERT A TAB
SETOM .JLCRF(R) ;INDICATE BEGINNING OF LINE
MOVE T3,.JLBCT(R) ;GET THE BYTE COUNT
SUBI T3,^D64 ;GET NEW LINE END ADDRESS
$RETT ;AND RETURN
CHKLIN: MOVE S1,.JLBCT(R) ;GET THE CURRENT BYTE COUNT FOR OUTPUT PAGE
SUBI S1,^D64 ;SUBTRACT A "STANDARD" LINE
SKIPG S1 ;MORE ROOM LEFT?
PUSHJ P,PAGOVF ;NO, GO SET UP NEXT PAGE
$RET ;CONTINUE
SUBTTL Error handling routines
;Error routines are branched to via a JSP TF,xxxERR so we can
;print the PC of the caller (as if that would help). Device-
;dependent error code should have already been printed by the
;driver module.
LENERR: MOVEI S1,[ASCIZ |message length error|]
JRST ALLERR ;JOIN COMMON CODE
ALLERR: $WTO (<^T/G$NAM/ ^T/0(S1)/ at PC ^O/TF,RHMASK/>,,.JQOBJ(R))
PJRST ABORTJ ;ABORT THE JOB
SUBTTL UUO error reporting
UUOERR::MOVEM S1,ERRCOD ;SAVE ERROR CODE
SUBI S2,2 ;POINT TO THE OFFENDING UUO
HRRZM S2,ERRPC ;SAVE ERROR PC
SKIPE S1,R ;STREAM RELOCATION SETUP?
MOVE S1,.JNIOV+.IOUUE(R) ;GET TRANSLATION TABLE
MOVEM S1,ERRTBL ;SAVE
PUSHJ P,JOBIDN ;GENERATE JOB ID TEXT
MOVE S1,@ERRPC ;GET UUO IN QUESTION
TDZ S1,[Z 17, @UU.PHY(17)] ;ZAP AC, INDIRECTION, INDEX, PHYSICAL
MOVE S2,[IFIW UUOTAB] ;TABLE POINTER
UUOER1: SKIPN 0(S2) ;END OF TABLE?
JRST UUOER2 ;YES
CAMN S1,0(S2) ;MATCH?
JRST UUOER3 ;YES
ADDI S2,3 ;ACCOUNT FOR MULTI-WORD ENTRIES
JRST UUOER1 ;LOOP
UUOER2: SETZ S2, ;ZERO
EXCH S2,ERRTBL ;TRY TABLE FROM DRIVER
JUMPN S2,UUOER1 ;LOOP BACK
MOVE S2,ERRPC ;GET PC
$TEXT (<-1,,ERRBUF>,<Unknown UUO ^O12R0/S1/ at PC ^O6R0/S2/^M^J^0>)
JRST UUOER6 ;FINISH UP
UUOER3: MOVE S1,1(S2) ;GET SIXBIT NAME
MOVEM S1,ERRNAM ;SAVE
MOVE S2,2(S2) ;PICK UP UUO TRANSLATION TABLE
MOVE S1,ERRCOD ;AND THE ORIGINAL ERROR CODE
UUOER4: HLRZ TF,(S2) ;GET AN ERROR CODE
CAIN TF,(S1) ;MATCH?
JRST UUOER5 ;YES
AOBJN S2,UUOER4 ;LOOP THROUGH TABLE
MOVEI S2,[[ASCIZ /Unknown error code/]]
UUOER5: MOVE S1,ERRCOD ;GET ERROR CODE
HRRZ S2,(S2) ;GET ERROR TEXT
$TEXT (<-1,,ERRBUF>,<^I/UUOETX/^M^J^0>)
UUOER6: MOVEI S1,ERRBUF ;POINT TO RETURNED TEXT
POPJ P, ;RETURN
UUOETX: ITEXT (<^W/ERRNAM/ UUO error ^O/S1/ at PC ^O6R0/ERRPC/; ^T/(S2)/>)
UUOTAB: UUO (<PISYS.>,PISYSL,PISYST)
UUO (<PITMR.>,PITMRL,PITMRT)
UUOLEN==.-UUOTAB
;PISYS. UUO
PISYST: PSTMA%,,[ASCIZ /Too many arguments/]
PSNFS%,,[ASCIZ /No function supplied/]
PSUKF%,,[ASCIZ /Unknown function requested/]
PSOOF%,,[ASCIZ /On and off in same function/]
PSUKC%,,[ASCIZ /Unknown condition or device requested/]
PSDNO%,,[ASCIZ /Device not open/]
PSPRV%,,[ASCIZ /Privilege failure/]
PSIVO%,,[ASCIZ /Invalid vector offset/]
PSUKR%,,[ASCIZ /Unknown reason enabled/]
PSPTL%,,[ASCIZ /Priority too large/]
PSNRW%,,[ASCIZ /Non-zero reserved word/]
PSPND%,,[ASCIZ /PIINI. not done/]
PSARF%,,[ASCIZ /Add and remove in same function/]
PISYSL==.-PISYST
;PITMR. UUO ERRORS
PITMRT: PSTNE%,,[ASCIZ /Timer not enabled/]
PSUFB%,,[ASCIZ /Unknown function bit/]
PITMRL==.-PITMRT
SUBTTL Miscellaneous routines -- JOBIDN - Generate job identifier
JOBIDN::PUSHJ P,.SAVET ;SAVE SOME ACS
MOVEI T1,@.JNIOV+.IONAM(R) ;NETWORK NAME
MOVE T2,.JBNOD(R) ;NODE NAME/NUMBER
MOVE T4,.JBWSC(R) ;GET WAIT STATE CODE
HLLZ T3,WSTABL(T4) ;GET ASSOCIATED CODE
HRRZ T4,WSTABL(T4) ;AND TEXT
$TEXT (<-1,,.JBIDN(R)>,<^T/(T1)/ node: ^N/T2/ Stream state: ^W/T3/ (^T/(T4)/)>)
POPJ P, ;RETURN
DEFINE X (NAM,TXT),<XWD ''NAM'',[ASCIZ |'TXT|]>
WSTABL: WSTATE
SUBTTL Miscellaneous routines -- SETxBF - Setup buffer pointers
;INPUT BUFFER
SETIBF::MOVSI S1,(BF.VBR) ;VIRGIN BUFFER BIT
HRRI S1,.JIIBF+.BFHDR(R) ;ADDRESS OF BUFFER
MOVEM S1,.JIIBR+.BFADR(R) ;STORE IN RING HEADER
MOVSI S1,(POINT 8,) ;8 BIT BYTES
HRRI S1,.JIIBF+.BFCNT+1(R) ;ADDRESS OF FIRST DATA WORD
MOVEM S1,.JIIBR+.BFPTR(R) ;STORE IN RING HEADER
MOVSI S1,BFSWRD-2 ;DATA WORDS IN A BUFFER
HRRI S1,.JIIBF+.BFHDR(R) ;ADDRESS OF BUFFER
MOVEM S1,.JIIBF+.BFHDR(R) ;RING LOOPS ON ITSELF
SETZM .JIIBF+.BFCTR(R) ;NOTHING AVAILABLE YET
POPJ P, ;RETURN
;OUTPUT BUFFER
SETOBF::MOVSI S1,(BF.VBR) ;VIRGIN BUFFER BIT
HRRI S1,.JIOBF+.BFHDR(R) ;ADDRESS OF BUFFER
MOVEM S1,.JIOBR+.BFADR(R) ;STORE IN RING HEADER
MOVSI S1,(POINT 8,) ;8 BIT BYTES
HRRI S1,.JIOBF+.BFCNT+1(R) ;ADDRESS OF FIRST DATA WORD
MOVEM S1,.JIOBR+.BFPTR(R) ;STORE IN RING HEADER
MOVSI S1,BFSWRD-2 ;DATA WORDS IN A BUFFER
MOVSM S1,.JIOBR+.BFCTR(R) ;STORE IN RING HEADER
HRRI S1,.JIOBF+.BFHDR(R) ;ADDRESS OF BUFFER
MOVEM S1,.JIOBF+.BFHDR(R) ;RING LOOPS ON ITSELF
POPJ P, ;RETURN
;RESET OUTPUT BUFFER POINTERS
INIOBF::MOVX S1,BFSBYT ;INITIALIZE OUTPUT BYTE COUNT
MOVEM S1,.JIOBC(R)
MOVEI S1,.JIOBF(R) ;ADDRESS OF OUTPUT BUFFER
HRLI S1,(POINT 8) ;8-BIT BYTES
MOVEM S1,.JIOBP(R) ;INITIALIZE OUTPUT BYTE POINTER
POPJ P, ;RETURN
SUBTTL Initialization blocks
;GLXLIB INITIALIZATION BLOCK
IB: $BUILD (IB.SZ) ;SIZE OF BLOCK
$SET (IB.PRG,FWMASK,%%.MOD) ;PROGRAM NAME
$SET (IB.FLG,IP.STP,0) ;SEND STOPCODES TO ORION
$SET (IB.PIB,FWMASK,PIB) ;ADDRESS OF PIB
$SET (IB.INT,FWMASK,VECTOR) ;ADDRESS OF PSI VECTORS
$EOB ;END OF BLOCK
;PID INITIALIZATION BLOCK
PIB: $BUILD (PB.MNS) ;SIZE OF BLOCK
$SET (PB.HDR,PB.LEN,PB.MNS) ;LENGTH OF THIS BLOCK
$SET (PB.FLG,IP.PSI,1) ;USE PSI FOR IPCF
$SET (PB.FLG,IP.RSE,1) ;RETURN ON SEND FAILURES
$SET (PB.INT,IP.CHN,<IPCVEC-VECTOR>) ;OFFSET TO IPCF INTRUPT BLOCK
$SET (PB.SYS,IP.SQT,^D511) ;INFINITE SEND QUOTA
$SET (PB.SYS,IP.RQT,^D511) ;INFINITE RECEIVE QUOTA
$EOB
;DUMMY PIB FOR SENDING VIA QUASAR'S PID
QSRPIB: $BUILD (PB.MNS)
$EOB
;QUASAR INITIALIZATION BLOCK
HELLO: $BUILD HEL.SZ
$SET (.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET (.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET (HEL.NM,,%%.MOD) ;PROGRAM NAME
$SET (HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET (HEL.NO,HENNOT,2) ;NUMBER OF OBJECT TYPES
$SET (HEL.NO,HENMAX,PRCN) ;MAX NUMBER OF JOBS
$SET (HEL.OB+0,HELOBJ,.OTNQC);NETWORK QUEUE CONTROLLER
$SET (HEL.OB+0,HELATR,%NQINP);INPUT (FROM REMOTE)
$SET (HEL.OB+1,HELOBJ,.OTNQC);NETWORK QUEUE CONTROLLER
$SET (HEL.OB+1,HELATR,%NQOUT);OUTPUT (TO REMOTE)
$EOB
.LNKEN IOLNK,NETIOV
NETIOV: XWD 0,0 ;NETWORK I/O DRIVER CHAIN
SUBTTL Forms type file descriptor blocks
FTYFD: $BUILD (FDMSIZ) ;SHORT FILESPEC BLOCK
$SET (.FDLEN,FD.LEN,FDMSIZ) ;LENGTH
$SET (.FDSTR,,'SYS ') ;DEVICE
$SET (.FDNAM,,'FORMST') ;NAME
$SET (.FDEXT,,'DAT ') ;EXTENSION
$EOB
CHRFD: $BUILD (FDMSIZ) ;SHORT FILESPEC BLOCK
$SET (.FDLEN,FD.LEN,FDMSIZ) ;LENGTH
$SET (.FDSTR,,'SYS ') ;DEVICE
$SET (.FDNAM,,'CHARTY') ;NAME
$SET (.FDEXT,,'DAT ') ;EXTENSION
$EOB
FTYFOB: $BUILD (FOB.SZ) ;FILE OPEN BLOCK
$SET (FOB.CW,FB.BSZ,7) ;BYTE SIZE (ASCII)
$EOB
SUBTTL Message byte pointers
;P.Ixxx are for incoming messages, P.Oxxx are for outgoing messages
P.ITYP: BYTPNT (.HDTYP,.JIIBF(R)) ;TYPE
P.OTYP: BYTPNT (.HDTYP,.JIOBF(R))
P.IFLG: BYTPNT (.HDFLG,.JIIBF(R)) ;FLAGS
P.OFLG: BYTPNT (.HDFLG,.JIOBF(R))
P.ICTX: BYTPNT (.HDCTX,.JIIBF(R)) ;CONTEXT
P.OCTX: BYTPNT (.HDCTX,.JIOBF(R))
P.IBLK: BYTPNT (.HDBLK,.JIIBF(R)) ;NUMBER OF BLOCKS
P.OBLK: BYTPNT (.HDBLK,.JIOBF(R))
P.ILNH: BYTPNT (.HDLNH,.JIIBF(R)) ;HIGH BYTE OF MESSAGE LENGTH
P.OLNH: BYTPNT (.HDLNH,.JIOBF(R))
P.ILNL: BYTPNT (.HDLNL,.JIIBF(R)) ;LOW BYTE OF MESSAGE LENGTH
P.OLNL: BYTPNT (.HDLNL,.JIOBF(R))
SUBTTL Tempoary storage for listing
;Only used when listing one message - doesn't need to be in stream database
LISBEG:!
LISJNB: BLOCK 1 ;JOB NUMBER
LISNAM: BLOCK 10 ;JOB NAME
LISOWN: BLOCK 10 ;JOB OWNER
LISSTS: BLOCK 1 ;STATE
LISPGL: BLOCK 1 ;PAGE LIMIT
LISPRI: BLOCK 1 ;PRIORITY
LISFRM: BLOCK 1 ;FORMS NAME
LISNOT: BLOCK 10 ;NOTE
LISQNM: BLOCK QNMLEN ;QUEUE NAME
LISEND==.-1
SUBTTL Global data storage
G$ADR:: BLOCK JOBN ;JOB DATA BASE ADDRESS TABLE
G$PGM:: BLOCK 1 ;OUR PROGRAM NAME
G$NAM:: BLOCK 20 ;OUR PROCESS NAME
G$HNAM::BLOCK 1 ;HOST NODE NAME
G$HNBR::BLOCK 1 ;HOST NODE NUMBER
G$QPPN::BLOCK 1 ;QUEUE PPN
G$QPRT::BLOCK 1 ;SPOOLED FILE PROTECTION
G$SAB:: BLOCK SAB.SZ ;IPCF SEND ARGUMENT BLOCK
G$MSG:: BLOCK PAGSIZ+1 ;IPCF MESSAGE STORAGE
G$SND:: BLOCK 1 ;SENDER'S PID
G$SID:: BLOCK 1 ;SENDER'S ID
G$PRV:: BLOCK 1 ;SENDER'S PRIVS
G$FLG:: BLOCK 1 ;IPCF RECEIVE FLAGS
G$IDX:: BLOCK 1 ;SENDER'S SPECIAL PID INDEX
G$ACK:: BLOCK 1 ;NON-ZERO IF SENDER WANTS AN ACK
G$COD:: BLOCK 1 ;ACK CODE
G$NOW:: BLOCK 1 ;"NOW"
G$CLNC::BLOCK 1 ;-1 IF NEED TO CALL M%CLNC
SUBTTL Local data storage
PDL: BLOCK PDLMSZ ;MAIN PUSH DOWN LIST
CONFIG: BLOCK 5 ;MONITOR NAME
VECTOR:! ;START OF PSI VECTORS
TIMVEC: BLOCK 4 ;TIMER TRAP VECTOR
IPCVEC: BLOCK 4 ;IPCF INTERRUPT VECTOR
GLBVEC: BLOCK 4*GLBPSV ;SPARE GLOBAL PSI VECTORS
JOBVEC: BLOCK JOBPSV*<4*JOBN> ;STREAM VECTORS
IPCQUE: BLOCK 1 ;IPCF RESEND QUEUE
RSENDC: BLOCK 1 ;COUNT OF RESENDS NEEDED
MSGLEN: BLOCK 1 ;REQUESTED MESSAGE LENGTH
MSGBLK: BLOCK 1 ;ADDRESS OF CURRENT BLOCK IN MESSAGE
MSGCNT: BLOCK 1 ;COUNT OF MESSAGE BLOCKS TO PROCESS
BLKCNT: BLOCK 1 ;NUMBER OF BLOCKS IN MESSAGE BEING BUILT
CLKTIC: BLOCK 1 ;TIMER HAS GONE OFF
CLKTIM: BLOCK 1 ;CURRENT DATE/TIME
CLKNEW: BLOCK 1 ;NEW TIME INTERVAL
CURJOB: BLOCK 1 ;AOBJN POINTER FOR CURRENT JOB
NEWJOB: BLOCK 1 ;AOBJN POINTER FOR NEW JOB
RUNCNT: BLOCK 1 ;COUNT OF JOBS RUN LAST SCHEDULER PASS
ERRBEG:!
ERRTBL: BLOCK 1 ;UUO ERROR FLAG FOR DRIVER UUOS
ERRPC: BLOCK 1 ;UUO ERROR PC
ERRCOD: BLOCK 1 ;UUO ERROR CODE
ERRLVL: BLOCK 1 ;ERROR LEVEL
ERRCLS: BLOCK 1 ;ERROR CLASS
ERRNAM: BLOCK 1 ;UUO OPCODE NAME
ERRBUF: BLOCK 30 ;UUO ERROR TEXT BUFFER
ERREND==.-1
TMPDPB: IDPB S1,TMPPTR ;STUFF THE BYTE
$RETT
TMPPTR: BLOCK 1 ;BYTE POINTER INTO TEXT STRING BUFFER
TMPBUF: BLOCK 30 ;TEMPORARY BUFFER FOR BUILDING TEXT STRINGS
END NEBULA ;A GOOD PLACE TO START