Well, you might want to include AXREXXL in your getmained area. On Thu, 5 Sep 2019 08:21:05 -0500 Sebastian Welton <[email protected]> wrote:
:>Definitely, see below (formatting is probably stuffed I'm afraid), compiled
using the standard ASMAC found in PROCLIB (no overriding ASMAOPT or other
parameters) and link with RENT, INCLUDE(ASMAOBJ) and SETCODE AC(0). I have now
found out where the original came from and am doing further research on it as
well, thanks.
:>
:>Sebastian.
:>
:>GENMSGTR TITLE 'GENMSGTR'
:>GENMSGTR CSECT
:>GENMSGTR RMODE 31
:>GENMSGTR AMODE ANY
:>R0 EQU 0 REGISTER 0
:>R1 EQU 1 REGISTER 1
:>R2 EQU 2 REGISTER 2
:>R3 EQU 3 REGISTER 3
:>R4 EQU 4 REGISTER 4
:>R5 EQU 5 REGISTER 5
:>R6 EQU 6 REGISTER 6
:>R7 EQU 7 REGISTER 7
:>R8 EQU 8 REGISTER 8
:>R9 EQU 9 REGISTER 9
:>R10 EQU 10 REGISTER 10
:>R11 EQU 11 REGISTER 11
:>R12 EQU 12 REGISTER 12
:>R13 EQU 13 REGISTER 13
:>R14 EQU 14 REGISTER 14
:>R15 EQU 15 REGISTER 15
:> STM R14,R12,12(R13) SAVE CALLERS REGS
:> USING GENMSGTR,R12 ADDRESSABILITY
:> LR R12,R15 SET BASE ADDRESS
:> LR R2,R1 SAVE PARAMETER REGISTER
:> L R1,=A(@DSECTE-@DSECT) CALCULATE STORAGE LENGTH
:> STORAGE OBTAIN,LENGTH=(R1) GET SOME VS
:> ST R1,8(,R13) FORWARD POINTER
:> ST R13,4(,R1) BACKWARD POINTER
:> LR R13,R1 POINT TO SAVE AREA
:> LR R1,R2 RESTORE PARAMETER REGISTER
:> B EYEBALLE SKIP CONSTANTS
:>EYEBALL DS 0H
:> DC C'=====> GENMSGTR D=&SYSDATE T=&SYSTIME ROB ===='
:>EYEBALLE DS 0H
:> USING @DSECT,R13 ADDRESSABILITY
:> SR R11,R11 CLEAR RETURN CODE
:>*
:> L R9,0(,R1) POINT TO CTXT
:> USING CTXT,R9 ADDRESSABILITY
:> L R8,CTXTTXPN WAS THERE A MESSAGE?
:> LTR R8,R8 SINGLE OR FIRST LINE WTO?
:> BNZ RETURN NO - EXIT
:> L R8,CTXTTXPJ POINT TO MAJOR
:> USING CTXTATTR,R8 ADDRESSABILITY
:> LA R7,@ARGLST POINT TO AXREXX ARG LIST
:> USING AXRARGLST,R7 ADDRESSABILITY
:> MVI @ARGLST,X'00'
:> MVC @ARGLST+1(AXRARGLST_LEN),@ARGLST
:> MVC AXRARGLSTID,=A(AXRARGLSTACRO) MOVE IN EYECATCHER
:> LA R1,AXRARGLSTCURVER VERSION 0
:> ST R1,AXRARGLSTVER SAVE VERSION
:> LA R1,1 SINGLE ARGUMENT
:> STH R1,AXRARGLSTNUMBER SAVE NUMBER OF ARGUMENTS
:> SLR R1,R1 CLEAR ERROR FLAG
:> STH R1,AXRARGLSTENTRYINERROR SAVE ERROR FLAG
:> ST R1,AXRARGLSTRSV2 SAVE RESERVED VALUE
:> LA R6,@ARG1 POINT TO ARGUMENT 1
:> USING AXRARGENTRY,R6 ADDRESSABILITY
:> MVI @ARG1,X'00'
:> MVC @ARG1+1(AXRARGENTRY_LEN),@ARG1
:> SLR R1,R1 CLEAR ADDRESS HIGH
:> ST R1,AXRARGADDRHIGH SAVE ADDRESS HIGH
:> LA R1,CTXTTMSG POINT TO WTO
:> ST R1,AXRARGADDRLOW SAVE ADDRESS
:> LA R1,L'CTXTTMSG POINT TO LENGTH OF WTO
:> ST R1,AXRARGLENGTH SAVE LENGTH
:> MVI AXRARGTYPE,AXRARGTYPECHAR SET ARGUMENT TYPE TO CHAR
:> OI AXRARGINPUTFLGS1,AXRARGINPUT FLAG INPUT ARGUMENT
:> AXREXX REQUEST=EXECUTE, X
:> SECURITY=BYAXRUSER, X
:> TSO=YES, X
:> SYNC=NO, X
:> NAME=VNAME, X
:> REXXARGS=@ARGLST, X
:> MF=(E,AXREXXL) INITIATE SYSTEM REXX PGM
:> LTR R15,R15 HOW DID WE DO?
:> BZ RETURN GREAT!
:> ABEND 1,REASON=(R0) ABEND REASON IS REXX REASON
:> LA R11,8 SET BAD RETURN CODE
:>*
:>RETURN DS 0H
:> LR R1,R13 POINT TO AREA TO BE FREED
:> L R13,4(,R13) RSTR CALLING PROGS SAVE AREA
:> L R0,=A(@DSECTE-@DSECT) GET STORAGE LENGTH
:> STORAGE RELEASE,LENGTH=(R0),ADDR=(R1) FREE UP THE VS
:> LR R15,R11 MOVE RETURN CODE TO R15
:> L R14,12(,R13) RESTORE CALLERS R14
:> LM R0,R12,20(R13) RESTORE CALLERS R0-R12
:> BR R14 RETURN TO CALLER
:>* STORAGE DEFINITIONS *
:> DS 0D
:>VNAME DC CL8'GENMSGRX NAME OF SYSTEM REXX PROGRAM
:>*
:> LTORG ,
:>* DUMMY SECTIONS *
:>@DSECT DSECT
:>@DSECTSA DS 18F
:>*------*
:>@ARGLST DS CL(AXRARGLST_LEN) ARGLIST LENGTH
:>@ARG1 DS CL(AXRARGENTRY_LEN) ARGENTRY LENGTH
:>RC DS 1F
:>*------*
:>@DSECTE EQU *
:>*
:> AXREXX MF=(L,AXREXXL)
:>*
:> AXRZARG DSECT=YES,AXRARGLST=YES,AXRARGENTRY=YES,AXRDIAG=YES
:>*
:> IEZVX100
:>*
:> END
--
Binyamin Dissen <[email protected]>
http://www.dissensoftware.com
Director, Dissen Software, Bar & Grill - Israel
Should you use the mailblocks package and expect a response from me,
you should preauthorize the dissensoftware.com domain.
I very rarely bother responding to challenge/response systems,
especially those from irresponsible companies.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
