         PROC  &P,0                                                     AA300010
AA32     NAME                           IS$ADD                          AA300020
IS$ADD   NAME                                                           AA300030
         EJECT                                                          AA300040
*****9030 ISAM ADD MODULE               THIS ROUTINE ALLOWS ADDING OF   AA300050
*              REG CONVENTIONS          RECORDS TO ALL ADDABLE FILES    AA300060
*                  15 COVER             AS DESCRIBED IN THE DTF.        AA300070
*                  14 RETURN            RECORDS MAY BE ADDED BY KEY OR  AA300080
*                  1  DTF               POINTER (TTBB)                  AA300090
         GBL   &IS$D,&IS$F                                              AA300100
         DO    '&IS$D'=''                                               AA300110
&IS$D    SET   0                                                        AA300120
DH$ADD   EQU   *                                                        AA300130
*                                                                       AA300140
         TM    DC$DTF+2,X'02'           TEST FOR ADD FUNCTION           AA300150
         BNO   DH$ER14                  IF NOT GO TO MACRO ERROR        AA300160
         MVI   DH$FG2,X'02'            SET ADD BIT IN FG2               AA300170
         NI    DH$FG1,X'F8'             CLEAR ADD CNTRL BITS            AA300180
         TM    DH$FG1,X'08'            FILE ADDS RESTRICTED             AA300190
         BC     1,DH$ER35                                               AA300200
         L     7,DH$IOA1           TEMP BUFFER CONTROL HERE             AA300210
         ST    7,DH$A1             TEMP BUFFER CONTROL HERE             AA300220
         BAL   12,DH$CKSZ                                               AA300230
DH$A03   EQU   *                                                        AA300240
         TM    DC$FG1,X'08'             FILE INDEXED                    AA300250
         BC    8,DH$A10                 NO - FIND ID IN KEYARG          AA300260
         LTR   14,14                                                    AA300270
         BNP   DH$ER18                                                  AA300280
         L     7,DH$IOA1           TEMP BUFFER CONTROL HERE             AA300290
         ST    7,DC$BUF2           TEMP BUFFER CONTROL HERE             AA300300
         BAL   7,DH$SRH                 SEARCH INDEX                    AA300310
DH$A11   EQU   *                        SEQUENTIAL ADD                  AA300320
*                   INITIALIZE FOR READ OF COCR                         AA300330
         BAL   14,DH$COMP               COMPUTE COCR FROM SEARCH INFO   AA300340
DH$A2    EQU   *                                                        AA300350
         BAL   5,DH$A20                 READ COCR & CHECK FIT           AA300360
         TM    DH$FG1,X'01'             RECORD FIT                      AA300370
         BC    8,DH$A40                                                 AA300380
         MVC   DH$PCAID+1(3),DH$SRCH    PD BLK # TO PCA2                AA300390
*********           READ PRIME DATA RECORD INTO BUFFER 1                AA300400
         BAL   11,DH$A01                                                AA300410
         L     11,DH$A1                                                 AA300420
         MVC   DH$CFB(2),0(11)          SET CFB OF BLK READ             AA300430
         TM    DC$FG1,X'08'                                             AA300440
         BZ    DH$A30                   IF NOT INDEXED, AVOID SEARCH    AA300450
         L     8,DH$LWA                                                 AA300460
         AH    8,DH$KLC                 ON KEY IN WORK SPACE            AA300470
         MVI   DH$FUN,X'03'                                             AA300480
         SR    10,10                                                    AA300490
         BAL   12,DH$MASH               KEY SEARCH OF BLOCK             AA300500
         CLI   DH$RPLY,X'05'                                            AA300510
         BL    DH$ER36                  TO ERR ON EQUAL                 AA300520
         SH    10,DH$RDS                                                AA300530
         BP    DH$A54                   IF R10 POS, A HIT WAS MADE      AA300540
         AH    10,DH$CFB                                                AA300550
         AR    10,11                    ELSE SET UP ON LAST             AA300560
DH$A54   EQU   *                                                        AA300570
         TM    0(10),X'80'              R10 IS AT POINTER OF INTEREST   AA300580
         BZ    DH$A60                   BR IF CHAIN EXISTS              AA300590
         B     DH$A33A                                                  AA300600
DH$A123  EQU   *                                                        AA300610
         LA    8,5(10)                                                  AA300620
         S     8,DH$A1                                                  AA300630
         STH   8,DH$SRCH+3              BB SET BEYOND POINTING REC      AA300640
         OI    DH$SRCH+3,X'80'                                          AA300650
         SH    8,DH$CFB                                                 AA300660
         BM    DH$A121                  BR IF NOT LAST OF BLOCK         AA300670
         SR    6,6                                                      AA300680
         STH   6,DH$BPC-2               PREP FOR DIVIDE                 AA300690
         L     7,DH$SRCH-1                                              AA300700
         LA    8,1(7)                                                   AA300710
         D     6,DH$BPC-2               REMAINDER TO COMPARE TO PDLC    AA300720
         SH    6,DH$PDLC                                                AA300730
         BNZ   DH$A123B                 BR IF NOT FINAL PRIME           AA300740
         AH    8,DH$BPC                                                 AA300750
         SH    8,DH$PDLC                SET TO NEXT CYL                 AA300760
DH$A123B EQU   *                                                        AA300770
         ST    8,DH$SRCH-1              RESULTING RRR                   AA300780
         MVI   DH$SRCH+4,X'02'          SET BB = 2                      AA300790
DH$A123A EQU   *                                                        AA300800
         MVI   DH$SRCH+3,X'C0'          CHAIN END,BEGINS AT PRIME END   AA300810
DH$A121  EQU   *                                                        AA300820
         NI    DH$SRCH,X'7F'            CLEAR TOP BIT RRR               AA300830
         MVC   0(5,10),DH$COCR          COCR TO SOURCE LINK             AA300840
         MVC   DH$NMH,DH$COCR           SET FNAME.H FOR USER            AA300850
**             INITIALIZE FOR WRITE OF SOURCE BLOCK, PCA2 HOLDS         AA300860
*               DATA ON SOURCE RECORD.                                  AA300870
         MVI   DC$REQS,X'20'            SET OUTPUT FUNCTION             AA300880
         BAL  11,DH$A01                 LINK TO ISSUE                   AA300890
**             READ OF O/F RECORD MAY NOT BE REQUIRED IF THE ADDED      AA300900
*               RECORD IS FIRST IN BLK    (R10 = POINTER ADDR)          AA300910
         TM    DH$FG1,X'02'             IS OVERFLOW READ REQUIRED       AA300920
         BC    8,DH$A14                 YES, GO READ O/F RECORD         AA300930
DH$A122  EQU   *                        RETURN FROM READ OF O/F         AA300940
         L     9,DH$LWA                 WORKAREA ADDR TO R9             AA300950
         L     11,DH$A1                 BLOCK ADDR TO R11               AA300960
         LR    10,11                    BLK ADDR + BB = CURR ADDR       AA300970
         AH    10,DH$H01                ADD BB STORED AT A24            AA300980
         MVI   DH$FUN,X'09'             PLACE FUNCTION TO PKT           AA300990
         BAL   12,DH$MASH                PUT RECORD IN O/F BUFFER       AA301000
         AH    10,DH$SPB                BUFFER ADDR + CFB = LINK ADDR   AA301010
         MVC   0(5,10),DH$SRCH          MOVE NEXT RECORD LINK FIELD     AA301020
**             SET FOR WRITE OF O/F RECORD                              AA301030
*                                                                       AA301040
         MVC   DH$COCR+3(2),DH$CFB      SET NEXT BB IN COCR             AA301050
         MVC   0(2,11),DH$CFB           SET CFB IN O/F BLOCK            AA301060
         L     7,DH$ACCR-1              ACCR RRR TO R7                  AA301070
         L     8,DH$COCR-1              OVERFLOW RRR TO R8              AA301080
         CR    7,8                      IS O/F THE SAME AS ACCR         AA301090
         BC    8,DH$A128                YES, WRITE O/F & COCR AS ONE    AA301100
         MVC   DH$PCAID,DH$COCR-1       RRR TO PCA                      AA301110
         BAL   11,DH$A01                LINK TO ISSUE                   AA301120
**             SET TO WRITE COCR RECORD                                 AA301130
         L     11,DH$A1                 BLOCK ADDR TO R11               AA301140
         MVI   0(11),X'00'              SET BLOCK LENGTH TO 0009        AA301150
         MVI   1(11),X'09'              SET BLOCK LENGTH TO 0009        AA301160
*                                                                       AA301170
DH$A128  EQU   *                                                        AA301180
         MVC   DH$PCAID,DH$ACCR-1      ADDR COCR TO PCA                 AA301190
         L     11,DH$A1                 BLOCK ADDR TO R11               AA301200
         MVC   2(2,11),DH$BHB          SET RECORD LENGTH TO (2)         AA301210
         MVC   4(5,11),DH$COCR         PUT COCR BACK IN PLACE           AA301220
         BAL  11,DH$A01                 LINK TO ISSUE                   AA301230
         AI    DH$NMO,1                                                 AA301240
*                  THIS FIELD TO BE EXPANDED TO FULL WORD               AA301250
**             RESTORE USER REGS                                        AA301260
*               AND RETURN                                              AA301270
         BC    15,DH$CXT                GO TO COMMON EXIT               AA301280
DH$A10   EQU   *                        NON-INDEXED FILE                AA301290
         L     7,DH$KARG                ADDR KEYARG TO R7               AA301300
         MVC   DH$SRCH(5),0(7)          ID TO DTF                       AA301310
         BC    15,DH$A11                RETURN IN LINE                  AA301320
******             SET REG 10 TO POINT TO THE APPRO. LINK FIELD         AA301330
DH$A30   EQU   *                                                        AA301340
         LH    10,DH$SRCH+3                                             AA301350
DH$A33   EQU   *                                                        AA301360
         A     10,DH$A1                 R10 SET ON POINTING REC         AA301370
         BAL   12,DH$RSIZ               REC SIZE TO SPB                 AA301380
         AH    10,DH$SPB                R10 NOW AT POINTER              AA301390
DH$A33A  EQU   *                                                        AA301400
         CLI   0(10),X'F0'              IF F0, POINTER MUST BE FORMED   AA301410
         BE    DH$A123                  AND NEW REC WILL END CHAIN      AA301420
         MVC   DH$SRCH(5),0(10)         POINTER TENTATIVELY ACCEPTED    AA301430
         TM    0(10),X'80'                                              AA301440
         BZ    DH$A121                  IF NOT 80, POINTER OK AS IS     AA301450
         B     DH$A123A                 IF 80, MUST SET C0              AA301460
         EJECT                                                          AA301470
**                  READ COCR AND CHECK                                 AA301480
***                  FOR FIT THIS CYLINDER                              AA301490
*                   REGISTERS 7 & 8 ARE WORK REGS                       AA301500
*                  14 INTERNAL LINKAGE                                  AA301510
DH$A20   EQU   *    READ COCR AND CHECK FIT                             AA301520
         MVC   DH$PCAID+1(3),DH$ACCR    A. OF COCR TO PCA2              AA301530
         MVI   DC$REQS,X'10'            SET INPUT OPERATION W/WAIT      AA301540
         OI    DC$MFLG,X'20'            SET WAIT BIT                    AA301550
         BAL   11,DH$A01                LINK TO ISSUE RTN               AA301560
**                  TEST OF STATUS MADE                                 AA301570
*                   AT DH$ERRS                                          AA301580
         L     11,DH$A1                 ADDR. DATA BUF TO R11           AA301590
         MVC   DH$COCR(5),4(11)         COCR TO DTF                     AA301600
DH$A24   EQU   *                                                        AA301610
         LH    8,DH$COCR+3              UNUSED BYTES TO R8 (BB/COCR)    AA301620
         LH    7,DH$BSZ                 BLKSIZE TO R7                   AA301630
         SR    7,8                      SUB 8 FROM 7= AVAIL SPACE       AA301640
*                   RECORD TO BE ADDED WILL NOT FIT                     AA301650
DH$A26   EQU   *                        WILL RECORD FIT                 AA301660
         LH    8,DH$SPB                 NO,FIXED - RECSIZE TO R8        AA301670
         LA    8,5(8)                   INCR 8 BY LINK SIZE             AA301680
         CR    7,8                      RECSIZE : UNUSED BYTES  (FIT?)  AA301690
         BC    10,DH$A22                IF EQ/HI, RECORD FITS           AA301700
         CLC   DH$ACCR(3),DH$COCR       COMP FOR COCR REC               AA301710
         BNL   DH$A27                   IF NOT BYPASS TO IOF            AA301720
         TM    DH$FG1,X'02'            IS THIS A NEW RECORD             AA301730
         BC     1,DH$ER18                                               AA301740
DH$A27   EQU   *                                                        AA301750
         L     8,DH$COCR-1              COCR BLK # TO R8                AA301760
         LA    8,1(8)                   INCR R8 BY 1       (17BITS)     AA301770
         ST    8,DH$COCR-1              STORE NEW COCR 'RRR'            AA301780
         MVC   DH$COCR+3(2),DH$BHB                                      AA301790
         OI    DH$FG1,X'02'              SET NO O/F READ REQ'D          AA301800
         CL    8,DH$ACCR-1              NEW RRR : ACCR                  AA301810
         BC 4,DH$A24                   GO TEST RECORD AGAIN             AA301820
         BC    2,DH$A23                 IF HI EXIT NO FIT               AA301830
*                                                                       AA301840
*                   LAST BLOCK IN CYL WILL BE USED                      AA301850
         MVI   DH$COCR+4,X'09'          SET BB TO '09' (COCR OFFSET)    AA301860
         BC    15,DH$A24                                                AA301870
DH$A22   EQU   *                        SET INDICATOR TO YES, RECORD    AA301880
*                  STORE BB FROM COCR FOR USE AT A122                   AA301890
         MVC   DH$H01(2),DH$COCR+3      STORE BB FROM COCR              AA301900
         OI    DH$FG1,X'01'               TO BE ADDED FITS              AA301910
         BCR   15,5                     RETURN VIA REG 5                AA301920
DH$A23   EQU   *                        SET INDICATOR TO NO FIT         AA301930
         AI    DH$NMA,1                                                 AA301940
         NI    DH$FG1,X'FC'              CLEAR BITS 6 & 7               AA301950
         BCR   15,5                     RETURN VIA REG 5                AA301960
         EJECT                                                          AA301970
***            THIS RTN SETS UP FOR USING INDEPENDENT OVERFLOW          AA301980
*               AND STEPS TO NEXT CYLINDER AS PREV BECOMES              AA301990
*               EXHAUSTED. THE FIRST CYLINDER IS USED AS IOF            AA302000
*               INITIALLY                                               AA302010
DH$A40   EQU   *                                                        AA302020
         TM    DH$FG1,X'04'             IS THIS FIRST TRY FOR IOF       AA302030
         BC    1,DH$A42                 NO, MUST INCR TO NXT CYCL       AA302040
DH$A41   EQU   *                                                        AA302050
         MVC   DH$ACCR,DH$IOF+1         RRR OF IOF TO ACCR              AA302060
         OI    DH$FG1,X'04'             SET IOF IN USE INDICATOR        AA302070
         BC    15,DH$A2                 RETURN TO READ COCR             AA302080
DH$A42   EQU   *                                                        AA302090
*                   INCR IOF TO NEXT CYLINDER                           AA302100
         L     8,DH$IOF                  RRR OF IOF TO R8               AA302110
         AH    8,DH$BPC                 ADD BLOCKS/CYL = NEW IOF        AA302120
         ST    8,DH$IOF                 NEW IOF TO DTF                  AA302130
         CL    8,DH$PMBA                IS NEW IOF > MAX IOF            AA302140
         BC    12,DH$A41               NO MOVE IOF & EXITR              AA302150
*              THIS REQUIRES SPECIAL HANDLING - RESTRICT ADDS           AA302160
         TM    DH$PFG1,X'04'                FILE EXTENDABLE             AA302170
*        BC    8,DH$A43                GO EXTEND FILE                   AA302180
         OI    DH$FG1,X'08'            RESTRICT FURTHER ADDS            AA302190
         BC    15,DH$ER41                                               AA302200
*                                                                       AA302210
**                                                                      AA302220
***                                                                     AA302230
****                                                                    AA302240
*****                                                                   AA302250
******                                                                  AA302260
***            COMPUTE COCR ADDR - THIS RTN TAKES RRR FROM SRCH,        AA302270
*               COMPUTES THE CYLINDER AND COCR ADDR - RETURNED          AA302280
*         AT DH$ACCR IN THE FORM RRR                                    AA302290
DH$COMP  EQU   *    COMPUTE COCR ADDR                                   AA302300
         SR    6,6                                                      AA302310
         STH   6,DH$BPC-2               CLR UPPER OF DIVISOR            AA302320
         L     7,DH$SRCH-1                                              AA302330
         BCTR  7,0                      DECR BLK NUMB BY 1              AA302340
         A     7,DH$BPC-2                                               AA302350
         D     6,DH$BPC-2                                               AA302360
         M     6,DH$BPC-2                                               AA302370
         ST    7,DH$ACCR-1              BLK NUMB OF COCR                AA302380
         BR    14                                                       AA302390
*                   RETURN IS THRU REG 11                               AA302400
*                   SAT COVER      REG15                                AA302410
*                   LINK THRU      REG 14                               AA302420
         DO    '&IS$F'=''                                               AA302430
&IS$F    SET   0                                                        AA302440
DH$A01   EQU   *                                                        AA302450
         L     12,DC$PCA2                                               AA302460
         BC    15,DH$A013                                               AA302470
DH$A014  EQU   *                                                        AA302480
         MVI   DC$REQS,X'14'                                            AA302490
DH$A011  EQU   *                        SET FOR PCA2                    AA302500
         L     12,DC$PCA1               R12 TO PCA1                     AA302510
DH$A013  EQU   *                        SET SAT COVER                   AA302520
         L     15,DC$RELOC               LOAD SAT COVER                 AA302530
         BALR  14,15                    LINK THROUGH R14                AA302540
         L     15,16(13)                RELOAD ISAM COVER               AA302550
         BCR   15,11                    RETURN THRU TEG 11              AA302560
         ENDO                                                           AA302570
***            SEARCH OF OVERFLOW CHAIN TO DETERMINE                    AA302580
*               SOURCE RECORD, R10 POINTS TO LINK FIELD                 AA302590
DH$A60   EQU   *                                                        AA302600
         MVC   DH$LOF(3),DH$SRCH        SAVE BLK NUMB FOR REVERT        AA302610
DH$A62   EQU   *                                                        AA302620
         LR    5,10                     SAVE PTR LOC FOR REVERT         AA302630
         MVC   DH$COF(5),0(10)          SET LOC OF OFLO RECORD          AA302640
         MVC   DH$PCAID+1(3),DH$COF                                     AA302650
         MVI   DC$REQS,X'10'                                            AA302660
         BAL   11,DH$A01                READ OFLO BLK                   AA302670
         L     8,DH$LWA                                                 AA302680
         AH    8,DH$KLC                 SET KEY LOC                     AA302690
         L     10,DH$A1                                                 AA302700
         AH    10,DH$COF+3              FOCUS R10 ON REC                AA302710
         MVI   DH$FUN,X'06'                                             AA302720
         BAL   12,DH$MASH               TEST KEY                        AA302730
         AH    10,DH$SPB                R10 ON POINTER                  AA302740
         CLI   DH$RPLY,X'05'                                            AA302750
         BL    DH$ER36                  DUPE REC ERR                    AA302760
         BH    DH$A61                   BR IF HI KEY FOUND              AA302770
         TM    3(10),X'80'                                              AA302780
         BNZ   DH$A61A                  BR IF CUR REC IS END STRING     AA302790
         MVC   DH$LOF(3),DH$COF                                         AA302800
         B     DH$A62                   LOOP AFTER RESET REVERT BLK     AA302810
DH$A61   EQU   *                                                        AA302820
         MVC   DH$PCAID+1(3),DH$LOF                                     AA302830
         BAL   11,DH$A01                READ REVERT BLK                 AA302840
         LR    10,5                     SET R10 ON POINTER              AA302850
DH$A61A  EQU   *                                                        AA302860
         MVC   DH$SRCH(5),0(10)         POINTER CONTENTS TO SRCH        AA302870
         B     DH$A121                                                  AA302880
DH$A14   EQU   *    THIS ROUTINE MUST READ THE O/F RECORD               AA302890
         MVC   DH$PCAID+1(3),DH$COCR    RRROF O0F TO PCA2               AA302900
         MVI   DC$REQS,X'10'            SET INPUT FUNCTION              AA302910
         BAL   11,DH$A01                LINK TO ISSUE                   AA302920
         MVI   DC$REQS,X'20'            SET OUTPUT FUNCTION             AA302930
         BC    15,DH$A122               RETURN TO PRIME MOD             AA302940
         ENDO                                                           AA302950
         END                                                            AA302960
