How can I pass a stem variable to a proc?
Polanik, Joseph ** CTR ** , Joseph
subroutine or to make the stem GLOBAL so the subroutine can access it?
Thanks,
Joe Polanik
jpol...@lucent.com <mailto:jpol...@lucent.com>
Cees Jan
if you want to have some directions please mail me
Cees Jan van Deelen
mailto:cees.jan....@mail.ing.nl
REXX global variables
Problem addressed
Although REXX is a powerful and flexible language, it has one
significant weakness: its lack of global variable support, which
could be used to pass variables between EXECs.
Currently there are two common methods of sharing variables: by
using a REXX queue or the ISPF Dialog Manager shared
variable pool. Neither of these two methods is particularly
satisfactory. The ISPF Dialog Manager shared variable pool can
only be used in the ISPF environment, and the shared variables
must be explicitly named. Only the head or tail of a queue can be
accessed, the individual queue elements must be identified in
some way (for example, by using a tag), and accessing queue
elements is destructive.
Solution
The GLOBALV function shares variables by either copying the
variables into an internal buffer (SET mode) or restoring variables
from this buffer (GET mode). Two further modes - INI (initialize)
and END - perform buffer maintenance: INI clears the buffer, and
END removes (deletes) the buffer.
GLOBALV has two forms:
o Global data sharing (the complete set of variables is shared)
o Named variable sharing (explicit or generic).
The second form serves the interests of information-hiding, and
approximates the EXPOSE keyword in the REXX procedure
instruction.
The GLOBALV function dynamically allocates main storage
blocks for the required buffers and stores the anchor address of the
buffer chain in a named token. The buffer pools can be either
anonymous (from the application's viewpoint) or named.
A REXX EXEC shares variables by calling GLOBALV with the
SET option. The current values for the specified variables are
copied into the internal buffer: the original REXX variables
remain unchanged. Invoked EXECs retrieve the shared variables
by calling GLOBALV with the GET option. The stored variables
are copied from the internal buffer into the EXEC's local variable
pool: the variable values in the internal buffer remain unchanged.
Any subsequent GLOBALV SET invocation copies the variable
values at the end of the internal buffer.
The GLOBALV INI function clears the allocated buffers: the
(empty) buffers are retained. The shared variables are lost,
although the current REXX variables remain unchanged.
Subsequent GETs will rewrite the shared variables.
The GLOBALV END function explicitly frees the allocated
buffers and the associated token.
The allocated buffers are implicitly freed when the EXEC that
originally created the pool terminates. The token is freed when the
address space terminates. To avoid an error situation occurring
(error code 200), an END for the pool should be performed when
the original EXEC terminates if there is a possibility that this pool
can be reused in the current address space.
Named pools can be used to differentiate between various classes
of variable; for example, semi-constant data (data that remains
constant throughout the EXEC processing), EXEC-specific data,
etc.
Calling sequence
result = GLOBALV(SET [poolname][,varname]...)
result = GLOBALV(GET [poolname][,varname]...)
result = GLOBALV(INI [poolname])
result = GLOBALV(END [poolname])
poolname (1 to 8 characters) is the name of the associated pool.
poolname is suffixed to 'GLOBALV' to form the corresponding
token name.
If poolname is not specified, the default (anonymous) pool is used.
varname is the name of a variable to be processed. varname has
two special forms:
o varname* - generic variable name (all variable names that
match up to asterisk will be processed; for example, BETA*
matches BETA, BETA1, BETAABC, BETA.1, etc).
o varname. - stem variable name (all stem variables with the
specified stem will be processed; for example, GAMMA.
matches GAMMA.1, GAMMA.BETA, etc).
If no variable names are specified, the complete set of variables is
processed.
Function return value
GLOBALV returns with one of the following return values:
0 Successful processing.
1 Successful processing, although one or more variables
were truncated (GLOBALV truncates individual variables
to a maximum length of 4096 bytes, although this
program constant can be altered).
4 Parameter missing.
8 Invalid parameter (first parameter must be GET, SET,
INI, or END).
12 IRXEXCOM error (REXX environment error).
68,...,128 IEANxxx service error (return code + 64).
200 Addressing/protection exception (caused by the
variable pool storage area no longer being available - no
END operation performed).
Example 1 (global data sharing)
/* REXX1 */
...
CALL GLOBALV 'SET' /* save current variables */
CALL REXX2
CALL GLOBALV 'GET' /* get current (changed) variables (from REXX2) */
...
/* REXX2 */
CALL GLOBALV 'GET' /* get current variables (from REXX1) */
...
CALL GLOBALV 'SET' /* save current (new) variables (for REXX1) */
RETURN
Example 2 (selective data sharing)
/* REXX3 */
var11 = 'BETA'
var12 = 'DELTA'
var2 = '12345678'
phi.1 = 1
phi.3 = 3
CALL GLOBALV 'SET', 'PHI.', 'VAR1*'
var12 = ''
CALL REXX4
phi.1 = ''
CALL GLOBALV 'GET', 'VAR*', PHI.
SAY phi.1 /* 1 - original saved value */
SAY var12 /* DELTA - REXX4 not saved */
...
/* REXX4 */
CALL GLOBALV 'GET' /* get all saved values */
SAY phi.3 /* 3 */
SAY var12 /* DELTA */
var12 = 'GAMMA'
RETURN
Example 3 (named pools)
/* REXX5 */
var11 = 'BETA'
var12 = 'DELTA'
var2 = '12345678'
phi.1 = 1
phi.3 = 3
CALL GLOBALV 'SET P1', 'PHI.'
CALL GLOBALV 'SET P2', 'VAR1*'
/* ... */
DROP phi.
CALL GLOBALV 'GET P1'
SAY phi.1 /* 1 */
Program code
The program contains the MAXLEN equate, which specifies the
maximum length of variable data that can be saved (currently
4096). This equate can be changed, but should always be less
than BLKLEN (the length of a dynamically-allocated storage
block) to avoid a possible run-time loop.
Note: in the interests of keeping the program code as simple as
possible, the variables are always written at the end of the internal
buffer. This means that the same variable/value pair may by
present more than once. Although this performs correctly, an
optimized solution could check before storing a value (and so
reduce the overall buffer size).
TITLE 'REXX GLOBALV-Function'
GLOBALV CSECT
GLOBALV AMODE 31
GLOBALV RMODE ANY
BAKR R14,0 save regs
BASSM R12,0 set base register
USING *,R12
BASE LA R13,SA set internal save-area
MVC 4(4,R13),=C'F1SA'
MVC FRV,=H'0' initialize GLOBALV function return value
USING EFPL,R1
L R2,EFPLEVAL PTR(Evaluation Block)
L R11,0(R2) A(Evaluation Block)
USING EVALBLOCK,R11
LR R9,R0 A(Environment Block)
USING ENVBLOCK,R9
L R9,ENVBLOCK_IRXEXTE A(external entries)
USING IRXEXTE,R9
MVC AIRXEXCOM,IRXEXCOM
DROP R9
L R10,EFPLARG A(parsed Argument List)
USING ARGTABLE_ENTRY,R10
LA R9,USERSHVB
USING SHVBLOCK,R9
USING GVHDSECT,R6 Global Variable Header Block
ESPIE SET,ASYNCERR,(4,5) trap Addressing Exceptions
ST R1,TOKEN
* get argument
LM R3,R4,ARGTABLE_ARGSTRING_PTR
* R3: A(argument)
* R4: L(argument)
LA R15,4 error return: PARM missing
LTR R4,R4
BNP EXIT
* Test length. If >4, poolname present.
CH R4,=H'3'
BL EXIT too short
CH R4,=H'12'
BH EXIT too long
SH R4,=H'5' LC(poolname)
BM NOPOOL
EX R4,EXMOVE2
NOPOOL MVI MODE,0 initialize
* set processing mode
CLC =C'GET',0(R3)
BNE *+8
MVI MODE,二ET
CLC =C'SET',0(R3)
BNE *+8
MVI MODE,又ET
CLC =C'INI',0(R3)
BNE *+8
MVI MODE,儿NIT
CLC =C'END',0(R3)
BNE *+8
MVI MODE,九ND
CLI MODE,0 test whether mode has been set
BE EXIT :no, error
* process arguments
LA R10,ARGTABLE_NEXT-ARGTABLE_ENTRY(R10) next argument
LM R1,R2,ARGTABLE_ARGSTRING_PTR
* R2: L(first argument); <0 = no entries
LTR R2,R2
BP *+6 ok
SR R10,R10 indicate "no names present"
ST R10,AARGLIST start of argument list
LA R15,8 error return: invalid parm
* test whether token exists
CALL IEANTRT,(HOMELVL,USERNAME,USERTOKN,RC),VL
CH R15,=H'4'
BL A100 RC=0; not first block
BH ERROR1 function error
* allocate first (anchor) block
SR R8,R8 initialize
BAL R14,NEWBLOCK allocate block
A100 L R6,ANCHOR
TM MODE,又ET
BO SETVAR
TM MODE,二ET
BO GETVAR
TM MODE,儿NIT
BO INITCHN initialize chain
TM MODE,九ND
BO DELETE delete anchor
EOJ LH R15,FRV set function return value
EXIT DS 0H
* convert function return value to character format
CVD R15,D
MVC WK,=X'402020202120'
LA R1,WKE
EDMK WK,D+5 get first significant digit
LA R15,WKE
SR R15,R1 LC(result)
EX R15,EXMOVE1 move into <EVDATA>
LA R15,1(R15) L(result)
ST R15,EVALBLOCK_EVLEN entry size
ESPIE RESET,TOKEN
LA R15,0 function execution status
PR , program end
ERROR1 LA R15,64(R15) set error range 68,...,128
B EXIT
EXMOVE1 MVC EVALBLOCK_EVDATA(0),0(R1) EX-instruction
EXMOVE2 MVC POOLNAME(0),4(R3)
TITLE 'Processing Routines'
INITCHN DS 0H (re-)initialize chain
* R6: A(first block)
USING GVHDSECT,R6 Global Variable Header Block
LTR R6,R6
BZ EOJ empty chain
INITCHN1 L R7,GVHNEXT save address of next chained block
* reset pointers
BAL R14,INITHDR reinitialize header
LTR R6,R7 address of next chain block
BNZ INITCHN1 block exists (free)
LA R15,0
B EXIT
DELETE DS 0H free (delete) anchor
CALL IEANTDL,(HOMELVL,USERNAME,RC),VL
LTR R15,R15
BNZ ERROR1 function error
* free allocated chain
LTR R6,R6 R6: A(first block)
BZ EOJ empty chain
USING GVHDSECT,R6 Global Variable Header Block
FREEBLK L R7,GVHNEXT save address of next chained block
STORAGE RELEASE, free storage block x
LENGTH=BLKLEN, x
SP=SP, subpool x
ADDR=(R6), address x
LINKAGE=SYSTEM
* test whether further chained block exists
LTR R7,R7 address of next chain block
BNZ FREEBLK block exists (free)
* end of chain
SR R0,R0
ST R0,0(R8) zeroize pointer
B EOJ end of chain (program end)
GETVAR DS 0H get variables from buffer
MVI SHVCODE,SHVSTORE store variable
USING GVEDSECT,R7
GETVAR2 LA R7,GVHEND
ST R7,GVHADDR address of first entry in block
GETVAR1 C R7,GVHLAST address of last entry in block
BE GETVAR3 end of block
* process entry
LA R2,GVENAME A(name)
ST R2,SHVNAMA A(variable name)
SR R3,R3
IC R3,GVENAMEL L(name)
ST R3,SHVNAML L(variable name)
LH R4,GVEDATAL L(data)
ST R4,SHVVALL L(variable data)
LA R5,GVENAME(R3) A(data)
ST R5,SHVVALA A(variable data)
LA R7,0(R4,R5) A(next entry)
* test whether specified name
BAL R14,TESTNAME
LTR R15,R15
BNZ GETVAR1 name not found, ignore
* set in REXX variable pool
L R15,AIRXEXCOM
CALL (15),(IRX_IRXEXCOM,0,0,USERSHVB),VL
LTR R15,R15 test return code
BZ GETVAR1 ok
* else IRXEXCOM error
LA R15,12
B EXIT terminate
* end of block
GETVAR3 L R6,GVHNEXT address of next block
LTR R6,R6 test whether end of chain
BNZ GETVAR2 no: process next block
B EOJ last block
SETVAR DS 0H Set variable into buffer
MVI SHVCODE,SHVNEXTV fetch next
SETNEXT MVC SHVNAMA,=A(VN) A(variable name)
MVC SHVUSER,=A(L'VN)
MVC SHVNAML,=A(L'VN) L(variable name)
MVC SHVVALA,=A(VD) A(variable data)
MVC SHVBUFL,=A(L'VD) L(variable data)
MVC SHVVALL,=A(L'VD) L(variable data)
L R15,AIRXEXCOM
CALL (15),(IRX_IRXEXCOM,0,0,USERSHVB),VL
LTR R15,R15 test return code
BZ SETNEXT3 ok
* else IRXEXCOM error
MVC FRV,=H'1'
TM SHVRET,X'04'
BO SETNEXT2 truncated
LA R15,12
B EXIT terminate
SETNEXT3 TM SHVRET,X'02'
BO EOJ last variable
SETNEXT2 DS 0H determine entry size
* name
L R2,SHVNAMA
L R3,SHVNAML
* test whether specified name
BAL R14,TESTNAME
LTR R15,R15
BNZ SETNEXT name not found, ignore
* data
L R4,SHVVALA
L R5,SHVVALL
LA R0,GVELHDR(R3,R5) R1: entry size
SETNEXT4 L R1,GVHFREE current free space
SR R1,R0 free space remaining
BNM SETNEXT1 ok
LR R8,R6 save address of current block
ICM R6,15,GVHNEXT get chain address
BNZ SETNEXT4 chained-block available
BAL R14,NEWBLOCK no space, get new block
B SETNEXT2
* set entry
SETNEXT1 ST R1,GVHFREE set free space
L R7,GVHADDR
USING GVEDSECT,R7
STC R3,GVENAMEL L(name)
LA R0,GVENAME A(target name)
LR R1,R3 L(name)
MVCL R0,R2 move name
* R0: updated address (=A(data entry))
STH R5,GVEDATAL L(data)
LR R1,R5 L(data)
MVCL R0,R4 move data
* R0: updated address (=A(next entry))
ST R0,GVHADDR address of next entry
ST R0,GVHLAST = address of last entry
B SETNEXT
TESTNAME DS 0H test whether name specified as argument
* R2: A(name)
* R3: L(name)
SR R15,R15 initialize return code (=ok)
ICM R10,B'1111',AARGLIST load address of first argument
BZR R14 ok, no names specified
USING ARGTABLE_ENTRY,R10
TESTNAM0 LM R4,R5,ARGTABLE_ARGSTRING_PTR
* R4: A(argument)
* R5: L(argument)
LTR R5,R5
BM TESTNAM2 end of argument list, name not found
BZ TESTNAM3 null entry, get next entry
STM R2,R5,RSA save regs
CLCL R2,R4
BE TESTNAM4 names equal
LM R2,R5,RSA reload regs
* test for generic name (name*) or stem variable name (name.)
LA R1,0(R4,R5)
SH R1,=H'1' last byte of argument
CLI 0(R1),C'.' test for stem variable name
BNE TESTNAM1 :no
CR R3,R5
BL TESTNAM3 unequal
LR R3,R5 set argument length
CLCL R2,R4 compare
BE TESTNAM4 names equal
* else unequal, get next
TESTNAM3 LA R10,ARGTABLE_NEXT-ARGTABLE_ENTRY(R10) next argument
LM R2,R3,RSA reload regs
B TESTNAM0
TESTNAM1 CLI 0(R1),C'*' test for generic name
BNE TESTNAM3 :no
SH R5,=H'1' length of fixed argument
BNP TESTNAM3 zero length
CR R3,R5
BL TESTNAM3 unequal
LR R3,R5 set argument length
CLCL R2,R4 compare
BNE TESTNAM3 unequal, get next
TESTNAM4 LM R2,R5,RSA return
BR R14
TESTNAM2 LA R15,4 set return code
B TESTNAM4
NEWBLOCK ST R14,RSA save return address
* allocate new storage block
* R8: A(current block, or save-area for initial block)
STORAGE OBTAIN, x
LENGTH=BLKLEN, x
SP=SP, subpool x
ADDR=(R6), get address x
LOC=ANY, x
LINKAGE=SYSTEM
SPACE 1
BAL R14,INITHDR initialize header
XC GVHNEXT,GVHNEXT clear <GVHNEXT> (end of chain)
LTR R8,R8
BNZ NOTFIRST
* allocate user token
ST R6,ANCHOR set anchor address
CALL IEANTCR,(HOMELVL,USERNAME,USERTOKN,PERSOPT,RC),VL
LTR R15,R15
BNZ ERROR1 function error
LA R8,ANCHOR
NOTFIRST ST R6,0(R8) set chain address
L R14,RSA reload return address
BR R14 return
INITHDR DS 0H
* initialize header
LA R1,GVHEND
ST R1,GVHADDR A(first entry in block)
ST R1,GVHLAST A(current end of block)
L R1,=A(BLKLEN+GVHDSECT-GVHEND)
ST R1,GVHFREE free size
BR R14
TITLE 'Data areas'
SA DS 18F save-area
RSA DS 4A (work) register save-area
FRV DS H function return value
AARGLIST DS A A(argument list)
AIRXEXCOM DS A A(IRXEXCOM routine)
IRX_IRXEXCOM DC CL8'IRXEXCOM'
USERSHVB DS 0A user SHVBLOCK
DC (SHVBLEN)X'0' initialize to X'0...0'
HOMELVL DC F'2' home level
PERSOPT DC F'0' persistence option
USERNAME DS 0CL16
DC CL8'GLOBALV'
POOLNAME DC CL8' '
USERTOKN DS 0CL16
ANCHOR DS AL4
DS XL12 filler
TOKEN DC F'0'
RC DS F function return code
D DS 0D,PL8
WK DS CL6
WKE EQU *-1
MODE DS X processing mode
二ET EQU X'01'
又ET EQU X'02'
儿NIT EQU X'04'
九ND EQU X'08'
LTORG
VN DS CL250 variable name
VD DS CL(MAXLEN) variable data
MAXLEN EQU 4096 maximum non-truncated data length
BLKLEN EQU 8192 must be larger than L(VD)
SP EQU 1 storage subpool
TITLE 'ESPIE Exit'
ASYNCERR DS 0H
BALR R15,0
USING *,R15
L R12,=A(BASE)
USING BASE,R12
DROP R15
LA R15,200
B EXIT
DROP R12
LTORG
TITLE 'DSECTS'
GVHDSECT DSECT , Global Variable Header DSECT
GVHNEXT DS A address of next block (0 = chain end)
GVHADDR DS A address of next entry
GVHLAST DS A address of last entry
GVHFREE DS F free space count
GVHEND DS 0C start of data area
GVEDSECT DSECT , Global Variable Entry DSECT
GVEDATAL DS AL2 length of data
GVENAMEL DS AL1 length of name
GVELHDR EQU *-GVEDSECT L(header)
GVENAME DS 0C name
GVEDATA DS 0C data
IRXARGTB Argument Table Entry
IRXEFPL External Functions Parameter List
IRXENVB Environment Block
IRXEXTE External Entries
IRXEVALB Evaluation Block
IRXSHVB Shared Variable Request Block
END
A S Rudd
Technical Consultant (Germany)
c A S Rudd 1994