Google
 

Trailing-Edge - PDP-10 Archives - BB-FT68M-SM - exec/execmt.mac
There are 43 other files named execmt.mac in the archive. Click here to see a list.
; UPD ID= 122, SNARK:<5.EXEC>EXECMT.MAC.7,  28-Dec-81 11:15:22 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 63, SNARK:<5.EXEC>EXECMT.MAC.6,   9-Sep-81 09:44:37 by CHALL
;TCO 5.1492 $BACKS- PUT ONEWRD FLAGS IN BACKSPACE OPTION TABLE
; UPD ID= 41, SNARK:<5.EXEC>EXECMT.MAC.5,  17-Aug-81 09:39:26 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
;<HELLIWELL.EXEC.5>EXECMT.MAC.1, 14-May-81 08:18:45, EDIT BY HELLIWELL
;MAKE "UNLOAD DTAn:" and "REWIND DTAn:" not under NOSHIP
;REMOVE "MOUNT DECTAPE ..."
;MAKE "DISMOUNT DTAn:" and "DISMOUNT TAPE DTAn:" not under NOSHIP
; UPD ID= 2066, SNARK:<5.EXEC>EXECMT.MAC.3,  22-May-81 11:51:29 by GROUT
;tco 5.1343 - Make IPCF code flush buffers only when necessary
; UPD ID= 1954, SNARK:<5.EXEC>EXECMT.MAC.2,   6-May-81 15:05:32 by MURPHY
; UPD ID= 1192, SNARK:<5.EXEC>EXECMT.MAC.10,  24-Oct-80 15:43:06 by OSMAN
;tco 5.1179 - Make "%Close jfn" question work again.
; UPD ID= 981, SNARK:<5.EXEC>EXECMT.MAC.9,   3-Sep-80 11:54:17 by HESS
; UPD ID= 980, SNARK:<5.EXEC>EXECMT.MAC.8,   3-Sep-80 11:42:01 by HESS
; Remove old DMOUNT code
; UPD ID= 815, SNARK:<5.EXEC>EXECMT.MAC.7,  30-Jul-80 11:29:13 by OSMAN
;tco 5.1116 - Get confirmation on "SKIP MT0: 5 FILES"
;<5.EXEC>EXECMT.MAC.6, 30-May-80 17:03:44, EDIT BY MURPHY
; UPD ID= 536, SNARK:<5.EXEC>EXECMT.MAC.4,  20-May-80 15:36:28 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
;<5.EXEC>EXECMT.MAC.3,  8-May-80 14:02:20, EDIT BY OSMAN
;Remove R.L.5 and R.GE.5 macro calls and contents
;<4.1.EXEC>EXECMT.MAC.7, 17-Mar-80 14:08:28, EDIT BY OSMAN
;Get rid of ONEWRD checks
;<4.1.EXEC>EXECMT.MAC.6, 17-Mar-80 11:26:10, EDIT BY OSMAN
;Put R.L.5 conditional around SMOUNT, TMOUNT, SDISMOUNT
;Add warnings
;<4.1.EXEC>EXECMT.MAC.4, 12-Mar-80 10:59:41, EDIT BY OSMAN
;Make 4.1 version with SMOUNT and bug fixes
;<4.EXEC>EXECMT.MAC.171,  3-Jan-80 16:07:15, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;REMOVE CALL TO CCHKPT AND CBACK
;<4.EXEC>EXECMT.MAC.169,  4-Sep-79 14:41:56, Edit by HESS
; Ring chimes if called from IITPSI (XTND only)
;<4.EXEC>EXECMT.MAC.167, 10-Aug-79 14:35:10, EDIT BY OSMAN
;tco 4.2383 - say "Structure SNARK: mounted" for "MOUNT STR FOO:" when FOO:
;is a logical name for SNARK:
;<4.EXEC>EXECMT.MAC.165,  3-Aug-79 17:52:32, EDIT BY R.ACE
;TCO 4.2374 - FIX UNLOAD COMMAND TO GIVE % RATHER THAN ? FOR MT DEVICES
;<4.EXEC>EXECMT.MAC.164,  3-Aug-79 10:02:13, EDIT BY OSMAN
;tco 4.2372 - Print bette error on "SKIP 1" at LEOT
;<4.EXEC>EXECMT.MAC.163, 31-Jul-79 14:36:34, EDIT BY OSMAN
;tco 4.2359 - Put colon on PROTECTION switch
;<4.EXEC>EXECMT.MAC.162, 30-Jul-79 08:28:43, EDIT BY OSMAN
;tco 4.2358 - say "Mount request yyy failed..."
;<4.EXEC>EXECMT.MAC.161, 15-Jul-79 08:23:59, EDIT BY R.ACE
;TCO 4.2328 - ADD ERJMP AFTER .MORLI MTOPR IN LBLCHK
;<4.EXEC>EXECMT.MAC.160, 20-Jun-79 16:20:54, EDIT BY OSMAN
;tco 4.2300 - Allow long names on TMOUNT
;<4.EXEC>EXECMT.MAC.159,  8-Jun-79 19:05:32, EDIT BY HELLIWELL
;ADD DECTAPE HANDLING IN "MOUNT"
;<4.EXEC>EXECMT.MAC.158,  6-Jun-79 12:54:57, EDIT BY HELLIWELL
;<4.EXEC>EXECMT.MAC.157,  6-Jun-79 11:42:00, EDIT BY HELLIWELL
;REMOVE SOME OLD NOSHIP CODE
;<4.EXEC>EXECMT.MAC.156,  6-Jun-79 11:12:24, EDIT BY HELLIWELL
;ADD "DMOUNT" COMMAND UNDER NOSHIP
;<4.EXEC>EXECMT.MAC.155, 29-May-79 15:45:52, Edit by OSMAN
;MAKE LBLSKP BE GLOBAL AND TAKE TAPE DESIGNATOR IN A
;<4.EXEC>EXECMT.MAC.152, 29-May-79 14:48:57, Edit by OSMAN
;MAKE LBLSKP RETURN LABEL TYPE IN A
;<4.EXEC>EXECMT.MAC.151, 24-May-79 14:29:51, EDIT BY OSMAN
;tco 4.2258 - Fix TMOUNT to assign logical name correctly
;<4.EXEC>EXECMT.MAC.149, 20-Apr-79 16:45:14, EDIT BY OSMAN
;give better message when assign of MTA device fails
;<4.EXEC>EXECMT.MAC.148, 20-Apr-79 10:40:11, EDIT BY OSMAN
;tco 4.2237 - handle ASND error
;<4.EXEC>NEXECMT.MAC.2, 18-Apr-79 13:55:53, EDIT BY OSMAN
;USE LINKED LIST FOR REMEMBERING PENDING MOUNTS
;<4.EXEC>EXECMT.MAC.142, 10-Apr-79 10:19:56, EDIT BY OSMAN
;FIX LBLSKP (SET UP C TO POINT AT ARG BLOCK)
;<4.EXEC>EXECMT.MAC.137, 29-Mar-79 16:56:14, EDIT BY OSMAN
;fix help message after /VOLIDS:FOO
;<4.EXEC>EXECMT.MAC.136, 29-Mar-79 16:08:19, EDIT BY OSMAN
;TCO 4.2229 - ALLOW "SKIP MTA1: LEOT"
;<4.EXEC>EXECMT.MAC.135, 29-Mar-79 10:40:10, EDIT BY OSMAN
;ALLOW LONG WORD AFTER MOUNT TAPE (TRUNCATE TO SIX CHARACTERS FOR SET NAME)
;<4.EXEC>EXECMT.MAC.134, 28-Mar-79 15:02:23, EDIT BY OSMAN
;PUT IN MPENDF TO DETECT ^C OUT OF MOUNT
;<4.EXEC>EXECMT.MAC.133, 16-Mar-79 05:02:40, EDIT BY R.ACE
;ADD "Tape dismounted" TO CONFIRMATION FROM DISMOUNT TAPE COMMAND
;<4.EXEC>EXECMT.MAC.132, 15-Mar-79 14:14:55, EDIT BY OSMAN
;BREAK DOWN OPNMTA INTO OPNMAG, SINCE EXEC3 NEEDS IT TOO!
;<4.EXEC>EXECMT.MAC.131, 15-Mar-79 13:32:05, EDIT BY R.ACE
;FIX BUG IN OPNMTA ROUTINE WHEN USER WANTS TO CLOSE AN OPEN JFN
;<4.EXEC>EXECMT.MAC.130, 14-Mar-79 08:11:39, EDIT BY R.ACE
;FIX BUG IN PRINTING NAME OF ERRONEOUS MOUNT REQUEST
;<4.EXEC>EXECMT.MAC.129, 13-Mar-79 13:53:05, EDIT BY OSMAN
;PRINT NAME OF ERRONEOUS MOUNT REQUEST
;<4.EXEC>EXECMT.MAC.128, 12-Mar-79 18:00:09, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECMT.MAC.127, 12-Mar-79 10:02:10, EDIT BY OSMAN
;PRINT CR IF DOING MOUNT RESPONSE AFTER PROMPT
;<4.EXEC>EXECMT.MAC.126,  9-Mar-79 14:45:42, EDIT BY OSMAN
;PUT MOUNT ARG STACK IN FREE SPACE INSTEAD OF ON STACK
;<4.EXEC>EXECMT.MAC.125, 22-Feb-79 10:48:21, EDIT BY OSMAN
;STACK UP DDSK2 BEFORE OTHER ITEMS AT DSTR1
;<4.EXEC>EXECMT.MAC.123, 20-Feb-79 16:35:23, EDIT BY OSMAN
;ALLOW REAL DEVICE IN LIEU OF "TAPE" OR "STRUCTURE" IN DISMOUNT
;<4.EXEC>EXECMT.MAC.121, 15-Feb-79 09:58:12, EDIT BY OSMAN
;<4.EXEC>EXECMT.MAC.120, 14-Feb-79 16:57:18, EDIT BY OSMAN
;MOVE MNTSTG FROM DSTR TO .DISMO
;<4.EXEC>EXECMT.MAC.119, 14-Feb-79 16:25:00, EDIT BY OSMAN
;MAKE ILLEGAL FOR LABELLED TAPES: BACK RECORDS, SKIP RECORDS
;<4.EXEC>EXECMT.MAC.117, 14-Feb-79 15:06:07, EDIT BY OSMAN
;GET RID OF CANSTR
;<4.EXEC>EXECMT.MAC.115, 12-Feb-79 09:42:53, EDIT BY OSMAN
;MAKE "UNAVAILABLE, UNDER CONTROL OF ALLOCATOR..." LOWERCASE
;<4.EXEC>EXECMT.MAC.114,  9-Feb-79 15:51:22, EDIT BY OSMAN
;CHANGE A BUNCH OF TABS AFTER OPCODES TO SPACES
;<4.UTILITIES>1TV.INI.1,  9-Feb-79 15:48:45, EDIT BY OSMAN
;PUT IN /ENTIRE-VOLUME-SET AND /CURRENT-VOLUME-ONLY SWITCHES TO REWIND
;<4.EXEC>EXECMT.MAC.112,  9-Feb-79 10:29:00, EDIT BY OSMAN
;PUT ASSIGN AND DEASSIGN IN THIS MODULE
;<4.EXEC>EXECMT.MAC.111,  9-Feb-79 09:49:36, EDIT BY OSMAN
;move tape-moving commands into here from EXEC1
;<4.EXEC>EXECMT.MAC.110,  5-Feb-79 10:08:02, EDIT BY OSMAN
;change error from "DISK" to "STRUCTURE"
;<4.EXEC>EXECMT.MAC.109,  5-Feb-79 08:47:18, EDIT BY R.ACE
;ADD SOME CODE THAT WAS LEFT OUT OF SMOUNT
;<4.EXEC>EXECMT.MAC.108,  1-Feb-79 07:32:25, EDIT BY R.ACE
;FIX ERROR HANDLING IN DISMOUNT STRUCTURE AND SDISMOUNT
;<4.EXEC>EXECMT.MAC.107, 31-Jan-79 14:35:56, EDIT BY OSMAN
;CHANGE ERCAL CJERRE TO CALL CJERRE (SINCE IT DOESN'T IMMEDIATELY FOLLOW
;A JSYS
;REMOVE OLD SMOUNT/TMOUNT CODE
;<4.EXEC>EXECMT.MAC.106, 30-Jan-79 14:50:27, EDIT BY R.ACE
;FIX SCRATCH-TAPE BUG IN TMOUNT INTERFACE TO MOUNTR
;<4.EXEC>EXECMT.MAC.105, 30-Jan-79 14:47:20, EDIT BY OSMAN
;DON'T BITCH IF USER CANCELS MOUNT REQUEST (MREQX1)
;<4.EXEC>EXECMT.MAC.104, 23-Jan-79 14:32:28, EDIT BY OSMAN
;only ALLOW ONE ITEM TO BE MOUNTED PER COMMAND
;<4.EXEC>EXECMT.MAC.103, 22-Jan-79 11:28:26, EDIT BY OSMAN
;MAKE SO ^C OUT OF MOUNT ACTS LIKE /NOWAIT
;<4.EXEC>EXECMT.MAC.90, 12-Dec-78 11:44:46, EDIT BY OSMAN
;PUT IN DISMOUNT STRUCTURE
;<4.EXEC>EXECMT.MAC.89,  6-Dec-78 14:15:26, EDIT BY OSMAN
;FIX SMOUNT
;<4.EXEC>EXECMT.MAC.88,  6-Dec-78 09:40:07, EDIT BY R.ACE
;MISCELLANEOUS FIXES TO MOUNT TAPE, DISMOUNT TAPE, AND TMOUNT
;<4.EXEC>EXECMT.MAC.86, 12-Nov-78 11:35:29, EDIT BY R.ACE
;CHANGE /NOVERIFY TO /CHECK-SETNAME (OPPOSITE MEANING)
;<4.EXEC>EXECMT.MAC.85, 10-Nov-78 15:30:37, EDIT BY OSMAN
;CHANGE MOUNT DISK TO MOUNT STRUCTURE, ADD DISMOUNT
;<4.EXEC>EXECMT.MAC.83,  9-Nov-78 15:07:52, EDIT BY OSMAN
;QUEUE UP ID FOR NOWAIT AT MGROVL INSTEAD OF NOW2
;<4.EXEC>EXECMT.MAC.81,  9-Nov-78 13:41:59, EDIT BY R.ACE
;FIX CALL TO DEVST WHEN DEFINING LOGICAL NAME
;<4.EXEC>EXECMT.MAC.76,  1-Nov-78 16:28:00, EDIT BY OSMAN
;PUT IN "NEW" TMOUNT
;<4.EXEC>EXECMT.MAC.74,  1-Nov-78 09:36:39, EDIT BY MILLER
;PUT ; ON COMMENT LINE
;<4.EXEC>EXECMT.MAC.71, 31-Oct-78 16:30:01, EDIT BY OSMAN
;PUT IN "NEW" SMOUNT
;<4.EXEC>EXECMT.MAC.70, 31-Oct-78 10:43:36, EDIT BY R.ACE
;FIX /START: VOLID volid SWITCH ON MOUNT COMMAND
;<4.EXEC>EXECMT.MAC.68, 26-Oct-78 16:17:19, EDIT BY OSMAN
;REMOVE REFS TO GSSALS, USE LOCAL VAR INSTEAD
;<4.EXEC>EXECMT.MAC.42, 28-Sep-78 15:47:37, EDIT BY HELLIWELL
;CHANGE B7 TO DV%MDV AT .MOUNT (NOSHIP)
;<4.EXEC>EXECMT.MAC.41, 27-Sep-78 20:31:37, EDIT BY OSMAN
;REMOVE Bn SYMBOL REFS
;<4.EXEC>EXECMT.MAC.14, 17-Sep-78 16:24:40, EDIT BY OSMAN
;REMOVE REFS TO CSBUFP
;<4.EXEC>EXEC1.MAC.45, 13-Sep-78 09:25:44, EDIT BY OSMAN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH EXECDE
	TTITLE EXECMT
	GLXSCH			;SEARCH GALAXY UNV'S

;THIS FILE CONTAINS
;	o	 DISK AND TAPE MOUNTING STUFF
;
;	o	 tape-manipulation commands (SKIP BACKSPACE REWIND EOF ...)

DEFINE MNTSTG
<	TRVAR <NEWBLK,OLDLST,<AFTVOL,2>,VPOS,ARGPT0,ARGPT1,TAPDES,TAPPTR,ITEMS,CANF,JBNAM,TAPEF,QIDEN,NWAITF,NAMEP,ARGPTR>
>

DEFINE TAPSTG
<	TRVAR <TAPJFN,BNUM,MFCN,<GTMBUF,FILWDS>,GTP0>
>

;FLAGS USED IN Z

REMOVF==1B0			;FLAG SET IN AC0 IF /REMOVE TYPED
STRIDF==1B1			;/STRUCTURE-ID: HAS BEEN SEEN AT LEAST ONCE

;DISMOUNT STRUCTURE

DSTR:	NOISE (NAME)
	STRX <Structure name>
	 CMERRX			;ERROR TYPING STRUCTURE NAME
DSTR1:	CALL BUFFF		;REMEMBER STRUCTURE NAME
	MOVEM A,NAMEP		;SAVE FOR MOUNT NAME
	CALL ASTKI		;GET ARG POINTER
	MOVEI A,DDSK2		;SAY DISMOUNT STRUCTURE
	CALL REMARG
	CALL GETSXB		;GET SIXBIT STRUCTURE NAME
	MOVEM A,JBNAM		;USE SIXBIT AS NAME FOR REQUEST
	MOVE B,A		;ALIAS NAME IN B
	MOVEI A,DNAM2
	CALL REMARG		;REMEMBER ALIAS SPECIFIED
	TXZ Z,REMOVF		;NO /REMOVE SEEN YET
	SETZM NWAITF		;NO NOWAIT YET
DD1:	MOVEI B,[FLDDB. .CMSWI,,DSTAB,,,[FLDDB. .CMCFM]]
	CALL FLDSKP		;GET SWITCH OR END OF COMMAND
	 CMERRX
	LOAD C,CM%FNC,(C)	;GET FUNCTION CODE
	CAIN C,.CMSWI		;SWITCH?
	JRST [	CALL GETKEY	;YES, GET DISPATCH ADDRESS
		CALL (P3)	;EXECUTE THE SWITCH
		JRST DD1]	;GET REST OF COMMAND
	MOVE A,[1,,.MSDMC]	;PREPARE TO RELINQUISH HOLD ON THE STRUCTURE
	MOVEI B,NAMEP		;POINT TO WORD HOLDING POINTER TO NAME
	JXE Z,REMOVF,DD2	;JUMP IF /REMOVE NOT SPECIFIED
	MSTR			;TRY TO DECREMENT MOUNT COUNT
	 ERJMP [CALL DGETER	;FAILED, GET REASON
		CAIE A,STRX01	;STRUCTURE NOT MOUNTED?
		CAIN A,MSTX32	;STRUCTURE NOT MOUNTED BY THIS JOB?
		JRST .+1	;JUST GO ON WITH REMOVAL PROCESS
		CAIE A,MSTX21	;STRUCTURE NOT MOUNTED?
		CAIN A,STDVX1	;NO SUCH DEVICE?
		JRST .+1	;YES, PROCEED WITH REMOVAL
		CALL CJERR]	;UNEXPECTED ERROR, TELL USER AND QUIT
	CALLRET MGROVL		;TALK TO OPERATOR TO HANDLE REMOVAL

;HERE WHEN NOT DOING REMOVAL

DD2:	MSTR			;ATTEMPT TO DECREMENT MOUNT COUNT
	 ERJMP [CALL DGETER	;FAILED, SEE WHY
		MOVE C,NAMEP	;GET NAME FOR PRINTING ERROR
		CAIE A,STRX01	;STRUCTURE NOT MOUNTED AT ALL?
		CAIN A,MSTX32	;OR NOT BY THIS USER?
		CAIA		;RIGHT
		CALL CJERR	;UNKNOWN ERROR, QUIT
		ETYPE <%%Structure %3M: was not mounted%_>
		RET]		;NOTHING MORE TO DO
	MOVE A,NAMEP		;GET POINTER TO STRUCTURE NAME
	ETYPE <Structure %1m: dismounted%_>
	RET			;ALL DONE

;TABLE OF SWITCHES FOR DISMOUNT STRUCTURE

DSTAB:	TABLE
	T NOWAIT		;DON'T WAIT FOR COMPLETION BEFORE RETURNING TO EXEC
	TV REMARK		;SEND REMARK TO OPERATOR
	T REMOVE		;WAIT FOR STRUCTURE TO BE PHYSICALLY REMOVED
	TV STRUCTURE-ID,,.STRIO	;SPECIFY NAME WRITTEN ON PACK
	TEND

;/REMOVE MEANS WAIT FOR STRUCTURE TO BE REMOVED FROM DRIVES

.REMOV:	TXO Z,REMOVF		;REMEMBER THAT REMOVAL HAS BEEN REQUESTED
	RET

;DISMOUNT TAPE/STRUCTURE

.DISMO::MNTSTG
	MOVEI B,[FLDDB. .CMKEY,,DISTAB,,,[
		 FLDDB. .CMDEV]]
	CALL FLDSKP
	 CMERRX
	LOAD D,CM%FNC,.CMFNP(C)	;SEE WHAT WAS TYPED
	CAIE D,.CMKEY		;KEYWORD?
	JRST DISDEV		;NO, DEVICE
	CALL GETKEY		;FIGURE OUT WHERE TO GO
	CALLRET (P3)		;GO THERE

;USER TYPED "DISMOUNT FOO:".  FIGURE OUT WHAT KIND OF DEVICE THIS IS

DISDEV:	LOAD A,DV%TYP,B		;GET DEVICE TYPE
	CAIE A,.DVDTA		;DECTAPE?
	CAIN A,.DVMTA		;TAPE?
	JRST DTAPE2		;YES
	CAIN A,.DVDSK		;STRUCTURE?
	JRST DSTR1		;YES
	ERROR <Only tapes or disks may be DISMOUNTed>

;TABLE OF THINGS TO DISMOUNT

DISTAB:	TABLE
	T STRUCTURE,,DSTR
	T TAPE,,DTAPE
	TEND

;DISMOUNT TAPE

DTAPE:	NOISE (NAME)
	DEVX <Name of tape to dismount>
	 CMERRX
DTAPE2:	MOVEM B,TAPDES		;SAVE DESIGNATOR
	CALL BUFFF		;REMEMBER THE TAPE NAME
	MOVEM A,TAPPTR		;REMEMBER POINTER TO TAPE NAME
	CONFIRM			;MAKE SURE TYPIST KNOWS WHAT'S GOING ON
	MOVE A,TAPDES		;GET DESIGNATOR
	LOAD B,DV%TYP,A		;GET DEVICE TYPE
	CAIN B,.DVDTA		;DECTAPE?
	JRST DTAPE1		;YES, PROCEDE
	CAIE B,.DVMTA		;MAGTAPE?
	ERROR <Device is not a magtape>
	TRNN A,400000		;IS IT AN MT?
	ERROR <Device was not MOUNTed> ;NO
DTAPE1:	MOVE A,TAPDES		;GET DESIGNATOR
	RELD			;TRY TO RELEASE IT
	 JRST [	CAIE A,DEVX6	;CAN'T RELD BECAUSE OPEN JFN EXISTS?
		CALL CJERR	;NO, UNEXPECTED ERROR
		MOVE A,TAPDES	;GET DESIGNATOR
		CALL CJDEV	;FIND JFN AND ASK USER TO CLOSE IT
		 JRST [	MOVEI A,DEVX6 ;CAN'T FIND JFN
			CALL CJERR]
		JRST DTAPE1]	;HE CLOSED IT, TRY RELD ONCE MORE
	ETYPE <[Tape dismounted>
	MOVE B,TAPPTR		;POINT TO POSSIBLE LOGICAL NAME
	MOVEI A,.CLNJ1		;SAY DELETE ONE LOGICAL NAME FROM JOB
	CRLNM			;DELETE THE LOGICAL NAME
	 ERJMP [ETYPE <]>	;ERROR
		CAIN A,CRLNX1	;"LOGICAL NAME IS NOT DEFINED"?
		RET		;RIGHT, SO IGNORE ERROR
		CALL JERR]	;NO, SO UNEXPECTED
	ETYPE <, logical name %2M: deleted]
>
	RET

;MOUNT TAPE/STRUCTURE

ALN==3				;WORDS NEEDED PER DATA ITEM
ASTKLN==ALN*NMARGS		;LENGTH OF STACK NEEDED FOR DATA

.MOUNT::MNTSTG			;ALLOCATE STORAGE
	TXZ Z,STRIDF		;NO STRUCTURE ID SPECIFIED YET
	SETZM ITEMS		;CLEAR NUMBER OF ITEMS
	CALL ASTKI		;GET INITIAL ARGUMENT POINTER
	SETZM JBNAM		;HAVEN'T SELECTED A JOB NAME YET
	SETZM NWAITF		;HAVEN'T SEEN /NOWAIT YET
	MOVEI B,[FLDDB. .CMKEY,,$WHAT]
	CALL FLDSKP
	CMERRX <TAPE or STRUCTURE required>
MENTRY:	CALL GETKEY		;SEE WHAT'S BEING MOUNTED
	JRST (P3)		;DO IT

$WHAT:	TABLE
	T STRUCTURE
	T TAPE
	TEND

;MOUNT STRUCTURE SWITCHES

$DSSWI:	TABLE
	T NOWAIT
	TV REMARK
	TV STRUCTURE-ID,,.STRIO
	TEND

;MOUNT TAPE SWITCHES

$TPSWI:	TABLE
	T CHECK-SETNAME,,CHKSET
	TV DENSITY
	TV DRIVE-TYPE,,DTYPE
	TV LABEL-TYPE,,LTYPE
	T NEW
	T NOUNLOAD
	T NOWAIT
	T OPERATOR
	TV PROTECTION
	T READ-ONLY,,RONLY
	TV REMARK
	T SCRATCH
	TV START
	TV VOLIDS,,VOL
	T WRITE-ENABLED,,WENABL
	TEND

;ROUTINE TO INITIALIZE ARG STACK

ASTKI:	MOVEI A,ASTKLN
	CALL GETBUF		;GET BUFFER FOR ARGUMENT STACK
	SOJ A,			;DECREMENT SO FIRST PUSH USES FIRST WORD
	HRLI A,-ASTKLN		;USE NEGATIVE COUNT SO WE TRAP IF OVERFLOW
	MOVEM A,ARGPTR		;REMEMBER POINTER
	MOVEM A,ARGPT0		;REMEMBER INITIAL POINTER
	RET

;MOUNT STRUCTURE

.STRUC:	SETZM TAPEF		;SAY NOT TAPE
	JRST ITM1		;JOIN COMMON CODE

;MOUNT TAPE

.TAPE:	SETOM TAPEF		;REMEMBER WE'RE ON TAPE, NOT DISK
ITM1:	MOVEI A,TAP2		;LOAD UP ADDRESS FOR PROCESSING "TAPE"
	SKIPN TAPEF		;TAPE??
	MOVEI A,DSK2		;NO, DISK
	AOS ITEMS		;COUNT HOW MANY ITEMS ARE BEING MOUNTED
	CALL REMARG		;REMEMBER WHAT TYPED
	NOISE (NAME)
	HELPX <Logical name, first six characters will be tape set name>
	SKIPN TAPEF		;DIFFERENT HELP FOR DISK
	HELPX <Name structure will be referred to as, six characters or less, terminated with colon>
	STRX
	 CMERRX			;FAILED, PRINT MONITOR REASON
	CALL BUFFF		;ISOLATE THE NAME
	MOVEM A,NAMEP		;REMEMBER POINTER TO IT
	CALL GETSIX		;GET DEFAULT SET NAME
	 JFCL			;TRUNCATE TO SIX CHARACTERS
	MOVE B,A		;SIXBIT IN B
	MOVEI A,NAM2		;ADDRESS FOR PROCESSING NAME
	SKIPN TAPEF
	MOVEI A,DNAM2		;DIFFERENT STUFF FOR DISK
	CALL REMARG		;REMEMBER NAME
	MOVE A,NAMEP		;GET NAME TYPED
	SKIPN JBNAM		;SELECTED A JOB NAME YET?
	JRST [	CALL GETSIX	;NO, GET SIXBIT VERSION OF FIRST TAPE OR DISK SEEN
		 JFCL		;TRUNCATE IF NAME TOO LONG
		MOVEM A,JBNAM	;REMEMBER NAME
		JRST .+1]
	SKIPE TAPEF		;TAPE?
	CALL STOVD0		;SET VOLID LIST TO SET NAME
	SETZM 1+AFTVOL		;NOTHING AFTER /VOLID LIST YET
TAPINP:	MOVEI B,[FLDDB. .CMCFM,,,,,[	;END OF LINE ONE POSSIBILITY
		 FLDDB. .CMSWI,,$TPSWI]] ;TAPE SWITCH
;		 FLDDB. .CMKEY,,$WHAT	;PUT THIS IN FOR MULTIPLE-DEVICE MOUNT REQUESTS
	SKIPN TAPEF		;DIFFERENT SWITCHES FOR DISK
	MOVEI B,[FLDDB. .CMCFM,,,,,[	;END OF LINE ONE POSSIBILITY
		 FLDDB. .CMSWI,,$DSSWI]] ;DISK SWITCH
;		 FLDDB. .CMKEY,,$WHAT
	MOVEM B,VPOS		;REMEMBER POSSIBILITY FOR /VOLIDS
	CALL FLDSKP		;GET SOME INPUT
TERR:	 CMERRX			;INVALID INPUT
TAPIN1:	LOAD C,CM%FNC,.CMFNP(C)	;GET FUNCTION CODE
	CAIN C,.CMCFM		;END OF LINE?
	JRST MGROVL		;YES, GO DO EVERYTHING
	CAIN C,.CMKEY		;ANOTHER KEYWORD?
	JRST MENTRY		;YES, NEW ENTRY (NOT POSSIBLE FOR RELEASE 4!)
	CALL GETKEY		;IT'S A SWITCH, SEE WHICH ONE
	CALL (P3)		;EXECUTE THE SWITCH
	MOVE B,AFTVOL		;GET POSSIBLE FIELD FOLLOWING /VOLID
	MOVE C,1+AFTVOL	;IS THERE DATA (0+AFTVOL IS BAD TEST SINCE 0 MIGHT BE VALID DATA!)
	SETZM 1+AFTVOL		;NOTE THAT NOT JUST AFTER /VOLID LIST ANYMORE
	JUMPN C,TAPIN1		;SKIP COMND IF ALREADY READ NEXT FIELD
	JRST TAPINP		;CONTINUE INPUTTING

;/START

.START:	MOVEI B,[FLDDB. .CMKEY,,[2,,2
				 T NUMBER
				 T VOLID,,.VLD]]
	CALL FLDSKP
	 CMERRX
	CALL GETKEY		;SEE WHICH WAY STARTING VOLID BEING GIVEN
	CALLRET (P3)		;CONTINUE PARSING ACCORDING TO WHICH BEING GIVEN

.NUMBE:	DECX <Number of volume to start with, 1 means first>
	 CMERRX
	MOVEI A,NUM2
	CALLRET REMARG

NUM2:	MOVE A,[1,,.TMSTV]
	CALLRET SUBENT

.VLD:	WORDX <Volume identifier of volume to start with>
	 CMERRX
	CALL GETSXB		;GET SIXBIT VERSION
	MOVE B,A		;COPY SIXBIT VOLID TO B
	MOVEI A,VLD2
	CALLRET REMARG

VLD2:	MOVE A,[2,,.TMSTV]	;TWO DATA WORDS
	LSHC B,-44		;0 IN B, SIXBIT VOLID IN C
	CALLRET SUBENT

;/SCRATCH

.SCRAT:	MOVEI A,SCR2
	CALLRET REMARG

SCR2:	MOVX A,TM%SCR		;SAY SCRATCH
SFLAG:	IORM A,.MEFLG(P2)	;STORE IN FLAG WORD
	RET

;/NEW

.NEW:	MOVEI A,NEW2
	CALLRET REMARG

NEW2:	MOVX A,TM%NEW
	CALLRET SFLAG

;/DENSITY

.DENSI:	MOVEI B,[FLDDB. .CMKEY,,$TDENS]
	CALL FLDSKP
	 CMERRX
	MOVEI A,DEN2
	CALL GETKEY		;GET DENSITY CODE
	MOVE B,P3
	CALLRET REMARG

DEN2:	MOVE A,[1,,.TMDEN]	;SAY SPECIFYING DENSITY
	CALLRET SUBENT

;/LABEL-TYPE

LTYPE:	MOVEI B,[FLDDB. .CMKEY,,[5,,5
				 T ANSI,,.LTANS
				 T BYPASS,,TM%BYP
				 T EBCDIC,,.LTEBC
				 T TOPS-20,,.LTT20
				 T UNLABELED,,.LTUNL]]
	CALL FLDSKP
	 CMERRX
	CALL GETKEY
	MOVE B,P3
	MOVEI A,LT2
	CALLRET REMARG

LT2:	CAMN B,[TM%BYP]		;BYPASS?
	JRST [	MOVEI B,.LTUNL	;YES, SAY UNLABELED
		MOVE A,[1,,.TMLT]
		CALL SUBENT	;SAY UNLABELED
		MOVX A,TM%BYP
		CALLRET SFLAG]	;AND SET BYPASS FLAG
	MOVE A,[1,,.TMLT]
	CALLRET SUBENT

;/VOLIDS

MAXVLN==100			;NUMBER OF VOLIDS WE CAN INPUT

VOL:	STKVAR <<VOLBUF,1+MAXVLN>>
	MOVEI A,1
	MOVEM A,VOLBUF		;FIRST WORD IS LENGTH, INITIALLY 1 (INCLUDES ONLY ITSELF!)
VOL1:	WORDX <Name printed on tape volume>
	 CMERRX
	CALL GETSXB		;GET SIXBIT VERSION
	AOS B,VOLBUF		;GET TOTAL BLOCK LENGTH INCLUDING NEW VOLID
	CAILE B,1+MAXVLN	;ROOM TO STORE ANOTHER?
	 ERROR <Too many VOLIDs in one tape set>
	ADDI B,-1+VOLBUF	;GET ADDRESS OF WHERE TO PUT VOLID
	MOVEM A,(B)		;STORE LATEST VOLID
	HRL A,VPOS		;LOAD UP REST OF POSSIBILITIES
	HRRI A,FBLOCK		;CAN'T PUT "VPOS" IN FLDDB. SINCE IT'S A STACK VARIABLE!
	BLT A,FBLOCK+FBLLEN-1	;LOAD FUNCTION BLOCK
	MOVEI B,[FLDDB. .CMCMA,CM%SDH,,<Comma to specify another VOLID>,,FBLOCK]
	CALL FLDSKP
	 CMERRX <Invalid VOLID>
	LOAD D,CM%FNC,.CMFNP(C)
	CAIN D,.CMCMA		;MORE VOLIDS COMING?
	JRST VOL1		;GO GET NEXT VOLID
	DMOVEM B,AFTVOL		;REMEMBER WHAT'S AFTER THE VOLID LIST
	MOVEI A,VOLBUF		;GET ADDRESS OF BUFFER OF VOLIDS
	CALLRET STOVDS		;STORE THE VOLIDS

;ROUTINE TO SET VOLID LIST TO BE THE SINGLE NAME SPECIFIED IN A.

STOVD0:	STKVAR <NAM>
	MOVEM A,NAM		;REMEMBER NAME SUPPLIED
	MOVEI A,2		;GET A TWO-WORD BLOCK
	CALL GETBUF
	MOVE C,NAM		;GET VOLID NAME
	MOVEI B,2		;IT'S A TWO WORD BLOCK
	DMOVEM B,(A)		;CREATE TWO-WORD BLOCK
	CALLRET STOVDS		;SET UP VOLID LIST TO SINGLE NAME

;CALL STOVDS WITH ADDRESS IN A OF BLOCK OF VOLIDS.  FIRST WORD OF BLOCK
;IS SIZE OF ENTIRE BLOCK

STOVDS:	STKVAR <VA>
	MOVEM A,VA		;REMEMBER ADDRESS OF BLOCK
	MOVE A,@VA		;GET NUMBER OF WORDS NEEDED FOR BLOCK
	CALL GETBUF		;GET STORAGE FOR VOLIDS
	MOVE B,A		;REMEMBER ADDRESS OF BLOCK
	HRLI A,@VA		;PREPARE TO COPY FROM WORKING BUFFER
	MOVE C,@VA		;GET NUMBER OF WORDS TO MOVE
	ADDI C,-1(B)		;CALCULATE LAST WORD TO COPY INTO
	BLT A,(C)		;COPY THE VOLIDS
	MOVEI A,VOL2		;ADDRESS OF PASS2 ROUTINE
	CALLRET REMARG		;DONE

VOL2:	HRL A,(B)		;GET NUMBER OF VOLIDS SPECIFIED
	SUB A,[1,,0]		;NUMBER OF VOLIDS IS ONE LESS THAN BLOCK SIZE
	HRRI A,.TMVOL		;SAY THESE ARE VOLIDS
	TXO A,SUB%NI		;DATA IS NOT IMMEDIATE
	AOJ B,			;SKIP THE LENGTH
	CALLRET SUBENT		;MAKE SUBENTRY

;/REMARK

.REMAR:	QUOTEX <Remark for operator, in quotes>
	 CMERRX
	CALL BUFFF		;ISOLATE THE REMARK
	MOVE B,A		;BYTE POINTER TO REMARK IN B
	MOVEI A,REM2
	CALLRET REMARG

REM2:	STKVAR <REMPT>
	MOVEM B,REMPT		;REMEMBER POINTER TO REMARK
	MOVEI C,0		;C WILL TALLY LENGTH OF STRING
	MOVE A,B		;POINTER TO REMARK IN A
	CALL BCOUNT		;SEE HOW MANY WORDS REMARK TAKES
	HRL A,A			;LENGTH IN LEFT HALF
	HRRI A,.TMRMK		;SAY IT'S A REMARK
	TXO A,SUB%NI		;DATA NOT IMMEDIATE
	HRRZ B,REMPT		;ADDRESS OF REMARK
	CALLRET SUBENT		;MAKE THE SUBENTRY

;/DRIVE-TYPE

DTYPE:	MOVEI B,[FLDDB. .CMKEY,,[2,,2
				 T 7-TRACK,,.TMDR7
				 T 9-TRACK,,.TMDR9]]
	CALL FLDSKP
	 CMERRX
	CALL GETKEY		;GET CODE FOR DRIVE-TYPE
	MOVE B,P3
	MOVEI A,DT2
	CALLRET REMARG

DT2:	MOVE A,[1,,.TMDRV]
	CALLRET SUBENT

;/CHECK-SETNAME

CHKSET:	MOVEI A,NV2
	CALLRET REMARG

NV2:	MOVX A,TM%VFY
	CALLRET SFLAG

;/NOWAIT

.NOWAI:	MOVEI A,NOW2		;STACK UP THE SWITCH
	CALLRET REMARG

NOW2:	SETOM NWAITF		;SAY WE WANT NOWAIT
	RET

;COME HERE JUST BEFORE READING NEXT EXEC COMMAND, IF AN IPCF INTERRUPT HAS
;OCCURRED SINCE THE LAST COMMAND.  THIS ROUTINE CHECKS TO SEE IF ANY /NOWAIT
;MOUNT REQUESTS HAVE BEEN ANSWERED, AND TELLS USER THE RESULT FOR THOSE THAT
;HAVE.

CHECKM::STKVAR <SNXT,NOWPTX>
	MOVE A,NOWPTR		;GET ADDRESS OF FIRST BLOCK
	MOVEM A,NOWPTX		;REMEMBER WHERE WE ARE IN CHAIN
MNTC1:	SKIPN NOWPTX		;GET ADDRESS OF BLOCK ON QUEUE
	RET			;NO MORE BLOCKS, DONE
MNTC3:	MOVE C,NOWPTX		;BACK HERE AFTER INTERRUPT
	MOVE B,MQID(C)		;GET IDENTIFICATION FOR AN OUTSTANDING REQUEST
	MOVE C,MLNK(C)		;GET ADDRESS OF NEXT BLOCK TO CHECK
	MOVEM C,SNXT		;SAVE NOW SINCE GETQAN WILL FLUSH THIS BLOCK
	CALL GQPID		;GET QUASAR'S PID
	CALL IPCFND		;TRY TO FIND MESSAGE IN THE QUEUES
	 JRST MNTC4		;NOT THERE YET, SEE IF MESSAGE WAITING
	CALL LM			;GET TO LEFT MARGIN (SINCE WE MAY BE SITTING AFTER PROMPT!)
	MOVE A,NOWPTX		;FOUND IT, GET ITS RANK
	MOVE A,MQID(A)		;GET ITS IDENTIFICATION CODE
	CALL GETQAN		;GO PRINT RESULT OF MOUNT
	JRST MNTC2		;SKIP TEST OF IPCF
MNTC4:	SKIPL OLDIDX		;IS AN IPCF MESSAGE WAITING?
	JRST  [	CALL IPCFLM	;YES, READ IN MESSAGE, FLUSHING OLD ONE
		JRST MNTC3]	;SEE IF IT WAS OURS
MNTC2:	MOVE A,SNXT		;GET NEXT BLOCK ADDRESS TO DO
	MOVEM A,NOWPTX
	JRST MNTC1		;CONTINUE SCANNING TO SEE WHAT'S BEEN ANSWERED


;NOUNLOAD

.NOUNL:	MOVEI A,NOU2
	CALLRET REMARG

NOU2:	MOVX A,TM%NUL		;DON'T UNLOAD TAPES AT VOLUME-SWITCH OR DISMOUNT
	CALLRET SFLAG

;/OPERATOR

.OPERA:	MOVEI A,OP2
	CALLRET REMARG

OP2:	MOVX A,TM%OSV
	CALLRET SFLAG

;/PROTECTION

.PROTE:	OCTX <6-digit octal protection for new volumes>
	 CMERRX
	MOVEI A,PRO2
	CALLRET REMARG

PRO2:	MOVE A,[1,,.TMVPR]
	CALLRET SUBENT

;/READ-ONLY

RONLY:	MOVEI A,RON2
	CALLRET REMARG

RON2:	MOVX A,TM%WEN
CLRFLG:	ANDCAM A,.MEFLG(P2)	;CLEAR SPECIFIED FLAG
	RET


;/WRITE-ENABLED

WENABL:	MOVEI A,WEN2
	CALLRET REMARG

WEN2:	MOVX A,TM%WEN
	CALLRET SFLAG

;NAME SPECIFIED

NAM2:	MOVE A,[1,,.TMSET]	;1 DATA WORD,,NAME
	CALL SUBENT		;PUT IN THE SUBENTRY
	RET

;STRUCTURE NAME SPECIFIED (ALIAS, I.E. NAME STRUCTURE WILL BE REFERRED TO AS)

DNAM2:	MOVE A,[1,,.SMALI]	;SPECIFY ALIAS
	CALLRET SUBENT

;STRUCTURE-ID SPECIFIED

.STRIO:	STRX <Physical name as written on packs>
	 CMERRX
	CALL GETSXB		;GET SIXBIT VERSION
	MOVE B,A		;SIXBIT NAME IN B
	MOVEI A,STRI2
	TXO Z,STRIDF		;REMEMBER THAT ID SPECIFIED
	CALLRET REMARG

STRI2:	MOVE A,[1,,.SMNAM]	;SAY WE'RE GIVING STRUCTURE ID
	CALLRET SUBENT

;COME HERE TO PROCESS "TAPE" KEYWORD

TAP2:	MOVEI A,.MNTTP		;SAY IT'S TAPE
	CALLRET ITM2

;IDENTIFY DISMOUNTING DISK

DDSK2:	MOVEI A,.DSMST
	CALLRET ITM2

;HERE FOR "DISK" KEYWORD

DSK2:	MOVEI A,.MNTST		;SAY WE'RE MOUNTING A STRUCTURE
	CALLRET ITM2

;HERE WITH ENTRY FLAVOR IN A

ITM2:	STKVAR <FLVR>
	MOVEM A,FLVR		;REMEMBER FLAVOR
	JUMPN P2,[LOAD A,AR.LEN,.MEHDR(P2) ;GET LENGTH OF ENTRY WE JUST FINISHED
		  ADD P2,A	;STEP TO NEXT ENTRY
		  MOVEI A,.MEHSZ(P2) ;GET ADDRESS BEYOND ENTRY
		  CAIL A,1000(P1) ;RUN OUT OF ROOM?
		  CALL TME	;YES, TOO MANY ENTRIES
		  JRST TAPNF1]
	MOVEI P2,.MMHSZ(P1)	;CREATE POINTER TO FIRST ENTRY
	MOVEI Q1,.MEHSZ(P2)	;INITIALIZE POINTER TO SUBENTRIES
TAPNF1:	MOVEI A,.MEHSZ		;START WITH A 0-LENGTH ENTRY
	STOR A,AR.LEN,.MEHDR(P2)
	MOVE A,FLVR		;SAY WHAT TYPE OF ENTRY THIS IS
	STOR A,AR.TYP,.MEHDR(P2)
	AOS .MMARC(P1)		;COUNT HOW MANY ENTRIES WE HAVE
	RET

;CALL THE FOLLOWING ROUTINE WITH ADDRESS IN A, AND DATA IN B AND C.
;THE ADDRESS IN A WILL BE CALLED TO PROCESS THE ITEM, AFTER THE ENTIRE
;MOUNT COMMAND HAS BEEN CONFIRMED

REMARG:	MOVE D,ARGPTR		;GET POINTER TO ARG STACK
	PUSH D,A		;PUT ADDRESS ON STACK
	 ERCAL TME		;IF OVERFLOW, TOO MANY ITEMS
	PUSH D,B		;STORE DATA
	 ERCAL TME
	PUSH D,C
	 ERCAL TME
	MOVEM D,ARGPTR		;STORE RESULTANT POINTER FOR NEXT ARG
	RET

;COME TO HERE WHEN COMMAND HAS BEEN CONFIRMED

MGROVL:	CALL MNTINI		;INITIALIZE POINTERS
	CALL RETRX		;PROCESS ALL THE ARGS
	SUB Q1,P1		;GET LENGTH OF COMMUNICATION BLOCK
	STOR Q1,MS.CNT,(P1)	;STORE TOTAL LENGTH
	MOVE A,JBNAM		;GET NAME FOR ENTIRE MOUNT REQUEST
	MOVEM A,.MMNAM(P1)	;TELL QUASAR THE NAME
	SOSE ITEMS		;EXACTLY ONE ITEM?
	JRST MGR1		;NO, SO ALWAYS TALK TO OPERATOR
	LOAD A,AR.TYP,.MEHDR(P2) ;YES, SEE WHAT TYPE
	TXNN Z,STRIDF		;NO /STRUCTURE-ID SEEN?
	CAIE A,.MNTST		;DISK MOUNT?
	JRST MGR1		;NO, SO TALK TO OPERATOR
	MOVE A,NAMEP		;SIMPLE NAME
	STDEV			;SEE IF DEVICE EXISTS
	 ERJMP MGR1		;NO, SO TALK TO OPERATOR
	MOVE A,CSBUFP		;GET SOME SCRATCH SPACE
	DEVST			;GET REAL DEVICE NAME (NOT LOGICAL NAME!)
	 ERJMP MGR1		;IF FAILS, TALK TO OPERATOR
	MOVE A,CSBUFP
	CALL BUFFS		;ISOLATE THE STRING
	MOVEM A,NAMEP		;REMEMBER POINTER TO REAL NAME
	CALLRET IMC		;JUST INCREMENT MOUNT COUNT AN WE'RE DONE
MGR1:	CALL QUASND		;SEND REQUEST OFF TO QUASAR
	MOVEM A,QIDEN		;REMEMBER ID
	MOVEI A,NOWPTR		;FIND END OF CHAIN FOR STORING LATEST BLOCK
MGR3:	SKIPN B,MLNK(A)		;FIND END OF CHAIN YET?
	JRST MGR4		;YES
	MOVE A,B		;NO, KEEP SEARCHING
	JRST MGR3
MGR4:	MOVEM A,OLDLST		;REMEMBER THE OLD LAST BLOCK ADDRESS IN CHAIN
	CALL PIOFF		;NO ^C ALLOWED WHILE WE FIX DATABASE
	MOVEI A,MLEN		;ALLOCATE BLOCK
	CALL GTBUFX		;IN PERMANENT STORAGE
	MOVEM A,NEWBLK		;REMEMBER ADDRESS OF NEW BLOCK
	MOVE B,OLDLST		;GET ADDRESS OF PREVIOUS END OF CHAIN
	MOVEM A,MLNK(B)		;ADD NEW BLOCK TO CHAIN
	MOVE A,NAMEP		;GET POINTER TO LOGICAL NAME
	CALL XBUFFS		;STORE LOGICAL NAME IN PERMANENT STORAGE
	MOVE B,NEWBLK		;GET ADDRESS OF NEW BLOCK
	MOVEM A,MLOG(B)		;REMEMBER POINTER TO LOGICAL NAME
	MOVE A,QIDEN		;GET QUASAR IDENTIFICATION CODE
	MOVEM A,MQID(B)		;REMEMBER THAT IN BLOCK TOO
	SETZM MLNK(B)		;NO LINK TO ANOTHER BLOCK YET
	CALL PION		;ALLOW ^C AGAIN
	SKIPN NWAITF		;DON'T WAIT FOR ANSWER NOW IF /NOWAIT
	CALL GETANS		;NO NOWAIT, GET ANSWER
	CALL UNMAP		;GET RID OF SPECIAL PAGES
	RET			;DONE

GETANS:	SETOM MPENDF		;SAY A MOUNT IS PENDING
	MOVE A,QIDEN		;GET IDENTIFIER OF MESSAGE WE WANT TO RECEIVE
	CALLRET GETQAN		;GO GET QUASAR ANSWER

;HERE WITH IDENTIFIER IN A, TO GET AND PROCESS MOUNT RESPONSE

GETQAN:	STKVAR <LOG0,QQ,THIS,LAST,NEXT>
	MOVEM A,QQ
	CALL GQPID		;RECEIVE FROM QUASAR
	MOVE B,QQ		;ID IN B
	CALL IPCRCV		;GET RESPONSE
	SETZM MPENDF		;WHEN RESPONSE ARRIVES, ASSUME NO LONGER PENDING
	MOVEI A,NOWPTR		;PREPARE TO FIND ANSWERED ITEM IN PENDINGS
GETQ1:	MOVEM A,LAST		;REMEMBER BLOCK ADDRESS, IN CASE NEXT ONE IS GOOD ONE
	SKIPN A,MLNK(A)		;MAKE SURE WE'RE NOT AT END OF CHAIN
	JRST GETQ3		;MUST HAVE BEEN ^C BEFORE WE GOT A CHANCE TO QUEUE UP THE REQUEST
	MOVE B,MQID(A)		;GET AN ITEM FROM PENDING LIST
	CAME B,QQ		;IS THIS THE ONE WE JUST ANSWERED?
	JRST GETQ1		;KEEP SEARCHING FOR CORRECT BLOCK
	CALL PIOFF		;YES, DON'T LET USER ^C WHILE WE FIX LINKS
	MOVEM A,THIS		;REMEMBER ADDRESS OF THIS BLOCK
	MOVE A,MLOG(A)		;GET POINTER TO LOGICAL NAME
	CALL BUFFS		;PUT LOGICAL NAME IN TEMPORARY STORAGE
	MOVEM A,LOG0		;REMEMBER POINTER TO LOGICAL NAME
	MOVE A,THIS
	MOVE A,MLOG(A)		;GET PERMANENT POINTER TO LOGICAL NAME AGAIN
	CALL STREM		;RELEASE SPACE USED BY LOGICAL NAME
	MOVEI A,MLEN		;GET LENGTH OF BLOCK BEING THROWN AWAY
	MOVE B,THIS		;ADDRESS OF BLOCK BEING THROWN AWAY
	MOVE C,MLNK(B)		;GET ADDRESS OF NEXT BLOCK
	MOVEM C,NEXT		;REMEMBER IT
	CALL RETBUF		;RELEASE SPACE USED BY THIS BLOCK
	MOVE A,NEXT		;GET ADDRESS OF BLOCK FOLLOWING THE ONE WE THREW AWAY
	MOVE B,LAST		;GET ADDRESS OF BLOCK PRECEDING THE ONE WE THREW AWAY
	MOVEM A,MLNK(B)		;REPAIR CHAIN
	CALL PION		;ALLOW ^C AGAIN
GETQ3:	MOVE A,LOG0		;GET POINTER TO LOGICAL NAME
	CALLRET INTANS		;INTERPRET ANSWER AND RETURN

;ROUTINE TO INTERPRET ANSWER FROM QUASAR

INTANS:	STKVAR <OURLOG,ECNT,MNTNAM>
	MOVEM A,OURLOG		;REMEMBER POINTER TO LOGICAL NAME
	MOVEI P1,IPCFP		;POINT AT MESSAGE ITSELF
	MOVEI P2,0		;NO ENTRY POINTER YET
	MOVE A,.OARGC(P1)	;GET NUMBER OF ENTRIES
	MOVEM A,ECNT		;REMEMBER HOW MANY ENTRIES
INTA1:	SOSGE ECNT		;ANY MORE ENTRIES?
	RET			;NO
	CAIN P2,0		;ANY ENTRY POINTER SET UP YET?
	JRST [	MOVEI P2,.OHDRS(P1) ;NO, SET UP POINTER TO FIRST ONE
		JRST INTA2]
	LOAD A,AR.LEN,ARG.HD(P2) ;YES, GET LENGTH OF ENTRY JUST PROCESSED
	ADD P2,A		;STEP TO NEXT ENTRY
INTA2:
NEWF,<
	SKIPE AUTOF		;RING BELLS IF CALLED FROM INTERRUPT
	 TYPE <>
>
	LOAD A,AR.TYP,ARG.HD(P2) ;GET FLAVOR OF ENTRY
	CAIN A,.MNRNM		;NAME?
	JRST [	MOVE A,ARG.DA(P2) ;YES, GET NAME
		MOVEM A,MNTNAM	;REMEMBER FOR ERROR MESSAGE
		JRST INTA1]
	CAIN A,.MNRTX		;TEXT?
	JRST [	UTYPE ARG.DA(P2) ;YES, PRINT IT
		JRST INTA1]	;BACK FOR NEXT ENTRY
	CAIN A,.MNREC		;ERROR MESSAGE?
	JRST [	MOVE A,ARG.DA(P2) ;YES, GET ERROR CODE
		CAIN A,MREQX1	;DID USER CANCEL THE REQUEST?
		JRST INTA1	;YES, DON'T COMPLAIN
		MOVE B,MNTNAM	;GET NAME
		LERROR <Mount request %2' failed - %1?>	;PRINT AS ERROR MESSAGE
		JRST INTA1]
	CAIN A,.MNSDV		;STRUCTURE?
	JRST DOSTR		;YES, GO HANDLE IT
	CAIE A,.MNRDV		;DEVICE DESIGNATOR
	 JRST [	LERROR <Unrecognized message from QUASAR>
		JRST INTA1]
	MOVE A,ARG.DA+1(P2)	;GET DEVICE DESIGNATOR
	ASND			;ASSIGN IT SO YOU CAN USE DEASSIGN CMD
	 JFCL
	MOVE A,CSBUFP		;SOME SPACE TO WRITE STRING
	MOVE B,ARG.DA+1(P2)	;GET DEVICE DESIGNATOR
	DEVST			;GET STRING FOR DEVICE ASSIGNED TO US
	 CALL JERR		;SHOULDN'T EVER FAIL
	MOVEI B,":"
	IDPB B,A		;PUT A COLON AFTER THE DEVICE NAME
	SETZ B,
	IDPB B,A		;TERMINATE STRING WITH A NULL
	MOVE A,ARG.DA(P2)	;GET SET NAME
	CALL GETASC		;GET ASCII FOR IT
	MOVE B,OURLOG		;USE REAL LOGICAL NAME
	MOVE C,CSBUFP		;POINTER TO REAL DEVICE IN
	MOVEI A,.CLNJB
	CRLNM			;CREATE LOGICAL NAME FOR TAPE
	 CALL CJERRE		;IF FAILS, TELL USER WHY
	MOVE A,CSBUFP		;GET POINTER TO REAL DEVICE
	ETYPE <[%2m: defined as %1m]%_>
	JRST INTA1		;GET REST OF ENTRIES

;HERE TO HANDLE MOUNTED STRUCTURE

DOSTR:	MOVE A,ARG.DA(P2)	;GET SIXBIT NAME
	CALL GETASC		;GET ASCII VERSION OF IT
	CALL IMC		;INCREMENT THE MOUNT COUNT
	JRST INTA1		;DO REST OF DEVICES IN BLOCK

;ROUTINE TO INCREMENT A MOUNT COUNT
;FEED IT POINTER TO ASCII ALIAS IN A

IMC:	STKVAR <ISTR>
	MOVEM A,ISTR		;REMEMBER WHICH STRUCTURE
	MOVE C,A		;ASCII POINTER IN C
	DMOVE A,[EXP <1,,.MSIMC>,C] ;ONE WORD,,INCREMENT MOUNT COUNT,POINTER IN C
	MSTR			;INCREMENT THE MOUNT COUNT
	 ERJMP [CALL DGETER	;GET REASON FOR FAILURE
		MOVE B,ISTR	;GET NAME OF STRUCTURE WE COULDN'T MOUNT
		CAIN A,MSTX31	;ALREADY MOUNTED?
		ETYPE <%%Structure %2m: already mounted%_>
		CAIE A,MSTX31	;REAL ERROR FOR OTHER REASONS
		LERROR <Couldn't increment mount count for %2M: - %?>
		RET]		;GO DO REST OF RESPONSE
	MOVE A,ISTR		;GET STRUCTURE THAT GOT SUCCESSFULLY MOUNTED
	ETYPE <Structure %1m: mounted%_>
	RET			;DO REST OF REQUESTS

;ROUTINE TO PROCESS ALL THE COMMAND ARGS ON THE STACK

RETRX:	MOVE A,ARGPT0		;GET INITIAL POINTER
	MOVEM A,ARGPT1		;REMEMBER HOW FAR WE'VE GOT
RETR1:	MOVE D,ARGPT1		;GET POINTER
	CAMN D,ARGPTR		;HAVE WE SCANNED ENTIRE STACK?
	RET			;YES, DONE
	DMOVE B,2(D)		;GET DATA
	ADJSP D,ALN		;STEP BEYOND THIS SLOT
	MOVEM D,ARGPT1		;REMEMBER HOW MANY ENTRIES WE'VE PROCESSED
	CALL @-ALN+1(D)		;STORE THE DATA IN THE QUASAR BLOCK
	JRST RETR1		;LOOP FOR REST OF ENTRIES

;ROUTINE TO MAKE A SUBENTRY.  IT TAKES LENGTH OF DATA IN LEFT HALF OF
;A, FLAVOR IN RIGHT HALF.  IF SUB%NI IS ON IN A, B CONTAINS ADDRESS OF DATA, SUB%NI OFF MEANS B, C, D
;CONTAINS DATA ITSELF

SUB%NI==1B0			;DATA "NOT IMMEDIATE"

SUBENT:	STKVAR <DATLEN,DATTYP,<DATA,3>,DATBTS>
	DMOVEM B,DATA		;SAVE FIRST TWO WORDS OF DATA
	MOVEM D,2+DATA		;SAVE REST OF DATA
	LOAD D,SUB%NI,A		;GET CONTROL BIT
	STOR D,SUB%NI,DATBTS	;REMEMBER IT
	TXZ A,SUB%NI		;CLEAR CONTROL BIT FROM LENGTH
	HLRZM A,DATLEN		;SAVE DATA LENGTH
	HRRZM A,DATTYP		;REMEMBER FLAVOR
	MOVE A,DATLEN		;GET DATA LENGTH
	MOVE A,DATLEN		;GET LENGTH OF DATA
	ADDI A,(Q1)		;1 FOR HEADER WORD, GET LAST ADDRESS IN SUBENTRY
	CAIL A,1000(P1)		;MAKE SURE FITS IN IPCF BLOCK
TME:	ERROR <Too many entries or switches in MOUNT command>
	MOVEI A,ARG.DA(Q1)	;GET ADDRESS OF SUBENTRY DATA
	MOVX B,SUB%NI		;BIT FOR TESTING WHETHER DATA IMMEDIATE OR NOT
	MOVEI C,DATA		;FIRST ASSUME DATA IS IN DATA CELL ITSELF
	TDNE B,DATBTS		;SKIP IF DATA IMMEDIATE
	MOVE C,DATA		;NO, GET ADDRESS OF DATA
	HRL A,C			;MAKE BLT POINTER TO DATA
	HRRZI C,-1(A)
	ADD C,DATLEN		;COMPUTE HIGHEST DESTINATION ADDRESS
	BLT A,(C)		;STORE THE DATA
	MOVEI B,ARG.DA
	ADD B,DATLEN		;GET SUBENTRY LENGTH, DATA + HEADER
	STOR B,AR.LEN,ARG.HD(Q1) ;STORE FOR QUASAR
	MOVE A,DATTYP		;GET FLAVOR
	STOR A,AR.TYP,ARG.HD(Q1) ;STORE IT FOR QUASAR
	AOS .MECNT(P2)		;KEEP TRACK OF HOW MANY SUBENTRIES
	LOAD A,AR.LEN,ARG.HD(Q1) ;GET LENGTH OF SUBENTRY
	ADDB Q1,A		;STEP Q1 TO NEXT SUBENTRY
	SUB A,P2		;GET TOTAL LENGTH OF ENTRY
	STOR A,AR.LEN,.MEHDR(P2) ;STORE TOTAL ENTRY LENGTH
	RET

;INITIALIZATION ROUTINE FOR COMMUNICATION BLOCK FOR MOUNT REQUEST

MNTINI:	SETZM IPCFP		;FILL BLOCK WITH 0'S
	MOVE A,[IPCFP,,IPCFP+1]
	BLT A,IPCFP+777
	MOVEI P1,IPCFP		;P1 POINTS TO MAIN BLOCK
	MOVEI P2,0		;SAY NO ENTRY POINTER YET
	MOVEI A,.QOMNT		;SPECIFY FLAVOR OF QUASAR MESSAGE
	STOR A,MS.TYP,(P1)
	MOVEI A,1
	STOR A,MF.ACK,.MSFLG(P1) ;SAY WE WANT AN ACKNOWLEDGMENT
	AOS A,UNIQUE		;GET UNIQUE IDENTIFICATION FOR REQUEST
	MOVEM A,QIDEN		;REMEMBER IT
	MOVEM A,.MSCOD(P1)	;IN QUASAR BLOCK TOO
	RET

;REWIND AND OTHER RELATED MAGTAPE FCNS

.UNLOA::TAPSTG
	CALL GTMTA		;GET A MAG TAPE
	CONFIRM
	MOVEI C,.MORUL		;SPECIFY UNLOAD FUNCTION
	JRST DOMTP1

.REWIN::TAPSTG
	CALL GTMTA		;GET DEVICE NAME
	MOVEI B,[FLDDB. .CMSWI,,REWSTB,,</ENTIRE-VOLUME-SET>]
	CALL FLDSKP		;READ SWITCH
	 CMERRX			;BAD SWITCH TYPED
	CALL GETKEY		;GET DATA
	CONFIRM			;GET CR
	MOVE C,P3		;GET DESIRED FUNCTION
DOMTP1:	LDF B,OF%RD		;USE READ ACCESS
DOMTOP: TLO B,(17B9)		;USE DUMP MODE
	MOVEM C,MFCN		;REMEMBER FUNCTION
	CALL OPNMTA		;SPECIAL ROUTINE FOR MTA OPEN
	MOVE B,MFCN		;RESTORE FCN CODE
	MTOPR			;DO IT
	 ERJMP [CALL DGETER	;SEE WHY FAILED
		MOVE B,MFCN
		CAIN B,.MORUL	;CHECK FOR "UNLOAD"
		CAIE A,DESX9	;ILLEGAL FUNCTION?
		CALL CJERRE	;NOT UNLOAD OR NOT EXPECTED ERROR
		ETYPE <%%Use DISMOUNT to relinquish tape obtained with MOUNT>
		MOVE A,TAPJFN	;GET JFN BACK
		JRST NOMSTS]	;GO CLOSE THE TAPE
	CAIE D,.DVMTA		;ONLY MAGTAPE HAS STATUS
	JRST NOMSTS		;GO CLOSE JFN
	GDSTS			;GET DEVICE STATUS
	CAIE C,.MOEOF		;WAS IT WRITE EOF?
	JRST NOWCK		;NO - DONT CHECK W/ENB
	TXNE B,MT%ILW		;CHECK WRITE PROTECT
	ERROR	<Device write protected>
NOWCK:	TXNE B,MT%DVE		;CHECK FOR DEVICE ERROR
	ERROR	<Device error>
NOMSTS:	CLOSF			;RELEASE DEVICE
	  CALL CJERR		;POSSIBLE NON MTA ERROR
	RET			;RETURN

;SWITCHES FOR REWIND

REWSTB:	TABLE
	T CURRENT-VOLUME-ONLY,,.MORVL	;REWIND CURRENT VOLUME
	T ENTIRE-VOLUME-SET,,.MOREW	;REWIND ENTIRE TAPE (MORE USUAL)
	TEND

;EOF

.EOF::	TAPSTG
	CALL GTMTA		;GET DEVICE NAME (JFN IN A)
	CONFIRM			;GET CR
	MOVEI C,.MOEOF	;SAY "EOF"
	LDF B,OF%WR		;OPEN FOR WRITE
	JRST DOMTOP		;PERFORM REMAINING CODE
;SKIP (FILE,RECORD,LEOT)

.SKIP::	TAPSTG
	CALL GTMTA		;GET DEVICE NAME
	MOVEI B,[FLDDB. .CMNUM,CM%SDH,5+5,<Decimal number of files or records to skip>,1,[
		 FLDDB. .CMKEY,,[1,,1
				 T LEOT]]]
	CALL FLDSKP
	 CMERRX
	LOAD D,CM%FNC,.CMFNP(C)	;GET FLAVOR OF INPUT
	CAIN D,.CMKEY		;KEYWORD?
	JRST [	CALL GETKEY	;YES, SEE WHICH
		JRST (P3)]	;GO DO IT
	MOVEM B,BNUM		;REMEMBER COUNT
	KEYWD $SKIPT		;GET KEYWORD
	 T FILES,ONEWRD,..SKPF	;DEFAULT TO FILE
	 JRST CERR		;COMMAND ERROR
	JRST	(P3)		;DISPATCH

$SKIPT:	TABLE
	T FILES,ONEWRD,..SKPF
	T LEOT,ONEWRD,..SKPL
	T RECORDS,ONEWRD,..SKPR
	TEND

..SKPF:	SKIPA A,[.MOFWF]
..SKPR:	MOVEI A,.MOFWR		;RECORDS
	MOVEM A,MFCN		;SAVE OPERATION
	CALL .SKCOM		;CALL COMMON ROUTINE
	  ERROR	<Device or data error>
.SKPX:	MOVE A,TAPJFN		;JFN
	CLOSF			;CLOSE AND RELEASE
	  CALL JERR		;WHOOPS
	RET			;AND EXIT

.LEOT:	CONFIRM			;DOES HE MEAN IT?
..SKPL:	MOVEI C,.MOEOT		;SKIP TO LOGICAL EOT
	LDF B,OF%RD		;READ ACCESS
	JRST DOMTOP		;PERFORM REST
;COMMON ROUTINE FOR .SKIP AND .BACKS TO REPEAT OPERATION

.SKCOM:	LDF B,17B9+OF%RD	;OPEN DUMP MODE , READ
	CALL OPNMTA		;CALL SPECIAL ROUTINE TO OPEN
	MOVE A,MFCN		;GET FUNCTION BEGIN DONE
	CAIE A,.MOBKR		;CAN'T MOVE IN UNITS OF RECORDS ON labelED
	CAIN A,.MOFWR		;TAPES, SINCE OPNMTA MOVES THE TAPE
	JRST [	MOVE A,TAPJFN	;TELL LBLSKP WHICH TAPE TO CHECK
		CALL LBLSKP
		 JRST .+1	;NO LABELLED, O.K.
		ERROR <Illegal operation for labeled tape>]
	MOVE A,TAPJFN
.SKLUP:	MOVE B,MFCN		;FCN CODE
	SOSGE	BNUM		;MORE TO DO?
	RETSKP			;GIVE GOOD RETURN
	MTOPR			;GRONK
	 ERCAL CJERRE		;ON "SKIP 1" WHEN AT LEOT, TELL USER HE LOST
	GDSTS			;CHECK ON STATUS
	TXNE B,MT%DVE!MT%DAE!MT%BOT ;CHECK ERRORS
	RET			;GIVE ERROR RETURN
	JRST .SKLUP		;LOOP

;BACKSPACE (FILE,RECORD)

.BACKS::TAPSTG
	CALL GTMTA		;GET DEVICE NAME
	DEFX <1>		;DEFAULT IS 1
	DECX <Decimal number of files or records to backspace>
	 CMERRX
	MOVEM B,BNUM		;SAVE COUNT
	KEYWD $BACKT		;GET KEYWORD
	 T FILES,ONEWRD,..BCKF	;DEFAULT TO FILE
	 JRST CERR		;COMMAND ERROR
	JRST	(P3)		;DISPATCH

$BACKT:	TABLE
	T FILES,ONEWRD,..BCKF
	T RECORDS,ONEWRD,..BCKR
	TEND
..BCKF:	MOVEI D,.MOBKF
	MOVEM D,MFCN		;REMEMBER FUNCTION
	AOS BNUM		;DO N+1 FILES
	CALL .SKCOM		;COMMON CODE
	  JRST .BCKER		;BACKSPACE ERROR ROUTINE
	MOVE A,TAPJFN		;GET JFN
	MOVEI B,.MOFWR		;SKIP OVER TAPE MARK
	MTOPR			;...
	JRST .SKPX		;EXIT FROM THIS MADNESS

..BCKR:	MOVEI D,.MOBKR		;FUNCTION
	MOVEM D,MFCN
	CALL .SKCOM		;DO IT
	  JRST .BCKER		;ERROR
	JRST .SKPX		;ALL DONE

.BCKER:	TXNN B,MT%BOT		;FOUND BOT?
	ERROR	<Device or data error>
	SKIPG	BNUM		;EXACTLY MADE IT?
	JRST .SKPX		;YES - ALL DONE
	ERROR	<Load point reached before end of backspace request>
;ROUTINE TO GET JFN FOR A MTA AND CHECK VALID TAPE UNIT

GTMTA:	NOISE	<DEVICE>
	DEVX 	<Name of tape unit>
	 CMERRX			;NON-DEVICE TYPED
	CALL BUFFF		;SAVE NAME TYPED
	MOVEM A,GTP0		;SAVE POINTER TO DEVICE NAME
	MOVE A,B		;DEVICE DESIG TO A
	DVCHR			;GET DEVICE CHARACTERISTICS
	LDB D,[POINTR (B,DV%TYP)]
	CAIN D,.DVDTA		;DEC-TAPE
	JRST	[TLO A,(<1B3>)	;SET NO DIRECTORY BIT
		 MOUNT		;DO MOUNT FCN
		   CALL CJERR	;USER LOSAGE
		 JRST GTMTA2]	;JOIN COMMON CODE
	CAIE D,.DVMTA		;BETTER BE A MTA
	ERROR	<%1H: Device is not a magtape>
GTMTA2:	HLRE C,C		;JOB # TO RHS IF NOT AVAIL
	CALL CHKAV		;CHECK AVAILABILITY
	HRROI A,GTMBUF
	MOVE B,GTP0
	MOVEI C,0
	SOUT			;CREATE COPY OF STRING TO DIDDLE
	HRROI B,[ASCIZ /:/]
	SOUT			;PUT COLON AFTER DEVICE
	HRROI B,GTMBUF		;POINT AT DEVICE
	LDF A,GJ%SHT		;SHORT FORM
	CALL GTJFS		;TRY TO GET JFN
	  CALL 	CJERR		;SHOULDN'T HAPPEN
	MOVEM A,TAPJFN		;REMEMBER JFN
	RET			;RETURN
;ASSIGN <DEVICE>

.ASSIG::NOISE <DEVICE>
	CALL DEVN		;READ DEVICE NAME, CHECK IT.
				;...RETURNS DEV DESGNATOR IN A,
				;...CHARACTERISTICS IN B, JOB # ASS TO IN C.
	CONFIRM
	TXNN B,DV%AS
	ERROR <%1H: Cannot be assigned>
	CALL CHKAV		;CHECK IF AVAILABLE
	TXNE B,DV%ASN		;IF "ASSIGNED" BIT ALSO ON, ASSIGD TO SELF.
	TYPE < [Already assigned to you] > ;ADVISORY MSG, NOT ERROR
	ASND
	 CALL CJERR
	JRST CMDIN4

;ROUTINE TO CHECK IF DEVICE IS AVAILABLE TO THIS JOB
;C(B) := DEVCHR BITS, C(A) := DEVICE NAME, C(C) := DEVUNT INFO

CHKAV:	STKVAR <SAVDEV,SAVCHR,SAVJOB,CHKSFX>
	MOVEM A,SAVDEV
	MOVEM B,SAVCHR		;SAVE DEVICE AND CHARACTERISTICS
	MOVEM C,SAVJOB
	SETZM CHKSFX		;NO SUFFIX YET
	TXNE B,DV%AV		;"AVAILABLE" BIT
	RET			;YES - RETURN
	LDB D,[POINTR (A,DV%TYP)]
	CAMN C,[-2]		;SPECIAL ERROR
	JRST CHKAV1		;ALLOCATER HAS IT
	CAIN D,.DVMTA		;MAGTAPE?
	JRST [	CALL MTLSKP	;YES, SEE IF TAPE ALLOCATION IS ENABLED
		 JRST .+1	;NO
		HRROI A,[ASCIZ / - Use MOUNT command/]
		MOVEM A,CHKSFX
		JRST .+1]
	MOVE A,SAVDEV
	MOVE B,SAVCHR		;MTLSKP CLOBBERED THESE
	MOVE C,SAVJOB
	MOVE D,CHKSFX		;GET POSSIBLE SUFFIX
	TXNN B,DV%ASN		;NOT AVAILABLE - ASSIGNED?
	ERROR <%1H: Already open by job %3Q%%4M>
	ERROR <%1H: Already assigned to job %3Q%%4M>

CHKAV1:	ERROR <%1H: Unavailable, under control of allocator>

;DEASSIGN <DEVICE NAME>
;ACCEPTS LOGICAL OR REAL DEVICE NAME

.DEASS::NOISE <DEVICE>
	STARX <Device name or * for all>
	 JRST DEAS1		;NOT "DEASSIGN *"
	MOVNI A,1		;YES - SET TO RELEASE ALL
	JRST DEAS2		;GO DO IT

DEAS1:	DEVX			;NOT "DEASSIGN *", CHECK FOR REAL DEVICE
	 CMERRX			;NOT THAT EITHER!
				;NOW HAVE DEVICE DESGNATOR IN A, DEVCHR WORD IN B
	MOVE A,B		;PUT DESIGNATOR IN A
	DVCHR			;GET CHARACTERISTICS
	TXNN B,DV%ASN
	ERROR <%1H: not assigned>
	TXNN B,DV%AV
	ERROR <%1H: not assigned to you>
DEAS2:	CONFIRM
	RELD
	 CALL CJERRE
	JRST CMDIN4

;SPECIAL ROUTINE TO DO OPENF FOR MTA. CHECKS FOR "ILLEGAL
;SIMULTANEOUS ACCESS" RETURN AND LOOKS FOR OTHER JFN ASSIGNED
;TO THE SAME DEVICE. GIVES USER OPTION OF CLOSING JFN OR
;TERMINATING COMMAND WITHOUT HAVING TO RE-TYPE COMMAND.

; B/ FLAGS FOR OPENF

OPNMTA:	MOVE A,TAPJFN		;GET JFN
	CALLRET OPNMAG		;OPEN MAG TAPE AND RETURN
; CJDEV - GIVEN A DEVICE DESIGNATOR, FIND AN OPEN JFN FOR THAT DEVICE
;	  AND ASK THE USER IF HE WANTS TO CLOSE IT
;  A/ DEVICE DESIGNATOR
; RETURNS +1: COULD NOT FIND A JFN OPENED TO SPECIFIED DEVICE
;	  +2: JFN FOUND AND CLOSED AT USER'S REQUEST
;	  ERROR EXIT TAKEN IF USER DIDN'T WANT TO CLOSE JFN

CJDEV::	MOVE D,A		;SAVE DESIGNATOR
	MOVEI Q1,MAXJFN		;SET UP TO SCAN ALL JFN'S
CJDEV1:	MOVE A,Q1		;GET JFN TO BE TESTED
	GTSTS			;GET ITS STATUS
	TXNE B,GS%NAM		;REJECT IF NOT IN USE
	TXNN B,GS%OPN		;REJECT IF NOT OPEN
	JRST CJDEV2		;REJECTED
	DVCHR			;JFN IS OPEN, GET ITS DESIGNATOR
	CAME A,D		;DOES IT MATCH THE INPUT?
CJDEV2:	SOJG Q1,CJDEV1		;NO, LOOP THRU ALL JFN'S
	SKIPG A,Q1		;DID I FIND ONE?
	RET			;NO
	ETYPE <?Device %4H: open on JFN %1P%%_>
	PROMPT <%Close JFN? >	;ASK THE QUESTION
	SETZ Z,			;INITIALIZE FLAGS
	KEYWD CJDTB
	 T YES,,CJDYES
	 JRST CERR		;ERROR
	CONFIRM			;PARSE CRLF
	JRST (P3)		;DISPATCH

CJDTB:	TABLE
	T NO,,[ERROR <Command aborted...>]
	T YES,,CJDYES
	TEND

CJDYES:	MOVE A,Q1		;GET JFN TO BE RELEASED
	CALL JFNRLA		;RELEASE JFN WITH ABORT
	 JFCL			;IGNORE ERRORS
	RETSKP
;ROUTINE WHICH SKIPS IF TAPE ALLOCATION IS ENABLED

MTLSKP:	MOVEI A,.SFMTA		;CODE FOR CHECKING TAPE ALLOCATION
	TMON			;ASK MONITOR IF IT'S ENABLED
	JUMPN B,RSKP		;SKIP IF ENABLED
	RET

;ROUTINE WHICH SKIPS IF TAPE IS LABELED
;GIVE IT TAPE JFN IN A
;IF IT SKIPS, A CONTAINS THE LABEL TYPE

TBLEN==.MOMTP+1			;ALLOCATE ENOUGH WORDS FOR LABEL TYPE

LBLSKP::STKVAR <TJFN,<TB,TBLEN>>
	MOVEM A,TJFN		;REMEMBER TAPE JFN
	MOVEI A,TBLEN		;ALLOCATE BLOCK SIZE
	MOVEM A,TB
	MOVE A,TJFN		;GET JFN OF TAPE
	MOVEI B,.MORLI		;READ LABEL INFO
	MOVEI C,TB		;POINT TO ARGUMENT BLOCK
	MTOPR			;GET LABEL INFO
	 ERJMP R		;FAILS FOR MTA DEVICE, HENCE UNLABELED
	MOVE A,.MOMTP+TB	;GET LABEL TYPE
	CAIE A,.LTUNL		;UNLABELED?
	RETSKP			;LABELED, SKIP
	RET			;UNLABELED, DON'T.
END