Google
 

Trailing-Edge - PDP-10 Archives - BB-M081Z-SM - monitor-sources/tape.mac
There are 50 other files named tape.mac in the archive. Click here to see a list.
; Edit= 9011 to TAPE.MAC on 8-Nov-88 by LOMARTIRE
;Merge Production changes to BUG text
; Edit= 8942 to TAPE.MAC on 25-Aug-88 by GSCOTT
;Update BUG. documentation. 
; Edit= 8858 to TAPE.MAC on 11-Jul-88 by GSCOTT, for SPR #21894
;Fix "Invalid tape HDR1 sequence number" errors on second reel of multi reel
;saveset because DUMPER does not CLOSF the tape between savesets. 
; UPD ID= 8628, RIP:<7.MONITOR>TAPE.MAC.5,  11-Feb-88 18:54:33 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8333, RIP:<7.MONITOR>TAPE.MAC.4,  31-Dec-87 10:49:38 by RASPUZZI
;TCO 7.1169 - Prevent SDSTS% and GDSTS% from leaving file locked.
; UPD ID= 141, RIP:<7.MONITOR>TAPE.MAC.3,  25-Sep-87 11:17:49 by GSCOTT
; TCO 7.1064 - Allow 17 character filenames, treat file generation and 
; generation version fields as per DEC STD 149 (18-Jan-79), SPR #20419
; *** Edit 7446 to TAPE.MAC by RASPUZZI on 14-Apr-87, for SPR #00070
; Make sure GDSTS% returns an illegal instruction trap instead of OPNX8 in T2!
; *** Edit 7438 to TAPE.MAC by RASPUZZI on 7-Apr-87, for SPR #21584
; Prevent strange BUGHLTs (ILMNRF, ILLUUO, MSCBAD, etc) when GDSTS% comes into
; tape and does not pass a blocking routine in T3.
; *** Edit 7429 to TAPE.MAC by EVANS on 31-Mar-87, for SPR #16333
; Make LW.ABH return an error code. 
; UPD ID= 2192, SNARK:<6.1.MONITOR>TAPE.MAC.26,   5-Jun-85 11:10:51 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1936, SNARK:<6.1.MONITOR>TAPE.MAC.25,   7-May-85 22:51:31 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1107, SNARK:<6.1.MONITOR>TAPE.MAC.24,  20-Nov-84 08:02:53 by SHTIL
; TCO 6.2279 Make the monitor read RT11 labeled tapes.
; UPD ID= 4946, SNARK:<6.MONITOR>TAPE.MAC.23,  17-Oct-84 11:57:43 by TGRADY
; QAR 706272 - Remove edit 4509, TCO 6.2126 - unnecessary edit.
; UPD ID= 4855, SNARK:<6.MONITOR>TAPE.MAC.22,  20-Sep-84 09:11:51 by GLINDELL
;TCO 6.2209 - Allow MTOPR .MOIEL for non-open JFN's
; UPD ID= 4687, SNARK:<6.MONITOR>TAPE.MAC.21,  14-Aug-84 13:47:49 by MCLEAN
;TCO 6.2134
;ADD ACJ CHECK FOR LABELED TAPES
; UPD ID= 4532, SNARK:<6.MONITOR>TAPE.MAC.20,  14-Jul-84 10:01:49 by PURRETTA
;Update copyright notice and remove wigets in comments
; UPD ID= 4509, SNARK:<6.MONITOR>TAPE.MAC.19,  12-Jul-84 21:57:39 by TGRADY
;TCO 6.2126 Use Global job number for GETOK% .GOMTA function
; UPD ID= 4391, SNARK:<6.MONITOR>TAPE.MAC.18,  27-Jun-84 12:03:49 by HAUDEL
;TCO 6.2109 - ADD A COMMENT
; UPD ID= 3878, SNARK:<6.MONITOR>TAPE.MAC.17,   7-Mar-84 21:37:11 by MOSER
;TCO 6.1984 - ADD .MOIRB MTOPR
; UPD ID= 2412, SNARK:<6.MONITOR>TAPE.MAC.16,   3-May-83 16:21:59 by COBB
;TCO 6.1639 - ?s to PRINTX messages...
; UPD ID= 1808, SNARK:<6.MONITOR>TAPE.MAC.15,  15-Feb-83 08:45:12 by COBB
;TCO 6.1505 - Use MTLFCN to call MAGTAP on MTOPR% .MORRS (read record size)
; UPD ID= 1557, SNARK:<6.MONITOR>TAPE.MAC.14,  21-Dec-82 11:53:13 by MOSER
;TCO 6.1422 - WRITE STANDARD VALUE FOR RECORD SIZE IN HDR2 FOR FORMAT:D
; UPD ID= 1556, SNARK:<6.MONITOR>TAPE.MAC.13,  21-Dec-82 11:46:06 by MOSER
;TCO 6.1421 - DON'T SKIP FILES WITH SAME NAME AS PREVIOUS
; UPD ID= 1492, SNARK:<6.MONITOR>TAPE.MAC.12,  30-Nov-82 15:33:47 by MOSER
;TCO 6.1130 - MAKE .MOSRS ILLEGAL FOR LABELLED TAPES
; UPD ID= 1305, SNARK:<6.MONITOR>TAPE.MAC.11,   8-Oct-82 15:35:10 by MOSER
;TCO 6.1291 - DON'T APPEND CRLF AFTER SETTING .MONTR, MAKE LEGAL IF UNOPENED
; UPD ID= 1170, SNARK:<6.MONITOR>TAPE.MAC.10,  13-Sep-82 15:39:13 by MOSER
;TCO 6.1261 - ALLOW EBCDIC TAPES WITH STRANGE VOLUME SWITCH FIELD
; UPD ID= 1167, SNARK:<6.MONITOR>TAPE.MAC.9,  13-Sep-82 12:51:51 by MOSER
;TCO 6.1260 - ALLOW RECORD SIZE 0 FOR FORMAT D
; UPD ID= 1066, SNARK:<6.MONITOR>TAPE.MAC.8,   9-Aug-82 16:20:44 by PAETZOLD
;TCO 6.1219 - Extend MTDTB for RLJFD
; UPD ID= 957, SNARK:<6.MONITOR>TAPE.MAC.7,  23-Jun-82 17:35:58 by WALLACE
;TCO 6.1176 Preserve U and IOS because MTATR clobbers them and GTJFN
;  does not expect this.
; UPD ID= 861, SNARK:<6.MONITOR>TAPE.MAC.6,   7-Jun-82 09:41:29 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 437, SNARK:<6.MONITOR>TAPE.MAC.5,   5-Mar-82 11:14:20 by MILLER
;TCO 6.1065. FIX MTATR
;TCO 5.1653. FIX HANDLING OF JFN REASSIGNED
; UPD ID= 106, SNARK:<6.MONITOR>TAPE.MAC.3,  14-Oct-81 13:47:49 by SCHMITT
;TCO 5.1557 - Do not check protection on non RACF protected files
;<6.MONITOR>TAPE.MAC.2,  5-Oct-81 14:05:31, EDIT BY MURPHY
;REVISE DTB FORMAT; GET RID OF DOUBLE SKIPS ON NLUKD, ETC.
; UPD ID= 238, SNARK:<5.MONITOR>TAPE.MAC.27,   2-Oct-81 13:15:17 by SCHMITT
;TCO 5.1551 - Change MTOPR dispatch table to open tape on various functions
; UPD ID= 2228, SNARK:<5.MONITOR>TAPE.MAC.26,  19-Jun-81 13:47:44 by MILLER
;tco 6.1021.
; UPD ID= 2165, SNARK:<5.MONITOR>TAPE.MAC.25,  10-Jun-81 10:12:48 by SCHMITT
;TCO 5.1367 - Save prevailing data modes over rewind
; UPD ID= 2149, SNARK:<5.MONITOR>TAPE.MAC.24,   8-Jun-81 15:17:46 by SCHMITT
;TCO 5.1363 - Fix check for new block at SQGBYT
; UPD ID= 2005, SNARK:<5.MONITOR>TAPE.MAC.23,  14-May-81 23:54:20 by ZIMA
;TCO 5.1330 - Correct the labeled tape MTOPR dispatch table.
; UPD ID= 2004, SNARK:<5.MONITOR>TAPE.MAC.22,  14-May-81 23:25:29 by ZIMA
;TCO 5.1328 - correct EBCDIC tape code/case conversion.
; UPD ID= 1984, SNARK:<5.MONITOR>TAPE.MAC.21,  13-May-81 12:07:16 by SCHMITT
;TCO 5.1325 - Check for dump mode tape in MTGSX0
; UPD ID= 1969, SNARK:<5.MONITOR>TAPE.MAC.20,   8-May-81 17:13:12 by SCHMITT
;More TCO 5.1283 - Do an MCALL to MTFLSH rather than a CALL
; UPD ID= 1932, SNARK:<5.MONITOR>TAPE.MAC.19,   4-May-81 12:56:16 by SCHMITT
;TCO 5.1305 - Backspace extra record at REPOS1 and forward space over it
; UPD ID= 1876, SNARK:<5.MONITOR>TAPE.MAC.18,  23-Apr-81 17:20:01 by LYONS
;RETURN GJFX53 WHERE RIGHT TO DO IT
; UPD ID= 1810, SNARK:<5.MONITOR>TAPE.MAC.17,  15-Apr-81 16:15:17 by SCHMITT
;TCO 5.1283 - Fix read errors when hitting EOF for labeled tapes
; UPD ID= 1169, SNARK:<5.MONITOR>TAPE.MAC.16,  17-Oct-80 11:43:38 by MOSER
;TCO 5.1175 - Preserve record size when doing volume switch
; UPD ID= 1095, SNARK:<5.MONITOR>TAPE.MAC.15,   1-Oct-80 15:51:46 by MURPHY
;DITTO
; UPD ID= 1079, SNARK:<5.MONITOR>TAPE.MAC.14,   1-Oct-80 11:40:10 by MURPHY
;FIX UP ACVAR, ETC.
; UPD ID= 1039, SNARK:<5.MONITOR>TAPE.MAC.13,  24-Sep-80 15:20:45 by SCHMITT
;TCO 5.1154 - Do not enforce form control on EBCDIC labeled tapes
; UPD ID= 1038, SNARK:<5.MONITOR>TAPE.MAC.12,  24-Sep-80 15:07:01 by ZIMA
;TCO 5.1155 - return GJFX53 error on filename length errors.
; UPD ID= 903, SNARK:<5.MONITOR>TAPE.MAC.11,  15-Aug-80 09:35:14 by SANICHARA
;
;TCO 5.1133 - GIVE CORRECT EBCDIC VALUE TO COLON
; UPD ID= 839, SNARK:<5.MONITOR>TAPE.MAC.10,   5-Aug-80 11:38:08 by MILLER
;MORE TCO 5.1103. ALWAYS TO REPOS HACK AT ER.RDY
; UPD ID= 761, SNARK:<5.MONITOR>TAPE.MAC.8,  17-Jul-80 13:40:30 by MILLER
;MORE TCO 5.1103. FIX TYPEO
; UPD ID= 760, SNARK:<5.MONITOR>TAPE.MAC.7,  16-Jul-80 17:19:31 by SCHMITT
; UPD ID= 759, SNARK:<5.MONITOR>TAPE.MAC.6,  16-Jul-80 16:03:37 by MILLER
;TCO 5.1103. GET AROUND RACE IN MAGTAP
; UPD ID= 650, SNARK:<5.MONITOR>TAPE.MAC.5,  16-Jun-80 13:09:26 by SCHMITT
;TCO 5.1067 - Fix output to fixed format tapes to pad when buffer .LT. Rec Size
; UPD ID= 517, SNARK:<5.MONITOR>TAPE.MAC.4,  13-May-80 15:42:13 by MILLER
;TCO 5.1036 AGAIN. CLEAN UP CODE
; UPD ID= 514, SNARK:<5.MONITOR>TAPE.MAC.3,  12-May-80 14:49:03 by MILLER
;TCO 5.1036. MAKE GEN AND GEN VERSION CONFORM TO DEC STD.
; UPD ID= 484, SNARK:<4.1.MONITOR>TAPE.MAC.665,  27-Apr-80 16:08:23 by DBELL
;TCO 4.1.1150 - FIX AOBJN LOOP IN MTCLVA ROUTINE
; UPD ID= 386, SNARK:<4.1.MONITOR>TAPE.MAC.664,  27-Mar-80 15:36:33 by MILLER
;FIX TYPEO IN PREVIOUS EDIT
; UPD ID= 385, SNARK:<4.1.MONITOR>TAPE.MAC.663,  27-Mar-80 15:21:36 by MILLER
;TCO 4.1.1128. FIX DEFAULT BLOCK AND RECORD CODE
; UPD ID= 369, SNARK:<4.1.MONITOR>TAPE.MAC.662,  26-Mar-80 11:09:20 by DBELL
;TCO 4.1.1120 - FIX AOBJN LOOP IN MTCLVL ROUTINE
;<4.1.MONITOR>TAPE.MAC.661, 19-Nov-79 14:37:21, EDIT BY MILLER
;DON'T SET ACRLFF IF TPUED IN OPEN
;<4.1.MONITOR>TAPE.MAC.660, 13-Nov-79 11:48:54, EDIT BY MILLER
;<4.1.MONITOR>TAPE.MAC.659, 13-Nov-79 11:16:05, EDIT BY MILLER
;ADD TPOP0 TO TRY AND FIX RACE IN MTOPN
;<4.MONITOR>TAPE.MAC.658, 30-Oct-79 08:31:39, EDIT BY R.ACE
;TCO 4.2559 - FIX .MOSDS FUNCTION TO PERMIT ANSI LABEL TYPE
;<4.MONITOR>TAPE.MAC.657, 29-Oct-79 14:47:44, EDIT BY R.ACE
;FIX MTMSG BUG INVOCATION TO AGREE WITH BUGS.MAC
;<4.MONITOR>TAPE.MAC.656, 25-Oct-79 11:35:37, EDIT BY MILLER
;FIX MTLFCN TO NOT SAVE T1 OVER CALL TO MTAOPN
;<4.MONITOR>TAPE.MAC.655,  2-Oct-79 14:27:57, EDIT BY MILLER
;RANDOM FIXES FOR LARGE BLOCK SIZES
;<4.MONITOR>TAPE.MAC.654,  2-Oct-79 12:36:17, EDIT BY MILLER
;FIX BUG IN SQOSRF
;<4.MONITOR>TAPE.MAC.653, 26-Sep-79 16:00:08, EDIT BY HALL
;PUTVOL - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<4.MONITOR>TAPE.MAC.652, 24-Sep-79 08:37:12, EDIT BY R.ACE
;TCO 4.2482 - FIX BUGHLT'S FROM MTU% JSYS FUNCTION 2
;<4.MONITOR>TAPE.MAC.651, 21-Sep-79 12:49:19, EDIT BY MILLER
;CHECK FOR DUMP MODE OPEN IN SETFMT
;<4.MONITOR>TAPE.MAC.650, 21-Sep-79 07:48:35, EDIT BY R.ACE
;TCO 4.2480 - FIX SECG37'S IN MTU% JSYS
;<4.MONITOR>TAPE.MAC.649, 19-Sep-79 15:15:25, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.648, 19-Sep-79 14:33:25, EDIT BY MILLER
;FIX CO.ABH AND CI.ABH STATES
;<OSMAN.MON>TAPE.MAC.1, 10-Sep-79 16:11:03, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>TAPE.MAC.646, 23-Aug-79 10:30:29, EDIT BY MILLER
;CHANGE SQIGRD AND SQIGRS TO ALLOW NULL RECORDS.
;<4.MONITOR>TAPE.MAC.645, 14-Aug-79 11:28:54, EDIT BY MILLER
;CHANGE CLOSE NOT TO POSITION TO NEXT FILE IF STATE IS CI.UHL.
; FIX MTSKPF AND SKPEOT TO CALL INCHK IF STATE IS OTHER THEN ST.CLS
;<4.MONITOR>TAPE.MAC.644, 11-Aug-79 19:37:59, EDIT BY R.ACE
;TCO 4.2386 - CLEAN UP ERROR CODES
;<4.MONITOR>TAPE.MAC.643,  2-Aug-79 15:36:42, EDIT BY R.ACE
;CHANGE .MOCLE AND .MONOP TO DISPATCH TO MTLFCN INSTEAD OF MTMTCM
;<4.MONITOR>TAPE.MAC.642, 31-Jul-79 10:15:37, EDIT BY MILLER
;CHECK FOR NO HDR2 IN GETFC0
;<4.MONITOR>TAPE.MAC.641, 31-Jul-79 09:33:41, EDIT BY MILLER
;RETURN -1 IN MORLI IF ANY DATE IS INVALID
;<4.MONITOR>TAPE.MAC.640, 30-Jul-79 19:20:52, EDIT BY R.ACE
;TCO 4.2356 - ADD CODE TO CHECK VOL2 PROTECTION ON TOPS-20 TAPES
;REDO PROTECTION-CHECKING LOGIC
;<4.MONITOR>TAPE.MAC.639,  2-Jul-79 11:06:55, EDIT BY MILLER
;MAKE MTLFCN BE NOINT MOST OF THE TIME
;<4.MONITOR>TAPE.MAC.638, 11-Jun-79 16:56:11, EDIT BY MILLER
;MAKE OUTPUT OF NULL RECORDS WORK
;<4.MONITOR>TAPE.MAC.637, 10-Jun-79 13:48:12, EDIT BY MILLER
;CLEAR FSSAV IN MTLFCN IF MUST OPEN MTA
;<4.MONITOR>TAPE.MAC.636,  9-Jun-79 13:22:28, EDIT BY MILLER
;ADD CHECK FOR ERRF TO MTDOW.
;<4.MONITOR>TAPE.MAC.635,  9-Jun-79 13:17:29, EDIT BY MILLER
;ALLOW DUMP MODE I/O TO ANY FORMAT TAPE.
;<4.MONITOR>TAPE.MAC.634,  6-Jun-79 11:18:07, EDIT BY R.ACE
;VARIOUS PLACES IN MTSQO... CLEAR BLKF IF ERRF IS SET
;SET DATA MODE AFTER CALLING MTAOPN IN MTLFCN
;<4.MONITOR>TAPE.MAC.633,  6-Jun-79 09:15:17, EDIT BY OSMAN
;CLEAR CRNXT, LFNXT IF MOVING TAPE OPEN FOR READING
;<4.MONITOR>TAPE.MAC.632,  5-Jun-79 16:37:07, EDIT BY HALL
;OPHDRD - SEMICOLON OUT THE CAIN BEFORE THE TQO THAT WAS SEMICOLONED OUT
;GETFC0 - DON'T CALL MTTYP0 BECAUSE CALLER MAY BE OPEN ROUTINE
;<4.MONITOR>TAPE.MAC.631, 26-May-79 15:10:32, EDIT BY MILLER
;FIX RECLNN AND BLKLN
;<4.MONITOR>TAPE.MAC.630, 25-May-79 13:14:28, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.629, 25-May-79 12:36:39, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.628, 25-May-79 10:44:53, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.627, 24-May-79 17:51:26, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.626, 24-May-79 17:33:06, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.625, 24-May-79 17:26:57, EDIT BY MILLER
;HANDLE .STABT IN BACKSPACE FILE CODE
;<4.MONITOR>TAPE.MAC.624, 24-May-79 17:10:25, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.623, 24-May-79 16:38:32, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.622, 24-May-79 16:16:42, EDIT BY MILLER
;CHANGE BADIS ERROR CODE TO DESX9
;<4.MONITOR>TAPE.MAC.621, 24-May-79 15:55:42, EDIT BY MILLER
;SET ACRLFF IF APPROPRIATE
;<4.MONITOR>TAPE.MAC.620, 24-May-79 11:31:43, EDIT BY MILLER
;CHECK FOR MTFLSH RETURNING WITH BLKF SET.
;<4.MONITOR>TAPE.MAC.619, 24-May-79 11:27:20, EDIT BY MILLER
;FIX GDSTS CODE TO RETURN EOF BIT IF IN EOF TRAILERS
;<4.MONITOR>TAPE.MAC.618, 17-May-79 17:22:16, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.617, 17-May-79 17:22:01, EDIT BY MILLER
;FLUSH AT ER.RDY IF NO WAIT BEING USED
;<4.MONITOR>TAPE.MAC.616, 16-May-79 14:59:04, EDIT BY MILLER
;ALWAYS DO ABORT CLOSE OF MTA
;<4.MONITOR>TAPE.MAC.615, 10-May-79 10:43:16, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.614,  4-May-79 09:10:38, EDIT BY MILLER
;MAKE SET DENS AND SET PARITY ILLEGAL FOR LABELED TAPES
;<4.MONITOR>TAPE.MAC.613,  4-May-79 08:56:43, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.612, 26-Apr-79 17:22:16, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.611, 25-Apr-79 10:40:16, EDIT BY R.ACE
;REMOVE SPURIOUS "SETZRO TPFRK" IN CO.UT0
;<4.MONITOR>TAPE.MAC.610, 24-Apr-79 13:58:26, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.609, 20-Apr-79 10:13:11, EDIT BY R.ACE
;LET GDSTS RETURN MT%EOT ON LABELED TAPE IF TPDVS IS SET
;<4.MONITOR>TAPE.MAC.608, 19-Apr-79 15:28:56, EDIT BY MILLER
;FIX MTSDM NOT TO LOSE MTOPR CODE
;<4.MONITOR>TAPE.MAC.607, 19-Apr-79 10:46:59, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.606, 17-Apr-79 12:09:15, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.605, 12-Apr-79 10:16:51, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.604,  9-Apr-79 18:35:32, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.603,  9-Apr-79 16:07:36, EDIT BY MILLER
;TCO 4.2228. ADD .MTCVV FUNCTION OF MTU
;<4.MONITOR>TAPE.MAC.602,  5-Apr-79 11:14:39, Edit by MCLEAN
;REMOVE FIRST ARG FROM GTOKM MACRO
;<4.MONITOR>TAPE.MAC.601,  4-Apr-79 15:13:37, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.600,  4-Apr-79 11:06:39, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.599,  3-Apr-79 11:03:54, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.598, 27-Mar-79 12:49:48, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.597, 26-Mar-79 12:36:21, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.596, 26-Mar-79 11:16:15, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.595, 26-Mar-79 10:24:53, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.594, 22-Mar-79 16:26:45, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.593, 22-Mar-79 14:49:43, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.592, 21-Mar-79 13:55:09, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.591, 20-Mar-79 17:17:03, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.590, 19-Mar-79 15:16:45, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.589, 19-Mar-79 11:17:41, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.588, 19-Mar-79 10:35:18, EDIT BY MILLER
;MAKE SURE ALL BLOCK ARE AT LEAST 16 BYTES. FIX BACKSPACE CODE
;<4.MONITOR>TAPE.MAC.587, 16-Mar-79 14:43:59, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.586, 15-Mar-79 13:33:59, EDIT BY MILLER
;USE GJFX52 INSTEAD OF GJFX24
;<4.MONITOR>TAPE.MAC.585, 13-Mar-79 17:10:48, EDIT BY HURLEY
;ADD 0 TO FRONT OF GTOKM ARG LIST
;<4.MONITOR>TAPE.MAC.584, 13-Mar-79 11:52:21, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.583, 13-Mar-79 10:43:04, EDIT BY MILLER
;MUST EXPLICITLY CHECK ERRF AFTER MTRECO IS CALLED
;<4.MONITOR>TAPE.MAC.582, 12-Mar-79 16:34:33, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.581, 12-Mar-79 12:54:20, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.580, 11-Mar-79 13:09:53, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>TAPE.MAC.579,  7-Mar-79 17:46:11, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.578,  6-Mar-79 15:49:53, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.577,  6-Mar-79 13:06:47, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.576,  6-Mar-79 10:16:40, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.575,  5-Mar-79 19:23:38, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.574,  5-Mar-79 13:41:24, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.573,  5-Mar-79 11:04:21, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.572,  2-Mar-79 15:42:18, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.571,  1-Mar-79 19:04:01, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.570,  1-Mar-79 19:02:34, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.569,  1-Mar-79 16:36:27, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.568,  1-Mar-79 10:31:55, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.567, 28-Feb-79 18:47:19, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.566, 28-Feb-79 18:36:24, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.565, 28-Feb-79 15:06:34, EDIT BY R.ACE
;MAKE UNLOAD RETURN DESX9 FOR ALL MT DEVICES
;<4.MONITOR>TAPE.MAC.564, 28-Feb-79 12:40:12, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.563, 28-Feb-79 12:28:33, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.562, 27-Feb-79 15:31:18, EDIT BY HALL
;ALLOW LABLES OF GT 80 CHARACTERS TO BE READ
;<MILLER.DAWSON>TAPE.MAC.2, 26-Feb-79 11:14:55, EDIT BY MILLER
;<MILLER>TAPE.MAC.563, 26-Feb-79 11:12:32, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.562, 21-Feb-79 16:27:59, EDIT BY MILLER
;REMOVE USE OF TLABBF. GET A JSB PAGE TO USE FOR BUFFER I/O PAGE
;<4.MONITOR>TAPE.MAC.561, 21-Feb-79 15:33:47, EDIT BY MILLER
;FIX ABORT CLOSE SO IT CAN'T FAIL
;<4.MONITOR>TAPE.MAC.560, 21-Feb-79 14:42:14, EDIT BY MILLER
;DON'T ALLOCATE LABEL BUFFERS IF TAPE IS UNLABELED
;<4.MONITOR>TAPE.MAC.559, 16-Feb-79 16:10:38, EDIT BY BLOUNT
;FIX TSTLCG TO CHECK FOR TOPS20 TAPE IF ANSI LABEL
;<4.MONITOR>TAPE.MAC.558, 16-Feb-79 11:44:55, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.557, 16-Feb-79 11:32:41, EDIT BY MILLER
;MAKE TPEXPD A FULL WORD.
;<4.MONITOR>TAPE.MAC.556, 15-Feb-79 11:48:03, EDIT BY MILLER
;CLEAR FSEQ AND TPFSEC IN RELDMT
;<4.MONITOR>TAPE.MAC.555, 14-Feb-79 12:40:36, EDIT BY R.ACE
;ADD RETBAD AFTER CALL ASSLBL
;<4.MONITOR>TAPE.MAC.554, 12-Feb-79 14:21:18, EDIT BY MILLER
;MAKE .MOREW BE "REWIND VOLUME SET". MAKE .MORVS BE "REWIND VOLUME"
;<4.MONITOR>TAPE.MAC.553,  8-Feb-79 11:22:25, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.552,  8-Feb-79 11:00:16, EDIT BY MILLER
;FIX OUTCHK FOR APPEND ACCESS
;<4.MONITOR>TAPE.MAC.551,  6-Feb-79 09:32:56, EDIT BY R.ACE
;ADD DEFERRED VOLUME-SWITCH FOR LABELED DUMP-MODE OUTPUT
;<4.MONITOR>TAPE.MAC.550,  4-Feb-79 17:01:32, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.549,  4-Feb-79 16:50:44, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.548,  4-Feb-79 08:42:28, EDIT BY R.ACE
;MAKE UNLOAD BE A NOP
;<4.MONITOR>TAPE.MAC.547,  2-Feb-79 16:25:37, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.546,  2-Feb-79 14:22:36, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.545,  2-Feb-79 12:19:08, EDIT BY MILLER
;CHANEG DEFAULT VERSION NUMBER TO 377777 (8)
;<4.MONITOR>TAPE.MAC.544, 23-Jan-79 13:12:26, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.543, 23-Jan-79 12:58:06, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.542, 23-Jan-79 12:24:04, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.541, 23-Jan-79 12:11:16, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.540, 23-Jan-79 12:03:20, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.539, 23-Jan-79 11:37:09, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.538, 23-Jan-79 10:47:16, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.537, 22-Jan-79 17:31:30, EDIT BY MILLER
;MAKE SURE DATA MODE IS CORRECT AFTER VOLUME SWITCH
;<4.MONITOR>TAPE.MAC.536, 22-Jan-79 12:53:09, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.535, 22-Jan-79 12:19:55, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.534, 20-Jan-79 15:20:30, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.533, 20-Jan-79 15:14:34, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.532, 20-Jan-79 14:46:40, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.531, 19-Jan-79 12:31:06, EDIT BY R.ACE
;CLOSE MTA WHEN ENTERING CLOSED STATE IN BKCHK0
;<4.MONITOR>TAPE.MAC.530, 18-Jan-79 12:54:36, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.529, 18-Jan-79 12:05:54, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.528, 17-Jan-79 11:30:21, EDIT BY MILLER
;SUPPRESS SYMBOLS
;<4.MONITOR>TAPE.MAC.527, 16-Jan-79 15:37:11, EDIT BY R.ACE
;ADD OCTAL-NUMBER FIELD TYPE
;<4.MONITOR>TAPE.MAC.526, 11-Jan-79 14:25:12, EDIT BY MILLER
; ... MANY OTHERS ...
;<4.MONITOR>TAPE.MAC.193, 12-Oct-78 17:40:06, EDIT BY MILLER
;ADD ATTRIBUTE PROCESSING
;<4.MONITOR>TAPE.MAC.192, 12-Oct-78 10:37:40, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.156,  3-Oct-78 12:51:51, EDIT BY MILLER
;ADD CODE TO CALL IPCMTM
;<4.MONITOR>TAPE.MAC.155,  2-Oct-78 14:00:16, EDIT BY MILLER
;<4.MONITOR>TAPE.MAC.154,  2-Oct-78 13:38:32, EDIT BY MILLER
;FIX UP NEW .MOLOC FUNCTION ROUTINES
;<4.MONITOR>TAPE.MAC.153,  9-Sep-78 18:43:04, Edit by MCLEAN
;<2MCLEAN>TAPE.MAC.128, 15-Aug-78 16:49:44, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.128, 21-Aug-78 13:38:58, EDIT BY PORCHER
;<PORCHER>TAPE.MAC.144, 19-Aug-78 03:37:32, EDIT BY PORCHER
;ADD STUFF FOR FORMATTED RECORD PROCESSING
;<4.MONITOR>TAPE.MAC.127, 14-Aug-78 22:12:21, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.91, 19-Jul-78 02:19:00, Edit by MCLEAN
;CHANGE JSB SPACE TO SWAP SPACE
;<4.MONITOR>TAPE.MAC.90, 19-Jul-78 00:19:14, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.89, 19-Jul-78 00:11:19, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.88, 18-Jul-78 23:56:26, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.87, 16-Jul-78 22:15:22, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.86, 16-Jul-78 01:10:36, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.85, 14-Jul-78 16:03:45, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.84, 14-Jul-78 15:52:03, Edit by MCLEAN
;<4.MONITOR>TAPE.MAC.83, 12-Jul-78 02:57:02, Edit by MCLEAN
;FIX MTOPR
;<4.MONITOR>TAPE.MAC.82,  5-Oct-77 13:15:57, Edit by HESS
;ADD PULSAR MESSAGE FOR DRIVE STATUS CHANGE
;<4.MONITOR>TAPE.MAC.81,  4-Oct-77 15:49:45, Edit by HESS
;EXTENDED ADDRS FIXES
;<4.MONITOR>TAPE.MAC.79, 19-Aug-77 13:58:57, Edit by HESS
;CHANGE CLREOF TO ALSO CLEAR ABORTF

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	SEARCH PROLOG
	TTITLE TAPE,,< - LABEL HANDLER AND RECORD PROCESSOR>
	EXTN <IPCMTM,TLAB10,MTADNS,TLAB11,TLAB12,TLAB13,TLAB14> ;TEMP EXTERNALS
	EXTN <MTAFLA,MTFLSH,MTAKIL>
	SWAPCD

;SPECIAL AC DEFINITIONS USED IN THIS MODULE

DEFAC (U,Q1)			;UNIT NUMBER
DEFAC (IOS,Q2)			;STATUS BITS FROM MTASTS
DEFAC (STS,P1)			;DEVICE STATUS
DEFAC (JFN,P2)			;JFN
DEFAC (DEV,P4)			;DEVICE DISPATCH ADR
DEFAC (F1,P5)

DEFINE UCALL (ROU,ARGS) <

	CALL SAVEU
	  CALL ROU
>
DEFINE MCALL (ROU,ARGS) <
	CALL SAVEM
	 CALL ROU
>

DEFINE SQCALL (ROU,ARGS) <
	CALL SQMTCL
	 CALL [	MCALL ROU
		 NOP		;;IN CASE OF +1
		RET]		;;RETURN TO CALLER
>

DEFINE MTERET (COD,EXTRA) <
	JRST [EXTRA
	   IFNB <COD>,<MOVEI T1,COD>
		TQO <ERRF>
		RET]
>

DEFINE LBLCHK (ROU) <
	OPSTR <SKIPN>,TPLBD
	JRST [	MCALL ROU
		RET		;BLOCK
		RETSKP]		;RETURN
>
;LABEL PARAMETERS

.LBRSZ==^D80		;80 CHARACTER RECORDS
.LBLEN==^D80/4		; # OF WORDS
.LBTDM==4		;DATA MODE (IND COMPAT)
.LBHBW==4		;4 BYTES/WD

.LBFRD==100		;LABEL READ FUNCTION
.LBFWR==101		;LABEL WRITE FUNCTION
.VOLSW==102		;VOLUME SWITCH

.ACFUL==" "		;ACCESIBILITY CHARACTER ALLOWING FULL ACCESS
.DOMAC=="1"		;DOMESTIC ACCESS

;LABEL FIELD CODES AND DEFINITIONS

DEFSTR (FLDPOS,,5,6)	;FIELD POSITION
DEFSTR (FLDLEN,,12,7)	;FIELD LENGTH
DEFSTR (FLDTYP,,15,3)	;FIELD TYPE CODE
DEFSTR (FLDFLG,,17,2)	;FIELD PROTECTION
DEFSTR (FLDDAT,,35,18)	;FIELD DATA ROUTINE ADDRS

FF%PRT==1		;PROTECTED FIELD
FF%IMM==2		;IMMEDIATE DATA
			;4 - UNUSED

.FTSTR==0		;FIELD TYPE STRING
.FTNUM==1		;FIELD TYPE DECIMAL NUMBER
.FTDAT==2		;FIELD TYPE DATE
.FTSPC==3		;FIELD TYPE SPACES
.FTOCT==4		;FIELD TYPE OCTAL NUMBER
.FTMAX==4		;MAX VALUE OF ABOVE

DEFINE FLDID (NAM,POS,LEN,TYP,FLG,DATA) <
	NAM=.
    IFN <FLG&FF%IMM>,<
      IFE TYP,<
	BYTE (6)^D<POS> (7)^D<LEN> (3)TYP (2)FLG (18)[ASCIZ \DATA\]
      >
      IFN TYP,<
	BYTE (6)^D<POS> (7)^D<LEN> (3)TYP (2)FLG (18)DATA
      >
    >
    IFE <FLG&FF%IMM>,<
	BYTE (6)^D<POS> (7)^D<LEN> (3)TYP (2)FLG (18)DATA
    >
>

;LABEL RECORD OFFSETS IN TPLBLS

V1LOC==0			;WORD 0 IS BLOCK HEADER
UVLOC==V1LOC+.LBLEN		;UVLD IS NEXT
H1LOC==UVLOC+.LBLEN		;THEN HDR1
H2LOC==H1LOC+.LBLEN		;THEN HDR2
;FIELDS IN LABEL DATA BASE

DEFSTR (TPFLGS,TLABR0(U),35,36)	;FLAG WORD (RESIDENT)
MSKSTR (TPVV,TLABR0(U),1B0)	;VOLUME VALID FLAG
MSKSTR (TPNVV,TLABR0(U),1B1)	;TAPE NOT VALID (ERROR)
DEFSTR (TPUNIT,TLABR0(U),8,7)	;ACTUAL MTA UNIT (LIMITED TO 128)
MSKSTR (SNEOT,TLABR0(U),1B9)	;EOT SEEN WHILE WRITING LABELS
MSKSTR (TPEBD,TLABR0(U),1B11)	;EBCDIC VOLUME
DEFSTR (TPMTDM,TLABR0(U),14,3)	;PLACE TO SAVE DATA MODE
DEFSTR (TPMHBW,TLABR0(U),17,3)	;PLACE TO SAVE BYTES/WD
DEFSTR (RCNT,TLABR0(U),35,18)	;RECORD COUNT INFO (FROM UDB)

DEFSTR (TPSTAT,TLABL0(U),5,6)	;STATE CODE
DEFSTR (TPLPCS,TLABL0(U),12,7)	;LABEL PROCESSING CODE
	.MXMTO==100		;MAX MTOPR CODE (SEE MTLFCN)
MSKSTR (TPBEGF,TLABL0(U),1B13)	;SET IF BEGINNING OF SPANNED RECORD
MSKSTR (TPNBL,TLABL0(U),1B14)	;NEW BLOCK READ
MSKSTR (TPUED,TLABL0(U),1B15)	;USE EBCDIC DATA IF SET
MSKSTR (TPFVM,TLABL0(U),1B16)	;IF SET, FIRST VOLUME IS MOUNTED
DEFSTR (TPLCT,TLABL0(U),17,1)	;USER LABEL COUNT
MSKSTR (HDR1,TLABL0(U),1B18)	;HDR1 DATA VALID
MSKSTR (HDR2,TLABL0(U),1B19)	;HDR2 DATA VALID
MSKSTR (RCCHK,TLABL0(U),1B20)	;RECORD COUNT CHECK ERROR (TLRCHK)
MSKSTR (TPEOF,TLABL0(U),1B21)	;EOF1/2 SEEN IN TLRCHK (ELSE EOV)
MSKSTR (TPT20,TLABL0(U),1B22)	;THIS IS A TOPS20 VOLUME
MSKSTR (UVLD,TLABL0(U),1B23)	;UVLD DATA VALID
MSKSTR (TPLBD,TLABL0(U),1B24)	;UNLABELED/LABELED OPERATION
DEFSTR (TPDNS,TLABL0(U),27,3)	;MTA DENSITY- DECLARED BY MTCON
DEFSTR (TPNUL,TLABL0(U),31,4)	; # OF USER LABELS WRITTEN
	MAXLBL==10		;MAXIMUM ALLOWED USER LABELS ON WRITE
DEFSTR (TPDM,TLABL0(U),34,3)	;PREVAILING TAPE DATA MODE
				;35 UNUSED
DEFSTR (TPERM,TLABL1(U),17,18)	;ERROR CODE SET BY MTCON
DEFSTR (TPFRK,TLABL1(U),35,18)	;TAPE FORK FOR PSI
DEFSTR (TPJFN,TLABL2(U),17,18)	;SAVED JFN (ORIG JFN)
DEFSTR (TPLBLS,TLABL2(U),35,18)	;TAPE LABEL BUFFFERS IN SWAP

DEFSTR (FSSAV,TLABL3(U),35,36)	;PLACE TO SAVE FILSTS
DEFSTR (TPMTRS,TLABL4(U),35,18)	;PLACE TO SAVE RECORD SIZE
DEFSTR (TPFSEC,TLABL4(U),17,9)	;FILE SECTION #
DEFSTR (TPPSI,TLABL4(U),8,6)	;TAPE PSI FOR EOV
MSKSTR (TPEUT,TLABL4(U),1B0)	;END OF USER LABELS ENCOUNTERED
MSKSTR (TPAPP,TLABL4(U),1B1)	;OPEN FOR APPEND
MSKSTR (TPOPN,TLABL4(U),1B2)	;IF MT IS OPENED

DEFSTR (TPGDS,TLAB10(U),17,18)	;LOCAL STATUS

				;0-3 UNUSED
DEFSTR (TPOP0,TLABL5(U),4,1)	;BIT TO SAY TPOPN IS STILL HAPPENING
DEFSTR (TPDVS,TLABL5(U),5,1)	;DEFER VOLUME-SWITCH IF SET
DEFSTR (TPFRMT,TLABL5(U),11,6)	;RECORD FORMAT TYPE CODE
DEFSTR (TPMOD,TLABL5(U),13,2)	;TAPE MODE
DEFSTR (TPRVN,TLABL5(U),17,4)	;RELATIVE VOLUME #
				;18-35 UNUSED

DEFSTR (TPBSZ,TLABL6(U),17,18)	;FILE BLOCK SIZE
DEFSTR (TPRSZ,TLABL6(U),35,18)	;FILE RECORD SIZE

DEFSTR (TPSCUP,TLABL7(U),17,18)	;SAVES CURRENT PAGE POINTER FOR TPSBYT
DEFSTR (TPIOB,TLABL7(U),35,18)	;I/O BUFFER ADDRESS

DEFSTR (SVIOS,TLABL8(U),35,36)	;PLACE TO SAVE IOS

DEFSTR (SVBLK,TLABL9(U),35,36)	;PLACE TO SAVE BLOCK ADDRESS
DEFSTR (TPPRO,TLAB10(U),35,18)	;SAVE PROTECTION HERE
DEFSTR (TPXLB,TLAB10(U),1,2)	;EXTRA LABEL COUNT
DEFSTR (TPLRC,TLAB10(U),17,16)	;COUNT OF LAST READ RECORD
DEFSTR (TPOCT,TLAB11(U),17,18)	;OLD TPFCNT
DEFSTR (TPOBY,TLAB11(U),35,18)	;OLD TPFBYN
DEFSTR (TPFSN,TLAB12(U),35,36)	;SIXBIT VOL SET NAME
DEFSTR (TPEXPD,TLAB13(U),35,36) ;SAVE EXP DATE HERE


DEFSTR (FSEQ,TLAB14(U),17,18)	;TAPE FILE POSITION (SEQ #)
DEFSTR (USRSEQ,TLAB14(U),35,18)	;USER REQUESTED SEQ #
;FIELDS IN MTA DATA BASE

OPND==:1B2			;(SEE MAGTAP)

DEFSTR (MTDN,MTANR1,14,4)	;DENSITY
DEFSTR (MTDM,MTANR1,17,3)	;DATA MODE
DEFSTR (MTRS,MTANR1,35,18)	;RECORD SIZE
DEFSTR (MTBYT,MTANR2,17,18)	;LH OF BYTE POINTER TO MAGTAP BUFFER
DEFSTR (MTHBW,MTANR3,5,6)	;BYTES PER WORD
DEFSTR (MTCUP,MTANR4,35,18)	;CURRENT BUFFER PAGE POINTER
DEFSTR (MTALTC,MTANR6,17,18)	;# OF WORDS READ
;LABEL DESCRIPTORS

;FORMAT OF EACH BLOCK:
; WORD 0 := -<NUMBER OF ITEMS>,,<OFFSET INTO LABEL BUFFER>
; WORD 1-N := LABEL ID WORD
;	0-5	FIELD POSITION
;	6-11	FIELD LENGTH
;	12-14	FIELD TYPE (0 = STRING, 1 = NUMBER, 2 = DATE, 3 = SPACES)
;	15-17	FLAGS (1 - PROTECTED, 2 - IMMEDIATE, 4 - UNUSED)
;	18-35	DATA OR ROUTINE ADDRS

.VOL1:	-V1LEN,,V1LOC			;LOCATION IN TPLBLS
	FLDID (.V1LID,1,4,.FTSTR,3,<VOL1>)	;LABEL ID
	FLDID (.V1VID,5,6,.FTSTR,0,<R>)		;VOLUME ID
	FLDID (.V1ACC,11,1,.FTSTR,2,< >)	;ACCESSIBILITY
	FLDID (.V1OWN,38,13,.FTSTR,3,<D%KT20  00000>) ;OWNER ID
	FLDID (.V1DVR,51,1,.FTSTR,3,<1>)	;DEC STD VERSION
	FLDID (.V1AVR,80,1,.FTSTR,3,<3>)	;ANSI STD VERSION
    V1LEN==.-.VOL1

.UVLD:	-UVLEN,,UVLOC
	FLDID (.UVLID,1,4,.FTSTR,3,<VOL2>)	;LABEL ID
	FLDID (.UVPRT,5,6,.FTOCT,0,<GTVPRT>)	;PROTECTION
	FLDID (.UVPPN,11,12,.FTNUM,2,<0>)	;TOPS10 PPN
	FLDID (.UVNAM,23,39,.FTSTR,1,<GTUSER>)	;OWNERS NAME
	FLDID (.UVIND,80,1,.FTSTR,3,< >)	;INDICATOR
    UVLEN==.-.UVLD

.HDR1:	-H1LEN,,H1LOC
	FLDID (.H1LID,1,4,.FTSTR,3,<HDR1>)	;LABEL ID
	FLDID (.H1FNM,5,17,.FTSTR,0,<GTFNAM>)	;FILE IDENTIFIER
	FLDID (.H1VID,22,6,.FTSTR,1,<GTVLID>)	;FILE-SET ID
	FLDID (.H1SEC,28,4,.FTNUM,1,<GTFSEC>)	;FILE SECTION #
	FLDID (.H1SEQ,32,4,.FTNUM,1,<GTFSEQ>)	;FILE SEQUENCE NUMBER
	FLDID (.H1GEN,36,4,.FTNUM,0,<GTFGEN>)	;GENERATION NUMBER
	FLDID (.H1GNV,40,2,.FTNUM,0,<GTFGVR>)	;GENERATION VERSION
	FLDID (.H1CRE,42,6,.FTDAT,0,<GTCDAT>)	;CREATION DATE
	FLDID (.H1EXP,48,6,.FTDAT,0,<GTXDAT>)	;EXPRIATION DATE
	FLDID (.H1ACC,54,1,.FTSTR,0,<GTFACC>)	;ACCESS CHARACTER
	FLDID (.H1CNT,55,6,.FTNUM,3,<0>)	;BLOCK COUNT
	FLDID (.H1SID,61,13,.FTSTR,3,<DECSYSTEM20>)
    H1LEN==.-.HDR1

.HDR2:	-H2LEN,,H2LOC
	FLDID (.H2LID,1,4,.FTSTR,3,<HDR2>)	;LABEL ID
	FLDID (.H2FMT,5,1,.FTSTR,0,<GTRFMT>)	;RECORD FORMAT
	FLDID (.H2BLN,6,5,.FTNUM,0,<GTBLEN>)	;BLOCK LENGTH
	FLDID (.H2RLN,11,5,.FTNUM,0,<GTRLEN>)	;RECORD LENGTH
	FLDID (.H2FMC,37,1,.FTSTR,0,<GETMOD>)	;FORM CONTROL BYTE
	FLDID (.H2PRT,38,6,.FTOCT,0,<GTFPRT>)	;PROTECTION
	FLDID (.H2PAD,48,1,.FTSTR,2,<^>)	;PADDING CHARACTER
	FLDID (.H2BSZ,49,2,.FTNUM,0,<GTFBSZ>)	;FILE BYTE SIZE
	FLDID (.H2OFS,51,2,.FTNUM,2,<0>)	;BUFFER OFFSET?
    H2LEN==.-.HDR2
	; ..
;MORE LABEL DEFS

;DEFINE HEADER/TRAILER LABELS
;USER HEADER LABEL

.UVLS:	-UVLN0,,
	FLDID (.U1HID,1,3,.FTSTR,3,<UHL>)
	FLDID (.U1TID,1,3,.FTSTR,3,<UTL>)
	FLDID (.U1NUM,4,1,.FTSTR,0,<>)
	FLDID (.U1DAT,5,^D76,.FTSTR,0,<>)
   UVLN0==.-.UVLS
	FLDID (.LB,1,^D80,.FTSTR,0,<>) ;DESCRIBE AN ENTIRE LABEL

;SPECIAL DEF FOR EBCDIC TAPES. DESCRIBES VOLUME SWITCH INDICATOR

	FLDID (.H2EVS,17,1,.FTSTR,0,<>)

;SPECIAL DEF USED TO GET FIRST 3 BYTES OF .V1OWN

	FLDID (.V1OPR,38,3,.FTSTR,3,<>)
	FLDID (.V1OP0,38,2,.FTSTR,3,<>) ;FIRST TWO BYTES ONLY

DFLTV==377777			;DEFAULT VERSION USED BY TAPE
				; (INTENDED TO BE UNLIKELY)
EBDFIL==777			;EBCDIC FILL CHARACTER
				; EBCDIC TAPES APPARENTLY ARE NEVE
				; PADDED

MXMTAU==.RTJST(TPUNIT,TPUNIT)	;COMPUTE MAX MTA NUMBER
;STATE CODES

; CLS		;DEVICE IS CLOSED
; HDR		;READ/WRITE HDRS
; UHL		;USER HEADER LABEL AREA
; RDY		;DEVICE IS READY FOR I/O
; EOF		;END OF FILE SECTION
; EOT		;EOT MARKER SEEN ON OUTPUT
; ETL		;READ/WRITE TRAILERS
; UTL		;TLRS PROCESSED, ALLOW UTL
; ABD		;ABORT DURING READ
; VLS		;VOL SWITCH IN PROGRESS
; ABH		;ABORT DURING HEADER READ

;MACRO TO GENERATE STATE CODE DISPATCH TABLES

DEFINE STDISX (TYP,LST) <
    IRP <LST>,<			;;GEN STATES
	IF2,<IFNDEF TYP'.'LST,<TYP'.'LST=BADIS>>
	DTBDSP (TYP'.'LST)	;;DISPATCH
    >
>

;MACRO TO GENERATE STATE CODES

DEFINE GENST (LIST) <
	.NSTAT==-1		;;INIT COUNT OF STATES
    IRP <LIST>,<
	.NSTAT==.NSTAT+1	;;INCR STATE CODE
	.ST'LIST==.NSTAT	;;ASSIGN STATE CODE
    >
				;;MAKE MACRO TO GEN DISPATCH
    DEFINE STDIS (TYP) <
	STDISX (TYP,<LIST>)	;; CALL INNER MACRO
    >
>

;NOW GENERATE THE STATES

GENST (<CLS,HDR,UHL,RDY,EOF,EOT,ETL,UTL,ABH,ABD,VLS>)
;DISPATCH TABLE FOR TAPES (MT'S)


MTDTB::	MTDTBL			;LENGTH
	DTBDSP (MTDIR)		;SET DIRECTORY
	DTBDSP (MTNAM)		;LOOKUP NAME
	DTBDSP (MTEXT)		;LOOKUP EXTENSION
	DTBDSP (MTVER)		;LOOKUP VERSION
	DTBDSP (MTPRO)		;PROTECTION INSERTION
	DTBDSP (RSKP)		;ALLOW ACCOUNTS
	DTBBAD (DESX9)		;STATUS INSERTION
	DTBDSP (MTOPN)		;OPNEF
	DTBDSP (MTSQI)		;BIN/SIN
	DTBDSP (MTSQO)		;BOUT/SOUT
	DTBDSP (MTCLZ)		;CLOSF
	DTBBAD (DESX9)		;RENAME
	DTBBAD (DESX9)		;DELETE
	DTBDSP (MTDI)		;DUMPI
	DTBDSP (MTDO)		;DUMPO
	DTBSKP			;MOUNT
	DTBSKP			;DISMOUNT
	DTBBAD (DESX9)		;INIT DIRECTORY
	DTBDSP (MTMT)		;MTOPR
	DTBDSP (MTGTSX)		;GETSTS
	DTBDSP (MTSTSX)		;SETSTS
	DTBDSP (MTRCO)		;RECORD OUT
	DTBDSP (RFTADN)		;READ TAD
	DTBDSP (SFTADN)		;SET TAD
	DTBDSP (BIOINP)		;SET JFN FOR INPUT
	DTBDSP (BIOOUT)		;SET JFN FOR OUTPUT
	DTBDSP (MTATR)		;CHECK OUT ATTRIBUTES
	DTBDSP (RELMT)		;RELEASE JFN
	MTDTBL==:.-MTDTB	;GLOBAL LENGTH OF DISPATCH TABLE
;MACROS TO CREATE EBCDIC TO ASCII TRANSLATION TABLE

DEFINE INIT (VALUE)<
TAB'VALUE==32B7+32B15+32B23+32B31
>

DEFINE CODE (EBCDIC,ASCII)<

	IF2,<
OFFSET==<EBCDIC>_<-2>	;;GET WORD OFFSET
BIT==<<EBCDIC>&3>*^D8+7		;;GET RIGHTMOST BIT
	INSERT \OFFSET,\BIT,ASCII,EBCDIC	;;CREATE A TABLE ENTRY
   >
   >
DEFINE INSERT (OFFS,POS,CHAR,EBCDIC)<
TEMP==<TAB'OFFS_<POS-43>>&377
IFN TEMP-32,<PRINTT (EBCDIC,\TEMP)>
TAB'OFFS==TAB'OFFS!<<377>_<43-POS>>
TAB'OFFS==TAB'OFFS^!<<377>_<43-POS>>
TAB'OFFS==TAB'OFFS!<<CHAR>_<43-POS>>
   >
DEFINE MAKE (ENTRY) <
	XLIST			;;[7.1064]
	TAB'ENTRY		;;MAKE TRANSLASTION TABLE ENTRY
	LIST			;;[7.1064]
	PURGE TAB'ENTRY		;;GET RID OF SYMBOL
   >
DEFINE PRINTT (CHAR,TEMP) <
PRINTX %DUPLICATE FOR CHAR IS TEMP
   >


;INIT VALUES

XX==0
REPEAT ^D64,<
	INIT (\XX)
	XX==XX+1>
ETOA:	CODE (0,0)
	CODE (1,1)
	CODE (2,2)
	CODE (3,3)
	CODE (67,4)
	CODE (55,5)
	CODE (56,6)
	CODE (57,7)
	CODE (26,10)
	CODE (5,11)
	CODE (45,12)
	CODE (13,13)
	CODE (14,14)
	CODE (15,15)
	CODE (16,16)
	CODE (17,17)
	CODE (20,20)
	CODE (21,21)
	CODE (22,22)
	CODE (23,23)
	CODE (74,24)
	CODE (75,25)
	CODE (62,26)
	CODE (46,27)
	CODE (30,30)
	CODE (31,31)
	CODE (77,32)
	CODE (47,33)
	CODE (34,34)
	CODE (35,35)
	CODE (36,36)
	CODE (37,37)
	CODE (100,40)		;SPACE
	CODE (117,41)
	CODE (177,42)
	CODE (173,43)
	CODE (133,44)
	CODE (154,45)
	CODE (120,46)
	CODE (175,47)
	CODE (115,50)
	CODE (135,51)
	CODE (134,52)
	CODE (116,53)
	CODE (153,54)
	CODE (140,55)
	CODE (113,56)
	CODE (141,57)
	CODE (360,"0")
	CODE (361,"1")
	CODE (362,"2")
	CODE (363,"3")
	CODE (364,"4")
	CODE (365,"5")
	CODE (366,"6")
	CODE (367,"7")
	CODE (370,"8")
	CODE (371,"9")
	CODE (172,":")
	CODE (372,32)
	CODE (136,73)
	CODE (114,74)
	CODE (176,75)
	CODE (156,76)
	CODE (157,77)
	CODE (174,100)
	CODE (301,"A")
	CODE (302,"B")
	CODE (303,"C")
	CODE (304,"D")
	CODE (305,"E")
	CODE (306,"F")
	CODE (307,"G")
	CODE (310,"H")
	CODE (311,"I")
	CODE (321,"J")
	CODE (322,"K")
	CODE (323,"L")
	CODE (324,"M")
	CODE (325,"N")
	CODE (326,"O")
	CODE (327,"P")
	CODE (330,"Q")
	CODE (331,"R")
	CODE (342,"S")
	CODE (343,"T")
	CODE (344,"U")
	CODE (345,"V")
	CODE (346,"W")
	CODE (347,"X")
	CODE (350,"Y")
	CODE (351,"Z")
	CODE (112,"[")
	CODE (340,134)
	CODE (132,"]")
	CODE (137,"^")
	CODE (155,"_")
	CODE (171,140)
	CODE (201,"a")		;LOWER CASE
	CODE (202,"b")
	CODE (203,"c")
	CODE (204,"d")
	CODE (205,"e")
	CODE (206,"f")
	CODE (207,"g")
	CODE (210,"h")
	CODE (211,"i")
	CODE (221,"j")
	CODE (222,"k")
	CODE (223,"l")
	CODE (224,"m")
	CODE (225,"n")
	CODE (226,"o")
	CODE (227,"p")
	CODE (230,"q")
	CODE (231,"r")
	CODE (242,"s")
	CODE (243,"t")
	CODE (244,"u")
	CODE (245,"v")
	CODE (246,"w")
	CODE (247,"x")
	CODE (250,"y")
	CODE (251,"z")
	CODE (300,"{")
	CODE (152,"|")
	CODE (320,"}")
	CODE (241,"~")
	CODE (7,177)

XX==0
REPEAT ^D64,<
	MAKE (\XX)
	XX==XX+1>
;[7.1064] GDSTS JSYS processing

MTGTSX:	MOVE T4,JFN		;[7438] Get tape JFN
	CALL SETUNB		;[7438] (T3,T4/IOS) Get unit stuff (no blocking)
	 ITERR (,<CALL UNLCKF>)	;[7.1169] Error, unlock and return
	TDZA T1,T1		;ENTRY FLAG
MTGSX0:	MOVEI T1,1		;ENTRY FLAG
	ASUBR <FLAGS>		;SAVE ENTRY FLAG
	UCALL MTGTS
	TQNE <BLKF>		;NEED TO BLOCK
	RET			;YES
	OPSTR <SKIPE>,TPGDS	;HAVE LOCAL STATUS?
	TXO T1,MT%BOT		;YES
	LOAD T2,TPSTAT		;GET STATUS OF TAPE
	OPSTR <SKIPE>,TPEOF	;EOF LABEL SEEN RECENTLY?
	CAIE T2,.STUTL		;YES. NOW IN TRAILERS?
	SKIPA			;NO. DON'T SET EOF
	TXO T1,MT%EOF		;YES. SAY AT EOF THEN
	SKIPE FLAGS		;JSYS ENTRY?
	RET			;NO. DONE THEN
	JE TPLBD,,R		;IF UNLABLED, DONE
	LOAD T4,TPFRMT		;GET FORMAT
	CAIE T4,TPFSYD		;SYS DEFAULT
	CAIN T4,TPFMTU		;OR UNDEFINED?
	RET			;YES. DONE
	TXNE IOS,OPND		;OPENED IN DUMP MODE?
	RET			;YES, TRUST COUNT RETURNED FROM MAGTAP
	LOAD T3,TPLRC		;NO. GET LAST RECORD COUNT
	XCTU [HRLM T3,3]	;AND RETURN COUNT
	RET

;[7.1064] SDSTS JSYS processing

MTSTSX:	MOVE T4,JFN		;[7438] Get JFN number
	CALL SETUNB		;[7438] (T3,T4/IOS) Set up unit stuff (no blocking)
	 ITERR (,<CALL UNLCKF>)	;[7.1169] Error, unlock and return
	UCALL MTSTS
	RET
;[7.1064] MTOPR JSYS processing

MTMT:	CALL SETUNT		;SET UP UNIT STUFF
	 RETBAD ()		;ERROR
	SKIPL T2		;NEGITIVE ARE ILLEGAL
	CAIL T2,MTMTBL		;CHECK TO SEE IF IN RANGE
	RETBAD (MTOX1)		;ERROR
	SKIPG T3,MTMTOP(T2)	;ALLOW IF UNLABLED?
	JRST [	LBLCHK (MTMTAP) ;NO. CHECK IF LABELED
		JRST .+1]	;NOT
	TXZN T3,1B1		;ALLOW IF NOT OPENED?
	TQNE <OPNF>		;NO. IS IT OPENED?
	JRST [	TXNE T3,NOCRF	;ARE WE MOVING TAPE OPEN FOR READING?
		TQZ <CRNXT,LFNXT>	;YES, CLEAR CRLF STATE.
		JRST 0(T3)]	;GO DO THE FUNCTION
	RETBAD (DESX5)		;NO. ERROR THEN

;[7.1064] MTOPR disptach table layout

				;B0 = IF UNLABELED TAPE, CALL MAGTAP
				;B1 = PERMIT FUNCTION IF JFN IS CLOSED
NOCRF==1B2			;B2 = CLEAR EXTRA CRLF STATE

DEFINE SNOCRF (ITEM)
<	NOCRF!DTBDSP (ITEM)	;;MACRO TO SET NOCRF IN DISPATCH TABLE
>
;[7.1064] MTOPR dispatch table

MTMTOP:	DTBDSP (MTLFCN)		;0 - * CLEAR ERROR FLAGS
	SNOCRF (MTMTRW)		;1 - REWIND THIS VOLUME SET
	DTBBAD (MTOX1)		;2- NO READ BACKWARDS
	DTBDSP (MTWRTM)		;3 - WRITE TAPE MARK
	DTBDSP (MTSDM)		;4 - SET DATA MODE
	DTBBAD (MTOX1)		;5 - SET RECORD SIZE
	SNOCRF (MTSKPR)		;6 - FORWARD RECORD
	SNOCRF (MTBSPR)		;7 - BACKSPACE RECORD
	SNOCRF (SKPEOT)		;10 - SKIP TO EOT
	[RETBAD (DESX9)]	;11 - UNLOAD
	DTBDSP (MTLFCN)		;12 - * READ DENSITY
	DTBBAD (MTOX1)		;13 - ERASE
	DTBDSP (MTLFCN)		;14 - * READ HARDWARE DATA MODE
	DTBDSP (MTLFCN)		;15 - * READ RECORD SIZE (6.1505)
	SNOCRF (MTSKPF)		;16 - FORWARD FILE
	SNOCRF (MTBSPF)		;17 - BACKSPACE FILE
	DTBBAD (MTOX1)		;20 - SET PARITY. NOT LEGAL IF LABELED
	DTBDSP (MTLFCN)		;21 - * READ CURRENT PARITY
	DTBBAD (MTOX1)		;22 - RETURN BYTES LEFT IN CURRENT RECORD
	DTBDSP (MTMTCS)		;23 - FORCE OUTPUT OF PARTIAL BUFFER
	DTBBAD (MTOX1)		;24 - SET DENSITY. NOT LEGAL IF LABELED
	1B0+1B1+MTMTCM		;25 - INFO
	DTBDSP (MTLFCN)		;26 - * RETURN TAPE DIRECTION
	DTBBAD (MTOX1)		;27 - SET REEL ID
	1B1!MTMTCM		;30 - * INHIBIT ERROR LOGGING
	DTBDSP (MTLFCN)		;31 - * WAIT FOR ACTIVITY TO STOP
	DTBBAD (MTOX1)
	DTBDSP (MTMTCM)
	DTBDSP (MTMTCM)
	DTBDSP (MTMTCM)
	DTBDSP (MTMTCM)
	1B0!1B1!MTMTCM		;37 - RETURN STATUS
	1B0!1B1!MTMTCM		;40 - ENABLE ONLINE/OFFLINE PSI
	DTBDSP (MTMTCM)
	DTBDSP (MTPSI)		;42 - PSI FOR TAPE EOV
	SNOCRF (MTRWVL)		;43 -  REWIND VOLUME
	NOCRF!MTVLSW		;44 - DO VOLUME SWITCH. ALLOW IF UNLABELED
	1B0!1B1!MTNTR		;45 - SET/CLEAR NO TRANSLATE FLAG
	DTBDSP (RDULBL)		;46 - READ USER LABELS
	SNOCRF (WTULBL)		;47 - WRITE USER LABELS
	1B1!MTINFL		;50 - READ LABEL INFO
	DTBDSP (TPSMOD)		;51 - SPECIFY MODE OF TAPE
	DTBDSP (MTSDVS)		;52 - SET DEFERRED VOLUME-SWITCH
	DTBDSP (MTMTCM)		;53 - * RETURN IORBS QUEUED

; * PERFORMS SAME MTOPR AS FOR MTA
MTMTBL==<.-MTMTOP>
;SUPPORT ROUTINES FOR MTOPR CODE.

;MTOPR TO FORCE OUT CURRENT RECORD
;USED BEFORE CALLING MAGTAP FOR AN MTOPR FUNCTION AS WELL
;AS FOR OTHER ASSORTED INSTANCES.

MTMTCS:	CALL MTMCSC		;YES-- MUST COMPLETE LAST RECORD
	 RET			;BLOCK OR ERROR
				;FALL INTO COMMON


;MTOPR ACTION CODE. ANY FUNCTION THAT IS COINCIDENT WITH
;MAGTAP CODE COMES HERE. JUST CALLS INTO MAGTAP FOR THE
;WORK

MTMTCM:	MCALL MTMTAP		;TO MTAPE
	 RET
	RETSKP

; ROUTINE TO FINISH LAST RECORD AND FORCE IT TO TAPE

MTMCSC:	LOAD T1,TPFRMT		;GET TAPE FORMAT
	CAIE T1,TPFSYD		;SYSTEM-DEFAULT?
	CAIN T1,TPFMTU		; OR UNDEFINED?
	 RETSKP			;YES-- MAGTAP WILL HANDLE IT
	TQNN <WRTF>		;WRITING?
	 JRST MTMCS1		;NO-- JUST CLEAR VARIABLES
	CALL MTRCO0		;COMPLETE LAST RECORD
	 RET			;BLOCK OR ERROR
	MOVX T2,<1B1>		;GET A LARGE NUMBER
	CALL SQOFIT		;FORCE OUT LAST BLOCK
	 RET			;BLOCK OR ERROR
MTMCS1:	CALL CLRSQ0		;RESET VARIABLES
	RETSKP			;RETURN +2 FROM MTMCSC

;ROUTINE TO SET DEFER-VOLUME-SWITCH

MTSDVS:	CALL SKT20		;MUST BE TOPS-20 TAPE
	 JRST [	CALL SKANS	; OR ANSI TAPE
		 RETBAD (DESX11) ;NEITHER, GIVE ERROR
		JRST .+1]
	LDB T3,[POINT 4,STS,35]	;GET MODE
	CAIE T3,.GSDMP
	RETBAD (DUMPX2)		;JFN IS NOT OPENED IN DUMP MODE
	TQNN <WRTF>
	RETBAD (IOX2)		;FILE IS NOT OPENED FOR WRITING
	SETONE TPDVS		;SET DEFERRED-VOLUME-SWITCH
	RETSKP
;ACTION ROUTINES FOR MTOPR THAT CANNOT BE DONE IN MAGTAP

;REWIND VOLUME

MTRWVL:	TDZA T1,T1		;REWIND VOLUME ENTRY
MTMTRW:	MOVEI T1,1		;REWIND VOLUME SET ENTRY
	ASUBR <FLAG>		;SAVE ENTRY FLAG HERE
	LBLCHK (MTMTAP)		;IF NOT LABELED, GO TO MAGTAP
	CALL CHKSTA		;CHECK STATE
	 RETBAD()		;BADNESS
MTRWV0:	SETZRO FSEQ		;UNKNOWN SEQ NUMBER
	SETZRO TPFSEC		;AND UNKNOWN SECTION
	OPSTR <SKIPN>,TPFVM	;NEED VOLUME SWITCH?
	SKIPN FLAG		;WANT TO REWIND VOLUME SET?
	JRST [	MOVEI T2,.MOREW	;NO. JUST DO THIS ONE THEN
		CALL MTLFCN	;DO REWIND
		 RETBAD ()	;ERROR. PASS IT UP
		JRST FIXSTA]	;AND DONE
	MOVEI T1,.VMVSM		;SEND A VOLUME SWITCH MESSAGE
	MOVEI T2,1		;ONE EXTRA WORD
	XMOVEI T3,[.VSFST]	;MOUNT FIRST VOLUME
	SETOM T4		;NO LABEL READ
	CALL VVBLOK		;WAIT FOR VOLUME TO APPEAR
	 RETBAD()		;ERROR OF SOME SORT
	SETZM FLAG		;NOW JUST DO THIS VOLUME
	JRST MTRWV0		;AND DO IT
FIXSTA:	SETZRO <HDR1,HDR2>	;NO HEADERS NOW
	MOVEI T1,.STCLS		;NOW CLOSED
	STOR T1,TPSTAT		;SET IT UP
	RETSKP			;RETURN

;COMMON ROUTINE TO VERIFY STATE BEFORE REWINDING OR UNLOADING VOLUME

CHKSTA:	TQNN <READF>		;OPEN FOR READ?
	RETBAD (IOX1)		;NO. CAN'T DO IT THEN
	MOVEI T2,.STABH		;YES. SET TRANSIENT STATE WHILE WE DO IT
	STOR T2,TPSTAT
	MOVX T1,CZ%ABT		;AND INSURE TAPE IS CLOSED
	MCALL MTACLZ		;""
	 NOP
	CALL CLREOF		;CLEAR END OF FILE
	RETSKP			;AND DONE
;READ LABEL INFO

MTINFL:	SAVEAC <Q3,P3>		;GET WORK REGS
	TRVAR <<STRING,.LBLEN>>	;A PLACE TO PUT STRINGS
	UMOVE Q3,T3		;GET ARG POINTER
	UMOVE P3,0(Q3)		;GET COUNT
	SOSG P3			;WANT SOME DATA?
	RETBAD (ARGX04)		;NO. ERROR THEN
	JE TPLBD,,[CAILE P3,2	;IF UNLABELED, ONLY FIRST TWO
		   MOVEI P3,2	;ENFORCE IT
		   MOVNS P3	;GET # TO DO
		   HRLZS P3	;AND FORM AOBJN ARG
		   JRST MTINF0]	;AND GO
	LOAD T2,TPSTAT		;GET CURRENT STATE OF TAPE
	TQNE <OPNF>		;JFN OPENED?
	CAIE T2,.STCLS		;NOW CLOSED
	SKIPA			;ALLOW IT AS IS THEN
	CALL OPEN		;YES. ASSUME WAS A POSITION
	 NOP			;WHO CARES?
	UMOVE P3,0(Q3)		;PICK UP COUNT AGAIN
	JE HDR1,,[CAILE P3,VOLCNT+1 ;WANT HDR DATA?
		MOVEI P3,VOLCNT+1 ;YES. CAN'T HAVE IT
		JRST .+1]	;AND PROCEED
	CAILE P3,MTFTLN+1	;BEYOND THE END?
	MOVEI P3,MTFTLN+1	;YES. ONLY DO THE ONES WE KNOW ABOUT
	MOVNI P3,-1(P3)		;GET NEG OF ARG COUNT
	HRLZS P3		;FORM AOBJN WORD
MTINF0:	CALL @MTFTBL(P3)	;DO THIS FIELD
	JRST [	XCTU [HRLM P3,0(Q3)] ;RETURN IT
		RETBAD ()]	;AND ERROR
	AOBJN P3,MTINF0		;DO ALL REQUESTED ENTRIES
	XCTU [HRLM P3,0(Q3)]	;RETURN ENTRIES PROCESSED
	RETSKP			;AND DONE
;RPOCESSING DISPATCH FOR INFO

MTFTBL:	IFIW!MTTYPE		;TYPE OF LABEL
	IFIW!VOLNAM		;VOLUME NAME
	IFIW!OWNER		;OWNER NAME
VOLCNT==.-MTFTBL		;MAX ENTRIES FOR LABEL ONLY
	IFIW!FRMAT		;FORMAT
	IFIW!RECLNN		;RECORD LENGTH
	IFIW!BLKLN		;BLOCK LENGTH
	IFIW!CREDAT		;CREATION DATE
	IFIW!EXPDAT		;EXPIRATION DATE
	IFIW!FILIDN		;FILE IDENTIFIER
	IFIW!GENNUM		;GENERATION NUMBER
	IFIW!GENVNM		;GEN VERSION NUMBER
	IFIW!GETFCB		;GET FORM CONTROL BYTE

MTFTLN==.-MTFTBL		;LENGTH OF TABLE
;UTILITY ROUTINES FOR MTINFL.

;UTILITY TO STORE A VALUE IN USER SPACE

STOVAL:	HRRZ T2,P3		;GET OFFSET
	ADD T2,Q3		;ADD IN BASE
	UMOVEM T1,1(T2)		;RETURN TO USER
	RET			;DONE

;RETURN A STRING

STOSTG:	MOVEI T2,1(P3)		;GET OFFSET +1
	ADD T2,Q3		;COMPUTE ADDRESS
	UMOVE T4,0(T2)		;GET SP
	JUMPE T4,R		;IF NONE, DON'T RETURN IT
	TLC T4,-1
	TLCN T4,-1
	HRLI T4,(<POINT 7,>)	;FORM SP
	TLC T1,-1
	TLCN T1,-1
	HRLI T1,(<POINT 7,>)
STOST0:	ILDB T3,T1		;GET A BYTE
	UMOVEM T4,0(T2)		;SAVE CURRENT VALUE
	XCTBU [IDPB T3,T4]	;STASH IT
	JUMPN T3,STOST0		;DO THEM ALL
	RET			;AND DOEN

;LOCAL ROUTINE TO GET A STRING FROM THE LABEL
;	T2 AND T3 SET UP FOR GETLBL

GTLBLL:	MOVEI T1,1+STRING	;CLEAR RECEIVE AREA
	SETZM STRING		;INIT ZEROEING
	HRLI T1,STRING
	BLT T1,.LBLEN-1+STRING	;DO IT
	HRROI T1,STRING		;WHERE IT IS GOING
	CALLRET GETLBL		;AND FETCH IT
;ACTION ROUTINES

MTTYPE:	JE TPLBD,,[MOVEI T1,.LTUNL ;IF UNLABELED, SAY SO
		   JRST MTTYP0]	;AND DONE
	MOVEI T1,.LTANS		;ASSUME ASCII
	OPSTR <SKIPE>,TPT20	;TOPS20?
	MOVEI T1,.LTT20		;YES
	OPSTR <SKIPE>,TPEBD	;EBCDIC?
	MOVEI T1,.LTEBC		;HOW ABOUT EBCDIC
MTTYP0:	CALL STOVAL		;STORE IT
	RETSKP			;AND DONE

;RETURN VOLUME NAME

VOLNAM:	MOVE T2,.V1VID
	MOVEI T3,V1LOC		;WHERE IT IS
	CALL GTLBLL		;FETCH IT
	 RETBAD ()		;ERROR OF SOME SORT
	HRROI T1,STRING		;THE DATA
	CALL STOSTG		;STORE THE STRING
	RETSKP			;AND DONE

;RETURN OWNER NAME

OWNER:	JE TPT20,,[SETZM STRING	;IF NOT TOPS20, NO OWNER NAME
		JRST OWNER0]	;DO IT
	MOVE T2,.UVNAM		;TOPS20 TAPE. GET OWNER NAME
	MOVEI T3,UVLOC		;WHERE IT IS
	CALL GTLBLL		;GET IT
	 RETBAD ()
OWNER0:	HRROI T1,STRING		;WHERE IT IS
	CALL STOSTG		;RETURN IT
	RETSKP			;AND DONE

;RETURN FORMAT OF DATA

FRMAT:	JE HDR2,,[MOVEI T1,TPFMTF
		JRST FRMAT0]
	LOAD T1,TPFRMT
FRMAT0:	LDB T1,[POINT 7,FMTTAB(T1),6] ;GET FORMAT CHARACTER
	CALL STOVAL
	RETSKP
;MORE MTINFL ACTION ROUTINES

;RETURN RECORD LENGTH

RECLNN:	LOAD T1,TPRSZ		;GET RECORD LENGTH
RECLN0:	CALL STOVAL		;RETURN IT
	RETSKP			;AND DONE

;RETURN BLOCK LENGTH

BLKLN:	JE HDR2,,[LOAD T1,TPBSZ	;IF NO HDR2, USE MONITOR DEFAULT
		JRST BLKLN0]
	MOVE T2,.H2BLN		;GET IT FROM HDR2
	MOVEI T3,H2LOC		;""
	CALL GETLBL
	 RETBAD()		;UHOH
BLKLN0:	CALL STOVAL		;STORE IT
	RETSKP			;AND DONE

;RETURN CREATION DATE

CREDAT:	MOVE T2,.H1CRE
	MOVEI T3,H1LOC		;WHERE IT IS
	CALL GETLBL		;GET IT
	 SETOM T1		;SAY INVALID
	CALL STOVAL		;STORE IT
	RETSKP			;AND DONE

;RETURN EXPIRATION DATE

EXPDAT:	MOVE T2,.H1EXP
	MOVEI T3,H1LOC		;WHERE IT IS
	CALL GETLBL		;GET IT
	 SETOM T1		;SAY INVALID
	CALL STOVAL		;STORE RESULT
	RETSKP			;AND DOEN
;MORE MTINFL ACTION ROUTINES

;RETURN FILE IDENTIFIER

FILIDN:	MOVE T2,.H1FNM		;WHERE THE NAME IS
	MOVEI T3,H1LOC
	CALL GTLBLL		;GET VALUE
	 RETBAD ()		;SOME STRANGE ERROR
	HRROI T1,STRING		;WHERE IT IS
	CALL STOSTG		;RETURN STRING
	RETSKP			;AND DONE

;RETURN GEN AND GEN VERSION

GENNUM:	SKIPA T2,.H1GEN		;GEN
GENVNM:	MOVE T2,.H1GNV		;GEN VERSION
	MOVEI T3,H1LOC		;WHERE THE LABEL IS
	CALL GETLBL		;GET VALUE
	 RETBAD ()		;ERROR
	CALL STOVAL		;RETURN VALUE TO USER
	RETSKP			;DONE

;GET FORM CONTROL BYTE.

GETFCB:	CALL GETFC0		;CALL WORKER ROUTINE
	 RETBAD()		;UH OH
	CALLRET MTTYP0		;AND STORE IT
;WORKER ROUTINE TO EXTRACT FORM CONTROL BYTE.
;RETURNS:	+1 BAD LABEL (BYTE TYPE IS UNKNONW)
;		+2 T1/ FORMAT TYPE

GETFC0:	JN TPEBD,,[ MOVEI T1,.TPFNC ;IF EBCDIC, NO CONTROLS
		    RETSKP]	;RETURN SUCCESS
	HRROI T1,[ASCIZ /D%/]	;CHECK FOR DEC TAPE
	MOVE T2,.V1OP0
	MOVEI T3,V1LOC		;WHERE LABEL IS
	OPSTR <SKIPE>,HDR2	;IF NO HDR2, NO FORM CONTROL
	CALL LBLCMP		;DO IT
	 JRST [	MOVEI T1,.TPFNC	;IF NOT DEC, NO CONTROLS
		RETSKP]		;AND DONE
GETFC2:	SETZM T1
	MOVE T2,.H2FMC		;GET FROM CONTROL BYTE
	MOVEI T3,H2LOC		;FROM LABEL 2
	CALL GETLBL		;GET IT
	 RETBAD()		;ERROR
	MOVSI T3,-<.TPFMX+1>	;# OF WORDS TO DO
GETFC1:	LDB T4,[POINT 7,MODTBL(T3),6] ;GET THE BYTE
	CAIE T4,0(T1)		;THIS IT?
	JRST [	AOBJN T3,GETFC1	;ANY MORE
		RETBAD (IOX22)]	;NO. ILLEGAL TAPE THEN
	MOVEI T1,0(T3)		;YES. GET IT THEN
	RETSKP			;RETURN SUCCESS
;MTOPR ROUTINE TO DO A VOLUME SWITCH FOR UNLABLED TAPES.
;USER ARGS ARE:
;	T3/ POINTER TO BLOCK OF FORM:
;	COUNT
;	FLAGS,,SUBCODE
;	SUBCODE ARG

MTVLSW:	STKVAR <<VLSARG,2>>	;VOLUME SWITCH ARGS
	UMOVE T4,3		;GET POINTER TO ARGS
	UMOVE T3,0(T4)		;GET COUNT
	SOSG T3			;ANY DATA?
	RETBAD (ARGX04)		;NO. ERROR THEN
	UMOVE T1,1(T4)		;GET ARG
	MOVEM T1,VLSARG		;SAVE IT
	HRRZS T1		;GET SUBFUNCTION
	LOAD T2,TPLBD		;T2/ 0=UNLABELED, 1=LABELED
	CAIN T1,.VSFLS		;LABELED VOLUME SWITCH?
	JRST [	JUMPE T2,[RETBAD (DESX11)] ;YES, LABELED TAPES ONLY
		JE TPDVS,,[RETBAD (DESX11)] ;OK ONLY IF DEFERRED V/S
		LOAD T1,TPSTAT
		CAIE T1,.STRDY	;MUST BE IN READY STATE
		RETBAD (DESX11)
		CALLRET EOV]	;SWITCH VOLUMES
	JUMPN T2,[RETBAD (DESX11)] ;CAN'T DO THIS IF LABELED
	MOVEI T2,1		;COUNT OF ADDITIONAL ARGS
	SKIPLE T1
	CAILE T1,.VSMRV		;VALID FUNCTION?
	RETBAD (ARGX02)		;NO. ERROR THEN
	SOJLE T3,MTVLS0		;IF NO MORE ARGS, DONE
	ADDI T2,1		;ONE MORE ARG
	UMOVE T1,2(T4)		;GET SUBFUNC ARG
	MOVEM T1,1+VLSARG	;STORE IT

;ARGS ALL FORMED

MTVLS0:	MOVEI T1,.VMVSM		;THE FUNCTION TO DO
	XMOVEI T3,VLSARG	;WHERE THE DATA IS
	CALLRET VVBLOK		;DO VOLUME SWITCH

	ENDSV.			;END STKVAR
;MTOPR FUNCTIONS TO POSITION LABELED TAPES.

;SKIP RECORD. FORWARD ONLY FOR NOW

MTSKPR:	SAVEAC <Q3>		;GET A WORK REG
	TQNN <READF>		;READING THE TAPE?
	RETBAD (IOX1)		;ILLEGAL REFERNENCE
	TQNE <EOFF>		;AT THE EOF NOW?
	RETBAD (IOX4)		;YES.
MTSKR2:	CALL INCHK		;VERIFY STATE
	 RETBAD ()		;ERROR
	LDB T3,[POINT 4,STS,35]	;GET OPEN MODE
	CAIN T3,.GSDMP		;DUMP MODE?
	JRST MTSKR3		;YES.
	LOAD T3,TPFRMT		;GET FORMAT
	CAIE T3,TPFSYD		;SYS DEFAULT?
	CAIN T3,TPFMTU		;OR UNDEFINED?
MTSKR3:	JRST [	CALL DUMPIN	;YES. READ A RECORD THEN
		 JRST SKPERR	;ERROR
		RETSKP]		;AND DONE
	LOAD Q3,TPEBD		;GET EBCDIC/ASCII INDICATOR

;FORMATTED RECORDS

	MOVE T1,FILLEN(JFN)	;GET LENGTH OF RECORD
	SUB T1,TPFLNX(U)	;DISCOUNT NEXT BLOCK PART
	CAMLE T1,FILBYN(JFN)	;READ IT ALL?
	JRST MTSKR0		;NO. SKIP IT THEN

;AT END OF RECORD

MTSKR1:	CALL @[	IFIW!SQIGRF	;FIXED
		IFIW!SQIGRD	;VARIABLE
		IFIW!SQIGRS]-1(T3) ;SPANNED
	 JRST SKPERR		;ERROR. GO ANALYZE
	JRST MTSKR2		;AND NOW SKIP THE RECORD
;ERROR FETCHING NEXT RECORD

SKPERR:	TQNE <EOFF>		;AT THE EOF?
	CALL EOV		;YES. DO EOV PROCESSING
	 RETBAD ()		;ERROR OF SOME SORT
	TQNE <EOFF>		;STILL AT EOF?
	RETBAD ()		;YES. SAY SO
	JRST MTSKPR		;NOW SKIP THE RECORD

;NEED TO SKIP RECORD NOW IN PROGRESS

MTSKR0:	SKIPGE T2,FILCNT(JFN)	;GET REMAINDER IN CURRENT BUFFER
	SETZM T2		;BUT NOT NEG
	SETZM FILCNT(JFN)	;NO MORE LEFT
	ADDM T2,FILBYN(JFN)	;USE THESE BYTES
	ADJBP T2,FILBYT(JFN)	;ADJUST BYTE POINTER
	MOVEM T2,FILBYT(JFN)
	CAMLE T1,FILBYN(JFN)	;AT THE END NOW?
	JRST [	CALL MTSQII	;NO. GET NEXT BUFFER THEN
		TQNE <ERRF,BLKF> ;OKAY TO PROCEED/
		RET		;NO
		JRST MTSKR2]	;YES
	SKIPE TPFLNX(U)		;YES. NEED TO GO FORWARD ANYWAY?
	CAIE T3,TPFMTS		;?
	RETSKP			;DONE
	JRST MTSKR1
;MTOPR ROUTINE TO SKIP TO NEXT LOGICAL FILE

MTSKPF:	LOAD T1,TPSTAT		;GET STATE
	CAIE T1,.STCLS		;NOW CLOSED?
	JRST [	CALLRET CLOSEP]	;YES. CLOSE IT THEN
	JE HDR1,,[CALL HDRCHK	;IF NO HEADERS YET, GET THEM
		   RETBAD ()	;ERROR
		 JRST .+1]	;PROCEED
	MOVEI T1,1		;NEED TO SKIP ONE FILE
	CALLRET SKPFIL		;DO IT

;SKIP TO EOT (ACTUALLY TO END OF VOLUME SET)

SKPEOT:	CALL CLOSEP		;MAKE SURE IS CLOSED
	 RETBAD ()		;BAD
	SETZRO USRSEQ		;NO FURTHER POSITIONING
SKPEO0:	CALL HDRCHK		;GET HEADERS OF NEXT FILE
	 JRST [	CAIE T1,IOX24	;EOT?
		RETBAD ()	;NO. ERROR THEN
		TQZ <ERRF>	;NO ERROR IF SO
		RETSKP]		;YES. DONE
	MOVEI T1,1		;FOUND A FILE
	CALL SKPFIL		;SO, SKIP IT
	 RETBAD ()		;ERROR
	JRST SKPEO0		;AND CONTINUE

;LOCAL ROUTINE TO POS TO NEXT FILE AND CLOSE

CLOSEP:	CALL INCHK		;GET TO DATA
	 RETBAD()		;ERROR
	CALLRET CLOSE		;AND DONE
;ROUTINES TO IMPELMENT "BACKSPACE". A VERY DIFFICULT THING TO DO

;BACKSPACE RECORD. CALLED FROM MTOPR CODE

MTBSPR:	LOAD T1,TPSTAT		;GET PRESENT STATE
	CAIN T1,.STUTL		;AT EOF LABEL SET?
	JRST [	MOVEI T2,.MOBKF	;YES. BACK UP ONE FILE
		CALL MTLFCN	;"
		 RETBAD()	;ERROR
		DECR FSEQ	;STILL IN PREVIOUS FILE
		CALLRET SETRD0]	;AND DONE
	CALL INCHK		;VERIFY STATE
	 RETBAD ()		;ERROR
	LDB T1,[POINT 4,STS,35]	;GET OPEN MODE
	CAIN T1,.GSDMP		;DUMP MODE?
	JRST MTBSR0		;YES
	LOAD T1,TPFRMT		;GET TAPE FORMAT
	CAIE T1,TPFSYD		;SYS DEFAULT?
	CAIN T1,TPFMTU		;OR UNDEFINED?
MTBSR0:	JRST [	SKIPE T1,FILBYN(JFN) ;IN THE MIDST OF A RECORD?
		JRST [	MOVEI T2,.MOBKR ;YES. SAFE TO USE MAGTAP THEN
			CALLRET MTLFCN] ;DO IT
		CALL MTGPBL	;YES. GET PREVIOUS BLOCK
		 RETBAD ()	;ERROR
		MOVE T1,TPFLEN(U) ;GET LENGTH
		MOVEM T1,FILLEN(JFN)
		MOVE T1,TPFCNT(U) ;GET BYTE COUNT
		MOVEM T1,FILCNT(JFN) ;STASH IT
		CALL CLRSQ1	;CLEAR UNUSED FIELDS
		RETSKP]		;DONE

;FORMATTED RECORD TYPE. MUST DO SOME ANALYSIS

	CALL @[	IFIW!BKSRF	;FIXED
		IFIW!BKSRD	;VARIABLE
		IFIW!BKSRSP]-1(T1) ;SPANNED
	 RETBAD ()		;ERROR
	RETSKP			;DONE
;HANDLE VARIABLE RECORD


BKSRD:	SAVEAC <Q3>
	STKVAR <SVBYN>
	LOAD Q3,TPEBD		;GET EBCDIC/ASCII INDICATOR
	SKIPE FILBYN(JFN)	;IN THE MIDST OF A RECORD?
	JRST [	CALL NILREC	;YES. GET BACK TO START OF IT
		RETSKP]		;AND DONE
	SKIPE T2,TPFBYN(U)	;ANY BYTES PRECEDING?
	JRST [	MOVEM T2,SVBYN	;YES. SAVE IT
		CALL STBLK	;GET TO START OF BLOCK
		 RETBAD ()	;ERROR
		JRST DOPRC0]	;AND PROCEED
	CALL MTGPBL		;GET PREVIOUS BLOCK
	 RETBAD ()		;ERROR
	MOVE T2,TPFLEN(U)	;GET LENGTH
	MOVEM T2,SVBYN		;SAVE IT
DOPRC0:	CALL SQIGRD		;GET NEXT REOCRD
	 JRST [	TQZE <BLKF>	;WANT TO BLOCK?
		CALL MTFCNC	;YES. DO IT THEN
		 RETBAD ()	;ERROR
		JRST .-1]	;TRY AGIAN
	CALL GTEBYN		;GET END BYTE NUMBER
	CAMN T1,SVBYN		;THIS THE PREVIOUS?
	JRST [	CALL NILREC	;YES. GET BACK TO START
		RETSKP]		;AND DONE
	CALL CHKFIL		;SEE IF REMAINDER OF BLOCK IS FILLED
	 JRST [	CALL NILREC	;IT IS
		RETSKP]		;DONE
	CALL MTSKPR		;NO. SKIP CURRENT RECORD
	 RETBAD ()		;?
	JRST DOPRC0		;AND TRY AGAIN

	ENDSV.
;BACKSPACE SPANNED RECORD

BKSRSP:	SAVEAC <Q3>		;GET WORK REG
	TRVAR <FLAG>		;GET A WORD
	LOAD Q3,TPEBD		;GET ASCII/EBCDIC INDICATOR
	SETZM FLAG
	SKIPE FILBYN(JFN)	;IN THE MIDST OF A SEGMENT?
	CALL [SETOM FLAG
		CALLRET NILREC]	;AND RECOVER IT
	CALL SQIGS0		;GET THE RECORD
	 RETBAD ()		;ERROR
	CAILE T1,"1"		;START OF A RECORD?
	JRST [	CALL BKSEGS	;NO. GET PREVIOUS SEG
		 RETBAD ()	;ERROR
		SETOM FLAG	;REMEMBER THIS
		JRST .-1]	;AND TRY AGAIN
	SKIPE FLAG		;IF RECOVERED A RECORD, DONE
	JRST [	CALL NILREC	;YES.
		RETSKP]		;AND DONE

;AT BEGINNING OF CURRENT RECORD. NOW BACK UP

BKSRS1:	CALL BKSEGS		;BACK UP
	 RETBAD ()		;ERROR
	SETZM TPFLNX(U)		;NO NEXT
	CAIG T1,"1"		;START OF A SEG?
	RETSKP			;YES. DONE THEN
	JRST BKSRS1		;NO. BACK AGAIN THEN

	ENDTV.			;END TRVAR
;SUBROUTINE TO BACK UP ONE SPANNED SEGEMENT
;RETURNS	+1 ERROR
;	+2 SUCCESS. T1/ SPAN DESCRIPTOR
;ON SUCCESS, POSITIONED TO START OF RECORD

BKSEGS:	STKVAR <SVBYN,SVSEGT>	;SAVE BYTE NUMBER HERE
	CALL NILREC		;GET TO START OF CURRENT
	SKIPE T1,TPFBYN(U)	;ANY BYTE PRECEDING THIS ONE?
	JRST [	MOVEM T1,SVBYN	;YES. SAVE POSITION
		CALL STBLK	;GET TO START OF BLOCK
		 RETBAD ()	;ERROR
		JRST BKSGS0]	;AND PROCEED
	CALL MTGPBL		;GET PREVIOUS BLOCK
	 RETBAD ()		;ERROR
	MOVE T2,TPFLEN(U)	;GET POSITION
	MOVEM T2,SVBYN		;SAVE IT
BKSGS0:	SETZM TPFLNX(U)
	CALL SQIGS0		;GET THIS SEG
	 JRST [	TQZE <BLKF>	;WANT TO BLOCK
		CALL MTFCNC	;YES. DO SO
		 RETBAD ()	;ERROR
		JRST .-1]	;TRY AGAIN
	MOVEM T1,SVSEGT		;SAVE SEGMENT TYPE
	CALL GTEBYN
	CAMN T1,SVBYN		;NOW ON PRECEDING RECORD?
	JRST [	MOVE T1,SVSEGT	;YES. RECOVER SEGMENT TYPE
		RETSKP]		;AND RETURN
	CALL CHKFIL		;SEE IF REMAINDER OF BLOCK IS FILL
	 JRST [	MOVE T1,SVSEGT	;IT IS. AT THE END THEN
		RETSKP]		;AND DONE
	MOVE T1,FILCNT(JFN)	;GET COUNT OF BYTES IN RECORD
	ADDM T1,FILBYN(JFN)	;UPDATE COUNT
	ADJBP T1,FILBYT(JFN)	;UPDATE BP
	MOVEM T1,FILBYT(JFN)
	SETZM FILCNT(JFN)	;NO MORE LEFT IN RECORD
	JRST BKSGS0		;KEEP LOOKING

	ENDSV.			;END STKVAR
;HANDLE FIXED RECORD

BKSRF:	STKVAR <SVBYN>
	SKIPE FILBYN(JFN)	;IN THE MIDST OF A RECORD
	JRST [	CALL NILREC	;YES. RECOVER IT
		RETSKP]		;AND DONE
	SKIPE T2,TPFBYN(U)	;AT THE BEGINNING OF THE BLOCK
	JRST [	MOVEM T2,SVBYN	;SAVE BYTE
		CALL STBLK	;GET TO START OF BLOCK
		 RETBAD ()	;ERROR
		JRST BKRF1]	;AND GO

;RECORD IS NOT IN THIS BLOCK.

BKSRF1:	CALL MTGPBL		;GET PREVIOUS BLOCK
	 RETBAD ()		;ERROR
	MOVE T2,TPFLEN(U)	;GET LENGTH
	MOVEM T2,SVBYN		;SAVE IT
BKRF1:	CALL SQIGRF		;GET A RECORD
	 JRST [	TQZE <BLKF>	;WANT TO BLOCK
		CALL MTFCNC	;YES. DO IT
		 RETBAD ()
		JRST .-1]	;PROCEED
	CALL GTEBYN		;GET END
	CAMN T1,SVBYN		;THIS IT?
	RETSKP			;YES. DONE
	CAML T1,SVBYN		;DID WE PASS IT?
	JRST BKSRF1		;YES. PREVIOUS BLOCK THEN
	CALL MTSKPR		;NO. SKIP THE RECORD
	 RETBAD ()
	JRST BKRF1		;AND CONTINUE

	ENDSV.			;END STKVAR
;BACK UP CURRENT RECORD

NILREC:	SKIPN T1,FILBYN(JFN)	;IN THE MIDST OF A RECORD?
	RET			;NO. DONE THEN
	CALL SQRPOS		;GET TO START OF REC
	SETZM FILCNT(JFN)	;NO MORE BYTES
	SETZM FILBYN(JFN)	;AND NO POSITION
	SETZM FILLEN(JFN)
	LOAD T2,TPOCT		;GET OLD COUNT
	MOVEM T2,TPFCNT(U)	;STASH IT
	LOAD T2,TPOBY		;GET OLD BYTE NUMBER
	MOVEM T2,TPFBYN(U)	;STASH IT
	RET			;DONE

;ROUTINE TO GET TO START OF BLOCK

STBLK:	CALL CLRSQV		;CLEAR ALL VARIABLES
	MOVEI T2,.MOBKR		;BACK UP ONE BLOCK
	CALLRET MTLFCN		;DO IT

;ROUTINE TO COMPUTE END OF CURRENT RECORD

GTEBYN:	MOVE T1,FILLEN(JFN)	;GET SIZE OF RECORD
	ADD T1,TPFBYN(U)	;COMPUTE WHERE IT WOULD END IN BUFFER
	SUB T1,FILBYN(JFN)	;DISCOUNT PORTION IN THIS PIECE
	SUB T1,FILCNT(JFN)	;""
	SUB T1,TPFLNX(U)
	RET			;AND DONE

;ROUTINE TO CHECK IF REMAINDER OF BLOCK IS FILLED
;RETURNS:	+1 IT IS
;		+2 NOT

CHKFIL:	MOVE T2,TPFLEN(U)	;GET MAX BYTES IN BLOCK
	SUB T2,TPFBYN(U)	;COMPUTE BYTES REMAINING
	JUMPLE T2,RSKP		;IF NO MORE, NOT FILLED
	MOVE T1,FILCNT(JFN)	;GET COUNT IN THIS RECORD
	ADJBP T1,FILBYT(JFN)	;GET TO START OF NEXT CHUNK
CHKFL0:	ILDB T3,T1		;GET NEXT BYTE
	CAME T3,["^"
		  EBDFIL](Q3)	;A FILL BYTE?
	RETSKP			;NO. BLOCK NOT FILLED THEN
	SOJG T2,CHKFL0		;DO ALL BYTES
	RET			;IS FILLED

;POSITION TAPE TO PREVIOUS BLOCK.
;USED WHENEVER THE CURRENT BLOCK DOES NOT CONTAIN THE DESIRED
;RECORD.
;RETURNS:	+1 FAILED. EITHER NO PREVIOUS BLOCK, OR TAPE ERROR
;		+2 SUCCESS. BET YOU THOUGHT IT COULDN'T BE DONE

MTGPBL:	STKVAR <SVSEC,SVSEQ>	;THE UBUIQUITOUS "WORK" CELLS
	CALL CLRSQV		;FULSH CURRENT BYTES
	CALL MTGSX0		;GET UPDATED STATUS
	TQNN <ERRF>		;ERROR?
	TQNE <BLKF>		;OR BLOCK?
	RETBAD ()		;YES. RETURN
	TXNE IOS,MT%EOF		;EOF ENCOUNTERED?
	JRST [	LOAD T1,TPFRMT	;YES. GET FORMAT
		CAIE T1,TPFMTU	;"U"?
		CAIN T1,TPFSYD	;OR SYS DEFAULT?
		SKIPA		;YES
		JRST .+1	;NO. LET IT BE DISCOVERED THEN
		CALL CLREOF	;CLEAR EOF INDICATORS
		MOVEI T2,.MOBKR	;BACK OVER IT
		CALL MTLFCN	;BACK OVER THE EOF
		 RETBAD ()	;ERROR
		CALL CLREOF	;NO LONGER ON THE EOF
		RETSKP]		;AND DONE
	CALL CLREOF		;CLEAR EOF INDICATORS
	MOVEI T2,.MOBKR		;BACK UP OVER CURRENT BLOCK
	CALL MTLFCN		;""
	 RETBAD ()		;ERROR
	JRST MTGPRR		;GO READ IN THE BLOCK

;HIT EOF MARK DOING BACKSPACE. SEE ABOUT VOLUME SWITCH

MTGPB2:	CALL CLREOF		;CLEAR EOF
	LOAD T1,TPFSEC		;GET CURRRENT SECTION
	SOSG T1			;SECTION 1?
	RETBAD (IOX4)		;YES. AT BEGINNING-OF-FILE THEN
	MOVEM T1,SVSEC		;SAVE SECTION TO GET
	LOAD T1,FSEQ		;GET FILE SEQUENCE NUMBER
	MOVEM T1,SVSEQ		;SAVE THAT AS WELL
	SETZRO TPFSEC		;UNKNOWN SECTION NEXT
	SETZRO FSEQ		;AND UNKNOWN SEQ NUMBER AS WELL
	MOVEI T1,.VMVSM		;REQUEST VOLUME SWITCH
	MOVEI T2,2
	XMOVEI T3,[.VSMRV
		-1]		;GET PREVIOUS VOLUME
	SETOM T4		;NO NOTIFICATION OF HEADERS
	CALL VVBLOK		;DO VOLUME SWITCH
	 RETBAD ()		;COULDN'T
;NOW AT BEGINNING OF NEW VOLUME. MUST POSITION TO PROPER FILE

MTGPB1:	LOAD T1,FSEQ		;GET THIS SEQ NUMBER
	CAME T1,SVSEQ		;PROPER ONE?
	JRST MTGPBN		;NO. MUST POSITION THEN
	JN TPEBD,,MTGPB0	;IF EBCDIC, SKIP SECTION CHECK
	LOAD T1,TPFSEC		;GET FILE SECTION
	CAME T1,SVSEC		;BETTER MATCH
	MTERET (IOX22,<CALL LBLERR>) ;DOESN'T. FATAL ERROR
MTGPB0:	CALL INCHK		;MATCH. GET TO DATA PORTION OF FILE
	 RETBAD ()		;ERROR
	MOVEI T2,.MOFWF		;SKIP DATA
	CALL MTLFCN		;""
	 RETBAD ()		;TAPE ERROR
	CALL CLREOF		;CLEAR ANY LATENT INDICATORS
	MOVEI T2,.MOBKR		;BACK UP OVER EOF
	CALL MTLFCN
	 MTERET()		;ERROR
	CALL CLREOF
	MOVEI T2,.MOBKR		;NOW GET SET TO DO FINAL POSITION
	CALL MTLFCN		;DO IT
	 MTERET ()		;ERROR
	; ..
;NOW POSITIONED TO PROPER BLOCK. READ IT

MTGPRR:	LDB T2,[POINT 4,STS,35]	;SEE IF DUMP MODE
	CAIN T2,.GSDMP		;DUMP MODE?
	JRST MTGRR0		;YES
	LOAD T1,TPFRMT		;GET FORMAT AS WELL
	CAIE T1,TPFSYD		;SYS DEFAULT?
	CAIN T1,TPFMTU		;OR UNDEFINED?
MTGRR0:	JRST [	CALL DUMPIN	;YES. GET A RECORD
		 JRST MTGPWT	;CHECK FOR ERROR
		MOVEI T2,.MOBKR	;READ FINE
		CALLRET MTLFCN]	;AND DONE
	MOVEI T2,1		;GET ONE BYTE
	CALL SQGRCA		;DO IT
MTGPWT:	 JRST [	TQNE <EOFF>	;HIT EOF?
		JRST MTGPB2	;YES. CHECK VOLUME SWITCH THEN
		TQZN <BLKF>	;WANT TO BLOCK?
		RETBAD ()	;NO. ERROR. GIVE UP
		CALL MTFCNC	;YES. WAIT FOR DATA THEN
		 RETBAD ()	;ERROR
		JRST MTGPRR]	;TRY AGAIN

;BLOCK READ. POSITION TO BEGINNING

	SETZM FILBYN(JFN)
	SETZM FILLEN(JFN)
	MOVE T1,TPFBYN(U)	;GET BYTE # IN MTA BUFFER
	ADDM T1,TPFCNT(U)	;INCREASE AVAIALBLE BYTES
	SETZM TPFBYN(U)
	SETZM FILCNT(JFN)	;NO BYTE COUNT NOW EITHER
	RETSKP			;AND DONE
;UTILITY USED BY SKIP AND BACKSPACE RECORD TO SKIP
;A DUMP MODE RECORD

DUMPIN:	MOVEI T2,.MOFWR		;SKIP THE RECORD
	CALL MTLFCN		;DO IT
	 RETBAD ()		;ERROR
	TXNE IOS,MT%EOF		;HIT A TAPE MARK?
	RET			;YES. SAY ABNORMAL TERMINATION
	RETSKP			;NO. DONE THEN
;FILE IS NOT THE PROPER ONE. MUST ADVANCE TAPE

MTGPBN:	CAML T1,SVSEQ		;WITHIN RANGE?
	RETBAD (IOX22)		;NO. BAD TAPE THEN
	MOVEI T1,.STCLS		;"CLOSE" THE FILE
	STOR T1,TPSTAT		;NEW STATE
	MOVEI T1,1		;NEED TO SKIP THIS FILE
	CALL SKPFIL		;SO DO IT
	 RETBAD ()		;ERROR
	JN HDR1,,MTGPB1		;IF HAVE HEADERS NOW, PROCEED
	CALL HDRCHK		;NOT. GET THEM
	 RETBAD ()		;ERROR
	JRST MTGPB1		;AND GO LOOK AT FILE

	ENDSV.			;END STKVAR

;MTOPR ROUTINE TO SET DATA MODE OR RECORD SIZE.
;ONLY ALLOWABLE IF FILE IF FILE OPENED IN DUMP MODE
;OR RECORDED IN U FORMAT

MTSDM:	STKVAR <SVCODE>		;SAVE MTOPR CODE HERE
	MOVEM T2,SVCODE
	LOAD T1,TPSTAT		;GET STATE
	CAIE T1,.STCLS		;NOW CLOSED?
	JRST MTSDM1		;NO. SKIP OPEN THEN
	CALL OPEN		;MAKE SURE IS OPEN
	 RETBAD ()		;ERROR
MTSDM1:	LDB T1,[POINT 4,STS,35]	;GET DATA MODE
	LOAD T2,TPFRMT		;GET DATA FORMAT
	CAIE T2,TPFMTU		;UNDEFINED?
	CAIN T2,TPFSYD		;OR SYS DEFAULT?
	MOVEI T1,.GSDMP		;YES. ALLOW IT THEN
	CAIE T1,.GSDMP		;IS IT DUMP MODE?
	RETBAD (MTOX1)		;NO. ILLEGAL FUNCTION THEN
	MOVE T2,SVCODE		;GET BACK MTOPR CODE
	MCALL MTMTAP		;IT IS. GO TO MAGTAP
	 RETBAD ()		;ERROR
	LOAD T2,TPUNIT		;GET THE MTA UNIT NUMBER
	LOAD T2,MTDM,(T2)	;GET THE PREVAILING DATA MODE
	STOR T2,TPDM		;SET THE PREVAILING DATA MODE
	RETSKP			;SUCCESS

	ENDSV.			;END STKVAR
;BACKSPACE FILE CODE.

MTBSPF:	TQNN <READF>		;READING?
	RETBAD (IOX1)		;NO. ERROR
	LOAD T1,TPSTAT		;GET STATE
	CAIE T1,.STRDY		;NOW IN THE FILE?
	CAIN T1,.STUHL		;OR IN THE HEADERS?
	JRST [	CALL MTBSFI	;YES. GET TO START OF THIS FILE
		 RETBAD ()	;ERROR OF SOME SORT
		JRST .+1]	;AND PROCEED
MTBSFI:	SAVEAC <Q3>		;GET A WORK REG
	STKVAR <SVSEQ,<PLRARG,2>> ;WORK CELLS

MTBSF0:	LOAD T1,TPSTAT		;GET STATE
	JRST @.+1(T1)		;GO DO STATE PROCESSING
	STDIS (BS)		;GEN STATE TABLE
	; ..
;BACSPACE FILE CONTINUED.
;ACTION ROUTINES

BS.HDR:
BS.CLS:	JN HDR1,,BS.CL0		;IF ALREADY HAVE HEADERS, PROCEED
	CALL HDRCHK		;TAPE CLOSED. GET HEADERS
	 JRST [	CAIE T1,IOX24	;EOF ERROR?
		RETBAD (,<CALL LBLERR>) ;NO. ERROR
		JRST BSUHL0]	;AND BACK INTO FILE
BS.CL0:	MOVEI T1,.STUHL		;NOW IN USER LABELS
	STOR T1,TPSTAT		;SAY SO
	JRST MTBSF0		;AND PROCEED

;READY

BS.RDY:	MOVEI Q3,1		;BACK UP ONE FILE
	CALL BKIT
	 RETBAD ()		;ERROR
	MOVEI T2,.STUHL		;CHANGE STATE
	STOR T2,TPSTAT
	JRST BSCHK		;AND SEE IF WE ARE DONE

;IN USER TRAILERS

BS.UTL:	MOVEI Q3,1
	CALL BKIT		;BACK UP TO DATA
	 RETBAD ()
	MOVEI T2,.STRDY
	STOR T2,TPSTAT		;CHANGE STATE
	DECR FSEQ		;AND NOW ON PREVIOUS SEQ NUMBER
	JRST MTBSF0

;HANDLE ABORTED CONDITION

BS.ABH:	CALL OPEN		;REPOSITION TAPE
	 RETBAD ()		;OOPS
	JRST MTBSF0		;GOT IT. PROCEED

;INTERRRUPTED VOLUME SWITCH

BS.VLS:	CALL VOLSW0		;TRY TO COMPLETE VOL SWITCH
	 RETBAD()		;CAN'T
	JRST MTBSF0		;AND PROCEED
;BACKSPACE FILE CONTINUED. IN UHL STATE

BS.UHL:	LOAD T1,TPFSEC		;GET CURRENT SECTION
	SOJG T1,BSVSW		;IF GREATER 1, NEED TO SWITCH VOLUMES
	LOAD T1,FSEQ		;ON FIRST SECTION
	SOJE T1,[CALL MTRWVL	;IF ON FIRST, DO REWIND
		  RETBAD ()	;ERROR
		SETONE TPGDS	;SAY AT BOT
		RETSKP]		;AND SUCCEED

;NOT ON FIRST FILE. BACK UP

BSUHL0:	MOVEI Q3,2		;# OF FILES TO DO
	CALL BKIT		;DO IT
	 RETBAD (,<CALL LBLERR>) ;ERROR
	DECR FSEQ		;ON PREVIOUS ONE NOW
	SETZRO TPFSEC		;UNKNOWN SECTION
	MOVEI T2,.MOFWF		;SKIP INTO TRAILERS AGAIN
	CALL MTLFCN		;DO IT
	 RETBAD (,<CALL LBLERR>) ;ERROR
	CALL CLREOF		;IN CASE MAGTAP SETS THIS
	CALL HDRCHT		;CHECK TRAILERS
	 RETBAD (,<CALL LBLERR>) ;ERROR
	MOVEI Q3,1		;GET TO DATA
	CALL BKIT
	 RETBAD (,<CALL LBLERR>) ;ERROR
	MOVEI T1,.STRDY		;NOW IN DATA PORTION
	STOR T1,TPSTAT		;SAY SO
	JRST MTBSF0		;AND LOOK INTO IT

;LOCAL ROUTINE TO DO C(Q3) BACKUPS

BKIT:	MOVEI T2,.MOBKF		;BACK ONE TAPE MARK
	CALL MTLFCN		;DO IT
	 RETBAD ()		;ERROR
	CALL CLREOF		;CLEAR ANY LATENT INDICATORS
	SOJG Q3,BKIT		;DO THEM ALL
	RETSKP			;DONE
;NEED TO SWITCH VOLUMES

BSVSW:	LOAD T2,FSEQ		;GET CURRENT FILE SEQUENCE NUMBER
	MOVEM T2,SVSEQ		;SAVE IT
	MOVNM T1,1+PLRARG	;# OF VOLUMES TO GO BACK
	MOVEI T1,.VSMRV
	MOVEM T1,PLRARG		;THE SUBFUNCTION
	XMOVEI T3,PLRARG	;THE DATA
	MOVEI T2,2		;# OF WORDS
	MOVEI T1,.VMVSM		;MOUNT FUNCTION
	SETZRO <FSEQ,TPFSEC>	;DON'T CARE ABOUT THESE
	SETOM T4		;NO INTS
	CALL VVBLOK		;REQUEST THE VOLUME
	 RETBAD ()		;ERROR

;NOW FIND PROPER FILE ON THIS TAPE (IT WILL BE THE LAST ONE)

BSVSW0:	LOAD T1,FSEQ		;GET SEQ #
	CAMN T1,SVSEQ		;THE ONE?
	JRST BSCHK		;YES.
	CAML T1,SVSEQ		;WITHIN RANGE?
	RETBAD (IOX22,<CALL LBLERR>) ;NO. BAD TAPE
	MOVEI T1,1
	CALL SKPFIL		;SKIP THIS ONE
	 RETBAD ()		;ERROR
	JN HDR1,,BSVSW0		;IF HAVE HEADERS, GO ON
	CALL HDRCHK		;DON'T. GET THEM
	 RETBAD ()		;ERROR
	JRST BSVSW0		;AND PROCEED

	ENDSV.			;END STKVAR
;FOUND THE FILE. MAKE SURE WE ARE ON THE FIRST SECTION

BSCHK:	LOAD T1,TPFSEC		;GET SECTION #
	SOJG T1,MTBSF0		;IF NOT FIRST SECTION, PROCEED

;FOUND THE FILE. NOW WE WANT TO "CLOSE" IT

;	CALLRET BKCLS		;DO IT, AND DONE

;ROUTINE TO "CLOSE" FILE. USED TO POSITION TO START OF HEADERS

BKCLS:	MOVEI T1,.STABH		;SAY ABORTED FOR NOW
	STOR T1,TPSTAT
	MOVX T1,CZ%ABT
	MCALL MTACLZ		;CLOSE THE MTA
	 NOP			;CAN'T FAIL
	MOVEI Q3,1		;BACK ONE FILE
BKCHK1:	MOVEI T2,.MOBKR		;BACK UP ONE RECORD
	CALL MTLFCN		;DO IT
	 RETBAD (,<CALL LBLERR>) ;ERROR
	SOJG Q3,BKCHK1		;DO ALL REQUESTED

;CHECK IF ON THE HEADER LABELS

BKCHK0:	MOVEI T2,.LBFRD		;READ A LABEL
	CALL MTLFCN
	 RETBAD()
	HRROI T1,[ASCIZ /HDR1/]	;IS IT THE ONE WE WANT?
	MOVE T2,.H1LID
	SETOM T3
	CALL LBLCMP		;DO COMPARE
	 SKIPA Q3,[2]		;NO. KEEP BACKING UP
	SKIPA T2,[.STCLS]	;NEW STATE
	JRST BKCHK1		;NO. DO PREVIOUS ONE
	STOR T2,TPSTAT		;SET STATE
	SETZRO <HDR1,HDR2>	;NO LABELS IN NOW
	MOVEI T2,.MOBKR		;BACK OVER HDR1
	CALLRET MTLFCN		;AND DONE
;WRITE TAPE MARK MTOPR

MTWRTM:	TQNN <WRTF>		;WRITING THE TAPE?
	RETBAD (IOX2)		;NO. ERROR THEN
	LOAD T1,TPSTAT		;GET PRESENT STATE
	CAIE T1,.STCLS		;ALREADY CLOSED?
	CAIN T1,.STUTL		;ALREADY IN TRAILERS?
	TDZA T1,T1		;YES.
	MOVEI T1,1		;NO
	CALLRET @[IFIW!CLOSE	;IF SECOND TIME
		  IFIW!CLSUTL](T1) ;IF FIRST TIME

;SET MODE OF TAPE


TPSMOD:	UMOVE T1,3		;GET MODE
	SKIPL T1		;VALID?
	CAILE T1,.TPFMX		;STILL?
	RETBAD (ARGX05)		;NO
	STOR T1,TPMOD		;YES. SAVE IT
	RETSKP			;AND DONE
;GTJFN LOOKUP ROUTINES FOR TAPE

;DIRECTORY LOOKUP

MTDIR:	TQNE <STEPF>		;WANT TO STEP IT?
	RETBAD (GJFX17)		;YES. CAN'T DO IT THEN
	TQNE <NREC,NREC1>	;WANT RECOGNITION?
	IFSKP.
	  TQO AMBGF		;YES, SAY AMBIGUOUS
	  RET
	ENDIF.
	MOVX T2,177B6		;MAKE SURE STRING IS NULL
	TDNE T2,1(T1)		;IS IT?
	RETBAD (GJFX17)		;NO. ERROR THEN
	RETSKP

;NAME LOOKUP

MTNAM:	CALL MTNML		;DO LOCAL PROCESSING
	 JRST [	JUMPN T1,R	;ERROR
		TQO AMBGF	;AMBIGUOUS
		RET]
	RETSKP			;SUCCESS

MTNML:	SAVEAC <U,IOS>		;PRESERVE U
	TRVAR <ARGIN,<FILID,.LBLEN>> ;LOCAL STORAGE
	MOVEM T1,ARGIN		;SAVE INCOMING ARG
	XMOVEI T3,PRSWAT	;SET UP TEST INSTRUCTION
	CALL SETUNA		;GO DO UNIT STUFF
	 RETBAD()		;NONE DECLARED.
	IFQE. TPLBD
	  TQNE <NAMSF>		;WANT STEPPING?
	  RETBAD (GJFX31) 	;YES. ERROR
	  RETSKP		;DONE
	ENDIF.
	MOVE T1,ARGIN		;GET INCOMING POINTER
	CALL TSTSIZ		;TEST SIZE OF STRING
	 RETBAD (GJFX53)	;TOO LONG
	TQNE <NAMSF,EXTSF,VERSF> ;STEPPING?
	IFSKP.
	  SKIPE T1		;NO. NULL NAME?
	  TQNN <OLDNF>		;NO. OLD FILE THEN?
	  RETSKP		;LEAVE IT HERE
	ENDIF.
	LOAD T1,TPSTAT		;GET PRESENT STATE
	CAIE T1,.STCLS		;PROPER STATE?
	RETBAD (IOX32)		;NO.
	JN TPOPN,,[RETBAD (OPNX9)] ;CAN'T DO LOOKUP IF OPENED
	; ..
;TAPE IS TOPS20 TAPE. CHECK STATE

	TQNN <NREC,NREC1>	;WANT RECOGNITION
	CALLRET RFALSE		;YES. CAN'T HAVE IT
	JN HDR1,,MTNAM1		;JUMP IF ALREADY HAVE HEADERS
	CALL HDRCHK		;READ AND CHECK HEADERS
	 JRST NOFILE		;CHECK OUT ERROR CODE

;HAVE LABELS

MTNAM1:	TQNN <NAMSF,EXTSF,VERSF> ;ANYTHING STEPPING?
	JRST MTNAM2		;NO. GO ON THEN
	MOVE T1,[DP%RD,,FP%DIR]	;YES, CHECK FOR LIST ACCESS
	CALL DOACC		;DO IT
	 JRST [	CALL GETNXT	;NONE ALLOWED. NEXT FILE THEN
		 JRST NOFILE	;CHECK OUT ERROR CODE
		JRST MTNAM2]	;AND DONE
MTNAM2:	CALL PRSNAM		;GET AND PARSE FILE NAME
	 RETBAD ()
	SKIPN ARGIN		;WANT FIRST NAME?
	JRST CPYNAM		;YES. ALL DONE THEN
	TQNE <STEPF>		;STEPPING?
	TQNN <NAMSF>		;STEPPING NAME?
	SKIPA T1,[POINT 7,FILID] ;NO
	JRST [	MOVE T1,[POINT 7,FILID] ;GET POINTER TO FILE NAME
		MOVE T2,ARGIN	;GET LOOKUP POINTER
		CALL CMPR	;IS NAME SAME AS ONE WE ARE STEPPING?
		 JRST CPYNAM	;NO. ALREADY STEPPED THEN
		CALL GETNXT	;YES. STEP IT THEN
		 JRST NOFILE	;CHECK OUT ERROR CODE
		CALL PRSNAM	;PARSE THE NAME
		 RETBAD ()	;ERROR OF SOME SORT
		JRST CPYNAM]	;AND GO USE IT

;NEED TO COMPARE NAME

	TQNE <NAMSF>		;IS THE NAME STEPPABLE?
	RETSKP			;YES. LEAVE IT ALONE THEN
	MOVE T2,ARGIN		;LOOKUP POINTER
	MOVE T3,1(T2)		;GET FIRST WORD OF STRING
	TXNN T3,177B6		;NULL STRING?
	RETSKP			;YES. LEAVE IT HERE THEN
	CALL CMPR		;COMPARE THEM
	 JRST [	CALL GETNXT	;GET NEXT FILE
		 JRST NOFILE	;CHECK OUT ERROR CODE
		JRST MTNAM2]	;AND TRY AGAIN
	RETSKP			;SUCCESS
;SUPPORT ROUTINES FOR NAME LOOKUP
;COPY A NAME STRING

CPYNAM:	MOVE T1,[POINT 7,FILID]	;THE NAME
CPYNM0:	ILDB T2,T1		;GET BYTE
	IDPB T2,FILOPT(JFN)	;RETURN NAME
	JUMPN T2,CPYNM0		;DO IT ALL
	MOVNI T1,1
	ADJBP T1,FILOPT(JFN)
	MOVEM T1,FILOPT(JFN)	;ADJUST BYTE POINTER
	RETSKP			;AND DONE

;GET AND PARSE NAME

PRSNAM:	HRROI T1,FILID
	MOVE T2,.H1FNM		;I.D.
	MOVEI T3,H1LOC		;LOCATION OF LABEL
	CALL GETLBL		;GET LABEL
	 MTERET(,<CALL LBLERR>)	;BAD LABEL
	MOVE T1,[POINT 7,FILID]	;SET TO SCAN LABEL
	MOVE T4,T1		
	MOVEI T3,^D17		;MAX SIZE
PRSNM0:	ILDB T2,T1		;GET NEXT BYTE
	CAIN T2,"."		;AT THE EXTENSION?
	JRST PRSNM1		;YES
	CAIN T2," "		;BLANK ?
	SETZM T2		;YES, REPLACE BY ZERO
	IDPB T2,T4		;DEPOZIT CHAR
	SOJG T3,PRSNM0		;DO ALL OF NAME
PRSNM1:	SETZM T2
	SKIPN T3		;AT THE END?
	IBP T1			;YES
	DPB T2,T1		;TIE OFF NAME
	RETSKP			;AND DONE
;GET TO NEXT FILE ON TAPE
GETNXA:	TDZA T1,T1		;DON'T CHECK ACCESS
GETNXT:	SETOM T1		;CHECK ACCESS
	ASUBR <FLAG>		;SAVE THE FLAG
GETNX1:	JE HDR1,,[RETBAD (IOX4)] ;ALREADY AT EOF
	SETZRO <HDR1,HDR2>	;NO MORE HEADERS
	MOVEI T2,.MOFWF		;SKIP TO EOF
	CALL MTLFCN		;DO IT
	 MTERET (,<CALL LBLERR>) ;ERROR.
	MOVEI T2,.MOFWF		;NOW SKIP OVER DATA PORTION
	CALL MTLFCN		;DO TI
	 MTERET (,<CALL LBLERR>) ;ERROR
	CALL TLRCHK		;CHECK THE TRAILERS
	 RETBAD ()		;SOME SORT OF ERROR
	JN TPEOF,,GETNX0	;IF END-OF-FILE, DONE
	; ..
;GETNXT CONTINUED. AT EOV

;NEED A VOLUME SWITCH

	MOVEI T1,.VMVSM		;SWITCH VOLUME
	MOVEI T2,2
	XMOVEI T3,[.VSMRV
		1]		;MOUNT NEXT
	SETOM T4		;NO LABEL READ PLEASE
	CALL VVBLOK		;WAIT HERE
	 RETBAD ()		;ERROR OF SOME SORT
	MOVEI T1,.STCLS		;SET STATE PROPERLY
	STOR T1,TPSTAT		;SET IT
	JRST GETNX1		;AND PROCEED WITH SKIPPING

;DON'T NEED A VOLUME SWITCH

GETNX0:	MOVEI T2,.MOFWF		;SKIP OVER TRAILERS
	CALL MTLFCN		;DO IT
	 MTERET (,<CALL LBLERR>) ;UHOH
	MOVEI T1,1
	STOR T1,TPFSEC		;INIT SECTION NUMBER
	SKIPN FLAG		;WANT TO PROCEED WITH NEXT FILE?
	JRST [	SETZRO <HDR1,HDR2> ;NO
		RETSKP]		;AND DONE
	CALL HDRCHK		;CHECK OU THE HEADERS
	 RETBAD ()		;BAD
	TQNN <NAMSF,EXTSF,VERSF> ;SOME KIND OF STEPPING?
	RETSKP			;NO. USE THIS FILE
	MOVE T1,[DP%RD,,FP%DIR]	;YES, CHECK FOR LIST ACCESS
	CALL DOACC		;CHECK IT OUT
	 JRST GETNX1		;NO ACCESS. GET NEXT FILE
	RETSKP			;DONE
;COMPARE TWO STRINGS

;T1/	STRING POINTER
;T2/	LOOKUP POINTER

CMPR:	ACVAR <W1>		;GET A WORK REG
	HLRE T3,T2		;GET COUNT
	MOVNS T3		;GET POS COUNT
	ADDI T3,1		;GET COUNT OF WORDS
	IMULI T3,5		;CONVERT TO BYTE COUNT
	HRLI T2,(<POINT 7,0,35>) ;FORM STRING POINTER
CMPR0:	ILDB T4,T1		;GET BYTE FROM TEST STRING
	ILDB W1,T2		;GET BYTE FROM OTHER
	CAME T4,W1		;COMPARE?
	RET			;NO
	JUMPE T4,RSKP		;IF NULL, DONE
	SOJG T3,CMPR0		;IF MORE BYTES, GO
	ILDB T4,T1		;LOOKUP POINTER EXHAUSTED
	JUMPE T4,RSKP		;IF STRING IS ALSO, GOOD
	RET			;NOT

	ENDAV.			;END OF ACVAR

;LOCAL ROUTINE TO DO WAIT FOR VOULME SWITCH AND I/O
	RESCD

PRSWAT:	PUSH P,FILDEV(JFN)	;SAVE FILDEV WORD
	PUSH P,FILSTS(JFN)	;SAVE THIS AS WELL
	HDISMS (^D80)		;DO DISMISS
	POP P,T2		;RECOVER OLD STS
	POP P,T1		;RECOVER OLD FILDEV WORD
	CAMN T2,FILSTS(JFN)	;IS STS THE SAME?
	CAME T1,FILDEV(JFN)	;AND IT MUST BE THE SAME DEVICE
	RETBAD (DESX4)		;IF NOT, ERROR
	RETSKP			;AND DONE
	SWAPCD
;[7.1064] Compute size of a string in a lookup pointer
;
;Call:    T1/ Lookup pointer
;Returns: T1/ Count of characters
;	  T2, T3, T4 smashed
;	  +1 if string is greater than 17 characters
;	  +2 if string is less than or equal to 17 characters

TSTSIZ:	SKIPE T1		;WANT FIRST ONE?
	TQNE <STEPF>		;STEPPING?
	JRST [	SETZM T1	;YES. RETURN NO SIZE THEN
		RETSKP]
	HLRE T2,T1		;GET COUNT
	MOVNS T2
	ADDI T2,1		;ONE MORE FOR GOOD MEASURE
	IMULI T2,5		;MAX # OF CHARACTERS
	MOVE T3,T1		;[7.1064] Get furnished address
	HRLI T3,(<POINT 7,0,35>) ;[7.1064] Form BP to next word (string)
	SETZ T1,		;[7.1064] Init count of characters in string
TSTSZ0:	ILDB T4,T3		;[7.1064] Get the next character
	JUMPE T4,TSTSZ1		;[7.1064] Jump if a null there
	SOSE T2			;[7.1064] Any more characters?
	AOJA T1,TSTSZ0		;[7.1064] Nope, count this one and loop
TSTSZ1:	CAILE T1,^D17		;[7.1064] Within range?
	RET			;[7.1064] No, error then, return T1
	RETSKP			;[7.1064] Yes, good return with T1/count
;EXTENSION LOOKUP FOR TAPE

MTEXT:	CALL MTEXL		;DO LOCAL PROCESSING
	 JRST [	JUMPN T1,R	;ERROR
		TQO AMBGF	;AMBIGUOUS
		RET]
	RETSKP			;SUCCESS

MTEXL:	SAVEAC <U,IOS>		;PRESERVE THIS AC
	TRVAR <ARGIN,<FILID,.LBLEN>,EXTPTR,SVSIZ>
	MOVEM T1,ARGIN		;SAVE INCOMING LOOKUP POINTER
	XMOVEI T3,PRSWAT	;GET TEST INST
	CALL SETUNA		;GO DO UNIT STUFF
	 RETBAD (GJFX53)	;ERROR
	JE TPLBD,,[	TQNE <EXTSF> ;WANT STEPPING?
			RETBAD (GJFX31) ;YES. ERROR
			RETSKP] ;DONE
	TQNN <NREC,NREC1>	;WANT RECOGNITION?
	CALLRET RFALSE		;YES. CAN'T HAVE IT
	MOVE T1,ARGIN		;GET INCOMING POINTER
	CALL TSTSIZ		;CHECK SIZE OF POINTER
	 RETBAD (GJFX53)	;TOO LONG
	SKIPE T1		;[7.1064] Was there an extension string?
	ADDI T1,1		;[7.1064] Yes, account for "." before it
	MOVEM T1,SVSIZ		;SAVE ITS LENGTH
	HLRZ T1,FILNEN(JFN)	;GET NAME
	HRRZ T2,0(T1)		;GET # OF WORDS IN BLOCK
	MOVNI T2,-1(T2)		;FORM LOOKUP POINTER COUNT
	HRL T1,T2		;FORM LOOKUP POINTER
	CALL TSTSIZ		;GET ITS SIZE
	 RETBAD (GJFX53)	;TOO LONG
	ADD T1,SVSIZ		;GET SIZE OF BOTH STRINGS
	CAILE T1,^D17		;[7.1064] Does it fit in the label?
	 RETBAD (GJFX53)	;NO
	TQNN <NAMSF,EXTSF,VERSF> ;ANY STEPPING GOING ON?
	JRST [	SKIPE T1	;NO. ANY BYTES?
		TQNN <OLDNF>	;YES. SEARCH TAPE?
		RETSKP		;NO.
		JRST .+1]	;YES. PROCEED
	JN TPOPN,,[RETBAD (OPNX9)] ;CAN'T DO LOOKUP IF OPENED
	; ..
;READY TO CHECK EXTENSIONS

	CALL PRSEXT		;FIND NAME AND EXTENSION
	 RETBAD()		;BADNESS
EXTNM1:	SKIPN ARGIN		;WANT FIRST ONE?
	JRST CPYEXT		;YES. ALL DONE THEN
	TQNE <STEPF>		;STEPPING?
	TQNN <EXTSF>		; AND THE EXTENSION?
	SKIPA T1,EXTPTR		;NO
	JRST [	CALL CHKNAM	;SEE IF NAME CHANGED
		 RETBAD (GJFX19) ;IT DID. NO MORE EXTS
		MOVE T1,EXTPTR	;DIDN'T. GO ON
		MOVE T2,ARGIN	;GET INCOMING POINTER
		JUMPE T2,CPYEXT	;IF WANT FIRST ONE, DONE
		CALL CMPR	;SEE IF ALREADY STEPPED
		 JRST CPYEXT	;YES. USE IT THEN
		CALL GTNXTE	;GET NEXT ONE AND CHECK NAME
		 RETBAD ()	;BADNESS
		JRST CPYEXT]	;COPY EXTENSION

;NOT STEPPING. SEE IF WE HAVE THE DESIRED EXTENSION

	TQNE <EXTSF>		;IS EXTENSION STEPPABLE?
	RETSKP			;YES. LEAVE IT ALONE THNE
	MOVE T2,ARGIN		;GET LOOKUP POINTER
	HLRZ T4,FILNEN(JFN)	;GET FILE NAME AS WELL
	MOVX T3,177B6		;GET MASK FOR FIRST BYTE
	TDNN T3,1(T2)		;IS EXT NULL?
	TDNE T3,1(T4)		;YES. FILE NAME TOO?
	SKIPA			;NO
	RETSKP			;YES. NO COMPARISON THEN
	CALL CMPR		;SEE IF WE HAVEIT YET
	 JRST [	CALL GTNXTE	;GET NEXT EXTENSION AND VERIFY NAME
		 RETBAD()	;COULDN'T
		JRST EXTNM1]	;PROCEED
	RETSKP			;SUCCESS
;SUPPORT ROUTINES FOR EXTENSION LOOKUP

;GET NEXT FILE

GTNXTE:	CALL GETNXT		;GET NEXT FILE FROM TAPE
	 JRST NOFILE		;CHECK OUT ERROR CODE
	CALL PRSEXT		;FIND NAME AND EXTENSION
	 RETBAD ()		;BADNESS
	MOVE T1,[POINT 7,FILID]	;PINTER TO NAME
	HLRZ T2,FILNEN(JFN)	;GET NAME FROM JFN BLOCK
	CALL MKLKUP		;FORM LOOKUP POINTER AND GO TO CMPR
	 RETBAD (GJFX19)	;IT DID. NO MORE EXTS THEN
	RETSKP			;DIDN'T. USE IT

;COPY EXTENSION NAME

CPYEXT:	MOVE T1,EXTPTR		;GET POINTER
	CALLRET CPYNM0		;DO IT

;PARSE NAME AND EXTENSION

PRSEXT:	CALL PRSNAM		;DO NAME
	 RETBAD()		;ERROR OF SOME SORT
	MOVEM T1,EXTPTR		;WHERE THE EXT IS
	SOJLE T3,[IDPB T2,T1	;NO EXT
		RETSKP]		;AND DONE
PRSEX0:	ILDB T2,T1		;GET NEXT
	CAIN T2," "		;AT THE END YET?
	SKIPA			;YES
	SOJG T3,PRSEX0		;NO. KEEP LOOKING
	SETZM T2
	SKIPN T3		;AT THE END
	IBP T1
	DPB T2,T1		;TIE IT OFF
	RETSKP			;AND DONE

;SEE IF NAME HAS CHANGED

CHKNAM:	MOVE T1,[POINT 7,FILID]
	HLRZ T2,FILNEN(JFN)	;GET NAME IN GTJFN BLOCK
	CALLRET MKLKUP		;GO DO COMPARE

;SEE IF EXT CHANGED

CHKEXT:	MOVE T1,EXTPTR		;GET POINTER TO EXT
	HRRZ T2,FILNEN(JFN)	;GET EXT NAME

MKLKUP:	HRRZ T3,0(T2)		;GET COUNT OF STRING
	MOVNI T3,-1(T3)		;GET COUNT-1
	HRL T2,T3		;FORM LOOKUP POINTER
	CALLRET CMPR		;GO DO STRING COMPARE
;LOOKUP VERSION

MTVER:	SAVEAC <U,IOS>		;PRESERVE THIS AC
	TRVAR <ARGIN,<FILID,.LBLEN>,EXTPTR,SVVER>
	MOVEM T1,ARGIN		;SAVE INCOMING ARGUMENT
	XMOVEI T3,PRSWAT	;GET WAIT INST
	CALL SETUNA		;DO UNIT STUFF
	 RETBAD ()		;ERROR
	JE TPLBD,,[	TQNE <VERSF> ;WANT STEPPING?
			RETBAD (GJFX31) ;YES. ERROR
			RETSKP] ;DONE
	TQNN <NAMSF,EXTSF,VERSF> ;STEPPING?
	JRST [	HLRZ T1,FILNEN(JFN) ;GET FILE NAME
		MOVE T1,1(T1)	;GET FIRST WORD
		TXNE T1,177B6	;NULL NAME?
		TQNN <OLDNF>	;NO. DO SEARCH?
		SKIPA		;LEAVE IT HERE
		JRST .+1	;SEARCH
		TQO NEWVF	;NO. SAY IS NEW VERSION
		SKIPG T1,ARGIN	;SPECIFIC VERSION WANTED?
		MOVEI T1,DFLTV	;NO. USE SYS DEFAULT THEN
		RETSKP]		;AND LEAVE TAPE HERE
	JN TPOPN,,[RETBAD (OPNX9)] ;CAN'T DO LOOKUP IF OPENED
	CALL PRSEXT		;PARSE NAME AND EXTENSION
	 RETBAD ()		;IMPOSSIBLE, BUT...
	CALL PRSVER		;GET VERSION FROM TAPE
	 RETBAD ()		;SOMETHING IS WRONG
	TQNE <STEPF>		;STEPPING?
	TQNN <VERSF>		;YES. STEPPING THE VERSION?
	SKIPA			;NO
	JRST MTVER1		;YES

;NOT STEPPING. SEE IF WE HAVE THE DESIRED VERSION

MTVER0:	TQNN <VERSF>		;NON-STEPPABLE VERSION?
	SKIPG T2,ARGIN		;SPECIFIC VERSION WANTED?
	JRST CPYVER		;NO. RETURN THE ONE WE ARE ON THEN
	CAMN T2,SVVER		;IS THIS THE ONE?
	JRST CPYVER		;YES. ALL DONE
	CALL GTNXTV		;NO. GET NEXT
	 RETBAD()		;NO MORE
	JRST MTVER0		;DO THEM ALL
;HERE WHEN STEPPING VERSIONS

MTVER1:	CALL CHKEXT		;SEE IF EXT CHANGED
	 RETBAD (GJFX20)	;IT DID
	CALL CHKNAM		;SEE IF NAME CHANGED
	 RETBAD (GJFX20)	;DID
	MOVE T2,ARGIN
	JUMPL T2,CPYVER		;IF WANT FIRST ONE, DONE
	SKIPE SVVER		;IS VERSION ON TAPE 0?
	JRST [CAME T2,SVVER	;SAME NUMBER AS LAST FILE?
	      JRST CPYVER	;NO USE IT
	      LOAD T1,TPUNIT	;GET MTA UNIT
	      CALL PHYPOS	;GET POSITION INFO
	      HRRZ T1,FILMS2(JFN) ;GET POSITION FROM LAST VERSION STEPPED
	      CAME T2,T1	 ;SAME POSITION?
	      JRST CPYVER	;NO, USE THIS FILE
	      JRST .+1]		;YES, OLD FILE, USE NEXT ONE
	CALL GTNXTV		;GET NEXT VERSION
	 RETBAD ()		;BADNESS
	JRST CPYVER		;AND USE IT
;SUPPORT ROUTINES FOR MTVER

;COPY VERSION

CPYVER:	LOAD T1,TPUNIT		;GET MTA UNIT
	CALL PHYPOS		;GET POSITION INFO
	HRRM T2,FILMS2(JFN)	;SAVE TAPE POSITION INFO
	MOVE T1,SVVER		;GET CURRENT VERSION
	RETSKP			;AND DONE

;GET NEXT VERSION FROM TAPE

GTNXTV:	CALL GTNXTE		;GET NEXT EXTENSION
	 RETBAD()		;ERROR
	MOVE T2,EXTPTR		;GET POINTER TO EXTENSION
	HRRZ T2,FILNEN(JFN)	;GET EXT BLOCK IN FILE
	CALL MKLKUP		;FORM LOOKUP POINTER AND DO CMPR
	 RETBAD (GJFX20)	;NO MORE VERSIONS
	CALLRET PRSVER		;PARSE THE VERSION AND DONE

;COMPUTE VERSION OF FILE

PRSVER:	MOVE T2,.H1GEN		;GET GENERATION
	MOVEI T3,H1LOC		;WHERE THE DATA IS
	CALL GETLBL		;FETCH IT FROM LABEL
	 MTERET (,<CALL LBLERR>) ;ERROR
	MOVEM T1,SVVER		;SAVE VERSION
	MOVE T2,.H1GNV		;GET GENERATION VERSION
	MOVEI T3,H1LOC		;WHERE THE DATA IS
	CALL GETLBL		;DO IT
	 MTERET(,<CALL LBLERR>)	;ERROR
	MOVE T2,SVVER		;[7.1064] Load generation in T2
	CAIN T2,1		;[7.1064] If the generation is 1, and the
	JUMPE T1,RSKP		;[7.1064]  gen version is 0 then return gen 1
	SUBI T2,1		;[7.1064] It's a DEC STD 149 generation number
	IMULI T2,^D100		;[7.1064]  so the file's version is
	ADDI T2,1(T1)		;[7.1064]    ((gen-1)*100)+(gnv+1)
	MOVEM T2,SVVER		;AND SAVE IT
	RETSKP			;AND DONE

;ROUTINE USED BY MTDIR,MTNAM AND MTEXT TO ANALYZE FAILURE
;FROM GETNXT OR HDRCHK.
;	T1/ ERROR CODE

NOFILE:	CAIN T1,IOX24		;AT EOT?
	MOVEI T1,GJFX52		;YES. SAY NO SUCH FILE THEN
	RET			;AND DONE
;PROTECTION INSERTION.

MTPRO:	SAVEAC <U,IOS>		;SAVE VULNERABLE REGS
	CALL SETUNA		;SET UP U
	 RETBAD ()		;ERROR
	MOVE T2,FILPRT(JFN)	;GET PROTECTTION
	JE TPT20,,R		;IF NOT A TOPS20 TAPE, CAN'T DO THIS
	TXZ T2,7700		;IGNORE "GROUP" FIELD
	TRO T2,770000		;MAKE SURE OWNER CAN DO IT ALL
	MOVEM T2,FILMTP(JFN)	;SAVE PROTECTION
	RET			;AND DONE

;ROUTINE CALLED FROM RLJFN FOR MT JFNS. THIS CODE INSURES THAT
;THE ASSOCIATED MTA IS NOT OPENED

RELMT:	SAVEAC <U,IOS>		;SAVE VULNERABLE REGS
	CALL SETUNB		;SET UP INDEX
	 RET			;WHO CARES
	JN TPOP0,,[SETZRO <TPOP0,TPOPN> ;CLEAR BITS IF IN TRANSITION
		   JRST .+1]	;CONTINUE
	JN TPOPN,,RELMT0	;IF TAPE IS OPENED, NOTHING TO DO
	JE TPLPCS,,RELMT0	;IF NO OPERATIONS, DON'T CLOSE MTA
	MOVX T1,CZ%ABT		;ABORT ANY OUTSTANDING OPERATIONS
	MCALL MTACLZ		;""
	 NOP			;WILL WORK
	SETZRO TPLPCS		;NO MORE I/O GOING ON
	MOVEI T1,.STABH		;PUT IN ABORTED STATE
	STOR T1,TPSTAT		;DO IT
RELMT0:	RET			;AND DONE

;ROUTINE USED BY JFNS TO FETCH SPECIFIED PROTECTION

MTGPRO::MOVE T1,FILMTP(JFN)	;GET PROTECTION
	RET			;AND DONE
;PROCESS ATTRIBUTES

;	T1/ LOOKUP BLOCK FOR ATTRIBUTE VALUE
;	T2/ ATTRIBUTE TYPE CODE

;FIRST, TABLE OF VALID ATTRIBUTES

ATRTBL:	.PFFMT,,FMTCOD
	.PFEXP,,EXPCOD
	.PFBLK,,BLKCOD
	.PFRLN,,RLNCOD
	.PFPOS,,POSCOD		;FILE POSITION ARG
ATTLEN==.-ATRTBL		;TABLE LENGTH

;PROCESS AN ATTRIBUTE

MTATR:	SAVEAC <U,IOS>		;Preserve U and IOS
	ASUBR <LKBLK,ATT>	;SAVE INCOMING ARGS
	CALL SETUNB		;DO UNIT PROCESSING
	 RETBAD ()		;NONE DECLARED YET
	MOVSI T3,-ATTLEN	;GET AOBJN WORD
MTATR0:	HLRZ T4,ATRTBL(T3)	;GET CODE
	CAMN T4,ATT		;THIS IT?
	JRST [	HRRZ T3,ATRTBL(T3) ;GET PROCESSING ROUTINE
		MOVE T1,LKBLK	;GET BLOCK ADDRESS
		JRST 0(T3)]	;GO DO IT
	AOBJN T3,MTATR0		;LOOK AT ENTIRE TABLE
	RETBAD (GJFX49)		;NO SUCH ATTRIBUTE
;PROCESSING ROUTINES

;SPECIFYING FORMAT

FMTCOD:	MOVX T3,177B13		;MAKE SURE ONE CHARACTER ONLY
	TDNE T3,1(T1)		;IS IT?
	RETBAD (IOX25)		;NO. ERROR THEN
	LDB T1,[POINT 7,1(T1),6] ;GET FORMAT

;NOW VERIFY IT IS A KNOWN FORMAT TYPE

	CALL CHKFM0		;CHECK BUT DON'T STORE VALUE
	 RETBAD ()		;NOT GOOD
	RETSKP			;AND DONE

;EXPIRATION DATE

EXPCOD:	HRROI T1,1(T1)		;POINT TO STRING
	MOVX T2,IT%NTI		;NO TIME
	IDTNC			;GET RESULT
	 ERJMP [RETBAD (,<MOVE T1,T2>)] ;BAD
	SETZM T4		;AT THE BEGINNING OF THE DAY
	IDCNV			;GET INTERNAL FORMAT
	 ERJMP [RETBAD()]
	RETSKP			;AND DONE

;DO BLOCK SIZE

BLKCOD:

;DO RECORD SIZE

RLNCOD:

;POSITION ATTRIBUTE

POSCOD:	HRROI T1,1(T1)		;POINT TO STRING
	MOVEI T3,^D10		;GET DECIMAL NUMBER
	NIN			;""
	 ERJMP [RETBAD  (,<MOVE T1,T3>)]
	RETSKP			;AND DONE
;ROUTINE TO OPEN A TAPE (CHECK FOR VOLUME VALID)

MTOPN:	CALL SETUNA		;SET UNIT INFO
	 RET			;ERROR OR NEED TO BLOCK
	JE TPLBD,,[	MCALL MTAOPN ;IF UNLABLED, GO TO MAGTAP
			 RETBAD () ;ERROR
			CALL SETDNS ;GOOD. SET DENSITY
			RETSKP] ;AND DONE
	OPSTR <SKIPE>,TPLPCS	;OPERATION IN PROGRESS?
	JRST [	LOAD T1,TPSTAT	;YES. GET STATE THEN
		CAIE T1,.STCLS	;CLOSED?
		CAIN T1,.STABH	;OR "ABORTED"
		SKIPA		;YES. ALLOW OPEN THEN
		CALLRET SETERR	;NO. ERROR THEN
		MOVEI T1,.STABH	;SET STATE AS ABORTED
		STOR T1,TPSTAT
		JRST .+1]	;AND PROCEED
	TQNN <RNDF>		;WANT APPEND?
	TQNE <WRTF>		;NO. WANT WRITE?
	TQNN <READF>		;YES. WANT READ ALSO?
	SKIPA			;NO. ALL SET
	RETBAD (OPNX13)		;CAN'T DO THIS
	TQNN <RNDF,WRTF,READF>	;SOME SORT OF ACCESS WANTED?
	RETBAD (OPNX13)		;NO. WHY BOTHER THEN
	LOAD T2,TPUNIT		;GET MTA UNIT
	LOCK MTALCK(T2),<CALL LCKTST> ;INTERLOCK DATA BASE
	JN TPOPN,,[UNLOCK MTALCK(T2) ;IF ALREADY OPENED
		RETBAD (OPNX9)]	; ERROR
	SETONE TPOPN		;NOW INTERLOCKED
	UNLOCK MTALCK(T2)	;RELEASE LOCK
	MOVE T2,FORKX		;GET FORK INDEX
	STOR T2,TPFRK		;REMEMBER FORK OF OPENER
	SETZRO TPPSI		;NO PSI ASSIGNMENT
	SETZRO TPDVS		;CLEAR DEFERRED-VOLUME-SWITCH-REQUESTED
	SETZRO TPDM		;SET PREVAILING MODE TO SYSTEM DEFAULT
	CALL DOATTR		;PARSE ANY FILE ATTRIBUTES
	TQNE <READF>		;READING ONLY?
	RETSKP			;YES. SUCCEED ALWAYS THEN
	SETONE TPOP0		;SAY OPEN IN PROGRESS
	CALL OPEN		;DO OPEN
	 RETBAD (,<SETZRO <TPOPN,TPOP0>>)
	SETZRO TPOP0		;OPEN COMPLETE
	JN TPAPP,,RSKP		;IF APPEND, DONE
	MOVEI T1,1		;INIT SECTION VALUE
	STOR T1,TPFSEC		;DO IT
	RETSKP			;AND DONE
;ROUTINE TO CHECK ACTUAL MTA UNIT # AND CHECK VOLUME VALID
;MT UNIT TO RHS(U), MTASTS TO IOS

SETUNB:	MOVEI U,1		;SAY NO BLOCK
	JRST SETUNN		;AND PROCEED
SETUNA:	TDZA U,U		;ENTRY TO IGNORE TPLCPS
SETUNT:	SETOM U			;ENTRY TO CHECK TPLPCS
SETUNN:	SAVEAC <T2>		;NEED AN AC
	STKVAR <SVFLAG>
	MOVEM U,SVFLAG		;SAVE ENTRY FLAG
	HLRZ U,DEV		;GET MT UNIT NUMBER
	MOVEM T3,TLABL9(U)	;SAVE BLOCK ADDRESS
	STOR T4,TPJFN		;SAVE JFN
SETUN0:	LOAD T2,TPUNIT		;GET MTA UNIT #
	OPSTR <SKIPN>,TPVV	;HAVE VV?
	SKIPLE SVFLAG		;NO. RESIST BLOCKING?
	SKIPA			;YES.
	JRST SETUN1		;NO
	CAIN T2,MXMTAU		;-1 = NO UNIT ASSIGNED
	 MTERET (OPNX8)		;ERROR RETURN
	JE TPLPCS,,SETUN2	;IF NO LATENT OP, OK
	SETZRO TPLPCS		;IS. CLEAR IT
	MOVEI IOS,.STABH	;SET STATE APPROPRIATELY
	STOR IOS,TPSTAT		;""
SETUN2:	MOVE IOS,MTASTS(T2)	;GET MTA STATUS
	RETSKP			;SUCCESS RETURN

	ENDSV.			;END STKVAR

;HERE IF NO VV FOR THE UNIT

SETUN1:	CAIE T2,MXMTAU		;HAVE AN MTA ASSIGNED?
	MTERET (OPNX8)		;YES. DEFINITELY AN ERROR
	JN TPNVV,,[LOAD T1,TPERM ;IF VOL SWITCH ERROR
		   MTERET ()]	;GET CODE AND RETURN
	CALL [	SAVET		;SAVE ALL REGS
		MOVEI T1,VVBWAT	;GET SCHED TEST
		HRL T1,U	;GET UNIT
		CALLRET MTFCNC]	;AND WAIT
	 MTERET ()		;ERROR
	JRST SETUN0		;TRY AGAIN
;MTOPR TO SET MT PSI ASSIGNMENT.

MTPSI:	UMOVE T2,3		;GET PSI CHANNEL
	CAMN T2,[-1]		;IS IT CLEAR?
	JRST [	SETZRO TPPSI	;CLEAR FORK
		RETSKP]
	CAIL T2,0		;CHECK THAT GIVEN PSI CHANNEL IS VALID
	CAILE T2,5		;ASSIGNABLE CHANNEL
	JRST [	CAIL T2,^D24	;CHECK THAT GIVEN PSI CHANNEL IS VALID
		CAILE T2,^D35	;ASSIGNABLE CHANNEL
		RETBAD (MTOX14)	;BAD PSI CHANNEL NUMBER GIVEN
		JRST .+1]
	ADDI T2,1		;INCREMENT IT
	STOR T2,TPPSI
	MOVE T2,FORKX		;GET FORK INDEX
	STOR T2,TPFRK		;AND SET THIS AS WELL
	CALLRET REAJFN		;AND MAKE SURE JFN ASSIGMENT IS CORRECT

;ROUTINE TO SET OR CLEAR TRANSLATE FLAG. THIS FLAG,IF SET,
;DIRECTS THE MONITOR NOT TO TRANSLATE EBCDIC INTO ASCII.

MTNTR:	UMOVE T2,3		;GET NEW SETTING
	SKIPE T2		;WANT TO SET?
	MOVEI T2,1		;YES. SO DO IT
	STOR T2,TPUED		;STORE NEW VALUE
	SKIPE T2		;NO TRANSLATE?
	TQZ <ACRLFF>		;MEANS DON'T ADD CRLF
	RETSKP			;AND DONE
;MTOPR CODE TO DECLARE HDR,HDR2 VALUES. THIS MTOPR MUST BE DONE
;BEFORE HDR1 AND HDR2 ARE WRITTEN

   REPEAT 0,<			;SUPERCEDED BY ATTRIBUTES
MTHDRV:	SAVEAC <Q3>		;GET A WORK REG
	TQNN <WRTF>		;HAVE WRITE ACCESS?
	TQNN <OPNF>		;OPENED?
	RETBAD (DESX5)		;NO. CAN'T DO IT THEN
	LOAD T2,TPSTAT		;GET STATE
	CAIE T2,.STUHL		;IN THE USER HEADER REGION?
	RETBAD (GOKER1)		;BAD TIMING
	JN TPLCT,,[RETBAD(GOKER1)] ;SAME HERE

;TAPE IS IN THE PROPER STATE. FETCH ARGS

	UMOVE T4,T3		;GET BLOCK ADDRESS
	UMOVE Q3,.MOCNT(T4)	;GET COUNT
	SOSG Q3			;HAVE SOME DATA?
	RETBAD (ARGX04)		;NO. ERROR THEN
	UMOVE T1,.MOFMT(T4)	;GET FORMAT CHARACTER
	JUMPE T1,MTHDR1		;IF NOT SPECIFYING, GO ON
	CALL CHKFMT		;CHECK AND STORE FORMAT
	 RETBAD()		;ERROR
MTHDR1:	SOJLE Q3,MTHDR4		;IF NO MORE DONE
	UMOVE T1,.MOEPD(T4)	;GET EXP DATE
	JUMPE T1,MTHDR2		;IF NOT SPECIFYING, GO ON
	STOR T1,TPEXPD		;STORE IT
MTHDR2:	SOJLE Q3,MTHDR4		;IF NO MORE, GO ON
	UMOVE T1,.MOBSZ(T4)	;GET BLOCK SIZE
	JUMPE T1,MTHDR3		;IF NOT SPECIFYING, GO ON
	STOR T1,TPBSZ		;SAVE IT
MTHDR3:	SOJLE Q3,MTHDR4		;IF NO MORE, DONE
	UMOVE T1,.MORSZ(T4)	;GET RECORD SIZE
	JUMPE T1,MTHDR4		;IF NOT SPECIFYING, DONE
	STOR T1,TPRSZ		;STORE IT
MTHDR4:	CALL SETFMT		;NOW SET THE FORMAT CODE
	 RETBAD ()		;ERROR
	RETSKP			;ALL DONE
   >				;END OF REPEAT 0
;USER LABEL ROUTINES.

;READ USER HEADER/TRAILER LABELS
;TAPE MUST BE IN USER LABEL REGION.

RDULBL:	SAVEAC <P3>		;SAVE STATE HERE
	STKVAR <<LBL,.LBLEN>,RDROUT> ;WHERE TO PUT LABEL DATA
	CALL CLREOF		;CLEAR EOF INDICATORS
	LOAD T1,TPEBD		;GET ANSI/EBCDIC INDICATOR
	MOVE T1,[IFIW!GETLBL	;FOR ANSI TAPES
		 IFIW!GETLBU](T1) ;FOR EBCDIC
	MOVEM T1,RDROUT		;SAVE CORRECT ROUTINE
	LOAD P3,TPSTAT		;GET STATE
	CAIN P3,.STETL		;READING VOLUME TRAILERS?
	MOVEI P3,.STUTL		;YES. SIMULATE FILE TRAILERS THEN
	TQNE <READF>		;READING?
	JRST RDULB1		;YES. IS GOOD THEN
	OPSTR <SKIPE>,TPAPP	;APPEND?
	CAIE P3,.STUHL		;YES. AND IN THE HEADER REGION?
	RETBAD (IOX1)		;NO. ERROR THEN
RDULB1:	JN TPEUT,,[RETBAD (IOX4)] ;IF ALREADY AT THE END, SAY SO
	CAIN P3,.STCLS		;NOW CLOSED?
	JRST [	CALL OPEN	;YES. OPEN THE FILE
		 RETBAD ()	;FAILED
		LOAD P3,TPSTAT	;GET NEW STATE
		JRST .+1]	;AND PROCEED
	CAIE P3,.STUHL		;IN HEADER LABEL REGION?
	CAIN P3,.STUTL		;OR IN TRAILER REGION?
	SKIPA T2,[.LBFRD]	;YES. NEED TO READ ONE THEN
	RETBAD()		;NOT PROPERLY POSITIONED
	CALL MTLFCN		;DO IT
	 JRST [	TQNN <EOFF>	;END OF LABELS?
		RET		;NO. JUST RETURN THEN. EITHER BLOCK OR ERROR
		SETONE TPEUT	;END OF USER LABELS IF HERE
		CAIE P3,.STUHL	;IN THE HEADERS?
		RETBAD (IOX4)	;NO. DONE THEN
		OPSTR <SKIPN>,TPAPP ;YES. NORMAL READ?
		CALL SETRDY	;YES. SET UP FOR INPUT
		 NOP
		RETBAD (IOX4)]	;RETURN WITH END OF LABELS
	; ..

;RDULBL CONTINUED

	HRROI T1,[ASCIZ /UHL/]	;ASSUME HEADER
	CAIE P3,.STUHL		;READING HEADERS?
	HRROI T1,[ASCIZ /UTL/]	;NO. CHECK FOR TRAILER THEN
	MOVE T2,.U1HID		;ASSUME HEADER
	CAIE P3,.STUHL		;HEADERS?
	MOVE T2,.U1TID		;NO. TRAILERS THEN
	SETOM T3		;IN THE BUFFER
	CALL LBLCMP		;MAKE SURE IS PROPER LABEL
	 MTERET (,<CALL LBLERR>) ;NOT. ERROR THEN
	SETZM T1		;PUT IT IN T1
	MOVE T2,.U1NUM		;GET LABEL I.D.
	SETOM T3
	CALL @RDROUT		;FETCH IT
	 MTERET (,<CALL LBLERR>) ;BAD
	UMOVEM T1,2		;RETURN LABEL TYPE TO CALLER
	MOVE T2,.U1DAT		;GET DATA
	SETOM T3		;IN BUFFER
	HRROI T1,LBL		;WHERE TO PUT IT
	CALL @RDROUT		;GET DATA
	 NOP			;CAN'T FAIL
	CALL CNVU		;VERIFY USER BYTE POINTER
	MOVEI T3,^D76		;# OF BYTES TO RETURN
	MOVE T2,[POINT 7,LBL]	;WHERE DATA IS
RDULB0:	ILDB T1,T2		;GET NEXT BYTE
	XCTBUU [IDPB T1,3]	;STASH IT
	SOJG T3,RDULB0
	RETSKP			;AND DONE

	ENDSV.			;END STKVAR
;WRITE USER HEADER/TRAILER LABELS

CLSUTL:	TDZA T2,T2		;INTERNAL EOF CLOSER
WTULBL:	SETOM T2		;JSYS ENTRY
	SAVEAC <P3>		;TO SAVE STATE
	STKVAR <<LBL,.LBLEN>,SVFLAG>
	MOVEM T2,SVFLAG		;SAVE ENTRY FLAG
	TQNN <WRTF>		;OPENED FOR WRITE
	RETBAD (IOX1)		;NO
LWDIS:	LOAD P3,TPSTAT		;GET STATE
	JRST @.+1(P3)		;DO DISPATCH
	STDIS (LW)		;DO PROPER DISPATCH

;UTILITY USED BY RDULBL AND WTULBL TO VERIFY USER BYTE POINTER
;IN USER 3

CNVU:	UMOVE T1,3		;GET USER'S POINTER
	TLC T1,-1
	TLCN T1,-1		;CHECK FOR LH=-1
	HRLI T1,(<POINT 7,>)	;IT IS. CONVERT IT
	UMOVEM T1,3		;SET UP PROPER POINTER
	RET			;AND DONE
;ACTION ROUTINES FOR LABEL WRITE

LW.ABH:
LW.ABD:
LW.CLS:
LW.HDR:	RETBAD(IOX5)		;[7429] NOT LEGAL

;IN DATA AREA. CLOSE TAPE BEFORE PROCEEDING

LW.RDY:	CALL MTMCSC		;FINISH LAST RECORD
	 RETBAD ()		;ERROR
	MOVEI T2,.MONOP		;WAIT FOR OPS TO COMPLETE
	CALL MTLFCN		;DO IT
	 JRST [	TXNE IOS,MT%EOT	;WAS IT EOT?
		CALL EOV	;YES. DO EOV PROCESSING
		 RETBAD ()	;ERROR
		JRST LWDIS]	;HANDLE NEW STATE
	MOVEI T2,.MOEOF		;NEED EOF FIRST
	CALL MTLFCN		;CLOSE IT
	 JRST [	TXNN IOS,MT%EOT	;EOT?
		RETBAD ()	;NO. ERROR THEN
		JRST .+1]	;YES. PROCEED AND IGNORE IT
	CALL CLREOF		;CLEAR EOF
	MOVEI T1,.STEOF		;SAY AT EOF ON TAPE
	STOR T1,TPSTAT		;NEW STATE
	JRST LWDIS		;GO DISPATCH AGAIN

LW.EOF:	CALL CLSEOF		;DO EOF STUFF
	 RETBAD()
	JRST LWDIS		;AND TRY AGAIN

;IN USER LABELS

LW.UHL:	CALL WRODON		;WRITE STANDARD HEADERS
	 RETBAD ()		;ERROR DOING IT
	JRST LW.UTL		;AND GO DO USER LABEL

;VOLUME SWITCH STATE

LW.VLS:	CALL VOLSW0		;COMPLETE VOL SWITCH
	 RETBAD()		;ERROR
	JRST LWDIS		;AND TRY AGAIN
;TAPE IN USER HEADER/TRAILER REGION

LW.ETL:	MOVEI P3,.STUTL		;SIMULATE TRAILERS
LW.UTL:	SKIPN SVFLAG		;JSYS ENTRY?
	RETSKP			;NO. RETURN TO EOF CLOSING THEN
	LOAD T1,TPNUL		;GET # OF LABELS SO FAR WRITTEN
	CAIL T1,MAXLBL		;CAN WE WRITE ANOTHER?
	RETBAD (LTLBLX)		;NO. NO MORE LABELS FOR THIS FILE
	HRROI T1,[ASCIZ /UHL/]	;ASSUME HEADER
	CAIE P3,.STUHL		;IS IT?
	HRROI T1,[ASCIZ /UTL/]	;NO. GET TRAILER THEN
	MOVE T2,.U1HID		;FIELD DEF IS SAME
	SETOM T3
	CALL SETLB		;FIX FIELD
	UMOVE T2,4		;GET LABEL TYPE
	DPB T2,[POINT 7,LBL,6]	;STASH IT
	HRROI T1,LBL
	MOVE T2,.U1NUM		;THE FIELD TO FILL
	SETOM T3
	CALL SETLB		;FILL IT

;NOW COPY DATA INTO STKVAR FOR MOVING

	CALL CNVU		;VERIFY USER'S BYTE POINTER
	MOVEI T3,^D76		;LENGTH
	MOVE T1,[POINT 7,LBL]	;DEST
LW.UT0:	XCTBUU [ILDB T4,3]	;GET NEXT BYTE
	IDPB T4,T1		;STASH IT
	SOJG T3,LW.UT0		;DO THEM ALL
	HRROI T1,LBL		;NOW PUT IT IN LABEL
	MOVE T2,.U1DAT
	SETOM T3
	CALL SETLB		;DO IT

;LABEL ALL READY. WRITE IT

	MOVEI T2,.LBFWR		;WRITE A LABEL
	SETOM T3		;FROM THE LABEL BUFFER
	CALL MTLFCN		;DO IT
	 JRST [	TXNN IOS,MT%EOT	;AT THE EOT?
		RETBAD (,<CALL LBLERR>) ;NO. AN ERROR THEN
		CALL CLREOF	;CLEAR EOF FLAGS
		SETONE SNEOT	;REMEMBER THE EOT
		JRST .+1]	;PROCEED
	INCR TPNUL		;ON MORE LABEL WRITTEN
	RETSKP			;SUCCESS

	ENDSV.			;END STKVAR
;SEQUETIAL INPUT JACKET ROUTINE

MTSQI:	CALL SETUNT		;CHECK INPUT SETUP
	 RET
	LBLCHK (MTASQI)		;CHECK FOR UNLABELED
MTSQII:	SAVEAC <Q3>		;GET A WORK REG
MTSQI0:	CALL INCHK		;CHECK INPUT SETUP
	RET
	LOAD Q3,TPEBD		;REMEBER IF EBCIDC
	LOAD T2,TPFRMT		;GET TAPE FORMAT
	CAIE T2,TPFSYD		;SYSTEM-DEFAULT?
	CAIN T2,TPFMTU		; OR UNDEFINED?
	 JRST [	UCALL MTASQI		;YES-- JUST CALL MAGTAP
		TQNN <EOFF>		;END OF FILE?
		RET			;NO - RETURN
		CALL EOV	;YES. DO EOV PROCESSING
		 RETBAD ()	;FAILED
		JRST MTSQI0]	;SUCCESS. TRY AGAIN FOR THE BYTE
	; ..
; FORMATTED RECORD TYPES-- MUST PLAY WITH COUNTS BEFORE CALLING MAGTAP

	MOVE T1,FILLEN(JFN)	;GET LENGTH OF RECORD
	SUB T1,TPFLNX(U)	;DISCOUNT OVERAGE
	CAMLE T1,FILBYN(JFN)	;ANY BYTES LEFT?
	 JRST MTSQI1		;YES-- JUST GET BYTE FROM BUFFER OR MAGTAP

; MUST GET A NEW LOGICAL RECORD

	LOAD T2,TPFRMT		;GET TAPE FORMAT TYPE
	CALL @[			;DISPATCH TO GET RECORD ROUTINE
		DTBDSP (SQIGRF)		;FIXED
		DTBDSP (SQIGRD)		;VARIABLE
		DTBDSP (SQIGRS)		;SPANNED
		]-1(T2)
	 JRST [	TQNN <EOFF>		;ERROR OR BLOCK-- EOF?
		 RET			;NO-- JUST PASS UP
		CALL EOV	;DO EOV PROCESSING
		 RETBAD ()	;FAILED
		TQNE <EOFF>	;REALLY EOF?
		RETBAD ()	;YES
		JRST MTSQI0]	;NO. TRY AGAIN
	MOVE T1,FILLEN(JFN)	;GET RECORD LENGTH
	SUB T1,FILBYN(JFN)	;COMPUTE REMAINING BYTES
	JUMPLE T1,[TQO <RECF>	;IF NO COUNT, MUST BE EOR
		SETZM FILLEN(JFN) ;BE SURE EOR IS CLEARLY INDICATED
		SETZM TPFLNX(U)	;HERE AS WELL
		RETSKP]		;AND DONE
	OPSTRM <ADDM T1,>,TPLRC	;AND SAVE FOR GDSTS

; NOW GET A BYTE FROM BUFFER OR TAPE AND RETURN

MTSQI1:	CALL SQGBYT		;GET BYTE
	 JRST [	TQNN <EOFF>		;ERROR OR BLOCK-- EOF?
		 RET			;NO-- JUST PASS UP
		CALL EOV	;DO EOV PROCESSING
		 RETBAD ()	;FAILED
		JRST MTSQI0]	;AND TRY AGAIN
	JUMPGE T2,R		;IF NOT A NEW BUFFER, DONE
	CALLRET CNVREC		;A NEW BLOCK. CONVERT RECORD IF NECESSARY
;SEQUENTIAL INPUT ROUTINES

; GET NEXT FIXED RECORD

SQIGRF:	LOAD T2,TPRSZ		;GET RECORD SIZE
	CALL SQGREC		;GET A TAPE RECORD OF THAT SIZE
	 RET			;BLOCK OR ERROR
	CALL CNVREC		;CONVERT IF NECESSARY
	SETZRO TPLRC		;NO COUNT NOW
	RETSKP			;OK

; GET NEXT VARIABLE RECORD

SQIGRD:	STKVAR <GNUM,FLAG>	;CORRESPOND TO SQIGRS ENTRY SEQUENCE
	MOVE T2,[4
		^D8](Q3)	;GET MIN RECORD SIZE
	CALL SQGREC		;GET NEXT 5 BYTE RECORD
	 RET			;BLOCK OR ERROR
	SETZRO TPLRC		;NO COUNT OF RECORD NOW
	JUMPE Q3,SQIGS2		;IF NOT EBCDIC, GO ON
	JE TPNBL,,SQIGS2	;IF EBCDIC, BUT NOT NEW BLOCK, GO ON
	CALL SKPBDW		;SKIP THE BDW ON THE TAPE
	 RETBAD ()		;ERROR
	SETZRO TPNBL		;NO NEW BLOCK NOW
	JRST SQIGS2		;READY TO PROCESS DATA NOW

;ROUTINE TO SKIP THE BDW ON AN EBCDIC TAPE

SKPBDW:	CALL SQGRVW		;PICK OFF THE BDW
	 RETBAD ()		;ERROR
	MOVN T1,FILBYN(JFN)	;GET BYTE COUNT
	ADDM T1,FILLEN(JFN)	;DISCOUNT THE BDW FROM THE BLOCK COUNT
	SETZM FILBYN(JFN)	;ADJUST BYTE COUNT AS WELL
	RETSKP			;AND DONE
; GET NEXT SPANNED RECORD

SQIGS0:	TDZA T2,T2		;ACCEPT ANY SEGMENT
SQIGRS:	MOVEI T2,1		;MUST BE "CORRECT" SEGMENT
	STKVAR <GNUM,FLAG>	;SAVE COUNT FROM EBCDIC TAPE HERE
	MOVEM T2,FLAG		;SAVE INCOMING FLAG
	MOVE T2,[5
		^D8](Q3)	;GET MINIMUM RECORD SIZE
	CALL SQGREC		;GET NEXT 6 BYTE RECORD
	 RET			;BLOCK OR ERROR
	JUMPE Q3,SQIGR0		;IF NOT EBCDIC, GO ON
	JE TPNBL,,SQIGR0	;IS EBCDIC. A NEW BLOCK?
	CALL SKPBDW		;SKIP THE BDW
	 RETBAD()		;BADLY FORMED TAPE
SQIGR0:	JUMPN Q3,[CALL SQGRVW	;EBCDIC, PROCESS EBCDIC RCW
			JUMPE T1,R ;BADLY FORMED
		MOVEM T2,GNUM	;SAVE VALUE
		CAILE T1,3	;VALID SPAN DESCRIPTOR?
		RETBAD (IOX13)	;NO. ERROR THEN
		TRNE T1,2	;2 OR 3?
		TRC T1,1	;YES. MAKE 2 A 3 AND 3 A 2
		ADDI T1,"0"	;MAKE IT ASCII
		JRST SQIGR1]	;AND PROCEED
	CALL SQGBYT		;GET THE FIRST BYTE OF RECORD
	 RET			;BLOCK OR ERROR
	CAIL T1,"0"		;VALID
	CAILE T1,"3"		; NUMBER?
	RETBAD (IOX13)		;NO -- RETURN ERROR
SQIGR1:	SKIPN FLAG		;WANT TO CHECK FOR PROPER SEGEMENT?
	JRST SQIGS1		;NO. GO ON NOW THEN
	CAIG T1,"1"		; 0 OR 1, BEGIN SEGMENT?
	 JRST [	SKIPE TPFLNX(U)		;YES-- EXPECTING MIDDLE?
		 RETBAD (IOX13)		;YES-- ERROR
		SETZRO TPLRC	;NO RECORD COUNT IF ON FIRST SEGMENT
		JRST SQIGS1]
	SKIPN TPFLNX(U)		;NO-- EXPECTING BEGINNING
	 RETBAD (IOX13)		;YES-- ERROR
SQIGS1:	MOVEM T1,FLAG		;SAVE SPAN INDICATOR HERE
	SETZM TPFLNX(U)		;RESET EXPECTING FLAG
	CAIE T1,"1"		;IS THIS A "MIDDLE"
	CAIN T1,"2"		; SEGMENT?
	 AOS TPFLNX(U)		;YES-- EXPECT AT LEAST ONE BYTE FROM NEXT RECORD
	JUMPN Q3,[MOVE T2,GNUM	;IF EBCDIC, ALREADY HAVE COUNT
		JRST SQIGS3]	;AND PROCEED
	; ..
;HERE TO PROCESS A RECORD DESCRIPTOR. FOR ASCII TAPES, THE DESCRIPTOR
;IS A 4-BYTE PACKED DECIMAL NUMBER. FOR EBCDIC TAPES, THE FIRST TWO
;BYTES REPRESENT A BINARY NUMBER. THE LAST TWO BYTES MBZ.

SQIGS2:	CALL @[	IFIW!SQGNUM	;FOR ANSI, GET DECIMAL NUMBER
		IFIW!SQGRVW](Q3) ;FOR EBCIDC, GET RCW
	 RET			;BLOCK OR ERROR
SQIGS3:	ADD T2,TPFLNX(U)	;INCREASE LENGTH BY EXPECTING COUNT
	MOVEM T2,FILLEN(JFN)	;SAVE THE BYTE COUNT AS RECORD SIZE
	CALL SQSFCT		;SET FILCNT(JFN)
	SKIPN TPFLNX(U)		;EXPECTING BYTES IN NEXT RECORD?
	JRST [	MOVE T2,FILCNT(JFN) ;NO. GET COUNT IN NEW RECORD
		CAMLE T2,FILLEN(JFN) ;ENOUGH BYTES?
		MTERET (IOX31)	;NO. ILLEGAL RECORD THEN
		JRST .+1]	;AND PROCEED
	CALL CNVREC		;CONVERT IF NECESSARY
	MOVE T1,FLAG		;RETURN SPAN INDICATOR IF ANY
	RETSKP			;RETURN +2 FROM SQIGRD

	ENDSV.			;END STKVAR
; GET 4 DIGIT NUMBER FROM TAPE FOR ASCII TAPES

SQGNUM:	STKVAR <GNUM,GCNT>
	MOVX T1,^D4
	MOVEM T1,GCNT
	SETZM GNUM
SQGNM1:
	CALL SQGBYT		;GET A BYTE
	 RET			;ERROR-- PASS UP
	CAIL T1,"0"		;DECIMAL
	CAILE T1,"9"		; DIGIT?
	 MTERET (IOX14)		;NO-- ERROR
	MOVE T2,GNUM		;GET ACCUMULATED RESULT
	IMULI T2,^D10		;SHIFT A DIGIT
	ADDI T2,-"0"(T1)	;ADD IN THIS DIGIT
	MOVEM T2,GNUM		;REMEMBER RESULT SO FAR
	SOSLE GCNT		;COUNT TO 4?
	 JRST SQGNM1		;NO-- GET ANOTHER DIGIT
	RETSKP			;YES-- RETURN WITH NUMBER IN T2

	ENDSV.			;END STKVAR

;GET EBCDIC RCW FROM RECORD
;	+1 NOT AN BDW. MAY BE RCW FOR SPANNED RECORD
;	+2 A BDW OR RCW FOR NON-SPANNED RECORD

SQGRVW:	STKVAR <GNUM,SPNDSC>	;SAVE NUMBER HERE
	CALL SQGBYT		;GET NEXT BYTE
	 RETBAD ()		;BADNESS
	IMULI T1,^D256		;MAKE IT PROPER VALUE
	MOVEM T1,GNUM		;SAVE IT
	CALL SQGBYT		;GET NEXT
	 RETBAD()		;ERROR
	ADDM T1,GNUM		;ACCUMULATE RESULT
	CALL SQGBYT		;PICK OFF ZERO BYTE
	 RETBAD ()		;ERROR
	MOVEM T1,SPNDSC		;SAVE THIS BYTE
	CALL SQGBYT		;GET FINAL BYTE
	 RETBAD()		;ERROR
	JUMPN T1,RFALSE		;IF LAST BYTE IS NON-ZERO, ERROR
	MOVE T2,GNUM		;GET VALUE
	SKIPE T1,SPNDSC		;HAVE A SPANNING DESC?
	RET			;YES. RETURN IT
	RETSKP			;AND DONE

	ENDSV.			;END STKVAR
; GET SET TO READ A RECORD OF (T2) BYTES

SQGRCA:	TDZA T1,T1
SQGREC:	SETOM T1
	STKVAR <GCNT,TCNT,TBIN,SVFLAG> ;SAVES COUNT
	MOVEM T1,SVFLAG		;SAVE ENTRY FLAG
	MOVEM T2,GCNT		;SAVE COUNT
	MOVE T1,TPFLEN(U)	;GET LENGTH OF PHYSICAL BLOCK
	SUB T1,TPFBYN(U)	; MINUS WHAT'S BEEN READ
	CAML T1,T2		;IS THERE ENOUGH LEFT FOR THE RECORD (SIZE IN T2)?
	 JRST SQGRC2		;YES-- GO ON
SQGRC1:	SETZM TPFCNT(U)		;NO-- DISCARD REMAINDER OF BUFFER
	MOVE T1,TPFLEN(U)	; . .
	MOVEM T1,TPFBYN(U)	; . .
	SETZM FILCNT(JFN)	; . .
SQGRC2:	MOVE T2,GCNT		;GET COUNT BACK
	ADD T2,TPFLNX(U)	;PLUS WHAT WE EXPECT IN NEXT RECORD
	MOVEM T2,FILLEN(JFN)	;REMEMBER THE SIZE OF THIS RECORD
	SETZM FILBYN(JFN)	;NOW AT BEGINNING
	CALL SQSFCT		;SET FILCNT(JFN)

; CHECK FOR EMPTY RECORD

	CALL SQGBYT		;GET FIRST BYTE FROM RECORD (TO HAVE BUFFER)
	 JRST [	MOVE T2,TPFLNX(U)	;BLOCK OR ERROR-- RESET BUFFER COUNTS
		MOVEM T2,FILLEN(JFN)	; . .
		SETZM FILBYN(JFN)	; . .
		SETZM FILCNT(JFN)	; . .
		RET]			; AND PASS BLOCK/ERROR UP
	CALL SQSPOS		;REMEMBER BUFFER POSITION OF THIS BYTE
	MOVE T2,TPFCNT(U)
	ADD T2,FILCNT(JFN)
	MOVEM T2,TCNT
	MOVE T2,TPFBYN(U)
	SUB T2,FILCNT(JFN)
	MOVEM T2,TBIN
	SKIPN SVFLAG		;WANT TO CHECK FOR FILLED RECORD?
	JRST SQGRC5		;NO
	JRST SQGRC4		;AND LOOK AT BYTE
;HAVE DATA FROM MAGTAP. EXAMINE FOR FILLED RECORD, ETC.

SQGRC3:	MOVE T1,FILLEN(JFN)	;GET CURRENT LENGTH
	SUB T1,TPFLNX(U)	; MINUS WHAT'S EXPECTED IN NEXT BLOCK
	CAMG T1,FILBYN(JFN)	;HAVE WE LOOKED AT ENTIRE RECORD YET?
	 JRST SQGRC1		;YES-- DISCARD REMAINDER OF BLOCK
	CALL SQGBYT		;GET A BYTE FROM RECORD
	 RET			;BLOCK OR ERROR-- PASS UP
SQGRC4:	LOAD T2,TPEBD		;GET ANSI/EBCDIC INDICATOR
	CAMN T1,["^"		;CHECK FOR ANSI FILL
		 EBDFIL](T2)	;EBCDIC FILL
	 JRST SQGRC3		;YES-- LOOP TILL END OF RECORD
SQGRC5:	CALL SQRPOS		;NO-- RESTORE POSITION TO BEGINNING OF RECORD
	AOS T2,TCNT
	MOVEM T2,TPFCNT(U)
	SOS T2,TBIN
	MOVEM T2,TPFBYN(U)
	SETZM FILCNT(JFN)
	SETZM FILBYN(JFN)
	MOVE T2,GCNT
	ADD T2,TPFLNX(U)
	MOVEM T2,FILLEN(JFN)
	CALL SQSFCT		;SET UP FILCNT
	RETSKP			;RETURN SUCCESS

	ENDSV.			;END STKVAR
; SQGBYT -- GET A BYTE FROM BUFFER OR MAGTAP
; CALL:
; RETURNS:
;	+1:	BLOCK OR ERROR
;	+2:	SUCCESS, BYTE IN T1

SQGBYT:	SKIPLE FILCNT(JFN)	;ANY BYTES LEFT IN BUFFER?
	 JRST [	SOS FILCNT(JFN)		;YES-- COUNT ONE OF THEM
		AOS FILBYN(JFN)		; AND COUNT IN RECORD
		ILDB T1,FILBYT(JFN)	;GET THE BYTE
		SETZM T2	;NOT A NEW BLOCK
		RETSKP]			; AND RETURN WITH IT +2

; GET A BYTE FROM MAGTAP

	SQCALL MTASQI		;CALL MAGTAP FOR SEQUENTIAL BYTE
	 RET			;BLOCK OR ERROR-- RETURN +1
	SETOM T2		;A NEW BUFFER READ
	MOVE T3,TPFBYN(U)	;GET MAGTAP BLOCK COUNT
	SUB T3,FILCNT(JFN)	;SUBTRACT WHAT WE'VE ALREADY ACCOUNTED FOR
	CAILE T3,1		;A NEW BLOCK?
	RETSKP			;NO. DONE THEN
	SETONE TPNBL		;YES. NOTE THIS
	RETSKP			;OK-- RETURN +2 FROM SQGBYT
;UTILITY TO CONVERT EBCDIC DATA TO ASCII
;T1/	FIRST BYTE OF RECORD
;REMAINDER OF RECORD DESCRIBED BY FILCNT AND FILBYT

CNVREC:	JE TPEBD,,R		;IF ASCII ALREADY, DONE
	JN TPUED,,R		;OR IF WANT EBCDIC, DONE

;WANT DATA CONVERTED

	SAVEAC <P3>		;GET A WORK REG
	MOVE P3,FILCNT(JFN)	;GET PRESENT COUNT
	MOVE T4,FILBYT(JFN)	;GET BYTE POINTER
CNVRC0:	ILDB T2,T4		;GET NEXT BYTE
	IDIVI T2,4		;PREPARE TO TABLE LOOKUP
	LDB T2,[POINT 8,ETOA(T2),7
		POINT 8,ETOA(T2),15
		POINT 8,ETOA(T2),23
		POINT 8,ETOA(T2),31](T3)
	DPB T2,T4		;STASH IT
	SOJG P3,CNVRC0		;DO ENTIRE RECORD
	MOVE T2,T1		;GET FIRST BYTE
	ANDI T2,377
	CALL EBCASC		;MAKE IT ASCII
	MOVE T1,T2		;COPY BACK
	RET			;AND DONE
;ROUTINE TO CHECK TAPE POSTION FOR INPUT

INCHK:
INCHK1:	LOAD T1,TPSTAT		;GET MT STATE CODE
	JRST @INDIS.(T1)	;DISPATCH ON STATE CODE

;DISPATCH TABLE FOR INCHK

INDIS.:	STDIS (IN)		;GEN DISPATCH FOR STATES
;HERE IF NOT OPENED YET (IE HDRS NOT READ)

IN.ABH:
IN.CLS:	CALL OPEN		;NOT OPENED. PROBABLY JUST DID A POSITION
	 MTERET ()		;ERROR
	JRST INCHK1		;AND PROCEED
IN.HDR:	MTERET (DESX5)		;IMPOSSIBLE SITUATION

;IN UHL AREA - SKIP TO EOF

IN.UHL:	MOVEI T2,.MOFWF		;SKIP FORWARD FILE
	CALL MTLFCN		;INIT FUNCTION
	 RET			;BLOCK OR ERROR
	CALLRET SETRDY		;SET READY AND RCNT

;TAPE IS READY FOR INPUT

IN.RDY:	RETSKP			;SKIP RETURN FOR NOW

;HERE IF TAPE WASNT CLOSED YET, BUT EOF WAS ENCOUNTERED

IN.UTL:	CALL CLOSE		;CLOSE CURRENT FILE
	 RETBAD ()		;ERROR
	CALL OPEN		;OPEN NEXT
	 RETBAD ()		;ERROR
	JRST INCHK		;AND HANDLE NEW STATE

;VOLUME SWITCH STATE

IN.VLS:	CALL VOLSW0		;COMPLETE VOLUME SWITCH
	 RETBAD()		;ERROR
	JRST INCHK		;AND PROCEED
;SEQUENTIAL OUTPUT JACKET

MTSQO:	STKVAR <SAVBYT>		;PLACE TO SAVE THE BYTE TO OUTPUT
	CALL SETUNT		;GET UNIT
	RET			;ERROR
	LBLCHK (MTASQO)		;CHECK FOR UNLABELED TAPE
	MOVEM T1,SAVBYT		;SAVE THE BYTE
MTSQO0:	CALL OUTCHK		;CHECK OUTPUT SETUP
	 RET			;PASS UP
	LOAD T2,TPFRMT		;GET TAPE FORMAT
	CAIE T2,TPFSYD		;SYSTEM-DEFAULT?
	CAIN T2,TPFMTU		; OR UNDEFINED?
	 JRST [	MOVE T1,SAVBYT	;RECOVER BYTE
		UCALL MTASQO		;YES-- JUST CALL MAGTAP TO WRITE BYTE
		JRST MTSQO3]	;CHECK FOR EOT

; FORMATTED RECORD TYPE-- MUST PLAY WITH COUNTS BEFORE CALLING MAGTAP

	SKIPN FILBYN(JFN)	;ANY BYTES IN CURRENT BUFFER
	SKIPLE FILCNT(JFN)	;BYTE LEFT IN CURRENT RECORD?
	 JRST MTSQO1		;YES-- GO ON
	LOAD T2,TPFRMT		;GET TAPE FORMAT
	CALL @[			;DISPATCH TO SETUP NEW RECORD
		DTBDSP (SQOSRF)		;FIXED
		DTBDSP (SQOSRD)		;VARIABLE
		DTBDSP (SQOSRS)		;SPANNED
		]-1(T2)
	 JRST MTSQO3		;CHECK FOR EOT
	SETZM FILCNT(JFN)	;NOTHING IN THE BUFFER YET
	CALL SQSFCT		;SETUP FILE COUNT ACCORDING TO NEW VARIABLES
	; ..
;MTSQO CONTINUED
; SEE IF ROOM IN THIS RECORD

MTSQO1:	MOVE T1,FILLEN(JFN)	;GET RECORD LENGTH
	SUB T1,TPFLNX(U)	;DISCOUNT OVERAGE
	CAMLE T1,FILBYN(JFN)	;BYTES LEFT IN THIS RECORD?
	 JRST MTSQO2		;YES-- JUST PUT BYTE INTO BUFFER OR MAGTAP

; NO ROOM IN THIS RECORD-- OUTPUT IT

	CALL SQOPRC		;COMPLETE RECORD
	 JRST MTSQO3		;CHECK FOR EOT
	JRST MTSQO0		;TRY TO FIT BYTE AGAIN

; NOW SEND BYTE TO BUFFER OR MAGTAP

MTSQO2:	MOVE T1,SAVBYT		;GET THE BYTE BACK
	CALL SQPBYT		;PUT BYTE IN BUFFER OR SEND TO MAGTAP
MTSQO3:	 JRST [	TQNN <ERRF>	;BLOCK OR ERROR... IS IT ERROR?
		RET		;NO, MUST BE BLOCK
		TQZ <BLKF>	;CLEAR BLKF SO AS NOT TO CONFUSE IO
		TXNE IOS,MT%EOT	;EOT HIT?
		CALL EOV	;YES. DO EOV PROCESSING
		 RETBAD()	;ERROR
		JRST MTSQO0]	;AND TRY AGAIN
	RET			;RETURN FROM MTSQO

	ENDSV.			;END STKVAR
; RECORD OUTPUT ROUTINE (CALLED FROM IO)

MTRCO:	CALL SETUNT		;SETUP UNIT, ETC.
	 RET			;ERROR
	LBLCHK (MTRECO)		;DO UNLABELED CHECK
MTRCOO:	CALL OUTCHK		;MAKE SURE WE ARE IN THE RIGHT PLACE
	 RETBAD ()		;ERROR
	SKIPN FILBYN(JFN)	;A RECORD SET UP YET?
	SKIPLE FILCNT(JFN)	;OR HERE?
	JRST MTRCO0		;YES. GO ON
	LOAD T2,TPFRMT		;GET TAPE FORMAT
	CAIE T2,TPFSYD		;SYS DEFAULT?
	CAIN T2,TPFMTU		;OR U
	JRST MTRCO0		;YES. HANDLE AS INTERANL CALL
	CALL @[	IFIW!SQOSRF	;FIXED
		IFIW!SQOSRD	;VARIABLE
		IFIW!SQOSRS]-1(T2) ;SPANNED
	 JRST [	TQNE <ERRF>	;ERROR?
		TXNN IOS,MT%EOT	;YES. EOT THEN?
		RETBAD ()	;NO. REAL ERROR THEN
		TQZ <BLKF>
		CALL EOV	;DO VOL SIWTCH
		 RETBAD ()	;ERROR
		JRST MTRCOO]	;AND TRY AGAIN
	SETZM FILCNT(JFN)	;NO COUNT YET
	CALL SQSFCT		;SET UP COUNTS

MTRCO0:	LOAD T2,TPFRMT		;GET TAPE FORMAT
	CALL @[			;DISPATCH TO RECORD OUTPUT ROUTINE
		DTBDSP (MTRCOU)		;SYSTEM-DEFAULT
		DTBDSP (MTRCOF)		;FIXED
		DTBDSP (MTRCOD)		;VARIABLE
		DTBDSP (MTRCOS)		;SPANNED
		DTBDSP (MTRCOU)		;UNDEFINED
		](T2)
MTRCEV:	 JRST [	TXNN IOS,MT%EOT	;AT THE EOT?
		RETBAD ()	;NO. REAL ERROR THEN
		JN SNEOT,,RSKP	;IF ALREADY KNOW IT, DONE
		TQZ <BLKF>	;IGNORE THIS IF SET
		CALLRET EOV]	;YES. DO EOV PROCESSING
	CALL SQOPRC		;COMPLETE RECORD TO TAPE
	 CALLRET MTRCEV		;HANDLE EOV IN STANDARD MANNER
	RETSKP			;RETURN +2 SUCCESS
;ROUTINES OF MTRCO FOR EACH RECORD TYPE

; UNDEFINED RECORD OUTPUT

MTRCOU:	UCALL MTRECO		;CALL MAGTAP FOR PROCESSING
	 CALLRET MTRCEV		;HANDLE EOV IN STANDARD MANNER
	TQNE <ERRF>		;ANY ERRORS SEEN?
	JRST MTRCEV		;YES. GO HANDLE IT
	RETSKP			;SUCCESS


; FIXED RECORD OUTPUT

MTRCOF:	SKIPG T1,FILBYN(JFN)	;ANY BYTES IN RECORD?
	 RETSKP			;NO-- THIS IS A NOOP
	OPSTR <CAME T1,>,TPRSZ	;ENOUGH BYTES IN RECORD?
	RETBAD (IOX14)		;NO. ERROR THEN
	CALLRET SQOFIL		;FILL REST OF RECORD

; VARIABLE AND SPANNED RECORD OUTPUT

MTRCOD:
MTRCOS:	SKIPG T1,FILBYN(JFN)	;GET COUNT OF BYTES NOW IN RECORD
	 RETSKP			;NONE-- THIS IS A NOOP
	MOVEM T1,FILLEN(JFN)	;MAKE THIS THE RECORD SIZE
	SETZM TPFLNX(U)		; AND NO EXPECTED BYTES IN NEXT RECORD
	CALL SQSFCT		;SETUP FILCNT ACCORDINGLY
	RETSKP			;RETURN SUCCESS
;SEQUENTIAL OUTPUT ROUTINES

; SETUP FIXED RECORD

SQOSRF:	LOAD T1,TPRSZ		;GET TAPE RECORD SIZE
	MOVEM T1,FILLEN(JFN)	;SET THAT AS SIZE
	RETSKP			;RETURN +2 FROM SQOSRF

; SETUP VARIABLE RECORD

SQOSRD:	MOVX T1,^D4		;FOUR BYTE RECORD
	CALL SQOSRC		;SETUP RECORD COUNT
	 RET			;BLOCK OR ERROR-- PASS UP
	LOAD T1,TPRSZ		;GET TAPE RECORD SIZE INCLUDES RCW
;	ADDI T1,4		;ALLOW RCW AS WELL
	MOVEM T1,FILLEN(JFN)	;SET THAT AS SIZE
	RETSKP			;RETURN +2 FROM SQOSRD

; SETUP SPANNED RECORD

SQOSRS:	MOVX T1,^D5		;SEGMENT CONTROL WORD IS 5 BYTES
	CALL SQOSRC		;FILL SCW
	 RET			;BLOCK OR ERROR-- PASS UP
	SKIPG T1,TPFLNX(U)	;GET NUMBER OF BYTES EXPECTED IN THIS RECORD
	CALL [	LOAD T2,TPRSZ	;MAKE NEW RECORD. GET RECORD COUNT
		OPSTR <IDIV T2,>,TPBSZ ;COMPUTE # OF BLOCKS WE WILL NEED
		IMULI T2,5	;COMPUTE #OF BYTES IN SCW+RCW FOR EACH PIECE
		OPSTR <ADD T2,>,TPRSZ ;AND ADD IN RECORD SIZE
		MOVEI T1,5(T2)	;COMPUTE TOTAL RECORD SIZE
		RET]		;AND DONE
	MOVEM T1,FILLEN(JFN)	;SET AS CURRENT RECORD LENGTH
	SUB T1,TPFCNT(U)	;FIT INTO ACTUAL PHYSICAL BLOCK
	SUB T1,FILBYN(JFN)	;AND DISCOUNT THIS AS WELL
	SKIPG T1		;WILL EXPECTED RECORD SIZE FIT IN THIS BLOCK?
	 MOVX T1,0		;YES-- NO BYTES EXPECTED IN NEXT RECORD
	MOVEM T1,TPFLNX(U)	;SAVE COUNT OF BYTES EXPECTED IN NEXT RECORD
	RETSKP			;RETURN +2 FROM SQOSRV

; SQOSRC -- REMEMBER RCW/SCW POSITION AND FILL IT

SQOSRC:	ADD T1,TPFLNX(U)	;ADD EXPECTED SIZE SO THAT EVERYTHING WORKS RIGHT
	MOVEM T1,FILLEN(JFN)	;SET RCW/SCW SIZE AS CURRENT RECORD SIZE
	SETZM FILBYN(JFN)	;NOW AT BYTE 0
	CALL SQSFCT		;SETUP FILCNT FOR SCW/RCW
	MOVX T1,"^"		;GET FILL CHARACTER
	CALL SQPBYT		;FORCE US TO HAVE A BUFFER FOR THIS BYTE
	 JRST [	MOVE T2,TPFLNX(U)	;BLOCK OR ERROR-- RESET RECORD COUNTS
		MOVEM T2,FILLEN(JFN)	; . .
		SETZM FILBYN(JFN)	; . .
		SETZM FILCNT(JFN)	; . .
		RET]			; AND PASS BLOCK/ERROR UP
	CALL SQSPOS		;SAVE BUFFER POSITION
	CALL SQOFIL		;FILL RECORD CONTROL WORD WITH "^" FOR NOW
	 RET			;BLOCK OR ERROR-- PASS UP
	RETSKP			;RETURN NOW
; SQOPRC -- COMPLETE RECORD TO TAPE
; CALL:
; RETURNS:
;	+1:	BLOCK OR ERROR
;	+2:	SUCCESS

SQOPRC:	SKIPG FILBYN(JFN)	;ANY BYTES IN THIS RECORD?
	RETSKP			;NO. ALL DONE THEN
	LOAD T2,TPFRMT		;GET TAPE FORMAT TYPE
	CALL @[			;DISPATCH TO PUT RECORD ROUTINE
		DTBSKP			;SYSTEM-DEFAULT
		DTBDSP (SQOPRF)		;FIXED
		DTBDSP (SQOPRD)		;VARIABLE
		DTBDSP (SQOPRS)		;SPANNED
		DTBSKP			;UNDEFINED
		](T2)
	 RET			;BLOCK OR ERROR
	RETSKP			;RETURN +2 FORM SQOPRC


; PUT FIXED RECORD

SQOPRF:	LOAD T2,TPRSZ		;GET RECORD SIZE
	CALL SQOFIT		;MAKE SURE THAT ANOTHER RECORD WILL FIT
	 RET			;BLOCK OR ERROR-- PASS UP
	RETSKP			;RETURN +2 FROM SQOPRF

; PUT VARIABLE RECORD

SQOPRD:	CALL SQOPRN		;PUT FILBYN INTO RECORD CONTROL WORD
	LOAD T2,TPRSZ		;GET RECORD SIZE INCLUDING RCW
;	ADDI T2,^D4		; PLUS SIZE OF RCW
	CALL SQOFIT		;MAKE SURE THAT ANOTHER RECORD WILL FIT
	 RET			;BLOCK OR ERROR-- PASS UP
	RETSKP			;RETURN +2 FROM SQOPRD

; PUT SPANNED RECORD

SQOPRS:	SKIPLE TPFLNX(U)	;ANY BYTES EXPECTED FOR NEXT RECORD?
	 TDZA T1,T1		;YES-- WE ARE NOW IN MIDDLE, CLEAR BEGIN
	SETO T1,		;NO-- MUST BE AT END (AND NEXT RECORD BEGINS)
	LOAD T2,TPBEGF		;SEE IF WE BEGAN THIS RECORD (B35)
	STOR T1,TPBEGF		;REMEMBER WHETHER NEXT RECORD BEGINS OR NOT
	ANDI T1,2		;TRIM END FLAG DOWN TO 1 BIT (B34)
	IOR T1,T2		;NOW HAVE INDEX IN B34,B35:  END,BEGIN
				; 0: -B, -E;  1: B, -E;  2: -B, E;  3: B, E
	MOVE T1,[EXP "2","1","3","0"](T1) ;GET CHARACTER FOR SEGMENT TYPE
	CALL SQOPRB		;PUT THE DIGIT AWAY AS FIRST BYTE OF SCW
	CALL SQOPRN		;PUT FILBYN INTO SCW AS 4 DIGITS
	MOVX T2,^D5+^D1		;MAKE SURE WE CAN FIT
	CALL SQOFIT		; ANOTHER SCW AND 1 BYTE RECORD IN THIS BLOCK
	 RET			;BLOCK OR ERROR-- PASS UP
	RETSKP			;RETURN +2 FROM SQOPRS
; SQOPRN -- PUT RECORD/SEGMENT SIZE FROM FILBYN(JFN) INTO RCW/SCW AS 4 DIGITS
; CALL:
;	FILBYN(JFN)/  BYTE COUNT FOR RCW/SCW
; RETURNS:  +1 ALWAYS

SQOPRN:	MOVE T1,FILBYN(JFN)	;GET COUNT
	MOVX T3,^D4		;FOUR BYTES
SQOPC1:	IDIVI T1,^D10		;STRIP A DIGIT
	PUSH P,T2		;SAVE REMAINDER ON STACK
	SOSLE T3		;PUSHED 4 DIGITS YET?
	 CALL SQOPC1		;NO-- PUSH SOME MORE
	POP P,T1		;YES-- POP LAST DIGIT
	ADDI T1,"0"		;CONVERT TO ASCII
	CALLRET SQOPRB		;SEND THE BYTE TO RCW/SCW AND RETURN


; SQOPRB -- PUT BYTE INTO RCW/SCW
; CALL:
;	T1/	BYTE TO BE PUT IN SCW/RCW
; RETURNS:  +1 ALWAYS

SQOPRB:	JN SNEOT,,SQOPB1	;IF EOT PROCESSING, SKIP THIS PART
	IDPB T1,TPSBYT(U)	;PUT THE BYTE AWAY
	MOVE T1,TPSBYT(U)	;GET POINTER TO THIS BYTE
	IBP T1			;POINT TO NEXT BYTE
	TRNN T1,777		;ON PAGE BOUNDARY?
	CAMGE T1,[POINT 8,0,7]	; AND POINTING TO FIRST BYTE?
	 JRST SQOPB1		;NO-- GO ON
	LOAD T1,TPSCUP		;YES-- GET CURRENT PAGE POINTER
	ADDI T1,1		;BUMP TO NEXT PAGE
	STOR T1,TPSCUP		;SAVE IT
	MOVE T1,-1(T1)		;GET ADDRESS OF BUFFER PAGE
	SUBI T1,1		;MAKE THAT PREVIOUS PAGE SO IDPB STEPS TO THIS ONE
	HRRM T1,TPSBYT(U)	;STORE NEW PAGE ADDRESS
SQOPB1:	RET			;RETURN +1 FROM SQOPRB
; SQOFIT -- MAKE SURE ANOTHER RECORD CAN FIT IN BLOCK, ELSE PAD BLOCK
; CALL:
;	T2/	NUMBER OF BYTES THAT MUST FIT IN RECORD
; RETURNS:
;	+1:	ERROR OR BLOCK
;	+2:	SUCCESS

SQOFIT:	MOVE T1,TPFLEN(U)	;GET LENGTH OF CURRENT BLOCK
	SUB T1,TPFBYN(U)	; MINUS WHAT'S ALREADY THERE
	CAML T1,T2		;WILL THIS RECORD FIT IN BLOCK?
	 JRST SQOFT2		;YES-- ALL OK
	MOVE T3,TPFBYN(U)	;GET NUMBER OF BYTES IN BLOCK
	CAIGE T3,^D16		;ENOUGH FOR THE HDW?
	JRST SQOFT3		;NO. PAD THEN
	LOAD T3,TPFRMT		;GET FORMAT OF DATA
	SKIPE TPFLEN(U)		;ANY BUFFERS SET UP YET?
	CAIN T3,TPFMTF		;YES. IS THIS VARIABLE?
	SKIPA			;NO. DO FILL THEN
	JRST SQOFT1		;YES. DON'T FILL THEN
SQOFT3:	ADD T1,TPFLNX(U)	;COUNT EXPECTED BYTES WHICH WE WILL NOT FILL
	MOVEM T1,FILLEN(JFN)	;SAVE COUNT OF RECORD TO BE FILLED
	SETZM FILBYN(JFN)	;NOW AT BYTE 0
	CALL SQOFIL		;FILL THIS RECORD
	 RET			;BLOCK OR ERROR
SQOFT1:	SQCALL MTRECO		;CALL MAGTAP TO PUT RECORD ON TAPE
	 RET			;BLOCK OR ERROR-- PASS UP
	TQNE <ERRF>		;ANY ERRORS SEEN?
	RETBAD ()		;YES. PASS UP THEN
SQOFT2:	MOVE T1,TPFLNX(U)	;GET BYTES EXPECTED IN NEXT RECORD
	MOVEM T1,FILLEN(JFN)	;SAVE AS WHAT'S LEFT IN RECORD
	SETZM FILBYN(JFN)	;NOW AT BYTE ZERO OF THIS RECORD
	SETZM FILCNT(JFN)	;ALSO SAY NO BYTES AVAILABLE YET
	RETSKP			;RETURN +2 FROM SQOFIT
; SQOFIL -- FILL REST OF RECORD
; CALL:
; RETURNS:
;	+1:	BLOCK OR ERROR
;	+2:	SUCCESS

SQOFIL:	MOVE T1,FILLEN(JFN)	;GET CURRENT LENGTH
	SUB T1,TPFLNX(U)	; MINUS WHAT'S EXPECTED IN NEXT BLOCK
	CAMG T1,FILBYN(JFN)	;HAVE WE FILLED RECORD YET?
	 RETSKP			;YES-- RETURN +2
	MOVX T1,"^"		;NO-- GET FILL CHARACTER
	CALL SQPBYT		;PUT FILL CHARACTER IN BUFFER
	 RET			;BLOCK OR ERROR-- PASS UP
	JRST SQOFIL		;SEE IF FULL YET


; SQPBYT -- PUT BYTE INTO BUFFER OR SEND TO MAGTAP
; CALL:
;	T1/	BYTE TO BE OUTPUT
; RETURNS:
;	+1:	BLOCK OR ERROR
;	+2:	SUCCESS

SQPBYT:	SKIPLE FILCNT(JFN)	;ANY BYTES AVAILABLE IN BUFFER?
	 JRST [	IDPB T1,FILBYT(JFN)	;YES-- STORE BYTE
		SOS FILCNT(JFN)		;COUNT DOWN BYTES AVAILABLE
		AOS FILBYN(JFN)		;COUNT UP BYTE IN RECORD
		RETSKP]			; AND RETURN SUCCESS
	SQCALL MTASQO		;CALL MAGTAP TO PUT BYTE
	 RET			;BLOCK OR ERROR-- PASS UP
	RETSKP			;RETURN +2 FROM SQPBYT
;ROUTINE TO CHECK OUTPUT TAPE POSITION

OUTCHK:
OUTCK1:	LOAD T1,TPSTAT		;GET STATE
	JRST @OUDIS.(T1)	;DISPATCH

;DISPATCH TABLE FOR OUTPUT

OUDIS.:	STDIS (OU)		;GEN FOR ALL STATES
;TAPE NOT OPENED (HEADERS WRITTEN)

OU.ABH:
OU.CLS:	CALL OPEN		;OPEN UP NEXT FILE
	 RETBAD ()		;ERROR
	JRST OUTCHK		;AND PROCEED AROUND THE HORN

OU.HDR:	JRST IN.HDR		;HANDLE ERROR

;USER LABELS DONE - TIE OFF LABEL AREA

OU.UHL:	TQNE <WRTF>		;WRITING?
	JRST [	CALL WRODON	;YES. NOW WRITE FILE HEADERS
		 RETBAD()	;ERROR
		JRST .+1]	;PROCEED
	JN TPAPP,,[JN TPEUT,,OU.UH0 ;IF APPEND AND ALL LABELS READ, GO ON
		MOVEI T2,.MOFWF	;SKIP OVER USER LABELS
		CALL MTLFCN
		 RETBAD ()	;FAILED
		JRST OU.UH0]	;PROCEED WITH APPEND STATUS
	MOVEI T2,.MOEOF		;WRITE A TAPE MARK
	CALL MTLFCN		;...
	 JRST [	TXNN IOS,MT%EOT	;EOT?
		RETBAD ()	;NO. ERROR THEN
		SETONE SNEOT	;YES. REMEMBER THIS
		CALL CLREOF	;NO MORE EOF OR EOT
		JRST .+1]	;AND PROCEED
SETRDY:	LOAD T1,TPUNIT		;GET MTA UNIT
	CALL PHYPOS		;GET POSITION INFO
	STOR T1,RCNT		;SAVE FOR CLOSE
SETRD0:	MOVEI T1,.STRDY		;READY FOR I/O
	STOR T1,TPSTAT
	SETZRO <TPEUT,TPAPP>	;NO LONGER AT END OF USER LABELS
	CALL CLREOF		;CLEAR EOF INDICATION
	JE SNEOT,,RSKP		;IF NOT EOV, DONE
	CALL EOV		;IT WAS. PROCESS IT
	 RETBAD ()		;ERROR
	JRST OUTCK1		;SUCCESS.
;TAPE IS OPEN FOR APPEND. MUST POSITION TO END OF VALID DATA

OU.UH0:	MOVEI T2,.MOFWF		;SKIP TO EOF
	CALL MTLFCN		;DO IT
	 RETBAD ()
	CALL CLREOF		;CLEAR EOF INDICATOR
	CALL TLRCHK		;GET TO THE END
	 RETBAD ()		;SOME SORT OF ERROR
	JN TPEOF,,OU.UH1	;IF AT THE END, WE ARE READY
	CALL EREOF2		;GET NEXT TAPE
	 RETBAD ()		;ERROR OF SOME SORT
	MOVEI T2,.MOFWF		;SKIP TO LABEL SECTION
	CALL MTLFCN		;SKIP TO DATA PORTION
	 RETBAD()		;ERROR OF SOME SORT
	CALL CLREOF		;CLEAR EOF INDICATOR
	JRST OU.UH0		;AND PROCEED

;AT THE END OF FILE

OU.UH1:	SETZRO TPEOF		;CLEAR EOF INDICATOR
	DECR FSEQ		;STILL ON PREVIOUS SEQUENCE NUMBER
	MOVEI T2,.MOBKF		;BACK UP ONE FILE
	CALL MTLFCN		;DO IT
	 RETBAD ()		;ERROR
	CALL CLREOF		;CLEAR LATENT INDICATORS
	JRST SETRDY		;AND DONE AT LAST

;TAPE READY FOR OUTPUT

OU.RDY:	RETSKP			;SKIP RETURN

;HERE IF PREVIOUS USE WASN'T CLOSED

OU.UTL:	CALL CLOSE		;FINISH THE CLOSE
	 RETBAD ()		;ERROR
	JRST OUTCHK		;AND PROCEED

;VOLUME SWITCH STATE

OU.VLS:	CALL VOLSW0		;COMPLETE SWITCH
	 RETBAD()		;ERROR
	JRST OUTCHK		;AND PROCEED
; SQMTCL -- CALL MAGTAP SEQUENTIAL I/O ROUTINE AND KEEP TRACK OF COUNTS
; CALL:
;	SQCALL <ROUTINE IN MAGTAP>
; RETURNS:
;	+1:  BLOCK OR ERROR FROM MAGTAP (SCHED TEST OR ERROR CODE IN T1)
;	+2:  SUCCESS

SQMTCL:	PUSH P,FILLEN(JFN)	;SAVE FILLEN
	PUSH P,FILBYN(JFN)	; AND FILBYN
	PUSH P,T1		;SAVE T1 FOR NOW
	MOVE T1,TPFCNT(U)	;GET MAGTAP'S FILCNT
	MOVEM T1,FILCNT(JFN)	;SAVE THAT
	MOVE T1,TPFLEN(U)	; AND MAGTAP'S FILLEN
	MOVEM T1,FILLEN(JFN)	; . .
	MOVE T1,TPFBYN(U)	; AND MAGTAP'S FILBYN
	MOVEM T1,FILBYN(JFN)	; . .
	POP P,T1		;RESTORE T1 NOW
	XCT @-2(P)		;CALL ROUTINE IN MAGTAP
	AOS -2(P)		;SKIP THE INSTRUCTION
	PUSH P,T1		;SAVE T1 FROM MAGTAP
	MOVE T1,FILCNT(JFN)	;GET MAGTAP'S FILCNT
	MOVEM T1,TPFCNT(U)	;SAVE THAT
	MOVE T1,FILLEN(JFN)	; AND MAGTAP'S FILLEN
	MOVEM T1,TPFLEN(U)	; . .
	MOVE T1,FILBYN(JFN)	; AND MAGTAP'S FILBYN
	MOVEM T1,TPFBYN(U)	; . .
	POP P,T1		;RESTORE T1
	POP P,FILBYN(JFN)	;RESTORE OUR FILBYN
	POP P,FILLEN(JFN)	; AND OUR FILLEN
	SETZM FILCNT(JFN)	;MARK WE HAVEN'T ACCEPTED ANY OF MAGTAP'S BYTES YET
	TQNE <ERRF,EOFF,BLKF>	;ERROR OR BLOCK?
	 RET			;YES-- RETURN +1
	AOS FILBYN(JFN)		;NO-- COUNT THE BYTE WE JUST DID
	CALL SQSFCT		;SET FILCNT ACCORDING TO NEW VARIABLES
	RETSKP			;RETURN +2 FROM SQMTCL
; SQSFCT -- SET FILCNT(JFN) ACCORDING TO OTHER VARIABLES
; CALL:
; RETURNS:  +1 ALWAYS

SQSFCT:	PUSH P,T1		;SAVE T1
	SKIPGE T1,FILCNT(JFN)	;GET OUR UNUSED BYTES
	 MOVX T1,0		; BUT NEVER LESS THAN ZERO
	ADDM T1,TPFCNT(U)	;COUNT THEM BACK TO MAGTAP
	MOVN T1,T1		; ALSO
	ADDM T1,TPFBYN(U)	; MAGTAP'S RECORD BYTE COUNT
	MOVE T1,FILLEN(JFN)	;GET BYTES LEFT
	SUB T1,FILBYN(JFN)	; IN OUR RECORD
	SUB T1,TPFLNX(U)	; MINUS WHAT'S EXPECTED IN NEXT RECORD
	CAMLE T1,TPFCNT(U)	;DOES MAGTAP WANT US TO TAKE(GIVE) LESS?
	 MOVE T1,TPFCNT(U)	;YES-- USE MAGTAP'S COUNT
	SKIPGE T1		;LESS THAN ZERO??
	 MOVX T1,0		;YES-- MAKE IT ZERO
	MOVEM T1,FILCNT(JFN)	;SAVE AS OUR COUNT IN BUFFER
	ADDM T1,TPFBYN(U)	;COUNT THAT WE GOT THOSE BYTES
	MOVN T1,T1		; AND COUNT DOWN
	ADDM T1,TPFCNT(U)	; MAGTAP'S COUNT
	POP P,T1		;RESTORE T1
	RET			;RETURN FROM SQSFCT


; SQSPOS -- SAVE BUFFER POSITION IN TPSCUP AND TPSBYT
; CALL:
;	CALL AFTER ONE BYTE HAS BEEN TAKEN OR PUT INTO BUFFER
; RETURNS:
;	+1:	ALWAYS, T2, T3 DESTROYED, T1 PRESERVED

SQSPOS:	MOVX T2,-1		;NOW DECREMENT BYTE POINTER
	ADJBP T2,FILBYT(JFN)	; INTO T2
	MOVEM T2,TPSBYT(U)	;SAVE THAT POINTER
	LOAD T3,TPUNIT		;GET UNIT FOR MAGTAP DATABASE
	LOAD T2,MTCUP,(T3)	;GET CURRENT PAGE POINTER
	STOR T2,TPSCUP		;SAVE THAT POINTER
	MOVE T3,FILBYN(JFN)	;GET CURRENT JFN BYTE
	ADD T3,FILCNT(JFN)	;COMPUTE BYTES TAKEN SO FAR
	MOVE T2,TPFCNT(U)	;GET CURRENT COUNT
	ADD T2,T3		;INCREASE COUNT BY TAKEN BYTES
	STOR T2,TPOCT		;SAVE IT
	MOVE T2,TPFBYN(U)	;GET CURRENT BYTE NUMBER
	SUB T2,T3		;DECREASE BYTE NUMBER BY TAKEN BYTES
	STOR T2,TPOBY		;SAVE IT
	RET			;RETURN FROM SQSPOS
; SQRPOS -- RESTORE BUFFER POSITION
; CALL:
;	TPSCUP AND TPSBYT POINT TO BUFFER POSITION TO BE RESTORED
; RETURNS:
;	+1:	ALWAYS

SQRPOS:	MOVE T2,TPSBYT(U)	;GET BYTE POINTER
	MOVEM T2,FILBYT(JFN)	;RESTORE POINTER
	LOAD T3,TPUNIT		;GET MAGTAPE UNIT INDEX
	LOAD T2,TPSCUP		;GET BUFFER PAGE INDEX AT BUFFER POSITION
	STOR T2,MTCUP,(T3)	;SET IN MAGTAP'S DATABASE
	RET			;RETURN FROM SQRPOS
;ROUTINE TO CLEAR EOFF AND MT%EOF

CLREOF:	LOAD T1,TPUNIT		;GET MTA UNIT #
	CALLRET MTACEF		;CLEAR EOF AND ABORTF

;BAD STATE DISPATCHES COME HERE

BADIS:	MTERET (DESX9)		;BAD OPERATION
;DUMP MODE I/O

;DUMPI SERVER
;	T1/ I/O WORD TO SEND TO MAGTAP

MTDI:	ASUBR <IOARG>		;SAVE I/O LIST POINTER
	CALL SETUNT		;SET U
	RET			;ERROR
	LBLCHK (MTDMPI)		;DUMP MODE
;	LOAD T2,TPFRMT		;GET TAPE FORMAT
;	CAIE T2,TPFSYD		;SYSTEM-DEFAULT?
;	CAIN T2,TPFMTU		; OR UNDEFINED?
;	 SKIPA			;YES-- GO ON
;	  MTERET (IOX15)	;NO-- DUMP MODE IS ILLEGAL
MTDI0:	CALL INCHK		;CHECK FOR INPUT
	 RET			;NEED TO BLOCK
	MOVE T1,IOARG		;RESTORE I/O LIST POINTER
	UCALL MTDMPI		;CALL UPON MAGTAP
	 JRST MTDIW		;BLOCK OR ERROR OR EOF
	MOVE T1,IOARG		;GET OLD COMMAND WORD
	MOVEM T1,FILMTP(JFN)	;SAVE IN CASE OF TM
	RETSKP			; OK RETURN

;MTDMPI WANT TO BLOCK OR FOUND AN ERROR. DO ANALYSIS

MTDIW:	TQNE <EOFF>		;END-OF-FILE?
	CALL EOV		;HANDLE EOF
	 RETBAD ()		;ERROR
	TQNN <NWTF>		;IS THIS NO WAIT?
	JRST MTDI0		;NO, MORE DATA
	CALL INCHK		;YES. GET TO PROPER STATE
	 RETBAD ()		;ERROR
	MOVE T1,FILMTP(JFN)	;GET FAILING I/O BLOCK
	UCALL MTDMPI		;AND DO IT AGAIN
	 RETBAD ()		;ERROR
	JRST MTDI0		;AND DO NEW COMMAND WORD AS WELL
;DUMP MODE I/O CONTINUED

;DUMPO SERVER
;	T1/ I/O WORD TO PASS TO MAGTAP

MTDO:	ASUBR <IOARG>		;SAVE I/O LIST POINTER
	CALL SETUNT		;SET U
	RET			;ERROR
	LBLCHK (MTDMPO)		;DUMP OUTPUT
;	LOAD T2,TPFRMT		;GET TAPE FORMAT
;	CAIE T2,TPFSYD		;SYSTEM-DEFAULT?
;	CAIN T2,TPFMTU		; OR UNDEFINED?
;	 SKIPA			;YES-- GO ON
;	  MTERET (IOX15)	;NO-- DUMP MODE IS ILLEGAL
MTDO0:	CALL OUTCHK		;CHECK FOR OUTPUT
	 RET
	MOVE T1,IOARG		;RESTORE I/O LIST POINTER
	UCALL MTDMPO		;DO OUTPUT
	 JRST MTDOW		;BLOCK OR CHECK EOT
	RETSKP			;OK RETURN

;MTDMPO WANTS TO BLOCK OR FOUND AN ERROR. DO ANALYSIS

MTDOW:	JN TPDVS,,R		;PASS UP ERROR IF DEFERRING VOL SWITCH
	TQNN <ERRF>		;ERROR?
	RET			;NO. PASS UP BLOCK
	TQZ <BLKF>		;TURN OFF BLOCKING
	TXNE IOS,MT%EOT		;THIS EOT?
	CALL EOV		;DO EOT
	 RET			;ERROR
	JRST MTDO0		;TRY AGAIN
;ROUTINE TO CLOSE A TAPE

MTCLZ:	TXNE T1,CZ%ABT		;CLOSE W/ABORT?
	JRST MTCLZA		;YES - HANDLE SPECIAL
	CALL SETUNT		;NO - PROCEED NORMALLY
	 RET			;BLOCKAGE
	LBLCHK (MTACLZ)		;CLOSE IF UNLABELED OP
	CALL CLOSE		;PERFORM CLOSEING OPERATIONS
	 RET			;BLOCK OR ERROR
	CALLRET CLZCMN		;AND DO COMMON CLOSE STUFF

;HERE IF CLOSE WITH ABORT

MTCLZA:	STKVAR <SVLBOP>		;SAVE LABEL OPCODE HERE
	CALL SETUNB		;SET UP U, ETC.
	 JRST [	HLRZ U,DEV	;ERROR. SET UP U ANYWAY
		JRST MTACL1]	;AND DO ABORTING
	LOAD T2,TPLPCS		;GET STATE CODE
	MOVEM T2,SVLBOP		;ANAD SAVE IT
	SETZRO TPLPCS		;CLEAR IT
	HLRZ U,DEV		;SETUP U
	LOAD IOS,TPUNIT		;GET MTA UNIT #
	CAIN IOS,MXMTAU		;VALID?
	JRST MTCLA0		;NO. DON'T CLOSE MTA THEN
	MOVEM T3,TLABL9(U)	;SAVE BLOCK ADDRESS JUST IN CASE....
	STOR T4,TPJFN		;SAVE JFN
	MOVE IOS,MTASTS(IOS)	;OK - SETUP IOS
	UCALL MTACLZ		;CALL UPON MAGTAP
	 NOP			;MUST WORK
MTCLA0:	LOAD T1,TPSTAT		;CHECK STATE
	MOVE T2,SVLBOP
	CAIE T1,.STUHL		;SAFE?
	CAIN T1,.STCLS		;A SAFE STATE?
	JUMPE T2,CLZCMN		;IF LABNL OP IN PROGRESS, GO ON
MTACL1:	MOVEI T1,.STABH		;SAY ABORTED
	STOR T1,TPSTAT		;REMEMBER NEW STATE
CLZCMN:	SETZRO <TPOPN,TPMOD>	;NOT OPENED NOW
	LOAD T1,TPPRO		;GET PROTECTION OF THIS JFN
	MOVEM T1,FILMTP(JFN)	;AND PUT IT BACK
	RETSKP			;RETURN

	ENDSV.			;END STKVAR
;ROUTINE TO PERFORM FUNCTION CODE IN T2 AND WAIT UNTIL
; IT IS COMPLETE (CHECK ERRORS)
;RETURNS ERROR CODE (IF ANY) IN T1

MTLFCN:	SAVEAC <Q3,P3>		;SAVE REGS THAT ARE USED WITHIN TAPE
	TRVAR <ISTATE,ISTS,OLDCNT,OLDBYT,OLDBYN,OLDLEN>
	SETZM ISTATE		;NO FORCED OPEN YET
	MOVEM STS,ISTS		;SAVE INCOMING STATUS
	SETZRO TPGDS		;NO LOCAL STATUS
	NOINT			;PROTECT THIS CODE AGAINST INVADERS
MTLFC1:	TQZ <ERRF,BLKF>		;MAKE SURE THESE ARE OFF
	STOR T2,TPLPCS		;REMEMBER FCN STARTED
	LOAD T3,TPUNIT		;GET ASSOCIATED MTA
	SKIPL MTASTS(T3)	;IS IT OPENED?
	JRST [	SETZM OLDCNT
		SETZM OLDBYN
		SETZM OLDBYT
		SETZM OLDLEN	;INIT SAVE LOCS
		CALL FIXJF0	;SAVE CURRENT VALUES
		CALL [SAVEAC <T2,T3,T4> ;SAVE ACS
			SAVEP	;SAVE P'S AS WELL
			MOVX STS,<READF!17> ;READ AND DUMP MODE
			MCALL MTAOPN ;OPEN UP THE TAPE
			 RET	;ERROR OR BLOCK
			SETZRO FSSAV ;INIT STATUS SETTER
			RETSKP]	;DONE
		 JRST [	CALL FIXJF0 ;RESTORE VALUES
			JRST MTFCN0] ;AND ANALYZE ERROR
		SETOM ISTATE	;REMEMBER FORCED OPEN
		MOVX STS,<OPNF!READF!17> ;GET PROPER STS
		CALL SETDNS	;SET MT DENSITY
		JRST .+1]	;AND PROCEED
	CAIL T2,.MXMTO		;MAX MTOPR FUNCTION?
	JRST MTFCN2		;DOING OTHER FUNCTION
	CALL MTMTCM		;PERFORM MTOPR FUNCTION
	 JRST MTFCNB		;BLOCK OR ERROR
MTFCNW:	LOAD T2,TPLPCS		;FUNCTION JUST PERFORMED
	CAIN T2,.MONOP		;WAS THAT THE WAIT?
	JRST MTFCND		;DONE - PERFORM STATE CHANGE
	MOVEI T2,.MONOP		;DO NO-OP (WAIT)
	JRST MTLFC1		;NOW DO IT

MTFCND:	CALL CKCLZ		;SEE IF WANT IT CLOSED
	RETSKP			;DONE RETURN
;BLOCK ROUTINE / CHECK OPNF BIT STATE
;C(T1) PRESERVED (ERROR CODE/ WAIT STATE)

MTFCNB:
MTFCN0:	TQZN <BLKF>		;CHECK FOR ERROR
	RETBAD (,<CALL CKCLZ>)	;NOT BLOCKING. SEE IF NEED CLOSING
	EXCH STS,ISTS		;SAVE OLD STS. FETCH ORIGINAL
	CALL FIXJFN		;FIX UP JFN BLOCK
	OKINT			;UNDO NOINT SO WE CAN DISMISS
	CALL MTFCNC		;WAIT HERE
	 MTERET ()		;THE JFN WAS REASSIGNED.
	NOINT			;PROTECT AGAIN
	EXCH STS,ISTS		;SAVE ORIGINAL STS. FETCH WORKING ONE
	CALL FIXJFN		;FIX UP JFN BLOCK
	LOAD T2,TPLPCS		;TRY FUNCTION OVER
	JRST MTLFC1		;...

;LOCAL ROUTINE TO CLOSE MTA WHEN MTLFCN FUNTION IS COMPLETED OR
;NEEDS TO BLOCK

CKCLZ:	SETZRO TPLPCS		;NO PENDING OPERATIONS
	MOVE STS,ISTS		;RESTORE ORIGINAL STATUS
	MOVEM STS,FILSTS(JFN)	;UPDATE STATUS NOW
	SKIPN ISTATE		;NEED CLOSING?
	JRST CKCLZ0		;NO. DONE
	SAVET			;SAVE ALL REGS
	SAVEAC <STS,IOS>	;SAVE IMPORTANT STATE REGS
	MOVX T1,CZ%ABT		;SAY ABORTING
	MCALL MTACLZ		;CLOSE IT
	 NOP			;CAN'T FAIL
	CALL FIXJFN		;RESTORE JFN BLOCK
CKCLZ0:	OKINT			;ALLOW INTS NOW
	RET			;AND DONE
;ROUTINE USED BY MTFCNB TO FIX UP JFN BLOCK

FIXJFN:	SKIPN ISTATE		;NEED TO FIX JFN BLOCK?
	RET			;NO. ALL DONE THEN

;ENTRY TO ALWAYS DO SAVE

FIXJF0:	MOVE T3,OLDLEN		;GET OLD FILLEN
	EXCH T3,FILLEN(JFN)	;SWITCH
	MOVEM T3,OLDLEN
	MOVE T3,OLDBYN		;GET OLD FILBYN
	EXCH T3,FILBYN(JFN)	;SWITCH
	MOVEM T3,OLDBYN		;SAVE IT
	MOVE T3,OLDBYT		;GET OLD FILBYT
	EXCH T3,FILBYT(JFN)	;SWITCH
	MOVEM T3,OLDBYT
	MOVE T3,OLDCNT		;GET OLD FILCNT
	EXCH T3,FILCNT(JFN)
	MOVEM T3,OLDCNT
	RET			;AND DONE
;NON MTOPR FUNCTIONS ARE HANDLED HERE

MTFCN2:	CAILE T2,.MXFCN		;VALID FUCNTION?
	MTERET (MTOX1)		;NO. ERROR
	JRST @FCNTB-.MXMTO(T2)	;YES - DISPATCH

FCNTB:	DTBDSP (LRFCN)		;100 - LABEL READ
	DTBDSP (LWFCN)		;101 - LABEL WRITE
	DTBDSP (MTFCNC)		;WAIT
	   .MXFCN==.-FCNTB+.MXMTO-1

LRFCN:	CALL LBLRED		;START I/O
	 JRST MTFCNB		;BLOCK OR ERROR
CLRLBO:	MCALL MTAFLA		;RETIRE THE IORB
	JRST MTFCNW		;DO WAIT FCN

LWFCN:	CALL LBLWRT		;START I/O
	 JRST MTFCNB		;BLOCK OR ERROR
	JRST CLRLBO		;RETIRE IORB AND WAIT

MTFCNC:	SAVEAC <U>		;BE SURE THIS IS NOT LOST
	LOAD T2,TPJFN		;GET CORRECT JFN
	CALL @TLABL9(U)		;BLOCK AND WAIT
	MTERET ()		;ERROR
	RETSKP			;FINISHED
;EOV ROUTINE - HANDLE TM ON READ OR EOT ON WRITE

EOV:
EOV1:	LOAD T1,TPSTAT		;GET STATE
	TQNE <WRTF>		;WRITING?
	JRST @EWDIS.(T1)	;YES - DISPATCH
	JRST @ERDIS.(T1)	;NO - READING

EWDIS.:	STDIS (EW)		;GEN STATES (WRITE)

ERDIS.: STDIS (ER)		;GEN STATES (READ)
;READ - MUST BE READY

ER.RDY:	MCALL MTAKIL		;REMOVE ALL IORBS FROM QUEUE
	MCALL MTFLSH		;NOW FLUSH CURRENT ACTIVITY
	 TQZ <BLKF>		;SHOULD NOT BLOCK
	MOVEI T1,.STEOF		;GET STATE CODE FOR PROC EOF LABELS
	STOR T1,TPSTAT		;SAY EOF SEEN
	CALL CLREOF		;CLEAR LOWER LEVEL EOF AND ERROR COND.
	JRST EOV1		;LOOP BACK


;READ TRAILERS

ER.EOF:	CALL TLRCHK		;READ/CHECK TRAILERS
	 RET			;PASS ERROR UP
	MOVEI T1,.STUTL		;SET FOR USER TRAILERS
	STOR T1,TPSTAT
	JE TPEOF,,EREOF1	;JUMP IF EOV
	LOAD T1,TPUNIT		;GET MTA UNIT #
	MOVX IOS,MT%EOF		;SET EOF
	IORB IOS,MTASTS(T1)	;...
	TQO <EOFF>		;RETURN END-OF-FILE
	RET

;HERE TO HANDLE EOV ON READ

EREOF1:	CALL INTETL		;INT FORK THAT EOV TRAILERS ARE AVAIALABLE
	 MTERET ()		;ERROR
	TDZA T4,T4		;PROCEED. REQUESTING INTERRUPT ON HEADERS

;ENTRY FOR CLOSF. DON'T INTERRUPT FORK

EREOF2:	SETOM T4		;NO INT ON HEADERS PLEASE
	MOVEI T1,.VMVSM		;INFORM PULSAR
	MOVEI T2,2		;TWO OTHER WORDS
	XMOVEI T3,[.VSMRV	;MOUNT RELATIVE VOLUME
		1]		;NEXT ONE
	CALLRET VVBLOK		;SEND MESSAGE AND DO VOLUME SWITCH
;ROUTINE TO INFORM MTCON (AKA PULSAR) OF VOLUME SWITCH AND
;WAIT FOR IT TO HAPPEN
;	T1-T3 ARGS FOR PULSAR
;	T4/ 0= INT PROCESS WHEN HEADERS ARE AVAILABLE
;	   -1= DON'T INT PROCESS WHEN HEADERS ARE AVAILABLE
;RETURNS:	+1 FAILED. EITHER MTCON NOT RUNNING, OR VOLUME
;			SWITCH FAILED
;		+2 SUCCESS. THE IMMENSE TANGLE OF PROGRAMS MANAGED TO DO IT

VVBLOK:	ASUBR <ARG1,ARG2,ARG3,ARG4> ;SAVE INCOMING ARGS
	STKVAR <MTASTA,MTARS>	;PLACE TO SAVE MTA STATUS
	LOAD T2,TPUNIT		;GET MTA UNIT NUMBER
	MOVE T2,MTASTS(T2)	;GET MTA STATUS
	MOVEM T2,MTASTA		;SAVE IT
	JE TPLBD,,VVBLK1	;IF UNLABLED. GO ON
	MOVEI T2,.STVLS		;SET ABORTED STATE IN CASE OF INT
	STOR T2,TPSTAT		;""
	MOVEI T2,.MONOP		;MAKE SURE MTA IS DONE
	CALL MTLFCN		;""
	 JRST [	TXNN IOS,MT%EOF!MT%EOT ;ACCEPTABLE ERROR?
		RETBAD ()	;NO. COMPLAIN
		JRST .+1]	;YES. PROCEED
	JE TPFSEC,,VVBLK1	;IF UNKNOWN FILE SECTION, GO ON
	INCR TPFSEC		;NEXT FILE SECTION PLEASE
VVBLK1:	LOAD T1,TPUNIT		;GET MTA UNIT #
	LOAD T2,MTDM,(T1)	;GET DATA MODE OF TAPE
	HRRM T2,MTASTA		;SAVE DATA MODE FOR LATER
	LOAD T2,MTRS,(T1)	;GET RECORD SIZE
	MOVEM T2,MTARS		;SAVE FOR LATER
	CALL CLRVV		;CLEAR VOLUME VALID
	MOVE T1,ARG1
	MOVE T2,ARG2
	MOVE T3,ARG3		;GET ARGS FOR MESSAGE ROUTINE
	CALL PLRMSG		;SEND OFF REQUEST
	MOVEI T1,.STHDR		;WILL ENTER HEADER STATE NEXT
	STOR T1,TPSTAT		;""
VVBLK2:	MOVEI T1,VVBWAT		;SCHED TEST ADDRS
	HRL T1,U		;UNIT TO WAIT FOR
	CALL MTFCNC		;WAIT FOR VOLUME SWITCH
	 MTERET ()		;ERROR
	JN TPVV,,VVBLK0		;IF NOW VALID, OPEN MTA
	JE TPNVV,,VVBLK2	;IF NOT VALID AND NOT ERROR, WAIT SOME MORE
	LOAD T1,TPERM		;GET ERROR CODE FROM MTCON
	MTERET()		;AND INDICATE ERROR
;VV NOW ON. OPEN UP MTA IF NECESSARY

VVBLK0:	JE TPLBD,,VVBLK3	;IF UNLABELED, GO ON
	CALL VOLSW0		;DO VOLUME SWITCH INITIALIZATION
	 RETBAD ()		;FAILED
VVBLK3:	SKIPL MTASTA		;NEED TO OPEN MTA?
	RETSKP			;NO. ALL DONE
	UCALL MTAOPN		;DO IT NOW
	 RETBAD ()		;ERROR OF SOME SORT
	CALL SETDNS		;SET MT DENSITY
	JE TPLBD,,VVBLK4	;IF UNLABELED, DONE
	CALL SETFMT		;AND SET UP BUFFERS
	 RETBAD ()		;ERROR OF SOME SORT
	SKIPN ARG4		;WANT TO INFORM PROCESS OF HEADERS?
	JRST [	CALL INTFRK	;YES. DO IT NOW
		 RETBAD ()	;ERROR
		JRST .+1]	;AND PROCEED
VVBLK4:	LOAD T1,TPUNIT		;GET NEW MTA UNIT
	HRRZ T2,MTASTA		;GET OLD FORMAT
	STOR T2,MTDM,(T1)	;STORE NEW DATA MODE
	MOVE T2,MTARS		;GET OLD RECORD SIZE
	STOR T2,MTRS,(T1)	;SAVE NEW RECORD SIZE
	UCALL MTASBW		;SET NEW BUFFERS
	 RETBAD ()		;ERROR
	RETSKP			;AND DONE

	ENDSV.			;END STKVAR

	RESCD

;SCHEDULER TEST FOR WAITING FOR PULSAR TO RESET V/V

VVBWAT:	EXCH U,T1		;COPY UNIT # TO U
	JE <TPVV,TPNVV>,,VVBWA0	;IF NEITHER VV OR ERROR, NOT DONE
	AOS 4			;WAKE UP
VVBWA0:	EXCH T1,U		;RESTORE U
	JRST 0(4)		;WAIT SOME MORE OR WAKEUP

	SWAPCD
;GET HERE FROM STATE TRANSFER IF STATE WAS .STVLS
;INIDICATES AN INTERUPTED VOLUME SWITCH

VOLSW0:	CALL OPRHDR		;OPEN HEADER AREAS
	 MTERET()		;OOPS
	CALL HDRCHK		;CHECK OUT THE NEW TAPE
	 RETBAD ()		;ERROR
	MOVEI T2,.STUHL		;SET TO PROPER STATE
	STOR T2,TPSTAT
	SETZRO <TPLCT,TPNUL>	;NO USER LABELS WRITTEN YET
	RETSKP			;AND DONE
;WRITE - CHECK READY

EW.RDY:	CALL CLREOF		;CLEAR EOT/EOF
	SETONE SNEOT		;NOTIFY THE WORLD WE KNOW ABOUT EOT
	TQNE <OPNF>		;IS TAPE OPENED?
	JRST [	SKIPN T1,FILBYN(JFN) ;YES. GET BYTE NUMBER
		ADDM T1,FILCNT(JFN) ;UNDO THIS BLOCK
		SETZM FILBYN(JFN) ;""
		JRST .+1]	;CONTINUE
	CALL MTMCSC		;MAKE SURE THE LAST RECORD IS OUT
	 RETBAD ()		;ERROR
	MOVEI T2,.MONOP		;NOW WAIT FOR I/O TO COMPLETE
	CALL MTLFCN		;""
	 JRST [	TXNN IOS,MT%EOT	;EOT AGAIN?
		MTERET()	;NO. ERROR ON LAST OP
		CALL CLREOF	;YES. CLEAR ALL ERROR INDICATORS
		JRST .+1]	;AND CONTINUE
	MOVEI T2,.MOEOF		;WRITE FINAL TAPE MARK
	CALL MTLFCN		;...
	 JRST [	TXNN IOS,MT%EOT	;COMPLAINING ABOUT THE EOT?
		RETBAD ()	;NO. ERROR THEN
		JRST .+1]	;YES. OKAY THEN
	CALL CLREOF		;CLEAR EOF INFO
	MOVEI T1,.STEOT		;CHANGE TO EOT STATE
	STOR T1,TPSTAT		;...
	JRST EOV1		;CONTINUE

EW.EOT:	HRROI T1,[ASCIZ "EOV1"]	;USE END-OF-VOLUME LABELS
	HRROI T2,[ASCIZ "EOV2"]
	CALL WRTTLR		;WRITE TRAILERS
	 RET			;PASS ERROR UP
	SETZRO <HDR1,HDR2>	;NO MORE HEADERS
	SETZRO <TPLCT,TPNUL>	;NO LABELS WRITTEN YET
	MOVEI T1,.STUTL		;PROCEED TO USER TRAILERS
	STOR T1,TPSTAT		;...
	JRST EOV1		;CONTINUE

EW.UTL:	CALL INTETL		;TELL FORK THAT EOV LABELS ARE AVAIALBEL
	 MTERET ()		;ERROR
	CALL TWOEOF		;PUT TWO EOFS ON THE TAPE
	 RETBAD ()		;ERROR
	CALL CLREOF		;CLEAR EOT
	MOVEI T1,.VMVSM		;VOLUME SWITCH
	MOVEI T2,2		;TWO MORE WORDS
	XMOVEI T3,[VS%WRT+.VSMRV
		1]
	SETZM T4		;ALLOW HEADERS TO BE READ
	CALLRET VVBLOK		;HANDLE VV/WAIT
;CODE TO INTERRUPT PROCESS AT EOV SO IT MAY READ LABELS

INTFRK:	TQNN <OPNF>		;FILE OPENED?
	RETSKP			;NO. MUST BE DONE THEN
	LOAD T1,TPPSI		;YES. GET PSI ASSIGNMENT
	SOJL T1,RSKP		;IF NO PSI ASSIGNMENT, DONE
	LOAD T2,TPFRK		;GET FORK NUMBER
	CALL PSIRQ		;DO INT
	MOVEI T1,JSKP		;DON'T REALLY BLOCK. JUST GO OKINT
	CALLRET MTFCNC		;DO IT

;UTILITY TO SET MT STATE AND CALL INTFRK

INTETL:	MOVEI T2,.STETL		;GET TO PROPER STATE
	STOR T2,TPSTAT		;DO IT
	CALL INTFRK		;DO INTERRUPT
	 RETBAD()		;ERROR
	LOAD T2,TPSTAT		;GET CURRENT STATE
	CAIN T2,.STETL		;STILL IN ETL?
	RETSKP			;YES. DONE
	CALLRET BADIS		;NO. ERROR THEN
;OPEN PROCESSING

OPEN:	STKVAR <OPNCD>		;A STORAGE CELL
OPEN1:	LOAD T1,TPSTAT		;GET STATE CODE
	JRST @OPDIS.(T1)	;OPEN DISPATCH

;OPEN DISPATCH TABLE

OPDIS.:	STDIS (OP)		;OPEN TABLE
;OPEN PROCESSING - CLOSED STATE

OP.CLS:	SETZRO TPEUT		;NO LONGER AT THE END OF USER LABELS
	SETZRO TPFSEC		;UNKNOWN SECTION
	CALL OPRHDR		;OPEN HEADER
	 RETBAD ()		;ERROR
	JRST OPEN1		;CONTINUE OPEN

OPRHDR:	CALL CLRSQV		;RESET SEQUENTIAL I/O VARIABLES
OPCLS1:	MOVEI T1,.STHDR		;OK - MOVE TO HEADER STATE
	STOR T1,TPSTAT		;...
	SETZRO FSSAV		;NO STATUS SAVED YET
	RETSKP			; AND PROCEED

;OPEN FILE PROCESSING - NOT CORRECTLY POSITIONED BECAUSE OF ABORT

OP.VLS:
OP.ABH:
OP.ABD:	CALL MTRWVL		;REWIND VOLUME
	 RETBAD ()		;ERROR
	JN USRSEQ,,OP.AB0	;USER WANT POSITION?
	MOVE T2,.H1SEQ		;NO. GET LAST GOOD SEQUENCE NUMBER
	MOVEI T3,H1LOC
	CALL GETLBL		;GET IT
	 SETZM T1		;IF ERROR. ASSUME NONE FOUND
	STOR T1,USRSEQ		;MAKE OPEN CODE DO THIS POSITIONING
OP.AB0:	SETZRO FSEQ		;UNKNOWN FILE SEQUENCE
	SETZRO TPFSEC		;AND UNKNOWN FILE SECTION
	JRST OPEN1		;PROCEED WITH OPENING
;OPEN FILE PROCESSING - CHECK/WRITE HEADERS

OP.HDR:
OPHD1B:
OPHD1C:	SETZM OPNCD		;SET NO BUMMER INITIALLY
	JN HDR1,,OPHDR2		;SKIP FOLLOWING IF WE KNOW WHERE WE ARE
	CALL HDRCHK		;READ AND CHECK HEADERS
	 JRST [	JE USRSEQ,,[TQNE <RNDF>
			CAIE T1,IOX24 ;AT EOT?
			RETBAD () ;NO. ERROR
			TQC <RNDF,WRTF> ;YES. MAKE IT WRITE
			JRST OPHD2A] ;AND PROCEED
		CAIE T1,IOX24	;YES. AT EOT THEN?
		RETBAD ()	;NO. ERROR THEN
		MOVEM T1,OPNCD	;NOT FIRST TIME NOW
		JRST .+1]	;AND PROCEED
OPHDR2:	LOAD T1,USRSEQ		;GET USER SEQ #
	JUMPE T1,OPHD2A		;IF NONE GO ON
	OPSTR <SUB T1,>,FSEQ	;COMPUTE FILES TO SKIP
	JUMPE T1,OPHD2A		;IF NONE, ALL DONE
	JUMPL T1,[CALL OPHBAK	;IF NEG, DO BACK UP
		   RETBAD ()	;ERROR
		  JRST OPHD1C]	;IF SUCCESS, RECHECK
	CALL SKPFIL		;SKIP TO PROPER PLACE
	 RETBAD ()		;SOME SORT OF ERROR
	JRST OPHD1C		;AND CHECK AGAIN
OPHD2A:	SKIPE T1,OPNCD		;DID WE MAKE IT CLEAN?
	RETBAD (,<MOVEI T2,.STCLS ;NO, SET STATE PROPERLY
		STOR T2,TPSTAT>) ;AND RETURN ERROR
	SETZRO USRSEQ		;NO LONGER A USER SEQUENCE TO WORRY ABOUT
	TQNN <WRTF>		;WRITING?
	JRST OPHDRD		;NO - READ ONLY CASE
	JRST OPHDWR		;YES - HANDLE WRITE/READ

	ENDSV.			;END STKVAR

;LOCAL ROUTINE TO POSITION BACKWARDS
;T1/	-COUNT OF FILES TO DO

OPHBAK:	SAVEAC <Q3>		;GET A WORK REG
	MOVE Q3,T1		;GET COUNT
OPHBK0:	CALL MTBSFI		;BACK UP ONE
	 RETBAD ()		;ERROR
	AOJL Q3,OPHBK0		;AND DO THEM ALL
	RETSKP			;DONE
;OPEN FOR WRITE ACCESS

OPHDWR:	JN TPEBD,,[RETBAD (OPNX13)] ;CAN'T WRITE AN EBCDIC TAPE
	TQZ <RNDF>		;NO RANDOM ACCESS IF HERE
	SETZRO TPAPP		;CLEAR APPEND FLAG
	JE TPFRMT,,[MOVEI T1,"U" ;IF NO SPECIFIED FORMAT, USE UNDEF
		LDB T2,PBYTSZ	;GEE BYTE SIZE OF OPENING
		CAIE T2,10	;8-BIT?
		CAIN T2,7	;OR ASCII?
		MOVEI T1,"D"	;YES. USE VARIABLE THEN
		CALL CHKFMT	;CHECK AND SET IT
		 NOP		;WILL WORK
		JRST .+1]	;AND PROCEED
	JE TPRSZ,,[LOAD T1,TPBSZ ;SEE IF WE HAVE A BLOCK SIZE
		 STOR T1,TPRSZ ;IN CASE
		JUMPN T1,.+1	;IF SO, DONE
		CALL GTDFRS	;GET DEFAULT RECORD SIZE
		STOR T1,TPBSZ	;USE THIS AS BLOCK SIZE
		LOAD T2,TPFRMT	;GET FORMAT
		OPSTR <SKIPE>,JSMTR ;JOB DEFAULT GIVEN?
		MOVEI T2,TPFMTU	;YES. DON'T ADJUST THEN
		CAIN T2,TPFMTD	;VARIABLE?
		CAIGE T1,^D16*2	;ENOUGH TO ADJUST?
		SKIPA		;NO
		SUBI T1,^D16+4	;YES. SO ADJUST
		STOR T1,TPRSZ	;STUFF IT
		JRST .+1]	;DONE
	LOAD T1,TPBSZ		;GET BLOCK SIZE
	SKIPN T1		;SPECIFIED?
	LOAD T1,TPRSZ		;NO. ASSUME NOT BLOCKED THEN
	STOR T1,TPBSZ		;STORE NEW VALUE
	MOVX T2,SC%WHL!SC%OPR	;SEE IF WHOPER
	TDNE T2,CAPENB		;IS IT?
	JRST OPHDW3		;YES. ALLOW ACCESS THEN
;CHECK ACCESS BASED UPON ACCESSIBILITY AND PROTECTION FIELDS IN LABELS

	JE HDR1,,[MOVSI T1,DP%CF ;NOT OVERWRITING AN OLD FILE
		CALL DOACC	;LEGAL TO ADD A FILE TO THIS FILESET?
		 RETBAD ()	;NO
		JRST OPHDW3]	;YES, PROCEED
	MOVE T1,[DP%CN,,FP%WR]	;OVERWRITING OLD FILE
	CALL DOACC		;DO ACCESS CHECKING
	 RETBAD ()		;CAN'T HAVE IT

;CHECK IF LEGAL TO OVERWRITE OLD FILE BASED ON EXPIRATION DATE

	MOVE T2,.H1EXP		;GET EXPIRATION D/T
	MOVEI T3,H1LOC		;FROM HDR1
	CALL GETLBL		;...
	 RET			;FIELD ERROR
	MOVE T2,T1		;SAVE DATE
	GTAD			;GET CURRENT DATE AND TIME
	LSH T1,-1		;LOSE 1/3 SEC, BUT GET POS NUMBER
	LSH T2,-1		;""
	CAMGE T1,T2		;EXPIRED?
	MTERET (IOX26)		;NO - RETURN ERROR

;Checks for write access completed for now.  [8858] Set tape file section one,
;and enter common file open code.

OPHDW3:	MOVEI T1,1		;[8858] Since we are opening for write
	STOR T1,TPFSEC		;[8858]  then set file section one
;	JRST OPHDON		;DONE FOR NOW
;HERE WHEN FILE HAS BEEN OPENED

OPHDON:	UCALL MTAOPN		;OPEN UP THE TAPE
	 MTERET()		;FAILURE
	CALL SETDNS		;SET MT DENSITY
	LOAD T1,TPFRMT		;GET FORMAT CODE
	CALL SETFMT		;SET FORMAT AND BUFFERS
	 JRST [	MOVEM T1,LSTERR	;SAVE ERROR CODE
		MOVX T1,CZ%ABT
		UCALL MTACLZ	;RELEASE THE MTA
		 NOP
		MOVE T1,LSTERR
		RETBAD ()]	;GIVE ERROR
	MOVEI T1,.STUHL		;MOVE TO USER HEADER STATE
	STOR T1,TPSTAT
	SETZRO <TPLCT,TPNUL>	;NO USER LABELS WRITTEN YET
	JRST OPEN1		;CONTINUE PROCESSING


;OPEN PROCESSING - USER HEADER STATE OR READY

OP.RDY:
OP.UHL:	RETSKP			;JUST SKIP RETURN

;EOT SEEN WHILE WRITING HEADERS

OPNEOT:	TXNN IOS,MT%EOT		;IS IT REALLY?
	RETBAD(IOX5)		;NO. ERROR THEN
	CALL CLREOF		;CLEAR IT
	SETONE SNEOT		; AND REMEMBER
	RETSKP			;CONTINUE
;ROUTINE TO SET MTA DENSTIY WHENEVER THE MTA IS OPENED.
;CALLED FROM OPEN, MTLFCN, AND VVBLOK CODE.

SETDNS:	LOAD T1,TPDNS		;GET DENSITY OF TAPE
	MCALL MTADNS		;SET IT
	 NOP			;CAN'T FAIL
	RET			;AND DONE
;ROUTINE TO WRITE NEW FILE HEADERS FOR FILE OPENED FOR WRITE

WRODON:	JN TPLCT,,RSKP		;IF ALREADY DID THIS, JUST RETURN
	SETONE TPLCT		;NOTE WE WERE HERE ONCE
	JN TPAPP,,RSKP		;IF APPENDING, DON'T DO ANYTHING ELSE
	CALL REPOS		;REPOSITION TO START OF LAEL SET
	 RETBAD ()		;ERROR
	MOVEI T1,.HDR1		;LABEL TYPE
	CALL MAKLBL
	 MTERET ()
	SETONE HDR1
	MOVEI T1,H1LOC		;NOW GET LABEL
	CALL FETLBL
	MOVEI T2,.LBFWR		;WRITE FUNCTION
	CALL MTLFCN		;WRITE IT
	 JRST [	CALL OPNEOT	;CHECK FOR EOT
		 MTERET()	;NOT. SOME SORT OF ERROR
		JRST .+1]	;WAS. PROCEED
	MOVEI T1,.HDR2		;2ND HEADER TYPE
	CALL MAKLBL
	 MTERET ()
	SETONE HDR2
	MOVEI T1,H2LOC		;GET HDR2 INTO BUFFER
	CALL FETLBL
	MOVEI T2,.LBFWR
	CALL MTLFCN		;WRITE IT ALSO
	 JRST [	CALLRET OPNEOT]	;CHECK FOR EOT
	RETSKP			;DONE SUCCESSFULLY
;OPEN FOR READ ONLY ACCESS

OPHDRD:	SETZRO TPNBL		;INIT NEW BLOCK INDICATOR
	MOVE T1,[DP%RD,,FP%RD]	;REQUEST READ-ACCESS CHECK
	TQNE <RNDF>		;WANT APPEND?
	MOVE T1,[DP%CN,,FP%APP]	;YES, REQUEST APPEND-ACCESS CHECK
	CALL DOACC		;DO ACCESS CHECKING
	 RETBAD ()		;CAN'T
	JE HDR2,,[MOVEI T1,"F"	;IF NO HDR2, ASSUME FIXED
		CALL CHKFMT	;CHECK AND SET FORMAT CODE
		 NOP		;WILL WORK
		CALL GTDFRS	;GET DEFAULT RECORD SIZE
		STOR T1,TPRSZ	;AND SET IT UP
		STOR T1,TPBSZ	;SAVE BLOCK SIZE AS WELL
		JRST OPHRD3]	;AND PROCEED
	MOVE T2,.H2RLN		;GET RECORD LENGTH
	MOVEI T3,H2LOC		; FROM HDR2
	CALL GETLBL		;GET NUMBER IN T1
	 RETBAD ()
	STOR T1,TPRSZ		;STORE RECORD SIZE
	MOVE T2,.H2BLN		;READ BLOCK LENGTH
	MOVEI T3,H2LOC		;FROM HDR2
	CALL GETLBL		;GET IT
	 RETBAD ()
	MOVE T2,T1		;SAVE BLOCK SIZE
	CALL GTDFRS		;GET DEFAULT RECORD SIZE
	CAIGE T1,0(T2)		;TAKE MAX OF THE TWO
	MOVEI T1,0(T2)		;"
	STOR T1,TPBSZ		;SAVE BLOCK SIZE
	MOVE T2,.H2FMT		;GET FORMAT CHARACTER
	MOVEI T3,H2LOC		; FROM HDR2
	SETZM T1		;PUT IT IN T1
	CALL GETLBL		;GET CHARACTER R-JUST IN T1
	 RETBAD ()
	CALL CHKFMT		;CHECK AND SET FORMAT CODE
	 RETBAD ()
OPHRD3:	TQNE <RNDF>		;WANT APPEND REALLY?
	JRST OPAPND		;YES. GO DO IT THEN
	JN TPUED,,OPHDON	;IF "NO TRANSLATE", SKIP REST
	CALL GETFC0		;NO. GET FORM BYTE
	 RETBAD()		;ERROR
	CAIN T1,.TPFNC		;ANY CONTROLS PRESENT?
	TQO <ACRLFF>		;NO. INDICATE CR-LF NEEDED FROM ON HIGH
	JRST OPHDON		;DONE
;APPEND ACCESS DESIRED. POSITION TO EOF AND ALLOW IT TO GO

OPAPND:	JN TPEBD,,[RETBAD (OPNX13)] ;CAN'T WRITE AND EBCDIC TAPE
	TQC <RNDF,WRTF>		;SAY WRITING
	SETONE TPAPP		;SAY OPENED FOR APPEND
	JRST OPHDON		;AND DONE

;UTILITY TO COMPUTE DEFAULT RECORD SIZE.

GTDFRS:	LOAD T1,JSMTR		;GET JOB DEFAULT
	SKIPG T1		;ANY SET?
	MOVEI T1,MTDFRS		;NO. USE SYSTEM DEFAULT
	RET			;AND DONE
;ROUTINE CALLED FROM OPEN CODE TO PROCESS ATTRIBUTES

DOATTR:	SAVEAC <P3>		;GET A WORK REG
	SETZRO <TPEXPD>		;ASSUME NOT GIVEN
	SETZRO <TPFRMT,USRSEQ>	;SAME HERE
	SETZRO <TPRSZ,TPBSZ>	;AND HERE AS WELL
	MOVE T2,FILMTP(JFN)	;GET PROTECTION
	STOR T2,TPPRO		;MOVE IT TO PROTECTION
	LOAD P3,FLATL,(JFN)	;GET LIST OF ATTRIBUTES
DOATT0:	JUMPE P3,R		;IF AT THE END OF THE LIST, DONE
	LOAD T2,PRFXV,(P3)	;GET PREFIX VALUE
	SETZM T3		;START AT BEGINNING OF TABLE
DOATT1:	HLRZ T4,ATRTBL(T3)	;GET THIS VALUE
	CAIE T2,0(T4)		;FOUND IT YET?
	AOJA T3,DOATT1		;NO. KEEP GOING
	MOVE T1,P3		;SET UP POINTER TO VALUE
	CALL @DOATBL(T3)	;DO LOCAL PROCESSING
	LOAD P3,PRFXL,(P3)	;GET NEXT ATTRIBUTE
	JRST DOATT0		;DO THEM ALL

;TABLE

DOATBL:	IFIW!DOFMT
	IFIW!DOEXP
	IFIW!DOBLK
	IFIW!DORLN
	IFIW!DOPOS
   IFN <.-DOATBL-ATTLEN>,<PRINTX ?DOATT AND ATRTBL MISMATCH>
;ACTION ROUTINES FOR ATTRUBUTE PROCESSING

;PROCESS FORMAT

DOFMT:	LDB T1,[POINT 7,1(T1),6] ;GET CODE
	CALL CHKFMT		;CHECK IT
	 NOP
	RET			;DONE

;PROCESS EXP DATE

DOEXP:	CALL EXPCOD		;DO IT
	 NOP
	STOR T2,TPEXPD		;STORE IT
	RET			;AND DONE

;PROCESS RECORD LENGTH

DORLN:	CALL RLNCOD		;DO IT
	 NOP
	STOR T2,TPRSZ		;STORE VALUE
	RET

;PROCESS BLOCK LENGTH

DOBLK:	CALL BLKCOD		;DO IT
	 NOP
	STOR T2,TPBSZ		;STORE VALUE
	RET			;DONE

;PROCESS POSITION

DOPOS:	CALL POSCOD		;DO IT
	 NOP
	STOR T2,USRSEQ		;STORE IT
	RET			;AND DONE
;ROUTINE TO CHECK FOR ACCESS VIA GIVOK/GETOK
;HERE BECAUSE ACCESS CODE IS UNKNOWN FOR THIS TYPE OF VOLUME.
;THE GIVOK/GETOK POLICY PROGRAM IS REQUESTED TO VERIFY ACCESS
;	T1/ ACCESS IN HDR1
;	T2/ ACCESS DESIRED
;RETURNS:	+1 NO ACCESS
;		+2 ACCESS ALLOWED

ACCROU:	MOVE T4,JOBNO		;GET JOB NUMBER
	MOVE T4,JOBDIR(T4)	;GET LOGGED IN USER
	TLO T4,USRLH		;MAKE IT A USER NUMBER
	MOVEI T3,.LTANS		;ASSUME ASCII TAPE
	OPSTR <SKIPE>,TPT20	;IS IT TOPS20?
	MOVEI T3,.LTT20		;YES
	OPSTR <SKIPE>,TPEBD	;IS IT EBCDIC?
	MOVEI T3,.LTEBC		;YES
	GTOKM (.GOMTA,<T1,T4,U,T2,T3>,[RETBAD ()],ACCTST)
	RETSKP			;AND SUCCESS

;SPECIAL SCHEDULER TEST USED BY ACCROU
;GET TO HERE FROM GETOKM IN JSYSA.
;	T1/SCHEDULER TEST WORD
;ALL P'S INTACT

ACCTST:	SAVET			;SAVE ALL TEMPS
	SAVEAC <U>		;SAVE THIS AS WELL
	HLRZ U,DEV		;GET MT UNIT NUMBER
	CALLRET MTFCNC		;GO WAIT
;DOACC - CHECK FILE ACCESS BASED ON ACCESSIBILITY CHARACTERS IN
;	 VOL1 AND HDR1 LABELS (AND PROTECTION CODES IF TOPS-20)
;  T1/	LH - REQUESTED VOLUME ACCESS (DP%XXX)
;	RH - REQUESTED FILE ACCESS (FP%XXX)
;	     OR 0 TO CHECK ONLY VOLUME-ACCESS
;RETURNS +1: FAILED, T1/ ERROR CODE
;	 +2: SUCCESS

DOACC:	STKVAR <REQACC,FILACS>
	MOVEM T1,REQACC		;SAVE REQUESTED ACCESS CODES
	MOVX T2,SC%WHL+SC%OPR
	TDNE T2,CAPENB		;ENABLED?
	RETSKP			;YES, NO RESTRICTIONS

;GET ACCESSIBILITY CHARACTERS FROM VOL1, HDR1

	SETZ T1,		;RETURN CHARACTER IN T1
	MOVE T2,.H1ACC		;WANT FILE ACCESSIBILITY FIELD
	MOVEI T3,H1LOC		;WHERE LABEL IS
	CALL GETLBL		;GET CHARACTER
	 RETBAD ()		;ERROR
	MOVEM T1,FILACS		;SAVE FILE ACCESSIBILITY CHARACTER
	SETZ T1,
	MOVE T2,.V1ACC		;VOLUME ACCESSIBILITY FIELD
	MOVEI T3,V1LOC		;WHERE VOL1 IS
	CALL GETLBL		;GET CHARACTER
	 RETBAD ()		;ERROR
	MOVE T2,FILACS		;GET FILE ACCESSIBILITY CHARACTER
	MOVE T3,REQACC		;GET CALLER'S INPUT
;T1/ VOLUME ACCESSIBILTY CHARACTER
;T2,FILACS/ FILE ACCESSIBILITY CHARACTER
;T3,REQACC/ REQUESTED VOLUME ACCESS ,, REQUESTED FILE ACCESS
;NOW DISPATCH ACCORDING TO LABEL TYPE

	JN TPT20,,ACCT20	;TOPS-20 LABELS
	JN TPEBD,,ACCEBD	;EBCDIC LABELS
;ANSI LABELS

	TRNN T3,-1		;CHECKING VOLUME ACCESS ONLY?
	MOVEI T2,.ACFUL		;YES, FUDGE IT SO TEST SUCCEEDS
	CAIN T1,.ACFUL		;FULL ACCESS TO VOLUME
	CAIE T2,.ACFUL		; AND FILE?
	JRST ACPOLP		;NO, CHECK WITH POLICY PROGRAM
	RETSKP			;YES, SUCCEED

;EBCDIC LABELS

ACCEBD:	TRNE T3,-1		;SUCCEED IF CHECKING VOLUME ACCESS ONLY
	CAIN T2,"0"		;FILE UNPROTECTED?
	RETSKP			;YES, EVERYTHING OK
	CAIE T2,"1"		;RACF PASSWORD PROTECTION?
	CAIN T2,"3"		;...
	SKIPA			;YES, CONTINUE
	RETSKP			;NON-RACF PROTECTED, NO ACJ CHECK
	CAIN T2,"3"		;READ ACCESS ALLOWED
	TRNE T3,FP%WR+FP%APP	; AND NOT WRITING?
ACPOLP:	JRST [	MOVE T1,FILACS	;T1/ FILE ACCESSIBILITY CHARACTER
		HRRZ T2,REQACC	;T2/ REQUESTED ACCESS (FP%XXX)
		CALLRET ACCROU]	;DEFER DECISION TO POLICY PROGRAM
	RETSKP			;YES, NO PROBLEM HERE
;TOPS-20 LABELS
;FIRST, CHECK IF THE USER OWNS THE TAPE

ACCT20:	CALL PRSUSR		;GET OWNER'S USER # IN T1
	 SETZ T1,		;OWNER DOESN'T EXIST ON THIS SYSTEM
	MOVE T2,JOBNO		;GET JOB #
	MOVE T2,JOBDIR(T2)	;GET LOGGED-IN DIR #
	HRLI T2,USRLH		;FORM USER # IN T2
	CAMN T1,T2		;IS THE USER THE OWNER OF THE TAPE?
	RETSKP			;YES, NO ACCESS RESTRICTIONS

;ACCESS BY NON-OWNER, CHECK VOLUME PROTECTION CODE

	MOVE T2,.UVPRT		;WANT VOLUME PROTECTION FIELD
	MOVEI T3,UVLOC		;IN VOL2 LABEL
	CALL GETLBL		;GET VOLUME PROTECTION IN T1
	 RETBAD ()
	HLRZ T2,REQACC		;GET REQUESTED VOLUME ACCESS
	TDNN T1,T2		;ACCESS PERMITTED?
	JRST [ MOVE T1,FILACS	;GET FILE ACCESSABILITY CHARACTER
		CALL ACCROU	;GET ACJ RESPONSE
		 RETBAD (GJFX35) ;NO FROM ACJ
		 RETSKP]	;ACJ APPROVES
	HRRZ T1,REQACC		;WANT FILE ACCESS CHECK?
	JUMPE T1,RSKP		;NO, SUCCEED

;CHECK FILE ACCESSIBILITY CHARACTER

	MOVE T1,FILACS		;GET FILE ACCESSIBILITY CHARACTER
	CAIN T1,.ACFUL		;FULL ACCESS?
	RETSKP			;YES
	CAIE T1,.DOMAC		;ACCESS GOVERNED BY PROTECTION CODE?
	JRST T20FL		;NO, REJECT

;CHECK FILE PROTECTION CODE

	MOVE T2,.H2PRT		;WANT FILE PROTECTION CODE
	MOVEI T3,H2LOC		;WHERE IT IS
	CALL GETLBL		;GET CODE IN T1
	 RETBAD ()
	HRRZ T2,REQACC		;GET REQUESTED FILE ACCESS
	TDNE T1,T2		;ACCESS PERMITTED?
	RETSKP			;YES
;FILE ACCESS DENIED BASED ON PROTECTION CODE OR FILE ACCESSIBILITY CHAR

T20FL:	HRRZ T2,REQACC		;GET REQUESTED ACCESS (FP%XXX)
	MOVEI T1,OPNX12		;LIST ACCESS REQUIRED IF NO OTHER REASON
	TRNE T2,FP%RD
	MOVEI T1,OPNX3		;READ ACCESS REQUIRED
	TRNE T2,FP%WR
	MOVEI T1,OPNX4		;WRITE ACCESS REQUIRED
	TRNE T2,FP%APP
	MOVEI T1,OPNX6		;APPEND ACCESS REQUIRED
	RETBAD ()		;RETURN ERROR

	ENDSV.			;END STKVAR
;PRSUSR - GET USER NUMBER CORRESPONDING TO OWNER NAME IN VOL2 LABEL
;RETURNS +1: NO SUCH USER NAME
;	 +2: SUCCESS, T1/ USER NUMBER

PRSUSR:	STKVAR <<USRSTG,10>>
	HRROI T1,USRSTG		;GET ADDRESS OF STRING
	MOVE T2,.UVNAM		;WANT OWNER NAME STRING
	MOVEI T3,UVLOC		;IN VOL2 LABEL
	CALL GETLBL		;GET OWNER NAME
	 RETBAD ()
	MOVEI T2,USRSTG
	HRLI T2,(POINT 7)	;MAKE BYTE POINTER TO OWNER NAME
	MOVEI T3,^D39		;MAX SIZE OF A USER NAME
PRSUS0:	ILDB T1,T2		;GET A BYTE
	JUMPE T1,PRSUS1		;IF NULL, DONE
	CAIN T1,"V"-100		;QUOTING BYTE?
	JRST [	ILDB T1,T2	;YES. SKIP NEXT BYTE THEN
		SOJA T3,PRSUS2]	;AND PROCEED
	CAIN T1," "		;A BLANK?
	JRST [	SETZM T1	;YES. GET A NULL
		DPB T1,T2	;AND TIE OFF STRING
		JRST PRSUS1]	;AND DONE
PRSUS2:	SOJG T3,PRSUS0		;DO ENTIRE STRING
PRSUS1:	MOVX T1,RC%EMO
	HRROI T2,USRSTG		;GET POINTER TO USER NAME STRING
	RCUSR			;GET OWNER NUMBER
	 ERJMP R		;NO MATCH. ERROR THEN
	TXNE T1,RC%NOM!RC%AMB	;EXACT MATCH?
	RET			;NO.
	MOVE T1,T3		;COPY NUMBER
	RETSKP			;AND DONE

	ENDSV.			;END STKVAR
; CLRSQV -- CLEAR SEQUENTIAL I/O VARIABLES

CLRSQV:	SETONE TPBEGF		;NOW AT BEGINNING OF RECORD
	SETZM TPFLNX(U)		;NO BYTES EXPECTED IN NEXT RECORD
	SETZM FILLEN(JFN)	;NO RECORD SETUP
CLRSQ0:	SETZM FILCNT(JFN)	;NO BYTES AVAILABLE
	SETZM FILBYN(JFN)	;NO BYTES IN RECORD
CLRSQ1:	SETZM TPFCNT(U)		;NO MAGTAP'S BYTES AVAILABLE
	SETZM TPFLEN(U)		;NO MAGTAP'S RECORD SETUP
	SETZM TPFBYN(U)		;NO MAGTAP'S BYTES IN RECORD
	RET			;RETURN FROM CLRSQV
;LABEL MAKING ROUTINES

;CALL MAKLBL WITH C(T1) := ADDRS OF PARAMETER TABLE FOR LABEL

MAKLBL:	ASUBR <VAL,DESC,BFR,PNTR>
	SAVEQ			;SAVE Q1-Q3
	HLL T1,0(T1)		;FORM AOBJN PNTR
	MOVE Q3,T1		;SAVE IN Q3
	HRRZ IOS,0(T1)		;BUFFER OFFSET ARG
	MOVEM IOS,BFR		; SAVE BFR PNTR
	CALL SPACES		;PREFILL WITH SPACES
	JRST MAKNXT		;START PROCESSING FIELDS

MAKLUP:	MOVE T2,0(Q3)		;GET FIELD DESCRIPTOR
	MOVEM T2,DESC		;SAVE
	MOVEM IOS,BFR		;RESET BFR PNTR
	CALL MAKEBP		;FORM BP TO FIELD (IN PNTR)
	LOAD T1,FLDDAT,DESC	;ROUTINE ADDRS FOR FIELD DATA
	LOAD T2,FLDFLG,DESC	;GET FLAGS
	TRNE T2,FF%IMM		;IMMEDIATE VALUE?
	JRST [	LOAD T3,FLDTYP,DESC ;GET TYPE
		CAIN T3,.FTSTR	;STRING?
		TLO T1,-1	;YES - FORM PNTR
		JRST MAKLP1]
	TXO T1,IFIW		;STAY IN CURRENT SECTION
	CALL @T1		;FETCH DATA TO T1
MAKLP1:	MOVEM T1,VAL		;SAVE AS VALUE
	LOAD T4,FLDLEN,DESC	;GET LENGTH TO T4
	LOAD T2,FLDTYP,DESC	;DISPATCH ON FIELD TYPE
	CAILE T2,.FTMAX
	JRST ILLTYP		;ILLEGAL TYPE FIELD
	CALL @[	IFIW!MAKSTR	;STRING
		IFIW!MAKNUM	;DECIMAL NUMBER
		IFIW!MAKDAT	;DATE
		IFIW!MAKSPC	;SPACES
		IFIW!MAKOCT](T2) ;OCTAL NUMBER
	 RETBAD (IOX17)
MAKNXT:	AOBJN Q3,MAKLUP		;LOOP OVER ALL FIELDS
	RETSKP			;RETURN

;FILL FIELD WITH SPACES

MAKSPC:	MOVEI T2," "		;SPACE
	IDPB T2,PNTR		;STORE CHAR
	SOJG T4,.-1
	RETSKP			;RETURN
;ROUTINE TO FILL LABEL FIELD WITH STRING
;C(T1) := STRING PNTR , C(T4) := LENGTH

MAKSTR:	MOVE T1,VAL		;GET STRING PNTR
	TLNN T1,-1		;LEFT-HALF ALL ZERO?
	JRST [	HRLI T1,(<POINT 7,0,35>) ;YES. IS JSB STRING POINTER
		JRST MAKST1]	;PROCEED
	TLC T1,-1		;CHECK FOR SPECIAL
	TLCN T1,-1		; STRING POINTER
	HRLI T1,(POINT 7,,)	;CONVERT IF NECESSARY
MAKST1:	ILDB T3,T1		;FETCH CHAR
	JUMPE T3,[CALL CKSTRG	;CHECK IF STRING MUST BE RELEASED
		CALLRET MAKSPC]	;AND PAD
	CALL ASCEBC		;SEE IF CONVERSION NEEDED
	IDPB T3,PNTR		;PUT CHAR
	SOJG T4,MAKST1		;LOOP
	CALL CKSTRG		;CHECK IF STRING MUST BE RELEASED
	RETSKP			;GOOD RETURN (MAY TRUNCATE)

;ROUTINE TO FILL FIELD WITH DECIMAL NUMBER

MAKNUM:	MOVE T2,VAL		;GET VALUE INTO T2
	MOVE T1,PNTR		;SETUP POINTER
	CALL PNOUTD		;DECIMAL NUMBER W/ LEADING ZEROS
	RETSKP			;GOOD RETURN

;ROUTINE TO FILL FIELD WITH OCTAL NUMBER

MAKOCT:	MOVE T2,VAL		;GET VALUE INTO T2
	MOVE T1,PNTR		;SETUP POINTER
	CALL PNOUTO		;OCTAL NUMBER W/ LEADING ZEROS
	RETSKP			;GOOD RETURN

;ROUTINE TO PUT DATE IN LABEL FIELD

MAKDAT:	MOVEI T1," "		;NEED LEADING SPACE
	IDPB T1,PNTR		;...
	MOVE T2,VAL		;GET DATE VALUE
	MOVX T4,IC%JUD		;CONVERT TO JULIAN
	ODCNV
	MOVE T1,PNTR		;PICK UP POINTER
	MOVEM T2,VAL		;SAVE DAY-OF-YEAR
	HLRZS T2		;GET YEAR
	SUBI T2,^D1900		;NORMALIZE TO 20TH CENTURY
	MOVEI T4,2		;2 CHARACTERS
	CALL PNOUTD		; OUTPUT NUMBER
	HRRZ T2,VAL		;GET DAY
	MOVEI T4,3		;3 CHARS
	CALL PNOUTD		;OUTPUT IT (PNTR IN T1)
	RETSKP			;OK - RETURN
;LOCAL ROUTINE OF MAKSTR TO SEE IF STRING IDENTIFED BY
;VAL MUST BE RELEASED

CKSTRG:	SAVET			;SAVE ALL TEMPS
	MOVE T2,VAL		;GET VAL
	MOVEI T1,JSBFRE		;THE POOL NAME
	TLNN T2,-1		;IS IT PART OF THE POOL?
	CALL RELFRE		;YES. RELEASE IT THEN
	RET			;AND DONE
;ROUTINE TO PRE-FILL LABEL RECORD WITH SPACES

SPACES:	MOVE T1,BFR		;GET BUFFER ADDRS
	JUMPGE T1,[LOAD T2,TPLBLS ;OFFSET INTO LABEL STG
		   ADD T2,T1
		   JRST SPAC1]
	LOAD T2,TPIOB		;GET START OF I/O BUFFER
SPAC1:	MOVE T1,[BYTE (8)40,40,40,40]
	MOVEM T1,0(T2)		;FILL FIRST WORD
	HRLZ T1,T2		;FORM FROM,,TO
	HRRI T1,1(T2)
	BLT T1,.LBLEN-1(T2)	;PROPAGATE
	RET			;RETURN

;ROUTINES TO PUT A NUMBER WITH LEADING ZERO FILL INTO A FIELD
;PNOUTD FOR BASE 10, PNOUTO FOR BASE 8
;C(T1) := POINTER
;C(T2) := NUMBER
;C(T4) := LENGTH

PNOUTD:	SKIPA T3,[12]		;BASE 10
PNOUTO:	MOVEI T3,10		;BASE 8
	TRVAR <PNARG>
	MOVEM T3,PNARG		;SAVE RADIX
PNOUT:	SKIPN T2		;DONE ON ZERO
	TDZA T3,T3		;SUPPLY A 0
	IDIV T2,PNARG		;DIVIDE BY RADIX
	PUSH P,T3		;SAVE REMAINDER
	SOJLE T4,PNOUT1		;DECR COUNT
	CALL PNOUT		;RECURSE
PNOUT1:	POP P,T3		;GET BACK DIGIT
	ADDI T3,"0"		;CONVERT TO ASCII
	CALL ASCEBC		;CHECK FOR CONVERSION TO EBCDIC
	IDPB T3,T1		;STORE CHAR
	RET			;RETURN

;LOCAL ROUTINE OF MAKLBL TO CONVERT TO EBCDIC CHARACTER IF NECESSARY

ASCEBC:	JE TPEBD,,R		;IF NOT EBCDIC DONE

;**********************************
;	CONVERT C(T3) TO EBCDIC HERE
;***********************************
	RET			;DONE FOR NOW
;ROUTINE TO SETUP A SPECIFIED LABEL FIELD
;C(T1) := VALUE
;C(T2) := DESCRIPTIO
;C(T3) := BUFFER PNTR

SETLB:	ASUBR <VAL,DESC,BFR,PNTR>
	CALL MAKEBP		;SETUP PNTR
	LOAD T4,FLDLEN,DESC	;GET LENGTH
	LOAD T2,FLDTYP,DESC	;DISPATCH ON TYPE CODE
	CAIG T2,.FTMAX
	CALL @[	IFIW!MAKSTR	;STRING
		IFIW!MAKNUM	;DECIMAL NUMBER
		IFIW!MAKDAT	;DATE
		IFIW!MAKSPC	;SPACES
		IFIW!MAKOCT](T2) ;OCTAL NUMBER
	JRST ILLTYP		;ILLEGAL TYPE CODE
	RET
;PARAMETER SETUP ROUTINES

;ROUTINE TO RETURN TAPE BLOCK SIZE

GTBLEN:	LOAD T1,TPBSZ		;GET USER SPECIFIED SIZE
	JUMPE T1,GTDFRC		;USE DEFAULT IF ZERO
	RET			;RETURN

;RETURN FILE RECORD SIZE

GTRLEN:	LOAD T1,TPFRMT		;GET TAPE FORMAT
	CAIE T1,TPFSYD		;SYSTEM DEFAULT
	CAIN T1,TPFMTU		;OR UNDEFINED?
	JRST RFALSE		;YES. RETURN A ZERO THEN
	LOAD T1,TPRSZ		;GET USER SPECIFIED SIZE
	JUMPN T1,R		;RETURN IF NON-ZERO
GTDFRC:	CALLRET GTDFRS		;GET DEFAULT RECORD SIZE

;RETURN RECORD FORMAT INFO

GTRFMT:	LOAD T1,TPFRMT		;GET FORMAT CODE
	HRROI T1,FMTTAB(T1)	;MAKE STRING PNTR
	RET

FMTTAB:	PHASE 0
TPFSYD:!ASCIZ "U"		;0 - DEFAULT (UNDEFINED)
TPFMTF:!ASCIZ "F"		;1 - FIXED
TPFMTD:!ASCIZ "D"		;2 - VARIABLE
TPFMTS:!ASCIZ "S"		;3 - SPANNED
TPFMTU:!ASCIZ "U"		;4 - UNDEFINED
	DEPHASE

;RETURN CREATION/EXPIRATION DATE

GTXDAT:	LOAD T1,TPEXPD		;GET EXP DATE
	SKIPN T1		;ANY DEFINED?
GTCDAT:	SETO T1,		;NO - SUPPLY TODAY
	RET

;RETURN FILE ACCESS CHARACTER

GTFACC:	HRROI T1,[ASCIZ /1/]	;ASSUME DOMESTIC ACCESS
	OPSTR <SKIPN>,TPPRO	;WANT ANY?
	HRROI T1,[ASCIZ / /]	;YES
	RET			;DONE

;RETURN FILE PROTECTION

GTVPRT:				;DEFAULT VOLUME PROTECTION
GTFPRT:	LOAD T1,TPPRO		;RETURN PROTECTION
	RET
;RETURN FILE NAME FROM GTJFN OR GENERATE ONE

GTFNAM:	STKVAR <SVPNT>		;SAVE POINTER HERE
	MOVEI T2,5		;MAX NUMBER OF WORDS NEEDED
	CALL ASGJFR		;GET SOME SPACE
	 RETBAD ()		;BADNESS
	MOVEM T1,SVPNT		;SAVE IT
	HRLI T1,<(POINT 7,0,35)> ;BUILD BP
	HLRZ T2,FILNEN(JFN)	;POINTER TO NAME STRING
	MOVE T2,1(T2)		;GET NAME
	TXNE T2,177B6		;NULL?
	JRST BLDNAM		;NO. GO BUILD REAL FILE SPEC THEN
	CALL VOLID2		;RETURN VOLID PNTR IN T2
	MOVEI T4,6		;MAX SIZE
GTFNM1:	ILDB T3,T2		;GET CHAR (8-BIT)
	CAIN T3," "		;DONE ON SPACE
	JRST GTFNM2
	IDPB T3,T1		;COPY TO STRING (7-BIT)
	SOJG T4,GTFNM1		;DO 6
GTFNM2:	HRROI T2,[ASCIZ "-FILE-"]
	SETZ T3,
	SOUT			;APPEND TO VOLID
	LOAD T2,FSEQ		;GET SEQUENCE NUMBER
	MOVEI T4,4		;4 CHARS
	CALL PNOUTD		;APPEND SEQ #
	MOVE T1,SVPNT		;GET SPECIAL POINTER
	RET

;ROUTINE TO GET VOLID PNTR INTO T2 (PRESERVES T1)

VOLID2:	LOAD T2,TPLBLS		;LABEL BUFFER
	HRLI T2,(<POINT 8,0,31>) ;POINT TO VOLID IN VOL1
	RET			;RETURN

;GTFNAM CONTINUED
;HERE IF WE HAVE A NON-NULL NAME. BUILD NAME.EXE FOR THE HEADER

BLDNAM:	HLRZ T2,FILNEN(JFN)	;GET NAME STRING
	CALL CPYIT		;COPY IT
	HRRZ T2,FILNEN(JFN)	;GET EXT BLOCK
	MOVX T3,177B6		;CHECK IF NULL
	TDNN T3,1(T2)		;IS IT?
	JRST BLDNA0		;YES. DON'T PUT IN . THEN
	MOVEI T3,"."		;PUT IN SEPARATOR
	IDPB T3,T1		;PUT IT IN
	CALL CPYIT
BLDNA0:	SETZM T2
	IDPB T2,T1		;TIE IT OFF
	MOVE T1,SVPNT		;GET POINTER
	RET			;AND DONE

;LOCAL COPY ROUTINE
;	T2/ JSB BLOCK ADDRESS

CPYIT:	HRRZ T3,0(T2)		;GET # OF WORDS IN BLOCK
	SUBI T3,1		;DISCOUNT HEADER
	IMULI T3,5		;GET NAX BYTES
	HRLI T2,(<POINT 7,0,35>) ;GET A BP
CPYIT0:	ILDB T4,T2		;GET NEXT BYTE
	JUMPE T4,R		;IF A NULL, ALL DONE
	IDPB T4,T1		;STASH IT
	SOJG T3,CPYIT0		;DO ALL OF STRING
	RET			;DONE

;RETURN FORMAT CONTROL BYTE

GETMOD:	LOAD T1,TPMOD		;GET MODE
	HRROI T1,MODTBL(T1)	;GET BYTE
	RET			;AND DONE

;TABLE OF MODE VALUES

MODTBL:	ASCIZ /X/
	ASCIZ /M/
	ASCIZ /A/
	ASCIZ / /

	ENDSV.			;END STKVAR
;RETURN FILE SEQUENCE #

GTFSEQ:	LOAD T1,FSEQ		;CURRENT FILE POS
	RET

;RETURN VOLUME ID

GTVLID:	JN TPFSN,,GTFSN		;IF HAVE A VOL SET NAME, USE IT
	CALL VOLID2		;PNTR TO T2
	MOVE T1,T2		;RETURN IN T1
	RET

;RETURN POINTER TO USER NAME STRING

GTUSER:	HRROI T1,USRNAM+1	;ACTUAL TEXT BEGINNING
	RET


;RETURN FILE GENERATION #

GTFGEN:	HRRZ T1,FILVER(JFN)	;FILE GENERATION #
	IDIVI T1,^D100		;GET EXCESS OVER 100
	SKIPE T2		;[7.1064] Unless the ver is a multiple of 100
	ADDI T1,1		;ADD ONE TO CONFORM TO DEC STD
	RET

;[7.1064] Return file generation version
;Returns: +1, T1/ Generation version 

GTFGVR:	HRRZ T1,FILVER(JFN)	;[7.1064] Get the file's version number
	IDIVI T1,^D100		;[7.1064] Get the least significant two digits
	SKIPN T2		;[7.1064] Was generation multiple of 100?
	SKIPA T1,[^D99]		;[7.1064] Yes, GNV should be 99
	MOVEI T1,-1(T2)		;[7.1064] GNV should be remainder-1
	RET			;[7.1064] Return T1/ GNV

;RETURN FILE SECTION NUMBER

GTFSEC:	LOAD T1,TPFSEC		;RETURN IN T1
	JUMPN T1,R		;IF HAVE ONE, DONE
	AOJA T1,R		;IF NOT, MAKE IT ONE

;RETURN FILE BYTE SIZE

GTFBSZ:	LDB T1,PBYTSZ		;IN FILBYT
	RET
;ROUTINE TO FETCH VOL SET NAME FOR MAKE LABEL CODE.

GTFSN:	STKVAR <SVPNT>		;PLACE TO SAVE JSB FREE SPACE
	MOVEI T2,3		;GET NEEDED SPACE
	CALL ASGJFR		;GET IT
	 RETBAD ()		;NONE TO BE HAD
	MOVEM T1,SVPNT		;SAVE IT
	MOVEI T2,1(T1)		;GET ADDRESS WHERE DATA GOES
	LOAD T1,TPFSN		;GET VOL SET NAME
	CALL SIXASC		;MAKE IT ASCII
	MOVE T1,SVPNT		;GET POINTER
	RET			;AND DONE

	ENDSV.			;END STKVAR
; PARAMETER SETTING ROUTINES

; SET RECORD FORMAT TYPE
; RETURNS:
;	+1:	ERROR
;	+2:	SUCCESS

SETFMT:	LOAD T3,TPUNIT		;GET THE MTA UNIT NUMBER
	OPSTR <SKIPE T2,>,TPDM	;GET THE PREVAILING DATA MODE
	STOR T2,MTDM,(T3)	;SET THE MODE
	LDB T3,[POINT 4,STS,35]	;GET OPEN MODE
	CAIN T3,.GSDMP		;DUMP MODE?
	JRST SETFM2		;YES. ALLOW PREVAILING MODE THEN
	LOAD T2,TPFRMT		;GET CODE
	CAIE T2,TPFSYD		;SYSTEM-DEFAULT?
	CAIN T2,TPFMTU		; OR UNDEFINED?
	JRST [	CALL TSTLCG	;SEE IF A DEC 36-BIT CONFUSER
		 JRST .+1	;NO. USE 8-BIT BYTES THEN
		JRST SETFM2]	;IT IS. DO PROPER THING
	MOVX T1,^D8		;NO-- MUST SET BYTE SIZE TO 8
	DPB T1,PBYTSZ		;SET IN FILBYT
	LOAD T3,TPUNIT		;GET MTA UNIT #
	LOAD T2,TPBSZ		;GET BLOCK SIZE OF TAPE
	STOR T2,MTRS,(T3)	;SET UP MTA BLOCK SIZE
	LOAD T2,MTBYT,(T3)	;GET MAGTAP'S BYTE POINTER LH
	DPB T1,[POINT 6,T2,11+18] ;SET BYTE SIZE TO 8
	STOR T2,MTBYT,(T3)	;PUT CHANGED POINTER BACK
	MOVX T1,.SJDM8		;GET INDUSTRY-COMPATIBLE MODE (8 BIT BYTES)
	STOR T1,MTDM,(T3)	;SET IT IN MTA DATA BASE
	UCALL MTASBW		;ESTABLISH BUFFER PARAMETERS
	 RET			;ERROR-- PASS UP
SETFM2:	LOAD T1,TPRSZ		;GET RECORD SIZE
	CALL SETRSZ		;VALIDATE RECORD SIZE
	 RET			;INVALID RECORD SIZE
	RETSKP			;RETURN SUCCESS FROM SETFMT
;ROUTINE TO CHECK AND SET FORMAT CODE
;	T1/ CODE

CHKFM0:	TDZA T4,T4		;NO STORE OF DATA
CHKFMT:	MOVEI T4,1		;REMEMBER TO DO THE STORE
	MOVEI T2,TPFMTF		;START AT FIXED
	OPSTR <SKIPE>,TPEBD	;EBCDIC TAPE?
	CAIE T1,"V"		;YES. IS IT A V TAPE?
	SKIPA			;NO. GO ON
	MOVEI T1,"D"		;YES. CONVERT TO ANSI EQUIVALENT
CHKFM1:	CAILE T2,TPFMTU		;LOOKED AT THEM ALL?
	MTERET (IOX25)		;YES. ERROR THEN
	LDB T3,[POINT 7,FMTTAB(T2),6] ;GET CHARACTER
	CAIE T3,0(T1)		;THIS THE ONE?
	AOJA T2,CHKFM1		;NO. KEEP LOOKING
	JUMPE T4,RSKP		;IF NO STORE, DONE NOW
	STOR T2,TPFRMT		;YES. STORE IT
	RETSKP			;AND DONE
; SETRSZ -- SET TAPE RECORD SIZE
; CALL:
;	T1/	RECORD SIZE
; RETURNS:
;	+1:	ERROR
;	+2:	SUCCESS

SETRSZ:	LOAD T3,TPUNIT		;GET MAGTAP UNIT #
	LOAD T3,MTRS,(T3)	;GET PHYSICAL BLOCK SIZE
	LOAD T2,TPFRMT		;GET TAPE FORMAT
	XCT [			;GET MAX RECORD SIZE
		JRST SETRS1	;SYSTEM-DEFAULT
		NOP		;FIXED
		CALL [	CAMGE T3,T1 ;WILL IT FIT?
			MOVE T1,T3 ;NO. MAKE IT DO SO
			RET]	;AND DONE
		MOVX T3,<XWD 1,0>-1	;SPANNED
		JRST SETRS1		;UNDEFINED
		](T2)
	CAIN T2,2		;FORMAT D?
	JUMPE T1,SETRS1		;YES, ALLOW 0 RECORD SIZE
	SKIPLE T1		;RECORD SIZE TOO SMALL?
	CAMLE T1,T3		; OR TOO BIG?
	 MTERET (IOX20)		;YES-- ERROR
SETRS1:	STOR T1,TPRSZ		;STORE RECORD SIZE
	RETSKP			;RETURN +2 FROM SETRSZ

;ROUTINE TO CHECK FOR EITHER A DECSYSTEM20 OT A DECSYSTEM10 OWNER

TSTLCG:	TQNE <WRTF>		;HAVE WRITE ACCESS?
	RETSKP			;YES. SAY IS GOOD THEN
	JN TPT20,,RSKP		;IF A TOPS20 TAPE, DONE
	JN TPEBD,,R		;IF EBCDIC TAPE, CAN'T BE ONE OF OURS
	SETZM T1		;GET ANSWER IN T1
	MOVE T2,.V1OPR		;THE FIELD
	MOVEI T3,V1LOC		;IN THE VOL1 LABEL
	CALL GETLBL		;GET OWNER NAME
	 RET			;NOT. SAY SO
	CAME T1,["D%A"]		;IS IT TOPS10?
	CAMN T1,["D%K"]		;OR IS IT TOPS20?
	RETSKP			;IT IS. SON OF A GUN
	RET			;NOT
;ROUTINE TO SKIP TO CORRECT FILE HEADER AREA
;T1 := # OF FILES TO POSITION

SKPFIL:	SAVEAC <Q3>		;SAVE A REG
	MOVE Q3,T1		;GET # TO SKIP
SKPFL0:	CALL GETNXA		;GET NEXT, ALLOW NULL FILE
	 MTERET (GJFX24)	;NO MORE FILES
	SOJLE Q3,RSKP		;IF ALL FILES DONE, DONE
	CALL HDRCHK		;GET NEXT FILE HEADERS
	 RETBAD ()		;ERROR DOING IT
	JRST SKPFL0		;AND DO IT AGAIN

;ROUTINE TO REPOSITION TO BEGINNING OF A HEADER AREA

REPOS:	STKVAR <COUNT>
	JE HDR1,,RSKP		;IF NO HDR1, DONE
	MOVEI T1,1		;INIT COUNT
	MOVEM T1,COUNT		; TO 1
	OPSTR <SKIPE>,HDR2	;AND/OR HDR2
	AOS COUNT		;COUNT RECORDS
	LOAD T2,TPXLB		;GET EXTRA LABEL COUNT
	ADDM T2,COUNT		;ADJUST OUR COUNT BY THAT
	AOS COUNT		;BACKSPACE ONE EXTRA RECORD
REPOS1:	MOVEI T2,.MOBKR		;BACKUP A RECORD
	CALL MTLFCN
	 RET			;ERROR
	SOSE COUNT		;DECR COUNT
	JRST REPOS1		;LOOP
	MOVEI T2,.MOFWR		;FORWARD SPACE OVER EXTRA RECORD
	CALL MTLFCN		;...
	 RET			;AN ERROR
	RETSKP			;SUCCESS, RETURN

	ENDSV.			;END STKVAR
;ROUTINE TO READ AND VERIFY HEADER LABELS
;LEAVES TAPE POSITIONED AFTER LAST HDR LABEL

HDRCHK:	TDZA T2,T2		;ENTRY FLAG
HDRCHT:	MOVEI T2,1		;ENTRY TO CHECK USING TRAILERS
	SAVEAC <Q3>		;GET A WORK REG
	MOVE Q3,T2		;SAVE ENTRY FLAG
HDRCHE:	SETZRO <HDR1,HDR2>	;NO VALID HEADERS YET
	MOVEI T2,.LBFRD		;READ A LABEL
	CALL MTLFCN
	 JRST HDRERR		;CHECK FOR EOF
	HRROI T1,[ASCIZ /HDR1/
		  ASCIZ /EOF1/](Q3) ;CHECK FOR PROPER LABEL
	MOVE T2,.H1LID		; IN LABEL ID FIELD
	SETO T3,		;USE LABEL BUFFER
	CALL LBLCMP		;COMPARE FIELDS
	 JRST [	HRROI T1,[ASCIZ /VOL1/] ;SEE IF A VOLUME LABEL
		MOVE T2,.V1LID	;COMPARE
		SETOM T3	;IN THE LABEL BUFFER
		SKIPN Q3	;CHECKING HEADERS?
		CALL LBLCMP	;SEE IF AT VOLUME LABEL
		 MTERET (IOX21)	;NOT
		HRROI T1,[ASCIZ /VOL/] ;SKIP ALL VOLX LABELS
		CALL SKPLBL	;DO IT
		 RETBAD ()	;OOPS
		HRROI T1,[ASCIZ /UVL/] ;AND SKIP ALL UVLX LABELS
		CALL SKPLBL	;DO IT
		 RETBAD ()	;OOPS AGAIN
		JRST HDRCHE]	;ONCE MORE PLEASE
	MOVE T2,.H1SEQ		;GET SEQUENCE #
	SETO T3,		;FROM LABEL BUFFER
	CALL GETLBL		;...
	 MTERET (IOX22)
	JUMPE T1,[MTERET (IOX22)] ;ERROR IF NO SEQUENCE #
	LOAD T2,FSEQ		;GET CURRENT FSEQ
	JUMPE T2,HDRCH0		;IF UNKNOWN, GO ON
	OPSTR <SKIPN>,TPAPP	;DOING VS FOR APPEND?
	TQNN <WRTF>		;NO, OR IF WRITE
	CAIN T1,0(T2)		;YES, IS IT THE ONE WE EXPECT?
	SKIPA T1,T2		;YES. USE IT
	MTERET (IOX22)		;NO. ERROR THEN
	; ..
;HDRCHK CONTINUED.
;SEQUENCE NUMBER IS OK

HDRCH0:	STOR T1,FSEQ		;YES. STASH IT AWAY
	JN TPEBD,,HDRCH2	;IF EBCDIC, SKIP SEQUENCE VERIFICATION
	MOVE T2,.H1SEC		;GET FILE SECTION NUMBER
	SETOM T3
	CALL GETLBL
	 MTERET (IOX22)		;BAD LABEL
	LOAD T2,TPFSEC		;GET EXPECTED FILE SECTION
	JUMPE T2,HDRCH1		;IF UNKNOW, GO ON
	OPSTR <SKIPN>,TPAPP	;DOING VS FOR APPEND?
	TQNN <WRTF>		;NO, OF IF WRITE
	CAIN T1,0(T2)		;YES. A MISMATCH?
	SKIPA T1,T2		;NO. ALL DONE
	MTERET (IOX22)		;NO. ERROR THEN
HDRCH1:	STOR T1,TPFSEC		;SAVE SECTION NUMBER
HDRCH2:	MOVEI T1,H1LOC		;STORE LABEL IN SWAP SPACE
	CALL STOLBL		;...
	SETONE HDR1		;VALID HDR1 DATA
	MOVEI T2,.LBFRD		;SEE IF HDR2 PRESENT
	CALL MTLFCN		;...
	 JRST HDRERR		;CHECK EOF
	HRROI T1,[ASCIZ /HDR2/
		  ASCIZ /EOF2/](Q3)
	MOVE T2,.H2LID
	SETO T3,		;FROM LABEL BUFFER
	CALL LBLCMP
	 JRST HDRBAK		;NOT HDR2 - BACKUP
	MOVEI T1,H2LOC		;STORE LABEL
	CALL STOLBL
	SETONE HDR2		;SAY WE HAVE HDR2
	JN TPEBD,,[MOVE T2,.H2EVS ;IF EBCDIC, GET VOL SWITCH INDICATOR
		   SETZM T1	;PUT IT IN T1
		   MOVEI T3,H2LOC
		   CALL GETLBL	;GET THE VALUE
		    NOP		;CAN'T FAIL
		   TRCE T1,"0"	;CHECK FOR VALID VALUE
		   TRNE T1,-2	;IS IT?
		   JRST .+1	;NO, FORGET IT
		   ADDI T1,1	;"SECTION #
		   STOR T1,TPFSEC ;STASH IT
		   JRST .+1]	;AND PROCEED
	JUMPN Q3,RSKP		;IF CHECKING TRAILERS, DONE
	HRROI T1,[ASCIZ /HDR/]	;DOING HEADERS
	CALLRET SKPLBL		;PRUNE OTHER LABELS
;ERROR ROUTINES FOR HDRCHK

HDRERR:	TXNN IOS,MT%EOF		;FOUND EOF?
	MTERET (IOX23)		;NO - LABEL READ ERROR
	CALL CLREOF		;YES - CLEAR IT
HDRBAK:	MOVEI T2,.MOBKR		;BACKUP A RECORD
	CALL MTLFCN		;...
	 JRST [	TXNN IOS,MT%EOF	;EOF?
		MTERET (IOX23)	;NO. ERROR THEN
		JRST .+1]	;YES. PROCEED
	CALL CLREOF		;CLEAR EOF (IF IT WAS)
	SETZRO TPXLB		;NO EXTRA LABELS SKIPPED IF HERE
	JN HDR1,,RSKP		;OK IF HDR1 SEEN
	TQNN <WRTF>		;WANT SOME FORM OF WRITE?
	MTERET (IOX24,<MOVEI T2,.STCLS
			STOR T2,TPSTAT>) ;YES - ERROR
	JN FSEQ,,RSKP		;IF ALREADY HAVE SEQ NUMBER, GO ON
	INCR FSEQ		;WE DON'T. MUST BE A T FIRST FILE IN VOL SET
	RETSKP			;ELSE GOOD RETURN (APPEND)
;ROUTINE TO READ AND VERIFY TRAILER LABELS

TLRCHK:	SETZRO	TPEOF		;CLEAR THIS NOW
	LOAD T1,TPUNIT		;GET MTA UNIT #
	CALL PHYPOS		;GET CURRENT POSITION INFO
	OPSTRM <SUBM T1,>,RCNT	;COMPUTE RECORD COUNT
	MOVEI T2,.LBFRD		;READ A RECORD
	CALL MTLFCN
	 JRST TLRER1		;READ ERROR/TM
	HRROI T1,[ASCIZ /EOF1/]	;CHECK FOR THIS FIRST
	MOVE T2,.H1LID		;FIELD DESC
	SETO T3,		; IN LABEL BUFFER
	CALL LBLCMP		;CHECK MATCH
	 JRST TLREOV		;NOT EOF - CHECK EOV
	SETONE TPEOF		;SAY EOF SEEN
	INCR FSEQ		;AND EXPECT NEXT SEQUENCE NUMBER THE NEXT TIME
TLRCKR:	MOVE T2,.H1CNT		;SET TO COMPARE RECORD COUNT
	SETO T3,
	CALL GETLBL		;FETCH FIELD
	 JRST TLRCK3		;NOT A VALID NUMBER
	OPSTR <SUB T1,>,RCNT	;COMPUTE DIFFERENCE
	AOJE T1,TLRCK1		;JUMPE IF MATCH
TLRCK3:	SETONE RCCHK		;SET FLAG TO INDICATE NO MATCH
TLRCK1:	MOVEI T2,.LBFRD		;READ NEXT RECORD (EOF2/EOV2))
	CALL MTLFCN
	 JRST TLRER2		;ERROR OR TM
	HRROI T1,[ASCIZ /EOF2/]	;CHECK FOR THIS
	JN TPEOF,,TLRCK2	; EOF/EOV?
	HRROI T1,[ASCIZ /EOV2/]	;EOV - USE THIS INSTEAD
TLRCK2:	MOVE T2,.H2LID
	SETO T3,		; IN BUFFER
	CALL LBLCMP		;...
	 JRST TLRBAK		;BACKUP OVER RECORD
	HRROI T1,[ASCIZ /EOF/]	;ASSUME DOING EOF RECORDS
	OPSTR <SKIPE>,TPEOF	;ARE WE?
	HRROI T1,[ASCIZ /EOV/]	;NO. DOING EOV RECORDS
	CALLRET SKPLBL		;SKIP EXTRA LABELS
;ERROR ROUTINES FOR TLRCHK

;HERE IF UNABLE TO READ EOF1/EOV1

TLRER1:	MTERET (IOX23)		;RETURN ERROR

;HERE IF UNABLE TO READ EOF2/EOV2

TLRER2:	TXNN IOS,MT%EOF		;FOUND EOF INSTEAD?
	MTERET (IOX23)		;NO - UNABLE TO READ
	CALL CLREOF		;YES - CLEAR IT
TLRBAK:	MOVEI T2,.MOBKR		;SET TO BACKUP A RECORD
	CALL MTLFCN
	 JRST [	TXNN IOS,MT%EOF	;OVER THE EOF?
		MTERET(IOX23)	;NO. ERROR
		JRST .+1]	;YES. PORCEED
	CALL CLREOF		;MAKE SURE EOF IS OFF
	RETSKP			;GOOD RETURN
;ROUTINE TO CHECK FOR EOV RECORD

TLREOV:	HRROI T1,[ASCIZ /EOV1/]	;CHECK FOR THIS
	MOVE T2,.H1LID		;FIELD DESC
	SETO T3,		;LABEL BUFFER
	CALL LBLCMP		;DO COMPARE
	 JRST TLRER1		;ERROR - NO VALID TRAILERS
	JRST TLRCKR		;JOIN COMMON CODE (EOF)

;ROUTINE TO SKIP EXTRA HEADER OR TRAILER LABELS
;	T1/ SP TO LABEL TYPE TO BE SKIPPED
;RETURNS +1 ALWAYS. TPXLB CONTAINING THE COUNT OF LABELS SKIPPED

SKPLBL:	ASUBR <PNTR>		;SAVE COMPARATOR
	SETZRO TPXLB		;NO EXTRA LABELS YET
SKPLB0:	MOVEI T2,.LBFRD		;READ A LABEL
	CALL MTLFCN		;DO IT
	 JRST SKPLBE		;ERROR OR EOF
	MOVE T1,PNTR
	MOVE T2,.U1HID		;LOOK AT THREE CHARACTERS
	SETOM T3		;IN THE LABEL BUFFER
	CALL LBLCMP		;IS IT A MATCH?
	 JRST SKPLB1		;NO. ALL DONE THEN
	INCR TPXLB		;FOUND AN EXTRA LABEL
	JRST SKPLB0		;AND TRY AGAIN.

;ERROR READING LABEL

SKPLBE:	TXNN IOS,MT%EOF		;EOF?
	MTERET (IOX23)		;NO. LABEL ERROR THEN
	CALL CLREOF		;CLEAR EOF INDICATOR

;AT THE END. BACKUP OVER LAST RECORD

SKPLB1:	MOVEI T2,.MOBKR		;FUNCTION
	CALL MTLFCN		;DO IT
	 JRST [	TXNN IOS,MT%EOF	;EOF?
		MTERET (IOX23)	;NO
		JRST .+1]	;YES
	CALL CLREOF		;CLEAR EOF STUFF
	RETSKP			;AND DONE
;LABEL FIELD UTILITIES

;ROUTINE TO COMPARE A LABEL FIELD WITH VALUE IN T1
;LABEL FIELD DESCRIPTOR IN T2

LBLCMP:	ASUBR <VAL,DESC,BFR,PNTR>
	SAVEAC <Q3>		;GET A WORK REG
	SETOM Q3		;ALL VALUES IN ASCII PLEASE
	CALL MAKEBP		;MAKE A BYTE PNTR
	LOAD T4,FLDLEN,DESC	;GET LENGTH IN T4
	LOAD T1,FLDTYP,DESC	;GET TYPE
	CAIG T1,.FTMAX		;VALID?
	JRST @[	IFIW!CMPSTR	;STRING
		IFIW!CMPNUM	;DECIMAL NUMBER
		IFIW!CMPDAT	;DATE
		IFIW!CMPSPC	;SPACES
		IFIW!CMPOCT](T1) ;OCTAL NUMBER
ILLTYP:	BUG.(HLT,BADTYP,TAPE,HARD,<Bad label field desc>,,<

Cause:	This is a bug in TAPE.  The internal routines in TAPE have a table with
	codes that describe the type of data in particular label fields
	(octal,string,decimal).  One of these tables has a code that is out of
	range.	Try to find out where the out of-range-code came from.
>)
;ACTION ROUTINES FOR LBLCMP

;COMPARE STRING WITH LABEL FIELD

CMPSTR:	MOVE T1,VAL		;TEST STRING
	TLC T1,-1		;CHECK FOR -1,,ADDRS
	TLCN T1,-1
	HRLI T1,(<POINT 7,,>)	;MAKE BP
CMPST1:	ILDB T3,T1		;GET A CHAR
	JUMPE T3,CMPSPC		;CHECK FOR REMAINING SPACES
	CALL GTCHR		;GET CHARACTER FROM LABEL
	CAME T2,T3		;MATCH?
	RET			;NO - FAIL RETURN
	SOJG T4,CMPST1		;CONTINUE OVER ALL CHARS
	RETSKP			;MATCH - SUCCESS

;COMPARE FIELD FOR SPACES

CMPSPC:	CALL GTCHR		;GET BYTE
	CAIE T2,40		;SPACE?
	RET			;NO - FAIL
	SOJG T4,CMPSPC		;CONTINUE
	RETSKP			;OK RETURN

;COMPARE DECIMAL NUMBER

CMPNUM:	CALL GETNUM		;GET NUMBER FIELD
	 RET			;ERROR
	CAME T1,VAL		;MATCH?
	 RET			;NO
	RETSKP			;YES

;COMPARE OCTAL NUMBER

CMPOCT:	CALL GETOCT		;GET NUMBER FIELD
	 RET			;ERROR
	CAME T1,VAL		;MATCH?
	 RET			;NO
	RETSKP			;YES

;DATE COMPARE

CMPDAT:	RET			;NONE
;ROUTINE TO GET LABEL FIELD AND RETURN IT IN T1

GETLBU:	TDZA T4,T4		;NO CONVERSION
GETLBL:	SETOM T4		;ASCII ONLY
	ASUBR <VAL,DESC,BFR,PNTR>
	SAVEAC <Q3>		;GET A WORK REG
	MOVE Q3,T4		;SAVE ENTRY FLAG
	CALL MAKEBP		;MAKE A PNTR
	LOAD T4,FLDLEN,DESC	;GET FIELD LENGTH
	LOAD T1,FLDTYP,DESC	; AND TYPE
	CAIG T1,.FTMAX
	JRST @[	IFIW!GETSTR	;STRING
		IFIW!GETNUM	;DECIMAL NUMBER
		IFIW!GETDAT	;DATE
		IFIW!GETSPC	;SPACES
		IFIW!GETOCT](T1) ;OCTAL NUMBER
	JRST ILLTYP

GETSPC:	RET			;ERROR FOR NOW

GETNUM:	SKIPA T3,[12]		;BASE 10
GETOCT:	MOVEI T3,10		;BASE 8
	SETZ T1,		;INIT NUMBER
GETNM1:	ILDB T2,PNTR		;FETCH CHAR
	OPSTR <SKIPE>,TPEBD	;EBCDIC LABEL?
	CALL EBCASC		;YES. GET ASCII EQUIVALENT
	CAIN T2," "		;A BLANK?
	RETSKP			;YES. TERMINATE FIELD THEN
	CAIGE T2,"0"(T3)	;VALID DIGIT?
	CAIGE T2,"0"
	RETBAD (IFIXX2)		;NO. ERROR
	IMUL T1,T3
	ADDI T1,-60(T2)		;ACCUM RESULT
	SOJG T4,GETNM1
	RETSKP			;DONE

;GET STRING. IF VAL=0 ,GET R-JUST INT T1. ELSE, PUT IN VAL

GETSTR:	SKIPE T2,VAL		;WANT IT IN T1?
	JRST GETST2		;NO
	CAILE T4,5		;MAX OF 5 CHARS
	RET			; ELSE ERROR
	SETZ T1,		;INIT ANSWER
GETST1:	CALL GTCHR		;LOCAL GET CHARACTER ROUTINE
	ANDI T2,177		;MASK TO 7-BITS
	LSH T1,7		;MAKE SPACE
	IOR T1,T2		;PLUNK CHAR DOWN
	SOJG T4,GETST1		;LOOP TILL DONE
	RETSKP			;GOOD RETURN
;GETLBL/GETLBU CONTINUED.

;PUT STRING INTO VAL

GETST2:	TLC T2,-1		;CONVERT BP
	TLCN T2,-1		; IF NECESSARY
	HRLI T2,(<POINT 7,>)	;IT IS
	MOVEM T2,VAL		;UPDATE THE POINTER
GETST3:	CALL GTCHR		;LOCAL GET CHARACTER ROUTINE
	IDPB T2,VAL		;STASH IT
	SOJG T4,GETST3		;GET ENTIRE STRING
	RETSKP			;AND DONE

;LOCAL GET CHARACTER ROUTINE FOR GETSTR

GTCHR:	ILDB T2,PNTR		;GET NEXT BYTE
	OPSTR <SKIPE>,TPEBD	;EBCDIC TAPE?
	SKIPN Q3		;YES. WANT CONVERSION?
	RET			;NO. USE AS IS
	CALLRET EBCASC		;YES. CONVERT IT

;ROUTINE TO CONVERT EBCDIC BYTE TO ASCII
;	T2/ THE EBCDIC BYTE

EBCASC:	SAVEAC <T3>		;SAVE ALL REGS
	IDIVI T2,4		;GET WORD WITH TRANSLATION
	LDB T2,[POINT 8,ETOA(T2),7
		POINT 8,ETOA(T2),15
		POINT 8,ETOA(T2),23
		POINT 8,ETOA(T2),31](T3)
	RET			;DONE
;GET A JULIAN DATE

GETDAT:	CALL GTCHR		;GET NEXT BYTE
	CAIE T2,40		;BETTER BE A SPACE
	RET
	MOVEI T4,2		;GET YEAR DIGITS
	CALL GETNUM
	 RET			;ERROR
	PUSH P,T1		;SAVE YEAR
	MOVEI T4,3		;GET DAY DIGITS
	CALL GETNUM
	 JRST [	ADJSP P,-1	;ERROR , CLEAN OFF PDL
		RET]
	POP P,T2		;RETRIEVE YEAR
	JUMPE T1,[JUMPN T2,.+1	;IF INVALID DAY, CHECK CANONICAL VALUE
		AOJA T1,.+1]	;YES. CORRECT THE DAY THEN
	ADDI T2,^D1900		;MAKE INTO REAL YEAR
	HRLZS T2		;MOVE TO LHS
	HRR T2,T1		;DAY NUMBER TO RHS
	MOVX T4,IC%JUD		;CONVERT JULIAN
	IDCNV			;
	 RETBAD ()		;INTERNAL ERROR
	MOVE T1,T2		;COPY DATE TO T1
	RETSKP			;GOOD RETURN
;ROUTINE TO MAKE A BYTE POINTER TO A LABEL FIELD
;ASSUMES GLOBAL VARS:
;	DESC - LABEL FIELD DESCRIPTOR
;	BFR  - BUFFER ADDRS (OFFSET FROM TPLBLS, OR -1)
;	PNTR - RETURN RESULT

MAKEBP:	MOVE T1,BFR		;GET BUFFER LOC
	JUMPGE T1,[LOAD T2,TPLBLS ;GET LABEL STORAGE PNTR
		   ADD T2,T1	;ADD IN OFFSET
		   JRST MAKBP1]
	LOAD T2,TPIOB		;GET ADDRESS OF I/O BUFFER
MAKBP1:	MOVEM T2,BFR		;SAVE BUFFER ADDRS
	SETZ T2,		;INIT INDEX
	LOAD T1,FLDPOS,DESC	;GET CHAR POS
	SUBI T1,2		;OFFSET BY 2
	ASHC T1,-2		; / 4
	ROT T2,3		;GET REMAINDER * 2
	TRZ T2,4		; MOD 4
	ADD T1,[POINT 8,0,7
		POINT 8,0,15
		POINT 8,0,23
		POINT 8,0,31](T2) ;ADD IN CORRECT POINTER
	ADD T1,BFR		;BUFFER START ADDRS
	MOVEM T1,PNTR		;SAVE RESULT
	RET			;RETURN
;ROUTINE TO SAVE LABEL IN LABEL AREA
;C(T1) := LABEL OFFSET INTO LABEL AREA

STOLBL:	LOAD T2,TPIOB		;GET I/O BUFFER ADDRESS
	OPSTR <ADD T1,>,TPLBLS	;COMPUTE LABEL LOC
	HRLZS T2		; FROM ,, 0
	HRR T2,T1		; FROM ,, TO
	BLT T2,.LBLEN-1(T1)	;MOVE LABEL
	RET

;ROUTINE TO COPY LABEL INTO BUFFER
;C(T1) := LABEL OFFSET INTO LABEL AREA

FETLBL:	LOAD T2,TPIOB		;GET LABEL BUFFER
	OPSTR <ADD T1,>,TPLBLS
	HRL T2,T1		; FROM ,, TO
	HRRZ T1,T2		; DESTINATION
	BLT T2,.LBLEN-1(T1)	;MOVE IT
	RET
;CLOSE PROCESSING

CLOSE:	LOAD T1,TPSTAT		;CHECK STATE
	TQNN <WRTF>		;CHECK OUTPUT/INPUT
	JRST @CIDIS.(T1)	;DISPATCH INPUT CLOSE
	JRST @CODIS.(T1)	;DISPATCH OUTPUT CLOSE

;CLOSE STATE DISPATCH TABLE

CIDIS.:	STDIS (CI)		;GEN TABLE INPUT

CODIS.:	STDIS (CO)		;GEN TABLE OUTPUT
CO.ABH:	RETBAD (IOX32)		;POSITION INDETERMINATE

CI.ABH:	CALL OPEN		;SEE IF WE CAN GET POSITION
	 RETBAD ()		;NO
	JRST CLOSE		;AND TRY AGAIN

CO.CLS:
CI.CLS:	SETZRO <HDR1,HDR2>	;NO HEADERS ANYMORE
	RETSKP			;ALREADY CLOSED - RETURN

;TAPE IN DATA AREA - CHANGE THAT

CO.RDY:	CALL MTMCSC		;FINISH LAST RECORD
	 RETBAD ()		;ERROR OR BLOCK
	MOVEI T2,.MONOP		;WAIT FOR LAST OP TO FINISH
	CALL MTLFCN		;""
	 JRST [	TXNN IOS,MT%EOT	;AT THE EOT?
		RETBAD ()	;NO. ERRO OF SOME SORT
		CALL EOV	;YES. DO EOV PROCESSING THEN
		 RETBAD ()	;FAILED
		JRST CLOSE]	;HANDLE NEW STATE
	SKIPA T2,[.MOEOF]	;WRITE TAPE MARK
CI.RDY:	MOVEI T2,.MOFWF		;SKIP TO END OF DATA
	CALL MTLFCN		;...
	 RET			;BLOCK
	CALL CLREOF		;CLEAR EOF INDICATION
	MOVEI T1,.STEOF		;PREPARE FOR TRAILERS
	STOR T1,TPSTAT
	JRST CLOSE		;CONTINUE PROCESSING

CI.EOF:	CALL TLRCHK		;CHECK TRAILERS
	 RETBAD ()		;NOT GOOD
	JE TPEOF,,CI.EO0	;IF NOT EOF, MUST DO MORE WORK
	MOVEI T1,.STUTL		;MOVE TO LAST STATE
	STOR T1,TPSTAT		;...
	JRST CLOSE		;CONTINUE

;AT END OF FILE SECTION. MUST GET NEXT TAPE

CI.EO0:	CALL EREOF2		;GET NEXT VOLUME
	 RETBAD ()		;FAILED
	JRST CLOSE		;AND HANDLE NEW TAPE POSITION
;TAPE READY FOR TRAILERS

CO.EOF:	CALL CLSEOF		;DO EOF STUFF
	 RET
	JRST CLOSE		;DO IT AGAIN

;COMMON EOF PROCESSING

CLSEOF:	HRROI T1,[ASCIZ "EOF1"]	;WANT EOF LABELS
	HRROI T2,[ASCIZ "EOF2"]
	CALL WRTTLR		;WRITE TRAILERS
	 RET			;PASS BLOCK UP
	SETZRO <HDR1,HDR2>	;NO HEADERS
	INCR FSEQ		;STEP TO NEXT FILE
	MOVEI T1,.STUTL		;MOVE TO FINAL STATE
	STOR T1,TPSTAT		;...
	RETSKP			;AND DONE

CO.UTL:	CALL TWOEOF		;MAKE SURE TWO EOFS ON THE TAPE
	 RETBAD ()		;ERROR

CO.UT0:	MOVX T1,CZ%ABT		;TAPE ALL SET, DO CLOSE ASAP
	MCALL MTACLZ		;PERFORM ACTUAL CLOSE OPR.
	 RET			;BLOCK / ERROR
	MOVEI T1,.STCLS		;SAY WE ARE NOW CLOSED
	STOR T1,TPSTAT		;...
	JRST CLOSE		;AND EXIT

;CLOSE DOING INPUT AND TAPE IN TRAILER REGION

CI.UTL:	JN TPEUT,,CI.UT0	;IF ALL TRAILERS READ, DONE
	MOVEI T2,.MOFWF		;NOT. SKIP TRAILERS THEN
	CALL MTLFCN		;DO IT
	 RETBAD ()		;ERROR
CI.UT0:	JN TPEOF,,CO.UT0	;IF AT EOF, DONE
	JRST CI.EO0		;ELSE, SKIP TO NEXT TAPE
;TAPE STILL IN HEADER AREA

CO.UHL:	CALL OUTCHK		;GET TO READY STATE
	 RETBAD ()		;ERROR
	JRST CLOSE		;AND HANDLE NEW STATE
CI.UHL:	CALL REPOS		;GET BACK TO START OF LABELS
	 RETBAD()		;ERROR
	JRST CO.UT0		;AND DONE

;ROUTINE TO PUT TWO EOF MARKS ON THE TAPE. THIS IS
;DONE WHEN TAPE IS CLOSED AND WAS OPENED FOR WRITE.
;THIS ROUTINE IS HERE SINCE MAGTAP WILL NOT WRITE
;EOFS IF NO SOUT OR SOUTR CALLS HAVE BEEN EXECUTED PRIOR
;TO THE CLOSE.

TWOEOF:	MOVEI T2,.MOEOF		;THE FUNCTION
	CALL MTLFCN		;PUT ONE EOF ON THE TAPE
	 JRST [	TXNN IOS,MT%EOT	;EOT SENSED?
		RETBAD ()	;NO. REAL ERROR THEN
		CALL CLREOF	;YES. CLEAR CONDITION
		JRST .+1]	;AND PROCEED
	MOVEI T2,.MOEOF		;THE FUNCTION AGAIN
	CALL MTLFCN		;DO IT AGAIN
	 JRST [	TXNN IOS,MT%EOT	;EOT SENSED?
		RETBAD ()	;NO. REAL ERROR THEN
		CALL CLREOF	;YES. CLEAR CONDITION
		JRST .+1]	;AND PROCEED
	MOVEI T2,.MOBKR		;BACK UP OVER EOF
	CALLRET MTLFCN		;DO TI

;VOLUME SWITCH STATE

CO.VLS:	CALL VOLSW0		;COMPLETE SWITCH
	 RETBAD()		;CAN'T
	JRST CLOSE		;AND PROCEED
;ROUTINE TO WRITE TAPE TRAILERS (EOF/EOV)
;LABEL ID INFO IN T1,T2

WRTTLR:	STKVAR <HD1,HD2>
	MOVEM T1,HD1		;SAVE T1,T2
	MOVEM T2,HD2
	MOVEI T1,H1LOC		;GET HDR1 LABEL
	CALL FETLBL
	MOVE T1,HD1		;NEW ID
	MOVE T2,.H1LID		;DESCRIPTOR
	SETO T3,		;USE BUFFER
	CALL SETLB		;COPY ID TO LABEL
	LOAD T1,TPUNIT		;GET UNIT #
	CALL PHYPOS		;GET POSITION INFO
	OPSTR <SUB T1,>,RCNT	;COMPUTE DIFFERENCE
	SUBI T1,1		;** FUDGE **. THIS IS BECAUSE THE TM 
				;BETWEEN THE HDR2 LABEL AND THE DATA
				;PORTION IS INCLUDED IN UDBPS2.
	MOVE T2,.H1CNT		;SET BLOCK COUNT FIELD
	SETO T3,
	CALL SETLB		;...
	MOVEI T2,.LBFWR		;SET TO WRITE
	CALL MTLFCN
	 JRST [	TXNN IOS,MT%EOT	;AT EOT?
		RETBAD ()	;NO. ERROR THEN
		JRST .+1]	;AND PROCEED
	CALL CLREOF		;NO EOT
	MOVEI T1,H2LOC		;FETCH HDR2
	CALL FETLBL
	MOVE T1,HD2		;NEW HEADER
	MOVE T2,.H2LID		;DESC
	SETO T3,		; INTO BUFFER
	CALL SETLB		;...
	MOVEI T2,.LBFWR		;WRITE IT
	CALL MTLFCN
	 JRST [	TXNN IOS,MT%EOT	;AT EOT?
		RETBAD ()	;NO. ERROR THEN
		JRST .+1]	;AND PROCEED
	CALL CLREOF		;NO EOT
	RETSKP			;OK RETURN

	ENDSV.			;END STKVAR
;LABEL READ/WRITE ROUTINES

LBLWRT:	CALL SETSTS		;SAVE WORLD
	TQO <WRTF>		;GRNTEE WRITE PRIVS
	LOAD T1,TPIOB		;GET I/O BUFFER ADDRESS
	SOS T1			;POINT TO ONE BEFORE
	HRLI T1,-.LBLEN		;LENGTH FOR I/O
	MCALL MTDMOX		;WRITE RECORD
	 JRST CKLERR		;CHECK ERROR
	CALL RETSTS		;RESTORE STATUS
	RETSKP			;GOOD RETURN

LBLRED:	CALL SETSTS		;SAVE WORLD
	TQO <READF>		;GRNTEE READ PRIVS
	LOAD T1,TPIOB		;GET I/O BUFFER ADDRESS
	JUMPE T1,[CALL ASGPAG	;IF NONE ASSIGNED YET, GET ONE
		   RETBAD ()	;ERROR
		  STOR T1,TPIOB	;SAVE BUFFER ADDRESS
		  JRST .+1]	;AND PROCEED
	SOS T1			;POINT TO PREVIOUS WORD
	HRLI T1,-PGSIZ		;THE LENGTH
	MCALL MTDMIX		;READ RECORD
	 JRST CKLERR		;CHECK ERROR
	CALL RETSTS		;RESTORE STATUS
	RETSKP			;GOOD RETURN

SETERR:	TQO <ERRF>		;SET ERROR
	MOVEI T1,OPNX8		;ERROR CODE TO RETURN
				;HANDLE GENERAL CASE
CKLERR:	TQNE <BLKF>		;WANT TO BLOCK?
	RET			;YES.
	PUSH P,T1		;SAVE ERROR CODE
	CALL RETSTS		;RESTORE STS, ETC...
	POP P,T1		;RESTORE ERROR CODE
	TXNE IOS,MT%EOT!MT%EOF	;CHECK EOT/EOF
	RET			;PASS ERROR UP
	TXNN IOS,MT%DAE!MT%DVE	;SOME SORT OF DEVICE OR DATA ERROR?
	JRST [	TXZN IOS,MT%IRL	;NO. RECORD LENGTH FAILURE?
		JRST .+1	;NO. UNKNOWN. GIVE ERROR
		LOAD T2,TPUNIT	;GET TAPE UNIT
		LOAD T3,MTALTC,(T2) ;GET COUNT OF LAST TRANSFER
		CAIGE T3,.LBLEN	;ENOUGH WORDS?
		JRST .+1	;NO. ERROR THEN
		MOVEM IOS,MTASTS(T2) ;UPDATE STATUS
		TQZ <ERRF>	;YES. NO ERROR THEN
		RETSKP]		;AND DONE
	CALLRET LBLERR		;DO ERROR PROCESSING
;COMMON ROUTINE TO PROCESS A LABEL READ OR WRITE ERROR

LBLERR:	MOVEI T2,.STABH		;NEED TO SET ABORTED STATE
	STOR T2,TPSTAT		;DO IT
	RET			;AND DONE

;ROUTINE TO CLEAR VV AND RELEASE BUFFERS

CLRVV:	SETZRO TPEUT		;NO LONGER AT END OF USER LABELS
	LOAD T1,TPUNIT		;SEE IF MTA IS ASSIGNED
	CAIN T1,MXMTAU		;IS IT?
	JRST CLRVV0		;NO. PROCEED
	MOVX T1,CZ%ABT		;NEED TO CLOSE THE MTA
	MCALL MTACLZ		;DO IT
	 NOP			;ALWAYS SUCCEEDS
	SETONE TPUNIT		;NO ASSOCIATED MTA
CLRVV0:	SETZRO TPVV
	CALLRET DEALBL		;AND FREE THE LABEL BUFFERS

;ROUTINE CALLED FROM RELD WHEN AN "MT:" IS DEASSIGNED

;	T2/ INDEX INTO DEV TABLES

RELDMT::SAVEAC <U,IOS,DEV>	;SAVE VULNERABLE REGS
	SAVET			;SAVE ALL TEMPS AS WELL
	LOAD U,DV%UNT,DEVUNT(T2) ;GET UNIT NUMBER OF MT
	MOVS DEV,U		;SET UP DEV FOR MAGTAP
	SETZRO <TPUED,TPSTAT,TPLPCS,UVLD> ;CLEAR THESE VALUES FOR NEXT USER
	SETZRO <TPFSN>		;NO VOL SET NAME YET
	SETZRO FSEQ		;UNKNOWN SEQ FOR NEXT USER
	SETZRO TPFSEC		;AND AND UNKNOWN SECTION FOR NEXT USER
	CALLRET CLRVV		;CLEAR VV FOR THIS UNIT
;ROUTINE TO SETUP STATUS INFO FOR LABEL READ/WRITE

SETSTS:	OPSTR <SKIPE>,FSSAV	;SAVED ALREADY?
	RET			;YES - JUST RETURN
	STOR STS,FSSAV		;NO - STORE FILSTS
	TXZ STS,NWTF		;ALWAYS WAIT
	LOAD T3,TPUNIT		;GET MTA UNIT #
	LOAD T1,MTRS,(T3)	;GET RECORD SIZE
	STOR T1,TPMTRS		;SAVE IT
	MOVEI T1,.LBRSZ		;LABEL RECORD SIZE
	STOR T1,MTRS,(T3)
	LOAD T1,MTDM,(T3)	;DATA MODE
	STOR T1,TPMTDM
	MOVEI T1,.LBTDM		;LABEL DATA MODE
	STOR T1,MTDM,(T3)
	LOAD T1,MTHBW,(T3)	;HARDWARE BYTES/WD
	STOR T1,TPMHBW
	MOVEI T1,.LBHBW		;LABEL BYTES/WD
	STOR T1,MTHBW,(T3)
	STOR IOS,SVIOS		;SAVE IOS
	MOVX IOS,OPND		;SET DUMP MODE
	IORB IOS,MTASTS(T3)	;...
	RET			;RETURN

;ROUTINE TO RESTORE MTA STATUS

RETSTS:	OPSTR <SKIPN>,FSSAV	;ANYTHING SAVED?
	RET			;NO - JUST RETURN
	ANDX STS,ERRF!EOFF	;PRESERVE THESE STATUS BITS
	OPSTR <IOR STS,>,FSSAV	;...
	MOVEM STS,FILSTS(JFN)
	SETZRO FSSAV		;MARK RESTORED
	LOAD T3,TPUNIT		;GET MTA UNIT #
	LOAD T1,TPMTRS		;RESTORE RECORD SIZE
	STOR T1,MTRS,(T3)
	LOAD T1,TPMTDM		;RESTORE DATA MODE
	STOR T1,MTDM,(T3)
	LOAD T1,TPMHBW		;RESTORE BYTES/WD
	STOR T1,MTHBW,(T3)
	ANDX IOS,MT%EOF!MT%EOT!MT%DAE!MT%DVE!MT%IRL ;PRESERVE THESE
	OPSTR <IOR IOS,>,SVIOS	; IN MTASTS
	MOVEM IOS,MTASTS(T3)	;...
	RET			;RETURN
;SUPPORT ROUTINES FOR .MOATU

;ROUTINE TO SETUP U FOR MT UNIT #
;RETURNS T1 := MTA UNIT #
;	 T2 := CURRENT CONTENTS OF TPUNIT

MSETU:	EXCH T1,U		;SET U TO MT UNIT
	LOAD T2,TPUNIT		;RETURN CURRENT MTA UNIT
	RETSKP

;ROUTINE TO SET MTA UNIT NUMBER INTO MT DATA BASE.
;	T1/ MT UNIT #
;	T3/ DENSITY
;	T4/ RELATIVE VOLUME # (0= UNKNOWN)

SETMTU::MOVE T4,T2		;SAVE CURRENT VOLUME NUMBER
	CALL MSETU		;SETUP U , ETC.
	 RETBAD ()		;BAD ARGUMENT
	OPSTR <SKIPE>,TPVV	;ALREADY VALID?
	RETBAD (ARGX19)		;*** NEED ANOTHER ERROR CODE ***
	STOR T1,TPUNIT		;STORE MTA UNIT #
	SETZRO <TPEBD,TPLBD,TPT20> ;NONE OF THESE ARE NOW VALID
	STOR T3,TPDNS		;AND SET DENSITY AS WELL
	CAIE T4,1		;FIRST VOLUME IN SET?
	SETZM T4		;NO. NOT FIRST THEN
	STOR T4,TPFVM		;SET FIRST VOLUME MOUNTED BIT
	JRST SETVVX		;EXIT AND RESTORE U

;ROUTINE TO CLEAR ALL VALID VOLUME BITS IN ALL DRIVES

	RESCD
MTCLVA::SAVEQ			;SAVE REGISTERS
	MOVSI U,-MTAN		;CLEAR ALL DRIVES
MTCLV1:	SETZRO TPVV		;CLEAR VV
	AOBJN  U,MTCLV1		;CLEAR ALL
	RET			;AND RETURN
;ROUTINE TO CLEAR THE VALID VOLUME OF A SINGLE MTA

MTCLVL::SAVEQ
	MOVSI T3,-MTAN		;GET # OF MTAS
MTCLA2:	HRRZ T2,MTCUTB(T3)	;GET THE UDB ADDRESS
	CAIN P3,0(T2)		;MATCH?
	JRST MTCLAF		;YES
	AOBJN T3,MTCLA2		;TRY AGAIN
	RET			;RETURN NONE FOUND

MTCLAF:	MOVSI U,-MTAN		;FOUND AN MTA. NOW SCAN MTS
	HRRZS T3		;ISOLATE MTA UNIT
MTCLA3:	OPSTR <CAMN T3,>,TPUNIT	;IS THIS THE ONE?
	JRST MTCLA4		;YES
	AOBJN U,MTCLA3		;DO THEM ALL
	RET			;NON FOUNE

;FOUND AN MT

MTCLA4:	SETZRO TPVV		;CLEAR VV
	RET			;DONE AT LAST
	SWAPCD
;ROUTINE TO SET VOLUME VALID FOR MT UNIT FOR UNLABLED OPERATION
;	T1/ MT UNIT #
;	T3/ RELATIVE VOLUME #

SETVV::	CALL MSETU		;SETUP U ETC.
	 RETBAD ()
	CAME T2,T1		;BETTER BE THE SAVE
	JRST MTUX1		;BAD UNIT NUMBER
SETVV0:	SETZRO <HDR1,HDR2,SNEOT,TPNVV>
	SETONE TPVV		;TURN ON VV
	STOR T3,TPRVN		;STORE RELATIVE VOLUME #
	CALL ASSLBL		;MAKE SURE LABEL BUFFER ASSIGNED
	 RETBAD ()
SETVVX:	LOAD U,TPUNIT		;RESTORE U
	RETSKP			;SKIP RETURN

;ROUTINE TO CLEAR VV

CLRVVM::CALL MSETU		;SETUP U
	 RETBAD ()		;ERROR
	CAME T1,T2		;THIS ONE OK
	JRST MTUX1		;NO - INVALID UNIT #
	SETZRO TPVV		;CLEAR VOLUME VALID
	JRST SETVVX		;RESTORE U

	REPEAT 0,<
;ROUTINE TO CLEAR UNIT #

CLRMTU::CALL MSETU		;SETUP U
	 RETBAD ()		;ERROR
	SETONE TPUNIT		;SET UNIT TO -1
	MOVE U,T1		;RESET UNIT #
	RETSKP
   >				;END OF REPEAT 0

MTUX1:	LOAD U,TPUNIT		;RESTORE U
	RETBAD (ARGX19)		;ILLEGAL ARG RETURN
;
; ROUTINE TO SET EBCDIC VOLUME
;	T1/ MT UNIT #
;	T3/ RELATIVE VOLUME #
;
SETEBD::CALL MSETU		;SET UP U
	RETBAD ()
	SETONE <TPEBD,TPLBD>	;SET EBCDIC LABLED
	CALLRET SETVV0		;AND GO SET OTHER STANDARD VALUES

;
	REPEAT 0,<
; ROUTINE TO CLEAR EBCDIC VOLUME
;
CLREBD::CALL MSETU		;SET UP U
	RETBAD ()		;ERROR
	SETZRO TPEBD		;CLEAR EBCDIC
	JRST SETVVX		;RESTORE U AND RETURN
   >				;END OF REPEAT 0


;ROUTINE TO READ THE STATE OF VALID VOLUME
; RETURNS TO USER 2/ 0 IF NOT VALID -1 IF VALID
;

REDVV::	CALL MSETU	;SETUP U
	RETBAD ()		;ERROR
	SETZ T2,0		;ASSUME NOT VALID
	OPSTR <SKIPE>,TPVV
	SETO T2,0		;VOLUME VALID
	UMOVEM T2,T2		;RETURN VALID VOLUME
	JRST SETVVX		;RESTORE U AND RETURN

;
	REPEAT 0,<
;ROUTINE TO CLEAR LABELED TAPE FLAG
;
CLRLBL::CALL MSETU		;SET U
	RETBAD ()		;ERROR
	SETZRO TPLBD		;CLEAR FLAG
	JRST SETVVX		;RESTORE U AND RETURN
   >				;END OF REPEAT 0
;ROUTINE TO SET LABELED TAPE FLAG FOR ANSI TAPES
;	T1/ MT UNIT #
;	T3/ RELATIVE VOLUME #

SETLBL::CALL MSETU		;SET U
	RETBAD ()		;ERROR
	SETONE TPLBD		;SET FLAG
	CALLRET SETVV0		;AND SET OTHER STANDARD VALUES

;SET TOPS20 LABLED TAPE
;	T1/ MT UNIT #
;	T3/ RELATIVE VOLUME #

SETT20::CALL MSETU		;SET U
	 RETBAD ()
	SETONE <TPLBD,TPT20>	;SET LABLED OPERTAION
	CALLRET SETVV0		;AND GO DO COMMON SETUP


;SKxxx - SKIP IF TAPE IS OF SPECIFIED LABEL TYPE, WHERE xxx IS
;	 ANS - ANSI
;	 EBD - EBCDIC
;	 T20 - TOPS-20
;	 UNL - UNLABELED
;RETURNS +1: TAPE IS NOT OF SPECIFIED TYPE
;	 +2: TAPE IS OF SPECIFIED TYPE

SKANS:	JE TPLBD,,R		;MUST BE LABELED
	JOR <TPEBD,TPT20>,,R	;MUST NOT BE EBCDIC OR TOPS-20
	RETSKP			;OK, IT'S ANSI

SKEBD:	JN TPEBD,,RSKP		;SKIP IF EBCDIC
	RET

SKT20:	JN TPT20,,RSKP		;SKIP IF TOPS-20
	RET

SKUNL:	JE TPLBD,,RSKP		;SKIP IF NOT LABELED
	RET
;GET/PUT VOLUME LABELS FROM PULSAR
;	T1/ MT UNIT #
;	T2/ ADDRESS OF LABELS IN USER SPACE
;	T3/ # OF LABELS

PUTVOL::ASUBR <MTUN,ADDL,NUML>
	CALL MSETU		;GET MT UNIT #
	 RETBAD ()		;ERROR
	CAME T2,T1		;UNITS MATCH?
	JRST MTUX1		;NO - ARG ERROR
	CALL ASSLBL		;ASSIGN LABEL BUFFERS
	 RETBAD ()		;NONE TO BE HAD
	LOAD T3,TPLBLS		;GET LABEL BUFFER ADDRESS
	ADDI T3,V1LOC		;OFFSET FOR VOL1
	MOVE T2,ADDL		;ADDRESS OF LABELS
	MOVE T1,NUML		;GET NUMBER OF LABELS
	CAILE T1,2		;MORE THAN WE CAN HANDLE?
	MOVEI T1,2		;YES. JUST GET TWO OF THEM THEN
	IMULI T1,.LBLEN		;# OF WORDS TO READ
	SKIPE T1		;ANY TO MOVE?
	CALL BLTUM1		;MOVE TO MONITOR
	HRROI T1,[ASCIZ "VOL2"]	;STRING TO MATCH
	MOVE T2,.UVLID		;CHECK UVLD ID
	MOVEI T3,UVLOC		;BUFFER OFFSET
	CALL LBLCMP		;COMPARE
	 JRST PUTVL2		;NO MATCH - NONE
	SETONE UVLD		;SAY HAVE A VOL2
PUTVL2:
	JRST SETVVX		;RESTORE U AND EXIT

;ROUTINE TO SET VOL SET NAME
;	T1/ MT UNIT #
;	T3/ SIXBIT VOL SET NAME

SETVSN::CALL MSETU		;GET MT INDEX
	 RETBAD ()		;ERROR
	STOR T3,TPFSN		;SAVE IT
	JRST SETVVX		;AND DONE
;ROUTINES TO ASSIGN AND DEASSIGN LABEL BUFFERS
;	U/ MT #

ASSLBL:	JN TPLBLS,,RSKP		;HAVE AREA?
	MOVEI T1,4*.LBLEN+2	;ALLOCATE SWAP SPACE FOR LABELS
	CALL ASGSWP		;GET FREE SPACE
	 RETBAD ()		;NO SPACE
	ADDI T1,1		;POINT AFTER THE HEADER
	STOR T1,TPLBLS		;SAVE ADDRS
	RETSKP			;AND DONE

;DEASSIGN BUFFERS

DEALBL:	LOAD T1,TPLBLS		;RETURN BLOCK
	SOJLE T1,R		;IF NONE, ALL DONE
	NOINT			;PROTECT FREE SPACE
	SETZRO TPLBLS		;CLEAR THIS
	CALL RELMES		;RELEASE FREE SPACE
	LOAD T1,TPIOB		;NOW GET I/O PAGE
	SETZRO TPIOB		;NO LONGER HAVE IT
	SKIPE T1		;CHECK IF HAVE ONE
	CALL RELPAG		;RELEASE THE PAGE
	OKINT
	RET			;AND DONE
;PULSAR INTERFACE

;ROUTINE TO SEND STANDARD MESSAGE TO PULSAR
;	T1/ SUB CODE
;	T2/ COUNT OF ADDITIONAL ARGS
;	T3/ ADDRESS OF ADDITIONAL ARGS


PLRMSG:	MOVEI T4,0(U)		;GET MT UNIT NUMBER
	CALL IPCMTM		;SEND MT MESSAGE
	 JRST [	BUG.(INF,MTMSG,TAPE,HARD,<Failed to send MT message to MOUNTR>,<<T1,ERRCOD>>,<

Cause:	This message is from TAPE.  TAPE sends IPCF messages to MOUNTR under
	certain conditions, such as volume switch.  TAPE was unable to send the
	IPCF message.  The user program involved receives an error return to
	its tape operation.

Action:	There are many reasons IPCF refuses to send a message.  The IPCF error
	code is passed back to the user.  If it is a resource problem, try to
	improve system resources.  

	If it seems like a monitor bug, change this BUGINF to a BUGHLT, and
	submit an SPR with the dump stating how to reproduce the problem.  

Data:	ERRCOD - Error code
>)
		SETONE TPNVV	;INDICATE ERROR
		RETBAD ()]	;USE IPCF ERROR CODE
	RET			;AND DONE
;ROUTINE TO JACKET CALLS TO MAGTAP AND PRESERVE U & DEV.

SAVEU:	PUSH P,U		;SAVE U
	JN TPLPCS,,[ CALL SETERR ;BUSY
		     AOS -1(P)
		     POP P,U
		     RET]
	JRST SAVEC		;GO TO COMMON

SAVEM:	PUSH P,U		;SAVE U

SAVEC:	LOAD U,TPUNIT		;SETUP MTA UNIT
	CAIN U,MXMTAU		;CHECK TO SEE IF SETUP YET
SAVEV1:	MTERET (OPNX8,<	AOS -1(P)
			POP P,U>)		;OPEN ERROR
	HRL DEV,U		;...
	MOVE IOS,MTASTS(U)	;GET CORRECT IOS STATUS
	XCT @-1(P)		;XCT ACTUAL ROUTINE
URET:	 SKIPA 			;HANDLE NON-SKIP
	AOS -1(P)		; AND SKIPS
	AOS -1(P)
	MOVE IOS,MTASTS(U)	;GET FRESH STATUS
	POP P,U			;RESTORE U
	HRL DEV,U		;RESTORE DEV TO MT UNIT
	RET			;RETURN
;MT UTILTITY JSYS. USED BY PRIVILEGED PROGRAMS TO READ LABEL DATA
;AND DECLARE MT ERRORS.
;CALLING SEQUENCE:
;	T1/ FUNCTION CODE
;	T2/ MT UNIT NUMBER
;	T3/ POINTER TO ARG BLOCK

.MTU::	MCENT			;ENTER MONITOR
	MOVX T4,SC%WHL!SC%OPR	;MUST BE WHOPER
	TDNN T4,CAPENB		;IS IT?
	ITERR (CAPX1)		;NO.
	CAIL T2,MTAN		;VALID MT UNIT?
	ITERR (DESX1)		;NO
	MOVE U,T2		;COPY MT NUMBER
	SOSL T1			;VALID FUNCTION?
	CAIL T1,MTUF		;""
	ITERR (ARGX05)		;NO.
	CALL @MTUT(T1)		;DO FUNCTION
	 ITERR()		;ERROR OF SOME SORT
	MRETNG			;DONE

;FUNCTION DISPATCH TABLE FOR MTU JSYS

MTUT:	IFIW!MTMTER		;DECLARE ERROR ON VOLUME SWITCH
	IFIW!MTRDAL		;READ ALL LABELS
	IFIW!MTUPHA		;GET PHYSICAL ASSIGNMENT
	IFIW!MTMCVV		;CLEAR VV
MTUF==.-MTUT
;MTU FUNCTION TO DECLARE VOLUME SWITCH ERROR

MTMTER:	UMOVE T3,3		;GET ARG BLOCK
	UMOVE T4,0(T3)		;GET COUNT
	SOSG T4			;VALID COUNT?
	RETBAD (ARGX04)		;NO
	JN TPVV,,[RETBAD (GJFX16)] ;ERROR IF VV
	SOSG T4			;ERROR CODE GIVEN?
	JRST SETNVV		;NO. DONE THEN
	UMOVE T1,.MTCOD(T3)	;GET ERROR CODE
	STOR T1,TPERM		;SAVE IT
SETNVV:	SETONE TPNVV		;SET NO VV BIT
	RETSKP			;AND DONE

;RETURN PHYSICAL ASSIGNMENT OF AN MT

MTUPHA:	UMOVE T3,3		;GET ARG BLOCK POINTER
	UMOVE T4,0(T3)		;GET COUNT
	SOSG T4			;RROM FOR DATUM?
	RETBAD (ARGX04)		;NO
	LOAD T1,TPUNIT		;GET UNIT NUMBER
	OPSTR <SKIPN>,TPVV	;VOLUME VALID?
	MOVEI T1,.MTNUL		;NO.
	UMOVEM T1,.MTPHU(T3)	;RETURN IT
	RETSKP			;AND DONE

;CLEAR VV FOR SELECTED UNIT

MTMCVV:	JE TPVV,,[RETBAD (IOX8)] ;NOW OFF-LINE
	JN TPLBD,,[RETBAD (DESX9)] ;MUST BE UNLABELED
	JN TPOPN,,[RETBAD (OPNX1)] ;MUST BE CLOSED TOO.
	LOAD T1,TPUNIT		;GET UNIT
	SKIPGE MTASTS(T1)	;IS MTA ALSO CLOSED?
	RETBAD (OPNX1)		;NO. ERROR THEN
	SETZRO TPVV		;CLEAR VALID
	SETONE TPUNIT		;AND INDICATE NO MTA ASSIGNED
	RETSKP			;AND DONE
;MTU FUNCTION TO READ LABELS

MTRDAL:	JE TPVV,,[RETBAD (OPNX8)] ;MUST HAVE A VALID VOLUME
	TRVAR <<LABEL,.LBLEN>>	;PLACE TO STORE LABEL
	UMOVE P3,3		;GET ARG BLOCK ADDRESS
	UMOVE Q3,0(P3)		;GET COUNT
	SOSG Q3			;HAVE ARGS?
	RETBAD (ARGX04)		;NO
	XCTU [SKIPN .MTVL1(P3)]	;WANT VOL1?
	JRST MTRDA1		;NO. GO ON
	MOVEI T3,V1LOC		;WHERE IT IS
	CALL MTGET		;GET THE LABEL
	UMOVE T3,.MTVL1(P3)	;GET POINTER FOR VOL1
	CALL MOVIT		;MOVE IT TO CALLER
	UMOVEM T3,.MTVL1(P3)	;UPDATE SP
MTRDA1:	SOJLE Q3,RSKP		;IF NO MORE COUNT, DONE
	XCTU [SKIPN .MTVL2(P3)]	;WANT VOL2?
	JRST MTRDA2		;NO. GO ON
	JE UVLD,,[CALL CLRLBL	;IF NO VOL2, RETURN ALL NULLS
		JRST MTRD11]	;AND PROCEED
	MOVEI T3,UVLOC		;WHERE IT IS
	CALL MTGET		;GET LABEL
MTRD11:	UMOVE T3,.MTVL2(P3)	;GET SP
	CALL MOVIT		;MOVE VOL2 TO CALLER
	UMOVEM T3,.MTVL2(P3)	;DONE
MTRDA2:	SOJLE Q3,RSKP		;IF NO MORE, DONE
	XCTU [SKIPN .MTHD1(P3)]	;WANT HDR1?
	JRST MTRDA3		;NO
	MOVEI T3,H1LOC		;WHERE IT IS
	CALL MTGET		;GET HDR1
	UMOVE T3,.MTHD1(P3)	;GET SP
	CALL MOVIT		;MOVE HDR1 TO CALLER
	UMOVEM T3,.MTHD1(P3)	;UPDATE SP
MTRDA3:	SOJLE Q3,RSKP		;IF NO MORE, ALL DONE
	XCTU [SKIPN .MTHD2(P3)]	;WANT HDR2?
	RETSKP			;NO. DONE
	JE HDR2,,[CALL CLRLBL	;IF NO HDR2, RETURN NULLS
		JRST MTRD33]
	MOVEI T3,H2LOC		;WHERE HDR2 IS
	CALL MTGET		;GET LABEL
MTRD33:	UMOVE T3,.MTHD2(P3)	;GET SP
	CALL MOVIT		;MOVE HDR2 TO CALLER
	UMOVEM T3,.MTHD2(P3)	;UPDATE SP
	RETSKP			;AND DONE
;UTILITIES FOR MTU JSYS

;CLEAR LABEL BUFFER

CLRLBL:	SETZM LABEL		;ZERO FIRST WORD
	MOVSI T1,LABEL		;BLT SOURCE
	HRRI T1,1+LABEL		;BLT DESTINATION
	BLT T1,.LBLEN-1+LABEL	;PROPAGATE ZEROS THROUGHOUT BUFFER
	RET

;GET A LABEL INTO LABEL BUFFER

MTGET:	MOVEI T1,LABEL		;CONSTRUCT BYTE POINTER TO BUFFER
	HRLI T1,(POINT 8)	; WHERE THE LABEL IS GOING
	MOVE T2,.LB		;THE DESCRIPTOR (VIZ., THE ENTIRE LABEL)
	CALL GETLBU		;GET IT
	 NOP			;MUST SUCCEED
	RET			;AND DONE

;PUT LABEL IN CALLER'S SPACE

MOVIT:	MOVEI T4,.LBLEN*4	;# OF BYTE TO MOVE
	MOVE T1,[POINT 8,LABEL]	;POINTER TO LABEL
	TLC T3,-1
	TLCN T3,-1
	HRLI T3,(<POINT 7,>)
MOVI0:	ILDB T2,T1		;GET A BYTE
	XCTBU [IDPB T2,T3]	;RETURN TO CALLER
	SOJG T4,MOVI0		;DO THEM ALL
	RET			;AND DONE

	TNXEND
	END