[Info-vax] COBOL example $MGBLSC

[Arne Vajhøj]

On 9/7/2023 1:44 PM, Brian Schenkenberger wrote:
> On 2023-09-07 14:36:31 +0000, Brian Schenkenberger said:
>> I need to tell a customer how to map, assuming this is even possible, 
>> a global section into which I write data for them. They only do COBOL. 
>> :( Is this possibe? How does one reference the data once mapped in the 
>> expanded region? I've tried to make heads or tails of COBOL but I get 
>> totally lost in the PICs.
>>
>> If only somebody would do what Jim Duff did for calling system 
>> services with C but using COBOL. So very few examples exist.
> 
> OK.  I've gotten this far but now I have no idea how to access the data 
> in the mapped region.
> 
> 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 ADDRESS-1 PIC S9(09) COMP VALUE IS 512.
>   02 ADDRESS-2 PIC S9(09) COMP VALUE IS 512.
> 
> 01 RETADR.
>   02 ADDRESS-1 PIC S9(09) COMP VALUE IS 0.
>   02 ADDRESS-2 PIC S9(09) COMP VALUE IS 0.
> 
> PROCEDURE DIVISION.
> 0-BEGIN.
> 
>     ADD SEC$M_EXPREG TO FLAGS.
>     ADD SEC$M_PERM TO FLAGS.
>     ADD SEC$M_SYSGBL 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".
> 
> *** NOW WHAT???
> 
> 0-END.
>     STOP RUN.

I think you will need a hack.

:-)

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.

Arne