Trailing-Edge
-
PDP-10 Archives
-
BB-L014Z-BM_1990
-
galsrc/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
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH QSRMAC,GLXMAC,ORNMAC,NEBMAC ;PARAMETER FILE
PROLOGUE(QSRT20) ;GENERATE THE NECESSARY SYMBOLS
IFE FTJSYS,<
PASS2 ;DON'T BOTHER FOR TOPS-10 ASSEMBLY
END
> ;END OF IFE FTJSYS
T20MAN==:37 ;Maintenance edit number
T20DEV==:35 ;Development edit number
VERSIN (T20) ;Generate edit number
EXTERNAL MEMEDT,NETEDT,QUEEDT,SCHEDT
QSRED3==:MEMEDT+NETEDT+QUEEDT+SCHEDT+T20EDT
Subttl Table of Contents
; Table of Contents for QSRT20
;
; Section Page
;
;
; 1. Revision history . . . . . . . . . . . . . . . . . . . 4
; 2. Module Storage . . . . . . . . . . . . . . . . . . . . 6
; 3. Initialization Routine . . . . . . . . . . . . . . . . 7
; 4. Information . . . . . . . . . . . . . . . . . . . . . 9
; 5. I$SYSV - Read time-dependent system variables . . . . 10
; 6. I$CHAC - Routine to Check File Access . . . . . . . . 11
; 7. IPCF Interface . . . . . . . . . . . . . . . . . . . . 12
; 8. I$IPS - Send an IPCF Message . . . . . . . . . . . . . 13
; 9. FD Manipulation Routines . . . . . . . . . . . . . . . 14
; 10. I$CSM - Create a Canonical SPOOL Message . . . . . . . 15
; 11. I$CLM - Create a Canonical LOGOUT Message . . . . . . 17
; 12. Routines to handle system dependent fields . . . . . . 18
; 13. I$EQQE - Move fields from EQ to QE . . . . . . . . . . 19
; 14. I$LPPT - Update Remote LPT QE . . . . . . . . . . . . 20
; 15. I$QESM - Move fields from the QE to CSM . . . . . . . 21
; 16. I$SMEQ - ROUTINE TO MOVE FIELDS FROM THE CSM TO EQ . . 22
; 17. I$RMCH - Match a request and an RDB . . . . . . . . . 23
; 18. I$DFEQ - Default and check the EQ . . . . . . . . . . 24
; 19. I$LGFD - ROUTINE TO BUILD A LOG FILE FD. . . . . . . . 27
; 20. Spooled CDR file support . . . . . . . . . . . . . . . 29
; 21. I$CACV - ROUTINE TO VALIDATE THE ACCOUNT STRING FOR 'C 32
; 22. I$SACV - ROUTINE TO VALIDATE ACCT STRINGS FOR 'SCHEDUL 33
; 23. I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT DATA INTO 34
; 24. Batch Stream Unique Directory Routines . . . . . . . . 35
; 25. I$UQST - Set Directory for a Stream . . . . . . . . . 36
; 26. I$UQCL - Clear the directory for a stream . . . . . . 37
; 27. I$UQCH - Check for directory match . . . . . . . . . . 38
; 28. UNIFST - Find stream's unique entry . . . . . . . . . 39
; 29. Failsoft System Interface . . . . . . . . . . . . . . 40
; 30. I$WRIT - Write something into master queue file . . . 41
; 31. I$READ - Read something from master queue file . . . . 42
; 32. I$CRIP - Create an index page in master file . . . . . 43
; 33. I$OQUE - Open master queue files . . . . . . . . . . . 44
; 34. FBREAK - Find a break character . . . . . . . . . . . 45
; 35. STGWLD - Match a "wild" string . . . . . . . . . . . . 46
; 36. I$MINI - ROUTINE TO INITIALIZE THE TAPE MOUNT PROCESSO 47
; 37. INITIALIZE RESTARTED MOUNTR . . . . . . . . . . . . . 48
; 38. I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS . . . 49
; 39. I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES . . 50
; 40. OPERATOR TAPE/DISK MOUNT MESSAGES . . . . . . . . . . 51
; 41. TAPE MOUNT CHECKPOINT ROUTINE . . . . . . . . . . . . 52
; 42. I$MATR - ROUTINE TO SETUP AND PASS MNT ATTRIBUTE MSGS 54
; 43. I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS . 55
; 44. FILE ARCHIVING ROUTINES . . . . . . . . . . . . . . . 56
; 45. ARCHIVE - IPCC Function .IPCSR (41) . . . . . . . . . 57
; 46. Retrieval Queue Subroutines . . . . . . . . . . . . . 58
; 47. GETAPE - ROUTINE TO EXTRACT TAPE NBRS FROM A RETREIVAL 61
Subttl Table of Contents (page 2)
; Table of Contents for QSRT20
;
; Section Page
;
;
; 48. FILE ARCHIVING NOTIFICATION SCHEDULING ROUTINES . . . 62
; 49. I$NDEF - ROUTINE TO FILL IN NOTIFICATION DEFAULTS . . 63
; 50. I$NTFY - ROUTINE TO PERFORM FILE ARCHIVING NOTIFICATIO 64
; 51. NSETUP - ROUTINE TO SETUP A PAGE FOR NOTIFICATION . . 65
; 52. NHEADR - ROUTINE TO SETUP THE DATA HEADER LINE . . . . 66
; 53. NSNDIT - ROUTINE TO SEND THE NOTIFICATION . . . . . . 67
; 54. NTIMER - ROUTINE TO SET/RESET THE NOTIFICATION TIMER . 68
SUBTTL Revision history
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
1 7-Jan-83
Currently no edits
2 4.2.1552 15-Sep-83
In routine I$SMEQ, ignore errors from DIRST instead of
stopcoding. Remove ODE stopcd completely. Return from I$SMEQ without
setting TF since it is not used. Old QSRMAC edit 1217.
3 4.2.1556 26-Oct-83
In routine I$RMCH, if both a request ID and a seq. # are specified,
require them both to be correct. Old QSRMAC edit 1221.
4 4.2.1592 17-Sep-84
Correct the way I$SYSV calculates the remaining time until system
shutdown.
5 4.2.1594 20-Sep-84
Do not crash upon a PMAP% failure, instead sleep for 2 seconds and
retry, up to MAXFAL tries before crashing.
6 4.2.1597 7-Nov-84
For mount requests, send an ACK to the user before sending the mount
message to MOUNTR. This prevents a race between MOUNTR's ACK and QUASAR's ACK.
7 4.2.1604 29-Jan-85
Increase the size of DIRCTY to prevent overwriting routine I$NFJB
when archiving/retrieving files with structure/directory names in excess of
40. characters.
10 4.2.1610 28-Feb-85
Insure that notification requests have an after time (.EQAFT) later
than G$NOW so the DELETE, ARCHIVE event will be reported to the user.
***** Release 5.0 -- begin development edits *****
10 5.1003 7-Jan-83
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
11 5.1137 20-Apr-84
Subtotal QUASAR edit version number due to restriction in MACRO into
QSRED3.
12 5.1182 29-Nov-84
Do not trash structure mount requests made after QUASAR startup and
before MOUNTR startup. Also, do not trash structure mount requests made
after MOUNTR crashes and before it is restarted.
13 5.1183 30-Nov-84
Don't interrupt for network changes anymore (get rid of I$NINT).
14 5.1200 6-Feb-85
Restrict access to JFNs by turning on bit GJ%ACC on GTJFN calls.
15 5.1209 25-Mar-85 QAR# 838146.
Added 4.2 patch allowing enable users to use the /ACCOUNT switch.
***** Release 5 -- begin maintenance edits *****
20 Increment maintenance edit level for GALAXY 5.
***** Release 6.0 -- begin development edits *****
25 6.1042 29-Oct-87
Add support for remote printer requests.
26 6.1057 4-Nov-87
Change PS: to BS: and PS:[SPOOL] to SPOOL: for Non PS: login feature.
27 6.1097 22-Nov-87
Use the $QACK and $QWTO macros instead of the $ACK and $WTO macros
when sending .OMACK and .OMWTO messages.
30 6.1100 22-Nov-87
If a message send for a mount request fails due to MOUNTR not running,
then check if the mount request originated from a remote node in the cluster.
If it has, then include a remote node display block in the .OMACK message
and turn on bit MF.NEB in the flag word.
31 6.1123 6-Dec-87
If a create request does not include a node name, then set bit EQ.NND
in the EQ.
32 6.1162 5-Jan-88
If an IPCF send to MOUNTR fails due to MOUNTR not running and if the
message originated remotely, then check the message type. If the message is not
a dismount message, then send to ORION an .OMACK message; otherwise, send ORION
a FROM NEBULA DISMOUNT ACK message.
33 6.1175 7-Feb-88
Add a check to routine I$RMCH to ensure that a KILL request from a
remote node only cancels print requests that originated from that node.
34 6.1185 17-Feb-88
If a CANCEL command is given with an explicit request i.d. and a
request matches that i.d. number, then do not consider a match unless the
/USER, /SEQUENCE , and /JOBNAME also match.
35 6.1225 8-Mar-88
Update copyright notice.
***** Release 6.0 -- begin maintenance edits *****
36 6.1269 18-Oct-88
In routine RMCH.1, if the request is from an operator then there is no
need to check for the node name. The check is only needed if the request is
from a user.
37 6.1289 29-Nov-89
Declare location G$NULA as external. G$NULA is used by the Q$xxx
macros.
\ ;End of Revision History
COMMENT \
TOPS20 Field Interpretation
1) External Owner ID is a User Name
2) Owner ID (Internal) is a User Number
\
MAXFAL==^D40 ;For now
EXTERN G$REMN ;[27]REMOTE NODE WHERE MSG CAME FROM
EXTERN G$NEBF ;[27]REMOTE MESSAGE FLAG
;**;[37]At EXTERN G$NEBF add 1 line JCR 11/29/89
EXTERN G$NULA ;[37]Required by the $Qxxx macros
SUBTTL Module Storage
SPLCDR: BLOCK FDXSIZ ;SCRATCH SPACE FOR SPOOLED CDR FILESPEC
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
FAILP: BLOCK 1 ;COUNTER FOR PMAP RETRYS
MTRPID: BLOCK 1 ;MOUNTR'S PID
;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
BLOCK ^D34 ;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 /SPOOL:/] ;[26]DIRECTORY OF SPOOL
RCDIR ;RECOGNIZE IT
ERCAL S..NSD ;NOPE, WE MUST DIE
MOVEM T1,G$SPLD## ;SAVE FOR POSTERITY
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$MDA## ; Turn on tape/disk support
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
IFN FTFTS,<
MOVEI S1,.OTFTS ;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
> ;End IFN FTFTS
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
SETOM G$NTFY## ;PURGE NOTIFICATION REQUESTS
MOVNI TF,MAXFAL ;ARM THE PMAP FAILURE
MOVEM TF,FAILP ;FOR MAXFAL FAILURES
$RETT ;RETURN
$STOP (NSD,<No spooling directory>)
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$CHAC ;CHECK ACCESS
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
; Time of day G$NOW
; Batch LOGIN flag G$LOGN = 0 --- No LOGINs
; = -1 --- LOGINs allowed
; Operator available flag G$OPRA = 0 --- SCHED 400 set
; = -1 --- Operator on duty
I$SYSV: PUSHJ P,I%NOW ;GET TIME OF DAY
MOVEM S1,G$NOW## ;STORE IT
MOVE S1,['DWNTIM'] ;GET ^ECEASE SCHEDULING PARAMETER
SYSGT ;HOW MUCH TIME DO WE HAVE LEFT???
SKIPN S2 ;DOES THE TABLE ENTRY EXIST???
SETZM S1 ;NO,,ASSUME NO SCHEDULED SHUTDOWN
JUMPLE S1,SYSV.1 ;NONE PENDING,,SKIP THIS
SUB S1,G$NOW## ;CALCULATE TIME DIFFERENCE
HRRZ S2,S1 ;Place fraction into S2
HLRZS S1 ;Move days to the right half
IMULI S1,^D86400 ;Convert days to seconds
IMULI S2,^D86400 ;Convert the fraction
LSH S2,-^D18 ;into seconds
ADD S1,S2 ;Get the total number of seconds
CAIGE S1,^D60 ;MORE THEN 1 MINUTE LEFT ???
SETOM S1 ;NO,,ASSUME TIMESHARING IS OVER
SYSV.1: JUMPL S1,SYSV.2 ;IF TIMESHARING IS OVER THEN RETURN
CAMN S1,G$KSYS## ;ANY CHANGE FROM BEFORE ???
JRST SYSV.2 ;NO,,CONTINUE ONWARD
SKIPL G$KSYS## ;WAS LAST STATE 'TIMESHARING OVER' ???
SKIPG S1 ;NO,,IS NEW STATE 'NO KSYS SET' ???
DOSCHD ;YES,,FORCE A SCHEDULING PASS
SYSV.2: MOVEM S1,G$KSYS## ;SETUP KSYS TIMER
SETOM G$LOGN## ;ASSUME BATCH LOGINS ALLOWED
MOVX S1,.SFPTY ;ARGUMENT
TMON ;READ MONITOR'S FLAG SETTING
ERCAL [$STOP (TJF,TMON JSYS FAILED)] ;TMON FAILED, DIE
SKIPN S2 ;LOGINS ALLOWED?
SETZM G$LOGN## ;NOPE
SETOM G$OPRA## ;ASSUME OPERATOR ON DUTY
MOVX S1,.SFOPR ;GET FUNCTION CODE
TMON ;ASK MONITOR FOR OPR IN ATTENDANCE
ERCAL S..TJF ;TMON FAILED, DIE
SKIPN S2 ;ANYONE AROUND ???
SETZM G$OPRA## ;NO
$RETT ;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 A$WHEEL## ;NO, WIN ONLY IF WHEEL
$RETT ;YES, LET HIM DO IT
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$LPPT - Update Remote LPT QE
INTERN I$LPTT
;Call is: AP/ QE address
; M/ CREATE message address
I$LPTT: LOAD S1,.EQROB+.ROBTY(M),AR.TYP ;[25]PICK UP OBJECT TYPE
CAIE S1,.OTLPT ;[25]IS THIS A LPT OBJECT?
$RET ;[25]NO, RETURN NOW
LOAD S1,.EQSEQ(M),EQ.DLR ;[25]PICK UP REMOTE LPT BIT
SKIPN S1 ;[25]IS THIS A REMOTE LPT?
$RET ;[25]NO, RETURN NOW
SKIPN .EQRPN(M) ;[25]REMOTE LPT NAME?
JRST I$LP.1 ;[25]NO, THEN MUST BE A CLUSTER LPT
MOVEI S1,.QEONM+ARG.DA(AP) ;[25]PICK UP WHERE TO PLACE LPT NAME
HRLI S1,.EQRPN(M) ;[25]PICK UP LPT NAME ADDRESS
MOVEI S2,.QEONM+LPTNLN-1(AP) ;[25]END OF DESTINATION ADDRESS
BLT S1,(S2) ;[25]COPY REMOTE LPT NAME TO QE
MOVX S2,.UNLPT ;[25]ASSUME UNKNOWN REMOTE LPT TYPE
SKIPN S1,.EQNAM(M) ;[25]REMOTE LPT TYPE KNOWN?
JRST I$LP.2 ;[25]NO, INDICATE IN QE
MOVEM S1,.QEONM(AP) ;[25]STORE LPT NAME TYPE IN THE QE
HRRZS S1 ;[25]ISOLATE THE NAME TYPE
MOVX S2,.DQLPT ;[25]ASSUME A DQS LPT
CAIE S1,.KYDQS ;[25]IS IT?
MOVX S2,.LALPT ;[25]NO, IT IS A LAT LPT
SKIPA ;[25]SKIP CHANGING LPT TYPE
I$LP.1: MOVX S2,.CLLPT ;[25]INDICATE A CLUSTER LPT
I$LP.2: IORM S2,.QEROB+.ROBTY(AP) ;[25]INDICATE LPT TYPE IN THE QE
$RET ;[25]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
JFCL ;Ignore any directory errors
$RET ;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 ???
SKIPA ;[34]CHECK FOR A SEQUENCE NUMBER
$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
;**;[36]At RMCH.1:+4L replace 1 line with 2 JYCW Oct-18-88
SKIPE P1,G$REMN## ;[33][36]PICK UP REQUESTOR'S NODE NAME
SKIPE G$QOPR## ;[36]IS THIS AN OPERATOR REQUEST
JRST RMCH.2 ;[33]NONE, SO MUST BE LOCAL
CAME P1,.QENOD(AP) ;[33]SAME REMOTE NODE?
$RETF ;[33]NO, STOP NOW
RMCH.2: MOVEI P1,.RDBOW(S1) ;[33]GET THE USER NAME ADDRESS
SKIPE 0(P1) ;IS THERE A USER NAME ???
JRST RMCH.3 ;[33]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.3: MOVE S2,P1 ;[33]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
SKIPE .EQROB+.ROBND(T2) ;[31]IS THE NODE SPECIFIED?
JRST DFEQ.A ;[31]YES, CHECK FOR OWNER SET
MOVE S1,[POINT 7,G$LOCN##] ;[31]GET THE REQUESTS LOCATION
PUSHJ P,S%SIXB ;[31]CONVERT IT TO SIXBIT
MOVEM S2,.EQROB+.ROBND(T2) ;[31]NO, SAVE LOCAL NODE NAME
MOVX S1,EQ.NND ;[31]PICK DEFAULT NODE NAME BIT
IORM S1,.EQSEQ(T2) ;[31]INDICATE IN THE EQ
DFEQ.A: 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,A$WHEEL## ;NO, WIN ONLY IF HE'S A WHEEL
JUMPF E$IPE## ;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,A$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,[POINT 7,G$ACTS##] ;GET PTR TO SENDERS ACCOUNT STRING
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.
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
PUSH P,S2 ;Save the pointer of the file-spec
MOVX S1,GJ%SHT+GJ%OFG ;SHORT + PARSE ONLY JFN
LOAD S2,IB##+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
POP P,S2 ;Restore the file-spec pointer
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
ERCAL [$STOP(JJF,JFNS JSYS CANT GET MQF NAME STRING)] ;CAN'T, SO DIE
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/SPOOL:BATCH-/ ;[26]
SUBTTL Spooled CDR file support
; Get spooled CDR unique filename handle
; Call: MOVE S1,EQ address
; PUSHJ P,I$GCDR
;
; On return, S1:= handle from .EQSIS
;
I$GCDR::MOVE S1,.EQSIS(S1) ;PICK UP HANDLE (IF ANY)
POPJ P, ;RETURN
; Lite EQ.SPL if queued request has spooled CDR files associated with it
; Call: MOVE S1,EQ address
; PUSHJ P,I$QCDR
;
I$QCDR::MOVX S2,EQ.SPL ;GET 'SPOOLED FILES IN THIS REQUEST' BIT
SKIPE .EQSIS(S1) ;HAVE SPOOLED CDR FILES?
IORM S2,.EQSEQ(S1) ;YES - TURN ON THE BIT
POPJ P, ;RETURN
; Delete spooled CDR files (only orange beasts need this).
; Call: MOVE S1,directory number
; MOVE S2,unique code
; PUSHJ P,I$DCDR
;
; This routine deletes files whos names are:
;
; DSK:[SPOOL]CDR-xxx.CDyyy.*
;
; where xxx is a user's directory number in octal and yyyy are four unique
; characters conjured up by SPRINT (stored as SIXBIT/CDyyyy/ in .EQSIS).
;
I$DCDR::$TEXT (<-1,,SPLCDR>,<SPOOL:CDR-^O/S1,RHMASK/.^W/S2/.*^0>);[26]
MOVX S1,GJ%OLD!GJ%IFG!GJ%SHT ;LOAD GTJFN BITS
LOAD S2,IB##+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
HRROI S2,SPLCDR ;POINT TO FILE-NAME
GTJFN ;GET A JFN
POPJ P, ;FAILED, RETURN
MOVE T1,S1 ;SAVE THE JFN
JRST DCDR.2 ;JUMP INTO THE LOOP
DCDR.1: GNJFN ;GET THE NEXT FILE
JRST DCDR.3 ;DONE - EXPUNGE THE AREA
DCDR.2: TLZ S1,-1 ;CLEAR LEFT HALF OF JFN WORD
TXO S1,DF%NRJ ;DONT RELEASE THE JFN
DELF ;DELETE THE FILE
JFCL ;IGNORE ERRORS
MOVE S1,T1 ;RELOAD INDEXABLE JFN
JRST DCDR.1 ;GET THE NEXT ONE
DCDR.3: MOVEI S1,0 ;NO SPECIAL FLAGS
MOVE S2,G$SPLD## ;GET DIRECTORY NUMBER OF PS:[SPOOL]
DELDF ;EXPUNGE IT
ERJMP .+1 ;IGNORE ERROR..
POPJ P, ;AND RETURN
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
PUSHJ P,A$WHEEL## ;Does user have privileges
JUMPT .RETT ;Yes, no need to validate
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 USE
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,G$SID## ;GET THE USERS NUMBER
DIRST ;CONVERT NUMBER TO NAME
JFCL ;IGNORE THE ERROR
MOVE S1,[POINT 7,G$ACTS##] ;GET PTR TO USERS ACCOUNT STRING
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
SKIPT ;Did we get an entry successfully?
PUSHJ P,S..CCE## ;Stop if not
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
RETMPO: 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
ERJMP [$CALL RTPMAP
JRST RETMPO] ;CAN'T MAP THE PAGE OUT!
MOVNI S1,MAXFAL ;DID IT!
MOVEM S1,FAILP ;RESET THE FAILURE COUNTER
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
ERCAL S..CJF ;CAN'T SO DIE
$RETT ;AND RETURN
$STOP (CJF,CHFDB JSYS FAILED)
RTPMAP: MOVEI S1,2 ;Sleep for 2 seconds
$CALL I%SLP
AOSE FAILP ;COUNT THE FAILURE
POPJ P, ;AND TRY AGAIN
$STOP (PJF,PMAP JSYS ON MQF FAILED) ;RAN OUT OF CHANCES, STOPCODE.
;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
DMOVEM S1,READ.A ;SAVE THE ARGS
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
RETMPI: DMOVE T1,READ.A ;GET ARGS INTO T REGS
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
ERJMP [$CALL RTPMAP
JRST RETMPI] ;CANT PMAP PAGE IN!
MOVNI S1,MAXFAL ;DID IT!
MOVEM S1,FAILP ;RESET THE FAILURE COUNTER
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
RETSCP: 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!!
ERJMP [$CALL RTPMAP
JRST RETSCP] ;CANT SCRAP PAGE!
MOVNI S1,MAXFAL ;DID IT!
MOVEM S1,FAILP ;RESET THE FAILURE COUNTER
$RETT ;AND RETURN
READ.A: BLOCK 2 ;SPACE FOR ARGS
;HERE TO MAP IN AN INDEX PAGE
READ.1: DMOVE S1,READ.A ;GET THE ARGS BACK
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!
ERJMP [$CALL RTPMAP
JRST READ.1] ;CANT PMAP INDEX PAGE IN!
MOVNI S1,MAXFAL ;DID IT!
MOVEM S1,FAILP ;RESET THE FAILURE COUNTER
$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: PUSHJ P,.SAVET ;SAVE T REGS
DMOVE T3,S1 ;SAVE ARGS IN T3 AND T4
HRLI S2,FSSWPI ;NUMBER OF WORDS TO WRITE
RETPOP: DMOVE S1,T3 ;GET ARGS BACK
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
ERJMP [$CALL RTPMAP
JRST RETPOP] ;CANT, MUST DIE!
MOVNI S1,MAXFAL ;DID IT!
MOVEM S1,FAILP ;RESET THE FAILURE COUNTER
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
LOAD S2,IB##+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
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
ERCAL S..GJF ;CAN'T SO DIE
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
$STOP (GJF,GTFDB JSYS FAILED)
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
LOAD S2,IB##+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
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
I$MINI: PUSHJ P,.SAVE3 ;Save P1 through P3
MOVE S1,MDRQUE## ;Get the MDR queue list ID
PUSHJ P,L%FIRST ;Get the first MDR
JUMPF .RETT ;Error, process and return
MOVE S1,G$SND## ;Get MOUNTR's PID
MOVEM S1,MTRPID ;Save for later
JRST I$MIN2 ;Continue processing
I$MIN1: MOVE S1,MDRQUE## ;Get the MDR queue list ID
PUSHJ P,L%NEXT ;Get the next MDR
JUMPF .RETT ;Finished, clean up and return
I$MIN2: MOVE AP,S2 ;Place the MDR address in AP
LOAD P3,.MRCNT(AP),MR.CNT ;Pick up the number of VSLs
MOVNS P3 ;Make it into a
MOVSS P3 ;AOJBN counter
HRR P3,AP ;Finish with the address
I$MIN3: MOVE P2,.MRVSL(P3) ;Pick up the first VSL address
LOAD S1,.VSFLG(P2),VS.TYP ;Get the mount type
CAIE S1,.MNTST ;Is this a structure mount?
JRST [ MOVE S1,P2 ;Place VSL address in S1
PUSHJ P,D$DVSL## ;No, so delete this VSL
SUBI P3,1 ;Next VSL is where this one was
JRST I$MIN5 ] ;Go for the next VSL
PUSHJ P,NXTPAG ;Get a page for the message
PUSHJ P,BLDHDR ;Build the message header
PUSHJ P,BLDBLK ;Build the blocks
PUSHJ P,BLDEND ;Build the rest of the message
I$MIN4: MOVE S1,MTRPID ;Get MOUNTR's PID
MOVEM S1,G$SAB##+SAB.PD ;And store it in the SAB
PUSHJ P,C$SEND## ;Send the message to MOUNTR
JUMPF I$MIN4 ;Failed, try again
I$MIN5: AOBJN P3,I$MIN3 ;Go for the next VSL
LOAD S1,.MRCNT(AP),MR.CNT ;Pick up the number of remaining VSLs
SKIPN S1 ;Any remaining?
PUSHJ P,MDRRID ;No, so delete the MDR
JRST I$MIN1 ;Go for the next MDR
BLDHDR: MOVE S1,[PAGSIZ,,.QOMNT] ;Pick up 1st GALAXY header word
MOVEM S1,.MSTYP(P1) ;And store it
MOVX S1,MM.WAT ;User is waiting for an ACK
MOVEM S1,.MSFLG(P1) ;And store it in GALAXY flag word
MOVE S1,.MRACK(AP) ;Get the ACK code
MOVEM S1,.MSCOD(P1) ;And store in the header
LOAD S1,.MRFLG(AP),MR.FLG ;Pick up the MDR flag word
MOVEM S1,.MMFLG(P1) ;And store it in mount flag word
MOVE S1,.VSLNM(P2) ;Pick up sixbit mount request name
MOVEM S1,.MMNAM(P1) ;And store it in the header
MOVEI S1,1 ;Pick up the mount entry count
MOVEM S1,.MMARC(P1) ;And store it in the header
$RETT ;Finished with the header
BLDBLK: ADDI P1,.MMHSZ ;Point the mountr request header
MOVE S1,[7,,.MNTST] ;Pick up length,,type
MOVEM S1,.MEHDR(P1) ;And store
SETZM .MEFLG(P1) ;No flags are lit
MOVEI S1,2 ;Get the number of subentries
MOVEM S1,.MECNT(P1) ;And store
ADDI P1,.MEHSZ ;Point to the first subentry block
MOVE S1,[2,,.SMALI] ;Get length,,type
MOVEM S1,0(P1) ;And store it
MOVE S1,.VSLNM(P2) ;Pick up the alias from the VSL
MOVEM S1,1(P1) ;And store it
MOVE S1,[2,,.SMNAM] ;Pick up first word of next entry
MOVEM S1,2(P1) ;And store it
HRROI S1,.VSVSN(P2) ;Pick up ASCIZ struture name
PUSHJ P,S%SIXB ;And convert it to sixbit
MOVEM S2,3(P1) ;And store it
$RETT ;Finished with the blocks
BLDEND: SUBI P1,.MMHSZ+.MEHSZ ;Point to the last part of the message
LOAD S1,.VSRID(P2),VS.RID ;Get the ITN
MOVEM S1,.MMITN(P1) ;And store it
MOVE S1,.MRPID(AP) ;Get the sender's PID
MOVEM S1,.MMPID(P1) ;And store it
MOVEI S1,15 ;Get the original message size
MOVEM S1,.MMUMS(P1) ;And store it
MOVE S1,.MRACK(AP) ;Get the ACK code
MOVEM S1,.MMUCD(P1) ;And store it
MOVE S1,.MRUSR(AP) ;Get the user number
MOVEM S1,.MMUNO(P1) ;And store it
MOVE S1,.MRJOB(AP) ;Get the user's capabilities
MOVEM S1,.MMCAP(P1) ;And store
MOVE S1,[POINT 7,.MRACT(AP)] ;Get pointer to the account string
MOVE S2,[POINT 7,.MMACT(P1)] ;Get pointer to message account
BLDEN0: ILDB TF,S1 ;Copy the account string from
IDPB TF,S2 ;The MDR to the message
JUMPN TF,BLDEN0 ;Continue until finished
$RETT ;Finished with the message
NXTPAG: PUSHJ P,M%GPAG ;Get a page for the message
MOVEM S1,G$SAB##+SAB.MS ;Save the address in the SAB
MOVEM S1,P1 ;Save for later
MOVX S1,PAGSIZ ;Get the size of the message
MOVEM S1,G$SAB##+SAB.LN ;And save it in the SAB
$RETT ;And return
MDRRID: MOVE S1,MDRQUE## ;Get the MDR QUEUE ID
MOVE S2,AP ;Get the MDR address
PUSHJ P,L%APOS ;Position to the MDR entry
PUSHJ P,L%DENT ;And delete it
$RETT ;Return
SUBTTL INITIALIZE RESTARTED MOUNTR
INTERN I$MID
I$MID: PUSHJ P,.SAVE3 ;Save P1 through P3
MOVE S1,MDRQUE## ;Get the MDR queue list ID
PUSHJ P,L%FIRST ;Get the first MDR
JUMPF .RETT ;There are none so return
JRST I$MID1 ;Check if it's for a tape
I$MID0: MOVE S1,MDRQUE## ;Get the MDR queue list ID
PUSHJ P,L%NEXT ;Get the next MDR
JUMPF .RETT ;None left, so return
I$MID1: MOVE AP,S2 ;Place the MDR address in AP
LOAD P3,.MRCNT(AP),MR.CNT ;Get the number of VSLs
MOVNS P3 ;Make it into a
MOVSS P3 ;AOBJN counter
HRR P3,AP ;Finish with the address
I$MID2: MOVE P2,.MRVSL(P3) ;Pick up the next VSL address
LOAD S1,.VSFLG(P2),VS.TYP ;Get the mount type
CAIE S1,.MNTST ;Is this a structure mount?
JRST [ MOVE S1,P2 ;No, place VSL address in S1
PUSHJ P,D$DVSL## ;Delete the VSL
SUBI P3,1 ;Next VSL is where this one was
JRST I$MID3 ] ;Go for the next VSL
I$MID3: AOBJN P3,I$MID2 ;Go for the next VSL
LOAD S1,.MRCNT(AP),MR.CNT ;Pick up the number of remaining VSLs
SKIPN S1 ;Any remaining?
PUSHJ P,MDRRID ;No, so delete the MDR
JRST I$MID0 ;Go for the next MDR
SUBTTL Dummy tape subroutines (used only on TOPS10)
I$LOGN:: $RETT ;RETURN
I$RENA:: $RETT ;RETURN
I$CHKL:: $RETT ;RETURN
I$BMDR:: $RETT ;RETURN
I$CUNK:: $RETT ;RETURN
I$RALC:: PJRST S$INPS## ;CHECK SCHEDULABILITY
I$CGEN:: $RETF ;RETURN
SUBTTL I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS
INTERN I$MNTR
;CALL: AP/ The MDR Entry Address
; P1/ The VSL Address
; M/ The Mount Message Address
;
;RET: TRUE RETURN or ERRORS:IMM, MPN, DRN
I$MNTR: PUSHJ P,.SAVE2 ;Save P1 and P2 for a minute
MOVX S1,.OTMNT ;Want the MOUNT Processor PSB
MOVX S2,%GENRC ;Want the generic MOUNT Processor
PUSHJ P,A$LPSB## ;Locate the PSB
SETZM P4 ;Assume MOUNTR is there
JUMPF [ LOAD P2,.VSFLG(P1),VS.TYP ;Not there, pick up mount type
CAIE P2,.MNTST ;Was it for a structure?
SETOM P4 ;No, set MOUNTR not running flag
PUSHJ P,USRACK## ;Yes, so ACK the user
CAIE P2,.MNTST ;Was it for a structure
JRST E$MPN## ;No, so return an error
$RETT ] ;Yes, so return
PUSHJ P,USRACK## ;ACK the user
MOVE S1,P1 ;Restore the VSL address
PUSH P,.VSRID(S1) ;SAVE THE REQUEST ID
PUSHJ P,M%GPAG ;GO GET A PAGE WE CAN USE FOR IPCF
MOVEM S1,G$SAB##+SAB.MS ;SAVE THE MESSAGE ADDRESS
MOVE P1,S1 ;SAVE THE ADDRESS
POP P,S1 ;RESTORE THE REQUEST ID
LOAD S1,S1,VS.RID ;GET JUST 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
MNTR.1: ILDB TF,S1 ;COPY ACCOUNT
IDPB TF,S2 ; STRING FROM MDR
JUMPN TF,MNTR.1 ; 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
MOVX S1,PAGSIZ ;GET THE PAGE LENGTH
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IT AS THE NEW MESSAGE LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IN THE SAB ALSO
MNTR.2: MOVX S1,.OTMNT ;WANT MOUNT PROCESSOR PSB
MOVX S2,%GENRC ;WANT GENERIC MOUNT PROCESSOR
PUSHJ P,A$LPSB## ;LOCATE THE PSB
JUMPF [MOVE S1,G$SAB##+SAB.MS ;NOT THERE,,GET THE MSG ADDRESS
PUSHJ P,M%RPAG ;RETURN THE MEMORY
MOVE S1,.MRVSL(AP) ;Get the VSL address
LOAD S1,.VSFLG(S1),VS.TYP ;Get the mount type
CAIE S1,.MNTST ;Was it a structure request?
PJRST E$MPN## ;No, so return an error
$RETT ] ;Yes, so return
MOVE S1,PSBPID(S1) ;GET THE PROCESSORS PID
MOVEM S1,G$SAB##+SAB.PD ;SAVE THE PID
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF TO MOUNTR
JUMPF MNTR.2 ;LOSE,,TRY AGAIN
$RETT ;WIN,,RETURN
SUBTTL I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES
;CALL: M/RELEASE MESSAGE ADDRESS (SAME AS .QOREL)
;
;RET: TRUE - REQUEST DELETED OR NOT FOUND
; FALSE - INVALID MESSAGE RECIEVED
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,REL.IT(M) ;GET THE REQUEST ID
PUSHJ P,D$FVSL## ;FIND THE VSL
JUMPF .RETT ;NOT THERE,,FINE
PUSHJ P,D$DVSL## ;FOUND IT,,DELETE IT
LOAD S1,.MRCNT(AP),MR.CNT ;ANY REQUESTS LEFT ???
JUMPG S1,.RETT ;YES,,RETURN
PJRST D$DMDR## ;NO,,DELETE THE MDR & RETURN
SUBTTL OPERATOR TAPE/DISK MOUNT MESSAGES
;CALL: M/MESSAGE ADDRESS
;
;RET: TRUE ALWAYS
INTERN I$OMNT ;MAKE THE ROUTINE GLOBAL
I$OMNT: MOVX S1,.OTMNT ;WANT MOUNT PROCESSOR
MOVX S2,%GENRC ;WANT GENERIC MOUNT PROCESSOR
PUSHJ P,A$LPSB## ;LOCATE THE MOUNT PROCESSOR PSB
JUMPF OMNT.1 ;NOT THERE,,TELL OPERATOR
MOVE S1,PSBPID(S1) ;GET MOUNTRS PID
MOVEM S1,G$SAB##+SAB.PD ;SAVE AS RECIEVERS PID
MOVX S1,.CMDEV ;FIND DEVICE NAME BLOCK
PUSHJ P,A$FNDB## ;LOOK FOR IT
MOVX S2,.TAPDV ;CHANGE TO TAPE BLOCK
SKIPF ;WAS A DEVICE BLOCK FOUND ???
STORE S2,-ARG.DA(S1),AR.TYP ;YES,,CHANGE IT TO TAPE BLOCK
PUSHJ P,M%GPAG ;GO GET A PAGE FOR IPCF
MOVEM S1,G$SAB##+SAB.MS ;SAVE THE ADDRESS IN THE SAB
LOAD S2,.MSTYP(M),MS.CNT ;GET THE MESSAGE LENGTH
ADD S2,S1 ;CALC BLT END ADDRESS
HRL S1,M ;GET THE SOURCE ADDRESS
BLT S1,0(S2) ;COPY THE MESSAGE OVER
MOVX S1,PAGSIZ ;GET LENGTH OF A PAGE
MOVEM S1,G$SAB##+SAB.LN ;SET IT
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
JUMPF I$OMNT ;FAILED,,TRY AGAIN !!!
$RETT ;ELSE RETURN OK
OMNT.1: SKIPN G$NEBF ;[32]REQUEST ORIGINATE REMOTELY?
JRST OMNT.2 ;[32]NO, SEND AN ACK MESSAGE
LOAD S1,.MSTYP(M),MS.TYP ;[32]PICK UP THE MESSAGE TYPE
CAIE S1,.ODDSM ;[32]IS IT A DISMOUNT MESSAGE?
JRST OMNT.2 ;[32]NO, SO SEND AN ACK
$CALL M%GPAG ;[32]PICK UP A MESSAGE PAGE
MOVE S2,[.OHDRS+.ERRSZ,,.NFDAK] ;[30]PICK UP THE HEADER WORD
MOVEM S2,.MSTYP(S1) ;[30]PLACE IN THE MESSAGE
MOVE S2,G$MCOD## ;[30]PICK UP THE ACK CODE
MOVEM S2,.MSCOD(S1) ;[30]PLACE IN THE MESSAGE
MOVX S2,MF.NEB ;[30]PICK UP THE NEBULA BIT
MOVEM S2,.MSFLG(S1) ;[30]PLACE IN THE MESSAGE
MOVX S2,FA%QER ;[30]INDICATE ERROR FROM QUASAR
MOVEM S2,.OFLAG(S1) ;[30]PLACE IN THE MESSAGE
AOS .OARGC(S1) ;[30]INCREMENT THE ARGUMENT COUNT
MOVE S2,[.ERRSZ,,.ERRBK] ;[30]PICK UP ERROR BLOCK HEADER
MOVEM S2,.OHDRS+ARG.HD(S1) ;[30]PLACE IN THE MESSAGE
MOVEI S2,IPCFX4 ;[30]PICK UP THE ERROR CODE
MOVEM S2,.OHDRS+ARG.DA(S1) ;[30]PLACE IN THE MESSAGE
MOVE S2,G$SND## ;[30]PICK UP ORION'S PID
MOVEM S2,G$SAB##+SAB.PD ;[30]PLACE IN THE SAB
MOVEM S1,G$SAB##+SAB.MS ;[30]PLACE MESSAGE ADDRESS IN THE SAB
MOVEI S1,PAGSIZ ;[30]PICK UP THE PAGE SIZE
MOVEM S1,G$SAB##+SAB.LN ;[30]PLACE IN THE SAB
$CALL C$SEND## ;[30]SEND THE MESSAGE
$RETT ;[30]RETURN TO THE CALLER
OMNT.2: $QACK (Mount Request Processor Not Running,,,.MSCOD(M)) ;[32]
$RETT ;[32]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,.SAVE3 ;SAVE P1 & P2 & P3
PUSHJ P,A$WHEEL## ;MAKE SURE THE GUY HAS PRIVS.
JUMPF E$IPE## ;NO,,THE GUY IS A FRAUD
MOVE S1,CHE.IT(M) ;GET THE REQUEST ID
PUSHJ P,D$FVSL## ;LOCATE THE VSL
JUMPF .RETT ;NOT THERE,,FORGET IT
MOVE P3,S1 ;SAVE THE VSL ADDRESS
LOAD P2,.VSCVL(P3),VS.OFF ;GET THE OFFSET TO THE CURRENT VOLUME
ADDI P2,.VSVOL(P3) ;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: 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
;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
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
MOVE S1,P3 ;GET THE VSL ADDRESS
PUSHJ P,D$SETO## ;LITE OWNERSHIP FLAG BITS
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;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
SKIPT ;Did we get an entry successfully?
PUSHJ P,S..CCE## ;Stop if not
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 MOUNTR
;CALL: M/ MAT REQUEST ADDRESS
;
;RET: TRUE IF SENT OK
; FALSE IF MOUNTR NOT RUNNING
INTERN I$MATR ;MAKE IT GLOBAL
I$MATR: PUSHJ P,.SAVE1 ;SAVE P1
MATR.1: MOVX S1,.OTMNT ;WANT MOUNT PROCESSOR
MOVX S2,%GENRC ;WANT GENERIC MOUNT PROCESSOR
PUSHJ P,A$LPSB## ;LOCATE THE MOUNT PROCESSOR PSB
JUMPF E$MPN## ;NOT THERE,,SEND ERROR MSG
MOVE P1,S1 ;Save MOUNTR's PSB adress
PUSHJ P,G$STGS## ;Build ACK and send
MOVE S1,P1 ;Restore MOUNTR's PSB address
MOVE S1,PSBPID(S1) ;GET MOUNTRS PID
MOVEM S1,G$SAB##+SAB.PD ;SAVE AS RECIEVERS PID
PUSHJ P,M%GPAG ;GO GET A PAGE FOR IPCF
MOVEM S1,G$SAB##+SAB.MS ;SAVE THE ADDRESS IN THE SAB
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
MOVE S1,G$PRVS## ;GET PRVS,,JOB NUMBER
STORE S1,.MATCP(P1) ;SAVE IT IN THE MESSAGE
MOVE S1,G$SND## ;GET THE SENDERS PID
STORE S1,.MATPD(P1) ;SAVE IT IN THE MESSAGE
MOVX S1,PAGSIZ ;GET THE LENGTH OF A PAGE
MOVEM S1,G$SAB##+SAB.LN ;SAVE AS THE MESSAGE LENGTH
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
JUMPF MATR.1 ;FAILED,,TRY AGAIN
$RETT ;WIN,,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,.SAVE4 ;SAVE P1, P2, AND P3 AND P4
KMNT.1: MOVX S1,.OTMNT ;WANT MOUNT PROCESSOR
MOVX S2,%GENRC ;WANT GENERIC MOUNT PROCESSOR
PUSHJ P,A$LPSB## ;LOCATE THE MOUNT PROCESSOR PSB
JUMPF E$MPN## ;NOT THERE,,SEND ERROR MSG
MOVE S1,PSBPID(S1) ;GET MOUNTRS PID
MOVEM S1,G$SAB##+SAB.PD ;SAVE AS RECIEVERS PID
LOAD S1,G$PRVS##,MD.PJB ;GET THE USERS JOB NUMBER
PUSHJ P,D$FMDR## ;LOCATE THIS GUYS MDR
JUMPF E$SNY## ;NOTHING THERE !!!
PUSHJ P,M%GPAG ;GO GET A PAGE FOR IPCF
MOVEM S1,G$SAB##+SAB.MS ;SAVE THE ADDRESS IN THE SAB
MOVE P4,S1 ;SAVE IT IN P2
MOVX S1,.QOMTA ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(P4),MS.TYP ;SAVE IT
MOVEI S1,PAGSIZ ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(P4),MS.CNT ;SAVE IT
MOVEM S1,G$SAB##+SAB.LN ;SAVE THE LENGTH IN THE SAB
MOVE S1,.MSCOD(M) ;GET THE USERS ACK CODE
MOVEM S1,.MSCOD(P4) ;SAVE IT IN OUR MSG
MOVE S1,.MSFLG(M) ;GET THE USERS FLAG WORD
MOVEM S1,.MSFLG(P4) ;SAVE IT IN OUR MSG
MOVEI S1,2 ;GET THE BLOCK COUNT
STORE S1,.OARGC(P4) ;SAVE IT
MOVEI P4,.OHDRS(P4) ;POINT TO THE FIRST BLOCK
MOVX S1,.MTPID ;GET THE BLOCK TYPE
STORE S1,ARG.HD(P4),AR.TYP ;SAVE IT
MOVEI S1,2 ;GET THE BLOCK LENGTH
STORE S1,ARG.HD(P4),AR.LEN ;SAVE IT
MOVE S1,G$SND## ;GET THE SENDERS PID
STORE S1,ARG.DA(P4) ;SAVE IT
MOVEI P4,2(P4) ;POINT TO THE NEXT BLOCK
MOVE S1,[1,,.MTITN] ;GET THE ITN BLOCK HEADER
MOVEM S1,ARG.HD(P4) ;SAVE IT
LOAD P1,.MRCNT(AP),MR.CNT ;GET THE VSL COUNT
MOVNS P1 ;NEGATE IT
MOVSS P1 ;MOVE RIGHT TO LEFT
HRRI P1,.MRVSL(AP) ;CREATE VSL SEARCH AC
KMNT.2: MOVE P3,0(P1) ;GET A VSL ADDRESS
MOVE P2,KIL.RQ+.RDBRQ(M) ;GET ANY SPECIFIED REQUEST ID
JUMPE P2,KMNT.3 ;NO REQUEST ID,,SKIP THIS
LOAD S1,.VSRID(P3),VS.RID ;GET THE REQUEST ID IN S2
CAME S1,P2 ;DO WE MATCH ???
JRST KMNT.5 ;NO,,TRY NEXT ENTRY
JRST KMNT.4 ;YES,,WIN !!!
KMNT.3: HRROI S1,.VSVSN(P3) ;POINT TO THE VOL SET NAME
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
XOR S2,KIL.RQ+.RDBJB(M) ;ZERO IDENTICAL BITS
AND S2,KIL.RQ+.RDBJM(M) ;AND IT WITH THE MASK
JUMPN S2,KMNT.5 ;NOT ZERO, WE DONT MATCH, TRY NEXT ENTRY
KMNT.4: LOAD S1,ARG.HD(P4),AR.LEN ;GET THE BLOCK LENGTH
ADD S1,P4 ;CALC ENTRY ADDRESS
LOAD S2,.VSRID(P3),VS.RID ;GET THE REQUEST ID IN S2
MOVEM S2,0(S1) ;INSERT INTO THE MESSAGE
INCR ARG.HD(P4),AR.LEN ;BUMP THE BLOCK LENGTH
KMNT.5: AOBJN P1,KMNT.2 ;CHECK ALL VSL'S
LOAD S1,ARG.HD(P4),AR.LEN ;GET THE ITN COUNT
SOJLE S1,[MOVE S1,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS
PUSHJ P,M%RPAG ;RETURN THE PAGE
PJRST E$SNY## ] ;RETURN AN ERROR TO THE USER
PUSHJ P,C$SEND ;OK,,SEND THE MESSAGE
SETZM G$ACK## ;DONT ACK USERS MSG (LET MOUNTR DO IT)
$RETT ;AND RETURN
SUBTTL FILE ARCHIVING 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
CAIN S1,.OTNOT ;Notification?
JRST [ MOVE S1,G$NOW## ;Get the time of day
AOS S1 ;Make it the future
CAMLE S1,.EQAFT(P1) ;Compare with after time
MOVEM S1,.EQAFT(P1) ;Make after time future time
JRST I$ARC1 ] ;Rejoin
I$ARC1: 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 ???
$QWTO (<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 ^D10 ;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
NTFY.0: SETOM DIRCTY ;RESET THE DIRECTORY NUMBER
SETOM REASON ;RESET THE REASON
SETZB P1,P2 ;ZAP BUFFER ADDRESS AND FLAGS
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
SKIPLE BYTCNT ;ANY ROOM LEFT IN THE BUFFER ???
JRST NTFY.1 ;YES,,GO GET ANOTHER ENTRY
PUSHJ P,NSNDIT ;SEND THIS BUFFER
JRST NTFY.0 ;GET THE NEXT 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%GPAG ;GET A PAGE FOR THE DATA
MOVE P1,S1 ;GET THE PAGE NUMBER IN P1
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
MOVEI S1,<PAGSIZ-200>*5 ;GET BYTE COUNT (SAVE 200 WORDS)
MOVEM S1,BYTCNT ;SAVE IT
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: SOS BYTCNT ;ADJUST BYTE COUNT
IDPB S1,BYTPTR ;OUTPUT THE BYTE
$RETT ;AND RETURN
BYTPTR: BLOCK 1 ;BYTE POINTER FOR NOTIFICATION
BYTCNT: BLOCK 1 ;BYTE COUNT
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
MOVEM P1,G$SAB##+SAB.MS ;SAVE THE MSG ADDRESS IN THE SAB
MOVX S1,SI.FLG+SP.OPR ;SEND THIS TO ORION
MOVEM S1,G$SAB##+SAB.SI ;SAVE IN THE SAB
SETZM G$SAB##+SAB.PD ;ZAP ANY PREVIOUS PID IN THE BLOCK
MOVX S1,PAGSIZ ;A page message
MOVEM S1,G$SAB##+SAB.LN ;Save in the SAB for C%SEND
PUSHJ P,C$SEND## ;SEND IT OFF
$RETT ;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: MOVX S1,^D60 ;GET IGNORE TIME (60 MINUTES)
PUSHJ P,A$AFT## ;GET TIME FOR FIRST CHECKPOINT
MOVEM S1,G$MSG##+.EVUDT ;SAVE IT IN THE ENTRY
MOVEI S1,[SETOM G$NTFY## ;GET INTERRUPT ADDRESS
$RETT ] ;WHICH WILL FLAG THE TIMER REQUEST
MOVEM S1,G$MSG##+.EVRTN ;SAVE IT IN THE ENTRY
MOVX S1,%EVAFT ;GET THE /AFTER ENTRY TYPE
MOVEM S1,G$MSG##+.EVTYP ;SAVE IT IN THE ENTRY
MOVX S1,.EVMSZ ;GET THE ENTRY LENGTH
MOVEI S2,G$MSG## ;AND THE ENTRY ADDRESS
PUSHJ P,S$EVENT## ;ADD IT TO THE EVENT QUEUE
$RETT ;RETURN
END