Trailing-Edge
-
PDP-10 Archives
-
BB-PENEA-BM_1990
-
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]
SEARCH MACSYM ;[161]
PROLOG(OPRQSR)
ERRSET ;INITIALIZE ERROR TABLES
PARSET ;SETUP PARSER ENTRIES
;Version numbers
QSRMAN==:162 ;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
;**;[160]At EXTERNAL G$NOFG +1L add 3 lines PMM 6/3/90
EXTERNAL SNDAOP ;[160]Send to all OPRS
EXTERNAL FASNEB ;[160]Send to NEBULA
EXTERNAL W$NODE ;[160]Find node
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]
;**;[160]At $DATA OBJTYP:+1L replace 1 line with 7 lines PMM 6/3/90
$DATA OBTYPE,1 ;[160]Type of object in message
$GDATA HDRAKA,1 ;[160]Alias linked list header
$GDATA AKAOBJ,OBJ.SQ+10 ;[160]Object block storage for DEFAKA
$GDATA RELBLK,1 ;[160]Designates that null RESPONSE
;[160]to DEFINE ALIAS Command is
;[160]being sent.
$DATA REMLPT ;[160]Indicates message is from NEBULA
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.
146 6.1289 29-November-89
Make routine SNDCLU global.
147 6.1294 23-December-89
Set bit .RMLPT only if a /NODE switch has been specified, the
message is being sent remotely, and the object type is not all (i.e., not
"-1"). Also, set flag G$NOFG for all cases where a /NODE switch has been
specified in the SHOW STATUS and SHOW PARAMETERS commands.
150 6.1296 25-December-89
Add support for the /NODE switch for the SHOW STATUS and SHOW
PARAMETERS dealing with local printers.
151 6.1297 31-December-89
Replace routine CHLUN with routine CMDEND.
152 6.1298 10-January-90
Create a common routine to build the object block so that the START
doesn't have to call the SHUTDOWN code to do the work. Change the SHUTDOWN
code to only process the shutdown command and not process any switches related
to the START command.
153 6.1300 12-January-90
Change the order of the /REASON and /CLUSTER-NODE switches in the
ABORT command so that it can be forwarded to the indicated remote node.
154 6.1301 15-January-90
Correctly set the MF.NEB bit in the .MSFLG word for the SHOW CLUSTER
command.
155 6.1303 16-January-90
Change routine Q$SWITCH to return an error after it detects an
invalid tape drive designator.
156 6.1305 19-January-90
Add /CLUSTER-NODE switch support to commands ALIGN, SUPPRESS and
ROUTE.
157 6.1306 31-January-90
Change the argument value of .CMUSR and .LSUSR blocks from the
login directory number to the login directory name. This is in support
of those commands that can specify a /USER or /OWNER switch and in
which a /CLUSTER-NODE switch has been specified whose node argument
has a different public structure than the local node.
160 6.1318 3-June-90
Add support for alias printers.
161 6.1317 8-June-90
Add support for /CLUSTER-NODE SEND and SET command
162 6.1321 13-July-90
Edit 161 did not handle the SET TAPE /CLUSTER command correctly.
\ ;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
;**;[152]At Q$SHUT Replace 23 lines with 15 lines JYCW 1/8/90
Q$SHUT:: $CALL STASHU ;[152]Process the first part
$RETIF ;[152]Bad command
JRST CMDEND ;[152]End the command
STASHU: $CALL BLDOBJ ;[152]BUILD THE OBJECT
$RETIT ;[152]All done
$CALL P$KEYW ;[152]CHECK FOR KEYWORD
JUMPF E$IFC ;[152]ERROR..RETURN
CAIE S1,.KYNOD ;[152]WAS IT A NODE
$RETF ;[152]BAD COMMAND
;**;[160]At STASHU:+5L change 1 line PMM 6/3/90
MOVE S1,OBTYPE ;[160]Pick up the object type
CAIN S1,.OTLPT ;[152]A PRINTER?
$RETF ;[152]YES, RETURN NOW
$CALL CNODSW ;[152]ADD THE NODE NAME TO THE MESSAGE
$RETIF ;[152]CAN'T
$RETT ;[152]All done
;**;[151]At SHUT0:+10L remove routine SHUT JCR 12/31/89
;**;[144]At SHUT0:+10L add routine SHUT: JYCW Oct-18-88
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.
;**;[152]At Q$STAR+0L modify 7 lines JYCW 1/8/90
Q$STAR::$CALL STASHU ;[152]Process the first part
$RETIF ;[152]Bad command
HRRZ S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[152]Get the object type
CAIE S1,.OTLPT ;[152]IS IT A PRINTER?
JRST CMDEND ;[152]No, end the command
;**;[160]At Q$STAR::+4L replace 1 line with 11 lines PMM 6/3/90
STAR.1: $CALL P$SWIT ;[160]Is there a switch?
JUMPF CMDEN1 ;[160]No, end the command
CAIE S1,.SWDEV ;[160]Was it /DEVICE?
JRST STAR.2 ;[160]No, how about /TERMINAL?
MOVE S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[160]Pick up the printer type
TXNE S1,.CLLPT ;[160]A Cluster printer?
PJRST E$ICD ;[160]Yes, /DEVICE is invalid
TXNE S1,.DQLPT ;[160]A DQS printer?
PJRST E$IQD ;[160]Yes, /DEVICE is invalid
TXNE S1,.LALPT ;[160]A LAT printer?
PJRST E$ILD ;[160]Yes, /DEVICE is invalid
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 CMDEN1 ;[151]No, go send the command
;**;[160]At STAR.1:+17L replace 2 lines with 7 lines PMM 6/3/90
STAR.2: CAIE S1,.SWTTC ;[160]Was it TTY characteristic?
JRST CMDEN ;[160]No, check for /CLUSTER-NODE
MOVE S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[160]Pick up the printer type
TXNE S1,.CLLPT ;[160]A Cluster printer?
PJRST E$ICT ;[160]Yes, /TERMINAL is invalid
TXNE S1,.DQLPT ;[160]A DQS printer?
PJRST E$IDT ;[160]Yes, /TERMINAL is invalid
$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
;**;[160]At STAR.2:+18L change 1 line PMM 6/3/90
JRST STAR.1 ;[160]Check for a /DEVICE switch
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
;**;[160]Replace 1 line with 8 lines at ARGRTN:+3L PMM 6/3/90
LOAD S1,ARG.HD(P3),AR.TYP ;[160]Get next block type
CAIE S1,.AKANM ;[160]Is next block an alias block?
$RETT ;[160]No, return true
LOAD S1,ARG.HD(P3),AR.LEN ;[160]Get next block length
AOS .OARGC(MO) ;[160]Bump argument count
ADD P3,S1 ;[160]Bump to next location
$RETT ;[160]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]At CMDEND:+0L add 9 lines JYCW Oct-18-88
;[144]Since the /CLUSTER-NODE switch is the last switch, check for that before
;[144]checking for CONFIRM. This way we don't have to change all the routines
;[144]to check for /CLUSTER-NODE.
;**;[151]At CMDEND:-1L replace 9 lines with 14 lines JCR 12/31/89
;[151]Redefine entry point CMDEN and add entry point CMDEN0.
;[151]CMDEND is called when either a /CLUSTER-NODE switch or a confirm
;[151] is possible.
;[151]CMDEN is called when either a /CLUSTER-NODE switch or another type
;[151] of switch is possible followed by a confirm and in which the
;[151] /CLUSTER-NODE switch has been detected.
;[151]CMDEN0 is called when a /CLUSTER-NODE switch has been detected but it
;[151] is not the last switch in the command.
CMDEND: $CALL P$SWIT ;[151]Is there a /CLUSTER-NODE switch?
JUMPF CMDEN1 ;[151]No, check for a confirm block
CMDEN: $CALL CHCLUN ;[151]Pick up the /CLUSTER-NODE value
$RETIF ;[151]Quit on an error
CMDEN0: SKIPE G$CLUN ;[151]Remote or all nodes specified?
PJRST SNDCLU ;[144]YES, SEND THE MESSAGE TO NEBULA
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
;**;[160]At BLDOBJ:+1L change 1 line PMM 6/3/90
MOVEM S1,OBTYPE ;[160]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
;**;[150]At FINOBJ:+1L replace 16 lines with 34 lines JCR 12/25/89
JUMPT FINO.4 ;[150]Go check for a valid number
CAIE P1,.OTLPT ;[150]Is this a LPT object?
$RET ;[150]No, preserve the error AC
$CALL P$KEYW ;[150]Pick up the printer type
;**;[160]At FINOBJ:+7L add 2 lines PMM 6/3/90
CAIN S1,.AKANM ;[160]Is this an alias name?
PJRST LPTTYP ;[160]Go process it
$RETIF ;[150]Illegally formatted command
CAIE S1,.KYLOC ;[150]Is this a local LPT?
PJRST LPTTYP ;[150]No, process remote LPT
;[150]The LPT object is a local LPT (from SHOW STATUS or PARAMETER command)
MOVX S1,.LOLPT ;[150]Pick up the local LPT type
IORM S1,ARG.DA+OBJ.TY(P3) ;[150]Indicate in the message to QUASAR
$CALL P$NUM ;[150]Check for a unit number
JUMPF FINO.1 ;[150]Check for a node switch
$CALL FINNUM ;[150]Process the number
$RETIF ;[150]Return on an error
SKIPA ;[150]Don't reset the units
FINO.1: SETOM ARG.DA+OBJ.UN(P3) ;[150]Indicate all units
$CALL P$SWIT ;[150]Check for a switch
JUMPF FINO.3 ;[150]No switch, finish the block
CAIE S1,.SWNOD ;[150]A node switch?
JRST FINO.2 ;[150]Back up and check later
$CALL P$NODE ;[150]Pick up the node name
$RETIF ;[150]Return on an error
MOVE P1,S1 ;[150]Save the node data
SETOM G$NOFG ;[150]Indicate node switch present
PJRST BLDO.5 ;[150]Finish building the block
FINO.2: $CALL P$PREV ;[150]Back up a block
;**;[160]At FINO.3:+0L replace 2 lines with 7 lines PMM 6/3/90
FINO.3: MOVE S1,ARG.DA(P3) ;[160]Get address of object block
$CALL FINDPR ;[160]Does it have an alias?
JUMPF FIN.3A ;[160]No...
MOVE S1,OBJAKA(S2) ;[160]Yes, add it...
MOVEM S1,ARG.DA+OBJ.AK(P3) ;[160]...to message
FIN.3A: MOVEI S1,.OROBJ ;[160]Pick up block type
MOVEI S2,.OBJLN+LPTNLN ;[160]Pick up block size
PJRST ARGRTN ;[150]Finish building the block
FINO.4: $CALL FINNUM ;[150]Process the number block
$RETIF ;[150]Return on an error
$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
;**;[160]At BLDO.5:+3L add 3 lines PMM 6/3/90
HRRZ S1,ARG.DA+OBJ.TY(P3) ;[160]Pick up the object type
CAIN S1,.OTLPT ;[160]Is it a printer?
JRST BLDO5A ;[160]Yes, check for aliases
MOVX S1,.OROBJ ;TYPE OF DATA ELEMENT..OBJ BLOCK
MOVX S2,.OBJLN ;SIZE OF THE BLOCK
PJRST ARGRTN ;SETUP HEADER,COUNT, POINTER..RETT
;**;[160]At BLDO5A:+0L replace 5 lines with 20 PMM 6/3/90
BLDO5A: LOAD S1,ARG.DA+OBJ.UN(P3),OU.HRG ;[160]Get the high range
SKIPE S1 ;[160]Is it a range?
JRST BLDO5B ;[160]Yes, get all aliases
MOVEI S1,AKBSIZ ;[160]Get object length
STORE S1,ARG.HD(P3),AR.LEN ;[160]Save in object block header
MOVEI S1,ARG.DA+OBJ.TY(P3) ;[160]Get address of object block
$CALL FINDPR ;[160]Does it have an alias mapping?
JUMPF BLDO5C ;[160]No...
MOVE S1,OBJAKA(S2) ;[160]Yes, get the alias...
MOVEM S1,ARG.DA+OBJ.AK(P3) ;[160]...and add to message
SKIPA ;[160]Don't get all aliases
BLDO5B: $CALL RANGAK ;[160]Yes get all aliases
BLDO5C: MOVEI S1,.OROBJ ;[160]Pick up the block type
STORE S1,ARG.HD(P3),AR.TYP ;[160]...and add to message
LOAD S2,ARG.HD(P3),AR.LEN ;[160]Get argument length
SKIPN S2 ;[160]Is argument length established?
MOVEI S2,.OBJLN ;[160]No, add size of block
$CALL ARGRTN ;[160]Setup header, count, pointer
$RETT ;[160]Return true
BLDO.6: $CALL P$PREV ;POSITION TO THE PREVIOUS ONE
$RETF ;RETURN FALSE
;**;[150]At BLDO.6:+1L add routine FINNUM JCR 12/25/89
SUBTTL FINNUM Parse A Number Block
;[150]FINNUM is called when parsing the number block of an object specified
;[150]in a message from OPR
;[150]
;[150]Call is: S1/Number returned by P$NUM
;[150] P3/Address of message object block that is being built
;[150]Returns true: The number block has been successfully parsed and placed
;[150] in the outgoing IPCF message
;[150]Returns false: Illegal number or illegally formatted message
;[150]Modifies: P1
FINNUM::TLNE S1,-1 ;[150]Ligit number? (Fit in half word)
PJRST E$IRS ;[150]No - fake user with illeg. range
STORE S1,ARG.DA+OBJ.UN(P3),OU.LRG ;[150]Save as low range
MOVE P1,S1 ;[150]Save the low range
$CALL P$TOK ;[150]Check for token and range
JUMPF .RETT ;[150]If no token, return success
;[150]Ignore the token, check for a high range number
$CALL P$NUM ;[150]Pick up the high range number
$RETIF ;[150]Illegally formatted message
CAML P1,S1 ;[150]Check for valid range
PJRST E$IRS ;UNITS OUT OF RANGE
TLNE S1,-1 ;[150]Ligit number? (Fit in half word)
PJRST E$IRS ;[150]No - fake user with illeg. range
STORE S1,ARG.DA+OBJ.UN(P3),OU.HRG ;[150]Save the high range
$RETT ;[150]Indicate success
SUBTTL LPTTYP Process a LPT object
;**;[125]ROUTINE LPTTYP IS ADDED AS PART OF THIS EDIT
;CHECK THE TYPE OF LPT
;**;[150]At LPTTYP:+0L replace 37 lines with 10 lines JCR 12/25/89
;**;[160]At LPTTYP:+0L add two lines PMM 6/3/90
LPTTYP: CAIN S1,.AKANM ;[160]Is this an alias name?
JRST LPTTY7 ;[160]Yes, go process
CAIN S1,.KYDQS ;[150]Is this a DQS LPT?
JRST LPTTY3 ;[150]Yes, go process
CAIN S1,.KYLAT ;[150]Is this a LAT LPT?
JRST LPTTY4 ;[150]Yes, go process
CAIE S1,.KYCLU ;[150]Is this a cluster LPT?
$RETF ;[150]No, illegally formatted message
;THE LPT OBJECT IS A CLUSTER LPT
MOVX S1,.CLLPT ;[150]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: MOVE P1,P3 ;[160]Save the object block address
$CALL NOSNAM ;PICK UP THE NODE NAME
;**;[160]At LPTTY2:+1L replace 3 lines with 32 lines PMM 6/3/90
$RETIF ;[160]Return, if problem
LOAD S1,ARG.DA+OBJ.UN(P1),OU.HRG ;[160]Get the high range
SKIPE S1 ;[160]Is there a range?
JRST LPTT2B ;[160]Yes, check for a range of aliases
MOVE S1,P1 ;[160]Get address of object block
AOS S1 ;[160]Bump past header
$CALL FINDPR ;[160]Does it have an alias mapping?
JUMPF LPTT2A ;[160]No, return
MOVE S1,OBJAKA(S2) ;[160]Get alias name
MOVEM S1,ARG.DA+OBJ.AK(P1) ;[160]Yes, add to message
LPTT2A: MOVEI S1,AKBSIZ ;[160]Get size of object block
HRLM S1,ARG.HD(P1) ;[160]Save in message
ADDI P1,AKBSIZ ;[160]Get address of next argument
MOVE P3,P1 ;[160]Save for later use
$RETT ;[160]Return true
LPTT2B: MOVE P3,P1 ;[160]Point at object block
$CALL RANGAK ;[160]Yes, get all alias names
$RETT ;[160]Return
;[160]The object is a DQS LPT
LPTTY3: MOVX S2,.DQLPT ;[160]Pick up the DQS LPT bit
IORM S2,ARG.DA+OBJ.TY(P3) ;[160]Indicate in the type field
MOVEI P1,ARG.DA+OBJ.TY(P3) ;[160]Save object block address
$CALL BLDBLK ;[160]Fill in rest of the object
$RETIF ;[160]Return if problem
MOVE S1,P1 ;[160]Get address of object block
$CALL FINDPR ;[160]Does it have an alias mapping?
JUMPF LPTT3A ;[160]No, return
MOVE S1,OBJAKA(S2) ;[160]Get alias name
MOVEM S1,OBJ.AK(P1) ;[160]Add to message
LPTT3A: $RETT ;[160]Return true
;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
MOVEI P1,ARG.DA+OBJ.TY(P3) ;SAVE OBJECT BLOCK ADDRESS
$CALL BLDBLK ;FILL IN REST OF THE OBJECT
;**;[160]At LPTTY4:+7L add 7 lines PMM 6/3/90
$RETIF ;[160]Return if problem
MOVE S1,P1 ;[160]Get address of object block
$CALL FINDPR ;[160]Does it have an alias mapping?
JUMPF LPTT.4 ;[160]No, return
MOVE S1,OBJAKA(S2) ;[160]Yes, get alias name
MOVEM S1,OBJ.AK(P1) ;[160]Add to message
LPTT.4: $RETT ;[160]Return true
;Here to check for an alias mapping to the printer specificaton
;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
;**;[160]At LPTTY5:+0L replace 2 lines with 7 lines PMM 6/3/90
LPTTY6: MOVE S1,ARG.DA+OBJ.TY(P3) ;[160]Get address of object block
$CALL FINDPR ;[160]Does it have an alias?
JUMPF LPTT6A ;[160]Skip if no alias
MOVE S1,OBJAKA(S2) ;[160]Get alias name
MOVEM S1,ARG.DA+OBJ.AK(P3) ;[160]Update alias name in message
LPTT6A: MOVEI S1,.OROBJ ;[160]Pick up the object descriptor adr
MOVEI S2,.OBJLN+LPTNLN ;[160]Pick up the object descriptor len
$CALL ARGRTN ;[127]UPDATE THE BLOCK TYPE/LENGTH
$RET ;[127]RETURN PRESERVING TRUE/FALSE FLAG
;**;[160]At LPTT6A:+3L add 24 lines and routine RANGAK PMM 6/3/90
;[160]Here to process an alias name
INTERN LPTTY7 ;[160]Make it global
LPTTY7: $CALL P$CURR ;[160]Pick up the alias header
$CALL P$NEXT ;[160]Point at alias name block
AOS S1 ;[160]Point at the SIXBIT alias
MOVE S1,(S1) ;[160]Get SIXBIT alias name
$CALL FINDAK ;[160]Find address of mapped entry
$RETIF ;[160]Problem, alias not found
AOS S2 ;[160]Point at object block
HRLI S1,(S2) ;[160]Source address,,x
HRRI S1,ARG.DA+OBJ.TY(P3) ;[160]Source,,destination
BLT S1,ARG.DA+OBJ.AK(P3) ;[160]Move the object block
MOVEI S1,.OROBJ ;[160]Pick up the object descriptor adr
MOVEI S2,.OBJLN+LPTNLN ;[160]Pick up the printer length
MOVE P1,P3 ;[160]Save address of object block
$CALL ARGRTN ;[160]Update the block type/length
MOVE S2,OBJ.TY+ARG.DA(P1) ;[160]Get object type
TXNN S2,.DQLPT!.LALPT!.CLLPT ;[160]A DQS, LAT or Cluster printer?
SETOM G$NOFG ;[160]No, indicate to the remote ORION
;[160] not to change the node name
TXNN S2,.DQLPT!.LALPT ;[160]Is this a LAT or DQS printer?
$RETT ;[160]No, return now
MOVEI S2,.OBJLN ;[160]Get object descriptor length
STORE S2,ARG.HD(P1),AR.LEN ;[160]Store in message
AOS .OARGC(MO) ;[160]Bump argument count
ADDI P1,.OBJLN ;[160]Point to the name block
MOVEI S2,LPTNLN ;[160]Pick up its length
STORE S2,ARG.HD(P1),AR.LEN ;[160]Pick up its length
$RETT ;[160]Return
SUBTTL RANGAK Set Up Multiple Aliases For Range
;[160]RANGAK will include aliases for each printer specified by a
;[160]range.
;[160]Call is: S1/High range
;[160] P3/address of the printer object block
;[160]Returns False: There is no high range
;[160]Returns True: The alias name block is set up in the outgoing message
RANGAB:: SETOM REMLPT ;[160]Indicate message from NEBULA
SKIPA ;[160]Don't reset the flag
RANGAK: SETZM REMLPT ;[160]Indicate local
$SAVE <T1,T2,P1,P2> ;[160]Save these ACs
SKIPN S1 ;[160]Do we have a high range?
$RETF ;[160]No, return false
MOVEM S1,P1 ;[160]Save high range
LOAD T2,ARG.DA+OBJ.UN(P3),OU.LRG ;[160]Get the low range
MOVEM T2,P2 ;[160]Save low range
SETZM ARG.DA+OBJ.UN(P3) ;[160]Clear the unit numbers
MOVE T1,P3 ;[160]Get address of object block
MOVEI T3,OBJ.SZ+1 ;[160]Get length of object descriptor
STORE T3,ARG.HD(T1),AR.LEN ;[160]Store argument length in message
;[160]Get address of next available argument block in message.
;[160]The length not in yet.
ADD T1,T3 ;[160]Point at next argument
MOVEI S1,.OTLPT ;[160]Get printer type
HRRM S1,ARG.DA+OBJ.TY(P3) ;[160]Save in object block
MOVE S1,P3 ;[160]Get address of object block
SKIPN REMLPT ;[160]Is this a remote printer?
JRST RAN.G2 ;[160]No, don't bother
MOVE T3,ARG.DA+OBJ.TY(S1) ;[160]Get printer object type
TXZ T2,.RMLPT ;[160]Clear the remote printer bit
MOVEM T3,ARG.DA+OBJ.TY(S1) ;[160]Save in object block
RAN.G2: AOS S1 ;[160]Point at object block data
MOVE T3,P2 ;[160]Get low range
SETZM T2 ;[160]Initialize alias flag
SETZM OBJ.UN(S1) ;[160]Clear units in object block
RANG.1: AOS T1 ;[160]Get address for alias name
MOVEM T3,OBJ.UN(S1) ;[160]Store unit number in object block
$CALL FINDPR ;[160]Does this printer have an alias?
JUMPF RANG.2 ;[160]No, put in blank alias
MOVE S2,OBJAKA(S2) ;[160]Get alias name
SETOM T2 ;[160]Set alias flag
SKIPA
RANG.2: SETZM S2 ;[160]Zero out alias name
AOS T3 ;[160]Increment unit number
MOVEM S2,(T1) ;[160]Save in alias block
CAML P1,T3 ;[160]Have we reached the last unit?
JRST RANG.1 ;[160]No, check next printer
STORE P2,ARG.DA+OBJ.UN(P3),OU.LRG ;[160]Restore the low range
STORE P1,ARG.DA+OBJ.UN(P3),OU.HRG ;[160]Restore the high range
SKIPN REMLPT ;[160]Is this from a remote NEBULA?
JRST RANG.3 ;[160]No
MOVE S1,OBJ.TY+ARG.DA(P3) ;[160]Get object type
TXNE S1,.CLLPT ;[160]Is it a CLUSTER printer?
JRST RANG.3 ;[160]Yes, do not light .RMLPT bit
MOVX S1,.RMLPT ;[160]Pick up /NODE switch specified
IORM S1,ARG.DA+OBJ.TY(P3) ;[160]Indicate in the message type
RANG.3: LOAD T1,ARG.HD(P3),AR.LEN ;[160]Get the argument length
ADD T1,P3 ;[160]Point at next argument block
SUB P1,P2 ;[160]Get the range diffference
ADDI P1,2 ;[160]Get alias block length
STORE P1,ARG.HD(T1),AR.LEN ;[160]Save length in alias block
MOVEI T3,.AKANM ;[160]Get alias block header
STORE T3,ARG.HD(T1),AR.TYP ;[160]Save type in alias block
MOVE T1,ARG.DA+OBJ.TY(P3) ;[160]Get object type
TXNN T1,.CLLPT ;[160]Is this a CLUSTER printer?
JRST RANG.4 ;[160]No, return now
SKIPE REMLPT ;[160]Did message originate remotely?
JRST RANG.4 ;[160]Yes, return
AOS .OARGC(MO) ;[160]No, increment argument count
RAN.3A: LOAD S1,ARG.HD(P3),AR.LEN ;[160]Get argument length
SKIPN S1 ;[160]Is it a non-zero length?
JRST RANG.4 ;[160]No, return
ADD P3,S1 ;[160]Update current address of message
JRST RAN.3A ;[160]Loop back for next argument
RANG.4: SKIPN T2 ;[160]Were any aliases found?
$RETF ;[160]No, indicate so
$RETT ;[160]Yes, indicate so
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
;**;[160]At LPTOBJ:+8L replace 1 line with 5 lines PMM 6/3/90
HLLZ S1,OBJ.TY(T1) ;[160]Get printer type
TXNN S1,.LALPT ;[160]Is it a LAT printer?
SKIPN S1 ;[160]No, is it a local printer?
$RETT ;[160]Yes, to either
PJRST E$LOL ;[160]No, to either
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
;**;[156]At ALIG.2:+2L change 1 line JCR 1/19/90
JUMPF CMDEN ;[156]Check for a /CLUSTER-NODE switch
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
;**;[156]At Q$SUPP::+7L replace 3 lines with 11 lines JCR 1/19/90
JUMPT Q$SU.1 ;[156]Set up the block
$CALL CHCLUN ;[156]Check for a /CLUSTER-NODE switch
$RETIF ;[156]Not there, so an error
MOVEI S1,.SUPJB ;[156]Pick up JOB block type
SKIPA ;[156]Avoid changing the job block
Q$SU.1: MOVE S1,S2 ;[156]Place type in S1
MOVEI S2,1 ;[156]Length of argument in S2
$CALL ARGRTN ;[156]Save the argument
SKIPN G$CLUN ;[156]Cluster Node switch detected?
PJRST CMDEND ;[156]Not yet, finish the command
PJRST SNDCLU ;[156]Yes, go send 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
;**;[151]At ABOR.1:+1L change 1 line JCR 12/31/89
JUMPF CMDEN1 ;[151]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
;**;[153]At ABOR.2:+1L replace 13 lines with 9 lines JCR 1/12/90
JUMPF CMDEN1 ;[153]Error, check for end
ABOR.3: MOVEI S2,ABODSP ;[153]Abort table address
$CALL TABSRC ;[153]Search the table
JUMPT ABOR.4 ;[153]Success, process the switch
$CALL CHCLUN ;[153]Check for a /CLUSTER-NODE switch
JUMPF ABOR.5 ;[153]Check fo a /REASON switch
$CALL P$SWIT ;[153]Check for a switch
JUMPF CMDEN0 ;[153]If none, then send the message
JRST ABOR.5 ;[153]Process the /REASON switch
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
;**;[153]At ABOR.5:+0L replace 3 lines with 5 lines JCR 1/12/90
ABOR.5: CAIE S1,.SWRSN ;[153]A /REASON switch?
$RETF ;[153]No, illegally formatted message
$CALL PREASN ;[153]Process the /REASON switch
$RETIF ;[153]No, illegally formatted message
PJRST CMDEN0 ;[153]Send the message to QUASAR
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
;**;[157]At PUSER:+0L replace 14 lines with 14 lines JCR 1/31/90
PUSER: TDZA S1,S1 ;[157]User keyword entry
PUSERS: SETO S1, ;[157]User switch entry
MOVEM S1,G$2SCR## ;[157]Save for header
$CALL P$USER ;[157]Get the user data
$RETIF ;[157]Return on an error
MOVE S2,S1 ;[157]Place user number where expected
HRROI S1,ARG.DA(P3) ;[157]Where to place the user name
DIRST% ;[157]Map user number to user name
ERJMP .RETF ;[157]Quit on an error
MOVEI S2,EQNMSZ ;[157]Pick up the block size
MOVEI S1,.CMUSR ;[157]Assume user keyword
SKIPE G$2SCR## ;[157]Is it?
MOVEI S1,.LSUSR ;[157]No, indicate user switch
PJRST ARGRTN ;[157]Add the argument to the message
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
;**;[151]At REQU.4:+2L change 3 lines JCR 12/31/89
PJRST CMDEN0 ;[151]Check if a remote node specified
REQU.5: CAIN P1,.OTBAT ;[151]Check for batch
PJRST CMDEN0 ;[151]Check if a remote node specified
$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
;**;[151]At REQU.6:+8L change 1 line JCR 12/31/89
JUMPF CMDEN0 ;[151]Check if a remote node specified
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
;**;[151]At REQU.6:+13L remove 3 lines JCR 12/31/89
;**;[144]At REQU.6:+13L add 3 lines JYCW Oct-18-88
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
;**;[ppm]At ROUT.2:+4L add 1 line PPM 6/2/90
$CALL FNDALS ;[ppm]Check for local printer alias
MOVX S1,.RTETO ;GET THE BLOCK TYPE
MOVX S2,.OBJLN+LPTNLN ;[126]GET THE BLOCK LENGTH
$CALL ARGRTN ;UPDATE THE MESSAGE
;**;[156]At ROUT.3:+0L replace 2 lines with 3 lines JCR 1/19/90
ROUT.3: SKIPN G$CLUN ;[156]Seen a /CLUSTER-NODE switch?
PJRST CMDEND ;[156]No, check for one
PJRST SNDCLU ;[156]Yes, send message to NEBULA
;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
;**;[160]Add two lines at ROUT.5:+1L PMM 6/3/90
CAIN S1,.AKANM ;[160]Is this an alias name?
JRST ROUT.6 ;[160]Yes, process it
$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.
;**;[156]At ROUT.8:+4L replace 10 lines with 14 lines JCR 1/19/90
JRST ROUT9A ;[156]Check for a /CLUSTER-NODE switch
$CALL P$NODE ;[156]Get the source node if any
JUMPT ROUT10 ;[156]Go set node name
$RET ;[156]Illegally formatted message
ROUT9A: $CALL CHCLUN ;[156]/CLUSTER-NODE switch?
$RETIF ;[156]No, illegally formatted message
;[156]Since no node was specified, get the OPR's node
ROUT.9: MOVX S1,RT.SND ;[156]Default source node
IORM S1,.OFLAG(MO) ;[156]Indicate in the message
MOVE S1,G$OPRA ;[156]Get the operator's address
MOVE S1,OPR.ND(S1) ;[156]The the address of the node info
MOVE S1,NOD.NM(S1) ;[156]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
;**;[ppm]At ROUT10:+2L add 1 line PPM 6/3/90
$CALL FNDALS ;[ppm]Check for local printer alias
MOVX S1,.RTEFM ;GET THE BLOCK TYPE
MOVX S2,.OBJLN+LPTNLN ;[126]AND THE BLOCK LENGTH
$CALL ARGRTN ;AND UPDATE THE MESSAGE
;**;[156]At ROUT10:+5L add 2 lines JCR 1/19/90
SKIPE G$CLUN ;[156]/CLUSTER-NODE switch specified?
PJRST SNDCLU ;[156]Yes, go send to NEBULA
;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
;**;[160]At ROUT11:+3L add 2 lines PMM 6/3/90
CAIN S1,.AKANM ;[160]Is it an alias name?
JRST ROUT12 ;[160]Yes, process alias name
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.
;**;[156]At ROUT13:+6L replace 8 lines with 13 lines JCR 1/19/90
JRST ROU13A ;[156]Check for /CLUSTER-NODE switch
$CALL P$NODE ;[156]Get the destination node name
JUMPT ROUT.2 ;[156]Process destination node info
$RET ;[156]Illegally formatted message
ROU13A: $CALL CHCLUN ;[156]/CLUSTER-NODE switch?
$RETIF ;[156]No, illegally formatted message
;[156]Since no node was specified, get the OPR's node
ROUT14: MOVX S1,RT.DND ;[156]Default destination node
IORM S1,.OFLAG(MO) ;[156]Indicate in the message
MOVE S1,G$OPRA ;[156]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
;**;[150]At ROUBLK:+3L change 1 line JCR 12/25/89
$CALL LPTTYP ;[150]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
;**;[160]At ROUBLK:+7L remove 10 lines PMM 6/3/90
; 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
;**;[ppm]After routine ROUBLK add routine FNDALS PPM 6/3/90
SUBTTL FNDALS Check if a Local Printer Has an Alias
;[ppm]FNDALS is called by the ROUTE message processor to determine
;[ppm]if a local printer has an alias associated with it. If it does,
;[ppm]then it is included as part of the object descriptor block
;[ppm]
;[ppm]Call is: P3/Pointer to the object descriptor block header
;[ppm]Returns: If the object is a local printer and it has an alias
;[ppm] then the alias has been added to its object descriptor
FNDALS: MOVE S1,ARG.DA+OBJ.TY(P3) ;[160]Pick up the object type
CAIE S1,.OTLPT ;[160]Is it a local LPT?
$RET ;[ppm]No, so return now
MOVEI S1,ARG.DA+OBJ.TY(P3) ;[160]Get address of object block
$CALL FINDPR ;[160]Does it have an alias mapping?
$RETIF ;[160]No, so return now
MOVE S1,OBJAKA(S2) ;[160]Pick up the alias name
MOVEM S1,ARG.DA+OBJ.AK(P3) ;[160]Add to the object descriptor
$RET ;[ppm]Return to the caller
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 ;[144]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
;**;[151]At CANC.2:+1L replace 10 lines with 4 lines JCR 12/31/89
JUMPF CMDEN1 ;[151]No, check for END OF COMMAND
CAIN S1,.SWRSN ;[151]Was it /REASON: ?
JRST CANC.3 ;[151]Yes
PJRST CMDEN ;[151]Check for a /CLUSTER-NODE switch
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
;**;[161]At SETJOB+9L Replace 9 lines with 25 JYCW 6/8/90
CAIN S1,.KYCLS ;[161]WAS IT CLASS?
JRST SETJ.1 ;[161]Yes
SETO T2, ;[161]SET A FLAG
CAIN S1,.KYNOI ;[161]WAS IT NO OPERATOR INTERVENTION
MOVEI P2,.OBNWR ;[161]SET NO OPR INTERVENTION
CAIN S1,.KYOIA ;[161]OPR INTERVENTION ALLOWED
MOVEI P2,.OBALL ;[161]YES SET OPR INTERVENTION ALLOWED
JUMPL P2,.RETF ;[161]INVALID FIELD..RETURN
TOPS10 <
1OVE 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 <
$CALL P$SWIT ;[160]Check for a switch
JUMPF SETJ.W ;[161]None, do it locally
$CALL CHCLUN ;[161]Check if a /CLUSTER-NODE switch
$RETIF ;[161]Illegally formatted message
SKIPN G$CLUN ;[161]Local node specified?
JRST SETJ.W ;[161]Yes, do it locally
MOVE S1,G$CLUN ;[161]Pick up the remote node name
CAME S1,[-1] ;[161]For all nodes?
IFSKP. ;[161]Yes
$CALL SETJ.W ;[161]Yes, Local first then
ENDIF. ;[161]
$CALL RELPAG ;[161]Release the page
$CALL GETPAG ;[161]Get an output page
MOVEI P3,.OHDRS(MO) ;[161]FREE POINTER FOR OUTPUT
SETZM G$OUTP ;[161]MESSAGE PAGE RELEASE FLAG
MOVEI S1,.STJOB ;[161]Job info block
HRR S2,P1 ;[161]Job number
HRL S2,P2 ;[161]OPR/NOOPR
$CALL MOVAR2 ;[161]Add it to the message
$CALL RMSTMS ;[161]Build Remote Set message
$CALL SNDNEB ;[161]Only remote
CAME MO,G$OUTP ;[161]Was page release already
$CALL RELPAG ;[161]No, release the output page
$RET ;[161]Return to the caller
SETJ.W::MOVE S1,P1 ;[160]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 <
;**;[161]Needs Job number and Class number.
;P1/job number
;P2/class number
;**;[161]At SETJ.1+0L delete 2 lines JYCW 6/8/90
SETJ.1: $CALL P$NUM ;GET THE CLASS VALUE
$RETIF ;ERROR..RETURN
;**;[161]At SETJ.1+2L add 26 lines JYCW 6/8/90
MOVEM S1,P2 ;[161]Save class
$CALL P$SWIT ;[161]Check for a switch
JUMPF SETJ.S ;[161]None, do it locally
$CALL CHCLUN ;[161]Check if a /CLUSTER-NODE switch
$RETIF ;[161]Illegally formatted message
SKIPN G$CLUN ;[161]Local node specified?
JRST SETJ.S ;[161]Yes, do it locally
MOVE S1,G$CLUN ;[161]Pick up the remote node name
CAME S1,[-1] ;[161]For all nodes?
IFSKP. ;[161]Yes
$CALL SETJ.S ;[161]Yes, Local first then
ENDIF. ;[161]
$CALL RELPAG ;[161]Release the page
$CALL GETPAG ;[161]Get an output page
MOVEI P3,.OHDRS(MO) ;[161]FREE POINTER FOR OUTPUT
SETZM G$OUTP ;[161]MESSAGE PAGE RELEASE FLAG
MOVEI S1,.STSCH ;[161]Job info block
HRR S2,P1 ;[161]Job number
HRL S2,P2 ;[161]Scheduler class
$CALL MOVAR2 ;[161]Add it to the message
$CALL RMSTMS ;[161]Build Remote Set message
$CALL SNDNEB ;[161]Only remote
CAME MO,G$OUTP ;[161]WAS PAGE RELEASE ALREADY
$CALL RELPAG ;[161]No, release the output page
$RET ;[161]Return to the caller
SETJ.S::MOVE T3,P2 ;[161]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
MOVEM T2,G$ARG1 ;[161]Save it for reporting
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
;**;[161]At SETJ.2+3L add 12 lines JYCW 6/8/90
;builds the remote SET JOB message header.
RMSTMS: HRRZ S1,G$CBLK ;[161]Node name block
MOVE S2,G$CBLK+1 ;[161]Node name
$CALL MOVAR2 ;[161]Add it to the message
MOVX S1,NEB%MS!.OMSJB ;[161]Pick up the message type
STORE S1,.MSTYP(MO),MS.TYP ;[161]Save the type in header
MOVE S1,P3 ;[161]Get end address of message
SUB S1,MO ;[161]Subtract it from beginning
STORE S1,.MSTYP(MO),MS.CNT ;[161]Save the length of the message.
SETZM .OFLAG+.MSTYP(MO) ;[161]No flags
MOVX S1,MF.NEB ;[161]Nebula bit
IORM S1,.MSFLG(MO) ;[161]Say so in Galaxy header.
$RET ;[161]
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
;**;[162]At SETDS1+12 change 1 line JYCW 7/13/90
JUMPT CMDEN0 ;[162]Done, send it to NEBULA/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
;**;[162]At SETAVL+12 replace 18 lines with 8 JYCW 7/13/90
$CALL P$SWIT ;[162]Check for a switch
JUMPF SETAV0 ;[162]None, check for un/av for reason
$CALL CHCLUN ;[162]Check if a /CLUSTER-NODE switch
$RETIF ;[162]Illegally formatted message
SETAV0: CAIN T1,.DVUAV ;[162]UNAVAILABLE??
$CALL PREASN ;[162]Yes, process the reason
$RETT ;[162]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
;**;[157]At SETTAP:+9L change 1 line JCR 1/31/90
JUMPF E$ITD ;[157]Quit on an illegal tape name
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
;**;[162]At SETTAP+18 change 1 line JYCW 7/13/90
JUMPT CMDEN0 ;[162]Done, send it to NEBULA/QUASAR
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
;**;[157]At SETIDP:+11L add 1 line JCR 1/31/90
.SWCLN,,[.SWCLN,,CMDEN] ;[157]/CLUSTER-NODE
$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
;**;At SETOWN:+2L replace 2 lines with 8 lines JCR 1/31/90
MOVE S2,S1 ;[157]Place user number where expected
HRROI S1,ARG.DA(P3) ;[157]Where to place the user name
DIRST% ;[157]Map user number to user name
ERJMP .RETF ;[157]Quit on an error
MOVE S1,P1 ;[157]Get the argument type
MOVEI S2,EQNMSZ ;[157]Pick up the block size
$CALL ARGRTN ;[157]Build the argument header
JRST SETI.1 ;[157]Pick up the next field
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
;**;[151]At PROS.2:+2L replace 11 lines 11 lines JCR 12/31/89
CAIN S1,.SWNOD ;[151]A /NODE switch?
JRST PROS.3 ;[151]Yes, go process it
PUSH P,S1 ;[151]Preserve the switch type
$CALL ADDOBJ ;[151]Add the object block to the msg
POP P,S1 ;[151]Restore the switch type
CAIE S1,.SWSHT ;[151]A /SHORT switch?
JRST CMDEN ;[151]No, a /CLUSTER-NODE switch
$CALL PROSHT ;[151]Process the /SHORT switch
$RETIF ;[151]Return on an error
PJRST CMDEND ;[151]Finish the command
PROS.3: $CALL P$NODE ;[151]Get the node
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA+OBJ.ND(P3) ;SAVE NODE IN BLOCK
;**;[147]At PROS.3:+3L replace 3 lines with 4 lines JCR 12/23/89
SETOM G$NOFG ;[147]Indicate node switch present
$CALL ADDOBJ ;[147]Finish building the object block
$CALL P$SWIT ;[147]Check for a switch
JUMPF CMDEN1 ;[147]If none, then send the message
;**;[151]At PROS.3:+8L replace 19 lines with 12 lines JCR 12/31/89
CAIE S1,.SWSHT ;[151]A /SHORT switch?
PJRST CMDEN ;[151]No, /CLUSTER-NODE switch
MOVX S1,LS.FST ;[151]Get the flags
IORM S1,.OFLAG(MO) ;[151]Save in the flag word
PJRST CMDEND ;[151]Finish the command
PROS.4: $CALL FINOBJ ;[151]Finish object block
$RETIF ;[151]Quit on an error
$CALL P$SWIT ;[151]Switch there?
JUMPF CMDEN1 ;[151]No, check for the confirm block
$CALL PROSHT ;[151]Process /SHORT if there
JUMPF CMDEN ;[151]Process the /CLUSTER-NODE switch
PJRST CMDEND ;[151]Finish the message
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
;**;[151]At Q$SHWR:+1L replace 10 lines with 1 line JCR 12/31/89
PJRST CMDEND ;[151]Finish the command
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
;**;[151]At SHWNOD:+9L change 1 line JCR 12/31/89
PJRST CMDEND ;[151]Finish off the command
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?
;**;[151]At SHWT.2:+1L replace 14 lines with 9 lines JCR 12/31/89
JUMPF CMDEN1 ;[151]No, finish off the command
CAIN S1,.SWCLN ;[151]A /CLUSTER-NODE switch?
PJRST CMDEN ;[151]Yes, go process it
MOVEI S2,TAPSWI ;[151]Check for a tape switch
$CALL TABSRC ;[151]Search the table
$RETIF ;[151]Return on an error
MOVE S2,(S2) ;[151]Get the data
IORM S2,.OFLAG(MO) ;[151]Save the flags
PJRST CMDEND ;[151]Finish off the 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
;**;[151]At SHWD.0:+7L replace 16 lines with 9 lines JCR 12/31/89
JUMPF CMDEN1 ;[151]No switch check if end
CAIN S1,.SWCLN ;[151]/CLUSTER-NODE switch?
PJRST CMDEN ;[151]Yes, go process
MOVEI S2,DSKDSP ;[151]Get dsk table address
$CALL SHOWTB ;[151]Do the table lookup
$RETIF ;[151]Return on an error
PJRST CMDEND ;[151]Finish off the message
SHWD.1: $CALL PSTRRE ;[151]Check for a structure
PJRST CMDEND ;[151]Finish off the command
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
;**;[151]At SHWQ.3:+5L change 2 lines JCR 12/31/89
CAIN S1,.SWCLN ;[151]Cluster node switch?
PJRST CMDEN ;[151]Yes, go process it
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
;**;[154]At Q$SHCL:+2L change 1 line JCR 1/15/90
MOVEM S1,.MSFLG(MO) ;[154]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
;**;[151]At SHCL.1:+11L change 1 line JCR 12/31/89
PJRST CMDEN1 ;[151]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
;**;[151]At SHCL.4:+2L replace 52 lines with 31 lines JCR 12/31/89
PJRST CMDEN1 ;[151]Send the message to NEBULA
SUBTTL CHCLUN - Modify message for NEBULA
;[151]Routine CHCLUN checks if a switch block is a cluster node switch block.
;[151]If it is, then CHCLUN determines if the message is to be processed
;[151]locally, remotely or both locally and remotely.
;[151]
;[151]Call is: S1/Switch block type
;[151] G$CLUN/0
;[151]Returns true: The block is a switch block
;[151] G$CLUN/0 The message is to be processed
;[151] locally
;[151] G$CLUN/SIXBIT node name The message is to be forwarded
;[151] G$CLUN/-1 The message is to be processed
;[151] by all nodes in the cluster
;[151]Returns false: The block is not a switch block
;[151] S1/Switch block type
INTERN CHCLUN ;[151]Make it global
CHCLUN::CAIE S1,.SWCLN ;[151]Is it a CLUSTER-NODE switch?
$RETF ;[151]No, indicate so
$CALL P$CURR ;[151]Pick up cluster node block adr
$CALL P$NEXT ;[151]Point to the next block
MOVE S2,PFD.D1(S1) ;[151]Pick up the switch data
CAMN S2,G$HOST ;[151]Local node specified?
$RETT ;[151]Yes, return now
MOVEM S2,G$CLUN ;[151]Save the data for the caller
MOVEM S2,G$CBLK+1 ;[151]And place in the message block
$RETT ;[151]Return to the caller
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.
;**;[146]At SNDCLU:+0L change 1 line
SNDCLU::$CALL P$CFM ;[146]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
;**;[147]At SNDC.2:+18L replace 1 line with 11 lines JCR 12/23/89
SKIPN G$NOFG ;[147]A node switch specified?
JRST SNDC.3 ;[147]No, go send the message
LOAD S1,ARG.HD+.OHDRS(MO),AR.TYP ;[147]Pick up the block type
CAIE S1,.OROBJ ;[147]Is this an object block?
JRST SNDC.3 ;[147]No, go send the message
MOVE S1,ARG.DA+OBJ.TY+.OHDRS(MO) ;[147]Pick up the object type
CAMN S1,[-1] ;[147]For all objects?
JRST SNDC.3 ;[147]Yes, go send the message
MOVX S1,.RMLPT ;[147]Pick up /NODE switch specified
IORM S1,ARG.DA+OBJ.TY+.OHDRS(MO) ;[147]Indicate in the message type
SNDC.3: $CALL SNDNEB ;[147]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
;**;[151]At Q$MOUNT::+15L change 3 lines JCR 12/31/89
JUMPF CMDEN1 ;[151]None, finish off the command
CAIN S1,.SWCLN ;[151]CLUSTER-NODE switch?
PJRST CMDEN ;[151]Yes, go process it
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
;**;[151]At MOUN.1:+0L change 1 line JCR 12/31/89
MOUN.1: PJRST CMDEND ;[151]Finish off the command
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
;**;[160]At Q$DEFINE::+4L replace 2 lines with 6 lines
CAIN S1,.KYNOD ;[160]Is it node?
JRST DEFNOD ;[160]Yes, process it
CAIE S1,.KYAKA ;[160]Is it alias?
$RETF ;[160]No..return false
$CALL DEFAKA ;[160]Yes, process it
$RET ;[160]And return
;**;[160]At Q$DEFINE::+11L add label DEFNOD: PMM 6/3/90
DEFNOD: $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
;**;[160]At DEFI.5:+4L add routines DEFAKA, CHRNME, FINDAK, FORMAT, ADDAKA,
;**;[160]DELAKA, QSRAKA, LSTAKA and OPRRDA PMM 6/3/90
SUBTTL DEFAKA Process the DEFINE ALIAS Message
;[160]DEFAKA updates ORION's alias linked list, sends to OPR a RESPONSE TO
;[160]DEFINE ALIAS message and sends QUASAR a new alias message.
;[160]Routine DEFAKA is called by Q$DEFINE to process a DEFINE ALIAS message.
DEFAKA: SETZM AKAOBJ ;[160]Clear first word of object block
HRLI T1,AKAOBJ ;[160]Get source address
HRRI T1,AKAOBJ+1 ;[160]Get second word
BLT T1,AKAOBJ+OBJ.SQ+7 ;[160]Clear the entire object block
MOVEI P2,AKAOBJ+1 ;[160]Point at object block buffer
$CALL P$CURR ;[160]Pick up the .AKANM header
$CALL P$NEXT ;[160]Bump to the next field
AOS S1 ;[160]Bump to the alias string
HRROI S1,0(S1) ;[160]Get ASCII pointer to 'new' alias
$CALL S%SIXB ;[160]Convert 'new' alias to SIXBIT
MOVEM S2,G$ARG3 ;[160]Preserve 'new' SIXBIT alias
$CALL P$SWIT ;[160]Is there a /CLUSTER-NODE switch?
JUMPF DEFA.1 ;[160]No, process locally
$CALL CHCLUN ;[160]Pick up the /CLUSTER-NODE value
$RETIF ;[160]Illegally formatted message
SKIPN G$CLUN ;[160]Local node specified?
JRST DEFA.1 ;[160]Yes, so ignore the switch
MOVE S1,G$CLUN ;[160]Get node(s) specified
CAME S1,[-1] ;[160]Is it all nodes?
JRST DEFA.9 ;[160]No, send remotely
DEFA.1: $CALL P$CFM ;[160]Is this an unDEFINE ALIAS?
JUMPF DEFA.2 ;[160]No, process a DEFINE or reDEFINE
;Process the unDEFINE command
DEF.1B::MOVE S1,G$ARG3 ;[160]Set up input for routine FINDAK
$CALL FINDAK ;[160]Is 'new' alias in list?
JUMPF DEF.1C ;[160]No, complain
MOVE S1,G$ARG3 ;[160]Yes, get 'new' alias
MOVEM S1,G$ARG2 ;[160]Designate that it must be deleted
MOVE S1,S2 ;[160]Get address of entry
$CALL DELAKA ;[160]Delete it from linked list
$CALL E$AKU ;[160]Issue alias undefined message
JRST DEFEND ;[160]Send messages to OPR and QUASAR
DEF.1C: $CALL E$AKI ;[160]No, complain alias not found
MOVE S1,G$CLUN ;[160]Get node(s) specified
CAMN S1,[-1] ;[160]Is it all nodes?
JRST DEF.9D ;[160]Yes, send remotely
$RET ;[160]No, return now
;Here to read in a DEFINE or a reDEFINE alias command
DEFA.2: MOVEI P2,AKAOBJ ;[160]Get object block address
SETZM G$ARG2 ;[160]Assume no need to delete an alias
MOVE S1,G$ARG3 ;[160]Get 'new' alias
$CALL FINDAK ;[160]Alias already defined?
JUMPF DEFA.3 ;[160]No, process the printer specification
MOVE T1,OBJAKA(S2) ;[160]Yes, get SIXBIT alias name
MOVEM T1,G$ARG2 ;[160]and designate it for deletion
DEFA.3: $CALL P$NUM ;[160]Is this a local printer?
JUMPF DEFA.5 ;[160]No, process remote printer
;Read in the local printer specification
CAXLE S1,77 ;[160]Is it valid?
$RETF ;[160]No,,return
AOS P2 ;[160]Point past object block header
MOVEM S1,OBJ.UN(P2) ;[160]Save it in the object block
MOVEI S1,.OTLPT ;[160]Pick up the printer type
MOVEM S1,OBJ.TY(P2) ;[160]Indicate in the object block
$CALL P$SWIT ;[160]Get the node switch
JUMPT DEFA3A ;[160]Go check the switch type
MOVE S1,G$HOST ;[160]Pick up the local node name
JRST DEFA3C ;[160]Go place in the object block
DEFA3A: CAIN S1,.SWNOD ;[160]Is it a node switch?
JRST DEFA3B ;[160]Yes, pick up the node name
$CALL CHCLUN ;[160]Is it a /CLUSTER-NODE switch?
$RETIF ;[160]No, illegally formatted message
MOVE S1,G$HOST ;[160]Pick up the local node name
MOVEM S1,OBJ.ND(P2) ;[160]Save in the object block
SKIPN S1,G$CLUN ;[160]Local node specified?
JRST DEFA.4 ;[160]Yes, treat as the local case
CAMN S1,[-1] ;[160]All nodes?
JRST DEFA.4 ;[160]Yes, do the local case first
MOVEI S1,.OROBJ ;[160]Pick up the block type
HRLI S1,AKBSIZ ;[160]Pick up the block length
MOVEM S1,-ARG.DA(P2) ;[160]Place in the block header
JRST DEFA.9 ;[160]Prepare to send to NEBULA
DEFA3B: $CALL P$NODE ;[160]Get the source node
$RETIF ;[160]No,,return
SETOM G$NOFG ;[160]Indicate /NODE switch specified
DEFA3C: MOVEM S1,OBJ.ND(P2) ;[160]And save the source node
DEFA.4: MOVEI S1,AKAOBJ+1 ;[160]Get object block address
$CALL FINDPR ;[160]Is it in linked list?
JUMPF DEFA.6 ;[160]No, set up object block header
MOVE S1,OBJAKA(S2) ;[160]Get the old alias
MOVEM S1,OBJ.AK(P2) ;[160]Save it in object block
JRST DEFA.6 ;[160]Set up object block header
;Here to process a remote printer specification or an alias name
DEFA.5: MOVEI S1,.OTLPT ;[160]Pick up the printer type
MOVEM S1,OBJTYP(P2) ;[160]Indicate in the object block
$CALL P$KEYW ;[160]Pick up next keyword
MOVEI P3,AKAOBJ ;[160]Get the object block address
$CALL LPTTYP ;[160]Build the printer type
$RETIF ;[160]Return if false
MOVEI P2,AKAOBJ+1 ;[160]Get the object block address
;Here to add the object block header
DEFA.6: MOVEI T2,.OROBJ ;[160]Pick up the object block header
HRLI T2,AKBSIZ ;[160]Pick up the object block length
MOVEM T2,-1(P2) ;[160]Add in object block header
;CLUSTER-NODE next few lines:
$CALL P$SWIT ;[160]Is there a /CLUSTER-NODE switch?
JUMPF DEF.6D ;[160]No, process locally
$CALL CHCLUN ;[160]Pick up the /CLUSTER-NODE value
$RETIF ;[160]Illegally formatted message
SKIPN S1,G$CLUN ;[160]Local node specified?
JRST DEF.6D ;[160]Yes, so ignore the switch
CAME S1,[-1] ;[160]All nodes?
JRST DEFA.9 ;[160]No, send remotely
DEF.6D: $CALL P$CFM ;[160]Is there a confirm?
$RETIF ;[160]Invalid message
JRST DEF.6B ;[160]Process locally
DEF.6A::MOVEI P2,AKAOBJ+1 ;[160]Get address of object block
MOVE S1,G$ARG3 ;[160]Get 'new' alias
$CALL FINDAK ;[160]Alias already defined?
JUMPF DEF.6C ;[160]No, check object block
MOVE T1,OBJAKA(S2) ;[160]Yes, get SIXBIT alias name
MOVEM T1,G$ARG2 ;[160] and designate it for deletion
DEF.6C: MOVE S1,P2 ;[160]Get address of object block
SETZM OBJ.AK(S1) ;[160]Clear alias name
$CALL FINDPR ;[160]Is it in linked list?
JUMPF DEF.6B ;[160]No, continue on
MOVE S1,OBJAKA(S2) ;[160]Get alias name
MOVEM S1,OBJ.AK(P2) ;[160]Place in object block
DEF.6B: SKIPN S1,G$ARG2 ;[160]Alias to be deleted?
JRST DEFA.7 ;[160]No, object block mapped to any alias?
MOVE S2,OBJ.AK(P2) ;[160]Yes, get old alias
CAME S1,S2 ;[160]Is it the same mapping?
JRST DEF.6E ;[160]No, delete old alias mapping
$CALL E$AKM ;[160]Yes, notify operator
MOVE S1,G$CLUN ;[160]Get node(s) value
CAMN S1,[-1] ;[160]Is it all nodes?
JRST DEF.9D ;[160]Yes, process other nodes
$RET ;[160]Return
;Here to delete old alias mapping from list
DEF.6E: MOVE S1,G$ARG2 ;[160]Get old alias
$CALL FINDAK ;[160]Search for its address
MOVE S1,S2 ;[160]Get the address
$CALL DELAKA ;[160]Delete old alias from list
JRST DEFA.7 ;[160]Add 'new' alias entry to linked list
;Is this a redefinition?
DEFA.7: SKIPN S1,OBJ.AK(P2) ;[160]Really an old alias?
JRST DEFA.8 ;[160]No, set up and link in new entry
MOVE S1,P2 ;[160]Yes, get address of object block
$CALL FINDPR ;[160]Get its entry in list
MOVE S1,G$ARG3 ;[160]Get 'new' alias
MOVEM S1,OBJAKA(S2) ;[160]Add it to entry in list
MOVEM S1,OBJ.AK(P2) ;[160]Add 'new' alias to object block
JRST DEFEND ;[160]Send OPR and QUASAR messages
DEFA.8: $CALL FORMAT ;[160]Format the mapped entry
$RETIF
$CALL ADDAKA ;[160]Add the entry into list
$RETIF
DEFEND: $CALL OPRRDA ;[160]Send RESPONSE TO DEFINE ALIAS
$RETIF
$CALL QSRAKA ;[160]Send NEW ALIAS message to QUASAR
$RETIF ;[160]Return if problem
$CALL E$AKD ;[160]Issue alias defined message
MOVE S1,G$CLUN ;[160]Get node(s) specified
CAMN S1,[-1] ;[160]Is it all nodes?
JRST DEF.9D ;[160]Yes, process for all nodes
$RETT
;Here to send command remotely
DEFA.9: $CALL RELOPR ;[160]Release OPR from block receive
$RETIF ;[160]RETURN IF PROBLEM
DEF.9D: $CALL GETPAG ;[160]Pick up a page for NEBULA
MOVEI S1,NEB%MS!.OMAKA ;[160]Get message type
HRLI S1,.OHDRS+.AKASZ+.NDESZ ;[160]Assume the object block is empty
SKIPN AKAOBJ ;[160]Is the object block empty?
JRST DEF.9A ;[160]Yes, no need to include it
HRLI S1,.OHDRS+.AKASZ+AKBSIZ+.NDESZ ;[160]Yes, include it in length
DEF.9A: MOVEM S1,.MSTYP(MO) ;[160]Save in message
MOVEI P3,.OHDRS(MO) ;[160]Get address of first argument
MOVE S1,G$ARG3 ;[160]Get 'new' alias
MOVEM S1,ARG.DA(P3) ;[160]Save in message
MOVEI S1,.AKANM ;[160]Get argument type...
HRLI S1,.AKASZ ;[160]...and length
MOVEM S1,ARG.HD(P3) ;[160]Save argument header in message
ADDI P3,.AKASZ ;[160]Point at next argument block
AOS .OARGC(MO) ;[160]Increment argument count
SKIPN AKAOBJ ;[160]Is there a printer specification?
JRST DEF.9C ;[160]No, send message now
SETZM OBJ.AK(P2) ;[160]Zero out any old alias name
MOVE S1,OBJ.TY(P2) ;[160]Pick up the printer type
CAME S1,[.OTLPT] ;[160]A local printer?
TXNE S1,.CLLPT ;[160]No, a cluster printer?
SKIPA ;[160]A local or cluster printer
JRST DEF.9B ;[160]No, no need to check for /NODE
SKIPN G$NOFG ;[160]Node switch specified?
JRST DEF.9B ;[160]Yes, no need to change remotely
MOVX S1,.RMLPT ;[160]Pick up no /NODE specified bit
IORM S1,OBJ.TY(P2) ;[160]Save in the printer type word
DEF.9B: HRLI T1,AKAOBJ ;[160]Get source address
HRRI T1,ARG.HD(P3) ;[160]Get source,,destination
BLT T1,ARG.HD+AKBSIZ(P3) ;[160]Move the entire object block
AOS .OARGC(MO) ;[160]Increment argument count
ADDI P3,AKBSIZ ;[160]Point at next block
DEF.9C: $CALL FASNEB ;[160]Send the message to NEBULA
SETZ MO, ;[160]Indicate page has been released
$RET ;[160]Return to the caller
SUBTTL FINDPR Find An Alias Name Entry
;[160]FINDPR searches for the given printer object block in ORION's
;[160]alias printer name linked list
;[160]
;[160]Call is: S1/Address of printer object block
;[160]Returns true: S2/Address of mapped entry in ORION's list
;[160]Returns false: Signifies that printer object block was not found
FINDPR::$SAVE <T1,P1,P2> ;[160]Save the AC
MOVE P1,S1 ;[160]Preserve the printer object block
SKIPA S2,HDRAKA ;[160]Get the linked list header
FNDPR1: LOAD S2,.QELNK(S2),QE.PTN ;[160]Get the next entry
SKIPN S2 ;[160]End of list?
$RETF ;[160]Yes, return
MOVE T1,OBJ.TY(P1) ;[160]Get object type
CAME T1,OBJTYP(S2) ;[160]Same object type?
JRST FNDPR1 ;[160]No, loop to next entry
MOVE T1,OBJ.ND(P1) ;[160]Get node name
CAME T1,OBJNOD(S2) ;[160]Same node name?
JRST FNDPR1 ;[160]No, loop to next entry
MOVE T1,OBJ.UN(P1) ;[160]Get unit value
CAME T1,OBJUNI(S2) ;[160]Are the units equal?
JRST FNDPR1 ;[160]No, loop to next entry
MOVE T1,OBJ.TY(P1) ;[160]Get object type
TXNN T1,.DQLPT!.LALPT ;[160]Is this a LAT or DQS printer?
$RETT ;[160]No, return true
MOVEI S1,OBJ.QN(P1) ;[160]Get object's queue name
MOVE P2,S2 ;[160]Save S2
MOVEI S2,OBJNAM(S2) ;[160]Get current entry's queue name
$CALL CHRNME ;[160]Are the names equal?
MOVE S2,P2 ;[160]Restore current entry's address
JUMPF FNDPR1 ;[160]No, loop to next entry
$RETT ;[160]Yes, return true
SUBTTL CHRNME Compare Printer Names
;[160]CHRNME is called to compare DQS VMS queue names, LAT PORT names,
;[160]LAT SERVICE names or LAT SERVER names.
;[160]
;[160]Call is: S1/Address of name block to compare
;[160] S2/Address of name block to compare
;[160]Returns true: The names are the same and of the same type
;[160]Returns false: The names are different or not of the same type
;[160]In both cases: S1/Flags from the compare
CHRNME::$SAVE <P1,P2> ;[160]Save these ac
DMOVE P1,S1 ;[160]Save the addresses
LOAD S1,ARG.HD(P1),AR.TYP ;[160]Pick up the name type
LOAD S2,ARG.HD(P2),AR.TYP ;[160]Pick up the name type
CAME S1,S2 ;[160]Are they the same?
$RETF ;[160]No, indicate to the caller
HRROI S1,ARG.DA(P1) ;[160]Point to the name
HRROI S2,ARG.DA(P2) ;[160]Point to the name
$CALL S%SCMP ;[160]Compare the names
TXNE S1,SC%LSS!SC%SUB!SC%GTR ;[160]Are they the same?
$RETF ;[160]No, indicate to the caller
$RETT ;[160]Yes, indicate to the caller
SUBTTL FINDAK - Search For an Alias
;[160]Routine FINDAK searches for the given alias name in ORION's
;[160]alias printer name linked list which is pointed to by HDRAKA.
;[160]
;[160]Call is: S1/SIXBIT alias name
;[160]Returns true: S2/Address of mapped entry in ORION's list
;[160]Returns false: Alias name is not defined
;[160] S1/SIXBIT alias name
FINDAK::$SAVE <P1> ;[160]Save the AC
MOVE P1,S1 ;[160]Preserve the alias
SKIPA S2,HDRAKA ;[160]Get the linked list header
FIND.1: LOAD S2,.QELNK(S2),QE.PTN ;[160]Get the next entry
SKIPN S2 ;[160]End of the list?
JRST FIND.2 ;[160]Alias name is not defined
CAME P1,OBJAKA(S2) ;[160]Is this the alias name
JRST FIND.1 ;[160]No, loop to next entry
$RETT ;[160]Yes, return
FIND.2: MOVE S1,P1 ;[160]Place the alias name in S1
$RETF ;[160]No, return now
SUBTTL FORMAT - Formats an Alias Printer Name Entry
;[160]FORMAT sets up a mapped entry for ORION's alias printer name linked list.
;[160]FORMAT acquires memory space for the formatted mapped entry and BLTs
;[160]the printer object block which resides at address AKAOBJ into the
;[160]memory space.
;[160]
;[160]Call is: AKAOBJ Object block to be copied
;[160]Returns true: S1/ADDRESS OF THE FORMATTED MAPPED ENTRY
;[160]Returns false: Signifies that free space was not available
FORMAT: $SAVE <P1,P2> ;[160]Save these ACs
MOVEI S1,AKBSIZ ;[160]Get mapped entry size
$CALL M%GMEM ;[160]Get memory
$RETIF ;[160]Memory not available
MOVE P1,S2 ;[160]Get address of memory
SETZM .QELNK(P1) ;[160]Clear the pointers
MOVEI P2,AKAOBJ+1 ;[160]Get source address
MOVE S1,G$ARG3 ;[160]Get 'new' alias
MOVEM S1,OBJ.AK(P2) ;[160]Add 'new' alias to object block
HRLI S1,(P2) ;[160]Source address,,x
HRRI S1,OBJTYP(P1) ;[160]Source,,destination
BLT S1,OBJAKA(P1) ;[160]Move the object block
MOVE S1,P1 ;[160]Return address of formatted entry
$RETT ;[160]Return
SUBTTL ADDAKA - Add an Entry to the Alias Printer Name Linked List
;[160]ADDAKA links a formatted mapped entry into ORION's linked list
;[160]
;[160]Call is: S1/Address of the mapped entry to be added into ORION's linked
;[160] list
;[160]Returns: S1/Address of the mapped entry that was added into ORION's
;[160] linked list
ADDAKA: $SAVE <T1,T2,P1,P2,P3> ;[160]Save these ACs
MOVE P2,S1 ;[160]Preserve the object block address
SKIPE P1,HDRAKA ;[160]Get the list pointer
JRST ADDA.2 ;[160]Not empty
JRST ADDA.4 ;[160]Empty
ADDA.1: LOAD P1,.QELNK(P1),QE.PTN ;[160]Get next entry
SKIPN P1 ;[160]Last entry?
JRST ADDA.6 ;[160]Yes, add to end of list
ADDA.2: MOVE T1,OBJTYP(P2) ;[160]Get object type of new entry
CAMLE T1,OBJTYP(P1) ;[160]Object type too large?
JRST ADDA.1 ;[160]Yes, check next entry
CAME T1,OBJTYP(P1) ;[160]Same object type?
JRST ADDA.5 ;[160]No, link entry in here
MOVX T2,.LALPT!.OTLPT ;[160]Get LAT printer type
CAME T2,T1 ;[160]Is new entry a LAT printer?
JRST ADDA.3 ;[160]No, check node type
LOAD T1,OBJNAM(P1),AR.TYP ;[160]Get queue type of current entry
LOAD T2,OBJNAM(P2),AR.TYP ;[160]Get queue type of new entry
CAMLE T2,T1 ;[160]Is the new entry smaller?
JRST ADDA.1 ;[160]No, check next entry
CAME T2,T1 ;[160]Same queue type?
JRST ADDA.5 ;[160]No, link entry in here
ADDA.3: MOVE T1,OBJNOD(P2) ;[160]Get node type
CAMLE T1,OBJNOD(P1) ;[160]Object node too small?
JRST ADDA.1 ;[160]Yes, check next entry
CAME T1,OBJNOD(P1) ;[160]Same node type?
JRST ADDA.5 ;[160]No, link entry in here
MOVE T1,OBJUNI(P2) ;[160]Get unit block
CAMLE T1,OBJUNI(P1) ;[160]Unit too small?
JRST ADDA.1 ;[160]Yes, check next entry
CAME T1,OBJUNI(P1) ;[160]Same unit type?
JRST ADDA.5 ;[160]No, link entry in here
MOVEI S1,OBJNAM(P2) ;[160]Get object's queue name
MOVEi S2,OBJNAM(P1) ;[160]Get current entry's queue name
$CALL CHRNME ;[160]Compare strings
TXNE S1,SC%LSS ;[160]Name less than?
JRST ADDA.5 ;[160]Yes, go link in here
JRST ADDA.1 ;[160]No, check next entry
ADDA.4: MOVEM P2,HDRAKA ;[160]Point at first entry
MOVEI P1,HDRAKA ;[160]Get the list header address
STORE P1,.QELNK(P2),QE.PTP ;[160]Make it current entry's previous link
SETZ P1, ;[160]Clear P1
STORE P1,.QELNK(P2),QE.PTN ;[160]Store zero in next link
$RETT
ADDA.5: STORE P1,.QELNK(P2),QE.PTN ;[160]Make current entry the next link
LOAD P3,.QELNK(P1),QE.PTP ;[160]Get previous entry
STORE P3,.QELNK(P2),QE.PTP ;[160]Make previous entry the previous link
STORE P2,.QELNK(P1),QE.PTP ;[160]Change current entry's previous link
STORE P2,.QELNK(P3),QE.PTN ;[160]Change prevvious entry's next link
$RETT ;[160]Return
ADDA.6: SKIPA P1,HDRAKA ;[160]Get pointer to list
ADDA.7: LOAD P1,.QELNK(P1),QE.PTN ;[160]Point at next entry
LOAD T1,.QELNK(P1),QE.PTN ;[160]Look at current entry's next entry
SKIPE T1 ;[160]Is this the last entry?
JRST ADDA.7 ;[160]No, get next entry
STORE P2,.QELNK(P1),QE.PTN ;[160]Make last entry point to new entry
STORE P1,.QELNK(P2),QE.PTP ;[160]Make new entry point to last entry
SETZ T1, ;[160]Get end of list marker
STORE T1,.QELNK(P2),QE.PTN ;[160]Make new entry point at it
$RETT
SUBTTL ADDAKA - Delete an Entry to the Alias Printer Name Linked List
;[160]DELAKA deletes an entry from ORION's alias printer name linked list.
;[160]
;[160]Call is: S1/Address of the mapped entry to be deleted from ORION's
;[160] linked list
;[160]Returns: The entry has been deleted
DELAKA: $SAVE <P1,P2,T1> ;[160]Save these ACs
MOVE P2,S1 ;[160]Save address of entry
LOAD S2,.QELNK(S1),QE.PTP ;[160]Get previous entry
CAMN S1,HDRAKA ;[160]Is this the first entry in list?
JRST DELA.1 ;[160]Yes, process first entry
LOAD T1,.QELNK(S1),QE.PTN ;[160]Next entry pointer
STORE T1,.QELNK(S2),QE.PTN ;[160]Make previous point to next entry
JRST DELA.2 ;[160]Get the next entry
DELA.1: LOAD P1,.QELNK(S1),QE.PTN ;[160]Get the next entry
MOVEM P1,HDRAKA ;[160]Make it first entry in list
JUMPE DELA.3 ;[160]Release memory if no next entry
MOVEI T1,HDRAKA ;[160]Yes, get the pointer to list
STORE T1,.QELNK(P1),QE.PTP ;[160]Put in next entry's previous pointer
JRST DELA.3 ;[160]No, release memory
DELA.2: LOAD P1,.QELNK(S1),QE.PTN ;[160]Get the next entry
JUMPE P1,DELA.3 ;[160]Release memory if end of the list
STORE S2,.QELNK(P1),QE.PTP ;[160]Make next point to previous entry
DELA.3: MOVE S2,P2 ;[160]Get address of entry
MOVEI S1,AKBSIZ ;[160]Get entry size
$CALL M%RMEM ;[160]Release the 'de-linked' entry
$RET
;**;[160]Routine QSRAKA is added as part of this edit
;ROUTINE QSRAKA FORMATS UP THE NEW ALIAS MESSAGE AND SENDS IT TO QUASAR.
;
;CALL IS: S1/SIXBIT ALIAS NAME (OR ZERO TO SIGNIFY THAT NO ALIAS NEEDS
; TO BE DELETED
; S2/ADDRESS OF THE OBJECT BLOCK (OR ZERO TO SIGNIFY THAT
; NO ALIAS NEEDS TO BE ADDED
QSRAKA: $SAVE <T1,t2> ;[160]Save ACs
$CALL GETPAG ;[160]Get a page
MOVX T1,.OMNEW ;[160]Get new alias code
STORE T1,.MSTYP(MO),MS.TYP ;[160]Save the type in message
MOVEI T1,PAGSIZ ;[160]Get message length
STORE T1,.MSTYP(MO),MS.CNT ;[160]SAVE THE LENGTH IN MESSAGE
MOVEI T1,2 ;[160]Get the argument count
MOVEM T1,.OARGC(MO) ;[160]Save the argument count
MOVEI T1,.AKASZ ;[160]Get alias block length
HRLI T2,(T1) ;[160]Set in left half of word
MOVEI T1,.AKBLK ;[160]Get alias name type
HRRI T2,(T1) ;[160]Set in right half of word
MOVEM T2,ARG.HD+.OHDRS(MO) ;[160]Add alias name block header
MOVE S1,G$ARG2 ;[160]Get Alias name to be deleted
MOVEM S1,ARG.DA+.OHDRS(MO) ;[160]Add alias name to message
MOVEI T2,.AKASZ+ARG.HD+.OHDRS(MO) ;[160]Point at second header data block
MOVEI S2,AKAOBJ ;[160]Get object block address
HRLI T1,(S2) ;[160]Source address
HRRI T1,(T2) ;[160]Destination
BLT T1,OBJ.AK+1(T2) ;[160]Move the object block into message
$CALL SNDQSR ;[160]Send to quasar
SETZ MO, ;[160]Indicate page has been released
$RET ;[160]And return
SUBTTL LSTAKA - Set Up the RESPONSE TO DEFINE ALIAS Message
;[160]LSTAKA sets up the RESPONSE TO DEFINE ALIAS Message by
;[160]Copying every alias from ORION's linked list
;[160]Call is: S1/Address of the alias name block in outgoing message
;[160]Returns: Alias list block pointed to by S1
LSTAKA::$SAVE <P1,P2,P3> ;[160]Save these ACs
SETZ P1, ;[160]Initialize alias counter
MOVEI P2,(S1) ;[160]Point to alias name block
MOVE P3,P2 ;[160]Save alias list header address
AOS P2 ;[160]Point at first address in block
SKIPA S2,HDRAKA ;[160]Get address of first entry
LSTAK1: LOAD S2,.QELNK(S2),QE.PTN ;[160]Get the next object in the chain
SKIPN S2 ;[160]Last entry?
JRST LSTAK3 ;[160]Yes, add header
MOVE T1,OBJAKA(S2) ;[160]Get alias
MOVEM T1,(P2) ;[160]Add its alias to list
AOS P1 ;[160]Increment alias counter
AOS P2 ;[160]Increment pointer
JRST LSTAK1 ;[160]Loop to process next entry
LSTAK3: AOS P1 ;[160]Include header in block length
HRLI T1,(P1) ;[160]Get alias block length
HRRI T1,.AKBLK ;[160]Get alias block name
MOVEM T1,(P3) ;[160]Store in message
MOVEI T1,(P1) ;[160]Get alias block length
ADD P3,T1 ;[160]Update message pointer
MOVE S1,.MSFLG(MI) ;[160]Pick up the flag word
TXNN S1,MF.NEB ;[160]Message originate remotely?
$RET ;[160]No, so return now
MOVX S1,MF.NEB ;[160]Pick up the remote origin bit
IORM S1,.MSFLG(MO) ;[160]Indicate to OPR
DMOVE S1,G$CBLK ;[160]Pick up the remote node block
DMOVEM S1,ARG.HD(P3) ;[160]Place in the message
$RET ;[160]And return
SUBTTL LSTAKA - Set Up the RESPONSE TO DEFINE ALIAS Message
;[160]OPRRDA formats the RESPONSE TO DEFINE ALIAS message and sends it to OPR.
;
RELOPR: SETOM RELBLK ;[160]Set the release block flag
SKIPA ;[160]Don't reset the flag
OPRRDA: SETZM RELBLK ;[160]Clear release block flag
MOVEI S1,.OHDRS+ARG.HD(MO) ;[160]Get address for alias list block
SKIPL RELBLK ;[160]Is this just to release OPR?
$CALL LSTAKA ;[160]No, get alias list
MOVE T1,.OHDRS+ARG.HD(MO) ;[160]Get argument header
MOVEI T1,PAGSIZ-1 ;[160]Get message length
HRLI T2,(T1) ;[160]Set in left half of word
MOVEI T1,.OMRDA ;[160]Get command code
HRRI T2,(T1) ;[160]Set in right half of word
MOVEM T2,.MSTYP(MO) ;[160]Add to outgoing message
SETZ S1, ;[160]Assume this is a release OPR
SKIPL RELBLK ;[160]Is the release block flag set?
AOS S1 ;[160]No, get argument count
MOVEM S1,.OARGC(MO) ;[160]Store in outgoing message
SKIPE RELBLK ;[160]Is this RELOPR?
JRST OPRR.1 ;[160]Yes, send to sender only
SETOM G$ASND## ;[160]Force message to all OPRs
$CALL W$NODE ;[160]Find node
$CALL SNDAOP ;[160]No, send the message to all OPRS
$RET ;[160]And return
OPRR.1: MOVE S1,G$SND## ;[160]Get the Sender's PID
MOVEM S1,.MSCOD(MO) ;[160]Save PID in message
MOVEI S2,PAGSIZ-1 ;[160]Page message size
$CALL SPDOPR## ;[160]Send to OPR
$RET ;[160]And return
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
;**;[155]At Q$SWITCH::+8L replace 2 lines with 5 lines JCR 1/16/90
$CALL P$DEV ;[155]Check for a device block
JUMPF CMDEND ;[155]None, finish the command
$CALL PSTA.1 ;[155]Check for a tape device
$RETIF ;[155]Not a tape, that's an error
PJRST CMDEND ;[155]Finich the command
>;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