[Info-vax] COBOL example $MGBLSC

[Arne Vajhøj]

On 9/7/2023 6:26 PM, Brian Schenkenberger wrote:
> On 2023-09-07 20:51:20 +0000, Arne Vajhj 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