Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/vlngthio.src

Text File | 1988-05-03 | 117.8 KB | 3,298 lines

::::::::::
messageio.pro
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    :  MESSAGE_IO
-- Version      :  1.0
-- Author       :  Patrick Kopson
--              : Texas Instruments
--              :
--              :
-- DDN Address  :  WOODY%TI-EG@CSNET-RELAY
-- Copyright    :  (c) 1985
-- Date created :  01 APR 85
-- Release date :  03 DEC 85
-- Last update  :  03 DEC 85
-- Machine/System Compiled/Run on :  VAX 11/785  VMS 4.1
--                                   DEC Ada
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : Text_Messages
----------------:
--
-- Abstract     :
--   This package is used for sending messages to the defaut
--   output file.  See the visible part for the details of the
--   structure of the messages.  Minor changes to this package
--   (including making the length of certain fields generic
--   parameters) would make this package much more versatile.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 12/3/85      1.0         Patrick Kopson          Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------
::::::::::
messageio.ada
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    :  MESSAGE_IO
-- Version      :  1.0
-- Author       :  Patrick Kopson
--              : Texas Instruments
--              :
--              :
-- DDN Address  :  WOODY%TI-EG@CSNET-RELAY
-- Copyright    :  (c) 1985
-- Date created :  01 APR 85
-- Release date :  03 DEC 85
-- Last update  :  03 DEC 85
-- Machine/System Compiled/Run on :  VAX 11/785  VMS 4.1
--                                   DEC Ada
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : Text_Messages
----------------:
--
-- Abstract     :
--   This package is used for sending messages to the defaut
--   output file.  See the visible part for the details of the
--   structure of the messages.  Minor changes to this package
--   (including making the length of certain fields generic
--   parameters) would make this package much more versatile.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 12/3/85      1.0         Patrick Kopson          Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

package MESSAGE_IO is
-------------------------------------------------------------------------------
----                                                                       ----
--                          VISIBLE TYPE DECLARATIONS                        --
----                                                                       ----
-------------------------------------------------------------------------------

              -- Type Declarations for module name abbreviations:

type Character_Type is ( 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
                         'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
                         'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
                         'Y', 'Z', '_' );
     --| Allowable characters for module names and message id's

Name_Length : constant := 6;
     --| Largest number of characters per module name abbreviation

type Name_Range_Type is range  1 .. Name_Length;
     --| Type for length of module name abbreviations

type Name_Array_Type is array ( Name_Range_Type ) of Character_Type;
     --| Type for module name abbreviations


              -- Type Declarations for message id's:

Max_Message_Id : constant := 8;
     --| Largest number of characters per message id

type Message_Id_Range_Type is range 1 .. Max_Message_Id;
     --| Type for lengths of message id's

type Message_Id_Array_Type is
         array ( Message_Id_Range_Type ) of Character_Type;
     --| Type for message id's


              -- Type Declarations for priority kinds:

type Priority_Kind_Type is ( Alevel, Slevel, Tell_All );
     --| Each message must have one of these priority kinds associated with it

subtype Priority_Kind_Constrained_Type is
         Priority_Kind_Type range Alevel ..  Slevel;
     --| Constrained type of priority kinds for defining priority levels


              -- Type Declarations for text line extensions:

Text_Array_Length : constant := 32767;
     --| Largest number of text lines allowed

Text_Line_Length : constant := 72;
     --| Largest number of characters per line of text

subtype Text_Line_Type is string ( 1 .. Text_Line_Length );
     --| Type for text lines

type Text_Array_Length_Type is range  0 .. Text_Array_Length;
     --| Type for length of text array

type Text_Array_Type
     is array ( Text_Array_Length_Type range <> ) of Text_Line_Type;
     --| Type for text line extensions

Null_Text_Array : constant Text_Array_Type ( 1 .. 0 ) :=
                           ( 1 .. 0 => ( 1 .. Text_Line_Length => ' ' ) );
     --| Constant for null text lines


              -- Type Declarations for progress report headline
              --                       and message structure line:

Required_Text_Line_Length : constant := 40;
     --| Maximum length for required text line

subtype Required_Text_Line_Type is string ( 1 .. Required_Text_Line_Length );
     --| Type for required text line


type Severity_Level is ( Note, Warning, Error, Failure );


-------------------------------------------------------------------------------
----                                                                       ----
--                          PACKAGE ENTRY POINTS                             --
----                                                                       ----
-------------------------------------------------------------------------------


procedure DISPLAY_PROGRESS ( Report_Title : in Required_Text_Line_Type;
                             Report_Text  : in Text_Array_Type
                                               := Null_Text_Array;
                             Priority     : in Severity_Level := Failure );

   --|    OVERVIEW
   --|       When the priority of the progress message, given by Priority, is
   --|       higher than or equal to the lowest priority defined for the Slevel
   --|       priority kind, this procedure outputs to the message file the
   --|       progress report headline given by Report_Title, the wall clock date
   --|       and time, and if specified, the optional extension text given by
   --|       Report_Text.
   --|    REQUIRES
   --|       The message file must be open.
   --|    EFFECTS
   --|       The report title, wall clock date and time is written to the
   --|       message file.  The report text is selected for output, when
   --|       specified, when the priority is higher than or equal to the
   --|       lowest priority defined for the Slevel priority kind.  The
   --|       format of the report output is the following:
   --|
   --|       CONTROL:             <report_title>       hh:mm:ss dd-MMM-yyyy
   --|
   --|    o    [                         .                              ]
   --|    p    [                         .                              ]
   --|    t    [                         .                              ]
   --|    i    [             . . . <report_text> . . .                  ]
   --|    o    [                         .                              ]
   --|    n    [                         .                              ]
   --|    a    [                         .                              ]
   --|    l    [                         .                              ]
   --|
   --|    RAISES
   --|       MSIO_MESSAGE_FILE_DISASTER
   --|    ERRORS
   --|       If the message file has not been opened, or if the capacity
   --|       of the message file has been exceeded, or if the output
   --|       operation could not be completed because of a malfunction
   --|       of  the  underlying  system,  then  the  exception
   --|       MSIO_MESSAGE_FILE_DISASTER will be raised.
   --|    NA
   --|       MODIFIES


procedure DISPLAY_MSG
       ( Module_Abbr             : in Name_Array_Type;
         Message_Id              : in Message_Id_Array_Type;
         Message_Text_Standard   : in Required_Text_Line_Type;
         Message_Text_Addition   : in Text_Array_Type    := Null_Text_Array;
         Priority_Kind           : in Priority_Kind_Type := Tell_All;
         Priority                : in Severity_Level     := Note );

   --|    OVERVIEW
   --|       When the priority of the message given by Priority, is higher than
   --|       or equal to the lowest priority defined for the priority kind given
   --|       by Priority_Kind, this procedure outputs to the message file the
   --|       module abbreviation given by Module_Abbr, the message
   --|       identification given by Message_Id, the structure line, which
   --|       contains the required portion of the message, given by
   --|       Message_Text_Standard, and if specified, the optional extension
   --|       text given by Message_Text_Addition.
   --|    REQUIRES
   --|       The message file must be open.
   --|    EFFECTS
   --|       The module abbreviation, the message identification, the
   --|       priority, and the standard message text are output to the
   --|       message file.  Messages with priority higher than or equal
   --|       to the lowest priority level defined for a particilar
   --|       priority kind are selected for output to the output file.
   --|       If the lowest priority is not defined, then all messages
   --|       will be output.  If the priority kind, given by Priority_Kind,
   --|       is Tell_All, then the given message is output regardless of
   --|       priority.  The format of the message output looks like the
   --|       following:
   --|
   --|       <module_abbr> - <priority> - <message_id>  <message_text_standard>
   --|
   --|    o    [                         .                                ]
   --|    p    [                         .                                ]
   --|    t    [                         .                                ]
   --|    i    [         . . . <message_text_addition> . . .              ]
   --|    o    [                         .                                ]
   --|    n    [                         .                                ]
   --|    a    [                         .                                ]
   --|    l    [                         .                                ]
   --|
   --|    RAISES
   --|       MSIO_MESSAGE_FILE_DISASTER
   --|    ERRORS
   --|       If the message file has not been opened, or if the capacity
   --|       of the message file has been exceeded, or if the output
   --|       operation could not be completed because of a malfunction
   --|       of  the  underlying  system,  then  the  exception
   --|       MSIO_MESSAGE_FILE_DISASTER will be raised.
   --|    NA
   --|       MODIFIES


procedure DEFINE_LOWEST_PRIORITY
                      ( Priority_Kind  : in Priority_Kind_Constrained_Type;
                        Priority_Level : in Severity_Level );

   --|    OVERVIEW
   --|       This procedure allows the lowest reportable message priority,
   --|       given by Priority_Level, to be defined for a priority kind,
   --|       given by Priority_Kind.
   --|    EFFECTS
   --|       The lowest priority for a priority kind is defined.
   --|    NA
   --|       REQUIRES, RAISES, ERRORS


procedure CLOSE_MESSAGE_FILE;

   --|    OVERVIEW
   --|       This procedure closes the message file.
   --|    REQUIRES
   --|       The message file must be open.
   --|    EFFECTS
   --|       A message indicating that the message file is closed
   --|       is written to the message file, then the message file
   --|       is closed.
   --|    RAISES
   --|       MSIO_MESSAGE_FILE_DISASTER
   --|    ERRORS
   --|       If the message file is not open, then the exception
   --|       MSIO_MESSAGE_FILE_DISASTER will be raised.
   --|    NA
   --|       MODIFIES



-- Exceptions raised by Message file I/O package

MSIO_MESSAGE_FILE_DISASTER : exception;

end MESSAGE_IO;


-------------------------------------------------------------------------------
----                                                                       ----
--                         MESSAGE I/O PACKAGE BODY                          --
----                                                                       ----
-------------------------------------------------------------------------------

with TEXT_IO;
with CALENDAR;

package body MESSAGE_IO is
-------------------------------------------------------------------------------
----                                                                       ----
--                       INTERNAL TYPES AND OBJECTS                          --
----                                                                       ----
-------------------------------------------------------------------------------
subtype Date_And_Time_Type is STRING (1 .. 22);

type Priority_Array_Type is
     array (Priority_Kind_Constrained_Type) of Severity_Level;

Lowest_Priority_Array :  Priority_Array_Type
                      := (Severity_Level'First, Severity_Level'First);

File_Is_Closed : BOOLEAN := false;

-------------------------------------------------------------------------------
----                                                                       ----
--                           INTERNAL PROCEDURES                             --
----                                                                       ----
-------------------------------------------------------------------------------
function Character_Equivalent_Of
         (Char : in     Character_Type) return Character is

   --| OVERVIEW
   --|   This function returns the character equivalent of an item of
   --|   type Character_Type.
   --|
   --| ALGORITHM
   --|   Use Char as an index to an array of characters to select the result.

   type Character_Array_Type is array (Character_Type) of Character;

   Character_Array : Character_Array_Type := ('A', 'B', 'C', 'D', 'E', 'F', 'G',
                                              'H', 'I', 'J', 'K', 'L', 'M', 'N',
                                              'O', 'P', 'Q', 'R', 'S', 'T', 'U',
                                              'V', 'W', 'X', 'Y', 'Z', '_');
   begin
     return Character_Array (Char);
   end Character_Equivalent_Of;


function Date_And_Time return Date_And_Time_Type is

   --| OVERVIEW
   --|   This function returns the date and time from the wall clock
   --|   as a STRING so that TEXT_IO can write it to the message file.
   --|
   --| EFFECTS
   --|   The date and time are returned as a string with the following format:
   --|   " hh:mm:ss  dd-MMM-yyy".
   --|
   --| NA
   --|  REQUIRES, ERRORS, RAISES, MODIFIES
   --|
   --| ALGORITHM
   --|   After getting the Year, Month, Day and Seconds from CALENDAR
   --|   subprograms, derive Hour, Minute and Sec from Seconds.
   --|   Then insert the images of these values into the result string.

   Result : STRING(1 .. 22) := " hh:mm:ss  dd-MMM-yyyy";

   Seconds_Per_Minute : constant := 60;
   Seconds_Per_Hour   : constant := 3600;

   subtype Hour_Number   is INTEGER range 0 .. 23;
   subtype Minute_Number is INTEGER range 0 .. 59;
   subtype Sec_Number    is INTEGER range 0 .. 59;

   Date : CALENDAR.Time;

   Year    : CALENDAR.Year_Number;
   Month   : CALENDAR.Month_Number;
   Day     : CALENDAR.Day_Number;
   Seconds : CALENDAR.Day_Duration;

   Hour   : Hour_Number;
   Minute : Minute_Number;
   Sec    : Sec_Number;

   begin
      Date := CALENDAR.Clock;
      CALENDAR.Split (Date,
                      Year,
                      Month,
                      Day,
                      Seconds);
      Hour    := INTEGER(Seconds) / Seconds_Per_Hour;
      Seconds := CALENDAR.Day_Duration (INTEGER(Seconds) rem Seconds_Per_Hour);
      Minute  := INTEGER(Seconds) / Seconds_Per_Minute;
      Sec     := INTEGER(Seconds) rem Seconds_Per_Minute;

      Result(18 .. 22) := CALENDAR.Year_Number'IMAGE (Year);
      Result(18) := '-';

      case Month is
         when 1 => Result(15 .. 17) := "JAN";
         when 2 => Result(15 .. 17) := "FEB";
         when 3 => Result(15 .. 17) := "MAR";
         when 4 => Result(15 .. 17) := "APR";
         when 5 => Result(15 .. 17) := "MAY";
         when 6 => Result(15 .. 17) := "JUN";
         when 7 => Result(15 .. 17) := "JUL";
         when 8 => Result(15 .. 17) := "AUG";
         when 9 => Result(15 .. 17) := "SEP";
         when 10 => Result(15 .. 17) := "OCT";
         when 11 => Result(15 .. 17) := "NOV";
         when 12 => Result(15 .. 17) := "DEC";
      end case;

      if  (Day < 10)  then
         Result(12 .. 13) := CALENDAR.Day_Number'IMAGE (Day);
         Result(12) := '0';
      else
         Result(11 .. 13) := CALENDAR.Day_Number'IMAGE (Day);
      end if;

      if  (Sec < 10)  then
         Result(8 .. 9) := Sec_Number'IMAGE (Sec);
         Result(8) := '0';
      else
         Result(7 .. 9) := Sec_Number'IMAGE (Sec);
         Result(7) := ':';
      end if;

      if  (Minute < 10)  then
         Result(5 .. 6) := Minute_Number'IMAGE (Minute);
         Result(5) := '0';
      else
         Result(4 .. 6) := Minute_Number'IMAGE (Minute);
         Result(4) := ':';
      end if;

      if  (Hour < 10)  then
         Result(2 .. 3) := Hour_Number'IMAGE (Hour);
         Result(2) := '0';
      else
         Result(1 .. 3) := Hour_Number'IMAGE (Hour);
      end if;

      return Result;
   end Date_And_Time;


-------------------------------------------------------------------------------
----                                                                       ----
--                          PACKAGE ENTRY POINTS                             --
----                                                                       ----
-------------------------------------------------------------------------------
procedure DISPLAY_PROGRESS
          ( Report_Title : in Required_Text_Line_Type;
            Report_Text  : in Text_Array_Type := Null_Text_Array;
            Priority     : in Severity_Level := Failure ) is

   --| OVERVIEW
   --|   If the priority (Priority) is higher than or equal to the lowest
   --|   priority defined for the Slevel priority kind, this procedure
   --|   outputs the progress report headline (Report_Title) and the wall
   --|   clock date and time to the message file on one line with the
   --|   optional extension text (Report_Text), if specified, on following
   --|   lines.
   --|
   --| ALGORITM
   --|   . . .

   begin
     if File_Is_Closed then
        TEXT_IO.PUT
                ("***** MESSAGE_IO.Display_Progress called with file closed.");
        raise MSIO_MESSAGE_FILE_DISASTER;
     end if;

     if  ( Priority >= Lowest_Priority_Array(Slevel) )  then
        TEXT_IO.PUT ("CONTROL:   ");
        TEXT_IO.PUT (Report_Title);
        TEXT_IO.PUT ("     ");
        TEXT_IO.PUT (Date_And_Time);
        TEXT_IO.NEW_LINE;

        for Line in  Report_Text'RANGE(1)  loop
           TEXT_IO.PUT ("   ");
           TEXT_IO.PUT ( Report_Text(Line) );
           TEXT_IO.NEW_LINE;
        end loop;
     end if;

   exception
     when others => raise MSIO_MESSAGE_FILE_DISASTER;

   end DISPLAY_PROGRESS;


procedure DISPLAY_MSG
          ( Module_Abbr             : in Name_Array_Type;
            Message_Id              : in Message_Id_Array_Type;
            Message_Text_Standard   : in Required_Text_Line_Type;
            Message_Text_Addition   : in Text_Array_Type    := Null_Text_Array;
            Priority_Kind           : in Priority_Kind_Type := Tell_All;
            Priority                : in Severity_Level     := Note ) is

   --| OVERVIEW
   --|   If the priority (Priority) is higher than or equal to the lowest
   --|   priority defined for the priority kind (Priority_Kind), this
   --|   procedure outputs the module abbreviation (Module_Abbr), the
   --|   priority (Priority), the message identification (Message_Id), and
   --|   the structure line which contains the required portion of the
   --|   message (Message_Text_Standard) to the message file on one line,
   --|   with the optional extension text (Message_Text_Addition), if
   --|   specified, on following lines.
   --|
   --| NOTES
   --|   The Lowest_Priority for each priority kind is initialized
   --|   to the lowest possible value; so there is no need to check
   --|   whether it is undefined (indicating that we should write the
   --|   message regardless of the priority).
   --|
   --| ALGORITHM
   --|   After writing the Module_Abbr, Priority, Message_ID and
   --|   Message_Text_Standard, we check the Priority and Priority_Kind
   --|   to determine whether we must write the Message_Text_Addition.

   begin
     if File_Is_Closed then
        TEXT_IO.PUT ("***** MESSAGE_IO.Display_Msg called with file closed.");
        raise MSIO_MESSAGE_FILE_DISASTER;
     end if;

     if  ( Priority_Kind =  Tell_All ) or else
         ( Priority >= Lowest_Priority_Array(Priority_Kind) )  then
        for Char in Module_Abbr'RANGE loop
           TEXT_IO.PUT ( Character_Equivalent_Of(Module_Abbr(Char)) );
        end loop;
        TEXT_IO.PUT (" - ");
        case Priority is
           when Note    => TEXT_IO.PUT ( "NOTE" );
           when Warning => TEXT_IO.PUT ( "WARNING" );
           when Error   => TEXT_IO.PUT ( "ERROR" );
           when Failure => TEXT_IO.PUT ( "FAILURE" );
           when others  => TEXT_IO.PUT ( "OTHER" );
        end case;
        TEXT_IO.PUT (" - ");
        for Char in Message_ID'RANGE loop
           TEXT_IO.PUT ( Character_Equivalent_Of(Message_ID(Char)) );
        end loop;
        TEXT_IO.PUT (" - ");
        TEXT_IO.PUT (Message_Text_Standard);
        TEXT_IO.NEW_LINE;

        for Line in  Message_Text_Addition'RANGE(1)  loop
           TEXT_IO.PUT ("   ");
           TEXT_IO.PUT ( Message_Text_Addition(Line) );
           TEXT_IO.NEW_LINE;
        end loop;
     end if;

   exception
     when others => raise MSIO_MESSAGE_FILE_DISASTER;

   end DISPLAY_MSG;


procedure DEFINE_LOWEST_PRIORITY
          ( Priority_Kind  : in Priority_Kind_Constrained_Type;
            Priority_Level : in Severity_Level ) is

   --| OVERVIEW
   --|   This procedure allows the lowest reportable message priority,
   --|   given by Priority_Level, to be defined for a priority kind,
   --|   given by Priority_Kind.
   --|
   --| ALGORITHM
   --|   Set the specified lowest_priprity to Priority_Level

   begin
     Lowest_Priority_Array (Priority_Kind) := Priority_Level;
   exception
     when others => raise MSIO_MESSAGE_FILE_DISASTER;
   end DEFINE_LOWEST_PRIORITY;


procedure CLOSE_MESSAGE_FILE is

   --| OVERVIEW
   --|   This procedure closes the message file.
   --|
   --| NOTES
   --|   The standard output file can not be closed!
   --|   Therefore, this procedure will write a closing message
   --|   (including the wall clock date and time) to the message file
   --|   and then quit.
   --|
   --| ALGORITHM
   --|   Write a closing message to the file.
   --|   Close the default output file if possible.

   Close_File : TEXT_IO.File_Type;

   begin
     TEXT_IO.PUT ("Mesage File closed at    ");
     TEXT_IO.PUT (Date_And_Time);
     TEXT_IO.NEW_LINE;
     File_Is_Closed := true;
   exception
     when others => raise MSIO_MESSAGE_FILE_DISASTER;
   end CLOSE_MESSAGE_FILE;

end MESSAGE_IO;
::::::::::
vlengthio.pro
::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    :  VARIABLE_LENGTH_DIRECT_IO
-- Version      :  1.0
-- Author       :  Patrick Kopson
--              : Texas Instruments
--              :
--              :
-- DDN Address  :  WOODY%TI-EG@CSNET-RELAY
-- Copyright    :  (c) 1985
-- Date created :  01 APR 85
-- Release date :  03 DEC 85
-- Last update  :  03 DEC 85
-- Machine/System Compiled/Run on :  VAX 11/785  VMS 4.1
--                                   DEC Ada
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : DIRECT_IO, Varible-Length IO
----------------:
--
-- Abstract     :
--|   This is a package similar to DIRECT_IO that operates on records of
--|   variable length.  The body of this package may use CAIS utilities
--|   in the future.
--|
--|   This package allows the user to write elements of differing lengths to a
--|   single direct access file.  This package can be used to write data
--|   of all types to a single file (with the aid of UNCHECKED_CONVERSION).
--|   The DATA_FILE_IO package in the Ada repository serves as an example of
--|   how this can be accomplished.
--|
--|   This package also reduces the time-per-byte-of-data-transfered by reducing
--|   the number of calls to the run time libraray routines associated with the
--|   predefined generic package DIRECT_IO.  This is accomplished by placing
--|   many incoming records into a large buffer and then writng the entire
--|   buffer to an external file as a single element (vice versa for reading).
--|   Bytes_Per_Block, the only generic parameter for this package, determines
--|   the size (in bytes) of this buffer.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 12/3/85      1.0         Patrick Kopson          Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------
::::::::::
vlengthio.ada
::::::::::
--------------------------------------------------------------------------------
----                                                                        ----
--                     VARIABLE LENGTH DIRECT IO PACKAGE                      --
----                                                                        ----
--------------------------------------------------------------------------------
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    :  generic package VARIABLE_LENGTH_DIRECT_IO
--                                 ( Bytes_Per_Block : in Positive )
-- Version      :  1.0
-- Author       :  Patrick Kopson
--              : Texas Instruments
--              :
--              :
-- DDN Address  :  WOODY%TI-EG@CSNET-RELAY
-- Copyright    :  (c) 1985
-- Date created :  01 APR 85
-- Release date :  03 DEC 85
-- Last update  :  03 DEC 85
-- Machine/System Compiled/Run on :  VAX 11/785  VMS 4.1
--                                   DEC Ada
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : DIRECT_IO, Varible-Length IO
----------------:
--
-- Abstract     :
--|   This is a package similar to DIRECT_IO that operates on records of
--|   variable length.  The body of this package may use CAIS utilities
--|   in the future.
--|
--|   This package allows the user to write elements of differing lengths to a
--|   single direct access file.  This package can be used to write data
--|   of all types to a single file (with the aid of UNCHECKED_CONVERSION).
--|   The DATA_FILE_IO package in the Ada repository serves as an example of
--|   how this can be accomplished.
--|
--|   This package also reduces the time-per-byte-of-data-transfered by reducing
--|   the number of calls to the run time libraray routines associated with the
--|   predefined generic package DIRECT_IO.  This is accomplished by placing
--|   many incoming records into a large buffer and then writng the entire
--|   buffer to an external file as a single element (vice versa for reading).
--|   Bytes_Per_Block, the only generic parameter for this package, determines
--|   the size (in bytes) of this buffer.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 12/3/85      1.0         Patrick Kopson          Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

with SYSTEM;
with DIRECT_IO;
with IO_EXCEPTIONS;

generic

  Bytes_Per_Block : in Positive;

package VARIABLE_LENGTH_DIRECT_IO is
-------------------------------------------------------------------------------
----                                                                       ----
--                       VISIBLE TYPE DECLARATIONS                           --
----                                                                       ----
-------------------------------------------------------------------------------

  type File_Type is limited private;
    --|  An external file to be written to or read from using this package
    --|  must have an object of File_Type associated with it.  The File_Type
    --|  object is passed in for all routines.

  type Internal_File_Pointer_Type is private;
    --|  Objects of Internal_File_Pointer_Type are used as an index into a
    --|  file.  An open file has a current index, which is of this type, and is
    --|  used by the read and write operations.  When a file is opened, the
    --|  current index is set to the index of the first record.

  type File_Mode_Type is (In_Mode, Inout_Mode);
    --|  An open file must have one of these modes associated with it.  A file
    --|  of mode In_Mode is for reading only.  A file of mode Inout_Mode is for
    --|  reading and writing.

  subtype Non_Negative is Integer range 0 .. Integer'LAST;

  type Storage_Unit_Type is array ( 1 .. SYSTEM.Storage_Unit ) of Boolean;
  pragma PACK (Storage_Unit_Type);
    --|  Records will be built up from storage units.

  All_False : constant Storage_Unit_Type := ( 1..SYSTEM.Storage_Unit => False);

  type Record_Type is array ( Non_Negative range <> ) of Storage_Unit_Type;
    --|  Objects to be read or written must be of Record_Type.

  type Block_Count_Type is new Non_Negative;
    --|  This type is used for objects representing the number
    --|  of data blocks in a file.
---------------------------------------------------------------------------
----                                                                   ----
--                         PACKAGE ENTRY POINTS                          --
----                                                                   ----
---------------------------------------------------------------------------

  procedure CREATE
            ( File : in out File_Type;
              Mode : in     File_Mode_Type := Inout_Mode;
              Name : in     string := "";
              Form : in     string := "" );

    --| OVERVIEW
    --|   This procedure is similar the CREATE routine of the DIRECT_IO
    --|   package and is used to establish a new external file, with the
    --|   given name, mode and form, and to associate this external file
    --|   with the given file.  The given file is left open.  The default
    --|   access mode is Inout_Mode.
    --|
    --| REQUIRES
    --|   The given file must not be open already.
    --|
    --| EFFECTS
    --|   External file is created with given name and form.  File is opened.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_NAME_ERROR, VLIO_USE_ERROR
    --|
    --| ERRORS
    --|   If the given file is already open, the exception VLIO_STATUS_ERROR
    --|   is raised.
    --|   If the string given as Name does not allow the identification of an
    --|   external file, the exception VLIO_NAME_ERROR is raised.
    --|   If for the specified mode, the environment does not support creating
    --|   an external file with the given name and form, the exception
    --|   VLIO_USE_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure OPEN
            ( File : in out File_Type;
              Mode : in     File_Mode_Type;
              Name : in     string;
              Form : in     string := "" );

    --| OVERVIEW
    --|   This procedure is used similarly to the open routine in the
    --|   DIRECT_IO package.  The given file is associated with an existing
    --|   external file having the given name and form, and sets the current
    --|   mode of the given file to the given mode.  The given file is left
    --|   open and the current read index and write index are set to the
    --|   index of the first record.
    --|
    --| REQUIRES
    --|   The given file must exist and not be open already.
    --|
    --| EFFECTS
    --|   Associates file name with external file and opens external file.
    --|   Current read index and write index are set to first record.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_NAME_ERROR, VLIO_USE_ERROR
    --|
    --| ERRORS
    --|   If the given file is already open, the exception VLIO_STATUS_ERROR
    --|   is raised.
    --|   If the string given as Name does not allow the identification of an
    --|   external file, (in particular, if the external file with the given
    --|   name doesn't exist), the exception VLIO_NAME_ERROR is is raised.
    --|   If, for the specified mode, the environment does not support opening
    --|   an external file with the given name and form, the exception
    --|   VLIO_USE_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure CLOSE
            ( File : in out File_Type );

    --| OVERVIEW
    --|   This procedure is used to sever the association between the given
    --|   file and its associated external file.  The file is left closed.
    --|
    --| REQUIRES
    --|   The given file must be open.
    --|
    --| EFFECTS
    --|   Association between file name and external file is severed.
    --|   File is closed.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open, the exception VLIO_STATUS_ERROR is
    --|   raised.
    --|
    --| NA
    --|   MODIFIES


  procedure DELETE
            ( File : in out File_Type );

    --| OVERVIEW
    --|   This procedure is similar to the DELETE routine of the DIRECT_IO
    --|   package and is used to delete the external file associated with
    --|   the given file.  The given file is closed, and the external file
    --|   ceases to exist.
    --|
    --| REQUIRES
    --|   The file must be open.
    --|
    --| EFFECTS
    --|   Deletes and closes given file.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_USE_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open, the exception VLIO_STATUS_ERROR is
    --|   raised.  If deletion of the external file is not supported by the
    --|   environment, the exception VLIO_USE_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure RESET_FILE
            ( File : in out File_Type );

    --| OVERVIEW
    --|   This procedure resets the given file of mode In_Mode so that
    --|   reading from its elements can be restarted from the beginning of
    --|   the file;  in particular, for direct access this means that the
    --|   current index is set to the index of the first record.
    --|
    --| REQUIRES
    --|   The file must be open and must be of mode In_Mode.
    --|
    --| EFFECTS
    --|   Resets file to beginning of file for reading.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_MODE_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|   If the file is not of mode In_Mode, the exception VLIO_MODE_ERROR
    --|   is raised.
    --|
    --| NA
    --|   MODIFIES



  function MODE
            ( File : in File_Type ) return File_Mode_Type;

    --| OVERVIEW
    --|   This procedure is similar to the MODE routine of the DIRECT_IO
    --|   package and returns the current mode of the given file.
    --|
    --| REQUIRES
    --|   The given file must be open.
    --|
    --| EFFECTS
    --|   Current mode of given file is returned.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open, the exception VLIO_STATUS_ERROR is
    --|   raised.
    --|
    --| NA
    --|   MODIFIES


  function NAME
            ( File : in File_Type ) return string;

    --| OVERVIEW
    --|   This procedure is similar to NAME routine of the DIRECT_IO package
    --|   and returns a string which uniquely identifies the external file
    --|   currently associated with the given file.
    --|
    --| REQUIRES
    --|   The given file must be open.
    --|
    --| EFFECTS
    --|   String uniquely identifying external file associated with the given
    --|   file is returned.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open, the eception VLIO_STATUS_ERROR is
    --|   raised.
    --|
    --| NA
    --|   MODIFIES


  function FORM
            ( File : in File_Type ) return string;

    --| OVERVIEW
    --|   This procedure is similar to the FORM routine of the DIRECT_IO
    --|   package and returns the form string for the external file currently
    --|   associated with the given file.
    --|
    --| REQUIRES
    --|   The given file must be open.
    --|
    --| EFFECTS
    --|   Form string of external file associated with given file is
    --|   returned.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open, the exception VLIO_STATUS_ERROR is
    --|   raised.
    --|
    --| NA
    --|   MODIFIES


  function IS_OPEN
            ( File : in File_Type ) return boolean;

    --| OVERVIEW
    --|   The function IS_OPEN is used similarly to the IS_OPEN routine in the
    --|   DIRECT_IO package.  It returns TRUE if the given file is open;
    --|   otherwise it returns FALSE.
    --|
    --| NA
    --|   REQUIRES, EFFECTS, MODIFIES, RAISES, ERRORS



  procedure READ
            ( File : in out File_Type;
              Item : out    Record_Type );

    --| OVERVIEW
    --|   This procedure is similar to the sequential Read routine of the
    --|   DIRECT_IO package.  It operates on a file of any mode and
    --|   returns in the parameter Item, the value of the element whose
    --|   position is given by the current read index of the file.
    --|   The current read index is advanced.
    --|
    --| REQUIRES
    --|   The given file must be open.  There must be at least one more
    --|   element to read and that element must be of the Record_Type.
    --|
    --| EFFECTS
    --|   An element of Record_Type is returned in the Item paramenter.
    --|   The current read index is advanced.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_END_ERROR, VLIO_DATA_ERROR
    --|
    --| ERRORS
    --|   If this procedure is called for an unopened file, the exception
    --|   VLIO_STATUS_ERROR is raised.
    --|   If there are no more elements to be read, the exception
    --|   VLIO_END_ERROR is raised.
    --|   If the element read cannot be interpreted as a value of the
    --|   Record_Type, the exception VLIO_DATA_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure READ
            ( File : in out File_Type;
              From : in     Internal_File_Pointer_Type;
              Item : out    Record_Type );

    --| OVERVIEW
    --|   This procedure is similar to the direct READ routine of the
    --|   DIRECT_IO package.  It operates on a file of any mode and sets
    --|   the current read index of the given file to the index value given by
    --|   the parameter From.  It returns in the parameter Item, the value
    --|   of the element whose position is given by the current read index of
    --|   the file.  The current read index is advanced.
    --|
    --| REQUIRES
    --|   The given file must be open.
    --|   The value of the From parameter must
    --|   not exceed the size of external file.
    --|
    --| EFFECTS
    --|   The current read index is set to the value of the FROM parameter.
    --|   The value at that current read index position is returned in the
    --|   Item parameter.  The current read index is advanced.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_END_ERROR, VLIO_DATA_ERROR,
    --|   VLIO_POINTER_ERROR
    --|
    --| ERRORS
    --|   If this procedure is called for an unopened file, the exception
    --|   VLIO_STATUS_ERROR is raised.
    --|   If the element read cannot be interpreted as a value of the
    --|   Record_Type, the exception VLIO_DATA_ERROR is raised.
    --|   If the index to be used exceeds the size of the external file,
    --|   the exception VLIO_END_ERROR is raised.
    --|   If the From parameter points before the beginning of the file,
    --|   the exceptiom VLIO_POINTER_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure WRITE
            ( File            : in out File_Type;
              Item : in     Record_Type );

    --| OVERVIEW
    --|   This procedure operates on a file of mode Inout_Mode and writes a
    --|   record of Record_Type to the position in the file denoted by the
    --|   current write index.  The current write index is advanced.
    --|
    --| REQUIRES
    --|   The given file must be of mode Inout_Mode and must be open.
    --|
    --| EFFECTS
    --|   A record is written to the file at the current write index.
    --|   The current write index is advanced.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_MODE_ERROR, VLIO_USE_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open, the exception VLIO_STATUS_ERROR is
    --|   raised.
    --|   If the given file is of the mode In_Mode, the exception
    --|   VLIO_MODE_ERROR is raised.
    --|   If the capacity of the external file is exceeded by the write,
    --|   the exception VLIO_USE_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure REWRITE
            ( File            : in out File_Type;
              Item : in     Record_Type;
              To              : in Internal_File_Pointer_Type );

    --| OVERVIEW
    --|   This procedure writes a record of Record_Type to
    --|   the index specified by the To paramenter.
    --|
    --| REQUIRES
    --|   The file must be of mode Inout_Mode and must be open.
    --|   A record must exist at the index specified by the To parameter.
    --|   The record to be written must be the same length as the record
    --|   previously existing at the index specified by the To parameter.
    --|
    --| EFFECTS
    --|   A record is rewritten to the file at the index specified.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_MODE_ERROR, VLIO_END_ERROR,
    --|   VLIO_RECORD_SIZE_ERROR, VLIO_POINTER_ERROR
    --|
    --| ERRORS
    --|   If the given file is not open,
    --|   the exception VLIO_STATUS_ERROR is raised.
    --|   If the given file is of the mode In_Mode,
    --|   the exception VLIO_MODE_ERROR is raised.
    --|   If the index to be used exceeds the size of the external file,
    --|   the exception VLIO_END_ERROR is raised.
    --|   If the length of the record to write is not exactly the same
    --|   length as the record existing at the index specified,
    --|   the exception RECORE_SIZE_ERROR is raised.
    --|   If the To parameter points to before the beginning of the file,
    --|   the exceptiom VLIO_POINTER_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure SET_READ_INDEX
           ( File : in out File_Type;
             To   : in     Internal_File_Pointer_Type );

    --| OVERVIEW
    --|   This procedure operates on a file of any mode and sets the current
    --|   read index of the given file to the value of the To parameter.
    --|
    --| REQUIRES
    --|   The given file must be open.
    --|
    --| EFFECTS
    --|   Current read index is set to value of To parameter.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_POINTER_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|   If the To parameter points before the beginning of the file,
    --|   the exception VLIO_POINTER_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  procedure SET_WRITE_INDEX
            ( File : in out File_Type;
              To   : in     Internal_File_Pointer_Type );

    --| OVERVIEW
    --|   This procedure operates on a file of mode Inout_Mode and sets the
    --|   current write index of the given file to the value of the To
    --|   parameter.
    --|   Records previously written at or after the To parameter will be
    --|   irretrievable.
    --|
    --| REQUIRES
    --|   The file must be open and must be of mode Inout_Mode.
    --|
    --| EFFECTS
    --|   Current write index is set to value of To parameter.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_MODE_ERROR, VLIO_END_ERROR,
    --|   VLIO_POINTER_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|   If the file is of mode In_Mode, the exception VLIO_MODE_ERROR is
    --|   raised.
    --|   If the To parameter points beyond the end of the file,
    --|   the exception VLIO_END_ERROR is raised.
    --|   If the To parameter points before the beginning of the file,
    --|   the exception VLIO_POINTER_ERROR is raised.
    --|
    --| NA
    --|   MODIFIES


  function READ_INDEX
           ( File : in File_Type ) return Internal_File_Pointer_Type;

    --| OVERVIEW
    --|   This procedure operates on a file of any mode and returns the
    --|   current read index of the given file.
    --|
    --| REQUIRES
    --|   The file must be open.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|
    --| NA
    --|   EFFECTS, MODIFIES


  function WRITE_INDEX
           ( File : in File_Type ) return Internal_File_Pointer_Type;

    --| OVERVIEW
    --|   This procedure operates on a file of mode Inout_Mode and returns the
    --|   current write index of the given file.
    --|
    --| REQUIRES
    --|   The file must be open.
    --|   The file must be of mode Inout_Mode.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR, VLIO_MODE_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|   If the file is not of mode Inout_Mode, the exception
    --|   VLIO_MODE_ERROR is raised.
    --|
    --| NA
    --|   EFFECTS, MODIFIES


  function SIZE
           ( File : in File_Type ) return Block_Count_Type;

    --| OVERVIEW
    --|   This function operates on a file of any mode and returns the current
    --|   number of records in the file.  Some of these records may not yet
    --|   have been written to the external file.
    --|
    --| REQUIRES
    --|   The file must be open.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|
    --| NA
    --|   EFFECTS, MODIFIES


  function END_OF_FILE
           ( File : in File_Type ) return boolean;

    --| OVERVIEW
    --|   This function is similar to the END_OF_FILE routine in the DIRECT_IO
    --|   package.  It operates on a file of any mode and returns TRUE if the
    --|   current index exceeds the size of the external file; otherwise it
    --|   returns FALSE.
    --|
    --| REQUIRES
    --|   The file must be open.
    --|
    --| RAISES
    --|   VLIO_STATUS_ERROR
    --|
    --| ERRORS
    --|   If the file is not open, the exception VLIO_STATUS_ERROR is raised.
    --|
    --| NA
    --|   EFFECTS, MODIFIES


  function NIL return Internal_File_Pointer_Type;

    --| OVERVIEW
    --|   This function returns the value nil (or null or nothing) in the
    --|   form Internal_File_Pointer_Type.
    --|
    --| NA
    --|   REQUIRES, EFFECTS, RAISES, ERRORS, MODIFIES


  function IS_NIL
           ( Internal_Ptr : in Internal_File_Pointer_Type ) return boolean;

    --| OVERVIEW
    --|   This function returns true if the value of Internal_Ptr is nil;
    --|   otherwise it returns false.
    --|
    --| NA
    --|   REQUIRES, EFFECTS, RAISES, ERRORS, MODIFIES
  NAME_ERROR        : exception renames IO_EXCEPTIONS.NAME_ERROR;
  USE_ERROR         : exception renames IO_EXCEPTIONS.USE_ERROR;
  STATUS_ERROR      : exception renames IO_EXCEPTIONS.STATUS_ERROR;
  MODE_ERROR        : exception renames IO_EXCEPTIONS.MODE_ERROR;
  DEVICE_ERROR      : exception renames IO_EXCEPTIONS.DEVICE_ERROR;
  END_ERROR         : exception renames IO_EXCEPTIONS.END_ERROR;
  DATA_ERROR        : exception renames IO_EXCEPTIONS.DATA_ERROR;

  READ_MODE_ERROR   : exception;

  VLIO_NAME_ERROR        : exception;
  VLIO_USE_ERROR         : exception;
  VLIO_STATUS_ERROR      : exception;
  VLIO_MODE_ERROR        : exception;
  VLIO_DEVICE_ERROR      : exception;
  VLIO_END_ERROR         : exception;
  VLIO_DATA_ERROR        : exception;
  VLIO_RECORD_SIZE_ERROR : exception;
  VLIO_POINTER_ERROR     : exception;
  VLIO_WRITE_INDEX_ERROR : exception;
  VLIO_REWRITE_CANT_READ : exception;
  VLIO_FILE_LIMITS_ERROR : exception;
  VLIO_INTERNAL_ERROR    : exception;
  private
    ---------------------------------------------------------------------------
    ----                                                                   ----
    --                  PRIVATE TYPE DECLARATIONS                            --
    ----                                                                   ----
    ---------------------------------------------------------------------------

    subtype Byte_Range_Type is Non_Negative range 0..Bytes_Per_Block;

    subtype Buffer_Range_Type is Byte_Range_Type range 1..Byte_Range_Type'LAST;

    subtype Buffer_Type is Record_Type ( Buffer_Range_Type );

    package VAR_DIRECT_IO is new DIRECT_IO ( Element_Type => Buffer_Type );

    type Internal_File_Pointer_Type is
      record
        Block_Number : VAR_DIRECT_IO.Count;
        Byte_Offset  : Byte_Range_Type;
      end record;

    Start_Of_File : constant Internal_File_Pointer_Type := (1, 1);

    type File_Type is
      record
        File_Identifier    : VAR_DIRECT_IO.File_Type;
        Is_Open            : Boolean                    := false;
        Mode               : File_Mode_Type             := Inout_Mode;
        Buffer             : Buffer_Type;
        Buffer_Was_Changed : Boolean                    := false;
        Block_In_Buffer    : VAR_DIRECT_IO.Count        := 0;
        Read_Index         : Internal_File_Pointer_Type := Start_Of_File;
        Write_Index        : Internal_File_Pointer_Type := Start_Of_File;
      end record;

end VARIABLE_LENGTH_DIRECT_IO;


-------------------------------------------------------------------------------
----                                                                       ----
--                    VARIABLE LENGTH DIRECT IO PACKAGE BODY                 --
----                                                                       ----
-------------------------------------------------------------------------------

with UNCHECKED_CONVERSION;
with MESSAGE_IO;
use  MESSAGE_IO;

package body VARIABLE_LENGTH_DIRECT_IO is
-------------------------------------------------------------------------------
----                                                                       ----
--      TYPES AND CONSTANTS USED ONLY BY VARIABLE_LENGTH_DIRECT_IO BODY      --
----                                                                       ----
-------------------------------------------------------------------------------

  package MSIO renames MESSAGE_IO;

  type Process_Type is (Reading, Writing);
  --| Type to indicate to MOVE_CORRECT_BLOCK INTO BUFFER
  --| which of these two processes we are doing

  Non_Negative_Bytes : constant positive := (Non_Negative'SIZE + 7) / 8;

  subtype VLIO_Non_Negative is Record_Type (1 .. Non_Negative_Bytes);

  subtype File_Kind_Type is String (1 .. 30);

  VLIO_File_Flag : constant File_Kind_Type := "Variable Length Direct IO File";

  type File_Header_Type is
       record
         File_Kind : File_Kind_Type := VLIO_File_Flag;
         Write_Index : Internal_File_Pointer_Type := (0, 0);
       end record;

  File_Header_Bytes : constant Integer := (File_Header_Type'SIZE + 7) / 8;

  subtype VLIO_File_Header_Type is Record_Type (1 .. File_Header_Bytes);

-------------------------------------------------------------------------------
----                                                                       ----
--          SUBPROGRAMS USED ONLY BY VARIABLE_LENGTH_DIRECT_IO BODY          --
----                                                                       ----
-------------------------------------------------------------------------------

  --| The two following functions are necessary for translating record lengths
  --| from an integer subtype to Record_Type and vice-versa

  function NON_NEGATIVE_TO_VLIO_RECORD is new
           UNCHECKED_CONVERSION (Source => Non_Negative,
                                 Target => VLIO_Non_Negative);

  function VLIO_RECORD_TO_NON_NEGATIVE is new
           UNCHECKED_CONVERSION (Source => VLIO_Non_Negative,
                                 Target => Non_Negative);


  --| The two following functions are necessary for translating record headers
  --| from Record_Header_Type to Record_Type and vice-versa

  function FILE_HEADER_TO_VLIO_RECORD is new
           UNCHECKED_CONVERSION
           ( Source => File_Header_Type,
             Target => VLIO_File_Header_Type );

  function VLIO_RECORD_TO_FILE_HEADER is new
           UNCHECKED_CONVERSION
           ( Source => VLIO_File_Header_Type,
             Target => File_Header_Type );


  function "<" ( Left  : Internal_File_Pointer_Type;
                 Right : Internal_File_Pointer_Type ) return BOOLEAN is

  --| OVERVIEW
  --|   This function is used to see if one Internal_File_Pointer_Type
  --|   is less than another.
  --|
  --| EFFECTS
  --|   Returns TRUE if Left is less than Right;
  --|   returns FALSE otherwise.
  --|
  --| NA
  --|   REQUIRES, RAISES, ERRORS
  --|
  --| ALGORITHM
  --|   If Left is less than Right, then return TRUE;
  --|   otherwise, return FALSE.

  Result : Boolean;

  begin
    Result := False;

    if  VAR_DIRECT_IO."<" (Left.Block_Number, Right.Block_Number)  then
      Result := True;
    else
      if  VAR_DIRECT_IO."=" (Left.     Result := True;
      end if;
    end if;
    return Result;
  end "<";


  function ">" ( Left  : Internal_File_Pointer_Type;
                 Right : Internal_File_Pointer_Type ) return BOOLEAN is

  --| OVERVIEW
  --|   This function is used to see if one Internal_File_Pointer_Type
  --|   is greater than another.
  --|
  --| EFFECTS
  --|   Returns TRUE if Left is greater than Right;
  --|   returns FALSE otherwise.
  --|
  --| NA
  --|   REQUIRES, RAISES, ERRORS
  --|
  --| ALGORITHM
  --|   If Left is greater than Right, then return TRUE;
  --|   otherwise, return FALSE.

  Result : Boolean;

  begin
    Result := False;

    if  VAR_DIRECT_IO.">" (Left.Block_Number, Right.Block_Number)  then
      Result := True;
    else
      if  VAR_DIRECT_IO."=" (Left.Block_Number, Right.Block_Number)
          and then  Left.Byte_Offset > Right.Byte_Offset    then
        Result := True;
      end if;
    end if;
    return Result;
  end ">";


  function ">=" ( Left  : Internal_File_Pointer_Type;
                  Right : Internal_File_Pointer_Type ) return BOOLEAN is

  --| OVERVIEW
  --|   This function is used to see if one Internal_File_Pointer_Type
  --|   is greater than or equal to another.
  --|
  --| EFFECTS
  --|   Returns TRUE if Left is greater than or equal to Right;
  --|   returns FALSE otherwise.
  --|
  --| NA
  --|   REQUIRES, RAISES, ERRORS
  --|
  --| ALGORITHM
  --|   If Left is greater than or equal to Right, then return TRUE;
  --|   otherwise, return FALSE.

  Result : Boolean;

  begin
    Result := False;

    if  VAR_DIRECT_IO.">" (Left.Block_Number, Right.Block_Number)  then
      Result := True;
    else
      if  VAR_DIRECT_IO."=" (Left.Block_Number, Right.Block_Number)
          and then  Left.Byte_Offset >= Right.Byte_Offset    then
        Result := True;
      end if;
    end if;
    return Result;
  end ">=";
  procedure MOVE_CORRECT_BLOCK_INTO_BUFFER
            (File    : in out File_Type;
             Block   : in     VAR_DIRECT_IO.Positive_Count;
           Process : in     Process_Type := Reading)  is

  --| OVERVIEW
  --|   This procedure insures that the block specified by index into the
  --|   buffer associated with the given file so that data can be inserted
  --|   into or extracted from the right block.
  --|
  --| REQUIRES
  --|   The given file must be open.
  --|   We assume that calling subprograms have checked this condition.
  --|
  --| EFFECTS
  --|   If the specified block is already in the buffer, no action is
  --|   performed.  Otherwise, the specified block is read from the external
  --|   file.
  --|
  --| RAISES
  --|   STATUS_ERROR, MODE_ERROR, USE_ERROR, DATA_ERROR, END_ERROR,
  --|   READ_MODE_ERROR
  --|
  --| ERRORS
  --|   If VAR_DIRECT_IO raises STATUS_ERROR when we try to read (write)
  --|   from (to) the external file, then STATUS_ERROR is raised.
  --|   If VAR_DIRECT_IO raises MODE_ERROR when we try to write the current
  --|   block to the external file, then MODE_ERROR is raised.
  --|   If VAR_DIRECT_IO raises USE_ERROR when we try to write the current
  --|   block to the external file, then USE_ERROR is raised.
  --|   If VAR_DIRECT_IO raises DATA_ERROR when we try to read the specified
  --|   block from the external file, then DATA_ERROR is raised.
  --|   If VAR_DIRECT_IO raises END_ERROR when we try to read the specified
  --|   block from the external file, then END_ERROR is raised.
  --|   If VAR_DIRECT_IO raises MODE_ERROR when we try to read the specified
  --|   block from the external file, then READ_MODE_ERROR is raised.
  --|
  --| NA
  --|   MODIFIES
  --|
  --| ALGORITHM
  --|   if the right block is not already in the buffer then
  --|     if block currently in buffer was modified then
  --|       write out the buffer to the external file
  --|     end if
  --|     read in the right block from the external file
  --|   end if

  begin
    if VAR_DIRECT_IO."/="( Block,  File.Block_In_Buffer )  then
      if File.Buffer_Was_Changed then                 -- write the changed block
        begin
          VAR_DIRECT_IO.WRITE (File => File.File_Identifier,
                               Item => File.Buffer,
                               To   => File.Block_In_Buffer);
        exception
          when STATUS_ERROR =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "STA_MC_A",
                                 "File not open for write --MOVE BLOCK    ");
               raise;
          when MODE_ERROR   =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "MOD_MC_A",
                                 "File wrong mode for write --MOVE BLOCK  ");
               raise;
          when USE_ERROR    =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "USE_MC_A",
                                 "Write exceeds file capacity --MOVE BLOCK");
               raise;
        end;
      end if;

      File.Block_In_Buffer := Block;

      if  (Process = Reading) or (File.Write_Index.Byte_Offset /= 1)  then
        begin                                               --read desired block
          VAR_DIRECT_IO.READ (File => File.File_Identifier,
                              Item => File.Buffer,
                              From => Block);
        exception
          when STATUS_ERROR =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "STA_MC_B",
                                 "File not open for read --MOVE BLOCK     ");
               raise;
          when MODE_ERROR   =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "MOD_MC_B",
                                 "File wrong mode for read --MOVE BLOCK   ");
               raise READ_MODE_ERROR;
          when DATA_ERROR   =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "DAT_MC_A",
                                 "Wrong data type on read --MOVE BLOCK    ");
               raise;
          when END_ERROR    =>
               MSIO.DISPLAY_MSG ("CMVLIO",
                                 "END_MC_A",
                                 "Read past end-of-file --MOVE BLOCK      ");
               raise;
        end;
      end if;

    end if;
  exception
    when STATUS_ERROR |
         MODE_ERROR   |
         USE_ERROR    |
         DATA_ERROR   |
         END_ERROR    => raise;              -- avoid "unexpected" message
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_MCA",
                           "UNEXPECTED ERROR moving block to buffer ");
         raise;
  end MOVE_CORRECT_BLOCK_INTO_BUFFER;

  pragma inline (MOVE_CORRECT_BLOCK_INTO_BUFFER);
  procedure WRITE_ITEM_INTO_BUFFER
            (Item : in     Record_Type;
             File : in out File_Type)  is

  --| OVERVIEW
  --|   This procedure is used only by WRITE.
  --|   It assumes we are writing at the end of the file.
  --|   If this procedure were used by REWRITE,
  --|   it would destroy data already in the file.
  --|   This procedure puts the given item into the block-long buffer
  --|   associated with the file supplied.
  --|
  --| REQUIRES
  --|   The given file must be of mode Inout_Mode and must be open.
  --|   We assume that calling subprograms have already checked these
  --|   two conditions.
  --|
  --| EFFECTS
  --|   The given item is put into the buffer associated with the given
  --|   file.
  --|   If the current buffer will be filled, it is automatically
  --|   written to the external file when full and the remainder of the item
  --|   is then put into a new buffer.
  --|   The file's Write_Index is updated (points to the byte immediately
  --|   following the last byte filled by this operation).
  --|
  --| RAISES
  --|   Propogates:
  --|     STATUS_ERROR, MODE_ERROR, USE_ERROR
  --|
  --| ERRORS
  --|   All error conditions are raised from DIRECT_IO.WRITE
  --|
  --| NA
  --|   MODIFIES
  --|
  --| ALGORITHM
  --|   We make use of Ada's CONSTRAINT_ERROR to implement this algorithm:
  --|
  --|     LOOP Forever
  --|        IF the remaining portion of Item fits into
  --|                  the available room in the Buffer THEN
  --|           COPY the remaining portion of Item into
  --|                  the available room in the Buffer
  --|           IF Byte_Offset + Item'LENGTH <= Buffer'RANGE'LAST THEN
  --|              Byte_Offset := Byte_Offset + Item'LENGTH
  --|              EXIT LOOP
  --|           ELSE
  --|              -- Item filled ALL available room in the Buffer
  --|              INCREMENT Block_Number
  --|              INITIALIZE Byte_Offset to 1
  --|              EXIT LOOP
  --|           END IF
  --|        ELSE
  --|           COPY as much of Item as will fit into the Buffer
  --|           WRITE Buffer out to the external file
  --|           INCREMENT Block_Number
  --|           INITIALIZE Byte_Offset to 1
  --|        END IF
  --|     END LOOP

  First : Non_Negative; --index of first char of item yet to be put into buffer
  Last  : Non_Negative; --index of last char of item yet to be put into buffer

  Fit : Buffer_Range_Type;   --number of characters that will fit into block

  begin
    First := Item'FIRST;
    Last  := Item'LAST;

    loop
      begin
        -- Try to COPY what remains of Item into Buffer
        File.Buffer ( File.Write_Index.Byte_Offset ..
                      File.Write_Index.Byte_Offset + (Last - First + 1) - 1 ) :=
               Item ( First .. Last );

        begin
          -- Try to update Byte_Offset
          File.Write_Index.Byte_Offset :=
               File.Write_Index.Byte_Offset + (Last - First + 1);

        exception
          when CONSTRAINT_ERROR =>
            -- Item ends exactly at end of block
            -- INCREMENT Block_Number and
            -- INITIALIZE Byte_Offset to 1
            File.Write_Index.Block_Number :=
                           VAR_DIRECT_IO."+" (File.Write_Index.Block_Number, 1);
            File.Write_Index.Byte_Offset  := 1;
        end;

        File.Buffer_Was_Changed := True;
        exit;

      exception
        when CONSTRAINT_ERROR =>  -- not all of the rest of Item fits into block
          Fit := (Buffer_Range_Type'LAST - File.Write_Index.Byte_Offset) + 1;

          -- COPY as much of Item as will fit into Buffer
          File.Buffer (File.Write_Index.Byte_Offset .. Buffer_Range_Type'LAST)
              := Item (First .. First + Fit - 1);

          -- WRITE Buffer out to external file
          begin
            VAR_DIRECT_IO.WRITE (File => File.File_Identifier,
                                 Item => File.Buffer,
                                 To   => File.Block_In_Buffer);
          exception
            when STATUS_ERROR =>
                 MSIO.DISPLAY_MSG ("CMVLIO",
                                   "STA_WIB_",
                                   "File not open for write --WRITE ITEM    ");
                 raise;
            when MODE_ERROR   =>
                 MSIO.DISPLAY_MSG ("CMVLIO",
                                   "MOD_WIB_",
                                   "File wrong mode for write --WRITE ITEM  ");
                 raise;
            when USE_ERROR    =>
                 MSIO.DISPLAY_MSG ("CMVLIO",
                                   "USE_WIB_",
                                   "Write exceeds file capacity --WRITE ITEM");
                 raise;
          end;

          -- INCREMENT Block_Number and INITIALIZE Byte_Offset to 1
          File.Write_Index.Block_Number :=
                           VAR_DIRECT_IO."+" (File.Write_Index.Block_Number, 1);
          File.Write_Index.Byte_Offset  := 1;

          File.Buffer := (Buffer_Range_Type => All_False);
          File.Block_In_Buffer := File.Write_Index.Block_Number;

          First := First + Fit;
      end;
    end loop;

  exception
    when STATUS_ERROR |
         MODE_ERROR   |
         USE_ERROR    |
         DATA_ERROR   |
         END_ERROR    => raise;    -- avoid "unexpected" message
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_WIB",
                           "UNEXPECTED ERROR writing into buffer    ");
         raise;
  end WRITE_ITEM_INTO_BUFFER;

  pragma inline (WRITE_ITEM_INTO_BUFFER);
  procedure PUT_ITEM_INTO_BUFFER
            (Item : in     Record_Type;
             File : in out File_Type)  is

  --| OVERVIEW
  --|   This procedure is used only by REWRITE.
  --|   It is significantly slower than WRITE_ITEM_INTO_BUFFER
  --|   and should NOT be called by WRITE (which must execute quickly).
  --|   This procedure puts the given item into the block-long buffer
  --|   associated with the file supplied.
  --|
  --| REQUIRES
  --|   The given file must be of mode Inout_Mode and must be open.
  --|   We assume that calling subprograms have already checked these
  --|   two conditions.
  --|
  --| EFFECTS
  --|   The given item is put into the buffer associated with the given
  --|   file.
  --|   If the current buffer will be filled, it is automatically
  --|   written to the external file when full and the remainder of the item
  --|   is then put into a new buffer.
  --|   The file's Write_Index is updated (points to the byte immediately
  --|   following the last byte filled by this operation).
  --|
  --| RAISES
  --|   Propogates:
  --|     STATUS_ERROR, MODE_ERROR, USE_ERROR, DATA_ERROR, END_ERROR,
  --|     READ_MODE_ERROR
  --|
  --| ERRORS
  --|   All the errors are raised from MOVE_CORRECT_BLOCK_INTO_BUFFER.
  --|   See that routine for causes of exceptions.
  --|
  --| NA
  --|   MODIFIES
  --|
  --| NOTES
  --|   MODE_ERROR and/or STATUS_ERROR may be raised from lower level.
  --|
  --| ALGORITHM
  --|   We make use of Ada's CONSTRAINT_ERROR to implement this algorithm:
  --|
  --|     LOOP Forever
  --|        IF the remaining portion of Item fits into
  --|                  th--|           IF Byte_Offset + Item'LENGTH <= Buffer'RANGE'LAST THEN
  --|              Byte_Offset := Byte_Offset + Item'LENGTH
  --|              EXIT LOOP
  --|           ELSE
  --|              -- Item filled ALL available room in the Buffer
  --|              INCREMENT Block_Number
  --|              INITIALIZE Byte_Offset to 1
  --|              EXIT LOOP
  --|           END IF
  --|        ELSE
  --|           COPY as much of Item as will fit into the Buffer
  --|           WRITE Buffer out to the external file
  --|           INCREMENT Block_Number
  --|           INITIALIZE Byte_Offset to 1
  --|        END IF
  --|     END LOOP


  First : Non_Negative; --index of first char of item yet to be put into buffer
  Last  : Non_Negative; --index of last char of item yet to be put into buffer

  Fit : Buffer_Range_Type;   --number of characters that will fit into block

  begin
    First := Item'FIRST;
    Last  := Item'LAST;

    loop
      begin
        -- Try to COPY what remains of Item into Buffer
        File.Buffer ( File.Write_Index.Byte_Offset ..
                      File.Write_Index.Byte_Offset + (Last - First + 1) - 1 ) :=
               Item ( First .. Last );

        begin
          -- Try to update Byte_Offset
          File.Write_Index.Byte_Offset :=
               File.Write_Index.Byte_Offset + (Last - First + 1);

        exception
          when CONSTRAINT_ERROR =>       -- Item ends exactly at end of block
            -- INCREMENT Block_Number and INITIALIZE Byte_Offset to 1
            File.Write_Index.Block_Number :=
                           VAR_DIRECT_IO."+" (File.Write_Index.Block_Number, 1);
            File.Write_Index.Byte_Offset  := 1;
        end;

        File.Buffer_Was_Changed := True;
        exit;

      exception
        when CONSTRAINT_ERROR =>  -- not all of the rest of Item fits into block
          Fit := (Buffer_Range_Type'LAST - File.Write_Index.Byte_Offset) + 1;

          -- COPY as much of Item as will fit into Buffer
          File.Buffer (File.Write_Index.Byte_Offset .. Buffer_Range_Type'LAST)
              := Item (First .. First + Fit - 1);

          File.Buffer_Was_Changed := True;

          -- INCREMENT Block_Number and INITIALIZE Byte_Offset to 1
          File.Write_Index.Block_Number :=
                           VAR_DIRECT_IO."+" (File.Write_Index.Block_Number, 1);
          File.Write_Index.Byte_Offset  := 1;

          begin
            -- WRITE Buffer out to external file
            MOVE_CORRECT_BLOCK_INTO_BUFFER(File, File.Write_Index.Block_Number);
          exception
            when END_ERROR => null;         -- do not raise
                                            -- just means we're writing at EOF
            when others    =>
                 MSIO.DISPLAY_MSG ("CMVLIO",
                                   "MOV_PI_A",
                                   "Could not move correct block --PUT ITEM ");
                 raise;
          end;

          First := First + Fit;
      end;
    end loop;

  exception
    when STATUS_ERROR |
         MODE_ERROR   |
         USE_ERROR    |
         DATA_ERROR   |
         END_ERROR    => raise;    -- avoid "unexpected" message
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_PIA",
                           "UNEXPECTED ERROR putting into buffer    ");
         raise;
  end PUT_ITEM_INTO_BUFFER;
  procedure GET_ITEM_FROM_BUFFER
            (File : in out File_Type;
             Item :    out Record_Type)  is

  --| OVERVIEW
  --|   This procedure gets a value for the supplied item out of the
  --|   block-long buffer associated with the given file.
  -- open.
  --|   We assume that calling subprograms have checked this condition.
  --|
  --| EFFECTS
  --|   The value of the given item is extracted from the block-long
  --|   buffer associated with the given buffer.
  --|   If the value for the given item overlaps into the next block of
  --|   the file, that next block is brought into the buffer and the
  --|   remainder of the given value is extracted from there.
  --|
  --| RAISES
  --|   Propogates:
  --|     STATUS_ERROR, MODE_ERROR, USE_ERROR, DATA_ERROR, END_ERROR,
  --|     READ_MODE_ERROR
  --|
  --| ERRORS
  --|   All the errors are raised from MOVE_CORRECT_BLOCK_INTO_BUFFER.
  --|   See that routine for causes of exceptions.
  --|
  --| NA
  --|   MODIFIES
  --|
  --| ALGORITHM
  --|   We make use of Ada's CONSTRAINT_ERROR to implement this algorithm:
  --|
  --|     LOOP Forever
  --|        IF the remaining portion of the desired Item is in the Buffer THEN
  --|           COPY the remaining portion of Item from the Buffer
  --|           IF Byte_Offset + Item'LENGTH <= Buffer'RANGE'LAST  THEN
  --|              Byte_Offset := Byte_Offset + Item'LENGTH
  --|              EXIT LOOP
  --|           ELSE
  --|              -- Item ended exactly at the end of the Buffer
  --|              INCREMENT Block_Number
  --|              INITIALIZE Byte_Offset to 1
  --|              EXIT LOOP
  --|           END IF
  --|        ELSE
  --|           COPY as much of Item as is in the Buffer
  --|           READ next block into Buffer from the external file
  --|           INCREMENT Block_Number
  --|           INITIALIZE Byte_Offset to 1
  --|        END IF
  --|     END LOOP

  First : Non_Negative; --index of first char of item yet to be got from buffer
  Last  : Non_Negative; --index of last char of item yet to be got from buffer

  Available : Buffer_Range_Type; --number of characters that will fit into block

  begin
    First := Item'FIRST;
    Last  := Item'LAST;

    loop
      begin
        -- Try to copy remainder of Item from Buffer
        Item (First .. Last) :=
        File.Buffer ( File.Read_Index.Byte_Offset ..
                      File.Read_Index.Byte_Offset + (Last - First + 1) - 1 );

        begin
          -- Try to update Byte_Offset
          File.Read_Index.Byte_Offset :=
               File.Read_Index.Byte_Offset + (Last - First + 1);

        exception
          when CONSTRAINT_ERROR =>       -- Item ends exactly at end of block
            -- INCREMENT Block_Number and INITIALIZE Byte_Offset to 1
            File.Read_Index.Block_Number :=
                            VAR_DIRECT_IO."+" (File.Read_Index.Block_Number, 1);
            File.Read_Index.Byte_Offset  := 1;
        end;

        exit;

      exception
        when CONSTRAINT_ERROR =>  -- not all of the rest of Item is in block
          Available :=
                    (Buffer_Range_Type'LAST - File.Read_Index.Byte_Offset) + 1;

          -- COPY as much of Item as is in Buffer
          Item (First .. First + Available - 1) :=
          File.Buffer (File.Read_Index.Byte_Offset .. Buffer_Range_Type'LAST);

          -- INCREMENT Block_Number and INITIALIZE Byte_Offset to 1
          File.Read_Index.Block_Number :=
                          VAR_DIRECT_IO."+" (File.Read_Index.Block_Number, 1);
          File.Read_Index.Byte_Offset  := 1;

          begin
            -- READ next block in from external file
            MOVE_CORRECT_BLOCK_INTO_BUFFER (File, File.Read_Index.Block_Number);
          exception
            when END_ERROR =>
                 MSIO.DISPLAY_MSG ("CMVLIO",
                                   "END_GI_A",
                                   "Read past end-of-file --GET ITEM        ");
                 raise;
            when others    =>
                 MSIO.DISPLAY_MSG ("CMVLIO",
                                   "MOV_GI_A",
                                   "Could not move correct block --GET ITEM ");
                 raise;
          end;

          First := Buffer_Range_Type(First) + Available;
      end;
    end loop;

  exception
    when STATUS_ERROR |
         MODE_ERROR   |
         USE_ERROR    |
         DATA_ERROR   |
         END_ERROR    => raise;      -- avoid "unexpected" message
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_GIA",
                           "UNEXPECTED ERROR getting from buffer    ");
         raise;
  end GET_ITEM_FROM_BUFFER;
---------------------------------------------------------------------------
----                                                                   ----
--                         PACKAGE ENTRY POINTS                          --
----                                                                   ----
---------------------------------------------------------------------------


  procedure CREATE
            ( File : in out File_Type;
              Mode : in     File_Mode_Type := Inout_Mode;
              Name : in     string := "";
              Form : in     string := "" )  is

  --| OVERVIEW
  --|   This procedure is similar the CREATE routine of the DIRECT_IO
  --|   package and is used to establish a new external file, with the
  --|   given name, mode and form, and to associate this external file
  --|   with the given file.  The given file is left open.  The default
  --|   access mode is Inout_Mode.
  --|
  --| ALGORITHM
  --|   Use procedure of same name from DIRECT_IO.

  File_Header : File_Header_Type;

  Converted_Mode : VAR_DIRECT_IO.File_Mode;

  begin
    if mode = In_Mode then
      Converted_Mode := VAR_DIRECT_IO.In_File;
      File.Write_Index := NIL;
    else
      Converted_Mode := VAR_DIRECT_IO.Inout_File;
    end if;

    begin
      VAR_DIRECT_IO.CREATE ( File => File.File_Identifier,
                             Mode => Converted_Mode,
                             Name => Name,
                             Form => Form );
    exception
      when STATUS_ERROR =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "STA_CR_A",
                             "File already open when trying to CREATE ");
           raise VLIO_STATUS_ERROR;
      when NAME_ERROR   =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "NAM_CR_B",
                             "Illegal Name specified on CREATE        ");
           raise VLIO_NAME_ERROR;
      when USE_ERROR    =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "USE_CR_B",
                             "Illegal Mode or Form specified on CREATE");
           raise VLIO_USE_ERROR;
    end;

    File.Is_Open := True;
    File.Mode    := Mode;

    if  Mode = Inout_Mode  then
      File_Header := ( File_Kind   => VLIO_File_Flag,
                       Write_Index => (0, 0) );

      begin
        WRITE                   -- write file header
        ( File => File,                    -- end index will be updated at close
          Item => FILE_HEADER_TO_VLIO_RECORD (File_Header) );
      exception
        when others =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "WR_CR_FH",
                               "Error writing File Header during CREATE ");
             raise;
      end;
    end if;

  exception
    when VLIO_USE_ERROR |
         VLIO_NAME_ERROR |
         VLIO_STATUS_ERROR => raise;     -- avoid "unexpected" message
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_CRA",
                           "UNEXPECTED ERROR when trying to CREATE  ");
         raise;
  end CREATE;



  procedure OPEN
            ( File : in out File_Type;
              Mode : in   File_Mode_Type;
              Name : in   string;
              Form : in   string := "" )  is

  --| OVERVIEW
  --|   This procedure is used similarly to the open routine in the
  --|   DIRECT_IO package.  The given file is associated with an existing
  --|   external file having the given name and form, and sets the current
  --|   mode of the given file to the given mode.  The given file is left
  --|   open and the current read index and write index are set to the
  --|   index of the first user record.
  --|
  --| ALGORITHM
  --|   Use procedure of same name from DIRECT_IO.
  --|   READ the Write_Index (End-Of-File pointer) from the file.

  File_Header : VLIO_File_Header_Type;

  Converted_Mode : VAR_DIRECT_IO.File_Mode;

  begin
    if mode = In_Mode then
      Converted_Mode := VAR_DIRECT_IO.In_File;
    else
      Converted_Mode := VAR_DIRECT_IO.Inout_File;
    end if;

    begin
      VAR_DIRECT_IO.Open ( File => File.File_Identifier,
                           Mode => Converted_Mode,
                           Name => Name,
                           Form => Form );
    exception
      when STATUS_ERROR =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "STA_OP_A",
                             "File already open when trying to OPEN   ");
           raise VLIO_STATUS_ERROR;
      when NAME_ERROR   =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "NAM_OP_B",
                             "Illegal Name specified on OPEN          ");
           raise VLIO_NAME_ERROR;
      when USE_ERROR    =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "USE_OP_B",
                             "Illegal Mode or Form specified on OPEN  ");
           raise VLIO_USE_ERROR;
    end;

    File.Is_Open := True;
    File.Mode    := Mode;

    --  Find the end-of-file index;  It is part of the File_Header.
    --  First, set Write Index to its highest possible value so that
    --  we don't "read past end-of-file" when searching for the real
    --  Write Index (end-of-file indicator).
    File.Write_Index.Block_Number := VAR_DIRECT_IO.Count'LAST;
    File.Write_Index.Byte_Offset  := Byte_Range_Type'LAST;
    begin
      READ ( File => File,
                        Item => File_Header,
                        From => Start_Of_File );
      File.Write_Index := VLIO_RECORD_TO_FILE_HEADER( File_Header ).Write_Index;
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "RD_OP_FH",
                             "Error reading File Header during OPEN   ");
           raise;
    end;
  exception
    when VLIO_USE_ERROR |
         VLIO_NAME_ERROR |
         VLIO_STATUS_ERROR => raise;    -- avoid "unexpected" message
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_OPA",
                           "UNEXPECTED ERROR on OPEN attempt        ");
         raise;
  end OPEN;



  procedure CLOSE ( File : in out File_Type )  is

  --| OVERVIEW
  --|   This procedure is used to sever the association between the given
  --|   file and its associated external file.  The file is left closed.
  --|
  --| ALGORITHM
  --|   Update the Write_Index (End-Of-File pointer) on file if necessary.
  --|   Use procedure of same name from DIRECT_IO.

  File_Header : File_Header_Type;

  begin
    if  File.Mode = Inout_Mode  then
      -- Update the end-of-file index;
      -- It is part of the File_Header
      begin
        File_Header := (VLIO_File_Flag,  File.Write_Index);
        REWRITE ( File,                  -- update EOF index
                             FILE_HEADER_TO_VLIO_RECORD ( File_Header ),
                             Start_Of_File );
      exception
        when others =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "RW_CL_FH",
                               "Error rewriting File Header during CLOSE");
             raise;
      end;

      begin
        VAR_DIRECT_IO.WRITE ( File.File_Identifier,   -- flush the buffer
                              File.Buffer,            -- (first block of file)
                              1 );
      exception
        when STATUS_ERROR =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "STA_FL__",
                               "File not open to Flush during CLOSE     ");
             raise VLIO_STATUS_ERROR;
        when MODE_ERROR   =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "MOD_FL__",
                               "File wrong mode to Flush during CLOSE   ");
             raise;
        when USE_ERROR    =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "USE_FL__",
                               "Flush excedes file capacity during CLOSE");
             raise;
      end;
    end if;

    begin
      VAR_DIRECT_IO.CLOSE ( File => File.File_Identifier );  -- close the file
    exception
      when STATUS_ERROR =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "STA_CL_A",
                             "File not open when trying to CLOSE      ");
           raise VLIO_STATUS_ERROR;
    end;

    File.Is_Open := False;

  exception
    when VLIO_STATUS_ERROR => raise;     -- avoid "unexpected" message
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_CLA",
                           "UNEXPECTED ERROR when trying to CLOSE   ");
         raise;
  end CLOSE;



  procedure DELETE ( File : in out File_Type )  is

  --| OVERVIEW
  --|   This procedure is similar to the DELETE routine of the DIRECT_IO
  --|   package and is used to delete the external file associated with
  --|   the given file.  The given file is closed, and the external file
  --|   ceases to exist.
  --|
  --| ALGORITHM
  --|   Use procedure of same name from DIRECT_IO.

  begin
    VAR_DIRECT_IO.DELETE ( File => File.File_Identifier );
    File.Is_Open := False;
  exception
    when STATUS_ERROR =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "STA_DE_A",
                           "File not open when trying to DELETE     ");
         raise VLIO_STATUS_ERROR;
    when USE_ERROR    =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "USE_DE_A",
                           "Action not allowed when trying to DELETE");
         raise VLIO_USE_ERROR;
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_DEA",
                           "UNEXPECTED ERROR when trying to DELETE  ");
         raise;
  end DELETE;



  procedure RESET_FILE ( File : in out File_Type )  is

  --| OVERVIEW
  --|   This procedure resets the given file of any mode so that
  --|   reading from its elements can be restarted from the beginning of
  --|   the file;  in particular, for direct access this means that the
  --|   current index is set to the index of the first user record.
  --|
  --| ALGORITHM
  --|   Read File Header to set read index to first user record.

  File_Header : VLIO_File_Header_Type;

  begin
    begin
      READ ( File => File,
                        Item => File_Header,
                        From => Start_Of_File );
    exception
      when VLIO_STATUS_ERROR =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "STA_RS_A",
                             "File not open when trying to RESET      ");
           raise;
      when others            =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "UNEX_RSA",
                             "UNEXPECTED ERROR when trying to RESET   ");
           raise;
    end;
  end RESET_FILE;



  function MODE ( File : in File_Type ) return File_Mode_Type  is

  --| OVERVIEW
  --|   This procedure is similar to the MODE routine of the DIRECT_IO
  --|   package and returns the current mode of the given file.
  --|
  --| ALGORITHM
  --|   Use function of same name from DIRECT_IO.

  Mode_Of_File : VAR_DIRECT_IO.File_Mode;

  begin
    return File.Mode;
  exception
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_MOA",
                           "UNEXPECTED ERROR when finding MODE      ");
         raise;
  end MODE;



  function NAME ( File : in File_Type ) return string  is

  --| OVERVIEW
  --|   This procedure is similar to NAME routine of the DIRECT_IO package
  --|   and returns a string which uniquely identifies the external file
  --|   currently associated with the given file.
  --|
  --| ALGORITHM
  --|   Use function of same name from DIRECT_IO.

  begin
    return VAR_DIRECT_IO.Name ( File => File.File_Identifier );
  exception
    when STATUS_ERROR =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "STA_NA_A",
                           "File not open when finding NAME         ");
         raise VLIO_STATUS_ERROR;
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_NAA",
                           "UNEXPECTED ERROR when finding NAME      ");
         raise;
  end NAME;



  function FORM ( File : in File_Type ) return string  is

  --| OVERVIEW
  --|   This procedure is similar to the FORM routine of the DIRECT_IO
  --|   package and returns the form string for the external file currently
  --|   associated with the given file.
  --|
  --| ALGORITHM
  --|   Use function of same name from DIRECT_IO.

  begin
    return VAR_DIRECT_IO.FORM ( File => File.File_Identifier );
  exception
    when STATUS_ERROR =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "STA_FO_A",
                           "File not open when finding FORM         ");
         raise VLIO_STATUS_ERROR;
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_FOA",
                           "UNEXPECTED ERROR when finding FORM      ");
         raise;
  end FORM;



  function IS_OPEN ( File : in File_Type ) return boolean  is

  --| OVERVIEW
  --|   The function IS_OPEN is used similarly to the IS_OPEN routine in the
  --|   DIRECT_IO package.  It returns TRUE if the given file is open;
  --|   otherwise it returns FALSE.
  --|
  --| ALGORITHM
  --|   Use function of same name from DIRECT_IO.

  begin
    return File.Is_Open;
  exception
    when others =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_IOA",
                           "UNEXPECTED ERROR when checking IS_OPEN  ");
         raise;
  end IS_OPEN;



  procedure READ
            ( File : in out File_Type;
              Item : out  Record_Type )  is

  --| OVERVIEW
  --|   This procedure is similar to the sequential Read routine of the
  --|   DIRECT_IO package.  It operates on a file of any mode and
  --|   returns in the parameter Item, the value of the element whose
  --|   position is given by the current index of the file.
  --|   The current read index is increased by one.
  --|
  --| ALGORITH
  --|   Check open.
  --|   Get correct block into buffer.
  --|   Get length of next record from buffer and compare to Item'LENGTH.
  --|   Get the item from the buffer.

  Record_Length : VLIO_Non_Negative;

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_RD_A",
                        "File not open when trying to READ       ");
      raise STATUS_ERROR;
    end if;

    if  File.Read_Index >= File.Write_Index  then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "END_RD_A",
                        "Past end-of-file when beginning READ    ");
      raise END_ERROR;
    end if;

    begin
      MOVE_CORRECT_BLOCK_INTO_BUFFER( File  => File,
                                      Block => File.Read_Index.Block_Number );
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "MOV_RD_A",
                             "Error moving block when beginning READ  ");
           raise;
    end;

    begin
      GET_ITEM_FROM_BUFFER ( File => File,
                             Item => Record_Length );
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "GET_RD_A",
                             "Error getting item when beginning READ  ");
           raise;
    end;

    if VLIO_RECORD_TO_NON_NEGATIVE (Record_Length) = Item'LENGTH then
      begin
        MOVE_CORRECT_BLOCK_INTO_BUFFER( File  => File,
                                        Block => File.Read_Index.Block_Number );
      exception
        when others =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "MOV_RD_B",
                               "Error moving block when finishing READ  ");
             raise;
      end;

      begin
        GET_ITEM_FROM_BUFFER ( File => File,
                               Item => Item );
      exception
        when others =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "GET_RD_B",
                               "Error getting item when finishing READ  ");
             raise;
      end;
    else
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "DAT_RD_A",
                        "Record on file wrong size during READ   ");
      raise DATA_ERROR;
    end if;

    if  File.Read_Index > File.Write_Index  then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "END_RD_B",
                        "Past end-of-file when finishing READ    ");
      raise END_ERROR;
    end if;

  exception
    when STATUS_ERROR => raise VLIO_STATUS_ERROR;
    when DATA_ERROR   => raise VLIO_DATA_ERROR;
    when END_ERROR    => raise VLIO_END_ERROR;
    when others       =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX__RD",
                           "UNEXPECTED ERROR READing record         ");
         raise;
  end READ;



  procedure READ
            ( File : in out File_Type;
              From : in   Internal_File_Pointer_Type;
              Item : out  Record_Type )  is

  --| OVERVIEW
  --|   This procedure is similar to the direct READ routine of the
  --|   DIRECT_IO package.  It operates on a file of any mode and sets
  --|   the current read index of the given file to the index value given by
  --|   the parameter From.  It returns in the parameter Item, the value
  --|   of the element whose position is given by the current read index of the
  --|   file.  The current read index is advanced.
  --|
  --| ALGORITHM
  --|   Check From.
  --|   Set read index.
  --|   Call READ.

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_RF_A",
                        "File not open when trying to Direct-READ");
      raise VLIO_STATUS_ERROR;
    end if;

    if  VAR_DIRECT_IO."<" (From.Block_Number, 1)  then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "POI_RF_A",
                        "Direct-READ from before start-of-file   ");
      raise VLIO_POINTER_ERROR;
    end if;

    File.Read_Index := From;

    begin
      READ ( File => File,
             Item => Item );
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "RD_RF_A_",
                             "Read Error when trying to Direct-READ   ");
           raise;
    end;
  exception
    when VLIO_END_ERROR     |
         VLIO_DATA_ERROR    |
         VLIO_STATUS_ERROR  |
         VLIO_POINTER_ERROR => raise;
    when END_ERROR          => raise VLIO_END_ERROR;
    when others             =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_RDF",
                           "UNEXPECTED ERROR Direct-READing record  ");
         raise;
  end READ;



  procedure WRITE
            ( File : in out File_Type;
              Item : in     Record_Type )  is

  --| OVERVIEW
  --|   This procedure operates on a file of mode Inout_Mode and writes a
  --|   record of Record_Type to the position in the file denoted by the
  --|   current write index.  The current write index is advanced.
  --|
  --| ALGORITHM
  --|   Check open and Mode.
  --|   Get correct block into the buffer.
  --|   Put the item into the buffer.

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_WR_A",
                        "File not open when trying to WRITE      ");
      raise VLIO_STATUS_ERROR;
    end if;

    if File.Mode /= Inout_Mode then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "MOD_WR_A",
                        "File wrong mode when trying to WRITE    ");
      raise VLIO_MODE_ERROR;
    end if;

    begin
      MOVE_CORRECT_BLOCK_INTO_BUFFER (File    => File,
                                      Block   => File.Write_Index.Block_Number,
                                      Process => Writing);
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "MOV_WR_A",
                             "Error moving block into buffer --WRITE  ");
           raise;
    end;

    begin
      WRITE_ITEM_INTO_BUFFER
          ( File => File,
            Item => ( NON_NEGATIVE_TO_VLIO_RECORD( Item'LENGTH ) & Item )
          );
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "WRI_WR_A",
                             "Error writing item into buffer --WRITE  ");
           raise;
    end;

  exception
    when STATUS_ERROR | VLIO_STATUS_ERROR =>
         raise VLIO_STATUS_ERROR;
    when MODE_ERROR | VLIO_MODE_ERROR =>
         raise VLIO_MODE_ERROR;
    when USE_ERROR | VLIO_USE_ERROR =>
         raise VLIO_USE_ERROR;
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_WRA",
                           "UNEXPECTED ERROR WRITing record         ");
         raise;
  end WRITE;


  procedure REWRITE
            ( File : in out File_Type;
              Item : in     Record_Type;
              To   : in     Internal_File_Pointer_Type )  is

  --| OVERVIEW
  --|   This procedure writes a record of Record_Type to
  --|   the index specified by the To paramenter.
  --|
  --| ALGORITHM
  --|   Check open, Mode, and To.
  --|   Save indexes.
  --|   Get the item at specified place and compare lengths of items.
  --|   Put the given item into the buffer.
  --|   Restore the indexes.
  --|
  --| NOTES
  --|   REWRITE'ing to the end of the file is NOT allowed!

  Temp_Read_Index  : Internal_File_Pointer_Type;
  Temp_Write_Index : Internal_File_Pointer_Type;

  Record_Length : VLIO_Non_Negative;

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_RW_A",
                        "File not open when trying to REWRITE    ");
      raise VLIO_STATUS_ERROR;
    end if;

    if File.Mode /= Inout_Mode then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "MOD_RW_A",
                        "File wrong mode when trying to REWRITE  ");
      raise VLIO_MODE_ERROR;
    end if;

    if  To < Start_Of_File  then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "POI_RW_A",
                        "Cannot REWRITE before start-of-file     ");
      raise VLIO_POINTER_ERROR;
    end if;

    if To >= File.Write_Index then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "END_RW_A",
                        "Cannot REWRITE past end-of-file         ");
      raise VLIO_END_ERROR;
    end if;

    Temp_Read_Index  := File.Read_Index;
    Temp_Write_Index := File.Write_Index;
    File.Read_Index  := To;

    begin
      MOVE_CORRECT_BLOCK_INTO_BUFFER (File  => File,
                                      Block => File.Read_Index.Block_Number);
    exception
      when END_ERROR => null;
      when others    =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "MOV_RW_A",
                             "Error moving block --beginning REWRITE  ");
           raise;
    end;

    begin
      GET_ITEM_FROM_BUFFER ( File => File,
                             Item => Record_Length );
    exception
      when others =>
           MSIO.DISPLAY_MSG ("CMVLIO",
                             "GET_RW_A",
                             "Error getting item --beginning REWRITE  ");
           raise;
    end;

    if VLIO_RECORD_TO_NON_NEGATIVE (Record_Length) = Item'LENGTH then
      File.Write_Index := File.Read_Index;

      begin
        MOVE_CORRECT_BLOCK_INTO_BUFFER (File  => File,
                                        Block => File.Write_Index.Block_Number);
      exception
        when END_ERROR => null;
        when others    =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "MOV_RW_B",
                               "Error moving block --finishing REWRITE  ");
             raise;
      end;

      begin
        PUT_ITEM_INTO_BUFFER ( File => File,
                               Item => Item );
      exception
        when others =>
             MSIO.DISPLAY_MSG ("CMVLIO",
                               "PUT_RW_A",
                               "Error putting item --finishing REWRITE  ");
             raise;
      end;

    else
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "SIZ_RW_A",
                        "Record on file wrong size during REWRITE");
      raise VLIO_RECORD_SIZE_ERROR;
    end if;

    File.Read_Index  := Temp_Read_Index;
    File.Write_Index := Temp_Write_Index;
  exception
    when STATUS_ERROR | VLIO_STATUS_ERROR =>
         raise VLIO_STATUS_ERROR;
    when MODE_ERROR | VLIO_MODE_ERROR =>
         raise VLIO_MODE_ERROR;
    when END_ERROR | VLIO_END_ERROR =>
         raise VLIO_END_ERROR;
    when USE_ERROR | VLIO_USE_ERROR =>
         raise VLIO_USE_ERROR;
    when VLIO_POINTER_ERROR | VLIO_RECORD_SIZE_ERROR =>
         raise;
    when others =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_RWE",
                           "UNEXPECTED ERROR REWRITing record       ");
         raise;
  end REWRITE;


  procedure SET_READ_INDEX
            ( File : in out File_Type;
              To   : in     Internal_File_Pointer_Type )  is

  --| OVERVIEW
  --|   This procedure operates on a file any mode and sets the current
  --|   read index of the given file to the value of the To parameter.
  --|
  --| ALGORITHM
  --|   Check open and To
  --|   Set read index = To.

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_SR_A",
                        "File not open to SET READ INDEX         ");
      raise VLIO_STATUS_ERROR;
    end if;

    if  To < Start_Of_File  then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "POI_SR_A",
                        "SETting READ INDEX before start-of-file ");
      raise VLIO_POINTER_ERROR;
    else
      File.Read_Index := To;
    end if;

  exception
    when VLIO_STATUS_ERROR | VLIO_POINTER_ERROR =>
         raise;
    when others =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_SRA",
                           "UNEXPECTED ERROR SETting READ INDEX     ");
         raise;
  end SET_READ_INDEX;



  procedure SET_WRITE_INDEX
            ( File : in out File_Type;
              To   : in     Internal_File_Pointer_Type )  is

  --| OVERVIEW
  --|   This procedure operates on a file of mode Inout_Mode and sets the
  --|   current write index of the given file to the value of the To parameter.
  --|   Records previously written at or after the To parameter will be
  --|   irretrievable.
  --|
  --| ALGORITHM
  --|   Check open and mode.
  --|   Set write index = To.
  --|   Clear the rest of the file

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_SW_A",
                        "File not open to SET WRITE INDEX        ");
      raise VLIO_STATUS_ERROR;
    end if;

    if File.Mode /= Inout_Mode then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "MOD_SW_A",
                        "File wrong mode to  SET WRITE INDEX     ");
      raise VLIO_MODE_ERROR;
    end if;

    if  To < Start_Of_File  then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "POI_SW_A",
                        "SETting WRITE INDEX before start-of-file");
      raise VLIO_POINTER_ERROR;
    end if;

    if To > File.Write_Index then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "END_SW_A",
                        "SETting WRITE INDEX after end-of-file   ");
      raise VLIO_END_ERROR;
    end if;

    File.Write_Index := To;

  exception
    when VLIO_STATUS_ERROR |
         VLIO_MODE_ERROR   |
         VLIO_END_ERROR    |
         VLIO_POINTER_ERROR => raise;
    when others             =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_SWA",
                           "UNEXPECTED ERROR SETting WRITE INDEX    ");
         raise;
  end SET_WRITE_INDEX;



  function READ_INDEX
           ( File : in File_Type ) return Internal_File_Pointer_Type  is

  --| OVERVIEW
  --|   This procedure operates on a file of any mode and returns the
  --|   current read index of the given file.
  --|
  --| ALGORITHM
  --|   Check open.
  --|   Return the value of the file's read index.

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_RI_A",
                        "File not open when finding READ INDEX   ");
      raise VLIO_STATUS_ERROR;
    end if;

    return File.Read_Index;
  exception
    when VLIO_STATUS_ERROR => raise;
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_RIA",
                           "UNEXPECTED ERROR finding READ INDEX     ");
         raise;
  end READ_INDEX;



  function WRITE_INDEX
           ( File : in File_Type ) return Internal_File_Pointer_Type  is

  --| OVERVIEW
  --|   This procedure operates on a file of Inout mode and returns the
  --|   current write index of the given file.
  --|
  --| ALGORITHM
  --|   Check open and mode.
  --|   Return the value of the file's write index.

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_WI_A",
                        "File not open when finding WRITE INDEX  ");
      raise VLIO_STATUS_ERROR;
    end if;

    if File.Mode /= Inout_Mode then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "MOD_WI_A",
                        "File wrong mode when finding WRITE INDEX");
      raise VLIO_MODE_ERROR;
    end if;

    return File.Write_Index;
  exception
    when VLIO_STATUS_ERROR |
         VLIO_MODE_ERROR   => raise;
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_WIA",
                           "UNEXPECTED ERROR finding WRITE INDEX    ");
         raise;
  end WRITE_INDEX;



  function SIZE ( File : in File_Type ) return Block_Count_Type  is

  --| OVERVIEW
  --|   This function operates on a file of any mode and returns the current
  --|   number of bytes in the file.  Some of those bytes may not yet have
  --|   been written to the external file.
  --|
  --| ALGORITHM
  --|   Check open.
  --|   Return number of bytes in file.

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_SZ_A",
                        "File not open when finding SIZE         ");
      raise VLIO_STATUS_ERROR;
    else
      return Block_Count_Type (
  ((Integer(File.Write_Index.Block_Number) - 1) * Integer(Byte_Range_Type'LAST))
  + Integer(File.Write_Index.Byte_Offset)  - 1
                        );
    end if;
  exception
    when VLIO_STATUS_ERROR => raise;
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_SZA",
                           "UNEXPECTED ERROR finding SIZE           ");
         raise;
  end SIZE;



  function END_OF_FILE ( File : in File_Type ) return boolean  is

  --| OVERVIEW
  --|   This function is similar to the END_OF_FILE routine in the DIRECT_IO
  --|   package.  It operates on a file of any mode and returns TRUE if the
  --|   current read index exceeds the size of the external file;
  --|   otherwise it returns FALSE.
  --|
  --| ALGORITHM
  --|   If read index is greater than end index then return true
  --|   else return false

  begin
    if not File.Is_Open then
      MSIO.DISPLAY_MSG ("CMVLIO",
                        "STA_EO_A",
                        "File not open when checking END-OF-FILE ");
      raise VLIO_STATUS_ERROR;
    end if;

    if File.Read_Index >= File.Write_Index then
      return True;
    else
      return False;
    end if;
  exception
    when VLIO_STATUS_ERROR => raise;
    when others            =>
         MSIO.DISPLAY_MSG ("CMVLIO",
                           "UNEX_EOF",
                           "UNEXPECTED ERROR checking END-OF-FILE   ");
         raise;
  end END_OF_FILE;



  function NIL return Internal_File_Pointer_Type  is

  --| OVERVIEW
  --|   This function returns the value nil (or null or nothing) in the
  --|   form Internal_File_Pointer_Type.
  --|
  --| ALGORITHM
  --|   NIL = Internal_File_Pointer_Type'( Block_Number => 0,
  --|                                      Byte_Offset  => 0 );

  begin
    return Internal_File_Pointer_Type'( Block_Number => 0,
                                        Byte_Offset  => 0 );
  end NIL;



  function IS_NIL
           ( Internal_Ptr : in Internal_File_Pointer_Type ) return boolean  is

  --|  OVERVIEW
  --|    This function returns true if the value of Internal_Ptr is nil;
  --|    otherwise it returns false.
  --|
  --|  ALGORITHM
  --|    TRUE iff Internal_ptr = NIL

  Result : Boolean;

  begin
    Result := False;

    if  Internal_Ptr = Internal_File_Pointer_Type'(0, 0)  then
      Result := True;
    end if;

    return Result;
  end IS_NIL;


end VARIABLE_LENGTH_DIRECT_IO;