%title 'Area Example #1';
%sbttl 'Header';

%Replace True By '1'b;
%Replace False By '0'b;
%Replace Work_Area_Size By 42;

Area_Example: Procedure Options(Main);
/*
 *  Sample program using storage allocation in areas.
 *
 *  This program reads a single "command" from the
 *  SysIn file, which is 'Save' followed by a list of
 *  floating-point numbers, or 'Display'.
 *
 *  If 'Save' was specified, the numbers are placed in
 *  a offset-linked list in a based area until the
 *  area is full.  When this occurs, the area is
 *  flushed to the data file and emptied with EMPTY().
 *
 *  If a 'Display' operation was specified, the records
 *  are read back in from the data file and displayed.
 */

    Declare
        Data_File Sequential Record File,

        String Character(80) Varying,

        1 List_Entry_Type Based,
              2 Next Offset,
              2 Value Float Binary,

        Work_Area_Base Automatic Pointer,
        Work_Area Area(Work_Area_Size) Based(Work_Area_Base);
%page;
%sbttl 'Save_Data';
    Save_Data: Procedure(A);
    /*
     *  This procedure reads in the list of numbers
     *  and builds a linked list in the area.  If the
     *  offset to the next entry is Null(), then this
     *  is the last offset in the area.
     */

        Declare
            A Area(*),

            (Initial_Offset, Current_Offset, Temp) Automatic Offset(A),
            1 List_Entry Like(List_Entry_Type) Based(Current_Offset),

            Data Float Binary,

            Data_File_Open Bit Aligned Initial(False),

            Eof_SysIn Bit Aligned Initial(False);

        Initialize_Area: Procedure;
        /*
         *  Code to initialize or re-initialize the
         *  work area.
         */

            A = Empty();
            Initial_Offset, Current_Offset = Null();

            End Initialize_Area;


        Write_Data: Procedure;
        /*
         *  This procedure actually outputs the
         *  data for a given area.
         */
            If ^Data_File_Open
            Then Do;
                Open File(Data_File) Output Title('TEMP.DAT')
                    Environment(Maximum_Record_Size(Size(A)));
                Data_File_Open = True;
                End;

            Write File(Data_File) From(Initial_Offset);
            Write File(Data_File) From(A);

            End Write_Data;

        On Area Begin;
        /*
         *  This condition handler checks to see if the
         *  AREA condition was raised due to a full area.
         *  If it was, then the area is written out and
         *  emptied with EMPTY(). If it was due to some other Area
         *  condition, then we resignal it, since all of
         *  the other area conditions are non-recoverable.
         */

            /*
             *  Include the PL/I-specific status values
             *  and the VMS condition handling declarations.
             */
            %Include $PLIDEF;
            %Include $CHFDEF;
            If OnCode() ~= PLI$_AREA_FULL
            Then
                Call Resignal();
            Else Do;

                Chf$ArgPtr = OnArgsList();
                /*
                 * This shows how to check for a specific
                 * area.  Note that this assumes that
                 * the condition vector is:
                 *
                 *  PLI$_AREA
                 *  0
                 *  PLI$_AREA_FULL
                 *  1
                 *  address of full area
                 */
                If Chf$Sig_Arg(4) = PosInt(Addr(A))
                Then Do;
                    /*
                     *  Write out the data.  Note that
                     *  the allocation will be retried
                     *  on a normal return from the
                     *  On-unit.
                     */
                    Call Write_Data;
                    Call Initialize_Area;
                    End;

                Else
                    Call Resignal();

                End;

            End /* On Area */;

        /*
         *  Set the Eof flag for SysIn when we have
         *  exhausted the data list.
         */
        On EndFile(SysIn) Eof_SysIn = True;

        Call Initialize_Area;

        Get List(Data);

        Do While(~Eof_SysIn);

            Allocate List_Entry Set(Temp); /* Implied IN(A) */

            If Initial_Offset = Null()
            Then
                Initial_Offset = Temp;
            Else
                List_Entry.Next = Temp;
            Current_Offset = Temp;

            List_Entry.Next = Null();
            List_Entry.Value = Data;

            Get List(Data);

            End /* While */;

        /*
         *  If at least one entry was allocated,
         *  write out the area.
         */
        If Initial_Offset ~= Null()
        Then
            Call Write_Data;

        If Data_File_Open
        Then
            Close File(Data_File);

        End Save_Data;
%page;
%sbttl 'Display_Data';
    Display_Data: Procedure(A);
        /*
         *  Read in successive copies of the area from
         *  the data file displaying the list in each until
         *  there are no more areas in the data file.  (This
         *  assumes that the data file entries are pairs of
         *  records containing the initial offset into the
         *  area followed by the area itself.)
         */

        Declare
            A Area(*),

            (Initial_Offset, Current_Offset) Automatic Offset(A),
            1 List_Entry Like(List_Entry_Type) Based(Current_Offset),

            Eof_Data_File Bit Aligned Initial(False);

        On EndFile(Data_File) Eof_Data_File = True;

        Open File(Data_File) Input Title('TEMP.DAT');

        Read File(Data_File) Into(Initial_Offset);

        Do While(~Eof_Data_File);

            Read File(Data_File) Into(A);

            Do Current_Offset = Initial_Offset
                    Repeat(List_Entry.Next)
                    While(Current_Offset ~= Null());

                Put Skip List(List_Entry.Value);

                End /* Do Repeat */;

            Read File(Data_File) Into(Initial_Offset);

            End /* While */;

        Close File(Data_File);

        End Display_Data;
%page;
%sbttl 'Main program';
    /* Main code for Area_Example */

    /*
     *  Allocate the work area.  (Note that areas must
     *  be explicitly emptied with EMPTY() in VAX PL/I; they are
     *  not automatically Empty when allocated.)
     */
    Allocate Work_Area;
    Work_Area = Empty();

    /*
     *  Get the command and invoke the appropriate
     *  procedure with the work area.
     */
    On EndFile(SysIn) Stop;
    Get List(String);

    Select(String);

        When('Save') Do;
            Call Save_Data(Work_Area);
            End;

        When('Display') Do;
            Call Display_Data(Work_Area);
            End;

        Otherwise
            Put List('The valid commands are "Save" and "Display"');

        End /* Select */;

    End Area_Example;