TPE TITLE 'DMSTPE (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMSTPE (TAPE) 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* TAPE COMMAND. TO PERFORM CERTAIN TAPE FUNCTIONS, I.E. 00010000
* DUMP A CMS FILE, LOAD A CMS FILE, SET TAPE MODE, SCAN,SKI 00011000
* REW, RUN, FSF, FSR, BSF, BSR, ERG, AND WTM 00012000
* 00013000
* ATTRIBUTES - 00014000
* 00015000
* TRANSIENT, REFRESHABLE, CALLED VIA SVC 202 00016000
* 00017000
* ENTRY POINTS - 00018000
* 00019000
* DMSTPE, TAPE - SEE FUNCTION DESCRIPTION 00020000
* 00021000
* ENTRY CONDITIONS - 00022000
* 00023000
* GPR1 = A(PLIST) 00024000
* GPR14 = RETURN ADDRESS 00025000
* GPR15 = A(DMSTPE) 00026000
* PLIST = CL8'TAPE': COMMAND NAME 00027000
* CL8'DUMP'|'LOAD'|'SCAN'|'SKIP'|'MODESET'|'REW'| 00028000
* 'FSF'|'FSR'|'BSF'|'BSR'|'ERG'|'WTM'|'RUN' 00029000
* 00030000
* OPTIONAL - 00031000
* CL8 - FILENAME IF FUNCTION = DUMP,LOAD,SKIP,SCAN 00032000
* N IF FUNCTIO =WTM,ERG,FSF,FSR,BSF,BSR 00033000
* CL8 - FILETYPE IF FUNCTION = DUMP,LOAD OR SCAN 00034000
* CL8 - FILEMODE IF FUNCTION = DUMP, LOAD OR SCAN 00035000
* CL8'(': BEGINNING OF OPTIONS LIST 00036000
* CL8'WTM'|'NOWTM': FOR 'DUMP' ONLY, DEFAULT = NOWTM 00037000
* CL8 - TAPI|CUU: SYMBOLIC OR ACTUAL TAPE UNIT 00038000
* CL8 - EOT|EOF N: IF LOAD, SKIP, SCAN 00039000
* CL8'NOPRINT'|'TERM'|'PRINT'|'DISK':DUMP,LOAD OR SCAN 00040000
* CL8'9TRACK'|'7TRACK' 00041000
* CL8'DEN' 00042000
* CL8'1600'|'800'|'556'|'200'|'6250' 00043000
* CL8'TRTCH' 00044000
* CL8'0'|'0T'|'OC'|'E'|'ET' 00045000
* CL8')': END OF OPTIONS LIST 00046000
* 00047000
* 8XL1'FF': END OF PARAMETER LIST 00048000
* 00049000
* EXIT CONDITIONS - 00050000
* 00051000
* NORMAL - 00052000
* GPR15 = 0: TAPE FUNCTION PERFORMED AS REQUESTED 00053000
* 00054000
* ERROR - 00055000
* GPR15 = 28 : FILE NOT FOUND 00056000
* 24 : NO FUNCTION SPECIFIED 00057000
* 24 : INVALID OPTION 00058000
* 40 : PREMATURE EOF ON TAPE INPUT FILE 00059000
* 24 : NO FILEID SPECIFIED 00060000
* 24 : INVALID FUNCTION 00061000
* 24 : NO FILETYPE SPECIFIED 00062000
* 24 : INVALID DEVICE ADDRESS 00063000
* 24 : INVALID DEVICE 00064000
* 24 : INVALID PARAMETER FOR AN OPTION SPECIFIED 00065000
* 36 : MODE OF DISK SPECIFIED IS READ/ONLY 00066000
* 36 : TAPE FILE IS FILE PROTECTED 00067000
* 36 : TARGET DISK NOT ACCESSED @VA14196 00067500
* 24 : INVALID MODE 00068000
* 32 : INVALID RECORD FORMAT 00069000
* 24 : INVALID PARAMETER 00070000
* 100 : ERROR READING A FILE FROM DISK 00071000
* 100 : ERROR WRITING A FILE ON DISK 00072000
* 100 : ERROR READING FROM TAPE 00073000
* 100 : ERROR WRITING ON TAPE 00074000
* 100 : TAPE NOT ATTACHED 00075000
* 00076000
* CALLS TO OTHER ROUTINES - 00077000
* 00078000
* TYPLIN - TYPE A LINE ON THE TERMINAL 00079000
* PRINTIO - PRINT A LINE ON THE PRINTER 00080000
* WRBUF - WRITE A FILE ON THE DISK 00081000
* RDBUF - READ A FILE FROM THE DISK 00082000
* FINIS - CLOSE A FILE ON THE DISK 00083000
* ERASE - ERASE A FILE ON THE DISK 00084000
* FSTLKP - FIND THE FILE STATUS TABLE FOR A FILE 00085000
* UPDISK - UPDATE THE USER'S FILE DIRECTORY 00086000
* TAPEIO - PHYSICALLY PERFORMS THE TAPE FUNCTION REQUESTED 00087000
* KILLEX - IF 'KX' IS ENTERED 00088000
* 00089000
* EXTERNAL REFERENCES - 00090000
* 00091000
* NUCON - NUCLEUS CONSTANTS AREA 00092000
* FSTSECT - FILE STATUS TABLES 00093000
* ADTSECT - ACTIVE DISK TABLES 00094000
* DEVSECT - DEVICE TABLE 00095000
* 00096000
* TABLES/WORKAREAS - 00097000
* 00098000
* CARDOUT - BUFFER FROM WHICH FILES ARE 'DUMPED' 00099000
* CARDIN - BUFFER INTO WHICH FILES ARE 'LOADED' 00100000
* 00101000
* REGISTER USAGE - 00102000
* 00103000
* GPR0,GPR1 = CALLING EXTERNAL ROUTINES 00104000
* GPR3 = A(TAPE PARAMETER LIST) 00105000
* GPR11,GPR12 = BASE REGISTERS 00106000
* GPR14 = LINK REGISTER 00107000
* GPR15 = BRANCH REGISTER, RETURN CODE 00108000
* GPR4, GPR5, GPR6, GPR7, GPR8, GPR9, GPR10 = WORK REGS. 00109000
* GPR13 = A(FVS) 00110000
* 00111000
* NOTES - 00112000
* 00113000
* NONE 00114000
* 00115000
* OPERATION - 00116000
* 00117000
* 1. TAPE LOOKS FOR AN OPTIONS LIST. IF IT FINDS ONE, IT THEN 00118000
* PROCESSES EACH ONE BY SETTING A FLAG IN OPTBYTE OR 00119000
* CHANGING THE ENTRIES IN THE TAPEIO PARAMETER LIST. 00120000
* 00121000
* 2. AFTER ALL OPTIONS HAVE BEEN PROCESSED(IF ANY), IT FINDS 00122000
* THE MODESET BYTE IN THE DEVICE TABLE FOR THE SYMBOLIC TAPE 00123000
* UNIT SPECIFIED IN THE TAPEIO PARAMETER LIST. IF THE 00124000
* USER HAS SPECIFIED A MODESETB(NOW IN THE TAPEIO PARAMETER 00125000
* LIST) IT IS STORED IN THE APPROPRIATE PLACE IN THE DEVICE 00126000
* TABLE. IF NOT, THE MODESET BYTE FROM THE DEVICE TABLE IS 00127000
* STORED IN THE APPROPRIATE SLOT OF THE TAPEIO PARAMETER 00128000
* LIST. 00129000
* THE SAVING OF THE MODE SETTING BETWEEN 00130000
* COMMANDS OCCURS ONLY IF TAPES WITH VIRTUAL ADDRESS 00131000
* IN RANGE OF 180-187, 288-28F (TAP0-TAP7, TAP8-TAPF) ARHRC002DS 00132490
* 00133000
* 3. TAPE LOOKS FOR THE FUNCTION THE USER WANTS PERFORMED. 00134000
* 00135000
* DUMP - 00136000
* 1. FSTLKP IS CALLED TO FIND THE FILE TO BE DUMPED. IF IT IS 00137000
* FOUND, 'HX' IS PREVENTED AND IT'S FST IS ALTERED TO INDI 00138000
* CATE A FIXED LENGTH FILE WITH A RECORD LENGTH OF 800 00139000
* BYTES. THEN EACH RECORD IS READ(VIA RDBUF) AND WRITTEN 00140000
* ONTO TAPE(VIA TAPEIO) UNTIL EOF IS REACHED. 00141000
* 00142000
* 2. AT EOF, THE REAL FST IS WRITTEN AND A CHECK IS MADE TO SEE 00143000
* IF THE USER WANTS TO WTM. IF SO, ONE IS WRITTEN. THEN 00144000
* 2 WTM ARE WRITTEN(VIA TAPEIO) AND BACKSPACED OVER. 00145000
* 00146000
* 3. A CHECK IS MADE TO SEE IF * WAS ENTERED FOR FILENAME, 00147000
* FILETYPE OR FILEMODE. IF SO 1. IS REPEATED. ELSE RETURN. 00148000
* 00149000
* LOAD, SCAN, SKIP(AS INDICATED BY THE SETTING OF A SWITCH) 00150000
* FOR SCANNING OR SKIPPING THE TAPE, 00151000
* 1. THE TAPE IS READ(VIA TAPEIO) UNTIL THE NAME OF THE FILE 00152000
* ENCOUNTERED. IF A FILID HAD BEEN ENTERED, IT IS 00153000
* COMPARED WITH THAT ON THE TAPE FOR A MATCH. 00154000
* FOR LOADING A FILE, EACH RECORD IS READ 00155000
* (VIA TAPEIO) AND WRITTEN INTO A TEMPORARY FILE(TAPE 00156000
* CMSUT1) VIA WRBUF. *WHEN THE LAST RECORD IS READ, THE 00157000
* FILEID (IF GIVEN) IS CHECKED, AND IF MATCH, THE 00158000
* FILE STATUS TABLE AND THE USERS FILE DIRECTORY ARE UPDATED 00159000
* 00160000
* 2. IF THE FILENAME AND FILETYPE MATCHED THE ONE SPECIFIED 00161000
* BY THE USER, RETURN. IF NOT CONTINUE WITH 1. 00162000
* 00163000
* 3. ON EOF, CHECK TO SEE IF THE USER SPECIFIED EOFN. IF SO, 00164000
* SEE IF THE NUMBER OF EOF MARKS HIT EQUALS THE NUMBER 00165000
* SPECIFIED. IF SO RETURN. IF NOT SEE IF THE USER 00166000
* SPECIFIED EOT. IF NOT, RETURN. IF SO, CHECK 00167000
* FOR 2 CONSECUTIVE TAPE MARKS; IF FOUND, STOP. 00168000
* IF ONLY ONE TAPE MARK, CONTINUE AT STEP 1. 00169000
* 00170000
* 00171000
* REW,RUN,ERG,WTM,FSF,FSR,BSF,BSR - 00172000
* 1. THE FUNCTION IS MOVED INTO THE TAPEIO PARAMETER LIST. 00173000
* 00174000
* 2. TAPEIO IS CALLED 'N' TIMES TO PERFORM THE FUNCTION. 00175000
*. 00176000
EJECT 00177000
SPACE 3 00178000
********************************************************************** 00179000
* 00180000
* INITIALIZATION 00181000
* 00182000
********************************************************************** 00183000
DMSTPE START 0 00184000
ENTRY TAPE 00185000
TAPE EQU DMSTPE 00186000
USING *,R12,R11 00187000
LR R12,R15 SET UP ADDRESSIBILITY 00188000
USING TAPE,R12,R11 00189000
LA R11,4095(,R12) IN REGISTER 11 ALSO 00190000
LA R11,1(,R11) 00191000
SSM =X'FF' ENABLE INTERRUPTS V0762 00192000
USING NUCON,R0 SET UP ACCESS TO NUCLEUS AREA 00193000
L R13,AFVS V0403 00194000
USING FVSECT,R13 V0403 00195000
USING TAPEBUF,R10 ADDRESSABILITY FOR I/O BUFFERS @VA03003 00196000
ST R14,SAVER14 SAVE RETURN ADDRESS 00197000
MVI FREESTOR,NOTUSED INDICATE NOT USED @VA04052 00198000
MVI MESSAGE,C' ' INITIALIZE MESSAGE AREA TO BLANK 00199000
MVC MESSAGE+1(L'MESSAGE-1),MESSAGE SET LENGTH OF MSG 00200000
MVC LMSG,=AL2(L'DUMPING+1) INITIALIZE THE LENGTH 00201000
MVC SYMTAPA,TAP1 DEFAULT THE SYMBOLIC DEVICE ADDRESS 00202000
MVC SAVEFN(16),MESSAGE BLANK THE FILEID OF THE INPUT FILE 00203000
MVC SAVEFM(2),=C'A ' DEFAULT FILE MODE TO 'A ' P0953 00204000
MVC STATFM(2),SAVEFM ALSO STATE FILEMODE @VA01313 00205000
MVC EOFN,=AL4(1) DEFAULT EOFN TO 1 00206000
MVI OPTBYTE,X'EC' DEFAULT THE OPTIONS BYTE 00207000
MVI AFSTPLST,X'00' INDICATE FIRST CALL TO FSTLKP 00208000
MVI FLAGS,X'00' INITIALIZE SELECTION FLAGS 00209000
MVI TPEFLG,X'00' INITIALIZE FLAGS 00210000
LA R5,1 SET-UP COUNTER FOR PRINTING, @VA00983 00211000
STH R5,LINECT SO THAT EJECT IS DONE BEFORE @VA00983 00212000
* BEFORE LINE OUTPUT TO PRINTER 00213000
LA R5,OUTTERM INITIALIZE MAP FILE TO TERM 00214000
ST R5,POUTPUT 00215000
MVI MODESETB,X'00' SET MODESET BYTE TO DEFAULT 00216000
LA R1,0(,R1) ZERO OUT THE HIGH ORDER BYTE 00217000
LR R3,R1 LET R3 CONTAIN A(PLIST) 00218000
CLI 8(R3),X'FF' ANY FUNCTION SPECIFIED 00219000
BE ERROR047 NO, RETURN ERROR MSG 00220000
LM R5,R7,INDEXS SET UP BXLE LOOP 00221000
TAPE05 EQU * SEE WHICH TAPE FUNCTION SPECIFIED 00222000
CLC 8(8,R3),0(R5) IS THIS THE FUNCTION SPECIFIED 00223000
BE TAPE06 SET THE FLAG AND BRANCH POINT 00224000
BXLE R5,R6,TAPE05 NO, SEE IF IT'S THE NEXT FUNCTION 00225000
B ERROR014 NONE OF THE ABOVE, RETURN ERROR 00226000
TAPE06 EQU * SET FLAGS AND BRANCH POINT FOR FUNCTION 00227000
OC FLAGS,8(R5) SET THE FLAG 00228000
L R9,8(R5) SET THE BRANCH POINT @VA03003 00229000
LA R1,16(,R1) POINT TO PARAMETER PAST FUNCTION 00230000
TAPE07 EQU * DETERMINE IF OPTIONS LIST 00231000
CLI 0(R1),C'(' IS IT BEGINNING OF OPTIONS LIST 00232000
BE TAPE08 YES, SAVE THE POINTER 00233000
CLI 0(R1),X'FF' IS IT END OF COMMAND LINE 00234000
BE TAPE08 YES, SAVE THE POINTER 00235000
LA R1,8(,R1) POINT TO NEXT PARAMETER 00236000
B TAPE07 SEE IF THIS BEGINS OPTION LIST 00237000
TAPE08 EQU * 00238000
ST R1,SAVER1 SAVE A(BEGINNING OF OPTIONS OR FENCE) 00239000
CLI 0(R1),X'FF' NO OPTIONS, HIT END OF PLIST ? 00240000
BE TAPE300 YES, SEE WHICH OPTIONS WERE SPECIFIED 00241000
TAPE10 EQU * 00242000
LA R1,8(,R1) CHECK FIRST (OR NEXT) OPTION SPECIFIED 00243000
CLI 0(R1),FF END OF COMMAND LINE? @VA07150 00244000
BE TAPE300 BRANCH IF YES, PROCESS @VA07150 00245000
LA R5,FIRSTOPT POINT TO FIRST OPTION 00246000
LA R6,12 BXLE INCREMENT 00247000
LA R7,AFTRLST END OF OPTION DEFINITION TABLE 00248000
LR R8,R1 GET POINTER TO OPTION 00249000
LA R15,EIGHT SET LENGTH OF PLIST ELEM. @VA07150 00250000
TAPE13 CLI 0(R8),C' ' IS THIS END OF OPTION 00251000
BE TAPE15 YES, GO SET ITS LENGTH 00252000
LA R8,1(,R8) SEE IF NEXT CHAR. IS A BLANK 00253000
BCT R15,TAPE13 AND LOOP FOR LENGTH OF ELEM. @VA07150 00254000
TAPE15 EQU * DETERMINE LENGTH OF OPTION 00255000
SR R8,R1 BY SUBRACTING OUT START OF OPTION 00256000
STC R8,CHLINK SAVE THE LENGTH OF THE OPTION 00257000
BCTR R8,R0 LESS 1 FOR CLC 00258000
TAPE20 EQU * 00259000
CLC CHLINK(1),8(R5) CHECK MIN LENGTH P0735 00260000
BL TAPE23 IF LOW, ERROR P0735 00261000
EX R8,COMPOPT IS THIS THE OPTION SPECIFIED 00262000
BE TAPE45 FOUND OPTION, SET IT'S FLAGS 00263000
TAPE23 EQU * 00264000
BXLE R5,R6,TAPE20 MATCH ALL OPTIONS 00265000
* 00266000
* SEE IF CUU WAS SPECIFIED 00267000
* 00268000
TM 0(R1),X'F0' SEE IF IT'S A NUMBER 00269000
BNO ERROR003 NO, INVALID ARGUMENT 00270000
CLI 3(R1),C' ' IS 4TH BYTE BLANK? P0917 00271000
BNE ERROR017 NO, INVALID ADDR P0917 00272000
* 00273000
* ASSUME CUU AND CONVERT TO BINARY 00274000
* 00275000
XC DBLWRD1(L'DBLWRD1+L'DBLWRD2),DBLWRD1 ZERO CONV. AREA 00276000
MVC DBLWRD1+5(3),0(R1) MOVE CCU TO LAST 3 BYTES 00277000
PACK DBLWRD2,DBLWRD1 REMOVE ZONES 00278000
L R4,DBLWRD2+4 GET THE HEX NUMBER 00279000
SRL R4,4 SHIFT OFF THE SIGN BITS 00280000
* 00281000
* FIND IT'S SYMBOLIC NAME IN THE DEVICE TABLE 00282000
* 00283000
L R5,ADEVTAB A(DEVICE TABLE) 00284000
USING DEVSECT,R5 00285000
LA R6,DEVSIZE LENGTH OF AN ENTRY IN THE DEVICE TABLE 00286000
L R7,ATABEND A(END OF DEVICE TABLE) 00287000
TAPE30 EQU * START THE BXLE LOOP HERE 00288000
CH R4,DEVADDR DOES CUU MATCH ONE IN DEVICE TABLE 00289000
BE TAPE40 YES, PICK UP IT'S SYMBOLIC NAME 00290000
BXLE R5,R6,TAPE30 KEEP MATCHING 00291000
B ERROR017 NO MATCH, RETURN ERROR TO CALLER 00292000
TAPE40 EQU * PICK UP SYMBOLIC NAME 00293000
MVC SYMTAPA,DEVNAME MOVE TO TAPEIO PARAMETER LIST 00294000
B TAPE10 ANY MORE OPTIONS ? 00295000
SPACE 2 00296000
TAPE45 EQU * GET THE ADDRESS OF THE OPTION PROCESSOR 00297000
L R5,8(,R5) FROM THE TABLE 00298000
BR R5 SET THE FLAGS, ETC. 00299000
SPACE 2 00300000
* 00301000
* OPTIONS LIST AND BRANCH POINT 00302000
* 00303000
FIRSTOPT DS 0F 00304000
DC CL8'TAP0' TAP0 HRC002DS 00305190
DC AL1(4),AL3(TAPE50) HRC002DS 00305380
TAP1 DC CL8'TAP1' TAP1 HRC002DS 00305570
DC AL1(4),AL3(TAPE50) 00306000
DC CL8'TAP2' TAP2 00307000
DC AL1(4),AL3(TAPE50) 00308000
DC CL8'TAP3' TAP3 00309000
DC AL1(4),AL3(TAPE50) 00310000
DC CL8'TAP4' TAP4 00311000
DC AL1(4),AL3(TAPE50) HRC002DS 00312030
DC CL8'TAP5' TAP5 HRC002DS 00312060
DC AL1(4),AL3(TAPE50) HRC002DS 00312090
DC CL8'TAP6' TAP6 HRC002DS 00312120
DC AL1(4),AL3(TAPE50) HRC002DS 00312150
DC CL8'TAP7' TAP7 HRC002DS 00312180
DC AL1(4),AL3(TAPE50) HRC002DS 00312210
DC CL8'TAP8' TAP8 HRC002DS 00312240
DC AL1(4),AL3(TAPE50) HRC002DS 00312270
DC CL8'TAP9' TAP9 HRC002DS 00312300
DC AL1(4),AL3(TAPE50) HRC002DS 00312330
DC CL8'TAPA' TAPA HRC002DS 00312360
DC AL1(4),AL3(TAPE50) HRC002DS 00312390
DC CL8'TAPB' TAPB HRC002DS 00312420
DC AL1(4),AL3(TAPE50) HRC002DS 00312450
DC CL8'TAPC' TAPC HRC002DS 00312480
DC AL1(4),AL3(TAPE50) HRC002DS 00312510
DC CL8'TAPD' TAPD HRC002DS 00312540
DC AL1(4),AL3(TAPE50) HRC002DS 00312570
DC CL8'TAPE' TAPE HRC002DS 00312600
DC AL1(4),AL3(TAPE50) HRC002DS 00312630
DC CL8'TAPF' TAPF HRC002DS 00312660
DC AL1(4),AL3(TAPE50) HRC002DS 00312690
DC CL8'WTM' WTM 00313000
DC AL1(3),AL3(TAPE65) 00314000
DC CL8'NOWTM' NOWTM 00315000
DC AL1(5),AL3(TAPE70) 00316000
DC CL8'EOF' EOF 00317000
DC AL1(3),AL3(TAPE60) 00318000
DC CL8'EOT' EOT 00319000
DC AL1(3),AL3(TAPE80) 00320000
DC CL8'NOPRINT' NOPRINT 00321000
DC AL1(4),AL3(TAPE90) 00322000
DC CL8'TERM' TERM 00323000
DC AL1(1),AL3(TAPE100) 00324000
DC CL8'PRINT' PRINT 00325000
DC AL1(2),AL3(TAPE110) 00326000
DC CL8'DISK' DISK 00327000
DC AL1(4),AL3(TAPE120) 00328000
DC CL8'7TRACK' 7TRACK 00329000
DC AL1(6),AL3(TAPE130) 00330000
DC CL8'9TRACK' 9TRACK 00331000
DC AL1(6),AL3(TAPE140) 00332000
DC CL8'DEN' DEN 00333000
DC AL1(3),AL3(TAPE150) 00334000
DC CL8'TRTCH' TRTCH 00335000
DC AL1(5),AL3(TAPE160) 00336000
DC CL8')' END OF OPTIONS LIST 00337000
DC AL1(1),AL3(TAPE300) 00338000
AFTRLST EQU *-12 END OF OPTIONS LIST 00339000
EJECT 00340000
TAPE50 EQU * USER MODIFIES I/O UNIT 00341000
MVC SYMTAPA,0(R1) MOVE USER SYMBOLIC TAPE ADDRESS TO PLIST 00342000
B TAPE10 ANY MORE OPTIONS ? 00343000
* 00344000
TAPE60 EQU * USER MODIFIES EOFN 00345000
TM FLAGS,LOADSWT+SCNSWT+SKPSWT LOAD, SCAN, OR SKIP 00346000
BZ ERROR003 NO, INVALID OPTION 00347000
LA R1,8(,R1) POINT TO THE NUMBER OF 'EOF' 'S 00348000
XC DBLWRD1(L'DBLWRD1+L'DBLWRD2),DBLWRD1 ZERO CONV. AREA 00349000
CLI 0(R1),C'0' P0735 00350000
BL ERROR029 ERROR IF NOT 0 - 9 P0735 00351000
CLI 0(R1),C'9' P0735 00352000
BH ERROR029 P0735 00353000
LA R6,0(,R1) POINT TO BEGINNING OF NUMBER 00354000
LA R4,1(,R1) POINT TO BEGINNING OF NUMBER +1 00355000
LA R5,0 R5 = NUMBER OF N'S IN EOFN 00356000
TAPE61 EQU * 00357000
CLI 0(R4),X'40' ANY MORE N'S ? 00358000
BE TAPE62 NO 00359000
CLI 0(R4),C'0' P0735 00360000
BL ERROR029 ERROR IF NOT 0 - 9 P0735 00361000
CLI 0(R4),C'9' P0735 00362000
BH ERROR029 P0735 00363000
LA R4,1(,R4) INCREMENT ADDRESS 00364000
LA R5,1(,R5) ADD 1 N 00365000
CH R5,=H'7' NO MORE THAN 8 ALLOWED 00366000
BL TAPE61 CONTINUE 00367000
TAPE62 EQU * 00368000
LA R4,DBLWRD1+7 A(DBLWRD1) 00369000
SR R4,R5 NUM. CHARS. TO MOVE NOT MORE THAN 8 00370000
EX R5,MVCNUM MOVE THE NUMBER TO A DOUBLE WORD 00371000
PACK DBLWRD2,DBLWRD1 PUT NUMBER INTO PACKED FORMAT 00372000
SR R4,R4 ZERO R4 00373000
CVB R4,DBLWRD2 CONVERT NUMBER TO BINARY 00374000
ST R4,EOFN STORE THE NUMBER 00375000
NI OPTBYTE,255-NOEOFN SET NOEOFN STATUS FLAG OFF 00376000
OI OPTBYTE,NOEOT SET EOT STATUS FLAG ON 00377000
B TAPE10 ANY MORE OPTIONS ? 00378000
* 00379000
TAPE65 EQU * USER MODIFIES WTM 00380000
TM FLAGS,DUMPSWT DUMP 00381000
BZ ERROR003 NO, INVALID OPTION 00382000
NI OPTBYTE,255-NOWTM SET WTM STATUS FLAG OFF 00383000
B TAPE10 ANY MORE OPTIONS ? 00384000
* 00385000
TAPE70 EQU * USER SPECIFIES NOWTM 00386000
TM FLAGS,DUMPSWT DUMP 00387000
BZ ERROR003 NO, INVALID OPTION 00388000
OI OPTBYTE,NOWTM SET WTM STATUS FLAG ON 00389000
B TAPE10 ANY MORE OPTIONS ? 00390000
* 00391000
TAPE80 EQU * USER SPECIFIES EOT 00392000
TM FLAGS,LOADSWT+SKPSWT+SCNSWT LOAD, SKIP OR SCAN 00393000
BZ ERROR003 NO, INVALID OPTION 00394000
NI OPTBYTE,255-NOEOT SET NOEOT STATUS FLAG OFF 00395000
OI OPTBYTE,NOEOFN SET NOEOFN STATUS FLAG ON 00396000
B TAPE10 ANY MORE OPTIONS ? 00397000
* 00398000
TAPE90 EQU * USER SPECIFIES NOPRINT 00399000
TM FLAGS,DUMPSWT+LOADSWT+SCNSWT+SKPSWT 00400000
BZ ERROR003 NO, INVALID OPTION 00401000
OI OPTBYTE,NOPRINT+NOTERM+NODISK NO OUTPUT MESSAGES REQUEST 00402000
B TAPE10 ANY MORE OPTIONS ? 00403000
* 00404000
TAPE100 EQU * USER SPECIFIES TERM 00405000
TM FLAGS,DUMPSWT+LOADSWT+SCNSWT+SKPSWT 00406000
BZ ERROR003 NO, INVALID OPTION 00407000
LA R5,OUTTERM A(TYPLIN PARAMETER LIST) 00408000
ST R5,POUTPUT 00409000
NI OPTBYTE,255-NOTERM SEND MESSAGES TO TERMINAL 00410000
OI OPTBYTE,NOPRINT+NODISK NOT TO PRINTER OR DISK 00411000
B TAPE10 ANY MORE OPTIONS ? 00412000
* 00413000
TAPE120 EQU * USER SPECIFIES DISK 00414000
TM FLAGS,DUMPSWT+LOADSWT+SCNSWT+SKPSWT 00415000
BZ ERROR003 NO, INVALID OPTIN 00416000
ST R1,DBLWRD1 SAVE R1 IN TEMPORARY STORAGE 00417000
LA R1,PERASE ERASE 'TAPE MAP A5' IF IT EXISTS @VA11834 00418000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 00419000
L R15,AERASE ERASE @V305066 00420000
BALR R14,R15 ... @V305066 00421000
SSM TPEENA ENABLE INTERRUPTS @VA06258 00422000
LA R5,OUTDISK A(WRBUF PARAMETER LIST) 00423000
ST R5,POUTPUT 00424000
MVC OUTCOMM,WRBUF SET COMMAND TO WRITE @VA00898 00425000
NI OPTBYTE,255-NODISK SEND MESSAGES TO A DISK FILE 00426000
OI OPTBYTE,NOTERM+NOPRINT NOT TO THE TERMINAL OR PRINTER 00427000
L R1,DBLWRD1 GET R1 BACK 00428000
B TAPE10 ANY MORE OPTIONS ? 00429000
* 00430000
TAPE110 EQU * USER SPECIFIES PRINT 00431000
TM FLAGS,DUMPSWT+LOADSWT+SCNSWT+SKPSWT 00432000
BZ ERROR003 NO, INVALID OPTION 00433000
LA R5,OUTPRINT A(PRINTIO PARAMTER LIST) 00434000
ST R5,POUTPUT 00435000
NI OPTBYTE,255-NOPRINT SEND MESSAGES TO THE PRINTER 00436000
OI OPTBYTE,NOTERM+NODISK NOT TO THE TERMINAL OR DISK 00437000
B TAPE10 ANY MORE OPTIONS ? 00438000
* 00439000
TAPE130 EQU * USER SPECIFIES 7TRACK 00440000
TM FLAGS,DENSITY DENSITY BEEN SET ? V0312 00441000
BNO RESET7 NO...RESET MODE V0312 00442000
TM TPEFLG,NINETK HAS 9TRACK BEEN SET ? @V200414 00443000
BO RESET7 YES..RESET 7TRACK @V200414 00444000
TM MODESETB,DRESET 800 9TK SET ? V0312 00445000
BO RESET7 YES...RESET MODE V0312 00446000
TM MODESETB,PCT TRTCH DONE ? V0312 00447000
BO TAPE10 YES...GET NEXT OPT. V0312 00448000
NI MODESETB,KEEPDEN7 STRIP ALL BUT DENSITY BITS V0312 00449000
OI MODESETB,TRTCHOC RESET MODE 7 TRACK V0312 00450000
B TAPE10 GET NEXT OPT. V0312 00451000
RESET7 MVI MODESETB,RESETM7 RESET MODE 7 TRACK V0312 00452000
NI TPEFLG,NINEOFF INDICATE 7TRACK SET @V200414 00453000
B TAPE10 GET NEXT OPTION V0312 00454000
* 00455000
TAPE140 EQU * USER SPECIFIES 9TRACK 00456000
TM TPEFLG,NINETK HAS 9TRACK BEEN SET ? @V200414 00457000
BO TAPE10 YES..GET NEXT OPTION @V200414 00458000
OI TPEFLG,NINETK NO..SET IT @V200414 00459000
MVI MODESETB,DRESET @V200414 00460000
B TAPE10 ANY MORE OPTIONS ? 00461000
* 00462000
TAPE150 EQU * USER SPECIFIES DEN 00463000
OI FLAGS,DENSITY INDICATE THAT DENSITY HAS BEEN SET 00464000
LA R1,8(,R1) ADVANCE OPTION POINTER TO DEN SPECIFIED 00465000
CLC C6250,0(R1) DEN=6250? @VA07148 00466000
BE TAPE157 BRANCH IF YES @VA07148 00467000
CLC =C'1600 ',0(R1) DID THE USER WANT DEN=1600 00468000
BE TAPE153 YES, SET IT 00469000
CLC =C'800 ',0(R1) DEN=800 ? 00470000
BE TAPE154 YES, SET IT 00471000
TM TPEFLG,NINETK HAS 9TRACK BEEN SET @V200414 00472000
BO TAPE156 YES..SET 7TRACK RESET @V200414 00473000
TM MODESETB,PCT HAVE THE CONV. TRAN. BITS BEEN SET ? 00474000
BZ TAPE156 NO, SET THEM FIRST, THEN CHECK DEN 00475000
NI MODESETB,KEEPTRK7 YES, AND OUT THE DENSITY BITS ONLY 00476000
TAPE151 EQU * SEE WHICH DENSITY WAS SPECIFIED ? 00477000
CLC =C'556 ',0(R1) DEN=556 ? 00478000
BE TAPE152 YES, SET IT 00479000
CLC =C'200 ',0(R1) DEN=200 ? 00480000
BNE ERROR029 NO, NOTHING LEFT, RETURN ERROR 00481000
B TAPE10 YES, ALL SET, RETURN 00482000
TAPE152 EQU * DEN=556 00483000
OI MODESETB,D556 SET THE DENSITY BITS IN THE MODESET 00484000
B TAPE10 ANY MORE OPTIONS ? 00485000
TAPE153 EQU * DEN=1600 00486000
MVI MODESETB,DRESET SET THE DENSITY AND THE MODESET 00487000
OI TPEFLG,NINETK SET 9TRACK INDICATOR @V200414 00488000
B TAPE10 ANY MORE OPTIONS ? 00489000
TAPE154 EQU * DEN=800 00490000
TM TPEFLG,NINETK HAS 9TRACK BEEN SET ? @V200414 00491000
BO TAPE155 YES..SET RESET MODE @V200414 00492000
TM MODESETB,PCT HAVE THE CONV. TRANS. BITS BEEN SET ? 00493000
BZ TAPE155 NO, SET DEN=800 FOR 9 TRACK TAPE 00494000
NI MODESETB,KEEPTRK7 YES, ZERO ONLY THE DENSITY BITS 00495000
OI MODESETB,D8007TRK SET ONLY THE DENSITY BITS 00496000
B TAPE10 ANY MORE OPTIONS 00497000
TAPE155 EQU * DEN=800 FOR 9 TRACK TAPES 00498000
MVI MODESETB,D8009TRK SET THE MODESET BYTE 00499000
OI TPEFLG,NINETK SET 9TRACK INDICATOR @V200414 00500000
B TAPE10 ANY MORE OPTIONS ? 00501000
TAPE156 EQU * SET THE CONV. TRANS. BITS FOR 7TRACK TAPE 00502000
MVI MODESETB,TRTCHOC 7 TRK RESET V0312 00503000
B TAPE151 SEE IF DEN=200 OR DEN=556 00504000
* 00505000
TAPE157 EQU * @V200414 00506000
MVI MODESETB,D6250 SET MODESET BYTE @V200414 00507000
OI TPEFLG,NINETK SET 9TRACK INDICATOR @V200414 00508000
B TAPE10 GET NEXT OPTION @V200414 00509000
* 00510000
TAPE160 EQU * USER SPECIFIES TRTCH 00511000
TM MODESETB,DRESET SEE IF 9TRACK IS SPECIFIED 00512000
BO SETD7TRK RESET DENSITY TO 800BPI FOR 7 TRACK 00513000
TM FLAGS,DENSITY HAS ANY DENSITY BEEN SPECIFIED ? 00514000
BO SETRTCH YES, SET TRTCH 00515000
SETD7TRK EQU * SET DENSITY=800BPI FOR 7 TRACK 00516000
MVI MODESETB,D8007TRK 00517000
OI FLAGS,DENSITY SET DENSITY FLAG V0312 00518000
SETRTCH EQU * SET TRTCH 00519000
NI MODESETB,KEEPDEN7 LEAVE ONLY THE DENSITY SETTING 00520000
LA R1,8(,R1) ADVANCE POINTER TO TRTCH SETTING 00521000
CLC =C'OC ',0(R1) 'OC' SPECIFIED ? 00522000
BE TAPE161 YES, SET MODESET 00523000
CLC =C'OT ',0(R1) 'OT' SPECIFIED ? 00524000
BNE TAPE163 NO, CHECK THE OTHERS 00525000
OI MODESETB,TRTCHOT SET MODESET 00526000
B TAPE10 ANY MORE OPTIONS ? 00527000
TAPE161 EQU * 00528000
OI MODESETB,TRTCHOC SET MODESET FOR 'OC' 00529000
B TAPE10 ANY MORE OPTIONS ? 00530000
TAPE163 EQU * 00531000
CLC =C'ET ',0(R1) 'ET' SPECIFIED ? 00532000
BE TAPE165 YES, SET MODESET 00533000
CLC =C'E ',0(R1) 'E ' SPECIFIED ? 00534000
BNE TAPE167 NO, SEE IF 'O' 00535000
OI MODESETB,TRTCHE SET 'E' MODESET 00536000
B TAPE10 ANY MORE OPTIONS ? 00537000
TAPE165 EQU * 00538000
OI MODESETB,TRTCHET 00539000
B TAPE10 ANY MORE OPTIONS ? 00540000
TAPE167 EQU * SEE IF TRTCH = O 00541000
CLC =C'O ',0(R1) 'O' SPECIFIED ? 00542000
BNE ERROR029 NO, RETURN WITH ERROR 00543000
OI MODESETB,TRTCHO SET MODESET FOR 'O' 00544000
B TAPE10 ANY MORE OPTIONS ? 00545000
EJECT 00546000
* 00547000
* IF THE USER SPECIFIED A MODESET BYTE, STORE IT IN 00548000
* THE DEVICE TABLE. IF NOT PICK UP THE THE ONE IN THE 00549000
* DEVICE TABLE AND STORE IT IN TAPEIO PARAMETER LIST. 00550000
* 00551000
TAPE300 EQU * 00552000
L R5,ADEVTAB A(DEVICE TABLE) 00553000
LA R6,DEVSIZE LENGTH OF AN ENTRY IN THE DEVICE TABLE 00554000
L R7,ATABEND A(END OF DEVICE TABLES) 00555000
TAPE301 EQU * BEGIN BXLE LOOP HERE 00556000
CLC DEVNAME,SYMTAPA DO SYMBOLIC DEVICE NAMES MATCH ? 00557000
BE TAPE302 YES, TAPE UNIT = ONE IN DEVICE TABLE 00558000
BXLE R5,R6,TAPE301 KEEP COMPARING 00559000
B ERROR027 NO MATCH, RETURN TO CALLER 00560000
* 00561000
* CHECK MODESET BYTE IN DEVICE TABLE 00562000
* 00563000
TAPE302 EQU * 00564000
MVC TAPECCU,DEVADDR SAVE THE CCU OF THE TAPE 00565000
LR R10,R5 SAVE DEVICE TABLE POINTER @VA03003 00566000
LH R5,DEVADDR PROVIDE CP VIRTUAL DEV ADDR P0917 00567000
DC X'83560024' DIAGNOSE TO CHECK FEATURES P0917 00568000
BC 1,ERROR113 ERR IF NOT ATTACHED P0917 00569000
CLM R7,B'1000',CLASTAPE IF DEVICE EXISTS, CHEK TAPE P0917 00570000
BNE ERROR027 IF NOT TAPE, INVALID DEVICE P0917 00571000
LR R5,R10 RESTORE DEVICE TABLE POINTER @VA03003 00572000
CLI MODESETB,X'00' HAS THE USER SPECIFIED THE MODESET BYTE 00573000
BNE STDEVTAB YES, STORE IT IN THE DEVICE TABLE 00574000
MVC MODESETB,DEVMISC NO, USE THE ONE IN THE DEVICE TABLE 00575000
ST R7,FDIAG STORE REAL DEV INFO @VA08371 00575100
CLI MODESETB,X'00' IS IT STILL 00 @VA08371 00575200
BNE TAPE303 MODSETB IS SET @VA08371 00575300
TM FDIAG+3,FTRDLDNS DUAL DENSITY DRIVE ? @VA08371 00575400
BNO TAPE303 IF NOT DEN ALL SET @VA08371 00575500
OI MODESETB,DRESET SET DEFAULT FOR DUAL DEN @VA08371 00575600
* TAPE DRIVES AS 1600 BPI 00575700
B STORMODE AND STORE IN DEVTBL @VA08371 00576100
STDEVTAB EQU * SAVE THE USER'S MODESET IN THE DEVICE TBL 00577000
ST R7,FDIAG SAVE REAL DEVICE INFO. P0917 00578000
TM MODESETB,TRACK9 P0917 00579000
BO TEST9TRK DROP TO CHEK 9TRACK SETTING P0917 00580000
SPACE 1 00581000
TM FDIAG+3,FTR7TRK CHEK 7TRACK FEATURE P0917 00582000
LA R8,ERR7TRK P0917 00583000
BZ ERR115S ERR IF NO 7TRK FEAT. P0917 00584000
TM MODESETB,D200+D556+D8007TRK BETTER BE 7 TRK @VA03003 00585000
BNZ TTRANS DENSITY SETTING ... @VA03003 00586000
LA R8,ERRDLDNS OTHERWISE, ERROR @VA02112 00587000
B ERR115S PRINT ERROR MESSAGE @VA02112 00588000
TTRANS TM MODESETB,TRTCHET TRANSLATION WANTED? @VA02112 00589000
BNO TESTOC NO, CHEK CONVERSION P0917 00590000
TM FDIAG+3,FTRTRANS YES, CHEK FEATURE P0917 00591000
LA R8,ERRTRANS P0917 00592000
BZ ERR115S ERR IF NO TRANS. FEAT. P0917 00593000
TESTOC EQU * P0917 00594000
TM MODESETB,TRTCHOC DATA CONVERSION WANTED? P0917 00595000
BNO STORMODE NO, WE'RE SAFE P0917 00596000
TM FDIAG+3,FTRDCONV YES, CHEK FEATURE P0917 00597000
LA R8,ERRDCONV P0917 00598000
BZ ERR115S P0917 00599000
B STORMODE WE'RE SAFE P0917 00600000
SPACE 1 00601000
TEST9TRK EQU * P0917 00602000
TM FLAGS,DENSITY DENSITY SPECIFIED? P0917 00603000
BZ STORMODE IF NOT, NO SENSE CHEKING P0917 00604000
TM MODESETB,D6250 6250 BPI ? @V200414 00605000
BO TEST6250 YES..CHECK FOR FEATURE @V200414 00606000
TM FDIAG+1,TYP3420 3420 TAPE DRIVE? @VA02112 00607000
BO TEST3420 YES, DO SPECIFIC CHECKS @VA02112 00608000
TM FDIAG+1,TYP2420 2420 TAPE DRIVE? @VA02112 00609000
BO TEST2420 YES, DO SPECIFIC CHECKS @VA02112 00610000
TESTMOD TM MODESETB,D8009TRK IS IT 800 BPI, 9 TRACK? @VA02112 00611000
BNO TESTMOD2 NO, CHECK FOR HIGHER MODELS @VA02112 00612000
CLM R7,B'0010',MODEL3 MODEL 3 OR LESS? @VA02112 00613000
BNH STORMODE YES, OKAY @VA02112 00614000
B TESTDDEN DO MORE CHECKS @VA02112 00615000
TESTMOD2 TM FDIAG+1,TYP2401 2401 TAPE DRIVE? @VA02112 00616000
BNO TESTMOD3 NO, CONTINUE CHECKING @VA02112 00617000
CLM R7,B'0010',MODEL8 IS IT MODEL 8? @VA02112 00618000
BL TESTMOD3 NO, CONTINUE CHECKING @VA02112 00619000
LA R8,ERR9TRK ERROR, 9 TRACK NOT SUPPORTED @VA02112 00620000
B ERR115S PRINT ERROR MESSAGE @VA02112 00621000
TESTMOD3 CLM R7,B'0010',MODEL3 HIGHER THAN MODEL 3? @VA02112 00622000
BH STORMODE YES, OKAY @VA02112 00623000
TESTDDEN TM FDIAG+3,FTRDLDNS DUAL DENSITY? @VA02112 00624000
LA R8,ERRDLDNS GET ERROR MSG ADDR. IN CASE @VA02112 00625000
BZ ERR115S NO, ERROR @VA02112 00626000
B STORMODE OTHERWISE, OKAY @VA02112 00627000
TEST2420 EQU * @VA02112 00628000
TM MODESETB,D8009TRK 800 BPI, 9 TRACK? @VA02112 00629000
LA R8,ERR800BP GET ADDRESS JUST IN CASE @VA02112 00630000
BO ERR115S YEP, IT'S AN ERROR @VA02112 00631000
CLM R7,B'0010',MODEL5 MODEL 5? @VA02112 00632000
BE STORMODE YES, OKAY @VA02112 00633000
CLM R7,B'0010',MODEL7 MODEL 7? @VA02112 00634000
BE STORMODE YES, OKAY @VA02112 00635000
LA R8,ERRDLDNS GET ADDRESS @VA02112 00636000
B ERR115S PRINT ERROR MESSAGE @VA02112 00637000
TEST3420 CLM R7,B'0010',MODEL3 MODEL 3 OR LESS? @VA02112 00638000
BNH TST34208 GO CHECK 800 BPI @VA04963 00639000
CLM R7,B'0010',MODEL5 MODEL 5? @VA02112 00640000
BE TST34208 GO CHECK 800 BPI @VA04963 00641000
CLM R7,B'0010',MODEL7 MODEL 7? @VA02112 00642000
BE TST34208 GO CHECK 800 BPI @VA04963 00643000
TM MODESETB,D8009TRK 800 BPI? @VA02112 00644000
LA R8,ERR800BP GET ADDRESS @VA02112 00645000
BO ERR115S YES, ERROR 800 BPI NOT SUPPORTED @VA02112 00646000
LA R8,ERR16BP GET ERROR ADDRESS @VA04963 00647000
TM FDIAG+3,FTRDLDNS DUAL DENSITY FEATURE? @VA04963 00648000
BZ ERR115S 1600 NOT SUPPORTED FOR 4,6,8 @VA04963 00649000
B STORMODE OTHERWISE, OK @VA04963 00650000
TST34208 EQU * @VA04963 00651000
TM MODESETB,D8009TRK IS THIS 800 BPI ? @VA05789 00652000
BNO STORMODE BRANCH IF NOT @VA04963 00653000
LA R8,ERR800BP GET ERROR ADDRESS @VA04963 00654000
TM FDIAG+3,FTRDLDNS DUAL DENSITY FEATURE? @VA04963 00655000
BZ ERR115S 800 BPI NOT SUPPORTED @VA04963 00656000
B STORMODE OTHERWISE, OK @VA04963 00657000
TEST6250 TM FDIAG+1,TYP3420 3420 TAPE DRIVE? @VA02112 00658000
BZ HIERR NO, ERROR @VA02112 00659000
CLM R7,B'0010',MODEL3 MODEL 3 OR LESS? @VA02112 00660000
BNH HIERR YES, ERROR @VA02112 00661000
CLM R7,B'0010',MODEL5 MODEL 5? @VA02112 00662000
BE HIERR YES, ERROR @VA02112 00663000
CLM R7,B'0010',MODEL7 MODEL 7? @VA02112 00664000
BNE STORMODE NO, THIS IS OKAY @VA02112 00665000
HIERR LA R8,ERRHIDEN YES..ERROR @V200414 00666000
B ERR115S SAY SO.. @V200414 00667000
STORMODE EQU * P0917 00668000
LR R5,R10 RESTORE DEVICE TABLE POINTER @VA03003 00669000
MVC DEVMISC(1),MODESETB SET MODESET IN DEVTAB @V305066 00670000
TAPE303 EQU * 00671000
DMSFREE DWORDS=202 @VA03003 00672000
STM R0,R1,FREESTOR SAVE FREE STOR INFO FOR FRET @VA03003 00673000
LR R10,R1 PERMANENT ADDRESSABLIITY @VA03003 00674000
SPACE 1 00675000
SR R7,R7 NOW CLEAR THE FREE STOR @VA03003 00676000
SLL R0,3 OBTAINED, USING MVCL @VA03003 00677000
LR R1,R0 .... @VA03003 00678000
L R0,FREESTOR+4 .... @VA03003 00679000
MVCL R0,R6 .... @VA03003 00680000
SPACE 1 00681000
************************************************************** 00682000
* INITIALIZE PLISTS AND ADDRESS REFERENCES 00683000
* TO FREE STORAGE AREA AND ALSO TAPE HEADER 00684000
************************************************************** 00685000
MVC CARDOUT(4),HEADER @VA03003 00686000
LA R7,CARDOUT @VA03003 00687000
STCM R7,B'0111',AIOBUFF @VA03003 00688000
STCM R7,B'0111',ACARDOUT @VA03003 00689000
LA R7,DATAIN @VA03003 00690000
ST R7,WRBUFF @VA03003 00691000
LA R7,DATAOUT @VA03003 00692000
ST R7,INBUFF @VA03003 00693000
LA R7,CARDIN @VA03003 00694000
STCM R7,B'0111',ACARDIN @VA03003 00695000
SPACE 1 00696000
BR R9 BRANCH TO FUNCTION SPECIFIED @VA03003 00697000
EJECTRTN EQU * @VA00983 00698000
L R1,POUTPUT A(OUTPUT MESSAGE PLIST) @VA00983 00699000
CL R1,=A(OUTPRINT) IS OUTPUT GOING TO PRINTER? @VA00983 00700000
BNE EXECSVC1 NO, REGULAR PROCESSING @VA00983 00701000
LH R2,LINECT YES @VA03003 00702000
BCT R2,EXECSVC2 IS IT TIME TO EJECT ? @VA03003 00703000
MVI CARCTL,X'8B' YES, EJECT @VA00983 00704000
LA R2,55 SET-UP COUNTER TO ALLOW @VA03003 00705000
* 55 MORE LINES BEFORE NEXT EJECT 00706000
SVC 202 GO DO EJECT @VA00983 00707000
DC AL4(*+4) NO-OP ERROR RETURN @VA00983 00708000
MVI CARCTL,X'09' SPACE CONTROL IS NOW AT THE @VA00983 00709000
* BEGINNING OF EACH OUTPUT LINE 00710000
EXECSVC2 STH R2,LINECT STORE LINE COUNTER @VM03203 00711000
SVC 202 OUTPUT THE MESSAGE @VM03203 00712000
DC AL4(PRTERR) PRINT ERROR RETURN @VM03203 00713000
BR R14 RETURN TO CALLER @VM03203 00714000
PRTERR CH R15,=H'2' CHANNEL 12 SENSED ? @VM03203 00715000
BE CLR NOT A GREAT PROBLEM @VM03203 00716000
CH R15,=H'3' CHANNEL 9 SENSED ? @VM03203 00717000
BCR 7,R14 RETURN THIS ERROR TO CALLER @VM03203 00718000
CLR SR R15,R15 IGNORE CHAN 9 OR 12 @VM03203 00719000
BR R14 RETURN TO CALLER @VM03203 00720000
EXECSVC1 SVC 202 OUTPUT THE MESSAGE @VM03203 00721000
DC AL4(*+4) NO-OP ERROR RETURN @VA00983 00722000
BR R14 RETURN @VA00983 00723000
EJECT 00724000
* 00725000
* TAPE DUMP 00726000
* 00727000
TPDUMP EQU * 00728000
USING FSTSECT,R1 FILE STATUS BLOCK 00729000
L R5,SAVER1 A(BEGINNING OF OPTIONS LIST OR FENCE) 00730000
SR R5,R3 MINUS A(BEGINNING OF PLIST) 00731000
CH R5,=H'16' ANY FILEID SPECIFIED ? 00732000
BE ERROR042 NO, AN ERROR 00733000
CH R5,=H'32' SEE IF BOTH FILENAME AND FILETYPE THERE 00734000
BL ERROR023 NO, INVALID PARAMETER LIST 00735000
CH R5,=H'40' MORE THAN FN,FT,FM SUPPLIED ? 00736000
BNH S17 YES, IGNORE THE REST 00737000
LA R3,40(,R3) POINT TO UNEXPECTED PARAMETER 00738000
B ERROR070 OUTPUT THE ERROR MESSAGE 00739000
S17 EQU * 00740000
SH R5,=H'17' SUBTRACT 17 BYTES FOR MVC 00741000
* 00742000
* PREPARE PARAMETER LISTS FOR TAPEIO, FSTLKP AND RDBUF 00743000
* 00744000
EX R5,MVCFILID MOVE FILID FOR FSTLKP PLIST 00745000
MVC STATFN(16),SAVEFN HAVE STATE CHECK FN AND FT @VA14821 00745500
MVC STATFM(8),SAVEFM P0953 00746000
LA R1,STATLST CHECK FILEMODE P0953 00747000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 00748000
L R15,ASTATE STATE @V305066 00749000
BALR R14,R15 ... @V305066 00750000
SSM TPEENA ENABLE INTERRUPTS @VA06258 00751000
LTR R15,R15 P0953 00752000
BZ FMOK1 P0953 00753000
CH R15,=H'36' DISK NOT ACCESSED @VA14196 00753500
BE ERROR069 YES, ISSUE ERROR MSG @VA14196 00753550
CH R15,=H'28' IGNORE 'NOT FOUND' ERR P0953 00754000
BNE ERRET30 MODE ERROR P0953 00755000
FMOK1 EQU * P0953 00756000
SR R0,R0 INDICATE FIRST TIME ACCESS OF FSTLKP 00757000
MVC AIOBUFF,ACARDOUT WRITE CARDS FROM HERE 00758000
TM OPTBYTE,NOPRINT+NOTERM+NODISK OUTPUT MSG ? 00759000
BO TPDUMP10 USER REQUESTED NOMSG 00760000
MVC MESSAGE+1(L'DUMPING),DUMPING INDICATE DUMPING BEGINS 00761000
BAL R14,EJECTRTN OUTPUT MESSAGES @VA00983 00762000
LTR R15,R15 AN ERROR? @VA00983 00763000
BNZ ERROR1 YES, OUTPUT ERROR MESSAGE @VA00983 00764000
MVC MESSAGE+1(L'MESSAGE-1),MESSAGE BLANK OUT MSG LINE 00765000
MVC LMSG,=H'21' INSERT THE LENGTH OF THE MESSAGE 00766000
TPDUMP10 EQU * 00767000
MVC CONTROL,WRITE TAPEIO FUNCTION = 'WRITE' 00768000
MVC INCOMM,RDBUF FUNCTION NAME = 'RDBUF' 00769000
L R1,AFSTPLST A(FSTLKP PARAMETER LIST) 00770000
L R15,VCFSTLKP GET A(FSTLKP) @VM03093 00771000
BALR R14,R15 GO GET FST FOR REQUESTED FILE 00772000
BNZ NOTFOUND FILE NOT FOUND 00773000
LR R9,R0 GET THE A(ADT) 00774000
USING ADTSECT,R9 ACCESS THE ACTIVE DISK TABLE 00775000
OI AFSTPLST,X'80' INDICATE FSTLKP CALLED ONCE 00776000
CLI SAVEFM+1,C' ' ALL FM TYPES WANTED? P0953 00777000
BE DUMPIT YES, DUMP THIS FILE P0953 00778000
CLC FSTM+1(1),SAVEFM+1 NO, CHEK MODE TYPE MATCH P0953 00779000
BNE ERROR002 NO MATCH, FILE NOT FOUND @VA03136 00780000
DUMPIT EQU * P0953 00781000
MVC SAVEMODE(1),FSTM+1 SAVE MODE NUMBER @VA01998 00782000
ST R1,FSTSAVAD SAVE FST ENTRY ADDRESS @VA01998 00783000
SR R0,R0 INDICATE SEARCH ALL @VA00859 00784000
MVC FNACT(16),0(R1) FN FT FOR ACTLKP @VA00859 00785000
MVC FMACT,ADTM CORRECT MODE LETTER @VA00859 00786000
LA R1,CMDACT ADDRESS FOR ACTLKP @VA00859 00787000
LA R13,SAVE10R NEED TO SAVE 10 REGS @VA00859 00788000
L R15,AACTLKP ACTIVE FILE TABLE LOOKUP @VA00859 00789000
BALR 14,15 FIND IF FILE IS ACTIVE @VA00859 00790000
L R13,AFVS RESTORE FVS ADDRESS @VA01242 00791000
BNZ NOTACTV IT IS NOT - NO PROBLEM @VA00859 00792000
LA R1,AFTFST-AFTSECT(R1) GET FST COPY ADDRESS @VA00859 00793000
MVC SAVERPTR,FSTRP SAVE RD PTR FOR LATER OPEN @VA00859 00794000
OI ACTFLAG,RESET REMEMBER TO RE-OPEN @VA00859 00795000
LA R1,CMDACT GET COMMAND LIST @VA00859 00796000
MVC CMDACT,FINIS SET FOR FINIS @VA00859 00797000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 00798000
L R15,AFINIS FINIS @V305066 00799000
BALR R14,R15 ... @V305066 00800000
SSM TPEENA ENABLE INTERRUPTS @VA06258 00801000
SPACE 00802000
NOTACTV L R1,FSTSAVAD RESET LIKE THE OTHERS @VA01998 00803000
MVC FSTSAVE,FSTWP SAVE PART OF FST 00804000
OI UFDBUSY,WRBIT PREVENT 'KX' WHILE FST-ENTRY IS FUDGED JS 00805000
MVC FSTSAVE+20(4),FSTD SAVE DATE LAST UPDATED, TOO 00806000
CLI FSTFV,C'F' IS THIS FIXED FORMAT @VA03003 00807000
BNE SETUP NO, SETUP @VA01751 00808000
L R3,FSTIL ITEM LENGTH @VA01751 00809000
LH R2,FSTIC EVEN REG IMMATERIAL FOR MULT. SO @VA01751 00810000
N R2,=XL4'0000FFFF' USE IT FOR FULL WORD MULT @VA01751 00811000
MR R2,R2 AVOID LARGE IC CONFUSION @VA01751 00812000
AH R3,CONSTANT ADD 799, THIS WILL ADD A BLOCK @VA03003 00813000
* FOR REMAINDER 00814000
SR R2,R2 ZERO OUT FOR DIVIDE @VA01751 00815000
D R2,EIGHTHD DIVIDE BY 800 TO DETERMINE REAL @VA01751 00816000
* DATA COUNT, COUNTING NULL BLOCKS 00817000
STH R3,FSTDBC REAL DATA BLOCK COUNT CALCULATED @VA01751 00818000
SETUP MVI FSTFV,C'F' SET F/V FLAG TO FIXED @VA03003 00819000
MVC FSTIL,=F'800' SET ITEM LENGTH TO 800 00820000
MVC FSTIC,FSTDBC NO. ITEMS = NO. QTRK 00821000
MVC INMODE,ADTM PROPER MODE LETTER FOR READ 00822000
MVC INMODE+1(1),FSTM+1 AND MODE NUMBER FROM FST 00823000
MVC INNAME(16),FSTN MOVE FILENAME AND FILETYPE 00824000
TM OPTBYTE,NOPRINT+NOTERM+NODISK ANY RECORD OF DUMP WANTED? 00825000
BO LOOP NO, JUST DUMP 00826000
MVC MESSAGE+1(8),INNAME MOVE FILENAME TO MSG 00827000
MVC MESSAGE+10(8),INTYPE MOVE FILETYPE TO MSG 00828000
MVC MESSAGE+19(2),INMODE MOVE FILEMODE TO MSG 00829000
BAL R14,EJECTRTN OUTPUT MESSAGES @VA00983 00830000
LTR R15,R15 AN ERROR? @VA00983 00831000
BNZ ERR1 YES, OUTPUT ERROR MESSAGE @VA00983 00832000
LOOP EQU * 00833000
L R1,FSTSAVAD RESTORE FST POINTER @VA04989 00834000
LA R2,1 USE FOR DECR BLOK COUNT @VA04989 00835000
LH R3,FSTDBC GET NO. PHYS BLOKS @VA04989 00836000
LOOPEY EQU * ACTUAL READ/WRITE LOOP @VA04989 00837000
LA R1,INFILE SET LOCATION OF PARAMETER LIST 00838000
SVC 202 ISSUE CMS CALL 00839000
DC AL4(EOFCHK) ERROR RETURN 00840000
MVI FLAGOUT,BLANK RESET FLAG FIELD @VA04989 00841000
CLI INFLAG,BZERO NULL BLOK READ? @VA04989 00842000
BNE WRTAPE IF NOT, CONTINUE AS USUAL @VA04989 00843000
MVI FLAGOUT,CZERO SET NULL BLOK FLAG @VA04989 00844000
SR R3,R2 SUB 1 FOR NULL BLOK @VA04989 00845000
WRTAPE EQU * @VA04989 00846000
LA R1,PTAPEIO SET LOCATION OF PARAMETER LIST 00847000
SVC 202 ISSUE CALL TO TAPEIO 00848000
DC AL4(ERR111) V0155 00849000
B LOOPEY CONTINUE... @VA04989 00850000
* 00851000
* 00852000
EOFCHK C 15,=F'12' IS IT EOF 00853000
BNE ERR104 V0155 00854000
MVC DATAOUT(L'FSTSAVE),FSTSAVE GET FST INFO 00855000
STH R3,DATAOUT+16 RECORD NON-NULL BLOK COUNT @VA04989 00856000
MVI DATAOUT-1,C'N' INDICATE END RECORD 00857000
MVC DATAOUT+L'FSTSAVE(18),INNAME P0735 00858000
LA R1,PTAPEIO A(TAPEIO PLIST) 00859000
SVC 202 ISSUE CALL TO TAPEIO 00860000
DC AL4(ERR111) V0155 00861000
LA R8,DUMPOK NORMAL COMPLETION V0155 00862000
FINE EQU * CLOSE OUT THE FILE TR 00863000
LA R1,INFILE SET A(PARAMETER LIST FOR FINIS) 00864000
MVC INCOMM,FINIS FUNCTION NAME = 'FINIS' 00865000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 00866000
L R15,AFINIS FINIS @V305066 00867000
BALR R14,R15 ... @V305066 00868000
SSM TPEENA ENABLE INTERRUPTS @VA06258 00869000
LR R0,R9 RESTORE ADT REG @VA01998 00870000
CLI SAVEMODE,C'3' MODE THREE FILES WILL BE GO@VA01998 00871000
BE BRR8 SO SKIP RESTORE @VA01998 00872000
L R1,FSTSAVAD ADDRESS THE ENTRY @VA01998 00873000
MVC FSTWP(20),FSTSAVE RESTORE 2ND HALF OF 40 BYTE ENTRY, 00874000
TM ACTFLAG,RESET RE-OPEN THE FILE ? @VA00859 00875000
BZ BRR8 NOPE, ALL SET @VA00859 00876000
NI ACTFLAG,255-RESET CLEAN UP INDICATOR @VA00859 00877000
MVC CMDACT,POINT RESET READ POINTER @VA00859 00878000
MVC ITNOACT,SAVERPTR SET ITEM AS IT WAS @VA00859 00879000
LA R1,CMDACT SET ACTIVE FILE AS IT WAS @VA00859 00880000
SVC 202 MAKE IT ALL BETTER @VA00859 00881000
DC AL4(*+4) @VA00859 00882000
BRR8 KXCHK WRBIT CHECK FOR 'KX' DESIRED; IF NOT, JS 00883000
L R15,SAVER1+4 RESTORE RETURN CODE (IF ERR) V0155 00884000
L R1,SAVER1 AND PLIST ADDRESS V0155 00885000
BCR 15,R8 EITHER NORMAL OR ERR RETURN V0155 00886000
* 00887000
ERR1 LA R8,ERROR1 ERROR RETURN V0155 00888000
B SAVERR BUT FIRST RESTORE FST ENTRY V0155 00889000
ERR111 LA R8,ERROR111 V0155 00890000
B SAVERR V0155 00891000
ERR104 LA R8,ERROR104 V0155 00892000
ST R1,SAVER1 SAVE PLIST FOR ERR MSG V0155 00893000
SAVERR ST R15,SAVER1+4 SAVE ERR RETCODE FOR LATER V0155 00894000
B FINE NOW RESTORE THE FUDGED FST V0155 00895000
* 00896000
* WRITE TWO TAPE-MARKS, AND THEN BACKSPACE OVER THEM ... 00897000
* 00898000
DUMPOK EQU * V0155 00899000
MVC CONTROL,WTM TAPEIO FUNCTION = 'WTM' 00900000
LA R1,PTAPEIO 00901000
SVC 202 LL 00902000
DC AL4(ERROR111) ERROR 2 IF ERROR WRITING EOF MARK. JS 00903000
SVC 202 00904000
DC AL4(ERROR111) 00905000
MVC CONTROL,BSF TAPEIO FUNCTION = 'BSF' 00906000
SVC 202 00907000
DC AL4(ERROR111) ERROR RETURN 00908000
TM OPTBYTE,NOWTM WTM REQUESTED 00909000
BNO WTM2 YES, ONLY BSF ONE FILE MARK 00910000
SVC 202 00911000
DC AL4(ERROR111) ERROR RETURN 00912000
WTM2 EQU * 00913000
CLC =C'* ',SAVEFN ASTERISK IN PLACE OF FILENAME 00914000
BE TPDUMP10 YES, SEE IF ANY MORE FILES TO BE DUMPED 00915000
CLC =C'* ',SAVEFT ASTERISK IN PLACE OF FILETYPE 00916000
BE TPDUMP10 YES, SEE IF ANY MORE FILES TO BE DUMPED 00917000
CLC =C'* ',SAVEFM ASTERISK IN PLACE OF FILEMODE 00918000
BNE RETURN RETURN TO CALLER, ALL DONE 00919000
B TPDUMP10 CONTINUE DUMPING 00920000
* 00921000
NOTFOUND EQU * 00922000
TM AFSTPLST,X'80' HAS FSTLKP BEEN CALLED SUCCESSFULLY ONCE? 00923000
BNO ERROR002 NO, FILE NOT FOUND ERROR 00924000
B RETURN RETURN TO CALLER, ALL DONE 00925000
DROP R9 00926000
EJECT 00927000
********************************************************************** 00928000
* 00929000
* TAPE SCAN, SKIP, LOAD 00930000
* 00931000
********************************************************************** 00932000
TPSCAN EQU * 00933000
MVC MESSAGE+1(L'SCANNING),SCANNING INDICATE SCANNING 00934000
B CHCKFILE CHECK FOR FILE ID 00935000
TPLOAD EQU * 00936000
MVC MESSAGE+1(L'LOADING),LOADING INDICATE LOADING 00937000
B CHCKFILE CHECK FOR FILE ID 00938000
TPSKIP EQU * SKIP A FEW FILES 00939000
MVC MESSAGE+1(L'SKIPPING),SKIPPING INDICATE SKIPPING 00940000
CHCKFILE EQU * 00941000
L R5,SAVER1 A(BEGINNING OF OPTIONS LIST OR FENCE) 00942000
SR R5,R3 MINUS A(BEGINNING OF PLIST) 00943000
CH R5,=H'32' SEE IF BOTH FILENAME AND FILETYPE THERE 00944000
BNL CHKFT SEE IF MORE THAN FILETYPE SUPPLIED 00945000
CH R5,=H'24' WAS ONLY FILENAME SPECIFIED ? 00946000
BL EOFNEOT NO, FN NOT SPECIFIED, ASSUME EOF|EOT 00947000
B ERROR023 ONLY FILENAME SPECIFIED, NO FILETYPE 00948000
CHKFT EQU * 00949000
CH R5,=H'32' ONLY FN AND FT SPECIFIED ? @VA01201 00950000
BE CHKFT10 YES, OKAY THEN @VA01201 00951000
TM FLAGS,SKPSWT+SCNSWT SKIP OR SCAN 00952000
BZ CHKFT10 NO, MUST BE LOADING @VA01201 00953000
LA R3,32(,R3) POINT TO INVALID PARAMETER 00954000
B ERROR070 TYPE OUT THE MESSAGE 00955000
CHKFT10 EQU * 00956000
CH R5,=H'40' MORE THAN FN,FT,FM SUPPLIED 00957000
BNH S17A YNO, MOVE THE FILEID 00958000
LA R3,40(,R3) POINT TO THE UNKNOWN PARAMETER 00959000
B ERROR070 TYPE OUT AN ERROR MESSAGE 00960000
S17A EQU * 00961000
CH R5,=H'32' FILEMODE GIVEN? V0037 00962000
BE PREPSTAT IF NOT, SKIP OVER V0037 00963000
LA R7,32(,R3) POINT TO THE MODE LETTER 00964000
CLI 0(R7),C'*' WAS AN '*' SPECIFIED ? 00965000
BE ERROR048 YES, OUTPUT AN ERROR MESSAGE 00966000
MVC STATFM(8),0(R7) USER MODE FOR STATE V0037 00967000
PREPSTAT EQU * V0037 00968000
SH R5,=H'17' SUBTRACT 17 BYTES FOR MVC FILEID 00969000
EX R5,MVCFILID MOVE FILEID FOR FUTURE REFERENCE 00970000
TM FLAGS,LOADSWT LOADING? @VA02759 00971000
BO STFILE YES, DO STATE @VA02759 00972000
TM OPTBYTE,NODISK OUTPUT TO DISK? @VA02759 00973000
BO FMOK2 NO, DON'T DO STATE @VA02759 00974000
STFILE LA R1,STATLST CHECK FILEMODE @VA02759 00975000
MVC STATFN(16),SAVEFN HAVE STATE CHECK FN AND FT @VA14821 00975500
SSM TPEDIS DISABLE INTERRUPTS @VA06258 00976000
L R15,ASTATE STATE @V305066 00977000
BALR R14,R15 ... @V305066 00978000
SSM TPEENA ENABLE INTERRUPTS @VA06258 00979000
LTR R15,R15 P0953 00980000
BZ FMOK2 P0953 00981000
CH R15,=H'36' DISK NOT ACCESSED @VA14196 00981500
BE ERROR069 YES, ISSUE ERROR MSG @VA14196 00981550
CH R15,=H'28' IGNORE 'NOT FOUND' ERR P0953 00982000
BNE ERRET30 MODE ERROR P0953 00983000
FMOK2 EQU * P0953 00984000
CLC 16(10,R3),=C'* * ' FN, FT = * 00985000
BE EOFNEOT PRINT ALL FILEIDS 00986000
OI TPEFLG,PRTMATCH MATCH FOR PRINTING 00987000
EOFNEOT EQU * 00988000
TM OPTBYTE,NOPRINT+NOTERM+NODISK USER WANT ANY OUTPUT ? 00989000
BO TPINIT NO INITIALIZE FOR SCAN|LOAD OPERATION 00990000
BAL R14,EJECTRTN OUTPUT MESSAGES @VA00983 00991000
LTR R15,R15 AN ERROR? @VA00983 00992000
BNZ ERROR1 YES, OUTPUT ERROR MESSAGE @VA00983 00993000
MVC MESSAGE+1(L'MESSAGE-1),MESSAGE BLANK OUT MSG LINE 00994000
MVC LMSG,=H'21' INSERT LENGTH OF FILEID + 1 00995000
TPINIT EQU * 00996000
MVC CONTROL,READ TAPEIO FUNCTION = 'READ' 00997000
MVC AIOBUFF,ACARDIN A(INPUT BUFFER) 00998000
XR R7,R7 NUMBER EOF'S HIT = 0 00999000
TPSRSET EQU * RESET FOR READING ANOTHER FILE 01000000
TM FLAGS,MATCH FIRST, SEE IF HAD AN EXACT FILEID MATCH ? 01001000
BO RETURN YES, ALL DONE 01002000
XR R6,R6 ZERO THE NUMBER OF RECORDS READ 01003000
TPSLOOP EQU * 01004000
TM FLAGS,LOADSWT LOADING? P0735 01005000
BO LOADWR YES P0735 01006000
LA R1,PTAPEIO A(LOCATION OF PARAMETER LIST 01007000
SVC 202 ISSUE CALL TO TAPEIO 01008000
DC AL4(TAPEOF) ERROR RETURN 01009000
NI TPEFLG,255-EOTF JUST ONE TAPE MARK P0735 01010000
LA R6,1(,R6) UPDATE NUMBER OF RECORDS READ 01011000
CLC IOBUFF(4),BYTESRD SHOULD READ 805 BYTES @VA02415 01012000
BNE ERROR057 INVALID FORMAT IF NOT @VA02415 01013000
CLC CARDIN(4),HEADER IS THIS PROPER FORMAT @VA03003 01014000
BE FORMOK1 YES-CONTINUE @VA08107 01015000
TM MODESETB,TRTCHET TRANSLATION IN EFFECT @VA08107 01015100
BNO ERROR057 NO-INVALID FORMAT @VA08107 01015200
CLC CARDIN(4),HEADERTR IS FORMAT OK @VA08107 01015300
BNE ERROR057 NO-INVALID FORMAT @VA08107 01015400
FORMOK1 EQU * @VA08107 01015500
CLI CARDIN+4,C'N' IS THIS THE END RECORD JR 01016000
BNE TPSLOOP BR ON NO TO TRY AGAIN JR 01017000
LOADMACH EQU * CHECK ID MATCH P0735 01018000
NI TPEFLG,255-LOADPROC NO LONGER LOADING... P0735 01019000
CLI SAVEFN,C' ' ANY FILE ID SUPPLIED ? 01020000
BE OUTPUT NO, OUTPUT FILE ID MESSAGE 01021000
CLC =C'* ',SAVEFN DOES FILENAME MATTER ? 01022000
BE CHKTYPE NO, SEE IF FILETYPE MATTERS 01023000
CLC SAVEFN,DATAIN+L'FSTSAVE SEE CURRENT FNAME MATCHES USERS 01024000
BNE CHKSCNSW 01025000
OI TPEFLG,MATCHFN MATCH ON FILENAME 01026000
B CHKTYPE SEE IF MATCH ON FILETYPE 01027000
CHKSCNSW EQU * 01028000
TM FLAGS,SCNSWT SCANNING? P0953 01029000
BO OUTPUT YES, OUTPUT FILE ID SCANNED P0953 01030000
MVC WRCOMM(8),FINIS FINIS THE DUMMY WORK FILE V0155 01031000
LA R1,WRFILE V0155 01032000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 01033000
L R15,AFINIS FINIS @V305066 01034000
BALR R14,R15 ... @V305066 01035000
SSM TPEENA ENABLE INTERRUPTS @VA06258 01036000
B TPSRSET NO, CONTINUE SCAN FOR LOADING 01037000
CHKTYPE EQU * SEE IF FILETYPE MATCHES USER'S 01038000
CLC =C'* ',SAVEFT DOES FILETYPE MATTER 01039000
BE CHKMODE NO, CHEK FILEMODE TYPE P0953 01040000
CLC SAVEFT,DATAIN+L'FSTSAVE+8 CHECK FILETYPE 01041000
BNE CHKSCNSW DOESN'T MATCH, SEE IF SCANNING OR LOADING 01042000
OI TPEFLG,MATCHFT MATCH ON FILETYPE 01043000
CHKMODE EQU * P0953 01044000
CLI SAVEFM+1,C' ' ALL MODE TYPES WANTED? P0953 01045000
BE MATCHALL YES, LOAD THIS FILE P0953 01046000
CLC SAVEFM+1(1),DATAIN+5 MATCH ON FILEMODE TYPE P0953 01047000
BNE CHKSCNSW NO,DON'T LOAD THIS ONE V0155 01048000
OI TPEFLG,MATCHFM YES, LOAD IT P0953 01049000
MATCHALL EQU * P0953 01050000
TM TPEFLG,MATCHFT MATCH ON FILETYPE? P0953 01051000
BZ OUTPUT NO, CONTINUE... P0953 01052000
TM TPEFLG,MATCHFN WAS THERE A MATCH ON FILENAME 01053000
BZ OUTPUT NO, NOT AN EXACT MATCH 01054000
OI FLAGS,MATCH YES, INDICATE EXACT MATCH 01055000
OUTPUT EQU * 01056000
CLC DATAIN+L'FSTSAVE(16),TEMPFILE+8 WORK FILE NAME? P0917 01057000
BNE NOWORK P0917 01058000
MVI DATAIN+L'FSTSAVE+13,C'2' MAKE IT 'CMSUT2' P0917 01059000
NOWORK EQU * P0917 01060000
OI FLAGS2,NOTBLANK TAPE IS NOT A BLANK. @VA11948 01060500
TM TPEFLG,MATCHFN+MATCHFT+MATCHFM ANY MATCH ? @VA11305 01061000
BZ PRTFILID NO MATCH, DON'T SET FLAG @VA11305 01061100
OI TPEFLG,INPUT NOTE THAT A FILE WAS FOUND @VA11305 01061200
PRTFILID EQU * @VA11305 01061300
TM OPTBYTE,NOPRINT+NOTERM+NODISK RECORD OF OPERATION REQ.? 01062000
BO CHECKSCN NO, SEE IF SCANNING 01063000
TM TPEFLG,PRTMATCH PRINT THE FILEID 01064000
BZ OUTPUT10 YES, UNDER ALL CIRCUMSTANCES 01065000
TM TPEFLG,MATCHFN+MATCHFT+MATCHFM ANY MATCH? P0953 01066000
BZ CHECKSCN NO, DON'T PRINT THE FILEID 01067000
NI TPEFLG,255-MATCHFN-MATCHFT-MATCHFM RESET P0953 01068000
OUTPUT10 EQU * OUTPUT THE FILEID 01069000
MVC MESSAGE+1(8),DATAIN+L'FSTSAVE MOVE FILENAME TO MSG 01070000
MVC MESSAGE+10(8),DATAIN+L'FSTSAVE+8 01071000
MVC MESSAGE+19(2),DATAIN+L'FSTSAVE+16 01072000
TM FLAGS,LOADSWT LOADING? P0735 01073000
BZ OUTSVC P0735 01074000
MVC MESSAGE+19(1),SAVEFM IF SO, NEW MODE P0953 01075000
OUTSVC EQU * P0735 01076000
BAL R14,EJECTRTN OUTPUT MESSAGES @VA00983 01077000
LTR R15,R15 AN ERROR? @VA00983 01078000
BNZ ERROR1 YES, OUTPUT ERROR MESSAGE @VA00983 01079000
CHECKSCN EQU * 01080000
TM FLAGS,SKPSWT SKIPPING ? 01081000
BO TPSRSET YES, CONTINUE SKIP 01082000
TM FLAGS,SCNSWT SCANNING ? 01083000
BNO AROUND NO, MUST BE LOADING 01084000
TM FLAGS,MATCH ENCOUNTERED EXACT MATCH ? 01085000
BNO TPSRSET NO, CONTINUE SCAN 01086000
AROUND EQU * BACKSPACE TO BEGINNING OF FILE 01087000
TM FLAGS,LOADSWT LOADING? P0735 01088000
BO TPEND YES, GOTTA MATCH, TOO P0735 01089000
MVC CONTROL,BSR BACKSPACE RECORD OPERATION 01090000
LA R1,PTAPEIO PARAMETER FOR TAPEIO 01091000
TPSBSR EQU * BACKSPACE RECORD 01092000
SVC 202 ISSUE CALL TO TAPEIO 01093000
DC AL4(ERROR110) ERROR RETURN 01094000
BCT R6,TPSBSR DO AS MANY AS RECORDS IN FILE 01095000
TM FLAGS,SCNSWT SCANNING ? 01096000
BO RETURN ALL DONE, RETURN TO CALLER 01097000
LOADWR EQU * P0735 01098000
MVC WRFILE(L'WRCOMM+L'WRNAME+L'WRTYPE+L'WRMODE),TEMPFILE 01099000
MVC WRMODE(1),SAVEFM ERASE TEMP FILE IF IT EXISTS P0953 01100000
MVI WRMODE+1,C'1' DUMMY MODE TYPE P0953 01101000
LA R1,WRFILE ERASE 'TAPE CMSUT1' 01102000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 01103000
L R15,AERASE ... @V305066 01104000
BALR R14,R15 ... @V305066 01105000
SSM TPEENA ENABLE INTERRUPTS @VA06258 01106000
MVC CONTROL,READ TAPEIO FUNCTION = 'READ' 01107000
MVC WRCOMM,WRBUF FUNCTION NAME = 'WRBUF' 01108000
SR R8,R8 CLEAR BLOK COUNTER @VA04989 01109000
STH R8,WRITNO CLEAR PHYS BLOK COUNT @VA04989 01110000
TPLD1 EQU * CONTINUE READING TAPE 01111000
LA R1,PTAPEIO PARAMETER LIST FOR TAPEIO READ 01112000
SVC 202 ISSUE CALL TO TAPEIO 01113000
DC AL4(TAPEOF) ERROR RETURN 01114000
OI TPEFLG,LOADPROC LOADING IN PROGRESS P0735 01115000
CLC IOBUFF(4),BYTESRD SHOULD READ 805 BYTES @VA02415 01116000
BNE ERROR057 INVALID FORMAT IF NOT @VA02415 01117000
NI TPEFLG,255-EOTF JUST ONE TAPE MARK P0735 01118000
CLC CARDIN(4),HEADER PROPER FORMAT ? @VA03003 01119000
BE FORMOK2 YES-CONTINUE @VA08107 01120000
TM MODESETB,TRTCHET TRANSLATION IN EFFECT @VA08107 01120100
BNO ERROR057 NO-INVALID FORMAT @VA08107 01120200
CLC CARDIN(4),HEADERTR IS FORMAT OK @VA08107 01120300
BNE ERROR057 NO-INVALID FORMAT @VA08107 01120400
FORMOK2 EQU * @VA08107 01120500
CLI CARDIN+4,C'N' TEST FOR END RECORD 01121000
BE LOADMACH GO LOOK FOR ID MATCH P0735 01122000
LH R8,WRITNO GET PHYS BLOK NUMBER @VA04989 01123000
LA R8,1(,R8) BUMP BY 1 BLOKNUMBER @VA04989 01124000
STH R8,WRITNO AND STORE FOR NEXT WRITE @VA04989 01125000
CLI FLAGIN,CZERO NULL BLOK DUMPED? @VA04989 01126000
BE TPLD1 IF SO, IGNORE & READ NEXT @VA04989 01127000
LA R1,WRFILE PARAMETER LIST FOR WRBUF 01128000
L R15,AWRBUF WRBUF @V305066 01129000
SSM TPEDIS DISABLE INTERRUPTS @VA07792 01129500
BALR R14,R15 ... @V305066 01130000
SSM TPEENA ENABLE INTERRUPTS @VA07792 01130500
BNZ ERROR105 ERROR RETURN @V305066 01131000
B TPLD1 CONTINUE 01132000
* 01133000
* 01134000
TPEND EQU * 01135000
LA R1,WRFILE PARAMETER LIST FOR WRBUF 01136000
MVC WRCOMM,FINIS FUNCTION NAME = 'FINIS' 01137000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 01138000
L R15,AFINIS ... @V305066 01139000
BALR R14,R15 ISSUE CALL TO FINIS IN @V305066 01140000
SSM TPEENA ENABLE INTERRUPTS @VA06258 01141000
BNZ MSG701 CASE OF NULL FILE @V305066 01142000
L R15,VCFSTLKW FIND UTILITY FILE @VA04519 01143000
BALR R14,R15 @VA04519 01144000
USING FSTSECT,R1 FILE STATUS TABLE @VA04519 01145000
CLC DATAIN+(FSTDBC-FSTWP)(2),FSTDBC BLK CNT OK ? @VA04519 01146000
BNE ERROR096 NO, ERROR 096E @VA04519 01147000
DROP R1 @VA04519 01148000
MVC ACTFN(16),DATAIN+L'FSTSAVE P0735 01149000
MVC ACTFM(1),SAVEFM REQUESTED DISK MODE P0953 01150000
MVC ACTFM+1(1),DATAIN+L'FSTSAVE+17 AND MODE TYPE P0953 01151000
LA R1,ACTERS R1 = A(ERASE ACTIVE FILE) 01152000
SSM TPEDIS DISABLE INTERRUPTS @VA06258 01153000
L R15,AERASE ERASE @V305066 01154000
BALR R14,R15 ISSUE CALL TO ERASE IN CASE FILE @V305066 01155000
L R15,VCFSTLKW CALL TO FIND WHERE THE FILE IS @VM03093 01156000
LA R1,WRFILE ADDRESS OF PARAMETER LIST 01157000
BALR 14,15 ... 01158000
USING FSTSECT,R1 FILE STATUS TABLE 01159000
MVC CHLINK,FSTFCL SAVE CHAIN LINK TEMPORARILY 01160000
MVC FSTWP(20),DATAIN RESET BOTTOM PART OF FST 01161000
MVC FSTD,DATAIN+20 RESET DATE LAST UPDATED, TOO 01162000
MVC FSTN(16),DATAIN+L'FSTSAVE RESET FN, FT P0735 01163000
MVC FSTFCL,CHLINK RESTORE CHAIN LINK ADDRESS 01164000
L R15,AUPDISK NOW UPDATE UFD AFTER TAPE LOAD JS 01165000
BALR R14,R15 (R0 & R1 OK FROM FSTLKP ABOVE) 01166000
LR R9,R0 GET A(ADT) 01167000
USING ADTSECT,R9 ACCESS VARIABLES IN THE ADT 01168000
LM R0,R1,FSTT REAL FILETYPE INTO R0-R1, 01169000
DROP R1 01170000
L R15,ATYPSRCH CHECK REAL FILETYPE 01171000
BALR R14,R15 VIA "TYPSRCH" 01172000
O R15,ADTFTYP-3 "OR" IN THE POSSIBLE BIT 01173000
ST R15,ADTFTYP-3 FOR THE REAL FILETYPE. 01174000
SSM TPEENA ENABLE INTERRUPTS @VA06258 01175000
B TPSRSET SEE IF ANY MORE FILES ARE TO BE LOADED 01176000
* 01177000
* WHEN HIT TAPE READING ERROR COME HERE 01178000
* 01179000
TAPEOF EQU * 01180000
CH R15,=H'8' IS IT INCORRECT LENGTH? @VA03457 01181000
BE ERROR110 YES, THEN SAY SO @VA03457 01182000
CH R15,=H'2' TEST FOR EOF 01183000
BNE ERROR110 IF NOT, SEE WHAT ELSE IT COULD BE 01184000
TM TPEFLG,LOADPROC LOADING IN PROGRESS? P0735 01185000
BO ERROR010 YES, PREMATURE END OF FILE 01186000
SPACE 2 01187000
TM OPTBYTE,NOTERM+NOPRINT+NODISK ANY OUTPUT MSG REQUESTED 01188000
BO CHKEOF NO 01189000
MVC LMSG,=AL2(L'EOFM+1) INSERT THE LENGTH OF THE MESSAGE 01190000
MVC MESSAGE+1(L'EOFM),EOFM INFORM USER OF END OF FILE 01191000
BAL R14,EJECTRTN OUTPUT MESSAGES @VA00983 01192000
LTR R15,R15 AN ERROR? @VA00983 01193000
BNZ ERROR1 YES, OUTPUT ERROR MESSAGE @VA00983 01194000
MVC MESSAGE+1(L'MESSAGE-1),MESSAGE BLANK OUT MSG LINE 01195000
MVC LMSG,=H'21' INSERT LENGTH OF FILEID+1 01196000
CHKEOF EQU * ANY MORE SCANNING REQUIRED 01197000
TM OPTBYTE,NOEOT EOT SPECIFIED ? 01198000
BNZ NOTEOT P0735 01199000
TM TPEFLG,EOTF SECOND SUCCESSIVE TAPE MARK? P0735 01200000
BO CHKINPUT YES, CHECK IF A FILE FOUND @VA01415 01201000
OI TPEFLG,EOTF FIRST TAPE MARK SIGNAL P0735 01202000
B TPSRSET P0735 01203000
NOTEOT EQU * P0735 01204000
LA R7,1(,R7) INCREMENT NUMBER OF TAPE MARKS HIT 01205000
C R7,EOFN SEE IF MATCHES NUMBER USER REQUESTED 01206000
BL TPSRSET NO, CONTINUE SCANNING OR LOADING 01207000
CHKINPUT EQU * @VA11948 01207500
TM FLAGS2,NOTBLANK IS TAPE A BLANK TAPE? @VA11948 01207600
BNO ERR2RC GIVE RETURN CODE. @VA11948 01207700
TM TPEFLG,INPUT ANYTHING LOADED? @VA11948 01207800
BO RETURN YES, RETURN TO CALLER @VA01415 01209000
TM TPEFLG,PRTMATCH FILEID SPECIFIED ? @VA01415 01210000
BO ERROR002 YES, TELL USER @VA01415 01211000
TM FLAGS,SCNSWT+LOADSWT+SKPSWT WITH NO FILEID @VA13090 01211100
BM RETURN WE DON'T CARE @VA11305 01211200
B ERR2RC OTHERWISE JUST GIVE R.C. @VA01415 01212000
DROP R9 01213000
EJECT 01214000
* 01215000
* TAPE BSF, BSR, ERG, FSF, REW, RUN, WTM, FSR 01216000
* 01217000
TPCONTL EQU * 01218000
MVC CONTROL,8(R3) SET TAPE CONTROL FUNCTION 01219000
XC DBLWRD1(L'DBLWRD1+L'DBLWRD2),DBLWRD1 ZERO CONV. AREA 01220000
L R5,SAVER1 A(BEGINNING OF OPTIONS LIST OR FENCE) 01221000
SR R5,R3 MINUS BEGINNING OF PLIST 01222000
CH R5,=H'24' SEE IF 'N' SUPPLIED 01223000
BE CONVERT YES, CONVERT IT TO BINARY 01224000
LA R3,24(,R3) POINT TO THE UNKNOWN PARAMETER 01225000
BH ERROR070 AN UNKNOWN PARAMETER HAS BEEN INPUT 01226000
LA R5,1 PERFORM CONTROL FUNCTION ONLY ONCE 01227000
B PERFORM GO DO IT 01228000
CONVERT EQU * CONVERT 'N' TO BINARY 01229000
LA R6,16(,R3) NUMBER BEGINS HERE 01230000
CLI CONTROL,C'R' IS IT CONTROL FUNC. REW OR RUN? @VA03003 01231000
BE ERR70E YES, SHOULDN'T HAVE A PARAMETER @VA03257 01232000
CLI CONTROL,C'E' IS IT CONTROL FUNCTION ERG? @VA03003 01233000
BE ERR70E YES, SHOULDN'T HAVE A PARAMETER @VA03257 01234000
CLI 0(R6),C'0' P0953 01235000
BL ERR70E ERROR IF LT '0' @VA03257 01236000
CLI 0(R6),C'9' P0953 01237000
BH ERR70E ERROR IF GT '9' @VA03257 01238000
LA R4,17(,R3) NUMBER +1 STARTS HERE 01239000
LA R5,0 R5 = NUMBER OF NUMBERS IN 'N' - 1 01240000
CONVERT1 EQU * 01241000
CLI 0(R4),C' ' SEE IF CHARACTER IS BLANK 01242000
BE CONVERT2 YES, END OF 'N', DO CONVERSION 01243000
TM 0(R4),X'F0' P0953 01244000
BNO ERR70E ERROR IF NOT NUMERIC @VA03257 01245000
LA R4,1(,R4) INCREMENT A(POINTER TO 'N') 01246000
LA R5,1(,R5) INCREMENT NUMBER OF NUMBERS IN 'N' 01247000
CH R5,=H'7' SEE IF REACHED 8 NUMBERS YES 01248000
BL CONVERT1 NO, CONTINUE 01249000
CONVERT2 EQU * 01250000
LA R4,DBLWRD1+7 A(DBL WORD USED FOR CONVERSIONT) 01251000
SR R4,R5 MINUS NUMBER OF NUMBERS IN 'N' 01252000
EX R5,MVCNUM MOVE THE NUMBER FOR CONVERSION 01253000
PACK DBLWRD2,DBLWRD1 PACK IT 01254000
AR R5,R5 01255000
CVB R5,DBLWRD2 CONVERT TO BINARY 01256000
LTR R5,R5 IS 'N' EQUAL TO ZERO? @VA02967 01257000
BZ RETURN YES, DON'T DO ANYTHING @VA02967 01258000
PERFORM EQU * EXECUTE TAPE CONTROL FUNCTION 01259000
LA R1,PTAPEIO SET LOCATION OF PARAMETER LIST 01260000
PERFORM1 EQU * 01261000
SVC 202 ISSUE CALL TO TAPEIO 01262000
DC AL4(ERROR2) ERROR RETURN 01263000
BCT R5,PERFORM1 PERFORM AS OFTER AS REQUESTED 01264000
B RETURN ALL DONE, RETURN TO CALLER 01265000
EJECT 01266000
* 01267000
* TAPE MODESET 01268000
* 01269000
TPMODEST EQU * 01270000
L R5,SAVER1 GET POINTER TO OPTIONS LIST 01271000
SR R5,R3 SUBTRACT OUT POINTER TO PLIST 01272000
LA R3,16(,R3) POINT TO INVALID PARAMETER (IF ANY) 01273000
CH R5,=H'16' ANY INVALID PARAMETER 01274000
BH ERROR070 YES, TYPE MSG. P0735 01275000
B RETURN NO, RETURN TO CALLER 01276000
EJECT 01277000
********************************************************************** 01278000
* 01279000
* ERROR RETURNS 01280000
* 01281000
********************************************************************** 01282000
SPACE 2 01283000
ERROR1 EQU * ERROR WRITING TAPE MAP FILE 01284000
L R2,POUTPUT GET ADDR. OF STATUS OUTPUT PLIST 01285000
CLC 0(8,R2),OUTCOMM SEE IF IT'S A 'WRBUF' 01286000
BNE ERRET10 NO, ERROR HAS BEEN TAKEN CARE OF 01287000
MVC WRMODE(2),OUTMODE ENSURE OUTPUT MSG CORRECT @VA04663 01288000
LA R2,OUTNAME GET THE ADDR. OF THE FILE NAME 01289000
B ERROROUT OUTPUT MESSAGE 105 01290000
SPACE 2 01291000
ERROR2 EQU * ERROR DOING TAPEIO CONTROL 01292000
CLC CONTROL,WTM WRITING A TAPE MARK ? 01293000
BE ERROR111 YES, WRITING ERROR 01294000
CLC CONTROL,ERG ERASE RECORD GAP ? 01295000
BE ERROR111 WRITING ERROR 01296000
B ERROR110 READING ERROR 01297000
SPACE 2 01298000
ERROR002 EQU * 01299000
LA R2,SAVEFN A(FILEID) 01300000
DMSERR NUM=2,LET=E,SUB=(CHAR8A,(R2)),TEXT='FILE(S) ''.........+01301000
............'' NOT FOUND' 01302000
ERR2RC LA R15,28 COMPLETION CODE @VA01415 01303000
B ERRET10 RETURN TO CALLER 01304000
SPACE 2 01305000
ERROR003 EQU * 01306000
LR R2,R1 SAVE R1 01307000
DMSERR NUM=3,LET=E,SUB=(CHARA,(R2)),TEXT='INVALID OPTION ''...+01308000
.....''' 01309000
LA R15,24 COMPLETION CODE 01310000
B ERRET20 RETURN TO CALLER 01311000
SPACE 2 01312000
ERROR010 EQU * 01313000
LA R2,ACTFN ACTIVE FILENAME P0735 01314000
DMSERR NUM=10,LET=E,SUB=(CHAR8A,(R2)),TEXT='PREMATURE EOF ON F+01315000
ILE ''.................''' 01316000
LA R15,40 COMPLETION CODE 01317000
B ERRET10 RETURN TO CALLER 01318000
SPACE 2 01319000
ERROR042 EQU * 01320000
DMSERR NUM=42,LET=E,TEXT='NO FILEID SPECIFIED' 01321000
LA R15,24 COMPLETION CODE 01322000
B ERRET20 RETURN TO CALLER 01323000
SPACE 2 01324000
ERROR014 EQU * 01325000
LA R3,8(,R3) POINT TO THE UNEXPECTED FUNCTION 01326000
DMSERR NUM=14,LET=E,SUB=(CHARA,(R3)),TEXT='INVALID FUNCTION ''+01327000
........''' 01328000
LA R15,24 COMPLETION CODE 01329000
B ERRET20 RETURN TO CALLER 01330000
SPACE 2 01331000
ERROR023 EQU * 01332000
DMSERR NUM=23,LET=E,TEXT='NO FILETYPE SPECIFIED' 01333000
LA R15,24 COMPLETION CODE 01334000
B ERRET20 RETURN TO CALLER 01335000
SPACE 2 01336000
ERROR017 EQU * 01337000
LR R2,R1 SAVE REGISTER 1 01338000
DMSERR NUM=17,LET=E,SUB=(CHARA,(R2)),TEXT='INVALID DEVICE ADDR+01339000
ESS ''........''' 01340000
LA R15,24 COMPLETION CODE 01341000
B ERRET20 RETURN TO CALLER 01342000
SPACE 2 01343000
ERROR027 EQU * 01344000
LA R2,SYMTAPA POINT TO NAME @VA07458 01345500
DMSERR NUM=27,LET=E,SUB=(CHARA,(R2)),TEXT='INVALID DEVICE ''..+01347000
..''' @VA07458 01348100
LA R15,24 COMPLETION CODE 01349000
B ERRET20 01350000
SPACE 2 01351000
ERR29A LR R1,R6 POINT TO PARAMETER P0953 01352000
ERROR029 EQU * 01353000
LR R2,R1 GET POINTER TO PARAMETER IN R1 01354000
LR R3,R1 SAVE REGISTER 1 01355000
SH R3,=H'8' BACK UP TO OPTION 01356000
DMSERR NUM=29,LET=E,SUB=(CHARA,(R2),CHARA,(R3)),RENT=NO,TEXT='+01357000
INVALID PARAMETER ''........'' IN THE OPTION ''........'+01358000
' FIELD' 01359000
LA R15,24 COMPLETION CODE 01360000
B ERRET20 RETURN TO CALLER 01361000
SPACE 2 01362000
ERROR037 EQU * 01363000
DMSERR NUM=37,LET=E,SUB=(CHARA,((R7),1)), @VA05245+01364000
TEXT='DISK ''..'' IS READ/ONLY' @VA05245 01365000
MVC CONTROL,BSR BACKSPACE RECORD OPERATION @VA03886 01366000
LA R1,PTAPEIO PARAMETER FOR TAPEIO @VA03886 01367000
SVC 202 ISSUE CALL TO TAPEIO @VA03886 01368000
DC AL4(*+4) ERROR RETURN @VA03886 01369000
LA R15,36 COMPLETION CODE 01370000
B ERRET10 RETURN TO CALLER 01371000
SPACE 2 01372000
ERROR043 EQU * 01373000
DMSERR NUM=43,LET=E,SUB=(CHARA,(R3),HEX,(R2)),TEXT='''....(...+01374000
)'' IS FILE PROTECTED',RENT=NO 01375000
LA R15,36 COMPLETION CODE 01376000
B ERRET10 RETURN TO CALLER 01377000
SPACE 2 01378000
ERROR047 EQU * 01379000
DMSERR NUM=47,LET=E,TEXT='NO FUNCTION SPECIFIED' 01380000
LA R15,24 COMPLETION CODE 01381000
B ERRET20 RETURN TO CALLER 01382000
SPACE 2 01383000
ERROR048 EQU * 01384000
DMSERR NUM=48,LET=E,SUB=(CHARA,(R7)),TEXT='INVALID MODE ''..''+01385000
' 01386000
LA R15,24 COMPLETION CODE 01387000
B ERRET10 RETURN TO CALLER 01388000
SPACE 2 01389000
ERROR057 EQU * 01390000
DMSERR NUM=57,LET=E,TEXT='INVALID RECORD FORMAT' 01391000
LA R15,32 COMPLETION CODE 01392000
B ERRET10 RETURN TO CALLER 01393000
SPACE 2 01394000
ERROR058 EQU * 01395000
TM TPEFLG,EOTF SECOND TAPE MARK? P0953 01396000
BO RETURN O.K. IF SO P0953 01397000
DMSERR NUM=58,LET=E,TEXT='END-OF-FILE OR END-OF-TAPE' 01398000
LA R15,40 COMPLETION CODE 01399000
B ERRET10 RETURN TO CALLER 01400000
* @VA14196 01400500
ERROR069 EQU * @VA14196 01400520
DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X01400540
LET=E,SUB=(CHARA,(STATFM,1)) @VA14196 01400560
LA R15,36 RETURN CODE = 36 @VA14196 01400580
B ERRET30 @VA14196 01400600
SPACE 2 01401000
ERR70E LR R3,R6 GET INCORRECT PARAMETER @VA03257 01402000
ERROR070 EQU * 01403000
DMSERR NUM=70,LET=E,SUB=(CHARA,(R3)),TEXT='INVALID PARAMETER '+01404000
'........''' 01405000
LA R15,24 COMPLETION CODE 01406000
B ERRET20 RETURN TO CALLER 01407000
SPACE 2 01408000
ERROR096 LA R2,DATAIN+L'FSTSAVE ADDR. OF FNAME AND FTYPE @VA04519 01409000
DMSERR NUM=96,LET=E,SUB=(CHAR8A,(R2)),TEXT='FILE ''...........X01410000
......'' DATA BLOCK COUNT INCORRECT' @VA04519 01411000
LA R15,32 SET RETURN CODE @VA04519 01412000
B ERRET10 ABORT LOAD @VA04519 01413000
SPACE 2 @VA04519 01414000
ERROR104 EQU * 01415000
LA R2,8(,R1) POINT TO FHE FILE ID 01416000
DMSERR NUM=104,LET=S,SUB=(DECA,SAVER1+4,CHAR8A,(R2)),TEXT='ERR+01417000
OR ''..'' READING FILE ''....................'' FROM DIS+01418000
K',RENT=NO V0314 01419000
LA R15,100 COMPLETION CODE 01420000
B ERRET10 RETURN TO CALLER 01421000
SPACE 2 01422000
ERROR105 EQU * 01423000
LA R2,WRNAME GET NAME OF FILE BEING WRITTEN 01424000
ERROROUT EQU * 01425000
LA R7,WRMODE R7 POINTS TO MODE OF FILE 01426000
CH R15,=H'5' INVALID MODE SPECIFIED ? 01427000
BNH ERROR048 YES, TYPE OUT THE MESSAGE 01428000
CH R15,=H'12' DISK IS READ/ONLY ? 01429000
BE ERROR037 YES, TYPE OUT THE MESSAGE 01430000
LR R3,R15 GET THE RETURN CODE PASSED BY WRBUF 01431000
DMSERR NUM=105,LET=S,SUB=(DEC,(R3),CHAR8A,(R2)),TEXT='ERROR ''+01432000
...'' WRITING FILE ''.....................'' ON DISK',RE+01433000
NT=NO 01434000
LA R15,100 COMPLETION CODE 01435000
B ERRET10 RETURN TO CALLER 01436000
SPACE 2 01437000
ERROR110 EQU * 01438000
LH R2,TAPECCU GET THE DEVICE ADDRESS 01439000
LA R3,SYMTAPA GET IT'S SYMBOLIC NAME 01440000
DMSERR NUM=110,LET=S,SUB=(CHARA,(R3),HEX,(R2)),TEXT='ERROR REA+01441000
DING ''....(...)''',RENT=NO 01442000
LA R15,100 COMPLETION CODE 01443000
B ERRET10 RETURN TO CALLER 01444000
SPACE 2 01445000
ERROR111 EQU * 01446000
LH R2,TAPECCU GET THE DEVICE ADDRESS 01447000
LA R3,SYMTAPA SYMBOLIC DEVICE NAME 01448000
CH R15,=H'2' EOF OR EOT 01449000
BE ERROR058 YES, TYPE OUT THE MESSAGE 01450000
CH R15,=H'6' IS TAPE FILE PROTECTED ? 01451000
BE ERROR043 YES, TYPE OUT ERROR MESSAGE 01452000
DMSERR NUM=111,LET=S,SUB=(CHARA,(R3),HEX,(R2)),TEXT='ERROR WRI+01453000
TING ''....(...)''',RENT=NO 01454000
LA R15,100 COMPLETION CODE 01455000
B ERRET10 RETURN TO CALLER 01456000
SPACE 2 01457000
ERROR113 EQU * 01458000
LH R2,TAPECCU TAPE DEVICE ADDRESS 01459000
LA R3,SYMTAPA SYMBOLIC TAPE NAME 01460000
DMSERR NUM=113,LET=S,SUB=(CHARA,(R3),HEX,(R2)),TEXT='''....(..+01461000
.)'' NOT ATTACHED',RENT=NO 01462000
LA R15,100 COMPLETION CODE 01463000
B ERRET10 RETURN TO CALLER 01464000
SPACE 2 01465000
ERR115S EQU * P0917 01466000
LH R5,0(R5) POINT TO DEVICE V0037 01467000
DMSERR NUM=115,LET=S,SUB=(CHARA,(R8),HEX,(R5)), *01468000
TEXT='............ FEATURE NOT SUPPORTED ON DEVICE ''...*01469000
.''',RENT=NO 01470000
LA R15,88 RETURN CODE = 88 P0917 01471000
B ERRET30 P0917 01472000
SPACE 2 01473000
MSG701 EQU * USER READ IN A NULL FILE 01474000
DMSERR NUM=701,LET=I,TEXT='NULL FILE' 01475000
B TPSRSET SEE IF ANY MORE FILES TO BE LOOKED AT 01476000
* 01477000
* 01478000
* 01479000
* EXIT TO CALLER 01480000
* 01481000
* 01482000
RETURN EQU * 01483000
SR R15,R15 NO ERROR RETURN 01484000
ERRET10 EQU * 01485000
TM OPTBYTE,NODISK HAS A TRANSACTION RECORD BEEN CREATED 01486000
BO ERRET20 NO, RETURN 01487000
LR R3,R15 SAVE R15 (RETURN CODE ) 01488000
LA R1,OUTDISK R1=A(FINIS PARAMETER LIST) 01489000
MVC OUTCOMM,FINIS FUNCTION NAME = 'FINIS' 01490000
L R15,AFINIS FINIS @V305066 01491000
SSM TPEDIS DISABLE INTERRUPTS @VA07792 01491500
BALR R14,R15 ISSUE CALL TO FINIS TO CLOSE @V305066 01492000
SSM TPEENA ENABLE INTERRUPTS @VA07792 01492500
LR R15,R3 RESTORE R15 01493000
ERRET20 EQU * 01494000
TM OPTBYTE,NOPRINT WAS A PRINT FILE CREATED 01495000
BO ERRET30 NO, EXIT 01496000
LR R3,R15 SAVE THE RETURN CODE FROM TAPE 01497000
LA R1,CPCLOSE GET PLIST FOR CPF 01498000
SVC 202 CLOSE THE PRINTER FILE 01499000
LR R15,R3 RESTORE THE TAPE RETURN CODE 01500000
ERRET30 EQU * EXIT 01501000
TM FREESTOR,NOTUSED WAS STORAGE USED? @VA04052 01502000
BO ERRET40 BRANCH IF NOT @VA04052 01503000
LR R3,R15 SAVE R15 RETURN CODE @VA04052 01504000
LM R0,R1,FREESTOR POINT TO DMSFRET INFO @VA04052 01505000
DMSFRET DWORDS=(0),LOC=(1) @VA04052 01506000
LR R15,R3 RESTORE RETURN CODE @VA04052 01507000
ERRET40 EQU * @VA04052 01508000
L R14,SAVER14 RETURN USER'S R14 01509000
BR R14 EXIT 01510000
EJECT 01511000
********************************************************************** 01512000
* 01513000
* STORAGE SPACE AND CONSTANTS 01514000
* 01515000
********************************************************************** 01516000
* 01517000
DS 0F JS 01518000
LINECT DS H LINE COUNTER @VA00983 01519000
PTAPEIO DS 0F PARAMETER LIST FOR TAPEIO 01520000
DC CL8'TAPEIO' FUNCTION NAME 01521000
CONTROL DS CL8 TAPEIO FUNCTION 01522000
SYMTAPA DS CL4 SYMBOLIC TAPE ADDRESS 01523000
MODESETB DS BL1 MODESET BYTE 01524000
AIOBUFF DC AL3(0) A(I/O BUFFER) @VA03003 01525000
IOBUFF DC F'805' I/O BUFFER SIZE 01526000
BYTESRD DS F NUMBER OF BYTES READ/WRITTEN 01527000
ACARDIN DC AL3(0) A(INPUT BUFFER) @VA03003 01528000
ACARDOUT DC AL3(0) A(I/O BUFFER) @VA03003 01529000
WRITE DC CL8'WRITE' FOR TAPEIO WRITE CONTROL 01530000
READ DC CL8'READ' FOR TAPEIO READ CONTROL 01531000
SENSE DC CL8'SENSE' SENSE THE TAPE DEVICE 01532000
* 01533000
* MODESET OPTIONS - SET UP FOR 'ANDING' OPERATIONS 01534000
* 01535000
D200 EQU B'00000011' DENSITY = 200 01536000
D556 EQU B'01000011' DENSITY = 556 01537000
D8007TRK EQU B'10000011' DENSITY = 800BPI FOR 7 TRACK TAPE 01538000
D8009TRK EQU B'11001011' DENSITY = 800BPI FOR 9 TRACK TAPE 01539000
DRESET EQU B'11000011' DENSITY = RESET CONDITION, 1600BPI 01540000
D6250 EQU B'11010011' DENSITY=6250 @V200414 01541000
TRTCHO EQU B'00110011' ODD,CONV-OFF,TRANS-OFF,7TRACK ASSUMED 01542000
TRTCHOC EQU B'00010011' ODD,CONV-ON,TRANS-OFF,7TRACK ASSUMED 01543000
TRTCHOT EQU B'00111011' ODD,CONV-OFF,TRANS-ON,7TRACK ASSUMED 01544000
TRTCHE EQU B'00100011' EVEN,CONV-OFF,TRANS-OFF,7TRACK ASSUMED 01545000
TRTCHET EQU B'00101011' EVEN,CONV-OFF,TRANS-ON,7TRACK ASSUMED 01546000
TRACK7 EQU B'00110011' ODD,CONV-OFF,TRANS-OFF,7TRACK,DENSITY=800 01547000
TRACK9 EQU B'11000011' 9TRACK, 1600 BPI 01548000
PCT EQU B'00110000' TESTS THE PARITY AND CONVERTER BITS 01549000
KEEPDEN7 EQU X'C0' KEEP THE DENSITY SETTING FOR 7TRACK 01550000
KEEPDEN9 EQU X'C8' KEEP THE DENSITY SETTING FOR 9TRACK 01551000
KEEPTRK7 EQU X'3F' KEEP THE CONV. TRANS. BITS FOR 7TRACK 01552000
RESETM7 EQU X'93' 7 TRACK RESET CONDITION V0312 01553000
* 01554000
MVCNUM MVC 0(*-*,R4),0(R6) MOVE NUMBER FOR CONVERSION 01555000
EOFN DS 1F STORE NUMBER OF EOF'S WANTED, DEFAULT = 1 01556000
DBLWRD1 DS 1D FOR DEC-BIN CONVERSION 01557000
DBLWRD2 DS 1D FOR DEC-BIN CONVERSION 01558000
* 01559000
FREESTOR DS 2F DWORDS + ADDRESS OF FREE STOR @VA03003 01560000
NOTUSED EQU X'FF' @VA04052 01561000
EIGHTHD DC F'800' @VA03003 01562000
CONSTANT DC H'799' @VA03003 01563000
OPTBYTE DC BL1'11101100' OPTION BYTE 01564000
NOWTM EQU X'80' WTM|NOWTM 01565000
NOEOT EQU X'40' EOT|NOEOT 01566000
NOPRINT EQU X'20' PRINT|NOPRINT 01567000
NOTERM EQU X'10' TERM|NOTERM 01568000
NODISK EQU X'08' DISK|NODISK 01569000
NOEOFN EQU X'04' EOFN|NOEOFN 01570000
* 01571000
AFSTPLST DC A(FSTCMMD) FSTLKP PARAMETER LIST 01572000
FSTCMMD DS CL8 ROUTINE INVOKED = 'FSTLKP' OR 'ERASE' 01573000
SAVEFN DS CL8 FILENAME 01574000
SAVEFT DS CL8 FILETYPE 01575000
SAVEFM DS CL8 FILEMODE 01576000
* 01577000
COMPOPT CLC 0(*-*,R1),0(R5) DOES THIS FUNCTION MATCH 01578000
MVCFILID MVC SAVEFN(*-*),16(R3) MOVE FILED TO SAVE AREA 01579000
* 01580000
* FOLLOWING ARE CODES USED TO CHEK REAL DEVICE INFO FROM CP 01581000
* 01582000
FTR7TRK EQU X'80' P0917 01583000
FTRTRANS EQU X'20' P0917 01584000
FTRDCONV EQU X'10' P0917 01585000
FTRDLDNS EQU X'40' P0917 01586000
SPACE 1 01587000
TYP2401 EQU X'80' 2401 SERIES TAPE DRIVE P0917 01588000
TYP2415 EQU X'40' 2415 SERIES P0917 01589000
MODEL3 DC X'03' P0917 01590000
MODEL5 DC X'05' @VA02112 01591000
MODEL7 DC X'07' @VA02112 01592000
MODEL8 DC X'08' @VA02112 01593000
CLASTAPE DC X'08' TAPE DEVICE CODE P0917 01594000
FDIAG DC F'0' CP DIAGNOSE INFO FOR FEATURES P0917 01595000
ERR7TRK DC CL12'7-TRACK' P0917 01596000
ERRTRANS DC CL12'TRANSLATION' P0917 01597000
ERRDCONV DC CL12'CONVERSION' P0917 01598000
ERRDLDNS DC CL12'DUAL-DENSITY' P0917 01599000
TYP3420 EQU X'10' 3420 TYPE TAPE DRIVE @V200414 01600000
TYP2420 EQU X'20' 2420 TYPE TAPE DRIVE @V200414 01601000
ERRHIDEN DC CL12'6250 BPI' @V200414 01602000
ERR800BP DC CL12'800 BPI' @VA02112 01603000
ERR9TRK DC CL12'9-TRACK' @VA02112 01604000
ERR16BP DC CL12'1600 BPI' @VA04963 01605000
* 01606000
* PARAMETER LIST FOR RDBUF CALLS 01607000
* 01608000
INFILE DS 0D 01609000
INCOMM DS CL8 COMMAND NAME 01610000
INNAME DS CL8 FILE NAME 01611000
INTYPE DS CL8 FILE TYPE 01612000
INMODE DS CL2 FILE MODE 01613000
INITNO DC H'0' ITEM NUMBER 01614000
INBUFF DC A(0) BUFFER AREA @VA03003 01615000
INSIZE DC A(800) BUFFER SIZE 01616000
INFV DC CL1'F' FIXED/VARIABLE FLAG @VA04989 01617000
INFLAG DC CL1' ' NULL BLOK FLAG (NULL=X'00') @VA04989 01618000
INNOIT DC H'1' NUMBER OF ITEMS 01619000
INNORD DC F'0' NUMBER OF BYTES ACTUALLY READ 01620000
* 01621000
* PARAMETER LIST FOR WRBUF OR FINIS CALLS 01622000
* 01623000
WRFILE DS 0D 01624000
WRCOMM DS CL8 COMMAND NAME 01625000
WRNAME DS CL8 FILENAME 01626000
WRTYPE DS CL8 FILETYPE 01627000
WRMODE DS CL2 FILEMODE 01628000
WRITNO DC H'0' ITEM NUMBER 01629000
WRBUFF DC A(0) BUFFER AREA @VA03003 01630000
WRSIZE DC A(800) BUFFER SIZE 01631000
WRFV DC CL2'F' FIXED/VARIABLE FLAG 01632000
WRNOIT DC H'1' NUMBER OF ITEMS 01633000
WRNORD DC F'0' NUMBER OF BYTES READ 01634000
* 01635000
* ERASE PARAMETER LIST FOR TEMPORARY FILE 01636000
* 01637000
DS 0D 01638000
TEMPFILE DC CL8'ERASE' COMMAND NAME = 'ERASE' 01639000
DC CL8'TAPE' FILENAME = 'TAPE' 01640000
DC CL8'CMSUT1' FILETYPE = 'CMSUT1' 01641000
DC CL2' ' FILEMODE SUPPLIED AT EXECUTION TIME 01642000
* 01643000
* PARAMETER LIST FOR OUTPUTTING THE RECORD OF TAPE TRANSACTIONS 01644000
* 01645000
POUTPUT DS A A(WHERE OUTPUT WILL BE PUT FOR MAP) 01646000
* 01647000
OUTTERM DC CL8'TYPLIN' OUTPUT TO TERMINAL VIA TYPLIN 01648000
DC A(MESSAGE) MESSAGE TO BE OUTPUT 01649000
DC C'B',X'00' DO IT IN BLACK 01650000
LMSG DS AL2 LENGTH OF MESSAGE OUTPUT TO THE TERMINAL 01651000
OUTPRINT DC CL8'PRINTR' CALL DMSPIO FOR MSG OUTPUT 01652000
DC A(CARCTL) CARR CONTROL (EJECT OR SPACE) @VA00983 01653000
DC AL4(L'MESSAGE+L'CARCTL) LEN OF OUTPUT MESSAGE @VA00983 01654000
* PLUS LENGTH OF CARRIAGE CONTROL 01655000
* 01656000
OUTDISK DS 0D OUTPUT TO FILE TAPE MAP A5 @VA11834 01657000
OUTCOMM DC CL8'WRBUF' 01658000
OUTNAME DC CL8'TAPE' FILE NAME 01659000
OUTTYPE DC CL8'MAP' FILE TYPE 01660000
OUTMODE DC CL2'A5' FILE MODE @VA11834 01661000
OUTITNO DC H'0' ITEM NUMBER 01662000
OUTBUFF DC A(MESSAGE) BUFFER AREA 01663000
OUTSIZE DC A(80) BUFFER SIZE 01664000
OUTFV DC CL2'F' FIXED/VARIABLE FLAG 01665000
OUTNOIT DC H'1' NUMBER OF ITEMS 01666000
OUTNORD DC F'0' NUMBER OF BYTES ACTUALLY READ 01667000
* 01668000
CPCLOSE DS 0F CLOSE THE 'PRINT' FILE 01669000
DC CL8'CP' CALL DMSCPF 01670000
DC C'C E NAME TAPE MAP' 01671000
DC 4XL1'FF' END OF PLIST TO DMSPIO 01672000
* 01673000
CARCTL DS 1X ONE BYTE FOR CARRIAGE CONTROL @VA00983 01674000
MESSAGE DC CL80' ' MESSAGE CONTAINS FILE ID 01675000
SCANNING DC C'SCANNING....' USED WHEN SCANNING 01676000
LOADING DC C'LOADING.....' USED WHEN LOADING 01677000
DUMPING DC C'DUMPING.....' USED WHEN DUMPING 01678000
SKIPPING DC C'SKIPPING....' USED WHEN SKIPPING 01679000
EOFM DC C'END-OF-FILE OR END-OF-TAPE' 01680000
* 01681000
* REGISTER SAVE AREA 01682000
* 01683000
SAVER1 DS 1F A(BEGINNING OF OPTIONS OR FENCE IN PLIST) 01684000
DS 1F V0155 01685000
SAVER14 DS 1F RETURN ADDRESS 01686000
* 01687000
RDBUF DC CL8'RDBUF' FOR CALLS TO RDBUF 01688000
WRBUF DC CL8'WRBUF' FOR CALLS TO WRBUF 01689000
FINIS DC CL8'FINIS' FOR CALLS TO FINIS 01690000
* 01691000
TAPECCU DS 1H SAVE THE DEVICE ADDRESS 01692000
SPACE 01693000
DS 0D @VA00859 01694000
CMDACT DC CL8'FINIS' CLOSE AN ACTIVE FILE @VA00859 01695000
FNACT DC CL8' ' COPY FNAME @VA00859 01696000
DC CL8' ' COPY FTYPE @VA00859 01697000
FMACT DC CL2' ' COPY FMODE @VA00859 01698000
ITNOACT DC H'0' ITEM NUMBER FOR POINT @VA00859 01699000
SPACE 01700000
SAVE10R DC 10F'0' SAVE AREA FOR ACTLKP @VA00859 01701000
SAVERPTR DC H'0' SAVE AN ACTIVE FILES READ PTR@VA00859 01702000
ACTFLAG DC X'00' ACTIVE FILE FLAG @VA00859 01703000
RESET EQU X'80' RE-OPEN THE CURRENT FILE @VA00859 01704000
POINT DC CL8'POINT' @VA00859 01705000
* 01706000
DS 0D 01707000
STATLST DC CL8'STATE' P0953 01708000
STATFN DC CL8' ' @VA14821 01709500
DC CL8' ' P0953 01710000
STATFM DC CL8' ' P0953 01711000
PERASE DC CL8'ERASE' 01712000
DC CL8'TAPE' ACTIVE FILENAME 01713000
DC CL8'MAP' ACTIVE FILETYPE 01714000
DC CL2'A5' A DISK ONLY @VA11834 01715000
DS 0D 01716000
ACTERS DC CL8'ERASE' COMMAND NAME = 'ERASE' 01717000
ACTFN DS CL8 FILENAME 01718000
ACTFT DS CL8 FILETYPE 01719000
ACTFM DS CL2 FILEMODE 01720000
DS 0F 01721000
FSTSAVE DS CL(16*4) 01722000
FSTSAVAD DC F'0' SAVE THE ENTRY ADDRESS @VA01998 01723000
SAVEMODE DC X'0' SAVE THE MODE NUMBER @VA01998 01724000
CHLINK DS CL2 01725000
* 01726000
TPEFLG DS 1X TAPE FLAGS 01727000
PRTMATCH EQU X'80' MATCH FOR PRINTOUT 01728000
MATCHFN EQU X'40' MATCH ON FILENAME 01729000
MATCHFT EQU X'20' MATCH ON FILETYPE 01730000
MATCHFM EQU X'10' MATCH ON FILEMODE (NUMBER) P0953 01731000
EOTF EQU X'01' ON SIGNALS 1 TAPE MARK READ P0735 01732000
LOADPROC EQU X'08' LOADING IN PROGRESS P0735 01733000
INPUT EQU X'04' ONE MATCH FOUND @VA01415 01734000
NINETK EQU X'02' 9TRACK MODE SET @V200414 01735000
NINEOFF EQU X'FD' USED TO SET 7TRACK IND. @V200414 01736000
* 01737000
FLAGS DC X'00' INTERNAL FLAGS 01738000
DENSITY EQU X'80' DENSITY HAS BEEN SPECIFIED BY USER 01739000
MATCH EQU X'40' EXACT FILID MATCH REQUESTED 01740000
SCNSWT EQU X'20' SCANNING, NOT DUMPING 01741000
SKPSWT EQU X'10' SKIPPING 01742000
LOADSWT EQU X'08' INDICATES THAT TAPE LOADING IN PROCESS 01743000
DUMPSWT EQU X'04' DUMP FUNCTION 01744000
MODESWT EQU X'02' MODESET FUNCTION 01745000
CONTLSWT EQU X'01' TAPE CONTROL FUNCTION 01746000
FLAGS2 DC X'00' SECOND INTERNAL FLAG BYTE. @VA11948 01746100
NOTBLANK EQU X'40' TAPE IS NOT BLANK. @VA11948 01746200
* @VA04989 01747000
* MISC. EQUATES @VA04989 01748000
CZERO EQU C'0' @VA04989 01749000
BZERO EQU 0 @VA04989 01750000
BLANK EQU C' ' @VA04989 01751000
FF EQU X'FF' @VA07150 01752000
EIGHT EQU 8 @VA07150 01753000
* 01754000
C6250 DC CL5'6250 ' @VA07148 01755000
* @VA07148 01756000
* TABLE OF TAPE COMMANDS 01757000
* 01758000
DS 0F 01759000
TAB EQU * 01760000
DUMP DC CL8'DUMP' JS 01761000
DC AL1(DUMPSWT),AL3(TPDUMP) 01762000
LOAD DC CL8'LOAD' 01763000
DC AL1(LOADSWT),AL3(TPLOAD) 01764000
SKIP DC CL8'SKIP' 01765000
DC AL1(SKPSWT),AL3(TPSKIP) 01766000
SCAN DC CL8'SCAN' 01767000
DC AL1(SCNSWT),AL3(TPSCAN) 01768000
MODESET DC CL8'MODESET' MODESET 01769000
DC AL1(MODESWT),AL3(TPMODEST) 01770000
BSF DC CL8'BSF' BSF 01771000
DC AL1(CONTLSWT),AL3(TPCONTL) 01772000
BSR DC CL8'BSR' BSR 01773000
DC AL1(CONTLSWT),AL3(TPCONTL) 01774000
ERG DC CL8'ERG' ERG 01775000
DC AL1(CONTLSWT),AL3(TPCONTL) 01776000
FSF DC CL8'FSF' FSF 01777000
DC AL1(CONTLSWT),AL3(TPCONTL) 01778000
REW DC CL8'REW' REW 01779000
DC AL1(CONTLSWT),AL3(TPCONTL) 01780000
RUN DC CL8'RUN' RUN 01781000
DC AL1(CONTLSWT),AL3(TPCONTL) 01782000
WTM DC CL8'WTM' WTM 01783000
DC AL1(CONTLSWT),AL3(TPCONTL) 01784000
FSR DC CL8'FSR' FSR 01785000
DC AL1(CONTLSWT),AL3(TPCONTL) P0735 01786000
TABN EQU * END OF FUNCTION LIST 01787000
INDEXS DC A(TAB,12,TABN-12) 01788000
TPEENA DC X'FF' @VA06258 01789000
TPEDIS DC X'00' @VA06258 01790000
* 01791000
* LITERALS 01792000
* 01793000
LTORG 01794000
HEADER DC X'02C3D4E2' TAPE RECORD HEADER @VA03003 01795000
HEADERTR DC X'C2C3D4E2' TAPE HEADER READ WITH TRANSLATION @VA08107 01795100
TAPEBUF DSECT @VA03003 01796000
DS CL3 @VA03003 01797000
CARDOUT DS CL4 X'02', C'CMS' @VA04989 01798000
FLAGOUT DS CL1 'N'=END OF FILE, '0'=NULL BLOK @VA04989 01799000
DATAOUT DS CL800 @VA03003 01800000
DS 3C @VA03003 01801000
CARDIN DS CL4 X'02', C'CMS' @VA04989 01802000
FLAGIN DS CL1 'N'=END OF FILE, '0'=NULL BLOK @VA04989 01803000
DATAIN DS CL800 @VA03003 01804000
EJECT 01805000
PRINT GEN 01806000
NUCON 01807000
REGEQU 01808000
ADT (R12) 01809000
AFT @VA00859 01810000
EJECT 01811000
FVS 01812000
EJECT 01813000
FSTB 01814000
DEVSECT 01815000
END 01816000