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