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