Trailing-Edge
-
PDP-10 Archives
-
BB-JR93K-BB_1990
-
10,7/galaxy/operat/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/LWS 12-SEP-85
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1986,1987. 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 WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC,ORNMAC,QSRMAC,ACTSYM
PROLOG(OPRQSR)
ERRSET ;INITIALIZE ERROR TABLES
PARSET ;SETUP PARSER ENTRIES
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
OPRVRS==:OPRVRS ;LET LINK CATCH VERSION SKEWS
%%.OPR==:%%.OPR
ENTRY BLDOBJ ;BUILD OBJECT BLOCK
ENTRY ARGRTN ;SETUP ARGUMENT IN MESSAGE
ENTRY CMDEND ;COMMAND END PROCESSING
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 or LAT).............. 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
;**;[76] Change EDIT 75. Would cause to much grief. 2-Nov-83
TXNN S1,DV.DSK ;[75][76] DISK ON /DEVICE: ?
PJRST CMDEND ;NO,,CHECK FOR END AND RETURN
PJRST E$IDS ;[75] YES,,INVALID DEVICE SPECIFIED
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 Event queuing -- EVTMSG - Build message
; This routine will build the appropriate Event Queue request
; by parsing the OPR data. Note that the only switches handled
; here are switches defined in EVTSWT in OPRCMD. Event dependent
; switches should be defined to preceed the event independent
; switches in EVTSWT. The switch processor's address for the event
; dependent switches should be passed in S2. This event dependent
; switch processor should IORM any bit flags into EVTSWD or build
; the appropriate message blocks. If the event dependent switch
; processor fails to parse a switch encountered, P$PREV should be
; called before returning TRUE. Event dependent switches are parsed
; FIRST.
;
; "Generic" event command syntax:
;
; <command keywords> <date/time field> <dependent switches> <independent switches>
;
; EVTMSG should be called with the <date/time field> as the next field to
; parse, unless "flag" is lit. (see below)
;
; Call: MOVE S1, Flag,,Event type code (.EVxxx)
; MOVE S2, event dependent switch processor address or zero
; PUSHJ P,EVTMSG
;
; Where "Flag" (the sign bit) is set to indicate an auto file
; parse is being done.
EVTMSG::SETZM EVTSWD ;CLEAR TEMP SWITCH STORAGE
SETZM EVTSWI
MOVEM S1,G$ARG1 ;SAVE EVENT TYPE CODE
MOVEM S2,G$ARG2 ;SAVE OPTIONAL SWITCH PROCESSOR ADDRESS
MOVE S1,G$HOST ;GET HOST NAME
PUSHJ P,OPRENB ;CHECK OPR PRIVS
JUMPF .POPJ ;GIVE UP
MOVEI S1,.QOCQE ;MESSAGE TYPE IS SHORT CREATE
STORE S1,.MSTYP(MO),MS.TYP ;STORE IT
MOVX S1,MF.ACK ;GET THE ACK BIT
IORM S1,.MSFLG(MO) ;WANT A RESPONSE FROM QUASAR
; Queue type
MOVEI S1,.OTEVT ;OBJECT TYPE "EVENT"
MOVEM S1,ARG.DA(P3) ;SAVE
MOVEI S1,.QCQUE ;BLOCK TYPE
MOVEI S2,ARG.SZ ;BLOCK SIZE
PUSHJ P,ARGRTN ;WRITE BLOCK HEADER
; Event type
HRRZ S1,G$ARG1 ;GET EVENT TYPE CODE
MOVEM S1,ARG.DA(P3) ;SAVE
MOVEI S1,.QBEVT ;BLOCK TYPE
MOVEI S2,ARG.SZ ;BLOCK SIZE
PUSHJ P,ARGRTN ;WRITE BLOCK HEADER
; Possible auto file check
SKIPL G$ARG1 ;FLAG SET?
JRST EVTM.0 ;NO
PUSHJ P,EVTFIL ;PARSE FILESPEC
JUMPF .POPJ ;RETURN
; Time arguments
EVTM.0: PUSHJ P,EVTTIM ;PARSE ALL TIME RELATED ARGUMENTS
JUMPF .POPJ ;PROPAGATE ERRORS BACK
; Event dependent switches
EVTM.1: SKIPN G$ARG2 ;EVENT DEPENDENT SWITCH PROCESSOR?
JRST EVTM.2 ;NO, GO LOOK FOR INDEPENDENT SWITCHES
PUSHJ P,@G$ARG2 ;YES, CALL PROCESSOR
JUMPF .POPJ ;JUST RETURN IF PROBLEMS
; Event independent switches
EVTM.2: PUSHJ P,P$SWIT ;LOOK FOR INDEPENDENT SWITCHES
JUMPF EVTM.3 ;CONTINUE IF NONE FOUND
MOVEI S2,EVTSTB ;GET SWITCH TABLE ADDRESS
PUSHJ P,TABSRC ;LOOK FOR SWITCH PROCESSOR
JUMPF .POPJ ;RETURN IF NOT FOUND
PUSHJ P,(S2) ;PROCESS SWITCH
JUMPT EVTM.2 ;LOOK FOR MORE INDEPENDENT SWITCHES
EVTM.3: PUSHJ P,P$CURR ;SET PARSER STRAIGHT
SKIPE EVTSWD ;ANY SWITCHES SPECIFIED?
JRST EVTM.4 ;YES, PUT THEM IN MESSAGE
SKIPN EVTSWI
$RETT ;NO, ALL DONE
EVTM.4: DMOVE S1,EVTSWD ;GET SWITCHES (DEPENDENT AND INDEPENDENT)
DMOVEM S1,ARG.DA(P3) ;PUT IN MESSAGE
MOVEI S1,.QBESW ;GET BLOCK TYPE
MOVEI S2,ARG.SZ+.QBESI ;GET BLOCK SIZE
PUSHJ P,ARGRTN ;WRITE BLOCK HEADER
$RETT ;RETURN
INTERN EVTSWD ;MAKE IT GLOBAL
EVTSWD: BLOCK 1 ;EVENT DEPENDENT SWITCH STORAGE
EVTSWI: BLOCK 1 ;EVENT INDEPENDENT SWITCH STORAGE
EVTSTB: $STAB
.SWFIL,,EVTFIL ;FILESPEC PROCESSOR
.SWFSF,,EVTFSF ;FAILSOFT SWITCH PROCESSOR
.SWRSN,,EVTRSN ;REASON SWITCH PROCESSOR
$ETAB
SUBTTL Event queuing -- EVTTIM - Parse date/time
; Routine to parse:
; DAILY (AT) time
; EVERY weekday (AT) time
; NOW
; date/time
EVTTIM: SETZM G$ARG3 ;CLEAR REPEAT FLAGS
; EVERY weekday (AT) time
PUSHJ P,P$KEYW ;GET A KEYWORD
JUMPF EVTT.2 ;TRY FOR A DATE/TIME
CAIE S1,.KYWKY ;WAS IT SET KSYS "EVERY"
JRST EVTT.1 ;NO--TRY "DAILY"
PUSHJ P,P$KEYW ;GET DAY-OF-WEEK
JUMPF .POPJ ;RETURN IF DON'T HAVE IT
CAIL S1,0 ;RANGE CHECK
CAILE S1,6 ;..
$RETF ;BAD WEEKDAY INDEX
TXO S1,QB.WKY ;LITE "EVERY" FLAG
MOVEM S1,G$ARG3 ;SAVE TEMPORARILY
JRST EVTT.2 ;GO GET TIME
; DAILY (AT) time
EVTT.1: CAIE S1,.KYDLY ;WAS IT SET KSYS "DAILY"?
JRST EVTT.3 ;NO,,GO CHECK FOR "NOW"
MOVX S1,QB.DLY ;YES,,GET DAILY FLAG
MOVEM S1,G$ARG3 ;SAVE TEMPORARILY
; Parse time field used by EVERY and DAILY syntax
EVTT.2: PUSHJ P,P$TIME ;GET TIME
JUMPF .POPJ ;IT'S NOT THERE
JRST EVTT.4 ;GO FINISH UP
; NOW
EVTT.3: CAIE S1,.KYNOW ;IS IT "NOW"
$RETF ;NOPE
MOVX S1,QB.NOW ;YES,,GET NOW FLAG
MOVEM S1,G$ARG3 ;SAVE TEMPORARILY
MOVEI S1,-1 ;GET A RH -1
; Save expiration date/time
EVTT.4: MOVEM S1,ARG.DA(P3) ;SAVE
MOVEI S1,.QBAFT ;BLOCK TYPE
MOVEI S2,ARG.SZ ;BLOCK SIZE
PUSHJ P,ARGRTN ;WRITE BLOCK HEADER
; Save repeat flags
EVTT.5: MOVE S1,G$ARG3 ;GET REPEAT FLAGS
MOVEM S1,ARG.DA(P3) ;SAVE
MOVEI S1,.QBREP ;BLOCK TYPE
MOVEI S2,ARG.SZ ;BLOCK SIZE
PUSHJ P,ARGRTN ;WRITE BLOCK HEADER
$RETT ;AND RETURN
SUBTTL Event queuing -- Event independent switch parsing
; Here to parse /FILE
EVTFIL: PUSHJ P,P$IFIL ;GET INPUT FILESPEC
JUMPF .POPJ ;RETURN ON ERRORS
MOVEI TF,.QBFIL ;FILESPEC BLOCK
STORE TF,ARG.HD(S1),AR.TYP ;SAVE
PUSHJ P,MOVARG ;COPY FD INTO MESSAGE
MOVEI S1,.FPFAS ;ASCII FILE FORMAT
MOVEM S1,ARG.DA(P3) ;SAVE
MOVEI S1,.QBPTP ;BLOCK TYPE
MOVEI S2,ARG.SZ ;BLOCK SIZE
PUSHJ P,ARGRTN ;WRITE THE BLOCK HEADER
$RETT ;RETURN
; Here to process /REASON
EVTRSN: PUSHJ P,P$TEXT ;GET A TEXT
JUMPF .POPJ ;PROPAGATE ERRORS BACK
MOVEI T1,.QBMSG ;BLOCK TYPE
STORE T1,ARG.HD(S1),AR.TYP ;SAVE CORRECT TYPE IN HEADER
PUSHJ P,MOVARG ;COPY INTO MESSAGE
$RETT ;AND RETURN
; Here to process /FAILSOFT
EVTFSF: MOVX S1,QB.FSF ;GET FAILSOFT BIT
IORM S1,EVTSWI ;LITE IN TEMP FLAG WORD
$RETT ;RETURN
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: LOAD S1,ARG.DA+OBJ.UN(P3),OU.LRG ;GET LOW END OF RANGE
LOAD S2,ARG.DA+OBJ.UN(P3),OU.HRG ;GET HIGH END OF RANGE
SKIPN S2 ;IF NO HIGH END,
MOVE S2,S1 ;USE LOW END AS HIGH END
SUB S2,S1 ;GET NUMBER OF OBJECTS IN RANGE
CAXLE S2,MXUNIT ;WITHIN REASON?
PJRST E$IRS ;NO, GIVE AN ERROR
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 ;CHECK FOR VALID OBJECT TYPE
CAILE S1,.OTMAX
$RETF ;NOT AN OBJECT TYPE
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
NOFLAG: BLOCK 1 ;NON-ZERO IF "NO" KEYWORD
Q$SET:: SETZM NOFLAG ;HAVEN'T SEE "NO" YET
$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
PUSHJ P,P$KEYW## ;GET A KEYWORD
$RETIF ;RETURN ON ERRORS
CAIE S1,.KYNO ;"NO"?
JRST SET.1A ;NO
SETOM NOFLAG ;REMEMBER FOR LATER
PUSHJ P,P$KEYW## ;GET A KEYWORD
$RETIF ;RETURN ON ERRORS
SET.1A: 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
XWD .KYPLT,[-PLTCNT,,PLTDSP] ;PLT
XWD .KYNQC,[-NQCCNT,,NQCDSP] ;NETWORK-QUEUE-CONTROLLER
SETOBJ: XWD .KYFAL,[-FALCNT,,FALDSP] ;FAL-STREAM
XWD .KYJOB,SETJOB ;PROCESS JOB SETTING OPTIONS
XWD .KYTAP,SETTAP ;SET TAPE COMMAND
TOPS10< XWD .KYKSY,SETKSY ;SET KSYS COMMAND
XWD .KYUSG,SETUSG ;SET USAGE
XWD .KYSYS,SETSYS ;SET SYSTEM PARAMETER (LOGMAX, ETC.)
>;END TOPS10
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 .KYSOI,[[1,,.STSOI],,SETSOI] ;SYSTEM-OPR-INTERVENTION
XWD .KYTIM,[[ARG.SZ+1,,.STTIM],,SETTIM] ;SET TIME LIMITS
BATCNT==.-BATDSP
CDPDSP:!
LPTDSP:!
PLTDSP:!
PTPDSP:!
OUTDSP: XWD .KYFOT,[[ARG.SZ,,.STFRM],,SETFRM] ;FORMS-TYPE
XWD .KYLEA,[[ARG.SZ,,.STLEA],,SETLEA] ;LIMIT-EXCEED-ACTION
XWD .KYLP2,[[ARG.SZ+1,,.STLP2],,SETLP2] ;LP20-SIMULATION
XWD .KYMTA,[[ARG.SZ,,.STMTA],,SETMTA] ;MAGTAPE
XWD .KYOPL,[[ARG.SZ+1,,.STOPL],,SETOPL] ;OUTPUT-LIMITS
XWD .KYPGL,[[ARG.SZ+1,,.STPGL],,SETPGL] ;PAGE-LIMITS
XWD .KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
XWD .KYUTY,[[ARG.SZ+1,,.STUTY],,SETUTY] ;UNIT-TYPE
CDPCNT==.-CDPDSP
LPTCNT==.-LPTDSP
PLTCNT==.-PLTDSP
PTPCNT==.-PTPDSP
;FAL-STREAM Dispatch Table
FALDSP: XWD .KYNET,[[ARG.SZ,,.STNTY],,SETNTY] ;NETWORK-TYPE
FALCNT==.-FALDSP
;NETWORK-QUEUE-CONTROLLER dispatch table
NQCDSP: XWD .KYATR,[[ARG.SZ+1,,.STATR],,SETNQX] ;ATTRIBUTE
NQCCNT==.-NQCDSP
SUBTTL Q$CLOSE Process the CLOSE LOG command
;THIS ROUTINE WILL PROCESS THE CLOSE COMMAND AND CLOSE THE LOG FILE
Q$CLOSE::
MOVX S1,FWMASK ;POINT TO ALL NODES
$CALL OPRENB ;MUST BE SYSTEM OPR
$RETIF
PUSHJ P,P$NEXT ;POINT PAST 'LOG' KEYWORD
MOVEI S1,.EVOPR ;GET LOG FILE CLOSURE EVENT CODE
SETZM S2 ;NO SWITCH PROCESSOR
PUSHJ P,EVTMSG ;GO BUILD THE EVENT MESSAGE
JUMPF .POPJ ;RETURN IF PROBLEMS
PJRST CMDEND ;SEND MESSAGE TO QUASAR
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
MOVE S1,S2 ;COPY EVENT TYPE TO S1
SETZM S2 ;ASSUME BILLING CLOSURE
CAIE S1,.EVBIL ;WAS IT?
MOVEI S2,USGSWT ;NO, NEED DEPENDENT SWITCH PROCESSOR
PUSHJ P,EVTMSG ;CALL EVENT MESSAGE ROUTINE
JUMPF .POPJ ;RETURN IF PROBLEMS
PJRST CMDEND ;ELSE PARSE CONFIRM AND TELL QUASAR
USGSWT: $CALL P$SWITCH ;LOOK FOR A SWITCH
JUMPF .RETT ;NONE,,MIGHT STILL BE OK
CAXE S1,.SWNOS ;IS IT /NO-SESSION-ENTRIES ???
JRST [PUSHJ P,P$PREV ;NO, BACKUP PARSER AND RETURN
$RETT]
MOVX S1,US.NOS ;YES, NO SESSION ENTRY FLAG
IORM S1,EVTSWD ; AND LIGHT IT
$RETT ;RETURN
USGTBL: $STAB
.KYUBC,,.EVBIL ;BILLING-CLOSURE
.KYUFC,,.EVUSG ;FILE-CLOSURE
$ETAB
SUBTTL SETKSY Set KSYS command to stop timesharing
SETKSY: MOVEI S1,.EVKSY ;EVENT TYPE IS KSYS
MOVEI S2,KSYSWT ;SPECIAL SWITCH PROCESSOR
PUSHJ P,EVTMSG ;BUILD AN EVENT CREATE MESSAGE
JUMPF .POPJ ;FAILED
PJRST CMDEND ;CONFRM SEND SEND MESSAGE TO QUASAR
KSYSWT: PUSHJ P,P$SWIT ;GET A SWITCH
JUMPF .RETT ;IF NOT GIVE UP
MOVEI S2,KSWTAB ;GET ADDRESS OF CANNED STRING TABLE
PUSHJ P,TABSRC ;LOOK FOR CANNED REASON STRINGS
JUMPF [PUSHJ P,P$PREV ;BACKUP PARSER FOR EVENT SWITCH PARSER
$RETT] ;RETURN
MOVE S1,S2 ;GET ADDRESS OF FAKE TEXT BLOCK
HLRZ S2,(S2) ;GET LENGTH OF FAKE TEXT BLOCK
PUSHJ P,MOVARG ;COPY REASON TEXT TO MESSAGE
$RETT ;AND RETURN
;Canned reason switch text table
KSWTAB: $STAB
.SWCM,,[XWD 7,.QBMSG
ASCIZ\Corrective system maintenance\]
.SWNEW,,[XWD 5,.QBMSG
ASCIZ\New monitor\]
.SWPM,,[XWD 7,.QBMSG
ASCIZ\Preventive system maintenance\]
.SWSA,,[XWD 7,.QBMSG
ASCIZ\System will be stand alone\]
.SWSCH,,[XWD ^D8,.QBMSG
ASCIZ\Scheduled system shutdown\]
$ETAB
SUBTTL SET SYSTEM PARAMETER COMMAND
SETSYS: PUSHJ P,P$KEYW ;GET NEXT KEYWORD
JUMPF E$IFC ;BOMB IF NO KEYWORD FOUND
MOVEI S2,SETTAB ;GET TABLE TO SEARCH
PUSHJ P,TABSRC ;LOOK FOR PROCESSING ROUTINE
JUMPF E$IFC ;COMPLAIN IF NOT FOUND
PJRST (S2) ;JUMP TO PROCESSING ROUTINE
SETTAB: $STAB
.KYBMX,,SETBMX ;SET SYSTEM BATMAX
.KYBMN,,SETBMN ;SET SYSTEM BATMIN
.KYCMX,,SETCMX ;SET SYSTEM CORMAX
.KYCMN,,SETCMN ;SET SYSTEM CORMIN
.KYDAT,,SETDAT ;SET SYSTEM DATE
.KYDAY,,SETDAY ;SET SYSTEM DAYTIME
.KYLMX,,SETLMX ;SET SYSTEM LOGMAX
.KYSCD,,SETSCD ;SET SYSTEM SCHEDULE
.KYCSZ,,SETCSZ ;SET SYSTEM DISK-CACHE-SIZE
$ETAB
SUBTTL SET BATMAX, BATMIN, and LOGMAX Commands
;Process SET BATMAX
SETBMX: PUSHJ P,SETCOM ;EXECUTE SOME COMMON CODE
$RETIF ;SOME PROBLEMS
MOVE T1,S2 ;SAVE JOBMAX
MOVEI S2,[ASCIZ\BATMAX\] ;GET SOME TEXT FOR TYPEOUT
PUSHJ P,BATCOM ;DO COMMON RANGE CHECK
JUMPF .RETT ;JUS RETURN IT ERROR
CAILE S1,(T1) ;GREATER THAN JOBMAX??
JRST [MOVEI S2,SETIBN ;BATMAX TOO BIG
JRST SETX.1]
HRLI S1,.STBMX ;NO, BUILD AC FOR UUO
PJRST SETXCT ;GO DO THE SETUUO
;Process SET BATMIN
SETBMN: PUSHJ P,SETCOM ;EXECUTE THE COMMON CODE
$RETIF ;RETURN IF PROBLEMS
MOVE T1,S2 ;SAVE JOBMAX
MOVEI S2,[ASCIZ\BATMIN\] ;GET SOME TEXT FOR TYPEOUT
PUSHJ P,BATCOM ;DO COMMON RANGE CHECK
JUMPF .RETT ;RETURN IF ERROR
CAILE S1,-1(S2) ;MUST BE LESS THAN JOBMAX-1
JRST [MOVEI S2,SETIBN ;INVALID BATMIN VALUE
JRST SETX.1]
HRLI S1,.STBMN ;GET SET BATMIN FUNCTION CODE
PJRST SETXCT ;GO DO THE SETUUO
SETIBN: ITEXT (< ^T/@G$ARG1##/ must be less than current JOBMAX of ^D/G$ARG3##/ ^0>)
;Common BATMAX, BATMIN code
BATCOM: MOVEM S2,G$ARG1## ;SAVE IT
CAIL S1,0 ;RANGE CHECK
CAIL S1,INPMAX ; QUASAR'S MAXIMUM
SKIPA S2,[SETIBV] ;GET ADDRESS OF ERROR ITEXT
$RETT
PUSHJ P,SETX.1 ;GO COMPLAIN
$RETF
SETIBV: ITEXT (< Specified ^T/@G$ARG1##/ value, ^D/G$ARG2##/, out of range 0:^D/[INPMAX-1]/ ^0>)
;Process SET LOGMAX
SETLMX: PUSHJ P,SETCOM ;EXECUTE THE COMMON CODE
$RETIF ;RETURN IF FALSE
MOVEI T1,[ASCIZ\LOGMAX\] ;GET SOME TEXT FOR TYPEOUT
MOVEM T1,G$ARG1## ;SAVE IT
CAIL S1,1 ;RANGE CHECK
CAILE S1,(S2)
JRST [MOVEI S2,SETLIR ;GET ITEXT ADDRESS
JRST SETX.1]
HRLI S1,.STLMX ;GET SET LOGMAX FUNCTION CODE
;FALL INTO CODE TO DO SETUUO
;Common code to do SETUUO for SET BATMAX, BATMIN, and LOGMAX commands.
SETXCT: SETUUO S1, ;DO THE SETUUO
SKIPA S2,SETERR(S1) ;GET ERROR ITEXT ADDRESS
MOVEI S2,SETAOK ;LOAD ADDRESS OF SET OK TEXT
SETX.1: MOVEI S1,^D50 ;50 WORDS ENOUGH FOR BUFFER
PJRST GENACK ;GO ACK THE OPR
SETLIR: ITEXT (< LOGMAX must be in range 1:^D/G$ARG3##/ (JOBMAX) ^0>)
;Common subroutine for SET BATMAX, BATMIN, and LOGMAX commands.
;
;RETURNS TRUE S1/ Command argument (integer)
; S2/ Number of jobs monitor built for (JOBN)
;RETURNS FALSE If invalid command format or OPR not priv'd
SETCOM: MOVE S1,G$HOST ;GET HOST NAME
PUSHJ P,OPRENB ;CHECK PRIVS
$RETIF ;TOO BAD
PUSHJ P,P$NUM ;GET THE ARGUMENT
JUMPF E$IFC ;COMPLAIN IF BAD COMMAND
MOVEM S1,G$ARG2## ;SAVE FOR TYPEOUT
PUSHJ P,P$CFM ;VALIDATE LAST PART OF COMMAND
JUMPF E$IFC ;COMPLAIN IF BAD COMMAND
MOVE S2,[EXP %CNSJN] ;GET MAXIMUM NUMBER OF JOBS
GETTAB S2,
PJRST E$IFC ;SHOULD NOT HAPPEN
MOVEI S2,-1(S2) ;KEEP RH ONLY (ONE LESS FOR NULL JOB)
MOVEM S2,G$ARG3## ;SAVE FOR TYPEOUT
MOVE S1,G$ARG2## ;GET COMMAND ARG BACK
$RETT ;RETURN TO CALLER
SUBTTL SETCMX/SETCMN - Process SET SYSTEM CORMAX and SET SYSTEM CORMIN Commands
SETCMX: SKIPA P1,[EXP .STCXP] ;GET SET CORMAX (PAGES) FUNCTION CODE
SETCMN: MOVEI P1,.STCNP ;GET SET CORMIN (PAGES) FUNCTION CODE
MOVE S1,G$HOST ;CHECK OPR PRIVS
PUSHJ P,OPRENB
$RETIF
PUSHJ P,CORWDS ;GET USER ARG IN NUMBER OF WORDS
JUMPF E$IFC ;COMPLAIN IF PROBLEMS
MOVEM S1,G$ARG2## ;SAVE
MOVEM S2,G$ARG3## ;SAVE "K" OR "P"
PUSHJ P,P$CFM ;SEE IF CONFIRMED
JUMPF E$IFC ;COMPLAIN IF NOT
CAIE P1,.STCXP ;SETTING CORMAX?
JRST SETC.1 ;NO, GO DO SOME CORMIN CHECKS
MOVEI S2,[ASCIZ\CORMAX\] ;GET TEXT FOR ERROR TYPEOUT
MOVEM S2,G$ARG1## ;SAVE IT
MOVE S2,[%VMRMC] ;ASK MONITOR FOR MAXIMUM VALUE
JRST SETC.2 ;JUMP TO COMMON CODE AGAIN
SETC.1: MOVEI S2,[ASCIZ\CORMIN\] ;GET TEXT FOR TYPEOUT
MOVEM S2,G$ARG1## ;SAVE IT
MOVE S2,[%NSCMX] ;CORMIN CAN'T BE GREATER THAN CORMAX
SETC.2: GETTAB S2, ;GET MAXMAX OR CORMAX
MOVE S2,[<^D512*^D512>-1] ;SIGH, USE A REASONABLE DEFAULT
MOVE S1,G$ARG2## ;GET VALUE OPR REQUESTED
CAMLE S1,S2 ;ASKING FOR TOO MUCH?
SOS S1,S2 ;YES, SET TOO MAXIMUM ALLOWED
ADR2PG S1 ;CONVERT FROM WORDS TO PAGES
CAIN P1,.STCXP ;SETTING CORMAX?
TRO S1,400000 ;WANT "SOFT" CORMAX
HRL S1,P1 ;SET UP AC FOR UUO
SETUUO S1, ;DO THE UUO
JRST SETC.3 ;MUST BE NO PRIVS
CAIE P1,.STCXP ;SET CORMAX?
SKIPA S1,[%NSCMN] ;NO, GET INDEX FOR CORMIN
MOVE S1,[%NSCMX] ;YES, GET INDEX FOR CORMAX
GETTAB S1, ;ASK THE MONITOR
MOVE S1,G$ARG2## ;ASSUME IT SET WHAT WAS ASKED FOR
MOVNI S2,^D9 ;GET WORDS TO PAGES LSH ARG
MOVEI TF,"P" ;ASSUME PAGES
CAME TF,G$ARG3## ;WAS IT?
SOS S2 ;NO, BETTER BE "K"
LSH S1,(S2) ;CONVERT TO SAME UNITS AS ENTERED
MOVEM S1,G$ARG2## ;SAVE CURRENT VALUE AGAIN
SKIPA S2,[[ITEXT(< Set accepted, ^T/@G$ARG1##/ is now ^D/G$ARG2##/^7/G$ARG3##/ ^0>)]]
MOVEI S2,NOPRVS
TRNA
SETC.3: MOVE S2,SETERR(S1) ;GET SETUUO ERROR CODE ITEXT ADDRESS
MOVEI S1,^D50 ;250 CHARS SHOULD BE ENOUGH FOR TEXT
PJRST GENACK ;GO SETUP ACK AND RETURN
SUBTTL CORWDS - Parse Core Argument in SET SYSTEM CORMAX/CORMIN Commands
;CORWDS - Routine used by SETCMX and SETCMN to parse OPR core argument
;specified in the SET SYSTEM CORMAX/CORMIN commands.
;
; Returns: S1/ amount of core in words
; S2/ "K" or "P" (for pretty typeout)
;
; Returns FALSE if parse fails
CORWDS: PUSHJ P,P$FLD ;GET ARG USER TYPED
$RETIF
AOS S1 ;BUMP PAST TEXT HEADER WORD
HRLI S1,(POINT 7,0) ;BUILD A BYTE POINTER
MOVEI S2,^D10 ;GET RADIX
PUSHJ P,S%NUMI ;READ THE NUMBER
$RETIF ;RETURN IF PROBLEMS
PUSHJ P,.SAVE1 ;SAVE P1
EXCH S1,S2 ;S1=NUMBER, S2=UPDATED BYTE POINTER
LDB TF,S2 ;GET CHAR THAT TERMINATED NUMBER SCAN
MOVEI P1,^D9 ;GET PAGES TO WORDS LSH ARG
JUMPE TF,CORW.1 ;IF JUST NUMBER, ASSUME ARG IS IN "K"
ILDB S2,S2 ;GET ANOTHER CHAR, IF THERE
JUMPN S2,.RETF ;ONLY 1 CHAR CAN FOLLOW NUMBER
CAIE TF,"P" ;CHECK FOR "P"AGES
CAIN TF,"p"
JRST CORW.2 ;HE DID SAY "P"
CAIE TF,"K" ;HOW 'BOUT "K"
CAIN TF,"k"
CORW.1: AOSA P1 ;HE SAID "K", NEED TO SHIFT ONE MORE
$RETF
CORW.2: LSH S1,(P1) ;CONVERT ARGUMENT TO WORDS
MOVE S2,TF ;GET "K" OR "P"
JUMPE S2,CORW.3 ;IF NONE, ASSUME "K"
CAILE S2,"P" ;UPPER CASE?
SUBI S2," " ;NO, MAKE IT UPPER CASE
$RETT ;RETURN
CORW.3: MOVEI S2,"K" ;ASSUME "K"
$RETT ;RETURN
SUBTTL SETDAT - Process SET SYSTEM DATE Command
SETDAT: PUSHJ P,P$TIME ;GET DATE IN UDT FORMAT
JUMPF E$IFC ;COMPLAIN IF PROBLEMS
MOVE P1,S1 ;SAVE UDT
PUSHJ P,P$CFM ;MAKE SURE CONFIRMED
JUMPF E$IFC
MOVEI S1,[ASCIZ\DATE\] ;GET TEXT FOR ERROR TYPEOUT
MOVEM S1,G$ARG1## ;SAVE IT
MOVE S1,P1 ;GET UDT BACK
PUSHJ P,S%U2DT ;GET DATE IN PROPER FORMAT
HRLI S2,.STDAT ;GET SET DATE CODE
SETUUO S2, ;SET THE DATE
SKIPA S2,SETERR(S2) ;GET ERROR TEXT
MOVEI S2,[ITEXT(< Set accepted, current date is now ^H9/[-1]/ ^0>)]
MOVEI S1,^D50 ;GET 50 WORDS FOR BUFFER
PJRST GENACK ;GENERATE ACK AND RETURN
SUBTTL SETDAY - Process SET SYSTEM DAYTIME Command
SETDAY: PUSHJ P,P$TIME ;GET UDT OF TIME
JUMPF E$IFC ;LEAVE IF NOT THERE
MOVE P1,S1 ;COPY UDT
PUSHJ P,P$CFM ;SEE IF CONFIRMED
JUMPF E$IFC
MOVEI S1,[ASCIZ\DAYTIME\] ;GET ADDRESS OF SOME TYPEOUT TEXT
MOVEM S1,G$ARG1## ;SAVE IT
HRRZ S1,P1 ;JUST GET TIME-PAST-MIDNIGHT
PUSHJ P,.UD2SC## ;CONVERT TO SECONDS
HRLI S1,.STTMS ;GET SET TIME PAST MIDNIGHT CODE
SETUUO S1, ;SET THE TIME
SKIPA S2,SETERR(S1) ;GET THE ERROR ITEXT
MOVEI S2,[ITEXT(< Set accepted, current time is now ^C/[-1]/ ^0>)]
MOVE P1,S1 ;COPY ERROR CODE, IF ONE AT ALL
MOVEI S1,^D50 ;GET 50 WORDS FOR BUFFER
PJRST GENACK ;GENERATE ACK FOR OPR AND RETURN
SUBTTL SETSCD - Process SET SYSTEM SCHEDULE Command
SETSCD: PUSHJ P,P$NUM ;GET SCHEDULE BITS FROM OPR
JUMPF E$IFC ;COMPLAIN IF PROBLEM
MOVE P1,S1 ;SAVE NUMBER
PUSHJ P,P$CFM ;LOOK FOR CONFIRM
JUMPF E$IFC
MOVEI S1,[ASCIZ\SCHEDULE\] ;GET TEXT ADDRESS FOR TYPEOUT
MOVEM S1,G$ARG1## ;SAVE IT
TDNE P1,[777777,,776060] ;LOOK FOR INVALID BITS
JRST SETS.1 ;THERE WERE, GO COMPLAIN
MOVE S1,P1 ;COPY ARG BACK
HRLI S1,.STSCH ;GET SET SCHEDULE CODE
SETUUO S1, ;SET SCHED
SKIPA S2,SETERR(S1) ;GET ITEXT ADDRESS FOR ERROR
MOVEI S2,[ITEXT(< Set accepted, SCHEDULE is now ^O6R0/P1/ ^0>)]
TRNA
SETS.1: MOVEI S2,[ITEXT(< Illegal SCHEDULE bits in ^O/P1/, command ignored ^0>)]
MOVEI S1,^D50 ;GET 50 WORDS FOR BUFFER
PJRST GENACK ;GENERATE ACK TEXT AND RETURN
SUBTTL SETCSZ - Process SET SYSTEM DISK-CACHE-SIZE Command
SETCSZ: PUSHJ P,P$CFM ;SEE IF CONFIRM
JUMPT [MOVX P1,%LDOCS ;<CR> HERE MEANS USE CONFIGURED SIZE
GETTAB P1, ;ASK MONITOR
JRST E$IFC ;HUH?
JRST SETCS1] ;CONTINUE
PUSHJ P,P$NUM ;GET NEW CACHE SIZE
JUMPF E$IFC ;COMPLAIN IF PROBLEM
MOVE P1,S1 ;SAVE NUMBER
PUSHJ P,P$CFM ;LOOK FOR CONFIRM
JUMPF E$IFC
SETCS1: MOVEI S1,[ASCIZ\DISK-CACHE-SIZE\] ;GET TEXT ADDRESS FOR TYPEOUT
MOVEM S1,G$ARG1## ;SAVE IT
MOVE S1,P1 ;COPY ARG BACK
HRLI S1,.STCSZ ;GET SET CACHE SIZE CODE
SETUUO S1, ;SET CACHE SIZE
SKIPA S2,SETERR(S1) ;GET ITEXT ADDRESS FOR ERROR
MOVEI S2,[ITEXT(< Set accepted, DISK-CACHE-SIZE is now ^D/P1/ blocks ^0>)]
MOVEI S1,^D50 ;GET 50 WORDS FOR BUFFER
PJRST GENACK ;GENERATE ACK TEXT AND RETURN
SUBTTL GENACK - Generate ACK Text for ORION Processed OPR Commands
;GENACK - Routine to copy generate ACK text to be sent to OPR using
;the new way, i.e. putting address of ASCIZ text in G$ERR and setting
;up G$APBF and G$APFG.
;
; Call: S1/ Number of words text will need (less than a page)
; S2/ Address of ITEXT for ACK text
GENACK: PUSH P,S2 ;SAVE ADDRESS OF ITEXT
PUSHJ P,M%GMEM ;ASK GLXMEM FOR MEMORY REQUESTED
HRLM S1,G$APBF## ;SAVE NUMBER OF WORDS TO BE RETURNED
HRRM S2,G$APBF## ;SAVE ADDRESS OF ABOVE WORDS
MOVEM S2,G$ERR## ;SAVE ADDRESS OF BUFFER
POP P,S1 ;GET ITEXT ADDRESS BACK
$TEXT (<-1,,(S2)>,<^I/(S1)/^A>) ;COPY ACK TEXT TO BUFFER
MOVEI S1,'ACK' ;A NONDESCRIPT SUFFIX
MOVEM S1,G$APFG## ;SET IT FOR SPECIAL PROCESSING
$RETT ;RETURN, ACKING THE OPR
;Error messages
SETAOK: ITEXT (< Set accepted, ^T/@G$ARG1##/ is now ^D/G$ARG2##/ ^0>)
SETERR: [ITEXT (< Insufficient privileges to set ^T/@G$ARG1##/ ^0>)]
NOPRVS: [ITEXT (< Insufficient privileges to set ^T/@G$ARG1##/ ^0>)]
[ITEXT (< This error, code 2, should not happen trying to set ^T/@G$ARG1##/ ^0>)]
[ITEXT (< Illegal time specified ^0>)]
>;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
SETSOI:
SETNOI:
SETOIA: ADDI P3,1 ;BUMP TO NEXT LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;FINISH OFF COMMAND
SETLP2: MOVE S1,[.OFLNO,,.OFLYE] ;SET LP20 SIMULATION
SKIPE NOFLAG ;"NO" TYPED?
MOVSS S1 ;YES
HRRZM S1,ARG.DA(P3) ;SAVE SIMULATION TYPE IN MESSAGE
ADDI P3,ARG.SZ ;BUMP TO NEXT LOCATION
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
PJRST CMDEND ;END THE COMMAND
;HERE TO SET UNIT-TYPE
SETUTY:!
;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
;Here to handle NETWORK-TYPE
SETNTY: PUSHJ P,P$KEYW ;GET THE KEYWORD
$RETIF
MOVEI S2,NTYTAB ;GET KEYWORD TABLE ADDRESS
PUSHJ P,TABSRC ;LOOK FOR KEYWORD
$RETIF
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
NTYTAB: $STAB
.KYANF,,ST.ANF ;FAL-STREAM TYPE
.KYDCN,,ST.DCN
$ETAB
;SET MAGTAPE PARAMETERS
SETMTA: ADDI P3,ARG.SZ ;ADVANCE TO FIRST SWITCH STORAGE
AOS .OARGC(MO) ;ACCOUNT FOR NULL BLOCK
SETMT1: PUSHJ P,P$SWIT## ;GET A SWITCH
JUMPF CMDEND ;PROBABLY EOL
MOVSI S2,-MTALEN ;AOBJN POINTER
SETMT2: HLRZ TF,MTATAB(S2) ;GET BLOCK TYPE
CAIN TF,(S1) ;MATCH?
JRST SETMT3 ;YES
AOBJN S2,SETMT2 ;LOOP
$RETF ;BAD MESSAGE
SETMT3: STORE S1,ARG.HD(P3),AR.TYP ;SAVE SWITCH BLOCK TYPE IN MESSAGE
MOVEI S1,ARG.SZ ;ASSUME STANDARD TWO WORD BLOCK
STORE S1,ARG.HD(P3),AR.LEN ;SAVE IN MESSAGE
HRRZ S1,MTATAB(S2) ;GET DISPATCH ADDRESS
PUSHJ P,(S1) ;PROCESS SWITCH
JUMPT SETMT1 ;LOOP BACK FOR ANOTHER
$RETF ;ELSE GIVE UP
MTATAB: .SWMDN,,MTAMDN ;/DENSITY
.SWMDI,,MTAMDI ;/DIRECTORY-FILE
.SWMLT,,MTAMLT ;/LABEL-TYPE
.SWMRL,,MTAMRL ;/MULTI-REEL
.SWMPR,,MTAMPR ;/PARITY
.SWMTK,,MTAMTK ;/TRACKS
.SWMVS,,MTAMVS ;/VOLUME-SET
MTALEN==.-MTATAB ;LENGTH OF TABLE
;DENSITY
MTAMDN: JSP S1,MTAXXX ;SET DENSITY
$STAB
.KYDFL,,.TFD00 ;DEFAULT
.KY800,,.TFD80 ;800
.KY200,,.TFD20 ;200
.KY556,,.TFD55 ;556
.KY800,,.TFD80 ;800
.KY160,,.TFD16 ;1600
.KY625,,.TFD62 ;6250
$ETAB
;DIRECTORY-FILE
MTAMDI: MOVEI S1,MTADNY ;SET DIRECTORY-FILE
PJRST MTAXXX ;ENTER COMMON CODE
;LABEL-TYPE
MTAMLT: JSP S1,MTAXXX ;SET LABEL TYPE
$STAB
.KYDFL,,-1 ;DEFAULT
.KYANS,,%TFANS ;ANSI LABELS
.KYEBC,,%TFEBC ;EBCDIC
.KYUNL,,%TFUNL ;UNLABELED TAPE
$ETAB
;MULTI-REEL
MTAMRL: MOVEI S1,MTADNY ;SET MULTI-REEL
PJRST MTAXXX ;ENTER COMMON CODE
;PARITY
MTAMPR: JSP S1,MTAXXX ;SET PARITY
$STAB
.KYDFL,,.OBMPD ;DEFAULT
.KYODD,,.OBMPO ;ODD
.KYEVN,,.OBMPE ;EVEN
$ETAB
;TRACKS
MTAMTK: JSP S1,MTAXXX ;SET TRACKS
$STAB
.KYDFL,,.TMDRD ;DEFAULT
.KY7TK,,%TRK7 ;7-TRACKS
.KY9TK,,%TRK9 ;9-TRACKS
$ETAB
;VOLUME-SET
MTAMVS: PUSHJ P,P$QSTR## ;GET A QUOTED STRING
SKIPT ;CHECK FOR ERRORS
PUSHJ P,P$FLD## ;MAYBE JUST A FIELD
$RETIF ;RETURN IF NO QUOTED STRING OR FIELD
MOVSI S2,ARG.DA(S1) ;START OF TEXT
HRRI S2,ARG.DA(P3) ;WHERE TO PUT IT
LOAD S1,ARG.HD(S1),AR.LEN ;GET BLOCK LENGTH
ADDI S1,ARG.DA ;PLUS OVERHEAD
STORE S1,ARG.HD(P3),AR.LEN ;SET BLOCK SIZE IN MESSAGE
ADDI S1,(P3) ;COMPUTE END OF BLT
BLT S2,-1(S1) ;COPY TEXT
AOS P3,S1 ;BUMP THE POINTER
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
$RETT ;RETURN
; COMMON MAGTAPE SET ROUTINE
MTAXXX: PUSH P,S1 ;SAVE TABLE ADDRESS
PUSHJ P,P$KEYW## ;FETCH KEYWORD
POP P,S2 ;GET TABLE ADDRESS BACK
$RETIF ;CHECK FOR ERRORS
PUSHJ P,TABSRC ;LOOK FOR KEYWORD
$RETIF
MOVEM S2,ARG.DA(P3) ;SAVE IN THE MESSAGE
ADDI P3,ARG.SZ ;BUMP THE POINTER
AOS .OARGC(MO) ;BUMP THE ARGUMENT COUNT
$RETT ;RETURN
;DEFAULT/NO/YES TABLE
MTADNY: $STAB
.KYDFL,,.OBMRD ;DEFAULT
.KYNO ,,.OBMRN ;NO
.KYYES,,.OBMRY ;YES
$ETAB
;SET NETWORK-QUEUE-CONTROLLER
SETNQX: PUSHJ P,P$KEYW ;GET THE KEYWORD
$RETIF
MOVEI S2,NQXTAB ;GET KEYWORD TABLE ADDRESS
PUSHJ P,TABSRC ;LOOK FOR KEYWORD
$RETIF
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
NQXTAB: $STAB
.KYNQI,,%NQINP ;INPUT-STREAM
.KYNQO,,%NQOUT ;OUTPUT-STREAM
$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%DTA ;DECTAPE?
TXNE S2,DV%MTA ;MAGTAPE?
SKIPA ;LET EITHER THROUGH
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: SKIPN ARG.DA(S1) ;[77] DEVICE BETTER NOT BE ZERO!!!!
STOPCD (PBI,HALT,,<P$DEV blew it>) ;[77] (SIGH) SOME PARSER
$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
MOVE S1,T1 ;[75] RESTORE ARGUMENTS AND SAVE
EXCH S2,T2 ;[75] DEVCHR BITS
MOVX T1,.CMDEV ;TAPE DEVICE BLOCK
STORE T1,ARG.HD(S1),AR.TYP ;SAVE THE TYPE
$CALL MOVARG ;[75] MOVE THE BLOCK
MOVE S1,T2 ;[75] GET DEVCHR BITS
$RET ;[75] 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 S1/ SIXBIT DEVICE NAME (TOPS10)
;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 <
INTERN GETDES
GETDES: HRROI S1,ARG.DA(S1) ;GET STRING ADDRESS
HRRZM S1,G$ARG1 ;SAVE STRING POINTER
$CALL S%SIXB ;CONVERT TO SIXBIT
MOVE S1,S2 ;COPY SIXBIT DEVICE NAME
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
Q$SHQN::MOVX S1,.OMSQN ;SHOW QUEUE-NAMES
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
LS.XXX==LS.FST!LS.ALL!LS.SUM ;Contradictory list control switches
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
MOVEI S2,SHQSWT ;Point at switch table
$CALL TABSRC ;Check for a match
$RETIF ;If an error
MOVE S2,(S2) ;Get the bit for the switch
MOVX S1,LS.XXX ;Get the listing control bits
TDNE S2,S1 ;Did they specify a control switch?
TDNN S1,.OFLAG(MO) ;Yes, don't allow contradictions here
SKIPA ;All is goodness, skip
$RETF ;Contradictory switch, error
IORM S2,.OFLAG(MO) ;Light it
JRST SHWQ.3 ;Try for another switch
; 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
; 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
;Switches for the SHOW QUEUES command
SHQSWT: $STAB
.SWALL,,[LS.ALL] ;/ALL
.SWSHT,,[LS.FST] ;/SHORT
.SWSUM,,[LS.SUM] ;/SUMMARY
.SWRMT,,[LS.RMT] ;/REMOTE
$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$ETSR - ENABLE TIMESHARING
TOPS10 <
Q$ETSR::MOVE S1,G$HOST ;GET LOCAL HOST
PUSHJ P,OPRENB ;CHECK OPR PRIVS
JUMPF .POPJ ;GIVE UP
JUMPN P1,ETSR.1 ;JUMP IF DISABLE
MOVEI S1,.OMETS ;CODE FOR ENABLE TIMESHARING
STORE S1,.MSTYP(MO),MS.TYP ;SAVE IN MESSAGE
PJRST CMDEND ;SEND TO QUASAR AND RETURN
ETSR.1: MOVE S1,[XWD .STKSY,-1] ;TURN OF TIMESHARING
SETUUO S1,
TRNA
PJRST E$TSD
MOVEM S1,G$ARG1 ;SAVE ERROR CODE
PJRST E$DTF
> ;END TOPS-10 CONDITIONAL
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
CAIN S1,.SWOSN ;WAS IT /OVERRIDE-SET-NUMBER?
MOVX S2,.DMOSN ;YES
JUMPE S2,.RETF ;ERROR IF NO SWITCH SPECIFIED
IORM S2,.OFLAG(MO) ;SAVE THE FLAG BITS
JRST MOUN.1 ;TRY FOR MORE
>;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, DQS, or LAT)
;THIS COMMAND WILL DEFINE A DN60 NODE SO THAT PARAMETERS CAN BE SET
IFN FTUUOS!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
> ;END IFN FTUUOS!FTDN60
TOPS10 <
CAIN S1,.KYFAL ;IS IT DEFINE FILE-ACCESS?
JRST DEFFAL ;YES, GO DO THAT
CAIN S1,.KYQNM ;IS IT DEFINE QUEUE-NAME?
JRST DEFQNM ;YES, GO DO THAT
>
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,.KYLAT ;WAS IT LAT-SERVER?
MOVX T1,DF.LAT ;LAT
IFN FTDN60,<
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
>; END IFN FTDN60
CAIN S1,.KYSRV ;WAS IT SERVER?
MOVX T1,DF.SRV ;SERVER
JUMPE T1,.RETF ;ERROR..RETURN FALSE
STORE T1,DEF.TY(P3),DF.TPP ;Save the type
CAIE S1,.KYLAT ;Was is LAT-server?
JRST DEFI.1 ;No, keep checking
PUSHJ P,DEFLAT ;Process the LAT switches
JUMPT DEFI.2 ;No errors: finish message
$RET ;
DEFI.1: ;
IFN FTDN60,<
CAIN S1,.KYSRV ;WAS IT SERVER?
JRST DEFI.2 ;YES, END OF MESSAGE
PUSHJ P,DEFD60 ;PROCESS DN60 SWITCHES
$RETIF ;ERROR..RETURN
>; END IFN FTDN60
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
; GET LAT SWITCHES
DEFLAT: $CALL .SAVE1 ;Save P1
DEFL.1: $CALL P$SWIT ;Look for a switch
JUMPF .RETT ;None: finished
MOVEI S2,LATDSP ;Address of table
$CALL TABSRC ;Search the table
$RETIF ;Error: return
ADD S2,P3 ;Convert offset to address
MOVEM S2,P1 ;
$CALL P$FLD ;Get the text string
$RETIF ;Error: return
HRLI S1,1(S1) ;Source,,0
HRR S1,P1 ;Source,,destination
ADD S2,P1 ;Calculate ending address
BLT S1,-2(S2) ;Copy the text string
JRST DEFL.1 ;Look for another switch
LATDSP: $STAB ;
.SWSVR,,DEF.LA+0 ;Server
.SWSVC,,DEF.LA+4 ;Service
.SWPOR,,DEF.LA+10 ;Port
$ETAB
; GET DN60 SWITCHES
IFN FTDN60,<
DEFD60: $CALL P$SWIT ;Get the switch for signon/no- required
SETZ T1, ;Start at none
JUMPF DEFD.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
DEFD.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$KEYW ;SEE IF CPU KEYWORD
JUMPF DEFD.2 ;IF NOT, MUST BE OLD STYLE CMD
$CALL P$NUM ;GET CPU NUMBER
$RETIF ;IF NONE, BAD COMMAND
CAIL S1,0 ;RANGE CHECK
CAILE S1,5
$RETF ;BAD NUMBER
SETZM T4 ;INIT PORT ARGUMENT
STORE S1,T4,C1.1CN ;SAVE CPU NUMBER
$CALL P$KEYW ;GET PORT TYPE
$RETIF ;BAD COMMAND
MOVEI S2,PRTDSP ;PORT TYPE TABLE
$CALL TABSRC ;SEARCH THE TABLE
$RETIF ;PASS ERROR UP
STORE S2,T4,C1.1TY ;CONTINUE BUILDING PORT DESGINATION
$CALL P$NUM ;GET PORT NUMBER
$RETIF
CAIL S1,0 ;RANGE CHECK
CAILE S1,7
$RETF
STORE S1,T4,C1.1PN ;COMPLETE NEW STYLE PORT
HLRZM T4,DEF.PT(P3) ;STORE IN MESSAGE
$CALL P$KEYW ;GET LINE KEYWORD (BETTER BE THERE!)
$RETIF
JRST DEFD.4 ;JOIN COMMON CODE
PRTDSP: $STAB
.KYD10,,.C11DL ;DL-10 PORT TYPE
.KYD20,,.C11DT ;DTE-20
$ETAB
DEFD.2: $CALL P$NUM ;GET THE PORT NUMBER
$RETIF ;ERROR..RETURN
CAIG S1,7 ;DL10 PORT?
JRST [MOVEM S1,DEF.PT(P3) ;YES, STORE IT AND GET LINE NUMBER
JRST DEFD.4]
MOVS T4,S1 ;GET ARG IN LH FOR NEW TYPE ARG BUILD
ANDX T4,C1.1PN ;NO, KEEP ONLY DTE NUMBER
MOVX S1,.C11DT ;GET DTE PORT TYPE CODE
STORE S1,T4,C1.1TY ;STORE IT (CPU NUMBER IS ZERO)
HLRZM T4,DEF.PT(P3) ;SAVE THE PORT NUMBER
DEFD.4: $CALL P$NUM ;GET THE LINE NUMBER
$RETIF ;ERROR..RETURN
MOVEM S1,DEF.LN(P3) ;SAVE THE LINE NUMBER
$RETT ;NO..ERROR..RETURN
>; END IFN FTDN60
TOPS10 <
;PROCESS THE DEFINE FILE-ACCESS COMMAND
DEFFAL: MOVX S1,.OMODB ;GET THE OBJECT DATA MESSAGE TYPE
STORE S1,.MSTYP(MO),MS.TYP ;STORE IN THE MESSAGE HEADER
MOVX S1,.OTFAL ;GET THE OBJECT TYPE FOR FAL
MOVEM S1,ARG.DA(P3) ;STORE THE OBJECT TYPE
MOVX S1,.ORTYP ;GET THE OBJECT TYPE ARGUMENT BLOCK
MOVX S2,ARG.SZ ;GET THE LENGTH OF THE BLOCK
$CALL ARGRTN ;SAVE THE ARGUMENT
$CALL P$KEYW ;GET THE NEXT KEYWORD
$RETIF ;ERROR..RETURN
CAIN S1,.KYREJ ;REJECTION LIST?
JRST DEFFRJ ;YES, GO READ THAT
CAIE S1,.KYDPP ;NO, DEFAULT PPN?
$RETF ;NO. RETURN ERROR
$CALL P$USER ;GET THE DEFAULT PPN
$RETIF ;ERROR..RETURN
MOVEM S1,ARG.DA(P3) ;STORE IN THE DATA BLOCK
MOVX S1,.ORDPP ;GET THE BLOCK TYPE
MOVX S2,ARG.SZ ;GET THE LENGTH OF THE BLOCK
$CALL ARGRTN ;FINISH OFF THE BLOCK
PJRST CMDEND ;FINISH THE COMMAND AND SEND IT
DEFFRJ: MOVX T4,<<1000-.OHDRS-ARG.SZ-ARG.DA>/<REJ.SZ-ARG.DA>> ;NUMBER OF REJECTION SPECS
MOVE T3,P3 ;COPY THE STORAGE POINTER
;LOOP HERE FOR EACH REJECTION SPECIFICATION IN THE LIST
DEFRJ0: $CALL P$NODE ;GET THE NODE NAME
SKIPT ;DID WE GET ANYTHING?
SETZ S1, ;NO, DON'T SET ANYTHING THEN
MOVEM S1,REJ.ND(T3) ;STORE THE REJECTED NODE NAME
SETZM REJ.PP(T3) ;CLEAR THE
SETZM REJ.MK(T3) ; REJECTED PPN
$CALL P$USER ;GET THE REJECTED PPN
JUMPF DEFRJ1 ;NONE, SKIP THIS
MOVEM S1,REJ.PP(T3) ;STORE THE PPN WORD
MOVE S1,PFD.D2(S2) ;GET THE PPN MASK WORD
MOVEM S1,REJ.MK(T3) ;STORE IT TOO
DEFRJ1: MOVEI T3,REJ.SZ-ARG.DA(T3) ;POINT TO THE NEXT SUBBLOCK
$CALL P$CFM ;SEE IF END OF COMMAND YET
JUMPT DEFRJ2 ;YES, GO FINISH UP
$CALL P$COMMA ;NO, HOW ABOUT A COMMA?
$RETIF ;NO, JUST BLOW IT OFF
SOJG T4,DEFRJ0 ;YES, TRY ANOTHER ONE
PJRST E$IFC ;DONE TOO MANY. SAY BAD COMMAND
DEFRJ2: MOVE S2,T3 ;COPY THE STORAGE POINTER
SUBI S2,-ARG.DA(P3) ;COMPUTE BLOCK LENGTH
MOVX S1,.ORREJ ;GET THE BLOCK TYPE
$CALL ARGRTN ;SETUP THE ARG BLOCK
ANDI P3,777 ;GET LENGTH OF MESSAGE
STORE P3,.MSTYP(MO),MS.CNT ;SAVE THE COUNT
PJRST SNDQSR ;SEND THE COMMAND
DEFQNM: MOVX S1,.OMDQN ;GET THE DEFINE REMOTE QUEUE TYPE
STORE S1,.MSTYP(MO),MS.TYP ;STORE IN THE MESSAGE HEADER
$CALL P$FLD ;PROCESS QUEUE NAME
$RETIF
MOVSI S2,ARG.DA(S1) ;SOURCE
HRRI S2,DFQ.QN(P3) ;DESTINATION
LOAD S1,ARG.HD(S1),AR.LEN ;LENGTH OF BLOCK
SUBI S1,ARG.DA ;SUBTRACT LENGTH OF HEADER
CAILE S1,QNMLEN ;CHECK LENGTH
MOVEI S1,QNMLEN ;ADJUST
ADDI S1,(S2) ;COMPUTE END OF OF BLT
BLT S2,-1(S1) ;COPY THE QUEUE NAME STRING
$CALL P$CFM ;SEE IF DELETING DEFINITION
JUMPF DEFQN1 ;MUST BE (RE)DEFINING
$CALL P$PREV ;BACKUP SO COMMON CMD EXIT WORKS
JRST DEFQN4 ;FINISH UP
DEFQN1: $CALL P$KEYW ;GET THE QUEUE TYPE
$RETIF
MOVEM S1,DFQ.TY(P3) ;SAVE IT
$CALL P$NODE ;GET NODE NAME
$RETIF
MOVEM S1,DFQ.ND(P3) ;SAVE IT
$CALL P$KEYW ;GET THE OBJECT TYPE
$RETIF
MOVEM S1,DFQ.OT(P3) ;SAVE IT
$CALL P$CFM ;SEE IF ANY UNIT IS VALID
JUMPF DEFQN2 ;NO
SETOM DFQ.UN(P3) ;FLAG IT
$CALL P$PREV ;BACKUP SO COMMON CMD EXIT WORKS
JRST DEFQN4 ;FINISH UP
DEFQN2: $CALL P$NUM ;GET THE UNIT NUMBER
JUMPF DEFQN3 ;MAYBE NO UNIT NUMBER GIVEN
MOVEM S1,DFQ.UN(P3) ;SAVE UNIT NUMBER
JRST DEFQN4 ;ONWARD
DEFQN3: $CALL P$SIXF ;GET SIXBIT UNIT TYPE
$RETIF ;NEED EITHER UNIT NUMBER OR TYPE
MOVEM S1,DFQ.UT(P3) ;SAVE UNIT TYPE
DEFQN4: MOVX S1,.DFQNM ;BLOCK TYPE
MOVX S2,DFQ.SZ ;LENGTH OF THE MESSAGE
PUSHJ P,ARGRTN ;SAVE THE ARGUMENT
PJRST CMDEND ;FINISH UP AND SEND THE COMMAND
> ;END TOPS10
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 LISTS OR SHOW SYSTEM PARAMETERS
;COMMANDS. SHOW SYSTEM LISTS IS FORWARDED TO QUASAR
TOPS10<
Q$SLST::
PUSHJ P,P$KEYW ;GET NEXT KEYWORD
JUMPF E$IFC ;BETTER BE THERE
MOVEI S2,SSYTAB ;GET TABLE ADDRESS
PUSHJ P,TABSRC ;GET PROCESSOR ADDRESS
JUMPF E$IFC ;COMPLAIN IF NOT FOUND
PJRST (S2) ;GO DO THE WORK
;Here for SHOW SYSTEM PARAMETERS
SHOPRM: PUSHJ P,.SAVET ;SAVE T1-T4
MOVX S1,.OMDSP ;OPR DISPLAY MESSAGE
STORE S1,.MSTYP(MO),MS.TYP ;PUT IT IN THE MESSAGE
MOVEI S1,PRMHDR ;GET ADDRESS OF HEADER TEXT BLOCK
PUSHJ P,SHWMTX## ;USE ROUTINE IN ORION TO COPY INTO MSG
PUSHJ P,OPRSPT## ;USE ROUTINE IN ORION TO SETUP POINTERS
;Display CPU schedulabilty
MOVE S1,[%CNCPU] ;GET NUMBER OF CPUS MONITOR BUILT FOR
GETTAB S1,
JRST SHOP.4 ;DON'T EVEN BOTHER GUESSING
MOVNI T1,(S1) ;GET NEGATIVE COUNT
SOJLE S1,SHOP.4 ;IF JUST ONE, DON'T BOTHER EITHER
HRLZS T1 ;MAKE AOBJN COUNTER
SHOP.1: $TEXT (SHWDEP,<CPU^O/T1,RHMASK/ is ^A>) ;1ST PART OF TYPEOUT
HRRZ S1,T1 ;GET CPU NUMBER TO CHECK
PUSHJ P,VALCPU## ;SEE IF CPU IS RUNNING
MOVE T2,S1 ;SAVE VALUE IN S1
MOVE S1,RUNTBL##(T1) ;GET GETTAB INDEX FOR THIS CPU
GETTAB S1, ;GET %CVRUN WORD FOR THIS CPU
TXO S1,CV%RUN ;ASSUME NOT SCHEDULABLE
JUMPT SHOP.2 ;IF CPU IS RUNNING, SKIP SOME CHECKS
SETZM S2
TXNE S1,CV%RMV ;CPU REMOVED?
MOVEI S2,[ITEXT(<removed>)] ;YES
TXNE S1,CV%DET ;CPU DETACHED?
MOVEI S2,[ITEXT(<detached>)] ;YES
TXNE S1,CV%SPD ;CPU SUSPENDED?
MOVEI S2,[ITEXT(<supended>)] ;YES
JUMPN S2,SHOP.3 ;IF WE FOUND A BIT, GO DEPOSIT TEXT
MOVEI S2,[ITEXT(<not running>)];ELSE CPU IS NOT RUNNING
JRST SHOP.3
SHOP.2: TXNE S1,CV%RUN ;SCHEDULABLE?
SKIPA S2,[[ITEXT (<running but not scheduling jobs>)]] ;NO
MOVEI S2,[ITEXT (<running and scheduling jobs>)] ;YES
SHOP.3: $TEXT (SHWDEP,<^I/(S2)/^M^J^A>) ;PUT TEXT IN BUFFER
AOBJN T1,SHOP.1 ;LOOP FOR ALL CPUS
MOVEI S1,.CHCRT ;GET CARRIAGE RETURN
PUSHJ P,SHWDEP ;PUT IT IN BUFFER
MOVEI S1,.CHLFD ;LINEFEED
PUSHJ P,SHWDEP
;Display LOGMAX
SHOP.4: MOVE S1,[%CNSJN] ;GET MAX NUMBER OF JOBS
GETTAB S1,
MOVEI S1,^D513 ;ASSUME BIG DEFAULT
MOVEI S1,-1(S1) ;GET RID OF NEGATIVE NUMBER OF HISEGS
;DON'T COUNT NULL JOB
MOVE S2,[%CNLMX] ;GET LOGMAX
GETTAB S2,
MOVEI S2,^D512
$TEXT (SHWDEP,<LOGMAX: ^D/S2/ jobs out of ^D/S1/^M^J^J^A>)
;Display SCHEDULE bits
MOVE S1,[%CNSTS] ;GET STATUS WORD FOR SCHED BITS
GETTAB S1,
SETZM S1
TLZ S1,777777 ;KEEP ONLY SCHED BITS
MOVE T1,S1 ;SAVE THEM
$TEXT (SHWDEP,<SCHEDULE: ^O6R0/S1/^M^J^A>)
SKIPN T1 ;ANY BITS SET?
$TEXT (SHWDEP,< No restrictions^M^J^A>) ;NO
JUMPE T1,SHOP.5 ;IF NO BITS SET, SKIP SOME STUFF
TXNE T1,ST%NDL ;NO DOWN-LINE LOADING?
$TEXT (SHWDEP,< No automatic network down-line loading^M^J^A>) ;YES
TXNE T1,ST%NOP ;OPERATOR ON BREAK?
$TEXT (SHWDEP,< No operator coverage^M^J^A>) ;YES, AREN'T THEY ALWAYS
TXNE T1,ST%NSP ;NON-PRIV'D UNSPOOLING ALLOWED?
$TEXT (SHWDEP,< Device unspooling allowed without privilege^M^J^A>) ;YES
TXNE T1,ST%ASS ;CAN USERS ASSIGN RESTRICTED DEVICES
$TEXT (SHWDEP,< Restricted devices can be assigned^M^J^A>) ;YES
TXNE T1,ST%NRT ;REMOTE TERMINALS DISALLOWED?
$TEXT (SHWDEP,< No remote terminals^M^J^A>) ;YES
TXNE T1,ST%BON ;CAN ONLY BATCH JOBS LOGIN?
$TEXT (SHWDEP,< Batch jobs only^M^J^A>) ;YES
TXNE T1,ST%NRL ;NO REMOTE LOGINS?
$TEXT (SHWDEP,< No remote logins^M^J^A>) ;YES
TXNE T1,ST%NLG ;ONLY LOGINS AT CTY?
$TEXT (SHWDEP,< Logins from CTY only^M^J^A>) ;YES
;Display BATMAX and CORMAX
SHOP.5: MOVE S1,[%CNBMX] ;GET BATMAX
GETTAB S1,
MOVEI S1,^D13
CAIN S1,1 ;PLURAL OR SINGULAR (0 IS PLURAL)
SKIPA S2,[BYTE (7) "j","o","b"," ",0]
MOVE S2,[BYTE (7) "j","o","b","s",0] ;MUST BE PRETTY
MOVE T1,[%NSCMX] ;GET CORMAX
GETTAB T1,
SKIPA T1,[^D512]
LSH T1,-^D9 ;CONVERT WORDS TO PAGES
$TEXT (SHWDEP,<^JBATMAX: ^D2R/S1/ ^T/S2/ CORMAX: ^D4R/T1/ pages^M^J^A>)
;Display BATMIN and CORMIN
MOVE S1,[%CNBMN] ;GET BATMIN
GETTAB S1,
SETZM S1
CAIN S1,1 ;PLURAL OR SINGULAR (0 IS PLURAL)
SKIPA T1,[BYTE (7) "j","o","b"," ",0]
MOVE T1,[BYTE (7) "j","o","b","s",0] ;MUST BE PRETTY
MOVE S2,[%NSCMN] ;GET CORMIN
GETTAB S2,
SKIPA S2,[^D512]
LSH S2,-^D9 ;CONVERT WORDS TO PAGES
$TEXT (SHWDEP,<BATMIN: ^D2R/S1/ ^T/T1/ CORMIN: ^D4R/S2/ pages^M^J^J^A>)
;Display disk cache size
MOVX S1,%LDCSZ ;ASK FOR CACHE SIZE
GETTAB S1,
SETZ S1, ;THAT'S ODD
MOVX S2,%LDOCS ;ASK FOR ORIGINAL (CONFIGURED) SIZE
GETTAB S2,
SETZ S2, ;THAT'S ALSO ODD
$TEXT (SHWDEP,<Disk cache size: ^D/S1/ blocks Configured size: ^D/S2/ blocks^M^J^J^A>)
;CUSTOMER ADDITIONS TO SHOW SYSTEM PARAMETERS MAY BE DONE HERE
MOVX S1,%NSKTM ;GET KSYS TIME
GETTAB S1, ; FROM MONTOR
SETZ S1, ;ODD
JUMPE S1,SHOP.6 ;JUMP IF NOT SET
SKIPG S1 ;TIMESHARING OVER ???
$TEXT (SHWDEP,<* Timesharing is over^M^J^J^A>)
JUMPL S1,SHOP.6 ;YES,,TELL OPR AND RETURN
IMULI S1,^D60 ;CONVERT TO SECONDS
CAIGE S1,^D24*^D60*^D60 ;WITHIN 24 HOURS?
PUSHJ P,EXPTIM ;YES, EXPAND TIME INTO READABLE TEXT
SHOP.6: SETZ S2, ;GET A ZERO
IDPB S2,WTOPTR## ;TERMINATE THE MESSAGE
HRRZ S2,WTOPTR## ;GET ENDING ADDRESS
SUBI S2,-1(P3) ;GET LENGTH OF TEXT BLOCK GENERATED
MOVX S1,.CMTXT ;GET BLOCK TYPE
PUSHJ P,ARGRTN ;COPY TEXT TO MESSAGE
PJRST FINSHW## ;GO LOG MSG AND THEN SEND IT TO OPR
PRMHDR: XWD PRMLEN,.ORDSP ;SIZE AND TYPE OF TEXT BLOCK
BLOCK 1 ;ROOM FOR TIME STAMP
ASCIZ\ -- System Parameters --
\
PRMLEN==.-PRMHDR ;SIZE OF THE BLOCK
SHWDEP: IDPB S1,WTOPTR## ;PUT BYTE IN BUFFER
POPJ P, ;RETURN
SUBTTL EXPTIM - Expand time
; Expand time from seconds to hours and minutes
; CALL: MOVE S1,time in seconds
; PUSHJ P,EXPTIM
;
; On return, some pretty text will be generated
;
EXPTIM: $SAVE <T1,T2,T3> ;SAVE SOME ACS
IDIVI S1,^D60*^D60 ;S1:= HOURS
IDIVI S2,^D60 ;S2:= MINUTES
CAIN S1,0 ;HOURS?
MOVEI T1,[ITEXT (<>)] ;NO
CAIN S1,1 ;1 HOUR?
MOVEI T1,[ITEXT (<^D/S1/ hour >)] ;YES
CAILE S1,1 ;MORE THAN ONE HOUR?
MOVEI T1,[ITEXT (<^D/S1/ hours >)] ;YES
SKIPE S1 ;HAVE HOURS?
SKIPN S2 ;HAVE MINUTES?
SKIPA T2,[[ASCIZ ||]] ;JUST ONE OR THE OTHER
MOVEI T2,[ASCIZ |and |] ;HAVE BOTH
CAIN S2,0 ;MINUTES?
MOVEI T3,[ITEXT (<>)] ;NO
CAIN S2,1 ;1 MINUTE?
MOVEI T3,[ITEXT (<^D/S2/ minute>)] ;YES
CAILE S2,1 ;MORE THAN 1 MINUTE?
MOVEI T3,[ITEXT (<^D/S2/ minutes>)] ;YES
$TEXT (SHWDEP,<* Timesharing will cease in ^I/(T1)/^T/(T2)/^I/(T3)/^M^J^J^A>)
POPJ P, ;RETURN
;Here for SHOW SYSTEM LISTS
SHOSSL: 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
SSYTAB: $STAB
.KYLST,,SHOSSL
.KYPRM,,SHOPRM
$ETAB
>;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