Google
 

Trailing-Edge - PDP-10 Archives - BB-M080Y-SM - exec/execmt.mac
There are 43 other files named execmt.mac in the archive. Click here to see a list.
; Edit= 4449 to EXECMT.MAC on 22-May-90 by GSCOTT
;Update copyright notice as needed. 
; Edit= 4428 to EXECMT.MAC on 22-Sep-89 by GSCOTT
;Improve error message when the ASSIGN command fails.
; UPD ID= 4124, RIP:<7.EXEC>EXECMT.MAC.2,   7-Mar-88 18:24:12 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 234, SNARK:<6.1.EXEC>EXECMT.MAC.5,  10-Jun-85 08:44:27 by DMCDANIEL
; UPD ID= 176, SNARK:<6.1.EXEC>EXECMT.MAC.4,   3-May-85 08:31:37 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 125, SNARK:<6.1.EXEC>EXECMT.MAC.3,  15-Jan-85 09:05:55 by EVANS
;TCO 6.1.1130 - Remove part of help message that asks for colon after structure
;		name .
; UPD ID= 25, SNARK:<6.1.EXEC>EXECMT.MAC.2,   1-Oct-84 22:40:47 by PRATT
;TCO 6.1.1019 - Make some commands not require the ":" on devices
; UPD ID= 339, SNARK:<6.EXEC>EXECMT.MAC.10,  20-Nov-83 19:44:56 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 244, SNARK:<6.EXEC>EXECMT.MAC.9,  15-Jan-83 19:24:59 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 139, SNARK:<6.EXEC>EXECMT.MAC.8,   4-Aug-82 17:25:59 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 96, SNARK:<6.EXEC>EXECMT.MAC.6,   8-Jan-82 15:56:14 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 49, SNARK:<6.EXEC>EXECMT.MAC.5,   9-Sep-81 10:06:39 by CHALL
;TCO 5.1492 $BACKS- PUT ONEWRD FLAGS IN BACKSPACE OPTION TABLE
; UPD ID= 34, SNARK:<6.EXEC>EXECMT.MAC.4,  17-Aug-81 13:26:41 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= 2001, SNARK:<6.EXEC>EXECMT.MAC.2,  14-May-81 15:24:17 by MURPHY
;GLXSCH
; 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

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1990.
;	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.
	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)
	SETZ B,			;NO SPECIAL HELP
	CALL STRN		;GET STRUCTURE
	 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,CM%NSF]]
	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)
	HRROI B,[ASCIZ/Name of tape to dismount/]
	CALL DEVN		;GET DEVICE
	 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)
	HRROI B,[ASCIZ/Logical name, first six characters will be tape set name/]
	SKIPN TAPEF		;DIFFERENT HELP FOR DISK
	HRROI B,[ASCIZ/Name structure will be referred to as, six characters or less/]
	CALL STRN		;PARSE THE STRUCTURE
	 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
MNTC2:	MOVE A,SNXT		;GET NEXT BLOCK ADDRESS TO DO
	MOVEM A,NOWPTX
	JRST MNTC1		;CONTINUE SCANNING TO SEE WHAT'S BEEN ANSWERED

MNTC4:	SKIPGE OLDIDX		;IS THERE AN IPCF MESSAGE WAITING?
	JRST MNTC2		;NO - CONTINUE
	CALL IPCFLM		;YES - READ IN MESSAGE, FLUSHING OLD ONE
	JRST MNTC3		;GO CHECK OUT THE MESSAGE
;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:
	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>
	HRROI B,[ASCIZ/Name of tape unit/]
	CALL DEVN		;PARSE THE DEVICE
	 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>
	SETZ B,			;USE DEFAULT HELP STRING
	CALL DEVN		;READ DEVICE NAME, CHECK IT.
	 CMERRX			;...RETURNS DEV DESGNATOR IN A,
	CALL DVC		;...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

;HERE TO GET DVCHR WORD FOR DEVICE DESIGNATOR IN A
;
;RETURNS:
;  A:  DEVICE DESIGNATOR
;  B:  CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS THEREOF:
;	B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB
;	B6: ON IF ASSIGNED
;	    BOTH B5 & B6 ON IF ASSIGNED TO SELF
;  C:  JOB # ASSIGNED TO IF B6 OF B ON

DVC:	MOVE A,B
	DVCHR			;GET CHARACTERISTICS WORD
	HLRE C,C
	RET
;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)] ;[4428] Load device type
	CAIE D,.DVMTA		;[4428] Magtape device?
	IFSKP.			;[4428] Yes, magtape device
	  CALL MTLSKP		;[4428] (/) See if tape allocation is enabled
	   TDZA D,D		;[4428] Tape allocation is not enabled
	  HRROI D,[ASCIZ /
 Use MOUNT command to access magtape devices/] ;[4428] Ask for it buddy
	  MOVEM D,CHKSFX	;[4428] Save the suffix for the user
	  MOVE A,SAVDEV		;[4428] Restore device designator
	  MOVE B,SAVCHR		;[4428]  and dev char that MTLSKP clobbered
	  SKIPN C,SAVJOB	;[4428] Is device open by job 0?
	  ERROR <%1H: Not known to this system%4M> ;[4428]
	ENDIF.			;[4428] 
	MOVE D,CHKSFX		;GET POSSIBLE SUFFIX
	CAMN C,[-2]		;[4428] Under control of allocator?
	ERROR <%1H: Under control of allocator%4M> ;[4428] Yes
	TXNN B,DV%ASN		;NOT AVAILABLE - ASSIGNED?
	ERROR <%1H: Already open by job %3Q%%4M>
	ERROR <%1H: Already assigned to job %3Q%%4M>
;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:	SETZ B,			;USE DEFAULT HELP
	CALL DEVN		;NOT "DEASSIGN *", CHECK FOR REAL DEVICE
	 CMERRX			;NOT THAT EITHER!
	CALL DVC		;GET DVCHR INFO
	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