home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / guts / guts.dyn < prev    next >
Text File  |  2020-01-01  |  30KB  |  364 lines
  1.  *                                                                       00000010
  2.  *  for use with Kermit-TSO and Kermit-GUTS only                         00000020
  3.  *                                                                       00000030
  4.           EJECT                                                          00000040
  5.  DYNALC   CSECT                                                          00000050
  6.           B    14(R15)        BRANCH AROUND ID                           00000060
  7.           DC   X'08',CL9'DYNALC'                                         00000070
  8.           STM   14,12,12(13)                                             00000080
  9.           CNOP  0,4                                                      00000090
  10.           LR    12,13                                                    00000100
  11.           BALR  13,0                                                     00000110
  12.           BAL   13,76(13)                                                00000120
  13.           USING *,13                                                     00000130
  14.           DS    18F                                                      00000140
  15.           ST    12,4(13)                                                 00000150
  16.           ST    13,8(12)                                                 00000160
  17.           LR    R11,R1                                                   00000170
  18.           USING ARGADDS,R11                                              00000180
  19.           L     R1,AIDSYS                                                00000190
  20.           CLC   0(4,R1),=F'-1'                                           00000200
  21.           BE    EXITOK                                                   00000210
  22.           CLC   0(4,R1),=F'1'                                            00000220
  23.           BE    MVS                                                      00000230
  24.           CLC   0(4,R1),=F'2'                                            00000240
  25.           BE    MVS                                                      00000250
  26.           CLC   0(4,R1),=F'3'                                            00000260
  27.           BE    CMS                                                      00000270
  28.  MVS      EQU   *                                                        00000280
  29.  GETDDNAM L     R1,ADDNAME                                               00000290
  30.           TM    0(R1),X'80'                                              00000300
  31.           BO    DDCHAR                                                   00000310
  32.           L     R2,0(R1)                                                 00000320
  33.           CVD   R2,DBLWORD                                               00000330
  34.           UNPK  FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED              00000340
  35.           OI    FTXXF001+3,X'F0'                                         00000350
  36.           MVC   TUDDNAME(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT    00000360
  37.           MVC   TUDDNLEN(2),=AL2(8)                                      00000370
  38.           B     GETDSN                                                   00000380
  39.  DDCHAR   LA    R2,TUDDNAME                                              00000390
  40.           LA    R3,8                                                     00000400
  41.  DDLOOP   CLI   0(R1),C' '                                               00000410
  42.           BE    GOTDD                                                    00000420
  43.           MVC   0(1,R2),0(R1)                                            00000430
  44.           LA    R1,1(R1)                                                 00000440
  45.           LA    R2,1(R2)                                                 00000450
  46.           BCT   R3,DDLOOP                                                00000460
  47.  GOTDD    S     R2,=A(TUDDNAME)                                          00000470
  48.           STCM  R2,B'0011',TUDDNLEN                                      00000480
  49.  GETDSN   L     R1,AMVSDSN                                               00000490
  50.           LA    R2,TUDSNAME                                              00000500
  51.           LA    R3,44                                                    00000510
  52.  DSLOOP   CLI   0(R1),C' '                                               00000520
  53.           BE    GOTDS                                                    00000530
  54.           MVC   0(1,R2),0(R1)                                            00000540
  55.           LA    R1,1(R1)                                                 00000550
  56.           LA    R2,1(R2)                                                 00000560
  57.           BCT   R3,DSLOOP                                                00000570
  58.  GOTDS    S     R2,=A(TUDSNAME)                                          00000580
  59.           STCM  R2,B'0011',TUDSNLEN                                      00000590
  60.  GETMEM    L     R1,AMEMBER       R1 --> POSSIBLE MEMBER NAME            00000600
  61.            MVC   TUMEMBER(8),=CL8' '                                     00000610
  62.            CLC   0(8,R1),=CL8' '  ANY MEMBER HERE?                       00000620
  63.            BE    GETDISP          IF NOT, GO GET DISPOSITION             00000630
  64.           LA    R2,TUMEMBER                                              00000640
  65.           LA    R3,8              R3 = MAX LENGTH OF MEMBER              00000650
  66.  MEMLOOP  CLI   0(R1),C' '                                               00000660
  67.           BE    GOTMEM                                                   00000670
  68.           MVC   0(1,R2),0(R1)                                            00000680
  69.           LA    R1,1(R1)                                                 00000690
  70.           LA    R2,1(R2)                                                 00000700
  71.           BCT   R3,MEMLOOP                                               00000710
  72.  GOTMEM   S     R2,=A(TUMEMBER)                                          00000720
  73.           STCM  R2,B'0011',TUMEMLEN                                      00000730
  74.  GETDISP  L     R1,AIDISP         R1 --> STATUS PARM                     00000740
  75.           CLC   0(4,R1),=F'0'     UNCATALOG DATASET?                     00000750
  76.           BNE   *+12              IF NOT, CHECK FOR CATALOG              00000760
  77.           MVI   TUDISP,X'01'      ELSE, SIGNAL UNCATALOG                 00000770
  78.           B     GETSTAT           AND GO GET STATUS                      00000780
  79.           CLC   0(4,R1),=F'1'                                            00000790
  80.           BNE   *+12                                                     00000800
  81.           MVI   TUDISP,X'02'                                             00000810
  82.           B     GETSTAT                                                  00000820
  83.           CLC   0(4,R1),=F'2'                                            00000830
  84.           BNE   *+12                                                     00000840
  85.           MVI   TUDISP,X'04'                                             00000850
  86.           B     GETSTAT                                                  00000860
  87.           MVI   TUDISP,X'08'     MUST BE KEEP                            00000870
  88.  GETSTAT  L     R1,AISTAT                                                00000880
  89.           CLC   0(4,R1),=F'0'                                            00000890
  90.           BNE   *+12                                                     00000900
  91.           MVI   TUSTAT,X'04'                                             00000910
  92.           B     GETINOUT                                                 00000920
  93.           CLC   0(4,R1),=F'1'                                            00000930
  94.           BNE   *+12                                                     00000940
  95.           MVI   TUSTAT,X'01'                                             00000950
  96.           B     GETINOUT                                                 00000960
  97.           CLC   0(4,R1),=F'2'                                            00000970
  98.           BNE   *+12                                                     00000980
  99.           MVI   TUSTAT,X'08'                                             00000990
  100.           B      GETINOUT                                                00001000
  101.           MVI   TUSTAT,X'02'                                             00001010
  102.  GETINOUT L     R1,AINOUT                                                00001020
  103.           CLC   0(4,R1),=F'0'                                            00001030
  104.           BNE   OUT                                                      00001040
  105.           MVI   TUINOUT,X'80'                                            00001050
  106.           B     GETRECFM                                                 00001060
  107.  OUT      CLC   0(4,R1),=F'1'                                            00001070
  108.           BNE   BOTH                                                     00001080
  109.           MVI   TUINOUT,X'40'                                            00001090
  110.           B      GETRECFM                                                00001100
  111.  BOTH     MVI    TUINOUT,X'80'+X'40' SIGNAL BOTH INPUT/OUTPUT            00001110
  112.  GETRECFM L     R1,AIRECFM                                               00001120
  113.           CLC   0(4,R1),=F'1'                                            00001130
  114.           BNE   *+12                                                     00001140
  115.           MVI   TURECFM,X'80'+X'10'                                      00001150
  116.           B     GETBLKSI                                                 00001160
  117.           MVI   TURECFM,X'40'+X'10'+X'08' RECFM = V+B+S                  00001170
  118.  GETBLKSI L     R1,AIBLKSI                                               00001180
  119.           L     R2,0(R1)                                                 00001190
  120.           STCM  R2,B'0011',TUBLKSI                                       00001200
  121.  GETLRECL L     R1,AILRECL                                               00001210
  122.           L     R2,0(R1)                                                 00001220
  123.           STCM  R2,B'0011',TULRECL                                       00001230
  124.  GETUNIT  L     R1,ADEVICE                                               00001240
  125.           LA    R2,TUUNIT                                                00001250
  126.           LA    R3,8                                                     00001260
  127.  UNLOOP   CLI   0(R1),C' '                                               00001270
  128.           BE    GOTUN                                                    00001280
  129.           MVC   0(1,R2),0(R1)                                            00001290
  130.           LA    R1,1(R1)                                                 00001300
  131.           LA    R2,1(R2)                                                 00001310
  132.           B     UNLOOP                                                   00001320
  133.  GOTUN    S     R2,=A(TUUNIT)                                            00001330
  134.           STCM  R2,B'0011',TUUNTLEN                                      00001340
  135.  GETTRACK L     R1,AITRACK                                               00001350
  136.           L     R2,0(R1)                                                 00001360
  137.           STCM  R2,B'0111',TUPRIME                                       00001370
  138.           STCM  R2,B'0111',TUSECOND                                      00001380
  139.           MVI   TEXTOLDL,X'80'                                           00001390
  140.           MVI   TEXTNEWL,X'80'                                           00001400
  141.           TM    TUSTAT,X'04'                                             00001410
  142.           BO    NEWLIST                                                  00001420
  143.  OLDLIST  CLC   TUMEMBER(8),=CL8' '                                      00001430
  144.           BE    *+8                                                      00001440
  145.           MVI   TEXTOLDL,X'00'                                           00001450
  146.           MVC   DYNTXTPP(4),=A(TEXTOLD) ELSE, SET OLD TEXT UNITS         00001460
  147.           B     DYNALLOC                                                 00001470
  148.  NEWLIST  CLC   TUMEMBER(8),=CL8' '                                      00001480
  149.           BE    *+8                                                      00001490
  150.           MVI   TEXTNEWL,X'00'                                           00001500
  151.           MVC   DYNTXTPP(4),=A(TEXTNEW) SET NEW TEXT UNITS               00001510
  152.  DYNALLOC LA    R1,DYNRBPTR                                              00001520
  153.           DYNALLOC ,                                                     00001530
  154.           LTR   R15,R15                                                  00001540
  155.           BZ    EXITOK                                                   00001550
  156.  DYNFAIL  ST    R15,S99RC                                                00001560
  157.           LA    R1,DFPARMS                                               00001570
  158.           LINK  EP=IKJEFF18                                              00001580
  159.           LA    R15,1                                                    00001590
  160.           B     EXITBAD                                                  00001600
  161.           EJECT                                                          00001610
  162.  CMS      EQU   *                                                        00001620
  163.  DDNAMGET L     R1,ADDNAME                                               00001630
  164.           TM    0(R1),X'80'                                              00001640
  165.           BO    CHARDD                                                   00001650
  166.           L     R2,0(R1)                                                 00001660
  167.           CVD   R2,DBLWORD                                               00001670
  168.           UNPK  FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED              00001680
  169.           OI    FTXXF001+3,X'F0'                                         00001690
  170.           MVC   PLDD(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT        00001700
  171.           B     FILEGET                                                  00001710
  172.  CHARDD   MVC   PLDD(8),0(R1)  COPY                                      00001720
  173.  FILEGET  L     R1,ACMSFN                                                00001730
  174.           MVC   PLFN(8),0(R1)     COPY INTO FILEDEF PLIST                00001740
  175.           L     R1,ACMSFT                                                00001750
  176.           MVC   PLFT(8),0(R1)     COPY INTO FILEDEF PLIST                00001760
  177.           L     R1,ACMSFM                                                00001770
  178.           MVC   PLFM(2),0(R1)     COPY INTO FILEDEF PLIST                00001780
  179.           MVC   STATEFN(18),PLFN  COPY FN,FT,FM INTO STATE PLIST         00001790
  180.  STATGET  LA    R1,STATE                                                 00001800
  181.           SVC   202                                                      00001810
  182.           DC    AL4(*+4)                                                 00001820
  183.           L     R1,AISTAT                                                00001830
  184.           CLC   0(4,R1),=F'0'                                            00001840
  185.           BNE   OLDFILE                                                  00001850
  186.           C     R15,=F'0'                                                00001860
  187.           BNE   RECFMGET                                                 00001870
  188.           TPUT  ERRMSG1,ERRMSG1L                                         00001880
  189.           LA    R15,1                                                    00001890
  190.           B     EXITBAD                                                  00001900
  191.  OLDFILE  C     R15,=F'0'                                                00001910
  192.           BE    SETPLIST                                                 00001920
  193.           TPUT  ERRMSG2,ERRMSG2L                                         00001930
  194.           LA    R15,1                                                    00001940
  195.           B     EXITBAD                                                  00001950
  196.  RECFMGET L     R1,AIRECFM                                               00001960
  197.           CLC   0(4,R1),=F'1'                                            00001970
  198.           BNE   *+14                                                     00001980
  199.           MVC   NEWRECFM(3),=C'FB '                                      00001990
  200.           B     BLKSIGET                                                 00002000
  201.           MVC   NEWRECFM(3),=C'VBS'                                      00002010
  202.  BLKSIGET MVC   NEWBLKSI(8),=CL8' '                                      00002020
  203.           L     R1,AIBLKSI                                               00002030
  204.           L     R1,0(R1)                                                 00002040
  205.           CVD   R1,DBLWORD                                               00002050
  206.           UNPK  NEWBLKSI(5),DBLWORD+5(3) CONVERT TO PRINTABLS            00002060
  207.           OI    NEWBLKSI+4,X'F0'                                         00002070
  208.  LRECLGET MVC   NEWLRECL(8),=CL8' '                                      00002080
  209.           L     R1,AILRECL                                               00002090
  210.           L     R1,0(R1)                                                 00002100
  211.           CVD   R1,DBLWORD                                               00002110
  212.           UNPK  NEWLRECL(5),DBLWORD+5(3) CONVERT TO PRINTABLE            00002120
  213.           OI    NEWLRECL+4,X'F0'                                         00002130
  214.  SETPLIST L     R1,AISTAT                                                00002140
  215.           CLC   0(4,R1),=F'0'                                            00002150
  216.           BE    NEWPLIST                                                 00002160
  217.  OLDPLIST MVC   PLOPT(8),=8X'FF'                                         00002170
  218.           CLC   0(4,R1),=F'3'                                            00002180
  219.           BNE   FILEDEF                                                  00002190
  220.           MVC   PLOPT(8*4),OLDOPT ELSE, SET OPTION DISP=MOD              00002200
  221.           B     FILEDEF                                                  00002210
  222.  NEWPLIST MVC   PLOPT(8*8),NEWOPT                                        00002220
  223.  FILEDEF  LA    R1,PL                                                    00002230
  224.           ICM   R1,B'1000',=X'0D'                                        00002240
  225.           SVC   202                                                      00002250
  226.           DC    AL4(*+4)                                                 00002260
  227.           LTR   R15,R15                                                  00002270
  228.           BZ    EXITOK                                                   00002280
  229.           LA    R15,1                                                    00002290
  230.           B     EXITBAD                                                  00002300
  231.           EJECT                                                          00002310
  232.  EXITOK   SR    R15,R15                                                  00002320
  233.  EXITBAD  L     R1,AIRETCD                                               00002330
  234.           ST    R15,0(R1)                                                00002340
  235.           L     R13,4(R13)                                               00002350
  236.           LM    R14,R12,12(R13)                                          00002360
  237.           BR    R14                                                      00002370
  238.           EJECT                                                          00002380
  239.  DYNRBPTR DC   X'80',AL3(DYNRB)                                          00002390
  240.  DYNRB    DC   AL1(20,S99VRBAL)                                          00002400
  241.           DC   AL2(0,0,0)                                                00002410
  242.  DYNTXTPP DC   AL4(*-*)                                                  00002420
  243.           DC   AL4(0,0)                                                  00002430
  244.  S99RC    DC   F'0'                                                      00002440
  245.  TEXTOLD  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUFRE)                    00002450
  246.  TEXTOLDL DC   X'80',AL3(TUUNT),X'80',AL3(TUMEM)                         00002460
  247.  TEXTNEW  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUREC,TUBLK,TULRE,TUFRE)  00002470
  248.           DC   A(TUUNT,TUTRK,TUPRI,TUSEC)                                00002480
  249.  TEXTNEWL DC   X'80',AL3(TUREL),A(TUMEM),X'80',AL3(TUDIR)                00002490
  250.  TUDDN    DC   AL2(DALDDNAM,1)    DDNAME                                 00002500
  251.  TUDDNLEN DC   AL2(*-*)                                                  00002510
  252.  TUDDNAME DC   CL8' '                                                    00002520
  253.  TUDSN    DC   AL2(DALDSNAM,1)    DSNAME                                 00002530
  254.  TUDSNLEN DC   AL2(*-*)                                                  00002540
  255.  TUDSNAME DC   CL44' '                                                   00002550
  256.  TUMEM    DC    AL2(DALMEMBR,1) MEMBER                                   00002560
  257.  TUMEMLEN DC    AL2(0)                                                   00002570
  258.  TUMEMBER DC    CL8' '                                                   00002580
  259.  TUDIR    DC    AL2(DALDIR,1,3)  DIR BLKS                                00002590
  260.  TUDIRECT DC    AL3(5)                                                   00002600
  261.  TUDIS    DC   AL2(DALNDISP,1,1)  DISP                                   00002610
  262.  TUDISP   DC   X'00'                                                     00002620
  263.  TUSTA    DC   AL2(DALSTATS,1,1)  STATUS                                 00002630
  264.  TUSTAT   DC   X'00'                                                     00002640
  265.  TUINO    DC    AL2(DALINOUT,1,1) INPUT/OUTPUT                           00002650
  266.  TUINOUT  DC    X'00'                                                    00002660
  267.  TUREC    DC   AL2(DALRECFM,1,1)  RECFM                                  00002670
  268.  TURECFM  DC   X'00'                                                     00002680
  269.  TUBLK    DC   AL2(DALBLKSZ,1,2)  BLKSIZE                                00002690
  270.  TUBLKSI  DC   AL2(*-*)                                                  00002700
  271.  TULRE    DC   AL2(DALLRECL,1,2)  LRECL                                  00002710
  272.  TULRECL  DC   AL2(*-*)                                                  00002720
  273.  TUUNT    DC   AL2(DALUNIT,1)     UNIT                                   00002730
  274.  TUUNTLEN DC   AL2(*-*)                                                  00002740
  275.  TUUNIT   DC   CL8' '                                                    00002750
  276.  TUTRK    DC   AL2(DALTRK,0)      TRACKS                                 00002760
  277.  TUPRI    DC   AL2(DALPRIME,1,3)  PRIMARY                                00002770
  278.  TUPRIME  DC   AL3(*-*)                                                  00002780
  279.  TUSEC    DC   AL2(DALSECND,1,3)  SECONDARY                              00002790
  280.  TUSECOND DC   AL3(*-*)                                                  00002800
  281.  TUREL    DC   AL2(DALRLSE,0)     RELEASE                                00002810
  282.  TUFRE    DC   AL2(DALCLOSE,0)    FREE=CLOSE                             00002820
  283.  DFPARMS  DS   0D                 DAIR FAIL PLIST                        00002830
  284.  DFS99RBP DC   A(DYNRB)           ADDRESS OF SVC 99 REQ BLK              00002840
  285.  DFRCP    DC   A(S99RC)           ADDRESS OF SVC 99 RET CODE             00002850
  286.  DFJEFF02 DC   A(DFZEROES)        ADDR OF UNKNOWN WRITER                 00002860
  287.  DFIDP    DC   A(DFSWTCHS)        ADDR OF DAIRFAIL OPTIONS               00002870
  288.  DFCPPLP  DC   A(0)               UNKNOWN CPPL ADDRESS                   00002880
  289.  DFBUFP   DC   A(0)               DO NOT RETURN MESSAGE                  00002890
  290.  DFZEROES DC   A(0)                                                      00002900
  291.  DFSWTCHS DC   X'80',X'33'        WTP FOR DYNALLOC, PLEASE               00002910
  292.           EJECT                                                          00002920
  293.  STATE    DC   CL8'STATE'         PLIST FOR CMS STATE COMMAND            00002930
  294.  STATEFN  DC   CL8' '             FILENAME                               00002940
  295.  STATEFT  DC   CL8' '             FILETYPE                               00002950
  296.  STATEFM  DC   CL8' '             FILEMODE                               00002960
  297.  STATEFEN DC   8X'FF'             FENCE                                  00002970
  298.  PL       DC    CL8'FILEDEF'                                             00002980
  299.  PLDD     DC    CL8' '                                                   00002990
  300.  PLDK     DC    CL8'DISK'                                                00003000
  301.  PLFN     DC    CL8' '                                                   00003010
  302.  PLFT     DC    CL8' '                                                   00003020
  303.  PLFM     DC    CL8' '                                                   00003030
  304.  PLOPT    DC    CL8'('                                                   00003040
  305.           DC    8CL8' '                                                  00003050
  306.  NEWOPT   DC    CL8'('                                                   00003060
  307.           DC    CL8'RECFM'                                               00003070
  308.  NEWRECFM DC    CL8' '                                                   00003080
  309.           DC    CL8'LRECL'                                               00003090
  310.  NEWLRECL DC    CL8' '                                                   00003100
  311.           DC    CL8'BLKSIZE'                                             00003110
  312.  NEWBLKSI DC    CL8' '                                                   00003120
  313.           DC    8X'FF'                                                   00003130
  314.  OLDOPT  DC    CL8'('                                                    00003140
  315.          DC    CL8'DISP'                                                 00003150
  316.          DC    CL8'MOD'                                                  00003160
  317.          DC    8X'FF'                                                    00003170
  318.           EJECT                                                          00003180
  319.  ERRMSG1  DC    C'REQUEST FOR NEW FILE, BUT FILE EXISTS ALREADY.'        00003190
  320.  ERRMSG1L EQU   *-ERRMSG1                                                00003200
  321.  ERRMSG2  DC    C'REQUEST FOR OLD FILE, BUT FILE IS NOT FOUND.'          00003210
  322.  ERRMSG2L EQU   *-ERRMSG2                                                00003220
  323.  DBLWORD  DC    D'0'              NICE DOUBLEWORD                        00003230
  324.  FTXXF001 DC    C'FTXXF001'       PLACE TO BUILD FORTRAN DDNAME          00003240
  325.  ARGADDS  DSECT                                                          00003250
  326.  AIDSYS   DS   A                                                         00003260
  327.  ADDNAME  DS   A                                                         00003270
  328.  AMVSDSN  DS   A                                                         00003280
  329.  AMEMBER  DS   A                                                         00003290
  330.  ACMSFN   DS   A                                                         00003300
  331.  ACMSFT   DS   A                                                         00003310
  332.  ACMSFM   DS   A                                                         00003320
  333.  AISTAT   DS   A                                                         00003330
  334.  AIDISP   DS   A                                                         00003340
  335.  AINOUT   DS   A                                                         00003350
  336.  AIRECFM  DS   A                                                         00003360
  337.  AIBLKSI  DS   A                                                         00003370
  338.  AILRECL  DS   A                                                         00003380
  339.  ADEVICE  DS   A                                                         00003390
  340.  AITRACK  DS   A                                                         00003400
  341.  AIRETCD  DS   A                                                         00003410
  342.           PRINT NOGEN                                                    00003420
  343.           IEFZB4D0                                                       00003430
  344.           IEFZB4D2                                                       00003440
  345.  R0  EQU  0                                                              00003450
  346.  R1  EQU  1                                                              00003460
  347.  R2  EQU  2                                                              00003470
  348.  R3  EQU  3                                                              00003480
  349.  R4  EQU  4                                                              00003490
  350.  R5  EQU  5                                                              00003500
  351.  R6  EQU  6                                                              00003510
  352.  R7  EQU  7                                                              00003520
  353.  R8  EQU  8                                                              00003530
  354.  R9  EQU  9                                                              00003540
  355.  R10 EQU  10                                                             00003550
  356.  R11 EQU  11                                                             00003560
  357.  R12 EQU  12                                                             00003570
  358.  R13 EQU  13                                                             00003580
  359.  R14 EQU  14                                                             00003590
  360.  R15 EQU  15                                                             00003600
  361.           END                                                            00003610
  362.                                                                          00003620
  363.                                                                          00003630
  364.