Re: Ada95 Streams

[david.c.hoos.sr@ada95.com]

In article <742rpk$2t4$1@nnrp1.dejanews.com>,
  david_jones_98@yahoo.com wrote:
> I'm using stream_io get heterogeneous (several different types) input from a
> binary file, which works great. I read in a block of data from the file, then
> perform a crc check on it, and then if the crc is ok, i need to read some
> records from that block of data which is now in memory. I'd like to do this
> using the same stream attributes I use when reading from the file.
>
> How should I extend the root_stream_type to do this? At the moment I store the
> block of data as an array of bytes.
>
> -----------== Posted via Deja News, The Discussion Network ==----------
> http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own
>

Here is my implementation of a memory stream
-----------------------------------------------------------------------------
--- --	Copyright 1998, Ada95 Press, Inc. --  All rights reserved -- Author:
David C. Hoos, Sr. -- Department: Library Development -- Revision History: --
 1998/05/12 David C. Hoos, Sr. --  - Original version.
-----------------------------------------------------------------------------
---

--------------------------------------------------------------------------------
-- STREAMS:
-- Purpose:
--   This package defines the parent package for user-defined streams.
package Streams is

   pragma Pure (Streams);

   Rcsid : constant String :=
      "$Id";

end Streams; -- $Log $ --
-----------------------------------------------------------------------------
--- --	Copyright 1998, Ada95 Press, Inc. --  All rights reserved -- Author:
David C. Hoos, Sr. -- Department: Library Development -- Revision History: --
 1998/05/12 David C. Hoos, Sr. --  - Original version.
-----------------------------------------------------------------------------
---

--------------------------------------------------------------------------------
-- STREAMS.MEMORY:
-- Purpose:
--   This package implements in-memory streams.
with Ada.Streams;
with System;
package Streams.Memory is

   subtype Address_Type is System.Address;
   use type System.Address;

   type Stream_Descriptor_Type is new
      Ada.Streams.Root_Stream_Type with private;

   type Mode_Type is (Read, Write);

 
-----------------------------------------------------------------------------
 -- Open  -- Purpose:  --  This procedure opens the specified region of
memory for the specified  --  operation as the specifed stream.  --
Exceptions:  --  Use_Error (see cionditions ate description of Use_Error). 
procedure Open	(From_The_Address : Address_Type;  To_The_Address  :
Address_Type;  With_The_Mode  : Mode_Type;  As_The_Stream  : in out
Stream_Descriptor_Type);

 
-----------------------------------------------------------------------------
 -- Open  -- Purpose:  --  This procedure closes the specified memory_stream 
-- Exceptions:	--  Use_Error (see cionditions ate description of Use_Error).
 procedure Close  (The_Stream : in out Stream_Descriptor_Type);

 
-----------------------------------------------------------------------------
 -- Is_Open  -- Purpose:  --  This function returns whether the specified
stream is open.  function Is_Open (The_Stream : Stream_Descriptor_Type)
return Boolean;

 
-----------------------------------------------------------------------------
 -- End_Of_Stream  -- Purpose:	--  This function returns whether the next
access to the specified stream	--  would be beyond the end of the memory
region specified when the stream  --  was opened -- i.e., whether the stream
is at its end.	function End_Of_Stream (The_Stream : Stream_Descriptor_Type)
return Boolean;

 
-----------------------------------------------------------------------------
 -- End_Error :  -- Purpose:  --  This exception is raised by the Read and
Write procedures when  --  attempting to read or write beyond the end of the
opened memory region.  End_Error : exception;

 
-----------------------------------------------------------------------------
 -- Mode_Error :  -- Purpose:  --  This exception is raised by the Read and
Write Procedures when the  --  mode is not in agreement with the mode
specified when opening the  --	stream.  Mode_Error : exception;

 
-----------------------------------------------------------------------------
 -- Use_Error :  -- Purpose:  --  This exception is raised by the Close
procedure and the End_Of_Stream  --  function when the specified memory
stream is not open.  --  This exception is raised by the Open procedure when
the specified  --  memory stream is already open or when the memory access
permission is  --  inconsistent with the requested mode.  Use_Error :
exception;

private

   subtype Stream_Element_Array_Type is
      Ada.Streams.Stream_Element_Array;
   use type Ada.Streams.Stream_Element_Array;

   subtype Stream_Element_Offset_Type is
      Ada.Streams.Stream_Element_Offset;
   use type Ada.Streams.Stream_Element_Offset;

 
---------------------------------------------------------------------------- 
-- The following declarations provide for access through the dispatching  --
operations of the Ada.Streams package.	-- These procedures will be called by
the dispatching operations of the  -- Ada.Streams package, which have been
called by built-in or overridden  -- 'Read, 'Write, 'Input, or 'Output
attributes.  procedure Read (Stream : in out Stream_Descriptor_Type;  Item :
out Ada.Streams.Stream_Element_Array;  Last : out
Ada.Streams.Stream_Element_Offset);

   procedure Write (Stream : in out Stream_Descriptor_Type;
      Item : in Ada.Streams.Stream_Element_Array);

   type Stream_Descriptor_Record_Type is
   record
      First      : Address_Type;
      Last       : Address_Type;
      Mode       : Mode_Type;
      Block_Size : Natural := 0;
   end record;

   type Stream_Descriptor_Record_Access_Type is
      access Stream_Descriptor_Record_Type;

   type Stream_Descriptor_Type is new Ada.Streams.Root_Stream_Type with
      record
      Stream_Descriptor_Record_Access :
         Stream_Descriptor_Record_Access_Type;
   end record;

   Rcsid : constant String :=
      "$Id";

end Streams.Memory; -- $Log $ --
-----------------------------------------------------------------------------
--- --	Copyright 1998, Ada95 Press, Inc. --  All rights reserved -- Author:
David C. Hoos, Sr. -- Department: Library Development -- Revision History: --
 1998/05/12 David C. Hoos, Sr. --  - Original version.
-----------------------------------------------------------------------------
---

with Ada.Exceptions;
with Ada.Unchecked_Deallocation;
with System.Address_Image;
with System.Storage_Elements;
package body Streams.Memory is

   Rcsid_B : constant String :=
      "$Id";

   use type System.Storage_Elements.Storage_Offset;

   procedure Assert_Open (As_The_Stream : Stream_Descriptor_Type) is
   begin
      if not Is_Open (As_The_Stream) then
         raise Use_Error;
      end if;
   end Assert_Open;

   procedure Open
         (From_The_Address : Address_Type;
         To_The_Address : Address_Type;
         With_The_Mode : Mode_Type;
         As_The_Stream : in out Stream_Descriptor_Type) is
   begin
      if Is_Open (As_The_Stream) then
         raise Use_Error;
      end if;
      As_The_Stream.Stream_Descriptor_Record_Access :=
         new Stream_Descriptor_Record_Type;
      declare
         The_Stream : Stream_Descriptor_Record_Type
            renames As_The_Stream.Stream_Descriptor_Record_Access.all;
      begin
         The_Stream.Mode := With_The_Mode;
         The_Stream.First := From_The_Address;
         The_Stream.Last := To_The_Address;
         The_Stream.Block_Size :=
            Natural (The_Stream.Last - The_Stream.First + 1);
         declare
            The_Storage_Elements : Stream_Element_Array_Type
               (1 .. Stream_Element_Offset_Type (The_Stream.Block_Size));
            for The_Storage_Elements'Address use From_The_Address;
            The_Original_Value :
               Stream_Element_Array_Type (The_Storage_Elements'range)
               := The_Storage_Elements;
         begin
            The_Storage_Elements := The_Original_Value;
         exception
            when Storage_Error =>
               raise Use_Error;
         end;
      exception
         when E: others =>
            Ada.Exceptions.Raise_Exception
               (E => Ada.Exceptions.Exception_Identity (E),
               Message => "Streams.Memory.Open" &
               Ascii.Lf & "  block_size = " &
               Natural'Image (The_Stream.Block_Size) &
               Ascii.Lf & "  First = " &
               System.Address_Image (The_Stream.First) &
               "; Last = " &
               System.Address_Image (The_Stream.Last));
      end;
   end Open;

   function End_Of_Stream
         (The_Stream : Stream_Descriptor_Type) return Boolean is
   begin
      Assert_Open (The_Stream);
      declare
         The_Stream_Record : Stream_Descriptor_Record_Type
            renames The_Stream.Stream_Descriptor_Record_Access.all;
      begin
         return The_Stream_Record.First > The_Stream_Record.Last;
      end;
   end End_Of_Stream;

   function Is_Open
         (The_Stream : Stream_Descriptor_Type) return Boolean is
   begin
      return The_Stream.Stream_Descriptor_Record_Access /= null;
   end Is_Open;

   procedure Close
         (The_Stream : in out Stream_Descriptor_Type) is
      procedure Free is
         new Ada.Unchecked_Deallocation
         (Object => Stream_Descriptor_Record_Type,
         Name => Stream_Descriptor_Record_Access_Type);
   begin
      Assert_Open (The_Stream);
      Free (The_Stream.Stream_Descriptor_Record_Access);
   end Close;

   procedure Read (Stream : in out Stream_Descriptor_Type;
         Item : out Ada.Streams.Stream_Element_Array;
         Last : out Ada.Streams.Stream_Element_Offset) is
   begin
      Assert_Open (Stream);
      declare
         The_Stream_Record : Stream_Descriptor_Record_Type
            renames Stream.Stream_Descriptor_Record_Access.all;
         The_Overlay : Ada.Streams.Stream_Element_Array (Item'range);
         for The_Overlay'Address use The_Stream_Record.First;
      begin
         The_Stream_Record.First := The_Stream_Record.First + Item'Length;
         Item := The_Overlay;
         Last := Item'Last;
      exception
         when E: others =>
            Ada.Exceptions.Raise_Exception
               (E => Ada.Exceptions.Exception_Identity (E),
               Message => "Streams.Memory.Read" &
               Ascii.Lf & "  block_size = " &
               Natural'Image (The_Stream_Record.Block_Size) &
               Ascii.Lf & "  First = " &
               System.Address_Image (The_Stream_Record.First) &
               "; Last = " &
               System.Address_Image (The_Stream_Record.Last) &
               "; Item'Length =" &
               Integer'Image (Item'Length));
      end;
   exception
      when E: others =>
         Ada.Exceptions.Raise_Exception
            (E => Ada.Exceptions.Exception_Identity (E),
            Message => "Streams.Memory.Read");
   end Read;

   procedure Write (Stream : in out Stream_Descriptor_Type;
         Item : in Ada.Streams.Stream_Element_Array) is
   begin
      Assert_Open (Stream);
      declare
         The_Stream_Record : Stream_Descriptor_Record_Type
            renames Stream.Stream_Descriptor_Record_Access.all;
      begin
         if The_Stream_Record.Mode /= Write or else
               The_Stream_Record.First > The_Stream_Record.Last or else
               (The_Stream_Record.Last - The_Stream_Record.First + 1) <
               Item'Length then
            raise End_Error;
         end if;
         declare
            The_Overlay : Ada.Streams.Stream_Element_Array (Item'range);
            for The_Overlay'Address use The_Stream_Record.First;
         begin
            The_Stream_Record.First := The_Stream_Record.First + Item'Length;
            The_Overlay := Item;
         end;
      exception
         when E: others =>
            Ada.Exceptions.Raise_Exception
               (E => Ada.Exceptions.Exception_Identity (E),
               Message => "Streams.Memory.Write" &
               Ascii.Lf & "  block_size = " &
               Natural'Image (The_Stream_Record.Block_Size) &
               Ascii.Lf & "  First = " &
               System.Address_Image (The_Stream_Record.First) &
               "; Last = " &
               System.Address_Image (The_Stream_Record.Last) &
               "; Item'Length =" &
               Integer'Image (Item'Length));
      end;
   exception
      when E: others =>
         Ada.Exceptions.Raise_Exception
            (E => Ada.Exceptions.Exception_Identity (E),
            Message => "Streams.Memory.Write");
   end Write;

end Streams.Memory;
-- $Log $
--

-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own