Trailing-Edge
-
PDP-10 Archives
-
bb-jr93k-bb
-
10,7/galaxy/quasar/qsrdsp.mac
There are 39 other files named qsrdsp.mac in the archive. Click here to see a list.
TITLE QSRDSP - OPERATOR DISPLAY ROUTINES.
;
;
;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,ORNMAC
PROLOG (QSRDSP)
%%.QSR==:%%.QSR
QSRVRS==:QSRVRS
SUBTTL LOCAL STORAGE AND BRANCH TABLES
DEFINE X(STR,A,B),<
[ASCIZ/STR/]
>
;NOW DEFINE THE OBJECT (DEVICE) STATUS STRINGS
OBJSTC: STATUS ;DEFINE THE OBJECT STATUS STRINGS
STAPAR: [ASCIZ/ Status:/]
[ASCIZ/ Parameters:/]
LIMTYP: [ASCIZ/Min:Max Lim./] ;UNDEFINED
[ASCIZ/Min:Max Lim./] ;.OTRDR
[ASCIZ/Min:Max Lim./] ;.OTNCU
[ASCIZ/Page Limits /] ;.OTLPT
[ASCIZ/ Minutes /] ;.OTBAT
[ASCIZ/Card Limits /] ;.OTCDP
[ASCIZ/Min:Max Feet/] ;.OTPTP
[ASCIZ/ Minutes /] ;.OTPLT
[ASCIZ/Min:Max Lim./] ;.OTTRM
[ASCIZ/Min:Max Lim./] ;.OTJOB
[ASCIZ/Min:Max Lim./] ;.OTOPR
[ASCIZ/Min:Max Lim./] ;.OTIBM
[ASCIZ/Min:Max Lim./] ;.OTMNT
[ASCIZ/Min:Max Lim./] ;.OTXFR
[ASCIZ/Min:Max Lim./] ;.OTBIN
[ASCIZ/Min:Max Lim./] ;.OTRET
[ASCIZ/Min:Max Lim./] ;.OTNOT
[ASCIZ//] ;.OTDBM
[ASCIZ/Min:Max Lim./] ;.OTFAL
[ASCIZ//] ;.OTEVT
%UNLBL==1 ;VOLUME IS UNLABELED
%LABEL==2 ;VOLUME IS LABELED
SUBTTL ROUTINE DATA AREAS AND ITEXT STATEMENTS.
QUEBIT: BLOCK 1 ;SAVE AREA FOR THE QUEUE TYPES.
LSTUSR: BLOCK 1 ;AREA FOR THE USER ID.
LSTUSM: BLOCK 1 ;LSTUSR WILDCARD MASK
LSTJOB: BLOCK 1 ;JOB NAME TO LIST
LSTJBM: BLOCK 1 ;WILDCARD MASK FOR JOB NAME
LSTUNT: BLOCK 1 ;SPECIFIC UNIT TO LIST
LSTUTY: BLOCK 1 ;SPECIFIC UNIT TYPE TO LIST
LSTDND: BLOCK 1 ;DESTINATION NODE
LSTPND: BLOCK 1 ;PROCESSING NODE
LSTQNM: BLOCK QNMLEN ;LIST QUEUE NAME
LISFLG: BLOCK 1 ;FLAGS FROM LIST REQUEST
LISTYP: BLOCK 1 ;FLAG: 0=FAST, -1=NORMAL, 1=ALL
LSTSUM: BLOCK 1 ;SUMMARY FLAG (0=NO, 1=YES)
LSTSMH: BLOCK 1 ;SUMMARY HEADER FLAG
LSTSMQ: BLOCK 10 ;SUMMARY ASCIZ QUEUE NAME
LSTSMT: BLOCK 1 ;TOTAL RUNTIME, PAGES, MINUTES, ETC.
BLKADR: BLOCK 1 ;MESSAGE BLOCK ADDRESS.
OBTYPE: BLOCK 1 ;OBJECT TYPE
ACTIVE: BLOCK 1 ;ACTIVE JOB COUNT.
ATRIB: BLOCK 1 ;"STREAM/UNIT NEEDS ATTRIBUTES LISTED" FLAG
REMOTE: BLOCK 1 ;REMOTE SWITCH 0=NO, -1=YES
LIMIT: BLOCK 1 ;QUEUE LIMIT WORD.
LASTPT: BLOCK 2 ;LAST BYTPTR AND BYTCNT FOR QUEUE LISTINGS
NOROOM: BLOCK 1 ;FLAG TO INDICATE THE OUTPUT PAGE IS FULL.
ENTYPE: BLOCK 1 ;ENTRY TYPE (-1=OPERATOR, 0=QUEUE)
JOBNBR: BLOCK 1 ;JOB/DEVICE COUNT.
NODE6B: BLOCK 1 ;SIXBIT NODE NAME.
KLUDGE: BLOCK 1 ;[1206]KLUDGE FLAG TO HANDLE SHO Q CONFLICTS
BYTPTR: BLOCK 1 ;BYTE POINTER FOR $TEXT ROUTINE.
BYTCNT: BLOCK 1 ;NUMBER OF BYTES AVAILABLE IN THE OUTPUT PAGE.
DATADR: BLOCK 1 ;PAGE ADDR WHERE .WTTXT DATA STARTS.
SHWTYP: BLOCK 1 ;DISPLAY TYPE: -1=PARAMETERS, 0=STATUS.
ACKCOD: BLOCK 1 ;OPERATOR ACK CODE.
TIME.: BLOCK 3 ;TIME IN HOURS, MINUTES, SECONDS.
JOBACT: BLOCK 1 ;JOB ACTIVE FLAG. (-1=YES, 0=NO)
QEMPTY: BLOCK 1 ;FLAG TO INDICATE IF THE QUEUES ARE EMPTY.
HDRSAV: BLOCK 1 ;QUEUE HEADER SAVE BLOCK.
CRLFLG: BLOCK 1 ;FLAG FOR INSERTING A CRLF
DEVICE: BLOCK 1 ;SIXBIT DEVICE NAME FOR TAPE MOUNTS
OBJADR: BLOCK 1 ;MSG OBJECT BLOCK ADDRESS
DEFINE $ASCII(MSG),<
PUSHJ P,ASCOUI ;;CALL THE IN-LINE ASCII OUTPUTTER
CAI [ASCIZ+MSG+] ;;AIM AT THE MESSAGE
>;END $ASCII DEFINE
JS: ITEXT (<^W6L /.QEJOB(AP)/ ^D6R /.QERID(AP)/ >)
TIM: ITEXT (<^D2R0/TIME./:^D2R0/TIME.+1/:^D2R0/TIME.+2/>)
ONOFL: [ASCIZ/Offline/]
[ASCIZ/Online /]
[ASCIZ/Active /]
[ASCIZ/Server /]
IBMTYP: [ASCIZ\ \]
[ASCIZ\3780\]
[ASCIZ\2780\]
[ASCIZ\HASP\]
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
IBMODE: [ASCIZ/ /]
[ASCIZ/Termination/]
[ASCIZ/Emulation/]
[ASCIZ/Proto-termination/]
IBMDTR: [ASCIZ/ /]
[ASCIZ/ On/]
[ASCIZ/Off/]
IBMTIM: [ASCIZ/ /]
[ASCIZ/Primary/]
[ASCIZ/Secondary/]
IBMPOR: [ASCIZ/DL10/]
[ASCIZ/DTE/]
SYSPRM %OTLEN,^D48,^D48 ;OUTPUT QUEUE LINE LENGTH
IFE INPCOR,<SYSPRM %INLEN,^D48,^D48 > ;INPUT QUEUE LINE LENGTH
IFN INPCOR,<SYSPRM %INLEN,^D55,^D48 > ;INPUT QUEUE LINE LENGTH WITH 'CORE'
QUENAM: POINT 8, QNM.QN(AP) ;POINTER TO QUEUE NAME
QUEQUE: POINT 8, .QEQNM(AP) ;DITTO FOR A QE
QNMTYP: [ASCIZ /Local/]
[ASCIZ /Remote/]
;DEFINE THE MODULE ENTRY POINTS.
INTERN D$SHQS ;SHOW QUEUES PROCESSOR.
INTERN D$LIST ; ' ' ' ' '
INTERN D$SHST ;SHOW STATUS PROCESSOR.
INTERN D$SHPR ;SHOW PARAMETER PROCESSOR.
INTERN D$SHRT ;SHOW ROUTE TABLE PROCESSOR.
INTERN D$NPRM ;SHOW IBM NETWORK PARAMETERS
INTERN D$NSTS ;SHOW NETWORK STATUS (ONLINE/OFFLINE)
EXTERN USR ;USR IS AN ITEXT MACRO DEFINED IN QSRT10 & QSRT20.
;IT DEFINES THE OWNER OF A PARTICULAR QUEUE ENTRY.
EXTERN MNTUSR ;SAME AS ABOVE EXCEPT FOR THE MOUNT QUEUES
EXTERN STRUCT ;STRUCT IS AN ITEXT MACRO DEFINED IN QSRT10 & QSRT20
;IT DEFINES THE STRUCTURE NAME
EXTERN LABELS ;LABEL TYPE DISPATCH BLOCK
EXTERN G$MSG ;PLACE FOR MESSAGE GENERATION
EXTERN DENSTY ;DENSITY TRANSLATION TABLE IN QSRMDA
EXTERN TRK ;TRACK STATUS TABLE
EXTERN VOLQUE ;VOLUME QUEUE ID
TOPS10< EXTERN DEVNTB > ;DEVICE TRANSLATION TABLE
SUBTTL D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST.
D$SHQS: SETZM G$ACK## ;INDICATE WE DONT WANT AN ACK.
SKIPA S1,[-1] ;INDICATE 'OPERATOR' ENTRY POINT.
D$LIST: SETZ S1, ;INDICATE 'QUEUE' ENTRY POINT.
MOVEM S1,ENTYPE ;AND SET IT.
PUSHJ P,.SAVE3 ;SAVE 3 AC'S
SETZM QEMPTY ;RESET THE QUEUES EMPTY FLAG.
SETZM ACTIVE ;ZERO THE JOB ACTIVE COUNT.
SETZM NOROOM ;CLEAR NO MORE ROOM INDICATOR
SETZM BYTPTR ;INDICATE NO OUTPUT PAGE YET ..
SETOM JOBNBR ;RESET THE NUMBER OF JOBS COUNT.
SETOM LSTSMH ;RESET SUMMARY HEADER FLAG
SETZM LSTSMT ;ZAP TOTAL RUNTIM, PAGES, MINUTES, ETC.
PUSHJ P,GETPARMS ;BREAK DOWN THE INCOMMING MESSAGE.
JUMPF E$MTS## ;IF AN ERROR OCCURED,,PROCESS IT.
$COUNT (MLST) ;BUMP LIST COUNT.
SKIPN P1,QUEBITS ;GET THE QUEUE BITS.
PJRST E$ILM## ;NO QUEUES,,NOT VALID.
MOVX S1,MF.NOM ;GET 'NO MESSAGE BITS'
SKIPE G$ACK## ;DOES HE WANT AN ACK ???
PUSHJ P,G$MSND## ;YES,,DO IT !!
TXNE P1,LIQMNT ;DO WE WANT THE TAPE/DISK MOUNT QUEUE ?
PUSHJ P,D$SMNT ;YES,,GO DO IT
MOVEI H,TBLHDR## ;GET THE POINTER TO THE FIRST QUEUE.
MOVEI P2,NQUEUE## ;GET THE NUMBER OF QUEUES.
LIST.1: TDNE P1,.QHLIS(H) ;DOES HE WANT THIS QUEUE.
PUSHJ P,SHOWQS ;YES,,DUMP IT.
ADDI H,QHSIZE ;POINT TO THE NEXT QUEUE.
SOJG P2,LIST.1 ;AND TRY THE NEXT ONE.
$COUNT (NLAP) ;COUNT PAGES SENT
PUSHJ P,CHKRMQ ;SEE IF A REMOTE QUEUE LISTING NEEDED
MOVE P1,TF ;REMEMBER HERE
SKIPE QEMPTY ;ARE THE QUEUES EMPTY ???
JRST LIST.2 ;NO
SKIPE ENTYPE ;WAS THIS AN USER REQUEST ???
JRST LIST.4 ;NO
MOVEI S1,[ASCIZ/ System Queues Listing /] ;GENERATE THE ID
PUSHJ P,SETPAG ;GO SETUP THE PAGE
MOVEI S1,[ITEXT ()] ;NULL ITEXT STRING
SKIPF P1 ;WILL WE ASK THE NET QUEUE CTLR?
MOVEI S1,[ITEXT (<local >)] ;YES, INDICATE THERE MIGHT BE MORE
$TEXT (DEPBYT,<[The ^I/0(S1)/queues are empty]^A>)
LIST.2: JUMPF P1,LIST.3 ;SEND LAST MESSAGE IF NO REMOTE LISTING
PUSHJ P,CRLF ;ADD A CRLF
PUSHJ P,ASKNQC ;ASK NQC FOR THE QUEUE LISTING
JUMPF LIST.3 ;WE TRIED AND FAILED
PUSHJ P,SNDMSG ;SEND LAST PAGE, BUT SET WT.MOR SINCE
; NQC WILL BE SENDING TEXT
$RETT ;AND RETURN
LIST.3: PUSHJ P,SENDIT ;SEND IT OFF
$RETT ;AND RETURN
LIST.4: MOVEI S1,[ITEXT ()] ;NULL ITEXT STRING
SKIPF P1 ;WILL WE ASK THE NET QUEUE CTLR?
MOVEI S1,[ITEXT (<local >)] ;YES, INDICATE THERE MIGHT BE MORE
$ACK (<The ^I/0(S1)/queues are empty>,,,ACKCOD) ;YES,,RESPOND !!
JUMPF P1,.RETT ;DONE IF WE DON'T NEED TO ASK NQC
PUSHJ P,ASKNQC ;ASK NQC FOR A REMOTE LISTING
$RETT ;AND RETURN
; ROUTINES TO SUPPORT SUMMARY LISTINGS
LIST.S: $TEXT (<-1,,LSTSMQ>,<^T/(S1)/^0>) ;PRINT QUEUE NAME
AOSN LSTSMH ;OUTPUT SUMMARY HEADER YET?
$TEXT (DEPBYT,<^T/LIST.H/^A>) ;PRINT IT NOW
MOVE S1,JOBNBR ;GET COUNT
SKIPE (S2) ;HAVE SUMMARY QUANTITY TEXT?
CAIN S1,1 ;YES--JUST ONE?
TDZA S1,S1 ;SINGULAR
MOVSI S1,(ASCIZ/s/) ;PLURAL
$TEXT (DEPBYT,<^T11L /LSTSMQ/ ^D4R /JOBNBR/ ^T/(S2)/^T/S1/^A>)
$RETT ;RETURN
LIST.X: MOVE S1,HDRSAV ;GET SAVED QUEUE HEADER
SKIPE .QHSUM(S1) ;CHECK
PUSHJ P,@.QHSUM(S1) ;GENERATE SUMMARY DATA
MOVE S1,HDRSAV ;GET SAVED QUEUE HEADER
$TEXT (DEPBYT,< ^T/@.QHSQT(S1)/^A>)
$RETT ;RETURN
LIST.D::$TEXT (DEPBYT,<; ^D/LSTSMT/^A>) ;OUTPUT TOTALS IN DECIMAL
POPJ P, ;RETURN
LIST.T::MOVE S1,LSTSMT ;GET TOTAL TIME
IDIVI S1,^D60 ;GET # OF SECONDS.
MOVEM S2,TIME.+2 ; AND SAVE IT.
IDIVI S1,^D60 ;GET HOURS,MINUTES.
MOVEM S1,TIME. ;SAVE HOURS.
MOVEM S2,TIME.+1 ;SAVE MINUTES.
$TEXT (DEPBYT,<; ^I/TIM/^A>) ;OUTPUT TIME
POPJ P, ;RETURN
LIST.H: ASCIZ /
Queue Totals
----------- --------------------------
/
SUBTTL D$SHST - ROUTINE TO SHOW DEVICE STATUS.
; D$SHPR - ROUTINE TO SHOW PARAMETERS.
D$SHPR: SKIPA S1,[1] ;INDICATE THE PARAMETERS ENTRY POINT.
D$SHST: SETZ S1, ;INDICATE THE SHOW STATUS ENTRY POINT.
MOVEM S1,SHWTYP ;SAVE THE ENTRY STATUS.
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
PUSHJ P,.SAVET ;SAVE THE T ACS.
SETOM ENTYPE ;INDICATE 'OPERATOR' MESSAGE
SETZM QEMPTY ;INDICATE NO OBJECTS FOUND
SETZM OBTYPE ;ZERO THE OBJECT TYPE.
PUSHJ P,GETPARMS ;GO BREAK DOWN THE MESSAGE
SKIPN OBJADR ;MAKE SURE WE GOT AN OBJECT BLOCK
$RETT ;NONE THERE,,THATS AN ERROR
LOAD T1,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJ QUEUE ENTRY.
STPR.1: JUMPE T1,STPR.4 ;NO MORE,,RETURN.
LOAD T2,OBJTYP(T1) ;GET THE OBJ TYPE.
JUMPLE T2,STPR.3 ;NOT VALID,,TRY NEXT.
PUSHJ P,CHKOBJ ;DO WE WANT THIS OBJECT ???
JUMPF STPR.3 ;NO,,TRY THE NEXT ONE
MOVE P1,S1 ;SAVE THE NODE DB ENTRY ADDR IN S1
CAME T2,OBTYPE ;ARE WE PROCESSING A NEW QUEUE TYPE ???
PUSHJ P,CHKQUE ;YES,,GO SCAN FOR ACTIVE/REMOTE STATUS.
SKIPE NOROOM ;[1177]ROOM IN THE CURRENT BUFFER ?
PUSHJ P,PAGOVF ;[1177]NO,,SEND CURRENT AND CONTINUE
$TEXT (DEPBYT,< ^D4R /OBJUNI(T1)/ ^A>) ;PUT OUT THE UNIT/STREAM #
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$TEXT (DEPBYT,<^N10R /OBJNOD(T1)/ ^A>) ;PUT OUT THE NODE NAME
SKIPN SHWTYP ;IF THIS IS SHOW STATUS,
PUSHJ P,SHSTAT ;THEN GO GET THE STATUS.
SKIPE SHWTYP ;IF THIS IS SHOW PARAMETERS,, THEN
PUSHJ P,SHPARM ;GO GET THE PARAMETERS.
STPR.3: LOAD T1,.QELNK(T1),QE.PTN ;GET NEXT OBJ QUEUE ENTRY.
JRST STPR.1 ;GO PROCESS IT.
STPR.4: SKIPN S1,QEMPTY ;WAS ANYTHING PUT OUT ???
JRST STPR.5 ;NO,,TELL THE OPERATOR
JUMPG S1,.RETT ;JUST DN60 MSGS ??? - RETURN
PUSHJ P,CRLF ;OUTPUT A CRLF.
SKIPE SHWTYP ;IF 'SHOW PARM' THEN SEND
PJRST SENDIT ; THE MESSAGE AND RETURN
PUSHJ P,I$SYSV## ;UPDATE THE SYSTEM VARIABLES
SKIPN S1,G$KSYS## ;IF NO KSYS IS PENDING,,THEN SEND
PJRST SENDIT ; THE MESSAGE AND RETURN
SKIPG S1 ;TIMESHARING OVER ???
$TEXT(DEPBYT,<* Timesharing is over - no scheduling will be done^M^J>)
JUMPL S1,SENDIT ;YES,,TELL OPR AND RETURN
CAIGE S1,^D24*^D60*^D60 ;WITHIN 24 HOURS?
PUSHJ P,EXPTIM ;YES, EXPAND TIME INTO READABLE TEXT
PJRST SENDIT ;SEND THE MESSAGE AND RETURN.
STPR.5: MOVE S1,OBJADR ;GET THE OBJECT BLOCK ADDRESS
SKIPL OBJ.UN(S1) ; OR ALL UNITS ???
JRST STPR.6 ;NO,,SEND A SPECIFIC MSG
$ACK (<There are no devices started>,,,ACKCOD) ;YES,,TELL THE OPR
$RETT ;AND RETURN
STPR.6: HRRZS OBJ.UN(S1) ;Make certain there is no high range
$ACK (<Device unknown>,,0(S1),ACKCOD) ;SEND A SPECIFIC MSG
$RETT ;AND RETURN
SUBTTL EXPTIM - Expand time
; Expand time from seconds to hours and minutes
; CALL: MOVE S1,time in seconds
; PUSHJ P,EXPTIM
;
; On return, some pretty text will be generated
;
EXPTIM: $SAVE <T1,T2,T3> ;SAVE SOME ACS
IDIVI S1,^D60*^D60 ;S1:= HOURS
IDIVI S2,^D60 ;S2:= MINUTES
CAIN S1,0 ;HOURS?
MOVEI T1,[ITEXT (<>)] ;NO
CAIN S1,1 ;1 HOUR?
MOVEI T1,[ITEXT (<^D/S1/ hour >)] ;YES
CAILE S1,1 ;MORE THAN ONE HOUR?
MOVEI T1,[ITEXT (<^D/S1/ hours >)] ;YES
SKIPE S1 ;HAVE HOURS?
SKIPN S2 ;HAVE MINUTES?
SKIPA T2,[[ASCIZ ||]] ;JUST ONE OR THE OTHER
MOVEI T2,[ASCIZ |and |] ;HAVE BOTH
CAIN S2,0 ;MINUTES?
MOVEI T3,[ITEXT (<>)] ;NO
CAIN S2,1 ;1 MINUTE?
MOVEI T3,[ITEXT (<^D/S2/ minute>)] ;YES
CAILE S2,1 ;MORE THAN 1 MINUTE?
MOVEI T3,[ITEXT (<^D/S2/ minutes>)] ;YES
$TEXT(DEPBYT,<* Timesharing will cease in ^I/(T1)/^T/(T2)/^I/(T3)/^M^J>)
POPJ P, ;RETURN
SUBTTL CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS
;CALL: T1/ OBJECT BLOCK ADDRESS
;
;RET: S1/ The Network Data Base Addr
; False if no good
CHKOBJ: MOVE S1,OBJSCH(T1) ;GET THE SCHEDULING BITS
TXNE S1,OBSINV ;IS THIS AN INVISIBLE OBJECT ???
$RETF ;YES,,RETURN NOW.
TXNE S1,OBSFRR ;CANT BE FREE-RUNNING AND
SKIPN SHWTYP ; 'SHOW PARAMATERS'
JRST CHKO.A ;IF NOT,, THEN HE WINS
MOVE S2,OBJTYP(T1) ;GET OBJECT TYPE
CAIE S2,.OTFAL ;FAL IS FREE RUNNING AND HAS PARMS
$RETF ;ELSE TOUGH BREAKEEEEE
CHKO.A: MOVE S2,OBJADR ;GET THE MESSAGE OBJ BLOCK ADDRESS
SKIPL S1,OBJ.TY(S2) ;CHECK THE MSG OBJ TYPE,,-1 WINS
CAMN S1,OBJTYP(T1) ;COMPARE AGAINST OBJ Q ENTRY
SKIPA ;WIN ON EITHER,,SKIP
$RETF ;NO GOOD,,RETURN
SKIPL S1,OBJ.UN(S2) ;CHECK THE MSG UNIT #,,-1 WINS
CAMN S1,OBJUNI(T1) ;COMPARE AGAINST OBJ Q ENTRY
JRST CHKO.0 ;We win, continue on
;Check for within the range.
LOAD S1,OBJ.UN(S2),OU.HRG ;Get the high range
CAMGE S1,OBJUNI(T1) ;Within the high range?
$RETF ;No - return
LOAD S1,OBJ.UN(S2),OU.LRG ;Get the low range
CAMLE S1,OBJUNI(T1) ;Within low range?
$RETF ;No again
CHKO.0: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE S1,OBJNOD(T1) ;GET THE OBJECTS NODE NAME
PUSH P,S2 ;SAVE THE OBJECT ADDRESS FOR A SECOND
PUSHJ P,N$NODE## ;FIND ITS ENTRY IN OUR DATA BASE
MOVE P1,S2 ;SAVE/RETURN THE ADDRESS IN P1
POP P,S2 ;RESTORE THE OBJECT ADDRESS
MOVE S2,OBJ.ND(S2) ;[1206]GET THIS OBJECT NODE
CAMN S2,[-1] ;[1206]IS IT ALL NODES?
JRST CHKO.1 ;[1206]YES, SKIP THIS
MOVE S1,OBJNOD(T1) ;[1206]GET THE OBJECTS NODE NAME
$CALL N$MTCH ;[1206]CHECK FOR MATCH
$RETIF ;[1206]QUIT IF NOT THIS ONE
CHKO.1: MOVE S1,OBJSCH(T1) ;GET THE SCHEDULING BITS
TXNE S1,OBSSIP!OBSSUP!OBSIGN ;IF SIP OR SETUP OR IGNORE
SKIPN OBJPID(T1) ;AND A PROCESSOR,,THEN
TRNA
JRST CHKO.2 ; SKIP THIS CODE
TXNE S1,OBSSTA ;IF NOT STARTED,,THEN SKIP THIS CODE
SKIPE SHWTYP ;OR IF SHOWING PARAMETERS,,THEN
JRST CHKO.3 ; SKIP THIS CODE
MOVE S1,OBJTYP(T1) ;ELSE GET OBJECT TYPE
LOAD S2,OBJDAT(T1),RO.ATR ;AND GET STREAM OR UNIT ATTRIBUTES
PUSHJ P,A$LPSB## ;FIND PSB ASSOCIATED WITH STREAM OR UNIT
JUMPT CHKO.2 ;ALL SET IF THERE WAS ONE
MOVX S1,%NOPRC ;GET "NO PROCESSOR" STATUS
MOVEM S1,OBJSTS(T1) ;ASSUME SO UNTIL WE KNOW BETTER
MOVE S1,OBJTYP(T1) ;GET OBJECT TYPE AGAIN
LOAD S2,OBJDAT(T1),RO.ATR ;AND GET STREAM OR UNIT ATTRIBUTES
PUSHJ P,I$GOPD## ;GET PROCESSOR'S CJB
JUMPF CHKO.3 ;HMMM. JUST SAY NO PROCESSOR
LOAD S2,CJB.FL(S1),CJ.QSR ;GET OBJECT PROCESSOR TYPE
MOVX TF,%INACT ;GET INACTIVE STATUS
CAXN S2,%DEMND ;A DEMAND SPOOLER?
MOVEM TF,OBJSTS(T1) ;YES, CHANGE STATUS
JRST CHKO.3 ;CONTINUE
CHKO.2: MOVE S1,OBJSTS(T1) ;GET CURRENT STATUS WORD
CAXE S1,%NOPRC ;WAS IT "NO PROCESSOR" ?
CAXN S1,%INACT ;OR "INACTIVE"?
TRNA ;YES, UPDATE THE STATUS
JRST CHKO.3 ;NO - LEAVE IT ALONE
MOVE S1,T1 ;GET OBJECT BLOCK ADDRESS
PUSHJ P,A$OBST## ;UPDATE STREAM OR UNIT STATUS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CHKO.3: MOVE S1,P1 ;WE WANT TO RETURN NODE DB ADDR IN S1
LOAD S2,NETSTS(P1),NETIBM ;IS THIS A DN60 REMOTE STATION ???
JUMPE S2,.RETT ;NO,,RETURN NOW
LOAD S2,NETSTS(P1),NT.MOD ;YES,,GET ITS OPERATION MODE
CAXE S2,DF.EMU ;IS IT EMULATION MODE ???
$RETT ;NO,,JUST RETURN
SKIPN SHWTYP ;[1231] YES,,IS THIS 'SHOW STATUS' ???
SKIPN OBJPID(T1) ;IS THE SPOOLER SIGN'D ON ???
$RETT ;NO,,JUST RETURN
;Here is we have to send the msg to the emulation spooler so that
; it can do the show status display...
MOVE S1,[G$SAB,,G$MSG] ;COPY THE SAB TO SOME
BLT S1,G$MSG+SAB.SZ-1 ; TEMP BUFFER WHILE IN THIS SECTION
SKIPN QEMPTY ;HAVE WE SETUP AN OUTPUT MSG YET ???
AOS QEMPTY ;NO,,INDICATE SOME DN60 ACTION
PUSHJ P,M%GPAG ;GET A PAGE FOR IPCF
MOVEM S1,G$SAB##+SAB.MS ;SAVE THE MSG ADDRESS
MOVX S2,PAGSIZ ;GET THE TOTAL MSG LENGTH
MOVEM S2,G$SAB##+SAB.LN ;AND SAVE IT
SETZM G$SAB##+SAB.SI ;NO SPECIAL INDEX
SETZM G$SAB##+SAB.PB ;NO PIB EITHER
MOVE S2,OBJPID(T1) ;GET THE EMULATION SPOOLERS PID
MOVEM S2,G$SAB##+SAB.PD ;SAVE AS THE RECIEVERS PID
LOAD S2,.MSTYP(M),MS.CNT ;GET THE ORIGIONAL MSG LENGTH
ADDI S2,-1(S1) ;GET END ADDRESS -1
HRL S1,M ;GET SOURCE,,DEST
BLT S1,0(S2) ;COPY THE ORIGIONAL MSG OVER
MOVE S1,OBJADR ;GET THE PTR TO THE OBJ BLK IN THE MSG
SUB S1,M ;GET THE OFFSET TO THE OBJECT BLOCK
ADD S1,G$SAB##+SAB.MS ;POINT TO THE 2'OND MSG OBJECT BLOCK
MOVE S2,OBJNOD(T1) ;GET THIS OBJECTS NODE NAME
MOVEM S2,OBJ.ND(S1) ;AND SAVE IT IN THE MSG
PUSHJ P,C$SEND## ;SEND THE MSG OFF
MOVE S1,[G$MSG,,G$SAB] ;RESTORE THE ORIGIONAL
BLT S1,G$SAB+SAB.SZ-1 ; SAB FROM THE TEMP BUFFER
$RETF ;MUST RETURN FALSE TO SKIP THIS OBJECT
SUBTTL SHOW STATUS/PARAMETERS MESSAGE HEADING ROUTINE
STAHDR: MOVEI S1,[ASCIZ/ System Device Status /] ;GET THE MESSAGE HEADER.
SKIPE SHWTYP ;IF SHOW PARAMETERS,,SET UP HEADER.
MOVEI S1,[ASCIZ/ System Device Parameters /]
PUSHJ P,SETPAG ;SET UP THE PAGE FOR OUTPUT.
SETOM QEMPTY ;INDICATE AN OBJECT WAS FOUND
$RETT ;AND RETURN
SUBTTL CHKQUE - ROUTINE TO SCAN AND SET UP OBJECT HEADERS
CHKQUE: SKIPN OBTYPE ;IS THIS THE FIRST TIME THROUGH ???
PUSHJ P,STAHDR ;YES,,GO SET UP THE OUTPUT PAGE HEADER
MOVEM T2,OBTYPE ;SAVE THE CURRENT OBJECT TYPE
SETZM ACTIVE ;INDICATE NO ACTIVE JOBS
SETZM REMOTE ;INDICATE NO REMOTE STATIONS
SETZM ATRIB ;INDICATE NO SPECIAL OBJECT ATTRIBUTES
PUSH P,T1 ;SAVE THE CURRENT OBJECT ADDRESS
CHKQ.1: MOVE S1,OBJNOD(T1) ;GET THE OBJECTS LOCATION
PUSHJ P,N$LOCL## ;CHECK TO SEE IF LOCAL OR REMOTE
SKIPT ;TRUE - ITS LOCAL
SETOM REMOTE ;ELSE ITS REMOTE
MOVE S1,OBJSCH(T1) ;GET THE SCHEDULING BITS
TXC S1,OBSBUS ;COMPLIMENT BUSY BIT
TXNN S1,OBSBUS+OBSFRR ;MUST BE BUSY AND NOT FREE RUNNING
SETOM ACTIVE ;YES,,SET ACTIVE FOR LATER
MOVE S2,OBJTYP(T1) ;GET OBJECT TYPE
CAXN S2,.OTFAL ;FAL? (FAL'S FREE-RUNNING)
TXNE S1,OBSBUS ;FAL BUSY? (N.B. OBSBUS WAS TXC'D)
TRNA ;NOT FAL OR NOT BUSY
SETOM ACTIVE ;IT IS FAL AND IT'S BUSY, SAY SO
CAXE S2,.OTBAT ;IS IT BATCH ?
JRST CHK1.A ;NO
LOAD S1,OBJDAT(T1),RO.ATR ;GET ATTRIBUTE FIELD
CAXN S1,%SITGO ;SITGO ??
SETOM ATRIB ;YES
CHK1.A: LOAD T1,.QELNK(T1),QE.PTN ;GET THE NEXT OBJECT IN THE CHAIN
JUMPE T1,CHKQ.2 ;NO MORE,,PUT OUT THE HEADER
MOVE S1,OBJTYP(T1) ;GET THIS OBJECTS TYPE CODE
CAMN S1,OBTYPE ;ARE THEY THE SAME ???
JRST CHKQ.1 ;YES,,GO CHECK IT OUT
CHKQ.2: POP P,T1 ;RESTORE T1 TO ORIGIONAL OBJ ADDRESS
PUSHJ P,CRLF ;OUTPUT A CRLF
MOVE S1,SHWTYP ;GET THE 'SHOW' TYPE
$TEXT (DEPBYT,<^1/OBTYPE/^T/@STAPAR(S1)/>) ;GEN THE HEADING
CAIN T2,.OTFAL ;FAL?
JRST CHKQ.4 ;YES, GO DO ITS THING
CAIN T2,.OTNQC ;NETWORK QUEUE CONTROLLER?
JRST CHKQ.6 ;YES
CAIE T2,.OTBAT ;IS THIS BATCH ???
JRST CHKQ.3 ;NO,,ASSUME ITS OUTPUT
$ASCII (< Strm >) ;START THE HEADING
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (< Node >) ;YES,,PUT OUT A HEADING FOR THEM
SKIPE SHWTYP ;IS IT 'SHOW STATUS' ???
JRST CHK.2A ;NO,,MUST BE 'SHOW PARAMETERS' !!!
;SET UP BATCH 'SHOW STATUS' HEADINGS
$ASCII (< Status >) ;PUT OUT SOME MORE HEADING
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (<Jobname Req# User>) ;YES,,PUT OUT A HEADING
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- >)
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES,,UNDERLINE IT
$ASCII (<--------------- >) ;UNDERLINE STATUS
SKIPE ACTIVE ;ANY ACTIVE ???
$ASCII (<------- ------ ------------------------>)
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;SET UP BATCH 'SHOW PARAMETERS' HEADINGS
CHK.2A:
IFE INPCOR,< $ASCII (< Minutes Prio Opr-Intvn>)>
IFN INPCOR,< $ASCII (< Minutes Prio Core limits Opr-Intvn>)>
SKIPE ATRIB ;NEED TO LIST ATTRIBUTES ?
$ASCII (< Attributes>) ;YES
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- >) ;UNDERLINE 'STRM'
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES,,UNDERLINE IT
IFE INPCOR,< $ASCII (<------------- ----- --------->)>
IFN INPCOR,< $ASCII (<------------- ----- ----------- --------->)>
SKIPE ATRIB ;NEED TO LIST ATTRIBUTES ?
$ASCII (< ---------->) ;YES
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;OUTPUT QUEUE 'SHOW STATUS' HEADINGS
CHKQ.3: $ASCII (< Unit >) ;START THE HEADING
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (< Node >) ;YES,,PUT OUT A HEADING FOR THEM
SKIPE SHWTYP ;IS THIS 'SHOW STATUS' ???
JRST CHK.3A ;NO,,MUST BE 'SHOW PARAMETERS' !!!
$ASCII (< Status >) ;STATUS HEADING
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (<Jobname Req# User>) ;YES.....
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- >) ;UNIT UNDERLINE
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES......
$ASCII (<--------------- >) ;OUTPUT STATUS UNDERLINE
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (<------- ------ ------------------------>) ;YES...
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;OUTPUT QUEUE 'SHOW PARAMETERS' HEADING
CHK.3A: MOVE S1,OBTYPE ;GET THE OBJECT TYPE
MOVE S1,LIMTYP(S1) ;GET THE LIMIT DESCRIPTION ADDRESS
PUSHJ P,ASCOUT ;PUT IT OUT
$ASCII (< Form Prio Lim Ex Dev-Chars>) ;REST OF HEADING
PUSHJ P,CRLF ;START NEXT LINE
$ASCII (< ---- >) ;'UNIT' UNDERLINE
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES,,UNDERLINE ITS HEADING
$ASCII (<------------ ------ ----- ------- --------->) ;REST OF HDNG
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;SETUP SHOW STATUS FAL-STREAM DISPLAY HEADER
CHKQ.4: SKIPE SHWTYP ;SHOW STATUS?
JRST CHKQ.5 ;NO, MUST BE SHOW PARAMTERS
$ASCII (< Strm >) ;START THE HEADING
$ASCII (< Status >) ;PUT OUT SOME MORE HEADING
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (< Node Connect Time Bytes>) ;YES, OUTPUT HEADING
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- --------------- >) ;UNDERLINE STREAM AND STATUS
SKIPE ACTIVE ;ANY ACTIVE ???
$ASCII (<------ ------------ ------->)
PJRST CRLF ;START A NEW LINE AND RETURN
;SET SHOW PARAMTERS FAL-STREAM DISPLAY HEADER
CHKQ.5: $ASCII (< Strm Network>)
PUSHJ P,CRLF
$ASCII (< ---- ------->)
PJRST CRLF
;SETUP SHOW STATUS NETWORK-QUEUE-CONTROLLER STREAM DISPLAY HEADER
CHKQ.6: SKIPE SHWTYP ;SHOW STATUS?
JRST CHKQ.7 ;NO, MUST BE SHOW PARAMTERS
$ASCII (< Strm >) ;START THE HEADING
$ASCII (< Status >) ;PUT OUT SOME MORE HEADING
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (< Node Link Connect Time Bytes>) ;YES, OUTPUT HEADING
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- --------------- >) ;UNDERLINE STREAM AND STATUS
SKIPE ACTIVE ;ANY ACTIVE ???
$ASCII (<------ ------ ------------ ------->)
PJRST CRLF ;START A NEW LINE AND RETURN
;SET SHOW PARAMTERS NETWORK-QUEUE-CONTROLLER STREAM DISPLAY HEADER
CHKQ.7: $ASCII (< Strm Attribute>)
PUSHJ P,CRLF
$ASCII (< ---- --------->)
PJRST CRLF
SUBTTL D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE.
EXTERN G$MSG ;MAKE THIS ACCESSABLE !!!
D$SHRT: SETOM ENTYPE ;INDICATE THIS IS AN OPERATOR REQUEST.
LOAD S1,.MSCOD(M) ;GET THE ACK CODE.
STORE S1,ACKCOD ; AND SAVE IT.
MOVE S1,RTEQUE## ;GET THE ROUTE TABLE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
JUMPF SHRT.4 ;NONE THERE,,THATS AN ERROR
PUSH P,S2 ;SAVE THE FIRST ENTRY ADDRESS
MOVEI S1,[ASCIZ/ System Device Routing Table /] ;GET THE HEADING.
PUSHJ P,SETPAG ;SET UP AN OUTPUT PAGE.
PUSHJ P,CRLF ;OUTPUT A CRLF.
POP P,S1 ;RESTORE THE FIRST ENTRY ADDRESS
JRST SHRT.2 ;CONTINUE PROCESSING
SHRT.1: MOVE S1,RTEQUE## ;GET THE ROUTE TABLE ID
PUSHJ P,L%NEXT ;GET THE NEXT ENTRY
SKIPT ;SKIP IF THERE IS ANOTHER
PJRST SENDIT ;ELSE END THE ACK AND RETURN
MOVE S1,S2 ;GET THE ENTRY ADDRESS IN S1
SHRT.2: PUSHJ P,N$RTAS## ;CONVERT THE ENTRY TO ASCIZ (IN G$MSG)
$TEXT (DEPBYT,< ^T/G$MSG/^M^J>) ;INSERT THE TEXT
JRST SHRT.1 ;AND GET NEXT
SHRT.4: $ACK (<No routing has been performed>,,,ACKCOD) ;TELL OPR
$RETT ;AND RETURN
SUBTTL D$SHQN - ROUTINE TO DISPLAY THE QUEUE NAMES
D$SHQN::MOVE S1,.MSCOD(M) ;GET THE ACK CODE
MOVEM S1,ACKCOD ;SAVE IT
$SAVE <H,AP> ;FREE UP SOME AC'S
MOVEI H,HDRQNM## ;GET ADDRESS OF QUEUE HEADER
LOAD AP,.QHLNK(H),QH.PTF ;GET POINTER TO FIRST
SETOM JOBNBR ;SET COUNT TO -1
SHQN.1: JUMPE AP,SHQN.2 ;DONE IF NOTHING ELSE
AOSG JOBNBR ;TIME FOR THE HEADER?
PUSHJ P,QNMHDR ;YES, PUT IT OUT
LOAD TF,QNM.RO+.ROBAT(AP),RO.ATR ;GET ATTRIBUTE
MOVEI S1,[ITEXT (<^T8L/(S2)/>)] ;ASSUME NOT PHYSICAL OR UNIT TYPE
MOVE S2,TF ;GET INDEX
MOVE S2,ATRBTB(S2) ;AND ASSOCIATED TEXT
CAIN TF,%GENRC ;GENERIC?
SKIPN QNM.RO+.ROBUT(AP) ;AND A UNIT TYPE?
SKIPA ;NO
PUSHJ P,[MOVEI S1,[ITEXT (< ^W6L/S2/ >)] ;UNIT TYPE TEXT
MOVE S2,QNM.RO+.ROBUT(AP) ;UNIT TYPE NAME
POPJ P,]
CAIN TF,%PHYCL ;PHYSICAL?
PUSHJ P,[MOVEI S1,[ITEXT (< ^D2R/S2/ >)] ;UNIT NUMBER TEXT
LOAD S2,QNM.RO+.ROBAT(AP),RO.UNI ;UNIT NUMBER
POPJ P,]
MOVX T1,QN.LCL ;SEE IF LOCAL DEFINITION
TDNE T1,QNM.FL(AP) ;...
TDZA T1,T1 ;YES, GET A ZERO AND SKIP
MOVEI T1,1 ;NO, GET A 1
$TEXT (DEPBYT,<^Q31L/QUENAM/ ^T6L/@QNMTYP(T1)/ ^116L/QNM.RO+.ROBTY(AP)/ ^W6L/QNM.RO+.ROBND(AP)/ ^I/(S1)/>)
LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST SHQN.1 ;SEE IF MORE TO DO
SHQN.2: AOSG S1,JOBNBR ;GET CORRECT COUNT
$ACK (<There are no queue names defined>,,,ACKCOD)
JUMPE S1,.RETT ;ALL DONE IF NOTHING
PJRST SENDIT ;SEND THE ACK AND RETURN
QNMHDR: MOVEI S1,[ASCIZ / Network Queue Names /]
PUSHJ P,SETPAG ;SET UP OUTPUT PAGE
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< Queue Name Type Object Type Node Unit >)
PUSHJ P,CRLF ;END THE LINE
$ASCII (<------------------------------- ------ ---------------- ------ -------->)
PUSHJ P,CRLF ;END THE LINE
$RETT ;FOR NOW
SUBTTL D$NPRM - ROUTINE TO DISPLAY THE NETWORK (DN60) PARAMETERS
D$NPRM: PUSHJ P,.SAVE2 ;SAVE THE P ACS.
PUSHJ P,GETPARM ;GO BREAK DOWN THE INCOMMING MESSAGE
SETOM JOBNBR ;SET NODE COUNT TO -1
LOAD P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
NPRM.1: JUMPE P1,NPRM.5 ;NO MORE,,GO FINISH UP
SKIPN S1,NETCOL(P1) ;[1206]GET NODE NUMBER, IS IT 0 ???
MOVE S1,NETLOC(P1) ;[1512]GET THIS NODES NAME/NUMBER
PUSHJ P,CMPNOD ;IS IT ONE WE WANT ???
JUMPF NPRM.3 ;NO,,TRY NEXT
SKIPN S1,NETCOL(P1) ;[1147]GET NODE NUMBER UNLESS 0
MOVE S1,NETLOC(P1) ;[1147]GET THE NODE NAME/NUMBER
PUSHJ P,N$NODE## ;FIND THAT NODE IN OUR DATA BASE
MOVE P2,S2 ;SAVE THE ENTRY ADDRESS
LOAD S1,NETSTS(P2),NETIBM ;GET THIS ONES TYPE DESIGNATION
JUMPE S1,NPRM.3 ;NOT IBM,,SKIP THIS STUFF
AOSG JOBNBR ;BUMP NODE COUNT.
PUSHJ P,NPRHDR ;FIRST TIME,,SET UP THE HEADER
PUSHJ P,CHKLIN ;Check to see if next line fits
LOAD T1,NETSTS(P2),NT.TYP ;GET THE NODE TYPE
LOAD T2,NETSTS(P2),NT.MOD ;GET THE NODE MODE
$TEXT (DEPBYT,<^T14/NETASC(P2)/ ^T/@IBMTYP(T1)/^A>)
LOAD T1,NETSTS(P2),NETONL ;Get the online bit
SKIPN T1 ;Is it offline?
CAIE T2,DF.TRM ;Yes, is it a defined actual node?
SKIPA ;No to either
JRST NPRM.2 ;Yes to both, skip rest, continue loop
LOAD S1,NETPTL(P2),NT.PRT ;GET NEW STYLE CAL11. PORT ARGUMENT
MOVS T1,S1 ;GET IN LH WHERE IT'S DEFINED
LOAD S1,T1,C1.1CN ;GET THE CPU NUMBER
LOAD S2,T1,C1.1TY ;GET PORT TYPE CODE
LOAD T1,T1,C1.1PN ;GET PORT NUMBER
$TEXT (DEPBYT,< ^O3R/S1/ ^T4R/@IBMPOR(S2)/^O2R/T1/^A>) ;DISPLAY THE STUFF
LOAD T3,NETSTS(P2),NT.TOU ;Get protocol timeout cat.
LOAD T4,NETSTS(P2),NT.TRA ;GET 'TRANSPARENCY'
$TEXT (DEPBYT,< ^D4/NETPTL(P2),NT.LIN/ ^T/@IBMDTR(T4)/ ^D5/NETCSD(P2)/ ^D5/NETRPM(P2)/ ^D5/NETBPM(P2)/ ^T/@IBMTIM(T3)/>)
$TEXT (DEPBYT,< ^T/@IBMODE(T2)/^A>) ;DISPLAY TERMINATION OR WHATEVER
LOAD T1,NETSTS(P2),NETSGN ;GET 'SIGNON REQUIRED' BIT
SKIPE T1 ;SIGNON REQUIRED?
SKIPA T1,[[ASCIZ\[Sign-on required]\]] ;YES
MOVEI T1,[ASCIZ\[Sign-on is not required]\] ;NO
$TEXT (DEPBYT,< ^T/(T1)/^A>) ;DISPLAY SIGN-ON INFO
NPRM.2: PUSHJ P,CRLF ;END THE LINE
NPRM.3: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT ENTRY
JRST NPRM.1 ;AND CONTINUE
NPRM.5: AOS S1,JOBNBR ;GET THE NODE COUNT IN S1
MOVE S2,NODE6B ;GET THE NODE WE ASKED FOR
JUMPG S1,NPRM.6 ;WE HAD A MATCH SOMEWHERE !!!
CAMN S2,[-1] ;DID WE ASK FOR ALL NODES ???
$ACK (<No IBM remotes in system network>,,,.MSCOD(M))
CAME S2,[-1] ;DID WE ASK FOR ALL NODES ???
$ACK (<Node ^N/NODE6B/ is not an IBM remote>,,,.MSCOD(M))
$RETT ;JUST RETURN NOW
NPRM.6: CAIN S1,1 ;IS THERE 1 NODE ???
$ASCII (<There is 1 IBM node defined in the network>)
CAILE S1,1 ;IS THERE MORE THEN 1 ???
$TEXT(DEPBYT,<There are ^D/JOBNBR/ IBM nodes defined in the network^A>)
PUSHJ P,CRLF ;END THE LINE
PUSHJ P,CRLF ;ONE MORE FOR GOOD LUCK
PJRST SENDIT
SUBTTL NPRHDR - NETWORK PARAMETER HEADER ROUTINE
NPRHDR: MOVEI S1,[ASCIZ/ IBM Network Parameters /] ;GET THE HEADING.
PUSHJ P,SETPAG ;SET UP AN OUTPUT PAGE.
PUSHJ P,CRLF ;OUTPUT A CRLF.
$ASCII (< Node Name Type CPU Port Line Trans CSD RPM BPM Timeout>)
PUSHJ P,CRLF ;END THE LINE
$ASCII (<-------------- ---- --- ------ ---- ----- ----- ----- ----- ------->)
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
SUBTTL D$NSTS - DISPLAY NETWORK STATUS (ONLINE/OFFLINE)
D$NSTS: $SAVE <P1> ;Save P1 for a min.
SETOM JOBNBR ;NODE COUNT
PUSHJ P,GETPARM ;BREAK DOWN THE INCOMMING MESSAGE
MOVE S1,NODE6B ;GET THE NODE WE WANT
CAME S1,[-1] ;ALL NODES ???
JRST NSTS.5 ;No, go do it different
LOAD P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST NODE DATA BASE ENTRY
SKIPA ;SKIP THE FIRST TIME THROUGH
NSTS.0: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT NODE ENTRY ADDRESS
JUMPE P1,NSTS.3 ;NO MORE,,JUST RETURN
AOSG JOBNBR ;BUMP NODE COUNT BY 1
PUSHJ P,NSTHDR ;FIRST ONE,,PUT OUT A HEADER
PUSHJ P,CHKLIN ;Check to see if next line fits
MOVX S1,NETNQC ;GET THE SERVER BIT
TDNN S1,NETSTS(P1) ;NETWORK QUEUE CONTROLLER?
TDZA S1,S1 ;NO, GET A ZERO
MOVEI S1,3 ;YES, GET OFFSET TO ONOFL TABLE
JUMPN S1,NSTS.1 ;SKIP ONLINE/OFFLINE CHECK IF NET QUE
LOAD S1,NETSTS(P1),NETONL ;GET THE ONLINE BIT
JUMPN S1,NSTS.1 ;If online, just put out the status
LOAD S1,NETSTS(P1),NETPRO ;Get the proto-actual online bit
SKIPE S1 ;Still offline, skip
MOVEI S1,2 ;Otherwise, set active status
NSTS.1: $TEXT (DEPBYT,<^T15/NETCLM(P1)/ ^T/@ONOFL(S1)/^A>) ;TYPE NAME(NBR)
LOAD S1,NETSTS(P1),NETIBM ;GET THE IBM REMOTE STATUS BIT
JUMPE S1,NSTS.2 ;Not IBM, go finish up
LOAD S1,NETSTS(P1),NT.MOD ;IBM,,GET THE MODE
$TEXT (DEPBYT,< (IBM ^T/@IBMODE(S1)/)^A>) ;PUT OUT IBM INDICATION
CAIE S1,DF.PRO ;Is it proto?
JRST NSTS.2 ;No, go finish
LOAD S1,NETSTS(P1),NETPRO ;Get the proto-actual online bit
JUMPE S1,NSTS.2 ;Not proto-actual online, go finish
$TEXT (DEPBYT,< as Station ^N/NETLOC(P1)/^A>)
NSTS.2: PUSHJ P,CRLF ;Add the end of the line
JRST NSTS.0 ;Go for the next
NSTS.3: AOSG S1,JOBNBR ;GET CORRECT COUNT
$ACK (<There are no nodes in the network>,,,.MSCOD(M))
JUMPE S1,.RETT ;ALL DONE,,JUST RETURN
CAIN S1,1 ;JUST 1 NODE
$ASCII (<There is 1 node in the network>)
CAILE S1,1 ;MORE THEN 1 ???
$TEXT (DEPBYT,<There are ^D/JOBNBR/ nodes in the network^A>)
PUSHJ P,CRLF ;END THE LINE
PUSHJ P,CRLF ;ADD ONE MORE
PJRST SENDIT ;AND SEND THE ACK
NSTHDR: MOVEI S1,[ASCIZ/ System Network Status /] ;GET HEADING
PUSHJ P,SETPAG ;SET UP THE OUTPUT PAGE
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< Node Status >) ;SET UP HEADING
PUSHJ P,CRLF ;END THE LINE
$ASCII (<------------ -------->) ;UNDERLINE IT
PUSHJ P,CRLF ;END THE LINE
$RETT ;RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
; Here if Network status for a particular node
NSTS.5:
$CALL N$GNOD## ;Go get the node
JUMPT NSTS.6 ;Found, go output
$ACK (<Node ^N/NODE6B/ does not exist>,,,.MSCOD(M))
$RETT ;Nothing more to do
NSTS.6: MOVE P1,S2 ;Get the node entry address
LOAD S1,NETSTS(P1),NETIBM ;GET THE IBM REMOTE STATUS
LOAD S2,NETSTS(P1),NETONL ;GET THE ONLINE BIT
JUMPN S1,NSTS.7 ;IF AN IBM REMOTE,,SKIP THIS
$ACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/>,,,.MSCOD(M))
$RETT ;RETURN
NSTS.7: LOAD S1,NETSTS(P1),NT.MOD ;GET THE MODE
JUMPN S2,NSTS.8 ;If online, skip this
CAIE S1,DF.PRO ;Is it prototype?
JRST NSTS.8 ;No, skip this
LOAD S2,NETSTS(P1),NETPRO ;Get proto-actual online bit
JUMPE S2,NSTS.8 ;Not actual online, continue
MOVEI S2,2 ;Get active status
$ACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,< as Station ^N/NETLOC(P1)/>,,.MSCOD(M))
$RETT ;Return
NSTS.8: $ACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL D$STAP - SHOW STATUS OF TAPE DRIVES
TOPS10< INTERN D$STAP ;SHOW STATUS TAPE DRIVES
D$STAP: PUSHJ P,.SAVE2 ;SAVE P1 & P2 FOR A MINUTE
SETOM ENTYPE ;OPERATOR ENTRY POINT
SETOM JOBNBR ;DEVICE COUNT
SETZM ACTIVE ;ALLOCATED DEVICES
SETZM REMOTE ;PRESTAGED DEVICES
PUSHJ P,GETPARM ;BREAK DOWN THE INCOMMING MESSAGE
MOVE S1,.OFLAG(M) ;GET THE FLAG WORD
MOVEM S1,LISTYP ;SAVE FOR GETDSK ROUTINE
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;POSITION TO THE FIRST ENTRY
SKIPT ;SKIP IF WE FOUND ONE
PUSHJ P,S..NUE## ;NULL UCB CHAIN !!!
STAP.1: MOVE P1,S2 ;SAVE THE UCB ADDRESS
SKIPE S1,DEVICE ;A SPECIFIC DEVICE ???
CAMN S1,.UCBNM(P1) ;YES,,DO THEY MATCH ???
SKIPA ;NO DEVICE OR THEY MATCH,,WIN
JRST STAP.2 ;NO GOOD,,TRY NEXT DEVICE
LOAD S1,.UCBST(P1),UC.DVT ;GET THE DEVICE TYPE
CAXE S1,%TAPE ;IS IT MAG TAPE ???
JRST STAP.2 ;NO,,TRY NEXT DEVICE
LOAD TF,.UCBST(P1),UC.VSW ;GET VOLUME SWITCH BIT
SKIPE TF ;IN VOLUME SWITCH MODE ???
SETOM ACTIVE ;YES,,INDICATE WE HAVE AN OWNER
SKIPN S1,.UCBVL(P1) ;YES,,IS A VOLUME MOUNTED ???
JRST STAP.2 ;NOT TAPE OR NO VOLUME,,TRY NEXT UCB
SETOM REMOTE ;INDICATE WE HAVE A STAGED VOLUME
PUSHJ P,D$VOWN## ;DOES ANYONE OWN THIS VOLUME ???
SKIPF ;NO,,SKIP
SETOM ACTIVE ;YES,,INDICATE SO
SKIPE ACTIVE ;IS 'ACTIVE' SET
SKIPN REMOTE ;AND IS 'REMOTE' SET ???
SKIPA ;BOTH NOT SET,,SKIP
JRST STAP.3 ;BOTH SET,,STOP SCANNING
STAP.2: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT UCB ENTRY
JUMPT STAP.1 ;FOUND ONE,,GO CHECK IT OUT
STAP.3: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
SKIPT ;SKIP IF WE FOUND ONE
PUSHJ P,S..NUE## ;NULL UCB CHAIN !!!
STAP.4: MOVE P1,S2 ;SAVE THE ENTRY ADDRESS
SKIPE S1,DEVICE ;A SPECIFIC DEVICE ???
CAMN S1,.UCBNM(P1) ;YES,,DO THEY MATCH ???
SKIPA ;NO DEVICE OR THEY MATCH,,WIN
JRST STAP.6 ;NO GOOD,,TRY NEXT DEVICE
LOAD S1,.UCBST(P1),UC.DVT ;GET THE DEVICE TYPE
CAXE S1,%TAPE ;IS IT TAPE ???
JRST STAP.6 ;NO,,TRY NEXT UCB
MOVX TF,ST.AVA ;GET AVAILABLE BIT (/FREE)
TDNN TF,LISTYP ;USER SPECIFY /FREE ?
JRST STAP.D ;NO - TRY TO LIST ALL
MOVX TF,UC.AVA ;GET 'AVAILABLE TO MDA' BIT
SKIPN .UCBVS(P1) ;'FREE' ONLY, SO CAN'T BE ASSIGNED
TDNN TF,.UCBST(P1) ; OR SET UNAVAILABLE !!!
JRST STAP.6 ;LOSE,,TRY ANOTHER DRIVE
STAP.D: AOSG JOBNBR ;BUMP DEVICE COUNT BY 1
PUSHJ P,TAPHDR ;FIRST TIME,,PUT OUT THE TAPE STATUS HDR
LOAD S1,.UCBST(P1) ;GET THE DEVICE STATUS BITS
MOVEI S2,[ASCIZ/Online /] ;DEFAULT TO 'ONLINE' STATUS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TXNE S1,UC.OFL ;IS IT OFFLINE ???
MOVEI S2,[ASCIZ/Offline/] ;YES,,SAY SO
SKIPN .UCBVL(P1) ;IS THERE A VOLUME ON THIS UCB ???
MOVEI S2,[ASCIZ/Free /] ;NO,,MAKE THE STATUS 'FREE'
TXNN S1,UC.AVA ;IS IT 'UNAVAILABLE' ???
MOVEI S2,[ASCIZ/Unavailable/] ;YES,,SAY SO
LOAD TF,.UCBST(P1),UC.VSW ;GET THE VOLUME SWITCH BIT
SKIPE TF ;SWITCHING VOLUMES ???
MOVEI S2,[ASCIZ/Vol Switch/] ;YES,,SAY SO
LOAD TF,.UCBST(P1),UC.INI ;GET THE INITIALIZING BIT
SKIPE TF ;INITIALIZING LABELS?
MOVEI S2,[ASCIZ/Initializing/] ;YES, SAY SO
MOVEI S1,[ASCIZ/Yes/] ;DEFAULT AVR YES
LOAD TF,.UCBST(P1),UC.AVR ;GET THE AVR BIT
SKIPN TF ;IS IT LIT ???
MOVEI S1,[ASCIZ/No /] ;NO,,SAY NO AVR !!!
LOAD T1,.UCBST(P1),UC.TRK ;GET THE TRACK TYPE
$TEXT (DEPBYT,<^W6/.UCBNM(P1)/ ^W3/TRK(T1)/ ^T11/0(S2)/ ^T3/0(S1)/ ^A>)
SKIPE S1,.UCBVL(P1) ;VOLUME ON DRIVE?
JRST STAP.T ;YES, MAKES THINGS A LITTLE EASIER
MOVX S1,UC.200 ;GET 200 BPI BIT
TDNE S1,.UCBST(P1) ;IS IT LIT?
JRST STAP.S ;YES
MOVX S1,UC.800 ;GET 800 BPI BIT
TDNN S1,.UCBST(P1) ;LIT?
MOVX S1,UC.6250 ;NO, GET 6250 BIT
STAP.S: TXNE S1,UC.200 ;200 BPI BIT IN S1?
MOVEI S2,[ASCIZ\200/556/800\] ;YES, ASSUME 556 AND 800 BPI TOO
TXNE S1,UC.800 ;800 BPI BIT IN S1?
MOVEI S2,[ASCIZ\800/1600\] ;YES, ASSUME 1600 BPI TOO
TXNE S1,UC.6250 ;6250 BPI BIT IN S1?
MOVEI S2,[ASCIZ\1600/6250\] ;YES, IT DOES 1600 BPI ALSO
MOVX T1,UC.6250 ;GET 6250 BPI BIT
TDNE T1,.UCBST(P1) ;CHECK FOR ONE OF THEM FUNNY DRIVES
TXNN S1,UC.800 ;THAT HAVE 800/1600/6250 BPI
TRNA
MOVEI S2,[ASCIZ\800/1600/6250\] ;IT IS!!!
$TEXT (DEPBYT,<^T13/(S2)/ ^A>) ;DUMP THE TEXT
JRST STAP.U ;JOIN COMMON CODE
STAP.T: LOAD S2,.VLFLG(S1),VL.DEN ;GET VOLUME DENSITY
$TEXT (DEPBYT,<^T13L /@DENSTY(S2)/ ^A>) ;DUMP DENSITY OF VOLUME
STAP.U: SKIPE S1,.UCBVL(P1) ;ANY VOLUME ON THIS DRIVE ???
JRST STAP.Y ;YES,,GO PROCESS IT
LOAD TF,.UCBST(P1),UC.VSW ;GET THE VOLUME SWITCH BIT
SKIPN TF ;SWITCHING VOLUMES,,SKIP
JRST STAP.5 ;NO,,GO FINISH UP
SKIPE REMOTE ;ARE ANY VOLS MOUNTED ???
$ASCII (< >) ;YES,,PAD THE LINE
JRST STAP.Z ;AND CONTINUE
STAP.Y: MOVEI S2,[ASCIZ/Enabled/] ;DEFAULT TO WRITE ENABLED
LOAD TF,.UCBST(P1),UC.WLK ;GET THE WRITE LOCKED BIT
SKIPE TF ;IS IT LIT ???
MOVEI S2,[ASCIZ/Locked /] ;YES,,SAY WRITE LOCKED
$TEXT (DEPBYT,<^T7/0(S2)/ ^W6/.VLNAM(S1)/ ^A>) ;ADD SOME MORE TEXT
STAP.Z: SKIPN T1,.UCBVS(P1) ;[1173] GET VSL ADDRESS JUST IN CASE
JRST STAP.5 ;NO OWNER,,SKIP THIS
MOVE AP,.VSMDR(T1) ;[1173] GET THE OWNER MDR ADDRESS
LOAD T2,.VSCVL(T1),VS.OFF ;GET OFFSET TO CURRENT VOLUME
ADDI T2,.VSVOL(T1) ;COMPUTE ADDRESS OF VOL BLOCK POINTER
SKIPE T2,(T2) ;GET VOL BLOCK ADDRESS
LOAD T2,.VLFLG(T2),VL.DEN ;GET VOLUME DENSITY
LOAD S1,.MRJOB(AP),MR.JOB ;GET THE OWNERS JOB NUMBER
MOVE S2,.MRQEA(AP) ;GET THE QE ADDRESS (MAY BE 0)
TXNE S1,BA%JOB ;OWNED BY A PSEUDO REQUEST ???
$TEXT(DEPBYT,<^M^J Mounted for request ^D/.QERID(S2)/ ^I/MNTUSR/ ^15/.VSRFL(T1),MR.QUE/^A>) ;[1173]
TXNN S1,BA%JOB ;OWNED BY A NORMAL REQUEST ???
$TEXT(DEPBYT,<^M^J Owned by job ^D/.MRJOB(AP),MD.PJB/ ^I/MNTUSR/^A>)
STAP.5: PUSHJ P,CRLF ;END THE LINE
STAP.6: MOVE S1,UCBQUE ;GET THE UCB QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT UCB
JUMPT STAP.4 ;FOUND ONE,,GO CHECK IT OUT
AOSG S1,JOBNBR ;GET AND FIX DEVICE COUNT
$ACK (<Device ^W/DEVICE/ does not exist>,,,ACKCOD)
JUMPE S1,.RETT ;THE END,,RETURN
PUSHJ P,CRLF ;ADD AN ENDING CRLF
PUSHJ P,SENDIT ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
SUBTTL D$SDSK - SHOW STATUS OF DISK DRIVES
TOPS10< INTERN D$SDSK ;SHOW STATUS DISK DRIVES
D$SDSK: PUSHJ P,.SAVE2 ;SAVE P1 & P2 FOR A MINUTE
SETOM ENTYPE ;OPERATOR ENTRY POINT
SETOM JOBNBR ;DEVICE COUNT
SETZM REMOTE ;CLEAR MOUNTED VOLUMES FLAG
SETZM ACTIVE ;CLEAR DUAL PORTED FLAG
PUSHJ P,GETPARM ;BREAK DOWN THE INCOMMING MESSAGE
MOVE S1,.OFLAG(M) ;GET THE FLAG WORD
MOVEM S1,LISTYP ;SAVE FOR LATER
SETOM LSTUSR ;SAY WE WANT TO START UCB SCAN
SDSK.1: PUSHJ P,GETDSK ;GET A DISK UCB
JUMPF SDSK.2 ;NO MORE,,CONTINUE ONWARD
SKIPE .UCBVL(S1) ;IS A VOLUME MOUNTED ???
SETOM REMOTE ;YES,,SET THE FLAG
SKIPE .UCBAU(S1) ;IS IT DUAL PORTED ???
SETOM ACTIVE ;YES,,SET THE FLAG
SKIPE ACTIVE ;IS DUAL PORTED FLAG LIT ???
SKIPN REMOTE ; AND IS A VOLUME MOUNTED ???
JRST SDSK.1 ;BOTH NOT SET,,TRY AGAIN
SDSK.2: SETOM LSTUSR ;INDICATE WE WANT TO START UCB SCAN OVER
SDSK.3: PUSHJ P,GETDSK ;GET A DISK UCB
JUMPF SDSK.5 ;NO MORE,,GO FINISH UP
MOVE P1,S1 ;SAVE THE ENTRY ADDRESS
AOSG JOBNBR ;BUMP DEVICE COUNT BY 1
PUSHJ P,DSKHDR ;FIRST TIME,,PUT OUT THE DISK STATUS HDR
SKIPE S1,.UCBVL(P1) ;IS THERE A VOLUME MOUNTED ON IT ???
LOAD S1,.VLFLG(S1),VL.STA ;YES,,GET THE STRUCTURE STATUS BITS
CAXE S1,%STAMN ;IS IT MOUNTED ???
JRST SDSK.3 ;NO,,SKIP IT AND TRY NEXT UCB
SDSK.4: PUSHJ P,SDSK.A ;PUT OUT STATUS INFO FOR THIS UCB
LOAD P1,.UCBVL(P1) ;GET THE MOUNTED VOLUME ADDRESS
LOAD P1,.VLPTR(P1),VL.NXT ;GET THE PTR TO THE NEXT VOLUME
JUMPE P1,SDSK.3 ;NO MORE,,GET NEXT UCB
MOVE P1,.VLUCB(P1) ;GET THAT VOL'S UNIT ADDRESS
JRST SDSK.4 ;AND PUT IT OUT
SDSK.5: SETOM LSTUSR ;INDICATE RESCAN OF UCB QUEUE
SDSK.6: PUSHJ P,GETDSK ;GET A DISK UCB
JUMPF SDSK.7 ;NO MORE,,FINISH UP
MOVE P1,S1 ;SAVE THE UCB ADDRESS
SKIPN S1,.UCBVL(P1) ;IS THERE A VOLUME MOUNTED ON IT ???
JRST SDS.6B ;NO,,OUTPUT THE UNIT STATUS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SDS.6A: MOVE S2,S1 ;SAVE THE CURRENT VOL BLOCK ADDRESS
LOAD S1,.VLPTR(S2),VL.PRV ;FIND THE PRIMARY VOL BLOCK FOR THIS STR
JUMPN S1,SDS.6A ;NOT THERE YET,,KEEP TRYING
LOAD S1,.VLFLG(S2),VL.STA ;YES,,GET STRUCTURE STATUS BITS
CAXN S1,%STAMN ;IS IT MOUNTED ???
JRST SDSK.6 ;YES,,SKIP IT AND TRY NEXT UCB
SDS.6B: PUSHJ P,SDSK.A ;PUT OUT THE UNIT STATUS DATA
JRST SDSK.6 ;AND CONTINUE
SDSK.7: AOSG S1,JOBNBR ;GET AND FIX DEVICE COUNT
JRST SDSK.8 ;NONE LISTED.. SEE WHY
PUSHJ P,CRLF ;ADD AN ENDING CRLF
PUSHJ P,SENDIT ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
SDSK.8: SKIPE DEVICE ;WANTED A SPECIFIC DISK?
JRST [$ACK (<Device ^W/DEVICE/ does not exist>,,,ACKCOD)
$RETT] ;YES, SAY WE DIDN'T FIND IT
$ACK (<No free drives>,,,ACKCOD)
$RETT
;Here to output the disk device status
SDSK.A: SKIPE NOROOM ;ANY ROOM LEFT IN THE CURRENT BUFFER ???
PUSHJ P,PAGOVF ;NO,,SEND CURRENT AND CONTINUE
$TEXT (DEPBYT,<^W8/.UCBNM(P1)/^A>) ;PUT OUT THE UNIT NAME
SKIPE ACTIVE ;ANY DUAL PORTING ???
$TEXT (DEPBYT,<^W10/.UCBAU(P1)/^A>) ;YES,,DUMP OUT SECOND PORT
LOAD S1,.UCBST(P1),UC.RSN ;GET THE DEVICE RESOURCE NUMBER
IMULI S1,AMALEN ;CALC THE ENTRY OFFSET
ADD S1,AMATRX## ;GET THE 'A' MATRIX ENTRY ADDRESS
LOAD TF,.UCBST(P1) ;GET THE UCB STATUS BITS
MOVEI T2,[ASCIZ/Yes/] ;DEFAULT AVR TO YES
TXNN TF,UC.AVR ;IS AVR ENABLED ???
MOVEI T2,[ASCIZ/No /] ;NO,,SAY SO
MOVEI S2,[ASCIZ/Online /] ;DEFAULT TO ONLINE
TXNE TF,UC.OFL ;UNLESS ITS OFFLINE
MOVEI S2,[ASCIZ/Offline/] ;THEN SAY SO
SKIPN T1,.UCBVL(P1) ;IS THERE A VOLUME ON THIS UCB ???
MOVEI S2,[ASCIZ/Free /] ;NO,,MAKE STATUS 'FREE'
TXNN TF,UC.AVA ;IS IT AVAILABLE ???
MOVEI S2,[ASCIZ/Unavailable/] ;NO,,MAKE IT UNAVAILABLE
JUMPE T1,SDSK.B ;NO VOLUME MOUNTED,,SKIP THIS
LOAD TF,.VLFLG(T1),VL.STA ;GET THE STRUCTURE STATUS BITS
CAXN TF,%STAMN ;IS IT MOUNTED ???
MOVEI S2,[ASCIZ/Mounted/] ;YES,,SAY SO
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CAXN TF,%STADM ;IS IT DISMOUNT ???
MOVEI S2,[ASCIZ/Dismount/] ;YES,,SAY SO
CAXN TF,%STAWT ;IS IT WAITING ???
MOVEI S2,[ASCIZ/Waiting/] ;YES,,SAY SO
LOAD TF,.VLPTR(T1),VL.PRV ;GET THE PREVIOUS VOL ADDRESS
SKIPE TF ;NONE THERE,,SKIP
MOVEI S2,[ASCIZ/ /] ;SECONDARY VOL BLK,,STATUS IS UNDEFINED
SDSK.B: $TEXT (DEPBYT,<^T6/@.AMNAM(S1)/^T13/0(S2)/^T5/0(T2)/^A>)
JUMPE T1,CRLF ;NO VOLUME,,OUTPUT CRLF AND RETURN
LOAD S2,.VLFLG(T1),VL.LUN ;GET THE LOGICAL UNIT NUMBER
$TEXT (DEPBYT,<^W7/.VLNAM(T1)/^W10/.VLVID(T1)/^O/S2/>)
$RETT ;RETURN
SUBTTL GETDSK - ROUTINE TO RETURN THE FIRST/NEXT DISK UCB ADDRESS
;CALL: LSTUSR/ -1 for the first disk UCB, positive for the next
; LISTYP/ .OMFLG word of the requesting message
;
;RET: S1/ The UCB Address
GETDSK: AOSE LSTUSR ;IS THIS THE FIRST TIME THROUGH ???
JRST GETD.1 ;NO,,GET NEXT UCB
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
JUMPT GETD.2 ;JUMP IF OK
PUSHJ P,S..NUE## ;ELSE STOPCODE
GETD.1: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT UCB
JUMPF .RETF ;NO MORE,,RETURN FALSE
GETD.2: SKIPN S1,DEVICE ;A SPECIFIC DEVICE ???
JRST GETD.4 ;NOPE
CAME S1,.UCBNM(S2) ;PRIMARY PORT MATCH?
CAMN S1,.UCBAU(S2) ;ALTERNATE PORT MATCH?
SKIPA S1,S2 ;PUT THE UCB ADDRESS IN S1
JRST GETD.1 ;NO GOOD,,TRY NEXT UCB
GETD.3: MOVE S2,S1 ;COPY UCB ADDRESS
SKIPN S2,.UCBVL(S2) ;VOLUME MOUNTED?
JRST GETD.5 ;NO
LOAD S2,.VLPTR(S2),VL.PRV ;GET BACKCHAIN POINTER TO LAST VOLUME
JUMPE S2,GETD.5 ;HAVE A PREVIOUS VOLUME BLOCK?
MOVE S1,.VLUCB(S2) ;YES - POINT TO PREVIOUS UCB
JRST GETD.3 ;KEEP SEARCHING BACKWARDS
GETD.4: MOVE S1,S2 ;PUT THE UCB ADDRESS IN S1
GETD.5: LOAD S2,.UCBST(S1),UC.DVT ;GET THE DEVICE TYPE
CAXE S2,%DISK ;IS IT DISK ???
JRST GETD.1 ;NO GOOD,,TRY NEXT UCB
;Now, check this UCB against the OPR's optional request switch
;If the OPR said /ALL, just give the world back
MOVE S2,LISTYP ;GET THE LIST OPTION FLAGS
TXNE S2,ST.ALL ;WANT TO SEE EVERYTHING?
$RETT ;YES, GIVE THIS ONE TO CALLER
;Check for /MOUNTED from OPR
TXNE S2,ST.MNT ;WANT JUST MOUNTED UNITS?
JRST [SKIPN .UCBVL(S1) ;YES, UNIT HAVE A VOLUME ON IT?
JRST GETD.1 ;NO, SKIP IT
$RETT] ;YES, RETURN THIS UCB!
;For /FREE, or no option, don't list unavailable drives
LOAD TF,.UCBST(S1),UC.AVA ;GET 'AVAILABLE TO MDA' BIT
JUMPE TF,GETD.1 ;IF UNIT NOT AVAILABLE,,TRY NEXT UCB
TXNE S2,ST.AVA ;WANT TO SEE JUST FREE UNITS?
SKIPN .UCBVL(S1) ;YES, IS THERE A VOLUME HERE?
$RETT ;NOT /FREE, OR THIS IS A FREE UNIT!
JRST GETD.1 ;WANT /FREE, BUT THIS UNIT MOUNTED
> ;END TOPS10 CONDITIONAL
SUBTTL D$SSTR - SHOW STATUS OF FILE STRUCTURE
TOPS10< INTERN D$SSTR ;SHOW STATUS FILE STRUCTURE(S)
D$SSTR:
$SAVE <P1,P2,P3,P4> ;SAVE SOME REGS
STKVAR <<NUMMTD>,<TOTFRE>> ;NUMBER OF MOUNTED STRS, TOTAL FREE
SETZM NUMMTD ;NONE SO FAR
SETZM TOTFRE ;GOTTA ADD IT UP
PUSHJ P,GETPARM ;GET OPTIONAL STRUCTURE BLOCK
SETOM JOBNBR ;NONE LISTED SO FAR
SETZM LSTUSR ;START AT FIRST STRUCTURE
PUSHJ P,GETSTR ;GET THE FIRST PRIMARY VOLUME BLOCK
JUMPT SSTR.0 ;GOT ONE, GO LIST IT
$ACK (<No structures exist>,,,ACKCOD) ;VERY STRANGE
$RETT
SSTR.0: SKIPE S2,DEVICE ;WANT TO SEE A PARTICULAR STRUCTURE?
CAMN S2,.VLNAM(S1) ;YES, IS THIS THE RIGHT ONE?
SKIPA ;YES, OR OPR WANTS EVERYTHING
JRST SSTR.5 ;INCORRECT STR, TRY THE NEXT ONE
MOVE P1,S1 ;SAVE ADDR OF THIS STR BLOCK
MOVE P4,S1 ;SAVE FOR SUMMARY LINE, TOO
AOSN JOBNBR ;FIRST ONE SHOWN?
PUSHJ P,STRHDR ;YES, TYPE THE HEADER
SKIPE NOROOM ;OVERFLOWED A PAGE?
PUSHJ P,PAGOVF ;YES, DUMP IT OUT
$TEXT (DEPBYT,<^W4L/.VLNAM(P1)/ ^A>) ;TYPE THE STR NAME
LOAD S2,.VLFLG(P1),VL.STA ;GET THE STATUS CODE
SETZ S1, ;NO TEXT YET
CAXN S2,%STADM ;IS IT DISMOUNTING?
MOVEI S1,[ASCIZ/Dismounting/] ;YES, SAY SO
CAXN S2,%STAWT ;IS IT WAITING?
MOVEI S1,[ASCIZ/Waiting to be mounted/] ;YES, SAY SO
JUMPN S1,[$TEXT(DEPBYT,< --^T/0(S1)/-->)
JRST SSTR.4] ;JUST PRINT THAT ON THE LINE
AOS NUMMTD ;ONE MORE STR MOUNTED
MOVE S1,.VLNAM(P1) ;GET THE STR NAME BACK
PUSHJ P,I$MNTC## ;FIND OUT HOW MANY USERS, FREE BLKS
ADDM S2,TOTFRE ;ACCUMULATE FREE BLOCKS ON ALL
MOVE P2,G$NOW## ;GET THE CURRENT TIME
SUB P2,.VLMTM(P1) ;CALC MOUNT TIME
MULX P2,^D<24*60> ; Get number of minutes in a day
ASHC P2,^D17 ; Shift binary point between P2,P3
IDIVI P2,^D60 ; Split to hours and minutes
$TEXT (DEPBYT,<^D3R/P2/:^D2R0/P3/ ^D8R/S2/ ^D5R/S1/ ^A>)
MOVE S1,P1 ;GET VOL BLOCK ADDRESS
PUSHJ P,D$NREQ## ;GET NUMBER OF REQUESTS NEEDING STR
$TEXT (DEPBYT,<^D4R/S1/ ^A>) ;DISPLAY NUMBER OF REQUESTS
MOVEI P2,1 ;WE'VE GOT ONE UNIT
MOVE S1,P1 ;COPY ADR OF VOL BLOCK
SSTR.1: LOAD S1,.VLPTR(S1),VL.NXT ;STEP TO NEXT
SKIPE S1 ;IS THERE A NEXT?
AOJA P2,SSTR.1 ;YES, KEEP LOOKING
MOVEI P3,1 ;SET FOR FIRST PACK IN STR
SSTR.2: $TEXT (DEPBYT,<^W6L/.VLVID(P1)/ ^D1/P3//^D1/P2/ ^A>) ;TYPE THE VOLUME ID
SKIPN S1,.VLUCB(P1) ;IS THIS VOLUME MOUNTED?
JRST SSTR.3 ;NO, SKIP THIS STUFF
LOAD S2,.UCBST(S1),UC.RSN ;GET THE DEVICE RESOURCE NUMBER
IMULI S2,AMALEN ;CALC THE ENTRY OFFSET
ADD S2,AMATRX## ;GET THE 'A' MATRIX ENTRY ADDRESS
$TEXT (DEPBYT,<^T4/@.AMNAM(S2)/ ^W6/.UCBNM(S1)/ ^A>) ;PRINT DRIVE
SKIPN .VLOID(P1) ;HAVE AN OWNER PPN?
JRST SSTR.3 ;NO
HLRE TF,.VLOID(P1) ;GET PROJECT NUMBER
MOVEI S1,[ITEXT (<^O6R /.VLOID(P1),LHMASK/>)] ;OCTAL PROJECT #
CAMN TF,[-1] ;WILD?
MOVEI S1,[ITEXT (< *>)] ;YES
HRRE TF,.VLOID(P1) ;GET PROGRAMMER NUMBER
MOVEI S2,[ITEXT (<^O6L /.VLOID(P1),RHMASK/>)] ;OCTAL PROGRAMMER #
CAMN TF,[-1] ;WILD?
MOVEI S2,[ITEXT(<* >)] ;YES
$TEXT (DEPBYT,<^I/(S1)/,^I/(S2)/^A>) ;PRINT POSSIBLY WILD PPN
SSTR.3: PUSHJ P,CRLF ;FINISH THE LINE
LOAD P1,.VLPTR(P1),VL.NXT ;GET ADDR OF NEXT VOLUME IN STR
JUMPE P1,SSTR.4 ;IF NO MORE UNITS, TRY NEXT STR
$ASCII(< >) ;INDENT INFO FOR NEXT VOL
AOJA P3,SSTR.2 ;GO DO THE NEXT UNIT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to type the summary for this structure
SSTR.4: MOVX S2,ST.USR ;GET THE /USER FLAG BIT
MOVE S1,P4 ;GET BACK THE STRUCTURE BLOCK
TDNE S2,.OFLAG(M) ;DID THE OPR WANT TO SEE THE USERS?
PUSHJ P,D$SUSR ;YES, ADD THOSE TO THE MESSAGE
MOVE S1,P4 ;GET BACK THE STRUCTURE BLOCK
PUSHJ P,D$SSTS ;ADD WRITE LOCK STATUS, ETC.
LOAD S1,.VLFLG(P4),VL.LCK ;GET THE LOCK STATE CODE
CAXN S1,%UNLCK ;IS IT UNLOCKED?
JRST SSTR.5 ;YES, NOTHING TO SAY
SKIPE NOROOM ;IS THERE ENOUGH SPACE?
PUSHJ P,PAGOVF ;NO, GET A PAGE
CAXN S1,%LOCKD ;IS IT LOCKED?
$TEXT (DEPBYT,< (Locked against new accesses)>)
CAXN S1,%LOCKP ;IS A LOCK PENDING?
$TEXT (DEPBYT,< (Unlocked, Lock pending for ^H/.VLLTM(P4)/)>)
CAXN S1,%ULCKP ;IS AN UNLOCK PENDING?
$TEXT (DEPBYT,< (Locked, Unlock pending for ^H/.VLLTM(P4)/)>)
;Here to try the next structure
SSTR.5: PUSHJ P,GETSTR ;GET THE NEXT STR BLOCK
JUMPT SSTR.0 ;GOT ONE, CHECK IT OUT
SKIPN DEVICE ;WANT TO SEE A CERTAIN STRUCTURE?
JRST SSTR.6 ;NO, TYPE THE SUMMARY
AOSE JOBNBR ;YES, DID WE LIST IT?
JRST SSTR.7 ;YES, JUST FINISH UP
$ACK (<File structure ^W/DEVICE/ does not exist>,,,ACKCOD)
$RETT
SSTR.6: AOSN P1,JOBNBR ;GET TOTAL THAT WE LISTED
JRST [$ACK (<No file structures>,,,ACKCOD)
$RETT] ;AND RETURN
SOSN P1 ;EXACTLY ONE?
$ASCII (<One file structure>)
SKIPLE P1 ;MORE THAN ONE?
$TEXT (DEPBYT,< Total of ^D/JOBNBR/ file structures^A>)
SKIPLE P1 ;SUMMARY ONLY IF MORE THAN ONE STR
$TEXT (DEPBYT,<, ^D/NUMMTD/ mounted; ^D/TOTFRE/ free blocks>)
PUSHJ P,CRLF ;END THE LINE
SSTR.7: PUSHJ P,SENDIT ;FIRE THE MESSAGE BACK
$RETT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;A routine to show the users of a file structure.
;Call -
; S1/ SIXBIT primary Structure VOL block
;Returns -
; Always, adding descriptive text to the message
D$SUSR: $SAVE <P1,P2,P3,P4>
$SAVE <T1> ;[1173]
MOVE P1,S1 ;SAVE THE VOL BLK ADRS
$ASCII (< Users:>) ;FIRST THE GREETING
LOAD P2,.VLOWN(P1),VL.CNT ;GET THE NUMBER OF REQUESTORS
JUMPE P2,SUSR.4 ;NONE, SAY SO
MOVNS P2 ;NEGATE IT
MOVSS P2 ;TO LEFT HALF
HRRI P2,.VLVSL(P1) ;AIM AT THE LIST OF VSL POINTERS
SETZ P1, ;CLEAR COUNT OF USERS
SUSR.1: MOVX TF,VL.ASN ;GET THE 'MOUNTED' BIT
TDNN TF,0(P2) ;DOES THIS REQUESTOR (VSL) OWN IT?
JRST SUSR.3 ;NO, TRY THE NEXT VSL
AOS P1 ;COUNT THIS OWNER
SKIPE NOROOM ;IS THERE SOME SPACE?
PUSHJ P,PAGOVF ;NO, MAKE SOME MORE
MOVE T1,0(P2) ;[1173] AIM AT THE VSL
SKIPN S1,.VSMDR(T1) ;[1173] BACK UP TO THE MDR
PUSHJ P,S..IMV## ;OOPS!!
;handle pseudo mount requests (no job number but a req id)
MOVE P4,S1 ;SAVE THE MDR ADDRESS
SETZM G$MSG ;Blank trailer
MOVEI P3,[ASCIZ/Job/] ;Get default headers
LOAD S2,.MRJOB(P4),MR.JOB ;Get the job number
TXZN S2,BA%JOB ;PSEUDO PROCESS ???
JRST SUSR.2 ;NO,,SKIP THIS
$TEXT (<-1,,G$MSG>,< (^15/.VSRFL(T1),MR.QUE/^0)>) ;[1173] Get type for trailer
MOVEI P3,[ASCIZ/Req/] ;Get header
SUSR.2: $TEXT (DEPBYT,< ^T/(P3)/ ^D6/S2/ User ^W6/.MRNAM(P4)/^W6/.MRNAM+1(P4)/ ^U/.MRUSR(P4)/ ^T/G$MSG/>)
SUSR.3: AOBJN P2,SUSR.1 ;CHECK ALL THE REQUESTORS
JUMPN P1,.RETT ;IF WE SAW SOME,, ALL DONE
SUSR.4: $ASCII (< (None)
>)
$RETT
;A routine to show the status of a file structure.
;Call -
; S1/ SIXBIT primary Structure VOL block
;Returns -
; Always, adding descriptive text to the message
D$SSTS: $SAVE <P1>
$SAVE <T1>
MOVE P1,S1 ;SAVE THE VOL BLK ADRS
DSKCHR P1, ;ASK FOR DISK CHARACTERISTICS
$RETF ;OOPS
SKIPE NOROOM ;IS THERE ENOUGH SPACE?
PUSHJ P,PAGOVF ;NO, GET A PAGE
TXNE P1,DC.HWP ;HARDWARE WRITE PROTECT?
$TEXT (DEPBYT,< (Hardware write protected)>)
TXNE P1,DC.SWP ;SOFTWARE WRITE PROTECT?
$TEXT (DEPBYT,< (Software write protected)>)
TXNE P1,DC.SAF ;SINGLE ACCESS?
$TEXT (DEPBYT,< (Single access)>)
TXNE P1,DC.PRV ;PRIVATE?
$TEXT (DEPBYT,< (Private structure)>)
$RETT
>;END TOPS10
SUBTTL GETSTR - Get a primary file structure block
TOPS10<
;A routine to get the next primary file structure block
; Uses LSTUSR as a flag - 0 means get first file structure block
;Call -
; With LSTUSR setup
;Returns -
; S1/ addr of str block if TRUE
; FALSE if no more str blocks
GETSTR:
SKIPE LSTUSR ;FIRST STRUCTURE BLOCK DESIRED?
JRST GTST.1 ;NO, TRY THE NEXT
SETOM LSTUSR ;YES, NOTE WE'VE BEEN HERE
MOVE S1,VOLQUE ;GET THE HANDLE ON THE VOLUME LIST
$CALL L%FIRST ;TRY THE FIRST OF THOSE
JRST GTST.2 ;ENTER THE SELECTION LOOP
GTST.1: MOVE S1,VOLQUE ;GET THE HANDLE ON THE VOLUME LIST
$CALL L%NEXT ;GET THE NEXT ITEM IN THE LIST
GTST.2: JUMPF .POPJ ;NO MORE IN THE LIST
SKIPN S1,.VLVSL(S2) ;IS THERE A VSL FOR THIS VOL?
JRST GTST.3 ;NO, TRY FOR A UCB
LOAD S1,.VSFLG(S1),VS.TYP ;GET VSL TYPE
CAXE S1,%DISK ;IS IT A DISK OF ANY NAME?
JRST GTST.1 ;NO, TRY THE NEXT VOLUME BLOCK
JRST GTST.4 ;GOT A DISK VOLUME, SEE IF ITS PRIMARY
;Here if there is no VSL requesting this VOL
GTST.3: SKIPN S1,.VLUCB(S2) ;IS THERE A UCB (UNREQUESTED STR)
STOPCD (NUV,HALT,,<No UCB ptr and No VSL ptr from VOL>)
LOAD S1,.UCBST(S1),UC.DVT ;GET TYPE CODE FROM UCB
CAXE S1,%DISK ;IS IT A DISK OF ANY NAME?
JRST GTST.1 ;NO, TRY THE NEXT VOLUME BLOCK
GTST.4: SKIPN .VLNAM(S2) ;IS THIS A PRIMARY DISK BLOCK?
JRST GTST.1 ;NO, TRY THE NEXT
MOVE S1,S2 ;YES, THIS IS THE NEXT STR BLOCK!
$RETT
>;END TOPS10
SUBTTL STRHDR - Type a header line for SHOW STATUS STRUCTURES
TOPS10<
;This routine just dumps the header line into the message for the first
; output on a show structures message
STRHDR: MOVEI S1,[ASCIZ/ Disk File Structures /]
PUSHJ P,SETPAG ;SETUP THE OUTPUT PAGE
PUSHJ P,CRLF ;NEW LINE
$ASCII (<Name Time Free Mount #Req Volume Type Drive Owner PPN >)
PUSHJ P,CRLF ;NEW LINE
$ASCII (<---- ------ -------- ----- ---- ---------- ---- ------ ------------->)
PUSHJ P,CRLF ;NEW LINE
$RETT
>;END TOPS10
SUBTTL TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HEADER
TOPS10 <
TAPHDR: MOVEI S1,[ASCIZ/ Tape Drive Status /]
PUSHJ P,SETPAG ;SETUP THE OUTPUT PAGE
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (<Drive Trk Status AVR Density >) ;START THE HEADING
SKIPE REMOTE ;ANY VOLUMES MOUNTED ???
$ASCII (< Write Volume>) ;YES,,ADD TO THE HEADER
PUSHJ P,CRLF ;END THE LINE
$ASCII (<------ --- ----------- --- ------------->) ;START THE UNDERLINE
SKIPE REMOTE ;ANY VOLUMES MOUNTED ???
$ASCII (< ------- ------>) ;YES,,ADD TO THE UNDERLINE
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
SUBTTL DSKHDR - ROUTINE TO PUT OUT DISK STATUS DISPLAY HEADER
DSKHDR: MOVEI S1,[ASCIZ/ Disk Drive Status /] ;GET STATUS HEADER
PUSHJ P,SETPAG ;SETUP THE OUTPUT PAGE
PUSHJ P,CRLF ;ADD A CRLF
$ASCII (<Drive >) ;BUILD THE HEADER
SKIPE ACTIVE ;ANY DUAL PORTED DRIVES ???
$ASCII (<Aux Port >) ;YES,,SAY SO
$ASCII (<Type Status AVR>) ;FINISH UP
SKIPE REMOTE ;ANY VOLUMES MOUNTED ???
$ASCII (< STR Volume Unit#>) ;YES,,SAY SO
PUSHJ P,CRLF ;END THE HEADER LINE
$ASCII (<------ >) ;UNDERLINE 'DRIVE'
SKIPE ACTIVE ;ANY DUAL PORTED DRIVES ???
$ASCII (<-------- >) ;YES,,UNDERLINE 'AUX PORT'
$ASCII (<---- ----------- --->) ;UNDERLINE 'TYPE - AVR'
SKIPE REMOTE ;ANY VOLUMES MOUNTED ???
$ASCII (< ----- ------ ----->) ;YES,,UNDERLINE IT
PUSHJ P,CRLF ;END THE UNDERLINE
$RETT ;AND RETURN
>
SUBTTL D$SMNT - ROUTINE TO DUMP THE MOUNT QUEUES
;AC Usage: AP --) MDR Entry
; P1 --) VSL Entry
; P2 --) VOL Entry
; P3 --) UCB Entry
; P4 --) VSL AOBJN AC
D$SMNT: SETZM LSTSMT ;ZAP ACCUMULATED TOTALS
MOVE S1,NODE6B ;GET THE NODE WE WANT
PUSHJ P,N$LOCL$$ ;SEE IF ITS LOCAL
CAME S1,[-1] ;IF ITS ALL NODES,,HE WINS
JUMPF .RETT ;NOT LOCAL,,SKIP THIS
PUSHJ P,.SAVE4 ;SAVE P1 - P4
$SAVE <T1> ;SAVE T1
MOVE S1,VOLQUE ;GET THE VOLUME QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST VOL IN THE QUEUE
JRST SMNT.2 ;JUMP THE FIRST TIME THROUGH
SMNT.1: MOVE S1,VOLQUE ;GET THE VOLUME QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT VOLUME IN THE QUEUE
SMNT.2: JUMPF SMNT.7 ;NO MORE,,GO FINISH UP...
MOVE P2,S2 ;SAVE THE VOL ENTRY ADDRESS
LOAD P4,.VLOWN(P2),VL.CNT ;GET THE VOLUME REQUEST COUNT..
JUMPE P4,SMNT.1 ;NO REQUESTORS,,SKIP IT..
MOVNS P4 ;NEGATE THE REQUEST COUNT
MOVSS P4 ;MOVE RIGHT TO LEFT
HRRI P4,.VLVSL(P2) ;CREATE VSL AOBJN AC
MOVE P3,.VLUCB(P2) ;GET THE UCB ADDRESS
SMNT.3: MOVE P1,0(P4) ;GET A VSL ADDRESS
MOVE S1,.VSFLG(P1) ;GET THE VSL FLAG BITS
TXNE S1,VS.ALC+VS.ABO ;JUST ALLOCATED OR ABORTED ???
JRST SMNT.6 ;YES,,SKIP THIS
MOVE AP,.VSMDR(P1) ;GET THE MDR ADDRESS
SKIPN S1,.MRQEA(AP) ;CHECK AND LOAD THE .QE ADDRESS
JRST SMNT.4 ;NO QE ADDRESS FOR THIS MDR
PUSHJ P,S$INPS## ;HAVE A QE,,CHECK SCHEDULABILITY
JUMPF SMNT.6 ;NOT RUNNABLE,,SKIP IT
MOVE S1,.MRQEA(AP) ;GET QE ADDRESS AGAIN
MOVX S2,QE.HBO ;GET 'HELD BY OPERATOR' BIT
TDNE S2,.QESEQ(S1) ;IS IT?
JRST SMNT.6 ;HELD JOBS CAN'T MOUNT THINGS
SMNT.4: MOVE S1,.MRUSR(AP) ;GET THE USER ID
XOR S1,LSTUSR ;MASK WITH QUEUE LIST REQUEST
SKIPE LSTUSR ;WAS USER ID SPECIFIED?
TDNN S1,LSTUSM ;DOES IT MATCH?
CAIA ;OK
JRST SMNT.6 ;NO--GET NEXT VSL
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TOPS10< TXNE P1,VL.ASN ;DOES HE OWN THE VOLUME ???
JRST SMNT.6 ;YES,,SKIP IT...
>
LOAD S1,.VSCVL(P1),VS.OFF ;GET THE OFFSET TO HIS CUR VOL
ADDI S1,.VSVOL(P1) ;POINT TO HIS CURRENT VOL ADDR
MOVE S1,0(S1) ;PICK UP THE CURRENT VOL ADDRESS
CAME S1,P2 ;IS THIS THE ONE HE WANTS ???
JRST SMNT.6 ;NO,,GET NEXT
MOVE S2,.VLNAM(S1) ;ELSE GET VOLUME NAME
XOR S2,LSTJOB ;COMBINE WITH LIST REQUESTS
SKIPE LSTJOB ;SEE IF LIST REQUEST VOLUME NAME
TDNN S2,LSTJBM ;MASK OUT
CAIA ;MATCHES
JRST SMNT.6 ;LOSER
LOAD S1,.VSFLG(P1),VS.TYP ;GET THE VOLUME SET TYPE
CAXE S1,%DISK ;IS THIS A STRUCTURE REQUEST ???
JRST SMN.3B ;NO,,PUT OUT ALL TAPE REQUESTS
LOAD S1,.VLFLG(P2),VL.STA ;GET THE VOLUME STATUS
CAXN S1,%STAMN ;IS THE STRUCTURE MOUNTED ???
JRST SMNT.6 ;YES,,SKIP THIS REQUEST
SMN.3B: AOSG JOBNBR ;BUMP REQUEST COUNT BY 1
PUSHJ P,MNTHDR ;FIRST TIME,,PUT OUT A HEADER
SKIPE LSTSUM ;SUMMARY?
JRST SMNT.6 ;YES--BE QUIET
SKIPE NOROOM ;ANY ROOM LEFT ???
PUSHJ P,PAGOVF ;NO,SEND CURRENT PAGE AND START NEW ONE
PUSHJ P,SMTVOL ;DISPLAY VOLUME NAME
PUSHJ P,SMTSTS ;DISPLAY STATUS
PUSHJ P,SMTTYP ;DISPLAY MOUNT TYPE
PUSHJ P,SMTWLE ;DISPLAY WRITE LOCKED/ENABLED STATUS
PUSHJ P,SMTDMO ;DISPLAY DEMOGRAPHIC STUFF
PUSHJ P,SMNATT ;PRINT MOUNT REQUEST ATTRIBUTES
SMNT.6: AOBJN P4,SMNT.3 ;CONTINUE THROUGH ALL USERS
JRST SMNT.1 ;CONTINUE THROUGH ALL VOLUMES
SMNT.7: AOSG S1,JOBNBR ;CORRECT THE COUNT
JRST SMNT.9 ;NO REQUESTS,,RETURN NOW
SETOM QEMPTY ;INDICATE THE QUEUES ARE NOT EMPTY
SKIPN LISTYP ;IS THIS A FAST LISTING ???
JRST SMNT.9 ;YES,,SKIP THIS
SKIPE LSTSUM ;SUMMARY?
JRST SMNT.8 ;YES
CAIN S1,1 ;IS THERE 1 REQUEST ???
$ASCII (<There is 1 request in the queue>) ;YES,,SAY SO
CAILE S1,1 ;IS THERE MORE THEN 1 ???
$TEXT (DEPBYT,<There are ^D/S1/ requests in the queue^A>)
PUSHJ P,CRLF ;OUTPUT A CRLF
JRST SMNT.9 ;ONWARD
SMNT.8: MOVEI S1,[ASCIZ /Mount/] ;GET QUEUE NAME
MOVEI S2,[ASCIZ /request/] ;GET SUMMARY QUANTITY NAME
PUSHJ P,LIST.S ;DO SUMMARY LINE
PUSHJ P,CRLF ;END LINE
SMNT.9: SETOM JOBNBR ;RESET THE JOB/REQUEST COUNTER
SETZM ACTIVE ;AND THE ACTIVE COUNTER
$RETT ;AND RETURN
; MOUNT display volume output
;
SMTVOL: LOAD S1,.VSFLG(P1),VS.TYP ;GET THE REQUEST TYPE
CAXE S1,%TAPE ;IS IT A MAGTAPE ?
CAXN S1,%DTAP ;OR A DECTAPE ?
JRST SMTV.1 ;YES - HANDLE DIFFERENTLY
$TEXT (DEPBYT,<^W9/.VLNAM(P2)/^A>) ;ALL OTHERS
POPJ P, ;RETURN
SMTV.1: LOAD T1,.VLFLG(P2),VL.SCR ;GET THE SCRATCH VOLUME BIT
SKIPE T1 ;IS THIS A SCRATCH TAPE
$ASCII (<Scratch >) ;YES,,MAKE IT SCRATCH
SKIPN T1 ;CHECK FOR SCRATCH ONCE AGAIN
$TEXT (DEPBYT,<^W9/.VLNAM(P2)/^A>) ;NOT SCRATCH,,DUMP VOL NAME
POPJ P, ;RETURN
; MOUNT display status output
;
SMTSTS: LOAD T1,.VSFLG(P1),VS.TYP ;GET THE REQUEST TYPE
CAXN T1,%DSMT ;DISMOUNT STRUCTURE ???
JRST [$ASCII (<Dismount >) ;YES,,SAY SO
$RET ] ;AND RETURN
LOAD T1,.VLFLG(P2),VL.STA ;[1164] GET THE VOLUME STATUS
TXNN P1,VL.ASN ;DOES THE USER HAVE IT MOUNTED ???
JRST SMTS.1 ;NO,,MAKE IT WAITING
CAXN T1,%STAAB ;IS IT 'ABORTED' ???
$ASCII (<Aborted >) ;YES,,SAY SO
CAXE T1,%STADM ;IS IT 'DISMOUNT' ???
CAXN T1,%STAMN ;OR IS IT MOUNTED ???
$TEXT (DEPBYT,<^W10/.UCBNM(P3)/^A>) ;YES,,INSERT THE DEVICE NAME
POPJ P, ;[1164] RETURN
SMTS.1: CAXN T1,%STAIN ;IS IT 'INITIALIZING'???
$ASCII (<Initial >) ;YES,,SAY SO
CAXE T1,%STAIN ;NO,,ANYTHING ELSE IS 'WAITING'
$ASCII (<Waiting >) ;..
POPJ P, ;RETURN
; MOUNT display type output
;
SMTTYP: LOAD T1,.VSFLG(P1),VS.TYP ;GET THE VOLUME-SET TYPE
CAXN T1,%DTAP ;IS IT 'DECTAPE' ??
$ASCII (<DECtape >) ;YES
CAXN T1,%TAPE ;IS IT 'TAPE' ???
$ASCII (<Magtape >) ;YES
CAXE T1,%DSMT ;IS IT A STRUCTURE DISMOUNT ???
CAXN T1,%DISK ;OR IS IT 'DISK' ???
$ASCII (<Disk >) ;YES
CAXE T1,%UNKN ;OR 'UNKNOWN' DEVICE ?
$RETT ;NO
MOVX T1,VS.FDV ;BIT TO TEST
TDNE T1,.VSFLG(P1) ;FOREIGN (UNIT RECORD) DEVICE?
$ASCII (< >) ;YES,JUST PUT OUT BLANKS
TDNN T1,.VSFLG(P1) ;CHECK AGAIN
$ASCII (<Unknown >) ;YES
$RETT ;RETURN
; MOUNT display write locked/enabled status output
;
SMTWLE: LOAD T1,.VSFLG(P1),VS.TYP ;GET THE VOLUME-SET TYPE
CAXE T1,%TAPE ;IS IT 'TAPE' ???
CAXN T1,%DTAP ;OR A DECTAPE ?
JRST SMTW.1 ;YES TO EITHER
JRST SMTW.2 ;OTHERWISE, SKIP THIS FIELD
SMTW.1: LOAD T1,.VSFLG(P1) ;GET THE FLAG BITS FOR THE VOLUME SET
TXC T1,VS.WLK ;WANT IR WRITE ENABLED
TXNE T1,VS.WLK+VS.NEW+VS.SCR ;IS ENABLED OR NEW OR SCRATCH
$ASCII (<Enabled >) ;THEN SAY SO
TXNN T1,VS.WLK+VS.NEW+VS.SCR ;CHECK AGAIN
$ASCII (<Locked >) ;NONE SET,,THEN WRITE LOCKED
POPJ P, ;RETURN
SMTW.2: $ASCII (< >) ;DISPLAY NOTHING
POPJ P, ;RETURN
; MOUNT display demographic output
;
SMTDMO: LOAD S1,.MRJOB(AP),MR.JOB ;GET THE 'JOB NUMBER'
TXZN S1,BA%JOB ;IS THIS A PSEUDO PROCESS ???
JRST SMTD.1 ;NO,,SKIP THIS
$TEXT (<-1,,G$MSG>,<^I/MNTUSR/^0>) ;GEN THE DEMOGRAPHIC DATA
$TEXT (DEPBYT,<^D6R /.VSRID(P1)/ ^D4R /S1/ ^T20/G$MSG/ ^15/.VSRFL(P1),MR.QUE/>) ;[1173]
POPJ P, ;RETURN
SMTD.1: $TEXT (DEPBYT,<^D6R /.VSRID(P1)/ ^D4R /.MRJOB(AP),MD.PJB/ ^I/MNTUSR/>)
POPJ P, ;RETURN
; MOUNT display request attribute output
;
SMNATT: SKIPN LISTYP ;WAS IT /FAST ?
$RETT ;YES - RETURN NOW
LOAD T1,.VSFLG(P1),VS.TYP ;GET VOLUME SET TYPE
TOPS10< CAXN T1,%DISK ;STRUCTURE ???
JRST SMNA.1 ;YES,,SKIP THIS
CAXE T1,%DTAP ;DECTAPE?
CAXN T1,%TAPE ;MAGTAPE?
JRST [$TEXT (DEPBYT,< Volume-set: ^T/.VSVSN(P1)/>) ;INSERT TEXT
JRST SMNA.1 ] ;AND SKIP THIS
MOVE S1,P1 ;GET THE VSL ADDRESS
PUSHJ P,I$CGEN## ;GET TRANSLATION INDEX
JUMPF SMNA.1 ;NO TYPEOUT IF UNABLE TO TRANSLATE
$TEXT (DEPBYT,< Device-type: ^T/@DEVNTB(S1)/>) ;YES
> ;End TOPS10 conditional
SMNA.1: SKIPE .VSREM(P1) ;Was there a remark ?
$TEXT (DEPBYT,< Remark: ^T/.VSREM(P1)/>) ;Yes,,tell user
TOPS10< CAXE T1,%TAPE ;Check again for a tape request
$RETT ;Not one - return
LOAD T1,.VSFLG(P1),VS.LBT ;Get the label type
LOAD T2,.VSATR(P1),VS.TRK ;Get the track status
LOAD T3,.VSATR(P1),VS.DEN ;Pick up density index
$TEXT (DEPBYT,< Label-Type: ^T/@LABELS(T1)/, Tracks:^W/TRK(T2)/, Density: ^T/@DENSTY(T3)/ BPI>)
MOVE T1,.VSFLG(P1) ;GET VSL FLAGS
TXNE T1,VS.NEW!VS.INI ;[1164] REINITIALIZING?
JRST SMNA.2 ;[1164] YES,,JUMP OVER SCRATCH STUFF
TXNE T1,VS.SCR ;[1164] NO,,IS THE SCRATCH BIT ON?
TXNN T1,VS.REL ;AND THE USER SPECIFY A REELID?
$RETT ;NO MORE TO DO
LOAD S1,.VSFLG(P1),VS.LBT ;GET LABEL TYPE
PUSHJ P,D$GLBT## ;SEE IF IT IS LABELED
CAIN S1,%LABEL ;[1164] YES
$TEXT (DEPBYT,< Initialize new/scratch tape: - Volume-id: ^W/.VLNAM(P2)/ - Protection: ^O3/.VSATR(P1),VS.PRT/>) ;[1164]
$RETT ;[1164] GO AWAY
SMNA.2: LOAD S1,.VSCVL(P1),VS.CNT ;[1164] GET NUMBER OF VOLS
CAIE S1,1 ;[1164] ONLY 1 VOL?
SKIPA T1,[BYTE (7) "s",0,0,0,0] ;[1164] NO
SETZM T1 ;[1164] YES
$TEXT (DEPBYT,< Reinitializing ^D/S1/ volume^T/T1/>) ;[1164]
> ;End TOPS10 Conditional
$RETT ;Return
MNTHDR: MOVEI S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
SKIPN BYTPTR ;DO WE HAVE A PAGE ALREADY SETUP
PUSHJ P,SETPAG ;NO,,GO DO IT
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<Mount Queue:>) ;OUTPUT A HEADER
PUSHJ P,CRLF ;OUTPUT A CRLF
SKIPN LISTYP ;IS THIS A FAST LISTING ???
$RETT ;YES,,RETURN
$ASCII (<Volume Status Type Write Req# Job# User>)
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<------- -------- -------- ------- ------ ---- ------------------->)
PUSHJ P,CRLF ;OUTPUT A CRLF
$RETT ;AND RETURN
SUBTTL SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES.
SHOWQS: $SAVE <H,P1> ;SAVE H AND P1
STORE H,HDRSAV ;HERE ALSO.
SETO P1, ;FLAG FIRST PASS THROUGH QUEUES
SETZM LSTSMT ;ZERO ACCUMULATED TOTALS
MOVSI S1,'* ' ;GEN A SIXBIT '*' IN LOW BITS
MOVEM S1,JOBACT ;STORE IT IN JOBACT
MOVEI H,HDRUSE## ;LOOP THROUGH ACTIVE QUEUE FIRST.
LOAD AP,.QHLNK(H),QH.PTF ;GET THE FIRST ENTRY.
SHOW.1: JUMPE AP,SHOW.3 ;DONE,,DO EXTERNAL QUEUE.
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE OBJECT TYPE.
PUSHJ P,A$OB2Q## ;CONVERT IT TO A QUEUE HEADER.
CAME S1,HDRSAV ;ARE THEY THE SAME ???
JRST SHOW.2 ;NO,,TRY THE NEXT ONE.
LOAD T2,.QESEQ(AP),QE.RDE ;GET THE RDE BITS.
JUMPN T2,SHOW.2 ;NOT REALLY THERE,,TRY NEXT ONE.
PUSHJ P,PUTOUT ;GO PUT OUT THE LISTING.
JUMPF SHOW.2 ;NOT THIS ONE,,GET NEXT.
AOS ACTIVE ;BUMP THE ACTIVE COUNT BY 1.
SKIPN LSTSUM ;SKIP IF SUMMARY
SKIPN LISTYP ;IF THIS IS A QUICK LIST,,SKIP THIS.
JRST SHOW.2 ;DO NOT DUMP STATUS DATA.
$ASCII (< >) ;INSERT SOME BLANKS.
MOVEI S1,OBJST1(P3) ;DEFAULT TO THE JOB STATUS DATA.
MOVE S2,OBJSTS(P3) ;GET THE DEVICE STATUS
CAIN S2,%STOPD ;IS IT 'STOPPED' ???
MOVEI S1,[ASCIZ/--Stopped By Operator--/] ;YES,,SAY SO
CAIN S2,%NPTYS ;ARE WE WAITING FOR PTYS ???
MOVEI S1,[ASCIZ/--Waiting For PTYs--/] ;YES,,SAY SO
CAIN S2,%OFLNE ;ARE WE OFFLINE ???
MOVEI S1,[ASCIZ/--Waiting For Operator Intervention--/] ;YES,,SAY SO
CAIN S2,%OREWT ;ARE WE WAITING FOR OPR RESPONSE
MOVEI S1,[ASCIZ/--Waiting For Operator Response--/] ;YES,,SAY SO
CAIN S2,%ALIGN ;ARE WE ALIGNING FORMS ???
MOVEI S1,[ASCIZ/--Aligning Forms--/] ;YES,,SAY SO
PUSHJ P,ASCOUT ;DUMP THE STATUS OUT.
PUSHJ P,CRLF ;OUTPUT A CRLF.
SHOW.2: LOAD AP,.QELNK(AP),QE.PTN ;GET THE ADDRESS OF THE NEXT ENTRY.
JRST SHOW.1 ;AND GO PROCESS IT.
SHOW.3: LOAD H,HDRSAV ;GET THE HEADER ADDRESS.
LOAD AP,.QHLNK(H),QH.PTF ;GET THE FIRST ENTRY ADDRESS.
SETZM JOBACT ;INDICATE EXTERNAL QUEUE PROCESSING.
SHOW.4: JUMPE AP,SHW.5A ;NO MORE,,FINISH UP.
MOVE S1,G$NOW## ;GET NOW
CAML S1,.QECRE(AP) ;IS THIS AN AFTER ENTRY?
JRST [JUMPE P1,SHOW.5 ;NO, IS IT THE SECOND PASS?
JRST .+2] ;NO, LIST THIS ONE
JUMPN P1,SHOW.5 ;IGNORE AFTER ENTRIES IN FIRST PASS
PUSHJ P,PUTOUT ;PUT OUT THE LISTING.
SHOW.5: LOAD AP,.QELNK(AP),QE.PTN ;GET THE NEXT ENTRY.
JRST SHOW.4 ;AND GO PROCESS IT.
SHW.5A: AOJN P1,SHOW.6 ;JUMP IF REALLY DONE
JRST SHOW.3 ;JUST FINISHED FIRST PASS, GO DO SECOND
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SHOW.6: AOSG T1,JOBNBR ;GET & CORRECT THE JOB COUNT
JRST SHOW.7 ;NONE THERE,,RETURN
SETOM QEMPTY ;INDICATE THAT THE Q'S ARE NOT EMPTY.
SKIPN LISTYP ;IS THIS A 'FAST' LISTING ???
JRST SHOW.7 ;YES,,SKIP THIS
MOVE H,HDRSAV ;GET SAVED QUEUE HEADER
SKIPE LSTSUM ;SUMMARY?
JRST SHOW.S ;YES
CAIN T1,1 ;JUST 1 JOB PROCESSED ???
$TEXT (DEPBYT,<There is 1 ^T/@.QHSQN(H)/ in the queue^A>)
CAIE T1,1 ;MORE THEN 1 JOB ???
$TEXT (DEPBYT,<There are ^D/T1/ ^T/@.QHSQN(H)/s in the queue^A>)
JRST SHOW.A ;SKIP SUMMARY STUFF
SHOW.S: MOVE S2,.QHSQN(H) ;GET SUMMARY QUANTITY NAME
MOVE S1,.QHLQN(H) ;GET LISTING QUEUE NAME
PUSHJ P,LIST.S ;LIST SUMMARY LINE
SHOW.A: SKIPG ACTIVE ;ANY OF THEM ACTIVE ???
$ASCII (< (none in progress)>) ;NO,,SAY SO.
SKIPE ACTIVE ;ANY OF THEM ACTIVE ???
$TEXT (DEPBYT,< (^D/ACTIVE/ in progress)^A>) ;YES,,SAY SO.
PUSHJ P,LIST.X ;FINISH OFF LINE
PUSHJ P,CRLF ;INSERT A CRLF.
SHOW.7: SETOM JOBNBR ;RESET JOB COUNT
SETZM ACTIVE ;RESET ACTIVE COUNT.
CAIE H,HDRINP## ;WAS THIS THE BATCH QUEUE ???
$RETT ;NO,,RETURN.
;Here to output the batch pre-processor queue
SKIPN LSTJOB ;USER SPECIFY A JOB ?
SKIPE LSTUSR ;OR A USER ?
$RETT ;YES TO EITHER
SKIPE LISTYP ;A 'FAST' LISTING ???
SKIPL LSTUNT ;OR A UNIT ?
$RETT ;YES
SKIPE LSTUTY ;A UNIT TYPE?
$RETT ;YES
MOVEI S1,HDRBIN## ;GET THE SPRINT QUEUE ADDRESS
LOAD S2,.QHLNK(S1),QH.PTF ;GET THE FIRST ENTRY ADDRESS.
JUMPE S2,SHOW.8 ;NOTHING THERE,,SKIP THIS
AOS JOBNBR ;BUMP THE QUEUE COUNT
LOAD S2,.QELNK(S2),QE.PTN ;GET THE ADDRESS OF THE NEXT ENTRY.
JUMPN S2,.-2 ;ANOTHER,,COUNT'EM UP !!!
SHOW.8: MOVX S1,.OTBIN ;GET OBJECT TYPE
MOVEM S1,TIME.+OBJ.TY ;SAVE IT
SETZM TIME.+OBJ.UN ;UNIT 0
MOVE S1,G$LNAM## ;GET LOCAL NODE NAME
MOVEM S1,TIME.+OBJ.ND ;SAVE IT
MOVEI S1,TIME. ;GET OBJ BLK ADDRESS
PUSHJ P,A$FOBJ## ;LOCATE THE REAL THING
JUMPF SHOW.9 ;NOT THERE,,STRANGE !!!
MOVE AP,S1 ;SAVE THE OBJECT ADDRESS
LOAD S1,OBJSCH(AP),OBSBUS ;GET OBJ ACTIVE STATUS
SKIPGE JOBNBR ;ANY JOBS PENDING ???
JUMPE S1,.RETT ;NO,,AND OBJECT NOT ACTIVE - RETURN !!!
PUSH P,[[ASCIZ/none active/]
[ASCIZ/1 active/]](S1) ;SAVE STATUS TEXT ADDRESS
MOVEI S1,[ASCIZ/ System Queues Listing /] ;GET LIST HEADER ADDRESS
SKIPN BYTPTR ;DO WE HAVE A PAGE ALREADY SETUP
PUSHJ P,SETPAG ;NO,,THEN SET ONE UP !!!
SETOM QEMPTY ;SET FLAG 'QUEUE NOT EMPTY'
MOVEI S2,[ASCIZ/ jobs pending, /] ;DEFAULT TO MULTIPLE JOBS
AOS S1,JOBNBR ;UPDATE JOB COUNT
CAIN S1,1 ;ONLY 1 JOB ???
MOVEI S2,[ASCIZ/ job pending, /] ;YES,,MAKE IT 1 JOB
POP P,S1 ;GET THE STATUS TEXT ADDRESS BACK
$TEXT(DEPBYT,<^M^JReader interpreter queue: ^D/JOBNBR/^T/0(S2)/^T/0(S1)/>)
LOAD S1,OBJSCH(AP),OBSBUS ;GET OBJ ACTIVE STATUS
SKIPE S1 ;WAS IT ACTIVE ???
$TEXT (DEPBYT,<* ^T/OBJST1(AP)/>) ;YES,,INSERT STATUS
SHOW.9: SETOM JOBNBR ;RESET JOB COUNT
$RETT ;AND RETURN
SUBTTL PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING.
PUTOUT: LOAD P3,.QEOBJ(AP) ;GET THE OBJECT ADDR (FOR ACTIVE JOBS)
MOVE S2,.QEOID(AP) ;GET THE QUEUE ENTRY USER ID
XOR S2,LSTUSR ;COMBINE WITH LIST REQUESTS
SKIPE LSTUSR ;SEE IF LIST REQUEST USER ID
TDNN S2,LSTUSM ;MASK OUT
CAIA ;MATCHES
$RETF ;LOSER
MOVE S2,.QEJOB(AP) ;GET THE QUEUE ENTRY JOB NAME
XOR S2,LSTJOB ;COMBINE WITH LIST REQUESTS
SKIPE LSTJOB ;SEE IF LIST REQUEST JOB NAME
TDNN S2,LSTJBM ;MASK OUT
CAIA ;MATCHES
$RETF ;LOSER
SKIPGE S2,LSTUNT ;GET /UNIT
JRST POUT1 ;NOT SPECIFIED
SKIPE JOBACT ;SEE IF ACTIVE
JRST [MOVE S1,OBJUNI(P3) ;YES--GET UNIT FROM OBJ BLOCK
JRST POUT2] ;AND USE THAT
LOAD S1,.QEROB+.ROBAT(AP),RO.ATR;GET ATTRIBUTES
CAIE S1,%PHYCL ;PHYSICAL?
$RETF ;NO--DOESNT MATCH
LOAD S1,.QEROB+.ROBAT(AP),RO.UNI;GET REQUESTS UNIT
POUT2: CAIE S1,(S2) ;MATCH USERS?
$RETF ;NO--DOESNT MATCH
POUT1: SKIPN S2,LSTUTY ;UNIT TYPE REQUESTED?
JRST POUT3 ;NO
SKIPE JOBACT ;SEE IF ACTIVE
MOVE S1,OBJPRM+.OOUNT(P3) ;GET FROM OBJECT BLOCK
MOVE S1,.QEROB+.ROBUT(AP) ;GET FROM QE
CAME S1,S2 ;REQUESTED UNIT TYPE MATCH LIST SPEC?
$RETF ;NO
POUT3: SKIPE NOROOM ;IS THERE ROOM IN THE OUTPT PAGE ?
PUSHJ P,PAGOVF ;NO,,CLEAN UP A BIG MESS.
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE OBJECT (QUEUE) TYPE.
MOVEM S1,OBTYPE ;SAVE IT FOR LATER USE.
MOVE S1,HDRSAV ;GET SAVED QUEUE HEADER ADDRESS
PUSHJ P,@.QHDEP(S1) ;DUMP IT OUT
POPJ P, ;RETURN TRUE OR FALSE
SUBTTL SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATUS COMMAND.
SHSTAT: LOAD S1,OBJSTS(T1) ;GET THIS OBJECTS STATUS CODE
$TEXT (DEPBYT,<^T15L /@OBJSTC(S1)/ ^A>) ;OUTPUT THE STATUS
LOAD S1,OBJSCH(T1) ;GET THIS OBJECTS SCHEDLNG BITS
TXNN S1,OBSBUS ;IS IT BUSY ???
PJRST CRLF ;GO FINISH UP
MOVE TF,OBJTYP(T1) ;GET OBJECT TYPE
CAIN TF,.OTFAL ;IS IT FAL?
JRST FALSTS ;YES, FAL'S A HYBRID
CAIN TF,.OTNQC ;NETWORK QUEUE CONTROLLER?
JRST NQCSTS ;YES
LOAD S1,OBJITN(T1) ;GET THE CONTROLLING JOB
PUSHJ P,Q$SUSE## ;FIND THE JOB IN THE USE QUEUE
JUMPF CRLF ;SHOULD NOT HAPPEN !!
MOVE AP,S1 ;GET THE QUEUE ENTRY ADDRESS
$TEXT (DEPBYT,<^W6L /.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>)
SKIPN LISTYP ;IF THIS IS A FAST LISTING,,THEN
$RETT ;SKIP THE JOB STATUS DISPLAY
$ASCII (< >) ;INSERT A <TAB>
MOVEI S1,OBJST1(T1) ;GET THE JOBS STATUS DESCRIPTION ADDR
PUSHJ P,ASCOUT ;PUT IT OUT
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
;DISPLAY FAL-STREAM STATUS
FALSTS: MOVE S1,OBJPRM+.OBCON(T1) ;GET STREAM CONNECT TIME
IDIV S1,G$TIC## ;GET NUMBER OF SECONDS
IDIVI S1,^D60 ;GET CONNECT SECONDS
MOVEM S2,TIME.+2 ;SAVE IT
IDIVI S1,^D60 ;GET CONNECT HOURS IN S1, MINUTES IN S2
DMOVEM S1,TIME.+0 ;SAVE THEM
$TEXT (DEPBYT,<^W6L /OBJPRM+.OBNDN(T1)/ ^I/TIM/ ^D7R /OBJPRM+.OBBYT(T1)/>)
$ASCII (< >) ;INSERT A <TAB>
MOVEI S1,OBJST1(T1) ;GET THE JOBS STATUS DESCRIPTION ADDR
PUSHJ P,ASCOUT ;PUT IT OUT
PJRST CRLF ;END LINE AND RETURN
DEFINE X (TXT,SYM,OBJ) <
[ASCIZ\TXT\]
>
ATRBTB: ATTRIB ;GENERATE ATTRIBUTE TEXT TABLE
NQCSTS: SKIPN OBJPRM+.ONNOD(T1) ;NQC TELL US ANYTHING YET?
PJRST CRLF ;NO, THEN NOT MUCH ELSE WE CAN ADD
MOVE S1,OBJPRM+.ONCON(T1) ;GET STREAM CONNECT TIME (IN SECONDS)
IDIVI S1,^D60 ;GET CONNECT SECONDS
MOVEM S2,TIME.+2 ;SAVE IT
IDIVI S1,^D60 ;GET CONNECT HOURS IN S1, MINUTES IN S2
DMOVEM S1,TIME.+0 ;SAVE THEM
MOVE S1,OBJPRM+.ONLNK(T1) ;GET LINK TYPE (NETWORK TYPE)
MOVE S1,[[ASCIZ\ANF-10\]
[ASCIZ\DECnet\]]-1(S1) ;GET TEXT ASSOCIATED WITH IT
$TEXT (DEPBYT,<^W6L /OBJPRM+.ONNOD(T1)/ ^T/0(S1)/ ^I/TIM/ ^D7R/OBJPRM+.ONBYT(T1)/>)
$ASCII (< >) ;INSERT A <TAB>
MOVEI S1,OBJST1(T1) ;GET THE JOBS STATUS DESCRIPTION ADDR
PUSHJ P,ASCOUT ;PUT IT OUT
PJRST CRLF ;END LINE AND RETURN
SUBTTL SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND.
SHPARM: MOVE S1,OBTYPE ;GET THE OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
JRST SHPA.1 ;NO,,GO TRY SOMETHING ELSE
LOAD S1,OBJPRM+.OBTIM(T1),OBPMIN ;GET MIN TIME LIMIT
LOAD S2,OBJPRM+.OBTIM(T1),OBPMAX ;GET MAX TIME LIMIT
LOAD T2,OBJPRM+.OBPRI(T1),OBPMIN ;GET MIN PRIORITY
LOAD T3,OBJPRM+.OBPRI(T1),OBPMAX ;GET MAX PRIORITY
$TEXT (DEPBYT,<^D6R /S1/:^D6L /S2/ ^D2R /T2/:^D2L /T3/ ^A>)
IFN INPCOR,<
LOAD S1,OBJPRM+.OBCOR(T1),OBPMIN ;GET MIN CORE LIMIT
LOAD S2,OBJPRM+.OBCOR(T1),OBPMAX ;GET MAX CORE LIMIT
$TEXT (DEPBYT,<^D5R /S1/:^D5L /S2/ ^A>)
>
LOAD S1,OBJPRM+.OBFLG(T1),.OPRIN ;GET OPR INTRVN FLAG
CAIN S1,.OPINY ;IS IT ALLOW OPR INTRVN ???
$ASCII (< Yes>) ;YES,,SAY SO
CAIN S1,.OPINN ;IS IT NO OPR INTRVN ???
$ASCII (< No>) ;YES,,SAY SO
CAIN S1,.OPINS ;DEPEND ON SCHED?
$ASCII (< System>) ;YES,,SAY SO
SKIPN ATRIB ;NEED TO LIST ATTRIBUTES ?
JRST SHPA.0 ;NO - ALL DONE
LOAD S1,OBJDAT(T1),RO.ATR ;GET ATTRIBUTES
CAIN S1,%SITGO ;SITGO PROCESSOR?
$ASCII (< SITGO>)
SHPA.0: SKIPE OBJRID(T1) ;NEXTED REQUEST?
$TEXT (DEPBYT,<^M^J Next request #^D/OBJRID(T1)/^A>) ;INCLUDE BLURB
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
SHPA.1: CAIN S1,.OTFAL ;FAL?
JRST SHPA.2 ;YES, GO HANDLE FAL
CAIN S1,.OTNQC ;NETWORK QUEUE CONTROLLER?
JRST SHPA.3 ;YES
LOAD S1,OBJPRM+.OOLIM(T1),OBPMIN ;GET MIN OUTPUT LIMIT
LOAD S2,OBJPRM+.OOLIM(T1),OBPMAX ;GET MAX OUTPUT LIMIT
LOAD T2,OBJPRM+.OOFRM(T1) ;GET THE FORMS TYPE
LOAD T3,OBJPRM+.OOPRI(T1),OBPMIN ;GET MIN PRIORITY
LOAD T4,OBJPRM+.OOPRI(T1),OBPMAX ;GET MAX PRIORITY
$TEXT (DEPBYT,<^D5R /S1/:^D6L /S2/ ^W6L /T2/ ^D2R /T3/:^D2L /T4/ ^A>)
LOAD S1,OBJPRM+.OOFLG(T1),.OFLEA ;GET LIMIT EXCEEDED ACTION
CAIN S1,.STIGN ;IS IT 'IGNORE' ???
$ASCII (<Proceed >) ;YES,,SAY SO
CAIN S1,.STCAN ;IS IT 'CANCEL' ???
$ASCII (<Abort >) ;YES,,SAY SO
CAIN S1,.STASK ;IS IT ASK ???
$ASCII (<Ask >) ;YES,,SAY SO
LOAD S1,OBJDAT(T1),RO.ATR ;GET THE DEVICE ATTRIBUTES
CAIN S1,%LOWER ;IS IT LOWER CASE??
$ASCII (<Lower >) ;YES,,SAY SO
CAIN S1,%UPPER ;IS IT UPPER CASE ??
$ASCII (<Upper >) ;YES,,SAY SO
SKIPE S1,OBJPRM+.OOUNT(T1) ;HAVE A UNIT TYPE?
$TEXT (DEPBYT,<^W/S1/ ^A>) ;DISPLAY IT
LOAD S1,OBJSCH(T1),OBSSPL ;GET THE SPOOLING TO TAPE BITS
SKIPE S1 ;ARE WE SPOOLING TO TAPE ???
$TEXT (DEPBYT,<^W/OBJPRM+.OOTAP(T1)/:^A>) ;YES,,SAY SO
SKIPE OBJRID(T1) ;NEXTED REQUEST?
$TEXT (DEPBYT,<^M^J Next request #^D/OBJRID(T1)/^A>) ;INCLUDE BLURB
PJRST SHPSIM ;GO DISPLAY DETAILED PARAMETERS
;Display FAL-STREAM parameters
SHPA.2: MOVE S1,OBJPRM+.OBNTY(T1) ;GET NETWORK-TYPE ATTRIBUTE
MOVE S1,[[ASCIZ\ANF-10\]
[ASCIZ\DECnet\]]-1(S1) ;GET TEXT ASSOCITATED WITH IT
PUSHJ P,ASCOUT ;DUMP IT
PJRST CRLF ;FINISH UP
;Display NETWORK-QUEUE-CONTROLLER parameters
SHPA.3: LOAD S1,OBJDAT(T1),RO.ATR ;GET ATTRIBUTES
MOVE S1,ATRBTB(S1) ;AND ASSOCIATED TEXT
PUSHJ P,ASCOUT ;DUMP IT
PJRST CRLF ;FINISH UP
;SHOW SIMULATION
SHPSIM: LOAD S1,OBJPRM+.OOFLG(T1),OF.LP2 ;LP20 SIMULATION
JUMPE S1,SHPMTA ;GO CHECK MAGTAPE PARAMETERS
SETZM BYTCNT ;FORCE CRLF ON FIRST OUTPUT
SHPLP2: LOAD S1,OBJPRM+.OOFLG(T1),OF.LP2 ;LP20 SIMULATION
JUMPE S1,SHPMTA ;NEED TO DISPLAY?
MOVEI S1,^D12 ;FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOFLG(T1),OF.LP2 ;DATA
$TEXT (DEPBYT,<LP20 simulation:^T/@YNTAB(S1)/ ^A>)
;SHOW MAGTAPE PARAMETERS
SHPMTA: MOVE S1,OBJPRM+.OOMTA(T1) ;MAGTAPE PARAMETERS?
IOR S1,OBJPRM+.OOVSN(T1) ; OR VOLUMET-SET NAME?
JUMPE S1,CRLF ;RETURN IF NONE
SETZM BYTCNT ;FORCE CRLF ON FIRST OUTPUT
;DENSITY
SHPMDN: LOAD S1,OBJPRM+.OOMTA(T1),OB.MDN ;GET DENSITY
JUMPE S1,SHPMDI ;NEED TO DISPLAY?
MOVEI S1,^D12 ;FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOMTA(T1),OB.MDN ;GET DENSITY
$TEXT (DEPBYT,<Density:^T/@DENSTY(S1)/ ^A>)
;DIRECTORY-FILE
SHPMDI: LOAD S1,OBJPRM+.OOMTA(T1),OB.MDI ;GET DIRECTORY-FILE
JUMPE S1,SHPMLT ;NEED TO DISPLAY?
MOVEI S1,^D12 ;FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOMTA(T1),OB.MDI ;GET DIRECTORY-FILE
$TEXT (DEPBYT,<Directory:^T/@YNTAB(S1)/ ^A>)
;LABEL-TYPE
SHPMLT: MOVX S1,OB.MLV ;BIT TO TEST
TDNN S1,OBJPRM+.OOMTA(T1) ;LABEL FIELD VALID?
JRST SHPMRL ;NO
MOVEI S1,^D16 ;FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOMTA(T1),OB.MLT ;GET LABEL TYPE
$TEXT (DEPBYT,<Labels:^T/@LABELS(S1)/ ^A>)
;MULTI-REEL
SHPMRL: LOAD S1,OBJPRM+.OOMTA(T1),OB.MRL ;GET MULTI-REEL
JUMPE S1,SHPMPR ;NEED TO DISPLAY?
MOVEI S1,^D14 ;FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOMTA(T1),OB.MRL ;GET MULTI-REEL
$TEXT (DEPBYT,<Multi-reel:^T/@YNTAB(S1)/ ^A>)
;PARITY
SHPMPR: LOAD S1,OBJPRM+.OOMTA(T1),OB.MPR ;GET PARITY
JUMPE S1,SHPMTK ;NEED TO DISPLAY?
MOVEI S1,^D11 ;FIELD WIDTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOMTA(T1),OB.MPR ;GET PARITY
$TEXT (DEPBYT,<Parity:^T/@PARTAB(S1)/ ^A>)
;TRACKS
SHPMTK: LOAD S1,OBJPRM+.OOMTA(T1),OB.MTK ;GET TRACKS
JUMPE S1,SHPMVS ;NEED TO DISPLAY?
MOVEI S1,^D8 ;FIELD WIDTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,OBJPRM+.OOMTA(T1),OB.MTK ;GET TRACKS
$TEXT (DEPBYT,<Tracks:^T/@TRKTAB(S1)/ ^A>)
;VOLUME-SET NAME
SHPMVS: SKIPN OBJPRM+.OOVSN(T1) ;HAVE A VSN?
PJRST CRLF ;DONE
MOVEI S1,^D11 ;INITIAL FIELD WIDTH
MOVEI S2,OBJPRM+.OOVSN(T1) ;POINT TO VSN
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
ILDB TF,S2 ;GET A CHARACTER
SKIPE TF ;END?
AOJA S1,.-2 ;COUNT CHARACTER AND LOOP
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,<Volume-set:^T/OBJPRM+.OOVSN(T1)/^A>)
PJRST CRLF ;END LINE
YNTAB: [ASCIZ /Default/]
[ASCIZ /No/]
[ASCIZ /Yes/]
TRKTAB: [ASCIZ /Default/]
[ASCIZ /7/]
[ASCIZ /9/]
PARTAB: [ASCIZ /Default/]
[ASCIZ /Odd/]
[ASCIZ /Even/]
SUBTTL DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.
DEPOUT::
SKIPN KLUDGE ;[1206]CHECK FOR KLUDGE
SKIPA S1,[-1] ;MAKE IT WILD
MOVE S1,LSTPND ;GET /PROC
CAME S1,[-1] ;WAS IT SPECIFIED?
$RETF ;NO PROCESSING NODE FOR OUTPUT QUEUES
SKIPE JOBACT ;ACTIVE?
SKIPA S1,OBJNOD(P3) ;YES - GET NODE FROM OBJECT BLOCK
MOVE S1,.QEROB+.ROBND(AP) ;GET /DESTINATION NODE NAME OR NUMBER
MOVE S2,LSTDND ;GET REQUESTED DESTINATION NODE
PUSHJ P,LSTNOD ;COMPARE THEM
JUMPF .POPJ ;RETURN FALSE IF NO MATCH
AOSG JOBNBR ;IS THERE A HEADER ???
PUSHJ P,OUTHDR ;NO,,PUT ONE OUT.
GETLIM S1,.QELIM(AP),OLIM ;GET THE OUTPUT PAGE LIMIT.
ADDM S1,LSTSMT ;ACCUMULATE TOTAL
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
STORE S1,LIMIT ;SAVE IT FOR OUTPUT.
PUSH P,BYTCNT ;SAVE THE CURRENT BYTE COUNT
$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^D7R /LIMIT/ ^I/USR/^A>)
POP P,S1 ;RESTORE OLD BYTE COUNT TO S1.
MOVX S2,%OTLEN ;GET THE OUTPUT LINE LENGTH
PUSHJ P,DMPSTS ;INSERT THE JOB STATUS INFO.
$RETT ;RETURN.
OUTHDR: MOVEI S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
SKIPN BYTPTR ;DO WE HAVE A PAGE ALREADY SETUP
PUSHJ P,SETPAG ;NO,,GO DO IT
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
PUSHJ P,CRLF ;OUTPUT A CRLF.
$TEXT (DEPBYT,<^1/OBTYPE/ Queue:>) ;PUT OUT THE HEADING
SKIPN LISTYP ;IS THIS A 'FAST' LISTING ??
$RETT ;YES,,RETURN NOW.
$ASCII (<Job Name Req# Limit User>)
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<-------- ------ ------- ------------------------>)
PUSHJ P,CRLF ;OUTPUT A CRLF.
$RETT ;RETURN.
SUBTTL DEPBAT - ROUTINE TO PROCESS BATCH QUEUE ENTRYS.
DEPBAT::GETLIM S1,.QELIM(AP),ONOD ;GET /DESTINATION NODE NAME OR NUMBER
MOVE S2,LSTDND ;GET REQUESTED DESTINATION NODE
PUSHJ P,LSTNOD ;COMPARE THEM
SKIPE KLUDGE ;[1206]CHECK FOR KLUDGE
JUMPF .POPJ ;RETURN IF FALSE OR NO MATCH
SKIPE JOBACT ;ACTIVE?
SKIPA S1,OBJNOD(P3) ;YES - GET NODE FROM OBJECT BLOCK
MOVE S1,.QEROB+.ROBND(AP) ;GET /PROCESSING NODE NAME OR NUMBER
MOVE S2,LSTPND ;GET REQUESTED PROCESSING NODE
PUSHJ P,LSTNOD ;COMPARE THEM
JUMPF .POPJ ;RETURN FALSE IF NO MATCH
AOSG JOBNBR ;IS THE HEADER THERE ???
PUSHJ P,BATHDR ;NO,,PUT ONE OUT.
GETLIM S1,.QELIM(AP),TIME ;GET THE TIME LIMIT IN SECONDS.
ADDM S1,LSTSMT ;ACCUMULATE TOTAL
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
IDIVI S1,^D60 ;GET # OF SECONDS.
MOVEM S2,TIME.+2 ; AND SAVE IT.
IDIVI S1,^D60 ;GET HOURS,MINUTES.
MOVEM S1,TIME. ;SAVE HOURS.
MOVEM S2,TIME.+1 ;SAVE MINUTES.
PUSH P,BYTCNT ;SAVE THE CURRENT BYTE COUNT
IFE INPCOR,<$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^I/TIM/ ^I/USR/^A>)>
IFN INPCOR,<
PUSH P,T1 ;SAVE T1
GETLIM T1,.QELIM(AP),CORE ;GET CORE LIMIT
$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^I/TIM/ ^D5R /T1/ ^I/USR/^A>)
POP P,T1 ;RESTORE T1
>
POP P,S1 ;RESTORE OLD BYTE COUNT TO S1
MOVX S2,%INLEN ;GET THE BATCH LINE LENGTH
PUSHJ P,DMPSTS ;INSERT THE JOB STATUS INFO.
$RETT ;RETURN.
BATHDR: MOVEI S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
SKIPN BYTPTR ;DO WE HAVE A PAGE ALREADY SETUP
PUSHJ P,SETPAG ;NO,,GO DO IT
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
PUSHJ P,CRLF ;PUT OUT A CRLF.
$ASCII (<Batch Queue:>) ;PUT OUT A HEADER LINE.
PUSHJ P,CRLF ;PUT OUT A CRLF.
SKIPN LISTYP ;IS THIS A 'FAST' LISTING ??
$RETT ;YES,,RETURN NOW.
IFE INPCOR,<$ASCII (<Job Name Req# Run Time User>)>
IFN INPCOR,<$ASCII (<Job Name Req# Run Time Core User>)>
PUSHJ P,CRLF ;PUT OUT A CRLF.
IFE INPCOR,<$ASCII (<-------- ------ -------- ------------------------>)>
IFN INPCOR,<$ASCII (<-------- ------ -------- ----- ------------------------>)>
PUSHJ P,CRLF ;PUT OUT A CRLF.
$RETT ;AND RETURN.
SUBTTL DEPRET - ROUTINE TO PROCESS RETRIEVAL QUEUE ENTRYS.
TOPS10 <
DEPRET::$RETT ;JUSR RETURN ON THE 10
>
TOPS20 <
DEPRET::AOSG JOBNBR ;IS THE HEADER OUT YET???
PUSHJ P,RETHDR ;NO, PUT ONE OUT
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
GETLIM S1,.QELIM(AP),TID1 ;Get tape 1 ID
GETLIM S2,.QELIM(AP),TID2 ;Get tape 2 ID
MOVE T2,S1 ;Copy tape ID 1
IOR T2,S2 ; Assume both or neither is SIXBIT
TLNE T2,777777 ; Sixbit?
$TEXT (DEPBYT,<^I/JS/^W6R /S1/ ^W6R /S2/ ^I/USR/>)
TLNN T2,777777
$TEXT (DEPBYT,<^I/JS/^D6R /S1/ ^D6R /S2/ ^I/USR/>)
SKIPG LISTYP ;IS THIS A /ALL LIST ???
$RETT ;NO,,JUST RETURN
$ASCII (< File: >) ;INSERT A HEADING
MOVEI S1,.QECON(AP) ;GET THE FILE NAME ADDRESS
PUSHJ P,ASCOUT ;PUT IT OUT
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
RETHDR: MOVEI S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
SKIPN BYTPTR ;DO WE HAVE A PAGE ALREADY SETUP
PUSHJ P,SETPAG ;NO,,GO DO IT
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
PUSHJ P,CRLF
$ASCII (<Retrieval Queue:>)
PUSHJ P,CRLF
SKIPN LISTYP ;IS THIS A 'FAST' LISTING ???
$RETT ;YES,,RETURN NOW
$ASCII (< Name Req# Tape 1 Tape 2 User>)
PUSHJ P,CRLF
$ASCII (<------ ------ ------ ------ --------------------->)
PUSHJ P,CRLF
$RETT
>;END TOPS20
SUBTTL DEPEVT - ROUTINE TO PROCESS EVENT QUEUE ENTRYS.
DEPEVT::MOVE S1,LSTDND ;GET NODE
PUSHJ P,N$LOCL$$ ;MUST BE LOCAL
CAME S1,[-1] ; OR ALL NODES
JUMPF .RETT ; ELSE DON'T LIST
GETLIM S1,.QELIM(AP),INVS ;GET INVISIBLE BIT
SKIPN DEBUGW ;ARE WE DEBUGGING?
JUMPN S1,.RETT ;NO--AN INVISIBLE ENTRY?
AOSG JOBNBR ;IS THE HEADER OUT YET?
PUSHJ P,EVTHDR ;NO, PUT ONE OUT
GETLIM S1,.QELIM(AP),ACTV ;GET ACTIVE BIT
CAIN S1,1 ;ACTIVE?
AOSA ACTIVE ;COUNT UP ACTIVE EVENTS
TDZA S1,S1 ;DON'T FLAG
MOVSI S1,'* ' ;MAKE DISPLAY PRETTY
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
$TEXT (DEPBYT,<^W2L /S1/^I/JS/^H/.QECRE(AP)/^A>)
GETLIM S2,.QELIM(AP),TYPE ;GET EVENT TYPE
GETLIM S1,.QELIM(AP),TEXT ;GET ADDRESS OF TEXT BLOCK
SKIPN S1 ;ANY ASSOCIATED TEXT?
SKIPE S1,EVTDSC##(S2) ;NO, GET DEFAULT DISPLAY TEXT, IF ANY
$TEXT (DEPBYT,< ^T33L/(S1)/^A>) ;DISPLAY IT
PUSHJ P,CRLF ;END LINE
SKIPG LISTYP ;CHECK FOR /LIST:ALL
$RETT ;RETURN IF NOT
GETLIM S1,.QELIM(AP),REPT ;GET REPEAT BITS
TXNN S1,QB.DLY!QB.WKY ;DAILY OR WEEKLY OCCURANCE?
JRST EVTD.1 ;NO
PUSH P,S1 ;SAVE BITS
$ASCII (< Request will be requeued >)
POP P,TF ;GET BITS BACK
TXNE TF,QB.DLY ;DAILY?
MOVEI S1,EVTDLY ;YES
TXNE TF,QB.WKY ;WEEKLY?
MOVEI S1,EVTWKY ;YES
LOAD S2,TF,QB.DAY ;GET DAY OF WEEK
MOVE S2,EVTDAY(S2) ;POINT TO TEXT
$TEXT (DEPBYT,<^I/(S1)/ at ^C/.QECRE(AP)/^A>)
PUSHJ P,CRLF ;END LINE
EVTD.1: GETLIM S1,.QELIM(AP),FILE ;GET THE FD ADDRESS
JUMPE S1,.RETT ;RETURN IF NO ASSOCIATED FILE
PUSHJ P,A$WHEEL## ;GOT PRIVS?
GETLIM S1,.QELIM(AP),FILE ;GET FD AGAIN
SKIPF ;CAN'T SEE FILESPEC IF NO PRIVS
$TEXT (DEPBYT,< /File:^F/(S1)/>) ;YES--TYPE IT
$RETT ;AND RETURN
EVTHDR: MOVEI S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
SKIPN BYTPTR ;DO WE HAVE A PAGE ALREADY SETUP
PUSHJ P,SETPAG ;NO,,GO DO IT
SKIPE LSTSUM ;SUMMARY?
$RETT ;YES--DONE HERE
PUSHJ P,CRLF ;START WITH A NEW LINE
$ASCII (<Event Queue:>) ;DISPLAY QUEUE NAME
PUSHJ P,CRLF ;ANOTHER CRLF
SKIPN LISTYP ;IS THIS A 'FAST' LISTING ???
$RETT ;YES,,RETURN NOW
$ASCII (< Type Req# Expiration Description >)
PUSHJ P,CRLF
$ASCII (<-------- ------ ------------------ --------------------------------->)
PUSHJ P,CRLF
$RETT
EVTDLY: ITEXT (<daily>)
EVTWKY: ITEXT (<every ^T/(S2)/>)
EVTDAY: [ASCIZ |Wednesday|]
[ASCIZ |Thursday|]
[ASCIZ |Friday|]
[ASCIZ |Saturday|]
[ASCIZ |Sunday|]
[ASCIZ |Monday|]
[ASCIZ |Tuesday|]
SUBTTL D$SALC - SHOW ALLOCATION
TOPS20<
D$LALC::
PJRST E$ILM## ;ILLEGAL TO DO ON THE -20
>;END TOPS20
TOPS10<
D$SALC::SETZM G$ACK## ;DON'T ACK THE OPR
SKIPA S1,[-1] ;INDICATE OPERATOR REQUEST
D$LALC::SETZ S1, ;INDICATE USER LIST REQUEST
MOVEM S1,ENTYPE ;SAVE THE ENTRY FLAG
MOVE S1,.MSCOD(M) ;GET THE ACK CODE, IF ANY
MOVEM S1,ACKCOD ;SAVE IN GLOBAL
SETZM NOROOM ;CLEAR THE PAGE OVERFLOW FLAG
SETOM JOBNBR ;INDICATE NONE LISTED SO FAR
PUSHJ P,A$GBLK## ;GET THE NEXT BLOCK IN THE MESSAGE
JUMPF E$ILM## ;NO MORE, QUIT
MOVE S1,[XWD -LDSPLN,LALDSP] ;AIM AT THE TABLE
LALC.1: HRRZ S2,0(S1) ;GET THE NEXT KNOWN BLOCK TYPE
CAME S2,T1 ;MATCH?
AOBJN S1,LALC.1 ;NO, TRY AGAIN
JUMPGE S1,E$ILM## ;NO MATCH,, BAD MESSAGE
HLRZ S1,0(S1) ;GET THE SERVICE ADRS
PUSHJ P,0(S1) ;DO IT
AOSE JOBNBR ;ANY LISTED AT ALL?
PJRST SENDIT ;YES, FINISH UP
LALC.2: SKIPE ENTYPE ;NO, WAS THIS A USER REQUEST?
JRST LALC.3 ;NO, MUST BE OPERATOR
PUSHJ P,ALCHDR ;SETUP THE PAGE HEADER
$ASCII (<[No outstanding allocation]>)
PUSHJ P,CRLF ;FINISH THE LINE
PJRST SENDIT ;FIRE IT OFF
LALC.3: $ACK (<No outstanding allocations>,,,ACKCOD) ;TELL THE SAD NEWS
$RETT ;AND QUIT
LALDSP: XWD LALJNU,.ORJNU ;LIST A CERTAIN JOB
XWD LALREQ,.ORREQ ;LIST A BATCH REQUEST
LDSPLN==.-LALDSP ;TABLE LENGTH
;CONTINUED ON NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to list a certain job's request
LALJNU: SETZ S2, ;SAY WE WANT ALL JOBS
MOVE S1,0(T3) ;GET THE DATA
AOJE S1,LALALL ;IF -1, LIST EVERYTHING
CAXLE S1,MAXRES+1 ;IS THE JOB NUMBER VALID ???
$RETF ;NO,,RETURN NOW
SOJA S1,L1ALOC ;JUST LIST THAT ONE
;Here to list a batch request's allocation
LALREQ: MOVX S2,BA%JOB ;SAY WE CAME FROM BATCH
MOVE S1,0(T3) ;GET THE REQUEST NUMBER
AOJE S1,LALALL ;IF -1, LIST EVERYTHING
SOS S1 ;NOT -1, GET NUMBER AGAIN
TXO S1,BA%JOB ;LIGHT THE BATCH REQUEST BIT
PJRST L1ALOC ;PUT INFO ABOUT THIS ONE OUT
;Here to list all the requests
LALALL: $SAVE <P1,P2> ;THE LIST POINTER
MOVE P2,S2 ;SAVE THE ENTRY FLAG
MOVE S1,BMATRX## ;GET THE LIST HANDLE
$CALL L%FIRST ;START AT THE TOP
LALA.1: JUMPF .RETT ;QUIT IF LIST EMPTY
SKIPE P2 ;WANT TO LIST ALL BATCH?
TDNE P2,.SMJOB(S2) ;YES, IS THIS BATCH?
SKIPA ;WANT ALL, OR THIS IS BATCH
JRST LALA.2 ;BATCH, BUT THIS IS NOT BATCH ENTRY
MOVE P1,S2 ;SAVE THE ADRS OF THIS BLOCK
MOVE S1,.SMJOB(S2) ;GET THE JOB NUMBER
PUSHJ P,L1ALOC ;DISPLAY THIS ONE
MOVE S1,BMATRX## ;GET THE LIST HANDLE
MOVE S2,P1 ;GET THE OLD ADRS
$CALL L%APOS ;GET BACK TO THAT ONE
JUMPF .RETT ;CAN'T, QUIT
LALA.2: $CALL L%NEXT ;TO THE NEXT ONE, PLEASE
JRST LALA.1 ;DO 'EM ALL
;CONTINUED ON NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;A routine to dump one job's allocation into the message
L1ALOC: $SAVE <P1,P2,P3,P4>
MOVE P1,S1 ;SAVE THE JOB NUMBER
PUSHJ P,D$FMDR## ;FIND THIS GUY'S MDR
JUMPF .RETT ;NO MDR, DON'T LIST ANYTHING
MOVEI P2,[ASCIZ/job/] ;ASSUME LISTING OF JOB
TXNE P1,BA%JOB ;IS THIS A BATCH REQUEST?
MOVEI P2,[ASCIZ/batch request/] ;YES, SAY SO
PUSHJ P,D$BMTX## ;FIND THIS JOB'S B MATRIX
JUMPF L1AL.5 ;CAN'T, SO GIVE UP
PUSHJ P,D$CMTX## ;FIND THIS JOB'S C MATRIX
SKIPT ;IS THERE ONE?
SETZ CM, ;NO, CLEAR THE POINTER
AOSN JOBNBR ;FIRST TIME THRU?
PUSHJ P,ALCHDR ;YES, START THE PAGE
PUSHJ P,CRLF ;NEW LINE
$ASCII <Allocation for >
PUSHJ P,LALCDM ;ADD THE DEMOGRAPHIC INFO
PUSHJ P,CRLF ;FINISH THE LINE
LOAD P3,.SMFLG(BM),SM.CNT ;FIND OUT HOW MANY ENTRIES ARE HERE
MOVNS P3 ;NEGATE IT
MOVSS P3 ;TO LH
HRRI P3,.SMRES+1(BM) ;AIM AT THE LIST OF RESOURCE NUMBERS
MOVEI P4,1 ;START WITH RESOURCE 1
$ASCII (< Volume set Resource Type All Own>)
PUSHJ P,CRLF ;FINISH THIS LINE
$ASCII (<-------------------- ---------------- ------------ --- --->)
PUSHJ P,CRLF ;FINISH THIS LINE
L1AL.3: SKIPN 0(P3) ;ANY OF THIS TYPE ALLOCATED?
JRST L1AL.4 ;NO, TRY THE NEXT
SKIPE NOROOM ;ANY ROOM LEFT ON PAGE?
PUSHJ P,PAGOVF ;NO, GET A NEW ONE
MOVE S1,P4 ;GET THE RESOURCE NUMBER
PUSHJ P,GETVSN ;TRY TO FIND IT
MOVE T3,S1 ;GET STRING ADDRESS (WHAT EVER IT IS)
MOVE S1,P4 ;GET THE RESOURCE NUMBER
PUSHJ P,FNDCME ;GET THE NUMBER OWNED
MOVE S2,P4 ;GET THE INDEX
IMULI S2,AMALEN ;MAKE INDEX INTO A MATRIX
ADD S2,AMATRX ;AND AIM AT THIS ENTRY
MOVEI T1,[ITEXT (<^D3C/0(P3)/ ^D3C/S1/>)]
MOVE T2,(P3) ;GET ALLOCATION COUNT
CAXN T2,MAXRES ;EQUAL TO MAXIMUM NUMBER OF JOBS ?
MOVEI T1,[ITEXT (< 1 1 Single access>)] ;YES,,ITS SINGLE ACCESS
LOAD T2,.AMSTA(S2),AM.DVT ;GET RESOURCE TYPE
$TEXT (DEPBYT,<^T20L/(T3)/ ^T16L/@.AMNAM(S2)/ ^T12L/@RESTAB(T2)/ ^I/(T1)/>)
L1AL.4: AOS P4 ;BUMP THE RESOURCE INDEX
AOBJN P3,L1AL.3 ;CHECK EACH RESOURCE
$RETT ;BYE
L1AL.5: AOSN JOBNBR ;ANYTHING LISTED YET?
PUSHJ P,ALCHDR ;NO, ADD A HEADER
SKIPE NOROOM ;ANY SPACE LEFT?
PUSHJ P,PAGOVF ;NO, MAKE SOME
PUSHJ P,CRLF ;NEW LINE
$ASCII <No outstanding allocations for >
PUSHJ P,LALCDM ;ADD THE DEMOGRAPHIC INFO
$RETT
; Table of resource types in the 'A' matrix
;
RESTAB: [ASCIZ |Unknown|]
[ASCIZ |Magtape unit|]
[ASCIZ |Disk unit|]
[ASCIZ |DECtape unit|]
[ASCIZ |Dismount|]
[ASCIZ |Structure|]
[ASCIZ |Magtape vol.|]
[ASCIZ |DECtape vol.|]
SUBTTL Find a VSN given a resource number
; Routine to find a VSN string
; Call: MOVE AP,MDR address
; MOVE S1,resrource number
; PUSHJ P,GETVSN
;
; On return, S1:= VSN string address if there is one, otherwise S1:= "---"
;
GETVSN::$SAVE <P1,P2,P3,P4> ;SAVE SOME ACS
LOAD P1,.MRCNT(AP),MR.CNT ;GET NUMBER OF VOLUMES
MOVNS P1 ;GET -COUNT
HRLI P1,.MRVSL(AP) ;GET ADDRESS OF FIRST VSL
MOVSS P1 ;MAKE AN AOBJN POINTER
GETV.1: MOVE P2,(P1) ;GET ADDRESS OF VOLUME SET LIST
LOAD P3,.VSCVL(P2),VS.CNT ;GET NUMBER OF VOLUMES
MOVNS P3 ;GET -COUNT
HRLI P3,.VSVOL(P2) ;GET ADDRESS OF FIRST VOLUME
MOVSS P3 ;MAKE AN AOBJN POINTER
GETV.2: MOVE P4,(P3) ;GET A VOLUME ADDRESS
LOAD S2,.VLFLG(P4),VL.RSN ;GET VOLUME RESOURCE NUMBER
CAMN S1,S2 ;IS IT THE ONE WE'RE LOOKING FOR?
JRST GETV.3 ;GOT IT
AOBJN P3,GETV.2 ;TRY ANOTHER VOLUME
AOBJN P1,GETV.1 ;TRY ANOTHER VOLUME SET
MOVEI S1,[ASCIZ |---|] ;LOAD ADDRESS OF "---" STRING
POPJ P, ;RETURN
GETV.3: MOVE S1,(P1) ;GET ADDRESS OF CURRENT VSL
MOVEI S1,.VSVSN(S1) ;GET VSN ADDRESS
POPJ P, ;RETURN
;CONTINUED FROM THE PREVIOUS PAGE
;A routine do dump the demographic info about a user
;Call -
; P1/ job number or batch stream number
; P2/ adrs of batch or job ASCIZ descriptor
; AP/ adrs of MDR
LALCDM: MOVE S1,P1 ;GET THE JOB NUMBER
TXZ S1,BA%JOB ;CLEAR THE BATCH FLAG BIT
$TEXT (DEPBYT,<^T/0(P2)/ ^D/S1/ ^W6/.MRNAM(AP)/^W/.MRNAM+1(AP)/ ^U/.MRUSR(AP)/>^A)
$RETT
;Routine to dump a header into the message
ALCHDR: MOVEI S1,[ASCIZ/ Mountable Device Allocations /]
PJRST SETPAG ;SETUP WITH THIS HEADER
;This routine finds the contents of C MATRIX [.S1, .CM]
;If either the column or the row is not there, 0 is returned in S1
;Call -
; S1/ Resource number
; CM/ 0 if no column known, or adrs of CM header
FNDCME: JUMPE CM,FNDC.1 ;IF NO CMATRIX, RETURN 0
LOAD S2,.SMFLG(CM),SM.CNT ;GET THE MAXIMUM REPRESENTED
CAMLE S1,S2 ;ARE WE IN RANGE?
JRST FNDC.1 ;NO, QUIT
ADDI S1,(CM) ;AIM AT THE START OF THE ENTRY
SKIPA S1,.SMRES(S1) ;GET THE NUMBER THERE
FNDC.1: SETZ S1, ;OFF THE END, SET 0
$RETT
>;END TOPS10
SUBTTL SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE.
;CALL: S1/ The Address of an Asciz Type Line String
;
;RET: True Always
SETPAG: MOVE T3,S1 ;SAVE THE HEADER ADDRESS.
PUSHJ P,M%GPAG ;GET A PAGE FOR OUTPUT.
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT IN THE SAB
MOVX S2,PAGSIZ ;GET A PAGE LENGTH
MOVEM S2,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
MOVE S2,[.OHDRS,,.OMACS] ;GET MSG TYPE PARMS.
MOVEM S2,.MSTYP(S1) ;SAVE IT IN THE MSG.
MOVE S2,ACKCOD ;GET THE OPR ACK CODE.
MOVEM S2,.MSCOD(S1) ;SAVE IT IN THE MSG.
MOVX S2,WT.SJI+WT.NFO ;GET JOB INFO SUPPRESS BITS.
MOVEM S2,.OFLAG(S1) ;SAVE IT IN THE MSG.
AOS .OARGC(S1) ;ADD 1 TO THE ARGUMENT COUNT.
MOVEI S1,.OHDRS(S1) ;POINT TO THE FIRST MESSAGE BLK.
SKIPE T3 ;SKIP IF NO HEADER WANTED.
PUSHJ P,SETHDR ;ELSE GO PUT IT IN.
MOVEI T4,.CMTXT ;GET THE TEXT BLOCK TYPE.
MOVEM T4,ARG.HD(S1) ;SAVE IT IN THE MESSAGE.
MOVEI T4,ARG.DA(S1) ;POINT TO DATA AREA.
MOVEM T4,DATADR ;SAVE THE START DATA ADDRESS.
MOVE S1,G$SAB##+SAB.MS ;GET THE MESSAGE START ADDRESS.
SUB S1,T4 ;CALC NEG. NUMBER OF WORDS USED.
ADDI S1,^D512-^D75 ;CALC NUMBER OF WORDS LEFT.
IMULI S1,5 ;CALC NUMBER OF BYTES LEFT.
MOVEM S1,BYTCNT ;AND SAVE IT.
SETZM NOROOM ;RESET NO MORE ROOM FLAG.
HRLI T4,(POINT 7,) ;GEN THE BYTE POINTER.
MOVEM T4,BYTPTR ;AND SAVE IT.
$RETT ;RETURN
SUBTTL SETHDR - ROUTINE TO INSERT THE MESSAGE HEADER.
;Here with
; S1/ Adrs of free slot in message
; T3/ Adrs of ASCIZ string
;Returns
; display block into message
; S1 points to new first free location in message
SETHDR: $SAVE <P1> ;PRESERVE A REG
MOVE S2,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS.
AOS .OARGC(S2) ;ALSO BUMP THE BLOCK COUNT BY 1.
MOVX P1,.ORDSP ;GET BLOCK TYPE
STORE P1,ARG.HD(S1),AR.TYP ;SAVE IT IN THE MSG.
MOVE P1,G$NOW## ;GET THE TIME
MOVEM P1,ARG.DA(S1) ;SAVE TIME STAMP
MOVEI P1,ARG.DA+1(S1) ;POINT TO BLOCK DATA AREA.
HRLI P1,(POINT 7,) ;MAKE A BYTE POINTER OF IT
MOVEM P1,BYTPTR ;SAVE FOR TEXT OUTPUT ROUTINE
$TEXT (DEPBYT,<^T/0(T3)/^A>) ;DUMP THE HEAD INTO THE MESSAGE
HRRZ P1,BYTPTR ;GET LAST ADRS USED
SUBI P1,-1(S1) ;FIGURE LENGTH OF THIS BLOCK
STORE P1,ARG.HD(S1),AR.LEN ;MARK LENGTH OF THIS BLOCK
ADDI S1,0(P1) ;POINT TO NEXT SLOT AFTER THIS BLOCK
MOVSS P1 ;LENGTH TO LEFT HALF
ADDM P1,.MSTYP(S2) ;UPDATE MESSAGE LENGTH, TOO
$RETT
SUBTTL SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.
SNDMSG: MOVX S1,WT.MOR ;GET THE MORE PAGES COMMING BIT.
MOVE S2,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS.
IORM S1,.OFLAG(S2) ;LIGHT THE BIT.
SENDIT: SETZ S1, ;MAKE A NULL BYTE
IDPB S1,BYTPTR ;TERMINATE THE STRING
HRRZ S1,BYTPTR ;GET FINAL MESSAGE ADDRESS.
SUB S1,DATADR ;CALCULATE ITS LENGTH
ADDI S1,2 ;ADD THE HEADER LENGTH+1.
MOVSS S1 ;SHIFT RIGHT TO LEFT.
MOVE S2,DATADR ;GET THE BLOCK DATA START ADDRESS.
ADDM S1,-1(S2) ;BUMP TEXT BLOCK LENGTH.
ADDM S1,@G$SAB##+SAB.MS ;BUMP TOTAL MSG LENGTH.
MOVE S1,G$OPR## ;GET ORION'S PID
SKIPL ENTYPE ;UNLESS THIS IS A USER REQUEST..
MOVE S1,G$SND## ; THEN GET THE SENDERS PID.
MOVEM S1,G$SAB##+SAB.PD ;AND SAVE IT.
PUSHJ P,C$SEND## ;SEND IT OFF.
SETZM G$SAB##+SAB.MS ;ZERO THE SAB MSG ADDRESS.
$RETT ;RETURN.
SUBTTL DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO
DMPSTS: SKIPN LISTYP ;IF THIS IS A QUICK LIST,,SKIP THIS
JRST DMPS.8 ;EXIT
PUSHJ P,PADLIN ;PAD LINE LINE TO MAKE IT PRETTY
MOVE T3,BYTCNT ;GET THE CURRENT BYTE COUNT
SUBI T3,^D30 ;CALC ROOM TILL END OF LINE
LOAD S1,.QESEQ(AP),QE.HBO ;IS THE JOB IN OPERATOR HOLD ???
SKIPE S1 ;0=NO, 1=YES.
$ASCII (< Hold:Yes>) ;YES,,SAY SO
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
JRST DMPS.1 ;NO,,PROCESS AS OUTPUT QUEUE
MOVEI S1,^D13 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
MOVX S1,QE.STR ;BIT TO TEST
TDNN S1,.QENQC(AP) ;SPOOLING TO REMOTE?
TDZA S1,S1 ;NO
MOVE S1,[ASCIZ /NQC /] ;YES
SKIPE JOBACT ;IS THE JOB ACTIVE ???
$TEXT (DEPBYT,< In ^5/S1/stream:^D/OBJUNI(P3)/^A>) ;YES,,SAY SO
MOVEI S1,^D8 ;GET FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,.QEROB+.ROBAT(AP),RO.ATR ;GET STREAM ATTRIBUTES
CAIN S1,%SITGO ;SITGO REQUEST?
$TEXT (DEPBYT,< /SITGO^A>) ;YES,,SAY SO
MOVEI S1,^D8 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),DEPN ;GET THE DEPENDENCY COUNT
SKIPE S1 ;ANY THERE ???
$TEXT (DEPBYT,< /Dep:^D/S1/^A>) ;YES,,SAY SO
MOVEI S1,^D18 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),ONOD ;GET /DEST
PUSHJ P,N$NODE## ;FIX IT UP
PUSHJ P,N$LOCL## ;IS IT A LOCAL NODE?
SKIPT ;YES--SKIP IT
$TEXT (DEPBYT,< /Dest:^T/NETASC(S2)/^A>);NO--OUTPUT IT
JRST DMPS.3 ;CONTINUE ON
DMPS.1: MOVEI S1,^D12 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM.
LOAD S1,.QEROB+.ROBAT(AP),RO.ATR ;GET THE DEVICE ATTRIBUTES
SKIPN JOBACT ;JOB ACTIVE?
JRST DMP.1A ;NO
MOVX S2,QE.STR ;BIT TO TEST
TDNE S2,.QENQC(AP) ;SPOOLING TO REMOTE?
JRST DMP.1D ;YES
MOVE S2,OBJUNI(P3) ;GET UNIT NUMBER
$TEXT (DEPBYT,< On Unit:^D/S2/^A>) ;IS ACTIVE,,SAY SO
JRST DMPS.2 ;ONWARD
DMP.1A: SKIPN S2,.QEROB+.ROBUT(AP) ;GET UNIT TYPE IF SPECIFIED
JRST DMP.1B ;NOT KNOWN
$TEXT (DEPBYT,< /Unit:^W/S2/^A>) ;DISPLAY UNIT TYPE
JRST DMPS.2 ;ONWARD
DMP.1B: CAIE S1,%PHYCL ;WAS 'PHYSICAL' SPECIFIED?
JRST DMP.1C ;NO PARTICULAR UNIT
LOAD S2,.QEROB+.ROBAT(AP),RO.UNI ;YES,,GET THE UNIT NBR
$TEXT (DEPBYT,< /Unit:^D/S2/^A>) ;NOT ACTIVE,,SAY SO
JRST DMPS.2 ;AND CONTINUE ON
DMP.1C: CAIN S1,%LOWER ;WAS IT LOWER??
$ASCII (< /Lower>) ;YES,,SAY SO
CAIN S1,%UPPER ;WAS IT /UPPER??
$ASCII (< /Upper>) ;YES,,SAY SO
JRST DMPS.2 ;ONWARD
DMP.1D: $TEXT (DEPBYT,< In NQC stream:^D/OBJUNI(P3)/^A>)
DMPS.2: SKIPN .QEQNM(AP) ;QUEUE NAME SPECIFIED?
JRST DMPS2A ;NO
MOVSI S1,-QNMLEN ;COMPUTE FIELD LENGTH
SKIPE .QEQNM(AP) ;LOOK FOR A ZERO WORD
AOBJN S1,.-1 ;...
LSH S1,2 ;FOUR CHARACTERS/WORD
HRRZS S1 ;ISOLATE LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Queue:^Q/QUEQUE/^A>)
DMPS2A: MOVEI S1,^D15 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S2,.QELIM(AP),FORM ;GET THE FORMS TYPE
MOVE S1,S2 ;PUT IT HERE ALSO
MOVX TF,FRMNOR ;GET 'NORMAL' FORMS NAME
ANDX S2,FRMSK1 ;JUST GET THE IMPORTANT PART
ANDX TF,FRMSK1 ;HERE ALSO
CAME S2,TF ;EVERYTHING OK ???
$TEXT (DEPBYT,< /Forms:^W/S1/^A>) ;NO,,SAY SO
DMPS.3: MOVEI S1,^D16 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
SKIPE JOBACT ;[1156] JOB ACTIVE?
JRST DMPS3A ;[1156] YES,,GO CHECK ROUTING
MOVE S1,.QEROB+.ROBND(AP) ;[1156] NO,,GET NODE NAME
PUSHJ P,N$NODE ;[1156] CHECK IT OUT
JRST DMPS3B ;[1156] CONTINUE
DMPS3A: MOVEI S1,.QEROB(AP) ;[1156] GET THE REQ OBK BLK ADDRESS
SETZM S2 ;NO OBJECT MATCH
PUSHJ P,N$CSTN## ;PERFORM ANY ROUTING
DMPS3B: PUSHJ P,N$LOCL## ;[1156] IS IT A LOCAL NODE ???
JUMPT DMPS.4 ;YES,,SKIP THIS.
MOVE S1,.QEROB+.ROBTY(AP) ;GET THE OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
MOVEI S1,[ASCIZ'/Dest:'] ;NO,,MAKE IT /DEST:
CAIN S1,.OTBAT ;TRY ONCE MORE...
MOVEI S1,[ASCIZ'/Proc:'] ;IT IS BATCH,,MAKE IT /PROC-NODE:
$TEXT (DEPBYT,< ^T/0(S1)/^T/NETASC(S2)/^A>) ;NO,,SAY SO
DMPS.4: MOVEI S1,^D12 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
MOVE S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;BATCH?
JRST DMP.42 ;NO
TOPS10 <
SKIPE G$MDA## ;MDA TURNED ON?
JRST DMP.40 ;YES - DO IT THE RIGHT WAY
> ;END TOPS10 CONDITIONAL
DMP.42: PUSHJ P,Q$CDEP## ;FIND THE MISSING STRUCTURE
SKIPT ;NONE THERE,,SKIP THIS
$TEXT (DEPBYT,< Str:^I/STRUCT/^A>) ;PUT IT OUT
JRST DMP.41 ;SKIP MDA STUFF
DMP.40: MOVE S1,.QESEQ(AP) ;GET STATUS BITS
TXNE S1,QE.HBO ;HELD BY OPERATOR?
JRST DMP.41 ;YES
TXNE S1,QE.WAM ;IS IT WAITING FOR A MOUNT ???
$ASCII (< Mount wait>) ;YES,,SAY SO
DMP.41: MOVE S1,G$NOW## ;GET CURRENT TIME
CAML S1,.QECRE(AP) ;IS THERE A /AFTER PARM ???
JRST DMP.4A ;NO,,SKIP THIS
MOVEI S1,^D24 ;GET LENGTH FOR NEXT FIELD
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /After:^H15/.QECRE(AP)/^A>) ;YES,,SAY SO
DMP.4A: SKIPG LISTYP ;IS THIS AN EVERYTHING LIST ??
JRST DMPS.7 ;NO,,SKIP THIS
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;IF BATCH,,CONTINUE ON
JRST DMPS.5 ;ELSE PROCESS OUTPUT QUEUE
MOVEI S1,^D11 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),UNIQ ;GET THE UNIQUE SWITCH
CAIN S1,%EQUYE ;IS IT /UNIQUE:YES ???
$ASCII (< /Uniq:Yes>) ;YES,,SAY SO
CAIN S1,%EQUNO ;OR IS IT /UNIQUE:NO ???
$ASCII (< /Uniq:No>) ;YES,,SAY SO
MOVEI S1,^D14 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),REST ;GET THE /RESTART SWITCH
CAIN S1,%EQRNO ;IS IT /RESTART:NO ???
$ASCII (< /Restart:No>) ;YES,,SAY SO
CAIN S1,%EQRYE ;IS IR /RESTART:YES ???
$ASCII (< /Restart:Yes>) ;YES,,SAY SO
MOVEI S1,^D13 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),OINT ;GET /ASSISTANCE: VALUE
CAIN S1,.OPINY ;IS IT /ASSIST:YES ???
$ASCII (< /Assist:Yes>) ;YES,,SAY SO
CAIN S1,.OPINN ;IS IT /ASSIST:NO ???
$ASCII (< /Assist:No>) ;YES,,SAY SO
MOVEI S1,^D15 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;SEE IF ROOM
GETLIM S1,.QELIM(AP),OUTP ;GET /OUTPUT
CAIN S1,%EQONL ;NOLOG?
$ASCII (< /Output:Nolog>) ;YES
CAIN S1,%EQOLG ;LOG?
$ASCII (< /Output:Log>) ;YES
CAIN S1,%EQOLE ;ERROR?
$ASCII (< /Output:Error>) ;YES
MOVEI S1,^D16 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;SEE IF ROOM
GETLIM S1,.QELIM(AP),BLOG ;GET /BATLOG
CAIN S1,%BAPND ;APPEND?
$ASCII (< /Batlog:Append>) ;YES
CAIN S1,%BSCDE ;SUPERSEDE?
$ASCII (< /Batlog:Super>) ;YES
CAIN S1,%BSPOL ;SPOOL?
$ASCII (< /Batlog:Spool>) ;YES
JRST DMPS.6 ;CONTINUE ON
DMPS.5: MOVEI S1,^D20 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ENOUGH ROOM
GETLIM S1,.QELIM(AP),NOT1 ;GET THE FIRST NOTE WORD
GETLIM S2,.QELIM(AP),NOT2 ;GET THE SECOND NOTE WORD
SKIPE S1 ;ANY NOTE THERE ???
$TEXT (DEPBYT,< /Note:^W6L /S1/^W/S2/^A>) ;YES,,SAY SO
DMPS.6: MOVEI S1,^D10 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,.QESEQ(AP),QE.PRI ;GET THE JOB PRIORTY
CAXE S1,SPLPRI ;IS IT THE DEFAULT ???
$TEXT (DEPBYT,< /Prio:^D/S1/^A>) ;NO,,SAY SO
MOVEI S1,^D11 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Seq:^D/.QESEQ(AP),QE.SEQ/^A>) ;OUTPUT SEQ #
DMPS.7: SKIPN CRLFLG ;[1200]START OF THE LINE ??
JRST DMPS.8 ;[1200]NO, OUTPUT A CRLF
MOVX S1,.CHNUL ;[1200]YES, GET A NULL CHARACTER
DPB S1,BYTPTR ;[1200]CLEAR TAB IN BUFFER
DMOVE S1,LASTPT ;[1200]GET THE LAST BYTPTR AND BYTCNT
DMOVEM S1,BYTPTR ;[1200]RESET THE BYTPTR AND BYTCNT
$RETT ;[1200]AND RETURN
DMPS.8: PUSHJ P,CRLF ;PUT OUT A CRLF
$RETT ;AND RETURN
SUBTTL PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE
;CALL: S1/ The Byte count before the current line was generated
; S2/ The maximum line length
; BYTCNT/ The byte count after the current line was generated
;
;RET: True Always
PADLIN: MOVE T3,S1 ;GET THE OLD BYTE COUNT
SUB T3,S2 ;CALC BYTE COUNT-LINE LENGTH
SUB T3,BYTCNT ;GET DIFFERENCE BETWEEN OLD AND NEW
SKIPL T3 ;IF LESS,,THEN CONTINUE ON
$RETT ;NO,,JUST RETURN
MOVMS T3,T3 ;MAKE IT POSITIVE
PADL.1: SOJL T3,.RETT ;INSERT ANY SLACK BYTES
$ASCII (< >) ;PUT ONE IN
JRST PADL.1 ;KEEP ON GOING TILL DONE
SUBTTL GETPARMS = ROUTINE TO PROCESS THE INPUT BLOCKS IN A SHOW QUEUES MSG.
GETPAR: SETZM QUEBITS ;ZERO THE QUEUES WE WANT.
SETZM BLKADR ;ZERO THE MESSAGE BLOCK ADDRESS.
SETZM LSTUSR ;INDICATE ALL USER IDS
SETOM LSTUSM ;DEFAULT MASK TO NO WILDS
SETZM LSTJOB ;INDICATE ALL JOB NAMES
SETOM LSTJBM ;DEFAULT MASK TO NO WILDS
SETOM LSTUNT ;INDICATE ALL UNITS
SETZM LSTUTY ;INDICATE ALL UNIT TYPES
SETOM LSTDND ;ALL DESTINATION NODES
SETOM LSTPND ;ALL PROCESSING NODES
MOVX S1,QNMLEN ;LENGTH
MOVEI S2,LSTQNM ;ADDRESS
PUSHJ P,.ZCHNK ;ZERO IT
SETZM OBJADR ;ZAP THE OBJECT BLOCK ADDRESS
SETOM NODE6B ;INDICATE ALL NODES
SETZM DEVICE ;NO SPECIFIC DEVICE
LOAD S1,.MSCOD(M) ;GET THE ACK CODE.
STORE S1,ACKCOD ;AND SAVE IT.
LOAD S1,.OFLAG(M) ;GET THE MESSAGE FLAG BITS.
MOVEM S1,LISFLG ;SAVE FLAG BITS
SETZM LSTSUM ;ASSUME NO SUMMARY WANTED
TXNE S1,LS.SUM ;CHECK THE BIT
SETOM LSTSUM ;AND SET FLAG IF DESIRED
SETOM S2 ;SET S2 UP AS 'NORMAL' LISTING
TXNE S1,LS.FST ;DOES HE WANT A QUICK LISTING ???
SETZM S2 ;MAKE IT A 'FAST' LISTING
TXNE S1,LS.ALL ;DOES HE WANT EVERYTHING ???
MOVEI S2,1 ;MAKE IT EVERYTHING BUT KITCHEN SINK !
MOVEM S2,LISTYP ;SAVE IT FOR LATER
GETP.1: PUSHJ P,A$GBLK## ;GO GET A MESSAGE BLOCK.
JUMPF GETP.2 ;NO MORE, RESOLVE /DEST /PROC /NODE
CAIN T1,.LSQNM ;IS THIS THE QUEUE NAME BLOCK?
JRST GETP.3 ;YES
LOAD S1,0(T3) ;GET THE FIRST ENTRY IN THE BLOCK
CAIN T1,.LSQUE ;IS THIS THE QUEUES BLOCK ???
MOVEM S1,QUEBITS ;SAVE THE QUEUE TYPE(S) WE WANT.
CAIN T1,.LSUSR ;OR IS IT THE USER BLOCK ???
MOVEM S1,LSTUSR ;SAVE THE USER DATA.
CAIN T1,.LSUSM ;USER MASK BLOCK?
MOVEM S1,LSTUSM ;YES--SAVE IT
CAIN T1,.LSJOB ;JOB NAME BLOCK?
MOVEM S1,LSTJOB ;YES--SAVE IT
CAIN T1,.LSJBM ;JOB NAME MASK BLOCK?
MOVEM S1,LSTJBM ;YES--SAVE IT
CAIN T1,.LSUNT ;UNIT SPECIFICATION BLOCK?
MOVEM S1,LSTUNT ;YES--SAVE IT
CAIN T1,.LSUTY ;UNIT TYPE?
MOVEM S1,LSTUTY ;YES--SAVE IT
CAIN T1,.LSDND ;DESTINATION NODE?
MOVEM S1,LSTDND ;YES--SAVE IT
CAIN T1,.LSPND ;PROCESSING NODE?
MOVEM S1,LSTPND ;YES--SAVE IT
CAIN T1,.OROBJ ;IS IT THE OBJECT BLOCK ???
MOVEM T3,OBJADR ;YES,,SAVE ITS ADDRESS
CAIN T1,.ORNOD ;IS THIS THE NODE BLOCK ???
MOVEM S1,NODE6B ;YES,,SAVE THE NODE WE WANT
CAIE T1,.TAPDV ;IS IT A TAPE VOLUME BLOCK ???
CAIN T1,.STRDV ;OR IS IT A STRUCTURE BLOCK?
SKIPA ;TREAT THEM THE SAME
JRST GETP.1 ;NO,,SKIP IT AND PROCESS NEXT BLOCK
HRROI S1,0(T3) ;YES,,POINT TO THE ASCIZ DEVICE NAME
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,DEVICE ;SAVE IT
TOPS10< DEVNAM S2, ;GET THE REAL DEVICE NAME
SKIPA ;SKIP IF IT DOES NOT EXIST
MOVEM S2,DEVICE ;SAVE IT
> ;END TOPS10 CONDITIONAL
JRST GETP.1 ;AND GO TRY AGAIN.
; Resolve /DEST, /PROC and /NODE conflicts.
; This assumes some toad doesn't mix /DEST/PROC with /NODE in
; a list request. This crock is a temporary (but not a complete)
; solution to the SHOW Q /NODE problem until OPR implements /DEST
; and /PROC switches. This won't be done in GALAXY %4.1/4.2
;
GETP.2: SETOM KLUDGE ;[1206]TURN OFF KLUDGE
MOVE T1,NODE6B ;GET /NODE
CAMN T1,[-1] ;WAS /NODE SPECIFIED?
$RETT ;NO - NOTHING TO DO
MOVE T2,LSTDND ;GET /DEST
CAMN T2,[-1] ;WILD?
MOVEM T1,LSTDND ;YES
MOVE T2,LSTPND ;GET /PROC
CAMN T2,[-1] ;WILD?
MOVEM T1,LSTPND ;YES
SETZM KLUDGE ;[1206]FLAG KLUDGE
$RETT ;AND RETURN
GETP.3: HRLI T3,LSTQNM ;BUILD REVERSED BLT WORD
MOVSS T3 ;CORRECT IT
BLT T3,LSTQNM-1(T2) ;COPY QUEUE NAME
MOVEI S1,LSTQNM ;POINT AT IT
PUSHJ P,A$FQNM## ;SEE IF WE CAN DECIPHER IT
JUMPF GETP.4 ;IF NOT, IGNORE /QUEUE
MOVE S2,QNM.RO+.ROBND(S1) ;GET NODE
MOVEM S2,LSTDND ;OVERWRITE
LOAD S2,QNM.RO+.ROBAT(S1),RO.UNI ;GET UNIT NUMBER
MOVEM S2,LSTUNT ;OVERWRITE
JRST GETP.1 ;GO PROCESS THE NEXT BLOCK
GETP.4: SETZM LSTQNM ;ZAP OUT ANY MEMORY OF QUEUE NAME
JRST GETP.1 ;GO PROCESS THE NEXT BLOCK
SUBTTL UTILITY ROUTINES
DEPBYT: IDPB S1,BYTPTR ;PUT THE BYTE INTO THE MESSAGE.
SOSG BYTCNT ;CHECK THE BYTES REMAINING.
SETOM NOROOM ;NO MORE ROOM,,TURN ON FLAG.
SETZM CRLFLG ;CLEAR THE CRLF FLAG
$RETT ;RETURN
PAGOVF: PUSHJ P,SNDMSG ;SEND THE MESSAGE OFF.
SETZ S1, ;INDICATE WE DONT HAVE ANY HEADER.
PUSHJ P,SETPAG ;GO SET UP A NEW OUTPUT PAGE.
$COUNT (NLAP) ;COUNT THE PAGES SENT
$RETT ;AND RETURN.
CRLF: MOVEI S1,[BYTE(7) 15,12,0,0,0] ;GET THE CRLF.
PUSHJ P,ASCOUT ;DUMP IT OUT
SETOM CRLFLG ;SAY LAST THING OUT WAS CRLF
$RETT ;AND RETURN
ASCOUI: PUSH P,S1 ;SAVE S1
HRRZ S1,@-1(P) ;GET THE ADRS OF THE MESSAGE
AOS -1(P) ;SKIP OVER THE ARG POINTER
PUSHJ P,ASCOUT ;DUMP IT OUT
POP P,S1 ;RESTORE S1
$RETT ;AND WIN
ASCOUT: PUSHJ P,.SAVE1 ;SAVE P1.
MOVE P1,S1 ;SAVE THE INPUT ADDRESS.
HRLI P1,(POINT 7,0) ;MAKE IT A BYTE POINTER.
ASCO.1: ILDB S1,P1 ;GET A BYTE.
JUMPE S1,.RETT ;DONE,,RETURN.
PUSHJ P,DEPBYT ;PUT IT OUT.
JRST ASCO.1 ;AND DO ANOTHER.
CHKSPC: ADD S1,T3 ;ADD FIELD LENGTH AND LAST BYTE ADDRESS
CAMG S1,BYTCNT ;IS THERE ROOM FOR THE FIELD ???
$RETT ;YES,,RETURN
PUSHJ P,CRLF ;INSERT A CRLF
DMOVE S1,BYTPTR ;GET THE BYTPTR AND BYTCNT
DMOVEM S1,LASTPT ;SAVE THEM IN CASE WE NEED THEM
$ASCII (< >) ;INSERT A TAB
SETOM CRLFLG ;INDICATE BEGINNING OF LINE
MOVE T3,BYTCNT ;GET THE BYTE COUNT
SUBI T3,^D64 ;GET NEW LINE END ADDRESS
$RETT ;AND RETURN
CHKLIN: MOVE S1,BYTCNT ;Get the current byte count for out page
SUBI S1,^D64 ;Subtract a "standard" line
SKIPG S1 ;More room left?
PUSHJ P,PAGOVF ;No, go set up next page
$RET ;Continue
; Compare two nodes
; Call: S1/ node name or number from QE
; S2/ requested node name or number (for listings only)
; PUSHJ P,CMPNOD to compare against NODE6B
; PUSHJ P,LSTNOD to compare against listing requests
;
; Ret: TRUE if a match, FALSE if no match
;
CMPNOD: MOVE S2,NODE6B ;GET THE NODE NAME/NUMBER WE WANT
LSTNOD: CAMN S2,[-1] ;IS IT ALL NODES ???
$RETT ;YES,,RETURN
PJRST N$MTCH## ;NO,,RETURN THROUGH NODE MATCH ROUTINE
SUBTTL Remote Queue Utility Routines
;Check if a remote queue listing is needed for this LIST/SHOW QUEUES
;request. If any remote queues have been defined AND a node was
;specified which has any remote queues, we will assume a remote
;listing is required.
CHKRMQ: MOVE S1,QUEBIT ;GET THE BITS
MOVE S2,LISFLG ;AND THE FLAGS
TXNE S1,LIQOUT ;ASKING FOR OUTPUT QUEUES?
TXNN S2,LS.RMT ;AND DO THEY WANT REMOTE QUEUE LISTING?
$RETF ;NO, NO NEED FOR REMOTE LISTING
SKIPN LSTQNM ;A QUEUE NAME SUPPLIED?
JRST CHKRQ1 ;NO, MAYBE OLD /DEST: SWITCH?
MOVEI S1,LSTQNM ;ADDRESS OF THE QUEUE NAME STRING
PUSHJ P,A$FQNM## ;IS THERE A MATCH?
$RETIF ;IF NO MATCH
MOVX S2,QN.LCL ;IS IT A LOCAL QUEUE?
TDNE S2,QNM.FL(S1) ;IF SO, WE DON'T NEED TO BOTHER NQC
$RETF ;LOCAL
$RETT ;REMOTE
CHKRQ1: MOVE S1,LSTDND ;GET /DEST (/NODE) VALUE
CAME S1,[-1] ;ALL NODES?
$RETT ;NO, THAT'S OK
$RETF ;NO NEED FOR REMOTE LISTING
;Ask the Network Queue Controller for a remote queue listing. Sends
;a copy of the original LIST/SHOW QUEUES request to the NQC, who in
;turn responds with text messages to the recipient (using QUASAR's
;PID so folks who check senders don't get confused).
ASKNQC: MOVX S1,.OTNQC ;GET THE OBJECT TYPE
MOVX S2,%NQOUT ;ANYTHING WILL DO
PUSHJ P,A$LPSB## ;LOCATE THE PSB
JUMPF ASKN.2 ;NQC MUST NOT BE RUNNING
MOVE S2,[G$SAB##,,SAVSAB] ;WE MUST SALT THE SAB AWAY FOR A BIT
BLT S2,SAVSAB+SAB.SZ-1 ; SINCE WE'RE GOING TO OVERWRITE IT
MOVE S1,PSBPID(S1) ;GET THE PID OF THE NET QUEUE CTLR
MOVEM S1,G$SAB##+SAB.PD ;SAVE RECEIVER'S PID
PUSHJ P,.SAVET ;FREE UP SOME AC'S
PUSHJ P,M%GPAG ;GET A PAGE TO SEND A MESSAGE
MOVEM S1,G$SAB##+SAB.MS ;STORE THE ADDRESS
MOVE S2,G$ENT## ;GET THE MDB ADDRESS
LOAD S2,MDB.MS(S2),MD.ADR ;GET THE LIST REQUEST MESSAGE ADDRESS
HRL S1,S2 ;SET SOURCE FOR BLT
LOAD S2,.MSTYP(S2),MS.CNT ;GET THE MESSAGE LENGTH
ADDI S2,(S1) ;COMPUTE END+1 OF BLT
BLT S1,-1(S2) ;COPY THE ORIGINAL LIST REQUEST MESSAGE
MOVE T1,G$SAB##+SAB.MS ;GET MESSAGE ADDRESS BACK
MOVE S1,[2,,.LSPID] ;BLOCK WE ALWAYS ADD
MOVE S2,G$OPR## ;GET REQUESTOR'S PID
SKIPL ENTYPE ;IF USER REQUEST
MOVE S2,G$SND## ;GET FROM HERE
PUSHJ P,ASKN.A ;ADD THE BLOCK TO THE NEW MESSAGE
MOVEI S1,LSTQNM ;ADDRESS OF QUEUE NAME STRING
PUSHJ P,A$FQNM## ;GET THE ENTRY
JUMPF ASKN.1 ;DUH? JUST WORKED!
MOVE S2,QNM.RO+.ROBND(S1) ;GET THE NODE NAME
MOVE S1,[2,,.LSDND] ;BLOCK WE ADD
PUSHJ P,ASKN.A ;ADD THE BLOCK TO THE NEW MESSAGE
;(MIGHT ALREADY BE ONE, BUT BIG DEAL)
ASKN.1: MOVX S1,PAGSIZ ;WE'RE SENDING A PAGE
MOVEM S1,G$SAB##+SAB.LN ;SET LENGTH
PUSHJ P,C$SEND## ;SEND IT OFF TO THE NET QUEUE CTLR
MOVE S1,[SAVSAB,,G$SAB##] ;NOW RESTORE THE OLD SAB
BLT S1,G$SAB##+SAB.SZ-1 ;...
JUMPF ASKN.2 ;IN CASE OF ERROR
$RETT ;NQC WILL HANDLE THE REST
ASKN.2: $ASCII (<%The remote queues are not accessible>)
PUSHJ P,CRLF ;END WITH A CRLF
$RETF ;WE DID OUR BEST
;ADD A BLOCK TO THE LIST REQUEST MESSAGE
ASKN.A: AOS .OARGC(T1) ;WE'RE ADDING ANOTHER BLOCK
LOAD T2,.MSTYP(T1),MS.CNT ;GET THE COUNT FIELD
ADDI T2,2 ;BUMP BY TWO WORDS
CAILE T2,PAGSIZ ;QUICK SANITY CHECK
STOPCD (LPO,HALT,,<List request message page overflowed>)
STORE T2,.MSTYP(T1),MS.CNT ;STORE NEW COUNT
ADDI T2,-2(T1) ;FIND WHERE THE NEW BLOCK GOES
DMOVEM S1,(T2) ;MOVE IT THERE
POPJ P, ;RETURN
SAVSAB: BLOCK SAB.SZ ;SAVED G$SAB
END