Trailing-Edge
-
PDP-10 Archives
-
BB-H138D-BM
-
galaxy-sources/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 Murray Berkowitz/PJT 1-Jan-82
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC,ORNMAC,QSRMAC,ACTSYM
PROLOG(OPRQSR)
ERRSET ;INITIALIZE ERROR TABLES
PARSET ;SETUP PARSER ENTRIES
QSREDT==:74 ;OPRQSR 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 SNDQSR ;SEND TO QUASAR
TOPS10< EXTERNAL SNDACT> ;SEND TO ACTDAE
EXTERNAL GETPAG ;ROUTINE TO SETUP MO
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
COMMENT \
THIS MODULE CONTAINS MOST OF THE MESSAGE PROCESSING FOR QUASAR.
REVISION HISTORY
1 OPRQSR Dec-5-78 Add Check for Remote Nodes and add node
Block in Quasar Messages
2 OPRQSR Dec-5-78 Add /SHORT AND /ALL FOR SHOW QUEUES
3 OPRQSR Dec-7-78 Add New Format for HOLD,RELEASE,MODIFY,
SHOW STATUS AND PARAMETERS
4 OPRQSR Dec-8-78 Add GETTAP for the -10
5 OPRQSR Jan-5-78 Add /SHORT to SHOW STATUS and /NODE to
SHOW QUEUE command
6 OPRQSR JAN-10-78 USE ONLY NODE NAME WHEN DEFAULTING OBJECT
BLOCK FOR -10 AND -20
7 OPRQSR JAN-19-79 ADD LIMITED EXCEEDED ACTION AND PRIORITY
SETTING FOR CDP,PLT,PTP
10 OPRQSR JAN-23-79 ADD -20 SETJOB CODE
11 OPRQSR JAN-24-79 ADD SET ONLINE COMMAND FOR THE -20
12 OPRQSR JAN-31-79 ALLOW REQUEUE FOR CDP,PLT , AND PTP
13 OPRQSR FEB-2-79 CHANGE SHOW STA TAPE DEV FORM SHO STA DEV
14 OPRQSR FEB-6-79 ADD DN60 DEFINE, SET AND SHUTDOWN COMMANDS
15 OPRQSR Feb-27-79 Change Mount Command to be MOUNT STRUCTURE
then Structure name.
16 OPRQSR MAR-1-79 ADD SET TAPE INITIALIZE COMMAND
17 OPRQSR MAR-7-79 Add Bytes Per Message for DN60 and Unlabeled
as a label type
20 OPRQSR Mar-14-79 Fix Cancel bug
21 OPRQSR Mar-19-79 Send Node Numbers in Object Block on the -10
using symbol NOD.NX. (name on the -20)
22 OPRQSR Mar-26-79 Add IDENTIFY Command and remove Tape stuff from
the MOUNT command
23 OPRQSR Apr-5-79 Check Privileges on SET Job Command
24 OPRQSR Apr-8-79 Add Message on SET JOB commands
25 OPRQSR Apr-10-79 Add Support for new SHOW options for TAPE and
DISK
26 OPRQSR Apr-12-79 Add SWITCH Command for the -20
27 OPRQSR Apr-23-79 Add Scheduler Commands for the -20
30 OPRQSR May-2-79 Fix SHOW STATUS <OBJECT> to only show remote
Nodes
31 OPRQSR May-8-79 Add SHOW STATUS/PARAMETERS OF NETWORK-NODES
and START Node command
32 OPRQSR Jun-12-79 Remove AC PB from this module
33 OPRQSR Jul-9-79 Remove the MOUNT command
34 OPRQSR Jul-10-79 Fix Suppres Bug
35 OPRQSR Jul-11-79 Remove the UNLOAD command and add new DISMOUNT
command
36 OPRQSR Jul-24-79 Fix SET DISK ... UNAVAILABLE
37 OPRQSR Aug-9-79 Allow SHUTDOWN node without DN60 support
40 OPRQSR Aug-23-79 Add SET NODE SIGNON and NO-SIGNON-REQUIRED
for DN60
41 OPRQSR Sept-12-79 Support Terminals and Tapes on START command
with /DEVICE
42 OPRQSR Oct-8-79 Add LOCK,UNLOCK and ENABLE/DISABLE ASR
Also add SHOW STATUS STRUCTURE Command
43 OPRQSR Oct-15-79 Make GETTAP also check DV.DSK and return true
44 OPRQSR 20-Dec-79 Add MODIFY <system lists> messages
45 OPRQSR 08-Jan-80 Add SHOW ALLOCATION
46 OPRQSR 28-Apr-80 Add SET USAGE command
47 OPRQSR 14-Apr-80 Merge edit 43 from TOPS20 sources for backspace
and forwardspace. The /FILE option no longer
accepts a numeric argument
50 OPRQSR 25-JUN-80 Fix, once and for all, the SETUSG routine.
51 OPRQSR 5-AUG-80 SPR 20-14504 Change .SICNT to .SICTR to
avoid symbol conflicts
52 OPRQSR 6-OCT-80 ADD * TO CANCEL MOUNT COMMAND
53 OPRQSR 24-Nov-80 Change the syntax of the ROUTE command to
reflect new capability.
OPRQSR 25-Oct-80 Make SETTAP verify that a tape device was
specified
54 OPRQSR 2-Dec-80 Fix the ROUTE command to eat the node switch
55 OPRQSR 3-Dec-80 Do range checking in FINOBJ
56 OPRQSR 15-Dec-80 Change O$xxxx to proper OPRENB
calls.
57 OPRQSR 11-Dec-80 Remove call to OPRENB in order to
allow SHOW commands to work for all
OPR's
60 OPRQSR 20-Dec-80 Add /USER switch to the show queues command.
61 OPRQSR 5-Jan-81 Add all units to destination of route command
62 OPRQSR 6-Jan-81 Add support for /NO-SESSION-ENTRIES
63 OPRQSR 16-Feb-81 Let remote operators change printer parameters
64 3/11/81 Fix PROSHW to permit common show code to work.
65 3/19/81 Change SHWQ.4 so privs are not needed for the queue command
Also remember that we have a node name specified.
Change DV.MTA reference to generic DV%MTA
66 8/20/81 Add support for /ABORT on SET TAPE INITIALIZE (TOPS10)
67 11/1/81 Remove signon/nosignon dispatch table entries from set node.
Add processing of signon/nosignon switches to define node command.
70 11/4/81 Have Q$SHWQ save the short/all flags in .OFLAG(MO) instead
of T1 since it gets clobbered by called routines.
71 11/11/81 Don't validate tape or disk devices on RECOGNIZE commands.
72 12/8/81 Change reference of DF.TYP to DF.TPP due to symbol conflict
on the 10.
73 1-FEB-82 Fix QAR #10-06813 at PUSERS + 6 lines.
74 18-Mar-82 Add support for MOUNT FOO:/WRITE-LOCKED. GCO 1273
\
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR OPRQSR
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. Q$SHUT Process SHUTDOWN command.......................... 3
; 3. Q$CONT Process CONTINUE command.......................... 3
; 4. Q$STAR Process START command............................. 3
; 5. Q$PAUS Process the PAUSE command......................... 3
; 6. ARGRTN Setup an argument header.......................... 4
; 7. CMDEND Process end of command and send the message....... 5
; 8. BLDOBJ Build an object block............................. 6
; 9. FINOBJ Finish object block after type field.............. 6
; 10. Q$FSPA Process FORWARDSPACE command...................... 7
; 11. Q$BSPA Process BACKSPACE command......................... 7
; 12. LPTOBJ Setup printer object block........................ 7
; 13. Q$ALGN Process ALIGN command............................. 8
; 14. Q$SUPP Process suppress command.......................... 9
; 15. Q$ABOR Process ABORT command............................. 10
; 16. PREQNM Process /REQUEST switch........................... 11
; 17. PREASN Process /REASON switch............................ 11
; 18. PUSER Process USER block................................ 11
; 19. Q$REQU Process REQUEUE command........................... 12
; 20. Q$ROUT Process ROUTE command............................. 13
; 21. Q$RELE Process RELEASE command........................... 15
; 22. Q$HOLD Process HOLD command.............................. 15
; 23. PQTYPE Process QUEUE type field.......................... 15
; 24. PNODSW Process /NODE switch.............................. 16
; 25. CNODSW Validate a /NODE switch........................... 16
; 26. GNODSW Get /NODE argument if present..................... 16
; 27. Q$CANC Process CANCEL command............................ 17
; 28. CHKRMT Check for remote node input....................... 18
; 29. Q$MODI Process MODIFY command............................ 19
; 30. Q$SET Process the SET command........................... 20
; 31. SETUSG Process SET USAGE command......................... 21
; 32. SETJOB Set operator values for a job..................... 22
; 33. SETxxx Process SET PARAMETERS............................ 23
; 34. SETONL Process SET ONLINE command (TOPS20)............... 24
; 35. SETSCH Process SET SCHEDULER command (TOPS20)............ 25
; 36. SCHED Do the SKED% JSYS (TOPS20)........................ 25
; 37. SCHBAT Process SET SCHEDULER BATCH command (TOPS20)...... 26
; 38. SCHCLS Process SET SCHEDULER CLASS command (TOPS20)...... 27
; 39. SETNOD Process SET NODE command (DN60)................... 28
; 40. SETDSK Process SET DISK command (TOPS20)................. 29
; 41. SETTAP Process SET TAPE command (TOPS20)................. 30
; 42. PSTAPE Process tape drive argument....................... 31
; 43. PSTRUC Process structure argument........................ 31
; 44. PVOLID Process volume-id argument........................ 31
; 45. PSDEVI Process a device argument......................... 31
; 46. SETINI Process SET TAPE INITIALIZE command............... 32
; 47. SETDEN Process /DENSITY switch........................... 33
; 48. SETLBT Process /LABEL switch............................. 33
; 49. SETOVR Process /OVERIDE switch........................... 33
; 50. SETOWN Process /OWNER switch............................. 34
; 51. SETPRO Process /PROTECTION switch........................ 34
; 52. SETCNT Process /COUNT switch............................. 34
; 53. SETINC Process /INCREMENT switch......................... 34
; 54. SETSVI Process /START switch............................. 34
; 55. SETTDP Process /TAPE-DISPOSITION switch.................. 34
; 56. SETVID Process /VOLUME-ID switch......................... 35
; 57. TABSRC Table search routine.............................. 36
; 58. GETDES Get device designator word........................ 37
; 59. GETTAP Get a tape device................................. 38
; 60. SETSTR Process SET STRUCTURE command (TOPS20)............ 39
; 61. Q$SHWS Process SHOW STATUS command....................... 40
; 62. Q$SHWP Process SHOW PARAMETERS command................... 40
; 63. PROSHW Process SHOW STATUS and SHOW PARAMETERS........... 41
; 64. SHWNOD Process node for SHOW STATUS/PARAMETERS command... 42
; 65. SHWTAP Process SHOW STATUS TAPE command.................. 43
; 66. SHWSTR Process SHOW STATUS STRUCTURES command............ 44
; 67. SHWDSK Process SHOW STATUS DISK command.................. 45
; 68. Q$SHWQ Process SHOW QUEUES command....................... 46
; 69. Q$SHWC Process SHOW CONTROL-FILE command................. 47
; 70. Q$DISM Process DISMOUNT command (TOPS20)................. 48
; 71. Q$RECO Process RECOGNIZE command (TOPS10)................ 48
; 72. Q$UNLO Process UNLOAD command............................ 48
; 73. Q$ESTR Process ENABLE AUTOMATIC-STRUCTURE-RECOGNITION.... 49
; 74. Q$ETAP Process ENABLE TAPE command....................... 50
; 75. Q$DTAP Process DISABLE TAPE command...................... 50
; 76. Q$LOCK Process LOCK command.............................. 51
; 77. Q$ULOC Process UNLOCK command............................ 51
; 78. Q$MOUN Process MOUNT TAPE and DISK command............... 52
; 79. Q$IDEN Process IDENTIFY command.......................... 53
; 80. Q$DEFI Process DEFINE command (DN60)..................... 54
; 81. Q$SWIT Process SWITCH command (TOPS20)................... 55
; 82. Q$MODS Process MODIFY SYSTEM-LISTS command (TOPS10)...... 56
; 83. Q$SLST Process SHOW SYSTEM-LISTS command (TOPS10)........ 57
; 84. Q$SALC Process SHOW ALLOCATION command (TOPS10).......... 58
SUBTTL Q$SHUT Process SHUTDOWN command
;THIS ROUTINE WILL SEND THE APPROPRIATE OBJECT BLOCK TO QUASAR
;FOR THE DESIRED FUNCTION..
;THE ROUTINE IS CALLED WITH S1 CONTAINING THE MESSAGE TYPE
Q$SHUT:: $CALL BLDOBJ ;BUILD THE OBJECT
JUMPT CMDEND ;FINISH OFF COMMAND
$CALL P$KEYW ;CHECK FOR KEYWORD
JUMPF E$IFC ;ERROR..RETURN
CAIE S1,.KYNOD ;WAS IT A NODE
$RETF ;BAD COMMAND
$CALL CNODSW ;YES, TACK IT ON
$RETIF ;CAN'T
PJRST CMDEND ;END THE COMMAND
SUBTTL Q$CONT Process CONTINUE command
Q$CONT:: $CALL BLDOBJ ;BUILD AN OBJECT BLOCK
$RETIF ;RETURN FALSE BACK UP
PJRST CMDEND ;CHECK FOR END AND SEND MESSAGE
SUBTTL Q$STAR Process START command
;THE START COMMAND IS THE SAME AS THE SHUTDOWN, CONTINUE
; COMMANDS EXCEPT THAT THE START COMMAND FOR PRINTERS
;CAN HAVE AN OPTIONAL DEVICE FIELD.
Q$STAR:: $CALL Q$SHUTDN ;PROCESS THE!FIRST PART
$RETIT ;O.K..COMMAND FINISHED
MOVE S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;GET THE OBJECT TYPE
CAIE S1,.OTLPT ;IS IT A PRINTER?
$RETF ;NO..INVALID MESSAGE
$CALL P$SWIT ;IS THERE A SWITCH?
$RETIF ;NO..INVALID COMMAND
CAIE S1,.SWDEV ;WAS IT DEVICE?
$RETF ;NO..ERROR
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
PJRST CMDEND ;NO CHECK FOR END AND RETURN
SUBTTL Q$PAUS Process the PAUSE command
Q$PAUS:: $CALL BLDOBJ ;BUILD AN OBJECT BLOCK
$RETIF ;RETURN FALSE BACK UP
$CALL P$KEYW ;DO WE HAVE A KEYWORD ???
JUMPF STOP.1 ;NO,,DEFAULT TO IMMEDIATE
CAXN S1,.KYIMM ;IS IT IMMEDIATELY ???
JRST STOP.1 ;YES,,SAY SO
CAXE S1,.KYAFT ;NOT IMMEDIATE,,MUST BE AFTER !!!
$RETF ;NO,,RETURN AN ERROR
$CALL P$KEYW ;GET THE NEXT KEYWORD
$RETIF ;NOT THERE,,THATS AN ERROR
MOVX S2,ST.ACR ;DEFAULT TO CURRENT REQUEST
CAXN S1,.KYAER ;UNLESS IT IS EVERY REQUEST
MOVX S2,ST.AER ;THEN MAKE IT EVERY REQUEST
SKIPA ;SKIP OVER IMMEDIATE STATUS
STOP.1: MOVX S2,ST.IMM ;GET IMMEDIATE STATUS BIT
MOVEM S2,.OFLAG(MO) ;SAVE FLAG BITS
PJRST CMDEND ;CHECK FOR END AND SEND MESSAGE
SUBTTL Q$NEXT - NEXT COMMAND PROCESSOR
Q$NEXT:: $CALL BLDOBJ ;[NXT] BUILD AN OBJECT BLOCK
$RETIF ;[NXT] RETURN FALSE BACK UP
$CALL P$KEYW ;[NXT] DO WE HAVE A KEYWORD ???
$RETIF ;[NXT] ERROR..RETURN
CAXE S1,.KYRQN ;[NXT] MUST BE REQUEST-ID !!!
$RETF ;[NXT] NO,,THATS AN ERROR
$CALL PREQNM ;[NXT] PROCESS REQUEST NUMBER
$RETIF ;[NXT] ERROR..RETURN
PJRST CMDEND ;[NXT] FINISH OFF COMMAND
SUBTTL ARGRTN Setup an argument header
;THIS ROUTINE WILL SETUP THE ARGUMENT HEADER FROM THE
;TYPE IN S1 AND THE LENGTH IN S2. IT WILL ALSO ADVANCE P3 TO NEXT
;LOCATION IN MESSAGE AND BUMP ARGUMENT COUNT FOR MESSAGE
ARGRTN: STORE S1,ARG.HD(P3),AR.TYP ;SAVE THE TYPE FIELD
STORE S2,ARG.HD(P3),AR.LEN ;SAVE THE LENGTH
AOS .OARGC(MO) ;BUMP ARGUMENT COUNT
ADD P3,S2 ;BUMP TO NEXT FREE LOCATION
$RETT ;O.K...RETURN TRUE
SUBTTL CMDEND Process end of command and send the message
;THIS ROUTINE WILL CHECK FOR END OF COMMAND AND IF O.K
;PREPARE MESSAGE TO BE SENT TO QUASAR
CMDEND: $CALL P$CFM ;CHECK FOR CONFIRM
$RETIF ;NO..INVALID MESSAGE
ANDI P3,777 ;GET MESSAGE LENGTH
STORE P3,.MSTYP(MO),MS.CNT ;SAVE MESSAGE SIZE IN MESSAGE
PJRST SNDQSR ;SEND THE MESSAGE TO QUASAR
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
$RETIF ;NOT A KEYWORD..INVALID..RETURN
CAILE S1,.OTMAX ;LESS THAN OR EQUAL VALID OBJECT
JRST BLDO.6 ;INVALID TYPE..RETURN
CAIE S1,.OTBAT ;WAS IT A BATCH BLOCK
JRST BLDO.1 ;NO..IGNORE CHECK
MOVE P1,S1 ;SAVE THE NUMBER
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
$RETIF ;RETURN FALSE..PASSING RETURN UP
TLNE S1,-1 ;Ligit number? (Fit in half word)
PJRST E$IRS ;No - fake user with illeg. range
STORE S1,ARG.DA+OBJ.UN(P3),OU.LRG ;SAVE AS LOW RANGE
MOVE P1,S1 ;SAVE THE LOW RANGE
$CALL P$TOK ;CHECK FOR TOKEN AND RANGE
JUMPF BLDO.2 ;NO..CHECK FOR NODE
;IGNORE TOKEN
$CALL P$NUM ;GET THE OTHER NUMBER
$RETIF ;INVALID FIELD..NUMBER NEEDED
CAML P1,S1 ;CHECK FOR VALID RANGE
PJRST E$IRS ;UNITS OUT OF RANGE
TLNE S1,-1 ;Ligit number? (Fit in half word)
PJRST E$IRS ;No - fake user with illeg. range
STORE S1,ARG.DA+OBJ.UN(P3),OU.HRG ;SAVE THE HIGH RANGE
BLDO.2: ZERO ARG.DA+OBJ.ND(P3) ;INITIALIZE NODE FIELD
$CALL P$SWIT ;GET A SWITCH
JUMPF BLDO.4 ;NOT A SWITCH,,CHECK CONFIRM
CAIE S1,.SWNOD ;WAS IT A NODE
JRST BLDO.3 ;NO..SETUP NODE VALUE IN BLOCK
$CALL P$NODE ;GET THE NODE
JUMPF BLDO.3 ;GET NODE FROM NODE ENTRY
MOVE P1,S1 ;SAVE THE NODE DATA
PJRST BLDO.5 ;SAVE NODE AND RETURN
BLDO.3: $CALL P$PREV ;POSITION TO THE PREVIOUS ONE
;ON INPUT
BLDO.4: MOVE T1,G$OPRA ;GET OPERATOR ENTRY ADDRESS
MOVE T1,OPR.ND(T1) ;GET NODE ADDRESS
MOVE P1,NOD.NX(T1) ;GET NODE NAME ON -20
BLDO.5: STORE P1,ARG.DA+OBJ.ND(P3) ;SAVE THE NODE NAME
MOVE S1,P1 ;Copy affected node
$CALL OPRENB ;See if ok for this OPR
$RETIF ;No..return the failure
MOVX S1,.OROBJ ;TYPE OF DATA ELEMENT..OBJ BLOCK
MOVX S2,.OBJLN ;SIZE OF THE BLOCK
PJRST ARGRTN ;SETUP HEADER,COUNT, POINTER..RETT
BLDO.6: $CALL P$PREV ;POSITION TO THE PREVIOUS ONE
$RETF ;RETURN FALSE
SUBTTL 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) ;GET MESSAGE TYPE
CAXE S1,.OTLPT ;PRINTER?
$RETF ;NO, LOSE
$RETT ;RETURN TRUE
SUBTTL Q$ALGN Process ALIGN command
;THIS ROUTINE WILL PROCESS AN ALIGN COMMAND FROM OPR
Q$ALGN:: $CALL LPTOBJ ;SETUP LINE PRINTER OBJECT BLOCK
$RETIF ;ERROR..RETURN
$CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF ALIG.3 ;NO..CHECK FOR A FILE
CAIE S1,.SWSTP ;WAS IT A STOP
JRST ALIG.2 ;NO..TRY OTHER VALUES
MOVX S1,.ALSTP ;GET THE STOP ARGUMENT TYPE
MOVEI S2,1 ;SETUP FIELD LENGTH
$CALL ARGRTN ;SETUP ARGUMENT IN MESSAGE
PJRST CMDEND ;FINISH OFF THE COMMAND
ALIG.1: $CALL P$SWIT ;GET A SWITCH
JUMPF ALIG.3 ;CHECK FOR A FILE
ALIG.2: MOVEI S2,ALIDSP ;GET ALIGN TABLE
$CALL TABSRC ;CHECK THE TABLE
$RETIF ;ERROR..RETURN
MOVE T2,S2 ;SAVE THE VALUE
$CALL P$NUM ;GET A NUMBER
$RETIF ;ERROR..RETURN
STORE S1,ARG.DA(P3) ;SAVE NUMBER IN ARGUMENT BLOCK
MOVEI S2,ARG.SZ ;GET ARGUMENT SIZE
MOVE S1,T2 ;GET FUNCTION TYPE
$CALL ARGRTN ;SAVE THE ARGUMENT AND UPDATE COUNTERS
JRST ALIG.1 ;CHECK NEXT FIELD
ALIG.3: $CALL P$IFIL ;CHECK FOR INPUT FILE
JUMPF CMDEND ;NO..CHECK FOR END OF COMMAND
$CALL MOVARG ;YES..MOVE FD AND HEADER FOR OUTPUT
JRST ALIG.1 ;CHECK THE NEXT FIELD
ALIDSP: $STAB
.SWRPT,,.ALRPT ;REPEAT COUNT
.SWPAU,,.ALPAU ;PAUSE COUNT
$ETAB
SUBTTL Q$SUPP Process suppress command
Q$SUPP:: $CALL LPTOBJ ;SETUP LINE PRINTER OBJECT BLOCK
$RETIF ;ERROR..RETURN
$CALL P$SWIT ;CHECK FOR A SWITCH
MOVEI S2,SUPDSP ;ADDRESS OF THE TABLES
SKIPT ;SKIP IF O.K.
MOVEI S1,.SWJOB ;ASSUME JOB AS DEFAULT
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVE S1,S2 ;PLACE TYPE IN S1
MOVEI S2,1 ;LENGTH OF ARGUMENT IN S2
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH THE COMMAND
SUPDSP: $STAB
.SWFIL,,.SUPFL ;FILE
.SWJOB,,.SUPJB ;JOB
.SWSTP,,.SUPST ;STOP
$ETAB
SUBTTL Q$ABOR Process ABORT command
;THIS ROUTINE WILL PROCESS A ABORT COMMAND AND SEND THE
;APPROPRIATE MESSAGE TO QUASAR
Q$ABOR:: $CALL BLDOBJ ;GET AN OBJECT BLOCK SETUP
$RETIF ;NO..RETURN..BAD MESSAGE
MOVEI T1,.OHDRS+ARG.DA(MO) ;ADDRESS OF ARGUMENT BLOCK
LOAD S1,OBJ.UN(T1),OU.HRG ;GET HIGH RANGE
JUMPN S1,.RETF ;NON-ZERO..RETURN FALSE
ABOR.1: $CALL P$SWIT ;GET A SWITCH IF ANY
JUMPF CMDEND ;NO..CHECK FOR CONFIRM AND SEND
CAIE S1,.SWREQ ;/REQUEST NUMER SWITCH
JRST ABOR.3 ;PROCESS SEQUENCE SWITCH
$CALL PREQNM ;PROCESS REQUEST NUMBER
$RETIF ;ERROR RETURN
ABOR.2: $CALL P$SWIT ;CHECK FOR SWITCH
JUMPF CMDEND ;ERROR..CHECK FOR END
ABOR.3: MOVEI S2,ABODSP ;ABORT TABLE ADDRESS
$CALL TABSRC ;SEARCH THE TABLE
JUMPT ABOR.4 ;O.K..CONTINUE ON
CAIN S1,.SWRSN ;/REASON SWITCH
JRST ABOR.5 ;PROCESS REASON SWITCH
$RETF ;INVALID COMMAND
ABOR.4: MOVEM S2,ARG.DA(P3) ;SAVE THE DATA FIELD
MOVX S1,.CANTY ;GET ABORT TYPE
MOVX S2,ARG.SZ ;GET ARGUMENT SIZE
$CALL ARGRTN ;SETUP ARGUMENT HEADER AND COUNTS
JRST ABOR.2 ;GET NEXT FIELD
ABOR.5: $CALL PREASN ;PROCESS THE REASON SWITCH
$RETIF ;NO...ERROR..RETURN
PJRST CMDEND ;CHECK FOR COMMAND END AND RETURN
ABODSP: $STAB
.SWPUR,,.CNPRG ;/PURGE
.SWERR,,.CNERR ;/ERROR
.SWNER,,.CNNER ;/NOERROR
$ETAB
SUBTTL PREQNM Process /REQUEST switch
;PROCESS /REQUEST SWITCH
PREQNM: $CALL P$NUM ;GET A NUMBER
$RETIF ;NO..RETURN FALSE
PREQ.1: STORE S1,ARG.DA(P3) ;SAVE THE NAME IN MESSAGE
MOVX S1,.ORREQ ;GET JOBNAME TYPE
MOVX S2,ARG.SZ ;SIZE OF THE ARGUMENT
PJRST ARGRTN ;SETUP ARGUMENT HEADER AND COUNTS
SUBTTL PREASN Process /REASON switch
;PROCESS /REASON TEXT DATA
PREASN: $CALL P$TEXT ;GET A TEXT ARGUMENT
$RETIF ;NO..RETURN
MOVX T1,.ORREA ;GET REASON TYPE
STORE T1,ARG.HD(S1),AR.TYP ;SAVE CORRECT TYPE IN HEADER
$CALL MOVARG ;BUILD TEXT ARGUMENT AND UPDATE COUNTS
$RETT ;RETURN TRUE
SUBTTL PUSER/PUSERS Process USER block/switch
PUSER: MOVX S1,.CMUSR ;Get user block
SKIPA ;Skip other entry point
PUSERS: MOVX S1,.LSUSR ;List user switch
PUSH P,S1 ;Save it a sec
;Common work
$CALL P$USER ;GET USER DATA
JUMPF [POP P,(P) ;ERROR,,PHASE STACK
$RETF ] ;AND RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE DATA
POP P,S1 ;GET USER TYPE
MOVX S2,ARG.SZ ;SIZE OF THE ARGUMENT
PJRST ARGRTN ;SAVE THE ARGUMENT
SUBTTL Q$REQU Process REQUEUE command
;THIS ROUTINE WILL ANALYSZE A REQUEUE COMMAND AND SEND THE
;APPROPRIATE MESSAGE TO QUASAR
Q$REQU:: $CALL BLDOBJ ;SETUP OBJECT BLOCK
$RETIF ;ERROR IF NOT SETUP..RETURN
MOVEI T1,.OHDRS+ARG.DA(MO) ;GET THE ARGUMENT BLOCK
LOAD S1,OBJ.UN(T1),OU.HRG ;GET HIGH VALUE
JUMPN S1,.RETF ;RANGE NOT ALLOWED
MOVE P1,OBJ.TY(T1) ;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
$RETF ;INVALID COMMAND..RETURN
REQU.4: $CALL PREASN ;PROCESS THE REASON FLAG
$RETIF ;ERROR..RETURN
JRST REQU.7 ;CHECK FOR A CONFIRM
REQU.5: CAIN P1,.OTBAT ;CHECK FOR BATCH
JRST REQU.7 ;YES..CHECK FOR A CONFIRM
$CALL P$KEYW ;PRINTER..CHECK FOR KEYWORD
SETOM T1 ;SETUP FLAG FOR SWITCHES
JUMPF REQU.8 ;CHECK FOR END OF MESSAGE
CAIE S1,.KYBEG ;BEGINNING-OF KEYWORD
JRST REQU.6 ;CHECK FOR CURRENT POSITION
$CALL P$KEYW ;GET BEGINNING OPRION
$RETIF ;NOT..KEYWORD..ERROR
CAIN S1,.KYCPY ;IS IT COPY
MOVEI T1,.RQBCP ;BEGINNING OF COPY
CAIN S1,.KYJOB ;IS IT JOB
MOVEI T1,.RQBJB ;BEGINNING OF JOB
CAIN S1,.KYFIL ;IS IT FILE
MOVEI T1,.RQBFL ;BEGINNING OF FILE
REQU.6: CAIN S1,.KYCUR ;CURRENT-POSITION
MOVEI T1,.RQCUR ;CURRENT POSITION
JUMPL T1,.RETF ;INVALID KEYWORD
STORE T1,ARG.DA(P3) ;SAVE VALUE IN MESSAGE
MOVX S1,.REQTY ;KEY ARGUMNET BLOCK TYPE
MOVX S2,ARG.SZ ;GET ARGUMENT SIZE
$CALL ARGRTN ;SETUP ARGUMENT AND COUNTS
$CALL P$SWIT ;GET A SWITCH
JUMPF REQU.7 ;CHECK FOR CONFIRM
CAIE S1,.SWRSN ;IS IT REASON
$RETF ;RETURN FALSE
JRST REQU.4 ;PROCESS THE REASON SWITCH
REQU.7: PJRST CMDEND ;FINISH THE COMMAND
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
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,OBJ.SZ+1 ;AND THE BLOCK LENGTH
$CALL ARGRTN ;AND UPDATE THE MESSAGE
$CALL P$NODE ;GET THE DESTINATION NODE NAME
JUMPF ROUT.3 ;NOT THERE,,MIGHT BE 'DELETE' FUNCTION
SETOM ARG.DA+OBJ.UN(P3) ;Save all unit types
;Common completion code
ROUT.2: MOVEM S1,ARG.DA+OBJ.ND(P3) ;SAVE IT IN THE OBJECT BLOCK
$CALL OPRENB ;Check OPR's privs
$RETIF ;NO,,RETURN
MOVE S1,OBJDEV ;Get the source device type
MOVEM S1,ARG.DA+OBJ.TY(P3) ;Save the object types
MOVX S1,.RTETO ;GET THE BLOCK TYPE
MOVX S2,OBJ.SZ+1 ;GET THE BLOCK LENGTH
$CALL ARGRTN ;UPDATE THE MESSAGE
ROUT.3: $CALL CMDEND ;Send it off
$RET ;Return preserving previous return
;Process a route command for a specific device
ROUT.4: $CALL P$NUM ;GET THE UNIT NUMBER
JUMPF ROUT.5 ;NOT THERE,,MIGHT HAVE SAID 'ALL'
CAXLE S1,77 ;IS IT VALID ???
$RETF ;NO,,RETURN
JRST ROUT.6 ;YES,,CONTINUE
ROUT.5: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;NOT THERE,,THATS AN ERROR
CAXE S1,.KYALL ;IS IT 'ALL' ???
$RETF ;NO,,THATS AN ERROR
SETOM S1 ;Make this all units
ROUT.6: MOVEM S1,ARG.DA+OBJ.UN(P3) ;SAVE IT IN THE OBJECT BLOCK
$CALL P$SWIT ;Get the node switch
JUMPF ROUT.7 ;No switch- thats ok
CAIE S1,.SWNOD ;It must be a node switch however.
$RETF ;It isn't!
$CALL P$NODE ;GET THE SOURCE NODE if any
JUMPT ROUT.8 ;Go to set node name
;Since no node was specified, get the OPR's node
ROUT.7: MOVE S1,G$OPRA ;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
ROUT.8: MOVEM S1,ARG.DA+OBJ.ND(P3) ;AND SAVE THE SOURCE NODE
$CALL OPRENB ;Check OPR's privs
$RETIF ;NO,,RETURN
MOVX S1,.RTEFM ;GET THE BLOCK TYPE
MOVX S2,OBJ.SZ+1 ;AND THE BLOCK LENGTH
$CALL ARGRTN ;AND UPDATE THE MESSAGE
;Get destination information
$CALL P$NUM ;Get the destination unit number
JUMPF [$CALL P$KEYW ;Try to get a keyword
JUMPF ROUT.3 ;None -- check for delete function
CAXE S1,.KYALL ;Is it "ALL"?
$RETF ;No - return bad
SETOM S1 ;Make it all units
JRST ROUT.A] ;Continue
ROUT.A: CAXLE S1,77 ;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 ROUT.9 ;No switch- thats ok
CAIE S1,.SWNOD ;It must be a node switch however.
$RETF ;It isn't!
$CALL P$NODE ;GET THE DESTINATION NODE NAME
JUMPT ROUT.2 ;Go join the common code for
; processng the destination node info
;Since no node was specified, get the OPR's node
ROUT.9: MOVE S1,G$OPRA ;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 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
PJRST CMDEND ;CHECK FOR THE END
HOLD.3: $CALL PUSER ;PROCESS USER FIELD
JUMPF HOLD.4 ;CHECK OUT * OR /NODE
PJRST CMDEND ;END THE MESSAGE
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
$RETIF ;ERROR .. RETURN
PJRST CMDEND ;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) ;SAVE THE VALUE
MOVX S1,.ORNOD ;GET THE NODE BLOCK TYPE
MOVX S2,ARG.SZ ;AND BLOCK SIZE
PJRST ARGRTN ;SAVE ARGUMENT AND RETURN
SUBTTL GNODSW Get /NODE argument if present
;THIS ROUTINE WILL GET NODE SWITCH IF PRESENT AND RETURN VALUE
;IN S1 OR RETURN FALSE IF NOT THERE
GNODSW: $CALL P$SWIT ;CHECK FOR A SWITCH
$RETIF ;NOT..RETURN FALSE
CAIE S1,.SWNOD ;WAS IT A NODE
$RETF ;NO..RETURN FALSE
$CALL P$NODE ;GET THE NODE FIELD
$RET ;RETURN..PASSING CODE OR VALUE
SUBTTL Q$CANC Process CANCEL command
Q$CANC:: $CALL CHKRMT ;CHECK IF FROM REMOTE AND ADD
; NODE BLOCK IF LOCAL OR REMOTE
$CALL OPRENB ;Check OPR privs
$RETIF ;Return on error
$CALL P$KEYW ;GET THE QUEUE TYPE
$RETIF ;ERROR...RETURN
CAIN S1,.KYMNT ;WAS IT A MOUNT REQUEST
JRST CANC.1 ;PROCESS CANCEL OF MOUNT REQUESTS
SETZM P1 ;SET FLAG FOR ALL DATA
PJRST HOLD.1 ;FINISH OFF COMMAND
CANC.1: MOVX S1,.ODDMT ;SET CANCEL MOUNT REQUEST TYPE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL PREQNM ;WAS IT A REQUEST NUMBER
JUMPT CANC.2 ;PROCESS THE REASON IF PRESENT
$CALL PSTRUC ;GET THE STRUCTURE NAME
JUMPT CANC.2 ;WIN,,CHECK FOR REASON
$CALL P$TOK ;GET A TOKEN
$RETIF ;ERROR ..RETURN
SETOM S1 ;YES..ASSUME * -1 FOR ALL REQUESTS
$CALL PREQ.1 ;SAVE ARGUMENT
CANC.2: $CALL P$SWIT ;WAS THERE A SWITCH
JUMPF CMDEND ;NO..CHECK END OF COMMAND
CAIE S1,.SWRSN ;WAS IT /REASON: ??
$RETF ;NO..RETURN FALSE
$CALL PREASN ;PROCESS THE REASON
JUMPT CMDEND ;O.K FINISH OFF MESSAGE
$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 .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 .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
PLTDSP:
CDPDSP:
PTPDSP: XWD .KYFOT,[[ARG.SZ,,.STFRM],,SETFRM] ;FORMS-TYPE
XWD .KYLEA,[[ARG.SZ,,.STLEA],,SETLEA] ;LIMIT-EXCEED-ACTION
XWD .KYOPL,[[ARG.SZ+1,,.STOPL],,SETOPL] ;OUTPUT-LIMITS
XWD .KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
CDPCNT==.-CDPDSP
PTPCNT==.-PTPDSP
PLTCNT=.-PLTDSP
SUBTTL SETUSG Process SET USAGE command
TOPS10 <
SETUSG: SETOM S1 ;Get ALL nodes
$CALL OPRENB ;Check OPR privs
$RETIF ;Return on failure
$CALL P$KEYW
JUMPF E$IFC
MOVEI S2,USGTBL ;POINT TO KEY TABLE
$CALL TABSRC ;FIND THE KEYWORD
JUMPF E$IFC ;BAD FORMAT
STORE S2,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
CAXE S2,UGUFC$ ;IS THIS FILE CLOSURE ???
JRST SETU.1 ;NO,,FINISH UP !!!
PUSHJ P,P$KEYW ;GET THE NEXT KEYWORD
JUMPF SETU.1 ;NOT A KEYWORD,,TRY FOR A TIME !!!
CAXN S1,.KYNOW ;IS IT NOW ???
JRST [MOVX S1,US.NOW ;YES,,GET 'NOW' FLAG BIT
MOVEM S1,.OFLAG(MO) ;SAVE IT
PUSHJ P,I%NOW ;GET CURRENT TIME
JRST SETU.2 ] ;AND CONTINUE
CAXN S1,.KYDLY ;IS IT DAILY ???
JRST [MOVX S1,US.DLY ;YES,,GET 'DAILY' FLAG BIT
MOVEM S1,.OFLAG(MO) ;SAVE IT
JRST SETU.1 ] ;AND CONTINUE
CAXE S1,.KYWKY ;IS IT WEEKLY ???
JRST E$IFC ;NO,,THATS AN ERROR
PUSHJ P,P$KEYW ;GET THE DAY OF THE WEEK
JUMPF E$IFC ;NOT THERE,,THATS AN ERROR
CAIL S1,0 ;VALIDATE THE DAY - MUST BE BETWEEN
CAILE S1,6 ; ONE AND SEVEN...
JRST E$IFC ;NO,,THATS AN ERROR
TXO S1,US.WKY ;LITE 'WEEKLY' FLAG BIT
MOVEM S1,.OFLAG(MO) ;SAVE IT
SETU.1: $CALL P$TIME ;GET THE TIME
JUMPF E$IFC ;NOT THERE,,THATS AN ERROR !!!
SETU.2: MOVEM S1,ARG.DA(P3) ;SAVE THE UDT
MOVX S1,.ORTIM ;TIME BLOCK
MOVEI S2,ARG.SZ ;GET THE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
$CALL P$SWITCH ;LOOK FOR A SWITCH
JUMPF SETU.3 ;NONE,,MIGHT STILL BE OK
CAXE S1,.SWNOS ;IS IT /NO-SESSION-ENTRIES ???
JRST E$IFC ;NO,,THATS AN ERROR
MOVX S1,US.NOS ;YES,,GET FLAG BIT
IORM S1,.OFLAG(MO) ; AND LIGHT IT
SETU.3: $CALL P$CFM ;DO WE HAVE CONFIRM ???
JUMPF E$IFC ;NO,,THATS AN ERROR
ANDI P3,777 ;GET MESSAGE LENGTH
STORE P3,.MSTYP(MO),MS.CNT ;SAVE MESSAGE SIZE IN MESSAGE
$CALL SNDACT ;SEND THE MESSAGE OFF TO THE ACTDAE
$RETIT ;WIN,,RETURN
PJRST E$SAF ;SAY IT FAILED
USGTBL: $STAB
.KYUBC,,UGEBC$ ;BILLING-CLOSURE
.KYUFC,,UGUFC$ ;FILE-CLOSURE
$ETAB
> ;END TOPS10
SUBTTL SETJOB Set operator values for a job
SETJOB: MOVE S1,G$HOST ;Get host name
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$NUM ;GET A NUMBER
$RETIF ;NO..ERROR..RETURN
MOVE P1,S1 ;SAVE NUMBER IN P1
MOVEM P1,G$ARG1 ;SAVE THE JOB NUMBER
$CALL P$KEYW ;GET THE SETTING KEYWORD
$RETIF ;ERROR...RETURN
MOVE P2,S1 ;SAVE KEYWORD IN P2
$CALL P$CFM ;COMMAND HAVE CONFIRM?
JUMPF SETJ.1 ;TRY CLASS SETTING
SETO T2, ;SET A FLAG
CAIN P2,.KYNOI ;WAS IT NO OPERATOR INTERVENTION
MOVEI T2,.OBNWR ;SET NO OPR INTERVENTION
CAIN P2,.KYOIA ;OPR INTERVENTION ALLOWED
MOVEI T2,.OBALL ;YES SET OPR INTERVENTION ALLOWED
JUMPL T2,.RETF ;INVALID FIELD..RETURN
TOPS10 <
MOVE S2,P1 ;PLACE JOB NUMBER IN S2
MOVE S1,[2,,S2] ;SET UP THE BLOCK
HRLI T1,.STWTO ;SET WTO INFO FUNCTION
HRR T1,T2 ;PLACE VALUE IN T1
JBSET. S1, ;PERFORM THE FUNCTION
PJRST E$SJN ;SET JOB NOT IMPLEMENTED
>;END TOPS10
TOPS20 <
MOVE S1,P1 ;GET THE JOB NUMBER
MOVX S2,.SJBAT ;UPDATE BATCH DATA
SETZ T1, ;CLEAR THE DATA WORD
STORE T2,T1,OB%WTO ;SAVE THE DATA
SETJB ;SET THE INFO
ERJMP E$SJN ;NOTE THE ERROR
>;END TOPS20
PJRST E$SJM ;SET JOB MODIFIED
TOPS10 <
SETJ.1: $RETF ;ILLEGAL COMMAND
>;END TOPS10
TOPS20 <
SETJ.1: CAIE P2,.KYCLS ;WAS IT CLASS?
$RETF ;NO..INVALID COMMAND
$CALL P$NUM ;GET THE CLASS VALUE
$RETIF ;ERROR..RETURN
MOVE T3,S1 ;PLACE CLASS IN BLOCK
MOVEM T3,G$ARG2 ;SAVE THE CLASS
MOVEI S1,.SKSCJ ;GET THE FUNCTION
MOVEI S2,T1 ;BLOCK IN T1
MOVEI T1,3 ;SIZE OF BLOCK
MOVE T2,P1 ;GET THE JOB NUMBER
SKED% ;DO THE FUNCTION
ERJMP SETJ.2 ;TRAP ERROR
PJRST E$SSJ ;SET SCHEDULER JOB O.K.
SETJ.2: MOVE S1,[EXP -2] ;GET LAST -20 ERROR
MOVEM S1,G$ARG1 ;SAVE THE VALUE
PJRST E$SJF ;SET FAILED..RETURN
>;END TOPS20
SUBTTL SETxxx Process SET PARAMETERS
SETTIM:
SETPGL:
SETOPL:
SETMEM: $CALL P$RNGE ;GET RANGE
$RETIF ;ERROR..RETURN
SETM.1: DMOVEM S1,ARG.DA(P3) ;SAVE VALUES IN MESSAGE
ADDI P3,ARG.SZ+1 ;BUMP TO NEXT FREE LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
SETPRI: $CALL P$RNGE ;GET RANGE
$RETIF ;ERROR..RETURN
MOVEM S2,G$ARG1 ;SAVE THE VALUE
CAILE S2,^D63 ;IS IT IN RANGE
PJRST E$SPI ;INVALID PRIORITY SPECIFIED
JRST SETM.1 ;FINISH OFF COMMAND
SETNOI:
SETOIA: ADDI P3,1 ;BUMP TO NEXT LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
;HERE TO SET PRINTER PARAMETERS
SETFRM: $CALL P$SIXF ;GET A 6 BIT FIELD TYPE
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE FORMS NAME IN MESSAGE
ADDI P3,ARG.SZ ;BUMP TO NEXT LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;END THE COMMAND
;HERE TO HANDLE THE PROCESSOR VERB
SETATR: $CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
MOVEI S2,PRODSP ;GET PROCESSOR TABLE
$RETIF ;ERROR..RETURN
PJRST SETL.1 ;HANDLE AS LIMITED EXCEEDED
;HERE TO HANDLE LIMIT-EXCEEDED-ACTION VERB
SETLEA: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
MOVEI S2,LEADSP ;GET LIMIT-EXCEED ACTION TABLE
SETL.1: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVEM S2,ARG.DA(P3) ;SAVE IN THE MESSAGE
ADDI P3,ARG.SZ ;BUMP THE POINTER
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
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
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
$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
>;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 ;BETTER BE DRIVE NUMBER
CAIE S1,.KYDRV ;IS IT?
$RETF ;NO..RETURN FALSE
$CALL P$NUM ;GET DRIVE NUMBER
$RETIF ;NO..ERROR..RETURN
MOVEM S1,ARG.DA+1(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,3 ;3 WORDS
$CALL ARGRTN ;SAVE THE ARGUMENT
$CALL SETAVL ;GET SET AVALIABLE FUNCTION
JUMPT CMDEND ;END THE COMMAND AND SEND TO QUASAR
$RET ;RETURN PASSING ERROR UP
>;END TOPS20
SETAVL: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
SETOM T1 ;FLAG FOR CHECKING VALUES
CAIN S1,.KYAVA ;AVAILABLE?
MOVX T1,.DVAVL ;SET DEVICE AVAILABLE BLOCK
CAIN S1,.KYUAV ;UNAVAILABLE?
MOVX T1,.DVUAV ;SET DEVICE UNAVAILABLE
SKIPGE T1 ;IS ONE SET
$RETF ;NO..ERROR..RETURN
MOVE S1,T1 ;BLOCK TYPE IN 1
MOVEI S2,1 ;BLOCK SIZE OF 1
$CALL ARGRTN ;SAVE THE BLOCK
CAIE T1,.DVUAV ;UNAVAILABLE??
$RETT ;NO..RETURN TRUE
$CALL PREASN ;PROCESS THE REASON
$RET ;PASS THE RETURN BACK
SUBTTL SETTAP Process SET TAPE command (TOPS20)
SETTAP: MOVE S1,G$HOST ;Get local host
$CALL OPRENB
$RETIF
MOVX S1,.ODSTP ;SET TAPE COMMAND FOR -20
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL P$DEV ;GET DEVICE BLOCK
$RETIF ;RETURN FALSE
DMOVE T1,S1 ;SAVE THE ARGUMENTS
$CALL GETDES ;GET DEVICE DESIGNATOR
$RETIF ;RETURN IF NOT A DEVICE
TXNN S2,DV%MTA ;TAPE DRIVE ???
PJRST E$ITD ;INVALID TAPE DRIVE
DMOVE S1,T1 ;RESTORE S1 AND S2
MOVX T1,.TAPDV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PUSHJ P,MOVARG ;MOVE THE BLOCK AND DATA
$CALL SETAVL ;SETUP AVAILABLE,UNAVAILABLE BLOCK
JUMPT CMDEND ;O.K.. FINISH THE COMMAND
PJRST SETINI ;TRY INITIALIZE
SUBTTL PSTAPE Process tape drive argument
;THIS ROUTINE WILL CHECK FOR A DEVICE AND A TAPE DRIVE AND
;SAVE A .TAPDV BLOCK IN THE MESSAGE
PSTAPE: $CALL P$DEV ;GET DEVICE BLOCK
$RETIF ;RETURN FALSE
PSTA.1: $CALL GETTAP ;GET A TAPE DEVICE
$RETIF ;NO..ERROR..RETURN
MOVX T1,.TAPDV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL PSTRUC Process structure argument
;THIS ROUTINE WILL SAVE A STRUCTURE BLOCK IN THE MESSAGE
PSTRUC: $CALL P$DEV ;GET THE DEVICE
$RETIF ;ERROR..RETURN
MOVX T1,.STRDV ;STRUCTURE TYPE
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE IN BLOCK
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL PVOLID Process volume-id argument
;THIS ROUTINE WILL BUILD A VOLUME ID BLOCK
PVOLID: $CALL P$QSTR ;CHECK FOR QUOTED STRING
JUMPT PVOL.1 ;YES..PROCESS IT
$CALL P$FLD ;CHECK FOR FIELD
$RETIF ;ERROR..RETURN
PVOL.1: MOVX T1,.VOLID ;VOLUME ID
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL PSDEVI Process a device argument
PSDEVI: $CALL P$DEV ;GET DEVICE BLOCK
$RETIF ;RETURN FALSE
DMOVE T1,S1 ;SAVE THE ARGUMENTS
$CALL GETDES ;GET THE DEVICE DESIGNATOR
JUMPF E$IDS ;NO..ERROR..RETURN
DMOVE S1,T1 ;RESTORE THE ARGUMENTS
MOVX T1,.CMDEV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
PJRST MOVARG ;MOVE THE BLOCK AND RETURN
SUBTTL SETINI Process SET TAPE INITIALIZE command
;THIS COMMAND WILL BUILD A MESSAGE FOR THE TAPE PROCESSOR
;CONTAINING THE NECESSAY INFO FOR INITIALIZING TAPES
SETINI: CAIE S1,.KYINI ;WAS IT INITIALIZE
$RETF ;NO..RETURN FALSE
MOVEI S1,.DVINI ;DEVICE INITIALIZE
MOVEI S2,1 ;GET THE TYPE
$CALL ARGRTN ;SAVE THE ARGUMENT
SETI.1: $CALL P$SWITCH ;GET A SWITCH
JUMPF CMDEND ;END THE COMMAND
MOVEI S2,SETIDP ;ADDRESS OF THE TABLE
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;PASS ERROR UP
SETI.3: HLRZ P1,(S2) ;GET BLOCK TYPE
HRRZ S2,(S2) ;GET ROUTINE ADDRESS
JRST (S2) ;PROCESS ROUTINE
SETIDP: $STAB
TOPS10< .KYCNC,,[0,,SETABO] ;/ABORT >
.SWDEN,,[.SIDEN,,SETDEN] ;/DENSITY
.SWLBT,,[.SILBT,,SETLBT] ;/LABEL-TYPE
.SWOVR,,[.SIOVR,,SETOVR] ;/OVERIDE-EXPIRATION
.SWOWN,,[.SIOWN,,SETOWN] ;/OWNER
.SWPRO,,[.SIPRO,,SETPRO] ;/PROTECTION
.SWTDP,,[0,,SETTDP] ;/TAPE-DISPOSITION
.SWCNT,,[.SICTR,,SETCNT] ;/COUNT
.SWINC,,[.SIINC,,SETINC] ;/SET INCREMENT
.SWSVI,,[.SISVI,,SETSVI] ;/STARTING-VOLUME-ID
.SWVID,,[.VOLID,,SETVID] ;/VOLUME-ID
$ETAB
SUBTTL SETDEN Process /DENSITY switch
SETDEN: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,DENTAB ;DENSITY TABLE
SETD.1: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;NO MATCH..ELSE VALUE IN S2
MOVEM S2,ARG.DA(P3) ;SAVE THE DATA
SETD.2: MOVE S1,P1 ;GET ARGUMENT TYPE
MOVX S2,ARG.SZ ;GET THE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
JRST SETI.1 ;GET NEXT FIELD
DENTAB: $STAB
.KY160,,.TFD16 ;1600
.KY625,,.TFD62 ;6250
.KY800,,.TFD80 ;800
.KY556,,.TFD55 ;556
.KY200,,.TFD20 ;200
$ETAB
SUBTTL SETLBT Process /LABEL switch
SETLBT: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,LBTTAB ;LABEL TYPE TABLE
JRST SETD.1 ;PROCESS ARGUMENT
LBTTAB: $STAB
.KYANS,,%TFANS ;ANSI LABELS
.KYEBC,,%TFEBC ;EBCDIC
TOPS20< .KYT20,,%TFT20> ;TOPS-20 LABELS
.KYUNL,,%TFUNL ;UNLABELED TAPE
$ETAB
SUBTTL SETOVR Process /OVERIDE switch
SETOVR: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,OVRDSP ;OVERIDE TABLE
SETOV1: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;PASS ERROR UP
MOVE S1,S2 ;FUNCTION CODE
MOVEI S2,1 ;ARGUMENT TYPE
$CALL ARGRTN ;SAVE THE ARGUMENT
JRST SETI.1 ;GET THE NEXT ONE
OVRDSP: $STAB
.KYYES,,.SIOVR ;OVERIDE EXPIRATION
.KYNO,,.SINOV ;NO OVERIDE
$ETAB
SUBTTL SETOWN Process /OWNER switch
SETOWN: $CALL P$USER ;GET THE USER FIELD
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE USER
JRST SETD.2 ;FINISH BLOCK AND CONTINUE
SUBTTL SETPRO Process /PROTECTION switch
SUBTTL SETCNT Process /COUNT switch
SUBTTL SETINC Process /INCREMENT switch
SUBTTL SETSVI Process /START switch
SETCNT:
SETINC:
SETSVI:
SETPRO: $CALL P$NUM ;GET THE NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;SAVE THE DATA
JRST SETD.2 ;FINISH BLOCK AND RETURN
SUBTTL SETTDP Process /TAPE-DISPOSITION switch
SETTDP: $CALL P$KEYW ;GET A KEYWORD
$RETIF ;BAD COMMAND
MOVEI S2,TDPDSP ;TAPE DISPOSITION TABLE
JRST SETOV1 ;FINISH IT OFF
TDPDSP: $STAB
.KYHLD,,.SIHLD ;HOLD TAPE
.KYUNL,,.SIUNL ;UNLOAD THE TAPE
$ETAB
TOPS10<
SETABO: MOVX S1,.SIABO ;GET /ABORT BLOCK
MOVEI S2,1 ;GET BLOCK LENGTH OF 1
PUSHJ P,ARGRTN ;SAVE THE BLOCK
JRST CMDEND ;FINISH AND SEND COMMAND OFF
> ;END TOPS10 CONDITIONAL
SUBTTL SETVID Process /VOLUME-ID switch
SETVID: $CALL PVOLID ;PROCESS VOLUME-ID
JUMPT SETI.1 ;O.K.. GET NEXT BLOCK
$RET ;PASS ERROR UP
SUBTTL TABSRC Table search routine
;THIS ROUTINE WILL SEARCH A TABLE FOR A SPECIFIED VALUE AND
;RETURN THE ASSOCIATED INFO
;THE TABLE ENTRIES SHOULD HAVE CODE IN LEFT HALF AND DATA IN RIGHT HALF
;AND USE $STAB TO START THE TABLE AND $ETAB TO END IT
;CALL S1/ ITEM TO LOOK FOR
; S2/ ADDRESS OF TABLE
;
;
;RETURN S1/ ITEM TO LOOK FOR
; S2/ ITEM FOUND IN TABLE
;WILL USE T1 AND T2 FOR SCRATCH
TABSRC:: HLLZ T1,(S2) ;GET THE NUMBER OF ENTRIES
MOVN T1,T1 ;MAKE IT NEGATIVE
HRRI T1,1(S2) ;ADDRESS OF THE TABLE
TABS.1: HLRZ T2,(T1) ;GET THE ENTRY
CAMN S1,T2 ;MATCH?
JRST TABS.2 ;YES..
AOBJN T1,TABS.1 ;TRY NEXT ONE
$RETF ;ERROR..RETURN
TABS.2: HRRZ S2,(T1) ;GET THE DATA
$RETT ;RETURN TRUE
SUBTTL GETDES Get device designator word
;THIS ROUTINE WILL RETURN THE DEVICE DESIGNATOR WORD FOR
;THE DEVICE BLOCK PASSED
;
;RETURN S2/ DEVICE DESIGNATOR INFO
TOPS20 <
GETDES: HRROI S1,ARG.DA(S1) ;GET STRING ADDRESS
HRRZM S1,G$ARG1 ;SAVE THE POINTER
STDEV ;GET DESIGNATOR
$RETF ;RETURN FALSE
TRNE S2,400000 ;CHECK NOT MT DEVICE
PJRST E$ITD ;ERROR CODE
HLRZS S2 ;CLEAR RIGHT HALF AND PLACE IN RIGHT
SUBI S2,.DVDES ;GET TO DEVICE TYPE
$RETT ;RETURN DESIGNATOR IN S2
>;END TOPS20
TOPS10 <
GETDES: HRROI S1,ARG.DA(S1) ;GET STRING ADDRESS
HRRZM S1,G$ARG1 ;SAVE STRING POINTER
$CALL S%SIXB ;CONVERT TO SIXBIT
DEVCHR S2, ;DO THE DEVCHR
SKIPN S2 ;ANY BITS
$RETF ;RETURN FALSE
$RETT ;RETURN TRUE
>;END TOPS10
SUBTTL GETTAP Get a tape device
;THIS ROUTINE WILL CHECK FOR A VALID TAPE DEVICE AND RETURN FALSE
;IF DEVICE IS NOT A TAPE DRIVE
;OTHERWISE
; S1/ ADDRESS OF BLOCK
; S2/ LENGTH OF BLOCK
GETTAP:
TOPS10 <$RETT> ;NOT NEEDED ON THE -10
TOPS20 <
DMOVE T1,S1 ;SAVE THE ARGUMENTS
$CALL GETDES ;GET THE DESIGNATOR
JUMPF E$ITD ;ERROR ..RETURN
CAIE S2,.DVMTA ;IS IT MTA
JRST GETT.1 ;SETUP ERROR RETURN
DMOVE S1,T1 ;RESTORE S1 AND S2 FROM P$DEV RETURN
$RETT ;RETURN TRUE
GETT.1: DMOVE S1,T1 ;RESTORE DEVICE DATA
$RETF ;RETURN FALSE
>;END TOPS20
SUBTTL SETSTR Process SET STRUCTURE command (TOPS20)
TOPS20 <
SETSTR: MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
MOVX S1,.ODSST ;SET STRUCTURE COMMAND FOR -20
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN HEADER
$CALL PSTRUC ;PROCESS A STRUCTURE BLOCK
$RETIF ;ERROR..RETURN
$CALL P$KEYW ;GET THE OPTIONS
$RETIF ;ERROR..RETURN
MOVEI S2,STRDSP ;STRUCTURE DISPATCH TABLE
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVEM S2,ARG.DA(P3) ;SAVE VALUE IN BLOCK
MOVX S1,.STCHR ;STRUCTURE CHARACTERISTICS
MOVEI S2,2 ;SIZE OF BLOCK
$CALL ARGRTN ;BUILD BLOCK
PJRST CMDEND ;CHECK FOR END AND SEND TO QUASAR
STRDSP: $STAB
.KYACK,,S.ACKN ;ACKNOWLEDGED
.KYAVA,,S.AVAL ;AVAILABLE
.KYDOM,,S.DOMS ;DOMESTIC
.KYFOR,,S.FORN ;FOREIGN
.KYREG,,S.REGU ;REGULATED
.KYUAV,,S.UAVL ;UNAVAILABLE
.KYURG,,S.UREG ;UNREGULATED
.KYIGN,,S.IGNO ;IGNORE
$ETAB
>;END TOPS20
SUBTTL Q$SHWS Process SHOW STATUS command
;THIS ROUTINE WILL SEND A SHOW STATUS MESSAGE TO QUASAR
Q$SHWS:: MOVX S1,.OMSHS ;GET THE SHOW STATUS CODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE CODE
PJRST PROSHW ;PROCESS SHOW MESSAGE
SUBTTL Q$SHWP Process SHOW PARAMETERS command
;THIS ROUTINE WILL SEND A SHOW PARAMETERS MESSAGE TO QUASAR
Q$SHWP:: MOVX S1,.OMSHP ;GET SHOW PARAMTERS CODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE TIE TYPE CODE
PJRST PROSHW ;PROCESS SHOW MESSAGE
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.5 ;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
$CALL P$CFM ;END OF COMMAND?
JUMPT PROS.5 ;FINISH OFF BLOCK
PROS.2: $CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF PROS.4 ;NO..TRY OBJECT BLOCK REMAINDER
CAIE S1,.SWNOD ;NODE?
JRST [$CALL PROSHT ;PROCESS SHORT IF THERE
$RETIF ;ERROR..RETURN
PJRST PROS.5] ;FINISH OFF THE BLOCK
$CALL P$NODE ;GET THE NODE
$RETIF ;ERROR..RETURN
PROS.3: MOVEM S1,ARG.DA+OBJ.ND(P3) ;SAVE NODE IN BLOCK
$CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF PROS.5 ;NO..JUST SAVE OBJECT BLOCK
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
JRST PROS.5 ;SAVE THE BLOCK AND FINISH
PROS.4: $CALL FINOBJ ;FINISH OBJECT BLOCK
$RETIF ;NO..ERROR..RETURN
$CALL P$SWIT ;SWITCH THERE?
JUMPF CMDEND ;CHECK FOR THE END
$CALL PROSHT ;PROCESS /SHORT IF THERE
$RETIF ;ERROR...RETURN
PJRST CMDEND ;CHECK FOR END AND SEND IT
PROS.5: MOVX S1,.OROBJ ;BLOCK TYPE
MOVX S2,.OBJLN ;BLOCK SIZE
$CALL ARGRTN ;SAVE THE BLOCK
ANDI P3,777 ;GET LENGTH OF MESSAGE
STORE P3,.MSTYP(MO),MS.CNT ;SAVE THE COUNT
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
Q$SHWR:: MOVX S1,.OMSHR ;SHOW ROUTE TABLES
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
MOVEI S1,.OHDRS ;JUST THE HEADER
STORE S1,.MSTYP(MO),MS.CNT ;SAVE THE COUNT
PJRST SNDQSR ;SEND TO QUASAR
SUBTTL SHWNOD Process node for SHOW STATUS/PARAMETERS command
;THIS ROUTINE WILL BUILD A NODE BLOCK FOR QUASAR TO IDENTIFY THE
;NODE TO BE EXAMINED.
;IF NO NODENAME IS SPECIFIED THE DEFAULT -1 WILL BE USED.
SHWNOD: MOVX S1,.OMSSN ;SHOW STATUS NODE
LOAD S2,.MSTYP(MO),MS.TYP ;GET THE TYPE BLOCK
CAIE S2,.OMSHS ;WAS IT SHOW STATUS
MOVX S1,.OMSPN ;NO..SHOW PARAMETERS NODE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE IN BLOCK
$CALL P$NODE ;GET THE NODE DATA
SKIPT ;O.K.. CONTINUE ON
SETOM S1 ;ASSUME ALL NODES
$CALL SAVNOD ;SAVE THE VALUE
PJRST CMDEND ;END THE COMMAND AND SEND IT
SUBTTL SHWTAP Process SHOW STATUS TAPE command
;THIS ROUTINE WILL SHOW THE STATUS OF THE TAPE DRIVE
SHWTAP: MOVEI S1,.ODSHT ;SHOW STATUS COMMAND
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
$CALL P$DEV ;WAS IT A DEVICE
JUMPT SHWT.1 ;YES.. BUILD DEVICE BLOCK
MOVX S1,.ALTAP
MOVEI S2,1 ;BLOCK SIZE
$CALL ARGRTN ;SAVE THE BLOCK
JRST SHWT.2 ;FINISH OFF THE COMMAND
SHWT.1: $CALL PSTA.1 ;BUILD THE BLOCK
$RETIF ;FAIL..RETURN
SHWT.2: $CALL P$SWIT ;IS THERE A SWITCH?
JUMPF CMDEND ;NO..FINISH OFF COMMAND
MOVEI S2,TAPSWI ;TAPE SWITCHES
SHWTAB: $CALL TABSRC ;SEARCH THE TABLE
$RETIF ;ERROR..RETURN
MOVE S2,(S2) ;GET THE DATA
IORM S2,.OFLAG(MO) ;SAVE THE FLAGS
PJRST CMDEND ;END THE COMMAND
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
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE TYPE
$CALL PSTRUC ;PROCESS THE STRUCTURE
$CALL P$SWIT ;IS THERE A SWITCH?
JUMPF CMDEND ;NO, BETTER BE CONFIRM
CAIE S1,.SWUSR ;IS IT /USER?
$RETF ;NO!?
MOVX S1,ST.USR ;YES, GET FLAG BIT
IORM S1,.OFLAG(MO) ;LIGHT IN MESSAGE TO QUASAR
PJRST CMDEND ;END THE COMMAND AND SEND TO QUASAR
SUBTTL SHWDSK Process SHOW STATUS DISK command
;THIS ROUTINE WILL DO SHOW STATUS OF DISK DRIVES
SHWDSK: MOVEI S1,.ODSHD ;SHOW STATUS COMMAND
STORE S1,.MSTYP(MO),MS.TYP ;SAVE THE MESSAGE TYPE
$CALL P$DEV ;CHECK FOR A DEVICE BLOCK
JUMPT SHWD.1 ;CHECK OUT THE STRUCTURE
MOVX S1,.ALDSK ;FOR ALL DISK DRIVES
MOVEI S2,1 ;ONE WORD
$CALL ARGRTN ;SAVE THE BLOCK
$CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF CMDEND ;NO SWITCH CHECK IF END
MOVEI S2,DSKDSP ;GET DSK TABLE ADDRESS
JRST SHWTAB ;DO THE TABLE LOOKUP
SHWD.1: $CALL P$PREV ;BACKUP TO DEVICE AND GET DISK
$CALL PSTRUC ;CHECK FOR A STRUCTURE
PJRST CMDEND ;NOW TRY END AND RETURN
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
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$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
DISM.0: $CALL P$SWIT ;TRY FOR A SWITCH
JUMPF CMDEND ;NO SWITCH, BETTER CONFIRM
SETZM S2 ;INDICATE NO SWITCH MATCH YET
CAIN S1,.SWREM ;IS IT /REMOVE?
MOVX S2,.DMRMV ;YES, SET THAT BIT
TOPS10< CAIN S1,.SWNCK ;IS IT /NOCHECK?
MOVX S2,.DMNCK ;YES, SET THAT BIT
>;END TOPS10
JUMPE S2,.RETF ;IF NO LEGAL SWITCH, ERROR
IORM S2,.OFLAG(MO) ;SAVE THE FLAG BITS
JRST DISM.0 ;TRY FOR ANOTHER SWITCH
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
SUBTTL Q$IDEN Process IDENTIFY command
;THIS COMMAND WILL IDENTIFY A TAPE DRIVE WITH A PARTICULAR TAPE
;REQUEST OR TAPE VOLUME
Q$IDENTIFY::
MOVE S1,G$HOST ;Get local host
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL PSDEVI ;SAVE THE DEVICE BLOCK
$RETIF ;ERROR..RETURN
$CALL P$KEYW ;CHECK FOR A KEYWORD
$RETIF ;NO..ERROR..RETURN
MOVEI S2,IDNDSP ;USE THE DISPATCH
$CALL TABSRC ;CHECK THE TABLE
$RETIF ;ERROR..RETURN
PJRST (S2) ;DO THE WORK
IDNDSP: $STAB
.KYRQN,,IDNRQN ;REQUEST NUMBER
.KYSCR,,IDNSCR ;SCRATCH TAPE
.KYVID,,IDNVID ;VOLUME-ID
$ETAB
; VOLUME-ID FOR IDENTIFY
IDNVID: $CALL PVOLID ;PROCESS VOLUME ID
JUMPT CMDEND ;O.K.. FINISH OFF MESSAGE
$RET ;ERROR.. PASS CODE UP
; REQUEST NUMBER FOR IDENTIFY
IDNRQN: $CALL PREQNM ;PROCESS REQUEST NUMBER
$RETIF ;ERROR..RETURN
PJRST CMDEND ;FINISH OFF COMMAND
; SCRATCH FOR IDENTIFY
IDNSCR: MOVEI S1,.SCRTP ;SCRATCH TAPE
MOVEI S2,1 ;ONE WORD BLOCK
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH OFF THE COMMAND
SUBTTL Q$DEFI Process DEFINE command (DN60)
;THIS COMMAND WILL DEFINE A DN60 NODE SO THAT PARAMETERS CAN BE SET
IFN FTDN60,<
Q$DEFINE::
MOVE S1,G$HOST ;Get host name
$CALL OPRENB ;Check OPR privs
$RETIF
$CALL P$KEYW ;GET THE KEYWORD
$RETIF ;ERROR..RETURN
CAIE S1,.KYNOD ;BETTER BE NODE
$RETF ;NO..RETURN FALSE
$CALL P$NODE ;GET A NODE
$RETIF ;ERROR RETURN
$CALL SAVNOD ;SAVE THE NODE
$CALL P$KEYW ;GET A KEYWORD
$RETIF ;ERROR..RETURN
SETZ T1, ;SET A FLAG
CAIN S1,.KY278 ;WAS IT 2780
MOVX T1,DF.278 ;2780
CAIN S1,.KY378 ;WAS IT 3780
MOVX T1,DF.378 ;3780
CAIN S1,.KYHSP ;WAS IT HASP
MOVX T1,DF.HSP ;HASP
JUMPE T1,.RETF ;ERROR..RETURN FALSE
STORE T1,DEF.TY(P3),DF.TPP ;Save the type
$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
MOVX S1,.DFBLK ;DEFINE BLOCK
MOVEI S2,DEF.SZ ;DEFINE SIZE
$CALL ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH COMMAND AND SEND IT
>;END FTDN60
SUBTTL Q$SWIT Process SWITCH command (TOPS20)
;THIS COMMAND WILL SEND A MESSAGE TO MOUNTR (VIA QUASAR) TO
;SWITCH A GIVEN REQUEST TO ANOTHER VOLUME/DRIVE.
TOPS20 <
Q$SWITCH::
MOVE S1,G$HOST ;Get host name
$CALL OPRENB
$RETIF
$CALL PREQNM ;PROCESS A REQUEST NUMBER
$RETIF ;ERROR..RETURN
$CALL PVOLID ;PROCESS THE VOLUME ID
$RETIF ;ERROR..RETURN
$CALL PSTAPE ;PROCESS A TAPE BLOCK
PJRST CMDEND ;TRY TO FINISH COMMAND IN ANY CASE
>;END TOPS20
SUBTTL Q$MODS Process MODIFY SYSTEM-LISTS command (TOPS10)
;These routine are responsible for decoding the parse blocks
;Returned on a MODIFY <system-lists> command
;Call -
; S1/ Current keyword in parse
Q$MODS:
TOPS20< $RETF > ;ONLY FOR THE -10
TOPS10<
$CALL CNVLST ;CONVERT TO EXTERNAL FORM, ADD TO MESSAGE
$RETIF ;CAN'T, SO QUIT
MOVE S1,G$HOST ;Get local node
$CALL OPRENB ;Check OPrR privs
$RETIF
MOVX S1,.ODCSL ;NEW MESSAGE TYPE - CHANGE SYSTEM LISTS
STORE S1,.MSTYP(MO),MS.TYP ;SET IT
$CALL P$KEYW ;GET THE INCLUDE/EXCLUDE
JUMPF E$IFC ;CAN'T, SO QUIT
SETO S2, ;SAY NO MATCH SO FAR
CAIN S1,.KYINC ;IS IT INCLUDE?
SETZ S2, ;YES, CLEAR THE BIT
CAIN S1,.KYEXC ;IS IT EXCLUDE?
MOVEI S2,1 ;YES, GET ONE BIT
JUMPL S2,E$IFC ;BETTER BE ONE OF THOSE
STORE S2,.OFLAG(MO),AD.REM ;LITE BIT IF APPROP. IN FLAGS
$CALL PSTRUC ;GET THE DEVICE (STR OR UNI) NAME
$RETIF ;NOT A STR NEXT, STRANGE
PJRST CMDEND ;FINISH THE COMMAND
;THIS ROUTINE CONVERTS A LIST DESCRIPTOR KEYWORD INTO A
; BLOCK IN THE MESSAGE WITH THE EXTERNAL DESCRIPTOR
;CALL -
; S1/ .KYXXX KEYWORD SYMBOL
;RETURNS -
; TRUE, WITH A 2-WORD BLOCK TACKED ON TO THE MESSAGE
; FALSE - IF THE KEYWORD DIDN'T MATCH ANY KNOW KEYWORD
CNVLST: MOVEI S2,CLSTTB ;POINT TO THE MAPPING TABLE
$CALL TABSRC ;FIND THE CORRECT LIST HANDLE
JUMPF E$IFC ;VERY STRANGE
MOVEI S1,.SLSTY ;BLOCK TYPE - LIST DESCRIPTOR
MOVE TF,S2 ;COPY THE CONVERTED LIST TYPE
SETZ S2, ;CLEAR THE DATA WORD
STORE TF,S2,SL.TCD ;STASH IN PROPER PLACE
PJRST MOVAR2 ;ADD A 2-WORD ARG BLOCK
CLSTTB: $STAB
.KYSSL,,SL.SSL ;MAP FOR SYSTEM SEARCH LIST
.KYCDL,,SL.CDL ;MAP FOR SYSTEM DUMP LIST
.KYASL,,SL.ASL ;MAP FOR ACTIVE SWAP LIST
$ETAB
>;END TOPS10
SUBTTL Q$SLST Process SHOW SYSTEM-LISTS command (TOPS10)
;THIS ROUTINE PROCESSES THE SHOW SYSTEM LIST MESSAGE AND
; ANY ATTACHED BLOCKS
TOPS10<
Q$SLST::
MOVEI S1,.ODSSL ;MESSAGE TYPE IS NOW SHOW SYS
STORE S1,.MSTYP(MO),MS.TYP ;CHANGE IT
SLST.1: $CALL P$KEYW ;IS THERE A KEYWORD?
JUMPF CMDEND ;NO, BETTER BE CONFIRM
$CALL CNVLST ;YES, CONVERT AND ADD TO MSG
JRST SLST.1 ;TRY FOR ANOTHER
>;END TOPS10
SUBTTL Q$SALC Process SHOW ALLOCATION command (TOPS10)
TOPS10<
Q$SALC::
MOVEI S1,.ODSAL ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(MO),MS.TYP ;SAVE IN THE OUTGOING MESSAGE
$SAVE <P1> ;SOME WORK SPACE
$CALL P$KEYW ;GET THE DESCRIPTOR
JUMPF E$IFC ;WHOOPS!
MOVX P1,.ORJNU ;ASSUME JOB NUMBER
CAIN S1,.KYBRQ ;IS IT ANYTHING OTHER THAN BATCH REQ?
MOVX P1,.ORREQ ;BATCH REQUEST. SAVE BLOCK TYPE
CAIN S1,.KYALL ;WAS IT 'ALL-REQUESTS'?
JRST SALC.1 ;AND DON'T EXPECT A NUMBER
$CALL P$NUM ;GET THE JOB OR REQUEST NUMBER
SKIPT ;WAS THERE A NUMBER?
SALC.1: SETOM S1 ;NO, SAY -1 FOR JOB NUMBER
MOVE S2,S1 ;DATA WORD - JOB OR REQUEST NUMBER
MOVE S1,P1 ;BLOCK TYPE - FROM KEYWORD
$CALL MOVAR2 ;ADD THE TWO WORDS
PJRST CMDEND ;AND FINISH UP
>;END TOPS10
END