[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