Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
5-galaxy/qsrt20.mac
There are 36 other files named qsrt20.mac in the archive. Click here to see a list.
;SRC:<5-GALAXY>QSRT20.MAC.15, 22-Sep-86 13:51:49, Edit by KNIGHT
;SRC:<5-GALAXY>QSRT20.MAC.14, 22-Sep-86 10:57:52, Edit by KNIGHT
; Remove previous edit, do it in QSRQUE
;SRC:<5-GALAXY>QSRT20.MAC.13, 15-Sep-86 13:35:00, Edit by KNIGHT
; Route requests from CDP to LPT, and things going to CDP1 get the
;Impress flag added.
;SRC:<5-GALAXY>QSRT20.MAC.12, 22-Jul-86 11:17:47, Edit by KNIGHT
; Flush ill-advised CSM change
;SRC:<5-GALAXY>QSRT20.MAC.11, 21-Jul-86 16:40:49, Edit by KNIGHT
;CMU/CU lintprinter modifictions
;SRC:<5-GALAXY>QSRT20.MAC.10, 17-Jun-86 10:35:24, Edit by KNIGHT
; Account validation flag status determines value of G$ACTV
;SRC:<5-GALAXY>QSRT20.MAC.9, 12-Jun-86 14:17:09, Edit by KNIGHT
; Allow non-username for LPD requests
;SRC:<5-GALAXY>QSRT20.MAC.7, 21-Feb-86 19:55:05, Edit by KNIGHT
; More in the continuing saga. Make it so that unspecified units
; goto zero, make sure we're doing correct calculation on unit number
;SRC:<5-GALAXY>QSRT20.MAC.6, 21-Feb-86 10:50:03, Edit by KNIGHT
;SRC:<5-GALAXY>QSRT20.MAC.5, 18-Feb-86 16:34:49, Edit by KNIGHT
; Fix previous edit. I think.
;SRC:<5-GALAXY>QSRT20.MAC.4, 13-Feb-86 13:42:05, Edit by KNIGHT
; Route all CDP: requests to unit 0
;[SRI-NIC]SRC:<5-GALAXY>QSRT20.MAC.3, 2-Aug-85 14:20:58, Edit by HSS
; Undid last edit and added code to accommodate TSC users
;[SRI-NIC]SRC:<5-GALAXY>QSRT20.MAC.2, 3-Jul-85 15:05:35, Edit by HSS
; Spooled output (lpt or laser) without an explicit device comes out on
; unit 0 for that queue.
TITLE QSRT20 -- Operating System Interface for QUASAR-20
SUBTTL Preliminaries
;
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
; 1975,1976,1977,1978,1979,1980,1981,1982,1983,1984
;
; 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
IFN NICSW,<
SEARCH MACSYM
>;IFN NICSW
PROLOGUE(QSRT20) ;GENERATE THE NECESSARY SYMBOLS
IFE FTJSYS,<
PASS2 ;DON'T BOTHER FOR TOPS-10 ASSEMBLY
END
> ;END OF IFE FTJSYS
T20MAN==:5 ;Maintenance edit number
T20DEV==:11 ;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. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision history . . . . . . . . . . . . . . . . . . . 3
; 4. Module Storage . . . . . . . . . . . . . . . . . . . . 5
; 5. Initialization Routine . . . . . . . . . . . . . . . . 6
; 6. Information. . . . . . . . . . . . . . . . . . . . . . 8
; 7. I$SYSV
; 7.1. Read time-dependent system variables. . . . . 9
; 8. I$CHAC
; 8.1. Routine to Check File Access. . . . . . . . . 10
; 9. I$NINT - ROUTINE TO SETUP FOR NETWORK CHANGE INTERRUPTS 11
; 10. IPCF Interface . . . . . . . . . . . . . . . . . . . . 12
; 11. I$IPS
; 11.1. Send an IPCF Message. . . . . . . . . . . . . 13
; 12. FD Manipulation Routines . . . . . . . . . . . . . . . 14
; 13. I$CSM
; 13.1. Create a Canonical SPOOL Message. . . . . . . 15
; 14. I$CLM
; 14.1. Create a Canonical LOGOUT Message . . . . . . 17
; 15. Routines to handle system dependent fields . . . . . . 18
; 16. I$EQQE - Move fields from EQ to QE . . . . . . . . . 19
; 17. I$QESM - Move fields from the QE to CSM. . . . . . . . 20
; 18. I$SMEQ - ROUTINE TO MOVE FIELDS FROM THE CSM TO EQ . . 21
; 19. I$RMCH
; 19.1. Match a request and an RDB. . . . . . . . . . 22
; 20. I$DFEQ
; 20.1. Default and check the EQ. . . . . . . . . . . 23
; 21. I$LGFD - ROUTINE TO BUILD A LOG FILE FD. . . . . . . . 26
; 22. Spooled CDR file support . . . . . . . . . . . . . . . 28
; 23. I$MUSR - MOVE AN RDB OWNER ID TO AN RDB BLOCK. . . . . 30
; 24. I$ONOD - ROUTINE TO DEFAULT THE BATCH ONOD LIMIT WORD. 30
; 25. I$CACV - ROUTINE TO VALIDATE THE ACCOUNT STRING FOR 'CREATE' 31
; 26. I$SACV - ROUTINE TO VALIDATE ACCT STRINGS FOR 'SCHEDULING' 32
; 27. I$ACTV - A NO-OP ON THE -20. . . . . . . . . . . . . . 32
; 28. I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT DATA INTO MDR 33
; 29. Batch Stream Unique Directory Routines . . . . . . . . 34
; 30. I$UQST
; 30.1. Set Directory for a Stream. . . . . . . . . . 35
; 31. I$UQCL
; 31.1. Clear the directory for a stream. . . . . . . 36
; 32. I$UQCH
; 32.1. Check for directory match . . . . . . . . . . 37
; 33. UNIFST - Find stream's unique entry. . . . . . . . . 38
; 34. Failsoft System Interface. . . . . . . . . . . . . . . 39
; 35. I$WRIT
; 35.1. Write something into master queue file. . . . 40
; 36. I$READ
; 36.1. Read something from master queue file . . . . 41
; 37. I$CRIP
; 37.1. Create an index page in master file . . . . . 42
; 38. I$OQUE
; 38.1. Open master queue files . . . . . . . . . . . 43
; 39. FBREAK
; 39.1. Find a break character. . . . . . . . . . . . 44
; 40. STGWLD
; 40.1. Match a "wild" string . . . . . . . . . . . . 45
; 41. I$MINI - ROUTINE TO INITIALIZE THE TAPE MOUNT PROCESSOR 46
; 42. Dummy tape subroutines (used only on TOPS10) . . . . . 46
; 43. I$MNTR - ROUTINE TO PROCESS USER MOUNT REQUESTS. . . . 47
; 44. I$MTR - ROUTINE TO PROCESS MTCON RELEASE MESSAGES. . . 48
; 45. OPERATOR TAPE/DISK MOUNT MESSAGES. . . . . . . . . . . 49
; 46. TAPE MOUNT CHECKPOINT ROUTINE. . . . . . . . . . . . . 50
; 47. I$MATR - ROUTINE TO SETUP AND PASS MNT ATTRIBUTE MSGS TO MOUNTR 52
; 48. I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS . 53
; 49. FILE ARCHIVING ROUTINES. . . . . . . . . . . . . . . . 54
; 50. ARCHIVE
; 50.1. IPCC Function .IPCSR (41) . . . . . . . . . . 55
; 51. Retrieval Queue Subroutines. . . . . . . . . . . . . . 56
; 52. GETAPE - ROUTINE TO EXTRACT TAPE NBRS FROM A RETREIVAL REQUEST 59
; 53. FILE ARCHIVING NOTIFICATION SCHEDULING ROUTINES. . . . 60
; 54. I$NDEF - ROUTINE TO FILL IN NOTIFICATION DEFAULTS. . . 61
; 55. I$NTFY - ROUTINE TO PERFORM FILE ARCHIVING NOTIFICATION 62
; 56. NSETUP - ROUTINE TO SETUP A PAGE FOR NOTIFICATION. . . 63
; 57. NHEADR - ROUTINE TO SETUP THE DATA HEADER LINE . . . . 64
; 58. NXFILE - ROUTINE TO OUTPUT THE FILE DATA . . . . . . . 64
; 59. NSNDIT - ROUTINE TO SEND THE NOTIFICATION. . . . . . . 65
; 60. NTIMER - ROUTINE TO SET/RESET THE NOTIFICATION TIMER . 66
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.
***** 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.
\ ;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
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
;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
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 !!!
IFE NICSW,<
SETOM G$ACTV## ;ELSE WE'RE ACCOUNT VALIDATING..
>;IFE NICSW
IFN NICSW,<
MOVEM S2,G$ACTV## ;SET THE FLAG CORRECTLY, FER GODSAKES
>;IFN NICSW
;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
IFN NICSW,<
$CALL P%LPIN## ;{G6} Build the printer list
MOVE S1,G$LNAM ;{G6} Get node name
SETZ S2, ;{G6} Get the block for unit 0
$CALL P%FUNI## ;{G6} Ask for it
SKIPT ;{G6} Error ?
$STOP (NDP,No default printer name) ;{G6} Yes, fatal
MOVE S2,PP.NAM(S2) ;{G6} Get the printer name
MOVEM S2,G$LPT## ;{G6} Save it away
>;IFN NICSW
$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
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
; 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 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.
IFE NICSW,<
JUMPE T2,CSM.2A ;NO DEVICE SPECIFIED,,JUST RETURN
LSH T2,-^D12 ;RIGHT JUSTIFY THE DEVICE NUMBER
SUBI T2,'0'
TXO T2,RO.PHY ;TURN ON PHYSICAL BIT
STORE T2,CSM.A+CSM.RO+.ROBAT ;SAVE AS DEVICE ATTRIBUTES
>;IFE NICSW
IFN NICSW,<
LSH T2,-^D12 ;MOVE NUMBER OVER
SKIPE T2 ;SKIP IF NONE SPECIFIED (DEFAULT)
SUBI T2,'0' ;NORMALIZE UNIT NUMBER
CAIE S2,.OTCDP ;3 IF CDP DEVICE
IFSKP.
CAIE T2,1 ;CDP1:?
IFSKP.
MOVE T1,CSM.F1 ;3 GET SPECIAL SPOOLING FLAGS
STORE T1,CSM.A+CSM.FP ;3 SAVE IN CSM
ENDIF.
SETZ T2,
ENDIF.
STORE T2,CSM.A+CSM.RO+.ROBAT ;SAVE AS DEVICE ATTRIBUTES
>;IFN NICSW
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)
;3
IFN NICSW,<
CSM.F1: INSVL.(.FPFIM,FP.FFF)!INSVL.(1,FP.FSP)!FP.DEL!FP.SPL!INSVL.(1,FP.FCY)
>;IFN NICSW
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
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 ???
JRST [SKIPN .RDBES(S1) ;Yes, SEQ number specified?
$RETT ;No SEQ number, have a match
JRST RMCH.0] ;Go and check the SEQ number also
$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?
IFE NICSW,<
$RETF ;YES, NO MATCH
>;IFE NICSW
IFN NICSW,<
ERJMP DFEQ.9 ;IF WHEEL, WIN
>;IFN NICSW
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..
IFN NICSW,<
DFEQ.9:
>;IFN NICSW
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.
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
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/PS:<SPOOL>BATCH-/
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>,<PS:[SPOOL]CDR-^O/S1,RHMASK/.^W/S2/.*^0>)
MOVX S1,GJ%OLD!GJ%IFG!GJ%SHT ;LOAD GTJFN BITS
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
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,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
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
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: MOVE S1,MDRQUE## ;GET THE MDR QUEUE LIST ID
PUSHJ P,L%FIRST ;GET THE FIRST MDR ENTRY
JUMPF .RETT ;NO MORE,,RETURN
MOVE AP,S2 ;SAVE THE MDR ADDRESS IN AP
PUSHJ P,D$DMDR## ;DELETE THE MDR ET AL
JRST I$MINI ;DELETE ALL MOUNT REQUESTS
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
; S1/ The VSL Address
; M/ The Mount Message Address
;
;RET: TRUE RETURN or ERRORS:IMM, MPN, DRN
I$MNTR: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
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
PJRST E$MPN## ] ;AND RETURN AN ERROR
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: $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,.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 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
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
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
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