× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Calling Proc1 from COBOL would be done like:

CALL LINKAGE PRC "proc1" USING
BY CONTENT pParm1
OMITTED
BY VALUE pParm3
BY VALUE pParm4
BY VALUE pParm5
BY REFERENCE pParm6
.....
RETURNING A-Variable-Name.

LIKEDS can be done with a combination of IS TYPEDEF and TYPE. To borrow from a COBOL example in the APIs at Work book (available at finer stores ;) and note that I do have an interest in the book...) where I'm defining a structure like a QSYSINC include:

WORKING-STORAGE SECTION.
COPY QMHRTVM OF QSYSINC-QCBLLESRC REPLACING
==01 QMH-RTVM-RTVM0300==
BY ==01 QMH-RTVM-RTVM0300 IS TYPEDEF==.

and then:

01 Receiver.
05 Base TYPE QMH-RTVM-RTVM0300.
05 Variable PIC X(10000).

And from another COBOL example in APIs at Work -- this showing more calls, parameter passing, sub-programs, typedefs, and more...

PROCESS NOMONOPRC.

IDENTIFICATION DIVISION.
PROGRAM-ID. FigC9_9.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 Conv-Desc GLOBAL.
05 cdBins PIC S9(9) BINARY OCCURS 13.
01 Input-Variable1 PIC X(50)
VALUE "Some variable data".
01 Input-Variable2 PIC X(50) VALUE "More data".
01 Length-Input PIC S9(9) BINARY.
01 Output-Value PIC X(4096) GLOBAL.
01 Length-Output PIC S9(9) BINARY.
01 Rtn-Cde PIC S9(9) BINARY.
01 Message-Wait PIC X(01).

PROCEDURE DIVISION.
MAIN-LINE.
* Set our input CCSID to 37 and desired output as 819
CALL "SetConvert" USING BY VALUE 37,
BY VALUE 819,
RETURNING Rtn-Cde.
IF Rtn-Cde = 0
COMPUTE Length-Input =
FUNCTION LENGTH( FUNCTION TRIMR( Input-Variable1))
CALL "Convert" USING BY VALUE
ADDRESS OF Input-Variable1,
BY VALUE Length-Input,
RETURNING Length-Output
IF Length-Output = -1
DISPLAY "Text conversion error found"
ACCEPT Message-Wait
ELSE
* Output-Value now contains the converted field with a length of
* Length-Output bytes
CONTINUE
END-IF

* Convert another variable
COMPUTE Length-Input =
FUNCTION LENGTH( FUNCTION TRIMR( Input-Variable2))
CALL "Convert" USING BY VALUE
ADDRESS OF Input-Variable2,
BY VALUE Length-Input,
RETURNING Length-Output
IF Length-Output = -1
DISPLAY "Text conversion error found"
ACCEPT Message-Wait
ELSE
CONTINUE
END-IF

* Close the cd after all conversions are done

CALL LINKAGE PRC "iconv_close" USING
BY REFERENCE Conv-Desc,
RETURNING Rtn-Cde
ELSE
DISPLAY "Error setting up conversion"
ACCEPT Message-Wait
END-IF
STOP RUN.

IDENTIFICATION DIVISION.
PROGRAM-ID. "SetConvert".

DATA DIVISION.
WORKING-STORAGE SECTION.
COPY QTQICONV OF QSYSINC-QCBLLESRC REPLACING
==01 QTQCODE== BY ==01 QTQCODE IS TYPEDEF==.

01 Rtn-Cde PIC S9(9) BINARY.
01 From-Code.
05 From-Environment TYPE QTQCODE.
01 To-Code.
05 To-Environment TYPE QTQCODE.

LINKAGE SECTION.
01 Input-CCSID PIC S9(9) BINARY.
01 Output-CCSID PIC S9(9) BINARY.

PROCEDURE DIVISION USING BY VALUE Input-CCSID,
BY VALUE Output-CCSID,
RETURNING Rtn-Cde.
MAIN-LINE.
MOVE LOW-VALUES TO From-Code.
MOVE LOW-VALUES TO To-Code.
MOVE Input-CCSID TO CCSID OF From-Code.
MOVE Output-CCSID TO CCSID OF To-Code.
CALL LINKAGE PRC "QtqIconvOpen" USING
BY REFERENCE To-Code,
BY REFERENCE From-Code,
RETURNING Conv-Desc.
IF cdBins(1) = -1
DISPLAY "Open error"
MOVE -1 TO Rtn-Cde
ELSE
MOVE 0 TO Rtn-Cde
END-IF
GOBACK.

END PROGRAM "SetConvert".

IDENTIFICATION DIVISION.
PROGRAM-ID. "Convert".

DATA DIVISION.
WORKING-STORAGE SECTION.
01 Rtn-Cde PIC S9(9) BINARY.
01 Output-Buffer-Pointer POINTER.
01 Input-Bytes-Left PIC S9(9) BINARY.
01 Output-Bytes-Left PIC S9(9) BINARY.

LINKAGE SECTION.
01 Input-Pointer POINTER.
01 Input-Length PIC S9(9) BINARY.

PROCEDURE DIVISION USING BY VALUE Input-Pointer,
BY VALUE Input-Length,
RETURNING Rtn-Cde.
MAIN-LINE.

* Reset Input-Bytes-Left, Output-Bytes-Left, and
* Output-Buffer-Pointer each time as iconv updates these values

MOVE Input-Length TO Input-Bytes-Left.
MOVE LENGTH OF Output-Value TO Output-Bytes-Left.
SET Output-Buffer-Pointer TO ADDRESS OF Output-Value.
CALL LINKAGE PRC "iconv" USING
BY VALUE Conv-Desc,
BY VALUE ADDRESS OF Input-Pointer,
BY REFERENCE Input-Bytes-Left,
BY VALUE ADDRESS OF
Output-Buffer-Pointer,
BY REFERENCE Output-Bytes-Left,
RETURNING Rtn-Cde.
IF Rtn-Cde = -1
DISPLAY "Conv Error"
ELSE
COMPUTE Rtn-Cde = LENGTH OF Output-Value -
Output-Bytes-Left
END-IF
GOBACK.

END PROGRAM "Convert".

END PROGRAM FIGC9_9.

Bruce Vining
http://www.brucevining.com/


Aaron Bartell <albartell@xxxxxxxxx> wrote:
I didn't know if COBOL would ever enter my life again, but it has and I am
doing some wheel spinning. I am working with a shop that is on the iSeries
and has zero RPG coders so I am trying to span the gap and understand some
basic ILE syntax priciples in the COBOL environment.

Below I have contructed a very busy sub procedure that takes on a variety of
parameter passing features. I have been reading the Infocenter COBOL
manuals but the going is slow and I am wondering if somebody could give me a
kick start and convert it into COBOL??

Basically I need to know:
1) How to build proc1 into a COBOL prototype that could be /COPY'd into a
COBOL program
2) How to build a data structure and then reference it using something
similar to our LIKEDS (I saw COBOL has the LIKE keyword and I have been
playing around with that).
3) Show an example of calling this sub procedure from a mainline.
4) Show an example of defining/coding a local sub procedure.

D proc1 pr 3 0
D pParm1 10a const
D pParm2 15P 0 value options(*omit)
D pParm3 z value
D pParm4 128a value varying
D pParm5 n value
D pParm6 like(fld1)
D pParm7 likeds(ds1) options(*nopass)
D pParm8 * procptr value options(*nopass)

D fld1 s 10a

D ds1 ds qualified inz
D fld1 1024a varying
D fld2 10a
D fld3 10i 0
D fld4 30a varying

Makes me with they had a "COBOL for RPG programmers" book :-)

Thanks in advance,
Aaron Bartell
http://mowyourlawn.com



As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.