         PROC  &P,0,&RAN=,&SEQ=,&ADD=,&LOAD=,&INDX=                     AA200010
AA28     NAME                           IS$OS3                          AA200020
IS$OS3   NAME                                                           AA200030
         LCL   &L?SEQ,&L?RAN,&L?UPD,&L?AD,&L?LD,&L?NX,&L1,&L2,&L3,&L4   AA200040
         LCL   &F1,&F2,&F3,&F4                                          AA200050
         GBL   &IS$B                                                    AA200060
         DO    '&IS$B'=''                                               AA200070
&IS$B    SET   0                                                        AA200080
&L1      SET   0                                                        AA200090
&L2      SET   0                                                        AA200100
&L3      SET   0                                                        AA200110
&L4      SET   0                                                        AA200120
&F1      SET   0                                                        AA200130
&F2      SET   0                                                        AA200140
&F3      SET   0                                                        AA200150
&F4      SET   0                                                        AA200160
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  AA200170
*                                                                    *  AA200180
*   THE FOLLOWING PROGRAMS ARE THE SOLE PROPERTY OF SPERRY           *  AA200190
*                                                                    *  AA200200
* UNIVAC CONTAINING ITS PROPRIETARY, CONFIDENTIAL INFORMATION        *  AA200210
*                                                                    *  AA200220
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  AA200230
         DO    '&SEQ'='NO'                                              AA200240
&L?SEQ   SET   0                                                        AA200250
         GOTO  .DT11                                                    AA200260
         ENDO                                                           AA200270
&F2      SET   &F2+2                                                    AA200280
&L?SEQ   SET   1                                                        AA200290
.DT11    LABEL                                                          AA200300
&L?UPD   SET   1                                                        AA200310
.DT21    LABEL                                                          AA200320
         DO    '&RAN'='NO'                                              AA200330
&L?RAN   SET   0                                                        AA200340
         GOTO  .DT31                                                    AA200350
         ENDO                                                           AA200360
&F2      SET   &F2+1                                                    AA200370
&L?RAN   SET   1                                                        AA200380
.DT31    LABEL                                                          AA200390
         DO    '&LOAD'='NO'                                             AA200400
&L?LD    SET   0                                                        AA200410
         GOTO  .DT41                                                    AA200420
         ENDO                                                           AA200430
&L?LD    SET   1                                                        AA200440
&F1      SET   &F1+1                                                    AA200450
.DT41    LABEL                                                          AA200460
         DO    '&INDX'='NO'                                             AA200470
&L?NX    SET   0                                                        AA200480
         GOTO  .DT51                                                    AA200490
         ENDO                                                           AA200500
&L?NX    SET   1                                                        AA200510
&F3      SET   &F3+1                                                    AA200520
.DT51    LABEL                                                          AA200530
         DO    '&ADD'='NO'                                              AA200540
&L?AD    SET   0                                                        AA200550
         GOTO  .DT71                                                    AA200560
         ENDO                                                           AA200570
&L?AD    SET   1                                                        AA200580
&F4      SET   &F4+2                                                    AA200590
.DT71    LABEL                                                          AA200600
&F4      SET   &F4+1                                                    AA200610
IS$&F1.&F2.&F3.&F4  CSECT                                               AA200620
&F4      SET   &F4-1                                                    AA200630
&L1      SET   &F1                                                      AA200640
&L2      SET   &F2                                                      AA200650
&L3      SET   &F3                                                      AA200660
&L4      SET   &F4                                                      AA200670
         DO    &L1+1                                                    AA200680
         DO    (&L?SEQ=1)**(&L?RAN=0)                                   AA200690
&L2      SET   1                                                        AA200700
         GOTO  .DT73                                                    AA200710
         ENDO                                                           AA200720
&F2      SET   &L2                                                      AA200730
.DT73    LABEL                                                          AA200740
         DO    &L2+1                                                    AA200750
&F3      SET   &L3                                                      AA200760
         DO    &L3+1                                                    AA200770
&F4      SET   &L4                                                      AA200780
         DO    &L4+1                                                    AA200790
IS$&F1.&F2.&F3.&F4  EQU   *                                             AA200800
                    ENTRY IS$&F1.&F2.&F3.&F4                            AA200810
&F4      SET   &F4-1                                                    AA200820
         ENDO                                                           AA200830
&F3      SET   &F3-1                                                    AA200840
         ENDO                                                           AA200850
         DO    (&L?SEQ=1)**(&L?RAN=0)                                   AA200860
         DO    (&F2>0)                                                  AA200870
&F2      SET   &F2-2                                                    AA200880
         GOTO  .DT75                                                    AA200890
         ENDO                                                           AA200900
         DO    (&F2=0)                                                  AA200910
&F2      SET   &F2+2                                                    AA200920
         GOTO  .DT75                                                    AA200930
         ENDO                                                           AA200940
         ENDO                                                           AA200950
&F2      SET   &F2-1                                                    AA200960
.DT75    LABEL                                                          AA200970
         ENDO                                                           AA200980
&F1      SET   &F1-1                                                    AA200990
         ENDO                                                           AA201000
         USING *,15                                                     AA201010
         USING DM$DSCT,1                                                AA201020
         ENTRY DH$ERR                                                   AA201030
         ENTRY DH$COM                                                   AA201040
DH$COM   EQU   *                                                        AA201050
         BC    15,DH$C010               ENTER ISAM COMMON               AA201060
         DC    X'0080'                         ****                     AA201070
         DC    YL1(&L1*/4+&L2)           FACILITIES BITS                AA201080
         DC    YL1(&L3*/4+&L4+1)        FACILITIES BITS                 AA201090
DH$ERDSP DC    A(DH$ERR-DH$COM)         DISP TO ERROR RTNE              AA201100
         DC    XL4'FFFF0000'                                            AA201110
         DC    X'090776'                REVISION DATE                   AA201111
DH$PTCH  DC    10F'0'                                                   AA201120
DH$C010  EQU   *                         ISAM COMMON RTN - PROVIDES     AA201130
****                               ****  MACRO VALIDATION ,SEQUENCE     AA201140
***                                ***   VALIDATION AND SELECTS THE     AA201150
**                                 **    PROPER IOCS RTN TO ENTER       AA201160
*                                  *     STORES USER REGISTERS          AA201170
         ST    13,DC$SAVR               SAVE                            AA201180
         CLI   DC$SAV,X'F0'              USER                           AA201190
         BC    8,DH$C011           REGISTERS                            AA201200
         L     13,DC$SAV                   0 TO 12 AND                  AA201210
DH$C011  EQU   *                                                        AA201220
         STM   14,12,12(13)                 14 AND 15                   AA201230
         LR    14,15                    COMPUTE ERROR RTNE ADDRESS      AA201231
         A     14,DH$ERDSP              *                               AA201232
         ST    14,DC$ERCD               STORE IN DTF                    AA201233
         MVC   DC$FCS(1),DC$REQS        SAVE FUNCTION CODE              AA201240
         XC    DC$NMC(4),DC$NMC      CLEAR 4 BYTES OF FILENAME-C        AA201250
         TM    DC$MFLG,X'80'            IS FILE OPEN                    AA201260
         BNO   DH$ER14                  NO BR ERROR                     AA201270
         DO    (&L?AD++&L?SEQ++&L?RAN)                                  AA201280
         TM    DC$FG2,X'10'              TEST FOR LOAD                  AA201290
         BC    1,DH$C013                                                AA201300
*                       PROC INHIB TEST                                 AA201310
         TM    DC$FG1,X'80'             TEST PROCESSING INHIB           AA201320
         BO    DH$ER49                  GO TO ERROR 49                  AA201330
*                   INITIALIZE FOR TABLE SCAN                           AA201340
         LA    5,DH$CTAB                 ADDR OF MACRO TABLE            AA201350
         IC    6,DC$REQS                 MOVE FUNCTION TO R6            AA201360
DH$C012  EQU   *                                                        AA201370
*                   USING REG6 TO CARRY FUNCTION COMPARE TO R5 WHICH    AA201380
*                     POINTS TO THE TABLE.                              AA201390
         EX    6,DH$CEX1                 GO TEST FOR VALID FUNCTION     AA201400
         BC    8,DH$C020                 IF EQ GO TO TEST MACRO SEQ     AA201410
         CLI   0(5),X'FF'                TEST FOR END OF TABLE          AA201420
         BC     8,DH$ER14                                               AA201430
         LA    5,4(5)                    INCR R5 BY TABLE SIZE          AA201440
         BC    15,DH$C012                                               AA201450
DH$C020  EQU   *     THIS ROUTINE CHECKS MACRO SEQUENCE                 AA201460
         IC    6,1(,5)                   PICK UP SPECIAL SEQ CODE       AA201470
         LH    5,2(,5)                   LOAD DISPL. FROM TABLE         AA201480
         EX    6,DH$CEX2                 GO TEST FOR MACRO SEQ          AA201490
*                                        IF FULL OR PART MATCH GO TO    AA201500
         BC    7,0(5,15)                  THE IOCS RTN (DISPL. IN R5)   AA201510
         BC    15,DH$ER14                                               AA201520
         ENDO                                                           AA201530
DH$C013  EQU   *                                                        AA201540
         LA    14,DH$LOAD                                               AA201550
         CLI   DC$REQS,X'42'            WAIT ISSUE IN ENDFL MACRO       AA201560
         BNE   DH$CO13A                 NO,SKIP OVER                    AA201570
         MVI   DC$REQS,X'86'            MOVE IN WAIT CODE & CALL LOAD   AA201580
         BR    14                                                       AA201590
DH$CO13A EQU   *                                                        AA201600
         TM    DC$FG1,X'80'             TEST PROCESSING INHIB           AA201610
         BO    DH$ER49                  GO TO ERROR 49                  AA201620
         CLI   DC$REQS,X'26'            TEST FOR WRITE NEW KEY ONLY     AA201630
         BER   14                                                       AA201640
         BC    15,DH$ER14                                               AA201650
DH$CKSZ  EQU   *                                                        AA201660
         L     9,DH$LWA                                                 AA201670
         LH    14,DH$SPB                                                AA201680
         TM    DH$COD,X'01'                                             AA201690
         BZR   12                       EXIT IF FIXED RECS              AA201700
         MVC   DH$SPB(2),0(9)                                           AA201710
         LH    14,DH$SPB                                                AA201720
         CH    14,DH$BHB                CHECK SIZE LT 2 BYTES           AA201730
         BL    DH$ER18                                                  AA201740
         LA    8,7(0,14)                FORM SIZE PLUS 7 BYTES          AA201750
         CH    8,DH$BSZ                                                 AA201760
         BH    DH$ER18                  OVERSIZE REC                    AA201770
         SH    14,DH$KLC                                                AA201780
         SH    14,DH$KSZ                                                AA201790
         BR    12                                                       AA201800
         DO    (&L?AD++&L?SEQ++&L?RAN)                                  AA201810
DH$CEX1  EQU   *                        MACRO VALIDATION TEST           AA201820
         CLI   0(5),X'00'                                               AA201830
DH$CEX2  EQU   *                                                        AA201840
         TM    DH$FG2,X'00'              TEST PREV FUNCTION             AA201850
         CNOP  0,4                                                      AA201860
         CNOP  0,4                                                      AA201870
DH$CTAB  EQU   *                                                        AA201880
         DC    X'00'                     SETL                           AA201890
         DC    X'15'                     OPEN WAITF OR ESETL    SETL    AA201900
         DC    Y(DT$SETL-DH$COM)         SETL ENTRANCE DISPLACEMENT     AA201910
         DC    X'01'                     SETL                           AA201920
         DC    X'15'                     OPEN WAITF OR ESETL    SETL    AA201930
         DC    Y(DT$SETL-DH$COM)         SETL ENTRANCE DISPLACEMENT     AA201940
         DC    X'02'                     SETL                           AA201950
         DC    X'15'                     OPEN WAITF OR ESETL    SETL    AA201960
         DC    Y(DT$SETL-DH$COM)         SETL ENTRANCE DISPLACEMENT     AA201970
         DC    X'03'                     SETL                           AA201980
         DC    X'15'                     OPEN WAITF OR ESETL    SETL    AA201990
         DC    Y(DT$SETL-DH$COM)         SETL ENTRANCE DISPLACEMENT     AA202000
         DC    X'10'                     GET                            AA202010
         DC    X'E0'                     GET PUT OR SETL        GET     AA202020
         DC    Y(DT$GET-DH$COM)                                         AA202030
         DC    X'11'                     READ ID                        AA202040
         DC    X'15'                     OPEN WAITF OR ESETL  READ ID   AA202050
         DC    Y(DT$READ-DH$COM)                                        AA202060
         DC    X'12'                     READ KEY                       AA202070
         DC    X'15'                     OPEN WAITF OR ESETL  READ KEY  AA202080
         DC    Y(DT$READ-DH$COM)                                        AA202090
         DC    X'20'                     PUT                            AA202100
         DC    X'80'                     GET                    PUT     AA202110
         DC    Y(DT$PUT-DH$COM)                                         AA202120
         DC    X'22'                     WRITE KEY                      AA202130
         DC    X'09'                    READ/WAITF                      AA202140
         DC    Y(DT$WRITE-DH$COM)                                       AA202150
         DC    X'26'                     WRITE NK                       AA202160
         DC    X'11'                    ESETL/WAITF                     AA202170
         DC    Y(DH$ADD-DH$COM)          ADD ENTRANCE MINUS START       AA202180
         DC    X'40'                     ESETL                          AA202190
         DC    X'E0'                     SETL GET OR PUT       ESETL    AA202200
         DC    Y(DT$ESETL-DH$COM)                                       AA202210
         DC    X'86'                     WAITF                          AA202220
         DC    X'0E'                                                    AA202230
         DC    Y(DH$WAIT-DH$COM)                                        AA202240
         DC    X'FF'                     END OF TABLE                   AA202250
         EJECT                                                          AA202260
         ENDO                                                           AA202270
         CNOP  0,4                                                      AA202280
DT$LP2   EQU   *                                                        AA202290
DH$CXT   EQU   *                         COMMON EXIT RESTORES USER      AA202300
*                                        REGISTERS                      AA202310
         MVC   DC$REQS(1),DC$FCS        RESTOPE FUNCTION CODE           AA202320
         XC    DC$NMC(4),DC$NMC        CLEAR FMANE.C                    AA202330
         TM    DH$FG2,X'88'             IS THIS READ OR GET             AA202340
         BZ    DH$CXT1                  NO - INHIBIT UPDATE             AA202350
         OI    DC$FG3,X'10'             YES ALLOW UPDATE NEXT           AA202360
         B     DH$CXT2                                                  AA202370
DH$CXT1  EQU   *                                                        AA202380
         NI    DC$FG3,X'EF'             CLEAR UPDATE BIT                AA202390
DH$CXT2  EQU   *                                                        AA202400
         LM    14,12,12(13)             RESTORE REGS                    AA202410
         L      13,DC$SAVR                                              AA202420
         BR     14                      EXIT                            AA202430
DH$ER18  EQU   *                                                        AA202440
         BAL   14,ER2                                                   AA202450
         DC    XL1'18'             INVALID RECORD SIZE                  AA202460
         DC    XL1'80'             FNAME.C BIT MSG CODE                 AA202470
DH$ER34  EQU   *                                                        AA202480
         BAL   14,ER2                                                   AA202490
         DC    XL1'34'             END OF DATA, SEQ FUNCTION            AA202500
         DC    XL1'40'             FNAME.C BIT MSG CODE                 AA202510
DH$ER35  EQU   *                                                        AA202520
         BAL   14,ER2                                                   AA202530
         DC    XL1'35'             ADD RESTRICTED BY PREV OPER          AA202540
         DC    XL1'01'             FNAME.C BIT MSG CODE                 AA202550
DH$ER36  EQU   *                                                        AA202560
         BAL   14,ER2                                                   AA202570
         DC    XL1'36'             DUPLICATE RECORD                     AA202580
         DC    XL1'02'             FNAME.C BIT MSG CODE                 AA202590
DH$ER37  EQU   *                                                        AA202600
         BAL   14,ER2                                                   AA202610
         DC    XL1'37'             SEQ.ERROR-RECORD REJECTED            AA202620
         DC    XL1'04'             FNAME.C BIT MSG CODE                 AA202630
DH$ER39  EQU   *                                                        AA202640
         BAL   14,ER4                                                   AA202650
         DC    XL1'39'             INVALID INDEX                        AA202660
         DC    XL1'08'             FNAME.C BIT MSG CODE                 AA202670
DH$ER41  EQU   *                                                        AA202680
         BAL   14,ER4                                                   AA202690
         DC    XL1'41'             FILE SPACE EXHAUSTED                 AA202700
         DC    XL1'20'             FNAME.C BIT MSG CODE                 AA202710
DH$ER49  EQU   *                                                        AA202720
         BAL   14,ER4                                                   AA202730
         DC    XL1'49'             SET PROCESSING INHIBITED             AA202740
         DC    XL1'10'             FNAME.C BIT MSG CODE                 AA202750
DH$ER14  EQU   *                                                        AA202760
         BAL   14,ER3                                                   AA202770
         DC    XL1'14'             INVALID IMPER. MACRO-SEQ.            AA202780
         DC    XL1'02'             ERFLG BIT MSG CODE                   AA202790
DH$ER24  EQU   *                                                        AA202800
         BAL   14,ER3                                                   AA202810
         DC    XL1'24'             ID EXCEEDS FILE LIMITS               AA202820
         DC    XL1'40'             ERFLG BIT MSG CODE                   AA202830
DH$ER32  EQU   *                                                        AA202840
         MVI   DC$ERCD,X'00'       ILLIMINATE NO-FIND SETL KEY          AA202850
         OI    DC$ERFLG+1,X'10'    ERFLG BIT MSG CODE                   AA202860
         BC    15,DH$ERR                                                AA202870
ER3      EQU   *                                                        AA202880
         OC    DC$ERFLG(1),1(14)   SET ERFLG BIT MSG CODE               AA202890
         OI    DC$FG1,X'80'        SET INHIBIT PROCESSING BIT           AA202900
         B     ER1                                                      AA202910
ER4      EQU   *                                                        AA202920
         OI    DC$FG1,X'80'        SET INHIBIT PROCESSING BIT           AA202930
ER2      EQU   *                                                        AA202940
         OC    DC$NMC+3(1),1(14)   SET FNAME.C BIT MSG CODE             AA202950
ER1      EQU   *                                                        AA202960
         MVC   DC$ERCD(1),0(14)    SET ERCD AS SPECIFIED                AA202970
DH$ERR   EQU   *                                                        AA202980
         NI    DC$FG3,X'EF'             SET INHIIBIT UPDATE BIT         AA202990
         LM    14,12,12(13)        RESTORE                              AA203000
         L     13,DC$SAVR          USER REGISTERS                       AA203010
         SVC   60                  LINK TO ERROR PROCESSOR              AA203020
*                                                                       AA203030
         DO    (&L?AD++&L?SEQ++&L?RAN)                                  AA203040
***      MOVE AND SEARCH HANDLER SUBROUTINE, FUNC CODES  00 THRU 09     AA203050
*              REG  8  ADDR FOR KEY COMPARISON                          AA203060
*              REG  9  ADDR FOR RECORD WORK SPACE                       AA203070
*              REG 10  ADDR FOR CUR REC IN BLK                          AA203080
*              REG  11  ADDR FOR BLOCK OF DATA                          AA203090
*              REG 12  ADDR FOR RETURN                                  AA203100
*                                                                       AA203110
DH$MASH  LA    9,0(0,9)                                                 AA203120
         LA    10,0(0,10)                                               AA203130
         LA    11,0(0,11)               REGS CLEANED UP                 AA203140
         STM   11,12,DH$BKA                                             AA203150
         MVI   DH$RPLY,5                                                AA203160
         SR    12,12                                                    AA203170
         IC    12,DH$FUN                PICK UP FUNC CODE               AA203180
         LTR   10,10                                                    AA203190
         BNZ   DH$MSD                   BR IF R10 NOT ZERO              AA203200
         LR    10,11                                                    AA203210
         AH    10,DH$BHB                DATA START LOC IN R10           AA203220
         CLI   DH$FUN,X'02'                                             AA203230
         BH    DH$MSD                   BR IF FUNC ABOVE 02             AA203240
         LA    12,10(12,0)              INCR FUNC BY 10                 AA203250
DH$MSD   IC    12,DH$FTAB(12)                                           AA203260
         LA    12,DH$NEXT(12)           FORM ADDR OF FUNC ENTRANCE      AA203270
DH$RSIZ  LR    11,10                                                    AA203280
DH$LSIZ  TM    DH$COD,X'01'             TEST FOR FIXED OR VARIABLE      AA203290
         BZR   12                       BR IF FIXED                     AA203300
         MVC   DH$SPB(2),0(11)                                          AA203310
         BR    12                       BR IF VARIABLE                  AA203320
*                                                                       AA203330
***      INSTRUCTIONS USED BY EX                                        AA203340
*                                                                       AA203350
DH$CLC   CLC   0(1,11),0(8)                                             AA203360
DH$MVC   MVC   0(1,9),0(11)                                             AA203370
*                                                                       AA203380
***      CONSTANT, AND 13 BYTE TABLE OF OFFSETS                         AA203390
*                                                                       AA203400
DH$FF    DC    X'FF'                    ENTRY POINTS FOR 10+3 CODES:    AA203410
DH$FTAB  DC    YL1(DH$LSEQ-DH$NEXT)                                     AA203420
         DC    YL1(DH$LSAN-DH$NEXT)                                     AA203430
         DC    YL1(DH$NEXT-DH$NEXT)                                     AA203440
         DC    YL1(DH$LSEQ-DH$NEXT)                                     AA203450
         DC    YL1(DH$UPDT-DH$NEXT)                                     AA203460
         DC    YL1(DH$GOPT-DH$NEXT)                                     AA203470
         DC    YL1(DH$LSEQ-DH$NEXT)                                     AA203480
         DC    YL1(DH$VALD-DH$NEXT)                                     AA203490
         DC    YL1(DH$MOVE-DH$NEXT)                                     AA203500
         DC    YL1(DH$PLCE-DH$NEXT)                                     AA203510
         DC    YL1(DH$PLCE-DH$NEXT)                                     AA203520
         DC    YL1(DH$PLCE-DH$NEXT)                                     AA203530
         DC    YL1(DH$GOPT-DH$NEXT)                                     AA203540
*                                                                       AA203550
***      TWO ENTRIES, AND TAIL END OF MOVE ROUTINE                      AA203560
*                                                                       AA203570
DH$NEXT  BAL   12,DH$PROG               BASE FOR OFFSET TABLE           AA203580
DH$GOPT  SR    12,12                                                    AA203590
         TM    DH$COD,X'02'                                             AA203600
         BZ    DH$MOVE                  IF POINT, FALL INTO EXIT        AA203610
DH$ACF   IC    12,DH$ACS+3                                              AA203620
         SR    11,12                                                    AA203630
         SR    9,12                     REGS DECREMENTED AFTER MOVE     AA203640
DH$ACK   AR    9,11                                                     AA203650
         SR    9,10                     REG 9 RESTORED AFTER MOVE       AA203660
         B     DH$EXIT                                                  AA203670
*                                                                       AA203680
***      LSEQ  IS ENTRY TO ALL FUNCTION INVOLVING KEY TESTING           AA203690
*                                                                       AA203700
DH$LOOP  BAL   12,DH$PROG                                               AA203710
DH$LSEQ  AH    11,DH$KLC                START OF KEYTEST,SEARCH         AA203720
         IC    12,DH$KSZ+1               AND SEQ LOAD                   AA203730
         EX    12,DH$CLC                COMPARE TO KEY AT R8            AA203740
         BALR  12,0                                                     AA203750
         SRL   12,28                                                    AA203760
         STC   12,DH$RPLY                                               AA203770
         B     DH$EXIT                                                  AA203780
*                                                                       AA203790
***      PROGRESSION SUB, MAIN LINE CODE, AND MOVE ROUTINE              AA203800
*                                                                       AA203810
DH$VALD  CR    10,8                                                     AA203820
         BE    DH$EXIT                                                  AA203830
DH$PROG  LH    11,DH$CFB                SUB FOR PROGRESSING BY ONE REC  AA203840
         A     11,DH$BKA                                                AA203850
         AH    10,DH$SPB                                                AA203860
         AH    10,DH$RDS                REG 10 UP BY REC + DIVIDER      AA203870
         CR    10,11                                                    AA203880
         BL    DH$RSIZ                  BR IF R10 BELOW BKA + CFB       AA203890
DH$FAIL  SR    10,10                    ZERO TO R10                     AA203900
DH$EXIT  LM    11,12,DH$BKA                                             AA203910
         BNLR  12                       OUT TO USER ON ALL CC NOT LOW   AA203920
         CLI   DH$FUN,X'03'                                             AA203930
         BHR   12                       OUT TO USER OF KEYTEST          AA203940
         BE    DH$LOOP                  TO CONTINUE SEARCH              AA203950
DH$LSAN  AH    10,DH$SPB                CONTINUE LOAD                   AA203960
         AH    10,DH$RDS                                                AA203970
DH$PLCE  LR    11,9                                                     AA203980
         BAL   12,DH$LSIZ               NEW REC SIZE TO SPB             AA203990
         LR    12,10                                                    AA204000
         S     12,DH$BKA                                                AA204010
         AH    12,DH$SPB                                                AA204020
         AH    12,DH$RDS                PROPOSED CFB IN R12             AA204030
         CH    12,DH$BSZ                                                AA204040
         BH    DH$FAIL                  FAIL IF LARGER THAN BLK SIZE    AA204050
         STH   12,DH$CFB                                                AA204060
DH$UPDT  LR    11,9                     MOVE IN: DTA CUR CUR            AA204070
         LR    9,10                              11  10  9              AA204080
DH$MOVE  SR    12,12                    MOVE OUT: CUR CUR DTA           AA204090
         SH    12,DH$SPB                          11  10  9             AA204100
         BNM   DH$ACK                   OUT IF SPB NOT ABOVE ZERO       AA204110
         IC    12,DH$FF                 255 TO L.S. BYTE                AA204120
DH$ACA   AH    12,DH$ACS+2                                              AA204130
         BM    DH$ACB                   BR WHEN OVER 256 TO DO          AA204140
         LH    12,DH$SPB                                                AA204150
         BCTR  12,0                     AMOUNT FOR FRACTION SET         AA204160
DH$ACB   EX    12,DH$MVC                                                AA204170
         BNM   DH$ACF                   OUT IF FRACTION JUST DONE       AA204180
DH$ACS   LA    11,256(11,0)                                             AA204190
         LA    9,256(9,0)                                               AA204200
         B     DH$ACA                   LOOP FOR MORE                   AA204210
         ENDO                                                           AA204220
         DO    (&L?RAN**&L?SEQ)=0      ONE OR BOTH MISG                 AA204230
         DO    &L?RAN=0                RAND MISG                        AA204240
DT$READ  EQU   *                                                        AA204250
DT$WRITE EQU   *                                                        AA204260
         ENDO                                                           AA204270
         DO    &L?SEQ=0                SEQ MISG                         AA204280
DT$SETL  EQU   *                                                        AA204290
DT$GET   EQU   *                                                        AA204300
DT$PUT   EQU   *                                                        AA204310
DT$ESETL EQU   *                                                        AA204320
         ENDO                                                           AA204330
         B     DH$ER14                                                  AA204340
         DO    (&L?RAN++&L?SEQ)=0      BOTH MISG                        AA204350
         GOTO  .DT$99                                                   AA204360
         ENDO                                                           AA204370
         ENDO                                                           AA204380
* DTF LAYOUT IS AS FOLLOWINGS                                           AA204390
DT$BNRW  EQU   0                                                        AA204400
DT$TBN   EQU   0                                                        AA204410
DT$BNR   EQU    1                       CURR ADDR BUFF N (RRR)          AA204420
DT$BNB   EQU    4                                        (BB)           AA204430
DT$BNA   EQU    6                       ACTUAL ADDR BUFF N (RRR)        AA204440
         CNOP  0,4                                                      AA204450
***** RETRIEVE COMMON                                                   AA204460
         DO    &L?RAN                                                   AA204470
***** ENTRY OF RANDOM READ ROUTINE                                      AA204480
DT$READ  EQU   *                                                        AA204490
         TM    DC$DTF+1,X'01'           TEST FOR RANDOM RTRV FUNCTION   AA204500
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA204510
         MVI   DH$FG2,8                 SET PRE-COMMAND=READ            AA204520
         BAL   3,DT$IOAR                IOAR MODE                       AA204530
         B     DT$SETL1                 SEARCH RRR-BB                   AA204540
         DO    &L?UPD                                                   AA204550
***** ENTRY OF RANDOM UPDATE (WRITE) ROUTINE                            AA204560
DT$WRITE EQU   *                                                        AA204570
         TM    DC$DTF+1,X'01'           TEST FOR RANDOM RTRV FUNCTION   AA204580
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA204590
         TM    DC$FG3,X'10'             WRITE ALLOWED?                  AA204600
         BNO   DH$ER14                  NO INVALID MACRO                AA204610
         TM    DH$FG2,X'08'             READ KEY/ID LAST MACRO ISSUED?  AA204620
         BNO   DH$ER14                  NO INVALID MACRO                AA204630
         MVI   DH$FG2,4                 SET PRE-COMMAND=WRITE           AA204640
* UPDATE BUFF 'R'                                                       AA204650
         BAL   3,DT$IOAR                IOAR MODE                       AA204660
         B     DT$PUT1                  UPDATE                          AA204670
         ENDO                                                           AA204680
         ENDO                                                           AA204690
         DO    &L?SEQ                                                   AA204700
***** ENTRY OF SETL ROUTINE                                             AA204710
DT$SETL  EQU   *                                                        AA204720
         TM    DC$DTF+1,X'02'           TEST FOR SEQ RTRV FUNCTION      AA204730
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA204740
         MVI   DH$FG2,X'20'             SET PRE-COMMAND=SETL            AA204750
         MVI   DH$TBS,X'00'             CLR SEQNTL CNTRL BYTE           AA204760
         BAL   3,DT$IOAS                IOAS MODE                       AA204770
         ENDO                                                           AA204780
DT$SETL1 EQU   *                                                        AA204790
         L     11,DH$KARG                                               AA204800
         DO    &L?SEQ                                                   AA204810
         CLI   DC$FCS,X'01'        SETL ID                              AA204820
         BL    DT$BOF                   GO TO BOF PROC                  AA204830
         BE    DT$ID                    GO TO ID PROC                   AA204840
         ENDO                                                           AA204850
         DO    &L?RAN                                                   AA204860
         CLI   DC$FCS,X'11'        READ ID                              AA204870
         BE    DT$ID                    YES                             AA204880
         ENDO                                                           AA204890
         LH    3,DH$KSZ                 KEY SIZE FOR ZERO TEST          AA204900
         EX    3,DT$222                                                 AA204910
         BNZ   DT$KEY                   BR IF ARG NOT ZERO              AA204920
         DO    &L?SEQ                                                   AA204921
         CLI   DC$FCS,X'03'                                             AA204930
         BNE   DH$ER32                  IF NOT SETL GKEY, NO FIND       AA204940
         MVI   DC$FCS,X'00'                                             AA204950
         MVI   DC$REQS,X'00'            SETL GKEY CHANGED TO BOF        AA204960
         B     DT$BOF                                                   AA204970
         ENDO                                                           AA204971
         DO    (&L?SEQ=0)**(&L?RAN=1)                                   AA204972
         B     DH$ER32                  NO FIND ERROR                   AA204973
         ENDO                                                           AA204974
DT$222   EQU   *                                                        AA204980
         OC    0(0,11),0(11)            EX TEST FOR ZERO                AA204990
DT$224   EQU   *                                                        AA205000
         DC    X'000001'                                                AA205010
         DC    X'000200'                                                AA205020
*****  KEY ROUTINE                                                      AA205030
*        THIS ROUTINE FINDS                                             AA205040
*              RRR AND                                                  AA205050
*              BB                                                       AA205060
*              OF KEY IN KEYARG                                         AA205070
DT$KEY   EQU   *                                                        AA205080
         TM    DC$FG2,2                 IOA2 SPEC?                      AA205090
         BO    DT$KEY1                                                  AA205100
         ST    2,DC$BUF2                SET PCA                         AA205110
DT$KEY0  EQU   *                                                        AA205115
         XC    DT$BNA(3,4),DT$BNA(4)    CLEAR TO ZEROS                  AA205120
DT$KEY2  EQU   *                                                        AA205130
         ST    2,DC$PADDR               SAVE REGS 2 & 4                 AA205140
         ST    4,DH$RPLY                  BEFORE THE SRCH FUNCT.        AA205150
         BAL   7,DH$SRH                 SEARCH RRR INTO DH$SRCH         AA205160
         L     2,DC$PADDR               RESTORE REGS 2 & 4              AA205170
         L     4,DH$RPLY                  FOLLOWING SEARCH              AA205180
         MVC   DT$BNR(3,4),DH$SRCH      SET RRR                         AA205190
         BAL   3,DT$GBUF                READ RRR BLK                    AA205200
         MVC   DH$CFB(2),0(2)           SET CFB                         AA205210
         SR    10,10                    SEARCH FROM FIRST REC           AA205220
         MVI   DH$FUN,3                 SET FUNC AS S E/G               AA205230
         BAL   3,DT$MSRH                MASH SEARCH                     AA205240
         LA    6,5                      LOAD 5                          AA205250
         LTR   11,10                    OVF AHEAD?                      AA205260
         BZ    DT$OV2                   YES                             AA205270
         CLI   DH$RPLY,5                REPLY?                          AA205280
         BH    DT$OV21                  OVF INTER                       AA205290
         BC     8,DH$ER39                                               AA205300
         SR    10,2                     GET BB                          AA205310
         STH   10,DT$BNB(,4)            STORE BB                        AA205320
         B     DT$MAT                                                   AA205330
DT$KEY1  EQU   *                                                        AA205340
         MVC   DC$BUF2(4),DH$IOA2       SET PCA 2ND                     AA205350
         XC    DH$B2A(3),DH$B2A         CLEAR IOA2 CNTL TO ZEROS        AA205360
         B     DT$KEY0                                                  AA205370
         DO    &L?SEQ                                                   AA205380
***** BOF ROUTINE                                                       AA205390
*        THIS ROUTINE INITIATES                                         AA205400
*              CURR REC. ADR AS 1                                       AA205410
DT$BOF   EQU   *                                                        AA205420
         XC    DT$BNR(5,4),DT$BNR(4)    CLEAR                           AA205430
         OI    DH$TBS,2                  SET BYPASS OF 1ST RECORD       AA205440
         B     DT$BOF1                                                  AA205450
         ENDO                                                           AA205460
***** ID ROUTINE                                                        AA205470
*        THIS ROUTINE INITIATES                                         AA205480
*              CURR REC. ADDR AS ID                                     AA205490
DT$ID    EQU   *                                                        AA205500
         CLC   0(5,11),DT$224                                           AA205510
         BE    DH$ER24                  IF ID OF DUMMY, OUTSIDE LIMS    AA205520
         MVC   DT$BNR(5,4),0(11)        STORE POINTER                   AA205530
         NI    DT$BNB(4),X'3F'          ERASE FLAG                      AA205540
         B     DT$PPR                                                   AA205550
DT$OV2   EQU   *                                                        AA205560
         LH    11,0(,2)                 LOAD BLOCK LENGTH               AA205570
         AR    11,2                     ADD BUFF BASE                   AA205580
         SR    11,6                     SUBTRACT 5 AND GET PR ADDR      AA205590
         TM    0(11),X'80'         IF SET, THEN 80 (END OF CYL) OR      AA205600
*                                  F0 (NO OVERFLOW EXISTS.              AA205610
*                                  IF ON, GO CK OVERFLOW                AA205620
         BNO   DT$MORE                  CHAINED                         AA205630
****                                                                    AA205640
***                                                                     AA205650
**                                                                      AA205660
*  NO HIT ON SEARCH OF BLOCK - CK GKEY AND EOF ,RETURN NO FIND          AA205670
*         OR POINT TO FIRST RECORD OF NXT BLOCK                         AA205680
         TM    DC$FCS,X'03'             IF SETL GKEY GO TEST EOF        AA205690
         BNO   DH$ER32                  NO - NO FIND CONDITION          AA205700
         CLC   DT$BNR(3,4),DH$PID       RRR : PID   EOF TEST            AA205710
         BC    8,DH$ER32                EOF FOUND - SET NO FIND         AA205720
         BC    2,DH$ER39                PD RRR > PID  ILLOGICAL         AA205730
         MVI   DH$SCC,0                 SET SCC=0                       AA205740
         CLI   0(11),X'F0'              F0 POINTER ?                    AA205750
         BE    DT$BOF1                  YES                             AA205760
         MVC   DT$BNR(5,4),0(11)        NO, SET POINTER TO NEXT CYL     AA205770
         NI    DT$BNR(4),X'7F'          AND  CLEAR BIT                  AA205780
         B     DT$CR                    EXIT                            AA205790
DT$BOF1  EQU   *                                                        AA205800
         BAL   3,DT$ADV                 ADVANCE CURR RRR BY 1           AA205810
         MVI   DH$SCC,0                 SCC=0                           AA205820
         B     DT$CR                                                    AA205830
* OVF INTER                                                             AA205840
DT$OV21  EQU   *                                                        AA205850
         SR    11,6                     SUBTRACT 5 AND GET PR ADDR      AA205860
         CR    11,2                     IS POINTER  BEYOND BLOCK        AA205870
*         THIS WILL OCCUR IF FIRST KEY IS CHANGED OR INDEX IS BAD       AA205880
         BC    12,DH$ER39                                               AA205890
         TM    0(11),X'F0'              NO CHAIN?                       AA205900
         BO    DT$GTRR                  NO CHAIN                        AA205910
DT$MORE  EQU   *                                                        AA205920
****                                                                    AA205930
***                                                                     AA205940
**                                                                      AA205950
*  CHECK OF O/F RECORDS FOR EQ/HI - IF END OF STRING (MID BLOCK) RETURN AA205960
*         NO FIND FOR KEY FUNCTIONS, IF GKEY CHECK EOF - RETURN NO FIND AA205970
*         OR POINT TO NEXT PD RECORD                                    AA205980
         MVC   DT$BNR(5,4),0(11)   STORE POINTER                        AA205990
         TM    DT$BNB(4),X'80'          END OF STRING                   AA206000
         BC    8,DT$MOR1                NO - READ AGAIN                 AA206010
         CLI   DC$FCS,X'03'             SETL GKEY                       AA206020
         BC    7,DH$ER32                NO - SET NOFIND FOR KEY FUNCT.  AA206030
         TM    DT$BNB(4),X'C0'          RETURN TO NEW PD BLK            AA206040
         BC    8,DT$MOR1                NO - READ AGAIN                 AA206050
         L     9,DH$PID-1               LOAD RRR FROM PID               AA206060
         LA    9,1(0,9)                 INCR BY 1                       AA206070
         ST    9,DH$SRCH-1              STORE P1D+1 TO DH$SRCH          AA206080
         CLC   0(3,11),DH$SRCH          RRR FROM POINTER : PID+1        AA206090
         BC    8,DH$ER32                IF EQUAL SET NOFIND             AA206100
DT$MOR1  EQU   *                                                        AA206110
         NI    DT$BNB(4),X'3F'          ERASE                           AA206120
         BAL   3,DT$GBUF                READ RRR BLK                    AA206130
         LR    10,2                     GET                             AA206140
         AH    10,DT$BNB(,4)            RECORD ADDR                     AA206150
         MVI   DH$FUN,6                 SET FUNC AS TEST-KEY            AA206160
         BAL   3,DT$MSRH                MASH SEARCH                     AA206170
         CLI   DH$RPLY,5                REPLY?                          AA206180
         BH    DT$GTR                   GREATER                         AA206190
         BL    DT$MAT                   MATCHED                         AA206200
         LH    11,DH$SPB                GET                             AA206210
         AR    11,10                    POINTER ADDR                    AA206220
         B     DT$MORE                  LESS                            AA206230
DT$GTR   EQU   *                                                        AA206240
         CLI   DC$FCS,X'03'        SETLGKEY                             AA206250
         BC     7,DH$ER32                                               AA206260
* MATCHED                                                               AA206270
DT$MAT   EQU   *                                                        AA206280
         MVI   DH$SCC,4                 SET 4                           AA206290
         TM    DH$FG2,X'20'             TEST FOR SETL                   AA206300
         BC    8,DT$GET1                NO - GOTO GET1                  AA206310
         B     DH$CXT              NO SETL, EXIT W/O MOVE               AA206320
DT$GTRR  EQU   *                                                        AA206330
         SR    10,2                     GET BB                          AA206340
         STH   10,DT$BNB(,4)            STORE BB                        AA206350
         B     DT$GTR                                                   AA206360
DT$PPR   EQU   *                                                        AA206370
         MVI   DH$SCC,4                 SCC=4                           AA206380
DT$CR    EQU   *                                                        AA206390
         DO    '&RAN'='NO'                                              AA206400
         B     DT$PR                                                    AA206410
         GOTO  .DT32                                                    AA206420
         ENDO                                                           AA206430
         DO    '&SEQ'='NO'                                              AA206440
         BAL   3,DT$GBUF                GET BUFF                        AA206450
         GOTO  .DT12                                                    AA206460
         ENDO                                                           AA206470
         TM    DC$FCS,X'10'             READ OR GET                     AA206480
         BC    8,DT$PR                  NO GOTO DT$PR                   AA206490
         BAL   3,DT$GBUF                GET BUFF                        AA206500
         B     DT$GET1                                                  AA206510
.DT12    LABEL                                                          AA206520
.DT32    LABEL                                                          AA206530
         DO    &L?SEQ                                                   AA206540
***** ENTRY OF GET ROUTINE                                              AA206550
*        SEQUENTIAL ROUTINE CONTROL CODE MUST HAVE ONE OF FOLLOWING:    AA206560
*              0  MEANS TO GET FIRST RECORD IN BUFFER1 (P.D.PROC)       AA206570
*              2  MEANS TO GET NEXT RECORD IN BUFFER1 (P.D.PROC)        AA206580
*              4  MEANS TO GET P.D. RECORD OR                           AA206590
*                       TO GET OVF RECORD IN BUFFER1 (1 BUFF PROC)      AA206600
*              6  MEANS TO GET OVF RECORD IN BUFFER2 (2 BUFF PROC)      AA206610
DT$GET   EQU   *                                                        AA206620
         TM    DC$DTF+1,X'02'           TEST FOR SEQ RTRV FUNCTION      AA206630
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA206640
         MVI   DH$FG2,X'80'             SET PRE-COMMAND=GET             AA206650
         BAL   3,DT$IOAS                IOAS MODE                       AA206660
         TM    DH$TBS,4                 EOF?                            AA206670
         BC     1,DH$ER34                                               AA206680
         ENDO                                                           AA206690
DT$GET1  EQU   *                                                        AA206700
         CLI    DH$SCC,2                NEXT REC PROC?                  AA206710
         BE     DT$NXT                  YES                             AA206720
         CLI   DH$SCC,4                 REGET FROM BUFF1?               AA206730
         BE    DT$RG1                   YES                             AA206740
         DO    &L?SEQ                                                   AA206750
         CLI   DH$SCC,6                 REGET FROM BUFF 2?              AA206760
         BE    DT$RG2                   YES                             AA206770
         ENDO                                                           AA206780
***** FIRST RECORD PROC (SCC=ZERO)                                      AA206790
*        THIS ROUTINE PROCESS FIRST RECORD IN BUFFER1                   AA206800
*                 AND THE RECORD IS PRIME DATA                          AA206810
*                  DH$BSB/DH$BRB MUST HAVE VALUE OF 0002                AA206820
DT$1ST   EQU   *                                                        AA206830
         MVI   DT$BNB(4),X'00'          SET BB TO 0002                  AA206840
         MVI   DT$BNB+1(4),X'02'        SET BB TO 0002                  AA206850
         BAL   3,DT$GBUF                GET BUFF 1                      AA206860
***** NEXT RECORD PROC (SCC= TWO)                                       AA206870
*        THIS ROUTINE PROCESS 2ND,3RD...RECORD IN BUFFER1               AA206880
*                 AND THE RECORD IS PRIME DATA                          AA206890
*        DH$B1B MUST HAVE NON-ZERO                                      AA206900
DT$NXT   EQU   *                                                        AA206910
         MVI    DH$FUN,2                SET GET-NEXT-FUNCTION           AA206920
         MVC   DH$CFB(2),0(2)           SET CURR FILL BYTE              AA206930
         CLI   DH$SCC,X'02'             TEST FOR 02                     AA206940
         BC    7,DT$RG1                 GO SET REGET FUNCTION           AA206950
         B      DT$RG11                 BRANCH TO PREPARE MASH          AA206960
         DO    &L?SEQ                                                   AA206970
***** REGET OVF RECORD PROC (SCC= SIX)                                  AA206980
*        THIS ROUTINE PROCESS OVF RECORD (IN CASE OF 2 BUFFERS PROC)    AA206990
*                 IN BUFFER2                                            AA207000
*        DH$B2BMUST HAVE NON-ZERO                                       AA207010
DT$RG2   EQU   *                                                        AA207020
         BAL   3,DT$IOA2               IOA2 MODE                        AA207030
         ENDO                                                           AA207040
***** REGET PD/OVF RECORD PROC (SCC= FOUR)                              AA207050
*        THIS ROUTINE PROCESS PD RECORD (WHOSE PRE-RECORD IS OVFED)     AA207060
*                 OR OVF RECORD(IN CASE OF 1 BUFF PROC) IN BUFFER1      AA207070
DT$RG1   EQU   *                                                        AA207080
         BAL   3,DT$GBUF                GET BUFF 1                      AA207090
         MVI    DH$FUN,5                SET REGET-FUNCTION              AA207100
DT$RG11  EQU   *                                                        AA207110
         LR    10,2                     GET ADDR OF BUFF                AA207120
         LR    11,2                     GET ADDR OF BUFF                AA207130
         AH    10,DT$BNB(,4)            GET REC ADDR                    AA207140
***** MASH HANDLING                                                     AA207150
*        R-9 HAS ADDR OF WORK                                           AA207160
*        R-10 HAS ADDR OF CURR REC IN BUFF                              AA207170
*        R-11 HAS ADDR OF BUFF                                          AA207180
DT$MAS   EQU   *                                                        AA207190
         TM    DC$FG3,X'08'             IORG=YES SPEC?                  AA207200
         BC    1,DT$MAS11              YES SET POINT BIT                AA207210
         DO    &L?RAN                                                   AA207220
         TM    DH$FG2,X'08'             READ FUNCTION                   AA207230
         BC    8,DT$MAS1               NO GO LOAD R9 FROM SAVE R0       AA207240
         L     9,DH$RWA                 LOAD WORK AREA ADDR             AA207250
         BC    15,DT$MAS12              GOTO MASH LINK                  AA207260
         ENDO                                                           AA207270
DT$MAS1  EQU   *                                                        AA207280
         L     9,20(,13)                LOAD USER WORK AREA ADDR        AA207290
         BC    15,DT$MAS12             YES SKIP LOAD OF R9              AA207300
DT$MAS11 EQU   *                                                        AA207310
         OI    DH$COD,X'02'            SET POINT BIT FOR MASH           AA207320
DT$MAS12 EQU   *                        MASH LINK                       AA207330
         BAL    12,DH$MASH              MASH                            AA207340
         NI    DH$COD,X'FD'            TURN OFF POINT BIT               AA207350
         LTR    11,10                   MASH REJECTED?                  AA207360
         BZ    DT$MAS3                  IF YES, GO TO READ              AA207370
         TM    DC$FG3,X'08'            IOREG SPECIFIED ?                AA207380
         BC    8,DT$MAS2               NO - GO LOAD FNAME.H             AA207390
         LH    12,DH$IORG               GET IORG ADDR                   AA207400
         CLI   DH$IORG+1,X'48'                                          AA207410
         BE    DT$MAS13                                                 AA207420
         ST    10,0(12,13)              STORE CURR ADDR TO IORG         AA207430
         B     DT$MAS2                                                  AA207440
DT$MAS13 EQU   *                                                        AA207450
         ST    10,DC$SAVR                                               AA207460
DT$MAS2  EQU   *                                                        AA207470
         SR    10,2                     GET BB                          AA207480
         MVC   DH$NMG(3),DT$BNR(4)      SET FILENAME G                  AA207490
         STH   10,DH$NMG+3              BB                              AA207500
         DO    &L?UPD                                                   AA207510
         MVC   DH$LCC(1),DH$SCC         STORE LAST CONT CODE            AA207520
         STH   10,DH$URA                STORE UPDATE REC ADDR           AA207530
         ENDO                                                           AA207540
         AH    11,DH$SPB                GET ADDR OF CURR POINTER        AA207550
         DO    &L?RAN**&L?SEQ                                           AA207560
         TM    DH$FG2,X'08'             READ KEY/ID                     AA207570
         BO    DT$LP2                   YES                             AA207580
         ENDO                                                           AA207590
         DO    &L?SEQ=0                                                 AA207600
         B     DT$LP2                                                   AA207610
         GOTO  .DT13                                                    AA207620
         ENDO                                                           AA207630
***** SELECT NEXT CONTROL CODE                                          AA207640
*        R-11 HAS ADDR OF CURR POINTER                                  AA207650
*     *     *     *     *     *     *     *     *     *     *     *     AA207660
*        IF POINTER HAS 80 IN FIRST B OF BB AND VALUE OF BB IS SMALLER  AA207670
*        THAN 5, NEXT RECORD IS 1ST OF NEW PD BLOCK                     AA207680
*               CONTROL CODE = 0                                        AA207690
*     *     *     *     *     *     *     *     *     *     *     *     AA207700
*        IF POINTER HAS F0 IN FIRST R OF RRR, NO OVERFLOW EXISTS        AA207710
*               CONTROL CODE = 2                                        AA207720
*     *     *     *     *     *     *     *     *     *     *     *     AA207730
*        IF POINTER HAS 80 IN FIRST B OF BB AND VALUE OF BB IS NOT      AA207740
*        SMALLER THAN 5, NEXT RECORD IS IN PD, MIDBLOCK                 AA207750
*               CONTROL CODE = 4                                        AA207760
*     *     *     *     *     *     *     *     *     *     *     *     AA207770
*        IF POINTER HAS NEITHER F0 NOR 80 IN RRRBB, AND IN CASE OF      AA207780
*           1 BUFFER PROCESSING, NEXT RECORD IS IN OVERFLOW             AA207790
*               CONTROL CODE = 4                                        AA207800
*     *     *     *     *     *     *     *     *     *     *     *     AA207810
*        IF POINTER HAS NEITHER F0 NOR 80 IN RRRBB, AND IN CASE OF      AA207820
*           2 BUFFERS PROCESSING, NEXT RECORD IS IN OVERFLOW            AA207830
*               CONTROL CODE = 6                                        AA207840
*     *     *     *     *     *     *     *     *     *     *     *     AA207850
DT$SCC   EQU   *                                                        AA207860
         BAL   3,DT$IOAS                IOAS MODE                       AA207870
         TM    0(11),X'F0'              HAS CHAIN?                      AA207880
         BO     DT$SC2                  NO CHAIN, GO TO SET 2           AA207890
         TM    0(11),X'80'               IS THIS THE LAST REC. IN CYL.  AA207900
         BO    DT$SC4                     IF YES, GO SET SCC = 04       AA207910
         TM     3(11),X'C0'             CHAIN END?                      AA207920
         BO     DT$SC0                  YES,HAS C0                      AA207930
         BM     DT$SC4                  YES, HAS 80                     AA207940
         TM     DC$FG2,X'02'            2 BUFFS PROC?                   AA207950
         BNO    DT$SC4                  1 BUFF, GO TO SET 4             AA207960
DT$SC6   EQU   *                                                        AA207970
         MVI    DH$SCC,6                SET 6                           AA207980
         MVC    DH$B2R(5),0(11)         STORE CURR POINTER              AA207990
         BAL   3,DT$IOA2               IOA2 MODE                        AA208000
***** LAST PROC                                                         AA208010
*        THIS ROUTINE CHECKS UPDATE SPEC OR NOT                         AA208020
*               IF SPEC, PRE-READ BUFF                                  AA208030
*              IF IT IS SEQUENTIAL                                      AA208040
DT$LP    EQU   *                                                        AA208050
         CLC   DT$BNR(5,4),DH$PID       EOF?                            AA208060
         BE    DT$EOF                   YES                             AA208070
DT$TBOF  EQU   *                                                        AA208080
         TM    DH$TBS,2                 BOF?                            AA208090
         BO    DT$SBOF                                                  AA208100
         TM    DC$FG1,2                 UPDATE SPEC?                    AA208110
         BO    DT$LP1                   YES, EXIT                       AA208120
DT$PR    EQU   *                        GO TO PRE-READ                  AA208130
         TM    DC$FG3,X'08'        IOREG SPECIFIED?                     AA208140
         BO    DT$LP1              YES,THEN SKIP READ-AHEAD.            AA208150
         OI    DH$TBS,X'08'             SET NOWAIT BIT                  AA208160
         BAL    3,DT$GBUF               GET BUFFER                      AA208170
DT$LP1   EQU   *                                                        AA208180
         NI    DH$TBS,X'F7'             RESET                           AA208190
.DT13    LABEL                                                          AA208200
         BC    15,DT$LP2                GO TO COMMON EXIT               AA208210
DT$MAS3  EQU   *                                                        AA208220
         DO    &L?SEQ                                                   AA208230
         LH    11,0(,2)                **                               AA208240
         STH   11,DT$BNB(,4)           **                               AA208250
         CLC   DT$BNR(5,4),DH$PID      **                               AA208260
         BC     8,DH$ER34                                               AA208270
         BC     2,DH$ER24                                               AA208280
         BAL   3,DT$ADV                 ADVANCE CURR RRR BY 1           AA208290
         MVI   DH$SCC,X'00'             SET SCC TO ZERO                 AA208300
         B      DT$1ST                  BRANCH TO FIRST PROC            AA208310
         GOTO  .DT14                                                    AA208320
         ENDO                                                           AA208330
         BC    15,DH$ER39                                               AA208340
.DT14    LABEL                                                          AA208350
         DO    &L?SEQ                                                   AA208360
DT$SC0   EQU   *                                                        AA208370
         MVI   DH$SCC,0                 SET 0                           AA208380
         CLC   0(3,11),DH$PID          IS POINTER > PID                 AA208390
         BC    13,DT$SC01              NO, BYPASS OI                    AA208400
*              *   YES, THEN THIS IS EOF WITH HI RECORDS ADDED          AA208410
         OI    DH$TBS,X'04'            SET EOF BIT                      AA208420
DT$SC01  EQU   *                                                        AA208430
         LH    10,DH$BHB               SET R10 TO 0002                  AA208440
         MVC   DT$BNR(3,4),0(11)        STORE RRR                       AA208450
         B      DT$SC21                 BRANCH                          AA208460
DT$SC2   EQU   *                                                        AA208470
         MVI   DH$SCC,2                 SET 2                           AA208480
DT$SC21  EQU   *                                                        AA208490
         STH   10,DT$BNB(,4)            SET BB                          AA208500
         B      DT$LP                                                   AA208510
DT$SC4   EQU   *                                                        AA208520
         MVI   DH$SCC,4                 SET 4                           AA208530
         MVC   DT$BNR(5,4),0(11)        STORE POINTER                   AA208540
         NI    DT$BNR(4),X'7F'          CLEAR 1ST BIT OF RRR            AA208550
         NI    DT$BNB(4),X'3F'          ERASE                           AA208560
         B      DT$LP                                                   AA208570
DT$EOF   EQU   *                                                        AA208580
         OI    DH$TBS,4                 SET EOF BIT                     AA208590
         B     DT$TBOF                                                  AA208600
DT$SBOF  EQU   *                                                        AA208610
         NI    DH$TBS,X'FD'             TURN OFF BOF (BIT 6)            AA208620
         B     DT$GET1                                                  AA208630
         ENDO                                                           AA208640
         DO    &L?UPD                                                   AA208650
         DO    &L?SEQ                                                   AA208660
***** ENTRY OF PUT ROUTINE                                              AA208670
DT$PUT   EQU   *                                                        AA208680
         TM    DC$DTF+1,X'02'           TEST FOR SEQ RTRV FUNCTION      AA208690
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA208700
         TM    DC$FG3,X'10'             PUT ALLOWED?                    AA208710
         BNO   DH$ER14                  NO INVALID MACRO                AA208720
         MVI   DH$FG2,X'40'             SET PRE-COMMAND=PUT             AA208730
* UPDATE BUFF 'S'                                                       AA208740
         BAL   3,DT$IOAS                IOAS MODE                       AA208750
         ENDO                                                           AA208760
DT$PUT1  EQU   *                                                        AA208770
         TM    DC$FG1,2                 UPDATE SPEC?                    AA208780
         BC    14,DH$ER14                                               AA208790
         LH    10,DH$URA                GET UPDATE REC ADDR             AA208800
         MVI   DH$FUN,4                 SET UPDATE-FUNCTION             AA208810
         DO    &L?SEQ                                                   AA208820
         CLI   DH$LCC,6                 BUFF2 MUST BE UPDATED?          AA208830
         BE    DT$B2P                   YES, BRANCH                     AA208840
         ENDO                                                           AA208850
* COMMAN UPDATE                                                         AA208860
DT$PUT2  EQU   *                                                        AA208870
         MVC   DH$NMH(3),DT$BNA(4) SET FILENAME H                       AA208880
         MVC   DH$NMH+3(2),DH$URA                                       AA208890
         OI    DT$TBN(4),1              SET FLAG AS UPDATED             AA208900
         TM    DC$FG3,X'08'             IORG=YES SPEC?                  AA208910
         BO    DT$PUTA                  YES GO TEST FOR PUT             AA208920
         DO    &L?RAN                                                   AA208930
         DO    &L?SEQ                                                   AA208940
         TM    DH$FG2,X'04'             IS THIS A WRITE FUNCTION        AA208950
         BNO   DT$PUT3                  NO                              AA208960
         ENDO                                                           AA208970
         L     9,DH$RWA                 LOAD WA ADDR                    AA208980
         DO    &L?SEQ                                                   AA208990
         B     DT$PUT4                                                  AA209000
         ENDO                                                           AA209010
         ENDO                                                           AA209020
         DO    &L?SEQ                                                   AA209030
DT$PUT3  EQU   *                                                        AA209040
         L     9,20(,13)                LOAD USER WORK AREA ADDR        AA209050
         ENDO                                                           AA209060
DT$PUT4  EQU   *                                                        AA209070
         AR    10,2                     GET REC ADDR                    AA209080
         BAL   12,DH$MASH               MASH                            AA209090
**                                                                      AA209100
*                   IF THE CURRENT FUNCTION IS RANDOM MODE WITH SINGLE  AA209110
*                    BUFFER ALLOCATED, WRITE MUST BE ISSUED TO FREE     AA209120
*                    BUFFER FOR NEXT SEARCH FUNCTION.                   AA209130
DT$PUTA  EQU   *                                                        AA209140
         TM    DH$FG2,X'04'             IS THIS A WRITE FUNCTION        AA209150
         BNO   DT$PUT5                  NO                              AA209160
         BAL   11,DT$PBUF               UPDATE BLOCK IMMEDIATELY        AA209170
DT$PUT5  EQU   *                                                        AA209180
         B     DT$LP2                   EXIT                            AA209190
         DO    &L?SEQ                                                   AA209200
* UPDATE BUFF '2'                                                       AA209210
DT$B2P   EQU   *                                                        AA209220
         BAL   3,DT$IOA2               IOA2 MODE                        AA209230
         B     DT$PUT2                                                  AA209240
         ENDO                                                           AA209250
         ENDO                                                           AA209260
         DO    &L?SEQ                                                   AA209270
***** ENTRY OF ESETL ROUTINE                                            AA209280
DT$ESETL EQU   *                                                        AA209290
         TM    DC$DTF+1,X'02'           TEST FOR SEQ RTRV FUNCTION      AA209300
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA209310
         MVI   DC$REQS,X'86'            WAIT                            AA209320
         L     15,DC$RELOC              LOAD SAT COVER                  AA209330
         BALR  14,15                    GO TO WAIT AND RETURN           AA209340
         L     15,16(,13)               RESTORE REGS                    AA209350
         MVC   DC$REQS,DC$FCS           RESTORE FUNCTION                AA209360
         MVI   DH$FG2,X'10'             SET PRE-COMMAND=ESETL           AA209370
         BAL   3,DT$IOA2               IOA2 MODE                        AA209380
         DO    &L?UPD                                                   AA209390
         BAL   11,DT$PBUF               PUT BUFF                        AA209400
         ENDO                                                           AA209410
         XC    DT$BNR(8,4),DT$BNR(4)    CLEAR CNTRL-FORCE READ AT SETL  AA209420
         BAL   3,DT$IOAS                IOAS MODE                       AA209430
         DO    &L?UPD                                                   AA209440
         BAL   11,DT$PBUF               PUT BUFF                        AA209450
         ENDO                                                           AA209460
         XC    DT$BNR(8,4),DT$BNR(4)    CLEAR CNTRL-FORCE READ AT SETL  AA209470
         DO    &L?UPD                                                   AA209480
         ENDO                                                           AA209490
         B     DT$LP2                   EXIT                            AA209500
         ENDO                                                           AA209510
***** ADVANCE CURR RRR BY 1        ( BAL  3,DT$ADV   )                  AA209520
*              AND CLEAR BB                                             AA209530
DT$ADV   EQU   *                                                        AA209540
         XC    DT$BNB(2,4),DT$BNB(4)    CLEAR BB                        AA209550
         LA    12,1                                                     AA209560
         A     12,DT$BNRW(,4)                                           AA209570
         ST    12,DT$BNRW(,4)                                           AA209580
         BR    3                        EXIT                            AA209590
***** BUFF ADDRESS SETTING                                              AA209600
         DO    &L?SEQ                                                   AA209610
DT$IOAS  EQU   *                                                        AA209620
         L     2,DH$IOAS                                                AA209630
         LA    4,DH$TBS                                                 AA209640
         DO    &L?RAN                                                   AA209650
         SR    9,9                                                      AA209660
         IC    9,DH$BCB                                                 AA209670
         AR    4,9                                                      AA209680
         ENDO                                                           AA209690
         BR    3                                                        AA209700
DT$IOA2  EQU   *                                                        AA209710
         L     2,DH$IOA2                GET IOA2 AS CURR BUFF ADDR      AA209720
         LA    4,DH$TB2                                                 AA209730
         BR    3                                                        AA209740
         ENDO                                                           AA209750
         DO    &L?RAN                                                   AA209760
DT$IOAR  EQU   *                                                        AA209770
         L     2,DH$IOAR                                                AA209780
         LA    4,DH$TBR                                                 AA209790
         BR    3                                                        AA209800
         ENDO                                                           AA209810
***** MASH SEARCH        (  BAL   3,DT$MSRH  )                          AA209820
*        THIS ROUTINE IS INTERFACE                                      AA209830
*              TO MASH SUBROUTINE                                       AA209840
*        R10 HAS ADDR OF REC                                            AA209850
*        R2 HAS ADDR OF BUFF                                            AA209860
*        FUNCTION MUST BE SET BEFORE ENTRY                              AA209870
DT$MSRH  EQU   *                                                        AA209880
         L     8,DH$KARG                LOAD KEY ARG ADDR               AA209890
         LR    11,2                     LOAD BUFF ADDR                  AA209900
         BAL   12,DH$MASH               MASH                            AA209910
         BR    3                        EXIT                            AA209920
***** GET BUFF (S/2/R) (  BAL  3,DT$GBUF )                              AA209930
*        THIS ROUTINE PREPARES BUFFER(S/2/RAND UPDATES DISC IMAGE       AA209940
*        R2  HAS ADDR OF BUFF                                           AA209950
*        R4  HAS ADDR OF DTF                                            AA209960
DT$GBUF  EQU   *                                                        AA209970
         ST    2,DC$PADDR               SAVE REG 2                      AA209980
         TM    DC$MFLG,X'40'            WAIT REQD ?                     AA209990
         BC    8,DT$GB1                 NO   BYPASS WAITF               AA210000
         MVI   DC$REQS,X'86'       TEMP 9400  WAIT                      AA210010
         L      12,DC$PCA2              USE PCA1                        AA210020
         ST    12,DC$PUB+2         TEMP 9400                            AA210030
         L     15,DC$RELOC               LOAD SAT COVER                 AA210040
         BALR  14,15               TEMP 9400  WAIT                      AA210050
         L     15,16(13)           TEMP 9400 WAIT                       AA210060
         L     2,DC$PADDR               RESTORE REG 2                   AA210070
*        WAIT  (1)                      WAIT PRE-ISSUE                  AA210080
DT$GB1   EQU *                                                          AA210090
         CLC    DT$BNR(3,4),DT$BNA(4)   NEED TO READ ACTUALLY           AA210100
         BC    8,DT$GB2                 EXIT IF EQ - NOT NEEDED         AA210110
         DO    &L?UPD                                                   AA210120
         BAL   11,DT$PBUF               PUT BUFF                        AA210130
         ENDO                                                           AA210140
         DO    &L?SEQ                                                   AA210150
         TM    DH$TBS,8                 SAT WAIT REQUIRED               AA210160
         BNO   DT$X                     NO, SKIP                        AA210170
         NI    DC$MFLG,X'DF'            TURN WAIT OFF                   AA210180
DT$X     EQU   *                                                        AA210190
         ENDO                                                           AA210200
         MVC   DT$BNA(3,4),DT$BNR(4)    SET ACTUAL ADDR                 AA210210
         MVI   DC$REQS,X'10'            SET READ-FUNCTION               AA210220
         BAL    5,DT$SAT                GO TO SAT                       AA210230
         MVC    DC$REQS(1),DC$FCS       RESET USER FUNC CODE            AA210240
         OI    DC$MFLG,X'20'            TURN WAIT ON                    AA210250
DT$GB2   EQU   *                                                        AA210260
         BR    3                       EXIT                             AA210270
         DO    &L?UPD                                                   AA210280
***** PUT BUFF SUBROUTINE ( BAL 11,DT$PBUF   )                          AA210290
DT$PBUF  EQU   *                                                        AA210300
         TM    DT$TBN(4),X'01'          IS UPDATE REQUIRED              AA210310
         BCR   8,11                     NO, RETURN                      AA210320
         MVI   DC$REQS,X'20'            SET WRITE-FUNCTION              AA210330
         BAL    5,DT$SAT                GO TO SAT                       AA210340
         NI     DT$TBN(4),X'FE'         RESET UPDATED FLAG              AA210350
         BR    11                                                       AA210360
         ENDO                                                           AA210370
***** SAT HANDLING    (   BAL 5,DT$SAT  )                               AA210380
*        SAT INTERFACE                                                  AA210390
*               R2,3,4,5,11 ARE UNTOUCHABLE FOR SAT                     AA210400
*               R12 : PCA ADDR                                          AA210410
*               R14 : LINKAGE                                           AA210420
*               R15 : COVER                                             AA210430
DT$SAT   EQU   *                                                        AA210440
         ST    2,DH$A1                  SET BUFF ADDR TO PCA1           AA210450
         MVC    DH$PCAID+1(3),DT$BNA(4) SET READ BLK ADDR TO PCA        AA210460
         L     15,DC$RELOC               LOAD SAT COVER                 AA210470
         L      12,DC$PCA2              USE PCA1                        AA210480
         BALR   14,15                   SAT                             AA210490
         L     15,16(13)                RELOAD COVER REG                AA210500
         L     2,DC$PADDR               RESTORE REG 2                   AA210510
         BR     5                       EXIT                            AA210520
.DT$99   LABEL                                                          AA210530
         DO    &L?RAN++&L?SEQ++&L?AD                                    AA210540
         DO    &L?NX=1                                                  AA210550
         IS$SRH                                                         AA210560
         GOTO  .DL$98                                                   AA210570
         ENDO                                                           AA210580
         ENDO                                                           AA210590
DH$WAIT  EQU   *                                                        AA210600
         OI    DH$FG2,X'01'             NON-INDXED, WAITF NOT REQ.      AA210610
DH$SRH   EQU   *                                                        AA210620
         BC    15,DH$ER14                                               AA210630
.DL$98   LABEL                                                          AA210640
         DO    &L?AD=0                                                  AA210650
DH$ADD   EQU   *                   TEMP 9400   **********               AA210660
         BC    15,DH$ER14                                               AA210670
         GOTO  .DL$97                                                   AA210680
         ENDO                                                           AA210690
         IS$ADD                                                         AA210700
.DL$97   LABEL                                                          AA210710
         DO    &L?LD=1                                                  AA210720
         IS$LOAD  INDEXED=&INDX                                         AA210730
         GOTO  .DL$99                                                   AA210740
         ENDO                                                           AA210750
DH$LOAD  EQU   *                                                        AA210760
         BC    15,DH$ER14                                               AA210770
.DL$99   LABEL                                                          AA210780
         ENDO                                                           AA210790
         PRINT NOGEN                                                    AA210800
         DTFDM IS=YES                                                   AA210810
         PRINT GEN,DATA                                                 AA210820
         DROP  1,15                                                     AA210830
&SYSECT  CSECT                                                          AA210840
         END                                                            AA210850
