Trailing-Edge
-
PDP-10 Archives
-
BB-JR93K-BB_1990
-
10,7/galaxy/queue/queue.mac
There are 9 other files named queue.mac in the archive. Click here to see a list.
TITLE QUEUE - Tops-10 Queue Entry/Change Program - CTKunkel/CTK/JAD/DPM/JJF
SUBTTL Copyright and Version Information
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
; 1983,1984,1985,1986,1987,1988,1989
; DIGITAL EQUIPMENT CORPORATION
; 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 UUOSYM
SEARCH SCNMAC
SEARCH GLXMAC
SEARCH ORNMAC
SEARCH QSRMAC
.REQUE REL:SCAN ;SYSTEM COMMAND SCANNER
.REQUE REL:WILD ;COMMON FILE-SYSTEM MANIPULATOR
.REQUE REL:HELPER ;SYSTEM HELP TEXT TYPER
;Version Information
;
QUHVER==106 ;MAJOR VERSION
QUHMIN==0 ;MINOR VERSION
QUHWHO==0 ;WHO LAST PATCHED
QUHEDT==727 ;EDIT NUMBER
%%.QUH==VRSN.(QUH)
LOC 137
EXP %%.QUH
TWOSEG ;TWO SEGMENT PROGRAM
RELOC 400000 ;START IN HISEG
SALL ;SUPPRESS MACRO EXPANSIONS
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1986,1987,1988,1989.
ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR QUEUE
;
;
; SECTION PAGE
; 1. Copyright and Version Information......................... 1
; 2. Table of Contents......................................... 3
; 3. Revision History.......................................... 3
; 4. QUEUE AC'S and I/O Channel Definitions.................... 4
; 5. Switches, Symbols, Masks, and Flag Definitions............ 5
; 6. MOUNT-class commands flag definitions..................... 5
; 7. Parameters and Defaults................................... 6
; 8. Miscellaneous Data Macros................................. 8
; 9. QUEUE Message Macros...................................... 9
; 10. Device Macros............................................. 10
; 11. SCAN switch definition macros............................. 11
; 12. SCAN keyword tables....................................... 12
; 13. Definition of Switch Accumulation Area and Default Values. 13
; 14. Default Switch Table Values............................... 14
; 15. The QUEUES macro and its related uses..................... 15
; 16. Miscellaneous macros used in MOUNT........................ 17
; 17. S%SIXB -- Convert ASCII to SIXBIT........................ 18
; 18. .ZCHNK -- Zero an arbitrary memory area................... 19
; 19. ERRORS returned by subroutines............................ 20
; 20. QUEUE Entry and Initialization............................ 21
; 21. PSCAN - Init scanning of switches......................... 22
; 22. OSCAN -- READ SWITCH.INI AFTER COMMAND LINE IS PARSED..... 23
; 23. SWTSCN - Parse switches (Stolen from LOGIN)............... 24
; 24. QUELOP Traditional Main Processing Loop................... 25
; 25. SCAN Argument Blocks...................................... 26
; 26. TSCAN Routine Calls...................................... 27
; 27. DEFAUL Command Scanning Default Routines.................. 30
; 28. File Scanning Error Messages.............................. 41
; 29. Other Error Messages...................................... 42
; 30. COMMND Command Processing................................. 43
; 31. NCREAT New CREATE Queue Request - Input or Output......... 45
; 32. CREATO New CREATE Output Queue Request.................... 46
; 33. CREATI New CREATE Input Queue Request..................... 52
; 34. CRESND New CREATE Message Send Routine.................... 58
; 35. NBLDEQ New Build EQ Block Routine (INP/OUT)............... 59
; 36. DOACCT Fill in the Accounting String...................... 60
; 37. NLKFIL New Wild-Card LOOKUP Routine, Writes GALAXY Bits... 61
; 38. ISBIN Check for Binary File Subroutine................... 69
; 39. NMODFY New MODIFY routine................................. 70
; 40. MODINP INPUT Specific Modification Routines............... 75
; 41. MODOUT OUTPUT Specific Modification Routines.............. 77
; 42. GRPSTO Subroutine to Add a MODIFY Element to the Message.. 79
; 43. NKILL New KILL routine.................................... 80
; 44. NLIST New LIST Routines.................................. 81
; 45. NLSTBL Subroutine to Add Thing to LIST Message Block...... 86
; 46. NLSTQN Subroutine to store queue name string to LIST message block 86
; 47. LSTOPN Listing routines - Open the listing file........... 87
; 48. LSTMTA Listing routines - Type out listing filespec....... 88
; 49. LSTHDR Listing routines - Header generation............... 90
; 50. LSTTYO Listing routines - Output the list answer.......... 91
; 51. NDEFER New DEFER & ZDEFER Routine......................... 92
; 52. CMDXIT Return Routine..................................... 94
; 53. MSETUP Subroutine to Setup Temp and Message Areas......... 95
; 54. QUEFLS Subroutines to Flush the IPCF Receive Queue........ 96
; 55. GQPID Get the PID for QUASAR............................. 97
; 56. BLDACK Build ACK Code Subroutine.......................... 98
; 57. GETOBJ Subroutine to Convert Device to an Object Type..... 99
; 58. MSGSND Subroutine to Send a Message to QUASAR............. 100
; 59. RCVACK Subroutine to Receive an Expected "ACK" from QUASAR 101
; 60. MAKNAM Subroutine to Make Up the Packet to Send to INFO... 103
; 61. DFDEST and DFPROC Routines................................ 104
; 62. SETNOD Routine to Convert/Default a node Name/Number...... 105
; 63. GCORE Subroutine......................................... 106
; 64. GTTABS GETTAB Subroutines................................. 107
; 65. GTCLIN Command Scanning Subroutines....................... 109
; 66. SCAN switch definition macros............................. 113
; 67. QUETYP Identify What Type of QUEUE Has Been Specified..... 113
; 68. XPNQUE Expand QUEUE Name Abbreviation If Any.............. 115
; 69. ACCTSW Scan ACCOUNT Switch Processing Routine............. 116
; 70. RDX60W Input Time Subroutines............................. 117
; 71. Fatal Error Message Routines.............................. 118
; 72. Non-fatal Error Message Routines.......................... 119
; 73. Beginning of MOUNT-Class code section -- miscellaneous routines 120
; 74. MOUDEF--Set up defaults for MOUNT-class switches.......... 121
; 75. MOUNT/ALLOC - Process an Allocate or MOUNT Command........ 122
; 76. CANCEL command............................................ 127
; 77. DEALLOCATE and DISMOUNT commands.......................... 129
; 78. DEASWI - Handle the various DEASSIGN/DISMOUNT switches.... 130
; 79. SHOW command keyword tables............................... 131
; 80. CHKALC -- Build a SHOW ALLOCATION packet for QUASAR....... 132
; 81. CHKQUE - Build a SHOW QUEUES message for QUASAR........... 133
; 82. .SHOW - Parsing for SHOW command.......................... 134
; 83. .SHQUE - SHOW QUEUES command.............................. 135
; 84. SHOSWI - Process switches valid for SHOW QUEUE mumble..... 136
; 85. SHOPPN - 'Quick-and-dirty' PPN parsing.................... 137
; 86. P$WLDF - Parse a possibly-wild SIXBIT field............... 139
; 87. MOUNT-class initialization routines....................... 140
; 88. MOUSWI -- MOUNT/ALLOCATE switch moving routines........... 141
; 89. MO$VOL - Process a /VOLID switch from SCAN................ 143
; 90. MOUNT-class general routines.............................. 144
; 91. BLDVSN - Build volume-set name into a MOUNT message block. 146
; 92. BLDVSN - Support routines................................. 147
; 93. Literals and low-segment storage.......................... 149
SUBTTL Revision History
;600 QUENCH/QMANGR are a bit crufty, old MPB bits,
; data formats, data structures, etc. Remove them
; and add direct GALAXY interface. Include
; /FONT and /GRAPHICS switches as part of the
; laser printer support. Do this creating
; new module QUEUE.MAC
; 15-Mar-85 /CTK
;
;601 Fix RDH SWITCH.INI file bug which clobbered
; the S.ATTRIB word on LIST commands. Rewrite
; the NLOKFL routine so we do varible length
; FP blocks, cut down on /FONT switch overhead,
; and rename NLOKFL to NLKFIL reflecting these
; changes. Remove .FPINF/I.MOD word symbol crocks.
; 23-MAR-85 /CTK
;
;602 Fix Non-Existant batch control file CSG error message.
; 29-MAR-85 GCO 10184 /CTK
;
;603 Fix /FONT switch bugs and /STREAM or /UNIT in SWITCH.INI
; on LIST command bug.
; 8-APR-84 GCO 10190 /CTK
;
;604 Make /BATLOG switch unique to one character.
; Make multiply request output creates work and
; give them all the same JOBNAME.
; 14-APR-85 GCO 101xx /CTK
;
;605 Move check for ACK code to after check for packet from IPCC,
; otherwise can't use debugging feature.
; 18-Apr-85 GCO 10193 /JAD
;
;606 Init /ACCOUNT: switch storage to -1, not 0, DOACCT assumes
; -1 means no account string supplied.
; 26-Apr-85 GCO 10200 /LWS
;
;607 Implement DQS support (internal use only).
; 4-Jun-85 GCO 10228 /JAD
;
;610 Bad AC in kill code prevents [1,2] job from killing requests.
; 13-Jun-85 GCO 10230 /DPM
;
;611 Finish rest of DQS support.
; 20-Jun-85 GCO 10236 /JAD
;
;612 Make QUEUE FOO/UNIT:LN01 work.
; *** NOTE ***
; Neither QUASAR nor QUEUE perform any validity checks
; on the new unit class quantity. This enables a customer
; to write a spooler which passes the unit class info to
; QUASAR with no modifications necessary to any part of
; QUASAR or QUEUE.
; 1-JUL-85 GCO 10240 /DPM
;
;613 Fix handling of /UNIT: for DQS printer.
; 9-Jul-85 GCO 102xx /JAD
;
;614 Fix misleading messages beginning with "QMRxxx". Remove
; TTYCHR and TTYSTR macros and use OUTCHR/OUTSTR or N$xxxx
; where appropriate.
; 16-Jul-85 GCO 10252 /JAD
;
;615 Fix .PRI LPTnnn: commands, QUEUE would HIBER.
; 18-Jul-85 GCO 10253 /CTK
;
;616 Fix /NULL stack phase error.
; 18-Jul-85 GCO 10254 /JAD
;
;617 Allow core limits larger than 256K.
; 22-Jul-85 GCO 10259 /DPM
;
;620 Add DMS (1022 database) and FIN ("FINE" editor buffer file)
; to the binary extension table.
; 14-Nov-85 GCO 10327 /DPM
;
;621 We do not handle the "PRINT REL:FILE.EXT[,,EXAMPLE]"
; command. When an ERSATZ device is part of the file spec
; QUEUE can not find any SFD's on it.
; SPR 10-34921 GCO 10126 3-DEC-84/CTK
;
;622 QUEUE/DEFER doesn't work.
; 13-Jan-86 GCO 10356 /DPM
;
;623 Make USERNAME an 8-bit ASCII field.
; 13-Feb-86 GCO 10377 /NT
;
;624 Get the log file in the right place if the device was not
; explicitly specified.
; 17-Apr-86 GCO 10397 /JAD
;
;625 Remove old DQS support and replace with NQC equivalents.
; Code still under the FTDQS feature test.
; 17-Jun-86 GCO 10418 /JAD
;
;626 Queue name string should be 8-bit ASCII.
; 18-Jun-86 GCO 10420 /JAD
;
;627 Force queue name to be upper case ASCII.
; 2-Jul-86 GCO 10435 /JAD
;
;630 Pass forms type string in 7-bit ASCII to match characteristics.
; 14-Jul-86 GCO 10439 /JAD
;
;631 Change NLK.ER to use FILOP. function .FOFIL to return ALL the
; information about where the log file went. Always try doing
; an ENTER if a LOOKUP of the purported log file fails. Also
; some clean-up here and there.
; 18-Jul-86 GCO 10444 /JAD
;
;632 Teach QUEUE to look on CTL: for control files if no device
; was given and the specified file doesn't exist on disk. If
; the user gives a /NEW switch, then never check CTL and assume
; they know what they're doing.
; 23-Jul-86 GCO 104xx /DPM
;
;633 If first component of a multiple field /TIME: switch argument
; is greater than 60 QUEUE leaves the ":" as the next token for
; .SCAN to stumble over. Check for invalid terminator and give
; an error instead. Also limit time field to 18 bits (size of
; the limit word in the EQ).
; 7-Aug-86 GCO 10451 /JAD
;
;634 Re-enter lost GCO 10395 to correct problems with receives of
; large packets by reserving the maximum amount of storage for
; a large packet.
; 16-Dec-86 GCO 10477 /JJF
;
;[Edits 635-677 reserved for maintenance]
;[Start of version 106]
;700 Begin work on moving MOUNT syntax into QUEUE.
; 2-Feb-87 GCO 10508 /JJF
;
;701 Debug the CANCEL and SHOW commands. Many other MOUNT-class commands
; still need work, but these shouldn't.
; 5-Jun-87 GCO 10511 /JJF
;
;702 More debuggery. Make the ALLOCATE and MOUNT commands work. Redo
; the volume-ID name handler; rework much of the rest of the code to
; be able to get along with SCAN. Remove the MODIFY command from the
; command table, since it's a stub anyway, and is undocumented...
; Also make the DEALLOCATE and DISMOUNT commands work.
; 22-Jun-87 GCO 10513 /JJF
;
;703 Program around QUASAR weakness that causes NACKs for some mount-class
; commands to print out only the 'QSR' prefix with a null suffix.
; QUASAR uses a mechanism to generate complex NACK messages that does not
; allow the inclusion of suffixes in the message.
; Also fix bugs preventing multiple MOUNTs/DISMOUNTS on a single line
; from working. Fix another bug that caused all disk mounts to come
; up as /NOWRITE by default.
; 24-Jun-87 GCO 10514 /JJF
;
;704 Fix DISMOUNT/DEALLOCATE bug where DISMOUNT/NOWAIT doesn't default to
; /NOTIFY. Clean up defaulting for this command in general.
; 2-Jul-87 GCO 10522 /JJF
;
;705 Fix a few small problems with CANCEL and a big one with SHOW QUEUE:
; 1. MOUNT/LABEL:USER-EOT didn't because the keyword was not in the
; /LABEL table.
; 2. CANCEL <request-type> * didn't because no code was provided to make
; up for the fact that SCAN handles * differently than GLXLIB.
; 3. CANCEL <request-type> followed by carriage return gave a HALT
; because QUEUE wasn't checking to see if SCAN had returned the
; end-of-line flag after parsing the queue type.
; 4. SHOW QUEUE only processed the first IPCF message returned by
; QUASAR because of an incorrect test of the 'more to come' flag.
; 6-Jul-87 GCO 10525 /JJF
;
;706 More problems fixed:
; 1. .ALLOCATE <return> and .SHOW ALLOCATION sometimes hung because
; the job number wasn't getting stuffed into the message block.
; 2. Excess CRLF's appeared in multi-page SHOW QUEUE ACKs because of
; a misplaced call to TTCRLF. The call was moved to DOCMD so that
; the CRLF will be output only when needed (i.e., when QUEUE is
; invoked by an .R QUEUE command).
; 3. SHOPPN, the PPN parser for the SHOW QUEUE /USER switch left the
; trailing square bracket around so that it would be tripped over
; if the switch was typed in the middle of the line instead of at
; the end.
; 7-Jul-87 GCO 10527 /JJF
;
;707 Program around QUASAR stupidity. Fix RCVACK so that it doesn't
; hang when QUASAR returns junk in the .OFLAG word of the message.
; Do so by making sure that we check the right flag in the right
; cases: WT.MOR of .OFLAG if we are doing a queue listing, and
; MF.MOR of .MSFLG for all others.
; 8-Jul-87 GCO 10530 /JJF
;
;710 Fix some annoying little bugs. Fix MOUN30 so that it will handle
; 'MOUNT MTA:BACKUP:/switches...' (colon after logical name) correctly.
; Fix PSCAN so that QUEUE will die on any SCAN-detected parsing errors
; rather than plunging on mindlessly.
; 27-Jul-87 GCO 10543 /JJF
;
;711 Fix case where "MOUNT DEVICE LOGNAM" doesn't, namely if a colon
; is omitted from the device name.
; 25-Aug-87 GCO 10558 /JJF
;
;712 Bug fixes for the following problems:
; 1. CANCEL BATCH nnn/JOBNAME:foo didn't.
; 2. MOUNT/TRACKS: gave errors because the wrong default was provided
; 3. MOUNT disk/ACTIVE gave infinite loop
; 4. MOUNT disk/CREATE mounted it /NOCREATE and vice versa
; 5. MOUNT disk/SHARABLE was not a valid form of /SHARE.
; 6. DISMOUNT/NOWAIT/NONOTIFY notified.
; 7. ALLOCATE/HELP looked for ALLOC.HLP instead of ALLOCA.HLP.
; 14-Oct-87 GCO 10585 /JJF
;
;713 Create a separate MOUNT-class switch table so that there are no
; conflicts between MOUNT switches and traditional QUEUE switches.
; A small handful of switches are defined in both tables because they
; are used by both classes of commands. (/JOBNAM, /CHECK, /NOTIFY).
; 29-Oct-87 GCO 10587 /JJF
;
;714 Fix bug in volume-set gathering code so that the string
; 'MOUNT FOO(BAR,BAZ):/WRITE' doesn't ignore everything after the
; comma between the volume names. Do so by inventing a new bit
; FL.PAR to indicate if we are inside a parenthetical volume-set
; list.
; 6-Nov-87 GCO 10589 /JJF
;
;715 Fix bugs in dismount code that caused junky ACKs when dismounting
; devices that don't require talking to QUASAR. Also fix the bug
; which caused undeserved errors when dismounting multiple non-QUASAR
; devices.
; 10-Dec-87 GCO 10591 /JJF
;
;716 1. Make MOUNT-class commands use a different OSCAN argument block
; than that used for QUEUE-class commands -- so that it points
; at the correct switch tables. Makes SWITCH.INI parsing
; of MOUNT-class commands a reality.
; 2. Cosmetic fixes to many error messages which output a value
; of some sort after the message itself, so that there is at least
; a space between the message and the value; some also have a colon
; as well.
; 3. Put a copy of the /CREATE switch definition in MOUNT's
; switch table, so that it will work again. This was broken by
; Edit 713.
; 4. Add keyword support and code to allow SUBMIT/ASSIST to take 0 or 1
; in addition to YES and NO. Original author didn't do it right.
; 20-Jan-88 GCO 10595 /JJF
;
;717 Fix bug in /TRACK code so that it actually works.
; 28-Jan-88 GCO 10597 /JJF
;
;720 Allow MOUNT/WAIT<CR> to rejoin a MOUNT request in progress, as
; the old MOUNT program did.
; 25-Apr-88 GCO 10624 /JJF
;
;721 Prohibit ALLOCATE, MOUNT, DEALLOCATE, and CANCEL commands if
; job is not logged-in. ALLOCATE and MOUNT with no arguments
; (i.e., show the respective queues) are allowed.
; 20-Jun-88 GCO 10645 /JJF
;
;722 Fix problem with SHOW commands where they wouldn't work if
; not logged in. QUEUE sets the 'Not Logged-In' bit in the
; flags word if the user isn't logged in. This bit conflicts
; with the MOUNT-class '/CHECK typed' flag, and so it puts in
; a request to show the queues for user [2,5]. Thus, the queues
; are highly likely to be empty. Not a great idea. Clear the
; flags word upon entering the SHOW command dispatch code.
; 21-Jun-88 GCO 10646 /JJF
;
;723 Fix problem with /ACCOUNT:"string" switch processing so that
; the string sent to QUASAR will always be null-terminated.
; A bug in the byte-movement logic caused the string to have one
; or more bytes's worth of all ones at the end of the string,
; instead of a zero terminator.
; 21-Jun-88 GCO 10647 QAR T10L342 #84 /JJF
;
;724 Fix problems with MOUNT-class commands and switches.
; 26-Jul-88 GCO 10650 FT3 verbal QAR /RCB
;
;725 Neuter code to check validity of /DESTINATION switch. Since we
; can have remote destinations on ANF, DECnet, LAT, or IBMcomm nodes,
; the code that just checks ANF is quaint and obsolete.
; 11-Apr-89 GCO 10666 /JJF
;
;726 Make sure /NOTIFY for non-MOUNT class commands is defaulted
; to /NOTIFY:NO (0). Switch storage, S.NTF, is init'd to -1 and
; it's copied directly into EQ.NOT which is 2 bits wide and
; all 4 possible values are assigned. 0 means /NOTIFY:NO which
; is the "default" but when /NOTIFY isn't specified, 3 gets
; put in EQ.NOT which means "notify job via IPCF". This causes
; QUASAR extra overhead and unsuspecting jobs some possible grief.
; Could also cause IPCF quota problems from unwanted/unread messages
; in IPCF receive queue of job.
; 29-Jun-89 GCO 10672 /LWS
;
;727 Remove FTDQS conditionals, as this feature cannot be successfully
; turned off.
; 19-Jul-89 GCO 10673 /DPM
SUBTTL QUEUE AC'S and I/O Channel Definitions
TF==0
T1==1
T2==2
T3==3
T4==4
P1==5
P2==6
P3==7
P4==10
N==7 ;NUMBER/NAME ... USED BY SCAN
C==10 ;CHAR FROM CMD STRING (READ ONLY AC)
I==11 ;POINTS TO INPUT FILE SPEC
P5==11 ;(MOUNT) ANOTHER PRESERVED REG
F==12 ;FLAGS (LH==PERMANENT, RH==TEMPORARY)
J==13 ;QUEUE TYPE JUMP FLAG
P6==13 ;(MOUNT) ANOTHER PRESERVED REG
S1==14 ;FOR MOUNT-BASED CODE
S2==15 ;DITTO
FP==14 ;FB'S FP BLOCK POINTER IN MESSAGE
FD==15 ;FB'S FD BLOCK POINTER IN MESSAGE
M==16 ;LISTING MESSAGE POINTER
P==17 ;PUSH-DOWN POINTER
;I/O CHANNELS
;
DC==1 ;LOOKUP/RENAME DATA FILES
LC==2 ;LISTINGS
..==0 ;FLAG FOR FIELDS TO BE FILLED IN LATER
SUBTTL Switches, Symbols, Masks, and Flag Definitions
;ASSEMBLY SWITCHES
;
IFNDEF FTPROMPT,<FTPROMPT==0> ;PROMPT IF BARE COMMANDS TYPED
;<0>=NO, <-1>=YES
;PERMANENT FLAGS (LH)
;
L.LOGI==(1B17) ;THIS JOB IS LOGGED IN
L.NSBJ==(1B8) ;NOT LOGGED IN TOP LEVEL
;TEMPORARY FLAGS (RH)
;
R.OUTL==1B30 ;LISTING DEVICE NEEDS OUTPUT EACH LINE
R.ANUL==1B27 ;ALLOW DEVICE NUL:
SUBTTL MOUNT-class commands flag definitions
FL.MCL==1B0 ;MOUNT-class/QUEUE-class toggle; if lit,
;rest of flags have the meanings below; if not,
;they have the QUEUE-style meanings.
FL.TAP==1B1 ;Tape request
FL.DSK==1B2 ;Disk request
FL.WRT==1B3 ;Write enable
FL.WLK==1B4 ;Write lock
FL.EXC==1B5 ;Exclusive/sharable access
FL.SCR==1B6 ;Scratch volume set
FL.NEW==1B7 ;New volume set
FL.WAT==1B8 ;Wait for operation to complete
FL.NOT==1B9 ;Notify on completion
FL.PAS==1B10 ;Active/passive search list
FL.BYP==1B11 ;Bypass label processing
FL.MOU==1B12 ;This is a mount request
FL.REM==1B13 ;A remark has been sent with the request
FL.NOC==1B14 ;Creates are not OK as part of DSK:
FL.LAB==1B15 ;User typed some sort of /LABELS switch
FL.RMV==1B16 ;[REM] /REMOVE was typed
FL.CHK==1B17 ;/CHECK was typed
FL.TRK==1B18 ;/TRACK: was specified
FL.GDV==1B19 ;Generic device specified
FL.QTA==1B20 ;/QUOTA was specified
FL.MOR==1B21 ;Look for more ACK messages
FL.LST==1B22 ;MOUNT <CR><LF> was typed
FL.PAR==1B23 ;ON when inside parenthetical list of volumes
;QUEUE LOCAL .FPINF SYMBOLS
;
FP.DSP==3B24 ;/DISPOSE: FIELD -- LOCAL SYMBOL
;CONTAINS DISPXX VALUE
FP.OKB==1B25 ;/ERBIN, /OKBIN -- LOCAL SYMBOL
FP.NEW==1B26 ;/NEW -- LOCAL SYMBOL
FP.LOC==17B26 ;FP LOCAL MASK -- LOCAL SYMBOL
;ACK CODE SYMBOLS
;
ACK.NT==400000,,0 ;Mask for /NOTIFY
ACK.JB==377400,,0 ;Mask for job number
ACK.UT==377,,777777 ;Mask for UDT bits
;QUEUE OPERATIONS
;
.QORCR==1 ;CREATE
.QORDF==2 ;/CREATE/DEFER
.QORZD==3 ;/KILL/DEFER
.QORLS==4 ;LIST
.QORMD==5 ;MODIFY
.QORKL==6 ;KILL
;MODIFICATION INPUT DEPENDENCY SYMBOLS
;
MI.DMT==3B19 ;DEPENDENCY MODIFY TYPE
.MIDAB==0 ;ABSOLUTE
.MIDPL==1 ;PLUS (ADDITIVE)
.MIDMI==2 ;MINUS
.MIDNM==3 ;NO MODIFY
MI.DEP==177777 ;DEPENDENCY PARAMETER
;GENERAL SYMBOLS
;
REMLEN==^D10 ;50 CHARACTERS IN A REMARK STRING
VIDLEN==^D63
FBSIZE==FPXSIZ+FDXSIZ ;THE LARGEST FD/FP WE CAN BUILD
MAX<FBSIZE,KIL.SZ,7,DFR.SZ>
FBAREA==MAXSIZ ;THE LARGEST FILE BLOCK/MESSAGE NEEDED
MX.PTH==.FXLEN
PD.PTH==0
SUBTTL Parameters and Defaults
;ASSEMBLY PARAMETERS
;
ND LN$PDL,100 ;LENGTH OF PUSH-DOWN LIST
ND LN$ENT,11 ;LENGTH OF A LOOKUP/ENTER BLOCK
ND LN$DSK,5 ;LENGTH OF DSKCHR BLOCK
ND PUNCDP,0 ;-1=NO PUNCH COMMAND
;0=PUNCH COMMAND TO PTP
;1=PUNCH COMMAND TO CDP
XP TTYSIZ,<^D500/5>+1 ; TTY buffer size (500 characters)
XP PAKSIZ,^D100 ;Size of message packet
;Interrupt channel assignments
XP .ICIPC,1 ;IPCF interrupt channel
SYSPRM (MAXPRO,00777,777777) ;Maximum file protection
;Constants
ACK.NT==400000,,0 ;Mask for /NOTIFY
ACK.JB==377400,,0 ;Mask for job number
ACK.UT==377,,777777 ;Mask for UDT bits
;DEFAULTS
;
RADIX ^D10
DM AFT, 10080, 0, 10 ;AFTER CURRENT TIME IN MINUTES
DM CDP,^O777777, 000,2000 ;CARD PUNCH LIMIT IN CARDS
DM COP, 63, 1, 0 ;NUMBER OF COPIES OF OUTPUT
DM COR, .INFIN,25600,40960 ;CORE LIMIT FOR JOB
DM DPN, 65535, 0, 0 ;INITIAL DEPENDENCY COUNT
DM LIM,^O777777, 00, 0 ;OUTPUT LIMIT
DM LPT,^O777777, 00,2000 ;LINE PRINT LIMIT IN PAGES
DM NOD, 77,0,0 ;NODE NAME
DM HDR, 1, 1, 1 ;FILE HEADERS ON OUTPUT
DM PLT,^O777777, 00, 60 ;PLOT LIMIT IN MINUTES
DM PRI, 63,SPLPRI,MXUPRI ;EXTERNAL PRIORITY
DM PTP,^O777777, 000, 100 ;PT PUNCH LIMIT IN FEET
DM RID, ^O377777, 0, 0 ;REQUEST ID
DM RST, 1, 0, 1 ;RESTART PARAMETER
DM SEQ, 100000, 0, 0 ;JOB'S SEQUENCE NUMBER
DM STR, 100000, 1, 1 ;STARTING POINT IN FILE
DM TIM, ^O777777, 300,3600 ;TIME LIMIT FOR JOB IN SECONDS
DM UNT, 7,0,0 ;UNIT NUMBERS
;MOUNT-CLASS DEFAULTS
; NAME MAX ABS PRES
ND AD.LFD,DISPPRESERVE ;LOG FILE DISPOSITION
ND AD.OPN,.QORCR ;STANDARD OPERATION IS /CREATE
RADIX 8
SUBTTL Miscellaneous Data Macros
;MACRO TO MOVE DATA AROUND -- WIPES TF
;
DEFINE DATAM(SWRD,SFIELD,DWRD,DFIELD)<
LOAD(TF,SWRD,SFIELD)
XLIST
STORE(TF,DWRD,DFIELD)
LIST
SALL
> ;END OF DEFINE DATAM
;NMDCHG MACRO TO CHECK FILE BITS IN MODIFY.
; SETS T1 = THE NEW VALUE OR -1 IF NO CHANGE
;
DEFINE NMDCHG(FIELD),<
MOVE T1,I.MODM(I)
XLIST
TXNN (T1,FIELD)
TDOA T1,[-1]
LOAD (T1,I.MOD(I),FIELD)
LIST
SALL
> ;END OF DEFINE NMDCHG
;MACRO TO MOVE A WORD DIRECTLY INTO THE MODIFY MESSAGE USING GRPSTO
;
DEFINE MOVWRD(WORD),<
MOVE T1,WORD
XLIST
PUSHJ P,GRPSTO
LIST
SALL
> ;END OF DEFINE MOVWRD
;INCR MACRO
;
DEFINE INCR(A,B),<AOS A>
DEFINE SWSEG<
XLIST
LIT
LIST
RELOC
> ;END OF DEFINE SWSEG
;GCORE MACRO GET N MORE WORDS AT .JBFF
;
DEFINE GCORE (A),<
MOVEI T1,A
XLIST
PUSHJ P,GCORE.
LIST
>
SUBTTL QUEUE Message Macros
DEFINE N$FATE(A,B,C,%A),<
IFNDEF E.'A,<E.'A:>
SKIPA
XLIST
JRST %A
JSP T1,NFMSG'B
SIXBIT \ A\
ASCIZ \C\
%A:
LIST
SALL
> ;END DEFINE N$FATE
DEFINE N$WARN(A,B,C,%A),<
IF1,<IFNDEF E.'A,<E.'A:>>
SKIPA
XLIST
JRST %A
PUSHJ P,FWARN'B
<SIXBIT \A\>+[ASCIZ \C\]
%A:
LIST
SALL
> ;END DEFINE N$WARN
DEFINE N$INFO(A,B,C,%A),<
IF1,<IFNDEF E.'A,<E.'A:>>
SKIPA
XLIST
JRST %A
PUSHJ P,FINFO'B
<SIXBIT \A\>+[ASCIZ \C\]
%A:
LIST
SALL
> ;END DEFINE N$INFO
SUBTTL Device Macros
DEFINE DEVICE,<
X LPT,.OTLPT,LIQLPT
X LL,.OTLPT,LIQLPT
X LU,.OTLPT,LIQLPT
X PTP,.OTPTP,LIQPTP
X CDP,.OTCDP,LIQCDP
X PLT,.OTPLT,LIQPLT
X INP,.OTBAT,LIQBAT
> ;END DEFINE DEVICE
DEFINE X(A,B,C),<
SIXBIT /A/
> ;END DEFINE X
DEVTAB: DEVICE
NDEVS==.-DEVTAB
DEFINE X(A,B,C),<
EXP B
> ;END DEFINE X
OBJTAB: DEVICE
DEFINE X(A,B,C),<
EXP C
> ;END DEFINE X
LIQTAB: DEVICE
SUBTTL SCAN switch definition macros
DEFINE SWTCHS,<
XLIST
SP ACCOUNT,S.ACCT,ACCTSW,,FS.VRQ
SP AFTER,S.AFT,.SWDTF##,AFT,FS.VRQ!FS.NFS
SN ALLFILES,S.ALLF
SN ASSISTANCE,S.ASST
SL *BATLOG,S.BATL,BATL,BATLAPPEND
SP BATOPT,S.BATO,.SWSIX##,,FS.VRQ!FS.NFS
SP BEGIN,F.STRT,.SWDEC##,STR,FS.VRQ
SP CARDS,S.LCDP,.SWDEC##,CDP,FS.VRQ!FS.NFS!FS.LRG
SP CHARACTERISTICS,<POINT <^D65-CHRSIZ>,S.CHAR>,.SWASQ##,,FS.VRQ
SN *CHECK,S.CHK,FS.NFS
SP COPIES,<POINTR(F.MOD,FP.FCY)>,.SWDEC##,COP,FS.VRQ
SP CORE,S.COR,.SWCOR##,COR,FS.LRG!FS.VRQ
SS CREATE,S.OPN,.QORCR,FS.NOS
SN DEFERRED,S.DFR
SS DELETE,<POINTR(F.MOD,FP.DSP)>,DISPDELETE
SP DEPENDENCY,S.DPN,DEPSW,DPN,FS.VRQ
SP DESTINATION,S.DEST,.SWSIX##,NOD,FS.VRQ
SL DISPOSE,<POINTR(F.MOD,FP.DSP)>,DISP,DISPPRESERVE
SP DISTRIBUTION,<POINT 55,S.DIST>,.SWAS8##,,FS.VRQ
SS ERBINARY,<POINTR(F.MOD,FP.OKB)>,0
SS *FAST,S.LIST,LISTFAST
SP FEET,S.LPTP,.SWDEC##,PTP,FS.LRG
SL FILE,<POINTR(F.MOD,FP.FFF)>,FILE,FILEASCII
SP FONT,<POINT <^D65-FNMLTH>,F.FONT>,.SWASQ##,,
SP FORMS,<POINT <^D65-FRMSIZ>,S.FRM>,.SWSXQ##,,FS.VRQ
SS GENERIC,S.ATTRIB,<INSVL.(%GENRC,RO.ATR)>,FS.LRG
SN HEADER,<POINTR(F.MOD,FP.NFH)>
SP JOBNAME,S.JOB,.SWSIX##,,FS.VRQ
SS KILL,S.OPN,.QORKL
SP LIMIT,S.LIM,.SWDEC##,LIM,FS.LRG
SS LOWERCASE,S.ATTRIB,<INSVL.(%LOWER,RO.ATR)>,FS.LRG
SL *LIST,S.LIST,LIST,LISTJOBS
SP METERS,S.LPTP,METESW,PTP,FS.LRG
SS *MODIFY,S.OPN,.QORMD
SN NEW,<POINTR(F.MOD,FP.NEW)>
SP NOTES,<POINT 63,S.NOS1>,.SWSXQ##,,FS.VRQ
SN NOTIFY,S.NTF
SN NULL,S.NULL
SS OKBINARY,<POINTR(F.MOD,FP.OKB)>,1
SL OUTPUT,S.OUT,OUTP,INPLOG
SP PAGES,S.LLPT,.SWDEC##,LPT,FS.LRG
SP PATH,DEFFIL,.SWFIL##,PTH,FS.VRQ
SL PLOT,<POINTR(F.MOD,FP.FPF)>,PLOT,PLOTIMAGE
SS PRESERVE,<POINTR (F.MOD,FP.DSP)>,DISPPRESERVE
SL PRINT,<POINTR(F.MOD,FP.FPF)>,PRIN,PRINARROW
SP PRIORITY,S.PRI,.SWDEC##,PRI
SP PROCESSING,S.PROC,.SWSIX##,NOD,FS.VRQ
SL PUNCH,<POINTR(F.MOD,FP.FPF)>,PUNC,PUNCASCII
SP QUEUE,<POINT <^D65-QNMLEN>,S.QNM>,QNMSW,,FS.VRQ
SN READER,S.RDR
SN REMOTE,S.RMT
SP REPORT,<POINT 63,F.RPT>,.SWSXQ##,,FS.VRQ
SP REQUESTID,S.RID,.SWDEC##,RID
SN RESTARTABLE,S.RSTR
SP SEQUENCE,S.SEQ,.SWDEC##,SEQ
SS SITGO,S.ATTRIB,<INSVL.(%SITGO,RO.ATR)>,FS.LRG
SP STREAM,S.ATTRIB,UNITSW,UNT
SL *SPACING,<POINTR(F.MOD,FP.FSP)>,SPAC,SPACSINGLE
SP TAG,F.STRT,.SWSIX##,,FS.VRQ!FS.NFS
SL TAPE,<POINTR(F.MOD,FP.FPF)>,TAPE,TAPEASCII
SP TIME,S.LTIM,TIMESW,TIM,FS.LRG
SP TPLOT,S.LPLT,.SWDEC##,PLT,FS.LRG
SN *UNIQUE,S.UNIQ
SP UNIT,S.ATTRIB,UNITSW,UNT
SS UPPERCASE,S.ATTRIB,<INSVL.(%UPPER,RO.ATR)>,FS.LRG
SP USERNAME,<POINT 55,S.USER>,.SWAS8##,,FS.VRQ
LIST
>
SUBTTL SCAN keyword tables
;KEY WORD VALUES
KEYS BATL,<APPEND,SUPERSEDE,SPOOL>
KEYS DISP,<PRESERVE,RENAME,DELETE>
KEYS FILE,<ASCII,FORTRAN,COBOL,,,ELEVEN,,8BIT>
KEYS LIST,<ALL,FAST,JOBS,SUMMARY>
KEYS OUTP,<NOLOG,LOG,ERROR>
KEYS PLOT,<IMAGE,ASCII,BINARY>
KEYS PRIN,<ARROW,ASCII,OCTAL,SUPPRESS,GRAPHICS>
KEYS PUNC,<ASCII,026,BINARY,BCD,IMAGE>
KEYS SPAC,<SINGLE,DOUBLE,TRIPLE>
KEYS TAPE,<ASCII,IMAGE,IBINARY,BINARY>
KEYS DENK,<200-BPI,556-BPI,800-BPI,1600-BPI,6250-BPI,INSTAL,DEFAUL>
KEYS LABL,<DEFAULT,ANSI,BLP,BYPASS,EBCDIC,IBM,NOLABE,NONE,UNLABE,USER-EOT>
KEYS TRAK,<7,9>
;NOW BUILD THE TABLES FROM THE SWTCHS MACRO
DOSCAN(SWTCH)
SUBTTL Switch definitions for MOUNT-class commands
DEFINE SWTCHS,<
XLIST
SN ACTIVE,S.ACTIV,FS.NFS
SN ALL,S.ALL,FS.NFS
SN BRIEF,S.BRIEF,FS.NFS
SN *CHECK,S.CHK,FS.NFS
SN CREATE,S.OPN,FS.NOS
SP DEVICE,S.DEVIC,.SWSIX##,,FS.VRQ!FS.NFS
SN DISK,S.DISK,FS.NFS
SN EXCLUSIVE,S.EXCLU,FS.NFS
SN FULL,S.FULL,FS.NFS
SP JOBNAME,S.JOB,.SWSIX##,,FS.VRQ
SL LABEL-TYPE,S.LABEL,LABL,LABLDEFAULT,FS.VRQ!FS.NFS
SN MULTI,S.SHARE,FS.NFS
SN SHARABLE,S.SHARE,FS.NFS
SN NEW-VOLUME-SET,S.NEWVOL,FS.NFS
SN NOTIFY,S.NTF
SN PASSIVE,S.PASSIV,FS.NFS
SN QUOTA,S.QUOTA,FS.NFS
SN READ-ONLY,S.READ,FS.NFS
SP REELID,<POINT <^D65-VIDLEN>,S.VOLID>,MO$VOL,,FS.VRQ!FS.NFS
SP REMARK,<POINT <^D65-REMLEN>,S.REMAR>,.ASCQW##,,FS.VRQ!FS.NFS
SN REMOVE,S.REMOV,FS.NFS
SN RONLY,S.READ,FS.NFS
SN SCRATCH,S.SCRATCH,FS.NFS
SN SHARE,S.SHARE,FS.NFS
SN SINGLE,S.EXCLU,FS.NFS
SN TAPE,S.TAPE,FS.NFS
SL TRACKS,S.TRACKS,TRAK,<TRAK9>,FS.VRQ!FS.NFS
SN *WAIT,S.WAIT,FS.NFS
SN WENABL,S.WRITE,FS.NFS
SN WLOCK,S.READ,FS.NFS
SN WRITE-ENABLE,S.WRITE
SP USER,S.PPN,SHOPPN,,FS.VRQ!FS.NFS
SP VOLID,<POINT <^D65-VIDLEN>,S.VOLID>,MO$VOL,,FS.VRQ!FS.NFS
SP VID,<POINT <^D65-REMLEN>,S.REMAR>,.ASCQW##,,FS.VRQ!FS.NFS
LIST
>
LALL
DOSCAN(MOUSW)
SALL
SUBTTL Miscellaneous value tables for switches
;Table of values corresponding to /DENSITY:mumble
DENTBL: EXP .TFD20 ;200 BPI
EXP .TFD55 ;556
EXP .TFD80 ;800
EXP .TFD16 ;1600
EXP .TFD62 ;6250
EXP .TFD00 ;SYSTEM DEFAULT (/DENS:INSTAL)
EXP .TFD00 ;SYSTEM DEFAULT (/DENS:DEFAULT)
DENLEN==.-DENTBL
;Table of values corresponding to /TRACK:mumble
TRATAB: EXP .TMDR7
EXP .TMDR9
TRALEN==.-TRATAB
;Table of values corresponding to /LABEL:mumble
TLBTAB: EXP %TFUNL ;UNLABELLED (/DEFAULT)
EXP %TFANS ;ANSI labels
EXP %TFLBP ;BLP (Bypass Label Processing)
EXP %TFLBP ;BYPASS
EXP %TFEBC ;EBCDIC
EXP %TFEBC ;IBM (alias for EBCDIC)
EXP %TFUNL ;NOLABELS
EXP %TFUNL ;NONE
EXP %TFUNL ;UNLABELED
EXP %TFUNV ;USER-EOT
TLBLEN==.-TLBTAB
SUBTTL Definition of Switch Accumulation Area and Default Values
;EACH ENTRY IN QSM MACRO IS:
; SMX SWITCH-LOCATION,DEFAULT
;
DEFINE QSM,<
SMX S.ACCT,-1
MSC 7 ;SEVEN MORE - TOTAL OF EIGHT
SMX S.AFT,0
SMX S.ALLF,-1
SMX S.ASST,.OPINY
;*** S.ATTR AND S.UNTY MUST BE ADJACENT ***
SMX S.ATTR,-1 ;ATTRIBUTES
SMX S.UNTY,-1 ;UNIT TYPE
SMX S.BATL,BATLAPPEND
SMX S.BATO,-1
SMX S.CHAR,0
MSC CHRSIZ-1
SMX S.CHK,-1
SMX S.COR,-1
SMX S.DFR,-1
SMX S.DEST,-1
SMX S.DIST,-1
MSC 7
SMX S.DPN,0
SMX S.FRM,0
MSC FRMSIZ-1 ;A FEW MORE WORDS
SMX S.JOB,0
SMX S.LCDP,0
SMX S.LIM,0
SMX S.LIST,-1
SMX S.LLPT,0
SMX S.LPLT,0
SMX S.LPTP,0
SMX S.LPAT,0 ;PATCH LIMIT
SMX S.LTIM,0
SMX S.NOS1,0
SMX S.NOS2,0
SMX S.NTF,-1
SMX S.NULL,0
SMX S.OPN,0
SMX S.OUT,-1
SMX S.PRI,-1
SMX S.PROC,-1
SMX S.QNM,0
MSC QNMLEN-1
SMX S.RSTR,AD.RST
SMX S.RDR,-1
SMX S.RMT,-1
SMX S.RID,0
SMX S.SEQ,0
SMX S.SPAC,-1
SMX S.UNIQ,-1
SMX S.USER,-1
MSC 7
;MOUNT-CLASS STORAGE
SMX S.WAIT,-1
SMX S.DISK,-1
SMX S.TAPE,-1
SMX S.TRACKS,-1
SMX S.ACTIV,-1
SMX S.PASSIV,-1
SMX S.LABEL,-1
SMX S.REMOV,-1
SMX S.DEVIC,0
SMX S.EXCLU,-1
SMX S.SHARE,-1
SMX S.NEWVOL,-1
SMX S.SCRATCH,-1
SMX S.QUOTA,-1
SMX S.READ,-1
SMX S.WRITE,-1
SMX S.VOLID,-1
MSC VIDLEN-1
SMX S.RMHDR,0 ;Header for /REMARK - \keep
SMX S.REMAR,0 ; /together
MSC REMLEN-1
SMX S.ALL,-1
SMX S.PPN,0
SMX S.BRIEF,0
SMX S.FULL,1
> ;END DEFINE QSM
DEFINE MSC(A)<
BLOCK A
>
S.LINP==0 ;DUMMY
S.NOT==S.NOS1
SUBTTL Default Switch Table Values
;FIRST DEFINE THE TABLE OF DEFAULTS
;
DEFINE SMX(A,B),<
XLIST
EXP B
LIST
SALL
>
SWSEG ;Switch to low segment
SWDEFT: QSM
;NOW DEFINE THE ACCUMULATION TABLE
;
DEFINE SMX(A,B,C),<
XLIST
A: BLOCK 1
LIST
SALL
>
S.MIN:! QSM
S.EMIN==.-1
SWSEG ;Switch to high seg
SUBTTL The QUEUES macro and its related uses
;THE QUEUES MACRO DEFINES ALL PARAMETERS WHICH NEED TO BE
; EXPANDED INTO TABLES FOR THE VARIOUS QUEUES.
;
;EACH LINE IN THE QUEUES MACRO IS OF THE FORM:
;
; QQ PFX,A,B,PRC,HLP,PMT
;
;WHERE:
; PFX IS THE PREFIX NAME FOR THE COMMAND
; A IS THE QUEUE NAME IN SIXBIT
; B MONITOR COMMAND FOR THE QUEUE IN SIXBIT
; PRC PROCESSOR DISPATCH ADDRESS
; HLP NAME OF COMMAND TO LOOK UP IN HLP:
; PMT ASCII PROMPT STRING TO TYPE IN SCAN
;
;; PFX, A , B ,PROCES,HELP ,PROMPT
DEFINE QUEUES,<
QQ SUB,INP,<SUBMIT>,QUELOP,QUEUE ,<>
QQ PRI,LPT,<PRINT> ,QUELOP,QUEUE ,<>
QQ CPU,CDP,<CPUNCH>,QUELOP,QUEUE ,<>
QQ PUN,PTP,<TPUNCH>,QUELOP,QUEUE ,<>
QQ PLT,PLT,<PLOT> ,QUELOP,QUEUE ,<>
QQ PAT,PAT,<.PATCH>,QUELOP,QUEUE ,<>
> ;END DEFINE QUEUES
;MQUEUE IS THE DEFINITION OF MOUNT-CLASS QUEUE COMMANDS. THE
;QUEUE NAMES ARE BOGUS, BECAUSE THEY CANNOT BE ACCESSED DIRECTLY.
;; PFX, A , B ,PROCES,HELP ,PROMPT
DEFINE MQUEUE,<
QQ ALL,ALL,<ALLOCA>,ALLOC ,ALLOCA,<Volume-set-name: >
QQ CAN,CAN,<CANCEL>,.CANCE,CANCEL,<Request-type: >
QQ DIS,DIS,<DISMOU>,.DISMO,DISMOU,<Volume-set-name: >
QQ MOU,MOU,<MOUNT> ,MOUNT ,MOUNT ,<Volume-set-name: >
QQ SHO,SHO,<SHOW> ,.SHOW ,SHOW ,<What: >
QQ DEA,DEA,<DEALLO>,.DEALL,DEALLO,<Volume-set-name: >
>
;NOW INSURE THAT INP QUEUE IS FIRST AND DEFINE QUEUE TYPE SYMBOLS
;
..TMP==0
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
IFNDEF QTP'A,<QTP'A==..TMP>
..TMP==..TMP+1
> ;END DEFINE QQ
IF1,<
QUEUES
MQUEUE
>
;TABLE OF COMMANDS WHICH RUN QUEUE
;
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
SIXBIT /B/
>
SIXBIT /QUEUE/ ;SWITCH.INI LINE ON .RUN ETC
QCOMS: SIXBIT /QUEUE/
IFGE PUNCDP,< SIXBIT /PUNCH/>
QUEUES
NMQCOM==.-QCOMS ;LENGTH OF TRAD. QUEUE COMMAND TABLE
MQCOMS: MQUEUE ;DECLARE MOUNT-CLASS COMMANDS
MQCMLN==.-MQCOMS ;LENGTH OF MOUNT TABLE
QCMLEN==.-QCOMS ;LENGTH OF ENTIRE TABLE
PATCMD: BLOCK 1 ;PATCH COMMAND DISPATCH ADDRESS
;DEVICES USED BY THOSE COMMANDS
;
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
SIXBIT /A/
>
QDEVS: SIXBIT /LP/ ;QUEUE COMMAND (MUST BE LP NOT LPT)
IFG PUNCDP,<SIXBIT /CDP/>
IFE PUNCDP,<SIXBIT /PTP/>
IFL PUNCDP,<>
QUEUES
QMDEVS: MQUEUE ;ERSATZ DEVICES FOR MOUNT-CLASS
;DISPATCH TABLE FOR QUEUE COMMANDS
;CURRENTLY USED ONLY FOR MOUNT-CLASS COMMANDS, THIS TABLE ALLOWS FULL
;DISPATCHING BASED ON THE MONITOR COMMAND THAT INVOKED THE PROGRAM.
;THE TABLE CONSISTS OF THE ADDRESSES OF THE ROUTINES TO PROCESS THE COMMANDS
;FIRST REDEFINE QQ YET AGAIN
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
XWD 0,PRC
>
QDSTAB: QUEUES ;THE TRADITIONAL COMMANDS
BLOCK 1+IFGE PUNCDP,<1> ;FILLER BECAUSE "QUEUE" AND "PUNCH"
;CAUSE THE MOUNT TABLE TO BE OFF BY TWO
MQUEUE ;THE MOUNT-CLASS COMMANDS
QDSLEN==.-QDSTAB
;COMMAND BITS AND OFFSETS - DEFINE A BUNCH OF SYMBOLS TO MAKE LIFE EASIER
ZZ==-1
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
COM'PFX==<ZZ==ZZ+1>
CM.'PFX==1B<COM'PFX>
>
QUEUES
MQUEUE
;PSCAN AC ARG BLOCK TABLE
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<XWD PFX'PL,PFX'PB>
COMPBK: QUEUES
BLOCK 1+IFGE PUNCDP,<1> ;MORE STUPID FILLER
MQUEUE
;.PSCAN ARGUMENT BLOCKS - ONLY MOUNT NEEDS THEM
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
PFX'PB: IOWD MOUSWL, MOUSWN
XWD MOUSWD, MOUSWM
XWD 0,MOUSWP
<SIXBIT /'HLP/>
PFX'PL==.-PFX'PB
>
QUEUES
MQUEUE
;PSCAN PROMPT TABLE
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<EXP [ASCIZ \'PMT\]>
COMPMT: QUEUES
BLOCK 1+IFGE PUNCDP,<1> ;YET MORE STUPID FILLER
MQUEUE
XALL
;LOCATIONS OF INDIVIDUAL QUEUE LIMITS
; QQ PFX,A,B,PRC,HLP,PMT
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
EXP S.L'A
>
SWLDT: QUEUES
SALL
SUBTTL Miscellaneous macros used in MOUNT
DEFINE $DATA (NAME,SIZE<1>) <
NAME: BLOCK SIZE
..LOC==.>
DEFINE $GDATA (NAME,SIZE),<
$DATA (<NAME>,<SIZE>)
INTERN NAME
>
;Definitions for $RETT and friends - borrowed from GLXCOM
; Jump to location specified if TF contains TRUE
OPDEF JUMPT [JUMPN]
; Jump to location specified if TF contains FALSE
OPDEF JUMPF [JUMPE]
; Skip the next instruction if TF contains TRUE
OPDEF SKIPT [SKIPN]
; Skip the next instruction if TF contains FALSE
OPDEF SKIPF [SKIPE]
; Suppress DDT typeout of the above symbols
;
.NODDT JUMPT, JUMPF, SKIPT, SKIPF
GLOB <.POPJ, .RETT, .RETF> ;;SOME POPULAR RETURNS
OPDEF $RET [POPJ P,] ;;RETURN
OPDEF $RETT [PJRST .RETT] ;;RETURN TRUE
OPDEF $RETF [PJRST .RETF] ;;RETURN FALSE
OPDEF $RETIT [JUMPT .POPJ] ;;RETURN IF TRUE
OPDEF $RETIF [JUMPF .POPJ] ;;RETURN IF FALSE
.NODDT $RET,$RETT,$RETF,$RETIT,$RETIF
; .RETT AND .RETF are called via the $RETT and $RETF macros and can also
; be called directly. They both set the value of TF, one to TRUE and the other
; to FALSE. After doing this, they return via a POPJ P,
;
.RETF: TDZA TF,TF ;ZEROS MEAN FALSE
.RETT: SETO TF, ;ONES MEAN TRUE
POPJ P, ;RETURN
SUBTTL S%SIXB -- Convert ASCII to SIXBIT
;
;S1/ ASCII BYTE POINTER Returned updated
;S2/ SIXBIT value
S%SIXB: TLCE S1,-1 ;Left half of ptr = 0?
TLCN S1,-1 ;... or -1 ?
JRST [HRLI S1,(POINT 7,) ;Yes, Make up pointer for caller
JRST S%SIX1] ;Re enter flow
HRRI S1,@S1 ;Compute effective addr
TLZ S1,(@(17)) ;Remove indirection and index
S%SIX1: PUSHJ P,CNVSIX ;Do the work
$RETT ;Always return true
CNVSIX: PUSH P,T1 ;SAVE
PUSH P,T2 ; THE
PUSH P,T3 ; CALLER'S
PUSH P,T4 ; TEMPS
MOVEI T2,6 ;GET MAX NUMBER OF CHARACTERS IN NAME
MOVE T4,[POINT 6,S2] ; BP TO NODE STORAGE
SETZM S2 ;START FRESH
CNVS.1: ILDB T3,S1 ;GET NEXT CHARACTER FROM ATOM BUFFER
CAIL T3,"A"+40 ;LESS THAN LC A
CAILE T3,"Z"+40 ;OR GREATER THAN LC Z
SKIPA ;YES, NOT A LC CHARACTER
SUBI T3,40 ;NO, ITS LC, MAKE IT UC
CAIL T3,"0" ;RANGE
CAILE T3,"9" ; CHECK
CAIL T3,"A" ; THE
CAILE T3,"Z" ; CHARACTER
JRST CNVS.2 ;NO GOOD--RESTORE T1-T4 AND RETURN
SUBI T3,"A"-'A' ;SIXBITIZE
IDPB T3,T4 ;FILL OUT SIXBIT NODE NAME
SOJGE T2,CNVS.1 ;HAVE WE SEEN ENOUGH CHARACTERS?
;NO-GET MORE
;YES-FALL THROUGH TO EXIT
CNVS.2: POP P,T4 ;RESTORE
POP P,T3 ; THE
POP P,T2 ; CALLER'S
POP P,T1 ; TEMPS
$RETT ;AND GO BACK
SUBTTL .ZCHNK -- Zero an arbitrary memory area
;
;Call with S1/size of area
; S2/address of start
;Preserves all ACs, returns TRUE unless you are trying to zero ACs.
.ZCHNK: TRNN S1,-1 ;Anything to do?
$RETT ;No..just return
PUSH P,S1 ;SAVE CALLER'S SIZE
PUSH P,S2 ;AND ADDRESS
ZCHN.1: ZERO 0(S2) ;CLEAR FIRST WORD
SOJE S1,ZCHN.2 ;COUNT OF 1,,JUST RETURN
ADDI S1,0(S2) ;COMPUTE END ADDRESS
CAIGE S1,20 ;OUT OF THE ACS?
N$FATE (<AZA>,,<Attempt to zero the ACs>)
HRLS S2 ;GET ADDR,,ADDR OF CHUNK
AOS S2 ;AND NOW ADDR,,ADDR+1
BLT S2,0(S1) ;NOW CLEAR THE CHUNK
ZCHN.2: POP P,S2 ;RESTORE CALLER'S CHUNK ADDR
POP P,S1 ;AND HIS SIZE
$RETT ;AND RETURN
SUBTTL ERRORS returned by subroutines
;Define subroutine error return mechanism
DEFINE $RETER(CODE) <
PJRST [MOVEI S1,CODE
$RETF]>
;Define the errors
DEFINE ERRS <
XX (IDN,Invalid device type)
XX (NSD,No such device)
XX (UND,Unknown device type)
XX (USD,Unsupported device type)
XX (EZD,Ersatz device type)
XX (PLD,Pathological device type)
XX (ASN,Ambiguous structure name)
XX (ISN,Invalid structure name)
XX (GDN,Generic device name)
XX (NSS,No switch specified)
> ;End ERRS definition
DEFINE XX(CODE,TEXT) <
ZZ==ZZ+1
ER$'CODE==ZZ>
ZZ==0 ;Initialize error variable
ERRS ;Equate the error codes
SUBTTL QUEUE Entry and Initialization
QUEUE: PORTAL .+2 ;NORMAL ENTRY
PORTAL .+2 ;CCL ENTRY
TDZA T1,T1 ;ALLOW FOR CCL ENTRY POINT
MOVEI T1,1 ;YES--FLAG CCL ENTRY
MOVEM T1,STRTOF ;SAVE FOR ISCAN
RESET ;RESET ANY EXTERNAL I/O
SETZM F,ZCOR ;CLEAR FLAG, CLEAR CORE
MOVE T1,[ZCOR,,ZCOR+1]
BLT T1,EZCOR
MOVE P,[IOWD LN$PDL,PDLST] ;ESTABLISH PUSH-DOWN LIST
PUSHJ P,GTTABS ;DO ALL NECESSARY GETTABS
PJOB T1, ;GET THIS JOB'S NUMBER
MOVNS T1 ;GET JOB ARG FOR JOBSTS UUO
JOBSTS T1, ;GET THIS JOB'S STATUS
JRST .+2 ;FAILED--ASSUME LOGGED IN
TXNE T1,JB.ULI ;SEE IF LOGGED IN
TLO F,L.LOGI ;YES--SET FLAG
TLNE F,L.LOGI ;SEE IF LOGGED IN
JRST QUESS2 ;YES--PROCEED
TLO F,L.NSBJ ;INDICATE NOT LOGGED IN
SETOM T1 ;START AT OUR JOB
QUESTL: CTLJOB T1, ;GET CONTROLLING NUMBER
JRST QUESS2 ;NONE--ASSUME OK ANYWAY
JUMPL T1,QUESS2 ;IF NONE, ASSUME OK
MOVN T2,T1 ;GET -JOB
JOBSTS T2, ;GET ITS STATUS
SETOM T2 ;ASSUME LOGGED IN
TXNN T2,JB.ULI ;SEE IF LOGGED IN
JRST QUESTL ;NO--LOOP ON UP CHAIN
HRLZ T2,T1 ;GET THIS JOB'S NUMBER
HRRI T2,.GTPPN ;POINT TO PPN TABLE
GETTAB T2, ;GET PPN FROM MONITOR
JRST QUESS2 ;NONE!--GIVE UP
MOVEM T2,.MYPPN## ;OK--USE THAT INSTEAD
TLZ F,L.NSBJ ;OK AFTER ALL (PROBABLY OPSER CALL)
QUESS2: MOVE T1,.JBREL## ;SAVE CURRENT CORE
HRL T1,.JBFF## ;AND START OF FREE CORE
MOVEM T1,SAVCOR ;FOR LATER TO RESTORE
MOVE T1,[XWD ISCLEN, ISCARG] ;POINT AT .ISCAN ARGUMENTS
PUSHJ P,.ISCAN## ;INITIALIZE COMMAND SCANNER
MOVEM T1,COMIDX ;SAVE COMMAND INDEX
SKIPGE T1 ;SEE IF COMMAND
TDZA T1,T1 ;NO--CLEAR DEFAULT TYPE
MOVEI T2,QDEVS(T1) ;GET THE TABLE ADDRESS
CAIL T2,QMDEVS ;IN THE MOUNT-CLASS TABLE?
JRST QUESS3 ;YES--TREAT DIFFERENTLY
MOVE T2,QDEVS(T1) ;NO--GET QUEUE NAME
MOVEM T2,DQTYPE ;STORE AS DEFAULT TYPE
JRST QUELOP ;AND GO TO TRADITIONAL QUEUE LOOP
QUESS3: MOVEM T1,COMIDX ;SAVE COMMAND INDEX
TXO F,FL.MCL ;WE HAVE A MOUNT-CLASS COMMAND
BEGIN: PUSHJ P,MSETUP ;GET M SET UP BEFORE ANYTHING ELSE
PUSHJ P,JOBPRM ;Read initial JOB parameters
PUSHJ P,MOUDEF ;DEFAULT THE MOUNT SWITCHES
MOVE T1,COMIDX ;GET COMMAND INDEX
PUSHJ P,@QDSTAB(T1) ;GO DISPATCH TO THE ROUTINE TO
;HANDLE IT
RESET ;CLEAN UP
PUSHJ P,.MONRT## ;MOUNT-CLASS COMMANDS DO NOT
JRST .-1 ;HAVE A 'COMMAND MODE', SO IF WE
;GET HERE, WE LEAVE.
SUBTTL PSCAN - Init scanning of switches
;Routine to do partial line scanning and leading switch handling
;CALL: PUSHJ P,PSCAN
PSCAN: HRRZ T1,COMIDX ;GET COMMAND INDEX
MOVE T1,COMPBK(T1) ;POINT TO .PSCAN BLOCK
PSCAN0: SETOM REPARS ;INIT REPARSING FLAG
PUSH P,.OPTN## ;SAVE /OPTION
PUSH P,.FLVRB## ;SAVE /MESSAGE
PUSHJ P,.PSCAN## ;SET UP PARTIAL LINE SCANNER
TDZA T1,T1 ;WANTS TO PROMPT
MOVEI T1,1 ;JUST PARSE
POP P,.FLVRB## ;RESTORE /MESSAGE
POP P,.OPTN## ;RESTORE /OPTION
SKIPL REPARS ;DID SCAN RESTART .PSCAN (/HELP MAYBE?)
JRST .MONRT## ;PROBABLY AN ERROR - JUST EXIT
JUMPN T1,PSCAN1 ;JUMP IF NO PROMPT NEEDED
IFN FTPROMPT,<
HRRZ T1,COMIDX ;GET INVOKING COMMAND INDEX
MOVE T1,COMPMT(T1) ;AND ITS ASSOCIATED PROMPT STRING
SKIPN (T1) ;NULL STRING?
JRST PSCAN2 ;DO A DUMMY PROMPT
PUSHJ P,TTYPMT ;PROMPT
>
IFE FTPROMPT,<
SETOM C ;IF NO COMMAND TYPED ON THE LINE,
POPJ P, ;SET EOL AND LEAVE
>
PSCAN1: PUSHJ P,.TIAUC## ;PRIME THE PUMP - GET A CHARACTER
PJRST SWTSCN ;ENTER SWITCH SCANNER
PSCAN2: OUTCHR "#" ;OUTPUT THE CANONICAL CONTINUATION LINE PROMPT
JRST PSCAN1 ;AND MOVE ON
TTYPMT: OUTSTR (T1) ;OUTPUT THE STRING
POPJ P,
SUBTTL OSCAN -- READ SWITCH.INI AFTER COMMAND LINE IS PARSED
OSCAN: PUSHJ P,.PSH4T## ;SAVE THE TEAS
MOVEI T1,O.ZER ;ADDRESS OF OUR FILE
MOVEI T2,O.LZER ;AND ITS LENGTH
PUSHJ P,.GTSPC## ;GET SCAN SWITCHES TYPED SO FAR
MOVE T1,[XWD OSCMLE, OSCMAR] ;POINT AT .OSCAN ARGUMENTS
MOVX T2,'MOUNT ' ;WHAT TO READ
MOVEM T2,OSCNML ;STORE IT
MOVE T2,COMIDX ;GET THE COMMAND INDEX
MOVE T2,QCOMS(T2) ;GET THE COMMAND
MOVEM T2,OSCNML+1 ;AND SAVE FOR CALL
PUSHJ P,.OSCAN## ;LOOK AT OPTION FILE
MOVEI T1,O.ZER ;ADDRESS OF OUR FILE
MOVEI T2,O.LZER ;AND ITS LENGTH
PUSHJ P,.OSDFS## ;MERGE IN SCAN SWITCHES FROM .INI FILE
PUSHJ P,.POP4T## ;RESTORE THE TEMPS
POPJ P, ;GO BACK
SUBTTL SWTSCN - Parse switches (Stolen from LOGIN)
SWTSCN: CAIN C," " ;A SPACE?
PUSHJ P,.TIAUC## ;GET A REAL CHARACTER
CAIE C,"@" ;SEE IF INDIRECT FILE
JRST SWTSC1 ;IT ISN'T
PUSHJ P,.GTIND## ;YES - SET UP FOR IT
JUMPLE C,SWTSC1 ;LOOP FOR EOL
JRST E.ILSC## ;ELSE ERROR
SWTSC1: CAIN C,"," ;COMMA (I.E., MORE KEYWORDS?)
$RETT ;YES - GO BACK
CAIE C,"/" ;SWITCH COMING?
$RETT ;NO
AOS REPARS ;FIRST TIME THROUGH?
PUSHJ P,.KEYWD## ;YES -- GO PROCESS IT
$RETER(ER$NSS) ;NO - No switch specified
AOS REPARS ;INDICATE A SWITCH TYPED
JUMPLE C,.POPJ## ;RETURN IF EOL
CAIN C," " ;A SPACE?
PUSHJ P,.TIAUC## ;YES--EAT IT
JRST SWTSC1 ;LOOP BACK FOR ANOTHER SWITCH
SUBTTL QUELOP Traditional Main Processing Loop
;HERE WHENEVER * TYPED (IE, MAJOR RESTART)
;
QUELOP: TXZ F,FL.MCL ;INDICATE A TRADITIONAL COMMAND
MOVE T1,[XWD TSCLEN,TSCARG] ;POINT AT .TSCAN ARGUMENTS
PUSHJ P,.TSCAN## ;CALL TRADITIONAL SCANNER
SKIPE O.MODM ;SEE IF OUTPUT SPEC
JRST SOMCMD ;YES--NORMAL HANDLING
MOVE T1,I.NXZR ;SEE IF ANY COMMANDS
MOVE T2,I.INZR ;GET FIRST INPUT SPEC
SUB T1,T2 ;GET NUMBER OF SPECS*I.LZER
JUMPE T1,NOCMD ;NONE--NULL COMMAND
CAIN T1,I.LZER ;SEE IF JUST ONE
SKIPE .FXNAM(T2) ; WITH NULL FILE NAME
JRST SOMCMD ;NO--SOMETHING THERE
HLLZ T1,.FXEXT(T2) ;GET THE EXTENSION
JUMPN T1,SOMCMD ;JUMP IF THERE IS ONE
;HERE ON A NULL MONITOR COMMAND
;
NOCMD: PUSHJ P,DEFAU1 ;GO FILL IN MODIFIED DEFAULTS
JRST DOCMD ;THEN GO BELOW TO DO THE WORK
;HERE WHEN A NON-NULL COMMAND IS FOUND
;
SOMCMD: PUSHJ P,DEFAUL ;GO FILL IN DEFAULTS
;HERE AFTER DEFAULTS ARE DONE
;
DOCMD: PUSHJ P,COMMND ;DO THE COMMAND
PUSHJ P,TTCRLF ;DO A CRLF
JRST QUELOP ;LOOP BACK FOR MORE WORK
SUBTTL SCAN Argument Blocks
SWSEG
PSCARG: IOWD SWTCHL, SWTCHN ;IOWD POINTER TO SWITCH NAMES
XWD SWTCHD, SWTCHM ;SWITCH DEFAULTS,,PROCESSOR
XWD 0, SWTCHP ;ZERO,,STORAGE POINTERS
PSCHLP: SIXBIT /QUEUE/ ;NAME FOR HELP (DIDDLED BY CODE)
PSCLEN==.-PSCARG
SWSEG ;BACK TO HIGH SEG
;.ISCAN ARGUMENT BLOCK
ISCARG: IOWD QCMLEN, QCOMS ;IOWD POINTER TO MONITOR COMMAND NAMES
XWD STRTOF, 'QUE' ;ADDRESS OF START OFFSET,,CCL NAME
ISCLEN==.-ISCARG ;LENGTH OF .ISCAN ARGUMENT BLOCK
;.TSCAN ARGUMENT BLOCK
TSCARG: IOWD SWTCHL, SWTCHN ;IOWD POINTER TO SWITCH NAMES
XWD SWTCHD, SWTCHM ;DEFAULTS,,PROCESSOR
XWD 0, SWTCHP ;(FUTURE),,STORAGE POINTERS
SIXBIT /QUEUE/ ;NAME FOR HELP
XWD CLRANS, CLRFIL ;CLEAR ANSWER,,PER-FILE AREAS
XWD INFIL, OUTFIL ;ALLOCATE INPUT,,OUTPUT FILE SPEC
XWD FILSTK, APLSTK ;MEMORIZE,,APPLY STICKY DEFAULTS
XWD CLRSTK, 0 ;CLEAR STICKY DEFAULTS,,OUTPUT ROUTINE
TSCLEN==.-TSCARG ;LENGTH OF .TSCAN ARGUMENT BLOCK
;.OSCAN ARGUMENT BLOCK FOR QUEUE-CLASS COMMANDS
OSCARG: IOWD SWTCHL, SWTCHN ;IOWD POINTER TO SWITCH NAMES
XWD SWTCHD, SWTCHM ;DEFAULTS,,PROCESSOR
XWD 0, SWTCHP ;(FUTURE),,STORAGE POINTERS
XWD 0, 0 ;NO HELP
XWD 2, OSCNML ;POINTER TO OPTIONS LIST
OSCLEN==.-OSCARG ;LENGTH OF .OSCAN ARGUMENT BLOCK
;.OSCAN ARGUMENT BLOCK FOR MOUNT-CLASS COMMANDS
OSCMAR: IOWD MOUSWL, MOUSWN ;IOWD POINTER TO SWITCH NAMES
XWD MOUSWD, MOUSWM ;DEFAULTS,,PROCESSOR
XWD 0, MOUSWP ;(FUTURE),,STORAGE POINTERS
XWD 0, 0 ;NO HELP
XWD 2, OSCNML ;POINTER TO OPTIONS LIST
OSCMLE==.-OSCMAR ;LENGTH OF .OSCAN ARGUMENT BLOCK
SUBTTL TSCAN Routine Calls
;HERE TO CLEAR OUT A SINGLE FILE SPEC
;
CLRFIL: SETZM F.ZER
MOVE T1,[F.ZER,,F.ZER+1]
BLT T1,F.EZER
SETOM F.MIN
MOVE T1,[F.MIN,,F.MIN+1]
BLT T1,F.EMIN
POPJ P,
;HERE WHEN A SPECIFICATION FOR OUTPUT SIDE IS FOUND
;
OUTFIL: SKIPN F.MOD ;ANY MOD SWITCHES?
SKIPE F.MODM ; " " "
JRST OUTFL1 ;YES, GIVE ERROR
SKIPGE F.STRT ;/START?
SKIPL F.RPT ;OR /REPORT?
OUTFL1: JRST E.FMO## ;YES, GIVE ERROR
MOVEI T1,O.ZER ;POINT TO OUTPUT AREA
MOVEI T2,O.LZER ;INDICATE LENGTH
POPJ P, ;RETURN
;HERE WHEN A SPECIFICATION FOR INPUT SIDE FOUND
;
INFIL: PUSHJ P,GTCLIN ;GET AND CLEAR INPUT AREA
MOVEI T2,I.MOD(T1) ;POINT TO OUR PART
HRLI T2,F.ZER ;POINT TO OUR F AREA
BLT T2,I.LZER(T1) ;COPY OUR PART
MOVEI T2,I.LZER ;AND PASS BLOCK LENGTH
POPJ P, ;RETURN
;HERE TO CLEAR STICKY DEFAULTS
;
CLRSTK: SETZM P.ZER ;ZERO OUT DEFAULTS
MOVE T1,[P.ZER,,P.ZER+1]
BLT T1,P.EZER
SETOM P.MIN
MOVE T1,[P.MIN,,P.MIN+1]
BLT T1,P.EMIN
POPJ P,
;CLRANS -- CLEAR SCANNING ANSWER AREA
;CALL: PUSHJ P,CLRANS
;USES T1
;
CLRANS: HLLZS F ;CLEAR TEMPORARY FLAGS
SETZM S.ZER ;ZERO OUT COMMAND ACCUMULATORS
MOVE T1,[S.ZER,,S.ZER+1]
BLT T1,S.EZER
SETOM S.MIN ;PRESET SWITCH PARAMETERS
MOVE T1,[S.MIN,,S.MIN+1]
BLT T1,S.EMIN
MOVE T1,SAVCOR ;GET INITIAL START OF FREE CORE
HLRZM T1,.JBFF## ;SET START OF FREE CORE
HLRZM T1,I.INZR ;ESTABLISH PARAMETER AREA HERE
HLRZM T1,I.NXZR ;AND OF ZERO LENGTH
TLZ T1,-1 ;CLEAR JUNK
CORE T1, ;RESTORE REAL CORE ALSO
JFCL ;OK IF CAN'T
POPJ P, ;RETURN
;FILSTK -- MEMORIZE STICKY DEFAULTS
;CALL: PUSHJ P,FILSTK
; RETURNS AFTER NON-ZERO F.XXX COPIED TO P.XXX
;USES T1, T2
;
FILSTK: MOVE T1,F.MOD ;COPY SWITCHES
MOVE T2,F.MODM
ANDCAM T2,P.MOD
IORM T1,P.MOD
IORM T2,P.MODM
MOVE T1,F.STRT ;GET THE STARTING POINT
MOVEM T1,P.STRT ; ..
SETCM T1,F.RPT ;MEMORIZE /REPORT
JUMPE T1,FILS.1 ;DON'T STORE NULL REPORT
DMOVE T1,F.RPT ;GET /REPORT
DMOVEM T1,P.RPT ;AND SAVE IT
FILS.1: MOVE T1,[XWD F.FONT,P.FONT] ;MEMORIZE /FONT
MOVE T2,F.FONT ;GET /FONT
CAME T2,[-1] ;WAS IT SET ????
BLT T1,P.FONT+FNMLTH-1 ;YES, MEMORIZE IT
POPJ P, ;AND RETURN
;HERE AT END OF SPECIFICATION TO APPLY USER SUPPLIED DEFAULTS
;
APLSTK: MOVE T1,P.MOD ;APPLY ALL FILE SWITCHES
ANDCM T1,F.MODM ;MASK USED TO INDICATE WHICH WERE TYPED
IORM T1,F.MOD ; ..
MOVE T1,P.MODM ; ..
IORM T1,F.MODM ; ..
MOVE T1,F.STRT ;GET THE STARTING POINT
CAMN T1,[-1] ;WAS IT SPECIFIED?
MOVE T1,P.STRT ;NO, USE THE GLOBAL DEFAULT
MOVEM T1,F.STRT ;NO--SUPPLY DEFAULT
SETCM T1,P.RPT ;GET THE REPORT CODE
JUMPE T1,APLS.1 ;NOW FOR THE FONT SWITCH
SETCM T1,F.RPT ;SKIP IF NO REPORT GIVEN
JUMPN T1,APLS.1 ;DO THE FONT SWITCH
DMOVE T1,P.RPT ;GET /REPORT
DMOVEM T1,F.RPT ;SAVE IT
APLS.1: MOVE T2,[XWD P.FONT,F.FONT] ;PREPARE TO BLT STICKY FONT NAME
MOVE T1,F.FONT ;GET FILE SPECIFIC /FONT
CAME T1,[-1] ;WAS IT SET ????
POPJ P, ;YES, DON'T USE STICKY
MOVE T1,P.FONT ;NO, GET STICKY /FONT
CAME T1,[-1] ;WAS IT SET ????
BLT T2,F.FONT+FNMLTH-1 ;YES, APPLY IT
POPJ P, ;RETURN
SUBTTL DEFAUL Command Scanning Default Routines
;DEFAUL -- SUBROUTINE TO FILL IN DEFAULTS AND DETECT
; INCONSISTENCIES AFTER COMMAND SCANNING
;DEFAU1 -- DITTO EXCEPT DEFAULT OPERATION IS /LIST
;USES EVERYTHING
;
DEFAUL: MOVEI T1,AD.OPN ;FIRST DECIDE WHAT TYPE OF REQUEST
SKIPLE S.CHK ;HAVE /CHECK ?
SKIPL S.LIST ;HAVE /LIST ?
JRST DEFAU0 ;CONTINUE
MOVEI T2,LISTJOBS ;GET DEFAULT /LIST VALUE
MOVEM T2,S.LIST ;DEFAULT TO /LIST:JOBS
DEFAU0: SKIPL S.LIST ;SEE IF /LIST SHOWED UP
DEFAU1: MOVEI T1,.QORLS ;YES--FORCE /LIST AS DEFAULT
SKIPGE S.OPN
MOVEM T1,S.OPN
SKIPLE S.DFR ;WAS /DEFER SPECIFIED?
POPJ P, ;YES, RETURN NOW
MOVE T1,S.OPN ;FETCH ACTUAL OPERATION
MOVE T2,O.MODM ;GET INDICATOR OF OUTPUT
CAIE T1,.QORMD ;SEE IF /MODIFY
CAIN T1,.QORKL ;OR IF /KILL
SKIPA ;YES, SKIP
JRST DEFA1A ;NO, GO ON
JUMPE T2,E.SJN ;TYPE "JOB OR SEQ" ON LEFT...
MOVX T1,FX.NDV ;GET NULL DEVICE BIT
TDNN T1,O.MOD ;WAS IT SET?
JRST DEFA1A ;NO, HE SPECIFIED ONE, CONTINUE
MOVS T2,DQTYPE ;NO, GET DEFAULT QUEUE TYPE
SKIPE DQTYPE ;IS IT IS NULL,
CAIN T2,'LP ' ; OR JUST "LP"
N$FATE <NQS>,,<No queue specified in /KILL or /MODIFY>
DEFA1A: SETZM MADFIL ;CLEAR "MADE FILESPEC"
PUSHJ P,QUETYP ;IDENTIFY WHAT TYPE OF QUEUE
MOVE J,T1 ;SAVE AWAY FOR EASY TESTS LATER
MOVE P1,I.INZR ;RESET TO START OF INPUT AREA
ADDI P1,I.LZER ;FORCE AT LEAST ONE REQUEST
SKIPN J ;SEE IF INPUT QUEUE
ADDI P1,I.LZER ;YES--THEREFORE, TWO ENTRIES USED
DEFAU2: CAMG P1,I.NXZR ;SEE IF NEED MORE THAN GOT
JRST DEFAU3 ;NO--OK TO PROCEED
PUSHJ P,.CLRFL## ;CLEAR FXXX AREAS
PUSHJ P,APLSTK ;APPLY STICKY DEFAULTS
PUSHJ P,INFIL ;ALLOCATE SPACE
PUSHJ P,.GTSPC## ;COPY SPEC
SETOM MADFIL ;WE MADE A FILESPEC
JRST DEFAU2 ;LOOP BACK TO SEE IF ENOUGH
DEFAU3: MOVE I,I.INZR ;START AT BEGINNING OF REQUESTS
JUMPN J,DEFAU4 ;IF NOT INPUT QUEUE, WE ARE DONE
CAMN P1,I.NXZR ;IF INP AND NOT LIST SEE IF GT 2 ENTRY
JRST DEFAU4 ;NO--OK TO PROCEED
N$WARN <OTE>,,<Input queue request uses only two entries>
MOVEM P1,I.NXZR ;CHANGE LIMIT TO AGREE
DEFAU4: PUSHJ P,CLRFIL ;CLEAR THE F AREA
PUSHJ P,CLRSTK ;CLEAR THE P AREAA
MOVE T1,[XWD OSCLEN, OSCARG] ;POINT AT .OSCAN ARGUMENTS
MOVX T2,'QUEUE ' ;WHAT TO READ
MOVEM T2,OSCNML ;STORE IT
MOVE T2,COMIDX ;GET THE COMMAND INDEX
MOVE T2,QCOMS(T2) ;GET THE COMMAND
MOVEM T2,OSCNML+1 ;AND SAVE FOR CALL
MOVE I,S.OPN ;GET OPERATION WORD
CLEARM CREFLG ;ASSUME IT'S CREATE
PUSH P,S.ATTRIB ;SAVE /UNIT FOR LIST COMMANDS
PUSH P,S.UNTY ;DITTO
CAIE I,.QORMD ;IS IT MODIFY?
CAIN I,.QORKL ;OR KILL?
SOSA CREFLG ;IT'S NOT CREATE!!
PUSHJ P,.OSCAN## ;LOOK AT OPTION FILE
POP P,T2 ;GET UNIT TYPE BACK
POP P,T1 ;GET POSSIBLE /UNIT VALUE BACK
CAIN I,.QORLS ;/LIST COMMAND ???
DMOVEM T1,S.ATTR ;YES, IGNORE .OSCAN'S /UNIT OR /STREAM
SETOM PTHFCN ;SET TO READ DEFAULT
MOVE T1,[.PTMAX,,PTHFCN]
PATH. T1, ; READ IT
SETZM PTHPPN ;CAN'T--ASSUME DEFAULT
SKIPN PTHPPN ;SEE IF SET
SETZM PTHPPN+1 ;NO--CLEAR SFDS
MOVE T1,.MYPPN## ;GET SELF
SKIPN PTHPPN ;SEE IF DEFAULT KNOWN
MOVEM T1,PTHPPN ;NO--THEN USE SELF
MOVEI T1,O.ZER ;SETUP ARGS FOR OSDFS
MOVEI T2,O.LZER ; "
SKIPN CREFLG ;IS IT CREATE?
PUSHJ P,.OSDFS## ;YES, DO SWITCH INI DEFAULTING
CAIE I,.QORLS ;SEE IF LISTING DEVICE
JRST OUDEF1 ;NO--NOT A REAL DEVICE
MOVSI T1,'TTY' ;SET DEFAULT DEVICE
SKIPN P1,O.DEV ;YES--CHECK DEVICE CHARACTERISTICS
MOVE P1,T1 ;NO DEVICE--USE DEFAULT
MOVEM P1,O.DEV ;SAVE FOR LATER
MOVE T1,O.MOD ;GET MOD WORD
TXNE T1,FX.PHY ;SEE IF PHYS I/O NEEDED
DEVCHR P1,UU.PHY ;YES--TRY IT
TXNN T1,FX.PHY ;SEE IF NOT
DEVCHR P1, ;NO--USE LOGICAL FROM THE MONITOR
TXNN P1,DV.OUT ;SEE IF CAPABLE OF OUTPUT
JRST E.NOD ;NO--TELL USER HE BLEW IT
JRST OUDEF2 ;YES--PROCEED(WARNING--P1 USED BELOW)
OUDEF1: MOVX T1,FX.NDV ;CLEAR OUT
ANDCAM T1,O.MOD ; NULL DEVICE FLAG
SKIPE O.EXT ;SKIP IF EXTENSION IS ZERO
N$FATE <OEI>,,<Output Extension is Illegal>
OUDEF2: CAIN I,.QORLS ;SEE IF LISTING
JRST OUDF2A ;YES--SKIP ONWARD
MOVE T1,O.MOD ;GET OUTPUT FLAGS
TXNE T1,FX.DIR ;WAS A DIRECTORY SPECIFIED?
JRST OUDF2B ;YES, CONTINUE ON
SETOM O.DIRM ;NO, SET DIRECTORY MASK
JRST OUDF2A ;AND CONTINUE ON
OUDF2B: MOVE T1,.MYPPN## ;GET SELF
MOVSI T2,-1 ;MASK LEFT HALF
TDNN T2,O.DIR ;SEE IF SET
HRROS O.DIRM ;NO--PUT ON MASK
TDNN T2,O.DIR ; ..
HLLM T1,O.DIR ;SET IN SELF PROJECT
MOVEI T2,-1 ;MASK RIGHT HALF
TDNN T2,O.DIR ;SEE IF SET
HLLOS O.DIRM ;NO--PUT ON MASK
TDNN T2,O.DIR ; ..
HRRM T1,O.DIR ;SET IN SELF PROGRAMMER
SKIPE O.DIR+2 ;CHECK FOR SFDS
JRST E.QSFD ;ILLEGAL IN QUEUE USER
JRST OUDEF4 ;SKIP ON
OUDF2A: CAIE I,.QORLS ;LISTING THE QUEUES?
JRST OUDF3A ;NO
MOVE P1,O.DEV ;GET OUTPUT DEVICE
MOVX T1,FX.PHY ;GET PHYSICAL FLAG
SETZM T2 ;ASSUME NOT PHYSICAL
TDNE T1,O.MOD ;IS IT SET?
MOVX T2,UU.PHY ;YES
DEVCHR P1,(T2) ;GET DEVCHR WORD
SKIPN O.NAM ;HAVE A FILE NAME?
TXNN P1,DV.DIR ;A DIRECTORY DEVICE?
JRST OUDF3A ;NO NEED TO GENERATE A FILE NAME
MSTIME T1, ;YES--MANUFACTURE NAME HHMMSS
IDIVI T1,^D1000 ;GET SECONDS
MOVE T4,[POINT 6,O.NAM] ;SETUP BYTE POINTER
MOVSI T3,-6 ;INITIALIZE LOOP COUNTER
OUDEF3: IDIV T1,[^D36000
^D3600
^D600
^D60
^D10
^D1](T3) ;GET NEXT DIGIT
ADDI T1,'0' ;CONVERT TO SIXBIT DIGIT
IDPB T1,T4 ;STORE INTO NAME
MOVE T1,T2 ;RESTORE REMAINDER
AOBJN T3,OUDEF3 ;LOOP
SETOM O.NAMM ;CLEAR MASK TO NO WILD-CARDS
OUDF3A: HRLOI T1,'LSQ' ;GET DEFAULT EXTENSION
SKIPN O.EXT ;ONE SPECIFIED?
MOVEM T1,O.EXT ;NO, USE THE DEFAULT
OUDEF4: SKIPE CREFLG ;SEE IF MODIFY
JRST OUDEF5 ;YES--WILD CARDS ARE LEGAL
MOVE T1,[O.LZER,,O.ZER] ;SETUP TO CALL .STOPN
MOVEI T2,L.OPEN ;OPEN BLOCK
MOVE T3,[LN$ENT,,L.LOOK]
PUSHJ P,.STOPN## ;CALL .STOPN
N$FATE <OWI>,,<Output Wildcards are Illegal>
JRST INDEF ;AND CONTINUE
OUDEF5: SKIPLE S.SEQ ;WAS /SEQ: SPECIFIED ??
JRST INDEF ;YES,,CONTINUE
SKIPE O.NAM ;WAS THERE A JOBNAME ??
JRST INDEF ;YES,,CONTINUE
SKIPG S.RID ;WAS /REQ: SPECIFIED ??
N$FATE <NSR>,,<Jobname or /SEQUENCE or /REQUESTID required>
;HERE TO SUPPLY INPUT SIDE DEFAULTS
INDEF: MOVE J,QTYPE ;GET QTYPE IN J
MOVE I,I.INZR ;INITIALIZE LOOP
;LOOP HERE TO DEFAULT NEXT INPUT FILE
INDEF1: SKIPE CREFLG ;SEE IF /MODIFY
JRST INDEF2 ;YES--SKIP TO DIRECTORY TESTS
MOVEI T1,0(I) ;START SETTING UP TO CALL OSDFS
MOVEI T2,.FXLEN ;ADR AND LEN
PUSHJ P,.OSDFS## ;CALL IT
;DEVICE DEFAULTING
MOVSI T1,'DSK' ;DEFAULT TO DSK
CAMN I,I.INZR ;IS THIS THE FIRST SPEC?
JRST INDF11 ;YES,,SKIP THIS
MOVE T1,.FXDEV-I.LZER(I) ;USE DEVICE FROM LAST SPEC
JUMPN J,INDF11 ;JUMP IF NOT INPUT QUEUE
MOVSI T1,'DSK' ;DEFAULT IS ALWAYS DSK: FOR LOG FILE
MOVX T3,%EQONL ;LOAD OUTPUT NOLOG BIT
MOVS T2,.FXDEV(I) ;GET LOGFILE DEVICE
CAIN T2,'NUL' ;IS IT NUL:???
MOVEM T3,S.OUT ;YES, SET THE EXPLICIT BIT
JRST INDF12 ;PROCEED
INDF11: JUMPGE J,INDF12 ;JUMP IF NOT /LIST
MOVE T1,DQTYPE ;GET DEFAULT QUEUE
TLNN T1,(77B17) ;IS IT FROM QUEUE COMMAND?
SETZM T1 ;YES--DEFAULT IS ALL:
INDF12: MOVX T2,FX.NDV ;SEE IF
TDNN T2,.FXMOD(I) ; NULL DEVICE
SKIPN .FXDEV(I)
MOVEM T1,.FXDEV(I)
;FILE NAME DEFAULTING FOR INPUT QUEUE CONTROL FILE
JUMPN J,INDF13 ;JUMP IF NOT INPUT QUEUE
CAME I,I.INZR ;FIRST FILE?
JRST INDF13 ;NO, REGULAR DEFAULTING FOR LOG FILE
MOVE T1,.FXNMM(I) ;TEST NAME WILD
CAME T1,[-1] ;WILD NAME?
SKIPN .FXNAM(I) ;YES--SEE IF NAME THERE
JRST .+2 ;NO--THEN OK
JRST E.WCI ;YES--ILLEGAL
MOVEI T1,0 ;CLEAR DEFAULT
SKIPN T2,O.NAM ;GET JOB NAME
MOVE T2,T1 ;IF NO JOB NAME, DEFAULT IS CTL FILE
SKIPN T1,.FXNAM(I) ;SEE IF NAME SUPPLIED
MOVE T1,T2 ;NO--GET DEFAULT NAME
JUMPE T1,E.NNI ;ERROR IF NONE
MOVEM T1,.FXNAM(I) ;AND STORE RESULT
SETOM .FXNMM(I) ;REMOVE WILDCARD FROM NAME
JRST INDF14 ;SEE ABOUT EXTENSION
;FILE NAME DEFAULTING FOR OUTPUT QUEUES AND /LIST
INDF13: SKIPE .FXNAM(I) ;DEFAULT FILE NAME
JRST INDF14 ;NO DEFAULT NEEDED
CAME I,I.INZR ;SEE IF FIRST FILE
SKIPA T1,.FXNAM-I.LZER(I) ;NO--USE PREVIOUS FILE NAME
MOVSI T1,'* ' ;YES--SUPPLY WILD DEFAULT
MOVEM T1,.FXNAM(I)
CAME I,I.INZR ;SEE IF FIRST
SKIPA T1,.FXNMM-I.LZER(I) ;NO--USE PREVIOUS MASK
MOVEI T1,0 ;YES--USE WILD MASK
MOVEM T1,.FXNMM(I) ; ..
;EXTENSION DEFAULTING
INDF14: SKIPE .FXEXT(I) ;DEFAULT EXTENSION
JRST INDF16 ;NOT NEEDED
MOVSI T1,'* ' ;SET DEFAULT FOR /MODIFY
SKIPE CREFLG ;SEE IF /MODIFY
JRST INDF15 ;YES--GO STORE DEFAULT
JUMPN J,INDF16 ;JUMP IF NOT INPUT QUEUE
HRLOI T1,'CTL' ;LOAD THE EXTENSION
CAMN I,I.INZR ;SEE IF FIRST FILE
JRST INDF15 ;YES--PROCEED BELOW
HRLOI T1,'LOG' ; CHANGE TO LOG
INDF15: MOVEM T1,.FXEXT(I) ;STORE IT
;CHECK FOR NON-WILD EXTENSION ON INPUT QUEUE
INDF16: JUMPN J,INDEF2 ;JUMP IF NOT INPUT QUEUE
SETCM T1,.FXEXT(I) ;INPUT AND NOT /LIST--SEE IF
TRNE T1,-1 ; EXTENSION HAS WILDCARD
JRST E.WXI ;YES--ILLEGAL
;DIRECTORY DEFAULTING
INDEF2: MOVX T1,FX.DIR ;GET DIRECTORY BIT
JUMPGE J,INDEF3 ;JUMP IF NOT /LIST
SKIPE .FXDIR+2(I) ;SEE IF LISTING SFDS
JRST E.LSFD ;YES--THAT'S WRONG
SKIPN T2,O.DIR ;OUTPUT DIRECTORY
MOVE T2,.MYPPN## ;NO, GET USER'S PPN
TDNE T1,.FXMOM(I) ;DIRECTORY PRESENT?
JRST INDF21 ;YES, CHECK FOR [,] OR [-]
SETOM .FXDIR(I) ;NO--SET FOR ALL USERS
JRST INDF22 ;AND INDICATE DIRECTORY SET
INDF21: MOVSI T3,-1 ;YES--USE HIM FOR DEFAULT
TDNN T3,.FXDIR(I) ;CHECK FOR PROJECT
HRROS .FXDIM(I) ;BLANK--SET IT
TDNN T3,.FXDIR(I) ; ..
HLLM T2,.FXDIR(I) ; TO QUEUED USER
MOVEI T3,-1 ;CHECK FOR
TDNN T3,.FXDIR(I) ; PROGRAMMER NUMBER
HLLOS .FXDIM(I) ;BLANK--SET IT
TDNN T3,.FXDIR(I) ; ..
HRRM T2,.FXDIR(I) ; TO QUEUED USER
INDF22: IORM T1,.FXMOD(I) ;INDICATE DIRECTORY
IORM T1,.FXMOM(I) ; SPECIFIED
;CHECK FOR WILD CARDS IN DIRECTORY FOR INPUT QUEUE
INDEF3: SKIPE CREFLG ;SEE IF /MODIFY
JRST INDF42 ;YES--SKIP TO SWITCH TESTS
JUMPN J,INDEF4 ;JUMP IF NOT INPUT QUEUE
MOVE T1,.FXDIR(I) ;GET DIRECTORY
SETCM T2,.FXDIM(I) ;AND COMPLEMENT OF MASK
TLNN T1,-1 ;SEE IF PROJECT DEFAULT
TLZ T2,-1 ;YES--CLEAR WILD-CARDS
TRNN T1,-1 ;SEE IF PROGRAMMER DEFAULT
TRZ T2,-1 ;YES--CLEAR WILD-CARDS
JUMPN T2,E.WDI ;ERROR IF WILD UFD
SETOM T1 ;INPUT--CHECK FOR WILD DIRECTORY
MOVEI T2,2(I) ;SET POINTER TO SPEC
HRLI T2,1-.FXLND ;COUNT SFD DEPTH
INDF31: SKIPN .FXDIR(T2) ;SEE IF SPECIFIED
JRST INDEF4 ;NO--ALL DONE
CAME T1,.FXDIM(T2) ;SEE IF NOT WILD
JRST E.WDI ;ERROR IF SO
INCR T2 ;ADVANCE COUNT
AOBJN T2,INDF31 ;LOOP OVER SFD DEPTH
;PER-FILE SWITCH DEFAULTING
INDEF4: MOVE T1,INDADS ;ABSENT DEFAULTS FOR SWITCHES
JUMPN J,INDF41 ;JUMP IF NOT INPUT QUEUE
CAME I,I.INZR ;IF INPUT AND LOG FILE,
SKIPA T1,INDADI ; DEMAND SPECIAL SET
INDF41: ANDCM T1,F.MODM ;NON-SPECIAL, OBEY SWITCH.INI
ANDCM T1,I.MODM(I) ;MASK TO ONLY THE NEEDED ONES
IORM T1,I.MOD(I) ;AND INCLUDE OUR DEFAULTS
MOVE T1,F.MOD ;GET MOD WORD
ANDCM T1,I.MODM(I) ;TEST
IORM T1,I.MOD(I) ;AND SET
MOVE T1,F.MODM ;GET MOD WORD MASK
IORM T1,I.MODM(I) ;AND OR IT IN
MOVE T1,I.STRT(I) ;GET START PARAMETER
CAMN T1,[-1] ;SET?
MOVE T1,F.STRT ;NO, GET DEFAULT
CAMN T1,[-1] ;HAVE A TAG?
SETZM T1 ;NO
MOVEM T1,I.STRT(I) ;STORE IT
DMOVE T1,I.RPT(I) ;GET /REPORT
CAMN T1,[-1] ;WAS IT SET?
DMOVE T1,F.RPT ;GET DEFAULT
DMOVEM T1,I.RPT(I) ;STORE IT
MOVE T1,I.FONT(I) ;GET /FONT
CAME T1,[-1] ;WAS IT SET ????
JRST INDF42 ;YES, DON'T DEFAULT
HRLI T1,F.FONT ;NO, MOVE FONT SPEC
HRRI T1,I.FONT(I) ;GET DEFAULT
BLT T1,I.FONT+FNMLTH-1(I) ;MOVE IT AWAY
INDF42: LOAD T1,I.MOD(I),FP.FPF ;GET /PAPER: SWITCH
CAIN J,QTPCDP ;IS IT THE CARD-PUNCH QUEUE?
CAIE T1,PUNCBCD ;YES, DID HE SAY /PUNCH:BCD
SKIPA ;NOT CDP OR NOT /PUN:BCD
MOVEI T1,PUNC026 ;YES, BCD=026
STORE T1,I.MOD(I),FP.FPF ;AND STORE IT
MOVEI T1,AD.STR ;GET DEFAULT STARTING POINT
SKIPE CREFLG ;SEE IF /MODIFY
SETOM T1 ;YES--CLEAR DEFAULT
MOVE T2,I.STRT(I) ;GET SPECIFIED VALUE
CAMN T2,[-1] ;WAS IT SPECFIED?
MOVEM T1,I.STRT(I) ;NO--USE DEFAULT
;QUEUE NAME DEFAULTING
JUMPGE J,INDEF5 ;JUMP IF NOT /LIST
SKIPE N,.FXDEV(I) ;/LIST--GET QUE NAME
PUSHJ P,XPNQUE ;EXPAND ABBREVIATION
MOVEM N,.FXDEV(I) ;AND STORE RESULT
INDEF5: ADDI I,I.LZER ;ADVANCE POINTER
CAMGE I,I.NXZR ;SEE IF DONE YET
JRST INDEF1 ;NO--LOOP BACK
JRST SWDEF ;DEFAULT GLOBAL SWITCHES
;DEFAULT FOR PER-FILE SWITCHES FOR INPUT FILES
;(NOTE: FP.NFH IS BACKWARDS IN I.MOD FOR "SN" MACRO)
INDADS: INSVL.(SPACSI,FP.FSP) + INSVL.(AD.HDR,FP.NFH) + INSVL.(AD.COP,FP.FCY)
;DEFAULTS FOR INPUT QUEUE LOG FILE
INDADI: INSVL.(FILEAS,FP.FFF) + INSVL.(SPACSI,FP.FSP) + INSVL.(AD.LFD,FP.DEL) + INSVL.(1,FP.FLG) +INSVL.(AD.HDR,FP.NFH) + INSVL.(1,FP.NEW) + INSVL.(AD.COP,FP.FCY)
;HERE TO SUPPLY DEFAULTS FOR GLOBAL SWITCHES
;
SWDEF: SKIPE CREFLG ;SEE IF /MODIFY
JRST SWDEF2 ;YES--SKIP DEFAULT SWITCHES
MOVSI T1,-S.EMIN+S.MIN-1 ;INITIALIZE LOOP
SWDEF1: MOVE T2,SWDEFT(T1) ;GET DEFAULT
MOVE T3,S.MIN(T1) ;GET VALUE ENTERRED
CAMN T3,[-1] ;SEE IF ANYTHING TYPED
MOVEM T2,S.MIN(T1) ;YES--STUFF DEFAULT
AOBJN T1,SWDEF1 ;LOOP BACK FOR MORE
JUMPLE J,SWDEF2 ;JUMP IF /LIST OR INP:
MOVE T2,@SWLDT(J) ;GET ALTERNATE LIMIT VALUE
SKIPG S.LIM ;WAS /LIM SET?
MOVEM T2,S.LIM ;NO, SAVE ALTERNATE VALUE
SWDEF2: SKIPE T1,S.JOB ;GET REQUESTED JOB NAME
;(IF THERE IS ONE)
CAMN T1,[-1] ;IF ITS -1,,DONT SAVE IT
SKIPA ;0 OR -1,,SKIP
MOVEM T1,O.NAM ;SAVE IT FOR LATER
SKIPGE S.SEQ ;SEE IF SEQUENCE STILL NOT SET
SETZM S.SEQ ; RIGHT--SET IT FOR /MOD/KILL
SKIPLE T1,S.COR ;/CORE SPECIFIED ?
JRST SWDEF3 ;YES,,ADJUST IT
SKIPN CREFLG ;/MODIFY ???
SETZM S.COR ;NO,,ASSUME DEFAULT
JRST SWDEF4 ;AND SKIP REST
SWDEF3: CAIGE T1,^D256 ;SEE IF ALREADY IN WORDS
LSH T1,^D10 ;NO--ADD K FACTOR
MOVEM T1,S.COR ;STORE RESULT
SWDEF4: SKIPN DEFFIL+.FXDEV ;SEE IF /PATH
JRST SWDEF5 ;NO--PROCEED
SKIPN DEFFIL+.FXNAM ;SEE IF /PATH:NAME
.CREF FX.NDV
SKIPL DEFFIL+.FXMOD ; OR /PATH:DEV:
JRST E.PTHN ;ERROR IF SO
SKIPE DEFFIL+.FXEXT ; OR /PATH:.EXT
JRST E.PTHN ;ERROR IF SO
SWDEF5: SKIPE CREFLG ;SEE IF /MODIFY
POPJ P, ;YES--RETURN
JUMPL J,.POPJ## ;GO PROCESS IF /LIST
JUMPN J,SWDEF7 ;JUMP IF NOT INPUT QUEUE
MOVX T1,FX.DIR ;GET [] BIT
TDNE T1,DEFFIL+.FXMOM ;SEE IF /PATH:[]
JRST SWDEF6 ;YES--JUST CHECK NOT WILD
MOVE T2,.MYPPN## ;NO--GET SELF
SKIPN O.DIR+2 ;SEE IF NOT OUTPUT SFD
CAME T2,O.DIR ;SEE IF MATCHES OUTPUT P,PN
TDNN T1,O.MODM ;OR NO OUTPUT P,PN
JRST SWDF51 ;RIGHT--USE DEFAULT DIRECTORY
MOVE T1,[O.DIR,,DEFDIR] ;NO--COPY
BLT T1,DEFDIR+2*.FXLND-1 ;OUTPUT DIRECTORY
JRST SWDEF6 ;THEN CHECK FOR NO WILD-CARDS
SWDF51: MOVSI T2,-.FXLND ;GET LOOP COUNT
MOVEI T3,0 ;AND STORE INDEX
SWDF52: SKIPN T1,PTHPPN(T2) ;GET DEFAULT PATH
SOS T2 ;DEFEAT ADVANCE IF DONE
MOVEM T1,DEFDIR(T3) ;STORE IN /PATH
SETOM DEFDIR+1(T3) ;CLEAR WILDCARDS
ADDI T3,2 ;ADVANCE STORE
AOBJN T2,SWDF52 ;LOOP UNTIL DONE
SWDEF6: MOVE T1,DEFDIR ;GET UFD
SKIPN T2,O.DIR ;GET OUTPUT DIRECTORY
MOVE T2,.MYPPN## ;DEFAULT TO LOGGED IN DIRECTORY
TLNN T1,-1 ;SEE IF PROGRAMMER
HLL T1,T2 ;NO--DEFAULT
TRNN T1,-1 ;SEE IF PROGRAMMER
HRR T1,T2 ;NO--DEFAULT
MOVEM T1,DEFDIR ;STORE AWAY
MOVSI T2,-.FXLND ;SET LOOP COUNT
SWDF61: SKIPN DEFDIR(T2) ;SEE IF NEXT LEVEL SPECIFIED
JRST SWDEF7 ;NO--ALL OK
SETCM T1,DEFDIR+1(T2) ;GET COMPLEMENT OF WILD MASK
JUMPN T1,E.PTHW ;ERROR IF WASN'T -1
INCR T2 ;ADVANCE BY 2
AOBJN T2,SWDF61 ;LOOP OVER FULL DEPTH
SWDEF7: MOVE I,I.INZR ;DEFAULT JOB NAME IS FIRST FILE NAME
CAIN J,0 ;UNLESS INPUT QUEUE
ADDI I,I.LZER ;FOR WHICH IT IS LOG FILE
SETCM T1,.FXNMM(I) ;SEE IF WILDCARD IN FILE
JUMPN T1,.POPJ## ;YES--JUST PROCESS
MOVE T1,.FXNAM(I) ;NO--GET FILE NAME IN CASE
SKIPN O.NAM ;SEE IF OUTPUT NAME YET
MOVEM T1,O.NAM ;NO--SET THIS ONE
POPJ P, ;RETURN
SUBTTL File Scanning Error Messages
E.NOD: MOVE N,O.DEV
N$FATE <CDO>,<N>,<Can not do output to device >
E.NDD: MOVE N,.FXDEV(I)
N$FATE <DND>,<N>,<Input device not a disk >
E.WCI: MOVE N,.FXNAM(I)
N$FATE <WIQ>,<N>,<Wildcard illegal in input queue file name >
E.WDI: N$FATE <WDI>,,<Wildcard illegal in input queue file directory>
E.WXI: HLLZ N,.FXEXT(I)
N$FATE <WIE>,<N>,<Wildcard illegal in input queue file extension >
E.NNI: N$FATE <FRI>,,<Filename required for input queue>
E.QSFD: N$FATE <UCI>,,<Queue user cannot include SFDs>
E.LSFD: N$FATE <LQU>,,<Listed queue user cannot include SFDs>
E.PTHN: N$FATE <FNI>,,<File name illegal in default path>
E.PTHW: N$FATE <WID>,,<Wildcard illegal in default path>
E.SJN: N$FATE <SJN>,,<Specify jobname left of equal sign>
E.NSD: MOVE N,.FXDEV(I)
N$FATE <NSD>,<N>,<Input device does not exist >
E.WIN: N$FATE <WIN>,,<Wildcards illegal with /NEW>
SUBTTL Other Error Messages
E.OEFE: CLOSE LC,CL.RST!CL.ACS!CL.DLL ;RESET ENTER
RELEAS LC, ;CLEAR CHANNEL
MOVEI T1,L.LOOK ;POINT TO LOOKUP BLOCK
MOVEI T2,LN$ENT-1 ;GIVE LENGTH
MOVEI T3,O.ZER ;POINT TO SCAN BLOCK
PUSHJ P,E.LKEN## ;ISSUE ERROR MESSAGE
PJRST NFMSX1 ;GO ABORT JOB
E.NFLS: SKIPLE S.NULL ;NO FILES--SEE IF MESSAGE SUPPRESSED
PJRST CMDXIT ;YES--JUST QUIT
N$FATE <NFI>,,<No files in request>
E.ICMD: HRRZ N,I
N$FATE <ICC>,<D>,<Improper command code: >
E.NOQS: N$FATE <NQS>,,<No queue specified>
E.SVTL: N$FATE <SVT>,<D>,<Switch value too large>
E.IQNN: MOVE N,O.DEV ;GET THE DEVICE
E.IQN: N$FATE <IQN>,<N>,<Illegal queue name: >
SUBTTL COMMND Command Processing
;COMMND -- SUBROUTINE TO PROCESS COMMAND
;USES EVERYTHING
;HERE AFTER COMMAND HAS BEEN DECODED AND ALL DEFAULTS SUPPLIED
;DISPATCH TO APPROPRIATE COMMAND PROCESSOR
;
COMMND: SKIPLE I,S.OPN ;FETCH OPERATION CODE, CHECK FOR LEGAL
CAILE I,LCDT ;CHECK FOR VALIDITY
JRST E.ICMD ;NO--BOMB THE USER
MOVE T1,DQTYPE ;GET COMMAND-DEVICE
MOVEM T1,COMDEV ;AND SAVE FOR LATER
SETZM T.ZER ;ZERO OUT TEMPORARIES
MOVE T1,[T.ZER,,T.ZER+1] ; ..
BLT T1,T.EZER ; ..
MOVE T1,COMDEV ;GET THE DEVICE BACK
MOVEM T1,DQTYPE ; AND RESTORE IT (ZAP'D BY ABOVE BLT)
MOVS T1,COMDEV ;GET DEVICE NAME IN RH
CAIN T1,'PAT' ;PATCHING?
SKIPA T1,PATCMD ;YES
MOVE T1,CDTAB-1(I) ;GET ADDRESS AND CONTROL BITS
SKIPLE S.DFR ;WAS /DEFER SPECIFIED?
HRRI T1,NDEFER ;YES, DISPATCH TO DEFER ROUTINE
TLNE T1,(NNLGSB) ;SEE IF ERROR AS SUBJOB
TLNN F,L.NSBJ ;NO--SEE IF TOP IS LOGGED IN
SKIPA ;YES--LEAVE ALONE
TLO T1,(NNLGI) ;NO--INDICATE ERROR
TLNN F,L.LOGI ;SEE IF LOGGED IN
TLNN T1,(NNLGI) ;NO--SEE IF LEGAL IF NOT
JRST (T1) ;YES--GO DO IT
MOVE N,CMDTAB-1(I) ;ILLEGAL--ABORT
N$FATE <LFS>,<N>,<LOGIN please to use switch />
;TABLE OF DISPATCH ADDRESSES FOR VARIOUS COMMANDS
;
NNLGI==1B1 ;NOT LEGAL UNLESS LOGGED IN
NNLGSB==1B2 ;NOT LEGAL UNLESS LOGGED IN -
;AT TOP LEVEL
CDTAB:
EXP NCREAT+NNLGI ;1=CREATE ENTRY
EXP 0 ;2 WAS /DEFER
EXP 0 ;3 WAS /ZDEFER
EXP NLIST ;4=LIST QUEUE
EXP NMODFY+NNLGSB ;5=MODIFY EXISTING ENTRY
EXP NKILL+NNLGSB ;6=KILL EXISTING ENTRY
EXP ALLOC+NNLGI ;7=ALLOCATE A VOLUME-SET
EXP .CANCE+NNLGI ;10=CANCEL AN ALLOCATE/MOUNT REQUEST
EXP .DISMO+NNLGI ;11=DISMOUNT A VOLUME-SET
EXP MOUNT+NNLGI ;12=MOUNT A VOLUME-SET
EXP .SHOW ;13=SHOW THE MOUNT QUEUE
EXP .DEALL+NNLGI ;14=DEALLOACTE A VOLUME-SET
LCDT==.-CDTAB
CMDTAB: SIXBIT /CREATE/
EXP 0,0
SIXBIT /LIST/
SIXBIT /MODIFY/
SIXBIT /KILL/
SIXBIT /ALLOCA/
SIXBIT /CANCEL/
SIXBIT /DISMOU/
SIXBIT /MOUNT/
SIXBIT /SHOW/
SIXBIT /DEALLO/
SUBTTL NCREAT New CREATE Queue Request - Input or Output
NCREAT: MOVNI T1,I.LZER ;COMPUTE START
ADD T1,I.NXZR ;OF LAST SPEC
MOVEM T1,I.LSZR ;FOR WILD
;SET UP THE MESSAGE AREA
;
PUSH P,.JBFF## ;SAVE ORIGINAL .JBFF
PUSHJ P,MSETUP ;GET MEMORY ETC FOR MESSAGE
;CREATE MESSAGE HEADER
;
MOVX T1,EQHSIZ ;SIZE WITH PATH
STORE T1,.EQLEN(M),EQ.LOH ;STORE LENGTH OF REQUEST HEADER
STORE T1,.MSTYP(M),MS.CNT ;AND AS INITIAL MESSAGE LENGTH
MOVX T1,.QOCRE ;FUNCTION CREATE
STORE T1,.MSTYP(M),MS.TYP ;AS MESSAGE TYPE
JUMPE J,CREATI ;IF INPUT QUEUE, GO DO IT
JRST CREATO ;NO, MUST BE OUTPUT QUEUE
SUBTTL CREATO New CREATE Output Queue Request
;BEGINNING OUT ROB BLOCK CODE
;OUT ROB OBJECT TYPE WORD CODE
;
CREATO: PUSHJ P,GETOBJ ;FIND THE OBJECT
STORE T3,.EQROB+.ROBTY(M) ;STORE OBJECT TYPE
;OUT ROB ATTRIBUTE WORD CODE
;
HLRZ T1,O.DEV ;GET THE DEVICE BACK
MOVEI T2,0 ;GET SOME ATTRIBUTES
CAIN T1,'LL ' ;IS IT LL?
MOVX T2,%LOWER ;YES,,LOAD LOWER CASE
CAIN T1,'LU ' ;OR LU?
MOVX T2,%UPPER ;YES,,LOAD UPPER CASE
STORE T2,.EQROB+.ROBAT(M),RO.ATR ;STORE IT
;OUT ROB UNIT WORD CODE (MPB)
;MAY OVER WRITE ATTRIBUTE WORD
;
HRRZ T3,O.DEV ;GET DEVICE ONCE MORE
JUMPE T3,CREO.1 ;MPB FORMAT FIELD ???
LDB T2,[POINT 6,T3,23] ;YES, GET 4TH DIGIT
CAIN T2,'S' ;STATION SPECIFICATION?
JRST CREO.1 ;YES, NO MPB UNIT VALUE
LDB T1,[POINT 6,T3,35] ;GET THE 6TH CHAR
TXNN T3,7700 ;IS THERE A NODE FIELD?
LDB T1,[POINT 6,T3,23] ;NO, GET 4TH DIGIT
JUMPE T1,CREO.1 ;GO IF NO UNIT
SUBI T1,'0' ;ELSE, GET A UNIT
TXO T1,RO.PHY ;SET PHYSICAL UNIT BIT
STORE T1,.EQROB+.ROBAT(M) ;AND STORE UNIT NUMBER
;OUT ROB /LOWER, /UPPER, AND /UNIT SWITCH CODE (GALAXY)
;MAY OVER WRITE ATTRIBUTE WORD
;
CREO.1: DMOVE T1,S.ATTR ;GET ATTRIBUTES
CAME T1,[-1] ;GALAXY ATTRIBUTE SWITCH ???
MOVEM T1,.EQROB+.ROBAT(M) ;YES, STORE /UNIT IN MESSAGE
CAME T2,[-1] ;UNIT TYPE?
MOVEM T2,.EQROB+.ROBUT(M) ;YES
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;OUT ROB NODE WORD CODE GALAXY /DEST AND MPB
;
HRROI T4,.GTLOC ;SETUP TO GET MY LOCATION
GETTAB T4, ;GET IT
MOVEI T4,0 ;LOSE
HRRZ T3,O.DEV ;GET DEVICE ONCE MORE
JUMPE T3,CREO.2 ;MPB FORMAT FIELD ???
TRNN T3,007777 ;YES, WAS UNIT ALONE SPECIFIED ???
JRST CREO.2 ;YES, SKIP THIS STUFF
LDB T1,[POINT 6,T3,23] ;NO, GET THE 4TH DIGIT
CAIN T1,'S' ;STATION SPECIFICATION?
JRST [LSH T3,6 ;YES--SHIFT IT OFF
TLZ T3,-1 ;CLEAR OVERFLOW
LDB T1,[POINT 6,T3,23];GET FIRST NODE DIGIT
JRST .+1] ;AND PROCEED
CAIL T1,'0' ;MUST BE NUMERIC
CAILE T1,'7' ;AND IN RANGE
JRST E.IQNN ;ELSE SAY ILLEGAL QUEUE
LDB T2,[POINT 6,T3,29] ;GET THE 5TH DIGIT
CAIL T2,'0' ;MUST BE NUMERIC
CAILE T2,'7' ;AND IN RANGE
JRST E.IQNN ;ELSE SAY ILLEGAL QUEUE
SUBI T1,'0' ;MAKE IT BINARY
SUBI T2,'0' ;BOTH OF THEM
IMULI T1,10 ;AND START BUILDING AN OCTAL NUMBER
ADD T1,T2 ;FINISH THE PROCESS
SKIPA ;USE MPB NODE INFO
CREO.2: MOVE T1,T4 ;GET THE DEFAULT
MOVE T2,S.DEST ;GET THE /DESTINATION NODE
CAMN T2,[-1] ;DID WE TYPE IT ???
JRST CREO.3 ;NO, STORE IN MESSAGE
MOVE T1,S.DEST ;GET THE /DESTINATION NODE
PUSHJ P,SETNODE ;CONVERT/DEFAULT THE NODE NAME/NUMBER
CAMN T1,[-1] ;SEE IF NO NETWORK SOFTWARE
SETZM T1 ;YES--MAKE THE NODE NUMBER 0
CREO.3: STORE T1,.EQROB+.ROBND(M) ;STORE IT
;END OF OUT ROB BLOCK CODE
;BUILD EQ BLOCK
;
PUSHJ P,NBLDEQ ;GO BUILD THE EQ BLOCK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;BEGINNING OF LIMIT WORD CODE
;LIMIT WORD # 0
;
MOVE T1,S.FRM ;GET THE FORMS TYPE
STOLIM T1,.EQLIM(M),FORM ;PUT IT IN THE OUTPUT BLOCK
;LIMIT WORD # 1
;
SKIPG T1,S.LIM ;IS IT A REASONABLE LIMIT
SETZM T1 ;NO, INSURE ZERO
SKIPLE S.SPAC ;DO WE HAVE ABNORMAL SPACING ???
IMUL T1,S.SPAC ;YES, MULTIPLY THE LIMIT BY IT
CAILE T1,777776 ;CHECK TO LARGE
MOVEI T1,777776 ;FORCE OK
STOLIM T1,.EQLIM(M),OLIM ;STORE IN SECOND LIMIT WORD
;LIMIT WORDS # 2 AND 3
;
MOVE T1,S.NOS1 ;GET /NOTE SWITCH
STOLIM T1,.EQLIM(M),NOT1 ;STORE IN THIRD LIMIT WORD
MOVE T1,S.NOS2 ;GET /NOTE SWITCH
STOLIM T1,.EQLIM(M),NOT2 ;STORE IN FOURTH LIMIT WORD
;END OF LIMIT WORD CODE
;
;QUEUE NAME
;
SKIPN S.QNM ;/QUEUE SPECIFIED?
JRST CREO.7 ;NO
MOVSI T1,S.QNM ;WHERE /QUEUE IS STORED
HRRI T1,.EQQNM(M) ;WHERE TO PUT IT
BLT T1,.EQQNM+QNMLEN-1(M) ;COPY TO EQ
;CHARACTERISTICS
;
CREO.7: SETZM .EQCHR(M) ;ZERO IT INITIALLY
SKIPN S.CHAR ;/CHARACTERISTICS SPECIFIED?
JRST CREO.8 ;NO
MOVSI T1,S.CHAR ;WHERE /CHARACTERISTICS IS STORED
HRRI T1,.EQCHR(M) ;WHERE TO PUT IT
BLT T1,.EQCHR+CHRSIZ-1(M) ;COPY TO EQ
;LONG FORMS NAME
;
CREO.8: MOVSI T1,.EQFRM(M) ;CLEAR IT OUT FIRST
HRRI T1,.EQFRM+1(M) ;...
SETZM .EQFRM(M)
BLT T1,.EQFRM+FRMSIZ-1(M)
SKIPN S.FRM ;/FORMS SPECIFIED?
JRST CREO.9 ;NO
MOVE T1,[POINT 6,S.FRM] ;SOURCE BYTE POINTER
MOVEI T2,.EQFRM(M) ;DESTINATION
HRLI T2,(POINT 7) ;7-BIT BYTES
ILDB T3,T1 ;GET A BYTE
JUMPE T3,CREO.9 ;WHEN DONE
ADDI T3," "-' ' ;CONVERT TO ASCII
IDPB T3,T2 ;STORE IT
JRST .-4 ;LOOP
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;HERE TO ADD FB BLOCKS TO EQ REQUEST
;
CREO.9: SETZM I ;YES, SETUP CALL TO NLKFIL
CREO.4: LOAD T1,.MSTYP(M),MS.CNT ;CHECK FOR PAGE OVERFLOW
ADDI T1,FBSIZE ;SIZE IF I INCLUDE THIS FILE
CAILE T1,PAGSIZ ;OVER A PAGE BOUNDRY
PUSHJ P,CREO.6 ;YES, START A NEW MESSAGE
LOAD FP,.MSTYP(M),MS.CNT ;GET CURRENT SIZE
ADDI FP,(M) ;FP = FILE BLOCK LOCATION IN REQUEST
PUSHJ P,NLKFIL ;CREATE THE GALAXY FB BLOCK
JRST CREO.5 ;SEND THE MESSAGE
INCR .EQSPC(M),EQ.NUM ;BUMP NR. FILES IN REQUEST
CLOSE DC,CL.NMB ;KEEP ACCESS TABLE IN CORE
RELEAS DC, ;RELEASE THE CHANNEL
JRST CREO.4 ;GET ANOTHER GALAXY FB BLOCK
CREO.5: LOAD T1,.EQSPC(M),EQ.NUM ;GET NUMBER FILES IN REQUEST
JUMPG T1,CRESND ;ARE THERE FILE IN REQUEST ???
DECR NUMANS ;NO FILES IN THIS REQUEST
MOVE T1,NUMANS ;GET THE NEW REQUEST COUNT
JUMPG T1,CRESND ;ANY FULL REQUESTS TO DISPATCH ???
JRST E.NFLS ;NO FILES OR REQUESTS TO SEND
;ROUTINE TO BUILD ADDITIONAL REQUESTS
;COPY EQ HEADER, ROB, ETC.
;
CREO.6: PUSH P,M ;SAVE CURRENT REQUEST ADDR
PUSHJ P,MSUP.1 ;GET MEMORY ETC FOR NEW REQUEST
POP P,T1 ;RESTORE OLD REQUEST ADDR BACK
HRLI T2,(T1) ;LOAD OLD REQUEST ADDR FOR BLT
HRRI T2,(M) ;AND NEW REQUEST ADDR
BLT T2,EQHSIZ-1(M) ;BLT OLD EQ, ROB, ETC. TO NEW REQUEST
;LET'S FIX UP THE JOBNAME
;
MOVEI T2,EQHSIZ(T1) ;GET ADDR OF OLD MSG FST FB BLK
LOAD T3,.FPLEN(T2),FP.LEN ;GET FP BLOCK SIZE
ADD T2,T3 ;POINT TO FD BLOCK
MOVE T3,.EQJOB(T1) ;GET THE JOBNAME
SKIPN T3 ;USER SPECIFY JOBNAME ???
MOVE T3,.FDNAM(T2) ;GET FIRST FILE NAME IN FIRST MSG
MOVEM T3,.EQJOB(T1) ;PUT JOBNAME BACK IN ORIGINAL MSG
MOVEM T3,.EQJOB(M) ;AND STORE JOBNAME IN NEW REQUEST
;RESET LENGTH OF REQUEST
;
MOVX T1,EQHSIZ ;SIZE WITH PATH
STORE T1,.EQLEN(M),EQ.LOH ;STORE LENGTH OF REQUEST HEADER
STORE T1,.MSTYP(M),MS.CNT ;AND AS INITIAL MESSAGE LENGTH
;RESET NUMBER OF FILES IN REQUEST
;
SETZM T1 ;GET READY TO
STORE T1,.EQSPC(M),EQ.NUM ;ZERO NUMBER FILES IN REQUEST
POPJ P, ;BACK TO THE FB BLOCKS
SUBTTL CREATI New CREATE Input Queue Request
;BEGINNING INP ROB BLOCK CODE
;
CREATI: PUSHJ P,GETOBJ ;FIND THE OBJECT
STORE T3,.EQROB+.ROBTY(M) ;STORE OBJECT TYPE
PUSHJ P,DFPROC ;DEFAULT /PROC IF NOT GIVEN
MOVE T1,S.PROC ;LOAD /PROC
PUSHJ P,SETNODE ;CONVERT IT
CAMN T1,[-1] ;MONITOR SUPPORT NETWORK ???
SETZM T1 ;YES,,MAKE THE NODE NUMBER 0
MOVEM T1,.EQROB+.ROBND(M) ;SAVE IT IN THE ROB
LOAD T1,S.ATTRIB,RO.ATR ;GET ATTRIBUTES
CAXE T1,%SITGO ;IS IT SITGO ???
MOVX T1,%GENRC ;NO, MUST BE GENRIC
STORE T1,.EQROB+.ROBAT(M),RO.ATR ;SAVE THE ATTRIBUTE
SETZM .EQROB+.ROBUT(M) ;UNIT TYPE IS MEANINGLESS FOR INPUT
;END OF INP ROB BLOCK CODE
;BUILD EQ BLOCK
;
PUSHJ P,NBLDEQ ;GO BUILD THE EQ BLOCK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;BEGINNING OF LIMIT WORD CODE
;LIMIT WORD # 0
;
SKIPL T1,S.UNIQ ;/UNIQUE SWITCH ???
SKIPA T1,[EXP %EQUNO,%EQUYE](T1) ;YES, CONVERT TO QUASAR STANDARD
SETZ T1, ;NO, CLEAR THE UNIQUENESS BITS
STOLIM T1,.EQLIM(M),UNIQ ;AND STORE AWAY
SETZM T1
STOLIM T1,.EQLIM(M),BSPR ;CLEAR SPARE BITS
MOVX T1,%EQRNO ;ASSUME /REST:NO
SKIPE S.RSTR ;IS IT /REST:NO ???
MOVX T1,%EQRYE ;NO, SO IT'S /REST:YES
STOLIM T1,.EQLIM(M),REST ;AND STORE IT
SKIPGE T1,S.OUT ;GET OUTPUT QUEUEING
MOVEI T1,INPLOG ;DEFAULT TO /OUTPUT:LOG
STOLIM T1,.EQLIM(M),OUTP ;AND STORE THE VALUE
HRRZ T1,S.DPN ;GET DEPENDENCY REQUEST
TRZ T1,MI.DMT ;CLEAR +- FLAGS
STOLIM T1,.EQLIM(M),DEPN ;STORE /DEPENDENCY SWITCH
SKIPL T1,S.ASST ;GET /ASSIST
MOVE T1,[EXP .OPINN,.OPINY](T1) ;CONVERT TO QUASAR STANDARD
STOLIM T1,.EQLIM(M),OINT ;STORE IT AWAY
;LIMIT WORD # 1
;
SKIPLE T1,S.COR ;/CORE SPECIFIED ?
JRST CREI.3 ;YES,,ADJUST IT
SETZM T1 ;NO,,ASSUME DEFAULT
JRST CREI.4 ;AND SKIP REST
CREI.3: CAIGE T1,^D256 ;SEE IF ALREADY IN WORDS
LSH T1,^D10 ;NO--ADD K FACTOR
ADDI T1,PAGSIZ-1 ;ROUND UP TO A PAGE BOUNDRY
ADR2PG T1 ;CONVERT TO PAGES
CREI.4: STOLIM T1,.EQLIM(M),CORE ;STORE /CORE:pages
HRR T1,S.LTIM ;FETCH CPU TIME LIMIT
HLRZ T2,S.LTIM ;GET LEFT HALF OF THE LIMIT
CAIE T2,-1 ;IF -1
JUMPN T2,[HRRI T1,-2 ;OR 0, IGNORE IT, ELSE LOAD "INFIN"
JRST .+1] ;AND CONTINUE
STOLIM T1,.EQLIM(M),TIME ;STORE /TIME:seconds
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;LIMIT WORD # 2
;
MOVE T1,S.LLPT ;FETCH PAGE LIMIT
STOLIM T1,.EQLIM(M),SLPT ;STORE SPOOLED LPT LIMIT
MOVE T1,S.LCDP ;FETCH CARD PUNCH LIMIT
STOLIM T1,.EQLIM(M),SCDP ;STORE SPOOLED CDP LIMIT
;LIMIT WORD # 3
;
MOVE T1,S.LPTP ;FETCH PAPER TAPE LIMIT
STOLIM T1,.EQLIM(M),SPTP ;STORE SPOOLED PTP LIMIT
MOVE T1,S.LPLT ;FETCH PLOT LIMIT
STOLIM T1,.EQLIM(M),SPLT ;STORE SPOOLED PLT LIMIT
;LIMIT WORD # 4
;
HRRZ T1,O.DEV ;CHECK FOR MPB INPnn: OR INPSnn:
JUMPE T1,CREI.5 ;WELL, DO WE HAVE ONE ???
TRNN T1,007777 ;YES, DID THEY SPECIFY A UNIT ???
JRST CREI.5 ;YES, IGNORE IT
SETZM S.DEST ;CLEAR THE DEST NODE WORD
LDB T2,[POINT 6,T1,23] ;GET THE FIRST NODE CHARACTER
CAIN T2,'S' ;STATION SPECIFIED ???
JRST [LSH T1,6 ;YES, SO SHIFT IT OFF
TLZ T1,-1 ;CLEAR ANY OVERFLOW
LDB T2,[POINT 6,T1,23];GET NODE CHARACTER AGAIN
JRST .+1] ;FALL BACK INTO MAIN CODE
CAIL T2,'0' ;NO, IS IT NUMERIC
CAILE T2,'7' ;AND THE RANGE VALID ???
JRST E.IQNN ;NO, GIVE AN ERROR MESSAGE
DPB T2,[POINT 6,S.DEST,5] ;YES, STORE THE BITE
LDB T2,[POINT 6,T1,29] ;GET SECOND CHARACTER
CAIL T2,'0' ;NO, IS IT NUMERIC
CAILE T2,'7' ;AND THE RANGE VALID ???
JRST E.IQNN ;NO, GIVE AN ERROR MESSAGE
DPB T2,[POINT 6,S.DEST,11] ;YES, STORE THE BITE
CREI.5: PUSHJ P,DFDEST ;DEFAULT /DESTINATION IF NOT GIVEN
MOVE T1,S.DEST ;LOAD /DESTINATION
PUSHJ P,SETNODE ;CONVERT IT
CAMN T1,[-1] ;NO NETWORK SUPPORT IN THIS MONITOR ???
SETZM T1 ;YES,,MAKE THE NODE NUMBER 0
STOLIM T1,.EQLIM(M),ONOD ;AND STORE AWAY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;LIMIT WORD # 5
;
MOVE T1,S.BATL ;GET THE LOG FILE TYPE CODE
STOLIM T1,.EQLIM(M),BLOG ;AND STORE AWAY
SKIPE T1,MADFIL ;GET THE 'MADE A FILE' FLAG
STOLIM T1,.EQLIM(M),DLOG ;SET DEFAULT LOG BIT
;LIMIT WORD # 6
;
MOVE T1,S.BATO ;GET /BATOPT
CAME T1,[EXP -1] ;SPECIFIED ???
STOLIM T1,.EQLIM(M),OPTN ;YES, STORE IT IN MESSAGE
;END OF LIMIT WORD CODE
;
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;BEGINNING PATH BLOCK CODE
;
MOVSI T1,-.FXLND ;SET FOR FULL LOOP COUNT
HRRI T1,(M) ;POINT TO REQUEST
MOVEI T2,0 ;INITIALIZE FETCH POINTER
CREI.6: SKIPE T3,DEFDIR(T2) ;GET /PATH:
ADDI T2,2 ;ADVANCE FETCH UNLESS AT END
MOVEM T3,.EQPAT(T1) ;STORE IN REQUEST
AOBJN T1,CREI.6 ;LOOP UNTIL DONE
;END OF PATH BLOCK CODE
;
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;HERE TO ADD FB BLOCKS TO EQ REQUEST
;
SETZM I ;SETUP CALL TO NLKFIL
CREI.8: LOAD FP,.MSTYP(M),MS.CNT ;GET CURRENT SIZE
ADDI FP,(M) ;FP = FILE BLOCK LOCATION IN REQUEST
PUSHJ P,NLKFIL ;CREATE THE GALAXY FB BLOCK
JRST CREI.9 ;SEND THE MESSAGE
INCR .EQSPC(M),EQ.NUM ;BUMP NR. FILES IN REQUEST
TXO F,R.ANUL ;ALLOW NUL: FOR LOGFILE
JRST CREI.8 ;GET ANOTHER GALAXY FB BLOCK
CREI.9: HLLZS F ;RESET LOG FILE FLAG
LOAD T1,.EQSPC(M),EQ.NUM ;GET NUMBER FILES IN REQUEST
CAIE T1,2 ;SEE IF EXACTLY TWO FILES
N$FATE <INF>,,<Incorrect number of files in input queue request>;NO
JRST CRESND ;DO THE SEND
SUBTTL CRESND New CREATE Message Send Routine
CRESND: SKIPN NUMANS ;ALL SENT YET
JRST CMDXIT ;YES, RETURN TO CALLER
JUMPE J,CSND.1 ;NO, IF INPUT QUEUE, GO DO IT
MOVE T1,NOBLKS ;GET COUNT OF BLOCKS QUEUED
CAILE T1,777777 ;HANDLE OVERFLOW
MOVEI T1,777777 ;YES--MAKE MAXIMUM
STOLIM T1,.EQLIM(M),NBLK ;STORE BLOCKS*COPIES IN 2ND LIMIT WORD
CSND.1: MOVE M,FSTMSG ;GET FIRST MESSAGE ADDRESS
MOVEI T3,PAGSIZ(M) ;THE NEXT ONE
MOVEM T3,FSTMSG ;SAVE FOR NEXT GO AROUND
DECR NUMANS ;ONE LESS TO SEND
MOVX T3,MF.ACK ;GET FLAG FOR ACKNOWLEDGMENT
MOVEM T3,.MSFLG(M) ;AND SET IT
MOVX T3,%%.QSR ;VERSION NUMBER OF THE MESSAGE
STORE T3,.EQLEN(M),EQ.VRS ;STORE FOR QUASAR
LOAD T3,.EQROB+.ROBTY(M) ;GET THE QUEUE TYPE
LOAD T4,S.RDR ;GET THE /RDR SWITCH
CAIN T3,.OTBAT ;WAS IT THE BATCH QUEUE
CAMN T4,[-1] ;YES, AND WAS /RDR SET ???
JRST SENDIT ;NO,,SEND THE MESSAGE
MOVX T3,.OTBIN ;YES,,GET THE SPRINT QUEUE ID
STORE T3,.EQROB+.ROBTY(M) ;RESET THE QUEUE TYPE
LOAD T3,.EQLEN(M),EQ.LOH ;GET THE HEADER LENGTH
ADD T3,M ;POINT TO THE FIRST FP
MOVX T4,.FPFSA ;GET 'STREAM ASCII' MODE
STORE T4,.FPINF(T3),FP.FFF ;SAVE THE THE FILE FORMAT
SENDIT: TXO M,1B0 ;SIGN BIT IS PAGE MODE FLAG
PUSHJ P,MSGSND ;SEND OFF TO QUASAR
PUSHJ P,RCVACK ;GET THE "ACK" NOW
JRST CRESND ;SEND ANOTHER IF THERE IS ONE
SUBTTL NBLDEQ New Build EQ Block Routine (INP/OUT)
NBLDEQ: SKIPN T1,O.DIR ;ANY PPN SPECIFIED ???
GETPPN T1, ;NO,,GET OURS
JFCL ;IGNORE THIS RETURN
MOVEM T1,.EQOID(M) ;AND MOVE IT INTO THE EQ
PUSHJ P,DOACCT ;FILL IN ACCOUNT STRING
DATAM O.NAM,,.EQJOB(M)
DATAM S.SEQ,,.EQSEQ(M),EQ.SEQ
DATAM O.MOD,FX.PRO,.EQSPC(M),EQ.PRO
SKIPGE T1,S.NTF ;/NOTIFY SEEN?
SETZ T1, ;NO, MAKE IT /NOTIFY:NO
STORE T1,.EQSEQ(M),EQ.NOT ;PUT VALUE IN EQ
SKIPLE T1,S.AFT ;GET AFTER SWITCH
ADDI T1,3 ;ADD 1 SECOND
MOVEM T1,.EQAFT(M) ;MOVE THE AFTER PARAMETER
SKIPN T1,S.PRI ;/PRIORITY:0 SPECIFIED?
N$FATE <PZR>,,</PRIORITY:0 not in range 1 to 63> ;SEE YA
SKIPG T1 ;OK IF GREATER THAN ZERO
SETZM T1 ;OH....WELL, TAKE THE DEFAULT
STORE T1,.EQSEQ(M),EQ.PRI ;SAVE IT IN MESSAGE
DMOVE T1,G$NAM1 ;GET USER NAME
DMOVEM T1,.EQOWN(M) ;DEFAULT IT ...
MOVSI T1,S.USER ;POINT TO /USERNAME
HRRI T1,.EQUSR(M) ;MAKE A BLT POINTER
MOVE T2,S.USER ;GET FIRST WORD
CAME T2,[EXP -1] ;SPECIFIED?
BLT T1,.EQUSR+10-1(M) ;YES--COPY
MOVSI T1,S.DIST ;POINT TO /DISTRIBUTION
HRRI T1,.EQBOX(M) ;MAKE A BLT POINTER
MOVE T2,S.DIST ;GET FIRST WORD
CAME T2,[EXP -1] ;SPECIFIED?
BLT T1,.EQBOX+10-1(M) ;YES--COPY
POPJ P, ;AND RETURN
SUBTTL DOACCT Fill in the Accounting String
DOACCT: PUSHJ P,.SAVE3## ;SAVE P1, P2, AND P3 (N)
MOVX T1,%CNST2 ;WANT SECOND STATES WORD
GETTAB T1, ;GET IT
N$FATE <GUF>,,<GETTAB UUO Failed> ;NO,,END NOW
TXNN T1,ST%ACV ;IS ACCOUNT VALIDATION BEING DONE ???
POPJ P, ;NO,,SKIP THIS
MOVE T1,S.ACCT ;DID USER SPECIFY AN ACCOUNT STRING ???
CAME T1,[-1] ;LOOK FOR -1 (ACCT NOT SPECIFIED)
JRST DOAC.1 ;FOUND ONE,,GO PROCESS IT
;Here to default to user account string
;
DOAC.0: MOVE T1,[1,,T2] ;GET ACCT. PARMS
MOVEI T2,2 ;GET PARM BLOCK LENGTH
SETOM T3 ;WANT ACCOUNT STRING FOR THIS JOB
HRROI T4,.EQACT(M) ;GET POINTER TO WHERE WE WANT STRING PUT
ACCT. T1, ;READ THE ACCOUNT STRING INTO CREATE MSG
SETZM .EQACT(M) ;IT FAILED,,ZERO ACCOUNT STRING
POPJ P, ;RETURN
;Here to fill in account string specified by the user
;
DOAC.1: MOVSI T1,S.ACCT ;GET SOURCE ACCT STRING ADDRESS IN LEFT
HRRI T1,.EQACT(M) ;GET DESTINATION BLT ADDRESS IN RIGHT
BLT T1,.EQACT+12-1(M) ;COPY IT OVER
MOVX T1,QF.RSP+.QUVAL ;WANT RESPONSE+ACCOUNT VALIDATION
SETZM T2 ;NO NODE
MOVE T3,[1,,T1] ;WANT RESPONSE IN T1
MOVE T4,[10,,.QBACT] ;GET LENGTH,,TYPE
MOVEI P1,.EQACT(M) ;GET ACCOUNT STRING ADDRESS
MOVX P2,QA.IMM+.QBOID ;GET PPN BLOCK TYPE
MOVE N,.EQOID(M) ;GET THE OWNERS PPN
MOVE TF,[7,,T1] ;GET UUO BLOCK LEN,,ADDRESS
QUEUE. TF, ;REQUEST ACCOUNT VALIDATION
N$FATE <IAS>,,<Invalid account string specified>
POPJ P, ;RETURN
SUBTTL NLKFIL New Wild-Card LOOKUP Routine, Writes GALAXY Bits
;NLKFIL -- Routine to do wild card LOOKUP and build GALAXY CREATE BLOCK
;
;ENTER: With output block zeroed
;CALL:( MOVEI I,0 INITIALLY)
; MOVEI FP,ADDR. OF NEXT RESULT BLOCK
; PUSHJ P,NLKFIL
; ERROR RETURN IF NO MORE (MESSAGE ISSUED IF APPROPRIATE)
; SKIP RETURN IF FILE FOUND, THE APPROPRIATE FILE POINTERS
; WILL BE UPDATED IF NECESSARY TO POINT TO THE NEXT BLOCK
; MFD, UFD FILES WILL BE POSITIONED FOR NEXT TIME IN.
; THE .FDxxx BLOCK WILL BE BUILT AND APPENDED TO THE OUTPUT MESSAGE
;USES T1,T2,T3,T4,P1
;
NLKFIL: MOVE T1,[XWD WLDLEN, WLDARG] ;POINT AT .LKWLD ARGUMENTS
PUSHJ P,.LKWLD## ;GET NEXT WILD NAME
POPJ P, ;ALL DONE
MOVE P1,T1 ;SAVE T1 UNTIL FP IS DONE
;BUILD FP BLOCK
; .FPINF -- WORD # 1
;
NLK.FP: MOVE T4,I.MOD(I) ;GET FLAGS AND BITS
MOVEI T1,FILEASCII ;GET DEFAULT /FILE
HLRZ T2,RIBEXT ;GET EXTENSION
CAIN T2,'DAT' ;.DAT?
MOVEI T1,FILEFORTRAN ;YES, USE /FILE:FORT
TXNN T4,FP.FFF ;WAS IT ALREADY FILLED IN?
STORE T1,T4,FP.FFF ;NO, FILL IT IN
MOVEI T1,DISPPRES ;GET DEFAULT DISPOSITION
CAIN T2,'LST' ;IS IT A .LST FILE?
MOVEI T1,DISPDELE ;YES, LOAD DEFAULT
TXNN T4,FP.DSP ;WAS /DISP: ALREADY SET?
STORE T1,T4,FP.DSP ;NO, FILL IT IN
LOAD T1,T4,FP.NFH ;GET THE FILE HEADER BIT
SETCA T1, ;FLIP (WE STORE IT BACKWARDS IN I.MOD)
STORE T1,T4,FP.NFH ;SAVE IT
LOAD T1,T4,FP.DSP ;GET THE /DISP: VALUE
CAIE T1,DISPDELE ;WAS IT DELETE
TDZA T1,T1 ;NO, ZERO TEMP AND SKIP
MOVEI T1,1 ;YES, GET A BIT
STORE T1,T4,FP.DEL ;SET THE DELETE BIT CORRECTLY
LOAD T1,T4,FP.DSP ;GET THE /DISP: BITS
TXZ T4,FP.LOC ;CLEAR VARIOUS FLAGS
CAIN T1,DISPREN ;IS IT RENAME ???
TXO T4,FP.REN ;YES, SET THE BIT
MOVEM T4,.FPINF(FP) ;PUT .FPINF IN MESSAGE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;FP BLOCK /TAG OR /BEGIN SWITCH
; .FPFST -- WORD # 2
;
NLFP.1: MOVE T1,I.STRT(I) ;GET /TAG OR /BEGIN SWITCH
JUMPE T1,NLFP.3 ;DID WE FIND ONE ???
JUMPE J,NLFP.2 ;YES, INPUT QUEUE ???
TLNE T1,770000 ;NO, IS IT SIXBIT ???
SETZM T1 ;YES ... IGNORE /TAG SWITCH
NLFP.2: MOVEM T1,.FPFST(FP) ;SAVE IN REQUEST
;FP BLOCK /REPORT SWITCH
; .FPFR1 -- WORDS # 3 AND 4
;
NLFP.3: SETCM T1,I.RPT(I) ;GET /REPORT SWITCH
JUMPE T1,NLFP.4 ;DID WE FIND ONE ???
DMOVE T1,I.RPT(I) ;GET /REPORT
DMOVEM T1,.FPFR1(FP) ;AND SAVE IT
;FP BLOCK /FONT SWITCH
; .FPFNM -- WORDS # 7 THRU 16
;
NLFP.4: MOVEI FD,FPMSIZ ;SET FP SIZE WITHOUT FONT BLOCK
SETCM T1,I.FONT(I) ;GET /FONT SWITCH
JUMPE T1,NLFP.5 ;DO WE HAVE ONE ???
HRLI T1,I.FONT(I) ;YES, GET ADDRESS /FONT NAME
HRRI T1,.FPFNM(FP) ;AND WHERE TO STORE IT
BLT T1,.FPFNM+FNMLTH-1(FP) ;STORE AWAY IN MESSAGE
MOVEI FD,FPXSIZ ;MAXIMUM FILE PARMS BLOCK
NLFP.5: STORE FD,.FPLEN(FP),FP.LEN ;STORE PARAMETERS SIZE IN CREATE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;BUILD FD BLOCK
;
NLK.FD: ADDI FD,(FP) ;POINT TO WHERE FD BLOCK STARTS
JUMPN P1,NLK.F1 ;JUMP IF REAL DEVICE
MOVE T1,I.MOD(I) ;GET MOD WORD
TXNN T1,FP.NEW ;IF NON-EX-DEV, SEE IF /NEW
JRST E.NSD ;NO SUCH DEVICE
MOVSI T1,.FXLEN ;BLOCK LENGTH
HRRI T1,(I) ;BLOCK ADDRESS
MOVEI T2,OPNBLK ;OPEN BLOCK
MOVE T3,[LKBLKL,,LKBLK] ;LOOKUP BLOCK
PUSHJ P,.STOPN## ;ANY WILD CARDS?
JRST E.WIN
MOVE T1,OPNBLK+1 ;GET ARGUMENT DEVICE
MOVEM T1,.FDSTR(FD) ;STORE IT
MOVEM T1,RIBDEV ;AND HERE ALSO
MOVE T1,RIBNAM ;GET FILENAME
MOVEM T1,.FDNAM(FD) ;STORE IN REQUEST
MOVE T1,RIBEXT ;GET EXTENSION
HLLZM T1,.FDEXT(FD) ;STORE IN REQUEST
JRST NLK.PA ;AND MAKE BELIEVE THE LOOKUP FAILED
NLK.F1: TXNN P1,DV.DSK ;DOES IT THINK IT'S A DISK?
JRST E.NDD ;NO, NOT EVEN CLOSE
TXNE P1,DV.TTY ;YES, IF IT THINKS ITS A TTY, IT'S NUL:
TRZE F,R.ANUL ;YES, IT'S NUL:, DO WE ALLOW IT?
JRST NLK.LK ;YUP, HE'S GOLDEN
JRST E.NDD ;NO, LOSE BIG
;HERE WHEN LOOKUP BLOCK PREPARED FOR NEXT FILE
; AND IT IS TIME TO OPEN AND LOOK IT UP
NLK.LK: MOVE T1,OPNBLK+1 ;GET ARGUMENT DEVICE
MOVEM T1,.FDSTR(FD) ;STORE AS STRUCTURE
MOVE T1,RIBNAM ;GET FILE NAME
MOVEM T1,.FDNAM(FD) ;STORE IN REQUEST
MOVE T1,RIBEXT ;GET FILE EXTENSION
HLLZM T1,.FDEXT(FD) ;STORE IN REQUEST
OPEN DC,OPNBLK ;OPEN CHANNEL
JRST [PUSHJ P,E.DFO##
JRST NLKFIL]
MOVEI T4,PTHFCN ;POINT TO USER PATH
MOVX T2,FP.NEW ;GET /NEW BIT
TDNE T2,I.MOD(I) ;TEST THE FILE (IS IT THE /NEW?)
SKIPE RIBPPN ;YES, IS THERE A PPN SPECIFIED?
MOVE T4,RIBPPN ;YES, USE IT
MOVEM T4,RIBPPN ;USE THE CORRECT ONE
LOOKUP DC,LKBLK ;EXTENDED LOOKUP
JRST NLK.ER ;IF FAILURE
MOVEI T1,DC ;GET CHANNEL NUMBER
MOVEM T1,PTFFCN ;SET IN PATH BLOCK
MOVE T1,[.PTMAX,,PTFFCN]
PATH. T1, ;GET LOCATION FROM MONITOR
SETZM PTFPPN+1 ;CLEAR RESULT
MOVEI T1,PTFFCN ;POINT TO BLOCK
SKIPE PTFPPN+1 ;SEE IF SFDS
MOVEM T1,RIBPPN ;YES--POINT FROM LOOKUP
PUSHJ P,.CHKTM## ;CHECK /BEFORE/SINCE
JRST NLKFIL ;BAD--RECYCLE
PUSHJ P,ISBIN ;SEE IF BINARY AND IMPROPER
JRST NLK.BN ;YES--GIVE ERROR
SKIPE T4,RIBDEV ;GET UNIT NUMBER
MOVEM T4,.FDSTR(FD) ;STORE INTO REQUEST
MOVE T4,RIBSIZ ;GET LENGTH IN WORDS
ADDI T4,177 ;ROUND UP
ASH T4,-7 ;CONVERT TO BLOCKS
LOAD T3,I.MOD(I),FP.FCY ;GET REPEAT COUNT
SKIPN T3 ;FORCE NON-ZERO
MOVEI T3,1 ;YES
IMUL T3,T4 ;COMPUTE COMBINED TOTAL
ADDM T3,NOBLKS ;ADD TO ACCUMULATED TOTAL
MOVX T3,FP.NEW ;GET THE /NEW BIT
ANDCAM T3,I.MOD(I) ;AND TURN IT OFF
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;VERIFY STRUCTURE NAME
;
NLK.ST: MOVE T1,.FDSTR(FD) ;GET FILE STRUCTURE
DEVNAM T1, ;GET THE REAL NAME
JRST NLK.PA ;FAILED ASSUME NON-EXISTANT
MOVEM T1,STRBLK+.DCNAM ;CONVERT UNIT TO STRUCTURE
MOVE T1,[.DCSNM+1,,STRBLK] ;SET ARGUMENTS FOR DSKCHR
DSKCHR T1, ;DO THE CONVERSION AS I$MSTR DOES
JRST NLK.PA ;FAILED, ASSUME NON-EXISTANT
JUMPE T1,NLK.PA ;IF WORKED BUT NO ANSWER, MUST BE NUL:
MOVE T2,STRBLK+.DCSNM ;GET STR NAME CONTAINING THIS UNIT
TXNN T1,DC.TYP ;IF RETURNED TYPE IS ZERO, THEN
JRST [TRZN F,R.ANUL ;ALLOW 'NUL:', IS IT LOG FD ?
N$FATE <CSG>,,<Cannot Specify Generic Disk> ;NO, FAIL PRONTO
MOVE T2,FDCSTR ;YES, GET FD CTL STR NAME
JRST .+1] ;CONTINUE ....
MOVEM T2,.FDSTR(FD) ;STORE IT BACK IN DATA BASE
MOVEM T2,FDCSTR ;SAVE THE FD'S STRUCTURE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;FD PATH BLOCK
;
NLK.PA: SETZM .FDPPN(FD) ;CLEAR OUT DIRECTORY
HRLI T1,.FDPPN(FD) ; ..
HRRI T1,.FDPAT(FD) ; ..
BLT T1,.FDPPN+.FXLND-1(FD) ; ..
SKIPN T1,RIBPPN ;GET LOOKUP DIRECTORY
MOVEI T1,PTHFCN ;UNKNOWN--GET DEFAULT
TLNE T1,-1 ;SEE IF SFD
SKIPA T2,T1 ;NO--GET UFD
MOVE T2,.PTPPN(T1) ;YES--GET UFD
MOVEM T2,.FDPPN(FD) ;SAVE IN QUEUE REQUEST
MOVEI T4,FDMSIZ ;AT LEAST A SHORT DESCRIPTOR
STORE T4,.FDLEN(FD),FD.LEN ;SAVE THAT SIZE
TLNE T1,-1 ;SEE IF SFDS
JRST NLK.EX ;NO--DONE WITH DIRECTORY
MOVEI T2,.FDPAT(FD) ;YES--POINT TO SFDS IN QUEUE REQUEST
HRLI T2,1-.FXLND ;COUNT NUMBER OF SFDS
NLK.P1: SKIPN T3,.PTPPN+1(T1) ;GET NEXT SFD
JRST NLK.EX ;ALL DONE
MOVEM T3,(T2) ;STORE IN REQUEST
INCR T1 ;ADVANCE FETCH
LOAD T4,.FDLEN(FD),FD.LEN ;PICK UP FD LENGTH
INCR T4 ;ADD 1 TO IT
STORE T4,.FDLEN(FD),FD.LEN ;AND SAVE IT
AOBJN T2,NLK.P1 ;LOOP OVER STORE
;NLKFIL EXIT ROUTINE
;
NLK.EX: LOAD T1,.FDLEN(FD),FD.LEN ;GET LENGTH OF FD
LOAD T2,.FPLEN(FP),FP.LEN ;GET FP AREA LENGTH
ADDI T2,(T1) ;T2 = LENGTH OF AREA TO INCLUDE
LOAD T1,.MSTYP(M),MS.CNT ;GET CURRENT SIZE
ADDI T1,(T2) ;T1 = LENGTH INCLUDING THIS FILE
STORE T1,.MSTYP(M),MS.CNT ;STORE NEW LENGTH
JRST .POPJ1## ;IF SUCCESS RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;HERE WHEN LOOKUP FAILS--SEE IF .NULL NEEDED OR /NEW SWITCH
;
NLK.ER: MOVEM T4,RIBPPN ;RESTORE DIRECTORY
HRRZ T2,RIBEXT ;GET LOOKUP ERROR CODE
JUMPN T2,NLK.BD ;GO ISSUE ERROR
SETZM RIBPRV ;CLEAR PROTECTION, ET
CAMN I,I.INZR ;IS THIS THE FIRST SPEC?
CAIE J,QTPINP ;AND BATCH?
JRST NLK.E2 ;NO
MOVE T3,I.MOD(I) ;GET SWITCHES
TXNE T3,FP.NEW ;SEE IF /NEW
JRST NLK.E3 ;YES--LET THIS ONE THROUGH
MOVSI T1,'DSK' ;DEFAULT
CAME T1,.FXDEV(I) ; DEVICE?
JRST NLK.BD ;NO--GIVE UP
MOVSI T1,'CTL' ;ERSATZ DEVICE CTL
MOVEM T1,.FXDEV(I) ;STUFF IN SCAN BLOCK
MOVEM T1,OPNBLK+1 ;PUT IN OPEN BLOCK
JRST NLK.LK ;LOOP BACK AND TRY AGAIN
NLK.E2: MOVE T3,I.MOD(I) ;GET SWITCHES
TXNN T3,FP.NEW ;SEE IF /NEW
JRST NLK.BD ;NO--ERROR
NLK.E3: TRNN F,R.ANUL ;*.LOG FILE FD ???
JRST NLK.PA ;NO, SO LET'S FAIL GRACEFULLY
ENTER DC,LKBLK ;TRY AN ENTER TO GET FILE INFO
JRST NLK.ST ;NO LUCK THERE
MOVE T1,[2,,T2] ;POINT AT FILOP. ARGUMENTS
MOVE T2,[DC,,.FOFIL] ;FUNCTION TO RETURN FILE SPEC
MOVE T3,[.FOFMX,,FOFBLK] ;WHERE TO RETURN IT
FILOP. T1, ;ASK WHERE FILE WOUND UP
JRST NLK.E1 ;ERROR, LEAVE THINGS ALONE
MOVE T1,FOFBLK+.FOFDV ;GET DEVICE
MOVEM T1,.FDSTR(FD) ;SAVE STRUCTURE
MOVE T1,FOFBLK+.FOFFN ;GET FILE NAME
MOVEM T1,.FDNAM(FD) ;SAVE
MOVE T1,FOFBLK+.FOFEX ;GET EXTENSION
MOVEM T1,.FDEXT(FD) ;SAVE
MOVEI T1,FOFBLK+.FOFPP-.PTPPN ;FAKE LIKE A RETURNED PATH BLOCK
MOVEM T1,RIBPPN ;SAVE FOR NLK.PA
NLK.E1: MOVEI T1,DC ;GET CHANNEL
RESDV. T1, ;ABORT THE ENTER
JFCL ;YOU KNOW HOW IT IS
JRST NLK.ST ;RETURN RESULTS
NLK.BD: PUSHJ P,E.DFL## ;ISSUE ERROR MESSAGE
SKIPLE S.ALLF ;DOES HE WANT ALL HIS FILES?
N$FATE <NAF>,,<Not All Requested Files Exist> ;YES, DIE NOW
JRST NLKFIL ;NO, LOOP BACK TO GET NEXT REQUEST
NLK.BN: N$WARN <CPB>,<N>,<Can't print binary>
PUSHJ P,.TFILE##
JRST NLKFIL ;LOOP FOR NEXT FILE
;.LKWLD ARGUMENT BLOCK
WLDARG: XWD I.INZR, I.LSZR ;ADDRESS OF FIRST,,LAST FILE SPECS
XWD OPNBLK, LKBLK ;ADDRESS OF OPEN,,LOOKUP BLOCKS
XWD I.LZER, LKBLKL ;LENGTH OF FILE SPEC,,LOOKUP BLOCK
XWD 400000+DC, I ;FLAGS/CHANNEL,,INDEX TO CURRENT SPEC
WLDLEN==.-WLDARG ;LENGTH OF .LKWLD ARGUMENT BLOCK
SUBTTL ISBIN Check for Binary File Subroutine
;CALL: PUSHJ P,ISBIN
;ERROR RETURN IF WRONG
;SKIP RETURN IF OK
;USES T1, T2, T3, T4
;
ISBIN: MOVX T1,FP.OKB ;SEE IF /OKBINARY SWITCH
TDNE T1,I.MOD(I) ; ..
JRST .POPJ1## ;YES--GIVE OK RETURN
LOAD T1,I.MOD(I),FP.FPF ;GET MODE
LOAD T2,RIBPRV,RB.MOD ;GET FILE MODE
CAILE T2,.IOASL ;IF FILE MODE IS ASCII OR ASCII LINE,
CAILE T1,PRINASCII ;OR IF OUTPUT MODE IS NOT ASCII
;OR ARROW,
JRST .POPJ1## ;THEN IT IS OK ANYWAY
MOVE T1,QTYPE ;GET TYPE OF QUEUE
CAIE T1,QTPLPT ;IF NOT LPT,
JRST .POPJ1## ; THEN IT IS OK
;HERE WHEN NO SPECIAL CASES, JUST LPT OF RANDOM FILE
;
HLRZ T1,RIBEXT ;GET EXTENSION FOR EASE OF TESTING
MOVSI T3,-LENBEX ;GET LENGTH OF BINARY EXTENSION TABLE
ISBIN1: MOVE T2,BINEXT(T3) ;GET NEXT PAIR
CAIN T1,(T2) ;SEE IF IT MATCHES
POPJ P, ;YES--ERROR RETURN
HLRZS T2 ;TRY OTHER ONE
CAIN T1,(T2) ;..
POPJ P, ;ERROR RETURN
AOBJN T3,ISBIN1 ;LOOP UNTIL DONE
JRST .POPJ1## ;NOT BINARY EXTENSION--MUST BE OK
BINEXT: 'BACBIN' ;BASIC OUTPUT,,BINARY
'BUGCHN' ;PROGRAM SAVED WITH BUG,,CHAIN FILE
'DAEDCR' ;DAEMON FILE,,DCORE FILE
'DMPHGH' ;PDP-6 SAVE,,NON-SHAREABLE HIGH SEG SAVE
'LOWMSB' ;LOW SEGMENT,,MUSIC PROGRAM OUTPUT
'OVRQUC' ;COBOL OVERLAY,,QUEUE CHANGE
'QUDQUE' ;QUEUE DATA,,QUEUE REQUEST
'QUFREL' ;QUEUED REQUEST,,RELOCATABLE BINARY
'RIMRMT' ;TWO KINDS OF READ IN MODE FILES
'RTBSAV' ;ANOTHER RIM,,SAVE FILE
'SFDSHR' ;SUB-FILE DIRECTORY,,SHAREABLE HIGH SEGMENT SAVE
'SVESYS' ;10/30 SAVE,,SYSTEM BINARY FILE
'TMPUFD' ;TEMPORARY FILE,,USER'S FILE DIRECTORY
'XPNVMX' ;EXPANDED SAVE FILE,,VM SPECIAL CORE IMAGE
'EXEOVL' ;NEW SAVE FILE FORMAT,,OVERLAY
'DBSSCH' ;DBMS FILE,,ANOTHER DBMS FILE
'ATRUNV' ;SIMULA ATTRIBUTE FILE,,UNIVERSAL FILE
'DMSFIN' ;1022 DATABASE,,"FINE" EDITOR BUFFER FILE
;ADD MORE HERE--FILL WITH A DUPLICATE--NEVER FILL WITH 0
LENBEX==.-BINEXT
SUBTTL NMODFY New MODIFY routine
NMODFY: SKIPL S.BATL ;MODIFY /BATLOG SWITCH ???
N$FATE<CMB>,,<Can't modify /BATLOG switch> ;SEE YA
SKIPL S.NTF ;MODIFY /NOTIFY SWITCH ???
N$FATE<CMN>,,<Can't modify /NOTIFY switch> ;SEE YA
;SET UP THE TEMP AND MESSAGE AREAS
;
PUSH P,.JBFF## ;SAVE ORIGINAL .JBFF
PUSHJ P,MSETUP ;GET MEMORY ETC FOR MESSAGE
TXO M,1B0 ;INDICATE PAGE MODE MESSAGE
;MODIFY MESSAGE HEADER
;
MOVX T1,<INSVL.(MOD.SZ,MS.CNT)!INSVL.(.QOMOD,MS.TYP)>
MOVEM T1,.MSTYP(M) ;STORE IN MESSAGE HEADER
MOVX T1,MF.ACK ;ASK QUASAR FOR AN
MOVEM T1,.MSFLG(M) ;ACKNOWLEDGEMENT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;GROUP 0 -- Major Queue Items
;GROUP 0, HEADER
;
MOVEI P1,<MOD.FG+MOD.GN>(M) ;POINT TO THE FIRST GROUP HEADER
MOVE P2,P1 ;COPY ADDRESS OF GROUP HEADER
MOVX T1,<.GPMAJ,,0> ;DO MAJOR REQUEST MODIFIES
PUSHJ P,GRPSTO ;STORE AND BUMP COUNTS
;GROUP 0, WORD 0
;
MOVWRD S.AFT ;/AFTER SWITCH
;GROUP 0, WORD 1
;
MOVE T1,S.PRI ;GET /PRIORITY SWITCH WORD
CAMN T1,[-1] ;DID WE TYPE IT IN ???
JRST MOD.01 ;NO, SAVE INDICATING NO CHANGE
SKIPN T1 ;/PRIORITY:0 SPECIFIED?
N$FATE <PZR>,,</PRIORITY:0 not in range 1 to 63> ;SEE YA
ANDI T1,77 ;MASK TO FIT
MOD.01: PUSHJ P,GRPSTO ;STORE /PRIORITY
;GROUP 0, WORD 2
;
MOVWRD [-1] ;/DEADLINE SWITCH, NO LONGER SUPPORTED
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;GROUP 0, WORD 3
;
LOAD T1,O.MOD,FX.PRO ;GET USER SPECIFIED PROTECTION
CAIE T1,777 ;DID HE SAY /PROT:777?
JRST MOD.02 ;NO, DON'T CHANGE IT
N$WARN <PII>,,</PROTECT:777 is illegal, changed to 677>
MOVEI T1,677 ;AND DO IT
MOD.02: SKIPN T1 ;NOT SPECIFIED?
SETOM T1 ;YES, SHOW NO CHANGE
PUSHJ P,GRPSTO ;STORE /PROTECTION
;GROUP 0, WORD 4
;
JUMPN J,MOD.03 ;IF OUTPUT QUEUE, GO DO IT
;INPUT ATTRIBUTE WORD ROUTINE
;
MOVE T1,S.ATTRIB ;GET ATTRIBUTE SWITCH WORD
CAMN T1,[-1] ;DID WE TYPE IT IN ???
JRST MOD.05 ;NO, SAVE INDICATING NO CHANGE
LOAD T1,S.ATTRIB,RO.ATR ;GET ATTRIBUTES
CAXE T1,%SITGO ;IS IT SITGO ???
MOVX T1,%GENRC ;NO, MUST BE GENRIC
HRLZS T1 ;MOVE BITS TO LEFT HALF
JRST MOD.05 ;SAVE INPUT ATTRIBUTE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;OUTPUT MODIFY ATTRIBUTE ROUTINE
;
MOD.03: SETZM T1 ;GET SOME ATTRIBUTES
HLRZ T2,O.DEV ;GET THE DEVICE
CAIN T2,'LL ' ;IS IT LL?
MOVX T1,%LOWER ;YES,,LOAD LOWER CASE
CAIN T2,'LU ' ;OR LU?
MOVX T1,%UPPER ;YES,,LOAD UPPER CASE
HRLZS T1 ;MOVE BITS TO LEFT HALF
;OUTPUT MODIFY UNIT WORD CODE (MPB)
;MAY OVER WRITE T1, ENTRY IN MODIFY MESSAGE
;
HRRZ T2,O.DEV ;GET DEVICE ONCE MORE
JUMPE T2,MOD.04 ;MPB FORMAT FIELD ???
LDB T3,[POINT 6,T2,23] ;YES, GET 4TH DIGIT
CAIN T3,'S' ;STATION SPECIFICATION?
JRST MOD.04 ;YES, NO MPB UNIT VALUE
LDB T4,[POINT 6,T2,35] ;GET THE 6TH CHAR
TXNN T2,7700 ;IS THERE A NODE FIELD?
LDB T4,[POINT 6,T2,23] ;NO, GET 4TH DIGIT
JUMPE T4,MOD.04 ;GO IF NO UNIT
SUBI T4,'0' ;ELSE, GET A UNIT
TXO T4,RO.PHY ;SET PHYSICAL UNIT BIT
MOVE T1,T4 ;YES, SUPERCEDE PREVIOUS ATTRIBUTE
;OUTPUT MODIFY QUEUE /LOWER, /UPPER, AND /UNIT SWITCH CODE (GALAXY)
;MAY OVER WRITE T1, ENTRY IN MODIFY MESSAGE
;
MOD.04: MOVE T2,S.ATTRIB ;GET ATTRIBUTE SWITCH WORD
CAME T2,[-1] ;DID WE TYPE IT IN ???
MOVE T1,T2 ;YES, SUPERCEDE PREVIOUS ATTRIBUTE
MOD.05: SKIPN T1 ;DID WE FIND AN ATTRIBUTE ???
SETOM T1 ;NO, SO DON'T MODIFY IT
PUSHJ P,GRPSTO ;STORE /ATTRIBUTE VALUE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;GROUP 0, WORD 5
;
SKIPE J ;THE INPUT QUEUE ???
SKIPA T1,S.DEST ;NO--LOAD /DEST
MOVE T1,S.PROC ;YES--LOAD /PROC
CAMN T1,[-1] ;DID WE TYPE IT IN ???
SKIPA ;NO, DON'T SET, CONVERT, OR DEFAULT
PUSHJ P,SETNODE ;CONVERT IT
PUSHJ P,GRPSTO ;STORE IT
;GROUP 0, WORD 6
;
SETOM T1 ;CUSTOMER WORD, INDICATE NO CHANGE
PUSHJ P,GRPSTO ;STORE IT
;GROUP 1 -- Queue Dependent Items
;GROUP 1, HEADER
;
MOVE P2,P1 ;COPY ADDRESS OF GROUP HEADER
MOVX T1,<.GPQUE,,0> ;DO QUEUE DEPENDENT MODIFY
PUSHJ P,GRPSTO ;STORE AND BUMP COUNTS
MOVE I,I.INZR ;GET THE FIRST REQUEST.
JUMPN J,MODOUT ;IF OUTPUT QUEUE, GO DO IT
JRST MODINP ;MODIFY INPUT SPECIFIC FIELDS
;CONTINUED ON THE NEXT PAGE
SUBTTL MODINP INPUT Specific Modification Routines
;CONTINUED FROM PREVIOUS PAGE
;MODIFY INPUT QUEUE
;INP GROUP 1, WORD 0
;
MODINP: MOVE T1,S.COR ;GET /CORE LIMIT
JUMPL T1,MOD.06 ;SKIP THIS IF IT DIDN'T CHANGE
ADDI T1,PAGSIZ-1 ;ROUND UP TO A PAGE BOUNDRY
ADR2PG T1 ;CONVERT TO PAGES
MOD.06: PUSHJ P,GRPSTO ;STORE /CORE
;INP GROUP 1, WORD 1
;
MOVWRD S.LTIM ;DO/TIME LIMIT
;INP GROUP 1, WORD 2
;
MOVWRD S.LLPT ;DO /LPT LIMIT
;INP GROUP 1, WORD 3
;
MOVWRD S.LCDP ;DO /CDP LIMIT
;INP GROUP 1, WORD 4
;
MOVWRD S.LPTP ;DO /PTP LIMIT
;INP GROUP 1, WORD 5
;
MOVWRD S.LPLT ;DO /PLT LIMIT
;INP GROUP 1, WORD 6
;
MOVE T1,S.DPN ;GET THE /DEPENDENCY WORD
JUMPL T1,MOD.07 ;SKIP THIS IF NO CHANGE
LOAD T1,S.DPN,MI.DEP ;GET VALUE
LOAD T2,S.DPN,MI.DMT ;GET TYPE (+,-,ABSOLUTE)
HRLI T1,(T2) ;INCLUDE TYPE CODE
MOD.07: PUSHJ P,GRPSTO ;STORE /DEPENDENCY COUNT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;INP GROUP 1, WORD 7
;
SKIPL T1,S.UNIQ ;GET /UNIQUE SWITCH
MOVE T1,[EXP %EQUNO,%EQUYE](T1) ;CONVERT TO QUASAR STANDARD
PUSHJ P,GRPSTO ;STORE /UNIQUE
;INP GROUP 1, WORD 8
;
SKIPL T1,S.RSTR ;GET /RESTART SWITCH
MOVE T1,[EXP %EQRNO,%EQRYE](T1) ;CONVERT TO QUASAR STANDARD
PUSHJ P,GRPSTO ;STORE /RESTART
;INP GROUP 1, WORD 9
;
MOVWRD S.OUT ;DO /OUTPUT (/Z:)
;INP GROUP 1, WORD 10
;
MOVE T1,S.DEST ;YES, LOAD /DEST
CAMN T1,[-1] ;DID WE TYPE IT IN ???
SKIPA ;NO, DON'T SET, CONVERT, OR DEFAULT
PUSHJ P,SETNODE ;CONVERT IT
PUSHJ P,GRPSTO ;STORE /DEST (INP:)
;INP GROUP 1, WORD 11
;
SKIPL T1,S.ASST ;GET /ASSIST
MOVE T1,[EXP .OPINN,.OPINY](T1) ;CONVERT TO QUASAR STANDARD
PUSHJ P,GRPSTO ;DO /ASSISTANCE (OINT)
;DO INP FILE SPECIFIC CHANGES NOW
;INP GROUP 1, WORD 12
;
MOVWRD I.STRT(I) ;DO /TAG OR /BEGIN
JRST KILN.1 ;FILL IN COMMON PART AND SEND MESSAGE
SUBTTL MODOUT OUTPUT Specific Modification Routines
;MODIFY OUTPUT QUEUE
;GROUP 1, WORD 0
;
MODOUT: MOVWRD S.FRM ;DO /FORMS
;GROUP 1, WORD 1
;
MOVWRD S.LIM ;DO /LIMIT
;GROUP 1, WORD 2
;
MOVWRD S.NOT ;DO /ANNOTATION (1ST HALF)
;GROUP 1, WORD 3
;
MOVWRD S.NOT+1 ;DO /ANNOTATION (2ND HALF)
;OUTPUT FILE SPECIFIC MODIFY ROUTINE
;OUT GROUP 1, WORD 4
;
NMDCHG FP.NFH ;GET /HEADER
SKIPL T1 ;SKIP IF NO CHANGE
TRC T1,1 ;FLIP IT FOR GALAXY
PUSHJ P,GRPSTO ;STORE /HEADER
;OUT GROUP 1, WORD 5
;
NMDCHG FP.FSP ;GET /SPACING
PUSHJ P,GRPSTO ;STORE /SPACING
;OUT GROUP 1, WORD 6
;
NMDCHG FP.FPF ;GET /PRINT FORMAT
PUSHJ P,GRPSTO ;STORE /PRINT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;OUT GROUP 1, WORD 7
;
NMDCHG FP.FFF ;GET /FILE FORMAT
PUSHJ P,GRPSTO ;STORE /FILE
;OUT GROUP 1, WORD 10
;
NMDCHG FP.DSP ;GET /DISPOSITION
CAIN T1,DISPRENAME ;MODIFY /RENAME SWITCH ???
N$FATE<CMR>,,<Can't modify /DISPOSE:RENAME> ;SEE YA
JUMPL T1,MOD.10 ;JUMP IF DIDN'T CHANGE
CAIN T1,DISPPRES ;WAS IT /DIS:PRESERVE
TDZA T1,T1 ;YES, CLEAR THE DELETE BIT
MOVEI T1,1 ;NO, SET THE DELETE BIT
MOD.10: PUSHJ P,GRPSTO ;STORE /DISP
;OUT GROUP 1, WORD 11
;
NMDCHG FP.FCY ;GET /COPY COUNT
PUSHJ P,GRPSTO ;STORE /COPIES
;OUT GROUP 1, WORD 12
;
MOVWRD I.RPT(I) ;/REPORT 1ST WORD
;OUT GROUP 1, WORD 13
;
MOVWRD I.RPT+1(I) ;/REPORT 2ND WORD
;OUT GROUP 1, WORD 14
;
MOVWRD I.STRT(I) ;STORE /BEGIN
JRST KILN.1 ;FILL IN COMMON PART AND SEND MESSAGE
SUBTTL GRPSTO Subroutine to Add a MODIFY Element to the Message
;CALL: PUSHJ P,GRPSTO
; T1 = THING TO STORE
; P1 = CURRENT POINTER (WILL INCREMENT THIS AND MESSAGE LENGTH)
; P2 = GROUP HEADER ADDRESS (WILL INCREMENT ELEMENT COUNT)
;
GRPSTO: CAILE P1,PAGSIZ-1(M) ;OFF THE END YET
N$FATE<TMF>,,<Too Many Files in File-Specific Modify>
MOVEM T1,(P1) ;STORE THIS ELEMENT
LOAD T1,.MSTYP(M),MS.CNT ;GET CURRENT COUNT
INCR T1 ;ADD ANOTHER
STORE T1,.MSTYP(M),MS.CNT ;STORE IT
INCR MOD.GN(P2),MODGLN ;ANOTHER ELEMENT IN THIS GROUP
AOJA P1,.POPJ## ;ADVANCE FOR NEXT STORE AND RETURN
SUBTTL NKILL New KILL routine
;SET UP THE TEMP AND MESSAGE AREAS
;
NKILL: PUSH P,.JBFF## ;SAVE ORIGINAL .JBFF
PUSHJ P,MSETUP ;GET MEMORY ETC FOR MESSAGE
;KILL MESSAGE HEADER
;
MOVX T3,<INSVL.(KIL.SZ,MS.CNT)!INSVL.(.QOKIL,MS.TYP)>
MOVEM T3,.MSTYP(M) ;STORE IN MESSAGE HEADER
MOVX T3,MF.ACK ;SET FOR ACKNOWLEDGEMENT
MOVEM T3,.MSFLG(M) ;
KILN.1: PUSHJ P,GETOBJ ;GET OBJECT TYPE
STORE T3,KIL.OT(M) ;STORE IT
MOVE T1,O.NAM ;GET THE JOB NAME, COULD BE ZERO
STORE T1,KIL.RQ+.RDBJB(M) ;COPY THE JOB NAME
MOVE T1,O.NAMM ;GET THE MASK
STORE T1,KIL.RQ+.RDBJM(M) ;AND PUT IT IN THE MESSAGE
SKIPG T1,S.SEQ ;ANY SEQUENCE NUMBER ???
SETZM T1 ;IF NEGATIVE, SET TO ZERO
STORE T1,KIL.RQ+.RDBES(M) ;STORE IT IN MESSAGE
SKIPG T1,S.RID ;GET THE REQUEST ID
SETZM T1 ;IF NEGATIVE, SET TO ZERO
STORE T1,KIL.RQ+.RDBRQ(M) ;AND STORE IT IN THE MESSAGE
MOVE T1,O.DIR ;GET SPECIFIED PPN/DIRECTORY
STORE T1,KIL.RQ+.RDBOI(M) ;AND STORE IT
MOVE T1,O.DIRM ;GET THE PPN MASK
STORE T1,KIL.RQ+.RDBOM(M) ;AND ITS MASK
PUSHJ P,MSGSND ;SEND THE MESSAGE
PUSHJ P,RCVACK ;GET THE ACKNOWLEDGEMENT
PJRST CMDXIT ;AND RETURN TO CALLER
SUBTTL NLIST New LIST Routines
NLIST: PUSHJ P,LSTOPN ;OPEN THE LISTING FILE
MOVE I,I.INZR ;GET THE FIRST REQUEST.
;SET UP THE TEMP AND MESSAGE AREAS
;
PUSH P,.JBFF## ;SAVE ORIGINAL .JBFF
PUSHJ P,MSETUP ;GET MEMORY ETC FOR MESSAGE
;LIST MESSAGE HEADER
;
MOVEI T1,.OHDRS ;MAKE MESSAGE LENGTH FOR NOW
STORE T1,.MSTYP(M),MS.CNT ;AND SAVE IT.
MOVX T1,.QOLIS ;GET THE REQUEST TYPE.
STORE T1,.MSTYP(M),MS.TYP ;AND SAVE IT.
SETZM .OARGC(M) ;NO ARGS YET
SETZM .MSCOD(M) ;ZERO THE ACK CODE.
MOVE T1,S.LIST ;GET THE /LIST: BITS.
SETZM T2 ;DEFAULT THE FLAG WORD
CAIN T1,LISTFAST ;DOES HE WANT A QUICK LISTING.
MOVX T2,LS.FST ;YES, GET THE /L:FAST BITS.
CAIN T1,LISTALL ;WAS IT /LIST:ALL ???
MOVX T2,LS.ALL ;YES, GET THE RIGHT BITS
CAIN T1,LISTSUMMARY ;/LIST:SUMMARY?
MOVX T2,LS.SUM ;YES
SKIPG S.RMT ;DOES HE WANT A REMOTE LISTING TOO?
SKIPE S.QNM ;NOT EXPLICITLY, MAYBE BY DEFAULT?
TXO T2,LS.RMT ;YES
MOVEM T2,.OFLAG(M) ;SAVE IT IN THE MESSAGE.
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;QUEUE TYPE BLOCK # 0
;
SETO T3, ;ASSUME ALL QUEUES
MOVEI P2,.OHDRS(M) ;POINT TO FIRST FREE LIST BLOCK
MOVE T1,.FXDEV(I) ;GET THE DEVICE
MOVE T2,T1 ;SAVE IT IN T2
TRZ T1,-1 ;GET JUST GENERIC PART
CAMN T1,QUENMA ;IS IT 'ALLXXX' ???
HRRZS T2 ;YES, MAKE IT 0,,XXX
HLLZS T2 ;GET GENERIC DEVICE
JUMPE T2,NLST.3 ;PROPER ASSUMPTION
MOVSI T3,-NDEVS ;MAKE AN AOBJN POINTER
NLST.1: CAMN T1,DEVTAB(T3) ;MATCH?
JRST NLST.2 ;YES
AOBJN T3,NLST.1 ;NO, LOOP
SETZM T3 ;LET QUASAR THROUGH IT OUT
JRST NLST.3 ;STORE RESULT
NLST.2: MOVE T3,LIQTAB(T3) ;GET MASK
NLST.3: MOVEM T3,LSTQUE ;SAVE FOR LATER
MOVEI T4,.LSQUE ;TYPE (QUEUES TO LIST)
PUSHJ P,NLSTBL ;ADD TO LIST BLOCK
;ID/PPN BLOCK # 1
;
SKIPLE S.CHK ;SEE IF /CHECK
JRST [MOVE T1,.MYPPN ;YES--GET MY PPN
MOVEM T1,.FXDIR(I) ;SAVE AS SPECIFIED
SETOM .FXDIM(I) ;FLAG NO WILD CARDS
JRST .+1] ;AND CONTINUE
SKIPN T3,.FXDIR(I) ;SEE IF USER ID/PPN GIVEN
JRST NLST.4 ;NO
MOVEI T4,.LSUSR ;TYPE (USER ID)
PUSHJ P,NLSTBL ;ADD TO LIST BLOCK
;ID/PPN MASK BLOCK # 2
;
MOVE T3,.FXDIM(I) ;GET USER ID MASK
MOVEI T4,.LSUSM ;TYPE (USER ID MASK)
PUSHJ P,NLSTBL ;ADD TO LIST BLOCK
;JOBNAME REQUESTED BLOCK # 3
;
NLST.4: SKIPN T3,.FXNAM(I) ;SEE IF JOB NAME GIVEN
JRST NLST.5 ;NO
MOVEI T4,.LSJOB ;TYPE (JOB NAME)
PUSHJ P,NLSTBL ;ADD TO LIST BLOCK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;JOBNAME REQUESTED MASK BLOCK # 4
;
MOVE T3,.FXNMM(I) ;GET JOB NAME MASK
MOVEI T4,.LSJBM ;TYPE (JOB NAME MASK)
PUSHJ P,NLSTBL ;ADD TO LIST BLOCK
;ROB UNIT (MPB) BLOCK # 5
;
NLST.5: SETOM T3 ;INDICATE NO MPB/GLX UNIT BITS YET
HRRZ T1,.FXDEV(I) ;GET DEVICE ONCE MORE
JUMPE T1,NLST.6 ;MPB FORMAT FIELD ???
LDB T2,[POINT 6,T1,23] ;YES, GET 4TH DIGIT
CAIN T2,'S' ;STATION SPECIFICATION?
JRST NLST.6 ;YES, NO MPB UNIT VALUE
LDB T2,[POINT 6,T1,35] ;GET THE 6TH CHAR
TXNN T1,7700 ;IS THERE A NODE FIELD?
LDB T2,[POINT 6,T1,23] ;NO, GET 4TH DIGIT
JUMPE T2,NLST.6 ;GO IF NO UNIT
SUBI T2,'0' ;ELSE, GET A UNIT
MOVE T3,T2 ;GET READY TO STORE MPB BITS
;IF NECESSARY
;ROB /UNIT SWITCH (GALAXY) BLOCK # 5
;
NLST.6: LOAD T1,S.ATTRIB,RO.ATR ;YES, GET OBJECT ATTRIBUTES
CAIN T1,%PHYCL ;PHYSICAL UNIT ???
MOVE T3,S.ATTRIB ;YES, GET GALAXY UNIT BITS
SKIPL T3 ;UNLESS NOT SPECIFIED,
HRRZM T3,LSTUNT ;SAVE FOR LATER
MOVEI T4,.LSUNT ;YES, SET TYPE (UNIT NUMBER)
PUSHJ P,NLSTBL ;AND ADD IT TO THE LIST BLOCK
MOVE T3,S.UNTY ;GET UNIT TYPE
MOVE T4,T3 ;COPY IT
AOJE T4,NLST.7 ;JUMP IF NONE REQUESTED
MOVEM T3,LSTUTY ;SAVE UNIT FOR LATER
MOVEI T4,.LSUTY ;BLOCK CODE FOR UNIT TYPE
PUSHJ P,NLSTBL ;ADD TO MESSAGE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;DESTINATION NODE (MPB) BLOCK # 6
;
NLST.7: SETOM T3 ;INDICATE NO MPB/GLX DEST FIELD
HRRZ T1,.FXDEV(I) ;GET DEVICE ONCE MORE
JUMPE T1,NLS.7B ;MPB FORMAT FIELD ???
TXNN T1,7700 ;YES, IS THERE A NODE FIELD?
JRST NLS.7B ;NO, GOTO GALAXY FIELD PROCESSING
SETZM T3 ;CLEAR AC FOR MPB NODE NUMBER
LDB T2,[POINT 6,T1,23] ;YES, GET 4TH CHAR
CAIN T2,'S' ;STATION SPECIFICATION?
JRST NLS.7A ;YES, fooSnn COMMAND
SUBI T2,'0' ;NO, MAKE CHAR OCTAL
DPB T2,[POINT 3,T3,32] ;BUILD OCTAL NODE DEST NUMBER
LDB T2,[POINT 6,T1,29] ;GET 5TH CHAR
SUBI T2,'0' ;MAKE CHAR OCTAL
DPB T2,[POINT 3,T3,35] ;FINISH OCTAL NODE DEST NUMBER
JRST NLS.7B ;CHECK FOR GALAXY BITS
NLS.7A: LDB T2,[POINT 6,T1,29] ;GET 5TH CHAR
SUBI T2,'0' ;MAKE CHAR OCTAL
DPB T2,[POINT 3,T3,32] ;BUILD OCTAL NODE DEST NUMBER
LDB T2,[POINT 6,T1,35] ;GET 6TH CHAR
SUBI T2,'0' ;MAKE CHAR OCTAL
DPB T2,[POINT 3,T3,35] ;FINISH OCTAL NODE DEST NUMBER
;DESTINATION NODE (GALAXY) BLOCK # 6
;
NLS.7B: MOVE T1,S.DEST ;GET /DESTINATION
CAMN T1,[-1] ;DO WE HAVE GALAXY BITS ???
JRST NLS.7C ;NO, SO USE DEFAULT OR MPB BITS
PUSHJ P,SETNOD ;CONVERT IF NECESSARY
MOVE T3,T1 ;YES, USE THEM INSTEAD OF MPB BITS
NLS.7C: MOVEM T3,LSTNOD ;SAVE FOR LATER
MOVEI T4,.LSDND ;BLOCK TYPE
PUSHJ P,NLSTBL ;ADD TO MESSAGE
;PROCESSING NODE BLOCK # 7
;
MOVE T1,S.PROC ;GET /PROCESSING
PUSHJ P,SETNOD ;CONVERT IF NECESSARY
MOVE T3,T1 ;GET READY TO STORE IT
MOVEI T4,.LSPND ;BLOCK TYPE
PUSHJ P,NLSTBL ;ADD TO MESSAGE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SKIPE S.QNM ;SEE IF /QUEUE
PUSHJ P,NLSTQN ;YES, ADD QUEUE NAME BLOCK TO MESSAGE
;SEND LIST MESSAGE TO QUASAR
;
TXO M,1B0 ;INDICATE A PAGE FOR MSGSND
PUSHJ P,MSGSND ;SEND THE REQUEST
;RECEIVE MESSAGE FROM QUASAR
;
NLST.8: MOVE M,.JBFF## ;NOW FOR THE MESSAGES RETURNED,
MOVEI M,PAGSIZ-1(M) ;COMPUTE THE FIRST NON-EX PAGE.
TRZ M,PAGSIZ-1 ;ZERO THE BOTTOM BITS.
ADR2PG M ;CONVERT IT TO A PAGE NUMBER.
PUSHJ P,QUEWAT ;WAIT FOR A MESSAGE FROM QUASAR
MOVX T3,IP.CFV ;IT'S A PAGED ANSWER
SETZB T4,P1 ;CLEAR OTHER STUFF
MOVEI P2,(M) ;THE PAGE TO RECEIVE
HRLI P2,PAGSIZ ;COUNT FOR PAGE MODE
MOVE T2,[4,,T3] ;LENGTH,,ADDR
IPCFR. T2, ;REC, WAIT
SKIPA ;CAN'T
JRST NLST.9 ;PROCESS THE MESSAGE
CAXN T2,IPCUP% ;OUT OF CORE ?
N$FATE<NCL>,,<Not enough core to receive list answer>
N$FATE<LRF>,,<List answer receive failed>
NLST.9: PG2ADR M ;CONVERT PAGE # TO AN ADDRESS.
MOVEM M,.JBFF## ;RESET THE LAST PAGE ADDRESS.
INCR .JBFF## ;BUMP IT BY 1 TO FORCE NEXT PAGE.
MOVE T2,ACKCOD ;GET THE CODE WE WANT TO SEE
CAME T2,.MSCOD(M) ;EXPECTING THIS MESSAGE?
JRST NLST.8 ;NO, IGNORE IT
PUSHJ P,LSTTYO ;GO DUMP THE ANSWER.
LOAD T2,.OFLAG(M) ;GET THE FLAG BITS.
TXNE T2,WT.MOR ;WAS THIS THE LAST PAGE ???
JRST NLST.8 ;NO,,GO GET ANOTHER PAGE.
CLOSE LC, ;YES, CLOSE THE CHANNEL
RELEAS LC, ;RELEASE THE CHANNEL
PJRST CMDXIT ;AND RETURN
SUBTTL NLSTBL Subroutine to Add Thing to LIST Message Block
;CALL: PUSHJ P,NLSTBL
; T3/ DATA TO ADD
; T4/ TYPE CODE
;ASSUMES (AND UPDATES) P2 TO BE POINTER TO NEXT FREE BLOCK
NLSTBL: MOVEM T3,ARG.DA(P2) ;STORE THE DATA
STORE T4,ARG.HD(P2),AR.TYP ;STORE THE TYPE
MOVEI T3,2 ;THEY ARE TWO WORDS LONG
STORE T3,ARG.HD(P2),AR.LEN ;STORE THE LENGTH
INCR .OARGC(M) ;ONE MORE ARG
ADDI P2,2 ;ADVANCE TO NEXT BLOCK
LOAD T3,.MSTYP(M),MS.CNT ;GET MESSAGE COUNT
ADDI T3,2 ;UPDATE FOR WHAT WE STORED
STORE T3,.MSTYP(M),MS.CNT ;AND REMEMBER
POPJ P, ;RETURN
SUBTTL NLSTQN Subroutine to store queue name string to LIST message block
;CALL: PUSHJ P,NLSTQN
; S.QNM/ QUEUE NAME STRING
;ASSUMES (AND UPDATES) P2 TO BE POINTER TO NEXT FREE BLOCK
NLSTQN: MOVSI T1,-QNMLEN ;SEE HOW LONG THE STRING IS
SKIPE S.QNM(T1) ;LOOK FOR A ZERO
AOBJN T1,.-1 ;LOOP
HRRZS T1 ;ISOLATE LENGTH OF QUEUE NAME STRING
MOVEI T2,ARG.DA(T1) ;LENGTH INCLUDING HEADER STUFF
STORE T2,ARG.HD(P2),AR.LEN ;STORE LENGTH
MOVX T2,.LSQNM ;GET THE BLOCK TYPE
STORE T2,ARG.HD(P2),AR.TYP ;STORE IN MESSAGE BLOCK
MOVEI T2,ARG.DA(P2) ;WHERE TO COPY THE STRING TO
MOVE T3,T2 ;GET A COPY
HRLI T2,S.QNM ;SOURCE ADDRESS
ADDI T3,-1(T1) ;ADD LENGTH -1
BLT T2,(T3) ;COPY THE STRING
INCR .OARGC(M) ;COUNT ANOTHER BLOCK
LOAD T2,.MSTYP(M),MS.CNT ;GET MESSAGE COUNT
ADDI T2,ARG.DA(T1) ;INCLUDE THIS BLOCK
STORE T2,.MSTYP(M),MS.CNT ;UPDATE FOR WHAT WE STORED
ADDI P2,ARG.DA(T1) ;ADVANCE TO NEXT BLOCK
POPJ P, ;RETURN
SUBTTL LSTOPN Listing routines - Open the listing file
LSTOPN: MOVE I,I.INZR ;START WITH FIRST REQUEST
MOVSI T3,B.LC ;POINT TO BUFFER HEADERS
MOVEM T3,L.OPEN+2 ;STORE IN OPEN BLOCK
MOVEI T3,LN$ENT-1 ;SET LENGTH OF BLOCK
IORM T3,L.LOOK ; INTO LOOKUP BLOCK
MOVS T3,L.OPEN+1 ;GET OUTPUT DEVICE
MOVE N,O.DEV ;GET DEVICE NAME IN CASE THIS FAILS
CAIE T3,'TTY' ;IF TTY:
TLNE F,L.LOGI ; OR LOGGED IN,
JRST LSTO.1 ;THEN OK TO LIST
TLNE F,L.NSBJ ;ARE WE LOGGED IN AT TOP LEVEL?
N$FATE <LTL>,<N>,<You must LOGIN to list on device >
LSTO.1: OPEN LC,L.OPEN ;INIT THE DEVICE
N$FATE <LOF>,<N>,<Listing OPEN failure on device >
ENTER LC,L.LOOK ;ENTER FILE
JRST E.OEFE ;ERROR
OUTBUF LC,0 ;BUILD BUFFERS BEFORE WE MANGLE CORE
MOVEI T1,L.PATH ;POINT TO LISTING PATH BLOCK
MOVEM T1,L.LOOK+.RBPPN ;STORE FOR FILESPEC TYPEOUT
MOVEI T1,LC ;GET THE CHANNEL NUMBER
DEVCHR T1, ;GET DEVICE CHARACTERISTICS
TXNE T1,DV.TTY ;SEE IF LINE MODE OUTPUT DEVICE
TRO F,R.OUTL ;YES--SET FLAG TO FORCE OUT EACH LINE
TLC T1,-1-<(DV.TTA)> ;SEE IF NUL:
TLCN T1,-1-<(DV.TTA)> ; ..
JRST LSTDEV ;IT IS - HANDLE NON-DIRECTORY DEVICE
TXNE T1,DV.TTA ;CONTROLLING TTY ?
POPJ P, ;YES - THEN DON'T OUTPUT A MESSAGE
TXNE T1,DV.MTA ;A MAGTAPE ?
JRST LSTMTA ;YES
TXNE T1,DV.DSK ;A DISK ?
JRST LSTDSK ;YES
TXNE T1,DV.DIR ;DIRECTORY DEVICE ?
JRST LSTDIR ;YES - HANDLE DIFFERENTLY
JRST LSTDEV ;MUST BE A RANDOM DEVICE
SUBTTL LSTMTA Listing routines - Type out listing filespec
LSTMTA: MOVE T1,[3,,T2] ;SET UP AC
MOVX T2,.TFDEN+.TFSET ;FUNCTION CODE
MOVEI T3,LC ;LOAD CHANNEL NUMBER
LOAD T4,O.MOD,FX.DEN ;GET DENSITY
TAPOP. T1, ;SET IT
JFCL ;IGNORE ERRORS
MOVE T1,[3,,T2] ;SET UP AC
MOVX T2,.TFPAR+.TFSET ;LOAD FUNCTION CODE
MOVEI T3,LC ;LOAD CHANNEL NUMBER
LOAD T4,O.MOD,FX.PAR ;GET PARITY BIT
TAPOP. T1, ;SET ODD OR EVEN PARITY
JFCL ;IGNORE ERRORS
N$INFO <QLF>,<N>,<Queue listing on file>
MOVEI T1,LC ;GET CHANNEL NUMBER
DEVNAM T1, ;WANT THE REAL NAME
MOVE T1,L.OPEN+.OPDEV ;ASSUME NAME FROM OPEN BLOCK
PUSHJ P,.TSIXN## ;TYPE IT
PUSHJ P,.TCOLN## ;TYPE COLON
MOVEI T1,[ASCIZ |, density = |]
PUSHJ P,.TSTRG## ;TYPE TEXT
MOVE T1,[3,,T2] ;SET UP AC
MOVX T2,.TFDEN ;FUNCTION CODE
MOVEI T3,LC ;LOAD CHANNEL NUMBER
TAPOP. T1, ;READ DENSITY
MOVEI T1,0 ;CAN'T - ASSUME DEFAULT
CAILE T1,DENMAX ;GREATER THAN HIGHEST KNOWN DENSITY ?
MOVX T1,-1 ;UNKNOWN
MOVE T1,DENTAB(T1) ;PICK UP DENSITY TEXT
PUSHJ P,.TSTRG## ;TYPE IT
JRST LSTEND ;GO TO COMMON ENDING
; DENSITY TABLE
;
[ASCIZ |Unknown|]
DENTAB: [ASCIZ |Default|]
[ASCIZ |200|]
[ASCIZ |556|]
[ASCIZ |800|]
[ASCIZ |1600|]
[ASCIZ |6250|]
DENMAX==.-DENTAB
LSTDEV: N$INFO <QLF>,<N>,<Queue listing on file>
MOVEI T1,LC ;GET CHANNEL NUMBER
DEVNAM T1, ;WANT THE REAL NAME
MOVE T1,L.OPEN+.OPDEV ;ASSUME NAME FROM OPEN BLOCK
PUSHJ P,.TSIXN## ;TYPE IT
PUSHJ P,.TCOLN## ;TYPE COLON
JRST LSTEND ;GO TO COMMON ENDING
LSTDSK: MOVEI T1,LC ;GET CHANNEL NUMBER
MOVEM T1,L.PATH ;STORE IT
MOVEM T1,L.DSKC ;STORE IN DSKCHR BLOCK TOO
MOVE T1,[.PTMAX,,L.PATH] ;SET UP CALL
PATH. T1, ;READ PATH OF CHANNEL
JFCL ;IGNORE ERRORS
MOVE T1,[LN$DSK,,L.DSKC] ;SET UP DSKCHR UUO
DSKCHR T1, ;SEE WHAT THE DEVICE REALLY IS
SKIPA T1,L.OPEN+.OPDEV ;CAN'T
SKIPE T1,L.DSKC+.DCSNM ;GET STRUCTURE NAME (GUARD AGAINST NUL:)
MOVEM T1,L.OPEN+.OPDEV ;STORE IT
;FALL INTO LSTDIR
LSTDIR: N$INFO <QLF>,<N>,<Queue listing on file>
MOVEI T1,L.OPEN ;POINT TO THE OPEN BLOCK
MOVEI T2,L.LOOK ;POINT TO THE ENTER BLOCK
PUSHJ P,.TOLEB## ;TYPE FILESPEC
LSTEND: PUSHJ P,FINFO2 ;CLOSE OFF THE MESSAGE
PUSHJ P,LSTHDR ;TYPE LISTING HEADER
POPJ P, ;RETURN
SUBTTL LSTHDR Listing routines - Header generation
LSTHDR: MOVEI T1,LSTCHR ;GET OUT ROUTINE TO PUT A CHARACTER
PUSHJ P,.TYOCH## ;TELL SCAN ABOUT IT
MOVEM T1,L.OTYO ;REMEMBER THE OLD SETTING
PUSHJ P,.TCRLF## ;NEW LINE
MOVEI T1,[ASCIZ |Listing by QUEUE version |]
PUSHJ P,.TSTRG## ;TYPE HEADER INTRO
MOVE T1,.JBVER ;GET OUT VERSION NUMBER
PUSHJ P,.TVERW## ;TYPE IT
MOVEI T1,[ASCIZ | on |] ;SEPERATOR
PUSHJ P,.TSTRG## ;TYPE INTRO
PUSHJ P,.TDATN## ;TYPE THE CURRENT DATE
MOVEI T1,[ASCIZ | at |] ;GET SEPERATOR
PUSHJ P,.TSTRG## ;TYPE TEXT
PUSHJ P,.TTIMN## ;TYPE THE CURRENT TIME
PUSHJ P,.TCRLF## ;NEW LINE
PUSHJ P,.TCRLF## ;AND ANOTHER
MOVE T1,L.OTYO ;GET OLD TYPE OUT ROUTINE
PUSHJ P,.TYOCH## ;TELL SCAN
POPJ P, ;RETURN
SUBTTL LSTTYO Listing routines - Output the list answer
LSTTYO: MOVEI T1,.OHDRS(M) ;POINT TO THE FIRST MESSAGE BLOCK.
LOAD T2,ARG.HD(T1),AR.LEN ;GET THE BLOCK LENGTH.
SOSLE .OARGC(M) ;CHECK THE ARGUMENT COUNT.
ADD T1,T2 ;IF 2 BLOCKS,,GET 2ND BLOCK ADDRESS.
MOVEI T1,ARG.DA(T1) ;GET ADDRESS OF STRING
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM T1,L.PNTR ;STORE BYTE POINTER
LSTT.1: ILDB T1,L.PNTR ;GET A CHARACTER
PUSHJ P,LSTCHR ;PUT A CHARACTER
JUMPE T1,.POPJ## ;DONE IF WE ENCOUNTER A <NUL>
CAILE T1,.CHFFD ;END OF LINE ?
JRST LSTT.1 ;NO - CONTINUE
TRNE F,R.OUTL ;OUTPUT ON EVERY LINE ?
PUSHJ P,LSTC.1 ;YES - DO IT NOW
JRST LSTT.1 ;LOOP BACK FOR MORE CHARACTERS
POPJ P, ;RETURN.
LSTCHR: SOSG B.LC+.BFCNT ;ROOM IN THE BUFFER ?
PUSHJ P,LSTC.1 ;BUFFER FULL - WRITE IT OUT
IDPB T1,B.LC+.BFPTR ;PUT A CHARACTER
POPJ P, ;RETURN
LSTC.1: OUT LC, ;OUTPUT BUFFER
POPJ P, ;NO ERRORS - RETURN
PUSHJ P,.PSH4T## ;SAVE T3 - P2 (T1,T2,T3,T4)
GETSTS LC,L.STAT ;GET CHANNEL STATUS
MOVE T3,L.STAT ;PREPARE TO CLEAR
TXZ T3,IO.ERR ; BY PRESERVING JUST
SETSTS LC,(T3) ; THE CONTROL BITS
N$WARN <LDE>,<N>,<Listing device output error, status =>
HRLZ T2,L.STAT ;GET STATUS IN LH OF T2
MOVEI T3,6 ;SET UP COUNTER
LSTC.2: LSHC T1,3 ;SHIFT IN A DIGIT
ANDI T1,7 ;NO JUNK
ADDI T1,"0" ;MAKE IT ASCII
PUSHJ P,.TCHAR## ;TYPE IT
SOJG T3,LSTC.2 ;LOOP FOR ANOTHER
PUSHJ P,.TCRLF## ;NEW LINE
PUSHJ P,.POP4T## ;RESTORE T3 - P2 (T1,T2,T3,T4)
POPJ P, ;BACK FOR MORE CHARACTERS
SUBTTL NDEFER New DEFER & ZDEFER Routine
NDEFER: MOVE T1,I.INZR ;GET POINTER TO FIRST INPUT SPEC
SKIPE .FXNMM(T1) ;CHECK MASK FOR * OR ?????? TYPED
N$FATE<CDF>,,<Cannot /DEFER specific files>
ADDI T1,I.LZER ;POINT TO NEXT
CAMGE T1,I.NXZR ;WAS ONLY ONE SPEC SPEFICIED
N$FATE<TDR>,,<Too may deferred requests>
;SET UP THE TEMP AND MESSAGE AREAS
;
PUSH P,.JBFF## ;SAVE ORIGINAL .JBFF
PUSHJ P,MSETUP ;GET MEMORY ETC FOR MESSAGE
;DEFER MESSAGE HEADER
;
MOVX T1,<INSVL.(DFR.SZ,MS.CNT)!INSVL.(.QODFR,MS.TYP)>
MOVEM T1,.MSTYP(M) ;STORE MESSAGE AND LENGTH
MOVX T1,MF.ACK ;SET FOR ACKNOWLEDGEMENT
MOVEM T1,.MSFLG(M) ;
MOVE T2,S.OPN ;GET THE OPERATION SPECIFIED
SETOM S.OPN ;RESET THE OPERATION FIELD
SETOM T1, ;CLEAR T1
CAIN T2,.QORCR ;/CREATE?
MOVEI T1,.DFREL ;YES, PASS DEFER FUNCTION
CAIN T2,.QORKL ;/KILL?
MOVEI T1,.DFKIL ;PASS /ZDEFER
SKIPGE T1 ;MUST BE ONE OR THE OTHER
N$FATE<DMI>,,</DEFER request must include /CREATE or /KILL> ;NO
STORE T1,DFR.JB(M),DF.FNC ;YES, STORE THE DEFER FUNCTION
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
PJOB T1, ;FOR THIS JOB NUMBER
STORE T1,DFR.JB(M),DF.JOB ;STORE THE JOB NUMBER
SKIPE N,O.DEV ;DID HE TYPE A DEVICE?
PUSHJ P,XPNQUE ;YES, EXPAND IT
MOVEM N,O.DEV ;AND STORE IT BACK
MOVS T1,COMDEV ;GET COMMAND-DEVICE
CAIN T1,'LP ' ;DID HE SAY .QUEUE?
SETZM COMDEV ;YES, NO SPECIAL DEVICE
SKIPN T1,O.DEV ;GET SPECIFIED DEVICE
MOVE T1,COMDEV ;NONE THERE, USE COMMAND-DEVICE
MOVEM T1,O.DEV ;SAVE DEVICE IN O.DEV
SKIPE T3,O.DEV ;SKIP IF HE WANTS ALL QUEUES
PUSHJ P,GETOBJ ;GET THE OBJECT
MOVEM T3,DFR.OT(M) ;STORE THE OBJECT
PUSHJ P,MSGSND ;SEND OFF THE MESSAGE
PUSHJ P,RCVACK ;GET ACKNOWLEDGEMENT
PJRST CMDXIT ;USE THE NORMAL EXIT
SUBTTL CMDXIT Return Routine
CMDXIT: POP P,.JBFF## ;RESTORE ORIGINAL .JBFF
MOVE T3,.JBFF## ;GET THE VALUE
SUBI T3,1 ;BACK OFF FOR THE CORE UUO
CORE T3, ;GIVE SOME BACK
JFCL ;NICE TRY
POPJ P, ;RETURN FOR NEXT COMMAND
RESCOR: MOVE T3,-1(P) ;.JBFF IS DOWN ON THE STACK
MOVEM T3,.JBFF## ;RESET IT
SUBI T3,1 ;BACK OFF FOR THE CORE UUO
CORE T3, ;GIVE SOME BACK
JFCL ;NICE TRY
POPJ P, ;RETURN TO CALLER
SUBTTL MSETUP Subroutine to Setup Temp and Message Areas
MSETUP: PUSHJ P,QUEFLS ;FLUSH THE RECEIVE QUEUE FIRST
PUSHJ P,GQPID ;GET QUASAR'S PID
PUSHJ P,BLDACK ;GO BUILD AN ACK CODE
SETZM FSTMSG ;CLEAR ADDRESS OF FIRST MESSAGE
SETZM NUMANS ;AND NUMBER OF CREATES TO SEND
;GET AND CLEAR PAGE FOR MESSAGE
;
MSUP.1: MOVE M,.JBFF## ;CREATE MESSAGES ARE PAGE MODE SO
MOVEI M,PAGSIZ-1(M) ;ALIGN .JBFF ON A PAGE BOUNDRY
TRZ M,PAGSIZ-1 ;MAKE IT SO
MOVEM M,.JBFF## ;FAKE OUT CORGET
SOS .JBFF ;BACK OFF BY ONE
GCORE PAGSIZ ;GET A PAGE FOR IT
SETZM (M) ;CLEAR THE NEW MESSAGE FIRST
HRLI T1,(M) ;SET UP FOR EVENTUAL BLT
HRRI T1,1(M) ;DESTINATION
BLT T1,PAGSIZ-1(M) ;GET IT ALL
SKIPN FSTMSG ;THIS THE FIRST ONE
MOVEM M,FSTMSG ;YES, SAVE ITS ADDRESS
INCR NUMANS ;ACCOUNT FOR IT
POPJ P, ;AND RETURN
SUBTTL QUEFLS Subroutines to Flush the IPCF Receive Queue
QUEFLS: PUSHJ P,QUEQRY ;QUERY THE QUEUE
JUMPE T2,.POPJ## ;RETURN WHEN EMPTY
PUSHJ P,QUEIGN ;IGNORE THE ENTRY
JRST QUEFLS ;AND KEEP GOING
QUEQRY: SETZB T3,T4 ;CLEAR QUERY BLOCK
SETZB P1,P2 ;FOR GOOD MEASURE
MOVE T2,[4,,T3] ;LENGTH,,ARGUMENTS
IPCFQ. T2, ;FIND OUT WHATS THERE
SETZM P2 ;NOTHING, CLEAR P2
MOVE T2,P2 ;COPY QUEUE STATUS INTO T2
JUMPE T2,.POPJ## ;RETURN IF NOTHING THERE
SKIPE DEBUGW ;IF DEBUGGING,
CAME T4,INFPID ;COULD BE FROM INFO
CAMN T4,QSRPID ;FROM QUASAR
POPJ P, ;YES, RETURN NOW
PUSHJ P,QUEIGN ;FLUSH THE JUNK MAIL
JRST QUEQRY ;LOOK AGAIN
QUEIGN: ANDX T3,IP.CFV ;CLEAR ALL BUT PAGE MODE BIT
TXO T3,IP.CFT ;SET TO TRUNCATE
SETZB T4,P1 ;CLEAR THEM AGAIN
MOVEI P2,1 ;LENGTH = 0 , LOC = 1
MOVE T2,[4,,T3] ;SET UP LENGTH AND BLOCK ADDRESS
IPCFR. T2, ;THROW AWAY THE MESSAGE
N$FATE<CFR>,,<Cannot flush the IPCF receive queue>
POPJ P, ;RETURN
QUEWAT: PUSHJ P,QUEQRY ;FIND OUT WHATS THERE
JUMPN T2,.POPJ## ;SOMETHING, RETURN
MOVX T2,HB.IPC ;WAKE ON IPCF PACKET AVAILABLE
HIBER T2, ;WAIT FOR A REASONABLE TIME
JFCL ;WATCH THIS LOOP
JRST QUEWAT ;TRY NOW
SUBTTL GQPID Get the PID for QUASAR
GQPID: SKIPN DEBUGW ;ARE WE DEBUGGING?
JRST GQPI.1 ;NO, USE SYSTEM-QUASAR
PUSHJ P,MAKNAM ;MAKE UP NAME TO LOOK FOR
MOVE P2,T1 ;LENGTH AND POSITION OF PACKET
MOVX T1,SP.INF ;GET PID FOR SYSTEM-INFO
PUSHJ P,FPID ;
JUMPE T1,GQPI.1 ;IF NO INFO, GIVE UP
MOVE P1,T1 ;REMEMBER THE PID
MOVEM P1,INFPID ;
SETZB T3,T4 ;NO FLAGS, CLEAR PID
PUSHJ P,MSGGO ;SEND THE MESSAGE TO INFO
PUSHJ P,RCVACK ;WAIT FOR REPLY
LOAD T1,T3,IP.CFE ;CHECK FOR ERRORS
JUMPN T1,GQPI.1 ;
OUTSTR [ASCIZ /% Connecting to /]
OUTSTR SHTMSG+.IPCI2
PUSHJ P,TTCRLF ;ADD CRLF
MOVE T1,SHTMSG+.IPCI1 ;GET PRIVATE QUASAR'S PID
GQPI.4: MOVEM T1,QSRPID ;STORE THE PID
POPJ P, ;THEN RETURN
GQPI.1: SETOM T3 ;FLAG FOR FIRST TIME
GQPI.2: MOVX T1,SP.QSR ;PID OF QUASAR
PUSHJ P,FPID ;LOOK IT UP
JUMPN T1,GQPI.4 ;IF WE GOT THE PID , RETURN NOW
AOJN T3,GQPI.3 ;FIRST TIME IT FAILED?
N$WARN <WFQ>,,<Waiting for [SYSTEM]QUASAR to start>
GQPI.3: MOVEI T1,3 ;WAIT FOR 3 SECONDS
SLEEP T1, ;SLEEP FOR SPECIFIED TIME
JRST GQPI.2 ;AND TRY AGAIN
;GET PID FOR SYSTEM-INFO
;
FPID: HRLI T1,.GTSID ;WANT FROM SYSTEM PID TABLE
MOVSS T1
GETTAB T1, ;ASK FOR IT
SETZM T1 ;IF IT FAILS,
POPJ P, ;AND RETURN
SUBTTL BLDACK Build ACK Code Subroutine
;ACK CODE STORED IN ACKCOD
;
BLDACK: SETZM ACKCOD ;CLEAR TARGET
PJOB T1, ;GET OUR JOB NUMBER
STORE T1,ACKCOD,ACK.JB ;PUT IN PROPER PLACE
MOVX T1,%CNDTM ;GET UDT
GETTAB T1, ;ASK THE MONITOR
SETZM T1 ;OH WELL
STORE T1,ACKCOD,ACK.UT ;STORE IN UDT FIELD OF CODE
POPJ P, ;RETURN
SUBTTL GETOBJ Subroutine to Convert Device to an Object Type
;DEVICE NAME IN O.DEV, RETURN WITH T3 CONTAINING OBJECT
;
GETOBJ: HLLZ T3,O.DEV ;GET GENERIC DEVICE
MOVSI T4,-NDEVS ;MAKE AN AOBJN POINTER
GETO.1: CAMN T3,DEVTAB(T4) ;DO A COMPARE
JRST GETO.2 ;WIN
AOBJN T4,GETO.1 ;LOOP
JRST E.NOQS ;LOSE
GETO.2: MOVE T3,OBJTAB(T4) ;GET THE OBJECT
POPJ P, ;AND RETURN
SUBTTL MSGSND Subroutine to Send a Message to QUASAR
MSGSND: MOVE P1,QSRPID ;GET QUASAR'S PID
SETOM RTYCNT ;INIT RETRY COUNTER
MOVE T3,ACKCOD ;GET ACK CODE
MOVEM T3,.MSCOD(M) ;PUT IN MESSAGE HEADER
SETZB T3,T4 ;CLEAR FLAGS,MY PID
MOVEI P2,(M) ;MESSAGE ADDRESS, P1 = QSRPID
LOAD T2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
MOVEM T2,MSGTYP ;SAVE IT FOR REFERENCE LATER
LOAD T2,.MSTYP(M),MS.CNT ;GET THE LENGTH OF THE MESSAGE
TXNN M,1B0 ;IS THIS A PAGE MODE REQUEST
JRST MSGGO1 ;NO, SEND IT
MOVX T3,IP.CFV ;INDICATE A PAGE SEND
LSH P2,-^D9 ;CONVERT 'M' TO A PAGE NUMBER
MOVEI T2,PAGSIZ ;LENGTH MUST BE 1000
MSGGO1: HRL P2,T2 ;INCLUDE CORRECT SIZE IN HEADER
MSGGO: MOVE T2,[4,,T3] ;ARGUMENT FOR SEND
IPCFS. T2, ;SEND THE MESSAGE
SKIPA ;FAILED, SEE WHY
POPJ P, ;RETURN TO CALLER
CAIE T2,IPCDD% ;QUASAR DISABLED
CAIN T2,IPCRS% ;OR MY QUOTA EXHAUSTED
JRST RETRY ;YES, TRY IT AGAIN
CAIE T2,IPCRR% ;QUASAR FULL
CAIN T2,IPCRY% ;OR SYSTEM FULL
JRST RETRY ;YES, TRY IT AGAIN
N$FATE <SQF>,,<Send to [SYSTEM]QUASAR failed>
RETRY: MOVEI T2,2 ;WAIT BEFORE TRYING AGAIN
SLEEP T2, ;TAKE A QUICK NAP
AOSN RTYCNT ;COUNT THE RETRIES
N$WARN <MBR>,,<Send to [SYSTEM]QUASAR has failed, message being re-sent>
JRST MSGGO ;NOW RETRY IT
SUBTTL RCVACK Subroutine to Receive an Expected "ACK" from QUASAR
; RVCACK RETURNS CALLER AFTER RECEIVING A"GOOD" ONE,
; ISSUES AN ERROR MESSAGE AND QUITS ON A "BADDY"
;
RCVACK: MOVEI M,SHTMSG ;AREA FOR SHORT RECEIVE
PUSHJ P,QUEWAT ;WAIT FOR A RETURNED MESSAGE
ANDX T3,IP.CFV ;CLEAR ALL BUT THE PAGE MODE BIT
SETZB T4,P1 ;CLEAR THESE AGAIN
HRRI P2,(M) ;WHERE TO RECEIVE INTO
TXNN T3,IP.CFV ;IS IT A PAGE
JRST RCVA.1 ;NO, GO GET IT
MOVE M,.JBREL## ;GET A PAGE TO RECEIVE INTO
MOVEI M,PAGSIZ-1(M) ;ROUND UP
ADR2PG M ;CONVERT TO PAGE NUMBER
HRRI P2,(M) ;SET THE ADDRESS
HRLI P2,PAGSIZ ;LENGTH OF A PAGE
PG2ADR M ;STILL NEED TO POINT TO IT
RCVA.1: MOVE T2,[4,,T3] ;READY TO GET IT
IPCFR. T2, ;GET THE ACK FROM QUASAR
SKIPA ;CAN'T
JRST RCVA.A ;ENTER COMMON CODE
CAXN T2,IPCUP% ;OUT OF CORE ?
N$FATE<NEC>,,<Not enough core to receive acknowledgement>
N$FATE<ARF>,,<Acknowledgement receive failed>
RCVA.A: SKIPN DEBUGW ;DEBUGGING?
JRST RCVA.0 ;NO
MOVE T2,.IPCI0(M) ;GET POSSIBLE CODE WORD
CAMN T2,[MAKNAM,,.IPCIW] ;AND CHECK IT
POPJ P, ;RETURN NOW ON A MATCH
RCVA.0: MOVE T2,ACKCOD ;GET ACK CODE WE'RE EXPECTING
CAME T2,.MSCOD(M) ;IS IT?
JRST RCVACK ;NO, IGNORE IT
LOAD T2,.MSFLG(M) ;GET THE MESSAGE STATUS WORD
LOAD T1,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
CAIN T1,MT.TXT ;IS IT A TEXT MESSAGE?
JRST RCVA.4 ;YES--TYPE IT NOW
TXNE T2,MF.NOM ;NORMAL "ACK" (NO MESSAGE ASSOCIATED)
JRST RCVA.3 ;YES, SEE IF IT IS TIME TO RETURN
TXNE T2,MF.MOR ;FIRST OF MANY
JRST RCVACK ;NO, THROW THIS AWAY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
RCVA.4: TXNN T2,MF.FAT!MF.WRN ;FATAL OR WARNING
JRST RCVA.2 ;NEITHER
MOVEI T3,"?" ;FATAL CHARACTER
TXNN T2,MF.FAT ;WAS IT FATAL?
MOVEI T3,"%" ;NO, LOAD WARNING CHARACTER
OUTCHR T3 ;OUTPUT THE "?" OR "%"
LOAD T3,.MSFLG(M),MF.SUF ;GET THE MESSAGE SUFFIX
JUMPE T3,RCVA.2 ;DONT OUTPUT A PREFIX IF NULL SUFFIX
OUTSTR [ASCIZ/QSR/] ;OUTPUT "QUASAR" PREFIX
HRLZS T3 ;PUT SUFFIX IN LH FOR TTYSIX
PUSHJ P,TTYSIX ;OUTPUT THE FULL ERROR CODE
MOVEI T3," " ;GET ALIGNMENT CHARACTER
OUTCHR T3 ;MAKE THE OUTPUT PRETTY
RCVA.2: MOVEI T1,.OHDRS(M) ;POINT TO 1ST MESSAGE BLOCK
LOAD T3,ARG.HD(T1),AR.LEN ;GET LENGTH
SOSLE .OARGC(M) ;CHECK THE ARGUMENT COUNT
ADD T1,T3 ;IF 2 BLOCKS, POINT TO 2ND
OUTSTR ARG.DA(T1) ;AND FINALLY, OUTPUT THE MESSAGE
TXNE T2,MF.FAT ;AGAIN, WAS IT FATAL
JRST RCVA.5 ;YES, QUIT NOW
TXNE T2,MF.WRN ;OR WARNING?
JRST RCVA.5 ;YES, QUIT AS WELL
RCVA.3: TXNE T2,MF.MOR ;IS THE 'MORE' FLAG LIT?
JRST RCVACK ;YES, GO GET ANOTHER MESSAGE
MOVE T1,MSGTYP ;GET THE STORED MESSAGE TYPE
CAIE T1,.QOLIS ;WAS IT A LISTING?
POPJ P, ;NO - LEAVE
MOVE T1,.OFLAG(M) ;YES - GET THE OTHER FLAGS
TXNE T1,WT.MOR ;MORE COMING
JRST RCVACK ;YES, DO THIS ALL OVER AGAIN
POPJ P, ;CONTINUE PROCESSING
RCVA.5: PUSHJ P,.MONRT## ;EXIT AFTER THE OUTPUT
N$FATE<CNC>,,<Can't CONTINUE -- try REENTER>
;TTY OUTPUT SUBROUTINES
;
TTCRLF: OUTSTR [BYTE (7) .CHCRT, .CHLFD, 0]
POPJ P,
TTYSIX: MOVE T4,[POINT 6,T3] ;THE INITIAL BYTE POINTER
TYSIX1: ILDB P1,T4 ;GET A CHARACTER
JUMPE P1,.POPJ## ;STOP AT A NULL (BLANK)
ADDI P1," " ;ASCII-IZE IT
OUTCHR P1 ;DUMP IT OUT
TLNE T4,770000 ;END OF THE WORD
JRST TYSIX1 ;NO, GET ANOTHER
POPJ P, ;ALL DONE
SUBTTL MAKNAM Subroutine to Make Up the Packet to Send to INFO
;LOOK FOR [USER-NAME]QUASAR
;
MAKNAM: PUSH P,T3 ;SAVE SOME REGS
PUSH P,T4 ;
SKIPL T2,DEBUGW ;GET AND CHECK DEBUGW
TLNN T2,377777 ;IF SET ASSUME WE GOT A PPN IN THERE
GETPPN T2, ;GET THE PPN
JFCL ;INFAMOUS SKIP RETURN
MOVEI T1,SHTMSG+1 ;AREA TO CLEAR
HRLI T1,-1(T1) ;BLT POINTER
SETZM SHTMSG ;
BLT T1,SHTMSG+PAGSIZ-1 ;CLEAR IT
MOVE T1,[MAKNAM,,.IPCIW] ;GET INFO FUNCTION
MOVEM T1,SHTMSG+.IPCI0 ;STORE IT
SETZM SHTMSG+.IPCI1 ;NO ONE TO COPY
MOVEI T1,SHTMSG+.IPCI2 ;GET LOCATION TO PUT NAME INTO
HRLI T1,(POINT 7,) ;MAKE IT A POINTER
MOVEI T3,"[" ;OPEN BRACKET
IDPB T3,T1 ;STORED
PUSH P,T2 ;SAVE THE PPN
HLRZ T3,T2 ;GET THE PROJ NUMBER
PUSHJ P,OCTNAM ;OUTPUT IT
MOVEI T2,"," ;SEPARATING COMMA
IDPB T2,T1 ;STORE IT
POP P,T3 ;RESTORE THE PPN
ANDI T3,-1 ;ONLY PROG NUMBER
PUSHJ P,OCTNAM ;ADD TO THE NAME
MOVE T3,[POINT 7,[ASCIZ /]QUASAR/]] ;END OF NAME
MAKN.1: ILDB T4,T3 ;GET A BYTE
IDPB T4,T1 ;STORE THE BYTE
JUMPN T4,MAKN.1 ;REPEAT , INCLUDING NULL
HRRZS T1 ;ISOLATE THE ADDRESS
SUBI T1,SHTMSG-1 ;GET LENGTH
HRLI T1,SHTMSG ;WHERE THE PACKET STARTS
MOVSS T1 ;GET LEN,,ADDR
POP P,T4 ;RESTORE ACS USED
POP P,T3
POPJ P, ;AND RETURN
OCTNAM: IDIVI T3,8 ;OCTAL DIVIDE ROUTINE
HRLM T4,0(P) ;USUAL ROUTINE
SKIPE T3 ;DONE?
PUSHJ P,OCTNAM ;NO GO AGAIN
HLRZ T3,0(P) ;GET A DIGIT
ADDI T3,"0" ;ASCII-IZE IT
IDPB T3,T1 ;STORE IT
POPJ P, ;AND RETURN
SUBTTL DFDEST and DFPROC Routines
;DFDEST - DEFAULT /DEST TO USER LOCATION
;
DFDEST: MOVE T3,S.DEST ;GET /DEST FROM USER
CAME T3,[-1] ;SEE IF DEFAULT NEEDED
POPJ P, ;NO--RETURN
MOVSI T3,'OPR' ;YES--FIND HIS LOGICAL OPR
WHERE T3, ;ASK MONITOR
SETOM T3 ;NO NETWORK SUPPORT
MOVEM T3,S.DEST ;STORE /DEST
POPJ P, ;AND RETURN
;DFPROC - DEFAULT /PROC TO CENTRAL SITE
;
DFPROC: MOVE T3,S.PROC ;GET /PROC FROM USER
CAME T3,[-1] ;SEE IF DEFAULT NEEDED
POPJ P, ;NO--RETURN
MOVSI T3,'CTY' ;YES--FIND HIS CENTRAL SITE
WHERE T3, ;ASK MONITOR
SETOM T3 ;NO NETWORK SUPPORT
MOVEM T3,S.PROC ;STORE /PROC
POPJ P, ;AND RETURN
SUBTTL SETNOD Routine to Convert/Default a node Name/Number
SETNOD: CAME T1,[-1] ;DID WE DEFAULT IT TO -1.
TLNN T1,600000 ; OR IS THE NUMBER BINARY ???
POPJ P, ;YES,,RETURN NOW.
MOVE T4,T1 ;SAVE THE NODE NAME/NUMBER
SETZM T2 ;ZERO A WORK AC
ROTC T1,6 ;GET 6 BITS IN T2
CAIGE T2,'0' ;IS IT A NUMBER ???
JRST SETN.4 ;NO,,SEND THE GUY AN ERROR MSG
CAILE T2,'7' ;IS IT OCTAL ???
JRST SETN.3 ;NO,,GO CHECK FOR ALPHA
SETZM T4 ;ZERO ANOTHER WORK AC
SETN.1: SUBI T2,'0' ;MAKE THE NUMBER BINARY
LSH T4,3 ;MAKE ROOM FOR IT IN T4
ADD T4,T2 ;ADD IT IN
SETZM T2 ;ZERO THE AC AGAIN
ROTC T1,6 ;GET ANOTHER 6 BITS
JUMPE T2,SETN.2 ;DONE???,,SAVE IT AND RETURN
CAIL T2,'0' ;VALIDATE THE
CAILE T2,'7' ;NUMBER.......
JRST SETN.4 ;NO GOOD,,GEN AN ERROR
JRST SETN.1 ;ELSE CONTINUE ON
SETN.2: SKIPE T1,T4 ;ANY NUMBER YET?
POPJ P, ;YES--RETURN
MOVSI T1,'CTY' ;NO--CONVERT 0
WHERE T1, ;INTO CENTRAL SITE
SETOM T1 ;LOSE
POPJ P, ;AND RETURN
SETN.3: CAIL T2,'A' ;IS IT VALID ALPHA ??
CAILE T2,'Z' ;HERE ALSO
SETN.4: N$FATE <INS>,,<Invalid Node Specified>
SETN.5: SETZM T2 ;ZERO THE WORK AC
ROTC T1,6 ;GET ANOTHER 6 BITS
JUMPE T2,SETN.6 ;NO MORE,,STOP
CAIL T2,'0' ;IS IT LESS THEN 0
CAILE T2,'Z' ;OR GREATER THEN Z
JRST SETN.4 ;YES,,THEN AN ERROR
CAILE T2,'9' ;OR IS IT BETWEEN 9
CAIL T2,'A' ;AND 'A' ???
JRST SETN.5 ;NO,,KEEP ON GOING
JRST SETN.4 ;ELSE THERE IS AN ERROR
SETN.6: MOVEI T3,2 ;GET ARG BLOCK LENGTH
MOVE T1,[XWD .NDRNN,T3] ;NAME TO NUMBER FUNCTION
NODE. T1, ;CONVERT THE NODE NAME
MOVE T1,T4 ;CAN'T -- LET QUASAR DEAL WITH IT
POPJ P, ;RETURN, NODE NUMBER/NAME IN T1
SUBTTL GCORE Subroutine
;GCORE. -- GET CORE STARTING AT .JBFF
;CALL: GCORE N
;RETURN WITH T1=END OF AREA
;
GCORE.: ADDB T1,.JBFF## ;ADVANCE .JBFF THE SPACE
GCORE1: MOVE T1,.JBFF## ;GET NEW CORE SIZE
CAMG T1,.JBREL## ;SEE IF STILL IN CORE
SOJA T1,.POPJ## ;RETURN POINTING TO LAST
CORE T1, ;NO--ASK MONITOR FOR MORE
JRST GCOREE ;IF FAIL
JRST GCORE1 ;IF WON, LOOP BACK TO EXIT
GCOREE: N$FATE <UOC>,,<Unable to obtain additional memory> ;DIE
SUBTTL GTTABS GETTAB Subroutines
;GTTABS IS DRIVEN BY THREE TABLES GENERATED BY THE "TABS" MACRO.
; THE FIRST TABLE CONTAINS THE ARGUMENT TO GETTAB, THE SECOND,
; CONTAINS DEFAULTS TO USE ON FAILURE, AND THE THIRD CONTAINS
; AN INSTRUCTION WHICH IS EXECUTED TO STORE THE RESULTS.
GTTABS: MOVSI T2,-.NMTAB ;MAKE AN AOBJN POINTER
GTTAB1: MOVE T1,GTAB1(T2) ;GET AN ARGUMENT
GETTAB T1, ;DO THE GETTAB
MOVE T1,GTAB2(T2) ;GET THE DEFAULT
XCT GTAB3(T2) ;STORE THE RESULT
AOBJN T2,GTTAB1 ;AND LOOP
POPJ P, ;RETURN WHEN DONE
;THE ARGUMENTS TO THE TABS MACRO ARE:
; 1) ARGUMENT TO GETTAB
; 2) DEFAULT VALUE
; 3) INSTRUCTION TO STORE RESULT
; (NOTE: MACRO EXPANSION GENERATES THE CORRECT AC FIELD
; THEREFORE IT SHOULD BE BLANK IN THE ARGUMENT)
;
DEFINE TABS,<
T <%NSCMX>,<0>,<MOVEM G$CMAX>
T <%CNMMX>,<0>,<MOVEM G$MNMX>
T <-1,,.GTNM1>,<0>,<MOVEM G$NAM1>
T <-1,,.GTNM2>,<0>,<MOVEM G$NAM2>
> ;END DEFINE TABS
;NOW GENERATE THE TABLES
DEFINE T(A,B,C),<
EXP <A>
>
GTAB1: TABS
.NMTAB==.-GTAB1
DEFINE T(A,B,C),<
EXP <B>
>
GTAB2: TABS
DEFINE T(A,B,C),<
EXP <C> + <T1>B12
>
GTAB3: TABS
SUBTTL GTCLIN Command Scanning Subroutines
;GTCLIN -- GET AND CLEAR ONE INPUT FILE PARAMETER STORAGE AREA
;CALL: PUSHJ P,GTCLIN
;RETURNS WITH T1=START OF AREA, T2=LENGTH OF AREA
;USES T3
;
GTCLIN: MOVE T2,.JBFF## ;START AT .JBFF
GCORE I.LZER ;GET ONE AREA
MOVEI T1,1(T1) ;ADVANCE ONE AND
MOVEM T1,I.NXZR ;SAVE NEW END
SETZM (T2) ;CLEAR AREA
HRLZI T3,(T2) ; ..
HRRI T3,1(T2) ; ..
BLT T3,-1(T1) ; ..
SETOM .FXBFR(T2) ;CLEAR FIRST SWITCH (-1 MEANS NONE SPYC)
HRLZI T3,.FXBFR(T2) ;GET ADR,,0
HRRI T3,.FXBFR+1(T2) ;GET ADR,,ADR+1
BLT T3,.FXLEN(T2) ;AND RESET ALL SWITCHES
MOVE T1,T2 ;POSITION RESULT
MOVEI T2,I.LZER ;GET LENGTH
POPJ P, ;RETURN
;HERE TO READ IN SIGNED DECIMAL NUMBER (/DEPENDENCY)
;
DEPSW: PUSHJ P,.TIAUC## ;GET SIGN IF PRESENT
MOVEI T2,0 ;CLEAR FLAGS
CAIN C,"+" ;SEE IF INCREMENT
TRO T2,1B19 ;YES--SET FLAG
CAIN C,"-" ;SEE IF DECREMENT
TRO T2,1B18 ;YES--SET FLAG
TRNE T2,MI.DMT ;SEE IF EITHER SET
PUSHJ P,.TIAUC## ;YES--GET ONE MORE CHARACTER
PUSHJ P,.DECNC## ;GET NUMBER
JUMPL N,E.SVTL ;ERROR IF NEGATIVE
CAIL N,MI.DMT ;MAKE SURE IT'S SMALL ENOUGH
JRST E.SVTL ;NO--GIVE ERROR
IOR N,T2 ;COMBINE FLAGS
PJRST .SWDPB## ;GO STORE RESULT
;HERE WHEN SWITCH VALUE IS A RADIX-60 SPECIFICATION (/TIME)
;
TIMESW: PUSHJ P,RDX60W ;GET RADIX 60 NUMBER
PJRST .SWMAX## ;AND STORE ANSWER
;HERE ON /METERS
;
METESW: PUSHJ P,.SWDEC## ;GET DECIMAL ARGUMENT
PUSH P,N+1 ;SAVE THE AC FOR THE DIVIDE
IMULI N,^D3937 ;CONVERT TO CENTI-INCHES
IDIVI N,^D1200 ;CONVERT TO FEET
POP P,N+1 ;RESTORE N+1
PJRST .SWMAX## ;AND STORE THE ANSWER
;HERE ON /UNIT OR /STREAM SWITCH
;
UNITSW: PUSHJ P,.TIALT## ;GET NEXT CHARACTER
MOVE T1,C ;COPY IT
PUSHJ P,.REEAT## ;AND BACKUP ONE
CAIL C,"0" ;RANGE
CAILE C,"7" ; CHECK
JRST UNITYP ;GO PROCESS UNIT TYPE
PUSHJ P,.SWOCT## ;GET THE SWITCH VALUE
HRLI N,%PHYCL ;MARK AS PHYSICAL DEVICE
MOVEM N,S.ATTR ;SAVE IN ATTRIBUTE WORD
SETZM S.UNTY ;CLEAR OUT POSSIBLE UNIT TYPE
JRST .SWDON## ;RETURN WITHOUT STORE
UNITYP: PUSHJ P,.SIXSW## ;GET SIXBIT QUANTITY
MOVEM N,S.UNTY ;SAVE UNIT TYPE
JRST .SWDON## ;RETURN WITHOUT STORE
;HERE ON /QUEUE SWITCH
;
QNMSW: PUSHJ P,.TIALT## ;PRINT THE PUMP
PUSHJ P,.TICQT## ;CHECK FOR QUOTING
SETZM .NMUL## ;CLEAR ACCUMULATOR
MOVE T1,[.NMUL##,,.NMUL##+1]
BLT T1,.NMUE##
HRROI T1,.T8STR## ;SET ASCII STRING FORMAT
MOVEM T1,.LASWD## ; FOR ERROR PRINTING
MOVE T1,[POINT 8,.NMUL##] ;INITIALIZE BYTE POINTER
QNMSW1: PUSHJ P,.TIMUC## ;MAKE SURE IT'S UPPER CASE
SKIPLE .QUOTE## ;SEE IF IN QUOTED STRING
JRST QNMSW2 ;YES--JUST GO STORE
CAIE C,.CHCNV ;IF SUPERQUOTE
SKIPN .VQUOT## ;OR SUPER-QUOTED
JRST QNMSW2 ;THEN PASS THE CHARACTER
PUSHJ P,.TICAN## ;SEE IF LEGITIMATE ALPHA-NUMERIC
SKIPA ;NO
JRST QNMSW2 ;YES
CAIE C,"$" ;CHECK OTHER LEGAL ONES
CAIN C,"_" ;VAX COMPATIBILITY
JRST QNMSW2 ;GOOD
PJRST .SWDPB## ;GO STORE RESULT
QNMSW2: CAMN T1,[POINT 8,.NMUE##,31] ;SEE IF OVERFLOW
N$FATE <OVF>,,<Input string exceeds the size of input buffer>
IDPB C,T1 ;NO--STORE
PUSHJ P,.TIALT## ;GET NEXT CHARACTER
JRST QNMSW1 ;LOOP BACK TO PROCESS IT
SUBTTL SCAN switch definition macros
SUBTTL QUETYP Identify What Type of QUEUE Has Been Specified
;CALL: PUSHJ P,QUETYP
; RETURNS T1=-1 IF /LIST REQUEST
; 0 IF INP:
; 1+IF OUTPUT QUEUES IN ORDER OF QUEUES MACRO
;
; ALSO RETURNS O.DEV AND QTYPE UPDATED
;USES T2, T3, T4
;
;WARNING: THIS ROUTINE IS CALLED BEFORE AND AFTER THE DEFAULTER, SO
; IT MAY BE LOOKING AT UNDEFAULTED DATA.
;
QUETYP: MOVEI T1,.QORLS ;MAY NEED TO SET /LIST
SKIPL S.LIST ;SEE IF /LIST:VALUE
SKIPLE S.OPN ;YES--SEE IF SOME OTHER OPERATION
JRST .+2 ;YES--DO OTHER ONE
MOVEM T1,S.OPN ;NO--SET /LIST
SETOM T1 ;SET ANSWER IF /LIST
MOVE T2,S.OPN ;GET OPERATION CODE
CAIN T2,.QORLS ;SEE IF /LIST
JRST QUETY1 ;YES, RETURN THE ANSWER
PUSH P,N ;SAVE N
SKIPGE O.MOD ;SEE IF NULL DEVICE
SETZM O.DEV ;YES--CLEAR IT OUT
....==FX.NDV
SKIPN N,O.DEV ;NO--GET OUTPUT DEVICE
SKIPE N,DQTYPE ;USE DEFAULT FROM COMMAND
SKIPA ;OK
MOVSI N,'LPT' ;DEFAULT DEVICE
PUSHJ P,XPNQUE ;EXPAND AND MATCH QUEUE NAME
MOVEM N,O.DEV ;AND STORE IT
POP P,N ;RESTORE NAME
MOVEI T1,(T1) ;CHANGE TO INDEX
SUBI T1,QUENMT ; ..
QUETY1: MOVEM T1,QTYPE ;STORE AWAY THE ANSWER
POPJ P, ;AND RETURN
; QQ PFX,A,B,PRC,HLP,PMT
DEFINE QQ(PFX,A,B,PRC,HLP,PMT),<
IFN QTP'A-<.-QUENMT>,<EXP 0>
IFE QTP'A-<.-QUENMT>,<SIXBIT /A/>
>
QUENMA: SIXBIT /ALL/ ;FOR LISTING ONLY
QUENMT: QUEUES
QUENML==.-QUENMT
SUBTTL XPNQUE Expand QUEUE Name Abbreviation If Any
;CALL: MOVE N,NAME IN SIXBIT AS TYPED IN
; PUSHJ P,XPNQUE
; RETURN WITH UPDATED N
; AND WITH T1 = ADDRESS OF ENTRY
; USES M, T2, T3, T4
;
XPNQUE: MOVS T1,N ;COPY OVER THE ARGUMENT
ANDI T1,777700 ;AND TO FIRST TWO CHARS
CAIE T1,'LL ' ;IS IT LL
CAIN T1,'LU ' ;OR LU?
JRST XPNQU2 ;YES, JUMP
TRNE N,-1 ;IS RIGHT-HALF NULL?
JRST XPNQU1 ;NO, A BIG NAME
MOVE T1,[IOWD QUENML+1,QUENMA]
PUSHJ P,.NAME## ;GET LOOK FOR A MATCH
JRST E.IQN ;ILLEGAL QUEUE NAME
MOVE N,0(T1) ;GET REAL NAME
POPJ P, ;AND RETURN
XPNQU1: PUSH P,N ;SAVE THE ARGUMENT
TRZ N,-1 ;ZAP RH
MOVE T1,[IOWD QUENML+1,QUENMA]
PUSHJ P,.NAME## ;FIND IT
JRST E.IQN ;ILLEGAL QUEUE NAME
POP P,N ;OK, RESTORE REAL NAME
POPJ P, ;AND RETURN
XPNQU2: MOVEI T1,QTPLPT+QUENMT ;LU AND LL ARE LPTS
POPJ P, ;RETURN
SUBTTL ACCTSW Scan ACCOUNT Switch Processing Routine
ACCTSW: PUSHJ P,.SWASQ##
MOVE T3,S.ACCT ;HAS ACCOUNT STRING BEEN SPECIFIED ??
CAME T3,[-1] ;IF -1 THEN ITS OK
POPJ P, ;IF NOT -1 THEN ALREADY SET !!!
SETZM S.ACCT ;RESET THE ACCOUNT FLAG
MOVE T3,[POINT 7,.NMUL##]
MOVE T4,[POINT 7,S.ACCT]
MOVEI P1,^D39 ;MAX # OF CHARACTERS IN ACCT STRING
ACCTS1: ILDB P2,T3 ;GET A BYTE
JUMPE P2,[IDPB P2,T4 ;NULL? STORE IT TO TERMINATE STRING
JRST .POPJ1##] ;NOTE THAT VALIDATION IS DONE LATER
CAIGE P2,176 ;NOT NULL--CHECK FOR ILLEGAL CHARACTERS
CAIGE P2," "
ACCTS2: N$FATE <ICS>,<N>,<Illegal Character Specified in /ACCOUNT Switch: >
IDPB P2,T4 ;STORE THE STRING
SOJGE P1,ACCTS1 ;LOOP IF WE'VE DONE .LT. 40 CHARS
N$FATE <ASL>,,<?QUEASL /ACCOUNT switch string value is too long -- maximum is 39 characters>
;FAIL IF WE HAVE SEEN 40
SUBTTL RDX60W Input Time Subroutines
; Input a time. Legal formats are /TIME:seconds or /TIME:hh:mm:ss
; Call: PUSHJ P,RDX60W
;
; On return, N:= time
;
RDX60W: PUSHJ P,.SAVE2## ;SAVE OUR P1 AND P2
SETZB P1,P2 ;CLEAR COUNTER, RESULT
RDX6.1: PUSHJ P,.DECNW## ;GET A NUMBER
JUMPL N,RDX6.2 ;CHECK FOR ILLEGAL NUMBERS
CAILE N,^D60 ;A REASONABLE NUMBER?
JUMPN P1,RDX6.4 ;NO - MUST HAVE GIVEN TIME IN SECONDS
;(BUT HOURS CAN BE GREATER THAN 60)
IMULI P2,^D60 ;SHIFT SOME
ADDI P2,(N) ;ADD IN FIELD
CAIE C,":" ;FIELD SEPARATOR?
JRST RDX6.3 ;NO - MUST BE END OF TIME SPEC
CAIG P1,2 ;TOO MANY FIELDS?
AOJA P1,RDX6.1 ;NO - GET ANOTHER FIELD
RDX6.2: N$FATE <IFT>,,<Illegal format in time specification>
RDX6.3: MOVE N,P2 ;GET RESULT
POPJ P, ;RETURN
RDX6.4: CAIN C,":" ;FIRST TIME COMPONENT TOO LARGE?
JRST E.TCT ;YES
JUMPE P1,.POPJ## ;LARGE FIRST COMPONENT LEGAL (SECONDS)
N$FATE <TCT>,<D>,<Time component too large: >
SUBTTL Fatal Error Message Routines
;NFMSG -- ISSUE FATAL MESSAGE AND RESTART JOB
; CALLED BY N$FATE MACRO
;
NFMSG: MOVEI T2,.POPJ## ;NULL ROUTINE
JRST NFMSXE ;GO DO THE REST
;NFMSGN -- ISSUE FATAL MESSAGE, TYPE N IN SIXBIT, AND RESTART JOB
; CALLED BY N$FATE MACRO
;
NFMSGN: MOVEI T2,.TSIXN## ;THE ROUTINE TO CALL
JRST NFMSXE ;GO DO THE REST
;NFMSGD -- ISSUE FATAL MESSAGE, TYPE N IN DECIMAL, AND RESTART JOB
; CALLED BY N$FATE MACRO
;
NFMSGD: MOVEI T2,.TDECW## ;THE ROUTINE TO CALL
JRST NFMSXE ;AND GO FINISH UP
;NFMSGO -- ISSUE FATAL MESSAGE, TYPE N IN OCTAL, AND RESTART JOB
; CALLED BY N$FATE MACRO
;
NFMSGO: MOVEI T2,.TOCTW## ;THE OCTAL ROUTINE
;AND FALL INTO NFMSXE
;HERE TO PRINT THE MESSAGE AND CALL THE ROUTINE SETUP ABOVE
;
NFMSXE: PUSH P,T2 ;SAVE T2 FOR LATER
MOVE T2,(T1) ;GET CODE IN T2
MOVEI T1,1(T1) ;GET PC+1 INTO T1
EXCH T1,T2 ;SWAP THEM
HRLI T1,'QUE' ;GET A PREFIX
HRLI T2,"?" ;GET A QUESTION MARK
PUSHJ P,.ERMSG## ;TYPE THE ERROR MESSAGE
; PUSHJ P,.TSPAC## ;TYPE A SPACE
POP P,T2 ;GET THE ROUTINE BACK
MOVE T1,N ;GET THE ARGUMENT
PUSHJ P,(T2) ;CALL IT
NFMSX1: PUSHJ P,.CLRBF## ;CLEAR OUT TYPE AHEAD
PUSHJ P,.TCRLF## ;TYPE A CRLF
PUSHJ P,.TCRLF## ;AND ANOTHER ONE
TXNE F,FL.MCL ;WERE WE RUNNING IN MOUNT MODE?
JRST I%EXIT ;YES - DO NOT RESTART
MOVE P,[IOWD LN$PDL,PDLST] ;NO - RESET PDL
JRST QUELOP ;AND START OVER
SUBTTL Non-fatal Error Message Routines
;WARNING MESSAGES
;
FWARNN: PUSH P,N ;SAVE N
HRLI N,.TSPAC## ;ROUTINE TO CALL
JRST FWARN1 ;AND CONTINUE
FWARN: PUSH P,N ;SAVE N
HRLI N,.TCRLF## ;ROUTINE TO CALL
;AND FALL INTO COMMON CODE
FWARN1: HRR N,-1(P) ;GET ADDRESS OF ARGS
PUSHJ P,.PSH4T## ;SAVE SOME ACS
HLRZ T1,0(N) ;GET CODE
HRLI T1,'QUE' ;FILL IN CONSTANT PART
HRRZ T2,0(N) ;GET ADR OF MESSAGE
HRLI T2,"%" ;GET PREFIX
PUSHJ P,.ERMSG## ;TYPE THE MESSAGE
MOVSS N ;GET ADR OF ROUTINE IN RH
PUSHJ P,(N) ;CALL IT
PUSHJ P,.POP4T## ;RESTORE SOME ACS
POP P,N ;RESTORE N
PJRST .POPJ1## ;AND SKIP BACK OVER ARGS
;INFORMATION
;
FINFON: PUSH P,N ;SAVE N
HRLI N,.TSPAC## ;GET ADDRESS OF ROUTINE
JRST FINFO1 ;AND CONTINUE
FINFO: PUSH P,N ;SAVE N
HRLI N,FINFO2 ;ADDRESS OF ROUTINE
;AND FALL THRU
FINFO1: HRR N,-1(P) ;GET ADDRESS OF ARGS
PUSHJ P,.PSH4T## ;SAVE SOME ACS
HLRZ T1,0(N) ;GET CODE
HRLI T1,'QUE' ;FILL IN CONSTANT PART
HRRZ T2,0(N) ;GET ADR OF MESSAGE
HRLI T2,"[" ;GET PREFIX
PUSHJ P,.ERMSG## ;TYPE THE MESSAGE
MOVSS N ;GET ADR OF ROUTINE IN RH
PUSHJ P,(N) ;CALL IT
PUSHJ P,.POP4T## ;RESTORE SOME ACS
POP P,N ;RESTORE N
PJRST .POPJ1## ;AND SKIP BACK OVER ARGS
FINFO2: MOVEI T1,"]" ;A CLOSE
PUSHJ P,.TCHAR## ;TYPE IT
PJRST .TCRLF## ;TYPE A CRLF AND RETURN
SUBTTL Beginning of MOUNT-Class code section -- miscellaneous routines
;I%EXIT is lifted from GLXLIB - does the right kind of exit
I%EXIT: PUSHJ P,.CLRBF## ;Clear remainder of command line
PJOB S1, ;Get my job number
MOVN S1,S1
JOBSTS S1,
TDZA S1,S1
TXNE S1,JB.ULI ;Am I logged in?
JRST IEXIT ;Yes..then just exit
MOVEI T1,[ASCIZ /.KJOB
./]
PUSHJ P,.TSTRG## ;Output the string
LOGOUT
IEXIT: RESET ;Reset the world
EXIT 1, ;and Leave
MOVEI T1,[ASCIZ /? Can't continue
/]
PUSHJ P,.TSTRG## ;Output an error if we continue
JRST IEXIT ;Loop back
SUBTTL MOUDEF--Set up defaults for MOUNT-class switches
;...because SCAN doesn't...
MOUDEF: SETOM S.NTF ;/NOTIFY
SETOM S.OPN ;/CREATE
SETOM S.CHK ;/CHECK
SETOM S.WAIT ;/WAIT
SETOM S.DISK ;/DISK
SETOM S.TAPE ;/TAPE
SETOM S.ACTIV ;/ACTIVE
SETOM S.PASSIV ;/PASSIVE
SETOM S.LABEL ;/LABEL
SETOM S.TRACKS ;/TRACKS
SETOM S.EXCLU ;/EXCLUSIVE or /SINGLE
SETOM S.SHARE ;/SHARE or /MULTI or /SHARABLE
SETOM S.NEWVOL ;/NEW-VOLUME-SET
SETOM S.SCRATCH ;/SCRATCH
SETOM S.QUOTA ;/QUOTA
SETOM S.READ ;/READ
SETOM S.WRITE ;/WRITE
SETOM S.REMOV ;/REMOVE
SETOM S.ALL ;/ALL
SETOM S.BRIEF ;/BRIEF
SETOM S.FULL ;/FULL
SETOM S.VOLID ;/VOLID
SETOM S.JOB ;/JOBNAME
POPJ P,
SUBTTL MOUNT/ALLOC - Process an Allocate or MOUNT Command
ALLOC: PUSHJ P,.ALLOC ;Parse the command
TXNE F,FL.CHK+FL.LST ; Was /CHECK or implied /LIST specified?
PJRST CHKALC ;Yes..check the allocation
PUSHJ P,MSGSND ;Request the ACK
PUSHJ P,RCVACK ;Recieve it
$RETT
MOUNT: PUSHJ P,.MOUNT ;Parse the command
TXNE F,FL.CHK+FL.LST ; Was /CHECK or implied /LIST specified?
PJRST CHKMNT ;Yes..go check the queues
PUSHJ P,MSGSND ;Send off the request
PUSHJ P,RCVACK ;Get the first ACK
$RETIF ;Return if this fails
TXNE F,FL.WAT ;Want to wait?
PUSHJ P,RCVACK ;Yes..hang around
$RETIF ;Return if this fails
$RETT ;Otherwise, say win
;MOUNT and ALLOCATE commands
;These routines will parse a MOUNT or an ALLOCATE command.
; The parse blocks are built in a page of data supplied by the caller
;Call -
; T1/ Index into the main command table showing whether invoked
; by a MOUNT or an ALLOCATE command.
; The page of data that is used for the message is pre-allocated
; at MSGPAG.
;Return -
; TRUE always.
; If there are ANY errors, these routines pull a $ERR macro
; which JSPs to a caller-defined ERROR label (external from here)
; which should handle the error condition.
.ALLOC::
TDZ F,F ;CLEAR FLAG WORD
TXOA F,FL.MCL ;TURN 'MOUNT-CLASS' BIT BACK ON
.MOUNT::
MOVX F,FL.MCL+FL.MOU+FL.WAT ;Set Mount and Wait flags
;of our message block
MOVE M,.JBFF## ;Set up to get a page
;than 10. words...
MOVEI M,PAGSIZ-1(M) ;ALIGN .JBFF ON A PAGE BOUNDRY
TRZ M,PAGSIZ-1 ;MAKE IT SO
MOVEM M,.JBFF## ;FAKE OUT CORGET
SOS .JBFF ;BACK OFF BY ONE
GCORE PAGSIZ ;GET A PAGE FOR IT
SETZM (M) ;CLEAR THE NEW MESSAGE FIRST
HRLI T1,(M) ;SET UP FOR EVENTUAL BLT
HRRI T1,1(M) ;DESTINATION
BLT T1,PAGSIZ-1(M) ;GET IT ALL
TXO M,1B0 ;Indicate a page send
MOVEI P5,.MMHSZ(M) ;P5 contains first free address
MOVEI S2,.QOMNT ;Get mount message type
STORE S2,.MSTYP(M),MS.TYP ;Save in the message
MOVX S2,MF.ACK ;Get ACK request flag
MOVEM S2,.MSFLG(M) ;Store in message
MOUN04: MOVE P6,P5 ;P6 points to current entry
SETZM S1 ;Initially, no flags
ADDI P5,.MEHSZ ;P5 points to first free word
TXNN F,FL.MOU ;Is this a mount request?
MOVX S1,ME%ALC ;Get the allocate-only bit
MOVEM S1,.MEFLG(P6) ;Stash the flags
SETZM VOLCNT ;Clear the count of VOLIDS
MOUN05: PUSHJ P,PSCAN ;INITIALIZE PARTIAL SCANNER
SKIPN REPARS ;ANYTHING TYPED?
POPJ P, ;JUST /HELP
SKIPG S.WAIT ;/WAIT lit?
JRST MOUN5A ;No - look for other specials
JUMPG C,MOUN06 ;Yes - Don't treat special unless EOL
TXZ F,FL.LST!FL.CHK ;Turn off /LIST and /CHECK
TXO F,FL.WAT ;Turn on /WAIT
JRST MOUN80 ;Wrap up and prepare to send
MOUN5A: SKIPG S.CHK ;/CHECK lit?
JUMPG C,MOUN06 ;No - Go away if we have more keywords
TXO F,FL.LST ;Yes - Default to /LIST if EOL already
MOVEI T1,1 ;ALSO BE SURE TO
MOVEM T1,S.LIST ;LIGHT THE SWITCH BY HAND
POPJ P, ;And return
MOUN06: MOVEM F,DEFSWS ;Save sticky options
SKIPLE S.CHK ;Was /CHECK lit?
JRST MOUN80 ;Yes...Ignore rest of line
PUSHJ P,LGICHK ;CHECK FOR LOGGED-IN JOB
HRROI T1,.GTNM1 ;Get user name
GETTAB T1, ;May I?
SETZ T1, ;I may not..wing it
HRROI T2,.GTNM2 ;Get second half
GETTAB T2, ;May I?
SETZ T2, ;No..
DMOVEM T1,.MMUSR(M) ;Store in message
MOVEI T1,2 ;Get arg count for account
SETO T2, ;My Job
HRROI T3,.MMUAS(M) ;Store in message
MOVE S2,[.ACTRD,,T1] ;Get the account
ACCT. S2,
JFCL
MOUN10: INCR .MMARC(M) ;Increment total message arg count
MOVE F,DEFSWS ;Get default options
MOVE T1,.MMARC(M) ;Get message arg count
CAIG T1,1 ;First time through?
JRST MOUN20 ;Yes
MOUN15: MOVE P6,P5 ;No - P6 points to current entry
SETZM S1 ;Initially, no flags
ADDI P5,.MEHSZ ;P5 points to first free word
TXNN F,FL.MOU ;Is this a mount request?
MOVX S1,ME%ALC ;Get the allocate-only bit
MOVEM S1,.MEFLG(P6) ;Stash the flags
SETZM VOLCNT ;Clear the count of VOLIDS
PUSHJ P,.TIAUC## ;Get a character, since we saw a comma
JUMPLE C,[N$FATE(<NVS>,,<Volume set name must be specified>)]
SETZM VOLSHD ;Clear the volume-set header
SETZM VOLSET ;Clear the volume-set holders
HRLI T1,VOLSET ;Set up source
HRRI T1,VOLSET+1 ;Destination
BLT T1,VOLIDS-1 ;Zero them
MOUN20: PUSHJ P,.ASCQC## ;Get a VSN
MOVE S1,[XWD .NMUL##,VOLSET] ;Set up to store it
BLT S1,VOLIDS-1 ;Do it
MOVEI S1,VOLSET ;Get address of where we just put it
SKIPN VOLSET ;Make sure its not null
N$FATE (<NVS>,,<Volume set name must be specified>)
MOVEM S1,VSNADR ;Save address of Volume set name
HRROI S1,VOLSET ;Point to volume set name string
PUSHJ P,DEVCHK ;See if actual device name given
MOVEM S2,VSNAME ;Save SIXBIT volume set name
MOVE T1,S2 ;Save Device name
CAIN S1,.TYDSK ;Is it a disk?
DEVNAM T1, ;Yes, translate logical name.
JRST MOUN21 ;Failed, or not a disk.
MOVE T3,VSNADR ;Get device name address.
MOVEI T2,2 ;Arg block is only 2 long now.
MOVEM T2,VOLSIZ ;So stuff it.
SETZM VOLSET ;Zap the current name
SETZM VOLSET+1 ;And another word
MOVE T3,[POINT 7,VOLSET] ;Get a byte pointer
TRZ T1,7777 ;Ensure only 4 characters
MOLO: SETZ T2, ;Loop to change SIXBIT to ASCIZ
ROTC T1,6 ;Shift a character into T2
ADDI T2,"A"-'A' ;Make into ASCII
IDPB T2,T3 ;Stuff into name
JUMPN T1,MOLO ;Continue until done
MOUN21: TXNE F,FL.TAP!FL.DSK ;Request type known?
JRST MOUN25 ;Yes..then allow it
EXCH N,S2 ;Swap the device name
JUMPF [CAIN S1,ER$EZD ; ersatz device?
N$FATE(<EDN>,N,<Ersatz devices may not be mounted: >)
CAIN S1,ER$PLD ; pathological name?
N$FATE(<PDN>,N,<Pathological devices may not be mounted: >)
CAIN S1,ER$ASN ; ambigious?
N$FATE(<ASN>,N,<Ambigious structure name: >)
CAIN S1,ER$ISN ; illegal?
N$FATE(<ISN>,N,<Illegal structure name: >)
CAIN S1,ER$GDN ; generic?
N$FATE(<GDN>,N,<Generic devices may not be mounted: >)
EXCH N,S2 ;No - Swap device name back
JRST MOUN25] ;and process as VSN
EXCH N,S2 ;Swap device name back
CAIN S1,.TYMTA ;Yes..was it tape?
TXO F,FL.TAP ;Yes..specify tape
CAIN S1,.TYDSK ;Was it disk?
TXO F,FL.DSK
MOUN25: JUMPLE C,MOUN40 ;IF EOL go do wrap-up processing
CAIN C,":" ;Was VSN: specified?
JRST MOUN30 ;Yes..on to get logical name
CAIN C," " ;How about a space?
JRST MOUN30 ;Treat it like a colon!
CAIN C,"/" ;How about a /?
JRST MOUN40 ;Yes..see about wrap up
CAIN C,"(" ;Open parenthesis?
JRST [TXO F,FL.PAR ;yes - light 'Open Parens' flag
JRST MOUN26] ;and go get more characters
CAIN C,")" ;How about close paren?
JRST [TXZ F,FL.PAR ;Yes - turn off parens flag
JRST MOUN26] ;and get more characters
CAIN C,"," ;Comma?
JRST [TXNE F,FL.PAR ;Within parenthesis?
JRST MOUN26 ;yes - eat it and get a new character
JRST MOUN40] ;no - Leave it for later
PUSHJ P,.REEAT## ;Put back if none of above!
PUSHJ P,MO$VOL ; Process a VOLID
JRST MOUN25 ;See if there are more to do
MOUN26: PUSHJ P,.TIAUC## ;Get another character
JRST MOUN25 ;And start checking anew
;Here if a colon is encountered
MOUN30: PUSHJ P,.TIAUC## ;Get another character
JUMPLE C,MOUN40 ;Don't bother if we hit EOL here
CAIN C,"/" ;Is it a slash?
JRST MOUN40 ;Yup - no more useful stuff here
CAIN C," " ;A space?
JRST MOUN30 ;Then get another character
CAIN C,":" ;Yet another colon?
JRST [TXNE F,FL.MOU ;Are we MOUNTing?
N$FATE (<NCM>,,<Nodes cannot be mounted>)
N$FATE(<NCA>,,<Nodes cannot be allocated>)]
CAIN C,"@" ;Attempt to do indirection?
N$FATE(<IIM>,,<Indirect commands illegal in middle of line>)
PUSHJ P,.SIXQC## ;Get a logical name
MOVE S1,.NMUL## ;Only save 1 word's worth
MOVEM S1,LOGNAM ;Do it
MOVEI S1,LOGNAM ;Get address of where we just put it
MOVE T1,LOGNAM ;Get first word of logical name
JUMPE T1,MOUN40 ;Jump if none there
JUMPLE C,MOUN40 ;Also jump if EOL
CAIN C,"@" ;Attempted indirection?
N$FATE(<IIM>,,<Indirect commands illegal in middle of line>)
CAIN C,":" ;Is there a trailing colon?
PUSHJ P,.TIAUC## ;Yes - eat it
;Whatever - fall through to MOUN40
MOUN40: PUSHJ P,SWTSCN ;get rest of switches
PUSHJ P,OSCAN ;and read SWITCH.INI now
PUSHJ P,MOUSWI ;Go twiddle bits according to switches
MOVEM C,SAVEC ;Save C for a while
TXNN F,FL.DSK ;Is this a disk request ?
TXNE F,FL.TRK ;Was /TRACK specified ?
JRST MOU405 ;Yes, skip this
SETZM S1 ;clear S1
MOVE S2,VSNAME ;Get the volume set name in sixbit
CAMN S2,[SIXBIT/M9/] ;Did he specify M9 ?
MOVX S1,.TMDR9 ;Yes, get 9 track code
CAMN S2,[SIXBIT/M7/] ;Did he specify M7 ?
MOVX S1,.TMDR7 ;Yes, get 7 track code
JUMPE S1,MOU405 ;Neither,,skip this
MOVEI S2,.TMDRV ;Get /TRACK: block type
PUSHJ P,ADDSUB ;Add /TRACK:x to message
MOU405: SKIPN VOLCNT ;Did we process some volume-names?
JRST MOUN41 ;No - go on
INCR .MECNT(P6) ;Bump subentry count
MOVE P4,P5 ;Save free address
MOVN T1,VOLCNT ;Get negative volume count
HRLZ T1,T1 ;move to the LH
MOU410: ADDI P5,1 ;Bump up pointer
MOVE T2,VOLIDS(T1) ;Get a volume-ID
MOVEM T2,(P5) ;Store it away
AOBJN T1,MOU410 ;Go get another unless we are done
ADDI P5,1 ;Point past entries
MOVE S1,P5 ;Get final free address
SUB S1,P4 ;Compute argument length
MOVS S1,S1 ;Put length in Left half
HRRI S1,.TMVOL ;Get Volume subtype entry
MOVEM S1,ARG.HD(P4) ;Store in subentry header
MOVE S1,P4 ;Point to argument
PUSHJ P,UNICHK ;Check VOLID uniqueness
SKIPT ;All OK?
N$FATE (<VIU>,,<Volume identifiers must be unique>)
MOUN41: PUSHJ P,BLDVSN ;Build the VSN
PUSHJ P,LOGCHK ;Check out the logical name
SETZ S1, ;Clear entry flags
TXNN F,FL.MOU ;Is this a mount request?
TXO S1,ME%ALC ;NO - Get the allocate-only bit
TXNN F,FL.SCR ;Scratch volume wanted?
JRST MOUN42 ;No
TXO S1,TM%SCR!TM%WEN ;Yes-light bits in request flags
TXO F,FL.WRT ;Light bit in our flags
TXZ F,FL.WLK!FL.NEW ;Turn off /READ and /NEW
TXZ S1,TM%WLK!TM%NEW ;In the request flags as well
JRST MOUN50 ;Skip redundant checking
MOUN42: TXNN F,FL.NEW ;New volume set wanted?
JRST MOUN43 ;No
TXO S1,TM%NEW!TM%WEN ;Yes-light bits
TXO F,FL.WRT ;In our flags as well
TXZ F,FL.WLK!FL.SCR ;Turn off /READ and /SCRATCH
TXZ S1,TM%WLK!TM%SCR ;In the request flags as well
JRST MOUN50 ;Skip redundant checks
MOUN43: TXNE F,FL.WRT ;Write enabled?
JRST [TXO S1,TM%WEN ;Yes - light the flag
TXZ S1,TM%WLK ;Extinguish the other
JRST MOUN50] ;Skip redundant check
TXNE F,FL.WLK ;Write locked?
JRST [TXO S1,TM%WLK ;Yes - Light flag
TXZ S1,TM%WEN ;Put out the other one
JRST MOUN50] ;And go on
MOUN50: TXNE F,FL.BYP ;Bypass labels?
TXO S1,TM%BYP ;Yes
TXNE F,FL.PAS ;Was /PASSIVE specified?
TXO S1,SM%PAS ;Yes
TXNE F,FL.NOC ;Was /NOCREATE specified?
TXO S1,SM%NOC ;Yes
TXNE F,FL.EXC ;Was /EXCLUSIVE specified?
TXO S1,SM%EXC ;Yes
TXNE F,FL.QTA ;Was /QUOTA specified?
TXO S1,SM%ARD ;Yes
IORM S1,.MEFLG(P6) ;Save the entry flags
MOVEI S1,.MNUNK ;Get unknown entry type
TXNE F,FL.TAP ;Was it a tape request?
MOVEI S1,.MNTTP ;Yes..then use tape entry type
TXNE F,FL.DSK ;Was it a disk request?
MOVEI S1,.MNTST ;Yes..then use disk entry type
STORE S1,ARG.HD(P6),AR.TYP ;Save request type
MOVE S1,P5 ;Close current entry
SUB S1,P6 ;Compute entry length
STORE S1,ARG.HD(P6),AR.LEN ;Save in entry header
MOVE C,SAVEC ;Restore saved C
CAIE C,"," ;Comma present?
JRST MOUN80 ;No - go send what we have
SETZM VOLIDS ;Clear the volume-ID area
HRLI T1,VOLIDS ;Set up source
HRRI T1,VOLIDS+1 ;Destination
BLT T1,VOLCNT-1 ;Zero them
SETOM S.VOLID ;Reset switch
JRST MOUN10 ;Back for another volume-set
MOUN80: SETZB S1,.MMFLG(M) ;Clear message flag word
TXNE F,FL.WAT ;Want to wait for the mount?
TXO S1,MM.WAT ;Yes..light the flag
TXNE F,FL.NOT ;Want terminal notification?
TXO S1,MM.NOT ;Yes..light the flag
TXNN F,FL.WAT ;If we are not waiting, then
TXO S1,MM.NOT ;then we WILL notify the user
MOVEM S1,.MMFLG(M) ;Set the message flags
SUB P5,M ;Compute message length
STORE P5,.MSTYP(M),MS.CNT ;Save it
MOVEI S1,PAGSIZ ;Send of the page
MOVE S2,M
$RETT
SUBTTL CANCEL command
;CANCEL command syntax tables
;REQKEY - Request-names for CANCEL and MODIFY commands
REQKEY: SIXBIT /BATCH-/ ;BATCH-REQUEST
SIXBIT /CARD-P/ ;CARD-PUNCH-REQUEST
SIXBIT /EVENT-/ ;EVENT-REQUEST
SIXBIT /MOUNT-/ ;MOUNT-REQUEST
SIXBIT /PAPER-/ ;PAPER-TAPE-REQUEST
SIXBIT /PLOTTE/ ;PLOTTER-REQUEST
SIXBIT /PRINTE/ ;PRINTER-REQUEST
REQLEN==.-REQKEY
REQQTY: EXP .OTBAT
EXP .OTCDP
EXP .OTEVT
EXP .OTMNT
EXP .OTPTP
EXP .OTPLT
EXP .OTLPT
RQQLEN==.-REQQTY
;CANCEL command
.CANCE: PUSHJ P,PSCAN ;INITIALIZE PARTIAL SCANNER
JUMPLE C,[N$FATE(<NRS>,,<No request type and ID specified to cancel>)]
SKIPN REPARS ;ANYTHING TYPED?
POPJ P, ;JUST /HELP
PUSHJ P,LGICHK ;CHECK FOR LOGGED-IN JOB
MOVE M,.JBFF## ;Set up to get a page, since we may need more
;than 10. words...
MOVEI M,PAGSIZ-1(M) ;ALIGN .JBFF ON A PAGE BOUNDRY
TRZ M,PAGSIZ-1 ;MAKE IT SO
MOVEM M,.JBFF## ;FAKE OUT CORGET
SOS .JBFF ;BACK OFF BY ONE
GCORE PAGSIZ ;GET A PAGE FOR IT
SETZM (M) ;CLEAR THE NEW MESSAGE FIRST
HRLI T1,(M) ;SET UP FOR EVENTUAL BLT
HRRI T1,1(M) ;DESTINATION
BLT T1,PAGSIZ-1(M) ;GET IT ALL
MOVE P1,M ;P1 contains message address
MOVEI P2,KIL.RQ(P1) ;P2 points to request object
MOVEI S1,.QOKIL ;Get kill message type
STORE S1,.MSTYP(P1),MS.TYP ;Save in the message
MOVX S1,MF.ACK ;Request an ACK
MOVEM S1,.MSFLG(P1)
MOVE S1,USRNUM ;Get default user
MOVEM S1,.RDBOI(P2) ;Save in the message
SETOM .RDBOM(P2) ;Set user mask
PUSHJ P,.SIXMC## ;Get a command string
MOVE T2,.NMUL## ;Get first word
JUMPE T2,[N$FATE(<NRS>,,<No request type specified>)]
MOVE T1,[IOWD REQLEN,REQKEY] ;Set up for search
PUSHJ P,.LKNAM## ;Look up the name
JRST [MOVE N,.NMUL## ;Copy the command string
N$FATE(<IRS>,N,<Invalid request-type specified: >)]
HRRZM T1,T1 ;Clear LH of T1
SUBI T1,REQKEY ;Convert tbl ent addr to tbl offset
MOVE S1,REQQTY(T1) ;Get the object type
MOVEM S1,KIL.OT(P1) ;Save requested object type
CANCL1: JUMPLE C,[N$FATE(<NRN>,,<No request number, name, or volume-set typed>)]
PUSHJ P,.TIAUC## ;Yes - get first character
CAIN C," " ;Got a space?
JRST CANCL1 ;Loop for more
CAIN C,"*" ;Asterisk?
JRST CANAST ;Yes - go handle
CAIG C,"9" ;Is it numeric?
CAIGE C,"0" ;...
SKIPA ;No
JRST CANCEN ;Yes--treat as a number
CAXE S1,.OTMNT ;Is it a CANCEL MOUNT?
JRST CANCE0 ;No..don't store VSN
PUSHJ P,.ASCQC## ;Get a quoted string
MOVE S1,[POINT 7,.NMUL##] ;Point to source string
MOVEI S2,.RDBVS(P2) ;Point to destination
HRLI S2,(POINT 7)
PUSHJ P,CPYSTR ;Copy the string
JRST CANCE2 ;Get confirmation
;Handle an Asterisk...
CANAST: CAXN S1,.OTMNT ;Is it a CANCEL MOUNT?
N$FATE(<WNA>,,<Wildcards not allowed when cancelling MOUNT requests>)
SETZM S1 ;Clear our receiver
PUSHJ P,P$WLDA ;Convert to a Wildcard string
JUMPLE C,CANCE1 ;Are we at EOL? Go on if so
PUSHJ P,.TIAUC## ;Get another character (hopefully EOL)
JRST CANCE1 ;Move on
CANCEN: PUSHJ P,.DECNC## ;Get a request number
MOVEM N,.RDBRQ(P2) ;Save request number
JRST CANCE2 ;and go on
CANCE0: PUSHJ P,.REEAT## ;Go put the character back
PUSHJ P,P$WLDF ;Go get a possibly wild string
SKIPT
N$FATE (<IRN>,,<Invalid request name>)
CANCE1: MOVEM S1,.RDBJB(P2) ;Store the results
MOVEM S2,.RDBJM(P2) ;in the message
CANCE2: PUSHJ P,SWTSCN ;Go look for trailing switches
JUMPG C,[N$FATE(<EAE>,,<Excess arguments encountered at end of line>)]
PUSHJ P,OSCAN ;Now go read SWITCH.INI
CANCE3: MOVEI S1,KIL.SZ ;Get size of kill message
STORE S1,.MSTYP(P1),MS.CNT ;Store the count
TXO M,1B0 ;Indicate a page-mode send
PUSHJ P,CN$JOB ;See if a /JOBNAME was typed and get it
PUSHJ P,MSGSND ;Send it off
PUSHJ P,RCVACK ;Recieve the list answer
PUSHJ P,.CLRBF## ;Clear the buffer of any excess
$RETT ;and Return
CN$JOB: SKIPN S.JOB ;Any /JOBNAME given?
$RETT ;Return if not
MOVE S1,S.JOB ;Get the jobname
CAMN S1,[EXP -1] ;Is it -1?
$RETT ;Yes - it was not specified
PUSHJ P,P$WLDS ;Parse wild JOBNAME in S1
SKIPT
N$FATE (<IRN>,,<Invalid request name>)
MOVEM S1,.RDBJB(P2)
MOVEM S2,.RDBJM(P2)
$RETT
SUBTTL DEALLOCATE and DISMOUNT commands
;DEALLOCATE and DISMOUNT commands
.DEALL: MOVX F,FL.MCL ;Clear all flags but 'Mount-Class Command'
SKIPA
.DISMO: MOVX F,FL.MOU+FL.MCL ;Use mount flag for dismount
PUSHJ P,LGICHK ;CHECK FOR LOGGED-IN JOB
TXO F,FL.WAT ;Default to /WAIT
SETZM VIDADR ;Clear the /VID text address
MOVE S1,['DISMOU'] ;Assume dismount
TXNN F,FL.MOU
MOVE S1,['DEALLO']
MOVEM S1,CMDNAM ;Save for /HELP
PUSHJ P,PSCAN ;INITIALIZE PARTIAL SCANNER
JUMPLE C,[N$FATE(<NRS>,,<No request-ID specified>)]
SKIPN REPARS ;ANYTHING TYPED?
POPJ P, ;JUST /HELP
MOVEM F,DEFSWS
SETZM ACKCNT ;Clear count of expected ACKs
DEAL10: MOVE F,DEFSWS ;Reclaim sticky switches
MOVE M,.JBFF## ;Set up to get a page
MOVEI M,PAGSIZ-1(M) ;ALIGN .JBFF ON A PAGE BOUNDRY
TRZ M,PAGSIZ-1 ;MAKE IT SO
MOVEM M,.JBFF## ;FAKE OUT CORGET
SOS .JBFF ;BACK OFF BY ONE
GCORE PAGSIZ ;GET A PAGE FOR IT
SETZM (M) ;CLEAR THE NEW MESSAGE FIRST
HRLI T1,(M) ;SET UP FOR EVENTUAL BLT
HRRI T1,1(M) ;DESTINATION
BLT T1,PAGSIZ-1(M) ;GET IT ALL
MOVEM M,MSGBLK
MOVE P1,M ;P1 is a copy of M
MOVEI P5,.OHDRS(M) ;P5 points to message body
MOVE P6,P5 ;Copy it
ADDI P6,1 ;P6 points to free word
MOVEI S1,.QODVS ;Dismount message type
STORE S1,.MSTYP(M),MS.TYP
MOVX S1,MF.ACK ;Request an ACK
MOVEM S1,.MSFLG(M) ;Set the message flag
DEAL15: SKIPG ACKCNT ;Have we done an ACKable dismount?
SKIPE ITMCNT ;or a local DEASSIGN?
JRST DEAL16 ;Yes - handle specially
PUSHJ P,.ASCQC## ;No - we have 1st char. already
SKIPA ;Skip over
DEAL16: PUSHJ P,.ASCQW## ;Get the field, ignoring C's contents
SKIPN .NMUL## ;Null?
N$FATE (<NDF>,,<Device field must be specified>)
HRROI S1,.NMUL## ;Point to string
PUSHJ P,S%SIXB ;Convert first word to sixbit
MOVEM S2,VSNAME ;Save it
SETZM T2 ;Clear counter
DEAL17: MOVE T3,.NMUL##(T2) ;Get a word
JUMPE T3,DEAL18 ;Word is null--exit the loop
MOVEM T3,VOLSET(T2) ;Store the word
AOS T2 ;Bump counter
CAIGE T2,^D29 ;Moved 30 words?
JRST DEAL17 ;No - get another
AOS T2 ;Add one more so word count will be right
DEAL18: MOVEM T2,VOLIDS ;Yes - save count
SETZM VSNDEV ;No device name yet...
CAIN C,":" ;Got a colon?
PUSHJ P,.TIAUC## ;Yes--eat it
PUSHJ P,SWTSCN ;Whatever - go look for trailing switches
PUSHJ P,OSCAN ;Go read SWITCH.INI
PUSHJ P,DEASWI ;Twiddle the flags according to the switches
TXNN F,FL.MOU ;DEALLOCATING?
JRST DEAL20 ;YES, TALK TO QUASAR
MOVE S2,VSNAME ;Get sixbit volume-set-name
DEVNAM S2, ;Get real device name
JRST DEAL20 ;Treat as volume-set name if not device
MOVEM S2,VSNDEV ;Save actual device name
MOVE S1,S2 ;Put name in S1
MOVEI S2,.RECDV ;Argument type is device
PUSHJ P,ADDARG ;Add the argument
MOVE S1,VSNDEV ;GET THE DRIVE NAME
MOVE N,VSNDEV
DEVTYP S1, ;Get device type
N$FATE (<UDT>,<N>,<Unknown device type: >)
LOAD S2,S1,TY.DEV ;Get actual device type
CAIN S2,.TYDSK ;Is it disk?
JRST [MOVE S1,VSNDEV ;Get the device name
MOVEM S1,VIDCHR+.DCNAM ;Save it
MOVE S1,[.DCUID+1,,VIDCHR] ;Get DSKCHR parms
DSKCHR S1, ;Get disk characteristics
JRST DEAL40 ;Failed,,skip this
MOVE S1,VIDCHR+.DCUPN ;Get the unit its mounted on
MOVEM S1,VSNDEV ;Save it
JRST DEAL40 ] ;Continue
MOVEI S1,0 ;No..Deassign it
MOVE S2,VSNDEV
MOVE N,VSNDEV ;Make a copy for typeout
REASSI S1,
SKIPGE S1 ;Did we win?
N$FATE (<DNM>,N,<Device was not mounted: >)
MOVEI T1,"[" ;get a bracket
PUSHJ P,.TCHAR## ;type it
MOVE T1,VSNDEV ;Get name of device
PUSHJ P,.TSIXN## ;Type it
MOVEI T1,[ASCIZ / dismounted]/]
PUSHJ P,.TSTRG## ;Type rest of string
PUSHJ P,.TCRLF## ;Finish it off
AOS ITMCNT ;Indicate that we've been here at least once
JRST DEAL45 ;Check for more to do
DEAL20: MOVEI S1,.RCTVS ;Set proper type
STORE S1,VOLSHD,AR.TYP
MOVEI S1,VOLSHD ;Retrieve VSN text address
MOVE S2,VOLIDS ;Get its size
AOS S2 ;Add one to it (to account for header)
STORE S2,VOLSHD,AR.LEN ;Store the size
MOVEI P5,.OHDRS(M) ;Rebuild start of message body
PUSHJ P,CPYARG ;Copy the argument
DEAL40: MOVE S1,P5 ;Get free address
SUB S1,M ;Compute length
STORE S1,.MSTYP(M),MS.CNT
SETZM S2 ;Clear message flags
TXNN F,FL.MOU ;Dismount?
TXO S2,MM.DLC ;No..Deallocate
TXZE F,FL.RMV ;Removing?
TXO S2,MM.REM ;Yes..set the message flag
TXNE F,FL.WAT ;Are we waiting ???
TXO S2,MM.WAT ;yes,,set it
TXNE F,FL.NOT ;Wants notify ???
TXO S2,MM.NOT ;Yes,,set it
MOVEM S2,.OFLAG(M) ;Store the flags
PUSHJ P,MSGSND ;Send off the request
AOS ACKCNT ;Bump the count of expected ACKs
DEAL45: PUSHJ P,NOTOPR ;Notify OPR for /VID if we have to
JUMPLE C,DEAL50 ;EOL? If so, go wait for replies...
CAIN C,"," ;Found a comma?
JRST DEAL10 ;Yes - we have multiple fields - go get more
JUMPG C,[N$FATE(<BCS>,,<Bad command syntax>)]
DEAL50: TXNE F,FL.WAT ;Want to wait ?
SOSGE ACKCNT ;Yes - recieved all ACKS?
$RETT ;Yes..just return
PUSHJ P,RCVACK ;No..go recieve one
JRST DEAL50 ;Get the next
NOTOPR: SKIPN S.REMARK ;Was a /VID switch specified ??
$RET ;No VID,,return
HRRZI S1,REMLEN ;Get the block length
ADDI S1,^D20 ;Add 20 words
GCORE ^D50
SUBI T1,^D49 ;Get start location
MOVE S2,T1 ;Put it here
MOVEM S2,VIDBLK ;Save the address
MOVE S1,VIDADR ;Get the new text address
TLO S1,(POINT 7,0) ;Gen a byte pointer to the buffer
MOVEM S1,VIDPTR ;Save it
MOVEI T1,SAVBYT ;Get address of byte-storage routine.
PUSHJ P,.TYOCH## ;Tell SCAN to use it.
PUSH P,T1 ;Save previous routine on stack
MOVEI T1,[ASCIZ /Volume set: /]
PUSHJ P,.TSTRG## ;Write first part
MOVEI S1,VOLSHD ;Get the volume set name address
MOVEI T1,ARG.DA(S1) ;Get addr of text
PUSHJ P,.TSTRG## ;Write it out
SKIPE VSNDEV ;Any unit ???
JRST [MOVEI T1,[ASCIZ /, on unit: /] ;yes, type it too
PUSHJ P,.TSTRG##
MOVE T1,VSNDEV ;get device name
PUSHJ P,.TSIXN## ;type it too
JRST DEAL55]
DEAL55: PUSHJ P,.TCRLF## ;type a CR-LF
MOVE T1,S2 ;get VID address into t1
PUSHJ P,.TSTRG## ;add it into string
PUSHJ P,.TCRLF## ;Terminate with CRLF
POP P,T1 ;Get old typeout routine
PUSHJ P,.TYOCH## ;Tell scan to use it
MOVE S1,[5,,OPRNOT] ;Get QUEUE. UUO parms
QUEUE. S1, ;Yes,,tell the operator
JFCL ;Ignore the error
$RETT ;Return
SAVBYT: IDPB T1,VIDPTR ;Save the byte
$RET ;Return
;
SUBTTL DEASWI - Handle the various DEASSIGN/DISMOUNT switches
DEASWI: TXO F,FL.WAT ;/WAIT is default
TXZ F,FL.NOT ;/NONOTIFY " "
TXZ F,FL.RMV ;/NOREMOVE " "
MOVE T1,S.WAIT ;Get /WAIT
JUMPL T1,DEAS.1 ;Defaulted? Go around this then
JUMPG T1,[TXO F,FL.WAT ;if /WAIT: Turn on bit
TXZ F,FL.NOT ;Also assume /NONOTIFY
JRST DEAS.2] ;Go look at /REMOVE
TXZ F,FL.WAT ;/NOWAIT was typed -- turn off bit
TXO F,FL.NOT ;And assume /NOTIFY
SKIPE S.WAIT ;Check /NOTIFY if /NOWAIT set
JRST DEAS.2 ;Skip around /NOTIFY since we lit it
DEAS.1: MOVE T1,S.NTF ;Get /NOTIFY
JUMPL T1,DEAS.2 ;Jump if defaulted
JUMPG T1,[TXO F,FL.NOT ;Light bit
JRST DEAS.2] ;Go for more
TXZ F,FL.NOT ;/NONOTIFY was typed
DEAS.2: SKIPLE S.REMOV ;Skip if /REMOVE is defaulted
TXO F,FL.RMV ;Light the flag
POPJ P, ;Return to caller
SUBTTL SHOW command keyword tables
; Keyword tables for CANCEL, MODIFY, and SHOW commands
;SHOKEY - Keywords for the SHOW command
SHOKEY: SIXBIT /ALLOCA/ ;ALLOCATION
SIXBIT /QUEUES/ ;QUEUES
SHKLEN==.-SHOKEY
SHODSP: .SHALL
.SHQUE
SHDLEN==.-SHODSP
;SHOQUE - Keywords for the SHOW QUEUES command
SHOQUE: SIXBIT /ALL-RE/ ;ALL-REQUESTS
SIXBIT /BATCH-/ ;BATCH-REQUESTS
SIXBIT /CARD-P/ ;CARD-PUNCH-REQUESTS
SIXBIT /EVENTS/ ;EVENT REQUESTS
SIXBIT /MOUNT-/ ;MOUNT-REQUESTS
SIXBIT /OUTPUT/ ;OUTPUT-REQUESTS
SIXBIT /PAPER-/ ;PAPER-TAPE-REQUESTS
SIXBIT /PLOTTE/ ;PLOTTER-REQUESTS
SIXBIT /PRINTE/ ;PRINTER-REQUESTS
SHQLEN==.-SHOQUE
SHQDSP: EXP LIQALL_-^D18
EXP LIQBAT_-^D18
EXP LIQCDP_-^D18
EXP LIQEVT_-^D18
EXP LIQMNT_-^D18
EXP LIQOUT_-^D18
EXP LIQPTP_-^D18
EXP LIQPLT_-^D18
EXP LIQLPT_-^D18
SQDLEN==.-SHQDSP
SHQARG: IOWD SWTCHL, SWTCHN ;IOWD POINTER TO SWITCH NAMES
XWD SWTCHD, SWTCHM ;SWITCH DEFAULTS,,PROCESSOR
XWD 0, SWTCHP ;ZERO,,STORAGE POINTERS
SHQHLP: SIXBIT /SHOW/ ;NAME FOR HELP (DIDDLED BY CODE)
SHQPLN==.-SHQARG
SUBTTL CHKALC -- Build a SHOW ALLOCATION packet for QUASAR
CHKALC: PUSH P,P1 ;Save a couple of ACs...
PUSH P,P5 ;...
MOVEI S1,PAKSIZ ;Point to message size
MOVEI S2,PACKET ;Point to message address
PUSHJ P,.ZCHNK ;Zero the area
MOVEI P1,PACKET ;Point to message header
MOVEI P5,.OHDRS(P1) ;Point to free word
MOVEI S1,.QOLAC ;List allocation state
STORE S1,.MSTYP(P1),AR.TYP ;Store message type
MOVE S1,JOBNUM ;Get users job number
MOVEI S2,.ORJNU ;Get block type
PUSHJ P,ADDARG ;Store the argument
MOVE S1,P5 ;Compute message length
SUB S1,P1 ;...
STORE S1,.MSTYP(P1),MS.CNT ;Store in packet header
MOVEI M,PACKET ;Point to the packet
PUSHJ P,MSGSND ;Request the ACK
PUSHJ P,RCVACK ;Recieve it
POP P,P5 ;Restore the ACs we trashed...
POP P,P1 ;...
$RETT ;and go home.
CHKMNT: MOVE S1,[LIQMNT_-^D18] ;Get mount queue type
PUSHJ P,CHKQUE ;Build proper message
PUSHJ P,MSGSND ;Request the ACK
PUSHJ P,RCVACK ;Recieve it
$RETT ;All done.
SUBTTL CHKQUE - Build a SHOW QUEUES message for QUASAR
CHKQUE: PUSHJ P,.SAVE2##
MOVE T1,S1 ;Remember the type for a while
MOVEI S1,PAKSIZ ;Clear message
MOVEI S2,PACKET
PUSHJ P,.ZCHNK
MOVEI S1,.QOLIS ;Get list message type
STORE S1,.MSTYP(S2),MS.TYP ;Save in the message
MOVE S1,T1 ;Reclaim queue type
MOVEI P1,PACKET ;P1 contains message address
MOVEI P2,.OHDRS(S2) ;P2 contains argument address
MOVE S2,[2,,.LSQUE] ;Set argument type
MOVEM S2,ARG.HD(P2)
HRLZM S1,ARG.DA(P2) ;Store the queue type
INCR .OARGC(P1) ;Bump message argument count
ADDI P2,ARG.SZ ;Point to next free argument
CHKQ20: TXNN F,FL.CHK ;Was MOUNT /CHECK typed?
JRST CHKQ30 ;No...onward to show queues
MOVE S2,[2,,.LSUSR] ;Yes..then default is 'our' queues
MOVEM S2,ARG.HD(P2)
MOVE S2,USRNUM ; Only ours
MOVEM S2,ARG.DA(P2)
INCR .OARGC(P1) ;Include argument in count
ADDI P2,ARG.SZ ;Point past it
CHKQ30: SUBI P2,PACKET ;Compute message length
STORE P2,.MSTYP(P1),MS.CNT ;Store the count
MOVE S1,P2 ;Return S1 containing size
MOVEI S2,PACKET ; S2 Containing address
MOVEI M,PACKET ; M also holds address
$RETT
SUBTTL .SHOW - Parsing for SHOW command
.SHOW: MOVE S1,['SHOW '] ;Set for /HELP
MOVEM S1,CMDNAM ;...
SETZ F, ;Clear flags word
TXO F,FL.MCL ;Indicate "Mount-Class Command"
PUSHJ P,PSCAN ;INITIALIZE PARTIAL SCANNER
JUMPLE C,[N$FATE(<NSS>,,<Nothing specified to SHOW>)]
SKIPN REPARS ;ANYTHING TYPED?
POPJ P, ;JUST /HELP
PUSHJ P,.SIXMC## ;GO GET A KEYWORD
MOVE T2,.NMUL## ;Get first word of string
MOVE T1,[IOWD SHKLEN,SHOKEY] ;Address of table
PUSHJ P,.LKNAM## ;Look it up
N$FATE(<ISC>,,<Invalid SHOW command>) ;Didn't find it
HRRZ T1,T1 ;Zero out LH
SUBI T1,SHOKEY ;Convert table ent addr to offset
PJRST @SHODSP(T1) ;Go dispatch if we did find it
;SHOW ALLOCATION command
.SHALL: PUSHJ P,CHKALC ;Build and Send Check allocation message
$RETT ;Done
SUBTTL .SHQUE - SHOW QUEUES command
;SINCE WE GOT HERE RIGHT AFTER A CALL TO .SIXMC/.SIXMW, NEXT CHARACTER
;IS ALREADY IN C.
.SHQUE: JUMPLE C,.SHQU1 ;If EOL, assume ALL
CAIN C,"/" ;Switch?
PUSHJ P,SWTSCN ;Yes - go get any on the line
CAIN C," " ;Space?
JRST [PUSHJ P,.TIAUC## ;Get another character
JRST .SHQUE] ;Loop back for more
JUMPLE C,.SHQU1 ;Check EOL again--SWTSCN might've hit it
PUSHJ P,.SIXMC## ;Get next keyword - 1st char in C
MOVE T2,.NMUL## ;Get first word of string
MOVE T1,[IOWD SHQLEN,SHOQUE] ;Get table of values
PUSHJ P,.LKNAM## ;Look it up
N$FATE(<ISQ>,,<Invalid SHOW QUEUE command>) ;Didn't find it
HRRZM T1,T1 ;Clear LH of T1
SUBI T1,SHOQUE ;Change tbl ent addr to tbl offset
PUSH P,T1 ;Save it for a bit
PUSHJ P,SWTSCN ;Look for trailing switches
POP P,T1 ;Get the keyword index back
MOVE S1,SHQDSP(T1) ;Get queue type
SKIPA ;Skip next line
.SHQU1: MOVE S1,[LIQALL_-^D18] ;No..default to ALL
PUSHJ P,CHKQUE ;Build proper message
MOVEI P1,PACKET ;Get packet address
MOVEI P2,PACKET ;Get another copy
ADD P2,S1 ;Point to first free (from CHKQUE)
PUSHJ P,OSCAN ;Read SWITCH.INI
PUSHJ P,SHOSWI ;Process switch settings
PUSHJ P,MSGSND ;Request response
PUSHJ P,RCVACK ;Get the ACK
$RETT
;Here we pick up trailing switches...
.SHQU2: PUSHJ P,SWTSCN ;Go get switches
.SHQU3: JUMPLE C,.SHQU1 ;Go back if at EOL
PUSHJ P,.TIAUC## ;Get another character
JRST .SHQU3 ;Keep looping until we've eaten to EOL
;SHOW QUEUE option processor routines
;ACCEPTS P1/ Address of message
; P2/ First free address in message
SUBTTL SHOSWI - Process switches valid for SHOW QUEUE mumble
;This routine checks to see if /ALL, /BRIEF, or /FULL are lit. It also
;contains SHOPPN, a routine called by SCAN to process /USER:[p,pn].
;Conflicts detected (and reported):
; /ALL and /USER:[p,pn]
; /BRIEF and /FULL
;
;
SHOSWI: MOVE T1,S.ALL ;Get /ALL
JUMPLE T1,SHOS.2 ;Jump if not lit
SKIPE S.PPN ;Is a PPN specified?
N$FATE(<CSS>,,<Conflicting switches /ALL and /USER specified>) ;Yes - complain
;No - fall through and diddle message
SHOS.1: MOVE S2,[2,,.LSUSR] ;Specify all users
MOVEM S2,ARG.HD(P2)
SETZM ARG.DA(P2)
INCR .OARGC(M) ;Include argument count
ADDI P2,ARG.SZ ;Point past it
;Here to check /BRIEF and /FULL
SHOS.2: MOVE T1,S.BRIEF ;Get /BRIEF
JUMPLE T1,SHOS.3 ;Jump around if unlit
SKIPLE S.FULL ;Was /FULL lit as well?
N$FATE(<CSS>,,<Conflicting switches /BRIEF and /FULL specified>) ;Yes - complain
MOVX S1,LS.FST ;No - Get the bit
IORM S1,.OFLAG(M) ;Store in the message
SHOS.3: SKIPG S.FULL ;/FULL lit?
JRST SHOS.4 ;No - don't twiddle
MOVX S1,LS.ALL ;Get bit
IORM S1,.OFLAG(M) ;Light it in message
SHOS.4: SKIPLE S.ALL ;Was /ALL lit?
$RETT ;Yes - then don't look for /PPN
SKIPG S.PPN ;No - Is there a /USER:[p,pn]?
$RETT ;No - Go back
MOVE S1,S.PPN ;Yes - get the PPN
MOVE S2,[2,,.LSUSR] ;Get the argument type
MOVEM S2,ARG.HD(P2) ;Store it
MOVEM S1,ARG.DA(P2) ;Store user number
INCR .OARGC(M) ;Bump argument count
ADDI P2,ARG.SZ ;Point to next argument
LOAD S1,.MSTYP(P1),MS.CNT ;Get old word count
ADDI S1,ARG.SZ ;Add size of argument to count
STORE S1,.MSTYP(P1),MS.CNT ;Store it
$RETT ;And go back
SUBTTL SHOPPN - 'Quick-and-dirty' PPN parsing
;
;Called by SCAN when parsing /USER:[P,PN] for SHOW QUEUE /USER
SHOPPN: MOVE T3,USRNUM ;Get user's default PPN
SHOP.1: PUSHJ P,.TIAUC## ;Get a character
CAIE C,"[" ;Square bracket?
JRST SHOP.E ;No - bad PPN format
PUSHJ P,.TIAUC## ;Yes - get another character
CAIE C,"," ;Is it [,?
JRST SHOP.2 ;No
HLLM T3,S.PPN ;Yes - default LH of PPN
JRST SHOP.6 ;Skip next bit
SHOP.2: CAIE C,"]" ;IS it []?
JRST SHOP.4 ;No
SHOP.3: MOVEM T3,S.PPN ;Yes - default the whole thing
JRST SHOP.E ;and wrap up
SHOP.4: CAIE C,"-" ;Is it [-?
JRST SHOP.5 ;No
PUSHJ P,.TIAUC## ;Get yet another character
CAIE C,"]" ;Is it [-]?
N$FATE(<IPV>,,<Invalid PPN value>) ;No - bomb
JRST SHOP.3 ;Yes - default whole PPN
;Here to check for LH octal
SHOP.5: CAIGE C,"8" ;Less than 8?
CAIGE C,"0" ;And .GE. 0?
N$FATE(<IPV>,,<Invalid PPN value>) ;No - bomb
PUSHJ P,.OCTNC## ;Get the rest of the number
HRLM N,S.PPN ;Store it
JUMPLE C,[ N$FATE(<BFP>,,<Bad format for PPN>)]
CAIE C,"," ;Comma?
N$FATE(<BFP>,,<Bad format for PPN>) ;No
;Here for RH octal - C contains a comma
SHOP.6: PUSHJ P,.TIAUC## ;Get next character
CAIN C,"]" ;Close bracket?
JRST SHOP.7 ;No
CAIGE C,"8" ;Less than 8?
CAIGE C,"0" ;And .GE. 0?
N$FATE(<IPV>,,<Invalid PPN value>) ;No - bomb
PUSHJ P,.OCTNC## ;Get the rest of the number
HRRM N,S.PPN ;Store it
JUMPLE C,SHOP.E ;Leave if at EOL
CAIE C,"]" ;Close square bracket?
N$FATE(<BFP>,,<Bad format for PPN>) ;No
SHOP.E: MOVE N,S.PPN ;Copy PPN into N
JUMPLE C,SHOP.X ;Don't prime if at EOL already
PUSHJ P,.TIAUC## ;Get next character
SHOP.X: POPJ P, ;leave
SHOP.7: HRRM T3,S.PPN ;Default the RH
JRST SHOP.E ;and leave
;LOGCHR Default Text output routine
LOGCHR: PUSHJ P,.TCHAR## ;Type the character
SUBTTL P$WLDF - Parse a possibly-wild SIXBIT field
;P$WLDF/P$WLDS/P$WLDA - routine to parse Possibly wild
; SIXBIT field (in one word)
;
; P$WLDF is used if the field has yet to be input from the command line
;
; Call: PUSHJ P,P$WLDF
;
; P$WLDS is used if the field is already in S1.
;
; P$WLDA is used to dummy up a full wildcard.
;
;RETURNS TRUE S1/ Sixbit field
; S2/ Wild mask for field
; FALSE if field is not valid wild alphanumeric
;Field may be:
; AAAAAA Mask will be -1
; * mask will be 0
; AA?AAA mask will be 0 for 6 bits at each ? or %
P$WLDF: PUSHJ P,.SIXSW## ;GET A SIXBIT WORD
MOVE S1,N ;COPY IT TO S1 FRON WHERE SCAN LEFT IT
P$WLDS: SKIPN S1 ;User type "*" maybe?
P$WLDA: MOVSI S1,'* ' ;No - make it look that like he did
SETOM T2 ;Initialize mask
MOVE T3,[POINT 6,S1] ;Initialize name pointer
MOVE T4,[POINT 6,S2] ;Initialize mask pointer
PWLDF1: TLNN T3,(77B5) ;Finished last character?
$RETT ;Yes..return success
ILDB T1,T3 ;Get a source byte
JUMPE T1,PWLDF4 ;Update mask on null
CAIL T1,'0' ;Alphanumeric?
CAILE T1,'Z'
JRST PWLDF2 ;No..check for wild
CAILE T1,'9'
CAIL T1,'A'
JUMPN T2,PWLDF4 ;Do next character
PWLDF2: CAIE T1,'*' ;Full wild card?
JRST PWLDF3 ;No..check single
TDZ T2,T2 ;Yes..clear remaining mask
JRST PWLDF4
PWLDF3: CAIE T1,'?' ;Wild character?
CAIN T1,'%'
TRZA T2,77 ;Yes..Clear bits to indicate wild
$RETF ;Not alphanumeric
PWLDF4: TLNE T4,(77B5) ;Update mask
IDPB T2,T4
LSH T2,-6 ;Position mask
JRST PWLDF1 ;Do next character
SUBTTL MOUNT-class initialization routines
;JOBPRM - Routine to read initial job parameters
JOBPRM: SETO S1, ;Get information for my job
MOVEI S2,JI.JNO ;Read my job number
PJOB T1, ;Get the job number
MOVEM T1,JOBNUM
STORE T1,USRACK,ACK.JB ;Store in ACK also
GETPPN S2, ;Get my PPN
MOVEM S2,USRNUM
MOVX T1,%CNDTM ;Get the UDT
GETTAB T1, ;Go for it!
SETZM T1 ;Crufty old monitor
STORE S1,USRACK,ACK.UT ;Store part we want in ACK code
$RETT
SUBTTL MOUSWI -- MOUNT/ALLOCATE switch moving routines
;This routine looks at all the switches typed for the MOUNT and ALLOCATE
;commands and either twiddles the appropriate bits in F or puts the
;right info into the block for QUASAR.
;
; Uses: T1,T2
MOUSWI: SKIPG S.CHK ;/CHECK lit?
JRST MOUS.0 ;No - skip around
TXO F,FL.CHK ;Yes - Set the flag
$RETT ;and Return, ignoring the rest
;DISK option forcibly declares disk devices
MOUS.0: SKIPG S.DISK ;/DISK specified?
JRST MOUS.1 ;No - go look at next switch
SKIPLE S.TAPE ;/TAPE set as well?
N$FATE(<CSS>,,<Conflicting switches /DISK and /TAPE specified>)
TXO F,FL.DSK ;Forcibly light /DISK
TXZ F,FL.TAP ;Turn off /TAPE
JRST MOUS.2 ;Skip over /TAPE code
;/TAPE option
MOUS.1: SKIPG S.TAPE ;/TAPE specified?
JRST MOUS.2 ;No
TXO F,FL.TAP ;Light /TAPE
TXZ F,FL.DSK ;Extinguish /DISK
;/ACTIVE
MOUS.2: MOVE T1,S.ACTIV ;Get /ACTIVE
JUMPLE T1,MOUS.3 ;Ignore if not lit
SKIPLE T1,S.PASSIV ;Is /PASSIVE lit as well?
N$FATE(<CSS>,,<Conflicting switches /ACTIVE and /PASSIVE both specified>)
MOVE T1,[SIXBIT |ACTIVE|] ;error prefix
PUSHJ P,DSKCHK ;Must be disk
TXZ F,FL.PAS ;Clear Passive flag
JRST MOUS.4 ;Skip /PASSIVE stuff
;/PASSIVE
MOUS.3: SKIPG S.PASSIV ;/PASSIVE lit?
JRST MOUS.4 ;No - go around to next
MOVE T1,[SIXBIT |PASSIV|] ;Get error prefix
PUSHJ P,DSKCHK ;Must be dsk
TXO F,FL.PAS ;Set the PASSIVE flag
;/[NO]CREATE
MOUS.4: SKIPGE S.OPN ;/CREATE set in some way?
JRST MOUS.6 ;No - go around
SKIPE S.OPN ;Is it /NOCREATE?
JRST MOUS.5 ;No, then it must be /CREATE
MOVE T1,[SIXBIT |NOCREATE|] ;Get the switch
PUSHJ P,DSKCHK ;Disk requests only
TXO F,FL.NOC ;Twiddle the bit
JRST MOUS.6 ;Skip next bit
;/CREATE
MOUS.5: MOVE T1,[SIXBIT |CREATE|] ;Get error prefix
PUSHJ P,DSKCHK ;Must be disk
TXZ F,FL.PAS!FL.NOC ;Clear Passive and Nocreate
;Look at /DENSITY
MOUS.6: MOVX T1,FX.DEN ;/DENSITY mask
TDNN T1,O.MODM ;Was it given?
JRST MOUS.7 ;No
MOVE T1,[SIXBIT |DENSIT|] ;Get error prefix
PUSHJ P,TAPCHK ;Must be tape
LOAD S1,O.MOD,FX.DEN ;Get /DENSITY argument
MOVEI S2,.TMDEN ;Get the entry type
PUSHJ P,ADDSUB ;Store in the message
;/DEVICE option requests specific device type
MOUS.7: SKIPN S.DEVIC ;/DEVICE specified?
JRST MOUS.8 ;No - go around this
MOVE T1,S.DEVIC ;Yes- get the name
MOVEM T1,LOGNAM ;Store it where we can find it
;Check on /EXCLUSIVE (alias /SINGLE) and /SHARE
;/EXCLUSIVE option declares that exclusive ownership is requested
;/SHARE says it isn't - these are mutually exclusive
MOUS.8: SKIPG S.EXCLU ;/EXCLUSIVE typed?
JRST MOUS.9 ;No
SKIPLE S.SHARE ;/SHARE as well?
N$FATE(<CSS>,,<Conflicting switches /EXCLUSIVE and /SHARABLE specified>)
MOVE T1,[SIXBIT |EXCLUS|]
PUSHJ P,DSKCHK ;Must be disk
TXO F,FL.EXC ;Set the flag
JRST MOUS.A ;Skip /SHARE code
MOUS.9: SKIPG S.SHARE ;/SHARE typed?
JRST MOUS.A ;No
MOVE T1,[SIXBIT |SHARABLE|]
PUSHJ P,DSKCHK ;Must be disk
TXZ F,FL.EXC ;Clear Exclusive
;/LABEL-TYPE option
MOUS.A: SKIPG S.LABEL ;Was /LABEL-TYPE specified?
JRST MOUS.B ;No
MOVE T1,[SIXBIT |LABEL|] ;Get error prefix
PUSHJ P,TAPCHK ;Must be a tape request
MOVE T1,S.LABEL ;Get the keyword offset
SUBI T1,1 ;Back off by 1
MOVE S1,TLBTAB(T1) ;Get the label-type
CAXN S1,%TFLBP ;Was it BYPASS?
TXO F,FL.BYP ;Yes..set the flag
TXO F,FL.LAB ;Note that something was said
MOVEI S2,.TMLT ;Create label type entry
PUSHJ P,ADDSUB ;Store in the message
;/WRITE-ENABLE (alias /WENABLE) and /READ-ONLY (alias /WLOCK and /RONLY)...
MOUS.B: SKIPGE T1,S.WRITE ;/WRITE specified?
JRST MOUS.C ;No - then assume /READ
SKIPL S.READ ;/READ typed also?
CAME T1,S.READ ;Did they mean the same thing?
SKIPA ;Then it's OK, otherwise complain
N$FATE(<CSS>,,<Conflicting switches /WRITE-ENABLE and /READ-ONLY specified>)
JUMPE T1,MOUS.C ;Treat /WRITE:NO like /READ
TXO F,FL.WRT ;No - Light the bit
TXZ F,FL.WLK ;and extinguish the read-only bit
JRST MOUS.D ;and skip around the /READ code
;Here if /WRITE isn't lit - check for /READ
MOUS.C: SKIPLE S.READ ;/READ-ONLY?
JRST MOUSCC ;Yes - go light bits
JUMPN T1,MOUSCD ;Default from disk/tape if not /WRITE:NO
MOUSCC: TXO F,FL.WLK ;Yes - Light /READ in flags
TXZ F,FL.WRT ;and turn off /WRITE
JRST MOUS.D ;and check next switch
;Here to set correct defaults in absence of /READ or /WRITE
;Write-enable disks, write-lock tapes.
MOUSCD: TXNE F,FL.DSK ;Is it a disk request?
JRST [TXO F,FL.WRT ;Yes - write-ENABLE is the default
TXZ F,FL.WLK ;Turn off /READ
JRST MOUS.D] ;and go on
TXNN F,FL.TAP ;Is it tape?
JRST MOUS.D ;No - check next switch
TXO F,FL.WLK ;Turn on /READ
TXZ F,FL.WRT ;Turn off /WRITE
;fall through to MOUS.D
;Check for /NEW-VOLUME-SET or /SCRATCH
MOUS.D: SKIPG S.NEWVOL ;/NEW-VOLUME-SET lit?
JRST MOUS.E ;No
SKIPLE S.SCRATCH ;Is /SCRATCH lit too?
N$FATE(<CSS>,,<Conflicting switches /NEW-VOLUME-SET and /SCRATCH specified>)
MOVE T1,[SIXBIT |NEW-VOLUME-SET|] ;Get error prefix
PUSHJ P,TAPCHK ;Tape requests only
TXO F,FL.NEW ;Set the flag
TXZ F,FL.SCR ;and put out /SCRATCH
TXO F,FL.WRT ;Also light /WRITE
TXO F,FL.WLK ;and turn off /READ
JRST MOUS.F ;Go around /SCRATCH
;/SCRATCH
MOUS.E: SKIPG S.SCRATCH ;/SCRATCH lit?
JRST MOUS.F ;No
SKIPLE S.NEWVOL ;Is /NEW-VOLUME-SET lit too?
N$FATE(<CSS>,,<Conflicting switches /SCRATCH and /NEW-VOLUME-SET specified>)
MOVE T1,[SIXBIT |SCRATCH|] ;Get error prefix
PUSHJ P,TAPCHK ;Must be tape
TXO F,FL.SCR ;Set the flag
TXZ F,FL.NEW ;and turn off /NEW just to be sure
TXO F,FL.WRT ;Also light /WRITE
;/WAIT
MOUS.F: MOVE T1,S.WAIT ;Get /WAIT
JUMPL T1,MOUS.G ;Defaulted unless .gt. 0
JUMPG T1,[TXO F,FL.WAT ;Turn on bit
TXO F,FL.NOT ;Also assume /NOTIFY
JRST MOUS.H] ;Go look for more
TXZ F,FL.WAT ;/NOWAIT was typed
;
;/NOTIFY option
MOUS.G: MOVE T1,S.NTF ;Get /NOTIFY
JUMPL T1,MOUS.H ;Jump if defaulted
JUMPG T1,[TXO F,FL.NOT ;Light bit
JRST MOUS.H] ;Go for more
TXZ F,FL.NOT ;/NONOTIFY was typed
;/PROTECTION
MOUS.H: LOAD T1,O.MOD,FX.PRO ;GET USER SPECIFIED PROTECTION
CAIG T1,0 ;DID HE SAY /PROT at all?
JRST MOUS.I ;No
MOVE T1,[SIXBIT |PROTEC|] ;Get error prefix
PUSHJ P,TAPCHK ;Must be tape
LOAD T1,O.MOD,FX.PRO ;GET USER SPECIFIED PROTECTION
SKIPN T1 ;NOT SPECIFIED?
SETOM T1 ;YES, SHOW NO CHANGE
MOVE S1,T1 ;Put into P1
MOVEI S2,.TMVPR ;Create protection entry
PUSHJ P,ADDSUB ;Store in the message
;/QUOTA
MOUS.I: SKIPG S.QUOTA ;Was /QUOTA typed?
JRST MOUS.J ;No
MOVE T1,[SIXBIT |QUOTA|] ;Get error prefix
PUSHJ P,DSKCHK ;Must be dsk
TXO F,FL.QTA ;Set the quota flag
;/REMARK
MOUS.J: SKIPN S.REMAR ;Was a /REMARK or /VID given?
JRST MOUS.K ;No
TXO F,FL.REM ;Yes - Remember we saw it
HRLI T1,REMLEN+1 ;Get remark string length
HRRI T1,.TMRMK ;and the entry type
MOVEM T1,S.RMHDR ;Store in the header
MOVEI S1,S.RMHDR ;Get its address
MOVEI S2,REMLEN+1 ;And its length
PUSHJ P,CPYSUB ;Create .TMRMK subentry
;/TRACKS
MOUS.K: SKIPG S.TRACK ;/TRACK specified?
POPJ P, ;No, we're all done
MOVE T1,[SIXBIT |TRACKS|] ;Yes, Get error prefix
PUSHJ P,TAPCHK ;Must be tape
TXO F,FL.TRK ;Set /TRACK: flag
MOVE T1,S.TRACK ;Get the index
SUBI T1,1 ;Decrement it by 1
MOVE S1,TRATAB(T1) ;Get the value
MOVEI S2,.TMDRV ;And the type
PUSHJ P,ADDSUB ;Store in the message
MOUS.L: POPJ P, ;and go home!
SUBTTL MO$VOL - Process a /VOLID switch from SCAN
; - called by SCAN to process a /VOLID:(mumble,mumble).
;
MO$VOL: MOVE T1,VOLCNT ;Get the count of volumes seen
CAIL T1,^D64 ;Are we already filled with volids?
N$FATE (<TMV>,,<Too many volume identifiers specified>)
PUSH P,T1 ;Save T1 around call
PUSHJ P,.SIXSW## ;Get a volid into N
POP P,T1 ;Get T1 back
JUMPE N,[N$FATE(<NVI>,,<Null volume identifier is illegal>)]
MOVEM N,VOLIDS(T1) ;Store the volume name
AOS VOLCNT ;Increment volume count
POPJ P, ;Return
SUBTTL MOUNT-class general routines
;ADDARG - Routine to add a 2 word argument to general message
;ADDSUB - Routine to add a 2 word subentry argument to MOUNT message
;ACCEPTS S1/ Data word to be stored in message
; S2/ argument type code
; P1/ Address of message header
; P5/ Address of first free word in message
; P6/ Address of current mount entry
ADDARG::
AOSA .OARGC(P1) ;Increment message arg count
ADDSUB::
INCR .MECNT(P6) ;Increment subargument count
MOVEM S1,ARG.DA(P5) ;Store data word
HRLI S2,ARG.SZ ;Get size of 2
MOVEM S2,ARG.HD(P5) ;Store in header
ADDI P5,ARG.SZ ;Point to next free word
$RETT
;CPYARG - Routine to copy argument to general message
;CPYSUB - Routine to copy subargument to MOUNT message
;ACCEPTS S1/ Address of argument header word
; S2/ Number of words in argument
; P6/ Address of subargument count
;RETURNS S2/ Address of argument header in message
; P5/ Address of next free in message
CPYARG::
AOSA .OARGC(P1) ;Increment message arg count
CPYSUB::
INCR .MECNT(P6) ;Increment subargument count
MOVS S1,S1 ;Create BLT pointer
HRR S1,P5
ADD S2,P5 ;Get Next Free address
BLT S1,-1(S2) ;Copy the whole argument
EXCH P5,S2 ;P5 points to next free address
$RETT ;S2 points to stored argument
;CPYSTR - routine to store asciz string
;ACCEPTS S1/ Pointer to source string
; S2/ Pointer to destination string
CPYSTR::
ILDB TF,S1
IDPB TF,S2
JUMPN TF,CPYSTR
$RETT
;TAPCHK - routine to ensure that we are processing a tape request
;DSKCHK - routine to ensure that we are processing a disk request
;ACCEPTS S1/ Pointer to error prefix
TAPCHK: TXNE F,FL.DSK ;Disk request?
JRST [MOVE N,T1 ;Yes - get switch into N
N$FATE (<SVT>,<N>,<Switch is only valid for tape: />)]
TXO F,FL.TAP ;Remember we have a tape request
$RETT
DSKCHK: TXNE F,FL.TAP ;Tape request?
JRST [MOVE N,T1
N$FATE (<SVD>,<N>,<Switch is only valid for disk: />)]
TXO F,FL.DSK ;Remember we have a disk request
$RETT
;LOGCHK - check and add LOGICAL name to mount request
LOGCHK: SKIPN S1,LOGNAM ;See if logical name
$RETT ;No--Just return
TXNE F,FL.DSK ;Disk request?
JRST LOGC.1 ;Yes--No logical name
PUSH P,N ;Save N for a sec
MOVE N,S1 ;Copy the name into N
DEVCHR S1, ;See if logical name in use
JUMPE S1,LOGC.2 ;No--Thats OK
TXNN S1,DV.ASC!DV.ASP ;Assigned by console or program?
JRST LOGC.2 ;No
N$WARN (<LAU>,<N>,<Specified logical name already in use:>) ;Yes--Tell him
MOVX S1,<INSVL.(.FORED,FO.FNC)!FO.ASC>;Get a new channel
MOVEM S1,FBLK+.FOFNC ;Store
SETZM FBLK+.FOIOS ;No mode
MOVE S1,LOGNAM ;Get device
MOVEM S1,FBLK+.FODEV ;Store device
SETZM FBLK+.FOBRH ;And no buffers
MOVE S1,[.FOBRH+1,,FBLK] ;Point to FILOP.
FILOP. S1, ;Open the device
JRST LOGC.2 ;Cant
LOAD S1,FBLK+.FOFNC,FO.CHN ;Get channel
MOVEI S2,0 ;Clear logical name
DEVLNM S1, ;Zap it
JFCL ;We tried
MOVX S1,.FOREL ;Release function
STORE S1,FBLK+.FOFNC,FO.FNC ;Store it
MOVE S1,[1,,FBLK] ;Point to FILOP.
FILOP. S1, ;Release channel
JFCL ;Cant
LOGC.2: MOVE S1,LOGNAM ;Get logical name
MOVX S2,.TMLNM ;And block type
PUSHJ P,ADDSUB ;Add it
POP P,N ;Restore N
$RETT ;And return
LOGC.1: $RETT ; return
SUBTTL BLDVSN - Build volume-set name into a MOUNT message block
; Routine to build a volume set name into a MOUNT message block
; Call: PUSHJ P,BLDVSN
; <return>
;
; If the VSN is a generic device, then a VSN of DEV-xxxxxx (where xxxxxx
; is a random alpha-numeric value guaranteed to be unique) will be created.
; Otherwise, the existing VSN will be used.
;
BLDVSN: MOVEI TF,0 ;Clear character count
MOVEI S1,.TMSET ;Get subentry type
STORE S1,ARG.HD(P5),AR.TYP ;Store it
INCR .MECNT(P6) ;Increase subargument count
MOVEI S2,@VSNADR ;Get string address - ARG.DA
HLL S2,[POINT 7,0] ;Get byte pointer to read characters
MOVEI T1,ARG.DA(P5) ;Get storage address
HRLI T1,(POINT 7) ;Make a byte pointer
BLDV.1: ILDB S1,S2 ;Get a character
JUMPE S1,BLDV.2 ;Done ?
CAIL S1,"a" ;Greater than a?
CAILE S1,"z" ;and Less than z?
SKIPA ;No, do nothing to it
SUBI S1,40 ;Yes, make upper case
PUSHJ P,BLDV.C ;Store it
JRST BLDV.1 ;Loop back for another
BLDV.2: TXNE F,FL.GDV ;Generic device ?
PUSHJ P,BLDV.3 ;Yes - generate a special VSN
MOVX S1,.CHNUL ;Get a <NUL>
PUSHJ P,BLDV.C ;Store it
IDIVI TF,5 ;Count words in the VSN
ADDI TF,ARG.DA+1 ;Round up to the next full word
HRLM TF,(P5) ;Update word count
ADD P5,TF ;Get new first free word pointer
POPJ P, ;Return
BLDV.3: TXNN F,FL.MOU ;If ALLOCATE,,thats an error
N$FATE (<IVA>,,<Illegal volume set name specified for MOUNT/ALLOCATE command>)
MOVEI S1,"-" ;Get a funny character
PUSHJ P,BLDV.C ;Store it
MOVX S1,%CNDTM ;Get universal date/time
GETTAB S1, ;Do it
N$FATE(<GTF>,,<GETTAB for Universal Date/Time failed>)
MOVEI T2,6 ;Only 6 characters
BLDV.4: IDIVI S1,^D36 ;Radix 36
PUSH P,S2 ;Save the remainder
SOSE T2 ;Count characters
PUSHJ P,BLDV.4 ;Recurse if not done
POP P,S1 ;Get a digit
ADDI S1,"0" ;Make it ASCII
CAILE S1,"9" ;A number ?
ADDI S1,"A"-"9"-1 ;No - make it a letter
BLDV.C: IDPB S1,T1 ;Store it
ADDI TF,1 ;Count characters
POPJ P, ;Return
SUBTTL BLDVSN - Support routines
;UNICHK - routine to ensure uniqueness among argument entries
;ACCEPTS S1/ Address of argument header
UNICHK: LOAD T2,ARG.HD(S1),AR.LEN ;Get argument length
MOVE T1,S1 ;Save beginning address
ADDI T2,-1(S1) ;Compute end test address
UNICH1: ADDI T1,1 ;Compute next address
CAML T1,T2 ;Done?
$RETT ;Yes..all are unique
MOVEI S2,1(T1) ;S2 points to comparision entry
MOVE S1,0(T1) ;Get entry to check
UNICH2: CAMLE S2,T2 ;Finished checking this entry?
JRST UNICH1 ;Yes..back for next
CAME S1,0(S2) ;No..is it unique?
AOJA S2,UNICH2 ;Yes..back to check next entry
$RETF ;No..return the failure
;DEVCHK - routine to ensure device string is valid
;ACCEPTS S1/ Pointer to device name string
;RETURNS S1/ Device type (.TYDSK or .TYMTA)
; S2/ Sixbit device name (abbrv of name string)
;ERRORS ER$IDN Invalid device name
; ER$NSD No such device
; ER$USD Unsupported device
; ER$EZD Ersatz device
; ER$PLD Pathological device
; ER$ASN Ambigious structure name
; ER$ISN Illegal structure name
; ER$GDN Generic device name
DEVCHK: PUSHJ P,S%SIXB ;Convert to sixbit
ILDB S1,S1 ;Get terminator
JUMPN S1,[$RETER(ER$IDN)] ;Invalid device name
PUSHJ P,.SAVE3##
MOVE P1,S2 ;Save the device name
MOVE TF,[1,,P1] ;Yes, get DSKCHR parms
DSKCHR TF, ;Get structure status bits
JRST DEVC.1 ;Not a disk
LOAD TF,TF,DC.TYP ;Get the device type
CAXN TF,.DCTAB ;Ambigious?
$RETER(ER$ASN) ;Yes, say so
CAXE TF,.DCTUF ;Unit within strcuture?
CAXN TF,.DCTCN ;Controller class?
$RETER(ER$ISN) ;Yes, illegal structure
CAXE TF,.DCTCC ;Controller class?
CAXN TF,.DCTPU ;Physical unit?
$RETER(ER$ISN) ;Yes, illegal structure
CAXN TF,.DCTDS ;Generic or ersatz?
JRST DEVC.2 ;Yes, check it out some more
MOVX S1,.TYDSK ;Its a disk
$RETT ;And return
DEVC.2: MOVE TF,[3,,P1] ;Get PATH. args
PATH. TF, ;Find out some more
$RETT ;Ignore any error
TXNE P2,PT.DLN!PT.EDA ;Pathological name?
$RETER(ER$PLD) ;Yes, say so
TXNE P2,PT.IPP ;Implied PPN? (ersatz)
$RETER(ER$EZD) ;Yes, say so
$RETER(ER$GDN) ;Else call it generic
DEVC.1: MOVE P3,S2 ;Make another copy of device name
DEVTYP P3, ;Get device type
$RETER(ER$NSD) ;Unknown device
JUMPE P3,[$RETER(ER$NSD)] ;Unknown device
TXNE P3,TY.GEN ;A generic device ?
TXO F,FL.GDV ;Yes - remember it
LOAD S1,P3,TY.DEV ;Load the device type
CAIE S1,.TYMTA ;Is it a tape??
$RETER(ER$USD) ;No,,Unsupported device
;(DSKCHR would win if a disk)
$RETT ;Yes,,return
SUBTTL LGICHK - Check to see if the job is logged in
;
;LGICHK will see if the job is logged in (JOBSTS bit JB.ULI lit) and
;will abort the program if it isnt.
;
;Calling sequence:
;
; PUSHJ P,LGICHK
; only return
;
;The routine will NOT return if the job is not logged in.
;
;Uses: T1
;
LGICHK: PJOB T1, ;GET MY JOB NUMBER
MOVN T1,T1 ;NEGATE IT
JOBSTS T1, ;GET THE STATUS
SKIPA ;CANT -- STUPID MONITOR, ASSUME OK
TXNE T1,JB.ULI ;LOGGED IN JOB?
POPJ P, ;YES -- RETURN
N$FATE (<INI>,,<Command is illegal when not logged in>)
SUBTTL Literals and low-segment storage
XLIST ;LITERALS
LIT
LIST
SWSEG ;SWITCH TO LOW SEG
LOWFWA:! ;START OF LOW DATA AREA
SAVCOR: BLOCK 1 ;INITIAL VALUE OF LOW SEG CORE SIZE
MADFIL: BLOCK 1 ;WE DUMMIED UP A FILESPEC FLAG
STRTOF: BLOCK 1 ;STARTING ADDRESS OFFSET
ZCOR:! ;START OF AREA TO ZERO ON INITIAL LOAD
PDLST: BLOCK LN$PDL+1 ;PUSH-DOWN LIST
OPNBLK: BLOCK 3 ;OPEN BLOCK
LKBLK: BLOCK 1 ;EXTENDED LOOKUP BLOCK
RIBPPN: BLOCK 1 ;DIRECTORY
RIBNAM: BLOCK 1 ;FILE NAME
RIBEXT: BLOCK 1 ;FILE EXTENSION
RIBPRV: BLOCK 1 ;PROTECTION WORD
RIBSIZ: BLOCK 1 ;FILE SIZE
BLOCK 1 ;JUNK
RIBSPL: BLOCK 1 ;SPOOLING NAME
BLOCK 6 ;JUNK
RIBDEV: BLOCK 1 ;LOCATION OF FILE (LOGICAL UNIT)
LKBLKL==.-LKBLK
P.ZER:! ;START OF AREA FOR FILE DEFAULTS
P.MOD: BLOCK 1 ;LAST STICKY FILE SWITCHES TYPED BY USER
P.MODM: BLOCK 1 ;LAST STICKY FILE SWITCHES MASK TYPED BY USER
P.EZER==.-1
P.MIN:!
P.STRT: BLOCK 1 ;LAST STICKY FILE STARTING POINT
P.RPT: BLOCK 2 ;LAST STICKY REPORT NAME
P.FONT: BLOCK FNMLTH ;LAST STICKY FONT NAME (30 CHARS MAX)
P.EMIN==.-1
F.ZER:! ;START OF AREA FOR FILE TYPE-INS
F.MOD: BLOCK 1 ;FILE SWITCHES
F.MODM: BLOCK 1 ;FILE SWITCH MASK (ON IF TYPED)
F.EZER==.-1
F.MIN:!
F.STRT: BLOCK 1 ;FILE STARTING POINT
F.RPT: BLOCK 2 ;/REPORT KEY
F.FONT: BLOCK FNMLTH ;FONT NAME (30 CHARS MAX)
F.EMIN==.-1
;GETTAB INFO
;
G$NAM1: BLOCK 1 ;FIRST HALF OF USER'S NAME
G$NAM2: BLOCK 1 ;SECOND HALF OF USER'S NAME
G$CMAX: BLOCK 1 ;SYSTEM CORMAX
G$MNMX: BLOCK 1 ;MINMAX
S.ZER:!
COMDEV:BLOCK 1 ;COMMAND-DEVICE FOR CURRENT REQUEST
QTYPE: BLOCK 1 ;QUEUE TYPE FOR CURRENT REQUEST
OSCNML: BLOCK 2 ;COMMANDS FOR .OSCAN
DEFFIL: BLOCK .FXLEN ;/PATH:[DIRECTORY]
DEFDIR=DEFFIL+.FXDIR
O.ZER:! ;START OF OUTPUT SPEC STORAGE
O.DEV: BLOCK 1 ;DEVICE
O.NAM: BLOCK 1 ;NAME
O.NAMM: BLOCK 1 ;NAME MASK
O.EXT: BLOCK 1 ;EXT,,MASK
O.MOD: BLOCK 1 ;SCAN SWITCHES
O.MODM: BLOCK 1 ;SCAN SWITCH MASK
O.DIR: BLOCK 1 ;DIRECTORY
O.DIRM: BLOCK 2*.FXLND-1 ;DIRECTORY MASK
O.LZER==.-O.ZER
L.OPEN: BLOCK 3 ;LISTING FILE OPEN BLOCK
L.LOOK: BLOCK LN$ENT ;LISTING FILE LOOKUP BLOCK
L.PATH: BLOCK .PTMAX ;LISTING FILE PATH BLOCK
L.DSKC: BLOCK LN$DSK ;LISTING FILE DSKCHR BLOCK
L.OTYO: BLOCK 1 ;LISTING FILE OLD TYPE OUT ROUTINE
L.STAT: BLOCK 1 ;LISTING FILE CHANNEL STATUS
L.PNTR: BLOCK 1 ;LISTING FILE BYTE POINTER TO LIST MESSAGE
PTHFCN: BLOCK .PTMAX ;PATH. ARGS
PTHPPN=PTHFCN+.PTPPN
PTFFCN: BLOCK .PTMAX ;FILE PATH BLOCK
PTFPPN=PTFFCN+.PTPPN
PTHBLK: BLOCK .PTMAX ;MORE PATH SPACE
I.INZR: BLOCK 1 ;INITIAL INPUT SPEC STORAGE
I.NXZR: BLOCK 1 ;POINTER TO NEXT INPUT SPEC STORAGE
I.LSZR: BLOCK 1 ;POINTER TO LAST INPUT SPEC STORAGE
S.EZER==.-1
T.ZER:! ;START OF TEMPORARY DATA AREA
NOBLKS:BLOCK 1 ;ACCUMULATED NUMBER OF BLOCKS TO BE PROCESSED
CREFLG: BLOCK 1 ;FLAG 0 IF CREATE, -1 IF NOT
DQTYPE: BLOCK 1 ;WORD TO STORE OUTPUT QUEUE TYPE
; FOR SUBMIT,PUNCH ...
COMIDX: BLOCK 1 ;INDEX INTO QCOMS RETURNED BY ISCAN
LSTQUE: BLOCK 1 ;BITS FOR QUEUE TO LIST
LSTNOD: BLOCK 1 ;NODE NAME FOR QUEUE TO LIST
LSTUNT: BLOCK 1 ;UNIT NUMBER FOR QUEUE TO LIST
LSTUTY: BLOCK 1 ;UNIT TYPE
T.EZER:!
;BUFFER POINTERS
;
B.LC: BLOCK 3 ;LISTING FILE
QSRPID: BLOCK 1 ;PID OF SYSTEM QUASAR
INFPID: BLOCK 1 ;PID OF SYSTEM INFO
RTYCNT: BLOCK 1 ;RETRY COUNTER WHEN SEND TO QUASAR FAILS
FSTMSG: BLOCK 1 ;ADDR OF FIRST LISTANSWER OR CREATE MESSAGE
NUMANS: BLOCK 1 ;NUMBER RECEIVED OR TO BE SENT
ACKCOD: BLOCK 1 ;ACKCOD FOR KEEPING IN SYNCH
FDCSTR: BLOCK 1 ;CONTROL FILE STRUCTURE
STRBLK: BLOCK 5 ;AREA FOR DETERMINING STR FROM UNIT
FOFBLK: BLOCK .FOFMX ;SPACE TO READ FILE SPEC
SHTMSG: BLOCK PAGSIZ ;USED TO SEND/RECEIVE "SHORT" MESSAGES
;MOUNT/ALLOCATE STORAGE
JOBNUM: BLOCK 1 ;My Job number
USRNUM: BLOCK 1 ;My user number
USRACK: BLOCK 1 ;ACK for messages
ACKCNT: BLOCK 1 ;Number of ACKS expected
ITMCNT: BLOCK 1 ;Count of times we've been through the
;dismount code for non-QUASAR devices
DEFSWS: BLOCK 1 ;Default switches for parse
MSGADR: BLOCK 1 ;Address of recieved message
BLKADR: BLOCK 1 ;Address of current message block
BLKCNT: BLOCK 1 ;Count of remaining message blocks
PACKET: BLOCK PAKSIZ ;Storage for message
OPRNOT: BLOCK 3 ;QUEUE. UUO BLOCK FOR /VID ** DON'T SEPARATE **
VIDBLK: BLOCK 1 ;" " "
VIDADR: BLOCK 1 ;" " "
VIDPTR: BLOCK 1 ;" " "
VIDCHR: BLOCK .DCUPN+1 ;DSKCHR arg block
LOGNAM: BLOCK 1 ;Logical name
FBLK: BLOCK .FOMAX ;FILOP. UUO block
VSNAME: BLOCK 1 ;6bit Volume set name
VSNDEV: BLOCK 1 ;6 bit device name
VSNADR: BLOCK 1 ;Address of ASCIZ Volume set name argnt
CMDNAM: BLOCK 1 ;Address of parsed command name
SAVEC: BLOCK 1 ;HOLDER FOR P4/C
REPARS: BLOCK 1 ;REPARSE COUNT
VOLSIZ: BLOCK 1 ;SIZE OF VOLUME-SET STRING
VOLPTR: BLOCK 1 ;SAVED COPY OF AOBJN POINTER TO VOLUME-IDS
VOLSHD: BLOCK 1 ;HEADER WORD FOR VOLSET KEEP\
VOLSET: BLOCK ^D30 ;VOLUME-SET NAME HOLDER THESE|
VOLIDS: BLOCK ^D63 ;VOLUME IDS ALL|
VOLCNT: BLOCK 1 ;COUNT OF VOLIDS SEEN TOGETHER/
MSGBLK: BLOCK 1 ;COPY OF M (POINTER TO MESSAGE PAGE)
MSGTYP: BLOCK 1 ;COPY OF MESSAGE TYPE FOR REFERENCE
EZCOR==.-1 ;END OF AREA TO ZERO
PHASE .FXLEN ;SCAN'S AREA
I.MOD:! BLOCK 1 ;SWITCHES
I.MODM:!BLOCK 1 ;SWITCH MASK (ON IF USER SUPPLIED)
I.STRT:!BLOCK 1 ;FILE STARTING POINT
I.RPT:! BLOCK 2 ;/REPORT SWITCH
I.FONT:!BLOCK FNMLTH ;FONT NAME (30 CHARS MAX)
I.LZER::!
DEPHASE
END QUEUE