Trailing-Edge
-
PDP-10 Archives
-
BB-D868D-BM
-
language-sources/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) 1975,1976,1977,1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC,ORNMAC
PROLOG (QSRDSP)
SUBTTL LOCAL STORAGE AND BRANCH TABLES
QSAB: $BUILD SAB.SZ
$SET(SAB.LN,,1000)
$EOB
DEPDEV: EXP <.POPJ> ;ILLEGAL QUEUE TYPE 0.
EXP <.POPJ> ;.OTRDR - CARD READER QUEUE
EXP <.POPJ> ;.OTNCU - NETWORK CONTROLLER QUEUE.
EXP DEPOUT ;.OTLPT - LINE PRINTER QUEUE
EXP DEPBAT ;.OTBAT - BATCH QUEUE
EXP DEPOUT ;.OTCDP - CARD PUNCH QUEUE
EXP DEPOUT ;.OTPTP - PAPER TAPE QUEUE
EXP DEPOUT ;.OTPLT - PLOTTER QUEUE
EXP <.POPJ> ;.OTTRM - TERMINAL
EXP <.POPJ> ;.OTJOB - JOB (T/S) QUEUE
EXP <.POPJ> ;.OTOPR - OPERATOR QUEUE
EXP <.POPJ> ;.OTIBM - IBM
EXP <.POPJ> ;.OTMNT - MOUNT
EXP <.POPJ> ;.OTXFR - FILE TRANSFER
EXP <.POPJ> ;.OTBIN - CARD READER INTERPRETER
EXP DEPRET ;.OTRET - RETRIEVAL QUEUE
EXP <.POPJ> ;.OTNOT - RETREIVAL NOTIFICATION
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/Min:Max Feet/] ;.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
SUBTTL ROUTINE DATA AREAS AND ITEXT STATEMENTS.
QUEBIT: BLOCK 1 ;SAVE AREA FOR THE QUEUE TYPES.
LSTUSR: BLOCK 1 ;AREA FOR THE USER ID.
LISTYP: BLOCK 1 ;FLAG: 0=FAST, -1=NORMAL, 1=ALL
BLKADR: BLOCK 1 ;MESSAGE BLOCK ADDRESS.
OBTYPE: BLOCK 1 ;OBJECT TYPE
ACTIVE: BLOCK 1 ;ACTIVE JOB COUNT.
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.
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
DEVTYP: ASCIZ/Tape/
ASCIZ/Disk/
ASCIZ/Disk/
DEFINE $ASCII(MSG,%LN),<SKIPA
XLIST
JRST %LN ;;MAKE IT SKIP-ABLE.
MOVEI S1,[ASCIZ+MSG+] ;;GET THE STRING ADDRESS.
PUSHJ P,ASCOUT ;;DUMP IT OUT.
%LN: LIST > ;END OF $ASCII
JS: ITEXT (<^W6L /.QEJOB(AP)/ ^D4R /.QERID(AP)/ >)
TIM: ITEXT (<^D2R0/TIME./:^D2R0/TIME.+1/:^D2R0/TIME.+2/>)
ONOFL: [ASCIZ/Offline/]
[ASCIZ/ Online/]
IBMTYP: [ASCIZ/ /]
[ASCIZ/3780/]
[ASCIZ/2780/]
[ASCIZ/HASP/]
IBMODE: [ASCIZ/ /]
[ASCIZ/Termination/]
[ASCIZ/Emulation/]
IBMDTR: [ASCIZ/ /]
[ASCIZ/ On/]
[ASCIZ/Off/]
;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
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.
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.
JUMPE P1,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
SKIPN QEMPTY ;ARE THE QUEUES EMPTY ???
JRST LIST.2 ;YES,,PROCESS A LITTLE DIFFERENTLY
PUSHJ P,CRLF ;END WITH A CRLF
PUSHJ P,SENDIT ;SEND THE LAST PAGE.
$RETT ;RETURN.
LIST.2: SKIPE ENTYPE ;WAS THIS AN USER REQUEST ???
JRST LIST.3 ;NO,,MUST BE OPERATOR
MOVEI S1,[ASCIZ/ System Queues Listing /] ;GENERATE THE ID
PUSHJ P,SETPAG ;GO SETUP THE PAGE
$ASCII (<[The Queues are Empty]>) ;PUT IN THE TEXT
PUSHJ P,CRLF ;ADD A CRLF
PUSHJ P,SENDIT ;SEND IT OFF
$RETT ;AND RETURN
LIST.3: $ACK (The Queues are Empty,,,ACKCOD) ;YES,,RESPOND !!
$RETT ;AND RETURN
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.
$TEXT (DEPBYT,< ^D4R /OBJUNI(T1)/ ^A>) ;PUT OUT THE UNIT/STREAM #
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$TEXT (DEPBYT,<^T10R /NETASC(P1)/ ^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.
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: $ACK (Device Unknown,,0(S1),ACKCOD) ;SEND A SPECIFIC MSG
$RETT ;AND RETURN
SUBTTL CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS
;CALL: T1/OBJECT BLOCK ADDRESS
;
;RET: TRUE IF USER WANTS THIS OBJECT
; FALSE IF USER DOES NOT WANT THIS OBJECT
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'
SKIPA ;IF NOT,, THEN HE WINS
$RETF ;ELSE TOUGH BREAKEEEEE
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
SKIPA ;WIN ON EITHER,,SKIP
$RETF ;NO GOOD,,RETURN
SKIPN S1,OBJ.ND(S2) ;IF NO NODES,
JRST CHKO.1 ;WIN,,CHECK FOR DN60 EMULATION
CAME S1,[-1] ;IF ALL NODES,
CAMN S1,OBJNOD(T1) ; OR IF WE MATCH,
SKIPA ;THEN CHECK FOR DN60 EMULATION
$RETF ;ELSE RETURN FALSE
CHKO.1: MOVE S1,OBJNOD(T1) ;GET THE OBJECTS NODE NAME
PUSHJ P,N$NODE## ;FIND ITS ENTRY IN OUR DATA BASE
MOVE S1,S2 ;SAVE/RETURN THE ADDRESS IN S1
LOAD S2,NETSTS(S1),NETIBM ;IS THIS A DN60 REMOTE STATION ???
JUMPE S2,.RETT ;NO,,RETURN NOW
LOAD S2,NETSTS(S1),NT.MOD ;YES,,GET ITS OPERATION MODE
CAXE S2,DF.EMU ;IS IT EMULATION MODE ???
$RETT ;NO,,JUST RETURN
SKIPE SHWTYP ;YES,,IS THIS 'SHOW STATUS' ???
$RETF ;NO,,JUST SKIP THIS OBJECT
LOAD S2,NETSTS(S1),NETONL ;IS THE NODE ONLINE ???
JUMPE S2,.RETT ;NO,,JUST RETURN
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...
MOVEI S1,1 ;GET A 1
SKIPN QEMPTY ;HAVE WE SETUP AN OUTPUT MSG YET ???
MOVEM S1,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
MOVX S1,SAB.SZ ;GET THE SAB LENGTH
MOVEI S2,G$SAB## ;AND ITS ADDRESS
PUSHJ P,C%SEND ;SEND THE MSG OFF
JUMPT .RETF ;RETURN IF OK
MOVE S1,G$SAB##+SAB.MS ;NO GOOD,,GET THE MSG ADDRESS
PUSHJ P,M%RPAG ;RETURN IT
$RETF ;AND RETURN OURSELVES !!!
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
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
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
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: $ASCII (< Minutes Prio >) ;START HEADING
IFN INPCOR,< $ASCII (< Core >) > ;PUT OUT 'CORE'
$ASCII (<Opr-Intvn>) ;PUT OUT OPR-INTERVENTION HEADING
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- >) ;UNDERLINE 'STRM'
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES,,UNDERLINE IT
$ASCII (<----------- ----- >) ;OUTPUT SOME UNDERLINES
IFN INPCOR,< $ASCII (<------- >) > ;'CORE' UNDERLINE
$ASCII (<--------->) ;OPR-INTERVENTION UNDERLINE
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
SUBTTL D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE.
D$SHRT: PUSHJ P,.SAVE2 ;SAVE THE P ACS.
SETOM JOBNBR ;ZERO A COUNTER.
SETOM ENTYPE ;INDICATE THIS IS AN OPERATOR REQUEST.
LOAD S1,.MSCOD(M) ;GET THE ACK CODE.
STORE S1,ACKCOD ; AND SAVE IT.
LOAD P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
SHRT.1: JUMPE P1,SHRT.3 ;NO MORE,,FINISH UP.
SKIPN S1,NETRTE(P1) ;GET THE ROUTING NODE
JRST SHRT.2 ;NONE THERE,,GET NEXT
AOSG JOBNBR ;BUMP ROUTINE COUNT.
PUSHJ P,SHRHDR ;FIRST TIME,,SET UP THE HEADER
PUSHJ P,N$NODE## ;FIND THAT NODE
$TEXT (DEPBYT,<^T12L /NETASC(P1)/ ^T12L /NETASC(S2)/>)
SHRT.2: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT ENTRY
JRST SHRT.1 ;AND CONTINUE
SHRT.3: AOSN S1,JOBNBR ;CHECK NUMBER OF ROUTES.
JRST SHRT.4 ;NO ROUTING,,TELL THE OPERATOR
CAIN S1,1 ;IS THERE 1 RE-ROUTE ???
$ASCII (< 1 Node has been re-routed>) ;YES,,SAY SO.
CAILE S1,1 ;IS THERE MORE THEN 1 ???
$TEXT (DEPBYT,< ^D/JOBNBR/ Nodes have been re-routed^A>)
PUSHJ P,CRLF ;ADD THE LAST CRLF.
PJRST SENDIT
SHRT.4: $ACK (No Routing has been performed,,,ACKCOD) ;TELL OPR
$RETT ;AND RETURN
SHRHDR: PUSH P,S1 ;SAVE S1 FOR A MINUTE
MOVEI S1,[ASCIZ/ System Routing Table /] ;GET THE HEADING.
PUSHJ P,SETPAG ;SET UP AN OUTPUT PAGE.
PUSHJ P,CRLF ;OUTPUT A CRLF.
$ASCII (< Node Routed to Node>)
PUSHJ P,CRLF ;AGAIN.
$ASCII (<------------ ------------>)
PUSHJ P,CRLF ;ONE MORE TIME.
POP P,S1 ;RESTORE S1
$RETT ;AND RETURN
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.3 ;NO MORE,,GO FINISH UP
MOVE S1,NETCOL(P1) ;GET THIS NODES NAME/NUMBER
PUSHJ P,CMPNOD ;IS IT ONE WE WANT ???
JUMPF NPRM.2 ;NO,,TRY NEXT
MOVE S1,NETCOL(P1) ;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.2 ;NOT IBM,,SKIP THIS STUFF
AOSG JOBNBR ;BUMP NODE COUNT.
PUSHJ P,NPRHDR ;FIRST TIME,,SET UP THE HEADER
LOAD T1,NETSTS(P2),NT.TYP ;GET THE NODE TYPE
LOAD T2,NETSTS(P2),NT.MOD ;GET THE NODE MODE
LOAD T3,NETSTS(P2),NT.DTR ;GET 'DATA TERMINAL READY'
LOAD T4,NETSTS(P2),NT.TRA ;GET 'TRANSPARENCY'
$TEXT (DEPBYT,<^T12/NETASC(P2)/^T/@IBMTYP(T1)//^T12/@IBMODE(T2)/^T5/@IBMDTR(T3)/^T4R /@IBMDTR(T4)/ ^O4/NETPTL(P2),NT.PRT/ ^D4/NETPTL(P2),NT.LIN/^D6/NETCSD(P2)/^D6/NETRPM(P2)/^D6/NETBPM(P2)/^D6/NETSWL(P2)/>)
LOAD T1,NETSTS(P2),NETSGN ;GET 'SIGNON REQUIRED' BIT
$ASCII (< Signon>) ;Add SIGNON LINE
SKIPN T1 ;IS IT REQUIRED ???
$ASCII (< is not>) ;NO,,SAY SO
$ASCII (< Required>) ;ADD LAST BIT OF INFO
PUSHJ P,CRLF ;END THE LINE
NPRM.2: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT ENTRY
JRST NPRM.1 ;AND CONTINUE
NPRM.3: AOS S1,JOBNBR ;GET THE NODE COUNT IN S1
MOVE S2,NODE6B ;GET THE NODE WE ASKED FOR
JUMPG S1,NPRM.4 ;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 ^W/NODE6B/ is not an IBM Remote>,,,.MSCOD(M))
$RETT ;JUST RETURN NOW
NPRM.4: 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 DTR Trans Port Line CSD RPM BPM SWL>)
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: PUSHJ P,.SAVE1 ;SAVE P1 & P2 FOR A MINUTE
SETZM ACTIVE ;FLAG FOR 1 NODE ONLY
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 ???
SETOM ACTIVE ;NO,,A SPECIFIC NODE !!
LOAD P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST NODE DATA BASE ENTRY
SKIPA ;SKIP THE FIRST TIME THROUGH
NSTS.1: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT NODE ENTRY ADDRESS
JUMPE P1,NSTS.2 ;NO MORE,,JUST RETURN
MOVE S1,NETCOL(P1) ;GET THIS NODES NAME/NUMBER
PUSHJ P,CMPNOD ;IS IT ONE WE WANT ???
JUMPF NSTS.1 ;NO,,TRY NEXT NODE
SKIPE ACTIVE ;ALL NODES ???
JRST NSTS.3 ;NO,,ACK THIS NODE AND RETURN
AOSG JOBNBR ;BUMP NODE COUNT BY 1
PUSHJ P,NSTHDR ;FIRST ONE,,PUT OUT A HEADER
LOAD S1,NETSTS(P1),NETONL ;GET THE ONLINE BIT
$TEXT (DEPBYT,<^T13/NETASC(P1)/^T/@ONOFL(S1)/>)
JRST NSTS.1 ;PUT OUT DATA AND GO GET NEXT ENTRY
NSTS.2: AOSG S1,JOBNBR ;GET CORRECT COUNT
$ACK (<Node ^W/NODE6B/ Does not Exist>,,,.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
NSTS.3: LOAD S1,NETSTS(P1),NETONL ;GET THE ONLINE BIT
$ACK (<Node ^W/NODE6B/ is ^T/@ONOFL(S1)/>,,,.MSCOD(M))
$RETT ;RETURN
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 Name Status>) ;SET UP HEADING
PUSHJ P,CRLF ;END THE LINE
$ASCII (<----------- ------->) ;UNDERLINE IT
PUSHJ P,CRLF ;END THE LINE
$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,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
LOAD S1,.VLOWN(S1),VL.OFF ;GET THE VOL OWNER OFFSET
CAIE S1,-1 ;IS THERE AN OWNER ???
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
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
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
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 !!!
$TEXT (DEPBYT,<^W8/.UCBNM(P1)/^T13/0(S2)/^T5/0(S1)/^A>) ;INSERT TEXT
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,<^T9/0(S2)/^W8/.VLNAM(S1)/^A>) ;ADD SOME MORE TEXT
STAP.Z: SKIPN S1,.UCBVS(P1) ;GET VSL ADDRESS JUST IN CASE
JRST STAP.5 ;NO OWNER,,SKIP THIS
MOVE S1,.VSMDR(S1) ;GET THE OWNER MDR ADDRESS
$TEXT (DEPBYT,<^D4R /.MRRID(S1),MR.RID/ ^W6/.MRNAM(S1)/^W/.MRNAM+1(S1)/ ^U/.MRUSR(S1)/^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
SUBTTL TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HEADER
TAPHDR: MOVEI S1,[ASCIZ/ Tape Drive Status /]
PUSHJ P,SETPAG ;SETUP THE OUTPUT PAGE
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (<Drive Status AVR>) ;START THE HEADING
SKIPE REMOTE ;ANY VOLUMES MOUNTED ???
$ASCII (< Write Volume>) ;YES,,ADD TO THE HEADER
SKIPE ACTIVE ;ANY VOLUME OWNED ???
$ASCII (< Req# User>) ;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
SKIPE ACTIVE ;ANY OWNED VOLUMES
$ASCII (< ---- ---------------------->) ;YES,,ADD TO THE UNDERLINE
PUSHJ P,CRLF ;END THE LINE
$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
; T1 --> VOL AOBJN AC
; S1,S2,T2-T4 Are Scratch AC's
D$SMNT: 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
MOVE S1,MDRQUE## ;GET THE MOUNT QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
JUMPF SMNT.6 ;NONE THERE,,END IT ALL
PUSHJ P,.SAVET ;SAVE THE 'T' AC'S
PUSHJ P,.SAVE4 ;SAVE P1 THROUGH P4
SMNT.1: MOVE AP,S2 ;GET THE QUEUE ENTRY ADDRESS
SKIPE S1,LSTUSR ;FOR A PARTICULAR USER ???
CAMN S1,.MRUSR(AP) ;YES,,DO THEY MATCH ???
SKIPA ;NOT /USER: OR THEY MATCH,,SKIP
JRST SMNT.5 ;ENTRY DOESN'T MATCH,,SKIP IT
AOSG JOBNBR ;BUMP THE COUNT BY 1
PUSHJ P,MNTHDR ;FIRST TIME,,DO A HEADER
SKIPE NOROOM ;ANY ROOM LEFT ???
PUSHJ P,PAGOVF ;NO,,SEND THIS AND GET ANOTHER PAGE
SETZM SHWTYP ;WANT DEMOGRAPHIC DATA FOR THIS USER
LOAD P4,.MRRID(AP),MR.CNT ;GET THE VSL COUNT
MOVNS P4 ;MAKE IT NEGATIVE
HRLZS P4 ;CREATE A VSL AOBJN AC
SMNT.2: MOVEI P1,.MRVSL(AP) ;POINT TO THE FIRST VSL POINTER
ADDI P1,0(P4) ;ADD THE OFFSET TO THE CURRENT VSL
MOVE P1,0(P1) ;PICK UP THE CURRENT VSL ADDRESS
SKIPLE LISTYP ;IS THIS /ALL ???
JRST [LOAD T1,.VSCVL(P1),VS.CNT ;YES,,GET THE VOLUME COUNT
MOVNS T1 ;MAKE IT NEGATIVE
HRLZS T1 ;CREATE A VOL AOBJN AC (-COUNT,,0)
JRST SMNT.3 ] ;AND CONTINUE
LOAD T1,.VSCVL(P1),VS.OFF ;NO,,GET OFFSET TO THE CURRENT VOLUME
HRLI T1,-1 ;CREATE A VOL AOBJN AC (-1,,OFFSET)
SMNT.3: MOVEI P2,.VSVOL(P1) ;POINT TO THE FIRST VOL POINTER
ADDI P2,0(T1) ;ADD THE OFFSET TO THE CURRENT VOLUME
MOVE P2,0(P2) ;PICK UP THE CURRENT VOL ADDRESS
MOVE P3,.VLUCB(P2) ;GET THE UCB ADDRESS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
LOAD T4,.VSFLG(P1),VS.TMP ;GET THE REQUEST SCRATCH VOLUME BIT
LOAD TF,.VLFLG(P2),VL.SCR ;GET THE VOLUME SCRATCH BIT
ADD T4,TF ;MERGE THE BITS
SKIPE T4 ;IS THIS A SCRATCH TAPE
$ASCII (<Scratch >) ;YES,,MAKE IT SCRATCH
SKIPN T4 ;CHECK FOR SCRATCH ONCE AGAIN
$TEXT (DEPBYT,<^W9/.VLNAM(P2)/^A>) ;NOT SCRATCH,,DUMP VOL NAME
LOAD S1,.VSFLG(P1),VS.TYP ;GET THE REQUEST TYPE
CAXN S1,%DSMT ;IS THIS A DISMOUNT REQUEST ???
JRST [$ASCII (<Dismount >) ;YES,,SAY SO
JRST SMN.4X ] ;AND CONTINUE ON
LOAD S1,.VLOWN(P2),VL.OFF ;GET THE OWNER OFFSET
ADDI S1,.VLVSL(P2) ;POINT TO THE OWNER VSL ADDRESS
LOAD S2,.VLFLG(P2),VL.SHR ;PICK UP THE SHARED VOLUME BIT
CAME P1,0(S1) ;IS THIS USER THE OWNER
SKIPE S2 ;OR IS THE VOLUME SHARED ???
SKIPA ;YES,,SKIP
JRST SMNT.4 ;NO,,MAKE IT WAITING !!!
LOAD T4,.VLFLG(P2),VL.STA ;GET THE VOLUME STATUS
CAXN T4,%STAAB ;IS IT 'ABORTED' ???
$ASCII (<Aborted >) ;YES,,SAY SO
CAXE T4,%STADM ;IS IT 'DISMOUNT' ???
CAXN T4,%STAMN ;OR IS IT MOUNTED ???
$TEXT (DEPBYT,<^W10/.UCBNM(P3)/^A>) ;YES,,INSERT THE DEVICE NAME
CAXN T4,%STAWT ;IS IT 'WAITING' ???
SMNT.4: $ASCII (<Waiting >) ;YES,,SAY SO
SMN.4X: LOAD T4,.VSFLG(P1),VS.TYP ;GET THE VOLUME-SET TYPE
CAXN T4,%TAPE ;IS IT 'TAPE' ???
$ASCII (<Tape >) ;YES,,SAY SO
CAXE T4,%DSMT ;IS IT A STRUCTURE DISMOUNT ???
CAXN T4,%DISK ;OR IS IT 'DISK' ???
JRST [$ASCII (<Disk >) ;YES,,SAY SO
JRST SMN.4A ] ;AND CONTINUE
LOAD T4,.VSFLG(P1) ;GET THE FLAG BITS FOR THE VOLUME SET
TXC T4,VS.WLK ;WANT IR WRITE ENABLED
TXNE T4,VS.WLK+VS.NEW+VS.TMP ;IS ENABLED OR NEW OR SCRATCH
$ASCII (<Enabled >) ;THEN SAY SO
TXNN T4,VS.WLK+VS.NEW+VS.TMP ;CHECK AGAIN
$ASCII (<Locked >) ;NONE SET,,THEN WRITE LOCKED
SMN.4A: SKIPN SHWTYP ;DO WE WANT DEMOGRAPHIC DATA ???
$TEXT (DEPBYT,<^W10L/.MRREQ(AP)/^D4R /.MRRID(AP),MR.RID/ ^D4R /.MRJOB(AP),MD.PJB/ ^I/MNTUSR/^A>)
SETOM SHWTYP ;NO MORE DEMOGRAPHIC DATA FOR THIS USER
PUSHJ P,CRLF ;END THE LINE
AOBJN T1,SMNT.3 ;CONTINUE THROUGH ALL VOLUMES
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SKIPG LISTYP ;WAS THIS A /ALL LISTING ???
JRST SMN.4B ;NO,,SKIP THIS
SKIPE .VSREM(P1) ;YES,,WAS THERE ANY REMARK ???
$TEXT (DEPBYT,< Remark: ^T/.VSREM(P1)/>) ;YES,,INSERT THE REMARK
TOPS10< LOAD S1,.VSFLG(P1),VS.LBT ;GET THE LABEL TYPE
$TEXT (DEPBYT,< Label-Type: ^T/@LABELS(S1)/>) ;INSERT LABEL TYPE
>
SMN.4B: AOBJN P4,SMNT.2 ;CONTINUE THROUGH ALL VOLUME SETS
SMNT.5: MOVE S1,MDRQUE## ;GET THE QUEUE LIST ID
PUSHJ P,L%NEXT ;GET THE NEXT QUEUE ENTRY
JUMPT SMNT.1 ;CONTINUE IF THERE IS ONE
AOSG S1,JOBNBR ;CORRECT THE COUNT
JRST SMNT.6 ;NO REQUESTS,,RETURN NOW
SETOM QEMPTY ;INDICATE THE QUEUES ARE NOT EMPTY
SKIPN LISTYP ;IS THIS A FAST LISTING ???
JRST SMNT.6 ;YES,,SKIP THIS
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>) ;YES,,SAY SO
PUSHJ P,CRLF ;OUTPUT A CRLF
SMNT.6: SETOM JOBNBR ;RESET THE JOB/REQUEST COUNTER
SETZM ACTIVE ;AND THE ACTIVE COUNTER
$RETT ;AND 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
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<Tape/Disk 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 Name 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 ;SAVE H
STORE H,HDRSAV ;HERE ALSO.
MOVSI S1,120000 ;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 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,SHOW.6 ;NO MORE,,FINISH UP.
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.
;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
CAIN T1,1 ;JUST 1 JOB PROCESSED ???
$ASCII (<There is 1 Job in the Queue>) ;YES,,SAY SO.
CAIE T1,1 ;MORE THEN 1 JOB ???
$TEXT (DEPBYT,<There are ^D/T1/ Jobs in the Queue^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,CRLF ;INSERT A CRLF.
SHOW.7: SETOM JOBNBR ;RESET JOB COUNT
SETZM ACTIVE ;RESET ACTIVE COUNT.
$RETT ;RETURN.
SUBTTL PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING.
PUTOUT: MOVE S1,.QEROB+.ROBND(AP) ;GET THIS OBJECTS NODE NAME/NUMBER
PUSHJ P,CMPNOD ;SEE IF WE WANT THIS ONE
JUMPF .RETF ;NO,,TRY THE NEXT ONE
SKIPE S2,LSTUSR ;GET THE USER ID,,SKIP IF NONE.
CAMN S2,.QEOID(AP) ;DOES IT MATCH THIS QUEUE ENTRY ???
SKIPA ;YES,,GO DUMP IT OUT.
$RETF ;DONT WANT THIS ONE.
SKIPE NOROOM ;IS THERE STILL ROOM IN THE OUTPT PAGE ?
PUSHJ P,PAGOVF ;NO,,KLEEN UP A BIG MESS.
LOAD P3,.QEOBJ(AP) ;GET THE OBJECT ADDR (FOR ACTIVE JOBS)
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE OBJECT (QUEUE) TYPE.
MOVEM S1,OBTYPE ;SAVE IT FOR LATER USE.
PUSHJ P,@DEPDEV(S1) ;DUMP IT OUT.
$RETT ;RETURN.
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 ;NO,,END NOW
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)/ ^D4/.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
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,<^D5R /S1/:^D5L /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,<^D3R /S1/:^D3L /S2/ >)
>
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
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
SHPA.1: 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/:^D5L /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 (<Ignore >) ;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
MOVE S1,OBJDAT(T1) ;GET THE DEVICE ATTRIBUTES
TXNE S1,OBDLLC ;IS IT LOWER CASE ???
$ASCII (< Lower>) ;YES,,SAY SO
TXNE S1,OBDLUC ;IS IT UPPER CASE ???
$ASCII (< Upper>) ;YES,,SAY SO
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
PJRST CRLF ;END THE LINE & RETURN
SUBTTL DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.
DEPOUT: AOSG JOBNBR ;IS THERE A HEADER ???
PUSHJ P,OUTHDR ;NO,,PUT ONE OUT.
GETLIM S1,.QELIM(AP),OLIM ;GET THE OUTPUT PAGE LIMIT.
STORE S1,LIMIT ;SAVE IT FOR OUTPUT.
PUSH P,BYTCNT ;SAVE THE CURRENT BYTE COUNT
$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^D5R /LIMIT/ ^I/USR/^A>)
POP P,S1 ;RESTORE OLD BYTE COUNT TO S1.
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
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: AOSG JOBNBR ;IS THE HEADER THERE ???
PUSHJ P,BATHDR ;NO,,PUT ONE OUT.
GETLIM S1,.QELIM(AP),TIME ;GET THE TIME LIMIT IN SECONDS.
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
$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^I/TIM/ ^I/USR/^A>)
POP P,S1 ;RESTORE OLD BYTE COUNT TO S1
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
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.
$ASCII (<Job Name Req# Run Time User>)
PUSHJ P,CRLF ;PUT OUT A CRLF.
$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
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
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
>
SUBTTL SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE.
SETPAG: MOVE T3,S1 ;SAVE THE HEADER ADDRESS.
PUSHJ P,M%GPAG ;GET A PAGE FOR OUTPUT.
MOVEM S1,QSAB+SAB.MS ;SAVE ITS ADDRESS 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,QSAB+SAB.MS ;GET THE MESSAGE START ADDRESS.
SUB S1,T4 ;CALC NEG. NUMBER OF WORDS USED.
ADDI S1,^D512-^D50 ;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.
SETHDR: MOVE S2,QSAB+SAB.MS ;GET THE MESSAGE ADDRESS.
MOVSI T4,7 ;GET AND POSITION THIS BLK LEN.
ADDM T4,.MSTYP(S2) ;ADD IT TO THE TOTAL MSG LENGTH.
AOS .OARGC(S2) ;ALSO BUMP THE BLOCK COUNT BY 1.
MOVE S2,[7,,.ORDSP] ;GET LENGTH,,BLOCK-TYPE.
MOVEM S2,ARG.HD(S1) ;SAVE IT IN THE MSG.
MOVE S2,G$NOW## ;GET THE TIME
MOVEM S2,ARG.DA(S1) ;SAVE TIME STAMP
MOVEI T4,ARG.DA+1(S1) ;POINT TO BLOCK DATA AREA.
MOVEI S1,4(T4) ;GET BLT END ADDRESS.
HRL T4,T3 ;GET THE BLT SOURCE ADDRESS.
BLT T4,0(S1) ;CREATE TYPE LINE.
AOS S1 ;POINT TO NEXT(TXT) MSG BLOCK.
$RETT
SUBTTL SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.
SNDMSG: MOVX S1,WT.MOR ;GET THE MORE PAGES COMMING BIT.
MOVE S2,QSAB+SAB.MS ;GET THE MESSAGE ADDRESS.
IORM S1,.OFLAG(S2) ;LIGHT THE BIT.
SENDIT: HRRZ S1,BYTPTR ;GET FINAL MESSAGE ADDRESS.
SUB S1,DATADR ;SUBTRACT THE START ADDRESS.
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,@QSAB+SAB.MS ;BUMP TOTAL MSG LENGTH.
SKIPL ENTYPE ;IS THIS AN OPERATOR REQUEST ???
JRST SEND.1 ;NO,,MUST BE A USER REQUEST.
MOVE S1,[SI.FLG+SP.OPR] ;GET THE GENERIC OPR PID.
MOVEM S1,QSAB+SAB.SI ;AND SAVE IT.
SETZM QSAB+SAB.PD ;ZERO THE RECIEVERS PID.
JRST SEND.2 ;GO SEND IT OFF.
SEND.1: MOVE S1,G$SND## ;GET THE SENDERS PID.
MOVEM S1,QSAB+SAB.PD ;AND SAVE IT.
SETZM QSAB+SAB.SI ;ZERO THE GENERIC PID WORD.
SEND.2: MOVEI S1,SAB.SZ ;GET THE SAB LENGTH
MOVEI S2,QSAB ;GET THE SAB ADDRESS
PUSHJ P,C%SEND ;SEND IT OFF.
SETZM QSAB+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,^D10 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
SKIPE JOBACT ;IS THE JOB ACTIVE ???
$TEXT (DEPBYT,< In Stream:^D/OBJUNI(P3)/^A>) ;YES,,SAY SO
MOVEI S1,6 ;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
JRST DMPS.3 ;CONTINUE ON
DMPS.1: MOVEI S1,7 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM.
LOAD S1,.QEROB+.ROBAT(AP) ;GET THE DEVICE ATTRIBUTES
SETOM S2 ;INDICATE NO DEVICE SPECIFIED
TXNE S1,RO.PHY ;WAS A PHYSICAL UNIT SPECIFIED ??
LOAD S2,.QEROB+.ROBAT(AP),RO.UNI ;GET THE UNIT NBR
SKIPE JOBACT ;IS THE JOB ACTIVE
LOAD S2,OBJUNI(P3) ;YES,,GET THE DEVICE NUMBER.
SKIPGE S2 ;DO WE HAVE ANYTHING ???
JRST DMP.1A ;NO,,SKIP THIS
SKIPN JOBACT ;IS THE JOB ACTIVE ???
$TEXT (DEPBYT,< /Unit:^D/S2/^A>) ;NOT ACTIVE,,SAY SO
SKIPE JOBACT ;CHECK JOB ACTIVE AGAIN.
$TEXT (DEPBYT,< On Unit:^D/S2/^A>) ;IS ACTIVE,,SAY SO
JRST DMPS.2 ;AND CONTINUE ON
DMP.1A: TXNE S1,OBDLLC ;WAS IT /LOWER ???
$ASCII (< /Lower>) ;YES,,SAY SO
TXNE S1,OBDLUC ;WAS IT /UPPER ???
$ASCII (< /Upper>) ;YES,,SAY SO
DMPS.2: MOVEI S1,^D12 ;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
AND S2,[-1,,770000] ;JUST GET THE IMPORTANT PART
CAME S2,[SIXBIT/NORM/] ;IS IT NORMAL ???
$TEXT (DEPBYT,< /Forms:^W/S1/^A>) ;NO,,SAY SO
DMPS.3: MOVEI S1,^D12 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
MOVE S1,.QEROB+.ROBND(AP) ;GET THE NODE NAME/NUMBER
PUSHJ P,N$CSTN## ;PERFORM ANY ROUTING
PUSHJ P,N$LOCL## ;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,^D10 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
PUSHJ P,Q$CDEP## ;FIND THE MISSING STRUCTURE
SKIPT ;NONE THERE,,SKIP THIS
$TEXT (DEPBYT,< Str:^I/STRUCT/^A>) ;PUT IT OUT
LOAD S1,G$NOW## ;GET CURRENT TIME
CAML S1,.QECRE(AP) ;IS THERE A /AFTER PARM ???
JRST DMP.4A ;NO,,SKIP THIS
MOVEI S1,^D22 ;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,7 ;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
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEI S1,^D10 ;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,^D10 ;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
JRST DMPS.6 ;CONTINUE ON
DMPS.5: MOVEI S1,^D12 ;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,^D10 ;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: DMOVE S1,LASTPT ;GET THE LAST BYTPTR AND BYTCNT
SKIPE CRLFLG ;ARE WE STILL AT THE START OF THE LINE
DMOVEM S1,BYTPTR ;YES,,RESET THE BYTPTR AND BYTCNT
SKIPN CRLFLG ;SKIP IF WE DONT NEED A CRLF
DMPS.8: PUSHJ P,CRLF ;PUT OUT A CRLF
$RETT ;AND RETURN
SUBTTL PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE
PADLIN: MOVE T3,S1 ;GET THE OLD BYTE COUNT
SUBI T3,^D48 ;GET THE BYTE COUNT-48
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 JOBS.
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.
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 .RETT ;NO MORE,,RETURN.
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,.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 ???
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
JRST GETP.1 ;AND GO TRY AGAIN.
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
ASCOUT: PUSHJ P,.SAVE1 ;SAVE P1.
LOAD 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
;Call: S1/ The Node Name/Number of the Target Node
;
;Ret: True if we want to process this node, False otherwise
CMPNOD: MOVE S2,NODE6B ;GET THE NODE NAME/NUMBER WE WANT
CAMN S2,[-1] ;IS IT ALL NODES ???
$RETT ;YES,,RETURN
PJRST N$MTCH## ;NO,,RETURN THROUGH NODE MATCH ROUTINE
END