         PROC  &P,0,&INDX=YES                                           IRA00010
IRAM     NAME                                                           IRA00020
         LCL   &N1,&N2,&N3,&N4                                          IRA00030
&N1      SET   0                                                        IRA00040
&N2      SET   0                                                        IRA00050
&N3      SET   0                                                        IRA00060
         DO    '&INDX'='YES'                                            IRA00070
D3$I111  CSECT                                                          IRA00080
         ENTRY D3$I000                                                  IRA00090
D3$I000  EQU   *                                                        IRA00100
&N1      SET   1                                                        IRA00110
&N2      SET   1                                                        IRA00120
&N3      SET   1                                                        IRA00130
&N4      SET   X'1111'                                                  IRA00140
         GOTO  .LB1                                                     IRA00150
         ENDO                                                           IRA00160
&N4      SET   X'0000'                                                  IRA00170
D3$I000  CSECT                                                          IRA00180
.LB1     LABEL                                                          IRA00190
         USING *,15                                                     IRA00200
         USING DM$DSCT,1                                                IRA00210
         B     D3$00001                                                 IRA00220
         DC    X'0090'                                                  IRA00230
         DC    Y(&N4)                                                   IRA00240
D3$00000 DC    A(D3$03999-D3$I&N1.&N2.&N3)                              IRA00250
         DC    X'031477'           REVISION DATE                        IRA00260
         DC    5F'0'                                                    IRA00261
D3$00001 STM   14,12,12(13)             STORE USER REGISTERS            IRA00270
         MVC   D3$FCS(1),DC$REQS        SAVE FUNCTION CODE              IRA00280
         TM    DC$MFLG,X'80'            FILE OPEN ?                     IRA00290
         BNO   D3$00313                 NO, DM13 ERROR                  IRA00300
         CLI   DC$DTF,X'90'             VALID DTF ?                     IRA00310
         BNE   D3$00315                 NO, DM15 ERROR                  IRA00320
         TM    D3$FG1,X'20'             PROCESS INHIB ?                 IRA00330
         BO    D3$00349                 YES, DM49                       IRA00340
         LR    14,15                    LOAD IRAM COVER                 IRA00350
         A     14,D3$00000              COMPUTE SAT ERROR EXIT TO IRAM  IRA00360
         ST    14,DC$ERCD               STORE ADDRESS IN DTF            IRA00370
         TM    D3$FG1,X'80'             OPTIONAL FILE ?                 IRA00380
         BNO   D3$00010                 NO                              IRA00390
         TM    D3$FG3,X'80'             OUTPUT FILE ?                   IRA00400
         BO    D3$00100                 YES, EXIT                       IRA00410
         B     D3$24000                 NO, EXIT VIA EOF                IRA00420
D3$00010 LA    10,8                     LOAD LOOP COUNT FOR MACRO CHK   IRA00430
         LA    11,D3$DFTB               VALIDATION, LOAD TABLE BASE     IRA00440
         CLI   DC$REQS,X'00'            FUNCTION CODE ZERO ?            IRA00450
         BE    D3$00314                 YES, DM14                       IRA00460
D3$00020 CLC   DC$REQS(1),0(11)         MATCH ON FUNCTION               IRA00470
         BE    D3$21000                 YES, PROCESS MACRO REQUEST      IRA00480
         LA    11,1(0,11)               NO, INCREMENT TABLE POINTER     IRA00490
         BCT   10,D3$00020              LOOP FOR ALL ENTRIES            IRA00500
         B     D3$00314                 IF END OF TABLE, DM14           IRA00510
** COMMON EXIT **                                                       IRA00520
D3$00100 EQU   *                                                        IRA00530
         LM    14,12,12(13)             RESTORE USER REGISTERS          IRA00540
         BR    14                       EXIT                            IRA00550
** ERROR PROCESSING **                                                  IRA00560
D3$00313 BAL   14,D3$03000              DM13, FILE NOT OPEN             IRA00570
         DC    X'13020000'                                              IRA00580
D3$03314 OI    D3$FG1,X'20'             SET PROCESSING INHIBITED        IRA00590
D3$00314 BAL   14,D3$03000              DM14, INVALID MACRO             IRA00600
         DC    X'14020000'                                              IRA00610
D3$00315 BAL   14,D3$03000              DM15,INVALID DTF                IRA00620
         DC    X'15200000'                                              IRA00630
D3$00324 BAL   14,D3$03000              DM24, INVALID ID                IRA00640
         DC    X'24400000'                                              IRA00650
D3$00334 BAL   14,D3$03000              DM34, EOF DETECTED, NO EOFA     IRA00660
         DC    X'00000040'                                              IRA00670
         DO    '&INDX'='YES'                                            IRA00680
D3$00336 BAL   14,D3$03000              DM36, DUPLICATE KEY             IRA00690
         DC    X'36000002'                                              IRA00700
D3$00337 BAL   14,D3$03000              DM37, SEQUENCE ERROR            IRA00710
         DC    X'37000004'                                              IRA00720
         ENDO                                                           IRA00721
D3$00331 BAL   14,D3$03000              DM31, RANDOM NO-FIND            IRA00730
         DC    X'31001000'                                              IRA00740
D3$00345 BAL   14,D3$03000              SPACE NOT AVAILABLE FOR EXTEND  IRA00760
         DC    X'45400000'              DM45                            IRA00770
D3$00349 BAL   14,D3$03000              DM49                            IRA00780
         DC    X'49000010'                                              IRA00790
D3$03000 MVC   DC$ERCD(1),0(14)         SET ERROR CODE IN DTF           IRA00800
         OC    DC$ERFLG(2),1(14)        SET STATUS FLAGS                IRA00810
         OC    D3$ERRF+3(1),3(14)       *                               IRA00820
D3$03999 LM    14,12,12(13)             RESTORE USER REGISTERS          IRA00830
         SVC   60                       CALL ERROR TRANSIENT            IRA00840
** I/O PROCESSING ROUTINE **                                            IRA00850
D3$21000 EQU   *                                                        IRA00860
         L     12,DC$PCA1               LOAD PCA1 ADDRESS IN R12        IRA00870
         CLI   DC$REQS,X'20'            UPDATE PUT ?                    IRA00880
         BE    D3$21090                 YES                             IRA00890
         CLI   DC$REQS,X'8F'            SETM ISSUED ?                   IRA00900
         BE    D3$21100                 YES                             IRA00910
         CLI   DC$REQS,X'84'            FEOV ISSUED ?                   IRA00911
         BE    D3$24000                 YES                             IRA00912
         DO    '&INDX'='YES'                                            IRA00920
         CLI   DC$REQS,X'26'            PUTA ISSUED ?                   IRA00921
         BE    D3$21006                 YES, BYPASS SETL CHECK          IRA00922
         CLI   DC$REQS,X'03'            SETL GKEY ?                     IRA00930
         BNE   D3$21005                 NO, CHECK SETL REQUIRED ?       IRA00940
         NI    D3$DFG1,X'F7'            YES, CLEAR SETL REQUIRED        IRA00950
         B     D3$21006                 CONTINUE                        IRA00960
D3$21005 TM    D3$DFG1,X'08'            SETL REQUIRED ?                 IRA00970
         BO    D3$00314                 YES, DM14                       IRA00980
D3$21006 EQU   *                                                        IRA00990
         TM    D3$FG3,X'08'             INDX=YES SPECIFIED ?            IRA01000
         BNO   D3$21010                 NO, BYPASS INDX PROCESS         IRA01010
         MVC   D3$DRNM(4),D3$COUTR      SET RECORD NUMBER FOR LOAD/ADD  IRA01020
         BAL   4,D3$30000               LINK TO INDX RTNE               IRA01030
         L     12,DC$PCA1               LOAD PCA1 ADDRESS IN R12        IRA01040
         B     D3$21020                 PROCESS DATA RECORD             IRA01050
         ENDO                                                           IRA01060
D3$21010 EQU   *                                                        IRA01070
         CLI   D3$DSKAD,X'F0'           SKAD SPECIFIED ?                IRA01080
         BE    D3$21020                 NO                              IRA01090
         L     2,D3$DSKAD               LOAD RECORD FIELD ADDRESS       IRA01100
         CLI   DC$REQS,X'01'            SETL ID ISSUED ?                IRA01110
         BE    D3$21015                 YES                             IRA01120
         TM    D3$FG3,X'04'             MODE=RAND ?                     IRA01130
         BNO   D3$21020                 NO                              IRA01140
D3$21015 MVC   D3$DRNM(4),0(2)          SET CURRENT RECORD NUMBER       IRA01150
         L     2,D3$DRNM                VALID RECORD NUMBER ?           IRA01160
         LTR   2,2                      *                               IRA01170
         BNP   D3$00324                 NO, DM24 ERROR                  IRA01180
D3$21020 EQU   *                                                        IRA01190
         CLI   DC$REQS,X'26'            PUTA ISSUED ?                   IRA01200
         BE    D3$21025                 YES                             IRA01210
         CLC   D3$DRNM(4),D3$COUTR      EOF RECORD REACHED ?            IRA01220
         BL    D3$21025                NO                               IRA01230
         CLI   DC$REQS,X'01'           SETL ID                          IRA01231
         BE    D3$00331                YES-RANDOM NO FIND               IRA01232
         TM    D3$FG3,X'04'             RANDOM MODE ?                   IRA01233
         BO    D3$00331                 YES- RANDOM NO FIND             IRA01234
         B     D3$24000                NO-EXIT TO EOF                   IRA01235
D3$21025 EQU   *                                                        IRA01240
         TM    D3$DFG1,X'80'            IOA2 SPEC ?                     IRA01250
         BO    D3$21030                 YES                             IRA01260
         BAL   11,D3$27000              WAIT INPUT I/O                  IRA01270
D3$21030 EQU   *                                                        IRA01280
         LA    4,D3$DCSEC               LOAD STORAGE ADDRESS FOR CONV   IRA01290
         BAL   3,D3$25010               CONVERT RECORD NUM TO SECT/DISP IRA01300
         BAL   3,D3$25100               CHECK IF RECORD IS IN BUFFER    IRA01310
         BAL   5,D3$25200               NO, CHECK I/O REQUIREMENTS      IRA01320
         CLI   DC$REQS,X'03'            SETL ISSUED ?                   IRA01330
         BNH   D3$00100                 YES, EXIT                       IRA01340
         TM    D3$DFG1,X'02'            OUTPUT SEQ IORG PROCESS         IRA01350
         BNO   D3$21034         NO                                      IRA01360
         OI    D3$DFG1,X'01'    SET BUFFER ACTIVE FLAG                  IRA01361
         B     D3$21035         *                                       IRA01362
D3$21034 EQU   *                                                        IRA01363
         BAL   5,D3$25500               PROCESS CURRENT RECORD          IRA01370
D3$21035 CLI   DC$REQS,X'26'            WRITE FUNCTION                  IRA01380
         BE    D3$21040                 YES                             IRA01390
         NI    D3$FG1,X'BF'             CLEAR PUT ERROR FLAG            IRA01400
         MVC   D3$DINR(4),D3$DRNM       NO, SAVE CURRENT INPUT REC NUM  IRA01410
D3$21040 L     2,D3$DRNM                INCREMENT CURRENT RECORD        IRA01420
         LA    2,1(0,2)                 NUMBER BY 1                     IRA01430
         ST    2,D3$DRNM                *                               IRA01440
         CLI   DC$REQS,X'10'            INPUT REQUEST ?                 IRA01450
         BE    D3$21060                 YES                             IRA01460
         CLC   D3$COUTR(4),D3$DRNM      CURRENT REC+1 GR THAN OLD MAX   IRA01470
         BH    D3$21050                 NO                              IRA01480
         MVC   D3$COUTR(4),D3$DRNM      YES, SET NEW MAX                IRA01490
D3$21050 EQU   *                                                        IRA01500
         DO    '&INDX'='YES'                                            IRA01510
         TM    D3$FG3,X'80'             OUTPUT FILE ?                   IRA01520
         BO    D3$21060                 YES, IGNORE ADD CHECK           IRA01530
         TM    D3$FG2,X'01'             ADD RE-READ ?                   IRA01540
         BO    D3$21080                 YES                             IRA01550
         ENDO                                                           IRA01560
D3$21060 TM    D3$FG3,X'04'             MODE=RAND ?                     IRA01570
         BO    D3$00100                 YES, EXIT                       IRA01580
         TM    D3$FG3,X'80'             OUTPUT FILE ?                   IRA01590
         BO    D3$21070                 YES                             IRA01600
         DO    '&INDX'='YES'                                            IRA01610
         TM    D3$FG3,X'28'             INDX=YES OR UPDATE ?            IRA01620
         GOTO  .LB2                                                     IRA01630
         ENDO                                                           IRA01640
         TM    D3$FG3,X'20'             UPDATE FILE ?                   IRA01650
.LB2     LABEL                                                          IRA01660
         BNZ   D3$00100                 YES, EXIT                       IRA01670
         TM    D3$DFG1,X'40'            WORK SPECIFIED ?                IRA01680
         BZ    D3$00100                 NO, EXIT                        IRA01690
         CLC   D3$DRNM(4),D3$COUTR      EOF REACHED ON NEXT RECORD ?    IRA01700
         BNL   D3$00100                 YES, EXIT                       IRA01710
D3$21070 LA    4,D3$DCSEC               COMPUTE NEXT RECORD ADDRESS     IRA01720
         BAL   3,D3$25010               *                               IRA01730
         BAL   3,D3$25100               WITHIN CURRENT BUFFER ?         IRA01740
         BAL   5,D3$25200               NO, CHECK I/O REQUIRED          IRA01750
         TM    D3$DFG1,X'02'            OUTPUT SEQ IORG PROCESS         IRA01760
         BZ    D3$00100                 NO                              IRA01770
         BAL   5,D3$25500               PROCESS CURRENT RECORD          IRA01780
         B     D3$00100                 EXIT                            IRA01790
         DO    '&INDX'='YES'                                            IRA01800
D3$21080 MVC   D3$DRNM(4),D3$DINR       SET CURRENT RECORD NUMBER       IRA01810
         MVI   DC$REQS,X'10'            SET FOR INPUT OF LAST RETRIEVED IRA01820
         MVI   DC$FCS,X'10'             RECORD                          IRA01830
         B     D3$21025                 EXIT TO READ                    IRA01840
         ENDO                                                           IRA01850
D3$21090 EQU   *                                                        IRA01860
         TM    D3$FG1,X'40'             PUT ALLOWED ?                   IRA01870
         BO    D3$00314                 NO, DM14                        IRA01880
         BAL   5,D3$25500               PROCESS RECORD FOR              IRA01890
         B     D3$00100                 UPDATE AND EXIT                 IRA01900
D3$21100 XC    D3$DFTB(2),D3$DFTB       CLEAR SETL ENTRIES              IRA01910
         NI    D3$DFG1,X'F7'            CLEAR SETL REQUIRED             IRA01920
         TM    D3$FG3,X'04'             MODE=RAND ?                     IRA01930
         BNO   D3$21105                 NO                              IRA01940
         TM    D3$DFG1,X'80'            IOA2 SPECIFIED ?                IRA01950
         BO    D3$03314                 YES, ERROR                      IRA01960
         TM    D3$FG3,X'80'             OUTPUT FILE ?                   IRA01970
         BNO   D3$00100                 NO, EXIT                        IRA01980
         TM    D3$DFG1,X'40'            WORK=YES ?                      IRA01990
         BNO   D3$00314                 NO, DM14 ERROR                  IRA02000
         B     D3$00100                 EXIT                            IRA02010
D3$21105 EQU   *                                                        IRA02020
         DO    '&INDX'='YES'                                            IRA02030
         TM    D3$FG3,X'08'             INDX=YES ?                      IRA02040
         BNO   D3$21110                 NO                              IRA02050
         TM    D3$FG3,X'80'             OUTPUT FILE ?                   IRA02060
         BO    D3$21106                 YES                             IRA02070
         OI    D3$DFG1,X'08'            SET SETL REQUIRED               IRA02080
D3$21106 EQU   *                                                        IRA02090
         MVI   D3$DFTB+1,X'03'          SET SETL GKEY CODE IN TABLE     IRA02100
         B     D3$00100                 EXIT                            IRA02110
         ENDO                                                           IRA02120
D3$21110 MVI   D3$DFTB,X'01'            SET SETL ID CODE IN TABLE       IRA02130
         B     D3$00100                 EXIT                            IRA02140
** EOF PROCESSING **                                                    IRA02150
D3$24000 OI    D3$ERRF+3,X'20'          SET EOV FLAG                    IRA02160
         CLC   DC$PUB(1),DC$PUB+1       LAST VOLUME ACTIVE ?            IRA02170
         BE    D3$24100                 YES                             IRA02180
         LM    14,12,12(13)             RESTORE USER REGS               IRA02190
         LA    0,C'V'                   ISSUE EOV CLOSE                 IRA02200
         SVC   39                       *                               IRA02210
         LA    14,D3$24010              LOAD FEOV RETURN TO BYPASS ALLC IRA02220
         SVC   40                       ISSUE FEOV                      IRA02230
         LR    14,1                     SAVE DTF ADDRESS                IRA02240
         LA    0,512                    LOAD NO FCB CODE                IRA02250
         IC    0,DC$PUB+1               AND VOL NUMBER FOR ALLOCATE     IRA02260
         LA    1,DC$NME                 POINT TO LFD NAME               IRA02270
         SVC   33                       CALL ALLOCATE                   IRA02280
         LR    1,14                     RESTORE DTF ADDRESS             IRA02290
         LTR   0,0                      ALLOC ERROR ?                   IRA02300
         BM    D3$24200                 YES                             IRA02310
D3$24010 SVC   38                       CALL OPEN                       IRA02320
         STM   1,12,24(13)              RESTORE REGS FROM SAVEAREA      IRA02321
         CLI   DC$REQS,X'84'            FEOV ISSUED ?                   IRA02330
         BE    D3$00100                 YES, EXIT                       IRA02340
         TM    D3$FG3,X'80'             OUTPUT                          IRA02341
         BO    D3$00100                 YES,EXIT                        IRA02342
         DO    '&INDX'='YES'                                            IRA02343
         TM    D3$DFG1,X'08'            SETL REQUIRED                   IRA02344
         BNO   D3$21000                 NO                              IRA02345
         BAL   2,D3$530                 LOAD REGS                       IRA02346
         EX    10,D3$24500              CLEAR KARG                      IRA02347
         BAL   3,D3$500                 SEARCH                          IRA02348
         MVI   DC$REQS,X'03'            SET SETL,GKEY                   IRA02349
         BAL   4,D3$30001               LOAD SEQ KEY TABLE              IRA02350
         MVC   DC$REQS(1),DC$FCS        RESET FUNCTION CODE             IRA02351
         NI    D3$DFG1,X'F7'            CLEAR SETL REQD                 IRA02352
         ENDO                                                           IRA02353
         B     D3$21000                 *                               IRA02354
D3$24100 OI    D3$ERRF+3,X'40'          SET EOF FLAG                    IRA02360
         TM    D3$DFG1,X'10'            EOFA SPECIFIED ?                IRA02370
         BNO   D3$00334                 NO                              IRA02380
         MVC   17(3,13),D3$DEODA+1      SET EOFA IN R15                 IRA02390
         LM    14,12,12(13)             RESTORE USER  REGISTERS         IRA02400
         BR    15                       EXIT                            IRA02410
D3$24200 LM    14,15,12(13)             RESTORE USER REGS               IRA02420
         LM    1,12,24(13)              *                               IRA02430
         SVC   28                       CANCEL WITH ERROR CODE IN R0    IRA02440
         DO    '&INDX'='YES'                                            IRA02441
D3$24500 XC    0(1,14),0(14)            *                               IRA02442
         ENDO                                                           IRA02443
** RECORD NUMBER CONVERSION **                                          IRA02450
D3$25000 LH    7,D3$DBFSA               LOAD BUFFER SIZE                IRA02460
         SH    7,D3$DLDSP               SUBTRACT DISP TO FIRST RECORD   IRA02470
         XR    6,6                      *                               IRA02480
         D     6,D3$DREC                DIVIDE BY RECSIZE=HIGH IN BUFF  IRA02490
         A     7,D3$DRNM                ADD CURRENT RECORD NUMBER       IRA02500
         B     D3$25020                 TO COMPUTE UPPER SECTOR/DISP    IRA02510
D3$25010 L     7,D3$DRNM                LOAD CURRENT REC NUM-1 TO       IRA02520
D3$25020 BCTR  7,0                      COMPUTE START SEC/DISP IN BUFF  IRA02530
         M     6,D3$DREC                MULT BY RECSIZE                 IRA02540
         D     6,D3$00256               DIVIDE BY 256, GIVES SECTOR     IRA02550
         LA    7,1(0,7)                 NUMBER AND DISPLACEMENT OF REC  IRA02560
         ST    7,0(,4)                  STORE SECTOR NUMBER             IRA02570
         STH   6,4(,4)                  STORE DISPLACEMENT              IRA02580
         BR    3                        EXIT                            IRA02590
D3$00256 DC    F'256'                                                   IRA02600
**  CHECK CURRENT RECORD WITHIN BUFFER LIMITS **                        IRA02610
D3$25100 CLC   D3$DCSEC(6),D3$DLSEC     CUR  EQ/GR THAN LOWER LIMIT ?   IRA02620
         BLR   3                        NO, OUTSIDE RANGE, RETURN R3    IRA02630
         CLC   D3$DCSEC(6),D3$DUSEC     CUR  LESS THAN UPPER LIMIT ?    IRA02640
         BNLR  3                        NO, OUTSIDE RANGE, RETURN R3    IRA02650
         B     4(,3)                    WITHIN RANGE, RETURN R3+4       IRA02660
** CHECK I/O REQUIREMENTS PRIOR TO NEXT RECORD PROCESS **               IRA02670
D3$25200 EQU   *                                                        IRA02680
         TM    D3$DFG1,X'01'            BUFFER WRITE REQUIRED           IRA02690
         BNO   D3$25220                 NO                              IRA02700
         BAL   11,D3$27000              WAIT OUTSTANDING I/O            IRA02710
         MVC   D3$DCID(4),D3$DLSEC      SET SECTOR NUMBER FOR WRITE     IRA02720
         MVI   DC$REQS,X'26'            SET WRITE CODE                  IRA02730
         NI    D3$DFG1,X'FE'            CLEAR BUFFER ACTIVE FLAG        IRA02740
         TM    D3$DFG1,X'80'            IOA2 SPECIFIED ?                IRA02750
         BNZ   D3$25210                 YES                             IRA02760
         OI    DC$MFLG,X'20'            NO, FORCE WAIT WITH I/O         IRA02770
D3$25210 BAL   11,D3$27500              ISSUE I/O                       IRA02780
D3$25220 MVC   D3$DSTRG(4),D3$DLSEC    SAVE LSEC                        IRA02790
         MVC   D3$DLSEC(6),D3$DCSEC    SET NEW LOWER SECTOR/DISP        IRA02792
         CLI   DC$REQS,X'26'            PUTA ?                          IRA02800
         BNE   D3$25227                 NO, EXIT                        IRA02810
         XR    11,11                    *                               IRA02820
         LH    14,D3$DCDSP             PICK UP CURRENT DISP             IRA02829
         LTR   14,14                   DOES CURRENT DISP=0 ?            IRA02830
         BZ    D3$25221                YES                              IRA02831
         L     11,D3$DUSEC             CALCULATE DISP OF SECTOR TO      IRA02832
         S     11,D3$DSTRG             BE MOVED                         IRA02833
D3$25221 XR    6,6                      LOAD SECTORS/BUFFER             IRA02840
         IC    6,D3$DBFS                *                               IRA02850
         LR    4,6                      *                               IRA02860
         BCTR  6,0                      DECR BY 1                       IRA02870
         A     6,D3$DCSEC               ADD LOW LIMIT SECTOR            IRA02880
         LR    9,6                      STORE HIGH LIMIT SECTOR         IRA02881
         S     6,D3$DMAX                EXCEEDS MAX ?                   IRA02890
         BNP   D3$25225                 NO                              IRA02900
         SR    4,6                      COMPUTE EFF BUFF LENGTH         IRA02910
         BP    D3$25225                 POS NUMBER OF SECTORS, EXIT     IRA02920
D3$25223 LR    4,5                      SAVE R5                         IRA02950
         BAL   5,D3$25555               YES, ATTEMPT EXTEND             IRA02960
         LR    5,4                      RESTORE R5                      IRA02970
         B     D3$25221                 RECOMP EFFECTIVE LENGTH         IRA02980
D3$25225 STC   4,D3$DBFSA               SET SECTORS/BLOCK COUNT         IRA02990
         STC   4,D3$DA1                 *                               IRA03000
         STC   4,D3$DA2                 *                               IRA03010
D3$25227 LA    4,D3$DUSEC               COMPUTE NEW UPPER LIMIT         IRA03020
         BAL   3,D3$25000               *                               IRA03030
         BAL   3,D3$25100               DOES RECORD FIT ?               IRA03040
         B     D3$25223                 NO CHECK EXTEND                 IRA03050
         MVC   D3$DCID(4),D3$DLSEC      SET CURRENT SECTOR FROM NEW LOW IRA03060
         CLI   DC$REQS,X'26'            PUTA ISSUED ?                   IRA03070
         BE    D3$25270                 YES                             IRA03080
         TM    D3$DFG1,X'80'            IOA2 SPEC ?                     IRA03100
         BNO   D3$25240                 NO                              IRA03110
         CLI   DC$REQS,X'10'            GET ISSUED ?                    IRA03120
         BNE   D3$25229                 NO, PROCESS SETL                IRA03130
         TM    D3$DFG1,X'04'            IOA2 READ FLAG SET ?            IRA03140
         BNO   D3$25230                 NO                              IRA03150
D3$25229 NI    D3$DFG1,X'FB'            CLEAR FLAG                      IRA03160
         OI    DC$MFLG,X'20'            SET WAIT=YES                    IRA03170
         MVI   DC$REQS,X'10'            SET READ CODE                   IRA03180
         BAL   11,D3$27500              ISSUE READ AND WAIT IOA1        IRA03190
         BAL   3,D3$25290               SWAP BUFFER ADDRESSES           IRA03200
D3$25230 MVC   D3$DCID(4),D3$DUSEC      SET CUR ID FORM UPPER SECTOR    IRA03210
         CLC   D3$DCID+1(3),D3$DEOD+1   EOD READ ?                      IRA03220
         BL    D3$25240                NO                               IRA03230
         BAL   11,D3$27000             WAIT I/O                         IRA03231
         B     D3$25260                SWAP BUFFERS AND EXIT            IRA03232
D3$25240 TM    D3$FG3,X'2C'             RAND/INDX/UPDT ?                IRA03240
         BNZ   D3$25245                 YES, READ/WAIT IOA2             IRA03250
         TM    D3$FG1,X'01'             READ/WAIT REQUIRED ?            IRA03260
         BO    D3$25245                 YES                             IRA03270
         TM    D3$DFG1,X'C0'            IOA2/WORK SPEC ?                IRA03280
         BNZ   D3$25250                 YES                             IRA03290
D3$25245 OI    DC$MFLG,X'20'            SET WAIT=YES                    IRA03300
         NI    D3$FG1,X'FE'             CLEAR READ/WAIT FLAG            IRA03310
D3$25250 MVI   DC$REQS,X'10'            SET READ CODE                   IRA03320
         BAL   11,D3$27500             ISSUE READ                       IRA03330
D3$25260 BAL   3,D3$25290               SWAP I/O BUFFER ADDRESSES       IRA03340
         BR    5                        RETURN                          IRA03350
D3$25270 L     9,D3$DA1                 LOAD BUFFER ADDRESSES           IRA03360
         L     8,D3$DA2                 *                               IRA03370
         TM    D3$FG3,X'04'             MODE=RAND ?                     IRA03380
         BO    D3$25271                 YES                             IRA03390
         CLC   D3$DCID+1(3),D3$00256    FIRST SECTOR OUTPUT ?           IRA03400
         BER   5                        YES, RETURN                     IRA03410
D3$25271 TM    DC$DTF-1,X'01'           EXTEND ACTIVE ?                 IRA03420
         BO    D3$25272                 YES, BYPASS MODE CHECK          IRA03430
         TM    D3$FG3,X'64'             MODE=RAND/INPUT ?               IRA03440
         BZ    D3$25275                 NO                              IRA03450
D3$25272 EQU   *                                                        IRA03460
         CLC   D3$DEOD+1(3),D3$DCID+1   COMPARE EOD TO CURR SECTOR      IRA03470
         BL    D3$25260                 IF LOW, SWAP BUFFERS, RETURN    IRA03480
         BH    D3$25280                 IF HIGH, READ IS REQUIRED       IRA03490
D3$25275 EQU   *                                                        IRA03500
         LTR   14,14                   DOES CURRENT DISP=0 ?            IRA03510
         BZ    D3$25260                YES-DO NOT MOVE SECTOR           IRA03512
         M     10,D3$00256              COMPUTE DISP TO LAST SECTOR OF  IRA03520
         AR    9,11                     CURRENT BUFFER AND MOVE TO      IRA03530
         MVC   0(256,8),0(9)            SECONDARY BUFFER                IRA03540
         B     D3$25260                 SWAP BUFFER ADDRESSES, RETURN   IRA03550
D3$25280 BAL   3,D3$25290               SWAP BUFFER ADDRESSES           IRA03560
         BAL   11,D3$27000              WAIT I/O                        IRA03570
         MVI   DC$REQS,X'10'            SET FOR READ                    IRA03580
         OI    DC$MFLG,X'20'            SET WAIT=YES                    IRA03590
         BAL   11,D3$27500              ISSUE READ                      IRA03600
         BR    5                        EXIT                            IRA03610
D3$25290 EQU   *                                                        IRA03620
         L     2,D3$DA1                 SAVE BUFFER ADDRESS FROM IOA1   IRA03630
         MVC   D3$DA1(4),D3$DA2         MOVE IOA2 ADDRESS TO IOA1       IRA03640
         ST    2,D3$DA2                 STORE IOA1 CONTENTS IN IOA2     IRA03650
         BR    3                        RETURN                          IRA03660
** CURRENT RECORD PROCESSOR **                                          IRA03670
D3$25500 EQU   *                                                        IRA03680
         L     7,D3$DCSEC               COMPUTE RECORD LOCATION:        IRA03690
         MVC   D3$DSTRG(4),D3$DLSEC     CURRENT SECTOR MINUS LOWER      IRA03700
         S     7,D3$DSTRG               SECTOR                          IRA03710
         M     6,D3$00256               MULTIPLIED BY 256               IRA03720
         AH    7,D3$DCDSP               PLUS CURRENT DISPLACEMENT       IRA03730
         A     7,D3$DA1                 PLUS IOA1 ADDRESS               IRA03740
         TM    D3$DFG1,X'20'            IORG SPECIFIED ?                IRA03750
         BZ    D3$25510                 NO                              IRA03760
         LH    6,D3$DIORG               PICK UP DISP INTO SAVEAREA      IRA03770
         ST    7,0(6,13)                STORE RECORD LOCATION           IRA03780
         B     D3$25550                 CHECK OUTPUT AND EXIT           IRA03790
D3$25510 L     6,20(0,13)               PICK UP WORK AREA ADDRESS       IRA03800
         CLI   DC$REQS,X'10'            INPUT FUNCTION ?                IRA03810
         BE    D3$25520                 YES                             IRA03820
         XR    6,7                      SWAP POINTERS                   IRA03830
         XR    7,6                                                      IRA03840
         XR    6,7                                                      IRA03850
D3$25520 L     9,D3$DREC                PICK UP RECORD SIZE             IRA03860
         BCTR  9,0                      DECR BY 1                       IRA03870
         XR    8,8                                                      IRA03880
         D     8,D3$00256               CALCULATE # OF 256 BYTE MOVES   IRA03890
         LTR   9,9                      ANY 256 BYTE MOVES ?            IRA03900
         BZ    D3$25540                 NO                              IRA03910
D3$25530 MVC   0(256,6),0(7)            MOVE 256 BYTES OF RECORD        IRA03920
         LA    6,256(,6)                ADVANCE POINTERS                IRA03930
         LA    7,256(,7)                                                IRA03940
         BCT   9,D3$25530               DECREMENT SECTOR COUNT          IRA03950
D3$25540 EX    8,D3$25600               MOVE REMAINDER                  IRA03960
D3$25550 CLI   DC$REQS,X'10'            INPUT FUNCTION ?                IRA03970
         BER   5                        YES, RETURN                     IRA03980
         OI    D3$DFG1,X'01'            SET BUFFER ACTIVE FLAG          IRA03990
         BR    5                        RETURN                          IRA04000
D3$25555 TM    DC$MFLG+1,X'01'          UNASSIGNED SPACE AVAILABLE ?    IRA04001
         BO    D3$25556                 YES                             IRA04002
         TM    D3$FG3,X'80'             OUTPUT FILE ?                   IRA04003
         BNO   D3$25556                 NO                              IRA04004
         CLC   DC$PUB+1(1),DC$PUB       LAST VOLUME ?                   IRA04005
         BNE   D3$24000                 NO--GO TO EOV                   IRA04006
D3$25556 LR    10,1                     LOAD DTF ADDRESS IN R10         IRA04010
         ST    11,D3$DSTRG         SAVE R11                             IRA04011
         BAL   11,D3$27000         WAIT IO BEFORE SVC ISSUE             IRA04012
         L     11,D3$DSTRG         RESTORE R11                          IRA04013
         OI    DC$ERFLG,X'40'           SET INVALID ID FLAG             IRA04014
         SVC   46                       CALL EXTEND: R12 HAS PCA ADDR   IRA04020
         SVC   48                       WHICH REQUIRES EXTENSION        IRA04030
         B     D3$03999                EXIT TO ERROR                    IRA04040
         C     9,4(12)                  HIGH SECTOR STILL > MAX ?       IRA04041
         BH    D3$00324                 YES-INVALID ID                  IRA04042
         NI    DC$ERFLG,X'BF'           CLEAR INVALID ID FLAG           IRA04043
         BR    5                        RETURN                          IRA04050
D3$25600 MVC   0(0,6),0(7)              MOVE REMAINDER OF RECORD        IRA04060
* I/O ISSUE AND WAIT SUBROUTINE                                         IRA04070
D3$27000 TM    DC$MFLG,X'40'            WAIT REQUIRED ?                 IRA04080
         BNOR  11                       NO, RETURN                      IRA04090
         MVI   DC$REQS,X'86'            SET WAIT CODE                   IRA04100
D3$27500 L     15,D3$SATA               LOAD SAT ADDRESS IN R15         IRA04110
         BALR  14,15                    LINK TO SAT                     IRA04120
         L     15,16(,13)               RESTORE IRAM COVER              IRA04130
         NI    DC$MFLG,X'DF'            CLEAR WAIT=YES                  IRA04140
         MVC   DC$REQS(1),DC$FCS        RESTORE FUNCTION CODE           IRA04150
         MVC   D3$ERRF(2),DC$ERFLG      SET STATUS FLAGS                IRA04160
         MVC   D3$ERRF+2(1),DC$SB       *                               IRA04170
         MVI   D3$ERRF+3,0              *                               IRA04180
         BR    11                       RETURN                          IRA04190
         DO    '&INDX'='YES'                                            IRA04200
D3$30000 EQU   *                                                        IRA04210
         CLI   DC$REQS,X'26'            PUTA                            IRA04220
         BE    D3$30010                 YES                             IRA04230
         CLI   DC$REQS,X'10'            READ ?                          IRA04240
         BE    D3$30020                 YES                             IRA04250
         BAL   3,D3$500                 SRCH FOR SETL                   IRA04260
         BAL   11,D3$27000              WAIT I/O BEFORE SVC ISSUE       IRA04261
D3$30001 EQU   *                                                        IRA04262
         SVC   99                       LOAD SEQ KEY TABL               IRA04270
         AI    D3$XREME,0               END OF DATA                     IRA04280
         BZ    D3$24000                 YES, EOF                        IRA04290
         BR    4                        RETURN                          IRA04300
D3$30010 LR    3,4                      LOAD RETURN IN R3               IRA04310
         XC    D3$XREME(2),D3$XREME    ZERO REMAINING ENTRIES FIELD     IRA04311
         OI    D3$XCON,X'40'           REBUILD TABLE AFTER ADD          IRA04312
         NI    D3$XCON,X'EF'           CLEAR GOOD FINE BLK FLG ON ADD   IRA04313
         B     D3$540                   EXIT TO LOAD/ADD                IRA04320
D3$30020 TM    D3$FG3,X'04'             MODE=RAND ?                     IRA04330
         BNO   D3$30030                 NO                              IRA04340
         BAL   3,D3$500                 SEARCH KEY EQ                   IRA04350
         BNE   D3$00331                 NO-FIND ERROR EXIT              IRA04360
         BR    4                        EQ MATCH, RETURN                IRA04370
D3$30030 AI    D3$XREME,0               TABLE EMPTY ?                   IRA04380
         BNZ   D3$30040                 NO                              IRA04390
         BAL   11,D3$27000              WAIT INPUT I/O                  IRA04400
         SVC   99                       LOAD SEQ KEY TABLE              IRA04410
         AI    D3$XREME,0               TABLE EMPTY ?                   IRA04420
         BZ    D3$24000                 YES, EOF                        IRA04430
D3$30040 L     5,D3$XKSEQ               LOAD POINTER ADDRESS            IRA04440
         MVC   D3$DRNM+1(3),0(5)        SET RECORD NUMBER FROM TABLE    IRA04450
         LA    5,3(,5)                  INCR TO NEXT ENTRY              IRA04460
         ST    5,D3$XKSEQ               *                               IRA04470
         AI    D3$XREME,-1              DECREMENT COUNT BY 1            IRA04480
         OI    D3$FG1,X'01'             SET READ WAIT FLAG              IRA04490
         BR    4                        RETURN                          IRA04500
D3$530   EQU   *                                                        IRA04510
         LH    9,D3$CISZ                                                IRA04520
         IC    9,D3$502                                                 IRA04530
         SH    9,D3$502                 R9 = FINE BLK USABLE BYTES      IRA04540
         L     14,D3$XKARG                                              IRA04550
         L     12,DC$PCA2                                               IRA04560
         L     11,D3$XBUF                                               IRA04570
         LA    11,0(0,11)                                               IRA04580
         LH    10,D3$XKSZ               MAX KEY SIZE                    IRA04590
         LA    8,3(0,10)                R8 IS MAX ENTRY SIZE            IRA04600
         LA    7,D3$XHIK                                                IRA04610
         LA    6,1                                                      IRA04620
         BCTR  10,2                     R10 IS MAX KEY SIZE-1           IRA04630
D3$502   EQU   *                                                        IRA04640
         DC    X'0006'                                                  IRA04650
D3$503   EQU   *                                                        IRA04660
         MVC   0(1,7),0(14)                                             IRA04670
D3$504   EQU   *                                                        IRA04680
         CLC   0(1,14),0(7)                                             IRA04690
D3$500   EQU   *                                                        IRA04700
         BAL   2,D3$530                 SET REGS                        IRA04710
         C     6,D3$COUTR               DATA IN FILE ?                  IRA04720
         BNL   D3$00331                NO, RANDOM NO FIND               IRA04730
         TM    D3$XCON,X'01'                                            IRA04731
         BZ    D3$5001                  BR IF NO WRITE OWED             IRA04732
         MVC   D3$XBUF(1),D3$CISZ       NUMB IND BLKS                   IRA04733
         MVI   DC$REQS,X'20'            WRITE CODE                      IRA04734
         OI    DC$MFLG,X'20'            WAIT                            IRA04735
         BAL   11,D3$27500              WRITE BLK                       IRA04736
         NI    D3$XCON,X'FE'                                            IRA04737
D3$5001  BAL   2,D3$530                                                 IRA04738
         LR    7,11                     ADR BUF TOP IN 7 AS WELL AS 11  IRA04740
         TM    D3$XCON,X'10'            TEST STATUS OF IND BUF          IRA04750
         BZ    D3$521                   BR IF FULL SRCH NECESSARY       IRA04760
         EX    10,D3$504                ARG (14) VS LOKEY IN BUF (7)    IRA04770
         BL    D3$521                   FULL SRCH NEEDED IF ARG LO      IRA04780
         AH    7,0(9,11)                ADD CFB TO R7                   IRA04790
         SR    7,8                      R7 ON LAST ENTRY IN BUF         IRA04800
         EX    10,D3$504                ARG (14) VS HIKEY IN BUF (7)    IRA04810
         BE    D3$525                   GO TO HIT MADE                  IRA04820
         BL    D3$527                   GO TO CORE SEARCH               IRA04830
         LR    7,11                     ELSE RESET R7 FOR FULL SRCH     IRA04840
D3$521   EQU   *                        START FULL SEARCH               IRA04850
         EX    10,D3$503                TO BUF (7) FROM KARG (14)       IRA04860
         OI    D3$XSPB-1,X'40'          SET MULTI TRK                   IRA04870
         MVI   D3$XBUF,X'01'            SET SINGLE BLK                  IRA04880
         ST    6,D3$XCBN                SET BLKNO = 1                   IRA04890
D3$522   EQU   *                                                        IRA04900
         MVI   DC$REQS,X'14'            SET SRCH                        IRA04910
         NI    D3$XCBN+1,X'7F'          CLR BIT                         IRA04920
         OI    DC$MFLG,X'20'            SAT TO DO WAIT                  IRA04930
         BAL   11,D3$27500              DO TRACK(S) SEARCH              IRA04940
         BAL   2,D3$530                                                 IRA04950
         IC    6,255(11)                CUR FILL TO R6                  IRA04960
         AR    11,6                                                     IRA04970
         LR    7,11                     R11 AND R7 AT END OF DATA       IRA04980
         LR    2,8                                                      IRA04990
         SR    8,8                                                      IRA05000
         SR    8,2                      R8 HAS NEG ENTRY SIZE           IRA05010
D3$523   EQU   *                                                        IRA05020
         AR    7,8                      RESET R7 TO ADJAC ENTRY         IRA05030
D3$524   EQU   *                                                        IRA05040
         CR    7,11                                                     IRA05050
         BH    D3$00331                 OFF END OF FILE                 IRA05060
         EX    10,D3$504                KARG KEY (14) VS BUF KEY (7)    IRA05070
         BH    D3$523                   LOOP                            IRA05080
D3$525   EQU   *                                                        IRA05090
         ST    7,D3$XKSEQ               SAVE BUF LOC OF HIT REC         IRA05100
         LA    7,0(7,10)                                                IRA05110
         BCT   6,D3$526                 BR IF NOT DONE                  IRA05120
         MVC   D3$DRNM+1(3),1(7)                                        IRA05130
         BR    3                                                        IRA05140
D3$526   EQU   *                                                        IRA05150
         MVC   D3$XCBN+1(3),1(7)                                        IRA05160
         TM    D3$XCBN+1,X'80'                                          IRA05170
         BNZ   D3$522                   IF BIT SET, SEARCH AGAIN        IRA05180
         MVI   DC$REQS,X'10'                                            IRA05190
         MVC   D3$XBUF(1),D3$CISZ                                       IRA05200
         OI    DC$MFLG,X'20'            SET WAIT I/O FLAG               IRA05210
         BAL   11,D3$27500              DO MULTI-BLK READ               IRA05220
         OI    D3$XCON,X'10'                                            IRA05230
         BAL   2,D3$530                                                 IRA05240
D3$527   EQU   *                                                        IRA05250
         LR    7,11                     BUF ADR TO R7                   IRA05260
         AH    11,0(9,7)                BUF ADR PLUS CFB TO R11         IRA05270
         BCT   11,D3$524                STOPPER VALUE IN R11            IRA05280
D3$540   EQU   *                                                        IRA05290
         BAL   2,D3$530                                                 IRA05300
         LR    7,14                     ADR KARG IN 7                   IRA05310
         LH    14,D3$XKLC0                                              IRA05320
         A     14,20(0,13)              ADR REC KEY IN 14               IRA05330
         EX    10,D3$503                TO KARG (7) FROM REC (14)       IRA05340
         AR    7,10                                                     IRA05350
         MVC   1(3,7),D3$DRNM+1                                         IRA05360
         AI    D3$XPKCE,X'00'                                           IRA05370
         BNZ   D3$541                   SKIP IF NOT FIRST AFTER OPEN    IRA05380
         BAL   11,D3$27000              WAIT I/O BEFORE SVC ISSUE       IRA05381
         OC    D3$XMBN(4),D3$XMBN       MAX=0(NO INDEX ALLOC) ?         IRA05382
         BNZ   D3$540A                  NO                              IRA05383
         LA    9,1                      SET HIGH SECTOR TO 1            IRA05384
         BAL   5,D3$25556               CALL EXTEND                     IRA05385
D3$540A  SVC   98                       FRSTA TRANS                     IRA05390
D3$541   EQU   *                        START CALC SPACE FOR ADD        IRA05400
         IC    6,D3$CLEV                                                IRA05410
         LM    7,9,D3$XMBN              MBN IN 7, BPT IN 8, FAB IN 9    IRA05420
         BCTR  9,0                      FAB MINUS 1                     IRA05430
D3$542   EQU   *                                                        IRA05440
         LA    9,0(8,9)                 ADD BPT TO FAB                  IRA05450
         BCT   6,D3$542                 AS MANY TIMES AS LEVELS         IRA05460
         CR    9,7                      SUM VS MAX BLK                  IRA05470
         BNH   D3$543                   BR IF ENUF SPACE IS AVAIL       IRA05480
         BAL   5,D3$25555               EXTEND-INDEX TRANS              IRA05490
D3$543   EQU   *                                                        IRA05500
         BAL   2,D3$530                 SET REGS                        IRA05510
         EX    10,D3$504                ARG (14) VS HIK (7)             IRA05520
         BNL   D3$544                                                   IRA05530
         TM    D3$FG3,X'82'                                             IRA05540
         BO    D3$00337                 TO SEQ ERR IF ORD LOAD          IRA05550
         BAL   11,D3$27000              WAIT I/O BEFORE SVC ISSUE       IRA05551
         SVC   97                       TO ARGLO TRANS                  IRA05560
         BR    3                                                        IRA05570
D3$544   EQU   *                                                        IRA05580
         BNE   D3$545                                                   IRA05590
         C     6,D3$DRNM                                                IRA05600
         BNE   D3$00336                 TO DUPE ERR, EXCEPT RECNO 1     IRA05610
D3$545   EQU   *                                                        IRA05620
         TM    D3$XCON,X'01'            TEST FOR WRITE OWED             IRA05630
         BNZ   D3$547                   TO RES CODE IF OUTPUT           IRA05640
D3$546   EQU   *                                                        IRA05650
         BAL   11,D3$27000              WAIT I/O BEFORE SVC ISSUE       IRA05651
         SVC   96                       TO ARGHI TRANS                  IRA05660
         BR    3                                                        IRA05670
D3$547   EQU   *                                                        IRA05680
         LH    2,0(9,11)                CFB FROM BUF                    IRA05690
         CH    2,D3$XLBT                CUR LOC VS LIMIT LOC            IRA05700
         BNL   D3$546                   IF NOT ROOM, GO TO TRANS        IRA05710
         LA    10,3(0,10)                                               IRA05720
         EX    10,D3$503                TO HIK (7) FROM KARG (14)       IRA05730
         LA     7,0(2,11)                                               IRA05740
         EX    10,D3$503                TO BUF (7) FROM KARG (14)       IRA05750
         AR    2,8                                                      IRA05760
         STH   2,0(9,11)                SET NEW CFB IN FINE             IRA05770
         BR    3                                                        IRA05780
         ENDO                                                           IRA05790
         DTFDM IR=YES                   CALL IRAM DSECT EXPANSION       IRA05800
&SYSECT  CSECT                                                          IRA05810
         END                                                            IRA05820
