[Info-vax] COBOL example $MGBLSC
John Reagan
xyzzy1959 at gmail.com
Thu Sep 7 21:50:30 EDT 2023
On Thursday, September 7, 2023 at 7:21:22 PM UTC-4, Arne Vajhøj wrote:
> On 9/7/2023 6:26 PM, Brian Schenkenberger wrote:
> > On 2023-09-07 20:51:20 +0000, Arne Vajh j said:
> >> For inspiration:
> >>
> >> $ type main.cob
> >> IDENTIFICATION DIVISION.
> >> PROGRAM-ID. SYSMGBLS.
> >> ENVIRONMENT DIVISION.
> >> DATA DIVISION.
> >> WORKING-STORAGE SECTION.
> >>
> >> *** EXTERNAL VALUE from SEC.MAR ($SECDEF GLOBAL)
> >> *** $ MACRO SEC.MAR
> >> *** $ LINK SYSMGBLSC,SEC
> >>
> >> 01 SEC$M_EXPREG PIC S9(09) COMP VALUE IS EXTERNAL SEC$M_EXPREG.
> >> 01 SEC$M_PERM PIC S9(09) COMP VALUE IS EXTERNAL SEC$M_PERM.
> >> 01 SEC$M_SYSGBL PIC S9(09) COMP VALUE IS EXTERNAL SEC$M_SYSGBL.
> >>
> >> 01 FLAGS PIC S9(09) COMP VALUE IS 0.
> >>
> >> 01 RETSTS PIC S9(09) COMP VALUE IS 0.
> >> 01 GBLSECNAM PIC X(21) VALUE IS "A-GLOBAL-SECTION-NAME".
> >>
> >> 01 INADR.
> >> 02 IN-ADDRESS-1 PIC S9(09) COMP VALUE IS 512.
> >> 02 IN-ADDRESS-2 PIC S9(09) COMP VALUE IS 512.
> >>
> >> 01 RETADR.
> >> 02 RET-ADDRESS-1 PIC S9(09) COMP VALUE IS 0.
> >> 02 RET-ADDRESS-2 PIC S9(09) COMP VALUE IS 0.
> >>
> >> 01 DATA-LEN PIC S9(09) COMP VALUE IS 81920.
> >>
> >> PROCEDURE DIVISION.
> >> 0-BEGIN.
> >>
> >> ADD SEC$M_EXPREG TO FLAGS.
> >>
> >> CALL "SYS$MGBLSC" USING BY REFERENCE INADR,
> >> BY REFERENCE RETADR,
> >> OMITTED,
> >> BY VALUE FLAGS,
> >> BY DESCRIPTOR GBLSECNAM,
> >> OMITTED,
> >> OMITTED
> >> GIVING RETSTS.
> >>
> >> IF RETSTS IS FAILURE CALL "LIB$SIGNAL" USING BY VALUE RETSTS.
> >>
> >> IF RETSTS IS SUCCESS DISPLAY "GLOBAL SECTION MAPPED".
> >>
> >> CALL "BRIAN" USING BY REFERENCE DATA-LEN, BY VALUE RET-ADDRESS-1.
> >>
> >> 0-END.
> >> STOP RUN.
> >> $ type brian.cob
> >> IDENTIFICATION DIVISION.
> >> PROGRAM-ID.BRIAN.
> >> *
> >> DATA DIVISION.
> >> WORKING-STORAGE SECTION.
> >> 01 NBYT2 PIC S9(9) DISPLAY.
> >> 01 CVAL PIC S9(9) DISPLAY.
> >> LINKAGE SECTION.
> >> 01 NBYT PIC 9(9) COMP.
> >> 01 BLOB.
> >> 03 BYT PIC X OCCURS 1000000 TIMES.
> >> *
> >> PROCEDURE DIVISION USING NBYT BLOB.
> >> ACK-PARAGRAPH.
> >> MOVE NBYT TO NBYT2
> >> DISPLAY NBYT2
> >> MOVE FUNCTION ORD(BYT(1)) TO CVAL
> >> DISPLAY CVAL.
> >> END PROGRAM BRIAN.
> >> $ @cob
> >> $ cob main
> >> $ cob brian
> >> $ link main + brian
> >> $ run main
> >> GLOBAL SECTION MAPPED
> >> 00008192{
> >> 00000017H
> >>
> >> And yes - the first byte of that global section I setup for the test
> >> has value of 177.
> >
> > Thanks for trying. I'm totally lost. Why are you DISPLAYing in the data
> > segment? FUNCTION ORD?
> The routine BRIAN just displays the length passed and
> the first byte of the data passed.
>
> It is to verify that the call is working.
>
> The hack is this:
> >> 01 RETADR.
> >> 02 RET-ADDRESS-1 PIC S9(09) COMP VALUE IS 0.
> >> 02 RET-ADDRESS-2 PIC S9(09) COMP VALUE IS 0.
> >> CALL "SYS$MGBLSC" USING BY REFERENCE INADR,
> >> BY REFERENCE RETADR,
> RET-ADDRESS-1 and RET_ADDRESS-2 are lonmgwords
> that after the call to MGBLSC contains start
> and end address of the mapped area.
> >> CALL "BRIAN" USING BY REFERENCE DATA-LEN, BY VALUE RET-ADDRESS-1.
> Now we call BRIAN with second argument being a longword passed
> by value.
>
> But a longword that contains an address.
> >> LINKAGE SECTION.
> >> 01 NBYT PIC 9(9) COMP.
> >> 01 BLOB.
> >> 03 BYT PIC X OCCURS 1000000 TIMES.
> >> *
> >> PROCEDURE DIVISION USING NBYT BLOB.
> BRIAN expect a structure BLOB (containing a byte array here,
> but it could be anything) passed by reference.
>
> SO the trick is to pass a longword by value containing the
> address to a routine expecting a structure by reference.
> > This "language" has a POINTER feature but I can't figure out how to use
> > it. Isn't there an example ANYWHERE on the net where $EXPREG or
> > LIB$GET_VM is used in COBOL?
> I believe POINTER is just a container.
>
> Arne
Yep, POINTER is one of the few COBOL 2002 keywords in the compiler.
Just a container of the correct size (64-bits) but you can't really operate on
it. You can just pass it to some other routine (in another language that CAN
operate on such things)
More information about the Info-vax
mailing list