Trailing-Edge
-
PDP-10 Archives
-
bb-jr93h-bb
-
7,6/ap020/qsrt10.x20
There are 4 other files named qsrt10.x20 in the archive. Click here to see a list.
TITLE QSRT10 -- TOPS10 Operating System Interface for QUASAR
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1985,1986,1987. ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC ;PARAMETER FILE
SEARCH ORNMAC ;ORION PARAMETER FILE.
.DIRECT FLBLST
PROLOGUE(QSRT10) ;GENERATE THE NECESSARY SYMBOLS
QSRVRS==:QSRVRS ;REFERENCE QUASAR'S VERSION
%%.QSR==:%%.QSR ;AND QSRMAC'S
IFE FTUUOS,<
PASS2 ;DONT'T BOTHER FOR A TOPS-20 ASSEMBLY
END
> ;END OF IFE FTUUOS
SEARCH ACTSYM ;GET ACCOUNTING SYMBOLS
;Define a MACRO for FACT file accounting
DEFINE FACT,<IFN FTFACT>
COMMENT \
TOPS10 Interpretation of Fields
1) External Owner ID is a PPN
2) Onwer ID (Internal) is a PPN
\
EXTERN MDADBP ;MDA $TEXT ACTION ROUTINE
EXTERN MDBPTR ;MDA $TEXT BYTE POINTER
EXTERN BELLS
EXTERN DEMOT ;MDA DEMOGRAPHIC ITEXT
SUBTTL Module Storage
PRMDIR: BLOCK 1 ;DIRECTORY FOR PRIME QUEUE
INDPPN: BLOCK 1 ;INDEPENDANT PPN FLAG
UNILST: BLOCK 1 ;LIST NUMBER FOR /UNIQUE LIST
PPNPTR: BLOCK 1 ;BYTE POINTER
FACT< EXP .FACT ;DAEMON FACT FUNCTION
FACTBL: BLOCK 13 > ;WORDS IN MOUNT/DISMOUNT RECORDS
ACTMSG: UGVAL$ ;MESSAGE TYPE (UGVAL$)
ACTACK: 0,,0 ;ACK CODE
ACTPPN: 0,,0 ;PPN
ACTSTR: BLOCK .DCMAX ;GENERAL PURPOSE ARGUMENT BLOCK
IFN FTRQUE,<
REDDIR: BLOCK 1 ;DIRECTORY FOR REDUNDANT QUEUE
> ;END IFN FTRQUE
RENFRB: BLOCK FRB.SZ ;FRB FOR /DISP:REN
RENFD: BLOCK FDXSIZ ;FD FOR RENAME
RENUDT: EXP -1 ;BASE UDT FOR RENAME
;INTERRUPT CONTROL CELLS MUST BE IN THE FOLLOWING ORDER
; THEY ARE REFERENCED BY THE OFFSET FROM THE BASE
INTBLK::BLOCK 0 ;BASE ADDRESS OF INTERRUPT VECTOR
IPCBLK::EXP C$INT## ;PROCESSOR IPCF INTERRUPTS
BLOCK 3 ;PLACES FOR FLAGS,OLD PC, ETC
NETBLK::EXP N$INT## ;PROCESSOR FOR NETWORK INTERRUPTS.
BLOCK 3 ;SPACE FOR INTERRUPT DATA
JOBBLK::EXP I$JINT ;PROCESSOR FOR JOB INTERRUPTS
BLOCK 3 ;SPACE FOR INTERRUPT DATA
KSYBLK::EXP -1 ;PROCESSOR (-1 UNTIL ENABLED)
BLOCK 2 ;INTERRUPT DATA BLOCK
KSYS: BLOCK 1 ;KSYS TIME IN MINUTES FROM MONITOR
DTCBLK::EXP -1 ;PROCESSOR (-1 UNTIL ENABLED)
BLOCK 2 ;INTERRUPT DATA BLOCK
DTCDIF: BLOCK 1 ;DATE/TIME DIFFERENCE IN UDT UNITS
INTEND==.-1 ;END OF INTERRUPT VECTOR
INTERN USR ;THIS ITEXT IS USED FOR QUEUE LISTINGS,
INTERN MNTUSR ;THIS ITEXT IS USED FOR MOUNT QUEUE LISTINGS
INTERN STRUCT ;THIS ITEXT IS USED FOR QUEUE LISTINGS
;AND DEFINES THE STRUCTURE NAME
;AND DEFINES THE OWNER OF THE Q ENTRY.
USR: ITEXT (<^W6L /.QEUSR(AP)/^W/.QEUSR+1(AP)/ ^P/.QEOID(AP)/>)
MNTUSR: ITEXT (<^W6L /.MRNAM(AP)/^W/.MRNAM+1(AP)/ ^P/.MRUSR(AP)/>)
STRUCT: ITEXT (<^W/STRNAM(S1)/>)
DEFINE DEVOBJ,<XLIST
X LPT,.TYLPT,.OTLPT
X CDP,.TYCDP,.OTCDP
X PTP,.TYPTP,.OTPTP
X PLT,.TYPLT,.OTPLT
X LL,.TYLPT,.OTLPT
X LU,.TYLPT,.OTLPT
LIST > ;END DEFINE DEVOBJ
DEFINE X(DV,OBJ,TYP),<
DEV'DV: <SIXBIT /DV/>
> ;END DEFINE X
DEVTAB: DEVOBJ
NDEVS==.-DEVTAB
DEFINE X(DEV,OBJ,TYP),<
XWD TYP,OBJ
> ;END DEFINE X
OBJDEV: DEVOBJ
SUBTTL Initialization Routine
;The nominal number of resources to start with
MINRES==^D10 ;TYPICALLY, A GOOD STARTING # OF RESOURCES
I$INIT::PUSHJ P,I%NOW ;GET THE CURRENT TIME
MOVEM S1,G$NOW## ;AND SAVE IT
MOVX S1,%CNTIC ;GETTAB FOR CLOCK TICKS/SECOND
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,G$TIC## ;AND SAVE IT
MOVEI S1,PRMSTR ;GET PERMANENT STRUCTURE FLAG
MOVEM S1,G$PERM## ;AND SET IT
INIT.0: MOVSI S1,.STSPL ;SET SPOOL FUNCTION CODE
SETUUO S1, ;TURN OFF SPOOLING
JFCL ;WE TRIED
MOVX S1,%LDSPP ;GETTAB TO SPOOLED FILE PROTECTION
PUSHJ P,DOGTAB ;GET IT
LSH S1,-^D27 ;RIGHT-JUSTIFY IT
MOVEM S1,G$SPRT## ;AND STORE AWAY
MOVX S1,%LDQUE ;GETTAB TO SPOOLING DIRECTORY
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,G$SPLD## ;AND STORE IT AWAY
MOVX S1,%LDSYS ;GETTAB FOR "SYS"
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,PRMDIR ;AND SAVE THE DIRECTORY
MOVEM S1,G$SYSD## ;SAVE HERE FOR OTHER FOLKS
SETZM INDPPN ;CLEAR INDEPENDANT PPN FLAG
MOVX S1,%CNSTS ;GETTAB TO READ STATES WORD
PUSHJ P,DOGTAB ;GET IT
TXNE S1,ST%IND ;INDEPENDANT PPNS ?
SETOM INDPPN ;YES
MOVX S1,%CNST2 ;GETTAB TO READ 2ND STATES WORD
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,G$MST2## ;SAVE FOR USE LATER
IFN FTRQUE,<
MOVX S1,%LDQUE ;GETTAB FOR "QUE"
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,REDDIR ;AND SAVE IT
> ;END IFN FTRQUE
MOVX S1,%IPCML ;GETTAB FOR MAX PACKET SIZE
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,G$MPS## ;AND STORE IT
MOVX S1,%CNMMX ;GET SMALLEST LEGAL CORMAX
PUSHJ P,DOGTAB ;FROM THE CONFIG TABLE
ADR2PG S1 ;CONVERT WORDS TO PAGES
MOVEM S1,G$MCOR## ;SAVE FOR THE SCHEDULER
PJOB S1, ;GET JOB NUMBER
$SITEM S1,QJOB ;AND SET THE ITEM
PUSHJ P,I%ION ;ENABLE THE INTERRUPT SYSTEM
PUSHJ P,L%CLST ;CREATE A LIST
MOVEM S1,UNILST ;SAVE THE ADDRESS AWAY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEI S1,<MINRES+1>*AMALEN ;GET THE TYPICAL MINIMUM SPACE
$CALL M%GMEM ;GET THE SPACE
MOVEM S2,AMATRX## ;STUFF THAT IN AS OUR MATRIX
STORE S1,.AMHDR(S2),AM.LEN ;MARK LENGTH IN WORDS
MOVEI S1,MINRES ;AND COUNT IN RH
STORE S1,.AMHDR(S2),AM.MCN ;SAVE HIGHEST AVAILABLE INDEX
MOVX S1,%CNST2 ;GET SECOND MONITOR STATES WORD
PUSHJ P,DOGTAB ;READ IT IN
TXNE S1,ST%ACV ;ACCOUNT VALIDATION ENABLED ???
SETOM G$ACTV## ;YES,,LITE ACCOUNTING FLAG
TXNE S1,ST%MDA ;MDA SUPPORT IN THIS MONITOR ???
SETOM G$MDA## ;YES,,LITE MDA FLAG
SKIPE DEBUGW ;ARE WE DEBUGGING ???
SETZM G$ACTV## ;YES,,NO ACCOUNT VALIDATION !!!
HRROI S1,.GTPPN ;GET OUR PPN
PUSHJ P,DOGTAB ;REQUEST IT
CAME S1,[1,,2] ;ARE WE RUNNING [1,2] ???
SETZM G$MDA## ;NO,,CAN'T RUN WITH MDA ENABLED !!!
SKIPN G$MDA## ;MDA SUPPORT HERE ???
JRST INIT.1 ;NO,,DON'T GET SPECIAL MDA PIDS
;Here to set up special MDA Pids
MOVX S1,SP.MDA ;GET MDA'S SPECIAL PID INDEX
STORE S1,G$PIB##+PB.INT,IP.SPI ;SAVE IT IN THE PIB
MOVX S1,PB.MXS ;GET THE PIB LENGTH
MOVEI S2,G$PIB## ;AND THE PIB ADDRESS
PUSHJ P,C%CPID ;MAKE US SYSTEM[TAPE AVR]
MOVE S1,G$PIB##+PB.PID ;GET THE MDA PID
MOVEM S1,G$MPID## ;AND SAVE IT FOR LATER
MOVX S1,SP.TOL ;GET TAP AVR'S SPECIAL PID INDEX
STORE S1,G$PIB##+PB.INT,IP.SPI ;SAVE IT IN THE PIB
MOVX S1,PB.MXS ;GET THE PIB LENGTH
MOVEI S2,G$PIB## ;AND THE PIB ADDRESS
SKIPN DEBUGW ;IF DEBUGGING,,DONT GET PID
PUSHJ P,C%CPID ;ELSE MAKE US SYSTEM[TAPE AVR]
MOVX S1,SP.DOL ;GET DISK AVR'S SPECIAL PID INDEX
STORE S1,G$PIB##+PB.INT,IP.SPI ;SAVE IT IN THE PIB
MOVX S1,PB.MXS ;GET THE PIB LENGTH
MOVEI S2,G$PIB## ;AND THE PIB ADDRESS
SKIPN DEBUGW ;IF DEBUGGING,,DONT GET PID
PUSHJ P,C%CPID ;ELSE MAKE US SYSTEM[DISK AVR]
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to wait for ORION and ACTDAE and PULSAR to start up
INIT.1: SKIPE G$MDA ;IF MDA SUPPORT THEN..
PUSHJ P,I$SLBR ;..START UP PULSAR
SKIPT
STOPCD (PSF,HALT,,<PULSAR Startup Failed>)
PUSHJ P,I$SORN ;START UP ORION
SKIPT
STOPCD (OSF,HALT,,<ORION Startup Failed>)
MOVEM S1,G$OPR## ;SAVE IT FOR FUTURE REFERENCE
MOVEI S1,ACTCJB ;MUST WAIT FOR ACTDAE BECAUSE
$CALL I%CJOB ;WAIT FOREVER FOR PID TO EMERGE
SKIPT
$WTO (<Could not get Accounting Daemon pid>,<Error: ^E/S1/>,,<$WTFLG(WT.SJI)>)
;Start object processors that are started once at QUASAR startup
$SAVE <T1,T2> ;NEED SOME ACS
MOVX T2,CJ.D60 ;CANT TELL ABOUT DN60 (YET)
MOVE T1,[SIXBIT |LOCAL|] ;GET CROCKY NODE NAME GIVEN
CAME T1,G$LNAM## ;WHEN ANF-10 IS NOT PRESENT
TXO T2,CJ.ANF ;WE HAVE ANF-10
MOVX T1,ST%D36!ST%END ;GET DECNET STATE BITS
TDNE T1,G$MST2## ;LIT IN 2ND STATES WORD?
TXO T2,CJ.DCN ;WE HAVE DECNET
MOVSI S2,-OPDTSZ ;MAKE AOBJN POINTER TO OPDTAB
HRRI S2,OPDTAB
INIT.2: MOVE S1,(S2) ;GET ADDRESS OF DATA
MOVEI S1,OPDCJB(S1) ;GET ADDR OF PROCESSOR'S CJB
LOAD TF,CJB.FL(S1),CJ.QSR ;GET QUASAR'S PRIVATE FIELD
CAXE TF,%ONCE ;PROCESSOR TO START NOW?
AOBJN S2,INIT.2 ;NO, TRY NEXT
JUMPGE S2,INIT.3 ;JUMP IF NO MORE
LOAD TF,CJB.FL(S1),CJ.DEP ;GET DEPENDENCIES BITS
JUMPE TF,INIT2A ;SKIP TEST IF NO DEPENDENCIES
TDNN T2,CJB.FL(S1) ;DO WE HAVE THE REQUIRED STUFF?
JRST INIT2B ;NOPE, TRY NEXT ENTRY
INIT2A: HRLZ TF,S1 ;YES, COPY OBJECT'S CJB TO QUASAR'S
HRRI TF,QSRCJB
BLT TF,QSRCJB+CJB.SZ-1
MOVEI TF,^D60 ;WAIT 1 MINUTE FOR FRCLIN IF NEED BE
STORE TF,QSRCJB+CJB.TP,CJ.TIM ;PLACE SECONDS IN CJB
MOVEI S1,QSRCJB ;GET CJB ADDRESS
PUSH P,S2 ;SAVE AOBJN POINTER
PUSHJ P,I$SXXX ;GO DO THE WORK
JUMPF [POP P,S2 ;GET AOBJN POINTER BACK
JRST INIT2B] ;IF IT DIDN'T WORK, DON'T GET A PSB
SETZB S1,S2
PUSHJ P,GETPSB## ;GET US A PSB
MOVE S2,QSRCJB+CJB.NM ;GET THE PROCESSOR'S NAME
MOVEM S2,PSBNAM(S1) ;SAVE IN PSB
MOVX S2,PS.WAT ;GET "WAITING" STATUS
STORE S2,PSBFLG(S1),PSFSTS ;STORE IN PSB
MOVE S2,S1 ;GET PSB ADDRESS IN S1
$CALL I%NOW ;GET CURRENT TIME
ADD S1,[EXP ^D2*^D60*^D3] ;GIVE IT 2 MINUTES
MOVEM S1,PSBUDT(S2) ;STORE TIME IN PSB
POP P,S2 ;GET AOBJN POINTER BACK
INIT2B: AOBJN S2,INIT.2 ;TRY NEXT TABLE ENTRY
INIT.3: SKIPN G$MDA## ;MDA SUPPORT ???
$RETT ;NO,,RETURN
MOVX S1,%CNSJN ;GET CONFIG TABLE, JOB COUNTS ENTRY
PUSHJ P,DOGTAB ;GET IT
HRRZM S1,G$MAXJ## ;SAVE THE MAX JOB COUNT SUPPORTED
;Create Tape UCB's
PUSHJ P,.SAVE2 ;SAVE P1 AND P2 FOR A MINUTE
PUSHJ P,L%CLST ;CREATE A LIST FOR THE UCB CHAIN
MOVEM S1,UCBQUE## ;SAVE THE ID FOR LATER
MOVX S1,.TYMTA ;GET TYPE CODE FOR MTA'S
MOVEM S1,ACTSTR ;STORE IN THE DVPHY PARM BLOCK
SETZM ACTSTR+1 ;CLEAR DRIVE WORD
INIT.4: MOVE S1,[2,,ACTSTR] ;GET DVPHY. PARMS
DVPHY. S1, ;GET NEXT MTA UNIT
JRST INIT.5 ;NO MAG TAPES,,LOOK FOR DISKS
SKIPN S1,ACTSTR+1 ;GET THE DEVICE NAME
JRST INIT.5 ;NO MORE,,CREATE DISK UCB'S
LDB S2,[POINT 6+6,S1,6+6-1] ;GET LEFT 2 CHARACTERS OF DEVICE NAME
CAIN S2,' ''L' ;IS IT A LABEL DEVICE ???
JRST INIT.4 ;YES,,IGNORE IT
MOVE P1,S1 ;SAVE THE DEVICE NAME
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
MOVX S2,UCBLEN ;GET THE UCB ENTRY LENGTH
PUSHJ P,L%CENT ;CREATE AN ENTRY IN THE UCB CHAIN
MOVEM P1,.UCBNM(S2) ;SAVE THE DEVICE NAME
MOVE S1,S2 ;GET THE DEVICE ADDRESS IN S1
PUSHJ P,I$GATR ;GO SETUP THE DEVICE ATTRIBUTES
JRST INIT.4 ;AND CONTINUE PROCESSING
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Create Disk UCB's
INIT.5: SETZM T1 ;WANT FIRST PHYSICAL DISK UNIT
INIT.6: SYSPHY T1, ;GET FIRST/NEXT PHYSICAL DISK UNIT
STOPCD (CGD,HALT,,<Can't get disk physical unit>)
JUMPE T1,INIT.7 ;NO MORE,,CHECK FOR DECTAPES
MOVE S1,T1 ;GET THE UNIT NAME IN S1
PUSHJ P,D$GUCB## ;FIND THE UCB IN THE UCB CHAIN
JUMPT INIT.6 ;FOUND IT,,SKIP IT !!!
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
MOVX S2,UCBLEN ;AND THE UCB LENGTH
PUSHJ P,L%CENT ;CREATE THE DISK UCB ENTRY
MOVE P2,S2 ;SAVE THE UCB ADDRESS
MOVEM T1,.UCBNM(S2) ;SAVE THE PHYSICAL DEVICE NAME
MOVE S1,S2 ;GET THE DEVICE ADDRESS IN S1
PUSHJ P,I$GATR ;GET THE DEVICE ATTRIBUTES
LOAD S1,.UCBST(P2),UC.AVA ;GET THE AVAILABLE STATUS BITS
JUMPN S1,INIT.6 ;IF SET,,CONTINUE
MOVE S1,UCBQUE## ;NO,,GET UCB QUEUE ID
PUSHJ P,L%DENT ;DELETE THE UCB WE JUST ADDED
JRST INIT.6 ;AND CONTINUE
INIT.7: MOVX S1,.TYDTA ;GET TYPE CODE FOR DECTAPES
MOVEM S1,ACTSTR ;STORE IN THE DVPHY PARM BLOCK
SETZM ACTSTR+1 ;CLEAR DRIVE WORD
INIT.8: MOVE S1,[2,,ACTSTR] ;GET DVPHY. PARMS
DVPHY. S1, ;GET NEXT DTA UNIT
$RETT ;DONE
SKIPN P1,ACTSTR+1 ;GET THE DEVICE NAME
$RETT ;DONE
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
MOVX S2,UCBLEN ;GET THE UCB ENTRY LENGTH
PUSHJ P,L%CENT ;CREATE AN ENTRY IN THE UCB CHAIN
MOVEM P1,.UCBNM(S2) ;SAVE THE DEVICE NAME
MOVE S1,S2 ;GET THE DEVICE ADDRESS IN S1
PUSHJ P,I$GATR ;GO SETUP THE DEVICE ATTRIBUTES
JRST INIT.8 ;AND CONTINUE PROCESSING
SUBTTL CJBs used by QUASAR
;Build CJBs for starting the "always needed" components
ORNCJB::$BUILD (CJB.SZ)
$SET (CJB.NM,,<SIXBIT |ORION|>)
$SET (CJB.TP,CJ.TIM,777777) ;WAIT "FOREVER"
$SET (CJB.TP,CJ.SPI,SP.OPR) ;ORION'S SPECIAL PID INDEX
$EOB
LBRCJB::$BUILD (CJB.SZ)
$SET (CJB.NM,,<SIXBIT |PULSAR|>)
$SET (CJB.TP,CJ.TIM,777777) ;WAIT "FOREVER"
$SET (CJB.TP,CJ.SPI,SP.TLP) ;PULSAR'S SPECIAL PID INDEX
$EOB
CATCJB::$BUILD (CJB.SZ)
$SET (CJB.NM,,<SIXBIT |CATLOG|>)
$SET (CJB.TP,CJ.TIM,777777) ;WAIT "FOREVER"
$SET (CJB.TP,CJ.SPI,SP.CAT) ;CATLOG'S SPECIAL PID INDEX
$EOB
ACTCJB::$BUILD (CJB.SZ)
$SET (CJB.TP,CJ.TIM,777777) ;WAIT "FOREVER"
$SET (CJB.TP,CJ.SPI,SP.ACT) ;ACTDAE'S SPECIAL PID INDEX
$EOB
;Reserve a dummy CJB for use by QUASAR when he needs it
QSRCJB::BLOCK CJB.SZ
SUBTTL I$Sxxx - Start Various Galactic Components
INTERN I$SORN ;ROUTINE TO STARTUP ORION
INTERN I$SLBR ;ROUTINE TO STARTUP PULSAR
INTERN I$SCAT ;ROUTINE TO STARTUP CATLOG
INTERN I$SXXX ;ROUTINE TO STARTUP AN OBJECT PROCESSOR
INTERN I$GOPD ;ROUTINE TO GET OBJECT PROCESSOR DATA
INTERN I$FCJB ;ROUTINE TO FIND A PROCESSOR'S CJB
;Start up ORION
I$SORN::SKIPE DEBUGW ;DEBUGGING?
SETZM ORNCJB+CJB.NM ;YES, JUST WAIT FOR PID
MOVEI S1,ORNCJB ;GET ADDRESS OF ORION'S CJB
PJRST I$SXXX ;GO TO COMMON CODE
;Start up PULSAR
I$SLBR::SKIPE DEBUGW ;DEBUGGING?
SETZM LBRCJB+CJB.NM ;YES, JUST WAIT FOR PID
MOVEI S1,LBRCJB ;GET ADDRESS OF PULSAR'S CJB
PJRST I$SXXX ;HIT COMMON CODE
;Start up CATLOG
I$SCAT::SKIPE DEBUGW ;DEBUGGING?
SETZM CATCJB+CJB.NM ;YES, JUST WAIT FOR PID
MOVEI S1,CATCJB ;GET ADDRESS OF CATLOG'S CJB
; PJRST I$SXXX ;FALL INTO COMMON CODE
;I$SXXX - Common code to call I%CJOB
;
; Call: S1/ address of CJB for I%CJOB
; Return: Propagated from I%CJOB
I$SXXX: $SAVE <T1>
MOVE T1,S1 ;SAVE CJB ADDRESS
$CALL I%CJOB ;STARTUP ORION
$RETIT ;RETURN IF OK
$WTO (<^W/CJB.NM(T1)/ startup failed>,<Error: ^E/S1/>,,<$WTFLG(WT.SJI)>)
$RETF
SUBTTL I$GOPD - Get Object Processor Data
;Define table that contains object types, and a pointer to a CJB
;that contains the other object processor info needed.
DEFINE X (OBJ,PRG,TYP,ATR,DEP,TXT),<
XLIST
...OCT==0
...ACT==0
...TXT==0
IRP OBJ,<...OCT==...OCT+1> ;;COUNT OBJECT TYPES
IRP ATR,<...ACT==...ACT+1> ;;COUNT ATTRIBUTES
IRP TXT,<...TXT==...TXT+1> ;;COUNT TEXT STRINGS
IFG ...TXT - %CJSTC,<PRINTX ?Too many text strings in PRCDAT>
EXP [XWD -...OCT,[ ;;CONSTRUCT AOBJN POINTER
IRP OBJ,< ;;AND TABLE OF OBJECTS TYPES
EXP .OT'OBJ
>
]
XWD -...ACT,[ ;;CONSTRUCT AOBJN POINTER
IRP OBJ,< ;;AND TABLE OF ATTRIBUTES
EXP 'ATR
>
]
$BUILD (CJB.SZ) ;;BUILD THE CJB
$SET (CJB.NM,,<SIXBIT |'PRG|>)
$SET (CJB.FL,CJ.QSR,'TYP)
$SET (CJB.FL,CJ.STC,...TXT)
IRP DEP,<
IFIDN <DEP><ANF10>, <$SET (CJB.FL,CJ.ANF,1)>
IFIDN <DEP><DECNET>,<$SET (CJB.FL,CJ.DCN,1)>
IFIDN <DEP><DN60>, <$SET (CJB.FL,CJ.D60,1)>
>
...CNT==0
IRP TXT,<
$SET (CJB.ST+...CNT,,<[ASCIZ\'TXT\]>)
...CNT==...CNT+1
>
$EOB
]
.XCREF ...OCT,...ACT,...TXT,...CNT
PURGE ...OCT,...ACT,...TXT,...CNT
LIST
>
;PRCDAT defined in QSRMAC
OPDTAB::PRCDAT
OPDTSZ==.-OPDTAB ;SIZE OF TABLE
;Define OPDTAB entry offsets
PHASE 0
OBJPTR: BLOCK 1 ;AOBJN POINTER TO OBJECT TYPES
ATRPTR: BLOCK 1 ;AOBJN POINTER TO ATTRIBUTES
OPDCJB: BLOCK 0 ;START OF CJB
DEPHASE
;This routine returns the address of a CJB which contains the
;information about the object processor.
;
; Call: S1/ object type (.OTxxx)
; S2/ object attribute
;
; Return: TRUE S1/ address of CJB
; FALSE object type not found in table
I$GOPD::PUSHJ P,.SAVE3 ;SAVE P1 - P3
MOVSI P2,-OPDTSZ ;MAKE AOBJN POINTER INTO OPDTAB
HRRI P2,OPDTAB
GOPD.1: MOVE P3,(P2) ;GET ADDRESS OF DATA
MOVE P1,OBJPTR(P3) ;GET AOBJN POINTER OBJECT TYPES
CAME S1,(P1) ;OBJECT TYPE MATCH?
AOBJN P1,.-1 ;NO, CHECK NEXT OBJECT TYPE
JUMPGE P1,GOPD.2 ;IF NO MATCHES, CHECK NEXT TABLE SLOT
MOVE P1,ATRPTR(P3) ;OBJ'S MATCH. GET AOJBN TO ATTRIBS
CAME S2,(P1) ;ATTRIBUTES MATCH?
AOBJN P1,.-1 ;NO, CHECK NEXT ATTRIBUTE
JUMPGE P1,GOPD.2 ;IF NO MATCHES, CHECK NEXT TABLE SLOT
MOVEI S1,OPDCJB(P3) ;OBJECT AND ATTRIB MATCH. GET CJB ADDR
$RETT ;RETURN SUCCESS
GOPD.2: AOBJN P2,GOPD.1 ;POINT TO NEXT TABLE ENTRY
$RETF ;NOT FOUND
SUBTTL I$FCJB - Find an Object Processor's CJB
;I$FCJB - Find an object processor's CJB given it's program name
;
; Call: S1/ SIXBIT program name
;
; Return: TRUE S1/ CJB address
; FALSE CJB not found
I$FCJB::MOVSI S2,-OPDTSZ ;MAKE AOBJN POINTER TO TABLE
HRRI S2,OPDTAB
MOVE TF,S1 ;GET PROCESSOR NAME FROM CALLER
FCJB.1: MOVE S1,(S2) ;GET ADDRESS OF DATA
MOVEI S1,OPDCJB(S1) ;GET ADDRESS OF CJB
CAMN TF,CJB.NM(S1) ;CJB WE WANT?
$RETT ;YES, RETURN CJB ADDRESS
AOBJN S2,FCJB.1 ;NO, KEEP LOOKING
$RETF ;NOT FOUND
SUBTTL I$RENA - Process /DISPOSE:RENAME
; System dependant routine to rename files from user's PPNs into the queue
; PPN[3,3]. Called from QSRSCH (RENDEF) if /DISPOSE:RENAME was specified.
; Call: MOVE M,create message address
; MOVE S1,FP address in create message
; PUSHJ P,I$RENA
;
; TRUE return: file renamed
; FALSE return: rename failed, GLXFIL error code in AC 'S1'
;
; AC usage: All ACs saved except for S1 and S2
;
I$RENA: $SAVE <T1,T2,T3> ;SAVE SOME ACS
MOVEI T1,(S1) ;COPY FP ADDRESS
LOAD T2,.FPLEN(T1),FP.LEN ;GET SIZE OF FP
ADDI T2,(T1) ;POINT TO FD IN QUESTION
RENA.1: AOSN S1,RENUDT ;GET CURRENT RENAME SEED
MOVE S1,G$NOW## ;ADD TO THE CURRENT UDT
MOVEM S1,RENUDT ;SET IT FOR NEXT TIME
MOVEI S2,'Q' ;GET A Q FOR THE FIRST CHARACTER
DPB S2,[POINT 6,RENFD+.FDNAM,5] ;MAKE IT LIKE THE MONITOR DOES
MOVE T3,[POINT 6,RENFD+.FDNAM,5] ;MAKE A BYTE POINTER TO THE NEW NAME
RENA.2: IDIVI S1,^D26 ;DIVIDE BY RADIX 26
ADDI S2,'A' ;MAKE IT SIXBIT
IDPB S2,T3 ;STORE CHARACTER
TLNE T3,770000 ;DONE ?
JRST RENA.2 ;NO - LOOP
MOVSI S1,'SPL' ;GET A GOOD EXTENSION
MOVEM S1,RENFD+.FDEXT ;STASH IT AWAY
MOVE S1,.FDSTR(T2) ;GET DEVICE
MOVEM S1,RENFD+.FDSTR ;FOR DOCUMENTATION PURPOSES
MOVE S1,G$SPLD## ;GET PPN
MOVEM S1,RENFD+.FDPPN ;STORE IT
HRLZI S1,FDMSIZ ;GET SIZE OF MINIMUM FD
MOVEM S1,RENFD+.FDLEN ;STORE IT
MOVE S1,.FDNAM(T2) ;GET ORIGINAL FILE NAME
MOVEM S1,.FPONM(T1) ;REMENBER IT
MOVE S1,.FDEXT(T2) ;GET ORIGINAL EXTENSION
MOVEM S1,.FPOXT(T1) ;REMEMBER IT TOO
MOVEM T2,RENFRB+FRB.SF ;STORE SOURCE FD ADDRESS
MOVEI S1,RENFD ;GET DESTINATION FD
MOVEM S1,RENFRB+FRB.DF ;STORE IT
MOVE S1,.EQOID(M) ;GET USER'S PPN
MOVEM S1,RENFRB+FRB.US ;STORE IN-BEHALF-PPN
MOVEI S1,[EXP 3 ;3 WORD BLOCK
1B17+.FIPRO ;PROTECTION CODE SUB-FUNCTION
EXP G$SPRT##] ;FILE PROTECTION TO SET
MOVEM S1,RENFRB+FRB.AB ;TELL GLXFIL
MOVEI S1,FRB.SZ ;GET LENGTH
MOVEI S2,RENFRB ;POINT TO FRB
$CALL F%REN ;RENAME FILE TO [3,3]
JUMPT RENA.3 ;CHECK FOR ERRORS
CAXN S1,ERFAE$ ;FILE ALREADY EXISTS ?
JRST RENA.1 ;YES - TRY AGAIN
MOVX S1,FP.DEL ;GET DELETE BIT
IORM S1,.FPINF(T1) ;THATS THE BEST WE CAN DO
MOVX S1,FP.REN ;GET THE RENAME BIT
ANDCAM S1,.FPINF(T1) ;AND CLEAR IT
$RETF ;AND RETURN
RENA.3: MOVE S1,RENFD+.FDNAM ;GET FUNNY NAME
MOVEM S1,.FDNAM(T2) ;CHANGE FILE NAME IN EQ
HLLZ S1,RENFD+.FDEXT ;GET NEW EXTENSION
HLLM S1,.FDEXT(T2) ;CHANGE IT TOO
MOVE S1,G$SPLD## ;GET QUEUE PPN
MOVEM S1,.FDPPN(T2) ;CHANGE IT IN THE FD
LOAD S1,.FDLEN(T2),FD.LEN ;GET FD LENGTH
CAILE S1,.FDPAT ;HAVE ANY SFDS ?
SETZM .FDPAT(T2) ;YES - TERMINATE PATH
MOVEI S1,1 ;GET A 1
STORE S1,.FPINF(T1),FP.SPL ;LIGHT THE SPOOLED BIT
STORE S1,.EQSEQ(M),EQ.SPL ;HERE TOO
$RETT ;RETURN
SUBTTL I$JINT - ROUTINE TO PROCESS JOB INTERRUPTS.
I$JINT: $BGINT 1,
$DEBRK
SUBTTL Information
;ENTRY POINTS
INTERN I$RENA ;ROUTINE TO DO RENAME FOR /DISPOSE:RENAME
INTERN I$SYSV ;ROUTINE TO READ TIME-DEPENDENT SYSTEM VARIABLES
INTERN I$CHAC ;CHECK ACCESS
INTERN I$LOGN ;LOGIN MESSAGE PROCESSOR
INTERN I$NINT ;ENABLE FOR NETWORK CHANGE INTERRUPTS
INTERN I$MNTC ;GET MOUNT COUNT FOR A STRUCTURE
INTERN I$GATR ;GET DEVICE ATTRIBUTES AND SAVE IN UCB
INTERN I$ATCH ;ATTACH UNIT MONITOR COMMAND PROCESSOR
INTERN I$DTCH ;DETACH UNIT MONITOR COMMAND PROCESSOR
INTERN I$SLCM ;SEARCH LIST CHANGE MESSAGE (FROM MONITOR)
INTERN I$BMDR ;ROUTINE TO GENERATE AN MDR FOR A BATCH REQUEST
INTERN I$UMDR ;ROUTINE TO UPDATE A USERS ALLOC FOR BATCH
INTERN I$KINT ;ROUTINE TO SET PSI INTERRUPTS ON KSYS
INTERN I$KSYS ;ROUTINE TO CHECKS KSYS DATA FROM MONITOR
INTERN I$SKSM ;ROUTINE TO SEND KSYS MSG TO BATCON
INTERN I$MSTR ;ROUTINE TO HANDLE MONITOR STR MOUNTED MSG
INTERN I$DINT ;ROUTINE TO INIT DATE/TIME 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 TOPS10 these are:
;
; Variable Memory
; -------- ------
;
; Time till KSYS G$KSYS = # --- seconds till KSYS
; = 0 --- no KSYS set
; = -1 --- timesharing is over
; CORMAX G$XCOR
; 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: SKIPGE G$KSYI## ;INTERRUPT OCCUR?
PUSHJ P,I$KSYS ;YES,,PROCESS
SKIPL KSYBLK+.PSVNP ;KSYS INTERRUPTS ENABLED?
JRST [MOVE S1,KSYS ;YES,,GET LAST TIME GIVEN BY MONITOR
JRST SYSV.0] ;DON'T DO GETTAB
MOVX S1,%NSKTM ;GETTAB FOR KSYS
GETTAB S1, ;ASK THE MONITOR
SETZM S1 ;NO,,ASSUME NO SCHEDULED SHUTDOWN
SYSV.0: JUMPL S1,SYSV.2 ;NONE PENDING,,SKIP THIS
SKIPE S1 ;DON'T MULTIPLY IF ZERO
IMULI S1,^D60 ;MONITOR RETURNS MINS, MAKE SECS
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 FOR SCHEDULER
JUMPL S1,.RETT ;TIMESHARING OVER,,RETURN
PUSHJ P,I%NOW ;GET TIME OF DAY
MOVEM S1,G$NOW## ;STORE IT
MOVX S1,%NSCMX ;GETTAB FOR CORMAX
GETTAB S1, ;ASK THE MONITOR
SETZM S1 ;NO CORMAX SET
ADR2PG S1 ;CONVERT WORDS TO PAGES
MOVEM S1,G$XCOR## ;SETUP CORMAX FOR SCHEDULER
SETOM G$LOGN## ;ASSUME BATCH LOGINS ALLOWED
MOVX S1,%CNSTS ;GETTAB ARGS
GETTAB S1, ;GET THE MONITOR'S STATES WORD
SETZ S1, ;SICK MONITOR
TXNE S1,ST%NRL!ST%NLG ;LOGINS ALLOWED?
SETZM G$LOGN## ;NOPE
MOVE S2,G$OPRA## ;SAVE OLD OPR ON DUTY VALUE
SETOM G$OPRA## ;ASSUME OPERATOR ON DUTY
TXNE S1,ST%NOP ;CHECK
SETZM G$OPRA## ;NO OPERATOR ON DUTY
SKIPN S2 ;IF OPR WAS ON DUTY, CHANGE DOESN'T HELP
SKIPN G$OPRA## ;IF NOT BEFORE, BUT IS NOW
CAIA ;(FALSE)
DOSCHD ;SYSTEM-OPR STREAMS MAY BE SCHEDULABLE
$RETT ;RETURN
SUBTTL I$CHAC -- Routine to Check File Access
; Routine to check queue request access
;
; Call: MOVE S1,queue request protection code
; MOVE S2,queue request PPN
; PUSHJ P,I$CHAC
; RETURN HERE ALWAYS
; TRUE RETURN: ACCESS ALLOWED
; FALSE RETURN: ACCESS DENIED
;
I$CHAC: MOVEM S1,CHAC.A ;SAVE CODE AND PROTECTION
PUSHJ P,A$WHEEL## ;CHECK FOR GODLY PRIVS
JUMPT .RETT ;AND RETURN IF USER HAS THEM
XOR S2,G$SID## ;COMPARE THE PPNS
JUMPE S2,.RETT ;OWNER GETS FULL ACCESS
MOVEM S2,CHAC.B ;AND SAVE THE DIFFERENCE
SKIPN INDPPN ;INDPPN SET ?
HRRZS S2 ;NO - CHECK PROGRAMMER NUMBER ONLY
CHAC.1: MOVE S1,[POINT 3,CHAC.A,29] ;SET UP BYTE POINTER
JUMPE S2,CHAC.2 ;IS THIS THE OWNER ?
IBP S1 ;NO - TRY PROJECT
HLRZ S2,CHAC.B ;GET PROJECT NUMBER DIFFERENCE
SKIPE S2 ;IS IT THE SAME PROJECT ?
IBP S1 ;NO - TRY THE REST OF THE WORLD
CHAC.2: LDB S2,S1 ;GET THE PROTECTION CODE
TRZ S2,400 ;400 ONLY ASKS FOR FILDAE HELP
CAIGE S2,.PTWRI ;ALLOW WRITE ACCESS?
$RETT ;YES
$RETF ;OTHERWISE, HE'S A LOSER
CHAC.A: BLOCK 1 ;LOCAL STORAGE
CHAC.B: BLOCK 1 ;LOCAL STORAGE
SUBTTL I$LOGN - LOGIN MESSAGE PROCESSOR
;CALL: M/ The Message Address
;
;RET: True Always
I$LOGN: MOVX S1,LG.BSS ;GET 'BATCH STREAM SET' BIT
TDNN S1,LGN.JB(M) ;IS IT SET ?
JRST LOGN.1 ;NO,,TRY SOMETHING ELSE
LOAD S1,LGN.JB(M),LG.STR ;YES,,GET THE BATCH STREAM NUMBER
MOVEM S1,COMSTA##+OBJ.UN ;SAVE IT
MOVX S1,.OTBAT ;WANT OBJECT TYPE BATCH
MOVEM S1,COMSTA##+OBJ.TY ;SAVE IT
MOVE S1,G$LNBR## ;GET LOCAL NODE NUMBER
MOVEM S1,COMSTA##+OBJ.ND ;SAVE IT
MOVEI S1,COMSTA## ;POINT AT OUR OBJECT BLOCK
PUSHJ P,A$FOBJ## ;FIND THE OBJECT BLOCK
JUMPF .RETT ;NOT THERE,,SOMETHINGS WRONG !!!
SKIPN S1,OBJITN(S1) ;IS A JOB PROCESSING ???
$RETT ;NO,,RETURN
PUSHJ P,Q$SUSE## ;FIND THE REQUEST IN THE USE QUEUE
JUMPF .RETT ;NONE THERE,,JUST RETURN
LOAD P1,LGN.JB(M),LG.JOB ;GET THE USERS JOB NUMBER
STORE P1,.QEJBN(S1),QE.BJN ;SAVE IT IN THE QE
SKIPE G$MDA## ;IS MDA ENABLED ???
SKIPN AP,.QEMDR(S1) ;CHECK AND LOAD THE MDR ADDRESS
$RETT ;NOT THERE,,RETURN
PUSHJ P,D$BMTX## ;LOCATE THE PROCESS 'B' MATRIX
SKIPF ;LOSE,,MAY NOT HAVE ONE !!!
MOVEM P1,.SMJOB(BM) ;RESET THE 'B' MATRIX ID
PUSHJ P,D$CMTX## ;LOCATE THE PROCESS 'C' MATRIX
SKIPF ;LOSE,,MAY NOT HAVE ONE !!!
MOVEM P1,.SMJOB(CM) ;RESET THE 'C' MATRIX ID
STORE P1,.MRJOB(AP),MR.JOB ;CONVERT THIS MDR TO A REAL MDR
MOVE S1,P1 ;GET THE JOB NUMBER BACK
PUSHJ P,I$SSRL ;VERIFY THE SEARCH LIST
JRST LOGN.2 ;MEET AT THE PASS !!!
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
LOGN.1: SKIPN G$MDA## ;IS MDA ENABLED ???
$RETT ;NO,,RETURN NOW
LOAD S1,LGN.JB(M),LG.JOB ;GET THE USERS JOB NUMBER
PUSHJ P,D$FMDR## ;FIND HIS MDR (MOUNT QUEUE)
JUMPF .RETT ;NOT THERE,,JUST RETURN
LOGN.2: DMOVE S1,LGN.US(M) ;GET THE USERS NAME
DMOVEM S1,.MRNAM(AP) ;SAVE IT
$RETT ;RETURN
SUBTTL I$NINT - ROUTINE TO SET QUASAR UP FOR NETWORK INTERRUPTS
I$NINT: MOVX T1,.PCNET ;GET NETWORK INTERRUPT CODE
MOVSI T2,4 ;GET OFFSET TO INTERRUPT VECTOR
SETZM T3 ;CLEAR LAST WORD OF ARG BLOCK
MOVX S1,<PS.FON+PS.FAC+T1> ;GET PISYS. ARGUMENT BLOCK ADDRESS
PISYS. S1, ;ENABLE FOR NETWORK INTERRUPTS
$RETT ;IGNORE ANY ERRORS
$RETT ;RETURN OK
SUBTTL DOGTAB -- Routine to do necessary gettabs
;CALL WITH S1 CONTAINING THE GETTAB TO BE DONE.
DOGTAB: GETTAB S1, ;DO THE GETTAB
STOPCD (NGF,HALT,,<Necessary GETTAB failed>)
$RETT ;AND RETURN
SUBTTL GETTTY -- GET TERMINAL DATA ON A PARTICULAR JOB
;CALL: S1/ The Job Number
;
;RET: S1/ The terminal Designator
; S2/ Located node number,,line number
GETTTY: MOVE S2,S1 ;GET THE JOB NUMBER IN S2
TRMNO. S2, ;GET THE CONTROLLING TTY
JRST GETT.1 ;CAN'T,,RETURN
HRRZ TF,S2 ;GET THE LINE NUMBER
GETLCH TF ;GET THE TTY LINE CHARACTERISTICS
MOVE S1,[ASCII/T/] ;DEFAULT TO A TTY
TXNE TF,GL.ITY ;ARE WE A PTY ???
MOVE S1,[ASCII/P/] ;YES,,SAY SO
TXNE TF,GL.CTY ;ARE WE THE CTY ???
MOVE S1,[ASCII/C/] ;YES,,SAY SO
GTNTN. S2, ;GET THE NODE,,LINE NUMBER
JRST GETT.1 ;CAN'T,,RETURN
$RETT ;RETURN
GETT.1: MOVE S1,[ASCII/D/] ;MAKE US DETAHCED
HRLZ S2,G$LNBR## ;GET HOST NUMBER,,0
$RETT ;RETURN
SUBTTL I$MNTC - Get mount count for a structure
;CALL: S1/ SIXBIT structure name
;
;RET: S1/ Mount count
; S2/ Free blocks
I$MNTC: STKVAR <<BUFR,20>> ;GET SPACE FOR DSKCHR
MOVEI S2,BUFR ;GET THE DSKCHR BUFFER ADDRESS
MOVEM S1,.DCNAM(S2) ;SET THE STR NAME IN THE ARG BLOCK
HRLI S2,.DCSMT+1 ;GET BLOCK LENGTH,,ADDRESS
DSKCHR S2, ;GET THE INFO FROM THE MONITOR
JRST MNTC.1 ;CAN'T, SO RETURN FALSE
MOVEI S1,BUFR ;GET THE BUFFER ADDRESS
MOVE S2,.DCFCT(S1) ;AND GET THE NUMBER OF FREE BLOCKS
MOVE S1,.DCSMT(S1) ;GET THE MOUNT COUNT
$RETT ;RETURN
MNTC.1: SETZB S1,S2 ;CLEAR MOUNT COUNT, # FREE
$RETF
SUBTTL I$GATR - ROUTINE TO GET A DEVICE'S ATTRIBUTES AND SAVE IN UCB
;CALL: S1/ The UCB Address
;
;RET: True Always
I$GATR: PUSHJ P,.SAVE2 ;SAVE P1 AND P2 FOR A MINUTE
MOVE P2,S1 ;SAVE THE UCB ADDRESS
MOVE P1,.UCBNM(P2) ;GET THE UNIT NAME
MOVE S1,P1 ;HERE ALSO
DEVTYP S1, ;GET THE DEVICE TYPE
$RETT ;DEVTYP FAILED,,JUST RETURN
LOAD S1,S1,TY.DEV ;GET THE TYPE CODE IN S1
CAIN S1,.TYDTA ;IS IT A DECTAPE?
JRST GATR.3 ;YES
CAXN S1,.TYMTA ;IS IT A MAG TAPE ???
JRST GATR.1 ;YES,,GO PROCESS IT
CAXN S1,.TYDSK ;IS IT A DISK ???
JRST GATR.0 ;YES - GO PROCESS IT
$RETT ;NON OF THE ABOVE
;Here to update device attributes for disks
GATR.0: $SAVE T1 ;SAVE T1 FOR A SECOND
MOVEM P1,ACTSTR ;SAVE DEVICE NAME IN DSKCHR BUFFER
MOVE S1,[30,,ACTSTR] ;GET DSKCHR PARMS
DSKCHR S1, ;GET DISK CHARACTERISTICS
STOPCD (CDC,HALT,,<Can't get disk characteristics for unit (in T1)>)
MOVE T1,S1 ;SAVE THE DISK STATUS BITS FOR A MINUTE
LOAD S1,ACTSTR+.DCALT ;GET ALTERNATE UNIT NAME
STORE S1,.UCBAU(P2) ;SAVE IT
SETZM S2 ;CLEAR S2
MOVX S1,%DISK ;THIS IS A DISK UCB
STORE S1,S2,UC.DVT ;SO SAVE IT AS THE DEVICE TYPE
LOAD S1,T1,DC.STS ;GET THE DEVICE STATUS BITS
CAXE S1,.DCSTD ;IS THE DEVICE DOWN ???
TXO S2,UC.AVA+UC.AVR ;NO,,LITE AVAILABLE+AVR
LOAD S1,T1,DC.CNT ;GET THE CONTROLLER TYPE
STORE S1,S2,UC.KTP ;SAVE IT
LOAD S1,T1,DC.UNT ;GET THE UNIT TYPE
STORE S1,S2,UC.UTP ;SAVE IT
MOVEM S2,.UCBST(P2) ;SAVE THE DEVICE STATUS WORD
MOVE S1,S2 ;GET THE UCB STATUS BITS
PUSHJ P,D$DNRS## ;GET THE RESOURCE NUMBER
JUMPF GATR.2 ;THAT LOSES,,HMMMMM
STORE S1,.UCBST(P2),UC.RSN ;AND SAVE IT
$RETT ;DONE,,RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to update device attributes for Tapes
GATR.1: $SAVE <T1,T2> ;SAVE T1 AND T2
SETZM S2 ;CLEAR S2
MOVX T1,.TFTRK ;GET 'READ TRACK STATUS' FUNCTION
MOVE T2,P1 ;GET THE DEVICE NAME IN T2
MOVE S1,[2,,T1] ;GET TAPOP. PARAMETERS
TAPOP. S1, ;GET DEVICE TRACK STATUS
STOPCD (CDT,HALT,,<Can't determine tape track status>)
MOVE S1,[EXP %TRK9,%TRK7](S1) ;GET THE TRACK STATUS CODE
STORE S1,S2,UC.TRK ;SAVE THE TRACK STATUS CODE
MOVX T1,.TFPDN ;GET 'READ DENSITIES' FUNCTION
MOVE S1,[2,,T1] ;GET TAPOP. PARAMETERS
TAPOP. S1, ;READ POSSIBLE DENSITIES
STOPCD (CDD,HALT,,<Can't determine tape densities>)
TXNE S1,TF.DN1 ;SUPPORT 200 BPI ???
TXO S2,UC.200 ;YES,,SET IT
TXNE S1,TF.DN2 ;SUPPORT 556 BPI ???
TXO S2,UC.556 ;YES,,SET IT
TXNE S1,TF.DN3 ;SUPPORT 800 BPI ???
TXO S2,UC.800 ;YES,,SET IT
TXNE S1,TF.DN4 ;SUPPORT 1600 BPI ??
TXO S2,UC.1600 ;YES,,SET IT
TXNE S1,TF.DN5 ;SUPPORT 6250 BPI ??
TXO S2,UC.6250 ;YES,,SET IT
MOVX T1,.TFSTS ;GET CODE TO READ DEVICE STATUS
MOVE S1,[2,,T1] ;GET THE TAPOP. PARM BLOCK
TAPOP. S1, ;GET THE DEVICE STATUS BITS
STOPCD (CGS,HALT,,<Can't get status of tape drive (in P1)>)
TXNE S1,TF.OFL ;IS THE DRIVE OFFLINE ???
TXO S2,UC.OFL ;YES,,SET IT
MOVX T1,.TFKTP ;GET 'GET CONTROLLER TYPE' FUNCTION
MOVE S1,[2,,T1] ;GET TAPOP. PARM BLOCK
TAPOP. S1, ;GET THE CONTROLLER TYPE
STOPCD (CGC,HALT,,<Can't get controller type for tape drive (in P1)>)
STORE S1,S2,UC.KTP ;SAVE THE CONTROLLER TYPE
MOVX S1,%TAPE ;GET 'MAG TAPE' UCB TYPE
STORE S1,S2,UC.DVT ;SAVE AS THE DEVICE TYPE
MOVE S1,P1 ;GET DEVICE NAME
PUSHJ P,I$CKAV ;SEE IF ANYONE OWNS IT
SKIPT ;SKIP IF OWNED..
TXO S2,UC.AVA ;[1151]DEFAULT TO 'AVAILABLE'
LOAD S1,.UCBST(P2),UC.AVR ;PRESERVE AVR BIT
STORE S2,.UCBST(P2) ;SAVE THE DEVICE STATUS BITS
STORE S1,.UCBST(P2),UC.AVR ;RESTORE ORIGINAL AVR SETTING
MOVE S1,P1 ;GET THE DEVICE NAME IN S1
TXNE S2,UC.AVA ;ARE WE MAKING IT AVAILABLE?
PUSHJ P,I$MDAS ;MAKE THE DEVICE CONTROLLED BY US
MOVE S1,.UCBST(P2) ;GET THE UCB STATUS BITS
AND S1,[UC.200+UC.556+UC.800+UC.1600+UC.6250] ;SAVE ONLY THESE BITS
LOAD S2,.UCBST(P2),UC.TRK ;GET THE TRACK CODE
PUSHJ P,D$TNRS## ;GET THE RESOURCE NUMBER
JUMPF GATR.2 ;THAT LOSES,,HMMMMM
STORE S1,.UCBST(P2),UC.RSN ;AND SAVE IT
$RETT ;DONE,,RETURN
GATR.2: MOVX S1,UC.AVA ;GET AVR BIT
ANDCAM S1,.UCBST(P2) ;CLEAR THEM (DEVICE IS UNKNOWN)
$RETF ;RETURN
GATR.3: SETZ S2, ;INIT STATUS FLAG WORD
MOVX S1,%DTAP ;GET 'DECTAPE' UCB TYPE
STORE S1,S2,UC.DVT ;SAVE AS THE DEVICE TYPE
; MOVE S1,P1 ;GET DEVICE NAME
; PUSHJ P,I$CKAV ;SEE IF ANYONE OWNS IT
; SKIPT ;SKIP IF OWNED..
TXO S2,UC.AVA ;DEFAULT TO 'AVAILABLE'
MOVEM S2,.UCBST(P2) ;SAVE THE DEVICE STATUS BITS
MOVE S1,P1 ;GET THE DEVICE NAME IN S1
TXNE S2,UC.AVA ;ARE WE MAKING IT AVAILABLE?
PUSHJ P,I$MDAC ;MAKE SURE DVCMDA IS ALWAYS CLEAR
PUSHJ P,D$ONRS## ;GET THE RESOURCE NUMBER
JUMPF GATR.2 ;THAT LOSES,,HMMMMM
STORE S1,.UCBST(P2),UC.RSN ;AND SAVE IT
$RETT ;DONE,,RETURN
SUBTTL I$SDEN - Set density for a magtape drive
; Here on a call from QSRMDA's reassign code to set the density of
; of a drive before we give it away.
; Call: MOVE S1, sixbit unit name
; MOVE S2, density code
; PUSHJ P,I$SDEN
;
I$SDEN::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,[3,,TF] ;SET UP UUO
MOVEI TF,.TFDEN+.TFSET ;FUNCTION CODE TO SET DENSITY
TAPOP. P1, ;SET THE DENSITY
$RETF ;SHOULDN'T FAIL
$RETT ;RETURN
SUBTTL I$GDEN - Get density for a magtape drive
;CALL: MOVE S1,sixbit unit name
; PUSHJ P,I$GDEN
;RET: S2/ Density of drive
;
I$GDEN::PUSHJ P,.SAVE1 ;[1133]SAVE P1
MOVE P1,[3,,TF] ;[1133]SET UP UUO
MOVEI TF,.TFDEN ;[1133]FUNCTION CODE TO READ DENSITY
TAPOP. P1, ;[1133]READ THE DENSITY
$RETF ;[1133]SHOULD NOT FAIL
MOVE S2,P1 ;[1133]RETURN IN S2
$RETT ;[1133]AND RETURN
SUBTTL I$SLBT - Set label type for a magtape drive
; Here on a call from QSRMDA's reassign code to set the label type
; of a drive before we give it away.
; Call: MOVE S1, sixbit unit name
; MOVE S2, label type code
; PUSHJ P,I$SLBT
;
I$SLBT::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,[3,,TF] ;SET UP UUO
MOVEI TF,.TFLBL+.TFSET ;FUNCTION CODE TO SET LABEL TYPE
TAPOP. P1, ;SET THE LABEL TYPE
$RETF ;SHOULDN'T FAIL
$RETT ;RETURN
SUBTTL I$MTAC - Magtape unit accessible message progessing
; Here when we get a message from the monitor telling us there is a
; new magtape unit we ought to know about.
; Call: M/ message address
;
; TRUE return: always
; FALSE return: can't happen
;
I$MTAC::PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,.MTAUN(M) ;GET UNIT FROM MESSAGE
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
$CALL L%FIRST ;GET THE FIRST UCB ENTRY
SKIPA ;SKIP THE FIRST TIME
MTAC.1: $CALL L%NEXT ;GET THE NEXT UCB ENTRY
JUMPF MTAC.2 ;NO MATCHES - THATS OK
CAME P1,.UCBNM(S2) ;A MATCH?
JRST MTAC.1 ;NO - TRY ANOTHER UCB
$RETT ;ALREADY KNOW ABOUT THIS ONE
MTAC.2: MOVE S1,UCBQUE## ;GET UCB QUEUE ID
MOVEI S2,UCBLEN ;GET UCB LENGTH
$CALL L%CENT ;CREATE A NEW UCB FOR THIS UNIT
JUMPF .RETT ;CAN'T - IGNORE THE ERROR
MOVEM P1,.UCBNM(S2) ;SAVE UNIT NAME
MOVE P1,S2 ;COPY UCB ADDRESS
MOVE S1,P1 ;GET UCB ADDRESS
PUSHJ P,I$GATR ;SETUP THE UNITS ATTRIBUTES
MOVE S1,P1 ;GET UCB ADDRESS
PUSHJ P,D$INCA## ;INCRIMENT THE 'A' MATRIX
$WTO (<Device ^W/.MTAUN(M)/ accessible>,,,<$WTFLG(WT.SJI)>)
MOVE S1,.MTAUN(M) ;GET THE UNIT NAME
$RETT ;RETURN
SUBTTL I$MSTR - PROCESS MONITOR STRUCTURE MOUNTED MSG
;This routine extracts each unit from the .IPCST message and kicks
;PULSAR to recognize labels on the device. If the UCB for the unit
;doesn't exist, one is created. The UC.FRC bit is lit in the UCB
;indicating that the volume(s) is/are being mounted by someone other
;than PULSAR.
;CALL: M/ The message address
;RET: True always
I$MSTR: PUSHJ P,.SAVE3 ;[1217] SAVE P1-P3
HLRZ P2,.IPCS0(M) ;[1217] GET LENGTH OF MSG
CAIGE P2,3 ;[1217] MUST CONTAIN AT LEAST STR AND UNIT
$RETT ;[1217] IGNORE IF TOO SHORT
MOVNI P2,-2(P2) ;[1217] BUILD AOBJN
HRLI P2,.IPCS2(M) ;[1217] PTR TO PICK UP
MOVSS P2 ;[1217] UNITS IN MESSAGE
MSTR.1: SKIPN P1,(P2) ;[1217] GET SIXBIT UNIT NAME
STOPCD (MUN,HALT,,<Missing unit name in .IPCST message>) ;[1217] SO THERE!
MOVE S1,P1 ;[1217] GET UNIT NAME IN S1
PUSHJ P,D$GUCB## ;[1217] GO SEE IF UCB EXISTS
JUMPT MSTR.3 ;[1217] UCB EXISTS, GO KICK PULSAR
MOVE S1,UCBQUE## ;[1217] NO UCB, CREATE ONE
MOVX S2,UCBLEN ;[1217] FOR THIS UNIT.
PUSHJ P,L%CENT ;[1217]
MOVE S1,S2 ;[1217] GET THE ADDRESS OF UCB
MOVE P3,S1 ;[1217] SAVE ACROSS NEXT CALL
MOVEM P1,.UCBNM(S1) ;[1217] STORE UNIT NAME IN UCB
PUSHJ P,I$GATR ;[1217] GO FILL IN SPECIFICS
MOVE S1,P3 ;[1217] GET UCB ADDRESS BACK
PUSHJ P,D$INCA## ;[1217] UPDATE 'A' MATRIX
MOVE S1,P3 ;[1217] GET UCB ADDRESS AGAIN
MSTR.3: MOVX S2,UC.AVR!UC.AVA ;[1217] THIS DEVICE IS AVAILABLE AND
IORM S2,.UCBS0(S1) ;[1217] WE'RE GOING TO READ LABELS!
MOVX S2,U1.FRC ;[1217] GET 'FORCED MOUNT' BIT
IORM S2,.UCBS1(S1) ;[1217] LITE IN SECOND UCB STATUS WORD
MOVE S1,P1 ;[1217] GET SIXBIT UNIT NAME AGAIN
PUSHJ P,D$SREC## ;[1217] SEND RECOGNIZE MSG TO PULSAR
AOBJN P2,MSTR.1 ;[1217] LOOP FOR ALL UNITS IN MSG
$RETT ;[1217] RETURN AND WAIT FOR PULSAR ACK
SUBTTL I$ATCH/I$DTCH - ATTACH/DEATCH MESSAGE PROCESSING ROUTINES
;CALL: M/ The Message Address
;
;RET: True Always
I$ATCH: TDZA TF,TF ;INDICATE ATTACH ENTRY
I$DTCH: SETOM TF ;INDICATE DETACH ENTRY
PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,TF ;SAVE THE ENTRY POINT
MOVSI P2,-3 ;WANT 3 WORDS
HRRI P2,.ATTUN(M) ;POINT TO THE FIRST UNIT
DTCH.0: MOVE S1,0(P2) ;GET A UNIT
PUSHJ P,DTCH.X ;GET ITS UCB
SKIPT ;FOUND,,CONTINUE
AOBJN P2,DTCH.0 ;NOT THERE,,TRY ANOTHER
JUMPL P2,DTCH.1 ;GO IF FOUND A MATCH
JUMPN P1,.RETT ;NONE FOUND, IF DETACH THEN RETURN
MOVE S1,UCBQUE## ;IF ATTACH,,THEN GET UCB QUEUE ID
MOVX S2,UCBLEN ; AND GET A UCB LENGTH
PUSHJ P,L%CENT ;CREATE A NEW UCB FOR THIS UNIT
MOVE S1,.ATTUN(M) ;GET THE NEW UNIT NAME
MOVEM S1,.UCBNM(S2) ;SAVE IT
MOVE S1,S2 ;GET THE ADDRESS IN S1
DTCH.1: MOVE P2,S1 ;SAVE THE UCB ADDRESS
MOVEI S1,[ASCIZ/Attached/] ;DEFAULT TO ATTACH
SKIPE P1 ;UNLESS THIS IS DEATCH
MOVEI S1,[ASCIZ/Detached/] ; THEN MAKE IT DEATCHED
$WTO (<Device ^W/.ATTUN(M)/ ^T/0(S1)/>,,,<$WTFLG(WT.SJI)>)
JUMPE P1,ATCH.2 ;IF ATTCH,,SKIP DETACH CODE
; .DETACH xxx processing routine
SKIPN S1,.ATTPR(M) ;NEW PRIME UNIT?
JRST DTCH.2 ;NO, DETACHED ONLY PORT, DESTROY UCB
SETZ S2, ;GET A ZERO
EXCH S2,.UCBAU(P2) ;NO ALTERNATE NOW
CAMN S1,S2 ;IS NEW PRIME OLD ALTERNATE?
MOVEM S1,.UCBNM(P2) ;YES, RESET THE NAME IN THE UCB
$RETT ;DONE
DTCH.2: MOVE S1,P2 ;GET THE UCB ADDRESS IN S1
PUSHJ P,D$DECA## ;DECRIMENT THE 'A' MATRIX
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
MOVE S2,P2 ;GET THE UCB ADDRESS
PUSHJ P,L%APOS ;POSITION TO THIS ENTRY
PUSHJ P,L%DENT ; AND DELETE IT
PUSHJ P,D$DLOK## ;TAKE A RUN THROUGH THE DEADLOCK CHECK
JUMPT .RETT ;OK,,WHEW !!!
$WTO (<Warning: ^T/BELLS/System Deadlock Detected>,<Reason: Unit ^W/.ATTUN(M)/ was Detached>,,<$WTFLG(WT.SJI)>)
$RETT ;RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
; .ATTACH xxxx processing routine
ATCH.2: LOAD S1,.UCBST(P2),UC.AVA ;GET THE AVAILABLE BIT
JUMPN S1,ATCH.3 ;IF SET,,DON'T ALTER AVAILABLE COUNT
MOVE S1,P2 ;GET THE UCB ADDRESS
PUSHJ P,I$GATR ;SETUP THE UNITS ATTRIBUTES
MOVE S1,P2 ;GET THE UCB ADDRESS IN S1
PUSHJ P,D$INCA## ;INCRIMENT THE 'A' MATRIX
ATCH.3: MOVE S1,.ATTPR(M) ;GET THE NEW PRIMARY PORT
MOVEM S1,.UCBNM(P2) ;SAVE IT
MOVE S2,.ATTSC(M) ;GET THE SECONDARY PORT
MOVEM S2,.UCBAU(P2) ;SAVE IT
MOVE TF,[.DUCLM,,S1] ;GET DISK. ARG PARMS
DISK. TF, ;CLEAR MDA WAIT FOR PRIMARY PORT
JFCL ;IGNORE ANY ERROR
MOVE TF,[.DUCLM,,S2] ;GET DISK. ARG PARMS
DISK. TF, ;CLEAR MDA WAIT FOR SECONDARY PORT
JFCL ;IGNORE ANY ERROR
JUMPN P1,.RETT ;IF 'DETACH',,THEN JUST RETURN
SKIPE .UCBVL(P2) ;UNIT PART OF A MOUNTED STRUCTURE?
$RETT ;YES--JUST RECOGNIZE IS REDUNDANT
MOVE S1,.ATTUN(M) ;GET UNIT THAT WAS ATTACHED
PJRST D$SREC## ;RECOGNIZE IT
;Locate the attached/detached units UCB
DTCH.X: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
SKIPN P1,S1 ;SAVE THE UNIT WE WRE LOOKING FOR
$RETF ;UNIT IS 0,,RETURN NOW
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST UCB ENTRY
SKIPA ;SKIP THE FIRST TIME
DTCH.Y: PUSHJ P,L%NEXT ;GET THE NEXT UCB ENTRY
JUMPF .RETF ;NO MORE,,RETURN
CAME P1,.UCBNM(S2) ;DO WE MATCH PRIMARY PORTS ???
CAMN P1,.UCBAU(S2) ; OR SECONDARY PORTS ???
SKIPA ;FOUND,,CONTINUE
JRST DTCH.Y ;NO,,TRY NEXT UCB
MOVE S1,S2 ;GET THE UCB ADDRESS IN S1
$RETT ;AND RETURN
SUBTTL I$SLCM - PROCESS MONITOR SEARCH LIST CHANGE MESSAGES
;CALL: M/ The Message Address
;
;RET: True Always
I$SLCM: PUSHJ P,.SAVE3 ;[1155]SAVE P1 - P3 FOR A MINUTE
$SAVE <M> ;[1155]SAVE M ALSO
MOVE S1,1(M) ;[1155]GET THE JOBS JOB NUMBER
PUSHJ P,D$FMDR## ;[1155]LOCATE ITS MDR
JUMPT SLCM.0 ;[1155]FOUND,,CONTINUE
HRL S1,1(M) ;[1155]GET THE JOB NUMBER BACK
HRRI S1,.GTOBI ;[1172] GET BATCH/WTOR WORD
GETTAB S1, ;READ JOBS LIMITS
$RETT ;FAILED,,RETURN
TXNE S1,OB.BSS ;[1172] IS THIS A BATCON BATCH JOB?
$RETT ;[1172] YES,,LEAVE
SETZM AP ;[1155]NO MDR YET !!!
SLCM.0: PUSHJ P,REMSTR ;[1155]GET RID OF DELETED STRUCTURES
LOAD P2,.MSTYP(M),MS.CNT ;[1155]GET THE MONITOR MESSAGE LENGTH
SUBI P2,2 ;[1155]DELETE HEADER AND JOB NBR LENGTHS
JUMPLE P2,.RETT ;[1155]STRUCTURE COUNT ZERO, RETURN
PUSHJ P,M%GPAG ;GET A PAGE FOR DUMMY MESSAGE
MOVE P1,S1 ;SAVE ITS ADDRESS
MOVEM P1,ACTSTR ;HERE ALSO (MORE PERMENANT)
MOVX S1,.MMHSZ ;GET THE MESSAGE HEADER LENGTH
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IT
MOVEI P3,.MMHSZ(P1) ;POINT TO BLOCK AREA
MOVEI T2,1(M) ;SKIP OVER THE MSG HEADER
SLCM.1: AOS T2 ;POINT TO THE NEXT STRUCTURE NAME
MOVE S1,0(T2) ;GET A STRUCTURE NAME
PUSHJ P,D$FNDV## ;GO FIND IT
JUMPF SLCM.2 ;NOT THERE,,TRY NEXT
LOAD S1,.VLFLG(S1),VL.STA ;GET THE VOLUME STATUS
CAXE S1,%STAMN ;IF MOUNTED,,CONTINUE
JRST SLCM.2 ;SHOULD NOT HAPPEN
AOS .MMARC(P1) ;BUMP ENTRY COUNT BY 1
AOS .MECNT(P3) ;BUMP VOLUME SET COUNT BY 1
MOVE T1,[.MEHSZ+ARG.DA+1,,.MNTST] ;GET THE ENTRY BLOCK HEADER
MOVEM T1,.MEHDR(P3) ;SAVE IT
MOVE T1,[2,,.TMSET] ;GET THE VOL SET NAME BLOCK HEADER
MOVEM T1,.MEHSZ+ARG.HD(P3) ;SAVE IT
$TEXT (<-1,,.MEHSZ+ARG.DA(P3)>,<^W/0(T2)/^0>)
MOVSI T1,.MEHSZ+ARG.DA+1 ;GET THE ENTRY LENGTH
ADDM T1,0(P1) ;ADD IT TO THE TOTAL MSG LENGTH
MOVEI P3,.MEHSZ+ARG.DA+1(P3) ;POINT TO THE NEXT MSG ENTRY
SLCM.2: SOJG P2,SLCM.1 ;CONTINUE FOR ALL STRUCTURES
SKIPN .MMARC(P1) ;ANY STRUCTURES PROCESSED ???
JRST SLCM.6 ;NO,,SKIP THIS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
HRL S1,1(M) ;GET THE USERS JOB NUMBER
HRRI S1,.GTNM1 ;GET FIRST 6 CHARS OF HIS NAME
GETTAB S1, ;ASK MONITOR
JRST SLCM.6 ;NO GOOD,,MUST HAVE LOGGED OUT
MOVEM S1,.MMUSR(P1) ;SAVE IT
HRL S1,1(M) ;GET THE USERS JOB NUMBER
HRRI S1,.GTNM2 ;GET SECOND 6 CHARS OF HIS NAME
GETTAB S1, ;ASK MONITOR
JRST SLCM.6 ;NO GOOD,,MUST HAVE LOGGED OUT
MOVEM S1,.MMUSR+1(P1) ;SAVE IT
HRL S1,1(M) ;GET THE USERS JOB NUMBER
HRRI S1,.GTPPN ;GET THE USERS PPN
GETTAB S1, ;ASK MONITOR
JRST SLCM.6 ;NO GOOD,,MUST HAVE LOGGED OUT
MOVEM S1,G$SID## ;SAVE IT
SETOM G$SND## ;INVALID SENDERS PID
SETZM G$ACK## ;NO ACK HERE !!!
MOVE S1,1(M) ;GET THE USERS JOB NUMBER
STORE S1,G$PRVS##,MR.JOB ;SAVE IT
MOVE M,P1 ;GET THE MSG ADDRESS IN 'M'
PUSHJ P,D$CMDR## ;CREATE/MODIFY THE USERS MDR
JUMPF SLCM.6 ;NO GOOD,,JUST LEAVE !!!
;Create won, so check users allocation and make sure its ok
MOVE P1,S1 ;SAVE THE VSL ADDRESS (FROM D$CMDR)
PUSHJ P,D$ALOC## ;TRY TO PERFORM ALLOCATION
JUMPF SLCM.7 ;CAN'T,,USERS IN DEEP TROUBLE !!!
;Allocation won, so make sure there is no Deadlock possible
MOVE S1,P1 ;GET THE VSL ADDRESS BACK
PUSHJ P,D$DLCK## ;PERFORM DEADLOCK CHECK
JUMPF SLCM.7 ;UH OH,,TOOO BAD !!!
;OK, Loop through all users VSL's and Mount those structures we added
LOAD T1,.VSLNK(P1),VS.LNK ;GET THE VSL LINK CODE
LOAD P2,.MRCNT(AP),MR.CNT ;GET THE VSL COUNT
MOVNS P2 ;NEGATE IT
MOVSS P2 ;MOVE RIGHT TO LEFT
HRRI P2,.MRVSL(AP) ;POINT TO THE USERS VSL LIST
SLCM.3: MOVE S1,0(P2) ;GET A VSL ADDRESS
LOAD S2,.VSLNK(S1),VS.LNK ;GET ITS LINK CODE
CAMN S2,T1 ;DO THEY MATCH ???
PUSHJ P,D$SETO## ;YES,,SET UP OWNERSHIP !!!
AOBJN P2,SLCM.3 ;CONTINUE THROUGH ALL VSL'S
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SLCM.6: MOVE S1,ACTSTR ;GET THE MESSAGE ADDRESS
PJRST M%RPAG ;RETURN THROUGH MEMORY MANAGER
SLCM.7: PUSHJ P,MDASBP## ;SET UP FOR CALLS TO MDADBP
$TEXT (MDADBP,<Deadlock Detected^M^J Structure(s) ^A>)
LOAD T1,.VSLNK(P1),VS.LNK ;GET THE VOLUME SET LINK CODE
LOAD P1,.MRCNT(AP),MR.CNT ;GET THE VSL REQUEST COUNT
MOVEI T2,.MRVSL(AP) ;POINT TO THE VSL LIST
SLCM.8: MOVE S1,0(T2) ;GET A VSL ADDRESS
LOAD S2,.VSLNK(S1),VS.LNK ;GET ITS LINK CODE
CAMN S2,T1 ;DO THEY MATCH ???
SKIPE .VSUCB(S1) ;YES,,IS IT MOUNTED ???
JRST SLCM.9 ;NO MATCH OR MOUNTED,,TRY NEXT VSL
$TEXT (MDADBP,<^T5/.VSVSN(S1)/^A>)
MOVE S2,.VSVOL(S1) ;POINT TO THE VOL BLOCK
PUSH P,S1 ;SAVE THE VSL ADDRESS
PUSHJ P,D$DSLM## ;DELETE THE STR FROM THE USER (HEE HEE)
POP P,S1 ;RESTORE THE VSL ADDRESS
PUSHJ P,D$DVSL## ;DELETE THE VSL !!!
SKIPA ;SKIP OVER VSL POINTER UPDATE
SLCM.9: AOS T2 ;POINT TO THE NEXT VSL ADDRESS
SOJG P1,SLCM.8 ;CONTINUE FOR ALL VSL'S
$TEXT (MDADBP,<Removed From Search List^0>)
PUSH P,.MRFLG(AP) ;SAVE THE USERS FLAG WORD
SETZB S1,.MRFLG(AP) ;[1173] MAKE SURE MDR ACK FLAGS LOOK VALID
MOVX S1,MR.NOT ;GET THE NOTIFY BIT
IORM S1,.MRFLG(AP) ;LITE THE NOTIFY FLAG
SETOM ERRACK## ;THIS IS AN ERROR !!!
SETOM S2 ;[1173] USE MDR ACK FLAGS!
PUSHJ P,D$USRN## ;NOTIFY THE USER
POP P,.MRFLG(AP) ;RESTORE THE USERS FLAGS
LOAD S1,.MRCNT(AP),MR.CNT ;GET THE VSL REQUEST COUNT
SKIPN S1 ;SKIP IF NOT 0
PUSHJ P,D$DMDR## ;ELSE DELETE THE MDR
MOVE S1,ACTSTR ;GET THE MESSAGE ADDRESS
PJRST M%RPAG ;RETURN THROUGH MEMORY MANAGER
SUBTTL REMSTR - ROUTINE TO VALIDATE THE SEARCH LIST CHANGE MESSAGE
;CALL: AP/ The MDR Address
; M/ The Search list change message
;
;RET: True always
REMSTR: JUMPE AP,.RETT ;NO MDR,,RETURN
PUSHJ P,.SAVE3 ;SAVE P1 AND P2 AND P3
LOAD P1,.MSTYP(M),MS.CNT ;GET THE MONITOR MESSAGE LENGTH
SUBI P1,2 ;DELETE HEADER AND JOB NBR LENGTHS
LOAD P2,.MRCNT(AP),MR.CNT ;GET THE VSL COUNT
MOVNS P2 ;NEGATE IT
MOVSS P2 ;MOVE RIGHT TO LEFT
HRRI P2,.MRVSL(AP) ;POINT TO THE USERS VSL LIST
PUSH P,[-1] ;CREATE A QUEUE FOR VSL ADDRESSES
REMS.1: MOVE S1,0(P2) ;GET A VSL ADDRESS
LOAD S2,.VSFLG(S1),VS.TYP ;GET THE TYPE
MOVX TF,VS.CTL ;GET 'INITIAL PROC ALLOC' FLAG BIT
TDNN TF,.VSFLG(S1) ;PART OF INITIAL PSEUDO PROC ALLOC ??
CAXE S2,%DISK ; OR IS IT A STRUCTURE ???
JRST REMS.2 ;INITIAL ALLOC OR NOT A STR,,GET NEXT VSL
PUSHJ P,D$FOWN## ;DOES HE HAVE IT MOUNTED ???
JUMPF REMS.2 ;NO,,GET NEXT VSL
MOVX S2,VL.ASK ;GET THE 'ASK' BIT
TDNE S2,0(S1) ;DOES HE REALLY HAVE IT MOUNTED ???
JRST REMS.2 ;NO,,GET NEXT VSL
MOVE S1,0(P2) ;GET THE VSL ADDRESS BACK
MOVE S1,.VSVOL(S1) ;GET THE PRIMARY VOL BLK ADDRESS
MOVE S1,.VLNAM(S1) ;GET THE STRUCTURE NAME IN SIXBIT
MOVEI P3,2(M) ;[1160]POINT TO THE SEARCH LIST
MOVE S2,P1 ;[1160]GET THE STRUCTURE COUNT IN S2
REM.1A: JUMPLE S2,REM.1B ;[1160]ANY MORE ????
CAMN S1,0(P3) ;[1160]FIND THE USERS STRUCTURE
JRST REMS.2 ;[1160]IF FOUND,,THEN ALLS OK
AOS P3 ;[1160]POINT TO THE NEXT STRUCTURE
SOS S2 ;[1160]DECREMENT THE STRUCTURE COUNT
JRST REM.1A ;[1160]AND LOOP
REM.1B: PUSH P,0(P2) ;NOT THERE,,HE MUST HAVE DELETED IT
;SO QUEUE UP THE VSL AND CONTINUE
;CHECKING
REMS.2: AOBJN P2,REMS.1 ;CHECK ALL VOLUME SETS
REMS.3: POP P,S1 ;DE-QUEUE A VSL ADDRESS
CAMN S1,[-1] ;[1153]DONE ???
JRST REMS.4 ;[1153]YES!!!
PUSH P,S1 ;[1153]SAVE VSL FOR A MINUTE
PUSHJ P,D$DVSL## ;[1153]NO,,DELETE THE VSL
POP P,S1 ;[1153]RESTORE VSL POINTER
MOVE S1,.VSVOL(S1) ;[1153]GET THE PRIMARY VOL BLK ADDRESS
PUSHJ P,D$CCHK## ;[1153]HANDLE LOCKED STRUCTURES
JRST REMS.3 ;[1153]CONTINUE TILL DONE
REMS.4: LOAD S1,.MRCNT(AP),MR.CNT ;[1153]FINISHED,,GET THE REQUEST COUNT
SKIPN S1 ;NO MORE REQUESTS ???
PUSHJ P,D$DMDR## ; THEN DELETE THE MDR
$RETT ;RETURN
SUBTTL I$SSRL - ROUTINE TO BUILD A SEARCH LIST CHANGE MSG FOR A JOB
;CALL: S1/ THE JOB NUMBER
;
;RET: TRUE ALWAYS
INTERN I$SSRL ;MAKE IT GLOBAL
I$SSRL: $SAVE M ;SAVE 'M' FOR A SECOND
PUSHJ P,.SAVE4 ;SAVE P1 - P4
MOVE P4,[IOWD ^D50,SSLMSG] ;ALLOCATE SPACE FOR THE MSG
PUSH P4,[2,,0] ;PUT IN HEADER
PUSH P4,S1 ;AND JOB NUMBER
MOVEI M,SSLMSG ;POINT 'M' AT THE MSG
MOVE P1,S1 ;SETUP GOBSTR PARM (JOB #)
HRL P2,P1 ;GET JOB # IN LEFT HALF
HRRI P2,.GTPPN ;GET GETTAB PARM
GETTAB P2, ;SETUP GOBSTR PARM (PPN)
$RETT ;CAN'T,,RETURN
SETOM P3 ;FIRST STR IN SEARCH LIST
SSRL.1: MOVE S1,[3,,P1] ;GET GOBSTR PARM LIST
GOBSTR S1, ;GET A STRUCTURE
$RETT ;RETURN ON AN ERROR
JUMPE P3,SSRL.1 ;SKIP FENCE
CAMN P3,[-1] ;END OF LIST ???
PJRST I$SLCM ;YES,,GO PROCESS IT
PUSH P4,P3 ;ADD THE STR TO THE MSG
INCR SSLMSG,LHMASK ;BUMP MSG LENGTH
JRST SSRL.1 ;AND CONTINUE
SSLMSG: BLOCK ^D50 ;SPACE TO BUILD S/L CHANGE MESSAGE
SUBTTL I$BMDR - ROUTINE TO GENERATE AN MDR FOR A BATCH REQUEST
;CALL: M/ The Create Message Address
; S1/ The .QE Address
;
;RET: True Always
I$BMDR: LOAD S2,.EQROB+.ROBTY(M) ;GET THE OBJECT TYPE
SKIPE G$MDA## ;WE MUST BE RUNNING WITH MDA ENABLED
CAXE S2,.OTBAT ; AND THIS MUST BE A BATCH REQUEST
$RETT ;NO,,RETURN NOW
PUSHJ P,.SAVE4 ;SAVE P1 - P4
$SAVE <M,AP,BM,CM,G$ACK##,G$PRVS##> ;SAVE LOTS OF VARIABLES !!!
MOVE P1,M ;SAVE THE MESSAGE ADDRESS
MOVE P4,S1 ;SAVE THE QE ADDREESS
MOVE S1,.EQROB+.ROBND(M) ;GET THE DESTINATION NODE NAME
PUSHJ P,N$LOCL## ;CHECK FOR THE HOST SITE
MOVX S1,QE.WAL ;GET WAITING FOR ALLOCATION STATUS
SETZM S2 ;ZAP ATTRIBUTES
SKIPF ;IF DESTINED FOR THE HOST SYSTEM,,THEN
LOAD S2,.EQROB+.ROBAT(M),RO.ATR ;GET REQUEST ATTRIBUTES
CAXN S2,%GENRC ;IF HOST SYSTEM AND GENERIC,,THEN
IORM S1,.QESEQ(P4) ; SET ALLOCATE FOR THIS REQUEST
PUSHJ P,M%GPAG ;GET A PAGE FOR SOME SCRATCH WORK
MOVE M,S1 ;SAVE THE PAGE ADDRESS
MOVX S1,.MMHSZ ;GET THE MESSAGE HEADER LENGTH
STORE S1,.MSTYP(M),MS.CNT ;SAVE IT
MOVX S1,.QIFNC ;GET THE INTERNAL FUNCTION CODE
STORE S1,.MSTYP(M),MS.TYP ;SAVE IT
MOVEI P3,.MMHSZ(M) ;POINT TO BLOCK AREA
LOAD P2,.EQLEN(P1),EQ.LOH ;GET THE HEADER LENGTH
ADD P2,P1 ;POINT TO THE CONTROL FILE FP
LOAD S1,.FPLEN(P2),FP.LEN ;GET THE FP LENGTH
ADD P2,S1 ;POINT TO THE CONTROL FILE FD
MOVE S1,.FDSTR(P2) ;GET THE CONTROL FILE STRUCTURE NAME
PUSHJ P,BMDR.A ;CREATE THE ENTRY FOR IT
LOAD S1,.FDLEN(P2),FD.LEN ;GET THE FD LENGTH
ADD P2,S1 ;POINT TO THE LOG FILE FP
LOAD S1,.FPLEN(P2),FP.LEN ;GET THE LOG FILE FP LENGTH
ADD P2,S1 ;POINT TO THE LOG FILE FD
MOVE S1,.FDSTR(P2) ;GET THE LOG FILE STRUCTURE NAME
PUSHJ P,BMDR.A ;CREATE THE ENTRY FOR IT
DMOVE S1,.EQOWN(P1) ;GET THE USERS NAME
DMOVEM S1,.MMUSR(M) ;SAVE IT
MOVSI S1,.EQACT(P1) ;GET THE ACCOUNT STRING ADDR
HRRI S1,.MMUAS(M) ;GET SOURCE,,DESTINATION
BLT S1,.MMUAS+10-1(M) ;COPY IT OVER
MOVE S1,.EQOID(P1) ;GET THE SENDERS PPN
MOVEM S1,G$SID## ;SET IT UP
SETZM G$ACK## ;ZAP THE ACK REQUEST FLAG
MOVE S1,.EQRID(P1) ;GET THE BATCH REQUEST ID
TXO S1,BA%JOB ;LITE THE BATCH FLAG BIT
STORE S1,G$PRVS##,MR.JOB ;AND SAVE IT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE S1,P4 ;GET THE QE ADDRESS
PUSHJ P,D$MNTP## ;TRY TO MOUNT THE CTL & LOG FILE STRS
SKIPN AP,.QEMDR(P4) ;GET THE MDR ADDRESS (IF WE MADE IT)
JRST BMDR.2 ;OH WELL,,CONTINUE ONWARD !!!
LOAD S1,G$PRVS##,MR.JOB ;GET THE 'JOB NUMBER'
STORE S1,.QEJBN(P4),QE.BJN ;SAVE THE JOB NUMBER IN THE QE
LOAD S2,.EQROB+.ROBTY(P1) ;[1176] GET THE OBJECT TYPE
LOAD P1,.MRCNT(AP),MR.CNT ;GET THE REQUEST COUNT
MOVNS P1 ;NEGATE IT
MOVSS P1 ;MOVE RIGHT TO LEFT
HRRI P1,.MRVSL(AP) ;CREATE VSL AOBJN AC
MOVX P2,VS.UAL+VS.CTL ;'USER ALLOCATED+PSEUDO PROC ALLOC' BITS
BMDR.1: MOVE S1,0(P1) ;GET A VSL ADDRESS
IORM P2,.VSFLG(S1) ;LITE THE FLAG BITS
STORE S2,.VSRFL(S1),MR.QUE ;[1176] STORE OBJECT TYPE
AOBJN P1,BMDR.1 ; FOR ALL VSL'S
BMDR.2: MOVE S1,M ;GET THE PAGE ADDRESS BACK
PJRST M%RPAG ;RETURN THROUGH THE MEMORY MANAGER
;Routine to create a mount message entry
BMDR.A: CAMN S1,[SIXBIT/NUL/] ;GOING TO NUL: ???
$RETT ;YES,,THEN DON'T ENTER
AOS .MMARC(M) ;BUMP ENTRY COUNT BY 1
AOS .MECNT(P3) ;BUMP VOLUME SET COUNT BY 1
MOVE S2,[.MEHSZ+ARG.DA+1,,.MNTST] ;GET THE ENTRY BLOCK HEADER
MOVEM S2,.MEHDR(P3) ;SAVE IT
MOVE S2,[2,,.TMSET] ;GET THE VOL SET NAME BLOCK HEADER
MOVEM S2,.MEHSZ+ARG.HD(P3) ;SAVE IT
$TEXT (<-1,,.MEHSZ+ARG.DA(P3)>,<^W/S1/^0>)
MOVSI S2,.MEHSZ+ARG.DA+1 ;GET THE ENTRY LENGTH
ADDM S2,0(M) ;ADD IT TO THE TOTAL MSG LENGTH
MOVEI P3,.MEHSZ+ARG.DA+1(P3) ;POINT TO THE NEXT MSG ENTRY
$RETT ;RETURN
SUBTTL I$UMDR - ROUTINE TO PROCESS ALLOC UPDATE MSGS FROM BATCON
;CALL: M/ The Message Address
;
;RET: True Always
I$UMDR: PUSHJ P,.SAVE3 ;SAVE P1 AND P2 & P3
LOAD S1,.OFLAG(M),PR.RID ;GET THE REQUEST ID
PUSHJ P,A$FREQ## ;FIND THE REQUEST QE ENTRY
JUMPF .RETT ;NOT THERE,,RETURN
MOVE P3,S1 ;SAVE THE QE ADDRESS
MOVX S1,QE.WAL+QE.ALR ;GET 'ALLOCATION' BITS
ANDCAM S1,.QESEQ(P3) ; AND CLEAR THEM
LOAD S1,.OFLAG(M),PR.NON ;ANY DATA IN THE MESSAGE ???
JUMPN S1,UMDR.3 ;NO,,NO UPDATE TO PERFORM
LOAD S1,.OFLAG(M),PR.RID ;GET THE REQUEST ID
TXO S1,BA%JOB ;MAKE THIS A PSEUDO PROCESS
STORE S1,G$PRVS##,MR.JOB ; SAVE THE 'JOB' NUMBER
MOVE S1,.QEOID(P3) ;GET THE REAL USER PPN
MOVEM S1,G$SID## ;AND SET IT
MOVX S1,.QIFNC ;GET THE INTERNAL FUNCTION CODE
STORE S1,.MSTYP(M),MS.TYP ;AND SET IT FOR THIS MSG
PUSHJ P,D$CMDR## ;UPDATE THE MDR
JUMPF UMDR.3 ;FAILED,,IGNORE THE ALLOCATION
MOVE P2,S1 ;SAVE THE VSL ADDRESS
PUSHJ P,D$ALOC## ;PERFORM ALLOCATION
JUMPF [JUMPL S1,.RETT ;ALLOC POSTPONED,,JUST RETURN
MOVE S1,P2 ;ALLOC FAILED,,GET VSL ADDR BACK
PUSHJ P,D$DLVS## ; DELETE ALL NEWLY ADDED VSL'S
JRST UMDR.3 ] ;AND IGNORE THE ALLOCATION
INCR .MRCNT(AP),MR.LNK ;GEN A NEW LINK CODE
LOAD P2,.MRCNT(AP),MR.LNK ;AND LOAD IT
LOAD P1,.MRCNT(AP),MR.CNT ;GET THE REQUEST NUMBER
MOVNS P1 ;NEGATE IT
MOVSS P1 ;MOVE RIGHT TO LEFT
HRRI P1,.MRVSL(AP) ;CREATE VSL SEARCH AOBJN AC
UMDR.1: MOVE S1,0(P1) ;GET A VSL ADDRESS
LOAD S2,.VSFLG(S1),VS.ALC ;JUST ALLOCATING ???
SKIPN S2 ;YES,,SKIP THIS
STORE P2,.VSLNK(S1),VS.LNK ;NO,,LINK THIS VSL TO ALL OTHER MOUNTS
AOBJN P1,UMDR.1 ;LOOK AT ALL VSL'S
JRST UMDR.4 ;AND MEET AT THE PASS
UMDR.3: LOAD S1,.QESEQ(P3),QE.WAM ;WAITING TO BE MOUNTED ???
JUMPE S1,[DOSCHD ;NO,,FORCE A SCHEDULING PASS
$RETT ] ; AND RETURN
MOVE AP,.QEMDR(P3) ;GET THE MDR ADDRESS
UMDR.4: MOVE S1,.MRVSL(AP) ;GET THE FIRST VSL ADDRESS
PUSHJ P,D$MNTV## ;TRY TO MOUNT THE DEVICES
$RETT ;AND RETURN
SUBTTL I$RALC - ROUTINE TO REQUEST ALLOCATION PROCESSING FOR A REQUEST
;CALL: AP/ The MDR Address
; S1/ The QE Address
;
;RET: True Always
INTERN I$RALC ;MAKE IT GLOBAL
I$RALC: $SAVE <M,P1,P2> ;SAVE M AND P1 AND P2
MOVE P1,S1 ;SAVE THE QE ADDRESS
PUSHJ P,S$INPS## ;CHECK SCHEDULABILITY !!!
JUMPF .RETF ;FAILED,,RETURN NOW .....
MOVE S1,.QESEQ(P1) ;LOAD UP THE FLAG BITS
TXNE S1,QE.WAM+QE.ALR ;WAITING OR ALLOC ALREADY REQUESTED ???
$RETF ;YES,,RETURN
TXNN S1,QE.WAL ;ARE WE WAITING FOR ALLOCATION ???
$RETT ;NO,,HE WINS
RALC.1: MOVX S1,.OTBAT ;WANT BATCH OBJECT TYPE
MOVX S2,%GENRC ;WANT GENERIC BATCH PROCESSOR
PUSHJ P,A$LPSB## ;FIND THE BATCH PROCESSOR
JUMPF [SKIPN G$PASS## ;PASS 2? NEED BATCON STARTED?
$RETT ;YES, LET IT SLIDE TILL NEXT TIME
$RETF] ;NO, SOMETHING'S AMISS
MOVE S1,PSBPID(S1) ;GET THE PID OF THE BATCH ALLOC PROC
MOVEM S1,G$SAB##+SAB.PD ;SET IT IN THE SAB
MOVX S1,QE.ALR ;GET ALLOCATION REQUESTED STATUS BIT
IORM S1,.QESEQ(P1) ;LITE THE BIT
LOAD S1,.QESTN(P1),QE.DPA ;GET THE REQUESTS DPA
PUSHJ P,F$RDRQ## ;READ IN THE EQ
SKIPN 0(S1) ;A LITTLE SAFETY CHECK
PUSHJ P,S..NBR## ;SOMETHINGS WRONG !!!
MOVE P2,S1 ;SAVE THE EQ ADDRESS
MOVE S1,.QERID(P1) ;GET THE QE RID
MOVEM S1,.EQRID(P2) ;AND SAVE IT
MOVX S1,.QOALC ;GET THE ALLOCATE MESSAGE TYPE
STORE S1,.MSTYP(P2),MS.TYP ;SET IT
MOVEM P2,G$SAB##+SAB.MS ;SAVE THE MESSAGE ADDRESS IN THE SAB
MOVX S1,PAGSIZ ;GET A PAGE LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SET IT IN THE SAB
SETZM G$SAB##+SAB.SI ;NO SPECIAL PID INEDX
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
JUMPT .RETF ;WIN,,RETURN
ZERO .QESEQ(P1),QE.ALR ;CLEAR REQUESTED STATUS
JRST RALC.1 ;AND TRY AGAIN !!!
SUBTTL I$CHKL - ROUTINE TO CHECK TO SEE IF A JOB IS SCHEDULABLE
;CALL: S1/ The QE Address
; AP/ The MDR address
;
;RET: True if OK, False otherwise
INTERN I$CHKL ;Make it global
I$CHKL: $SAVE <P1,P2> ;Save required ACs
MOVE P1,S1 ;Save the QE address
LOAD P2,.MRCNT(AP),MR.CNT ;Get the request count
MOVNS P2 ;Negate it
MOVSS P2 ;Move right to left
HRRI P2,.MRVSL(AP) ;Create VSL search AC
CHKL.1: MOVE S1,0(P2) ;Get a VSL address in S1
LOAD S2,.VSFLG(S1),VS.TYP ;Get the request type
CAXE S2,%DISK ;For a structure ???
JRST CHKL.2 ;No,,get next request
MOVE S1,.VSVOL(S1) ;Get the primary VOL block address
LOAD S2,.VLFLG(S1),VL.LCK ;Get the VOL lock status
CAXE S2,%LOCKD ;Is the structure locked ???
CAXN S2,%ULCKP ; or locked with pending unlock ???
$RETF ;Yes,,can't schedule this request
CAXE S2,%LOCKP ;Is it unlocked with a pending lock ???
JRST CHKL.2 ;No,,check next request
MOVE S1,.VLLTM(S1) ;Yes,,load up the lock time
SUB S1,G$NOW## ;Calc number of jiffies remaining
JUMPLE S1,.RETF ;Already locked,,can't schedule
IDIVI S1,3 ;Calc number of seconds remaining
GETLIM S2,.QELIM(P1),TIME ;Get the jobs run time in seconds
CAMLE S2,S1 ;Can the job fit in the time remaining ?
$RETF ;No,,can't schedult it
CHKL.2: AOBJN P2,CHKL.1 ;Check all structure requests
$RETT ;Done,,return
SUBTTL I$CUNK - CHECK FOR 'UNKNOWN' REQUEST TYPES IN MOUNT/ALLOCATE
;CALL: S1/ The VSL Address
;
;RET: True Always
;If the device is a DECtape, the %DTAP will be set in the VSL
INTERN I$CUNK ;MAKE IT GLOBAL
I$CUNK: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,S1 ;GET THE VSL ADDRESS
LOAD S1,.VSFLG(P1),VS.TYP ;GET THE VOLUME SET TYPE
CAXE S1,%UNKN ;IS IT TYPE 'UNKNOWN' ???
CAXN S1,%DISK ;[1226] OR 'DISK' ???
TRNA ;[1226] YES TO EITHER
$RETT ;NO,,RETURN
MOVE S1,P1 ;GET THE VSL ADDRESS BACK
PUSHJ P,I$CGEN ;CONVERT THE VSN TO A DEVICE AND INDEX
JUMPF CUNK.1 ;NOT SUPPORTED,,MAKE IT A DISK
MOVX S1,VS.FDV ;BIT TO SET
IORM S1,.VSFLG(P1) ;IT'S A FOREIGN DEVICE (UNIT RECORD)
$RETT ;AND RETURN
CUNK.1: MOVE S1,P1 ;[1226] GET VSL ADDRESS
PUSHJ P,DEVCHK ;[1226] CHECK OUT DEVICE
$RETIF ;[1226] RETURN IF PROBLEMS
STORE S1,.VSFLG(P1),VS.TYP ;[1226] SAVE THE REQUEST TYPE
$RETT ;AND RETURN
;DEVCHK - ROUTINE TO ENSURE DEVICE STRING IS VALID
;ACCEPTS S1/ VSL ADDRESS
;RETURNS TRUE S1/ DEVICE TYPE (%DISK OR %TAPE)
; S2/ SIXBIT DEVICE NAME
; G$ERR IS SET WITH ERROR CODE IF PROBLEMS
DEVCHK: PUSHJ P,.SAVE4 ;[1226] SAVE P1-P4
MOVE P1,S1 ;[1226] COPY VSL ADDRESS
HRROI S1,.VSVSN(P1) ;[1226] GET ADDRESS OF VOLUME SET NAME
PUSHJ P,S%SIXB ;[1226] CONVERT TO SIXBIT
$SAVE <S2> ;[1226] SAVE DEVICE NAME FOR RETURN
ILDB P4,S1 ;[1226] GET TERMINATOR
JUMPN P4,DEVC.3 ;[1226] GO SEE IF REELID SPECIFIED
MOVE P2,S2 ;[1226] SAVE THE DEVICE NAME
MOVE TF,[1,,P2] ;[1226] YES, GET DSKCHR PARMS
DSKCHR TF, ;[1226] GET STRUCTURE STATUS BITS
JRST DEVC.1 ;[1226] NOT A DISK
LOAD TF,TF,DC.TYP ;[1226] GET THE DEVICE TYPE
CAXN TF,.DCTAB ;[1226] AMBIGUOUS?
PJRST E$ASN## ;[1226] YES - SAY SO
CAXE TF,.DCTUF ;[1226] UNIT WITHIN STRUCTURE?
CAXN TF,.DCTCN ;[1226] CONTROLLER CLASS?
PJRST E$ISN## ;[1226] YES - INVALID STRUCTURE
CAXE TF,.DCTCC ;[1226] CONTROLLER CLASS?
CAXN TF,.DCTPU ;[1226] PHYSICAL UNIT?
PJRST E$ISN## ;[1226] YES, ILLEGAL STRUCTURE
CAXN TF,.DCTDS ;[1226] GENERIC OR ERSATZ?
JRST DEVC.2 ;[1226] YES, CHECK IT OUT SOME MORE
MOVX S1,%DISK ;[1226] ITS A DISK
$RETT ;[1226] AND RETURN
DEVC.1: DEVTYP S2, ;[1226] GET DEVICE TYPE
JRST DEVC.4 ;[1226] CHECK FOR REELID
JUMPE S2,DEVC.4 ;[1226] GO LOOK FOR REELID
TXNE S2,TY.GEN ;[1226] A GENERIC DEVICE ?
PJRST E$GDN## ;[1226] YES
LOAD TF,S2,TY.DEV ;[1460] LOAD THE DEVICE TYPE
CAIE TF,.TYMTA ;[1460] IS IT TAPE??
CAIN TF,.TYDTA ;[1460] OR IS IT A DECTAPE??
TRNA ;[1460] YES
PJRST E$DNM## ;[1226] NO,,UNSUPPORTED DEVICE
MOVX S1,%TAPE ;[1226] ASSUME MAGTAPE
CAIE TF,.TYMTA ;[1460] WAS IT?
MOVX S1,%DTAP ;[1460] NO, MUST HAVE BEEN DECTAPE
$RETT ;[1226] RETURN
DEVC.2: MOVE TF,[3,,P2] ;[1226] GET PATH. ARGS
PATH. TF, ;[1226] FIND OUT SOME MORE
PJRST E$UST## ;[1226] CATCH ALL
TXNE P3,PT.DLN!PT.EDA ;[1226] PATHOLOGICAL NAME?
PJRST E$PLD## ;[1226] YES, SAY SO
TXNE P3,PT.IPP ;[1226] IMPLIED PPN? (ERSATZ)
PJRST E$ERZ## ;[1226] YES, SAY SO
PJRST E$GDN## ;[1226] ELSE CALL IT GENERIC
DEVC.3: DEVTYP S2, ;GET DEVICE TYPE
SETZ S2, ;NO SUCH DEVICE
LOAD S2,S2,TY.DEV ;[1226] LOAD THE DEVICE TYPE
CAIN S2,.TYDTA ;DECTAPE?
SKIPA S1,[%DTAP] ;YES
DEVC.4: MOVX S1,%TAPE ;[1226] ASSUME TAPE
LOAD TF,.VSFLG(P1),VS.REL ;[1226] GET REELID SPECIFIED FLAG
JUMPN TF,.RETT ;[1226] RETURN TRUE IF REELID THERE
JUMPN P4,E$IVN## ;[1226] MORE THAN 6 CHARS AND NO REELID
MOVX S1,%UNKN ;CALL IT UNKNOWN
$RETT ;[1226] RETURN OK
SUBTTL I$CGEN - CONVERT A VSN TO A DEVICE TYPE AND TRANSLATION INDEX
;CALL: S1/ The VSL address
;
;RET: S1/ The Translation index into table DEVNTB
; S2/ The device type
INTERN I$CGEN ;GLOBALIZE IT
I$CGEN: HRROI S1,.VSVSN(S1) ;POINT TO THE VOLUME SET NAME
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
DEVTYP S2, ;GET THE DEVICE TYPE
$RETF ;LOSE,,RETURN (TOO BAD)
LOAD S2,S2,TY.DEV ;GET THE TYPE CODE
MOVSI S1,-DEVLEN ;CREATE SEARCH AOBJN AC
CAME S2,DEVTBL(S1) ;DO WE MATCH ALLOWABLE DEVICES ???
AOBJN S1,.-1 ;NO,,TRY NEXT
JUMPGE S1,.RETF ;NO MATCH,,LOSE
HRRZS S1 ;GET JUST THE INDEX
$RETT ;AND RETURN
DEVTBL: .TYTTY ;TTY
.TYPTR ;PAPER TAPE READER
.TYPTP ;PAPER TAPE PUNCH
.TYDIS ;DISPLAY DEVICE
.TYLPT ;LINE PRINTER
.TYCDR ;CARD READER
.TYCDP ;CARD PUNCH
.TYPTY ;PTY
.TYPLT ;PLOTTER
DEVLEN==.-DEVTBL ;TABLE LENGTH
DEVNTB::EXP [ASCIZ/Terminal/]
EXP [ASCIZ/Paper tape reader/]
EXP [ASCIZ/Paper tape punch/]
EXP [ASCIZ/Display/]
EXP [ASCIZ/Line printer/]
EXP [ASCIZ/Card reader/]
EXP [ASCIZ/Card punch/]
EXP [ASCIZ/Pseudo-terminal/]
EXP [ASCIZ/Plotter/]
SUBTTL Device validation
; Check for a valid (existing) device.
; Call: MOVE S1, sixbit device name
; PUSHJ P,I$VDEV
;
; TRUE return: device exists
; FALSE return: non-existant device
;
I$VDEV::DEVTYP S1, ;DOES IT EXIST?
SETZ S1, ;DEVTYP NOT IMPLEMENTED??
JUMPE S1,.RETF ;NO SUCH DEVICE
$RETT ;DEVICE EXISTS
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,.SAVE3 ;SAVE P1-P3
MOVEI S1,CSMSIZ+FDMSIZ ;GET THE CSM+FD LENGTH
MOVEI S2,CSM.A ;LOAD ADR OF BLOCK
PUSHJ P,.ZCHNK ;ZERO THE CSM AND FD
MOVEI S2,CSM.A ;RESTORE CSM ADDRESS
LOAD P1,SPL.JB(M),SP.JOB ;GET THE JOB NUMBER
STORE P1,CSM.JB(S2),CS.JOB ;AND STORE IT
LOAD P1,SPL.JB(M),SP.DFR ;GET DEFER'ED SPOOLING BIT
LOAD P2,SPL.SF(M),SP.FLG ;GET SPOOLING FLAGS
CAIN P2,.SPDFD ;IS IT DEFERED SPOOLING ???
MOVEI P1,1 ;YES,,GET A BIT
CAIN P2,.SPDFI ;IS IT IMMEDIATE SPOOLING ???
MOVEI P1,0 ;YES,,GET A NULL BIT
STORE P1,CSM.JB(S2),CS.DFR ;AND STORE IT
DMOVE P1,SPL.US(M) ;GET THE USER NAME
DMOVEM P1,CSM.US(S2) ;AND STORE IT
MOVSI P1,SPL.AC(M) ;GET ACCOUNT STRING ADDRESS
HRRI P1,CSM.AC(S2) ;GET DESTINATION ADDRESS
BLT P1,CSM.AC+7(S2) ;YES,,COPY THE ACCOUNT STRING OVER
LOAD P1,G$SID## ;GET USER'S DIRECTORY
STORE P1,CSM.OI(S2) ;AND STORE IT
LOAD P3,SPL.SF(M),SP.TYP ;GET THE SPOOL TYPE
SKIPE P3 ;IS THERE ONE ???
SETZM SPL.DV(M) ;YES,,MAKE DEVICE NULL
HLLZ P1,SPL.DV(M) ;LOAD THE DEVICE
HRLZI P2,-NDEVS ;MAKE AOBJN AC (FOR DEVICE SEARCH)
CSM.1: HLLZ P3,DEVTAB(P2) ;GET THE DEVICE TYPE FROM THE TABLE
CAMN P1,P3 ;DO WE MATCH ???
JRST CSM.2 ;YES,,CONTINUE ON.
AOBJN P2,CSM.1 ;ELSE TRY THE NEXT TABLE ENTRY
SETZM SPL.DV(M) ;NOT THERE,,MAKE DEVICE NULL
LOAD P1,SPL.SF(M),SP.TYP ;GET THE SPOOL TYPE
SKIPN P1 ;IS THERE ONE ???
MOVX P1,.TYLPT ;NO,,DEFAULT TO LPT
HRLZI P2,-NDEVS ;MAKE AOBJN AC
CSM.1A: HRRZ P3,OBJDEV(P2) ;GET THE OBJECT TYPE
CAMN P1,P3 ;DO WE MATCH ???
JRST CSM.2 ;YES,,CONTINUE ON
AOBJN P2,CSM.1A ;NO,,TRY THE NEXT ENTRY
SKIPA P1,[EXP .OTLPT] ;NONE THERE,,DEFAULT TO LPT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CSM.2: HLRZ P1,OBJDEV(P2) ;GET THE OBJECT TYPE
STORE P1,CSM.RO+.ROBTY(S2) ;SAVE IT
SKIPN P1,SPL.DV(M) ;DID THE USER SPECIFY A DEVICE ???
JRST CSM.3 ;NO,,USE SPL.DA
SETZ P2, ;ZAP A TEMP AC
CAMN P1,DEVLL ;WAS IT LL: ???
MOVX P2,OBDLLC ;YES,,MAKE IT LOWER CASE
CAMN P1,DEVLU ;WAS IT LU: ???
MOVX P2,OBDLUC ;YES,,MAKE IT UPPER CASE
JUMPN P2,CSM.2A ;IF LOWER OR UPPER,,GO SAVE IT
TXNE P1,7700 ;DID HE SPECIFY A NODE NUMBER ???
WHERE P1,UU.PHY ;GET THE NODE NUMBER
SKIPA ;DONT SAVE IF AN ERROR
STORE P1,CSM.RO+.ROBND(S2) ;ELSE SAVE THE NODE NUMBER
MOVE P1,SPL.DV(M) ;GET THE DEVICE NAME
LDB P2,[POINT 6,P1,35] ;GET UNIT NUMBER
TXNN P1,7700 ;IS THERE A NODE FIELD ???
LDB P2,[POINT 6,P1,23] ;NO,,UNIT IS 4TH DIGIT
JUMPE P2,CSM.3 ;NO UNIT,,CONTINUE ON
SUBI P2,'0' ;MAKE UNIT BINARY
TXO P2,RO.PHY ;TURN ON THE PHYSICAL BIT
CSM.2A: STORE P2,CSM.RO+.ROBAT(S2) ;AND SAVE IT
JRST CSM.4 ;AND CONTINUE
CSM.3: MOVE P1,SPL.DA(M) ;GET THE DEVICE NAME
LOAD P2,P1,SP.UNI ;GET THE UNIT NUMBER
JUMPE P1,CSM.3A ;NONE THERE,,CONTINUE
TXO P2,RO.PHY ;GET 'PHYSICAL' BIT
TXNE P1,SP.PHY ;IS IT 'PHYSICAL' ???
JRST CSM.3A ;YES,,SAVE IT
TXNE P1,SP.LWC ;IS IT LL: ???
MOVX P2,OBDLLC ;YES,,MAKE IT LOWER
TXNE P1,SP.UPC ;OR IS IT UPPER CASE ???
MOVX P2,OBDLUC ;YES,,MAKE IT UPPER CASE
CSM.3A: STORE P2,CSM.RO+.ROBAT(S2) ;SAVE THE DEVICE ATTRIBUTES
CSM.4: LOAD P1,SPL.ST(M) ;GET THE FILESTRUCTURE
STORE P1,CSM.B+.FDSTR ;AND STORE IN THE FD AREA
LOAD P1,SPL.EN(M) ;GET THE ENTER'ED FILENAME
STORE P1,CSM.EN(S2) ;AND STORE IT
LOAD P1,SPL.FS(M) ;GET THE FILE SIZE
STORE P1,CSM.FS(S2) ;STORE IT AWAY
LOAD P1,SPL.CP(M) ;GET THE # OF COPIES
STORE P1,P1,FP.FCY ;MOVE TO THE CORRECT PLACE
TXO P1,FP.SPL ;TURN ON SPL BITS
STORE P1,CSM.FP(S2) ;SAVE FOR Q$INCL
LOAD P1,SPL.FM(M) ;GET THE FORMS TYPE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
STORE P1,CSM.FM(S2) ;SAVE THEM
LOAD P1,SPL.LM(M) ;GET THE LIMIT
STORE P1,CSM.LM(S2) ;SAVE IT
LOAD P1,SPL.AF(M) ;GET /AFTER
STORE P1,CSM.AF(S2) ;SAVE IT
SKIPN P1,SPL.ND(M) ;GET THE NODE NAME
LOAD P1,SPL.JB(M),SP.LOC ;NOT THERE,,GET FROM HERE
SKIPN CSM.RO+.ROBND(S2) ;IS THE NODE ALREADY FILLED IN ???
STORE P1,CSM.RO+.ROBND(S2) ;NO,,THEN SAVE IT
MOVEI P1,CSM.B ;WHERE WE BUILD THE FD
STORE P1,CSM.FD(S2),CS.FDA ;STORE IT
MOVEI P2,FDMSIZ ;GET SIZE OF THE FD
STORE P2,.FDLEN(P1),FD.LEN ;AND STORE IT
;NOW FINISH MOVING THE FD AREA
LOAD P1,SPL.FN(M) ;GET THE FILE NAME
STORE P1,CSM.B+.FDNAM ;STORE IT
LOAD P1,G$SPLD## ;GET SPOOLING DIRECTORY
STORE P1,CSM.B+.FDPPN ;STORE IT
HLRZ S2,SPL.DV(M) ;LOAD DEVICE SPECIFIED
CAIE S2,'LL ' ;WAS IT LL?
CAIN S2,'LU ' ;NO, LU?
MOVEI S2,'LPT' ;ONE OR THE OTHER, USE LPT
LOAD S1,SPL.EX(M),SP.EXT ;GET THE SPOOL EXTENSION
SKIPE S1 ;IS THERE ONE ???
MOVE S2,S1 ;YES,,SAVE IT IN S2
HRLZM S2,CSM.B+.FDEXT ;AND STORE GENERIC DEV AS EXTENSION
MOVEI S1,CSM.A ;LOAD THE ANSWER
$RETT ;AND RETURN
CSM.A: BLOCK CSMSIZ ;THE CSM TO RETURN
CSM.B: BLOCK FDMSIZ ;THE FD AREA
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.JB(S1),LG.BSS ;GET BATCH STREAM FLAG SETTING
SKIPE S2 ;IS IT SET ?
LOAD S2,LGO.JB(S1),LG.BAT ;YES - 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$SMEQ ;Move fields from CSM to EQ
INTERN I$QESM ;Move fields from QE to CSM
INTERN I$RMCH ;Make request and RDB
INTERN I$DFEQ ;Default and check the EQ
INTERN I$LGFD ;Build a logfile FD
INTERN I$MUSR ;Move a RDB user into a message.
INTERN I$ONOD ;Default the ONOD limit word for batch
INTERN I$VACT ;ACTDAE ACCT VALIDATION MSG PROCSR
INTERN I$CACV ;'CREATE' ACCT STRING VALIDATION
INTERN I$SACV ;'SCHEDULE' ACCT STRING VALIDATION
INTERN I$ACTV ;VALIDATE ACCOUNT USING QE
INTERN I$DFMR ;FILL IN SYSTEM DEPENDENT MDR DATA
INTERN I$QCDI ;CONNECTED DIRECTORY ON SHORT CREATE
INTERN I$MNTR ;JUST A NOOP ON THE -10
INTERN I$GOFR ;IPCF [SYSTEM]GOPHER MESSAGE PROCESSOR
SUBTTL I$EQQE - Move fields from EQ to QE
;CALL: S1/ The EQ Address
; AP/ The QE Address
; ***NOTE*** There are no system dependent fields to move on the -10,
; so we will just exit through the account validation routine.
I$EQQE: LOAD S2,.QHTYP(H),QH.TYP ;GET QUEUE TYPE
CAIE S2,.QHTOU ;OUTPUT?
CAIN S2,.QHTIP ;INPUT?
PJRST I$CACV ;YES--GO DO ACCOUNT VALIDATION
$RETT ;RETURN
SUBTTL I$SMEQ -- Move fields from CSM to EQ
;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE CANONICAL
; SPOOL MESSAGE (CSM) TO THE EXTERNAL QUEUE REQUEST (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 OWNER ID
STORE S2,.EQOID(AP) ;SAVE IT IN THE EQ
MOVSI S2,CSM.AC(S1) ;GET THE ACCOUNT STRING ADDRESS
HRRI S2,.EQACT(AP) ;GET THE DESTINATION ADDRESS
BLT S2,.EQACT+7(AP) ;COPY THE ACCOUNT STRING OVER
DMOVE S1,CSM.US(S1) ;GET USER NAME
DMOVEM S1,.EQOWN(AP) ;SAVE IN THE EQ
$RETT ;AND RETURN
SUBTTL I$QESM - Move fields from the QE to the CSM
;CALL: AP/ QE Address
; T1/ CSM Address
;
;RET: True Always
I$QESM: DMOVE S1,.QEUSR(AP) ;GET THE USER NAME
DMOVEM S1,CSM.US(T1) ;INSERT INTO THE CSM
$RETT ;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) ;GET AND CHECK FOR REQUEST ID.
JRST RMCH.0 ;NONE THERE,,CONTINUE NORMALLY
CAME S2,[-1] ;IS IT 'ALL' REQUESTS ???
CAMN S2,.QERID(AP) ; OR DO WE MATCH ???
$RETT ;YES,,RETURN OK
$RETF ;NO,,RETURN INVALID
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
LOAD S2,.QEOID(AP) ;GET OWNER ID
SKIPN P1,.RDBOI(S1) ;LOAD SPECIFIED OID
SKIPE G$QOPR## ;IS THE REQUEST FROM THE OPERATOR ??
SKIPA ;YES,,KEEP ON GOING.
MOVE P1,G$SID## ;NO,,USE THE DEFAULT IF 0
XOR S2,P1 ;FIND OUT WHATS DIFFERENT
AND S2,.RDBOM(S1) ;MASK OUT INSIGNIFICANT PARTS
JUMPN S2,.RETF ;NO MATCH IF NOT 0
$RETT ;WIN!!
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: LOAD S2,.EQOID(S1) ;GET OWNER
CAME S2,G$SID## ;SAME AS SENDER?
JUMPN S2,A$WHEEL## ;IF NOT, AND IF NOT 0, RETURN THRU WHEEL
LOAD S2,G$SID## ;LOAD CURRENT SENDER
STORE S2,.EQOID(S1) ;STORE IT
MOVEI S2,.EQOWN(S1) ;GET ADDRESS OF USER NAME
HRLI S2,(POINT 6,) ;MAKE A BYTE POINTER
MOVEM S2,PPNPTR ;SAVE IT
MOVE S2,.EQOWN+0(S1) ;GET USER NAME WORD 1
IOR S2,.EQOWN+1(S1) ;OR WITH USER NAME WORD 2
SKIPN S2 ;WAS A USER NAME SPECIFIED?
$TEXT (PPNTYO,<^P12L /.EQOID(S1)/^A>) ;STORE [PPN]
SKIPE .EQJOB(S1) ;SKIP IF WE MUST DEFAULT THE JOBNAME
$RETT ;ELSE, RETURN
PUSH P,S1 ;SAVE ADDRESS OF .EQ
LOAD S2,.EQLEN(S1),EQ.LOH ;GET LENGTH OF HEADER
ADD S1,S2 ;GET ADDRESS OF FIRST FP
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FPLENGTH
ADD S1,S2 ;POINT TO THE FIRST FD
LOAD S2,.FDNAM(S1) ;GET THE FIRST FILENAME
POP P,S1 ;GET THE .EQ ADDRESS
STORE S2,.EQJOB(S1) ;STORE THE JOBNAME
$RETT ;AND RETURN
; Character sticker routine to build a [PPN]
;
PPNTYO: SUBI S1," " ;CONVERT ASCII TO SIXBIT
IDPB S1,PPNPTR ;STORE CHARACTER
$RETT ;RETURN
SUBTTL I$LGFD -- Build a LOG file FD
;I$LGFD is called by the INP queue default filler to generate an FD
; for a LOG file on a job where no log file is given.
;
;The filename created is SIXBIT<ITN>.LOG[3,3]
;
;Call: S1/ address of the location to start building FD
; S2/ FD Address
; M/ EQ Address
;
;T Ret: always
I$LGFD: PUSHJ P,.SAVE3 ;SAVE P1 AND P2 AND P3
MOVE S2,.FPINF(S2) ;GET THE STATUS BITS FOR THIS FILE
TXNN S2,FP.SPL ;DO WE WANT A NORMAL 'SPOOL' FD
JRST LGFD.2 ;NO,,CREATE A USER LOG FILE FD
PUSHJ P,LGFD.0 ;YES,,GO SETUP THE SPOOL FILE NAME
MOVSI S2,'LOG' ;GET THE EXTENSION
STORE S2,.FDEXT(S1) ;SAVE IT
MOVE S2,G$SPLD## ;GET SPOOL DIRECTORY
STORE S2,.FDPPN(S1) ;SAVE IT
MOVE S2,G$QSTR## ;[1226] GET A STRUCTURE
STORE S2,.FDSTR(S1) ;AND STORE IT
MOVEI S2,FDMSIZ ;GET MINIMUM FD SIZE
STORE S2,.FDLEN(S1),FD.LEN ;SAVE IT
$RETT ;AND RETURN
LGFD.0: LOAD P1,.EQITN(M) ;GET THE ITN.
MOVE S2,[POINT 6,.FDNAM(S1)] ;GET THE OUTPUT BYTE POINTER
MOVEI P3,6 ;ONLY 6 CHARACTERS !!!
LGFD.1: IDIVI P1,^D36 ;GET RADIX 36
PUSH P,P2 ;SAVE THE REMAINDER
SOSE P3 ;COUNT DOWN THE CHARACTERS
PUSHJ P,LGFD.1 ;MORE,,GO BACK.
POP P,P1 ;GET AN ANSWER.
ADDI P1,'0' ;MAKE IT SIXBIT
CAILE P1,'9' ;IS IT A NUMBER ???
ADDI P1,'A'-'9'-1 ;NO,,MAKE IT A LETTER
IDPB P1,S2 ;SAVE THE BYTE
POPJ P, ;THEN PROCESS THE NEXT ONE
LGFD.2: MOVE P1,S1 ;SAVE THE LOG FILE FD ADDRESS
LOAD S1,.EQLEN(M),EQ.LOH ;GET LENGTH OF EQ HEADER
ADDI S1,(M) ;INDEX TO THE CTL FILE FP
LOAD P2,.FPLEN(S1),FP.LEN ;[1500] GET FP LENGTH
ADDI P2,(S1) ;[1500] INDEX TO THE CTL FILE FD
MOVEI S1,.FDSTR(P2) ;[1500] POINT TO STRUCTURE
HRLI S1,1 ;ONE WORD
DSKCHR S1, ;MAKE SURE IT'S A DISK
SETZ S1, ;IT'S NOT
LOAD S1,S1,DC.TYP ;GET ARGUMENT TYPE
CAIN S1,.DCTFS ;FILE STRUCTURE?
JRST LGFD.3 ;YES
MOVE S1,.FDSTR(P2) ;[1500] GET OFFENDING DEVICE
$TEXT (<-1,,@G$ACKB##>,<"^W/S1/" is not a file structure^0>)
PUSHJ P,E$XXX## ;SET THE ERROR CODE
MOVEI S1,'NFS' ;GET PREFIX FOR QUEUE PROGRAM
HRLM S1,G$ERR## ;SAVE
$RETF ;AND RETURN
LGFD.3: MOVE S1,.EQJOB(M) ;GET THE JOB NAME
MOVEM S1,.FDNAM(P1) ;SAVE IT
MOVSI S1,'LOG' ;GET THE EXTENSION
MOVEM S1,.FDEXT(P1) ;SAVE IT
MOVX S1,FDXSIZ ;GET THE FD LENGTH+HDR LENGTH
STORE S1,.FDLEN(P1),FD.LEN ;SAVE IT
MOVSI S1,.EQPAT(M) ;GET THE PATH SOURCE ADDRESS
HRRI S1,.FDPPN(P1) ;GET THE DESTINATION PATH ADDRESS
BLT S1,.FDPPN+6-1(P1) ;COPY THE PATH OVER
MOVE S1,.EQOID(M) ;GET THE USER'S PPN
SKIPN .FDPPN(P2) ;[1500] WAS A PATH SPECIFIED IN CTL FD???
MOVEM S1,.FDPPN(P2) ;[1500] NO,,SAVE USER PPN
SKIPN .FDPPN(P1) ;WAS A PATH SPECIFIED IN LOG FD???
MOVEM S1,.FDPPN(P1) ;NO,,SAVE USER PPN
LOAD S1,.EQLEN(M),EQ.LOH ;GET THE HEADER LENGTH
ADD S1,M ;POINT TO THE FIRST FD
LOAD S2,.FPLEN(S1),FP.LEN ;GET THE FP LENGTH
ADD S1,S2 ;POINT TO THE FIRST FD
MOVE S1,.FDSTR(S1) ;GET THE STRUCTURE
MOVEM S1,.FDSTR(P1) ;SAVE IT
$RETT ;RETURN
SUBTTL Spooled CDR file support
; Dummy routines not needed under TOPS-10
I$GCDR::POPJ P, ;RETURN
I$QCDR::POPJ P, ;RETURN
I$DCDR::POPJ P, ;RETURN
SUBTTL I$MUSR - Move an RDB user PPN into an RDB block.
;ROUTINE TO MOVE AN RDB USER PPN INTO AN RDB BLOCK IN AN
; HOLD/RELEASE MESSAGE.
;
;CALL:
; MOVE S1,USER PPN ADDRESS.
; MOVEI S2,OUTPUT RDB ADDRESS
; PUSHJ P,I$MUSR##
; ALWAYS RETURN HERE
I$MUSR: SKIPE S1 ;NO USER PPN,,STORE 0'S.
LOAD S1,0(S1) ;LOAD THE PPN.
STORE S1,.RDBOI(S2) ;SAVE IT IN THE MESSAGE.
SETZM .RDBOM(S2) ;DEFAULT TO A MASK OF ALL 0'S.
SKIPE S1 ;IF NO [PPN] THEN RETURN.
SETOM .RDBOM(S2) ;SET THE MASK TO ALL 1'S.
$RETT ;RETURN.
SUBTTL I$ONOD - ROUTINE TO DEFAULT THE ONOD LIMIT WORD FOR BATCH EQ'S
;CALL: M/ The EQ Address
;
;RET: True Always
I$ONOD: MOVE S1,G$LNBR## ;GET THE LOCAL NODE NUMBER
STOLIM S1,.EQLIM(M),ONOD ;SAVE IT IN THE EQ
$RETT ;AND RETURN
SUBTTL Structure mount/dismount accounting routines
;CALL: AP/ The MDR Address
; S1/ The VSL Address
;
;RET: True Always
INTERN I$SMNT ;GLOBALIZE MOUNT ENTRY POINT
INTERN I$SDSM ;GLOBALIZE DISMOUNT ENTRY POINT
I$SMNT: SKIPA S2,[UGFDM$] ;PICK UP MOUNT MSG TYPE
I$SDSM: MOVX S2,UGFDD$ ;PICK UP DISMOUNT MSG TYPE
SKIPE DEBUGW ;ARE WE DEBUGGING ???
$RETT ;YES,,RETURN
PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE VSL ADDRESS
MOVE S1,S2 ;GET THE MSG TYPE IN S1
PUSHJ P,ACTINI ;INITIALIZE THE MESSAGE
MOVE S1,.VSVOL(P1) ;GET THE PRI VOL BLOCK ADDRESS
MOVE S2,.VLNAM(S1) ;GET THE SIXBIT STR NAME
MOVEM S2,ACTSTR+UF$DEV ;SAVE IT
FACT< MOVEM S2,FACTBL+10 > ;STORE FOR DAEMON ALSO
MOVE TF,[1,,S2] ;GET DSKCHR PARM BLOCK LENGTH,,ADDRESS
DSKCHR TF, ;GET STRUCTURE STATUS BITS
SETZM TF ;SHOULD NOT HAPPEN !!!
LOAD TF,TF,DC.PRV ;GET THE PRIVATE STR BIT
AOS TF ;RECODE IT
MOVEM TF,ACTSTR+UF$STY ;SAVE IT
SETZM S2 ;CLEAR # OF PACKS COUNTER
LOAD S1,.VLPTR(S1),VL.NXT ;GET THE NEXT PACK IN THE STR
AOS S2 ;COUNT NUMBER OF PACKS IN STRUCTURE
JUMPN S1,.-2 ;ANOTHER,,COUNT IT UP
MOVEM S2,ACTSTR+UF$PNO ;SAVE # OF PACKS
MOVE S1,.VSUCB(P1) ;GET THE UCB OF THE PRIMARY VOL BLK
LOAD S2,.UCBST(S1),UC.KTP ;GET THE CONTROLLER TYPE
MOVEM S2,ACTSTR+UF$CTY ;SAVE IT
LOAD S2,.UCBST(S1),UC.UTP ;GET THE UNIT TYPE
MOVEM S2,ACTSTR+UF$DTY ;SAVE IT
MOVE S1,.VSCRE(P1) ;GET THE REQUEST CREATION DATE
MOVEM S1,ACTSTR+UF$CDT ;SAVE IT
SKIPN S1,.VSSCH(P1) ;GET THE SCHEDULED DATE
MOVE S1,G$NOW## ;NONE,,USE CURRENT TIME
MOVEM S1,ACTSTR+UF$SDT ;SAVE IT
MOVE S1,G$NOW## ;GET SERVICED DATE
MOVEM S1,ACTSTR+UF$VDT ;SAVE IT
MOVE S1,ACTSTR+UF$DEV ;GET THE SIXBIT STRUCTURE NAME BACK
PUSHJ P,I$MNTC ;GET THE MOUNT COUNT
MOVE S2,ACTSTR+UX$TYP ;GET THE MESSAGE TYPE
CAXN S2,UGFDM$ ;IS THIS A MOUNT REQUEST ???
SUBI S1,1 ;YES,,PHASE MOUNT COUNT
MOVEM S1,ACTSTR+UF$CBR ;SAVE THE MOUNT COUNT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEM S1,ACTSTR+UF$SCT ;SAVE IT HERE ALSO
LOAD S1,.VSFLG(P1),VS.SIN ;GET SINGLE ACCESS BIT
AOS S1 ;RECODE IT
MOVEM S1,ACTSTR+UF$ACC ;SAVE IT
MOVEI S1,ACTSTR ;GET THE MESSAGE ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT
MOVX S1,UF$SCT+1 ;GET THE MSG LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT
MOVX S1,SI.FLG+SP.ACT ;GET SPECIAL PID 'ACTDAE'
MOVEM S1,G$SAB##+SAB.SI ;SAVE IT
SETZM G$SAB##+SAB.PD ;NO PID HERE
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
FACT< MOVE S1,[14,,FACTBL-1] ;LENGTH,,ADDR OF FACT BLOCK
DAEMON S1, ;WRITE FACT FILE
JFCL > ;REALLY OUGHT TO COMPLAIN
$RETT ;RETURN
SUBTTL I$TMNT - Tape mount accounting routines
; I$TDSM - " " " " " "
;CALL: S1/ The VSL Address
; AP/ The MDR Address
;
;RET: True Always
INTERN I$TMNT ;GLOBALIZE TAPE MOUNT ENTRY POINT
INTERN I$TDSM ;GLOBALIZE TAPE DISMOUNT ENTRY POINT
I$TMNT: SKIPA S2,[UGMGM$] ;GET MOUNT MESSAGE TYPE
I$TDSM: MOVX S2,UGMGD$ ;GET DISMOUNT MESSAGE TYPE
SKIPE DEBUGW ;ARE WE DEBUGGING ???
$RETT ;YES,,RETURN
PUSHJ P,.SAVE1 ;YES,,SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE VSL ADDRESS
MOVE S1,S2 ;GET THE MSG TYPE IN S1
PUSH P,S1 ;[1234] SAVE MSG TYPE
PUSHJ P,ACTINI ;PERFORM ACCOUNTING INITIALIZATION
POP P,S2 ;[1234] GET MSG TYPE BACK
LOAD S1,.TDDVT(M),TDD.FL ;[1234] GET MONITOR FLAGS
CAXE S2,UGMGM$ ;[1234] MOUNT STATS?
TXNN S1,TD.VSW ;[1234] VOLUME SWITCH STATS?
JRST TMNT.A ;[1234] NO, MOUNT OR REGULAR DISMOUNT
MOVE S1,.TDDEV(M) ;[1234] YES, GET DEVICE NAME
MOVEM S1,ACTSTR+UM$DEV ;[1234] SAVE IT
JRST TMNT.B ;[1234] GO GET STATS
TMNT.A: MOVE S1,.VSCRE(P1) ;[1234] GET THE CREATION DATE
MOVEM S1,ACTSTR+UM$CDT ;SAVE IT
MOVE S1,.VSSCH(P1) ;GET THE SCHEDULED DATE
MOVEM S1,ACTSTR+UM$SDT ;SAVE IT
MOVE S1,G$NOW## ;GET THE SERVICED DATE
MOVEM S1,ACTSTR+UM$VDT ;SAVE IT
LOAD S1,.VSFLG(P1),VS.LBT ;GET THE LABEL TYPE
MOVEI S2,1 ;DEFAULT TO UNLABELED
CAXN S1,.TFLAL ;DO WE HAVE ANSI LABELS ???
MOVEI S2,2 ;YES,,SAY SO
CAXN S1,.TFLIL ;DO WE HAVE EBCDIC LABELS ???
MOVEI S2,3 ;YES,,SAY SO
MOVEM S2,ACTSTR+UM$LTY ;SAVE IT
MOVE S1,.VSUCB(P1) ;GET THE UCB ADDRESS
MOVE S2,.UCBNM(S1) ;GET THE DEVICE NAME
MOVEM S2,ACTSTR+UM$DEV ;SAVE IT
FACT< MOVEM S2,FACTBL+10 > ;STORE FOR DAEMON ALSO
LOAD S1,.UCBST(S1),UC.KTP ;GET THE CONTROLLER TYPE
MOVEM S1,ACTSTR+UM$CTY ;SAVE IT
LOAD S1,.VSCVL(P1),VS.OFF ;GET THE OFFSET TO THE CURRENT VOLUME
ADDI S1,.VSVOL(P1) ;POINT TO THE VOL BLK ADDRESS
MOVE S1,0(S1) ;AND LOAD IT
MOVE S2,.VLNAM(S1) ;GET THE VOLID
MOVEM S2,ACTSTR+UM$VID ;SAVE IT
LOAD S1,ACTSTR+.MSTYP,MS.TYP ;GET THE MESSAGE TYPE
LOAD S2,.MSTYP(M),MS.CNT ;[1165] GET LENGTH OF MESSAGE FROM MONITOR
CAIN S1,UGMGD$ ;[1165] IS IT A DISMOUNT ???
CAIG S2,.TDMIN ;[1165] DOES IT CONTAIN NEW STATISTICS STUFF?
JRST TMNT.1 ;NO,,SEND THE MESSAGE OFF
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TMNT.B: MOVE S1,.TDCRD(M) ;[1234][1165] GET THE CHARACTERS READ
MOVEM S1,ACTSTR+UM$MRD ;SAVE IT
MOVE S1,.TDCWR(M) ;[1165] GET THE CHARACTERS WRITTEN
MOVEM S1,ACTSTR+UM$MWR ;SAVE IT
MOVE S1,.TDSRE(M) ;[1165] GET SOFT READ ERRORS
MOVEM S1,ACTSTR+UM$SRE ;SAVE IT
MOVE S1,.TDSWE(M) ;[1165] GET SOFT WRITE ERRORS
MOVEM S1,ACTSTR+UM$SWE ;SAVE IT
MOVE S1,.TDHRE(M) ;[1165] GET HARD READ ERRORS
MOVEM S1,ACTSTR+UM$HRE ;SAVE IT
MOVE S1,.TDHWE(M) ;[1165] GET HARD WRITE ERRORS
MOVEM S1,ACTSTR+UM$HWE ;SAVE IT
TMNT.0: SKIPA S1,[UM$HWE+1] ;GET THE MSG LENGTH
TMNT.1: MOVX S1,UM$FSI+1 ;GET THE MSG LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT
MOVEI S1,ACTSTR ;GET THE MESSAGE ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT
MOVX S1,SI.FLG+SP.ACT ;GET SPECIAL PID 'ACTDAE'
MOVEM S1,G$SAB##+SAB.SI ;SAVE IT
SETZM G$SAB##+SAB.PD ;NO PID HERE
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
FACT< MOVE S1,[14,,FACTBL-1] ;LENGTH,,ADDR OF FACT BLOCK
DAEMON S1, ;WRITE FACT FILE
JFCL > ;REALLY OUGHT TO COMPLAIN
$RETT ;RETURN
SUBTTL ACTINI - MDA ACCOUNTING INITIALIZATION ROUTINE
;CALL: AP/ The MDR Address
; S1/ The Message Type
;
;RET: True Always
ACTINI: $SAVE <T1,T2> ;SAVE T1 AND T2
SETZM ACTSTR ;CLEAR THE FIRST ACCOUNT BUFFER WORD
MOVE S2,[ACTSTR,,ACTSTR+1] ;GET SOURCE,,DESTINATION
BLT S2,ACTSTR+^D50-1 ;CLEAR THE ACCOUNT MESSAGE BUFFER
MOVEM S1,ACTSTR+UX$TYP ;SAVE THE MESSAGE TYPE
LOAD S1,.MRJOB(AP),MD.PJB ;GET THE USERS JOB NUMBER
MOVEM S1,ACTSTR+UF$JOB ;SAVE IT
MOVE S1,[SIXBIT/QUASAR/] ;GET OUR PEOGRAM NAME
MOVEM S1,ACTSTR+UF$PNM ;SAVE IT
MOVE S1,.JBVER ;GET OUR VERSION NUMBER
MOVEM S1,ACTSTR+UF$PVR ;SAVE IT
MOVE S1,.MRUSR(AP) ;GET THE USERS PPN
MOVEM S1,ACTSTR+UF$PPN ;SAVE IT
DMOVE S1,.MRNAM(AP) ;GET THE USERS NAME
DMOVEM S1,ACTSTR+UF$NM1 ;SAVE IT
MOVE S1,[1,,S2] ;GET ACCT. PARM LIST
MOVEI S2,2 ;GET LIST LENGTH
LOAD T1,.MRJOB(AP),MD.PJB ;GET THE USERS JOB NUMBER
HRROI T2,ACTSTR+UF$ACT ;POINT TO OUTOUT AREA
ACCT. S1, ;GET THE USERS ACCOUNT STRING
SETZM ACTSTR+UF$ACT ;FAILED,,ZERO THE ACCOUNT STRING
MOVE S1,.MRTTY(AP) ;GET TERMINAL DESIGNATOR,,LINE NUMBER
STORE S1,ACTSTR+UF$TNO,MR.TNO ;SAVE THE LINE NUMBER
TRZ S1,-1 ;ZAP LINE NUMBER
MOVEM S1,ACTSTR+UF$TRD ;SAVE THE TERMINAL DESIGNATOR
MOVE S1,.MRNOD(AP) ;GET THE USERS LOCATED NODE
MOVEM S1,ACTSTR+UF$NOD ;SAVE IT
FACT< SETZM FACTBL ;ZERO FACT TABLE
MOVE S1,[FACTBL,,FACTBL+1] ;GET BLT PARMS
BLT S1,FACTBL+12 ;ZAP IT ALL
LOAD S1,ACTSTR+UF$TNO,MR.TNO ;GET TERMINAL NUMBER AGAIN
LDB S2,[POINT 7,ACTSTR+UF$TRD,6] ;GET TERMINAL DESIGNATOR
CAIN S2,"C" ;THE CTY
MOVEI S1,7777 ;YES, USE THIS INSTEAD
CAIN S2,"D" ;OR DETACHED
MOVEI S1,7776 ;YES
LSH S1,6 ;POSITION TO BITS 18-29
HRL S1,ACTSTR+UF$JOB ;INSERT THE JOB NUMBER
IOR S1,[271000,,13] ;INSERT FACT TYPE AND LENGTH
MOVEM S1,FACTBL+0 ;STORE
MOVE S1,ACTSTR+UF$PPN ;GET THE USERS PPN
MOVEM S1,FACTBL+1 ;STORE
MOVE S1,[%CNSER] ;BOOT CPU SERIAL NUMBER
GETTAB S1, ;ASK THE MONITOR
SETZ S1, ;WHAT!
MOVE S2,[.NDRNN,,T1] ;CONVERT NODE NAME TO NODE NUMBER
MOVEI T1,2 ;2 ARGUMENTS
MOVE T2,ACTSTR+UF$NOD ;GET THE USERS NODE
NODE. S2, ;CONVERT IT
SETZ S2, ;WHAT!
HRL S1,S2 ;INSERT NODE NUMBER
TLZ S1,777700 ;IN CASE NODE .GT. 77
MOVE S2,ACTSTR+UX$TYP ;GET MOUNT/DISMOUNT TYPE
CAIE S2,UGDTD$ ;A DECTAPE DISMOUNT
CAIN S2,UGMGD$ ; OR A MAGTAPE DISMOUNT
CAIA ;YES
CAIN S2,UGFDD$ ; OR A FILE STRUCTURE DISMOUNT
TLOA S1,'UD ' ;YES, SOME TYPE OF DISMOUNT
TLO S1,'UM ' ;MUST BE MOUNT (SPINDLES DON'T GO TO FACT)
MOVEM S1,FACTBL+3 ;STORE
MOVSI S1,1 ;AND ALL MOUNT/DISMOUNTS ARE SUCCESSFUL
MOVEM S1,FACTBL+12 ;STORE
> ;END FACT ACCOUNTING
$RETT ;RETURN
SUBTTL I$STRM - Structure mount/dismount accounting routines
; I$STRD - " " " " " "
;CALL: S1/ The primary VOL block address
;
;RET: True always
INTERN I$STRM ;GLOBALIZE MOUNT ENTRY POINT
INTERN I$STRD ;GLOBALIZE DISMOUNT ENTRY POINT
I$STRM: SKIPA S2,[UGSPM$] ;GET MOUNT MESSAGE TYPE
I$STRD: MOVX S2,UGSPD$ ;GET DISMOUNT MESSAGE TYPE
SKIPE DEBUGW ;ARE WE DEBUGGING ???
$RETT ;YES,,RETURN
PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE PRIMARY VOL ADDRESS
SETZM ACTSTR ;ZAP FIRST WORD OF MESSAGE BUFFER
MOVE S1,[ACTSTR,,ACTSTR+1] ;GET SOURCE,,DESTINATION
BLT S1,ACTSTR+^D50-1 ;CLEAR COMPLETE MESSAGE BUFFER
STORE S2,ACTSTR+.MSTYP,MS.TYP ;SAVE THE MESSAGE TYPE
MOVE S1,[SIXBIT/QUASAR/] ;GET OUR NAME
MOVEM S1,ACTSTR+US$PNM ;SAVE IT
MOVE S1,.JBVER ;GET OUR VERSION
MOVEM S1,ACTSTR+US$PVR ;SAVE IT
MOVE S1,G$LNAM## ;GET OUR LOCATION
MOVEM S1,ACTSTR+US$NOD ;SAVE IT
PJOB S1, ;GET OUR JOB NUMBER
MOVEM S1,ACTSTR+US$JOB ;SAVE IT
PUSHJ P,GETTTY ;GET THE TTY DATA
MOVEM S1,ACTSTR+US$TRD ;SAVE TERMINAL DESIGNATOR
HRRZM S2,ACTSTR+US$TNO ;SAVE TERMINAL NUMBER
SETZM S2 ;CLEAR STR PACK COUNTER
MOVE S1,P1 ;GET THE VOL BLK ADDRESS IN S1
LOAD S1,.VLPTR(S1),VL.NXT ;GET THE NEXT VOL POINTER
AOS S2 ;BUMP PACK COUNT BY 1
JUMPN S1,.-2 ;CONTINUE TILL DONE
MOVEM S2,ACTSTR+US$PNO ;SAVE THE STRUCTURE PACK COUNT
MOVE S1,G$NOW## ;GET THE CURRENT TIME
MOVEM S1,ACTSTR+US$DTM ;SAVE IT
MOVE S1,.VLNAM(P1) ;GET THE STRUCTURE NAME
MOVEM S1,ACTSTR+US$FSN ;SAVE IT
MOVE TF,[1,,S1] ;GET DSKCHR PARM BLOCK LENGTH,,ADDRESS
DSKCHR TF, ;GET STRUCTURE STATUS BITS
SETZM TF ;SHOULD NOT HAPPEN !!!
LOAD TF,TF,DC.PRV ;GET THE PRIVATE STR BIT
AOS TF ;RECODE IT
MOVEM TF,ACTSTR+US$STY ;SAVE IT
STRM.1: MOVE S1,.VLUCB(P1) ;GET THE UCB ADDRESS
MOVE S2,.UCBNM(S1) ;GET THE DRIVE NAME
MOVEM S2,ACTSTR+US$DEV ;SAVE IT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
AOS ACTSTR+US$MTH ;THIS IS PACK N of M
MOVE S2,.VLVID(P1) ;GET THE VOLUME IDENTIFIER
MOVEM S2,ACTSTR+US$DPI ;SAVE IT
LOAD S2,.UCBST(S1),UC.UTP ;GET THE UNIT TYPE
MOVEM S2,ACTSTR+US$DTY ;SAVE IT
LOAD S2,.UCBST(S1),UC.KTP ;GET THE CONTROLLER TYPE
MOVEM S2,ACTSTR+US$CTY ;SAVE IT
MOVEI S1,ACTSTR ;GET THE MESSAGE ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT
MOVX S1,US$DTM+1 ;GET THE MSG LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT
MOVX S1,SI.FLG+SP.ACT ;GET SPECIAL PID 'ACTDAE'
MOVEM S1,G$SAB##+SAB.SI ;SAVE IT
SETZM G$SAB##+SAB.PD ;NO PID HERE
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
LOAD P1,.VLPTR(P1),VL.NXT ;GET THE SECONDARY VOL BLK ADDRESS
JUMPN P1,STRM.1 ;CONTINUE IF MORE
$RETT ;RETURN IF NONE
SUBTTL I$DMNT - DECtape mount accounting routines
; I$DDSM - " " " " " " "
;CALL: S1/ The VSL Address
; AP/ The MDR Address
;
;RET: True Always
INTERN I$DMNT ;GLOBALIZE DECTAPE MOUNT ENTRY POINT
INTERN I$DDSM ;GLOBALIZE DECTAPE DISMOUNT ENTRY POINT
I$DMNT: SKIPA S2,[UGDTM$] ;GET 'MOUNT' MESSAGE TYPE
I$DDSM: MOVX S2,UGDTD$ ;GET 'DISMOUNT' MESSAGE TYPE
SKIPE DEBUGW ;ARE WE DEBUGGING ???
$RETT ;YES,,RETURN
PUSHJ P,.SAVE1 ;YES,,SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE VSL ADDRESS
MOVE S1,S2 ;GET THE MSG TYPE IN S1
PUSHJ P,ACTINI ;PERFORM ACCOUNTING INITIALIZATION
MOVE S1,.VSCRE(P1) ;GET THE CREATION DATE
MOVEM S1,ACTSTR+UD$CDT ;SAVE IT
MOVE S1,.VSSCH(P1) ;GET THE SCHEDULED DATE
MOVEM S1,ACTSTR+UD$SDT ;SAVE IT
MOVE S1,G$NOW## ;GET THE SERVICED DATE
MOVEM S1,ACTSTR+UD$VDT ;SAVE IT
MOVE S1,.VSUCB(P1) ;GET THE UCB ADDRESS
MOVE S1,.UCBNM(S1) ;GET THE DEVICE NAME
MOVEM S1,ACTSTR+UD$DEV ;SAVE THE DEVICE NAME
FACT< MOVEM S1,FACTBL+10 > ;STORE FOR DAEMON ALSO
LOAD S1,.VSCVL(P1),VS.OFF ;GET THE OFFSET TO THE CURRENT VOLUME
ADDI S1,.VSVOL(P1) ;POINT TO THE VOL BLK ADDRESS
MOVE S1,0(S1) ;AND LOAD IT
MOVE S2,.VLNAM(S1) ;GET THE VOLID
MOVEM S2,ACTSTR+UD$VID ;SAVE IT
LOAD S1,ACTSTR+.MSTYP,MS.TYP ;GET THE MESSAGE TYPE
LOAD S2,.MSTYP(M),MS.CNT ;[1165] GET LENGTH OF MESSAGE FROM MONITOR
CAIN S1,UGDTD$ ;[1165] IS IT A DISMOUNT ???
CAIG S2,.TDMIN ;[1165] DOES IT CONTAIN NEW STATISTICS STUFF?
JRST DMNT.1 ;NO,,SEND THE MESSAGE OFF
MOVE S1,.TDDTR(M) ;[1165] GET DECTAPE READS
MOVEM S1,ACTSTR+UD$DRD ;[1165] STORE
MOVE S1,.TDDTW(M) ;[1165] GET DECTAPE WRITES
MOVEM S1,ACTSTR+UD$DWR ;[1165] STORE
SKIPA S1,[UD$DWR+1] ;GET THE MSG LENGTH
DMNT.1: MOVX S1,UD$RID+1 ;GET THE MSG LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT
MOVEI S1,ACTSTR ;GET THE MESSAGE ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT
MOVX S1,SI.FLG+SP.ACT ;GET SPECIAL PID 'ACTDAE'
MOVEM S1,G$SAB##+SAB.SI ;SAVE IT
SETZM G$SAB##+SAB.PD ;NO PID HERE
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
FACT< MOVE S1,[14,,FACTBL-1] ;LENGTH,,ADDR OF FACT BLOCK
DAEMON S1, ;WRITE FACT FILE
JFCL > ;REALLY OUGHT TO COMPLAIN
$RETT ;RETURN
SUBTTL I$VACT - ACCT DAEMON ACCT VALIDATION MSG PROCESSOR
;CALL: M/MESSAGE ADDRESS
;
;RET: TRUE ALWAYS
ACTFMT==6 ;PROFILE FORMAT VERSION WE KNOW ABOUT
I$VACT: DOSCHD ;FORCE ANOTHER SCHEDULING PASS
SETZM VACT.W ;CLEAR EQ REWRITE FLAG
PUSHJ P,.SAVE2 ;[1471] SAVE P1 & P2 FOR A MINUTE
HLRZ S1,UC$ACK(M) ;GET THE OBJECT TYPE
PUSHJ P,A$OB2Q## ;GET THE QUEUE HEADER
JUMPF VACT.O ;GO COMPLAIN ABOUT BAD OBJECT TYPE
LOAD P1,.QHLNK(S1),QH.PTF ;GET POINTER TO FIRST QE ENTRY
HRRZ S2,UC$ACK(M) ;GET THE REQUEST ID
SKIPA
VACT.1: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT QE ENTRY ADDRESS
JUMPE P1,.RETT ;NOT THERE,,JUST RETURN
CAME S2,.QERID(P1) ;FIND THE QE WE WANT ???
JRST VACT.1 ;NO,,TRY NEXT
MOVE S1,.QESEQ(P1) ;GET THE QE STATUS BITS
MOVX S2,%VALID ;GET ACCOUNT VALIDATION COMPLETE STATUS
STORE S2,S1,QE.ACT ;SAVE IT
MOVE S2,UC$RES(M) ;GET THE VALIDATION CODE
HLRZ TF,UC$ACK(M) ;GET OBJECT CODE AGAIN
CAIE TF,.OTBAT ;BATCH?
CAXN S2,UGTRU$ ;IS THE ACCOUNT STRING VALID ???
TRNA ;BATCH ALWAYS VALID
TXO S1,QE.IAS ;NO,,LITE INVALID ACCOUNT STRING
MOVEM S1,.QESEQ(P1) ;RESTORE QE STATUS BITS
HRLI S1,UC$ACT(M) ;GET ACCOUNT STRING RETURNED BY ACTDAE
HRRI S1,.QEACT(P1) ;POINT TO QE
CAXN S2,UGTRU$ ;SUCESSFUL VALIDATION?
BLT S1,.QEACT+7(P1) ;YES--REMEMBER NEW ACCOUNT STRING
;Here to default .EQUSR and .EQBOX from user profile it needed.
MOVEI P2,UGTRU$ ;[1471] GET SUCCESS RESPONSE CODE
CAME P2,UC$PRF(M) ;[1471] PROFILE PRESENT?
$RETT ;[1471] NO, DONE
MOVEI S1,ACTFMT ;[1471] VERSION WE EXPECT
LOAD S2,UC$PRO+.AEVRS(M),AE.VRS ;[1471] VERSION WE WERE GIVEN
CAIE S1,(S2) ;[1471] COMPARE
JRST VACT.V ;[1471] GO COMPLAIN ABOUT SKEW
SKIPN UC$PRO+.AEPNM(M) ;"PERSONAL NAME" IN PROFILE?
SKIPE UC$PRO+.AEBOX(M) ;WHAT ABOUT "DISTRIBUTION LOC"?
JRST VACT.2 ;YES
SKIPN UC$PRO+.AELOG(M) ;DEFAULT LOG FILE?
$RETT ;NO--DONE
VACT.2: LOAD S1,.QESTN(P1),QE.DPA ;GET THE DPA
PUSHJ P,F$RDRQ## ;READ THE REQUEST
JUMPF .RETT ;IF FAILURE, CATCH IT SOMEWHERE ELSE
MOVE P2,S1 ;SAVE THE ADDRESS
SKIPN .EQUSR(P2) ;PERSONAL NAME IN EQ?
SKIPN UC$PRO+.AEPNM(M) ;NO, IS THERE A DEFAULT IN PROFILE?
JRST VACT.3 ;NO DEFAULT
MOVSI S1,.EQUSR(P2) ;POINT TO START OF STORAGE
HRRI S1,.EQUSR+1(P2) ;MAKE A BLT POINTER
SETZM .EQUSR(P2) ;CLEAR FIRST WORD
BLT S1,.EQUSR+.APNLW-1(P2) ;CLEAR OUT ENTIRE BLOCK
HRRZ S1,UC$PRO+.AEPNM(M) ;GET RELATIVE OFFSET OF BLOCK
ADDI S1,UC$PRO(M) ;INDEX INTO PROFILE
HRLZS S1 ;PUT IN LH
HRRI S1,.EQUSR(P2) ;MAKE A BLT POINTER
HLRE S2,UC$PRO+.AEPNM(M) ;GET NEGATIVE LENGTH OF BLOCK
MOVMS S2 ;MAKE POSITIVE
ADDI S2,.EQUSR(P2) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY PERSONAL NAME
AOS VACT.W ;EQ NEEDS REWRITING
VACT.3: SKIPN .EQBOX(P2) ;DISTRIBUTION LOCATION IN EQ?
SKIPN UC$PRO+.AEBOX(M) ;NO, IS THERE A DEFAULT IN PROFILE?
JRST VACT.4 ;NO DEFAULT
MOVSI S1,.EQBOX(P2) ;POINT TO START OF STORAGE
HRRI S1,.EQBOX+1(P2) ;MAKE A BLT POINTER
SETZM .EQBOX(P2) ;CLEAR FIRST WORD
BLT S1,.EQBOX+.ADLLW-1(P2) ;CLEAR OUT ENTIRE BLOCK
HRRZ S1,UC$PRO+.AEBOX(M) ;GET RELATIVE OFFSET OF BLOCK
ADDI S1,UC$PRO(M) ;INDEX INTO PROFILE
HRLZS S1 ;PUT IN LH
HRRI S1,.EQBOX(P2) ;MAKE A BLT POINTER
HLRE S2,UC$PRO+.AEBOX(M) ;GET NEGATIVE LENGTH OF BLOCK
MOVMS S2 ;MAKE POSITIVE
ADDI S2,.EQBOX(P2) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY DISTRIBUTION LOCATION
AOS VACT.W ;EQ NEEDS REWRITING
VACT.4: MOVE S1,P2 ;POINT TO THE EQ
PUSHJ P,DLOGFL ;DO DEFAULT LOG FILE PROCESSING
SKIPN VACT.W ;NEED TO REWRITE THE EQ?
JRST VACT.5 ;NO
MOVE S1,P2 ;POINT TO THE EQ
PUSHJ P,F$WRRQ## ;REWRITE THE REQUEST
LOAD S2,.QESTN(P1),QE.DPA ;GET THE OLD DPA
STORE S1,.QESTN(P1),QE.DPA ;STORE THE NEW ONE
MOVE S1,S2 ;LOAD THE OLD ONE INTO S1
PUSHJ P,F$RLRQ## ;RELEASE THE REQUEST
VACT.5: MOVE S1,P2 ;GET THE PAGE
PUSHJ P,M%RPAG ;RELEASE IT
$RETT
VACT.W: BLOCK 1 ;NON-ZERO IF EQ NEEDS REWRITING
VACT.A: ASCIZ /Accounting system error/
VACT.F: ITEXT (<Wrong profile format
Expecting format ^O/S1/ but received ^O/S2/>)
VACT.O: $WTO (<^T/VACT.A/>,<Unknown ACK code ^O/S1/>,,<$WTFLG(WT.SJI)>)
$RETT ;RETURN
VACT.V: $WTO (<^T/VACT.A/>,<^I/VACT.F/>,,<$WTFLG(WT.SJI)>)
$RETT ;RETURN
; HERE TO LOAD THE DEFAULT LOG FILE IF NEEDED
DLOGFL: HLRZ T1,UC$ACK(M) ;GET OBJECT TYPE
CAIE T1,.OTBAT ;BATCH?
POPJ P, ;NO - COMPLETELY IGNORE IT
LOAD T1,.EQSPC(S1),EQ.NUM ;YES- GET NUMBER OF FILES
SKIPE UC$PRO+.AELOG(M) ;HAVE A DEFAULT LOG FILE?
CAIE T1,2 ;EXACTLY 2 FILES?
JRST DLOG.7 ;NO - DON'T BOTHER.
GETLIM T1,.EQLIM(S1),DLOG ;YES - GET DEFAULT LOG FILE BIT
JUMPE T1,.POPJ ;JUMP IF NOT SET
MOVEI T1,(S1) ;COPY MESSAGE ADDRESS TO T1
LOAD T2,.EQLEN(S1),EQ.LOH ;GET LENGTH OF HEADER
ADDI T1,(T2) ;ADVANCE TO FIRST FP
LOAD T2,.FPLEN(T1),FP.LEN ;GET LENGTH OF FP
ADDI T1,(T2) ;ADVANCE TO FIRST FD
LOAD T2,.FDLEN(T1),FD.LEN ;GET LENGTH OF FIRST FD
ADDI T1,(T2) ;ADVANCE TO SECOND FP
MOVE T2,.FPINF(T1) ;GET THE STATUS BITS
TXNN T2,FP.FLG ;IS THIS THE LOG FILE?
JRST DLOG.7 ;NO - MUST BE CONFUSED (LEAVE IT BE...)
LOAD T2,.FPLEN(T1),FP.LEN ;YES- GET LENGTH OF 2ND FP
ADDI T1,(T2) ;ADVANCE TO 2ND FD
MOVE T2,UC$PRO+.AELOG(M) ;GET OFFSET TO FILESPEC
ADDI T2,UC$PRO(M) ;INDEX INTO PROFILE
;NOW THAT WE'VE DONE ALL THAT, WE COPY WHAT WE NEED TO FROM USER PROFILE
;TO LOGFILE ENTRY. WE'LL ONLY COPY NON-BLANK STUFF. ALSO, WE WILL HAVE TO
;MAKE SURE THAT, IF SFDS ARE INVOLVED, WE DO THE RIGHT THING.
;SINCE THE USER PROFILE CAN CONCEIVABLY CONTAIN ANY OF:
;
; DEV:FILNAM.EXT[PROJ,PROG,SFD1,SFD2,SFD3,SFD4,SFD5]
;
;EXCEPT FOR THE PUNCTUATION, WE HAVE TO BE SMART IN WHAT WE COPY.
;CHECK AND MOVE THE NORMAL STUFF FIRST, DON'T MOVE A FIELD UNLESS IT
;IS NONZERO.
DLOG.1: MOVE T3,(T2) ;GET STRUCTURE
JUMPE T3,DLOG.2 ;JUMP IF NONE SPECIFIED
MOVEM T3,.FDSTR(T1) ;STORE IT
AOS VACT.W ;EQ NEEDS REWRITING
DLOG.2: AOBJP T2,.POPJ ;RETURN IF END OF FILESPEC
MOVE T3,(T2) ;GET FILE NAME
JUMPE T3,DLOG.3 ;JUMP IF THERE ISN'T ONE
MOVEM T3,.FDNAM(T1) ;STORE THAT
AOS VACT.W ;EQ NEEDS REWRITING
DLOG.3: AOBJP T2,.POPJ ;RETURN IF END OF FILESPEC
HLLZ T3,(T2) ;GET
JUMPE T3,DLOG.4 ;JUMP IF THERE ISN'T AN EXTENSION
MOVEM T3,.FDEXT(T1) ;STORE THE SUCKER
AOS VACT.W ;EQ NEEDS REWRITING
DLOG.4: AOBJP T2,.POPJ ;RETURN IF END OF FILESPEC
MOVE T3,(T2) ;GET THE PPN
JUMPE T3,DLOG.5 ;JUMP IF NONE SET
MOVEM T3,.FDPPN(T1) ;STORE IT
AOS VACT.W ;EQ NEEDS REWRITING
;HANDLE MOVING A SFD PATH IF SPECIFIED. CRITERIA OF THE MOVING IS
;AS FOLLOWS:
; IF 1ST SFD IS ZERO - DON'T BOTHER, NO DEFAULT SFD PATH
; IN USER PROFILE ENTRY.
; IF FD IS SHORT - DON'T BOTHER, FD IS TOO SMALL.
;IF THESE TWO TESTS ARE PASSED, START MOVING SFDS UNTIL ONE OF THE
;FOLLOWING HAPPENS:
; WE RUN OUT OF NONZERO SFDS IN THE PROFILE
; WE RUN OUT OF PATH SLOTS IN THE FD (FDMSIZ .LT. .FDLEN .LT. FDXSIZ)
; WE MOVE 5 SFDS (.FDLEN = FDXSIZ).
DLOG.5: SKIPN (T2) ;HAVE AN SFD?
POPJ P, ;NO - FINISH UP
LOAD T3,.FDLEN(T1),FD.LEN ;GET THE LENGTH OF THE FD
CAIG T3,FDMSIZ ;BIGGER THAN MINIMUM SIZE?
POPJ P, ;NO - NO SFDS PRESENT, FINISH UP
MOVE T4,T1 ;PUT A DUPLICATE FD PTR INTO T4
DLOG.6: MOVE T3,(T2) ;GET AN SFD
MOVEM T3,.FDPAT(T4) ;STORE IN FD PATH BLOCK
ADDI T4,1 ;INCREMENT DUPLICATE FD PTR
AOS VACT.W ;EQ NEEDS REWRITING
AOBJN T2,DLOG.6 ;DECREMENT COUNT & LOOP
POPJ P, ;ALL FINISHED
DLOG.7: MOVEI T2,0 ;CLEAR
STOLIM T2,.EQLIM(S1),DLOG ;THE DEFAULT LOG FILE BIT
AOS VACT.W ;NEED TO REWRITE THE EQ
POPJ P, ;RETURN
SUBTTL I$CACV - ROUTINE TO VALIDATE AN ACCT STRING DURING 'CREATE'
;CALL: S1/ The EQ Address
; AP/ The QE Address
;
;RET: True Always
I$CACV: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;SAVE THE EQ ADDRESS IN P1
LOAD S2,.EQROB+.ROBTY(P1) ;GET THE QUEUE TYPE
MOVX S1,UGVUP$ ;VALIDATE ACCT STRING, RETURN PROFILE
MOVEM S1,ACTMSG ;PUT MESSAGE FOR ACTDAE
MOVX S2,%VALRQ ;GET 'NEED ACCOUNT VALIDATION' STATUS
STORE S2,.EQSEQ(P1),EQ.ACT ;LITE IT IN THE EQ
LOAD S2,.EQAFT(P1) ;GET THE CREATION DATE OF THIS REQUEST
CAMLE S2,G$NOW## ;IS IT IN THE FURURE ???
$RETT ;YES,,JUST RETURN
MOVX S2,%VALPD ;GET VALIDATION PENDING STATUS
STORE S2,.EQSEQ(P1),EQ.ACT ;SAVE IT
LOAD S2,.EQOID(P1) ;GET THE OWNERS PPN
STORE S2,ACTPPN ;SAVE IT IN THE MESSAGE
LOAD S2,.EQRID(P1) ;GET THE REQUEST ID
HRL S2,.EQROB+.ROBTY(P1) ;ADD IN OBJECT TYPE
MOVEM S2,ACTACK ;SAVE IT AS THE ACK CODE
MOVEI S1,.EQACT(P1) ;POINT TO THE USERS ACCOUNT STRING
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVE S2,[POINT 7,ACTSTR] ;GET OUTPUT BYTE POINTER
CACV.1: ILDB TF,S1 ;COPY THE ACCOUNT STRING
IDPB TF,S2 ; TO THE ACCT VALIDATION MESSAGE
JUMPN TF,CACV.1 ;CONTINUE TILL ASCIZ
MOVX S1,UV$MAX ;GET ACCT VALIDATION MSG LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SET IT IN THE SAB
MOVX S1,SI.FLG+SP.ACT ;GET ACCOUNTING DAEMON SPECIAL INDEX
MOVEM S1,G$SAB##+SAB.SI ;SET IT IN THE SAB
MOVEI S1,ACTMSG ;GET THE ACCOUNT MESSAGE ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SET IT IN THE SAB
SETZM G$SAB##+SAB.PD ;CLEAR RECIEVERS PID
PUSHJ P,C$SEND## ;VALIDATE THE ACCOUNT STRING
$RETT ;AND RETURN
SUBTTL I$SACV - ROUTINE TO VALIDATE AN ACCT STRING DURING 'SCHEDULING'
;CALL: S1/ The EQ Address
; AP/ The QE Address
;
;RET: True Always
I$SACV: LOAD TF,.QESEQ(AP),QE.IAS ;GET 'INVALID ACCT STRING' BIT
STORE TF,.EQSEQ(S1),EQ.IAS ;SAVE IT IN THE EQ
$RETT ;AND RETURN
SUBTTL I$ACTV - ROUTINE TO VALIDATE AN ACCOUNT STRING
;CALL: S1/ The QE Address
;
;RET: True Always
;This routine validates an account string using the QE as the
;account string source.
I$ACTV: LOAD TF,.QESEQ(S1),QE.ACT ;GET THE ACCT VALIDATION STATUS
CAXN TF,%VALRQ ;IS VALIDATION REQUIRED ???
JRST ACTV.1 ;YES,,GO DO IT...
CAXN TF,%VALID ;IS THE ACCOUNT VALID ???
$RETT ;YES,,RETURN OK
$RETF ;NO,,WAIT FOR ACTDAE'S ACK
ACTV.1: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;SAVE THE QE ADDRESS
LOAD S2,.QEROB+.ROBTY(P1) ;GET THE QUEUE TYPE
CAIN S2,.OTBAT ;IS IT BATCH ???
$RETT ;YES, NOTHING TO DO
MOVX S2,UGVUP$ ;GET MESSAGE TYPE
MOVEM S2,ACTMSG ;SAVE IN MESSAGE
LOAD S2,.QEOID(P1) ;GET THE OWNERS PPN
STORE S2,ACTPPN ;SAVE IT IN THE MESSAGE
LOAD S2,.QERID(P1) ;GET THE REQUEST ID
HRL S2,.QEROB+.ROBTY(P1) ;ADD IN OBJECT TYPE
MOVEM S2,ACTACK ;SAVE IT AS THE ACK CODE
MOVEI S1,.QEACT(P1) ;POINT TO THE USERS ACCOUNT STRING
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVE S2,[POINT 7,ACTSTR] ;GET OUTPUT BYTE POINTER
ACTV.2: ILDB TF,S1 ;COPY THE ACCOUNT STRING
IDPB TF,S2 ; TO THE ACCT VALIDATION MESSAGE
JUMPN TF,ACTV.2 ;CONTINUE TILL ASCIZ
MOVX S1,UV$MAX ;GET ACCT VALIDATION MSG LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SET IT IN THE SAB
MOVX S1,SI.FLG+SP.ACT ;GET ACCOUNTING DAEMON SPECIAL INDEX
MOVEM S1,G$SAB##+SAB.SI ;SET IT IN THE SAB
MOVEI S1,ACTMSG ;GET THE ACCOUNT MESSAGE ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SET IT IN THE SAB
SETZM G$SAB##+SAB.PD ;CLEAR RECIEVERS PID
PUSHJ P,C$SEND## ;VALIDATE THE ACCOUNT STRING
MOVX S1,%VALPD ;GET VALIDATION PENDING STATUS
STORE S1,.QESEQ(P1),QE.ACT ;SAVE IT IN THE QE
$RETF ;AND RETURN
SUBTTL I$DFMR - ROUTINE TO FILL IN SYSTEM DEPENDENT MDR DATA
;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 ;SAVE THE MDR ADDRESS
DMOVE S1,.MMUSR(M) ;GET THE USERS NAME IN S1 & S2
DMOVEM S1,.MRNAM(P1) ;SAVE IT
MOVE S1,G$LNAM## ;GET THE HOST NODE NAME
MOVEM S1,.MRNOD(P1) ;SAVE IT FOR NOW
LOAD S1,G$PRVS##,MD.PJB ;GET THE USERS JOB NUMBER
PUSHJ P,GETTTY ;GET TTY INFO
STORE S2,S1,MR.TNO ;CREATE LINE DESGINATOR,,LINE NUMBER
MOVEM S1,.MRTTY(P1) ;SAVE TERMINAL DESIGNATOR,,LINE NUMBER
HLRZ S1,S2 ;GET 0,,NODE NUMBER
PUSHJ P,N$NODE## ;LOCATE IT IN OUR DATA BASE
MOVE S1,NETNAM(S2) ;GET THE NODE NAME
MOVEM S1,.MRNOD(P1) ;SAVE IT
$RETT ;RETURN
SUBTTL I$QCDI - ROUTINE TO PROCESS CONNECTED DIRECTORY ON SHORT CREATES
;CALL: S1/ The Connected Directory (PATH) Block Address
; S2/ The EQ Page Address
;
;RET: True if a valid block
I$QCDI: PUSHJ P,.SAVE2 ;SAVE P1 & P2
DMOVE P1,S1 ;SAVE THE CALLING ARGS
LOAD S1,ARG.HD(P1),AR.LEN ;GET THE BLOCK LENGTH
CAIL S1,2 ;MUST BE GREATER THEN 1
CAILE S1,7 ;AND LESS THEN 7
PJRST E$IPB## ;NO GOOD,,RETURN AN ERROR
SUBI S1,1 ;GET THE BLOCK DATA LENGTH
HRLI S2,ARG.DA(P1) ;GET THE BLOCK DATA ADDRESS
HRRI S2,.EQPAT(P2) ;GET THE DESTINATION ADDRESS
ADDI S1,.EQPAT(P2) ;GET THE DESTINATION END ADDRESS
BLT S2,-1(S1) ;COPY THE PATH BLOCK ACROSS
$RETT ;AND RETURN
SUBTTL I$MNTR - JUST A NOOP ON THE -10
I$MNTR: $RETT ;JUST RETURN TRUE
SUBTTL I$GOFR - ROUTINE TO PROCESS [SYSTEM]GOPHER IPCF MESSAGES
;CALL: M/ The Message Address
;
;RET: Through the Function Processing Routine
I$GOFR: MOVE S1,G$ENT## ;GET THE MDB ADDRESS
MOVE S1,MDB.FG(S1) ;GET THE MDB FLAG BITS
TXNE S1,<77B29> ;IS THIS A RETURNED MESSAGE ???
$RETT ;YES,,JUST RETURN
MOVEI S1,<MD.PJH-MD.PJB> ;GET MASK TO CLEAR JCH
ANDCAM S1,G$PRVS## ;CLEAR JCH
LOAD S1,.MSFLG(M),MF.ACK ;GET THE USER ACK BIT
MOVEM S1,G$ACK## ;AND SAVE IT
MOVX S1,.QBFNC ;NO,,GET THE FUNCTION BLOCK TYPE
PUSHJ P,A$FNDB## ;FIND IT IN THE MESSAGE
JUMPF ERROR ;NOT THERE,,THATS AN ERROR
MOVE S2,0(S1) ;GET THE FUNCTION CODE
CAILE S2,0 ;LESS OR EQUAL TO 0
CAILE S2,GFRLEN ; OR GREATER THEN MAX FUNCTION
SETZM S2 ;YES,,FORCE AN ERROR
PJRST @GFRTAB(S2) ;NO,,GO PROCESS THE MESSAGE
GFRTAB: ERROR ;FUNCTION 0 INVALID FUNCTION CODE
QUEUE ;FUNCTION 1 PRINT
QUEUE ;FUNCTION 2 PUNCH ON CARDS
QUEUE ;FUNCTION 3 PUNCH ON PAPER TAPE
QUEUE ;FUNCTION 4 PLOT
QUEUE ;FUNCTION 5 SUBMIT
MOUNT ;FUNCTION 6 ALLOCATE
MOUNT ;FUNCTION 7 DEALLOCATE
MOUNT ;FUNCTION 10 MOUNT
MOUNT ;FUNCTION 11 DISMOUNT
ERROR ;FUNCTION 12 WTO
ERROR ;FUNCTION 13 WTOR
ERROR ;FUNCTION 14 VALIDATE ACCOUNT STRING
ERROR ;FUNCTION 15 ACCOUNTING MESSAGE
ERROR ;FUNCTION 16 CATALOG DAEMON MESSAGE
ERROR ;FUNCTION 17 MAIL MESSAGE
QUEUE ;FUNCTION 20 EVENT CREATE
GFRLEN==.-GFRTAB ;TABLE LENGTH
;Here if an error occurs
ERROR: PUSHJ P,E$IFC## ;SET INVALID FUNCTION CODE
PUSHJ P,G$STGS## ;GEN THE ACK AND SEND IT
$RETT ;RETURN
;Here to process QUEUE related messages
QUEUE: SETZM TF ;CLEAR TF FOR A MINUTE
CAXN S2,.QUPRT ;WAS IT PRINT ???
MOVX TF,.OTLPT ;YES,,MAKE IT PRINT
CAXN S2,.QUCDP ;WAS IT CARD PUNCH ???
MOVX TF,.OTCDP ;YES,,MAKE IT CARD PUNCH
CAXN S2,.QUPTP ;WAS IT PAPER TAPE ???
MOVX TF,.OTPTP ;YES,,MAKE IT PAPER TAPE
CAXN S2,.QUPLT ;WAS IT PLOT ???
MOVX TF,.OTPLT ;YES,,MAKE IT PLOT
CAXN S2,.QUBAT ;WAS IT BATCH ???
MOVX TF,.OTBAT ;YES,,MAKE IT BATCH
JUMPE TF,ERROR ;SHOULD NOT HAPPEN !!!
MOVEM TF,0(S1) ;SAVE THE OBJECT TYPE
PUSHJ P,Q$CRQE## ;TRY TO CREATE A QUEUE ENTRY
SKIPE G$ERR## ;WAS THERE AN ERROR ???
PUSHJ P,G$STGS## ;YES,,GEN THE ACK AND SEND IT
$RETT ;RETURN
;Here to process MOUNT related messages
MOUNT: PUSHJ P,.SAVE4 ;SAVE P1 - P4
CAXE S2,.QUDAL ;IS THIS A DEALLOCATE
CAXN S2,.QUDIS ; OR A DISMOUNT ???
JRST MOUN.7 ;YES,,THEN GEN A DISMOUNT/DEALLOCATE MSG
;Here to gen a MOUNT/ALLOCATE message
SETZM P2 ;ASSUME A 'MOUNT' REQUEST
CAXN S2,.QUALC ;UNLESS THIS IS AN ALLOCATE
MOVX P2,ME%ALC ;THEN MAKE THIS AN ALLOCATE REQUEST
PUSHJ P,M%GPAG ;GET A PAGE TO BUILD THE MSG IN
MOVE P1,S1 ;SAVE ITS ADDRESS
SETZM G$BLKA## ;START RECIEVED MSG SCAN AT BEGINNING
MOVE S1,[.MMHSZ,,.QIFNC] ;GET HDR LENGTH,,INTERNAL FUNCTION
MOVEM S1,.MSTYP(P1) ;START THE MESSAGE
MOVE S1,.MSCOD(M) ;GET [SYSTEM]GOPHER'S ACK CODE
MOVEM S1,.MSCOD(P1) ;SET IT IN THE NEW MESSAGE
MOVEI P3,.MMHSZ(P1) ;POINT TO THE FIRST 'ME' ENTRY
SETZM P4 ;NO DATA BLOCKS YET !!!
MOUN.1: PUSHJ P,A$GBLK## ;GET A MESSAGE BLOCK
JUMPF MOUN.4 ;NO MORE,,TRY THE MOUNT/ALLOCATE
CAXE T1,.QBFNC ;IS THIS THE FUNCTION TYPE BLOCK
CAXN T1,.QBNOD ;OR THE LOCATED NODE BLOCK ???
JRST MOUN.1 ;YES,,IGNORE THEM
CAXN T1,.QBACT ;ACCOUNT STRING BLOCK ???
JRST MOUACT ;YES,,PROCESS IT
CAXN T1,.QBNAM ;USER NAME BLOCK ???
JRST MOUNAM ;YES,,PROCESS IT
CAXN T1,.QBNOT ;/NOTIFY BLOCK ???
JRST MOUNOT ;YES,,PROCESS IT
CAXN T1,.QBMFG ;MOUNT FLAG BITS ???
JRST MOUMFG ;YES,,PROCESS IT
SETZM S1 ;CLEAR S1
CAXN T1,.QBVSN ;VOLUME SET NAME BLOCK ???
MOVX S1,.TMSET ;YES,,GET CORRECT BLOCK TYPE
CAXN T1,.QBLNM ;LOGICAL NAME BLOCK ???
MOVX S1,.TMLNM ;YES,,GET CORRECT BLOCK TYPE
CAXN T1,.QBVOL ;VOLUME ID'S BLOCK ???
MOVX S1,.TMVOL ;YES,,GET CORRECT BLOCK TYPE
CAXN T1,.QBDEN ;DENSITY BLOCK ???
MOVX S1,.TMDEN ;YES,,GET CORRECT BLOCK TYPE
CAXN T1,.QBTRK ;TRACK BLOCK ???
MOVX S1,.TMDRV ;YES,,GET CORRECT BLOCK TYPE
CAXN T1,.QBLTP ;LABEL TYPE BLOCK ???
MOVX S1,.TMLT ;YES,,GET CORRECT BLOCK TYPE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CAXN T1,.QBRMK ;REMARK BLOCK ???
MOVX S1,.TMRMK ;YES,,GET CORRECT BLOCK TYPE
JUMPE S1,MOUN.5 ;TYPE NOT DEFINED,,THATS AN ERROR
MOVEI T3,-ARG.DA(T3) ;RE-POSITION TO THE BLOCK HEADER
STORE S1,ARG.HD(T3),AR.TYP ;SAVE THE RECODED BLOCK TYPE
;Here to setup a new ME for a .QBVSN (.TMSET) block
CAXE S1,.TMSET ;IS THIS THE VOLUME SET BLOCK ???
JRST MOUN.3 ;NO,,SKIP THIS
LOAD S1,.MEHDR(P3),AR.LEN ;GET THE CURRENT 'ME' LENGTH
ADD P3,S1 ;POINT TO THE NEXT 'ME' ENTRY
AOS .MMARC(P1) ;BUMP THE 'ME' COUNT BY 1
MOVEI P4,.MEHSZ(P3) ;POINT TO THE 'ME' BLOCK AREA
MOVSI S1,.MEHSZ ;GET THE 'ME' HEADER LENGTH,,0
ADDM S1,.MEHDR(P3) ;NO,,BUMP THE ME LENGTH
ADDM S1,.MSTYP(P1) ;AND BUMP THE TOTAL MESSAGE LENGTH
MOVEM P2,.MEFLG(P3) ;ALSO SET MOUNT ENTRY TYPE (MOUNT/ALLOC)
MOUN.3: JUMPE P4,[PUSHJ P,E$IVN## ;MUST HAVE PROCESSED A VSN BLOCK !!!
JRST MOUN.5 ] ;IF NOT,,THATS AN ERROR
AOS .MECNT(P3) ;BUMP THE ENTRY BLOCK COUNT BY 1
MOVSS T3 ;GET SOURCE,,0
HRR T3,P4 ;GET SOURCE,,DESTINATION
ADD T2,P4 ;CALC END ADDRESS
BLT T3,-1(T2) ;COPY OLD MSG BLK TO NEW MSG
LOAD S1,ARG.HD(P4),AR.LEN ;GET THE BLOCK LENGTH
ADD P4,S1 ;CALC NEXT OUTPUT BLOCK ADDRESS
MOVSS S1 ;GET LENGTH,,0
ADDM S1,.MSTYP(P1) ;BUMP TOTAL MESSAGE LENGTH
ADDM S1,.MEHDR(P3) ;BUMP TOTAL MOUNT ENTRY LENGTH
JRST MOUN.1 ;GO GET THE NEXT BLOCK
;Here to try the MOUNT/ALLOCATE
MOUN.4: $SAVE <M> ;SAVE 'M'
MOVE M,P1 ;POINT TO OUR 'NEW' MESSAGE
MOVX S1,MM.GFR ;[1170] LITE "FROM [SYSTEM]GOPHER" BIT
SKIPE G$ACK## ;[1170] WAITING FOR ACK?
TXO S1,MM.WAT ;[1170] YES,,LITE WAITING FOR ACK BIT
IORM S1,.MMFLG(P1) ;LITE THE BITS
PUSHJ P,D$MOUNT## ;LETERRIP !!!
SKIPN G$ERR## ;ANY ERRORS ???
JRST MOUN.6 ;NO,,RETURN
;Here on an error
MOUN.5: SKIPN G$ERR## ;ANY ERROR YET ???
PUSHJ P,E$IMM## ;NO,,SET INVALID MOUNT MMSSAGE
PUSHJ P,G$STGS## ;GEN THE ACK AND SEND IT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOUN.6: MOVE S1,P1 ;GET THE PAGE ADDRESS BACK
PUSHJ P,M%RPAG ;RETURN IT
$RETT ;RETURN
;Here to gen DISMOUNT/DEALLOCATE message
MOUN.7: SETZM P2 ;DEFAULT TO DISMOUNT
CAXN S2,.QUDAL ;IS THIS A DEALLOCATE
MOVX P2,MM.DLC ;YES,,MAKE THIS DEALLOCATE
PUSHJ P,M%GPAG ;GET A PAGE TO BUILD THE MSG IN
MOVE P1,S1 ;SAVE ITS ADDRESS
SETZM G$BLKA## ;START RECIEVED MSG SCAN AT BEGINNING
MOVE S1,[.OHDRS,,.QIFNC] ;GET HEADER LENGTH,,INTERNAL CALL
MOVEM S1,.MSTYP(P1) ;START THE MESSAGE
MOVE S1,.MSCOD(M) ;GET [SYSTEM]GOPHER'S ACK CODE
MOVEM S1,.MSCOD(P1) ;SET IT IN THE NEW MESSAGE
MOVEM P2,.OFLAG(P1) ;SAVE THE DISMOUNT/DEALLOCATE FLAGS
MOVX S1,MM.GFR ;[1170] LITE "FROM [SYSTEM]GOPHER" BIT
SKIPE G$ACK## ;[1170] WAITING FOR ACK?
TXO S1,MM.WAT ;[1170] YES,,LITE THE BIT
IORM S1,.OFLAG(P1) ;[1170] LITE THE FLAG(S)
MOUN.8: PUSHJ P,A$GBLK## ;GET A MESSAGE BLOCK
JUMPF MOUN.9 ;NO MORE,,TRY THE MESSAGE
CAXE T1,.QBFNC ;IS THIS THE FUNCTION TYPE BLOCK
CAXN T1,.QBNOD ;OR THE LOCATED NODE BLOCK ???
JRST MOUN.8 ;YES,,IGNORE IT
CAXE T1,.QBACT ;ACCOUNT STRING BLOCK ???
CAXN T1,.QBNAM ;OR USER NAME BLOCK ???
JRST MOUN.8 ;YES,,IGNORE IT
CAXN T1,.QBMFG ;MOUNT FLAG BITS ???
JRST [LOAD S1,0(T3),QB.REM ;GET THE /REMOVE BIT
STORE S1,.OFLAG(P1),MM.REM ;SET/CLEAR IT
JRST MOUN.8 ] ;AND CONTINUE
CAXE T1,.QBVSN ;VOLUME SET NAME BLOCK ???
JRST [PUSHJ P,E$IFC## ;NO,,THEN INVALID CODE SPECIFIED
JRST MOUN.5 ] ;SET IT AND RETURN
AOS S1,.OARGC(P1) ;BUMP BLOCK COUNT
CAIE S1,1 ;CAN ONLY SPECIFY 1 VOL SET NAME !!!
JRST [PUSHJ P,E$MVB## ;GEN MULTIPLE VOL SET BLOCKS ERROR
JRST MOUN.5 ] ;SET IT AND RETURN
MOVX S1,.RCTVS ;GET VOLUME SET BLOCK TYPE
STORE S1,-ARG.DA(T3),AR.TYP ;AND SET IT FOR THIS MESSAGE
MOVE S1,T2 ;GET THE BLOCK LENGTH IN S1
CAILE S1,1 ;LENGTH MUST BE FROM 2 TO 11
CAILE S1,11 ;MUST BE REASONABLE !!!
JRST [PUSHJ P,E$IVN## ;NO,,GEN THE ERROR
JRST MOUN.5 ] ;SET IT AND RETURN
MOVSS S1 ;GET LENGTH,,0
ADDM S1,.MSTYP(P1) ;BUMP TOTAL MSG LENGTH
ADDI T2,.OHDRS+ARG.HD(P1) ;CALC END ADDRESS
MOVSI T3,-ARG.DA(T3) ;GET SOURCE,,0
HRRI T3,.OHDRS+ARG.HD(P1) ;GET SOURCE,,DESTINATION
BLT T3,-1(T2) ;COPY THE VOLUME SET NAME
JRST MOUN.8 ;AND CONTINUE
MOUN.9: $SAVE <M> ;SAVE 'M'
MOVE M,P1 ;POINT TO OUR 'NEW' MESSAGE
SKIPG .OARGC(M) ;MUST HAVE THE VSN BLOCK !!!
JRST [PUSHJ P,E$IVN## ;NO,,GEN THE ERROR
JRST MOUN.5 ] ;SET IT AND RETURN
PUSHJ P,D$DVS## ;LETERRIP !!!
SKIPE G$ERR## ;ANY ERROR ???
JRST MOUN.5 ;YES,,EXIT SENDING AN ACK
JRST MOUN.6 ;NO,,EXIT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOUACT: CAIN T2,1 ;ZERO-LENGTH ACCOUNT STRING?
JRST MOUN.1 ;YES (JUST THE HEADER)
CAIL T2,2 ;VALIDATE BLOCK LENGTH
CAILE T2,11 ;MUST BE BETWEEN 2 AND 11
JRST MOUN.5 ;NO,,THATS AN ERROR
ADDI T2,.MMUAS(P1) ;CALC END ADDRESS
MOVSS T3 ;GET SOURCE,,0
HRRI T3,.MMUAS(P1) ;GET SOURCE,,DESTINATION
BLT T3,-2(T2) ;COPY THE ACCOUNT STRING
JRST MOUN.1 ;AND CONTINUE
MOUNAM: CAILE T2,1 ;VALIDATE BLOCK LENGTH
CAILE T2,3 ;MUST BE BETWEEN 2 AND 3
JRST MOUN.5 ;NO,,THATS AN ERROR
ADDI T2,.MMUSR(P1) ;CALC END ADDRESS
MOVSS T3 ;GET SOURCE,,0
HRRI T3,.MMUSR(P1) ;GET SOURCE,,DESTINATION
BLT T3,-2(T2) ;COPY THE USER NAME
JRST MOUN.1 ;AND CONTINUE
MOUNOT: CAIE T2,2 ;VALIDATE BLOCK LENGTH (MUST BE 2)
JRST MOUN.5 ;NO,,THATS AN ERROR
MOVX S1,MM.NOT ;GET THE NOTIFY BIT
IORM S1,.MMFLG(P1) ;LITE IT
JRST MOUN.1 ;AND CONTINUE
MOUMFG: JUMPE P4,[PUSHJ P,E$IVN## ;MUST HAVE PROCESSED A VSN BLOCK !!!
JRST MOUN.5 ] ;IF NOT,,THATS AN ERROR
CAIE T2,2 ;VALIDATE BLOCK LENGTH (MUST BE 2)
JRST MOUN.5 ;NO,,THATS AN ERROR
MOVE T3,0(T3) ;LOAD UP THE FLAG BITS
MOVE S1,.MEFLG(P3) ;GET THE MOUNT ENTRY FLAG WORD
TXNE T3,QB.PAS ;IS /PASSIVE REQUESTED ???
TXO S1,SM%PAS ;YES,,SET IT
TXNE T3,QB.EXC ;/SINGLE (EXCLUSIVE) REQUESTED ???
TXO S1,SM%EXC ;YES,,SET IT
TXNE T3,QB.WLK ;WRITE LOCKED ???
TXO S1,TM%WLK ;YES,,SET IT
TXNE T3,QB.WEN ;WRITE ENABLED ???
TXO S1,TM%WEN ;YES,,SET IT
TXNE T3,QB.NOC ;IS /NOCREATE REQUESTED ???
TXO S1,SM%NOC ;YES,,SET IT
TXNE T3,QB.ARD ;WANT TO ALWAYS RECOMPUTE DISK USAGE?
TXO S1,SM%ARD ;YES
TXNE T3,QB.SCR ;IS /SCRATCH REQUESTED ???
TXO S1,TM%SCR!TM%WEN ;YES,,SET IT
MOVEM S1,.MEFLG(P3) ;SAVE THE ENTRY FLAG BITS
TXNN T3,QB.DSK+QB.TAP ;SPECIFY DISK OR TAPE ???
JRST MOUN.1 ;NO,,RETURN NOW
TXNE T3,QB.DSK ;SPECIFY DISK ???
MOVX S1,.MNTST ;YES,,SET STRUCTURE MOUNT
TXNE T3,QB.TAP ;SPECIFY TAPE ???
MOVX S1,.MNTTP ;YES,,SET TAPE MOUNT
STORE S1,.MEHDR(P3),AR.TYP ;SAVE THE MOUNT ENTRY TYPE
JRST MOUN.1 ;GET THE NEXT BLOCK
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 S1
MOVE S1,UNILST ;GET LIST NUMBER
MOVEI S2,3 ;AND ENTRY SIZE
PUSHJ P,L%CENT ;CREATE AN ENTRY
POP P,0(S2) ;GET STREAM NUMBER IN FIRST WORD
GETLIM S1,.QELIM(AP),UNIQ ;GET UNIQUE VALUE
STORE S1,1(S2) ;AND STORE IT
MOVE S1,.QEOID(AP) ;GET THE PPN
MOVEM S1,2(S2) ;STORE IT
$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'S ENTRY
MOVE S2,S1 ;PUT IT IN S2
MOVE S1,UNILST ;GET 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: MOVE S1,UNILST ;GET LIST NAME
PUSHJ P,L%FIRST ;POSITION TO THE BEGINNING
JUMPF .RETT ;EMPTY LIST WINS!!
UQCH.1: LOAD S1,.QEOID(AP) ;GET PPN FROM REQUEST
CAME S1,2(S2) ;MATCH?
JRST UQCH.2 ;NO, ON TO NEXT ENTRY
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.2: 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
STOPCD (USM,HALT,,<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.
;
;NOTE: WRITES "BOTH" MASTERS.
I$WRIT: MOVEM S1,WRIT.A ;SAVE BLOCK NUMBER
MOVEM S2,WRIT.B ;SAVE POINTER WORD
HLRZ S1,S2 ;GET THE LENGTH
SKIPLE S1 ;LE 0
CAILE S1,1000 ;OR GREATER THAN A PAGE?
STOPCD (WBL,HALT,,<Writing bad length>)
MOVNS S1 ;NEGATE IT
HRLZS S1 ;GET -LEN,,0
SUBI S2,1 ;MAKE ADR-1
HRR S1,S2 ;AND MAKE AN IOWD
MOVEM S1,WRIT.C ;SAVE IT
CLEARM WRIT.C+1 ;SET END OF LIST
WRIT.1: MOVE S1,WRIT.A ;GET BLOCK NUMBER BACK
USETO CMQ1,(S1) ;SET IT
OUT CMQ1,WRIT.C ;AND WRITE FILE 1
JRST WRIT.2 ;WIN!! GO ON
GETSTS CMQ1,S1 ;GET I/O STATUS
TXZN S1,IO.BKT ;RUN OUT OF ROOM?
STOPCD (PWE,HALT,,<Prime write error>)
SETSTS CMQ1,(S1) ;YES, CLEAR INDICATOR
MOVEI S1,12 ;LOOP 10 SECS
SLEEP S1, ;SLEEP SOME
JRST WRIT.1 ;AND TRY AGAIN
WRIT.2:
IFN FTRQUE,<
MOVE S1,WRIT.A ;GET BLOCK NUMBER BACK
USETO CMQ2,(S1) ;SET IT
OUT CMQ2,WRIT.C ;WRITE FILE 2
JRST WRIT.3 ;WIN! GO ON
GETSTS CMQ2,S1 ;GET I/O STATUS
TXZN S1,IO.BKT ;RUN OUT OF ROOM?
STOPCD (RWE,HALT,,<Redundant write error>)
SETSTS CMQ2,(S1) ;YES, CLEAR INDICATOR
MOVEI S1,12 ;LOOP 10 SECS
SLEEP S1, ;SLEEP SOME
JRST WRIT.2 ;AND TRY AGAIN
> ;END IFN FTRQUE
;"I$WRIT" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
WRIT.3: HLRZ S1,WRIT.B ;GET NUMBER OF WORDS
SUBI S1,1 ;ROUND DOWN
IDIVI S1,FSSBKS ;AND GET NUMBER OF BLOCKS
ADD S1,WRIT.A ;ADD IN DPA OF FIRST BLOCK
CAMG S1,G$NBW## ;GREATER THAN PREVIOUS LAST BLOCK?
$RETT ;NO, USING SAME SPACE
MOVEM S1,G$NBW## ;YES, SAVE AS GREATEST
MOVX S1,<FO.PRV!<CMQ1>B17!.FOURB>
MOVE S2,[1,,S1] ;LOAD ARGBLOCK
FILOP. S2, ;UPDATE THE RIB FOR THE FIRST ONE
STOPCD (EEP,HALT,,<Error expanding prime queue>)
IFN FTRQUE,<
MOVX S1,<FO.PRV!<CMQ2>B17!.FOURB>
MOVE S2,[1,,S1] ;LOAD THE ARGBLOCK
FILOP. S2, ;UPDATE THE RIB FOR THE SECOND ONE
STOPCD (EER,HALT,,<Error expanding redundant queue>)
> ;END IFN FTRQUE
$RETT ;AND RETURN
WRIT.A: BLOCK 1 ;LOCAL STORAGE
WRIT.B: BLOCK 1 ;LOCAL STORAGE
WRIT.C: BLOCK 2 ;LOCAL STORAGE
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: MOVEM S1,READ.A ;SAVE BLOCK NUMBER
MOVEM S2,READ.B ;SAVE IO-POINTER
USETI CMQ1,(S1) ;SET THE INPUT BLOCK
HLRZ S1,S2 ;GET THE LENGTH
MOVNS S1 ;NEGATE IT
HRLZS S1 ;GET -LEN,,0
SUBI S2,1 ;MAKE ADR-1
HRR S1,S2 ;MAKE AN IOWD
MOVEM S1,READ.C ;SAVE IT
CLEARM READ.C+1 ;SET END-OF-LIST
IN CMQ1,READ.C ;READ THE BLOCK
$RETT ;NO ERROR, SO RETURN GOOD RETURN NOW
GETSTS CMQ1,S1 ;I/O ERROR, GET THE STATUS
TXNE S1,IO.EOF ;WAS IT AN EOF?
STOPCD (REF,HALT,,<Reading end of file>)
STOPCD (RIE,HALT,,<Read I/O error>)
READ.A: BLOCK 1 ;LOCAL STORAGE
READ.B: BLOCK 1 ;LOCAL STORAGE
READ.C: BLOCK 2 ;LOCAL STORAGE
SUBTTL I$CRIP -- Create an index page in master file
;I$CRIP IS CALLED WHEN THE FAILSOFT SYSTEM DECIDES TO START A NEW FILE
; SECTION (INCLUDING THE VERY FIRST) TO WRITE OUT THE NEW INDEX
; PAGE INTO THE FILE. CALL WITH S1 CONTAINING THE BLOCK NUMBER OF
; THE PAGE, AND S2 CONTAINING THE ADDRESS OF THE PAGE.
I$CRIP: HRLI S2,FSSWPI ;GET LENGTH TO WRITE
PJRST I$WRIT ;AND WRITE IT OUT
SUBTTL I$OQUE -- Open master queue files
;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
; THE MASTER QUEUE FILE(S). OPENS ONE FILE IF FTRQUE IS
; OFF AND TWO IF FTRQUE IS ONE
I$OQUE: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,SETOQF ;SETUP CONSTANT PARAMETERS
MOVE P1,[MQFNM1] ;GET NAME OF PRIME QUEUE
MOVEM P1,.RBNAM(S2) ;STORE IT
SKIPE DEBUGW ;IF DEBUGGING,
SKIPA P1,.RBPPN(S2) ; GET DEFAULT DIRECTORY AND SKIP
MOVE P1,PRMDIR ;GET DIRECTORY OF PRIME QUEUE
MOVEM P1,.RBPPN(S2) ;STORE IT
MOVSI P1,CMQ1 ;GET CHANNEL FOR PRIME QUEUE
IORM P1,.FOFNC(S1) ;STORE IT
HRLI S1,6 ;GET LEN,,ADR
FILOP. S1, ;AND OPEN THE PRIME QUEUE!
JRST OQUE.1 ;DO SOME EVALUATION
MOVE S1,.RBSIZ(S2) ;GET THE SIZE OF FILE (WRITTEN)
ADDI S1,FSSBKS-1 ;ROUND UP
IDIVI S1,FSSBKS ;AND CONVERT TO BLOCKS
MOVEM S1,G$NBW## ;AND SAVE AS NUMBER OF BLOCKS WRITTEN
IFN FTRQUE,<
PUSHJ P,SETOQF ;SETUP CONSTANT PARAMETERS
MOVE P1,[MQFNM2] ;GET NAME OF REDUNDANT QUEUE
MOVEM P1,.RBNAM(S2) ;STORE IT
SKIPE DEBUGW ;IF DEBUGGING,
SKIPA P1,.RBPPN(S2) ; GET DEFAULT DIRECTORY AND SKIP
MOVE P1,REDDIR ;GET DIRECTORY OF REDUNDANT QUEUE
MOVEM P1,.RBPPN(S2) ;STORE IT
MOVSI P1,CMQ2 ;GET THE CHANNEL NUMBER
IORM P1,.FOFNC(S1) ;STORE IT
HRLI S1,6 ;GET LEN,,ADR
FILOP. S1, ;OPEN THE REDUNDANT QUEUE!!
STOPCD (COR,HALT,,<Cannot open redundant queue>)
> ;END IFN FTRQUE
SKIPE DEBUGW ;DEBUGGING?
$RETT ;YES - THEN DON'T SET QUESTR
MOVE S1,[.DCMAX,,ACTSTR] ;SET UP UUO AC
MOVEI S2,CMQ1 ;GET CHANNEL NUMBER
MOVEM S2,ACTSTR+.DCNAM ;SAVE AS THE ARGUMENT
DSKCHR S1, ;GET STRUCTURE NAME
$RETT ;STRANGE
MOVE S1,[.STQST,,ACTSTR+.DCSNM] ;SET UP AC
SETUUO S1, ;SET THE QUEUE STRUCTURE IN THE MONITOR
JFCL ;CAN'T
MOVE S1,ACTSTR+.DCSNM ;GET STR NAME
MOVEM S1,G$QSTR## ;SAVE
$RETT ;RETURN
;HERE ON A FILOP. FAILURE FOR THE PRIME QUEUE
OQUE.1: CAIN S1,ERFBM% ;SPECIAL CASE: FILE BEING MODIFIED
STOPCD (PQI,HALT,,<Prime queue is interlocked>)
STOPCD (COP,HALT,,<Cannot open prime queue>)
SUBTTL SETOQF -- Setup to OPEN master queue files
;SETOQF IS CALLED BY I$OQUE TO SETUP THE INVARIANT PART OF THE FILOP AND
; LOOKUP UUO BLOCKS. INTO THE LOOKUP BLOCK IT FILLS IN:
; BLOCK LENGTH
; FILE-NAME EXTENSION
; PROTECTION
; ESTIMATED LENGTH
; FILE STATUS BITS
;INTO THE FILOP BLOCK IT PUTS
; FILOP FUNCTION
; I/O STATUS
; FILE-STRUCTURE NAME
; ADDRESS OF LOOKUP BLOCK
;RETURN WITH S1 CONTAINING ADDRESS OF FILOP BLOCK AND S2 CONTAINING THE
; ADDRESS OF THE LOOKUP BLOCK
SETOQF: CLEARM SETO.A ;CLEAR FIRST WORD OF LOOKUP BLOCK
MOVE S1,[SETO.A,,SETO.A+1]
BLT S1,SETO.A+.RBSTS ;AND CLEAR THE REST
CLEARM SETO.B ;CLEAR THE FIRST WORD OF FILOP BLOCK
MOVE S1,[SETO.B,,SETO.B+1]
BLT S1,SETO.B+5 ;AND CLEAR THE REST
MOVEI S1,.RBSTS ;GET LENGTH OF LKP BLOCK
MOVEM S1,SETO.A+.RBCNT ;SAVE IT
MOVSI S1,'QSR' ;GET THE EXTENSION
MOVEM S1,SETO.A+.RBEXT ;SAVE IT
MOVSI S1,FSSPRT_9 ;GET FILE PROTECTION
MOVEM S1,SETO.A+.RBPRV ;STORE IT AWAY
MOVEI S1,1000 ;ESTIMATE 1 FILE SECTION
MOVEM S1,SETO.A+.RBEST ;SAVE IT
MOVX S1,RP.ABC ;ALWAYS BAD CHECKSUM
MOVEM S1,SETO.A+.RBSTS ;AND SAVE IT
MOVX S1,<FO.PRV+.FOSAU> ;SINGLE ACCESS UPDATE
MOVEM S1,SETO.B+.FOFNC ;SAVE FUNCTION WORD
MOVX S1,<UU.PHS+.IODMP> ;PHONLY DUMP MODE
MOVEM S1,SETO.B+.FOIOS ;SAVE STATUS
SKIPE DEBUGW ;ARE WE DEBUGGING?
SKIPA S1,[EXP DFSSTR] ;YES, USE DEBUGGING STRUCTURE
MOVX S1,FSSSTR ;OTHERWISE, GET THE STR NAME
MOVEM S1,SETO.B+.FODEV ;SAVE IT
SKIPN DEBUGW ;IF WE ARE NOT DEBUGGING,,
JRST SETO.1 ; RETURN NOW
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SETOM ACTSTR+.PTFCN ;SET MY JOB #,,READ PATH FCN
SETZM ACTSTR+.PTSWT ;NO SWITCHES
MOVE S1,[ACTSTR+.PTSWT,,ACTSTR+.PTSWT+1] ;GET SOURCE,,DEST
BLT S1,ACTSTR+.PTMAX-1 ;ZERO THE REST OF THE PATH BLOCK
MOVE S1,[.PTMAX,,ACTSTR] ;GET PATH. UUO PARM LIST
PATH. S1, ;GET USERS PATH
JRST SETO.1 ;IF AN ERROR,,JUST RETURN
MOVEI S1,ACTSTR ;POINT TO PATH BLOCK
MOVEM S1,SETO.A+.RBPPN ;SET IT IN THE FILOP. BLOCK
SETO.1: MOVEI S2,SETO.A ;GET ADDRESS OF LKP BLOCK
MOVEM S2,SETO.B+.FOLEB ;SAVE IT
MOVEI S1,SETO.B ;LOAD ADR OF FILOP BLOCK
$RETT ;AND RETURN
SETO.A: BLOCK .RBSTS+1 ;THE LOOKUP BLOCK
SETO.B: BLOCK 6 ;THE FILOP BLOCK
SUBTTL TAPE MOUNT MESSAGE DISPATCHER
INTERN I$OMNT ;MAKE IT GLOBAL
INTERN I$MINI ;A NOOP ON THE -10
INTERN I$KMNT ;KILL A USER MOUNT REQUEST
INTERN I$ISTR ;INITIALIZE SYSTEM STRUCTURE LIST
INTERN I$PERM ;MARK PERMANENT STRUCTURES AS SUCH
EXTERN TXTTBL ;TABLE OR ADRS OF ERROR TEXTS
EXTERN MDAOBJ ;MDA OBJECT BLOCK FOR $ACK
I$OMNT: SKIPN G$MDA## ;IS THERE MDA SUPPORT ???
JRST OMNT.3 ;NO,,SKIP THIS
MOVSI S1,-MNTLEN ;GET THE DISPATCH TABLE LENGTH
HRRI S1,MNTDSP ;AND THE TABLE ADDRESS
LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
OMNT.1: LOAD TF,0(S1),RHMASK ;GET THE DISPATCH TABLE MESSAGE TYPE
CAMN TF,S2 ;HAVE WE FOUND A MATCH ???
JRST OMNT.2 ;YES,,GO PROCESS IT
AOBJN S1,OMNT.1 ;CONTINUE THROUGH THE DISPATCH TABLE
JRST [$WTO(<Internal Error>,<Invalid Operator Mount Message Type ^O/S2/>,,$WTFLG(WT.SJI))
$RETT] ;KEEP RUNNING
OMNT.2: LOAD S1,0(S1),LHMASK ;GET THE MESSAGE PROCESSOR ADDRESS
PUSHJ P,0(S1) ;RETURN THROUGH THE MESSAGE PROCESSOR
JUMPT .RETT ;ALL WENT WELL, MOVE ALONG
SKIPN S1,G$ERR## ;GET THE ERROR CODE
$RETT ;OR NO ERROR CODE, QUIT
$ACK (<Operator Command Processing Error>,<^T/@TXTTBL(S1)/>,MDAOBJ,.MSCOD(M))
$RETT
OMNT.3: $ACK (<MDA is not Supported in this Monitor>,,,.MSCOD(M))
$RETT ;RETURN
;Each of the processing routines is resonsible for
;either 1) ACKing the OPR directly and returning TRUE, or
; 2) Returning FALSE via one of the E$xxx routines.
MNTDSP: D$STAP##,,.ODSHT ;SHOW STATUS TAPE DRIVES
D$SDSK##,,.ODSHD ;SHOW STATUS DISK DRIVES
D$ENAB##,,.ODENA ;ENABLE TAPE DRIVE AVR
D$DISA##,,.ODDIS ;DISABLE TAPE DRIVE AVR
D$ALIAS##,,.ODMTS ;MOUNT A STRUCTURE (WITH ALIAS)
D$DISM##,,.ODDSM ;DISMOUNT STRUCTURE
I$CNI,,.ODSDK ;SET DISK
D$SMDA##,,.ODSTP ;SET TAPE
I$CNI,,.ODSST ;SET STRUCTURE
D$RECO##,,.ODREC ;RECOGNIZE TAPE
D$UNLO##,,.ODUNL ;UNLOAD TAPE
D$IDEN##,,.ODIDN ;IDENTIFY TAPE
D$DELE##,,.ODDMT ;DELETE MOUNT REQUEST
D$SSTR##,,.ODSTR ;SHOW STATUS STRUCTURES
D$LOCK##,,.ODLOC ;LOCK A STRUCTURE
D$ULOK##,,.ODULC ;UNLOCK A STRUCTURE
I$CLST,,.ODCSL ;CHANGE THE SYSTEM LISTS
I$SLST,,.ODSSL ;SHOW THE SYSTEM LISTS
D$SALC##,,.ODSAL ;SHOW ALLOCATION
MNTLEN==.-MNTDSP ;DISPATCH TABLE LENGTH
I$CNI::$ACK (Command Not Yet Implemented,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL I$ISTR - ROUTINE TO INITIALIZE THE SYSTEM STRUCTURE LIST
I$ISTR: PUSHJ P,.SAVET ;SAVE ALL T AC'S
PUSHJ P,.SAVE1 ;SAVE P1 ALSO
SETZM T1 ;CLEAR T1
ISTR.1: SYSSTR T1, ;GET FIRST STRUCTURE IN SYSTEM
STOPCD (CSS,HALT,,<Can't get system structure list>)
JUMPE T1,.RETT ;NO MORE,,RETURN
PUSHJ P,D$CVOL## ;CREATE AN ENTRY IN THE VOLUME QUEUE
MOVE P1,S1 ;SAVE THE VOL ADDRESS
MOVE T2,S1 ;PUT HERE ALSO (FOR ISTR.5)
MOVEM T1,.VLNAM(P1) ;SAVE THE STRUCTURE NAME
MOVEM T1,ACTSTR+.DCNAM ;SAVE FOR DSKCHR
MOVE S1,[.DCMAX,,ACTSTR] ;SET UP UUO
DSKCHR S1, ;READ DISK CHARACTERISTICS
TDZA S1,S1 ;CAN'T
MOVE S1,ACTSTR+.DCOWN ;GET OWNER PPN
MOVEM S1,.VLOID(P1) ;SAVE IT
MOVE S1,P1 ;AIM AT THE VOL BLOCK
PUSHJ P,D$SVRS## ;GENERATE A RESOURCE NUMBER
MOVE S1,T1 ;GET THE STRUCTURE NAME IN S1
PUSHJ P,ISTR.5 ;GEN THE VOL BLOCK FOR IT
MOVX S1,%STAMN ;GET 'STRUCTURE MOUNTED' STATUS BITS
STORE S1,.VLFLG(P1),VL.STA ;SAVE AS THE NEW VOLUME STATUS
MOVE S1,G$NOW## ;GET THE CURRENT TIME
MOVEM S1,.VLMTM(P1) ;AND SET IT
MOVX S1,.TFLAL ;GET 'ANSI LABELED' LABEL TYPE
STORE S1,.VLFLG(P1),VL.LBT ; AND SET IT
MOVE T3,[POINT 6,ACTSTR] ;GET BYTE PTR TO STRUCTURE NAME
MOVEI S1,5 ;ONLY SCAN 5 BYTES
ISTR.2: ILDB S2,T3 ;GET A STRUCTURE BYTE
SKIPE S2 ;IS IT NULL ???
SOJG S1,ISTR.2 ;OR IS BYTE COUNT EXHAUSTED ???
MOVEI S1,20 ;GET A SIXBIT '0'
DPB S1,T3 ;CREATE A LOGICAL UNIT NAME
MOVE T2,P1 ;START LINKING WITH THE PRIMARY VOL BLK
ISTR.3: LDB S1,T3 ;GET THE LAST BYTE
AOS T4,S1 ;BUMP TO NEXT LOGICAL UNIT NAME
DPB S1,T3 ;AND SAVE IT
MOVE S1,[.DCMAX,,ACTSTR] ;GET DSKCHR PARMS
DSKCHR S1, ;GET THE DISK PARAMETERS
JRST ISTR.4 ;CAN'T,,MAKE SURE THE STR IS IN THE CAT
PUSHJ P,D$CVOL## ;CREATE A VOLUME ENTRY FOR THIS VOLUME
MOVE S2,ACTSTR+.DCUID ;GET THE VOLUME ID (HOME BLOCK)
MOVEM S2,.VLNXT(T2) ;SET NEXT VOL NAME IN PREVIOUS VOL BLK
MOVE S2,ACTSTR+.DCOWN ;GET OWNER PPN
MOVEM S2,.VLOID(T2) ;SET IT
STORE S1,.VLPTR(T2),VL.NXT ;POINT LAST VOL TO NEXT VOL
STORE T2,.VLPTR(S1),VL.PRV ;POINT NEXT VOL TO LAST VOL
MOVE T2,S1 ;MAKE NEXT VOL THE CURRENT VOL
SUBI T4,20 ;GET THE LOGICAL UNIT NUMBER (OCTAL)
STORE T4,.VLFLG(T2),VL.LUN ;SAVE IT
PUSHJ P,ISTR.6 ;UPDATE UCB POINTERS
JRST ISTR.3 ;AND TRY NEXT VOLUME
ISTR.4: MOVE S1,P1 ;GET THE PRIMARY VOL BLK ADDR BACK
PUSHJ P,V$CREA## ;ADD IT TO THE INCORE CATALOG
MOVE S1,P1 ;GET THE PRIMARY VOL BLOCK ADDRESS
PUSHJ P,I$STRM ;PERFORM STRUCTURE ACCOUNTING
JRST ISTR.1 ;AND GO GET THE NEXT STRUCTURE
;CONTINUED ONE THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to get disk parms for the volume in S1
ISTR.5: MOVEM S1,ACTSTR ;SAVE THE DISK/STRUCTURE NAME
MOVE S1,[30,,ACTSTR] ;GET DSKCHR PARMS
DSKCHR S1, ;GET STRUCTURE PARMS
PUSHJ P,S..CDC ;CAN'T,,STOPCODE !!!
ISTR.6: MOVE S1,ACTSTR+.DCUID ;GET THE HOME BLOCK ID
MOVEM S1,.VLVID(T2) ;SAVE IT IN THE VOL BLOCK
MOVE S1,ACTSTR+.DCSNM ;GET THE STRUCTURE NAME
MOVEM S1,.VLSTR(T2) ;SAVE IT IN THE VOL BLOCK
MOVE S1,ACTSTR+.DCUPN ;GET THE UNIT THIS STR IS MOUNTED ON
PUSHJ P,D$GUCB## ;FIND IT IN OUR UCB CHAIN
SKIPT ;IT MUST BE THERE !!!
STOPCD (CFU,HALT,,<Can't find UCB for unit (see ACTSTR+.DCUPN)>)
MOVEM T2,.UCBVL(S1) ;LINK THE VOL TO THE UCB
MOVEM S1,.VLUCB(T2) ;AND LINK THE UCB TO THE VOL
MOVX S2,UC.SWP ;GET THE UNIT SWAP BIT
SKIPL ACTSTR+.DCPAS ;ANY SWAPPING SPACE HERE ???
IORM S2,.UCBST(S1) ;YES,,LITE THE SWAP BIT IN UCB
$RETT ;RETURN
SUBTTL I$PERM - ROUTINE TO MODIFY THE 'A' MATRIX REFLECTING PERM STRS
;CALL: NO ARGS
;
;RET: TRUE
I$PERM: SKIPN G$PERM## ;PERMANENT STRUCTURES TURNED ON?
$RETT ;NO
PUSHJ P,.SAVET ;SAVE T1 - T4
SETZB T1,T2 ;ZERO T1 AND T2
SETOM T3 ;WANT FIRST STR IN SYSTEM SEARCH LIST
PERM.1: MOVE S1,[3,,T1] ;SETUP GOBSTR ARG BLOCK
GOBSTR S1, ;GET THE SYSTEM SEARCH LIST STR
JRST PERM.2 ;ON ERROR,,LOOK AT UCB'S
CAMN T3,[-1] ;DONE WITH THE SEARCH LIST ???
JRST PERM.2 ;YES,,LOOK AT THE UCB'S
MOVE S1,T3 ;GET THE STR NAME IN S1
PUSHJ P,SETPRM ;SETUP THE 'A' MATRIX
JRST PERM.1 ;AND CONTINUE
PERM.2: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST UCB ENTRY
JRST PERM.4 ;JUMPT THE FIRST TIME THROUGH
PERM.3: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT UCB QUEUE ENTRY
PERM.4: JUMPF .RETT ;NO MORE,,RETURN
LOAD S1,.UCBST(S2),UC.DVT ;GET THE DEVICE TYPE
CAXE S1,%DISK ;IS IT A DISK ???
JRST PERM.3 ;NO,,SKIP IT
LOAD S1,.UCBST(S2),UC.SWP ;DOES IT HAVE SWAP SPACE ON IT ??
JUMPE S1,PERM.3 ;NO,,SKIP IT
SKIPN S1,.UCBVL(S2) ;LOAD AND CHECK THE VOL ADDRESS
JRST PERM.3 ;NO VOLUME MOUNTED,,SKIP IT
MOVE S1,.VLSTR(S1) ;GET THE VOL STRUCTURE NAME
PUSHJ P,SETPRM ;MODIFY THE 'A' MATRIX
JRST PERM.3 ;CONTINUE FOR ALL UCB'S
SUBTTL SETPRM - ROUTINE TO MODIFY THE 'A' MATRIX FOR PERM STRUCTURES
;CALL: S1/ THE STR NAME
;
;RET: TRUE ALWAYS
SETPRM: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE STRUCTURE NAME
JUMPE P1,.RETT ;JUST CHECKING !!!
PUSHJ P,D$SRSN## ;GET THE STRUCTURE RESOURCE NUMBER
IMULI S1,AMALEN ;GET 'A' MATRIX OFFSET
ADD S1,AMATRX## ;GET THE ENTRY ADDRESS
LOAD S2,.AMNAM(S1),AM.PRR ;GET THE PERMANENT RESOURCE BIT
JUMPN S2,.RETT ;ALREADY SET,,JUST RETURN
MOVX S2,AM.PRR ;GET THE PERMANENT STRUCTURE BIT
IORM S2,.AMNAM(S1) ;LITE IT FOR THIS STRUCTURE
LOAD S1,.AMNAM(S1),AM.NAM ;GET ADDRESS OF RESOURCE NAME
PUSHJ P,V$FIND## ;GET THE CATALOG ENTRY
SKIPT ;IT MUST BE THERE !!!
PUSHJ P,S..SCE## ;NO,,THATS AN ERROR
MOVEI S2,.CQVSL(S1) ;POINT THE THE CAT VOL LIST
MOVE S1,.CQNVL(S1) ;GET THE VOL COUNT
SETP.1: MOVE P1,.CQRSN(S2) ;GET THE VOL RESOURCE NUMBER
IMULI P1,AMALEN ;GET THE ENTRY OFFSET
ADD P1,AMATRX## ;GET THE ENTRY ADDRESS
DECR .AMCNT(P1),AM.AVA ;DECRIMENT THE AVAILABLE COUNT BY 1
ADDI S2,2 ;POINT TO THE NEXT VOL BLK
SOJG S1,SETP.1 ;CONTINUE FOR ALL VOLUMES
$RETT ;RETURN WHEN DONE
SUBTTL I$MDAS,I$MDAC - Set and clear MDA control bit for a device
;These routines will set or clear the monitor's 'device controlled by MDA' bit.
;CALL: S1/ The Sixbit Device Name
;
;RET: True if alls ok, False if we Can't do it.
I$MDAS::SKIPA S2,[.DFMDS] ;CODE TO SET MDA BIT
I$MDAC::MOVX S2,.DFMDC ;CODE TO CLEAR MDA BIT
;Enter here with S1/SIXBIT device name, S2/ function code
EXCH S1,S2 ;PUT CODE IN S1, DEV NAME IN S2
MOVE TF,[XWD 2,S1] ;AIM AT THE ARG BLOCK
DEVOP. TF, ;TELL THE MONITOR TO DO IT
$RETF ;CAN'T CHANGE DEVICE STATUS
;Having cleared the DVCMDA bit, Clear the label type for the drive
$SAVE <T1> ;SAVE A REG
MOVX T1,.TFLBP ;CODE FOR BYPASS LABELS
MOVX S1,.TFPLT+.TFSET ;PRIV'D LABEL TYPE SET
MOVE TF,[XWD 3,S1] ;LENGTH,, ADDR
TAPOP. TF, ;MAKE THE DRIVE BYPASS LABELS
$RETF ;CAN'T DO IT ALL
$RETT ;WINS
I$MINI: $RETT ;JUST RETURN
SUBTTL I$KMNT - ROUTINE TO PROCESS USER MOUNT KILL REQUESTS
;CALL: M/ Kill Message Address
;
;RET: TRUE ALWAYS
I$KMNT:: PUSHJ P,.SAVE2 ;SAVE P1 - P2
MOVEI P1,KIL.RQ(M) ;GET THE RDB ADDRESS
SETZM P2 ;CLEAR DELETE COUNTER
SKIPN S1,.RDBRQ(P1) ;DID HE SPECIFY A REQUEST ID ???
JRST KMNT.1 ;NO,,SKIP THIS
PUSHJ P,D$FVSL## ;FIND THE VSL HE WANTS
JUMPF E$SNY## ;NOT THERE,,THATS AN ERROR
MOVE P1,S1 ;SAVE THE VSL ADDRESS
MOVE AP,.VSMDR(P1) ;AND THE MDR ADDRESS
LOAD S1,G$PRVS##,MD.PJB ;GET THE SENDERS JOB NUMBER
LOAD S2,.MRJOB(AP),MD.PJB ;GET THE MDR JOB NUMBER
CAME S1,S2 ;THEY MUST MATCH !!!
JRST E$SNY## ;NO,,THATS AN ERROR
MOVE S1,P1 ;GET THE VSL ADDRESS
JRST KMNT.2 ;AND GO COMPLETE THE PROCESSING
KMNT.1: LOAD S1,G$PRVS##,MD.PJB ;GET THE SENDERS JOB NUMBER
PUSHJ P,D$FMDR## ;FIND THE USERS MDR
JUMPF E$SNY## ;NOT THERE,,THATS AN ERROR
MOVEI S1,.RDBVS(P1) ;POINT TO ASCIZ VOLUME SET NAME
PUSHJ P,D$FLNM## ;LOOK FOR LOGICAL NAME FIRST
JUMPT KMNT.2 ;FOUND IT,,CONTINUE
MOVEI S1,.RDBVS(P1) ;POINT TO ASCIZ VOLUME SET NAME
PUSHJ P,D$FVSN## ;LOOK FOR REQUEST BY THIS VOL SET NAME
JUMPF E$SNY## ;NOT THERE,,THATS AN ERROR
KMNT.2: MOVE P1,S1 ;SAVE THE VSL ADDRESS
LOAD S1,.VSFLG(P1),VS.ALC ;HAS HE TRIED TO MOUNT IT YET ???
JUMPN S1,E$CDA## ;NO,,THEN ITS STILL ALLOCATED
SKIPE .VSUCB(P1) ;DOES HE ALREADY HAVE THE VOLUME MOUNTED
PJRST E$MRP## ;YES,,THATS AN ERROR
MOVE S1,P1 ;GET THE VSL ADDRESS IN S1
PUSHJ P,D$FOWN## ;DOES HE OWN THE VOLUME
JUMPT E$MRP## ;YES,,HE CAN'T DO THIS !!!
$WTO (<Mount Request #^D/.VSRID(P1)/ cancelled by user>,< ^I/DEMOT/^M^J Volume-set-name: ^T/.VSVSN(P1)/>,,<$WTFLG(WT.SJI)>)
SKIPE G$ACK## ;DOES HE WANT AN ACK ???
$TEXT (G$CCHR##,<Mount Request for ^T/.VSVSN(P1)/ Canceled^0>)
MOVE S1,P1 ;GET THE VSL ADDRESS IN S1
PUSHJ P,D$ALCV## ;RETURN HIS RESOURCES
LOAD S1,.MRCNT(AP),MR.CNT ;ANY REQUESTS LEFT ???
SKIPN S1 ;YES,,SKIP
PUSHJ P,D$DMDR## ;NO,,DELETE THE MDR
$RETT ;AND RETURN
SUBTTL I$CKAV - See if a device is owned by anyone.
;This routine takes a device name in S1. It asks the monitor if anyone
;owns the drive. This is useful on intialization, wheen MDA may have
;been restarted, and unaware of the state of the world,
;or when a drive has been set unavailable, and MDA
;has not been tracking its usage.
;Returns: TRUE if someone owns the device, false if nobody does
I$CKAV::DEVCHR S1, ;SEE IF THE DEVICE IS AVAILABLE
TXNE S1,DV.ASC!DV.ASP ;IS THE DEVICE AVAILABLE?
$RETT ;SOMEBODY OWNS IT!!
$RETF ;NOBODY OWNS IT
SUBTTL I$GOWN - Get device owner
;This routine takes a sixbit device name in S1 and returns its
;controlling job number in S1.
;Return: TRUE if owned, FALSE if not.
I$GOWN::DEVTYP S1, ;Get physical device properties
$RETF ;Return false if error
LOAD S1,S1,TY.JOB ;Get the job number seperated
JUMPE S1,.RETF ;No such device
$RETT ;Return true
SUBTTL FILE ARCHIVING ENTRY POINTS
;ALL FILE ARCHIVING ENTRY POINTS RETURN FALSE
I$NDEF:: $RETF ;JUST RETURN
I$NFJB:: $RETF ; '' ''
I$NTFY:: $RETF ; '' ''
I$NLNK:: $RETF ; '' ''
I$RDEF:: $RETF ; '' ''
I$RFJB:: $RETF ; '' ''
I$RSCH:: $RETF ; '' ''
I$RLNK:: $RETF ; '' ''
I$ARCH:: $RETF ; '' ''
SUBTTL LOCK and UNLOCK support
;These routines just try to tell the operating system that
; a file structure is to be locked from further access.
; Or cleared from such restriction
;
;CALL: S1/ File structure name
;
;RET: TRUE if the monitor allows the call,
; FALSE if not
INTERN I$LOCK ;MAKE IT GLOBAL
INTERN I$UNLK ; "" "" ""
I$LOCK: MOVX TF,.FSLOK ;FUNCTION CODE TO DO LOCK
SKIPA ;DO IT
I$UNLK: MOVX TF,.FSCLR ;FUNCTION CODE TO DO UNLOCK
MOVX S2,<XWD 2,TF> ;AIM AT THE ARGUMENT LIST
SKIPE DEBUGW ;NEVER DO IT IF DEBUGGING!
$RETT ;PRETEND IT WON, THOUGH
STRUUO S2, ;DO IT
$RETF ;CAN'T
$RETT ;DONE
SUBTTL I$SLST - CHANGE SYSTEM LISTS
;Since some of the actions involved in adding and
; removing units and structures from various system lists,
; all the work is done by PULSAR.
;All this routine does is forward the message (in M) to PULSAR
I$SLST:
I$CLST:
PJRST I$FPLR ;FORWARD THE MESSAGE TO PULSAR
SUBTTL I$FPLR - Forward a message to PULSAR
;This routine is used when all or some of the functionality
; provided by some OPR message will be provided by the tape labeler.
; This routine makes a copy of the incoming message, and
; sends the copy to the tape labeler.
;Call -
; M/ Incoming message adrs
;Returns -
; TRUE (ALWAYS)
I$FPLR::
$CALL M%GPAG ;GET A PAGE
STORE S1,G$SAB##+SAB.MS ;SAVE ADRS OF THE MESSAGE
MOVX S2,PAGSIZ ;GET A PAGE LENGTH (1000)
MOVEM S2,G$SAB##+SAB.LN ;SEND MESSAGE AS A PAGE
LOAD S2,.MSTYP(M),MS.CNT ;GET LENGTH OF THE MESSAGE
ADDI S2,0(S1) ;FIGURE TERMINATION ADRS
HRLI S1,0(M) ;MOVE FROM THE INCOMING MESSAGE
BLT S1,-1(S2) ;MOVE THE MESSAGE OVER
MOVX S1,SI.FLG+SP.TLP ;SEND TO TAPE LABELER (PULSAR)
;S1 = PID index. SAB should contain everything else.
SNDMSG: MOVEM S1,G$SAB##+SAB.SI ;SAVE IN SAB
SETZM G$SAB##+SAB.PB ;NO IN BEHALF OF PIB
SETZM G$SAB##+SAB.PD ;NO RECIEVERS PID (USING INDEX)
PUSHJ P,C$SEND## ;SEND THE MESSAGE OFF
$RETT ;RETURN
SUBTTL I$OCLS Operator Log File Closure Event
;Called by scheduler. Message .QOOLC
I$OCLS::PUSHJ P,M%GPAG ;GET A PAGE FOR MESSAGE
$SAVE <M> ;SAVE M
MOVE M,S1 ;GET PAGE ADDRESS IN M
MOVEI S1,.QOOLC ;GET MESSAGE TYPE
STORE S1,.MSTYP(M),MS.TYP ;STORE IN MESSAGE
MOVEI S1,.OHDRS ;GET MESSAGE SIZE
STORE S1,.MSTYP(M),MS.CNT ;STORE IN MESSAGE
MOVEM S1,G$SAB##+SAB.LN ;AND IN SAB
MOVEM M,G$SAB##+SAB.MS ;PUT MESSAGE ADDRESS IN SAB
MOVX S1,SI.FLG+SP.OPR ;GET ORION'S PID INDEX
PUSHJ P,SNDMSG ;SEND THE MESSAGE TO ORION
PUSHJ P,Q$EVTR## ;RELEASE THE EVENT
$RETT ;RETURN
SUBTTL Usage File and Billing Closure -- ACTDAE functions 10 and 11
;Called by scheduler with S1 = QE address, S2 = object block address
I$UFIL::MOVEI TF,UGUFC$ ;LOAD FILE CLOSURE CODE
TRNA ;"SKIPA 0,FOO" DOESN'T LOAD AC
I$UBIL::MOVEI TF,UGEBC$ ;LOAD BILLING CLOSURE CODE
$SAVE <M,T1> ;SAVE A COUPLE ACS
MOVE T1,TF ;COPY MESSAGE TYPE AND .QE ADDRESS
PUSHJ P,M%GPAG ;GET A PAGE FOR MESSAGE
MOVE M,S1 ;COPY ADDRESS
STORE T1,.MSTYP(M),MS.TYP ;SAVE MESSAGE TYPE
MOVEI S1,.OHDRS ;GET MESSAGE SIZE
STORE S1,.MSTYP(M),MS.CNT ;STORE IN MESSAGE
MOVEM S1,G$SAB##+SAB.LN ;AND IN SAB
CAIE T1,UGUFC$ ;IS IT FILE CLOSURE?
JRST USAG.1 ;NO, NO SWITCHES THEN
GETLIM S1,.QELIM(AP),SWIT ;YES, GET DEPENDENT SWITCHES
MOVEM S1,.OFLAG(M) ;SAVE FOR ACTDAE
USAG.1: MOVEM M,G$SAB##+SAB.MS ;SAVE MESSAGE ADDRESS IN THE SAB
MOVX S1,SI.FLG+SP.ACT ;GET ACTDAE'S PID INDEX
PUSHJ P,SNDMSG ;SEND OFF TO ACTDAE
PUSHJ P,Q$EVTR## ;RELEASE THE EVENT
$RETT ;RETURN
SUBTTL I$KINT & I$KSYI - QUASAR'S ROUTINES FOR KSYS INTERRUPTS
;Enable KSYS interrupts
I$KINT: MOVEI S1,KSYTAB ;GET WARNING TIME TABLE ADDRESS
MOVEM S1,KSYTIM ;INTIALIZE INDIRECT POINTER
MOVX S1,%NSKTM ;SEE IF KSYS ALREADY SET
GETTAB S1,
SETZM S1 ;ASSUME NONE SET IF ERROR
MOVEM S1,KSYS ;INIT KSYS WORD IN INTERRUPT BLOCK
MOVEM S1,KSYOLD ;INIT "OLD KSYS" VALUE ALSO
JUMPLE S1,KINT.2 ;IF NO KSYS PENDING SKIP TABLE INIT
KINT.1: CAMLE S1,@KSYTIM ;KSYS PENDING. SET WARNING TIME
JRST KINT.2 ;INDEX INTO KSYTAB.
AOS KSYTIM
JRST KINT.1
KINT.2: IMULI S1,^D60 ;CONVERT TO SECONDS FOR G$KSYS
MOVEM S1,G$KSYS## ;STORE SECONDS FOR I$SYSV
MOVX T1,.PCKSY ;GET KSYS INTERRUPT FUNCTION CODE
MOVSI T2,<KSYBLK-INTBLK> ;GET OFFSET FROM BEGINNING OF VECTOR
SETZB T3,G$KSYI## ;DON'T NEED T3,,INIT KSYS INTR FLAG
MOVEI S1,I$KSYI ;GET ADDRESS OF INTERRUPT ROUTINE
MOVEM S1,KSYBLK+.PSVNP ;SAVE ADDRESS
MOVX S1,<PS.FON+PS.FAC+T1> ;BUILD ARG AC
PISYS. S1, ;DO THE ENABLE
SKIPF ;COMPLAIN
$RETT ;RETURN
$WTO (<Couldn't enable for KSYS interrupts via PSI system>,<OPSER will have to be run>)
SETOM KSYBLK+.PSVNP ;INVALIDATE INTERRUPT ROUTINE ADDRESS
$RETT ;RETURN
;KSYS interrupt routine
I$KSYI: $BGINT 1,
SETOM G$KSYI## ;FLAG INTERRUPT OCCURRED
$DEBRK
SUBTTL I$KSYS - ROUTINE TO CHECK KSYS INFO FROM MONITOR
;I$KSYS is called from MAIN loop or I$SYSV when G$KSYI is negative.
; KSYS warnings are broadcasted to users at intervals specified
; in KSYSTB.
KSYOLD::BLOCK 1 ;LAST KSYS VALUE
KSYTIM: BLOCK 1 ;POINTER INTO KSYTAB
RADIX 10
KSYTAB: EXP 24*60,12*60,8*60,4*60,2*60,60,30,15,10,5,4,3,2,1 ;MINUTES TILL KSYS (WARNING TIMES)
RADIX 8
I$KSYS: SKIPL G$KSYI## ;INTERRUPT HAPPEN?
$RETT ;NO,,RETURN (HOW'D THAT HAPPEN?)
SETZM G$KSYI## ;YES,,CLEAR FLAG
SKIPE DEBUGW ;DEBUGGING?
$RETT ;YES, DON'T DO KSYS STUFF
MOVE S1,KSYS ;GET NEW VALUE
MOVE S2,KSYOLD ;GET OLD VALUE
MOVEM S1,KSYOLD ;REMEMBER NEW VALUE
JUMPL S1,KSYS.0 ;JUMP IF TIMESHARING OVER
JUMPG S1,KSYS.6 ;IF POSITIVE,,SEE IF TIME FOR WARNING
JUMPG S2,KSYS0 ;JUMP IF KSYS HAS BEEN CANCELLED
;KSYS going from off to on. Check to see if we're waiting for BATCON
;to "fire up" for KSYS duties.
SETZM G$KUDT## ;KSYS GOING FROM OFF TO ON
MOVX S1,.OTBAT ;GET BATCON'S OBJECT TYPE
MOVX S2,%GENRC ;AND HIS ATTRIBUTE
PUSHJ P,I$GOPD ;FIND HIS CJB
JUMPF .RETT ;?????
MOVE S2,CJB.NM(S1) ;GET BATCON'S NAME
SETZ S1, ;SEARCH BY NAME, NOT BY PID
PUSHJ P,A$FPSB## ;FIND HIS PSB
JUMPF .RETT ;IF NOT THERE THAT'S OK
LOAD S2,PSBFLG(S1),PSFSTS ;GET THE PSB STATUS
CAXE S2,PS.KSY ;FIRED UP BECAUSE OF KSYS AND TOOK ITS
$RETT ;TIME ABOUT IT?
MOVX S2,PS.WAT ;YES, SET TO "WAITING". WE DON'T WANT
STORE S2,PSBFLG(S1),PSFSTS ;TO SEND AN ERRONEOUS KSYS MSG TO BATCON
$RETT
;Here when KSYS has been cancelled. S1=0 S2 .GT. 0
KSYS0: MOVEI S1,KSYTAB ;REINIT WARNING TIME TYPEOUT TABLE
MOVEM S1,KSYTIM
CAMLE S2,KSYTAB ;WAS KSYS WARNING EVER BROADCASTED?
JRST KSYS.A ;PROBABLY NOT
PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S2 ;SAVE S2
MOVE S1,[POINT 7,KSYBUF] ;INIT BYTE POINTER
MOVEM S1,KSYPTR ;..
MOVEI S1,[ASCIZ\KSYS cancelled\] ;GET A KEY STRING ADDRESS
$TEXT (KSYPUT,<SEND ^W/KSYTTY/ ^T/(S1)/. Timesharing will not end^A>)
$WTO (<^T/(S1)/>,,,$WTFLG(WT.SJI))
PUSHJ P,KSYMSG ;GO SEND MESSAGE TO USERS
KSYS.A: SETZM G$KUDT## ;CLEAR GLOBAL KSYS TIME
$SAVE <H,AP> ;SAVE H AND AP
MOVEI H,HDREVT ;GET EVENT QUEUE HEADER ADDRESS
LOAD AP,.QHLNK(H),QH.PTF ;GET POINTER TO FIRST ENTRY
KSYS.B: JUMPE AP,.RETT ;JUST RETURN IF NONE
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT TYPE
CAIE S1,.EVKSY ;KSYS EVENT?
JRST [LOAD AP,.QELNK(AP),QE.PTN ;NO, GET POINTER TO NEXT ENTRY
JRST KSYS.B]
GETLIM S1,.QELIM(AP),ACTV ;GET ACTIVE BIT
JUMPE S1,.RETT ;RETURN IF NOT ACTIVE
MOVE S1,G$NOW## ;GET CURRENT UDT
PUSHJ P,.UD2SC## ;CONVERT TO SECONDS
EXCH S1,P1 ;SWAP OLD KSYS MINUTES AND SECONDS
IMULI S1,^D60 ;CONVERT MINUTES TO SECONDS
ADD P1,S1 ;GET LAST KSYS UDT IN SECONDS
MOVE S1,.QECRE(AP) ;GET KSYS EVENT UDT
PUSHJ P,.UD2SC## ;CONVERT TO SECONDS
SUB P1,S1 ;GET DIFFERENCE
MOVMS P1 ;GET POSITIVE DIFFERNCE
CAIG P1,^D60*2 ;WITHIN 2 MINUTES?
PUSHJ P,Q$EVTR## ;YES, RELEASE THE EVENT
$RETT ;RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here when KSYS has just expired.
KSYS.0: CAME S1,[-1] ;CLOCK1 BUG KEEPS REMINDING US
$RETT ;RETURN UNTIL MONITOR FIXED
$WTO (<Timesharing is over>,<Wait for "KSYS processing complete" message before SHUTDOWN>,,$WTFLG(WT.SJI)) ;TELL OPERATORS
$SAVE <AP,H> ;SAVE AP & H
LOAD AP,HDREVT##+.QHLNK,QH.PTF ;POINT TO THE FIRST ENTRY
KSYS.1: JUMPE AP,KSYS.2 ;RETURN IF NO MORE ENTRIES
GETLIM S2,.QELIM(AP),TYPE ;GET EVENT TYPE
CAIN S2,.EVKSY ;KSYS?
JRST KSYS.2 ;YES
LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST KSYS.1 ;AND LOOP
KSYS.2: PUSHJ P,Q$EVTR## ;DO EVENT RELEASE
SETOM G$KUDT## ;INDICATE IN UDT WORD
;Start BATCON if not already running
MOVX S1,.OTBAT ;GET OUR BATCON'S OBJECT TYPE
MOVX S2,%GENRC ;AND HIS ATTRIBUTE
PUSHJ P,I$GOPD ;GET BATCON'S CJB
JUMPT KSYS2A ;JUMP IF WE GOT IT
$WTO (<BATCON can't be started. CJB not found.>,<KSYS logouts will not be done>,,$WTFLG(WT.SJI))
PJRST KSYS5A ;GO DO SEND ALL
KSYS2A: MOVE S2,CJB.NM(S1) ;GET BATCON'S PROCESSOR NAME
PUSH P,S1 ;SAVE CJB ADDRESS
SETO S1, ;SEARCH BY NAME, DON'T CARE ABOUT PID
PUSHJ P,A$FPSB## ;FIND BATCON'S PSB
POP P,S2 ;GET CJB ADDRESS BACK IN S2
JUMPF KSYS2B ;JUMP IF NO PSB
;We have the PSB. Check to its status.
LOAD TF,PSBFLG(S1),PSFSTS ;GET PSB STATUS VALUE
CAXN TF,PS.RUN ;RUNNING?
JRST [PUSHJ P,KSYS.5 ;YES, SEND KSYS MSG
PJRST KSYS5A] ;DO THE SEND ALL
CAXE TF,PS.FIR ;NO, WAITING TO BE FIRED UP?
JRST KSYS2D ;NO, MUST BE WAITING
;PSB needs to be fired.
; S1 continas PSB address, 0, or -1
; S2 contains CJB address
KSYS2B: PUSH P,S1 ;SAVE PSB ARG
PUSH P,S2 ;SAVE CJB ADDRESS
HRLZ S1,S2 ;COPY BATCON'S CJB TO QUASAR'S
HRRI S1,QSRCJB
BLT S1,QSRCJB+CJB.SZ-1
MOVEI S1,QSRCJB
MOVEI TF,^D10 ;WAIT 10 SECONDS FOR FRCLIN
STORE TF,CJB.TP(S1),CJ.TIM ;PUT IN CJB
PUSHJ P,I$SXXX ;GO START UP BATCON
POP P,S2 ;GET CJB ADDRESS BACK
POP P,S1 ;GET PSB ADDRESS BACK
JUMPF KSYS.4 ;WE TRIED
JUMPG S1,KSYS2D ;IF PSB, DON'T CREATE ONE
;Create a PSB, BATCON is in the process of firing up
KSYS2C: PUSH P,S2 ;SAVE CJB ADDRESS
SETZB S1,S2 ;CLEAR ARG ACS
PUSHJ P,GETPSB## ;GET US A PSB
POP P,S2 ;GET CJB ADDRESS BACK
MOVE TF,CJB.NM(S2) ;GET BATCON'S NAME
MOVEM TF,PSBNAM(S1) ;PUT IN PSB
;Set PSB status up for KSYS
KSYS2D: MOVX TF,PS.KSY ;SET SPECIAL BATCON STATUS
STORE TF,PSBFLG(S1),PSFSTS
SETZM TF ;NO, MORE TRIES
STORE TF,PSBFLG(S1),PSFCNT ;ALL
MOVE S2,S1 ;SAVE PSB ADDRESS
$CALL I%NOW ;GET CURRENT TIME
ADD S1,[EXP ^D30*^D3] ;WAIT 30 SECONDS FOR BATCON
MOVEM S1,PSBUDT(S2) ;SAVE UDT IN PSB
$WTO (<Waiting for BATCON to start for KSYS logouts>,,,$WTFLG(WT.SJI))
MOVE S1,S2 ;GET PSB IN S1
PJRST KSYS5A ;GO DO SEND ALL
KSYS.4: $WTO (<BATCON startup failed>,<KSYS logouts will not be done>,,$WTFLG(WT.SJI))
PJRST KSYS5A ;GO DO SEND ALL
;Call here from A$HELLO when BATCON says hello and PS.KSY is set in PSFSTS.
I$SKSM::
;Send KSYS message to BATCON
;S1 = PSB ADDRESS
KSYS.5: MOVE S2,PSBPID(S1) ;GET BATCON'S PID
MOVEM S2,G$SAB##+SAB.PD ;SAVE PID IN SAB
MOVEI S2,MSHSIZ ;GET MESSAGE SIZE
MOVEM S2,G$SAB##+SAB.LN ;SAVE IT IN SAB
STORE S2,G$MSG##+.MSTYP,MS.CNT ;AND IN MESSAGE
MOVX S2,.QOKSY ;GET KSYS MESSAGE TYPE
STORE S2,G$MSG##+.MSTYP,MS.TYP ;STORE IT IN MESSAGE
SETZM G$MSG##+.MSFLG ;NO FLAGS
SETZM G$MSG##+.MSCOD ;NO ACK CODE
MOVEI S2,G$MSG## ;GET MESSAGE ADDRESS
MOVEM S2,G$SAB##+SAB.MS ;STORE IN SAB
SETZM G$SAB##+SAB.SI ;NO SPECIAL INFO NEEDED
$CALL C$SEND ;SEND MESSAGE TO BATCON
$RETIT
$WTO (<KSYS message send to BATCON failed>,<Error: ^E/S1/>,,$WTFLG(WT.SJI))
$WTO (<BATCON not available>,<KSYS logouts will not be done>,,$WTFLG(WT.SJI))
$RETT
;Do a SEND ALL to say "Timesharing is over!"
KSYS5A: MOVE S1,[POINT 7,KSYBUF] ;INIT BYTE POINTER
MOVEM S1,KSYPTR ;..
$TEXT (KSYPUT,<SEND ^W/KSYTTY/ Timesharing is over!^M^J^0>) ;BUILD MSG
MOVEI S1,KSYBUF ;GET ADDRESS OF BUFFER
PUSHJ P,FRCTYP ;OUTPUT FOR ALL TO SEE
PUSHJ P,TYPRSN ;TYPE REASON TOO
MOVEI S1,KSYTAB ;REINITIALIZE WARNING TIME
MOVEM S1,KSYTIM ;TYPEOUT TABLE
$RETT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to check if a "Timesharing ends" message is appropriate.
;S1 = New KSYS value (greater than zero)
;S2 = Old KSYS value
;First see if a KSYS event exists. If not, create one.
KSYS.6: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
LOAD S1,HDREVT##+.QHLNK,QH.PTF ;POINT TO FIRST EVENT ENTRY
KSYS6A: JUMPE S1,KSYS6B ;EMPTY MEANS NO KSYS EVENT
GETLIM S2,.QELIM(S1),TYPE ;GET EVENT TYPE
CAIE S2,.EVKSY ;KSYS EVENT?
JRST [LOAD S1,.QELNK(S1),QE.PTN ;NO, GET NEXT EVENT ENTRY AND LOOP
JRST KSYS6A]
GETLIM S2,.QELIM(S1),ACTV ;YES, GET ACTIVE BIT
JUMPN S2,KSYS6C ;CONTINUE ON IF KSYS EVENT ACTIVE
KSYS6B: PUSH P,M ;SAVE M
MOVEI S1,.EVKSY ;GET KSYS EVENT CODE
PUSHJ P,Q$EVTI## ;GO CREATE SKELETON EQ
MOVE S1,G$NOW## ;GET CURRENT UDT
PUSHJ P,.UD2SC## ;CONVERT TO SECONDS
MOVE S2,-2(P) ;GET NEW MINUTES TILL KSYS
IMULI S2,^D60 ;CONVERT TO SECONDS
ADD S1,S2 ;GET KSYS UDT IN SECONDS
PUSHJ P,.SC2UD## ;CONVERT TO UDT
MOVEM S1,.EQAFT(M) ;STORE IN EQ
MOVX S1,.QIFNC ;GET INTERNAL FUNCTION BIT
IORM S1,.MSTYP(M) ;LITE IT IN MESSAGE
PUSHJ P,Q$CREATE## ;CREATE THE KSYS EVENT FOR REAL
POP P,M ;RESTORE M
KSYS6C: POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
PUSHJ P,.SAVE2 ;SAVE P1 & P2
DMOVE P1,S1 ;COPY NEW AND OLD TIME-TILL-KSYS VALUES
SUB S2,S1 ;COMPUTE DIFFERENCE BETWEEN THE TWO
JUMPE P2,KSYS.7 ;JUMP IF FIRST KSYS WARNING
CAIN S2,1 ;NEW KSYS TIME SPECIFIED?
JRST KSYS.9 ;NO, 1 MIN DIFFERENCE. IGNORE TOADS
;SETTING A NEW KSYS 1 MIN BEFORE CURRENT
KSYS.7: MOVEI S2,KSYTAB ;NEW KSYS. REINIT WARNING TIME TABLE
MOVEM S2,KSYTIM ; POINTER IN EITHER CASE
IMULI S1,^D60 ;CONVERT MINS TILL KSYS TO SECONDS
PUSH P,S1 ;SAVE FOR A LATER
MOVE S1,G$NOW## ;GET CURRENT TIME IN UDT FORMAT
PUSHJ P,.UD2SC## ;CONVERT UDT TO SECONDS
ADD S1,(P) ;COMPUTE FUTURE TIME IN SECONDS
PUSHJ P,.SC2UD## ;CONVERT FUTURE TIME TO UDT FORMAT
MOVEM S1,G$KUDT## ;SAVE FOR ALL TO SEE
POP P,(P) ;RESYNCH STACK
SETZM P2 ;MAKE SURE REASON IS TYPED
CAMLE P1,KSYTAB ;TIME TO KSYS GREATER THAN 1ST WARNING
$RETT ;YES--RETURN
KSYS.8: CAML P1,@KSYTIM ;NO--SET KSYTIM POINTER TO TIME IN
JRST KSYS.9 ; KSYTAB THAT IS LESS THAN TIME TILL
AOS KSYTIM ; KSYS.
JRST KSYS.8
;Determine whether a warning and reason should be broadcasted
KSYS.9: CAMG P1,@KSYTIM ;TIME FOR A WARNING?
JRST KSYS10 ;YES
JUMPN P2,.RETT ;NOT IF IT'S NOT THE FIRST TIME
TRNA ;IT IS THE FIRST TIME
KSYS10: AOS KSYTIM ;YES--POINT TO NEXT WARNING TIME
PUSHJ P,TIMMSG ;TYPE THE WARNING TO ALL
JUMPE P2,TYPRSN ;GIVE REASON IF FIRST KSYS INTERRUPT
CAME P1,KSYTAB ; OR FIRST WARNING TABLE TIME
$RETT ;RETURN OTHERWISE
;Here to type reason for KSYS
TYPRSN: LOAD S1,HDREVT##+.QHLNK,QH.PTF ;POINT TO THE FIRST ENTRY
TYPR.1: JUMPE S1,.RETT ;RETURN IF NO MORE ENTRIES
GETLIM S2,.QELIM(S1),TYPE ;GET EVENT CODE
CAIE S2,.EVKSY ;KSYS?
TDZA S2,S2 ;NO
GETLIM S2,.QELIM(S1),ACTV ;GET ACTIVE BIT
JUMPN S2,TYPR.2 ;ONLY VALID IF ACTIVE
LOAD S1,.QELNK(S1),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST TYPR.1 ;AND LOOP
TYPR.2: GETLIM S2,.QELIM(S1),TEXT ;GET TEXT BUFFER ADDRESS
SKIPN S2 ;REASON MESSAGE?
$RETT ;NO,,RETURN
MOVE S1,[POINT 7,KSYBUF] ;YES,,REINIT BYTE POINTER
MOVEM S1,KSYPTR ;STORE IT
$TEXT (KSYPUT,<SEN ^W/KSYTTY/ Reason: ^T/(S2)/^M^J^0>) ;COPY REASON
MOVEI S1,KSYBUF ;GET ADDRESS OF REASON
PUSHJ P,FRCTYP ;SEND IT FOR ALL
$RETT ;RETURN
; ROUTINE TO STRIP SECONDS OFF KSYS UDT
; CALL: MOVE S1, KSYS UDT
; PUSHJ P,I$KTIM
;
; ON RETURN, S1 CONTAINS A POSSIBLY UPDATED UDT
I$KTIM::PUSH P,S1 ;SAVE UDT
HRRZS S1 ;KEEP ONLY THE FRACTION OF THE DAY
PUSHJ P,.UD2SC ;CONVERT TO SECONDS
IDIVI S1,^D60 ;S1 = MINUTES, S2 = SECONDS
CAIL S2,^D30 ;GREATER THAN 30 SECONDS?
ADDI S1,1 ;ROUND UP TO THE NEXT MINUTE
IMULI S1,^D60 ;CONVERT MINUTES BACK TO SECONDS
PUSHJ P,.SC2UD ;AND BACK TO UDT FORMAT
POP P,S2 ;GET UDT BACK
HLL S1,S2 ;INCLUDE DATE PORTION
POPJ P, ;RETURN
SUBTTL Support routines for KSYS countdown
;TIMMSG builds the ASCIZ string "Timesharing ends in x days, y hours and
; z minutes" part of the KSYS warning message.
; KSYS word should contain correct time in minutes.
TIMMSG: SKIPG S1,KSYS ;JUST IN CASE
$RETT
$SAVE <T1,T2,T3> ;SAVE A FEW
SETZM T3 ;CLEAR T3
MOVE T1,S1 ;GET TIME
MOVE S1,[POINT 7,KSYBUF] ;INIT BYTE POINTER
MOVEM S1,KSYPTR ;..
$TEXT (KSYPUT,<SEN ^W/KSYTTY/ Timesharing ends in^A>) ;FIRST PART
IDIVI T1,<^D60*^D24> ;COMPUTE NUMBER OF DAYS
JUMPE T1,TIMM.1 ;JUMP IF LESS THAN DAY
ADDI T3,1 ;INDICATE DAY(S) IN MESSAGE
MOVEI S1,[ASCIZ\day\] ;GET PART OF MESSAGE
$TEXT (KSYPUT,< ^D/T1/ ^T/(S1)/^A>) ;DUMP IN BUFFER
CAIE T1,1 ;MORE THAN 1 DAY?
PUSHJ P,TIMM.7 ;YES,,GO ADD "s"
TIMM.1: MOVE T1,T2 ;GET NUMBER OF MINUTES REMAINING
IDIVI T1,^D60 ;COMPUTE NUMBER OF HOURS
SKIPN T1 ;HOURS VALID?
JUMPE T3,TIMM.2 ;NO,,ONLY TYPE "0" IF DAYS WERE TYPED
MOVEI S1,[ASCIZ\hr\] ;GET SOME TEXT
$TEXT (KSYPUT,< ^D/T1/ ^T/(S1)/^A>) ;DUMP HOURS
CAILE T1,1 ;MORE THAN 1 HOUR?
PUSHJ P,TIMM.7 ;YES,,GO ADD "s"
TIMM.2: JUMPE T2,TIMM.3 ;JUMP IF NO MINUTES
MOVEI S1,[ASCIZ\min\] ;GET SOME MORE TEXT
$TEXT (KSYPUT,< ^D/T2/ ^T/(S1)/^A>) ;DUMP MINUTE(S)
CAIE T2,1 ;MORE THAN 1 MINUTE?
PUSHJ P,TIMM.7 ;YES,,GO ADD "s"
TIMM.3: PUSHJ P,KSYMSG ;TYPE IT OUT
POPJ P, ;RETURN
TIMM.7: MOVEI S1,"s" ;GET AN "s"
PUSHJ P,KSYPUT ;ADD IT TO BUFFER
POPJ P, ;RETURN
;KSYPUT - Put a char in KSYBUF using KSYPTR.
; S1 = char to deposit
KSYPUT: IDPB S1,KSYPTR ;DEPOSIT THE CHARACTER
POPJ P, ;RETURN
KSYPTR: POINT 7,KSYBUF ;INITIAL BYTE POINTER
KSYBUF: BLOCK <^D100/5+1> ;SHOULD BE ENOUGH ROOM
KSYTTY: SIXBIT /ALL/ ;DEFAULT KSYS SEND ALL TTY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;KSYMSG - This routine appends " at dd-mmm-yy hh:mm" to
; string in KSYBUF. G$KUDT is assumed to be correct.
KSYMSG: SKIPN S1,G$KUDT## ;DON'T USE ZERO
JRST KSYM.1 ;GO TERMINATE LINE
PUSHJ P,I$KTIM ;STRIP OFF SECONDS
$TEXT (KSYPUT,< at ^H/S1/^A>) ;DATE/TIME OF KSYS
KSYM.1: $TEXT (KSYPUT,<^M^J^0>) ;ADD CRLF
MOVEI S1,KSYBUF ;GET ADDRESS OF TEXT TO SEND
PUSHJ P,FRCTYP ;GO SEND IT
POPJ P, ;RETURN
;FRCTYP - Type string down FRCLIN's throat.
; S1 = string address (ASCIZ)
FRCTYP: MOVX S2,%CNFLN ;GET FRCLIN'S TTY
GETTAB S2, ;..
PJRST S..NGF ;SHOULDN'T HAPPEN
TXO S2,.UXTRM ;MAKE INTO UDX
MOVEM S2,FRCUDX ;STORE UDX
MOVEM S1,FRCADR ;STORE ADDRESS
MOVEI S2,.TOTYP ;GET FUNCTION
MOVEM S2,FRCFCN ;STORE IT
MOVE S1,[3,,FRCFCN] ;GET TRMOP ARG
TRMOP. S1, ;DO IT
PJRST S..NGF ;SO WE LIE A LITTLE BIT
$RETT ;RETURN
FRCFCN: BLOCK 1
FRCUDX: BLOCK 1
FRCADR: BLOCK 1
; Routine called by the scheduler
I$SKSY::SKIPGE G$KSYS## ;TIMESHARING ENABLED?
$RETT ;NO--DON'T SET TIMER
GETLIM S1,.QELIM(AP),ACTV ;GET ACTIVE BIT
JUMPN S1,.RETT ;ACTIVE MEANS WE ALREADY SET TIMER
GETLIM S1,.QELIM(AP),REPT ;GET REPEAT BITS
TXNE S1,QB.NOW ;IS IT RIGHT NOW?
JRST SKSY.1 ;THEN DO IT RIGHT NOW!
PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,.QECRE(AP) ;GET EXPIRATION TIME
$CALL .UD2SC ;CONVERT TO SECONDS
MOVE P1,S1 ;SAVE
MOVE S1,G$NOW## ;GET CURRENT TIME
$CALL .UD2SC ;CONVERT TO SECONDS
SUB P1,S1 ;COMPUTE DIFFERENCE
SKIPG S1,P1 ;HAS THIS REQUEST EXPIRED?
JRST SKSY.1 ;YES
IDIVI S1,^D60 ;CONVERT TO MINUTES
CAIL S2,^D30 ;OVERFLOW?
ADDI S1,1 ;ROUND UP
CAILE S1,-2 ;SEE IF BEYOND 181 DAYS + 23:59
$RETT ;YES--THIS ONE CAN WAIT
JRST SKSY.2 ;ENTER COMMON CODE
SKSY.1: MOVNI S1,1 ;SET KSYS NOW
SKSY.2: HRLI S1,.STKSY ;GET SET KSYS FUNCTION
SKIPN DEBUGW ;DEBUGGING?
SETUUO S1, ;SET KSYS
JFCL ;SHOULDN'T FAIL
CAIE S1,0 ;CLEARING THE TIMER?
MOVEI S1,1 ;NO--THEN MARK AS ACTIVE
STOLIM S1,.QELIM(AP),ACTV ;SET/CLEAR ACTIVE FLAG
$RETT ;RETURN
; Routine called by the kill code
I$KKSY::GETLIM S1,.QELIM(AP),ACTV ;GET A BIT
JUMPE S1,.RETT ;RETURN IF REQUEST NOT PENDING
MOVEI S1,0 ;TURN ON TIMESHARING
SKIPL G$KSYS## ;TIMESHARING OVER?
PUSHJ P,SKSY.2 ;ENABLE TIMESHARING
POPJ P, ;RETURN
SUBTTL I$DINT & I$DTCI - Date/Time Change Interrupt Routines
; Initialize for Date/Time change interrupts
I$DINT: MOVX T1,.PCDTC ;GET DATE/TIME INTERRUPT FUNCTION CODE
MOVSI T2,<DTCBLK-INTBLK> ;GET OFFSET FROM BEGINNING OF VECTOR
SETZB T3,G$DTCI## ;DON'T NEED T3,,INIT DTC INTR FLAG
MOVEI S1,I$DTCI ;GET ADDRESS OF INTERRUPT ROUTINE
MOVEM S1,DTCBLK+.PSVNP ;SAVE ADDRESS
MOVX S1,<PS.FON+PS.FAC+T1> ;BUILD ARG AC
PISYS. S1, ;DO THE ENABLE
SKIPF ;COMPLAIN
$RETT ;RETURN
$WTO (<Couldn't enable for Date/Time Change interrupts via PSI system>,,,$WTFLG(WT.SJI))
SETOM DTCBLK+.PSVNP ;INVALIDATE INTERRUPT ROUTINE ADDRESS
$RETT ;RETURN
SUBTTL I$DTCI - Date/Time Change Interrupt Routine
I$DTCI: $BGINT 1,
AOS G$DTCI## ;COUNT DATE/TIME CHANGE INTERRUPTS
SETOM G$SCHD## ;FORCE A SCHEDULING PASS
MOVE S1,G$NOW## ;GET CURRENT TIME
MOVEM S1,G$OUDT## ;SAVE PREVIOUS UDT
MOVE P1,DTCDIF ;GET DATE/TIME CHANGE DIFFERENCE
ADDM P1,G$NOW## ;UPDATE G$NOW
; Change login times in MDR queue.
MOVE S1,MDRQUE## ;GET MDR LIST HANDLE
PUSHJ P,L%FIRST ;GET THE FIRST MDR ENTRY
TRNA ;SKIP 1ST TIME THRU
MDTC.1: PUSHJ P,L%NEXT ;GET NEXT MDR
JUMPF MDTC.2 ;CONTINUE ON IF NO MORE
ADDM P1,.MRLOG(S2) ;ADJUST LOGIN TIME
JRST MDTC.1 ;LOOP FOR ALL MDRS
; Change volume set creation time and operator mount notification time.
MDTC.2: MOVE S1,VSLQUE## ;GET VSL LIST HANDLE
PUSHJ P,L%FIRST ;GET FIRST ENTRY
TRNA ;SKIP 1ST TIME THRU
MDTC.3: PUSHJ P,L%NEXT ;GET NEXT VSL
JUMPF MDTC.4 ;IF NO MORE , CONTINUE
ADDM P1,.VSCRE(S2) ;ADJUST VSL CREATION TIME
SKIPE .VSSCH(S2) ;ONLY CHANGE SCHEDULED TIME IS NONZERO
ADDM P1,.VSSCH(S2)
JRST MDTC.3 ;LOOP FOR ALL VSLS
; Change volume mount time and volume (un)lock time
MDTC.4: MOVE S1,VOLQUE## ;GET VOL QUEUE LIST HANDLE
PUSHJ P,L%FIRST ;GET FIRST ENTRY
TRNA ;SKIP 1ST TIME THRU
MDTC.5: PUSHJ P,L%NEXT ;GET NEXT VOL BLOCK
JUMPF MDTC.6 ;IF NO MORE, CONTINUE
SKIPE .VLMTM(S2) ;ADJUST STRUCTURE MOUNT TIME
ADDM P1,.VLMTM(S2)
JRST MDTC.5 ;CONTINUE FOR ALL VOL BLOCKS
; Here to change the UDTs in the internal event list
MDTC.6: MOVE S1,G$EVENT## ;GET EVENT LIST HANDLE
PUSHJ P,L%FIRST ;GET FIRST ENTRY
TRNA ;SKIP 1ST TIME THRU
MDTC.7: PUSHJ P,L%NEXT ;GET NEXT LIST ENTRY
SKIPT
$DEBRK ;RETURN FROM INTERRUPT IF NO MORE
ADDM P1,.EVUDT(S2) ;UPDATE EVENT TIME
JRST MDTC.7 ;LOOP FOR ALL EVENTS
SUBTTL I$BATJ - Check for a batch job
; THIS ROUTINE WILL CHECK FOR EITHER A BATCON OR MIC BATCH
; JOB BASED ON THE JOB NUMBER SUPPLIED IN S1
I$BATJ::HRLZS S1 ;PUT IN LH
HRRI S1,.GTLIM ;GETTAB ARGUMENT
GETTAB S1, ;ASK MONITOR
MOVEI S1,0 ;ASSUME NOT
TXNE S1,JB.LBT ;BATCH BIT SET (EITHER BATCON OR MIC)?
$RETT ;YES--A BATCH JOB
$RETF ;ELSE NOT
SUBTTL I$AUTO - Initiate processing of SYS:SYSTEM.CMD
; THIS ROUTINE WILL QUEUE AN EVENT TO TAKE THE GALAXY STARTUP COMMAND
; FILE SYS:SYSTEM.CMD
I$AUTO::SKIPE DEBUGW ;DEBUGGING?
$RETT ;YES, DON'T CONFUSE THE ISSUE
MOVEI S1,.EVATO ;GET AUTO FILE EVENT CODE
PUSHJ P,Q$EVTI## ;GO CREATE SKELETON EQ
MOVX S1,QB.NOW ;ONLY ONE SHOT
STOLIM S1,.EQLIM(M),REPT ;STORE REPEAT FLAGS
$TEXT (<-1,,.EQTXT(M)>,<GALAXY start-up command file^0>) ;REASON TEXT
LOAD S1,.EQLEN(M),EQ.LOH ;GET OFFSET TO FP/FD AREA
ADD S1,M ;POINT AT START OF FP/FD AREA
MOVE S2,S1 ;GET A COPY
HRLI S1,ATOFF ;SET SOURCE FOR BLT
BLT S1,ATOFFL-1(S2) ;COPY THE FP/FD INTO THE EQ
MOVEI S1,1 ;SET COUNT OF FILES
STORE S1,.EQSPC(M),EQ.NUM ;...
MOVX S1,.QIFNC ;GET INTERNAL FUNCTION BIT
IORM S1,.MSTYP(M) ;LITE IT IN MESSAGE
PUSHJ P,Q$CREATE## ;CREATE THE AUTO FILE EVENT FOR REAL
$RETT
;FP/FD areas for GALAXY startup command file
ATOFF: $BUILD (FPMSIZ) ;BUILD FP
$SET (.FPLEN,FP.LEN,FPMSIZ) ;LENGTH OF FP
$EOB
$BUILD (FDMSIZ) ;BUILD FD
$SET (.FDLEN,FD.LEN,FDMSIZ) ;LENGTH OF FD
$SET (.FDSTR,,'SYS ') ;DEVICE
$SET (.FDNAM,,'SYSTEM') ;FILE NAME
$SET (.FDEXT,,'CMD ') ;EXTENSION
$EOB
ATOFFL==.-ATOFF ;LENGTH OF COMBINED FP/FD
SUBTTL I$SCDM - Process Schedule Bits Change Message
I$SCDM::DOSCHD ;[1502] FLAG THAT A SCHEDULING
$RETT ;[1502] PASS IS NEEDED.
END