* 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