Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
5-galaxy/qsrdsp.mac
There are 39 other files named qsrdsp.mac in the archive. Click here to see a list.
;SRC:<5-GALAXY>QSRDSP.MAC.8, 28-Jul-86 09:39:24, Edit by KNIGHT
;SRC:<5-GALAXY>QSRDSP.MAC.7, 25-Jul-86 16:09:50, Edit by KNIGHT
; Allow queue listing by unit number
;SRC:<5-GALAXY>QSRDSP.MAC.6, 25-Jul-86 15:41:07, Edit by KNIGHT
; Search MACSYM
;SRC:<5-GALAXY>QSRDSP.MAC.5, 25-Jul-86 15:19:46, Edit by KNIGHT
; Output /UNIT symbolically in queue listings for LPTs
;SRC:<5-GALAXY>QSRDSP.MAC.4, 21-Jul-86 16:18:29, Edit by KNIGHT
; CU/CMU lineprinter modifictions
;SRC:<5-GALAXY>QSRDSP.MAC.3, 14-Jan-86 15:57:46, Edit by KNIGHT
; Add foreign printer support
;[SRI-NIC]SRC:<6-GALAXY>QSRDSP.MAC.2, 16-May-85 15:02:36, Edit by HSS
; [LSRSPL] Add LASER support
TITLE QSRDSP - OPERATOR DISPLAY ROUTINES.
SUBTTL Preliminaries
;
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
; 1975,1976,1977,1978,1979,1980,1981,1982,1983,1984
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC,ORNMAC
IFN NICSW,<
SEARCH MACSYM
>;IFN NICSW
PROLOG (QSRDSP)
DSPMAN==:1 ;Maintenance edit number
DSPDEV==:14 ;Development edit number
VERSIN (DSP) ;Generate edit number
SUBTTL Table of Contents
; Table of Contents for QSRDSP
;
;
; Section Page
; 1. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision history . . . . . . . . . . . . . . . . . . . 3
; 4. LOCAL STORAGE AND BRANCH TABLES. . . . . . . . . . . . 4
; 5. ROUTINE DATA AREAS AND ITEXT STATEMENTS. . . . . . . . 5
; 6. D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST. . 8
; 7. D$SHST - ROUTINE TO SHOW DEVICE STATUS.. . . . . . . . 9
; 8. EXPTIM - Expand time . . . . . . . . . . . . . . . . . 10
; 9. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS . . . . . . 11
; 10. SHOW STATUS/PARAMETERS MESSAGE HEADING ROUTINE . . . . 13
; 11. CHKQUE - ROUTINE TO SCAN AND SET UP OBJECT HEADERS . . 14
; 12. D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE. . . . . . 16
; 13. D$NPRM - ROUTINE TO DISPLAY THE NETWORK (DN60) PARAMETERS 17
; 14. NPRHDR - NETWORK PARAMETER HEADER ROUTINE. . . . . . . 18
; 15. D$NSTS - DISPLAY NETWORK STATUS (ONLINE/OFFLINE) . . . 19
; 16. D$STAP - SHOW STATUS OF TAPE DRIVES. . . . . . . . . . 21
; 17. D$SDSK - SHOW STATUS OF DISK DRIVES. . . . . . . . . . 23
; 18. GETDSK - ROUTINE TO RETURN THE FIRST/NEXT DISK UCB ADDRESS 26
; 19. D$SSTR - SHOW STATUS OF FILE STRUCTURE . . . . . . . . 27
; 20. GETSTR - Get a primary file structure block. . . . . . 30
; 21. STRHDR - Type a header line for SHOW STATUS STRUCTURES 31
; 22. TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HEADER 32
; 23. DSKHDR - ROUTINE TO PUT OUT DISK STATUS DISPLAY HEADER 33
; 24. D$SMNT - ROUTINE TO DUMP THE MOUNT QUEUES. . . . . . . 34
; 25. SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES.. . . . 38
; 26. PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING. . . . . 40
; 27. SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATUS COMMAND. 41
; 28. SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND. 42
; 29. DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.. 43
; 30. DEPBAT - ROUTINE TO PROCESS BATCH QUEUE ENTRYS.. . . . 43
; 31. DEPRET - ROUTINE TO PROCESS RETRIEVAL QUEUE ENTRYS.. . 44
; 32. D$SALC - SHOW ALLOCATION . . . . . . . . . . . . . . . 45
; 33. Find a VSN given a resource number . . . . . . . . . . 48
; 34. SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE. . . . . . 50
; 35. SETHDR - ROUTINE TO INSERT THE MESSAGE HEADER. . . . . 50
; 36. SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.. . . . . . 51
; 37. DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO . . . . . . 52
; 38. PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE . . . . 56
; 39. GETPARMS = ROUTINE TO PROCESS THE INPUT BLOCKS IN A SHOW QUEUES MSG. 57
; 40. UTILITY ROUTINES . . . . . . . . . . . . . . . . . . . 58
SUBTTL Revision history
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
0 7-Jan-83
Currently no edits
***** 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.
\ ;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
;[LSRSPL] [ASCIZ/Card Limits /] ;.OTCDP
[ASCIZ/Page Limits /] ;[LSRSPL]
[ASCIZ/Min:Max Feet/] ;.OTPTP
IFE NICSW,<
[ASCIZ/ Minutes /] ;.OTPLT
>;IFE NICSW
IFN NICSW,<
[ASCIZ/Page limits /] ;.OTPLT
>;IFN NICSW
[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
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
IFN NICSW,<
LSTUNI: BLOCK 1 ;Specific unit name to list
>;IFN NICSW
OBJADR: BLOCK 1 ;MSG OBJECT BLOCK ADDRESS
DEFINE $ASCII(MSG),<
PUSHJ P,ASCOUI ;;CALL THE IN-LINE ASCII OUTPUTTER
CAI [ASCIZ+MSG+] ;;AIM AT THE MESSAGE
>;END $ASCII DEFINE
JS: ITEXT (<^W6L /.QEJOB(AP)/ ^D6R /.QERID(AP)/ >)
TIM: ITEXT (<^D2R0/TIME./:^D2R0/TIME.+1/:^D2R0/TIME.+2/>)
ONOFL: [ASCIZ/Offline/]
[ASCIZ/Online /]
[ASCIZ/Active /]
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
TOPS10< EXTERN DEVNTB > ;DEVICE TRANSLATION TABLE
SUBTTL D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST.
D$SHQS: SETZM G$ACK## ;INDICATE WE DONT WANT AN ACK.
SKIPA S1,[-1] ;INDICATE 'OPERATOR' ENTRY POINT.
D$LIST: SETZ S1, ;INDICATE 'QUEUE' ENTRY POINT.
MOVEM S1,ENTYPE ;AND SET IT.
PUSHJ P,.SAVE3 ;SAVE 3 AC'S
SETZM QEMPTY ;RESET THE QUEUES EMPTY FLAG.
SETZM ACTIVE ;ZERO THE JOB ACTIVE COUNT.
SETZM NOROOM ;CLEAR NO MORE ROOM INDICATOR
SETZM BYTPTR ;INDICATE NO OUTPUT PAGE YET ..
SETOM JOBNBR ;RESET THE NUMBER OF JOBS COUNT.
PUSHJ P,GETPARMS ;BREAK DOWN THE INCOMMING MESSAGE.
JUMPF E$MTS## ;IF AN ERROR OCCURED,,PROCESS IT.
$COUNT (MLST) ;BUMP LIST COUNT.
SKIPN P1,QUEBITS ;GET THE QUEUE BITS.
JUMPE P1,E$ILM## ;NO QUEUES,,NOT VALID.
MOVX S1,MF.NOM ;GET 'NO MESSAGE BITS'
SKIPE G$ACK## ;DOES HE WANT AN ACK ???
PUSHJ P,G$MSND## ;YES,,DO IT !!
TXNE P1,LIQMNT ;DO WE WANT THE TAPE/DISK MOUNT QUEUE ?
PUSHJ P,D$SMNT ;YES,,GO DO IT
MOVEI H,TBLHDR## ;GET THE POINTER TO THE FIRST QUEUE.
MOVEI P2,NQUEUE## ;GET THE NUMBER OF QUEUES.
LIST.1: TDNE P1,.QHLIS(H) ;DOES HE WANT THIS QUEUE.
PUSHJ P,SHOWQS ;YES,,DUMP IT.
ADDI H,QHSIZE ;POINT TO THE NEXT QUEUE.
SOJG P2,LIST.1 ;AND TRY THE NEXT ONE.
$COUNT (NLAP) ;COUNT PAGES SENT
SKIPN QEMPTY ;ARE THE QUEUES EMPTY ???
JRST LIST.2 ;YES,,PROCESS A LITTLE DIFFERENTLY
PUSHJ P,CRLF ;END WITH A CRLF
PUSHJ P,SENDIT ;SEND THE LAST PAGE.
$RETT ;RETURN.
LIST.2: SKIPE ENTYPE ;WAS THIS AN USER REQUEST ???
JRST LIST.3 ;NO,,MUST BE OPERATOR
MOVEI S1,[ASCIZ/ System Queues Listing /] ;GENERATE THE ID
PUSHJ P,SETPAG ;GO SETUP THE PAGE
$ASCII (<[The queues are empty]>) ;PUT IN THE TEXT
PUSHJ P,CRLF ;ADD A CRLF
PUSHJ P,SENDIT ;SEND IT OFF
$RETT ;AND RETURN
LIST.3: $ACK (<The queues are empty>,,,ACKCOD) ;YES,,RESPOND !!
$RETT ;AND RETURN
SUBTTL D$SHST - ROUTINE TO SHOW DEVICE STATUS.
; D$SHPR - ROUTINE TO SHOW PARAMETERS.
D$SHPR: SKIPA S1,[1] ;INDICATE THE PARAMETERS ENTRY POINT.
D$SHST: SETZ S1, ;INDICATE THE SHOW STATUS ENTRY POINT.
MOVEM S1,SHWTYP ;SAVE THE ENTRY STATUS.
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
PUSHJ P,.SAVET ;SAVE THE T ACS.
SETOM ENTYPE ;INDICATE 'OPERATOR' MESSAGE
SETZM QEMPTY ;INDICATE NO OBJECTS FOUND
SETZM OBTYPE ;ZERO THE OBJECT TYPE.
PUSHJ P,GETPARMS ;GO BREAK DOWN THE MESSAGE
SKIPN OBJADR ;MAKE SURE WE GOT AN OBJECT BLOCK
$RETT ;NONE THERE,,THATS AN ERROR
LOAD T1,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJ QUEUE ENTRY.
STPR.1: JUMPE T1,STPR.4 ;NO MORE,,RETURN.
LOAD T2,OBJTYP(T1) ;GET THE OBJ TYPE.
JUMPLE T2,STPR.3 ;NOT VALID,,TRY NEXT.
PUSHJ P,CHKOBJ ;DO WE WANT THIS OBJECT ???
JUMPF STPR.3 ;NO,,TRY THE NEXT ONE
MOVE P1,S1 ;SAVE THE NODE DB ENTRY ADDR IN S1
CAME T2,OBTYPE ;ARE WE PROCESSING A NEW QUEUE TYPE ???
PUSHJ P,CHKQUE ;YES,,GO SCAN FOR ACTIVE/REMOTE STATUS.
IFN NICSW,<
MOVE S1,OBTYPE ;Get the object type
CAIN S1,.OTLPT ;Printer ?
JRST [ MOVE S1,OBJNOD(T1) ;Get the node name
MOVE S2,OBJUNI(T1) ;Retrieve unit number
$CALL P%FUNI## ;Find the printer bblock
SKIPT ;Error ?
SKIPA S1,[SIXBIT / /] ;Yes, no name then
MOVE S1,PP.NAM(S2) ;Get printer name
$TEXT (DEPBYT,< ^W6L /PP.NAM(S2)/ ^A>) ;Yes, add name
JRST STPR.2] ;Join common code
>;IFN NICSW
$TEXT (DEPBYT,< ^D4R /OBJUNI(T1)/ ^A>) ;PUT OUT THE UNIT/STREAM #
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$TEXT (DEPBYT,<^N10R /OBJNOD(T1)/ ^A>) ;PUT OUT THE NODE NAME
IFN NICSW,<
STPR.2:
>;IFN NICSW
SKIPN SHWTYP ;IF THIS IS SHOW STATUS,
PUSHJ P,SHSTAT ;THEN GO GET THE STATUS.
SKIPE SHWTYP ;IF THIS IS SHOW PARAMETERS,, THEN
PUSHJ P,SHPARM ;GO GET THE PARAMETERS.
STPR.3: LOAD T1,.QELNK(T1),QE.PTN ;GET NEXT OBJ QUEUE ENTRY.
JRST STPR.1 ;GO PROCESS IT.
STPR.4: SKIPN S1,QEMPTY ;WAS ANYTHING PUT OUT ???
JRST STPR.5 ;NO,,TELL THE OPERATOR
JUMPG S1,.RETT ;JUST DN60 MSGS ??? - RETURN
PUSHJ P,CRLF ;OUTPUT A CRLF.
SKIPE SHWTYP ;IF 'SHOW PARM' THEN SEND
PJRST SENDIT ; THE MESSAGE AND RETURN
PUSHJ P,I$SYSV## ;UPDATE THE SYSTEM VARIABLES
SKIPN S1,G$KSYS## ;IF NO KSYS IS PENDING,,THEN SEND
PJRST SENDIT ; THE MESSAGE AND RETURN
SKIPG S1 ;TIMESHARING OVER ???
$TEXT(DEPBYT,<* Timesharing is over - no scheduling will be done^M^J>)
JUMPL S1,SENDIT ;YES,,TELL OPR AND RETURN
PUSHJ P,EXPTIM ;EXPAND TIME INTO READABLE TEXT
PJRST SENDIT ;SEND THE MESSAGE AND RETURN.
STPR.5: MOVE S1,OBJADR ;GET THE OBJECT BLOCK ADDRESS
SKIPL OBJ.UN(S1) ; OR ALL UNITS ???
JRST STPR.6 ;NO,,SEND A SPECIFIC MSG
$ACK (<There are no devices started>,,,ACKCOD) ;YES,,TELL THE OPR
$RETT ;AND RETURN
STPR.6: HRRZS OBJ.UN(S1) ;Make certain there is no high range
$ACK (<Device unknown>,,0(S1),ACKCOD) ;SEND A SPECIFIC MSG
$RETT ;AND RETURN
SUBTTL EXPTIM - Expand time
; Expand time from seconds to hours and minutes
; CALL: MOVE S1,time in seconds
; PUSHJ P,EXPTIM
;
; On return, some pretty text will be generated
;
EXPTIM: $SAVE <T1,T2,T3> ;SAVE SOME ACS
IDIVI S1,^D60*^D60 ;S1:= HOURS
IDIVI S2,^D60 ;S2:= MINUTES
CAIN S1,0 ;HOURS?
MOVEI T1,[ITEXT (<>)] ;NO
CAIN S1,1 ;1 HOUR?
MOVEI T1,[ITEXT (<^D/S1/ hour >)] ;YES
CAILE S1,1 ;MORE THAN ONE HOUR?
MOVEI T1,[ITEXT (<^D/S1/ hours >)] ;YES
SKIPE S1 ;HAVE HOURS?
SKIPN S2 ;HAVE MINUTES?
SKIPA T2,[[ASCIZ ||]] ;JUST ONE OR THE OTHER
MOVEI T2,[ASCIZ |and |] ;HAVE BOTH
CAIN S2,0 ;MINUTES?
MOVEI T3,[ITEXT (<>)] ;NO
CAIN S2,1 ;1 MINUTE?
MOVEI T3,[ITEXT (<^D/S2/ minute>)] ;YES
CAILE S2,1 ;MORE THAN 1 MINUTE?
MOVEI T3,[ITEXT (<^D/S2/ minutes>)] ;YES
$TEXT(DEPBYT,<* Timesharing will cease in ^I/(T1)/^T/(T2)/^I/(T3)/^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
SKIPL S1,OBJ.TY(S2) ;CHECK THE MSG OBJ TYPE,,-1 WINS
CAMN S1,OBJTYP(T1) ;COMPARE AGAINST OBJ Q ENTRY
SKIPA ;WIN ON EITHER,,SKIP
$RETF ;NO GOOD,,RETURN
SKIPL S1,OBJ.UN(S2) ;CHECK THE MSG UNIT #,,-1 WINS
CAMN S1,OBJUNI(T1) ;COMPARE AGAINST OBJ Q ENTRY
JRST CHKO.0 ;We win, continue on
;Check for within the range.
LOAD S1,OBJ.UN(S2),OU.HRG ;Get the high range
CAMGE S1,OBJUNI(T1) ;Within the high range?
$RETF ;No - return
LOAD S1,OBJ.UN(S2),OU.LRG ;Get the low range
CAMLE S1,OBJUNI(T1) ;Within low range?
$RETF ;No again
CHKO.0: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE S1,OBJNOD(T1) ;GET THE OBJECTS NODE NAME
PUSH P,S2 ;SAVE THE OBJECT ADDRESS FOR A SECOND
PUSHJ P,N$NODE## ;FIND ITS ENTRY IN OUR DATA BASE
MOVE P1,S2 ;SAVE/RETURN THE ADDRESS IN P1
POP P,S2 ;RESTORE THE OBJECT ADDRESS
SKIPN S2,OBJ.ND(S2) ;IF NO NODES,
JRST CHKO.1 ;WIN,,CHECK FOR DN60 EMULATION
CAME S2,[-1] ;IF ALL NODES,
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
CHKO.1: MOVE S1,OBJSCH(T1) ;GET THE SCHEDULING BITS
TXNE S1,OBSSIP+OBSSUP ;IF SIP OR SETUP,,THEN
JRST CHKO.2 ; SKIP THIS CODE
TXNE S1,OBSSTA ;IF NOT STARTED,,THEN SKIP THIS CODE
SKIPE SHWTYP ;OR IF SHOWING PARAMETERS,,THEN
JRST CHKO.3 ; SKIP THIS CODE
MOVE S1,OBJTYP(T1) ;ELSE GET OBJECT TYPE
LOAD S2,OBJDAT(T1),RO.ATR ;AND GET STREAM OR UNIT ATTRIBUTES
PUSHJ P,A$LPSB## ;FIND PSB ASSOCIATED WITH STREAM OR UNIT
JUMPT CHKO.2 ;ALL SET IF THERE WAS ONE
MOVX S1,%NOPRC ;GET "NO PROCESSOR" STATUS
MOVEM S1,OBJSTS(T1) ;NO - FIX UP STATUS
JRST CHKO.3 ;CONTINUE
CHKO.2: MOVE S1,OBJSTS(T1) ;GET CURRENT STATUS WORD
CAXE S1,%NOPRC ;WAS IT "NO PROCESSOR" ?
JRST CHKO.3 ;NO - LEAVE IT ALONE
MOVE S1,T1 ;GET OBJECT BLOCK ADDRESS
PUSHJ P,A$OBST## ;UPDATE STREAM OR UNIT STATUS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CHKO.3: MOVE S1,P1 ;WE WANT TO RETURN NODE DB ADDR IN S1
LOAD S2,NETSTS(P1),NETSNA ;IS THIS AN SNA WORKSTATION STATION ???
JUMPN S2,CHKO.5 ; 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.4: 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.5: 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.4 ; 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.4
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
PUSH P,T1 ;SAVE THE CURRENT OBJECT ADDRESS
CHKQ.1: MOVE S1,OBJNOD(T1) ;GET THE OBJECTS LOCATION
PUSHJ P,N$LOCL## ;CHECK TO SEE IF LOCAL OR REMOTE
SKIPT ;TRUE - ITS LOCAL
SETOM REMOTE ;ELSE ITS REMOTE
MOVE S1,OBJSCH(T1) ;GET THE SCHEDULING BITS
TXC S1,OBSBUS ;COMPLIMENT BUSY BIT
TXNN S1,OBSBUS+OBSFRR ;MUST BE BUSY AND NOT FREE RUNNING
SETOM ACTIVE ;YES,,SET ACTIVE FOR LATER
MOVE S1,OBJTYP(T1) ;GET OBJECT TYPE
CAXE S1,.OTBAT ;IS IT BATCH ?
JRST CHK1.A ;NO
LOAD S1,OBJDAT(T1),RO.ATR ;GET ATTRIBUTE FIELD
CAXN S1,%SITGO ;SITGO ??
SETOM ATTRIB ;YES
CHK1.A: LOAD T1,.QELNK(T1),QE.PTN ;GET THE NEXT OBJECT IN THE CHAIN
JUMPE T1,CHKQ.2 ;NO MORE,,PUT OUT THE HEADER
MOVE S1,OBJTYP(T1) ;GET THIS OBJECTS TYPE CODE
CAMN S1,OBTYPE ;ARE THEY THE SAME ???
JRST CHKQ.1 ;YES,,GO CHECK IT OUT
CHKQ.2: POP P,T1 ;RESTORE T1 TO ORIGIONAL OBJ ADDRESS
PUSHJ P,CRLF ;OUTPUT A CRLF
MOVE S1,SHWTYP ;GET THE 'SHOW' TYPE
$TEXT (DEPBYT,<^1/OBTYPE/^T/@STAPAR(S1)/>) ;GEN THE HEADING
CAIE T2,.OTBAT ;IS THIS BATCH ???
JRST CHKQ.3 ;NO,,ASSUME ITS OUTPUT
$ASCII (< Strm >) ;START THE HEADING
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (< Node >) ;YES,,PUT OUT A HEADING FOR THEM
SKIPE SHWTYP ;IS IT 'SHOW STATUS' ???
JRST CHK.2A ;NO,,MUST BE 'SHOW PARAMETERS' !!!
;SET UP BATCH 'SHOW STATUS' HEADINGS
$ASCII (< Status >) ;PUT OUT SOME MORE HEADING
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (<Jobname Req# User>) ;YES,,PUT OUT A HEADING
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- >)
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES,,UNDERLINE IT
$ASCII (<--------------- >) ;UNDERLINE STATUS
SKIPE ACTIVE ;ANY ACTIVE ???
$ASCII (<------- ------ ------------------------>)
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;SET UP BATCH 'SHOW PARAMETERS' HEADINGS
CHK.2A: $ASCII (< Minutes Prio >) ;START HEADING
IFN INPCOR,< $ASCII (< Core >) > ;PUT OUT 'CORE'
$ASCII (<Opr-Intvn>) ;PUT OUT OPR-INTERVENTION HEADING
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.3: $ASCII (< Unit >) ;START THE HEADING
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (< Node >) ;YES,,PUT OUT A HEADING FOR THEM
SKIPE SHWTYP ;IS THIS 'SHOW STATUS' ???
JRST CHK.3A ;NO,,MUST BE 'SHOW PARAMETERS' !!!
$ASCII (< Status >) ;STATUS HEADING
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (<Jobname Req# User>) ;YES.....
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< ---- >) ;UNIT UNDERLINE
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES......
$ASCII (<--------------- >) ;OUTPUT STATUS UNDERLINE
SKIPE ACTIVE ;ANY ACTIVE JOBS ???
$ASCII (<------- ------ ------------------------>) ;YES...
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
;OUTPUT QUEUE 'SHOW PARAMETERS' HEADING
CHK.3A: MOVE S1,OBTYPE ;GET THE OBJECT TYPE
MOVE S1,LIMTYP(S1) ;GET THE LIMIT DESCRIPTION ADDRESS
PUSHJ P,ASCOUT ;PUT IT OUT
$ASCII (< Form Prio Lim-Ex Dev-Chars>) ;REST OF HEADING
PUSHJ P,CRLF ;START NEXT LINE
$ASCII (< ---- >) ;'UNIT' UNDERLINE
SKIPE REMOTE ;ANY REMOTE STATIONS ???
$ASCII (<---------- >) ;YES,,UNDERLINE ITS HEADING
$ASCII (<------------ ------ ----- ------ --------->) ;REST OF HDNG
PUSHJ P,CRLF ;START A NEW LINE
$RETT ;AND RETURN
SUBTTL D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE.
EXTERN G$MSG ;MAKE THIS ACCESSABLE !!!
D$SHRT: SETOM ENTYPE ;INDICATE THIS IS AN OPERATOR REQUEST.
LOAD S1,.MSCOD(M) ;GET THE ACK CODE.
STORE S1,ACKCOD ; AND SAVE IT.
MOVE S1,RTEQUE## ;GET THE ROUTE TABLE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
JUMPF SHRT.4 ;NONE THERE,,THATS AN ERROR
PUSH P,S2 ;SAVE THE FIRST ENTRY ADDRESS
MOVEI S1,[ASCIZ/ System Device Routing Table /] ;GET THE HEADING.
PUSHJ P,SETPAG ;SET UP AN OUTPUT PAGE.
PUSHJ P,CRLF ;OUTPUT A CRLF.
POP P,S1 ;RESTORE THE FIRST ENTRY ADDRESS
JRST SHRT.2 ;CONTINUE PROCESSING
SHRT.1: MOVE S1,RTEQUE## ;GET THE ROUTE TABLE ID
PUSHJ P,L%NEXT ;GET THE NEXT ENTRY
SKIPT ;SKIP IF THERE IS ANOTHER
PJRST SENDIT ;ELSE END THE ACK AND RETURN
MOVE S1,S2 ;GET THE ENTRY ADDRESS IN S1
SHRT.2: PUSHJ P,N$RTAS## ;CONVERT THE ENTRY TO ASCIZ (IN G$MSG)
$TEXT (DEPBYT,< ^T/G$MSG/^M^J>) ;INSERT THE TEXT
JRST SHRT.1 ;AND GET NEXT
SHRT.4: $ACK (<No routing has been performed>,,,ACKCOD) ;TELL OPR
$RETT ;AND RETURN
SUBTTL D$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 ???
$ACK (<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 ???
$ACK (<No SNA-Workstations in system network>,,,.MSCOD(M))
CAME S2,[-1] ;DID WE ASK FOR ALL NODES ???
$ACK (<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
$ACK (<There are no nodes in the network>,,,.MSCOD(M))
JUMPE S1,.RETT ;ALL DONE,,JUST RETURN
CAIN S1,1 ;JUST 1 NODE
$ASCII (<There is 1 node in the network>)
CAILE S1,1 ;MORE THEN 1 ???
$TEXT (DEPBYT,<There are ^D/JOBNBR/ nodes in the network^A>)
PUSHJ P,CRLF ;END THE LINE
PUSHJ P,CRLF ;ADD ONE MORE
PJRST SENDIT ;AND SEND THE ACK
NSTHDR: MOVEI S1,[ASCIZ/ System Network Status /] ;GET HEADING
PUSHJ P,SETPAG ;SET UP THE OUTPUT PAGE
PUSHJ P,CRLF ;START A NEW LINE
$ASCII (< Node Status >) ;SET UP HEADING
PUSHJ P,CRLF ;END THE LINE
$ASCII (<------------ -------->) ;UNDERLINE IT
PUSHJ P,CRLF ;END THE LINE
$RETT ;RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
; Here if Network status for a particular node
NSTS.5:
$CALL N$GNOD## ;Go get the node
JUMPT NSTS.6 ;Found, go output
$ACK (<Node ^N/NODE6B/ does not exist>,,,.MSCOD(M))
$RETT ;Nothing more to do
NSTS.6: MOVE P1,S2 ;Get the node entry address
LOAD S1,NETSTS(P1),NETIBM ;GET THE IBM REMOTE STATUS
LOAD S2,NETSTS(P1),NETONL ;GET THE ONLINE BIT
JUMPN S1,NSTS.7 ;IF AN IBM REMOTE,,SKIP THIS
$ACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/>,,,.MSCOD(M))
$RETT ;RETURN
NSTS.7: LOAD S1,NETSTS(P1),NT.MOD ;GET THE MODE
JUMPN S2,NSTS.8 ;If online, skip this
CAIE S1,DF.PRO ;Is it prototype?
JRST NSTS.8 ;No, skip this
LOAD S2,NETSTS(P1),NETPRO ;Get proto-actual online bit
JUMPE S2,NSTS.8 ;Not actual online, continue
MOVEI S2,2 ;Get active status
$ACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,< as Station ^N/NETLOC(P1)/>,,.MSCOD(M))
$RETT ;Return
NSTS.8: $ACK (<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL D$STAP - SHOW STATUS OF TAPE DRIVES
TOPS10< INTERN D$STAP ;SHOW STATUS TAPE DRIVES
D$STAP: PUSHJ P,.SAVE2 ;SAVE P1 & P2 FOR A MINUTE
SETOM ENTYPE ;OPERATOR ENTRY POINT
SETOM JOBNBR ;DEVICE COUNT
SETZM ACTIVE ;ALLOCATED DEVICES
SETZM REMOTE ;PRESTAGED DEVICES
PUSHJ P,GETPARM ;BREAK DOWN THE INCOMMING MESSAGE
MOVE S1,.OFLAG(M) ;GET THE FLAG WORD
MOVEM S1,LISTYP ;SAVE FOR GETDSK ROUTINE
MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;POSITION TO THE FIRST ENTRY
SKIPT ;SKIP IF WE FOUND ONE
PUSHJ P,S..NUE## ;NULL UCB CHAIN !!!
STAP.1: MOVE P1,S2 ;SAVE THE UCB ADDRESS
SKIPE S1,DEVICE ;A SPECIFIC DEVICE ???
CAMN S1,.UCBNM(P1) ;YES,,DO THEY MATCH ???
SKIPA ;NO DEVICE OR THEY MATCH,,WIN
JRST STAP.2 ;NO GOOD,,TRY NEXT DEVICE
LOAD S1,.UCBST(P1),UC.DVT ;GET THE DEVICE TYPE
CAXE S1,%TAPE ;IS IT MAG TAPE ???
JRST STAP.2 ;NO,,TRY NEXT DEVICE
LOAD TF,.UCBST(P1),UC.VSW ;GET VOLUME SWITCH BIT
SKIPE TF ;IN VOLUME SWITCH MODE ???
SETOM ACTIVE ;YES,,INDICATE WE HAVE AN OWNER
SKIPN S1,.UCBVL(P1) ;YES,,IS A VOLUME MOUNTED ???
JRST STAP.2 ;NOT TAPE OR NO VOLUME,,TRY NEXT UCB
SETOM REMOTE ;INDICATE WE HAVE A STAGED VOLUME
PUSHJ P,D$VOWN## ;DOES ANYONE OWN THIS VOLUME ???
SKIPF ;NO,,SKIP
SETOM ACTIVE ;YES,,INDICATE SO
SKIPE ACTIVE ;IS 'ACTIVE' SET
SKIPN REMOTE ;AND IS 'REMOTE' SET ???
SKIPA ;BOTH NOT SET,,SKIP
JRST STAP.3 ;BOTH SET,,STOP SCANNING
STAP.2: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%NEXT ;GET THE NEXT UCB ENTRY
JUMPT STAP.1 ;FOUND ONE,,GO CHECK IT OUT
STAP.3: MOVE S1,UCBQUE## ;GET THE UCB QUEUE ID
PUSHJ P,L%FIRST ;GET THE FIRST ENTRY
SKIPT ;SKIP IF WE FOUND ONE
PUSHJ P,S..NUE## ;NULL UCB CHAIN !!!
STAP.4: MOVE P1,S2 ;SAVE THE ENTRY ADDRESS
SKIPE S1,DEVICE ;A SPECIFIC DEVICE ???
CAMN S1,.UCBNM(P1) ;YES,,DO THEY MATCH ???
SKIPA ;NO DEVICE OR THEY MATCH,,WIN
JRST STAP.6 ;NO GOOD,,TRY NEXT DEVICE
LOAD S1,.UCBST(P1),UC.DVT ;GET THE DEVICE TYPE
CAXE S1,%TAPE ;IS IT TAPE ???
JRST STAP.6 ;NO,,TRY NEXT UCB
MOVX TF,ST.AVA ;GET AVAILABLE BIT (/FREE)
TDNN TF,LISTYP ;USER SPECIFY /FREE ?
JRST STAP.D ;NO - TRY TO LIST ALL
MOVX TF,UC.AVA ;GET 'AVAILABLE TO MDA' BIT
SKIPN .UCBVS(P1) ;'FREE' ONLY, SO CAN'T BE ASSIGNED
TDNN TF,.UCBST(P1) ; OR SET UNAVAILABLE !!!
JRST STAP.6 ;LOSE,,TRY ANOTHER DRIVE
STAP.D: AOSG JOBNBR ;BUMP DEVICE COUNT BY 1
PUSHJ P,TAPHDR ;FIRST TIME,,PUT OUT THE TAPE STATUS HDR
LOAD S1,.UCBST(P1) ;GET THE DEVICE STATUS BITS
MOVEI S2,[ASCIZ/Online /] ;DEFAULT TO 'ONLINE' STATUS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
TXNE S1,UC.OFL ;IS IT OFFLINE ???
MOVEI S2,[ASCIZ/Offline/] ;YES,,SAY SO
SKIPN .UCBVL(P1) ;IS THERE A VOLUME ON THIS UCB ???
MOVEI S2,[ASCIZ/Free /] ;NO,,MAKE THE STATUS 'FREE'
TXNN S1,UC.AVA ;IS IT 'UNAVAILABLE' ???
MOVEI S2,[ASCIZ/Unavailable/] ;YES,,SAY SO
LOAD TF,.UCBST(P1),UC.VSW ;GET THE VOLUME SWITCH BIT
SKIPE TF ;SWITCHING VOLUMES ???
MOVEI S2,[ASCIZ/Vol Switch/] ;YES,,SAY SO
LOAD TF,.UCBST(P1),UC.INI ;GET THE INITIALIZING BIT
SKIPE TF ;INITIALIZING LABELS?
MOVEI S2,[ASCIZ/Initializing/] ;YES, SAY SO
MOVEI S1,[ASCIZ/Yes/] ;DEFAULT AVR YES
LOAD TF,.UCBST(P1),UC.AVR ;GET THE AVR BIT
SKIPN TF ;IS IT LIT ???
MOVEI S1,[ASCIZ/No /] ;NO,,SAY NO AVR !!!
LOAD T1,.UCBST(P1),UC.TRK ;GET THE TRACK TYPE
$TEXT (DEPBYT,<^W6/.UCBNM(P1)/ ^W3/TRK(T1)/ ^T11/0(S2)/ ^T3/0(S1)/ ^A>)
SKIPE S1,.UCBVL(P1) ;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
$ACK (<Device ^W/DEVICE/ does not exist>,,,ACKCOD)
JUMPE S1,.RETT ;THE END,,RETURN
PUSHJ P,CRLF ;ADD AN ENDING CRLF
PUSHJ P,SENDIT ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
SUBTTL D$SDSK - SHOW STATUS OF DISK DRIVES
TOPS10< INTERN D$SDSK ;SHOW STATUS DISK DRIVES
D$SDSK: PUSHJ P,.SAVE2 ;SAVE P1 & P2 FOR A MINUTE
SETOM ENTYPE ;OPERATOR ENTRY POINT
SETOM JOBNBR ;DEVICE COUNT
SETZM REMOTE ;CLEAR MOUNTED VOLUMES FLAG
SETZM ACTIVE ;CLEAR DUAL PORTED FLAG
PUSHJ P,GETPARM ;BREAK DOWN THE INCOMMING MESSAGE
MOVE S1,.OFLAG(M) ;GET THE FLAG WORD
MOVEM S1,LISTYP ;SAVE FOR LATER
SETOM LSTUSR ;SAY WE WANT TO START UCB SCAN
SDSK.1: PUSHJ P,GETDSK ;GET A DISK UCB
JUMPF SDSK.2 ;NO MORE,,CONTINUE ONWARD
SKIPE .UCBVL(S1) ;IS A VOLUME MOUNTED ???
SETOM REMOTE ;YES,,SET THE FLAG
SKIPE .UCBAU(S1) ;IS IT DUAL PORTED ???
SETOM ACTIVE ;YES,,SET THE FLAG
SKIPE ACTIVE ;IS DUAL PORTED FLAG LIT ???
SKIPN REMOTE ; AND IS A VOLUME MOUNTED ???
JRST SDSK.1 ;BOTH NOT SET,,TRY AGAIN
SDSK.2: SETOM LSTUSR ;INDICATE WE WANT TO START UCB SCAN OVER
SDSK.3: PUSHJ P,GETDSK ;GET A DISK UCB
JUMPF SDSK.5 ;NO MORE,,GO FINISH UP
MOVE P1,S1 ;SAVE THE ENTRY ADDRESS
AOSG JOBNBR ;BUMP DEVICE COUNT BY 1
PUSHJ P,DSKHDR ;FIRST TIME,,PUT OUT THE DISK STATUS HDR
SKIPE S1,.UCBVL(P1) ;IS THERE A VOLUME MOUNTED ON IT ???
LOAD S1,.VLFLG(S1),VL.STA ;YES,,GET THE STRUCTURE STATUS BITS
CAXE S1,%STAMN ;IS IT MOUNTED ???
JRST SDSK.3 ;NO,,SKIP IT AND TRY NEXT UCB
SDSK.4: PUSHJ P,SDSK.A ;PUT OUT STATUS INFO FOR THIS UCB
LOAD P1,.UCBVL(P1) ;GET THE MOUNTED VOLUME ADDRESS
LOAD P1,.VLPTR(P1),VL.NXT ;GET THE PTR TO THE NEXT VOLUME
JUMPE P1,SDSK.3 ;NO MORE,,GET NEXT UCB
MOVE P1,.VLUCB(P1) ;GET THAT VOL'S UNIT ADDRESS
JRST SDSK.4 ;AND PUT IT OUT
SDSK.5: SETOM LSTUSR ;INDICATE RESCAN OF UCB QUEUE
SDSK.6: PUSHJ P,GETDSK ;GET A DISK UCB
JUMPF SDSK.7 ;NO MORE,,FINISH UP
MOVE P1,S1 ;SAVE THE UCB ADDRESS
SKIPN S1,.UCBVL(P1) ;IS THERE A VOLUME MOUNTED ON IT ???
JRST SDS.6B ;NO,,OUTPUT THE UNIT STATUS
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SDS.6A: MOVE S2,S1 ;SAVE THE CURRENT VOL BLOCK ADDRESS
LOAD S1,.VLPTR(S2),VL.PRV ;FIND THE PRIMARY VOL BLOCK FOR THIS STR
JUMPN S1,SDS.6A ;NOT THERE YET,,KEEP TRYING
LOAD S1,.VLFLG(S2),VL.STA ;YES,,GET STRUCTURE STATUS BITS
CAXN S1,%STAMN ;IS IT MOUNTED ???
JRST SDSK.6 ;YES,,SKIP IT AND TRY NEXT UCB
SDS.6B: PUSHJ P,SDSK.A ;PUT OUT THE UNIT STATUS DATA
JRST SDSK.6 ;AND CONTINUE
SDSK.7: AOSG S1,JOBNBR ;GET AND FIX DEVICE COUNT
JRST SDSK.8 ;NONE LISTED.. SEE WHY
PUSHJ P,CRLF ;ADD AN ENDING CRLF
PUSHJ P,SENDIT ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
SDSK.8: SKIPE DEVICE ;WANTED A SPECIFIC DISK?
JRST [$ACK (<Device ^W/DEVICE/ does not exist>,,,ACKCOD)
$RETT] ;YES, SAY WE DIDN'T FIND IT
$ACK (<No free drives>,,,ACKCOD)
$RETT
;Here to output the disk device status
SDSK.A: SKIPE NOROOM ;ANY ROOM LEFT IN THE CURRENT BUFFER ???
PUSHJ P,PAGOVF ;NO,,SEND CURRENT AND CONTINUE
$TEXT (DEPBYT,<^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
$ACK (<No structures exist>,,,ACKCOD) ;VERY STRANGE
$RETT
SSTR.0: SKIPE S2,DEVICE ;WANT TO SEE A PARTICULAR STRUCTURE?
CAMN S2,.VLNAM(S1) ;YES, IS THIS THE RIGHT ONE?
SKIPA ;YES, OR OPR WANTS EVERYTHING
JRST SSTR.5 ;INCORRECT STR, TRY THE NEXT ONE
MOVE P1,S1 ;SAVE ADDR OF THIS STR BLOCK
MOVE P4,S1 ;SAVE FOR SUMMARY LINE, TOO
AOSN JOBNBR ;FIRST ONE SHOWN?
PUSHJ P,STRHDR ;YES, TYPE THE HEADER
SKIPE NOROOM ;OVERFLOWED A PAGE?
PUSHJ P,PAGOVF ;YES, DUMP IT OUT
$TEXT (DEPBYT,<^W4L/.VLNAM(P1)/ ^A>) ;TYPE THE STR NAME
LOAD S2,.VLFLG(P1),VL.STA ;GET THE STATUS CODE
SETZ S1, ;NO TEXT YET
CAXN S2,%STADM ;IS IT DISMOUNTING?
MOVEI S1,[ASCIZ/Dismounting/] ;YES, SAY SO
CAXN S2,%STAWT ;IS IT WAITING?
MOVEI S1,[ASCIZ/Waiting to be mounted/] ;YES, SAY SO
JUMPN S1,[$TEXT(DEPBYT,< --^T/0(S1)/-->)
JRST SSTR.4] ;JUST PRINT THAT ON THE LINE
AOS NUMMTD ;ONE MORE STR MOUNTED
MOVE S1,.VLNAM(P1) ;GET THE STR NAME BACK
PUSHJ P,I$MNTC## ;FIND OUT HOW MANY USERS, FREE BLKS
ADDM S2,TOTFRE ;ACCUMULATE FREE BLOCKS ON ALL
MOVE P2,G$NOW## ;GET THE CURRENT TIME
SUB P2,.VLMTM(P1) ;CALC MOUNT TIME
MULX P2,^D<24*60> ; Get number of minutes in a day
ASHC P2,^D17 ; Shift binary point between P2,P3
IDIVI P2,^D60 ; Split to hours and minutes
$TEXT (DEPBYT,<^D3R/P2/:^D2R0/P3/ ^D8R/S2/ ^D5R/S1/ ^A>)
MOVE S1,P1 ;GET VOL BLOCK ADDRESS
PUSHJ P,D$NREQ## ;GET NUMBER OF REQUESTS NEEDING STR
$TEXT (DEPBYT,<^D4R/S1/ ^A>) ;DISPLAY NUMBER OF REQUESTS
MOVEI P2,1 ;WE'VE GOT ONE UNIT
MOVE S1,P1 ;COPY ADR OF VOL BLOCK
SSTR.1: LOAD S1,.VLPTR(S1),VL.NXT ;STEP TO NEXT
SKIPE S1 ;IS THERE A NEXT?
AOJA P2,SSTR.1 ;YES, KEEP LOOKING
MOVEI P3,1 ;SET FOR FIRST PACK IN STR
SSTR.2: $TEXT (DEPBYT,<^W6L/.VLVID(P1)/ ^D1/P3//^D1/P2/ ^A>) ;TYPE THE VOLUME ID
SKIPN S1,.VLUCB(P1) ;IS THIS VOLUME MOUNTED?
JRST SSTR.3 ;NO, SKIP THIS STUFF
LOAD S2,.UCBST(S1),UC.RSN ;GET THE DEVICE RESOURCE NUMBER
IMULI S2,AMALEN ;CALC THE ENTRY OFFSET
ADD S2,AMATRX## ;GET THE 'A' MATRIX ENTRY ADDRESS
$TEXT (DEPBYT,<^T4/@.AMNAM(S2)/ ^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
$ACK (<File structure ^W/DEVICE/ does not exist>,,,ACKCOD)
$RETT
SSTR.6: AOSN P1,JOBNBR ;GET TOTAL THAT WE LISTED
JRST [$ACK (<No file structures>,,,ACKCOD)
$RETT] ;AND RETURN
SOSN P1 ;EXACTLY ONE?
$ASCII (<One file structure>)
SKIPLE P1 ;MORE THAN ONE?
$TEXT (DEPBYT,< Total of ^D/JOBNBR/ file structures^A>)
SKIPLE P1 ;SUMMARY ONLY IF MORE THAN ONE STR
$TEXT (DEPBYT,<, ^D/NUMMTD/ mounted; ^D/TOTFRE/ free blocks>)
PUSHJ P,CRLF ;END THE LINE
SSTR.7: PUSHJ P,SENDIT ;FIRE THE MESSAGE BACK
$RETT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;A routine to show the users of a file structure.
;Call -
; S1/ SIXBIT primary Structure VOL block
;Returns -
; Always, adding descriptive text to the message
D$SUSR: $SAVE <P1,P2,P3,P4>
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 [
TOPS20< 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>)
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) ;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)
MOVE S2,.QEOID(AP) ;GET THE QUEUE ENTRY USER ID
XOR S2,LSTUSR ;COMBINE WITH LIST REQUESTS
SKIPE LSTUSR ;SEE IF LIST REQUEST USER ID
TDNN S2,LSTUSM ;MASK OUT
CAIA ;MATCHES
$RETF ;LOSER
MOVE S2,.QEJOB(AP) ;GET THE QUEUE ENTRY JOB NAME
XOR S2,LSTJOB ;COMBINE WITH LIST REQUESTS
SKIPE LSTJOB ;SEE IF LIST REQUEST JOB NAME
TDNN S2,LSTJBM ;MASK OUT
CAIA ;MATCHES
$RETF ;LOSER
SKIPGE S2,LSTUNT ;GET /UNIT
JRST POUT1 ;NOT SPECIFIED
SKIPE JOBACT ;SEE IF ACTIVE
JRST [MOVE S1,OBJUNI(P3) ;YES--GET UNIT FROM OBJ BLOCK
JRST POUT2] ;AND USE THAT
LOAD S1,.QEROB+.ROBAT(AP),RO.ATR;GET ATTRIBUTES
CAIE S1,%PHYCL ;PHYSICAL?
$RETF ;NO--DOESNT MATCH
LOAD S1,.QEROB+.ROBAT(AP),RO.UNI;GET REQUESTS UNIT
POUT2: CAIE S1,(S2) ;MATCH USERS?
$RETF ;NO--DOESNT MATCH
POUT1: 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.
SHSTAT: LOAD S1,OBJSTS(T1) ;GET THIS OBJECTS STATUS CODE
$TEXT (DEPBYT,<^T15L /@OBJSTC(S1)/ ^A>) ;OUTPUT THE STATUS
LOAD S1,OBJSCH(T1) ;GET THIS OBJECTS SCHEDLNG BITS
TXNN S1,OBSBUS ;IS IT BUSY ???
PJRST CRLF ;NO,,END NOW
LOAD S1,OBJITN(T1) ;GET THE CONTROLLING JOB
PUSHJ P,Q$SUSE## ;FIND THE JOB IN THE USE QUEUE
JUMPF CRLF ;SHOULD NOT HAPPEN !!
MOVE AP,S1 ;GET THE QUEUE ENTRY ADDRESS
$TEXT (DEPBYT,<^W6L /.QEJOB(AP)/ ^D6/.QERID(AP)/ ^I/USR/>)
SKIPN LISTYP ;IF THIS IS A FAST LISTING,,THEN
$RETT ;SKIP THE JOB STATUS DISPLAY
$ASCII (< >) ;INSERT A <TAB>
MOVEI S1,OBJST1(T1) ;GET THE JOBS STATUS DESCRIPTION ADDR
PUSHJ P,ASCOUT ;PUT IT OUT
PUSHJ P,CRLF ;END THE LINE
$RETT ;AND RETURN
SUBTTL SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND.
SHPARM: MOVE S1,OBTYPE ;GET THE OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
JRST SHPA.1 ;NO,,GO TRY SOMETHING ELSE
LOAD S1,OBJPRM+.OBTIM(T1),OBPMIN ;GET MIN TIME LIMIT
LOAD S2,OBJPRM+.OBTIM(T1),OBPMAX ;GET MAX TIME LIMIT
LOAD T2,OBJPRM+.OBPRI(T1),OBPMIN ;GET MIN PRIORITY
LOAD T3,OBJPRM+.OBPRI(T1),OBPMAX ;GET MAX PRIORITY
$TEXT (DEPBYT,<^D6R /S1/:^D6L /S2/ ^D2R /T2/:^D2L /T3/ ^A>)
IFN INPCOR,<
LOAD S1,OBJPRM+.OBCOR(T1),OBPMIN ;GET MIN CORE LIMIT
LOAD S2,OBJPRM+.OBCOR(T1),OBPMAX ;GET MAX CORE LIMIT
$TEXT (DEPBYT,<^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 P,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 T2,OBJPRM+.OOFRM(T1) ;GET THE FORMS TYPE
LOAD T3,OBJPRM+.OOPRI(T1),OBPMIN ;GET MIN PRIORITY
LOAD T4,OBJPRM+.OOPRI(T1),OBPMAX ;GET MAX PRIORITY
$TEXT (DEPBYT,<^D5R /S1/:^D6L /S2/ ^W6L /T2/ ^D2R /T3/:^D2L /T4/ ^A>)
LOAD S1,OBJPRM+.OOFLG(T1),.OFLEA ;GET LIMIT EXCEEDED ACTION
CAIN S1,.STIGN ;IS IT 'IGNORE' ???
$ASCII (<Proceed >) ;YES,,SAY SO
CAIN S1,.STCAN ;IS IT 'CANCEL' ???
$ASCII (<Abort >) ;YES,,SAY SO
CAIN S1,.STASK ;IS IT ASK ???
$ASCII (<Ask >) ;YES,,SAY SO
LOAD S1,OBJDAT(T1),RO.ATR ;GET THE DEVICE ATTRIBUTES
CAIN S1,%LOWER ;IS IT LOWER CASE??
$ASCII (< Lower>) ;YES,,SAY SO
CAIN S1,%UPPER ;IS IT UPPER CASE ??
$ASCII (< Upper>) ;YES,,SAY SO
LOAD S1,OBJSCH(T1),OBSSPL ;GET THE SPOOLING TO TAPE BITS
SKIPE S1 ;ARE WE SPOOLING TO TAPE ???
$TEXT (DEPBYT,< ^W/OBJPRM+.OOTAP(T1)/:^A>) ;YES,,SAY SO
PJRST CRLF ;END THE LINE & RETURN
SUBTTL 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
IFN NICSW,<
LOAD S1,.QEROB+.ROBAT(AP),RO.UNI ;GET UNIT NUMBER
MOVE S2,LSTUNI ;USER SPECIFY ONE ?
CAME S2,[-1] ;...
CAMN S2,S1 ;DOES IT MATCH ?
SKIPA ;YES, GO DUMP IT OUT.
$RETF ;DONT WANT THIS ONE.
>;IFN NICSW
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.
$TEXT (DEPBYT,<^1/OBTYPE/ Queue:>) ;PUT OUT THE HEADING
SKIPN LISTYP ;IS THIS A 'FAST' LISTING ??
$RETT ;YES,,RETURN NOW.
$ASCII (<Job Name Req# Limit User>)
PUSHJ P,CRLF ;OUTPUT A CRLF
$ASCII (<-------- ------ ------- ------------------------>)
PUSHJ P,CRLF ;OUTPUT A CRLF.
$RETT ;RETURN.
SUBTTL DEPBAT - ROUTINE TO PROCESS BATCH QUEUE ENTRYS.
DEPBAT: GETLIM S1,.QELIM(AP),ONOD ;GET /DESTINATION NODE NAME OR NUMBER
MOVE S2,LSTDND ;GET REQUESTED DESTINATION NODE
PUSHJ P,LSTNOD ;COMPARE THEM
SKIPE KLUDGE ;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: $ACK (<No outstanding allocations>,,,ACKCOD) ;TELL THE SAD NEWS
$RETT ;AND QUIT
LALDSP: XWD LALJNU,.ORJNU ;LIST A CERTAIN JOB
XWD LALREQ,.ORREQ ;LIST A BATCH REQUEST
LDSPLN==.-LALDSP ;TABLE LENGTH
;CONTINUED ON NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;Here to list a certain job's request
LALJNU: SETZ S2, ;SAY WE WANT ALL JOBS
MOVE S1,0(T3) ;GET THE DATA
AOJE S1,LALALL ;IF -1, LIST EVERYTHING
CAXLE S1,MAXRES+1 ;IS THE JOB NUMBER VALID ???
$RETF ;NO,,RETURN NOW
SOJA S1,L1ALOC ;JUST LIST THAT ONE
;Here to list a batch request's allocation
LALREQ: MOVX S2,BA%JOB ;SAY WE CAME FROM BATCH
MOVE S1,0(T3) ;GET THE REQUEST NUMBER
AOJE S1,LALALL ;IF -1, LIST EVERYTHING
SOS S1 ;NOT -1, GET NUMBER AGAIN
TXO S1,BA%JOB ;LIGHT THE BATCH REQUEST BIT
PJRST L1ALOC ;PUT INFO ABOUT THIS ONE OUT
;Here to list all the requests
LALALL: $SAVE <P1,P2> ;THE LIST POINTER
MOVE P2,S2 ;SAVE THE ENTRY FLAG
MOVE S1,BMATRX## ;GET THE LIST HANDLE
$CALL L%FIRST ;START AT THE TOP
LALA.1: JUMPF .RETT ;QUIT IF LIST EMPTY
SKIPE P2 ;WANT TO LIST ALL BATCH?
TDNE P2,.SMJOB(S2) ;YES, IS THIS BATCH?
SKIPA ;WANT ALL, OR THIS IS BATCH
JRST LALA.2 ;BATCH, BUT THIS IS NOT BATCH ENTRY
MOVE P1,S2 ;SAVE THE ADRS OF THIS BLOCK
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: MOVE T3,S1 ;SAVE THE HEADER ADDRESS.
PUSHJ P,M%GPAG ;GET A PAGE FOR OUTPUT.
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT IN THE SAB
MOVX S2,PAGSIZ ;GET A PAGE LENGTH
MOVEM S2,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
MOVE S2,[.OHDRS,,.OMACS] ;GET MSG TYPE PARMS.
MOVEM S2,.MSTYP(S1) ;SAVE IT IN THE MSG.
MOVE S2,ACKCOD ;GET THE OPR ACK CODE.
MOVEM S2,.MSCOD(S1) ;SAVE IT IN THE MSG.
MOVX S2,WT.SJI+WT.NFO ;GET JOB INFO SUPPRESS BITS.
MOVEM S2,.OFLAG(S1) ;SAVE IT IN THE MSG.
AOS .OARGC(S1) ;ADD 1 TO THE ARGUMENT COUNT.
MOVEI S1,.OHDRS(S1) ;POINT TO THE FIRST MESSAGE BLK.
SKIPE T3 ;SKIP IF NO HEADER WANTED.
PUSHJ P,SETHDR ;ELSE GO PUT IT IN.
MOVEI T4,.CMTXT ;GET THE TEXT BLOCK TYPE.
MOVEM T4,ARG.HD(S1) ;SAVE IT IN THE MESSAGE.
MOVEI T4,ARG.DA(S1) ;POINT TO DATA AREA.
MOVEM T4,DATADR ;SAVE THE START DATA ADDRESS.
MOVE S1,G$SAB##+SAB.MS ;GET THE MESSAGE START ADDRESS.
SUB S1,T4 ;CALC NEG. NUMBER OF WORDS USED.
ADDI S1,^D512-^D75 ;CALC NUMBER OF WORDS LEFT.
IMULI S1,5 ;CALC NUMBER OF BYTES LEFT.
MOVEM S1,BYTCNT ;AND SAVE IT.
SETZM NOROOM ;RESET NO MORE ROOM FLAG.
HRLI T4,(POINT 7,) ;GEN THE BYTE POINTER.
MOVEM T4,BYTPTR ;AND SAVE IT.
$RETT ;RETURN
SUBTTL SETHDR - ROUTINE TO INSERT THE MESSAGE HEADER.
;Here with
; S1/ Adrs of free slot in message
; T3/ Adrs of ASCIZ string
;Returns
; display block into message
; S1 points to new first free location in message
SETHDR: $SAVE <P1> ;PRESERVE A REG
MOVE S2,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS.
AOS .OARGC(S2) ;ALSO BUMP THE BLOCK COUNT BY 1.
MOVX P1,.ORDSP ;GET BLOCK TYPE
STORE P1,ARG.HD(S1),AR.TYP ;SAVE IT IN THE MSG.
MOVE P1,G$NOW## ;GET THE TIME
MOVEM P1,ARG.DA(S1) ;SAVE TIME STAMP
MOVEI P1,ARG.DA+1(S1) ;POINT TO BLOCK DATA AREA.
HRLI P1,(POINT 7,) ;MAKE A BYTE POINTER OF IT
MOVEM P1,BYTPTR ;SAVE FOR TEXT OUTPUT ROUTINE
$TEXT (DEPBYT,<^T/0(T3)/^A>) ;DUMP THE HEAD INTO THE MESSAGE
HRRZ P1,BYTPTR ;GET LAST ADRS USED
SUBI P1,-1(S1) ;FIGURE LENGTH OF THIS BLOCK
STORE P1,ARG.HD(S1),AR.LEN ;MARK LENGTH OF THIS BLOCK
ADDI S1,0(P1) ;POINT TO NEXT SLOT AFTER THIS BLOCK
MOVSS P1 ;LENGTH TO LEFT HALF
ADDM P1,.MSTYP(S2) ;UPDATE MESSAGE LENGTH, TOO
$RETT
SUBTTL SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.
SNDMSG: MOVX S1,WT.MOR ;GET THE MORE PAGES COMMING BIT.
MOVE S2,G$SAB##+SAB.MS ;GET THE MESSAGE ADDRESS.
IORM S1,.OFLAG(S2) ;LIGHT THE BIT.
SENDIT: 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 DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO
DMPSTS: SKIPN LISTYP ;IF THIS IS A QUICK LIST,,SKIP THIS
JRST DMPS.8 ;EXIT
PUSHJ P,PADLIN ;PAD LINE LINE TO MAKE IT PRETTY
MOVE T3,BYTCNT ;GET THE CURRENT BYTE COUNT
SUBI T3,^D30 ;CALC ROOM TILL END OF LINE
LOAD S1,.QESEQ(AP),QE.HBO ;IS THE JOB IN OPERATOR HOLD ???
SKIPE S1 ;0=NO, 1=YES.
$ASCII (< Hold:Yes>) ;YES,,SAY SO
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
JRST DMPS.1 ;NO,,PROCESS AS OUTPUT QUEUE
MOVEI S1,^D13 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
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.3 ;CONTINUE ON
IFE NICSW,<
DMPS.1: MOVEI S1,^D12 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM.
LOAD S1,.QEROB+.ROBAT(AP),RO.ATR ;GET THE DEVICE ATTRIBUTES
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
LOAD S2,OBJUNI(P3) ;YES,,GET THE DEVICE NUMBER.
SKIPGE S2 ;DO WE HAVE ANYTHING ???
JRST DMP.1A ;NO,,SKIP THIS
SKIPN JOBACT ;IS THE JOB ACTIVE ???
$TEXT (DEPBYT,< /Unit:^D/S2/^A>) ;NOT ACTIVE,,SAY SO
SKIPE JOBACT ;CHECK JOB ACTIVE AGAIN.
$TEXT (DEPBYT,< On Unit:^D/S2/^A>) ;IS ACTIVE,,SAY SO
JRST DMPS.2 ;AND CONTINUE ON
DMP.1A: CAIN S1,%LOWER ;WAS IT LOWER??
$ASCII (< /Lower>) ;YES,,SAY SO
CAIN S1,%UPPER ;WAS IT /UPPER??
$ASCII (< /Upper>) ;YES,,SAY SO
>;IFE NICSW
IFN NICSW,<
DMPS.1: LOAD S1,.QEROB+.ROBTY(AP) ;Get the queue type
CAIE S1,.OTLPT ;Is it a printer ?
JRST [ 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 number
SKIPGE S2 ;Do we have anything ???
JRST DMPS.2 ;No,,skip this
SKIPN JOBACT ;Is the job active ???
$TEXT (DEPBYT,< /Unit:^D/S2/^A>) ;Not active,,say so
SKIPE JOBACT ;Check job active again.
$TEXT (DEPBYT,< On Unit:^D/S2/^A>) ;Is active,,say so
JRST DMPS.2] ;And continue on
GETLIM S2,.QELIM(AP),PRNT ;Get printer name
SKIPN JOBACT ;Is the job active ???
$TEXT (DEPBYT,< /Unit:^W/S2/^A>) ;Not active,,say so
SKIPE JOBACT ;Check job active again.
$TEXT (DEPBYT,< On Unit:^W/S2/^A>) ;Is active,,say so
>;IFN NICSW
DMPS.2: MOVEI S1,^D15 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S2,.QELIM(AP),FORM ;GET THE FORMS TYPE
MOVE S1,S2 ;PUT IT HERE ALSO
MOVX TF,FRMNOR ;GET 'NORMAL' FORMS NAME
ANDX S2,FRMSK1 ;JUST GET THE IMPORTANT PART
ANDX TF,FRMSK1 ;HERE ALSO
CAME S2,TF ;EVERYTHING OK ???
$TEXT (DEPBYT,< /Forms:^W/S1/^A>) ;NO,,SAY SO
DMPS.3: MOVEI S1,^D16 ;GET NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
MOVEI S1,.QEROB(AP) ;GET THE REQ OBK BLK ADDRESS
SETZM S2 ;NO OBJECT MATCH
PUSHJ P,N$CSTN## ;PERFORM ANY ROUTING
PUSHJ P,N$LOCL## ;IS IT A LOCAL NODE ???
JUMPT DMPS.4 ;YES,,SKIP THIS.
MOVE S1,.QEROB+.ROBTY(AP) ;GET THE OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH ???
MOVEI S1,[ASCIZ'/Dest:'] ;NO,,MAKE IT /DEST:
CAIN S1,.OTBAT ;TRY ONCE MORE...
MOVEI S1,[ASCIZ'/Proc:'] ;IT IS BATCH,,MAKE IT /PROC-NODE:
$TEXT (DEPBYT,< ^T/0(S1)/^T/NETASC(S2)/^A>) ;NO,,SAY SO
DMPS.4: MOVEI S1,^D12 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
MOVE S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;BATCH?
JRST DMP.42 ;NO
TOPS10 <
SKIPE G$MDA## ;MDA TURNED ON?
JRST DMP.40 ;YES - DO IT THE RIGHT WAY
> ;END TOPS10 CONDITIONAL
DMP.42: PUSHJ P,Q$CDEP## ;FIND THE MISSING STRUCTURE
SKIPT ;NONE THERE,,SKIP THIS
$TEXT (DEPBYT,< Str:^I/STRUCT/^A>) ;PUT IT OUT
JRST DMP.41 ;SKIP MDA STUFF
DMP.40: MOVE S1,.QESEQ(AP) ;GET STATUS BITS
TXNE S1,QE.HBO ;HELD BY OPERATOR?
JRST DMP.41 ;YES
TXNE S1,QE.WAM ;IS IT WAITING FOR A MOUNT ???
$ASCII (< Mount wait>) ;YES,,SAY SO
DMP.41: MOVE S1,G$NOW## ;GET CURRENT TIME
CAML S1,.QECRE(AP) ;IS THERE A /AFTER PARM ???
JRST DMP.4A ;NO,,SKIP THIS
MOVEI S1,^D24 ;GET LENGTH FOR NEXT FIELD
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /After:^H15/.QECRE(AP)/^A>) ;YES,,SAY SO
DMP.4A: SKIPG LISTYP ;IS THIS AN EVERYTHING LIST ??
JRST DMPS.7 ;NO,,SKIP THIS
LOAD S1,.QEROB+.ROBTY(AP) ;GET THE QUEUE TYPE
CAIE S1,.OTBAT ;IF BATCH,,CONTINUE ON
JRST DMPS.5 ;ELSE PROCESS OUTPUT QUEUE
MOVEI S1,^D11 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),UNIQ ;GET THE UNIQUE SWITCH
CAIN S1,%EQUYE ;IS IT /UNIQUE:YES ???
$ASCII (< /Uniq:Yes>) ;YES,,SAY SO
CAIN S1,%EQUNO ;OR IS IT /UNIQUE:NO ???
$ASCII (< /Uniq:No>) ;YES,,SAY SO
MOVEI S1,^D14 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),REST ;GET THE /RESTART SWITCH
CAIN S1,%EQRNO ;IS IT /RESTART:NO ???
$ASCII (< /Restart:No>) ;YES,,SAY SO
CAIN S1,%EQRYE ;IS IR /RESTART:YES ???
$ASCII (< /Restart:Yes>) ;YES,,SAY SO
MOVEI S1,^D13 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
GETLIM S1,.QELIM(AP),OINT ;GET /ASSISTANCE: VALUE
CAIN S1,.OPINY ;IS IT /ASSIST:YES ???
$ASCII (< /Assist:Yes>) ;YES,,SAY SO
CAIN S1,.OPINN ;IS IT /ASSIST:NO ???
$ASCII (< /Assist:No>) ;YES,,SAY SO
MOVEI S1,^D15 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;SEE IF ROOM
GETLIM S1,.QELIM(AP),OUTP ;GET /OUTPUT
CAIN S1,%EQONL ;NOLOG?
$ASCII (< /Output:Nolog>) ;YES
CAIN S1,%EQOLG ;LOG?
$ASCII (< /Output:Log>) ;YES
CAIN S1,%EQOLE ;ERROR?
$ASCII (< /Output:Error>) ;YES
MOVEI S1,^D16 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;SEE IF ROOM
GETLIM S1,.QELIM(AP),BLOG ;GET /BATLOG
CAIN S1,%BAPND ;APPEND?
$ASCII (< /Batlog:Append>) ;YES
CAIN S1,%BSCDE ;SUPERSEDE?
$ASCII (< /Batlog:Super>) ;YES
CAIN S1,%BSPOL ;SPOOL?
$ASCII (< /Batlog:Spool>) ;YES
JRST DMPS.6 ;CONTINUE ON
DMPS.5: MOVEI S1,^D20 ;GET THE FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ENOUGH ROOM
GETLIM S1,.QELIM(AP),NOT1 ;GET THE FIRST NOTE WORD
GETLIM S2,.QELIM(AP),NOT2 ;GET THE SECOND NOTE WORD
SKIPE S1 ;ANY NOTE THERE ???
$TEXT (DEPBYT,< /Note:^W6L /S1/^W/S2/^A>) ;YES,,SAY SO
DMPS.6: MOVEI S1,^D10 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
LOAD S1,.QESEQ(AP),QE.PRI ;GET THE JOB PRIORTY
CAXE S1,SPLPRI ;IS IT THE DEFAULT ???
$TEXT (DEPBYT,< /Prio:^D/S1/^A>) ;NO,,SAY SO
MOVEI S1,^D11 ;GET THE NEXT FIELD LENGTH
PUSHJ P,CHKSPC ;MAKE SURE THERE IS ROOM
$TEXT (DEPBYT,< /Seq:^D/.QESEQ(AP),QE.SEQ/^A>) ;OUTPUT SEQ #
DMPS.7: DMOVE S1,LASTPT ;GET THE LAST BYTPTR AND BYTCNT
SKIPE CRLFLG ;ARE WE STILL AT THE START OF THE LINE
DMOVEM S1,BYTPTR ;YES,,RESET THE BYTPTR AND BYTCNT
SKIPN CRLFLG ;SKIP IF WE DONT NEED A CRLF
DMPS.8: PUSHJ P,CRLF ;PUT OUT A CRLF
$RETT ;AND RETURN
SUBTTL PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE
;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
IFN NICSW,<
SETOM LSTUNI ;NO SPECIFIC UNIT
>;IFN NICSW
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.2 ;NO MORE, RESOLVE /DEST /PROC /NODE
LOAD S1,0(T3) ;GET THE FIRST ENTRY IN THE BLOCK
CAIN T1,.LSQUE ;IS THIS THE QUEUES BLOCK ???
MOVEM S1,QUEBITS ;SAVE THE QUEUE TYPE(S) WE WANT.
CAIN T1,.LSUSR ;OR IS IT THE USER BLOCK ???
MOVEM S1,LSTUSR ;SAVE THE USER DATA.
CAIN T1,.LSUSM ;USER MASK BLOCK?
MOVEM S1,LSTUSM ;YES--SAVE IT
CAIN T1,.LSJOB ;JOB NAME BLOCK?
MOVEM S1,LSTJOB ;YES--SAVE IT
CAIN T1,.LSJBM ;JOB NAME MASK BLOCK?
MOVEM S1,LSTJBM ;YES--SAVE IT
CAIN T1,.LSUNT ;UNIT SPECIFICATION BLOCK?
MOVEM S1,LSTUNT ;YES--SAVE IT
CAIN T1,.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 ???
IFE NICSW,<
MOVEM T3,OBJADR ;YES,,SAVE ITS ADDRESS
>;IFE NICSW
IFN NICSW,<
JRST [ MOVEM T3,OBJADR ;YES,,SAVE ITS ADDRESS
LOAD S1,OBJ.TY(T3) ;{G6} Get the object type
CAIE S1,.OTLPT ;{G6} Printer ?
JRST GETP.1 ;{G6} No, get the next block
MOVE S1,OBJ.UN(T3) ;{G6} Get the unit name
TLNN S1,(77B5) ;{G6} Is it a sixbit name ?
JRST GETP.1 ;{G6} No, next block then
$CALL P%FNAM## ;{G6} Convert name to node and number
JUMPF GETP.1 ;{G6} Ignore errors
MOVE T1,OBJADR ;{G6} Reload the object address
MOVE S1,PP.UNI(S2) ;{G6} Get the printer unit
MOVEM S1,OBJ.UN(T1) ;{G6} Save it in the object block
MOVE S1,PP.NOD(S2) ;{G6} Get the printer node name
MOVEM S1,OBJ.ND(T1) ;{G6} Save it in the object block
JRST GETP.1] ;{G6} And get another block
>;IFN NICSW
CAIN T1,.ORNOD ;IS THIS THE NODE BLOCK ???
MOVEM S1,NODE6B ;YES,,SAVE THE NODE WE WANT
IFN NICSW,<
CAIE T1,.LSUNI ;{G19} Is this the unit block ?
JRST GETP.3 ;{G19} No, check for other blocks
$CALL P%FNAM## ;{G19} Yes, convert to unit and node
JUMPF GETP.1 ;{G19} Ignore any error
MOVE S1,PP.UNI(S2) ;{G19} Get the unit number
MOVEM S1,LSTUNI ;{G19} And save it away
MOVE S1,PP.NOD(S2) ;{G19} Get the node name
MOVEM S1,NODE6B ;{G19} Save that also
JRST GETP.1 ;{G19} Process other blocks
GETP.3:
>;IFN NICSW
CAIE T1,.TAPDV ;IS IT A TAPE VOLUME BLOCK ???
CAIN T1,.STRDV ;OR IS IT A STRUCTURE BLOCK?
SKIPA ;TREAT THEM THE SAME
JRST GETP.1 ;NO,,SKIP IT AND PROCESS NEXT BLOCK
HRROI S1,0(T3) ;YES,,POINT TO THE ASCIZ DEVICE NAME
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,DEVICE ;SAVE IT
TOPS10< DEVNAM S2, ;GET THE REAL DEVICE NAME
SKIPA ;SKIP IF IT DOES NOT EXIST
MOVEM S2,DEVICE ;SAVE IT
> ;END TOPS10 CONDITIONAL
JRST GETP.1 ;AND GO TRY AGAIN.
; Resolve /DEST, /PROC and /NODE conflicts.
; This assumes 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
;
GETP.2: SETOM KLUDGE ;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 UTILITY ROUTINES
DEPBYT: IDPB S1,BYTPTR ;PUT THE BYTE INTO THE MESSAGE.
SOSG BYTCNT ;CHECK THE BYTES REMAINING.
SETOM NOROOM ;NO MORE ROOM,,TURN ON FLAG.
SETZM CRLFLG ;CLEAR THE CRLF FLAG
$RETT ;RETURN
PAGOVF: PUSHJ P,SNDMSG ;SEND THE MESSAGE OFF.
SETZ S1, ;INDICATE WE DONT HAVE ANY HEADER.
PUSHJ P,SETPAG ;GO SET UP A NEW OUTPUT PAGE.
$COUNT (NLAP) ;COUNT THE PAGES SENT
$RETT ;AND RETURN.
CRLF: MOVEI S1,[BYTE(7) 15,12,0,0,0] ;GET THE CRLF.
PUSHJ P,ASCOUT ;DUMP IT OUT
SETOM CRLFLG ;SAY LAST THING OUT WAS CRLF
$RETT ;AND RETURN
ASCOUI: PUSH P,S1 ;SAVE S1
HRRZ S1,@-1(P) ;GET THE ADRS OF THE MESSAGE
AOS -1(P) ;SKIP OVER THE ARG POINTER
PUSHJ P,ASCOUT ;DUMP IT OUT
POP P,S1 ;RESTORE S1
$RETT ;AND WIN
ASCOUT: PUSHJ P,.SAVE1 ;SAVE P1.
MOVE P1,S1 ;SAVE THE INPUT ADDRESS.
HRLI P1,(POINT 7,0) ;MAKE IT A BYTE POINTER.
ASCO.1: ILDB S1,P1 ;GET A BYTE.
JUMPE S1,.RETT ;DONE,,RETURN.
PUSHJ P,DEPBYT ;PUT IT OUT.
JRST ASCO.1 ;AND DO ANOTHER.
CHKSPC: ADD S1,T3 ;ADD FIELD LENGTH AND LAST BYTE ADDRESS
CAMG S1,BYTCNT ;IS THERE ROOM FOR THE FIELD ???
$RETT ;YES,,RETURN
PUSHJ P,CRLF ;INSERT A CRLF
DMOVE S1,BYTPTR ;GET THE BYTPTR AND BYTCNT
DMOVEM S1,LASTPT ;SAVE THEM IN CASE WE NEED THEM
$ASCII (< >) ;INSERT A TAB
SETOM CRLFLG ;INDICATE BEGINNING OF LINE
MOVE T3,BYTCNT ;GET THE BYTE COUNT
SUBI T3,^D64 ;GET NEW LINE END ADDRESS
$RETT ;AND RETURN
CHKLIN: MOVE S1,BYTCNT ;Get the current byte count for out page
SUBI S1,^D64 ;Subtract a "standard" line
SKIPG S1 ;More room left?
PUSHJ P,PAGOVF ;No, go set up next page
$RET ;Continue
; Compare two nodes
; Call: S1/ node name or number from QE
; S2/ requested node name or number (for listings only)
; PUSHJ P,CMPNOD to compare against NODE6B
; PUSHJ P,LSTNOD to compare against listing requests
;
; Ret: TRUE if a match, FALSE if no match
;
CMPNOD: MOVE S2,NODE6B ;GET THE NODE NAME/NUMBER WE WANT
LSTNOD: CAMN S2,[-1] ;IS IT ALL NODES ???
$RETT ;YES,,RETURN
PJRST N$MTCH## ;NO,,RETURN THROUGH NODE MATCH ROUTINE
END