Trailing-Edge
-
PDP-10 Archives
-
bb-l014y-bm_tops20_v7_0_tsu02_1_of_2
-
galsrc/oprqsr.mac
There are 40 other files named oprqsr.mac 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==:145 ;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.
145 6.1285 5-October-89
When checking if a CANCEL MOUNT or ABORT message should be sent
locally or remotely, use the SKIPE instruction rather than the SKIP instruction
so that messages to be sent locally will not be forwarded to NEBULA.
\ ;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
;**;[145]At Q$STA:+2L change 1 line JCR 10/5/89
SKIPE G$CLUN ;[145]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
;**;[145]At ABOR.3:+8L change 1 line JCR 10/5/89
SKIPE G$CLUN ;[145]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
;**;[145]At CANC.2:+7L change 1 line JCR 10/5/89
SKIPE G$CLUN ;[145]]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