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