Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
A callable Assembler sub-program is another method -
| Code: |
*PROCESS RENT PROGRAM IS RE-ENTRANT
***********************************************************************
* THIS SUB-PROGRAM IS CALLED, USING THE FOLLOWING SYNTAX - *
* *
* 03 WS-GETUSER PIC X(08) VALUE 'GETUSER'. *
* 03 WS-GETUSER-PARM. *
* 05 WS-GETUSER-ID PIC X(08). *
* 05 FILLER PIC X(72). *
* *
* CALL WS-GETUSER USING WS-GETUSER-PARM. *
* *
* UPON RETURN, IF THE COBOL 'RETURN-CODE' SPECIAL-REGISTER IS *
* ZERO, THEN 'WS-GETUSER-ID' WILL CONTAIN THE VALUE OF THE *
* JOB-CARD 'USER'. OTHERWISE, THERE WAS A PROBLEM EXTRACTING *
* THE USERID FROM THE CONTROL-BLOCKS. *
***********************************************************************
PRINT NOGEN SUPPRESS MACRO EXPANSION
CVT DSECT=YES,LIST=YES, CVT-DSECT (PREFIX=YES) X
PREFIX=YES
IHAACEE ACEE-DSECT
IHAASXB ASXB-DSECT
IHAASCB ASCB-DSECT
PRINT GEN ACTIVATE MACRO EXPANSION
PRMDSECT DSECT
USING *,R7 INFORM ASSEMBLER
PRMUSER DS CL8 USERID RETURNED TO CALLER
PRMREGSA DS XL72 REGISTER SAVEAREA
GETUSER CSECT
USING *,R3 INFORM ASSEMBLER
SAVE (14,12) SAVE REGISTERS
LA R3,0(,R15) CSECT ADDRESSABILITY
L R7,0(,R1) PARM-ADDRESSABILITY
XC PRMREGSA,PRMREGSA ENSURE X'00'S
LA R15,PRMREGSA POINT TO OUR SAVEAREA
ST R13,4(,R15) BACKWARD-CHAIN
ST R15,8(,R13) FORWARD-CHAIN
LR R13,R15 POINT TO OUR SAVEAREA
L R1,CVTPTR CVT-ADDRESS
L R1,0(,R1) ADDRESS OF TCB POINTERS
L R1,12(,R1) POINT TO 'ASCB'
L R1,ASCBASXB-ASCB(,R1) CHAIN TO 'ASXB' ADDRESS
L R1,ASXBSENV-ASXB(,R1) CHAIN TO 'ACEE' ADDRESS
USING ACEE,R1 INFORM ASSEMBLER
MVC PRMUSER,ACEEUSRI POPULATE PARM-USERID
DROP R1 DROP ADDRESSABILITY
XR R15,R15 ENSURE X'00'S
CLC PRMUSER,=CL8' ' EXCEEDS SPACES?
BH RTN2CLLR YES, RETURN TO THE CALLER
LA R15,16 SET NON-ZERO RETURN-CODE
RTN2CLLR EQU *
L R13,4(,R13) RESTORE CALLER'S R13
XC PRMREGSA,PRMREGSA ENSURE X'00'S
RETURN (14,12),RC=(15) RESTORE AND RETURN
LTORG ,
YREGS ,
GETUSER AMODE 31
GETUSER RMODE ANY
END , END 'GETUSER'
|
HTH.... |
|
