[Info-vax] COBOL example $MGBLSC

[Brian Schenkenberger]

On 2023-09-07 20:51:20 +0000, Arne Vajhj said:

> 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

Thanks for trying.  I'm totally lost. Why are you DISPLAYing in the 
data segment? FUNCTION ORD?

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?