Last active
March 21, 2017 22:07
-
-
Save JohnArchieMckown/d7ddef0c7ddf95c72c5978b099768d9b to your computer and use it in GitHub Desktop.
VBSCOPY - copy VBS files, dropping any "broken" records.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| IAZYREG | |
| MACRO | |
| &LBL XPUT &DATA | |
| &LBL DS 0H | |
| MVC LINE+1(8),&DATA | |
| MVC LINE+10,PINREC | |
| OI LINE+10,X'F0' | |
| MVC LINE+12,INREC | |
| OI LINE+10,X'F0' | |
| PUT SYSPRINT,LINE | |
| MEND | |
| RECLEN EQU 1024*1024 | |
| VBSCOPY2 CSECT | |
| USING *,R11 | |
| SAVE (14,12),,VBSCOPY2\&SYSDATE\&SYSTIME | |
| LR R11,R15 | |
| CNOP 0,4 | |
| BAS R1,*+76 | |
| DC 18A(0) | |
| ST R13,4(,R1) SAVE OLD S/A POINTER IN NEW S/AW | |
| ST R1,8(,R13) SAVE NEW S/A POINTER IN OLD S/A | |
| LR R13,R1 POINT TO NEW S/A | |
| L R1,4(,R13) POINT BACK | |
| L R1,24(,R1) RESTORE ORIGINAL R1 | |
| B GO GO TO ACTUAL CODE | |
| GOBACK DS 0H | |
| L R1,4(,R13) GET OLD S/A POINTER | |
| XC 4(4,R13),4(R13) KILL BACK CHAIN | |
| XC 8(4,R1),8(R1) KILL FORWARD CHAIN | |
| LR R13,R1 RESTORE ENTRY S/A POINTER | |
| LR R15,R5 LOAD CONDITION CODE | |
| RETURN (14,12),T,RC=(15) GET OTTA HERE! | |
| GO DS 0H | |
| OPEN (SMFIN,(INPUT), X | |
| SMFOUT,(OUTPUT), X | |
| SMFBAD,(OUTPUT), X | |
| SYSPRINT,(OUTPUT)) | |
| XC INREC,INREC | |
| MVI GOOD,1 | |
| GETMAIN R,LV=RECLEN | |
| ST R1,AREA | |
| LA R1,4(,R1) | |
| ST R1,AREA2 | |
| GETMAIN R,LV=RECLEN | |
| ST R1,BAREA | |
| ST R1,BAREA2 | |
| GETLP DS 0H | |
| MVC PINREC,INREC | |
| BAL R5,GETSMF | |
| SLR R5,R5 | |
| IC R5,INREC GET CURRENT RECORD TYPE | |
| SLA R5,2 MULTIPLY BY 4 | |
| B *+4(R5) BRANCH TO ROUTINE | |
| B TYPE0 COMPLETE RECORD | |
| B TYPE1 START OF SEGMENT | |
| B TYPE2 END OF SEGMENT | |
| B TYPE3 MIDDLE OF SEGMENT | |
| * | |
| TYPE0 DS 0H | |
| * XPUT XTYPE0 | |
| CLI PINREC,0 PREV RECORD OK? | |
| BE PUTSMF YES | |
| CLI PINREC,2 PREV RECORD OK? | |
| BE PUTSMF YES | |
| MVI GOOD,0 | |
| L R14,AREA | |
| LH R15,0(,R10) | |
| LR R0,R10 | |
| LR R1,R15 | |
| MVCL R14,R0 | |
| ST R14,AREA2 | |
| B PUTSMF | |
| TYPE1 DS 0H | |
| * XPUT TYPE1 | |
| CLI PINREC,0 PREV RECORD WAS COMPLETE? | |
| BE GETLP YES - OK | |
| CLI PINREC,2 PREV RECORD WAS END OF SEGMENT? | |
| BE GETLP YES - OK | |
| MVI GOOD,1 SAY RECORD LOOKS GOOD | |
| L R14,AREA POINT TO ASSEMBLY AREA | |
| LH R15,0(,R10) GET LENGTH OF RECORD | |
| STH R15,0(,R14) SAVE LENGTH OF RECORD | |
| LR R0,R10 POINT TO RECORD | |
| LR R1,R15 GET LENGTH TO MOVE | |
| MVCL R14,R0 MOVE RECORD | |
| ST R14,AREA SAVE POINTER TO NEXT BYTE | |
| B GETLP | |
| * | |
| TYPE2 DS 0H | |
| * XPUT TYPE2 | |
| CLI PINREC,1 PREV REC OK? | |
| BE PUTSMF YES - RECORD COMPLETE | |
| CLI PINREC,3 PREV REC MAYBE OK? | |
| BNE TYPE2E NO | |
| CLI GOOD,1 VALID TYPE3 RECS? | |
| BE PUTSMF YES - RECORD COMPLETE | |
| TYPE2E DS 0H | |
| * XPUT XTYPE2E | |
| MVI GOOD,0 SET BAD | |
| L R1,AREA | |
| LA R1,4(,R1) | |
| ST R1,AREA2 | |
| B GETLP | |
| * | |
| TYPE3 DS 0H | |
| * XPUT XTYPE3 | |
| CLI PINREC,1 PREV RECORD WAS START-OF-SEGMENT? | |
| BE GETLP YES | |
| CLI PINREC,3 PREV RECORD WAS MIDDLE-OF-SEGMENT? | |
| BE GETLP YES | |
| MVI GOOD,0 BAD SEGMENT | |
| L R1,AREA | |
| LA R1,4(,R1) | |
| ST R1,AREA2 | |
| B GETLP | |
| PUTSMF DS 0H | |
| * XPUT XPUTSMF | |
| L R6,AREA | |
| PUT SMFOUT,(6) OUTPUT GOOD RECORD | |
| CLI GOOD,1 | |
| BE NOTBAD | |
| * | |
| LM R2,R3,BAREA | |
| ERRLP DS 0H | |
| * XPUT XERRLP | |
| CR R2,R3 | |
| BNL ERRLPX | |
| PUT SMFBAD,(2) | |
| AH R2,0(,R2) | |
| B ERRLP | |
| ERRLPX DS 0H | |
| PUT SMFBAD,(6) | |
| NOTBAD DS 0H | |
| * XPUT XNOTBAD | |
| LA R6,4(,R6) | |
| ST R6,AREA2 | |
| MVC BAREA2,BAREA | |
| MVI GOOD,1 | |
| B GETLP | |
| * | |
| GETSMF DS 0H | |
| GET SMFIN | |
| LR R10,R1 | |
| MVC INREC,2(R10) | |
| NI INREC,X'03' | |
| * | |
| * RECONSTRUCT VB RECORD FROM VBS RECORD | |
| L R14,AREA2 GET BUILD AREA | |
| LH R15,0(,R10) GET RECORD LENGTH | |
| S R15,=F'4' DEC LENGTH FOR LLBB FIELD | |
| LA R0,4(,R10) POINT TO DATA IN RECORD | |
| LR R1,R15 GET RECORD LENGTH | |
| MVCL R14,R0 MOVE RECORD TO AREA | |
| ST R14,AREA2 UPDATE RECORD AREA | |
| L R15,AREA GET ADDR OF RECORD | |
| SR R14,R15 CALC CURRENT LENGTH OF RECORD | |
| STH R14,0(,R15) SAVE IT | |
| * | |
| * CONSTRUCT A SERIES OF VB RECORDS FROM THE VBS SEGMENTS | |
| L R14,BAREA2 CURRENT BUILD AREA | |
| LH R15,0(,R10) LENGTH OF RECORD | |
| LA R1,4(,R15) INCREASE BY 4 | |
| STH R1,0(,R14) SAVE LENGTH | |
| LA R14,4(,R14) BYPASS LENGTH AREA | |
| LR R0,R10 POINT TO RECORD | |
| LR R1,R15 GET LENGTH | |
| MVCL R14,R0 MOVE RECORD TO AREA | |
| ST R14,BAREA2 | |
| BR R5 | |
| EOF DS 0H | |
| CLOSE (SMFIN,,SYSPRINT,,SMFOUT,,SMFBAD) | |
| SLR R5,R5 | |
| B GOBACK | |
| DC CL4'DATA' | |
| DOUBLE DS D | |
| BAREA DS A | |
| BAREA2 DS A | |
| CAREA DS A | |
| CAREA2 DS A | |
| AREA DS A | |
| AREA2 DS A | |
| RECSIN DC PL8'0' | |
| ONE DC PL8'1' | |
| PINREC DS X | |
| INREC DS X | |
| GOOD DS X | |
| XNOTBAD DC CL8'NOTBAD' | |
| XERRLP DC CL8'ERRLP' | |
| XTYPE0 DC CL8'TYPE0' | |
| XTYPE1 DC CL8'TYPE1' | |
| XTYPE2 DC CL8'TYPE2' | |
| XTYPE3 DC CL8'TYPE3' | |
| XTYPE2E DC CL8'TYPE2E' | |
| XPUTSMF DC CL8'PUTSMF' | |
| LINE DC CL133' ' | |
| SYSPRINT DCB DDNAME=SYSPRINT, X | |
| DSORG=PS, X | |
| LRECL=133, X | |
| MACRF=PM, X | |
| RECFM=FB | |
| SMFIN DCB DDNAME=SMFIN, X | |
| DSORG=PS, X | |
| RECFM=VB, X | |
| EODAD=EOF, X | |
| MACRF=(GL) | |
| SMFOUT DCB DDNAME=SMFOUT, X | |
| DSORG=PS, X | |
| RECFM=VBS, X | |
| MACRF=PM | |
| SMFBAD DCB DDNAME=SMFBAD, X | |
| DSORG=PS, X | |
| RECFM=VB, X | |
| MACRF=PM | |
| LTORG * | |
| END VBSCOPY2 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment