DYNA     TITLE 'DYNAMIC FILE ALLOCATION ROUTINE'                        00000010
*********************************************************************** 00000020
* DYNALC - J.F. Chandler - 1986 October                               * 00000030
* TSO FORTRAN-callable routine based on version from KERMSRV          * 00000040
*  e.g., CALL DYNALC(DSN,DDN,UNIT,VOL,DISP,SPACE,RC)                  * 00000050
*    or  CALL DYNALC(DSN,DDN,UNIT,VOL,DISP,SPACE,RC,BUFF)             * 00000055
*  with  DSN   60-char string of DSN + MEMBER + PASSW (blank if none) * 00000060
*        DDN   8-char string of DDNAME or FORTRAN unit number         * 00000070
*        UNIT  8-char string of device type                           * 00000080
*        VOL   6-char string of volume name                           * 00000090
*        DISP  1-byte code giving dataset disposition:                * 00000100
*              80: SHR       08: KEEP       One bit must be set       * 00000110
*              40: NEW  +    04: DELETE     in each HEX digit.        * 00000120
*              20: MOD       02: CATLG                                * 00000130
*              10: OLD       01: UNCATLG                              * 00000140
*        SPACE fullword track allocation increment                    * 00000150
*        RC    fullword returned completion (0 if ok, 1 if not)       * 00000160
*        BUFF  (optional) 512-byte buffer for returned error message. * 00000163
*              If not given, in case of error, display the message.   * 00000166
*********************************************************************** 00000170
DYNALC   CSECT                                                          00000180
         PRINT NOGEN                                                    00000190
         SAVE  (14,12),,*                                               00000200
         USING DYNALC,15                                                00000210
         CNOP  0,4                                                      00000220
         BAL   12,*+76                                                  00000230
         USING *,13                                                     00000240
         DS    18F                                                      00000250
         ST    12,8(13)                                                 00000260
         ST    13,4(12)                                                 00000270
         LR    13,12                                                    00000280
         LM    4,11,0(1)     Get arguments                     @SC88119 00000290
         TM    0(4),X'F0'                                               00000300
         BNM   EXITBAD       Must be old                                00000310
         LR    1,4           Dsname ptr                                 00000320
         LA    0,44                                                     00000330
         LA    3,TUDSN+2                                                00000340
         BAL   14,GETTU                                                 00000350
         LA    1,44(4)       Possible member name                       00000360
         LA    0,8           Max length                                 00000370
         LA    3,TUMEM+2                                                00000380
         BAL   14,GETTU                                                 00000390
         LA    1,52(4)       Possible password                          00000392
         LA    0,8           Max length                                 00000394
         LA    3,TUPASS+2                                               00000396
         BAL   14,GETTU                                                 00000398
         LR    1,5           Ddname ptr                                 00000400
         TM    0(1),X'F0'                                               00000410
         BNZ   DDCHAR        Must be char string                        00000420
         L     0,0(1)        Numeric, get value                         00000430
         CVD   0,DBLWORD                                                00000440
         OI    DBLWORD+7,15                                             00000450
         LA    1,FTXXF001                                               00000460
         UNPK  2(2,1),DBLWORD Convert to zoned                          00000470
DDCHAR   LA    0,8           Max length                                 00000480
         LA    3,TUDDN+2                                                00000490
         BAL   14,GETTU                                                 00000500
         SR    0,0                                                      00000510
         IC    0,0(8)        Get stat,disp                              00000520
         SRDL  0,4           Separate nybbles                           00000530
         SRL   1,28                                                     00000540
         STC   0,TUSTAT      Save values                                00000550
         STC   1,TUDISP                                                 00000560
         LR    1,6           Unit ptr                                   00000570
         LA    0,8           Max length                                 00000580
         LA    3,TUUNT+2                                                00000590
         BAL   14,GETTU                                                 00000600
         LR    1,7           Volume ptr                                 00000610
         LA    0,6           Max length                                 00000620
         LA    3,TUVOL+2                                                00000630
         BAL   14,GETTU                                                 00000640
         L     2,0(9)        Space value                                00000650
         STCM  2,7,TUPRIME   Use for both                               00000660
         STCM  2,7,TUSECOND                                             00000670
         LA    1,TEXTOLD                                                00000680
         MVC   0(16,1),=A(TUUNT,TUVOL,TUPASS,TUMEM)                     00000690
         LA    3,4                                                      00000700
TSTSLP   L     2,0(1)                                                   00000710
         CLI   5(2),0        Is is specified?                           00000720
         BNE   *+10          Yes, keep it                               00000730
         XC    0(4,1),0(1)   No, exclude it from list                   00000740
         LA    1,4(1)        On to next                                 00000750
         BCT   3,TSTSLP                                                 00000760
         LA    1,TEXTOLD     Determine which units to use               00000770
         TM    TUSTAT,X'04'                                             00000780
         BZ    DYNALLOC                                                 00000790
         LA    1,TEXTNEW                                                00000800
         CLI   TUMEM+5,0     Any member given?                          00000810
         BE    DYNALLOC      No, that's fine                            00000820
         LA    1,TEXTNEWM    Yes, must allocate directory               00000830
DYNALLOC ST    1,DYNTXTPP                                               00000840
         LA    1,DYNRBPTR                                               00000850
         DYNALLOC ,                                                     00000860
         LTR   15,15                                                    00000870
         BZ    EXITRC                                                   00000880
         NI    DFSWTCHS,X'9F'                                  @SC88119 00000881
         LTR   10,10         Is there a message buffer?        @SC88119 00000882
         BM    *+8           No                                @SC88119 00000883
         OI    DFSWTCHS,X'40' Yes, set flag for filling it     @SC88119 00000884
         STCM  11,7,DFBUFP+1 Pass pointer                      @SC88119 00000885
DYNFAIL  ST    15,S99RC                                                 00000890
         LA    1,DFPARMS                                                00000900
         LINK  EP=IKJEFF18                                              00000910
EXITBAD  LA    15,1                                                     00000920
EXITRC   ST    15,0(10)      Save RC                                    00000930
         L     13,4(13)                                                 00000940
         RETURN (14,12)                                                 00000950
*                                                                       00000960
* Copy string+length into text unit. R1->string, R3->length field       00000970
GETTU    LR    2,1           Save start of string                       00000980
GLLP     CLI   0(2),C' '     Find end                                   00000990
         BE    GOTLEN                                                   00001000
         LA    2,1(2)                                                   00001010
         BCT   0,GLLP                                                   00001020
GOTLEN   SR    2,1           Length of token                            00001030
         STCM  2,3,2(3)      Save in text unit                          00001040
         BZR   14            Empty string                               00001050
         BCTR  2,0           Fix for execute                            00001060
         EX    2,COPYTU                                                 00001070
         BR    14                                                       00001080
COPYTU   MVC   4(,3),0(1)    Move string to text unit                   00001090
         EJECT                                                          00001100
         DS    0F                                                       00001110
DYNRBPTR DC    X'80',AL3(DYNRB)                                         00001120
DYNRB    DC    AL1(20,S99VRBAL)                                         00001130
         DC    AL2(0,0,0)                                               00001140
DYNTXTPP DC    AL4(*-*)                                                 00001150
         DC    AL4(0,0)                                                 00001160
S99RC    DC    F'0'                                                     00001170
TEXTNEWM DC    A(TUDIR)                                                 00001180
TEXTNEW  DC    A(TUTRK,TUPRI,TUSEC,TUREL)                               00001190
TEXTOLD  DC    A(TUUNT,TUVOL,TUPASS,TUMEM)                              00001200
         DC    A(TUDDN,TUDSN,TUSTA,TUDIS),X'80',AL3(TUFRE)              00001210
*                                                                       00001220
TUDDN    DC    AL2(DALDDNAM,1)   DDNAME                                 00001230
         DS    AL2,CL8                                                  00001240
TUDSN    DC    AL2(DALDSNAM,1)   DSNAME                                 00001250
         DS    AL2,CL44                                                 00001260
TUMEM    DC    AL2(DALMEMBR,1)   Member                                 00001270
         DS    AL2,CL8                                                  00001280
TUPASS   DC    AL2(DALPASSW,1)   Password                               00001283
         DS    AL2,CL8                                                  00001286
TUDIR    DC    AL2(DALDIR,1)     Dir blks                               00001290
         DC    AL2(3),AL3(5)                                            00001300
TUDIS    DC    AL2(DALNDISP,1,1) Disp                                   00001310
TUDISP   DC    X'00'                                                    00001320
TUSTA    DC    AL2(DALSTATS,1,1) Status                                 00001330
TUSTAT   DC    X'00'                                                    00001340
TUUNT    DC    AL2(DALUNIT,1)    Unit                                   00001350
         DS    AL2,CL8                                                  00001360
TUVOL    DC    AL2(DALVLSER,1)   Volume                                 00001370
         DS    AL2,CL6                                                  00001380
TUTRK    DC    AL2(DALTRK,0)     Tracks                                 00001390
TUPRI    DC    AL2(DALPRIME,1,3) Primary                                00001400
TUPRIME  DC    AL3(*-*)                                                 00001410
TUSEC    DC    AL2(DALSECND,1,3) Secondary                              00001420
TUSECOND DC    AL3(*-*)                                                 00001430
TUREL    DC    AL2(DALRLSE,0)    Release                                00001440
TUFRE    DC    AL2(DALCLOSE,0)   FREE=CLOSE                             00001450
DFPARMS  DS    0D            DAIR fail plist                            00001460
DFS99RBP DC    A(DYNRB)      Adr of SVC 99 req blk                      00001470
DFRCP    DC    A(S99RC)      Adr of SVC 99 ret code                     00001480
DFJEFF02 DC    A(DFZEROES)   Adr of unknown writer                      00001490
DFIDP    DC    A(DFSWTCHS)   Adr of DAIRFAIL options                    00001500
DFCPPLP  DC    A(0)          Unknown CPPL address                       00001510
DFBUFP   DC    A(0)          Do not return message                      00001520
DFZEROES DC    A(0)                                                     00001530
DFSWTCHS DC    X'80',X'33'   WTP for DYNALLOC, please                   00001540
DBLWORD  DC    D'0'                                                     00001550
FTXXF001 DC    C'FTXXF001'   Place to build FORTRAN ddname              00001560
         IEFZB4D0                                                       00001570
         IEFZB4D2                                                       00001580
         END                                                            00001590
