ibm:vm370-lib:cms:dmstpe.assemble_src
Table of Contents
DMSTPE Source
References
- Fixes Applied : 7
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC002DS]
Source Listing
- DMSTPE.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmstpe.assemble_src.txt · Last modified: 2024/06/18 19:49 by Site Administrator