Copyright (c) Digital Equipment Corporation 1985. All rights reserved

OVERVIEW:

The program in this article demonstrates the use of $CRMPSC to create a
global section.  In general, the program creates a sequential file, maps
that file into its working space, modifies it, then updates the pages on
disk. For a general overview of global sections, please refer to the
VAX/VMS Version 4 "System Services Reference Manual," (Sept 84), section
11.6.

CAUTION:  This sample program has been tested using PL/I V2.3 on
VAX/VMS V4.1.  However, we cannot guarantee its effectiveness because
of the possibility of error in transmitting or implementing it.  It is
meant to be used as a template for writing your own program, and it may
require modification for use on your system.

The length of this article is approximately 210 lines.


PROGRAM EXAMPLE:

ST:     PROCEDURE OPTIONS(MAIN);

/* To execute this program, you will need to use the following DCL
   commands. The important feature is the link options file. Since we
   are defining our own storage for the section, we must insure that
   the storage is page aligned. To do this, we must use a link options
   file.
                $ PLI CRMPSC
                $ LINK CRMPSC,SYS$INPUT/OPT
                  PSECT_ATTR=GBLSEC,PAGE

                $ RUN CRMPSC                            */

        %INCLUDE SYS$CRMPSC;
        %INCLUDE SYS$DGBLSC;
        %INCLUDE SYS$UPDSEC;
        %INCLUDE SYS$WAITFR;
        %INCLUDE SYS$OPEN;
        %INCLUDE $STSDEF;
        %INCLUDE $FABDEF;
        %INCLUDE $SECDEF;

%ZERO_OUT: PROCEDURE( BLOCK ) RETURNS( CHARACTER );
        DECLARE BLOCK CHARACTER;
        RETURN( 'BEGIN;' ||
                'DCL LIB$MOVC5 EXTERNAL ENTRY( ' ||
                    'BIN(15), ANY, BIN(7), BIN(15), ANY );' ||
                'CALL LIB$MOVC5( 0, 0, 0, ' ||
                    'SIZE(' || BLOCK || '),' || BLOCK || ');' ||
                'END' );   /* EACH INSTANCE HAS FINAL SEMI-COLON */
END;

/* The following arguments are for $CRMPSC system service call */

        DCL INADR(2)    POINTER;
        DCL RETADR(2)   POINTER;
        DCL FLAGS       BIT(32) INIT(BIT(0,32)) ALIGNED;
        DCL GSDNAM      CHARACTER(14)  INIT('CAT_IN_THE_HAT');
        DCL CHAN        FIXED BIN(31);
        DCL IOSB(4)     FIXED BIN(15);
        DCL EFN         FIXED BIN(31);


/* The following union structure is used to load an address in a non-
   pointer declared field. Fields in the file access block (FAB) that
   need addresses are not declared as pointer data types in the include
   file. This will be corrected in a future release of PL/I. */

        DCL 01 PNTDEF UNION,
                02 POINT        POINTER,
                02 POINT_BIN    FIXED BIN(31);

/* Declare some simple variables */

        DCL FABPNT      POINTER;
        DCL RABPNT      POINTER;
        DCL DATAFILE    FILE;
        DCL FILE_TITLE  CHARACTER(13) INIT('MYSECTION.DAT');
        DCL 01 AREA UNION GLOBALDEF(GBLSEC),
               02 STUFF(64)     CHARACTER(1) INIT((64)('Z')),
               02 SECTION(24)   CHARACTER(64);

        DCL I           FIXED BIN(31);
        DCL ANSWER      CHARACTER(1);

/* Begin the code section. Set up some ON units */

        ON ENDFILE(SYSIN) GOTO END;

/* Create the file and load data into it for the map section */

        OPEN FILE(DATAFILE) TITLE(FILE_TITLE) RECORD OUTPUT
                 ENVIRONMENT(FIXED_LENGTH_RECORDS,
                             MAXIMUM_RECORD_SIZE(64));

        DO I = 1 TO 24;
           WRITE FILE(DATAFILE) FROM(STUFF);
        END;

        CLOSE FILE(DATAFILE);

/* Allocate the FAB and open the file */

        ALLOCATE FABDEF SET(FABPNT);
        ZERO_OUT(FABPNT->FABDEF);
        FABPNT->FAB$B_BID = FAB$C_BID;
        FABPNT->FAB$B_BLN = FAB$C_BLN;
        POINT = ADDR(FILE_TITLE);
        FABPNT->FAB$L_FNA = POINT_BIN;
        FABPNT->FAB$B_FNS = 13;
        FABPNT->FAB$V_UFO = '1'B1;
        FABPNT->FAB$V_UPD = '1'B1;
        FABPNT->FAB$V_PUT = '1'B1;
        FABPNT->FAB$V_GET = '1'B1;

        STS$VALUE = SYS$OPEN(FABPNT->FAB$B_BID,,);
        IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);

/* Retrieve the Channel */

        CHAN = FABPNT->FAB$L_STV;

/* Create the global section. If you create a permanent section, you
   will need the privilege PRMGBL. */

        INADR(1) = ADDR(SECTION(1));
        INADR(2) = ADDR(SECTION(24));

ASK:    PUT SKIP EDIT('Do you wish to create a temporary',
                      ' or permanent section, enter P or T ')
                      (A(34),A(36));
        GET EDIT(ANSWER) (A(1));

        IF ANSWER = 'P' | ANSWER = 'p' THEN
                FLAGS = SEC$M_WRT | SEC$M_GBL | SEC$M_PERM;
        ELSE
           IF ANSWER = 'T' | ANSWER = 't' THEN
                FLAGS = SEC$M_WRT | SEC$M_GBL;
           ELSE GOTO ASK;

        STS$VALUE = SYS$CRMPSC(INADR,
                               RETADR, ,
                               FLAGS,
                               GSDNAM, , ,
                               CHAN, , , , );

        IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);

/* Display the first line in the section */

        PUT SKIP(2) LIST('The first line in the section is: ');
        PUT SKIP LIST(SECTION(1));

        PUT SKIP LIST(' ');
      PUT SKIP LIST('Input a character to use in updating the section: ');
        GET EDIT (STUFF(1)) (A(1));

        DO I = 2 TO 64;
           STUFF(I) = STUFF(1);
        END;
        DO I = 2 TO 24;
           SECTION(I) = SECTION(1);
        END;

        PUT SKIP(2) LIST('New line in section is: ');
        PUT SKIP LIST(SECTION(1));

/* Update the section */

        EFN = 1;
        STS$VALUE = SYS$UPDSEC(INADR,
                               RETADR, , ,
                               EFN,
                               IOSB, , );

        IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);
        STS$VALUE = SYS$WAITFR(EFN);
        IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);
        IF IOSB(1) > 1 THEN SIGNAL VAXCONDITION(STS$VALUE);

/* Section update complete */

        PUT SKIP(2) LIST('Update is complete');

END:    IF ANSWER = 'T' | ANSWER = 't' THEN GOTO TERM;

        PUT SKIP(2) LIST('Do you wish to delete the section? ');
        GET LIST(ANSWER);

        IF ANSWER = 'N' | ANSWER = 'n' THEN GOTO TERM;

        PUT SKIP(2) LIST('Beginning clean up');
        STS$VALUE = SYS$DGBLSC(,GSDNAM,);
        IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);
        PUT SKIP LIST('Clean up done');

TERM:   END ST;

buy online or call 1.800.AT.COMPAQ