Calling external subroutines
Stephen E. Bacher
>that is called from the main REXX program....
>I know how to manipulate a variable via procedure expose if the
>subroutine is internal. But I want to be able to expose the variable
>to an externally written REXX subroutine. I am using rexx in TSO/E.
I guess this is a FAQ by now, but it can't be done - and it is one of
the Top Ten requests for enhancing the REXX language. Be assured that
highly paid experts are working on this problem even as we speak. :-)
Alternatives, by the way, have been posted here recently. I suggested
using the REXX data stack to pass values back and forth between
mutually external procedures. (Is that a proper terminology?)
- seb
Stephen E. Bacher
>can only see what is passed to it. If you are using ISPF you can use the
>profile pool to send values to an external routine.
It'd be better to use the shared ISPF variable pool, rather than the
profile pool, because the shared pool remains in memory. The profile
pool values get stored in the user's profile data set and persist
across sessions, sometimes causing unwanted results, and it's certainly
more expensive.
>There is also an ibm
>requirement to enhance rexx so it supports global variables. This would
>allow you do as you require.
Is there? If so, it requires enhancing the OS. MVS/TSO has had a
glaring lack of this feature since day one. And it would be fairly
easy to do it, given the nature of the TSO control block structure.
I've had a proposal for implementing such a thing sitting around for a
long time, but never put it into effect due to lack of potential
interest in an increasingly non-mainframe-oriented world.
- seb
Otto Stolz
(Hugh Dunn) writes:
> Does anyone know how I can pass variables from an external subroutine
> that is called from the main REXX program....
On Fri, 3 Dec 1993 13:15:04 PST <DJG...@DJGOVER.BCSC.GOV.BC.CA> said:
> [...] you can pass values to an external routine but not the
> variables them selves. An external routine [...]
> can only see what is passed to it.
This is the answer for REXX proper; and I will elaborate on it in the
sequel. However, there is an easier approach for CMS and TSO, which I'll
decuss below. (The latter may also be available in other REXX imple-
mentations, though in other disguise.)
It has been pointed out by other contributors that you can exploit the
REXX Stack to pass values to and fro between REXX programs that invoke
each other. I recommend the following canonical approach:
/* Caller */
address command "MAKEBUF"; buffer_level = rc /* for CMS */
stack_level = queued()
queue first_value
queue second_value
/* ... */
queue last_value
call callee queued()-stack_level
do i = queued()-stack_level
result.0 = i
parse pull result.i
end i
address command "DROPBUF" buffer_level /* for CMS */
/* now process result.i, where 1 <= i <= result.0 */
/* Callee */
if ^ datatype(arg(1),"W") then display_nastygram_and_exit
do i = 1 to arg(1)
result.0 = i
parse pull argument.i
end i
/* now process argument.i, where 1 <= i <= argument.0 */
/* and queue results */
return
The CMS MAKEBUF command has been implemented in many REXX implementations
as part of the REXX support. The above method is designed to use the only
stack available to the process in a way as to not disturb other programs
that use the stack. In TSOREXX, however, you can create, and dispose of,
stacks, to your hearts content; so you will rather create a new stack
rather than invoking MAKEBUF, and delete it rather than invoking DROPBUF.
There is an alternate approach, which is much less troublesome for the
REXX programmer.
Every REXX implemetation provides an interface for external routines
to the variables of the caller; however, this interface is designed for
system implementation languages, mostly assembler. In CMS, and TSO, you
can invoke a CMS Pipeline containing the STEM, or VAR, stages. Quote from
the help file:
: Operation: Variables are set or obtained from the REXX [...]
: environment active when the pipeline is defined. This is either the
: EXEC issuing the PIPE command or a REXX program issuing CALLPIPE. [...]
: When first in a pipeline, 'stem' obtains variables from the
: environment; in other positions variables are set. [...]
: On CMS and MVS you can specify the number of REXX environments to go
: back. [...] Thus, 'stem' can operate on variables in the EXEC issuing
: the pipeline specification, or one of its ancestors. [...]
: Though side effects are not always considered a good thing, the number
: option can be used to transfer an array from the caller (or back).
: /* Obtain parameters from caller */
: address command,
: 'PIPE stem parms. 1|stem parms.'
: Notes:
: 3. When a pipeline is issued as a TSO command, IKJCT441 is called to
: access the variable pool. The calling program can be REXX or CLIST.
: When the command is issued with Address Link, 'stem' accesses the REXX
: environment from where the command is issued.
To limit the hazard of the side effect, I recommend to encapsulate the
invokation of the external routine in a local procedure, thus:
/* Caller */
argument.1 = first_value
argument.2 = second_value
/* ... */
argument.0 = number_of_arguments
call encapsulate_callee
/* now process result.i, where 1 <= i <= result.0 */
/* local procedure of Caller: */
encapsulate_callee: procedure expose argument. result.
call callee
return
/* Callee */
address command 'PIPE stem argument. 1 | stem argument.'
/* now process argument.i, where 1 <= i <= argument.0 */
/* and store number of results in result.0 */
/* and store results in result.i, where 1 <= i <= result.0 */
address command 'PIPE stem result. | stem result. 1'
return
Happy programming,
Otto Stolz <RZO...@nyx.uni-konstanz.de>
<RZO...@DKNKURZ1.Bitnet>
PS. CMS Pipelines is the programm offering 5785-RAC/5799-DKF. One number
applies to Europe, the other to overseas (however, I can't remember
which is which.)
Stephen E. Bacher
different from the approach I had in mind, in implementation,
but has similar functionality. I noticed his caveat about
loading the variable pool prior to entry into ISPF, and the
reference to split screen usage. I didn't understand this
set of restrictions until I saw the code, which makes use of
a load module brought into storage via the LOAD systems service
as a pool anchor (if I read the code correctly).
Since LOADed modules belong to the task that loads them, they
go away when the loading task goes away. If the initial call
to REXXGLBL were to be done inside of ISPF, the module would
disappear as soon as the ISPF logical screen task terminated.
That is why the pool needs to be created from ready-mode TSO.
My original idea, on the other hand, was to chain variable contents off
the TSO environment control table (ECT) using the ECTUSER field, which
is reserved for installation use. We're already using this to store
READY-mode PFK definitions. Allocating memory in subpool 78 (the
shared subpool) insures that the storage will not disappear upon
task termination. Thus, a single variable pool can be created and
accessed from all TSO and ISPF environments for one logon session.
But, as I said before, I never got around to implementing it, and
now there's almost nobody left who would care...
- seb
Peter Flass
>Peter - would you be willing to share your code?
>
Let me describe what I have and if anyone's still interested I'll
send them a copy.
"REXXGLBL" is an external function which implements "session"
variables for TSO/REXX users. ISPF 'shared pool' variables
are not shared across logical screens, and 'profile pool'
variables, like CMS 'LASTING GLOBALV' variables are stored on
disk and retained across logons. REXXGLBL maintains a pool of
variables which may be initialized at logon and shared by REXX
EXECS running in any split-screen session. The pool is
initialized at first use. Variables are added or changed by
calling the function REXXGLBL('VPUT',variable,value) or
retrieved by calling REXXGLBL('VGET',variable). The only
restriction is that the pool must be initialized prior to
invoking ISPF (e.g. in a LOGON EXEC). REXXGLBL consists of
a 580 line assembler module plus another 70-line program and
a couple of macros. These modules may reside in a LINKLIST
library or steplib. No APF authorization is required.
As a little background I wrote this to be called at logon
to pull data from the execute parms and make it accessable
to REXX EXECS. For example we store version qualifiers of
libraries in a JCL include member and I wanted to be able to
use them in EXECS to allocate the correct libraries.
>On Tue, 7 Dec 1993 08:45:56 EST , Peter Flass <FL...@LBDRSCS.BITNET>
>writes:
>> On Mon, 6 Dec 1993 21:57:47 -0500 Stephen E. Bacher said:
>> >
>> >>There is also an ibm
>> >>requirement to enhance rexx so it supports global variables. This would
>> >>allow you do as you require.
>> >
>> >Is there? If so, it requires enhancing the OS. MVS/TSO has had a
>> >glaring lack of this feature since day one. And it would be fairly
>> >easy to do it, given the nature of the TSO control block structure.
>> >I've had a proposal for implementing such a thing sitting around for a
>> >long time, but never put it into effect due to lack of potential
>> >interest in an increasingly non-mainframe-oriented world.
>> >
>> I implemented "global variables" for TSO/REXX some time ago via an external
>> function call and it was relatively simple. I can't understand why IBM's
>> dragging their feet, but I decided I couldn't wait.
>>
=====================================================================
= PETER FLASS FLASS@LBDRSCS =
= Systems Programmer tel (518)458-5114 =
= NYS Legislative Bill Drafting Commission =
= 1450 Western Ave. =
= Albany, NY 12203 =
=====================================================================
Peter Flass
Peter Flass
//FLASSG JOB (),LBDTSO,CLASS=J,MSGCLASS=Z,
// REGION=2048K,NOTIFY=$
//ASM EXEC PGM=IEV90,REGION=200K,
// PARM='OBJECT,NODECK,ALIGN'
//********************************************************************
//** ASSEMBLE PROGRAM *
//********************************************************************
//SYSLIB DD DSN=SYSTEMS.MACLIB,DISP=SHR
// DD DSN=SYS1.MACLIB,DISP=SHR
// DD DSN=SYS1.MODGEN,DISP=SHR
//SYSPRINT DD SYSOUT=X,CHARS=(GT12)
//SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSUT2 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSUT3 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSLIN DD DSN=&&ASM,UNIT=VIO,DISP=(,PASS),
// SPACE=(TRK,(3,3)),DCB=BLKSIZE=400
//SYSIN DD *
TITLE 'LBD TSO CONTROL BLOCK ANCHOR'
LBDTSO CSECT
***********************************************************************
* *
* MODULE NAME: LBDTSO *
* *
* FUNCTION: LBD TSO CONTROL BLOCK ANCHOR. *
* WILL BE FILLED IN AT RUN TIME. *
* *
* CALLING SEQUENCE: *
* NONE *
* *
* AUTHOR: PETER FLASS *
* NYS LEGISLATIVE BILL DRAFTING COMMISSION *
* JANUARY, 1992. *
* *
* ATTRIBUTES: AMODE(31), RMODE(ANY). PROBLEM STATE, UNAUTHORIZED. *
* REUSABLE, NOT REFRESHABLE OR REENTRANT. *
* --- *
* *
* STATUS: TSO/E 2.3.1 *
* (NO TSO RELEASE DEPENDENCIES) *
* *
* MODIFICATIONS: *
* *
***********************************************************************
SPACE 3
LBDTSOVT DS 0F LBD TSO VECTOR TABLE
DC CL8'LBDTSOVT' MEMORY COMMENT
LBDGLOBL DC A(0) A(GLOBAL VARIABLE TABLE)
DC A(0) .
DC A(0) .
DC A(0) .
DC A(0) .
DC 4X'FF' END OF TABLE
END
//* --------------------------------------------------------------- ***
//LKED EXEC PGM=IEWL, X
// PARM='XREF,LET,LIST,NCAL,REUS', X
// COND=(8,LT,ASM)
//********************************************************************
//** LINKEDIT PROGRAM *
//********************************************************************
//SYSPRINT DD SYSOUT=X,CHARS=(GT12)
//SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSLIB DD DSN=SYSTEMS.LINKLIB,DISP=SHR
// DD DSN=SYS1.LINKLIB,DISP=SHR
//SYSLMOD DD DISP=SHR,DSN=SYSTEMS.LINKLIB
//SYSLIN DD DSN=&&ASM,DISP=(OLD,DELETE)
// DD *
MODE AMODE(31),RMODE(ANY)
NAME LBDTSO(R)
//* --------------------------------------------------------------- ***
./ ADD NAME=LBDTSOD
*
***********************************************************************
* LBD TSO VECTOR TABLE PF111092 *
***********************************************************************
LBDTSO DSECT , LBD TSO VECTOR TABLE
DS CL8 MODULE NAME
LBDVGLBL DS A A(GLOBAL VARIABLE POOL)
DS A UNUSED
DS A .
DS A .
DS A .
DS F F'-1' = END-OF-LIST
./ ADD NAME=LOADCHK
MACRO
.************************************************************
.* *
.* LOADCHK CHECK WHETHER OR NOT A SPECIFIED *
.* MODULE HAS BEEN LOADED BY SCANNING *
.* THE LLE, AND OPTIONALLY LOADING IT *
.* IF NOT PREVIOUSLY LOADED. *
.* *
.************************************************************
&NAME LOADCHK &TYPE=CHECK,&EP=,&EPLOC=,&LOAD=NO,&ERRET=
GBLB &EDS
LCLC &NDX
&NDX SETC 'LC&SYSNDX'
AIF ('&TYPE' EQ 'DSECT').LBD0001
AIF ('&TYPE' EQ 'CHECK').LBD0003
MNOTE 12,'I N V A L I D T Y P E'
MEXIT
.************************************************************
.* *
.* GENERATE NECESSARY DSECTS *
.* *
.************************************************************
.LBD0001 ANOP
AIF (&EDS).LBD0002
&EDS SETB 1
PUSH PRINT
PRINT NOGEN
CVT DSECT=YES COMMUNICATION VECTOR TABLE
IHACDE CONTENTS DIRECTORY ENTRY
IHALLE LOAD LIST ELEMENT
IKJTCB TASK CONTROL BLOCK
POP PRINT
.LBD0002 ANOP
MEXIT
.************************************************************
.* *
.* TYPE=CHECK *
.* *
.************************************************************
.LBD0003 ANOP
AIF ('&EP' NE '').LBD0004
AIF ('&EPLOC' NE '').LBD0005
MNOTE 8,'EP= OR EPLOC= PARAMETER IS REQUIRED'
MEXIT
.LBD0004 ANOP
AIF ('&EPLOC' EQ '').LBD0006
MNOTE 8,'EPLOC= CONFLICTS WITH EP= PARAMETER'
MEXIT
.LBD0005 ANOP
AIF ('&EP' EQ '').LBD0006
MNOTE 8,'EP= CONFLICTS WITH EPLOC= PARAMETER'
MEXIT
.LBD0006 ANOP
AIF ('&ERRET' NE '').LBD0007
MNOTE 8,'ERRET= PARAMETER IS REQUIRED'
MEXIT
.LBD0007 ANOP
AIF ('&LOAD' EQ 'YES').LBD0013
.************************************************************
.* *
.* GENERATE CODE (LOAD=NO) *
.* *
.************************************************************
&NAME L R15,CVTPTR POINT AT CVT
L R15,CVTTCBP-CVTMAP(,R15) POINT AT TCB POINTERS
L R1,0(,R15) ADDRESS OF ACTIVE TCB
L R15,TCBLLS-TCB(,R1) ADDRESS OF LAST LLE
LTR R15,R15 VALID ADDRESS?
BZ &NDX.C NO, EXIT (S806-04)
&NDX.A L R14,LLECDPT-LLE(,R15) ADDRESS OF CDE
&NDX.B L R0,CDENTPT-CDENTRY(,R14) ENTRY POINT ADDRESS
AIF ('&EP' EQ '').LBD0008
CLC CDNAME-CDENTRY(8,R14),=CL8'&EP'
AGO .LBD0010
.LBD0008 ANOP
AIF ('&EPLOC(1,1)' EQ '(').LBD0009
CLC CDNAME-CDENTRY(8,R14),&EPLOC
AGO .LBD0010
.LBD0009 ANOP
CLC CDNAME-CDENTRY(8,R14),0(&EPLOC(1))
.LBD0010 ANOP
BE &NDX.D . REQUESTED MODULE FOUND
L R14,CDCHAIN-CDENTRY(,R14) ADDRESS OF NEXT CDE
LTR R14,R14 END OF CDE CHAIN?
BNZ &NDX.B NO, CONTINUE
L R15,LLECHN-LLE(,R15) ADDRESS OF NEXT LLE
LTR R15,R15 END OF LLE CHAIN?
BNZ &NDX.A NO, CONTINUE
&NDX.C XR R0,R0 SET ENTRY-POINT ADDRESS
XR R1,R1 SET ABEND-CODE=806
ICM R1,3,=X'0806' .
LA R15,4 SET REASON-CODE=04
AIF ('&ERRET(1,1)' EQ '(').LBD0011
B &ERRET
AGO .LBD0012
.LBD0011 ANOP
B 0(&ERRET(1))
.LBD0012 ANOP
&NDX.D XR R15,R15 SET REASON-CODE=ZERO
MEXIT
.************************************************************
.* *
.* GENERATE CODE (LOAD=YES) *
.* *
.************************************************************
.LBD0013 ANOP
&NAME L R15,CVTPTR POINT AT CVT
L R15,CVTTCBP-CVTMAP(,R15) POINT AT TCB POINTERS
L R1,0(,R15) ADDRESS OF ACTIVE TCB
L R15,TCBLLS-TCB(,R1) ADDRESS OF LAST LLE
LTR R15,R15 VALID ADDRESS?
BZ &NDX.C NO, ISSUE LOAD
&NDX.A L R14,LLECDPT-LLE(,R15) ADDRESS OF CDE
&NDX.B L R0,CDENTPT-CDENTRY(,R14) ENTRY POINT ADDRESS
AIF ('&EP' EQ '').LBD0014
CLC CDNAME-CDENTRY(8,R14),=CL8'&EP'
AGO .LBD0016
.LBD0014 ANOP
AIF ('&EPLOC(1,1)' EQ '(').LBD0015
CLC CDNAME-CDENTRY(8,R14),&EPLOC
AGO .LBD0016
.LBD0015 ANOP
CLC CDNAME-CDENTRY(8,R14),0(&EPLOC(1))
.LBD0016 ANOP
BE &NDX.D . REQUESTED MODULE FOUND
L R14,CDCHAIN-CDENTRY(,R14) ADDRESS OF NEXT CDE
LTR R14,R14 END OF CDE CHAIN?
BNZ &NDX.B NO, CONTINUE
L R15,LLECHN-LLE(,R15) ADDRESS OF NEXT LLE
LTR R15,R15 END OF LLE CHAIN?
BNZ &NDX.A NO, CONTINUE
AIF ('&EP' EQ '').LBD0017
&NDX.C LOAD EP=&EP,ERRET=&ERRET LOAD REQUESTED MODULE
AGO .LBD0018
.LBD0017 ANOP
&NDX.C LOAD EPLOC=&EPLOC,ERRET=&ERRET LOAD REQUESTED MODULE
.LBD0018 ANOP
&NDX.D XR R15,R15 SET REASON-CODE=ZERO
MEXIT
MEND
./ ADD NAME=REGS
MACRO
&NAME REGS
*
***********************************************************************
* * G e n e r a l R e g i s t e r E q u a t e s * *
***********************************************************************
*
R0 EQU 0 General Register 0
R1 EQU 1 General Register 1
R2 EQU 2 General Register 2
R3 EQU 3 General Register 3
R4 EQU 4 General Register 4
R5 EQU 5 General Register 5
R6 EQU 6 General Register 6
R7 EQU 7 General Register 7
R8 EQU 8 General Register 8
R9 EQU 9 General Register 9
R10 EQU 10 General Register 10
R11 EQU 11 General Register 11
R12 EQU 12 General Register 12
R13 EQU 13 General Register 13
R14 EQU 14 General Register 14
R15 EQU 15 General Register 15
*
***********************************************************************
*
SPACE 3
MEND
./ ADD NAME=REXXGLBL
//FLASST JOB (),REXXGLBL,CLASS=J,MSGCLASS=Z,
// REGION=2048K,NOTIFY=$
//ASM EXEC PGM=IEV90,REGION=200K,
// PARM='OBJECT,NODECK,ALIGN,RENT'
//********************************************************************
//** ASSEMBLE PROGRAM *
//********************************************************************
//SYSLIB DD DSN=SYSTEMS.MACLIB,DISP=SHR
// DD DSN=SYS1.MACLIB,DISP=SHR
// DD DSN=SYS1.MODGEN,DISP=SHR
//SYSPRINT DD SYSOUT=X,CHARS=(GT12)
//SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSUT2 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSUT3 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSLIN DD DSN=&&ASM,UNIT=VIO,DISP=(,PASS),
// SPACE=(TRK,(3,3)),DCB=BLKSIZE=400
//SYSIN DD *
TITLE 'TSO/REXX GLOBAL VARIABLE ROUTINE'
REXXGLBL CSECT
***********************************************************************
* *
* MODULE NAME: REXXGLBL *
* *
* AUTHOR: PETER FLASS <FLASS@LBDRSCS> *
* NEW YORK STATE LEGISLATIVE BILL DRAFTING COMMISSION *
* 1450 WESTERN AVENUE, 3RD FLOOR *
* ALBANY, NY 12203 *
* *
* THIS PROGRAM IS FREELY DISTRIBUTED ON THE CONDITION *
* THAT IT NOT BE SOLD OR INCORPORATED IN A COMMERCIAL *
* PRODUCT WITHOUT EXPRESS WRITTEN PERMISSION BY *
* THE AUTHOR. *
* *
* FUNCTION: TSO/REXX GLOBAL VARIABLE ROUTINE. *
* PROVIDES EQUIVALENTS OF ISPF 'VGET' AND 'VPUT' *
* FOR SESSION-GLOBAL VARIABLES. *
* *
* CALLING SEQUENCE: *
* NULL = REXXGLBL ( 'VPUT', <VARNAME>, <VALUE> ) *
* VALUE = REXXGLBL ( 'VGET', <VARNAME> ) *
* VARNAME IS NAME OF VARIABLE TO BE SET OR RETRIEVED. *
* VALUE IS THE VALUE OF THE VARIABLE, PASSED AS A *
* PARAMETER FOR 'VPUT', RETURNED AS FUNCTION *
* RESULT FORT 'VGET'. *
* USED. *
* NOTE: NULL IS RETURNED IF NOT FOUND. *
* ------------------------------ *
* *
* ALL VARIABLE NAMES AND VALUES ARE TRANSLATED TO UPPER-CASE*
* ----------------------------------------------------------*
* *
* RETURN CODES: *
* 0 - VARIABLE SUCCESSFULLY STORED OR RETRIEVED. *
* 12 - PARAMETER LIST ERROR (VGET OR VPUT). *
* 16 - INSUFFICIENT STORAGE (VPUT). *
* *
* AUTHOR: PETER FLASS *
* NYS LEGISLATIVE BILL DRAFTING COMMISSION *
* JANUARY, 1992. *
* *
* ATTRIBUTES: AMODE(31), RMODE(ANY). PROBLEM STATE, UNAUTHORIZED. *
* *
* STATUS: TSO/E REXX 2.2 *
* NO TSO OR OPERATING SYSTEM DEPENDENCIES. *
* *
* TO DO: GARBAGE COLLECTION ROUTINE SHOULD BE EXTENDED TO *
* COMPRESS GLOBAL STORAGE AREAS, CONSOLIDATING ALLOCATED *
* AREAS AND ELIMINATING 'WASTE' SPACE. *
* *
* MODIFICATIONS: *
* *
***********************************************************************
EJECT
REGS , EQUATE REGISTERS
GLBLPTR EQU R8 A(GLOBAL VARIABLES)
EVALPTR EQU R9 A(EVALBLOCK)
LINK EQU R10 INTERNAL LINKAGE
ENVPTR EQU R11 A(ENVRION. BLOCK)
BASE EQU R12 MY BASE REGISTER
*
* ------ CHANGE THE FOLLOWING EQUATE TO ADJUST SIZE OF GLOBAL TABLE - *
GLBLSIZE EQU 4096 SIZE OF GLOBAL VARIABLE TABLE *
* ------------------------------------------------------------------- *
EJECT
REXXGLBL CSECT
B BEGIN-*(,R15) SKIP COMMENT
REXXGLBL VERSION 1.0
BEGIN EQU *
SAVE (14,12) SAVE REGISTERS
LR BASE,R15 ESTABLISH BASE REGISTER
USING REXXGLBL,BASE .
LR ENVPTR,R0 SAVE A(ENVBLOCK)
USING ENVBLOCK,ENVPTR .
LR R4,R1 SAVE A(EFPL)
GETMAIN RU,LV=WRKLEN,LOC=ANY SET UP SAVEAREAS
ST R1,8(,R13) .
ST R13,4(,R1) .
LR R13,R1 .
USING WRKAREA,R13 .
ST R4,EFPLADDR SAVE A(EFPL)
XC SAVERC,SAVERC CLEAR RETURN CODE
MVC BANNER,VERSION FLAG WORKAREA FOR DUMPS
MVI FLAG,X'00' CLEAR SWITCHES
SPACE 3
* ------------------------------------------------------- *
* LOCATE TSO CONTROL BLOCK ANCHOR *
* ------------------------------------------------------- *
LOADCHK TYPE=CHECK,EPLOC=ANCHNAME,ERRET=ABEND,LOAD=YES
LR R3,R0 GET ADDRESS OF ANCHOR
ICM GLBLPTR,X'F',LBDVGLBL-LBDTSO(R3) TEST GLOBAL ADDR
BNZ HAVEGLBL .. OKAY, WE GOT ONE
GETMAIN RU,LV=GLBLSIZE,SP=78,LOC=ANY GET STG FOR GLOBALS
ST R1,LBDVGLBL-LBDTSO(R3) SAVE ACQUIRED AREA ADDR
LR GLBLPTR,R1 LOAD A(ACQUIRED STORAGE)
USING GLBLHDR,GLBLPTR BASE POINTS TO HEADER
LR R0,GLBLPTR CLEAR ACQUIRED STORAGE
LH R1,=AL2(GLBLSIZE) .
SR R14,R14 .
SR R15,R15 .
MVCL R0,R14 .
MVC GLBLID,=CL8'*GLOBAL*' .
LA R1,GLBLHDRE INITIALIZE FREE BLOCK PTR
ST R1,FFREE .
MVC LFREE-NAMED+GLBLHDRE,=AL2(GLBLSIZE-GLBLHDRL) X
INITIALIZE FREE BLOCK SIZE
HAVEGLBL EQU * WE HAVE REQUIRED CTL. BLOCKS
EJECT
L R2,EFPLEVAL-EFPL(,R4) A(EVALBLOCK_ADDR)
L EVALPTR,0(,R2) A(EVALBLOCK)
USING EVALBLOCK,EVALPTR
ST EVALPTR,EVALBLKA SAVE ADDRESS
XC EVALBLOCK_EVLEN,EVALBLOCK_EVLEN X
ZERO RETURNED VALUE LENGTH
L R4,EFPLARG-EFPL(,R4) LOAD A(ARGTB)
LM R14,R15,ARGTABLE_ARGSTRING_PTR-ARGTABLE_ENTRY(R4) X
LOAD 1ST ARG ADDRESS AND LENGTH
CH R15,=H'4' TEST ARGUMENT LENGTH
BL ERROR .. TOO SHORT
MVC DWD(4),0(R14) GET ARG VALUE
TR DWD(4),UPCASE FORCE UPPER-CASE
CLC =C'RESE',DWD Q/ IS FUNCTION 'RESET'?
BE RESET .. YES
CLC =C'VGET',DWD Q/ IS FUNCTION 'VGET'?
BE GETARG2 .. YES
CLC =C'VPUT',DWD Q/ IS IT 'VPUT'?
BNE ERROR .. NO, MUST BE ERROR
OI FLAG,FVPUT .. YES, SET FLAG
*
GETARG2 EQU * PROCESS 2ND ARGUMENT
LA R4,ARGTABLE_NEXT-ARGTABLE_ENTRY(,R4) X
POINT TO SECOND ARG
CLC ARGTABLE_ARGSTRING_PTR-ARGTABLE_ENTRY(4,R4),=4X'FF' X
Q/ 2ND ARG PRESENT?
BE ERROR .. NO, ERROR
LM R14,R15,ARGTABLE_ARGSTRING_PTR-ARGTABLE_ENTRY(R4) X
LOAD 2ND ARG INFO
LTR R15,R15 TEST ARGUMENT LENGTH
BNP ERROR .. TOO SHORT
CH R15,=H'32' TEST FOR MAX (IMPL. DEF'D.)
BH ERROR .. TOO LONG
STC R15,VARNAMEL SAVE LENGTH OF NAME
BCTR R15,0 SAVE VARIABLE NAME VALUE
EX R15,MVC1 *** MVC VARNAME(*-*),0(R14)
EX R15,TR1 *** TR VARNAME(*-*),UPCASE
CLI VARNAME,C'A' MINIMAL EDITING
BL ERROR .
CLI VARNAME,C'Z' .
BH ERROR .
TM FLAG,FVPUT Q/ IS THIS 'VPUT'?
BNO SKIPARG3 .. NO, NO 3RD ARG
*
LA R4,ARGTABLE_NEXT-ARGTABLE_ENTRY(,R4) X
POINT TO THIRD ARG
CLC ARGTABLE_ARGSTRING_PTR-ARGTABLE_ENTRY(4,R4),=4X'FF' X
Q/ 3RD ARG PRESENT?
BE ERROR .. NO, ERROR
LM R14,R15,ARGTABLE_ARGSTRING_PTR-ARGTABLE_ENTRY(R4) X
LOAD 3RD ARG INFO
LTR R15,R15 TEST ARGUMENT LENGTH
BM ERROR .. TOO SHORT
CH R15,=H'255' TEST FOR MAX (IMPL. DEF'D.)
BH ERROR .. TOO LONG
STC R15,VARVALUL SAVE LENGTH OF VALUE
BCTR R15,0 SAVE VARIABLE VALUE
EX R15,MVC2 *** MVC VARVALU(*-*),0(R14)
EX R15,TR2 *** TR VARVALU(*-*),UPCASE
SKIPARG3 EQU * BYPASS 3RD ARGUMENT PROCESS
EJECT
***********************************************************************
* CHASE VARIABLE CHAIN TO LOCATE CURRENT VARIABLE *
***********************************************************************
LA R3,FVAR POINT TO NAME LIST ANCHOR
VARCHN EQU * CHASE ALLOCATED CHAIN
LR R0,R3 SAVE PREVIOUS ADDRESS
ICM R3,X'F',ANAME-NAMED(R3) LOAD PTR->NEXT_NAME
BZ VARCHN1 .. NOT FOUND
CLC LNAME-NAMED(1,R3),VARNAMEL Q/ CAN THIS BE NAME?
BNE VARCHN .. NO, TRY NEXT
SR R2,R2 .. YES, COMPARE
IC R2,LNAME-NAMED(,R3) .
BCTR R2,0 .
EX R2,CLC1 *** CLC VARNAME(*-*),NAMETXT-NAMED(R3)
BNE VARCHN .. NOT THIS VARIABLE
*
VARCHN1 EQU * VARIABLE FOUND OR END-OF-CHAIN
TM FLAG,FVPUT Q/ IS THIS 'VPUT'?
BNO RETVAR .. NO
SR R4,R4 COMPUTE REQUIRED ENTRY LENGTH IN R4
SR R1,R1 .
IC R4,VARNAMEL .
IC R1,VARVALUL .
LA R4,NAMETXT-NAMED(R1,R4) .
MVI WASTE,X'00' INIT 'WASTED' BYTE COUNT
* 'WASTE' INDICATES UNUSED BYTES IN VARIABLE ENTRY
* TOO SHORT TO HOLD FREE BLOCK HEADER.
LTR R3,R3 Q/ WAS VARIABLE FOUND?
BZ VARCHN3 .. NO
SPACE 1
***********************************************************************
* CHECK REPLACEMENT SIZE *
***********************************************************************
SR R2,R2 COMPUTE EXISTING ENTRY LENGTH IN R2
SR R1,R1 .
IC R2,LNAME-NAMED(,R3) .
IC R1,LVALU-NAMED(,R3) .
LA R1,NAMETXT-NAMED(R2,R1) .
IC R2,LWASTE-NAMED(,R3) .
LA R2,0(R1,R2) .
CR R4,R2 Q/ NEW ENTRY SAME SIZE OR SMALLER?
BNH VARCHN2 .. YES, UPDATE IN PLACE
LR R1,R0 LOAD PREVIOUS BLOCK ADDRESS
MVC ANAME-NAMED(4,R1),ANAME-NAMED(R3) X
UNLINK FROM ALLOCATED CHAIN
STH R2,LFREE-NAMED(,R3) LINK ONTO FREE CHAIN
MVI XFREE-NAMED(R3),FREESPC .
MVC AFREE-NAMED(4,R3),FFREE .
ST R3,FFREE .
B VARCHN3
VARCHN2 EQU * VALUE TO BE REPLACED
LR R0,R2 COMPUTE NEW WASTE VALUE
SR R0,R4 (CURRENT - NEW)
STC R0,WASTE STORE WASTED BYTE COUNT
CH R0,=AL2(FREESIZE) Q/ ENOUGH WASTE FOR FREE BLOCK
BL VALUPD .. NO
LA R15,0(R4,R3) .. YES, POINT TO FREE AREA
STH R0,LFREE-NAMED(,R15) STORE FREE BLK LEN
MVI XFREE-NAMED(R15),FREESPC .
MVC AFREE-NAMED(4,R15),FFREE UPDATE CHAIN
ST R15,FFREE .
MVI WASTE,X'00' NOW, NO WASTE
B VALUPD GO UPDATE IN PLACE
VARCHN3 EQU * FIND NEW SPACE FOR VARIABLE
*
EJECT
***********************************************************************
* CHASE FREE BLOCK CHAIN TO FIND SPACE FOR VARIABLE *
***********************************************************************
FRECHN EQU * CHASE FREE BLOCK CHAIN
LA R3,FFREE POINT TO NAME FREE LIST ANCHOR
FRECHN0 EQU *
LR R1,R3 SAVE PREVIOUS ADDRESS
ICM R3,X'F',AFREE-NAMED(R3) LOAD PTR->NEXT_FREE_BLOCK
BZ NOSTG .. END OF FREE CHAIN, ERROR
CH R4,LFREE-NAMED(R3) Q/ CAN THIS BLOCK HOLD VARIABLE?
BH FRECHN0 .. NO, EXAMINE NEXT
*
LH R0,LFREE-NAMED(,R3) EXAMINE REM FREE BLK SIZE
SR R0,R4 .
CH R0,=AL2(FREESIZE) Q/ CAN WE HOLD FREE BLK PTR
BNL FRECHN1 .. YES
MVC AFREE-NAMED(4,R1),AFREE-NAMED(R3) NO, UPDATE CHAIN
STC R0,WASTE STORE WASTED BYTE COUNT
B NEWVAR
FRECHN1 EQU * SPLIT FREE BLOCK
LA R15,0(R4,R3) POINT TO SPLIT AREA
ST R15,AFREE-NAMED(,R1) UPDATE FREE CHAIN
MVC AFREE-NAMED(4,R15),AFREE-NAMED(R3)
STH R0,LFREE-NAMED(,R15) .
MVI XFREE-NAMED(R15),FREESPC .
*
EJECT
***********************************************************************
* CHAIN ON NEW VARIABLE BLOCK *
***********************************************************************
NEWVAR EQU * SPLIT FREE BLOCK
MVC ANAME-NAMED(4,R3),FVAR UPDATE VAR CHAIN
ST R3,FVAR .
MVI XNAME-NAMED(R3),NAMESPC INDICATE USED VARIABLE AREA
SR R15,R15 GET NAME LENGTH
IC R15,VARNAMEL .
STC R15,LNAME-NAMED(,R3) STORE INTO AREA
BCTR R15,0 MOVE VARIABLE NAME
LA R14,NAMETXT-NAMED(,R3) .
EX R15,MVC4 *** MVC 0(*-*,R14),VARNAME
SPACE 1
***********************************************************************
* UPDATE VARIABLE VALUE *
***********************************************************************
VALUPD EQU * UPDATE VALUE
MVC LWASTE-NAMED(1,R3),WASTE WASTED BYTE COUNT
* -------- DO NOT SEPARATE THE FOLLOWING INSTRUCTIONS -----+
SR R15,R15 GET VALUE LENGTH |
ICM R15,B'0001',VARVALUL . |
STC R15,LVALU-NAMED(,R3) . |
BZ EXIT .. LENGTH=ZERO |
* ---------------------------------------------------------+
SR R14,R14 POINT TO VALUE
IC R14,LNAME-NAMED(,R3) .
LA R14,NAMETXT-NAMED(R14,R3) .
BCTR R15,0 MOVE VARIABLE VALUE
EX R15,MVC5 *** MVC 0(*-*,R14),VARVALU
B EXIT EXIT
*
EJECT
RETVAR EQU * RETURN VALUE TO CALLER
LTR R3,R3 Q/ WAS VARIABLE FOUND?
BZ NOTFND .. NO, EXIT
SR R1,R1 GET VALUE LENGTH
IC R1,LVALU-NAMED(,R3) .
ST R1,EVALBLOCK_EVLEN SAVE INTO EVALBLOCK
L R1,EVALBLOCK_EVSIZE COMPUTE L'(RETURNED DATA)
SLL R1,3 EVSIZE * 8
SH R1,=H'16' - 16.
C R1,EVALBLOCK_EVLEN COMPARE TO L'VARIABLE
BNL RETURN .. OKAY TO USE
LA R1,IRXRLT_P1 .. TOO SMALL
ST R1,PLIST BUILD PARAMETER LIST
LA R1,IRXRLT_P2 FOR IRXRLT 'GETBLOCK'
ST R1,PLIST+4 .
LA R1,IRXRLT_P3 .
ST R1,PLIST+8 .
OI PLIST+8,X'80' .
MVC IRXRLT_P1,=CL8'GETBLOCK' .
XC IRXRLT_P2,IRXRLT_P2 .
MVC IRXRLT_P3,EVALBLOCK_EVLEN .
LA R1,PLIST GET NEW EVALBLOCK
L R15,VECTABLE LOAD A(REXX VECTOR TABLE)
L R15,IRXRLT-IRXEXTE(,R15) A(IRXRLT)
BALR R14,R15 CALL IRXRLT
LTR R15,R15 TEST RETURN CODE FROM 'GETBLOCK'
BZ RETVAR1 .. OKAY
LA R15,X'100'(,R15) .. ERROR FORCE TO 1XX
ST R15,SAVERC SAVE RETURN CODE
B EXIT AND DIE
RETVAR1 EQU *
L R2,IRXRLT_P2 GET A(NEW_EVALBLOCK)
L R1,EFPLADDR PUT A(NEW_EVALBLOCK) IN EFPL
ST R2,EFPLEVAL-EFPL(,R1) .
MVC EVALBLOCK_EVLEN,IRXRLT_P3 MOVE LENGTH
*
RETURN EQU * STASH RESULT VALUE OR NULL
L R1,EVALBLOCK_EVLEN LOAD L'VARIABLE
LTR R1,R1 Q/ VALUE PRESENT?
BNP EXIT .. NO
BCTR R1,0 .. YES, SET UP FOR 'EX'
LA R14,EVALBLOCK_EVDATA POINT TO RESULT FIELD
SR R15,R15 POINT TO SOURCE FIELD
IC R15,LNAME-NAMED(,R3) .
LA R15,NAMETXT-NAMED(R15,R3) .
EX R1,MVC3 *** MVC 0(*-*,R14),0(R15) X
MOVE VALUE TO RESULT FIELD
B EXIT RETURN TO CALLER
*
EJECT
ABEND EQU * *** TEMPORARY CODE ***
DC H'0'
ERROR MVI SAVERC+3,12 PARAMETER ERROR, RC=12
B EXIT
NOTFND MVI SAVERC+3,0 VARIABLE NOT FOUND, RC=0
B EXIT EXIT W/NULL RETURNED VALUE
SPACE 3
NOSTG EQU * SHORT-ON-STORAGE
TM FLAG,FSOS Q/ RECURSION ON SOS?
BNO GARBCOLL .. NO, DO GARB COLL
MVI SAVERC+3,16 SHORT-ON-STORAGE, RC=16
B EXIT
SPACE 3
***********************************************************************
* GARBAGE COLLECTION AT SHORT-ON-STORAGE *
* *
* GARBAGE COLLECTION ROUTINE WALKS THE GLOBAL STORAGE AREA *
* IN ADDRESS SEQUENCE. ADJACENT FREE AREAS ARE CONSOLIDATED *
* INTO ONE AND THE FREE BLOCK CHAIN IS REBUILT. *
* *
* CODE SHOULD BE ADDED TO COMPRESS ALLOCATED AREAS BY *
* ELIMINATING 'WASTE' BYTES AND CONSOLIDATING ALL ALLOCATED *
* AREAS AT ONE END OF GLOBAL STORAGE, RESULTING IN ONE *
* LARGE FREE AREA. *
* *
***********************************************************************
GARBCOLL EQU * GARBAGE COLLECTION
OI FLAG,FSOS PREVENT RECURSION
LA R1,GLBLHDRE POINT TO FIRST AREA
LR R0,GLBLPTR COMPUTE ENDING ADDRESS
AH R0,=AL2(GLBLSIZE) .
SR R15,R15 NO FREE AREAS YET
ST R15,FFREE .
GARB01 EQU *
CR R1,R0 Q/ ARE WE DONE?
BNL GARB09 .. YES
CLI XFREE-NAMED(R1),FREESPC Q/ IS THIS FREE BLOCK?
BNE GARB03 .. NO
LTR R15,R15 Q/ PRECEEDING BLOCK FREE?
BNZ GARB02 .. YES
LR R15,R1 SAVE THIS BLOCK ADDRESS
MVC AFREE-NAMED(4,R1),FFREE RE-LINK CHAIN
ST R1,FFREE .
AH R1,LFREE-NAMED(,R1) BUMP TO NEXT BLOCK
B GARB01 AND EXAMINE IT
GARB02 EQU * COMBINE ADJACENT FREE BLOCKS
LH R1,LFREE-NAMED(,R1) GET THIS BLOCK LENGTH
AH R1,LFREE-NAMED(,R15) ADD TO PREV
STH R1,LFREE-NAMED(,R15) STORE UPDATED LENGTH
LA R1,0(R15,R1) POINT TO NEXT BLOCK
B GARB01 AND EXAMINE IT
GARB03 EQU * SKIP OVER ALLOCATED BLOCK
SR R15,R15 CLEAR WORK REGISTERS
SR R14,R14 .
IC R15,LNAME-NAMED(,R1) COMPUTE ENTRY LENGTH
IC R14,LVALU-NAMED(,R1) .
LA R15,NAMETXT-NAMED(R14,R15) .
IC R14,LWASTE-NAMED(,R1) .
AR R15,R14 .
AR R1,R15 POINT TO NEXT ENTRY
SR R15,R15 ZERO FREE BLOCK POINTER
B GARB01 GO LOOK AT NEXT ENTRY
GARB09 EQU * GARBAGE COLLECTION EXIT
B FRECHN TRY FREE CHAIN AGAIN
SPACE 3
***********************************************************************
* RESET ALL GLOBAL VARIABLES (DEBUGGING ONLY) *
***********************************************************************
RESET EQU * RE-INITIALIZE GLOBAL STORAGE
LR R0,GLBLPTR CLEAR ACQUIRED STORAGE
LH R1,=AL2(GLBLSIZE) .
SR R14,R14 .
SR R15,R15 .
MVCL R0,R14 .
MVC GLBLID,=CL8'*GLOBAL*' .
LA R1,GLBLHDRE INITIALIZE FREE BLOCK PTR
ST R1,FFREE .
MVC LFREE-NAMED+GLBLHDRE,=AL2(GLBLSIZE-GLBLHDRL) X
INITIALIZE FREE BLOCK SIZE
B EXIT
*
DROP EVALPTR
DROP GLBLPTR
*
EJECT
* ------------------------------------------------------- *
* RETURN TO CALLER *
* ------------------------------------------------------- *
EXIT EQU * EXIT TO CALLER
L R2,SAVERC GET FINAL RETURN CODE
LR R1,R13 SET UP FOR FREEMAIN
L R13,4(,R13) .
FREEMAIN RU,LV=WRKLEN,A=(1) FREE WORKAREA
LR R15,R2 SET RETURN CODE
RETURN (14,12),RC=(15) RETURN TO REXX
*
SPACE 3
* EXECUTED INSTRUCTIONS
MVC1 MVC VARNAME(*-*),0(R14) SAVE VARIABLE NAME
TR1 TR VARNAME(*-*),UPCASE TRANSLATE NAME TO UPPER-CASE
MVC2 MVC VARVALU(*-*),0(R14) SAVE VARIABLE VALUE
TR2 TR VARVALU(*-*),UPCASE TRANSLATE VALUE TO UPPER-CASE
CLC1 CLC VARNAME(*-*),NAMETXT-NAMED(R3)
MVC3 MVC 0(*-*,R14),0(R15) MOVE VAR VALUE TO EVALBLOCK
MVC4 MVC 0(*-*,R14),VARNAME MOVE VAR NAME TO GLOBAL STORAGE
MVC5 MVC 0(*-*,R14),VARVALU MOVE VAR VALUE TO GLOBAL STORAGE
*
SPACE 3
UPCASE DS 0F UPPER-CASE TRANSLATE TABLE
DC 256AL1(*-UPCASE) EBCDIC CHARACTER SET
ORG UPCASE+X'81' LOWER-CASE 'A'
DC C'ABCDEFGHI'
ORG UPCASE+X'91' LOWER-CASE 'J'
DC C'JKLMNOPQR'
ORG UPCASE+X'A2' LOWER-CASE 'S'
DC C'STUVWXYZ'
ORG ,
*
ANCHNAME DC CL8'LBDTSO ' NAME OF ANCHOR MODULE
*
LTORG , HERE BE LITERALS
*
EJECT
***********************************************************************
* MODULE WORKING STORAGE *
***********************************************************************
WRKAREA DSECT , FUNCTION WORKAREA
SAVEAREA DS 9D STANDARD OS SAVEAREA
BANNER DS CL8 EYECATCHER FOR DUMP
*
DWD DS D DOUBLEWORD WORKAREA
VECTABLE DS A A(REXX VECTOR TABLE)
ENVBLK DS A A(REXX ENVIRONMENT BLOCK)
EVALBLKA DS A A(EVALBLOCK)
EFPLADDR DS A A(EFPL)
SAVERC DS F RETURN CODE SAVEAREA
*
PLIST DS 4A PARAM LIST FOR IRXRLT
*
IRXRLT_PARMS DS 0F PARAMETERS FOR IRXRLT
IRXRLT_P1 DS CL8 .. COMMAND
IRXRLT_P2 DS A .. A(NEW_EVALBLOCK)
IRXRLT_P3 DS F .. L'(NEW_EVALBLOCK)
*
FLAG DS BL1 FLAG BYTE
FVPUT EQU X'80' 1... .... 'VPUT' SPECIFIED
FVGET EQU X'7F' 0... .... 'VGET' SPECIFIED
FSOS EQU X'40' .1.. .... GARB COLL RECV'RY
*
VARNAMEL DS FL1 L'VARIABLE NAME
VARNAME DS CL32 SAVED VARIABLE NAME
VARVALUL DS FL1 L'VARIABLE VALUE
VARVALU DS CL255 SAVED VARIABLE VALUE
WASTE DS FL1 'WASTED' BYTE COUNT
*
WRKLEN EQU *-WRKAREA LENGTH OF WORKAREA
EJECT
COPY LBDTSOD
*
***********************************************************************
* GLOBAL STORAGE DEFINITIONS *
***********************************************************************
NAMED DSECT , ALLOCATED ENTRY DSECT *
ANAME DS A A(NEXT_NAME) OR ZERO *
XNAME DS BL1 SPACE TYPE INDICATOR ' *
NAMESPC EQU X'80' 1... .... THIS IS NAME AREA *
* . . . THE PRECEEDING FIELDS SHOULD MATCH FREE BLOCK DEF. . . . . . *
LNAME DS FL1 L'NAME
LVALU DS FL1 L'VALUE
LWASTE DS FL1 L'WASTE DUE TO FRAGMENTATION
NAMETXT DS 0C NAME TEXT BEGINS HERE
*
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . *
ORG NAMED FREE BLOCK DSECT *
AFREE DS A A(NEXT_FREE_BLOCK) *
XFREE DS BL1 SPACE TYPE INDICATOR *
FREESPC EQU X'00' 0... .... THIS IS FREE AREA *
* . . . THE PRECEEDING FIELDS SHOULD MATCH ALLOCATED BLOCK DEF . . . *
LFREE DS H LENGTH OF THIS BLOCK
FREESTUF EQU * REMAINDER OF FREE BLOCK BEGINS HERE
FREESIZE EQU *-NAMED L'FREE STORAGE HEADER
ORG , RESET ORIGIN
*
***********************************************************************
*
GLBLHDR DSECT CHAIN ANCHORS
GLBLID DS CL8 CONTROL BLOCK ID '*GLOBAL*'
FVAR DS A VARIABLE CHAIN ANCHOR
FFREE DS A FREE BLOCK CHAIN ANCHOR
GLBLHDRE EQU * END-OF-HEADER
GLBLHDRL EQU *-GLBLHDR L'HEADER
***********************************************************************
*
SPACE 3
PRINT GEN
EJECT
IRXEFPL , COPY EXT FUNCT. PARAM LIST
EJECT
IRXARGTB , COPY ARG LIST FORMAT
EJECT
IRXENVB , COPY ENV. BLOCK DSECT
EJECT
IRXEVALB , COPY EVALUATION BLOCK DSECT
EJECT
IRXEXTE , COPY VECTOR TABLE DSECT
PRINT NOGEN
LOADCHK TYPE=DSECT DSECTS FOR LOADCHK
END
//* --------------------------------------------------------------- ***
//LKED EXEC PGM=IEWL, X
// PARM='XREF,LET,LIST,NCAL,RENT,REUS,REFR', X
// COND=(8,LT,ASM)
//********************************************************************
//** LINKEDIT PROGRAM *
//********************************************************************
//SYSPRINT DD SYSOUT=X,CHARS=(GT12)
//SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1))
//SYSLIB DD DSN=SYSTEMS.LINKLIB,DISP=SHR
// DD DSN=FLASS.PF.LOAD,DISP=SHR
// DD DSN=SYS1.LINKLIB,DISP=SHR
//SYSLMOD DD DISP=SHR,DSN=SYSTEMS.LINKLIB
//SYSLIN DD DSN=&&ASM,DISP=(OLD,DELETE)
// DD *
MODE AMODE(31),RMODE(ANY)
NAME REXXGLBL(R)
//* --------------------------------------------------------------- ***
./ ADD NAME=VERSION
.* VERSION MACRO REVISED 6/7/91 - PRF PTF1
MACRO
&NAME VERSION &VERSLVL
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . *
VERSION EQU * PROGRAM LEVEL INFORMATION PTF1
DC CL8'&NAME' MODULE NAME
DC CL1' '
DC CL8'VERSION '
DC CL8'&VERSLVL' VERSION/LEVEL
DC CL8'&SYSDATE' ASSEMBLY DATE
DC C' '
DC CL5'&SYSTIME' ASSEMBLY TIME
VERSIONL EQU *-VERSION PTF1
DS 0H ALIGNMENT PTF1
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . *
SPACE 3
MEND
l...@osreq48.rockwell.com
>> We cannot do everything at once, <<
>> but we can do something at once. Calvin Coolidge <<
*---------------------------------------------------------------------*
* Lionel B. Dyck | Rockwell TSO: WCC1.$A1238 *
* M/C: 110-SE28 | Rockwell VM: ISCEMS(LBDYCK) *
* Comnet: 797-1125 | IBMLink: ROK2027 *
* Phone: (310) 797-1125 | IBM Mail: USROKNTN *
* Fax: (310) 797-2056 | Internet: l...@osreq48.Rockwell.Com *
*---------------------------------------------------------------------*
l...@osreq48.rockwell.com
On Tue, 7 Dec 1993 08:45:56 EST , Peter Flass <FL...@LBDRSCS.BITNET>
writes:
> On Mon, 6 Dec 1993 21:57:47 -0500 Stephen E. Bacher said:
> >
> >>There is also an ibm
> >>requirement to enhance rexx so it supports global variables. This would
> >>allow you do as you require.
> >
> >Is there? If so, it requires enhancing the OS. MVS/TSO has had a
> >glaring lack of this feature since day one. And it would be fairly
> >easy to do it, given the nature of the TSO control block structure.
> >I've had a proposal for implementing such a thing sitting around for a
> >long time, but never put it into effect due to lack of potential
> >interest in an increasingly non-mainframe-oriented world.
> >
> I implemented "global variables" for TSO/REXX some time ago via an external
> function call and it was relatively simple. I can't understand why IBM's
> dragging their feet, but I decided I couldn't wait.
>
> =====================================================================
> = PETER FLASS FLASS@LBDRSCS =
> = Systems Programmer tel (518)458-5114 =
> = NYS Legislative Bill Drafting Commission =
> = 1450 Western Ave. =
> = Albany, NY 12203 =
> =====================================================================
l...@osreq48.rockwell.com
release it to us 'unwashed masses'.
Thanks.
Keefe Hayes
of variables is to use the mvs name/token services.
keefe