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