Joined: 16 Apr 2008 Posts: 104 Location: South Carolina
I see plenty of articles for Cobol programs calling Rexx programs, but little for the opposite. I am writing a cobol program to read a vsam file, read a certain amount of records, write each record to a DD then return to the rexx program that does an ISPF browse or edit on the DD. Here is what I have:
SELECT VSAM-FILE ASSIGN TO SYSTBASE
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS VSAM-KEY
FILE STATUS IS WS-VSAM-STATUS.
SELECT OUTPUT-FILE ASSIGN TO PRXYDSN.
Joined: 16 Apr 2008 Posts: 104 Location: South Carolina
I did some more research and read that I need reference my linkage to macro IRXEFPL. This is what is passed in R1, and the fifth address in the linkage is the address to the argument array, IRXARGTB, passed from the Rexx program. So here is what I have:
Code:
FILE-CONTROL.
SELECT VSAM-FILE ASSIGN TO SYSTBASE
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS VSAM-KEY
FILE STATUS IS WS-VSAM-STATUS.
SELECT OUTPUT-FILE ASSIGN TO PRXYDSN.
IF WS-VSAM-STATUS = '00'
CONTINUE
ELSE
DISPLAY WS-VSAM-STATUS
GO TO XXXX-MAIN-SECTION-EXIT
END-IF
WRITE OUTPUT-REC FROM IRXEFPL
SET ADDRESS OF IRXARGTB TO EFPL-ARG-TABLE
SET WS-ADDRESS TO EFPL-ARG-TABLE
SET ADDRESS OF IRXARGTB TO WS-ADDRESS
WRITE OUTPUT-REC FROM IRXARGTB
SET ADDRESS OF PARM-LIST-DATA TO WS-ADDRESS
WRITE OUTPUT-REC FROM PARM-LIST-DATA
SET ADDRESS OF PARM-KEY TO ARG-TBL-ADDR
WRITE OUTPUT-REC FROM PARM-KEY
ADD 8 TO WS-ADDRESS-NUM
SET ADDRESS OF IRXARGTB TO WS-ADDRESS
WRITE OUTPUT-REC FROM IRXARGTB
SET ADDRESS OF PARM-KEY TO ARG-TBL-ADDR
WRITE OUTPUT-REC FROM PARM-KEY
ADD 8 TO WS-ADDRESS-NUM
SET ADDRESS OF IRXARGTB TO WS-ADDRESS
WRITE OUTPUT-REC FROM IRXARGTB
SET ADDRESS OF PARM-KEY TO ARG-TBL-ADDR
WRITE OUTPUT-REC FROM PARM-KEY
MOVE PARM-KEY TO VSAM-KEY
* READ VSAM WITH KEY
PERFORM XXXX-READ-VSAM-KEY
IF WS-VSAM-STATUS = '00'
CONTINUE
ELSE
DISPLAY WS-VSAM-STATUS
GO TO XXXX-MAIN-SECTION-EXIT
END-IF
* READ VSAM SEQUENTIALLY
PERFORM XXXX-READ-VSAM-NEXT
UNTIL VSAM-NON-SEQ-KEY > NON-SEQ-KEY
When I try LINKPGM, I receive the same results. I am using RXVSAM as a model:
Code:
MAIN100 DS 0H
IAZXJSAB READ,JOBID=MYJOBID
SPACE
LR R1,R4 RESTORE PARM (R1) FROM SAVED REG
USING EFPL,R1 SET ADDRESSABILITY
ST R1,EFPL@ KEEP POINTER AROUND JUST IN CASE
LA R6,OURSHVBL INIT -> TO OUR SHARED VAR BLK
USING SHVBLOCK,R6 SET ADDRESSABILITY
L R8,EFPLARG GET -> TO ARGUMENT LIST
USING ARGTABLE_ENTRY,R8 SET ADDRESSABILITY
DROP R1 DROP EFPL ADDRESSABILITY
SPACE
MVC VSAMEMSG(VMSGLEN),VMSGINIT INIT VSAM ERROR MSG AREA
MVC NTMSG(NTMSGLEN),NTMSGINI INIT NAME/TOKEN MSG AREA
SPACE
SETMSG MSG=M$ALLOK INITIALIZE RETURN MESSAGE
MVC VSAMER15,=CL2'00' INITIALIZE VSAM REG 15 RC
SPACE
*R5 already -> environment block -- loaded from R0 at entry to RXVSAM
SPACE
USING ENVBLOCK,R5 SET ADDRESSABILITY TO ENVBLOCK @ANZ
ST R5,ENVB@ SAVE ENVIRONMENT BLOCK POINTER @ANZ
L R5,ENVBLOCK_IRXEXTE EXTERNAL ENTRY VECTOR ADDRESS @ANZ
USING IRXEXTE,R5 SET ADDRESSABILITY TO EXTE @ANZ
L R0,IRXEXCOM IRXEXCOM ROUTINE ADDRESS @ANZ
ST R0,IRXEXCO@ SAVE ROUTINE ADDRESS FOR LATER USE
DROP R5 DROP ENVBLOCK ADDRESSABILITY @ANZ
SPACE
L R5,ARGTABLE_ARGSTRING_PTR GET ADDR OF REQUEST ARG
C R5,=X'FFFFFFFF' IF ADDRESS IS ALL X'FF'
BE MAIN400 NO ARG PASSED,ERROR
SPACE
LA R8,ARGTABLE_NEXT BUMP TO NEXT ARGUMENT (DDNAME)
LM R3,R4,ARGTABLE_ARGSTRING_PTR GET ADDR & LENGTH OF ARG
C R3,=X'FFFFFFFF' IF ADDRESS IS ALL X'FF'
BE MAIN400 NO ARG PASSED,ERROR
SPACE
CH R4,=H'8' IF DDNAME LONGER THAN 8 CHARACTERS
BH MAIN400 IT'S AN ERROR
LA R8,ARGTABLE_NEXT BUMP TO "NEXT" ARGUMENT
MVC DDNAME,SPACES INIT BLANK PADDED DDNAME
BCTR R4,0 DECR IN PREPARATION FOR EXECUTED MVC
EX R4,MOVEDDNM SET OUR COPY OF THE DDNAME
SPACE
MVC IEANTNA1,MYJOBID CREATE "NAME" FOR NAME / TOKEN
MVI IEANTNA1,C'X' SERVICES: JOBID (1ST CHAR ALWAYS "X")
MVC IEANTNA2,DDNAME PLUS DDNAME
XC IEANTTOK,IEANTTOK CLEAR OUT "TOKEN"
MVC IEANTLVL,=AL4(IEANT_TASK_LEVEL) TASK LVL FOR ALL REQ
EJECT
It is called as such:
Code:
RC = RXVSAM(DDNAME, FUNCTION, PARAM1, PARAM2)
enrico-sorichetti wrote:
there are also a few topics here ( if You only had cared to search )
I thought with all of the code and examples that I have provided, that it would prove the due diligence on my part.
Joined: 16 Apr 2008 Posts: 104 Location: South Carolina
I finished my program, and I wanted to post a sample of what is involved. There isn't much available on the internet for doing this kind of procedure.
To call the assembler:
Code:
TEST_RC = TEST(ARG1,ARG2,ARG3)
Assembler:
Code:
REGEQU
*
TEST CSECT
TEST AMODE 31
TEST RMODE ANY
STM R14,R12,12(R13) SAVE REGISTERS
LR R12,R15 ESTABLISH BASE
USING TEST,R12
ST R13,SAVEAREA+4 CHAIN SAVEAREA
LR R15,R13
LA R13,SAVEAREA
*
**********************************************************************
* PARSE PARM LIST
**********************************************************************
MVC RC,=CL2'00' INITIALIZE RETURN CODE
USING EFPL,R1 ADDRESS FUNCTION PARM LIST
L R8,EFPLARG LOAD ARGUMENT LIST ADDRESS
L R2,EFPLEVAL GET EVAL BLOCK ADDR
L R2,0(,R2) POINT TO EVALBLOCK
USING EVALBLOCK,R2 ADDRESS EVALUATION BLOCK
DROP R1 DROP PARM LIST
*
CHECKARG DS 0H
USING ARGTABLE_ENTRY,R8
BAL R6,GETARG
MVC ARG1,ARGUMENT
BAL R6,GETARG
MVC ARG2,ARGUMENT
BAL R6,GETARG
MVC ARG3,ARGUMENT
B PROCESS
*
GETARG DS 0H
LM R3,R4,ARGTABLE_ARGSTRING_PTR GET ADDR OF OUTPUT FILE
C R3,=X'FFFFFFFF' IF ADDRESS IS ALL X'FF'
BE INVLDARG
BCTR R4,0
MVC ARGUMENT,SPACES
EX R4,MOVEARG
ST R4,ARGLEN
LA R8,ARGTABLE_NEXT BUMP TO NEXT ARGUMENT
BR R6
*
MOVEARG MVC ARGUMENT(0),0(R3)
*
PROCESS DS 0H
...
EXIT DS 0H
*
MVC EVALBLOCK_EVLEN,=F'2' PREPARE REXX RETURN
MVC EVALBLOCK_EVDATA(2),RC
DROP R2
*
L R13,SAVEAREA+4
LM R14,R12,12(R13)
SR R15,R15 SET REGISTER TO 0
BR R14
*
***********************************************************************
* VARIABLES
***********************************************************************
SAVEAREA DS 18F
RC DS F
REASON DS F
*
ARGUMENT DS CL80
ARGLEN DS F'0'
SPACES DC CL80' '
LTORG
*
IRXEFPL
IRXARGTB
IRXEVALB
DCBD
END
the biggest misunderstanding here is on the solution provided VS the question asked
REXX calling COBOL
which means something like.... given a COBOL program
call it from REXX passing some parameters and receiving back some results
the program being a general use program.
the solution and code snippet posted relates to something completely different
the thing is coded following the rules and convention of REXX external functions...
where the methodology for parameter passing back and forth is disctated by the REXX conventions
a program written in this way can interact only with REXX
just to straighten things out and not have people understand things wrong!