home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibmtsochicago / tsodyn.asm next >
Assembly Source File  |  2020-01-01  |  10KB  |  364 lines
  1. *
  2. *  for use with Kermit-TSO only
  3. *
  4.          EJECT
  5. DYNALC   CSECT
  6.          B    14(R15)        BRANCH AROUND ID
  7.          DC   X'08',CL9'DYNALC'
  8.          STM   14,12,12(13)
  9.          CNOP  0,4
  10.          LR    12,13
  11.          BALR  13,0
  12.          BAL   13,76(13)
  13.          USING *,13
  14.          DS    18F
  15.          ST    12,4(13)
  16.          ST    13,8(12)
  17.          LR    R11,R1
  18.          USING ARGADDS,R11
  19.          L     R1,AIDSYS
  20.          CLC   0(4,R1),=F'-1'
  21.          BE    EXITOK
  22.          CLC   0(4,R1),=F'1'
  23.          BE    MVS
  24.          CLC   0(4,R1),=F'2'
  25.          BE    MVS
  26.          CLC   0(4,R1),=F'3'
  27.          BE    CMS
  28. MVS      EQU   *
  29. GETDDNAM L     R1,ADDNAME
  30.          TM    0(R1),X'80'
  31.          BO    DDCHAR
  32.          L     R2,0(R1)
  33.          CVD   R2,DBLWORD
  34.          UNPK  FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED
  35.          OI    FTXXF001+3,X'F0'
  36.          MVC   TUDDNAME(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT
  37.          MVC   TUDDNLEN(2),=AL2(8)
  38.          B     GETDSN
  39. DDCHAR   LA    R2,TUDDNAME
  40.          LA    R3,8
  41. DDLOOP   CLI   0(R1),C' '
  42.          BE    GOTDD
  43.          MVC   0(1,R2),0(R1)
  44.          LA    R1,1(R1)
  45.          LA    R2,1(R2)
  46.          BCT   R3,DDLOOP
  47. GOTDD    S     R2,=A(TUDDNAME)
  48.          STCM  R2,B'0011',TUDDNLEN
  49. GETDSN   L     R1,AMVSDSN
  50.          LA    R2,TUDSNAME
  51.          LA    R3,44
  52. DSLOOP   CLI   0(R1),C' '
  53.          BE    GOTDS
  54.          MVC   0(1,R2),0(R1)
  55.          LA    R1,1(R1)
  56.          LA    R2,1(R2)
  57.          BCT   R3,DSLOOP
  58. GOTDS    S     R2,=A(TUDSNAME)
  59.          STCM  R2,B'0011',TUDSNLEN
  60. GETMEM    L     R1,AMEMBER       R1 --> POSSIBLE MEMBER NAME
  61.           MVC   TUMEMBER(8),=CL8' '
  62.           CLC   0(8,R1),=CL8' '  ANY MEMBER HERE?
  63.           BE    GETDISP          IF NOT, GO GET DISPOSITION
  64.          LA    R2,TUMEMBER
  65.          LA    R3,8              R3 = MAX LENGTH OF MEMBER
  66. MEMLOOP  CLI   0(R1),C' '
  67.          BE    GOTMEM
  68.          MVC   0(1,R2),0(R1)
  69.          LA    R1,1(R1)
  70.          LA    R2,1(R2)
  71.          BCT   R3,MEMLOOP
  72. GOTMEM   S     R2,=A(TUMEMBER)
  73.          STCM  R2,B'0011',TUMEMLEN
  74. GETDISP  L     R1,AIDISP         R1 --> STATUS PARM
  75.          CLC   0(4,R1),=F'0'     UNCATALOG DATASET?
  76.          BNE   *+12              IF NOT, CHECK FOR CATALOG
  77.          MVI   TUDISP,X'01'      ELSE, SIGNAL UNCATALOG
  78.          B     GETSTAT           AND GO GET STATUS
  79.          CLC   0(4,R1),=F'1'
  80.          BNE   *+12
  81.          MVI   TUDISP,X'02'
  82.          B     GETSTAT
  83.          CLC   0(4,R1),=F'2'
  84.          BNE   *+12
  85.          MVI   TUDISP,X'04'
  86.          B     GETSTAT
  87.          MVI   TUDISP,X'08'     MUST BE KEEP
  88. GETSTAT  L     R1,AISTAT
  89.          CLC   0(4,R1),=F'0'
  90.          BNE   *+12
  91.          MVI   TUSTAT,X'04'
  92.          B     GETINOUT
  93.          CLC   0(4,R1),=F'1'
  94.          BNE   *+12
  95.          MVI   TUSTAT,X'01'
  96.          B     GETINOUT
  97.          CLC   0(4,R1),=F'2'
  98.          BNE   *+12
  99.          MVI   TUSTAT,X'08'
  100.          B      GETINOUT
  101.          MVI   TUSTAT,X'02'
  102. GETINOUT L     R1,AINOUT
  103.          CLC   0(4,R1),=F'0'
  104.          BNE   OUT
  105.          MVI   TUINOUT,X'80'
  106.          B     GETRECFM
  107. OUT      CLC   0(4,R1),=F'1'
  108.          BNE   BOTH
  109.          MVI   TUINOUT,X'40'
  110.          B      GETRECFM
  111. BOTH     MVI    TUINOUT,X'80'+X'40' SIGNAL BOTH INPUT/OUTPUT
  112. GETRECFM L     R1,AIRECFM
  113.          CLC   0(4,R1),=F'1'
  114.          BNE   *+12
  115.          MVI   TURECFM,X'80'+X'10'
  116.          B     GETBLKSI
  117.          MVI   TURECFM,X'40'+X'10'+X'08' RECFM = V+B+S
  118. GETBLKSI L     R1,AIBLKSI
  119.          L     R2,0(R1)
  120.          STCM  R2,B'0011',TUBLKSI
  121. GETLRECL L     R1,AILRECL
  122.          L     R2,0(R1)
  123.          STCM  R2,B'0011',TULRECL
  124. GETUNIT  L     R1,ADEVICE
  125.          LA    R2,TUUNIT
  126.          LA    R3,8
  127. UNLOOP   CLI   0(R1),C' '
  128.          BE    GOTUN
  129.          MVC   0(1,R2),0(R1)
  130.          LA    R1,1(R1)
  131.          LA    R2,1(R2)
  132.          B     UNLOOP
  133. GOTUN    S     R2,=A(TUUNIT)
  134.          STCM  R2,B'0011',TUUNTLEN
  135. GETTRACK L     R1,AITRACK
  136.          L     R2,0(R1)
  137.          STCM  R2,B'0111',TUPRIME
  138.          STCM  R2,B'0111',TUSECOND
  139.          MVI   TEXTOLDL,X'80'
  140.          MVI   TEXTNEWL,X'80'
  141.          TM    TUSTAT,X'04'
  142.          BO    NEWLIST
  143. OLDLIST  CLC   TUMEMBER(8),=CL8' '
  144.          BE    *+8
  145.          MVI   TEXTOLDL,X'00'
  146.          MVC   DYNTXTPP(4),=A(TEXTOLD) ELSE, SET OLD TEXT UNITS
  147.          B     DYNALLOC
  148. NEWLIST  CLC   TUMEMBER(8),=CL8' '
  149.          BE    *+8
  150.          MVI   TEXTNEWL,X'00'
  151.          MVC   DYNTXTPP(4),=A(TEXTNEW) SET NEW TEXT UNITS
  152. DYNALLOC LA    R1,DYNRBPTR
  153.          DYNALLOC ,
  154.          LTR   R15,R15
  155.          BZ    EXITOK
  156. DYNFAIL  ST    R15,S99RC
  157.          LA    R1,DFPARMS
  158.          LINK  EP=IKJEFF18
  159.          LA    R15,1
  160.          B     EXITBAD
  161.          EJECT
  162. CMS      EQU   *
  163. DDNAMGET L     R1,ADDNAME
  164.          TM    0(R1),X'80'
  165.          BO    CHARDD
  166.          L     R2,0(R1)
  167.          CVD   R2,DBLWORD
  168.          UNPK  FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED
  169.          OI    FTXXF001+3,X'F0'
  170.          MVC   PLDD(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT
  171.          B     FILEGET
  172. CHARDD   MVC   PLDD(8),0(R1)  COPY
  173. FILEGET  L     R1,ACMSFN
  174.          MVC   PLFN(8),0(R1)     COPY INTO FILEDEF PLIST
  175.          L     R1,ACMSFT
  176.          MVC   PLFT(8),0(R1)     COPY INTO FILEDEF PLIST
  177.          L     R1,ACMSFM
  178.          MVC   PLFM(2),0(R1)     COPY INTO FILEDEF PLIST
  179.          MVC   STATEFN(18),PLFN  COPY FN,FT,FM INTO STATE PLIST
  180. STATGET  LA    R1,STATE
  181.          SVC   202
  182.          DC    AL4(*+4)
  183.          L     R1,AISTAT
  184.          CLC   0(4,R1),=F'0'
  185.          BNE   OLDFILE
  186.          C     R15,=F'0'
  187.          BNE   RECFMGET
  188.          TPUT  ERRMSG1,ERRMSG1L
  189.          LA    R15,1
  190.          B     EXITBAD
  191. OLDFILE  C     R15,=F'0'
  192.          BE    SETPLIST
  193.          TPUT  ERRMSG2,ERRMSG2L
  194.          LA    R15,1
  195.          B     EXITBAD
  196. RECFMGET L     R1,AIRECFM
  197.          CLC   0(4,R1),=F'1'
  198.          BNE   *+14
  199.          MVC   NEWRECFM(3),=C'FB '
  200.          B     BLKSIGET
  201.          MVC   NEWRECFM(3),=C'VBS'
  202. BLKSIGET MVC   NEWBLKSI(8),=CL8' '
  203.          L     R1,AIBLKSI
  204.          L     R1,0(R1)
  205.          CVD   R1,DBLWORD
  206.          UNPK  NEWBLKSI(5),DBLWORD+5(3) CONVERT TO PRINTABLS
  207.          OI    NEWBLKSI+4,X'F0'
  208. LRECLGET MVC   NEWLRECL(8),=CL8' '
  209.          L     R1,AILRECL
  210.          L     R1,0(R1)
  211.          CVD   R1,DBLWORD
  212.          UNPK  NEWLRECL(5),DBLWORD+5(3) CONVERT TO PRINTABLE
  213.          OI    NEWLRECL+4,X'F0'
  214. SETPLIST L     R1,AISTAT
  215.          CLC   0(4,R1),=F'0'
  216.          BE    NEWPLIST
  217. OLDPLIST MVC   PLOPT(8),=8X'FF'
  218.          CLC   0(4,R1),=F'3'
  219.          BNE   FILEDEF
  220.          MVC   PLOPT(8*4),OLDOPT ELSE, SET OPTION DISP=MOD
  221.          B     FILEDEF
  222. NEWPLIST MVC   PLOPT(8*8),NEWOPT
  223. FILEDEF  LA    R1,PL
  224.          ICM   R1,B'1000',=X'0D'
  225.          SVC   202
  226.          DC    AL4(*+4)
  227.          LTR   R15,R15
  228.          BZ    EXITOK
  229.          LA    R15,1
  230.          B     EXITBAD
  231.          EJECT
  232. EXITOK   SR    R15,R15
  233. EXITBAD  L     R1,AIRETCD
  234.          ST    R15,0(R1)
  235.          L     R13,4(R13)
  236.          LM    R14,R12,12(R13)
  237.          BR    R14
  238.          EJECT
  239. DYNRBPTR DC   X'80',AL3(DYNRB)
  240. DYNRB    DC   AL1(20,S99VRBAL)
  241.          DC   AL2(0,0,0)
  242. DYNTXTPP DC   AL4(*-*)
  243.          DC   AL4(0,0)
  244. S99RC    DC   F'0'
  245. TEXTOLD  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUFRE)
  246. TEXTOLDL DC   X'80',AL3(TUUNT),X'80',AL3(TUMEM)
  247. *TEXTNEW  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUREC,TUBLK,TULRE,TUFRE)
  248. *         DC   A(TUUNT,TUTRK,TUPRI,TUSEC)
  249. TEXTNEW  DC   A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUREC,TUBLK,TULRE)
  250.          DC   A(TUFRE,TUTRK,TUPRI,TUSEC)
  251. TEXTNEWL DC   X'80',AL3(TUREL),A(TUMEM),X'80',AL3(TUDIR)
  252. TUDDN    DC   AL2(DALDDNAM,1)    DDNAME
  253. TUDDNLEN DC   AL2(*-*)
  254. TUDDNAME DC   CL8' '
  255. TUDSN    DC   AL2(DALDSNAM,1)    DSNAME
  256. TUDSNLEN DC   AL2(*-*)
  257. TUDSNAME DC   CL44' '
  258. TUMEM    DC    AL2(DALMEMBR,1) MEMBER
  259. TUMEMLEN DC    AL2(0)
  260. TUMEMBER DC    CL8' '
  261. TUDIR    DC    AL2(DALDIR,1,3)  DIR BLKS
  262. TUDIRECT DC    AL3(5)
  263. TUDIS    DC   AL2(DALNDISP,1,1)  DISP
  264. TUDISP   DC   X'00'
  265. TUSTA    DC   AL2(DALSTATS,1,1)  STATUS
  266. TUSTAT   DC   X'00'
  267. TUINO    DC    AL2(DALINOUT,1,1) INPUT/OUTPUT
  268. TUINOUT  DC    X'00'
  269. TUREC    DC   AL2(DALRECFM,1,1)  RECFM
  270. TURECFM  DC   X'00'
  271. TUBLK    DC   AL2(DALBLKSZ,1,2)  BLKSIZE
  272. TUBLKSI  DC   AL2(*-*)
  273. TULRE    DC   AL2(DALLRECL,1,2)  LRECL
  274. TULRECL  DC   AL2(*-*)
  275. TUUNT    DC   AL2(DALUNIT,1)     UNIT
  276. TUUNTLEN DC   AL2(*-*)
  277. TUUNIT   DC   CL8' '
  278. TUTRK    DC   AL2(DALTRK,0)      TRACKS
  279. TUPRI    DC   AL2(DALPRIME,1,3)  PRIMARY
  280. TUPRIME  DC   AL3(*-*)
  281. TUSEC    DC   AL2(DALSECND,1,3)  SECONDARY
  282. TUSECOND DC   AL3(*-*)
  283. TUREL    DC   AL2(DALRLSE,0)     RELEASE
  284. TUFRE    DC   AL2(DALCLOSE,0)    FREE=CLOSE
  285. DFPARMS  DS   0D                 DAIR FAIL PLIST
  286. DFS99RBP DC   A(DYNRB)           ADDRESS OF SVC 99 REQ BLK
  287. DFRCP    DC   A(S99RC)           ADDRESS OF SVC 99 RET CODE
  288. DFJEFF02 DC   A(DFZEROES)        ADDR OF UNKNOWN WRITER
  289. DFIDP    DC   A(DFSWTCHS)        ADDR OF DAIRFAIL OPTIONS
  290. DFCPPLP  DC   A(0)               UNKNOWN CPPL ADDRESS
  291. DFBUFP   DC   A(0)               DO NOT RETURN MESSAGE
  292. DFZEROES DC   A(0)
  293. DFSWTCHS DC   X'80',X'33'        WTP FOR DYNALLOC, PLEASE
  294.          EJECT
  295. STATE    DC   CL8'STATE'         PLIST FOR CMS STATE COMMAND
  296. STATEFN  DC   CL8' '             FILENAME
  297. STATEFT  DC   CL8' '             FILETYPE
  298. STATEFM  DC   CL8' '             FILEMODE
  299. STATEFEN DC   8X'FF'             FENCE
  300. PL       DC    CL8'FILEDEF'
  301. PLDD     DC    CL8' '
  302. PLDK     DC    CL8'DISK'
  303. PLFN     DC    CL8' '
  304. PLFT     DC    CL8' '
  305. PLFM     DC    CL8' '
  306. PLOPT    DC    CL8'('
  307.          DC    8CL8' '
  308. NEWOPT   DC    CL8'('
  309.          DC    CL8'RECFM'
  310. NEWRECFM DC    CL8' '
  311.          DC    CL8'LRECL'
  312. NEWLRECL DC    CL8' '
  313.          DC    CL8'BLKSIZE'
  314. NEWBLKSI DC    CL8' '
  315.          DC    8X'FF'
  316. OLDOPT  DC    CL8'('
  317.         DC    CL8'DISP'
  318.         DC    CL8'MOD'
  319.         DC    8X'FF'
  320.          EJECT
  321. ERRMSG1  DC    C'REQUEST FOR NEW FILE, BUT FILE EXISTS ALREADY.'
  322. ERRMSG1L EQU   *-ERRMSG1
  323. ERRMSG2  DC    C'REQUEST FOR OLD FILE, BUT FILE IS NOT FOUND.'
  324. ERRMSG2L EQU   *-ERRMSG2
  325. DBLWORD  DC    D'0'              NICE DOUBLEWORD
  326. FTXXF001 DC    C'FTXXF001'       PLACE TO BUILD FORTRAN DDNAME
  327. ARGADDS  DSECT
  328. AIDSYS   DS   A
  329. ADDNAME  DS   A
  330. AMVSDSN  DS   A
  331. AMEMBER  DS   A
  332. ACMSFN   DS   A
  333. ACMSFT   DS   A
  334. ACMSFM   DS   A
  335. AISTAT   DS   A
  336. AIDISP   DS   A
  337. AINOUT   DS   A
  338. AIRECFM  DS   A
  339. AIBLKSI  DS   A
  340. AILRECL  DS   A
  341. ADEVICE  DS   A
  342. AITRACK  DS   A
  343. AIRETCD  DS   A
  344.          PRINT NOGEN
  345.          IEFZB4D0
  346.          IEFZB4D2
  347. R0  EQU  0
  348. R1  EQU  1
  349. R2  EQU  2
  350. R3  EQU  3
  351. R4  EQU  4
  352. R5  EQU  5
  353. R6  EQU  6
  354. R7  EQU  7
  355. R8  EQU  8
  356. R9  EQU  9
  357. R10 EQU  10
  358. R11 EQU  11
  359. R12 EQU  12
  360. R13 EQU  13
  361. R14 EQU  14
  362. R15 EQU  15
  363.          END
  364.