Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/execmt.mac
There are 43 other files named execmt.mac in the archive. Click here to see a list.
;713 add literals label
;712 DEC release version
; 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
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;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
; DISK AND TAPE MOUNTING STUFF
; 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
GTFLDT 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?
ABSKP ;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
GTFLDT D ;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
MOVX 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
NOP ;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
NOP ;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: GTFLDT 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 [MOVX 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>>
MOVX 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,,<a comma to specify another VOLID>,,
FBLOCK]
CALL FLDSKP
CMERRX <Invalid VOLID>
GTFLDT D
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
MOVX A,2 ;GET A TWO-WORD BLOCK
CALL GETBUF
MOVE C,NAM ;GET VOLID NAME
MOVX 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
ADDI B,1 ;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
SETZ C, ;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: MOVX A,.MNTTP ;SAY IT'S TAPE
CALLRET ITM2
;IDENTIFY DISMOUNTING DISK
DDSK2: MOVX A,.DSMST
CALLRET ITM2
;HERE FOR "DISK" KEYWORD
DSK2: MOVX 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: MOVX 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
;ROUTINE SETS UP ADDRESSES TO CALL TO PROCESS ITEMS AFTER WHOLE MOUNT COMMAND
; IS CONFIRMED
;
; ACCEPTS: A/ ADDRESS TO CALL TO PROCESS ITEM
; B,C/ DATA
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
MOVX 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
MOVX 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
SETZ P2, ;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
NOP
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
MOVX 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
MOVX 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
;
; ACCEPTS: A/ POINTER TO ASCII ALIAS
IMC: STKVAR <ISTR>
MOVEM A,ISTR ;REMEMBER WHICH STRUCTURE
MOVE C,A ;ASCII POINTER IN C
DMOVE A,[1,,.MSIMC
C] ;ONE WORD,,INCREMENT MOUNT COUNT,PNTR 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.
;
; ACCEPTS: A/ LH IS LENGTH OF DATA
; SUB%NI ON MEANS B CONTAINS ADDRESS OF DATA
; OFF MEANS B,C,D CONTAINS DATA ITSELF
; B,C,D/ SEE ABOVE
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
MOVX 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
SETZ P2, ;SAY NO ENTRY POINTER YET
MOVX A,.QOMNT ;SPECIFY FLAVOR OF QUASAR MESSAGE
STOR A,MS.TYP,(P1)
MOVX 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
MOVX 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: TXO B,FLD(.GSDMP,OF%MOD) ;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
MOVX 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,^D10,<a decimal number of files or
records to skip>,1,[
FLDDB. .CMKEY,,[1,,1
T LEOT]]]
CALL FLDSKP
CMERRX
GTFLDT D ;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: MOVX 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: MOVX 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,FLD(.GSDMP,OF%MOD)!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: MOVX 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 [TXO 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
SETZ C,
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
RET ;7 style
;7 JRST CMDIN4
;ROUTINE TO CHECK IF DEVICE IS AVAILABLE TO THIS JOB
;
; ACCEPTS: A/ DEVICE NAME
; B/ DVCHR% BITS
; 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 *"
SETO A, ;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.
;
; ACCEPTS: 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
;
; ACCEPTS: 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
MOVX 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
NOP ;IGNORE ERRORS
RETSKP
;ROUTINE WHICH SKIPS IF TAPE ALLOCATION IS ENABLED
MTLSKP: MOVX 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
MOVX A,TBLEN ;ALLOCATE BLOCK SIZE
MOVEM A,TB
MOVE A,TJFN ;GET JFN OF TAPE
MOVX 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.
LITSMT: ;713 debugging aid: literals label
END