Trailing-Edge
-
PDP-10 Archives
-
bb-kl11i-bm_tops20_v7_0_atpch_1-22
-
autopatch/oprqsr.x20
There is 1 other file named oprqsr.x20 in the archive. Click here to see a list.
TITLE OPRQSR ORION MODULE TO PROCESS QUASAR MESSAGES
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH GLXMAC,ORNMAC,QSRMAC,ACTSYM,NEBMAC ;[130]
PROLOG(OPRQSR)
ERRSET ;INITIALIZE ERROR TABLES
PARSET ;SETUP PARSER ENTRIES
;Version numbers
QSRMAN==:144 ;Maintenance edit number
QSRDEV==:143 ;Development edit number
VERSIN (QSR) ;Generate edit number
EXTERNAL G$NOW ;TIME OF DAY
EXTERNAL G$ARG1 ;ARGUMENT 1
EXTERNAL G$ARG2 ;ARGUMENT 2
EXTERNAL G$ARG3 ;ARGUMENT 3
EXTERNAL G$OPRA ;OPR ADDRESS
EXTERNAL G$HOST ;HOST NODE NAME
EXTERNAL G$ERR ;ERROR FLAG WORD
EXTERNAL G$CLUN ;[130]CLUSTER NODE BLOCK
EXTERNAL G$OUTP ;[130]RELEASE PAGE INDICATOR
EXTERNAL G$FERR ;[130]FIRST MESSAGE ERROR FLAG
EXTERNAL G$CBLK ;[130]CLUSTER NODE NAME BLOCK
;**;[144]At EXTERNAL G$CBLK +1L add 1 line JYCW Oct-18-88
EXTERNAL G$NOFG ;[144]/NODE: SWITCH
EXTERNAL SNDQSR ;SEND TO QUASAR
EXTERNAL SNDNEB ;[130]SEND TO NEBULA
TOPS10< EXTERNAL SNDACT> ;SEND TO ACTDAE
EXTERNAL GETPAG ;ROUTINE TO SETUP MO
EXTERNAL RELPAG ;[130]ROUTINE TO RELEASE A PAGE
EXTERNAL QRTONB ;[134]ORION TO NEBULA CODE TRANSLATION
EXTERNAL OPRENB ;OPR ENABLED
EXTERNAL MOVARG ;MOVE AN ARGUMENT
EXTERNAL MOVAR2 ;MOVE TWO WORD ARGUMENT
ENTRY BLDOBJ ;BUILD OBJECT BLOCK
ENTRY ARGRTN ;SETUP ARGUMENT IN MESSAGE
ENTRY CMDEND ;COMMAND END PROCESSING
;**;[144]At ENTRY CMDEND add 1 line JYCW Oct-18-88
ENTRY SNDCL0 ;[144]
$DATA OBJTYP,1 ;[125]TYPE OF OBJECT IN MESSAGE
SUBTTL Revision history
COMMENT \
74 4.2.1273 18-Mar-82
Add support for MOUNT FOO:/WRITE-LOCKED.
***** Release 4.2 -- begin maintenance edits *****
***** Release 5.0 -- begin development edits *****
100 5.1003 30-Dec-82
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
101 5.1021 5-Apr-83
Handle the new structure attributes EXCLUSIVE and SHARED. Support
the new SET PORT CI OFFLINE/ONLINE command (SETPOR routine).
102 5.1027 10-May-83
Change SET PORT CI OFFLINE/ONLINE to UNAVAILABLE/AVAILABLE.
103 5.1035 18-Jul-83
Add processing for REMOVAL/NOREMOVAL to the DISMOUNT STRUCTURE
command processing in Q$DISM.
104 5.1069 23-Jan-84
Add processing for new SHOW STATUS STRUCTURE command.
105 5.1080 6-Feb-84
Add routine Q$UNDE to support undefine command.
106 5.1111 1-Mar-84
Add routine Q$MOUNT to support MOUNT command.
107 5.1124 2-Apr-84
Add support to SETDSK to handle controller number.
110 5.1162 21-Sep-84
Add support for SNA Workstations
111 5.1170 19-Oct-84
Correct /SPOOL on SET PRINTER DESTINATION so as not to cause
ORION Message Error.
112 5.1186 5-Dec-84
Support the new SET PORT NI AVAILABLE/UNAVAILABLE command (SETPOR
routine).
113 5.1203 28-Feb-85
Add support for the SHOW CONFIGURATION DISK-DRIVE command.
114 5.1208 20-Mar-85
Correct symbols used in NI% JSYS support.
***** Release 5.0 -- begin maintenance edits *****
120 Increment maintenance edit level for GALAXY 5.
***** Release 6.0 -- begin development edits *****
125 6.1016 13-Oct-87
Add support for remote printing commands.
126 6.1020 19-Oct-87
Change the format of the ROUTE message to always include a name
block. This block is used by QUASAR only for remote LPTs, but adds consistency
to QUASAR's route table's entries.
127 6.1041 29-Oct-87
Add support for remote printer handling of the OPR SHOW STATUS PRINTER
and SHOW PARAMETERS PRINTER commands.
130 6.1078 15-Nov-87
Add support for the /CLUSTER-NODE: switch of the OPR SHOW command.
131 6.1072 12-Nov-87
In routine Q$STAR and LPTTY4, add the TERMINAL-CHARACTERISTIS block to
the start command.
132 6.1081 19-Nov-87
In STRDSP: add keyword entries for DUMPABLE/NONDUMPABLE.
133 6.1098 22-Nov-87
Add support for MOUNT STRUCTURE /CLUSTER-NODE
134 6.1099 22-Nov-87
Change routine SNDCLU to change the message code to what NEBULA
expects.
135 6.1078 25-Nov-87
Make routine CHCLUN:: global.
136 6.1114 3-Dec-87
Add support for the SHOW CLUSTER-GALAXY-LINK-STATUS command.
137 6.1143 17-Dec-87
Do not save and restore the switch type when calling routint
CHCLUN since it preserves the swithc type.
140 6.1225 8-Mar-88
Update copyright notice.
141 6.1226 8-Mar-88
Delete the check for /TERMINAL-CHAR in routine LPTTY4: and move it to
Q$SHUT:. This will fix the /PURGE bug in the ABORT command.
142 6.1230 24-Mar-88
SHOW STATUS TAPE /CHARACTERISTIC /CLUSTER-NODE: results in "illegally
formatted message".
143 6.1226 5-Apr-88
Edit 141 didn't delete the check for /TERMINAL-CHAR in LPTTY4 like it
suppose to.
144 6.1269 18-Oct-88
1. Implement the /CLUSTER-NODE: switch in the following commands:
START SHUTDOWN ABORT REQUEUE HOLD CANCEL.
2. Change routine CMDEND: to look for the /CLUSTER-NODE switch before looking
for confirm.
3. If the object with are addressing is a remote (/NODE) include the .RMLPT
bit in the object block.
4. In routine SNDC.2:, if the message is not found in table QRTONB: and the
message is a cluster command, set bit NEB%MS in the GALAXY header to state
that this message is a command message in the new format, there is no
convertion needed before sending it to QUASAR and send it as is.
\ ;End of Revision History
Subttl Table of Contents
; Table of Contents for OPRQSR
;
; Section Page
;
;
; 1. Revision history . . . . . . . . . . . . . . . . . . . 3
; 2. Q$SHUT Process SHUTDOWN command . . . . . . . . . . . 6
; 3. Q$NEXT - NEXT COMMAND PROCESSOR . . . . . . . . . . . 7
; 4. ARGRTN Setup an argument header . . . . . . . . . . . 8
; 5. CMDEND Process end of command and send the message . . 9
; 6. BLDOBJ Build an object block . . . . . . . . . . . . . 10
; 7. LPTTYP Process a LPT object . . . . . . . . . . . . . 11
; 8. BLDBLK . . . . . . . . . . . . . . . . . . . . . . . . 12
; 9. Q$FSPA Process FORWARDSPACE command . . . . . . . . . 13
; 10. Q$ALGN Process ALIGN command . . . . . . . . . . . . . 14
; 11. Q$SUPP Process suppress command . . . . . . . . . . . 15
; 12. Q$ABOR Process ABORT command . . . . . . . . . . . . . 16
; 13. PREQNM Process /REQUEST switch . . . . . . . . . . . . 17
; 14. Q$REQU Process REQUEUE command . . . . . . . . . . . . 18
; 15. Q$ROUT Process ROUTE command . . . . . . . . . . . . . 19
; 16. ROUBLK Build a remote printer object descriptor for RO 21
; 17. Q$RELE Process RELEASE command . . . . . . . . . . . . 22
; 18. PNODSW Process /NODE switch . . . . . . . . . . . . . 23
; 19. Q$CANC Process CANCEL command . . . . . . . . . . . . 24
; 20. CHKRMT Check for remote node input . . . . . . . . . . 25
; 21. Q$MODI Process MODIFY command . . . . . . . . . . . . 26
; 22. Q$SET Process the SET command . . . . . . . . . . . . 27
; 23. SETUSG Process SET USAGE command . . . . . . . . . . . 28
; 24. SETJOB Set operator values for a job . . . . . . . . . 29
; 25. SETxxx Process SET PARAMETERS . . . . . . . . . . . . 30
; 26. SETONL Process SET ONLINE command (TOPS20) . . . . . . 31
; 27. SETSCH Process SET SCHEDULER command (TOPS20) . . . . 32
; 28. SCHBAT Process SET SCHEDULER BATCH command (TOPS20) . 33
; 29. SCHCLS Process SET SCHEDULER CLASS command (TOPS20) . 34
; 30. SETNOD Process SET NODE command (DN60) . . . . . . . . 35
; 31. SETDSK Process SET DISK command (TOPS20) . . . . . . . 36
; 32. SETAVL Process set available/unavailable . . . . . . . 37
; 33. SETTAP Process SET TAPE command (TOPS20) . . . . . . . 38
; 34. PSTAPE Process tape drive argument . . . . . . . . . . 39
; 35. SETINI Process SET TAPE INITIALIZE command . . . . . . 40
; 36. SETDEN Process /DENSITY switch . . . . . . . . . . . . 41
; 37. SETOWN Process /OWNER switch . . . . . . . . . . . . . 42
; 38. SETVID Process /VOLUME-ID switch . . . . . . . . . . . 43
; 39. TABSRC Table search routine . . . . . . . . . . . . . 44
; 40. GETDES Get device designator word . . . . . . . . . . 45
; 41. GETTAP Get a tape device . . . . . . . . . . . . . . . 46
; 42. SETSTR Process SET STRUCTURE command (TOPS20) . . . . 47
; 43. SETPOR Process SET PORt command . . . . . . . . . . . 48
; 44. Q$SHCF Process SHOW CONFIGURATION command . . . . . . 49
; 45. Q$SHWS Process SHOW STATUS command . . . . . . . . . . 50
; 46. PROSHW Process SHOW STATUS and SHOW PARAMETERS . . . . 51
; 47. SHWNOD Process node for SHOW STATUS/PARAMETERS command 52
Subttl Table of Contents (page 2)
; Table of Contents for OPRQSR
;
; Section Page
;
;
; 48. SHWTAP Process SHOW STATUS TAPE command . . . . . . . 53
; 49. SHWSTR Process SHOW STATUS STRUCTURES command . . . . 54
; 50. SHWCFG Process SHOW CONFIGURATION DISK-DRIVE command . 55
; 51. SHWDSK Process SHOW STATUS DISK command . . . . . . . 56
; 52. Q$SHWQ Process SHOW QUEUES command . . . . . . . . . . 57
; 53. Q$SHWC Process SHOW CONTROL-FILE command . . . . . . . 59
; 54. Q$SHCL - SHOW CLUSTER-GALAXY-STATUS-LINK . . . . . . . 60
; 55. CLUNOD - Send the message as determined by CLUSTER-NOD 61
; 56. CHCLUN - Modify message for NEBULA . . . . . . . . . . 62
; 57. SNDCLU - Send a cluster message . . . . . . . . . . . 63
; 58. Q$DISM Process DISMOUNT command (TOPS20) . . . . . . . 64
; 59. Q$ESTR Process ENABLE AUTOMATIC-STRUCTURE-RECOGNITION 65
; 60. Q$ETAP Process ENABLE TAPE command . . . . . . . . . . 66
; 61. Q$LOCK Process LOCK command . . . . . . . . . . . . . 67
; 62. Q$MOUN Process MOUNT TAPE and DISK command . . . . . . 68
; 63. Q$IDEN Process IDENTIFY command . . . . . . . . . . . 69
; 64. Q$DEFI Process DEFINE command (DN60) . . . . . . . . . 70
; 65. Q$SWIT Process SWITCH command (TOPS20) . . . . . . . . 71
; 66. Q$MODS Process MODIFY SYSTEM-LISTS command (TOPS10) . 72
; 67. Q$SLST Process SHOW SYSTEM-LISTS command (TOPS10) . . 73
; 68. Q$SALC Process SHOW ALLOCATION command (TOPS10) . . . 74
; 69. Q$UNDE Process undefine command . . . . . . . . . . . 75
SUBTTL Q$SHUT Process SHUTDOWN command
;THIS ROUTINE WILL SEND THE APPROPRIATE OBJECT BLOCK TO QUASAR
;FOR THE DESIRED FUNCTION..
;THE ROUTINE IS CALLED WITH S1 CONTAINING THE MESSAGE TYPE
Q$SHUT:: $CALL BLDOBJ ;BUILD THE OBJECT
JUMPF SHUT0 ;[141]GO CHECK KEYWORD
MOVE S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[141]Get the object type
;**;[144]At Q$SHUT:+3L add 3 lines JYCW Oct-18-88
TXNN S1,.DQLPT ;[144]DQS?
TXNE S1,.CLLPT ;[144cluster printer?
JRST SHUT1 ;[144]yes, check for /cluster-node
TXNN S1,.LALPT ;[141]Is it a LAT?
;**;[144]At Q$SHUT:+7L change 1 line JYCW Oct-18-88
JRST SHUT ;[141][144]No,
$CALL P$SWIT ;[141] IS THERE ANOTHER SWITCH
JUMPF CMDEND ;[141]NO GO SEND COMMAND
CAIE S1,.SWTTC ;[141]WAS IT TTY CHARACTERISTIC
;**;[144]At Q$SHUT:+11L change 1 line JYCW Oct-18-88
JRST SHUT2 ;[144]NO
$CALL P$SIXF ;[141]GET SIXBIT FIELD
$RETIF ;[141]NO GOOD
;BUILD NEW BLOCK, /TERMINAL-CHARACTERISTIC BLOCK, .ORTCR.
MOVEM S1,T4 ;[141]SAVE THE TTY CHARACTERISTIC
MOVEI S2,2 ;[141] TWO WORDS
MOVEI S1,T3 ;[141]POINT TO THE ARG DATA
MOVX T1,.ORTCR ;[141]TTY CHARACT BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;[141]SAVE THE TYPE
HRLM S2,ARG.HD(S1) ;[141]SAVE THE TYPE
$CALL MOVARG ;[141]MOVE THE BLOCK AND RETURN
;**;[144]At SHUT0:-1L add 1 line JYCW Oct-18-88
JRST SHUT1 ;[144]FINISH OFF COMMAND
SHUT0: $CALL P$KEYW ;[141]CHECK FOR KEYWORD
JUMPF E$IFC ;ERROR..RETURN
CAIE S1,.KYNOD ;WAS IT A NODE
$RETF ;BAD COMMAND
MOVE S1,OBJTYP ;[125]PICK UP THE OBJECT TYPE
CAIN S1,.OTLPT ;[125]A PRINTER?
$RETF ;[125]YES, RETURN NOW
$CALL CNODSW ;ADD THE NODE NAME TO THE MESSAGE
$RETIF ;CAN'T
PJRST CMDEND ;END THE COMMAND
;**;[144]At SHUT0:+10L add routine SHUT: JYCW Oct-18-88
;S1/CONTAINS THE OBJECT TYPE
SHUT: LOAD S2,.MSTYP(MO),MS.TYP ;[144]Get the message type
CAIN S2,.OMSHT ;[144]Is this shutdown
JRST SHUT1 ;[144]Yes, check for /cluster-node
CAIN S1,.OTLPT ;[144]IS IT A PRINTER?
JRST CMDEND ;[144]Yes, must be a line printer
SHUT1: $CALL P$SWIT ;[144]Get a switch
JUMPF CMDEND ;[144]None all done
SHUT2: $CALL CHCLUN ;[144]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF .POPJ ;[144]NOT A CLUSTER-NODE SWITCH
SKIPN G$CLUN ;[144]REMOTE NODE SPECIFIED?
JRST CMDEND ;[144]NO, TREAT AS LOCAL
PJRST SNDCLU ;[144]SEND THE MESSAGE TO NEBULA
SUBTTL Q$CONT Process CONTINUE command
Q$CONT:: $CALL BLDOBJ ;BUILD AN OBJECT BLOCK
$RETIF ;RETURN FALSE BACK UP
PJRST CMDEND ;CHECK FOR END AND SEND MESSAGE
SUBTTL Q$STAR Process START command
;THE START COMMAND IS THE SAME AS THE SHUTDOWN, CONTINUE
; COMMANDS EXCEPT THAT THE START COMMAND FOR PRINTERS
;CAN HAVE AN OPTIONAL DEVICE FIELD.
Q$STAR:: $CALL Q$SHUTDN ;PROCESS THE!FIRST PART
$RETIT ;O.K..COMMAND FINISHED
MOVE S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;GET THE OBJECT TYPE
TLNE S1,LHMASK ;[125]A REMOTE PRINTER?
$RET ;[125]YES, RETURN THE ERROR
CAIE S1,.OTLPT ;IS IT A PRINTER?
$RETF ;NO..INVALID MESSAGE
$CALL P$SWIT ;IS THERE A SWITCH?
$RETIF ;NO..INVALID COMMAND
CAIE S1,.SWDEV ;WAS IT DEVICE?
;**;[144] Q$STAR:+10L change 1 line JYCW Oct-18-88
JRST Q$STA ;[144]No, how about /cluster-node
LOAD S1,OBJ.UN+ARG.DA+.OHDRS(MO),OU.HRG ;GET HIGH RANGE
SKIPE S1 ;CHECK IF THERE IS ONE
PJRST E$RNA ;RANGE NOT ALLOWED IN START /DEVICE
$CALL PSDEVI ;PROCESS DEVICE BLOCK
$RETIF ;RETURN ON ERROR
$CALL P$SWIT ;[131] IS THERE ANOTHER SWITCH
JUMPF Q$STA1 ;[131]NO GO SEND COMMAND
CAIE S1,.SWTTC ;[131]WAS IT TTY CHARACTERISTIC
;**;[144]At Q$STAR:+19L change 1 libne JYCW Oct-18-88
JRST Q$STA ;[144]NO,WAS IT /CLUSTER-NODE
$CALL P$SIXF ;[131]GET SIXBIT FIELD
$RETIF ;[131]NO GOOD
;BUILD NEW BLOCK, /TERMINAL-CHARACTERISTIC BLOCK, .ORTCR.
MOVEM S1,T4 ;[131]SAVE THE TTY CHARACTERISTIC
MOVEI S2,2 ;[131] TWO WORDS
MOVEI S1,T3 ;[131] POINT TO THE ARG DATA
MOVX T1,.ORTCR ;[131]TTY CHARACT BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;[131]SAVE THE TYPE
HRLM S2,ARG.HD(S1) ;[131]SAVE THE TYPE
$CALL MOVARG ;[131]MOVE THE BLOCK AND RETURN
;**;[144]At Q$STAR:+29L add 6 lines JYCW Oct-18-88
$CALL P$SWIT ;[144]CHECK FOR A SWITCH
JUMPF CMDEND ;[144]NONE, SO SEND THE MESSAGE
Q$STA: $CALL CHCLUN ;[144]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF .POPJ ;[144]NOT A CLUSTER-NODE SWITCH
SKIP G$CLUN ;[144]REMOTE NODE SPECIFIED?
PJRST SNDCLU ;[144]SEND THE MESSAGE TO NEBULA
Q$STA1: PJRST CMDEND ;NO CHECK FOR END AND RETURN
SUBTTL Q$PAUS Process the STOP command
Q$STOP:: $CALL BLDOBJ ;[125]BUILD AN OBJECT BLOCK
$RETIF ;RETURN FALSE BACK UP
$CALL P$KEYW ;DO WE HAVE A KEYWORD ???
JUMPF STOP.1 ;NO,,DEFAULT TO IMMEDIATE
CAXN S1,.KYIMM ;IS IT IMMEDIATELY ???
JRST STOP.1 ;YES,,SAY SO
CAXE S1,.KYAFT ;NOT IMMEDIATE,,MUST BE AFTER !!!
$RETF ;NO,,RETURN AN ERROR
$CALL P$KEYW ;GET THE NEXT KEYWORD
$RETIF ;NOT THERE,,THATS AN ERROR
MOVX S2,ST.ACR ;DEFAULT TO CURRENT REQUEST
CAXN S1,.KYAER ;UNLESS IT IS EVERY REQUEST
MOVX S2,ST.AER ;THEN MAKE IT EVERY REQUEST
SKIPA ;SKIP OVER IMMEDIATE STATUS
STOP.1: MOVX S2,ST.IMM ;GET IMMEDIATE STATUS BIT
MOVEM S2,.OFLAG(MO) ;SAVE FLAG BITS
PJRST CMDEND ;CHECK FOR END AND SEND MESSAGE
SUBTTL Q$NEXT - NEXT COMMAND PROCESSOR
Q$NEXT:: $CALL BLDOBJ ;[NXT] BUILD AN OBJECT BLOCK
$RETIF ;[NXT] RETURN FALSE BACK UP
$CALL P$KEYW ;[NXT] DO WE HAVE A KEYWORD ???
$RETIF ;[NXT] ERROR..RETURN
CAXE S1,.KYRQN ;[NXT] MUST BE REQUEST-ID !!!
$RETF ;[NXT] NO,,THATS AN ERROR
$CALL PREQNM ;[NXT] PROCESS REQUEST NUMBER
$RETIF ;[NXT] ERROR..RETURN
PJRST CMDEND ;[NXT] FINISH OFF COMMAND
SUBTTL ARGRTN Setup an argument header
;THIS ROUTINE WILL SETUP THE ARGUMENT HEADER FROM THE
;TYPE IN S1 AND THE LENGTH IN S2. IT WILL ALSO ADVANCE P3 TO NEXT
;LOCATION IN MESSAGE AND BUMP ARGUMENT COUNT FOR MESSAGE
ARGRTN: STORE S1,ARG.HD(P3),AR.TYP ;SAVE THE TYPE FIELD
STORE S2,ARG.HD(P3),AR.LEN ;SAVE THE LENGTH
AOS .OARGC(MO) ;BUMP ARGUMENT COUNT
ADD P3,S2 ;BUMP TO NEXT FREE LOCATION
$RETT ;O.K...RETURN TRUE
SUBTTL CMDEND Process end of command and send the message
;THIS ROUTINE WILL CHECK FOR END OF COMMAND AND IF O.K
;PREPARE MESSAGE TO BE SENT TO QUASAR
;[144]Since the /CLUSTER-NODE switch is the last switch, check for that before
;checking for CONFIRM. This way we don't have to change all the routines to
;check for /CLUSTER-NODE.
;**;[144]At CMDEND:+0L add 9 lines JYCW Oct-18-88
CMDEND: $CALL P$SWIT ;[144]Get a switch
JUMPF CMDEN1 ;[144]None CHECK FOR CONFIRM
$CALL CHCLUN ;[144]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF CMDEN ;[144]NOT A CLUSTER-NODE SWITCH
SKIPE G$CLUN ;[144]REMOTE NODE SPECIFIED?
PJRST SNDCLU ;[144]YES, SEND THE MESSAGE TO NEBULA
SKIPA ;[144]
CMDEN: $CALL P$PREV ;[144]Back up one switch
CMDEN1: $CALL P$CFM ;[144]CHECK FOR CONFIRM
$RETIF ;NO..INVALID MESSAGE
ANDI P3,777 ;GET MESSAGE LENGTH
STORE P3,.MSTYP(MO),MS.CNT ;SAVE MESSAGE SIZE IN MESSAGE
SKIPN G$CLUN ;[130]CLUSTER NODE BLOCK DETECTED?
PJRST SNDQSR ;[130]NO, SEND THE MESSAGE TO QUASAR
PJRST SNDNEB ;[130]YES, SEND TO NEBULA
SUBTTL BLDOBJ Build an object block
SUBTTL FINOBJ Finish object block after type field
;THIS ROUTINE WILL BUILD AN OBJECT BLOCK FOR A MESSAGE TO AN
;OBJECT PROCESSOR AND PLACE IT IN THE MESSAGE POINTED TO BY
;MO
BLDOBJ: $CALL P$KEYW ;GET A KEYWORD
MOVEM S1,OBJTYP ;[125]SAVE THE OBJECT TYPE
$RETIF ;NOT A KEYWORD..INVALID..RETURN
CAILE S1,.OTMAX ;LESS THAN OR EQUAL VALID OBJECT
JRST BLDO.6 ;INVALID TYPE..RETURN
MOVE P1,S1 ;[125]SAVE THE OBJECT TYPE
CAIE S1,.OTBAT ;WAS IT A BATCH BLOCK
JRST BLDO.1 ;NO..IGNORE CHECK
MOVE S1,G$HOST ;GET THE HOST NAME
$CALL OPRENB ;MUST BE SYSTEM OR LOCAL
JUMPF E$BNR ;BATCH COMMANDS MUST BE LOCAL
MOVE S1,P1 ;GET THE TYPE BACK
BLDO.1: STORE S1,ARG.DA+OBJ.TY(P3) ;SAVE THE TYPE
FINOBJ: SETZM ARG.DA+OBJ.UN(P3) ;ZERO THE UNIT NUMBER FIELDS
$CALL P$NUM ;GET A NUMBER
SKIPT ;[125]A NUMBER?
PJRST LPTTYP ;[125]NO, CHECK FOR A REMOTE LPT
TLNE S1,-1 ;Ligit number? (Fit in half word)
PJRST E$IRS ;No - fake user with illeg. range
STORE S1,ARG.DA+OBJ.UN(P3),OU.LRG ;SAVE AS LOW RANGE
MOVE P1,S1 ;SAVE THE LOW RANGE
$CALL P$TOK ;CHECK FOR TOKEN AND RANGE
JUMPF BLDO.2 ;NO..CHECK FOR NODE
;IGNORE TOKEN
$CALL P$NUM ;GET THE OTHER NUMBER
$RETIF ;INVALID FIELD..NUMBER NEEDED
CAML P1,S1 ;CHECK FOR VALID RANGE
PJRST E$IRS ;UNITS OUT OF RANGE
TLNE S1,-1 ;Ligit number? (Fit in half word)
PJRST E$IRS ;No - fake user with illeg. range
STORE S1,ARG.DA+OBJ.UN(P3),OU.HRG ;SAVE THE HIGH RANGE
BLDO.2: ZERO ARG.DA+OBJ.ND(P3) ;INITIALIZE NODE FIELD
$CALL P$SWIT ;GET A SWITCH
JUMPF BLDO.4 ;NOT A SWITCH,,CHECK CONFIRM
CAIE S1,.SWNOD ;WAS IT A NODE
JRST BLDO.3 ;NO..SETUP NODE VALUE IN BLOCK
$CALL P$NODE ;GET THE NODE
JUMPF BLDO.3 ;GET NODE FROM NODE ENTRY
MOVE P1,S1 ;SAVE THE NODE DATA
;**;[144]at BLDO.2:+8L add 1 line JYCW Oct-18-88
SETOM G$NOFG ;[144]We have a /NODE: switch
PJRST BLDO.5 ;SAVE NODE AND RETURN
BLDO.3: $CALL P$PREV ;POSITION TO THE PREVIOUS ONE
;ON INPUT
BLDO.4: MOVE T1,G$OPRA ;GET OPERATOR ENTRY ADDRESS
MOVE T1,OPR.ND(T1) ;GET NODE ADDRESS
MOVE P1,NOD.NX(T1) ;GET NODE NAME ON -20
BLDO.5: STORE P1,ARG.DA+OBJ.ND(P3) ;SAVE THE NODE NAME
MOVE S1,P1 ;Copy affected node
$CALL OPRENB ;See if ok for this OPR
$RETIF ;No..return the failure
MOVX S1,.OROBJ ;TYPE OF DATA ELEMENT..OBJ BLOCK
MOVX S2,.OBJLN ;SIZE OF THE BLOCK
PJRST ARGRTN ;SETUP HEADER,COUNT, POINTER..RETT
BLDO.6: $CALL P$PREV ;POSITION TO THE PREVIOUS ONE
$RETF ;RETURN FALSE
SUBTTL LPTTYP Process a LPT object
;**;[125]ROUTINE LPTTYP IS ADDED AS PART OF THIS EDIT
LPTTYP:CAIE P1,.OTLPT ;IS THIS A LPT OBJECT?
$RET ;PRESERVE THE ERROR AC
;CHECK THE TYPE OF LPT
$CALL P$KEYW ;PICK UP THE PRINTER TYPE
$RETIF ;ILLEGALLY FORMATTED COMMAND
LPTTY0: CAIN S1,.KYDQS ;IS THIS A DQS LPT?
JRST LPTTY3 ;YES, GO PROCESS
CAIN S1,.KYLAT ;IS THIS A LAT LPT?
JRST LPTTY4 ;YES, GO PROCESS
CAIN S1,.KYCLU ;[127]IS THIS A CLUSTER LPT?
JRST LPTTY1 ;[127]YES, GO PROCESS
CAIE S1,.KYLOC ;[127]IS THIS A LOCAL LPT?
$RETF ;NO, INDICATE AN ERROR
;THE LPT OBJECT IS A LOCAL LPT (FROM SHOW STATUS OR SHOW PARAMETER COMMAND)
MOVX S1,.LOLPT ;[127]PICK UP THE LOCAL LPT TYPE
IORM S1,ARG.DA+OBJ.TY(P3) ;[127]INDICATE IN THE MESSAGE TO QUASAR
MOVE S1,G$HOST ;[127]PICK UP THE LOCAL NODE NAME
MOVEM S1,ARG.DA+OBJ.ND(P3) ;[127]PLACE IN THE OBJECT BLOCK
$CALL P$NUM ;[127]CHECK FOR A UNIT NUMBER
JUMPF LPTTY5 ;[127]NONE, GO INDICATE IN OBJECT BLOCK
TLNE S1,-1 ;[127]IS THE UNIT NUMBER TOO LARGE?
PJRST E$IRS ;[127]YES, INFORM THE OPR
STORE S1,ARG.DA+OBJ.UN(P3),OU.LRG ;[127]SAVE THE LOWER UNIT NUMBER
MOVE P1,S1 ;[127]SAVE THE LOWER UNIT NUMBER
$CALL P$TOK ;[127]CHECK FOR THE ":" TOKEN
JUMPF LPTTY6 ;[127]IF NONE, THEN UPDATE THE BLOCK
$CALL P$NUM ;[127]PICK UP THE HIGHER UNIT NUMBER
$RETIF ;[127]NO NUMBER, INDICATE AN ERROR
CAMLE S1,P1 ;[127]LOW UNIT NUMBER LESS THAN HIGH?
TLNE S1,-1 ;[127]YES, IS HIGH UNIT # TOO LARGE?
PJRST E$IRS ;[127]YES, INDICATE ILLEGAL RANGE
STORE S1,ARG.DA+OBJ.UN(P3),OU.HRG ;[127]SAVE THE HIGHER UNIT NUMBER
JRST LPTTY6 ;[127]UPDATE THE BLOCK TYPE/LENGTH
;THE LPT OBJECT IS A CLUSTER LPT
LPTTY1: MOVX S1,.CLLPT ;[127]PICK UP THE CLUSTER LPT TYPE
IORM S1,ARG.DA+OBJ.TY(P3) ;INDICATE IN THE MESSAGE TO QUASAR
$CALL P$NUM ;PICK UP THE LOWER UNIT NUMBER
JUMPF LPTTY5 ;[127]IF NO NUMBER THEN FROM SHOW
TLNE S1,-1 ;IS THE UNIT NUMBER TOO LARGE?
PJRST E$IRS ;YES, INFORM THE OPR
STORE S1,ARG.DA+OBJ.UN(P3),OU.LRG ;SAVE THE LOWER UNIT NUMBER
MOVE P1,S1 ;SAVE THE LOWER UNIT NUMBER
$CALL P$TOK ;CHECK FOR THE ":" TOKEN
JUMPF LPTTY2 ;NO ":", CHECK FOR NODE SWITCH
$CALL P$NUM ;PICK UP THE HIGHER UNIT NUMBER
$RETIF ;NO NUMBER, INDICATE AN ERROR
CAMLE S1,P1 ;LOW UNIT NUMBER LESS THAN HIGH?
TLNE S1,-1 ;YES, IS HIGH UNIT # TOO LARGE?
PJRST E$IRS ;YES, INDICATE ILLEGAL RANGE
STORE S1,ARG.DA+OBJ.UN(P3),OU.HRG ;SAVE THE HIGHER UNIT NUMBER
LPTTY2: $CALL NOSNAM ;PICK UP THE NODE NAME
$RET ;RETURN TO THE CALLER
;THE OBJECT IS A DQS LPT
LPTTY3: MOVX S2,.DQLPT ;PICK UP THE DQS LPT BIT
IORM S2,ARG.DA+OBJ.TY(P3) ;INDICATE IN THE TYPE FIELD
$CALL BLDBLK ;FILL IN REST OF THE OBJECT
$RET ;RETURN TO THE CALL
;THE OBJECT IS A LAT LPT
LPTTY4: MOVX S1,.LALPT ;PICK UP THE LAT LPT BIT
IORM S1,ARG.DA+OBJ.TY(P3) ;INDICATE IN THE TYPE FIELD
$CALL P$KEYW ;PICK UP PORT OR SERVICE
JUMPF LPTTY5 ;[127]IF NO KEYWORD, THEN SHOW
CAIE S1,.KYPOR ;PORT SPECIFIED?
MOVEI S1,.KYSER ;NO, INDCICATE A SERVICE
$CALL BLDBLK ;FILL IN REST OF THE OBJECT
$RET ;PRESERVE ERROR FLAG
;SHOW STATUS (OR PARAMETER) PRINTER COMMANDS MAY HAVE FORMATS:
; SHOW STATUS PRINTER CLUSTER
; SHOW STATUS PRINTER LAT
LPTTY5: SETOM ARG.DA+OBJ.UN(P3) ;[127]INDICATE FOR ALL
LPTTY6: MOVEI S1,.OROBJ ;[127]PICK UP THE OBJECT DESCRIPTOR ADR
MOVEI S2,.OBJLN ;[127]PICK UP THE OBJECT DESCRIPTOR LEN
$CALL ARGRTN ;[127]UPDATE THE BLOCK TYPE/LENGTH
$RET ;[127]RETURN PRESERVING TRUE/FALSE FLAG
SUBTTL BLDBLK
;**;[125]ROUTINE BLDBLK IS ADDED AS PART OF THIS EDIT
BLDBLK: MOVEI T1,.OBJLN(P3) ;POINT TO THE NAME BLOCK
STORE S1,ARG.HD(T1),AR.TYP ;SAVE THE TYPE OF NAME
$CALL P$FLD ;PICK UP THE NAME
JUMPF NOSNA2 ;[127]FROM A SHOW COMMAND IF NO NAME
AOS S1 ;BYPASS THE PARSER HEADER BLOCK
MOVSS S1 ;PREPARE THE SOURCE OF THE BLT
HRRI S1,ARG.DA(T1) ;SOURCE,,DESTINATION OF THE BLT
ADD T1,S2 ;END ADDRESS + 1
BLT S1,-1(T1) ;MOVE NAME INTO MESSAGE
MOVEI S2,LPTNLN ;[127]PICK UP BLOCK LENGTH
STORE S2,.OBJLN(P3),AR.LEN ;SAVE THE LENGTH OF THIS BLOCK
AOS .OARGC(MO) ;INCREMENT THE NUMBER OF BLOCKS
$CALL NOSNAM ;INCLUDE THE NODE NAME IN THE MSG
JUMPF .POPJ ;PASS ON ANY ERROR
ADDI P3,LPTNLN ;[127]POINT TO THE NEXT BLOCK
$RET ;PRESERVE THE TRUE INDICATION
;**;[125]ROUTINE NOSNAM IS ADDED AS PART OF THIS EDIT.
;PICK UP THE NODE (OR SERVER) NAME FOR A REMOTE LPT AND PLACE IN THE
;MESSAGE TO QUASAR.
NOSNAM: $CALL P$KEYW ;PICK UP THE KEYWORD
$RETIF ;INDICATE MSG ILLEGALLY FORMATTED
CAIN S1,.KYNOD ;A NODE KEYWORD?
JRST NOSNA1 ;YES, CONTINUE PROCESSING
CAIE S1,.KYSRV ;A SERVER KEYWORD?
$RETF ;NO, MESSAGE ILLEGALLY FORMATTED
NOSNA1: $CALL P$NODE ;PICK UP THE NODE (SERVER) NAME
$RETIF ;PASS ON ANY ERROR
STORE S1,ARG.DA+OBJ.ND(P3) ;SAVE THE NODE (SERVER) NAME
JRST NOSNA3 ;[127]UPDATE THE OBJECT DESCRIPTOR BLK
;OPR SHOW STATUS (OR PARAMETERS) PRINTER COMMANDS CAN HAVE THE FOLLOWING
;FORMATS:
; SHOW STATUS PRINTER DQS
; SHOW STATUS PRINTER LAT PORT
; SHOW STATUS PRINTER LAT SERVICE
NOSNA2: LOAD S1,ARG.HD(T1),AR.TYP ;[127]PICK UP THE REMOTE NAME TYPE
MOVE S2,ARG.DA+OBJ.TY(P3) ;[127]PICK UP REMOTE LPT TYPE
TXNE S2,.DQLPT ;[127]IS IT A DQS LPT?
SETO S1, ;[127]INDICATE FOR ALL DQS LPT
MOVEM S1,ARG.DA+OBJ.UN(P3) ;[127]PLACE IN THE UNITS FIELD
NOSNA3: MOVEI S1,.OROBJ ;[127]PICK UP OBJECT DESCRIPTOR CODE
MOVEI S2,.OBJLN ;PICK UP OBJECT DESCRIPTOR LENGTH
$CALL ARGRTN ;UPDATE THE MESSAGE TO QUASAR
$RET ;PRESERVER THE TRUE/FALSE FLAG
SUBTTL Q$FSPA Process FORWARDSPACE command
SUBTTL Q$BSPA Process BACKSPACE command
Q$FSPA::
Q$BSPA:: $CALL LPTOBJ ;LINE PRINTER OBJECT SETUP
$RETIF ;ERROR..RETURN
$CALL P$SWIT ;GET A SWITCH
$RETIF ;ILLEGALLY FORMATTED COMMAND
MOVEI S2,FSPDSP ;GET TABLE ADDRESS
$CALL TABSRC ;GET THE VALUE
$RETIF ;ERROR..RETURN
MOVE T2,S2 ;PLACE TYPE IN T2
$CALL P$NUM ;GET A NUMBER
JUMPF [CAIE T2,.SPFIL ;WAS THIS /FILE?
$RETF ;NO..THEN RETURN FAILURE
MOVEI S1,1 ;YES..THEN THE NUMBER IS 1
JRST .+1] ;CONTINUE
STORE S1,ARG.DA(P3) ;SAVE DATA IN MESSAGE
MOVE S1,T2 ;GET TYPE IN S1
MOVEI S2,ARG.SZ ;SIZE OF THE BLOCK
$CALL ARGRTN ;ARG HEADER,COUNT ROUTINE
PJRST CMDEND ;CHECK FOR END AND SEND MESSAGE
FSPDSP: $STAB
.SWPAG,,.SPPAG ;PAGES
.SWFIL,,.SPFIL ;FILES
.SWCPY,,.SPCPY ;COPIES
$ETAB
SUBTTL LPTOBJ Setup printer object block
;THIS ROUTINE WILL SETUP AN OBJECT BLOCK AND MAKE SURE
;THAT IT IS FOR A LINE PRINTER WITH ONLY ONE UNIT SPECIFIED.
;THE OBJECT BLOCK WILL BE BUILT IN THE OUTPUT MESSAGE
LPTOBJ: $CALL BLDOBJ ;AND AN OBJECT BLOCK
$RETIF ;ERROR..PASS CODE UP
MOVEI T1,.OHDRS+ARG.DA(MO) ;POINT TO OBJECT BLOCK
LOAD S1,OBJ.UN(T1),OU.HRG ;SEE IF WE HAVE A NON-ZERO HIGH UNIT
JUMPN S1,.RETF ;LOSE IF SO
LOAD S1,OBJ.TY(T1),RHMASK ;[125]GET MESSAGE TYPE
CAXE S1,.OTLPT ;PRINTER?
$RETF ;NO, LOSE
$RETT ;RETURN TRUE
SUBTTL Q$ALGN Process ALIGN command
;THIS ROUTINE WILL PROCESS AN ALIGN COMMAND FROM OPR
Q$ALGN:: $CALL LPTOBJ ;SETUP LINE PRINTER OBJECT BLOCK
$RETIF ;ERROR..RETURN
$CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF ALIG.3 ;NO..CHECK FOR A FILE
CAIE S1,.SWSTP ;WAS IT A STOP
JRST ALIG.2 ;NO..TRY OTHER VALUES
MOVX S1,.ALSTP ;GET THE STOP ARGUMENT TYPE
MOVEI S2,1 ;SETUP FIELD LENGTH
$CALL ARGRTN ;SETUP ARGUMENT IN MESSAGE
PJRST CMDEND ;FINISH OFF THE COMMAND
ALIG.1: $CALL P$SWIT ;GET A SWITCH
JUMPF ALIG.3 ;CHECK FOR A FILE
ALIG.2: MOVEI S2,ALIDSP ;GET ALIGN TABLE
$CALL TABSRC ;CHECK THE TABLE
$RETIF ;ERROR..RETURN
MOVE T2,S2 ;SAVE THE VALUE
$CALL P$NUM ;GET A NUMBER
$RETIF ;ERROR..RETURN
STORE S1,ARG.DA(P3) ;SAVE NUMBER IN ARGUMENT BLOCK
MOVEI S2,ARG.SZ ;GET ARGUMENT SIZE
MOVE S1,T2 ;GET FUNCTION TYPE
$CALL ARGRTN ;SAVE THE ARGUMENT AND UPDATE COUNTERS
JRST ALIG.1 ;CHECK NEXT FIELD
ALIG.3: $CALL P$IFIL ;CHECK FOR INPUT FILE
JUMPF CMDEND ;NO..CHECK FOR END OF COMMAND
$CALL MOVARG ;YES..MOVE FD AND HEADER FOR OUTPUT
JRST ALIG.1 ;CHECK THE NEXT FIELD
ALIDSP: $STAB
.SWRPT,,.ALRPT ;REPEAT COUNT
.SWPAU,,.ALPAU ;PAUSE COUNT
$ETAB
SUBTTL Q$SUPP Process suppress command
Q$SUPP:: $CALL LPTOBJ ;SETUP LINE PRINTER OBJECT BLOCK
$RETIF ;ERROR..RETURN
$CALL P$SWIT ;CHECK FOR A SWITCH
MOVEI S2,SUPDSP ;ADDRESS OF THE TABLES
SKIPT ;SKIP IF O.K.
MOVEI S1,.SWJOB ;ASSUME JOB AS DEFAULT
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVE S1,S2 ;PLACE TYPE IN S1
MOVEI S2,1 ;LENGTH OF ARGUMENT IN S2
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH THE COMMAND
SUPDSP: $STAB
.SWFIL,,.SUPFL ;FILE
.SWJOB,,.SUPJB ;JOB
.SWSTP,,.SUPST ;STOP
$ETAB
SUBTTL Q$ABOR Process ABORT command
;THIS ROUTINE WILL PROCESS A ABORT COMMAND AND SEND THE
;APPROPRIATE MESSAGE TO QUASAR
Q$ABOR:: $CALL BLDOBJ ;GET AN OBJECT BLOCK SETUP
$RETIF ;NO..RETURN..BAD MESSAGE
MOVEI T1,.OHDRS+ARG.DA(MO) ;ADDRESS OF ARGUMENT BLOCK
LOAD S1,OBJ.UN(T1),OU.HRG ;GET HIGH RANGE
JUMPN S1,.RETF ;NON-ZERO..RETURN FALSE
ABOR.1: $CALL P$SWIT ;GET A SWITCH IF ANY
JUMPF CMDEND ;NO..CHECK FOR CONFIRM AND SEND
CAIE S1,.SWREQ ;/REQUEST NUMER SWITCH
JRST ABOR.3 ;PROCESS SEQUENCE SWITCH
$CALL PREQNM ;PROCESS REQUEST NUMBER
$RETIF ;ERROR RETURN
ABOR.2: $CALL P$SWIT ;CHECK FOR SWITCH
JUMPF CMDEND ;ERROR..CHECK FOR END
ABOR.3: MOVEI S2,ABODSP ;ABORT TABLE ADDRESS
$CALL TABSRC ;SEARCH THE TABLE
JUMPT ABOR.4 ;O.K..CONTINUE ON
CAIN S1,.SWRSN ;/REASON SWITCH
JRST ABOR.5 ;PROCESS REASON SWITCH
;**;[144]At ABOR.3:+5L replace 1 line with 5 JYCW Oct-18-88
$CALL CHCLUN ;[144]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF .POPJ ;[144]NOT A CLUSTER-NODE SWITCH
SKIP G$CLUN ;[144]REMOTE NODE SPECIFIED?
PJRST SNDCLU ;[144]SEND THE MESSAGE TO NEBULA
PJRST CMDEND ;[144]CHECK FOR COMMAND END AND RETURN
ABOR.4: MOVEM S2,ARG.DA(P3) ;SAVE THE DATA FIELD
MOVX S1,.CANTY ;GET ABORT TYPE
MOVX S2,ARG.SZ ;GET ARGUMENT SIZE
$CALL ARGRTN ;SETUP ARGUMENT HEADER AND COUNTS
JRST ABOR.2 ;GET NEXT FIELD
ABOR.5: $CALL PREASN ;PROCESS THE REASON SWITCH
$RETIF ;NO...ERROR..RETURN
PJRST CMDEND ;CHECK FOR COMMAND END AND RETURN
ABODSP: $STAB
.SWPUR,,.CNPRG ;/PURGE
.SWERR,,.CNERR ;/ERROR
.SWNER,,.CNNER ;/NOERROR
$ETAB
SUBTTL PREQNM Process /REQUEST switch
;PROCESS /REQUEST SWITCH
PREQNM: $CALL P$NUM ;GET A NUMBER
$RETIF ;NO..RETURN FALSE
PREQ.1: STORE S1,ARG.DA(P3) ;SAVE THE NAME IN MESSAGE
MOVX S1,.ORREQ ;GET JOBNAME TYPE
MOVX S2,ARG.SZ ;SIZE OF THE ARGUMENT
PJRST ARGRTN ;SETUP ARGUMENT HEADER AND COUNTS
SUBTTL PREASN Process /REASON switch
;PROCESS /REASON TEXT DATA
PREASN: $CALL P$TEXT ;GET A TEXT ARGUMENT
$RETIF ;NO..RETURN
MOVX T1,.ORREA ;GET REASON TYPE
STORE T1,ARG.HD(S1),AR.TYP ;SAVE CORRECT TYPE IN HEADER
$CALL MOVARG ;BUILD TEXT ARGUMENT AND UPDATE COUNTS
$RETT ;RETURN TRUE
SUBTTL PUSER/PUSERS Process USER block/switch
PUSER: MOVX S1,.CMUSR ;Get user block
SKIPA ;Skip other entry point
PUSERS: MOVX S1,.LSUSR ;List user switch
PUSH P,S1 ;Save it a sec
;Common work
$CALL P$USER ;GET USER DATA
JUMPF [POP P,(P) ;ERROR,,PHASE STACK
$RETF ] ;AND RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE DATA
POP P,S1 ;GET USER TYPE
MOVX S2,ARG.SZ ;SIZE OF THE ARGUMENT
PJRST ARGRTN ;SAVE THE ARGUMENT
SUBTTL Q$REQU Process REQUEUE command
;THIS ROUTINE WILL ANALYSZE A REQUEUE COMMAND AND SEND THE
;APPROPRIATE MESSAGE TO QUASAR
Q$REQU:: $CALL BLDOBJ ;SETUP OBJECT BLOCK
$RETIF ;ERROR IF NOT SETUP..RETURN
MOVEI T1,.OHDRS+ARG.DA(MO) ;GET THE ARGUMENT BLOCK
LOAD S1,OBJ.UN(T1),OU.HRG ;GET HIGH VALUE
JUMPN S1,.RETF ;RANGE NOT ALLOWED
LOAD P1,OBJ.TY(T1),RHMASK ;[125]GET THE TYPE FIELD
REQU.1: $CALL P$SWIT ;GET A SWITCH
JUMPF REQU.5 ;NO..CHECK FOR OTHER FIELDS
CAIE S1,.SWREQ ;CHECK FOR REQUEST
JRST REQU.3 ;YES..PROCESS JOBNAME
$CALL PREQNM ;PROCESS REQUEST NUMBER
$RETIF ;ERROR RETURN
REQU.2: $CALL P$SWIT ;CHECK FOR SWITCH
JUMPF REQU.5 ;CHECK OTHER FIELDS
REQU.3: CAIN S1,.SWRSN ;CHECK FOR REASON
JRST REQU.4 ;PROCESS REASON SWITCH
;**;[144]At REQU.3:+2L change 1 line JYCW Oct-18-88
JRST REQU.9 ;[144]CHECK FOR /CLUSTER-NODE
REQU.4: $CALL PREASN ;PROCESS THE REASON FLAG
$RETIF ;ERROR..RETURN
JRST REQU.7 ;CHECK FOR A CONFIRM
REQU.5: CAIN P1,.OTBAT ;CHECK FOR BATCH
JRST REQU.7 ;YES..CHECK FOR A CONFIRM
$CALL P$KEYW ;PRINTER..CHECK FOR KEYWORD
SETOM T1 ;SETUP FLAG FOR SWITCHES
JUMPF REQU.8 ;CHECK FOR END OF MESSAGE
CAIE S1,.KYBEG ;BEGINNING-OF KEYWORD
JRST REQU.6 ;CHECK FOR CURRENT POSITION
$CALL P$KEYW ;GET BEGINNING OPRION
$RETIF ;NOT..KEYWORD..ERROR
CAIN S1,.KYCPY ;IS IT COPY
MOVEI T1,.RQBCP ;BEGINNING OF COPY
CAIN S1,.KYJOB ;IS IT JOB
MOVEI T1,.RQBJB ;BEGINNING OF JOB
CAIN S1,.KYFIL ;IS IT FILE
MOVEI T1,.RQBFL ;BEGINNING OF FILE
REQU.6: CAIN S1,.KYCUR ;CURRENT-POSITION
MOVEI T1,.RQCUR ;CURRENT POSITION
JUMPL T1,.RETF ;INVALID KEYWORD
STORE T1,ARG.DA(P3) ;SAVE VALUE IN MESSAGE
MOVX S1,.REQTY ;KEY ARGUMNET BLOCK TYPE
MOVX S2,ARG.SZ ;GET ARGUMENT SIZE
$CALL ARGRTN ;SETUP ARGUMENT AND COUNTS
$CALL P$SWIT ;GET A SWITCH
JUMPF REQU.7 ;CHECK FOR CONFIRM
CAIE S1,.SWRSN ;IS IT REASON
;**;[144]At REQU.6:+10L change 1 line JYCW Oct-18-88
JRST REQU.9 ;[144]NO
JRST REQU.4 ;PROCESS THE REASON SWITCH
;**;[144]At REQU.6:+13L add 3 lines JYCW Oct-18-88
REQU.7: SKIPN G$CLUN ;[144]EMOTE NODE SPECIFIED?
PJRST CMDEND ;[144]FINISH THE COMMAND
PJRST SNDCLU ;[144]YES, SEND THE MESSAGE TO NEBULA
REQU.8: CAIE S1,.CMCFM ;CHECK IF AT END OF COMMAND
$RETF ;NO..RETURN FALSE
MOVEI S1,.KYCUR ;SET DEFAULT FOR CURRENT POSITION
JRST REQU.6 ;FINISH COMMAND
;**;[144]At REQU.8:+4L add routine REQU.9: JYCW Oct-18-88
REQU.9: $CALL CHCLUN ;[144]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF .RETF ;[144]NOT A CLUSTER-NODE SWITCH
JRST REQU.2 ;[144]CHECK FOR MORE SWITCHES
SUBTTL Q$ROUT Process ROUTE command
INTERN Q$ROUTE ;MAKE IT GLOBAL
Q$ROUT: STKVAR (OBJDEV) ;CREATE SPACE FOR THE DEVICE TYPE
$CALL P$KEYW ;GET A KEYWORD !!!
$RETIF ;NOT THERE,,THATS AN ERROR
CAXE S1,.KYALL ;DID HE SPECIFY ALL DEVICES ???
CAXG S1,.OTMAX ;NO,,IS IT A VALID OBJECT TYPE ???
SKIPA ;YES TO EITHER,,SKIP
$RETF ;NO,,RETURN
CAXN S1,.KYALL ;DID HE SPECIFY ALL ???
SETOM S1 ;YES,,SET IT
MOVEM S1,ARG.DA+OBJ.TY(P3) ;SAVE IT IN THE SOURCE OBJECT BLOCK
MOVEM S1,OBJDEV ;SAVE IT HERE FOR LATER
JUMPGE S1,ROUT.4 ;Go to process routing for specific dev.
;Process ALL-DEVICE command
SETOM ARG.DA+OBJ.UN(P3) ;Set object block to all units
$CALL P$NODE ;Get the source node
JUMPT ROUT.1 ;Go process the node name
;Maybe ALL-NODES was specified!
$CALL P$KEYW ;Try for th keyword
$RETIF ;Must be there!
CAXE S1,.KYALL ;Is it ALL?
$RETF ;No -- screwed up
SETOM S1 ;Say all nodes
ROUT.1: MOVEM S1,ARG.DA+OBJ.ND(P3) ;Save source node info
$CALL OPRENB ;Check OPR's privs
$RETIF ;NO,,RETURN
MOVX S1,.RTEFM ;GET THE BLOCK TYPE
MOVX S2,.OBJLN+LPTNLN ;[126]AND THE BLOCK LENGTH
$CALL ARGRTN ;AND UPDATE THE MESSAGE
$CALL P$NODE ;GET THE DESTINATION NODE NAME
JUMPF ROUT.3 ;NOT THERE,,MIGHT BE 'DELETE' FUNCTION
SETOM ARG.DA+OBJ.UN(P3) ;Save all unit types
;Common completion code
ROUT.2: MOVEM S1,ARG.DA+OBJ.ND(P3) ;SAVE IT IN THE OBJECT BLOCK
$CALL OPRENB ;Check OPR's privs
$RETIF ;NO,,RETURN
MOVE S1,OBJDEV ;Get the source device type
MOVEM S1,ARG.DA+OBJ.TY(P3) ;Save the object types
MOVX S1,.RTETO ;GET THE BLOCK TYPE
MOVX S2,.OBJLN+LPTNLN ;[126]GET THE BLOCK LENGTH
$CALL ARGRTN ;UPDATE THE MESSAGE
ROUT.3: $CALL CMDEND ;Send it off
$RET ;Return preserving previous return
;Process a route command for a specific device
ROUT.4: $CALL P$NUM ;GET THE UNIT NUMBER
JUMPF ROUT.5 ;NOT THERE,,MIGHT HAVE SAID 'ALL'
CAXLE S1,77 ;IS IT VALID ???
$RETF ;NO,,RETURN
JRST ROUT.8 ;[125]YES,,CONTINUE
ROUT.5: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;NOT THERE,,THATS AN ERROR
CAIN S1,.KYALL ;[125]IS IT 'ALL'
JRST ROUT.7 ;[125]YES, GO PROCESS IT
CAIN S1,.KYDQS ;[125]IS THIS A DQS LPT?
JRST ROUT.6 ;[125]YES, GO PROCESS
CAIN S1,.KYLAT ;[125]IS THIS A LAT LPT?
JRST ROUT.6 ;[125]YES, GO PROCESS
CAIE S1,.KYCLU ;[125]IS THIS A CLUSTER LPT?
$RETF ;[125]NO, INDICATE ERROR TO CALLER
ROUT.6: MOVX P2,.RTEFM ;[125]PICK UP THE BLOCK TYPE
$CALL ROUBLK ;[125]CHECK FOR A REMOTE PRINTER
$RETIF ;[125]RETURN ON AN ERROR
JRST ROUT11 ;[125]CHECK THE DESTINATION INFORMATION
ROUT.7: SETOM S1 ;[125]Make this all units
ROUT.8: MOVEM S1,ARG.DA+OBJ.UN(P3) ;[125]SAVE IT IN THE OBJECT BLOCK
$CALL P$SWIT ;Get the node switch
JUMPF ROUT.9 ;[125]No switch- thats ok
CAIE S1,.SWNOD ;It must be a node switch however.
$RETF ;It isn't!
$CALL P$NODE ;GET THE SOURCE NODE if any
JUMPT ROUT10 ;[125]Go to set node name
;Since no node was specified, get the OPR's node
ROUT.9: MOVE S1,G$OPRA ;[125]Get the operator's address
MOVE S1,OPR.ND(S1) ;The the address of the node info
MOVE S1,NOD.NM(S1) ;Get the node name
ROUT10: MOVEM S1,ARG.DA+OBJ.ND(P3) ;[125]AND SAVE THE SOURCE NODE
$CALL OPRENB ;Check OPR's privs
$RETIF ;NO,,RETURN
MOVX S1,.RTEFM ;GET THE BLOCK TYPE
MOVX S2,.OBJLN+LPTNLN ;[126]AND THE BLOCK LENGTH
$CALL ARGRTN ;AND UPDATE THE MESSAGE
;Get destination information
ROUT11: $CALL P$NUM ;[125]Get the destination unit number
JUMPT ROUT13 ;[125]GO VALIDATE THE NUMBER
$CALL P$KEYW ;[125]Attempt to get a keyword
JUMPF ROUT.3 ;[125]None, check for delete function
CAIE S1,.KYALL ;[125]Is it "ALL"?
JRST ROUT12 ;[125]No, check for a remote printer
SETOM S1 ;[125]Make it all units
JRST ROUT13 ;[125]Go validate the number
ROUT12: MOVE S2,OBJDEV ;[125]PICK UP THE SOURCE OBJECT TYPE
MOVEM S2,ARG.DA+OBJ.TY(P3) ;[125]SAVE IN THE DESTINATION BLOCK
MOVX P2,.RTETO ;[125]PICK UP THE DESTINATION BLK TYPE
$CALL ROUBLK ;[125]CHECK FOR A REMOTE PRINTER
$RETIF ;[125]RETURN ON AN ERROR
JRST ROUT.3 ;[125]GO FINISH THE MESSAGE
ROUT13: CAXLE S1,77 ;[125]Validate it
$RETF ;NOT VALID,,RETURN AN ERROR
MOVEM S1,ARG.DA+OBJ.UN(P3) ;Save the unit number
$CALL P$SWIT ;Get the node switch
JUMPF ROUT14 ;[125]No switch- thats ok
CAIE S1,.SWNOD ;It must be a node switch however.
$RETF ;It isn't!
$CALL P$NODE ;GET THE DESTINATION NODE NAME
JUMPT ROUT.2 ;Go join the common code for
; processng the destination node info
;Since no node was specified, get the OPR's node
ROUT14: MOVE S1,G$OPRA ;[125]Get the operator's address
MOVE S1,OPR.ND(S1) ;The the address of the node info
MOVE S1,NOD.NM(S1) ;Get the node name
JRST ROUT.2 ;Go join the common code for completion
SUBTTL ROUBLK Build a remote printer object descriptor for ROUTE
;ROUBLK is called to build a remote printer object descriptor block during
;the processing of a ROUTE command that specified a remote printer
;
;Call is: P2/ROUTE message block type code
; P3/Address of object block being built in the ROUTE message
ROUBLK: STKVAR (OBJADR) ;[126]PLACE TO SAVE OBJECT BLOCK ADR
SETZM ARG.DA+OBJ.UN(P3) ;[126]ZERO THE UNITS FIELD
MOVEM P3,OBJADR ;[126]SAVE THE OBJECT BLOCK ADDRESS
$CALL LPTTY0 ;[126]BUILD THE OBJECT DESCRIPTOR BLOCK
$RETIF ;[126]RETURN ON AN ERROR
MOVE S1,OBJADR ;[126]PICK UP THE OBJECT BLOCK ADDRESS
STORE P2,ARG.HD(S1),AR.TYP ;[126]SAVE THE DESTINATION BLOCK TYPE
ADDI S1,.OBJLN ;[126]POINT TO THE NAME BLOCK
LOAD S2,ARG.HD(S1),AR.LEN ;[126]PICK UP ITS LENGTH
MOVNS S2 ;[126]MAKE IT NEGATIVE
SKIPN S2 ;[126]WAS THIS A CLUSTER LPT?
AOS .OARGC(MO) ;[126]INCLUDE "NAME" BLOCK IN ARG COUNT
ADDI S2,LPTNLN ;[126]AMOUNT TO ADD TO NEXT BLK POINTER
ADD P3,S2 ;[126]UPDATE POINTER TO NEXT BLOCK
MOVEI S2,LPTNLN ;[126]PICK UP COMMON NAME BLOCK LENGTH
STORE S2,ARG.HD(S1),AR.LEN ;[126]STORE THE NAME BLOCK LENGTH
MOVE S1,OBJADR ;[126]PICK UP THE OJBECT BLOCK ADDRESS
MOVE S1,ARG.DA+OBJ.ND(S1) ;[126]PICK UP THE NODE NAME
$CALL OPRENB ;[126]VALIDATE THE OPERATOR
$RET ;[126]PASS BACK THE TRUE/FALSE FLAG
SUBTTL Q$RELE Process RELEASE command
SUBTTL Q$HOLD Process HOLD command
Q$RELE::
Q$HOLD:: $CALL CHKRMT ;CHECK IF FROM REMOTE AND ADD
; NODE BLOCK IF REMOTE OR LOCAL
$CALL OPRENB ;Check OPR Privs
$RETIF ;Return on error
$CALL P$KEYW ;GET THE KEYWORD
$RETIF ;NO..ERROR...RETURN
HOLD.1: $CALL PQTYPE ;PROCESS QUEUE TYPE
JUMPF E$IOT ;ERROR..INVALID QUEUE TYPE
HOLD.2: $CALL PREQNM ;PROCESS REQUEST NUMBER
JUMPF HOLD.3 ;ERROR..TRY USER FIELD
JRST CMDEND ;CHECK FOR THE END
HOLD.3: $CALL PUSER ;PROCESS USER FIELD
JUMPF HOLD.4 ;CHECK OUT * OR /NODE
JRST CMDEND ;CHECK FOR THE END
HOLD.4: $CALL P$TOK ;GET A TOKEN
$RETIF ;ERROR ..RETURN
SETOM S1 ;YES..ASSUME * -1 FOR REQUEST
$CALL PREQ.1 ;SAVE ARGUMENT
$CALL PNODSW ;GET NODE SWITCH
;**;[144]At HOLD.4:+5L change 1 line JYCW Oct-18-88
JUMPF HOLD.5 ;[JW]NOT /NODE BUT HOW ABOUT /CLUSTER
PJRST CMDEND ;FINISH OFF COMMAND
;**;[144]At HOLD.4:+8L add 2 lines JYCW Oct-18-88
HOLD.5: $CALL P$PREV ;[144]BACK UP ONE SWITCH
PJRST CMDEND ;[144]FINISH OFF COMMAND
SUBTTL PQTYPE Process QUEUE type field
;CALLED WITH S1 CONTAINING THE QUEUE TYPE
PQTYPE: MOVEM S1,G$ARG1 ;SAVE THE OBJECT TYPE
SKIPLE S1 ;VALID QUEUE TYPE?
CAILE S1,.OTPLT ;WITHIN RANGE
$RETF ;NO..INVALID OBJECT TYPE
PQTY.1: MOVEM S1,ARG.DA(P3) ;SAVE THE OBJECT TYPE IN MESSAGE
MOVX S1,.ORTYP ;GET OBJECT TYPE
MOVX S2,ARG.SZ ;GET ARGUMENT SIZE
PJRST ARGRTN ;SAVE ARGUMENT AND RETURN
SUBTTL PNODSW Process /NODE switch
SUBTTL CNODSW Validate a /NODE switch
PNODSW: $CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF .RETT ;RETURN O.K..CHECK NEXT FIELD
CAIE S1,.SWNOD ;WAS IT A NODE
$RETF ;NO..RETURN FALSE
CNODSW: $CALL P$NODE ;GET THE NODE FIELD
$RETIF ;ERROR..RETURN
MOVE P1,S1 ;SAVE VALUE OF NODE
$CALL OPRENB ;IS OPR ENABLED FOR NODE
$RETIF ;ERROR...RETURN
MOVE S1,P1 ;PLACE IN S1
SAVNOD::MOVEM S1,ARG.DA(P3) ;[136]SAVE THE VALUE
MOVX S1,.ORNOD ;GET THE NODE BLOCK TYPE
MOVX S2,ARG.SZ ;AND BLOCK SIZE
PJRST ARGRTN ;SAVE ARGUMENT AND RETURN
SUBTTL GNODSW Get /NODE argument if present
;THIS ROUTINE WILL GET NODE SWITCH IF PRESENT AND RETURN VALUE
;IN S1 OR RETURN FALSE IF NOT THERE
GNODSW: $CALL P$SWIT ;CHECK FOR A SWITCH
$RETIF ;NOT..RETURN FALSE
CAIE S1,.SWNOD ;WAS IT A NODE
$RETF ;NO..RETURN FALSE
$CALL P$NODE ;GET THE NODE FIELD
$RET ;RETURN..PASSING CODE OR VALUE
SUBTTL Q$CANC Process CANCEL command
Q$CANC:: $CALL CHKRMT ;CHECK IF FROM REMOTE AND ADD
; NODE BLOCK IF LOCAL OR REMOTE
$CALL OPRENB ;Check OPR privs
$RETIF ;Return on error
$CALL P$KEYW ;GET THE QUEUE TYPE
$RETIF ;ERROR...RETURN
CAIN S1,.KYMNT ;WAS IT A MOUNT REQUEST
JRST CANC.1 ;PROCESS CANCEL OF MOUNT REQUESTS
SETZM P1 ;SET FLAG FOR ALL DATA
PJRST HOLD.1 ;FINISH OFF COMMAND
CANC.1: MOVX S1,.ODDMT ;SET CANCEL MOUNT REQUEST TYPE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL PREQNM ;WAS IT A REQUEST NUMBER
JUMPT CANC.2 ;PROCESS THE REASON IF PRESENT
$CALL PSTRUC ;GET THE STRUCTURE NAME
JUMPT CANC.2 ;WIN,,CHECK FOR REASON
$CALL P$TOK ;GET A TOKEN
$RETIF ;ERROR ..RETURN
SETOM S1 ;YES..ASSUME * -1 FOR ALL REQUESTS
$CALL PREQ.1 ;SAVE ARGUMENT
CANC.2: $CALL P$SWIT ;WAS THERE A SWITCH
JUMPF CMDEND ;NO..CHECK END OF COMMAND
;**;[144]At CANC.2:+2L replace 1 line with 9 JYCW Oct-18-88
CAIN S1,.SWRSN ;[144]Was it /REASON: ??
JRST CANC.3 ;[144]Yes
$CALL CHCLUN ;[144]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF .POPJ ;[144]NOT A CLUSTER-NODE SWITCH
SKIP G$CLUN ;[144]REMOTE NODE SPECIFIED?
PJRST SNDCLU ;[144]SEND THE MESSAGE TO NEBULA
PJRST CMDEND ;[144]FINISH OFF COMMAND
CANC.3: $CALL PREASN ;[144]Process the REASON
JUMPT CANC.2 ;[144]O.K check for /CLUSTER-NODE
$RET ;OTHERWISE PASS ERROR BACK
SUBTTL CHKRMT Check for remote node input
;THIS ROUTINE WILL CHECK IF FROM REMOTE SITE AND ADD A .CMNOD
;BLOCK IF OPR IS REMOTE SO QUASAR CAN VALIDATE THE REQUEST
;Returns S1/ Node Name
CHKRMT: SETOM S1 ;System OPR?
$CALL OPRENB
JUMPT [MOVE S1,G$HOST ;Yes..return host name
JRST CHKR.2]
SETZM G$ERR ;Ignore errors
MOVE S1,G$HOST ;Local OPR?
$CALL OPRENB
JUMPT [MOVE S1,G$HOST ;Yes..add central site block
JRST CHKR.1]
SETZM G$ERR ;Ignore errors
MOVE S2,OPR.ND(S1) ;GET NODE ENTRY ADDRESS
MOVE S1,NOD.NX(S2) ;GET THE NAME
CHKR.1: $SAVE <S1> ;Preserve node
$CALL SAVNOD ;Include the node block
CHKR.2: $RETT
SUBTTL Q$MODI Process MODIFY command
;THIS COMMAND WILL MODIFY AN ENTRY IN QUASARS QUEUES
Q$MODI:: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
$CALL PQTYPE ;PROCESS QUEUE TYPE
JUMPF Q$MODS ;NOT A QUEUE TYPE, MAYBE A SYSTEM LIST
$CALL CHKRMT ;CHECK IF FROM REMOTE AND ADD
; NODE BLOCK IF REMOTE OR LOCAL
$CALL OPRENB ;Check OPR privs
$RETIF ;Return on failure
$CALL PREQNM ;PROCESS REQUEST NUMBER
JUMPT MODI.1 ;O.K. PROCESS MODIFY OPTION
$CALL PUSER ;TRY USER FIELD
JUMPT MODI.1 ;O.K.. PROCESS THE FIELDS
$CALL P$TOK ;WAS THERE A TOKEN
SETZM G$ERR ;Ignore errors
$RETIF ;NO..ERROR..RETURN
SETOM S1 ;SET FOR ALL REQUESTS
$CALL PREQ.1 ;SAVE REQUEST NUMBER
$CALL PNODSW ;WAS THERE A NODE SWITCH
$RETIF ;ERROR..RETURN
MODI.1: $CALL P$KEYW ;PROCESS A KEYWORD
$RETIF ;BAD COMMAND
CAIE S1,.KYPRI ;IS IT PRIORITY
$RETF ;BAD COMMAND
$CALL P$NUM ;GET THE NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE VALUE
MOVX S1,.MOPRI ;GET BLOCK TYPE
MOVX S2,ARG.SZ ;BLOCK SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH OFF COMMAND
SUBTTL Q$SET Process the SET command
;THIS ROUTINE WILL SEND THE APPROPRIATE SET MESSAGE TO
;QUASAR FOR PRINTERS, BATCH-STREAMS, AND PRIORITY. ALL OTHER
;SET TYPES WILL BE PROCESSED BY ORION
Q$SET:: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;ILLEGALLY FORMATTED COMMAND
MOVSI S2,-SETTX1 ;PREPARE AOBJN POINTER
SET.1: HLRZ T1,SETDSP(S2)
CAME T1,S1 ;MATCH?
AOBJN S2,SET.1 ;CHECK THE REST IF ANY
JUMPGE S2,.RETF ;LOSE!
MOVE P2,SETDSP(S2) ;SAVE ENTRY DATA
MOVEI T1,SETDSP(S2) ;ADDRESS OF THE ENTRY
CAILE T1,SETOBJ ;SET FOR BAT OR LPT
JRST SET.3 ;NO..GO PROCESS
$CALL P$PREV ;POSITION TO PREVIOUS BLOCK
$CALL BLDOBJ ;GET THE OBJECT BLOCK
$RETIF ;RETURN
$CALL P$KEYW ;GET THE KEYWORD FOR SET
$RETIF ;RETURN
HRRZ S2,P2 ;GET THE PROPER TABLE ADDRESS
MOVE S2,(S2) ;GET DISPATCH POINTER
SET.2: HLRZ T1,(S2) ;GET THE FIELD TO CHECK
CAME T1,S1 ;CHECK FOR MATCH??
AOBJN S2,SET.2 ;NO..KEEP CHECKING
JUMPGE S2,.RETF ;NO MATCH..FAILED
HRRZ T1,(S2) ;GET ADDRESS OF HEADER
HLRZ T2,(T1) ;PLACE ADDRESS IN T1
MOVE T2,(T2) ;GET HEADER IN T1
MOVEM T2,ARG.HD(P3) ;SAVE THE ENTRY
SET.3: HRRZ S2,(T1) ;GET THE ROUTINE ADDRESS
JRST (S2) ;GO TO PROPER ROUTINE
;SET COMMAND DISPATCH TABLE
SETDSP: XWD .KYBAT,[-BATCNT,,BATDSP] ;BATCH
XWD .KYLPT,[-LPTCNT,,LPTDSP] ;LPT
XWD .KYCDP,[-CDPCNT,,CDPDSP] ;CDP
XWD .KYPTP,[-PTPCNT,,PTPDSP] ;PAPAR-TAPE-PUNCH
SETOBJ: XWD .KYPLT,[-PLTCNT,,PLTDSP] ;PLT
XWD .KYJOB,SETJOB ;PROCESS JOB SETTING OPTIONS
XWD .KYTAP,SETTAP ;SET TAPE COMMAND
TOPS10< XWD .KYUSG,SETUSG> ;SET USAGE
TOPS20 <
XWD .KYSCH,SETSCH ;SET BIAS COMMAND
XWD .KYDSK,SETDSK ;SET DISK COMMAND
XWD .KYSTR,SETSTR ;SET STRUCTURE COMMAND
XWD .KYPOR,SETPOR ;Set port command
XWD .KYONL,SETONL ;SET ONLINE COMMAND
>;END TOPS20
IFN FTDN60,<
XWD .KYNOD,SETNOD ;SET NODE COMMAND
>;END FTDN60
SETTX1==.-SETDSP
;BATCH DISPATCH TABLE
BATDSP: XWD .KYATR,[[ARG.SZ+1,,.STATR],,SETATR] ;ATTRIBUTE
XWD .KYMEM,[[ARG.SZ+1,,.STMEM],,SETMEM] ;MEMORY LIMITS
XWD .KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
XWD .KYNOI,[[1,,.STNOI],,SETNOI] ;NOOPR-INTERVENTION
XWD .KYOIA,[[1,,.STOIA],,SETOIA] ;OPR-INTERVENTION
XWD .KYTIM,[[ARG.SZ+1,,.STTIM],,SETTIM] ;SET TIME LIMITS
BATCNT==.-BATDSP
;LINE PRINTER DISPATCH TABLE
LPTDSP: XWD .KYDST,[[ARG.SZ,,.STDST],,SETDST] ;Destination
XWD .KYFOT,[[ARG.SZ,,.STFRM],,SETFRM] ;FORMS-TYPE
XWD .KYLEA,[[ARG.SZ,,.STLEA],,SETLEA] ;LIMIT-EXCEED-ACTION
XWD .KYPGL,[[ARG.SZ+1,,.STPGL],,SETPGL] ;PAGE-LIMITS
XWD .KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
LPTCNT==.-LPTDSP
CDPDSP: XWD .KYDST,[[ARG.SZ,,.STDST],,SETDST] ;Destination
PLTDSP:
PTPDSP: XWD .KYFOT,[[ARG.SZ,,.STFRM],,SETFRM] ;FORMS-TYPE
XWD .KYLEA,[[ARG.SZ,,.STLEA],,SETLEA] ;LIMIT-EXCEED-ACTION
XWD .KYOPL,[[ARG.SZ+1,,.STOPL],,SETOPL] ;OUTPUT-LIMITS
XWD .KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
CDPCNT==.-CDPDSP
PTPCNT==.-PTPDSP
PLTCNT=.-PLTDSP
SUBTTL SETUSG Process SET USAGE command
TOPS10 <
SETUSG: SETOM S1 ;Get ALL nodes
$CALL OPRENB ;Check OPR privs
$RETIF ;Return on failure
$CALL P$KEYW
JUMPF E$IFC
MOVEI S2,USGTBL ;POINT TO KEY TABLE
$CALL TABSRC ;FIND THE KEYWORD
JUMPF E$IFC ;BAD FORMAT
STORE S2,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
CAXE S2,UGUFC$ ;IS THIS FILE CLOSURE ???
JRST SETU.1 ;NO,,FINISH UP !!!
PUSHJ P,P$KEYW ;GET THE NEXT KEYWORD
JUMPF SETU.1 ;NOT A KEYWORD,,TRY FOR A TIME !!!
CAXN S1,.KYNOW ;IS IT NOW ???
JRST [MOVX S1,US.NOW ;YES,,GET 'NOW' FLAG BIT
MOVEM S1,.OFLAG(MO) ;SAVE IT
PUSHJ P,I%NOW ;GET CURRENT TIME
JRST SETU.2 ] ;AND CONTINUE
CAXN S1,.KYDLY ;IS IT DAILY ???
JRST [MOVX S1,US.DLY ;YES,,GET 'DAILY' FLAG BIT
MOVEM S1,.OFLAG(MO) ;SAVE IT
JRST SETU.1 ] ;AND CONTINUE
CAXE S1,.KYWKY ;IS IT WEEKLY ???
JRST E$IFC ;NO,,THATS AN ERROR
PUSHJ P,P$KEYW ;GET THE DAY OF THE WEEK
JUMPF E$IFC ;NOT THERE,,THATS AN ERROR
CAIL S1,0 ;VALIDATE THE DAY - MUST BE BETWEEN
CAILE S1,6 ; ONE AND SEVEN...
JRST E$IFC ;NO,,THATS AN ERROR
TXO S1,US.WKY ;LITE 'WEEKLY' FLAG BIT
MOVEM S1,.OFLAG(MO) ;SAVE IT
SETU.1: $CALL P$TIME ;GET THE TIME
JUMPF E$IFC ;NOT THERE,,THATS AN ERROR !!!
SETU.2: MOVEM S1,ARG.DA(P3) ;SAVE THE UDT
MOVX S1,.ORTIM ;TIME BLOCK
MOVEI S2,ARG.SZ ;GET THE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
$CALL P$SWITCH ;LOOK FOR A SWITCH
JUMPF SETU.3 ;NONE,,MIGHT STILL BE OK
CAXE S1,.SWNOS ;IS IT /NO-SESSION-ENTRIES ???
JRST E$IFC ;NO,,THATS AN ERROR
MOVX S1,US.NOS ;YES,,GET FLAG BIT
IORM S1,.OFLAG(MO) ; AND LIGHT IT
SETU.3: $CALL P$CFM ;DO WE HAVE CONFIRM ???
JUMPF E$IFC ;NO,,THATS AN ERROR
ANDI P3,777 ;GET MESSAGE LENGTH
STORE P3,.MSTYP(MO),MS.CNT ;SAVE MESSAGE SIZE IN MESSAGE
$CALL SNDACT ;SEND THE MESSAGE OFF TO THE ACTDAE
$RETIT ;WIN,,RETURN
PJRST E$SAF ;SAY IT FAILED
USGTBL: $STAB
.KYUBC,,UGEBC$ ;BILLING-CLOSURE
.KYUFC,,UGUFC$ ;FILE-CLOSURE
$ETAB
> ;END TOPS10
SUBTTL SETJOB Set operator values for a job
SETJOB: MOVE S1,G$HOST ;Get host name
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$NUM ;GET A NUMBER
$RETIF ;NO..ERROR..RETURN
MOVE P1,S1 ;SAVE NUMBER IN P1
MOVEM P1,G$ARG1 ;SAVE THE JOB NUMBER
$CALL P$KEYW ;GET THE SETTING KEYWORD
$RETIF ;ERROR...RETURN
MOVE P2,S1 ;SAVE KEYWORD IN P2
$CALL P$CFM ;COMMAND HAVE CONFIRM?
JUMPF SETJ.1 ;TRY CLASS SETTING
SETO T2, ;SET A FLAG
CAIN P2,.KYNOI ;WAS IT NO OPERATOR INTERVENTION
MOVEI T2,.OBNWR ;SET NO OPR INTERVENTION
CAIN P2,.KYOIA ;OPR INTERVENTION ALLOWED
MOVEI T2,.OBALL ;YES SET OPR INTERVENTION ALLOWED
JUMPL T2,.RETF ;INVALID FIELD..RETURN
TOPS10 <
MOVE S2,P1 ;PLACE JOB NUMBER IN S2
MOVE S1,[2,,S2] ;SET UP THE BLOCK
HRLI T1,.STWTO ;SET WTO INFO FUNCTION
HRR T1,T2 ;PLACE VALUE IN T1
JBSET. S1, ;PERFORM THE FUNCTION
PJRST E$SJN ;SET JOB NOT IMPLEMENTED
>;END TOPS10
TOPS20 <
MOVE S1,P1 ;GET THE JOB NUMBER
MOVX S2,.SJBAT ;UPDATE BATCH DATA
SETZ T1, ;CLEAR THE DATA WORD
STORE T2,T1,OB%WTO ;SAVE THE DATA
SETJB ;SET THE INFO
ERJMP E$SJN ;NOTE THE ERROR
>;END TOPS20
PJRST E$SJM ;SET JOB MODIFIED
TOPS10 <
SETJ.1: $RETF ;ILLEGAL COMMAND
>;END TOPS10
TOPS20 <
SETJ.1: CAIE P2,.KYCLS ;WAS IT CLASS?
$RETF ;NO..INVALID COMMAND
$CALL P$NUM ;GET THE CLASS VALUE
$RETIF ;ERROR..RETURN
MOVE T3,S1 ;PLACE CLASS IN BLOCK
MOVEM T3,G$ARG2 ;SAVE THE CLASS
MOVEI S1,.SKSCJ ;GET THE FUNCTION
MOVEI S2,T1 ;BLOCK IN T1
MOVEI T1,3 ;SIZE OF BLOCK
MOVE T2,P1 ;GET THE JOB NUMBER
SKED% ;DO THE FUNCTION
ERJMP SETJ.2 ;TRAP ERROR
PJRST E$SSJ ;SET SCHEDULER JOB O.K.
SETJ.2: MOVE S1,[EXP -2] ;GET LAST -20 ERROR
MOVEM S1,G$ARG1 ;SAVE THE VALUE
PJRST E$SJF ;SET FAILED..RETURN
>;END TOPS20
SUBTTL SETxxx Process SET PARAMETERS
SETTIM:
SETPGL:
SETOPL:
SETMEM: $CALL P$RNGE ;GET RANGE
$RETIF ;ERROR..RETURN
SETM.1: DMOVEM S1,ARG.DA(P3) ;SAVE VALUES IN MESSAGE
ADDI P3,ARG.SZ+1 ;BUMP TO NEXT FREE LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
SETPRI: $CALL P$RNGE ;GET RANGE
$RETIF ;ERROR..RETURN
MOVEM S2,G$ARG1 ;SAVE THE VALUE
CAILE S2,^D63 ;IS IT IN RANGE
PJRST E$SPI ;INVALID PRIORITY SPECIFIED
JRST SETM.1 ;FINISH OFF COMMAND
SETNOI:
SETOIA: ADDI P3,1 ;BUMP TO NEXT LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
;HERE TO SET PRINTER PARAMETERS
SETFRM: $CALL P$SIXF ;GET A 6 BIT FIELD TYPE
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE FORMS NAME IN MESSAGE
ADDI P3,ARG.SZ ;BUMP TO NEXT LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;END THE COMMAND
;HERE TO HANDLE THE PROCESSOR VERB
SETATR: $CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
MOVEI S2,PRODSP ;GET PROCESSOR TABLE
$RETIF ;ERROR..RETURN
PJRST SETL.1 ;HANDLE AS LIMITED EXCEEDED
;HERE TO HANDLE LIMIT-EXCEEDED-ACTION VERB
SETLEA: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
MOVEI S2,LEADSP ;GET LIMIT-EXCEED ACTION TABLE
SETL.1: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVEM S2,ARG.DA(P3) ;SAVE IN THE MESSAGE
ADDI P3,ARG.SZ ;BUMP THE POINTER
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
; Here to handle an SNA Destination Specification
SETDST: $CALL P$TEXT ;Get the specification
$RETIF
MOVEI T1,.STDST ;"Destination" type
STORE T1,ARG.HD(S1),AR.TYP ;Save correct type in header
$CALL MOVARG ;Build argument and update counts
SETD.0: $CALL P$SWITCH ;Look for a switch
JUMPF CMDEND ;None there, finish up
MOVEI S2,DSTDSP ;Get dispatch table
$CALL TABSRC ;Search the table
$RETIF ;Error, return
MOVE S1,S2 ;Argument type to S1
MOVEI S2,1 ;The argument size
$CALL ARGRTN ;Save the argument
JRST SETD.0 ;Keep looking
LEADSP: $STAB
.KYCNC,,.STCAN ;CANCEL IT
.KYASK,,.STASK ;ASK
.KYIGN,,.STIGN ;IGNORE IT
$ETAB
PRODSP: $STAB
.KYBAT,,%GENRC ;SET BATCON PROCESSOR
.KYSIT,,%SITGO ;SET SITGO PROCESSOR
$ETAB
DSTDSP: $STAB
.SWNTL,,.STNTL ;/NOTRANSLATE
.SWSPL,,.STSPL ;/SPOOL
$ETAB
SUBTTL SETONL Process SET ONLINE command (TOPS20)
;THIS COMMAND IS TO INFORM SYSTEM OF A DEVICE THAT HAS BECOME
;AVAILABLE.
TOPS20 <
SETONL: MOVE S1,G$HOST ;Get host name
$CALL OPRENB ;Check OPR privs
$RETIF
MOVE P3,MO ;GET OUTPUT POINTER
MOVEI S1,[ASCIZ//] ;NULL TEXT
MOVEM S1,G$ARG1 ;SAVE THE ARGUMENT
SETOM T4 ;SET THE FLAG
SETO.1: $CALL P$NUM ;GET A NUMBER
$RETIF ;BAD COMMAND
MOVEM S1,G$ARG2 ;SAVE THE ARGUMENT
SKIPGE S1 ;IS IT O.K.
PJRST E$SIC ;INVALID CHANNEL
CAILE S1,7 ;IS IT IN RANGE
PJRST E$SIC ;SET INVALID CHANNEL
AOS P3 ;BUMP THE FIELD
MOVEM S1,(P3) ;SAVE THE DATA
$CALL P$COMMA ;CHECK FOR A COMMA
$RETIF ;ERROR..RETURN
$CALL P$NUM ;GET THE DEVICE NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,G$ARG2 ;SAVE DEVICE NUMBER
SKIPGE S1 ;IS IT VALID?
PJRST E$SID ;INVALID DEVICE
AOS P3 ;BUMP POINTER
MOVEM S1,(P3) ;SAVE THE VALUE
$CALL P$CFM ;CHECK IF DONE
JUMPF SETO.2 ;TRY FOR COMMA
AOS P3 ;BUMP FIELD
SETOM (P3) ;NO CONTROLLER -1 USED
PJRST SETO.3 ;FINISH OFF COMMAND
SETO.2: $CALL P$COMMA ;WAS IT A COMMA?
$RETIF ;BAD COMMAND
$CALL P$NUM ;GET CONTROLLER IF PRESENT
$RETIF ;NO..ERROR..RETURN
MOVEM S1,G$ARG2 ;SAVE THE VALUE
;JSYS WILL VERIFY
AOS P3 ;BUMP POINTER
MOVEM S1,(P3) ;SAVE THE VALUE
$CALL P$CFM ;CONFIRMED??
JUMPT SETO.3 ;PROCESS IT
AOSE T4 ;CHECK FLAG
$RETF ;INVALID COMMAND
MOVEI S1,[ASCIZ/Alternate /] ;GET ALTERNATE
MOVEM S1,G$ARG1 ;SAVE THE VALUE
JRST SETO.1 ;GET ALTERNATE DATA
SETO.3: MOVX S1,.DGPDL ;GET FUNCTION CODE
MOVEM S1,(MO) ;SAVE IN BLOCK
HRRZ S1,MO ;ADDRESS IN RIGHT HALF
SUBI P3,-1(MO) ;GET LENGTH OF BLOCK
MOVN P3,P3 ;MAKE IT NEGATIVE
HRL S1,P3 ;PUT LENGTH IN LEFT HALF
DIAG ;DO THE JSYS
PJRST SETO.4 ;ERROR..CHECK IT OUT
PJRST E$SOA ;SET ONLINE ACCEPTED.. RELEASE THE PAGE
SETO.4: MOVEM S1,G$ARG1 ;SAVE THE ERROR CODE
PJRST E$DJF ;DIAG JSYS FAILED
>;END TOPS20
SUBTTL SETSCH Process SET SCHEDULER command (TOPS20)
;THIS COMMAND WILL DO THE SKED% JSYS TO AFFECT THE SCHEDULER CONTROLS
;AND INFORM OPERATOR OF THE ACTION
TOPS20 <
SETSCH: MOVE S1,G$HOST ;Get local host name
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
MOVEI S2,SCHDSP ;SCHEDULER DISPATCH TABLE
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
HLRZ P1,(S2) ;GET THE FUNCTION CODE
HRRZ S2,(S2) ;GET THE ROUTINE ADDRESS
PJRST (S2) ;PROCESS THE ROUTINE AND RETURN
SCHBIA: $CALL P$NUM ;GET THE NUMBER
$RETIF ;ERROR..RETURN
MOVEI T1,2 ;BLOCK OF 2 WORDS
MOVE T2,S1 ;GET THE NUMBER
PJRST SCHED ;DO THE FUCNTION AND RETURN
SUBTTL SCHED Do the SKED% JSYS (TOPS20)
;THIS ROUTINE WILL DO THE SCHEDULE FUNCTION WITH P1 CONTAINING THE
;FUNCTION CODE
SCHED: MOVEI T1,2 ;MINIMUM SIZE BLOCK
SCHED1: MOVE S1,P1 ;GET THE FUNCTION
MOVEI S2,T1 ;ADDRESS OF THE BLOCK
SKED% ;DO THE JSYS
ERJMP SCHED2 ;SHOW ERROR
PJRST E$SSS ;BIAS SET ..RETURN AND RELEASE PAGE
SCHED2: MOVE S2,[EXP -2] ;LAST -20 ERROR CODE
MOVEM S2,G$ARG1 ;SAVE THE CODE
PJRST E$SSF ;SET BIAS FAILED
SCHDSP: $STAB
.KYBAT,,[.SKBCS,,SCHBAT] ;SET SCHED BATCH
.KYBIA,,[.SKSBC,,SCHBIA] ;SET SCHED BIAS
.KYCLS,,[.SKSCS,,SCHCLS] ;SET SCHED CLASS
$ETAB
>;END TOPS20
SUBTTL SCHBAT Process SET SCHEDULER BATCH command (TOPS20)
TOPS20 <
SCHBAT: $CALL P$NUM ;GET THE BATCH CLASS
JUMPF SCHB.1 ;TRY KEYWORDS
MOVE T2,S1 ;GET THE CLASS NUMBER
PJRST SCHED ;DO THE SCHED JSYS
SCHB.1: $CALL P$KEYW ;IS IT A KEYWORD?
$RETIF ;ERROR..RETURN
CAIE S1,.KYNON ;NONE?
JRST SCHB.2 ;TRY BACKGROUND
SETOM T2 ;NON-ZERO VALUE
$CALL SCHED ;DO THE FUNCTION
MOVEI P1,.SKBBG ;CLEAR DREGS SETTING ALSO
SETZM T2 ;CLEAR THE VALUE
PJRST SCHED ;DO THE FUNCTION AND RETURN
SCHB.2: CAIE S1,.KYBCK ;WAS IT BACKGROUND
$RETF ;NO..RETURN FALSE
MOVEI P1,.SKBBG ;SET BACKGROUND
SETOM T2 ;NON-ZERO..BACKGROUND
PJRST SCHED ;DO THE FUNCTION
>;END TOPS20
SUBTTL SCHCLS Process SET SCHEDULER CLASS command (TOPS20)
TOPS20 <
SCHCLS: $CALL P$NUM ;GET THE CLASS NUMBER
$RETIF ;ERROR..RETURN
MOVE T2,S1 ;SAVE THE VALUE
$CALL P$NUM ;GET THE PERCENT
$RETIF ;ERROR..RETURN
FLTR S1,S1 ;FLOAT THE NUMBER
FDVRI S1,(100.) ;CONVERT TO NUMBER FROM PERCENT
MOVE T3,S1 ;SAVE THE SHARE
MOVEI T1,3 ;GET THE LENGTH
PJRST SCHED1 ;DO THE FUNCTION
>;END TOPS20
SUBTTL SETNOD Process SET NODE command (DN60)
;THIS COMMAND WILL PASS A PARTICULAR VALUE FOR A DN60 OPTION
IFN FTDN60,<
SETNOD: MOVE S1,G$HOST ;Get host name
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$NODE ;BETTER HAVE NODE VALUE
$RETIF ;ERROR..RETURN
$CALL SAVNOD ;SAVE THE NODE
$CALL P$KEYW ;CHECK FOR A KEYWORD
$RETIF ;ERROR..RETURN
MOVEI S2,SETNDP ;GET TABLE ADDRESS
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
HLRZ P1,(S2) ;GET BLOCK VALUE IN P1
HRRZ S2,(S2) ;GET ROUTINE ADDRESS
PJRST (S2) ;PROCESS FUNCTION AND RETURN
SETNDP: $STAB
XWD .KYBPM,[.STBPM,,SETBPM] ;BYTES PER MESSAGE
XWD .KYCSD,[.STCSD,,SETCSD] ;CLEAR-SEND-DELAY
XWD .KYDTR,[.STDTR,,SETDTR] ;DATA TERMINAL READY
XWD .KYRPM,[.STRPM,,SETRPM] ;RECORDS PER MESSAGE
XWD .KYSWL,[.STSWL,,SETSWL] ;SILO WARNING LEVEL
XWD .KYTOU,[.STTOU,,SETTOU] ;TIMEOUT CATEGORY
XWD .KYTRA,[.STTRA,,SETTRA] ;TRANSPARANCY
XWD .KYDAT,[.STDAT,,SETDAT] ;IBM logon data
XWD .KYLOM,[.STLOM,,SETLOM] ;IBM logon mode
XWD .KYPLU,[.STPLU,,SETPLU] ;IBM Application (PLU)
XWD .KYCIR,[.STCIR,,SETCIR] ;Circuit-ID
XWD .KYCHS,[.STCHS,,SETCHS] ;Translation file
$ETAB
;ALL ROUTINES CALLED WITH FUNCTION CODE IN P1
;SET CLEAR TO SEND DELAY
SETBPM:
SETRPM:
SETSWL:
SETCSD: $CALL P$NUM ;GET THE VALUE
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE DATA
SETFIN: MOVE S1,P1 ;GET THE BLOCK TYPE
MOVX S2,ARG.SZ ;BLOCK SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH AND SEND COMMAND
SETTRA:
SETDTR: $CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
SETZ T1, ;SET A FLAG
CAIN S1,.KYON ;WAS IT ON
MOVX T1,ST.ON ;SET ON
CAIN S1,.KYOFF ;WAS IT OFF
MOVX T1,ST.OFF ;SET OFF
JUMPE T1,.RETF ;NONE..ERROR..RETURN
MOVEM T1,ARG.DA(P3) ;SAVE THE VALUE
PJRST SETFIN ;FINISH SET COMMAND
SETTOU: $CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
SETZ T1, ;SET A FLAG
CAIN S1,.KYPRI ;WAS IT PRIMARY
MOVX T1,ST.PRI ;SET PRIMARY
CAIN S1,.KYSEC ;WAS IT SECONDARY
MOVX T1,ST.SEC ;SET SECONDARY
JUMPE T1,.RETF ;NONE..ERROR..RETURN
MOVEM T1,ARG.DA(P3) ;SAVE THE VALUE
PJRST SETFIN ;FINISH THE COMMAND
SETSON:
SETNSN: MOVE S1,P1 ;GET THE FUNCTION CODE
MOVEI S2,1 ;GET THE BLOCK SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH AND SEND COMMAND
SETCIR: ;Circuit-ID
SETDAT: ;IBM logon data
SETLOM: ;IBM logon mode
SETPLU: ;IBM Application
$CALL P$TEXT
$RETIF
JRST SETCOM ;Join common code
SETCHS:
$CALL P$IFIL
$RETIF
SETCOM: STORE P1,ARG.HD(S1),AR.TYP ;Save correct type in header
$CALL MOVARG ;Build text argument and update counts
PJRST CMDEND ;Finish and send command
>;END FTDN60
SUBTTL SETDSK Process SET DISK command (TOPS20)
TOPS20 <
SETDSK: MOVE S1,G$HOST ;Get local host name
$CALL OPRENB ;Check OPR privs
$RETIF
MOVX S1,.ODSDK ;SET DISK COMMAND FOR -20
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
CAIE S1,.KYCHN ;WAS IT A CHANNEL
$RETF ;NO..RETURN
$CALL P$NUM ;GET THE NUMBER
$RETIF ;NO..ERROR
MOVEM S1,ARG.DA(P3) ;SAVE CHANNEL NUMBER
MOVEM S1,G$ARG1 ;SAVE NUMBER FOR POSSIBLE ERROR
SKIPGE S1 ;VALID CHANNEL NUMBER
PJRST E$ICN ;INVALID CHANNEL NUMBER
$CALL P$KEYW ;Get next item
$RETIF ;Need something else at least
CAIE S1,.KYCON ;Controller?
JRST [SETOM ARG.DA+1(P3) ;No, set no controller
JRST SETDS1] ;Go and make sure it is drive
$CALL P$NUM ;Get controller number
$RETIF ;Where is it???
MOVEM S1,ARG.DA+1(P3) ;Save controller number
$CALL P$KEYW ;GET NEXT ITEM
$RETIF ;BETTER BE DRIVE NUMBER
SETDS1: CAIE S1,.KYDRV ;IS IT?
$RETF ;NO..RETURN FALSE
$CALL P$NUM ;GET DRIVE NUMBER
$RETIF ;NO..ERROR..RETURN
MOVEM S1,ARG.DA+2(P3) ;SAVE THE DRIVE NUMBER IN BLOCK
MOVEM S1,G$ARG1 ;SAVE NUMBER IN CASE OF ERROR
SKIPGE S1 ;IS IT VALID
PJRST E$DDI ;DISK DRIVE INVALID
MOVX S1,.DSKDV ;DISK DRIVE BLOCK
MOVEI S2,4 ;3 WORDS
$CALL ARGRTN ;SAVE THE ARGUMENT
$CALL SETAVL ;GET SET AVALIABLE FUNCTION
JUMPT CMDEND ;END THE COMMAND AND SEND TO QUASAR
$RET ;RETURN PASSING ERROR UP
>;END TOPS20
SUBTTL SETAVL Process set available/unavailable
SETAVL: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
SETOM T1 ;FLAG FOR CHECKING VALUES
CAIN S1,.KYAVA ;AVAILABLE?
MOVX T1,.DVAVL ;SET DEVICE AVAILABLE BLOCK
CAIN S1,.KYUAV ;UNAVAILABLE?
MOVX T1,.DVUAV ;SET DEVICE UNAVAILABLE
SKIPGE T1 ;IS ONE SET
$RETF ;NO..ERROR..RETURN
MOVE S1,T1 ;BLOCK TYPE IN 1
MOVEI S2,1 ;BLOCK SIZE OF 1
$CALL ARGRTN ;SAVE THE BLOCK
CAIE T1,.DVUAV ;UNAVAILABLE??
$RETT ;NO..RETURN TRUE
$CALL PREASN ;PROCESS THE REASON
$RET ;PASS THE RETURN BACK
SUBTTL SETTAP Process SET TAPE command (TOPS20)
SETTAP: MOVE S1,G$HOST ;Get local host
$CALL OPRENB
$RETIF
MOVX S1,.ODSTP ;SET TAPE COMMAND FOR -20
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL P$DEV ;GET DEVICE BLOCK
$RETIF ;RETURN FALSE
DMOVE T1,S1 ;SAVE THE ARGUMENTS
$CALL GETDES ;GET DEVICE DESIGNATOR
$RETIF ;RETURN IF NOT A DEVICE
TXNN S2,DV%MTA ;TAPE DRIVE ???
PJRST E$ITD ;INVALID TAPE DRIVE
DMOVE S1,T1 ;RESTORE S1 AND S2
MOVX T1,.TAPDV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PUSHJ P,MOVARG ;MOVE THE BLOCK AND DATA
$CALL SETAVL ;SETUP AVAILABLE,UNAVAILABLE BLOCK
JUMPT CMDEND ;O.K.. FINISH THE COMMAND
PJRST SETINI ;TRY INITIALIZE
SUBTTL PSTAPE Process tape drive argument
;THIS ROUTINE WILL CHECK FOR A DEVICE AND A TAPE DRIVE AND
;SAVE A .TAPDV BLOCK IN THE MESSAGE
PSTAPE: $CALL P$DEV ;GET DEVICE BLOCK
$RETIF ;RETURN FALSE
PSTA.1: $CALL GETTAP ;GET A TAPE DEVICE
$RETIF ;NO..ERROR..RETURN
MOVX T1,.TAPDV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL PSTRUC Process structure argument
;THIS ROUTINE WILL SAVE A STRUCTURE BLOCK IN THE MESSAGE
PSTRUC: $CALL P$DEV ;GET THE DEVICE
$RETIF ;ERROR..RETURN
PSTRRE: MOVEI T1,.STRDV ;[130]]STRUCTURE TYPE
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE IN BLOCK
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL PVOLID Process volume-id argument
;THIS ROUTINE WILL BUILD A VOLUME ID BLOCK
PVOLID: $CALL P$QSTR ;CHECK FOR QUOTED STRING
JUMPT PVOL.1 ;YES..PROCESS IT
$CALL P$FLD ;CHECK FOR FIELD
$RETIF ;ERROR..RETURN
PVOL.1: MOVX T1,.VOLID ;VOLUME ID
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL PSDEVI Process a device argument
PSDEVI: $CALL P$DEV ;GET DEVICE BLOCK
$RETIF ;RETURN FALSE
DMOVE T1,S1 ;SAVE THE ARGUMENTS
$CALL GETDES ;GET THE DEVICE DESIGNATOR
JUMPF E$IDS ;NO..ERROR..RETURN
DMOVE S1,T1 ;RESTORE THE ARGUMENTS
MOVX T1,.CMDEV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL SETINI Process SET TAPE INITIALIZE command
;THIS COMMAND WILL BUILD A MESSAGE FOR THE TAPE PROCESSOR
;CONTAINING THE NECESSAY INFO FOR INITIALIZING TAPES
SETINI: CAIE S1,.KYINI ;WAS IT INITIALIZE
$RETF ;NO..RETURN FALSE
MOVEI S1,.DVINI ;DEVICE INITIALIZE
MOVEI S2,1 ;GET THE TYPE
$CALL ARGRTN ;SAVE THE ARGUMENT
SETI.1: $CALL P$SWITCH ;GET A SWITCH
JUMPF CMDEND ;END THE COMMAND
MOVEI S2,SETIDP ;ADDRESS OF THE TABLE
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;PASS ERROR UP
SETI.3: HLRZ P1,(S2) ;GET BLOCK TYPE
HRRZ S2,(S2) ;GET ROUTINE ADDRESS
JRST (S2) ;PROCESS ROUTINE
SETIDP: $STAB
TOPS10< .KYCNC,,[0,,SETABO] ;/ABORT >
.SWDEN,,[.SIDEN,,SETDEN] ;/DENSITY
.SWLBT,,[.SILBT,,SETLBT] ;/LABEL-TYPE
.SWOVR,,[.SIOVR,,SETOVR] ;/OVERIDE-EXPIRATION
.SWOWN,,[.SIOWN,,SETOWN] ;/OWNER
.SWPRO,,[.SIPRO,,SETPRO] ;/PROTECTION
.SWTDP,,[0,,SETTDP] ;/TAPE-DISPOSITION
.SWCNT,,[.SICTR,,SETCNT] ;/COUNT
.SWINC,,[.SIINC,,SETINC] ;/SET INCREMENT
.SWSVI,,[.SISVI,,SETSVI] ;/STARTING-VOLUME-ID
.SWVID,,[.VOLID,,SETVID] ;/VOLUME-ID
$ETAB
SUBTTL SETDEN Process /DENSITY switch
SETDEN: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,DENTAB ;DENSITY TABLE
SETD.1: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;NO MATCH..ELSE VALUE IN S2
MOVEM S2,ARG.DA(P3) ;SAVE THE DATA
SETD.2: MOVE S1,P1 ;GET ARGUMENT TYPE
MOVX S2,ARG.SZ ;GET THE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
JRST SETI.1 ;GET NEXT FIELD
DENTAB: $STAB
.KY160,,.TFD16 ;1600
.KY625,,.TFD62 ;6250
.KY800,,.TFD80 ;800
.KY556,,.TFD55 ;556
.KY200,,.TFD20 ;200
$ETAB
SUBTTL SETLBT Process /LABEL switch
SETLBT: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,LBTTAB ;LABEL TYPE TABLE
JRST SETD.1 ;PROCESS ARGUMENT
LBTTAB: $STAB
.KYANS,,%TFANS ;ANSI LABELS
.KYEBC,,%TFEBC ;EBCDIC
TOPS20< .KYT20,,%TFT20> ;TOPS-20 LABELS
.KYUNL,,%TFUNL ;UNLABELED TAPE
$ETAB
SUBTTL SETOVR Process /OVERIDE switch
SETOVR: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,OVRDSP ;OVERIDE TABLE
SETOV1: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;PASS ERROR UP
MOVE S1,S2 ;FUNCTION CODE
MOVEI S2,1 ;ARGUMENT TYPE
$CALL ARGRTN ;SAVE THE ARGUMENT
JRST SETI.1 ;GET THE NEXT ONE
OVRDSP: $STAB
.KYYES,,.SIOVR ;OVERIDE EXPIRATION
.KYNO,,.SINOV ;NO OVERIDE
$ETAB
SUBTTL SETOWN Process /OWNER switch
SETOWN: $CALL P$USER ;GET THE USER FIELD
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE USER
JRST SETD.2 ;FINISH BLOCK AND CONTINUE
SUBTTL SETPRO Process /PROTECTION switch
SUBTTL SETCNT Process /COUNT switch
SUBTTL SETINC Process /INCREMENT switch
SUBTTL SETSVI Process /START switch
SETCNT:
SETINC:
SETSVI:
SETPRO: $CALL P$NUM ;GET THE NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE DATA
JRST SETD.2 ;FINISH BLOCK AND RETURN
SUBTTL SETTDP Process /TAPE-DISPOSITION switch
SETTDP: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,TDPDSP ;TAPE DISPOSITION TABLE
JRST SETOV1 ;FINISH IT OFF
TDPDSP: $STAB
.KYHLD,,.SIHLD ;HOLD TAPE
.KYUNL,,.SIUNL ;UNLOAD THE TAPE
$ETAB
TOPS10<
SETABO: MOVX S1,.SIABO ;GET /ABORT BLOCK
MOVEI S2,1 ;GET BLOCK LENGTH OF 1
PUSHJ P,ARGRTN ;SAVE THE BLOCK
JRST CMDEND ;FINISH AND SEND COMMAND OFF
> ;END TOPS10 CONDITIONAL
SUBTTL SETVID Process /VOLUME-ID switch
SETVID: $CALL PVOLID ;PROCESS VOLUME-ID
JUMPT SETI.1 ;O.K.. GET NEXT BLOCK
$RET ;PASS ERROR UP
SUBTTL TABSRC Table search routine
;THIS ROUTINE WILL SEARCH A TABLE FOR A SPECIFIED VALUE AND
;RETURN THE ASSOCIATED INFO
;THE TABLE ENTRIES SHOULD HAVE CODE IN LEFT HALF AND DATA IN RIGHT HALF
;AND USE $STAB TO START THE TABLE AND $ETAB TO END IT
;CALL S1/ ITEM TO LOOK FOR
; S2/ ADDRESS OF TABLE
;
;
;RETURN S1/ ITEM TO LOOK FOR
; S2/ ITEM FOUND IN TABLE
;WILL USE T1 AND T2 FOR SCRATCH
TABSRC:: HLLZ T1,(S2) ;GET THE NUMBER OF ENTRIES
MOVN T1,T1 ;MAKE IT NEGATIVE
HRRI T1,1(S2) ;ADDRESS OF THE TABLE
TABS.1: HLRZ T2,(T1) ;GET THE ENTRY
CAMN S1,T2 ;MATCH?
JRST TABS.2 ;YES..
AOBJN T1,TABS.1 ;TRY NEXT ONE
$RETF ;ERROR..RETURN
TABS.2: HRRZ S2,(T1) ;GET THE DATA
$RETT ;RETURN TRUE
SUBTTL GETDES Get device designator word
;THIS ROUTINE WILL RETURN THE DEVICE DESIGNATOR WORD FOR
;THE DEVICE BLOCK PASSED
;
;RETURN S2/ DEVICE DESIGNATOR INFO
TOPS20 <
GETDES: HRROI S1,ARG.DA(S1) ;GET STRING ADDRESS
HRRZM S1,G$ARG1 ;SAVE THE POINTER
STDEV ;GET DESIGNATOR
$RETF ;RETURN FALSE
TRNE S2,400000 ;CHECK NOT MT DEVICE
PJRST E$ITD ;ERROR CODE
HLRZS S2 ;CLEAR RIGHT HALF AND PLACE IN RIGHT
SUBI S2,.DVDES ;GET TO DEVICE TYPE
$RETT ;RETURN DESIGNATOR IN S2
>;END TOPS20
TOPS10 <
GETDES: HRROI S1,ARG.DA(S1) ;GET STRING ADDRESS
HRRZM S1,G$ARG1 ;SAVE STRING POINTER
$CALL S%SIXB ;CONVERT TO SIXBIT
DEVCHR S2, ;DO THE DEVCHR
SKIPN S2 ;ANY BITS
$RETF ;RETURN FALSE
$RETT ;RETURN TRUE
>;END TOPS10
SUBTTL GETTAP Get a tape device
;THIS ROUTINE WILL CHECK FOR A VALID TAPE DEVICE AND RETURN FALSE
;IF DEVICE IS NOT A TAPE DRIVE
;OTHERWISE
; S1/ ADDRESS OF BLOCK
; S2/ LENGTH OF BLOCK
GETTAP:
TOPS10 <$RETT> ;NOT NEEDED ON THE -10
TOPS20 <
DMOVE T1,S1 ;SAVE THE ARGUMENTS
$CALL GETDES ;GET THE DESIGNATOR
JUMPF E$ITD ;ERROR ..RETURN
CAIE S2,.DVMTA ;IS IT MTA
JRST GETT.1 ;SETUP ERROR RETURN
DMOVE S1,T1 ;RESTORE S1 AND S2 FROM P$DEV RETURN
$RETT ;RETURN TRUE
GETT.1: DMOVE S1,T1 ;RESTORE DEVICE DATA
$RETF ;RETURN FALSE
>;END TOPS20
SUBTTL SETSTR Process SET STRUCTURE command (TOPS20)
TOPS20 <
SETSTR: MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
MOVX S1,.ODSST ;SET STRUCTURE COMMAND FOR -20
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL PSTRUC ;PROCESS A STRUCTURE BLOCK
$RETIF ;ERROR..RETURN
$CALL P$KEYW ;GET THE OPTIONS
$RETIF ;ERROR..RETURN
MOVEI S2,STRDSP ;STRUCTURE DISPATCH TABLE
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVEM S2,ARG.DA(P3) ;SAVE VALUE IN BLOCK
MOVX S1,.STCHR ;STRUCTURE CHARACTERISTICS
MOVEI S2,2 ;SIZE OF BLOCK
$CALL ARGRTN ;BUILD BLOCK
PJRST CMDEND ;CHECK FOR END AND SEND TO QUASAR
STRDSP: $STAB
.KYACK,,S.ACKN ;ACKNOWLEDGED
.KYAVA,,S.AVAL ;AVAILABLE
.KYDOM,,S.DOMS ;DOMESTIC
.KYEXL,,S.EXCL ;Exclusive
.KYFOR,,S.FORN ;FOREIGN
.KYREG,,S.REGU ;REGULATED
.KYSHR,,S.SHAR ;Shared
.KYUAV,,S.UAVL ;UNAVAILABLE
.KYURG,,S.UREG ;UNREGULATED
.KYIGN,,S.IGNO ;IGNORE
.KYDUM,,S.DUMP ;[132]Dumpable
.KYNDM,,S.NODP ;[132]Nondumpable
$ETAB
>;END TOPS20
SUBTTL SETPOR Process SET PORt command
; Initially this command only supports CI as the keyword. Eventually
; however, it should also support NI and a channel number to be set
; on/offline.
SETPOR: MOVE S1,G$HOST ;Get local host name
$CALL OPRENB ;Check privs.
$RETIF ;Not enough
$CALL P$KEYW ;Get a keyword
$RETIF ;Error -- return
CAIN S1,.KYNI ;Set PORT NI?
JRST SETNI ;Yes, process it
CAIE S1,.KYCI ;No, SET PORT CI?
$RETF ;No, error
MOVX S1,.ODSPO ;Set port
STORE S1,.MSTYP(MO),MS.TYP ;Save the type in the header
$CALL P$KEYW ;Get a keyword
$RETIF ;Error -- return
SETO S2, ;Set flag word
TLZ S2,-1 ;Clear flag bits
TXO S2,DV.CI ;Set it as CI
CAIN S1,.KYUAV ;Unavailable?
TXOA S2,DV.UAV ;Yes, set it as unavailable
SKIPA
JRST SETP.1 ;Go to cleanup
CAIE S1,.KYAVA ;Available?
$RETF ;No, bad message
TXO S2,DV.AVA ;Yes, set it as available
SETP.1: MOVEM S2,ARG.DA(P3) ;Save the argument
MOVEI S1,.PORDV ;Argument type
MOVEI S2,ARG.SZ ;Standard size
$CALL ARGRTN ;Set up the argument block
PJRST CMDEND ;Go clean-up
SETNI: $CALL .SAVE2 ;Save P1
$CALL OPRMS## ;Setup OPR message
$CALL P$KEYW ;Get a keyword
$RETIF ;Error, invalid message
MOVE P1,S1 ;Save S1 for later
$CALL P$CFM ;Check for confirm
$RETIF ;Error, invalid message
MOVE S1,[8,,.EIRCI] ;Going to check status of the NI
MOVEI S2,0 ;Zero status word
PUSHJ P,SETBLK ;Set up the block
NI% ;Pick up status of the NI
ERJMPR NIERR ;Quit if error
MOVE P2,NIJBLK##+.EISTA ;Save the status for later
CAIN P1,.KYUAV ;UNAVAILABLE?
JRST NIUNA ;Yes
CAIN P1,.KYAVA ;AVAILABLE?
JRST NIAVA ;Yes
$RETF ;No, bad message
NIUNA: TXNN P2,EI%RUN ;Is the NI available?
JRST [ $TEXT(WTORTN##,< -- Problem Setting Port --
NI Port already set unavailable >)
JRST NIFIN ] ;And finish
MOVE S1,[4,,.EISCS] ;Set channel state
MOVEI S2,.EISOF ;To unavailable
PUSHJ P,SETBLK ;Set up the NI argument block
NI% ;Do it
ERJMPR NIERR ;Notify if an error
$TEXT(WTORTN##,< -- NI PORT SET UNAVAILABLE -->)
JRST NIFIN ;Finish up the message
NIAVA: TXNE P2,EI%RUN ;Is the NI already set available?
JRST [ $TEXT(WTORTN##,< -- Problem Setting Port --
NI Port already set available>)
JRST NIFIN ] ;And finish
MOVE S1,[4,,.EISCS] ;Set channel state
MOVEI S2,.EISRR ;To running
PUSHJ P,SETBLK ;Set up the argument block
NI% ;Do it
ERJMPR NIERR ;Notify if an error
$TEXT(WTORTN##,< -- NI PORT SET AVAILABLE -->)
JRST NIFIN ;Finish up the message
NIERR: $TEXT(WTORTN##,< -- NI% JSYS Failure - Error: ^E/S1/ -->)
NIFIN: $CALL MSGFIN## ;Finish the message
$CALL L$SHWM## ;Log the message
MOVE S1,G$SND## ;Get the Sender's PID
MOVEI S2,PAGSIZ ;Page message size
$CALL SPDOPR## ;Send to OPR
$RETT ;And return
SETBLK: MOVEM S1,NIJBLK##+.EILEN ;Set up the first word of the block
SETZM NIJBLK##+.EIFLG ;Zero the flags
SETZM NIJBLK##+.EICHN ;Zero the channel number
SETZM NIJBLK##+.EIPSI ;Zero the PSI channels
STORE S2,NIJBLK##+.EISTA,EI%SST ;Store the channel substate
MOVEI S1,NIJBLK## ;Pick up the block address
$RET
SUBTTL Q$SHCF Process SHOW CONFIGURATION command
;THIS ROUTINE WILL SEND A SHOW CONFIGURATION MESSAGE TO QUASAR
Q$SHCF::SETOM ARG.DA+OBJ.UN(P3) ;DEFAULT FOR ALL UNITS
$CALL P$CFM ;CHECK FOR CONFIRM
JUMPT SHCF0 ;YES, NO GOOD
$CALL P$KEYW ;GET A KEYWORD..(TYPE)
JUMPF SHCF0 ;NO KEYWORD, NO GOOD
CAIN S1,.KYDSK ;WAS IT A DISK?
PJRST SHWCFG ;PROCESS THE DISKS
SHCF0: $RETF ;BAD COMMAND
SUBTTL Q$SHWS Process SHOW STATUS command
;THIS ROUTINE WILL SEND A SHOW STATUS MESSAGE TO QUASAR
Q$SHWS::MOVEI S1,.OMSHS ;[130]GET THE SHOW STATUS CODE
SKIPA ;[130]PROCESS THE DISKS
SUBTTL Q$SHWP Process SHOW PARAMETERS command
;THIS ROUTINE WILL SEND A SHOW PARAMETERS MESSAGE TO QUASAR
Q$SHWP::MOVEI S1,.OMSHP ;[130]GET SHOW PARAMTERS CODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE TIE TYPE CODE
SUBTTL PROSHW Process SHOW STATUS and SHOW PARAMETERS
;COMMON CODE FOR SHOW STATUS AND SHOW PARAMETERS
PROSHW: $CALL CHKRMT ;See if this is a remote OPR
SETOM ARG.DA+OBJ.TY(P3) ;DEFAULT TO ALL TYPES
SETOM ARG.DA+OBJ.UN(P3) ;DEFAULT FOR ALL UNITS
SETOM ARG.DA+OBJ.ND(P3) ;DEFAULT FOR ALL NODES
CAME S1,G$HOST ;Did CHKRMT find the node to be host?
MOVEM S1,ARG.DA+OBJ.ND(P3) ;Save the node info
$CALL P$CFM ;CHECK FOR CONFIRM
JUMPT PROS.6 ;SAVE BLOCK AND RETURN
$CALL P$KEYW ;GET A KEYWORD..(TYPE)
JUMPF PROS.2 ;TRY FOR A SWITCH
CAIG S1,.OTMAX ;VALID OBJECT TYPE
JRST PROS.1 ;YES..GOOD OBJECT
CAIN S1,.KYDSK ;WAS IT A DISK?
PJRST SHWDSK ;PROCESS THE DISKS
CAIN S1,.KYSTR ;WAS IT A STRUCTURE
PJRST SHWSTR ;PROCESS THE STRUCTURES
CAIN S1,.KYTAP ;ALL TAPES?
PJRST SHWTAP ;PROCESS THE TAPES
CAIN S1,.KYNOD ;CHECK FOR NETWORK NODE
PJRST SHWNOD ;SHOW NODE COMMAND
$RETF ;BAD COMMAND
PROS.1: MOVEM S1,ARG.DA+OBJ.TY(P3) ;SAVE THE OBJECT TYPE
MOVE P1,S1 ;[126]SAVE FOR FINOBJ LPT PROCESSING
$CALL P$CFM ;END OF COMMAND?
JUMPT PROS.6 ;FINISH OFF BLOCK
PROS.2: $CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF PROS.4 ;NO..TRY OBJECT BLOCK REMAINDER
$CALL CHCLUN ;[130]IS THIS A CLUSTER-NODE SWITCH?
JUMPF PROS.3 ;[130]NO, CHECK FOR A NODE SWITCH
$CALL ADDOBJ ;[130]ADD THE OBJECT BLOCK TO THE MSG
JRST CLUN.1 ;[130]GO SEND THE MESSAGE
PROS.3: CAIE S1,.SWNOD ;[130]NODE?
JRST [$CALL PROSHT ;PROCESS SHORT IF THERE
$RETIF ;ERROR..RETURN
$CALL ADDOBJ ;[130]ADD THE OBJECT BLOCK TO THE MSG
$CALL P$SWIT ;[130]CHECK FOR A CLUSTER NODE SWITCH
JUMPF SNDQSR ;[130]IF NONE, SEND THE MSG TO QUASAR
JRST CLUN.1 ] ;[130]ELSE DETERMINE WHERE TO SEND TO
$CALL P$NODE ;GET THE NODE
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA+OBJ.ND(P3) ;SAVE NODE IN BLOCK
$CALL ADDOBJ ;[130]FINISH BUILDING THE OBJECT BLOCK
$CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF SNDQSR ;[130]IF NONE, THEN SEND THE MESSAGE
$CALL CHCLUN ;[130]IS THIS A CLUSTER-NODE SWITCH?
JUMPT CLUN.1 ;[130]YES, GO SEND THE MESSAGE
CAIE S1,.SWSHT ;WAS IT SHORT
$RETF ;NO..RETURN FALSE
MOVX S1,LS.FST ;GET THE FLAGS
IORM S1,.OFLAG(MO) ;SAVE IN FLAG WORD
PJRST SNDQSR ;[130]SEND THE MESSAGE TO QUASAR
PROS.4: $CALL FINOBJ ;FINISH OBJECT BLOCK
$RETIF ;NO..ERROR..RETURN
$CALL P$SWIT ;SWITCH THERE?
JUMPF CMDEND ;CHECK FOR THE END
$CALL CHCLUN ;[130]IS THIS A CLUSTER-NODE SWITCH?
JUMPT CLUN.1 ;[130]YES, GO SEND THE MESSAGE
CAIE S1,.SWNOD ;[127]IS IT A NODE SWITCH?
JRST PROS.5 ;[127]NO, THEN /SHORT SWITCH
$CALL P$NODE ;[127]PICK UP THE NODE NAME
$RETIF ;[127]IF AN ERROR, THEN RETURN
MOVEM S1,ARG.DA+OBJ.ND(P3) ;[127]PLACE IN THE MESSAGE
$CALL P$SWIT ;[127]CHECK FOR A SWITCH
JUMPF CMDEND ;[127]NO, CHECK FOR THE END
$CALL CHCLUN ;[130]IS THIS A CLUSTER-NODE SWITCH?
JUMPT CLUN.1 ;[130]YES, GO SEND THE MESSAGE
PROS.5: $CALL PROSHT ;[127]PROCESS /SHORT IF THERE
$RETIF ;ERROR...RETURN
PJRST CLUNOD ;[130]GO CHECK FOR A CLUSTER-NODE SWITCH
PROS.6: $CALL ADDOBJ ;[130]ADD THE OBJECT BLOCK
PJRST SNDQSR ;SEND THE COMMAND
PROSHT: CAIE S1,.SWSHT ;WAS IT SHORT
$RETF ;NO..RETURN FALSE
MOVX S1,LS.FST ;GET THE FLAGS
IORM S1,.OFLAG(MO) ;SAVE IN FLAG WORD
$RETT ;RETURN TRUE
ADDOBJ: MOVX S1,.OROBJ ;[130]BLOCK TYPE
MOVX S2,.OBJLN ;[130]BLOCK SIZE
$CALL ARGRTN ;[130]SAVE THE BLOCK
ANDI P3,777 ;[130]GET LENGTH OF MESSAGE
STORE P3,.MSTYP(MO),MS.CNT ;[130]SAVE THE COUNT
$RET ;[130]RETURN TO THE CALLER
Q$SHWR:: MOVX S1,.OMSHR ;SHOW ROUTE TABLES
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
MOVEI S1,.OHDRS ;JUST THE HEADER
STORE S1,.MSTYP(MO),MS.CNT ;SAVE THE COUNT
$CALL P$SWIT ;[130]IS THERE A SWITCH?
JUMPF SNDQSR ;[130]NO, SEND THE MESSAGE TO QUASAR
MOVEI P3,.OHDRS(MO) ;[130]POINT TO THE NODE BLOCK
$CALL CHCLUN ;[130]IS THIS A CLUSTER-NODE SWITCH?
JUMPF .POPJ ;[130]NO, INDICATE AN ERROR
SKIPN G$CLUN ;[130]LOCAL NODE NAME SPECIFIED?
PJRST SNDQSR ;[130]YES, SEND THE MESSAGE TO QUASAR
PJRST SNDCLU ;[130]SEND THE MESSAGE TO NEBULA
SUBTTL SHWNOD Process node for SHOW STATUS/PARAMETERS command
;THIS ROUTINE WILL BUILD A NODE BLOCK FOR QUASAR TO IDENTIFY THE
;NODE TO BE EXAMINED.
;IF NO NODENAME IS SPECIFIED THE DEFAULT -1 WILL BE USED.
SHWNOD: MOVX S1,.OMSSN ;SHOW STATUS NODE
LOAD S2,.MSTYP(MO),MS.TYP ;GET THE TYPE BLOCK
CAIE S2,.OMSHS ;WAS IT SHOW STATUS
MOVX S1,.OMSPN ;NO..SHOW PARAMETERS NODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN BLOCK
$CALL P$NODE ;GET THE NODE DATA
SKIPT ;O.K.. CONTINUE ON
SETOM S1 ;ASSUME ALL NODES
$CALL SAVNOD ;SAVE THE VALUE
PJRST CLUNOD ;[130]CHECK FOR CLUSTER-NODE BLOCK
SUBTTL SHWTAP Process SHOW STATUS TAPE command
;THIS ROUTINE WILL SHOW THE STATUS OF THE TAPE DRIVE
SHWTAP: MOVEI S1,.ODSHT ;SHOW STATUS COMMAND
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
$CALL P$DEV ;WAS IT A DEVICE
JUMPT SHWT.1 ;YES.. BUILD DEVICE BLOCK
MOVX S1,.ALTAP
MOVEI S2,1 ;BLOCK SIZE
$CALL ARGRTN ;SAVE THE BLOCK
JRST SHWT.2 ;FINISH OFF THE COMMAND
SHWT.1: $CALL PSTA.1 ;BUILD THE BLOCK
$RETIF ;FAIL..RETURN
SHWT.2: $CALL P$SWIT ;IS THERE A SWITCH?
JUMPF CMDEND ;NO..FINISH OFF COMMAND
MOVEI S2,TAPSWI ;TAPE SWITCHES
SHWTAB: $CALL TABSRC ;SEARCH THE TABLE
JUMPF SHWT.3 ;[142]Not here, could be /CLUSTER
MOVE S2,(S2) ;GET THE DATA
IORM S2,.OFLAG(MO) ;SAVE THE FLAGS
$CALL P$SWIT ;[142]Is there a switch?
JUMPF CMDEND ;[142]No end the command
;[142] before we come to here, s1/switch block type from P$SWIT
SHWT.3: $CALL CHCLUN ;[142]IS THIS A CLUSTER-NODE SWITCH?
JUMPT CLUN.1 ;[142]YES, GO SEND THE MESSAGE
$RETF ;[142]No, back command
SHOWTB: $CALL TABSRC ;[130]SEARCH THE TABLE
$RETIF ;[130]ERROR..RETURN
MOVE S2,(S2) ;[130]GET THE DATA
IORM S2,.OFLAG(MO) ;[130]SAVE THE FLAGS
$RETT ;[130]RETURN TO THE CALLER
TAPSWI: $STAB
.SWALL,,[ST.ALL] ;ALL
.SWCHR,,[ST.CHR] ;CHARACTERISTICS
.SWFRE,,[ST.AVA] ;FREE(AVAILABLE)
$ETAB
SUBTTL SHWSTR Process SHOW STATUS STRUCTURES command
;THIS COMMAND WILL SHOW STATUS OF STRUCTURES
SHWSTR: MOVEI S1,.ODSTR ;GET MESSAGE TYPE
PJRST SHWD.0 ;Join some common code in show disk
SUBTTL SHWCFG Process SHOW CONFIGURATION DISK-DRIVE command
;THIS COMMAND WILL SHOW CONFIGURATION OF DISK DRIVES
SHWCFG: MOVEI S1,.ODSCD ;GET MESSAGE TYPE
PJRST SHWD.0 ;Join some common code in show disk
SUBTTL SHWDSK Process SHOW STATUS DISK command
;THIS ROUTINE WILL DO SHOW STATUS OF DISK DRIVES
SHWDSK: MOVEI S1,.ODSHD ;SHOW STATUS COMMAND
SHWD.0: STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
$CALL P$DEV ;CHECK FOR A DEVICE BLOCK
JUMPT SHWD.1 ;CHECK OUT THE STRUCTURE
MOVX S1,.ALDSK ;FOR ALL DISK DRIVES
MOVEI S2,1 ;ONE WORD
$CALL ARGRTN ;SAVE THE BLOCK
$CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF CMDEND ;NO SWITCH CHECK IF END
$CALL CHCLUN ;[130]IS THIS A CLUSTER-NODE SWITCH?
JUMPT SHWD.2 ;[130]YES, GO SEND THE MESSAGE
MOVEI S2,DSKDSP ;GET DSK TABLE ADDRESS
$CALL SHOWTB ;[130]DO THE TABLE LOOKUP
JUMPF .POPJ ;[130]RETURN ON A MESSAGE FORMAT ERROR
SKIPA ;[130]CHECK FOR A /CLUSTER-NODE SWITCH
SHWD.1: $CALL PSTRRE ;[130]CHECK FOR A STRUCTURE
$CALL P$SWIT ;[130]CHECK FOR A SWITCH
JUMPF CMDEND ;[130]NONE, SO SEND THE MESSAGE
$CALL CHCLUN ;[130]CHECK FOR A CLUSTER-NODE SWITCH
JUMPF .POPJ ;[130]NOT A CLUSTER-NODE SWITCH
SHWD.2: SKIPN G$CLUN ;[130]REMOTE NODE SPECIFIED?
JRST CMDEND ;[130]NO, TREAT AS LOCAL
PJRST SNDCLU ;[130]SEND THE MESSAGE TO NEBULA
DSKDSP: $STAB
.SWALL,,[ST.ALL] ;ALL
.SWAVA,,[ST.AVA] ;AVAILABLE
.SWMNT,,[ST.MNT] ;MOUNTED
$ETAB
SUBTTL Q$SHWQ Process SHOW QUEUES command
;THIS ROUTINE WILL FORMAT MESSAGE TO QUASAR FOR SHOW QUEUES
Q$SHWQ:: STKVAR <NFLAG> ;Save a flag to indicate a node name
MOVX S1,.OMSHQ ;SHOW THE QUEUES
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
$CALL P$KEYW ;GET A KEYWORD
JUMPF SHWQ.1 ;No keyword -- assume all
MOVEI S2,QUETYP ;Get the queue type table
$CALL TABSRC ;Search the table
JUMPT [MOVE S1,(S2) ;Get the data
JRST SHWQ.2] ;Continue at store
CAIE S1,.KYALL ;Was all specified?
PJRST E$IQS ;Invalid queue specified and return
SHWQ.1: SETOM S1 ;Set for all
SHWQ.2: STORE S1,.OHDRS+ARG.DA(MO) ;Save type of queue
MOVEI S1,.LSQUE ;Get argument type
MOVEI S2,ARG.SZ ; and size
$CALL ARGRTN ;Setup the argument
SETZM NFLAG ;We have no node name so far
; Loop on switches till confirm
SETZM .OFLAG(MO) ;Initialize flag
SHWQ.3: $CALL P$CFM ;Check for confirm / C.R.
JUMPT SHWQ.8 ;Go clean up.
$CALL P$SWIT ;Get a switch
$RETIF ;Since no confirm, no switch is error
$CALL CHCLUN ;[130]Is this a CLUSTER-NODE switch?
JUMPT CLUN.1 ;[130]Yes, go send the message
CAIN S1,.SWNOD ;Node switch?
JRST SHWQ.4 ;Yes - go process node name
CAIN S1,.SWUSR ;User switch?
JRST SHWQ.5 ;Yes - go process user name
SKIPE .OFLAG(MO) ;ALL or SHORT specified previously?
$RETF ;Yes - quit bad
CAIN S1,.SWALL ;All specified?
JRST SHWQ.6 ;Yes - go process all
CAIN S1,.SWSHT ;Short specified?
JRST SHWQ.7 ;Yes - go process short
$RETF ;No legal switch, return bad
; Continued on next page
; Continued from previous page
; Process node name
SHWQ.4: $CALL P$NODE ;Check out the node name
$RETIF ;Quit if bad
$CALL SAVNOD ;Save the stuff in the message
SETOM NFLAG ;We now have a node name
JRST SHWQ.3 ;Try for another switch
; Process user name
SHWQ.5: $CALL PUSERS ;Try to process the user name switch
$RETIF ;Quit if none
JRST SHWQ.3 ;Try for another switch
; Process all switch
SHWQ.6: MOVX S1,LS.ALL ;Set for all listing
MOVEM S1,.OFLAG(MO) ;Remember it
JRST SHWQ.3 ;Try for another switch
; Process short switch
SHWQ.7: MOVX S1,LS.FST ;Set for fast (short) listing
MOVEM S1,.OFLAG(MO) ;Remember it
JRST SHWQ.3 ;Try for another switch
; Finish off the command
SHWQ.8: SKIPN NFLAG ;Already have a node name?
$CALL CHKRMT ;No, do this here
ANDI P3,777 ;Get the message length
STORE P3,.MSTYP(MO),MS.CNT ;Save the count
$CALL SNDQSR ;Send the message
$RETT ;Return true
DEFINE X(TYP),<
.OT'TYP,,[LIQ'TYP] >
QUETYP: $STAB
DEVQUE
$ETAB
SUBTTL Q$SHWC Process SHOW CONTROL-FILE command
;THIS ROUTINE DOES THE OLD BATCON EXAMINE FUNCTION FOR
;SHOWING THE OPERATOR LINES IN A BATCH CONTROL-FILE
Q$SHWC:: MOVX S1,.OMSHC ;SHOW CONTROL-FILE TYPE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE
$CALL BLDOBJ ;BUILD AN OBJECT BLOCK
$RETIF ;ERROR..RETURN
MOVEI T1,.OHDRS+ARG.DA(MO) ;POINT TO OBJECT BLOCK
LOAD S1,OBJ.UN(T1),OU.HRG ;GET THE HIGH VALUE
JUMPN S1,.RETF ;NON-ZERO..ERROR
LOAD S1,OBJ.TY(T1) ;GET THE TYPE FIELD
CAXE S1,.OTBAT ;BETTER BE BATCH
$RETF ;RETURN FALSE..ERROR
$CALL P$SWIT ;GET A SWITCH
JUMPF SHWC.2 ;NO..SETUP DEFAULT LINES
CAIE S1,.SWLNS ;IS IT LINES
$RETF ;INVALID COMMAND
MOVEI T2,.SHCLN ;YES..SETUP SHOW LINES TYPE
$CALL P$NUM ;GET A NUMBER
$RETIF ;ERROR..RETURN
SHWC.1: STORE S1,ARG.DA(P3) ;SAVE NUMBER IN BLOCK
MOVE S1,T2 ;GET THE ARGUMENT TYPE
MOVEI S2,ARG.SZ ;SIZE OF THE BLOCK
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH OFF THE MESSAGE
SHWC.2: MOVEI S1,^D10 ;DEFAULT TO 10 LINES
MOVEI T2,.SHCLN ;SHOW CONTROL FILE LINES
JRST SHWC.1 ;FINISH OFF BLOCK AND MESSAGE
SUBTTL Q$SHCL - SHOW CLUSTER-GALAXY-STATUS-LINK
Q$SHCL::MOVE S1,[.OHDRS,,.NSCLU] ;[136]PICK UP THE MESSAGE TYPE
MOVEM S1,.MSTYP(MO) ;[136]PLACE IN THE MESSAGE
MOVX S1,MF.NEB ;[136]PICK UP THE NEBULA BIT
MOVEM .MSFLG(MO) ;[136]PLACE IN THE MESSAGE
$CALL P$SWIT ;[136]IS THERE A SWITCH BLOCK?
JUMPT SHCL.1 ;[136]YES, GO CHECK ITS TYPE
$CALL P$CFM ;[136]IS THERE A CARRIAGE RETURN?
$RETIF ;[136]NO, ILLEGALLY FORMATTED MESSAGE
PJRST SNDNEB ;[136]GO SEND THE MESSAGE TO NEBULA
SHCL.1: $CALL CHCLUN ;[136]IS IT A CLUSTER-NODE SWITCH?
JUMPT SHCL.3 ;[136]YES, ADD THE CLUSTER NODE BLOCK
CAIE S1,.SWNOD ;[136]IS IT A NODE SWITCH?
$RETF ;[136]NO, ILLEGALLY FORMATTED MESSAGE
$CALL P$NODE ;[136]PICK UP THE NODE NAME
$RETIF ;[136]RETURN ON AN ERROR
$CALL SAVNOD ;[136]BUILD THE NODE BLOCK IN THE MSG
$CALL P$SWIT ;[136]IS THERE ANOTHER SWITCH BLOCK?
JUMPT SHCL.2 ;[136]YES, CHECK FOR CLUSTER-NODE
SETOM G$CLUN ;[136]NO, INDICATE SEND TO NEBULA
PJRST CMDEND ;[136]SEND THE MESSAGE TO NEBULA
SHCL.2: $CALL CHCLUN ;[136]IS THIS A CLUSTER-NODE SWITCH?
$RETIF ;[136]IF NO, THEN INDICATE AN ERROR
SHCL.3: DMOVE S1,G$CBLK ;[136]PICK UP THE CLUSTER NODE BLOCK
DMOVEM S1,ARG.HD(P3) ;[136]PLACE IN THE MESSAGE
SKIPE G$CLUN ;[136]LOCAL NODE NAME SPECIFIED?
JRST SHCL.4 ;[136]NO, GO SEND THE MESSAGE
MOVE S1,G$HOST ;[136]PICK UP THE LOCAL NODE NAME
MOVEM S1,ARG.DA(P3) ;[136]PLACE IN THE MESSAGE
SETOM G$CLUN ;[136]INDICATE SEND TO NEBULA
SHCL.4: AOS .OARGC(MO) ;[136]INCREMENT THE ARGUMENT COUNT
ADDI P3,.NDESZ ;[136]INCREMENT THE MESSAGE LENGTH
PJRST CMDEND ;[136]SEND THE MESSAGE TO NEBULA
SUBTTL CLUNOD - Send the message as determined by CLUSTER-NODE switch
CLUNOD: $CALL P$SWIT ;[130]IS THERE A SWITCH BLOCK?
JUMPF CMDEND ;[130]NO, SEND THE MESSAGE TO QUASAR
$CALL CHCLUN ;[130]DETERMINE WHERE MSG IS TO BE SENT
JUMPF .POPJ ;[130]INDICATE ILLEGAL FORMAT
CLUN.1: SKIPN G$CLUN ;[130]LOCAL NODE SPECIFIED?
JRST CMDEND ;[130]YES, TREAT AS LOCAL
PJRST SNDCLU ;[130]SEND THE MESSAGE AS INDICATED
SUBTTL CHCLUN - Modify message for NEBULA
;Routine CHCLUN checks if a switch block is a cluster node switch block.
;If it is, then CHCLUN determines if the message is to be processed locally,
;remotely or both locally and remotely.
;
;Call is: S1/Switch block type
;
;Returns true: S1/Switch block type
; The block is a switch block
; G$CLUN/0 The message is to be processed locally
; G$CLUN/SIXBIT node name The message is to be forwarded
; G$CLUN/-1 The message is to be processed by
; all the cluster nodes
;Returns false: S1/Switch block type
; The block is not a switch block
INTERN CHCLUN ;[135]Make it global
CHCLUN::CAIE S1,.SWCLN ;[135]IS IT A CLUSTER-NODE SWITCH?
;**;[144]At CHCLUN:+1L change 1 line JYCW Oct-18-88
JRST CHCL.4 ;[144]NO, INDICATE SO
PUSH P,S1 ;[136]SAVE THE SWITCH TYPE
$CALL P$CURR ;[130]PICK UP CLUSTER NODE BLOCK ADR
MOVE S2,PFD.D1(S1) ;[130]PICK UP THE SWITCH DATA
CAMN S2,[-1] ;[130]FOR ALL NODES IN THE CLUSTER?
JRST [SETOM G$CLUN ;[130]INDICATE FOR ALL NODES
JRST CHCL.1 ] ;[130]GO MODIFY THE MSG FOR NEBULA
CAMN S2,G$HOST ;[130]LOCAL NODE SPECIFIED?
JRST CHCL.2 ;[130]YES, POINT TO NEXT BLOCK
MOVEM S2,G$CLUN ;[130]SAVE THE CLUSTER NODE NAME
CHCL.1: DMOVE S1,PFD.HD(S1) ;[130]PICK UP THE CLUSTER NODE BLOCK
DMOVEM S1,G$CBLK ;[130]]SAVE FOR LATER
CHCL.2: $CALL P$NEXT ;[130]POINT TO THE CONFIRM BLOCK
POP P,S1 ;[136]RESTORE THE SWITCH TYPE
;**;[144]At CHCL.2:+2L add 5 lines JYCW Oct-18-88
SKIPN G$NOFG ;[144]DO WE HAVE /NODE:
JRST CHCL.3 ;[144]NO ALL DONE
MOVX S2,.RMLPT ;[144]GET THE BIT
IORM S2,ARG.DA+.OHDRS+OBJ.TY(MO) ;[144]SET IT IN THE OBJECT BLOCK
SETZM G$NOFG ;[144]lCLEAR /NODE: SWITCH FLAG
CHCL.3: $RETT ;[130]RETURN TO THE CALLER
;**;[144]AT CHCL.3+1L add 2 lines JYCW Oct-18-88
CHCL.4: SETZM G$NOFG ;[144]CLEAR /NODE: SWITCH FLAG
$RETF ;[144]ALL DONE
SUBTTL SNDCLU - Send a cluster message
;SNDCLU determines if a cluster message is to be sent to a particular node
;or to all the nodes in the cluster including the local node.
SNDCLU: $CALL P$CFM ;[130]CHECK FOR A CONFIRM BLOCK
$RETIF ;[130]INDICATE AN ERROR IF NO CONFIRM
SNDCL0: SETOM G$FERR ;[130]ASSUME FIRST MESSAGE SENT O.K.
ANDI P3,777 ;[130]ISOLATE THE MESSAGE LENGTH
STORE P3,.MSTYP(MO),MS.CNT ;[130]STORE THE LENGTH
MOVE S1,G$CLUN ;[130]PICK UP DESTINATION FLAG
CAME S1,[-1] ;[130]SEND MESSAGE TO ALL THE NODES?
PJRST SNDC.2 ;[130]NO, SEND MESSAGE TO NEBULA
$SAVE <P1> ;[130]SAVE THIS AC
$CALL M%GPAG ;[130]PICK UP A SECOND MESSAGE PAGE
MOVE P1,S1 ;[130]SAVE ITS ADDRESS
MOVE S2,P3 ;[130]PICK UP THE MESSAGE LENGTH
ADD S2,S1 ;[130]POINT TO END OF MESSAGE + 1
HRL S1,MO ;[130]SOURCE,,DESTINATION
BLT S1,-1(S2) ;[130]COPY MESSAGE TO NEW PAGE
$CALL SNDQSR ;[130]SEND THE FIRST MESSAGE TO QUASAR
JUMPT SNDC.1 ;[130]DON'T RELEASE PAGE ON SUCCESS
$CALL RELPAG ;[130]RELEASE THE MESSAGE PAGE
SETZM G$FERR ;[130]INDICATE FAILURE FOR MSG SEND
SNDC.1: MOVE MO,P1 ;[130]PLACE MESSAGE ADR WHERE EXPECTED
SNDC.2: ADDI P3,.MSTYP(MO) ;[130]POINT TO THE CLUSTER NODE BLOCK
DMOVE S1,G$CBLK ;[130]PICK UP THE CLUSTER NODE BLOCK
DMOVEM S1,ARG.HD(P3) ;[130]PLACE IN THE MESSAGE
AOS .OARGC(MO) ;[130]INCREMENT THE ARGUMENT COUNT
MOVSI S1,.NDESZ ;[130]PICK UP SIZE OF CLUSTER NODE BLK
ADDM S1,.MSTYP(MO) ;[130]ADD TO THE TOTAL MESSAGE LENGTH
LOAD S1,.MSTYP(MO),MS.TYP ;[134]PICK UP THE MESSAGE TYPE
MOVEI S2,QRTONB ;[134]PICK UP THE CODE TRANSLATION TBL
$CALL TABSRC ;[134]TRANSLATE THE MESSAGE CODE
;**;[144]At SNDC.2:+9L change 1 line JYCW Oct-18-88
JUMPF [MOVX S2,NEB%MS ;[144]GET NEBULA BIT
IORM S1,S2 ;[144]set it in the message code
JRST .+1] ;[144]continue
STORE S2,.MSTYP(MO),MS.TYP ;[134]PLACE THE CODE IN THE MESSAGE
MOVX S1,MF.NEB ;[134]PICK UP THE NEBULA BIT
CAIN S2,.NTMTS ;[134]IS THIS A MOUNT MESSAGE?
MOVX S1,MF.NEB!MF.WTO ;[134]YES, TURN ON THE WTO EXPECTED BIT
IORM S1,.MSFLG(MO) ;[134]INDICATE IN THE MESSAGE
$CALL SNDNEB ;[130]SEND THE MESSAGE TO NEBULA
JUMPF .POPJ ;[130]LET COMMAN RELEASE THE PAGE
SKIPE G$FERR ;[130]ERROR SENDING THE FIRST MESSAGE?
$RET ;[130]NO, RETURN TRUE
MOVEM MO,G$OUTP ;[130]INDICATE DON'T RELEASE MSG PAGE
$RETF ;[130]INDICATE AN ERROR OCCURRED
SUBTTL Q$DISM Process DISMOUNT command (TOPS20)
Q$DISM::
MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
CAIE S1,.KYSTR ;IS IT A STRUCTURE
JRST DISM.1 ;NO..TRY TAPE
$CALL PSTRUC ;PROCESS THE STRUCTURE
$RETIF ;NOT A STR OR A TAPE, QUIT
$CALL P$KEYW ;Look for optional KEYWORD
JUMPF CMDEND ;None there, return
SETZ S2, ;Clear word to set flags
CAIN S1,.KYREM ;Is it for removal?
MOVX S2,.DMRMV ;Yes, set the bit
CAIN S1,.KYNRM ;Is it for no removal?
MOVX S2,.DMNRV ;Yes, set the bit
IORM S2,.OFLAG(MO) ;SAVE THE FLAG BITS
JRST CMDEND ;Go finish up
DISM.1: CAIE S1,.KYTAP ;CHECK FOR A TAPE
$RETF ;NO..RETURN FALSE
MOVEI S1,.ODUNL ;GET THE UNLOAD TYPE
STORE S1,.MSTYP(MO),MS.TYP ;RESET THE MESSAGE TYPE
JRST UNLO.1 ;PROCESS THE UNLOAD
SUBTTL Q$RECO Process RECOGNIZE command (TOPS10)
SUBTTL Q$UNLO Process UNLOAD command
TOPS10 <
Q$RECO::
>;END TOPS10
Q$UNLO::MOVE S1,G$HOST ;Get local host name
$CALL OPRENB
$RETIF
UNLO.1: $CALL PSTAPE ;SAVE THE TAPE BLOCK
JUMPT CMDEND ;O.K... FINISH OFF COMMAND
$RET ;PASS THE ERROR BACK
SUBTTL Q$ESTR Process ENABLE AUTOMATIC-STRUCTURE-RECOGNITION
Q$ESTR::
MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
MOVX S1,.ODENA ;GET ENABLE CODE
SKIPE P1 ;CHECK IF ENABLE OR DISABLE
MOVX S1,.ODDIS ;GET DISABLE CODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN MESSAGE
MOVX S1,.ASREC ;GET ASR TYPE
MOVEI S2,1 ;GET THE LENGTH
$CALL ARGRTN ;ADD ARGUMENT TO MESSAGE
$CALL P$KEYW ;GET A KEYWORD
JUMPF CMDEND ;NO...CHECK END AND SEND
CAIN S1,.KYSTR ;WAS IT FOR ALL STRUCTURES
JRST ESTR.1 ;YES SETUP FOR ALL STRUCTURES
$CALL PSTRUC ;PROCESS A STRUCTURE BLOCK
JUMPT CMDEND ;O.K.. FINISH AND SEND
$RET ;ELSE RETURN WITH CURRENT FALSE STATE
ESTR.1: MOVX S1,.ALSTR ;ALL STRUCTURES
MOVEI S2,1 ;LENGTH OF BLOCK
$CALL ARGRTN ;BUILD THE ARGUMENT
PJRST CMDEND ;FINISH OFF COMMAND
SUBTTL Q$ETAP Process ENABLE TAPE command
SUBTTL Q$DTAP Process DISABLE TAPE command
;THIS ROUTINE WILL HANDLE ENABLE AND DISABLE TAPE COMMANDS
Q$DTAP::
Q$ETAP::MOVE S1,G$HOST ;Get local node
$CALL OPRENB ;Check OPR privs
$RETIF
MOVX S1,.ODENA ;GET ENABLE CODE
SKIPE P1 ;CHECK IF ENABLE OR DISABLE
MOVX S1,.ODDIS ;GET DISABLE CODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN MESSAGE
MOVX S1,.AVREC ;GET AVR TYPE
MOVEI S2,1 ;GET THE LENGTH
$CALL ARGRTN ;ADD ARGUMENT TO MESSAGE
$CALL P$KEYW ;GET A KEYWORD
CAIN S1,.KYTAP ;WAS IT FOR ALL TAPES
JRST ETAP.1 ;YES SETUP FOR ALL TAPES
CAIN S1,.KYDSK ;ALL DISKS
JRST ETAP.3 ;YES.. ALL DISKS
$CALL PSTAPE ;PROCESS A TAPE BLOCK
JUMPT CMDEND ;O.K.. SEND AND RETURN
SETZM G$ERR ;CLEAR THE ERROR WORD
$CALL P$PREV ;POSITION TO PREVIOUS
$CALL PSTRUC ;PROCESS STRUCTURE BLOCK
JUMPT CMDEND ;O.K.. SEND AND RETURN
$RET ;PASS FALSE BACK
ETAP.1: MOVX S1,.ALTAP ;ALL TAPES
ETAP.2: MOVEI S2,1 ;LENGTH OF BLOCK
$CALL ARGRTN ;BUILD THE ARGUMENT
PJRST CMDEND ;FINISH OFF COMMAND
ETAP.3: MOVX S1,.ALDSK ;GET ALL STRUCTURES
PJRST ETAP.2 ;FINISH AND RETURN
SUBTTL Q$LOCK Process LOCK command
SUBTTL Q$ULOC Process UNLOCK command
;THIS COMMAND WILL LOCK A STRUCTURE FROM FURTHER ACCESS
;NOW OR OPTIONALLY AT A SPECIFIED TIME
;THE MESSAGE TYPE DISTINGUISHES LOCK FROM UNLOCK
Q$LOCK::
Q$ULOC::
MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL PSTRUC ;GET THE STRUCTURE
$RETIF ;INVALID COMMAND
$CALL P$TIME ;GET THE TIME
MOVEM S1,ARG.DA(P3) ;SAVE THE UDT
MOVX S1,.ORTIM ;TIME BLOCK
MOVEI S2,ARG.SZ ;GET THE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
$CALL P$SWIT ;GET OPTIONAL SWITCH
JUMPF CMDEND ;NONE,,END IT !!!
CAXE S1,.SWNUL ;WAS IT NO-UNLOAD ???
$RETF ;NO,,THATS AN ERROR
MOVX S1,LC.NUL ;GET THE NO UNLOAD STATUS
MOVEM S1,.OFLAG(MO) ;SAVE IT
PJRST CMDEND ;END THE MSG
SUBTTL Q$MOUN Process MOUNT TAPE and DISK command
;THIS COMMAND WILL BUILD MESSAGE FOR MOUNTING STRUCTURES
TOPS10<
Q$MOUNT::
MOVE S1,G$HOST ;Get local host name
$CALL OPRENB
$RETIF
$CALL P$KEYW ;CHECK FOR A KEYWORD
$RETIF ;NO..INVALID COMMAND
CAIE S1,.KYSTR ;IS IT A STRUCTURE
$RETF ;NO..INVALID COMMAND
$CALL PSTRUC ;PROCESS THE STRUCTURE
$RETIF ;ERROR..RETURN
$CALL P$DEV ;CHECK FOR ALIAS NAME
JUMPF MOUN.1 ;ISN'T ONE, TRY FOR A SWITCH
MOVX T1,.STALS ;STRUCTURE ALIAS
STORE T1,ARG.HD(S1),AR.TYP ;SAVE CODE IN BLOCK
$CALL MOVARG ;MOVE THE BLOCK
MOUN.1: PUSHJ P,P$SWIT ;TRY TO PARSE A SWITCH
JUMPF CMDEND ;CAN'T
SETZ S2, ;DEFAULT TO NO SWITCH
CAIN S1,.SWWLK ;WAS IT /WRITE-LOCKED?
MOVX S2,.MTWLK ;YES
JUMPE S2,.RETF ;ERROR IF NO SWITCH SPECIFIED
IORM S2,.OFLAG(MO) ;SAVE THE FLAG BITS
PJRST CMDEND ;CHECK FOR END..AND SEND TO QUASAR
>;END TOPS10
Q$MOUNT::
MOVE S1,G$HOST ;Get local host name
$CALL OPRENB
$RETIF
$CALL P$KEYW ;CHECK FOR A KEYWORD
$RETIF ;NO..INVALID COMMAND
CAIE S1,.KYSTR ;IS IT A STRUCTURE
$RETF ;NO..INVALID COMMAND
$CALL P$DEV ;GET THE DEVICE
$RETIF ;ERROR..RETURN
MOVX T1,.STALS ;STRUCTURE ALIAS
STORE T1,ARG.HD(S1),AR.TYP ;SAVE CODE IN BLOCK
$CALL MOVARG ;MOVE THE BLOCK
PUSHJ P,P$SWIT ;TRY TO PARSE A SWITCH
JUMPF CMDEND ;CAN'T
$CALL CHCLUN ;[133]CHECK FOR CLUSTER NODE SWITCH
JUMPT CLUN.1 ;[133]GO SEND THE MSG IF CLUSTER SWITCH
SETZ S2, ;DEFAULT TO NO SWITCH
CAIN S1,.SWSID ;WAS IT /STRUCTURE-ID
MOVX S2,.MTSID ;YES
JUMPE S2,.RETF ;ERROR IF NO SWITCH SPECIFIED
IORM S2,.OFLAG(MO) ;SAVE THE FLAG BITS
$CALL P$DEV ;CHECK FOR STRUCTURE NAME
JUMPF MOUN.1 ;ISN'T ONE,ALL DONE
MOVX T1,.STRDV ;STRUCTURE NAME
STORE T1,ARG.HD(S1),AR.TYP ;SAVE CODE IN BLOCK
$CALL MOVARG ;MOVE THE BLOCK
MOUN.1: PJRST CLUNOD ;[133]CHECK FOR A /CLUSTER-NODE SWITCH
SUBTTL Q$IDEN Process IDENTIFY command
;THIS COMMAND WILL IDENTIFY A TAPE DRIVE WITH A PARTICULAR TAPE
;REQUEST OR TAPE VOLUME
Q$IDENTIFY::
MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL PSDEVI ;SAVE THE DEVICE BLOCK
$RETIF ;ERROR..RETURN
$CALL P$KEYW ;CHECK FOR A KEYWORD
$RETIF ;NO..ERROR..RETURN
MOVEI S2,IDNDSP ;USE THE DISPATCH
$CALL TABSRC ;CHECK THE TABLE
$RETIF ;ERROR..RETURN
PJRST (S2) ;DO THE WORK
IDNDSP: $STAB
.KYRQN,,IDNRQN ;REQUEST NUMBER
.KYSCR,,IDNSCR ;SCRATCH TAPE
.KYVID,,IDNVID ;VOLUME-ID
$ETAB
; VOLUME-ID FOR IDENTIFY
IDNVID: $CALL PVOLID ;PROCESS VOLUME ID
JUMPT CMDEND ;O.K.. FINISH OFF MESSAGE
$RET ;ERROR.. PASS CODE UP
; REQUEST NUMBER FOR IDENTIFY
IDNRQN: $CALL PREQNM ;PROCESS REQUEST NUMBER
$RETIF ;ERROR..RETURN
PJRST CMDEND ;FINISH OFF COMMAND
; SCRATCH FOR IDENTIFY
IDNSCR: MOVEI S1,.SCRTP ;SCRATCH TAPE
MOVEI S2,1 ;ONE WORD BLOCK
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH OFF THE COMMAND
SUBTTL Q$DEFI Process DEFINE command (DN60)
;THIS COMMAND WILL DEFINE A DN60 NODE SO THAT PARAMETERS CAN BE SET
IFN FTDN60,<
Q$DEFINE::
MOVE S1,G$HOST ;Get host name
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
CAIE S1,.KYNOD ;BETTER BE NODE
$RETF ;NO..RETURN FALSE
$CALL P$NODE ;GET A NODE
$RETIF ;ERROR RETURN
$CALL SAVNOD ;SAVE THE NODE
$CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
SETZ T1, ;SET A FLAG
CAIN S1,.KY278 ;WAS IT 2780
MOVX T1,DF.278 ;2780
CAIN S1,.KY378 ;WAS IT 3780
MOVX T1,DF.378 ;3780
CAIN S1,.KYHSP ;WAS IT HASP
MOVX T1,DF.HSP ;HASP
CAIN S1,.KYSNA ;Was it SNA
MOVX T1,DF.SNA ;SNA
JUMPE T1,.RETF ;ERROR..RETURN FALSE
STORE T1,DEF.TY(P3),DF.TPP ;Save the type
CAIN S1,.KYSNA ;Was it SNA
JRST DEFI.3 ;Yes, skip E/T processing
$CALL P$SWIT ;Get the switch for signon/no- required
SETZ T1, ;Start at none
JUMPF DEFI.1 ;And we have none
CAIN S1,.SWNSN ;Is no signon required?
MOVX T1,DF.NSN ;Yes, remember it
CAIN S1,.SWSON ;Is signon required?
MOVX T1,DF.SON ;Yes, remember it
DEFI.1: STORE T1,DEF.TY(P3),DF.FLG ;Save it in any case
$CALL P$KEYW ;GET MODE KEYWORD
$RETIF ;ERROR..RETURN
SETZ T1, ;SET THE FLAG
CAIN S1,.KYTRM ;WAS IT TERMINATION
MOVX T1,DF.TRM ;TERMINATION
CAIN S1,.KYEMU ;WAS IT EMULATION
MOVX T1,DF.EMU ;EMULATION
JUMPE T1,.RETF ;ZERO..ERROR..RETURN
MOVEM T1,DEF.MD(P3) ;SAVE THE MODE
$CALL P$NUM ;GET THE PORT NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,DEF.PT(P3) ;SAVE THE PORT NUMBER
$CALL P$NUM ;GET THE LINE NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,DEF.LN(P3) ;SAVE THE LINE NUMBER
DEFI.2: MOVX S1,.DFBLK ;DEFINE BLOCK
MOVEI S2,DEF.SZ ;DEFINE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH COMMAND AND SEND IT
DEFI.3: ;Here when processing SNA type node
SETZ T1, ;Zero the Emulation/Termination fields
STORE T1,DEF.TY(P3),DF.FLG ;SIGNON flag
MOVEM T1,DEF.MD(P3) ;The mode
MOVEM T1,DEF.PT(P3) ;The port number
MOVEM T1,DEF.LN(P3) ;The line number
DEFI.4: $CALL P$KEYW ;Get a keyword
JUMPF DEFI.2 ;Not a keyword, try to finish up
CAIN S1,.KYGWY ;Was it GATEWAY?
JRST DEFI.5 ;Yes, go process it
CAIE S1,.KYACC ;Was it ACCESS-NAME?
JRST .RETF ;No, error
$CALL P$FLD ;Get the Access Name
HRLI S1,1(S1) ;Start of text
HRRI S1,DEF.AN(P3) ;Where to save it
CAILE S2,4 ;Don't take more than 3 words of data
JRST .RETF ;Error if longer
ADDI S2,DEF.AN-2(P3) ;Last word of destination block
BLT S1,(S2) ;Save the access name
JRST DEFI.4 ;Loop for another keyword
DEFI.5: ;Here to process GATEWAY
$CALL P$NODE ;Get a node
$RETIF ;Error, return
MOVEM S1,DEF.GW(P3) ;Save the Gateway Node
JRST DEFI.4 ;Loop for more
>;END FTDN60
SUBTTL Q$SWIT Process SWITCH command (TOPS20)
;THIS COMMAND WILL SEND A MESSAGE TO MOUNTR (VIA QUASAR) TO
;SWITCH A GIVEN REQUEST TO ANOTHER VOLUME/DRIVE.
TOPS20 <
Q$SWITCH::
MOVE S1,G$HOST ;Get host name
$CALL OPRENB
$RETIF
$CALL PREQNM ;PROCESS A REQUEST NUMBER
$RETIF ;ERROR..RETURN
$CALL PVOLID ;PROCESS THE VOLUME ID
$RETIF ;ERROR..RETURN
$CALL PSTAPE ;PROCESS A TAPE BLOCK
PJRST CMDEND ;TRY TO FINISH COMMAND IN ANY CASE
>;END TOPS20
SUBTTL Q$MODS Process MODIFY SYSTEM-LISTS command (TOPS10)
;These routine are responsible for decoding the parse blocks
;Returned on a MODIFY <system-lists> command
;Call -
; S1/ Current keyword in parse
Q$MODS:
TOPS20< $RETF > ;ONLY FOR THE -10
TOPS10<
$CALL CNVLST ;CONVERT TO EXTERNAL FORM, ADD TO MESSAGE
$RETIF ;CAN'T, SO QUIT
MOVE S1,G$HOST ;Get local node
$CALL OPRENB ;Check OPrR privs
$RETIF
MOVX S1,.ODCSL ;NEW MESSAGE TYPE - CHANGE SYSTEM LISTS
STORE S1,.MSTYP(MO),MS.TYP ;SET IT
$CALL P$KEYW ;GET THE INCLUDE/EXCLUDE
JUMPF E$IFC ;CAN'T, SO QUIT
SETO S2, ;SAY NO MATCH SO FAR
CAIN S1,.KYINC ;IS IT INCLUDE?
SETZ S2, ;YES, CLEAR THE BIT
CAIN S1,.KYEXC ;IS IT EXCLUDE?
MOVEI S2,1 ;YES, GET ONE BIT
JUMPL S2,E$IFC ;BETTER BE ONE OF THOSE
STORE S2,.OFLAG(MO),AD.REM ;LITE BIT IF APPROP. IN FLAGS
$CALL PSTRUC ;GET THE DEVICE (STR OR UNI) NAME
$RETIF ;NOT A STR NEXT, STRANGE
PJRST CMDEND ;FINISH THE COMMAND
;THIS ROUTINE CONVERTS A LIST DESCRIPTOR KEYWORD INTO A
; BLOCK IN THE MESSAGE WITH THE EXTERNAL DESCRIPTOR
;CALL -
; S1/ .KYXXX KEYWORD SYMBOL
;RETURNS -
; TRUE, WITH A 2-WORD BLOCK TACKED ON TO THE MESSAGE
; FALSE - IF THE KEYWORD DIDN'T MATCH ANY KNOW KEYWORD
CNVLST: MOVEI S2,CLSTTB ;POINT TO THE MAPPING TABLE
$CALL TABSRC ;FIND THE CORRECT LIST HANDLE
JUMPF E$IFC ;VERY STRANGE
MOVEI S1,.SLSTY ;BLOCK TYPE - LIST DESCRIPTOR
MOVE TF,S2 ;COPY THE CONVERTED LIST TYPE
SETZ S2, ;CLEAR THE DATA WORD
STORE TF,S2,SL.TCD ;STASH IN PROPER PLACE
PJRST MOVAR2 ;ADD A 2-WORD ARG BLOCK
CLSTTB: $STAB
.KYSSL,,SL.SSL ;MAP FOR SYSTEM SEARCH LIST
.KYCDL,,SL.CDL ;MAP FOR SYSTEM DUMP LIST
.KYASL,,SL.ASL ;MAP FOR ACTIVE SWAP LIST
$ETAB
>;END TOPS10
SUBTTL Q$SLST Process SHOW SYSTEM-LISTS command (TOPS10)
;THIS ROUTINE PROCESSES THE SHOW SYSTEM LIST MESSAGE AND
; ANY ATTACHED BLOCKS
TOPS10<
Q$SLST::
MOVEI S1,.ODSSL ;MESSAGE TYPE IS NOW SHOW SYS
STORE S1,.MSTYP(MO),MS.TYP ;CHANGE IT
SLST.1: $CALL P$KEYW ;IS THERE A KEYWORD?
JUMPF CMDEND ;NO, BETTER BE CONFIRM
$CALL CNVLST ;YES, CONVERT AND ADD TO MSG
JRST SLST.1 ;TRY FOR ANOTHER
>;END TOPS10
SUBTTL Q$SALC Process SHOW ALLOCATION command (TOPS10)
TOPS10<
Q$SALC::
MOVEI S1,.ODSAL ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE IN THE OUTGOING MESSAGE
$SAVE <P1> ;SOME WORK SPACE
$CALL P$KEYW ;GET THE DESCRIPTOR
JUMPF E$IFC ;WHOOPS!
MOVX P1,.ORJNU ;ASSUME JOB NUMBER
CAIN S1,.KYBRQ ;IS IT ANYTHING OTHER THAN BATCH REQ?
MOVX P1,.ORREQ ;BATCH REQUEST. SAVE BLOCK TYPE
CAIN S1,.KYALL ;WAS IT 'ALL-REQUESTS'?
JRST SALC.1 ;AND DON'T EXPECT A NUMBER
$CALL P$NUM ;GET THE JOB OR REQUEST NUMBER
SKIPT ;WAS THERE A NUMBER?
SALC.1: SETOM S1 ;NO, SAY -1 FOR JOB NUMBER
MOVE S2,S1 ;DATA WORD - JOB OR REQUEST NUMBER
MOVE S1,P1 ;BLOCK TYPE - FROM KEYWORD
$CALL MOVAR2 ;ADD THE TWO WORDS
PJRST CMDEND ;AND FINISH UP
>;END TOPS10
SUBTTL Q$UNDE Process undefine command
Q$UNDE:: MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF ;Must have at least host privs.
$CALL P$KEYW ;Get the next keyword
$RETIF ;Must have the next keyword
CAIE S1,.KYSTR ;Is it structure?
$RETIF ;No, bad keyword
MOVX S1,.ODUDS ;Get the message type
STORE S1,.MSTYP(MO),MS.TYP ;Save the type in the header
$CALL PSTRUC ;Process a structure block
$RETIF ;Quit if bad
PJRST CMDEND ;Check for end and send to QUASAR
END