home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ibmtsochicago.tar.gz
/
ibmtsochicago.tar
/
tsodyn.asm
next >
Wrap
Assembly Source File
|
1984-07-18
|
10KB
|
364 lines
*
* 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