Had a call off-list from someone who was unhappy
with my use of hard coded offsets in my sample.
He's right, of course, but the usual excuse: I
was just doing a "quick and dirty" for the list.
But, of course, that's the kind of thing that ends
up going into production in real life (not this
example, of course, just any code that's thrown
together for one time only). Then I also realized
the code was not truly reentrant (due to the way
the WTO was set up).
So I thought I'd fix that up. Here is the code
I sent last night:
*PROCESS COMPAT(NOCASE,MACROCASE)
PGM64A CSECT
PGM64A AMODE 64
SYSSTATE AMODE64=YES,ARCHLVL=2
llgtr 13,13 * ensure R13 valid 64-bit address
stmg 14,12,8(13) * save all passed regs
larl 12,pgm64a * get base reg for program
using PGM64A,12
getmain r,lv=160 * 144 save area + 16 byte work area
stg 1,136(13)
stg 13,128(1)
lgr 13,1
mvc 4(4,13),f4sa
mvc 144(14,13),parmlist
la 2,150(13) point to text
st 2,144(13)
*
la 2,148(13) point to halword prefixed string
wto text=(2),routcde=(11),mf=(e,genwto)
*
l 15,vpgma
o 15,amode31_bit set target amode to 31
la 1,144(13) point to address of data
bassm 14,15
*
la 2,148(13) point to halword prefixed string
wto text=(2),routcde=(11),mf=(e,genwto)
*
lg 13,128(13)
lg 1,136(13)
freemain r,lv=144,a=(1)
lmg 14,12,8(13)
sr 15,15 * set return code
bsm 0,14 * return, resetting AMODE
*
f4sa dc c'F4SA'
vpgma dc v(pgma)
amode31_bit dc x'80000000'
parmlist dc a(critdte)
msgarea dc h'8'
critdte dc cl8'Original'
genwto wto text=(2),routcde=(11),mf=l
END PGM64A
Now, here's the code after setting up a DSECT and
making adjustments:
*PROCESS COMPAT(NOCASE,MACROCASE)
PGM64A CSECT
PGM64A AMODE 64
SYSSTATE AMODE64=YES,ARCHLVL=2
* A program that starts out in AMODE64 and calls a subroutine
* running in AMOD31; passes a parm to the sub, which changes it
*
* The call is static
*
*
llgtr 13,13 * ensure R13 valid 64-bit address
stmg 14,12,8(13) * save all passed regs
larl 12,pgm64a * get base reg for program
using PGM64A,12
getmain r,lv=mem_size * save area + work area
stg 1,136(13)
stg 13,128(1)
lgr 13,1
using sarea,13
mvc eyecatch,f4sa
mvc genwto(gen_size),srcwto
mvc d_pointer(14),parmlist
la 2,data point to text
st 2,d_pointer
*
la 2,data_len point to halword prefixed string
wto text=(2),routcde=(11),mf=(e,genwto)
*
l 15,vpgma
o 15,amode31_bit set target amode to 31
la 1,d_pointer point to address of data
bassm 14,15
*
la 2,data_len point to halword prefixed string
wto text=(2),routcde=(11),mf=(e,genwto)
*
lg 13,128(13)
lg 1,136(13)
freemain r,lv=mem_size,a=(1)
lmg 14,12,8(13)
sr 15,15 * set return code
bsm 0,14 * return, resetting AMODE if needed
*
f4sa dc c'F4SA'
vpgma dc v(pgma)
amode31_bit dc x'80000000'
parmlist dc a(critdte)
msgarea dc h'8'
critdte dc cl8'Original'
genwto wto text=(2),routcde=(11),mf=l
sarea dsect
savearea ds cl144
org savearea+4
eyecatch ds ad
org savearea+136
fwdptr ds ad
bwdptr ds ad
org
d_pointer ds a
data_len ds h
data ds cl8
ds h
genwto wto text=(2),routcde=(11),mf=l
gen_size equ *-genwto
mem_size equ *-savearea
END PGM64A
I still didn't see a nice way to use the labels
fwdptr and bwdptr, due to the timing of when there's
a good value in R13. So, just as a little challenge:
what else could we do to get rid of the fixed /
hard coded displacements?
--
Kind regards,
-Steve Comstock
The Trainer's Friend, Inc.
303-393-8716
http://www.trainersfriend.com
z/OS Application development made easier
* Our classes include
+ How things work
+ Programming examples with realistic applications
+ Starter / skeleton code
+ Complete working programs
+ Useful utilities and subroutines
+ Tips and techniques
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [EMAIL PROTECTED] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
