FGTRCE TITLE ' FGTRCE--QUEUED SEQ-00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** UENTIAL ACCESS METHOD FOR SEISMIC TRACES.' 00000200 *AINDMFGTRCE -- SEISMIC TRACE - OPEN, READ, WRITE, CLOSE 00000303 *TITLE FGIRTR -- OPEN A SEISMIC TRACE DATA SET FOR INPUT 00000404 *A AUTHOR-DESIGNER FRANCIS COLLINS (ADAPTED FROM SPARC FOTRCE) 00000500 *A LANGUAGE S/370 ASSEMBLER 00000600 *A SYSTEM IBM (SEE CRAY) 00000700 *A WRITTEN 7-07-82 00000800 * 00000900 * REVISED 7-01-83 NAM1. ADDED FREEPOOL MACRO TO FGCRTR TO 00001000 * AVOID RUNNING OUT OF MEMORY. 00001100 * REVISED 7-23-85 RSK. ALLOW READING OF DATA INTO XA EXTENDED 00001200 * MEMORY. CHANGES ARE MARKED 'EXT'. 00001300 * REVISED 2-10-86 REM. USE INPUT DATA LENGTH FOR FOWTR INSTEAD 00001400 * OF LRECL IN DCB. 00001500 * REVISED 2-18-87 REM. ADD EXTRN FOR GETMN2 TO SATISFY BKBUFADD. 00001600 * 00001700 *A 00001800 *A 00001900 *A CALL FGIRTR (DCBAD, BLKSIZ, STATUS) 00002000 *A 00002100 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00002200 *A 00002300 *A INPUT DCBAD A4 ADDRESS OF A QSAM DCB. 00002400 *A OUTPUT BLKSIZ I4 MAXIMUM BLOCK SIZE IN BYTES. 00002500 *A OUTPUT STATUS I4 STATUS CODE. 1 = OK. 00002600 *A 2 = OPEN FAILED. 00002700 *A 00002800 *A 00002900 *A INITIALIZE TO READ TRACES. STORES EODAD ADDRESS, SYNAD ADDRESS, 00003000 *A AND EXIT LIST ADDRESS IN THE DATA CONTROL BLOCK, THEN OPENS THE 00003100 *A DCB FOR INPUT. 00003200 *A 00003300 *A BLOCK SIZE IS OBTAINED FROM THE DATA SET LABEL BY THE OPEN 00003400 *A ROUTINE. AFTER THE DATA SET IS OPEN, THE BLOCK SIZE IS OBTAINED 00003500 *A FROM THE DCBBLKSI OF THE DCB AND RETURNED TO THE CALLER IN THE 00003600 *A BLKSIZ PARAMETER. 00003700 *A 00003800 *A REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 00003900 *A 00004000 *A DDNAME, DSORG=PS, MACRF=(GM), RECFM=UT. 00004100 *A 00004200 *A THESE PARAMETERS WILL BE SUPPLIED IF THE DCB IS OBTAINED FROM 00004300 *A THE DYNAMIC ALLOCATION SUBROUTINE UGASEQ. 00004400 *AEND 00004500 EJECT 00004600 *TITLE FGRTR -- READ A SEISMIC TRACE. 00004701 *A AUTHOR-DESIGNER FRANCIS COLLINS (ADAPTED FROM SPARC FOTRCE) 00004800 *A LANGUAGE S/370 ASSEMBLER 00004900 *A WRITTEN 7-07-82 00005000 * 00005100 *A 00005200 *A 00005300 *A CALL FGRTR (DCBAD, DATA, LRECL, STATUS) 00005400 *A 00005500 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00005600 *A 00005700 *A INPUT DCBAD A4 ADDRESS OF QSAM DCB OPENED BY FGIRTR. 00005800 *A OUTPUT DATA ANY ARRAY OF LENGTH AT LEAST LRECL BYTES. 00005900 *A OUTPUT LRECL I4 LENGTH OF RECORD READ, IN BYTES. 00006000 *A OUTPUT STATUS I4 STATUS CODE. 00006100 *A 1 = OK. 00006200 *A 2 = FILE NOT OPEN. 00006300 *A 3 = READ ERROR. 00006400 *A 4 = VOLUME SWITCH. 00006500 *A 5 = CONCATENATION. 00006600 *A 6 = VOLUME SWITCH + READ ERROR. 00006700 *A 7 = CONCATENATION + READ ERROR. 00006800 *A 8 = END OF FILE. 00006900 *A 9 = FAILED TO READ JOB FILE CONTROL BLK. 00007000 *A 00007100 *A 00007200 *A GET ONE RECORD. MOVE THE RECORD INTO DATA. 00007300 *A THIS SECTION CONTAINS EODAD, SYNAD, AND EXIT LIST. 00007400 *A 00007500 *A REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 00007600 *A 00007700 *A DDNAME, DSORG=PS, MACRF=(GM), RECFM=UT. 00007800 *A 00007900 *A THESE PARAMETERS WILL BE SUPPLIED IF THE DCB IS OBTAINED FROM 00008000 *A THE DYNAMIC ALLOCATION SUBROUTINE UGASEQ. 00008100 *AEND 00008200 EJECT 00008300 *TITLE FGCRTR -- CLOSE THE INPUT DATA SET 00008400 *A AUTHOR-DESIGNER RALPH MCMILLAN (ADAPTED FROM SPARC FOTRCE) 00008500 *A LANGUAGE S/370 ASSEMBLER 00008600 *A WRITTEN 3- 1-83 00008700 *A 00008800 *A 00008900 *A CALL FGCRTR (DCBAD, STATUS) 00009000 *A 00009100 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00009200 *A 00009300 *A INPUT DCBAD A4 ADDRESS OF QSAM DCB OPENED BY FGIRTR. 00009400 *A OUTPUT STATUS I4 STATUS CODE. 00009500 *A 1 = OK. 00009600 *A 2 = CLOSE FAILED. 00009700 *A 00009800 *A 00009900 *A CLOSE THE INPUT DCB. 00010000 *AEND 00010100 SPACE 3 00010200 *TITLE FGIWTR -- OPEN A QSAM DCB FOR SEISMIC TRACE OUTPUT 00010304 *A AUTHOR-DESIGNER FRANCIS COLLINS (ADAPTED FROM SPARC FOTRCE) 00010400 *A LANGUAGE S/370 ASSEMBLER 00010500 *A WRITTEN 7-07-82 00010600 *A 00010700 *A 00010800 *A CALL FGIWTR (DCBAD, STATUS) 00010900 *A 00011000 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00011100 *A 00011200 *A INPUT DCBAD A4 ADDRESS OF A QSAM DCB. 00011300 *A OUTPUT STATUS I4 STATUS CODE. 1 = OK. 00011400 *A 2 = OPEN FAILED. 00011500 *A 00011600 *A 00011700 *A OPEN THE DATA CONTROL BLOCK FOR OUTPUT OF SEISMIC TRACES. 00011800 *A STORE ADDRESSES FOR SYNAD AND EXIT LIST IN DCB. 00011900 *A 00012000 *A REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 00012100 *A 00012200 *A DDNAME, DSORG=PS, MACRF=(PM), RECFM=UT, BLKSIZE. 00012300 *A 00012400 *A THESE PARAMETERS WILL BE SUPPLIED IF THE DCB IS OBTAINED FROM 00012500 *A THE DYNAMIC ALLOCATION SUBROUTINE UGANEW. 00012600 *AEND 00012700 EJECT 00012800 *TITLE FGWTR -- WRITE A SEISMIC TRACE USING QSAM 00012904 *A AUTHOR FRANCIS COLLINS (ADAPTED FROM SPARC FOTRCE) 00013000 *A LANGUAGE S/370 ASSEMBLER 00013100 *A WRITTEN 7-07-82 00013200 * 00013300 * REVISED 7-23-85 RSK. ALLOW WRITING OF DATA INTO XA EXTENDED 00013400 * MEMORY. CHANGES ARE MARKED 'EXT'. 00013500 *A 00013600 *A 00013700 *A CALL FGWTR (DCBAD, DATA, LRECL, STATUS) 00013800 *A 00013900 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00014000 *A 00014100 *A INPUT DCBAD A4 ADDRESS OF A QSAM DCB OPENED BY FGIWTR. 00014200 *A DATA I4 ARRAY CONTAINING THE RECORD. 00014300 *A LRECL I4 LENGTH OF THE RECORD, BYTES. 00014400 *A OUTPUT STATUS I4 STATUS CODE. 1 = OK, 00014500 *A 2 = FILE NOT OPEN, 00014600 *A 3 = WRITE ERROR, 00014700 *A 4 = VOLUME SWITCH, 00014800 *A 6 = VOLUME SWITCH + WRITE 00014900 *A ERROR. 00015000 *A WRITE A SEISMIC TRACE RECORD USING QSAM. 00015100 *A 00015200 *A REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 00015300 *A 00015400 *A DDNAME, DSORG=PS, MACRF=(PM), RECFM=UT, BLKSIZE. 00015500 *A 00015600 *A THESE PARAMETERS WILL BE SUPPLIED IF THE DCB IS OBTAINED FROM 00015700 *A THE DYNAMIC ALLOCATION SUBROUTINE UGANEW. 00015800 *AEND 00015900 SPACE 3 00016000 *TITLE FGCWTR -- CLOSE THE OUTPUT DATA SET 00016100 *A AUTHOR-DESIGNER RALPH MCMILLAN (ADAPTED FROM SPARC FOTRCE) 00016200 *A LANGUAGE S/370 ASSEMBLER 00016300 *A WRITTEN 3- 1-83 00016400 *A 00016500 *A 00016600 *A CALL FGCWTR (DCBAD, STATUS) 00016700 *A 00016800 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00016900 *A 00017000 *A INPUT DCBAD A4 ADDRESS OF QSAM DCB OPENED BY FGIWTR. 00017100 *A OUTPUT STATUS I4 STATUS CODE. 00017200 *A 1 = OK. 00017300 *A 2 = CLOSE FAILED. 00017400 *A 00017500 *A 00017600 *A CLOSE THE OUTPUT DCB. CLOSE AND REWIND FILE. 00017700 *AEND 00017800 EJECT 00017900 MACRO 00018000 &ENTRY ENTER 00018100 ENTRY &ENTRY 00018200 USING *,R15 00018300 &ENTRY B &ENTRY.1 00018400 DC X'06',CL7'&ENTRY' 00018500 &ENTRY.1 ST R15,ENTRYADD 00018600 L R15,=A(FGTRCE) 00018700 USING FGTRCE,R15 00018800 B PRELIM 00018900 DROP R15 00019000 MEND 00019100 SPACE 3 00019200 PRINT NOGEN 00019300 SPACE 00019400 FGTRCE CSECT 00019500 DC X'06',CL7'FGTRCE' 00019600 EXTRN GETMN2 00019700 R0 EQU 0 00019800 R1 EQU 1 00019900 R2 EQU 2 ADDRESS OF DATA CONTROL BLOCK. 00020000 R3 EQU 3 ADDRESS OF BLKSIZ IN FGIRTR, 00020100 * ADDRESS OF DATA IN FGRTR AND FGWTR, 00020200 * ADDRESS OF STATUS IN FGIWTR (TEMPORARY, R3-->R6). 00020300 R4 EQU 4 ADDRESS OF LRECL IN FGRTR AND FGWTR, 00020400 * VALUE OF LRECL IN FGWTR. 00020500 R5 EQU 5 ADDRESS OF STATUS. 00020600 R6 EQU 6 VALUE OF STATUS. 00020700 R7 EQU 7 00020800 R8 EQU 8 00020900 R9 EQU 9 00021000 R11 EQU 11 ADDRESS OF JOB FILE CONTROL BLOCK AREA. 00021100 R12 EQU 12 BASE REGISTER. 00021200 R13 EQU 13 SAVE AREA ADDRESS. 00021300 R14 EQU 14 00021400 R15 EQU 15 00021500 SPACE 00021600 BYTE234 EQU B'0111' 00021700 B1T3 EQU B'00010000' 00021800 CLOSFAIL EQU 2 00021900 CONCAT EQU 5 00022000 EOFST EQU 8 00022100 JFCBFAIL EQU 9 00022200 OK EQU 1 00022300 OPENFAIL EQU 2 00022400 VOLSWTCH EQU 4 00022500 SPACE 00022600 SAVEAREA DC 18F'0' 00022700 USING FGTRCE,R12 00022800 USING IHADCB,R2 R2 = ADDRESS OF DCB. 00022900 USING INFMJFCB,R11 R11 = ADDRESS OF JFCB AREA. 00023000 EJECT 00023100 USING FGTRCE,R15 00023200 PRELIM STM R14,R12,12(R13) PRELIM COMMON TO ALL ENTRY POINTS. 00023300 MVC 16(4,R13),ENTRYADD SAVE ENTRY POINT FOR RETURN. 00023400 ST R13,SAVEAREA+4 00023500 LA R12,SAVEAREA 00023600 ST R12,8(,R13) 00023700 LR R13,R12 00023800 LR R12,R15 00023900 DROP R15 00024000 **************** ADDRESSING MODE SWITCH ****************** EXT 00024100 FGTRCE AMODE ANY EXT 00024200 FGTRCE RMODE 24 EXT 00024300 LA R4,FGNEXT EXT 00024400 LA R5,RETURNIT EXT 00024500 BSM R5,R4 EXT 00024600 RETADD DC F'0' EXT 00024700 THELINE DC F'16777215' EXT 00024800 COMPADD DC F'0' EXT 00024900 FGNEXT DS 0H EXT 00025000 ST R5,RETADD EXT 00025100 SPACE 00025200 LM R2,R5,0(R1) PARAMETER ADDRESSES 1 TO 4. 00025300 L R2,0(,R2) PARAMETER 1 = DCB ADDRESS. 00025400 LA R6,OK NORMAL VALUE OF STATUS CODE. 00025500 ST R6,STATUS WILL BE CHANGED IF ERRORS OCCUR. 00025600 LA R11,JFCB 00025700 SPACE 00025800 L R15,ENTRYADD 00025900 B FGIRTR2-FGIRTR(,R15) 00026000 EJECT 00026100 ********************************************************************** 00026200 * CALL FGIRTR (DCBAD, BLKSIZ, STATUS) * 00026300 * R2 R3 R4---->R5 * 00026400 * IN OUT OUT * 00026500 * INITIALIZE TO READ. * 00026600 ********************************************************************** 00026700 FGIRTR ENTER 00026800 SPACE 00026900 FGIRTR2 LR R5,R4 MOVE STATUS ADDRESS TO R5. 00027000 TM DCBOFLGS,B1T3 ALREADY OPEN? 00027100 BO RETURN10 00027200 MVI DCBMACR1,X'48' GET/LOCATE MODE 00027300 LA R0,EOF 00027400 STCM R0,BYTE234,DCBEODA END OF DATA ADDRESS. 00027500 LA R0,RSYNAD 00027600 STCM R0,BYTE234,DCBSYNA SYNAD ADDRESS. 00027700 LA R0,REXLST 00027800 STCM R0,BYTE234,DCBEXLSA EXIT LIST ADDRESS. 00027900 SPACE 00028000 OPEN ((R2),(INPUT)) OPEN THE DATA SET. 00028100 TM DCBOFLGS,B1T3 VERIFY THE OPEN OPERATION. 00028200 BNO OPNTST10 00028300 LH R0,DCBBLKSI RETURN BLOCK SIZE TO CALLER. 00028400 ST R0,0(,R3) 00028500 SPACE 00028600 XC JFCB,JFCB OBTAIN THE DATA SET NAME FROM 00028700 RDJFCB ((R2),INPUT) THE JOB FILE CONTROL BLOCK. 00028800 LTR R15,R15 00028900 BNZ JFCBERR 00029000 MVC DSNAME,JFCBDSNM 00029100 B RETURN10 00029200 EJECT 00029300 ********************************************************************** 00029400 * CALL FGRTR (DCBAD, DATA, LRECL, STATUS) * 00029500 * R2 R3 R4 R5 * 00029600 * IN OUT OUT OUT * 00029700 * READ A SEISMIC TRACE USING QSAM. * 00029800 ********************************************************************** 00029900 FGRTR ENTER 00030000 SPACE 00030100 TM DCBOFLGS,B1T3 IS THE DCB OPEN? 00030200 BNO OPNTST10 NO, STATUS = 2. 00030300 SPACE 00030400 GET (R2) DO READ IN LOCATE MODE EXT 00030500 STM R4,R7,FGTRRXRS RESTORE REGS USED FOR MOVE EXT 00030600 L R4,FGTRRX1 ADDRESS FOR MODE SWITCH EXT 00030700 BSM 0,R4 SWITCH EXT 00030800 DS 0F EXT 00030900 FGTRRX1 DC A(FGTRRX2+X'80000000') EXT 00031000 FGTRRXRS DC 4F'0' EXT 00031100 FGTRRX2 DS 0H EXT 00031200 LR R4,R3 ADDRESS TO MOVE DATA INTO EXT 00031300 LR R6,R1 ADDRESS TO MOVE DATA FROM EXT 00031400 LH R5,DCBLRECL LENGTH OF DATA BUFFER EXT 00031500 N R5,=X'0000FFFF' EXT 00031600 LR R7,R5 EXT 00031700 MVCL R4,R6 MOVE IN THE DATA EXT 00031800 LA R4,FGTRRX3 SWITCH OUT OF 31 BIT MODE EXT 00031900 BSM 0,R4 EXT 00032000 FGTRRX3 DS 0H EXT 00032100 LM R4,R7,FGTRRXRS RESTORE REGS USED FOR MOVE EXT 00032200 FGTRRX99 DS 0H EXT 00032300 LH R0,DCBLRECL RETURN RECORD LENGTH TO CALLER. 00032400 ST R0,0(,R4) 00032500 L R6,STATUS WAS END-OF-VOLUME EXIT ENTERED? 00032600 C R6,=F'4' STATUS = 4 = EOV, OR 00032700 BE FGRTR2 STATUS = 6 = EOV + READ ERROR. 00032800 C R6,=F'6' IF NO, FINISHED. 00032900 BNE RETURN10 IF YES, EOV AND MAYBE CONCATENATION. 00033000 SPACE 00033100 FGRTR2 XC JFCB,JFCB CONCATENATION TEST. CLEAR JFCB AREA. 00033200 RDJFCB ((R2),INPUT) READ JOB FILE CONTROL BLOCK. 00033300 LTR R15,R15 TEST RETURN CODE FROM READ JFCB. 00033400 BNZ JFCBERR RD JFCB FAILED. PROBABLY NO DDCARD. 00033500 CLC DSNAME,JFCBDSNM IF NEW DATA SET NAME = OLD DSNAME, 00033600 BE RETURN10 CONCATENATION DID NOT OCCUR. 00033700 MVC DSNAME,JFCBDSNM CONCATENATION. SAVE NEW NAME. 00033800 LA R6,1(,R6) STATUS 4 --> 5, EOV --> CONCAT, 00033900 ST R6,STATUS STATUS 6 --> 7, 00034000 B RETURN10 EOV+RERROR --> CONCAT+RERROR. 00034100 EJECT 00034200 * END-OF-FILE ROUTINE FOR READ ENTRY FGRTR. 00034300 EOF LA R6,EOFST END OF FILE. STATUS = 8. 00034400 B RETURN10 00034500 SPACE 3 00034600 * SYNAD ERROR EXIT FOR READ ENTRY FGRTR. 00034700 RSYNAD LA R6,2 00034800 A R6,STATUS STATUS 1 --> 3, OK --> READ ERROR, 00034900 ST R6,STATUS STATUS 4 --> 6, EOV --> EOV + READ ERROR. 00035000 BR R14 00035100 SPACE 3 00035200 * EXIT LIST FOR READ ENTRY FGRTR. 00035300 DS 0F 00035400 REXLST DC X'06',AL3(REOV) END-OF-VOLUME, OR CONCATENATION. 00035500 DC X'87',AL3(JFCB) JOB FILE CONTROL BLOCK AREA. 00035600 SPACE 3 00035700 * END-OF-VOLUME EXIT FOR READ ENTRY FGRTR. 00035800 * THIS EXIT ALSO TAKEN WHEN CONCATENATION OCCURS. 00035900 REOV LA R6,VOLSWTCH VOLUME SWITCH, STATUS = 4. WILL BE 00036000 ST R6,STATUS CHANGED TO 6 IF READ ERROR OCCURS. 00036100 BR R14 IF CONCATENATION, 4 --> 5 & 6 --> 7. 00036200 SPACE 3 00036300 INFMJFCB DSECT MAP OF JOB FILE CONTROL BLOCK. 00036400 JFCBDSNM DS CL44 00036500 SPACE 3 00036600 FGTRCE CSECT 00036700 DS 0F 00036800 JFCB DS CL176 AREA FOR JOB FILE CONTROL BLOCK. 00036900 EJECT 00037000 ********************************************************************** 00037100 * CALL FGCRTR (DCBAD, STATUS) * 00037200 * R2 R3---->R5 * 00037300 * CLOSE THE INPUT DCB * 00037400 ********************************************************************** 00037500 FGCRTR ENTER 00037600 LR R5,R3 A(STATUS). 00037700 TM DCBOFLGS,B1T3 NEED TO BE CLOSED? 00037800 BZ RETURN10 NO. 00037900 CLOSE ((R2),REWIND) 00038000 FREEPOOL ((R2)) FREE UP THE ALLOCATED POOL NAM1 00038100 B CLSTST 00038200 EJECT 00038300 ********************************************************************** 00038400 * CALL FGIWTR (DCBAD, STATUS) * 00038500 * R2 R3---->R5 * 00038600 * IN OUT * 00038700 * INITIALIZE TO WRITE QSAM RECORDS. * 00038800 ********************************************************************** 00038900 FGIWTR ENTER 00039000 SPACE 00039100 LR R5,R3 MOVE STATUS ADDRESS TO R5. 00039200 TM DCBOFLGS,B1T3 ALREADY OPEN? 00039300 BO RETURN10 00039400 LA R0,WSYNAD 00039500 STCM R0,BYTE234,DCBSYNA SYNAD ADDRESS. 00039600 LA R0,WEXLST 00039700 STCM R0,BYTE234,DCBEXLSA EXIT LIST ADDRESS. 00039800 SPACE 00039900 OPEN ((R2),(OUTPUT)) OPEN THE DATA SET. 00040000 B OPNTST 00040100 EJECT 00040200 ********************************************************************** 00040300 * CALL FGWTR (DCBAD, DATA, LRECL, STATUS) * 00040400 * R2 R3 R4 R5 * 00040500 * IN IN IN OUT * 00040600 * WRITE A SEISMIC TRACE RECORD USING QSAM. * 00040700 ********************************************************************** 00040800 FGWTR ENTER 00040900 SPACE 00041000 TM DCBOFLGS,B1T3 IS THE FILE OPEN? 00041100 BNO OPNTST10 NO, STATUS = 2. 00041200 L R4,0(,R4) R4 = LRECL VALUE. 00041300 CH R4,DCBBLKSI GREATER THAN BLOCK SIZE? 00041400 BNH FGWTR3 NO, PROCEED. 00041500 LH R4,DCBBLKSI YES, SET EQUAL TO BLOCK SIZE. 00041600 FGWTR3 EQU * 00041700 STH R4,DCBLRECL DCBLRECL FIXES LENGTH TO BE WRITTEN. 00041800 SPACE 00041900 ST R3,COMPADD EXT 00042000 NI COMPADD,X'7F' EXT 00042100 CLC COMPADD,THELINE ABOVE THE LINE? EXT 00042200 BH FGWTWXSW IF SO, DO SWITCH EXT 00042300 LR R9,R3 ELSE, GO DO OLD WRITE. EXT 00042400 B FGWTWX99 EXT 00042500 ************* SWITCH MODES AND MOVE IN WRITE DATA ************* EXT 00042600 FGWTWXSW DS 0H EXT 00042700 STM R4,R7,FGWTWXRS SAVE REGS USED FOR MOVE EXT 00042800 LR R7,R4 SAVE INPUT LENGTH REM-EXT 00042900 L R4,=V(BKBUFADD) GET BUFFER ADDRESS ADDRESS EXT 00043000 L R4,0(R4) GET BUFFER ADDRESS EXT 00043100 LTR R4,R4 EXT 00043200 BNZ FGWTWX0 EXT 00043300 ABEND 999,DUMP EXT 00043400 FGWTWX0 DS 0H EXT 00043500 L R5,FGWTWX1 ADDRESS FOR MODE SWITCH EXT 00043600 BSM 0,R5 SWITCH EXT 00043700 DS 0F EXT 00043800 FGWTWX1 DC A(FGWTWX2+X'80000000') EXT 00043900 FGWTWXRS DC 4F'0' EXT 00044000 FGWTWX2 DS 0H EXT 00044100 LR R5,R7 LENGTH OF DATA BUFFER EXT 00044200 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 00044300 LR R9,R4 SAVE ADDRESS EXT 00044400 MVCL R4,R6 MOVE IN THE DATA EXT 00044500 LA R4,FGWTWX3 SWITCH OUT OF 31 BIT MODE EXT 00044600 BSM 0,R4 EXT 00044700 FGWTWX3 DS 0H EXT 00044800 LM R4,R7,FGWTWXRS RESTORE REGS USED FOR MOVE EXT 00044900 FGWTWX99 DS 0H EXT 00045000 PUT (R2),(R9) EXT 00045100 B RETURN 00045200 SPACE 3 00045300 * SYNAD ERROR EXIT FOR WRITE ENTRY FGWTR. 00045400 WSYNAD LA R6,2 00045500 A R6,STATUS STATUS 1 --> 3, OK --> WRITE ERROR, 00045600 ST R6,STATUS STATUS 4 --> 6, EOV --> EOV + WRITE ERROR. 00045700 BR R14 00045800 SPACE 3 00045900 * EXIT LIST FOR WRITE ENTRY FGWTR. 00046000 DS 0F 00046100 WEXLST DC X'86',AL3(WEOV) END-OF-VOLUME. 00046200 SPACE 3 00046300 * END-OF-VOLUME EXIT FOR WRITE ENTRY FGWTR. 00046400 WEOV LA R6,VOLSWTCH VOLUME SWITCH, STATUS = 4. 00046500 ST R6,STATUS 00046600 BR R14 00046700 SPACE 3 00046800 ********************************************************************** 00046900 * CALL FGCWTR (DCBAD, STATUS) * 00047000 * R2 R3---->R5 * 00047100 * CLOSE THE OUTPUT DCB * 00047200 ********************************************************************** 00047300 FGCWTR ENTER 00047400 LR R5,R3 A(STATUS). 00047500 TM DCBOFLGS,B1T3 DOES IT NEED TO BE CLOSED? 00047600 BZ RETURN10 NO, FINISHED. 00047700 CLOSE ((R2),REWIND) 00047800 B CLSTST 00047900 EJECT 00048000 JFCBERR LA R6,JFCBFAIL 00048100 B RETURN10 00048200 SPACE 3 00048300 CLSTST TM DCBOFLGS,B1T3 DID THE CLOSE REALLY CLOSE? 00048400 BZ RETURN10 YES. 00048500 LA R6,CLOSFAIL NO. STATUS = 2. 00048600 B RETURN10 00048700 SPACE 3 00048800 OPNTST TM DCBOFLGS,B1T3 IS IT OPEN? 00048900 BO RETURN10 YES, STATUS = 1 = OK. 00049000 OPNTST10 LA R6,OPENFAIL NO, STATUS = 2 = NOT OPENED. 00049100 B RETURN10 00049200 SPACE 3 00049300 RETURN L R6,STATUS 00049400 RETURN10 EQU * 00049500 **************** ADDRESSING RETURN ****************** EXT 00049600 ST R6,0(,R5) STORE STATUS CODE. 00049700 L R5,RETADD EXT 00049800 BSM 0,R5 EXT 00049900 RETURNIT DS 0H EXT 00050000 L R13,SAVEAREA+4 00050100 LM R14,R12,12(R13) 00050200 MVI 12(R13),X'FF' 00050300 SR R15,R15 00050400 BR R14 00050500 EJECT 00050600 DS 0F 00050700 DSNAME DC CL44' ' 00050800 ENTRYADD DC F'0' 00050900 STATUS DC F'0' 00051000 SPACE 3 00051100 PRINT NOGEN 00051200 DCBD DSORG=(PS),DEVD=(DA) 00051300 END 00051400