*                                                                       0000000
*  for use with Kermit-TSO only                                         0000000
*                                                                       0000000
         EJECT                                                          0000000
DYNALC   CSECT                                                          0000000
         B    14(R15)        BRANCH AROUND ID                           0000000
         DC   X'08',CL9'DYNALC'                                         0000000
         STM   14,12,12(13)                                             0000000
         CNOP  0,4                                                      0000000
         LR    12,13                                                    0000000
         BALR  13,0                                                     0000000
         BAL   13,76(13)                                                0000000
         USING *,13                                                     0000000
         DS    18F                                                      0000000
         ST    12,4(13)                                                 0000000
         ST    13,8(12)                                                 0000000
         LR    R11,R1                                                   0000000
         USING ARGADDS,R11                                              0000000
         L     R1,AIDSYS                                                0000000
         CLC   0(4,R1),=F'-1'                                           0000000
         BE    EXITOK                                                   0000000
         CLC   0(4,R1),=F'1'                                            0000000
         BE    MVS                                                      0000000
         CLC   0(4,R1),=F'2'                                            0000000
         BE    MVS                                                      0000000
         CLC   0(4,R1),=F'3'                                            0000000
         BE    CMS                                                      0000000
MVS      EQU   *                                                        0000000
GETDDNAM L     R1,ADDNAME                                               0000000
         TM    0(R1),X'80'                                              0000000
         BO    DDCHAR                                                   0000000
         L     R2,0(R1)                                                 0000000
         CVD   R2,DBLWORD                                               0000000
         UNPK  FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED              0000000
         OI    FTXXF001+3,X'F0'                                         0000000
         MVC   TUDDNAME(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT    0000000
         MVC   TUDDNLEN(2),=AL2(8)                                      0000000
         B     GETDSN                                                   0000000
DDCHAR   LA    R2,TUDDNAME                                              0000000
         LA    R3,8                                                     0000000
DDLOOP   CLI   0(R1),C' '                                               0000000
         BE    GOTDD                                                    0000000
         MVC   0(1,R2),0(R1)                                            0000000
         LA    R1,1(R1)                                                 0000000
         LA    R2,1(R2)                                                 0000000
         BCT   R3,DDLOOP                                                0000000
GOTDD    S     R2,=A(TUDDNAME)                                          0000000
         STCM  R2,B'0011',TUDDNLEN                                      0000000
GETDSN   L     R1,AMVSDSN                                               0000000
         LA    R2,TUDSNAME                                              0000000
         LA    R3,44                                                    0000000
DSLOOP   CLI   0(R1),C' '                                               0000000
         BE    GOTDS                                                    0000000
         MVC   0(1,R2),0(R1)                                            0000000
         LA    R1,1(R1)                                                 0000000
         LA    R2,1(R2)                                                 0000000
         BCT   R3,DSLOOP                                                0000000
GOTDS    S     R2,=A(TUDSNAME)                                          0000000
         STCM  R2,B'0011',TUDSNLEN                                      0000000
GETMEM    L     R1,AMEMBER       R1 --> POSSIBLE MEMBER NAME            0000000
          MVC   TUMEMBER(8),=CL8' '                                     0000000
          CLC   0(8,R1),=CL8' '  ANY MEMBER HERE?                       0000000
          BE    GETDISP          IF NOT, GO GET DISPOSITION             0000000
         LA    R2,TUMEMBER                                              0000000
         LA    R3,8              R3 = MAX LENGTH OF MEMBER              0000000
MEMLOOP  CLI   0(R1),C' '                                               0000000
         BE    GOTMEM                                                   0000000
         MVC   0(1,R2),0(R1)                                            0000000
         LA    R1,1(R1)                                                 0000000
         LA    R2,1(R2)                                                 0000000
         BCT   R3,MEMLOOP                                               0000000
GOTMEM   S     R2,=A(TUMEMBER)                                          0000000
         STCM  R2,B'0011',TUMEMLEN                                      0000000
GETDISP  L     R1,AIDISP         R1 --> STATUS PARM                     0000000
         CLC   0(4,R1),=F'0'     UNCATALOG DATASET?                     0000000
         BNE   *+12              IF NOT, CHECK FOR CATALOG              0000000
         MVI   TUDISP,X'01'      ELSE, SIGNAL UNCATALOG                 0000000
         B     GETSTAT           AND GO GET STATUS                      0000000
         CLC   0(4,R1),=F'1'                                            0000000
         BNE   *+12                                                     0000000
         MVI   TUDISP,X'02'                                             0000000
         B     GETSTAT                                                  0000000
         CLC   0(4,R1),=F'2'                                            0000000
         BNE   *+12                                                     0000000
         MVI   TUDISP,X'04'                                             0000000
         B     GETSTAT                                                  0000000
         MVI   TUDISP,X'08'     MUST BE KEEP                            0000000
GETSTAT  L     R1,AISTAT                                                0000000
         CLC   0(4,R1),=F'0'                                            0000000
         BNE   *+12                                                     0000000
         MVI   TUSTAT,X'04'                                             0000000
         B     GETINOUT                                                 0000000
         CLC   0(4,R1),=F'1'                                            0000000
         BNE   *+12                                                     0000000
         MVI   TUSTAT,X'01'                                             0000000
         B     GETINOUT                                                 0000000
         CLC   0(4,R1),=F'2'                                            0000000
         BNE   *+12                                                     0000000
         MVI   TUSTAT,X'08'                                             0000000
         B      GETINOUT                                                0000000
         MVI   TUSTAT,X'02'                                             0000000
GETINOUT L     R1,AINOUT                                                0000000
         CLC   0(4,R1),=F'0'                                            0000000
         BNE   OUT                                                      0000000
         MVI   TUINOUT,X'80'                                            0000000
         B     GETRECFM                                                 0000000
OUT      CLC   0(4,R1),=F'1'                                            0000000
         BNE   BOTH                                                     0000000
         MVI   TUINOUT,X'40'                                            0000000
         B      GETRECFM                                                0000000
BOTH     MVI    TUINOUT,X'80'+X'40' SIGNAL BOTH INPUT/OUTPUT            0000000
GETRECFM L     R1,AIRECFM                                               0000000
         CLC   0(4,R1),=F'1'                                            0000000
         BNE   *+12                                                     0000000
         MVI   TURECFM,X'80'+X'10'                                      0000000
         B     GETBLKSI                                                 0000000
         MVI   TURECFM,X'40'+X'10'+X'08' RECFM = V+B+S                  0000000
GETBLKSI L     R1,AIBLKSI                                               0000000
         L     R2,0(R1)                                                 0000000
         STCM  R2,B'0011',TUBLKSI                                       0000000
GETLRECL L     R1,AILRECL                                               0000000
         L     R2,0(R1)                                                 0000000
         STCM  R2,B'0011',TULRECL                                       0000000
GETUNIT  L     R1,ADEVICE                                               0000000
         LA    R2,TUUNIT                                                0000000
         LA    R3,8                                                     0000000
UNLOOP   CLI   0(R1),C' '                                               0000000
         BE    GOTUN                                                    0000000
         MVC   0(1,R2),0(R1)                                            0000000
         LA    R1,1(R1)                                                 0000000
         LA    R2,1(R2)                                                 0000000
         B     UNLOOP                                                   0000000
GOTUN    S     R2,=A(TUUNIT)                                            0000000
         STCM  R2,B'0011',TUUNTLEN                                      0000000
GETTRACK L     R1,AITRACK                                               0000000
         L     R2,0(R1)                                                 0000000
         STCM  R2,B'0111',TUPRIME                                       0000000
         STCM  R2,B'0111',TUSECOND                                      0000000
         MVI   TEXTOLDL,X'80'                                           0000000
         MVI   TEXTNEWL,X'80'                                           0000000
         TM    TUSTAT,X'04'                                             0000000
         BO    NEWLIST                                                  0000000
OLDLIST  CLC   TUMEMBER(8),=CL8' '                                      0000000
         BE    *+8                                                      0000000
         MVI   TEXTOLDL,X'00'                                           0000000
         MVC   DYNTXTPP(4),=A(TEXTOLD) ELSE, SET OLD TEXT UNITS         0000000
         B     DYNALLOC                                                 0000000
NEWLIST  CLC   TUMEMBER(8),=CL8' '                                      0000000
         BE    *+8                                                      0000000
         MVI   TEXTNEWL,X'00'                                           0000000
         MVC   DYNTXTPP(4),=A(TEXTNEW) SET NEW TEXT UNITS               0000000
DYNALLOC LA    R1,DYNRBPTR                                              0000000
         DYNALLOC ,                                                     0000000
         LTR   R15,R15                                                  0000000
         BZ    EXITOK                                                   0000000
DYNFAIL  ST    R15,S99RC                                                0000000
         LA    R1,DFPARMS                                               0000000
         LINK  EP=IKJEFF18                                              0000000
         LA    R15,1                                                    0000000
         B     EXITBAD                                                  0000000
         EJECT                                                          0000000
CMS      EQU   *                                                        0000000
DDNAMGET L     R1,ADDNAME                                               0000000
         TM    0(R1),X'80'                                              0000000
         BO    CHARDD                                                   0000000
         L     R2,0(R1)                                                 0000000
         CVD   R2,DBLWORD                                               0000000
         UNPK  FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED              0000000
         OI    FTXXF001+3,X'F0'                                         0000000
         MVC   PLDD(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT        0000000
         B     FILEGET                                                  0000000
CHARDD   MVC   PLDD(8),0(R1)  COPY                                      0000000
FILEGET  L     R1,ACMSFN                                                0000000
         MVC   PLFN(8),0(R1)     COPY INTO FILEDEF PLIST                0000000
         L     R1,ACMSFT                                                0000000
         MVC   PLFT(8),0(R1)     COPY INTO FILEDEF PLIST                0000000
         L     R1,ACMSFM                                                0000000
         MVC   PLFM(2),0(R1)     COPY INTO FILEDEF PLIST                0000000
         MVC   STATEFN(18),PLFN  COPY FN,FT,FM INTO STATE PLIST         0000000
STATGET  LA    R1,STATE                                                 0000000
         SVC   202                                                      0000000
         DC    AL4(*+4)                                                 0000000
         L     R1,AISTAT                                                0000000
         CLC   0(4,R1),=F'0'                                            0000000
         BNE   OLDFILE                                                  0000000
         C     R15,=F'0'                                                0000000
         BNE   RECFMGET                                                 0000000
         TPUT  ERRMSG1,ERRMSG1L                                         0000000
         LA    R15,1                                                    0000000
         B     EXITBAD                                                  0000000
OLDFILE  C     R15,=F'0'                                                0000000
         BE    SETPLIST                                                 0000000
         TPUT  ERRMSG2,ERRMSG2L                                         0000000
         LA    R15,1                                                    0000000
         B     EXITBAD                                                  0000000
RECFMGET L     R1,AIRECFM                                               0000000
         CLC   0(4,R1),=F'1'                                            0000000
         BNE   *+14                                                     0000000
         MVC   NEWRECFM(3),=C'FB '                                      0000000
         B     BLKSIGET                                                 0000000
         MVC   NEWRECFM(3),=C'VBS'                                      0000000
BLKSIGET MVC   NEWBLKSI(8),=CL8' '                                      0000000
         L     R1,AIBLKSI                                               0000000
         L     R1,0(R1)                                                 0000000
         CVD   R1,DBLWORD                                               0000000
         UNPK  NEWBLKSI(5),DBLWORD+5(3) CONVERT TO PRINTABLS            0000000
         OI    NEWBLKSI+4,X'F0'                                         0000000
LRECLGET MVC   NEWLRECL(8),=CL8' '                                      0000000
         L     R1,AILRECL                                               0000000
         L     R1,0(R1)                                                 0000000
         CVD   R1,DBLWORD                                               0000000
         UNPK  NEWLRECL(5),DBLWORD+5(3) CONVERT TO PRINTABLE            0000000
         OI    NEWLRECL+4,X'F0'                                         0000000
SETPLIST L     R1,AISTAT                                                0000000
         CLC   0(4,R1),=F'0'                                            0000000
         BE    NEWPLIST                                                 0000000
OLDPLIST MVC   PLOPT(8),=8X'FF'                                         0000000
         CLC   0(4,R1),=F'3'                                            0000000
         BNE   FILEDEF                                                  0000000
         MVC   PLOPT(8*4),OLDOPT ELSE, SET OPTION DISP=MOD              0000000
         B     FILEDEF                                                  0000000
NEWPLIST MVC   PLOPT(8*8),NEWOPT                                        0000000
FILEDEF  LA    R1,PL                                                    0000000
         ICM   R1,B'1000',=X'0D'                                        0000000
         SVC   202                                                      0000000
         DC    AL4(*+4)                                                 0000000
         LTR   R15,R15                                                  0000000
         BZ    EXITOK                                                   0000000
         LA    R15,1                                                    0000000
         B     EXITBAD                                                  0000000
         EJECT                                                          0000000
EXITOK   SR    R15,R15                                                  0000000
EXITBAD  L     R1,AIRETCD                                               0000000
         ST    R15,0(R1)                                                0000000
         L     R13,4(R13)                                               0000000
         LM    R14,R12,12(R13)                                          0000000
         BR    R14                                                      0000000
         EJECT                                                          0000000
DYNRBPTR DC   X'80',AL3(DYNRB)                                          0000000
DYNRB    DC   AL1(20,S99VRBAL)                                          0000000
         DC   AL2(0,0,0)                                                0000000
DYNTXTPP DC   AL4(*-*)                                                  0000000
         DC   AL4(0,0)                                                  0000000
S99RC    DC   F'0'                                                      0000000
TEXTOLD  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUFRE)                    0000000
TEXTOLDL DC   X'80',AL3(TUUNT),X'80',AL3(TUMEM)                         0000000
TEXTNEW  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUREC,TUBLK,TULRE,TUFRE)  0000000
         DC   A(TUUNT,TUTRK,TUPRI,TUSEC)                                0000000
TEXTNEWL DC   X'80',AL3(TUREL),A(TUMEM),X'80',AL3(TUDIR)                0000000
TUDDN    DC   AL2(DALDDNAM,1)    DDNAME                                 0000000
TUDDNLEN DC   AL2(*-*)                                                  0000000
TUDDNAME DC   CL8' '                                                    0000000
TUDSN    DC   AL2(DALDSNAM,1)    DSNAME                                 0000000
TUDSNLEN DC   AL2(*-*)                                                  0000000
TUDSNAME DC   CL44' '                                                   0000000
TUMEM    DC    AL2(DALMEMBR,1) MEMBER                                   0000000
TUMEMLEN DC    AL2(0)                                                   0000000
TUMEMBER DC    CL8' '                                                   0000000
TUDIR    DC    AL2(DALDIR,1,3)  DIR BLKS                                0000000
TUDIRECT DC    AL3(5)                                                   0000000
TUDIS    DC   AL2(DALNDISP,1,1)  DISP                                   0000000
TUDISP   DC   X'00'                                                     0000000
TUSTA    DC   AL2(DALSTATS,1,1)  STATUS                                 0000000
TUSTAT   DC   X'00'                                                     0000000
TUINO    DC    AL2(DALINOUT,1,1) INPUT/OUTPUT                           0000000
TUINOUT  DC    X'00'                                                    0000000
TUREC    DC   AL2(DALRECFM,1,1)  RECFM                                  0000000
TURECFM  DC   X'00'                                                     0000000
TUBLK    DC   AL2(DALBLKSZ,1,2)  BLKSIZE                                0000000
TUBLKSI  DC   AL2(*-*)                                                  0000000
TULRE    DC   AL2(DALLRECL,1,2)  LRECL                                  0000000
TULRECL  DC   AL2(*-*)                                                  0000000
TUUNT    DC   AL2(DALUNIT,1)     UNIT                                   0000000
TUUNTLEN DC   AL2(*-*)                                                  0000000
TUUNIT   DC   CL8' '                                                    0000000
TUTRK    DC   AL2(DALTRK,0)      TRACKS                                 0000000
TUPRI    DC   AL2(DALPRIME,1,3)  PRIMARY                                0000000
TUPRIME  DC   AL3(*-*)                                                  0000000
TUSEC    DC   AL2(DALSECND,1,3)  SECONDARY                              0000000
TUSECOND DC   AL3(*-*)                                                  0000000
TUREL    DC   AL2(DALRLSE,0)     RELEASE                                0000000
TUFRE    DC   AL2(DALCLOSE,0)    FREE=CLOSE                             0000000
DFPARMS  DS   0D                 DAIR FAIL PLIST                        0000000
DFS99RBP DC   A(DYNRB)           ADDRESS OF SVC 99 REQ BLK              0000000
DFRCP    DC   A(S99RC)           ADDRESS OF SVC 99 RET CODE             0000000
DFJEFF02 DC   A(DFZEROES)        ADDR OF UNKNOWN WRITER                 0000000
DFIDP    DC   A(DFSWTCHS)        ADDR OF DAIRFAIL OPTIONS               0000000
DFCPPLP  DC   A(0)               UNKNOWN CPPL ADDRESS                   0000000
DFBUFP   DC   A(0)               DO NOT RETURN MESSAGE                  0000000
DFZEROES DC   A(0)                                                      0000000
DFSWTCHS DC   X'80',X'33'        WTP FOR DYNALLOC, PLEASE               0000000
         EJECT                                                          0000000
STATE    DC   CL8'STATE'         PLIST FOR CMS STATE COMMAND            0000000
STATEFN  DC   CL8' '             FILENAME                               0000000
STATEFT  DC   CL8' '             FILETYPE                               0000000
STATEFM  DC   CL8' '             FILEMODE                               0000000
STATEFEN DC   8X'FF'             FENCE                                  0000000
PL       DC    CL8'FILEDEF'                                             0000000
PLDD     DC    CL8' '                                                   0000000
PLDK     DC    CL8'DISK'                                                0000000
PLFN     DC    CL8' '                                                   0000000
PLFT     DC    CL8' '                                                   0000000
PLFM     DC    CL8' '                                                   0000000
PLOPT    DC    CL8'('                                                   0000000
         DC    8CL8' '                                                  0000000
NEWOPT   DC    CL8'('                                                   0000000
         DC    CL8'RECFM'                                               0000000
NEWRECFM DC    CL8' '                                                   0000000
         DC    CL8'LRECL'                                               0000000
NEWLRECL DC    CL8' '                                                   0000000
         DC    CL8'BLKSIZE'                                             0000000
NEWBLKSI DC    CL8' '                                                   0000000
         DC    8X'FF'                                                   0000000
OLDOPT  DC    CL8'('                                                    0000000
        DC    CL8'DISP'                                                 0000000
        DC    CL8'MOD'                                                  0000000
        DC    8X'FF'                                                    0000000
         EJECT                                                          0000000
ERRMSG1  DC    C'REQUEST FOR NEW FILE, BUT FILE EXISTS ALREADY.'        0000000
ERRMSG1L EQU   *-ERRMSG1                                                0000000
ERRMSG2  DC    C'REQUEST FOR OLD FILE, BUT FILE IS NOT FOUND.'          0000000
ERRMSG2L EQU   *-ERRMSG2                                                0000000
DBLWORD  DC    D'0'              NICE DOUBLEWORD                        0000000
FTXXF001 DC    C'FTXXF001'       PLACE TO BUILD FORTRAN DDNAME          0000000
ARGADDS  DSECT                                                          0000000
AIDSYS   DS   A                                                         0000000
ADDNAME  DS   A                                                         0000000
AMVSDSN  DS   A                                                         0000000
AMEMBER  DS   A                                                         0000000
ACMSFN   DS   A                                                         0000000
ACMSFT   DS   A                                                         0000000
ACMSFM   DS   A                                                         0000000
AISTAT   DS   A                                                         0000000
AIDISP   DS   A                                                         0000000
AINOUT   DS   A                                                         0000000
AIRECFM  DS   A                                                         0000000
AIBLKSI  DS   A                                                         0000000
AILRECL  DS   A                                                         0000000
ADEVICE  DS   A                                                         0000000
AITRACK  DS   A                                                         0000000
AIRETCD  DS   A                                                         0000000
         PRINT NOGEN                                                    0000000
         IEFZB4D0                                                       0000000
         IEFZB4D2                                                       0000000
R0  EQU  0                                                              0000000
R1  EQU  1                                                              0000000
R2  EQU  2                                                              0000000
R3  EQU  3                                                              0000000
R4  EQU  4                                                              0000000
R5  EQU  5                                                              0000000
R6  EQU  6                                                              0000000
R7  EQU  7                                                              0000000
R8  EQU  8                                                              0000000
R9  EQU  9                                                              0000000
R10 EQU  10                                                             0000000
R11 EQU  11                                                             0000000
R12 EQU  12                                                             0000000
R13 EQU  13                                                             0000000
R14 EQU  14                                                             0000000
R15 EQU  15                                                             0000000
         END                                                            0000000
