Trailing-Edge
-
PDP-10 Archives
-
BB-KL11L-BM_1990
-
galsrc/qsrdsp.mac
There are 39 other files named qsrdsp.mac in the archive. Click here to see a list.
TITLE QSRDSP - OPERATOR DISPLAY ROUTINES.
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH QSRMAC,GLXMAC,ORNMAC
SEARCH NEBMAC ;[31]SEARCH NEBULA'S SYMBOLS
PROLOG (QSRDSP)
DSPMAN==:60 ;Maintenance edit number
DSPDEV==:52 ;Development edit number
VERSIN (DSP) ;Generate edit number
Subttl Table of Contents
; Table of Contents for QSRDSP
;
; Section Page
;
;
; 1. Revision history . . . . . . . . . . . . . . . . . . . 3
; 2. LOCAL STORAGE AND BRANCH TABLES . . . . . . . . . . . 4
; 3. ROUTINE DATA AREAS AND ITEXT STATEMENTS. . . . . . . . 5
; 4. D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST. . 8
; 5. D$SHST - ROUTINE TO SHOW DEVICE STATUS. . . . . . . . 9
; 6. EXPTIM - Expand time . . . . . . . . . . . . . . . . . 10
; 7. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS . . . . . . 11
; 8. SHOW STATUS/PARAMETERS MESSAGE HEADING ROUTINE . . . . 13
; 9. CHKQUE - ROUTINE TO SCAN AND SET UP OBJECT HEADERS . . 14
; 10. D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE. . . . . . 16
; 11. D$NPRM - ROUTINE TO DISPLAY THE NETWORK (DN60) PARAMET 17
; 12. NPRSNA - ROUTINE TO DISPLAY SNA-WORKSTATION NETWORK PA 18
; 13. NPRHDR - NETWORK PARAMETER HEADER ROUTINE . . . . . . 19
; 14. D$NSTS - DISPLAY NETWORK STATUS (ONLINE/OFFLINE) . . . 20
; 15. D$STAP - SHOW STATUS OF TAPE DRIVES . . . . . . . . . 22
; 16. D$SDSK - SHOW STATUS OF DISK DRIVES . . . . . . . . . 24
; 17. GETDSK - ROUTINE TO RETURN THE FIRST/NEXT DISK UCB ADD 27
; 18. D$SSTR - SHOW STATUS OF FILE STRUCTURE . . . . . . . . 28
; 19. GETSTR - Get a primary file structure block . . . . . 31
; 20. STRHDR - Type a header line for SHOW STATUS STRUCTURES 32
; 21. TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HE 33
; 22. DSKHDR - ROUTINE TO PUT OUT DISK STATUS DISPLAY HEADER 34
; 23. D$SMNT - ROUTINE TO DUMP THE MOUNT QUEUES . . . . . . 35
; 24. SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES. . . . 39
; 25. PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING. . . . . 41
; 26. SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATU 42
; 27. SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM CO 43
; 28. DSPDST - DISPLAY SNA PRINTER / PUNCH DESTINATION PARAM 44
; 29. DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE. 45
; 30. DEPRET - ROUTINE TO PROCESS RETRIEVAL QUEUE ENTRYS. . 46
; 31. D$SALC - SHOW ALLOCATION . . . . . . . . . . . . . . . 47
; 32. Find a VSN given a resource number . . . . . . . . . . 50
; 33. SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE. . . . . . 52
; 34. SENDIT - END-OF-MESSAGE PROCESSING ROUTINE. . . . . . 53
; 35. SNDNEB - Send a message to NEBULA . . . . . . . . . . 54
; 36. DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO . . . . . . 55
; 37. PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE . . . . 57
; 38. GETPARMS = ROUTINE TO PROCESS THE INPUT BLOCKS IN A SH 58
; 39. REMLIS - Reformat a LIST message to be forward remotel 59
; 40. UTILITY ROUTINES . . . . . . . . . . . . . . . . . . . 60
SUBTTL Revision history
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
0 7-Jan-83
Currently no edits
2 4.2.1598 20-Nov-84
If the last character in an INFORMATION OUTPUT or INFORMATION BATCH
message page is a TAB, replace it with a NULL.
***** Release 5.0 -- begin development edits *****
10 5.1003 7-Jan-83
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
11 5.1144 25-May-84
Include if the tape is labeled or not in the SHOW QUEUES
MOUNT-REQUESTS/ALL and INFORMATION MOUNT-REQUESTS/ALL commands.
12 5.1162 21-Sep-84
Add code to SHOW PARAMETERS for SNA Workstation. Add code to
SHOW DESTINATION for SNA printers and punches.
13 5.1171 22-Oct-84
Don't try to display both IBM and SNA parameters when a specific
node is given.
14 5.1175 23-Oct-84
Don't show the password in SHOW PARAMETERS for an SNA-Workstation
printer.
15 5.1210 25-Mar-85
Show all the volume i.d.s of a volume set when the command INFORMATION
MOUNT-REQUESTS/ALL is given.
***** Release 5.0 -- begin maintenance edits *****
20 Increment maintenance edit level for GALAXY 5.
***** Release 6.0 -- begin development edits *****
25 6.1043 29-Oct-87
Add support to the SHOW STATUS PRINTER and SHOW PARAMETERS PRINTER
commands for remote printers.
26 6.1051 3-Nov-87
Change OUTHDR to pick up the object type for the SHOW QUEUES display
from word OBTYPE instead of word OBJTYP.
27 6.1060 6-Nov-87
Place the user name on a separate line for the SHOW STATUS PRINTER DQS
command.
30 6.1097 22-Nov-87
Use the $QACK and $QWTO macros instead of the $ACK and $WTO macros
for sending .OMACK and .OMWTO messages.
31 6.1101 23-Nov-87
Add a remote node name display block to responses to SHOW messages
that originated on a remote node in the cluster. Make the message type
of such responses .NMACS rather than .OMACS.
32 6.1106 1-Dec-87
In routine SNDMSG: change the MOVEI to MOVX. It was accidently
changed.
33 6.1110 1-Dec-87
Change CHKQUE to always display the header line for non-LPT objects.
Also, correct the header underline to match the header words when a LAT
object is active.
34 6.1123 6-Dec-87
Indicate to routine N$CSTN by word G$DEFL to make node name
comparisions.
35 6.1138 13-Dec-87
Fix bugs found while debugging NEBULA.
36 6.1156 4-Jan-88
Correct the Req# and User header fields for LAT printers
37 6.1172 27-Jan-88
Change routine DMPSTS to correctly display active print jobs whose
LPT objects have been routed.
40 6.1173 28-Jan-88
Add the Forms field for LAT printer displays.
41 6.1175 7-Feb-88
Add support for the INFORMATION OUTPUT/DESTINATION command.
42 6.1177 11-Feb-88
Add support for specifying that batch log files and spooled files
be scheduled on specified local printers.
43 6.1178 11-Feb-88
Call routine N$NODE to set up the display of the node name for
active jobs.
44 6.1181 15-Feb-88
Fix some bugs found while debugging remote INFO OUTPUT requests
against a private EXEC.
45 6.1183 16-Feb-88
Reject a CANCEL PRINT/DESTINATION request if Cluster GALAXY is not
enabled.
46 6.1185 17-Feb-88
If an unprivileged user has specified the INFO OUTPUT/DESTINATION
command, then cause routine REMLIS to set up the call to the DIRST% correctly.
47 6.1190 19-Feb-88
Add the characteristics of TTY: and LAT printers to the SHOW PARAMETERS
PRINTER display.
50 6.1225 8-Mar-88
Update copyright notice.
51 6.1258 20-May-88
Orthogonalize the building of the SHOW STATUS and SHOW PARAMETERS
displays among the various types of objects for ease of maintainability.
52 6.1259 31-May-88
Edit 51 was missing 3 lines of code in routine SHWPAR which includes
the stream numbers for SHOW PARAMETERS BATCH.
***** Release 6.0 -- begin maintenance edits *****
53 6.1262 20-Jun-88
BPN crashes resulting from SHOW STATUS and PARAMETER commands will
have displays over a page long. Also, add 5 lines in SHST.1 to include the
node name for remote batch streams.
54 6.1289 29-Nov-89
Declare location G$NULA as external. This location is used by the
$Qxxx macros.
55 6.1294 23-Dec-89
In CHKOBJ check for all object types ("-1") before checking for remote
printer types.
56 6.1296 25-Dec-89
Add support for local printer commands that include the /NODE switch.
57 6.1306 31-Jan-90
Change the SHOW QUEUE/USER commands to expect as an argument the
user name rather than the user public structure directory number. This is
in support of the /CLUSTER-NODE switch in which the remote node has a
different public structure than the local node.
60 6.1318 3-Jun-90
Add support for alias printers.
\ ;End of Revision History
SUBTTL LOCAL STORAGE AND BRANCH TABLES
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
EXP <.POPJ> ;.OTDBM
EXP <.POPJ> ;.OTFAL
EXP <.POPJ> ;.OTSNA - SNA Workstation
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/Min:Max Lim./] ;.OTDBM
[ASCIZ/Min:Max Lim./] ;.OTFAL
[ASCIZ/Min:Max Lim./] ;.OTSNA
%UNLBL==1 ;VOLUME IS UNLABELED
%LABEL==2 ;VOLUME IS LABELED
VOLLIN==5 ;Volumes displayed/line
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
LSTDND: BLOCK 1 ;DESTINATION NODE
LSTPND: BLOCK 1 ;PROCESSING NODE
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.
ATTRIB: 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 ;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
SERNAM: BLOCK 1 ;[25]LAT SERVICE NAME HAS BEEN SEEN FLAG
ALLLPT: BLOCK 1 ;[25]INCLUDE ALL LPT TYPES IN DISPLAY
LPTHDR: BLOCK 1 ;[25]PRINTER HEADER PRINTED
REMMSG: BLOCK 1 ;[31]SECOND PAGE DISPLAY BLOCK INCLUDE FLAG
PIDBLK: BLOCK 1 ;[41]PID OF THE REMOTE SENDER
USRNAM: BLOCK 1 ;[41]POINTER TO THE REMOTE USER NAME
REMUSR: BLOCK 1 ;[41]MESSAGE IS IN BEHALF OF A REMOTE USER
;**;[60]At REMUSR:+1L add 1 line PMM 6/3/90
AKHEAD: BLOCK 1 ;[60]Printer alias header flag (-1=Yes, 0=No)
JOBAKA: BLOCK 1 ;[60]SIXBIT alias name
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 /]
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/]
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'
;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
EXTERN G$REMN ;[30]REMOTE NODE NAME WHERE MSG CAME FROM
EXTERN G$NEBF ;[30]REMOTE MESSAGE FLAG
;**;[54]At EXTERN G$NEBF add 1 line JCR 11/29/89
EXTERN G$NULA ;[54]Required by the $Qxxx macros
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 ..
;**;[60]At D$LIST:+6L add 1 line PMM 6/3/90
SETZM AKHEAD ;[60]Indicate no alias header
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.
SKIPE G$NEBF ;[41]MESSAGE ORIGINATE REMOTELY?
JRST LIST3A ;[44]YES, SO IGNORE THE FOLLOWING
SKIPN PIDBLK ;[41]IS THERE A PID BLOCK IN THE MSG?
JRST LIST.3 ;[41]NO, SO LOCAL AND DON'T FORWARD
MOVEI S1,.ORNOD ;[41]PICK UP THE NODE NAME BLOCK CODE
$CALL A$FNDB## ;[41]FIND THE NODE NAME BLOCK
JUMPF E$ILM## ;[41]ILLEGAL LIST MESSAGE
MOVE S2,0(S1) ;[41]PICK UP THE NODE NAME
CAME S2,G$LNAM## ;[41]LOCAL NODE NAME SPECIFIED?
JRST LIST.0 ;[41]NO, SO FORWARD THE REQUEST
SETZM PIDBLK ;[41]INDICATE A LOCAL REQUEST
JRST LIST.3 ;[41]TREAT AS A LOCAL REQUEST
LIST.0:
SINGLE< PJRST E$CNE##> ;[45]QUIT IF CLUSTER GALAXY NOT ENABLED
SOS S1 ;[41]ADDRESS OF THE NODE BLOCK
MOVEI S2,.NDENM ;[41]PICK UP REMOTE NODE NAME BLK CODE
STORE S2,ARG.HD(S1),AR.TYP ;[41]UPDATE THE BLOCK TYPE
SKIPE G$NEBP ;[41]IS NEBULA'S PID KNOWN?
JRST LIST.1 ;[41]YES, SO DON'T PICK IT UP
$CALL A$NPID## ;[41]]PICK UP NEBULA'S PID
JUMPF LIST.2 ;[41]IF FALSE, NEBULA'S NOT RUNNING
LIST.1: $CALL REMLIS ;[41]REFORMAT THE MESSAGE FOR NEBULA
$RETIF ;[41]RETURN ON AN ERROR
$CALL SNDNEB ;[41]FORWARD THE MESSAGE TO NEBULA
$RETT ;[44]AND RETURN
LIST.2: MOVX S1,MF.NOM ;[44]INDICATE A NULL ACK
SKIPE G$ACK## ;[41]AN ACK REQUESTED?
PUSHJ P,G$MSND## ;[41]YES, SEND A NULL ACK
MOVEI S1,[ASCIZ/ System Queues Listing /] ;[41]PICK UP HEADER ADR
$CALL SETPAG ;[41]SET UP THE MESSAGE PAGE
$ASCII (<[Unable to obtain output queue listing - node not reachable]>)
$CALL CRLF ;[41]END THE LINE
$CALL SENDIT ;[41]SEND THE MESSAGE TO THE USER
$RETT ;[41]RETURN
LIST.3: MOVX S1,MF.NOM ;[44]INDICATE A NULL ACK
SKIPE G$ACK## ;[41]AN ACK REQUESTED?
PUSHJ P,G$MSND## ;[41]YES, SEND A NULL ACK
SKIPA ;[44]G$ACK ALREADY ZEROED
LIST3A: SETZM G$ACK## ;[44]DON'T SEND AN ACK ON RETURN
TXNE P1,LIQMNT ;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.4: TDNE P1,.QHLIS(H) ;[41]DOES HE WANT THIS QUEUE?
PUSHJ P,SHOWQS ;YES,,DUMP IT.
ADDI H,QHSIZE ;POINT TO THE NEXT QUEUE.
SOJG P2,LIST.4 ;[41]AND TRY THE NEXT ONE.
$COUNT (NLAP) ;COUNT PAGES SENT
SKIPN QEMPTY ;ARE THE QUEUES EMPTY ???
JRST LIST.5 ;[41]YES, PROCESS A LITTLE DIFFERENTLY
PUSHJ P,CRLF ;END WITH A CRLF
PUSHJ P,SENDIT ;SEND THE LAST PAGE.
$RETT ;RETURN.
LIST.5: SKIPE ENTYPE ;[41]WAS THIS AN USER REQUEST?
JRST LIST.6 ;[41]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.6: $QACK (<The queues are empty>,,,ACKCOD) ;[41]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,.SAVET ;SAVE THE T ACS.
SETOM ENTYPE ;INDICATE 'OPERATOR' MESSAGE
SETZM QEMPTY ;INDICATE NO OBJECTS FOUND
SETZM OBTYPE ;ZERO THE OBJECT TYPE.
SETOM SERNAM ;[25]INDICATE NO LAT SERVICE OBJECTS
;**;[53]At D$SHST:+7L add 2 lines JYCW 6/20/88
SETZM NOROOM ;[53]Clear no more room indicator
SETZM BYTPTR ;[53]Indicate no output page yet ..
PUSHJ P,GETPARMS ;GO BREAK DOWN THE MESSAGE
SKIPN S1,OBJADR ;[25]MAKE SURE WE GOT AN OBJECT BLOCK
$RETT ;NONE THERE,,THATS AN ERROR
SETZM ALLLPT ;[51]ASSUME INCLUDE ONLY SPECIFIC LPTS
SETOM LPTHDR ;[25]NO HEADER PRINTED YET
MOVE S2,OBJ.TY(S1) ;[25]PICK UP THE OBJECT TYPE FROM MSG
CAIE S2,.OTLPT ;[25]IS THIS MESSAGE FOR ALL LPTS?
JRST STPR.0 ;[25]NO, PICK UP FIRST OBJECT ENTRY
SKIPGE OBJ.UN(S1) ;[25]IS IT REALLY FOR ALL LPT TYPES?
SETOM ALLLPT ;[25]YES, INDICATE SO
STPR.0: LOAD T1,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJ QUEUE ENTRY.
STPR.1: JUMPE T1,STPR.8 ;[25]NO MORE,,RETURN.
LOAD T2,OBJTYP(T1) ;GET THE OBJ TYPE.
JUMPLE T2,STPR.7 ;[25]NOT VALID,,TRY NEXT.
PUSHJ P,CHKOBJ ;DO WE WANT THIS OBJECT ???
JUMPF STPR.7 ;[25]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 ???
JRST STPR.2 ;[25]YES, SCAN FOR ACTIVE/REMOTE
LOAD S1,OBJNAM(T1),AR.TYP ;[25]PICK UP THE REMOTE NAME TYPE
CAIE S1,.KYSER ;[25]A LAT SERVICE NAME?
JRST STPR.3 ;[51]NO, CHECK IF SHOW STATUS OR NOT
AOSN SERNAM ;[25]IS THIS THE FIRST LAT SERVICE?
STPR.2: PUSHJ P,CHKQUE ;[25]YES, SCAN FOR ACTIVE/REMOTE STAT
STPR.3: SKIPN SHWTYP ;[51]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.7: LOAD T1,.QELNK(T1),QE.PTN ;[25]GET NEXT OBJ QUEUE ENTRY.
JRST STPR.1 ;GO PROCESS IT.
STPR.8: SKIPN S1,QEMPTY ;[25]WAS ANYTHING PUT OUT?
JRST STPR.9 ;[25]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
PUSHJ P,EXPTIM ;EXPAND TIME INTO READABLE TEXT
PJRST SENDIT ;SEND THE MESSAGE AND RETURN.
STPR.9: MOVE S1,OBJADR ;[25]GET THE OBJECT BLOCK ADDRESS
SKIPGE S2,OBJ.UN(S1) ;[25]IS IT FOR ALL UNITS?
JRST STPR10 ;[25]YES, INDICATE SO
CAIE S2,.KYPOR ;[25]IS LAT PORT KEYWORD SPECIFIED?
CAIN S2,.KYSER ;[25]NO, IS IT LAT SERVICE KEYWORD?
SKIPA ;[25]LAT PORT OR SERVICE SPECIFIED
JRST STPR11 ;[25]NO, SEND A SPECIFIC MESSAGE
STPR10: $QACK (<There are no devices started>,,,ACKCOD) ;YES,,TELL THE OPR
$RETT ;AND RETURN
STPR11: HRRZS OBJ.UN(S1) ;[25]CHECK THAT THERE IS NO HIGH RANGE
MOVE S2,OBJ.TY(S1) ;[25]PICK UP THE OBJECT TYPE
;**;[56]At STPR11:+2L replace 3 lines with 8 lines JCR 12/25/89
TXNN S2,.LOLPT ;[56]Is it a local LPT?
JRST STPR12 ;[56]No, go send the ACK
HRRZS OBJ.TY(S1) ;[56]Yes, keep only the object code
SETO S2, ;[56]Set for all nodes
CAMN S2,OBJ.ND(S1) ;[56]For all nodes?
SETZM OBJ.ND(S1) ;[56]Yes, default to the local node
STPR12: $QACK (<Device unknown>,,0(S1),ACKCOD) ;[56]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)/^A>)
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'
SKIPA ;IF NOT,, THEN HE WINS
$RETF ;ELSE TOUGH BREAKEEEEE
MOVE S2,OBJADR ;GET THE MESSAGE OBJ BLOCK ADDRESS
;**;[55]At CHKOBJ:+8L replace 1 line with 2 lines JCR 12/23/89
MOVE S1,OBJ.TY(S2) ;[55]Pick up object type
CAMN S1,[-1] ;[55]"-1" matches all object types
JRST CHKOBB ;[25]CHECK THE UNITS
CAMN S1,OBJTYP(T1) ;COMPARE AGAINST OBJ Q ENTRY
JRST CHKOBB ;[25]CHECK THE UNITS
CAIE S1,.OTLPT ;[25]A LPT SPECIFIED IN THE MESSAGE?
JRST CHKOBA ;[25]NO, CHECK FOR A LOCAL LPT
MOVE S1,OBJTYP(T1) ;[25]PICK UP THE OBJECT TYPE
TXNN S1,.DQLPT!.LALPT!.CLLPT ;[25]IS THIS A REMOTE LPT OBJECT?
$RETF ;[25]NO, DON'T INCLUDE THIS OBJECT
SKIPL ALLLPT ;[25]INCLUDE ALL LPT OBJECTS?
$RETF ;[25]NO, DON'T INCLUDE THIS OBJECT
JRST CHKOBB ;[25]CHECK THE UNITS
CHKOBA: CAME S1,[.LOLPT!.OTLPT] ;[25]IS THIS A LOCAL LPT (SHOW COMMAND?)
$RETF ;[25]NO, DON'T INCLUDE THIS OBJECT
HRRZS S1 ;[25]ISOLATE THE OBJECT TYPE
CAME S1,OBJTYP(T1) ;[25]IS THE OBJECT A LOCAL LPT?
$RETF ;[25]NO, RETURN NOW
CHKOBB: SKIPL S1,OBJ.UN(S2) ;[25]CHECK THE MSG UNIT #,,-1 WINS
CAMN S1,OBJUNI(T1) ;COMPARE AGAINST OBJ Q ENTRY
JRST CHKO.1 ;[25]MATCH, CONTINUE ON
CAIE S1,.KYPOR ;[25]IS THIS A LAT PORT?
CAIN S1,.KYSER ;[25]NO, A LAT SERVICE?
SKIPA ;[25]YES TO EITHER
JRST CHKO.0 ;[25]NO CHECK THE UNITS RANGE
LOAD T3,OBJNAM(T1),AR.TYP ;[25]PICK UP THE OBJECT'S NAME TYPE
CAME S1,T3 ;[25]ARE THEY THE SAME?
$RETF ;[25]NO, INDICATE NO MATCH
JRST CHKO.1 ;[25]CHECK THE NODE NAMES
;Check for within the range.
CHKO.0: LOAD S1,OBJ.UN(S2),OU.HRG ;[25]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.1: PUSHJ P,.SAVE1 ;[25]SAVE P1 FOR A SECOND
MOVE S1,OBJNOD(T1) ;GET THE OBJECTS NODE NAME
PUSHJ P,N$NODE## ;FIND ITS ENTRY IN OUR DATA BASE
MOVE P1,S2 ;SAVE/RETURN THE ADDRESS IN P1
MOVE S2,OBJADR ;[25]PICK UP THE OBJECT ADDRESS
SKIPN S2,OBJ.ND(S2) ;IF NO NODES,
JRST CHKO.2 ;[25]WIN,,CHECK FOR DN60 EMULATION
CAMN S2,[-1] ;[25]IF ALL NODES,
JRST CHKO.2 ;[25]THEN GO CHECK THE SCHEDULING BITS
CAMN S2,NETNAM(P1) ; OR IF WE MATCH BY NAME,
SKIPA ;THEN CHECK FOR DN60 EMULATION
CAMN S2,NETNBR(P1) ;IF WE MATCH BY NODE NUMBER,
SKIPA ;THEN CHECK FOR DN60 EMULATION
$RETF ;ELSE RETURN FALSE
MOVE S2,OBJADR ;[25]PICK UP THE OBJECT ADDRESS
MOVE S1,OBJ.TY(S2) ;[25]PICK UP THE OBJECT'S TYPE
;**;[55]At CHKO.1:+16L add 2 lines JCR 12/23/89
CAMN S1,[-1] ;[55]Is this for all units?
JRST CHKO.2 ;[55]Yes, pick up the scheduling bits
TXNN S1,.DQLPT!.LALPT ;[25]IS THIS A REMOTE PRINTER?
JRST CHKO.2 ;[25]NO, PICK UP THE SCHEDULING BITS
MOVEI S1,OBJ.SZ(S2) ;[25]PICK UP THE NAME BLOCK ADDRESS
MOVEI S2,OBJNAM(T1) ;[25]PICK UP OBJECT'S NAME BLOCK ADR
$CALL CHRNME## ;[25]CHECK IF THE NAMES ARE THE SAME
JUMPF .POPJ ;[25]NO, INDICATE TO THE CALLER
CHKO.2: MOVE S1,OBJSCH(T1) ;GET THE SCHEDULING BITS
TXNE S1,OBSSIP+OBSSUP ;IF SIP OR SETUP,,THEN
JRST CHKO.3 ; SKIP THIS CODE
TXNE S1,OBSSTA ;IF NOT STARTED,,THEN SKIP THIS CODE
SKIPE SHWTYP ;OR IF SHOWING PARAMETERS,,THEN
JRST CHKO.4 ; 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.3 ;ALL SET IF THERE WAS ONE
MOVX S1,%NOPRC ;GET "NO PROCESSOR" STATUS
MOVEM S1,OBJSTS(T1) ;NO - FIX UP STATUS
JRST CHKO.4 ;CONTINUE
CHKO.3: MOVE S1,OBJSTS(T1) ;GET CURRENT STATUS WORD
CAXE S1,%NOPRC ;WAS IT "NO PROCESSOR" ?
JRST CHKO.4 ;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.4: MOVE S1,P1 ;WE WANT TO RETURN NODE DB ADDR IN S1
LOAD S2,NETSTS(P1),NETSNA ;IS THIS AN SNA WORKSTATION STATION ???
JUMPN S2,CHKO.6 ; Yes, Go do it
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
SKIPE SHWTYP ;YES,,IS THIS 'SHOW STATUS' ???
$RETF ;NO,,JUST SKIP THIS OBJECT
CHKO.5: 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
;
; Here when we have an SNA workstation; only send one status request
; to the spooler since response includes all station devices
;
CHKO.6: SKIPE SHWTYP ; Is this 'SHOW STATUS' ?
$RETT ; Yes, don't send request to spooler
MOVE S1,OBJADR ; Get message obj block address
SKIPL OBJ.TY(S1) ; If no object specified (-1)
SKIPGE OBJ.UN(S1) ; or no specific unit specified
SKIPA ; do more checking
JRST CHKO.5 ; Otherwise, send message to spooler
MOVE S1,OBJTYP(T1) ; If -1 was specified
MOVE S2,OBJUNI(T1) ; then only send message to spooler
CAIN S1,.OTBAT ; if this is the master batch stream
CAIE S2,1
$RETF ; Return false, we don't want this one
JRST CHKO.5
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 ATTRIB ;INDICATE NO SPECIAL OBJECT ATTRIBUTES
;**;[60]At CHKQUE:+5L add 1 line PMM 6/3/90
SETZM AKHEAD ;[60]Indicate no alias header
PUSH P,T1 ;SAVE THE CURRENT OBJECT ADDRESS
CHKQ.1: MOVE S1,OBJNOD(T1) ;GET THE OBJECT'S 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
;**;[60]At CHKQ.1:+8L add 1 line PMM 6/3/90
LOAD S1,OBJTYP(T1),RHMASK ;[60]Get object type
CAIE S1,.OTBAT ;IS IT BATCH ?
JRST CHKQ.2 ;NO
LOAD S1,OBJDAT(T1),RO.ATR ;GET ATTRIBUTE FIELD
CAXN S1,%SITGO ;SITGO ??
SETOM ATTRIB ;YES
;**;[60]At CHKQ.2:+0L add 8 lines PMM 6/3/90
CHKQ.2: CAIE S1,.OTLPT ;[60]Is this a printer?
JRST CHKQ2A ;[60]No, ignore alias processing
SKIPL AKHEAD ;[60]Skip, if alias header already set
SKIPN S1,OBJALI(T1) ;[60]Is the alias name empty?
JRST CHKQ2A ;[60]No, need to check object
$CALL CHKOBJ ;[60]Is this object in display?
SKIPF ;[60]No
SETOM AKHEAD ;[60]Yes, set alias header for later
CHKQ2A: LOAD T1,.QELNK(T1),QE.PTN ;GET THE NEXT OBJECT IN THE CHAIN
JUMPE T1,CHKQ.3 ;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.3: POP P,T1 ;RESTORE T1 TO ORIGIONAL OBJ ADDRESS
LOAD S1,OBJNAM(T1),AR.TYP ;[25]PICK UP REMOTE NAME BLOCK TYPE
HRRZ S2,T2 ;[25]PICK UP THE OBJECT TYPE
CAIE S2,.OTLPT ;[33]IS THIS A LPT OBJECT?
JRST CHKQ3A ;[33]NO, SO OUTPUT THE HEADER
CAIN S1,.KYSER ;[25]IS IT A SERVICE NAME?
AOS SERNAM ;[25]YES, REMEMBER ONE HAS BEEN SEEN
AOSE LPTHDR ;[25]HEADER PRINTED ALREADY?
JRST CHKQ3B ;[25]YES, DON'T PRINT IT AGAIN
CHKQ3A: PUSHJ P,CRLF ;[33]OUTPUT A CRLF
MOVE S1,SHWTYP ;GET THE 'SHOW' TYPE
$TEXT (DEPBYT,<^1/S2/^T/@STAPAR(S1)/>) ;[25]GEN THE HEADING
CHKQ3B: CAIE T2,.OTBAT ;[25]IS THIS BATCH?
JRST CHKQ.5 ;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 CHKQ.4 ;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
CHKQ.4: $ASCII (< Minutes Prio >) ;START HEADING
IFN INPCOR,< $ASCII (< Core >) > ;PUT OUT 'CORE'
$ASCII (<Opr-Intvn>) ;PUT OUT OPR-INTERVENTION HEADING
SKIPE ATTRIB ;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
$ASCII (<------------- ----- >) ;OUTPUT SOME UNDERLINES
IFN INPCOR,< $ASCII (<------- >) > ;'CORE' UNDERLINE
$ASCII (<--------->) ;OPR-INTERVENTION UNDERLINE
SKIPE ATTRIB ;NEED TO LIST ATTRIBUTES ?
$ASCII (< ---------->) ;YES
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;OUTPUT QUEUE 'SHOW STATUS' HEADINGS
CHKQ.5: $CALL CRLF ;[51]START A NEW LINE
CAIE S2,.OTLPT ;[51]IS THIS A LPT?
JRST CHKQ18 ;[51]NO, OTHER TYPE OF OUTPUT
TXNE T2,.CLLPT ;[51]IS THIS A CLUSTER LPT?
JRST CHKQ10 ;[51]YES, GO BUILD ITS HEADER
TXNE T2,.DQLPT ;[51]IS THIS A DQS LPT?
JRST CHKQ12 ;[51]YES, GO BUILD ITS HEADER
TXNE T2,.LALPT ;[51]IS THIS A LAT LPT?
JRST CHKQ14 ;[51]YES, GO BUILD ITS HEADER
;Local (or IBM) printer status
SKIPN REMOTE ;[51]ANY IBM PRINTERS?
$ASCII (<Local printers>) ;[51]NO, SO INDICATE ONLY LOCAL
SKIPE REMOTE ;[51]ANY IBM PRINTERS?
;**;[56]At CHKQ.5:+15L change 1 line JCR 12/25/89
$ASCII (<Local/IBM/SNA printers>);[56]Yes, so indicate
$CALL CRLF ;[51]START A NEW LINE
;**;[60]AT CHKQ.5:+13L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< Alias >) ;[60]Output Alias field
$ASCII (< Unit >) ;[51]OUTPUT THE UNIT FIELD
SKIPE REMOTE ;[51]ANY IBM PRINTERS?
$ASCII (< Node >) ;[51]YES, NEED A NODE FIELD
SKIPE SHWTYP ;[51]SHOW STATUS?
JRST CHKQ.6 ;[51]NO, SHOW PARAMETER
$ASCII (< Status >) ;[51]OUTPUT THE STATUS FIELD
SKIPE ACTIVE ;[51]ANY ACTIVE JOBS?
$ASCII (<Jobname Req# User>) ;[51]YES
$CALL CRLF ;[51]END THIS LINE
;**;[60]At CHKQ.5:+24L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---- >) ;[51]UNDERLINE THE UNIT FIELD
SKIPE REMOTE ;[51]ANY IBM PRINTERS?
$ASCII (<------ >) ;[51]YES, UNDERLINE THE NODE FIELD
$ASCII (<-------------- >) ;[51]UNDERLINE THE STATUS FIELD
SKIPE ACTIVE ;[51]ANY ACTIVE JOBS?
$ASCII (<------- ---- --------------------->) ;[51]
PJRST CRLF ;[51]END THIS LINE AND RETURN
;Local (or IBM) printer parameters
CHKQ.6: MOVE S2,OBTYPE ;[51]PICK UP THE OBJECT TYPE
MOVE S1,LIMTYP(S2) ;[51]GET THE LIMIT DESCRIPTION ADDRESS
$CALL ASCOUT ;[51]PUT IT OUT
SKIPE G$LOGF## ;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
$ASCII (< Form Prio Lim-Ex Chars Logfile-Ena Dev-Chars>) ;[51]YES
SKIPN G$LOGF## ;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
$ASCII (< Form Prio Lim-Ex Chars Dev-Chars>) ;[51]NO
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ.6:+7L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---- >) ;[51]UNDERLINE THE UNIT FIELD
SKIPE REMOTE ;[51]ANY IBM PRINTERS?
$ASCII (<------ >) ;[51]YES, UNDERLINE THE NODE FIELD
SKIPE G$LOGF## ;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
$ASCII (<----------- ------ ----- ------ ------ ----------- --------->) ;[51]YES
SKIPN G$LOGF## ;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
$ASCII (<----------- ------ ----- ------ ------ --------->) ;[51]NO
PJRST CRLF ;[51]AND RETURN
;Cluster printer status
CHKQ10: $ASCII (<Cluster printers>) ;[51]OUTPUT THE PRINTER TYPE
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ10:+1L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< Alias >) ;[60]Output Alias field
$ASCII (< Unit Node >) ;[51]OUTPUT UNIT/NODE FIELDS
SKIPE SHWTYP ;[51]SHOW STATUS?
JRST CHKQ11 ;[51]NO, SHOW PARAMETER
$ASCII (<Status >) ;[51]OUTPUT THE STATUS FIELD
SKIPE ACTIVE ;[51]ANY ACTIVE REQUESTS
$ASCII (<Jobname Req# User>) ;[51]YES
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ10:+10L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---- ------ -------------- >) ;[60]UNDERLINE
SKIPE ACTIVE ;[51]ANY ACTIVE REQUESTS
$ASCII (<------- ----- ------------------------>) ;[51]YES
PJRST CRLF ;[51]AND RETURN
;Cluster printer parameters
CHKQ11: MOVE S2,OBTYPE ;[51]PICK UP THE OBJECT TYPE
MOVE S1,LIMTYP(S2) ;[51]GET THE LIMIT DESCRIPTION ADDRESS
$CALL ASCOUT ;[51]PUT IT OUT
;**;[60]At CHKQ11:+2L replace 2 lines with 6 lines PMM 6/3/90
$ASCII (< Prio Lim-Ex>) ;[60]Output the rest of the line
$CALL CRLF ;[60]Start a new line
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ ---- ------ ----------- ----- ------>) ;[60]
SKIPN AKHEAD ;[60]Is an alias header needed?
$ASCII (< ---- ------ ----------- ----- ------>) ;[60]
PJRST CRLF ;[51]AND RETURN
;DQS printer status
CHKQ12: $ASCII (<DQS printers>) ;[51]OUTPUT THE PRINTER TYPE
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ12:+1L replace 1 line with 4 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< Alias DQS queue name Node >) ;[60]
SKIPN AKHEAD ;[60]Is an alias header needed?
$ASCII (< DQS queue name Node >) ;[60]
SKIPE SHWTYP ;[51]SHOW STATUS?
JRST CHKQ13 ;[51]NO, SHOW PARAMETER
$ASCII (< Status >) ;[51]OUTPUT THE STATUS FIELD
SKIPE ACTIVE ;[51]ANY ACTIVE REQUESTS?
$ASCII (<Jobname Req# >) ;[51]YES
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ12:+10L replace 1 line with 4 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ ------------------------------ ------ --------------- >) ;[60]
SKIPN AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------------------------------ ------ --------------- >) ;[60]
SKIPE ACTIVE ;[51]ANY ACTIVE REQUESTS?
$ASCII (<------- ---- >) ;[51]YES
PJRST CRLF ;[51]AND RETURN
;DQS printer parameters
CHKQ13: $ASCII (< Page Limits Prio Lim-Ex>) ;[51]OUTPUT REST OF HEADER
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ13:+1L replace 1 line with 4 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ ----------------------------- ------ >) ;[60]Yes
SKIPN AKHEAD ;[60]Is an alias header needed?
$ASCII (< ----------------------------- ------ >) ;[60]No
$ASCII (<----------- ---- ------>) ;[51]
PJRST CRLF ;[51]AND RETURN
;LAT PORT printer status
CHKQ14: LOAD S1,OBJNAM(T1),AR.TYP ;[51]PICK UP NAME TYPE
CAIE S1,.KYPOR ;[51]IS IT A LAT PORT?
JRST CHKQ16 ;[51]NO, IT IS A LAT SERVICE
$ASCII (<LAT PORT printers>) ;[51]INDICATE THE LAT TYPE
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ14:+4L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< Alias >) ;[60]Output Alias field
$ASCII (< Port name Server >) ;[51]
SKIPE SHWTYP ;[51]IS THIS 'SHOW STATUS'?
JRST CHKQ15 ;[51]NO, MUST BE 'SHOW PARAMETERS'
$ASCII (< Status >) ;[51]STATUS HEADER
SKIPE ACTIVE ;[51]ANY ACTIVE JOBS?
$ASCII (<Jobname Req# User>) ;[51]YES
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ12:+13L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---------------- ------ --------------->)
SKIPE ACTIVE ;[51]ANY ACTIVE JOBS?
$ASCII (< ------- ---- ---->) ;[51]YES
PJRST CRLF ;[51]AND RETURN
;LAT PORT printer parameters
CHKQ15: $ASCII (<Page Limits Form Prio Lim-Ex >) ;[51]LAT PORT LPT HEADER
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ15:+1L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---------------- ------ >) ;[51]NAME AND NODE
$ASCII (<----------- ------ ---- ------>) ;[51]REST OF THE HEADER
PJRST CRLF ;[51]AND RETURN
;LAT SERVICE printer status
CHKQ16: $ASCII (<LAT SERVICE printers>) ;[51]INDICATE THE LAT TYPE
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ16:+1L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< Alias >) ;[60]Output Alias field
$ASCII (< Service name Server >) ;[51]
SKIPE SHWTYP ;[51]IS THIS 'SHOW STATUS'?
JRST CHKQ17 ;[51]NO, MUST BE 'SHOW PARAMETERS'
$ASCII (< Status >)
SKIPE ACTIVE ;[51]ANY ACTIVE JOBS?
$ASCII (<Jobname Req# User>) ;[51]YES
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ16:+10L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---------------- ------ --------------- >) ;[51]
SKIPE ACTIVE ;[51]ANY ACTIVE JOBS?
$ASCII (< ------- ---- ---->) ;[51]YES
PJRST CRLF ;[51]AN RETURN
;LAT SERVICE printer parameters
CHKQ17: $ASCII (<Page Limits Form Prio Lim-Ex >) ;[51]LAT SERVICE LPT HEADER
$CALL CRLF ;[51]START A NEW LINE
;**;[60]At CHKQ17:+1L add 2 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Is an alias header needed?
$ASCII (< ------ >) ;[60]Output Alias field
$ASCII (< ---------------- ------ >) ;[51]NAME
$ASCII (<----------- ------ ---- ------>) ;[51]REST OF THE HEADER
PJRST CRLF ;[51]AND RETURN
;All other types of output status
CHKQ18: $ASCII (< Unit >) ;[51]OUTPUT THE UNIT FIELD
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$ASCII (< Node >) ;[51]YES, OUTPUT THE NODE NAME FIELD
SKIPE SHWTYP ;[51]SHOW STATUS?
JRST CHKQ19 ;[51]NO, SHOW PARAMETERS
$ASCII (< Status >) ;[51]OUTPUT THE STATUS FIELD
SKIPE ACTIVE ;[51]ANY ACTIVE REQUESTS?
$ASCII (<Jobname Req# User>) ;[51]OUTPUT REST OF HEADER
$CALL CRLF ;[51]START A NEW LINE
$ASCII (< ---- >) ;[51]UNDERLINE THE UNIT FIELD
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$ASCII (< ------ >) ;[51]YES, UNDERLINE THE NODE NAME
$ASCII (<---------------- >) ;[51]UNDERLINE STATUS
SKIPE ACTIVE ;[51]ANY ACTIVE REQUESTS?
$ASCII (<------- ----- ------------------------>) ;[51]
PJRST CRLF ;[51]AND RETURN
;All other types of output parameters
CHKQ19: MOVE S2,OBTYPE ;[51]GET THE OBJECT TYPE
MOVE S1,LIMTYP(S2) ;[51]GET THE LIMIT DESCRIPTION ADDRESS
PUSHJ P,ASCOUT ;[51]PUT IT OUT
$ASCII (< Form Prio Lim-Ex Dev-Chars>) ;[51]
$CALL CRLF ;[51]START A NEW LINE
$ASCII (< ---- >) ;[51]'UNIT' UNDERLINE
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$ASCII (< ------ >) ;[51]YES, UNDERLINE ITS HEADING
$ASCII (<------------ ------ ----- ------ --------->) ;[51]
PJRST CRLF ;[51]AND RETURN
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.
SETZM REMUSR ;[41]REQUEST ORIGINATED LOCALLY
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: $QACK (<No routing has been performed>,,,ACKCOD) ;TELL OPR
$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.5 ;NO MORE,,GO FINISH UP
MOVE S1,NETCOL(P1) ;GET THIS NODES NAME/NUMBER
PUSHJ P,CMPNOD ;IS IT ONE WE WANT ???
JUMPF NPRM.3 ;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.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)/^T12/@IBMODE(T2)/^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 T3,NETSTS(P2),NT.TOU ;Get protocol timeout cat.
LOAD T4,NETSTS(P2),NT.TRA ;GET 'TRANSPARENCY'
$TEXT (DEPBYT,< ^O4/NETPTL(P2),NT.PRT/ ^D4/NETPTL(P2),NT.LIN/ ^T/@IBMDTR(T4)/ ^D5/NETCSD(P2)/ ^D5/NETRPM(P2)/ ^D5/NETBPM(P2)/ ^T/@IBMTIM(T3)/>)
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
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 ???
$QACK (<No IBM remotes in system network>,,,.MSCOD(M))
PJRST NPRSNA ;Go look for SNA-Workstations
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
$CALL SENDIT
MOVE S2,NODE6B ;Get the node we asked for
CAMN S2,[-1] ;Did we ask for all nodes?
PJRST NPRSNA ;Go look for SNA-Workstations
$RETT ;No, we are finished
SUBTTL NPRSNA - ROUTINE TO DISPLAY SNA-WORKSTATION NETWORK PARAMETERS
NPRSNA: SETOM JOBNBR ;SET NODE COUNT TO -1
LOAD P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
NPRS.1: JUMPE P1,NPRS.5 ;NO MORE,,GO FINISH UP
MOVE S1,NETCOL(P1) ;GET THIS NODES NAME/NUMBER
PUSHJ P,CMPNOD ;IS IT ONE WE WANT ???
JUMPF NPRS.3 ;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),NETSNA ;GET THIS ONES TYPE DESIGNATION
JUMPE S1,NPRS.3 ;NOT SNA,,SKIP THIS STUFF
AOSG JOBNBR ;BUMP NODE COUNT.
PUSHJ P,NPSHDR ;FIRST TIME,,SET UP THE HEADER
PUSHJ P,CHKLIN ;Check to see if next line fits
$TEXT (DEPBYT,<^T11/NETASC(P2)/ ^W9/NETGWY(P2)/ ^T11/NETACC(P2)/^A>)
LOAD T1,NETNAB(P2),NA.ADR ;Get the NAB address
JUMPE T1,NPRS.2 ;Continue on if none
$TEXT (DEPBYT,< ^T11/NABPLU(T1)/ ^T7/NABCIR(T1)/ ^T10/NABLOM(T1)/^A>)
MOVE T2,NABCHS(T1) ; Start of character set
SKIPE T2 ; Skip if node specified
$TEXT (DEPBYT,<^M^J Character set: ^T/NABCHS(T1)/^A>)
NPRS.2: PUSHJ P,CRLF ;END THE LINE
NPRS.3: LOAD P1,.QELNK(P1),QE.PTN ;GET THE NEXT ENTRY
JRST NPRS.1 ;AND CONTINUE
NPRS.5: AOS S1,JOBNBR ;GET THE NODE COUNT IN S1
MOVE S2,NODE6B ;GET THE NODE WE ASKED FOR
JUMPG S1,NPRS.6 ;WE HAD A MATCH SOMEWHERE !!!
CAMN S2,[-1] ;DID WE ASK FOR ALL NODES ???
$QACK (<No SNA-Workstations in system network>,,,.MSCOD(M))
CAME S2,[-1] ;DID WE ASK FOR ALL NODES ???
$QACK (<Node ^N/NODE6B/ is neither an IBM remote nor an SNA-Workstation>,,,.MSCOD(M))
$RETT
NPRS.6: CAIN S1,1 ;IS THERE 1 NODE ???
$ASCII (<There is 1 SNA-Workstation defined in the network>)
CAILE S1,1 ;IS THERE MORE THEN 1 ???
$TEXT(DEPBYT,<There are ^D/JOBNBR/ SNA-Workstations 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 Port Line Trans CSD RPM BPM Timeout>)
PUSHJ P,CRLF ;END THE LINE
$ASCII (<-------------- ----------------- ---- ---- ----- ----- ----- ----- ------->)
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
;
; Header for SNA-Workstations
;
NPSHDR: MOVEI S1,[ASCIZ/ SNA Workstation Parameters /] ;GET THE HEADING.
PUSHJ P,SETPAG ;SET UP AN OUTPUT PAGE.
PUSHJ P,CRLF ;OUTPUT A CRLF.
$ASCII (<Workstation Gateway Access Name Application Circuit Logon Mode>)
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
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),NETSNA ; Is it an SNA Workstation?
SKIPE S1 ; No, go try others
$TEXT (DEPBYT,< (SNA Workstation)^A>) ; Yes, put out SNA indication
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
$QACK (<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
$QACK (<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
$QACK (<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
$QACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,< as Station ^N/NETLOC(P1)/>,,.MSCOD(M))
$RETT ;Return
NSTS.8: $QACK (<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) ;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 S1,.UCBVS(P1) ;GET VSL ADDRESS JUST IN CASE
JRST STAP.5 ;NO OWNER,,SKIP THIS
MOVE AP,.VSMDR(S1) ;GET THE OWNER MDR ADDRESS
LOAD S1,.MRJOB(AP),MD.PJB ;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,<^D6R /.QERID(S2)/ ^I/MNTUSR/ ^15/.MRFLG(AP),MR.QUE/^A>)
TXNN S1,BA%JOB ;OWNED BY A NORMAL REQUEST ???
$TEXT(DEPBYT,<^D6R /.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
$QACK (<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
$QACK (<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,<^W7/.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
$QACK (<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)/ ^W5R/.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
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
$QACK (<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>
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 S1,0(P2) ;AIM AT THE VSL
SKIPN S1,.VSMDR(S1) ;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),MD.PJB ;Get the job number
TXZN S2,BA%JOB ;PSEUDO PROCESS ???
JRST SUSR.2 ;NO,,SKIP THIS
$TEXT (<-1,,G$MSG>,< (^15/.MRFLG(P4),MR.QUE/^0)>) ;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
>;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)
$STOP (NUV,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>) ;START THE HEADING
SKIPE REMOTE ;ANY VOLUMES MOUNTED ???
$ASCII (< Write Volume>) ;YES,,ADD TO THE HEADER
SKIPE ACTIVE ;ANY VOLUME OWNED ???
$ASCII (< Job# 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 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: 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 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
TOPS20< PUSHJ P,SMTDEN > ;DISPLAY DENSITY
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.8 ;NO REQUESTS,,RETURN NOW
SETOM QEMPTY ;INDICATE THE QUEUES ARE NOT EMPTY
SKIPN LISTYP ;IS THIS A FAST LISTING ???
JRST SMNT.8 ;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.8: 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
TXNN P1,VL.ASN ;DOES THE USER HAVE IT MOUNTED ???
JRST SMTS.1 ;NO,,MAKE IT WAITING
LOAD T1,.VLFLG(P2),VL.STA ;GET THE VOLUME STATUS
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
CAXN T1,%STAWT ;IS IT 'WAITING' ???
SMTS.1: $ASCII (<Waiting >) ;YES,,SAY SO
POPJ P, ;RETURN
; MOUNT display type output
;
SMTTYP: LOAD T1,.VSFLG(P1),VS.TYP ;GET THE VOLUME-SET TYPE
CAXN T1,%TAPE ;IS IT 'TAPE' ???
$ASCII (<Tape >) ;YES
CAXE T1,%DSMT ;IS IT A STRUCTURE DISMOUNT ???
CAXN T1,%DISK ;OR IS IT 'DISK' ???
$ASCII (<Disk >) ;YES
CAXE T1,%DTAP ;IS IT DECTAPE ???
CAXN T1,%UNKN ;OR 'UNKNOWN' DEVICE ?
$ASCII (< >) ;YES,,JUST PUT OUT BLANKS
$RETT ;RETURN
; MOUNT display tape density
;
TOPS20<
SMTDEN: LOAD T1,.VSFLG(P1),VS.TYP ;GET VOLUME SET TYPE
CAXE T1,%TAPE ;IS IT TAPE?
JRST [$ASCII (< >) ;NO, OUTPUT BLANKS
$RETT] ;AND RETURN
LOAD S1,.VSATR(P1),VS.DEN ;GET POINTER TO DENSITY
$TEXT (DEPBYT,<^T4/@DENSTY(S1)/ ^A>) ;OUTPUT DENSITY
$RETT
> ; End of TOPS20
; 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),MD.PJB ;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),VS.RID/ ^D4R /S1/ ^T20/G$MSG/ ^15/.MRFLG(AP),MR.QUE/>)
POPJ P, ;RETURN
SMTD.1: $TEXT (DEPBYT,<^D6R /.VSRID(P1),VS.RID/ ^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
CAXN T1,%DISK ;STRUCTURE ???
JRST SMNA.1 ;YES,,SKIP THIS
CAXN T1,%TAPE ;MAGTAPE ?
JRST [
MOVE T1,LISTYP ;Get volume set name
JUMPLE T1,SMNA.1 ;Only if all
LOAD T1,.VSFLG(P1),VS.LBT ;Get the label type
CAIN T1,%UNLBL ;Unlabeled?
$TEXT (DEPBYT,< Volume-set: ^T/.VSVSN(P1)/ Tape is unlabeled>)
CAIE T1,%UNLBL ;Labeled?
$TEXT (DEPBYT,< Volume-set: ^T/.VSVSN(P1)/ Tape is labeled>)
$TEXT (DEPBYT,< Volumes in this set: ^A>)
LOAD T1,.VSCVL(P1),VS.CNT ;Number of volumes in set
MOVEI T3,.VSVOL(P1) ;Get current VOL adr.
ADD T3,T1 ;Point to 1st vol. name
$TEXT (DEPBYT,<^W9/.VLNAM(T3)/^A>) ;Print it
SOJLE T1,LSTVL3 ;Finished if no more vols
SUB T3,T1 ;Point to 2nd VOL adr.
IMULI T1,-1 ;Make it into a
HRLZ T1,T1 ;AOBJN counter
HRR T1,T3 ;Finish the AOBJN counter
MOVEI T2,VOLLIN-1 ;Max number of vol/line
LSTVL1: MOVE S1,0(T1) ;Get its address
$TEXT(DEPBYT,<^W9/.VLNAM(S1)/^A>)
SOJG T2,LSTVL2 ;Any room left?
MOVEI T2,VOLLIN ;Reset max. number
$TEXT(DEPBYT,< ^A>)
LSTVL2: AOBJN T1,LSTVL1 ;Get the next name
LSTVL3: $TEXT(DEPBYT,< >) ;Leave this line
JRST SMNA.1 ] ;AND SKIP THIS
TOPS10<
MOVE S1,P1 ;GET THE VSL ADDRESS
PUSHJ P,I$CGEN## ;GET TRANSLATION INDEX
$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.SCR!VS.NEW ;ARE THE SCRATCH OR NEW BITS 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 ;YES
$TEXT (DEPBYT,< Initialize new tape with volume-id: ^W/.VLNAM(P2)/ protection: ^O3/.VSATR(P1),VS.PRT/>)
> ;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
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
TOPS10<
$ASCII (<Volume Status Type Write Req# Job# User>)
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<------- -------- ---- ------- ------ ---- ------------------->)
> ;End of TOPS10
TOPS20<
$ASCII (<Volume Status Type Dens Write Req# Job# User>)
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<------- -------- ---- ---- ------- ------ ---- ------------------->)
> ;End of TOPS20
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),AR.TYP ;[25]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.
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
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)
SKIPN S1,USRNAM ;[41]USER NAME BLOCK PRESENT?
JRST PUTO.1 ;[41]NO, MUST BE A LOCAL REQUEST
MOVEI S2,.QEOWN(AP) ;[41]PICK UP USER NAME ADDRESS
HRLI S2,(POINT 7,) ;[41]MAKE INTO A POINTER
$CALL S%SCMP ;[41]CHECK FOR A MATCH
TXNE S1,SC%LSS!SC%SUB!SC%GTR ;[41]INCLUDE THIS ONE?
$RETF ;[41]NO, RETURN NOW
JRST PUTO.2 ;[41]CHECK THE JOB NAME
PUTO.1: MOVE S2,.QEOID(AP) ;[41]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
PUTO.2: MOVE S2,.QEJOB(AP) ;[41]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: SKIPE NOROOM ;IS THERE STILL ROOM IN THE OUTPT PAGE ?
PUSHJ P,PAGOVF ;NO,,KLEEN UP A BIG MESS.
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.
POPJ P, ;RETURN TRUE OR FALSE
SUBTTL SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATUS COMMAND.
;**;[53]At SHSTAT:+0L add 1 line JYCW 6/20/88
SHSTAT: PUSHJ P,CHKLIN ;[53]Check to see if next line fits
MOVE S2,OBJTYP(T1) ;[51]PICK UP THE OBJECT TYPE
HRRZ S1,S2 ;[51]ISOLATE THE MAJOR PART
CAIN S1,.OTBAT ;[51]IS IT BATCH?
JRST SHST.1 ;[51]YES, OUTPUT ITS STATUS
CAIN S1,.OTLPT ;[51]IS IT A LPT?
JRST SHST.2 ;[51]YES, OUTPUT ITS STATUS
;Non-batch and non-LPT objects
$TEXT (DEPBYT,< ^D4R/OBJUNI(T1)/ ^A>) ;[51]OUTPUT THE UNIT
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$TEXT (DEPBYT,< ^N6R/OBJNOD(T1)/ ^A>) ;[51]PUT OUT THE NODE NAME
LOAD S1,OBJSTS(T1) ;[51]GET THIS OBJECT'S STATUS CODE
$TEXT (DEPBYT,<^T15L /@OBJSTC(S1)/ ^A>) ;[51]OUTPUT THE STATUS
$CALL GTQUEE ;[51]PICK UP AN ACTIVE QE
JUMPF CRLF ;[51]IF NONE, END THIS LINE
$TEXT (DEPBYT,< ^W6L /.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>) ;[51]
JRST SHST.6 ;[51]CHECK FOR A FAST LISTING
;Batch objects
SHST.1: LOAD S1,OBJSTS(T1) ;[51]GET THIS OBJECT'S STATUS CODE
;**;[53]At SHST.1:+1L add 5 lines JYCW 6/20/88
$TEXT (DEPBYT,< ^D4R /OBJUNI(T1)/ ^A>) ;[53]Put out UNIT/STREAM #
SKIPE REMOTE ;[53]Any remote stations ???
$TEXT (DEPBYT,<^N10R /OBJNOD(T1)/ ^A>) ;[53]Put out the node name
LOAD S1,OBJSTS(T1) ;[53]GET THIS OBJECT'S STATUS CODE
$TEXT (DEPBYT,<^T15L /@OBJSTC(S1)/ ^A>) ;[53]OUTPUT THE STATUS
$CALL GTQUEE ;[51]PICK UP AN ACTIVE QE
JUMPF CRLF ;[51]IF NONE, END THIS LINE
$TEXT (DEPBYT,<^W6L/.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>) ;[51]
JRST SHST.6 ;[51]CHECK FOR A FAST LISTING
;LPT objects
SHST.2: LOAD S1,OBJSTS(T1) ;[51]GET THIS OBJECT'S STATUS CODE
TXNN S2,.DQLPT ;[51]IS THIS A DQS LPT?
JRST SHST.3 ;[51]NO, CHECK FOR A CLUSTER LPT
;**;[60]At SHST.2:+2L add 3 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we need an alias field?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^T31R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^T15L/@OBJSTC(S1)/ ^A>) ;[60]
SKIPL AKHEAD ;[60]Do we need an alias field?
$TEXT (DEPBYT,< ^T31R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^T15L/@OBJSTC(S1)/ ^A>) ;[51]
$CALL GTQUEE ;[51]PICK UP AN ACTIVE QE
JUMPF CRLF ;[51]IF NONE, END THIS LINE
$TEXT (DEPBYT,<^W6L/.QEJOB(AP)/ ^D6/.QERID(AP)/^M^J User:^I/USR/^A>)
JRST SHST.6 ;[51]CHECK FOR A FAST LISTING
SHST.3: TXNN S2,.CLLPT ;[51]IS THIS A CLUSTER LPT?
JRST SHST.4 ;[51]NO, CHECK FOR A LAT LPT
;**;[60]At SHST.3:+2L add 3 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we need an alias field?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^D4R/OBJUNI(T1)/ ^N6R/OBJNOD(T1)/ ^T15L/@OBJSTC(S1)/ ^A>) ;[60]
SKIPN AKHEAD ;[60]Do we need an alias field?
$TEXT (DEPBYT,< ^D4R/OBJUNI(T1)/ ^N6R/OBJNOD(T1)/ ^T15L/@OBJSTC(S1)/ ^A>) ;[51]
$CALL GTQUEE ;[51]PICK UP AN ACTIVE QE
JUMPF CRLF ;[51]IF NONE, END THIS LINE
$TEXT (DEPBYT,<^W6L/.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>) ;[51]
JRST SHST.6 ;[51]CHECK FOR A FAST LISTING
SHST.4: TXNN S2,.LALPT ;[51]IS THIS A LAT LPT?
JRST SHST.5 ;[51]NO, IT MUST BE LOCAL
;**;[60]At SHST.4:+1L replace 1 line with 4 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we need an alias field?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^T16R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^T15L/@OBJSTC(S1)/ ^A>) ;[60]
SKIPN AKHEAD ;[60]Do we need an alias field?
$TEXT (DEPBYT,< ^T16R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^T15L/@OBJSTC(S1)/ ^A>) ;[60]
$CALL GTQUEE ;[51]PICK UP AN ACTIVE QE
JUMPF CRLF ;[51]IF NONE, END THIS LINE
$TEXT (DEPBYT,<^W6L/.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>)
JRST SHST.6 ;[51]CHECK FOR A FAST LISTING
;**;[60]At SHST.5:+0L replace 1 line with 4 lines PMM 6/3/90
SHST.5: SKIPE AKHEAD ;[60]Do we need an alias name?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^D4R/OBJUNI(T1)/ ^A>) ;[60]Yes
SKIPN AKHEAD ;[60]Do we want no alias?
$TEXT (DEPBYT,< ^D4R/OBJUNI(T1)/ ^A>) ;[60]No, output the unit
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$TEXT (DEPBYT,<^N6R/OBJNOD(T1)/ ^A>) ;[51]PUT OUT THE NODE NAME
LOAD S1,OBJSTS(T1) ;[51]GET THIS OBJECT'S STATUS CODE
$TEXT (DEPBYT,<^T15L /@OBJSTC(S1)/ ^A>) ;[51]OUTPUT THE STATUS
$CALL GTQUEE ;[51]PICK UP AN ACTIVE QE
JUMPF CRLF ;[51]IF NONE, END THIS LINE
$TEXT (DEPBYT,<^W6L/.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>) ;[51]
SHST.6: SKIPN LISTYP ;[51]IF THIS IS A FAST LISTING, THEN
$RETT ;[51]SKIP THE JOB STATUS DISPLAY
$ASCII (< >) ;[51]INSERT A <TAB>
MOVEI S1,OBJST1(T1) ;[51]GET THE JOBS STATUS DESCRIPTION ADDR
$CALL ASCOUT ;[51]PUT IT OUT
PJRST CRLF ;[51]AND RETURN
SUBTTL GTQUEE - PICK UP AN ACTIVE QE ENTRY FOR SHOW STATUS COMMAND
;[51]GTQUEE determines if the current object whose status is being displayed
;[51]has an active QE associated with it.
;[51]
;[51]Call is: T1/Object address
;[51]Returns true: The object is processing a request
;[51] AP/Address of the active QE
;[51]Returns false: The object is not processing a request
GTQUEE: LOAD S1,OBJSCH(T1) ;[51]PICK UP THE SCHEDULING WORD
TXNN S1,OBSBUS ;[51]IS THIS OBJECT BUSY?
$RETF ;[51]NO, INDICATE SO
LOAD S1,OBJITN(T1) ;[51]GET THE CONTROLLING JOB
PUSHJ P,Q$SUSE## ;[51]FIND THE JOB IN THE USE QUEUE
JUMPF .POPJ ;[51]SHOULD NOT HAPPEN
MOVE AP,S1 ;[51]GET THE QUEUE ENTRY ADDRESS
$RETT ;[51]INDICATE SUCCESS
SUBTTL SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND.
;**;[53]At SHPARM:+0L add 1 line JYCW 6/20/88
SHPARM: PUSHJ P,CHKLIN ;[53]Check to see if next line fits
MOVE S1,OBTYPE ;GET THE OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
JRST SHPA.1 ;NO,,GO TRY SOMETHING ELSE
$TEXT (DEPBYT,< ^D4R /OBJUNI(T1)/ ^A>) ;[52]Put out UNIT/STREAM #
SKIPE REMOTE ;[52]Any remote stations ???
$TEXT (DEPBYT,<^N10R /OBJNOD(T1)/ ^A>) ;[52]Put out the node name
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,<^D3R /S1/:^D3L /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
SKIPN ATTRIB ;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: PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
SHPA.1: LOAD S1,OBJSCH(T1),OBSSNA ; Is this for SNA Workstation?
JUMPE S1,SHPA.2 ; No, continue on
PUSHJ P,.SAVE1 ; Yes, save P1
MOVE P1,T1 ; Save object address in P1
MOVE S1,OBJNOD(T1) ; Get the node name
PUSHJ P,N$NODE## ; Find data base entry
MOVE S1,NETNOB(S2) ; Get NOB list index
PUSHJ P,FNDNOB## ; Get the NOB
SKIPF ; Failed?
PUSHJ P,DSPDST ; Go display destination field
MOVE T1,P1 ; Restore object address
PJRST CRLF ; Finish off line and return
SHPA.2: LOAD S1,OBJPRM+.OOLIM(T1),OBPMIN ;GET MIN OUTPUT LIMIT
LOAD S2,OBJPRM+.OOLIM(T1),OBPMAX ;GET MAX OUTPUT LIMIT
LOAD T3,OBJPRM+.OOPRI(T1),OBPMIN ;GET MIN PRIORITY
LOAD T4,OBJPRM+.OOPRI(T1),OBPMAX ;GET MAX PRIORITY
LOAD T2,OBJPRM+.OOFRM(T1) ;[51]GET THE FORMS TYPE
$SAVE <P1> ;[51]SAVE THIS AC
MOVE P1,OBJTYP(T1) ;[51]PICK UP THE OBJECT TYPE
TXNN P1,.DQLPT ;[51]A DQS LPT?
JRST SHPA.3 ;[51]NO, CHECK FOR A CLUSTER LPT
;**;[60]At SHPA.2:+9L replace 1 line with 3 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we want to include an alias?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^T31R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[60]Yes
SKIPN AKHEAD ;[60]Do we want no alias?
$TEXT (DEPBYT,<^T31R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[60]No
$CALL LIMEXC ;[51]PICK UP LIMIT EXCEEDED ACTION
PJRST CRLF ;[51]AND RETURN
SHPA.3: TXNN P1,.CLLPT ;[51]A CLUSTER LPT?
JRST SHPA.4 ;[51]NO, CHECK FOR A LAT LPT
;**;[60]At SHPA.3:+2L replace 1 line with 4 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we need an alias?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^D4R/OBJUNI(T1)/ ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[60]Yes
SKIPN AKHEAD ;[60]Do we need an alias?
$TEXT (DEPBYT,< ^D4R/OBJUNI(T1)/ ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[60]No
$CALL LIMEXC ;[51]PICK UP LIMIT EXCEEDED ACTION
PJRST CRLF ;[51]AND RETURN
SHPA.4: TXNN P1,.LALPT ;[51]A LAT LPT?
JRST SHPA.5 ;[51]NO, CHECK FOR A LOCAL LPT
;**;[60]At SHPA.4:+2L replace 1 line with 4 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we need an alias?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^T16R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^W6L/T2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[60]Yes
SKIPN AKHEAD ;[60]Do we want no alias?
$TEXT (DEPBYT,< ^T16R/OBJNAM+ARG.DA(T1)/ ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^W6L/T2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[60]No
$CALL LIMEXC ;[51]PICK UP LIMIT EXCEEDED ACTION
PJRST CRLF ;[51]AND RETURN
SHPA.5: HRRZS P1 ;[51]ISOLATE MAJOR LPT TYPE
CAIE P1,.OTLPT ;[51]IS THIS A LOCAL LPT?
JRST SHPA.7 ;[51]NO, OTHER TYPE OF OUTPUT
;**;[60]At SHPA.5:+3L replace 1 line with 3 lines PMM 6/3/90
SKIPE AKHEAD ;[60]Do we need an alias?
$TEXT (DEPBYT,< ^W6R/OBJALI(T1)/ ^D4R/OBJUNI(T1)/^A>) ;[60]Yes
SKIPN AKHEAD ;[60]Do we need an alias?
$TEXT (DEPBYT,< ^D4R/OBJUNI(T1)/^A>) ;[60]No, output the unit only
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$TEXT (DEPBYT,< ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/^W6L/T2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[51]
SKIPN REMOTE ;[51]ANY REMOTE STATIONS?
$TEXT (DEPBYT,< ^D5R/S1/:^D6L/S2/^W6L/T2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[51]
$CALL LIMEXC ;[51]PICK UP LIMIT EXCEEDED ACTION
SKIPN S1,OBJTCR(T1) ;[51]TERMINAL CHARACTERISTICS?
$ASCII (< >) ;[51]NO, LEAVE BLANK
SKIPE S1 ;[51]TERMINAL CHARACTERISTICS?
$TEXT (DEPBYT,<^W6L/S1/^A>) ;[51]DISPLAY THE CHARACTERISTICS
SKIPN G$LOGF## ;[51]SPECIFIC LOG/SPOOL LPT ENA?
JRST SHPA.6 ;[51]NO, CHECK FOR ATTRIBUTES
LOAD S1,OBJSC2(T1),OB2LOG ;[51]PICK UP THE PRINT-LOG BIT
SKIPE S1 ;[51]ENABLED?
$ASCII (< Yes >) ;[51]YES, INDICATE SO
SKIPN S1 ;[51]ENABLED?
$ASCII (< No >) ;[51]NO, INDICATE SO
SHPA.6: $CALL DEVATR ;[51]PICK UP THE DEVICE ATTRIBUTES
LOAD S1,OBJSCH(T1),OBSSPL ;[51]GET THE SPOOLING TO TAPE BIT
SKIPE S1 ;[51]ARE WE SPOOLING TO TAPE?
$TEXT (DEPBYT,< ^W/OBJPRM+.OOTAP(T1)/:^A>) ;[51]YES, SAY SO
PJRST CRLF ;[51]END THE LINE AND RETURN
SHPA.7: $TEXT (DEPBYT,< ^D4R/OBJUNI(T1)/ ^A>) ;[51]OUTPUT THE UNIT
SKIPE REMOTE ;[51]ANY REMOTE STATIONS?
$TEXT (DEPBYT,< ^N6R/OBJNOD(T1)/ ^D5R/S1/:^D6L/S2/ ^W6L/T2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[51]
SKIPN REMOTE ;[51]ANY REMOTE STATIONS?
$TEXT (DEPBYT,<^D5R/S1/:^D6L/S2/ ^W6L/T2/ ^D2R/T3/:^D2L/T4/ ^A>) ;[51]
$CALL LIMEXC ;[51]GET THE LIMIT-EXCEEDED ACTION
$CALL DEVATR ;[51]GET THE DEVICE-ATTRIBUTES
PJRST CRLF ;[51]AND RETURN
SUBTTL LIMEXC - LIMIT EXCEEDED ACTION FOR SHOW PARAMETERS
;[51]LIMEXC is called to place the limit exceeded action in the SHOW
;[51]PARAMETERS display of an object
;[51]
;[51]Call is: T1/Object address
;[51]Returns: Always
LIMEXC: LOAD S1,OBJPRM+.OOFLG(T1),.OFLEA ;[51]GET LIMIT EXCEEDED ACTION
CAIN S1,.STIGN ;[51]IS IT 'IGNORE'?
$ASCII (<Proceed >) ;[51]YES, SAY SO
CAIN S1,.STCAN ;[51]IS IT 'CANCEL'?
$ASCII (<Abort >) ;[51]YES, SAY SO
CAIN S1,.STASK ;[51]IS IT ASK?
$ASCII (<Ask >) ;[51]YES, SAY SO
$RET ;[51]RETURN TO THE CALLER
SUBTTL DEVATR - DEVICE ATTRIBUTES FOR SHOW PARAMETERS
;[51]DEVATR is called to place the device attributes for the SHOW
;[51]PARAMETERS display of an object
;[51]
;[51]Call is: T1/Object address
;[51]Returns: Always
DEVATR: LOAD S1,OBJDAT(T1),RO.ATR ;[51]GET THE DEVICE ATTRIBUTES
CAIN S1,%LOWER ;[51]IS IT LOWER CASE?
$ASCII (< Lower>) ;[51]YES, SAY SO
CAIN S1,%UPPER ;[51]IS IT UPPER CASE?
$ASCII (< Upper>) ;[51]YES, SAY SO
$RET ;[51]AND RETURN
SUBTTL DSPDST - DISPLAY SNA PRINTER / PUNCH DESTINATION PARAMETER
; S1/ address of object entry in NOB list
DSPDST: $TEXT (DEPBYT,< Destination: ^A>)
MOVEI S2,NOBDST(S1) ; Address of destination string
HRLI S2,(POINT 7) ; Make it a pointer
DSP.1: ILDB S1,S2 ; Get a byte
JUMPE S1,.RETT ; If null, all done
$CALL DEPBYT ; Move to message
CAIE S1,"""" ; See if quote
JRST DSP.1 ; Keep looking for a "
; Start of acess string found
DSP.2: ILDB S1,S2 ; Get a byte
JUMPE S1,.RETT ; If null, all done
$CALL DEPBYT ; Move to message
CAIE S1," " ; See if space
JRST DSP.2 ; Keep looking for a space
$TEXT (DEPBYT,<password"^A>) ; Fill in password field
DSP.3: ILDB S1,S2 ; Get a byte
JUMPE S1,.RETT ; If null, all done
CAIE S1,"""" ; See if quote
JRST DSP.3 ; Keep looking for a quote
$TEXT (DEPBYT,<^Q/S2/^A>) ; Finish off string
$RET
SUBTTL DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.
DEPOUT: SKIPN KLUDGE ;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.
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
PUSHJ P,CRLF ;OUTPUT A CRLF.
HRRZ S1,OBTYPE ;[26]PICK UP THE OBJECT TYPE
$TEXT (DEPBYT,<^1/S1/ 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 ;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.
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/ ^D4R /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
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
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
LOAD S1,.QEOID(AP) ;GET REQUEST ID USER NUMBER
CAMN S1,G$SID## ;MATCH THE GLOBAL SENDER
JRST DEP.1 ;YES, OK TO SHOW FILES
PUSHJ P,A$WHEEL## ;DOES USER HAVE PRIVILEGES
JUMPF .RETT ;NO, THEN NO FILES
DEP.1: $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
>;END TOPS20
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: $QACK (<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
HRRZ 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: MOVEM S1,REMMSG ;[31]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.
SKIPE G$NEBF ;[31]MESSAGE FROM A REMOTE NODE?
MOVE S2,[.OHDRS,,.NMACS] ;[31]YES, CHANGE THE MESSAGE CODE
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,REMMSG ;[31]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.
MOVEI P1,.ORDSP ;GET BLOCK TYPE
STORE P1,ARG.HD(S1),AR.TYP ;SAVE IT IN THE MESSAGE
SKIPN G$NEBF ;[31]MESSAGE ORIGINATE REMOTELY?
JRST SETH.1 ;[31]NO, BUILD THE DISPLAY BLOCK
SKIPE PIDBLK ;[41]USER PID BLOCK PRESENT?
JRST SETH.1 ;[41]YES, DON'T ADD THIS DISPLAY BLOCK
MOVE P1,G$REMN ;[31]PICK UP NODE NAME MSG CAME FROM
MOVEM P1,ARG.DA(S1) ;[31]SAVE IN THE DISPLAY BLOCK
MOVEI P1,ARG.DA+1(S1) ;[35]PICK UP WHERE TO PLACE THE TEXT
HRLI P1,(POINT 7,) ;[35]MAKE IT INTO A POINTER
MOVEM P1,BYTPTR ;[31]SAVE WHERE DEPBYT EXPECTS IT
;**;[54]At SETHDR:+15L change 1 line JCR 11/29/89
MOVEI P1,[ITEXT(< Received message from ^N/G$LNAM##/::>)] ;[54]
$TEXT (DEPBYT,<^I/0(P1)/^A>) ;[31]PLACE IN THE MESSAGE
HRRZ P1,BYTPTR ;[31]PICK UP THE END ADDRESS
SUBI P1,-1(S1) ;[31]CALCULATE LENGTH OF BLOCK
STORE P1,ARG.HD(S1),AR.LEN ;[35]STORE IN THE BLOCK
ADD S1,P1 ;[31]POINT TO THE NEXT BLOCK
MOVSS P1 ;[31]PLACE LENGTH IN EXPECTED PLACE
ADDM P1,.MSTYP(S2) ;[31]ADD TO TOTAL MESSAGE LENGTH
AOS .OARGC(S2) ;[31]INCREMENT THE ARGUMENT COUNT
MOVEI P1,.ORDSP ;[31]PICK UP THE NEXT BLOCK TYPE
STORE P1,ARG.HD(S1),AR.TYP ;[31]STORE IN THE BLOCK HEADER WORD
SETH.1: MOVE P1,G$NOW## ;[31]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 ;[32]Get the more pages comming bit.
MOVE S2,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS.
IORM S1,.OFLAG(S2) ;LIGHT THE BIT.
SKIPN G$NEBF ;[31]MESSAGE ORIGINATE REMOTELY?
JRST SEND.1 ;[31]NO, FINISH BUILDING THE MESSAGE
MOVX S1,MF.NEB!MF.MOR ;[31]INDICATE REMOTE MESSAGE RESPONSE
IORM S1,.MSFLG(S2) ;[31]INDICATE IN THE MESSAGE
JRST SEND.1 ;[31]GO FINISH THE MESSAGE
SENDIT: SKIPN G$NEBF ;[31]MESSAGE ORIGINATE REMOTELY?
JRST SEND.1 ;[31]NO, PICK UP BYTE POINTER
MOVX S1,MF.NEB ;[31]PICK UP THE NEBULA BIT
MOVE S2,G$SAB##+SAB.MS ;[31]PICK UP THE MESSAGE ADDRESS
IORM S1,.MSFLG(S2) ;[31]INDICATE A REMOTE MESSAGE RESPONSE
SEND.1: MOVE S2,BYTPTR ;[31]PICK UP THE BYTE POINTER
ILDB S1,S2 ;Pick up the last character
CAIN S1,11 ;Is it a TAB?
SETZM S1 ;Yes, change to a NULL
DPB S1,S2 ;And replace
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,@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 SNDNEB - Send a message to NEBULA
SNDNEB::MOVE S1,G$NEBP## ;[41]PICK UP NEBULA'S PID
MOVEM S1,G$SAB##+SAB.PD ;[41]PLACE IN THE SAB
$CALL C$SEND## ;[41]SEND THE MESSAGE TO NEBULA
SETZM G$SAB##+SAB.MS ;[41]RESET SAB MESSAGE ADDRESS
$RET ;[41]RETURN TO THE CALLER
SUBTTL DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO
DMPSTS: SKIPN LISTYP ;IF THIS IS A QUICK LIST,,SKIP THIS
JRST DMPS16 ;EXIT
$SAVE <P1> ;[25]SAVE THIS AC
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 ;[25]NO, PROCESS AS OUTPUT QUEUE
MOVEI S1,^D13 ;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,^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.7 ;CONTINUE ON
DMPS.1: SKIPN JOBACT ;[37]IS THIS JOB ACTIVE?
;**;[60]At DMPS.1:+1L change 1 line PPM 6/3/90
JRST DMPS1F ;[60]No, check for a LPT
MOVE P1,OBJTYP(P3) ;[37]PICK UP THE OBJECT TYPE
HRRZ S1,P1 ;[37]ISOLATE THE OJBECT TYPE
CAIE S1,.OTLPT ;[37]IS THIS A LPT OBJECT?
JRST DMPS.4 ;[37]NO, CHECK FOR A UNIT
MOVE S1,.QEOBJ(AP) ;[42]PICK UP THE OBJECT ADDRESS
;**;[60]At DMPS.1:+6L add 2 lines PMM 6/3/90
MOVE S1,OBJAKA(S1) ;[60]Get alias name
MOVEM S1,JOBAKA ;[60]Save for later
TXNN P1,.DQLPT!.LALPT ;[37]A LAT OR DQS LPT OBJECT?
JRST DMPS4A ;[37]NO, IT'S A LOCAL LPT
TXNN P1,.DQLPT ;[37]IS THIS A DQS LPT?
JRST DMPS1B ;[37]NO, IT IS A LAT OR UNKNOWN
;**;[60]At DMPS.1:+14L replace 2 lines with 7 lines PMM 6/3/90
SKIPN JOBAKA ;[60]Need an alias field?
JRST DMPSA1 ;[60]No, add the queue name
MOVEI S1,^D16 ;[60]Get the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /Alias:^W/JOBAKA/^A>) ;[60]Add alias name
DMPSA1: MOVEI S1,^D45 ;[60]Get the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /Queue-name:^T/OBJNAM+1(P3)/^A>)
JRST DMPS.6 ;[37]CHECK THE FORMS TYPE
DMPS1B: LOAD S1,OBJNAM(P3),AR.TYP ;[37]PICK UP THE NAME BLOCK TYPE
CAIE S1,.KYPOR ;[37]IS IT A PORT?
;**;[60]At DMPS1B:+2L replace 3 lines with 7 lines PMM 6/3/90
JRST DMPS1D ;[60]No, must be a SERVICE
SKIPN JOBAKA ;[60]Need an alias field?
JRST DMPS1C ;[60]No, add the PORT name
MOVEI S1,^D16 ;[60]Get the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /Alias:^W/JOBAKA/^A>) ;[60]Add alias name
DMPS1C: MOVEI S1,^D29 ;[37]GET THE FIELD LENGTH
$CALL CHKSPC ;[37]MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Port-name:^T/OBJNAM+1(P3)/^A>)
JRST DMPS.6 ;[37]CHECK THE FORMS TYPE
;**;[60]At DMPS1C:+L relace 2 lines with 7 lines PMM 6/3/90
DMPS1D: SKIPN JOBAKA ;[60]Need an alias field?
JRST DMPS1E ;[60]No, add the SERVICE name
MOVEI S1,^D16 ;[60]Get the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /Alias:^W/JOBAKA/^A>) ;[60]Add alias name
DMPS1E: MOVEI S1,^D32 ;[60]Get the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /Service-name:^T/OBJNAM+1(P3)/^A>)
JRST DMPS.6 ;[37]CHECK THE FORMS TYPE
DMPS1F: MOVE P1,.QEROB+.ROBTY(AP) ;[37]Pick up the object type
TXNN P1,.DQLPT!.LALPT!.UNLPT ;[27]IS THIS A REMOTE LPT?
JRST DMPS.4 ;[25]NO, CHECK FOR A UNIT
TXNN P1,.DQLPT ;[25]IS THIS A DQS LPT?
JRST DMPS.2 ;[27]NO, IT IS A LAT OR UNKNOWN
MOVEI S1,^D45 ;[25]GET THE FIELD LENGTH
$CALL CHKSPC ;[25]MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Queue-name:^T/.QEONM+ARG.DA(AP)/^A>)
JRST DMPS.6 ;[25]CHECK THE FORMS TYPE
DMPS.2: TXNE P1,.UNLPT ;[27]UNKNOWN REMOTE PRINTER TYPE?
JRST DMPS3A ;[27]YES, INDICATE REMOTE NAME
LOAD S1,.QEONM(AP),AR.TYP ;[25]PICK UP THE NAME BLOCK TYPE
CAIE S1,.KYPOR ;[25]IS IT A PORT?
JRST DMPS.3 ;[25]NO, MUST BE A SERVICE
MOVEI S1,^D29 ;[25]GET THE FIELD LENGTH
$CALL CHKSPC ;[25]MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Port-name:^T/.QEONM+ARG.DA(AP)/^A>)
JRST DMPS.6 ;[25]CHECK THE FORMS TYPE
DMPS3A: $TEXT (DEPBYT,< /Remote-name:^T/.QEONM+ARG.DA(AP)/^A>)
JRST DMPS.6 ;[27]CHECK THE FORMS TYPE
DMPS.3: MOVEI S1,^D32 ;[25]GET THE FIELD LENGTH
$CALL CHKSPC ;[25]MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Service-name:^T/.QEONM+ARG.DA(AP)/^A>)
JRST DMPS.6 ;[25]CHECK THE FORMS TYPE
DMPS.4: 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
SETOM S2 ;INDICATE NO DEVICE SPECIFIED
CAIN S1,%PHYCL ;WAS 'PHYSICAL' SPECIFIED?
LOAD S2,.QEROB+.ROBAT(AP),RO.UNI ;YES,,GET THE UNIT NBR
SKIPE JOBACT ;IS THE JOB ACTIVE
DMPS4A: LOAD S2,OBJUNI(P3) ;[37]YES, GET THE DEVICE NUMBER.
SKIPGE S2 ;DO WE HAVE ANYTHING ???
JRST DMPS.5 ;NO,,SKIP THIS
SKIPN JOBACT ;IS THE JOB ACTIVE ???
;**;[60]At DMPS4A:+3L replace 5 lines with 14 lines PMM 6/3/90
JRST DMPS4C ;[60]No, go indicate so
SKIPN JOBAKA ;[60]Does it have an alias?
JRST DMPS4B ;[60]No, add the unit field
MOVEI S1,^D16 ;[60]Pick up the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /On Alias Printer:^W/JOBAKA/^A>) ;[60]Yes, add it
DMPS4B: MOVEI S1,^D13 ;[60]Pick up the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< On Unit:^D/S2/^A>) ;[60]Is active,,say so
JRST DMPS.6 ;[60]And continue on
DMPS4C: MOVEI S1,^D10 ;[60]Pick up the field length
$CALL CHKSPC ;[60]Make sure there is room
$TEXT (DEPBYT,< /Unit:^D/S2/^A>) ;[60]Not active,,say so
JRST DMPS.6 ;[60]Get the next field
DMPS.5: CAIN S1,%LOWER ;WAS IT LOWER??
$ASCII (< /Lower>) ;YES,,SAY SO
CAIN S1,%UPPER ;WAS IT /UPPER??
$ASCII (< /Upper>) ;YES,,SAY SO
DMPS.6: 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.7: MOVEI S1,^D16 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
SKIPN JOBACT ;[42]IS THIS REQUEST ACTIVE?
JRST DMPS7A ;[42]NO, CHECK ROUTE TBL FOR NODE NAME
MOVE S1,OBJNOD(P3) ;[42]PICK UP THE NODE NAME
$CALL N$NODE ;[43]SET UP FOR THE DISPLAY
JRST DMPS7B ;[42]CHECK IF ITS LOCAL
DMPS7A: MOVEI S1,.QEROB(AP) ;[42]GET THE REQ OBK BLK ADDRESS
SETZ S2, ;NO OBJECT MATCH
PUSHJ P,N$CSTN## ;PERFORM ANY ROUTING
DMPS7B: PUSHJ P,N$LOCL## ;[42]IS IT THE LOCAL NODE
JUMPT DMPS.8 ;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
SKIPN .QENOD(AP) ;[41]REQUEST FROM A REMOTE NODE?
JRST DMPS.8 ;[41]NO, CHECK FOR STRUCTURE
MOVEI S1,^D17 ;[41]GET LENGTH FOR NEXT FIELD
PUSHJ P,CHKSPC ;[41]MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Req-from:^N/.QENOD(AP)/^A>) ;[41]
DMPS.8: MOVEI S1,^D12 ;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
JRST DMP.11 ;SKIP MDA STUFF
DMP.10: MOVE S1,.QESEQ(AP) ;GET STATUS BITS
TXNE S1,QE.HBO ;HELD BY OPERATOR?
JRST DMP.11 ;YES
TXNE S1,QE.WAM ;IS IT WAITING FOR A MOUNT ???
$ASCII (< Mount wait>) ;YES,,SAY SO
DMP.11: MOVE S1,G$NOW## ;GET CURRENT TIME
CAML S1,.QECRE(AP) ;IS THERE A /AFTER PARM ???
JRST DMP.12 ;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.12: SKIPG LISTYP ;IS THIS AN EVERYTHING LIST ??
JRST DMPS15 ;NO,,SKIP THIS
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;IF BATCH,,CONTINUE ON
JRST DMPS13 ;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 DMPS14 ;CONTINUE ON
DMPS13: 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
DMPS14: 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 #
DMPS15: 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
DMPS16: 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
SETOM LSTDND ;ALL DESTINATION NODES
SETOM LSTPND ;ALL PROCESSING NODES
SETZM OBJADR ;ZAP THE OBJECT BLOCK ADDRESS
SETOM NODE6B ;INDICATE ALL NODES
SETZM DEVICE ;NO SPECIFIC DEVICE
SETZM USRNAM ;[41]NO USER NAME BLOCK
SETZM PIDBLK ;[41]NO PID BLOCK
SETZM REMUSR ;[41]NOT IN BEHALF OF A REMOTE USER
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 GETP.3 ;[41]NO MORE, CHECK FOR REMOTE USER
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 ???
;**;[57]At GETP.1:+6L change 1 line JCR 1/31/90
MOVEM T3,LSTUSR ;[57]Save the user name address
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,.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
CAIN T1,.LSPID ;[41]IS THIS A PID BLOCK?
MOVEM S1,PIDBLK ;[41]YES, SAVE THE PID
CAIE T1,.LSUNM ;[41]IS THIS A USER NAME BLOCK?
JRST GETP.2 ;[41]NO, CHECK FOR A TAPE BLOCK
HRLI T3,(POINT 7,) ;[41]YES, MAKE A POINTER
MOVEM T3,USRNAM ;[41]SAVE THE USER NAME POINTER
GETP.2: CAIE T1,.TAPDV ;[41]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.
GETP.3: SKIPN PIDBLK ;[41]A PID BLOCK PRESENT?
;**;[57]At GETP.3:+1L replace 3 lines with 16 lines JCR 1/31/90
JRST GETP.4 ;[57]No, check for user ID block
SKIPE G$NEBF ;[57]Message originate remotely?
SETOM REMUSR ;[57]Yes, indicate from a remote user
GETP.4: SKIPN LSTUSR ;[57]User ID block present?
JRST GETP.6 ;[57]No, Resolve /DEST /PROC /NODE
SKIPE ENTYPE ;[57]From an operator?
JRST GETP.5 ;[57]Yes, user name instead of number
MOVE S1,@LSTUSR ;[57]Pick up the user number
MOVEM S1,LSTUSR ;[57]Place where expected
JRST GETP.6 ;[57]Resolve /DEST /PROC /NODE
GETP.5: MOVX S1,RC%EMO ;[57]Exact match only
HRROI S2,@LSTUSR ;[57]Point to the user name
RCUSR% ;[57]Get the user number
ERJMP .RETF ;[57]Quit on an error
MOVEM T1,LSTUSR ;[57]Place user number where expected
; Resolve /DEST, /PROC and /NODE conflicts.
; This assumes someone 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
;
;**;[57]At GETP.4:+0L change 1 line JCR 1/31/90
GETP.6: SETOM KLUDGE ;[57]Say no 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 ;FLAG KLUDGE
$RETT ;AND RETURN
SUBTTL REMLIS - Reformat a LIST message to be forward remotely
REMLIS: $SAVE <P1,P2> ;[41]SAVE THESE AC
MOVE S1,.MSFLG(M) ;[41]PICK UP THE FLAG WORD
TXZ S1,MF.ACK ;[41]DON'T WANT AN ACK
TXO S1,MF.NEB ;[41]INDICATE A REMOTE REQUEST
MOVEM S1,.MSFLG(M) ;[41]SAVE THE UPDATED FLAG WORD
$CALL M%GPAG ;[41]PICK UP A PAGE FOR THE MSG
MOVE P1,S1 ;[41]SAVE THE MESSAGE ADDRESS
LOAD S2,.MSTYP(M),MS.CNT ;[41]PICK UP THE MESSAGE LENGTH
ADD S2,S1 ;[41]ADDRESS OF END OF MESSAGE+1
HRL S1,M ;[41]SOURCE,,DESTINATION
BLT S1,-1(S2) ;[41]COPY MSG TO REFORMATTED MSG
SKIPE G$RPRV## ;[41]UNPRIVILEGED USERS ENABLED?
JRST REML.1 ;[41]YES, CHECK FOR A USER BLOCK
$CALL A$WHEEL ;[41]IS THE USER PRIVILEGED?
JUMPT REML.1 ;[41]YES, CHECK FOR A USER BLOCK
MOVE S2,G$SID## ;[46]PICK UP THE USER I.D.
SKIPN LSTUSR ;[41]IS THERE A USER BLOCK PRESENT?
JRST REML.2 ;[41]NO, USE THE USER I.D.
CAME S2,LSTUSR ;[41]YES, SAME AS THE USER'S?
JRST [ MOVE S1,P1 ;[41]NO, PICK UP THE MSG PAGE ADR
$CALL M%RPAG ;[41]RELEASE THE PAGE
PJRST E$IUN## ] ;[41]INDICATE THE ERROR
JRST REML.2 ;[41]BUILD THE USER NAME BLOCK
REML.1: SKIPN S2,LSTUSR ;[41]IS THERE A USER BLOCK PRESENT?
JRST REML.3 ;[44]SEND ANY ACK
REML.2: LOAD P2,.MSTYP(P1),MS.CNT ;[41]PICK UP THE ORIGINAL MSG LENGTH
ADD P2,P1 ;[41]POINT TO THE NEXT FREE BLOCK
MOVE S1,[11,,.LSUNM] ;[41]PICK UP USER NAME BLOCK HEADER
MOVEM S1,ARG.HD(P2) ;[41]PLACE IN THE NAME BLOCK
HRROI S1,ARG.DA(P2) ;[41]POINT TO THE FIRST DATA WORD
DIRST% ;[41]PLACE THE USER NAME IN THE MSG
ERJMP [ MOVE S1,P1 ;[41]PICK UP THE MESSAGE ADDRESS
$CALL M%RPAG ;[41]RELEASE THE MESSAGE PAGE
PJRST E$CDU## ] ;[41]INDICATE AN ERROR
MOVEI S1,11 ;[41]PICK UP USER NAME BLOCK LENGTH
MOVSS S1 ;[41]PLACE LENGTH IN EXPECTED PLACE
ADDM S1,.MSTYP(P1) ;[41]UPDATE THE MESSAGE LENGTH
AOS .OARGC(P1) ;[41]INCREMENT THE ARGUMENT COUNT
REML.3: MOVX S1,MF.NOM ;[44]INDICATE A NULL ACK
SKIPE G$ACK## ;[44]ACK REQUESTED?
$CALL G$MSND## ;[44]YES, ACK THE SENDER
MOVEM P1,G$SAB##+SAB.MS ;[44]SAVE MESSAGE ADDRESS HERE
MOVEI S1,PAGSIZ ;[44]PICK UP THE MESSAGE SIZE
MOVEM S1,G$SAB##+SAB.LN ;[44]SAVE THE MESSAGE SIZE
$RETT ;[41]AND RETURN
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.
SKIPE S1,G$NEBF ;[41]MESSAGE ORIGINATE REMOTELY?
MOVE S1,REMMSG ;[41]YES, PICK UP DISPLAY BLK ADDRESS
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
END