Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
language-sources/qsrt20.mac
There are 36 other files named qsrt20.mac in the archive. Click here to see a list.
TITLE QSRT20 -- Operating System Interface for QUASAR-20
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC,ORNMAC ;PARAMETER FILE
PROLOGUE(QSRT20) ;GENERATE THE NECESSARY SYMBOLS
IFE FTJSYS,<
PASS2 ;DON'T BOTHER FOR TOPS-10 ASSEMBLY
END
> ;END OF IFE FTJSYS
COMMENT \
TOPS20 Field Interpretation
1) External Owner ID is a User Name
2) Owner ID (Internal) is a User Number
\
SUBTTL Module Storage
LVL1PC: BLOCK 1 ;PC AT INTERRUPT
FILJFN: BLOCK 1 ;JFN OF MASTER QUEUE FILE
FSPAGN: BLOCK 1 ;SCRATCH PAGE FOR I$READ/I$WRIT
FSADDR: BLOCK 1 ; SAME AS FSPAGN BUT AS AN ADDRESS
UNILST: BLOCK 1 ;LIST NUMBER OF UNIQUE LIST
; DIRECTORY FOR /UNIQUE CHECK
;LEVTAB AND CHNTAB MUST BE CONTIGUOUS AND IN THE FOLLOWING ORDER.
INTBLK==:<XWD LEVTAB,CHNTAB> ;USED FOR INTIALIZATION
LEVTAB: EXP LVL1PC ;POINTER TO OLD PC STORAGE
0 ;2ND AND
0 ;3RD LEVELS ARE UNUSED
CHNTAB: XWD INT.PL,C$INT## ;IPCF ON CHANNEL 0
0,,0 ;NOTHING ON CHANNEL 1
XWD INT.PL,N$INT## ;NETWORK CHANGE INTRPTS ON CHANNEL 2
BLOCK ^D33 ;FILL IN REST OF TABLE
INTERN USR ;THESE 2 ITEXTS ARE USED BY THE QUEUE'S
INTERN STRUCT ; LISTING ROUTINES IN QSRDSP
INTERN MNTUSR ;SAME AS USR EXCEPT FOR MOUNT DISPLAYS
USR: ITEXT (<^T/.QEOWN(AP)/>) ;ASCIZ TOPS-20 OWNER NAME.
MNTUSR: ITEXT (<^T/.MRNAM(AP)/>) ;ASCIZ TOPS-20 USER NAME
STRUCT: ITEXT (<^T/STRNAM(S1)/>) ;ASCIZ TOPS-20 STRUCTURE NAME
DEFINE X(QUE),<
<SIXBIT/QUE/>!<.OT'QUE> >
RETSEQ: BLOCK 1 ;SEQUENCE COUNTER FOR RET QUEUE
QLIST: DEVQUE
NDEVS==.-QLIST
SUBTTL Initialization Routine
;ROUTINE TO INITIALIZE THE WORLD. I$INIT INITIALIZES THE I/O
; SYSTEM.
;
I$INIT:: CIS ;CLEAR THE INTERRUPT SYSTEM
PUSHJ P,.SAVET ;SAVE T REGS
MOVEI S1,.MUMPS ;FUNCTION FOR MAX PACKET SIZE
MOVEM S1,INIT.B ;STORE AWAY
ZERO INIT.B+1 ;CLEAR SECOND WORD
MOVEI S1,2 ;GET BLOCK SIZE
MOVEI S2,INIT.B ;AND ADDRESS OF BLOCK
MUTIL ;GET THE INFO
$STOP(CGP,CAN'T GET PACKET SIZE)
MOVE S1,INIT.B+1 ;GET THE ANSWER
MOVEM S1,G$MPS## ;SAVE IT
SKIPE DEBUGW ;ARE WE [PRIVATE]QUASAR?
JRST INIT.1 ;YES, NO NEED TO QUERY <SPOOL>
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,[ASCIZ /PS:<SPOOL>/] ;DIRECTORY OF SPOOL
RCDIR ;RECOGNIZE IT
TXNE S1,RC%NOM ;MATCH?
$STOP(NSD,NO SPOOLING DIRECTORY)
MOVE S1,T1 ;COPY DIR NUMBER INTO S1
MOVEI S2,TMPBFR ;LOAD ADDR OF BLOCK
ZERO T1 ;DON'T WANT THE PASSWORD
GTDIR ;GET DIRECTORY INFO
ERCAL S..NSD ;
HRRZ S1,TMPBFR+7 ;GET DEFAULT PROTECTION
MOVEM S1,G$SPRT## ;AND STORE IT
INIT.1: ZERO G$MCOR## ;THERE IS NO SYSTEM MINIMUM
MOVEI S1,777777 ;512 PAGES
MOVEM S1,G$XCOR## ;IS MAXIMUM CORE LIMIT
SETO S1, ;-1 = MY JOB
HRROI S2,T2 ;POINT TO ARG BLOCK
SETZ T1, ;WORD 0
GETJI ;GET MY JOB NUMBER
$STOP(CGJ,CANT GET JOB NUMBER)
$SITEM T2,QJOB ;AND STORE IT
PUSHJ P,I%ION ;ENABLE INTERRUPTS
PUSHJ P,L%CLST ;CREATE A LIST
MOVEM S1,UNILST ;SAVE LIST NAME
MOVX S1,.SFAVR ;GET ACCOUNT VALIDATION CODE
TMON ;FIND OUT IF ITS SET
ERJMP .+2 ;NO GOOD,,VALIDATION NOT ON !!!
SETOM G$ACTV## ;ELSE WE'RE ACCOUNT VALIDATING..
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;FLUSH THE RETREIVAL QUEUES FOR JOBS WHICH WERE WAITING.
SETOM G$APID## ;SET ACCOUNTING PID TO -1
ZERO P1 ; and initialize sequence number
MOVEI H,HDRRET## ; Point to RET queue header
LOAD E,.QHLNK(H),QH.PTF ; Point to first entry
INIT.2: JUMPE E,INIT.4 ; Quit if end of queue
LOAD P2,.QESEQ(E),QE.SEQ ; Get sequence number
CAMGE P1,P2 ; Biggest yet?
MOVE P1,P2 ; Yes, update max
LOAD P3,.QESEQ(E),QE.PRI ; Get priority
CAIE P3,.RETRW ; Was this job waiting?
JRST INIT.3 ; No, skip it
LOAD S1,.QESTN(E),QE.DPA
MOVE AP,E
PUSHJ P,F$RLRQ## ; Release failsoft copy
MOVE AP,E ; To be safe
LOAD E,.QELNK(E),QE.PTN ; Do this before freeing
PUSHJ P,M$RFRE## ; Delink and free the cell
INIT.3: LOAD E,.QELNK(E),QE.PTN ; Point to next in Q
JRST INIT.2 ; Continue
INIT.4: MOVEM P1,RETSEQ ; Remember sequence number
MOVE S1,G$LNAM## ;GET THE HOST NODE NAME
STORE S1,COMSTA##+.OHDRS+ARG.DA+OBJ.ND ;SAVE IT
MOVEI S1,.OTXFR ;GET THE FILE TRANSFER OBJ TYPE
STORE S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
MOVEI M,COMSTA## ;ISSUE THE STARTUP COMMAND
PUSHJ P,A$OSTA## ;FOR THE FILE TRANSFER PROCESSOR
MOVEI S1,.OTRET ;GET THE RETRIEVAL OBJ TYPE
STORE S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
MOVEI M,COMSTA## ;ISSUE THE STARTUP COMMAND
PUSHJ P,A$OSTA## ;FOR THE RETRIEVAL PROCESSOR
MOVEI S1,.OTNOT ;GET THE NOTIFICATION OBJ TYPE
STORE S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
MOVEI M,COMSTA## ;ISSUE THE STARTUP COMMAND
PUSHJ P,A$OSTA## ;FOR THE NOTIFICATION PROCESSOR
PUSHJ P,NTIMER ;GO SET THE NOTIFICATION TIMER
$RETT ;RETURN WHEN DONE
INIT.B: BLOCK 2 ;MUTIL BLOCK
TMPBFR: BLOCK ^D14 ;GTDIR BLOCK
SUBTTL Information
;ENTRY POINTS
INTERN I$SYSV ;READ AND REMEMBER TIME-DEPENDENT SYSTEM VARIABLES
INTERN I$WHEEL ;CHECK IF CURRENT SENDER IS SOME FLAVOR OF OPERATOR
INTERN I$AGE ;COMPUTE AGE USING INTERNAL FORMAT DATE/TIME
INTERN I$AFT ;MODIFY AN INTERNAL TIME BY ADDITION
INTERN I$CHAC ;CHECK ACCESS
INTERN I$NINT ;TURN ON NETWORK CHANGE INTERRUPTS
SUBTTL I$SYSV -- Read time-dependent system variables
;I$SYSV is called to read and remember all relevent system variables
; which could change with time. On TOPS20 these are:
;
; Variable Memeory
; -------- -------
;
; Time till KSYS G$KSYS = > 0 --- seconds till KSYS
; = = 0 --- no KSYS set
; = < 0 --- timesharing is over
; Batch logins allowed G$LOGN = 0 --- no
; = -1 --- yes
; Time of day G$NOW
I$SYSV: PUSHJ P,I%NOW ;GET TIME OF DAY
MOVEM S1,G$NOW## ;STORE IT
MOVE S1,[SIXBIT/DWNTIM/] ;THE SYSTEM TABLE NAME
SYSGT ;GET THE TABLE NUMBER AND ENTRY 0
SKIPN S2 ;SKIP IF THE TABLE EXISTS
ZERO S1 ;ELSE RETURN A ZERO
JUMPE S1,SYSV.2 ;EXIT IF NONE PENDING
PUSH P,S1 ;SAVE TIME FOR NOW
MOVEI S1,1 ;FIND NOW PLUS 1 MINUTE
PUSHJ P,I$AFT ;COMPUTE IT
POP P,S2 ;NOW GET WHEN SCHEDULED
SUB S2,S1 ;CALC # OF JIFFIES TILL SHUTDOWN
IDIVI S2,3 ;CALC # OF SECONDS TILL SHUTDOWN
SKIPN S1,S2 ;GET # OF SECONDS IN S1
SETOM S1 ;IF 0,,THEN MAKE IT NEGATIVE
SYSV.2: MOVEM S1,G$KSYS## ;AND STORE RESULT
SETOM G$LOGN## ;ASSUME LOGINS ALLOWED
MOVX S1,.SFPTY ;PTY LOGINS BIT
TMON ;TEST IT
SKIPN S2 ;CAN WE?
SETZM G$LOGN## ;NOPE!
$RETT ;AND RETURN
SUBTTL I$WHEEL -- Determine whether sender of current message is privileged
;Call to determine whether the send of the current IPCF message has lots of
; privs.
;Call: No arguments
;T Ret: If caller is a wheel (or operator)
;F Ret: If caller has no special privs
I$WHEEL:
MOVE S1,G$PRVS## ;GET PRIVS WORD
SKIPN DEBUGW ;IF DEBUGGING, ALWAYS SUCCEED
TXNE S1,MD.PWH!MD.POP ;WHEEL OR OPERATOR?
$RETT ;YES, RETURN TRUE
$RETF ;NOW RETURN FALSE
SUBTTL I$AGE -- Routine to compare two times in internal format
;ROUTINE TO COMPUTE THE AGE IN SECONDS BASED ON THE INTERNAL DATE/TIME FORMAT
;
;CALL:
; S1 AND S2 ARE THE TIMES TO COMPUTE AGES
; PUSHJ P,I$AGE
; RETURNS HERE WITH AGE IN SECONDS IN S1
;DESTROYS S1,S2 IN THE PROCESS
I$AGE: CAMGE S1,S2 ;ORDERING CHECK
EXCH S1,S2 ;WANT THE LARGEST IN S1
SUB S1,S2 ;SUBTRACT THEM
IDIVI S1,3 ;RESOLUTION IS APPROX. 1/3 SEC
SKIPG S1 ;ANY TIME HERE ???
MOVEI S1,1 ;NO,,RETURN 1 SECOND
$RETT ;RETURN
SUBTTL I$AFT -- Routine to modify an internal time
;ROUTINE TO RETURN G$NOW + A SPECIFIED INTERVAL.
;
;CALL:
; S1 CONTAINS INTERVAL IN MINUTES
; PUSHJ P,I$AFT
; RETURN HERE WITH S1=G$NOW+SPECIFIED INTERVAL
I$AFT: ZERO S2 ;ZERO FOR A SHIFT
ASHC S1,-^D17 ;GENERATE DOUBLE CONSTANT
; = ARG*2^18
DIVI S1,^D1440 ;DIVIDE BY MIN/DAY
ADD S1,G$NOW## ;ADD IN NOWTIM
$RETT ;AND RETURN
SUBTTL I$CHAC -- Routine to Check File Access
;ROUTINE TO CHECK FILE AND QUEUE REQUEST ACCESS
;
;CALL:
; MOVE S1,[ACCESS CODE,,PROTECTION]
; MOVE S2,DIRECTORY OF FILE OR REQUEST
; PUSHJ P,I$CHAC
; RETURN HERE ALWAYS
;
;CHECK IS MADE AGAINST SENDER OF CURRENT REQUEST
;TRUE RETURN: ACCESS ALLOWED
;FALSE RETURN: ACCESS NOT ALLOWED
I$CHAC: LOAD S1,G$SID## ;GET SENDER'S ID
CAME S1,S2 ;IS HE THE OWNER
PJRST I$WHEEL ;NO, WIN ONLY IF WHEEL
$RETT ;YES, LET HIM DO IT
SUBTTL I$NINT - ROUTINE TO SETUP FOR NETWORK CHANGE INTERRUPTS
I$NINT: MOVX S1,.NDSIC ;GET ADD CHANNEL TO INTRPT SYS FUNCTION
MOVEI S2,T1 ;GET THE ARGUMENT BLOCK ADDRESS
MOVEI T1,2 ;WANT INTERRUPTS ON CHANNEL 2
NODE ;TELL THE SYSTEM WHAT WE WANT
ERJMP .RETT ;ON AN ERROR,,JUST IGNORE IT
MOVX S1,.FHSLF ;GET MY PROCESS HANDLE
MOVX S2,1B2 ;WANT CHANNEL 2
AIC ;ACTIVATE NETWORK CHANGE INTERRUPTS
ERJMP .+1 ;IGNORE ANY ERROR
$RETT ;AND RETURN
SUBTTL IPCF Interface
;ENTRY POINTS
INTERN I$IPS ;IPCF SEND
SUBTTL I$IPS -- Send an IPCF Message
;ROUTINE TO SEND AN IPCF MESSAGE.
;CALL:
; MOVE S1,PDB SIZE
; MOVE S2,ADDRESS OF PDB
; PUSHJ P,I$IPS
;
;TRUE RETURN: IF SEND IS OK
;FALSE RETURN: IF SEND FAILS, ERROR CODE IN S1
I$IPS: MSEND ;SEND THE MESSAGE
$RETF ;ERROR RETURN
$RETT ;WIN, RETURN ALL OK
SUBTTL FD Manipulation Routines
INTERN I$CSM ;Create a Canonical SPOOL Message
INTERN I$CLM ;Create a Canonical LOGOUT Message
SUBTTL I$CSM -- Create a Canonical SPOOL Message
;CALL I$CSM TO CONVERT A SPOOL MESSAGE RECEIVED FROM THE OPERATING SYSTEM
; INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL: M/SPOOL MESSAGE ADDRESS
; PUSHJ P,I$CSM
; RETURN HERE WITH S1 CONTAINING THE ADR OF THE CSM
I$CSM: PUSHJ P,.SAVET ;SAVE T1-T4 FOR USE HERE
MOVE T1,[CSM.A,,CSM.A+1] ;SET UP TO ZERO CSM AREA
ZERO CSM.A ;ZERO FIRST WORD
BLT T1,CSM.A+CSMSIZ-1 ;AND ALL THE REST
LOAD T1,SPL.JB(M),SP.JOB ;GET THE JOB NUMBER
STORE T1,CSM.A+CSM.JB,CS.JOB ;AND SAVE IT IN CSM
LOAD T1,SPL.FL(M),SP.DFR ;GET THE DEFER BIT
STORE T1,CSM.A+CSM.JB,CS.DFR ;AND SAVE IT@IN SPOOL MESSAGE
LOAD T1,SPL.FL(M),SP.LOC ;GET THE STATION NUMBER
STORE T1,CSM.A+CSM.JB,CS.LOC ;AND SAVE IT IN CSM
MOVE S1,[POINT 7,G$LOCN##] ;POINT TO THE JOBS LOCATION (IN ASCII)
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
STORE S2,CSM.A+CSM.RO+.ROBND ;SAVE IT AS THE DESTINATION NODE
LOAD T1,G$SID## ;GET THE USERS ID
STORE T1,CSM.A+CSM.OI ;STORE IT IN CSM
LOAD T1,SPL.BV(M),SP.SIZ ;GET THE FILE SIZE IN PAGES
STORE T1,CSM.A+CSM.FS ;SAVE IT IN CSM
MOVE T1,CSM.F ;GET THE STANDARD FLAGS FOR SPOOLING
STORE T1,CSM.A+CSM.FP ;INTO THE CSM
MOVEI S1,SPL.FI-1(M) ;GET THE ADDRESS OF THE FD
SETZM .FDLEN(S1) ;CLEAR THE COUNT FOR NOW
MOVEI T1,.FDSTG(S1) ;POINT T1 TO THE FILESPEC
STORE S1,CSM.A+CSM.FD,CS.FDA ;AND SAVE IT AS THE ADDRESS OF THE CSM FD
HRLI T1,(POINT 7,0) ;MAKE T1 A BYTE POINTER TO THE FD
ZERO T2 ;BUT DON'T STORE THIS
MOVX T3,<76,,0> ;TERMINATE ON RIGHT ANGLE BRACKET
ZERO T4 ;NO COUNT
PUSHJ P,FBREAK ;SKIP TO END OF DIRECTORY
SKIPN S1 ;IF NOT NULL,,OK.
PUSHJ P,CSM.3 ;ELSE LEAVE A TRACK AND STOPCODE.
MOVE T2,[POINT 6,CSM.A+CSM.RO+.ROBTY] ;STORE NEXT STUFF AS DEVICE
MOVEI T4,6 ;ONLY 6 CAHRACTERS
MOVE T3,["-",,"A"-'A'] ;STOP ON -, CONVERT TO SIXBIT
PUSHJ P,FBREAK ;PICK UP DEVICE NAME
SKIPN S1 ;IF NOT NULL,,OK.
PUSHJ P,CSM.3 ;ELSE LEAVE A TRACK AND STOPCODE.
ZERO T2 ;DON'T STORE ANYTHING
ZERO T4 ;NO COUNT
MOVSI T3,"-" ;STOP ON MINUS
PUSHJ P,FBREAK ;SKIP THE STATION NUMBER
SKIPN S1 ;IF NOT NULL,,OK.
PUSHJ P,CSM.3 ;ELSE LEAVE A TRACK AND STOPCODE.
;"I$CSM" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
ZERO T4 ;NO COUNT
ZERO T2 ;NO DESTINATION
MOVSI T3,"-" ;STOP ON MINUS
PUSHJ P,FBREAK ;AND THE DIRECTORY NUMBER
SKIPN S1 ;IF NOT NULL,,OK.
PUSHJ P,CSM.3 ;ELSE LEAVE A TRACK AND STOPCODE.
MOVE T2,[POINT 6,CSM.A+CSM.EN] ;SET UP TO STORE THE ENTERED NAME
MOVEI T4,6 ;ONLY 6 CHARACTERS
MOVE T3,[".",,"A"-'A'] ;ENDED WITH ., CONVERTED TO SIXBIT
PUSHJ P,FBREAK ;PICK UP THE ENTERED NAME
SKIPN S1 ;IF NOT NULL,,OK
PUSHJ P,CSM.3 ;ELSE LEAVE A TRACK AND STOPCODE.
SKIPN S1,CSM.A+CSM.EN ;GET ENTERED NAME INTO S1
LOAD S1,SPL.PG(M) ;IF NO ENTERED NAME,USE PROGRAM NAME
STORE S1,CSM.A+CSM.EN ;SAVE AS ENTERED NAME
CSM.1: ILDB T2,T1 ;PICK UP NEXT CHARACTER
JUMPN T2,CSM.1 ;LOOP UNTIL A NUL
TLZ T1,-1 ;CONVERT BYTE POINTER TO ADDRESS
SUBI T1,SPL.FI-2(M) ;AND MAKE INTO LENGTH OF FD
LOAD T2,CSM.A+CSM.FD,CS.FDA ;GET ADDRESS OF THE FD
STORE T1,.FDLEN(T2),FD.LEN ;AND STORE THE LENGTH
MOVSI S1,-NDEVS ;CREATE AN AOBJN AC.
HLLZ T1,CSM.A+CSM.RO+.ROBTY ;GET THE DEVICE NAME.
HRRZ T2,CSM.A+CSM.RO+.ROBTY ;GET THE DEVICE NUMBER
CSM.2: HLLZ S2,QLIST(S1) ;FIND THE DEVICE TYPE
CAME S2,T1 ; FROM THE SPOOL MSG IN THE LIST OF Q'S
JRST [AOBJN S1,CSM.2 ;NO MATCH,,TRY THE NEXT ENTRY
PUSHJ P,CSM.3 ] ;NO THERE,,LEAVE A TRACK AND STOPCODE.
HRRZ S2,QLIST(S1) ;PICK UP THE .OT??? SYMBOL (Q TYPE)
MOVEM S2,CSM.A+CSM.RO+.ROBTY ;SAVE IT AS THE OBJECT TYPE.
JUMPE T2,CSM.2A ;NO DEVICE SPECIFIED,,JUST RETURN
LSH T2,-^D12 ;RIGHT JUSTIFY THE DEVICE NUMBER
SUBI T2,'0' ;MAKE IT BINARY
TXO T2,RO.PHY ;TURN ON PHYSICAL BIT
STORE T2,CSM.A+CSM.RO+.ROBAT ;SAVE AS DEVICE ATTRIBUTES
CSM.2A: MOVEI S1,CSM.A ;PUT ADDRESS OF CSM IN S1 FOR CALLER
$RETT ;AND RETURN
CSM.3: $STOP(BSD,Bad SPOOL data)
CSM.A: BLOCK CSMSIZ ;PLACE FOR CSM
CSM.F: INSVL.(.FPFAS,FP.FFF)!INSVL.(1,FP.FSP)!FP.DEL!FP.SPL!INSVL.(1,FP.FCY)
SUBTTL I$CLM -- Create a Canonical LOGOUT Message
;CALL I$CLM TO CONVERT A LOGOUT MESSAGE RECEIVED FROM THE OPERATING SYSTEM
; INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL:
; MOVE S1,[ADR OF LOGOUT MESSAGE FROM OPERATING SYSTEM]
; PUSHJ P,I$CLM
; RETURN HERE WITH S1 CONTAINING THE ADR OF THE CLM
I$CLM: MOVX S2,.IPCSL ;GET FUNCTION CODE
STORE S2,<CLM.A+CLM.FC> ;STORE THE FUNCTION
LOAD S2,LGO.JB(S1),LG.JOB ;GET JOB NUMBER
STORE S2,<CLM.A+CLM.JB>,CL.JOB ;STORE IT
LOAD S2,LGO.FL(S1),LG.BAT ;GET THE BATCH BIT
STORE S2,<CLM.A+CLM.JB>,CL.BAT ;STORE IT
MOVEI S1,CLM.A ;LOAD ADR OF THE CLM
$RETT ;AND RETURN
CLM.A: BLOCK CLMSIZ ;BLOCK TO RETURN CLM
SUBTTL Routines to handle system dependent fields
INTERN I$EQQE ;Move fields from EQ to QE
INTERN I$QESM ;Move fields from QE to CSM
INTERN I$SMEQ ;Move fields from CSM to EQ
INTERN I$RMCH ;Match a request and an RDB
INTERN I$DFEQ ;Default and check an EQ
INTERN I$LGFD ;BUILD A LOG FILE FD.
INTERN I$MUSR ;MOVE A USER ID TO AN RDB.
INTERN I$ONOD ;Default the batch ONOD limit word
INTERN I$CACV ;'CREATE' ACCT STRING VALIDATION
INTERN I$SACV ;'SCHEDULE' ACCT STRING VALIDATION
INTERN I$ACTV ;A NO-OP ON THE -20
INTERN I$DFMR ;FILL IN SYSTEM DEPENDENT DATA IN MDR
SUBTTL I$EQQE - Move fields from EQ to QE
;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE EXTERNAL
; QUEUE REQUEST (EQ) TO THE INTERNAL QUEUE ENTRY (QE).
;
;CALL:
; MOVE S1,<ADDRESS OF EQ>
; MOVE AP,<ADDRESS OF QE>
; PUSHJ P,I$EQQE
; ALWAYS RETURN HERE
I$EQQE: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE THE EQ ADDRESS
MOVSI S2,.EQOWN(P1) ;SETUP TO BLT THE OWNER'S NAME
HRRI S2,.QEOWN(AP) ;FORM EQ TO QE
BLT S2,.QEOWN+7(AP) ;ZAP!!
MOVSI S2,.EQCON(P1) ;POINT TO CONNCECTED DIRECTORY
HRRI S2,.QECON(AP) ;PLACE TO BLT TO
BLT S2,.QECON+11(AP) ;AND BLT IT
$RETT ;RETURN
SUBTTL I$QESM - Move fields from the QE to CSM
I$QESM: $RETT ;THIS IS A NO-OP ON THE -20
SUBTTL I$SMEQ - ROUTINE TO MOVE FIELDS FROM THE CSM TO EQ
;CALL:
; MOVE S1,<ADDRESS OF CSM>
; MOVE AP,<ADDRESS OF EQ>
; PUSHJ P,I$SMEQ
; ALWAYS RETURN HERE
I$SMEQ: LOAD S2,CSM.OI(S1) ;GET THE OWNER ID
STORE S2,.EQOID(AP) ;SAVE IT IN THE EQ
HRROI S1,.EQOWN(AP) ;POINT TO EQ
DIRST ;CONVERT TO STRING
$STOP(ODE,OWNER DOESNT EXIST)
$RETT ;AND RETURN
SUBTTL I$RMCH -- Match a request and an RDB
;ROUTINE TO DETERMINE WHETHER OR NOT A PARTICULAR QUEUE ENTRY MATCHES
; THE REQUEST DESCRIPTION IN A PARTICULAR REQUEST DESCRIPTION
; BLOCK (RDB)
;
;CALL:
; MOVE S1,<ADDRESS OF RDB>
; MOVE AP,<ADDRESS OF QE>
; PUSHJ P,I$RMCH
; ALWAYS RETURN HERE
I$RMCH: SKIPN S2,.RDBRQ(S1) ;IS THERE A JOB ID NUMBER ???
JRST RMCH.0 ;NO,,THEN CONTINUE ON.
CAME S2,[-1] ;IS IT ALL JOBS ???
CAMN S2,.QERID(AP) ; OR DO WE MATCH ???
$RETT ;YES,,THEN RETURN OK
$RETF ;ELSE RETURN NO GOOD !!
RMCH.0: PUSHJ P,.SAVE1 ;SAVE P1
SKIPN P1,.RDBES(S1) ;LOAD EXTERNAL SEQ #
JRST RMCH.1 ;ZERO ASSUME A MATCH
LOAD S2,.QESEQ(AP),QE.SEQ ;GET SEQUENCE NUMBER FROM THE QE
CAME S2,P1 ;DO THEY MATCH?
$RETF ;NO, STOP NOW
RMCH.1: LOAD S2,.QEJOB(AP) ;GET JOBNAME FROM QE
XOR S2,.RDBJB(S1) ;FIND WHATS DIFFERENT
AND S2,.RDBJM(S1) ;MASK OUT INSIGNIFICANT PARTS
JUMPN S2,.RETF ;AND RETURN IF NO MATCH
MOVEI P1,.RDBOW(S1) ;GET THE USER NAME ADDRESS
SKIPE 0(P1) ;IS THERE A USER NAME ???
JRST RMCH.2 ;YES,,CONTINUE
SKIPE G$QOPR## ;NOT THERE,,IS THIS AN OPERATOR REQUEST
$RETT ;YES,,THEN WE MATCH.
HRRO S1,P1 ;NO,,CONVERT THE
MOVE S2,G$SID## ;SENDERS ID TO HIS
DIRST ;ASCIZ USER NAME
ERJMP .RETF ;IF AN ERROR,,NO MATCH !!
RMCH.2: MOVE S2,P1 ;GET THE ADDRESS
HRLI S2,(POINT 7,0) ;AND MAKE A BYTE POINTER
MOVX S1,<POINT 7,.QEOWN(AP)> ;POINT TO REQUEST OID
PJRST STGWLD ;MATCH AND PROPAGATE TRUE OR FALSE
SUBTTL I$DFEQ -- Default and check the EQ
;ROUTINE TO DEFAULT AND CHECK THE OPERATING SYSTEM DEPENDENT VALUES
; IN THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
; MOVE S1,<ADDRESS OF EQ>
; PUSHJ P,I$DFEQ
; ALWAYS RETURN HERE WITH T/F INDICATION
I$DFEQ: PUSHJ P,.SAVET ;SAVE T REGS
MOVE T2,S1 ;COPY EQ ADR INTO T2
SETZB T3,T4 ;CLEAR SOME FLAGS
MOVE S1,[POINT 7,G$LOCN##] ;GET THE REQUESTS LOCATION
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
SKIPN .EQROB+.ROBND(T2) ;IS THE NODE SPECIFIED ???
MOVEM S2,.EQROB+.ROBND(T2) ;NO,,SAVE THIS AS THE DESTINATION NODE
SKIPE .EQOWN(T2) ;IS OWNER SET?
JRST DFEQ.0 ;YES, CONTINUE
SETOM T3 ;FLAG DEFAULT ON .EQOWN
HRROI S1,.EQOWN(T2) ;NO, POINT TO LOCATION
LOAD S2,G$SID## ;GET DEFAULT
STORE S2,.EQOID(T2) ;SAVE THE USER ID IN THE EQ
DIRST ;AND GET DEFAULT ONWER STRING
ERJMP E$CDU## ;RETURN THROUGH CANT DEFAULT USER ERROR
DFEQ.0: SKIPE .EQCON(T2) ;IS CON DIR SET?
JRST DFEQ.1 ;YES, DONT DEFAULT IT
SETOM T4 ;FLAG DEFAULTED .EQCON
HRROI S1,.EQCON(T2) ;POINT TO BLOCK
LOAD S2,G$CDI## ;GET THE DEFAULT
DIRST ;GET THE CONNECTED DIRECTORY
ERJMP E$CDD## ;RETURN THROUGH CANT DEFAULT DIRECTORY
DFEQ.1: JUMPL T3,DFEQ.2 ;DON'T CHECK IF EQOWN WAS DEFAULT
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,.EQOWN(T2) ;POINT TO THE OWNER BLOCK
RCUSR ;GET THE NUMBER
ERJMP .RETF ;IF IT FAILS,,TRASH THE REQUEST
TXNE S1,RC%NOM ;NO MATCH?
$RETF ;YES, NO MATCH
STORE T1,.EQOID(T2) ;SAVE THE USER ID IN THE EQ.
CAMN T1,G$SID## ;MATCH, IS IT OK?
JRST DFEQ.2 ;YES,,CONTINUE ON..
PUSHJ P,I$WHEEL ;NO, WIN ONLY IF HE'S A WHEEL
JUMPF .RETF ;NOT A WHEEL,,TOUGH BREAKEEE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
DFEQ.2: JUMPL T4,DFEQ.3 ;IF CON DIR WAS DEFAULTED,,CHECK JOBNAME
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,.EQCON(T2) ;NOW CHECK CONNECTED
RCDIR ;CHECK IT
ERJMP E$ICD## ;IF IT FAILS,,TRASH THE REQUEST
TXNE S1,RC%NOM ;MATCH?
PJRST E$ICD## ;NO, LOSE
CAMN T1,G$CDI## ;IS IT OK?
JRST DFEQ.3 ;YES,,CONTINUE ON..
PUSHJ P,I$WHEEL ;NO,,WIN ONLY IF HE IS A WHEEL
JUMPF E$ICD## ;NOT A WHEEL,,LETS LEAVE.
DFEQ.3: LDB S1,[POINT 7,.EQACT(T2),6] ;GET THE FIRST BYTE OF THE ACCT STRING
JUMPN S1,DFEQ.5 ;IF THERE IS ONE THERE,,VERIFY IT.
MOVE S1,G$ACCT## ;GET THE SENDERS ACCOUNT STR ADDRESS.
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER.
MOVE S2,[POINT 7,.EQACT(T2)] ;THIS IS WHERE WE WANT IT TO GO.
DFEQ.4: ILDB T1,S1 ;COPY THE ACCOUNT STRING
IDPB T1,S2 ; TO THE EQ ENTRY.
JUMPN T1,DFEQ.4 ;END ON A NULL,,ELSE CONTINUE.
JRST DFEQ.6 ;SKIP OVER THE ACCOUNT VALIDATION
DFEQ.5: MOVE S1,T2 ;GET THE EQ ADDRESS
PUSHJ P,I$CACV ;GO VALIDATE THE ACCOUNT STRING
JUMPF E$IAS## ;NO GOOD,,RETURN WITH AN ERROR
DFEQ.6: SKIPE .EQJOB(T2) ;IS THERE A JOB NAME ???
$RETT ;YES,,DONT DEFAULT IT.
LOAD T1,.EQLEN(T2),EQ.LOH ;GET THE HEADER LENGTH
ADD T1,T2 ;POINT TO THE FIRST FP
LOAD S1,.FPLEN(T1),FP.LEN ;GET THE FP LENGTH
ADDI T1,.FDFIL(S1) ;POINT TO THE FIRST FILE-SPEC
HRLI T1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVSI T3,76 ;STOP AT THE '>'
SETZ T4, ;DONT STORE ANY DATA
PUSHJ P,FBREAK ;STRIP THE FILE-SPEC UP TO THE FILENAME
SKIPN S1 ;ANYTHING THERE ???
PJRST E$IFS## ;MUST BE AN INVALID FILESPEC
MOVEI T4,6 ;COUNT 6 BYTES
MOVE S2,[POINT 6,.EQJOB(T2)] ;GET OUTPUT BYTE POINTER
SKIPA T3,[0] ;SKIP THE FIRST TIME THROUGH
DFEQ.7: SETOM T3 ;INDICATE A ^V WAS READ
DFEQ.8: ILDB S1,T1 ;GET A FILESPEC BYTE
CAIN S1,26 ;IS IT ^V ???
JRST DFEQ.7 ;YES,,IGNORE IT AND SET FLAG
CAILE S1," " ;LESS OR EQUAL TO A BLANK ???
CAILE S1,"z" ; OR GREATER THEN "z"
MOVEI S1,"?" ;YES,,MAKE IT A "?"
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CAIL S1,"a" ;IF ITS LOWER CASE THEN
SUBI S1,40 ; MAKE IT UPPER CASE
SUBI S1,40 ;CONVERT IT TO SIXBIT
CAIN S1,'.' ;END ON A PERIOD (UNLESS ^V)
JUMPE T3,.RETT ;NO ^V,,THEN WE ARE DONE
CAIN S1,'-' ;ALSO CHECK FOR A '-' AS THE
CAIE T4,1 ; LAST CHARACTER IN THE JOB NAME
SKIPA ;HERE,,HE IS OK...
$RETT ;HERE,,DONT SAVE THE '-', JUST RETURN
IDPB S1,S2 ;SAVE IT
SETZM T3 ;CLEAR ^V FLAG
SOJG T4,DFEQ.8 ;CONTINUE FOR 6 BYTES
$RETT ;AND RETURN
SUBTTL I$LGFD - ROUTINE TO BUILD A LOG FILE FD.
;I$LGFD IS CALLED BY THE INPUT QUEUE DEFAULT FILLER TO GENERATE AN FD
; FOR A LOG FILE ON A JOB WHERE NO LOG FILE IS GIVEN.
;CALL: S1/ ADDRESS OF THE LOCATION TO START BUILDING THE FD.
; S2/ THE FP ADDRESS
; M/ THE EQ ADDRESS
;T RET: ALWAYS
I$LGFD: MOVE S2,.FPINF(S2) ;GET THE FP FLAG WORD FOR THIS FILE
TXNN S2,FP.SPL ;IS IT SUPPOSED TO BE 'SPOOLED' ???
JRST LGFD.1 ;NO,,CREATE A USER LOG FILESPEC
$TEXT (<-1,,.FDSTG(S1)>,<^T/SPOOL/^O/.EQITN(M)/.LOG>^0)
MOVEI S2,13 ;GET THE FD LENGTH.
STORE S2,.FDLEN(S1),FD.LEN ;AND SET IT
$RETT ;RETURN.
;HERE IF WE HAVE TO DEFAULT THE LOG FILE SPEC FOR THE USER
LGFD.1: PUSHJ P,.SAVET ;SAVE THE 'T' AC'S
MOVE T4,S1 ;SAVE THE FD ADDRESS FOR A MINUTE
HRROI S1,.FDSTG(S1) ;POINT TO WHERE WE WANT THE CONNECTED
MOVE S2,G$CDI## ; DIRECTORY PUT
DIRST ;GEN THE CONNECTED DIRECTORY
ERJMP E$IFS## ;ON AN ERROR,,'INVALID FILE SPEC'
PUSH P,S1 ;SAVE THE UPDATED BYTE POINTER
LOAD S1,.EQLEN(M),EQ.LOH ;GET THE HEADER LENGTH
ADD S1,M ;POINT TO THE FIRST FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADD S1,S2 ;POINT TO THE FIRST FD
HRROI S2,.FDSTG(S1) ;POINT TO THE ACTUAL FILE-SPEC
MOVX S1,GJ%SHT+GJ%OFG ;SHORT + PARSE ONLY JFN
GTJFN ;GET A JFN
JRST E$IFS## ;ON AN ERROR,,'INVALID FILE SPEC'
MOVE S2,S1 ;GET THE JFN IN S2
POP P,S1 ;GET THE DESTINATION POINTER
MOVX T1,JS%NAM ;WANT FILE NAME ONLY
SETZM T2 ;NO ADDITION POINTERS
JFNS ;GET THE FILENAME
EXCH S1,S2 ;GET JFN IN S1,,UPDATED PTR IN S2
RLJFN ;RELEASE THE JFN
JFCL ;IGNORE THE ERROR
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE S1,[POINT 7,LOG] ;GET THE .LOG EXTENSION BYTE POINTER
LGFD.2: ILDB T1,S1 ;GET A BYTE
IDPB T1,S2 ;SAVE IT
SKIPE T1 ;END ON THE NULL
JRST LGFD.2 ;ELSE CONTINUE
HRRZS S2 ;GET END FILESPEC ADDRESS ONLY
SUBI S2,-1(T4) ;GET FD LENGTH
STORE S2,.FDLEN(T4),FD.LEN ;SAVE IT
$RETT ;AND RETURN
LOG: ASCIZ/.LOG/
SPOOL: ASCIZ/PS:<SPOOL>BATCH-/
SUBTTL I$MUSR - MOVE AN RDB OWNER ID TO AN RDB BLOCK.
;ROUTINE TO MOVE AN RDB OWNER ID INTO AN RDB BLOCK FOR A
; HOLD/RELEASE MESSAGE.
;CALL:
; MOVE S1,OWNER ID ADDRESS.
; MOVEI S2,OUTPUT RDB ADDRESS
; PUSHJ P,I$MUSR##
; ALWAYS RETURN HERE
;
I$MUSR: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S2 ;SAVE THE OUTPUT RDB ADDRESS
SKIPN S1 ;CHECK IF THERE IS ONE.
JRST MUSR.2 ;NONE THERE,,SET TO 0 AND RETURN.
MOVE S2,0(S1) ;GET THE 36 BIT USER ID.
HRROI S1,.RDBOW(P1) ;THIS IS WHERE WE WANT IT.
DIRST ;TRANSLATE IT.
ERJMP MUSR.1 ;ON ERROR,,TOUGH BREAKEEE
$RETT ;ELSE RETURN OK.
MUSR.1: SETOM .RDBOW(P1) ;MAKE IT SO IT NEVER WORKS.
$RETT ;AND RETURN.
MUSR.2: SETZM .RDBOW(P1) ;CLEAR THE FIRST WORD OF THE RDB OWNER
$RETT ;AND RETURN
SUBTTL I$ONOD - ROUTINE TO DEFAULT THE BATCH ONOD LIMIT WORD
;CALL: M/ The EQ address
;
;RET: TRUE ALWAYS
I$ONOD: MOVE S1,[POINT 7,G$LOCN##] ;GET THE USERS LOCATION
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
STOLIM S2,.EQLIM(M),ONOD ;DEFAULT THE OUTPUT NODE NAME
$RETT ;AND RETURN
SUBTTL I$CACV - ROUTINE TO VALIDATE THE ACCOUNT STRING FOR 'CREATE'
;CALL: S1/EQ ADDRESS
;
;RET: TRUE IF VALID
; FALSE IF NOT
I$CACV: SKIPN G$ACTV## ;ARE WE VALIDATING AT ALL ???
$RETT ;NO,,JUST RETURN
MOVE S2,S1 ;PUT EQ ADDRESS INTO S2
LOAD S1,.EQOID(S2) ;GET THE USER NUMBER.
HRROI S2,.EQACT(S2) ;POINT TO THE USERS ACCOUNT STRING
VACCT ;VERIFY THE ACCOUNT STRING FOR THE USER.
ERJMP .RETF ;NO GOOD,,RETURN NOW.
$RETT ;OK,,RETURN SAYING SO.
SUBTTL I$SACV - ROUTINE TO VALIDATE ACCT STRINGS FOR 'SCHEDULING'
;CALL: S1/ EQ ADDRESS
; AP/ QE ADDRESS
;
;RET: TRUE IF ACCT OK
; IF ACCT INVALID. IF THE ACCT IS INVALID,
; THE EQ.IAS BIT IS LIT SO THAT THE SPOOLER CAN KILL IT
I$SACV: PUSHJ P,I$CACV ;GO VALIDATE THE ACCOUNT STRING
MOVX S2,QE.IAS ;GET THE INVALID ACCOUNT STRING BIT
SKIPT ;IS THE ACCOUNT STRING VALID ??.
IORM S2,.QESEQ(AP) ;NO,,LIGHT IAS BIT.
$RETT ;AND RETURN
SUBTTL I$ACTV - A NO-OP ON THE -20
I$ACTV: $RETT ;JUST RETURN
SUBTTL I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT DATA INTO MDR
;CALL: S1/ The MDR Address
; M / The Mount Message Address
;
;RET: True Always
I$DFMR: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;GET THE MDR ADDRESS IN P1
HRROI S1,.MRNAM(P1) ;POINT TO THE DESTINATION AREA
MOVE S2,.MRUSR(P1) ;GET THE USERS NUMBER
DIRST ;CONVERT NUMBER TO NAME
JFCL ;IGNORE THE ERROR
MOVE S1,G$ACCT## ;GET THE ACCOUNT STRING ADDRESS
HRLI S1,(POINT 7,0) ;CONVERT TO A BYTE POINTER
MOVEI S2,.MRACT(P1) ;GET THE DESTINATION ADDRESS
HRLI S2,(POINT 7,0) ;CONVERT TO A BYTE POINTER
DFMR.1: ILDB P1,S1 ;GET A BYTE
IDPB P1,S2 ;SAVE IT
JUMPN P1,DFMR.1 ;CONTINUE TILL ASCIZ
$RETT ;AND RETURN
SUBTTL Batch Stream Unique Directory Routines
INTERN I$UQST ;SET DIRECTORY FOR A STREAM
INTERN I$UQCL ;CLEAR DIRECTORY FOR A STREAM
INTERN I$UQCH ;COMPARE STREAM FOR UNIQNESS
SUBTTL I$UQST -- Set Directory for a Stream
;ROUTINE TO SET THE DIRECTORY FOR A STREAM FROM THE BATCH QUEUE ENTRY
;
;CALL:
; MOVEI S1,<STREAM NUMBER>
; MOVE AP,<BATCH QUEUE ENTRY (QE)>
; PUSHJ P,I$UQST
; ALWAYS RETURN HERE
I$UQST: PUSH P,S1 ;SAVE STREAM NUMBER
MOVE S1,UNILST ;GET LIST NAME
MOVEI S2,^D12 ;AND ENTRY SIZE
PUSHJ P,L%CENT ;CREATE AN ENTRY
POP P,0(S2) ;PUT STREAM NUMBER IN 1ST WORD
GETLIM S1,.QELIM(AP),UNIQ ;GET UNIQUE SETTING
STORE S1,1(S2) ;SAVE IT
HRLI S1,.QECON(AP) ;GET SOURCE ADDRESS
HRRI S1,2(S2) ;AND DESTINATION
BLT S1,^D11(S2) ;STORE THE DIRECTORY
$RETT ;AND RETURN
SUBTTL I$UQCL -- Clear the directory for a stream
;ROUTINE TO CLEAR OUT THE DIRECTORY FOR A STREAM
;
;CALL:
; MOVEI S1,<STREAM NUMBER>
; PUSHJ P,I$UQCL
; ALWAYS RETURN HERE
I$UQCL: PUSHJ P,UNIFST ;FIND THE STREAM ENTRY
MOVE S2,S1 ;PUT IT INTO S2.
MOVE S1,UNILST ;GET THE LIST NUMBER.
PUSHJ P,L%DENT ;DESTROY ENTRY
$RETT ;AND RETURN
SUBTTL I$UQCH -- Check for directory match
;Routine to determine whether a job meets all necessary UNIQNESS criteria
; to be scheduled.
;
;CALL: AP/ BATCH QUEUE ENTRY
;
;T RET: IF JOB CAN BE SCHEDULED
;F RET: IF JOB CANNOT BE SCHEDULED
I$UQCH: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,UNILST ;GET LIST NAME
PUSHJ P,L%FIRST ;POSITION TO THE BEGINNING
JUMPF .RETT ;EMPTY LIST WINS!!
UQCH.1: HRLI S2,-12 ;MAKE IT AN AOBJN POINTER ALSO
ADDI S2,2 ;AND POINT TO FIRST DIRECTORY WORD
MOVEI S1,.QECON(AP) ;POINT TO FIRST WORD IN QE
UQCH.2: MOVE P1,0(S2) ;GET A WORD
CAME P1,0(S1) ;COMPARE
JRST UQCH.3 ;NO MATCH, NEXT ENTRY
ADDI S1,1 ;BUMP S1
AOBJN S2,UQCH.2 ;LOOP
MOVE S1,UNILST ;GET LIST NAME
PUSHJ P,L%CURRENT ;GET ADDRESS OF CURRENT ENTRY AGAIN
MOVE S2,1(S2) ;GET UNIQNESS OF ENTRY
GETLIM S1,.QELIM(AP),UNIQ ;GET UNIQNESS OF NEW REQUEST
CAIE S1,%EQUYE ;IF EITHER ONE IS UNIQUE,
CAIN S2,%EQUYE ; THEN THE NEW ONE IS NO GOOD
$RETF ;GOTCHA!!
UQCH.3: MOVE S1,UNILST ;GET LIST NAME
PUSHJ P,L%NEXT ;POSITION TO NEXT
JUMPT UQCH.1 ;AND LOOP
$RETT ;NO MORE, RETURN SUCCESS
SUBTTL UNIFST - Find stream's unique entry
;UNIFST is called by the 'clear' and 'compare' routines to find the
; list entry associated with a particular stream number.
; Upon return the list entry is CURRENT.
;CALL: S1/ STREAM NUMBER
;
;T RET S1/ ADDRESS OF UNIQUE ENTRY FOR STREAM
UNIFST: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;COPY STREAM NUMBER OVER
MOVE S1,UNILST ;GET LIST NUMBER
PUSHJ P,L%FIRST ;POSITION IT
JUMPF S..USM ;LOSE BIG
UNIF.1: CAMN P1,0(S2) ;MATCH?
JRST [MOVE S1,S2
$RETT] ;YES, RETURN
PUSHJ P,L%NEXT ;POSITION TO NEXT
JUMPT UNIF.1 ;AND LOOP
$STOP(USM,Unique stream missing)
SUBTTL Failsoft System Interface
;ENTRY POINTS
INTERN I$WRIT ;WRITE SOMETHING INTO THE MASTER
INTERN I$READ ;READ SOMETHING FROM THE MASTER
INTERN I$CRIP ;CREATE AN INDEX PAGE
INTERN I$OQUE ;OPEN MASTER QUEUE FILES
SUBTTL I$WRIT -- Write something into master queue file
;ROUTINE TO WRITE SOMETHING INTO THE MASTER QUEUE FILES. CALL WITH S1
; CONTAINING THE BLOCK NUMBER TO WRITE, AND S2 CONTAINING AN
; IO-POINTER OF THE FORM:
;
; XWD LENGTH,ADDRESS
;
; WHERE 'LENGTH' IS THE NUMBER OF WORDS TO WRITE, AND 'ADDRESS'
; IS THE PLACE TO START WRITING FROM.
I$WRIT: PUSHJ P,.SAVET ;SAVE T1-T4
MOVE T1,S1 ;GET BLOCK NUMBER
IDIVI T1,FSSBPS ;DIVIDE BY BLOCKS/SECTION
CAIN T2,FSSFIB ;IS IT AN INDEX BLOCK?
JRST WRIT.1 ;YES, DO SOMETHING SPECIAL
DMOVEM S1,WRIT.A ;STORE INPUT ARGUMENTS
HRR T3,FSADDR ;ADDRESS OF SCRATCH PAGE
HRL T3,WRIT.A+1 ;GET SOURCE,,DEST IN T3
HLRZ T4,WRIT.A+1 ;GET LENGTH OF DATA
ADDI T4,-1(T3) ;ADD IN BASE ADR-1
BLT T3,(T4) ;AND BLT THE DATA
MOVE S1,FSPAGN ;GET 0,,SOURCE-PAGE
HRLI S1,.FHSLF ;<FORK-HANDLE>,,<SOURCE-PAGE>
MOVE S2,WRIT.A ;GET 0,,<DEST-PAGE>
HRL S2,FILJFN ;GET <JFN>,,<DEST-PAGE>
MOVX T1,PM%RD!PM%WT ;READ AND WRITE ACCESS
PMAP ;AND MAP THE PAGE OUT
HRL S1,FILJFN ;GET <JFN>,,0
HRR S1,WRIT.A ;GET <JFN>,,<FILE-PAGE>
MOVEI S2,1 ;AND A REPEAT COUNT
UFPGS ;UPDATE THE DISK
$STOP(CUF,CANT UPDATE FILE)
MOVE T1,WRIT.A ;GET FILE PAGE NUMBER
CAMG T1,G$NBW## ;HIGHEST PAGE YET
$RETT ;NO, RE-USING SAME SPACE
MOVEM T1,G$NBW## ;YES, SAVE NEW FILE SIZE
MOVSI S1,.FBUSW ;FILL IN USER-SPECIFIED-WORD
HRR S1,FILJFN ;FOR MASTER FILE
SETO S2, ;FILL ENTIRE WORD WITH T1
CHFDB ;CHANGE THE FILE BLOCK
$RETT ;AND RETURN
;HERE IF WRITING AN INDEX PAGE
WRIT.1: HRL S1,FILJFN ;GET <JFN>,,<PAGE-NUMBER>
MOVEI S2,1 ;AND A REPEAT COUNT
UFPGS ;AND UPDATE THE INDEX
$STOP(CUI,CANT UPDATE INDEX)
$RETT ;AND RETURN
WRIT.A: BLOCK 2 ;INPUT ARGUMENTS
SUBTTL I$READ -- Read something from master queue file
;ROUTINE TO READ SOMETHING FROM THE MASTER QUEUE FILE. CALL WITH S1
; CONTAINING A BLOCK TO START THE READ AT AND S2 CONTAINING AN
; IO-POINTER OF THE FORM:
;
; XWD LENGTH,ADDRESS
;
; WHERE 'LENGTH' IS THE NUMBER OF WORDS TO READ, AND 'ADDRESS'
; IS THE PLACE TO START READING THEM INTO.
I$READ: PUSHJ P,.SAVET ;SAVE T1-T4
MOVE T1,S1 ;GET BLOCK NUMBER
IDIVI T1,FSSBPS ;DIVIDE BY BLOCKS/SECTION
CAIN T2,FSSFIB ;IS IT AN INDEX BLOCK?
JRST READ.1 ;YES, GO MAP IT IN
DMOVE T1,S1 ;COPY ARGS FROM S TO T
MOVE S1,T1 ;GET 0,,<SOURCE-PAGE>
HRL S1,FILJFN ;GET <JFN>,,<SOURCE-PAGE>
MOVE S2,FSPAGN ;GET 0,,<DEST-PAGE>
HRLI S2,.FHSLF ;<FORK-HANDLE>,,<DEST-PAGE>
MOVX T1,PM%RD ;AND READ ACCESS
PMAP ;AND MAP IN THE PAGE
HRL T1,FSADDR ;GET <SOURCE-ADR>,,0
HRR T1,T2 ;GET <SOURCE-ADR>,,<DEST-ADR>
HLRZ T3,T2 ;GET LENGTH OF DATA
ADDI T3,-1(T2) ;ADD IN BASE ADR -1
BLT T1,(T3) ;AND BLT TO REQUESTORS PAGE
SETO S1, ;NOW SETUP TO RELEASE THE
HRRZ S2,FSPAGN ; MAPPED SCRATCH PAGE FROM
HRLI S2,.FHSLF ; OUR ADDRESS SPACE
SETZ T1, ;FLAGS ARE MEANINGLESS
PMAP ;DO IT!!
$RETT ;AND RETURN
;HERE TO MAP IN AN INDEX PAGE
READ.1: HRL S1,FILJFN ;GET JFN,,SOURCE-PAGE
TLZ S2,-1 ;GET 0,,<DEST-ADR>
ADR2PG S2 ;GET 0,,<DEST-PAGE>
HRLI S2,.FHSLF ;<FORK-HANDLE>,,<DEST-PAGE>
MOVX T1,PM%RWX ;READ/WRITE/EXECUTE
PMAP ;MAP IT!
$RETT ;AND RETURN
SUBTTL I$CRIP -- Create an index page in master file
;I$CRIP IS CALLED WHEN THE FAILSOFT SYSTEM DECIDES TO START A NEW FILE
; SECTION (INCLUDING THE VERY FIRST) TO WRITE OUT THE NEW INDEX
; PAGE INTO THE FILE. CALL WITH S1 CONTAINING THE BLOCK NUMBER OF
; THE PAGE, AND S2 CONTAINING THE ADDRESS OF THE PAGE.
I$CRIP: HRLI S2,FSSWPI ;NUMBER OF WORDS TO WRITE
PUSHJ P,.SAVET ;SAVE T REGS
DMOVE T3,S1 ;SAVE ARGS IN T3 AND T4
HRRZ S1,S2 ;GET 0,,<SOURCE-ADR>
ADR2PG S1 ;GET 0,,<SOURCE-PAGE>
HRLI S1,.FHSLF ;GET <FHANDLE>,,<SOURCE-PAGE>
HRRZ S2,T3 ;GET 0,,<DEST-PAGE>
HRL S2,FILJFN ;GET <JFN>,,<DEST-PAGE>
MOVX T1,PM%WR ;WRITE ACCESS REQUIRED
PMAP ;MAP THE PAGE OUT
DMOVE S1,T3 ;RECOVER THE ARGS
PUSHJ P,I$READ ;MAP THE PAGE IN
DMOVE S1,T3 ;RECOVER THE ARGS AGAIN
PJRST I$WRIT ;UPDATE THE WORLD AND RETURN
SUBTTL I$OQUE -- Open master queue files
;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
; THE MASTER QUEUE FILE.
I$OQUE: ZERO OQUE.A ;FIRST TIME THRU
OQUE.1: MOVX S1,<GJ%SHT!GJ%OLD!GJ%NS> ;DO A SHORT GTJFN, OLD FILE ONLY,NO SEARCH
SKIPE DEBUGW ;ARE WE DEBUGGING?
SKIPA S2,[-1,,[DMQFNM]] ;YES, USE PRIVATE MASTER QUEUE FILE
HRROI S2,[MQFNAM] ;POINT TO MASTER QUEUE NAME
GTJFN ;GO GET IT
JRST OQUE.2 ;NOT THERE, CREATE IT
HRRZM S1,FILJFN ;SAVE THE JFN
HRRZS S1 ;AND ZERO THE LEFT HALF OUT
PUSH P,T1 ;SAVE T1
MOVX S2,<1,,.FBUSW> ;READ USER SUPPLIED ARGUMENT
MOVEI T1,OQUE.B ;INTO LOCAL STORAGE
GTFDB ;READ FILE BLOCK INFORMATION
MOVE T1,OQUE.B ;WE FILL IN HIGHEST PAGE NUMBER
MOVEM T1,G$NBW## ;SAVE THE FILE SIZE
POP P,T1 ;AND RESTORE T1
MOVE S1,FILJFN ;GET THE JFN
MOVX S2,<OF%RD+OF%WR+OF%NWT> ;GET OPENF BITS
OPENF ;OPEN THE FILE
PUSHJ P,OQUE.4 ;LOSE!!
PUSHJ P,M%ACQP ;GET A PAGE FOR I$READ/I$WRITE
MOVEM S1,FSPAGN ;FOR THEIR SCRATCH USE
PG2ADR S1 ;CONVERT TO ADDRESS ALSO
MOVEM S1,FSADDR ;FOR EASIER USE
$RETT ;AND RETURN
OQUE.2: SKIPE OQUE.A ;FIRST TIME THRU?
PUSHJ P,OQUE.3 ;NO, GIVE A STOPCD
MOVX S1,<GJ%NEW!GJ%SHT!GJ%FOU> ;NEW FILE, OUTPUT, SHORT GTJFN
SKIPE DEBUGW ;ARE WE DEBUGGING?
SKIPA S2,[-1,,[DMQFNM]] ;YES, USE PRIVATE MASTER QUEUE FILE
HRROI S2,[MQFNAM] ;POINT TO MASTER QUEUE NAME
GTJFN ;GET IT
PUSHJ P,OQUE.3 ;LOSE?
MOVX S2,OF%WR ;WRITE
HRRZS S1 ;CLEAR LH
PUSH P,S1 ;AND SAVE JFN
OPENF ;OPEN THE FILE
PUSHJ P,OQUE.3 ;CAN'T?
POP P,S1 ;RESTORE THE JFN
CLOSF ;CLOSE THE FILE
JFCL ;REALLY SHOULDN'T HAPPEN
SETOM OQUE.A ;WE'VE BEEN HERE ONCE ALREADY
JRST OQUE.1 ;AND TRY AGAIN
OQUE.3: $STOP(COP,Cannot Open Prime Queue)
OQUE.4: CAIE S1,OPNX9 ;IS IT ILLEGAL SIMUL ACCESS?
JRST OQUE.3 ;NO
$STOP(PQI,Prime Queue is Interlocked)
OQUE.A: BLOCK 1 ;LOCAL STORAGE
OQUE.B: BLOCK 1 ;LOCAL STORAGE
SUBTTL FBREAK -- Find a break character
;FBREAK IS USED TO SEPARATE PIECES OUT OF CHARACTER STRINGS. IT WILL
;ALSO DO A FIXED OFFSET CONVERSION OF THE CHARACTERS
;IT IS CALLED WITH:
; T1 = BYTE POINTER TO SOURCE STRING
; T2 = BYTE POINTER TO DESTINATION STRING
; T3 = CHARACTER TO STOP ON,,CONVERSION OFFSET (SUBTRACTED FROM SOURCE CHARACTER
; T4 = COUNT OF CHARACTERS TO STORE (OTHERS TO BREAK ARE SKIPPED)
;IT RETURNS:
; T1 = BYTE POINTER TO FIRST CHARACTER AFTER BREAK IN SOURCE
; S1 = TERMINATION CHARACTER (EITHER BREAK AS SPECIFIED IN T3 OR NULL
; S2,T2-T3 UNDEFINED
FBREAK: HLRZ S2,T3 ;GET CHARACTER TO STOP ON
HRRES T3 ;AND MAKE T3 CONVERSION OFFSET
FBRE.1: ILDB S1,T1 ;GET A CHARACTER FROM THE SOURCE
JUMPE S1,.RETT ;ALWAYS STOP ON NULL
CAMN S1,S2 ;IS IT THE BREAK CHARACTER
POPJ P, ;YES, RETURN
SUB S1,T3 ;DO THE CONVERSION
SOSL T4 ;DECREMENT NUMBER OF CHARACTERS TO STORE
IDPB S1,T2 ;STORE IT
JRST FBRE.1 ;AND LOOP BACK FOR MORE
SUBTTL STGWLD -- Match a "wild" string
;STGWLD IS CALLED WITH S1 CONTAINING A POINTER TO A "BASE" STRING
; LIKE A JOBNAME OR FILENAME AND S2 CONTAINING A POINTER TO
; A STRING WITH POSSIBLE WILDCARD CHARACTERS * AND % IN IT.
; IT THE BASE STRING MATCHES THE WILD STRING, TRUE IS RETURNED
; OTHERWISE FALSE.
STGWLD: PUSHJ P,.SAVET ;SAVE T REGS
STGW.1: ZERO T1 ;CLEAR * FLAG
STGW.2: ILDB T4,S2 ;GET A CHARACTER FROM "WILD"
STGW.3: CAIL T4,"A"+40 ;CHECK FOR LOWER CASE
CAILE T4,"Z"+40 ; "
SKIPA ;ITS NOT LC
SUBI T4,40 ;IT IS, MAKE IT UPPER CASE
STGW.4: ILDB T3,S1 ;GET A CHARACTER FROM "BASE"
CAIL T3,"A"+40 ;CHECK IT FOR LOWER CASE
CAILE T3,"Z"+40
SKIPA ;ITS NOT LOWER
SUBI T3,40 ;IT IS, MAKE IT UC
CAME T3,T4 ;MATCH?
JRST STGW.5 ;NO, THAT WOULD BE TOO SIMPLE
JUMPE T3,.RETT ;YES, RETURN IF END OF STRINGS
JRST STGW.1 ;ELSE JUST LOOP
STGW.5: CAIN T4,"*" ;IS "WILD" A *?
JUMPE T3,.RETT ;YES, WIN IF END OF STRING
JUMPN T1,STGW.4 ;IF LAST "WILD" WAS *, KEEP GOING
JUMPE T3,.RETF ;IF NOT END-OF-STRING DOES NOT MATCH
CAIN T4,"%" ;IS "WILD" A %
JRST STGW.7 ;YES, MATCH AND GO AROUND AGAIN
CAIE T4,"*" ;NO, IS IT A *
$RETF ;NO, LOSE
STGW.6: AOSA T1 ;YES, SET * FLAG
STGW.7: ZERO T1 ;CLEAR * FLAG
STGW.8: ILDB T4,S2 ;GET NEXT "WILD" CHARACTER
CAIN T4,"*" ;IS IT A *?
JRST STGW.6 ;YES, "**"="*"
CAIE T4,"%" ;NO, A % ?
JRST STGW.3 ;NO, PLAIN OLD ALPHANUMERIC
JRST STGW.8 ;YES, "*%" = "*"
SUBTTL I$MINI - ROUTINE TO INITIALIZE THE TAPE MOUNT PROCESSOR
INTERN I$MINI ;MAKE INITIALIZATION GLOBAL
MNTPDB: IP%CFV ;MSG PDB - PAGE MODE
0,,0 ; - SENDERS PID
0,,0 ; - RECEIVERS PID
1000,,0 ; - LENGTH,,PAGE #
I$MINI: MOVE S1,MDRQUE## ;GET THE MDR QUEUE LIST ID
PUSHJ P,L%FIRST ;GET THE FIRST MDR ENTRY
JUMPF MINI.0 ;NONE THERE,,JUST CONTINUE
MINI.A: MOVE AP,S2 ;SAVE THE MDR ADDRESS IN AP
PUSHJ P,D$DMDR## ;DELETE THE MDR ET AL
MOVE S1,MDRQUE## ;GET THE MDR QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT MDR ENTRY
JUMPT MINI.A ;CONTINUE THROUGH ALL MDR'S
MINI.0: LOAD AP,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST PSB
MOVEI H,HDRPSB## ;SETUP THE HEADER
SKIPA ;SKIP THE FIRST TIME THROUGH
MINI.1: LOAD AP,.QELNK(AP),QE.PTN ;GET THE NEXT PSB ADDRESS
MINI.2: JUMPE AP,.RETT ;NO MORE,,RETURN
LOAD S1,PSBOBJ(AP) ;GET THE FIRST OBJECT TYPE
CAIE S1,.OTMNT ;IS IT A MOUNT PSB ???
JRST MINI.1 ;NO,,TRY THE NEXT ONE
LOAD S1,.QELNK(AP),QE.PTN ;GET THE NEXT PSB ADDRESS NOW
PUSH P,S1 ; SINCE WE ARE DELETING THIS ENTRY
PUSHJ P,M$RFRE## ;DE-LINK/DELETE THIS PSB
POP P,AP ;RESTORE NEXT PSB ADDRESS
JRST MINI.2 ;AND CONTINUE
SUBTTL I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS
INTERN I$MNTR
;CALL: AP/ The MDR Entry Address
; M/ The Mount Message Address
;
;RET: TRUE RETURN or ERRORS:IMM, MPN, DRN
I$MNTR: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
PUSHJ P,FNDPSB ;GO FIND A MTCON PSB
JUMPF E$MPN## ;NOT THERE,,THATS AN ERROR
MOVE S1,PSBPID(S1) ;GET THE PROCESSORS PID
MOVEM S1,MNTPDB+.IPCFR ;SAVE IT IN THE PDB
PUSHJ P,M%ACQP ;GO GET A PAGE WE CAN USE FOR IPCF
HRRM S1,MNTPDB+.IPCFP ;SAVE THE PAGE NUMBER IN THE PDB
PG2ADR S1 ;CONVERT THE PAGE TO AN ADDRESS
MOVE P1,S1 ;SAVE THE ADDRESS
LOAD S1,.MRRID(AP),MR.RID ;GET THE REQUEST ID
MOVEM S1,.MMITN(P1) ;SAVE IT IN THE MESSAGE ALSO
MOVE S1,.MRUSR(AP) ;GET THE USER NUMBER
MOVEM S1,.MMUNO(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,G$SND## ;GET THE SENDERS PID
MOVEM S1,.MMPID(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,G$MCOD## ;GET THE SENDERS ACK CODE
MOVEM S1,.MMUCD(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,.MRJOB(AP) ;GET THE USERS CAPABILITIES
MOVEM S1,.MMCAP(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,[POINT 7,.MRACT(AP)] ;GET POINTER TO MDR ACCOUNT STRING
MOVE S2,[POINT 7,.MMACT(P1)] ;GET POINTER TO DESTINATION
MNT.0: ILDB TF,S1 ;COPY ACCOUNT
IDPB TF,S2 ; STRING FROM MDR
JUMPN TF,MNT.0 ; TO THE MESSAGE
LOAD S1,.MSTYP(M),MS.CNT ;GET THE SENDERS MESSAGE LENGTH
STORE S1,.MMUMS(P1) ;SAVE IT IN THE MESSAGE
ADD S1,P1 ;GET THE END ADDRESS (FOR BLT)
HRL S2,M ;GET THE SOURCE ADDRESS
HRR S2,P1 ;AND THE DESTINATION ADDRESS
BLT S2,0(S1) ;COPY IT OVER
MOVEI S1,1000 ;GET THE PAGE LENGTH
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IT AS THE NEW MESSAGE LENGTH
PUSH P,AP ;SAVE AP FOR A MINUTE
MOVEI AP,MNTPDB ;POINT TO THE MESSAGE PDB
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF TO MOUNTR
POP P,AP ;RESTORE AP
$RETT ;AND RETURN
SUBTTL I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES
;CALL: M/RELEASE MESSAGE ADDRESS (SAME AS .QOREL)
;
;RET: FALSE - ERROR MESSAGE (MTS, MTL, SNY)
; TRUE - REQUEST DELETED
INTERN I$MTR ;CREATE THE ENTRY POINT
I$MTR: PUSHJ P,.SAVE1 ;SAVE P1
LOAD S1,.MSTYP(M),MS.CNT ;GET THE MESSAGE LENGTH
CAIGE S1,REL.SZ ;IS IT LESS THEN RELEASE MSG SIZE ??
JRST E$MTS## ;YES,,THATS AN ERROR
CAIE S1,REL.SZ ;IS IT GREATER THEN RELSE MSG SIZE ???
JRST E$MTL## ;THAT TOO IS AN ERROR
MOVE S1,MDRQUE## ;GET THE MOUNT QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST QUEUE ENTRY
JUMPF E$SNY## ;NONE THERE,,THATS AN ERROR
MTR.1: MOVE AP,S2 ;SAVE THE MDR ADDRESS IN AP
LOAD S1,.MRRID(AP),MR.RID ;GET THIS REQUESTS ID
CAMN S1,REL.IT(M) ;IS THIS THE ONE WE WANT ???
PJRST D$DMDR## ;YES,,DELETE IT AND RETURN
MOVE S1,MDRQUE## ;GET THE MOUNT QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT QUEUE ENTRY
JUMPT MTR.1 ;FOUND,,GO CHECK IT
JRST E$SNY## ;NO MORE,,THATS AN ERROR
SUBTTL OPERATOR TAPE/DISK MOUNT MESSAGES
;CALL: M/MESSAGE ADDRESS
; T4/MESSAGE LENGTH
; P1/MESSAGE TYPE
;
;RET: TRUE ALWAYS
INTERN I$OMNT ;MAKE THE ROUTINE GLOBAL
I$OMNT: PUSHJ P,FNDPSB ;GET MTCON'S PSB
JUMPF OMNT.1 ;NOT THERE,,TELL OPERATOR
MOVE S1,PSBPID(S1) ;GET MTCONS PID
MOVEM S1,MNTPDB+.IPCFR ;SAVE IT IN THE PDB
PUSHJ P,M%ACQP ;GO GET A PAGE FOR IPCF
HRRM S1,MNTPDB+.IPCFP ;SAVE THE PAGE NUMBER IN THE PDB
PG2ADR S1 ;CONVERT IT TO AN ADDRESS
ADD T4,S1 ;CALC BLT END ADDRESS
HRL S1,M ;GET THE SOURCE ADDRESS
BLT S1,0(T4) ;COPY THE MESSAGE OVER
MOVEI AP,MNTPDB ;GET THE PDB ADDRESS
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
OMNT.1: $ACK (Mount Request Processor Not Running,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL TAPE MOUNT CHECKPOINT ROUTINE
;CALL: M/ADDRESS OF CHECKPOINT MESSAGE
;
;RET: FALSE - ERROR MESSAGE (SNY, IPE)
; TRUE - REQUEST IS CHECKPOINTED
INTERN I$CHKP ;MAKE IT GLOBAL
I$CHKP: PUSHJ P,.SAVE2 ;SAVE P1 & P2
PUSHJ P,I$WHEEL ;MAKE SURE THE GUY HAS PRIVS.
JUMPF E$IPE## ;NO,,THE GUY IS A FRAUD
MOVE S1,MDRQUE## ;GET THE QUEUE LIST ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
JRST CHKP.2 ;SKIP THE FIRST TIME THROUGH
;Find the MDR in the Request queue
CHKP.1: MOVE S1,MDRQUE## ;GET THE MDR QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT MDR ENTRY
CHKP.2: JUMPF E$SNY## ;NOT FOUND,,THATS AN ERROR
LOAD S1,.MRRID(S2),MR.RID ;GET THIS MDR'S RID IN S1
CAME S1,CHE.IT(M) ;HAVE WE FOUND THE MDR WE WANT ???
JRST CHKP.1 ;NO,,TRY THE NEXT MDR
MOVE AP,S2 ;SAVE THE MDR ADDRESS
MOVE S1,.MRVSL(AP) ;GET THE VSL ADDRESS
LOAD P2,.VSCVL(S1),VS.OFF ;GET THE OFFSET TO THE CURRENT VOLUME
ADDI P2,.VSVOL(S1) ;POINT TO THE CURRENT VOLUME ADDRESS
MOVE P2,0(P2) ;GET THE CURRENT VOLUME
MOVE S1,CHE.IN+.MTVOL(M) ;GET THE VOLUME (PERHAPS) IN S1
CAXE S1,%VOLBL ;IS THE VOLUME NAME BLANK ???
CAXN S1,%VOLSC ;OR IS IT A SCRATCH VOLUME ???
JRST [MOVX S1,VL.SCR ;YES,,GET THE SCRATCH VOLUME BIT
IORM S1,.VLFLG(P2) ;MAKE THE VOLUME A SCRATCH VOLUME
JRST CHK.2A ] ;AND CONTINUE
MOVEM S1,.VLNAM(P2) ;SAVE THE NEW VOLUME ID
ZERO .VLFLG(P2),VL.SCR ;CLEAR SCRATCH BIT
CHK.2A: ZERO .VLOWN(P2),VL.OFF ;MAKE THIS GUY THE CURRENT OWNER
MOVE S2,CHE.IN+.MTSTA(M) ;GET THE DEVICE NAME (POSSIBLY)
CAXE S2,%STAWT ;IS IT WAITING ???
CAXN S2,%STAAB ;OR IS IT 'ABORTED' ???
JRST [STORE S2,.VLFLG(P2),VL.STA ;YES,,SAVE THE NEW VOLUME STATUS
$RETT ] ;AND RETURN
HRROI S1,TMPBFR ;NO,,POINT TO ASCIZ DEVICE NAME BUFFER
DEVST ;TRY TO CONVERT TO ASCIZ DEVICE NAME
$RETT ;STILL NO GOOD,,JUST RETURN
HRROI S1,TMPBFR ;POINT TO THE ASCIZ DEVICE NAME
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVE P1,S2 ;SAVE THE DEVICE NAME IN P1
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Find the UCB in the Device queue. If not there, create a UCB for the device
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST UCB ENTRY
JRST CHKP.4 ;JUMP THE FIRST TIME THROUGH
CHKP.3: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT UCB
CHKP.4: SKIPT ;THERE WAS ONE,,CHECK IT OUT
PUSHJ P,CHKP.6 ;NO MORE UCB'S,,CREATE ONE
CAME P1,.UCBNM(S2) ;HAVE WE FOUND THE UCB IN QUESTION ??
JRST CHKP.3 ;NO,,TRY THE NEXT ONE
MOVE P1,S2 ;SAVE THE UCB ADDRESS IN P1
SKIPE S1,.UCBVL(P1) ;ANY VOLUME POINTER ???
SETZM .VLUCB(S1) ;YES,,CLEAR THE VOL UCB POINTER
SETZM .UCBVL(P1) ;AND CLEAR THE UCB VOL POINTER
MOVEM P2,.UCBVL(P1) ;LINK THE VOL TO THE UCB
MOVEM P1,.VLUCB(P2) ;LINK THE UCB TO THE VOL
MOVX S1,%STAMN ;GET 'VOLUME' MOUNTED STATUS CODE
STORE S1,.VLFLG(P2),VL.STA ;SAVE THE NEW VOLUME STATUS
$RETT ;AND RETURN
;Subroutine to create a UCB entry for the device in the status message
CHKP.6: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
MOVX S2,UCBLEN ;GET THE LENGTH OF A UCB
PUSHJ P,L%CENT ;CREATE A UCB FOR THE DEVICE IN P1
MOVEM P1,.UCBNM(S2) ;SAVE THE DEVICE NAME
MOVX S1,%TAPE ;WANT 'TAPE' DEVICE TYPE
STORE S1,.UCBST(S2),UC.DVT ;SAVE AS THE DEVICE TYPE
$RETT ;RETURN
SUBTTL I$MATR - ROUTINE TO SETUP AND PASS MNT ATTRIBUTE MSGS TO MTCON
;CALL: M/ MAT REQUEST ADDRESS
;
;RET: TRUE IF SENT OK
; FALSE IF MTCON NOT RUNNING
INTERN I$MATR ;MAKE IT GLOBAL
I$MATR: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,FNDPSB ;FIND MTCON'S PSB
JUMPF E$MPN## ;NOT THERE,,SEND ERROR MSG
MOVE S1,PSBPID(S1) ;GET THE PID
MOVEM S1,MNTPDB+.IPCFR ;SAVE IT IN THE PDB
PUSHJ P,M%ACQP ;GET A PAGE FOR IPCF
HRRM S1,MNTPDB+.IPCFP ;SAVE THE PAGE NUMBER
PG2ADR S1 ;MAKE IT AN ADDRESS
MOVE P1,S1 ;SAVE IT IN P1
HRL S1,M ;GET THE SOURCE ADDRESS (FOR BLT)
BLT S1,.MATQS-1(P1) ;COPY THE MESSAGE OVER
MOVX S1,.MATQS ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IT IN THE MESSAGE
LOAD S1,G$PRVS## ;GET PRVS,,JOB NUMBER
STORE S1,.MATCP(P1) ;SAVE IT IN THE MESSAGE
LOAD S1,G$SND## ;GET THE SENDERS PID
STORE S1,.MATPD(P1) ;SAVE IT IN THE MESSAGE
MOVEI AP,MNTPDB ;GET THE PDB ADDRESS
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
SUBTTL I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS
;CALL: M/ Kill Message Address
;
;RET: TRUE ALWAYS
INTERN I$KMNT ;MAKE IT GLOBAL
I$KMNT: PUSHJ P,.SAVE3 ;SAVE P1, P2, AND P3
PUSHJ P,FNDPSB ;IS TAPE PROCESSOR RUNNING ???
JUMPF E$MPN## ;NO,,THATS AN ERROR
MOVE S1,PSBPID(S1) ;ELSE GET THE PROCESSOR'S PID
MOVEM S1,MNTPDB+.IPCFR ;SAVE IT AS THE RECIEVERS PID
MOVEI P1,KIL.RQ(M) ;GET THE RDB ADDRESS
SETZB P2,P3 ;ZERO P2 AND P3
MOVE S1,MDRQUE## ;GET THE MOUNT QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
JUMPF E$SNY## ;NONE THERE,,THATS AN ERROR
KMNT.1: MOVE AP,S2 ;SAVE THE ENTRY ADDRESS
MOVE S1,.MRUSR(AP) ;GET THE USER ID
CAME S1,G$SID## ;IS IT THE SAME USER ???
JRST KMNT.4 ;NO,,TRY NEXT ENTRY
KMNT.2: SKIPN S1,.RDBRQ(P1) ;DID HE SPECIFY A REQUEST ID ???
JRST KMN.2A ;NO,,SKIP THIS
LOAD S2,.MRRID(AP),MR.RID ;GET THE REQUEST ID IN S2
CAIE S1,0(S2) ;DO THE REQUEST ID'S MATCH ???
JRST KMNT.4 ;NO,,TRY NEXT ENTRY
JRST KMN.2B ;YES,,CHECK JOB NUMBERS
KMN.2A: MOVE S1,.MRREQ(AP) ;GET THE REQUEST NAME
XOR S1,.RDBJB(P1) ;ZERO IDENTICAL BITS
AND S1,.RDBJM(P1) ;AND IT WITH THE MASK
JUMPN S1,KMNT.4 ;NOT ZERO, WE DONT MATCH, TRY NEXT ENTRY
KMN.2B: LOAD S1,G$PRVS##,MD.PJB ;GET THE USERS JOB NUMBER
LOAD S2,.MRJOB(AP),MD.PJB ;GET THE REQUESTS JOB NUMBER
CAME S1,S2 ;FROM THE SAME JOB ???
JRST KMNT.4 ;NO,,TRY THE NEXT ENTRY
SKIPE P2 ;HAVE WE SETUP THE IPCF MSG PAGE ???
JRST KMNT.3 ;YES,,CONTINUE ON
PUSHJ P,M%ACQP ;DONT DO THIS UNLESS WE HAVE TO !!
HRRM S1,MNTPDB+.IPCFP ;SAVE THE PAGE NUMBER IN THE PDB
PG2ADR S1 ;CONVERT IT TO AN ADDRESS
MOVE P2,S1 ;SAVE IT IN P2
MOVX S1,.QOMTA ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(P2),MS.TYP ;SAVE IT
MOVEI S1,1000 ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(P2),MS.CNT ;SAVE IT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE S1,.MSCOD(M) ;GET THE USERS ACK CODE
MOVEM S1,.MSCOD(P2) ;SAVE IT IN OUR MSG
MOVE S1,.MSFLG(M) ;GET THE USERS FLAG WORD
MOVEM S1,.MSFLG(P2) ;SAVE IT IN OUR MSG
MOVEI S1,2 ;GET THE BLOCK COUNT
STORE S1,.OARGC(P2) ;SAVE IT
MOVEI P2,.OHDRS(P2) ;POINT TO THE FIRST BLOCK
MOVX S1,.MTPID ;GET THE BLOCK TYPE
STORE S1,ARG.HD(P2),AR.TYP ;SAVE IT
MOVEI S1,2 ;GET THE BLOCK LENGTH
STORE S1,ARG.HD(P2),AR.LEN ;SAVE IT
MOVE S1,G$SND## ;GET THE SENDERS PID
STORE S1,ARG.DA(P2) ;SAVE IT
MOVEI P2,2(P2) ;POINT TO THE NEXT BLOCK
MOVX S1,.MTITN ;GET THE BLOCK TYPE
STORE S1,ARG.HD(P2),AR.TYP ;SAVE IT
PUSH P,P2 ;SAVE THIS BLOCK ADDRESS
MOVEI P2,ARG.DA(P2) ;POINT TO THE DATA AREA
KMNT.3: LOAD S1,.MRRID(AP),MR.RID ;GET THIS REQUESTS ITN
STORE S1,0(P2) ;SAVE IT IN THE MESSAGE
MOVEI P2,1(P2) ;GET THE NEXT ITN ADDRESS
AOS P3 ;BUMP THE ITN COUNT
KMNT.4: MOVE S1,MDRQUE## ;GET THE QUEUE LIST ID
PUSHJ P,L%NEXT ;GET THE NEXT ENTRY
JUMPT KMNT.1 ;FOUND ONE,,CONTINUE
JUMPE P2,E$SNY## ;FIND ANYTHING ???,,NO SEND AN ERROR
POP P,P2 ;RESTORE THE LAST BLOCK ADDRESS
AOS P3 ;ADD THE HEADER LENGTH
STORE P3,ARG.HD(P2),AR.LEN ;SAVE THE BLOCK LENGTH
MOVEI AP,MNTPDB ;POINT TO THE PDB
PUSHJ P,C$SEND ;SEND THE MESSAGE
SETZM G$ACK## ;DONT ACK USERS MSG (LET MTCON DO IT)
$RETT ;AND RETURN
SUBTTL TAPE MOUNT UTILITY ROUTINES
;FNDPSB - ROUTINE TO FIND THE MOUNT PROCESSOR'S PSB
;CALL: PUSHJ P,FNDPSB
; RETURN HERE ALWAYS
;RET: S1/ADDRESS OF MOUNT PSB
FNDPSB: MOVEI S1,HDRPSB## ;POINT TO THE PSB QUEUE
LOAD S1,.QHLNK(S1),QH.PTF ;GET THE FIRST PSB ENTRY
MOVEI S2,.OTMNT ;GET THE OBJECT TYPE
FNDP.1: JUMPE S1,.RETF ;NO MORE,,RETURN FALSE
CAMN S2,PSBOBJ(S1) ;DO WE MATCH ???
$RETT ;YES,,RETURN TRUE
LOAD S1,.QELNK(S1),QE.PTN ;POINT TO THE NEXT ENTRY
JRST FNDP.1 ;AND GO CHECK IT OUT
SUBTTL FILE ARCHIVING SCHEDULING ROUTINES
INTERN I$ARCHIVE ;PROCESS A MONITOR ARCHIVE MSG
INTERN I$RLNK ;LINK A RETREIVAL REQUEST INTO THE QUEUE
INTERN I$RSCH ;SCHEDULE A JOB FOR AN OBJECT
INTERN I$RDEF ;FILL IN DEFAULTS FOR A JOB
INTERN I$RFJB ;FIND A JOB FOR SCHEDULING
SUBTTL ARCHIVE -- IPCC Function .IPCSR (41)
; The ARCHIVE message is sent by the operating system whenever a
; retrieval request is made, and whenever the tape pointers
; of an archived file are destroyed.
;
; CALL: M/ Monitor Archive/Notification Msg Address
;
I$ARCHIVE:
PUSHJ P,M%GPAG ;GET A PAGE FOR THE EQ
MOVE P1,S1 ;SAVE ITS ADDRESS
MOVE S1,[EQHSIZ+FPMSIZ+FDXSIZ,,.QIRET] ;GET LENGTH,,TYPE
STORE S1,.MSTYP(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,[%%.QSR,,EQHSIZ] ;GET QUASAR VERSION,,HEADER SIZE
STORE S1,.EQLEN(P1) ;SAVE IT IN THE MESSAGE
LOAD S1,ARC.FN(M),AR.FNC ;GET THE FUNCTION CODE
LOAD S1,[.OTRET ;USE AS AN OFFSET TO GET THE
.OTNOT](S1) ;CORRECT OBJECT TYPE
STORE S1,.EQROB+.ROBTY(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,G$LNAM## ;GET THE LOCAL NODE NAME
MOVEM S1,.EQROB+.ROBND(P1) ;SAVE IN THE OBJECT BLOCK
LOAD S1,ARC.PR(M),AR.PRT ;GET THE PROTECTION BITS
STORE S1,.EQSPC(P1),EQ.PRO ;SAVE THEM IN THE MESSAGE
LOAD S1,ARC.FN(M),AR.MOD ;GET THE REASON VALUE
STORE S1,.EQSEQ(P1),EQ.PRI ;MAKE IT THE REQUESTS PRIORITY
MOVEI S1,1 ;GET A 1
STORE S1,.EQSPC(P1),EQ.NUM ;ONE FILE IN THIS EQ
HRLI S1,ARC.T1(M) ;SETUP SOURCE POINTER
HRRI S1,.EQLIM+1(P1) ;AND THE DESTINATION POINTER
BLT S1,.EQLIM+4(P1) ;COPY OVER THE TAPE 1 INFO
MOVX T1,EQHSIZ ;GET THE HEADER SIZE
ADD T1,P1 ;POINT TO THE FP AREA
MOVX S1,FPMSIZ ;GET THE FP LENGTH
STORE S1,.FPLEN(T1),FP.LEN ;SAVE IT IN THE FP
ADD T1,S1 ;POINT TO THE FP
MOVX S1,FDXSIZ ;GET THE FD SIZE
STORE S1,.FDLEN(T1),FD.LEN ;SAVE IT IN THE FD
HRLI S1,ARC.FL(M) ;POINT TO THE FILE-SPEC
HRRI S1,.FDFIL(T1) ;AND ITS DESTINATION
BLT S1,FDXSIZ-1(T1) ;COPY THE FILE-SPEC OVER TO THE EQ
PUSH P,M ;SAVE THE ARCHIVE MSG ADDRESS
MOVE M,P1 ;RESET M TO POINT TO THE EQ
PUSHJ P,Q$CREATE## ;CREATE THE QUEUE ENTRY
SKIPE G$ERR## ;ANY ERRORS ???
$STOP(CRA,CREATE REJECTED ARCHIVE DATA) ;YES,,SERIOUS ERROR !!!
POP P,M ;RESTORE THE ARCHIVE MESSAGE ADDRESS
LOAD S1,ARC.FN(M),AR.FNC ;GET THE FINCTION CODE
CAXN S1,.RETM ;IS IT A FILE RETRIEVAL REQUEST ???
$WTO (< Request From ^T/.EQOWN(P1)/ >,<File: ^T/ARC.FL(M)/>,.EQROB+.ROBTY(P1))
MOVE S1,P1 ;GET THE EQ ADDRESS
PJRST M%RPAG ;RELEASE IT AND RETURN
SUBTTL Retrieval Queue Subroutines
; Routine to link a retrieval request into the queue. Requests are ordered
; by their tape pointers.
I$RLNK: PUSHJ P,.SAVET ; Save T1-T4
MOVE S1,AP ; S1 points to new entry
MOVEI S2,RETL.A ; S2 points to tape info block
PUSHJ P,GETAPE ; Get the relevant tape numbers
LOAD E,.QHLNK(H),QH.PTF ; Get pointer to first in Q
RETL.1: JUMPE E,M$ELNK## ; If end of queue, tack on to end
MOVE S1,E ; S1 points to queued entry
MOVEI S2,T1 ; Tape info to T1 and T2
PUSHJ P,GETAPE ; Get tape info
CAMLE T1,RETL.A+0 ; Compare tape ID's
PJRST M$LINK## ; Link in here
CAME T1,RETL.A+0 ; Compare ID's again
JRST RETL.2 ; Move to next queued entry
CAMLE T2,RETL.A+1 ; Compare TSN,,TFN
PJRST M$LINK## ; Link in here
RETL.2: LOAD E,.QELNK(E),QE.PTN ; Get next entry in Q
JRST RETL.1 ; And continue
RETL.A: BLOCK 2 ; Tape info
;Routine to fill in tape information of a new retrieval request.
I$RDEF: SETZ S1,
STOLIM S1,.EQLIM(M),TDTD ;Clear timestamp
HRLI S1,.EQLIM(M) ; Make BLT pointer
HRRI S1,.EQCHK(M) ; Copy the tape info
BLT S1,.EQCHK+<EQLMSZ-1>(M) ; Into the limit words
AOS S1,RETSEQ ; Get new sequence #
STORE S1,.EQSEQ(M),EQ.SEQ ; Sequence the request
LOAD S1,.EQLEN(M),EQ.LOH ;GET THE MSG HEADER LENGTH
ADD S1,M ;POINT TO THE FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADDI S1,.FDSTG(S2) ;POINT TO THE FILE NAME
HRL S1,S1 ;MOVE SOURCE TO LEFT HALF
HRRI S1,.EQCON(M) ;GET THE DESTINATION ADDRESS
BLT S1,.EQCON+11(M) ;PUT THE FILE NAME IN THE CONN DIR AREA
SETZM S1 ;GET A NULL BYTE
DPB S1,[POINT 7,.EQCON+11(M),34] ;MAKE SURE ITS ASCIZ
$RETT ; (A REAL HACK !!!) RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
I$RSCH: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S2 ;SAVE THE OBJECT ADDRESS
MOVEI S2,OBJPRM+.OBTAP(P1) ; Point to OBJ tape info
PUSHJ P,GETAPE ; Copy tape info into OBJ
MOVE S1,G$NOW## ;GET THE CURRENT UDT
EXCH S1,OBJPRM+.OBSTM(P1) ;SWAP THE CURRENT TIME WITH OBJECT TIME
CAIE S1,0 ;WAS OBJECT TIME 0
CAXN S1,<1B1> ;OR WAS IT 200000,,0
$RETT ;YES TO EITHER,,JUST RETURN
MOVEM S1,OBJPRM+.OBSTM(P1) ;NO,,RESTORE OLD OBJECT TIME
$RETT ;RETURN AND SEND NEXTJOB MSG
; Routine to find a retrieval request. If DUMPER is not already
; processing one, the next retrieval to be processed is found by skipping
; through the queue until a request which sorts after the most recently
; processed request. Starting with that request, the timestamps are
; checked. If a request is found which was not already processed (and
; rejected) by the current instance of DUMPER, that is the chosen request.
I$RFJB: PUSHJ P,.SAVE1 ; Save P1
SETZM RETS.A ; Clear flag
MOVE P1,S1 ; Save OBJ address
LOAD S1,HDRRET##+.QHLNK,QH.PTF ; Get first item in the QUEUE
JUMPE S1,RETS.5 ;NOTHING THERE,,JUST RETURN
RETS.0: MOVEI S2,T1 ; Point to T1-T2
PUSHJ P,GETAPE ; Get tape info
CAMGE T1,OBJPRM+.OBTAP(P1) ; Compare tape ID's
JRST RETS.1 ; Already been tried this pass
CAME T1,OBJPRM+.OBTAP(P1) ; Compare again
JRST RETS.3 ; Start with this one
CAMGE T2,OBJPRM+.OBSSN(P1) ; Compare TSN,,TFN
JRST RETS.1 ; Already tried this pass
CAME T2,OBJPRM+.OBSSN(P1) ; Compare again
JRST RETS.3 ; Start here
RETS.1: LOAD S1,.QELNK(S1),QE.PTN ; Get next in Q
JUMPN S1,RETS.0 ; Continue if anything there
PUSHJ P,RETS.9 ; Otherwise start new pass
; Now that we have found the place to start looking, start looking.
RETS.3: GETLIM T1,.QELIM(S1),TDAT ;Get date/time last tried
CAMLE T1,OBJPRM+.OBSTM(P1) ; In the past?
JRST RETS.4 ; No, keep looking
$RETT ; Schedule this one
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
RETS.4: LOAD S1,.QELNK(S1),QE.PTN ; Get next in Q
JUMPN S1,RETS.3 ; Continue if anything there
SKIPE RETS.A ; Just start a new pass?
JRST RETS.5 ; Yes, no more to do
PUSHJ P,RETS.9 ; No, start one
JRST RETS.3 ; Resume loop
; Here when there are no more suitable requests.
RETS.5: MOVX S1,OBSINT ;GET INTERNAL SHUTDOWN BIT
IORM S1,OBJSCH(P1) ;LITE IT
SETZM OBJPRM+.OBTAP(P1) ;CLEAR THE LAST TAPE ID
SETZM OBJPRM+.OBSSN(P1) ;CLEAR THE LAST SAVE SET NUMBER
MOVX S1,<1B1> ;CREATE A VERY LARGE TIME STAMP
MOVEM S1,OBJPRM+.OBSTM(P1) ;AND SET IT FOR LATER
$RETF ;AND RETURN
; Subroutine used by RETSCH to begin a new pass through the queue.
RETS.9: SETZM OBJPRM+.OBTAP(P1) ; Reset watermark
SETZM OBJPRM+.OBSSN(P1) ; Ditto
LOAD S1,HDRRET##+.QHLNK,QH.PTF ; Point to first in Q
SETOM RETS.A ; Flag the new pass
POPJ P,
RETS.A: BLOCK 1 ; -1 implies new pass started
SUBTTL GETAPE - ROUTINE TO EXTRACT TAPE NBRS FROM A RETREIVAL REQUEST
; The GETAPE routine is used by RETLNK and RETFJB to extract the tape
; numbers by which a retrieval request should be sorted.
; Call S1 = pointer to retrieval request (QE)
; S2 = pointer to 2 word block, as follows:
; 0: Tape ID
; 1: TSN,,TFN
; Returns +1 always.
GETAPE: PUSHJ P,.SAVE2 ; Save P1-P3
GETLIM P1,.QELIM(S1),TID2 ; Assume using 2nd set
GETLIM P2,.QELIM(S1),TTN2
DMOVEM P1,0(S2) ; Store it wherever
GETLIM P1,.QELIM(S1),TUFT ; Get 1st/2nd flag bit
JUMPE P1,.RETT ; If not set, assumption correct
GETLIM P1,.QELIM(S1),TID1 ; Was set, get 1st set
GETLIM P2,.QELIM(S1),TTN1
DMOVEM P1,0(S2) ; Return those instead
$RETT ; Done
SUBTTL FILE ARCHIVING NOTIFICATION SCHEDULING ROUTINES
INTERN I$NLNK ;LINK IN A JOB
INTERN I$NDEF ;FILL IN DEFAULTS FOR A JOB
INTERN I$NFJB ;FIND A JOB FOR SCHEDULING
; Routine to link entries in the notification queue. The entries are
; sorted first by the directory number, and second by the reason
; for notification (either the file was expunged or the archive
; pointers were explicitly discarded.)
I$NLNK: PUSHJ P,.SAVE3 ; Save P1-P3
LOAD E,.QHLNK(H),QH.PTF ; Get first in Q
GETLIM P1,.QELIM(AP),TDTD ; Get timestamp
LOAD P2,.QESEQ(AP),QE.PRI ; Get reason for notification
NOTL.1: JUMPE E,M$ELNK## ; If end, link there
CAMGE P1,.QELIM(E) ; Compare dir #s
PJRST M$LINK## ; Link in here
CAME P1,.QELIM(E) ; Compare again
JRST NOTL.2 ; Scan further
LOAD P3,.QESEQ(E),QE.PRI ; Get reason of Q'd entry
CAMG P2,P3 ; Compare
PJRST M$LINK## ; Link in here
NOTL.2: LOAD E,.QELNK(E),QE.PTN ; Get next in Q
JRST NOTL.1 ; And keep comparing
SUBTTL I$NDEF - ROUTINE TO FILL IN NOTIFICATION DEFAULTS
; Routine to fill in the tape pointers and directory number associated
; with the file in a NOTIFICATION queue entry.
I$NDEF: LOAD S1,.EQLEN(M),EQ.LOH ;GET THE HEADER LENGTH
ADD S1,M ;POINT TO THE FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADDI S2,.FDFIL(S1) ;POINT TO THE FD FILENAME
HRLI S2,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVE S1,[POINT 7,DIRCTY] ;GET THE DESTINATION PTR
NDEF.1: ILDB T1,S2 ;GET A FILESPEC BYTE
IDPB T1,S1 ;SAVE IT
JUMPE T1,.RETF ;IF 0,,THATS A NO-NO
CAIE T1,76 ;WAS IT THE END OF THE DIRECTORY ???
JRST NDEF.1 ;NO,,KEEP ON GOING
SETZM T1 ;GET A NULL BYTE
IDPB T1,S1 ;MAKE IT ASCIZ
MOVX S1,RC%EMO ;WANT EXACT MATCH ONLY
HRROI S2,DIRCTY ;GET THE ASCIZ STRUCTURE ADDRESS
SETZM T1 ;CLEAR AC 3
RCDIR ;GET THE FILE'S DIRECTORY NUMBER
ERJMP .RETF ;NO GOOD,,END IT ALL
STOLIM T1,.EQLIM(M),TDTD ;SAVE THE CONNECTED DIR IN THE LIMIT WRD
$RETT
DIRCTY: BLOCK 10 ;TEMP DIRECTORY STORAGE
REASON==DIRCTY+1 ;REASON BLOCK USED IN I$NTFY
I$NFJB: LOAD S1,HDRNOT##+.QHLNK,QH.PTF ; Hand 'em first guy in queue
JUMPE S1,.RETF ; Return if nothing there
$RETT
SUBTTL I$NTFY - ROUTINE TO PERFORM FILE ARCHIVING NOTIFICATION
INTERN I$NTFY ;MAKE IT GLOBAL
I$NTFY: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZM G$NTFY## ;CLEAR THE NOTIFY FLAG
MOVEI H,HDRNOT## ;SET UP THE NOTIFICATION HEADER PTR
SETZM DIRCTY ;CLEAR THE DIRECTORY NUMBER
SETZM P1 ;CLEAR THE OUTPUT PAGE ADDRESS
NTFY.1: LOAD AP,.QHLNK(H),QH.PTF ;GET THE FIRST ENTRY
JUMPE AP,NTFY.2 ;NO MORE,,RETURN
GETLIM S1,.QELIM(AP),TDTD ;GET THE USERS DIRECTORY NUMBER
CAME S1,DIRCTY ;IF THE SAME,,THEN CONTINUE
PUSHJ P,NSETUP ;ELSE GO SETUP A PAGE FOR OUTPUT
LOAD S1,.QESEQ(AP),QE.PRI ;GET THE REASON CODE (SAVED IN PRIO FLD)
CAME S1,REASON ;IF THE SAME,,THEN CONTINUE
PUSHJ P,NHEADR ;ELSE GO SETUP THE HEADER
PUSHJ P,NXFILE ;OUTPUT THE FILE DATA
JRST NTFY.1 ;AND GO GET ANOTHER ENTRY
NTFY.2: SKIPE P1 ;NOTHING THERE,,JUST RETURN
PUSHJ P,NSNDIT ;ELSE SEND THE DATA OFF TO ORION
PUSHJ P,NTIMER ;GO RESET THE NOTIFICATION TIMER
$RETT ;RETURN
SUBTTL NSETUP - ROUTINE TO SETUP A PAGE FOR NOTIFICATION
;CALL: AP/.QE ADDRESS
;
;RET: P1/OUTPUT PAGE ADDRESS
NSETUP: PUSH P,S1 ;SAVE S1 FOR A MINUTE
SKIPE P1 ;DO WE ALREADY HAVE A PAGE SETUP ???
PUSHJ P,NSNDIT ;YES,,SEND IT OFF
POP P,S1 ;RESTORE THE DIRECTORY NUMBER
MOVEM S1,DIRCTY ;SAVE IT FOR LATER
PUSHJ P,M%ACQP ;GET A PAGE FOR THE DATA
MOVE P1,S1 ;GET THE PAGE NUMBER IN P1
PG2ADR P1 ;CONVERT IT TO AN ADDRESS
MOVEI S1,.OMNFY ;GET THE NOTIFY MSG TYPE
STORE S1,.MSTYP(P1),MS.TYP ;SAVE IT IN THE MESSAGE
MOVX S1,NT.MLU ;GET THE 'MAIL TO USER' FLAG BITS
MOVEM S1,.OFLAG(P1) ;SAVE IT IN THE FLAG WORD
MOVEI S1,3 ;GET THE ARGUMENT COUNT
MOVEM S1,.OARGC(P1) ;SAVE IT IN THE MESSAGE
MOVEI S1,.CMTXT ;GET THE DATA BLOCK TYPE
STORE S1,.OHDRS+ARG.HD(P1) ;SAVE IT IN THE MESSAGE
MOVEI S1,.OHDRS+ARG.DA(P1) ;POINT TO THE DATA BLOCK
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,BYTPTR ;SAVE IT FOR LATER
SETZM P2 ;CLEAR THE FLAG AC
SETOM REASON ;RESET THE REASON
$RETT ;AND RETURN
SUBTTL NHEADR - ROUTINE TO SETUP THE DATA HEADER LINE
;CALL: S1/THE REASON (MUST BE 0 OR 1)
;
;RET: P2/THE ENCODED REASON
NHEADR: MOVEM S1,REASON ;SAVE THE REASON
TRO P2,1(S1) ;LITE THE APPROPRIATE BITS
CAIN S1,0 ;IS THE REASON 'EXPUNGED' ???
$TEXT (OUTBYT,<The Following Archived File(s) have been Expunged:>)
CAIN S1,1 ;IS THE REASON 'DISCARDED' ???
$TEXT (OUTBYT,<The Archive Status of the Following File(s) has been Discarded:>)
$RETT ;RETURN
SUBTTL NXFILE - ROUTINE TO OUTPUT THE FILE DATA
;CALL: AP/.QE ADDRESS
;
;RET: TRUE ALWAYS
NXFILE: LOAD S1,.QESTN(AP),QE.DPA ;GET THE EXTERNAL QUEUE DISK ADDRESS
PUSHJ P,F$RDRQ## ;READ IT IN
PUSH P,S1 ;SAVE THE ADDRESS FOR A MINUTE
LOAD S2,.EQLEN(S1),EQ.LOH ;GET THE HEADER LENGTH
ADD S1,S2 ;POINT TO THE FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADDI S1,.FDFIL(S2) ;POINT TO THE FD FILESPEC
GETLIM T1,.QELIM(AP),TTS1 ;FILE #1 SAVESET #
GETLIM T2,.QELIM(AP),TTF1 ;FILE #1 FILE #
GETLIM T3,.QELIM(AP),TTS2 ;FILE #2 SAVESET #
GETLIM T4,.QELIM(AP),TTF2 ;FILE #2 FILE #
LOAD S2,.QELIM+1(AP) ;GET THE TAPE VOLUME ID
TLNN S2,777777 ;IS IT DECIMAL ???
$TEXT (OUTBYT,< ^T/0(S1)/ Tape 1:^D/.QELIM+1(AP)/,^D/T1/,^D/T2/ Tape 2:^D/.QELIM+3(AP)/,^D/T3/,^D/T4/>)
TLNE S2,777777 ;IS IT SIXBIT ???
$TEXT (OUTBYT,< ^T/0(S1)/ Tape 1:^W/.QELIM+1(AP)/,^D/T1/,^D/T2/ Tape 2:^W/.QELIM+3(AP)/,^D/T3/,^D/T4/>)
LOAD S1,.QESTN(AP),QE.DPA ;GET THE DISK ADDRESS AGAIN
PUSHJ P,F$RLRQ## ;RELEASE THE REQUEST
POP P,S1 ;GET THE IN-CORE ADDRESS
PUSHJ P,M%RPAG ;RELEASE IT
PUSHJ P,M$RFRE## ;RELEASE THE QE ALSO
$RETT ;AND RETURN
OUTBYT: IDPB S1,BYTPTR ;OUTPUT THE BYTE
$RETT ;AND RETURN
BYTPTR: BLOCK 1 ;BYTE POINTER FOR NOTIFICATION
SUBTTL NSNDIT - ROUTINE TO SEND THE NOTIFICATION
;CALL: P1/THE DATA PAGE ADDRESS
;
;RET: TRUE ALWAYS
NSNDIT: $SAVE AP ;SAVE AP ACROSS THE SUBROUTINE CALL
HRRZ S1,BYTPTR ;GET THE END ADDRESS
SUBI S1,.OHDRS-1(P1) ;GET THE BLOCK LENGTH
STORE S1,.OHDRS+ARG.HD(P1),AR.LEN ;SAVE IT IN THE MESSAGE
ADDI S1,.OHDRS(P1) ;POINT TO THE NEXT BLOCK
MOVE S2,[2,,.CMDIR] ;SET UP THE DIRECTORY BLK HEADER
MOVEM S2,ARG.HD(S1) ;SAVE IT
MOVE S2,DIRCTY ;GET THE USERS DIRECTORE NUMBER
MOVEM S2,ARG.DA(S1) ;SAVE IT
ADDI S1,2 ;POINT TO THE NEXT BLOCK
PUSH P,S1 ;SAVE ITS ADDRESS FOR A MINUTE
MOVX S2,.NTSUB ;GET THE SUBJECT BLK TYPE
STORE S2,ARG.HD(S1) ;SAVE IT IN THE MESSAGE
MOVEI S1,ARG.DA(S1) ;POINT TO THE DATA BLOCK
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,BYTPTR ;SAVE IT
$TEXT (OUTBYT,<^T/@REATBL(P2)/>) ;OUTPUT THE SUBJECT STRING
HRRZ S1,BYTPTR ;GET THE END ADDRESS
POP P,S2 ;GET THE START ADDRESS
SUBI S1,-1(S2) ;GET THE BLOCK LENGTH
STORE S1,ARG.HD(S2),AR.LEN ;SAVE IT IN THE MESSAGE
HRRZ S1,BYTPTR ;GET THE END ADDRESS AGAIN
SUBI S1,-1(P1) ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IT
ADR2PG P1 ;CONVERT THE ADDRESS TO A PAGE NUMBER
HRRM P1,MNTPDB+.IPCFP ;SAVE THE PAGE NUMBER
MOVE S1,G$OPR## ;GET ORION'S PID
MOVEM S1,MNTPDB+.IPCFR ;SAVE AS RECIEVERS PID
MOVEI AP,MNTPDB ;GET THE PDB ADDRESS
PUSHJ P,C$SEND## ;SEND IT OFF
$RETT ;AND RETURN
REATBL: [0,,0] ;NOT USED
[ASCIZ/Expunged Archive File(s)/]
[ASCIZ/Discarded Archive Status/]
[ASCIZ\Expunged File(s)/Discarded Archive Status\]
SUBTTL NTIMER - ROUTINE TO SET/RESET THE NOTIFICATION TIMER
NTIMER: MOVEI S1,COMSTA##+.OHDRS+ARG.DA+OBJ.TY ;POINT TO THE OBJECT BLOCK
PUSHJ P,A$FOBJ## ;GO FIND IT
JUMPF .RETF ;NOT THERE,,JUST RETURN
MOVE P1,S1 ;SAVE THE OBJECT ADDRESS
MOVX S1,OBSIGN ;GET THE IGNORE BIT
IORM S1,OBJSCH(P1) ;SET IT
MOVEI S1,^D240 ;GET FOUR HOURS IN MINUTES
PUSHJ P,I$AFT ;GET CURRENT TIME+4 HOURS
STORE S1,OBJTIM(P1) ;SAVE IT
$RETT ;AND RETURN
END