* 00000010 * for use with Kermit-TSO and Kermit-GUTS only 00000020 * 00000030 EJECT 00000040 DYNALC CSECT 00000050 B 14(R15) BRANCH AROUND ID 00000060 DC X'08',CL9'DYNALC' 00000070 STM 14,12,12(13) 00000080 CNOP 0,4 00000090 LR 12,13 00000100 BALR 13,0 00000110 BAL 13,76(13) 00000120 USING *,13 00000130 DS 18F 00000140 ST 12,4(13) 00000150 ST 13,8(12) 00000160 LR R11,R1 00000170 USING ARGADDS,R11 00000180 L R1,AIDSYS 00000190 CLC 0(4,R1),=F'-1' 00000200 BE EXITOK 00000210 CLC 0(4,R1),=F'1' 00000220 BE MVS 00000230 CLC 0(4,R1),=F'2' 00000240 BE MVS 00000250 CLC 0(4,R1),=F'3' 00000260 BE CMS 00000270 MVS EQU * 00000280 GETDDNAM L R1,ADDNAME 00000290 TM 0(R1),X'80' 00000300 BO DDCHAR 00000310 L R2,0(R1) 00000320 CVD R2,DBLWORD 00000330 UNPK FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED 00000340 OI FTXXF001+3,X'F0' 00000350 MVC TUDDNAME(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT 00000360 MVC TUDDNLEN(2),=AL2(8) 00000370 B GETDSN 00000380 DDCHAR LA R2,TUDDNAME 00000390 LA R3,8 00000400 DDLOOP CLI 0(R1),C' ' 00000410 BE GOTDD 00000420 MVC 0(1,R2),0(R1) 00000430 LA R1,1(R1) 00000440 LA R2,1(R2) 00000450 BCT R3,DDLOOP 00000460 GOTDD S R2,=A(TUDDNAME) 00000470 STCM R2,B'0011',TUDDNLEN 00000480 GETDSN L R1,AMVSDSN 00000490 LA R2,TUDSNAME 00000500 LA R3,44 00000510 DSLOOP CLI 0(R1),C' ' 00000520 BE GOTDS 00000530 MVC 0(1,R2),0(R1) 00000540 LA R1,1(R1) 00000550 LA R2,1(R2) 00000560 BCT R3,DSLOOP 00000570 GOTDS S R2,=A(TUDSNAME) 00000580 STCM R2,B'0011',TUDSNLEN 00000590 GETMEM L R1,AMEMBER R1 --> POSSIBLE MEMBER NAME 00000600 MVC TUMEMBER(8),=CL8' ' 00000610 CLC 0(8,R1),=CL8' ' ANY MEMBER HERE? 00000620 BE GETDISP IF NOT, GO GET DISPOSITION 00000630 LA R2,TUMEMBER 00000640 LA R3,8 R3 = MAX LENGTH OF MEMBER 00000650 MEMLOOP CLI 0(R1),C' ' 00000660 BE GOTMEM 00000670 MVC 0(1,R2),0(R1) 00000680 LA R1,1(R1) 00000690 LA R2,1(R2) 00000700 BCT R3,MEMLOOP 00000710 GOTMEM S R2,=A(TUMEMBER) 00000720 STCM R2,B'0011',TUMEMLEN 00000730 GETDISP L R1,AIDISP R1 --> STATUS PARM 00000740 CLC 0(4,R1),=F'0' UNCATALOG DATASET? 00000750 BNE *+12 IF NOT, CHECK FOR CATALOG 00000760 MVI TUDISP,X'01' ELSE, SIGNAL UNCATALOG 00000770 B GETSTAT AND GO GET STATUS 00000780 CLC 0(4,R1),=F'1' 00000790 BNE *+12 00000800 MVI TUDISP,X'02' 00000810 B GETSTAT 00000820 CLC 0(4,R1),=F'2' 00000830 BNE *+12 00000840 MVI TUDISP,X'04' 00000850 B GETSTAT 00000860 MVI TUDISP,X'08' MUST BE KEEP 00000870 GETSTAT L R1,AISTAT 00000880 CLC 0(4,R1),=F'0' 00000890 BNE *+12 00000900 MVI TUSTAT,X'04' 00000910 B GETINOUT 00000920 CLC 0(4,R1),=F'1' 00000930 BNE *+12 00000940 MVI TUSTAT,X'01' 00000950 B GETINOUT 00000960 CLC 0(4,R1),=F'2' 00000970 BNE *+12 00000980 MVI TUSTAT,X'08' 00000990 B GETINOUT 00001000 MVI TUSTAT,X'02' 00001010 GETINOUT L R1,AINOUT 00001020 CLC 0(4,R1),=F'0' 00001030 BNE OUT 00001040 MVI TUINOUT,X'80' 00001050 B GETRECFM 00001060 OUT CLC 0(4,R1),=F'1' 00001070 BNE BOTH 00001080 MVI TUINOUT,X'40' 00001090 B GETRECFM 00001100 BOTH MVI TUINOUT,X'80'+X'40' SIGNAL BOTH INPUT/OUTPUT 00001110 GETRECFM L R1,AIRECFM 00001120 CLC 0(4,R1),=F'1' 00001130 BNE *+12 00001140 MVI TURECFM,X'80'+X'10' 00001150 B GETBLKSI 00001160 MVI TURECFM,X'40'+X'10'+X'08' RECFM = V+B+S 00001170 GETBLKSI L R1,AIBLKSI 00001180 L R2,0(R1) 00001190 STCM R2,B'0011',TUBLKSI 00001200 GETLRECL L R1,AILRECL 00001210 L R2,0(R1) 00001220 STCM R2,B'0011',TULRECL 00001230 GETUNIT L R1,ADEVICE 00001240 LA R2,TUUNIT 00001250 LA R3,8 00001260 UNLOOP CLI 0(R1),C' ' 00001270 BE GOTUN 00001280 MVC 0(1,R2),0(R1) 00001290 LA R1,1(R1) 00001300 LA R2,1(R2) 00001310 B UNLOOP 00001320 GOTUN S R2,=A(TUUNIT) 00001330 STCM R2,B'0011',TUUNTLEN 00001340 GETTRACK L R1,AITRACK 00001350 L R2,0(R1) 00001360 STCM R2,B'0111',TUPRIME 00001370 STCM R2,B'0111',TUSECOND 00001380 MVI TEXTOLDL,X'80' 00001390 MVI TEXTNEWL,X'80' 00001400 TM TUSTAT,X'04' 00001410 BO NEWLIST 00001420 OLDLIST CLC TUMEMBER(8),=CL8' ' 00001430 BE *+8 00001440 MVI TEXTOLDL,X'00' 00001450 MVC DYNTXTPP(4),=A(TEXTOLD) ELSE, SET OLD TEXT UNITS 00001460 B DYNALLOC 00001470 NEWLIST CLC TUMEMBER(8),=CL8' ' 00001480 BE *+8 00001490 MVI TEXTNEWL,X'00' 00001500 MVC DYNTXTPP(4),=A(TEXTNEW) SET NEW TEXT UNITS 00001510 DYNALLOC LA R1,DYNRBPTR 00001520 DYNALLOC , 00001530 LTR R15,R15 00001540 BZ EXITOK 00001550 DYNFAIL ST R15,S99RC 00001560 LA R1,DFPARMS 00001570 LINK EP=IKJEFF18 00001580 LA R15,1 00001590 B EXITBAD 00001600 EJECT 00001610 CMS EQU * 00001620 DDNAMGET L R1,ADDNAME 00001630 TM 0(R1),X'80' 00001640 BO CHARDD 00001650 L R2,0(R1) 00001660 CVD R2,DBLWORD 00001670 UNPK FTXXF001+2(2),DBLWORD+6(2) CONVERT TO ZONED 00001680 OI FTXXF001+3,X'F0' 00001690 MVC PLDD(8),FTXXF001 COPY FORTRAN DDNAME TO TEXT UNIT 00001700 B FILEGET 00001710 CHARDD MVC PLDD(8),0(R1) COPY 00001720 FILEGET L R1,ACMSFN 00001730 MVC PLFN(8),0(R1) COPY INTO FILEDEF PLIST 00001740 L R1,ACMSFT 00001750 MVC PLFT(8),0(R1) COPY INTO FILEDEF PLIST 00001760 L R1,ACMSFM 00001770 MVC PLFM(2),0(R1) COPY INTO FILEDEF PLIST 00001780 MVC STATEFN(18),PLFN COPY FN,FT,FM INTO STATE PLIST 00001790 STATGET LA R1,STATE 00001800 SVC 202 00001810 DC AL4(*+4) 00001820 L R1,AISTAT 00001830 CLC 0(4,R1),=F'0' 00001840 BNE OLDFILE 00001850 C R15,=F'0' 00001860 BNE RECFMGET 00001870 TPUT ERRMSG1,ERRMSG1L 00001880 LA R15,1 00001890 B EXITBAD 00001900 OLDFILE C R15,=F'0' 00001910 BE SETPLIST 00001920 TPUT ERRMSG2,ERRMSG2L 00001930 LA R15,1 00001940 B EXITBAD 00001950 RECFMGET L R1,AIRECFM 00001960 CLC 0(4,R1),=F'1' 00001970 BNE *+14 00001980 MVC NEWRECFM(3),=C'FB ' 00001990 B BLKSIGET 00002000 MVC NEWRECFM(3),=C'VBS' 00002010 BLKSIGET MVC NEWBLKSI(8),=CL8' ' 00002020 L R1,AIBLKSI 00002030 L R1,0(R1) 00002040 CVD R1,DBLWORD 00002050 UNPK NEWBLKSI(5),DBLWORD+5(3) CONVERT TO PRINTABLS 00002060 OI NEWBLKSI+4,X'F0' 00002070 LRECLGET MVC NEWLRECL(8),=CL8' ' 00002080 L R1,AILRECL 00002090 L R1,0(R1) 00002100 CVD R1,DBLWORD 00002110 UNPK NEWLRECL(5),DBLWORD+5(3) CONVERT TO PRINTABLE 00002120 OI NEWLRECL+4,X'F0' 00002130 SETPLIST L R1,AISTAT 00002140 CLC 0(4,R1),=F'0' 00002150 BE NEWPLIST 00002160 OLDPLIST MVC PLOPT(8),=8X'FF' 00002170 CLC 0(4,R1),=F'3' 00002180 BNE FILEDEF 00002190 MVC PLOPT(8*4),OLDOPT ELSE, SET OPTION DISP=MOD 00002200 B FILEDEF 00002210 NEWPLIST MVC PLOPT(8*8),NEWOPT 00002220 FILEDEF LA R1,PL 00002230 ICM R1,B'1000',=X'0D' 00002240 SVC 202 00002250 DC AL4(*+4) 00002260 LTR R15,R15 00002270 BZ EXITOK 00002280 LA R15,1 00002290 B EXITBAD 00002300 EJECT 00002310 EXITOK SR R15,R15 00002320 EXITBAD L R1,AIRETCD 00002330 ST R15,0(R1) 00002340 L R13,4(R13) 00002350 LM R14,R12,12(R13) 00002360 BR R14 00002370 EJECT 00002380 DYNRBPTR DC X'80',AL3(DYNRB) 00002390 DYNRB DC AL1(20,S99VRBAL) 00002400 DC AL2(0,0,0) 00002410 DYNTXTPP DC AL4(*-*) 00002420 DC AL4(0,0) 00002430 S99RC DC F'0' 00002440 TEXTOLD DC A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUFRE) 00002450 TEXTOLDL DC X'80',AL3(TUUNT),X'80',AL3(TUMEM) 00002460 TEXTNEW DC A(TUDDN,TUDSN,TUSTA,TUDIS,TUINO,TUREC,TUBLK,TULRE,TUFRE) 00002470 DC A(TUUNT,TUTRK,TUPRI,TUSEC) 00002480 TEXTNEWL DC X'80',AL3(TUREL),A(TUMEM),X'80',AL3(TUDIR) 00002490 TUDDN DC AL2(DALDDNAM,1) DDNAME 00002500 TUDDNLEN DC AL2(*-*) 00002510 TUDDNAME DC CL8' ' 00002520 TUDSN DC AL2(DALDSNAM,1) DSNAME 00002530 TUDSNLEN DC AL2(*-*) 00002540 TUDSNAME DC CL44' ' 00002550 TUMEM DC AL2(DALMEMBR,1) MEMBER 00002560 TUMEMLEN DC AL2(0) 00002570 TUMEMBER DC CL8' ' 00002580 TUDIR DC AL2(DALDIR,1,3) DIR BLKS 00002590 TUDIRECT DC AL3(5) 00002600 TUDIS DC AL2(DALNDISP,1,1) DISP 00002610 TUDISP DC X'00' 00002620 TUSTA DC AL2(DALSTATS,1,1) STATUS 00002630 TUSTAT DC X'00' 00002640 TUINO DC AL2(DALINOUT,1,1) INPUT/OUTPUT 00002650 TUINOUT DC X'00' 00002660 TUREC DC AL2(DALRECFM,1,1) RECFM 00002670 TURECFM DC X'00' 00002680 TUBLK DC AL2(DALBLKSZ,1,2) BLKSIZE 00002690 TUBLKSI DC AL2(*-*) 00002700 TULRE DC AL2(DALLRECL,1,2) LRECL 00002710 TULRECL DC AL2(*-*) 00002720 TUUNT DC AL2(DALUNIT,1) UNIT 00002730 TUUNTLEN DC AL2(*-*) 00002740 TUUNIT DC CL8' ' 00002750 TUTRK DC AL2(DALTRK,0) TRACKS 00002760 TUPRI DC AL2(DALPRIME,1,3) PRIMARY 00002770 TUPRIME DC AL3(*-*) 00002780 TUSEC DC AL2(DALSECND,1,3) SECONDARY 00002790 TUSECOND DC AL3(*-*) 00002800 TUREL DC AL2(DALRLSE,0) RELEASE 00002810 TUFRE DC AL2(DALCLOSE,0) FREE=CLOSE 00002820 DFPARMS DS 0D DAIR FAIL PLIST 00002830 DFS99RBP DC A(DYNRB) ADDRESS OF SVC 99 REQ BLK 00002840 DFRCP DC A(S99RC) ADDRESS OF SVC 99 RET CODE 00002850 DFJEFF02 DC A(DFZEROES) ADDR OF UNKNOWN WRITER 00002860 DFIDP DC A(DFSWTCHS) ADDR OF DAIRFAIL OPTIONS 00002870 DFCPPLP DC A(0) UNKNOWN CPPL ADDRESS 00002880 DFBUFP DC A(0) DO NOT RETURN MESSAGE 00002890 DFZEROES DC A(0) 00002900 DFSWTCHS DC X'80',X'33' WTP FOR DYNALLOC, PLEASE 00002910 EJECT 00002920 STATE DC CL8'STATE' PLIST FOR CMS STATE COMMAND 00002930 STATEFN DC CL8' ' FILENAME 00002940 STATEFT DC CL8' ' FILETYPE 00002950 STATEFM DC CL8' ' FILEMODE 00002960 STATEFEN DC 8X'FF' FENCE 00002970 PL DC CL8'FILEDEF' 00002980 PLDD DC CL8' ' 00002990 PLDK DC CL8'DISK' 00003000 PLFN DC CL8' ' 00003010 PLFT DC CL8' ' 00003020 PLFM DC CL8' ' 00003030 PLOPT DC CL8'(' 00003040 DC 8CL8' ' 00003050 NEWOPT DC CL8'(' 00003060 DC CL8'RECFM' 00003070 NEWRECFM DC CL8' ' 00003080 DC CL8'LRECL' 00003090 NEWLRECL DC CL8' ' 00003100 DC CL8'BLKSIZE' 00003110 NEWBLKSI DC CL8' ' 00003120 DC 8X'FF' 00003130 OLDOPT DC CL8'(' 00003140 DC CL8'DISP' 00003150 DC CL8'MOD' 00003160 DC 8X'FF' 00003170 EJECT 00003180 ERRMSG1 DC C'REQUEST FOR NEW FILE, BUT FILE EXISTS ALREADY.' 00003190 ERRMSG1L EQU *-ERRMSG1 00003200 ERRMSG2 DC C'REQUEST FOR OLD FILE, BUT FILE IS NOT FOUND.' 00003210 ERRMSG2L EQU *-ERRMSG2 00003220 DBLWORD DC D'0' NICE DOUBLEWORD 00003230 FTXXF001 DC C'FTXXF001' PLACE TO BUILD FORTRAN DDNAME 00003240 ARGADDS DSECT 00003250 AIDSYS DS A 00003260 ADDNAME DS A 00003270 AMVSDSN DS A 00003280 AMEMBER DS A 00003290 ACMSFN DS A 00003300 ACMSFT DS A 00003310 ACMSFM DS A 00003320 AISTAT DS A 00003330 AIDISP DS A 00003340 AINOUT DS A 00003350 AIRECFM DS A 00003360 AIBLKSI DS A 00003370 AILRECL DS A 00003380 ADEVICE DS A 00003390 AITRACK DS A 00003400 AIRETCD DS A 00003410 PRINT NOGEN 00003420 IEFZB4D0 00003430 IEFZB4D2 00003440 R0 EQU 0 00003450 R1 EQU 1 00003460 R2 EQU 2 00003470 R3 EQU 3 00003480 R4 EQU 4 00003490 R5 EQU 5 00003500 R6 EQU 6 00003510 R7 EQU 7 00003520 R8 EQU 8 00003530 R9 EQU 9 00003540 R10 EQU 10 00003550 R11 EQU 11 00003560 R12 EQU 12 00003570 R13 EQU 13 00003580 R14 EQU 14 00003590 R15 EQU 15 00003600 END 00003610 00003620 00003630