Google
 

Trailing-Edge - PDP-10 Archives - BB-L014Y-BM_1990 - galsrc/mountr.mac
There are 35 other files named mountr.mac in the archive. Click here to see a list.
TITLE	MOUNTR
SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.


; Required UNV and REL files

	SEARCH MTRMAC
	SEARCH MONSYM,MACSYM,ACTSYM,SERCOD,GLXMAC,QSRMAC,ORNMAC,NEBMAC
	.REQUIRE SYS:MACREL
SUBTTL Version Information
; Version Information

	MTRVER==6		;MAJOR VERSION #
	MTRMIN==0		;MINOR VERSION #
	MTRMAN==6040		;Maintenance edit level
	MTRDEV==6032		;Development edit level
	MTRWHO==0		;GROUP WHO LAST EDITED (0=DEC DEVELOPMENT)

	VERSIN (MTR)		;Generate version number

	EXTERNAL CFSMAN,CFSDEV,CFSEDT,USRMAN,USRDEV,USREDT

;  Externals used from MTRDDB

	EXTERNAL DSFINI		;Initialize disk data base
	EXTERNAL DSFUDE		;Update disk entry
	EXTERNAL DSFGET		;Get disk entry
	EXTERNAL DSFGNX		;Get next entry of specific type
	EXTERNAL DSFCRE		;Create disk entry
	EXTERNAL DSFLOC		;Locate disk entry
	EXTERNAL DSFNUP,DSFYUP	;Routines to stop/start updating of DDB
	EXTERNAL DSFDLE		;Delete disk entry

	EXTERNAL DSFE
	EXTERNAL PRTINI,CFSCHK

	MTRVER==<VRSN.(MTR)>+CFSEDT+USREDT+MACEDT

MTRVEC:	BLDVEC (MOUNTR,MTR,L)
	BLDVEC (MTRCFS,CFS)
	BLDVEC (MTRUSR,USR)
	BLDVEC (MTRMAC,MAC,L)
	BLDVEC (GLXMAC,GMC,L)
	BLDVEC (ORNMAC,OMC,L)
	BLDVEC (QSRMAC,QMC,L)

	EXTERN .JBOPS		;JOBDAT CELL COMMANDEERED FOR TEST FLAG
	EXTERN .JBSA		;LH/ ADDR OF 1ST LOCATION AFTER PROGRAM
	EXTERN .JBSYM		;POINTER TO SYMBOL TABLE FOR DDT
	EXTERN .RLEND		;LAST LOCATION IN MACREL

	SALL
	.DIRECTIVE FLBLST	;SUPPRESS ASCIZ MACHINE CODE EXPANSION
	SUBTTL	Table of Contents


;		Table of Contents for MOUNTR
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Version Information. . . . . . . . . . . . . . . . . .    2
;   3. Table of Contents. . . . . . . . . . . . . . . . . . .    3
;   4. Edit history . . . . . . . . . . . . . . . . . . . . .    4
;   5. PREFACE. . . . . . . . . . . . . . . . . . . . . . . .    5
;   6. MODIFYABLE DATA AREA . . . . . . . . . . . . . . . . .    9
;   7. STORAGE AREA FOR USAGE DATA. . . . . . . . . . . . . .   10
;   8. STATIC DATA AREA . . . . . . . . . . . . . . . . . . .   11
;   9. INITIALIZATION . . . . . . . . . . . . . . . . . . . .   17
;  10. SERVICE SCHEDULER (SS) . . . . . . . . . . . . . . . .   18
;  11. ACCOUNTING ROUTINES. . . . . . . . . . . . . . . . . .   21
;  12. AVR - AUTOMATIC VOLUME RECOGNITION . . . . . . . . . .   27
;  13. DECTAPE SUPPORT. . . . . . . . . . . . . . . . . . . .   36
;  14. IPCF SEND AND RECEIVE. . . . . . . . . . . . . . . . .   39
;  15. LABELED TAPE INITIALIZATION. . . . . . . . . . . . . .   47
;  16. OPERATOR INTERFACE . . . . . . . . . . . . . . . . . .   52
;  17. QUASAR INTERFACE . . . . . . . . . . . . . . . . . . .   85
;  18. STRUCTURE ROUTINES . . . . . . . . . . . . . . . . . .   95
;  19. Update all disks
;       19.1.   Flow of update. . . . . . . . . . . . . . . .   96
;       19.2.   DDSCIH - Update all disk drives . . . . . . .   97
;       19.3.   DSTINI - Initialize MSTR block for scanning units   98
;       19.4.   DSTNXT - Get status of the next disk. . . . .   98
;       19.5.   DSTSRC - LOOK FOR THE DISK ENTRY MATCHING SPECIFIED CKU NUMBERS   99
;       19.6.   DDSNEW - Add new disk to data bases . . . . .  100
;       19.7.   DDSCHK - Check disk already existing. . . . .  101
;       19.8.   DDSDEL - DELETE STRUCTURE INFORMATION ABOUT A DISK 102
;       19.9.   DDSADD - ADD A DISK COMING ON-LINE. . . . . .  103
;       19.10.  STRINF - Store/check structure information. .  104
;       19.11.  STRGSB - GET STRUCTURE STATUS BLOCK (BUILD ONE IF NECESSARY) 107
;       19.12.  STRDSM - Dismount structure data base . . . .  108
;       19.13.  DDSMCH - MATCH USER REQUEST TO MOUNTS AND DISMOUNTS  109
;       19.14.  DSTDDB - Delete STructure DDB . . . . . . . .  110
;  20. Disk Routines
;       20.1.   DSKINI - Disk initialization routine. . . . .  111
;       20.2.   DSTGIV - Get status for a given unit. . . . .  112
;  21. KSDK - Set disk-drive command from OPR . . . . . . . .  113
;  22. KDSM - PROCESS DISMOUNT STRUCTURE COMMAND FROM OPR . .  114
;  23. KSHD - SHOW DISK STATUS COMMAND FROM OPR . . . . . . .  115
;  24. - DSKDSP - Print any special messages. . . . . . . . .  116
;  25. KSHS - SHOW STATUS STRUCTURE command from OPR. . . . .  117
;  26. STRDSP - Print any special messages. . . . . . . . . .  118
;  27. SHSTR - Show status for a particular structure . . . .  119
;  28. SHSMAC - Adds a user who has mounted or connected or accessing a structure to the SHO STA STR FOO: command. 120
;  29. SHWSTR - Show status for a single structure. . . . . .  121
;  30. - SHWCON
;       30.1.   Indicates structure status conflicts. . . . .  122
;  31. Process set structure (KSST)
;       31.1.   Initialize processing of command. . . . . . .  123
;       31.2.   Set the database (DDB). . . . . . . . . . . .  124
;       31.3.   Set structure correctly in monitor. . . . . .  125
;  32. KSST
;       32.1.   Data base for setable characteristics . . . .  126
;  33. STSTR - SeT STRucture. . . . . . . . . . . . . . . . .  127
;  34. KSUD - Undefine structure. . . . . . . . . . . . . . .  128
;  35. UPDSTR - Update structure. . . . . . . . . . . . . . .  129
;  36. Determine-new-string routine (NEWSTA)
;       36.1.   Determine STRFLG based on MOUNTR and disk status 131
;  37. CHKAVA - Check SSB disk drives for available/unavailable  132
;  38. SSB routines
;       38.1.   SSBINI - Initialize SSB data base . . . . . .  133
;       38.2.   SSBCRE - Create a new SSB entry (zeroed). . .  133
;       38.3.   SSBRET - Return SSB entry to free SSB pool. .  133
;       38.4.   SSBNXT - Get next SSB . . . . . . . . . . . .  134
;       38.5.   MATCHS - Match request to structure (old) . .  135
;  39. ISTDDB - Initialize structure DDB. . . . . . . . . . .  137
;  40. MESCHK - CHECK IF MESSAGE FOR STRUCTURE ALREADY SENT TO OPERATOR  138
;  41. MNTALL - MOUNT ALL STRUCTURES NOT ALREADY MOUNTED. . .  139
;  42. OPRSB - SET UP REQUEST BLOCK FOR OPR MOUNT OR DISMOUNT COMMAND  140
;  43. PSDR - PARSE OPERATOR RESPONSE TO DISMOUNT MESSAGE WHEN OTHER JOBS  141
;  44. SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT . . .  142
;  45. SIXSEV - ROUTINE TO CONVERT SIXBIT TO ASCIZ. . . . . .  142
;  46. STRDMT - DISMOUNT A STRUCTURE (OPR>DISMOUNT STRUCTURE FOO:) 143
;  47. STRUNA - SET STR UNAVAILABLE . . . . . . . . . . . . .  145
;  48. Operator Communication . . . . . . . . . . . . . . . .  146
;  49. STRMNT - MOUNT A STRUCTURE . . . . . . . . . . . . . .  147
;  50. WOFRE - SET UP STRING CONTAINING INFORMATION ON FREE DRIVE  154
;  51. - WOINI
;       51.1.   Fills in the first five fields of the display  155
;  52. WOMDAV - TELL OPERATOR OF AVAILABILITY OF DISK DRIVE FOR SYSTEM USE 157
;  53. WOSM - TELL OPERATOR OF A STRUCTURE. . . . . . . . . .  158
;  54. USER TAPE MOUNT REQUEST. . . . . . . . . . . . . . . .  162
;  55. VOLUME/REQUEST ASSOCIATION LOGIC . . . . . . . . . . .  174
;  56. SUBROUTINES. . . . . . . . . . . . . . . . . . . . . .  185
;  57. STRSTT
;       57.1.   Returns the structure status. . . . . . . . .  222
SUBTTL	Edit history

Comment ^

*****	Release 4.2 -- Begin Maintenance Edits *****

154	4.2.1537	12-jan-83
	Add procedure procedure WTOCHK and calls to WTOCHK so that batch
jobs with /assistance:no will have any mount request requiring asistance 
disallowed.

155	4.2.1538	12-jan-83
	Increase number of requests allowed to 400

156	4.2.1539	13-jan-83
 	If the first mount request is canceled and the structure has not 
been mounted, make sure OPR gets mount request message on awaiting request.

157	4.2.1540	27-Jan-83
	Set or clear the correct bit in STRFLG(STR) when a change of structure
status occurs.  Also if operator refuse to dismount a structure, restore the 
structure status if there was no change.

160	4.2.1544	17-mar-83
	Add check for bad HOME or BAT blocks and inform operator.  Also check 
for disk in use by on-line diagnostic program before mount.

161	4.2.1549	14-Jun-83
	Change 1 line of edit 157 so that AC F will not get clobber if the 
structure is to be set unavailable.

162     4.2.1569	15-Mar-84
        Set the controller type field to zero in the usage records. Also set
the access type field to 1.

163	4.2.1575	3-May-84
	Do not crash if SYSTEM:INFO is not running when sending an IPCF message
message .Instead, inform the operator, sleep for 30 seconds and then attempt to
send another message.

164	4.2.1577	10-May-84
	When multiple tapes with numeric IDs are being initialized, cause 
MOUNTR to increment the next ID without asking the operator.

165	4.2.1583	25-Jul-84
	Do not abort tape mount requests if all the tape drives have been set
unavailable, instead queue the request and inform the operator that all the
tape drives are unavailable.

166	4.2.1588	21-Aug-84
	Create left justified tape numeric volume i.d.s with the OPR SET TAPE
INITIALIZE command.

167	4.2.1595	26-Sep-84
	Correct the way edit 163 searches and branches from table MTBL upon
an IPCF failure.

170	4.2.1600	10-Jan-85
	If a tape is initialized with leading zeros in its volume i.d.,
do not suppress them.

171	4.2.1606	29-Jan-85
	Do not reset the density of a tape drive when dismounting a tape.

172	4.2.1615	26-Apr-85
	Do not crash immediately upon a MUTIL% JSYS error when attempting to
get a system PID, instead try up to NTRY times before crashing.

*****	Release 5.0 -- Begin Development Edits *****

200	5.1000		3-jan-83
	Move to new development area.  Change to new edit history format.  
Change edit level designations to conform to new Galaxy standard.

201	5.1001		4-jan-83
	Support system/job default for tape drives instead of hardcoding a 
default of 1600

202	5.1005		10-jan-83
	Add version vector.

203	5.1015		4-MAR-83
	Move macro and data definitions to MTRMAC.  Add MTRCFS and MTRUSR to 
version vector.

204	5.1018		16-mar-83
	Move command table back to MOUNTR.  Add disk types for Ra80, Ra81, Ra60

205	5.1020		29-mar-83
	Due to increasing numbers of disks and tapes which are available to
TOPS-20, IPCF messages must be divided into packets with no more than wtomax 
(defined on ornmac) words of text.

206	5.1020		4-apr-83
	Need to count bytes of header as well as body of text when dividing 
ipcf messages into packets.

207	5.1022		7-apr-83
	Add check for CI port when outputting disk status display.  Abbreviate
oprtions in disk status display.

210	5.1029		24-may-83
	Add support for SET PORT command.  Enlarge filed for unit display to 4.
Make several routine labels global.

211	5.1030		22-june-83
	Modify structure dismount procedures for port operations.

212	5.1031		29-june-83
	Add calls to CFS dismount routines.

213	5.1032		30-june-83
	Add code to add or delete or replace a structure entry from the 
device-status data base.  MOUNTR will mount a structure based on status 
obtained from the device-status data base.

214	5.1033		6-july-83
	Add a call to routine CFSCHK in MTRCFS to see if we are in a CFS 
system.  The return value for CFSP is 0 for not CFS and 1 for CFS.

215	5.1040		30-Sep-83
	Redesign and rewrite the dismount code so that a dismount operation
and a dismount via a port operation can both use the common code and have each
operation handle the possible results from the dismount accordingly.

216	5,1044		14-Oct-83
	Add code to enforce the FORCE response from a port operation.  Make 
WOMDAV an external symbol.  Make sure we do not touch AC0 accidentally.

217	5.1052		31-Oct-83
	Add code to handle setting a structure exclusive.

220	5.1055		8-Nov-83
	Add code to support REMOVE/NOREMOVE function in DISMOUNT command

221	5.1056		14-Nov-83
	Fix code to handle setting a structure EXCLUSIVE while dismounting a
structure with REMOVAL in a CFS configuration and fix other bugs relating to 
DISMOUNTING a structure in a CFS configuration 	(REMOVAL/NOREMOVAL and default)

222	5.1054		15-Nov-83
	First change the above GCO# from 5.1054 to 5.1056.  Add code to set a 
structure exclusive.

223	5.1060		28-Nov-83
	Do not use SETFLG to check whether a port operation is FORCE.  Check
RSBIFL(RSB) bit R%REP.  If R%REP is set, a FORCE action is to be taken.

224	5.1062		29-Nov-83
	During start up, call a new routine, PRTINI, to check for port 
unavailability.

225	5.1065		9-Dec-83
	Fix bad test for exclusive in KSSER2.

226	5.1068		9-Dec-83
	Remove DSFxxx routines and move them to MTRDDB.  Since we
did that, a bad STOR instruction broke in PRTINI.  Fix that as well.

227	5.1079		4-Feb-84
	Lots of changes:
1.  Change all references to DDB routines to use new DDB routines.
2.  Add table of contents.
3.  Redo SHOW STATUS DISK DISPLAY
4.  Add SHOW STATUS STRUCTURE display.
5.  Add SHOW STATUS STRUCTURE FOO: display.
6.  Rearrange a number of the disk status update routines so they are together.
7.  Disable write protecting code because that gets in the way a lot.  We
    need to have storage in other modules and that is impossible with the
    current write protection scheme.
8.  Instead of using MSTRBK everywhere and having things get confused, make
    some additional locations to have MSTR argument blocks depending on the
    action occuring.
9.  For consistancy, make any bit referencing available 0 if available and 1 if
    unavailable.
10. In the DDSxxx routines, rearrange the logic to take advantage of the new
    DDB support.  In addition, make MOUNTR able to detect changes instead of
    simply accepting them, and correct some of them.  In all cases, inform
    the operator that the changes are occuring.
11. Change the management of the SSBs and create some routines to manage them:
    SSBINI - Initialize the SSB data base
    SSBCRE - Create a new SSB entry
    SSBRET - Return SSB entry to the free pool.
    SSBNXT - Get the next SSB entry.
12. Eliminate the old logic for ignore attribute.  The attribute is now
    included with the DDB entry for the structure.
13. Only mount all available structures during initialization if this is in
    CFS.
14. Rearrange the whole way we manage the unavailable attribute.  Besides a
    device being unavailable due to its attribute set, it may also be 
    unavailable due to another object that may affect it.
15. Support for new $STOP macro.

Lots of little things as well.  The above is the gist of things.

230	5.1081		6-Feb-84
	Add support for undefine structure command.

231	5.1082		6-Feb-84
	Use structure header instead of disk header for SHOW STATUS STRUCTURE.

232	5.1084		10-Feb-84
	Reformat the SHOW STA STR FOO: display. Only print one user for each
usage of the structure. Include the disk information.  The CKU is to be printed
in decimal.  Include an asterisk for dual ported disks.

233	5.1085		10-Feb-84
	Make sure the disk type field starts printing in colume 2.

234	5.1086		11-Feb-84
	If we are switching disk ports, always defer adding the new port info
until after deleting old port info.  Indicate need for second disk status pass
with flag AGAIN.  Set DSKSSA to minus one to indicate such an event is in 
progress for the disk and to prevent looping.

235	5.1087		11-Feb-84
	Unfortunatly, ABTRET takes up more than one word.  Skipping around
it doesn't make it.  JRST to it as a literal @MNTNXT+1.

236	5.1088		11-Feb-84
	Remove the code used to support MOUNTR.CMD.

237	5.1090		11-Feb-84
	Clear the pointer to the structure status block when forgetting the
structure in DDSDEL.

240	5.1091		11-Feb-84
	Add an extra CRLF to error message at DDSERR.

241	5.1096		14-Feb-84
	Add a check for offline, free and mounted before we print the state
of a disk.  Initialize TMCMSG before we print the "No disk available" message.

242	5.1097		14-Feb-84
	Write two subroutines (STRDSP, DSKDSP) to print special messages.

243	5.1100		17-Feb-84
	In routine WOMNT3 call DSFLOC to get the structure entry from the DDB.

244	5.1103		20-Feb-84
	In routine STRFND if we find the DSB pointer in the SSB already set,
then check if it is set to the current DSK before assuming a problem.

245	5.1104		20-Feb-84
	Clear STRPNT in DSTDDB.  Remove routine STRDME.  Call DSTDDB from
STRDMS.

246	5.1107		23-Feb-84
	In routine SHW1, get the conflicting bits in T1 before checking for 
status of structure.

247	5.1108		25-Feb-84
	Remove special casing in the dismount code.  Create and use ascii
string DSMHDR for dismount query.  Move test for Ignore until after the
status has been updated.  Remove confused code from WOVDS.

250	5.1109		27-Feb-84
	Add more bad bits to check for at STRIN2.  Add information to the
display to say which bad bits are set.  Move STRIN7 label down some lines to
skip over code to set up DDB info for the structure.

251	5.1110		28-Feb-84
	Add message to show status structure indicating structure
is exclusive due to port operation.  Do the STR%EP check earlier
so a public structure's exclusive bit gets set correctly.  Make MOVE
a MOVEI T1,.DVSTR.

252	5.1112		1-Mar-84
	Add routine KSMT to handle MOUNT STRUCTURE command from OPR.  Delete
all tabs at the beginning of the second line in the edit history.  Show only
one dismount message when dismounting a structure via port operation.  When 
displaying structure status and structure is not mounted, it is still
possible get a SSB on a structure if that structure is being dismounted.

253	5.1113		5-Mar-84	
	Fix KSMT so that the MOUNT command will mount structures that are not
physically mounted first and clear STR%DT correctly.  Clean up NEWSTA and 
reject the mount request based on the requestor in routine STRMNT.

254	5.1115		12-Mar-84
	Change references from CFSP to either CFSB or to a call to CHKCFS.

255     5.1117		15-Mar-84
	Check for end of TMCMSG buffer and break up IPCF packets if necessary 
at carriage returns and/or line feeds

256	5.1120		22-Mar-84
	Add code to support the MOUNT command from OPR so that the correct 
action and messages get to be printed.  Change NEWSTA back to before edit 253.

257	5.1121		26-Mar-84
	Remove path no longer exists message from SHOW STATUS DISK.  Spell
DISMOUNT correctly.  * indicates external path to drive, not simply dual
ported.

260	5.1122		28-Mar-84
	Reject dismount request if structure is set IGNORED.  Tell operator
that a structure is set IGNORED and the attributes for that structure are not
set as that of the DDB.  

261	5.1123		30-Mar-84
	Filter the "don't care bits" (MS%NTC) as well as the MS%EXC in routine
STSTR.

262	5.1125		2-Apr-84
	Add processing of controller number to disk available/un command
processing.

263	5.1127		2-Apr-84
	Change dismount message in routine WOVDS to be more clear.

264	5.1128		4-Apr-84
	In routine %K: print the CKU in decimal. In routine SHWSTR add the open
file count to the structure display.

265	5.1129		4-Apr-84
	In routine KVIRSB:+11 change the MOVEI to MOVE.

266	5.1130		5-Apr-84
	Change the dismount no-removal message so that it is in relationship
to the command.  In routine BT3:+2, change the SKIPE to SKIPLE so that it will
suppress warning messages as well as checking for text to be outputed.

267	5.1131		5-Apr-84
	Fix the dismount messages to correspond to the dismount request.

270	5.1135		11-Apr-84
	Add code in DDSCHK to check for MONITOR bug, i.e if a disk is online
there must be a structure on that disk.  Also in routine DDSDEL, delete the SSB
if and only if DSKSSA is greater than zero.

271	5.1139		25-Apr-84
	Cannot set primary public structure exclusive/shared.  In routine 
STSTR, only set the exclusive/shared attribute of the primary public structure.

272	5.1140		26-Apr-84
	Change the CALL WOMNT to CALL WOFRE in routine WOVDS to print the 
status of a disk as part of the dismount acknowledgement message to the 
operator.

273	5.1141		30-Apr-84
	In routine SCREQ2, restore MSTAL with correct structure alias.

274	5.1142		16-May-84
	Change KVIRS to KVIR2.
Add code to handle the "in the process of being dismounted/removed" state of a
structure.

275	5.1143		25-May-84
	Do not the the tape status header if no tape drives are on the system.

276	5.1145		30-May-84
	Fix KSDKER to tell the operator why it cannot set a disk drive 
unavailable if the primary public structure is mounted on that drive.

277	5.1147		7-Jun-84
	In CHKAVA loop through all the STRADD based on number of units in that 
structure.

300	5.1151		11-July-84
	Replace the constant 777777 by the assembly runtime parameter DEFPRO
when supplying the default protection for a tape being initialized.

301	5.1153		27-July-84
	Make NEWSTA and STSTR internal labels for MTRCFS.

302	5.1154		27-July-84
	In routine DISFAL, check for error code MSTX21 and reject dismount
request if so.

303	5.1156		31-Aug-84
	In routine STRINF, add code to detect errors on the disk when it comes 
online.  Change routine STRIN2 to CHKDSK and have CHKDSK return +1 errors 
found, +2 no errors found.  In DDSCHK call CHKDSK to see if the MONITOR is
returning bad data due to disk errors or due to bug.

304	5.1159		14-Sept-84
	Delete all WTORs in regards to dismount queries for a dismounted 
structure.  Also, restore the alias in MSTAL in routine STRREF.

305	5.1161		20-Sept-84
	Set STR%UD in routine STRSET rather in routine STREXC.

306	5.1163		21-Sept-84
	Include account string in display.

307	5.1164		1-Oct-84
	Create a new routine, DISREF, to handle the operator refusal to 
dismount.

310	5.1165		3-Oct-84
	Add code to display device type to SHOW STATUS TAPE/CHAR.

311	5.1178		8-Nov-84
	Add message to disk and structure displays explain "Free" is relative 
to this system and check other systems before attempting any removal.

312	5.1181		28-Nov-84
	Check for structure unique code, if given, in MATCHS.  In mount 
routines check the return from MATCHS to determine ambiguous mount request or
legitimate mount request.  Set RSBSTE to RST.WD to indicate RSB is waiting for
dismount instead of using RST.WM (waiting for mount).

313	5.1185		5-Dec-84
	Edit 311 prints the "Free" message eveytime a disk display is done.
This message is meaningless if there are no free drives.  Only print the "Free"
if there is a disk online.

314	5.1190		8-Jan-85
	In routine STSTR+5 change ERJMP to JRST.

315	5.1192		9-Jan-85
	Comment out the code pertaining to write protecting MOUNTR

316	5.1193		10-Jan-85
	No structure name in SHOW STA STR FOO: display if FOO: has not 
previously mounted and disk drive is set unavailable.

317	5.1201		4-Feb-85
	Add code to skip MSTR if we are in debug mode.

320	5.1203		21-Feb-85
	Add a SHOW CONFIGURATION (of) DISK-DRIVE command.

321	5.1203		21-Feb-85
	More on SHOW CONFIG . . .

322	5.1205		18-Mar-85
	Give the correct error message when attempting to dismount the primary
public structure.

323	5.1211		26-Mar-85
	Check for RST.WD in DDSMCH.

324	5.1212		4-Apr-85	QAR 706407
	If bit MS%OFL is on also check MS%IAC.  If both bits are on then the
disk drive is not truely offline but rather force offline due to HOM checking
on behalf of a cluster change.

325	5.1213		30-Apr-85	QAR 838245, 838231
	Add check for structure unique code change for an online structure in
routine DDSCHK.

326	5.1222		21-Jun-85	QAR 838449
	In routine WONMT3: get the alias from the DSB.
*****	Release 5.0 -- begin maintenance edits	*****
330	Increment maintenance edit level for version 5 of GALAXY.

331	5.1228		Nov-15-85
	In routine STMERR check for only one recoverable error from failure
to mount structure.

332	5.1230		Jan-10-85
	In routine MTRLS, notify the operator that a mount request for a
volume of a multi-volume set is canceled due to a dismount.

333	4.2.1623	Feb-3-86
	In routine UNLOAD, REWIND the tape before UNLOAD.

334	5.1239		May-28-86
	In routime IOXCTR, increase the time out timer from 1 minute to 3
minutes.

335	5.1245		Dec-5-86
	Remember how many dismounts are currently being performed on a
structure so that if a cancel for a dismount request is given and if there are
no more dismounts for that structure pending, MOUNTR can reset
the structure status back to its previous state prior to the dismount.
This edit must be accompanied by MTRMAC edit 41.  MOUNTR must be rebuild.

336	5.1247		Oct-13-87
	In routine STRFND: when MOUNTR detects a -1 for the address of a SSB in
the DSB, go to STRFN3 to find out why.  There are three cases that this might
happen: if two identical structures are put online, if a disk drive switches
paths while the MONITOR is doing HOM block checking on that drive, and if two
structures with identical bad HOM blocks are put online.  The first case MOUNTR
will create two structure status blocks for each structure.  The second case,
MOUNTR will delete the path (DSB) that is doing the HOM block checking.  The
third case will be treated like the first but the DSB will state that the disk
has bad HOM blocks.  Since the MONITOR will no longer returns two accessible
paths to a disk drive, MOUNTR will no longer crash.

*****	Release 6.0 -- begin development edits	*****

6000	6.1037		26-Oct-87
	Move sources from G5: to G6:

6001	6.1057		4-Nov-87
	Change PS: to BS: and PS:[SPOOL] to SPOOL: for Non PS: login feature.
	Include BS: and PS: information in disk and structure displays.

6002	6.1081		17-Nov-87
	Add support to SET STRUCTUREs DUMPABLE/NONDUMPABLE.

6003	6.1081		18-Nov-87
	Missing the "/" in CHRTBL.	

6004	6.1081		19-Nov-87
	In routine SHW4:, show whether the structure is dumpable.

6005	6.1081		20-NOV-87
	In routine SHW.4:, use the alias name from DSFE because the structure
might not be online.

6006	6.1112		2-Dec-87
	In routine SHW4:, add a check for MS%OFS and display the structure as
offline if MS%OFS is lit.

6007	6.1137		9-Dec-87
	In routine STSTR: include MS%DMP as one of the bits that cab be set.
Report any conflicts regarding MS%DMP.

6010	6.1139		13-Dec-87
	When sending a remote ACK/WTO always include the .WTNHD and .WTTYP
blocks.

6011	6.1147		17-Dec-87
	Implement automation of DISMOUNT/REMOVAL and SET EXCLUSIVE.  Add code
to handle remote MOUNTs.

6012	6.1148		18-Dec-87
	Remote systems can't mount a structure after the local system has
remounted the structure after a DISMOUNT/REMOVAL.

6013	6.1149		18-Dec-87
	MOUNTR crashes with PDL overflow when DISMOUNT/REMOVE is done in a
mix 6.1 and 7.0 TOPS-20 Cluster.

6014	6.1150		21-Dec-87
	In routine KSST.6, If the SET EXCLUSIVE requires a RSB, save the
operator's PID in RSBPID so that the operator can be notified upon completion
of command.  In KSSTEX: add code to JRST to the correct routines so that the
SET command terminates normally.  In routine STRMN1: after the structure is 
mounted, always release the structure lock.

6015	6.1151		22-Dec-87
	Rewrite STRMN8: to following the same logic as DISMOUNT/REMOVAL and
SET EXCLUSIVE when MOUNTR tries to apply the EXCLUSIVE attribute of a structure
after it has been mounted.

6016	6.1152		23-Dec-87
	In routine KSSTAB:, just return after calling UNSEXC.  SCREQ3: will
have already imform the operator that the SET EXCLUSIVE was aborted.  Also,
in routine KDSM: remember the remote node in RSBOBN and STROBN if the dismount
is a remote dismount.

6017	6.1165		7-Jan-88
	In routine BT4:, store the remote node name in .WTNHD and not the
local node name.  In CKGHDR: if the message is from NEBULA, save the remote
node name in RENODE.  In PNEDC3:+1, change the AOJG to SOJG or else MOUNTR
will loop forever.  In KSST: save the structure flag in STRFL2.

6020	6.1167		15-Jan-88
	In routine STRMNT:, change the CAME to CAMN to correctly check for
a whether the remote request node name matches the remote node name who did
the dismount.   In routine WHOEQC:, zero out the left half of TEMP so that the
user number is correctlt stored in the INFBLK:.  In routine WHOENQ:, change the
message to indicate the command failed because the structure is being dismount
with removal or set exclusive a structure from another system.

6021	6.1199		29-Feb-88
	In routine STRMNT:+4, change the MOVE to SKIPE so that remote mounts
on a structure that have not been dismount on behalf of works.

6022	6.1202		2-Mar-88
	Extend the sign bit of the terminal line number in ACCLN because the
MONITOR doesn't like 0,,-1 for a deteched terminal line number.

6023	6.1216		5-Mar-88
	Add missing RET in STRFND.

6024	6.1219		6-Mar-88
	Add conditional for enabling/disabling CLUSTER GALAXY feature.  In
routine START: add one line..SINGLE <SETOM ENQFLG> after the ENQ% call. 
ENQFLG=-1 if not 7.0 MONITOR or CLUSTER GALAXY is disabled.

6025	6.1225		8-Mar-88
	Update copyright notice.

6026	6.1228		9-Mar-88
	Change message in WODSC1: to be more clear.

6027	6.1231		28-Mar-88
	Edit 6022 is incorrect.  ACCLN is a mask (0,,-1) and not a location 
which contains the line number.  Change ACCLN to ACCNO(ACC).

6030	6.1236		21-Apr-88
	No need to check for additional pending RSBs in routine SCREQ3: because
they are already pending for a response to a WTOR.  Also, the code to do the
checking was incorrect.

6031	6.1240		27-Apr-88
	In routine NSACK: get the RSB status in AC 1 so that the check for
R%STA is correct.  In routine FAILE: make sure that the error indicator bit is
set in .OFLAG.  In routine STRDMT: set R%STA if the remote dismount fails
because the structure is set IGNORE and use ABTREQ macro to abort the request.

6032	6.1250		9-May-88
	In error table NEBERR: add [ and ] for each error string so that FNDERR
can return the correct address of a NEBULA error.

6033	6.1265		29-Jun-88
	At routine STRIN6:, if the call to ISTDDB returns +1 then disconnect
the link between the DDB and its SSB because that SSB is no longer valid.

6034	6.1268		11-Aug-88
	MOUNTR does not return the correct information on structures that are
mounted by CHECKD.  Also change the headers to be in mixed case instead of
upper case. (this will not have an edit # in the comment line).

6035	6.1269		18-Oct-88
	Set the NEBULA message flag, NEBMSG, if we received a remote command
so that MOUNTR will return the response locally and remotely.

6036	6.1277		25-Apr-89
	Move edit 6035 after checking for message from INFO.  Apparently INFO
sends a message to MOUNTR after a @MOUNT command and the message contains
data that is of not interest.  However, the second word of the message has bit
MF.NEB sent and MOUNTR erroronously sets NEBMSG for the next command.

6037	6.1279		30-Jun-89
	In routine STRMNT: if there is no structure name use the alias.  Also,
include an error code when rejecting the mount request.

6040	6.1280		22-Sept-89
	Change the error messages when a MTA device is being used on another
system.  This is in accordance with a patch to the MONITOR to make MTA devices
shareable in a TOPS-20 Cluster.
^	;End of revision history
SUBTTL PREFACE
COMMENT ^

MOUNTR - THIS PROGRAM CONTOLS MAGNETIC TAPE AND  STRUCTURE  MOUNT
REQUEST QUEUEING AND PROCESSING UNDER TOPS-20. IT INTERFACES WITH
QUASAR, ORION, NON-PRIVILEGED USER-MODE PROGRAMS  (TOPS-20  EXEC,
ET AL), AND THE SYSTEM OPERATOR.

ACCUMULATOR CONVENTIONS:

F, Q1-Q3, AND SPECIAL-PURPOSE AC'S (E.G. MTA)  ARE  PRESERVED  BY
SUBROUTINES, WHILE T1-T4 AND CX MAY BE CLOBBERED. SOME MACROS USE
CX TO LINK TO DRIVERS, SO BE  CAREFUL.  F  CONTAINS  PROGRAM-WIDE
FLAGS THAT MAY BE MODIFIED AND TESTED BY ANY ROUTINE  THAT  NEEDS
THEM. MACRO DRIVERS GENERALLY PRESERVE T1-T4.

INTERRUPT-LEVEL OPERATION:

TO  MINIMIZE  THE  POSSIBILITY  OF  TIMING  BUGS,  PROCESSING  AT
INTERRUPT LEVEL WILL BE KEPT TO AN ABSOLUTE  MINIMUM.  INTERRUPTS
FROM SOURCES EXTERNAL TO THE PROGRAM ARE  PROCESSED  AT  PRIORITY
LEVEL 3 (DEFINED BY "PRIEXT" EQUATE). TYPICALLY, THE ONLY  ACTION
TAKEN IS TO REQUEST  THAT  THE  SCHEDULER  PASS  CONTROL  TO  THE
APPROPRIATE EVENT PROCESSOR AT  NON-INTERRUPT  LEVEL  (ALL  EVENT
PROCESSOR TAGS  END  IN  "IH").  DEBRK  IS  DONE  EITHER  TO  THE
INTERRUPTED PC OR TO THE BEGINNING OF  THE  SCHEDULER,  DEPENDING
UPON THE SETTING OF THE FLAG, IRETF. ALL  PANIC-CHANNEL  ACTIVITY
OCCURS AT LEVEL 1 (DEFINED BY "PRIPAN" EQUATE).

ASSOCIATED PROCESSES:

THIS PROGRAM RELIES UPON SEVERAL OTHER SYSTEM  TASKS  TO  PERFORM
ITS FUNCTIONS. THESE ARE REFERRED TO AS  "ASSOCIATED  PROCESSES",
ABBREVIATED A/P. PARALLEL A/P  TABLES  ARE  MAINTAINED  IN  CORE,
INDEXED BY THE A/P INDEX  (A SMALL INTEGER  ASSOCIATED  WITH  THE
PROCESS).

RESTARTABILITY:

IT IS INTENDED THAT MOUNTR BE RESTARTABLE  WITH  A  MINOR  IMPACT
UPON  SYSTEM  PERFORMANCE.  SOME  OF  THE  PROBLEMS  CREATED   BY
RESTARTING THE PROGRAM ARE:

     1.	ALL STRUCTURE-MOUNT AND ACCOUNTING INFORMATION IS LOST.
     2.	ALL ACCOUNTING INFORMATION FOR CURRENTLY-MOUNTED TAPES IS
	LOST.
     3.	ALL TAPE-MOUNT REQUESTS THAT HAVE NOT BEEN ASSIGNED AN MT
	DEVICE ARE LOST.
     4. USERS WITH MT DEVICES MAY CONTINUE USING  THEM,  BUT  ANY
	ATTEMPT AT A VOLUME SWITCH WILL RECEIVE AN ERROR.

EXTENDED ADDRESSING:

THOUGH MOUNTR WILL NOT NORMALLY RUN IN A  NON-ZERO  SECTION,  ITS
CODE SHOULD NOT PRECLUDE THAT POSSIBILITY. BECAUSE OF THE VARIETY
OF JSYS'S IT EXECUTES, MOUNTR  CAN  BE  OF  GREAT  ASSISTANCE  IN
TESTING THE USER-MODE EXTENDED ADDRESSING FEATURES OF THE MONITOR.

TEST MODE:

PLACING A NON-ZERO VALUE IN LOCATION 135 (.JBOPS) BEFORE STARTING
MOUNTR  WILL  CAUSE  MOUNTR  TO  RUN  IN  A  TESTING  MODE  (THIS
CONVENTION IS ADOPTED  FROM  THE  GALAXY  WORLD).  THE  ESSENTIAL
DIFFERENCES FROM LIVE MODE ARE THAT MOUNTR WILL TALK  TO  PRIVATE
GALAXY COMPONENTS, AND IT WILL REFRAIN FROM DOING  THINGS  (E.G.,
ASSIGNING MTA DEVICES) THAT WOULD INTERFERE WITH THE OPERATION OF
THE REAL MOUNTR.

^

; TABLE OF SUPPORTED DENSITIES

DENTAB:: DENLST			;GENERATE LIST OF DENSITIES
DENMAX==:.-DENTAB-1		;MAXIMUM DENSITY INDEX

; POINTERS TO TEXT STRINGS INDEXED BY LABEL TYPE

LTTXT::	0
	[ASCIZ/Unlabeled/]
	[ASCIZ/ANSI/]
	[ASCIZ/EBCDIC/]
	[ASCIZ/TOPS-20/]
MAXLT			;CODE NEEDED HERE IF NEW LABEL TYPE ADDED

; POINTERS TO TEXT STRINGS INDEXED BY DRIVE TYPE

DRVTXT:: 0
	[ASCIZ/9-TRACK/]
	[ASCIZ/7-TRACK/]

DVTTXT:	DVTGEN <45,70,71,72,73,77,78>
	DVTLEN==:.-DVTTXT
; ASCII-TO-EBCDIC TRANSLATION TABLE

; TABLE IS COMPOSED OF 128 8-BIT BYTES, INDEXED BY THE
; ASCII CHARACTER VALUE

AETT::
BYTE (8)000,001,002,003,067,055,056,057,026,005,045,013,014,015,016,017
BYTE (8)020,021,022,023,074,075,062,046,030,031,077,047,034,035,036,037
BYTE (8)100,117,177,173,133,154,120,175,115,135,134,116,153,140,113,141
BYTE (8)360,361,362,363,364,365,366,367,370,371,172,136,114,176,156,157
BYTE (8)174,301,302,303,304,305,306,307,310,311,321,322,323,324,325,326
BYTE (8)327,330,331,342,343,344,345,346,347,350,351,112,340,132,137,155
BYTE (8)171,201,202,203,204,205,206,207,210,211,221,222,223,224,225,226
BYTE (8)227,230,231,242,243,244,245,246,247,250,251,300,152,320,241,007



; EBCDIC-TO-ASCII TRANSLATION TABLE

; TABLE IS COMPOSED OF 256 7-BIT ASCII BYTES, INDEXED BY THE
; EBCDIC CHARACTER VALUE

XXX==.CHCNZ		;VALUE OF EBCDIC CHARS WITHOUT IMAGES (^Z=SUB)

EATT::
BYTE (7)000,001,002,003,XXX,011,XXX,177,XXX,XXX,XXX,013,014,015,016
BYTE (7)017,020,021,022,023,XXX,XXX,010,XXX,030,031,XXX,XXX,034,035
BYTE (7)036,037,XXX,XXX,XXX,XXX,XXX,012,027,033,XXX,XXX,XXX,XXX,XXX
BYTE (7)005,006,007,XXX,XXX,026,XXX,XXX,XXX,XXX,004,XXX,XXX,XXX,XXX
BYTE (7)024,025,XXX,032,040,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,133
BYTE (7)056,074,050,053,041,046,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)135,044,052,051,073,136,055,057,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,174,054,045,137,076,077,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,140,072,043,100,047,075,042,XXX,141,142,143,144,145,146
BYTE (7)147,150,151,XXX,XXX,XXX,XXX,XXX,XXX,XXX,152,153,154,155,156
BYTE (7)157,160,161,162,XXX,XXX,XXX,XXX,XXX,XXX,XXX,176,163,164,165
BYTE (7)166,167,170,171,172,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,173,101,102
BYTE (7)103,104,105,106,107,110,111,XXX,XXX,XXX,XXX,XXX,XXX,175,112
BYTE (7)113,114,115,116,117,120,121,122,XXX,XXX,XXX,XXX,XXX,XXX,134
BYTE (7)XXX,123,124,125,126,127,130,131,132,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)060,061,062,063,064,065,066,067,070,071,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,0,0,0,0
;DISPLAY MESSAGES FOR DISK STATUS


DSKHDR::ASCIZ "
DISK DRIVE INFORMATION                   DISK PACK INFORMATION
      Chan-Cont   Disk   Mount   Mount                Usage
 Type   Drive    Status  Status  Count   Name         Options
 ---- --------- -------- ------- -----   ------------ --------------------------
"
CFGHDR::ASCIZ "
      Chan-Cont                        Mount    
 Type   Drive    Drive Serial Number   Status   Name
 ---- --------- ---------------------  -------  ------------
"

FREHDR::ASCIZ "
			FREE DRIVES
"

MNTHDR::ASCIZ "
			MOUNTED DRIVES
"

;DISPLAY MESSAGES FOR STRUCTURE STATUS

STRHDR::ASCIZ "
              Mount   Mount File
Alias  Name   State   Count Count Status         Access         Accounting
------ ------ ------- ----- ----- -------- -------------------- ---------------
"

FRESTR::ASCIZ"
		UNMOUNTED STRUCTURES
"
MNTSTR::ASCIZ"
		MOUNTED STRUCTURES
"
;  Header for a particular structure

;  Display messages for structure status change

STRCHD:	ASCIZ "Structure Status Change Detected"

;  Display message for conflicting bits

CONFLI: ASCIZ "*  The attribute(s) for this structure are inconsistent with current status
"

;  Trying to set a disk drive with PS: mounted on it

DSKPS:	ASCIZ "**Warning - Primary public structure is mounted on disk drive **
"

DSMHDR:: ASCIZ "%IDismount of structure %3S: (Alias %2S:) requested.
Other jobs are currently using it.  Should
dismount request be processed (Yes or No)?
%U"

FREEH:: ASCIZ /%7CDisk drives that are "Free" might be in use by other systems%_%7CCheck status of structure on other systems before attempting any removal/

;[6011]
RESHDR:: ASCIZ /If successful, respond PROCEED
If not successful, respond ABORT/

;[6011]
RESPRE:: BLOCK 1		;RESPRE must be right before RESNAM
RESNAM:: ASCIZ/-DSKO'MJCLFGZAPKMSACPSCBR/ ;Resource name 
;DISK UNIT TYPE TABLE

UNTYTB:! XWD .MSRP4,[ASCIZ/RP04/]	;1 - RP04
	XWD .MSRP5,[ASCIZ/RP05/]	;5 - RP05
	XWD .MSRP6,[ASCIZ/RP06/]	;6 - RP06
	XWD .MSRP7,[ASCIZ/RP07/]	;7 - RP07
	XWD .MSRM3,[ASCIZ/RM03/]	;11 - RM03
	XWD .MSR20,[ASCIZ/RP20/]	;24 - RP20
	xwd .msr80,[asciz/RA80/]	;27 - ra80
	xwd .msr81,[asciz/RA81/]	;30 - ra81
	xwd .msr60,[asciz/RA60/]	;31 - ra60
	XWD -1,[ASCIZ/Unk /]		;ENTRY IN CASE NONE OF ABOVE

	MXUTYP==:.-UNTYTB-1		;NUMBER OF KNOWN ENTRIES
SUBTTL MODIFYABLE DATA AREA

; DEFINITION OF ASSOCIATED PROCESS INDICES

DEFINE APENT (X) <.AP'X==NEXT>
NEXT$==0		;INITIALIZE VARIABLE
	APTABL		;DEFINE SYMBOLS OF FORM .APxxx AS A/P INDICES
APNUM==NEXT$		;# OF ASSOCIATED PROCESSES

; ALL DATA FROM ZROBGN TO ZROEND WILL BE SET TO ZEROS AT STARTUP

ZROBGN::			;BEGINNING OF AUTOMATIC ZERO AREA
NSR::	BLOCK 1			;# OF REQUESTS IN SCHEDULER QUEUE
TDSCF::	BLOCK 1			;.GE. 0 SCHED REQUEST EXISTS FOR TDSCIR
MYPID::	BLOCK 1			;SYSTEM MDA PID
MSGSIN:: BLOCK 1		;# OF IPCF MESSAGES RECEIVED
SHORT::	BLOCK 1			;MAXIMUM LENGTH OF NON-PAGE IPCF MESSAGE
MTAN::	BLOCK 1			;NUMBER OF MTA DEVICES ON SYSTEM
MTN::	BLOCK 1			;NUMBER OF MT DEVICES ON SYSTEM
PBACW::	BLOCK 1			;GLOBAL ADDR OF ARGUMENT COUNT WORD
PBBPT::	BLOCK 1			;ADDR OF NEXT BUILDING BLOCK TO BE BUILT
PBLFT:: BLOCK 1			;Bytes positions left in orion message
MORTXT:: BLOCK 1		;Byte pointer to remaining text
BTEXT:: BLOCK 1			;ORION communication flags
FIRST:: BLOCK 1			;Marker for wto/ack message type block
BUFLFT:: BLOCK 1		;Number of words free in TMCMSG
TMCPTR:: BLOCK 1		;BYTE POINTER INTO TMCMSG
TMCTSP:: BLOCK 1		;TMCT0 ROUTINE SOURCE STRING POINTER
TMCWDS:: BLOCK 1		;CURRENT LENGTH OF TMCMSG IN WORDS
WTRQDB:: BLOCK 1		;QDB FOR OUTSTANDING WTOR REQUESTS
ARBQDB:: BLOCK 1		;QDB FOR ACTIVE REQUEST STATUS BLOCKS
IRBQDB:: BLOCK 1		;QDB FOR INACTIVE REQUEST STATUS BLOCKS
FVSQDB:: BLOCK 1		;QDB FOR FREE VOLID SLOTS IN VOLP0
UNIQUE:: BLOCK 1		;UNIQUE VALUE WORD (ACCESSED WITH AOS)
BTFLGS:: BLOCK 1		;.OFLAG WORD FOR WTO'S AND ACK'S
TAPNAM:: BLOCK TPNMSZ/5+1	;INSTALLATION-SUPPLIED NAME FOR VOL1
CRSHAC:: BLOCK 20		;AC'S AT TIME OF CRASH
SSSDAT:: BLOCK 2		;DATA AND ROUTINE ADDRESS FOR DEBUG
LSTERR:: BLOCK 1		;LAST ERROR AT TIME OF CRASH
CHKDFG:: BLOCK 1		;[6034]CHECKD flag
CSB::	BLOCK 12		;STATE BLOCK FOR COMND JSYS
APPID::	BLOCK APNUM		;A/P PID TABLE
MRPDB::	BLOCK 10		;PDB FOR MRECV OPERATIONS
TRPDB::	BLOCK 4			;MSEND PDB
PDL::	BLOCK PDLEN+1		;PUSH-DOWN STACK
PDL1::	BLOCK 4			;ALTERNATE PDL - USED BY STOPP ROUTINE
BADP::	BLOCK 1			;CONTENTS OF P WHEN STACK PROBLEM FOUND
SYRHDR:: BLOCK SYRHSZ+SYRMSZ	;SYSERR HEADER AND MESSAGE
SYRMSG==SYRHDR+SYRHSZ		;ADDRESS OF SYSERR MESSAGE
SAVEDP:: BLOCK 1		;USED TO SAVE STACK POINTER FOR REPARSES
IABQDB:: BLOCK 1		;QDB FOR INACTIVE ACCOUNT BLOCKS
AABQDB:: BLOCK 1		;QDB FOR ACTIVE ACCOUNT BLOCKS
READCL:: BLOCK 2		;DUMPI IOWD LIST FOR READING LABELS
LPC1::	BLOCK 2			;PSI LEVEL 1 FLAGS & PC
LPC2::	BLOCK 2			;PSI LEVEL 2 FLAGS & PC
LPC3::	BLOCK 2			;PSI LEVEL 3 FLAGS & PC
DAEPC::	BLOCK 1			;PC OF LAST DATA ERROR
DEFDEN:: BLOCK 1		;Default Initialization Density
PRTRSB:: BLOCK 1		;Storage for Port RSB
ANY:: BLOCK 1			;Disk marker - SET PORT CI offline 
PORTST:: BLOCK 1		;Port status word . 1=unavailable 0=unavailable
AGAIN:	BLOCK 1			;Flag word to indicate redo of status loop
UNLD:	BLOCK 1			;Tape being unloaded flag
LCNODE:	BLOCK 1			;[6010]Local node name
RENODE: BLOCK 1			;[6010]Remote node name
NEBMSG:	BLOCK 1			;[6010]Request from NEBULA flag. nonzero=NEBULA
WTNHDB: BLOCK 2			;[6010]2 Word block for .WTNHD
WTTYPA: BLOCK 1			;[6010]Address of .WTTYP
TEMPX:	BLOCK 2			;[6010]Temp storage
STNAM:	BLOCK 1			;[6011]Structure name from .STRNM from .NRDAK
NUMNOD: BLOCK 1			;[6011]Number of nodes returned from .NRDAK
DFLAG:	BLOCK 1			;[6011]Remote dismount flag from .NRDAK
ADDRBK: BLOCK 1			;[6011]Address of .STSBK block from .NRDAK
BADADR: BLOCK 1			;[6013]Address of BADNOD
BADNOD: BLOCK 7			;[6013]Nodes in the cluster that is pre 7
ZROEND==.-1			;END OF AUTOMATIC ZERO AREA

;  End of buffer flags used in TMCMSG and for IPCF packets

ENDBUF==MSGLEN-^D20		;Nearing end of TMCMSG buffer
BYTEND==^D83			;Nearing end of IPCF message buffer

;  Data for SHOW CONFIGURATION DISK-DRIVE command

CFGFLG:: BLOCK 1	;Used so SHO STA DISK knows it's a different display

;  Data for user list for SHO STa STR FOO: command

USRSIZ==101			;Max number of users on user list.
USRBIT==0			;Offset to usage bits.
USRNUM==1			;Offset to Job user number.
USRENT==2			;User entry size.
DIRNAM:: BLOCK 15		;User name who have mounted/access/connected
USRLST:: BLOCK USRSIZ		;User list for usage of structure

PNFLAG:: BLOCK 1		;[6011]Routine PNEDAC's header flag
FNDRSB:: BLOCK 1		;[6011]Routine PNEDAC's RSB flag
DSPFLG:: BLOCK 1		;Display message flag, bits define in MTRMAC
; CDFLG - DEPOSIT 0 TO DISABLE ^D, DEPOSIT 1 TO ENABLE ^D
CDFLG::	EXP -1			;CONTROL-D ENABLE/DISABLE SWITCH
CFSPEC:: ASCIZ/SPOOL:MOUNTR-CRASH.EXE/ ;[6001]CRASH FILESPEC
LBUF2::	BLOCK LB7WDS		;7-BIT ASCII REPRESENTATION OF LBUF1
OPRHSZ==12
OPRHDR:: BLOCK OPRHSZ		;TEMPORARY TEXT STORAGE
MSTRBK:: BLOCK 50		;PLACE FOR MSTR DSK STATUS ARG BLOCK
MSTNM::	BLOCK 2			;STRUCTURE NAME FOR MSTR IN 7-BIT ASCII
MSTAL::	BLOCK 2			;STRUCTURE ALIAS FOR MSTR IN 7-BIT ASCII
CFSB:: BLOCK 1			;0=NON CFS SYSTEM, -1=CFS SYSTEM
ENQFLG:: BLOCK 1		;[6010]Cluster ENQ flag -1=Not cluster ENQ
ENQBLK:: BLOCK 6		;[6010]ENQ block
ENQCBK:: Block 3		;[6010]ENQC block
CNFSIZ==:30			;[6010]CNFIG block size
NUMBLK:: BLOCK 31		;[6010]CNFIG block for CI-node number
NAMBLK:: BLOCK 31		;[6010]CNFIG block for CI-node name
INFBLK:: BLOCK 20		;[6010]INFO block

;  Argument blocks for various JSYSs

MSTRST:	BLOCK .MSGSI+1		;[6010]Block for structure status MSTR
MUTLBK:	BLOCK 3			;Block for MUTIL JSYS
TAPEBK:	BLOCK .MOIWF+1		;Block for getting info about tape drive MTOPR

;  SSB data base management

SSBFPT:	BLOCK 1			;Pointer to SSB free entries (or 0 if none)
SSBTOP:	BLOCK 1			;Top of active SSB entries
				;  Points to next SSB entry available
SUBTTL STORAGE AREA FOR USAGE DATA


JOBNO::	BLOCK 1			;JOB NUMBER
LINO::	BLOCK 1			;LINE NUMBER
USRNAM:: BLOCK 10		;ASCIZ USER NAME
ACOUNT:: BLOCK 10		;ASCIZ ACCOUNT USTING

USTCRT::			;DATE/TIME OF REQUEST CREATION
UMTCRT:: BLOCK 1		;CREATION DATE/TIME OF REQUEST

USTSCD::			;SCHEDULED TIME
UMTSCD:: BLOCK 1

USTSRV:: 			;DATE/TIME WHEN SERVICED
UMTSRV:: BLOCK 1		;SERVICED DATE/TIME

USTEUT::			;ELAPSED USAGE TIME
UMTEUT:: BLOCK 1

USTDSP::			;DISPOSITION OF REQUEST
UMTDSP:: BLOCK 1

USTTXT::			;OPERATOR/SYSTEM TEXT
UMTTXT:: BLOCK 10

USGCSZ==.-JOBNO+1

USTNM::				;STRUCTURE NAME
UMTVID:: BLOCK 1		;MAGTAPE VOLUME IDENTIFIER

USTKTP:: 			;CONTROLLER TYPE
UMTKTP:: BLOCK 1		;CONTROLLER TYPE

USTDTP:: 			;DEVICE TYPE
UMTLT::	BLOCK 1			;LABEL TYPE
				; 1 = UNLABELED, 2 = ANSI
				; 3 = EBCDIC, 4 = DEC

USTSTP::			;STRUCTURE TYPE (3=DOMESTIC,4=FOREIGN)
UMTLS::	BLOCK 1			;LABEL STATUS
				; 0 = UNLABLED VOLUME
				; 1 = PRIVATE VOLUME
				; 2 = SCRATCH VOLUME
				; 3 = SCRATCH VOLUME ASSIGNED TO USER
				;     DURING THIS MOUNT

USTTNP:: 			;NUMBER OF PACKS IN STRUCTURE
UMTMRD:: BLOCK 1		;MAGTAPE READS

USTMC::				;MOUNT COUNT BEFORE MOUNT
UMTMWR:: BLOCK 1		;MAGTAPE WRITES

USTDC::				;MOUNT COUNT AFTER MOUNT
UMTMRF:: BLOCK 1		;THOUSANDS OF FRAMES READ OF MTA

USTATP::			;ACCESS TYPE
UMTMWF:: BLOCK 1		;THOUSANDS OF FRAMES WRITTEN

UMTFSI:: BLOCK 1		;FILE SET IDENTIFIER
UMTSRE:: BLOCK 1		;NUMBER OF SOFT READ ERRORS
UMTSWE:: BLOCK 1		;NUMBER OF SOFT WRITE ERRORS
UMTHRE:: BLOCK 1		;NUMBER OF HARD READ ERRORS
UMTHWE:: BLOCK 1		;NUMBER OF HARD WRITE ERRORS
UMTVSN:: BLOCK 1		;VISUAL SERIAL NUMBER

USGSIZ==.-JOBNO+1
SUBTTL STATIC DATA AREA

;	BLOCK 1000		;GET INTO A NEW PAGE
;PURE::				;LOWEST LOCATION IN STATIC DATA AREA

; EVERYTHING BEYOND THIS POINT WILL BE WRITE-PROTECTED BY THE
; ROUTINE WRTP, WHICH IS CALLED IN THE INITIALIZATION PHASE

TSTF==:135			;Galaxy mode flag: 0=live, 1=test

; SOFTWARE INTERRUPT SYSTEM DATA AREAS
; ------------------------------------

LEVTAB:	LPC1
	LPC2
	LPC3

; MACRO TO DEFINE PANIC-CHANNEL INTERRUPT CHNTAB ENTRIES

DEFINE PANIC (PANHDL) <
	INTMSK==INTMSK+1B<.-CHNTAB> ;;SET BIT IN CHANNEL MASK
	XWD PRIPAN,PANHDL	;;GENERATE CHNTAB ENTRY
>

; MACRO TO DEFINE EXTERNAL INTERRUPT CHNTAB ENTRIES

DEFINE EXTPSI (ENAM,EADR) <
	INTMSK==INTMSK+1B<.-CHNTAB> ;;SET BIT IN CHANNEL MASK
	ENAM'CN==.-CHNTAB	;;DEFINE CHANNEL# SYMBOL
  IFB <EADR>,<
	XWD PRIEXT,[CALL EIHR	;;GENERATE CHNTAB ENTRY
		    EXP ENAM'IH] ;;ENTRY POINT FOR SCHEDULER
  > ;;END IFB EADR
  IFNB <EADR>,<
	XWD PRIEXT,EADR		;;GENERATE CHNTAB ENTRY
  > ;;END IFNB EADR
>

INTMSK==0			;INITIAL VALUE OF INTRPT CHANNEL MASK
CHNTAB:
	EXTPSI DDT		;0 - LOAD AND SCHEDULE DDT
	0,,0			;1 - ASSIGNABLE CHANNEL 1
	0,,0			;2 - ASSIGNABLE CHANNEL 2
	0,,0			;3 - ASSIGNABLE CHANNEL 3
	0,,0			;4 - ASSIGNABLE CHANNEL 4
	0,,0			;5 - ASSIGNABLE CHANNEL 5
	0,,0			;6 - ARITHMETIC OVERFLOW
	0,,0			;7 - FLOATING OVERFLOW
	0,,0			;8 - RESERVED
	PANIC PANPOV		;9 - PDL OVERFLOW
	0,,0			;10 - END OF FILE
	PANIC PANDAE		;11 - DATA ERROR
	PANIC PANQTA		;12 - QUOTA EXCEEDED
	0,,0			;13 - RESERVED
	0,,0			;14 - TIME OF DAY (RESERVED)
	PANIC PANILI		;15 - ILLEG INSTRUCTION
	PANIC PANIRD		;16 - ILLEGAL READ
	PANIC PANIWR		;17 - ILLEGAL WRITE
	0,,0			;18 - ILLEGAL EXECUTE (RESERVED)
	0,,0			;19 - INFERIOR FORK TERMINATION
	PANIC PANMSE		;20 - MACHINE SIZE EXCEEDED
	0,,0			;21 - TRAP TO USER (RESERVED)
	0,,0			;22 - NONEXISTENT PAGE REFERENCED
	0,,0			;23 - ASSIGNABLE CHANNEL 23
	EXTPSI MRCV		;24 - IPCF MESSAGE WAITING
	EXTPSI TDSC,TDSCIH	;25 - MTA DEVICE STATUS CHANGE
	EXTPSI JTO,JTOIH	;26 - JSYS TIMER EXPIRED
	EXTPSI DDSC		;27 - DISK DEVICE STATUS CHANGE
	0,,0			;28 - ASSIGNABLE CHANNEL 28
	0,,0			;29 - ASSIGNABLE CHANNEL 29
	0,,0			;30 - ASSIGNABLE CHANNEL 30
	0,,0			;31 - ASSIGNABLE CHANNEL 31
	0,,0			;32 - ASSIGNABLE CHANNEL 32
	0,,0			;33 - ASSIGNABLE CHANNEL 33
	0,,0			;34 - ASSIGNABLE CHANNEL 34
	0,,0			;35 - ASSIGNABLE CHANNEL 35
; ENTRY VECTOR

ENTVEC:	JRST START		;STARTING ADDRESS
	JRST DEBUG		;REENTER ADDRESS
LVERS::	EXP mtrVER		;PROGRAM VERSION
ENTVSZ==.-ENTVEC
; TABLE OF INITIALIZATION ROUTINE ADDRESSES FOR ASSOCIATED PROCESSES;
; ROUTINE IS CALLED DURING PROGRAM INITIALIZATION, AND POSSIBLY
; BY THE RECOVERY ROUTINE IF THE PROCESS CRASHES.

DEFINE APENT (X) <IFIW!X'INI>
APINI:	APTABL			;GENERATE LIST OF INIT ROUTINE ADDRS

; TABLE OF IPCF INPUT-MESSAGE PROCESSING ROUTINE ADDRESSES FOR A/P'S;
; ROUTINE IS CALLED WHEN AN IPCF MESSAGE IS RECEIVED FROM A PID THAT
; IS LISTED IN THE APPID TABLE

DEFINE APENT (X) <IFIW!X'MRC>
APMRC:	APTABL			;GEN LIST OF IPCF-RECEIVE HANDLER ADDRS

; Table of error codes and corresponding processing addresses upon MSEND
; failure for IPCF Send and Receive routines

MTBL:	IPCFX4,,TRAN1		;Receiver's PID is invalid
	IPCFX5,,TRAN1		;Receiver's PID is disabled
	IPCFX6,,TRAN6		;Send quota is exceeded
	IPCFX7,,TRAN5		;Receiver's quota is exceeded
	IPCFX8,,TRAN6		;IPCF free space is exhausted
	IPCF19,,TRAN7		;No PID for SYSTEM INFO
	MONX06,,TRAN6		;No swappable free space
MLEN==.-MTBL			;Length of the table
SUBTTL TEMPLATES FOR USAGE JSYS

;STRUCTURE USE RECORD

USGSTR: USENT. (.UTMNT,1,1)	;STRUCTURE USAGE RECORD TYPE
	USPNM. (<SIXBIT/MOUNTR/>,US%IMM) ;PROGRAM NAME
	USPVR. (mtrver,US%IMM)	;VERSION NUMBER
	USJNO. (JOBNO)		;JOB NUMBER
	USLNO. (LINO)		;LINE NUMBER
	USACT. (<-1,,ACOUNT>)	;ACCOUNT
	USNM2. (<-1,,USRNAM>)	;USER NAME
	USSSI. (USTNM)		;STRUCTURE NAME
	USSTP. (USTSTP)		;STRUCTURE TYPE
	USTNP. (USTTNP)		;TOTAL NUMBER OF PACKS IN FILE STRUCTURE
	USKTP. (USTKTP)		;CONTROLLER TYPE (RH20)
	USDTP. (USTDTP)		;DEVICE TYPE (RP04,ETC.)
	USDSP. (USTDSP)		;DISPOSITION
	USTXT. (<-1,,USTTXT>)	;SYSTEM/OPERATOR TEXT
	USCRT. (USTCRT)		;CREATION DATE/TIME OF REQUEST
	USSCD. (USTSCD)		;SCHEDULED TIME
	USSRV. (USTSRV)		;SERVICED DATE/TIME
	USMCT. (USTMC)		;MOUNT COUNT BEFORE MOUNT
	USDCT. (USTDC)		;MOUNT COUNT AFTER DISMOUNT
	USATP. (USTATP)		;ACCESS TYPE
	USEUT. (USTEUT)		;ELAPSED TIME OF USAGE
	0			;END OF RECORD

;TAPE MOUNT RECORD

USGMTA: USENT. (.UTMMT,2,1)	;MAGTAPE USAGE RECORD TYPE
	USPNM. (<SIXBIT/MOUNTR/>,US%IMM) ;PROGRAM NAME
	USPVR. (mtrVER,US%IMM)	;VERSION NUMBER
	USJNO. (JOBNO)		;JOB NUMBER
	USLNO. (LINO)		;LINE NUMBER
	USACT. (<-1,,ACOUNT>)	;ACCOUNT
	USNM2. (<-1,,USRNAM>)	;USER NAME
	USVID. (UMTVID)		;VOLUME IDENTIFIER IN VOL1 LABEL
	USMRF. (UMTMRF)		;THOUSANDS OF FRAMES READ
	USMWF. (UMTMWF)		;THOUSANDS OF FRAMES WRITTEN
	USDSP. (UMTDSP)		;DISPOSITION
	USTXT. (<-1,,UMTTXT>)	;SYSTEM/OPERATOR TEXT
	USCRT. (UMTCRT)		;CREATION DATE/TIME
	USSCD. (UMTSCD)		;SCHEDULED TIME
	USSRV. (UMTSRV)		;SERVICED DATE/TIME
	USKTP. (UMTKTP)		;CONTROLLER TYPE
	USMLT. (UMTLT)		;LABEL TYPE
	USMLS. (UMTLS)		;LABEL STATE
	USMRD. (UMTMRD)		;NUMBER OF TAPE READS
	USMWR. (UMTMWR)		;NUMBER OF TAPE WRITES
	USFSI. (UMTFSI)		;FILE SET IDENTIFIER
	USSRE. (UMTSRE)		;NUMBER OF SOFT READ ERRORS
	USSWE. (UMTSWE)		;NUMBER OF SOFT WRITE ERRORS
	USHRE. (UMTHRE)		;NUMBER OF HARD READ ERRORS
	USHWE. (UMTHWE)		;NUMBER OF HARD WRITE ERRORS
	USVSN. (UMTVSN)		;VISUAL SERIAL NUMBER
	USEUT. (UMTEUT)		;ELAPSED TIME OF USAGE
	0			;END OF RECORD
SUBTTL INITIALIZATION

; PROGRAM EXECUTION BEGINS HERE

START:	HLRZ T1,.JBSA		;GET UPPER BOUND OF PROGRAM
	CAIL T1,ADLOW		;PROGRAM TOO BIG?
	JRST [	TMSG <MOUNTR program overlaps ADLOW> ;YES, ERROR
		HALTF]		;MAKE ADLOW HIGHER TO CORRECT PROBLEM
	RESET			;CLOSE JFNS, CLEAR PSI, DUMP PIDS, ETC.
	MOVE P,[IOWD PDLEN,PDL]	;SET UP STACK POINTER
	MOVX F,INITF		;INITIALIZE FLAGS AC
	MOVE T1,.JBOPS		;GET GALAXY STANDARD TEST FLAG
	MOVEM T1,TSTF		;COPY TO WRITE-PROTECTED LOCATION

; ZERO OUT MODIFYABLE DATA AREA

	SETZM ZROBGN		;CLEAR FIRST WORD OF ZERO AREA
	MOVE T1,[ZROBGN,,ZROBGN+1] ;GET BLT POINTER
	BLT T1,ZROEND		;CLEAR THE REST OF THE ZERO AREA
	SETOM TDSCF		;SET NO SCHED REQUEST PRESENT FOR TDSCIR

; TURN ON INTERRUPT SYSTEM

	MOVEI T1,.FHSLF		;THIS FORK
	MOVE T2,[LEVTAB,,CHNTAB] ;TABLE ADDRESSES
	SIR			;COMMUNICATE TABLE ADDR'S TO MNTR
	EIR			;TURN ON INTERRUPT SYSTEM
	MOVX T2,INTMSK
	AIC			;ENABLE INTERRUPT CHANNELS
	SETO T3,
	EPCAP			;ENABLE ALL CAPABILITIES

; PERFORM VARIOUS INITIALIZATION OPERATIONS


;  This is one way to find out if we are running Pre 7 monitor
;  ENQFLG=0  Post 7 monitor and cluster GALAXY enabled.
;  ENQFLG=-1  Pre 7 monitor and cluster GALAXY disabled.
;  SINGLE= conditional flag for ENABLE/DISABLE CLUSTER GALAXY

	SETZM ENQFLG		;[6010]Assume cluster ENQ and 7 MONITOR
SINGLE	<SETOM ENQFLG>		;[6024]Not cluster GALAXY if SINGLE is defined
	SKIPE ENQFLG		;[6024]Do we have Cluster GALAXY?
	JRST START0		;[6024]No, skip ENQ% call
	MOVEI T1,.ENECL		;[6010]Enable cluster ENQ
	ENQ%			;[6010]Do the JSYS
	 SETOM ENQFLG		;[6010]Not cluster ENQ

START0:	CALL GCNFIG		;[6024]Get the local node name
	MOVE T1,NAMBLK+1	;[6010]Get pointer to local node name
	MOVEI T2,LCNODE		;[6010]Put SIXBIT name in LCNODE
	CALL SEVSIX		;[6010]Convert it
;	CALL WRTP		;WRITE-PROTECT MY CODE
	MOVEI T1,.SFMTA
	TMON			;TAPE-DRIVE ALLOCATION ENABLED?
	JUMPN T2,[TXO F,TALCF	;YES, SET FLAG
		MOVEI T1,POLINT	;GET POLLING INTERVAL
		MOVEI T2,POLLR	;GET ADDRESS OF POLLING ROUTINE
		CALL SRAI	;SCHEDULE MAGTAPE POLLING TASK
		JRST .+1]
	CALL PIDINI		;CREATE SYSTEM MDA PID
	CALL GTINAM		;GET INSTALLATION NAME
	CALL INAP		;MAKE FRIENDS WITH ASSOCIATED PROCESSES

	CALL DSFINI		;MAP DEVICE-STATUS FILE
	CALL DSFNUP		;Say we want no update of DDB
	SKIPN TSTF		;RUNNING LIVE?
	JRST [	TXNE F,TALCF	;Yes, SKIP MTA ASSIGN IF ALLOCATION DISABLED
		CALL ASMTA	;ASSIGN PHYSICAL MAGTAPES TO MYSELF
		CALL ASMT	;PUT LOGICAL MAGTAPES IN ALLOC POOL
		JRST .+1]
	CALL GETDEN		;Get magtape density for Initialize default
	CALL GETRSI		;INITIALIZE FREE RSB POOL
	CALL PRTINI		;Check for CI availability
	CALL DSKINI		;Initialize for disk change interrupts
	CALL SSBINI		;Initialize SSB data base
	CALL DDSCIH		;Set up DSK and STR DDB and status blocks
	SKIPE TSTF		;Debugging?
	JRST .+3		;Yes, skip mount all
	SKIPE CFSB		;Are we in CFS?
	CALL MNTALL		;Yes, mount all structures possible
	CALL DSFYUP		;We now want update of DDB

	CALL VQSPIN		;INITIALIZE VOLID-SLOT POOL
	CALL GETABI		;INITIALIZE FREE ACCOUNT BLOCK POOL
	CALL TDSCIR		;REWIND TAPES, DO AVR, ETC.
	TXZ F,INITF		;NOT INITIALIZING ANY MORE
	JRST SSS		;ENTER SCHEDULER
SUBTTL SERVICE SCHEDULER (SS)

; SCHEDULER REQUEST QUEUE ENTRY EQUATES

FLDPTR==0
  FLDDEF(RE.TIM,1)		;OFFSET TO ACTIVATION TIME
  FLDDEF(RE.ENT,1)		;OFFSET TO GLOBAL ENTRY ADDRESS
  FLDDEF(RE.ARG,1)		;OFFSET TO ARGUMENT
RE.LEN==FLDPTR			;LENGTH OF SCHEDULER ENTRY

; ONCE AGAIN INTO THE FRAY, DEAR FRIENDS

SSS:	TXZ F,IRETF		;SET NOT INTERRUPTIBLE
	CAME P,[IOWD PDLEN,PDL]	;STACK POINTER OK?
	JSP CX,STOPP		;NO, CRASH
	CALL DDCTLD		;CHECK FOR ENABLE/DISABLE ^D
	TXO F,IRETF		;SET INTERRUPTIBLE
	SKIPN NSR		;QUEUES EMPTY?
	WAIT			;YES, REG TO SLEEP
	GTAD			;GET CURRENT TIME & DATE IN T1
	MOVE T2,SRQ+RE.TIM	;GET TIME/DATE OF EARLIEST REQUEST
	SUB T2,T1		;IS IT IN THE FUTURE?
	JUMPLE T2,SSER		;NO, GET ON IT RIGHT AWAY

; SLEEP UNTIL WAKE-UP TIME OF EARLIEST REQUEST

	MOVE T1,T2		;COPY INTERNAL FORMAT SLEEP INTERVAL
	MUL T1,[DAYSEC*^D1000]	;COMPUTE # OF MILLISECONDS
	ASHC T1,^D17		; TO SLEEP IN T1
	DISMS			;SLEEP UNTIL NEEDED
	JRST SSS		;ATTEMPT SCHEDULE AGAIN

; SCHEDULE THE FIRST REQUEST IN THE QUEUE

SSER:	TXZ F,IRETF		;AIN'T IDLE NO MORE
	MOVEI T1,.FHSLF
	DIR			;INHIBIT INTERFERENCE
	MOVE T4,SRQ+RE.ENT	;GET ROUTINE ENTRY ADDRESS
	MOVE T3,SRQ+RE.ARG	;GET ARG FOR HANDLER ROUTINE
	SOS T1,NSR		;GET # OF REQUESTS REMAINING
	JUMPE T1,SSS1		;IF NONE LEFT, DON'T BLT
	IMULI T1,RE.LEN		;COMPUTE # OF WORDS TO BLT
	MOVE T2,[SRQ+RE.LEN,,SRQ] ;GET BLT SOURCE,,DESTINATION
	BLT T2,SRQ+RE.LEN-1(T1)	;DELETE HEAD OF QUEUE
SSS1:	MOVEI T1,.FHSLF
	EIR			;PERMIT INTERRUPTS
	DMOVEM T3,SSSDAT	;STORE CALLED-ROUTINE INFO FOR DEBUG
	CALL (T4)		;CALL USER ROUTINE WITH ARG IN T3
	TXZE F,ABORTF		;WERE ANY REQUESTS ABORTED?
	CALL PRQABT		;YES, PURGE THEM FROM REQUEST QUEUE
	JRST SSS		;GO SEE IF MORE WORK TO DO
; SRA - ADD SCHEDULER REQUEST TO QUEUE (2 ENTRY POINTS)
; SRAA - ABSOLUTE INTERNAL-FORMAT TIME & DATE IN T1
; SRAI - INCREMENTAL FORM: # OF SECONDS FROM NOW IN T1
; SRAN - REQUEST IS TO BE SCHEDULED AS SOON AS POSSIBLE (T1 MEANINGLESS)
;  T2/ ROUTINE ADDRESS IN RIGHT HALF
;  T3/ ARGUMENT TO BE SUPPLIED TO ROUTINE IN T3 AT TIME OF CALL
; RETURNS +1: ALWAYS

SRAI:	STAKT			;STACK T1-T4
	MUL T1,[1,,0]		;CONVERT # OF SECONDS
	DIVI T1,DAYSEC		; TO INCREMENTAL INTERNAL FORMAT
	MOVE T2,T1		;CLEAR OUT OF T1 FOR GTAD
	GTAD			;GET CURRENT INTERNAL T/D
	ADD T1,T2		;ADD INCREMENT
	JRST SRA1		;SKIP OTHER ENTRY

SRAN:	SETZ T1,		;IMMEDIATE FLAVOR - STUFF T1
SRAA:	STAKT			;STACK T1-T4

; COMMON CODE FOR SRAx

SRA1:	MOVE T4,T1		;MOVE ACTIVATION TIME TO T4
	MOVEI T1,.FHSLF
	DIR			;INHIBIT INTERFERENCE
	SETZ T2,		;INIT SCAN INDEX
	MOVNI T3,RE.LEN		;INIT QUEUE POINTER
SRA2:	ADDI T3,RE.LEN		;BUMP QUEUE POINTER
	CAMGE T2,NSR		;ANY ENTRIES LEFT TO CHECK AGAINST?
	JRST [	CAML T4,SRQ+RE.TIM(T3) ;YES, EARLIER THAN THIS ENTRY?
		AOJA T2,SRA2	;NO, CONTINUE SEARCH
		JRST .+1]	;YES, GO INSERT IT HERE
	SUB T2,NSR		;COMPUTE # OF
	MOVNS T2		; ENTRIES TO BE SHIFTED DOWN
	IMULI T2,RE.LEN		;COMPUTE # OF WORDS TO SHIFT
	MOVE T3,NSR
	IMULI T3,RE.LEN		;SET UP LOAD/STORE INDEX AT TAIL
	JUMPE T2,SRA3		;IF NONE, SKIP SHIFTING STUFF
SRA4:	MOVE T1,SRQ-1(T3)	;GET A WORD
	MOVEM T1,SRQ+RE.LEN-1(T3) ;SHIFT IT DOWN
	SOS T3			;INDEX NEXT WORD
	SOJG T2,SRA4		;LOOP TILL ALL SHIFTING DONE

; INSTALL ENTRY IN NEWLY-CREATED SLOT

SRA3:	MOVEM T4,SRQ+RE.TIM(T3)	;STUFF TIME/DATE
	XMOVEI T1,20
	HRR T1,CT2
	MOVEM T1,SRQ+RE.ENT(T3)	;STUFF GLOBAL ENTRY ADDRESS
	MOVE T1,CT3
	MOVEM T1,SRQ+RE.ARG(T3)	;STUFF ARGUMENT
	AOS NSR			;BUMP # OF ENTRIES IN QUEUE
	MOVEI T1,.FHSLF
	EIR			;PERMIT INTERRUPTS
	RET
; EIHR - SUPPORT ROUTINE FOR EXTERNAL INTERRUPTS

EIHR:	ADJSP P,5		;CREATE ROOM ON STACK FOR T1-T4, CX
	MOVEM CX,-4(P)		;SAVE CX
	DMOVEM T1,-3(P)		;SAVE T1 & T2
	DMOVEM T3,-1(P)		;SAVE T3 & T4

; REQUEST SCHEDULING AT INTERRUPT HANDLER ENTRY POINT

	MOVE T2,@-5(P)		;GET ADDRESS OF ROUTINE
	CALL SRAN		;SCHEDULE AT THIS ADDRESS IMMEDIATELY

; RESTORE AC'S AND EXIT TO INTERRUPTED PROGRAM OR SCHEDULER

	MOVE CX,-4(P)		;RESTORE CX
	DMOVE T1,-3(P)		;RESTORE T1 & T2
	DMOVE T3,-1(P)		;RESTORE T3 & T4
	ADJSP P,-6		;DELETE TEMP SPACE FROM STACK
	TXZN F,IRETF		;SCHED GOOFING OFF?
	DEBRK			;NO, GO BACK TO INTERRUPTED CODE
	MOVE CX,[PC%USR+SSS]	;YES, GET NEW PC
	MOVEM CX,@LEVTAB+PRIEXT-1 ;STUFF IT
	DEBRK			;EXIT TO SCHEDULER
SUBTTL ACCOUNTING ROUTINES

;ACCSTI - STRUCTURE COUNT BEING INCREMENTED. BUILD ACCOUNTING BLOCK FOR
;	  USER

ACCSTI:	HRRZ T1,RBUF+4		;GET STRUCTURE STATUS
	TRNE T1,(MS%NRS)	;IS IT NON-REGULATED?
	JRST ACCS3		;YES, FORGET ENTRY AND DELETE OLD BLOCK
	HLRZ T1,RBUF+2		;GET JOB NUMBER
	HRRZ T2,RBUF+3		;GET DEVICE DESIGNATOR
	HRLI T2,.DVDES+.DVDSK	;ADD DISK DESIGNATION
	CALL FNDACC		;SEE IF THERE IS A BLOCK ALREADY
	JRST ACCS1		;NO
        SKIPN ACCSVT(ACC)	;IS THERE A SERVICED TIME
	JRST ACCS2		;NO. SO STORE INFORMATION.
	AOS ACCFRK(ACC)		;YES, INCREMENT FORK COUNT
	RET			;FINISHED
ACCS1:	CALL GETACC		;GET AN ACCOUNT BLOCK
	 CALLRET DELACC		;ABORT SINCE ACC BLOCKS IN SHORT SUPPLY
ACCS2:	AOS ACCFRK(ACC)		;SET NUMBER OF FORKS USING STR TO 1

;STORE ACCOUNTING INFORMATION

	HRRZ T1,RBUF+3		;GET STRUCTURE UNIQUE CODE
	HRLI T1,.DVDES+.DVDSK	;ADD DISK DESIGNATOR
	MOVEM T1,ACCDD(ACC)	;STORE IN ACCOUNTING BLOCK
	MOVE T1,RBUF+2		;GET JOB #,,LINE #
	MOVEM T1,ACCNO(ACC)
	MOVE T2,RBUF+10		;GET USER #
	HRROI T1,ACCUSR(ACC)
	DIRST			;TRANSLATE TO NAME
	 JFCL
	MOVEI T1,ACCSTG(ACC)	;SET UP BLT POINTER
	HRLI T1,RBUF+11
	BLT T1,ACCSTG+7(ACC)	;STORE ACCOUNT STRING
	MOVE T1,RBUF+7
	SKIPN ACCSCD(ACC)	;IF NO TIME SCHEDULED
	MOVEM T1,ACCSCD(ACC)	;TIME SCHEDULED
	MOVEM T1,ACCSVT(ACC)	;AND SERVICED ARE THE SAME
	MOVE T1,RBUF+6
	MOVEM T1,ACCSTN(ACC)	;STORE STRUCTURE NAME
	HLRZ T1,RBUF+4
	STOR T1,ACCMB		;STORE MOUNT COUNT
	HLRZ T1,RBUF+5
	STOR T1,ACCNU		;STORE NUMBER OF UNITS
	HRRZ T1,RBUF+5
	STOR T1,ACCDT		;STORE DISK TYPE
	HRRZ T1,RBUF+4		;GET STRUCTURE STATUS
	MOVEI T2,4		;ASSUME STRUCTURE IS FOREIGN
	TRNE T1,(MS%DOM)	;IS IT DOMESTIC?
	MOVEI T2,3		;YES, GET DOMESTIC CODE
	STOR T2,ACCST		;STORE STRUCTURE TYPE
	SETZRO ACCKT		;SET CONTROLLER TO ALL ONES
	MOVE T1,[SIXBIT/NORMAL/] ;PRESET TO NORMAL DISPOSITION
	MOVEM T1,ACCDSP(ACC)	; SAVE IT
	RET
ACCS3:	HLRZ T1,RBUF+2		;GET JOB NUMBER
	HRRZ T2,RBUF+3		;GET DEVICE DESIGNATOR
	HRLI T2,.DVDES+.DVDSK	;ADD DISK DESIGNATION
	CALL FNDACC		;SEE IF THERE IS A BLOCK ALREADY
	RET			;NO, JUST RETURN
	SKIPE ACCSVT(ACC)	;IS IT LEFT OVER FROM A PHYSICAL MOUNT REQ?
	RET			;NO, LEAVE IT ALONE
	CALLRET DELACC		;YES, DELETE IT
;ACCSTD - STRUCTURE COUNT BEING DECREMENTED. MAKE USAGE ENTRY.

ACCSTD:	HLRZ T1,RBUF+2		;GET JOB NUMBER
	MOVE T2,RBUF+3		;GET DEVICE DESIGNATOR
	HRLI T2,.DVDES+.DVDSK	;ADD DISK DESIGNATION
	CALL FNDACC		;FIND ACCOUNT BLOCK
	 RET			;THERE WAS NONE
	SOSE ACCFRK(ACC)	;ANY OTHER FORKS HAVE IT INCREMENTED?
	RET			;YES, DON'T SEND ANY INFO, YET
	CALL STOSTR		;STORE STR INFO FROM ACCOUNT BLOCK
	HRRZ T1,RBUF+2		;GET MOUNT COUNT
	MOVEM T1,USTDC
	MOVEI T1,.UTMNT		;THIS IS STRUCTURE MOUNT INFO
	CALL SNDACC		;SEND USAGE INFO TO MONITOR
	CALLRET DELACC		;DELETE ACCOUNT BLOCK

;ACCSTR - STRUCTURE BEING REMOVED.  SEND ACCOUNT BLOCKS TO USAGE

ACCSTR:	QSCANI AABQDB		;SET UP TO SCAN ACTIVE ACCOUNT BLOCKS
	MOVE Q1,RBUF+3		;GET DEVICE DESIGNATOR
	HRLI Q1,.DVDES+.DVDSK	;ADD DISK DESIGNATION
ACCSR1:	CALL QMSCAN		;GET ADDRESS OF NEXT ACC IN T2
	 RET			;NONE LEFT
	MOVEI ACC,-ACCLNK(T2)	;LOAD ACC ADDRESS
	CAME Q1,ACCDD(ACC)	;IS THIS THE STR BEING REMOVED
	JRST ACCSR1		;NO, GET NEXT ACCOUNT BLOCK
	CALL STOSTR		;STORE STR INFO INTO USAGE BLOCK
	MOVEI T1,.UTMNT		;THIS IS STRUCTURE MOUNT INFO
	CALL SNDACC		;SEND USAGE INFO TO MONITOR
	CALL DELACC		;DELETE ACCOUNT BLOCK
	JRST ACCSR1		;GET NEXT BLOCK
;ACCMTR - TAPE BEING REQUESTED.  BUILD ACCOUNTING BLOCK FOR USER

ACCMTR:	CALL GETACC		;GET ACCOUNT BLOCK
	 JRST DELACC		;ABORT SINCE ACC BLOCKS IN SHORT SUPPLY
	MOVSI T1,RSBACT(RSB)	;BLT SOURCE
	HRRI T1,ACCSTG(ACC)	;BLT DESTINATION
	BLT T1,ACCSTG+7(ACC)	;MOVE USER'S ACCOUNT STRING TO ACC
	GTAD			;STORE TIME SCHEDULED
	MOVEM T1,ACCSCD(ACC)	;IN ACCOUNT BLOCK
	LOAD T1,RSBJNO		;GET USER'S JOB NUMBER
	STOR T1,ACCJN
	CALL STONAM		;STORE USER'S NAME
	 JRST DELACC		;USER NOT AROUND, DELETE ACC BLOCK
	MOVSI T1,.DVDES+.DVMTA	;GET DEVICE DESIGNATOR
	MOVEM T1,ACCDD(ACC)	;STORE IN ACCOUNT BLOCK
	MOVE T1,[SIXBIT/NORMAL/] ;PRESET TO NORMAL DISPOSITION
	MOVEM T1,ACCDSP(ACC)	; SAVE IT
	STOR ACC,RSBACC		;STORE ACCOUNT BLOCK ADDRESS INTO RSB
	RETSKP

;ACCMTD - TAPE BEING DISMOUNTED. MAKE USAGE ENTRY FOR USER

;ACCEPTS: MT/	ADDRESS OF MT STATUS BLOCK
;	  MTA/	ADDRESS OF MTA STATUS BLOCK
;	  RSB/  ADDRESS OF REQUEST STATUS BLOCK

ACCMTD:	SAVEAC <ACC>
	SETZM UMTKTP		;SET CONTROLLER TYPE TO ZERO
	LOAD ACC,RSBACC		;RETRIEVE ACCOUNT BLOCK ADDRESS
	MOVE T1,MTAVOL(MTA)	;GET VOLID
	MOVEM T1,UMTVID
	LOAD T1,MTALT		;GET LABEL TYPE
	MOVEM T1,UMTLT		; INTO USAGE BLOCK
	MOVEI T2,.LSUNL		;LABEL STATE, ASSUME UNLABELLED.
	CAIE T1,.LTUNL		;IS IT REALLY UNLABELLED?
	MOVEI T2,.LSPRI		;NO, MUST BE PRIVATE.
	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	TXNE T1,MA%SCR		;IS IT SCRATCH?
	MOVEI T2,.LSSCR		;YES, SAY SO
	MOVEM T2,UMTLS		;LABEL STATE INTO USAGE BLOCK
	CALL MTAGJF		;GET MAGTAPE JFN
	MOVEI T2,.MOINF		;GET TAPE INFORMATION
	MOVEI T3,.MOIWF		;GET LENGTH OF INFO BLOCK
	MOVEM T3,TAPEBK
	MOVEI T3,TAPEBK		;PUT ALL INFO INTO TAPEBK
	MTOPR
	CALL MTARJF		;RELEASE JFN
	MOVE T1,TAPEBK+.MOIRD	;GET NUMBER OF PHYSICAL RECS READ
	SUB T1,ACCPR(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTMRD
	MOVE T1,TAPEBK+.MOIWT	;GET NUMBER OF PHYSICAL RECS WRITTEN
	SUB T1,ACCPW(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTMWR
	MOVE T1,TAPEBK+.MOIRF	;GET NUMBER OF FRAMES READ
	IDIVI T1,^D1000		;IN THOUSANDS
	SUB T1,ACCFR(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTMRF
	MOVE T1,TAPEBK+.MOIWF	;GET NUMBER OF FRAMES WRITTEN
	IDIVI T1,^D1000		;IN THOUDANDS
	SUB T1,ACCFW(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTMWF
	MOVE T1,TAPEBK+.MOISR	;GET NUMBER OF SOFT READ ERRORS
	SUB T1,ACCSR(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTSRE
	MOVE T1,TAPEBK+.MOISW	;GET NUMER OF SOFT WRITE ERRORS
	SUB T1,ACCSW(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTSWE
	MOVE T1,TAPEBK+.MOIHR	;GET NUMBER OF HARD READ ERRORS
	SUB T1,ACCHR(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTHRE
	MOVE T1,TAPEBK+.MOIHW	;GET NUMBER OF HARD WRITE ERRORS
	SUB T1,ACCHW(ACC)	;SUBTRACT STARTING VALUE
	MOVEM T1,UMTHWE
	MOVE T1,RSBASN(RSB)	;GET VOLUME SET NAME
	MOVEM T1,UMTFSI
	MOVE T1,ACCDSP(ACC)	; GET DISPOSITION OF REQUEST
	MOVEM T1,UMTDSP		; SAVE IT
	MOVEI T1,.UTMMT		;THIS IS TAPE MOUNT INFO
	CALLRET SNDACC		;SEND ACCOUNTING INFO TO MONITOR
;DELACC - DELETE ACCOUNT BLOCK FROM QUEUE
;ACCEPTS: ACC/	ADDRESS OF ACCOUNT BLOCK
;RETURNS: +1, NOTHING

DELACC:	SETZM ACCDD(ACC)	;SET ACC INACTIVE
	QSCANI AABQDB		;SET UP TO SCAN ACTIVE ACC QUEUE
	SAVEAC <ACC>

; SEARCH ACCOUNT BLOCK QUEUE AND EXTRACT ABORTED REQUESTS

DELAC1:	CALL QMSCAN		;GET ADDRESS OF NEXT ACC ON QUEUE
	 RET			;NONE LEFT, EXIT
	MOVEI ACC,-ACCLNK(T2)	;LOAD ACC WITH ACC BLOCK ADDRESS
	SKIPE ACCDD(ACC)	;IS REQUEST ABORTED?
	JRST DELAC1		;NO, SKIP IT
	CALL QMDQS		;DEQUEUE ACC, GET LINKAGE ADDR IN T2
	MOVEI T1,IABQDB		;GET QDB ADDRESS
	CALL QMQH		;QUEUE ACC TO HEAD OF INACTIVE QUEUE
	JRST DELAC1		;CONTINUE SCAN

;FNDACC - FIND AN EXISTING ACCOUNT BLOCK

;ACCEPTS: T1/	JOB NUMBER
;	  T2/	DEVICE DESIGNATOR

;RETURNS: +1,	FAILURE, COULD NOT FIND BLOCK
;	  +2,	SUCCESS, ACC/ ADDRESS OF ACCOUNT BLOCK

FNDACC:	SAVEQ
	DMOVE Q1,T1
	QSCANI AABQDB		;SET UP TO SCAN ACTIVE ACC QUEUE
FNDAC1:	CALL QMSCAN		;GET ADDRESS OF NEXT ACC IN T2
	 RET			;NONE LEFT
	MOVEI ACC,-ACCLNK(T2)	;LOAD ACC ADDRESS
	CAME Q2,ACCDD(ACC)	;IS THIS THE RIGHT DEVICE DESIGNATOR?
	JRST FNDAC1		;NO, GET ANOTHER ACC
	LOAD T1,ACCJN
	CAME Q1,T1		;IS THIS THE RIGHT JOB?
	JRST FNDAC1		;NO, TRY ANOTHER ACC
	RETSKP			;SUCCESS

; GETABI - INITIALIZE FREE ACC POOL FOR GETACC
; RETURNS +1: ALWAYS

GETABI:	SAVEQ
	MOVEI Q1,ACC0		;GET ADDRESS OF ACC POOL
	MOVEI Q2,MAXACC+1	;# OF ACCS IN POOL
GTABI1:	MOVEI T1,IABQDB		;GET QDB ADDRESS
	MOVEI T2,ACCLNK(Q1)	;GET ADDRESS OF ACC LINKAGE
	CALL QMQT		;QUEUE ACC TO TAIL OF FREE QUEUE
	ADDI Q1,ACCSIZ		;POINT Q1 AT NEXT ACC
	SOJG Q2,GTABI1		;LOOP THRU ALL ACCOUNT BLOCKS
	RET
; GETACC - ALLOCATE AN ACCOUNT BLOCK
; RETURNS +1: ACCOUNT BLOCK ALLOCATED, BUT IT'S THE LAST ONE
;	  +2: ACCOUNT BLOCK ALLOCATED, MORE FREE ACC BLOCK'S LEFT
;  ACC/ ADDR OF ACCOUNTING BLOCK

GETACC:	MOVEI T1,IABQDB		;POINT TO INACTIVE ACC QUEUE
	CALL QMDQH		;DEQUEUE HEAD OF QUEUE
	 CALL STOP		;QUEUE EMPTY, PROGRAM LOGIC ERROR
	MOVEI ACC,-ACCLNK(T2)	;LOAD UP ACC AC
	MOVSI T1,1(ACC)		;BLT SOURCE
	HRRI T1,2(ACC)		;BLT DESTINATION
	SETZM 1(ACC)		;CLEAR 2ND WORD OF ACC
	BLT T1,ACCSIZ-1(ACC)	;CLEAR THE REST OF THE ACC
	GTAD
	MOVEM T1,ACCCRT(ACC)	;STORE TIME WHEN REQUEST WAS RECEIVED
	MOVEI T2,ACCLNK(ACC)	;GET ADDRESS OF ACC LINKAGE WORD
	SKIPN IABQDB		;WAS THIS THE LAST FREE ACC?
	JRST [	MOVEI T1,IABQDB	;YES, CAN'T GIVE IT AWAY
		CALLRET QMQH]	;PUT ON INACTIVE QUEUE AND TAKE +1
	MOVEI T1,AABQDB		;NOT THE LAST FREE ONE
	CALL QMQT		;QUEUE TO TAIL OF ACTIVE QUEUE
	RETSKP

;SNDACC - SEND ACCOUNTING INFORMATION TO MONITOR

;ACCEPTS: T1/	TYPE OF ENTRY
;	  ACC/	ADDRESS OF ACCOUNT BLOCK

;RETURNS: +1,	ALWAYS

SNDACC:	MOVE T4,T1		;SAVE TYPE OF ENTRY
	GTAD			;GET CURRENT DATE AND TIME
	SUB T1,ACCSVT(ACC)	;SUBTRACT SERVICED TIME GIVING DAYS,,FRACTION
	MOVEM T1,ACCEUT(ACC)	; AND STORE. CHKPNT WILL CONVERT TO SECONDS.
	MOVE T1,T4		;RESTORE TYPE OF ENTRY
	MOVEI T2,USRNAM		;MOVE COMMON INFO FROM ACCOUNT BLOCK
	HRLI T2,ACCUSR(ACC)	; TO USAGE AREA
	BLT T2,USRNAM+ACCCSZ-4
	LOAD T2,ACCJN		;GET JOB NUMBER
	MOVEM T2,JOBNO
	HRRE T2,ACCNO(ACC)	;[6027]GET LINE # (use HRRE to extend sign bit)
	MOVEM T2,LINO
	MOVEI T2,USGSTR		;ASSUME STRUCTURE RECORD
	CAIE T1,.UTMNT		;IS IT A STRUCTURE?
	MOVEI T2,USGMTA		;NO, IT'S A MAGTAPE ENTRY
	MOVEI T1,.USENT		;WRITE AN ENTRY INTO SYSTEM DATA FILE
	SKIPN TSTF		;DON'T MAKE USAGE ENTRY IF TESTING
	USAGE
	 ERCAL WOUSGF		;REPORT ERROR
	SETZM JOBNO		;ZERO USAGE AREA
	MOVE T1,[JOBNO,,JOBNO+1]
	BLT T1,JOBNO+USGSIZ-2
	RET
;STONAM - STORE USER'S NAME INTO ACCOUNT BLOCK

;ACCEPTS: T1/	USER NUMBER
;RETURNS: +1,	FAILURE, COULD NOT FIND USER
;	  +2,	SUCCESS

STONAM:	MOVE T2,[-2,,Q1]
	MOVEI T3,.JITNO		;GET TERMINAL AND USER NUMBERS
	GETJI
	 RET			;USER NOT AROUND
	SKIPN Q2		;IS USER REALLY THERE?
	RET			;NO
	STOR Q1,ACCLN		;STORE LINE NUMBER
	HRROI T1,ACCUSR(ACC)	;GET USER NAME
	MOVE T2,Q2
	DIRST
	 JFCL			;CAN'T GET NAME
	RETSKP

;STOSTR - STORE STRUCTURE INFO INTO USAGE BLOCK

;ACCEPTS: ACC/	ADDRESS OF ACCOUNT BLOCK
;RETURNS: +1,	ALWAYS

STOSTR:	MOVE T1,ACCSTN(ACC)	;GET STRUCTURE NAME
	MOVEM T1,USTNM
	LOAD T1,ACCKT		;GET CONTROLLER TYPE
	MOVEM T1,USTKTP
	LOAD T1,ACCDT		;GET DEVICE TYPE
	MOVEM T1,USTDTP
	LOAD T1,ACCST		;GET STRUCTURE TYPE
	MOVEM T1,USTSTP
	LOAD T1,ACCNU		;GET NUMBER OF PACKS
	MOVEM T1,USTTNP
	LOAD T1,ACCMB		;GET MOUNT COUNT BEFORE MOUNTING
	MOVEM T1,USTMC
	MOVE T1,ACCDSP(ACC)	; GET DISPOSITION OF REQUEST
	MOVEM T1,USTDSP		; SAVE IT
	MOVEI T1,1		;GET ACCESS TYPE
	MOVEM T1,USTATP         ;SAVE IT
	RET
SUBTTL AVR - AUTOMATIC VOLUME RECOGNITION

; AVR - INITIATE AVR SEQUENCE FOR A TAPE DRIVE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

AVR:	JN MTAJCT,,R		;EXIT IF I'M ALREADY PROCESSING
	JN MTALT,,R		;EXIT IF VOLUME ALREADY RECOGNIZED
	JN MTAMT,,[LOAD T1,MTASTE ;GET STATE
		CAIE T1,S.INIT	;IN INIT MODE?
		RET		;NO, EXIT
		JRST .+1]	;YES, PROCEED
	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	MOVEI T2,.LTUNL
	TXNN T1,MA%AVS		;IS AVR SUPPORTED FOR THIS DRIVE?
	STOR T2,MTALT		;NO, MUST CLASSIFY AS UNLABELED
	TXNN T1,MA%AVE		;IS AVR ENABLED FOR THIS DRIVE?
	JRST [	CALL REW	;NO, IS DRIVE LOADED?
		 RET		;NO
		CALLRET WOTMD]	;YES, TELL OPERATOR ABOUT IT
	MOVX T1,MA%UXV+MA%OPF
	ANDCAM T1,MTAFLG(MTA)	;CLEAR LABEL-RELATED FLAGS
	CALL MTAGJF		;GET JFN ON MTA DEVICE
	MOVEI T1,DENMAX
	STOR T1,MTADEN		;START AT HIGHEST DENSITY

; LOOP TO CHECK FOR LABEL AT ALL AVAILABLE DENSITIES

AVR2:	LOAD T1,MTADEN		;GET DENSITY
	CALL DRVDEN		;CAN THE DRIVE OPERATE AT THIS DENSITY?
	 JRST AVR2B		;NO, SKIP TO THE NEXT DENSITY
	MOVEI T1,AVR2A		;ENTER AT AVR2A AFTER REWIND
	CALL REWEA		;TRY TO REWIND
	 JRST AVR3		;CAN'T REWIND, WRAP UP AVR
	RET			;EXIT UNTIL REWIND COMPLETES

; END-ACTION FOR REWIND

AVR2A:	CALL CHKLT		;CHECK LABEL TYPE OF THE TAPE
	 SKIPA			;CAN'T READ TAPE AT THIS DENSITY
	JRST AVR3		;TAPE WAS IDENTIFIFED AT THIS DENSITY
AVR2B:	DECR MTADEN		;NEXT DENSITY
	JN MTADEN,,AVR2		;GO AROUND FOR ANOTHER TRY

; NOTHING CAN BE READ FROM THIS TAPE

	MOVEI T1,.SFTDF
	TMON			;GET TAPE-MOUNT CONTROLS SET BY SETSPD
	JXN T2,MT%UUT,[CALL UNLOAD ;IF UNLOAD SET BY INSTALLATION, DO IT
		CALL MTARJF	;DUMP JFN
		CALL WOLRDX	;TELL OPERATOR
		JRST AVR4]	;GO CHECK WAITING RSB'S

; MTA STATUS BLOCK NOW REFLECTS THE ATTRIBUTES OF THE AVR'ED VOLUME

AVR3:	CALL MTARJF		;DUMP JFN
	LOAD T1,MTASTE
	CAIN T1,S.INIT		;DRIVE IN INITIALIZE MODE?
	JRST [	CALLRET KVITAV]	;YES, SPECIAL EXIT
	CALL CKMPAV		;DRIVE STILL AVAILABLE?
	 CALL DACMTA		;NO, HERE IS A GOOD PLACE TO DEACTIVATE
	MOVE T1,MTAFLG(MTA)
	JXE T1,MA%LOD,AVR4	;WRAP UP IF DRIVE NOT LOADED
	CALL WOTMD		;TELL OPERATOR TAPE IS MOUNTED
	CALL WOCKSW		;IS THIS A WRITE-PROTECTED SCRATCH TAPE?
	 JRST AVR4		;YES, DRIVE UNLOADED AND MESSAGE TYPED
	SKIPN MTAVOL(MTA)	;HAS THE VOLUME BEEN IDENTIFIFED?
	RET			;NO, MUST WAIT FOR KEYIN
	CALL MATCHV		;YES, TRY FOR A MATCH

; CHECK IF NECESSARY TO TELL THE OPERATOR OF PENDING TAPE MOUNT REQUESTS

AVR4:	QSCANI ARBQDB		;SET UP TO SCAN REQUEST QUEUE
AVR41:	CALL NMTRSB		;GET NEXT TAPE REQUEST IN RSB AC
	 RET			;NONE LEFT
	CALL WOVMT		;TELL OPERATOR IF NECESSARY
	JRST AVR41		;LOOP THRU ALL REQUESTS
; CHKLT - IDENTIFY LABEL TYPE OF A TAPE AND UPDATE MTA STATUS BLOCK
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: COULD NOT READ ANY INFORMATION FROM THE TAPE
;	  +2: TAPE WAS IDENTIFIED AT DENSITY IN MTADEN

CHKLT:	SAVEQ

; Q1/	BIT 01 SET - VOL1 ACCESSIBILITY IS NOT BLANK
;	BIT 02 SET - HDR1 ACCESSIBILITY IS NOT BLANK
;	BIT 04 SET - OVERWRITE ACCESS DENIED - WORLD DP%CN IS RESET
;	BIT 10 SET - OVERWRITE ACCESS DENIED - WORLD FP%WR IS RESET
; Q2/	1 = READING CORE-DUMP MODE, 0 = READING INDUSTRY-COMPATIBLE MODE
; Q3/	CONTENTS OF MTAVOL AT TIME CHKLT WAS CALLED (USED TO RESTORE
;	MTAVOL IF TAPE HAS A VOL1 BUT NO HDR1)

	MOVE Q3,MTAVOL(MTA)	;REMEMBER CURRENT VOLID
	SETZ Q1,
	MOVEI T1,.LTUNL
	STOR T1,MTALT		;SET UNLABELED INITIALLY FOR LBLICV
	CALL MTAOPI		;OPEN MTA JFN
	 RETSKP			;OFFLINE

; CHECK FOR AND PROCESS VOL1 LABEL
; THE FIRST READ IS DONE IN CORE-DUMP MODE TO ALLOW FOR READING THE
; LARGEST POSSIBLE RECORD THAT TOPS-20 CAN WRITE (MOST LIKELY CASE
; SEEMS TO BE AN UNLABELED DUMPER TAPE WITH A LARGE BLOCKING FACTOR).
; BITS 0-31 OF THE FIRST WORD LOOK THE SAME IN CORE-DUMP AND I/C MODES,
; AND THAT'S THE FIRST 4 FRAMES OF THE RECORD (ALL I CARE ABOUT HERE).
; IF IT'S A VOL1, THEN REWIND AND READ IT AND ALL OTHER LABELS IN I/C
; MODE.  IF IT'S NOT A VOL1, THEN JUST CLASSIFY THE TAPE AS UNLABELED.

	MOVEI Q2,1		;SETUP Q2 FOR LOOPING
CHKL1:	CALL REW		;REWIND TO TEST IF DRIVE IS ONLINE
	 JRST [	CALL MTACLS	;OFFLINE, CLOSE JFN
		RETSKP]		;PREVENT CHECKING OTHER DENSITIES
	LOAD T1,MTAJFN		;GET JFN
	MOVEI T2,.MOSDM		;MTOPR FUNCTION CODE
	MOVE T3,[EXP .SJDM8,.SJDMC](Q2) ;GET DESIRED DATA MODE
	MTOPR			;SET DATA MODE
	CALL RDLBL		;TRY TO READ 1ST RECORD FROM TAPE
	 JRST [	JUMPLE T1,CHKLR1 ;TIMEOUT OR DATA ERROR
		SKIPG Q2	;SKIP IF CORE-DUMP READ
		SETZM LBUF1	;NON-LABEL READ SUCCESSFULLY
		JRST .+1]	; SO FORCE CHKV1 TO SAY IT'S UNLABELED
	SOJE Q2,[LOAD T1,MTAJFN	;FIRST READ ATTEMPT, GET JFN
		MOVEI T2,.MORDN	;FUNCTION = READ DENSITY
		MTOPR		;GET DENSITY THE TAPE WAS READ AT IN T3
		STOR T3,MTADEN	;REMEMBER IT
		CALL CHKV1A	;IS IT A VOL1?
		 JRST CHKLP	;NO, CLASSIFY AS UNLABELED
		JRST CHKL1]	;YES, REWIND AND READ IN I/C MODE
	CALL CHKV1		;CHECK FOR VOL1, FILL IN STATUS BLOCK
	 JRST CHKLP		;NOT LABELED (SHOULD NEVER GET HERE)
	CAIE T1," "		;VOL1 ACCESSIBILITY BLANK?
	TRO Q1,1		;NO, SET FLAG
	SETZM MTASET(MTA)	;LABELED TAPE - CLEAR SETNAME
	JUMPE T2,CHKL2		;JUMP IF IT CAN'T BE A TOPS-20 TAPE

; CHECK FOR AND PROCESS VOL2 LABEL

	CALL RDLBL		;YES, GET LABEL AFTER VOL1
	 JRST CHKLUN		;NO LABEL AFTER VOL1, IT'S UNLABELED
	CALL CHKV2		;IS IT A VOL2?
	 JRST CHKL3		;NO
	STOR T1,MA%SCR,MTAFLG(MTA) ;YES, STORE SCRATCH FLAG
	TRNN T2,DP%CN		;WORLD DP%CN RESET?
	TRO Q1,4		;YES, SET DP%CN ACCESS-DENIED FLAG
	MOVEI T1,.LTT20
	STOR T1,MTALT		;SET LABEL-TYPE TO TOPS-20

; CHECK FOR AND PROCESS HDR1 LABEL

CHKL2:	CALL RDLBL		;GET NEXT LABEL
	 JRST CHKLUN		;NO LABEL HERE, TAPE IS UNLABELED
CHKL3:	MOVE T1,LBUF2		;GET FIRST 5 CHARACTERS FROM RECORD
	TRZ T1,77777		;KEEP THE FIRST 3 CHARACTERS
	CAME T1,[ASCIZ/VOL/]	;IS IT A VOL
	CAMN T1,[ASCIZ/UVL/]	; OR A UVL?
	JRST CHKL2		;YES, CONTINUE SEARCH
	CALL CKHDR1		;IF HDR1, UPDATE STATUS BLOCK
	 JRST CHKLUN		;NOT HDR1, TAPE IS UNLABELED
	CAIE T1," "		;HDR1 ACCESSIBILITY BLANK?
	TRO Q1,2		;NO, SET FLAG

; CHECK FOR AND PROCESS HDR2 LABEL

	CALL RDLBL		;GET NEXT LABEL
	 JRST CHKLP		;NO LABEL
	CALL CKHDR2		;CHECK IF HDR2
	 JRST CHKLP		;NOT HDR2
	TRNN T1,FP%WR		;WORLD WRITE-ACCESS ALLOWED TO FILE?
	TRO Q1,10		;NO, SET WRITE-ACCESS DENIED
CHKLP:	CALL CHKLR1		;REWIND AND CLOSE JFN
	LOAD T1,MTALT		;GET LABEL TYPE
	CAIN T1,.LTANS		;ANSI?
	JRST [	TRNE Q1,1+2	;YES, ANY NON-BLANK ACCESSIBILITIES?
		JRST CHKLPS	;YES, SET PROTECTED
		JRST CHKLPR]	;NO, RESET PROTECTED
	CAIN T1,.LTT20		;TOPS-20?
	JRST [	TRNE Q1,4	;YES, WORLD WRITE ACCESS DENIED TO VOL?
		JRST CHKLPS	;YES, SET PROTECTED
		TRNE Q1,2	;RESET PROT IF FILE ACCESSIBILITY BLANK
		TRNN Q1,10	; OR IF WORLD WRITE ACCESS IS ALLOWED
		JRST CHKLPR
		JRST CHKLPS]	;NEITHER, SET PROTECTED
	RETSKP

CHKLPS:	SETONE MA%OPF,MTAFLG(MTA) ;SET OVERWRITE-PROTECTED FLAG
CHKLPR:	JE MA%SCR,MTAFLG(MTA),RSKP ;RETURN IF NOT SCRATCH
	MOVX T1,MA%OPF+MA%UXV	;IT'S A SCRATCH TAPE
	ANDCAM T1,MTAFLG(MTA)	;TURN OFF OVERWRITE INHIBITORS
	RETSKP

CHKLR1:	CALL REW		;GET BACK TO BOT
	 JFCL			;OFFLINE, WILL BE CAUGHT BY AVR
CHKLID:	CALL MTACLS		;CLOSE MTA
	RET

; TAPE HAS A VOL1 BUT NO HDR1 - CLASSIFY IT AS UNLABELED

CHKLUN:	MOVEI T1,.LTUNL
	STOR T1,MTALT		;SET LABEL TYPE TO UNLABELED
	MOVEM Q3,MTAVOL(MTA)	;REPLACE OLD VOLID
	JRST CHKLP		;WRAP UP AND EXIT
; CHKV1 - IDENTIFY A VOLUME WHOSE FIRST RECORD IS IN LBUF1
;  MTA/ ADDR OF MTA STATUS BLOCK
;  LBUF1/ UNMODIFIED RECORD READ FROM TAPE
; RETURNS +1: VOLUME IS UNLABELED, MTALT UPDATED
;	  +2: VOLUME IS LABELED, MTALT AND MTAVOL UPDATED
;		T1/ VOL1 ACCESSIBILITY CHARACTER
;		T2/ 1 MEANS VOL1 MEETS NECESSARY CONDITIONS FOR
;		    CLASSIFICATION AS TOPS-20 LABEL TYPE, ELSE 0

; CHKV1A - DETERMINE IF RECORD IN LBUF1 (IN CORE-DUMP FORMAT) IS A VOL1
;  LBUF1/ UNMODIFIED RECORD READ FROM TAPE IN CORE-DUMP MODE
; RETURNS +1: NOT A VOL1
;	  +2: IS A VOL1

CHKV1:	TDZA T1,T1		;REMEMBER CHKV1 ENTRY
CHKV1A:	MOVEI T1,1		;REMEMBER CHKV1A ENTRY
	SAVET			;SET UP TO RETURN VALUES TO CALLER
	SETZM CT2		;SET NOT TOPS-20
	MOVE T2,LBUF1		;GET 1ST 4 FRAMES FROM TAPE
	TRZ T2,17		;B32-B35 MEANINGLESS, SO SET TO ZERO
	CAMN T2,[713533,,237420] ;EBCDIC VOL1?
	JRST [	MOVEI T1,.LTEBC	;YES, SET LABEL TYPE TO EBCDIC
		JRST CHKV11]	;SKIP OTHER TESTS
	TDZ T2,[1B0+1B8+1B16+1B24] ;CLEAR 8TH BITS FOR ASCII CHECK
	CAMN T2,[BYTE(8) "V","O","L","1"] ;ASCII VOL1?
	JRST [	MOVEI T1,.LTANS	;YES, IS EITHER ANSI OR TOPS-20
		JRST CHKV11]	; BUT ASSUME ANSI FOR NOW...
CHKV12:	MOVEI T1,.LTUNL
	SKIPN CT1		;DON'T STORE LABEL TYPE IF CHKV1A
	STOR T1,MTALT		;SET LABEL TYPE = UNLABELED
	RET			;+1 RETURN FOR UNLABELED

; VOL1 LABEL WAS FOUND

CHKV11:	SKIPE CT1		;CHKV1A ENTRY?
	RETSKP			;YES, INDICATE RECORD WAS A VOL1
	STOR T1,MTALT		;STORE LABEL TYPE IN MTA TABLE
	CALL LBLICV		;CONVERT LABEL TO 7-BIT ASCII
	MOVE T1,[ILPTR(V1VID)]	;ADDRESS VOLID FIELD IN VOL1
	MOVEI T2,6		;6-CHARACTER FIELD
	CALL CVTA6		;CONVERT VOLID TO SIXBIT
	 JRST CHKV12		;BAD VOLID, SO ASSUME UNLABELED

; GIVE ERROR IF VOLID FROM "IDENTIFY" COMMAND DOESN'T MATCH THE
; ACTUAL VOLID THAT IS RECORDED ON THE TAPE

	MOVEM T1,MTAVOL(MTA)	;STORE ACTUAL VOLID IN MTA STATUS BLOCK
	SKIPE MTAIDV(MTA)	;DOES ALLEGED VOLID EXIST?
	CAMN T1,MTAIDV(MTA)	;YES, ALLEGED VOLID MATCH ACTUAL VOLID?
	SKIPA			;NO ALLEGED VOLID, OR IT MATCHES ACTUAL
	CALL [	TMCT <%I%M Cannot Change Volid Of Labeled Tape>
		MOVEI T3,TMCMSG	;POINT TO MESSAGE
		CALLRET BTWTON]	;TELL OPERATOR HE BLEW IT
	SETZM MTAIDV(MTA)	;CLEAR ALLEGED VOLID

; COPY VOL1 TO MTA STATUS BLOCK AND CHECK FOR TOPS-20 LABEL TYPE

	MOVSI T1,LBUF1		;BLT SOURCE
	HRRI T1,MTAV1(MTA)	;BLT DESTINATION
	BLT T1,MTAV1+LB8WDS-1(MTA) ;TRANSFER VOL1 LABEL TO STATUS BLOCK
	LDB T1,[LPTR(V1ACS)]	;GET ACCESSIBILITY CHARACTER
	MOVEM T1,CT1		;RETURN ACCESSIBILTY TO CALLER
	CAIE T1,"1"		;TOPS-20 PROTECTION?
	RETSKP			;NO, WILL CLASSIFY AS ANSI TAPE
	MOVE T1,[ILPTR(V1SCD)]	;GET POINTER TO SYS CODE IN VOL1
	MOVE T2,[POINT 7,T20SCD] ;GET POINTER TO TOPS-20 SYS CODE
CHK201:	ILDB T3,T1		;GET CHAR FROM VOL1
	ILDB T4,T2		;GET CHAR FROM TOPS-20 SYS CODE
	JUMPE T4,[AOS CT2	;MATCH SUCCESSFUL, SET TOPS-20 VOL1
		RETSKP]
	CAMN T3,T4		;MATCH SO FAR?
	JRST CHK201		;YES, CONTINUE SCAN
	RETSKP			;RETURN, NON-TOPS-20 VOL1

; TOPS-20 SYSTEM CODE

T20SCD:	ASCIZ /DECSYS20**   /
; CHKV2 - EXAMINE LABEL BUFFER FOR VOL2 RECORD
;  LBUF2/ RECORD TO BE EXAMINED
; RETURNS +1: RECORD IS NOT A VOL2
;	  +2: RECORD IS A VOL2
;		T1/ 0=NON-SCRATCH  1=SCRATCH
;		T2/ TOPS-20 VOLUME PROTECTION CODE

CHKV2:	SAVET			;SET UP TO RETURN VALUES TO CALLER
	SETZM CT1
	MOVE T1,LBUF2		;GET FIRST 5 CHARS OF LABEL
	TRZ T1,377		;MASK DOWN TO 4 CHARACTERS
	CAME T1,[ASCII/VOL2/]	;IS IT A VOL2?
	RET			;NO, RETURN +1
	MOVSI T1,LBUF1		;BLT SOURCE
	HRRI T1,MTAV2(MTA)	;BLT DESTINATION
	BLT T1,MTAV2+LB8WDS-1(MTA) ;TRANSFER VOL2 LABEL TO STATUS BLOCK

	MOVE T1,[ILPTR(V2PRO)]	;GET POINTER TO PROTECTION FIELD
	CALL PROTIN		;GET PROTECTION IN T1
	 MOVEI T1,777777	;BAD PROTECTION, ASSUME ACCESSIBLE
	MOVEM T1,CT2		;RETURN PROTECTION CODE TO CALLER

	MOVE T2,[ILPTR(V2OWN)]	;GET POINTER TO VOL2 OWNER-NAME FIELD
	MOVEI T3,V2OWNL		;GET # OF CHARACTERS TO SCAN
CHKV21:	ILDB T4,T2		;GET A CHAR FROM OWNER'S NAME
	CAIE T4," "		;SPACE?
	RETSKP			;NO, NOT SCRATCH SO RETURN
	SOJG T3,CHKV21		;CONTINUE SCAN
	AOS CT1			;SCAN COMPLETE, IT'S A SCRATCH
	RETSKP
; CKHDR1 - CHECK LBUF2 FOR HDR1 AND PROCESS HDR1 FIELDS
;  LBUF2/ LABEL TO BE EXAMINED
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: NOT HDR1 LABEL
;	  +2: WAS HDR1 LABEL, INFORMATION STORED IN MTA STATUS BLOCK
;		T1/ HDR1 ACCESSIBILITY CODE

CKHDR1:	MOVE T1,LBUF2		;GET FIRST 5 CHARS OF LABEL
	TRZ T1,377		;MASK DOWN TO 4 CHARACTERS
	CAME T1,[ASCII/HDR1/]	;IS THIS A HDR1?
	RET			;NO
	MOVE T1,[ILPTR(H1SET)]	;YES, POINT TO SETNAME FIELD
	MOVEI T2,6		;6-CHARACTER FIELD
	CALL CVTA6		;CONVERT SETNAME TO SIXBIT
	 SETZ T1,		;BAD SETNAME, ASSUME NONE
	MOVEM T1,MTASET(MTA)	;STORE SET NAME IN STATUS BLOCK
	MOVE T1,[ILPTR(H1EXP)]	;POINT AT EXPIRATION-DATE FIELD
	CALL LDATIN		;CONVERT THE DATE FROM THE LABEL
	 SETZ T1,		;BAD DATE, ASSUME EXPIRED
	SETO T2,		;SPECIFY CURRENT DATE/TIME
	MOVX T4,IC%JUD		;WANT JULIAN FORM
	ODCNV			;GET T2/ YEAR,,JULIANDAY
	MOVX T3,MA%UXV
	CAMLE T1,T2		;IS THE TAPE EXPIRED?
	IORM T3,MTAFLG(MTA)	;NO, SET NOT-EXPIRED FLAG
	LDB T1,[LPTR(H1ACS)]	;GET ACCESSIBILITY CODE FOR CALLER
	RETSKP


; CKHDR2 - CHECK LBUF2 FOR HDR2 LABEL
;  LBUF2/ LABEL TO BE EXAMINED
; RETURNS +1: NOT HDR2
;	  +2: HDR2, T1/ TOPS-20 FILE PROTECTION CODE

CKHDR2:	MOVE T1,LBUF2		;GET 5 CHARS
	TRZ T1,377		;MASK DOWN TO 4 CHARACTERS
	CAME T1,[ASCII/HDR2/]	;HDR2?
	RET			;NO
	MOVE T1,[ILPTR(H2PRO)]	;GET POINTER TO PROTECTION CODE FIELD
	CALL PROTIN		;GET PROTECTION
	 MOVEI T1,777777	;ERROR, ASSUME UNPROTECTED
	RETSKP
; LBLICV - CONVERT INDUSTRY-COMPATIBLE LABEL IN LBUF1 TO 7-BIT ASCII
;	   LABEL IN LBUF2, USING THE FOLLOWING RULES:
;		NO CONVERSION PERFORMED FOR UNLABELED TAPES
;		ANSI AND TOPS-20 LABEL TYPES ASSUMED TO BE 8-BIT ASCII
;		EBCDIC LABEL TYPE ASSUMED TO BE 8-BIT EBCDIC
;  LBUF1/ LABEL TO BE CONVERTED, 80 8-BIT BYTES
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, LBUF2/ 7-BIT ASCII EQUIVALENT OF LABEL IN LBUF1

LBLICV:	SAVEQ
	LOAD T1,MTALT		;GET LABEL TYPE IN T1
	CAIN T1,.LTUNL		;UNLABELED?
	RET			;YES, RETURN TAKING NO ACTION
	DMOVE Q1,[POINT 8,LBUF1	;GET LOAD POINTER IN Q1
		POINT 7,LBUF2]	;GET GET STORE POINTER IN Q2
	MOVEI T2,LBLSIZ		;GET # OF FRAMES TO PROCESS
LBLCV1:	ILDB T3,Q1		;GET A BYTE FROM LBUF1
	CAIN T1,.LTEBC		;EBCDIC LABEL?
	JRST [	ADJBP T3,[POINT 7,EATT,6] ;YES, POINT AT ASCII EQUIV.
		LDB T3,T3	;GET ASCII EQUIVALENT IN T3
		JRST .+1]
	IDPB T3,Q2		;STORE CHARACTER IN LBUF2
	SOJG T2,LBLCV1		;LOOP THRU ENTIRE BUFFER
	RET
; RDLBL - READ A LABEL FROM A TAPE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: T1/ -1 = READ I/O OPERATION TIMED OUT
;	      T1/  0 = DEVICE OR DATA ERROR ON READ
;	      T1/  1 = TAPE MARK OR RECORD .LT. 80 FRAMES READ
;	  +2: RECORD OF 80 BYTES OR LONGER READ SUCCESSFULLY INTO
;	      LBUF1 IN INDUSTRY-COMPATIBLE FORMAT; ASCII EQUIVALENT
;	      LABEL IN LBUF2

RDLBL:	MOVE T1,[IOWD LBUF1W,LBUF1] ;GET IOWD FOR ENTIRE BUFFER
	SKIPN READCL		;FIRST READ SINCE I STARTED?
	MOVEM T1,READCL		;YES, SET UP TRIAL IOWD, EXPECT DUMPX3
RDLBL0:	LOAD T1,MTAJFN
	MOVEI T2,READCL		;GET ADDRESS OF COMMAND LIST
	IOXCT DUMPI,RDLBL1,RDLBL2 ;EXECUTE AND TIME OUT DUMPI JSYS
	JRST RDLBL3		;SUCCESSFUL (PROBABLY VERY RARE)

; ERROR RETURN FROM DUMPI

RDLBL1:	CALL CLRTAP		;CLEAR ERRORS AND GET ERROR INFO
	 JRST RDLBL2		;TIMED OUT
	CAIN T1,DUMPX3		;RECORD SIZE TOO LARGE?
	JRST [	MOVSI T1,1000	;YES
		ADDM T1,READCL	;REDUCE IT BY A PAGE
		JRST RDLBL0]	;TRY IT AGAIN WITH SMALLER RECORD SIZE
	CAIN T1,IOX4
	JRST [	MOVEI T1,1	;TAPE MARK, SET NON-LABEL
		RET]
	CAIE T1,IOX5		;DEVICE OR DATA ERROR?
	CALL STOP		;NO, I CAN'T HANDLE THIS ONE
	TXNE T2,MT%DVE+MT%DAE	;DEVICE ERROR OR DATA ERROR?
	JRST [	SETZ T1,	;YES
		RET]
	CAIGE T3,LBLSIZ		;IS THE RECORD LONG ENOUGH?
	JRST [	MOVEI T1,1	;NO
		RET]
RDLBL3:	CALL LBLICV		;GOOD LABEL, CONVERT IT
	RETSKP			;SUCCESSFUL RETURN

; DUMPI DID NOT COMPLETE IN TIME

RDLBL2:	CALL WOTIMO		;REPORT TIMEOUT TO OPERATOR
	SETO T1,		;RETURN -1
	RET
; POLLR - SELF-PERPETUATING PERIODIC MAGTAPE POLLING ROUTINE
;	  CHECKS FOR ONLINE-TO-OFFLINE AND OFFLINE-TO-ONLINE TRANSITIONS
; RETURNS +1: ALWAYS

POLLR:	TXO F,POLLF		;CAUSE CHECKS FOR ONLINE-TO-OFFLINE
	CALL TDSCIR		;PERFORM DRIVE SCAN
	TXZ F,POLLF
	MOVEI T1,POLINT		;GET INTERVAL BETWEEN POLLS
	MOVEI T2,POLLR		;ROUTINE ADDRESS
	CALLRET SRAI		;SCHEDULE NEXT POLL AND EXIT

; TDSCIH - CALLED AS A RESULT OF MTA STATUS CHANGE INTERRUPTS

TDSCIH:	AOSE TDSCF		;SCHEDULING REQUEST PRESENT ALREADY?
	DEBRK			;YES, EXIT
	CALL EIHR		;NO, REQUEST SCHEDULING AT TDSCIR
	EXP TDSCIR

; TDSCIR - CALLED BY SCHEDULER, REQUESTED BY TDSCIH
; RETURNS +1: ALWAYS

TDSCIR:	SAVEQ
	SAVEAC <MTA>
	SETOM TDSCF		;SET NO SCHEDULER REQUESTS FOR TDSCIR
	MOVE Q1,MTAN		;GET # OF MTA DEVICES ON SYSTEM
	MOVEI MTA,MTA0-MTASZ	;INIT MTA STATUS BLOCK POINTER

; I DON'T KNOW WHICH DRIVE DID IT, SO I HAVE TO CHECK EVERY ONE

TDSCI1:	SOJL Q1,R		;EXIT IF NO MTA DEVICES LEFT TO CHECK
	ADDI MTA,MTASZ		;GET STATUS BLOCK ADDRESS
	CALL TDSC1		;CHECK IT FOR A STATUS CHANGE
	JRST TDSCI1		;LOOP THRU ALL DRIVES
; TDSC1 - CHECK TAPE DRIVE FOR ONLINE/OFFLINE/REWIND-COMPLETE TRANSITION
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

TDSC1:	SAVEQ
	LOAD T1,MTASTE		;GET STATE
	JUMPE T1,R		;IGNORE IF NOT AVAILABLE
	CAIE T1,S.INIT		;IN INIT MODE?
	JRST [	JN MTAMT,,R	;NO, EXIT IF USER HAS THE DRIVE
		JRST .+1]
	CALL MTAGJF		;GET JFN NOW TO REDUCE GTJFN OVERHEAD
	MOVE Q1,MTAFLG(MTA)	;Q1/ MTA FLAGS
	CALL GMTADS
	MOVE Q2,T1		;Q2/ MTA STATUS BITS FROM MONITOR
	JXN Q2,SJ%OFS,[TXZE Q1,MA%LOD ;IF OFFLINE, DID I THINK SO TOO?
		CALL WOUNLW	;NO, ADMONISH OPERATOR
		MOVEM Q1,MTAFLG(MTA) ;UPDATE FLAGS
		JRST .+1]
	LOAD Q3,MTAREA		;END-ACTION ADDRESS PRESENT?
	JUMPN Q3,TDSC11		;YES
	TXNE Q1,MA%LOD		;PROCEED IF I THINK DRIVE IS UNLOADED
	TXNE Q1,MA%ULP		;PROCEED IF UNLOAD PENDING
	JRST TDSC11		;ONE OF THE ABOVE WAS TRUE
	TXNN F,POLLF		;POLLING?
	JRST [	CALLRET MTARJF]	;NO, NO NEED FOR FURTHER ANALYSIS
TDSC11:	LOAD T1,SJ%WLK,Q2	;GET WRITE-LOCKED BIT
	TRC T1,1		;COMPLEMENT TO GET WRITE-ENABLED
	STOR T1,MA%WEN,MTAFLG(MTA) ;STORE HERE FOR EASY REFERENCE

; CHECK FOR PENDING UNLOAD-REQUEST OR REWIND-ENDACTION

	TXZE Q1,MA%ULP		;WAS AN UNLOAD-REQUEST PENDING?
	JRST [	JXN Q2,SJ%REW,[CALLRET MTARJF] ;YES
		MOVEM Q1,MTAFLG(MTA) ;RESET MA%ULP IN STATUS BLOCK
		CALL UNLOAD	;UNLOAD THE DRIVE
		JRST .+1]
	JUMPN Q3,[JXN Q2,SJ%REW,[CALLRET MTARJF] ;EXIT IF REWINDING
		SETZRO MTAREA	;CLEAR END-ACTION ADDRESS
		CALL MTARJF	;DUMP JFN
		CALLRET (Q3)]	;CALL END-ACTION ROUTINE AND RETURN

; DRIVE NOT UNDER USER CONTROL AND AVR SEQUENCE NOT IN PROGRESS

	TXNN F,POLLF		;CHECK FOR ANY TRANSITION IF POLLING
	TXNN Q1,MA%LOD		;EXIT IF I THINK THE DRIVE IS LOADED
	CAIA			;POLLING OR DRIVE UNLOADED
	JRST [	CALLRET MTARJF]	;NOT POLLING AND DRIVE LOADED
	CALL REW		;IS IT LOADED NOW?
	 JRST [	TXNE Q1,MA%LOD	;NO, DID I THINK IT WAS LOADED?
		CALL WOUNLW	;YES, ADMONISH OPERATOR
		CALLRET MTARJF]	;DUMP JFN AND RETURN
	CALL MTARJF		;YES, DUMP JFN SO AVR CAN OCCUR
	TXNE Q1,MA%LOD		;HAS IT BEEN ONLINE ALL ALONG?
	RET			;YES, TAKE NO ACTION

; DRIVE IS COMING ON-LINE

	SETONE MA%LOD,MTAFLG(MTA) ;SET DRIVE-LOADED
	MOVX T1,MA%SCR+MA%UXV+MA%OPF+MA%ULP+MA%VMG
	ANDCAM T1,MTAFLG(MTA)	;CLEAR VARIOUS FLAGS
	SETZB T1,MTAVOL(MTA)	;SET VOLUME NOT IDENTIFIED (YET)
	SETZM MTAIDV(MTA)	;CLEAR OPERATOR-SUPPLIED VOLID
	STOR T1,MTALT		;SET RECOGNITION NOT ATTEMPTED (YET)
	LOAD T1,MTASTE
	CAIN T1,S.INIT		;DRIVE IN INITIALIZE MODE?
	JRST [	CALLRET KVITAV]	;YES, SPECIAL EXIT
	CALLRET AVR		;PERFORM IDENTIFICATION SEQUENCE
NOSHIP,<
SUBTTL DECTAPE SUPPORT

; RLSDTA - PROCESS RELEASE OF ALLOC'ED DECTAPE DEVICE
;  T1/ DEVICE DESIGNATOR
; RETURNS +1: ALWAYS

RLSDTA:	SAVEQ
	MOVE Q1,T1		;SAVE DESIGNATOR
	MOVE T2,T1		;COPY DESIGNATOR TO T2 FOR ALLOC
	MOVEI T1,.ALCAL		;ALLOC FUNCTION CODE
	MOVNI T3,1		;MAKE DTA AVAILABLE TO ALL USERS
	ALLOC
	 JFCL			;IGNORE FAILURE

; FIND REQUEST THAT WAS USING THIS DECTAPE AND DELETE IT

	TMCT <%I%5V Released>
	QSCANI ARBQDB		;SET UP TO SCAN REQUEST QUEUE
RDTA1:	CALL NXXRSB		;GET ADDRESS OF NEXT ACTIVE RSB
	 JRST RDTA2		;NONE LEFT
	LOAD T1,RSBTYP		;GET REQUEST TYPE
	CAIE T1,.MNTDT		;IS IT A DECTAPE-MOUNT REQUEST?
	JRST RDTA1		;NO, SKIP IT
	CAME Q1,RSBDTA(RSB)	;DOES THIS REQUEST OWN THE DECTAPE?
	JRST RDTA1		;NO
	LOAD T1,RSBJNO		;GET OWNER'S JOB #
	TMCT < by job %1D>
	ABTREQ (ABRTNR)		;FOUND THE OWNER, DELETE REQUEST
RDTA2:	MOVEI T3,TMCMSG		;GET ADDRESS OF MESSAGE
	CALLRET BTWTON		;TELL OPR'S THAT DECTAPE WAS RELEASED
; TLUDT - BUILD BLOCKS FOR SUCCESSFUL DECTAPE-MOUNT RESPONSE
;	  (CALLED BY TELUSR)
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ FLAGS FOR GALAXY MSG HEADER

TLUDT:	STKVAR <<DVBLK,3>>
	CALL VQGCV		;GET VOLID IN T1
	TMCT <%I[DECtape volume %1S mounted]%_>
	MOVEI T1,TMCMSG		;GET ADDRESS OF TEXT
	MOVEI T2,.MNRTX		;GET ARGUMENT TYPE
	CALL PBTXT		;CREATE BUILDING BLOCK CONTAINING TEXT
	MOVE T1,[FLD(3,AR.LEN)+FLD(.MNRDV,AR.TYP)] ;GET HEADER
	MOVE T2,RSBSSN(RSB)	;GET SETNAME
	DMOVEM T1,DVBLK		;STORE HEADER AND SETNAME
	MOVE T1,RSBDTA(RSB)	;GET DECTAPE DEVICE DESIGNATOR
	MOVEM T1,2+DVBLK	;STORE DESIGNATOR IN .MNRDV BLOCK
	MOVEI T1,DVBLK		;GET ADDRESS OF BLOCK
	CALL PBBLK		;INSTALL BLOCK IN MESSAGE
	SETZ T1,		;NO FLAGS
	RET
; UDTM - PROCESS USER DECTAPE-MOUNT REQUEST RECEIVED FROM QUASAR
;  T1/ ADDRESS OF DECTAPE-MOUNT ENTRY IN IPCF MESSAGE FROM QUASAR
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

UDTM:	MOVEI T2,[[	MOVX T1,TM%WEN ;ROUTINE TO PROCESS FLAGS
			AND T1,.MEFLG(Q1)
			MOVEM T1,RSBUFL(RSB)
			RETSKP]
		BTRSET		;SETNAME
		BTRVLS		;VOLID LIST
		BTRRMK		;REMARK
		0]
	CALL BTMRSB		;BUILD RSB
	 RET			;ABORTED, EXIT
	MOVEI T1,1
	STOR T1,RSBCV		;CURRENT VOLUME = 1
	CALL PWATCH		;ABORT REQUEST IF USER DELETES PID
	MOVEI T1,RST.WM
	STOR T1,RSBSTE		;SET STATE = WAITING FOR MOUNT

; BUILD HEADER LINE

UDTM1:	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%IDECtape Mount Request # %1D>
	CALL CPYHDR		;COPY HEADER TO OPRHDR

; BUILD BODY OF MESSAGE

	CALL VQGCV		;GET CURRENT VOLID IN T1
	TMCT <%IMount volume %1S%_%U>
	SKIPE RSBRMK(RSB)	;DID THE USER SUPPLY A REMARK?
	JRST [	MOVEI T1,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
		TMCT <%_User's remark: %1A>
		JRST .+1]
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <
  RESPOND msg# DTAn:
   or
  DELETE MOUNT-REQUEST %1D /REASON:reason>

; SEND MESSAGE AND GET RESPONSE

	MOVEI T2,RSBWTB(RSB)	;GET WTB ADDRESS
	MOVEI T3,OPRHDR		;GET ADDRESS OF HEADER
	JSP T1,BTWTOR		;SEND WTOR AND RECEIVE REPLY

; PROCESS RESPONSE

	MOVEI RSB,-RSBWTB(T2)	;LOAD RSB AC
	CALL COMNDI		;INIT FOR COMND PARSING
	MOVEI T2,[FLDDB. .CMDEV]
	CALL COMNDX		;PARSE DEVICE NAME
UDTM2:	 JRST [	MOVEI T3,[ASCIZ/Response Does Not Specify DECtape/]
		CALL BTACK	;REJECT IT
		JRST UDTM1]	;RE-ISSUE WTOR
	LOAD T1,DV%TYP,T2	;GET DEVICE TYPE
	CAIE T1,.DVDTA		;DECTAPE?
	JRST UDTM2		;NO, REJECT
	MOVEI T1,.ALCAL		;GET ALLOC FUNCTION CODE
	LOAD T3,RSBJNO		;GET USER'S JOB #
	ALLOC			;TRY TO ALLOC DTA TO USER
	 JRST UDTM3		;FAILED

; ALLOCATION SUCCESSFUL

	MOVEM T2,RSBDTA(RSB)	;STORE DEVICE DESIGNATOR
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%I%2V Allocated To Request # %1D>
	MOVEI T3,TMCMSG
	CALL BTACK		;ACKNOWLEDGE SUCCESSFUL ALLOCATION
	MOVEI T1,RST.AC
	STOR T1,RSBSTE		;SET STATE TO ACTIVE
	CALL TELUSR		;TELL THE USER HE GOT IT
	CALLRET TCKP		;TELL QUASAR

; ALLOCATION FAILED

UDTM3:	CALL [	SAVET		;PRESERVE T1-T4
		TMCT <%ICannot Allocate %2V> ;BUILD HEADER
		CALLRET CPYHDR]	;SAVE HEADER IN OPRHDR
	CAIE T1,ALCX5		;SOMEONE ELSE HAS IT?
	JRST [	TMCT <%IError from ALLOC JSYS: %1J>
		JRST UDTM4]
	MOVE T1,T2		;ANOTHER JOB HAS IT
	DVCHR			;GET OWNER'S JOB # IN LH(T3)
	HLRZS T3		;MOVE TO RIGHT HALF
	TMCT <%IAlready in use by job %3D>
UDTM4:	MOVEI T3,OPRHDR
	CALL BTACKT		;TELL OPERATOR ABOUT ALLOC FAILURE
	JRST UDTM1		;SEND WTOR AGAIN
>;NOSHIP
SUBTTL IPCF SEND AND RECEIVE

; GSYSPD - DOES MUTIL TO GET PID FROM SYSTEM PID TABLE
;  T1/ INDEX INTO SYSTEM PID TABLE
; RETURNS +1: PID COULD NOT BE OBTAINED
;	  +2: SUCCESS, PID IN T1

GSYSPD:	SKIPE TSTF		;TESTING?
	JRST GSYSPT		;YES, SPECIAL CODE
	SAVEAC <Q1,Q2>		;Save 2 ACs
	MOVE Q1,T1		;Save T1 for possible later use
	MOVNI Q2,NTRY		;The number of MUTIL% attempts
GSYSPA:	MOVE T2,Q1		;Copy index to T2 for XMUTIL
	MOVEI T1,.MURSP		;Function = return system PID
	CALL XMUTIL		;Get it
	JRST GSYSPB		;Error, try again up to NTRY
	MOVE T1,T3		;Copy to T1 for return
	RETSKP			;Successful return
GSYSPB: AOJE Q2,GSYSPC		;Try again?
	MOVEI T1,^D2000		;Yes, but ...
	DISMS			;Wait awhile
	JRST GSYSPA		;Now try it again
GSYSPC: CAIN T1,IPCF27		;System PID table slot empty?
	RET			;Yes, take error return
	CALL STOP		;Unexpected error

GSYSPT:	STAKT
	MOVE T2,[[EXP IP%CPD,0,0,<20,,TBUF+4>,.IPCIW,0],,TBUF]
	BLT T2,TBUF+5		;MOVE PDB AND PART OF MESSAGE TO BUF
	SKIPL SYPIDS(T1)	;WANT USERNAME PREFIX?
	JRST [	HRROI T1,TBUF+6	;NO, SET UP DESTINATION POINTER
		JRST GSYSP1]	;COPY PID NAME SANS PREFIX INTO TMSG
	GJINF			;GET USER# IN T1
	MOVE T2,T1		;COPY INTO T2
	MOVE T1,[POINT 7,TBUF+6] ;GET POINTER
	MOVEI T3,"["
	IDPB T3,T1
	DIRST			;ADD USER NAME
	 JSHLT
	MOVEI T2,"]"
	IDPB T2,T1
GSYSP1:	MOVE T2,CT1		;GET SYSTEM PID TABLE INDEX
	HRRO T2,SYPIDS(T2)	;GET POINTER TO STRING
	SETZ T3,		;STOP ON NULL
	SOUT			;ADD PID NAME
	MOVEI T1,4
	MOVEI T2,TBUF
	MSEND			;SHIP OFF QUESTION TO INFO
	 JSHLT
	SETZM TBUF		;CLEAR FLAGS WORD FOR RECEIVE
	MOVE T3,TBUF+1		;GET MY PID SO I CAN RECEIVE
	MOVE T4,[20,,TBUF+4]	;SIZE,,MSGADDR
	DMOVEM T3,TBUF+2	;SET WORDS 2 & 3 OF PDB
	MRECV			;RECEIVE INFO'S REPLY
	 JSHLT
	LOAD T4,IP%CFE,TBUF+.IPCFL ;ERROR FROM INFO?
	JUMPN T4,[MOVEI T1,.MUDES ;YES, NO SUCH PID
		MOVE T2,TBUF+2	;GET THE PID WE PICKED UP
		CALL XMUTIL	;LIQUIDATE IT
		 JSHLT		;COULDN'T
		HRROI T1,TBUF+6	;RETURN POINTER TO PID NAME
		RET]
	TMSG <% MOUNTR Found PID for >
	HRROI T1,TBUF+6
	PSOUT
	 TMSG <
>
	MOVEI T1,.MUDES
	MOVE T2,TBUF+2		;GET THE PID I USED FOR THIS CRAP
	CALL XMUTIL		;LIQUIDATE IT
	 JSHLT
	MOVE T1,TBUF+5		;GET PID FOR CALLER
	RETSKP			;GIVE IT TO HIM
SYPIDS:	0
	0
	-1,,[ASCIZ/QUASAR/]
	-1,,[ASCIZ/MOUNTR/]
	-1,,[ASCIZ/ORION/]
; MRCVIH - ENTERED BY SCHEDULER WHEN INTERRUPT RECEIVED FROM PID
; RETURNS +1: ALWAYS

MRCVIH:	TXO F,MRMSF+MRPGF	;EXPECTING PAGE-MODE MESSAGE

; RECEIVE THE HEAD MESSAGE FROM THE QUEUE

MRCVI1:	TXZN F,MRMSF		;RECEIVE QUEUE EMPTY?
	RET			;YES, EXIT TO SCHEDULER
	TXCN F,MRPGF		;NON-PAGE-MODE MESSAGE COMING?
	JRST [	MOVX T1,IP%CFB+IP%TTL ;YES, GET FLAGS
		MOVE T2,[1000,,RBUF] ;SIZE,,ADDRESS
		JRST MRCVI3]	;REJOIN
	MOVX T1,IP%CFB+IP%TTL+IP%CFV ;DON'T BLOCK, TRUNCATE, PAGE MODE
	MOVE T2,[1000,,RBUF_-9]	;SIZE,,PAGE#
MRCVI3:	MOVEM T1,.IPCFL+MRPDB	;SET FLAGS
	MOVEM T2,.IPCFP+MRPDB	;SET RECEIVER BUFFER LENGTH,,ADDRESS
	MOVE T3,MYPID
	MOVEM T3,.IPCFR+MRPDB	;SET RECEIVER'S PID
	MOVEI T1,4		;LENGTH OF PDB
	MOVEI T2,MRPDB		;ADDRESS OF PDB
	MRECV			;RECEIVE THE MESSAGE
	 JRST [	CAIN T1,IPCFX2	;QUEUE EMPTY?
		RET		;YES, EXIT TO SCHEDULER
		TXO F,MRMSF	;SET DO-MRECV FLAG
		CAIN T1,IPCF16	;WRONG MODE?
		JRST MRCVI1	;YES, TRY OTHER MODE
		CALL STOP]	;CAN'T HANDLE THIS ERROR
	AOS MSGSIN		;COUNT # OF MESSAGES IN
	JUMPN T1,[TXNE T1,IP%CFV ;THERE IS ANOTHER MSG, WHAT MODE?
		TXO F,MRPGF	;PAGE-MODE
		TXO F,MRMSF	;FORCE ANOTHER MRECV
		JRST .+1]
	TXNN F,INITF		;DISCARD MESSAGE IF INITIALIZING
	CALL MRCVPM		;PROCESS MESSAGE
	JRST MRCVI1		;GO CHECK FOR MORE MESSAGES

; REFER THE MESSAGE TO THE APPROPRIATE PROCESSING ROUTINE

MRCVPM:	JN IP%CFM,MRPDB+.IPCFL,R ;DISCARD UNDELIVERED MAIL
	LOAD T1,IP%CFC,MRPDB+.IPCFL ;SENT BY <SYSTEM> ?
	JUMPN T1,[CALLRET MRSYS] ;YES, PROCESS IT
;**;[6036]At MRCVPM:+1L move edit 6035 two lines down  JYCW Oct-18-88
	MOVE T1,RBUF+.MSFLG	;[6036]Get the message flag word
	TXNE T1,MF.NEB		;[6036]From NEBULA
	SETOM NEBMSG		;[6036]Yes
	MOVE T1,MRPDB+.IPCFS	;GET SENDER'S PID
	MOVEI T2,APNUM-1	;# OF ASSOCIATED PROCESSES - 1
MRCVAP:	CAMN T1,APPID(T2)	;FROM THIS A/P?
	JRST [	CALLRET @APMRC(T2)] ;YES, GIVE IT TO HIS HANDLER
	SOJGE T2,MRCVAP		;NO, CHECK THE OTHERS
	RET			;I DON'T KNOW THE SENDER, SO PITCH IT
; MRSYS - PROCESS IPCF MESSAGE FROM SYSTEM TASK
;  T1/ SYSTEM SENDER CODE FROM IP%CFC FIELD OF PDB
;  MRPDB, RBUF/ PDB AND MESSAGE
; RETURNS +1: ALWAYS

MRSYS:	CAIN T1,.IPCCF		;SENT BY INFO?
	JRST [	LOAD T1,IP%CFE,MRPDB+.IPCFL ;YES, GET CODE
		CAIN T1,.IPCKM	;WATCHED PID DELETED?
		JRST [	CALLRET INFOK] ;YES, GO PROCESS IT
		CAIE T1,.IPCBP	;BAD PID (RESPONSE TO .IPCIK) ?
		RET		;I DON'T RECOGNIZE IT, SO PITCH IT
		CALLRET PRQPID]	;BAD PID, CHECK REQUEST QUEUE
	CAIE T1,.IPCCC		;SENT BY SYSTEM IPCF?
	RET			;NO, PITCH IT
	HLRZ T1,MRPDB+.IPCFP	;GET SIZE OF MESSAGE
	JUMPE T1,R		;NO MESSAGE, NO WORK
	MOVE T2,RBUF		;GET SYSTEM MESSAGE CODE
	CAIN T2,.IPCSA
	JRST [	CALLRET SALMSG]	;ALLOCATED DEVICE BEING RETURNED
	CAIN T2,.IPCTR
	JRST [	CALLRET SMTMSG]	;MESSAGE ABOUT MAGTAPES
	CAIN T2,.IPCMS
	JRST [	CALLRET ACCSTI]	;STRUCTURE COUNT BEING INCREMENTED
	CAIN T2,.IPCDS
	JRST [	CALLRET ACCSTD]	;STRUCTURE COUNT BEING DECREMENTED
	CAIN T2,.IPCRS
	JRST [	CALLRET ACCSTR]	;STRUCTURE BEING REMOVED
	RET
; INFOK - PROCESS PID-KILLED MESSAGE FROM INFO
;  RBUF/ PID THAT WAS KILLED
; RETURNS +1: ALWAYS

INFOK:	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB>
INFOK1:	CALL QMSCAN		;GET NEXT ENTRY FROM RSB QUEUE
	 RET			;NONE LEFT, SPLIT
	MOVEI RSB,-RSBLNK(T2)	;GET RSB ADDRESS
	MOVE T1,RSBPID(RSB)	;GET PID FROM RSB
	CAMN T1,RBUF		;WAS IT KILLED?
	CALL VALPID		;YES, ABORT REQUEST IF NECESSARY
	 JFCL
	JRST INFOK1


; SALMSG - PROCESS ALLOCATED-DEVICES-RELEASED MESSAGE
; RETURNS +1: ALWAYS

SALMSG:	SAVEQ
	HLRZ Q1,MRPDB+.IPCFP	;GET # OF DEVICES PLUS 1
SALMS1:	SOJLE Q1,[CALLRET MCHWMT] ;EXIT WHEN DEVICE LIST EXHAUSTED
	MOVE T1,RBUF(Q1)	;GET DEVICE DESIGNATOR
NOSHIP,<
	LOAD T2,DV%TYP,T1	;GET DEVICE TYPE
	CAIN T2,.DVDTA		;DECTAPE?
	JRST [	CALL RLSDTA	;YES, CALL PROCESSOR
		JRST SALMS1]	;GET NEXT DEVICE
>;NOSHIP
	CALL DDMT		;CONVERT IT TO MT STATUS BLK ADDR IN MT
	 JRST SALMS1		;NOT MT DEVICE, IGNORE IT
	SETOM UNLD		;Tape being unloaded
	CALL MTRLS		;PROCESS RELEASE OF MT DEVICE
	JRST SALMS1		;ON TO NEXT DEVICE IN IPCF MESSAGE
; SMTMSG - PROCESS IPCF MESSAGES FROM MONITOR TAPE SERVICE
; RETURNS +1: ALWAYS

SMTMSG:	SAVEQ
	MOVEI Q1,RBUF+1		;GET ADDRESS OF .VMCOD WORD
	SKIPL T1,.VSMTN(Q1)	;GET MT# AND CHECK IF LESS THAN 0
	CAML T1,MTN		; OR TOO BIG
	CALL STOP		;ILLEGAL MT# FROM MONITOR
	IMULI T1,MTSZ		;EXPAND TO OFFSET
	MOVEI MT,MT0(T1)	;LOAD MT WITH ADDR OF MT STATUS BLOCK
	MOVE T1,.VMCOD(Q1)	;DISPATCH BY MESSAGE SUBCODE
	CAIN T1,.VMVSM
	JRST SMTVS		;VOLUME-SWITCH
	CALL STOP		;CODE NOT RECOGNIZED

; PROCESS VOLUME-SWITCH

SMTVS:	LOAD RSB,MTRSB		;GET REQUEST STATUS BUFFER ADDRESS
	CAIN RSB,MTNAV		;DOES USER OWN MT AND NO RSB?
	JRST [	MOVEI T1,.MTNVV	;YES
		MOVE T2,MT	;COMPUTE MT #
		SUBI T2,MT0
		IDIVI T2,MTSZ
		MOVEI T3,[EXP 3,MREQX8,0] ;GET ARGUMENT BLOCK
		MTU%		;MOUNTR CRASHED, SO YOU CAN'T VOLSWITCH
		RET]
	SKIPN RSB		;DO I OWN THE MT?
	CALL STOP		;YES, WHAT'S GOING ON HERE?
	LOAD T2,VS%COD,.VSFLG(Q1) ;TYPE OF SWITCH
	SKIPLE T2		;VALIDATE TYPE
	CAILE T2,4
	CALL STOP		;UNKNOWN TYPE
	LOAD T1,RSBCV		;GET CURRENT VOLID INDEX
	XCT [	MOVE T1,.VSCNT(Q1)	;1 - MOUNT ABSOLUTE VOLUME #
		MOVEI T1,1		;2 - MOUNT FIRST VOLUME
		CALL VQCNT		;3 - MOUNT LAST VOLUME
		ADD T1,.VSCNT(Q1)]-1(T2) ;4- MOUNT RELATIVE VOLUME
	LOAD T2,VS%WRT,.VSFLG(Q1) ;GET READ/WRITE FLAG
	LOAD T3,RSBLT		;GET LABEL TYPE
	CAIN T3,.LTUNL		;UNLABELED?
	SETZ T2,		;YES, DON'T REWRITE VOLUME LABELS
	STOR T2,R%WVL,RSBIFL(RSB) ;SET OR RESET FLAG IN RSB
	CALLRET VOLSW		;PERFORM VOLUME-SWITCH
; PIDINI - GET AND INITIALIZE PID FOR COMMUNICATION WITH THE WORLD
; RETURNS +1: ALWAYS

PIDINI:	SAVEQ

; SET JOB PID QUOTA TO A LARGE VALUE

	MOVEI T1,.MUSPQ		;FUNCTION = SET JOB PID QUOTA
	SETO T2,		;THIS JOB
	MOVEI T3,777		;NEW QUOTA
	CALL XMUTIL
	 JFCL

; TRY TO USE THE PID IN THE SYSTEM PID TABLE (IF IT EXISTS)
; IF THIS IS NOT POSSIBLE, CREATE A NEW PID AND USE IT
; Q1/ 0 IF I CREATED THE PID, 1 IF THE PID IS RECYCLED

	SETZ Q1,		;Q1/0 MEANS I CREATED THE PID
	MOVEI T1,.SPMDA		;OFFSET INTO TABLE FOR MDA PID
	CALL GSYSPD		;DOES MDA PID EXIST?
	 JRST PIN1		;NO
	MOVEM T1,MYPID		;YES, SAVE IT
	AOJA Q1,PIN2		;TRY TO RECYCLE IT

PIN1:	MOVEI T1,.MUCRE		;FUNCTION = CREATE PID
	MOVE T2,[IP%JWP+.FHSLF]	;JOB-WIDE
	CALL XMUTIL		;CREATE PID
	 CALL STOP		;CAN'T WORK WITHOUT A PID
	MOVEM T3,MYPID		;STORE MY PID
PIN2:	MOVEI T1,.MUPIC		;FUNCTION = PUT PID ON INTERRUPT CHANNEL
	MOVE T2,MYPID		;PID
	MOVEI T3,MRCVCN		;CHANNEL #
	CALL XMUTIL		;CAN PID BE PUT ON INT CHANNEL?
	 JRST [	SOJE Q1,PIN3	;NO, REPORT ERROR IF NOT MY PID
		CALL STOP]	;CAN'T PUT MY OWN PID ON INT CHANNEL

	MOVEI T1,.MUSSQ		;FUNCTION = SET SEND AND RECEIVE QUOTAS
	MOVE T2,MYPID		;PID
	MOVEI T3,777100		;SEND = 777, RECEIVE = 100
	CALL XMUTIL		;SET SEND/RECEIVE QUOTAS
	 JFCL
	SKIPE Q1		;RECYCLING OLD MDA PID?
	CALL MRCVIH		;YES, DISCARD ANY CURRENT MESSAGES

; IDENTIFY MYSELF TO THE WORLD

	SKIPE TSTF		;TESTING?
	JRST [	MOVE T2,[[EXP 0,0,0,<20,,TBUF+4>,.IPCII,0],,TBUF]
		BLT T2,TBUF+5		;MOVE PDB AND PART OF MESSAGE TO BUF
		MOVE T1,MYPID
		MOVEM T1,TBUF+.IPCFS	;SET SENDER'S PID
		GJINF			;GET USER# IN T1
		MOVE T2,T1		;COPY INTO T2
		MOVE T1,[POINT 7,TBUF+6] ;GET POINTER
		MOVEI T3,"["
		IDPB T3,T1
		DIRST			;ADD USER NAME
		 JSHLT
		MOVEI T2,"]"
		IDPB T2,T1
		HRROI T2,[ASCIZ/MDA/] 	;[6011]Get pointer to string
		SETZ T3,		;STOP ON NULL
		SOUT			;ADD PID NAME
		MOVEI T1,4
		MOVEI T2,TBUF
		MSEND
		 CALL STOP
		TMSG <% MOUNTR Becoming >
		HRROI T1,TBUF+6		;INFORM USER WE HAVE GOT PID
		PSOUT
		TMSG <
>
		JRST PIN4]
	MOVEI T1,.MUSSP		;FUNCTION = SET VALUE IN SYS PID TABLE
	MOVEI T2,.SPMDA		;OFFSET INTO TABLE
	MOVE T3,MYPID		;PID
	CALL XMUTIL		;SET MY PID AS SYSTEM MDA PID
	 CALL STOP
PIN4:

; OBTAIN AND REMEMBER MAXIMUM LENGTH OF NON-PAGE-MODE IPCF PACKETS

	MOVEI T1,.MUMPS		;FUNCTION = RETURN MAX NON-PAGE PACKET
	CALL XMUTIL
	 CALL STOP
	MOVEM T2,SHORT		;SAVE IT
	RET

; ERROR ENCOUNTERED WHILE ASSIGNING EXISTING MDA PID TO PSI CHANNEL
; THIS IMPLIES THAT ANOTHER MOUNTR IS RUNNING, SO DON'T INTERFERE

PIN3:	TMSG <?MDA PID is already defined>
	MOVEI T1,.MUFOJ
	MOVE T2,MYPID		;GET THE PID
	CALL XMUTIL		;GET JOB# OF PID'S OWNER
	 HALTF
	TMSG < by job >
	MOVEI T1,.PRIOU
	MOVE T2,T3		;COPY JOB#
	MOVEI T3,12		;BASE 10
	NOUT			;DISPLAY JOB#
	 JFCL
	HALTF
; PWATCH - TELL INFO TO WATCH THE PID IN RSBPID
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

PWATCH:	MOVEI T1,.IPCIK
	MOVEM T1,TBUF+.IPCI0	;STORE INFO FUNCTION CODE
	MOVE T1,RSBPID(RSB)
	MOVEM T1,TBUF+.IPCI2	;STORE PID TO BE WATCHED
	SETZ T1,		;SENDING TO INFO
	MOVEI T2,3		;3 WORDS
	CALLRET TRANM
; TRANG - TRANSMIT GALAXY IPCF MESSAGE TO ASSOCIATED PROCESS
; TRANU - TRANSMIT GALAXY IPCF MESSAGE TO USER PROCESS
; TRANM - TRANSMIT IPCF MESSAGE TO SPECIFIED PID
;  T1/ ASSOCIATED-PROCESS INDEX (TRANG) OR PID (TRANM, TRANU)
;  T2/ MESSAGE LENGTH IN WORDS (TRANM ONLY)
;  TBUF/ MESSAGE TO BE TRANSMITTED
; RETURNS +1: ALWAYS

TRANG:	MOVE T1,APPID(T1)	;GET PID OF ASSOCIATED PROCESS
TRANU:	LOAD T2,MS.CNT,TBUF+.MSTYP ;GET SIZE FROM GALAXY HEADER
	JUMPE T1,TRAN1		;IF RECEIVER PID IS 0, DON'T BOTHER
TRANM:	SAVEQ
	MOVEI Q1,1		;SET UP RETRY COUNTER

; BUILD PDB AND ATTEMPT TO TRANSMIT THE MESSAGE

	SETZM TRPDB+.IPCFL	;CLEAR PDB FLAGS WORD
	MOVE T4,MYPID
	MOVEM T4,TRPDB+.IPCFS	;STORE SENDER'S PID IN PDB
	MOVEM T1,TRPDB+.IPCFR	;STORE RECEIVER'S PID IN PDB
	CAMG T2,SHORT		;CAN I SEND A SHORT MESSAGE?
	JRST [	MOVSM T2,TRPDB+.IPCFP ;YES, SET SIZE IN PDB
		MOVEI T2,TBUF
		HRRM T2,TRPDB+.IPCFP ;INSTALL MSG ADDRESS IN PDB
		JRST TRAN2]	;SKIP PAGE-MODE STUFF
	MOVX T2,IP%CFV
	IORM T2,TRPDB+.IPCFL	;SET PAGE-MODE IN PDB
	MOVE T2,[1000,,TBUF_-9]
	MOVEM T2,TRPDB+.IPCFP	;SET SIZE,,PAGE#

TRAN2:	MOVEI T1,4		;PDB LENGTH
	MOVEI T2,TRPDB		;PDB ADDRESS
	MSEND			;SEND THE MESSAGE
	 JRST TRAN3		;FAILED
TRAN1:	SETZM TBUF		;CLEAR 1ST WORD OF TBUF
	MOVE T1,[TBUF,,TBUF+1]	;BLT SOURCE AND DESTINATION
	BLT T1,TBUF+777		;CLEAR TBUF FOR NEXT CALLER
	RET

; IPCF TRANSMIT FAILED, FIND OUT WHY

TRAN3:	MOVSI T2,-MLEN		;Get the length of the error table
TRAN4:	HLRZ T4,MTBL(T2)	;Get the next error code
	CAME T1,T4		;Do we match?
	AOBJN T2,TRAN4		;No, try the next one
	SKIPL T2		;Found a match?
	$STOP <MSEND Failure>	;This error can't be dealt with
	HRRZ T4,MTBL(T2)	;Get the routine address
	JRST 0(T4)		;Process the error
TRAN5:	SOJL Q1,TRAN1		;GIVE UP IF RETRY COUNT EXHAUSTED
TRAN6:	MOVEI T1,^D1000		;RETRYABLE FAILURE
	DISMS			;DELAY
	JRST TRAN2		;TRY IT AGAIN
TRAN7:	HRROI T1,[ASCIZ/SYSTEM INFO Is Not Running - MOUNTR Dismissing For 30 Seconds
/]				;The message to the operator
	PSOUT			;Tell the operator
	MOVEI T1,^D30000	;Give the operator time to restart INFO
	DISMS			;Sleep for 30 seconds
	JRST TRAN2		;Try again
SUBTTL LABELED TAPE INITIALIZATION

; LTINIT - CHECK IF LABELED TAPE MUST BE INITIALIZED, AND IF SO,
;	   WRITE VOLUME LABELS AND A DUMMY FILE ON THE TAPE
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR, TAPE DISMOUNTED OR REQUEST ABORTED
;	  +2: SUCCESS, TAPE IS PROPERLY PREPARED

LTINIT:	MOVX T1,R%WVL
	TDNN T1,RSBIFL(RSB)	;SKIP IF LABELS MUST BE WRITTEN
	RETSKP			;YES, SHOULDN'T WRITE LABELS!
	CALL OWCHK		;OVERWRITE PERMITTED?
	 RET			;NO, REQUEST ABORTED
	LOAD T1,RSBDEN		;GET DESIRED DENSITY
	STOR T1,MTADEN		;OPEN MTA AT THAT DENSITY
	LOAD T1,RSBLT		;GET LABEL TYPE
	STOR T1,MTALT		;SET NEW LABEL TYPE OF TAPE
	CALL MTAOPO		;OPEN MTA FOR OUTPUT
	 JRST [	CALLRET UNLOAD]	;WRITE PROTECTED OR OFFLINE ???
	MOVEI T1,.MOREW
	MOVEI T2,1
	CALL XMTOPR		;REWIND TAPE (SHOULDN'T TAKE LONG)
	 JRST LTINI1
	LOAD T1,RSBLT
	CAIN T1,.LTUNL		;UNLABELED TAPE?
	JRST [	SETZM LBUF1	;YES
		MOVE T1,[LBUF1,,LBUF1+1]
		BLT T1,LBUF1+^D19 ;ZERO THE BUFFER
		MOVEI T1,LBUF1	;GET BUFFER ADDRESS
		CALL WRTLBL	;WRITE A RECORD OF ZEROS
		 JRST LTINI2	;ERROR
		JRST LTINI0]	;SUCCESSFUL, GO WRAP UP
	CALL BLDV1		;BUILD VOL1 LABEL
	MOVEI T1,MTAV1(MTA)	;GET ADDRESS OF VOL1
	CALL WRTLBL		;WRITE VOL1
	 JRST LTINI2		;ERROR
	SETZM MTAV2(MTA)	;ZAP VOL2 BUFFER
	LOAD T1,RSBLT		;GET LABEL TYPE
	CAIN T1,.LTT20		;IS THIS A TOPS-20 VOLUME?
	JRST [	CALL BLDV2	;YES, BUILD VOL2 LABEL
		MOVEI T1,MTAV2(MTA) ;GET ADDRESS OF VOL2
		CALL WRTLBL	;WRITE VOL2
		 JRST LTINI2	;ERROR
		JRST .+1]

; --- USER VOLUME LABELS WOULD BE WRITTEN HERE ---

	CALL BLDH1		;BUILD HDR1 FOR DUMMY FILE
	MOVEI T1,LBUF1		;GET ADDRESS OF HDR1
	CALL WRTLBL		;WRITE HDR1
	 JRST LTINI2		;ERROR
	MOVEI T1,.MOEOF
	MOVEI T2,2		;REPEAT COUNT
	CALL XMTOPR		;DOUBLE TAPE MARK FRAMING EMPTY FILE
	 JRST LTINI1
	CALL BLDEF1		;BUILD EOF1
	MOVEI T1,LBUF1		;GET ADDRESS OF EOF1
	CALL WRTLBL		;WRITE EOF1
	 JRST LTINI2
LTINI0:	MOVEI T1,.MOEOF
	MOVEI T2,2		;REPEAT COUNT
	CALL XMTOPR		;WRITE DOUBLE TAPE MARK
	 JRST LTINI1
	CALL REW		;REWIND TAPE
	 JRST LTINI2		;OFFLINE ERROR
	CALL MTACLS		;CLOSE TAPE
	RETSKP			;I DID IT!!

; DEVICE ERROR OR TIMEOUT OCCURRED

LTINI1:	CALL XMTREP		;TELL OPERATOR ABOUT ERROR OR TIMEOUT
LTINI2:	CALL UNLOAD		;UNLOAD THE TAPE FROM THE DRIVE
	CALL MTACLS		;CLOSE THE JFN
	CALLRET WOLINF		;TELL OPERATOR LABEL INIT FAILED


; WRTLBL - WRITE A LABEL TO TAPE
;  T1/ ADDRESS OF INDUSTRY-COMPATIBLE FORMAT LABEL
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: I/O ERROR OR DRIVE TIMED OUT
;	  +2: LABEL WRITTEN SUCCESSFULLY

WRTLBL:	STKVAR <<WCLIST,2>>
	SUBI T1,1		;GET BUFFER ADDRESS MINUS 1
	HRLI T1,-LBLSIZ/4	;GET MINUS # OF WORDS TO WRITE
	MOVEM T1,WCLIST		;STORE IOWD
	SETZM 1+WCLIST		;FOLLOW IOWD WITH ZERO WORD
	LOAD T1,MTAJFN		;GET JFN
	MOVEI T2,WCLIST		;GET COMMAND LIST ADDRESS
	IOXCT DUMPO,WRTLB1,WRTLB2 ;DO THE I/O
	RETSKP			;SUCCESS

WRTLB1:	CALL CLRTAP		;CLEAR ERRORS, GET ERROR CODE IN T1
	 JRST WRTLB2		;TIMED OUT
	CAIN T1,IOX5		;DEVICE OR DATA ERROR?
	RET			;YES, TELL CALLER
	CALL STOP		;I CAN'T HANDLE THIS

WRTLB2:	CALLRET WOTIMO		;TELL OPERATOR ABOUT TIMEOUT AND TAKE +1
; BLDV1 - BUILD VOL1 LABEL
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, VOL1 LABEL IN MTAV1 IN MTA STATUS BLOCK

BLDV1:	DMOVE T1,[ASCII/VOL1      /]
	DMOVEM T1,LBUF2		;SET FIRST 2 WORDS OF VOL1
	MOVE T1,[LBUF2+1,,LBUF2+2]
	BLT T1,LBUF2+LB7WDS-1	;SET THE REST TO BLANKS
	MOVE T1,MTAVOL(MTA)	;GET VOLID
	MOVE T2,[ILPTR(V1VID)]	;GET DESTINATION POINTER
	CALL SIXASC		;PUT VOLID IN LABEL
	LOAD T1,RSBLT		;GET LABEL TYPE
	CAIN T1,.LTEBC		;EBCDIC?
	JRST BLDV11		;YES, SKIP ANSI/TOPS20 STUFF
	CAIN T1,.LTT20		;IS THIS A TOPS-20 VOLUME?
	JRST [	MOVEI T1,"1"	;YES
		DPB T1,[LPTR(V1ACS)] ;SET ACCESSIBILITY FIELD
		HRROI T1,T20SCD
		MOVE T2,[ILPTR(V1SCD)]
		CALL MOVSTR	;PUT TOPS-20 SYSTEM CODE IN VOL1
		JRST .+1]
	HRROI T1,[ASCIZ/D%K/]
	MOVE T2,[ILPTR(V1OWN)]
	CALL MOVSTR		;PUT MACHINE CODE IN OWNER-ID FIELD
	MOVEI T1,DECV
	DPB T1,[LPTR(V1DECV)]	;STORE DEC STANDARD VERSION
	MOVEI T1,ANSV
	DPB T1,[LPTR(V1ANSV)]	;STORE ANSI STANDARD VERSION
	SKIPA T2,[ILPTR(V1INAM)] ;GET POINTER TO ANSI/TOPS20 OWNER NAME
BLDV11:	MOVE T2,[ILPTR(V1INME)]	;GET POINTER TO EBCDIC OWNER NAME
	HRROI T1,TAPNAM		;POINT TO INSTALLATION NAME
	CALL MOVSTR		;COPY INSTALLATION NAME INTO LABEL
	MOVEI T1,MTAV1(MTA)	;GET DESTINATION ADDRESS
	CALLRET LBLOCV		;CONVERT TO OUTPUT FORMAT AND RETURN
; BLDV2 - BUILD VOL2 LABEL
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, VOL2 LABEL IN MTAV2 IN MTA STATUS BLOCK

BLDV2:	DMOVE T1,[ASCII/VOL2      /]
	DMOVEM T1,LBUF2		;SET FIRST 2 WORDS OF VOL2
	MOVE T1,[LBUF2+1,,LBUF2+2]
	BLT T1,LBUF2+LB7WDS-1	;SET THE REST TO BLANKS
	MOVE T1,[ILPTR(V2PRO)]	;GET POINTER TO ACCESS CODE FIELD
	LOAD T2,RSBVPR		;GET PROTECTION CODE
	TRO T2,770000		;FORCE COMPLETE OWNER ACCESS
	TRZ T2,007700		;CLEAR WORLD ACCESS (NOT DEFINED YET)
	MOVE T3,[6,,10]		;FIELD WIDTH,,RADIX
	CALL FNOUT		;PUT NUMERIC FIELD IN LABEL
	HRROI T1,[ASCIZ/000000000000/] ;DUMMY PPN
	MOVE T2,[ILPTR(V2PPN)]
	CALL MOVSTR		;INSTALL PPN
	HRROI T1,MTAV2(MTA)	;USE MTAV2 TEMPORARILY
	MOVE T2,RSBUNO(RSB)	;USER'S USER #
	DIRST			;TRANSLATE USER # TO STRING
	 SETZM MTAV2(MTA)
	HRROI T1,MTAV2(MTA)	;(ALL THIS FUDGING IS BECAUSE DIRST
	MOVE T2,[ILPTR(V2OWN)]	; PUTS AN UNWANTED NULL AT THE END)
	CALL MOVSTR		;TRANSFER OWNER'S NAME TO LABEL
	MOVEI T1,MTAV2(MTA)	;GET DESTINATION ADDRESS
	CALLRET LBLOCV		;CONVERT TO OUTPUT FORMAT AND RETURN
; BLDH1 - BUILD DUMMY HDR1 LABEL
; BLDEF1 - BUILD DUMMY EOF1 LABEL
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, LABEL IN LBUF1

BLDH1:	SKIPA T1,[ASCII/HDR1D/]
BLDEF1:	MOVE T1,[ASCII/EOF1D/]
	MOVEM T1,LBUF2		;SET FIRST WORD OF LABEL
	MOVE T1,[SKEL1,,LBUF2+1]
	BLT T1,LBUF2+LB7WDS-1	;SUPPLY REMAINDER OF SKELETON
	MOVE T1,MTAVOL(MTA)	;GET VOLID
	MOVE T2,[ILPTR(H1SET)]	;GET DESTINATION POINTER
	CALL SIXASC		;PUT VOLID IN FILE SET NAME FIELD
	SETO T2,		;SPECIFY CURRENT DATE/TIME
	MOVX T4,IC%JUD		;WANT JULIAN FORM
	ODCNV			;GET T2/ YEAR,,JULIANDAY
	HLRZ T1,T2		;GET YEAR
	SUBI T1,^D1900		;DROP CENTURY PART
	IMULI T1,^D1000		;DECIMAL SHIFT
	HRRZS T2		;ISOLATE DAY IN T2
	ADD T2,T1		;GET T2/ YYDDD (DECIMAL)
	MOVE T1,[ILPTR(H1CRE+1)] ;GET POINTER TO LABEL FIELD
	MOVE T3,[5,,12]		;5 CHARS WIDE, BASE 10
	CALL FNOUT		;EDIT CREATION DATE INTO LABEL
	MOVEI T1,LBUF1		;GET DESTINATION ADDRESS
	CALLRET LBLOCV		;CONVERT TO OUTPUT FORMAT AND RETURN

SKEL1:	ASCII     /UMMY-FILE-0000        0001000100010/ ;CP  6-40
	ASCII/0       00000 000000DECSYSTEM20         / ;CP 41-80


; LBLOCV - CONVERT 7-BIT ASCII LABEL IN LBUF2 TO 8-BIT ASCII OR EBCDIC
;  T1/ ADDRESS OF DESTINATION LABEL
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

LBLOCV:	SAVEQ
	HRLI T1,(POINT 8,0)	;MAKE POINTER TO DESTINATION
	MOVE T2,[POINT 7,LBUF2]	;GET POINTER TO SOURCE
	MOVEI T3,LBLSIZ		;GET # OF BYTES IN LABEL
	LOAD T4,RSBLT		;GET LABEL TYPE
LBLOC1:	ILDB Q1,T2		;GET SOURCE BYTE
	CAIN T4,.LTEBC		;EBCDIC LABEL?
	JRST [	ADJBP Q1,[POINT 8,AETT,7] ;YES, GET POINTER TO TABLE
		LDB Q1,Q1	;TRANSLATE ASCII TO EBCDIC
		JRST .+1]
	IDPB Q1,T1		;STORE BYTE IN DESTINATION
	SOJG T3,LBLOC1
	RET
; OWCHK - CHECK IF USER MAY OVERWRITE TAPE VOLUME
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: OVERWRITE NOT PERMITTED, REQUEST ABORTED
;	  +2: OVERWRITE PERMITTED

OWCHK:	JN R%PRIV,RSBIFL(RSB),RSKP ;PRIVILEGED USERS CAN DO ANYTHING
	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	JXN T1,MA%UXV,[ABTRET (MREQ28)] ;ERROR IF FIRST FILE NOT EXPIRED
	JXN T1,MA%SCR,RSKP	;OK IF IT'S A SCRATCH TAPE
	LOAD T1,MTALT		;GET LABEL TYPE
	LOAD T2,MA%OPF,MTAFLG(MTA) ;GET OVERWRITE-PROTECT FLAG
	JRST @OWCDV(T1)		;DISPATCH ACCORDING TO LABEL TYPE

OWCDV:	IFIW!RSKP		;LABEL TYPE NOT KNOWN YET
	IFIW!RSKP		;UNLABELED
	IFIW!OWCANS		;ANSI
	IFIW!OWCPV		;EBCDIC (WRITE ACCESS NOT SUPPORTED)
	IFIW!OWCT20		;TOPS-20
MAXLT

OWCANS:	JUMPE T2,RSKP		;OK IF FLAG IS RESET
OWCPV:	ABTRET (MREQ29)		;OVERWRITE ACCESS VIOLATION, ABORT REQ

OWCT20:	JUMPE T2,RSKP		;OK IF FLAG RESET
	STKVAR <<OWNER,10>>
	MOVEI T1,OWNER		;PROVIDE WORK AREA FOR GETVU
	CALL GETVU		;GET TAPE-OWNER'S USER # IN T2
	CAME T2,RSBUNO(RSB)	;TAPE USER # MATCH REQUESTOR USER # ?
	JRST OWCPV		;NO, PROTECTION VIOLATION
	RETSKP			;YES, YOU OWN IT, SO YOU CAN OVERWRITE
SUBTTL OPERATOR INTERFACE

; BADOM, BADQM BADNM - TYPE A MESSAGE ON CTY INDICATING THAT I RECEIVED A BAD
; IPCF MESSAGE FROM ORION OR QUASAR OR NEBULA.  USES T4 AS A FLAG TO INDICATE 
; WHO SEND THE MESSAGE.
; RETURNS +1: ALWAYS

BADOM:	MOVEI T1,[ASCIZ/ORION/] ;From ORION 
	SETZRO T4		;-1 is from ORION
	JRST BADCOM		;Join common code
BADQM:	MOVEI T1,[ASCIZ/QUASAR/] ;From QUASAR
	SETO T4,		;0 is from QUASAR
	JRST BADCOM		;Join common code
BADNM:	MOVEI T1,[ASCIZ/NEBULA/] ;From NEBULA
	MOVEI T4,1		;1 is from NEBULA
BADCOM:	MOVE T2,[RBUF,,BADMSG]
	BLT T2,BADMSG+777	;MAKE A COPY JUST FOR THE RECORD
	TMCT <%IBad IPCF message received from %1A>
	LOAD T1,MS.TYP,RBUF+.MSTYP ;GET MESSAGE TYPE
	CAIN T1,MT.TXT		;IS THIS
	SKIPE RBUF+.OARGC	;A NULL TEXT MESSAGE?
	SKIPA			;NO
	RET			;YES, RETURN
	CAIN T1,MT.TXT		;TEXT MESSAGE?
	CALL [	MOVEI T1,RBUF+.OHDRS+ARG.DA ;YES, POINT TO TEXT
		TMCTR <%_TEXT MESSAGE: %1A>] ;DISPLAY IT
	MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
	CALL BTWTO		;[6011]Out to CTY and return
	MOVE T1,RBUF+.MSFLG	;[6011]Get flag
	TXNN T1,MF.WTO		;[6017]Return status via WTO?
	TXNN T1,MF.NEB		;[6011]No, is this from NEBULA?
	RET			;[6011]No, all done

;  Have to send a dismount ACK back to NEBULA

	MOVX T1,E%BADM		;[6011]Error code
	SKIPGE T4		;[6011]From ORION
	IFSKP.			;[6011]No
         SKIPE T4		;[6011]From QUASAR
	 IFSKP.
          TXO T1,FA%QER		;[6011]Yes
	 ELSE.
	  TXO T1,FA%NER		;[6011]Must be from NEBULA
	 ENDIF.
	ELSE.
	 TXO T1,FA%OER		;[6011]Yes
	ENDIF.
	MOVE T2,RBUF+.MSCOD	;[6011]Remote ACK 
	CALLRET FAILE		;[6011]Remote, send failure
	
; TO CLEAR SOME OF THE CONFUSION HERE, AN "ACK" IS USED WHEN SENDING
; TEXT TO A PARTICULAR OPR (E.G. WHEN TELLING THE OPERATOR THAT
; HE MADE A BAD KEYIN), WHEREAS "WTO" AND "WTOR" MESSAGES ARE SEEN
; BY ALL USERS RUNNING OPR THE TIME THE MESSAGE IS RECEIVED BY ORION.
; ALL OF THE BTxxx ROUTINES RETURN +1 ALWAYS

; BTACK - BUILD AND TRANSMIT ACK MESSAGE WITHOUT TEXT
;  RBUF+.MSCOD/ ID OF OPR WHO WILL RECEIVE ACK
;  T3/ ADDRESS OF ASCIZ MESSAGE TYPE

; BTACKT - BUILD AND TRANSMIT ACK MESSAGE WITH TEXT
;  TMCMSG/ ASCIZ MESSAGE TO BE TRANSMITTED
;  T3/ ADDRESS OF ASCIZ MESSAGE TYPE

; BTWTO - BUILD AND TRANSMIT WTO MESSAGE
;  TMCMSG/ ASCIZ MESSAGE TO BE TRANSMITTED
;  T3/ ADDRESS OF ASCIZ MESSAGE TYPE

; BTWTOR - BUILD AND TRANSMIT WTOR MESSAGE
;  TMCMSG/ ASCIZ MESSAGE TO BE TRANSMITTED
;  T1/ 0 ,, ADDR OF ROUTINE TO BE SCHEDULED WHEN RESPONSE IS RECEIVED
;  T2/ ADDRESS OF WTB
;  T3/ ADDRESS OF ASCIZ MESSAGE TYPE

BTACK::	SKIPA T4,[1B0+.OMACK]	;ACK MESSAGE, NO TEXT BLOCK
BTACKT::MOVEI T4,.OMACK		;ACK MESSAGE WITH TEXT BLOCK
	JRST BT1		;ENTER COMMON CODE
BTWTON::MOVE T4,[1B0+.OMWTO]	;WTO MESSAGE WITHOUT TEXT BLOCK
	JRST BT1
BTWTOR::SKIPA T4,[.OMWTR]	;WTOR MESSAGE
BTWTO::	MOVEI T4,.OMWTO		;WTO MESSAGE
BT1:	MOVEM T4,BTEXT		;Save for text checking
	STAKT			;STACK T1-T4
	HRRZ T1,CT3		;[6010]Get the header address
	MOVEM T1,WTTYPA		;[6010]Save the .wttyp address
	AOS FIRST		;First message packet
BT2:	MOVEI T1,PBMAX		;Number of byte allowed in message
	SUBI  T1,BYTEND		;Last line in packet trigger
	MOVEM T1,PBLFT		;Initialize # bytes left in message
	SETZM BUFLFT		;Exhausted space in TMCMSG turned off

; CONSTRUCT BUILDING BLOCKS IN IPCF MESSAGE TO ORION


	MOVX T1,WT.MOR		;Get more text flag
	ANDCAM T1,BTFLGS	;Make sure it is not set
	CALL PBINIT		;SET UP TO CREATE BUILDING BLOCKS
	SKIPN FIRST		;Is it the first time
	JRST BT3		;No, check remote request

;  Object type block

	MOVEI T1,[2,,.WTOCD
		  .OTMNT]
	CALL PBBLK		;INSERT MESSAGE CLASSIFICATION BLOCK

;  Check to see whether the message is going to NEBULA or ORION or both

BT3:	SKIPE NEBMSG		;[6010]Message in response to a NEBULA reqeust
	IFSKP.
	 CAIN RSB,1		;[6010]No RSB
	 JRST BT0		;[6010]No WTNHD
	 MOVE T2,RSBIFL(RSB)	;Get the flag word	 
	 TXNN T2,R%WTO		;Nebula want WTO?
	 JRST BT0		;No
	 MOVE T2,RSBOBN(RSB)	;[6017]Get Remote node name
	 MOVEM T2,RENODE	;[6017]Save it for .WTNHD
	ENDIF.

	MOVE T1,[2,,.WTNHD]	;[6010]Node name header block
	MOVEM T1,WTNHDB		;[6010]Save it 
	MOVE T1,RENODE		;[6017]node name
	MOVEM T1,WTNHDB+1	;[6010]Save it 
	MOVEI T1,WTNHDB		;[6010]Address of arg block
	CALL PBBLK		;[6010]Insert into message
	JRST BT7		;[6010]Must add .WTTYP block

BT0:	SKIPN FIRST		;Is it the first time
	JRST BT6		;No, do text
	
BT7:	MOVE T1,WTTYPA		;ADDR OF ASCIZ MESSAGE TYPE
	MOVEI T2,.WTTYP		;TYPE CODE
	CALL PBTXT		;INSTALL MESSAGE TYPE TEXT
	SETZM FIRST		;Clear first flag

BT6:	MOVEI T1,TMCMSG		;ADDR OF FORMATTED TEXT
	MOVEI T2,.WTTXT		;TYPE CODE
	SKIPLE BTEXT		;Text Present?
	CALL PBTXT		;YES, INSTALL IT
	SKIPG MORTXT		;Any text left?
	SETZM BTEXT		;No, mark it so


; BUILD GALAXY HEADER AND SHIP THE MESSAGE OFF TO ORION
; Before calling GALHDR, T1,T2,T3 must be setup correctly with the first 3
; words of the standard GALAXY header.

BT4:	HRRZ T1,CT4		;GET MESSAGE TYPE
	CAIE T1,.OMACK		;ACK MESSAGE?
	AOSA T3,UNIQUE		;NO, GET A UNIQUE NUMBER
	MOVE T3,RBUF+.MSCOD	;YES, GET OPR PID
	MOVE T2,PBBPT
	SUBI T2,TBUF		;COMPUTE SIZE OF IPCF MESSAGE
	HRL T1,T2		;GET LENGTH,,MSGTYPE
	SKIPE NEBMSG		;[6010]Message in response to a NEBULA request
	IFSKP.
	 CAIN RSB,1		;[6010]No RSB
	 JRST BT5		;[6010]No MF.WTO
	 MOVE T2,RSBIFL(RSB)	;Get the flag word	 
	 TXNN T2,R%WTO		;Nebula want WTO?
	 JRST BT5		;No
	 MOVX T2,MF.WTO		;[6017]Yes set NEBULA WTO bit
	 MOVE T3,RSBPID(RSB)	;[6017]Get the remote operator pid
	ENDIF.

;  Remote message

	MOVE T4,BTFLGS		;[6010]Get the more data flag
	TXO T2,MF.NEB		;[6017]Set the NEBULA bit
	TXNE T4,WT.MOR		;[6010]Any more data?
	TXO T2,MF.MOR	 	;[6017]Yes, lite the more bit
	SKIPA			;[6010]
BT5:	SETZ T2,		;[6010]No flags
	CALL GALHDR		;BUILD GALAXY MESSAGE HEADER IN TBUF
	MOVE T1,BTFLGS		;GET CURRENT FLAGS 
	TXO T1,WT.SJI		;ALWAYS SUPPRESS JOB INFORMATION
	MOVEM T1,TBUF+.OFLAG	;SET FLAGS WORD OF MESSAGE TO ORION
	MOVEI T1,.APORN		;GOING TO ORION
	CALL TRANG		;QUEUE IT UP FOR TRANSMISSION
	MOVE T1,BTFLGS		;Get flags
	TXNE T1,WT.MOR		;More text?
	JRST BT2		;Yes, process it
	SETZM NEBMSG		;[6010]Clear NEBULA FLAG
	SETZM BTFLGS		;No, clear message flags
	HRRZ T1,CT4		;GET FUNCTION CODE
	CAIE T1,.OMWTR		;WHAT FUNCTION?
	RET			;NOT WTOR - ALL DONE

; WTOR - MAKE ENTRY IN RESPONSE-EXPECTED QUEUE

	MOVE T1,CT2		;GET WTB ADDRESS
	SKIPE WTBCOD(T1)	;MESSAGE OUTSTANDING?
	CALL STOP		;YES, PROGRAM LOGIC ERROR
	MOVE T2,UNIQUE
	MOVEM T2,WTBCOD(T1)	;SAVE ACK CODE
	XMOVEI T2,20
	HRR T2,CT1
	MOVEM T2,WTBENT(T1)	;SAVE CALLER'S GLOBAL ENTRY ADDRESS
	MOVEI T2,WTBLNK(T1)	;GET ADDRESS OF PACKET LINKAGE WORD
	MOVEI T1,WTRQDB		;GET QUEUE DESCRIPTOR BLOCK ADDRESS
	CALLRET QMQT		;PUT PACKET ON EXPECTED-RESPONSE QUEUE

; BTJOB - REQUEST WT.JOB BE SET IN NEXT MESSAGE TO ORION
; BTNFO - REQUEST WT.NFO BE SET IN NEXT MESSAGE TO ORION
; RETURNS +1: ALWAYS

BTJOB::	SKIPA T1,[WT.JOB]
BTNFO::	MOVX T1,WT.NFO
	IORM T1,BTFLGS		;SET APPROPRIATE FLAG
	RET
; CANWTR - CANCEL AN OUTSTANDING WTOR MESSAGE
;  T1/ ACK CODE FROM WTB
; RETURNS +1: ALWAYS

CANWTR: QSCANI WTRQDB		;SET UP TO SCAN OUTSTANDING WTOR QUEUE
	STKVAR <CANCOD>
	MOVEM T1,CANCOD		;SAVE ACK CODE

; SEARCH WTB QUEUE FOR THE WTB WITH THE SPECIFIED ACK CODE

CANWT1:	CALL QMSCAN		;GET ADDRESS OF NEXT WTB ON CHAIN
	 CALL STOP		;END OF LIST, EXPECTED WTB MISSING
	MOVE T3,WTBCOD(T2)	;GET ACK CODE FROM WTB
	CAME T3,CANCOD		;IS THIS THE ONE THE CALLER WANTS?
	JRST CANWT1		;NO, CONTINUE SEARCH

; FOUND THE WTB FOR THE WTOR REQUEST THAT'S GOING TO BE CANCELED
; BUILD AND TRANSMIT CANCEL-WTOR MESSAGE TO ORION

	CALL QMDQS		;DEQUEUE WTB
	SUBI T2,WTBLNK		;GET WTB ADDRESS IN T2
	SETZM WTBCOD(T2)	;MARK WTB AS INACTIVE
	MOVE T1,[.OARGC+1,,.OMWTR] ;BUILD GALAXY HEADER
	SETZ T2,		; FLAGS
	MOVE T3,CANCOD		; ACK CODE
	CALL GALHDR
	MOVX T1,WT.KIL+WT.SJI	;GET FLAG FOR KILL-WTOR
	MOVEM T1,TBUF+.OFLAG
	SETZM TBUF+.OARGC	;NO ARGUMENTS
	MOVEI T1,.APORN		;MESSAGE GOING TO ORION
	CALLRET TRANG		;SEND CANCEL REQUEST TO ORION


; CMDCFM - PARSE END-OF-LINE
;  CSB/ COMND STATE BLOCK
; RETURNS +1: ERROR, MESSAGE SENT TO OPERATOR
;	  +2: SUCCESS

CMDCFM:	MOVEI T2,[FLDDB. .CMCFM]
	CALL COMNDX		;PARSE IT
	 SKIPA			;ERROR
	RETSKP			;SUCCESS
	JSP T1,RSPERR
	ASCIZ/Superfluous information at end of response/
; COMNDI - SET UP COMND STATE BLOCK FOR PARSING OPERATOR RESPONSE
;  T1/ ADDRESS OF ASCIZ OPERATOR RESPONSE TEXT
; RETURNS +1: ALWAYS, CSB SET UP FOR PARSING

COMNDI::STAKT			;STACK T1-T4
	TMCT <%I>		;INIT MESSAGE COMPOSER
	MOVE T1,CT1		;GET ADDRESS OF RESPONSE TEXT
	CALL TMCRSP		;COPY TEXT TO THE WIDE OPEN SPACES
	MOVX T3,CM%RAI+CM%XIF	;RAISE INPUT, NO INDIRECT FILE
	MOVEM T3,CSB+.CMFLG
	SETZM CSB+.CMIOJ	;SET BAD JFNS TO PREVENT TTY I/O
	HRROI T3,[0]
	MOVEM T3,CSB+.CMRTY	;CTRL/R BUFFER BYTE POINTER
	HRROI T1,TMCMSG
	MOVEM T1,CSB+.CMBFP	;BEGINNING OF INPUT
	MOVEM T1,CSB+.CMPTR	;POINTER TO NEXT FIELD TO BE PARSED
	MOVEI T2,5000
	MOVEM T2,CSB+.CMCNT	;SIZE OF AREA AFTER .CMPTR
	MOVEM T2,CSB+.CMINC	;# OF UNPARSED CHARS AFTER .CMPTR
	HRROI T3,ATMBFR
	MOVEM T3,CSB+.CMABP	;POINTER TO ATOM BUFFER
	MOVEI T3,ATMSIZ*5
	MOVEM T3,CSB+.CMABC	;SIZE OF ATOM BUFFER (CHARACTERS)
	SETZM CSB+.CMGJB	;GTJFN BUFFER ADDRESS
	RET


; COMNDX - EXECUTE COMND JSYS TO PARSE OPERATOR RESPONSE IN CORE
;  T2/ ADDRESS OF FUNCTION DESCRIPTOR BLOCK CHAIN
;  CSB/ COMND JSYS STATE BLOCK SET UP BY COMNDI SUBROUTINE
; RETURNS +1: PARSE FAILED
;	  +2: PARSE SUCCEEDED, T2/ T2 RETURNED BY COMND JSYS
;			       T3/ ADDRESS OF FDB ACTUALLY USED

COMNDX::SAVEQ
	MOVE T1,CSB+.CMINC	;GET # OF UNPARSED CHARACTERS
	CAIN T1,5000		;FIRST PARSE FOR THIS COMMAND LINE?
	JRST [	MOVX Q1,FLD(.CMCFM,CM%FNC) ;YES
		HRR Q1,T2	;PREFIX CALLER'S FDB WITH CONFIRM FDB
		MOVEI T2,Q1	;SUBSTITUTE THE ADDRESS OF MY FDB
		JRST .+1]
	MOVEI T1,CSB		;GET ADDRESS OF COMND STATE BLOCK
	COMND			;CALL MONITOR
	 ERJMP R		;JSYS FAILED, MAKE LIKE PARSE ERROR
	HRRZS T3		;GET ACTUAL FDB ADDRESS IN T3
	TXNN T1,CM%NOP		;PARSE ERROR?
	CAIN T3,Q1		; OR NULL COMMAND LINE?
	RET			;YES, RETURN +1, ERROR CODE IN T2
	RETSKP
; COMNDV - PARSE A VOLID WITHIN OPERATOR RESPONSE
;  CSB/ COMND JSYS STATE BLOCK
; RETURNS +1: BAD VOLID, ERROR MESSAGE SENT TO OPERATOR
;	  +2: SUCCESS, T1/ SIXBIT VOLID

COMNDV:	MOVEI T2,[FLDDB.(.CMQST,,,,,[FLDDB.(.CMFLD)])]
	CALL COMNDX		;PARSE QUOTED STRING OR FIELD
	 SETZM ATMBFR		;SYNTACTICAL ERROR
	MOVEI T1,ATMBFR		;GET STRING ADDRESS
	CALL ASCIZL		;GET LENGTH OF VOLID IN T2
	JUMPE T2,[JSP T1,RSPERR	;ERROR IF NULL VOLID
		ASCIZ/Syntactical error in volume-id/]
	CAILE T2,6		;TOO LONG?
	JRST [	JSP T1,RSPERR	;YES
		ASCIZ/Volume identifier longer than 6 characters/]
	MOVE T1,[POINT 7,ATMBFR] ;GET POINTER TO ASCII VOLID
	CALL CVTA6R		;CONVERT VOLID TO SIXBIT
	 JRST [	JSP T1,RSPERR	;ERROR
		ASCIZ/Illegal volume identifier/]
	RETSKP			;LOOKS GOOD, RETURN IT TO CALLER
; INWTOR - PROCESS INCOMING RESPONSE TO OUTSTANDING WTOR MESSAGE
;  RBUF/ IPCF MESSAGE FROM ORION, MESSAGE TYPE = .OMRSP
; RETURNS +1: ALWAYS

INWTOR:	QSCANI WTRQDB		;SET UP TO SCAN OUTSTANDING WTOR QUEUE
	STKVAR <WTBAD>

; SCAN OUTSTANDING WTOR MESSAGE QUEUE FOR THE MESSAGE THAT
; MATCHES UP WITH THE RESPONSE I JUST GOT

INWTO1:	CALL QMSCAN		;GET ADDR OF NEXT PACKET IN QUEUE
	 RET			;RACE - OPERATOR RESPONDED TO MESSAGE
				;JUST BEFORE ORION GOT MY KILL ORDER
	MOVE T3,WTBCOD-WTBLNK(T2) ;GET ACK CODE FROM ENTRY
	CAME T3,RBUF+.MSCOD	;DOES IT MATCH CODE IN IPCF MESSAGE?
	JRST INWTO1		;NO, CONTINUE SCAN

; THE RESPONSE HAS BEEN IDENTIFIED - DEQUEUE THE WTB,
; LOAD AC'S FOR HANDLER, AND SCHEDULE IT

	CALL QMDQS		;DEQUEUE THIS ENTRY, GET ADDR IN T2
	SUBI T2,WTBLNK		;SUBTRACT LINKAGE WORD OFFSET
	MOVEM T2,WTBAD		;SAVE ADDRESS OF WTB
	SETZM WTBCOD(T2)	;MARK WTB AS INACTIVE
	MOVEI T1,.ACKID
	CALL ORNBLF		;LOOK UP OPR-IDENTIFIER BLOCK
	 SETZ T2,		;NOT THERE
	JUMPE T2,[CALLRET BADOM] ;BLOCK NOT THERE OR TOO SHORT
	MOVE T1,(T1)		;GET ID OF RESPONDING OPR
	MOVEM T1,RBUF+.MSCOD	;SET IN CASE I WANT TO CALL BTACK
	MOVEI T1,.CMTXT		;SPECIFY ARG TYPE I WANT
	CALL ORNBLF		;SCAN ARG LIST FOR RESPONSE
	 JRST [	CALLRET BADOM]	;NO RESPONSE BLOCK, BAD MSG FROM ORION
	HRLI T1,(POINT 7)	;CONSTRUCT POINTER TO RESPONSE TEXT
	MOVE T2,WTBAD		;GET WTB ADDRESS IN T2

; ENTER RESPONSE PROCESSOR WITH THE FOLLOWING AC SETUP:
;   T1/ BYTE POINTER TO ASCIZ RESPONSE FROM OPERATOR
;   T2/ ADDRESS OF WTB

	CALLRET @WTBENT(T2)	;CALL BTWTOR CLEANUP CODE
; KC ROUTINES - CHECK FOR VARIOUS TAPE DRIVE CONDITIONS
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: CONDITION NOT SATISFIED, ERROR MESSAGE SENT TO OPERATOR
;	  +2: CONDITION SATISFIED

; CHECK FOR DRIVE AVAILABLE TO USERS

KCAVL:	LOAD T2,MTASTE		;GET STATE
	CAIN T2,S.AV		;AVAILABLE?
	RETSKP			;YES
	MOVEI T1,[ASCIZ/Not Under Operator Control/]
	JUMPE T2,KC1		;JUMP IF DRIVE NOT ASSIGNED
	JSP T1,KC1		;ONLY OTHER CASE IS INITIALIZING
	ASCIZ/In INITIALIZE Mode/

; CHECK IF DRIVE IS LOADED

KCLOAD:	JN MA%LOD,MTAFLG(MTA),RSKP
	JSP T1,KC1
	ASCIZ/Not Loaded/

; CHECK IF DRIVE IS IN USE BY ME OR USER

KCUSE:	SAVEAC <MT,RSB>
	JN MTAJCT,,[TMCT <%I%M Is In Use By MOUNTR, Try Later>
		MOVEI T3,TMCMSG
		CALLRET BTACK]	;SEND REPLY AND RETURN +1
	LOAD MT,MTAMT		;MT ASSOCIATED?
	JUMPE MT,RSKP		;RETURN GOOD IF DRIVE NOT IN USE
	LOAD RSB,MTRSB		;GET RSB ADDRESS
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%I%M Is In Use By Request # %1D> ;A USER HAS IT
	MOVEI T3,TMCMSG
	CALLRET BTACK		;TELL OPERATOR

; KC1 - T1/ ADDRESS OF ASCIZ ERROR MESSAGE

KC1:	TMCT <%ITape Drive %M is %1A>
	MOVEI T3,TMCMSG
	CALLRET BTACK		;SEND ACK BACK TO OPR AND TAKE +1 RET
; KDMT - PROCESS DELETE MOUNT-REQUEST COMMAND FROM OPR
; RETURNS +1: ALWAYS

KDMT:	SAVEQ
	MOVEI T1,.ORREA
	CALL ORNBLF		;LOOKUP REASON BLOCK
	 SETZ T2,		;NOT FOUND
	SKIPE Q1,T2		;REASON GIVEN?
	JRST [	MOVSS T1	;YES, GET BLT SOURCE
		HRRI T1,ATMBFR	;BLT DESTINATION
		BLT T1,ATMBFR-1(T2) ;COPY REASON TO ATMBFR FOR TELUSR
		SETZM ATMBFR(T2) ;TIE IT OFF
		JRST .+1]
	MOVEI T1,.ORREQ
	CALL ORNBLF		;LOOKUP REQUEST # BLOCK
	 JRST KDMT1		;NOT THERE, TRY STRUCTURE FORM

; DELETING SPECIFIC MOUNT REQUEST

	JUMPE T2,KBADM		;REJECT HEADER-ONLY ENTRY
	MOVE T1,(T1)		;GET REQUEST #
	CALL REQRSB		;TRANSLATE REQ# TO RSB ADDR
	 JRST KNXREQ		;REQUEST DOES NOT EXIST
	LOAD T2,RSBSTE		;GET STATE OF REQUEST
	CAIE T2,RST.WM		;WAITING FOR MOUNT?
	CAIN T2,RST.WV		; OR WAITING FOR VOLID LIST KEYIN?
	SKIPA			;IF EITHER, OK TO DELETE
	JRST [	JSP T2,KACKRQ	;CAN'T DELETE THIS REQUEST
		ASCIZ/Is Not Waiting/]
	MOVEI T2,[ASCIZ/Canceled/]
	CALL KACKRQ		;TELL OPERATOR I DELETED IT
	MOVE	Q2,RSBSTN(RSB)	;GET STR NAME
	MOVE	Q3,RSBSTA(RSB)	;GET STR ALIAS
	JUMPN Q1,[ABTREQ (MREQ15,ABT%OP) ;ABORT WITH REASON
		  JRST	KDMT0]		 ;AND CONTINUE
	ABTREQ (MREQ15)		;ABORT WITHOUT REASON
KDMT0:	QSCANI	ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
KDMT0A:	CALL	NSTRSB		;GET ADDR OF NEXT RSB
	JRST	KDMT0B		;END OF QUEUE
	CAMN	Q2,RSBSTN(RSB)	;SAME STR NAME
	CAME	Q3,RSBSTA(RSB)	;SAME ALIAS
	JRST	KDMT0A		;NO, TRY NEXT RSB
	MOVE	T1,RSBIFL(RSB)	;YES, SEE IF OPR HAS BEEN NOTIFIED
	TXNE	T1,R%ONR	;
	JRST	KDMT0A		;OPR HAS SEEN THIS ONE, TRY NEXT
	CALL	WOVMS		;OPR HAS NOT SEEN IT YET --TELL OPR
KDMT0B:	RET			;FINISHED


; DELETING ALL MOUNT REQUESTS FOR SPECIFIED STRUCTURE

KDMT1:	MOVEI T1,.STRDV		;SPECIFY BLOCK TYPE
	CALL KGTSTR		;GET STRUCTURE NAME
	 JRST KBADM		;NOT THERE, ERROR
	MOVE Q2,T1		;SAVE SIXBIT STRUCTURE NAME
	QSCANI ARBQDB		;SET UP TO SCAN REQUEST QUEUE
	SETZ Q3,		;SET ABORTED REQUEST COUNT TO ZERO

; SCAN REQUEST QUEUE ABORTING REQUESTS FOR THIS STRUCTURE

KDMT2:	CALL NSTRSB		;GET NEXT RSB
	 JRST KDMT3		;NONE LEFT
	LOAD T1,RSBTYP		;GET TYPE
	CAIE T1,.MNTST		;STRUCTURE MOUNT?
	JRST KDMT2		;NO, SKIP IT
	SKIPN T1,RSBSTN(RSB)	;STRUCTURE NAME SPECIFIED?
	MOVE T1,RSBSTA(RSB)	;NO, USE ALIAS
	CAME Q2,T1		;WANT TO CANCEL THIS REQUEST?
	JRST KDMT2		;NO, SKIP IT
	JUMPN Q1,[ABTREQ (MREQ15,ABT%OP) ;ABORT WITH REASON
		AOJA Q3,KDMT2]	;COUNT IT AND CONTINUE SCAN
	ABTREQ (MREQ15)		;ABORT WITHOUT REASON
	AOJA Q3,KDMT2		;COUNT IT AND CONTINUE SCAN

; TELL THE OPERATOR HOW MANY REQUESTS WERE DELETED

KDMT3:	JUMPE Q3,[TMCT <%INo>
		JRST KDMT3A]
	TMCT <%I%7D>		;DISPLAY # OF REQUESTS
KDMT3A:	TMCT < Mount Request>
	SOJN Q3,[TMCT <s>	;TACK ON S IF NOT 1 REQUEST
		JRST .+1]
	TMCT < Canceled>
	MOVEI T3,TMCMSG		;GET ADDRESS OF MESSAGE
	CALLRET BTACK		;RESPOND TO DELETE COMMAND
; KDIS/KENA - PROCESS ENABLE AND DISABLE COMMANDS FROM OPR
; RETURNS +1: ALWAYS

KDIS:	SKIPA T1,[[LOAD T1,MTASTE
		CAIE T1,S.AV
		RET
		MOVX T1,MA%AVE
		ANDCAM T1,MTAFLG(MTA)
		RET]]		;COROUTINE FOR DISABLE
KENA:	MOVEI T1,[LOAD T1,MTASTE
		CAIE T1,S.AV
		RET
		CALL AVRENA
		CALLRET AVR]	;COROUTINE FOR ENABLE
	JXE F,TALCF,KNALC	;REJECT IF ALLOCATION NOT ENABLED
	STAKT
	MOVEI T1,.AVREC		;CHECK FOR AVR KEYWORD
	CALL ORNBLF		;IS IT THERE?
	 JRST KBADM		;NO
	MOVE T1,CT1		;GET ADDRESS OF COROUTINE
	CALL KTXCT		;DO IT FOR SPECIFIED TAPE DRIVES
	 JRST KBADM		;BAD MESSAGE FROM QUASAR
	RET
; KGBLK - LOOK UP SPECIFIED BLOCK TYPE IN MESSAGE
;  T1/ BLOCK TYPE
;  T2/ UPPER LIMIT OF ARGUMENT (LOWER LIMIT = 0)
;      IF T2/ 0, NO LIMIT CHECKING IS DONE
;  T3/ DEFAULT, APPLIED IF (T2).NE.0 AND VALUE=0
;		OR IF ENTRY NOT PRESENT
; RETURNS +1: HEADER-ONLY ENTRY OR VALUE BEYOND LIMITS
;	  +2: T1/ VALUE (OR DEFAULT IF APPLICABLE)

KGBLK:	STAKT			;SAVE ARGS
	CALL ORNBLF		;LOOKUP ARGUMENT
	 JRST KGBLK1		;NOT THERE, TAKE THE DEFAULT
	JUMPE T2,R		;ERROR IF HEADER-ONLY
	MOVE T1,(T1)		;GET ARGUMENT
	SKIPN CT2		;LIMIT CHECK REQUESTED?
	RETSKP			;NO, JUST PASS IT BACK
	CAMG T1,CT2		;GREATER THAN UPPER LIMIT?
	SKIPGE T1		; OR BELOW 0 ?
	RET			;YES, ERROR
	SKIPN T1		;IS IT 0 ?
KGBLK1:	MOVE T1,CT3		;YES, SUBSTITUTE THE DEFAULT
	RETSKP


; KGTSTR - LOCATE AND EXTRACT STRUCTURE OR ALIAS NAME
;  T1/ ENTRY TYPE CODE (.STRDV OR .STALS)
; RETURNS +1: ENTRY NOT FOUND
;	  +2: SUCCESS, T1/ SIXBIT STRUCTURE NAME  T2,T3/ ASCIZ NAME

KGTSTR:	CALL ORNBLF		;LOOKUP SPECIFIED BLOCK TYPE
	 JRST KGSTR1		;NOT FOUND
	SAVET			;SET UP TO RETURN VALUES TO CALLER
	DMOVE T3,(T1)		;GET ASCIZ NAME FROM ENTRY
	CAIG T2,1		;ENTRY 1 WORD LONG?
	SETZ T4,		;YES, ZAP SECOND WORD
	DMOVEM T3,CT2		;RETURN ASCIZ NAME IN T2,T3
	MOVSI T1,(POINT 7)
	HRRI T1,CT2		;CONSTRUCT POINTER TO ASCIZ NAME
	MOVEI T2,CT1		;RETURN SIXBIT EQUIVALENT HERE
	CALL SEVSIX		;CONVERT NAME TO SIXBIT
	RETSKP
KGSTR1: TXNN F,PORTF		;Are we doing a port operation
	RET			;No, return failure
	SAVET			;
	MOVE T1,DSKSTN(DSK)	;Get sixbit name from status block
	MOVEM T1,CT1		;Save it for return
	MOVEI T1,CT1		;Adress of sixbit for SIXSEV
	MOVSI T2,(POINT 7)
	HRRI T2,CT2		;Construct pointer to ASCIZ name
	CALL SIXSEV		;Convert name to ASCIZ
	RETSKP

; KGTVOL - EXTRACT SIXBIT VOLID FROM .VOLID ENTRY
; RETURNS +1: ERROR, MESSAGE SENT TO OPR
;	  +2: T1/ 0 IF .VOLID ENTRY ABSENT, ELSE SIXBIT VOLID

KGTVOL:	SAVEQ
	STKVAR<TMPSIX>		;Later, to hold sixbit vol. i.d. value
	MOVEI T1,.VOLID
	CALL ORNBLF		;VOLID SPECIFIED?
	 JRST [	SETZ T1,	;NO, RETURN ZERO
		SETOM RSBIVN(RSB) ;Consider as non-numeric
		RETSKP]
	JUMPE T2,KBADV		;MUST HAVE SOMETHING AFTER HEADER
	MOVE Q1,T1		;SAVE ADDRESS OF ASCIZ VOLID
	CALL ASCIZL		;GET # OF CHARACTERS IN VOLID
	SKIPE T2		;NULL VOLID IS AN ERROR
	CAILE T2,6		;LONGER THAN 6 CHARACTERS?
	JRST KBADV		;YES, ERROR
	MOVE T1,Q1		;FETCH ADDRESS OF VOLID
	HRLI T1,(POINT 7)	;MAKE BYTE POINTER
	CALL CVTA6R		;CONVERT TO SIXBIT
	 JRST KBADV		;NOT A LEGAL VOLID
	MOVEM T1,TMPSIX		;Save for later use
	MOVE T1,Q1		;Address of vol. i.d. in ASCIZ
	CALL ASCIZL		;(T2) = number characters in vol. i.d.
	MOVE T1,Q1		;Make T1 into a pointer to the volume
	HRLI T1,(POINT 7)	;i.d. in ASCIZ
	ILDB T3,T1		;Get the 1st volume i.d. character
	CAIN T3,"0"		;Is it a zero?
	JRST NONUM		;Yes, so consider it as non-numeric
	SETZM T4		;T4 will contain the integer value
	SKIPA			;Continue to check the first character
CHKNXT: ILDB T3,T1		;Next volume i.d. character
	CAIL T3,"0"		;Less than zero in value?
	CAILE T3,"9"		;No, less or equal to nine?
	JRST NONUM		;Not numeric
	SUBI T3,"0"		;Change from ASCII to binary
	ADD T4,T3		;Add to the integer volume i.d.
	SOSLE T2		;Don't multiply the units contribution
	IMULI T4,^D10		;Multiply by base 10
	JUMPG T2,CHKNXT		;Get the next character
	MOVEM T4,RSBIVN(RSB)	;Store the integer value of the i.d.
	SKIPA			;Numeric, so skip the next
NONUM:	SETOM RSBIVN(RSB)	;Indicate that not numeric
 	MOVE T1,TMPSIX		;Restore the sixbit value of the i.d.
	RETSKP
; KIDN - PROCESS IDENTIFY COMMAND FROM OPR
; RETURNS +1: ALWAYS

KIDN:	SAVEQ
	SAVEAC <MT,MTA,RSB>
	STKVAR <<OWNER,10>>	;LOCAL WORK AREA FOR GETVU ROUTINE
; VALIDATE TAPE DRIVE

	MOVEI T1,.TAPDV
	CALL ORNBLF		;TAPE DRIVE SPECIFIED?
	 JRST KBADM		;NO, BAD MESSAGE FROM QUASAR
	JXE F,TALCF,KNALC	;REJECT IF ALLOCATION IS NOT ENABLED
	CALL STMTA		;CONVERT STRING TO MTA STATUS BLOCK ADDR
	 JRST KBADM		;NOT MTA DEVICE STRING

	MOVEI T1,.ORREQ
	CALL ORNBLF		;LOOKUP REQUEST # BLOCK
	 JRST KIDV		;NOT THERE, MAYBE ANOTHER FORM OF CMD
	JUMPE T2,KBADM		;REJECT HEADER-ONLY ENTRY
	MOVE Q3,(T1)		;GET REQUEST #

; PROCESS COMMAND:  IDENTIFY drive REQUEST-ID n

	MOVE T1,Q3		;GET REQUEST #
	CALL REQRSB		;GET RSB ADDRESS FOR THIS REQUEST
	 JRST KNXREQ		;REQUEST DOES NOT EXIST
	HRROI T2,[ASCIZ/Not Waiting For Tape Mount/]
	LOAD T3,RSBTYP
	CAIE T3,.MNTTP		;TAPE REQUEST?
	JRST KACKRQ		;NO, REJECT IT
	LOAD T3,RSBSTE		;GET STATE
	CAIN T3,RST.WV		;WAITING FOR KEYIN?
	JRST [	JSP T2,KACKRQ	;YES, REJECT WITH APPROPRIATE MESSAGE
		ASCIZ/Waiting For RESPOND Keyin/]
	CAIE T3,RST.WM		;WAITING FOR TAPE MOUNT?
	JRST KACKRQ		;NO
	CALL VQGCV		;DOES USER WANT A SCRATCH TAPE?
	JUMPE T1,KIDR1		;YES, TAKE ALTERNATE PATH
	MOVE Q1,T1		;SPECIFIC VOLID, SAVE IT
	MOVX T2,TM%BYP
	TDNE T2,RSBUFL(RSB)	;BYPASS MODE?
	SETZ T1,		;YES, KEEP KVAC FROM BARFING
	SETZ T2,		;NOT SCRATCH
	CALL KVAC		;OK TO SET NEW VOLID?
	 RET			;NO, ERROR MESSAGE SENT
	MOVEM Q1,MTAIDV(MTA)	;SET ALLEGED VOLID
	EXCH Q1,MTAVOL(MTA)	;SET NEW VOLID, SAVE OLD
	CALL VRA		;TRY TO MATCH REQUEST TO VOLUME NOW
	 SKIPA			;DIDN'T MATCH
	RET			;DID MATCH, ALL DONE
	MOVEM Q1,MTAVOL(MTA)	;RESTORE OLD VOLID
	CALL CHKAB		;REQUEST ABORTED?
	 JRST KIDR0		;YES, CLEAN UP AND LEAVE
	CALL VOLMNT		;STILL THERE, TRY TO MOUNT AGAIN
	JN MTAJCT,,R		;RETURN IF AVR IN PROGRESS
KIDR0:	SETZM MTAIDV(MTA)	;REQ ABORTED OR NOT DOING AVR
	RET

; SAME AS ABOVE, BUT USER IS REQUESTING SCRATCH VOLUME

KIDR1:	SETZ T1,		;NOT SETTING VOLID
	MOVEI T2,1		;SCRATCH
	CALL KVAC		;OK TO SCRATCH THIS VOLUME?
	 RET			;NO, ERROR MESSAGE SENT
	LOAD T1,MTALT
	CAIN T1,.LTT20		;TOPS-20 LABELED TAPE?
	JRST [	JN MA%SCR,MTAFLG(MTA),.+1 ;YES, OK IF ALREADY SCRATCH
		MOVEI T1,OWNER	;SUPPLY WORK AREA ADDRESS TO GETVU
		CALL GETVU	;GET TAPE OWNER'S USER # IN T2
		CAME T2,RSBUNO(RSB) ;OWNER AND REQUESTOR THE SAME?
		JRST KNOSCR	;NO, REJECT KEYIN
		JRST .+1]	;YES, PERMIT IT
	MOVE Q1,MTAFLG(MTA)	;SAVE FLAGS
	SETONE MA%SCR,MTAFLG(MTA) ;SET SCRATCH
	SETZRO MA%OPF,MTAFLG(MTA) ;CLEAR OVERWRITE-PROTECTED
	CALL VRA		;TRY TO MATCH REQUEST TO VOLUME
	 SKIPA			;DIDN'T MATCH
	RET			;DID MATCH, ALL DONE
	MOVX Q2,MA%SCR+MA%OPF	;RESTORE MA%SCR AND MA%OPF IN MTAFLG
	AND Q1,Q2
	ANDCAM Q2,MTAFLG(MTA)
	IORM Q1,MTAFLG(MTA)
	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%I%M Tape Not Compatible With Request %1D>
	MOVEI T3,TMCMSG
	CALLRET BTACK		;SEND IT OFF

; PROCESS FOLLOWING FORMS OF IDENTIFY COMMAND:
;    IDENTIFY drive VOLUME-ID volid
;    IDENTIFY drive SCRATCH-TAPE

KIDV:	CALL KGTVOL		;LOOKUP .VOLID ENTRY
	 RET			;SOME ERROR, OPERATOR NOTIFIED
	MOVE Q1,T1		;SAVE VOLID IN Q1

	MOVEI T1,.SCRTP
	MOVEI Q2,1		;ASSUME SCRATCH SPECIFIED
	CALL ORNBLF		;SCRATCH SPECIFIED?
	 JRST [	SETZ Q2,	;NO, SET NO SCRATCH
		JUMPN Q1,.+1	;ARE .SCRTP AND .VOLID BOTH ABSENT?
		JRST KBADM]	;YES, BAD MESSAGE
	JUMPN Q2,[MOVE T1,MTAFLG(MTA) ;IF SCRATCHING, GET FLAGS
		LOAD T2,MTALT	;AND LABEL TYPE
		TXNN T1,MA%SCR	;ALREADY SCRATCH?
		CAIE T2,.LTT20	;OR NOT TOPS-20 LABEL?
		JRST .+1	;YES TO EITHER, OK TO SCRATCH
		JRST KNOSCR]	;CAN'T SCRATCH TOPS-20 TAPE WITH THE
				;IDENTIFY COMMAND - MUST SET TAPE INIT
	DMOVE T1,Q1		;GET VOLID AND SCRATCH FLAG
	CALL KVAC		;OK TO DO THIS TO THIS DRIVE?
	 RET			;NO, ERROR MESSAGE SENT

; EVERYTHING LOOKS LEGAL, NOW DO WHAT THE OPERATOR WANTS

	SKIPE Q1		;SETTING VOLID?
	MOVEM Q1,MTAVOL(MTA)	;YES, DO IT
	JUMPN Q2,[SETONE MA%SCR,MTAFLG(MTA) ;SETTING SCRATCH FLAG
		SETZRO MA%OPF,MTAFLG(MTA) ;CLEAR OVERWRITE PROTECTION
		JRST .+1]
	CALLRET MATCHV		;TRY TO MATCH VOLUME WITH A REQUEST
; KSHT - PROCESS SHOW STATUS TAPE-DRIVE COMMAND FROM OPR
; ACCEPTS IPCF MESSAGE IN RBUF
; RETURNS +1: ALWAYS

KSHT:	SAVEQ
	JXE F,TALCF,KNALC	;REJECT IF ALLOCATION IS NOT ENABLED
	TMCTN <%I
Drive  State     Volid   Req#  Job#  User
-----  -----     ------  ----  ----  ---->
	MOVE T1,RBUF+.OFLAG	;GET FLAGS
	TXNE T1,ST.AVA		;/FREE
	TMCTN <%I
Drive  State    Avr  Write  Volid   Scr  Lbl Type  Density
-----  -----    ---  -----  ------  ---  --------  ------->
	TXNE T1,ST.CHR		;CHARACTERISTICS
	TMCTN <%I
Drive  Type             Supported Densities
-----  ---------------  ------------------->
	TMCTO			;INSERT HEADING
	MOVE Q1,TMCPTR		;GET CURRENT TEXT POINTER
	MOVEI T1,KSHSCR		;GET COROUTINE ADDRESS
	CALL KTXCT		;BUILD THE BODY OF THE DISPLAY
	 JRST KBADM		;BAD IPCF MESSAGE
	CAME Q1,TMCPTR		;Anything displayed?
	JRST [MOVEI T3,[ASCIZ/Tape Drive Status/] ;Yes
	      CALL BTNFO		;REQUEST NO FORMATTING
	      MOVE T4,RBUF+.MSFLG	;[6010]Get the message flag word
	      TXNE T4,MF.NEB		;[6010]From NEBULA
	      SETOM NEBMSG		;[6010]Yes
	      CALLRET BTACKT]		;SEND DISPLAY TO OPERATOR AND SPLIT

	MOVEI T3,[ASCIZ/There Are No Free Tape Drives/] ;No, assume free drives
	LOAD T2,ST.AVA,RBUF+.OFLAG ;Get the switch
	SKIPN T2		;Asking for free-drive display?
	MOVEI T3,[ASCIZ/There Are No Tape Drives/] ;No
	MOVE T4,RBUF+.MSFLG	;[6010]Get the message flag word
	TXNE T4,MF.NEB		;[6010]From NEBULA
	SETOM NEBMSG		;[6010]Yes
	CALLRET BTACK

; COROUTINE FOR SHOW STATUS

KSHSCR:	SAVEQ
	SAVEAC <MT,RSB>
	MOVE Q3,RBUF+.OFLAG	;GET MESSAGE FLAGS
	JXN Q3,ST.AVA,KSHF	;/FREE
	JXN Q3,ST.CHR,KSHC	;/CHARACTERISTICS
; SHOW STATUS TAPE-DRIVE [/ALL]

	LOAD MT,MTAMT		;GET ADDRESS OF MT STATUS BLOCK
	JE MTASTE,,[CALL GMTADD	;DRIVE UNAVAILABLE, GET DESIGNATOR
		DVCHR		;GET LH(T3)/ OWNER'S JOB#
		TLNN T3,-1	;SHOW IF PHYSICAL DEVICE EXISTS
		CALL CKMPAV	;SHOW IF SET UNAVAILABLE
		 JRST .+1
		RET]		;DON'T SHOW
	TMCT <%_%M%8C>		;DISPLAY DRIVE NAME
	LOAD Q1,MTASTE
	CAIE Q1,S.AV		;AVAILABLE TO USERS?
	JRST [	JUMPE Q1,[TMCTR <Unavailable>] ;NO
		TMCT <Initialize>
		LOAD RSB,MTRSB	;GET RSB ADDRESS
		SKIPN RSBWTB+WTBCOD(RSB) ;WAITING FOR OPER RESPONSE?
		RET		;NO
		TMCTR <, operator response wait>]
	MOVE Q1,MTAFLG(MTA)	;GET MTA FLAGS
	JXE Q1,MA%LOD,[TMCT <Unloaded>
		JRST KSHN1]
	MOVEI T1,[ASCIZ/Loaded/] ;ASSUME JUST LOADED
	SKIPE MT		;RIGHT?
	MOVEI T1,[ASCIZ/In Use/] ;NO, CHANGE TO IN USE
	TMCT <%1A%18C>		;DISPLAY STATE
	SKIPE T1,MTAVOL(MTA)	;DO I KNOW VOLID?
	CALL [	TMCTR <%1S>]	;YES, DISPLAY IT
	JUMPE MT,KSHN1		;THAT'S ALL IF NO USER
	LOAD RSB,MTRSB		;GET REQUEST STATUS BLOCK ADDRESS
	CAIN RSB,MTNAV		;MT OWNED BY PHANTOM USER?
	JRST KSHN1		;YES, THAT'S ALL
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	LOAD T2,RSBJNO		;GET JOB #
	MOVE T3,RSBUNO(RSB)	;GET USER #
	TMCT <%26C%1D%32C%2D%38C%3U> ;SHOW USER INFO
KSHN1:	JXE Q3,ST.ALL,R		;/ALL REQUESTED?
	LOAD T1,MA%AVE,Q1	;YES, GET AVR STATUS
	TMCT <%_%8CAVR: %1Y>	;DISPLAY AVR STATE
	JXE Q1,MA%LOD,R		;EXIT IF NOT LOADED
	LOAD T1,MA%WEN,Q1	;GET WRITE-ENABLED FLAG
	TMCT <, Write: %1Y>	;DISPLAY IT
	LOAD T1,MTALT		;GET LABEL TYPE
	JUMPE T1,R		;NOT IDENTIFIED YET
	MOVE T2,LTTXT(T1)	;GET LABEL-TYPE TEXT
	MOVEI T3,[0]		;ASSUME UNLABELED
	CAIE T1,.LTUNL
	MOVEI T3,[ASCIZ/ labels/]
	TXNE Q1,MA%SCR		;SCRATCH?
	MOVEI T3,[ASCIZ/ scratch tape/]
	TMCT <, %2A%3A>		;SHOW LABEL TYPE, SCRATCH
	CAIN T1,.LTUNL		;UNLABELED?
	RET			;YES
	LOAD T2,MTADEN		;LABELED, SHOW DENSITY
	MOVE T2,DENTAB(T2)
	TMCTR <, %2D BPI>

; SHOW STATUS TAPE-DRIVE /FREE

KSHF:	LOAD T1,MTASTE		;GET STATE
	CAIE T1,S.AV		;AVAILABLE TO USERS?
	RET			;NO, SKIP IT
	JN MTAMT,,R		;DON'T SHOW IF A USER HAS IT
	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	MOVEI T2,[ASCIZ/Unloaded/] ;ASSUME UNLOADED
	TXNE T1,MA%LOD		;LOADED?
	MOVEI T2,[ASCIZ/Loaded/] ;YES
	LOAD T3,MA%AVE,T1	;GET AVR FLAG
	TMCT <%_%M%8C%2A%17C%3Y> ;DISPLAY DRIVE, STATE, AVR
	JXE T1,MA%LOD,R		;END OF LINE IF DRIVE NOT LOADED
	LOAD T2,MA%WEN,T1	;GET WRITE-ENABLED FLAG
	MOVE T3,MTAVOL(MTA)	;GET VOLID
	LOAD T4,MA%SCR,T1	;GET SCRATCH FLAG
	TMCT <%23C%2Y%29C%3S%37C%4Y> ;DISPLAY WRITE, VOLID, SCRATCH
	LOAD T1,MTALT		;GET LABEL TYPE
	JUMPE T1,R		;UNKNOWN
	MOVE T2,LTTXT(T1)	;GET POINTER TO TEXT
	TMCT <%42C%2A>		;DISPLAY LABEL TYPE
	CAIN T1,.LTUNL		;LABELED?
	RET			;NO, DONE
	LOAD T2,MTADEN		;YES, GET DENSITY CODE
	MOVE T2,DENTAB(T2)	;GET DENSITY
	TMCTR <%52C%2D>		;DISPLAY AND RETURN

; SHOW STATUS TAPE-DRIVE /CHARACTERISTICS

KSHC:	JE MTASTE,,R		;DON'T SHOW DRIVE IF I DON'T CONTROL IT
	LOAD T1,MTADRV		;GET DRIVE TYPE CODE
	MOVE T1,DRVTXT(T1)	;GET ADDRESS OF TEXT
	LOAD T2,MTADVT		;Get the device
	MOVSI T3,-DVTLEN	;Get number of things in table
KSHCDV:	HRRZ T4,DVTTXT(T3)	;Get te drive type from table
	CAIN T4,(T2)		;Do they match?
	JRST KSHCD2		;Yes
	AOBJN T3,KSHCDV		;Loop to check all of them
	SKIPA T2,[EXP [ASCIZ/??/]]
KSHCD2:	HLRZ T2,DVTTXT(T3)	;Point to drive type
	TMCT <%_%M%8C%2A%15C%1A%25C>	;DISPLAY DRIVE, TYPE
	MOVSI T1,-DENMAX-1	;GET AOBJP POINTER
	MOVSI T2,(1B0)		;SET UP INTERROGATION BIT
	MOVEI T3,[0]		;NO ", " BEFORE FIRST DENSITY
KSHC1:	AOBJP T1,R		;GET OUT OF LOOP IF DONE
	LSH T2,-1		;SHIFT BIT TO NEXT POSITION
	TDNN T2,MTASDN(MTA)	;IS THIS DENSITY SUPPORTED?
	JRST KSHC1		;NO, TEST NEXT DENSITY
	MOVE T4,DENTAB(T1)	;GET DENSITY
	TMCT <%3A%4D>		;DISPLAY DENSITY
	MOVEI T3,[ASCIZ/, /]	;SEPARATE SUBSEQUENT DENS WITH A COMMA
	JRST KSHC1
; KSTP - PROCESS SET TAPE-DRIVE COMMAND FROM OPR
; RETURNS +1: ALWAYS

KSTP:	SAVEQ
	SAVEAC <MTA>
	JXE F,TALCF,KNALC	;REJECT IF ALLOCATION IS NOT ENABLED
	MOVEI T1,.TAPDV
	CALL ORNBLF		;TAPE DRIVE SPECIFIED?
	 JRST KBADM		;NO
	CALL STMTA		;CONVERT STRING TO MTA STATUS BLOCK ADDR
	 JRST KBADM		;BAD MTA STRING
	SETZ Q1,		;ASSUME SETTING UNAVAILABLE
	MOVEI T1,.DVUAV
	CALL ORNBLF		;CHECK IF SETTING UNAVAILABLE
	 JRST [	MOVEI T1,.DVAVL	;NO
		CALL ORNBLF	;SETTING AVAILABLE?
		 SKIPA		;NO
		AOJA Q1,KSTPA	;SETTING AVAILABLE
		MOVEI T1,.DVINI
		CALL ORNBLF	;SETTING INITIALIZE MODE?
		 JRST KBADM	;NO, BAD MESSAGE
		CALLRET KVI]	;YES, GO DO IT

; SETTING DRIVE UNAVAILABLE

	MOVEI T1,.ORREA
	CALL ORNBLF		;REASON BLOCK PRESENT?
	 JRST KBADM		;NO
	MOVE Q2,T1		;COPY ADDRESS OF REASON TEXT
	CALL CKMPAV		;IS DRIVE ALREADY SET UNAVAILABLE?
KSTP1:	 JRST [	MOVE T1,[[ASCIZ/Unavailable/]
			 [ASCIZ/Available/]](Q1) ;GET TEXT POINTER
		TMCT <%ITape Drive %M Is Already Set %1A>
		MOVEI T3,TMCMSG
		CALLRET BTACK]	;TELL OPRTR HIS COMMAND HAS NO EFFECT
	LOAD T1,MTASTE
	CAIN T1,S.INIT		;IN INITIALIZE MODE?
	JRST [	CALL KVICU	;YES, CAN I GET OUT OF IT NOW?
		 RET		;NO
		JRST .+1]	;YES, CONTINUE
	MOVEI T1,CS%DDV		;GET CODE FOR DETACH-DEVICE
	MOVE T2,Q2		;GET ADDRESS OF ASCIZ REASON
	CALL SYTSET		;LOG SYSERR ENTRY FOR DRIVE SET UNAVAIL
	CALL DACMTA		;DEACTIVATE THE DRIVE IF POSSIBLE
	MOVEI T1,1		;GET 1 TO SET UNAVAILABLE
	CALL SMPAV		;UPDATE DEVICE STATUS FILE
	CALL WOTDAV		;TELL ALL OPERATORS WHAT HAPPENED
	RET

; SETTING DRIVE AVAILABLE

KSTPA:	LOAD T1,MTASTE		;GET CURRENT STATE
	CAIN T1,S.INIT		;INITIALIZING VOLUMES?
	JRST [	CALL KVICU	;YES, CLEAR INITIALIZE STUFF
		 RET		;CAN'T DO IT NOW
		CALLRET KVIDAV]	;GET BACK TO AVAILABLE STATE
	SETZ Q2,		;REMEMBER INITIAL SMPAV STATE IN Q2
	SKIPE T1		;OK IF DRIVE NOT BEING SCHEDULED
	CALL CKMPAV		;OK IF DRIVE SET UNAVAILABLE
	 TDZA Q2,Q2		;ONE OF THE ABOVE CONDITIONS WAS TRUE
	JRST KSTP1		;NEITHER TRUE, THAT'S AN ERROR
	SETZ T1,
	CALL SMPAV		;SET AVAILABLE IN STATUS FILE
	MOVEI T1,S.AV		;GET DESIRED STATE
	CALL ACTMTA		;TRY TO ACTIVATE THE MTA
	 JRST KSTP3		;CAN'T, SO SEND DIAGNOSTIC TO OPR
	CALL TDSC1		;CHECK IF LOADED, DO AVR, ETC.
	JUMPE Q2,[MOVEI T1,CS%ADV ;GET CODE FOR ATTACH-DEVICE
		SETZ T2,	;NO REASON
		CALL SYTSET	;LOG SYSERR ENTRY FOR DRIVE SET AVAIL
		JRST .+1]
	CALLRET WOTDAV		;TELL OPERATORS IT'S BACK

; Can't assign tape drive to us, T1/ job of assigner or error code

KSTP3:	MOVE Q2,T1		;SAVE JOB #
;**;[6040]At KSTP3:+1L replace 3 lines with 8 lines  GAS
	TMCT <%I%M >		;[6040] Start message with "MTAx: "
	MOVE T1,Q2		;[6040] Get job or error code back
	JUMPE Q2,[TMCT <Unknown to this system> ;[6040] If job 0
		JRST KSTP2]	;[6040] Tape drive not known yet
	CAIL Q2,.ERBAS		;[6040] Is it some other error code?
	JRST [	TMCT <%1J>	;[6040] Yes, print that error code
		JRST KSTP2]	;[6040]  and continue
	TMCT <Assigned to Job %1D> ;[6040] Tape is assigned to another job
KSTP2:	MOVEI T3,[ASCIZ/Cannot Set Tape Drive Available/]
	CALLRET BTACKT		;TELL OPERATOR WHY I CAN'T SET AVAIL
; KSWI - PROCESS SWITCH COMMAND FROM OPR
; RETURNS +1: ALWAYS

; VALIDATE REQUEST NUMBER AND STATE

KSWI:	SAVEQ
	SAVEAC <MT,MTA,RSB>
	MOVEI T1,.ORREQ
	CALL ORNBLF		;LOOKUP REQUEST #
	 JRST KBADM		;NOT THERE
	MOVE T1,(T1)		;GET REQ#
	CALL REQRSB		;FIND RSB
	 JRST KNXREQ		;UNKNOWN REQUEST #
	MOVEI T2,[ASCIZ/Not Using An Unlabeled Tape/]
	LOAD T3,RSBTYP		;GET REQ TYPE
	CAIE T3,.MNTTP		;TAPE-MOUNT REQUEST?
	JRST KACKRQ		;NO, REJECT IT
	LOAD T3,RSBSTE		;GET STATE
	LOAD T4,RSBLT		;GET LABEL-TYPE
	CAIN T3,RST.AC		;MUST BE ACTIVE
	CAIE T4,.LTUNL		;MUST HAVE UNLABELED TAPE
	JRST KACKRQ		;DOESN'T QUALIFY, REJECT IT
	LOAD MT,RSBMT		;GET MT STATUS BLOCK ADDRESS

; VALIDATE VOLID

	CALL KGTVOL		;LOOKUP VOLID
	 RET			;SCREWED-UP VOLID
	SKIPN Q1,T1		;WAS THERE A .VOLID ENTRY?
	JRST KBADM		;NO, BAD NEWS

; CHECK IF TAPE DRIVE SPECIFIED

	SETZ MTA,		;ASSUME NO DRIVE SPECIFIED
	MOVEI T1,.TAPDV
	CALL ORNBLF		;TAPE DRIVE SPECIFIED?
	 JRST KSWI1		;NO
	CALL STMTA		;YES, LOAD MTA AC FOR THIS DRIVE
	 JRST KBADM		;BAD DRIVE NAME FROM QUASAR
	LOAD T1,MTMTA		;GET CURRENT DRIVE
	CAMN T1,MTA		;SWITCHING TO SAME DRIVE?
	JRST [	MOVEI T3,[ASCIZ/Cannot SWITCH To Same Drive/] ;YES
		CALLRET BTACK]
	MOVE T1,Q1		;GET VOLID
	SETZ T2,		;NOT SETTING SCRATCH
	CALL KVAC		;CHECK IF I CAN USE THIS MTA
	 RET			;NO, ERROR MSG SENT
	LOAD T1,MTALT
	CAIE T1,.LTUNL		;UNLABELED TAPE?
	JRST [	TMCT <%I%M Does Not Contain An Unlabeled Tape>
		MOVEI T3,TMCMSG
		CALLRET BTACK]	;TELL OPERATOR
KSWI1:

; COMMAND HAS BEEN VALIDATED, NOW PERFORM SPECIFIED TASKS

	CALL GMTDD		;GET MT DEVICE DESIGNATOR IN T1
	LDB T2,[POINT 9,T1,35]	;GET MT UNIT# IN T2
	MOVEI T1,.MTCVV		;FUNCTION CODE = CLEAR VOLUME-VALID
	MTU%			;YANK MT AND MTA APART IN MONITOR
	 ERJMP [MOVE T1,RSBITN(RSB) ;CAN'T DO IT, GET REQUEST #
		TMCT <%ICannot SWITCH - Request %1D Has Tape Drive Open>
		MOVEI T3,TMCMSG
		CALLRET BTACK]	;TELL OPR THE BAD NEWS
	MOVX T1,TM%NUL
	MOVE Q2,RSBUFL(RSB)	;GET CURRENT SETTING OF UNLOAD FLAG
	AND Q2,T1		;EXTRACT TM%NUL FLAG
	ANDCAM T1,RSBUFL(RSB)	;MAKE SURE TAPE GETS UNLOADED
	CALL PLDISA		;DISASSOCIATE MT&MTA IN MY TABLES
	IORM Q2,RSBUFL(RSB)	;RESTORE USER SETTING OF TM%NUL
	LOAD T1,RSBCV		;GET CURRENT VOLUME #
	MOVE T2,Q1		;GET VOLID
	CALL VQSET		;SET NEW VOLID IN USER REQUEST
	 CALL STOP		;VOLID LIST SCREWED UP
	JUMPE MTA,[CALLRET VOLMNT] ;NO MTA SPECIFIED, REQUEST TAPE MOUNT

; TRY TO ASSOCIATE SPECIFIED DRIVE WITH USER REQUEST

	MOVEI T1,RST.WM
	STOR T1,RSBSTE		;SET REQUEST WAITING FOR MOUNT
	EXCH Q1,MTAVOL(MTA)	;SET NEW VOLID
	CALL VRA		;TRY TO ASSOCIATE REQUEST WITH DRIVE
	 SKIPA			;NO GO
	RET			;ASSOCIATION DONE, EXIT
	MOVEM Q1,MTAVOL(MTA)	;RESTORE OLD VOLID
	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES
	CALLRET VOLMNT		;NO, ASK FOR VOLUME
; KTXCT - IMPLEMENTS EXECUTION OF MTA FUNCTION FOR ONE OR ALL TAPE
;	  DRIVES, ACCORDING TO PRESENCE OF .TAPDV AND .ALTAP BLOCKS
;  T1/ ADDRESS OF COROUTINE TO BE CALLED; COROUTINE RECEIVES MTA
;      STATUS BLOCK ADDRESS IN MTA AC, AND RETURNS +1 ALWAYS
; RETURNS +1: ERROR IN COMMAND MESSAGE
;	  +2: SUCCESS

KTXCT:	SAVEAC <MTA>
	SAVEQ
	MOVE Q2,T1		;SAVE COROUTINE ADDRESS
	MOVEI T1,.ALTAP
	CALL ORNBLF		;LOOKUP ALL-TAPES BLOCK
	 TDZA MTA,MTA		;NOT THERE, CLEAR MTA
	MOVEI MTA,MTA0		;ALL TAPES, POINT AT MTA0 STATUS BLOCK
	MOVEI T1,.TAPDV
	CALL ORNBLF		;LOOKUP SPECIFIC-TAPE-DRIVE BLOCK
	 JRST [	JUMPE MTA,R	;NO TAPE INFO SPECIFIED, BAD MESSAGE
		MOVE Q1,MTAN	;ALL DRIVES, GET # OF DRIVES
		JRST KTXCT1]	;GO DO THEM
	JUMPN MTA,R		;CAN'T HAVE BOTH!
	CALL STMTA		;GET MTA STATUS BLK ADDR FROM STRING
	 RET			;STRING DOESN'T SPECIFY MTA DEVICE
	MOVEI Q1,1		;DOING 1 DRIVE
KTXCT1:	CALL (Q2)		;CALL COROUTINE
	ADDI MTA,MTASZ		;POINT AT NEXT MTA STATUS BLOCK
	SOJG Q1,KTXCT1		;LOOP THRU SPECIFIED # OF DRIVES
	RETSKP
; KUNL - PROCESS UNLOAD COMMAND FROM OPR
; RETURNS +1: ALWAYS

KUNL:	SAVEQ
	SAVEAC <MTA>
	MOVEI T1,.TAPDV
	CALL ORNBLF		;TAPE DRIVE SPECIFIED?
	 JRST KBADM		;NO, REJECT MESSAGE
	JXE F,TALCF,KNALC	;REJECT IF ALLOCATION IS NOT ENABLED
	CALL STMTA		;CONVERT STRING TO MTA STATUS BLK ADDR
	 JRST KBADM		;ERROR, BAD MESSAGE
	MOVE Q1,MTAFLG(MTA)	;GET FLAGS
	CALL KCAVL		;DRIVE AVAILABLE TO USERS?
	 RET			;NO
	JN MTAMT,,[CALL KCUSE	;GIVE ERROR IF A USER HAS THE DRIVE
		 JFCL		;SHOULD ALWAYS RETURN +1
		RET]
	JN MTAJCT,,[SETONE MA%ULP,MTAFLG(MTA) ;IN USE BY ME, SET UNLOAD
		JRST KUNL1]	; PENDING
	CALL UNLOAD		;NOT IN USE BY ME, UNLOAD IT
KUNL1:	TXNN Q1,MA%LOD		;DID I THINK IT WAS LOADED?
	SETZM MTAVOL(MTA)	;NO, SUPPRESS VOLID IN UNLOAD MESSAGE
	CALLRET WOUNL		;TELL OPERATORS IT'S UNLOADED
; KVAC - CHECK IF LEGAL FOR OPERATOR TO CHANGE VOLUME ATTRIBUTES
;  T1/ 0 IF NOT CHANGING VOLID, NON-ZERO IF CHANGING VOLID
;  T2/ 0 IF NOT SETTING SCRATCH, NON-ZERO IF SETTING SCRATCH
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: FUNCTION ILLEGAL, ERRROR MESSAGE SENT TO OPERATOR
;	  +2: FUNCTION IS LEGAL

KVAC:	SAVEQ
	DMOVE Q1,T1		;COPY ARGS TO A SAFE PLACE
	CALL KCAVL		;DRIVE MUST BE AVAILABLE TO USERS
	 RET
	CALL KCLOAD		;DRIVE MUST BE LOADED
	 RET
	CALL KCUSE		;DRIVE MUST NOT BE IN USE
	 RET
	LOAD Q3,MTALT		;GET LABEL TYPE
	JUMPN Q1,[JUMPE Q3,.+1	;VOLID OK IF AVR NOT PERFORMED YET
		CAIN Q3,.LTUNL	;WHAT KIND OF TAPE?
		JRST .+1	;UNLABELED, VOLID OK HERE
		JSP T1,KVAX	;CAN'T SPECIFY VOLID FOR LABELED TAPE
		ASCIZ/Cannot Change Volid Of Labeled Tape/]
	JUMPE Q2,RSKP		;OK IF NOT SETTING SCRATCH
	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	JXN T1,MA%UXV,[JSP T1,KVAX ;CAN'T SCRATCH AN UNEXPIRED VOLUME
		ASCIZ/Cannot Scratch - Volume Is Not Expired/]
	JXE T1,MA%WEN,[JSP T1,KVAX ;CAN'T SCRATCH A WRITE-PROTECTED VOL
		ASCIZ/Cannot Scratch - Drive Is Write-Protected/]
	JUMPE Q3,[JSP T1,KVAX	;CAN'T SCRATCH UNTIL I'VE DONE AVR
		ASCIZ/Cannot Scratch - AVR Not Enabled/]
	RETSKP

; ERROR DETECTED, T1/ ADDR OF ERROR TEXT

KVAX:	TMCT <%I%M %1A>
	MOVEI T3,TMCMSG		;GET ADDRESS OF MESSAGE
	CALLRET BTACK		;SEND ERROR MESSAGE AND RETURN +1
; KVI - SUPPORT VOLUME INITIALIZATION UNDER OPR CONTROL
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RBUF/ "SET TAPE-DRIVE INIT" MESSAGE FROM OPR
; RETURNS +1: ALWAYS

KVI:	JE MA%AVS,MTAFLG(MTA),[LOAD T1,MTADRV
		MOVE T1,DRVTXT(T1)
		TMCT <%ICommand Illegal For %1A Drives>
		MOVEI T3,TMCMSG
		CALLRET BTACK]	;BLAST THE OPERATOR
	CALL KCAVL		;DRIVE IN S.AV STATE?
	 RET			;NO, CAN'T DO THIS
	CALL KCUSE		;DRIVE IN USE?
	 RET			;YES, ERROR
	CALL GORSB		;GET RSB FOR INITIALIZATION
	 RET			;RSB POOL EXHAUSTED, MESSAGE TYPED
	MOVEI T1,.MNTTP
	STOR T1,RSBTYP		;SET RSB TYPE = TAPE-MOUNT
	MOVEI T1,RST.AC
	STOR T1,RSBSTE		;SET RSB ACTIVE
	CALL KVIRSB		;BUILD RSB FROM USER PARAMETERS
	 RET			;ERROR, RSB ABORTED, MESSAGE SENT TO OPR
	MOVEI T1,S.INIT
	STOR T1,MTASTE		;PUT TAPE DRIVE IN PROPER STATE
	MOVEI MT,RSBIMT(RSB)	;GET PSEUDO-MT STATUS BLOCK ADDRESS
	STOR RSB,MTRSB		;LINK MT TO RSB
	STOR MT,RSBMT		;LINK RSB TO MT
	STOR MTA,MTMTA		;LINK MT TO MTA
	STOR MT,MTAMT		;LINK MTA TO MT

; GET VOLID OF VOLUME TO BE INITIALIZED

KVI0:	LOAD T1,RSBLT
	CAIE T1,.LTUNL		;UNLABELED?
	SKIPE RSBIVL(RSB)	;OR DO I KNOW THE VOLID?
	JRST KVI2A		;YES TO EITHER, PROCEED
KVI1:	JSP T1,KVIMR1		;NO, HAVE TO ASK OPERATOR
	MOVEI RSB,-RSBWTB(T2)	;GET RSB ADDRESS
	LOAD MT,RSBMT
	LOAD MTA,MTMTA		;GET MTA STATUS BLOCK ADDR
	CALL PINI		;PARSE RESPONSE
	 JRST KVI1		;ERROR, TRY IT AGAIN JACK
KVI2:	MOVEM T1,RSBIVL(RSB)	;REMEMBER VOLID

; MAKE SURE DRIVE IS READY, DO AVR IF NEEDED

KVI2A:	JN MTAJCT,,R		;WAIT IF AVR OR REWIND IN PROGRESS
	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	JXE T1,MA%LOD,KVIM1	;IF TAPE NOT UP, SAY SO
	TXNE T1,MA%AVE		;WANT TO CHECK IF EXPIRED?
	JRST [	JE MTALT,,[CALLRET AVR] ;YES, DO AVR IF NOT DONE YET
		JXE T1,MA%UXV,.+1 ;AVR DONE, OK IF EXPIRED
		CALL KVIM4	;TELL OPERATOR IT'S NOT EXPIRED
		CALL UNLOAD	;UNLOAD IT
		JRST KVIM1]	;ASK HIM TO DO IT AGAIN
	CALL MTAGJF		;LOCK UP THE DRIVE
	MOVEI T1,KVI2B		;GET REWIND END-ACTION ADDRESS
	CALL REWEA		;REWIND
	 JRST KVI2B		;FAILED, MA%LOD CLEARED
	RET			;EXIT UNTIL REWIND COMPLETES

; REWIND END-ACTION

KVI2B:	CALL MTARJF		;RELEASE LOCK
	LOAD MT,MTAMT
	LOAD RSB,MTRSB		;RESTORE RSB ADDRESS
	JE MA%LOD,MTAFLG(MTA),KVIM1 ;ASK FOR TAPE IF NOT LOADED
; WRITE LABELS TO TAPE

	MOVE T1,RSBIVL(RSB)	;GET VOLID
	MOVEM T1,MTAVOL(MTA)	;STUFF IT FOR LTINIT
	SETONE R%WVL,RSBIFL(RSB) ;REQUEST LTINIT TO WRITE LABELS
	CALL LTINIT		;WRITE LABELS TO TAPE
	 JRST KVIM1		;ERROR, TELL OPERATOR TO MOUNT AGAIN
	CALL KVIM2		;TELL OPERATOR WHAT HAPPENED
	MOVX T1,TM%NUL
	TDNN T1,RSBUFL(RSB)	;UNLOAD REQUESTED?
	CALL UNLOAD		;YES, DO IT

; CHECK IF MORE INITIALIZATIONS LEFT TO DO

	SOSG RSBICT(RSB)	;ANY TAPES LEFT TO DO?
	JRST [	CALL KVICU	;NO, CLEAR INITIALIZE STUFF
		 CALL STOP
		CALLRET KVIDAV]	;GET BACK TO AVAILABLE STATE
	SETZM RSBIVL(RSB)	;YES, CLEAR VOLID
	SKIPN T1,RSBIVI(RSB)	;DOING NUMERIC VOLIDS?
	JRST KVI0		;NO, MUST ASK FOR NEXT VOLID
	ADD T1,RSBIVN(RSB)	;YES, STEP TO NEXT VOLID
	MOVEM T1,RSBIVN(RSB)	;RESTORE NUMERIC VOLID
	CALL INT26L		;Convert to sixbit
	JRST KVI2		;GO GET IT MOUNTED

; KVICU - PROCESS REQUEST TO CANCEL INITIALIZATION SERIES
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DRIVE BUSY, OPERATOR TOLD ABOUT FAILURE
;	  +2: SUCCESS, TAPE DRIVE INITIALIZE STATE IS CLEARED

KVICU:	SAVEAC <MT,RSB>
	LOAD MT,MTAMT
	LOAD RSB,MTRSB		;GET RSB ADDRESS
	JN MTAJCT,,[JSP T1,KC1	;ERROR IF DRIVE BUSY
		ASCIZ/Busy/]
	SETZRO MTAMT		;CLEAR MTA LINK TO MT
	SETZRO RSBMT		;CLEAR RSB LINK TO MT
	SETZRO MA%LOD,MTAFLG(MTA) ;CLEAR DRIVE-LOADED
	ABTREQ (ABRTNR)		;DUMP THE RSB
	RETSKP

; KVIDAV - EXIT FROM INITIALIZE MODE TO AVAILABLE MODE

KVIDAV:	MOVEI T1,S.AV
	STOR T1,MTASTE		;SET STATE BACK TO AVAILABLE
	CALL AVRENA		;ENABLE AVR IF POSSIBLE
	CALL KVIM3		;TELL OPERATOR THE DRIVE IS AVAIL
	CALLRET TDSC1		;GO CHECK IF DRIVE OCCUPIEDPIPER

; KVITAV - REPORT TAPE DRIVE COMING ONLINE OR AVR COMPLETED
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

KVITAV:	SAVEAC <MT,RSB>
	LOAD MT,MTAMT
	LOAD RSB,MTRSB		;GET RSB ADDRESS
	JE MA%WEN,MTAFLG(MTA),[CALL UNLOAD ;WRITE-PROTECTED
		TMCT <%I%M Write Protected, Unloading Volume>
		MOVEI T3,TMCMSG	;GET ADDRESS OF TEXT
		CALLRET BTWTON]	;TELL OPERATOR THE BAD NEWS
	SKIPE RSBWTB+WTBCOD(RSB) ;WTOR OUTSTANDING?
	RET			;YES, WAIT TILL IT COMES BACK
	JN MA%LOD,MTAFLG(MTA),KVI0 ;IF TAPE IS READY, GET THINGS MOVING
	RET			;OTHERWISE, STILL HAVE TO WAIT

; KVIM1 - TELL OPERATOR TO MOUNT TAPE TO BE INITIALIZED

KVIM1:	TMCT <%IMount tape>
	SKIPE T1,RSBIVL(RSB)	;KNOW VOLID?
	JRST [	TMCT < volume %1S> ;YES
		JRST .+1]
	TMCT < for initialization on %M>
	MOVEI T3,[ASCIZ/Mount Tape To Be Initialized/]
	CALLRET BTWTO		;SEND MESSAGE TO OPERATOR

; KVIM2 - TELL OPERATOR TAPE WAS INITIALIZED SUCCESSFULLY

KVIM2:	TMCT <%I%M>		;DISPLAY DRIVE NAME
	LOAD T1,RSBLT
	CAIN T1,.LTUNL		;UNLABELED TAPE?
	JRST [	TMCT < Unlabeled Tape> ;YES, SAY SO
		JRST .+2]	;DON'T TYPE VOLID
	CALL TMCVOL		;DISPLAY VOLID
	TMCT < Initialized>
	CALL CPYHDR		;COPY HEADER TO A SAFE PLACE
	LOAD T1,RSBLT		;GET LABEL TYPE
	MOVE T1,LTTXT(T1)	;GET POINTER TO TEXT
	LOAD T2,RSBDEN
	MOVE T2,DENTAB(T2)	;GET DENSITY
	TMCT <%ILabel type: %1A%25CDensity: %2D>
	LOAD T1,RSBLT
	CAIE T1,.LTT20		;TOPS-20 TAPE?
	JRST KVIM21		;NO
	TMCT <
Owner: >			;YES, MORE INFO
	SKIPN T2,RSBUNO(RSB)	;GET OWNER USER #
	JRST [	TMCT <Scratch>	;IF ZERO, IT'S A SCRATCH TAPE
		JRST KVIM21]
	TMCT <%2U%23C  Protection: >
	MOVE T1,TMCPTR
	LOAD T2,RSBVPR		;GET PROTECTION CODE
	MOVE T3,[NO%LFL+NO%ZRO+FLD(6,NO%COL)+10]
	NOUT			;INSTALL IT
	 SKIPA
	MOVEM T1,TMCPTR		;RESTORE UPDATED POINTER
	CALL TMC1		;STANDARD TMC CLEANUP
KVIM21:	MOVEI T3,OPRHDR		;GET ADDRESS OF MESSAGE TYPE TEXT
	CALLRET BTWTO		;TELL OPERATORS WHAT HAPPENED

; KVIM3 - TELL OPERATOR DRIVE IS NO LONGER INITIALIZING

KVIM3:	TMCT <%I%M available for user tape requests>
	MOVEI T3,[ASCIZ/INITIALIZE Completed/]
	CALLRET BTWTO

; KVIM4 - TELL OPERATOR TAPE I CAN'T INITIALIZE - TAPE IS NOT EXPIRED

KVIM4:	TMCT <%I>
	CALL TMCVOL		;DISPLAY VOLID
	TMCT < on drive %M is not expired, unloading>
	MOVEI T3,[ASCIZ/Tape Volume Not Expired/]
	CALLRET BTWTO

; KVIMR1 - ISSUE WTOR TO ASK OPERATOR FOR VOLID TO BE INITIALIZED

KVIMR1:	STAKT
	TMCT <%IWhat is the volume-id of the next tape to be
initialized on drive %M ?
Respond with:
  RESPOND n volid>
	MOVE T1,CT1		;GET END-ACTION ADDRESS
	MOVEI T2,RSBWTB(RSB)	;GET WTB ADDRESS
	MOVEI T3,[ASCIZ/Key In Volume Identifier/]
	CALLRET BTWTOR
; KVIRSB - SCAN "SET TAPE INITIALIZE" IPCF MESSAGE FROM OPR AND
;	   BUILD REQUEST STATUS BLOCK
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR DETECTED, OPERATOR NOTIFIED, RSB ABORTED
;	  +2: SUCCESS, INFORMATION STORED IN RSB

KVIRSB:	CALL KGTVOL		;GET VOLID
	 JRST KVIABT		;ERROR, MESSAGE SENT
	MOVEM T1,RSBIVL(RSB)	;STORE VOLID OR 0 IF NONE
	MOVE T1,RSBIVN(RSB)	;Get the integer volume i.d.
	JUMPL T1,KVIR2		;Don't increment if not an integer
	CALL INT26L		;convert to sixbit
	MOVEM T1,RSBIVL(RSB)	;set sixbit volid too
	MOVEI T1,.SIINC		;code for numeric volid increment
	SETZ T2,		;no limit
	MOVEI T3,1		;default = 1
	CALL KGBLK		;lookup increment
	 JRST KVIBM		;error
	MOVEM T1,RSBIVI(RSB)	;store increment
KVIR2:				;
	MOVEI T1,.SILBT		;CODE FOR LABEL TYPE
	MOVEI T2,.LTMAX		;LIMIT
	MOVEI T3,.LTT20		;DEFAULT
	CALL KGBLK		;LOOKUP LABEL TYPE
	 JRST KVIBM		;ERROR
	STOR T1,RSBLT		;STORE LABEL TYPE

	MOVEI T1,.SIDEN		;CODE FOR DENSITY
	MOVEI T2,DENMAX		;LIMIT
	MOVE T3,DEFDEN		;DEFAULT
	CALL KGBLK		;LOOKUP DENSITY
	 JRST KVIBM		;ERROR
	STOR T1,RSBDEN		;STORE DENSITY
	CALL DRVDEN		;CAN THE DRIVE OPERATE AT THIS DENSITY?
	 JRST [	LOAD T1,RSBDEN	;NO
		MOVE T1,DENTAB(T1) ;GET NUMERIC DENSITY
		TMCT <%I%1D BPI Is Not Supported On %M>
		MOVEI T3,TMCMSG	;GET MESSAGE ADDRESS
		CALL BTACK	;SEND ERROR MESSAGE
		JRST KVIABT]	;ABORT REQUEST

	MOVEI T1,.SICTR		;CODE FOR COUNT BLOCK
	HRLOI T2,377777		;LIMIT
	MOVEI T3,1		;DEFAULT
	CALL KGBLK		;LOOKUP COUNT
	 JRST KVIBM		;ERROR
	MOVEM T1,RSBICT(RSB)	;STORE COUNT
	MOVEI T1,.SIHLD		;REQUESTED TO KEEP TAPE ON DRIVE?
	CALL ORNBLF
	 SKIPA			;NO
	JRST [	MOVE T1,RSBICT(RSB) ;YES, GET COUNT
		MOVX T2,TM%NUL
		CAIN T1,1	;INITIALIZING 1 TAPE?
		IORM T2,RSBUFL(RSB) ;YES, OK TO KEEP ON DRIVE
		JRST .+1]

	MOVEI T1,.SIOWN		;CODE FOR OWNER-ID
	SETZB T2,T3		;NO LIMIT, DEFAULT = 0 (SCRATCH)
	CALL KGBLK		;LOOK OWNER-ID
	 JRST KVIBM		;ERROR
	MOVEM T1,RSBUNO(RSB)	;STORE OWNER-ID

	MOVEI T1,.SIPRO		;CODE FOR PROTECTION
	SETZ T2,		;NO LIMIT
	MOVEI T3,DEFPRO		;DEFAULT 
	CALL KGBLK		;LOOKUP PROTECTION
	 JRST KVIBM		;ERROR
	STOR T1,RSBVPR		;STORE PROTECTION

	MOVEI T1,.SIOVR		;OVERRIDE EXPIRATION-DATE CHECK?
	CALL ORNBLF
	 SKIPA T1,[1]		;NO
	SETZ T1,		;YES
	STOR T1,MA%AVE,MTAFLG(MTA) ;STORE OVERRIDE FLAG

	RETSKP

; ERROR CONDITIONS

KVIBM:	CALL BADQM		;ERROR IN IPCF MESSAGE FROM QUASAR
KVIABT:	ABTRET (ABRTNR)		;ABORT RSB AND RETURN +1
; ERROR HANDLERS FOR UNSOLICITED OPERATOR KEYINS ("K" ROUTINES)
; RET IS DONE THROUGH BTACK, GIVING ERROR MESSAGE TO OFFENDING OPR

KBADM:	MOVE T1,RBUF+.MSFLG	;[6011]Get flag
	TXNE T1,MF.NEB		;[6011]Is this from NEBULA?
	CALLRET BADNM		;[6011]Yes
	CALLRET BADQM		;ERROR IN MESSAGE RECEIVED FROM QUASAR


KNXREQ:	MOVEI T2,[ASCIZ/Does Not Exist/]
KACKRQ:	TMCT <%IMount Request %1D %2A> ;T1/ REQ#, T2/ ADDRESS OF TEXT
	MOVEI T3,TMCMSG
	CALLRET BTACK		;SEND IT OFF TO OPERATOR

KBADV:	MOVEI T3,[ASCIZ/Illegal Volume Identifier/]
	CALLRET BTACK

KNALC:	TMCT <%I>		;Clear message buffer 
	MOVEI T3,[ASCIZ/Tape drive allocation is not enabled/]
	CALLRET BTACK

;REJECT IDENTIFY KEYIN TO SCRATCH A TAPE

KNOSCR:	STKVAR <<OWNER,10>>
	TMCT <%ICannot Scratch %M> ;BUILD HEADING WITH DRIVE NAME
	CALL CPYHDR		;SAVE MESSAGE HEADING
	MOVEI T1,OWNER		;OWNER'S NAME GOES HERE
	CALL GETVU		;GET POINTER TO OWNER'S NAME IN T1
	MOVE T2,MTAVOL(MTA)	;GET VOLID
	TMCT <%IVolume %2S owned by user %1A>
	MOVEI T3,OPRHDR		;POINT TO HEADING
	CALLRET BTACKT		;TELL OPERATOR I REJECTED IT
; ORNBCK - CHECK BUILDING BLOCK STRUCTURE OF ORION-STYLE IPCF MESSAGE
;	   IN RBUF (ASSUMES CKGHDR HAS BEEN CALLED)
; RETURNS +1: ERROR IN BLOCK STRUCTURE
;	  +2: BLOCK STRUCTURE OK

ORNBCK:	MOVE T1,RBUF+.OARGC	;GET # OF ARGS
	MOVEI T2,RBUF+.OHDRS	;GET ADDRESS OF 1ST ARG
	LOAD T3,MS.CNT,RBUF+.MSTYP ;GET SIZE OF IPCF MESSAGE FROM HEADER
	SUBI T3,.OHDRS		;COMPUTE SIZE OF BUILDING BLOCK AREA
	CALLRET CKBSTR		;CHECK BLOCK STRUCTURE


; ORNBLF - FIND ARGUMENT BLOCK IN ORION-STYLE IPCF MESSAGE
;  T1/ TYPE CODE OF DESIRED ARGUMENT
; RETURNS +1: NO ARGUMENTS OF REQUESTED TYPE FOUND
;	  +2: SUCCESS, T1/ ADDRESS OF FIRST WORD OF ARGUMENT
;		       T2/ LENGTH OF ARGUMENT (NOT COUNTING HEADER)

ORNBLF:	MOVE T3,T1		;COPY ARG TYPE TO T3 FOR BLKFND
	MOVEI T1,RBUF+.OARGC	;GET ADDRESS OF ARG COUNT WORD
	MOVEI T2,RBUF+.OHDRS	;GET ADDRESS OF 1ST BLOCK
	CALLRET BLKFND		;CALL BLKFND TO DO LOOKUP


; ORNINI - ESTABLISH IPCF RAPPORT WITH ORION
; RETURNS +1: ALWAYS

ORNINI:	STKVAR <TSTFLG>		;FLAG USED ONLY FOR DEBUGGING
	SETOM TSTFLG		;INITIALIZE FLAG
ORNIN1:	MOVEI T1,.SPOPR
	CALL GSYSPD		;GET ORION'S PID FROM SYSTEM PID TABLE
	 JRST [	AOSN TSTFLG	;HAVE WE BEEN HERE BEFORE?
		CALL TSTWAT	;NO, INFORM USER WE ARE WAITING
		MOVEI T1,^D5000	;NOT THERE YET
		DISMS		;WAIT 5 SECONDS
		JRST ORNIN1]	; AND TRY AGAIN
	MOVEM T1,APPID+.APORN	;STUFF PID IN A/P TABLE
	GTAD			;GET FAIRLY UNIQUE VALUE IN RH(T1)
	HRLM T1,UNIQUE		;INSURE CODES UNIQUE TO SYSTEM STARTUP
	RET

; TSTWAT - INFORMS USER WHO WE ARE WAITING FOR IF DEBUGGING
; REQUIRES PONTER TO ASCII PID NAME IN T1
; RETURNS +1: ALWAYS

TSTWAT:	SKIPN TSTF		;ARE WE DEBUGGING
	 RET			;NO
	PUSH P,T1		;SAVE POINTER
	TMSG <% MOUNTR Waiting for >
	POP P,T1		;POINTER TO PID NAME STRING
	PSOUT			;TYPE IT TO TERMINAL
	TMSG <
>
	RET			;RETURN
; ORNMRC - PROCESS INCOMING IPCF MESSAGE FROM ORION
;  RBUF/ INCOMING IPCF MESSAGE
;  MRPDB/ PDB THAT WAS USED TO RECEIVE THE MESSAGE
; RETURNS +1: ALWAYS

ORNMRC:	CALL CKGHDR		;GALAXY HEADER OK?
	 JRST [	CALLRET BADOM]	;NO
	CALL ORNBCK		;BLOCK STRUCTURE OK?
	 JRST [	CALLRET BADOM]	;NO
	LOAD T1,MS.TYP,RBUF+.MSTYP ;GET MESSAGE TYPE
	CAIN T1,.OMRSP		;WHAT TYPE?
	JRST [	CALLRET INWTOR]	;RESPONSE TO WTOR
	CAIN T1,.NRDAK		;[6011]What type?
	JRST [CALLRET PNEDAC]	;[6011]Remote dismount ACK
	LOAD T2,MF.SUF,RBUF+.MSFLG ;GET SIXBIT SUFFIX
	CAIN T1,MT.TXT		;TEXT MESSAGE?
	JRST [	CAIE T2,'NMC'	;CHECK FOR - NO MESSAGE WITH THIS CODE
		CAIN T2,'ODE'	;CHECK FOR - OPR DOESN'T EXIST
		RET		;IGNORE THIS ERROR
		JRST .+1]	;CAN'T HANDLE THIS TEXT MESSAGE
	CALLRET BADOM		;BAD TEXT MESSAGE, REPORT IT
; PINI - PARSE OPERATOR RESPONSE TO REQUEST FOR VOLID TO BE INIT'ED
;  T1/ ADDRESS OF ASCIZ OPERATOR RESPONSE TEXT
; RETURNS +1: ERROR, MESSAGE SENT TO OPERATOR
;	  +2: SUCCESS, T1/ SIXBIT VOLID

PINI:	SAVET			;SETUP TO RETURN VALUE IN T1
	CALL COMNDI
	CALL COMNDV		;PARSE VOLID
	 RET			;FAILED
	MOVEM T1,CT1		;RETURN VOLID TO CALLER
	CALLRET CMDCFM		;GET CONFIRMATION AND RETURN

; PMR - PARSE OPERATOR RESPONSE TO WTOR ASKING FOR VOLID LIST
;  T1/ ADDRESS OF ASCIZ OPERATOR RESPONSE TEXT
;  RSB/ ADDRESS OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR DETECTED WHILE PARSING RESPONSE, OPERATOR NOTIFIED
;	  +2: SUCCESSFUL PARSE
;	      T1/ 0 - RSB AND VOLID LIST SET UP
;	      T1/ 1 - REQUEST ABORTED

PMR:	CALL COMNDI		;INITIALIZE FOR COMND JSYS
	MOVEI T2,[FLDDB.(.CMKEY,,PMRT1)] ;SET UP FOR KEYWORD PARSE
	CALL COMNDX		;ISSUE COMND JSYS TO DO PARSE
	 JRST [	MOVEI T3,[ASCIZ/Syntactical Error In Response/]
		CALLRET BTACK]	;HE BLEW THE KEYWORD
	HRRZ T2,(T2)		;GET ADDRESS OF KEYWORD PROCESSOR
	CALLRET (T2)		;DISPATCH TO KEYWORD PROCESSOR

PMRT1:	PMRT1L,,PMRT1L		;KEYWORD TABLE
	[ASCIZ/REFUSE/],,PMRREF	;REFUSE reason
	[ASCIZ/VOLUMES/],,PMRVOL ;VOLUMES volid,...,volid
PMRT1L==.-PMRT1-1

PMRREF:	CALL PREFUS		;PARSE REFUSAL
	 RET			;OPERATOR ERROR
	ABTREQ (MREQ16,ABT%OP)	;ABORT REQUEST
	MOVEI T1,1		;SET T1 TO INDICATE ABORTION
	RETSKP


; PREFUS - COMPLETE PARSING OF REFUSAL BY OPERATOR
; RETURNS +1: ERROR, OPERATOR NOTIFIED
;	  +2: SUCCESSFUL PARSE, ATMBFR/ ASCIZ REASON GIVEN BY OPERATOR

PREFUS:	MOVEI T2,[FLDDB. .CMTXT] ;PARSE TEXT OUT TO CARRIAGE RETURN
	CALL COMNDX
	 JRST PREFU1		;ERROR
	LDB T1,[POINT 7,ATMBFR,6] ;WAS THERE A REASON GIVEN?
	JUMPN T1,RSKP		;YES, TAKE GOOD RETURN
PREFU1:	JSP T1,RSPERR		;ERROR, TELL OPERATOR
	ASCIZ/No reason given/
; PMRVOL - PARSE VOLID LIST FROM OPERATOR
;  RSB/ ADDRESS OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR, T1/ ADDRESS OF ASCIZ ERROR MESSAGE FOR OPERATOR
;	  +2: T1/ 0 - RSB AND VOLID LIST SET UP
;	      T1/ 1 - REQUEST ABORTED

PMRVOL:	CALL VQDEL		;DELETE VOLID LIST (IF ANY)
	MOVEI T1,1
	STOR T1,RSBCV		;SET CURRENT VOLUME # TO 1
PMRV1:	CALL COMNDV		;PARSE VOLID
	 RET			;FAILED
	CALL VQADD		;ADD VOLUME TO LIST
	 JRST [	MOVEI T1,1	;OUT OF TABLE SPACE
		RETSKP]
	MOVEI T2,[FLDDB.(.CMCMA,,,,,[FLDDB.(.CMCFM)])]
	CALL COMNDX		;PARSE COMMA OR CARRIAGE RETURN
	 JRST [	JSP T1,RSPERR	;PARSE FAILED
		ASCIZ/Syntactical error in volume-id list/]
	HRRZS T3		;GET ADDRESS OF ACTUAL FDB
	LOAD T3,CM%FNC,(T3)	;GET FUNCTION CODE FROM FDB
	CAIN T3,.CMCMA		;WHAT DID I JUST PARSE?
	JRST PMRV1		;COMMA, GO GET ANOTHER VOLID
	SETZ T1,		;CARRIAGE RETURN, CLEAR T1
	RETSKP
; PNVR - PARSE OPERATOR RESPONSE TO "KEYIN NEXT VOLID" WTOR
;  T1/ ADDR OF ASCIZ RESPONSE TEXT
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR, T1/ ADDRESS OF ASCIZ ERROR MESSAGE FOR OPERATOR
;	  +2: T1/ 0 - VOLID ADDED TO RSB VOLID LIST
;	      T1/ 1 - REQUEST ABORTED

PNVR:	CALL COMNDI		;SET UP FOR PARSING WITH COMND
	MOVEI T2,[FLDDB. .CMKEY,,PNVKT] ;GET FDB ADDRESS
	CALL COMNDX		;PARSE KEYWORD
	 JRST [	JSP T1,RSPERR	;ERROR
		ASCIZ/REFUSE or VOLUME keyword missing/]
	HRRZ T2,(T2)		;GET HANDLER ADDRESS
	CALLRET (T2)		;DISPATCH TO HANDLER

PNVKT:	PNVKTL,,PNVKTL		;KEYWORD TABLE
	[ASCIZ/REFUSE/],,PMRREF
	[ASCIZ/VOLUME/],,PNVVOL
PNVKTL==.-PNVKT-1

PNVVOL:	SAVEQ			;OPERATOR RESPONDED WITH A VOLID
	CALL COMNDV		;PARSE VOLID
	 RET			;FAILED
	MOVE Q1,T1		;SAVE VOLID
	CALL CMDCFM		;CHECK FOR EOL
	 RET			;NOT THERE
	MOVE T1,Q1		;GET VOLID
	CALL VQADD		;TACK IT ON TO THE END OF THE LIST
	 JRST [	MOVEI T1,1	;OUT OF TABLE SPACE
		RETSKP]
	SETZ T1,		;SET SUCCESSFUL COMPLETION
	RETSKP
; PSMR - PARSE OPERATOR RESPONSE TO STRUCTURE MOUNT WTOR MESSAGE
;  T1/ ADDRESS OF ASCIZ RESPONSE TEXT
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR DETECTED WHILE PARSING RESPONSE, OPERATOR NOTIFIED
;	  +2: SUCCESSFUL PARSE, REQUEST ABORTED
;	      ATMBFR/ ASCIZ REASON GIVEN BY OPERATOR

PSMR:	CALL COMNDI		;INIIALIZE FOR COMND JSYS
	MOVEI T2,[FLDDB.(.CMKEY,,PSMKT)] ;SET UP FOR KEYWORD PARSE
	CALL COMNDX		;PARSE KEYWORD
	 JRST [	JSP T1,RSPERR	;BAD KEYWORD, GIVE ERROR
		ASCIZ/Response must be of the form:
REFUSE reason/]
	MOVX T2,R%OPR
	TDNE T2,RSBIFL(RSB)	;IS THIS AN OPR REQUEST?
	RETSKP			;YES, FORGET REASON
	CALL PREFUS		;PARSE REMAINDER OF REFUSAL
	 RET			;OPERATOR ERROR
	ABTREQ (MREQ15,ABT%OP)	;OPERATOR REFUSED TO MOUNT VOLUME
	RETSKP

PSMKT:	PSMKTL,,PSMKTL
	[ASCIZ/REFUSE/],,0
PSMKTL==.-PSMKT-1
; RSPERR - TELL OPERATOR THAT THERE WAS AN ERROR IN HIS RESPONSE
;  T1/ ADDRESS OF ASCIZ ERROR MESSAGE
; RETURNS +1: ALWAYS

RSPERR::TMCT <%I%1A>
	MOVEI T3,[ASCIZ/Response Error/] ;GET MESSAGE TYPE
	CALLRET BTACKT		;SEND IT OFF TO THE OPERATOR


; WOASO - TELL OPERATOR A TAPE HAS BEEN GIVEN TO A USER
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

WOASO:	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%I%M Given To Request %1D>
	CALL CPYHDR		;COPY HEADER TO OPRHDR
	TMCT <%I>
	CALL TMCVOL		;DISPLAY VOLID
	TMCT < now in use by%_ %U>
	MOVE T1,RSBIFL(RSB)
	TXNN T1,R%ONR		;WAS OPERATOR TOLD TO MOUNT TAPE?
	CALL BTJOB		;NO, MAKE THIS A JOB MESSAGE
	MOVEI T3,OPRHDR		;POINT TO HEADING
	CALLRET BTWTO		;SHIP IT OFF TO THE OPERATOR


; WOCKSW - IF A SCRATCH VOLUME IS WRITE-PROTECTED, DISMOUNT IT AND
;	   GIVE AN ERROR MESSAGE TO THE OPERATOR
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: WRITE-PROTECTED SCRATCH VOLUME UNLOADED
;	  +2: TAPE WAS NOT A WRITE-PROTECTED SCRATCH

WOCKSW:	MOVE T1,MTAFLG(MTA)	;GET FLAGS
	TXNE T1,MA%SCR		;TAKE +2 IF NOT SCRATCH
	TXNE T1,MA%WEN		;TAKE +2 IF WRITE-ENABLED
	RETSKP
	TMCT <%IUnloading drive %M>
	SKIPE MTAVOL(MTA)	;DO I KNOW ITS VOLID?
	CALL TMCVOL		;YES, THROW IT IN THERE TOO
	TMCT <
Remount scratch tape with write ring>
	MOVEI T3,[ASCIZ/No Ring In Scratch Tape/]
	CALL BTWTO		;TELL OPERATOR
	CALLRET UNLOAD		;UNLOAD THE TAPE


; WODISA - TELL OPERATOR A USER HAS RELEASED A TAPE DRIVE
;  T1/ ADDR OF ASCIZ DISPOSITION TEXT
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WODISA:	STAKT
	TMCT <%I%M>
	SKIPN MTAVOL(MTA)	;TAPE HAVE A VOLID?
	JRST [	TMCT < Tape>	;NO
		JRST .+2]
	CALL TMCVOL		;DISPLAY VOLID
	MOVE T1,CT1		;GET ADDRESS OF CALLER'S TEXT
	TMCT < %1A>
	CALL BTJOB		;THIS IS A JOB MESSAGE
	MOVEI T3,[ASCIZ/Tape Drive Released By User/]
	CALLRET BTWTO		;SEND IT OFF

; WOUSGF - TELL OPERATOR THAT USAGE JSYS FAILED.
;
; RETURNS +1: ALWAYS

WOUSGF:	TMCT <%IAccount record not written. %U. Reason: %J>
	MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
	CALLRET BTWTO		;OUT TO OPERATOR

; WOLINF - TELL OPERATOR THAT I FAILED TO WRITE LABELS ON A TAPE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOLINF:	TMCT <%IError writing labels on %M>
	CALL TMCVOL		;DISPLAY VOLID
	MOVEI T3,[ASCIZ/Tape Error Writing Labels/]
	CALLRET BTWTO		;OUT TO OPERATOR


; WOLOCF - TELL OPERATOR THAT .MOLOC MTOPR FAILED
;  MTA/ ADDR OF MTA STATUS BLOCK
;  MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS

WOLOCF:	TMCT <%IFailed to associate %M with %N%_Reason: %J>
	MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
	CALLRET BTWTO		;OUT TO OPERATOR


; WOLRDX - TELL OPERATOR I COULDN'T READ ANYTHING FROM THE TAPE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOLRDX:	TMCT <%ITape on %M may be labeled at a density that
is not supported by this drive.
Tape has been unloaded.>
	MOVEI T3,[ASCIZ/Cannot Read Tape/]
	CALLRET BTWTO


; WORCAN - TELL OPERATOR A MOUNT REQUEST WAS CANCELED
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

WORCAN:	MOVE T1,RSBIFL(RSB)	;GET FLAGS
	TXNN T1,R%ONR		;DID THE OPERATOR SEE THE MESSAGE?
	RET			;NO, DON'T SAY ANYTHING WAS CANCELED
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%IMount Request # %1D Canceled>
	MOVEI T3,TMCMSG		;GET ADDRESS OF TEXT
	CALLRET BTWTON		;TELL ALL OPERATORS


; WOTDAV - TELL OPERATOR OF AVAILABILITY OF TAPE DRIVE FOR SYSTEM USE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOTDAV:	SAVEQ
	SAVEAC <MT,RSB>
	MOVEI Q1,1		;ASSUME AVAILABLE
	CALL CKMPAV		;IS IT AVAILABLE?
	 SETZ Q1,		;NO, SET NOT AVAILABLE
	TMCT <%I%M set >
	JUMPE Q1,[TMCT <un>
		JRST .+1]
	TMCT <available for assignment by MOUNTR>
	LOAD MT,MTAMT		;MT ASSOCIATED?
	JUMPN MT,[LOAD RSB,MTRSB ;YES, GET RSB ADDRESS
		TMCT <%_%%Drive is currently in use by %U>
		JRST .+1]
	MOVE T3,[[ASCIZ/Tape Drive Set Unavailable/]
		 [ASCIZ/Tape Drive Set Available/]](Q1) ;GET HEADER
	CALLRET BTWTO		;GET MESSAGE OUT TO OPERATOR


; WOTIMO - REPORT MTA DEVICE TIMEOUT TO THE OPERATOR
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOTIMO:	TMCT <%I%M operation timed out>
	MOVEI T3,[ASCIZ/Tape Drive Timed Out/]
	CALLRET BTWTO		;TELL THE OPERATOR


; WOTMD - TELL OPERATOR A TAPE HAS BEEN MOUNTED ON A DRIVE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOTMD:	MOVX T1,MA%VMG
	TDNE T1,MTAFLG(MTA)	;HAS THE OPERATOR BEEN TOLD ALREADY?
	RET			;YES, NO ACTION THEN
	IORM T1,MTAFLG(MTA)	;NO, SET MESSAGE-GIVEN
	TMCT <%I%M>
	SKIPE MTAVOL(MTA)	;DOES IT HAVE A VOLID?
	JRST [	CALL TMCVOL	;YES, DISPLAY IT
		TMCT <,>
		JRST .+1]
	LOAD T1,MTALT		;GET LABEL TYPE
	JUMPE T1,WOTMD1		;JUMP IF LT NOT KNOWN (AVR DISABLED)
	MOVE T2,LTTXT(T1)	;GET ADDRESS OF TEXT
	TMCT < %2A>		;SPEW OUT LABEL TYPE
	CAIE T1,.LTUNL		;IS IT LABELED?
	CALL [	TMCTR < labeled>] ;YES
WOTMD1:	TMCT < tape mounted>
	MOVEI T3,TMCMSG		;GET ADDRESS OF TEXT
	CALLRET BTWTON		;BUILD AND TRANSMIT WTO MESSAGE


; WOUNL  - TELL OPERATOR THAT A TAPE HAS BEEN UNLOADED
; WOUNLW - SAME AS WOUNL, EXCEPT WARNING MESSAGE IS GIVEN TOO
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOUNLW:	SKIPA T1,[BTWTO]	;DISPLAY WARNING
WOUNL:	MOVEI T1,BTWTON		;SUPPRESS WARNING
	STAKT
	TMCT <%I%M>		;DISPLAY DRIVE NAME
	SKIPE MTAVOL(MTA)	;DO I KNOW THE VOLID?
	CALL TMCVOL		;YES, DISPLAY IT
	TMCT < unloaded>
	CALL CPYHDR		;COPY HEADER TO OPRHDR
	TMCT <%I%%Use the DISMOUNT TAPE command to unload tape drives>
	MOVEI T3,OPRHDR		;GET ADDRESS OF HEADER
	MOVE T1,CT1		;GET ADDRESS OF ROUTINE TO CALL
	CALLRET (T1)		;OUT TO OPERATOR AND RETURN
; WOVMT - TELL OPERATOR A TAPE VOLUME MUST BE MOUNTED
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

WOVMT:	SAVEQ
	SAVEAC <MTA>
; IN THE EVENT THAT A USER IS REQUESTING A SPECIFIC VOLUME AND
; THAT VOLUME IS UNDERGOING AVR ON A TAPE DRIVE, WE WANT TO
; INHIBIT SENDING THE WTO TO REQUEST THE TAPE UNTIL THE AVR
; SEQUENCE COMPLETES.  THIS CODE CHECKS FOR THIS CONDITION.

	LOAD T1,RSBSTE		;GET REQUEST STATE
	MOVE T2,RSBIFL(RSB)	;GET FLAGS
	CAIN T1,RST.WM		;WAITING FOR MOUNT
	TXNE T2,R%ONR		; AND OPERATOR NOT TOLD YET?
	RET			;NOT BOTH, DON'T DO ANYTHING
	CALL VQGCV		;GET CURRENT VOLID
	JUMPE T1,WOV2		;SCRATCH
	MOVE T2,MTAN		;GET # OF MTA'S TO SCAN
	MOVEI MTA,MTA0-MTASZ	;START HERE
WOV1:	ADDI MTA,MTASZ		;POINT AT NEXT MTA
	SOJL T2,WOV2		;NONE LEFT, SEND MESSAGE
	LOAD T3,MTASTE		;GET DRIVE STATE
	CAIE T3,S.AV		;AVAILABLE TO USERS?
	JRST WOV1		;NO, SKIP IT
	JE MTAJCT,,WOV1		;SKIP IF AVR NOT IN PROGRESS
	CAMN T1,MTAVOL(MTA)	;DRIVE & REQUEST VOLIDS MATCH?
	RET			;YES, MESSAGE SUPPRESSED
	JRST WOV1		;NO, CONTINUE DRIVE SCAN

; MUST TELL THE OPERATOR TO MOUNT THE TAPE, START BUILDING MESSAGE

WOV2:	SETONE R%ONR,RSBIFL(RSB) ;SET OPERATOR-NOTIFIED
	CALL WTOCHK		;IS  WTO DISABLED
	RET			;YES
	MOVE T1,RSBITN(RSB)	;GET REQUEST #
	TMCT <%ITape Mount Request # %1D>
	CALL CPYHDR		;COPY HEADER TO OPRHDR

; BUILD THE BODY OF THE MESSAGE

	TMCT <%IMount >
	CALL TRESCK		;Are any tape drives set to available
	CALL [ TMCT <%INote: All tape drives are set unavailable
Mount >				;No, include in the mount request message
	       RET ]		;Return to in stream
	CALL VQGCV		;GET VOLID IN T1
	MOVE Q1,T1		;COPY VOLID TO SAFE PLACE
	LOAD T2,RSBLT		;LABEL TYPE KNOWN?
	JUMPN T2,[MOVEI T1,[ASCIZ/Labeled/] ;YES
		CAIE T2,.LTUNL
		SKIPE Q1
		MOVE T1,LTTXT(T2) ;UNLABELED OR NOT SCRATCH
		MOVX T2,TM%BYP
		TDNE T2,RSBUFL(RSB) ;BYPASS?
		MOVEI T1,[ASCIZ/BYPASS/] ;YES, SAY SO
		TMCT <%1A >	;DISPLAY LABEL TYPE
		JRST .+1]
	JUMPE Q1,[TMCT <scratch tape> ;SCRATCH TAPE, SAY SO
		JRST .+1]
	JUMPN Q1,[TMCT <volume %5S> ;DISPLAY SPECIFIC VOLUME
		JRST .+1]
	LOAD Q1,RSBDRV		;DRIVE TYPE KNOWN?
	JUMPN Q1,[MOVE T1,DRVTXT(Q1) ;GET POINTER TO DRIVE TEXT
		TMCT <, %1A>	;DISPLAY DRIVE TYPE
		JRST .+1]
	LOAD Q1,RSBDEN		;DENSITY KNOWN?
	JUMPN Q1,[MOVE T1,DENTAB(Q1) ;YES, GET DENSITY
		TMCT <, %1D BPI>
		JRST .+1]
	MOVEI T1,[ASCIZ/, READ-ONLY/] ;ASSUME READ-ONLY
	MOVX T2,TM%WEN
	TDNE T2,RSBUFL(RSB)
	MOVEI T1,[ASCIZ/, WRITE-ENABLED/]
	TMCT <%1A%_%U>
	JE R%ONV,RSBIFL(RSB),[SETONE R%ONV,RSBIFL(RSB)
		CALL VQCNT	;MORE THAN 1 VOLID IN SET?
		SOJLE T1,.+1	;NO
		MOVE T1,RSBSSN(RSB) ;GET SETNAME
		TMCT <
Volumes in set %1S: >
		CALL TMCVLS	;DISPLAY VOLID LIST
		JRST .+1]
	SKIPE RSBRMK(RSB)	;DID THE USER SUPPLY A REMARK?
	JRST [	MOVEI T1,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
		TMCT <%_User's remark: %1A>
		JRST .+1]
	MOVEI T3,OPRHDR		;GET ADDRESS OF HEADING
	CALLRET BTWTO		;SEND WTO OFF TO THE OPERATOR


; WOWDDR - REQUEST REMOUNT OF TAPE - DRIVE COULDN'T HANDLE DENSITY
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

WOWDDR:	TMCT <%I%M>
	CALL TMCVOL		;DISPLAY VOLID
	MOVE T1,MTAVOL(MTA)	;GET VOLID
	LOAD T2,RSBDEN
	MOVE T2,DENTAB(T2)	;GET NUMERIC DENSITY
	TMCT < being unloaded
Remount volume %1S on %2D BPI drive>
	MOVEI T3,[ASCIZ/Remount Tape Volume/]
	CALLRET BTWTO


; WOWPE - TELL OPERATOR THAT WRITE RING SHOULD BE INSERTED OR REMOVED
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

WOWPE:	TMCT <%I%M>
	CALL TMCVOL		;DISPLAY VOLID
	LOAD T1,MA%WEN,MTAFLG(MTA) ;GET CURRENT WRITE STATUS
	MOVE T1,[[ASCIZ/Insert/]
		 [ASCIZ/Remove/]](T1) ;GET WHAT TO DO
	TMCT <%_%1A write ring and remount tape>
	MOVEI T3,[ASCIZ/Tape Write Protect Error/]
	CALLRET BTWTO		;OUT TO OPERATOR


; WRNXTV - ASK OPERATOR FOR NEXT VOLUME OF VOLUME SET
;  T1/ ADDR OF RESPONSE HANDLER THAT WILL BE CALLED BY INWTOR
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

WRNXTV:	MOVE T2,RSBSSN(RSB)
	TMCT <%ISupply next volume-id for tape set %2S%_%U
Respond with either of:
  VOLUME volid
  REFUSE reason>
	SKIPE RSBRMK(RSB)	;DID THE USER SUPPLY A REMARK?
	JRST [	MOVEI T2,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
		TMCT <%_User's remark: %2A>
		JRST .+1]
	MOVEI T2,RSBWTB(RSB)	;GET WTB ADDRESS
	MOVEI T3,[ASCIZ/Key In Next Volume Identifier/]
	CALLRET BTWTOR		;SEND IT OFF


; WRUTR - TELL OPERATOR THAT A USER TAPE MOUNT REQUEST HAS BEEN
;	   RECEIVED AND ASK HIM TO KEY IN VOLID LIST
;  T1/ ADDRESS OF RESPONSE HANDLER THAT WILL BE CALLED BY INWTOR
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

WRUTR:	MOVE T2,RSBSSN(RSB)
	TMCT <%IVolume set %2S, %U
Respond with either of:
  RESPOND n VOLUMES volid,volid,...
  RESPOND n REFUSE reason>
	SKIPE RSBRMK(RSB)	;DID THE USER SUPPLY A REMARK?
	JRST [	MOVEI T2,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
		TMCT <%_User's remark: %2A>
		JRST .+1]
	MOVEI T2,RSBWTB(RSB)	;WTB ADDRESS
	MOVEI T3,[ASCIZ/Tape Set Request/] ;MESSAGE TYPE
	CALLRET BTWTOR		;SEND OFF WTOR
; TEXT MESSAGE COMPOSITION (TMC) SUBROUTINES
; ALL TMC SUBROUTINES RETURN +1 ALWAYS

TMC1:	MOVE T1,TMCPTR		;GET BUFFER POINTER
	SETZ T2,
	IDPB T2,T1		;PUT A NULL AT THE END OF THE BUFFER
	SUBI T1,TMCMSG-1	;COMPUTE BUFFER SIZE IN WORDS
	HRRZM T1,TMCWDS		;STORE IT FOR CALLING ROUTINES

; CHECK FOR END OF BUFFER

	HRRZ T1,T1		;Size of the current message
	CAIGE T1,ENDBUF		;Space for another line?
	RET			;Yes
	MOVE T1,[POINT 7,[ASCIZ/
Message Truncated - Buffer Space Exhausted
/]]
TMCLP:	ILDB T2,T1		;Pick up the next character of message
	IDPB T2,TMCPTR		;Place into the TMCMSG buffer
	SKIPE T2		;End of the ASCIZ string?
	JRST TMCLP		;No, go pick up the next character
	SETOM BUFLFT		;Set flag to indicate exhausted buffer
	MOVE T1,TMCPTR		;Get address of the end of the message
	SUBI T1,TMCMSG-1	;Calculate the message size
	HRRZM T1,TMCWDS		;Store it for calling routines
	RET

; TMCRSP - SPECIAL VERSION OF TMCASZ FOR INCOMING WTOR RESPONSES
;  T1/ 0 ,, ADDRESS OF ASCIZ WTOR RESPONSE

TMCRSP:	HRLI T1,(POINT 7)	;CONSTRUCT BYTE POINTER
TMCRS1:	ILDB T2,T1		;GET A BYTE FROM RESPONSE TEXT
	JUMPE T2,[TMCTR <%_>]	;END, APPEND CRLF AND RETURN
	CAIN T2,"F"-100
	JRST TMCRS1		;DON'T COPY CTRL/F
	CAIN T2,.CHESC
	JRST TMCRS1		;DON'T COPY ESCAPE
	CAIN T2,"?"
	JRST TMCRS1		;DON'T COPY QUESTION MARK
	CAIN T2,.CHCRT
	JRST TMCRS1		;DON'T COPY CARRIAGE RETURN
	CAIN T2,.CHLFD
	MOVEI T2," "		;CHANGE LINE FEED TO BLANK
	IDPB T2,TMCPTR		;PUT CHARACTER IN TMCMSG
	JRST TMCRS1		;LOOP UNTIL NULL

; CPYHDR - COPY CONTENTS OF TMCMSG TO OPRHDR

CPYHDR:	MOVE T1,[TMCMSG,,OPRHDR] ;BLT SOURCE,,DESTINATION
	BLT T1,OPRHDR+OPRHSZ-1
	RET


; TMCVOL - DISPLAY THE TEXT " Volume " FOLLOWED BY THE MTA VOLID
;  MTA/ ADDR OF MTA STATUS BLOCK

TMCVOL:	SKIPN T1,MTAVOL(MTA)	;GET VOLID
	JRST [	TMCTR < scratch tape>] ;ZERO, THEREFORE SCRATCH
	TMCTR < Volume %1S>	;DISPLAY AND RETURN


; TMCVLS - DISPLAY THE VOLUME-ID LIST FOR A GIVEN USER REQUEST
;  RSB/ ADDR OF REQUEST STATUS BLOCK

TMCVLS:	SAVEQ
	QSCANI <RSBVLS(RSB)>	;SET UP TO SCAN VOLID LIST
	SETO Q1,		;INIT COUNTER
TMCVL1:	CALL QMSCAN		;GET ADDRESS OF NEXT VOLID ENTRY IN T2
	 RET			;NONE LEFT, SPLIT
	AOJG Q1,[TMCT <, >	;SEPARATE VOLIDS WITH COMMAS
		JRST .+1]
	SKIPN T1,1(T2)		;GET SIXBIT VOLID
	JRST [	TMCT <scratch>	;HE'S DEAD, JIM
		JRST TMCVL1]
	TMCT <%1S>		;VOLID IS KNOWN
	JRST TMCVL1		;LOOP UNTIL ALL VOLIDS ARE DISPLAYED
; DRIVER FOR TMCT AND TMCTR MACROS
;  CX/ ADDRESS OF FORMATTING STRING

TMCT0:: HRL  CX,BUFLFT		;Load end of buffer flag
	SKIPGE CX		;Any space left in TMCMSG?
	RET			;No
	HRLI CX,(POINT 7)	;MAKE BYTE POINTER TO SOURCE STRING
	MOVEM CX,TMCTSP		;SAVE POINTER
	SAVET			;ALL AC'S PRESERVED (EXCEPT 15,16)
	TRVAR <TMCTAR,<TMCTAC,4>>
	DMOVEM T1,TMCTAC	;SAVE T1-T4
	DMOVEM T3,2+TMCTAC
TMCT1:	ILDB T1,TMCTSP		;GET NEXT CHARACTER FROM STRING
	JUMPE T1,TMC1		;END OF STRING
	CAIE T1,"%"		;TRIGGER CHARACTER?
	JRST [	IDPB T1,TMCPTR	;NO, JUST COPY IT
		JRST TMCT1]	;LOOP THRU STRING
	TXZ F,ARGF		;SAY NO ARGUMENT (YET)
	SETZM TMCTAR		;ZERO ARGUMENT ACCUMULATOR
TMCT2:	ILDB T1,TMCTSP		;GET NEXT CHARACTER
	CAIG T1,"9"		;NUMERIC?
	CAIGE T1,"0"
	JRST TMCT3		;NO
	SUBI T1,"0"		;YES, CONVERT ASCII TO INTEGER
	MOVE T2,TMCTAR		;GET CURRENT ACCUMULATOR
	IMULI T2,12		;DECIMAL SHIFT
	ADD T2,T1		;ADD IN NEXT DIGIT
	MOVEM T2,TMCTAR		;STORE UPDATED ACCUMULATOR
	TXO F,ARGF		;SET ARG-SEEN
	JRST TMCT2		;CONTINUE ARGUMENT SCAN

TMCT3:	MOVSI T2,-TMCDTL	;GET AOBJN POINTER TO DISPATCH TABLE
TMCT4:	HLRZ T3,TMCDT(T2)	;GET CHARACTER FROM DISPATCH TABLE
	CAME T1,T3		;MATCH FUNCTION CHARACTER?
	JRST [	AOBJN T2,TMCT4	;NO, CONTINUE SCAN
		JRST TMC1]	;NO MATCH??? ERROR IN FORMAT STRING
	HRRZ T1,TMCDT(T2)	;FOUND IT, GET ROUTINE ADDRESS
	CALL (T1)		;CALL HANDLER
	MOVE T1,TMCPTR		;GET BUFFER POINTER
	SETZ T2,
	IDPB T2,T1		;PUT A NULL AT THE END OF TEXT
	SUBI T1,TMCMSG-1	;COMPUTE TEXT SIZE IN WORDS
	HRRZM T1,TMCWDS		;STORE IT FOR CALLERS
	JRST TMCT1		;FUNCTION DONE, CONTINUE STRING SCAN
; TMCT DISPATCH TABLE

TMCDT:	"A",,%A		;ASCIZ STRING, ARG = AC CONTAINING ADDRESS
	"C",,%C		;ADVANCE TO COLUMN, ARG = COLUMN#
	"D",,%D		;DECIMAL #, ARG = AC CONTAINING #
	"I",,%I		;INITIALIZE TMC FORMATTED STRING
	"J",,%J		;JSYS ERROR MESSAGE, ARG = AC CONT. ERROR CODE
			;NO ARG MEANS USE MOST RECENT MOUNTR ERROR
	"K",,%K		;TYPE DRIVE NUMBERS, ARG = CKU NUMBER
	"M",,%M		;DISPLAY "MTAn:" (NEEDS MTA AC)
	"N",,%N		;DISPLAY "MTn:" (NEEDS MT AC)
	"O",,%O		;OCTAL NUMBER, ARG = AC CONTAINING #
	"S",,%S		;SIXBIT, ARG = AC CONTAINING SIXBIT VALUE
	"U",,%U		;USER NAME, ARG = AC CONTAINING USER#
			;NO ARG MEANS DO NAME/JOB/LINE FOR CURRENT RSB
	"V",,%V		;DEVICE NAME, ARG = AC CONTAINING DESIGNATOR
	"Y",,%Y		;ARG = AC CONTAINING NON-0 FOR Yes OR 0 FOR No
	"%",,%%		;PERCENT SIGN
	"_",,%CRLF	;CRLF
TMCDTL==.-TMCDT		;NUMBER OF ENTRIES IN TABLE
GETREG:	JXE F,ARGF,[ADJSP P,-1	;IF NO ARG PRESENT
		RET]		;RETURN TO CALLER'S CALLER
	MOVE T1,TMCTAR		;GET ARGUMENT
	CAIG T1,T4		;IN T1-T4?
	ADDI T1,-1+TMCTAC	;YES, ADD OFFSET TO STORED AC'S
	MOVE T1,(T1)		;GET CONTENTS OF REGISTER
	RET

;Returns - +1 always 
;	   T2/The current location of the message
;	   This routine clobbers T2

TMCNT:	SAVEQ

	MOVE Q1,[POINT 7,TMCMSG] ;GET POINTER TO EXISTING MESSAGE
TMCNT1:	SETZ T2,		;# OF CHARACTERS SINCE LAST LINEFEED
TMCNT2:	ILDB Q2,Q1		;GET NEXT CHARACTER FROM MESSAGE
	CAIN Q2,.CHLFD		;IS IT A LINEFEED?
	JRST TMCNT1		;YES, RESET COUNTER AND CONTINUE SCAN
	SKIPE Q2		;END OF STRING?
	AOJA T2,TMCNT2		;NO, COUNT CHARACTER AND LOOP
	RET
%CRLF:	SKIPA T1,[[ASCIZ/
/]]
%A:	CALL GETREG		;GET ADDRESS OF TEXT
%A0:	HRLI T1,(POINT 7)	;MAKE STRING POINTER
%A1:	ILDB T2,T1		;GET NEXT CHARACTER FROM STRING
	JUMPE T2,R		;EXIT IF END OF STRING
	IDPB T2,TMCPTR		;COPY CHARACTER TO OUTPUT STRING
	JRST %A1		;LOOP THRU INPUT

%C:	CALL TMCNT		;Get the current location of pointer to msg
	MOVE T1,TMCTAR		;GET DESIRED COLUMN POSITION
	SUB T1,T2		;GET # OF SPACES PLUS 1
	MOVEI T2," "		;GET SPACE
TMCC3:	SOJLE T1,TMC1		;EXIT IF NO MORE SPACES NEEDED
	IDPB T2,TMCPTR		;INSERT A SPACE
	JRST TMCC3		;LOOP UNTIL POSITION IS REACHED

%D:	CALL GETREG		;GET NUMBER
	MOVEI T3,12		;BASE 10
	JRST %DO		;MERGE
%O:	CALL GETREG		;GET NUMBER
	MOVEI T3,10		;BASE 8
%DO:	MOVE T2,T1		;# TO T2 FOR NOUT
	MOVE T1,TMCPTR		;GET DESTINATION STRING POINTER
	NOUT			;OUTPUT NUMBER
	 SKIPA
	MOVEM T1,TMCPTR		;STORE UPDATED POINTER
	RET

%I:	MOVE T1,[POINT 7,TMCMSG] ;GET PTR TO TEXT STRING
	MOVEM T1,TMCPTR		;INITIALIZE IT
	RET

%J:	MOVEI T1,-1		;ASSUME NO ARGUMENT
	TXNE F,ARGF		;ARG PRESENT?
	CALL GETREG		;YES, GET ERROR CODE FROM AC
	MOVE T2,T1		;CODE TO T2 FOR ERSTR
	HRLI T2,.FHSLF		;FORK HANDLE ,, ERROR CODE
	MOVE T1,TMCPTR		;DESTINATION STRING POINTER
	SETZ T3,		;NO LIMIT ON LENGTH
	ERSTR			;GET ERROR STRING
	 JFCL
	 JFCL
	MOVEM T1,TMCPTR		;STORE UPDATED POINTER
	RET

%K:	CALL GETREG		;READ ARGUMENT
	MOVE T4,T1		;REMEMBER IT
	MOVE T1,TMCPTR		;GET BYTE POINTER
	HRROI T2,[ASCIZ/Channel /]	;TEXT
	SETZ T3,		;ALL OF IT
	SOUT			;TYPE IT
	LOAD T2,DOP%C2,T4	;GET CHANNEL
	MOVEI T3,^D10		;Decimal
	NOUT			;TYPE IT
	 JFCL
	TXC T4,DOP%K2		;GET READY
	TXCN T4,DOP%K2		;ANY CONTROLLER TO TYPE?
	JRST %K2		;NO, SKIP ON
	HRROI T2,[ASCIZ/ Controller /]	;YES
	SETZ T3,		;ASCIZ
	SOUT			;TYPE THIS
	LOAD T2,DOP%K2,T4	;GET CONTROLLER NUMBER
	MOVEI T3,^D10		;Decimal
	NOUT			;TYPE IT
	 JFCL
%K2:	HRROI T2,[ASCIZ/ Drive /]	;MORE TEXT
	SETZ T3,		;ASCIZ
	SOUT			;TYPE IT
	LOAD T2,DOP%U2,T4	;GET DRIVE NUMBER
	MOVEI T3,^D10		;Decimal AGAIN
	NOUT			;TYPE IT
	 JFCL
	MOVEM T1,TMCPTR		;REMEMBER NEW POINTER
	RET			;DONE


%M:	CALL GMTADD		;GET MTA DEVICE DESIGNATOR
	SKIPA
%N:	CALL GMTDD		;GET MT DEVICE DESIGNATOR
%V1:	MOVE T2,T1		;DESIGNATOR TO T2 FOR DEVST
	MOVE T1,TMCPTR		;GET DEST STRG PTR
	DEVST			;GET DEVICE NAME
	 CALL STOP
	MOVEM T1,TMCPTR		;STORE UPDATED POINTER
	MOVEI T1,":"
	IDPB T1,TMCPTR		;PUT A COLON AT THE END
	RET

%S:	CALL GETREG		;GET SIXBIT QUANTITY
%S1:	SETZ T2,		;CLEAR T2 FOR SHIFT
	ROTC T1,6		;GET NEXT CHARACTER IN T2
	ADDI T2,40		;CONVERT TO ASCII
	IDPB T2,TMCPTR		;STORE IT
	JUMPN T1,%S1		;LOOP IF MORE NON-BLANKS REMAINING
	RET

%U:	JXE F,ARGF,%UNA		;JUMP IF NO ARGUMENT
	CALL GETREG		;GET USER#
	MOVE T2,T1		;USER# TO T2 FOR DIRST
	MOVE T1,TMCPTR		;GET DEST POINTER
	DIRST			;GET USER NAME
	 SKIPA
	MOVEM T1,TMCPTR		;STORE UPDATED POINTER
	RET

%UNA:	PUSH P,TMCTSP		;SAVE CURRENT INPUT POINTER
	TMCT <User>
	CAIN RSB,MTNAV		;RSB AVAILABLE?
	JRST %U1		;NO, THAT'S ALL
	LOAD T1,RSBJNO		;GET JOB #
	MOVE T2,RSBUNO(RSB)	;GET USER #
	TMCT < %2U, Job %1D>
	MOVSS T1		;MOVE JOB # TO LEFT HALF
	HRRI T1,.JOBTT		;GET TABLE # IN RIGHT HALF
	GETAB			;GET LINE # FROM JOBTTY TABLE
	 CALL STOP
	HLRES T1		;DETACHED?
	JUMPE T1,%U1		;IF ZERO, USER PROBABLY LOGGED OUT
	JUMPL T1,[TMCT <, DETACHED> ;IF DETACHED, SAY SO
		JRST %U1]
	TMCT <, Terminal %1O>	;SHOW LINE # AND RETURN
%U1:	MOVEI T2,RSBACT(RSB)	;Get address of account string in mount request
	MOVX T1,R%OPR		;Check for OPR request
	TDNN T1,RSBIFL(RSB)	;Skip if OPR request
	TMCT <, Account %2A>	;Indicate the account string
	POP P,TMCTSP		;RESTORE PREVIOUS STRING POINTER
	RET

%V:	CALL GETREG		;GET DESIGNATOR IN T1
	JRST %V1		;GO DISPLAY IT

%Y:	CALL GETREG		;GET ARG IN T1
	JUMPN T1,[JSP T1,%A0	;NON-ZERO, SAY YES
		ASCIZ/Yes/]
	JSP T1,%A0		;ZERO, SAY NO
	ASCIZ/No/

%%:	MOVEI T1,"%"
	IDPB T1,TMCPTR		;STORE PERCENT CHARACTER
	RET
SUBTTL QUASAR INTERFACE

; GETRSB - ALLOCATE A REQUEST STATUS BLOCK
; RETURNS +1: RSB ALLOCATED, BUT IT'S THE LAST ONE
;	  +2: RSB ALLOCATED, MORE FREE RSB'S LEFT
;  RSB/ ADDR OF REQUEST STATUS BLOCK

GETRSB:	MOVEI T1,IRBQDB		;POINT TO INACTIVE RSB QUEUE
	CALL QMDQH		;DEQUEUE HEAD OF QUEUE
	 CALL STOP		;QUEUE EMPTY, PROGRAM LOGIC ERROR
	MOVEI RSB,-RSBLNK(T2)	;LOAD UP RSB AC
	MOVS T1,RSB		;BLT SOURCE
	HRRI T1,1(RSB)		;BLT DESTINATION
	SETZM (RSB)		;CLEAR 1ST WORD OF RSB
	BLT T1,RSBSIZ-1(RSB)	;CLEAR THE REST OF THE RSB
	MOVEI T2,RSBLNK(RSB)	;GET ADDRESS OF RSB LINKAGE WORD
	MOVEI T1,ARBQDB
	CALL QMQT		;QUEUE TO TAIL OF ACTIVE QUEUE
	SKIPN IRBQDB		;WAS THIS THE LAST FREE RSB?
	RET			;YES, RETURN +1
	RETSKP


; GETRSI - INITIALIZE FREE RSB POOL FOR GETRSB
; RETURNS +1: ALWAYS

GETRSI:	SAVEQ
	MOVEI Q1,RSB0		;GET ADDRESS OF RSB POOL
	MOVEI Q2,MAXMRQ+1	;# OF RSBS IN POOL
GTRSI1:	MOVEI T1,IRBQDB		;GET QDB ADDRESS
	MOVEI T2,RSBLNK(Q1)	;GET ADDRESS OF RSB LINKAGE
	CALL QMQT		;QUEUE RSB TO TAIL OF FREE QUEUE
	ADDI Q1,RSBSIZ		;POINT Q1 AT NEXT RSB
	SOJG Q2,GTRSI1		;LOOP THRU ALL RSBS
	RET

; GORSB - GET RSB FOR FUNCTION REQUESTED VIA OPR COMMAND
;  T1/ REQUEST TYPE CODE
; RETURNS +1: RSB POOL EMPTY, ACK MESSAGE SENT TO OPERATOR
;	  +2: SUCCESS, RSB/ ADDR OF REQUEST STATUS BLOCK

GORSB:	STAKT
	CALL GETRSB		;TRY TO ASSIGN RSB
	 TDZA T4,T4		;SET SHORTAGE FLAG
	MOVEI T4,1		;SET NO SHORTAGE
	MOVE T1,CT1
	STOR T1,RSBTYP		;SET TYPE IN RSB
	MOVX T1,R%OPR+R%PRIV	;SET FROM-OPERATOR AND PRIVILEGED
	IORM T1,RSBIFL(RSB)
	JUMPN T4,RSKP		;TAKE +2 IF NO FREESPACE SHORTAGE
	ABTREQ (ABRTNR)		;SHORTAGE, ABORT REQUEST
	CALL PRQABT		;PUT RSB BACK ON INACTIVE QUEUE
	MOVEI T3,[ASCIZ/Space exhausted, try later/]
	CALLRET BTACK		;TELL OPERATOR ABOUT BUMMER
; MATR - PROCESS USER REQUEST FOR ATTRIBUTES OF MOUNTED DEVICE
;	 (CURRENTLY VALID ONLY FOR TAPES)
;  RBUF/ ATTRIBUTE-REQUEST MESSAGE
;  T1/ SIZE OF MESSAGE (WORDS)
; RETURNS +1: ALWAYS

MATR:	SAVEQ
	SAVEAC <MT,RSB>
	CAIE T1,.MATQS		;CHECK SIZE
	JRST [	CALLRET BADQM]	;NOT WHAT IT SHOULD BE
	MOVE T1,RBUF+.MATDV	;GET DEVICE DESIGNATOR
	CALL DDMT		;GET MT STATUS BLOCK ADDRESS
	 TDZA RSB,RSB		;BAD MT DEVICE, FORCE ERROR RETURN
	LOAD RSB,MTRSB		;GET RSB ADDRESS
	SKIPE RSB
	CAIN RSB,MTNAV
	JRST [	TMCT <%IInvalid device> ;BAD MT OR NO REQ ASSOCIATED
		MOVE T1,RBUF+.MATPD ;GET USER'S PID
		MOVX T2,MF.FAT	;GET FATAL-ERROR FLAG
		MOVE T3,RBUF+.MSCOD ;GET USER'S ACK CODE
		CALLRET TXTMSG]	;RESPOND TO USER WITH GLX TEXT MESSAGE

; CONSTRUCT RESPONSE, BUILDING-BLOCK STYLE

	CALL PBINIT		;INITIALIZE BUILDING-BLOCK STRUCTURE
	MOVE Q1,[2,,.MATDD]	;CONSTRUCT DEVICE-DESIGNATOR BLOCK
	MOVE Q2,RBUF+.MATDV
	MOVEI T1,Q1		;GET ADDR OF SOURCE BLOCK
	CALL PBBLK		;INSTALL IT
	HRRI Q1,.TMSET		;GET SIZE AND TYPE FOR SETNAME
	MOVE Q2,RSBSSN(RSB)	;GET SETNAME
	MOVEI T1,Q1		;GET ADDR OF SOURCE BLOCK
	CALL PBBLK		;INSTALL IT
	CALL VQCNT		;GET # OF VOLIDS
	MOVSI Q1,1(T1)		;BLOCK LENGTH = # OF VOLIDS + 1
	HRRI Q1,.TMVOL		;GET BLOCK TYPE
	MOVEI T1,Q1		;GET ADDR OF SOURCE BLOCK
	HRRZ Q2,PBBPT		;GET ADDRESS OF DESTINATION BLK HEADER
	CALL PBBLK		;INSTALL IT
	HLRZS Q1		;GET # OF VOLIDS + 1
MATR3:	SOJG Q1,[AOBJN Q2,	;BUMP INDICES (NEVER JUMPS)
		HLRZ T1,Q2	;GET VOLID INDEX
		CALL VQGET	;GET VOLID
		 JFCL		;SHOULD NEVER FAIL
		MOVEM T1,(Q2)	;STORE VOLID INTO MESSAGE
		JRST MATR3]	;LOOP THRU ALL VOLIDS
	MOVE T1,PBBPT		;MESSAGE IS COMPLETE, GET HIGH ADDRESS
	SUBI T1,TBUF		;COMPUTE LENGTH OF MESSAGE
	MOVSS T1		;TO LEFT HALF
	HRRI T1,.QOMAR		;GET MESSAGE CODE
	SETZ T2,		;NO FLAGS
MATR2:	MOVE T3,RBUF+.MSCOD	;GET ACK CODE FOR USER
	CALL GALHDR		;BUILD GALAXY HEADER IN MESSAGE
	MOVE T1,RBUF+.MATPD	;GET USER'S PID
	CALLRET TRANU		;SEND MESSAGE TO USER
; QMNT - PROCESS USER MOUNT REQUEST MESSAGE FROM QUASAR
;  RBUF/ IPCF MOUNT MESSAGE
;  T1/ SIZE OF MESSAGE (WORDS)
; RETURNS +1: ALWAYS

QMNT:	SAVEQ
	CAIE T1,1000		;DID I GET A PAGE OF DATA?
	JRST [	CALLRET BADQM]	;NO, QUASAR BLEW IT

; GET RSB AND COPY USER-DESCRIPTOR INFORMATION INTO IT

	SETZ Q2,		;ASSUME NO PROBLEMS WITH RSB POOL
	CALL GETRSB		;ALLOCATE STATUS BLOCK FOR THIS REQUEST
	 SETO Q2,		;FREE RSB POOL IS NOW EMPTY
	MOVE T1,RBUF+.MMNAM
	MOVEM T1,RSBRNM(RSB)	;MOVE REQUEST NAME TO RSB
	MOVE T1,RBUF+.MMITN
	MOVEM T1,RSBITN(RSB)	;MOVE QUASAR INTERNAL TASK # TO RSB
	MOVE T1,RBUF+.MMUCD
	MOVEM T1,RSBCOD(RSB)	;MOVE USER'S ACK CODE TO RSB
	MOVE T1,RBUF+.MMPID
	MOVEM T1,RSBPID(RSB)	;MOVE USER'S PID TO RSB
	LOAD T1,MD.PJB,RBUF+.MMCAP
	STOR T1,RSBJNO		;MOVE USER'S JOB # TO RSB
	MOVE T1,RBUF+.MMUNO
	MOVEM T1,RSBUNO(RSB)	;MOVE USER'S USER # TO RSB
	MOVX T1,MD.PWH+MD.POP
	MOVX T2,R%PRIV
	TDNE T1,RBUF+.MMCAP	;DOES USER HAVE WHEEL OR OPERATOR?
	IORM T2,RSBIFL(RSB)	;YES, MARK HIM AS PRIVILEGED
	MOVSI T1,RBUF+.MMACT	;BLT SOURCE
	HRRI T1,RSBACT(RSB)	;BLT DESTINATION
	BLT T1,RSBACT+7(RSB)	;MOVE USER'S ACCOUNT STRING TO RSB

; IDENTIFY REQUEST TYPE AND DISPATCH TO THE APPROPRIATE PROCESSOR

	JUMPN Q2,[ABTREQ (MREQ31) ;ABORT IF RSB'S IN SHORT SUPPLY
		TXZ F,ABORTF	;CLEAR ABORTED-REQUESTS-PRESENT
		CALLRET PRQABT]	;MAKE SURE AT LEAST 1 FREE RSB IS LEFT
	MOVE T1,RBUF+.MMARC	;GET ENTRY COUNT
	CAIE T1,1		;IS IT 1?
	JRST MSERR		;NO, FORMAT ERROR
	MOVEI T2,RBUF+.MMHSZ	;GET ADDRESS OF FIRST ENTRY
	MOVE T3,RBUF+.MMUMS	;GET SIZE OF USER IPCF MESSAGE
	SUBI T3,.MMHSZ		;COMPUTE SIZE OF MOUNT-ENTRY REGION
	CALL CKBSTR		;CHECK BUILDING-BLOCK STRUCTURE
MSERR:	 JRST [	ABTRET (MREQ13)] ;STRUCTURAL ERROR IN MOUNT MESSAGE
	MOVEI T1,RBUF+.MMHSZ	;GET ADDRESS OF FIRST ENTRY
	LOAD T2,AR.TYP,(T1)	;GET TYPE OF ENTRY
	STOR T2,RSBTYP		;STORE REQUEST TYPE IN RSB
	CAIN T2,.MNTTP		;IS IT A USER TAPE MOUNT?
	JRST [	CALLRET UTM]	;YES, GO PROCESS IT
	CAIN T2,.MNTST		;USER STRUCTURE MOUNT?
	JRST [	CALLRET USM]	;YES, GO PROCESS IT
	CAIN T2,.DSMST		;DISMOUNT STRUCTURE?
	JRST [	CALLRET USD]	;YES
NOSHIP,<
	CAIN T2,.MNTDT		;DECTAPE MOUNT?
	JRST [	CALLRET UDTM]	;YES
>;NOSHIP
	ABTRET (MREQ21)		;I CAN'T HANDLE ANYTHING ELSE
; QSRINI - ESTABLISH IPCF RAPPORT WITH QUASAR
; RETURNS +1: ALWAYS

QSRINI:	STKVAR <TSTFLG>		;FLAG USED ONLY FOR DEBUGGING
	SETOM TSTFLG		;INITIALIZE FLAG
QSRIN1:	MOVEI T1,.SPQSR
	CALL GSYSPD		;GET QUASAR'S PID FROM SYSTEM PID TABLE
	 JRST [	AOSN TSTFLG	;HAVE WE BEEN HERE BEFORE?
		CALL TSTWAT	;NO, INFORM USER WE ARE WAITING
		MOVEI T1,^D5000	;NOT THERE YET
		DISMS		;WAIT 5 SECONDS
		JRST QSRIN1]	; AND TRY AGAIN
	MOVEM T1,APPID+.APQSR	;STUFF PID IN A/P TABLE

; BUILD AND TRANSMIT HELLO MESSAGE TO QUASAR

	MOVE T1,[HEL.SZ,,.QOHEL] ;MESSAGE LENGTH ,, MESSAGE TYPE
	SETZB T2,T3		;NO FLAGS, NO ACK CODE
	CALL GALHDR		;CONSTRUCT GALAXY HEADER IN TBUF
	MOVE T1,[SIXBIT/MOUNTR/]
	MOVEM T1,TBUF+HEL.NM	;MY NAME
	MOVX T1,FLD(%%.QSR,HEFVER)
	MOVEM T1,TBUF+HEL.FL	;QSRMAC VERSION #
	MOVX T1,FLD(1,HENNOT)+FLD(HENMAX,HENMAX)
	MOVEM T1,TBUF+HEL.NO	;# OF OBJ TYPES, MAX # OF JOBS
	MOVX T1,.OTMNT
	MOVEM T1,TBUF+HEL.OB	;I HANDLE MAGTAPE MOUNT REQUESTS

	MOVEI T1,.APQSR		;GOING TO QUASAR
	CALL TRANG		;TRANSMIT MESSAGE
	RET
; QSRMRC - DISPATCH IPCF MESSAGES FROM QUASAR TO APPROPRIATE ROUTINES
;  MRPDB, RBUF/ PDB AND MESSAGE
; RETURNS +1: ALWAYS

QSRMRC:	SAVEQ
	CALL CKGHDR		;CHECK OUT GALAXY HEADER
	 JRST [	CALLRET BADQM]	;BAD HEADER

; T1/ MESSAGE LENGTH (WORDS)   T2/ MESSAGE TYPE

	MOVSI T4,-QDTABL	;GET AOBJN POINTER
QSRMR1:	HLRZ T3,QDTAB(T4)	;GET MESSAGE TYPE FROM TABLE
	CAME T2,T3		;DOES IT MATCH THE MESSAGE I JUST GOT?
	JRST [	AOBJN T4,QSRMR1	;NO, LOOP
		CALLRET BADQM]	;DOESN'T MATCH ANYTHING IN THE TABLE
	HRRZ T2,QDTAB(T4)	;GET ADDRESS OF DISPATCH WORD
	MOVE T2,(T2)		;GET DISPATCH WORD
	TLZE T2,1		;HAVE TO CALL ORNBCK?
	JRST [	DMOVE Q1,T1	;YES, SAVE T1 & T2
		CALL ORNBCK
		 JRST [	CALLRET BADQM] ;ERROR, REPORT IT AND RETURN
		DMOVE T1,Q1	;COPY 'EM BACK
		JRST .+1]
	CALLRET (T2)		;DISPATCH TO HANDLER, T1/ MSG LENGTH

; DISPATCH TABLE FOR MESSAGE TYPES RECEIVED FROM QUASAR

; 1 IN LEFT HALF OF LITERAL MEANS ORNBCK MUST BE CALLED BEFORE DISPATCH

QDTAB:	.QOMNT,,[0,,QMNT]	;MOUNT REQUEST FROM USER
	.QOMTA,,[0,,TCAN]	;TAPE MOUNT CANCEL
	.QOMAT,,[0,,MATR]	;ATTRIBUTE REQUEST FROM USER
	.ODDMT,,[1,,KDMT]	;OPR COMMAND - DELETE MOUNT-REQUEST
	.ODENA,,[1,,KENA]	;OPR COMMAND - ENABLE
	.ODDIS,,[1,,KDIS]	;OPR COMMAND - DISABLE
	.ODDSM,,[1,,KDSM]	;OPR COMMAND - DISMOUNT
	.ODSDK,,[1,,KSDK]	;OPR COMMAND - SET DISK-DRIVE
	.ODIDN,,[1,,KIDN]	;OPR COMMAND - IDENTIFY
	.ODSTP,,[1,,KSTP]	;OPR COMMAND - SET TAPE-DRIVE
	.ODSHD,,[1,,KSHD]	;OPR COMMAND - SHOW STATUS DISK
	.ODSHT,,[1,,KSHT]	;OPR COMMAND - SHOW STATUS TAPE
	.ODSTR,,[1,,KSHS]	;OPR COMMAND - SHOW STATUS STRUCTURE
	.ODSST,,[1,,KSST]	;OPR COMMAND - SET STRUCTURE
	.ODSWI,,[1,,KSWI]	;OPR COMMAND - SWITCH
	.ODUNL,,[1,,KUNL]	;OPR COMMAND - UNLOAD
	.ODSPO,,[1,,KSPT##]	;OPR Command - Set Port
	.ODUDS,,[1,,KSUD]	;OPR Command - Undefine Structure
	.ODMTS,,[1,,KSMT]	;OPR command - Mount Structure
	.ODSCD,,[1,,KSCD]	;OPR COMMAND - Show configuration disk
QDTABL==.-QDTAB
; REQRSB - TRANSLATE REQUEST NUMBER INTO RSB ADDRESS
;  T1/ REQUEST NUMBER
; RETURNS +1: UNKNOWN REQUEST #, T1/ REQUEST #
;	  +2: SUCCESS, RSB/ RSB ADDR,  T1/ REQUEST #

REQRSB:	QSCANI ARBQDB		;SET UP TO SCAN RSB QUEUE
	SAVET			;PRESERVE T1 AS ADVERTISED
REQR1:	CALL QMSCAN		;GET NEXT RSB
	 RET			;NONE LEFT, REQUEST # UNKNOWN
	MOVEI RSB,-RSBLNK(T2)	;LOAD RSB AC WITH ADDRESS OF RSB
	MOVE T1,CT1		;GET REQ# FROM RSB
	CAME T1,RSBITN(RSB)	;DOES IT MATCH WHAT THE CALLER GAVE?
	JRST REQR1		;NO, CONTINUE SCAN
	RETSKP			;YES, SUCCESS


; RLSMSG - SEND RELEASE MESSAGE TO QUASAR
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

RLSMSG:	MOVE T1,RSBITN(RSB)	;GET ITN
	MOVEM T1,TBUF+REL.IT	;STORE IN MESSAGE
	MOVE T1,[REL.SZ,,.QOMTR] ;GET GALAXY HEADER
	SETZB T2,T3
	CALL GALHDR		;BUILD HEADER
	MOVEI T1,.APQSR
	CALLRET TRANG		;SEND RELEASE MESSAGE TO QUASAR
; TCAN - PROCESS USER TAPE REQUEST CANCEL MESSAGE FROM QUASAR
;  RBUF/ IPCF TAPE MOUNT CANCEL MESSAGE
;  T1/ SIZE OF MESSAGE (WORDS)
; RETURNS +1: ALWAYS

TCAN:	SAVEQ
	MOVE T3,T1		;COPY SIZE OF MESSAGE
	SUBI T3,.OHDRS		;GET SIZE OF BLOCK REGION OF MESSAGE
	JUMPLE T3,TCANQE	;NO BLOCK REGION, ERROR BY QUASAR
	MOVE T1,RBUF+.OARGC	;GET # OF BLOCKS
	MOVEI T2,RBUF+.OHDRS	;GET ADDRESS OF 1ST BLOCK
	CALL CKBSTR		;CHECK BLOCK STRUCTURE
TCANQE:	 JRST [	CALLRET BADQM]	;BAD STRUCTURE, QUASAR GOOFED
	DMOVE T1,[EXP RBUF+.OARGC,RBUF+.OHDRS]
	MOVEI T3,.MTPID		;GET TYPE OF BLOCK BEING SOUGHT
	CALL BLKFND		;LOOK UP USER'S PID
	 JRST TCANQE		;PID BLOCK NOT THERE
	JUMPE T2,TCANQE		;MAKE SURE THERE'S ROOM FOR A PID
	MOVE Q2,(T1)		;GET PID SO I CAN REPLY TO THE USER
	DMOVE T1,[EXP RBUF+.OARGC,RBUF+.OHDRS]
	MOVEI T3,.MTITN		;GET BLOCK TYPE
	CALL BLKFND		;LOOK UP ITN LIST
	 JRST TCANQE		;NOT THERE
	SETZ Q1,		;CLEAR COUNTER OF CANCELED REQUESTS
	JUMPE T2,TCAN2		;NO SCAN IF NOTHING TO CANCEL
	MOVN Q3,T2		;GET NEGATIVE NUMBER OF ITN'S
	MOVSS Q3		;OVER TO LEFT HALF FOR AOBJN
	HRR Q3,T1		;MAKE AOBJN POINTER TO ITN LIST

; LOOP THROUGH ITN LIST, TRYING TO CANCEL EACH ONE

TCAN1:	MOVE T1,(Q3)		;GET AN ITN
	CALL TCITN		;TRY TO CANCEL IT
	 SKIPA			;CAN'T CANCEL
	AOS Q1			;COUNT CANCELED REQUEST
	AOBJN Q3,TCAN1		;LOOP
	; ..
	; ..

; BUILD TEXT REPLY TO CANCEL MESSAGE IN TMCMSG

TCAN2:	JUMPG Q1,[TMCT <%I%5D>	;AT LEAST 1 REQUEST CANCELED
		JRST TCAN3]
	TMCT <%INo>		;NO REQUESTS CANCELED
TCAN3:	TMCT < mount request>
	SOJN Q1,[TMCT <s>	;IF NOT 1 REQUEST, TACK ON AN "S"
		JRST .+1]
	TMCT < canceled>

; BUILD IPCF MESSAGE AND SEND IT TO THE CANCELER

	MOVE T1,Q2		;GET USER'S PID
	SETZ T2,		;NO FLAGS
	MOVE T3,RBUF+.MSCOD	;GET CANCELER'S ACK CODE
	CALLRET TXTMSG		;RESPOND TO CANCEL WITH GLX TEXT MESSAGE
; TCKP - SEND A STATUS UPDATE FOR A MOUNT REQUEST TO QUASAR
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

TCKP:	SAVEQ
	SAVEAC <MT,MTA>
	MOVE T1,RSBITN(RSB)
	MOVEM T1,TBUF+CHE.IT	;STORE ITN IN MESSAGE
	SETZM TBUF+CHE.FL	;SET NO SPECIAL FLAGS
	MOVEI Q1,TBUF+CHE.IN	;GET ADDR OF START OF CKPT INFO AREA

	LOAD Q2,RSBTYP		;GET REQUEST TYPE
	MOVEM Q2,.MTTYP(Q1)	;STORE IT
	CAIE Q2,.MNTTP		;TAPE REQUEST?
	CAIN Q2,.MNTDT		; OR DECTAPE REQUEST?
	SKIPA			;YES
	JRST TCKP0		;NO, SKIP VOLID STUFF

	CALL VQGCV		;GET VOLID OF CURRENT VOLUME IN T1
	SKIPN T1		;SCRATCH?
	MOVEI T1,%VOLSC		;YES, GET 1 TO DISPLAY "Scratch"
	LOAD T2,RSBSTE		;GET CURRENT STATE OF REQUEST
	CAIGE T2,.ERBAS		;ABORTED OR
	CAIN T2,RST.WV		; WAITING FOR VOLID LIST?
	MOVEI T1,%VOLBL		;YES, DON'T DISPLAY ANYTHING
	MOVEM T1,.MTVOL(Q1)	;STORE VOLID
TCKP0:

	CAIN T2,RST.AC		;REQUEST HAVE MTA OR DTA?
	JRST [	MOVE T1,RSBDTA(RSB) ;YES, ASSUME DECTAPE
		CAIN Q2,.MNTDT	;DECTAPE?
		JRST TCKP1	;YES, T1/ DECTAPE DEVICE DESIGNATOR
		LOAD MT,RSBMT	;MAGTAPE REQUEST
		LOAD MTA,MTMTA	;LOAD MTA AC
		CALL GMTADD	;GET MTA DESIGNATOR IN T1
		JRST TCKP1]	;GO STORE IT
	MOVEI T1,%STAWT		;ASSUME WAITING FOR SOMETHING
	CAIL T2,.ERBAS		;ABORTED?
	MOVEI T1,%STAAB		;YES, SAY SO THEN
TCKP1:	MOVEM T1,.MTSTA(Q1)	;STORE STATE FIELD OF MESSAGE

	MOVE T1,[CHE.IN+EQCKSZ,,.QOMTC] ;GET SIZE AND MESSAGE TYPE
	SETZB T2,T3		;NO FLAGS OR ACK CODE
	CALL GALHDR		;BUILD GALAXY HEADER
	MOVEI 1,.APQSR
	CALLRET TRANG		;SEND CHECKPOINT MESSAGE TO QUASAR
; TXTMSG - SEND GALAXY IPCF TEXT-MESSAGE
;  T1/ RECEIVER'S PID
;  T2/ FLAGS FOR GALAXY MESSAGE HEADER
;  T3/ ACK CODE FOR MESSAGE HEADER
;  TMCMSG/ ASCIZ MESSAGE TO BE SENT
; RETURNS +1: ALWAYS

TXTMSG:	STAKT
	AOS TBUF+.OARGC		;SET ARGUMENT COUNT TO 1
	MOVE T1,TMCWDS		;GET LENGTH OF MESSAGE (WORDS)
	MOVSI T2,1(T1)		;CONSTRUCT
	HRRI T2,.CMTXT		; ARGUMENT HEADER WORD
	MOVEM T2,TBUF+.OHDRS	;STORE ARG HEADER
	MOVE T2,[TMCMSG,,TBUF+.OHDRS+1] ;GET BLT SOURCE,,DESTINATION
	BLT T2,TBUF+.OHDRS(T1)	;COPY TEXT INTO IPCF MESSAGE
	MOVSI T1,.OHDRS+1(T1)	;GET SIZE OF ENTIRE MESSAGE
	HRRI T1,MT.TXT		;BUILD SIZE,,TYPE
	MOVE T2,CT2		;GET FLAGS
	MOVE T3,CT3		;GET ACK CODE
	CALL GALHDR		;BUILD GALAXY HEADER FOR MESSAGE
	MOVE T1,CT1		;GET RECEIVER'S PID
	CALLRET TRANU		;TRANSMIT MESSAGE AND RETURN
SUBTTL STRUCTURE ROUTINES

;BSRALI - GET STRUCTURE ALIAS FROM QUASAR MSSG INTO RSB

;ACCEPTS: T1/ ADDRESS OF SUBENTRY COUNT WORD
;	  T2/ ADDRESS OF FIRST SUBENTRY
;	  RSB/ ADDR OF REQUEST STATUS BLOCK

;RETURNS: +1,	FAILURE
;	  +2,	SUCCESS

BSRALI: MOVEI T3,.SMALI		;GET STRUCTURE ALIAS CODE
	CALL BLKFND		;LOOKUP ALIAS
	 JRST [	ABTRET(MREQ22)]	;ERROR, CAN'T MOUNT STR IF NO ALIAS
	JUMPE T2,[ABTRET(MREQ22)] ;TREAT ZERO-LENGTH NAME LIKE NO NAME
	MOVE T1,(T1)		;GET ALIAS IN T1
	MOVEM T1,RSBSTA(RSB)	;STORE ALIAS IN RSB
	RETSKP


;BSRNAM - GET STRUCTURE NAME FROM QUASAR MSSG INTO RSB

;ACCEPTS: T1/ ADDRESS OF SUBENTRY COUNT WORD
;	  T2/ ADDRESS OF FIRST SUBENTRY
;	  RSB/ ADDR OF REQUEST STATUS BLOCK

;RETURNS: +1,	FAILURE
;	  +2,	SUCCESS

BSRNAM:	MOVEI T3,.SMNAM		;GET STRUCTURE NAME CODE
	CALL BLKFND		;LOOKUP NAME
	 JRST BSRNA1		;NAME NOT GIVEN
	JUMPE T2,BSRNA1		;TREAT ZERO-LENGTH NAME AS NO NAME
	MOVE T1,(T1)		;GET NAME IN T1
	CAME T1,RSBSTA(RSB)	;IS NAME SAME AS ALIAS
	JRST [	MOVX T2,R%PRIV	;NO, IS USER PRIVILEGED?
		TDNE T2,RSBIFL(RSB)
		JRST .+1	;YES, LET IT GO
		ABTRET (CAPX1)]	;NOT PRIVLEGED, ABORT REQUEST
	SKIPA
BSRNA1:	SETZ T1,		;STORE ZERO IF NO NAME MENTIONED
	MOVEM T1,RSBSTN(RSB)	;STORE NAME IN REQUEST BLOCK
	RETSKP
SUBTTL Update all disks -- Flow of update
COMMENT %

                        +----------+
                        |  DDSCIH  |
                        +----------+
                             |
      ------------------------------------------------
      |               |               |              |
+----------+    +----------+    +----------+    +----------+
|  DDSNXT  |    |  DSTSRC  |    |  DDSNEW  |    |  DDSCHK  |  Add or check
+----------+    +----------+    +----------+    +----------+  DSK
 Get next        Search for           |           |    |
 CKU             DSK with CKU         -------------    |
                 (Also called          |               |
                  by KSDK)       +----------+    +----------+
                                 |  DDSADD  |    |  DDSDEL  |  Delete structure
                        Add disk +----------+    +----------+  info. about disk
                                  |        |       |
                            +----------+   ---------
           Store structure  |  STRINF  |       |
            info. for disk  +----------+   +----------+
                                  |        |  DDSMCH  |  Match user requests
                            +----------+   +----------+  with disk change
             Get/build SSB  |  STRGSB  |
                            +----------+
% ; END OF COMMENT
SUBTTL Update all disks -- DDSCIH - Update all disk drives

;DDSCIH - ENTERED BY SCHEDULER WHEN PSI INTERRUPT RECEIVED
;	  INDICATING THAT A DISK STATUS CHANGE HAS OCCURRED
;	Also called whenever disks need to be updated

;ACCEPTS: NOTHING
;RETURNS: +1,	ALWAYS


DDSCIH::SAVEQ			;SAVE ACS
	CALL DSFNUP		;Set no update
DDSC.0:	CALL DSTINI		;INITIALIZE TO LOOP OVER ALL DISKS

DDSC.1:	CALL DSTNXT		;GET STATUS OF NEXT DISK
	 JRST DDSC.2		;Done go finish up
	CALL DSTSRC		;LOOK FOR UNIT IN TABLES
	 JRST [	CALL DDSNEW	;Not found, go do a new disk drive
	 	JRST DDSC.1]	;And continue
	CALL DDSCHK		;Otherwise, go check on it
	JRST DDSC.1		;THEN LOOK AT NEXT ONE

DDSC.2:	SKIPN AGAIN		;Do we need to do again?
	JRST DDSC.3		;No, go clean up
	SETZM AGAIN		;Clear flag
	JRST DDSC.0		;Go try again

DDSC.3: CALL DSFYUP		;Want to update
	RET			;And return
SUBTTL Update all disks -- DSTINI - Initialize MSTR block for scanning units

;  Called only by DDSCIH

;ACCEPTS: NOTHING
;RETURNS: +1,	ALWAYS


DSTINI:	SETOM MSTRBK		;SET UP MSTR TO LOOK AT FIRST CHANNEL
	SETOM MSTRBK+1		; FOR FIRST CONTROLLER
	SETOM MSTRBK+2		; FOR FIRST DISK
	RET			;DONE


SUBTTL Update all disks -- DSTNXT - Get status of the next disk

;  Called only by DDSCIH

;ACCEPTS: MSTRBK BLOCK FOR MSTR JSYS
;RETURNS: +1,	FAILURE
;	  +2,	SUCCESS, STATUS RETURNED IN MSTRBK BLOCK
;		  T1/	CKU NUMBERS FOR UNIT


DSTNXT:	MOVE T1,[POINT 7,MSTNM] ;GET POINTER TO STRUCTURE NAME
	MOVEM T1,MSTRBK+.MSRSN	; AND STORE IN MSTR ARGUMENT BLOCK
	MOVE T1,[POINT 7,MSTAL]	;DO SAME FOR STRUCTURE ALIAS
	MOVEM T1,MSTRBK+.MSRSA
	MOVE T1,[50,,.MSRNU]	;Set up call to monitor to get status
	MOVEI T2,MSTRBK		;PUT STATUS IN MSTR BLOCK
	SETZM MSTNM		;CLEAR NAME IN CASE NOT PART OF STRUCTURE
	SETZM MSTAL		;CLEAR ALIAS ALSO
	MSTR			;GET STATUS
	 ERJMP R		;END OF DISKS
	SETZ T1,		;START WITH ZERO AC
	MOVE T2,MSTRBK+.MSRCH	;GET CHANNEL NUMBER
	STOR T2,DOP%C2,T1	;STORE INTO AC
	MOVE T2,MSTRBK+.MSRCT	;GET CONTROLLER NUMBER
	STOR T2,DOP%K2,T1	;STORE WITH CHANNEL
	MOVE T3,MSTRBK+.MSRUN	;FINALLY GET UNIT NUMBER
	STOR T3,DOP%U2,T1	;STORE WITH REST
	RETSKP			;DONE
SUBTTL Update all disks -- DSTSRC - LOOK FOR THE DISK ENTRY MATCHING SPECIFIED CKU NUMBERS

;ACCEPTS: T1/	CKU NUMBER (CHANNEL, CONTROLLER, UNIT NUMBERS)
;RETURNS: +1,	UNIT WAS NOT IN TABLES
;		   DSK/	ADDRESS OF FIRST FREE SLOT OR ZERO IF NONE
;	  +2,	UNIT FOUND
;		  DSK/	ADDRESS OF DISK STATUS BLOCK FOR UNIT



DSTSRC:	MOVE DSK,[-MAXDSK,,DSKSTB]	;GET AOBJN POINTER READY
	SETZ T2,		;NO FREE ENTRY FOUND YET

DSTSRL:	SKIPN DSKFLG(DSK)	;THIS ENTRY IN USE?
	JRST DSTSRF		;NO, GO REMEMBER FREE ENTRY
	CAME T1,DSKCKU(DSK)	;IS THIS THE UNIT?
	JRST DSTSRN		;NO, TRY NEXT ONE
	ANDI DSK,-1		;FOUND THE UNIT, REMOVE JUNK
	RETSKP			;SUCCESSFUL RETURN

DSTSRF:	SKIPN T2		;HAVE FREE ENTRY REMEMBERED YET?
	MOVE T2,DSK		;NO, THEN REMEMBER THIS ONE
DSTSRN:	ADDI DSK,DSKSZ-1	;MOVE TO NEXT ENTRY
	AOBJN DSK,DSTSRL	;GO DO IT
	HRRZ DSK,T2		;UNIT NOT FOUND, GET FREE BLOCK IF ANY
	RET			;AND RETURN IT
SUBTTL Update all disks -- DDSNEW - Add new disk to data bases

;  Called only by DDSCIH

;HERE WHEN A NEW UNIT HAS TO BE ADDED TO THE DISK TABLES:
;  DSK/	ADDRESS OF FREE ENTRY, OR ZERO IF NO MORE ROOM
;  T1/	CKU NUMBERS FOR UNIT


DDSNEW:	SKIPN DSK		;Room for the entry?
	 CALL STOP		;No, must be room

;  Initialize the disk status block

	MOVSI T2,0(DSK)		;SETUP BLT POINTER
	IORI T2,1(DSK)		;TO CLEAR THE DISK STATUS BLOCK
	SETZM (DSK)		;CLEAR FIRST WORD
	BLT T2,DSKSZ-1(DSK)	;THEN THE REST

	MOVEM T1,DSKCKU(DSK)	;REMEMBER CKU NUMBERS
	MOVE Q2,MSTRBK+.MSRST	;GET STATUS OF DISK
	MOVEM Q2,DSKFLG(DSK)	;REMEMBER IN BLOCK
	MOVE T2,MSTRBK+.MSDSH	;Get serial number of disk (HIGH ORDER)
	MOVEM T2,DSKSNH(DSK)	;Remember in block
	MOVE T2,MSTRBK+.MSDSN	;Get serial number of disk (LOW ORDER)
	MOVEM T2,DSKSNL(DSK)	;Remember in block

;  Add/create DDB for entry

	MOVEI T2,.DVDSK		;Get the disk type
	MOVEM T2,DSFE+DSFTYP	;Save it
	MOVEM T1,DSFE+DSFSPC	;Save the CKU
	SETZM DSFE+DSFFLG	;Default to no flags
	CALL DSFCRE		;Go create it
	 JRST DDSN.1		;Skip this, it already exists

;  Here check whether to set DSF%PO in the disk entry of the DDB base on PORTST
;  PORTST=0 indicates port available, 1=unavailable, -1=No port

	SKIPG PORTST		;Is the port available
	JRST DDSN.1		;Available, skip port stuff
	MOVE T2,MSTRBK+.MSRCH	;Get the channel number
	CAIE T2,CIPORT		;For now test for channel 7
	TXNE Q2,MS%2PT		;Port unavailable, is it dual ported?
	CALL [SETONE DSF%PO,DSFE+DSFFLG ;Set disk unavail due to port operation
	      RET]
DDSN.1:	MOVEM DSK,DSFE+DSFPNT	;Save the DSB address
	CALL DSFUDE		;Update the entry
	 $STOP <Update of previously known DDB with DSFUDE failed>
	MOVEM T1,DSKPNT(DSK)	;Save address of DDB in DSB

	TXNE Q2,MS%OFL		;Is pack off-line?
	TXNE Q2,MS%IAC		;Yes, but is it due to HOM checking?
	CALL DDSADD		;No, add structure information
	RET			;DONE WITH UNIT
SUBTTL Update all disks -- DDSCHK - Check disk already existing

;  Called only by DDSCIH

;HERE TO CHECK ON A DISK WHICH WAS ALREADY IN OUR TABLES.  UPDATE
;THE DATA FOR IT.
;  DSK/	ADDRESS OF THIS DRIVE'S DATA


DDSCHK:	MOVE Q2,MSTRBK+.MSRST	;Get status of disk unit
	MOVE Q1,Q2		;Make copy of status
	XOR Q1,DSKFLG(DSK)	;Get changed bits
	MOVEM Q2,DSKFLG(DSK)	;Save new state in any case

;  First, if online, check the name of the structure with the old name.
;  If different, then delete the old and set the new structure information.

	TXNE Q2,MS%OFL!MS%IAC	;Offline?
	JRST DDSCH1		;Yes, skip the name test

;  Online, make sure we have a structure
	
	SKIPN MSTNM		;Do we have a structure
	JRST [CALL CHKDSK	;[336]Is it due to disk errors?
	      RET		;[336]Yes, bad data on disk drive
	      LOAD STR,DSKSSA,(DSK) ;[336]No structure,
	      JUMPE STR,R	;[336]If no pointer forget about this disk
	      MOVE T1,DSKCKU(DSK) ;No errors, MONITOR bug, get the CKU
	      TMCT <%IWarning disk (%1K) is online
but can not find structure on disk%_>
	      MOVEI T3,[ASCIZ/Disk Problem/]
	      CALLRET BTWTO]	;Online, but no structure!!!!
	MOVE T1,MSTRBK+.MSMID	;Get the unique code
	CAME T1,DSKUNQ(DSK)	;Is it the same
	JRST DDSCH0		;No, must be a new structure
	MOVE T1,[POINT 7,MSTNM] ;Online, get pointer to name
	MOVEI T2,Q3		;Want to put it in Q3
	CALL SEVSIX		;Convert name to sixbit
	CAME Q3,DSKSTN(DSK)	;Same as before?
;**;[6034]At DDSCHK:+16L add 6 lines JYCW 11-Aug-88
	JRST DDSCH0		;[6034]No, go update
	MOVE T1,[POINT 7,MSTAL] ;[6034]Online, get pointer to name
	MOVEI T2,Q3		;[6034]Want to put it in Q3
	CALL SEVSIX		;[6034]Convert name to sixbit
	CAMN Q3,DSKSTA(DSK)	;[6034]Same as before?
	JRST DDSCH1		;[6034]Yes, go check on other things

;  The name (disk) has changed

DDSCH0:	CALL DDSDEL		;Delete old structure information
	CALL DDSADD		;Add new structure information
	RET			;Nothing else to do this time

;  The name is the same or don't care.  Any reason to check further?

DDSCH1:	LOAD T1,DSKSSA,(DSK)	;Get the structure address field
	CAIN T1,-1		;Is it special, indicating a need to add?
	JRST DDSADD		;Yes, go do it

	SKIPN Q1		;Anything changed in status?
	JRST [TXNN Q2,MS%MNT	;No, is it mounted?
	      RET		;No, nothing further to check
	      LOAD STR,DSKSSA,(DSK) ;Get the SSB address
	      SKIPN STR		;Is there one?
	      RET		;No. done
	      SKIPE T1,STRPNT(STR) ;Get the DDB address
	      CALL UPDSTR	;Go try to update it
	      RET]		;Done

;  If the offline status has changed we either need to add or delete

	TXNE Q1,MS%OFL		;Offline status change?
	JRST [TXNE Q2,MS%IAC	;Yes, but is it HOM checking?
	      RET		;Yes, no need to do anything
	      TXNE Q2,MS%OFL	;How did the offline status change?
	      JRST DDSDEL	;  became offline
	      JRST DDSADD]	;  became online

;  If the mount status changed, add structure again
;  Also, if on f the error status changed, then also add structure again.

	TXNE Q1,MS%MNT!MS%WLK!MS%HBB!MS%BBB!MS%DIA ;Mount or error change?
	JRST DDSADD		;Yes.

	RET			;Whatever changed, we don't understand...
SUBTTL Update all disks -- DDSDEL - DELETE STRUCTURE INFORMATION ABOUT A DISK

;  Called only by DDSCHK

;ACCEPTS: DSK/	DISK NUMBER
;RETURNS: +1,	ALWAYS

DDSDEL:	LOAD STR,DSKSSA,(DSK)	;Get structure block address
	JUMPLE STR,DDSDE2	;If no STR then return after zeroing dsk entry

	CALL STRDSM		;Dismount structure data base if needed
	LOAD T1,STRMCT,(STR)	;Get number of disks mounted in structure
	SOJN T1,[STOR T1,STRMCT,(STR) ;If still more, save the number left
		LOAD T1,DSKLUN,(DSK) ;Get disk logical number
		ADD T1,STR	;Add base
		SETZM STRADD(T1) ;Clear this entry
		JRST DDSDE2]	;Continue to clear disk entry

	QSCANI ARBQDB		;Setup to scan active RSB queue
	SAVEAC <RSB,DSK>
	CALL PRQPID		;CLEAN UP REQUEST QUEUE FIRST
	MOVX T1,R%DSM		;CHECK DISMOUNT QUEUES
	CALL DDSMCH		;MATCH AND FINISH ACTIVE RSB'S
	MOVE T1,STRFL1(STR)	;[6011]Get flag
	TXNN T1,STR%LE+STR%LD	;[6011]Locked?
	IFSKP.
	 TXNN T1,STR%MT		;[6011]Yes, is it still mounted?
	 CALL RELLOC		;[6011]No, have to unlock structure
	ENDIF.
	CALL SSBRET		;Return the SSB

DDSDE2:	SETZM DSKSTN(DSK)	;ZERO STRUCTURE NAME
	SETZM DSKSTA(DSK)	;ZERO STRUCTURE ALIAS
	SETZM DSKNS(DSK)	;Zero structure unit information
	SETZM DSKP2(DSK)	;Clear pointer to SSB (zeros DSKSSA)
	RET
SUBTTL Update all disks -- DDSADD - ADD A DISK COMING ON-LINE

;  Called only by DDSNEW and DDSCHK

;ACCEPTS: DSK/	Address of Disk Status Block
;RETURNS: +1,	ALWAYS

DDSADD:	CALL STRINF		; YES, STORE STRUCTURE INFORMATION
	RET			;Do not want to continue right now
	LOAD T1,STRUNI,(STR)	;GET NUMBER OF DISKS IN STR
	LOAD T2,STRMCT,(STR)	;GET NUMBER OF DISKS MOUNTED IN STR
	CAME T1,T2		;ARE ALL DISK PACKS MOUNTED?
	RET			;NO, RETURN

;TRY TO MATCH STRUCTURE COMING ON-LINE TO USER REQUEST

	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB,DSK>
	CALL PRQPID		;CLEAN UP REQUEST QUEUE FIRST
	MOVE Q2,DSKFLG(DSK)	;GET DISK STATUS
	TXNE Q2,MS%MNT		;IS IT MOUNTED ALREADY?
	JRST [	CALLRET DDSMC0]	;YES, CHECK MOUNT QUEUES
DDSAD1:	CALL NSTRSB		;GET ADDRESS OF NEXT RSB
	 RET			;NONE LEFT
	LOAD T1,RSBSTE		;GET STATE OF REQUEST
	CAIE T1,RST.WM		;IS USER WAITING FOR STRUCTURE
	JRST DDSAD1		;NO, TRY NEXT REQUEST
	SKIPN T1,RSBSTN(RSB)	;GET STRUCTURE NAME IN REQUEST
	MOVE T1,RSBSTA(RSB)	;THERE IS NONE, GET ALIAS FOR NAME
	CAME T1,STRNAM(STR)	;IS IT SAME AS STRUCTURE COMING ON-LINE
	JRST DDSAD1		;NO, TRY NEXT REQUEST
	CALL STRMNT		;MOUNT THE STRUCTURE
	JRST DDSAD2		;ERROR IN MOUNTING STRUCTURE
	SETZ T1,		;CHECK MOUNT REQUESTS
	CALLRET DDSMCH		;STRUCTURE IS NOW READY FOR USERS. TELL THEM

;DDSAD2 - Return according to request.  If it was a MOUNT command from OPR
;         go to KSMTE2 for error message.

DDSAD2:	SKIPGE RSBITN(RSB)	;Is it from operator
	CALLRET KSMTE2		;Yes, let KSMTE2 handle the error
	RET			;No, STRMNT should have given the error message
SUBTTL Update all disks -- STRINF - Store/check structure information

;  Called only by DDSADD

;ACCEPTS: Q2/	STATUS OF UNIT
;	  DSK/  Address of Disk Status Block
;	  MSTRBK/ BLOCK FROM MSTR CALL

;RETURNS: +1 if processing requires second pass
;	  +2 if ok.

STRINF:	MOVE T1,[POINT 7,MSTNM]	;GET POINTER TO STRUCTURE NAME
	MOVEI T2,DSKSTN(DSK)	;GET WORD IN WHICH TO STORE NAME
	CALL SEVSIX		; CONVERT FROM 7-BIT TO 6-BIT
	TXNN Q2,MS%MNT		;DOES DRIVE HAVE MOUNTED STRUCTURE
	JRST STRIN1		;NO, STORE REST OF INFORMATION
	MOVE T1,[POINT 7,MSTAL]	;GET POINTER TO ALIAS NAME
	MOVEI T2,DSKSTA(DSK)	;GET WORD IN WHICH TO STORE ALIAS
	CALL SEVSIX		;CONVERT FROM 7-BIT TO 6-BIT
STRIN1:	MOVE T3,MSTRBK+.MSRNS	;GET LOGICAL UNIT,,NUMBER OF UNITS
	MOVEM T3,DSKNS(DSK)	; AND STORE
	MOVE T4,MSTRBK+.MSMID	;Get the unique code
	MOVEM T4,DSKUNQ(DSK)	;Save it in DSB
	MOVE T1,DSKSTA(DSK)	;GET STRUCTURE ALIAS IN SIXBIT
	MOVE T2,DSKSTN(DSK)	;GET STRUCTURE NAME
	CALL STRGSB		;BUILD STR STATUS TABLE & GET STR ADDR
	RET			;Done for now
	STOR STR,DSKSSA,(DSK)	;STORE STR STATUS BLOCK ADDRESS

;  If the structure is not mounted, was it previously, and if so, clean
;  some stuff up.

	TXNE Q2,MS%MNT		;Is disk part of a mounted structure?
	JRST [CALL CHKDSK	;Is the disk error free
	      JRST STRIN6	;No
	      JRST STRIN3]	;Yes, no errors found
	CALL CHKDSK		;Disk is not mounted, any errors
	SKIP
	CALL STRDSM		;Dismount structure data base if needed
	RETSKP			;And done

;  Continued on next page
;Continued from previous page

;  Since there are no error bits, are there any to clear?

STRIN3:	MOVE T1,STRFL1(STR)	;Get the flags
	TXZN T1,STR%DE		;Any device errors previous? (And clear bit)
	JRST STRIN6		;No, skip this

;  Want to loop on all the disks to verify that the bit should still be set.

	LOAD T2,STRUNI,(STR)	;Get the number of units
	MOVNS T2		;Set number of units negative
	MOVSS T2		;Switch halves
	HRRI T2,STRADD(STR)	;Get start of pack list

;    Beginning of loop

STRIN4: MOVE T3,(T2)		;Get address of DSB
	MOVE T3,DSKFLG(T3)	;Get the flags for this one
	TXNE T3,MS%WLK+MS%HBB+MS%BBB+MS%DIA+MS%ERR+MS%16B ;Any bad bits set?
	JRST STRIN6		;Yes, cannot clear bit at this time
	AOBJN T2,STRIN4		;Go try for more

;    End of loop

	MOVEM T1,STRFL1(STR)	;We win! Clear the bit
	MOVE T2,DSKSTA(DSK)	;Get Alias
	TMCT <%IDevice error cleared%_Structure %2S: can be used>
	MOVEI T3,STRCHD		;Get general purpose structure header
	CALL BTWTO		;Tell everyone

;  Continued on next page
;Continued from previous page

;  Structure is mounted.
;  Check to see if SSB knows about all of the disks of the structure.

STRIN6:	LOAD T1,STRUNI,(STR)	;Get number of units in structure
	LOAD T2,STRMCT,(STR)	;Get the number found so far
	CAME T1,T2		;The whole thing mounted?
	RETSKP			;No, don't do anything else for now

;  All the packs are mounted.  Build/find DDB entry.

	MOVE T1,STRFL1(STR)	;Get the other structure flags
	TXNE T1,STR%MT		;Was it previously mounted?
	JRST STRIN7		;Yes, skip this stuff
	MOVEI T2,MSTAL		;Get the structure alias ascii
	TMCT <%IPreviously mounted structure %2A: detected>
	MOVEI T3,STRCHD		;Get header
	CALL BTWTO
	MOVX T2,STR%MT		;Get mounted bit
	IORM T2,STRFL1(STR)	;Say it is so
	MOVE T1,DSKSTA(DSK)	;Get the structure alias
	MOVEM T1,STRALI(STR)	;Save it
	SKIPA			;Don't need to get alias again
	MOVE T1,STRALI(STR)	;Get the alias
	CALL ISTDDB		;Go build/find DDB
;**;[6033]At STRIN6:+22L (within literal) change 2 lines JYCW 6/28/88
	  CALL [SKIPE T2,DSFE+DSFPNT ;[6033]Already exists?
		SETZM STRPNT(T2) ;[6033]Yes, old pointer no longer valid
		RET]		;Rejoin code

	HRRM STR,DSFE+DSFPNT	;Save SSB address as pointer
	CALL DSFUDE		;Update DDB entry
	 $STOP <Update of previously known DDB with DSFUDE failed>
	MOVEM T1,STRPNT(STR)	;Save DDB pointer

;  Now want to UPDATE structure if needed including telling everyone
;  about what happened.

STRIN7:	MOVE T1,STRPNT(STR)	;Get pointer to DDB back
	CALL UPDSTR		;Go update structure
	RETSKP			;And done
SUBTTL Update all disks -- STRGSB - GET STRUCTURE STATUS BLOCK (BUILD ONE IF NECESSARY)

;  Called only by STRINF

;ACCEPTS: T1	SIXBIT STRUCTURE ALIAS
;	  T2	SIXBIT STRUCTURE NAME
;	  T3	LOGICAL UNIT # OF CURRENT DISK,,# OF UNITS IN STRUCTURE
;	  T4	Structure Unique Code
;	  DSK	DISK STATUS BLOCK ADDRESS

;RETURNS: +1 if processing requires 2nd pass
;	  +2 if ok.
;		STR/ CURRENT STRUCTURE BLOCK ADDRESS

STRGSB:	STAKT
	CALL MATCHS		;DOES THIS STRUCTURE EXIST?
	SKIPA			;NO
	JRST STRFND		;YES, DON'T NEED TO BUILD NEW BLOCK
STRGS0:	CALL SSBCRE		;[336]Get a new SSB entry
	MOVE T2,CT2		;RESTORE STR NAME
	MOVEM T2,STRNAM(STR)	;SAVE STR NAME
	HRRZ T2,CT3		;GET NUMBER OF UNITS
	STOR T2,STRUNI,(STR)	;AND STORE
	MOVE T1,DSKUNQ(DSK)	;Get unique code
	MOVEM T1,STRUNQ(STR)	;Save it

;STORE DISK STATUS BLOCK ADDRESS

STRFND:	HLRZ T3,CT3		;GET UNIT NUMBER
	ADD T3,STR		;GET OFFSET TO
	SKIPN T2,STRADD(T3)	;[6023]Do we have a previous address?
	IFSKP.			;[336][6023]Change to IFSKP
	 CAMN T2,DSK		;[336]Yes, is it the same as this one?
	 JRST STRFN0		;Yes, still ok.
	 LOAD T1,DSKSSA,(DSK)	;Get the disk structure address
         CAIN T1,-1		;Have we already been here?
	 JRST STRFN3		;[336]Yes, go do some analyz
         SETONE DSKSSA,(DSK) 	;Set the case
         SETOM AGAIN		;Say we should try again
	 RET			;[6023]Add missing RET from [336]
	ENDIF.			;[336]
STRFN0:	HRRZM DSK,STRADD(T3)	; SAVE DISK STATUS BLOCK ADDRESS

	LOAD T2,STRUNI,(STR)	;Get the number of units
	MOVNS T2		;Set number of units negative
	MOVSS T2		;Switch halves
	HRRI T2,STRADD(STR)	;GET START OF PACK LIST
	SETZ T4,		;LOOP THRU TO GET # OF PACKS

STRFN1:	SKIPE (T2)		;IS THIS A PACK
	AOS T4			;YES, COUNT IT
	AOBJN T2,STRFN1		;LOOK FOR ALL OF THEM

	STOR T4,STRMCT,(STR)	; AND STORE
	RETSKP

;[336] STRFN3 - Find out why we have a -1 in DSKSSA.
;Accepts T2/disk status block
;	 DSK/disk status block with -1 for SSB address.  
;	 STR/SSB
STRFN3:	MOVE T1,DSKFLG(DSK)	;[336]Get status flag of coming online disk
	TXNE T1,MS%IAC+MS%OFL	;[336]HOM block checking?
	 IFNSK.
	  MOVE T2,DSK		;[336]Move DSB into AC T2
	  JRST STRFN5		;[336]Delete DSB
	 ENDIF.
	MOVE T3,DSKFLG(T2)	;[336]Get disk status flag of existing disk
	TXNE T3,MS%IAC+MS%OFL	;[336]HOM block checking?
	 JRST STRFN5		;[336]Yes, delete DSB
;  Not result from a force offline due to HOM block checking
;  Is it due to bad HOM block informaton
	TXNN T1,MS%HBB		;[336]Bad HOM block?
	 IFSKP.		        ;[336]Yes
	  SETZM DSKP2(DSK)	;[336]Clear pointer to SSB (zeros DSKSSA)
	  RET			;[336]Yes, no need to add SSB
	 ENDIF.
	
;  Not result from bad HOM block
;  Must be identical structures coming online
	JRST STRGS0		;[336]Go create a new SSB

;T2/DSB address
STRFN5:	SETZM DSKSTN(T2)	;[336]Zero structure name
	SETZM DSKSTA(T2)	;[336]Zero structure alias
	SETZM DSKNS(T2)		;[336]Zero structure unit information
	SETZM DSKP2(T2)		;[336]Clear pointer to SSB (zeros DSKSSA)
	RET
SUBTTL Update all disks -- STRDSM - Dismount structure data base

;  Called only by STRINF and DDSDEL

;  This routine checks the mount bit for the structure and if lit, then
;  delete DDB, clear the mount bit, and clear the alias.  It also sends
;  an error message because the dismount is not normal

;  Accepts: STR / address of SSB

;  Returns: +1 always

STRDSM:	MOVE T1,STRFL1(STR)	;No, get the structure flags
	TXNN T1,STR%MT		;Was the structure previously mounted?
	RET			;No, all done
	CALL DSTDDB		;Get rid of DDB entry
	MOVE T1,STRALI(STR)	;Get the old structure alias
	TMCT <%IPreviously mounted structure %1S: no longer mounted>
	MOVEI T3,STRCHD		;Get general purpose structure header
	CALL BTWTO		;Tell everyone
	SETZM STRALI(STR)	;Alias only has meaning if structure mounted
	RET			;All to do with this structure
SUBTTL Disk status check -- CHKDSK -- Check for disk errors

;  Disk is online, check out if any error bits are set
;	accepts Q2/disk status
;		STR/structure status block
;		DSK/disk status block
;	return 	+1 found error 
;		+2 no error found
CHKDSK:	TXNN Q2,MS%WLK+MS%HBB+MS%BBB+MS%DIA+MS%ERR+MS%16B ;Any bad bits set?
	RETSKP			;No, skip setting the problem
	MOVE T1,DSKCKU(DSK)	;Get CKU
	TMCT <%IDevice error on %1K%_Drive cannot be used>
	TXNE Q2,MS%WLK		;Write locked?
	CALL [TMCT <%_Unit is write locked>
	      RET]		;And return
	TXNE Q2,MS%HBB		;Home block problem?
	CALL [TMCT <%_Unit has bad home block>
	      RET]		;And return
	TXNE Q2,MS%BBB		;Bad bit block problem?
	CALL [TMCT <%_Unit has bad bat block>
	      RET]		;And return
	TXNE Q2,MS%DIA		;Diagnostics?
	CALL [TMCT <%_Unit currently in use by on-line diagnostic>
	      RET]		;And return
	TXNE Q2,MS%ERR		;Device error?
	CALL [TMCT <%_Error reading this unit>
	      RET]		;And return
	TXNE Q2,MS%16B		;16 Bit format?
	CALL [TMCT <%_Unit written in 16 bit mode>
	      RET]		;And return
	MOVEI T3,STRCHD		;Get general purpose structure header
	CALL BTWTO		;Tell everyone
	LOAD STR,DSKSSA,(DSK)	;[336]No structure,
	JUMPE STR,R		;[336]If no pointer forget about this disk
	SETONE STR%DE,STRFL1(STR) ;[336]Yes, set the disk error flag
	RET			;Error return
SUBTTL Update all disks - DDSMCH - MATCH USER REQUEST TO MOUNTS AND DISMOUNTS

;  Called only by DDSADD and DDSDEL

;ACCEPTS: T1/	0=LOOK AT MOUNT REQUESTS
;		R%DSM=LOOK AT DISMOUNT REQUESTS
;	  QSB/ ADDRESS OF QUEUE SCAN BLOCK
;	  STR/ ADDRESS OF STRUCTURE BLOCK
;RETURNS:  +1,	ALWAYS

DDSMC0:	SAVEQ			;ALTERNATE ENTRY FOR MOUNT REQUESTS
	SETZ Q1,
	JRST DDSMC1

DDSMCH:	SAVEQ
	MOVE Q1,T1
	JUMPE Q1,DDSMC2		;GO TO DDSMC2 FOR MOUNT REQUESTS
DDSMC1:	CALL NSTRSB		;GET NEXT USER REQUEST
	 RET			;NONE LEFT
	LOAD T1,RSBSTE		;GET STATE OF REQUEST
	CAIE T1,RST.WM		;Is user waiting for mount?
	JRST [CAIE T1,RST.WD	;No, is user waiting for dismount?
	     JRST DDSMC1	;Neither, try next request
	     JRST .+1]		;Waiting for dismount
	MOVE T1,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	CAME T1,STRALI(STR)	;IS IT SAME AS THIS ONE
	JRST DDSMC1		;NO, TRY NEXT REQUEST
	SKIPN T1,RSBSTN(RSB)	;GET STRUCTURE NAME
	JRST DDSMC2		;NONE SPECIFIED. ALLOW THIS MOUNT
	CAME T1,STRNAM(STR)	;IS THIS THE SAME AS CURRENT STR
	JRST DDSMC1		;NO, GET NEXT REQUEST
DDSMC2:	MOVE T1,RSBIFL(RSB)	;GET INTERNAL FLAGS
	XOR T1,Q1		;ARE WE LOOKING AT RIGHT REQUEST TYPE
	TXNE T1,R%DSM
	JRST DDSMC1		;NO
	LOAD ACC,RSBACC		;GET ACC IF ANY ASSOCIATED.
	JUMPE ACC,DDSMC3	;NO ASSOCIATED ACC
	SETZRO RSBACC		;DELINK ACC AND RSB
	MOVEI T1,RSBSTA(RSB)	;POINT TO SIXBIT ALIAS
	MOVE T2,[POINT 7,MSTAL]	;ASCII GOES HERE
	CALL SIXSEV		;CONVERT ALIAS TO ASCII
	HRROI T1,MSTAL		;POINT TO ASCII ALIAS
	STDEV			;GET DEVICE DESIGNATOR
	 CALL STOP		;ERROR NO SUCH DEVICE?
	JRST [	HLRZ T1,T2	;GET LEFT HALF OF DESIGNATOR
		CAIE T1,.DVDES+.DVDSK ;IS IT A DISK?
		 CALL STOP	;NOT A DISK?
		MOVEM T2,ACCDD(ACC) ;SAVE IT FOR FNDACC.
		JRST .+1 ]
DDSMC3:	MOVX T1,R%OPR
	TDNN T1,RSBIFL(RSB)	;DID OPERATOR REQUEST THIS?
	CALL TELUSR		;NO, LET USER KNOW HE HAS STRUCTURE
	ABTREQ (ABRTNR)		;ABORT RSB WITH NO REPLY TO USER
	JRST DDSMC1
SUBTTL Update all disks -- DSTDDB - Delete STructure DDB

;  Called only by STRDSM and STRDMS

;  This routine deletes the structure DDB and sets the STR as dismounted.

;  Accepts: STR / address of SSB

;  Returns +1 always

DSTDDB:	SKIPN T1,STRPNT(STR)	;Do we have DDB entry?
	JRST DSTDD0		;No, skip this

;  Delete DDB entry and mark the structure as not mounted

	CALL DSFGET		;Yes, go get it
	 SKIPA			;Shouldn't happen
	CAME STR,DSFE+DSFPNT	;Does pointer match SSB address?
	 $STOP <Incorrect DDB pointer detected in SSB>
	SETZM DSFE+DSFPNT	;Get rid of pointer
	CALL DSFUDE		;Update entry
	 $STOP <Update of previously known DDB with DSFUDE failed>
	SETZM STRPNT(STR)	;Clear pointer

DSTDD0:	SETZRO STR%MT,STRFL1(STR) ;Clear structure mounted flag
	RET
SUBTTL Disk Routines -- DSKINI - Disk initialization routine

;ACCEPTS: NOTHING
;RETURNS: +1, ALWAYS


DSKINI:

;  Turn on interrupts for disk status changes

	MOVEI T1,33		;GET INTERRUPT CHANNEL FOR DISK
	MOVEM T1,T3		; STATUS CHANGE
	MOVE T1,[1,,.MSOFL]	;TELL MONITOR TO INTERRUPT US IF
	MOVEI T2,T3		; THERE IS DISK CHANGE
	SKIPN TSTF		;DON'T DO MSTR IF TESTING
	MSTR
	 ERCAL STOP		;Should not fail
	RET
SUBTTL Disk Routines -- DSTGIV - Get status for a given unit

;  Called only by STRMNT

;DSTGIV - GET STATUS FOR GIVEN DISK UNIT

;ACCEPTS: DSK/	ADDRESS OF DISK STATUS BLOCK
;RETURNS: +1	ERROR, INVALID UNIT
;	  +2	SUCCESS, STATUS IN MSTRBK BLOCK
;	  T1 /  Unit status returned by MSTR

DSTGIV: LOAD T1,DSKCTR,(DSK)	;GET CONTROLLER NUMBER
	LOAD T2,DSKCHN,(DSK)	;GET CHANNEL NUMBER
	LOAD T3,DSKDRV,(DSK)	;GET UNIT NUMBER
	CAIN T1,<.RTJST(-1,DOP%K2)>	;ALL ONES?
	SETO T1,		;YES, MAKE IT A FULL WORD
	MOVEM T1,MSTRBK+.MSRCT
	MOVEM T2,MSTRBK+.MSRCH
	MOVEM T3,MSTRBK+.MSRUN	;STORE VALUES FOR MSTR JSYS
	MOVE T1,[.MSRST+1,,.MSRUS] ;RETURN STATUS OF THE GIVEN UNIT
	MOVEI T2,MSTRBK		;GIVE ADDRESS OF ARGUMENT BLOCK
	MSTR
	 ERJMP R		;FAILURE RETURN
	MOVE T1,MSTRBK+.MSRST	;Get flags
	RETSKP
SUBTTL KSDK - Set disk-drive command from OPR

;KSDK - PROCESS SET DISK-DRIVE COMMAND FROM OPR
;***  NOTICE:  THIS CANNOT HANDLE RP20'S UNTIL GALAXY REDEFINES
;***  THEIR ARGUMENT BLOCK TO INCLUDE CONTROLLER NUMBERS
;Local AC use
;	Q1/New disk state. 1=unavailable  0=available
;	Q2/CKU,,Channel
;	Q3/
;RETURNS +1,	ALWAYS

KSDK:	SAVEQ
	SAVEAC <DSK>
	STKVAR <REASON>

;  Check for valid arguments

	MOVEI T1,.DSKDV
	CALL ORNBLF		;DISK DRIVE SPECIFIED?
	 JRST KBADM		;NO

	MOVE T2,0(T1)		;GET CHANNEL NUMBER
	DPB T2,[POINTR Q2,DOP%C2]	;PUT INTO AC
	MOVE T2,1(T1)		;Get controller number
	DPB T2,[POINTR Q2,DOP%K2] ;Put into AC
	MOVE T2,2(T1)		;GET DRIVE NUMBER
	DPB T2,[POINTR Q2,DOP%U2]	;STORE ALSO
	CALL DDSCIH		;MAKE SURE TABLES UP-TO-DATE
	MOVE T1,Q2		;COPY CKU NUMBER TO RIGHT AC
	CALL DSTSRC		;FIND THIS DISK DRIVE
	 JRST [	TMCT <%ICommand ignored.  Unknown %1K>	;NOT FOUND, COMPLAIN
		MOVEI T3,TMCMSG
		CALLRET BTACK]	;TELL OPERATOR NO SUCH DRIVE

;  Q1 contains the state of the disk to be changed. unavailable=1 available=0

	MOVEI Q1,1		;ASSUME SETTING UNAVAILABLE
	MOVEI T1,.DVUAV
	CALL ORNBLF		;CHECK IF SETTING UNAVAILABLE
	 JRST [ MOVEI T1,.DVAVL	;NO
		CALL ORNBLF	;SETTING AVAILABLE?
		 JRST KBADM	;NO
	        SOJA Q1,KSDK0]	;Yes, make Q1 zero and join common code

;  We are setting the disk to unavailable, get the reason block

	MOVEI T1,.ORREA
	CALL ORNBLF		;REASON BLOCK PRESENT
	 JRST KBADM		;No, bad message
	MOVEM T1,REASON		;Save the reason 

;  If a structure is mounted on this disk, set up to set the correct str bits 

KSDK0:	TMCT <%I>
	MOVE T1,DSKFLG(DSK)	;GET DISK STATUS
	TXNN T1,MS%MNT		;IS IT LOGICALLY MOUNTED?	
	JRST KSDK1		;No, skip setup stuff for set structure status
	LOAD STR,DSKSSA,(DSK)	;Get str status block address for disk drive

;  Check to see if primary PS: is mounted on this disk

	LOAD T1,MS%PPS,STRFLG(STR) ;Get the PS: bit
	JUMPN T1,KSDKER		;Error if PS:

	MOVEI T1,STRALI(STR)	;Get alias
	MOVE T2,[POINT 7,MSTAL]	;Alias goes here
	CALL SIXSEV		;Convert to asciz
	SKIPE T1,STRPNT(STR)	;Get address of DDB
	CALL DSFGET		;Get it
	  CALL STOP		;Not there, someone else must have mounted it

;  We have a structure, now see if the status is consistent with monitor

	CALL UPDSTR		;Update status

;  Find the disk entry in DDB

KSDK1:	MOVE T1,DSKPNT(DSK)	;Get the dsk pointer to DDB
	CALL DSFGET		;Go look for it
	 CALL STOP		;Not there,SHOULDN'T HAPPEN

;  T2 contains previous DSF%AV.  on if unavailable, of if unavailable

	LOAD T2,DSF%AV,DSFE+DSFFLG ;Load the available unavailable bit

	CAMN Q1,T2		;See if we have to change status? 
        JRST KSDKA		;No, no need to update DDB 
	STOR Q1,DSF%AV,DSFE+DSFFLG ;store the bit

	MOVE T1,DSKPNT(DSK)	;Get pointer to DDB entry
	CALL DSFUDE		;Go update
	 $STOP <Update of previously known DDB with DSFUDE failed>
	MOVEM T1,DSKPNT(DSK)	;In case it is updated


;  If Q1 is 0  log SYSERR for available else log for unavailable

	JUMPE Q1,[MOVEI T1,CS%ADV ;GET CODE FOR ATTACH-DEVICE
	          SETZ T2,	;NO REASON     
		  JRST KSDK2]	;Go log it
	MOVEI T1,CS%DDV		;Get code for detach-device
	MOVE T2,REASON		;Get adrress of ASCIZ reason

;  SYSSET should be called after DDB has been updated

KSDK2:	CALL SYMSET		;LOG SYSERR ENTRY FOR DRIVE SET UNAVAIL
	CALL WOMDAV		;TELL ALL OPERATORS WHAT HAPPENED

;  Check to see if a structure is mounted on this disk

	MOVE T1,DSKFLG(DSK)	;GET DISK STATUS
	TXNN T1,MS%MNT		;IS IT LOGICALLY MOUNTED?	
	RET			;NO


;  Here we want to determine what we would like STRFLG to be.  Compare that
;  with the current STRFLG value.  If they are equal, nothing to do but clean
;  up and exit.  If they are unequal, we would like to set the structure
;  to the new value and then set STRFLG appropriatly.  If we fail, analyze
;  the error.

	TMCT <%I >
	MOVE T1,STRPNT(STR)	;Get address of DDB
	CALL DSFGET		;Get it
	  CALL STOP		;Should not happen
	CALL NEWSTA		;Determine a new proposed STRFLG
	  JFCL			;Do not care if unmounted
	CAMN T1,STRFLG(STR)	;Is the proposed STRFLG anything new?	
	RET			;No.  Done.

;  Set the new strflg

	CALL STSTR		;Try to set the new strflg
	SKIPA			;Error need to do some more
	JRST KSDK4		;All done.

;  Failed to set the new strflg characteristics.  T1 contains the attempt.

	MOVE T2,STRALI(STR)	;Get structure alias
	TMCT <Unable to change structure %2S: status as part of disk operation>
	JRST KSDK5		;Send the message	

KSDK4:	MOVE T2,STRALI(STR)	;Get structure alias
	JUMPN Q1,[TMCT <Structure %2S: UNAVAILABLE due to disk operation>
	          JRST KSDK5]
	TMCT <Structure %2S: is AVAILABLE due to disk operation>	
KSDK5:	MOVEI T3,[ASCIZ/Structure status changed due to disk operation/]
	CALLRET BTWTO

;  Exit routine for setting a disk that already has that characteristic.

KSDKA:	MOVE T1,[[ASCIZ/Available/]
		[ASCIZ/Unavailable/]](Q1) ;GET TEXT POINTER
	MOVE T2,DSKCKU(DSK)		;GET UNIT ADDRESS
	TMCT <%I%2K Is Already Set %1A>
	MOVEI T3,TMCMSG
	CALLRET BTACK	;TELL OPRTR COMMAND HAS NO EFFECT

;  Exit routine for trying to set a disk drive with PS: mounted on it

KSDKER:	MOVEI T1,DSKPS		;Get error message
	TMCT <%8C%1A>
  	MOVEI T3,[ASCIZ/Set disk drive command failed/]
	CALL BTNFO		;Ask for no formatting
	CALLRET BTACKT	;TELL OPRTR COMMAND HAS NO EFFECT
SUBTTL KDSM - PROCESS DISMOUNT STRUCTURE COMMAND FROM OPR
;RBUF/
;RETURNS +1,	ALWAYS

KDSM:	CALL DDSCIH		;MAKE SURE TABLES UP-TO-DATE
	MOVEI T1,.DSMST		;GET RSB TYPE
	CALL OPRSB		;SET UP RSB FOR THIS OPR REQUEST
	 JRST KNORSB		;[6011]No RSB available
	MOVX T2,R%RNR		;Get the bit
	MOVE T1,RBUF+.OFLAG	;Get the REMOVE/NOREMOVE bit
	TXNE T1,.DMNRV		;Noremove specified ?
	JRST KDSM.1		;Do not have to set the bit
	TXNE T1,.DMRMV		;Remove specified ?
	JRST [ IORM T2,RSBIFL(RSB)	;Yes, set it 
		JRST KDSM.1]		;Skip default
	CALL CFSCHK		;Check on CFS status
	SKIPA			;Not cfs
	JRST KDSM.1		;CFS system, default to NOREMOVE
	MOVX T1,R%RNR		;Get the bit	
	IORM T1,RSBIFL(RSB)	;Set it 
KDSM.1:	MOVX T1,R%DSM		;GET DISMOUNT FLAG
	IORM T1,RSBIFL(RSB)	;AND SET INTO RSB
	SETZM RSBSTN(RSB)	;ZERO STRUCTURE NAME FOR MATCHS
	MOVEI T1,RST.WD
	STOR T1,RSBSTE		;SET STATE TO WAITING FOR DISMOUNT
	MOVE T1,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	MOVE T2,RSBSTN(RSB)	;GET STRUCTURE NAME
	SETZ T4,		;No unique code
	CALL MATCHS		;MATCH REQUEST TO STRUCTURE
	 JRST KDSM.2		;[6011]Structure not mounted. nothing to do.
	STOR STR,RSBSS		;STORE THE STRUCTURE ADDR INTO RSB
	SKIPG STR		;IS STRUCTURE MOUNTED?
	IFSKP.
	 SKIPN T1,RSBOBN(RSB)	;[6016]Get node name
	  IFSKP.
           MOVEM T1,STROBN(STR)	;[6011]Save it
	   SETONE STR%OB,STRFL1(STR) ;[6011]Set bit in STRFL1
	  ENDIF.
	 MOVEI T1,RSBSTA(RSB) 	;YES, DISMOUNT IT
	 MOVE T2,[POINT 7,MSTAL]
	 CALL SIXSEV
	 CALLRET STRDMT		;Dismount the structure
	ENDIF.

KDSM.2:	CALL NSACK		;[6011]Tell Nebula or not
	MOVE T2,RSBSTA(RSB)	;Get the name
	TMCT <%IStructure %2S: is not mounted%_> ;Build common message 
	MOVEI T3,[ASCIZ/Dismount Structure Status/] ;Default case
	LOAD T1,R%LOR,RSBIFL(RSB) ;[6011]Get the status bit
	SKIPE T1		;[6011]Local request, use local header
KDSM.3:	MOVEI T3,[ASCIZ/Remote Dismount Structure Status/] ;Else use remote
KDSM.4:	CALL BTWTO		;Tell the operator
	ABTRET (ABRTNR)		;Delete RSB and return

;[6011]
;Error routine for KDSM when MOUNTR runs out of RSBs. It will inform the
;operator of the error.  If the request is remote then a DISMOUNT
;ACK (failure ACK) is sent to NEBULA via ORION.  The content of AC RSB will
;determine whether the error is no RSB or somthing else.
;RSB/1 no RSB.
;RBUF/MESSAGE

KNORSB:	CAIE RSB,1		;[6014]We have a RSB
	RET			;[6011]No, just return
	MOVE T2,RBUF+.MSFLG	;[6011]Get the Galaxy flag word
	TXNE T2,MF.NEB		;[6011]Remote or local
	TXNN T2,MF.WTO		;[6011]Direct or indirect request
	JRST KNORS1		;[6011]Local/Indirect no need to send ACK

	MOVX T1,E%NRSB		;[6011]Error code
	TXO T1,FA%MER		;[6011]MOUNTR error type
	MOVE T2,RBUF+.MSCOD	;[6011]Remote ACK 
	CALL FAILE		;[6011]Remote, send failure
	MOVEI T1,.STRDV		;[6011]Get block type code
	CALL KGTSTR		;[6011]Get structure name
	 JRST KBADM		;[6011]Not there, reject message
	MOVE T3,T1		;[6011]Save the name
	MOVEI T1,.NDENM		;[6011]Want node name
	CALL ORNBLF		;[6011]Look for it in RBUF
	 JFCL			;[6011]None
	MOVE T4,(T1)		;[6011]Get the node name
	TMCT <%IInsufficient MOUNTR resources needed to dismount
structure%3S: for node %4S::%_>
	MOVEI T3,[ASCIZ/Remote Dismount Structure Failed/]
	CALLRET BTWTO		;[6011]Tell the operator

KNORS1:	TMCT <%IInsufficient MOUNTR resources needed to dismount
structure%3S:>
	MOVEI T3,[ASCIZ/Dismount Structure Failed/] ;
	CALLRET BTWTO		;[6011]Tell the operator
;[6011]
;MOUNTR must send a dismount ACK back to Nebula for a remote dismount
;Checks R%LOR for local or remote request.
;If the request is a remote request then this routine will check bit R%STA
;in RSBIFL and send a success or failure dismount ACK back to Nebula.  
;RSB/ request status block

NSACK:	MOVE T1,RSBIFL(RSB)	;[6031]Get the status
	TXNN T1,R%LOR		;[6031]Local request?
	RET			;[6031]Yes, no need to tell NEBULA
	MOVE T2,RSBRAC(RSB)	;[6011]Get remote ACK
	TXNN T1,R%STA		;[6011]Success or failure?
	IFNSK.
 	 CALL SUCCE		;[6011]Success
	ELSE.
	 MOVE T1,RSBERR(RSB)	;[6011]Get error type,, error code
	 CALL FAILE		;[6011]Fail
	ENDIF.
	RET	

;SUCCE builds the success ACK
;Accepts T2/ACK code

SUCCE:	MOVE T1,[.OARGC+1,,.NFDAK] ;[6011]BUILD GALAXY HEADER
	MOVE T3,T2		;[6011]ACK code
	MOVX T2,MF.NEB		;[6011]Nebula message
	CALL GALHDR		;[6011]Build the Galaxy header
	SETONE SU%NOE,TBUF+.OFLAG ;[6011]Set the success bit 
	SETZM TBUF+.OARGC	;[6011]NO ARGUMENTS
	MOVEI T1,.APORN		;[6011]MESSAGE GOING TO ORION
	CALLRET TRANG		;[6011]SEND CANCEL REQUEST TO ORION

;FAILE builds the failure ACK
;Accepts T1/error type,,error code
;	 T2/ACK Code
;Returns +1 always

FAILE:	CALL PBINIT		;[6011]Set up for creating building blocks
	MOVE T3,T2		;[6011]Ack code in T3
	HRRZM T1,T2		;[6011]Save error code for later 
	HLLM T1,TBUF+.OFLAG	;[6031]Error indicator goes here
	MOVE T1,[.ERRSZ,,.ERRBK] ;[6011]length,, error block
	DMOVEM T1,TEMPX		;[6011]Goes here
	MOVE T1,[.OARGC+3,,.NFDAK] ;[6011]BUILD GALAXY HEADER
	MOVX T2,MF.NEB		;[6011]Nebula message
	CALL GALHDR		;[6011]Build the Galaxy header
	MOVEI T1,TEMPX		;[6011]Address of .ERRBK
	CALL PBBLK		;[6011]Add it
	MOVEI T1,1
	MOVEM T1,TBUF+.OARGC	;[6011]for this message
	MOVEI T1,.APORN		;[6011]MESSAGE GOING TO ORION
	CALLRET TRANG		;[6011]SEND CANCEL REQUEST TO ORION
E%NRSB==1B0
E%BADM==1B1

MTRERR:	[ASCIZ/Insufficient MOUNTR resources/]
	[ASCIZ/Bad IPCF message/]
SUBTTL KSCD - SHOW CONFIGURATION DISK-DRIVE COMMAND FROM OPR

;RETURN: +1,	ALWAYS

KSCD:	SETOM	CFGFLG		;Set CONFIG command flag
	CALLRET	KSHD		;Use SHOW STATUS DISK code checking for flag
SUBTTL KSHD - SHOW DISK STATUS COMMAND FROM OPR

;RETURN: +1,	ALWAYS

KSHD:	SAVEQ

	SETZM DSPFLG		;Start of clean, no special messages yet
	CALL DDSCIH		;MAKE SURE TABLES UP-TO-DATE
	TMCT <%I>

;  Q3 is a flag which indicates the kind of display
;  -1=all disk drives.  0=free disk drives.  1=mounted disk drives.

	SETO Q3,		;Say it is for all drives, for now
	MOVE Q1,RBUF+.OFLAG	;GET COMMAND TYPE
	CAMN Q1,[ST.MNT]	;IS IT ASKING FOR MOUNTED DISKS?
	JRST [CALL KSHDM	;Yes, print the mounted header
		MOVEI Q3,1	;Say it is for mounted drives
		JRST KSHDA]	;Go join common stuff for STATUS
	CAMN Q1,[ST.AVA]	;WERE WE ASKED ONLY FOR FREE DRIVES?
	JRST [CALL KSHDF	;Yes, print the free header
		SETZ Q3,	;Say it is for free drives
		JRST KSHDA]	;Go join common stuff for STATUS
KSHDA:	MOVEI T1,DSKHDR		;Get common header for STATUS
	SKIPE CFGFLG		;Unless it is from CONFIG...
	MOVEI T1,CFGHDR		;Get common header for CONFIG
	TMCT <%1A>

;  Loop through all disk drives in DDB
	
KSHDA1:	MOVEI T1,.DVDSK		;Get the disk type
	MOVEM T1,DSFE+DSFTYP	;Save it in DSFE
	SETZ T1,		;Go for the first
KSHDA2:	CALL DSFGNX		;Go get an entry
	 JRST KSHDE		;No more, go do mounted disk if needed
	PUSH P,T1		;Save pointer
	SKIPN DSK,DSFE+DSFPNT	;Get disk status block address
	JRST KSHDA4		;Not there, not in use, skip this entry
	LOAD T1,MS%MNT,DSKFLG(DSK) ;Get mount bit
	SKIPN T1		;Is it mounted?
	JRST [SKIPG Q3		;No, are we asking for mounted drives only?
	       CALL WOFRE	;No, display the unit's status.
              JRST KSHDA4]	;Get the next disk drive.
	SKIPE Q3		;Are we asking for free drives?
	 CALL WOMNT		;No

;  Before we get the next disk make sure that DSFE contains the correct type

KSHDA4:	MOVEI T1,.DVDSK		;Get the disk type
	MOVEM T1,DSFE+DSFTYP	;Save it in DSFE
	POP P,T1		;Get the pointer back
	JRST KSHDA2		;Get the next

KSHDE:	CALL DSKDSP		;Print any special messages

KSHDEX:	MOVEI	T3,[ASCIZ/Disk Drive Status/]
	SKIPE	CFGFLG
	 MOVEI	T3,[ASCIZ/Disk Drive Configuration/]
	SETZM	CFGFLG		;Re-set CONFIG command flag
	CALL	BTNFO		;ASK FOR NO FORMATTING
	MOVE T4,RBUF+.MSFLG	;[6010]Get the message flag word
	TXNE T4,MF.NEB		;[6010]From NEBULA
	SETOM NEBMSG		;[6010]Yes
	CALLRET	BTACKT		;END OF DISKS, SEND STATUS TO OPR

KSHDM:	MOVEI T1,MNTHDR		;Get header for mounted drives
	SKIPA			;Only wanted mounted header
KSHDF:	MOVEI T1,FREHDR		;GET HEADER FOR MOUNTED DRIVES
	TMCT <%1A>
	RET
SUBTTL - DSKDSP - Print any special messages
;Accepts - Nothing
;Returns +1 always

DSKDSP::MOVE T1,DSPFLG		;Get the display message flag
	TXNN T1,MSG%AN		;Any disk to print 
	JRST [TMCT <%I%15CCurrently there are no free disk drives%_>
	      JRST DSKDEX]	;No
	TXNE T1,MSG%CI		;Any channel 7 CI disks?;
	CALL [TMCT <%7CNOTE: Channel 7 indicates CI channel%_>
	      RET]
	TXNE T1,MSG%DU		;Any dual ported disks
	CALL [TMCT <%7C(*) indicates potential external port%_>
	      RET]
	TXNE T1,MSG%FR		;Any free drives
	CALL [TMCTI <FREEH>
	      RET]

DSKDEX:	RET
SUBTTL KSHS - SHOW STATUS STRUCTURE command from OPR

;  Returns: +1 always

KSHS:	SAVEQ
	CALL DDSCIH		;First go update things
	SETZM DSPFLG		;Clear display flags 
	TMCT <%I>

	MOVEI T1,.STRDV		;GET BLOCK TYPE CODE
	CALL KGTSTR		;GET STRUCTURE NAME
	 SKIPA			;Not there, go do all purpose display
	JRST SHSTR		;Go display the particular structure and skip
				; this stuff

;  Q3 is a flag which indicates the kind of display
;  -1=all disk drives.  0=free disk drives.  1=mounted disk drives.

	SETO Q3,		;Say it is for all drives, for now
	MOVE Q1,RBUF+.OFLAG	;GET COMMAND TYPE
	CAMN Q1,[ST.MNT]	;IS IT ASKING FOR MOUNTED DISKS?
	JRST [CALL KSHSM	;Yes, print the mounted header
		MOVEI Q3,1	;Say it is for mounted structure
		JRST KSHSA]	;Go join common stuff
	CAMN Q1,[ST.AVA]	;WERE WE ASKED ONLY FOR FREE DRIVES?
	JRST [CALL KSHSF	;Yes, print the free header
		SETZ Q3,	;Say it is for dismounted structure 
		JRST KSHSA]	;Go to join common code



KSHSA:	MOVEI T1,STRHDR
	TMCT <%1A>
	SETZ T1,		;Go for the first one

	MOVEI T2,.DVSTR		;Get structure type
	MOVEM T2,DSFE+DSFTYP	;Set it

KSHS.0:	CALL DSFGNX		;Go get an entry
	  JRST KSHS.9		;Done
	PUSH P,T1		;Save the pointer

;  What do we want to print out

	SKIPN STR,DSFE+DSFPNT	;Structure mounted?
	JRST [SKIPG Q3		;No, are we asking for mounted drives only?
	      CALL SHWSTR	;No, display the unit's status.
	      JRST KSHS8]	;Yes, get the next
	SKIPE Q3		;Yes, Can this drive be printed
	CALL SHWSTR		;Yes, output structure status

KSHS8:	MOVEI T2,.DVSTR		;Get structure type
	MOVEM T2,DSFE+DSFTYP	;Set it
	POP P,T1		;Get back the pointer
	JRST KSHS.0		;Go for another

KSHS.9:	CALL STRDSP		;Go print any special messages


KSHSEX:	MOVEI T3,[ASCIZ/Structure Status/]
	CALL BTNFO		;No formatting
	MOVE T4,RBUF+.MSFLG	;[6010]Get the message flag word
	TXNE T4,MF.NEB		;[6010]From NEBULA
	SETOM NEBMSG		;[6010]Yes
	CALL BTACKT		;Send status
	RET			;And done
SUBTTL STRDSP - Print any special messages
;Accepts - nothing

STRDSP:	MOVE T1,DSPFLG		;Get the display message flag
	TXNN T1,MSG%AN		;Any disk to print 
	JRST [TMCT <%I%15CCurrently there are no unmounted structures%_>
	      JRST STRDEX]	;No

	TXNE T1,MSG%CO		;Conflict messge?
	CALL [MOVEI T2,CONFLI	;Get the message 
	      TMCT <%2C%2A>	;Print it
	      RET]
STRDEX:	RET
SUBTTL SHSTR - Show status for a particular structure

;Accepts - T1/Structure name in sixbit
;	 - T2 and T3/Structure name in ASCIZ

SHSTR:	SAVEQ

	DMOVEM T2,MSTAL		;Save the ASCIZ structure name
	MOVEM T1,DSFE+DSFSPC	;Save the SIXBIT structure name
	MOVEI T1,.DVSTR		;Get structure type
	MOVEM T1,DSFE+DSFTYP
	CALL DSFLOC
	 JRST [MOVEI T1,MSTAL	;No entry, must not be mounted
	      TMCT <%20CNo such Structure %1A:%_>
	      JRST SHEX]	;Go to common exit

;  Print the structure information on this structure

	MOVEI T1,STRHDR		;Get all purpose header
	TMCT <%1A>		;Add it to display
	CALL SHWSTR		;Print structure information first
	CALL STRDSP		;Go print any special messages

;  Print the disk information on this structure

	JUMPE STR,[TMCT <%_Structure is not mounted on a disk drive%_>
	      JRST SHEX]		;If structure is not mounted, all done
	CALL [TMCT <%_%10CDisk information pertaining to mounted structure>
	      RET]
	MOVEI T1,DSKHDR		;Get all purpose disk header
	TMCT <%1A>		;Add it to the display

;  Loop through all the disks on which this structure is mounted on.

	LOAD Q3,STRUNI,(STR)	;Get the number of units
	MOVNS Q3		;Negate number of units
	MOVSS Q3		;And switch halves
	HRRI Q3,STRADD(STR)	;Setup address of first disk status block

SHS.0:	MOVE DSK,(Q3)		;Get the disk address
	JUMPE DSK,SHS.01	;No DSB, try next
	MOVE T1,DSKFLG(DSK)	;Get the status of the disk
	TXNE T1,MS%MNT		;Is it mounted?
	JRST [CALL WOMNT	;Yes, display the unit's status.
	      JRST SHS.01]	;Get the next.
	CALL WOFRE		;No, display the unit's status.

SHS.01:	AOBJN Q3,SHS.0		;Get the next disk
SHS.02:	CALL DSKDSP		;Print any special messages
	JUMPLE STR,SHEX		;Structure is not mounted

;  Get list of users on structure

	MOVE T1,[POINT 7,MSTAL]	
	MOVEM T1,MSTRBK+.MSUAL	;Put alias in mstr block 
	MOVX T1,MS%GTA+MS%GTM+MS%GTC ;We want all users
	MOVEM T1,MSTRBK+.MSUFL	;Put it in mstr block 
	MOVE T1,[50,,.MSGSU]	;
	MOVEI T2,MSTRBK	
	MSTR
	 ERJMP SHSERR
	HRRZ Q1,MSTRBK+.MSUFL	;Get number of users currently using this str
	JUMPE Q1,[TMCT <There are currently no users using this structure%_>
	          JRST SHEX]	;No users all done

;  Initialize some things

	SETZM USRLST
	MOVE T1,[USRLST,,USRLST+1] ;Zero out the user list
	BLT T1,USRLST+USRSIZ-1

	MOVEI Q3,USRLST+1	;Get the beginning of the user list

	MOVEI Q2,MSTRBK+.MSUJ1	;Get the address of first user

;  Get ready to do GETJI and add users on to the list.

SHS.1:	HRRZ T1,(Q2)		;Get the job number
	MOVE T2,[-1,T4]		;Lets save the job user number in T4
	MOVEI T3,.JIUNO		;We only want the job user number
	GETJI
	 ERJMP SHSERR
	MOVEI T1,1		;Looking at the first user entry
	MOVEI T3,1		;Use T3 as an index to the current user list

;  Loop through user list to see if user already exist.

SHS.2:	CAMLE T1,USRLST		;Are we at the end of the list
	JRST SHS.3		;Yes 
	CAMN T4,USRLST+USRNUM(T3) ;Is it in the table?
	JRST SHS.4		;Yes, get the next
	AOS T1			;Increment counter
	ADDI T3,USRENT		;Go to the next entry 
	JRST SHS.2

;  User is not on list, add user

SHS.3:	HLLZ T2,(Q2)		;Get the mounted/connected/access bit
	MOVEM T2,USRBIT(Q3)	;Save it in the first word
	MOVEM T4,USRNUM(Q3)	;Save the job user number in the second word
	ADDI Q3,USRENT		;Now the next entry
	AOS USRLST		;One more user using this structure
	JRST SHS.5		;Next

;  Same user but is it the same usage

SHS.4:	LOAD T2,MS%GTM,(Q2)	;Get the mounted bit
	SKIPE T2		;Not mounted
	STOR T2,MS%GTM,USRLST+USRBIT(T3) ;Mounted, include it for this user
	LOAD T2,MS%GTC,(Q2)	;Get the connected bit
	SKIPE T2		;Not connected
	STOR T2,MS%GTC,USRLST+USRBIT(T3) ;Connected, include it for this user
	LOAD T2,MS%GTA,(Q2)	;Get the connected bit
	SKIPE T2		;Not access
	STOR T2,MS%GTA,USRLST+USRBIT(T3) ;Access, include it for this user
			
SHS.5:	AOS Q2			;Point to the next user
	SOJG Q1,SHS.1		;Jump if more

;  Check each user to see what their usages are.

	TMCT <%_Users who have MOUNTed this structure:%_>
	MOVX T3,MS%GTM		;Show users who have mounted this structure
	CALL SHSMAC		;Add users to message
	CALL [TMCT <None.%_>
	      RET]
	TMCT <%_Users who are ACCESSing this structure:%_>	
	MOVX T3,MS%GTA		;Show users who are connected to this structure
	CALL SHSMAC		;Add users to message
	CALL [TMCT <None.%_>
	      RET]
	TMCT <%_Users who are CONNECTed to this structure:%_>	
	MOVX T3,MS%GTC		;Show users who are connected to this structure
	CALL SHSMAC		;Add users to message
	CALL [TMCT <None.%_>
	      RET]

SHEX:	JRST KSHSEX		;All done

;  Error routine for JSYS when doing SHSTR
;**;[6034]At SHSERR:+0L add 1 line JYSW 11-Aug-88
SHSERR:	CALL CHECKD		;[6034]CHECKD has anything to do with this
	TMCT <%_Can't determine users using this structure because of the following error: %_%J>
	JRST SHEX		;Go to common exit
SUBTTL SHSMAC - Adds a user who has mounted or connected or accessing a structure to the SHO STA STR FOO: command.

;Accepts - T3/Usage bit (MS%GMT,MS%GTA,MS%GTC)
;Returns - +1 No users 
;	 - +2 with users added on to display

SHSMAC:	MOVE Q2,USRLST		;Get the number of users using this structure
	MOVEI Q3,USRLST+1	;Get the address of user list
	SETO T4,		;Flag to indicate whether we have a user
SHSM.1:	HLLZ T2,USRBIT(Q3)	;Get the user's usage of structure.
	AND T2,T3		;Get the bit that we are interested in 
	SKIPN T2		;If set, user belongs to this list
	JRST SHSM.6		;User does not belong to this list
	MOVE T2,USRNUM(Q3)	;Get the job user number
	HRROI T1,DIRNAM		;Put the string here
	DIRST
	 ERJMP SHSMEX
	CALL TMCNT		;Get the current location in the line
	MOVE Q1,[POINT 7,DIRNAM] ;Pointer to user name

SHSM.2:	ILDB T1,Q1		;Get the character
	SKIPN T1		;End of string
	JRST SHSM.3		;Yes, all done
	AOS T2			;Add another character
	JRST SHSM.2		;Get the next character	

SHSM.3:	MOVEI T1,DIRNAM		;Get the user name
	CAIL T2,^D78		;Can we add it to this line (78 , and space)
	JRST [TMCT <,%_%1A>	;No, start at new line
	      JRST SHSM.6]	;and continue
	SKIPE T4		;The first user?
	JRST [TMCT <%1A>	;Yes
	      SETZ T4,		;Say we have at least one user therefore
	      JRST SHSM.6]	; The next user should have a , and a space
	TMCT <, %1A>	 	;No, lets add a comma and a space to message


SHSM.6:	ADDI Q3,USRENT		;Point to the next user
	SOJG Q2,SHSM.1 		;If we have more

SHSMEX:	SKIPE T4		;Do we have at least one user?
	RET			;No 
	TMCT <.%_>		;Finish off the line
	RETSKP			;We have at least one user
SUBTTL SHWSTR - Show status for a single structure

;  Accepts: DSFE containing DDB for structure

SHWSTR:	SAVEQ

;  Q2 contains the structure status from DDB

	MOVE Q2,DSFE+DSFFLG	;Save the status flag
	MOVX T2,MSG%AN		;Get bit to say we have at least one
	IORM T2,DSPFLG		;Say we have one
	MOVE T1,DSFE+DSFSPC	;Get the alias
	TMCT <%1S >
	SKIPN STR,DSFE+DSFPNT	;Do we have SSB?
	JRST SHW0		;No, continue
	MOVE T1,STRNAM(STR)	;Get name
	TMCT <%8C%1S >
	JRST SHW0.1		;skip this if DDB has a SSB

;  Structure might have SSB but no DDB link.

SHW0:	SETZ T2,		;Don't have structure name. T1 has the alias
	SETZ T4,		;Don't have unique code
	CALL MATCHS		;Do we have a SSB for this structure
	JFCL			;No, STR should be zero

;  If STR/0 structure is not mounted, STR/less than 0 means structure is 
;  spinning or being dismounted, STR/ greater than 0 means mounted.

SHW0.1:	SKIPG STR		;Again do we have SSB?
	JRST SHW1		;No, not mounted

	MOVE Q1,STRFL1(STR)	;Get flags
	TXNN Q1,STR%MT		;Mounted?
	JRST SHW1		;No, not mounted

	TMCT <%15CMounted >

;  Print the mount count

	MOVE T2,[POINT 7,MSTAL];SET UP POINTER FOR ALIAS
	MOVEI T1,STRALI(STR)
	CALL SIXSEV		;CONVERT SIXBIT ALIAS TO NEEDED 7-BIT
	MOVEI T1,MSTAL		;Get address of alias
	CALL STRSTT		;Go get the status
;**;[6034]At SHW0.1:+13L change 1 line JYCW 11-Aug-88
	 JRST SHWSE1		;[6034]NO STRUCTURE?
	TMCT <%24C%3D>		;Print the mount count

;  Open file count field

	TMCT <%30C%4D>		;Print the open file count

SHW1:	TMCT <%35C>

	SKIPG STR		;Mounted?
	JRST SHW2		;No, no need to check for conflicting status
	CALL NEWSTA		;Get the real status
	 JFCL			;Shouldn't really happen
	XOR T1,STRFLG(STR)	;Get the changed bits

;  T1 contains the conflicting bits if structure is mounted, else there is no 
;  check for conflict.

	TXZ T1,MS%NTC		;Get rid of don't care bits

SHW2:	TXNE Q2,DSF%IG		;Ignored for real?
	JRST [TMCT <Ignored>	;Assume ignored
	      JRST SHW3]	;Skip avail/unavailable

	TXNE Q2,DSF%AV		;Unavailable for real?
	JRST [TMCT <Unavail>	;Assumption
	      JRST SHW2.1]
	TMCT <Avail>		;No 

SHW2.1:	SKIPG STR		;Mounted?
	JRST SHW3		;No

	TXNE T1,MS%DIS		;Is the available/unavailable bit in conflict?
	CALL SHWCON		;Yes print * and set bit in display flag word

SHW3:	TXNE Q2,DSF%EX		;Exclusive for real?
	JRST [TMCT <%44CExclusive> ;Assume exclusive
	      JRST SHW3.1]
	TMCT <%44CShared>

SHW3.1:	SKIPG STR		;Mounted?
	JRST SHW3.2		;No

	TXNE T1,MS%EXC		;Is the exclusive/shared bit in conflict?
	CALL SHWCON		;Yes print * and set bit in display flag word

SHW3.2:	SKIPG STR		;Mounted?
	JRST SHW3.3		;No
	MOVE T2,STRFLG(STR)	;Get flags
	TXNN T2,MS%PS!MS%BS	;[6001]Is either bit lit?
	JRST SHW3.3		;[6001]No.
	TXNE T2,MS%PS		;[6001]At least one lit. Is MS%PS lit
	TXNN T2,MS%BS		;[6001] along with MS%BS?
	IFSKP.			;[6001]If both are lit...
	  TMCT <%55C## Primary Public Str. ##> ;[6001]Both. Old message
	ELSE.			;[6001]If only one..
	  TXNN T2,MS%PS		;[6001]Is MS%PS lit?
	  IFSKP.		;[6001]If yes...
	    TMCT <%55C## Login Structure ##> ;[6001]Login Structure
	  ELSE.			;[6001]Then must be MS%BS
	    TMCT <%55C## Boot Structure ##> ;[6001]Boot structure
	  ENDIF.		;[6001]
	ENDIF.			;[6001]
	JRST SHW4		;[6001]Go to common exit

SHW3.3:	TXNE Q2,DSF%DO		;Domestic for real?
	JRST [TMCT <%55CDomestic> ;Assume domestic 
	      JRST SHW3.4]
	TMCT <%55CForeign>

SHW3.4:	SKIPG STR		;Mounted?
	JRST SHW3.5		;No, no need to check for conflict

	TXNE T1,MS%DOM		;Is the domestic/foreign bit in conflict?
	CALL SHWCON		;Yes print * and set bit in display flag word


SHW3.5:	TXNE Q2,DSF%RG		;Regulated for real?
	JRST [TMCT <%65CUnregulated>	;Assume regulated
	      JRST SHW3.6]
	TMCT <%65CRegulated>

SHW3.6:	SKIPG STR		;Mounted?
	JRST SHW4		;No
	TXNE T1,MS%NRS		;Is the regulated/unregulated bit in conflict?
	CALL SHWCON		;Yes print * and set bit in display flag word

;  Before we check for disk status, make sure there is a SSB

SHW4:	TMCT <%_>		;End the line
	TXNE Q2,DSF%DP		;[6007]DUMPABLE?
	CALL [TMCT <%4CStructure is Dumpable%_> ;[6007]Yes
	      RET]		;[6007]
	JUMPE STR,SHWSEX	;No SSB means all done
	MOVE Q1,STRFL1(STR)	;Get mount state
	TXNE Q1,STR%DT		;Is structure being dismounted
	CALL [MOVE T1,STRALI(STR) ;Get the alias
              TMCT <%4CCan't use structure %1S: - structure being dismounted%_>
	      RET]
	TXNE Q1,STR%UD		;[335]Is structure unavail due to dismount?
	TMCT <%4CStructure is set unavailable due to dismount%_> ;[335]
	TXNE Q1,STR%EP		;[335]Is str exclusive due to port operation?
	TMCT <%4CStructure is exclusive due to port operation%_> ;[335]
	TXNE Q1,STR%OB		;[6011]Dismount on behalf of another node?
	CALL [MOVE T1,STROBN(STR) ;[6011]Get "on behalf node name"
	      TMCT <%4CStructure is dismounted on behalf of %1S::%_>
	      RET]
	MOVE T1,STR		;Get the SSB address
	CALL CHKAVA		;Is the disk available/unavailable
	CALL [SKIPN T1,STRALI(STR) ;Structure might not be mounted
	      MOVE T1,STRNAM(STR) ;Use structure name
		TMCT <%4CCan't use structure %1S: - drive is unavailable for system use%_>
		RET]		
	MOVE T1,STRFLG(STR)	;[6006]Get the structure flag
	TXNE T1,MS%OFS		;[6006]Offline due to outstanding IORB?
	CALL [MOVE T1,STRALI(STR) ;[6006]Get the alias
	      TMCT <%4CCan't use structure %1S: - structure is offline%_>
	      RET]
SHWSEX:
	RET
;**;[6034]At SHWSEX:+2L add routine SHWSE1:

SHWSE1:	CALL CHECKD		;[6034]Is it mounted by CHECKD
	JRST SHW1		;[6034]No, go back and finish display
	HLRZ T1,T3		;[6034]Get the job #
	MOVEI T2,DEVX2		;[6034]Yes, get correct error code
	TMCT <%4C * %2J, Job %1O *> 	;[6034]
	RET			;[6034]All done
SUBTTL - SHWCON -- Indicates structure status conflicts


;Accepts nothing
;Returns +1 always

SHWCON: SAVET
	TMCT <*>		;Yes
	MOVX T1,MSG%CO		;Get the CONFLICT MESSAGE BIT
	IORM T1,DSPFLG		;Set it so it can be printed 
	RET

;  Routine to print the correct header

KSHSM:	MOVEI T1,MNTSTR		;Get the mounted structure header
	SKIPA			;We want mounted header not free header
KSHSF:	MOVEI T1,FRESTR		;Get the free structure header
	TMCT <%1A>
	RET
SUBTTL Process set structure (KSST) -- Initialize processing of command

;ACCEPTS: MRPDB, RBUF/ PDB AND MESSAGE FROM OPR
;	  +1,	ALWAYS

KSST:
;  Do some initial validation

	CALL DDSCIH		;MAKE SURE TABLES UP TO DATE
	MOVEI T1,.STRDV		;GET BLOCK TYPE CODE
	CALL KGTSTR		;GET STRUCTURE NAME
	 JRST KBADM		;NOT THERE, REJECT MESSAGE
				; wrong routine, calling BADOM probably better
	MOVEM T1,DSFE+DSFSPC	;Save the sixbit structure name
	DMOVEM T2,MSTAL		;STORE ASCII STRUCTURE NAME	
	MOVEI T1,.STCHR
	CALL ORNBLF		;WAS A CHARACTERISTIC SPECIFIED?
	 JRST KBADM		;NO, REJECT MESSAGE
	MOVE Q3,(T1)		;Save the characteristic for later

;  Lets see what we have in the DDB for this structure

	MOVE T1,DSFE+DSFSPC	;Get the alias back
	CALL ISTDDB		;Go try to create DDB entry based on alias
	  JFCL			;What a suprise, we already have it!
				;  DSFE now contains the correct stuff
	MOVE Q1,T1		;Save the pointer to the DDB for later

;  Update status of structure if needed

	CALL UPDSTR		;Go do it

;  Find the characteristic.

	HRLZI Q2,-CHRTL		;Form index into CHRTBL
KSST.1:	HLRZ T1,CHRTBL(Q2)	;Get characteristic
	CAMN Q3,T1		;Found characteristic?
	JRST KSST.2		;Yes, go process characteristic
	AOBJN Q2,KSST.1		;No, go try next
	JRST KBADM		;NO SUCH CHARACTERISTIC, REJECT MESSAGE
				; wrong routine, calling BADOM probably better

;  Continued on next page
SUBTTL Process set structure (KSST) -- Set the database (DDB)

;  Continued from preceeding page

KSST.2: STKVAR <SAVPNT>		;[6011]Save DDB pointer
	TMCT <%I >		;Initialize the operator message

;  Found characteristic to be set.  Check the attributes of the set with
;  existing attributes.

	MOVE T1,Q1		;Get pointer to DDB
	CALL DSFGET		;Get DDB
	  CALL STOP		;Should not happen

	MOVEM T1,SAVPNT		;Save DDB pointer
	HRRZ Q2,CHRTBL(Q2)	;Get address of attributes
	MOVE T1,(Q2)		;Get the bit
	AND T1,DSFE+DSFFLG	;Get rid of everything but the bit in question
	HLRZ T2,1(Q2)		;Get on/off flag
	SKIPE T1		;Equal to zero?
	MOVEI T1,1		;No, bit is set
	CAME T1,T2		;Compare for both on or off
	JRST KSST.3		;Not equal, need to do some setting

;  Here the characteristic is already correctly set in DDB.
;  Add error message.

	CAIE Q3,S.SHAR		;[6017]Shared?
	IFSKP.
	 MOVE T1,DSFE+DSFFLG	;[6017]Get the flag word again
	 MOVEM T1,STRFL2(STR)	;[6017]Save IT
	 JRST KSST.S		;[6017]Yes, have to do some work
	ENDIF.			;[6017]
	MOVEI T1,MSTAL		;Get structure alias
	HRRZ T2,1(Q2)		;Get ASCII attribute
	TMCT <Structure %1A already set %2A%_>
	JRST KSSEN1		;Go and finish up

;  Set new characteristic in DSFFLG, but don't write it back on disk until
;  the characteristic is set.

KSST.3:	MOVE T1,DSFE+DSFFLG	;Get the flag word again
	SKIPE T2		;Want to set the bit?
	 TDOA T1,(Q2)		;Yes, do it and skip next
	TDZ T1,(Q2)		;No, clear the bit
	MOVEM T1,DSFE+DSFFLG	;Put value back

;  Continued from previous page
;  Now want to determine the correct structure status block

	TXNE T1,DSF%IG		;Is it IGNORED?
	JRST [TMCT <Structure is currently set IGNORED.%_>
	      TMCT <Attributes will be applied when 
structure is set to ACKNOWLEDGED.%_>
	      JRST KSSEND]	;Yes
	SKIPG STR,DSFE+DSFPNT	;Do we have SSB?
	JRST KSSEND		;No.  Done.
	MOVE T1,STRFL1(STR)	;Get other structure flags
	TXNN T1,STR%MT		;Structure mounted?
	JRST KSSEND		;No.  Done.
	MOVE T2,DSFE+DSFFLG	;[6011]Get value back
	MOVEM T2,STRFL2(STR)	;[6011]Save IT
	TXNN T1,STR%UD		;Structure unavailable due to dismount?
	JRST KSST.6		;No

;  Structure is in the process of being dismounted

	CAIN Q3,S.AVAL		;Setting available?
	JRST KSSEN2		;Yes, cannot do it right now

;  Set the new strflg

KSST.6:	CALL NEWSTA		;Get the proposed STRFLG
	 JRST KSST.4		;Not mounted
	CALL STSTR		;Try to set the new strflg
	 JRST KSSERR		;Failed. find out if it was set exclusive
	JRST KSST.4		;[6011]No
;  Setting a structure from exclusive to shared
;tbd  This might not ever happened
KSST.S:	CALL UNSEXC		;Unlock the structure

;Get RSB
;[6011]

 	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	CALL PRQPID		;CLEAN UP REQUEST QUEUE FIRST

KSST.7:	CALL QMSCAN		;GET ADDRESS OF NEXT RSB
	 JRST KSST.4		;No more all done
	MOVEI RSB,-RSBLNK(T2)	;Load RSB ac
	LOAD T1,RSBTYP		;Get type
	CAIE T1,.DSEXC		;Exclusive
	JRST KSST.7		;No,, continue scan
	MOVE T1,RSBSTA(RSB)	;Get the alias
	CAME T1,STRALI(STR)	;Are they the same
	JRST KSST.7		;No, get the next
	MOVE T1,RSBIFL(RSB)	;Get request status flag
	MOVE T2,STRFL1(STR)	;Get structure status flag
	TXNN T1,R%SDM		;Did this request send a remote dismount?
	IFSKP.			;Yes,
	 TXNN T2,STR%LD		;Are there any pending dismount/remove request
	 CALL NEBCAN		;No, tell Nebula to cancel
	ENDIF.
	ABTREQ (ABRTNR)		;Delete RSB and return

KSST.4:	MOVE T1,Q1		;Get the pointer to the structure entry in DDB
	CALL DSFGET		;Get the entry
	 $STOP <Structure entry not in DDB>
	MOVE T1,STRFL2(STR)	;[6011]Get the new STRFLG
	MOVEM T1,DSFE+DSFFLG	;Put it the status word
SUBTTL Process set structure (KSST) -- Set structure correctly in monitor

;  All is done write DDB back on disk and tell operator of success.

KSSEND:	MOVE T1,Q1		;Get pointer to DDB back
	CALL DSFUDE		;Update entry
	 $STOP <Update of previously known DDB with DSFUDE failed>
	HRRZ T1,1(Q2)		;Get address of string indicating change
	MOVEI T2,MSTAL
	TMCT <Structure %2A: set %1A>

;  Here we want to output messages.

KSSEN1:	MOVEI T3,[ASCIZ/Set Structure Command/] ;Header line for message
	CALL BTACKT		;Send the message we built with TMCT
	RET
SUBTTL	SET Structure EXCLUSIVE failure.  Send remote dismount

;[6011]
;  Failed to set the new strflg characteristics.  T1 contains the attempt.
;  Check to see if the failure was due to a SET EXCLUSIVE.  If so, we have
;  to send a remote dismount to all the systems that have the structure mounted
;  
;Accepts T1/error type

KSSERR:	CAIE T1,-1		;Is the error exclusive?
	JRST KSSER		;No
	MOVEI T1,.DSEXC		;Set up exclusive switch request
	CALL OPRSB		;Get RSB
	 JRST [TMCT <%IFailed to acquire RSB for exclusive procedure>
	       MOVEI T3,[ASCIZ/Set Structure Command/]
	       CALLRET BTACKT]	;Error abort
	MOVE T1,RBUF+.MSCOD	;[6014]Get operator's PID
	MOVEM T1,RSBPID(RSB)	;[6014]Save it for later
	STOR STR,RSBSS		;[6011]Save SSB address in RSB
	SKIPE ENQFLG		;[6011]Cluster ENQ enabled?
	JRST KSSER		;No
KSSER1:	CALL GETLOC		;[6011]Lock the structure
	 JRST [CALL WHOENQ	;[6011]Failed, find out who has it
	       JRST KSSER1	;[6011]No one lets try again
	       MOVEI T3,[ASCIZ/Set Structure Command/]
	       CALLRET BTACKT]	;[6011]failed
	MOVEI T1,KSSTEX 	;[6011]Get continue address for success
	MOVEM T1,RSBCON(RSB)	;[6011]Save it
	MOVEI T1,KSSTAB		;[6014]Get continue address for abort
	MOVEM T1,RSBABO(RSB)	;[6011]Save it
	JRST SCREQ1		;[6011]Failed get cfs compliance

;Upon receiving the dismount ACK, KSSTEX will setup MOUNTR in the correct
;context.  DSFE must be setup with the correct structure DDB, Q1 must have
;the pointer to the DDB, Q2/EXCLUSIVE entry in CHRTBL, RBUF+.MSCOD contains
;the operator PID.

;Accepts RSB and STR

KSSTEX:	TMCT <%I>		;[6014]Initialize TMCMSG
	MOVE T1,RSBPID(RSB)	;[6014]Get the operator PID
	MOVEM T1,RBUF+.MSCOD	;[6014]Save it
	MOVE Q1,STRPNT(STR)	;[6014]Get address of DDB
	SKIPE T1,Q1		;[6014]Get address of DDB
	CALL DSFGET		;Setup DSFE
	 JRST KSSTE1		;[6014]Not here, must have been deleted

;  Set up Q2 to contain CHRTBL attributes

	HRR Q2,CHRTBL+3		;[6014]Get the ASCIZ for EXCLUSIVE

;RSB,STR and DSFE must be setup

	CALL NEWSTA		;Get status 
	 JRST KSSTE1		;[6014]Not mounted, clean up
	TXO T1,MS%EXC		;[6014]Lite the EXCLUSIVE bit
	CALL STSTR		;Try to set the new strflg
	 JRST [CAIN T1,-1	;Failed. find out if it was set exclusive
	       CALLRET KSSER1	;Yes, try again
	       JRST KSSER]	;[6014]No clean up

;  Finaly, we set the structure exclusive.

	CALL UNSEXC		;[6014]Unlock 
	HRR Q2,CHRTBL+3		;[6014]Get the entry for EXCLUSIVE
	JRST KSST.4		;[6014]Go join common success exit

KSSTE1: CALL UNSEXC		;[6014]Unlock 
	JRST KSST.4		;[6014]All done 	

KSSTAB:	CALL UNSEXC		;[6014]Unlock 
	RET			;[6016]Just return
SUBTTL	Error handler for SET EXCLUSIVE

KSSER:	MOVEI T2,MSTAL		;Get the alias
	HRRZ T3,1(Q2)		;Get the characteristic that failed
	TMCT <Can't set structure %2A: %3A%_>
	CALL GETERR		;Get the last error
	TMCT <- error - %1J>
	JRST KSSEN1		;Go send the message

KSSEN2:	TMCT <Dismounted currently in progress.%_>
	HRRZ T1,1(Q2)		;Get address of string indicating change	
	TMCT <Structure attribute %1A will be applied 
at completion of dismount.%_>
	JRST KSST.4		;[6014]Join common routine
SUBTTL KSST -- Data base for setable characteristics

COMMENT /
  CHRTBL contains characteristic to be changed in the left half and address
of attributes in the right half.  The first attribute is the bit in the
structure DDB flag word.  The left half of the second word indicates whether
the bit is on or off.  Finally the right half of the second attribute word
contains a pointer to the ASCIZ string describing the characteristic.
/

CHRTBL:	S.ACKN,,[DSF%IG
		0,,[ASCIZ/ACKNOWLEDGED/] ]
	S.AVAL,,[DSF%AV
		0,,[ASCIZ/AVAILABLE/] ]
	S.DOMS,,[DSF%DO
		1,,[ASCIZ/DOMESTIC/] ]
	S.EXCL,,[DSF%EX
		1,,[ASCIZ/EXCLUSIVE/] ]
	S.FORN,,[DSF%DO
		0,,[ASCIZ/FOREIGN/] ]
	S.IGNO,,[DSF%IG
		1,,[ASCIZ/IGNORED/] ]
	S.REGU,,[DSF%RG
		0,,[ASCIZ/REGULATED/] ]
	S.SHAR,,[DSF%EX
		0,,[ASCIZ/SHARED/] ]
	S.UAVL,,[DSF%AV
		1,,[ASCIZ/UNAVAILABLE/] ]
	S.UREG,,[DSF%RG
		1,,[ASCIZ/UNREGULATED/] ]
	S.DUMP,,[DSF%DP				;[6002]
		1,,[ASCIZ/DUMPABLE/] ]		;[6002]
	S.NODP,,[DSF%DP				;[6002]
		0,,[ASCIZ/NONDUMPABLE/] ]	;[6002][6003]

CHRTL==.-CHRTBL

;UNSEXC - Unlock structure due to reversing SET EXCLUSIVE

UNSEXC: MOVE T1,STRFL1(STR)	;[6011]Get flag
	TXZN T1,STR%LE		;[6011]Is it locked for set exclusive?
	IFSKP.
	 TXNN T1,STR%LD		;[6011]Yes, how about for dismount?
	 CALL RELLOC		;[6011]No, time to unlock
	ENDIF.
	MOVEM T1,STRFL1(STR)	;[6011]Restore flag
	RET
;UNDREM - Call to only  unlock a structure due to dismount/remove

UNDREM:	LOAD T2,STRDLK,STRELC(STR) ;[6011]Get the # of locks for this structure
	JUMPE T2,R		;[6014]No lock! just return
	SOJG T2,UNDRE0		;[6014]One less, any more dismount pending?
	MOVE T1,STRFL1(STR)	;[6011]No, Get flag
	TXZN T1,STR%LD		;[6011]Is it locked for dismount?
	IFSKP.
	 TXNN T1,STR%LE		;[6011]Yes, how about for set exclusive?
	 CALL RELLOC		;[6011]No, time to unlock
	ENDIF.
	MOVEM T1,STRFL1(STR)	;[6011]Update the flag word

;  no need to unlock because the are outstanding dismount/removals  pending.

UNDRE0:	STOR T2,STRDLK,STRELC(STR) ;[6011]Update lock counter
UNDRE1:	RET
SUBTTL STSTR - SeT STRucture

;  This routine sets the new structure characteristics based on T1.
;  Accepts: T1 / New STRFLG value
;	    STR / Pointer to SSB.
;	    MSTAL / Two words containing structure name in ASCII
;  Uses: MSTRST for the MSTRs needed
;  Returns: STRFLG updated in STR data base to correct state
;	    +1 on error T1/-1 for exclusive failure
;	    +2 on success

;  First we need to determine if exclusive or shared is to be set because
;  that is not set in a normal way.

STSTR::	TRVAR <NEWSTF,STRERR>	;NEWSTF - Saved T1, new structure flags
				;STRERR - Error flag.  0 if no error encounter
	SETZM STRERR		;No errors yet
	MOVEM T1,NEWSTF		;Save the new STRFLG to be

;  Do set for domestic/regulated/dismounted, but first check if it is PS:

	MOVEI T1,MSTAL		;Get address of alias
	CALL STRSTT		;Go get the status
	JRST [SETOM STRERR	;Set the error code
				;Would like to set error message
	       JRST STSTR2]	;And skip success setting 
	TXNE T1,MS%PPS		;[6001]Is this the primary public structure?
	JRST STSTR1		;Yes, only can set exclusive/share
	MOVE T1,NEWSTF		;Restore the new STRFLG to be
	TXZ T1,MS%EXC+MS%NTC	;Forget about exclusive and other bits for now
	HRROI T2,MSTAL		;Build pointer to alias
	MOVEM T2,MSTRST+.MSSSN	;Save it
	MOVEM T1,MSTRST+.MSSST	;Save the new state
	MOVX T2,MS%DIS+MS%DOM+MS%NRS+MS%DMP ;[6007]The bits that can be set
	MOVEM T2,MSTRST+.MSSMW	;Save the bits being changed
	MOVE T1,[3,,.MSSSS]	;Get block size,,function code
	MOVEI T2,MSTRST		;Get the argument block
	SKIPN TSTF		;Don't set if debugging
	MSTR
	ERJMP [SETOM STRERR	;Set the error code
				;Would like to set error message
	       JRST STSTR1]	;And try to set exclusive/shared

;  Since we have just set some bits, lets say so in STRFLG

	LOAD T1,MS%DIS,NEWSTF	;Get the new unavail/avail bit
	STOR T1,MS%DIS,STRFLG(STR) ;And save it

	LOAD T1,MS%DOM,NEWSTF	;Get the new domestic/foreign bit
	STOR T1,MS%DOM,STRFLG(STR) ;And save it

	LOAD T1,MS%NRS,NEWSTF	;Get the new unregulated/regulated bit
	STOR T1,MS%NRS,STRFLG(STR) ;And save it

;  Now to set EXCLUSIVE/SHARED

STSTR1:	MOVE T1,NEWSTF		;Get the new strflg back
	SETZ T4,		;Assume shared
	TXNE T1,MS%EXC		;Clear exclusive bit, was it set?
	MOVX T4,MS%EXC		;Yes, say we want exclusive
	HRROI T3,MSTAL		;Build pointer to alias
	MOVE T1,[2,,.MSCSM]	;Say we want to set exclusive/shared
	MOVEI T2,T3		;And where the arguments are
	SKIPN TSTF		;Don't set if debugging
	MSTR			;Try to set it
	 ERJMP [SETOM STRERR	;[6014]Set the error flag
		CALL GETERR	;[6014]Get error
		CAIE T1,MSTX48	;[6011]CFS error?
		JRST STSTR2	;[6014]No
		TXNE T4,MS%EXC	;Were we doing exclusive? 
	        MOVEI T1,-1	;[6011]Yes, set error for exclusive failure
	        JRST STSTR2]	;And skip success setting 

;  Set STRFLG to indicate change

	LOAD T1,MS%EXC,NEWSTF	;Get the exclusive stuff
	STOR T1,MS%EXC,STRFLG(STR) ;Update STRFLG

;  Here to do cleanup and analysis.

STSTR2:	SKIPE STRERR		;Any errors?
	RET			;Yes. return telling the world
	RETSKP			;All done.
SUBTTL KSUD - Undefine structure

;  This routine processes the UNDEFINE STRUCTURE command from OPR.

KSUD:	
;  Do some initial validation

	CALL DDSCIH		;Make certain tables up to date

	MOVEI T1,.STRDV		;Get block type code
	CALL KGTSTR		;Get structure name
	 JRST KBADM		;Not there, reject message

	DMOVEM T2,MSTAL		;Save the ascii name
	MOVEI T2,MSTAL		;Get the address
	TMCT <%IStructure %2A: > ;Start the message
	MOVEM T1,DSFE+DSFSPC	;Save SIXBIT structure name
	MOVEI T1,.DVSTR		;Get the structure type
	MOVEM T1,DSFE+DSFTYP	;Save it
	CALL DSFLOC		;Go try to locate this one
	 JRST [TMCT <is currently not defined> ;Not there
	       JRST KSUD.9]	;Go to the cleanup
	SKIPE DSFE+DSFPNT	;Do we have an SSB currently?
	 JRST [TMCT <cannot be undefined%_The structure is currently in use.>
	       JRST KSUD.9]	;Yes, go to the cleanup
	CALL DSFDLE		;Delete the entry
	  $STOP <Deletion of previously known DDB with DSFDLE failed>
	TMCT <deleted from data base> ;Tell of success

KSUD.9:	MOVEI T3,[ASCIZ/Undefine Structure Command/] ;Header for message
	CALL BTACKT		;Send the message we built with TMCT
	RET			;And fini
SUBTTL KSMT - Mount Structure x:/Structure-id:z: command from OPR
;KSMT - Mount a structure if possible else allow the structure to be mounted if
;       possible.

;Accepts MRPDB, RBUF/ PDB AND MESSAGE

KSMT:	CALL DDSCIH		;Update disk table
	MOVEI T1,.MNTST		;We want mount RSB
	CALL OPRSB		;Get mount RSB 
	 JRST KSMTNR		;[6011]No RSB, no mount
	MOVE T1,RSBIFL(RSB)	;[6011]Get flag word
	TXNN T1,R%LOR		;[6011]Remote or local?
	JRST KSMT0		;[6011]Local
	MOVEI T1,.NDENM		;[6011]Want node name block
	CALL ORNBLF		;[6011]Is there one?
	 JRST KBADM 		;[6011]No, bad remote mount messge
	MOVE T4,0(T1)		;[6011]Get the node name
	MOVEM T4,RSBOBN(RSB)	;[6011]Save it
	MOVE T1,RBUF+.MSCOD	;[6017]Get operator's PID
	MOVEM T1,RSBPID(RSB)	;[6017]Save it for later

KSMT0:	SETOM RSBITN(RSB)	;[6011]Indicate request is from operator
	MOVEI T1,RST.WM
	STOR T1,RSBSTE		;Set state to waiting for mount
	MOVE T1,RSBSTA(RSB)	;Alias name in T1
	MOVE T2,RSBSTN(RSB)	;Structure name in T2
	SETZ T4,		;For now no unique code
	CALL MATCHS		;Go find SSB
	 JRST [JUMPE T1,KSMTE1	;Not there, go ask to be mounted
	       JRST DUPSTA]	;More than one found

	SKIPE T2,STRPNT(STR)	;Do we have a pointer to DDB
	 JRST [TMCT <%IStructure %1S: is already mounted%_>
	       JRST KSMTEX]	;No need to do anything but tell operator
	SETZRO STR%DT,STRFL1(STR) ;Clear the being dismount bit

	LOAD T1,STRUNI,(STR) 	;No, get # of disks in str
	LOAD T2,STRMCT,(STR) 	;Get # of disk on-line in str
	CAME T1,T2		;Are all disks on-line?
	JRST KSMTE1		;No, ask operator
	CALL STRMNT		;Go mount the structure
	 JRST KSMTE2		;Can't mount structure 
	RET

KSMTE:	MOVE T1,RSBSTA(RSB)	;Alias name in T1
	MOVE T2,RSBSTN(RSB)	;Structure name in T2
	TMCT <%IStructure %2S: mounted as alias %1S:%_>
KSMTEX:	ABTREQ (ABRTNR)		;Get rid of RSB
	MOVEI T3,[ASCIZ/Mount request by operator completed/]
	CALLRET BTWTO		;Tell operator
	 	
;  Exit routines for KSMT

KSMTE1:	CALLRET WOVMS		;TELL OPERATOR TO MOUNT STRUCTURE	

KSMTE2:	MOVE T3,RSBSTA(RSB)	;Alias name in T1
	MOVE T2,RSBSTN(RSB)	;Structure name in T2
	TMCT <%ICan't mount structure %2S: (alias %3S:)
Check status of structure and disk drive.%_>
	MOVEI T3,[ASCIZ/Mount request by operator failed/]
	CALLRET BTWTO		;Tell operator of failure
;[6011]
;No RSB.  from KSMT
;RSB/1
;RBUF/MESSAGE

KSMTNR:	CAIE RSB,1		;[6014]We have a RSB
	RET			;[6011]NO, just return
	MOVEI T1,.STALS	
	CALL KGTSTR		;[6011]an alias specified?
	 JRST KBADM		;[6011]Reject message
	MOVE T2,T1		;[6011]Save alias
 	MOVE T3,T2		;[6011]Structure name same as alias for now
	MOVEI T1,.STRDV		;[6011]Get block type
	CALL KGTSTR		;[6011]Get structure name
	SKIPA			;[6011]No name use alias
	MOVE T3,T1		;[6011]Save name
	MOVEI T1,.NDENM		;[6011]Want node name
	CALL ORNBLF		;[6011]Look for it
	 JRST KBADM		;[6011]No there
	MOVE T4,0(T1)		;[6011]Save it

	MOVE T1,RBUF+.MSFLG	;[6011]Get the Galaxy flag word
	TXNN T1,MF.NEB		;[6011]Remote or local
	JRST KSMTN1		;[6011]Local

	TMCT <%IInsufficient MOUNTR resources needed to mount
structure%3S: (Alias %2S:) for node %4S::%_>
	MOVEI T3,[ASCIZ/Remote Mount Structure Failed/]
	CALLRET	 BTWTO		;[6011]Tell the operator

KSMTN1:	
	TMCT <%IInsufficient MOUNTR resources needed to mount
structure%3S: (Alias %2S:) %_%U%_>
	MOVEI T3,[ASCIZ/Mount Structure Failed/]
	CALLRET BTWTO		;[6011]Tell the operator
; Found two structures with same structure name. Need operator help. 

DUPSTA:	SKIPN T1,RSBSTN(RSB)	;Use structure name if there is one
	MOVE T1,RSBSTA(RSB)	;else use alias
	TMCT <%ICan not satisfy mount request because
there is more than one structure with 
the name %1S: online.
Structures are online on disk drives%_>
	SETZ STR,		;Start at the beginning
DUPST1:	CALL SSBNXT		;Go get the next one
	JRST DUPST7		;All done go send message
	MOVE T3,STRFL1(STR)	;Get structure state flags
	TXNE T3,STR%MT		;Is the structure mounted?
	JRST DUPST1		;Already mounted, go get next
	CAME T1,STRNAM(STR)	;Is this the one we want
	JRST DUPST1		;no, get next
	LOAD T3,STRUNI,(STR)	;Get number of disks in structure
	MOVNS T3
	HRRI T3,STRADD(STR)	;Setup address of first disk status block

DUPST2: HRRZ T4,(T3)		;Get the DSB
	JUMPE T4,DUPST3		;Get next if zero
	MOVE T2,DSKCKU(T4)	;Get the CKU
	TMCT <%7C%2K%_>		;Add it to message
DUPST3:	AOBJN T3,DUPST2		;Increment pointer 
	JRST DUPST1		;Next structure
DUPST7:	TMCT <Mount request >
	MOVE T1,RSBITN(RSB)	;Get request #
	SKIPL T1		;No request ID must be from operator
	CALL [TMCT < # %1D > 
	      RET]
	TMCT <rejected.
Please spin down conflicting structure(s)
and resubmit the mount request%_>
	MOVEI T3,[ASCIZ/Ambiguous Mount Request Detected/]
	CALL BTWTO		;Tell operator
	MOVE T2,RSBIFL(RSB)	;GET INTERNAL REQUEST FLAGS
	TXNE T2,R%OPR		;DON'T REPLY TO OPR-ORIGINATED REQUEST
	JRST [ABTRET (ABRTNR)]	;and abort 
	ABTRET (NPXAMB)		;But do tell user
SUBTTL UPDSTR - Update structure

;  This routine updates the status of a structure by comparing the state
;  of the structure as determined from the DDB and STRFLG with the state
;  of the structure determined from the monitor.

;  Accepts T1 / pointer for DDB containing structure
;	MSTAL / ascii alias contained in DSFE

;  Uses MSTRBK for MSTR call

UPDSTR:	STKVAR <INIPNT,STRSTA>	;Some locals
				;INIPNT - place to save pointer
				;STRSTA - place to save prop. structure status

	MOVEM T1,INIPNT		;Save argument
	CALL DSFGET		;Go get DDB
	  CALL STOP		;Someone lied

	SKIPN STR,DSFE+DSFPNT	;Get pointer to SSB, is there one?
	JRST UPDSEX		;No, cannot need updating

;  Now get the monitor state for the structure

	MOVEI T1,MSTAL		;Get pointer to alias
	CALL STRSTT		;Go get the state
	 JRST [CALL GETERR	;Get the error
		CAIN T1,MSTX21	;Was it not mounted?
		JRST UPDSEX	;Yes, just return for now
		MOVEI T2,MSTAL	;Get structure name
		TMCT <%IError in structure status for structure %2A, error is %1J>
		JRST UPDS.9]	;Send to all OPRs

	MOVEM T1,STRFLG(STR)	;Save the status from the MONITOR

	MOVE T1,DSFE+DSFFLG	;Get the flags
	TXNN T1,DSF%IG		;Is it ignore?

	CALL NEWSTA		;Go check on current status
	JRST UPDSEX		;Not mounted, don't need updating

;  Continued on next page
;  Continued from previous page
;  Now, do we match?

	MOVE T2,STRFL1(STR)	;Get the other structure flag
	TXNE T2,STR%UD+STR%ME	;[6011]Is it unavail due to dismount and
				;[6011]failure to exclusive as part of mount?
	TXO T1,MS%DIS		;Yes, it must be unavailable
	MOVEM T1,STRSTA		;Save the proposed structure status for a bit
	XOR T1,STRFLG(STR)	;Get the changed bits
	TXZ T1,MS%NTC		;Get rid of don't care bits
	SKIPN T1		;Has it changed?
	JRST UPDSEX		;No, all done

	MOVEI T2,MSTAL		;Get structure name
	TMCT <%IStructure state for structure %2A is incorrect%_>

	TXZE T1,MS%DOM		;Domestic bit set incorrectly?
	CALL [TMCT <  DOMESTIC/FOREIGN attribute set incorrectly%_>
	      RET]

	TXZE T1,MS%NRS		;Regulated bit set incorrectly?
	CALL [TMCT <  REGULATED attribute set incorrectly%_>
	      RET]

	TXZE T1,MS%EXC		;Exclusive bit set incorrectly?
	CALL [TMCT <  EXCLUSIVE/SHARED attribute set incorrectly%_>
	      RET]

	TXZE T1,MS%DIS		;Dismount bit set incorrectly?
	CALL [TMCT <  Available status is set incorrectly%_>
	      RET]

	TXZE T1,MS%DMP		;[6007]Dumpable bit set incorrectly?
	CALL [TMCT <  Dumpable status is set incorrectly%_>
	      RET]

	SKIPE T1		;Cleared everything?
	CALL [TMCT <  Unknown status -- word is - %1O%_> ; No
	      RET]

	MOVE T1,STRSTA		;Get new STRFLG based on DDB and disk
	CALL STSTR		;Try to update things	
	  CALL [TMCT <Unable to update structure status correctly%_> ;Thing bad
		RET]

;  Tell operator what bits were set or not set.

	MOVEI T1,MSTAL		;Get alias 
	TMCT <Status of structure %1A: is set:%_> 
	CALL STRSTT		;Go get the state
	 JRST [	MOVEI T1,MSTAL	;Get alias 
	        TMCT <Error in getting structure status for structure %1A:
error is %J%_>
		JRST UPDS.9]	;Send to all OPRs

	TXNE T1,MS%DOM		;Foreign or domestic?
	JRST [TMCT <Domestic>
	      JRST UPD1]
	TMCT <Foreign>

UPD1:	TXNE T1,MS%NRS		;Regulated on unregulated
	JRST [TMCT <, Unregulated>
	      JRST UPD2]
	TMCT <, Regulated>

UPD2:	TXNE T1,MS%EXC		;Exclusive or shared?
	JRST [TMCT <, Exclusive>
	      JRST UPD3]
	TMCT <, Shared>

UPD3:	TXNE T1,MS%DIS		;Available or unavailable?
	JRST [TMCT <, Unavailable> ;[6007]
	      JRST UPD4]	;[6007]
	TMCT <, Available>	;[6007]

UPD4:	TXNE T1,MS%DMP		;[6007]
	JRST [TMCT <, Dumpable%_> ;[6007]
	      JRST UPDS.9]	;[6007]
	TMCT <, Nondumpable%_>	;[6007]

;  Structure check message output

UPDS.9:	MOVEI T3,STRCHD		;Get structure error header
	CALL BTWTO		;Tell the operator

UPDSEX:	RET		;All done
SUBTTL Determine-new-string routine (NEWSTA) -- Determine STRFLG based on MOUNTR and disk status

;This routine determines new STRFLG(STR) based on DDB, disk drive status used 
;by this structure and structure mount status.

;Accepts - DSFE / structure DDB  (will NOT be preserved!)
;Returns - always with T1 containing the new structure status flags.
;	   +1 if structure is not mounted
;	   +2 if structure is mounted

NEWSTA::SAVEAC <Q1>			;Save some ACs
	SETZ Q1,			;Q1 contains the building STRFLG

;  Structure status DSFE+DSFFLG, lets set the corresponding bits in STRFLG 

	LOAD T1,DSF%EX,DSFFLG+DSFE	;Get the share/exclusive bit

;  This bit counts if the structure is primary PS.

	MOVE T2,DSFE+DSFPNT		;Is there a pointer to the SSB?
	JUMPE T2,NEWST0			;If no pointer, continue normal stuff

	LOAD T3,STR%EP,STRFL1(T2)	;Get exclusive due to port bit
	SKIPE T3			;Is it?
	MOVE T1,T3			;Yes, set for exclusive anyway

	MOVE T3,STRFLG(T2)		;Get the structure flags
	TXNN T3,MS%PPS			;Is it primary PS?
	JRST NEWST0			;No, continue normal stuff
	STOR T1,MS%EXC,T3		;Store the share/exclusive bit with
					;  STRFLG since nothing else changable
	MOVE T1,T3			;Move the new STRFLG over
	RETSKP				;And return only the PS case

NEWST0:	STOR T1,MS%EXC,Q1		;Save it

	LOAD T1,DSF%DO,DSFFLG+DSFE	;Get the foreign/domestic bit
	STOR T1,MS%DOM,Q1		;Save it

	LOAD T1,DSF%RG,DSFFLG+DSFE	;Get the regulate/unregulate bit
	STOR T1,MS%NRS,Q1		;Save it

	LOAD T1,DSF%AV,DSFFLG+DSFE	;Get the available/unavailable bit
	STOR T1,MS%DIS,Q1		;Save it

	LOAD T1,DSF%DP,DSFFLG+DSFE	;[6002]DOB Get the dumpable/nondumpable
	STOR T1,MS%DMP,Q1		;[6002]Save it

	SKIPG T2,DSFE+DSFPNT		;SSB?
	JRST NEWEX			;No, Can't have anything else to do
	PUSH P,T2			;Save the SSB

	MOVE T1,STRFL1(T2)		;Get other structure bits
	TXNE T1,STR%DT+STR%DE		;Structure being dismounted or error
	JRST NEWST1			;Yes, set structure as unavailable

	MOVE T1,T2			;Move over the SSB address
	CALL CHKAVA			;Go check on status based on disks
	SKIPA				;Skip if want unavailable
	JRST NEWST2			;Otherwise go to finish

NEWST1:	SETONE MS%DIS,Q1		;Set things unavailable

NEWST2:	MOVE T1,Q1			;Get the new strflg in any case
	POP P,T2			;Get the SSB
	MOVE T2,STRFL1(T2)		;Get the internal status flags
	TXNE T2,STR%MT			;Structure mounted?
	RETSKP				;Yes
	SKIPA				;Don't need to set strflg again

NEWEX:	MOVE T1,Q1			;Get the STRFLG
	RET				;And return unmounted.
SUBTTL CHKAVA - Check SSB disk drives for available/unavailable

;  Accepts: T1 / Address of SSB

;  Returns: +1 Structure is on a disk drive unavailable
;	    +2 Structure can be available

CHKAVA:	SAVEQ
	MOVE Q1,T1		;Get address of SSB

;  Set according to the disk which this structure is mounted.

	LOAD Q3,STRUNI,(Q1)	;Get the number of units
	MOVNS Q3		;Negate number of units
	MOVSS Q3		;And switch halves
	HRRI Q3,STRADD(Q1)	;Setup address of first disk status block

;  Loop through all disks belonging to this structure

CHKAV1:	MOVE T2,(Q3)		;Get the disk status block address
	JUMPE T2,CHKAV2		;No address, go try the next
	MOVE T1,DSKPNT(T2)	;Get pointer to disk DDB
	CALL DSFGET		;Get DSFE for disk	
	  CALL STOP		;Should never happen
	MOVE T2,DSFE+DSFFLG	;Get the flag bits
	TXNE T2,DSF%AV+DSF%PO	;Any reason to be unavailable?
	RET			;Yes, return unavailable

CHKAV2:	AOBJN Q3,CHKAV1		;Get the next disk address and loop back	

;  End of loop

	RETSKP			;Must be ok
SUBTTL SSB routines -- SSBINI - Initialize SSB data base

;  Returns +1 always

SSBINI:	SETZM SSBFPT		;No free entries
	MOVEI T1,STRSTB		;The bottom is the top
	MOVEM T1,SSBTOP		;And remember it
	RET


SUBTTL SSB routines -- SSBCRE - Create a new SSB entry (zeroed)

;  Returns +1 always
;		STR / address of new entry

SSBCRE:	SKIPE STR,SSBFPT	;Any already existing free entries?
	JRST [MOVE T1,STRALI(STR) ;Yes, get pointer to next free entry
	      MOVEM T1,SSBFPT	;Set it as address of free entry list
	      JRST SSBC.5]	;go to finish up
	MOVE STR,SSBTOP		;Get top as new entry
	MOVE T1,STR		;Copy of new entry address
	ADDI T1,STRSZ		;Bump to the new limit
	CAIL T1,MAXSSB		;Room for more?
	CALL STOP		;No.  Too bad
	MOVEM T1,SSBTOP		;Save the new next entry 

;  Clear new entry

SSBC.5:	MOVSI T1,0(STR)		;Setup BLT pointer
	IORI T1,1(STR)		;  to clear Structure status block
	SETZM (STR)		;Clear first word
	BLT T1,STRSZ-1(STR)	;And the rest
	RET


SUBTTL SSB routines -- SSBRET - Return SSB entry to free SSB pool

;  Accepts:	STR / Address of entry to be returned to free

;  Returns +1 always

SSBRET:	MOVE T1,SSBFPT		;Get pointer to first entry
	MOVEM T1,STRALI(STR)	;Save it
	MOVEM STR,SSBFPT	;Save new pointer to new first entry
	SETZM STRNAM(STR)	;Say entry is free
	SETZ STR,		;Clear the SSB pointer just in case
				;  someone tries to use it
	RET
SUBTTL SSB routines -- SSBNXT - Get next SSB

;  Accepts: STR / Address of the current SSB or 0 if initializing search

;  Returns: +1 if no more SSBs
;	    +2 if successful
;	    STR / Address of next SSB

SSBNXT:	SKIPE STR		;Do we have a previous?
	JRST SSBN.2		;Yes, go to bump to the next one
	MOVEI STR,STRSTB	;No.  Initialize

SSBN.1:	SKIPE STRNAM(STR)	;Is this one in use?
	RETSKP			;Yes, done
SSBN.2:	ADDI STR,STRSZ		;Bump to the next one
	CAMGE STR,SSBTOP	;Any more to look at?
	JRST SSBN.1		;Yes, go try this one
	RET			;No, no more
SUBTTL SSB routines -- MATCHS - Match request to structure (old)

; The caller determines what to match by passing arguements in T ACs.

;  Accepts:	T1 / SIXBIT structure alias
;		T2 / SIXBIT structure name
;		T4 / Unique Code
;	    +1 Unsuccessful in finding a match
;		STR /  0
;		T1  /  0 if structure not found
;		T1  / -1 if ambiguity found
;	    +2 Structure spinning
;		STR / -1,,SSB address if not mounted
;		STR /  0,,SSB address if mounted
;  Caller should check return

MATCHS:: SAVEQ			;Save the Q acs
				;Q1 will have structure Alias
				;Q2 will have structure name
				;Q3 will have successful unmounted name match
	STKVAR <UNQCOD>		;Storage for unique code
	SETZ Q3,		;No name matchs
	DMOVE Q1,T1		;Save the arguments
	MOVEM T4,UNQCOD		;Save the unique code
	SETZ STR,		;Starting place

;  Loop on all structure entries till match or run out

MATC.1:	CALL SSBNXT		;Get the next entry
	JRST MATC.8		;No more entries

;  Want to check for match with the following logic:
;  If the structure is mounted, alias matching is required.
;	if the alias matches, then so must the unique code,
;	or the request cannot be satisfied.  (ambiguous)
;  If the structure is not mounted name matching and unique code matching
;  is acceptable (The alias in SSB is invalid and should be 0)
;  But matching with a mounted structure is preferred.

	MOVE T4,STRFL1(STR)	;Get structure flags with mount flag
	TXNN T4,STR%MT		;Is this structure mounted?
	JRST MATC.3		;No, go try for match another way

;  Here if mounted

	CAME Q1,STRALI(STR)	;Match the alias
	JRST MATC.1		;No, go try for another
	SKIPN T2,UNQCOD		;Unique code provided
	JRST MATC.2		;No, check structure name
	CAME T2,STRUNQ(STR)	;Yes, do they match
	JRST MATC.1		;No, get the next
MATC.2:	SKIPE Q2		;Name provided
	CAMN Q2,STRNAM(STR)	;Yes, does it match
	JRST MATC.9		;Yes, go tell of success
	JRST MATC.7		;No, give up on this one
				;  (indicates ambiguity)

;  Loop continued on next page
;  Loop continued from previous page

;  Here if structure being examined is not mounted

MATC.3:	SKIPN T4,Q2		;Skip if structure name given
	MOVE T4,Q1		;Otherwise, match on alias against name
	CAME T4,STRNAM(STR)	;Do we have a match
	JRST MATC.1		;No, go try for another
	SKIPN T2,UNQCOD		;Unique code given?
	JRST MATC.4		;No, skip this check. 
	CAME T2,STRUNQ(STR)	;Yes, do they match?
	JRST MATC.7		;Unique code doesn't match, ambiguity

MATC.4:	JUMPN Q3,MATC.7		;If already have a name match, then go bad
				;  (Indicates ambiguity)
	SETO Q3,		;Remember this one
	HRRI Q3,(STR)		;  unmounted as it is
	JRST MATC.1		;  and continue to look for something better

;  End of loop

;  Returns:
;  Here on ambiguous return

MATC.7:	SETO T1,		;Set the problem
	SETZ STR,		;Clear the pointer
	RET

;  Here on exhausted loop

MATC.8:	SETZ T1,		;Say at least not bad
	SKIPN STR,Q3		;Any non-mount match?
	RET			;No.

;  For whatever reason, we think we succeeded

MATC.9:	RETSKP
SUBTTL ISTDDB - Initialize structure DDB

;  Accepts: T1 / Structure alias in sixbit

;  Returns: T1 / Pointer for found/created entry
;	    DSFE containing found/created entry
;	    +1 if alias already exists
;	    +2 if entry created
;	    DSFE containing entry

ISTDDB:	MOVEM T1,DSFE+DSFSPC	;Save the alias
	MOVEI T1,.DVSTR		;Get structure type
	MOVEM T1,DSFE+DSFTYP	;Set it
	SETZM DSFE+DSFPNT	;No pointer yet
	SETZM DSFE+DSFFLG	;Set for default flags
	CALL DSFCRE		;Go create
	  RET			;Already exists, what a suprise
	RETSKP			;Successfully created!
SUBTTL MESCHK - CHECK IF MESSAGE FOR STRUCTURE ALREADY SENT TO OPERATOR

;ACCEPTS:  RSB/	ADDRESS OF RSB
;RETURNS:  +1,	OPERATOR ALREADY NOTIFIED OF STRUCTURE
;	   +2,	OPERATOR NOT NOTIFIED

MESCHK:	SAVEQ
	MOVE Q1,RSBSTN(RSB)	;GET STRUCTURE NAME
	MOVE Q2,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	MOVE Q3,RSB		;SAVE ADDRESS OF RSB
	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB>
	CALL PRQPID		;CLEAN UP REQUEST QUEUE FIRST
MESCH1:	CALL NSTRSB		;GET ADDRESS OF NEXT RSB
	RETSKP			;NONE LEFT
	CAMN Q3,RSB		;IS THIS THE CURRENT RSB?
	JRST MESCH1		;YES, FORGET IT
	CAMN Q1,RSBSTN(RSB)	;SAME STRUCTURE NAME?
	CAME Q2,RSBSTA(RSB)	;YES, SAME ALIAS?
	JRST MESCH1		;NO, TRY NEXT RSB	
	MOVE T1,RSBIFL(RSB)	;SEE IF OPR TOLD ABOUT THIS ONE
	TXNN T1,R%ONR		; 
	JRST MESCH1		;NO, DO NOT STOP HERE
	RET			;SAME NAME AND ALIAS
SUBTTL MNTALL - MOUNT ALL STRUCTURES NOT ALREADY MOUNTED

;ACCEPTS:  NOTHING
;RETURNS:  +1,	ALWAYS

MNTALL:	CALL GORSB		;Create a fake RSB since everything else
				;  depends on it
	JFCL			;Got the last one

;  loop on all the structures around

	SETZ STR,		;Start at the beginning
MNTNXT:	CALL SSBNXT		;Go get the next one
	JRST [ABTRET (ABRTNR)]	;No more.  Get rid of RSB and return
	MOVE T1,STRFL1(STR)	;Get structure state flags
	TXNE T1,STR%MT		;Is the structure mounted?
	JRST MNTNXT		;Already mounted, go get next
	MOVE T1,STRFLG(STR)	;Get the structure flags
	TXNE T1,MS%PPS		;Public structure?
	JRST MNTNXT		;Public structure, go get next

	LOAD T1,STRUNI,(STR)	;Get number of disks in structure
	LOAD T2,STRMCT,(STR)	;Get number of disks on-line
	CAME T1,T2		;Is it all there?
	JRST MNTNXT		;No, go get next one
	PUSH P,STR		;Save the SSB we are working at
	SETZ T1,		;No alias
	MOVE T2,STRNAM(STR)	;Get structure name
	MOVEM T2,RSBSTA(RSB)	;Alias of structure will be physical name
	SETZ T4,		;No unique code
	CALL MATCHS		;Find SSB
	JRST MNTNX2		;Skip mount if more than one str with that name
	CALL STRMNT		;Mount the structure
	  JFCL			;Failed for some reason, who cares
MNTNX2:	POP P,STR		;Restore the SSB
	JRST MNTNXT		;Go try for the next one
SUBTTL OPRSB - SET UP REQUEST BLOCK FOR OPR MOUNT OR DISMOUNT COMMAND

;ACCEPTS: T1/	REQUEST TYPE (.MNTST,.DSMST, .PTSET, .SETST)
;	  MRPDB, RBUF/ PDB AND MESSAGE FROM OPR IPCF REQUEST

;RETURNS: +1,	FAILURE.  RSB/1
;	  +2,	SUCCESS, RSB/ ADDR OF REQUEST STATUS BLOCK

OPRSB::	CALL GORSB		;GET A STATUS BLOCK FOR REQUEST
	 JRST [MOVEI RSB,1	;[6011]No RSB's available, set RSB to 1
	       RET]		;[6011]Take error return
	MOVE T1,RBUF+.MSFLG	;[6011]Get the Galaxy header flag word
	TXNN T1,MF.NEB		;[6011]Is the request from Nebula (remote)?
	JRST OPRSB0		;[6011]No need to get node name

;  Remote request must have a node block

	SETONE R%LOR,RSBIFL(RSB);[6011]Yes, say so in the RSB
	TXNE T1,MF.WTO		;Want WTO?
	SETONE R%WTO,RSBIFL(RSB) ;Yes, remember to send WTO to NEBULA
	MOVE T1,RBUF+.MSCOD	;[6011]Get the ACK code
	MOVEM T1,RSBRAC(RSB)	;[6011]Store it for return message
	MOVEI T1,.NDENM		;[6011]Want node name block
	CALL ORNBLF		;[6011]Is there one?
	 JRST OPRSBE		;[6011]No go to error routine
	MOVE T4,0(T1)		;[6011]Get the node name
	MOVEM T4,RSBOBN(RSB)	;Save it

OPRSB0:	MOVEI T1,.STRDV		;GET BLOCK TYPE
	CALL KGTSTR		;GET STRUCTURE NAME
	SKIPA			;Not there, lets try alias
	MOVEM T1,RSBSTN(RSB)	;STORE SIXBIT STRUCTURE NAME IN RSB
	MOVEI T1,.STALS	
	CALL KGTSTR		;WAS AN ALIAS SPECIFIED?
	 JRST [	SKIPE T1,RSBSTN(RSB) ;No alias, how about structure name?
		JRST OPRSB1	;We have a structure name but no alias
	        JRST OPRSBE]	;[6011]Bad message from NEBULA
	SKIPN RSBSTN(RSB)	;Do we have a structure name?
	MOVEM T1,RSBSTN(RSB)	;No, lets use the alias
OPRSB1:	MOVEM T1,RSBSTA(RSB)	;YES, STORE IT IN RSB
	MOVE T1,MRPDB+.IPCFS	;GET PID OF SENDER
	MOVEM T1,RSBPID(RSB)	;STORE IN RSB
	MOVEM T1,MUTLBK+1
	MOVEI T1,.MUFOJ		;GET SENDER'S JOB NUMBER
	MOVEM T1,MUTLBK
	MOVEI T1,3		;3 WORDS IN ARGUMENT BLOCK
	MOVEI T2,MUTLBK		; WHICH IS MUTLBK
	MUTIL
	 JRST [	ABTRET (ABRTNR)] ;SOMETHING HAPPENED TO REQUESTER
	MOVE T1,MUTLBK+2	;GET JOB NUMBER
	STOR T1,RSBJNO
	MOVE T2,[-1,,T4]	;GET USER NUMBER
	MOVEI T3,.JIUNO
	GETJI
	 JRST [	ABTRET (ABRTNR)] ;SOMETHING HAPPENED TO REQUESTER
	MOVEM T4,RSBUNO(RSB)	;STORE USER NUMBER
	RETSKP

;  Error routine when MOUNTR receives a bad message from NEBULA

OPRSBE: ABTREQ (ABRTNR)		;[6011]No, abort the request
	MOVX T1,E%NEB		;[6011]Error code=NEBULA error
	TXO T1,FA%NER		;[6011]Set bit NEBULA error
	MOVE T2,RSBRAC(RSB) 	;[6011]Need ACK code 
	MOVE T3,RSBIFL(RSB) 	;[6011]Get flag
	TXNN T3,R%WTO		;[6011]Just send WTO?
	CALL FAILE		;[6011]No, send ACK first
	JRST KBADM		;[6011]Then tell local operator
SUBTTL PSDR - PARSE OPERATOR RESPONSE TO DISMOUNT MESSAGE WHEN OTHER JOBS
;	USING STRUCTURE

;ACCEPTS: T1/	ADDRESS OF ASCIZ RESPONSE TEXT
;	  RSB/	ADDRESS OF REQUEST STATUS BLOCK

;RETURNS: +1,	ERROR DETECTED WHILE PARSING RESPONSE, OPERATOR TOLD
;	  +2,	SUCCESSFUL PARSE
;		IF ANSWER IS YES, T1/	0
;		IF ANSWER IS NO,  T1/	-1

PSDR::	CALL COMNDI		;INITIALIZE FOR COMND JSYS
	MOVEI T2,[FLDDB.(.CMKEY,,PSDKT)] ;SETUP FOR KEYWORD PARSE
	CALL COMNDX		;PARSE KEYWORD
	 JRST [	MOVEI T1,[ASCIZ/Response must be YES or NO/]
		CALLRET RSPERR]	;DIDN'T SAY YES OR NO, GIVE ERROR
	HRRZ T1,(T2)		;GET 0 FOR NO, 1 FOR YES
	SOJA T1,RSKP		;RETURN -1 FOR NO, 0 FOR YES

PSDKT:	PSDKTL,,PSDKTL
	[ASCIZ/NO/],,0
	[ASCIZ/YES/],,1
PSDKTL==.-PSDKT-1
SUBTTL SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT

;ACCEPTS: T1	POINTER TO ASCIZ STRING
;	  T2	ADDRESS OF WORD IN WHICH TO STORE 6-BIT STRING

;RETURNS: +1, ALWAYS

SEVSIX:	SAVET			;[6010]Save T ACs
	HRLI T2,(POINT 6,0)	;SET UP SIXBIT POINTER
	SETZM (T2)		;CLEAR THE DESTINATION WORD
	MOVEI T4,6		;MAXIMUM OF 6 CHARACTERS

;LOOP OVER CHARACTERS

SEVLOP:	ILDB T3,T1		;GET 7-BIT CHARACTER
	JUMPE T3,R		;RETURN IF END OF STRING
	CAIL T3,"a"		;IS IT LOWER CASE?
	TRZ T3,40		;MAKE SURE IT IS UPPER CASE
	SUBI T3,40		;CONVERT TO 6-BIT
	IDPB T3,T2		;STORE CHARACTER
	SOJG T4,SEVLOP		;JUMP IF MORE CHARACTERS
	RET

SUBTTL SIXSEV - ROUTINE TO CONVERT SIXBIT TO ASCIZ

;ACCEPTS: T1	ADDRESS OF WORD CONTAINING SIXBIT CHARACTERS
;	  T2	POINTER TO WORDS FOR STORING ASCIZ STRING (2 WORDS)

;RETURNS: +1, ALWAYS

SIXSEV::SAVET			;[6010]Save T ACs
	HRLI T1,(POINT 6)	;SET UP BYTE POINTER FOR SIXBIT WORD
	MOVEI T4,6		;MAXIMUM OF 6 CHARACTERS

;LOOP OVER CHARACTERS

SIXLOP:	ILDB T3,T1		;GET CHARACTER
	JUMPE T3,SIXEND		;IF ZERO, THEN END OF STRING
	ADDI T3,40		;MAKE 7-BIT
	IDPB T3,T2		;STORE WORD
	SOJG T4,SIXLOP		;JUMP IF MORE CHARACTERS
SIXEND:	ADDI T4,4		;ZERO OUT REST OF WORD(S)
	SETZ T3,
	IDPB T3,T2		;DEPOSIT ZERO
	SOJG T4,.-1		;JUMP BACK IF MORE CHARACTERS
	RET
SUBTTL STRDMT - DISMOUNT A STRUCTURE (OPR>DISMOUNT STRUCTURE FOO:)
;	  This is the superior dismount routine.  It calls the appropriate 
;	  routines to do the task.

;ACCEPTS: RSB/	ADDR OF REQUEST STATUS BLOCK
;	  MSTAL/ ASCIZ ALIAS OF STRUCTURE
;	  STR/ STRUCTURE STATUS BLOCK

;RETURNS: +1,	ALWAYS

STRDMT: 

;  First, make sure we are allowed to dismount structure.

	MOVE T1,STRPNT(STR)	;Get the pointer to the DDB
	CALL DSFGET		;Go find it
	 $STOP <TRYING TO DISMOUNT A STR THAT DOESN'T HAVE A STRUCTURE ENTRY IN DDB>
	MOVE T1,DSFE+DSFFLG	;Get the status flag
	TXNE T1,DSF%IG		;Is it IGNORED?
	JRST [MOVEI Q1,MREQ27	;Yes, get the error code
	      MOVE T1,STRALI(STR) ;Get the alias
	      TMCT <%ICan't dismount structure %1S:-%5J%_%U%_>
              MOVEI T3,[ASCIZ/Dismount Structure Failed/]
	      CALL BTWTO	;SEND MSSG TO OPERATORS
	      ABTREQ (MREQ27)	;[6031]Abort the dismount request
	      TXO Q1,FA%TER	;[6011]Monitor error
	      MOVEM Q1,RSBERR(RSB) ;[6011]Save it
	      SETONE R%STA,RSBIFL(RSB) ;[6031]Set status of request as fail
	      JRST STREXT]	;[6011]Go to common failure exit

;  Are we in the middle of a dismount for this structure and is it from OPR

	MOVE T2,RSBIFL(RSB)	;Get the request status flag
	TXNN T2,R%LOR		;[6011]From Nebula?
	TXNN T2,R%OPR		;No, local OPR request?
	JRST STRDM0		;From Nebula, go do the dismount
	MOVE T1,STRFL1(STR)	;Get the structure status
	TXNN T1,STR%UD		;Are we already dismounting?
	JRST STRDM0		;No, go dismount structure 
	
;  Tell operator we are already dismounting this structure

	MOVE T1,STRALI(STR) 	;Get the alias
        TMCT <%IStructure %1S: is already in the process of being dismounted%_%U%_>
        MOVEI T3,[ASCIZ/Dismount Structure Aborted/]
	CALL BTACKT		;Send message to operator

	ABTREQ (ABRTNR)		;[6011]Abort rsb with no reply to operator
	JRST STREXT		;[6011]Common exit

;  Start procedures for dismount.

STRDM0:	CALL STRSET		;Set up for dismount
	JRST STRER1		;An error or some one connected to str
STREX0:	MOVE T1,RSBIFL(RSB)	;Get the flag word
	TXNE T1,R%RNR		;Is it remove
	SKIPA			;yes, but is it CFS?
	JRST STRDMC		;No remove specified go to dismount
	SKIPN CFSB		;Is it CFS system?
	JRST STRDMC		;No, just go dismount str
	SKIPE ENQFLG		;[6011]Yes, but is Cluster ENQ enabled?
	JRST STREX2		;[6011]No, do it the old way
STREX1:	CALL GETLOC		;[6011]Lock the structure
	 JRST [CALL WHOENQ	;Failed, find out who has it
	       JRST STREX1	;No one lets try again
	       MOVEI T3,[ASCIZ/Dismount Status/]
	       CALL BTWTO
	       CALL STSTBK
	       JRST STREXT]	;[6011]failed
STREX2:	MOVE T3,[POINT 7,MSTAL]	;Get pointer to alias of str
	MOVX T4,MS%EXC		;say we want it exclusive
	MOVE T1,[2,,.MSCSM]	;Get length,,function
	MOVEI T2,T3		;Get the address of the arguments
	SKIPN TSTF		;Skip if debugging
	MSTR			;Go try to set exclusive
	 ERJMP [CALL GETERR	;[6011]Get the error
	        CAIE T1,MSTX48 ;[6011]CFS access error?
		JRST STEXER	;[6011]No, abort the dismount
		MOVEI T1,STREX2 ;[6012]Get continue address for success
	        MOVEI T2,STREXT ;[6011]Get continue address for abort
		MOVEM T1,RSBCON(RSB) ;[6011]Save it
		MOVEM T2,RSBABO(RSB) ;[6011]Save it
		JRST SCREQ1]	;[6011]Failed get cfs compliance
STRDMC:	CALL STRDMS		;Dismount the str
	CALLRET DISFAL		;An error, tell operator what happened
	CALL NSACK		;[6011]Tell NEBULA or not?
	CALL WOVDS		;Tell operator to remove or not to remove
	SETZM STRNDM(STR)	;Set number of pending dismounts to zero

;  Just dismounted a structure, Do we have any more dismount queries for this 
;  structure.  Loop through all RSB and kill outstanding WTORs

 	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB,DSK>
	CALL PRQPID		;CLEAN UP REQUEST QUEUE FIRST

STRDRB:	CALL NSTRSB		;GET ADDRESS OF NEXT RSB
	 RET			;NONE LEFT
	SKIPE T1,RSBSUP(RSB)	;Is this a dismount due to port operation
	JRST STRDR2		;Yes, leave it alone!!
	LOAD T1,RSBTYP		;Get the type
	CAIE T1,.DSMST		;Is it a dismount?
	JRST STRDR2		;No
	MOVE T1,RSBSTA(RSB)	;Yes, get alias in request
	CAME T1,STRALI(STR)	;Is it same as dismounted structure? 
	JRST STRDR2		;No
	SKIPN T2,RSBSTN(RSB)	;Yes, do we have a structure-id?
	JRST STRDR1		;No, one more check
	CAME T2,STRNAM(STR)	;Yes, is it the same as dismounted structure?
	JRST STRDR2		;No
STRDR1:	SKIPE T1,RSBWTB+WTBCOD(RSB) ;Do we have ack code?
 	CALL CANWTR		;Yes, Get rid of WTOR for this RSB
STRDR2:	JRST STRDRB		;Get the next one

;STEXER - Routine to handle set exclusive error when doing a dismount/removal
;that is not MSTX48.

STEXER:	CALL SAVERR		;[6011]Report the error
	CALL STSTBK		;[6011]Set the structure back
	CALLRET DISFAL		;[6011]Abort the dismount
SUBTTL GETLOC - Obtain a structure lock for dismount/removal or set/exec

;[6011]
;GETLOC - Routine to lock the structure for setting a structure exclusive due
;to the SET or DISMOUNT/REMOVE commands.  This routine only locks a structure
;once and updates STRFL1 (bits STR%LE and STR%LD) to indicate why it is locked.
;Also, STRDLK is incremented for DISMOUNT/REMOVE to indicate how many dismounts
;are pending.
;The resource name is the structure unique code
;plus an arbitrary ASCIZ string.  Cluster ENQ at this point must be enabled.
;If cluster ENQFLG is set (cluster ENQ is disabled) then there means that we
;are running a pre 7 monitor.
;Accepts RSB and STR
;T4 is only used as a counter for the number of locks in this routine.  Do not
;use T4 for anything else.
;Returns ENQBLK
;	+1 failed to lock. Error code in T1
;	+2 Success

GETLOC:	LOAD T4,STRDLK,STRELC(STR) ;[6011]Get the number of locks
	MOVE T1,STRFL1(STR)	;[6011]Get flag
	SKIPG T4		;No need to lock if already locked for dismount
	TXNE T1,STR%LE		;or lock for set exclusive
	JRST GETLO1		;No need to lock

;Build header

	MOVE T1,[20001,,6]	;Header length,# resource block,,length
	MOVEM T1,ENQBLK+.ENQLN  ;Into arg block
	SETZM ENQBLK+.ENQID	;No PSI and no ID

;Build request block

	MOVX T1,EN%BLN+EN%NST	;Ignore level number and allow nesting
	HRRI T1,-2		;Only allow locking by this job
	MOVEM T1,ENQBLK+.ENQLV	;Say so in arg block
	MOVE T1,STRUNQ(STR)	;Structure unique code
	MOVEM T1,RESPRE		;Resources prefix
	HRROI T1,RESPRE		;Make it a pointer
	MOVEM T1,ENQBLK+.ENQUC	;Add it to arg block
	SETZM ENQBLK+.ENQRS	;Only one resource
	SETZM ENQBLK+.ENQMS	;Save it
	MOVEI T1,.ENQAA		;Get function code
	MOVEI T2,ENQBLK		;Address of argument block
	SKIPN TSTF		;Debugging?
	ENQ%			;No, get the lock
	 ERJMP R		;Error
GETLO1:	SETONE R%LOC,RSBIFL(RSB) ;This request locked the structure
	LOAD T1,RSBTYP		;Get the type
	CAIE T1,.DSMST		;Dismount?
	IFSKP.			
	 SETONE STR%LD,STRFL1(STR) ;Lock for dismount
	 AOS T4			;Add one more
	 STOR T4,STRDLK,STRELC(STR) ;Store it 
	ELSE.
	 SETONE STR%LE,STRFL1(STR) ;No, then it must be exclusive
	ENDIF.
	RETSKP			;Got it

;RELLOC - Release the structure lock
;RELLOC is called when:
;A structure goes offline and is not mounted.
;A structure is set from exclusive to shared.
;A dismount/remove is canceled.
;Operator aborts a dismount/remove request.
;
;Accepts STR/
;Return +1 always

RELLOC:	SAVET			;Save T ACs

;Build header

	MOVE T1,[20001,,6]	;Header length,# resource block,,length
	MOVEM T1,ENQBLK+.ENQLN  ;Into arg block
	SETZM ENQBLK+.ENQID	;No PSI and no ID

;Build request block

	MOVX T1,EN%BLN+EN%NST	;Ignore level number and allow nesting
	HRRI T1,-2		;Only allow locking by this job
	MOVEM T1,ENQBLK+.ENQLV	;Say so in arg block
	MOVE T1,STRUNQ(STR)	;Structure unique code
	MOVEM T1,RESPRE		;Resources prefix
	HRROI T1,RESPRE		;Make it a pointer
	MOVEM T1,ENQBLK+.ENQUC	;Add it to arg block
	SETZM ENQBLK+.ENQRS	;Only one resource
	SETZM ENQBLK+.ENQMS	;No mask
	MOVEI T1,.DEQDR		;Get function code
	MOVEI T2,ENQBLK		;Address of argument block
	SKIPN TSTF		;Debugging?
	DEQ%			;No, get the lock
	 ERCAL RELOC1		;Error
	SETZRO STR%LE+STR%LD,STRFL1(STR) ;Clear lock for dismount/set exclusive
	RET			;All done

;Error handling routine for RELLOC
;T1/DEQ error code

RELOC1:	CAIE T1,ENQX7		;No ENQ on this lock
	$STOP <DEQ error in RELLOC >
	RET

;WHOENQ - Called when an ENQ (function .ENQAA) fails to lock a structure
;resource.  WHOENQ Checks for error code ENQX6 to see if it is already locked
;by another system then calls WHOEQC to find the node that has the lock.
;WHOEQC returns in T1 the SIXBIT node name
;WHOENQ builds the message why it couldn't lock the structure
;Accepts T1/ERROR CODE
;       STR/structure status block
;returns +1 No one has it locked
;	 +2 Someone has it or some other ENQ error.

WHOENQ:	CAIE T1,ENQX6		;Already locked?
	JRST [MOVE T2,STRALI(STR);Some other error.  Get the structure name
	      TMCT <%IUnable to lock structure %2$:%_Reason - %1J%_>
	      JRST WHOEN3]	;Add header
	CALL WHOEQC		;Who has it
	 RET			;No one
	SETONE R%STA,RSBIFL(RSB) ;Set status of request as fail
	MOVE T2,STRALI(STR)	;Get the name
	TMCT <%IUnable to lock structure %2S:
Structure %2S: is in the process of being DISMOUNTED with REMOVAL or
SET EXCLUSIVE by node %1S::%_> ;[6020]T1 contains  node name from WHOEQC
WHOEN3:	RETSKP			;No one has it

;WHOEQC - Routine to find out which system in the cluster has locked a
;particular structure resource via the ENQC JSYS.  Since the ENQC JSYS only
;returns the job number, WHOEQC will call GCNFIG to get the CI node number of
;each system in the cluster and do a INFO (function GETJI) on each node to find
;out if the job number belongs to this node.  If it is found WHOEQC returns
;back to the caller the node name in T1.
;Accepts STR
;	 ENQBLK set up
;Returns +1 no one has it
;	 +2 T1/sixbit node name

WHOEQC:	STKVAR <TEMP>		;Allocate space for job number and node name

;Build header

	MOVE T1,[20001,,6]	;Header length,# resource block,,length
	MOVEM T1,ENQBLK+.ENQLN  ;Into arg block
	SETZM ENQBLK+.ENQID	;No PSI and no ID

;Build request block

	MOVX T1,EN%BLN+EN%NST	;Ignore level number and allow nesting
	HRRI T1,-2		;Only allow locking by this job
	MOVEM T1,ENQBLK+.ENQLV	;Say so in arg block
	MOVE T1,STRUNQ(STR)	;Structure unique code
	MOVEM T1,RESPRE		;Resources prefix
	HRROI T1,RESPRE		;Make it a pointer
	MOVEM T1,ENQBLK+.ENQUC	;Add it to arg block
	SETZM ENQBLK+.ENQRS	;Only one resource
	SETZM ENQBLK+.ENQMS

;Do ENQC

	MOVEI T1,.ENQCS		;Function code
	MOVEI T2,ENQBLK		;Arg block
	MOVEI T3,ENQCBK		;Return Info goes here
	ENQC%			;Get the node that has the structure locked
	 ERJMP STOP		;(tbd)
	MOVE T1,ENQCBK		;Get the flag and job number 
	TXNN T1,EN%QCE		;Any errors?
	IFSKP.			;Yes
	 HRRZS T1		;Get error code
	 CAIE T1,ENQX7		;No ENQ on this lock?
	  $STOP <ENQC JSYS failed at WHOEQC:>
	 RET			;No one has it
	ELSE.
	 CAIN T1,-1		;Lock is not owned?
	 RET			;That's right
	 HRR T1,ENQCBK		;Get the job number
	 HRRZM T1,TEMP		;[6020]Save job number
	ENDIF.
	CALL GCNFIG		;Get node and CI number
	SOJLE T3,R		;No one has it

;  Who has it.  Use INFO% (GETJI) to find out who has it.

	MOVEI T4,2		;Start at the second CI-node number
WHOEQ1:	HLRZ T1,NUMBLK(T4)	;Get the CI-node number
	MOVEM T1,INFBLK+.INCID	;Store it in INFO arg block
	MOVE T1,[.INGJI,,.INAC3+2] ;Function,,Length
	MOVEM T1,INFBLK+.INFUN	;Store it 
	MOVE T1,TEMP 		;job number
	MOVEM T1,INFBLK+.INAC1	;Store it in INFO block	
	MOVE T1,[-2,,TEMPX]	;Just want to see if its there
	MOVEM T1,INFBLK+.INAC2	;Address goes here 
	SETZM INFBLK+.INAC3	;Start at the beginning
	MOVEI T1,INFBLK		;
	INFO%
	 ERJMP [AOS T4		;Not this node
		SOJN T3,WHOEQ1	;Get the next node
		RET]		;No one has it
	TXNN T1,IN%RER		;INFO% encounter a remote error?
	SKIPGE TEMPX		;Does the job belong to this node?
	JRST WHOEQ2		;Get the next node
	MOVE T1,NAMBLK(T4)	;Yes, get pointer to node
	MOVEI T2,TEMP		;Store node name here
	CALL SEVSIX		;Convert to SIXBIT
	MOVE T1,TEMP		;Return it in T1
	RETSKP

WHOEQ2:	AOS T4			;Not this node
	SOJN T3,WHOEQ1		;Get the next node
	RET
;Failure exit point
;Accepts RSB

STREXT:	CALL UNDREM		;[6011]UNLOCK?
	CALL NSACK		;Remote, tell Nebula
	RET			;Lets continue
	
;STRSET - Set up for dismount. 
;	  This routine sets the status of a structure and indicates whether
;	  an error has occurred.
;  For local dismounts:
;  If the structure is in used, a dismount query will be sent to the operator.
;  For remote dismounts:
;  It will not check for structure use

;ACCEPTS RSB and STR already setup
;RETURNS +1 If error occurs LSTERR contains error code
;	  or LSTERR is zero indicates user is connected or files open.
;	 +2 Ready to continue to dismount.

STRSET::SETZM LSTERR
	MOVEI T1,MSTAL		;Get address of alias string
	CALL STRSTT		;Try to get the status
;**;[6034]At STRSET:+4L change 1 line JYCW 11-Aug-88
	 JRST STRSE1		;[6034]Couldn't get status, why??
	TXNE T1,MS%PPS		;Is this the primary public str?
	JRST [	MOVEI T1,MSTX24 ;Say it is a ps:
		MOVEM T1,LSTERR	;Save the error
		RET]
	SETZ T2,		;Clear
	TXNE T1,MS%DIS		;Is this str unavailable
	MOVEI T2,1		;Yes, set the bit
	STOR T2,MS%DIS,STRFLG(STR) ;Store it
	CALL STRUNA		;Set it unavailable
	CALLRET SAVERR		;Error return back
	MOVEI T1,MSTAL		;Get address of alias string again
	CALL STRSTT		;Get the status again
	 JRST SAVERR		;Go get the error
	SETONE STR%UD,STRFL1(STR) ;Say it is unavailable due to dismount
	MOVE T1,RSBIFL(RSB)	;[6011]Get Local or remote bit
	TXNE T1,R%LOR		;[6011]Remote?
	RETSKP			;[6011]Yes, no need to query the operator
	AOS STRNDM(STR)		;[335]Up the # of dismount requests
	SKIPN T3		;Has anyone mounted this str?
	SKIPE T4		;No, are any files open?
	SKIPA			;Yes
	RETSKP			;No one connected & no files open

; WHILE WE WAIT FOR OPERATOR RESPONSE ALLOW OTHERS TO USE STRUCTURE
	MOVE T1,STRFLG(STR)	;Get the previous status
	TXNE T1,MS%DIS		;Was it unavailable
	RET			;Yes leave it unavailable
	CALL STRAVA		;Set it available
	CALLRET SAVERR		;Error in LSTERR
	RET			;No errors but someone is connected.

;**;[6034]At STRER1:-1L add routine STRSE1
;STRSE1 is called from STRSET to see whether the call to STRSTT failed due
;to MSTX21.  If it is then CHECKD might have mounted it behind MOUNTR's back.

STRSE1:	CALL GETERR		;[6034]Get the last error
	MOVEM T1,LSTERR		;[6034]Save the error
	CAIE T1,MSTX21		;[6034]Is it str not mounted?  
	JRST SAVERR		;[6034]No, give error 
	CALL CHECKD		;[6034]yes, Who has it?
	JRST SAVERR		;[6034]No one.
	HLRZ T4,T3		;[6034]Get job #
	MOVEI T3,DEVX2		;[6034]Get correct error code
	MOVE T1,STRNAM(STR)	;[6034]Get the structure name
	MOVE T2,STRALI(STR)	;[6034]Get the structure alias
	TMCT <%IProblem with structure %1S: (Alias %2S:)%_%3J, Job %4O>
	MOVEI T3,[ASCIZ/Dismount Structure Failed/]
	CALLRET BTWTO		;[6034]Send mssg to operators
		
;**;[6034]Add routine CHECKD
;check whether if a structure is mounted by CHECKD or not
;Calls with MSTAL/structure alias name in ASCIZ
;returns +1 not assign to another job 
;	 +2 assigned to another job probably running CHECKD
;	Ac 3 /job #,,-1

CHECKD:	HRROI T1,MSTAL		;[6034]Point to ASCII alias
	STDEV			;[6034]Get device designator
	 ERJMP R		;[6034]Error no such device?
	MOVE T1,T2		;[6034]device designator in T1
	DVCHR			;[6034]Get the characteristic
	 ERJMP R		;[6034]Error, no such device
	HRRZ T1,T3		;[6034]Get the right half
	CAIE T1,-1		;[6034]Is it already assign to another job?
	RET			;[6034]No, return no one has it
	RETSKP			;[6034]Yes, someone has it

;STRER1 - Check to see if we have an error
;	 or if we need to ask operator what to do

STRER1: SKIPE LSTERR		;Any errors 
	CALLRET DISFAL		;Yes, tell operator what happened
STRER2:	MOVEI T1,STRER3		;Get end-action address
	CALLRET WRDSC		;Ask operator if ok to process request
STRER3:	MOVEI RSB,-RSBWTB(T2)	;Load rsb ac
	LOAD STR,RSBSS		;Get structure status block again
	CALL PSDR		;Parse operator response
	 JRST STRER2		;Bad response, try it again
	JUMPN T1,STRREF		;Operator refused
	CALL STRDM2		;No, set str unavailable
	CALLRET DISFAL		;Can not set str unavailable
	JRST STREX0		;Str unavailable, now check to see EXCLUSIVE

;;STRDM2 - Set str unavailable
;RETURNS +1 Any errors will be saved in LSTERR
;	 +2 O.K

STRDM2::MOVEI T1,RSBSTA(RSB)	;Get alias again
	MOVE T2,[POINT 7,MSTAL]	
	CALL SIXSEV		;Convert to asciz
	CALL STRUNA		;Set str unavailable
	CALLRET SAVERR		;Structure is gone!!!!
	RETSKP			;Back to caller

;STRDMS - Dismount the structure

;  Accepts: MSTAL / name of structure in ASCII

;  RETURNS +1 On error, error code in LSTERR
;	   +2 On success

STRDMS:: HRROI T3,MSTAL		;Set pointer to structure name
	MOVE T1,[1,,.MSDIS]	;Dismount structure
	MOVEI T2,T3		;Get address of only argument
	SKIPN TSTF		;Skip if debugging
	MSTR
	 ERJMP SAVERR		;Save the error and tell operator
	CALL DSTDDB		;Clear structure DDB info
	SETONE STR%DT,STRFL1(STR) ;Say unavailable due to dismount
	SETZRO STR%UD,STRFL1(STR) ;Say all done with dismount
	TXNE F,PORTF		;Are we engaged in a port operation
	JRST STRDM1		;Yes, tell operator and return skip
	MOVEI T1,STRNAM(STR)	;Get sixbit structure name and
	MOVE T2,[POINT 7,MSTNM]	; And convert to asciz
	CALL SIXSEV
	CALL WOSDM		;Tell operator of dismount
	RETSKP			;Have to check for removal/no removal 

STRDM1:	MOVE T1,STRNAM(STR)	;Get the structure name
	MOVE T2,STRALI(STR)	;Get the structure alias name
	TMCT <%IStructure %1S: (alias %2S:) dismounted %_%U%_>
	MOVEI T3,[ASCIZ/Dismount Structure Succeeded As Part Of Port Operation/]
	CALL BTWTO		;SEND MSSG TO OPERATORS
	RETSKP			;All done back to who ever called STRDMS

;STRREF - Operator refuses to dismount structure
;Accepts STR/SSB address
;	 RSB/Request status block address
;Returns +1 always through STSTBK

STRREF::MOVE T1,STRALI(STR)	;Get the structure alias name
	MOVE T2,STRNAM(STR)	;Get the structure name
	TMCT <%IOperator refused to dismount structure %2S: (Alias %1S:)%_ for %U%_>
	MOVEI T3,[ASCIZ/Dismount Structure Failed/]
	CALL BTWTO		;SEND MSSG TO OPERATORS
	CALL STSTBK		;[335]Set structure back to previous state
	ABTRET (MREQ23,ABT%OP)  ;[335] and abort the request
;**;[335]At DISREF:+0 rename the routine to STSTBK 
SUBTTL STSTBK - Set STR back to previous state, before the DISMOUNT.
;Accepts STR/structure status block address
;Returns +1 always

STSTBK:	SOSLE STRNDM(STR)	;[335]One less, any more dismounts?
	JRST STSTB1		;[335]Yes, better not set it back yet.
	SETZRO STR%UD,STRFL1(STR) ;[335]Say all done with dismount	
	MOVEI T1,RSBSTA(RSB)	;[335]Get SIXBIT alias
	MOVE T2,[POINT 7,MSTAL]	;[335]This is place to store 7-bit
	CALL SIXSEV		;[335]CONVERT IT
	MOVE T1,STRFLG(STR)	;[335]Get structure status
	TXNN T1,MS%DIS		;[335]Was it originally unavailable?
	JRST STSTB2		;[335]It was available so set it 
	CALL STRUNA		;[335]Set str unavailable
	CALL DISFA1		;[335]Can not set structure unavailable

STSTB1:	RET			;[335]Common exit point 

STSTB2:	CALL STRAVA		;[335]Set it available
	CALL DISFA1		;[335]Can not set structure unavailable
	CALLRET STSTB1		;[335]Back to previous, join common exit
SUBTTL STRUNA - SET STR UNAVAILABLE

;RETURNS +1 On error
;	 +2 Ok
STRUNA::MOVE T1,[POINT 7,MSTAL]	;Get pointer to structure alias
	MOVEM T1,MSTRST+.MSSSN
	MOVX T1,MS%DIS
	MOVEM T1,MSTRST+.MSSST	;Change only the bit to say the str
	MOVEM T1,MSTRST+.MSSMW	;Is being dismounted
	MOVE T1,[3,,.MSSSS]	;Changing structure status
	MOVEI T2,MSTRST
	SKIPN TSTF		;Skip if debugging
	MSTR
	 ERJMP R		;Get error in lsterr
	RETSKP

;STRAVA - SET STR AVAILABLE

;RETURNS +1 On error
;	 +2 Ok

STRAVA::MOVE T1,[POINT 7,MSTAL]	;Get pointer to structure alias
	MOVEM T1,MSTRST+.MSSSN
	MOVX T1,MS%DIS
	MOVEM T1,MSTRST+.MSSMW	;Change only the bit to say the str
	SETZM MSTRST+.MSSST	;Is being dismounted
	MOVE T1,[3,,.MSSSS]	;Changing structure status
	MOVEI T2,MSTRST
	SKIPN TSTF		;Skip if debugging
	MSTR
	 ERJMP R		;Get error in lsterr
	RETSKP

;STDERR - RECOVER FROM AN ERROR WHEN TRYING TO DISMOUNT A STRUCTURE

STDERR:	MOVEI T1,MSTNM
	TMCT <%IProblem with structure %1A: %J%_%U>
	MOVEI T3,[ASCIZ/Dismount Problem/]
	CALLRET BTWTO		;SEND MESSAGE TO OPERATOR

;SAVERR - Error routine, reports the error to the operator
;	  and saves the error in LSTERR.
;RETURNS +1 Always

SAVERR::MOVE T1,STRNAM(STR)	;Get the structure name
	MOVE T2,STRALI(STR)	;Get the structure alias
;**;[6034]Change 1 line at SAVERR:+2L JYCW 11-Aug
	TMCT <%IProblem with structure %1S: (Alias %2S:) %J%_%U> ;[6034]
	MOVEI T3,[ASCIZ/Dismount Structure Failed/]
	CALL BTWTO		;SEND MSSG TO OPERATORS
	CALL GETERR		;Get the error
	MOVEM  T1,LSTERR	;Save the error
	RET			;After saving the error we return

;DISFAL - Tell the operators that a dismount structure failed and abort

DISFAL::MOVE T1,LSTERR		;Get the last error	
	CAIN T1,MSTX21		;Was it structure no longer mounted
	JRST DISFA0		;[6011]Go to common exit
	CAIN T1,MSTX24		;Trying to dismount PS:?
	JRST [MOVE T2,STRALI(STR) ;Yes, get the alias
	     TMCT <%I%1J %2S:%_%U>
	     MOVEI T3,[ASCIZ/Dismount Structure Failed/]
	     CALL BTWTO		;Send msg to operators
	     JRST .+1]		;[6011]Set it back to previous state
	TXO T1,FA%TER		;[6011]MONITOR error type
	MOVEM T1,RSBERR(RSB)	;[6011]Save error type,,code
	MOVE T1,STRPNT(STR)	;Get the pointer to the DDB
	CALL DSFGET		;Go find it
	 $STOP <STRUCTURE NOT FOUND IN DDB..DISFAL::+2>
	MOVE T1,DSFE+DSFFLG	;Get the status
	TXNE T1,DSF%AV		;Should we set it available/unavailable
	JRST [CALL STRUNA	;Unavailable
	      CALL DISFA1	;On error say so
	      SETONE MS%DIS,STRFLG(STR) ;Should be unavailable
	      JRST DISFA]	;Just continue
	CALL STRAVA		;Set it available
	CALL DISFA1		;On error say so
	SETZRO MS%DIS,STRFLG(STR) ;Should be available
DISFA:	SETZRO STR%UD,STRFL1(STR) ;No longer unavailable due to dismount
	SETONE R%STA,RSBIFL(RSB) ;[6011]Set failure bit
	MOVE T1,RSBIFL(RSB)	;[6011]Get lock bit
	TXZE T1,R%LOC		;[6011]Did this request locked the structure
	CALL UNDREM		;[6011]Go unlock
DISFA0:	ABTREQ (LSTERR,ABT%IN)  ;[6011]Abort the dsk request
	JRST STREXT		;[6011]

;  Only called when the resulting error is due to a local event

DISFA1:	MOVE T1,STRNAM(STR)	;Get the structure name
	MOVE T2,STRALI(STR)	;Get the structure alias
	TMCT <%IProblem with structure %1S: (Alias %2S:) %J%_%U>
	MOVEI T3,[ASCIZ/Cannot Set Structure To Original State/] 
	CALLRET BTWTO		;SEND MSSG TO OPERATORS
SUBTTL	Operator Communication When set EXCLUSIVE fails

; SCREQ1 - SCS Request - dismount structure on all processors
;	   Until this procedure is set, the following
;	   temporary local operator request will be the request mechanism
;Must have a continue address in RSBCON

SCREQ1::MOVEI T1,SCREQ2		;get end action request
	CALLRET WODSCI		;Notify operator

SCREQ2:	MOVEI RSB,-RSBWTB(T2)	;Load RSB ac
	LOAD STR,RSBSS		;Get str status block
	CALL RSDR		;Parse answer
	 JRST SCREQ1		;Error, try again
	JUMPN T1,SCREQ3		;[6011]Refused
	MOVEI T1,RSBSTA(RSB)	;Get SIXBIT alias
	MOVE T2,[POINT 7,MSTAL]	;This is the place to store 7-bit
	CALL SIXSEV		;Convert it
	SKIPE ENQFLG		;[6011]Cluster ENQ enabled?
	JRST @RSBCON(RSB)	;[6011]No, do it the old way
	JRST SENNEB		;[6011]Send remote dismount message to NEBULA

;  Operator refused to continue with dismount

SCREQ3:	MOVE T1,STRALI(STR)	;Get the structure alias name
	MOVE T2,STRNAM(STR)	;Get the structure name
	TMCT <%IOperator refused to dismount structure %2S: (Alias %1S:)
from the other system for %_%U%_>
	MOVEI T3,[ASCIZ/Cannot Set Structure Exclusive/]
	CALL BTWTO		;SEND MSSG TO OPERATORS
	CALL STSTBK		;[335] Abort the disk request and return
	ABTREQ (MREQ23,ABT%OP) ;[335][6011] and abort the request
	SKIPE ENQFLG		;[6011]Pre 7 MONITOR?
	RET			;[6011]Yes, just return
	SETONE R%STA,RSBIFL(RSB) ;[6011]Set failure bit
	MOVE T1,RSBIFL(RSB)	;[6011]Get status
	TXZN T1,R%LOC		;[6011]Did this request locked the structure
	JRST SCREQ4		;[6011]No
	MOVE T2,STRFL1(STR)	;[6011]Get the status
	LOAD T3,RSBTYP		;[6011]Get the type
	CAIN T3,.DSMST		;Dismount?
	CALL RELLOC		;[6011]Unlock

SCREQ4:	CALLRET @RSBABO(RSB)	;[6030]Continue at failure address and return
SUBTTL	Send a DISMOUNT Message to NEBULA

;[6011]SENNEB Send dismount message to Nebula.  Send only one remote dismount
;message.
;Accepts RSB and STR
;Returns back to scheduler

SENNEB:	MOVE T1,STRFL1(STR)	;Get the flag word
	TXNE T1,STR%SN		;Did we send a dismount message?
	JRST SCSNE0		;Yes, no need to send another

;Build Structure name block

	STKVAR <<DVBLK,3>>
	CALL PBINIT		;Set up for creating building blocks
	MOVE T1,[3,,.STRDV] ;length,, structure name block
	MOVEM T1,DVBLK		;Save it in the message
	MOVE T2,[POINT 7,MSTAL];Set up pointer for alias
	MOVEI T1,STRALI(STR)
	CALL SIXSEV		;CONVERT SIXBIT ALIAS TO NEEDED 7-BIT
	DMOVE T1,MSTAL		;Get the ASCIZ name
	MOVEM T1,1+DVBLK	;Put it in the message
	MOVEM T2,2+DVBLK	;Put it in the message
	MOVEI T1,DVBLK		;Get address of the structure name block 
	CALL PBBLK		;Add it

;Build Node name block
;Get node name from RSB

	LOAD T4,RSBNSM		;Get the number of nodes
	MOVEI T1,RSBRND(RSB)	;Start at the beginning
SCSNE:	MOVE T2,[.NDESZ,,.NDENM] ;Size,,node block
	MOVE T3,(T1)		;Get the node name
	DMOVEM T2,TEMPX		;Goes here
	PUSH P,T1		;Save address of node name 
	MOVEI T1,TEMPX		;Add it to the node block
	CALL PBBLK
	POP P,T1		;Restore address
	ADDI T1,2		;Go to the next node
	SOJG T4,SCSNE		;Get the next node

;Build Galaxy header

	MOVE T2,PBBPT		;Get the end of the message
	SUBI T2,TBUF		;Compute size of IPCF message
	HRL T1,T2		;Get length,,msgtype
	HRRI T1,.NRDSM		;
	MOVX T2,MF.NEB 		;Nebula message
	AOS T3,UNIQUE		;ACK code
	CALL GALHDR		;Build the Galaxy header
	MOVX T1,.DMDIS		;Assume it is for dismount
	LOAD T2,RSBTYP		;Get the type
	CAIN T2,.DSMST		;Dismount?
	SKIPA
	MOVX T1,.DMSEX		;Set exclusive
	MOVEM T1,TBUF+.OFLAG	;Save it
	MOVEI T1,.APORN		;ORION'S PID
	PUSH P,T3		;Save the ACK code 
	CALL TRANG		;Send it
	POP P,T3		;Restore ACK code
	SETONE STR%SN,STRFL1(STR) ;Say we have send a dismount message
SCSNE0:	MOVEM T3,RSBRAC(RSB)	;Save ACK code in RSB
	LOAD T1,STRSEN,STRSMN(STR) ;Get the number of dismount msg sent
	AOS T1			;Add one more
	STOR T1,STRSEN,STRSMN(STR) ;Save it 
	RET
SUBTTL	Build and Send a Cancel Remote Dismount Message to NEBULA


;[6011]
;Build and send cancel remote dismount message
;Accepts T1/Type of cancel (NC%CDM or NC%CSE)  and RSB

NEBCAN:	MOVEM T1,TBUF+.OFLAG	;Set the cancel type
	MOVE T1,[.OARGC+1,,.NCDSM] ;BUILD GALAXY HEADER
	MOVX T2,MF.NEB 		;Nebula message
	MOVE T3,RSBRAC(RSB)	;Get remote ACK
	CALL GALHDR		;Build the Galaxy header
	SETZM TBUF+.OARGC	;No arg count word
	MOVEI T1,.APORN		;MESSAGE GOING TO ORION
	CALLRET TRANG		;SEND CANCEL REQUEST TO ORION
SUBTTL	Process NEBULA Dismount ACK 

;[6011]
; PNEDAC - Process DISMOUNT ACK from NEBULA.
;The ACK can be in response to a SET EXCLUSIVE or a DISMOUNT/REMOVE command.
;PNEDAC translates the ACK to an ASCIZ text and informs the operator what the
;results of the remote dismounts were.  If there was a failure, a QUERY will be
;sent to the operator.  If all the remotes are successful
;or the operator RESPOND with PROCEED, PNEDAC will continue processing at
;@RSBCON on success and at RSBABO on abort.
;  RBUF/ IPCF MESSAGE FROM NEBULA via ORION, MESSAGE TYPE = .NTDAK
; RETURNS +1: ALWAYS

;Build status WTO about remote dismounts

PNEDAC:	SETZM PNFLAG		;Clear PNEDAC FLAG
	MOVEI T1,.STRNM		;Get the structure name block
	CALL ORNBLF		;
	 JRST KBADM		;Bad message from NEBULA (BUG)
	MOVE T2,0(T1)		;Get the structure name
	MOVEM T2,STNAM		;Save it
	MOVEI T1,.STSBK		;Get node name
	CALL ORNBLF
	 JRST KBADM		;No node block, bad message from NEBULA (BUG)

;  Uses T2/the arg block length and T1/address of block

	MOVEM T1,ADDRBK		;Save address of block
	IDIVI T2,2		;Two words/entry 
	MOVEM T2,NUMNOD		;Save number of nodes
	MOVE T4,RBUF+.OFLAG	;Get the flag
	MOVEM T4,DFLAG		;Save it
	SETZM FNDRSB		;Initialize found RSB flag

;  Continued on next page
;Continued from previous page

;  Get exclusive pending RSB

PNEDA: 	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	CALL PRQPID		;CLEAN UP REQUEST QUEUE FIRST

PNEDA0:	CALL QMSCAN		;GET ADDRESS OF NEXT RSB
	 JRST [SETOM FNDRSB	;No RSB found
	       SKIPE PNFLAG	;First time through?
	       JRST PNEDER	;No, all done
	       JRST PNEDA7]	; must have been canceled
	MOVEI RSB,-RSBLNK(T2)	;Get RSB adddress
	MOVE T3,RSBRAC(RSB)	;Get ACK code from entry
	CAME T3,RBUF+.MSCOD	;Does it match code in IPCF message?
	JRST PNEDA0		;No,, continue scan
	LOAD STR,RSBSS		;Get str status block
	HRL T3,ADDRBK		;Get the source
	HRRI T3,RSBRND(RSB)	;Destination
	BLT T3,RSBRND+15(RSB) 	;Do the transfer
	LOAD T1,STRSEN,STRSMN(STR) ;[6011](TBD)Get message sent counter
	SOS T1			;[6011]One less
	STOR T1,STRSEN,STRSMN(STR) ;Put it back
	SETZRO STR%SN,STRFL1(STR) ;Clear send dismount message to NEBULA
	JRST PNEDA1

;Print the success nodes first

PNEDA7:	MOVE T1,ADDRBK		;Get the nodes status block
	SKIPA

PNEDA1:	MOVEI T1,RSBRND(RSB)	;Point to remote node status
	MOVEM T1,ADDRBK		;Save it for later
	SETZM PNFLAG		;Clear the header flag
	MOVE T2,NUMNOD		;Get the number of nodes in message
	TMCT <%I>		;Initialize TMCMSG buffer
PNEDA2:	MOVE T4,.STNST(T1)	;Get status word
	TXNN T4,ST%SSD		;Success?
	 JRST PNEDA3		;No
	SKIPE PNFLAG		;Did we print the header?
	IFSKP.			;No
	 MOVE T3,STNAM		;Get the structure name
 	 TMCT <Structure %3S: dismounted from >
	 SETOM PNFLAG		;Set the header flag
	ELSE.
	 TMCT <, >
	ENDIF.
	MOVE T3,.STNNE(T1)	;Yes, get the node name
	TMCT <%3S::>		;Add it to the message
PNEDA3:	ADDI T1,.STRLN		;Go to the next block
	SOJN T2,PNEDA2		;Get the next block if there is one
	TMCT <%_>

;  Continued on next page
;Continued from previous page

	MOVE T1,DFLAG		;Get status flag word
	TXNE T1,DS%SUC		;All success?
	JRST PNEDA6		;Yes no need to send WTOR

;Print the failure nodes

	MOVE T1,ADDRBK		;Get the nodes status block
	MOVE T2,NUMNOD		;Get number of nodes

PNEDA4:	MOVE T4,.STNST(T1)	;Get status word
	TXNE T4,ST%SSD		;Success?
	JRST PNEDA5		;Yes, get the next node
	MOVE T3,STNAM		;Get the structure name
	MOVE T4,.STNNE(T1)	;Yes, get the node name
 	TMCT <Structure %3S: failed to be dismounted from %4S::%_Error - >
	MOVE T3,.STNST(T1)	;Get the error word
	TXZN T3,ST%TER		;From MONITOR
	IFSKP.			;Yes
	 TMCT <%3J>
	ELSE.
	 CALL FNDERR		;Find the address of the error string
	 TMCTI <T3>
	ENDIF.
	SKIPN FNDRSB		;No RSB means request canceled
	TMCT <%_Correct the problem indicated on %4S::%_>
PNEDA5:	ADDI T1,.STRLN		;Go to the next block
	SOJN T2,PNEDA4		;Get the next block

	MOVE T1,RBUF+.OFLAG	;Get the flag
	TXNN T1,DS%SUC		;Dismount from all?
	SKIPE FNDRSB		;Don't have a request
	JRST PNEDA6		;No need for WTOR
	TMCTI <RESHDR>		;Add tail of message
	MOVEI T3,[ASCIZ/Dismount Query/]
	TXNE T1,DS%SEX		;Is this a dismount ACK via SET EXCLUSIVE?
	MOVEI T3,[ASCIZ/Set Structure Query/] ;Yes
	MOVEI T1,PNERSP		;Continue here
	MOVEI T2,RSBWTB(RSB)	;Get WTB address
	CALLRET BTWTOR		;Send WTOR

;  Continued on next page
;Continued from previous page

;Here there is no need to send a WTOR because either the request was canceled
;or all the remote dismounts were successful

PNEDA6:	MOVEI T3,[ASCIZ/Remote Dismount Status/]
	CALL BTWTO		;Tell the operator
	SKIPN FNDRSB		;Do we have a request for this ACK
	JRST PNEDEX		;Yes, continue with the request

;Tell operator to remotely mount the structure that just got remotely
;dismounted.

	MOVE T1,ADDRBK		;Get the address of structure block
	MOVE T2,NUMNOD		;Get number of nodes
	MOVE T3,STNAM		;Get the structure name
	TMCT <%IDismount request has been canceled.
However, structure %3S: has been dismounted from nodes:%_>

PNEDC1:	MOVE T4,.STNST(T1)	;Get status word
	TXNN T4,ST%SSD		;Success?
	JRST PNEDC3		;No, get the next node
	MOVE T3,.STNNE(T1)	;Yes, get the node name
	TMCT <%3S::  >		;Add it
PNEDC3:	ADDI T1,.STRLN		;Next
	SOJG T2,PNEDC1		;[6017]
	MOVEI T3,[ASCIZ/Dismount Status/]
	CALLRET BTWTO

;  Continue with the request.  Could be a set exclusive command or a dismount
;  with removal.

PNEDEX:	LOAD STR,RSBSS		;Get str status block
	MOVEI T1,RSBSTA(RSB)	;Get SIXBIT alias
	MOVE T2,[POINT 7,MSTAL]	;This is the place to store 7-bit
	CALL SIXSEV		;Convert it
	CALL @RSBCON(RSB)	;Yes, continue from where we left of
PNEDER:	RET

;Parse response from operator

PNERSP: MOVEI RSB,-RSBWTB(T2)	;Load RSB ac
	LOAD STR,RSBSS		;Get str status block
	SETZM FNDRSB		;We have a request 
	CALL RSDR		;Parse answer
	 JRST PNEDA1		;Error, try again
	JUMPN T1,SCREQ3		;Abort 
	MOVEI T1,RSBSTA(RSB)	;Get SIXBIT alias
	MOVE T2,[POINT 7,MSTAL]	;This is place to store 7-bit
	CALL SIXSEV		;Convert it
	JRST PNEDEX		;Go to common code
SUBTTL	Process NEBULA Remote Dismount Errors

;[6011]
;Accepts T3/error bit
;Returns T3/address of error text string

FNDERR:	SAVET			;Save T ACs
	JFFO T3,.+1		;Pickup displacement into error table
	CAIL T4,STLOW		;Check for legal error
	CAILE T4,STHIGH		;Check for legal error
	SETZ T4,
	MOVE T3,NEBERR(T4)	;[6032]Return address of error string in T3
	RET

NEBERR:	[ASCIZ/Unknown error/]
	[ASCIZ/STRUCTURE SUCCESSFULLY DISMOUNTED/]
	[ASCIZ/SENDER WAITING FOR A HELLO RESPONSE/]
	[ASCIZ/LISTENER HAS NOT RECEIVED HELLO MSG/]
	[ASCIZ/SENDER LISTENER ARE CRASHED/]
	[ASCIZ/NO SUCH NODE/]
        [ASCIZ/PRE-7 MONITOR/]
	[ASCIZ/NO DECNET IN MONITOR/]
        [ASCIZ/SCS% DETECTED NODE LEFT THE CLUSTER/]
        [ASCIZ/INFO% UNABLE TO OBTAIN SOFTWARE ENVMEN/]
        [ASCIZ/DISMOUNT CANCELLED IN TIME/]
        [ASCIZ/MONITOR ERROR DISMOUNTING STRUCTURE/]
 	[ASCIZ/ORION ERROR/]
	[ASCIZ/QUASAR ERROR/]
 	[ASCIZ/NEBULA ERROR/]
 	[ASCIZ/MOUNTR ERROR/]
; WODSCI - Tell Operator to find all other processors having
;	   the specified structure mounted so that they can dismount it.
;RSB and STR

WODSCI:	STKVAR <CONADR,TRSB>	;Allocate room for continue address, RSB
	MOVEM T1,CONADR		;Save continue address for CALL BTWTOR
	MOVEM RSB,TRSB		;[6011]Save RSB
	MOVE T2,STRNAM(STR)	;Get structure name
	MOVE T3,STRALI(STR)	;Get structure alias
	TMCT <%IStructure %2S: (Alias %3S:) is in use by%_>
	SKIPN ENQFLG		;[6011]Cluster ENQ enabled?
	IFSKP.			;[6011]No, must be a pre 7 release
	 TMCT <another processor in the cluster>
	 JRST WODSC1		;[6011]Go finish of WTOR message text
	ENDIF.
	CALL GETNOD		;[6011]Get the systems which have it mounted
	 JRST WODSC2		;[6013]No one has it????
	LOAD T2,RSBNSM		;Get number of nodes which has it mounted
	SKIPN T2		;If no node
	JRST STREX2		;[6013]Try to set it exclusive again
WODSC0:	MOVE T1,RSBRND(RSB)	;Get the node name
	TMCT <%1S::>		;Add it to the message
	SOJLE T2,WODSC1		;Any more?
	TMCT <, >		;Yes, add a comma
	ADDI RSB,2		;Next node
	JRST WODSC0		;Get the next node

WODSC2:	SETZ T1,		;[6013]Start at the beginning 
	SKIPE T2,BADNOD(T1)	;[6013]Do we have a bad node?
	IFSKP.
	 TMCT <another processor in the cluster>
	 JRST WODSC1		;[6013]No one
	ENDIF.

	TMCT <the following nodes which were unreachable for structure
information:%_>
WODSC4:	TMCT <%2S::>		;[6013]Display BAD node
	AOS T1			;[6013]Next BAD node
	SKIPN T2,BADNOD(T1)	;[6013]Do we have one?
	IFSKP.			;[6013]Yes
	 TMCT <, >
	 JRST WODSC4
	ENDIF.

WODSC1:	TMCT <%_and can't be removed from the cluster unless it's dismounted
with NO-REMOVAL from the systems.
Respond with PROCEED to dismount the structure from the 
above systems or
Respond with ABORT to terminate the dismount request%_ > ;[6026]
	MOVE RSB,TRSB		;Get back RSB 
	MOVEI T2,RSBWTB(RSB)	;Get WTB address
	LOAD T3,RSBTYP		;Get the type
	CAIE T3,.DSMST		;Dismount? 
	IFSKP.
	 MOVEI T3,[ASCIZ/Dismount Query/]
	ELSE.
 	 MOVEI T3,[ASCIZ/Set Structure Command Query/]
	ENDIF.
	MOVE T1,CONADR		;Get the continue address
	CALL BTWTOR		;Query the operator
	RET
SUBTTL	Find Out Which Node(s) in the Cluster has the Structure Mounted

;[6011]
;Do config%
;Accepts STR
;	 RSB
;Returns +1 on failure
;	 BADNOD/Nodes in the Cluster that might have the structure mounted
;	        but we don't know
;Returns +2 on success
;	 NAMBLK/ASCIZ node name
;	 NUMBLK/CI-node number
;	 RSBRND+n/SIXBIT node names
;	 RSBNNM/number of node
;	 +2 on success 

GETNOD:	STKVAR <NCOUNT,TRSB>	;Allocate space for which node mounted the str
				;and RSB.
	SETZM NCOUNT		;Make sure we start at zero
	MOVEM RSB,TRSB		;Save RSB
	SETZM BADNOD		;[6013]Clear BAD node block
	MOVE T1,[BADNOD,,BADNOD+1] ;[6013]Get source,,destination 
	BLT T1,BADNOD+6		;[6013]Clear it
	SETZM RSBNNM(RSB)	;No one has it mounted yet
	CALL GCNFIG		;Get the node and their CI node number
	SOJLE T3,RSKP		;We are the only one, set it exclusive
	STOR T3,RSBNO1		;Remember how many node in cluster
	MOVEI T4,BADNOD		;[6013]Get address of BAD nodes in the cluster
	MOVEM T4,BADADR		;[6013]Save it

;Can't use T3.  T3 must be perserved when routines are called from this routine
;Check which systems have the structure mounted.  RSB is saved in TRSB because
;it gets trashed.  Make sure RSB is strored before leaving this routine

	MOVEI T4,2		;Start at the second CI-node number
GETNO1:	HLRZ T1,NUMBLK(T4)	;Get the CI-node number
	MOVEM T1,INFBLK+.INCID	;Store it in INFO arg block
	MOVE T1,[.INMSR,,.INAC2+2] ;Function,,Length
	MOVEM T1,INFBLK+.INFUN	;Store it 
	MOVE T1,[.MSGSI+1,,.MSGSS] ;Get length,,function	
	MOVEM T1,INFBLK+.INAC1	;Store it in INFO block	
	MOVEI T1,MSTRST		;MSTR block
	MOVEM T1,INFBLK+.INAC2	;Address goes here 
	MOVEI T1,STRALI(STR)	;Make pointer to alias
	MOVE T2,[POINT 7,MSTAL]	;DO SAME FOR STRUCTURE ALIAS
	MOVEM T2,MSTRST+.MSGSN	;Store it in MSTR block
	CALL SIXSEV		;Convert into ASCIZ 
	MOVEI T1,INFBLK		;Get the INFO arg block
	INFO%
	 ERJMP GETNO3		;Local error, get the next node
	TXZE T1,IN%RER		;[6013]Any remote error?
	JRST GETNO4		;Yes, skip this and onward
	MOVE T1,NAMBLK(T4)	;Get pointer to node
	MOVEI T2,RSBRND(RSB)	;Store name here
	CALL SEVSIX		;Convert to SIXBIT
	MOVE T1,NCOUNT		;Get counter for who has it mounted
	AOS T1			;Increment it
	MOVEM T1,NCOUNT		;Store it back
	ADDI RSB,2		;Next RSBNNM
GETNO2:	AOS T4			;Next node number
	SOJG T3,GETNO1		;Next node name
	MOVE RSB,TRSB		;Get RSB
	MOVE T1,NCOUNT		;Get who has it mounted counter
	STOR T1,RSBNSM		;Store it in RSB
	SKIPG T1		;[6013]Do we have at least one node
	RET			;[6013]No
	RETSKP			;No more all done

;  Detected that a node in the Cluster is running a 7 Monitor.  Save the SIXBIT
;  node name in BADNOD and display them in WODSCI:

GETNO4:	CAIN T1,MSTX21		;[6013]Structure is not mounted?
	JRST GETNO2		;[6013]Yes, no need to add this node
GETNO3:	MOVE T2,BADADR		;[6013]Get address of BAD nodes
	MOVE T1,NAMBLK(T4)	;Get pointer to node
	MOVEI T2,(T2)		;Store name here
	CALL SEVSIX		;Convert to SIXBIT
	AOS T2			;[6013]Increment to next word
	MOVEM T2,BADADR		;[6013]Save it
	JRST GETNO2		;[6013]Get the next node
SUBTTL	Get The Cluster Node Name and CI Node Number
;[6010]
;GCNFIG - returns the number of nodes in the cluster.
;Returns +1 Success T3/number of nodes in the cluster
;	    NAMBLK/Node name block
;   	    NUMBLK/CI node number block


GCNFIG:	MOVEI T1,CNFSIZ		;Size of CNFIG block 
	MOVEM T1,NAMBLK+.CFNND	;Store it in the arg block

	MOVEI T1,.CFCND		;Get function code
	MOVEI T2,NAMBLK		;Get the arg address
	CNFIG%			;Get the node name
	 ERJMP STOP		;Shouldn't fail

	MOVEI T1,CNFSIZ		;Size of CNFIG block 
	MOVEM T1,NUMBLK+.CFLEN	;Store it in the arg block
	MOVEI T1,.CFCSE		;Get function code
	MOVEI T2,NUMBLK		;Get the arg address
	CNFIG%			;Get the node number
	 ERJMP STOP		;Shouldn't fail
	HLRZ T2,NUMBLK		;Get number of words returned
	SOS T2			;Don't count the first word
	HLRZ T3,NAMBLK		;Get number of node in the cluster
	CAME T3,T2		;Are the number and name the same?
	JRST GCNFIG		;No, try again
	RET
;RSDR - Parse operator response to request for other processor dismount
;
RSDR:	CALL COMNDI		;Initialize for COMND jsys
	MOVEI T2,[FLDDB. .CMKEY,,RSDRKS] ;Setup keyword parse
	CALL COMNDX		;Parse keyword
	 JRST [ MOVEI T1,[ASCIZ/Response must be PROCEED or ABORT/]
		CALLRET RSPERR] ;Incorrect response, give error
	HRRZ T2,(T2)		;Get address of keyword processr
	CALLRET (T2)		;Dispatch 

RSDRKS: RSDRSE,,RSDRSE
	[ASCIZ/ABORT/],,RSDRNO
	[ASCIZ/PROCEED/],,RSDRSI
RSDRSE==.-RSDRKS-1		

RSDRNO::SETO T1,
	RETSKP

RSDRSI::SETZ T1,
	RETSKP
SUBTTL STRMNT - MOUNT A STRUCTURE

;ACCEPTS: RSB/	CURRENT REQUEST BLOCK
;	  STR/	STRUCTURE TO MOUNT

;RETURNS: +1/	FAILURE
;	  +2/	SUCCESS

;  It is assumed the structure specified is not logically mounted...

STRMNT:	SKIPE ENQFLG		;[6011]Pre 7 monitor?
	JRST STRMN		;[6011]Yes, no need to check locking

;  Check to see if we are doing a remote mount.  If we are, the mount request
;  must be from the same node that did the remote dismount.

	MOVE T1,RSBIFL(RSB)	;[6011]Get flag
	TXNN T1,R%LOR		;[6011]Local or remote
	IFSKP.			;[6011]Remote
	 SKIPE T1,STROBN(STR)	;[6021]No need to check if no node name
	 CAMN T1,RSBOBN(RSB)	;[6020]Is the node we are doing the remote
				;mount the same as the node we did a remote
				;dismount
  	 JRST STRMN		;Yes, by pass locking check
	 SKIPN T2,RSBSTN(RSB)	;Get the structure name
	 MOVE T2,RSBSTA(RSB)	;No name, use the alias 
	 MOVE T3,RSBSTA(RSB)	;and alias
	 TMCT <%IUnable to mount structure %2S: (Alias %3S:)
Structure %2S: (Alias %3S:) is currently being dismounted
with removal by node %1S::>
	MOVEI T3,[ASCIZ/Mount Status/]
	CALLRET BTWTO 		;[6011]Inform operator
	ENDIF.
	 
; Check and see if it is reasonable to mount this structure

	MOVE T1,STRFL1(STR)	;[6011]Get status
	TXNE T1,STR%LE+STR%LD	;[6011]Do we have it locked?
	JRST STRMN		;[6011]Yes, no need to check who has it locked
	CALL WHOEQC		;[6011]Anyone has it locked
	JRST STRMN		;[6011]No one has it
	SKIPN T2,RSBSTN(RSB)	;Get the structure name
;**;[6037]At STRMNT:+27L change 1 line
	MOVE T2,RSBSTA(RSB)	;[6037]Use the alias
	MOVE T3,RSBSTA(RSB)	;and alias
	TMCT <%IUnable to mount structure %2S: (Alias %3S:)
Structure %2S: is locked by node %1S::>
	MOVEI T3,[ASCIZ/Mount Status/]
	CALL BTWTO 		;[6011]Inform operator
;**;[6037]At STRMNT:+34L change 1 line
	MOVEI Q1,MSTX33		;[6037]Get the error code
	JRST STRMEX

STRMN:	MOVE T1,RSBSTA(RSB)	;Get alias in request
	MOVEM T1,DSFE+DSFSPC	;Set it in test DDB
	MOVEI T1,.DVSTR		;Get structure type
	MOVEM T1,DSFE+DSFTYP	;Set it
	CALL DSFLOC		;Go look for it
	  JRST STRMN0		;Don't have DDB.  Have no reason not to mount

	MOVE T2,DSFE+DSFFLG	;Get the flags
	TXNE T2,DSF%IG		;Is it ignore?
	JRST [MOVEI Q1,MREQ27	;Get the error code
	      JRST STRMEX]	;Yes, reject request based on caller
	SKIPE DSFE+DSFPNT	;Get address of SSB for structure
	JRST [ABTRET (ABRTNR)]	;Already mounted, reject the request
	CALL NEWSTA		;Get new status of the structure based on DDB
	  JFCL			;Not mounted
	TXNE T1,MS%DIS		;Is this structure available to be mounted?
	JRST [MOVEI Q1,MSTX33	;Get the error code
	      JRST STRMEX]	;No, reject request based on caller
	
	MOVE T1,STRFL1(STR)	;Get the other status word
	TXNE T1,STR%DT		;Is it being dismounted?
	JRST [MOVEI Q1,MSTX33	;Yes, get the error code
	      JRST STRMEX]	;Reject request based on requestor

STRMN0:	MOVE T1,STR		;Get the address of the SSB
	CALL CHKAVA		;Check availability status of the SSB
	JRST [MOVEI Q1,MSTX33	;Get the error code
	      JRST STRMEX]	;Not available, reject request based on caller

;  Now we want to set up the MSTR to mount the structure
;  First argument word is to contain pointer to ASCIZ string for structure name

	MOVE T2,[POINT 7,MSTNM]	;GET PTR TO CONVERT STR NAME TO ASCIZ
	MOVEM T2,MSTRBK+.MSTNM	;STORE POINTER FOR LATER MSTR CALL
	MOVEI T1,RSBSTN(RSB)
	SKIPN (T1)		;IF NO PHYSICAL NAME WAS SPECIFIED,
	MOVEI T1,RSBSTA(RSB)	; USE ALIAS
	CALL SIXSEV

;  Second argument word is pointer to ASCIZ string for structure alias

	MOVE T2,[POINT 7,MSTAL]	;DO SAME FOR STRUCTURE ALIAS
	MOVEM T2,MSTRBK+.MSTAL
	MOVEI T1,RSBSTA(RSB)
	CALL SIXSEV

;  Third argument word is to contain number of units in structure

	LOAD T1,STRUNI,(STR)	;GET NUMBER OF UNITS IN STRUCTURE
	HRRZM T1,MSTRBK+.MSTFL	; AND DON'T SET ANY SPECIAL ACTION FLAGS

;  Beginning with the 4th argument word build three word blocks, one block for
;  each disk in the structure.  The three word block contains the CKU for the
;  disk drive.
;  For this loop, T1 pointers to the current STRADD and controls the loop
;		  T2 points to the destination in the MSTR block for the CKU.

	MOVNS T1		;NEGATE NUMBER OF UNITS
	MOVSS T1		;SET UP INDEX FOR DISK ADDRESS
	HRRI T1,STRADD(STR)	;Point to the first disk drive status block
	MOVEI T2,MSTRBK+.MSTUI	;SET UP INDEX FOR STORING DISK INFO

STRMN1:	MOVE DSK,(T1)		;GET ADDRESS OF DISK STATUS BLOCK

	LOAD T3,DSKCHN,(DSK)	;GET DISK CHANNEL
	MOVEM T3,.MSTCH(T2)	;STORE FOR MSTR CALL

	LOAD T3,DSKCTR,(DSK)	;GET CONTROLLER
	CAIN T3,<.RTJST(-1,DOP%K2)> ;ALL ONES?
	SETO T3,		;YES, MAKE FULL-WORD
	MOVEM T3,.MSTCT(T2)	;STORE IT

	LOAD T3,DSKDRV,(DSK)	;Get drive unit number
	MOVEM T3,.MSTUN(T2)	;Store for MSTR call

	ADDI T2,1+.MSTUN	;Increment destination for next try
	AOBJN T1,STRMN1		;Go for another disk drive if any

	SUBI T2,MSTRBK		;GET LENGTH OF ARGUMENT BLOCK

	MOVEI T1,.MSMNT		;Get MSTR function type (mount a structure)
	HRL T1,T2		;Get length
	MOVEI T2,MSTRBK		;GET ADDRESS OF ARGUMENT BLOCK
	MSTR			;FINALLY, MOUNT IT
	 ERJMP STMERR		; SOMETHING WENT WRONG

	CALL RELLOC		;[6014]Unlock the structure
	SETZM STRELC(STR)	;[6012]No longer locked for dismount
	SETZRO STR%LD+STR%OB,STRFL1(STR) ;[6016]Clear lock bit 
	MOVE T1,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	MOVEM T1,STRALI(STR)	; AND STORE

;  We should also create a str entry in DDB for this structure

	CALL ISTDDB		;Go try to create
	  CALL [SKIPE DSFE+DSFPNT ;Already have one, already pointing at SSB?
		$STOP <Detected previously set pointer in DDB during STR mount>
		RET]		;No, continue
	HRRZM STR,DSFE+DSFPNT	;Need to update pointer
	CALL DSFUDE		;Update the entry pointer
	 $STOP <Update of previously known DDB with DSFUDE failed>
	SKIPE STRPNT(STR)	;Already pointing at DDB?
	$STOP <Detected previously set pointer in SSB during STR mount> ;Yes
	MOVEM T1,STRPNT(STR)	;Save the pointer to the DDB

	SETONE STR%MT,STRFL1(STR) ;Set structure mounted

STRMN3:	LOAD T4,STRMCT,(STR)	;GET NUMBER OF DISKS IN STRUCTURE
	MOVNS T4
	HLRZS T4
	HRRI T4,STRADD(STR)
STRMN4:	MOVE DSK,(T4)
	CALL DSTGIV		;GET STATUS OF GIVEN UNIT
	 CALL STOP		;THERE IS AN INCONSISTENCY
	MOVEM T1,DSKFLG(DSK)	;STORE STATUS OF UNIT
	MOVE T1,STRALI(STR)	;GET ALIAS
	MOVEM T1,DSKSTA(DSK)	; AND STORE
	AOBJN T4,STRMN4
	SKIPGE RSBITN(RSB)	;Is the MOUNT from operator?
	IFSKP.
	 CALL WOSMT		;[6015]Tell operator of success
	ELSE.
	 CALL KSMTE		;[6015]Let KSMT handle the message
	ENDIF.

STRMN5:	CALL NEWSTA		;Get the new status
	 JFCL			;Don't care
	CALL STSTR		;Set the structure
	 JRST [CAIE T1,-1	;[6011]Couldn't set exclusive
	       JRST STRMNE	;[6015]No
	       SETONE STR%ME,STRFL1(STR) ;[6011]Set bit in flag word
	       JRST STRMN6]
STRMNE:	RETSKP			;[6015]Common exit point
SUBTTL	Apply Structure Exclusive Attribute after it mounted

;[6011]  Fail to set the structure exclusive attribute.
;  We get here only if we can't set the structure exclusive as part of the
;  mount.
;  At this point there is no RSB for the set exclusive.

STRMN6:	SKIPE CFSB		;CFS?
	SKIPE ENQFLG		;[6011]Cluster ENQ enabled?
	JRST STRMNE		;[6015]No
	MOVEI T1,.DSEXC		;[6015]Set up exclusive switch request
	CALL OPRSB		;[6015]Get RSB
	 JRST [TMCT <%IFailed to acquire RSB for exclusive procedure>
	       MOVEI T3,[ASCIZ/Applying Structure Attribute Status/]
	       CALLRET BTACKT]	;Error abort
	MOVE T1,RBUF+.MSCOD	;[6014]Get operator's PID
	MOVEM T1,RSBPID(RSB)	;[6014]Save it for later
	STOR STR,RSBSS		;[6011]Save SSB address in RSB
STRMN7:	CALL GETLOC		;Lock the structure
	 JRST [CALL WHOENQ	;Failed, find out who has it
	       JRST STRMN7	;No one lets try again
	       MOVEI T3,[ASCIZ/Applying Structure Attribute Status/]
	       CALL BTACKT	;[6011]Tell operator
	       ABTREQ (ABRTNR)	;[6015]Get rid of RSB
	       JRST STRMNE]	;[6011]failed
	MOVEI T1,STRMNP 	;[6015]Get continue routine address
	MOVEM T1,RSBCON(RSB) 	;[6011]Save it
	MOVEI T1,STRMNA		;[6015]Get abort routine address 
	MOVEM T1,RSBABO(RSB)	;[6011]
	CALL SCREQ1		;[6015]Failed get cfs compliance
	JRST STRMNE		;[6015]Go to common exit 

;  STRMNP continue with setting the structure exclusive after receiving the
;  dismount ACK.
;  Accepts RSB and STR.
;  Returns via STRMN3.

STRMNP:	SKIPE T1,STRPNT(STR)	;Get address of DDB
	CALL DSFGET		;Get it
	 JRST STRMNA		;[6015]Not here, must have been UNDEFINE

	CALL NEWSTA		;Get the new status
	 JFCL			;Don't care
	CALL STSTR		;Set the structure
	 JRST [CAIE T1,-1	;[6011]Couldn't set exclusive
	       JRST .+1		;[6011]No
	       SETONE STR%ME,STRFL1(STR) ;[6011]Set bit in flag word
	       JRST STRMN6]

;  Finally, we have applied the structure's exclusive attribute.
;  Now, lets see if we can unlock the structure.

STRMNA:	SETZRO STR%ME,STRFL1(STR) ;[6015]Clear can't set exclusive bit
	CALL UNDREM		;[6011]Unlock if we can
	ABTRET (ABRTNR)		;[6015]Get rid of RSB
;STMERR - ERROR IN MOUNTING A STRUCTURE

STMERR:	SAVEQ
	MOVEI T1,.FHSLF		;GET THE ERROR
	GETER
	HRRZS T2		;GET ERROR ONLY
	MOVE Q1,T2		;[331] Copy error code to safe place
	CALL DDSERR		;[331] Tell operator of problem
	CAIN Q1,MSTRX5		;[331] Is error drive offline?
	RET			;[331] Yes, don't abort the request

;  STRMEX - Exit routine for STRMNT for a structure which can't be mounted 
;           because of its disk or structure attributes.  The purpose of this 
;	    routine is to reject the request based on the caller i.e from user
;	    or operator.
;Accepts - RSB/Request status block
;	   Q1/error code.
;Returns - +1 to caller of STRMNT.  Indicates failure

STRMEX: SKIPL RSBITN(RSB)	;Is it from operator
	JRST [ABTRET (Q1,ABT%IN)] ;No, must be from user, reject the request
	RET			;Yes, let KSMT handle the error

;DDSERR - RECOVER FROM AN ERROR WHEN TRYING TO MOUNT A STRUCTURE

DDSERR:	MOVEI T1,MSTNM
	TMCT <%IProblem with structure %1A:%_%J%_%U>
	MOVEI T3,[ASCIZ/Mount Problem/]
	CALLRET BTWTO		;SEDN MESSAGE TO OPERATOR
;SUBTTL SYMSET - BUILD AND LOG SYSERR ENTRY FOR DISK DRIVE STATUS CHANGE

;ACCEPTS: T1/ FUNCTION CODE (CS%ADV = SET AVAILABLE, CS%DDV = SET UNAVAILABLE)
;	  T2/ ADDRESS OF ASCIZ REASON, OR 0 IF NO REASON GIVEN
;	  Q2/ CHANNEL,,DRIVE
;	  DSK/ ADDR OF DISK STATUS BLOCK
;RETURNS: +1, ALWAYS

SYMSET:	SAVEQ
	SETZM SYRMSG		;ZERO OUT SYSERR MESSAGE AREA
	MOVE T4,[SYRMSG,,SYRMSG+1]
	BLT T4,SYRMSG+SYRMSZ-1

; TRANSFER OPERATION CODE AND REASON TO MESSAGE

	STOR T1,CS%OPR,SYRMSG+CS%OPW ;STORE OPERATION CODE INTO MESSAGE
	MOVEI Q1,SYRHSZ+CS%SIZ	;ASSUME NO REASON GIVEN
	SKIPN T1,T2		;REASON GIVEN?
	JRST SYMSE1		;NO
	MOVS Q3,T1		;YES, COPY ADDRESS OF STRING FOR BLT
	CALL ASCIZL		;GET # OF CHARACTERS
	IDIVI T2,5		;GET # OF WORDS MINUS 1
	CAIL T2,SYRMSZ		;TOO LONG?
	MOVEI T2,SYRMSZ-1	;YES, TRUNCATE
	MOVEI Q1,SYRHSZ+CS%SIZ+1(T2) ;SAVE SIZE OF ENTIRE MESSAGE
	HRRI Q3,SYRMSG+CS%SIZ	;GET BLT DESTINATION
	BLT Q3,SYRMSG+CS%SIZ(T2) ;TRANSFER STRING TO MESSAGE
	MOVEI T1,CS%SIZ
	STOR T1,CS%RSN,SYRMSG+CS%RSW ;STORE POINTER TO REASON
SYMSE1:	MOVEI T1,SEC%CS		;GET CONFIGURATION STATUS CHANGE CODE
	DPB T1,[POINT 9,SYRHDR,8] ;STORE INTO SYSERR ENTRY HEADER

;BUILD AND STORE SIXBIT DEVICE NAME

	MOVE T1,[SIXBIT/DP000 /]
	MOVE T2,[POINT 6,1,11]
	HLRZ T3,Q2		;GET CHANNEL
	ADDI T3,20		;MAKE IT A SIXBIT NUMBER
	IDPB T3,T2		;SET CHANNEL INTO NAME
	HRRZ T3,Q2		;GET DRIVE NUMBER
	ADDI T3,20
	IDPB T3,T2		;SET DRIVE INTO NAME
	MOVEM T1,SYRMSG+CS%DNM	;STORE SIXBIT DEVICE NAME
	SETZM SYRMSG+CS%ADS	;CAN'T GET THE SERIAL NUMBER
	LOAD T1,DSKTYP,(DSK)	;GET DISK TYPE
	STOR T1,CS%UTP,SYRMSG+CS%HTP

;LOG THE MESSAGE

	MOVEI T1,SYRHDR		;GET ADDRESS OF SYSERR MESSAGE
	MOVE T2,Q1		;GET # OF WORDS IN MESSAGE
	SKIPN TSTF		;DON'T LOG SYSERRS IF TESTING
	SYERR			;LOG IT
	 ERJMP R		;IGNORE ERRORS
	RET
;TLUSR - BUILD BLOCK FOR SUCCESSFUL STRUCTURE REMOVAL RESPONSE

;ACCEPTS: RSB/	ADDRESS OF REQUEST STATUS BLOCK

;RETURNS:  +1,	ALWAYS

TLUSR:	MOVE T1,RSBSTA(RSB)	;GET STRUCTURE NAME
	TMCT <%IStructure %1S: removed
>
	MOVEI T1,TMCMSG		;GET ADDRESS OF ASCIZ TEXT
	MOVEI T2,.MNRTX		;GET ARGUMENT TYPE
	CALL PBTXT		;CREATE TEXT BUILDING BLOCK
	SETZ T1,		;SET NO FLAGS IN GALAXY HEADER
	RET
;TLUSS - BUILD BLOCKS FOR SUCCESSFUL STRUCTURE MOUNT RESPONSE

;ACCEPTS: RSB/	ADDRESS OF REQUEST STATUS BLOCK

;RETURNS: +1:	ALWAYS

TLUSS:	STKVAR <<DVBLK,2>>
	TMCT <%I>		;NEED THIS?
	MOVE T1,[FLD(2,AR.LEN)+FLD(.MNSDV,AR.TYP)] ;GET HEADER
	MOVE T2,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	DMOVEM T1,DVBLK		;STORE HEADER AND STRUNCTURE NAME
	MOVEI T1,DVBLK		;GET ADDRESS OF DEVICE BLOCK
	CALL PBBLK		;ADD IT TO BUILDING BLOCK LIST
	SETZ T1,		;SET NO FLAGS IN GALAXY HEADER
	RET
;USD - PROCESS USER STRUCTURE DISMOUNT REQUEST RECEIVED THRU QUASAR

;ACCEPTS: T1/	ADDR OF STRUCTURE MOUNT ENTRY IN IPCF MSSG FROM QUASAR
;	  RSB/	ADDR OF REQUEST STATUS BLOCK

;RETURNS: +1,	ALWAYS

USD:	SAVEQ
	MOVEI T2,BSRRTA		;SET UP ANALYSIS TABLE FOR BTMRSB
	CALL BTMRSB		;BUILD RSB FROM QUASAR MESSAGE
	 RET			;REQUEST ABORTED, EXIT
	MOVX T1,R%DSM+R%RNR	;GET DISMOUNT and REMOVAL FLAG
	IORM T1,RSBIFL(RSB)	;AND SET INTO RSB
	CALL DDSCIH		;MAKE SURE TABLES UP-TO-DATE
	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES, MADE UNCORRECTABLE MOUNT ERROR
	MOVE T1,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	MOVE T2,RSBSTN(RSB)	;GET STRUCTURE NAME
	SETZ T4,		;No unique code
	CALL MATCHS		;MATCH REQUEST TO STRUCTURE
	 JRST [ABTRET(MREQ25)]	;STRUCTURE NOT FOUND
	STOR STR,RSBSS		;STORE STRUCTURE STATUS BLOCK ADDR

;MAKE SURE USER ISN'T CONNECTED TO STRUCTURE TO DISMOUNT

	LOAD T1,RSBJNO		;GET USER'S JOB NUMBER
	MOVE T2,[-1,,Q1]	;GET USER'S CONNECTED DIRECTORY
	MOVEI T3,.JIDNO		; INTO Q1
	GETJI
	 RET			;INVALID JOB, ABORT REQUEST
	HRROI T1,TMCMSG		;POINT TO PLACE TO PUT NAME OF CONN DIR
	MOVE T2,Q1		;GET CONNECTED DIRECTORY
	DIRST
	 JRST USD1		;FORGET CONNECTED STR
	HRROI T1,TMCMSG		;GET DESIGNATOR OF CONNECTED STR
	STDEV
USD1:	 SETZ T2,		;FORGET CONNECTED STR
	MOVE Q1,T2		;STORE DESIGNATOR IN T3
	MOVEI T1,RSBSTA(RSB)	;GET SIXBIT ALIAS
	MOVE T2,[POINT 7,MSTAL]	;THIS IS PLACE TO STORE 7-BIT
	CALL SIXSEV		;CONVERT IT
	HRROI T1,MSTAL		;POINT TO ALIAS
	STDEV			;GET ITS DESIGNATOR
	 JRST [	JUMPN STR,[MOVEI T1,RST.WD ;STR SPINNING,BUT NOT MOUNTED?
			   STOR T1,RSBSTE ;SET STATE TO WAITING
			   JRST WOVDS]
		ABTRET (MREQ25)] ;STR IS NOT TO BE FOUND
	CAMN Q1,T2		;IS USER CONNECTED TO STR BEING REMOVED?
	JRST [	ABTRET (MREQ24)] ;YES, ILLEGAL

;USER ISN'T CONNECTED TO STRUCTURE.  PREPARE TO DISMOUNT IT.

	MOVEI T1,RST.WD
	STOR T1,RSBSTE		;SET STATE TO WAITING FOR DISMOUNT
	MOVEI T1,RSBSTN(RSB)	;CONVERT SIXBIT NAME TO 7-BIT
	MOVE T2,[POINT 7,MSTNM]
	CALL SIXSEV
	CALL TCKP		;UPDATE QUASAR'S QUEUES FOR "INFO MOUNT"
	CALLRET STRDMT		;DISMOUNT STRUCTURE
;USM - PROCESS USER STRUCTURE MOUNT REQUEST RECEIVED THROUGH QUASAR

;ACCEPTS: T1/	ADDR OF STRUCTURE MOUNT ENTRY IN IPCF MSSG FROM QUASAR
;	  RSB/	ADDR OR REQUEST STATUS BLOCK

;RETURNS: +1,	ALWAYS

USM:	MOVEI T2,BSRRTA		;SET UP ANALYSIS TABLE FOR BTMRSB
	CALL BTMRSB		;BUILD RSB FROM QUASAR MESSAGE
	 RET			;REQUEST ABORTED, EXIT
	MOVEI T1,RSBSTA(RSB)	;POINT TO SIXBIT ALIAS
	MOVE T2,[POINT 7,MSTAL]	;ASCII GOES HERE
	CALL SIXSEV		;CONVERT ALIAS TO ASCII
	HRROI T1,MSTAL		;POINT TO ASCII ALIAS
	STDEV			;IS THIS A TTY: OR OTHER ILLEGAL DEVICE
	 SKIPA			;ERROR, MUST BE OKAY
	JRST [	HLRZS T2	;GET LEFT HALF OF DESIGNATOR
		CAIN T2,.DVDES+.DVDSK ;IS IT A DISK?
		JRST [	CALL TELUSR ;YES, AND ALREADY MOUNTED
			ABTRET (ABRTNR)]
		MOVEI Q1,MSTRX7 ;GET ERROR MESSAGE
		ABTRET (Q1,ABT%IN)] ;ILLEGAL DEVICE FOR MOUNT
	MOVEI T1,RST.WM
	STOR T1,RSBSTE		;SET STATE TO WAITING FOR MOUNT
	CALL DDSCIH		;MAKE SURE TABLES UP-TO-DATE

	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES, MADE UNCORRECTABLE MOUNT ERROR
	MOVE T1,RSBSTA(RSB)	;GET STRUCTURE ALIAS
	MOVE T2,RSBSTN(RSB)	;GET STRUCTURE NAME
	SETZ T4,		;No unique code
	CALL MATCHS		;MATCH REQUEST TO STRUCTURE
	 JRST [JUMPE T1,USM1	;Not found, go ask to be mounted
	       JRST DUPSTA]	;Duplicate state
	SKIPG STR		;IS STRUCTURE MOUNTED?		
	JRST [	LOAD T1,STRUNI,(STR) ;NO, GET # OF DISKS IN STR
		LOAD T2,STRMCT,(STR) ;GET # OF DISK ON-LINE IN STR
		CAME T1,T2	;ARE ALL DISKS ON-LINE?
		JRST USM1	;NO, ASK OPERATOR
		CALL STRMNT	;PACK IS SPINNING. MOUNT IT
		 JRST USM1	;PROBLEM IN MOUNTING,CHECK WITH OPERATOR
		JRST USM0]

USM0:	CALL TELUSR		;LET USER KNOW HE HAS STRUCTURE
	ABTRET (ABRTNR)		;DUMP THE RSB AND RETURN TO CALLER

;STRUCTURE IS NOT PHYSICALLY OR LOGICALLY MOUNTED, GO TELL OPERATOR TO MOUNT IT

USM1:	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES, DON'T TALK TO OPERATOR
	SKIPN T1,RSBSTN(RSB)	;GET SIXBIT STRUCTURE NAME
	MOVE T1,RSBSTA(RSB)	;NONE SPECIFIED,GET ALIAS AS NAME
	CALL TCKP		;UPDATE QUASAR'S QUEUES FOR "INFO MOUNT"
	CALL PWATCH		;WATCH FOR USER DELETING HIS PID
	CALL GETACC		;GET AN ACCOUNT BLOCK
	 JRST [	CALL DELACC	;ABORT SINCE ACC BLOCKS IN SHORT SUPPLY
		ABTRET (MREQ31)] ;AND KILL REQUEST.
	SETOM ACCDD(ACC)	;FLAG ACCOUNT BLOCK NOT DELETABLE
	GTAD			;GET NOW
	MOVEM T1,ACCSCD(ACC)	;AS SCHEDULED TIME
	LOAD T1,RSBJNO		;GET USER'S JOB NUMBER
	STOR T1,ACCJN		;SAVE IN RSB
	STOR ACC,RSBACC		;ASSOCIATE ACC WITH REQUEST
	CALLRET WOVMS		;TELL OPERATOR TO MOUNT STRUCTURE
SUBTTL CFDIS - SET UP STRING CONTAINING INFORMATION FOR SHOW CONFIG DISK

;ACCEPTS DSK/	CURRENT DISK STATUS BLOCK ADDRESS
;RETURNS +1,	ALWAYS

CFDIS:: SAVEQ
	MOVE Q1,DSKFLG(DSK)	;GET STATUS WORD

; The DSN field 

CFDIS1:	MOVE	T1,DSKSNH(DSK) ;Get serial number
	TMCT	<%17C%1D >	;Disk drive serial number (HIGH ORDER)
	MOVE	T1,DSKSNL(DSK)	;Get serial number
	TMCT	<%27C%1D>	;Disk drive serial number (LOW ORDER)

;  The mount status field

CFDIS2:	TXNE Q1,MS%MNT		;Is it mounted
	JRST [TMCT <%40CMounted> ;Yes, say it is mounted
	      JRST CFDIS3]	; and add mount count field
	TXNE Q1,MS%OFL		; OFF LINE
	JRST [TMCT <%40COffline > ;Display offline
	      JRST CFDIS3]	;
	TMCT <%40CFree>		;Display free
	MOVX T1,MSG%FR		;Get free message bit
	IORM T1,DSPFLG		;Set free message flag	

;  The structure name field 

CFDIS3:	MOVE T1,DSKSTN(DSK)	;GET STRUCTURE NAME
	JUMPE T1,CFNEX		;No name all done
	TMCT <%49C%1S%56C(>	;Add name

;  Add number of disks in structure

	LOAD T2,DSKNOU,(DSK)	;GET NUMBER OF UNITS IN STR
	LOAD T1,DSKLUN,(DSK)
	MOVE T3,T1		;SAVE UNIT NUMBER
	AOS T1			;CHANGE UNIT NUMBER TO ORDINAL
	TMCT <%1D/%2D)>		;UNIT# / # OF UNITS

CFNEX:	RET
SUBTTL WOFRE - SET UP STRING CONTAINING INFORMATION ON FREE DRIVE

;WOFRE - SET UP STRING CONTAINING INFORMATION ON FREE DRIVE

;ACCEPTS DSK/	CURRENT DISK STATUS BLOCK ADDRESS
;RETURNS +1,	ALWAYS

WOFRE::	SAVEQ
	MOVX T1,MSG%AN		;Get the any bit
	IORM T1,DSPFLG		;Say we have one

	MOVE Q1,DSKFLG(DSK)	;GET STATUS WORD

	CALL WOINI		;Go fill out the first five fields

	SKIPE	CFGFLG		;For the CONFIG command?
	 JRST	WOFRE1		;Already have structure name

;  The structure name field 

	MOVE T1,DSKSTN(DSK)	;GET STRUCTURE NAME
	JUMPE T1,WOFREX		;No name all done
	TMCT <%42C%1S%49C(>
	LOAD T1,DSKLUN,(DSK)
	AOS T1			;CHANGE UNIT NUMBER TO ORDINAL
	TMCT <%1D/>
	LOAD T1,DSKNOU,(DSK)	;GET # OF UNITS IN STRUCTURE
	TMCT <%1D)>

;  Do we have any bad disk errors?

WOFRE1:	TXNE Q1,MS%BBB		; BAD BAT BLOCKS?
	CALL [	TMCTR <%_Bad BAT blocks >] ; DISPLAY MESSAGE
	TXNE Q1,MS%WLK		; IS UNIT WRITE LOCKED?
	CALL [  TMCTR <%_Unit is write locked >] ; DISPLAY MESSAGE
	TXNE Q1,MS%HBB		; BAD HOME BLOCKS?
	CALL [  TMCTR <%_Bad HOME blocks >] ; DISPLAY MESSAGE
	TXNE Q1,MS%DIA		; IN MAINTENANCE MODE?
	CALL [  TMCTR <%_Maintenance mode >] ; DISPLAY MESSAGE
	TXNE Q1,MS%ERR		;Error while reading?
	CALL [	TMCTR <%_Error reading this unit>] ;Display message
	TXNE Q2,MS%16B		;16 Bit format?
	CALL [TMCTR <%_Unit written in 16 bit mode>] ;Display message

WOFREX: TMCT <%_>

;  Is the disk on offline CI port

	MOVE T1,DSFE+DSFFLG	;Get the disk status
	TXNE T1,DSF%PO		;Is it unavailable due to port operation?
	CALL [TMCT <%5CCan't use disk drive - Port unavailable%_>
	      RET]
	RET
SUBTTL - WOINI -- Fills in the first five fields of the display

;Accepts - DSK/disk status block 
;Returns - DSFE disk entry

WOINI:	SAVEQ
	MOVE Q1,DSKFLG(DSK)	;GET STATUS WORD

;  The # of port field

	TXNN Q1,MS%2PT		;Dual ported?
	JRST WOINI0		;No, skip indication
	TMCT <*>		;Add a asterisk
	MOVX T1,MSG%DU		;Get the display flag word
	IORM T1,DSPFLG		;Dual ported drive message is to be printed

;  The disk type field

WOINI0:	LOAD T1,MS%TYP,Q1
	MOVSI T2,-MXUTYP	;GET READY FOR SEARCH
	HLRZ T3,UNTYTB(T2)	;GRAB NEXT TYPE FROM TABLE
	CAME T1,T3		;IS THIS IT?
	AOBJN T2,.-2		;NO, KEEP GOING
	HRRZ T1,UNTYTB(T2)	;GET POINTER TO DISK TYPE STRING
	TMCT <%2C%1A>		;Type it

;  The CKU field

	LOAD T1,DSKCHN,(DSK)	;GET CHANNEL NUMBER
	TMCT <%7C%1D,>		;Type it and palce the pointer in the 10 col
	CAIE T1,CIPORT		;Is it channel 7?
	JRST WOINI1		;No, skip setting special message bit
	MOVX T1,MSG%CI		;Get the channel 7 bit 
	IORM T1,DSPFLG		;Set it in display falg to say channel 7 
WOINI1:	LOAD T1,DSKCTR,(DSK)	;GET CONTROLLER NUMBER
	CAIN T1,<.RTJST(-1,DOP%K2)> ;IS THERE ONE?
	JRST [TMCT <  ,>
	      JRST WOINI2]	;NO, put two spaces
	CAIGE T1,12		;Is it double digit?
	CALL [TMCT <0>		;No, add a zero
	      RET]
	TMCT <%1D,>		;YES, TYPE IT
WOINI2:	LOAD T1,DSKDRV,(DSK)	;GET UNIT NUMBER
	TMCT <%1D>		;Type it

;  Get the disk entry from DDB

WOINI3:	MOVE T1,DSKPNT(DSK)	;Get the pointer to DDB
	CALL DSFGET		;Go get the entry
	 $STOP <Disk entry not in DDB...WOINI2:+3>

	SKIPE	CFGFLG		;For the CONFIG command?
	 CALLRET CFDIS		;Yes, finish the display.

;  The disk status field

	MOVE T1,DSFE+DSFFLG	;Get the flag word
	TXNE T1,DSF%AV		;Is it available?
	JRST [TMCT <%17CUnavail> ;No, Say it is unavailable
	      JRST WOINI4]
	TMCT <%17CAvail>	;Say it is available for now

;  The mount status field

WOINI4:	TXNE Q1,MS%MNT		;Is it mounted
	JRST [TMCT <%26CMounted> ;Yes, say it is mounted
	      JRST WOINEX]	; and add mount count field
	TXNE Q1,MS%OFL		; OFF LINE
	JRST [TMCT <%26COffline > ;Display offline
	      JRST WOINEX]	;
	TMCT <%26CFree>		;Display free
	MOVX T1,MSG%FR		;Get free message bit
	IORM T1,DSPFLG		;Set free message flag	
WOINEX:	RET
;WOMNT - SET UP STRING CONTAINING INFORMATION ON MOUNTED DRIVE

;ACCEPTS DSK/	CURRENT DISK STATUS BLOCK ADDRESS
;RETURNS +1,	ALWAYS

WOMNT::	SAVEQ
;**;[6034]At WOMNT:+1L add 1 line JYCW 11-Aug-88
	SETZM CHKDFG		;[6034]Clear the CHECKD flag	
	MOVX T2,MSG%AN		;Get any bit
	IORM T2,DSPFLG		;Say we have one
	
	MOVE Q1,DSKFLG(DSK)	;GET STATUS WORD

	CALL WOINI		;Go fill out the first six fields

	MOVE Q2,DSFE+DSFFLG	;Save the disk status 

	SKIPE	CFGFLG		;For the CONFIG command?
	 JRST WOMNEX		;Finish off line

;  The mount count field, only for mounted disks

	MOVE T2,[POINT 7,MSTAL];SET UP POINTER FOR ALIAS
	MOVEI T1,DSKSTA(DSK)	;Get the alias
	CALL SIXSEV		;CONVERT SIXBIT ALIAS TO NEEDED 7-BIT
	MOVEI T1,MSTAL		;Get address of alias
	CALL STRSTT		;Go get the status
;**;[6034]At WOMNT:+15L replace 1 line with 2 JYCW 11-Aug-88
	 JRST [SETOM CHKDFG	;[6034]Set the flag
	       JRST WOMNT6]	;[6034]NO STRUCTURE?
	MOVEM T1,Q3		;Save the status 
	TMCT <%34C%3D>		;Output mount count

;  The structure name field 

WOMNT6:	MOVE T1,DSKSTN(DSK)	;GET STRUCTURE NAME
	JUMPE T1,WOMNEX		;No name all done
	TMCT <%42C%1S%49C(>	;Add name

;  Add number of disks in structure

	LOAD T2,DSKNOU,(DSK)	;GET NUMBER OF UNITS IN STR
	LOAD T1,DSKLUN,(DSK)
	MOVE T3,T1		;SAVE UNIT NUMBER
	AOS T1			;CHANGE UNIT NUMBER TO ORDINAL
	TMCT <%1D/%2D)>		;UNIT# / # OF UNITS
	SOJE T2,WOMNT3		;JUMP IF ONLY ONE UNIT
	SKIPE T3		;IS THIS FIRST UNIT OF STRUCTURE?
	JRST WOMNEX		;NO, HAVE ALREADY OUTPUT INFORMATION

;  The usage option field

WOMNT3:	TMCT <%55C>		;Go to the usage option colume

;  Q3 should still contain the status


	TXNE Q3,MS%EXC		;Is it?
	CALL [TMCT <Excl >	;Assume exclusive
	      RET]


	TXNE Q3,MS%DIS		;IS IT
	CALL [TMCT <Unavail >	;Assume available
	      RET]

;  Set up for ignore

	MOVEI T1,.DVSTR		;Get the type
	MOVEM T1,DSFE+DSFTYP	;Save it
	MOVE T1,DSKSTA(DSK)	;Get the alias
	MOVEM T1,DSFE+DSFSPC	;Save it
	CALL DSFLOC		;Go find the entry
	 $STOP <Can't find structure entry in DDB.>

;  This is for ignored case

	MOVE T1,DSFE+DSFFLG	;Get the structure status flag word
	TXNE T1,DSF%IG		;Is it ignored
	CALL [TMCT <Ignored >	;Yes
	      RET]

;  The alias field

	MOVE T2,DSKSTA(DSK)	;Get structure name 
	CAMN T2,DSKSTN(DSK)	;ARE NAME AND ALIAS THE SAME?
	JRST WOMNEX		;YES
	TMCT <(Alias %2S)>	;Output name

WOMNEX:	TMCT <%_>		;Finish the line off
	
;  Is the disk on offline CI port

	TXNE Q2,DSF%PO		;Is it unavailable due to port operation?
	CALL [TMCT <%5CCan't use disk drive- Port unavailable%_>
	      RET]
;**;[6034]At WOMNEX:+3L add 6 lines JYCW 11-Aug-88
	SKIPE CHKDFG		;[6034]Did we get an STRSTT error
	CALL CHECKD		;[6034]Check whether CHECKD has it
	RET			;[6034]No all done
	HLRZ T1,T3		;[6034]Get the job number
	MOVEI T2,DEVX2		;[6034]Yes, get correct error code
	TMCT <* %2J, Job %1O *%_>;[6034]

	RET
SUBTTL WOMDAV - TELL OPERATOR OF AVAILABILITY OF DISK DRIVE FOR SYSTEM USE

;ACCEPTS: Q1/  1 IF UNAVAILABLE, 0 IF AVAILABLE
;	  Q2/  CKU NUMBER
;RETURNS: +1,  ALWAYS

WOMDAV::MOVE T1,Q2		;COPY FOR CALL
	TMCT <%I%1K set >	;TYPE UNIT ADDRESS
	JUMPN Q1,[TMCT <un>
		  JRST .+1]
	TMCT <available for mounting by MOUNTR>
	MOVE T3,[[ASCIZ/Disk Drive Set Available/]
		 [ASCIZ/Disk Drive Set Unavailable/]](Q1) ;GET HEADER
	CALLRET BTWTO		;GET MESSAGE OUT TO OPERATOR
SUBTTL WOSM - TELL OPERATOR OF A STRUCTURE


WOSM:	MOVEI T1,MSTNM		;GET STRUCTURE NAME
	TMCT <%IStructure %1A>
	MOVE T1,MSTNM		;ARE ALIAS AND NAME THE SAME
	CAME T1,MSTAL
	JRST WOS1		;NO, PRINT THE ALIAS
	MOVE T1,MSTNM+1
	CAMN T1,MSTAL+1
	RET			;YES, FORGET THE ALIAS
WOS1:	MOVEI T1,MSTAL		;POINT TO ALIAS
	TMCTR <: (Alias: %1A)>

;WOSDM - TELL OPERATOR OF A STRUCTURE DISMOUNT

WOSDM:	CALL WOSM		;SET UP STRUCTURE NAMES
	TMCT < dismounted>
	MOVEI T3,[ASCIZ/Structure Dismounted/]
	CALLRET BTWTO		;TELL OPERATOR

;WOSMT - TELL OPERATOR OF A STRUCTURE MOUNT

WOSMT:	CALL WOSM		;SET UP STRUCTURE NAMES
	TMCT < mounted>
	MOVEI T3,[ASCIZ/Structure Mounted/]
	CALLRET BTWTO		;TELL OPERATOR

;WOSSC - TELL OPERATOR STATUS OF STRUCTURE AFTER STATUS CHANGE

WOSSC:	STAKT
	MOVEI T2,MSTAL		;GET STRUCTURE NAME
	TMCT <%I%2A: set %1A for use by system>
	MOVEI T3,[ASCIZ/Structure Status Set/]
	CALL BTWTO		;GET MESSAGE TO OPERATOR
	CAIE Q3,S.EXCL		;Is it exclusive
	CAIN Q3,S.SHAR		;or share
	JRST [	ABTRET (ABRTNR)] ;Yes, abort the request
	RET			;Else return
;WRDSC - ASK OPERATOR IF STRUCTURE SHOULD BE REMOVED, EVEN THOUGH THERE
;	 ARE USERS ON IT

;ACCEPTS: T1/	ADDRESS OF RESPONSE HANDLER CALLED BY INWTOR
;	  STR/	ADDRESS OF STRUCTURE STATUS BLOCK
;	  RSB/	ADDRESS OF REQUEST STATUS BLOCK

;RETURNS: +1,	ALWAYS

WRDSC::	MOVE T3,STRNAM(STR)	;GET STRUCTURE NAME
	MOVE T2,STRALI(STR)	;GET ALIAS
	CALL WTOCHK		;IS WTO DIASABLED
	RET			;YES
	TMCTI <DSMHDR>		;Build dismount message
	MOVEI T2,RSBWTB(RSB)	;GET WTB ADDRESS
	MOVEI T3,[ASCIZ/Dismount Query/]
	CALLRET BTWTOR		;SEND WTOR OFF TO THE OPERATOR
;WOVDS - TELL OPERATOR A STRUCTURE MUST BE DISMOUNTED AND ACCEPT A
;	 POSSIBLE REFUSAL

;ACCEPTS: STR/	ADDRESS OF STRUCTURE STATUS BLOCK
;	  RSB/	ADDRESS OF REQUEST STATUS BLOCK

;RETURNS: +1,	ALWAYS

WOVDS:	MOVE T1,STRNAM(STR)	;GET SIXBIT STRUCTURE NAME
	MOVE T2,RSBSTA(RSB)	;GET SIXBIT STRUCTURE ALIAS
	CALL WTOCHK		;IS WTO DISABLED?
	RET			;YES
	MOVE T3,RSBIFL(RSB)	;Get the remove noremove bit
	TXNE T3,R%RNR		;To remove?
	JRST [ TMCT <%IRemove %1S: (alias %2S:)%_%U%_>
	       JRST .+2]
	TMCT <%IDo not remove %1S: (alias %2S:)%_%U%_>
	SKIPE RSBRMK(RSB)	;DID THE USER SUPPLY A REMARK?
	JRST [	MOVEI T1,RSBRMK(RSB) ;YES, GET ADDRESS OF ASCIZ REMARK
		TMCT <User's remark: %1A%_>
		JRST .+1]
	SKIPE T1,RSBOBN(RSB)	;[6011]Get "on behalf node name"
	TMCT <Structure is dismounted on behalf of %1S::%_>
	MOVEI T1,DSKHDR		;GET STATUS HEADER TEXT
	TMCT <%1A>
	LOAD Q1,STRUNI,(STR)	;GET NUMBER OF UNITS IN STRUCTURE
	MOVNS Q1		;SET UP INDEX
	HRLZ Q1,Q1
	MOVE T1,STR
	ADDI T1,STRADD		;GET INDEX TO START OF DISK ADDRESSES
	HRR Q1,T1		;GET ADDRESS FOR DISK
WOVD1:	MOVE DSK,(Q1)		;GET DISK BLOCK ADDRESS
	JUMPE DSK,WOVD2		;JUMP IF PACK GONE
	MOVX T1,MS%MNT		;MAKE SURE DISK IS NOT MOUNTED
	ANDCAM T1,DSKFLG(DSK)
	CALL WOFRE		;DISPLAY UNIT
WOVD2:	AOBJN Q1,WOVD1		;IF MORE PACKS, DISPLAY THEM
	MOVE T3,RSBIFL(RSB)	;Get the remove noremove bit
	TXNE T3,R%RNR		;To remove?
        JRST [TMCT <Structure cannot be mounted again unless MOUNTed via OPR or until removed%_>
	       JRST .+2]
	TMCT <Structure cannot be mounted unless MOUNTed via OPR%_>
	MOVEI T2,RSBWTB(RSB)	;GET WTB ADDRESS
	MOVEI T3,[ASCIZ/Dismount Structure/]
	CALL BTNFO		;No formatting
	CALLRET BTWTO		;SEND WTO OFF TO THE OPERATOR
;WOVMS - TELL OPERATOR A STRUCTURE MUST BE MOUNTED

;ACCEPTS: RSB/ ADDRESS OF REQUEST STATUS BLOCK

;RETURNS: +1,	ALWAYS

WOVMS:	CALL MESCHK		;HAVE WE ALREADY NOTIFIED OPR OF STR?
	RET			;YES, FORGET THIS
	CALL WTOCHK		;IS WTO DISABLED
	RET			;YES
	SKIPGE T1,RSBITN(RSB)	;GET REQUEST # if not from operator
	JRST [TMCT <%IStructure Mount Request made by operator>
	      JRST WOVM0]
	TMCT <%IStructure Mount Request # %1D>
	SETONE R%ONR,RSBIFL(RSB) ;SET OPERATOR-NOTIFIED
WOVM0:	CALL CPYHDR		;COPY HEADER TO OPRHDR
	SKIPN T1,RSBSTN(RSB)	;GET SIXBIT STRUCTURE NAME
	MOVE T1,RSBSTA(RSB)	;NONE SPECIFIED, GET ALIAS AS NAME
	MOVE T2,RSBSTA(RSB)	;GET SIXBIT STRUCTURE ALIAS
	TMCT <%IMount %1S: (alias %2S:)%_%U%_>
	SKIPE RSBRMK(RSB)	;DID THE USER SUPPLY A REMARK?
	JRST [	MOVEI T1,RSBRMK(RSB) ;YES, GET ADDRESS OF REMARK
		TMCT <User's remark: %1A%_>
		JRST .+1]
	CALL KSHDF		;Displace the headers
	MOVEI T1,DSKHDR
	TMCT <%1A>

;  Loop through all disks

	MOVEI T1,.DVDSK		;Get the disk type
	MOVEM T1,DSFE+DSFTYP	;Save it in DSFE
	SETZ T1,		;Go for the first

	SETZ Q1,		;SET FLAG TO SAY NO AVAILABLE DRIVES
WOVM1:	CALL DSFGNX		;Go get an entry
	 JRST WOVM3		;No more
	PUSH P,T1		;Save pointer
	SKIPN DSK,DSFE+DSFPNT	;Get disk status block address
	JRST WOVM2		;No disk status block, get the next disk
	MOVE T1,DSKFLG(DSK)	;Get te status flag
	TXNN T1,MS%MNT		;IS THIS DISK MOUNTED?
	TXNE T1,MS%DIA		;NO, IS IT IN MAINT MODE?
	JRST WOVM2		;YES, SKIP THIS DISK
	CALL WOFRE		;DISPLAY STATUS OF THIS DRIVE
	SETO Q1,		;SET FLAG TO SAY WE HAVE A DRIVE

WOVM2:	MOVEI T1,.DVDSK		;Get the disk type
	MOVEM T1,DSFE+DSFTYP	;Save it in DSFE
	POP P,T1		;Get the pointer back
	JRST WOVM1		;Get the next

WOVM3:	JUMPE Q1,[TMCT <%INo drives available> 
		JRST .+1]
	MOVEI T3,OPRHDR		;GET ADDRESS OF HEADER TEXT
	CALL BTNFO		;No formatting	
	CALLRET BTWTO		;SEND WTO OFF TO THE OPERATOR
SUBTTL USER TAPE MOUNT REQUEST

; BTMRSB - EXTRACT INFORMATION FROM USER MOUNT REQUEST AND
;	   TRANSFER IT TO THE REQUEST STATUS BUFFER
;  T1/ ADDRESS OF MOUNT ENTRY IN IPCF MESSAGE FROM QUASAR
;  T2/ ADDRESS OF TABLE MOUNT REQUEST ANALYSIS ROUTINE ADRESSES
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: FAILURE, MOUNT REQUEST ABORTED
;	  +2: SUCCESS, INFORMATION TRANSFERRED TO RSB

BTMRSB:	SAVEQ
	DMOVE Q1,T1		;COPY ADDRESSES TO A SAFE PLACE

; PERFORM STRUCTURAL VALIDATION OF MOUNT ENTRY

	MOVE T1,.MECNT(Q1)	;GET SUBENTRY COUNT
	MOVEI T2,.MEHSZ(Q1)	;GET ADDRESS OF FIRST SUBENTRY
	LOAD T3,AR.LEN,.MEHDR(Q1) ;GET LENGTH OF SUBENTRY
	SUBI T3,.MEHSZ		;COMPUTE SIZE OF SUBENTRY AREA
	SKIPL T3		;ERROR IF HEADER IS INCOMPLETE
	CALL CKBSTR		;CHECK STRUCTURE OF MOUNT REQUEST
	 JRST [	ABTRET (MREQ20)] ;STRUCTURE ERROR IN MOUNT ENTRY

; PERFORM SEMANTIC ANALYSIS OF MOUNT ENTRY

BTMR1:	MOVEI T1,.MECNT(Q1)	;ADDRESS OF SUBENTRY COUNT WORD
	MOVEI T2,.MEHSZ(Q1)	;ADDRESS OF FIRST SUBENTRY
	SKIPN (Q2)		;FINISHED WITH ANALYSIS ROUTINES?
	RETSKP			;YES, GO HOME
	CALL @(Q2)		;CALL ANALYSIS ROUTINE
	 RET			;ERROR DETECTED, PASS IT TO CALLER
	AOJA Q2,BTMR1		;LOOP THRU ALL ANALYSIS ROUTINES

; TABLE OF TAPE MOUNT REQUEST ANALYSIS ROUTINE ADDRESSES
;   WARNING:
;   DO NOT CHANGE THE ORDER OF THE ROUTINES IN THIS TABLE - SOME
;   DEPEND UPON RSB FIELDS SET UP BY THEIR PREDECESSORS

BTRRTA:	IFIW!BTRFLG		;BIT FLAGS
	IFIW!BTRDEN		;DENSITY
	IFIW!BTRDRV		;DRIVE-TYPE
	IFIW!BTRLT		;LABEL TYPE
	IFIW!BTRSET		;SET NAME
	IFIW!BTRRMK		;REMARK
	IFIW!BTRVLS		;VOLID LIST
	IFIW!BTRSTV		;STARTING VOLID NUMBER
	IFIW!BTRVPR		;VOLUME PROTECTION
	0			;END OF ROUTINES

;TABLE OF STRUCTURE MOUNT REQUEST ANALYSIS ROUTINE ADDRESSES
;    WARNING:
;    BSRALI MUST BE AFTER BSRNAM IN THE TABLE

BSRRTA:	IFIW!BSRALI		;ALIAS OF STRUCTURE
	IFIW!BSRNAM		;NAME OF STRUCTURE
	IFIW!BTRRMK		;REMARK
	0			;END OF ROUTINES
; ROUTINES FOR PROCESSING SUBENTRIES OF TAPE MOUNT REQUEST
;  T1/ ADDRESS OF SUBENTRY COUNT WORD
;  T2/ ADDRESS OF FIRST SUBENTRY
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST ABORTED
;	  +2: SUBENTRY PROCESSED SUCCESSFULLY

; DENSITY

BTRDEN:	MOVEI T3,.TMDEN
	MOVEI T4,DENMAX		;GET MAXIMUM
	CALL BTRG1		;LOOKUP DENSITY PARAMETER
	 JRST [	ABTRET (MREQX3)] ;DENSITY ILLEGAL
	STOR T1,RSBDEN		;STORE DENSITY IN RSB
	RETSKP

; DRIVE TYPE

BTRDRV:	MOVEI T3,.TMDRV
	MOVEI T4,.TMDMX		;GET MAXIMUM
	CALL BTRG1		;LOOKUP DRIVE PARAMETER
	 JRST [	ABTRET (MREQX4)] ;DRIVE TYPE ILLEGAL
	STOR T1,RSBDRV		;STORE DRIVE TYPE IN RSB
	RETSKP

; BIT FLAGS

BTRFLG:	MOVE T1,.MEFLG(Q1)	;GET USER-SUPPLIED FLAGS
	TXNE T1,TM%BYP		;DOES HE WANT BYPASS?
	JRST [	MOVX T2,R%PRIV	;YES
		TDNE T2,RSBIFL(RSB) ;IS HE PRIVILEGED?
		JRST .+1	;YES, LET HIM DO IT
		ABTRET (CAPX1)]	;NOT PRIVILEGED, ABORT REQUEST
	TXNE T1,TM%SCR
	JRST [	TXO T1,TM%NEW+TM%WEN ;FLAGS IMPLIED BY TM%SCR
		TXZ T1,TM%OSV+TM%VFY
		JRST .+1]
	TXNE T1,TM%NEW
	JRST [	TXO T1,TM%WEN	;FLAGS IMPLIED BY TM%NEW
		TXZ T1,TM%VFY
		MOVX T2,R%WVL
		IORM T2,RSBIFL(RSB)
		JRST .+1]
	MOVEM T1,RSBUFL(RSB)	;MOVE USER REQUEST FLAGS TO RSB
	RETSKP
; LABEL TYPE (MUST BE CALLED AFTER BTRDRV)

BTRLT:	MOVEI T3,.TMLT
	MOVEI T4,.LTMAX		;GET MAXIMUM
	CALL BTRG1		;LOOKUP DRIVE-TYPE PARAMETER
	 JRST [	ABTRET (MREQX5)] ;LABEL TYPE ILLEGAL
	MOVX T2,TM%BYP
	TDNE T2,RSBUFL(RSB)	;BYPASS?
	MOVEI T1,.LTUNL		;YES, FORCE LABEL TYPE = UNLABELED
	CAIE T1,.LTUNL		;LABELED TAPE?
	JUMPN T1,[LOAD T2,RSBDRV ;YES, GET DRIVE TYPE
		CAIE T2,.TMDR7	;7-TRACK?
		JRST .+1	;NO
		ABTRET (MREQX2)] ;YES, 7-TRACK LABELS NOT SUPPORTED
	STOR T1,RSBLT		;STORE LABEL TYPE IN RSB
	RETSKP

; REMARK

BTRRMK:	MOVEI T3,.TMRMK
	CALL BLKFND		;LOOKUP REMARK
	 RETSKP			;NO REMARK
	JUMPE T2,RSKP		;TREAT ZERO-LENGTH REMARK LIKE NO REMARK
	CAILE T2,RMKLEN		;IS REMARK TOO LONG?
	MOVEI T2,RMKLEN		;YES, TRUNCATE
	MOVSS T1		;BLT SOURCE
	HRRI T1,RSBRMK(RSB)	;BLT DESTINATION
	ADDI T2,RSBRMK-1(RSB)	;LAST WORD OF DESTINATION
	BLT T1,(T2)		;BLT REMARK INTO RSB
	MOVEI T1,377
	ANDCAM T1,(T2)		;MAKE SURE REMARK ENDS WITH A NULL
	RETSKP

; SETNAME

BTRSET:	MOVEI T3,.TMSET
	CALL BLKFND		;LOOKUP SETNAME
	 JRST BTRSE1		;SETNAME MISSING
	JUMPE T2,BTRSE1		;ERROR IF HEADER-ONLY SUBENTRY
	MOVE T1,(T1)		;GET SETNAME IN T1 FOR CHKID
	CALL CHKID		;IS IT A LEGAL SETNAME?
BTRSE1:	 JRST [	ABTRET (MREQX6)] ;SETNAME ILLEGAL OR MISSING
	MOVEM T1,RSBSSN(RSB)	;STORE USER-SUPPLIED SETNAME IN RSB
	MOVX T2,TM%NEW
	TDNE T2,RSBUFL(RSB)	;USER CREATING NEW VOLUME SET?
	MOVEM T1,RSBASN(RSB)	;YES, HIS SETNAME GOES IN THE LABELS
	RETSKP
; STARTING VOLID NUMBER (MUST BE CALLED AFTER BTRVLS)

BTRSTV:	SAVEQ
	MOVEI T3,1
	STOR T3,RSBCV		;DEFAULT CURRENT VOLID # IS 1
	MOVEI T3,.TMSTV
	CALL BLKFND		;STARTING VOLID ENTRY PRESENT?
	 RETSKP			;NO, DEFAULT WILL BE USED
	JUMPE T2,BTRSTI		;ERROR IF HEADER-ONLY SUBENTRY
	MOVX T3,TM%OSV+TM%NEW
	TDNE T3,RSBUFL(RSB)	;ANY BITS SET?
	JRST BTRSTI		;YES, USER CAN'T SPECIFY THIS PARAMETER
	SKIPE Q1,(T1)		;SPECIFYING NUMBER OR VOLID?
	JRST [	CALL VQCNT	;NUMBER, GET # OF VOLIDS IN REQUEST
		CAMG Q1,T1	;ERROR IF SPECIFIED VALUE .GT. MAX
		SKIPG Q1	;ERROR IF STARTING VOLID NOT POSITIVE
		JRST BTRSTI
		STOR Q1,RSBCV	;OFFSET IS LEGAL, STORE IT
		RETSKP]
	CAIGE T2,2		;SPECIFYING VOLID, IS ENTRY LONG ENOUGH?
	JRST BTRSTI		;NO
	MOVE Q1,1(T1)		;GET VOLID
	MOVEI Q2,1		;GET COUNTER
	QSCANI <RSBVLS(RSB)>	;SET UP TO SCAN VOLID LIST
BTRST1:	CALL QMSCAN		;LOOK AT NEXT VOLID FOR THIS REQUEST
BTRSTI:	 JRST [	ABTRET (MREQX7)] ;ABORT REQUEST - ILLEGAL STARTING VOLID
	CAME Q1,1(T2)		;IS THIS THE ONE?
	AOJA Q2,BTRST1		;NO, BUMP COUNTER & CONTINUE SEARCH
	STOR Q2,RSBCV		;FOUND IT, STORE ORDINAL VOLID #
	RETSKP
; VOLID LIST

BTRVLS:	SAVEQ
	MOVX T3,TM%OSV+TM%SCR
	TDNE T3,RSBUFL(RSB)	;IS USER PERMITTED TO SPECIFY VOLIDS?
	RETSKP			;NO, IGNORE VOLID LIST IF PRESENT
	MOVEI T3,.TMVOL
	CALL BLKFND		;LOOKUP VOLID LIST
	 SETZ T2,		;NO VOLID LIST
	JUMPE T2,[MOVX T2,TM%OSV+TM%NEW ;ZERO-LENGTH IS LIKE NO LIST
		TDNE T2,RSBUFL(RSB) ;IS VOLID LIST REQUIRED?
		RETSKP		;NO, LET HIM BY
		ABTRET (MREQ17)] ;YOU FORGOT TO LIST YOUR VOLIDS FELLA
	MOVN Q1,T2		;GET -#VOLIDS IN Q1
	MOVSS Q1		;CONSTRUCT LEFT HALF OF AOBJN POINTER
	HRR Q1,T1		;VOLID SOURCE ADDRESS IN RIGHT HALF
BTRVL1:	MOVE T1,(Q1)		;GET A VOLID FROM SUBENTRY
	CALL CHKID		;IS IT A LEGAL VOLID?
	 JRST [	ABTRET (MREQX9)] ;NO, ABORT REQUEST
	CALL VQADD		;ADD VOLID TO END OF LIST
	 RET			;POOL EXHAUSTED, REQUEST ABORTED
	AOBJN Q1,BTRVL1		;LOOP TO TRANSFER ALL VOLIDS
	RETSKP

; VOLUME PROTECTION

BTRVPR:	MOVEI T3,.TMVPR
	CALL BLKFND		;SEARCH FOR VOLUME-PROTECTION ENTRY
	 SETZ T2,		;NONE FOUND
	MOVE T1,(T1)		;GET ARG IF THERE
	SKIPN T2		;SKIP IF ARGUMENT PRESENT
	MOVEI T1,777777		;USE DEFAULT
	STOR T1,RSBVPR		;STORE VOLUME-PROTECTION CODE
	RETSKP
; BTRG1 - GET A NUMERIC ARGUMENT FROM A BUILDING-BLOCK LIST
;	  IF NO VALUE SPECIFIED, RETURN 0
;	  IF VALUE SUPPLIED, VERIFY THAT 0 .LE. VALUE .LE. MAXIMUM
; T1-T3/ ARGUMENTS FOR BLKFND
; T4/ MAXIMUM VALUE
; RETURNS +1: ENTRY CONTAINS HEADER ONLY OR ARG LIES OUTSIDE LIMITS
;	  +2: ARGUMENT VALID, T1/ VALUE

BTRG1:	STAKT
	CALL BLKFND		;SEARCH FOR ENTRY
	 JRST [	SETZ T1,	;ENTRY NOT THERE, RETURN ZERO
		RETSKP]
	JUMPE T2,R		;ERROR IF HEADER-ONLY
	SKIPGE T1,(T1)		;GET ARGUMENT
	RET			;CAN'T BE LESS THAN ZERO
	CAMLE T1,CT4
	RET			;.GT. UPPER LIMIT
	RETSKP


; TCITN - CANCEL A TAPE MOUNT REQUEST WITH A SPECIFIED ITN
;  T1/ INTERNAL TASK NAME (ITN) OF REQUEST TO BE CANCELED
; RETURNS +1: ITN NOT FOUND OR REQUEST COULD NOT BE CANCELED
;	  +2: REQUEST CANCELED

TCITN:	QSCANI ARBQDB		;SET UP TO SCAN TAPE REQUEST QUEUE
	SAVEAC <RSB>
	SAVEQ
	MOVE Q1,T1		;SAVE ITN
TCITN1:	CALL QMSCAN		;GET ADDR OF NEXT RSB IN T2
	 RET			;NONE LEFT, EXIT
	MOVEI RSB,-RSBLNK(T2)	;GET ADDRESS OF RSB INTO RSB AC
	CAME Q1,RSBITN(RSB)	;IS THIS THE RIGHT REQUEST?
	JRST TCITN1		;NO, CONTINUE SEARCH
	LOAD T1,RSBTYP
	CAIN T1,.MNTTP		;TAPE REQUEST?
	JRST [	JE RSBMT,,.+1	;YES, CANCEL ONLY IF MT NOT ASSIGNED YET
		RET]		;MT ASSIGNED, CAN'T CANCEL IT
	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES, CAN'T CANCEL
	CALL CHKDSM		;[335]Check to see if we a doing a str dismount
	ABTREQ (MREQX1)		;OK, KILL TI
	CALL WORCAN		;TELL OPERATOR REQUEST WAS CANCELED
	RETSKP

;**;[335]At TELMON:-1L add 8 lines  JYCW 12/5/86
;CHKDSM - Call only by TCITN to set the structure back to its previous
;	  state if we are canceling a dismount request. 
;Accepts RSB/Request Status Block
;Returns +1 always
CHKDSM:	LOAD T1,RSBTYP		;[335]Get the request type
	CAIE T1,.DSMST		;[335]Dismount str request?
	JRST CHKDS1		;[335]No, all done
	MOVE T1,RSBSTA(RSB)	;[335]Get structure alias
	MOVE T2,RSBSTN(RSB)	;[335]Get structure name
	SETZ T4,		;[335]No unique code
	CALL MATCHS		;[335]Get SSB in STR
	 SKIPA			;[335]Not there
	CALL STSTBK		;[335]Set str back to its previous state
CHKDS1:	RET
; TELMON - TELL THE MONITOR A TAPE VOLUME SWITCH WAS NOT PERFORMED
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

MTUABS==3			;SIZE OF ARGUMENT BLOCK
TELMON:	STKVAR <<MTUAB,MTUABS>>
	MOVEI T1,MTUABS
	MOVEM T1,.MTCNT+MTUAB	;SET COUNT IN ARGUMENT BLOCK
	LOAD T1,RSBSTE		;GET ERROR CODE
	MOVEM T1,.MTCOD+MTUAB	;SET ERROR CODE IN ARG BLOCK
	SETZ T1,		;ASSUME NO ERROR MESSAGE
	MOVX T2,R%ORES
	TDNE T2,RSBIFL(RSB)	;IS THERE AN OPERATOR RESPONSE?
	HRROI T1,ATMBFR		;YES, GET POINTER TO RESPONSE STRING
	MOVEM T1,.MTPTR+MTUAB	;SET STRING POINTER OR 0 IN ARG BLOCK

; ARGUMENT BLOCK IS SET UP, NOW LOAD THE AC'S AND ISSUE THE CALL

	MOVEI T1,.MTNVV		;GET MTU FUNCTION CODE
	LOAD T2,RSBMT		;GET MT STATUS BLOCK ADDRESS
	SUBI T2,MT0		;COMPUTE DISPLACEMENT FROM 0TH BLOCK
	IDIVI T2,MTSZ		;COMPUTE MT#
	MOVEI T3,MTUAB		;GET ARGUMENT BLOCK ADDRESS
	MTU%			;TELL MONITOR
	RET
; TELUSR - BUILD AND SEND IPCF MESSAGE TO USER TO NOTIFY HIM OF THE
;	   DISPOSITION OF A MOUNT REQUEST
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

TELUSR:	SAVEQ
	SETZM TBUF+.OFLAG	;CLEAR FLAGS WORD
	CALL PBINIT		;SET UP FOR CREATING BUILDING BLOCKS
	MOVE Q1,[2,,.MNRNM]	;BUILD BLOCK CONTAINING REQUEST NAME
	MOVE Q2,RSBRNM(RSB)
	MOVEI T1,Q1
	CALL PBBLK
	LOAD T1,RSBSTE		;GET REQUEST STATE
	CAIN T1,ABRTNR		;SHOULD USER GET A RESPONSE?
	RET			;NO, EXIT
	CAIL T1,.ERBAS		;IS THE REQUEST ABORTED?
	JRST [	CALL TLUAB	;YES, BUILD MESSAGE FOR ABORT
		JRST TELUS1]
	LOAD T1,RSBTYP		;GET REQUEST TYPE
	MOVEI T2,STOP		;IN CASE NO MATCH IS FOUND
	CAIN T1,.MNTTP		;TAPE-MOUNT?
	MOVEI T2,TLUTS		;YES
	CAIN T1,.MNTST		;STRUCTURE MOUNT?
	MOVEI T2,TLUSS		;YES
	CAIN T1,.DSMST		;DISMOUNT STRUCTURE?
	MOVEI T2,TLUSR		;YES
NOSHIP,<
	CAIN T1,.MNTDT		;DECTAPE-MOUNT?
	MOVEI T2,TLUDT		;YES
>;NOSHIP
	CALL (T2)		;CALL APPROPRIATE TELL-ROUTINE

; TELUS1 - T1/ GALAXY HEADER FLAGS

TELUS1:	MOVE T2,T1		;COPY FLAGS TO T2 FOR GALHDR
	MOVE T1,PBBPT		;GET POINTER AFTER LAST BLOCK
	SUBI T1,TBUF		;COMPUTE LENGTH OF MESSAGE
	MOVSS T1		;MOVE TO LH OF T1
	HRRI T1,.QOMNA		;PUT MESSAGE TYPE IN RIGHT HALF
	MOVE T3,RSBCOD(RSB)	;GET USER'S ACK CODE
	CALL GALHDR		;BUILD GALAXY HEADER FOR USER
	MOVE T1,RSBPID(RSB)	;GET USER'S PID
	CALLRET TRANU		;SEND THE MESSAGE AND RETURN TO CALLER
; TLUTS - BUILD BLOCKS FOR SUCCESSFUL TAPE MOUNT RESPONSE

TLUTS:	STKVAR <<DVBLK,3>,SAVMT>
	CALL VQGCV		;GET CURRENT VOLID IN T1
	MOVE T2,RSBSSN(RSB)	;GET SETNAME
	JUMPE T1,[TMCT <%I[Tape set %2S, scratch tape mounted]%_>
		JRST TLUTS1]
	TMCT <%I[Tape set %2S, volume %1S mounted]%_>
TLUTS1:	JN TM%OSV,RSBUFL(RSB),[TMCT <[Volume identifiers: >
		CALL TMCVLS	;DISPLAY VOLID LIST
		TMCT <]
>
		JRST .+1]
	MOVEI T1,TMCMSG		;GET ADDR OF ASCIZ TEXT
	MOVEI T2,.MNRTX		;GET ARGUMENT TYPE
	CALL PBTXT		;CREATE TEXT BUILDING BLOCK
	MOVE T1,[FLD(3,AR.LEN)+FLD(.MNRDV,AR.TYP)] ;GET HEADER
	MOVE T2,RSBSSN(RSB)	;GET SETNAME
	DMOVEM T1,DVBLK		;STORE HEADER AND SETNAME
	MOVEM MT,SAVMT		;PRESERVE MT AC
	LOAD MT,RSBMT		;GET ADDR OF MT STATUS BLOCK
	CALL GMTDD		;GET MT DEVICE DESIGNATOR IN T1
	MOVE MT,SAVMT		;RESTORE MT AC
	MOVEM T1,2+DVBLK	;STORE MT DESIGNATOR IN .MNRDV BLOCK
	MOVEI T1,DVBLK		;GET ADDRESS OF .MNRDV BLOCK
	CALL PBBLK		;ADD IT TO BUILDING BLOCK LIST
	SETZ T1,		;SET NO FLAGS IN GALAXY HEADER
	RET
; TLUAB - BUILD BLOCKS FOR UNSUCCESSFUL MOUNT-REQUEST RESPONSE

TLUAB:	SAVEQ
	MOVE Q1,[FLD(2,AR.LEN)+FLD(.MNREC,AR.TYP)] ;GET HEADER
	LOAD Q2,RSBSTE		;GET ERROR CODE
	MOVEI T1,Q1		;POINT AT ERROR CODE BLOCK
	CALL PBBLK		;PUT BLOCK IN MESSAGE
	JN R%ORES,RSBIFL(RSB),[MOVEI T1,ATMBFR ;POINT TO REASON
		TMCT <%IReason given by operator: %1A>
		MOVEI T1,TMCMSG	;GET ADDRESS OF ASCIZ TEXT
		MOVEI T2,.MNRTX	;GET ENTRY TYPE
		CALL PBTXT	;INSTALL TEXT BUILDING BLOCK
		JRST .+1]
	MOVX T1,MF.FAT		;GET FATAL-ERROR FLAG
	RET
; TRESCK - CHECK IF THE SYSTEM HAS AT LEAST ONE OF THE TYPE OF
;	   TAPE DRIVE REQUESTED BY THE USER JOB
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST CANNOT BE HANDLED BY THE SYSTEM
;	  +2: REQUEST CAN BE HANDLED BY THE SYSTEM

TRESCK:	SAVEAC <MTA>
	SAVEQ
	SKIPE TSTF		;TEST MODE?
	RETSKP			;YES, ALWAYS SUCCEED
	MOVE Q1,MTAN		;GET # OF MTA DEVICES ON SYSTEM
	MOVEI MTA,MTA0-MTASZ	;INIT MTA AC FOR STATUS BLOCK SCAN
	LOAD Q2,RSBDRV		;GET REQUESTED DRIVE TYPE

; SCAN AVAILABLE TAPE DRIVES FOR ONE THAT CAN POTENTIALLY
; SATISFY THE USER TAPE MOUNT REQUEST

TRES1:	SOJL Q1,R		;TAKE +1 RETURN IF NONE LEFT TO CHECK
	ADDI MTA,MTASZ		;POINT AT NEXT MTA STATUS BLOCK
	JE MTASTE,,TRES1	;SKIP DRIVE IF NOT ASSIGNED TO ME
	JUMPN Q2,[LOAD T1,MTADRV ;GET TYPE OF DRIVE
		CAME T1,Q2	;DOES IT MATCH WHAT THE USER WANTS?
		JRST TRES1	;NO, SKIP IT
		JRST .+1]
	LOAD T1,RSBDEN		;GET REQUESTED DENSITY
	JUMPE T1,RSKP		;OK IF NOT PARTICULAR ABOUT DENSITY
	CALL DRVDEN		;CAN THE DRIVE OPERATE AT THIS DENSITY?
	 JRST TRES1		;NO, SKIP IT
	RETSKP			;OK, AT LEAST 1 DRIVE CAN DO IT
; UTM - PROCESS USER TAPE MOUNT REQUEST RECEIVED THROUGH QUASAR
;	1 - ANALYZE BUILDING-BLOCK REQUEST AND BUILD RSB
;	2 - GET VOLID LIST FROM OPERATOR (IF TM%OSV SET)
;	3 - GET THE FIRST REQUESTED VOLUME MOUNTED
;  T1/ ADDRESS OF TAPE MOUNT ENTRY IN IPCF MESSAGE FROM QUASAR
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

UTM:	MOVEI T2,BTRRTA		;TABLE OF TAPE MOUNT SUBENTRY PROCESSORS
	CALL BTMRSB		;BUILD RSB FROM QUASAR MESSAGE
	 RET			;REQUEST ABORTED, EXIT
	JXE F,TALCF,[ABTRET (MREQ26)] ;MUST HAVE ALLOCATION ENABLED
	CALL ACCMTR		;CREATE ACCOUNT BLOCK
	 JRST [	ABTRET (MREQ31)] ;ABORT REQUEST, NO BLOCKS AVAILABLE
	CALL PWATCH		;TELL INFO TO WATCH USER'S PID
	MOVX T1,TM%OSV
	TDNN T1,RSBUFL(RSB)	;WHO IS SUPPLYING THE VOLIDS?
	JRST [	CALLRET VOLMNT]	;USER, GO GET THE FIRST VOLUME MOUNTED

; GET THE VOLID LIST FROM THE OPERATOR

	MOVEI T1,RST.WV		;OPERATOR IS SUPPLYING VOLIDS
	STOR T1,RSBSTE		;SET STATE TO WAITING FOR VOLID KEYIN
	CALL TCKP		;SEND STATUS UPDATE TO QUASAR
UTM1:	JSP T1,WRUTR		;ASK OPERATOR TO KEY IN VOLID LIST
	MOVEI RSB,-RSBWTB(T2)	;LOAD UP ADDR OF REQUEST STATUS BLOCK
	CALL PMR		;PARSE RESPONSE TO VOLID REQUEST
	 JRST UTM1		;BAD RESPONSE, TRY IT AGAIN
	JUMPN T1,R		;RETURN IF REQUEST ABORTED
	CALLRET VOLMNT		;GET 1ST VOLUME MOUNTED AND RETURN
SUBTTL VOLUME/REQUEST ASSOCIATION LOGIC

; MATCHR - TRY TO MATCH USER REQUEST TO TAPE VOLUME
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

MATCHR:	SAVEAC <MTA,Q1>
	MOVE Q1,MTAN		;GET # OF MTA DEVICES ON SYSTEM
	MOVEI MTA,MTA0-MTASZ	;INIT MTA AC FOR SCAN

; SCAN MTA STATUS BLOCKS FOR VOLUMES THAT CAN SATISFY THE REQUEST

MCHR1:	ADDI MTA,MTASZ		;POINT AT NEXT MTA STATUS BLOCK
	SOJL Q1,R		;NONE LEFT, SO SPLIT
	CALL VRA		;TRY TO MATCH REQUEST TO VOLUME
	 JRST MCHR1		;CAN'T, SO CONTINUE SEARCH
	RET


; MATCHV - TRY TO MATCH TAPE VOLUME TO USER REQUEST
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

MATCHV:	SAVEQ
	SAVEAC <RSB>
; PROBLEM: IF THE VOLUME IS A SCRATCH TAPE WITH A VOLID, I WANT TO
; ENSURE THAT ANY USER REQUESTING THE TAPE BY ITS VOLID GETS PRIORITY
; OVER ANY USER REQUESTING A RANDOM SCRATCH TAPE.

; SOLUTION: IMPLEMENT THE HAIRY CODE BELOW THAT PERFORMS A 2-PASS
; SEARCH OF THE RSB QUEUE WHEN THE VOLUME IS A SCRATCH TAPE. THE FIRST
; PASS (Q1/1) CHECKS ONLY RSB'S THAT ARE REQUESTING SPECIFIC (I.E.,
; NON-SCRATCH) VOLUMES. THE SECOND PASS (Q1/0) WILL CHECK ALL RSB'S. IF
; THE TAPE IS NOT A SCRATCH TAPE, ONLY THE SECOND PASS IS EXECUTED.

	LOAD Q1,MA%SCR,MTAFLG(MTA) ;GET 1 IFF VOLUME IS A SCRATCH
MATV1:	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
MATV2:	CALL NMTRSB		;GET NEXT RSB
	 JRST [	SOJGE Q1,MATV1	;MAKE 2ND PASS IF NEEDED
		RET]		;ELSE RETURN
	CALL VQGCV		;THIS USER WANT A SCRATCH TAPE?
	SKIPN T1		;NO
	JUMPG Q1,MATV2		;YES, BYPASS IF IN NON-SCRATCH PASS
	CALL VRA		;TRY TO MATCH REQUEST TO VOLUME
	 JRST MATV2		;CAN'T DO IT, CONTINUE SEARCH
	RET			;REQUEST MATCHED TO VOLUME, EXIT
; MCHWMT - THIS ROUTINE IS CALLED WHEN MT DEVICES ARE FREED BY USER
;	   JOBS. ITS PURPOSE IS TO SCAN THE REQUEST QUEUE FOR REQUESTS
;	   THAT COULD NOT BE SATISFIED BECAUSE NO MT'S WERE AVAILABLE.
; RETURNS +1: ALWAYS

MCHWMT:	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB>
	TXZN F,NOMTF		;DOES AN MT SHORTAGE EXIST?
	RET			;NO, NOTHING TO DO

; SCAN REQUEST QUEUE FOR REQUESTS THAT NEED MT DEVICES

MCHWM1:	TXNN F,NOMTF		;EXIT IF MT SHORTAGE EXISTS
	CALL NMTRSB		;GET NEXT RSB
	 RET			;NOTHING MORE TO DO
	JN RSBMT,,MCHWM1	;BYPASS IF HE'S GOT AN MT ALREADY
	LOAD T1,RSBSTE		;GET STATE OF REQUEST
	CAIE T1,RST.WM		;WAITING FOR TAPE MOUNT?
	JRST MCHWM1		;NO, DOESN'T NEED MT
	CALL MATCHR		;TRY TO FIND A MATE FOR THIS REQUEST
	JRST MCHWM1		;GO ON TO NEXT REQUEST
; MOLOC - PERFORM .MOLOC MTOPR FUNCTION
;  MT/ ADDR OF MT STATUS BLOCK
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

MOLASZ==10			;SIZE OF .MOLOC ARG BLOCK
MOLOC:	STKVAR <<MOLARG,MOLASZ>>
; SET UP ARGUMENT BLOCK FOR MTOPR

	MOVEI T1,MOLASZ		;SET SIZE OF ARG BLOCK
	MOVEM T1,.MOCNT+MOLARG
	MOVE T1,MT		;GET MT STATUS BLOCK ADDR
	SUBI T1,MT0		;SUBTRACT BASE ADDRESS
	IDIVI T1,MTSZ		;COMPUTE MT UNIT#
	MOVEM T1,.MOMTN+MOLARG	;SET MT UNIT #
	LOAD T1,RSBDEN
	MOVEM T1,.MODNS+MOLARG	;SET DENSITY
	MOVEI T1,MTAV1(MTA)
	MOVEM T1,.MOAVL+MOLARG	;SET LABEL ADDRESS
	LOAD T1,RSBCV
	MOVEM T1,.MOCVN+MOLARG	;SET CURRENT VOLUME #
	MOVE T1,RSBASN(RSB)
	MOVEM T1,.MOVSN+MOLARG	;SET SIXBIT FILE SET IDENTIFIER
	LOAD T1,RSBLT
	MOVEM T1,.MOLBT+MOLARG	;SET LABEL TYPE
	MOVEI T2,1		;ASSUME EBCDIC OR ANSI
	CAIN T1,.LTUNL
	MOVEI T2,0		;UNLABELED
	CAIN T1,.LTT20
	MOVEI T2,2		;TOPS-20
	MOVEM T2,.MONVL+MOLARG	;SET LABEL COUNT

; NOW PASS ALL THIS STUFF ON DOWN TO THE MONITOR

	CALL MTAGJF		;GET JFN FOR MTOPR
	MOVEI T2,.MOLOC		;GET MTOPR FUNCTION CODE
	MOVEI T3,MOLARG		;ADDRESS OF ARGUMENT BLOCK
	MTOPR			;PERFORM REQUESTED FUNCTION
	 ERCAL WOLOCF		;ERROR, DISPLAY TO OPERATOR
	LOAD T1,MTAJFN		;GET JFN
	MOVEI T2,.MOSID		;FUNCTION = SET VOLUME-ID
	MOVE T3,MTAVOL(MTA)	;GET VOLID
	MTOPR			;MAKE VOLID AVAILABLE TO USER VIA .MOINF
	CALLRET MTARJF		;RELEASE JFN AND RETURN
; MTALC - ALLOC MT DEVICE TO A USER JOB
;  MT/ ADDR OF MT STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: FAILED, USER JOB DISAPPEARED
;	  +2: SUCCESS, MT AND RSB LINKED TO EACH OTHER

MTALC:	CALL GMTDD		;GET MT DEVICE DESIGNATOR IN T1
	MOVE T2,T1		;MOVE IT TO T2 FOR ALLOC JSYS
	MOVEI T1,.ALCAL		;ALLOC FUNCTION CODE
	LOAD T3,RSBJNO		;GET USER'S JOB #
	ALLOC			;ALLOCATE MT DEVICE TO USER JOB
	 JRST [	CAIE T1,ALCX4	;INVALID JOB #?
		CALL STOP	;NO, I CAN'T HANDLE THIS ERROR
		ABTRET (ABRTNR)] ;ABORT - USER WENT AWAY
	STOR MT,RSBMT		;STORE MT STATUS BLOCK ADDR IN RSB
	STOR RSB,MTRSB		;STORE RSB ADDR IN MT STATUS BLOCK
	RETSKP			;SUCCESSFUL COMPLETION


; MTGET - LOCATE A FREE MT DEVICE
; RETURNS +1: NO FREE MT'S AVAILABLE
;	  +2: FREE MT FOUND, MT/ ADDR OF MT STATUS BLOCK

MTGET:	MOVEI MT,MT0-MTSZ	;INIT MT AC FOR STATUS BLOCK SEARCH
	MOVE T1,MTN		;GET # OF MT DEVICES ON SYSTEM
MTGET1:	ADDI MT,MTSZ		;POINT AT NEXT MT STATUS BLOCK
	SOJL T1,[TXO F,NOMTF	;NONE LEFT, SET NONE-LEFT FLAG
		RET]		;ERROR RETURN
	JN MTRSB,,MTGET1	;SKIP THIS ONE IF IT'S IN USE
	RETSKP			;FREE MT FOUND


; MTRLS - PROCESS RELEASE OF MT DEVICE BY USER
;  MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS

MTRLS:	SAVEAC <RSB>
	LOAD RSB,MTRSB		;GET RSB ADDRESS
	JUMPE RSB,R		;EXIT IF NO RSB ASSOCIATED
	CALL PLDISA		;DISASSOCIATE MT FROM MTA
	SETZRO MTRSB		;CLEAR OWNER-OF-MT FIELD
	CAIN RSB,MTNAV		;WAS THERE AN RSB?
	RET			;NO, BYPASS RSB PROCESSING
	SETZRO RSBMT		;CLEAR POINTER TO MT IN RSB
	LOAD T1,RSBSTE		;[332]Get the status
	CAIN T1,RST.WM		;[332]Waiting for next volume?
	CALL WORCAN		;[332]Yes, Tell OPR of cancelation 
	SKIPE T1,RSBWTB+WTBCOD(RSB) ;WTOR OUTSTANDING?
	CALL CANWTR		;YES, CANCEL IT
	TXO F,ABORTF		;FORCE A SCAN TO DUMP THE RSB
	ABTRET (ABRTNR)		;GET THE REQUEST OUT OF MY QUEUES
; PLDISA - DISASSOCIATE PHYSICAL AND LOGICAL TAPE DEVICES
;  MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS

; NOTE - IF MOUNTR CRASHES AND GETS RESTARTED, THE CURRENT MT-MTA
;	 ASSOCIATIONS ARE RESTORED FROM MONITOR TABLES (ASMT ROUTINE)
;	 BUT MTRSB WILL CONTAIN MTNAV (HENCE PLDISA CHECKS FOR THIS)

PLDISA:	SAVEAC <MTA,RSB>
	LOAD MTA,MTMTA		;GET MTA STATUS BLOCK ADDRESS
	JUMPE MTA,R		;EXIT IF NO MTA ASSOCIATED WITH MT
	LOAD RSB,MTRSB		;GET REQUEST STATUS BLOCK ADDRESS
	SETZRO MTAMT		;CLEAR MTA-TO-MT LINK
	SETZRO MTMTA		;CLEAR MT-TO-MTA LINK
	CALL SCIENA		;GET STATUS INTERRUPTS FOR THIS DRIVE

	CAIN RSB,MTNAV		;RSB ASSOCIATED?
	JRST PLDISU		;NO, UNLOAD DRIVE TO PLAY IT SAFE
	CALL ACCMTD		;SEND ACCOUNT INFO TO MONITOR
	CALL CKMPAV		;DID OPERATOR SET MTA UNAVAILABLE?
	 JRST PLDISU		;YES, UNLOAD IT
	JE TM%NUL,RSBUFL(RSB),PLDISU ;JUMP IF USER WANTS VOLUME UNLOADED
	CALL REW		;IS MTA OFFLINE?
	 JRST PLDISU		;YES, NO HOPE FOR RE-USE
	MOVEI T1,[ASCIZ/Remaining mounted on drive/]
	CALL WODISA		;TELL OPERATOR THAT USER RELEASED TAPE
	LOAD T1,MTALT		;GET LABEL TYPE
	CAIE T1,.LTUNL		;UNLABELLED?
	JRST PLDSA1		;NO, DON'T TOUCH VOLID
	SETZM MTAVOL(MTA)	;CLEAR VOLID
	SETZM MTAIDV(MTA)	;AND OPERATOR KEYIN
PLDSA1:	JE MA%AVS,MTAFLG(MTA),[CALLRET MATCHV] ;TRY MATCHUP IF NON-AVR
	MOVX T1,MA%UXV+MA%OPF+MA%SCR
	ANDCAM T1,MTAFLG(MTA)	;CLEAR SOME FLAGS
	SETZRO MTALT		;CLEAR MTALT SO AVR WILL WORK
	CALLRET AVR		;INITIATE AVR SEQUENCE FOR DRIVE

; AVR SEQUENCE MAY NOT BE PERFORMED UPON TAPE

PLDISU:	LOAD T1,MTALT		;GET LABEL TYPE
	CAIN T1,.LTUNL		;UNLABELLED?
	JRST [SETZM MTAVOL(MTA)	;YES, CLEAR VOLID
	      SETZM MTAIDV(MTA)	;AND OPERATOR KEYIN
	      JRST .+1]		;CONTINUE
	CALL UNLOAD		;UNLOAD THE DRIVE
	MOVEI T1,[ASCIZ/Being unloaded/]
	CAIE RSB,MTNAV		;IF NO RSB, DON'T GIVE MESSAGE
	CALL WODISA		;TELL OPERATOR THAT USER RELEASED TAPE
	CALL CKMPAV		;DID OPERATOR SET MTA NOT-AVAILABLE?
	 CALL DACMTA		;YES, DEACTIVATE MTA
	RET			;NO
; PRQABT - PURGE ABORTED REQUESTS FROM MOUNT REQUEST QUEUE
; RETURNS +1: ALWAYS

PRQABT::SAVEAC <T1>		;Save T1
	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB>

; SEARCH MOUNT REQUEST QUEUE AND EXTRACT ABORTED REQUESTS

PRQAB1:	CALL QMSCAN		;GET ADDRESS OF NEXT RSB ON QUEUE
	 RET			;NONE LEFT, EXIT
	MOVEI RSB,-RSBLNK(T2)	;LOAD RSB AC WITH RSB ADDRESS
	CALL CHKAB		;REQUEST ABORTED?
	 SKIPA			;YES
	JRST PRQAB1		;NO, SKIP IT
	LOAD T1,RSBTYP		;GET TYPE OF REQUEST
	CAIN T1,.MNTTP		;TAPE MOUNT?
	JRST [	JN RSBMT,,PRQAB1 ;YES, SKIP IF USER STILL HAS MT DEVICE
		CALL VQDEL	;RELEASE VOLID LIST
		JRST .+1]	;CONTINUE DELETION LOGIC

; DEQUEUE AND DISCARD ABORTED RSB

	SKIPE RSBWTB+WTBCOD(RSB) ;IS WTB ACTIVE?
	CALL STOP		;YES, CRASH!!!
	MOVX T1,R%OPR
	TDNN T1,RSBIFL(RSB)	;WAS THIS REQUEST FROM OPR?
	CALL RLSMSG		;NO, TELL QUASAR TO RELEASE THIS ITN
	CALL QMDQS		;DEQUEUE RSB, GET LINKAGE ADDR IN T2
	MOVEI T1,IRBQDB		;GET QDB ADDRESS
	CALL QMQH		;QUEUE RSB TO HEAD OF INACTIVE QUEUE
	JRST PRQAB1		;CONTINUE SCAN OF RSB QUEUE
; PRQPID - PURGE REQUESTS FROM MOUNT REQUEST QUEUE WHOSE OWNERS
;	   HAVE DELETED THEIR PIDS BEFORE THE FIRST VOLUME WAS MOUNTED
; RETURNS +1: ALWAYS

PRQPID:	QSCANI ARBQDB		;SET UP TO SCAN ACTIVE RSB QUEUE
	SAVEAC <RSB>
PURGR1:	CALL QMSCAN		;GET ADDR OF NEXT RSB IN T2
	 RET			;END OF RSB QUEUE, EXIT
	MOVEI RSB,-RSBLNK(T2)	;COPY RSB ADDRESS TO RSB AC
	CALL CHKAB		;REQUEST ABORTED?
	 JRST PURGR1		;YES, SKIP IT
	CALL VALPID		;CHECK PID
	 JFCL			;REQUEST ABORTED
	JRST PURGR1		;CONTINUE SEARCH


; VALPID - ABORT REQUEST IF PID IS DELETED
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST ABORTED BECAUSE USER PID WAS DELETED
;	  +2: REQUEST NOT ABORTED

VALPID:	LOAD T1,RSBTYP
	CAIN T1,.MNTTP		;TAPE REQUEST?
	JRST [	JE RSBMT,,.+1	;YES, DOES THE USER HAVE AN MT?
		RETSKP]		;YES, DON'T DO PID CHECK
	CAIN T1,.MNTDT		;DECTAPE-MOUNT REQUEST?
	SKIPN RSBDTA(RSB)	;DOES USER HAVE THE DTA?
	SKIPA			;NO TO EITHER
	RETSKP			;USER HAS DECTAPE, PRESERVE REQUEST
	MOVEI T1,.MUFOJ
	MOVE T2,RSBPID(RSB)	;GET USER'S PID
	CALL XMUTIL		;IS IT STILL VALID?
	 JRST [	CALL WORCAN	;NO, TELL OPERATOR REQ WAS CANCELED
		ABTRET (ABRTNR)] ;ABORT REQUEST
	RETSKP			;PID STILL GOOD
; VOLMNT - ATTEMPT TO MATCH REQUEST WITH MOUNTED VOLUME; IF THIS IS
;	   NOT POSSIBLE, THE OPERATOR IS TOLD TO MOUNT THE VOLUME
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

VOLMNT:	CALL VQCNT		;GET # OF VOLUMES IN SET IN T1
	LOAD T2,RSBCV		;GET CURRENT VOLUME #
	MOVX T3,R%WVL
	TDNN T3,RSBIFL(RSB)	;NEED TO ASK OPERATOR FOR NEXT VOLID?
	CAMG T2,T1
	SKIPA T1,[RST.WM]	;NO
	JRST [	MOVEI T1,RST.WV	;YES
		STOR T1,RSBSTE	;SET STATE TO WAITING FOR VOLID KEYIN
		CALL TCKP	;TELL QUASAR
		MOVEI T1,VOLMT2	;GET END-ACTION ADDRESS
		CALLRET WRNXTV]	;GO ASK FOR NEXT VOLID
	STOR T1,RSBSTE		;SET STATE TO WAITING FOR TAPE MOUNT
	SETZRO R%ONR,RSBIFL(RSB) ;CLEAR OPERATOR-NOTIFIED FLAG
	CALL TCKP		;SEND CHECKPOINT MESSAGE TO QUASAR
	CALL MATCHR		;MATCH REQUEST TO VOLUME
	CALL CHKAB		;REQUEST ABORTED?
	 RET			;YES, BACK TO CALLER
	LOAD T1,RSBSTE		;GET STATE TO SEE WHAT MATCHR DID
	CAIE T1,RST.WM		;STILL WAITING FOR A MOUNT?
	RET			;NO, EXIT
	CALLRET WOVMT		;TELL OPERATOR TO MOUNT VOLUME

; PROCESS RESPONSE TO WTOR ASKING OPERATOR TO SUPPLY NEXT VOLID

VOLMT2:	MOVEI RSB,-RSBWTB(T2)	;LOAD RSB AC
	CALL PNVR		;PARSE RESPONSE
	 JRST [	MOVEI T1,VOLMT2	;BAD RESPONSE, GET END-ACTION ADDRESS
		CALLRET WRNXTV]	;LET HIM TRY IT AGAIN
	JUMPN T1,R		;RETURN NOW IF REQUEST ABORTED
	JRST VOLMNT		;GOT THE VOLID, NOW GO GET IT MOUNTED
; VOLSW - PERFORM TAPE VOLUME-SWITCH
;  T1/ ABSOLUTE VOLUME NUMBER TO SWITCH TO
;  MT/ ADDR OF MT STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

VOLSW:	SAVEAC <MTA,ACC>
	STAKT
	LOAD T2,RSBCV		;GET CURRENT VOLUME #
	CAMN T1,T2		;SWITCHING TO SAME VOLUME?
	JRST [	LOAD MTA,MTMTA	;YES, GET MTA STATUS BLK ADDR
		CALLRET MOLOC]	;HOOK UP MT&MTA AGAIN
	CALL PLDISA		;DISASSOCIATE MTA FROM MT
	LOAD ACC,RSBACC		;GET ACC
	GTAD			;GET TIME
	MOVEM T1,ACCSCD(ACC)	;SAVE IN ACCOUNT BLOCK AS SCHEDULED TIME
	CALL VQCNT		;GET # OF VOLUMES IN SET
	ADDI T1,1		;ADD 1 IN CASE EXPANDING VOLUME SET
	SKIPLE T2,CT1		;ERROR IF GOING TO VOLUME BEFORE FIRST
	CAMLE T2,T1		;ERROR IF GOING BEYOND END OF SET
	JRST [	ABTRET (MREQX8)] ;ATTEMPT TO SWITCH TO VOL OUTSIDE SET
	STOR T2,RSBCV		;SET CURRENT VOLUME # IN RSB
	CALLRET VOLMNT		;GET THE REQUESTED VOLUME MOUNTED
; VRA - ASSOCIATE USER REQUEST AND TAPE VOLUME (IF POSSIBLE)
;  MTA/ ADDR OF MTA STATUS BLOCK OF DRIVE TO BE CHECKED
;  RSB/ ADDR OF USER REQUEST STATUS BLOCK
; RETURNS +1: FAILED, REQUEST MAY BE ABORTED
;	  +2: SUCCESS, MT/ ADDR OF MT STATUS BLOCK

VRA:	SAVEQ
	MOVE T1,MTAFLG(MTA)
	LOAD T2,MTASTE
	CAIN T2,S.AV		;INELIGIBLE IF DRIVE NOT AVAIL TO USERS
	TXNN T1,MA%LOD		;INELIGIBLE IF DRIVE NOT LOADED
	RET
	SKIPN MTAVOL(MTA)	;IS VOLUME IDENTIFIED?
	TXNE T1,MA%SCR		; OR SCRATCH?
	SKIPA			;YES TO EITHER, PROCEED
	RET			;BOTH NO
	JN MTAJCT,,R		;INELIGIBLE IF AVR IN PROGRESS
	JN MTAMT,,R		;INELIGIBLE IF DRIVE IN USE
	LOAD T1,RSBSTE		;GET STATE OF REQUEST
	CAIE T1,RST.WM		;WAITING FOR VOLUME TO BE MOUNTED?
	RET			;NO

; REQUEST AND DRIVE ARE IN THE PROPER STATES... A GOOD SIGN

	MOVEI Q1,VRACCN		;ASSUME NOT REQUESTING SCRATCH
	CALL VQGCV		;GET CURRENT VOLID IN T1
	SKIPN T1		;WANT SCRATCH VOLUME?
	MOVEI Q1,VRACCS		;YES, CALL SCRATCH ROUTINE
	CALL (Q1)		;CALL APPROPRIATE ROUTINE
	 RET			;WRONG VOLUME OR REQUEST ABORTED

; MISCELLANEOUS CHECKS BEFORE I ASSIGN AN MT TO THE USER

	CALL VALPID		;CHECK FOR DELETED PID
	 RET			;REQUEST ABORTED
	CALL REW		;CHECK IF DRIVE IS REALLY LOADED
	 RET			;NO, DON'T ASSIGN
	LOAD T1,MA%WEN,MTAFLG(MTA) ;GET DRIVE WRITE STATUS
	LOAD T2,TM%WEN,RSBUFL(RSB) ;GET REQUESTED WRITE STATUS
	CAME T1,T2		;DO DRIVE AND USER AGREE?
	JRST [	CALL UNLOAD	;NO, UNLOAD THE DRIVE
		CALLRET WOWPE]	;TELL THE OPERATOR TO FIX IT

; GET MT DEVICE FOR THIS REQUEST IF IT DOESN'T ALREADY HAVE ONE

	LOAD MT,RSBMT		;GET MT STATUS BLOCK ADDRESS
	JUMPE MT,[CALL MTGET	;NO MT YET, ANY MT'S AVAILABLE?
		 RET		;NO, FAILED
		JRST .+1]	;MT AC LOADED (NOT ALLOC'ED YET)
	CALL VQCNT		;GET # OF VOLIDS IN REQUEST
	LOAD T2,RSBCV		;GET CURRENT VOLUME #
	CAMGE T1,T2		;ASSIGNING SCRATCH TAPE TO USER?
	JRST [	MOVE T1,MTAVOL(MTA) ;YES, GET VOLID OF TAPE
		CALL VQADD	;TACK VOLID ON THE END OF LIST
		 RET		;REQUEST ABORTED (RESOURCES EXHAUSTED)
		JRST .+1]

; PUT VALUES IN DEFAULTED RSB FIELDS (DENSITY, DRIVE-TYPE, LABEL-TYPE)

	LOAD T1,MTADRV		;DRIVE-TYPE
	LOAD T2,RSBDRV
	SKIPN T2
	STOR T1,RSBDRV
	LOAD T1,MTALT		;LABEL-TYPE
	LOAD T2,RSBLT
	SKIPN T2
	STOR T1,RSBLT
	LOAD T1,RSBLT		;DENSITY
	CAIE T1,.LTUNL		;LABELED?
	JRST [	LOAD T1,MTADEN	;YES
		LOAD T2,RSBDEN
		SKIPN T2
		STOR T1,RSBDEN
		MOVX T1,MA%SCR
		MOVX T2,R%WVL
		TDNE T1,MTAFLG(MTA) ;SCRATCH TAPE?
		IORM T2,RSBIFL(RSB) ;YES, INSURE LABELS GET REWRITTEN
		CALL LTINIT	;WRITE LABELS IF NECESSARY
		 RET		;ERROR
		JRST .+1]

; ALLOC THE MT TO THE USER (HAPPENS WHEN MOUNTING THE FIRST TAPE OF SET)

	LOAD Q1,RSBMT		;HAVE I ALLOC'ED THE MT TO THE USER YET?
	JUMPE Q1,[CALL MTALC	;NO, ALLOC MT TO USER
		 RET		;ALLOC FAILED (USER DISAPPEARED)
		JRST .+1]	;MT DEVICE ALLOC'ED TO USER JOB

; MT DEVICE ASSIGNED TO USER JOB - ASSOCIATE MTA WITH MT

	MOVE T1,MTASET(MTA)	;GET SETNAME FROM TAPE
	SKIPN RSBASN(RSB)	;DOES THIS REQUEST HAVE A SETNAME YET?
	MOVEM T1,RSBASN(RSB)	;NO, USE SETNAME FROM HDR1 ON TAPE
	CALL MTAGJF		;GET MAGTAPE JFN
	MOVEI T2,.MOINF		;GET TAPE INFO
	MOVEI T3,.MOIWF		;LENGTH OF INFO BLOCK
	MOVEM T3,TAPEBK
	MOVEI T3,TAPEBK		;INFO INTO TAPEBK
	MTOPR			;GET IT
	CALL MTARJF		;RELEASE JFN
	MOVE T1,TAPEBK+.MOIRD	;Number of physical records read
	MOVEM T1,ACCPR(ACC)
	MOVE T1,TAPEBK+.MOIWT	;Number of physical records written
	MOVEM T1,ACCPW(ACC)
	MOVE T1,TAPEBK+.MOIRF	;GET FRAMES READ
	IDIVI T1,^D1000		;IN THOUSANDS
	MOVEM T1,ACCFR(ACC)
	MOVE T1,TAPEBK+.MOIWF	;GET FRAMES WRITTEN
	IDIVI T1,^D1000		;IN THOUSANDS
	MOVEM T1,ACCFW(ACC)
	MOVE T1,TAPEBK+.MOISR	;GET NUMBER OF SOFT READ ERRORS
	MOVEM T1,ACCSR(ACC)
	MOVE T1,TAPEBK+.MOISW	;GET NUMBER OF SOFT WRITE ERRORS
	MOVEM T1,ACCSW(ACC)
	MOVE T1,TAPEBK+.MOIHR	;GET NUMBER OF HARD READ ERRORS
	MOVEM T1,ACCHR(ACC)
	MOVE T1,TAPEBK+.MOIHW	;GET NUMBER OF HARD WRITE ERRORS
	MOVEM T1,ACCHW(ACC)
	CALL MOLOC		;ISSUE JSYS TO ASSOCIATE MT WITH MTA
	CALL SCIDIS		;DON'T TAKE INTERRUPTS FROM THIS MTA
	SKIPN Q1		;WAS MT DEVICE JUST GIVEN TO USER?
	CALL TELUSR		;YES, SEND IPCF CONFIRMATION MSG TO USER

; PERFORM MISCELLANEOUS POST-ASSOCIATION TASKS

	GTAD
	LOAD ACC,RSBACC		;GET ADDRESS OF ACCOUNT BLOCK
	MOVEM T1,ACCSVT(ACC)	;STORE SERVICED-TIME
	SKIPE T1,RSBWTB+WTBCOD(RSB) ;WTOR MESSAGE OUTSTANDING?
	CALL CANWTR		;YES, CANCEL IT
	MOVEI T1,RST.AC
	STOR T1,RSBSTE		;SET STATE TO ACTIVE
	STOR MT,MTAMT		;PUT MT STATUS BLK ADDR IN MTA STAT BLK
	STOR MTA,MTMTA		;PUT MTA STATUS BLK ADDR IN MT STAT BLK
	CALL TCKP		;TELL QUASAR ABOUT STATE CHANGE
	MOVX T1,MA%SCR
	ANDCAM T1,MTAFLG(MTA)	;NOT SCRATCH AFTER I GIVE IT TO USER
	CALL WOASO		;TELL OPERATOR ABOUT ASSOCIATION
	RETSKP
; VRACCN - CHECK COMPATIBILITY OF NON-SCRATCH REQUEST AND TAPE VOLUME
;  T1/ SIXBIT VOLID BEING REQUESTED
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: NOT COMPATIBLE OR REQUEST ABORTED
;	  +2: COMPATIBLE

VRACCN:	SAVEQ
	CAME T1,MTAVOL(MTA)	;DO I HAVE THE RIGHT VOLUME?
	RET			;NO
	LOAD T1,RSBDRV		;DID USER SPECIFY A DRIVE TYPE?
	JUMPN T1,[LOAD T2,MTADRV ;YES, GET ACTUAL DRIVE TYPE
		CAMN T1,T2	;DO THEY MATCH?
		JRST .+1	;YES
		ABTRET (MREQ11)] ;NO, ABORT REQUEST
	JN TM%BYP,RSBUFL(RSB),VRACN3 ;IF BYPASS, JUST CHECK DENSITY
	JE MTALT,,[LOAD Q1,MA%AVE,MTAFLG(MTA) ;TAPE NOT AVR'ED YET
		SETONE MA%AVE,MTAFLG(MTA) ;FORCE AVR
		CALL AVR	;INITIATE AVR SEQUENCE
		STOR Q1,MA%AVE,MTAFLG(MTA) ;RESTORE AVR-ENABLED FLAG
		RET]		;YOU HAVE TO WAIT UNTIL AVR IS DONE
	JN R%WVL,RSBIFL(RSB),VRACN2 ;SPECIAL CASE IF WRITING VOL LABELS
	LOAD T1,RSBLT		;CHECK LABEL TYPES
	LOAD T2,MTALT
	JUMPN T1,[CAMN T1,T2	;USER SPECIFIED LT, DOES IT MATCH TAPE?
		JRST .+1	;YES, PROCEED
		ABTRET (MREQ12)] ;NO, LABEL TYPE MISMATCH
	CAIN T2,.LTUNL		;WHAT KIND OF REQUEST?
	JRST VRACN3		;UNLABELED, CHECK DRIVE CAPABILITIES
	LOAD T1,RSBDEN		;DID USER SPECIFY DENSITY?
	JUMPN T1,[LOAD T2,MTADEN ;YES, GET DENSITY OF TAPE
		CAMN T1,T2	;DO REQUEST AND TAPE DENSITIES MATCH?
		JRST .+1	;YES, PROCEED
		ABTRET (MREQ10)] ;MISMATCHED DENSITY
	MOVX T1,TM%VFY
	TDNE T1,RSBUFL(RSB)	;CHECKING SETNAME OF LABELED TAPE?
	JRST [	MOVE T1,RSBSSN(RSB) ;YES, GET SETNAME FROM RSB
		CAMN T1,MTASET(MTA) ;DOES IT MATCH SETNAME OF VOLUME?
		JRST .+1	;YES
		ABTRET (MREQ14)] ;MISMATCHED SET NAME
	RETSKP

; REWRITING VOLUME LABELS

VRACN2:	CALL VRWLT		;LABEL TYPES COMPATIBLE?
	 JRST [	ABTRET (MREQ12)] ;NO, LABEL TYPE MISMATCH

; MAKE SURE THE DRIVE WILL HANDLE THE REQUESTED DENSITY

VRACN3:	LOAD T1,RSBDEN		;ANY DENSITY SPECIFIED?
	JUMPE T1,RSKP		;NO, IT'S OK
	CALL DRVDEN		;WILL THE DRIVE HANDLE IT?
	 JRST [	CALL UNLOAD	;NO, UNLOAD IT
		CALLRET WOWDDR]	;TELL OPERATOR AND POSTPONE REQUEST
	RETSKP			;DRIVE CAN HANDLE THE DENSITY, OK


; VRACCS - CHECK COMPATIBILITY OF SCRATCH REQUEST AND TAPE VOLUME
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: NOT COMPATIBLE
;	  +2: COMPATIBLE

VRACCS:	JE MA%SCR,MTAFLG(MTA),R	;REJECT VOLUME IF NOT A SCRATCH
	LOAD T1,RSBDRV		;GET REQUESTED DRIVE TYPE
	JUMPN T1,[LOAD T2,MTADRV ;GET DRIVE-TYPE OF DRIVE
		CAME T1,T2	;SAME DRIVE TYPE?
		RET		;NO
		JRST .+1]
	LOAD T1,RSBDEN		;GET REQUESTED DENSITY
	JUMPN T1,[CALL DRVDEN	;CAN THE DRIVE OPERATE AT THIS DENSITY?
		 RET		;NO, THIS SCRATCH WON'T WORK
		JRST .+1]
	CALLRET VRWLT		;CHECK IF LABEL TYPES ARE COMPATIBLE


; VRWLT - TAPE VOLUME LABELS WILL BE REWRITTEN - CHECK IF LABEL TYPES
;	  OF REQUEST AND VOLUME ARE COMPATIBLE
;  MTA/ ADDR OF MTA STATUS BLOCK
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: LABELED-UNLABELED OR UNLABELED-LABELED
;	  +2: UNLABELED-UNLABELED OR LABELED-LABELED

VRWLT:	LOAD T1,RSBLT		;GET REQUESTED LABEL TYPE
	JUMPE T1,RSKP		;NOT PARTICULAR, THIS ONE WILL DO
	LOAD T2,MTALT		;GET LABEL TYPE OF TAPE
	MOVE T3,[CAIE T2,.LTUNL] ;ASSUME HE WANTS UNLABELED SCRATCH
	CAIE T1,.LTUNL		;RIGHT?
	HRLI T3,(CAIN T2,)	;NO, WANTS LABELED
	XCT T3			;COMPARE REQUEST AND VOLUME
	 RET			;UNLABELED-LABELED OR LABELED-UNLABELED
	RETSKP			;LABELED-LABELED OR UNLABELED-UNLABELED
SUBTTL SUBROUTINES

; ACTMTA - ACTIVATE AN MTA DEVICE (INITIALIZE STATUS BLOCK, ETC.)
;  MTA/ ADDR OF MTA STATUS BLOCK
;  T1/ MTA STATE CODE
; RETURNS +1: T1/ owning job if assigned to another job or error code
;	  +2: SUCCESS, MTA ACTIVATED

ACTMTA:	STKVAR <ACTCOD,<MTOBLK,MOSTAL>>
	MOVEM T1,ACTCOD		;SAVE STATE CODE
	JN MTASTE,,RSKP		;RETURN GOOD IF ALREADY ACTIVATED
; ASSIGN MTA TO MY JOB

	CALL GMTADD		;GET DEVICE DESIGNATOR
	ASND			;TRY TO ASSIGN DEVICE TO MY JOB
;**;[6040]At ACTMTA:+5L add 2 lines GAS
	 JRST [	CAIE T1,DEVX2	;[6040] Assigned to another job?
		RET		;[6040] Nope, return T1/ error code
		CALL GMTADD	;GET DESIGNATOR
		DVCHR
		HLRZ T1,T3	;GET T1/ OWNER'S JOB#
		RET]

; TRY TO OPEN DRIVE. IF THIS FAILS ANOTHER PROCESS IN THIS JOB IS USING
; THE DRIVE.

	CALL MTAGJF		;GET JFN ON MTA
	MOVX T2,FLD(17,OF%MOD)+FLD(10,OF%BSZ)+OF%OFL+OF%RD
	OPENF			;TRY TO OPEN
	 JRST [	CAIE T1,OPNX9	;SOMEONE ELSE HAS THE DRIVE?
		JRST .+1	;NO IT IS OK
		CALL MTARJF	;YES, DUMP JFN
		SETZM T1	;SET SPECIAL JOB FLAG
		RET ]		;EXIT SADLY
	SETONE MA%OPN,MTAFLG(MTA)	;SET OPEN JFN FLAG
	CALL MTACLS		;CLOSE MTA

; INITIALIZE MTA STATUS BLOCK AND ENABLE FOR STATUS-CHANGE INTERRUPT

	SETZM (MTA)		;ZERO 1ST WORD OF STATUS BLOCK
	MOVS T1,MTA		;BLT SOURCE
	HRRI T1,1(MTA)		;BLT DESTINATION
	BLT T1,MTASZ-1(MTA)	;CLEAR ENTIRE STATUS BLOCK
	MOVE T1,ACTCOD
	STOR T1,MTASTE		;SET STATE
	CALL SCIENA		;RECEIVE STATUS CHANGE INTERRUPTS
	MOVEI T1,MTOBLK		;GET MOSTA ARG BLOCK ADDRESS
	CALL MOSTA		;GET MTA STATUS & CHARACTERISTICS
	MOVE T1,.MODVT+MTOBLK	;Get drive type
	STOR T1,MTADVT		;Save as device type
	MOVE T1,.MODDN+MTOBLK	;GET SUPPORTED DENSITIES
	HLLM T1,MTASDN(MTA)	;STORE SUPPORTED DENSITIES
	LOAD T1,SJ%7TR,.MOTRK+MTOBLK ;GET 7-TRACK FLAG
	MOVE T2,[EXP .TMDR9,.TMDR7](T1) ;GET DRIVE TYPE CODE
	STOR T2,MTADRV		;STORE DRIVE TYPE IN STATUS BLOCK
	TRC T1,1		;GET 0 FOR 7-TRACK, 1 FOR 9-TRACK
	STOR T1,MA%AVS,MTAFLG(MTA) ;STORE AVR-SUPPORTED FLAG
	CALL AVRENA		;ENABLE AVR (IF LEGAL)
	RETSKP
; AREQ - DRIVER FOR ABTREQ MACRO, ABORTS USER REQUEST
; ARET - DRIVER FOR ABTRET MACRO, ABORTS REQUEST AND DOES RET
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; CALL:	ABTREQ (abortcode,flags)
;	 OR
;	ABTRET (abortcode,flags)

AREQ::	SKIPA T2,[AOS (P)]	;GET AREQ INSTRUCTION
ARET::	MOVE T2,[ADJSP P,-1]	;GET ARET INSTRUCTION
	MOVE T1,@(P)		;GET FLAGS AND CODE
	XCT T2			;EXECUTE INSTRUCTION BASED ON ENTRY
	SAVEAC <MT,ACC>
	HRRZ T2,T1		;GET CODE
	TXNE T1,ABT%IN		;INDIRECT?
	MOVE T2,(T2)		;YES, GET CODE FROM LOCATION
	LOAD T3,RSBSTE		;GET CURRENT STATE OF REQUEST
	CAIE T2,ABRTNR		;FORCE STORE IF NO-REPLY ABORT
	CAIGE T3,.ERBAS		;STORE IF REQUEST NOT ABORTED YET
	JRST [	STOR T2,RSBSTE	;STORE CODE INTO RSB STATE FIELD
		LOAD T2,ABT%OP,T1 ;GET OPERATOR-RESPONSE-PRESENT FLAG
		STOR T2,R%ORES,RSBIFL(RSB) ;COPY FLAG TO RSB
		LOAD T1,RSBTYP	;GET REQUEST TYPE
		CAIE T1,.MNTTP	;TAPE-MOUNT?
		JRST .+1	;NO
		JE RSBMT,,.+1	;DON'T UPDATE STATUS IF RSB GOING AWAY
		CALL TCKP	;UPDATE QUASAR QUEUE DISPLAY
		JRST .+1]
	SKIPE T1,RSBWTB+WTBCOD(RSB) ;WTOR MESSAGE OUTSTANDING?
	CALL CANWTR		;YES, CANCEL IT
	LOAD ACC,RSBACC		;CHECK FOR ACCOUNT BLOCK PRESENT.
	SKIPE ACC		;IS THERE AN ACCOUNT BLOCK?
	CALL DELACC		;YES, DELETE IT.
	TXO F,ABORTF		;FORCE PURGE UPON RETURN TO SCHEDULER
	LOAD T1,RSBSTE		;GET REQUEST STATE
	MOVE T2,RSBIFL(RSB)	;GET INTERNAL REQUEST FLAGS
	TXNN T2,R%OPR		;DON'T REPLY TO OPR-ORIGINATED REQUEST
	CAIN T1,ABRTNR		;DON'T REPLY IF NO-REPLY REQUESTED
	RET
	LOAD T1,RSBTYP
	CAIE T1,.MNTTP		;TAPE RSB?
	JRST [	CALLRET TELUSR]	;NO, TELL USER VIA IPCF
	JE RSBMT,,[CALLRET TELUSR] ;TELL USER ON 1ST VOLUME
	CALLRET TELMON		;OTHERWISE TELL MONITOR TO TELL USER
; ASMT - PLACE MT DEVICES IN THE DEVICE ALLOCATOR'S POOL
;	 CALLED DURING INITIALIZATION
; RETURNS +1: ALWAYS

ASMT:	SAVEQ
	SAVEAC <MT,MTA>
	MOVSI Q1,-MAXMT		;RH(Q1)/ MT UNIT NUMBER
	MOVEI MT,MT0		;ADDRESS OF FIRST MT STATUS BLOCK

; LOOP TO PLACE ALL MT DEVICES IN THE DEVICE ALLOCATOR'S POOL

ASMT1:	SETZM (MT)		;CLEAR FIRST WORD OF MT STATUS BLOCK
IFG MTSZ-1,<
	MOVS T1,MT		;BLT SOURCE
	HRRI T1,1(MT)		;BLT DESTINATION
	BLT T1,MTSZ-1(MT)	;CLEAR REMAINDER OF MT STATUS BLOCK
>
	CALL GMTDD		;GET MT DEVICE DESIGNATOR IN T1
	DVCHR			;IS THIS A VALID DESIGNATOR?
	 ERJMP ASMT2		;NO, SKIP NON-DEVICE
	HRRZM Q1,MTN		;SET HIGHEST MT UNIT NUMBER
	MOVE T2,T1		;MOVE DESIGNATOR TO T2 FOR ALLOC
	MOVEI T1,.ALCAL		;GET ALLOC FUNCTION CODE
	MOVNI T3,1		;RELEASE DEVICE TO FREE POOL
	ALLOC			;TRY TO FREE UP THE DEVICE
	 MOVEI T1,.ALCAL	;IGNORE ERROR, RESTORE T1
	MOVNI T3,2		;ASSIGN MT TO ALLOCATOR'S POOL
	ALLOC			;TRY TO ASSIGN TO ALLOCATOR
	 SKIPA			;FAILED
	JRST ASMT2		;ASSIGNED TO ALLOCATOR, GO DO NEXT MT

; CANNOT PUT MT IN ALLOCATOR'S POOL, SO THIS IS PROBABLY A RESTART
; AND THE MT IS STILL IN A USER'S POSSESSION.  THE LOGIC HERE FINDS
; OUT WHAT MTA DEVICE IS ASSOCIATED WITH THE MT, LINKS THEM UP, AND
; BUSYS THEM OUT UNTIL THE USER RELEASES THE MT.

 	MOVEI T1,MTNAV		;CAN'T GET CONTROL OF MT
	STOR T1,MTRSB		;RSB ADDR NON-0 TO PREVENT ALLOCATION
	MOVEI T1,.MTASI		;GET MTU FUNCTION CODE
	HRRZ T2,Q1		;GET MT UNIT #
	MOVEI T3,Q2		;GET ARGUMENT BLOCK ADDRESS (Q2,Q3)
	MOVEI Q2,2		;SET LENGTH IN ARG BLOCK
	MTU%			;ASK MONITOR FOR ASSIGNMENT INFO
	CAIN Q3,.MTNUL		;ANY MTA ASSIGNED TO THIS MT?
	JRST ASMT2		;NO
	MOVE T1,Q3		;GET MTA UNIT #
	HRLI T1,.DVDES+.DVMTA	;MAKE DESIGNATOR
	CALL DDMTA		;GET MTA STATUS BLOCK ADDRESS IN MTA
	 CALL STOP		;BAD MTA UNIT # FROM MONITOR
	MOVEI T1,S.AV		;GET AVAILABLE-TO-USER STATE
	CALL ACTMTA		;ACTIVATE MTA IF POSSIBLE
	 JRST ASMT2		;CAN'T, SO DON'T CROSS-LINK
	STOR MT,MTAMT		;ASSOCIATE MT WITH MTA
	STOR MTA,MTMTA		;...
	SETONE MA%LOD,MTAFLG(MTA) ;SET DRIVE-LOADED FOR KSHS
ASMT2:	ADDI MT,MTSZ		;POINT AT NEXT MT STATUS BLOCK
	AOBJN Q1,ASMT1		;LOOP THRU ALL POSSIBLE MT'S
	AOS MTN			;CONVERT HIGHEST UNIT# TO # OF DEVICES
	RET
; ASMTA - ASSIGN MTA DEVICES TO THIS JOB
;	  CALLED DURING INITIALIZATION
; RETURNS +1: ALWAYS

ASMTA:	SAVEAC <MTA,Q1>
	MOVSI Q1,-MAXMTA	;# OF MTA DEVICES I CAN HANDLE
	MOVEI MTA,MTA0		;ADDRESS OF MTA0: STATUS BLOCK

; LOOP TO CHECK AND POSSIBLY ACTIVATE EVERY MTA DEVICE ON THE SYSTEM

ASMTA1:	SETZRO MTASTE		;SET DRIVE NOT ASSIGNED
	CALL GMTADD		;GET MTA DEVICE DESIGNATOR IN T1
	DVCHR			;IS THIS A VALID DESIGNATOR?
	 ERJMP ASMTA2		;NO, SKIP NON-DEVICE
	HRRZM Q1,MTAN		;STORE HIGHEST MTA UNIT #
	CALL CKMPAV		;IS THIS DRIVE SET AVAILABLE?
	 JRST ASMTA2		;NO, DON'T ASSIGN IT
	MOVEI T1,S.AV		;GET AVAILABLE-TO-USER STATE
	CALL ACTMTA		;ACTIVATE THE MTA
	 JFCL			;DON'T CARE IF I CAN'T ASND
ASMTA2:	ADDI MTA,MTASZ		;POINT AT NEXT MTA STATUS BLOCK
	AOBJN Q1,ASMTA1		;LOOP THROUGH ENTIRE DEVICE TABLE
	AOS MTAN		;CONVERT HIGHEST UNIT# TO # OF DEVICES
	RET
; ASCIZL - COMPUTE THE LENGTH OF AN ASCIZ STRING (NOT COUNTING NULL)
;  T1/ ADDRESS OF STRING
; RETURNS +1: ALWAYS, WITH LENGTH IN BYTES IN T2

ASCIZL:	HRLI T1,(POINT 7)	;CONSTRUCT BYTE POINTER
	SETZ T2,		;CLEAR COUNTER
ASCIL1:	ILDB T3,T1		;LOAD A BYTE
	JUMPE T3,R		;EXIT IF END OF STRING
	AOJA T2,ASCIL1		;OTHERWISE, COUNT IT AND LOOP


; AVRENA - ENABLE AVR FOR DRIVE (IF AVR SUPPORTED FOR THIS DRIVE TYPE)
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

AVRENA:	MOVX T1,MA%AVS
	TDNN T1,MTAFLG(MTA)	;AVR SUPPORTED FOR THIS DRIVE?
	RET			;NO
	MOVX T1,MA%AVE
	IORM T1,MTAFLG(MTA)	;SET AVR-ENABLED
	RET


; BLKFND - SEARCH A GALAXY-STYLE BUILDING BLOCK ARGUMENT LIST FOR
;	   THE LAST OCCURRENCE OF A SPECIFIED ARGUMENT TYPE
;  T1/ ADDRESS OF ARGUMENT COUNT WORD
;  T2/ ADDRESS OF FIRST ARGUMENT BLOCK
;  T3/ TYPE CODE OF DESIRED ARGUMENT
; RETURNS +1: NO ARGUMENTS OF REQUESTED TYPE FOUND
;	  +2: SUCCESS, T1/ ADDRESS OF FIRST WORD OF ARGUMENT
;		       T2/ LENGTH OF ARGUMENT (NOT COUNTING HEADER)

BLKFND:	STKVAR <GETLA>
	SETZM GETLA		;CLEAR ADDRESS OF LAST MATCHING HDR
	SKIPG T1,(T1)		;GET # OF ARGUMENTS
	RET			;NONE ???
BLKFN1:	LOAD T4,AR.TYP,(T2)	;GET ARGUMENT TYPE CODE
	CAMN T3,T4		;DOES IT MATCH THE ONE I WANT?
	MOVEM T2,GETLA		;YES, SAVE ITS ADDRESS
	LOAD T4,AR.LEN,(T2)	;GET LENGTH OF THIS ENTRY
	ADD T2,T4		;COMPUTE ADDRESS OF NEXT ENTRY
	SOJG T1,BLKFN1		;LOOP UNTIL ARG COUNT EXHAUSTED
	SKIPN T1,GETLA		;SCAN COMPLETE, ANY MATCHES?
	RET			;NO
	LOAD T2,AR.LEN,(T1)	;YES, GET SIZE OF ENTRY & HDR
	SOS T2			;SUBTRACT SIZE OF HEADER
	AOJA T1,RSKP		;POINT T1 AT 1ST DATA WORD & RETURN
; CHKAB - CHECK IF MOUNT REQUEST IS ABORTED
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST IS ABORTED
;	  +2: REQUEST IS NOT ABORTED

CHKAB:	LOAD T1,RSBSTE		;GET STATE
	CAIL T1,.ERBAS		;ABORTED?
	RET			;YES
	RETSKP			;NO


; CHKID - DETERMINE IF A WORD QUALIFIES AS A LEGAL SIXBIT VOLID/SETNAME
;  T1/ WORD TO BE TESTED
; RETURNS +1: NOT A LEGAL VOLID/SETNAME
;	  +2: LEGAL VOLID SETNAME  T1/ PRESERVED

CHKID:	SKIPN T2,T1		;COPY WORD TO PRESERVE T1
	RET			;ALL BLANKS - ILLEGAL
CHKID1:	SETZ T3,		;CLEAR T3 FOR ROTATING
	ROTC T2,6		;MOVE A CHARACTER FROM T2 INTO T3
	ADJBP T3,[POINT 1,CHKCHR,0] ;GET BYTE POINTER TO BIT
	LDB T3,T3		;IS THIS A LEGAL CHARACTER?
	JUMPE T3,R		;NO, ERROR RETURN
	JUMPN T2,CHKID1		;LOOP IF MORE CHARACTERS LEFT IN T2
	RETSKP			;LOOKS OK TO ME

; TABLE OF LEGAL CHARACTERS FOR VOLIDS AND SETNAMES

CHKCHR:	^B111001111111111111111111111111110111 ;40-103
	^B111111111111111111111110000000000000 ;104-147
; CKBSTR - CHECK GALAXY BUILDING BLOCK STRUCTURE TO VERIFY THAT ALL
;	   BUILDING BLOCKS LIE WITHIN THE STRUCTURE
;  T1/ ENTRY COUNT
;  T2/ ADDRESS OF FIRST ENTRY
;  T3/ SIZE OF STRUCTURE
; RETURNS +1: ERROR WAS DETECTED
;	  +2: NO ERROR DETECTED

CKBSTR:	JUMPL T1,R		;NEGATIVE ENTRY COUNT IS AN ERROR
	JUMPL T3,R		;NEGATIVE STRUCTURE SIZE ALSO AN ERROR
	JUMPE T1,RSKP		;ZERO ENTRY COUNT IS OK
CKBST1:	LOAD T4,AR.LEN,(T2)	;GET SIZE OF THIS ENTRY
	JUMPE T4,R		;ENTRY MUST HAVE A NON-ZERO SIZE
	SUB T3,T4		;SUBTRACT FROM REMAINING STRUCTURE SIZE
	JUMPL T3,R		;ERROR IF BLOCK EXTENDS BEYOND END
	ADD T2,T4		;POINT T2 AT NEXT BLOCK
	SOJG T1,CKBST1		;LOOP THROUGH ALL BLOCKS
	RETSKP			;LOOKS OK TO ME


; CKGHDR - PERFORM BASIC CONSISTENCY CHECK ON INCOMING GALAXY MESSAGE
; CKGHDR also checks whether the message is local or remote.  If remote,
; the remote node name will be stored in RENODE.
;  RBUF, MRPDB/ MESSAGE AND PDB
; RETURNS +1: ERROR IN HEADER
;	  +2: HEADER OK,  T1/ SIZE OF MESSAGE IN WORDS
;			  T2/ MESSAGE TYPE
;		      RENODE/ Remote node name or zero
;			 RSB/ 1, no RSB at this point

CKGHDR:	SETZM RENODE		;[6017]Assume local message
	HLRZ T2,MRPDB+.IPCFP	;GET ACTUAL SIZE OF MESSAGE FROM PDB
	LOAD T1,MS.CNT,RBUF+.MSTYP ;GET SIZE OF MESSAGE FROM GLX HEADER
	CAIL T1,MSHSIZ		;CRASH IF MSG DOESN'T CONTAIN FULL HDR
	CAMGE T2,T1		;IS MSG AS BIG AS ITS HEADER CLAIMS?
	RET			;NO, ERROR IN HEADER
	LOAD T2,MS.TYP,RBUF+.MSTYP ;GET MESSAGE TYPE FOR CALLER
	MOVE T3,RBUF+.MSFLG	;[6010]Get the message flag word
	TXNN T3,MF.NEB		;[6017]From NEBULA
	IFSKP.
	 PUSH P,T1		;[6017]Save T1
	 PUSH P,T2		;[6017]And T2
 	 MOVEI T1,.NDENM	;[6017]Want node name
	 CALL ORNBLF		;[6017]Look for it
	  RET			;[6017]No there
	 MOVE T1,0(T1)		;[6017]Get remote node name from message
	 MOVEM T1,RENODE	;[6017]Save it
	 POP P,T2		;[6017]Restore T2
	 POP P,T1		;[6017]Restore T1
 	ENDIF.
	MOVEI RSB,1		;[6010]NO RSB
	RETSKP
; CKMPAV - TEST IF TAPE DRIVE IS AVAILABLE FOR USE BY SYSTEM
;	   BY CHECKING STATUS BIT IN DEVICE-STATUS FILE ENTRY
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DRIVE NOT AVAILABLE
;	  +2: DRIVE AVAILABLE

CKMPAV:	CALL GMTADD		;GET T1/ MTA DEVICE DESIGNATOR
	MOVEM T1,DSFE+DSFSPC	;Save it as specification
	MOVEI T2,.DVMTA		;Get the device type
	MOVEM T2,DSFE+DSFTYP	;Save it
	CALL DSFLOC		;Go look for it
	  RETSKP		;Not represented, default to available
	MOVE T1,DSFE+DSFFLG	;Get the flags
	TXNE T1,DSF%AV		;Is it available?
	RET			;No
	RETSKP			;Yes


; CLRTAP - ISSUE MTOPR TO CLEAR ERRORS IN MTA DEVICE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: GDSTS TIMED OUT
;	  +2: SUCCESS, AC'S SET UP:
;		T1/ LAST ERROR CODE ENCOUNTERED BY PROCESS
;		T2/ GDSTS T2
;		T3/ # OF BYTES TRANSFERRED (LH OF GDSTS T3)

CLRTAP:	SAVET			;SET UP RETURN VALUES IN STACK
	CALL GETERR		;GET LAST ERROR CODE
	MOVEM T1,CT1		;GIVE TO CALLER
	LOAD T1,MTAJFN		;GET JFN
	IOXCT GDSTS,R,R		;GET STATUS IN T2,T3
	MOVEM T2,CT2		;GIVE T2 TO CALLER VERBATIM
	HLRZM T3,CT3		;PUT # OF BYTES XFERRED IN CALLER'S T3
	MOVEI T2,.MOCLE		;GET CLEAR-ERRORS FUNCTION
	MTOPR			;CLEAR ANY ERROR FLAGS
	 ERCAL STOP
	RETSKP			;RETURN PULLING T1-T4 FROM STACK


; CTIMER - CANCEL ALL TIMER JSYS REQUESTS FOR THIS FORK
; RETURNS +1: ALWAYS

CTIMER:	MOVE T1,[.FHSLF,,.TIMAL] ;FORK,,FUNCTION
	SETZB T2,T3		;PROPITIATE TIMER JSYS
	TIMER			;CANCEL ALL REQUESTS FOR THIS FORK
	 CALL STOP
	RET
; CVTA6 - CONVERT CONTIGUOUS ASCII CHARACTERS TO SIXBIT
; CVTA6R - SAME AS CVTA6, BUT INTERPRET LOWER CASE LETTERS AS UPPER CASE
;  T1/ BYTE POINTER TO FIRST ASCII CHARACTER
;  T2/ NUMBER OF CHARACTERS TO PROCESS
; RETURNS +1: FIELD WAS NOT A LEGAL VOLID OR SETNAME
;	  +2: FIELD WAS A LEGAL VOLID OR SETNAME,  T1/ SIXBIT RESULT

CVTA6:	TDZA T3,T3		;REMEMBER NO-RAISE ENTRY
CVTA6R:	MOVEI T3,1		;REMEMBER RAISE ENTRY
	STAKT
	SETZ T1,		;CLEAR RESULT REGISTER
	MOVE T4,[POINT 6,T1]	;GET BYTE POINTER FOR BUILDING RESULT
CVTA61:	ILDB T3,CT1		;GET NEXT CHARACTER FROM FIELD
	CAIL T3,"a"
	CAILE T3,"z"		;LOWER CASE?
	JRST CVTA62		;NO
	SKIPE CT3		;RAISING LOWER CASE?
	SUBI T3,40		;YES, DO IT
CVTA62:	SUBI T3,40		;CONVERT TO SIXBIT REPRESENTATION
	TRNE T3,777700		;OUT OF RANGE?
	RET			;YES, RETURN ERROR
	IDPB T3,T4		;PACK IT INTO T1
	SOJG T2,CVTA61		;LOOP THRU ALL CHARS IN FIELD
	CALLRET CHKID		;PASS JUDGMENT UPON CONVERTED VALUE


; DACMTA - UNDO THE EFFECTS OF ACTMTA (I.E. DEACTIVATE MTA DEVICE)
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

DACMTA:	JE MTASTE,,R		;RETURN IF ALREADY DONE
	JN MTAJCT,,R		;CAN'T DO IT IF I'M USING THE DRIVE
	JN MTAMT,,R		;CAN'T DO IT IF A USER HAS THE DRIVE
	CALL SCIDIS		;DON'T TAKE INTERRUPTS FROM THIS MTA
	CALL GMTADD		;GET DEVICE DESIGNATOR
	RELD			;RELEASE CONTROL OF DEVICE
	 CALL STOP
	SETZRO MTASTE		;SET MTA NOT ASSIGNED
	RET
; DDMT - CONVERT MT DEVICE DESIGNATOR TO STATUS BLOCK ADDRESS
;  T1/ DEVICE DESIGNATOR
; RETURNS +1: FAILED, NOT A VALID MT DEVICE DESIGNATOR
;	  +2: SUCCESS, MT/ ADDRESS OF MT STATUS BLOCK

DDMT:	HLRZ T2,T1		;GET LEFT HALF OF DESIGNATOR
	CAIN T2,.DVDES+.DVMTA	;CHECK LEFT HALF
	TRZN T1,400000		;CHECK RIGHT HALF
	RET			;SOMETHING'S ROTTEN
	HRRZ MT,T1		;GET UNIT# PART OF DESIGNATOR
	CAML MT,MTN		;DO I KNOW ABOUT IT?
	RET			;NO, ERROR
	IMULI MT,MTSZ		;COMPUTE ADDRESS
	ADDI MT,MT0		; OF STATUS BLOCK
	RETSKP			;SUCCESS


; DDMTA - CONVERT MTA DEVICE DESIGNATOR TO STATUS BLOCK ADDRESS
;  T1/ DEVICE DESIGNATOR
; RETURNS +1: FAILED, NOT A VALID MTA DEVICE DESIGNATOR
;	  +2: SUCCESS, MTA/ ADDRESS OF MTA STATUS BLOCK

DDMTA:	HLRZ T2,T1		;GET LEFT HALF OF DESIGNATOR
	CAIE T2,.DVDES+.DVMTA	;IS IT AN MTA DEVICE?
	RET			;NO, ERROR
	HRRZ MTA,T1		;GET RIGHT HALF OF DESIGNATOR
	CAML MTA,MTAN		;DO I KNOW ABOUT IT?
	RET			;NO, ERROR
	IMULI MTA,MTASZ		;COMPUTE ADDRESS
	ADDI MTA,MTA0		; OF STATUS BLOCK
	RETSKP			;SUCCESS


; DRVDEN - DETERMINE IF DRIVE CAN OPERATE AT A GIVEN DENSITY
;  T1/ DENSITY CODE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DRIVE CANNOT OPERATE AT THIS DENSITY
;	  +2: DRIVE CAN OPERATE AT THIS DENSITY

DRVDEN:	MOVNS T1		;NEGATE FOR RIGHT SHIFT
	MOVSI T2,(1B0)
	LSH T2,(T1)		;POSITION BIT FOR INTERROGATION
	TDNN T2,MTASDN(MTA)	;CAN THE DRIVE WORK AT THIS DENSITY?
	RET			;NO
	RETSKP			;YES
; DDCTLD - CHECK FOR REQUEST TO ENABLE OR DISABLE ^D INTERCEPT
; RETURNS +1: ALWAYS

DDCTLD:	SKIPGE T1,CDFLG		;HAS A REQUEST BEEN MADE?
	RET			;NO
	SETOM CDFLG		;YES, CLEAR IT
	JUMPE T1,[MOVEI T1,.TICCD ;REQUEST TO DISABLE ^D
		DTI
		TXZ F,CDENF	;RESET ^D-ENABLED
		RET]
	MOVX T1,<.TICCD,,DDTCN>	;REQUEST TO ENABLE ^D
	ATI
	TXO F,CDENF		;SET ^D-ENABLED
	RET

; DDT INTERRUPT PROCESSOR

DDTIH:	CALL DDTLOD		;TRY TO LOAD DDT
	 SKIPA			;NO CAN DO
	CALL 770000		;CALL DDT - RETURN IS R$G
	MOVEI T1,.FHSUP
	MOVX T2,1B0
	TXNN F,CDENF		;DON'T INTERRUPT IF CALLED BY ^D
	IIC			;TRIGGER CHANNEL-0 INTERRUPT UPSTAIRS
	RET			;EXIT TO SCHED

; DDTLOD - LOADS DDT INTO MY ADDRESS SPACE IF NOT ALREADY THERE
; RETURNS +1: ERROR LOADING DDT
;	  +2: DDT LOADED SUCCESSFULLY

DDTLOD:	MOVE T1,[.FHSLF,,770]
	RPACS			;IS DDT LOADED ALREADY?
	JXN T2,PA%PEX,RSKP	;YES, RETURN +2
	MOVX T1,GJ%OLD+GJ%SHT
	HRROI T2,[ASCIZ/SYS:UDDT.EXE/]
	GTJFN
DDTLDX:	 JRST [	TMSG <% MOUNTR Can't find or get DDT>
		JRST JSERR0]	;TYPE MESSAGE AND RETURN +1
	HRLI T1,.FHSLF
	GET
	 ERJMP DDTLDX
	MOVE T1,.JBSYM		;GET ADDRESS OF SYMBOL TABLE
	HRRZ T2,770001		;GET ADDRESS OF WHERE TO STUFF IT
	MOVEM T1,(T2)		;POINT DDT AT MY SYMBOL TABLE
	RETSKP

; REENTER ADDRESS

DEBUG:	MOVE P,[IOWD PDLEN,PDL]	;NEED STACK POINTER FOR CALL
	CALL DDTLOD		;LOAD DDT
	 HALTF			;CAN'T
	JRST 770000		;GO RIGHT TO DDT


; ELOGOF - INHIBIT ERROR LOGGING FOR MAGTAPE
; ELOGON - RESTORE ERROR LOGGING FOR MAGTAPE
;  MTA/ ADDR OF MTA STATUS BLOCK (MTA MUST BE OPEN)
; RETURNS +1: ALWAYS, REQUESTED FUNCTION PERFORMED

ELOGON:	TDZA T3,T3		;ENABLE ERROR LOGGING
ELOGOF:	MOVEI T3,1		;INHIBIT ERROR LOGGING
	LOAD T1,MTAJFN		;GET JFN
	MOVEI T2,.MOIEL		;FUNCTION = CONTROL ERROR LOGGING
	IOXCT MTOPR,R,R		;SET DESIRED STATE
	RET
; FNOUT - TRANSLATE A NUMBER INTO RIGHT-JUSTIFIED, ZERO-FILLED ASCII
;  T1/ BYTE POINTER TO FIELD
;  T2/ NUMBER
;  T3/ FIELD SIZE ,, RADIX
; RETURNS +1: ALWAYS

FNOUT:	HLRZ T4,T3		;GET FIELD SIZE
	ADJBP T4,T1		;GET POINTER TO BYTE AFTER FIELD
	ILDB T4,T4		;GET BYTE FOLLOWING FIELD
	TXO T3,NO%LFL+NO%ZRO	;TURN ON FLAGS
	NOUT			;OUTPUT NUMBER
	 JFCL
	IDPB T4,T1		;FIX UP STUPID NULL LEFT BY NOUT
	RET


; GALHDR - CONSTRUCT STANDARD GALAXY HEADER IN TBUF
;  T1/ LENGTH OF MESSAGE (WORDS) ,, MESSAGE TYPE CODE
;  T2/ MESSAGE FLAGS ,, SIXBIT SUFFIX
;  T3/ ACKNOWLEDGMENT CODE
; RETURNS +1: ALWAYS, WITH GALAXY HEADER BUILT IN BEGINNING OF TBUF
; NOTE: THIS IS THE ONLY PLACE WHERE THE GALAXY HEADER IS BUILT
;	IN THE ENTIRE MODULE

GALHDR:	MOVEM T1,TBUF+.MSTYP
	MOVEM T2,TBUF+.MSFLG
	MOVEM T3,TBUF+.MSCOD
	RET


; GETDEN - Get system default magtape density
; Returns +1: Always, with density in DEFDEN

GETDEN:	SETO T1,		;Use value for current job
	HRROI T2,DEFDEN		;Get just one word
	MOVEI T3,.JIDEN		;System/job default density
	GETJI
	 ERJMP [ MOVEI T1,.SJD16 ;Failed use 1600 BPI
	 	 MOVEM T1,DEFDEN ;as default density
		 JRST .+1]
	RET

; GETERR - RETURN THE MOST RECENT ERROR CODE FOR THIS FORK
; RETURNS +1: ALWAYS, WITH ERROR CODE IN T1

GETERR:	MOVEI T1,.FHSLF
	GETER			;GET MOST RECENT ERROR IN RH OF T2
	 ERJMP .+1
	HRRZ T1,T2		;MOVE TO T1 STRIPPING LEFT HALF
	RET
; GETVU - TRANSFER USER NAME FROM VOL2 LABEL TO CALLER'S STRING AND
;	  RETURN USER NUMBER CORRESPONDING TO THE USER NAME
;  T1/ ADDRESS OF 8-WORD AREA TO RECEIVE ASCIZ USER NAME
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: T1/ BYTE POINTER TO CALLER'S ASCIZ USER NAME STRING
;	      T2/ USER # CORRESPONDING TO NAME OR 0 IF THE USER DOESN'T
;		  EXIST ON THE SYSTEM

GETVU:	HRLI T1,(POINT 7)	;CREATE BYTE POINTER TO CALLER'S AREA
	SAVET			;RETURN IT TO CALLER IN T1
	MOVEI T2,V2OWN-1
	ADJBP T2,[POINT 8,MTAV2(MTA)] ;GET BYTE PTR TO VOL2 USER NAME
	MOVEI T3,V2OWNL		;GET MAX LENGTH OF USER NAME
GETVU1:	ILDB T4,T2		;GET CHARACTER FROM VOL2
	TRZ T4,200		;MASK OFF TRASH
	CAIN T4," "		;END OF NAME?
GETVU2:	SETZ T4,		;YES, TIE IT OFF WITH A NULL
	IDPB T4,T1		;COPY CHARACTER TO CALLER'S AREA
	JUMPN T4,[SOJG T3,GETVU1 ;LOOP IF MORE LEFT IN VOL2 LABEL
		JRST GETVU2]	;OTHERWISE WRAP UP

; NOW TRY TO IDENTIFY THE USER WITH RCUSR

	SETZM CT2		;RETURN 0 IN T2 IF RCUSR FAILS
	MOVX T1,RC%EMO		;REQUEST EXACT MATCH
	MOVE T2,CT1		;GET POINTER TO CALLER'S STRING
	RCUSR			;TRY TO RECOGNIZE USER NAME
	 ERJMP R		;FAILED
	TXNN T1,RC%NOM		;GOT A MATCH?
	MOVEM T3,CT2		;YES, RETURN USER # IN T2
	RET
; GMTADD - GET MTA DEVICE DESIGNATOR
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, WITH DEVICE DESIGNATOR IN T1

GMTADD:	MOVE T1,MTA		;COPY STATUS BLK ADDR
	SUBI T1,MTA0		;COMPUTE OFFSET FROM START OF BLOCKS
	IDIVI T1,MTASZ		;COMPUTE MTA UNIT #
	HRLI T1,.DVDES+.DVMTA	;ADD LEFT HALF OF DEVICE DESIGNATOR
	RET


; GMTADS - ISSUE MTOPR AND RETURN MTA DEVICE STATUS
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ .MOSTA STATUS WORD .MOCST

GMTADS:	STKVAR <<MTOBLK,MOSTAL>>
	MOVEI T1,MTOBLK		;GET ARG BLOCK ADDRESS
	CALL MOSTA		;GET STATUS & CHARACTERISTICS
	MOVE T1,.MOCST+MTOBLK	;GET STATUS INFO FOR CALLER
	TXNE T1,SJ%OFS		;OFFLINE?
	TXZ T1,SJ%REW		;YES, CAN'T BE REWINDING THEN
	RET


; GMTDD - GET MT DEVICE DESIGNATOR
;  MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS, WITH DEVICE DESIGNATOR IN T1

GMTDD:	MOVE T1,MT		;COPY STATUS BLK ADDR
	SUBI T1,MT0		;COMPUTE OFFSET FROM START OF BLOCKS
	IDIVI T1,MTSZ		;COMPUTE MT UNIT #
	TDO T1,[.DVDES+.DVMTA,,400000] ;ADD THE FRILLS
	RET
; GTINAM - GET INSTALLATION NAME FROM FILE
; RETURNS +1: ALWAYS, ASCIZ INSTALLATION NAME IN TAPNAM

GTINAM:	MOVX T1,GJ%SHT+GJ%ACC+GJ%OLD
	HRROI T2,[ASCIZ/SYSTEM:TAPNAM.TXT/]
	GTJFN			;GET JFN ON FILE
	 RET			;NO JFN, NO ARBEIT
	MOVE T4,T1		;SAVE JFN
	MOVX T2,FLD(7,OF%BSZ)+OF%RD
	OPENF			;OPEN FILE FOR READ ACCESS
	 JRST [	MOVE T1,T4	;OPEN FAILED, GET JFN
		RLJFN		;DUMP IT
		 JFCL
		RET]
	HRROI T2,TAPNAM		;GET ADDRESS OF TEXT IN CORE
	MOVNI T3,TPNMSZ		;GET MAX # OF BYTES TO READ
	SIN			;READ 'EM IN
	 ERJMP .+1		;IGNORE ERRORS
	CLOSF			;CLOSE FILE, DUMP JFN
	 JFCL
	MOVE T1,[POINT 7,TAPNAM] ;GET POINTER TO TEXT
GTINM1:	ILDB T2,T1		;GET A BYTE
	JUMPE T2,R		;EXIT IF END OF STRING
	CAIE T2,.CHCRT		;CARRIAGE-RETURN?
	JRST GTINM1		;NO, CONTINUE SCAN
	SETZ T2,		;YES
	DPB T2,T1		;DELETE C/R AND EVERYTHING AFTER IT
	RET


; INAP - PERFORM INITIALIZATION RELATED TO ASSOCIATED PROCESSES
; RETURNS +1: ALWAYS

INAP:	SAVEQ
	MOVEI Q1,APNUM		;GET # OF A/P'S
INAP1:	SOJL Q1,R		;EXIT IF NONE LEFT
	CALL @APINI(Q1)		;CALL A/P INIT ROUTINE
	JRST INAP1		;LOOP THRU ALL A/P TABLE ENTRIES

; INT26 - CONVERT INTEGER TO SIXBIT, RIGHT-JUSTIFIED ZERO-FILLED
;  T1/ INTEGER
; RETURNS +1: ALWAYS, T1/ SIXBIT RESULT

INT26:	MOVM T2,T1		;GET ABSOLUTE VALUE
	IDIV T2,[^D1000000]	;GET NUMBER MOD 1000000 IN T3
	MOVE T1,[EXP 0]		;INIT RESULT
	MOVE T2,[POINT 6,T1,35]	;GET POINTER TO RESULT
INT261:	IDIVI T3,12		;PEEL OFF A DIGIT
	ADDI T4,20		;CONVERT INTEGER TO SIXBIT
	DPB T4,T2		;STORE INTO T1
	ADD T2,[6B5]		;BACK UP BYTE POINTER
	JUMPN T3,INT261		;LOOP IF MORE TO DO
	RET
;INT26L - CONVERT INTEGER TO SIXBIT, LEFT-JUSTIFIED ZERO-FILLED
;T1/ INTEGER
;RETURNS +1: ALWAYS, T1/SIXBIT RESULT

INT26L:	MOVM T2,T1		;Get absolute value
	IDIV T2,[^D1000000]	;Get number MOD 1000000 in T3
	MOVE T2,[POINT 6,T1]	;Set up a pointer
	SETZ T1,		;Initialize the sixbit value
I26LOP: IDIVI T3,^D10		;Convert the number
	PUSH P,T4		;Save the digit
	SKIPE T3		;Check if completed
	CALL I26LOP		;Standard recursive algorithm
	POP P,T4		;Restore the digit
	ADDI T4,20		;Convert to sixbit
	IDPB T4,T2		;Store the digit
	RET 			;And return
; IOXCTR - DRIVER FOR IOXCT MACRO; EXECUTES AND TIMES OUT A JSYS
;  T1-T4/ ARGUMENTS FOR JSYS
; CALL:	IOXCT <JSYS,ERJMP ADDRESS,TIMEOUT ADDRESS>
; RETURNS TO ERJMP ADDRESS IF JSYS ERJMP'ED
;	  TO TIMEOUT ADDRESS IF JSYS TIMED OUT
;	  TO INSTRUCTION AFTER IOXCT MACRO IF JSYS SUCCEEDED
;	ALL RETURNS: T1-T4 CONTAINING VALUES RETURNED BY JSYS

; CAUTION - IN ORDER TO PICK UP THE ARGUMENTS THAT FOLLOW THE CALL,
;	    THIS ROUTINE DOES SOME SHADY THINGS WITH THE STACK

IOXCTR:: CALL [	SAVET		;PRESERVE AC'S FOR JSYS
		MOVE T1,[14,,.SYSTA]
		GETAB		;GET CURRENT LOAD AVERAGE
		 CALL STOP	;SHOULD NEVER FAIL
		FIXR T2,T1	;CONVERT TO AN INTEGER
		IMULI T2,3	;TIMES 3
		CAIGE T2,^D180	;[334]Wait at least 3 minutes
		MOVEI T2,^D180	;[334]
		MOVE T1,[.FHSLF,,.TIMEL] ;FORK,,FUNCTION
		IMULI T2,^D1000	;CONVERT SECONDS TO MILLISECONDS
		MOVEI T3,JTOCN	;GET INTERRUPT CHANNEL #
		TIMER		;SET UP FOR INTERRUPT
		 JFCL
		RET]
	TXO F,JTOAF		;SET JSYS-TIMEOUT-ARMED
	XCT @(P)		;EXECUTE JSYS
	 ERJMP [TXZ F,JTOAF	;DISARM TIMER
		CALL [	SAVET
			CALLRET CTIMER] ;CANCEL TIMER
		POP P,CX	;GET ADDRESS OF CALL+1
		HLRZ CX,1(CX)	;GET ERJMP ADDRESS
		JRST (CX)]	;RETURN TO ERJMP ADDRESS
	TXZ F,JTOAF		;DISARM TIMER
	CALL [	SAVET
		CALLRET CTIMER]	;CANCEL TIMER
	AOS (P)			;RETURN TO
	RETSKP			; CALL+3

; INTERRUPT HANDLER FOR TIMER JSYS INTERRUPT

JTOIH:	TXZN F,JTOAF		;TIMER STILL ARMED?
	DEBRK			;NO, DON'T DO ANYTHING
	MOVEM T1,@LEVTAB+PRIEXT-1 ;SAVE T1
	MOVE T1,[PC%USR+IOXCT1]	;GET NEW PC
	EXCH T1,@LEVTAB+PRIEXT-1 ;RESTORE T1, SET NEW PC
	DEBRK			;DEBREAK TO IOXCT1

IOXCT1:	POP P,CX		;TIMEOUT OCCURRED, GET ADDR OF CALL+1
	HRRZ CX,1(CX)		;GET TIMEOUT-HANDLER ADDRESS
	JRST (CX)		;EXIT TO CALLER'S TIMEOUT HANDLER
; LDATIN - PARSE AND RETURN DATE FROM TAPE LABEL (IN FORM " YYDDD")
;  T1/ ILDB POINTER TO FIRST CHARACTER OF DATE FIELD
; RETURNS +1: DATE CONTAINED NON-NUMERIC CHARACTERS OR WAS ILLEGAL
;	  +2: DATE PARSED SUCCESSFULLY,
;		T1/ YEAR,,JULIANDAY   OR   0 (IF DATE WAS " 00000")

LDATIN:	SAVEQ
	IBP T1			;SKIP OVER THE SPACE
	MOVE Q1,T1		;MOVE POINTER TO ANOTHER PLACE
	SETO Q2,		;SET FOR 1ST PASS
LDAT1:	MOVEI T4,3(Q2)		;COMPUTE # OF DIGITS TO SCAN
	SETZ T2,		;CLEAR ACCUMULATOR
LDAT2:	ILDB T3,Q1		;GET NEXT CHARACTER
	CAIL T3,"0"		;ERROR IF .LT. 0
	CAILE T3,"9"		; OR .GT. 9
	RET
	IMULI T2,^D10		;SHIFT CONTENTS OF ACCUMULATOR
	ADDI T2,-"0"(T3)	;ADD IN NEW DIGIT
	SOJG T4,LDAT2		;LOOP
	AOJE Q2,[MOVS T1,T2	;DOING YEAR, GET T1/ YEAR-1900,,0
		JRST LDAT1]	;NOW GO BACK AND DO THE DAY
	JUMPE T2,[JUMPE T1,RSKP	;IF YEAR=DAY=0, RETURN GOOD WITH T1/ 0
		RET]		;IF DAY=0 BUT YEAR.NE.0, ERROR
	CAILE T2,^D366		;IS DAY TOO LARGE?
	RET			;YES, ERROR
	HRR T1,T2		;GET YEAR-1900,,JULIANDAY
	ADD T1,[^D1900,,0]	;ADD IN THE 1900
	RETSKP
; MOSTA - ISSUE .MOSTA MTOPR TO GET TAPE DRIVE CHARACTERISTICS AND STATUS
;	  NOTE - THIS MTOPR FUNCTION MUST BE GUARANTEED NOT TO BLOCK
;  T1/ ADDRESS OF BLOCK TO RECEIVE INFORMATION (MOSTAL WORDS LONG)
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, WITH INFORMATION IN ARGUMENT BLOCK

MOSTA:	STAKT
	CALL MTAGJF		;GET JFN FOR MTOPR IN T1
	MOVEI T2,.MOSTA		;MTOPR FUNCTION CODE
	MOVE T3,CT1		;GET ADDR OF ARGUMENT BLOCK
	MOVEI T4,MOSTAL
	MOVEM T4,(T3)		;PUT LENGTH IN FIRST WORD OF BLOCK
	MTOPR			;GET STATUS INFO INTO ARG BLOCK
	CALLRET MTARJF		;RELEASE JFN AND RETURN


; MOVSTR - MOVE ASCIZ STRING (TRAILING NULL IS NOT MOVED)
;  T1/ SOURCE STRING POINTER
;  T2/ DESTINATION STRING POINTER
;  STRING POINTERS MAY BE OF THE FORM:  -1,,ADDRESS
; RETURNS +1: ALWAYS

MOVSTR:	TLC T1,-1
	TLCN T1,-1
	HRLI T1,(POINT 7)
	TLC T2,-1
	TLCN T2,-1
	HRLI T2,(POINT 7)
MOVST1:	ILDB T3,T1
	JUMPE T3,R
	IDPB T3,T2
	JRST MOVST1
; MTAGJF - GET A JFN ON MTA DEVICE
;  MTA/ MTA STATUS BLOCK
; RETURNS +1: ALWAYS, WITH JFN IN MTAJFN AND T1

MTAGJF:	JN MTAJCT,,MTAGJ1	;JFN EXISTS ALREADY, USE IT
	STKVAR <<GJFTXT,2>>
	CALL GMTADD		;GET DEVICE DESIGNATOR IN T1
	MOVE T2,T1		;MOVE TO T2 FOR DEVST
	HRROI T1,GJFTXT		;GET ADDRESS OF TEXT BUFFER
	DEVST			;BEGIN JFN STRING WITH "MTAn"
	 CALL STOP
	MOVEI T2,":"
	IDPB T2,T1		;TACK ON A COLON
	SETZ T2,
	IDPB T2,T1		;TERMINATE WITH A NULL
	MOVX T1,GJ%SHT+GJ%ACC	;GTJFN FLAGS
	HRROI T2,GJFTXT		;POINTER TO STRING
	GTJFN			;GET JFN ON MTA DEVICE
	 CALL STOP
	STOR T1,MTAJFN		;STORE JFN IN TABLE
MTAGJ1:	INCR MTAJCT		;INCREMENT JFN-IN-USE COUNT
	LOAD T1,MTAJFN		;GET JFN FOR CALLER
	RET


; MTARJF - RELEASE MTA JFN OBTAINED WITH MTAGJF
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

MTARJF:	LOAD T1,MTAJCT		;GET JFN-IN-USE COUNT
	SOSGE T1		;GOING NEGATIVE?
	CALL STOP		;YES, PROGRAM LOGIC ERROR
	STOR T1,MTAJCT		;STORE NEW COUNT
	JUMPG T1,R		;EXIT IF JFN STILL IN USE
	LOAD T1,MTAJFN		;GET JFN
	RLJFN			;DISCARD IT
	 CALL STOP
	SETZRO MTAJFN		;CLEAR JFN JUST TO PLAY IT SAFE
	RET
; MTAOPI - GET A JFN OPEN FOR READ ON AN MTA DEVICE
; MTAOPO - GET A JFN OPEN FOR WRITE ON AN MTA DEVICE
;  MTA/ ADDR OF MTA STATUS BLOCK (DENSITY SET FROM MTADEN)
; RETURNS +1: FAILED, DRIVE OFFLINE OR WRITE-LOCKED
;	  +2: SUCCESS, JFN IN MTAJFN AND T1

MTAOPI:	SKIPA T1,[OF%RD]	;OPEN FOR READ ACCESS
MTAOPO:	MOVX T1,OF%WR		;OPEN FOR WRITE ACCESS
	SAVEQ
	MOVE Q1,T1		;SAVE MODE
	MOVE T1,MTAFLG(MTA)	;GET MTA FLAGS
	TXNE T1,MA%OPN		;JFN OPEN ALREADY?
	CALL STOP		;YES, PROGRAM FAILURE
	CALL MTAGJF		;GET JFN ON MTA
	MOVX T2,FLD(17,OF%MOD)+FLD(10,OF%BSZ)
	TDO T2,Q1		;SET MODE BIT
	OPENF			;OPEN THE JFN
	 JRST [	CAIN T1,OPNX8	;DEVICE OFFLINE?
		JRST [	SETZRO MA%LOD,MTAFLG(MTA) ;YES, UPDATE STATUS
			CALLRET MTARJF] ;DUMP JFN AND TAKE +1
		CAIE T1,OPNX25	;DEVICE WRITE PROTECTED?
		CALL STOP	;NO, CAN'T HACK THIS ONE
		CALLRET MTARJF]	;YES, DUMP JFN AND TAKE +1
	SETONE MA%OPN,MTAFLG(MTA) ;SET JFN-OPEN FLAG
	MOVEI T2,.MOSDM
	MOVEI T3,.SJDM8		;SPECIFY INDUSTRY-COMPATIBLE MODE
	MTOPR			;SET DATA MODE OF DRIVE
	SKIPE UNLD		;Skip if the tape is not being unloaded
	JRST [ SETZM UNLD		;Reset tape unloading flag
	       RETSKP ]			;Return +2, T1/ JFN
	MOVEI T2,.MOSDN
	LOAD T3,MTADEN		;GET DESIRED DENSITY CODE
	MTOPR			;SET DENSITY
	RETSKP			;RETURN +2, T1/ JFN


; MTACLS - CLOSE MTA JFN
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

MTACLS:	MOVX T1,MA%OPN
	TDNN T1,MTAFLG(MTA)	;IS THE JFN OPEN?
	CALL STOP		;NO, PROGRAM FAILURE
	ANDCAM T1,MTAFLG(MTA)	;IT'LL BE CLOSED WHEN I GET DONE
	LOAD T1,MTAJFN		;GET MTA JFN
	LOAD T2,MTAJCT		;GET JFN-IN-USE COUNT
	SOSGE T2		;GOING NEGATIVE?
	CALL STOP		;YES, PROGRAM LOGIC ERROR
	STOR T2,MTAJCT		;STORE NEW COUNT
	SKIPE T2		;DOES SOMEONE ELSE NEED THE JFN?
	TXO T1,CO%NRJ		;YES, DON'T DUMP JFN, JUST CLOSE IT
	TXO T1,CZ%ABT		;CLOSE WITHOUT BLOCKING
	CLOSF			;CLOSE (AND POSSIBLY DISCARD) JFN
	 CALL STOP
	JUMPN T2,R		;EXIT IF JFN STILL IN USE
	SETZRO MTAJFN		;CLEAR JFN JUST TO PLAY IT SAFE
	RET
; NMTRSB - GET ADDRESS OF NEXT MAGTAPE MOUNT RSB
; NSTRSB - GET ADDRESS OF NEXT STRUCTURE MOUNT OR DISMOUNT RSB
; NXXRSB - GET ADDRESS OF NEXT ACTIVE RSB
;  QSB/ ADDR OF QUEUE SCAN BLOCK FOR ARBQDB
; RETURNS +1: NO RSB'S LEFT
;	  +2: SUCCESS, RSB/ ADDR OF REQUEST STATUS BLOCK

NMTRSB:	SAVEQ
	JSP Q1,NRSB1		;SETUP COROUTINE ADDRESS IN Q1
	CAIE T1,.MNTTP		;COROUTINE FOR TAPE MOUNT
	JRST NRSB1
	RETSKP

NSTRSB:	SAVEQ
	JSP Q1,NRSB1		;SETUP COROUTINE ADDRESS IN Q1
	CAIE T1,.MNTST		;COROUTINE FOR STRUCTURE MNT/DSMNT
	CAIN T1,.DSMST
	RETSKP
	JRST NRSB1

NXXRSB:	SAVEQ
	JSP Q1,NRSB1		;SETUP COROUTINE ADDRESS IN Q1
	RETSKP			;COROUTINE TO SUCCEED FOR ANY RSB

; CHECK NEXT RSB TO SEE IF IT QUALIFIES

NRSB1:	CALL QMSCAN		;GET ADDRESS OF RSB LINKAGE IN T2
	 RET			;END OF RSB LIST
	MOVEI RSB,-RSBLNK(T2)	;LOAD RSB AC
	CALL CHKAB		;REQUEST ABORTED?
	 JRST NRSB1		;YES, SKIP IT
	LOAD T1,RSBTYP		;LIVE RSB, GET TYPE FOR COROUTINE
	JRST (Q1)		;DISPATCH TO COROUTINE
; PB ROUTINES - CONSTRUCT GALAXY-STYLE BUILDING-BLOCK LIST IN TBUF

; PBINIT - SET UP DATABASE FOR CALLS TO OTHER PB ROUTINES
; RETURNS +1: ALWAYS

PBINIT:	SAVET			;[6010]Save T ACs
	XMOVEI T1,TBUF+.OARGC	;GET ADDRESS OF ARGUMENT COUNT WORD
	MOVEI T2,TBUF+.OHDRS	;GET ADDRESS OF FIRST BUILDING BLOCK
	MOVEM T1,PBACW		;SAVE ADDR OF ARGUMENT COUNT WORD
	SETZM (T1)		;ZERO THE ARGUMENT COUNT
	MOVEM T2,PBBPT		;SAVE ADDR OF 1ST BUILDING BLOCK
	RET


; PBBLK - ADD PREFORMATTED BUILDING BLOCK TO LIST
;  T1/ ADDRESS OF BUILDING BLOCK WITH HEADER
; RETURNS +1: ALWAYS

PBBLK:	SAVET			;[6010]Save T ACs
	LOAD T2,AR.LEN,(T1)	;GET LENGTH OF BLOCK
	MOVE T3,T2		;Get length in words
	IMULI T3,5		;Turn it to bytes
	EXCH T3,PBLFT		;flop them for sub
	SUBB T3,PBLFT		;number of bytes left in tbuf

	MOVSS T1		;BLT SOURCE
	HRR T1,PBBPT		;BLT DESTINATION
	ADDB T2,PBBPT		;COMPUTE ADDR OF NEXT BLOCK
	BLT T1,-1(T2)		;MOVE BLOCK INTO LIST
	AOS @PBACW		;BUMP ARG COUNT
	RET


; PBTXT - CONSTRUCT ASCIZ TEXT BUILDING BLOCK
;  T1/ ADDRESS OF ASCIZ TEXT
;  T2/ ARGUMENT TYPE CODE
; RETURNS +1: ALWAYS

PBTXT: 	MOVE T4,PBBPT		;GET ADDR OF BLOCK HEADER
	STOR T2,AR.TYP,(T4)	;STORE TYPE CODE IN HEADER
	HRLI T1,(POINT 7)	;Get default byte pointer to source
	CAIN T2,.WTTYP		;[6010]Is it the header?
	JRST PBTXT0		;[6010]Yes, use what is in T1
	SKIPLE MORTXT		;Is this a continuation
	MOVE T1,MORTXT		;Yes, restore byte pointer
	SETZM MORTXT		;Clear text continuation byte pointer
PBTXT0:	MOVEI T2,1(T4)		;[6010]COMPUTE ADDRESS OF TEXT IN BLOCK
	HRLI T2,(POINT 7)	;GET BYTE POINTER TO DESTINATION
PBTXT1:	ILDB T3,T1		;GET BYTE
	IDPB T3,T2		;TRANSFER IT
	JUMPE T3,PBTXT7		;End of this message
	SOSLE PBLFT		;Can orion handle more text
	JRST PBTXT1		;Yes, pick up next character
	MOVEI T3,BYTEND		;Pick up number of bytes left in the buffer
	MOVEM T3,PBLFT		;Store in byte count left
PBTXT2:	ILDB T3,T1		;Pick up the next character
	IDPB T3,T2		;Place into the buffer
	JUMPE T3,PBTXT7		;End of the ASCIZ string
	SOSG PBLFT		;Update the number of bytes left in the buffer
	JRST PBTXT6		;This should never happen, no more space
	CAIN T3,.CHCRT		;Is this a carriage return?
	JRST PBTXT3		;Yes, go do end of message processing
	CAIE T3,.CHLFD		;No, is this a line feed?
	JRST PBTXT2		;No, pick up the next character

;A carriage return or line feed has been found. Pick up any more if room

PBTXT3:	MOVE T4,T1		;Save the pointer 
PBTXT4:	ILDB T3,T1		;Pick up the next character
	SKIPN T3		;End of the ASCIZ string?
	JRST [  IDPB T3,T2	;Yes, place the null in the buffer
		MOVE T4,PBBPT	;Restore block pointer address
		JRST PBTXT7]	;Finish processing this packet
	CAIN T3,.CHCRT		;Carriage return?
	JRST PBTXT5		;Yes, include it in this packet
	CAIN T3,.CHLFD		;No, is it a line feed?
	JRST PBTXT5		;Yes, include it in this packet
	MOVE T1,T4		;No,restore the pointer to TMCMSG
	JRST PBTXT6		;Finish processing this packet
PBTXT5: IDPB T3,T2		;Include the CR or LF in this packet
	SOSLE PBLFT		;Update the amount of space left
	JRST PBTXT4		;Go pick up the next character
PBTXT6:	MOVX T4,WT.MOR		;More message for next time 
	IORM T4,BTFLGS	        ;Save it
	MOVE T4,PBBPT		;Addr of block header
	SKIPE T3		;Was last byte a nul
	MOVEM T1,MORTXT		;No, save byte pointer of next text
PBTXT7: MOVEI T2,1(T2)		;GET ADDR OF WORD AFTER LAST TEXT WORD
	MOVEM T2,PBBPT		;UPDATE BLOCK POINTER
	SUB T2,T4		;COMPUTE LENGTH OF BLOCK
	STOR T2,AR.LEN,(T4)	;PUT LENGTH IN HEADER
	AOS @PBACW		;BUMP ARG COUNT
	RET
; PROTIN - CONVERT 6-DIGIT ASCII PROTECTION CODE TO FIXED-POINT INTEGER
;  T1/ BYTE POINTER TO PROTECTION CODE
; RETURNS +1: CODE CONTAINED AT LEAST 1 NON-OCTAL DIGIT
;	  +2: SUCCESS, T1/ CODE

PROTIN:	MOVE T4,T1		;COPY POINTER TO T4
	SETZ T1,		;INIT VALUE AC
	MOVEI T2,6
PROT1:	ILDB T3,T4		;GET ASCII CHAR
	SUBI T3,"0"
	TRNE T3,777770		;LEGAL OCTAL DIGIT?
	RET			;NO
	LSH T1,3		;YES, SHIFT TO MAKE ROOM
	ADD T1,T3		;ADD IN THIS DIGIT
	SOJG T2,PROT1		;LOOP
	RETSKP
; QUEUE-MANAGING ROUTINES
;	ADD AND REMOVE PACKETS FROM QUEUES; QUEUES ARE DEFINED BY A
;	1-WORD QUEUE DESCRIPTOR WITH ADDRESS OF HEAD PACKET IN LEFT
;	HALF AND ADDRESS OF TAIL IN RIGHT. IF ZERO, QUEUE IS EMPTY.


; QMDQH - DEQUEUE THE HEAD PACKET OF A QUEUE
;  T1/ ADDRESS OF QUEUE DESCRIPTOR BLOCK
; RETURNS +1: QUEUE WAS EMPTY
;	  +2: SUCCESS, T2/ ADDRESS OF DEQUEUED HEAD PACKET

QMDQH:	HLRZ T2,(T1)		;GET ADDRESS OF HEAD PACKET
	JUMPE T2,R		;IF EMPTY, QUIT NOW
	SKIPN T3,(T2)		;QUEUE GOING TO BE EMPTY?
	SETZM (T1)		;YES, CLEAR DESCRIPTOR BLOCK
	HRLM T3,(T1)		;SET NEW HEAD POINTER IN QDB
	RETSKP


; QMQH - ADD A PACKET TO THE HEAD OF A QUEUE
;  T1/ ADDRESS OF QUEUE DESCRIPTOR BLOCK
;  T2/ ADDRESS OF PACKET TO BE ADDED TO HEAD OF QUEUE
; RETURNS +1: ALWAYS

QMQH:	HLRZ T3,(T1)		;GET ADDRESS OF CURRENT HEAD
	HRLM T2,(T1)		;SET ADDRESS OF NEW HEAD IN QDB
	JUMPE T3,[HRRM T2,(T1)	;QUEUE WAS EMPTY, SET NEW TAIL
		SETZM (T2)	;CLEAR LINKAGE IN ONLY ENTRY
		RET]
	MOVEM T3,(T2)		;POINT NEW HEAD AT OLD HEAD
	RET


; QMQT - ADD A PACKET TO THE TAIL OF A QUEUE
;  T1/ ADDRESS OF QUEUE DESCRIPTOR BLOCK
;  T2/ ADDRESS OF PACKET TO BE ADDED TO TAIL OF QUEUE
; RETURNS +1: ALWAYS

QMQT:	SETZM (T2)		;CLEAR LINKAGE IN NEW TAIL
	HRRZ T3,(T1)		;GET CURRENT TAIL ADDRESS
	HRRM T2,(T1)		;SET NEW TAIL
	JUMPE T3,[HRLM T2,(T1)	;QUEUE WAS EMPTY, SET NEW HEAD
		RET]
	MOVEM T2,(T3)		;POINT OLD TAIL AT NEW TAIL
	RET
; ROUTINES ON THIS PAGE ARE USED FOR SCANNING A QUEUE, POSSIBLY
; WITH THE INTENT OF DEQUEUEING ONE OF ITS ENTRIES.

; QUEUE-SCAN-BLOCK (QSB) OFFSETS:

QSB.QB==0		;OFFSET TO QUEUE DESCRIPTOR BLOCK
QSB.LE==1		;OFFSET TO LAST ENTRY SCANNED
QSB.LP==2		;OFFSET TO ENTRY BEFORE LAST ENTRY


; QSCNIR - DRIVER FOR QSCANI MACRO
; CALL:	QSCANI qdb-address

QSCNIR::PUSH P,QSB		;SAVE QSB AC
	MOVEI QSB,1(P)		;GET ADDRESS OF QSB IN STACK
	PUSH P,(CX)		;QSB.QB - QDB ADDRESS
	PUSH P,[0]		;QSB.LE - ADDRESS OF LAST ENTRY SCANNED
	PUSH P,[0]		;QSB.LP - ADDRESS OF ENTRY BEFORE THAT
	CALL 1(CX)		;BACK TO CALLER FOR A WHILE
	 TRNA			;NON-SKIP RETURN
	AOS -4(P)		;SKIP RETURN
	ADJSP P,-3		;DELETE QSB FROM STACK
	POP P,QSB		;RESTORE QSB AC
	RET			;TAKE +1 OR +2


; QMSCAN - RETURN ADDRESS OF NEXT ENTRY IN QUEUE
;  QSB/ ADDRESS OF QUEUE SCAN BLOCK
; RETURNS +1: NO ENTRIES REMAINING IN QUEUE
;	  +2: SUCCESS, T2/ ADDRESS OF NEXT ENTRY IN QUEUE

QMSCAN:	SKIPN T2,QSB.LE(QSB)	;FIRST CALL FOR THIS QUEUE SCAN?
	JRST [	SETZM QSB.LP(QSB) ;YES, CLEAR OLD-LAST ADDRESS
		HLRZ T2,@QSB.QB(QSB) ;GET ADDRESS OF HEAD PACKET
		JRST QMS1]
	MOVEM T2,QSB.LP(QSB)	;NOT FIRST TIME, SET OLD-LAST
	MOVE T2,(T2)		;GET ADDRESS OF NEXT PACKET
QMS1:	MOVEM T2,QSB.LE(QSB)	;SET NEW-LAST
	JUMPN T2,RSKP		;TAKE +2 IF I FOUND SOMETHING
	RET			;OTHERWISE +1

; QMDQS - DEQUEUE LAST PACKET RETURNED BY QMSCAN
;  QSB/ ADDRESS OF QUEUE SCAN BLOCK
; RETURNS +1: ALWAYS, T2/ ADDRESS OF DEQUEUED PACKET

QMDQS:	MOVE T2,QSB.LE(QSB)	;GET ADDRESS OF ENTRY TO BE DEQUEUED
	MOVE T3,QSB.LP(QSB)	;GET ADDRESS OF PREVIOUS ENTRY
	MOVEM T3,QSB.LE(QSB)	;FIX LE IN CASE QMSCAN IS CALLED AGAIN
	SKIPN T4,(T2)		;GET ADDR OF FOLLOWING ENTRY
	HRRM T3,@QSB.QB(QSB)	;IF DEQING TAIL, SET NEW TAIL IN QDB
	JUMPE T3,[HRLM T4,@QSB.QB(QSB) ;DEQING HEAD, SET NEW HEAD IN QDB
		RET]
	MOVEM T4,(T3)		;NOT HEAD, FIX LINKAGE IN PREDECESSOR
	RET
; REW - INITIATES A REWIND OPERATION ON AN MTA
; REWEA - LIKE REW, BUT ALSO SCHEDULES A CALLER-SPECIFIED ROUTINE
;	  WHEN THE REWIND IS COMPLETE
;  T1/ ADDRESS OF END-ACTION ROUTINE THAT WILL BE ENTERED WHEN
;      REWIND OPERATION IS COMPLETE (REWEA ONLY)
;  MTA/ ADDR OF STATUS BLOCK
; RETURNS +1: DEVICE OFFLINE OR TIMED OUT
;	  +2: REWIND OPERATION INITIATED
;		CONTROL IS GIVEN TO END-ACTION ROUTINE WHEN REWIND
;		COMPLETES. MTA AC WILL HAVE ADDR OF MTA STATUS BLK.
; NOTE: SINCE NOT ALL THE MAGTAPE HARDWARE IS CONSCIENTIOUS ABOUT
;	REPORTING STATUS CHANGES, THIS PROGRAM RELIES HEAVILY UPON
;	DEVICE OPERATIONS (IN PARTICULAR, REWIND) TO DETERMINE THE
;	LOADED/UNLOADED STATUS OF A TAPE DRIVE. THE BASIC LINE OF
;	REASONING IS: IF SJ%OFS IS SET THEN BELIEVE IT; IF IT IS
;	RESET, CHECK FOR ONLINE/OFFLINE BY ISSUING A REWIND MTOPR.

REW:	SETZ T1,
REWEA:	SAVEQ
	MOVEI Q3,1		;SET UP FOR SUCCESSFUL RETURN
	MOVE Q2,T1		;SAVE END-ACTION ADDRESS
	LOAD T1,MTAREA
	SKIPE T1		;END-ACTION ALREADY REQUESTED?
	CALL STOP		;YES, PROGRAM LOGIC FAILURE
	CALL MTAGJF		;GET JFN NOW TO LIMIT GTJFN CALLS
	CALL GMTADS		;GET MTA DEVICE STATUS
	JXN T1,SJ%OFS,[SETZRO MA%LOD,MTAFLG(MTA) ;OFFLINE, SAY SO
		CALLRET MTARJF] ;DUMP JFN AND GIVE ERROR RETURN
	JXN T1,SJ%REW,[CALL MTARJF ;REWINDING ALREADY, DUMP JFN
		STOR Q2,MTAREA	;SET END-ACTION ADDRESS
		RETSKP]		;TAKE SUCCESSFUL RETURN
	LOAD Q1,MA%OPN,MTAFLG(MTA) ;IS MTA JFN OPEN ALREADY?
	JUMPE Q1,[CALL MTAOPI	;NO, OPEN IT
		 SKIPA		;OFFLINE
		JRST .+1	;OPENED
		CALLRET MTARJF] ;DUMP JFN AND GIVE ERROR RETURN
	CALL MTARJF		;UN-NEST PRIOR MTAGJF
	CALL ELOGOF		;DON'T LOG ERRORS
	MOVEI T1,.MOREW
	MOVEI T2,1		;REPEAT COUNT
	CALL XMTOPR		;INITIATE REWIND
	 SETZ Q3,		;OFFLINE OR TIMED OUT, SET +1 RETURN
	CALL ELOGON		;RESTORE ERROR LOGGING
	STOR Q3,MA%LOD,MTAFLG(MTA) ;SET STATE (LOADED/UNLOADED)
	SKIPN Q1		;SKIP IF I DIDN'T OPEN MTA
	CALL MTACLS		;I OPENED IT, SO I'LL CLOSE IT
	JUMPE Q3,R		;TAKE ERROR RETURN IF INDICATED
	STOR Q2,MTAREA		;GOOD RETURN, SET END-ACTION ADDR
	RETSKP
; SCIDIS - DISABLE STATUS-CHANGE INTERRUPTS FROM MTA DEVICE
; SCIENA - ENABLE STATUS-CHANGE INTERRUPTS FROM MTA DEVICE
;	WHEN A TAPE DRIVE IS ENABLED FOR STATUS-CHANGE INTERRUPTS, THE
;	FOLLOWING EVENTS CAUSE A PSI INTERRUPT ON CHANNEL "TDSCCN":
;	TRANSITION TO ONLINE, TRANSITION TO OFFLINE, REWIND COMPLETE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

SCIDIS:	SKIPA T2,[0,,-1]
SCIENA:	MOVEI T2,TDSCCN
	MOVEI T1,2		;BUILD ARG BLOCK IN CT1 AND CT2
	STAKT
	CALL MTAGJF		;GET JFN ON MTA
	MOVEI T2,.MOOFL		;MTOPR FUNCTION CODE
	MOVEI T3,CT1		;GET ADDRESS OF ARG BLOCK
	MTOPR			;ENABLE OR DISABLE
	CALLRET MTARJF		;DUMP JFN AND EXIT


; SIXASC - CONVERT SIXBIT WORD TO ASCII STRING
;  T1/ SIXBIT WORD
;  T2/ BYTE POINTER TO ASCII DESTINATION STRING
; RETURNS +1: ALWAYS, 6 CHARACTERS PLACED IN DESTINATION STRING

SIXASC:	MOVE T4,T2		;MOVE POINTER OUT OF T2
	MOVEI T3,6
SIXAS1:	SETZ T2,		;CLEAR FOR SHIFT
	ROTC T1,6		;GET A SIXBIT CHARACTER
	ADDI T2,40		;CONVERT TO ASCII
	IDPB T2,T4		;STORE CHARACTER
	SOJG T3,SIXAS1
	RET
; SAVEQR - DRIVER FOR SAVEQ MACRO

SAVEQR::ADJSP P,3		;CREATE ROOM ON STACK FOR Q1-Q3
	DMOVEM Q1,-2(P)		;STACK Q1 & Q2
	MOVEM Q3,0(P)		;STACK Q3
	CALL (CX)		;BACK TO CALLER
	 TRNA			;NON-SKIP RETURN
	AOS -3(P)		;SKIP RETURN
	DMOVE Q1,-2(P)		;RESTORE Q1 & Q2
	MOVE Q3,0(P)		;RESTORE Q3
	ADJSP P,-3		;DELETE TEMP SPACE FROM STACK
	RET			;BACK TO CALLER'S CALLER +1 OR +2

; SAVETR - DRIVER FOR SAVET MACRO

SAVETR::ADJSP P,4		;CREATE ROOM ON STACK FOR T1-T4
	DMOVEM T1,-3(P)		;STACK T1 & T2
	DMOVEM T3,-1(P)		;STACK T3 & T4
	CALL (CX)		;BACK TO CALLER
	 TRNA			;NON-SKIP RETURN
	AOS -4(P)		;SKIP RETURN
	DMOVE T1,-3(P)		;RESTORE T1 & T2
	DMOVE T3,-1(P)		;	 T3 & T4
	ADJSP P,-4		;DELETE TEMP SPACE FROM STACK
	RET			;BACK TO CALLER'S CALLER +1 OR +2

; STAKTR - DRIVER FOR STAKT MACRO

STAKTR::ADJSP P,4		;CREATE ROOM ON STACK FOR T1-T4
	DMOVEM T1,-3(P)		;STACK T1 & T2
	DMOVEM T3,-1(P)		;STACK T3 & T4
	CALL (CX)		;BACK TO CALLER
	 TRNA			;NON-SKIP RETURN
	AOS -4(P)		;SKIP RETURN
	ADJSP P,-4		;DELETE TEMP SPACE FROM STACK
	RET			;BACK TO CALLER'S CALLER +1 OR +2
; SMPAV - SET AVAILABLE STATUS OF TAPE DRIVE
;  T1/ 0 TO SET DRIVE UNAVAILABLE, 1 TO SET DRIVE AVAILABLE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

SMPAV:	STAKT
	SKIPE T1,MTAPNT(MTA)	;Do we have a DDB?
	JRST [CALL DSFGET	;Yes, go get DDB
	      $STOP <Invalid DDB pointer in magtape status block>
	      JRST SMPA.1]	;Continue with common code
	CALL GMTADD		;Get designator
	MOVEM T1,DSFE+DSFSPC	;Save it as specification
	MOVEI T1,.DVMTA		;Get type
	MOVEM T1,DSFE+DSFTYP	;Save it
	SETZM DSFE+DSFFLG	;Default flags
	CALL DSFCRE		;Try to create
	  JFCL			;Don't care if already exists

;  Now have DDB in DSFE

SMPA.1:	MOVE T2,CT1		;GET AVAILABLE OR UNAVAILABLE FLAG
	STOR T2,DSF%AV,DSFE+DSFFLG ;STORE FLAG
	CALL DSFUDE		;Update entry
	 $STOP <Update of previously known DDB with DSFUDE failed>
	RET			;And done


; STMTA - CONVERT AN ASCIZ STRING TO AN MTA STATUS BLOCK ADDRESS
;  T1/ ADDRESS OF ASCIZ STRING FOR MTA (IN FORM SUITABLE FOR STDEV JSYS)
; RETURNS +1: STRING DOES NOT SPECIFY MTA DEVICE
;	  +2: MTA/ ADDR OF MTA STATUS BLOCK

STMTA:	HRLI T1,-1		;GET STRING POINTER TO ASCIZ DEVNAME
	STDEV			;TRANSLATE STRING TO DEV DESIGNATOR
	 RET			;NOT A DEVICE
	MOVE T1,T2		;GET DESIGNATOR
	CALLRET DDMTA		;CONVERT TO MTA STATUS BLOCK ADDR IN MTA
; STOPNW - Same as STOP but a message is supplied.
; Invoked by:
;	$STOP <message>

STPHLP:	BLOCK 1			;Local storage location
STOPNW::			;New stop with message
	SETOM STPHLP		;Say we came in here
	SKIPA			;Don't execute first instruction in STOP

; STOP - A FATAL ERROR WAS DETECTED; PROGRAM MUST HALT
; INVOKED BY:
;	CALL STOP

STOP::	SETZM STPHLP		;Say we came in here
	MOVEM 17,CRSHAC+17	;SAVE AC'S FROM CRASH
	MOVEI 17,CRSHAC
	BLT 17,CRSHAC+16
	MOVEI T1,.FHSLF
	SETZ T2,
	GETER			;GET MOST RECENT ERROR
	 ERJMP .+1
	HRRZM T2,LSTERR		;STORE IT FOR ANALYSIS
	DIR			;DISABLE ALL INTERRUPTS
	TMSG <

?MOUNTR crashing, PC = >
	MOVEI T1,.PRIOU
	HRRZ T2,CRSHAC+P	;GET TOP-OF-STACK ADDRESS
	HRRZ T2,(T2)		;GET ADDRESS OF CALL + 1
	SOS T2			;GET ADDRESS OF CALL
	MOVE T3,[NO%ZRO+NO%LFL+FLD(6,NO%COL)+10]
	NOUT			;TYPE PC
	 JFCL
	TMSG <
>				;Add a CRLF after number of crash PC

	SKIPE STPHLP		;Do we want a message?
	JRST [AOS T2		;Yes, point to it
	      HRRO T1,(T2)	;Setup pointer to error message
	      PSOUT		;Print it
	       ERJMP STOP0	;Don't believe/care about errors
	      TMSG <
>				;Add a CRLF after message
	      JRST STOP0]	;Continue on

STOP0:	SKIPE TSTF		;TESTING?
	JRST [	TMSG <Test flag set, not saving MOUNTR core image>
				;YES, DON'T SAVE CORE IMAGE
		JRST STOP1]

; SAVE CORE IMAGE IN CRASH FILE

	MOVX T1,GJ%SHT+GJ%FOU+GJ%ACC
	HRROI T2,CFSPEC		;GET POINTER TO FILESPEC
	GTJFN			;GET JFN ON CRASH FILE
	 JRST STOP2
	MOVE Q2,T1		;COPY JFN TO A SAFE PLACE
	TMSG <Saving MOUNTR core image on file >
	MOVEI T1,.PRIOU
	MOVE T2,Q2		;JFN
	SETZ T3,
	JFNS			;DISPLAY FILESPEC
	 ERJMP STOP2
	MOVSI T1,.FHSLF
	HRR T1,Q2		;FORK HANDLE,,JFN
	MOVE T2,[-1000,,SS%CPY]	;ALL PAGES OF PROCESS, COPY-ON-WRITE
	SETZ T3,
	SSAVE			;SAVE CORE IMAGE
	 ERJMP STOP2
	JRST STOP1		;SKIP AROUND FAILURE-PROCESSOR

; ERROR SAVING CORE IMAGE, REPORT IT

STOP2:	TMSG <
?Cannot save MOUNTR core image: >
	MOVEI T1,.PRIOU
	HRLOI T2,.FHSLF		;FORK HANDLE ,, -1 (MOST RECENT ERROR)
	SETZ T3,		;NO LIMIT
	ERSTR			;SHOW WHY SAVE FAILED
	 JFCL
	 JFCL
STOP1:	MOVSI 17,CRSHAC		;GET BLT SOURCE,,DESTINATION
	BLT 17,17		;RESTORE AC'S TO CRASH STATE
	HALTF

; STOPP - STOP BECAUSE OF SOME KIND OF STACK PROBLEM
; INVOKED BY:
;	JSP CX,STOPP

STOPP:	MOVEM P,BADP		;SAVE BAD P
	MOVE P,[IOWD 4,PDL1]	;GET NEW P SO PDL IS PRESERVED
	CALL STOP		;NOW CRASH

; PANIC INTERRUPT HANDLERS - PROGRAM IS CRASHING
; DATA ERROR IS NON FATAL AND IS REPORTED

PANPOV:	JSP CX,STOPP		;PDL OVERFLOW
PANDAE:	EXCH T1,@LEVTAB+PRIPAN-1 ;GET RETURN PC
	MOVEM T1,DAEPC		;SAVE IT
	EXCH T1,@LEVTAB+PRIPAN-1 ;RESTORE T1 AND PC
	SOS DAEPC		;PC OF INTERRUPT
	CALL EIHR		;SCHEDULE
	EXP DAEIH		;ROUTINE TO SCHEDULE	
PANQTA:	CALL STOP		;QUOTA EXCEEDED
PANILI:	CALL STOP		;ILLEGAL INSTRUCTION
PANIRD:	CALL STOP		;ILLEGAL READ
PANIWR:	CALL STOP		;ILLEGAL WRITE
PANMSE:	CALL STOP		;MACHINE SIZE EXCEEDED

; DAEIH - INFORM OPERATOR OF A DATA ERROR.
; RETURNS +1 ALWAYS

DAEIH:	MOVE T1,DAEPC		;GET PC OF ERROR
	TMCT <%IData Error encountered. PC= %1O Last Error: %J>
	MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
	CALLRET BTWTO		;TELL OPERATOR
; SYTSET - BUILD AND LOG SYSERR ENTRY FOR TAPE DRIVE STATUS CHANGE
;  T1/ FUNCTION CODE (CS%ADV = SET AVAILABLE, CS%DDV = SET UNAVAILABLE)
;  T2/ ADDRESS OF ASCIZ REASON, OR 0 IF NO REASON GIVEN
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

SYTSET:	SAVEQ
	STKVAR <<SYTA,.MOISN+1>>
	SETZM SYRMSG		;ZERO OUT SYSERR MESSAGE AREA
	MOVE T4,[SYRMSG,,SYRMSG+1]
	BLT T4,SYRMSG+SYRMSZ-1

; TRANSFER OPERATION CODE AND REASON TO MESSAGE

	STOR T1,CS%OPR,SYRMSG+CS%OPW ;STORE OPERATION CODE INTO MESSAGE
	MOVEI Q1,SYRHSZ+CS%SIZ	;ASSUME NO REASON GIVEN
	SKIPN T1,T2		;REASON GIVEN?
	JRST SYTSE1		;NO
	MOVS Q2,T1		;YES, COPY ADDRESS OF STRING FOR BLT
	CALL ASCIZL		;GET # OF CHARACTERS
	IDIVI T2,5		;GET # OF WORDS MINUS 1
	CAIL T2,SYRMSZ		;TOO LONG?
	MOVEI T2,SYRMSZ-1	;YES, TRUNCATE
	MOVEI Q1,SYRHSZ+CS%SIZ+1(T2) ;SAVE SIZE OF ENTIRE MESSAGE
	HRRI Q2,SYRMSG+CS%SIZ	;GET BLT DESTINATION
	BLT Q2,SYRMSG+CS%SIZ(T2) ;TRANSFER STRING TO MESSAGE
	MOVEI T1,CS%SIZ
	STOR T1,CS%RSN,SYRMSG+CS%RSW ;STORE POINTER TO REASON
SYTSE1:	MOVEI T1,SEC%CS		;GET CONFIGURATION STATUS CHANGE CODE
	DPB T1,[POINT 9,SYRHDR,8] ;STORE INTO SYSERR ENTRY HEADER

; BUILD AND STORE SIXBIT DEVICE NAME (E.G. MTA0)
; (CAN'T STORE CHANNEL TYPE BECAUSE I DON'T KNOW IT)

	CALL GMTADD		;GET MTA DEVICE DESIGNATOR
	MOVE T2,T1		;TO T2 FOR DEVST
	HRROI T1,SYTA		;GET ADDR OF STRING AREA
	DEVST			;GET ASCIZ DEVICE NAME (E.G. MTA0)
	 SETZM SYTA		;SHOULD NEVER FAIL
	MOVEI T1,SYTA		;GET ADDR OF STRING
	CALL ASCIZL		;GET LENGTH OF STRING FOR CVTA6
	MOVSI T1,(POINT 7)
	HRRI T1,SYTA		;GET POINTER TO STRING
	CALL CVTA6		;GET SIXBIT DEVICE NAME IN T1
	 SETZ T1,		;SHOULDN'T FAIL
	MOVEM T1,SYRMSG+CS%DNM	;STORE SIXBIT DEVICE NAME

; GET DEVICE ADDRESS AND SERIAL#

	JE MTASTE,,R		;DON'T BOTHER IF DEVICE NOT ASSIGNED
	MOVEI T1,.MOISN
	MOVEM T1,.MOICT+SYTA	;SET ARG BLOCK LENGTH IN ARG BLOCK
	CALL MTAGJF		;GET MTA JFN IN T1
	MOVEI T2,.MOINF		;GET MTOPR FUNCTION CODE
	MOVEI T3,SYTA		;GET ADDRESS OF ARG BLOCK
	MTOPR			;GET MTA INFO FROM MONITOR
	CALL MTARJF		;DUMP JFN
	MOVE T1,.MOISN+SYTA	;GET UNIT ADDRESS AND SERIAL#
	MOVEM T1,SYRMSG+CS%ADS	;STORE IN SYSERR MESSAGE
	MOVE T1,.MOITP+SYTA	;GET DRIVE TYPE CODE
	STOR T1,CS%UTP,SYRMSG+CS%HTP ;STUFF IT

; LOG THE MESSAGE

	MOVEI T1,SYRHDR		;GET ADDRESS OF SYSERR MESSAGE
	MOVE T2,Q1		;GET # OF WORDS IN MESSAGE
	SKIPN TSTF		;DON'T LOG SYSERRS IF TESTING
	SYERR			;LOG IT
	 ERJMP R		;IGNORE ERRORS
	RET
; UNLOAD - UNLOAD A VOLUME FROM AN MTA DEVICE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

UNLOAD:	SAVEQ
	CALL MTAGJF		;GET JFN NOW TO LIMIT GTJFN CALLS
	CALL GMTADS		;GET DEVICE STATUS IN T1
	JXN T1,SJ%OFS,[SETZRO MA%LOD,MTAFLG(MTA) ;OFFLINE, SAY SO
		CALLRET MTARJF] ;DUMP JFN AND RETURN
	JXN T1,SJ%REW,[SETONE MA%ULP,MTAFLG(MTA) ;SET UNLOAD-PENDING
		CALLRET MTARJF]	;DUMP JFN AND RETURN
	SETZRO MA%LOD,MTAFLG(MTA) ;SET STATUS TO UNLOADED
	LOAD Q1,MA%OPN,MTAFLG(MTA) ;IS MTA JFN OPEN ALREADY?
	JUMPE Q1,[CALL MTAOPI	;NO, OPEN IT
		 SKIPA		;OFFLINE
		JRST .+1	;OPENED
		CALLRET MTARJF] ;DUMP JFN AND GIVE ERROR RETURN
	CALL MTARJF		;UN-NEST PRIOR MTAGJF
	CALL ELOGOF		;DON'T LOG ERRORS
	MOVEI T1,.MOREW		;[333]Get the rewind function 
	MOVEI T2,1		;[333]Repeat count
	CALL XMTOPR		;[333]Rewind before we unload (TM03)
	 JRST .+1		;[333]Don't care if it fails
	MOVEI T1,.MORUL
	MOVEI T2,1		;REPEAT COUNT
	CALL XMTOPR		;INITIATE REWIND-AND-UNLOAD
	 CALL XMTREP		;REPORT UNLOAD ERROR
	CALL ELOGON		;RESUME LOGGING ERRORS
	JUMPN Q1,R		;EXIT IF I DIDN'T OPEN MTA
	CALLRET MTACLS		;I OPENED IT, SO I'LL CLOSE IT
; VQADD - APPEND A NEW VOLID TO THE END OF THE RSB VOLID LIST
;  T1/ SIXBIT VOLID
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: NO SLOTS LEFT IN VOLID POOL, REQUEST ABORTED
;	  +2: SUCCESS

VQADD:	STAKT
	MOVEI T1,FVSQDB		;POINT TO FREE POOL QDB
	CALL QMDQH		;DEQUEUE HEAD OF FREE CHAIN
	 JRST [	ABTRET (MREQ31)] ;NO FREE SLOTS, ABORT REQUEST
	MOVE T1,CT1		;T2/ SLOT ADDR, GET VOLID
	MOVEM T1,1(T2)		;STORE VOLID IN SLOT
	MOVEI T1,RSBVLS(RSB)	;GET ADDR OF RSB VOLID LIST QDB
	CALL QMQT		;ADD NEW VOLID TO END OF RSB VOLID QUEUE
	RETSKP


; VQCNT - RETURN THE LENGTH OF THE RSB VOLID LIST
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ LENGTH OF VOLID LIST

VQCNT:	SETZ T1,		;CLEAR COUNTER
	HLRZ T2,RSBVLS(RSB)	;GET HEAD OF QUEUE
VQCNT1:	JUMPE T2,R		;END OF QUEUE, RETURN
	MOVE T2,(T2)		;NOT THE END, GET ADDR OF NEXT ENTRY
	AOJA T1,VQCNT1		;COUNT THIS ENTRY AND LOOP


; VQDEL - RETURN RSB VOLID QUEUE TO FREE VOLID SLOT POOL
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS

VQDEL:	SKIPN T1,RSBVLS(RSB)	;IS QUEUE EMPTY?
	RET			;YES, NOTHING TO DO
	SETZM RSBVLS(RSB)	;CLEAR QDB IN RSB
	HRRZ T2,FVSQDB		;GET CURRENT FREE POOL TAIL
	JUMPE T2,[MOVEM T1,FVSQDB ;NO FREE POOL, SO CREATE IT
		RET]
	HLRZM T1,(T2)		;POINT CURRENT TAIL AT RSB LIST HEAD
	HRRM T1,FVSQDB		;SET TAIL OF FREE POOL TO RSB TAIL
	RET
; VQGCV - GET CURRENT VOLID FOR TAPE MOUNT REQUEST
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ 0 IF SCRATCH TAPE, ELSE SIXBIT VOLID

VQGCV:	LOAD T1,RSBCV		;GET CURRENT VOLUME #
	CALL VQGET		;GET VOLID IN T1
	 SETZ T1,		;BAD INDEX, MUST BE A SCRATCH
	RET


; VQGET - RETURN A VOLID FROM RSB VOLID LIST
; VQSET - STORE A VOLID INTO RSB VOLID LIST
;  T1/ ORDINAL NUMBER OF VOLID TO BE RETURNED
;  T2/ SIXBIT VOLID TO BE STORED (VQSET ONLY)
;  RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: VOLID NUMBER OUT OF RANGE
;	  +2: SUCCESS, T1/ SIXBIT VOLID

VQGET:	SKIPA T3,[MOVE T1,1(T2)]
VQSET:	MOVE T3,[MOVEM T1,1(T2)]
	JUMPLE T1,R		;CHECK FOR FUNNY INPUT
	QSCANI <RSBVLS(RSB)>	;SET UP TO SCAN RSB VOLID LIST
	STAKT
VQGET1:	CALL QMSCAN		;GET NEXT VOLID IN LIST
	 RET			;NONE LEFT, FAILED
	SOSLE CT1		;IS THIS THE ONE THE CALLER WANTED?
	JRST VQGET1		;NO, CONTINUE SCAN
	MOVE T1,CT2		;GET VOLID IN CASE OF VQSET
	XCT CT3			;LOAD OR STORE VOLID AS REQUESTED
	RETSKP


; VQSPIN - INITIALIZE FREE POOL OF VOLID SLOTS
; RETURNS +1: ALWAYS

VQSPIN:	SAVEQ
	SETZM FVSQDB		;SET QUEUE EMPTY INITIALLY
	MOVEI Q1,VOLP0		;GET ADDRESS OF 1ST SLOT IN POOL
	MOVEI Q2,VOLPN		;GET # OF SLOTS IN POOL
VQSPI1:	MOVEI T1,FVSQDB		;GET QDB ADDRESS
	MOVE T2,Q1		;GET ADDRESS OF NEXT SLOT
	CALL QMQT		;ADD SLOT TO TAIL OF FREE LIST
	ADDI Q1,2		;POINT TO NEXT SLOT
	SOJG Q2,VQSPI1		;LOOP
	RET
; WRTP - WRITE-PROTECT MOUNTR'S CODE TO CATCH STRAY STORES
; RETURNS +1: ALWAYS
Comment /
WRTP:	MOVEI T1,PURE		;COMPUTE PAGE # OF FIRST
	LSH T1,-11		; PAGE OF NON-MODIFYABLE MEMORY
	HRLI T1,.FHSLF		;GET FORK HANDLE ,, PAGE#
	MOVX T2,PA%RD+PA%EX	;REQUEST READ AND EXECUTE ACCESS
	MOVEI T3,.RLEND		;COMPUTE PAGE # OF LAST READ-ONLY
	LSH T3,-11		; PAGE PLUS 1
WRTP1:	CAIG T3,(T1)		;ALL DONE?
	RET			;YES
	SPACS			;SET PAGE TO READ & EXECUTE
	AOJA T1,WRTP1		;INCREMENT PAGE # AND LOOP
/

;WTOCHK CHECKS TO SEE IF WTOR FUNCTION IS DISABLED IN BATCH JOB
;RETURNS +1 IF DISABLED
;RETURNS +2 IF NOT DISABLED
;ABTRET WITH ERROR MESSAGE IF DISABLED

WTOCHK:	SAVET			;SAVE T1-T4
	LOAD T1,RSBJNO		;GET JOBNUMBER
	SETO T2,		;JUST ONE ITEM
	HRRI T2,T3		;INTO T3
	MOVEI T3,.JIBCH		;GET BATCH FLAGS
	GETJI			;
	 SETZ T3,		;UNLIKELY
	LOAD T3,OB%WTO,T3	;CHECK FOR WTO ENABLED
	CAIE T3,.OBALL		;ARE MESSAGES ALLOWED?
	JRST [ ABTRET (MREQ15)]	;NO, ABORT WITH MESSAGE
	RETSKP			;YES, RETURN +2

; XMTOPR - EXECUTE MAGTAPE MTOPR FUNCTION A GIVEN NUMBER OF TIMES
;  T1/ MTOPR FUNCTION CODE
;  T2/ NUMBER OF TIMES TO EXECUTE
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DEVICE FAILURE, T1/ 0=ERROR 1=TIMEOUT
;	  +2: SUCCESS

XMTOPR:	SAVEQ
	DMOVE Q1,T1		;SAVE FUNCTION CODE AND REPEAT COUNT
XMTOP1:	LOAD T1,MTAJFN		;GET JFN
	MOVE T2,Q1		;GET MTOPR FUNCTION CODE
	IOXCT MTOPR,XMTOP2,XMTOP3 ;START POSITIONING OPERATION
	MOVEI T2,.MONOP
	IOXCT MTOPR,XMTOP2,XMTOP3 ;WAIT TILL OPERATION COMPLETES
	CALL CLRTAP		;CLEAR ERRORS
	 JRST XMTOP3		;TIMED OUT
	TXNE T2,MT%DVE+MT%DAE	;ANY SERIOUS PROBLEMS?
	JRST XMTOP2		;YES
	SOJG Q2,XMTOP1		;LOOP TILL DONE
	RETSKP			;SUCCESS

XMTOP2:	TDZA T1,T1		;ERROR, PUT 0 IN T1
XMTOP3:	MOVEI T1,1		;TIMEOUT, PUT 1 IN T1
	RET			;TAKE ERROR RETURN
; XMTREP - REPORT MTA DEVICE FAILURE TO OPERATOR
;  T1/ 0 TO REPORT DEVICE ERROR, 1 TO REPORT DEVICE TIMEOUT
;  MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS

XMTREP:	JUMPN T1,[CALLRET WOTIMO] ;TIMEOUT, RETURN THROUGH TIMEOUT CODE
	TMCT <%I%M positioning operation failed. Last Error: %J>
	MOVEI T3,[ASCIZ/Tape Positioning Error/]
	CALLRET BTWTO		;TELL OPERATOR AND RETURN


; XMUTIL - EXECUTE MUTIL FOR CALLER
;  T1-T4/ ARGUMENT BLOCK WORDS 0-3
; RETURNS +1: ERROR ON MUTIL CALL, CODE IN T1
;	  +2: SUCCESS, WITH COPY OF ARG BLOCK IN T1-T4

XMUTIL:	SAVET			;SAVE CALLER'S AC'S ON STACK
	MOVEI T1,4		;ARGUMENT BLOCK LENGTH
	MOVEI T2,CT1		;ADDRESS OF ARGUMENT BLOCK
	MUTIL			;DO MUTIL (ARG BLOCK IS IN STACK)
	 JRST [	MOVEM T1,CT1	;ERROR, SUPPLY ERROR TO CALLER
		RET]		;TAKE ERROR RETURN
	RETSKP			;GOOD RETURN, T1-T4 COME OFF STACK
SUBTTL STRSTT -- Returns the structure status

;  Accepts: T1 / Address of name (alias) of structure

;  Returns: +1 if failed to get status for structure
;	    +2 with status
;	    T1 / Status flags
;	    T2 / Number of units in structure
;	    T3 / Mount count for structure
;	    T4 / Open file count for structure

STRSTT:	HRRO T1,T1		;Set pointer for alias
	MOVEM T1,MSTRST+.MSGSN	;Save it
	MOVE T1,[.MSGFC+1,,.MSGSS] ;Get length,,function
	MOVEI T2,MSTRST		;Get the address of argument block
	MSTR			;Try for the status
	  ERJMP R		;Just return
	DMOVE T1,MSTRST+.MSGST	;Get the flags and the number of units
	DMOVE T3,MSTRST+.MSGMC	;Get the mount count and the open file count
	RETSKP			;And return

LIT:				;ADDRESS OF START OF LITERAL POOL
	END <ENTVSZ,,ENTVEC>