Trailing-Edge
-
PDP-10 Archives
-
BB-M081R-SM
-
monitor-sources/tape.mac
There are 50 other files named tape.mac in the archive. Click here to see a list.
; 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 will get 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