home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibm370 / iktdyn.asm < prev    next >
Assembly Source File  |  2020-01-01  |  14KB  |  174 lines
  1. DYNA     TITLE 'DYNAMIC FILE ALLOCATION ROUTINE'                        00000010
  2. *********************************************************************** 00000020
  3. * DYNALC - J.F. Chandler - 1986 October                               * 00000030
  4. * TSO FORTRAN-callable routine based on version from KERMSRV          * 00000040
  5. *  e.g., CALL DYNALC(DSN,DDN,UNIT,VOL,DISP,SPACE,RC)                  * 00000050
  6. *    or  CALL DYNALC(DSN,DDN,UNIT,VOL,DISP,SPACE,RC,BUFF)             * 00000055
  7. *  with  DSN   60-char string of DSN + MEMBER + PASSW (blank if none) * 00000060
  8. *        DDN   8-char string of DDNAME or FORTRAN unit number         * 00000070
  9. *        UNIT  8-char string of device type                           * 00000080
  10. *        VOL   6-char string of volume name                           * 00000090
  11. *        DISP  1-byte code giving dataset disposition:                * 00000100
  12. *              80: SHR       08: KEEP       One bit must be set       * 00000110
  13. *              40: NEW  +    04: DELETE     in each HEX digit.        * 00000120
  14. *              20: MOD       02: CATLG                                * 00000130
  15. *              10: OLD       01: UNCATLG                              * 00000140
  16. *        SPACE fullword track allocation increment                    * 00000150
  17. *        RC    fullword returned completion (0 if ok, 1 if not)       * 00000160
  18. *        BUFF  (optional) 512-byte buffer for returned error message. * 00000163
  19. *              If not given, in case of error, display the message.   * 00000166
  20. *********************************************************************** 00000170
  21. DYNALC   CSECT                                                          00000180
  22.          PRINT NOGEN                                                    00000190
  23.          SAVE  (14,12),,*                                               00000200
  24.          USING DYNALC,15                                                00000210
  25.          CNOP  0,4                                                      00000220
  26.          BAL   12,*+76                                                  00000230
  27.          USING *,13                                                     00000240
  28.          DS    18F                                                      00000250
  29.          ST    12,8(13)                                                 00000260
  30.          ST    13,4(12)                                                 00000270
  31.          LR    13,12                                                    00000280
  32.          LM    4,11,0(1)     Get arguments                     @SC88119 00000290
  33.          TM    0(4),X'F0'                                               00000300
  34.          BNM   EXITBAD       Must be old                                00000310
  35.          LR    1,4           Dsname ptr                                 00000320
  36.          LA    0,44                                                     00000330
  37.          LA    3,TUDSN+2                                                00000340
  38.          BAL   14,GETTU                                                 00000350
  39.          LA    1,44(4)       Possible member name                       00000360
  40.          LA    0,8           Max length                                 00000370
  41.          LA    3,TUMEM+2                                                00000380
  42.          BAL   14,GETTU                                                 00000390
  43.          LA    1,52(4)       Possible password                          00000392
  44.          LA    0,8           Max length                                 00000394
  45.          LA    3,TUPASS+2                                               00000396
  46.          BAL   14,GETTU                                                 00000398
  47.          LR    1,5           Ddname ptr                                 00000400
  48.          TM    0(1),X'F0'                                               00000410
  49.          BNZ   DDCHAR        Must be char string                        00000420
  50.          L     0,0(1)        Numeric, get value                         00000430
  51.          CVD   0,DBLWORD                                                00000440
  52.          OI    DBLWORD+7,15                                             00000450
  53.          LA    1,FTXXF001                                               00000460
  54.          UNPK  2(2,1),DBLWORD Convert to zoned                          00000470
  55. DDCHAR   LA    0,8           Max length                                 00000480
  56.          LA    3,TUDDN+2                                                00000490
  57.          BAL   14,GETTU                                                 00000500
  58.          SR    0,0                                                      00000510
  59.          IC    0,0(8)        Get stat,disp                              00000520
  60.          SRDL  0,4           Separate nybbles                           00000530
  61.          SRL   1,28                                                     00000540
  62.          STC   0,TUSTAT      Save values                                00000550
  63.          STC   1,TUDISP                                                 00000560
  64.          LR    1,6           Unit ptr                                   00000570
  65.          LA    0,8           Max length                                 00000580
  66.          LA    3,TUUNT+2                                                00000590
  67.          BAL   14,GETTU                                                 00000600
  68.          LR    1,7           Volume ptr                                 00000610
  69.          LA    0,6           Max length                                 00000620
  70.          LA    3,TUVOL+2                                                00000630
  71.          BAL   14,GETTU                                                 00000640
  72.          L     2,0(9)        Space value                                00000650
  73.          STCM  2,7,TUPRIME   Use for both                               00000660
  74.          STCM  2,7,TUSECOND                                             00000670
  75.          LA    1,TEXTOLD                                                00000680
  76.          MVC   0(16,1),=A(TUUNT,TUVOL,TUPASS,TUMEM)                     00000690
  77.          LA    3,4                                                      00000700
  78. TSTSLP   L     2,0(1)                                                   00000710
  79.          CLI   5(2),0        Is is specified?                           00000720
  80.          BNE   *+10          Yes, keep it                               00000730
  81.          XC    0(4,1),0(1)   No, exclude it from list                   00000740
  82.          LA    1,4(1)        On to next                                 00000750
  83.          BCT   3,TSTSLP                                                 00000760
  84.          LA    1,TEXTOLD     Determine which units to use               00000770
  85.          TM    TUSTAT,X'04'                                             00000780
  86.          BZ    DYNALLOC                                                 00000790
  87.          LA    1,TEXTNEW                                                00000800
  88.          CLI   TUMEM+5,0     Any member given?                          00000810
  89.          BE    DYNALLOC      No, that's fine                            00000820
  90.          LA    1,TEXTNEWM    Yes, must allocate directory               00000830
  91. DYNALLOC ST    1,DYNTXTPP                                               00000840
  92.          LA    1,DYNRBPTR                                               00000850
  93.          DYNALLOC ,                                                     00000860
  94.          LTR   15,15                                                    00000870
  95.          BZ    EXITRC                                                   00000880
  96.          NI    DFSWTCHS,X'9F'                                  @SC88119 00000881
  97.          LTR   10,10         Is there a message buffer?        @SC88119 00000882
  98.          BM    *+8           No                                @SC88119 00000883
  99.          OI    DFSWTCHS,X'40' Yes, set flag for filling it     @SC88119 00000884
  100.          STCM  11,7,DFBUFP+1 Pass pointer                      @SC88119 00000885
  101. DYNFAIL  ST    15,S99RC                                                 00000890
  102.          LA    1,DFPARMS                                                00000900
  103.          LINK  EP=IKJEFF18                                              00000910
  104. EXITBAD  LA    15,1                                                     00000920
  105. EXITRC   ST    15,0(10)      Save RC                                    00000930
  106.          L     13,4(13)                                                 00000940
  107.          RETURN (14,12)                                                 00000950
  108. *                                                                       00000960
  109. * Copy string+length into text unit. R1->string, R3->length field       00000970
  110. GETTU    LR    2,1           Save start of string                       00000980
  111. GLLP     CLI   0(2),C' '     Find end                                   00000990
  112.          BE    GOTLEN                                                   00001000
  113.          LA    2,1(2)                                                   00001010
  114.          BCT   0,GLLP                                                   00001020
  115. GOTLEN   SR    2,1           Length of token                            00001030
  116.          STCM  2,3,2(3)      Save in text unit                          00001040
  117.          BZR   14            Empty string                               00001050
  118.          BCTR  2,0           Fix for execute                            00001060
  119.          EX    2,COPYTU                                                 00001070
  120.          BR    14                                                       00001080
  121. COPYTU   MVC   4(,3),0(1)    Move string to text unit                   00001090
  122.          EJECT                                                          00001100
  123.          DS    0F                                                       00001110
  124. DYNRBPTR DC    X'80',AL3(DYNRB)                                         00001120
  125. DYNRB    DC    AL1(20,S99VRBAL)                                         00001130
  126.          DC    AL2(0,0,0)                                               00001140
  127. DYNTXTPP DC    AL4(*-*)                                                 00001150
  128.          DC    AL4(0,0)                                                 00001160
  129. S99RC    DC    F'0'                                                     00001170
  130. TEXTNEWM DC    A(TUDIR)                                                 00001180
  131. TEXTNEW  DC    A(TUTRK,TUPRI,TUSEC,TUREL)                               00001190
  132. TEXTOLD  DC    A(TUUNT,TUVOL,TUPASS,TUMEM)                              00001200
  133.          DC    A(TUDDN,TUDSN,TUSTA,TUDIS),X'80',AL3(TUFRE)              00001210
  134. *                                                                       00001220
  135. TUDDN    DC    AL2(DALDDNAM,1)   DDNAME                                 00001230
  136.          DS    AL2,CL8                                                  00001240
  137. TUDSN    DC    AL2(DALDSNAM,1)   DSNAME                                 00001250
  138.          DS    AL2,CL44                                                 00001260
  139. TUMEM    DC    AL2(DALMEMBR,1)   Member                                 00001270
  140.          DS    AL2,CL8                                                  00001280
  141. TUPASS   DC    AL2(DALPASSW,1)   Password                               00001283
  142.          DS    AL2,CL8                                                  00001286
  143. TUDIR    DC    AL2(DALDIR,1)     Dir blks                               00001290
  144.          DC    AL2(3),AL3(5)                                            00001300
  145. TUDIS    DC    AL2(DALNDISP,1,1) Disp                                   00001310
  146. TUDISP   DC    X'00'                                                    00001320
  147. TUSTA    DC    AL2(DALSTATS,1,1) Status                                 00001330
  148. TUSTAT   DC    X'00'                                                    00001340
  149. TUUNT    DC    AL2(DALUNIT,1)    Unit                                   00001350
  150.          DS    AL2,CL8                                                  00001360
  151. TUVOL    DC    AL2(DALVLSER,1)   Volume                                 00001370
  152.          DS    AL2,CL6                                                  00001380
  153. TUTRK    DC    AL2(DALTRK,0)     Tracks                                 00001390
  154. TUPRI    DC    AL2(DALPRIME,1,3) Primary                                00001400
  155. TUPRIME  DC    AL3(*-*)                                                 00001410
  156. TUSEC    DC    AL2(DALSECND,1,3) Secondary                              00001420
  157. TUSECOND DC    AL3(*-*)                                                 00001430
  158. TUREL    DC    AL2(DALRLSE,0)    Release                                00001440
  159. TUFRE    DC    AL2(DALCLOSE,0)   FREE=CLOSE                             00001450
  160. DFPARMS  DS    0D            DAIR fail plist                            00001460
  161. DFS99RBP DC    A(DYNRB)      Adr of SVC 99 req blk                      00001470
  162. DFRCP    DC    A(S99RC)      Adr of SVC 99 ret code                     00001480
  163. DFJEFF02 DC    A(DFZEROES)   Adr of unknown writer                      00001490
  164. DFIDP    DC    A(DFSWTCHS)   Adr of DAIRFAIL options                    00001500
  165. DFCPPLP  DC    A(0)          Unknown CPPL address                       00001510
  166. DFBUFP   DC    A(0)          Do not return message                      00001520
  167. DFZEROES DC    A(0)                                                     00001530
  168. DFSWTCHS DC    X'80',X'33'   WTP for DYNALLOC, please                   00001540
  169. DBLWORD  DC    D'0'                                                     00001550
  170. FTXXF001 DC    C'FTXXF001'   Place to build FORTRAN ddname              00001560
  171.          IEFZB4D0                                                       00001570
  172.          IEFZB4D2                                                       00001580
  173.          END                                                            00001590
  174.