TPD TITLE 'DMSTPD (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 * 00006000 * 00007000 * MODULE NAME: 00008000 * 00009000 * DMSTPD (TAPPDS) 00010000 * 00011000 * FUNCTION: 00012000 * 00013000 * ENABLE USERS TO READ A TAPE CONSISTING OF CARD IMAGES 00014000 * MEMBERS OF A PDS AND CREATE CMS DISK FILE(S) FOR EACH 00015000 * MEMBER OF THE DATA SET, OR TO READ A TAPE CONSISTING 00016000 * OF UNLOADED PDS AND CREATE CMS DISK FILE(S) FOR EACH 00017000 * MEMBER OF THE DATA SET. THE PDS OPTION WILL ALLOW TO 00018000 * TO READ UNBLOCKED TAPES PRODUCED BY THE O/S IEBPTPCH 00019000 * UTILITY, OR BLOCKED TAPES PRODUCED BY THE O/S IEHMOVE 00020000 * UTILITY. THE UPDATE OPTION WILL PROVIDE THE './ ADD' 00021000 * FUNCTION TO TAPES, BLOCKED OR UNBLOCKED, PRODUCED BY 00022000 * THE O/S IEBUPDTE UTILITY. 00023000 * 00024000 * ATTRIBUTES: 00025000 * 00026000 * DISK RESIDENT 00027000 * 00028000 * ENTRY POINTS: 00029000 * 00030000 * DMSTPD 00031000 * 00032000 * ENTRY CONDITIONS: 00033000 * 00034000 * GPR1 = A(PLIST) 00035000 * PLIST DC CL8'TAPPDS' 00036000 * 00037000 * DC CL8'FILENAME'|'TAPPDS' 00038000 * 00039000 * DC CL8'FILETYPE'|'CMSUT1' 00040000 * 00041000 * DC CL8'FILEMODE'|'A1' 00042000 * 00043000 * DC CL8'(' DEFAULT OPTIONS APPEAR FIRST: 00044000 * 00045000 * DC CL8'PDS'|'NOPDS'|'UPDATE' 00046000 * 00047000 * DC CL8'NOCOL1'|'COL1' 00048000 * 00049000 * DC CL8'TAP1'|'TAPX' 00050000 * 00051000 * DC CL8'NOEND'|'END' 00052000 * 00053000 * DC CL8'NOMAXTEN'|'MAXTEN' 00054000 * 00055000 * EXIT CONDITIONS: 00056000 * 00057000 * NORMAL 00058000 * 00059000 * GPR15 = 0 : NO ERRORS. 00060000 * 00061000 * ERROR 00062000 * 00063000 * GPR15 = 00064000 * 24 INVALID DISK MODE 00065000 * 24 OPTION ERROR 00066000 * 40 TWO ADJACENT TAPE MARKS ENCOUNTERED 00067000 * 100 TAPE ERROR 00068000 * 100 ERROR WRITING TO DISK 00069000 * 104 VIRTUAL STORAGE CAPACITY EXCEEDED 00070000 * 00071000 * CALLS TO OTHER ROUTINES: 00072000 * 00073000 * DMSBWR,DMSFNS,DMSSTT,DMSAUDL,DMSERS,DMSCWR,DMSTIO,DMSERR 00074000 * 00075000 * EXTERNAL REFERENCES: 00076000 * 00077000 * NONE. 00078000 * 00079000 * TABLES/WORKAREAS: 00080000 * 00081000 * PLISTS FOR THE CALLS AND OTHER ROUTINES. 00082000 * 00083000 * REGISTER USAGE: 00084000 * 00085000 * GPR12 = BASE REGISTER 00086000 * GPR1 = A(PARAMETER LIST) 00087000 * 00088000 * NOTES: 00089000 * 00090000 * WHEN PROCESSING UNLOADED PDS, ALL OPTIONS ARE IGNORED. 00091000 * 00092000 * OPERATION: 00093000 * 00094000 * TAPPDS SETS FLAG BITS EITHER TO THE DEFAULT SETTING 00095000 * OR TO THE REQUESTED OPTION SETTING. IF A USER 00096000 * FILENAME, FILETYPE, OR TAPE UNIT IS REQUESTED, THESE 00097000 * ARE SAVED IN LOCATIONS NAM1, NAM2, AND TAPID. TAPE 00098000 * RECORDS ARE READ, & THE END-OF-FILE FLAG IS CLEARED 00099000 * AFTER EACH READ. IF O/S LABELS ARE ON THE TAPE, THEY 00100000 * ARE TYPED TO THE TERMINAL AND THE NEXT RECORD IS 00101000 * READ. 00102000 * 00103000 * IF DATA COLUMNS 1-7 CONTAIN 'MEMBER', THE OPTION BITS 00104000 * ARE CHECKED FOR THE PARTITIONED DATA SET REQUEST. IF 00105000 * THERE IS A PDS REQUEST AND THE FILE IS OPEN, FINIS 00106000 * IS CALLED TO CLOSE THE OLD FILE, THE USER IS NOTIFIED 00107000 * AND THE PROGRAM CONTINUES. OTHERWISE, 00108000 * STATE IS CALLED FOR THE FILE - IF IT EXISTS, ERASE IS 00109000 * CALLED. THE OPEN FILE BIT IS SET ON, AND THE RECORDS 00110000 * ARE BROUGHT IN. IF THERE IS NO PDS REQUEST, THE 00111000 * FIELD IS IGNORED, THE FILE OPENED, AND WRBUF IS 00112000 * CALLED TO WRITE THE RECORD ON DISK. SUCCEEDING 00113000 * RECORDS GO DIRECTLY TO WRBUF UNTIL TAPPDS ENCOUNTERS 00114000 * EITHER THE NEXT 'MEMBER' CARD (PDS) OR A TAPE MARK IS 00115000 * READ (NOPDS). IF THE 'END' OPTION IS SPECIFIED, PRO- 00116000 * CESSING CONTINUES UNTIL AN 'END' CARD IS ENCOUNTERED. 00117000 * FOR 'NOPDS', THE FILE IS CLOSED, AND PROCESSING STOPS 00118000 * WITH THE TAPE POSITIONED AFTER THE 'END' CARD. 00119000 * FOR 'PDS', THE FILE IS CLOSED BY CMS FINIS, THE USER 00120000 * IS INFORMED, AND THE 'MAXTEN' COUNTER IS UPDATED AND 00121000 * CHECKED. IF 'MAXTEN' IS REQUESTED, AND THE LIMIT IS 00122000 * REACHED, THE TAPE IS BACKSPACED, THE USER IS INFORMED 00123000 * AND THE PROGRAM IS TERMINATED. IF THE 'MAXTEN' OPTION 00124000 * IS NOT SPECIFIED, TAPPDS SCANS FOR THE NEXT FILE. 00125000 * 00126000 * 00127000 * TAPPDS, WITH THE 'UPDATE' OPTION, WILL SCAN FOR './' 00128000 * CARDS, WHICH ARE USED AS 'IEBUPDTE' CONTROL CARDS, IN 00129000 * ORDER TO LOAD SOURCE DECKS INTO CMS DISK FILES. TAPPDS 00130000 * WILL ONLY RECOGNIZE THE './ ADD' CARD WITH A 'NAME=' 00131000 * PARAMETER FROM WHICH TAPPDS GETS THE CMS FILENAME. A 00132000 * DEFAULT FILENAME OF 'TAPPDS' WILL BE USED IF 'NAME=' 00133000 * IS MISSING OR FOLLOWED BY A BLANK. A DEFAULT FILETYPE 00134000 * OF 'ASSEMBLE' IS USED, UNLESS OTHERWISE SPECIFIED BY 00135000 * THE USER IN THE COMMAND LINE. 00136000 * THE 'END' OPTION IS DISABLED WITH THE 'UPDATE' OPTION. 00137000 * ALL './' CARDS ARE DELETED BEFORE THE FILE IS WRITTEN 00138000 * TO DISK. WHEN A './ ENDUP' CARD IS FOUND, THE CURRENT 00139000 * FILE IS CLOSED, THE USER IS INFORMED, AND PROCESSING 00140000 * STOPS WITH NO REPOSITIONING OF THE TAPE. 00141000 * 00142000 * IF THE FIRST RECORD READ SHOWS THAT THE FILE BELONGS 00143000 * TO AN UNLOADED PDS, THE DSCB FOR THE DATA SET (RECORD 00144000 * 2) IS READ, AND THE 'RECFM' AND 'LRECL' ARE SAVED FOR 00145000 * LATER USE. THE 1ST. MEMBER HEADER RECORD IS READ. ALL 00146000 * DUMMY AND NOTELIST RECORDS ARE IGNORED. ALL PDS DATA 00147000 * RECORDS ARE WRITTEN TO DISK (IF THE DATA SET IS FIXED 00148000 * BLOCKED, THE DATA SET IS DEBLOCKD AND WRITTEN TO DISK 00149000 * AS FIXED). WHEN THE NEXT MEMBER HEADER RECORD IS READ, 00150000 * OR A TAPE MARK IS READ, THE FILE IS CLOSED, THE USER 00151000 * IS INFORMED, AND THE NEW FILE IS OPENED (IF NOT EOF). 00152000 * EVERYTIME A NEW MEMBR HEADER RECORD IS READ, STATE IS 00153000 * CALLED TO VERIFY IF ANY OLD FILE EXISTS, AND IF FOUND 00154000 * ERASE IS CALLED TO ERASE THE OLD FILE. 00155000 * 00156000 * AN ENCOUNTER OF TWO TAPE MARKS IN A ROW WILL ALSO 00157000 * TERMINATE THE PROGRAM. 00158000 * 00159000 *. 00160000 EJECT 00161000 DMSTPD CSECT 00162000 USING DMSTPD,R12 00163000 USING NUCON,R0 @V305001 00163100 LR R12,R15 GET ADDRESSABILITY 00164000 OI FLAG,PDS+BTOF SET DEFAULT VALUES 00165000 * 00166000 LA R1,8(,R1) INTERPRET PARAMETER LIST 00167000 CLC 0(4,R1),FENCE END OF LIST ? 00168000 BE TOP YES, BYPASS LIST DECODE 00169000 CLI 0(R1),C'(' BEGIN OF OPTIONS ? 00170000 BE PARLOOP YES, DETERMINE OPTIONS 00171000 CLC 0(2,R1),STAR DEFAULT FILENAME SPECIFIED ? 00172000 BE LOOKTYPE YES, CHECK FILETYPE 00173000 MVC NAM1,0(R1) PROVIDE USER FILENAME 00174000 LOOKTYPE LA R1,8(,R1) BUMP TO FILETYPE 00175000 CLC 0(4,R1),FENCE END OF LIST ? 00176000 BE STATCALL YES, CALL STATE 00177000 CLI 0(R1),C'(' BEGIN OF OPTIONS ? 00178000 BE STATCALL YES, CALL STATE 00179000 CLC 0(2,R1),STAR DEFAULT FILETYPE SPECIFIED ? 00180000 BE DEFTYPE YES, CHECK FILEMODE 00181000 MVC NAM2,0(R1) PROVIDE USER FILETYPE 00182000 DEFTYPE LA R1,8(,R1) BUMP TO FILEMODE 00183000 CLC 0(4,R1),FENCE END OF LIST ? 00184000 BE STATCALL YES, CALL STATE 00185000 CLI 0(R1),C'(' BEGIN OF OPTIONS ? 00186000 BE STATCALL IF SO, GO CALL STATE 00187000 CLC 0(2,R1),STAR DEFAULT FILEMODE SPECIFIED ? 00188000 BE BUMP YES, BUMP TO START OPTIONS 00189000 MVC MODE(2),0(R1) PROVIDE USER FILEMODE 00190000 CLI MODE+1,C' ' IS FILEMODE NUMBER BLANK @VA04055 00190100 BNE BUMP BR TO BUMP IF NUMBER GIVEN @VA04055 00190200 MVI MODE+1,C'1' SPECIFY 1 IF NOT @VA04055 00190300 BUMP LA R1,8(,R1) BUMP TO OPTIONS 00191000 STATCALL LR R2,R1 SAVE LINE POINTER 00192000 MVC STATNAME(18),NAM1 MAKE UP STATE FILEID 00193000 LA R1,STATLIST GET STATE LIST 00194000 SVC 202 CALL STATE 00195000 DC AL4(*+4) ... 00196000 LTR R15,R15 ANY ERRORS FROM STATE ? 00197000 BZ CHEKEND NO, KEEP CHECKING LINE 00198000 CH R15,=H'28' WAS IT 'NOT FOUND' ? 00199000 BNE RETURN NO, SYNTAX OR DISK ERROR 00200000 CHEKEND LR R1,R2 RESTORE LINE POINTER 00201000 CLC 0(4,R1),FENCE END OF LIST ? 00202000 BE TOP YES, GET OUT OF LINE SCAN 00203000 CLI 0(R1),C'(' START OF OPTIONS ? 00204000 BNE ERR3E NO, ABSOLUTELY AN ERROR 00205000 EJECT 00206000 PARLOOP LA R1,8(,R1) POINT TO 1ST OPTION 00207000 CLC 0(4,R1),FENCE END OF LIST ? 00208000 BE TOP YES, BYPASS OPTION CHECKING 00209000 CLI 0(R1),C')' END OF OPTIONS ? 00210000 BE TOP YES, BYPASS OPTION CHECKING 00211000 CLC 0(8,R1),=CL8'PDS' IS OPTION 'PDS' ? 00212000 BNE TNPDS NO, CHECK 'NOPDS' 00213000 OI FLAG,PDS SET 'PDS' FLAG 00214000 NI FLAG2,255-UPDATE AND 'NOPDS' OFF 00215000 B PARLOOP GET NEXT OPTION 00216000 TNPDS CLC 0(8,R1),=CL8'NOPDS' IS OPTION 'NOPDS' ? 00217000 BNE TCOL1 NO, CHECK 'COL1' 00218000 NI FLAG,255-PDS CLEAR 'PDS' FLAG 00219000 B PARLOOP GET NEXT OPTION 00220000 TCOL1 CLC 0(8,R1),=CL8'COL1' IS OPTION 'COL1' ? 00221000 BNE TNCOL1 NO, CHECK 'NOCOL1' 00222000 OI FLAG,COL1 SET 'COL1' FLAG 00223000 B PARLOOP GET NEXT OPTION 00224000 TNCOL1 CLC 0(8,R1),=CL8'NOCOL1' IS OPTION 'NOCOL1' ? 00225000 BNE TTAP NO, CHECK 'TAPX' 00226000 NI FLAG,255-COL1 CLEAR 'COL1' FLAG 00227000 B PARLOOP GET NEXT OPTION 00228000 TTAP CLC 0(3,R1),=C'TAP' IS OPTION 'TAPX' ? 00229000 BNE TEND NO, CHECK 'END' 00230000 CLI 3(R1),C'0' IS IT TAP0 ? HRC002DS 00231390 BL ERR3E IF LESS THAN 0, ERROR HRC002DS 00231780 CLI 3(R1),C'9' IS IT TAP4 ? HRC002DS 00232170 BNH TTAPX IF <= 9, OK HRC002DS 00232560 CLI 3(R1),C'A' IS IT TAP0 ? HRC002DS 00232950 BL ERR3E IF LESS THAN A, ERROR HRC002DS 00233340 CLI 3(R1),C'F' IS IT TAPF ? HRC002DS 00233730 BH ERR3E IF HIGHER THAN F, ERROR HRC002DS 00234120 TTAPX EQU * HRC002DS 00234510 CLI 4(R1),C' ' ANYMORE DIGITS ? 00235000 BNE ERR3E YES, DEFINITELY AN ERROR 00236000 MVC TAPID(4),0(R1) SET TAPEID FOR TAPEIO 00237000 B PARLOOP GET NEXT OPTION 00238000 TEND CLC 0(8,R1),=CL8'END' IS OPTION 'END' ? 00239000 BNE TNEND NO, CHECK 'NOEND' 00240000 OI FLAG,END SET 'END' FLAG 00241000 B PARLOOP GET NEXT OPTION 00242000 TNEND CLC 0(8,R1),=CL8'NOEND' IS OPTION 'NOEND' ? 00243000 BNE TUPDATE NO, CHECK 'UPDATE' 00244000 NI FLAG,255-END CLEAR 'END' FLAG 00245000 B PARLOOP GET NEXT OPTION 00246000 TUPDATE CLC 0(8,R1),=CL8'UPDATE' IS OPTION 'UPDATE' ? 00247000 BNE TMAXTEN NO, CHECK 'MAXTEN' 00248000 OI FLAG2,UPDATE SET 'UPDATE' FLAG 00249000 NI FLAG,255-END-PDS CLEAR 'END' & 'PDS' FLAGS 00250000 B PARLOOP GET NEXT OPTION 00251000 TMAXTEN CLC 0(8,R1),=CL8'MAXTEN' IS OPTION 'MAXTEN' ? 00252000 BNE TNMAXTEN NO, CHECK 'NOMAXTEN' 00253000 OI FLAG,MAXTEN SET 'MAXTEN' FLAG 00254000 B PARLOOP GET NEXT OPTION 00255000 TNMAXTEN CLC 0(8,R1),=CL8'NOMAXTEN' IS OPTION 'NOMAXTEN' ? 00256000 BNE ERR3E NO, THEN MUST BE INVALID 00257000 NI FLAG,255-MAXTEN CLEAR 'MAXTEN' FLAG 00258000 B PARLOOP GET NEXT OPTION 00259000 EJECT 00260000 TOP EQU * 00261000 MVC DOSF(1),DOSFLAGS SAVE NUCON'S DOSFLAGS @V305001 00261100 DMSEXS NI,DOSFLAGS,255-DOSSVC SET DOSSVC OFF (IF ON) @V305001 00261200 GETMAIN VC,LA=REQS,A=UPBUF @VA00766 00262000 MVC TAPBUFSZ(4),UPBUF+4 BUFFER SIZE TO TAPIO LIST @VA00766 00263000 L R11,UPBUF GET THE BUFFER ADDRESS @VA00766 00264000 STCM R11,7,TAPBUFAD SAVE IT IN TAPEIO LIST @VA00766 00265000 A R11,TAPBUFSZ GET TOP OF AREA GETMAIN'D @V200801 00266000 ST R11,UPBUFHI SAVE FOR LATER USE @V200801 00267000 MVC 0(4,R11),=C'VOL1' PREPARE BUFFER @VA00766 00268000 TM FLAG2,UPDATE 'UPDATE' OPTION SPECIFIED ? 00269000 BZ NOUP NO, SKIP FILETYPE CHECK 00270000 CLC NAM2(8),=CL8'CMSUT1' WAS FILETYPE SPECIFIED ? 00271000 BNE NOUP NO, LEAVE FILETYPE ALONE 00272000 MVC NAM2(8),=CL8'ASSEMBLE' SET DEFAULT FILETYPE 00273000 MVC STATNAME(16),NAM1 ALSO STATE LIST 00274000 NOUP MVC FILETYPE,NAM2 PROVIDE 'WRBUF' WITH FILETYPE 00275000 MVC FILEMODE,MODE AND FILEMODE ALSO 00276000 TM FLAG,PDS 'PDS' OPTION SPECIFIED ? 00277000 BO TAPEREAD YES, USE MEM NAMES AS FNAME 00278000 MVC FILENAME,NAM1 OTHERWISE, USE A FILENAME 00279000 TAPEREAD LA R1,TAPLIST READ A TAPE RECORD 00280000 SVC 202 ... 00281000 DC AL4(TAPERR) ERROR EXIT 00282000 TM CSW+5,X'40' INCORRECT LENGTH ? @VA00766 00283000 BZ POSTREAD NO, NO PROBLEM THEN @VA00766 00284000 CLC CSW+6(2),H0 ANY DATA READ AT ALL ? @VA00766 00285000 BE SIZERR NO, NEED LARGER BUFFER @VA00766 00286000 POSTREAD L R8,TAPBUFAD-1 GET THE BUFFER ADDRESS @VA00766 00287000 TM FLAG,BTOF IS THIS THE BEGINNING ? 00288000 BNO PR2 NO, DON'T CHECK FOR HEADERS 00289000 CLC 0(3,R8),=C'VOL' IS IT O/S VOL1 LABEL ? @VA00766 00290000 BE LABEL YES, PROCESS IT 00291000 CLC 0(3,R8),=C'HDR' IS IT O/S HDR LABEL ? @VA00766 00292000 BE LABEL YES, PROCESS IT 00293000 BAL LKGR,TIEHMOVE GO SEE IF UNLOADED PDS @V200801 00294000 PR2 TM FLAG,EOF TAPE MARK BEEN READ ? 00295000 BNO TAPRD01 NO, CHECK DATA IN BUFFER 00296000 CLC 0(3,R8),=C'EOF' IS IT O/S EOF LABEL ? @VA00766 00297000 BE LABEL YES, PROCESS IT 00298000 CLC 0(3,R8),=C'EOV' IS IT O/S EOV LABEL ? @VA00766 00299000 BE STOP YES, WE ARE ALL DONE 00300000 EJECT 00301000 TAPRD0 NI FLAG,255-EOF-BTOF INDICATE NO TAPE MARKS 00302000 TAPRD01 TM FLAG,COL1 DATA IN COLUMN 1 ? 00303000 BO MEMCHEK YES, CHECK IF MEMBER RECORD 00304000 LA R8,1(,R8) START SCANNING FROM COLUMN 2 00305000 MEMCHEK CLC 0(7,R8),=CL7'MEMBER' IS THIS A 'MEMBER' RECORD ? 00306000 BE MEMBR YES, CHECK IF 'PDS' SPECIFIED 00307000 TAPRD1 TM FLAG2,UPDATE UPDATE OPTION SPECIFIED ? 00308000 BO UPDATES YES, GO PROCESS IT 00309000 TM FLAG,FILEOPEN IS OUTPUT FILE OPEN ? 00310000 BZ FILECHEK NO, THEN OPEN IT 00311000 WRITEIT LR R2,R8 GET THE BUFFER ADDRESS @VA00766 00312000 ST R2,FILEBUFF AND STORE IN BUFF POCKET 00313000 LA R1,FILE GET WRBUF LIST 00314000 SVC 202 WRITE THE RECORD 00315000 DC AL4(ERR105S) ERROR EXIT 00316000 TM FLAG,END END OPTION SPECIFIED ? 00317000 BZ TAPEREAD CONTINUE READ LOOP 00318000 * 00319000 * SCAN FOR END CARD 00320000 * 00321000 TESTEND L R1,TAPSIZE GET RECORD LENGTH 00322000 CLC 0(4,R2),=CL4'END' IS THIS 'END' RECORD ? 00323000 BE CLOZER YES, FILE DONE..CLOSE IT 00324000 CLI 0(R2),C'*' IS IT COMMENT RECORD ? 00325000 BE TAPEREAD YES, IGNORE IT 00326000 TESTEND1 CLI 0(R2),C' ' FIND FIRST BLANK 00327000 BE TESTEND2 FOUND IT, FIND 1ST NON-BLANK 00328000 LA R2,1(,R2) INCREMENT PAST BLANK 00329000 BCT R1,TESTEND1 KEEP LOOKING THRU BUFFER 00330000 B TAPEREAD NO BLANKS FOUND - NORMAL RECORD 00331000 SPACE 00332000 TESTEND2 CLI 0(R2),C' ' FIND FIRST NON-BLANK AFTER 00333000 BNE TESTEND3 FIRST BLANK 00334000 LA R2,1(,R2) INCREMENT PAST NON-BLANK 00335000 BCT R1,TESTEND2 KEEP LOOKING THRU BUFFER 00336000 B TAPEREAD NONE FOUND - READ NEXT RECORD 00337000 SPACE 00338000 TESTEND3 CLC 0(4,R2),=CL4'END' NOW, IS IT 'END' ? 00339000 BNE TAPEREAD NO, IT IS A NORMAL RECORD 00340000 CLOZER BAL LKGR,CLOZFILE CLOSE THIS FILE 00341000 TM FLAG,PDS PDS OPTION SPECIFIED ? 00342000 BZ STOP NO, SEQUENTIAL DATASET: STOP 00343000 B TAPEREAD LETS START AGAIN FOR NXT MEM 00344000 EJECT 00345000 MEMBR TM FLAG,PDS PROCESSING PDS ? 00346000 BZ TAPRD1 IGNORE 'MEMBER' RECORD THEN 00347000 TM FLAG,FILEOPEN IS THE FILE OPEN ? 00348000 BZ NEWMEMBR NO, THIS MUST BE FIRST ONE 00349000 BAL LKGR,CLOZFILE CLOSE THE OLD ONE 00350000 NEWMEMBR LA R7,13(R8) POINT TO BEG OF MEMBER NAME @VA00766 00351000 SR R8,R8 READY FOR CHAR COUNT @VA00766 00352000 BLOOP CLI 0(R7),C' ' LOOK FOR START OF MEMBER NAME 00353000 BNE FOUND NON-BLANK MUST BE BEGIN 00354000 LA R7,1(,R7) BUMP TO NEXT CHARACTER 00355000 B BLOOP KEEP LOOKING 00356000 FOUND LR R9,R7 SAVE NAME START 00357000 FOUND1 LA R8,1(,R8) LETS COUNT CHARS IN NAME 00358000 LA R7,1(,R7) BUMP TO NEXT CHAR 00359000 CLI 0(R7),C' ' IS IT END OF NAME ? 00360000 BE ENDNAM YES, SET IF WITHIN LIMITS 00361000 CLI 0(R7),C',' CHECK COMMA FOR UPDATES 00362000 BNE FOUND1 IF NEITHER, LOOP 00363000 ENDNAM MVI FILENAME,C' ' BLANK-OUT DISK NAME AREA 00364000 MVC FILENAME+1(7),FILENAME ... 00365000 CH R8,=H'8' IS MEMBER NAME UNDER 8 CHARS ? 00366000 BNH MOVNAME YES, USE IT THEN 00367000 LA R8,8 GET MAX LENGTH ALLOWED 00368000 MOVNAME BCTR R8,0 DECREMENT FOR 'EXECUTE' 00369000 EX R8,MEMNAME PROVIDE MEMBR NAME FOR WRITE 00370000 MEMOPEN BAL LKGR,OPENFILE OPEN THE NEW FILE 00371000 TM FLAG2,UPDATE UPDATE OPTION SPECIFIED ? 00372000 BO BXLE YES, USE DEBLOCKING 00373000 B TAPEREAD GO READ NEXT RECORD 00374000 SPACE 00375000 FILECHEK TM FLAG,PDS WAIT FOR 'MEMBER' OF PDS 00376000 BO TAPEREAD ... 00377000 BAL LKGR,OPENFILE OPEN NEW OUTPUT FILE 00378000 B WRITEIT WRITE RECORD TO IT 00379000 SPACE 00380000 LABEL TM FLAG,BEGUN HAVE WE STARTED A FILE YET ? 00381000 BO TAPRD0 YES, DO NOT TYPE LABEL 00382000 BAL LKGR,SHOWTAPE TYPE OUT THE LABEL 00383000 B TAPEREAD AND GO ON READING 00384000 EJECT 00385000 UPDATES LR R3,R8 R3 -> FIRST LOGICAL REC 00386000 LA R4,80 INCREMENT FOR DEBLOCKING 00387000 L R5,TAPCOUNT SET END OF BLOCK FOR BXLE 00388000 AR R5,R8 R5 -> END OF BLOCK 00389000 SR R5,R4 00390000 LR R9,R8 START OF BUFFER @VA00766 00391000 AR R9,R4 PLUS LEN GIVES END REC PTR @VA00766 00392000 SPACE 1 00393000 CHEKUP EQU * THIS IS THE DEBLOCKING LOOP 00394000 NI FLAG2,255-LINEND RESET LINEND 00395000 LR R7,R3 R7 -> CURRENT LOGICAL REC 00396000 CLC 0(3,R7),=CL3'./' IEBUPDTE CARD? 00397000 BE CTLOOP YES 00398000 TM FLAG,FILEOPEN ANY FILE OPEN? 00399000 BNO BXLE IF NOT, DON'T WRITE 00400000 ST R3,FILEBUFF POINT TO CURRENT REC FOR WRBUF 00401000 LA R1,FILE 00402000 SVC 202 WRITE CURRENT LOGICAL REC 00403000 DC AL4(ERR105S) ERROR EXIT 00404000 BXLE AR R9,R6 BUMP END OF LINE PTR 00405000 BXLE R3,R4,CHEKUP NEXT LOGICAL REC 00406000 B TAPEREAD IF END OF BLOCK, GET NEXT ONE 00407000 SPACE 1 00408000 CTLOOP LA R7,2(,R7) SKIP BY './' 00409000 AGAIN CLI 0(R7),C' ' FIND CONTROL WORD 00410000 BNE ADDCHEK DROP IF FOUND 00411000 LA R7,1(,R7) IF NOT, BUMP AND LOOP 00412000 CR R9,R7 CHEK END OF RECORD 00413000 BE BXLE 00414000 B AGAIN 00415000 EJECT 00416000 ADDCHEK CLC 0(4,R7),=CL4'ADD' IS IT 'ADD' RECORD ? 00417000 BE ADDFOUND YES, GET FILENAME FROM CARD 00418000 CLC 0(6,R7),=CL6'ENDUP' CHEK FOR 'ENDUP' CARD 00419000 BNE BXLE IF NEITHER, GET NEXT REC 00420000 BAL LKGR,CLOZFILE IF ENDUP, CLOSE CURRENT FILE, 00421000 B STOP AND STOP. 00422000 SPACE 1 00423000 ADDFOUND EQU * PROCESS 'ADD' CARD FOR NAME 00424000 LA R7,3(,R7) IF SO, POINT TO KEYWORDS 00425000 TM FLAG,FILEOPEN FILE ACTIVE? 00426000 BZ NAMLOOP NO: FIRST FILE 00427000 BAL LKGR,CLOZFILE GO CLOSE ACTIVE FILE 00428000 NAMLOOP LA R7,1(,R7) FIND THE 'NAME=' PARM 00429000 CLI 0(R7),C' ' 00430000 BNE NAMECHEK KEYWORDS HAVE STARTED 00431000 TM FLAG2,LINEND END OF KEYWORDS? 00432000 BO DEFNAME DEFAULT THE NAME IF SO 00433000 CR R9,R7 END OF RECORD? 00434000 BE BXLE 00435000 B NAMLOOP LOOP FOR END 00436000 SPACE 1 00437000 NAMECHEK CLC 0(5,R7),=CL5'NAME=' IS IT 'NAME=' PARM ? 00438000 BE USENAME JACKPOT= MEMBER NAME 00439000 OI FLAG2,LINEND SIGNAL KEYWORD START 00440000 B NAMLOOP 00441000 USENAME LA R7,5(,R7) POINT TO ACTUAL NAME 00442000 XR R8,R8 00443000 CLI 0(R7),C' ' CHEK FOR BLANK NAME FIELD 00444000 BNE FOUND O.K. 00445000 DEFNAME MVC FILENAME(8),=CL8'TAPPDS' DEFAULT FILENAME 00446000 B MEMOPEN CONTINUE PROCESSING 00447000 EJECT 00448000 OPENFILE MVC STATNAME(18),FILENAME FILEID FOR STATE 00449000 MVC STATLIST(8),=CL8'STATE' COMMAND NAME IN LIST 00450000 LA R1,STATLIST GET STATE LIST 00451000 SVC 202 ISSUE STATE 00452000 DC AL4(NEWFILE) ERROR EXIT 00453000 MVC STATLIST(8),=CL8'ERASE' ERASE COMMAND IN LIST 00454000 SVC 202 ISSUE ERASE 00455000 DC AL4(*+4) ... 00456000 * 00457000 NEWFILE MVC TAPSIZE,TAPCOUNT SET TAPE RECORD SIZE 00458000 OI FLAG,FILEOPEN+BEGUN SET FILE NOT NEW ANYMORE 00459000 TM FLAG2,UPDATE IF UPDATE, 00460000 BCR 1,LKGR KEEP FILESIZE OF '80' 00461000 L R2,TAPCOUNT GET RECORD SIZE 00462000 TM FLAG,COL1 IS COL1 IS TO BE IGNORED? 00463000 BO NEWFILE1 YES, DO NOT DECREMENT SIZE 00464000 BCTR R2,0 DECREMENT COUNT BY 1 00465000 NEWFILE1 ST R2,FILESIZE SAVE NEW RECORD SIZE 00466000 BR LKGR RETURN TO CALLER 00467000 EJECT 00468000 * 00469000 TIEHMOVE CLC 0(2,R8),=H'1' LOOKS LIKE UNLOADED PDS ? @V200801 00470000 BNER LKGR NO, JUST RETURN @V200801 00471000 L R4,TAPCOUNT GET NUMBER BYTES READ @V200801 00472000 LA R4,0(R4,R8) POINT TO END OF BLOCK @V200801 00473000 ST R8,ABUFF1 SAVE BEGIN BLOCK @V200801 00474000 ST R4,ABUFF2 SAVE END BLOCK AS 2ND BUFF @V200801 00475000 ST R4,ABUFF2A SAME AS ABUFF2 @V200801 00476000 ST LKGR,SAVLKGR SAVE LINK REGISTER @V200801 00477000 BAL LKGR,TAPIO2 GO STRIP UNWANTED CHARS. @V200801 00478000 B NIEHMOVE ERROR RETURN FROM TAPIO @V200801 00479000 L R3,ABUFF2 GET BEGIN 2ND BUUFER @V200801 00480000 LA R10,75 GET SUPPOSED LEN OF 1ST. REC @V200801 00481000 CH R10,0(,R3) DOES LENGTH MATCH ? @V200801 00482000 BNE NIEHMOVE NO, NOT UNLOADED PDS @V200801 00483000 LA R10,3(,R10) UP LENGTH BY 3 @V200801 00484000 CLC 3(75,R3),IEHMOVE IS THIS UNLOADED PDS REC ? @V200801 00485000 BE RDDSCB YES, GO ON TO READ DSCB @V200801 00486000 NIEHMOVE L LKGR,SAVLKGR RESTORE LINK REGISTER @V200801 00487000 BR LKGR RETURN TO CALLER @V200801 00488000 * 00489000 RDDSCB BAL LKGR,NEXTREC GO GET 2ND RECORD @V200801 00490000 MVI FLAG2,0 CLEAR 2ND FLAGS @V200801 00491000 TM 87(R3),FXD IS DATA SET FIXED ? @V200801 00492000 BO POSSFXD MAYBE, SEE IF UNDEFINED @V200801 00493000 MVI FILEMODE+1,C'4' IF NOT, MAKE FMODE NO. 4 @V200801 00494000 SETVAR MVI FILEFV,C'V' MAKE FILEFV VARIABLE @V200801 00495000 B GETNEXT GO GET NEXT RECORD @V200801 00496000 POSSFXD TM 87(R3),VAR IS DATA SET UNDEFINED ? @V200801 00497000 BO SETVAR YES, SET WRBUF FV TO V @V200801 00498000 TM 87(R3),BLK IS FIXED DATA SET BLOCKED ? @V200801 00499000 BZ GETNEXT NO, GO GET NEXT RECORD @V200801 00500000 OI FLAG2,BLK SET BLOCKED FLAG @V200801 00501000 MVC RECLEN+2(2),91(R3) SAVE LRECL FOR DEBLOCKING @V200801 00502000 GETNEXT BAL LKGR,NEXTREC GO GET NEXT RECORD @V200801 00503000 TM 2(R3),X'08' IS THIS A MEMBER HEADER REC ? @V200801 00504000 BZ GETNEXT NO, KEEP CHECKING @V200801 00505000 * 00506000 FOUND2 MVI FLAG,FILEOPEN+BEGUN SET SOME FLAGS @V200801 00507000 MVC FILENAME(8),6(R3) MAKE MEM NAME AS FILENAME @V200801 00508000 MVC STATNAME(18),FILENAME PREPARE STATE LIST @V200801 00509000 LA R1,STATLIST ADDRESS STATE P-LIST @V200801 00510000 MVC STATLIST(8),=CL8'STATE' MOVE IN THE COMMAND @V200801 00511000 SVC 202 CALL STATE @V200801 00512000 DC AL4(*+4) ... @V200801 00513000 CH R15,=H'28' WAS FILE NOT FOUND ? @V200801 00514000 BE NEWMEM YES..SKIP ERASE OLD FILE @V200801 00515000 LTR R15,R15 ANY OTHER ERRORS ? @V200801 00516000 BNZ RETURN YES, MUST BE BAD THEN @V200801 00517000 MVC STATLIST(8),=CL8'ERASE' MOVE IN THE COMMAND @V200801 00518000 SVC 202 CALL ERASE @V200801 00519000 DC AL4(*+4) ... @V200801 00520000 EJECT 00521000 NEWMEM BAL LKGR,NEXTREC GET NEXT RECORD @V200801 00522000 TM 2(R3),X'14' IS IT DUMMY OR NOTELIST ? @V200801 00523000 BM NEWMEM YES, IGNORE THIS RECORD @V200801 00524000 TM 2(R3),X'08' IS IT A MEMBER HEADER REC ? @V200801 00525000 BO CLSOPN YES, CLOSE OLD FILE THEN @V200801 00526000 TM 2(R3),X'20' IS IT DATA RECORD ? @V200801 00527000 BZ NEWMEM NO, IGNORE WHATEVER IT IS @V200801 00528000 BAL LKGR,RECOUT WRITE THIS RECORD TO DISK @V200801 00529000 B NEWMEM GO AND GET NEXT RECORD @V200801 00530000 * 00531000 NEXTREC AR R3,R10 POINT TO BEGIN NEXT REC @V200801 00532000 CHKREC LH R10,0(,R3) GET LENGTH NEW RECORD @V200801 00533000 LA R10,3(,R10) UP LENGTH BY 3 @V200801 00534000 TM 2(R3),X'80' ANY TTR INFO. IN REC ? @V200801 00535000 BZ NOTTR DON'T COMPENSATE FOR IT @V200801 00536000 LA R10,3(,R10) BYPASS TTR INFORMATION @V200801 00537000 NOTTR LA R6,0(R3,R10) POINT TO POSSIBLE END REC @V200801 00538000 C R6,BUFFEND IS ALL OF REC IN CORE ? @V200801 00539000 BLR LKGR YES, RETURN SINCE WE HAVE IT @V200801 00540000 * 00541000 L R2,ABUFF2A GET ADDR 2ND BUFFER @V200801 00542000 L R4,BUFFEND ALSO ADDR END 2ND BUFFER @V200801 00543000 SR R4,R3 CALCULATE LENGTH IN BUFFER @V200801 00544000 LOOP1 LA R6,256 GET MAX MVC LENGTH @V200801 00545000 SR R4,R6 SEE IF WE EXCEED MAX @V200801 00546000 BNP LAST256 IF NOT, SKIP LOOP @V200801 00547000 BCTR R6,0 MAX LESS 1 FOR EXECUTE @V200801 00548000 EX R6,MOVEUP MOVE 256 BYTES UP @V200801 00549000 LA R2,1(R6,R2) BUMP 2ND BUFFER BY LENGTH @V200801 00550000 LA R3,1(R6,R3) ALSO WHERE MOVING FROM @V200801 00551000 B LOOP1 GO AND TRY AGAIN @V200801 00552000 LAST256 AR R4,R6 LETS PUT PROPER LEN BACK @V200801 00553000 BCTR R4,0 LESS 1 FOR EXECUTE @V200801 00554000 EX R4,MOVEUP MOVE REMAINIG UP @V200801 00555000 LA R2,1(R4,R2) BUMP 2ND BUFFER BY LENGTH @V200801 00556000 * 00557000 ST R2,ABUFF2 SAVE 2ND BUFFER ADDRESS @V200801 00558000 ST LKGR,SAVLKGR SAVE LINK REGISTER @V200801 00559000 BAL LKGR,TAPIO GET & STRIP NEXT BLOCK @V200801 00560000 B ERR110S ERROR EXIT FROM TAPIO @V200801 00561000 L R3,ABUFF2A GET ADDR NEW BUFFER @V200801 00562000 L LKGR,SAVLKGR RESTORE LINK REGISTER @V200801 00563000 B CHKREC GO CHECK IF ALL IN CORE NOW @V200801 00564000 EJECT 00565000 RECOUT LA R4,3(,R3) POINT TO POSS BEGIN OF DATA @V200801 00566000 TM 2(R3),X'80' ANY TTR TO BYPASS @V200801 00567000 BZ SETBUF NO, THAT IS IT @V200801 00568000 LA R4,3(,R4) SKIP PAST TTR INFORMATION @V200801 00569000 SETBUF ST R4,FILEBUFF SAVE BUFFER START ADDRESS @V200801 00570000 LH R4,0(,R3) NOW GET THE LENGTH OF THE REC @V200801 00571000 ST R4,FILESIZE SAVE BUFFER LENGTH @V200801 00572000 XC FILENOIT,FILENOIT CLEAR NO. OF ITEMS @V200801 00573000 TM FLAG2,BLK ARE RECORDS BLOCKED ? @V200801 00574000 BZ WRITEIT2 NO, JUST WRITE ONE RECORD @V200801 00575000 SRDA R4,32 PREPARE FOR DIVIDE @V200801 00576000 D R4,RECLEN COMPUTE NUMBER RECORDS @V200801 00577000 LTR R4,R4 ANY RESIDUAL COUNT ? @V200801 00578000 BNZ ERR110S IF SO, TAPE MUST BE BAD @V200801 00579000 STH R5,FILENOIT SAVE NUMBER RECORDS TO WRITE @V200801 00580000 WRITEIT2 LA R1,FILE GET WRBUF P-LIST ADDR @V200801 00581000 SVC 202 CALL WRBUF @V200801 00582000 DC AL4(ERR105S) ERROR EXIT FOR WRBUF @V200801 00583000 BR LKGR GOOD, RETURN TO CALLER @V200801 00584000 * 00585000 CLSOPN BAL LKGR,CLOZFILE CLOSE THIS FILE AND GIVE @V200801 00586000 B FOUND2 INFO. MSG TO USER @V200801 00587000 * 00588000 TAPIO LA R1,TAPLIST ADDRESS TAPE P-LIST @V200801 00589000 SVC 202 CALL TAPEIO @V200801 00590000 DC AL4(TAPERR) ERROR EXIT FROM TAPEIO @V200801 00591000 TAPIO2 L R4,TAPCOUNT GET NUMBER BYTES READ @V200801 00592000 CL R4,LRECL LESS THAN SHORTEST BLOCK ? @V200801 00593000 BLR LKGR YES, ERROR (POSS BAD TAPE) @V200801 00594000 SRDA R4,32 PREPARE FOR DIVIDE @V200801 00595000 D R4,LRECL GET NO. 80 BYTE RECS. @V200801 00596000 LTR R4,R4 ANY REMAINDER FROM DIVIDE ? @V200801 00597000 BNZR LKGR YES, ERROR (POSS BAD TAPE) @V200801 00598000 LR R4,R5 GET QUOTIENT IN REG 4 @V200801 00599000 SLL R4,1 MULTIPLY BY 2 @V200801 00600000 L R6,TAPCOUNT GET NUMBER BYTES READ @V200801 00601000 SR R6,R4 LESS NO. BYTES TO BE REMOVED @V200801 00602000 L R4,ABUFF2 GET 2ND BUFFER ADDRESS @V200801 00603000 LA R4,0(R6,R4) PLUS NEW BYTES TO BE MOVED @V200801 00604000 C R4,UPBUFHI WILL THIS EXCEED HIGHEST AREA @V200801 00605000 BH SIZERR YES, THEN NO MORE CORE AVAIL @V200801 00606000 ST R4,BUFFEND SAVE NEW BUFFER END @V200801 00607000 L R2,ABUFF1 GET AREA JUST READ FROM TAPE @V200801 00608000 L R3,ABUFF2 GET 2ND BUFFER ADDRESS @V200801 00609000 LOOP3 MVC 0(78,R3),2(R2) MOVE UP SKIPPING 1ST 2 BYTES @V200801 00610000 LA R2,80(,R2) BUMP READ BLOCK POINTER @V200801 00611000 LA R3,78(,R3) BUMP 2ND BUFFER POINTER @V200801 00612000 BCT R5,LOOP3 MOVE 'TILL NO MORE RECORDS @V200801 00613000 B 4(,LKGR) RETURN TO CALLER + 4 (NORMAL) @V200801 00614000 EJECT 00615000 ERR3E LR R2,R1 SUB IN REG 2 00616000 DMSERR NUM=3,LET=E,SUB=(CHARA,(R2)),TEXT='INVALID OPTION ''...*00617000 .....''' 00618000 LA R15,24 RETURN CODE = 24 00619000 B RETURN GET OUT OF HERE 00620000 EJECT 00621000 CLOZFILE LA R1,STATLIST GET LIST ADDRESS 00622000 MVC STATLIST(8),=CL8'FINIS' FINIS COMMAND (CLOSE) 00623000 SVC 202 CLOSE THE FILE 00624000 DC AL4(*+4) ... 00625000 NI FLAG,255-FILEOPEN SHOW FILE NOT OPEN 00626000 DMSERR NUM=703,LET=I,SUB=(CHAR8A,FILENAME), *00627000 TEXT='FILE ''....................'' COPIED' 00628000 TM FLAG,MAXTEN CHECK IF LIMIT IS IMPOSED 00629000 BCR 8,LKGR NO, RETURN 00630000 LH R1,FILECONT GET CURRENT COUNT 00631000 LA R1,1(,R1) INCREMENT THE COUNT 00632000 STH R1,FILECONT SAVE UPDATED COUNT 00633000 CH R1,=H'10' MAXIMIN REACHED ? 00634000 BCR 4,LKGR NO, RETURN TO CALLER 00635000 * 00636000 MVC TAPLIST+8(8),=CL8'BSR' BACKSPACE TAPE ONE RECORD 00637000 LA R1,TAPLIST TAPE LIST ADDRESS 00638000 SVC 202 TAPE COMMAND 00639000 DC AL4(*+4) ... 00640000 DMSERR NUM=707,LET=I,TEXT='TEN FILES COPIED' 00641000 B STOP DONE 00642000 EJECT 00643000 TAPERR CH R15,=H'2' IS IT END-OF-FILE ? 00644000 BNE ERR110S NO, GIVE ERROR MSG 00645000 TM FLAG,EOF READ END-OF-FILE BEFORE ? 00646000 BO EOFSTOP YES, THAT IS TWO IN A ROW.. 00647000 OI FLAG,EOF+BTOF SET EOF AND BEGIN NEW FILE 00648000 TM FLAG,BEGUN DO WE HAVE A NEW FILE ? 00649000 BZ TAPEREAD NO, KEEP READING FROM TAPE 00650000 TM FLAG,FILEOPEN IS THE NEW FILE OPEN ? 00651000 BZ STOP NO, JUST EXIT 00652000 BAL LKGR,CLOZFILE IF OPEN, CLOSE THE FILE 00653000 B STOP EXIT 00654000 SPACE 00655000 SIZERR DMSERR NUM=109,LET=S,TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED' 00656000 LA R15,104 RETURN CODE = 104 @VA00766 00657000 B RETURN RETURN @VA00766 00658000 SPACE 00659000 EOFSTOP DMSERR NUM=58,LET=E,TEXT='END-OF-FILE OR END-OF-TAPE' 00660000 LA R15,40 RETURN CODE = 40 00661000 B RETURN RETURN 00662000 EJECT 00663000 ERR110S DMSERR NUM=110,LET=S,SUB=(CHARA,TAPID),TEXT='ERROR READING ''.*00664000 ...''' 00665000 LA R15,100 RETURN CODE = 100 00666000 B RETURN RETURN 00667000 ERR105S LR R9,R15 SUB IN REG 9 00668000 DMSERR NUM=105,LET=S,SUB=(DEC,(R9),CHAR8A,FILENAME),TEXT='ERRO*00669000 R ''..'' WRITING FILE ''....................'' ON DISK',*00670000 RENT=NO 00671000 LA R15,100 RETURN CODE = 100 00672000 B RETURN RETURN 00673000 EJECT 00674000 SHOWTAPE LA R1,TYPLIST2 TYPLIN LIST ADDRESS 00675000 STCM R8,7,TPLSTBUF SET TYPLIN BUFFER @VA00766 00676000 MVC TPLST2A+1(3),TAPCOUNT+1 MOVE IN BYTE COUNT 00677000 SVC 202 TYPE THE BUFFER 00678000 DC AL4(*+4) ... 00679000 BR LKGR RETURN TO CALLER 00680000 SPACE 00681000 STOP SR R15,R15 RETURN CODE = 0 00682000 RETURN EQU * @V305001 00683100 DMSEXS MVC,DOSFLAGS(1),DOSF RESET NUCON'S DOSFLAGS @V305001 00683200 TM FLAG2,UPDATE BUFFER GETMAIN'D ? @V305001 00683300 BCR 8,R14 NO, JUST GET OUT @VA00766 00684000 LR R8,R15 SAVE THE RETURN CODE @VA00766 00685000 FREEMAIN V,A=UPBUF @VA00766 00686000 LR R15,R8 RESTORE THE RETURN CODE @VA00766 00687000 BR R14 EXIT GRACEFULLY @VA00766 00688000 EJECT 00689000 TYPLIST2 DS 0D 00690000 DC CL8'TYPLIN' TYPLIN P-LIST 00691000 DC AL1(1) 00692000 TPLSTBUF DC AL3(*-*) BUFFER ADDRESS @VA00766 00693000 TPLST2A DC C'B' 00694000 DC AL3(*-*) BUFFER LENGTH 00695000 SPACE 00696000 TAPLIST DS 0D 00697000 DC CL8'TAPEIO' TAPEIO P-LIST 00698000 DC CL8'READ' 00699000 TAPID DC C'TAP1' 00700000 DC X'00' NO MODE FOR TAPEIO @VA12288 00701000 TAPBUFAD DC AL3(*-*) BUFFER ADDRESS @VA00766 00702000 TAPBUFSZ DC F'0' BUFFER SIZE @VA00766 00703000 TAPCOUNT DC F'0' NO. BYTES READ 00704000 FENCE DC F'-1' FENCE 00705000 TAPSIZE DC F'0' SAVE FOR PREVIOUS SIZE 00706000 SPACE 00707000 FILE DS 0D WRBUF P-LIST 00708000 DC CL8'WRBUF' COMMAND 00709000 FILENAME DC CL8'*' 00710000 FILETYPE DC CL8'*' 00711000 FILEMODE DC CL2'A1' 00712000 DC H'0' ITEM NUMBER 00713000 FILEBUFF DC A(*-*) 00714000 FILESIZE DC A(80) 00715000 FILEFV DC CL2'F' 00716000 FILENOIT DC H'1' NUMBER OF ITEMS 00717000 SPACE 00718000 STATLIST DS 0D STATE P-LIST 00719000 DC CL8'STATE' 00720000 STATNAME DC CL24' ' STATE FILEID 00721000 SPACE 00722000 UPBUF DC 2F'0' GETMAIN PARM LIST @VA00766 00723000 REQS DC F'80' MINIMUM AREA NEEDED @VA00766 00724000 DC F'49152' MAXIMUM AREA REQUESTED @VA13892 00725000 UPBUFHI DC F'0' TOP OF GETMAIN'D AREA @V200801 00726000 H0 DC H'0' RESIDUAL COUNT COMPARE @VA00766 00728000 FILECONT DC H'0' NUMBER OF FILES READ COUNT 00729000 DOSF DS X SAVE AREA FOR NUCON'S DOSFLAGS @V305001 00729100 EJECT 00730000 FLAG DC X'0' FLAG FOR SWITCHES 00731000 PDS EQU X'80' ON IF THIS IS A PDS 00732000 COL1 EQU X'40' ON IF COL1 CONTAINS DATA, NOT CC 00733000 FILEOPEN EQU X'20' ON IF FILE IS OPEN 00734000 END EQU X'10' ON IF END CARD IMPLIES END OF MBR 00735000 BEGUN EQU X'08' ON IF FILE HAS EVER BEEN PROCESSED 00736000 EOF EQU X'04' END-OF-FILE HAS JUST BEEN READ 00737000 MAXTEN EQU X'02' SET IF MAXIMUM OF TEN MEMBERS 00738000 BTOF EQU X'01' BEGINNING OF TAPE FILE 00739000 * 00740000 FLAG2 DC X'0' SECOND FLAG FOR SWITCHES 00741000 UPDATE EQU X'80' ON IF IEBUPDTE SCAN WANTED 00742000 LINEND EQU X'40' ON IF KEYWORDS SCAN HAS STARTED 00743000 BLK EQU X'10' UNLOADED DATA SET IS BLOCKED @V200801 00744000 * 00745000 FXD EQU X'80' FIXED FORMAT RECS. @V200801 00746000 VAR EQU X'40' VARIABLE FORMAT RECS. @V200801 00747000 * 00748000 NAM1 DC CL8'TAPPDS' DEFAULT FILENAME (NPDS) 00749000 NAM2 DC CL8'CMSUT1' DEFAULT FILETYPE 00750000 MODE DC CL2'A1' DEFAULT FILEMODE 00751000 LKGR EQU 11 LINK REGISTER 00752000 SAVLKGR DC F'0' SAVE AREA FOR LINK REG. @V200801 00753000 MEMNAME MVC FILENAME(*-*),0(R9) MOVE NAME FROM TAPE TO DISK 00754000 MOVEUP MVC 0(0,R2),0(R3) MOVE UNLOADED PDS BLOCK UP @V200801 00755000 STAR DC CL2'*' CHECK FOR DEFAULT FILEID 00756000 IEHMOVE DC C'THIS IS AN UNLOADED DATA SET PRODUCED BY' @V200801 00757000 DC X'80' @V200801 00758000 DC C'THE IBM UTILITY, SYSMOVE.OMMBRLDWB' @V200801 00759000 ABUFF1 DC A(*-*) UNLOADED PDS TAPE BUFFER @V200801 00760000 ABUFF2 DC A(*-*) 2ND BUFFER FOR STRIP RECS @V200801 00761000 ABUFF2A DC A(*-*) PART OF ABOVE @V200801 00762000 BUFFEND DC F'0' END ADDRESS OF 2ND BUFFER @V200801 00763000 RECLEN DC F'0' LRECL FOR BLOCKED DATA SETS @V200801 00764000 LRECL DC F'80' STANDARD IEHMOVE LRECL @V200801 00765000 EJECT 00766000 LTORG 00767000 EJECT 00768000 NUCON @V305001 00768100 REGEQU 00769000 END 00770000