ibm:vm370-lib:cms:dmstpd.assemble_src
Table of Contents
DMSTPD Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC002DS]
Source Listing
- DMSTPD.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmstpd.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator