STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW

["andrew.carroll@okstate.edu" <andrew.carroll@okstate.edu>]

I read the messages earlier on this error where they were working on
some medical device.  My program is not threaded.  I'm not real sure
where to put a pragma storage_size(...) statement.  Does it go inside
the procedure of the main program?  Does it go in the package header?
The package body?  Where should I put it?  Okay, you caught me, I
tried all of those and the compiler wouldn't let me put them there.
How do I use heap instead when allocating an object?  Is it some other
word than "new" or just a pragma?

I didn't have trouble with this until I started using 'class types
instead of _ptr "types".  I am trying to use ada.streams.stream_io
with dispatching.  I wasn't using dispatching originally.  In the
newest version, with dispatching, I made my base type abstract,
changed from using _ptr "types" to 'class types and then I would get
the message "raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION".  So I
kept converting things from _ptr to 'class thinking that maybe a tag
wasn't written or that it was due to some inconsistency between
'outputing an _ptr and 'inputing a 'class.

I tracked it down to one section of my code that uses 'input to read
the object from a file stream.  After it is 'inputed the data is all
messed up.  The section of code is where I capture the return value of
the return value of the call to from_disc (which is a dispatched
call).  Anyway, now that I've muddied that up.  HELP!

Here are the base types and all that:

with util, Ada.Calendar, ada.streams.stream_io;

use util, Ada.Calendar, ada.streams.stream_io;

package attribute_types is

    -----------------------------------
    --    Forwarding Declarations    --
    -----------------------------------
    type attribute is abstract tagged;
    type booleanattribute is tagged;
    type integerattribute is tagged;
    type stringattribute is tagged;
    type dateattribute is tagged;

    --------------------------------------
    --    Attribute Type Declarations    --
    --------------------------------------
    type attribute is abstract tagged record
        name         : String (1 .. max_attributename_length) :=
           (1 .. max_attributename_length => ' ');
        domain       : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
        isprimarykey : Boolean                                :=
False;
        byte_start   : Integer                                := 0;
        byte_end     : Integer                                := 0;
    end record;

    --------------------------------------
    --    Basic Pointer Declarations    --
    --------------------------------------
    type attribute_ptr is access attribute'class;
    --type attribute_array is array (Integer range <>) of
attribute_ptr;
    type attribute_array is array (Integer range <>) of access
attribute'class;
    type attribute_array_ptr is access all attribute_array;

    procedure to_disc (fout: file_type; item: in out attribute) is
abstract;
    function from_disc(fout: file_type; item: attribute) return
attribute'class is abstract;


    -----------------------------------
    --    Extended Attribute Types   --
    -----------------------------------
    type booleanattribute is new attribute with record
        value : Boolean := False;
    end record;
    type booleanattribute_ptr is access all booleanattribute'class;
    procedure to_disc (fout: file_type; item: in out
booleanattribute);
    function from_disc(fin: file_type; item: booleanattribute) return
attribute'class;

    type integerattribute is new attribute with record
        value : Integer := 0;
    end record;
    type integerattribute_ptr is access all integerattribute'class;
    procedure to_disc (fout: file_type; item: in out
integerattribute);
    function from_disc(fin: file_type; item: integerattribute) return
attribute'class;

    type stringattribute is new attribute with record
        value : String (1 .. max_stringlength) := (1 ..
max_stringlength => ' ');
    end record;
    type stringattribute_ptr is access all stringattribute'class;
    procedure to_disc (fout: file_type; item: in out stringattribute);
    function from_disc(fin: file_type; item: stringattribute) return
attribute'class;

    type dateattribute is new attribute with record
        year  : Year_Number  := 1901;
        month : Month_Number := 1;
        day   : Day_Number   := 1;
        value : Time         := Time_Of (1901, 1, 1);
    end record;
    type dateattribute_ptr is access all dateattribute'class;
    procedure to_disc (fout: file_type; item: in out dateattribute);
    function from_disc(fin: file_type; item: dateattribute) return
attribute'class;

end attribute_types;


with ada.text_io, util, ada.calendar;
use util, ada.calendar;

package body attribute_types is

    procedure to_disc (fout: file_type; item: in out booleanattribute)
is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(booleanattribute'size / 8) - 7;
        booleanattribute'class'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: booleanattribute) return
attribute'class is
        temp : access attribute'class;
    begin
      temp := new booleanattribute;
      temp.all := booleanattribute'class'input (Stream (fin));
      return temp.all;
    end from_disc;

    procedure to_disc (fout: file_type; item: in out integerattribute)
is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(integerattribute'size / 8) - 7;
        integerattribute'class'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: integerattribute) return
attribute'class is
    	temp : access attribute'class;
    begin
  	temp := new integerattribute;
	temp.all := integerattribute'class'input (Stream (fin));
	return temp.all;
    end from_disc;

    procedure to_disc (fout: file_type; item: in out stringattribute)
is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(stringattribute'size / 8) - 7;
        stringattribute'class'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: stringattribute) return
attribute'class is
    	temp: access attribute'class;
    begin
  	temp := new stringattribute;
	temp.all := stringattribute'class'input (Stream (fin));
	return temp.all;
    end from_disc;

    procedure to_disc (fout: file_type; item: in out dateattribute) is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(dateattribute'size / 8) - 11;
        dateattribute'class'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: dateattribute) return
attribute'class is
    	temp: access attribute'class;
    begin
    	temp := new dateattribute;
	temp.all := dateattribute'class'input (Stream (fin));
	return temp.all;
    end from_disc;

begin
    null;
end attribute_types;

with attribute_types...
use attribute_types...
package schema_types is
...
    type schema (number_of_attributes : Integer) is tagged record
        tablename : String (1 .. max_tablename_length) := (1 ..
max_tablename_length => ' ');

        --attribute order is always from left to right
        --Primary key attributes | others
        attributes        : attribute_array (1 ..
number_of_attributes);
        byte_start        : Integer := 0;
        byte_end          : Integer := 0;
        primary_key_count : Integer := 0;
    end record;
...
end schema_types;

Here is the code that initiates disaster:
schemainfo.all.attributes (x) := new attribute'class'(from_disc(fin,
schemainfo.all.attributes (x).all));