[Info-vax] COBOL example $MGBLSC

[Brian Schenkenberger]

On 2023-09-07 23:21:18 +0000, Arne Vajhj said:

> 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

I have the SYS$MGBLSC working... at least, in the debugger.  I defined 
a test global section with two longwords.

1,-1
2,-2
3,-3
etc.,-etc.
0,0

I have the following for the global section's element definition:

LINKAGE SECTION.

01 GLOBAL-SECTION.
  02 ELEMENT OCCURS 2000 TIMES.
    03 A        PIC S9(9) COMP.
    03 B        PIC S9(9) COMP.

and the procedure...

PROCEDURE DIVISION USING GLOBAL_SECTION.
PARAGRAPH-MAIN.
    PERFORM PARAGRAPH-ENTER THRU PARAGRAPH-EXIT
            VARYING I FROM 1 BY 1 UNTIL A(I) = 0 AND B(I) = 0.
PARAGRAPH-ENTER.
    DISPLAY "First[" I "]: " A(I) "  Second[" I "]: " B(I).
PARAGRAPH-EXIT.
    EXIT.
END PROGRAM GBLSEC.

In the debugger, A(I) and B(I) show me the values but DISPLAY pukes on 
them. It'd be great too if there was a way to DISPLAY them in HEX but 
just getting it to DISPLAY without regurgitaing garbage would be great.

I also can't figure out how to define GLOBA:L-SECTION ELEMENT OCCURS * 
TIMES. The number of the elements in the global section could be quite 
variable.