* STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW
@ 2007-04-02 6:13 andrew.carroll
2007-04-02 10:10 ` Stephen Leake
` (3 more replies)
0 siblings, 4 replies; 46+ messages in thread
From: andrew.carroll @ 2007-04-02 6:13 UTC (permalink / raw)
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));
^ permalink raw reply [flat|nested] 46+ messages in thread* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll @ 2007-04-02 10:10 ` Stephen Leake 2007-04-02 14:11 ` andrew.carroll 2007-04-02 22:05 ` andrew.carroll ` (2 subsequent siblings) 3 siblings, 1 reply; 46+ messages in thread From: Stephen Leake @ 2007-04-02 10:10 UTC (permalink / raw) "andrew.carroll@okstate.edu" <andrew.carroll@okstate.edu> writes: > Here are the base types and all that: You need to post an actual, compilable example before we can help. -- -- Stephe ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 10:10 ` Stephen Leake @ 2007-04-02 14:11 ` andrew.carroll 2007-04-02 18:43 ` andrew.carroll 2007-04-02 20:45 ` Simon Wright 0 siblings, 2 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-02 14:11 UTC (permalink / raw) All the files are below. The last file in the list, called tables.txt, is the input file. I've supplied the input file I am using when I get the errors. with Ada.Text_IO, Ada.Directories, GNAT.Calendar.Time_IO, Ada.Characters.Latin_1, Ada.IO_Exceptions, Ada.Strings.Maps.Constants, Ada.Strings.Fixed, Ada.Characters.Handling, Ada.Calendar, schema_types, attribute_types, parser, util, index_types; use parser, GNAT.Calendar.Time_IO, Ada.Characters.Latin_1, Ada.Strings.Maps.Constants, Ada.Strings.Fixed, Ada.Characters.Handling, Ada.Calendar, schema_types, attribute_types, util; procedure dbprog is -- the input file contains the table specifications -- input : Ada.Text_IO.File_Type; ------------------------------------ -- Variables for Processing -- ------------------------------------ char : Character; line : string_ptr; tablename : string_ptr; datacols : string_array_ptr; pkcols : string_array_ptr; schemas : schema_array_ptr; sindex : Integer := 1; tupls : tuple_ptr; procedure showoptionsmenu is begin cls; pl ("---------------------------------------------------", True); pl ("Type one of the following at the prompt:", True); pl (" ", True); pl ("~ QUIT ", True); pl ("1 INSERT DATA", True); pl ("2 UPDATE DATA", True); pl ("3 DELETE DATA", True); pl ("4 SHOW RECORDS", True); pl ("For help type 'help'", True); pl ("---------------------------------------------------", True); pl (">>", False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); end showoptionsmenu; function markschema return Integer is idx : Integer := 0; begin --find the schema in schemas. if schemas'length <= 0 then return idx; end if; loop idx := idx + 1; exit when idx > schemas'length or else Index (To_Upper (schemas (idx).tablename), tablename.all) > 0; end loop; return idx; end markschema; procedure getcolumnnamesandvalues is year : Year_Number; month : Month_Number; day : Day_Number; line : string_ptr := new String'(""); valid : Boolean := False; begin --markschema sets sindex to the appropriate index in schemas --for the table with tablename. sindex := markschema; --tables are already loaded and ready to go. datacols := new string_array (1 .. schemas (sindex).attributes'length); for x in 1 .. schemas (sindex).attributes'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "DATE" then while not valid loop pl ("Enter a YEAR (1901 - 2099) for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Year_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; year := Year_Number'value (line.all); valid := False; while not valid loop pl ("Enter a MONTH NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Month_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; month := Month_Number'value (line.all); valid := False; while not valid loop pl ("Enter a DAY NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Day_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; day := Day_Number'value (line.all); datacols.all (x) := new String'(Image (Time_Of (year, month, day), ISO_Date)); valid := False; else while not valid loop pl ("Enter a value for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & "(" & Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) & ") >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then if To_Upper (line.all) = "TRUE" then line := new String'("True"); valid := True; elsif To_Upper (line.all) = "FALSE" then line := new String'("False"); valid := True; elsif line.all = "1" then line := new String'("True"); valid := True; elsif line.all = "0" then line := new String'("False"); valid := True; else pl ("!! INVALID !!", True, False); end if; elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 then valid := True; else pl ("!! INVALID !!", True, False); end if; else --"STRING" valid := True; end if; end loop; valid := False; datacols.all (x) := new String'(line.all); end if; end loop; end getcolumnnamesandvalues; procedure getprimarykeynamesandvalues is year : Year_Number; month : Month_Number; day : Day_Number; line : string_ptr := new String'(""); valid : Boolean := False; begin --markschema sets sindex to the appropriate index in schemas --for the table with tablename. sindex := markschema; pl ("Provide the primary key values to identify the record to delete.", False, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); --tables are already loaded and ready to go. pkcols := new string_array (1 .. schemas (sindex).primary_key_count); for x in 1 .. schemas (sindex).attributes'length loop if schemas (sindex).attributes (x).isprimarykey then if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "DATE" then while not valid loop pl ("Enter a YEAR (1901 - 2099) for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Year_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; year := Year_Number'value (line.all); valid := False; while not valid loop pl ("Enter a MONTH NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Month_Number' range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; month := Month_Number'value (line.all); valid := False; while not valid loop pl ("Enter a DAY NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Day_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; day := Day_Number'value (line.all); pkcols.all (x) := new String'(Image (Time_Of (year, month, day), ISO_Date)); valid := False; else while not valid loop pl ("Enter a value for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & "(" & Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) & ") >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then if To_Upper (line.all) = "TRUE" then line := new String'("True"); valid := True; elsif To_Upper (line.all) = "FALSE" then line := new String'("False"); valid := True; elsif line.all = "1" then line := new String'("True"); valid := True; elsif line.all = "0" then line := new String'("False"); valid := True; else pl ("!! INVALID !!", True, False); end if; elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 then valid := True; else pl ("!! INVALID !!", True, False); end if; else --"STRING" valid := True; end if; end loop; valid := False; pkcols.all (x) := new String'(line.all); end if; end if; end loop; end getprimarykeynamesandvalues; procedure gettablename is count : Integer := 1; begin pl ("Enter the table name in CAPITAL letters >>", False); tablename := new String'(Ada.Text_IO.Get_Line); tablename.all := To_Upper (tablename.all); while not Ada.Directories.Exists (tablename.all) and count < 5 loop pl ("Enter the table name in CAPITAL letters >>", False); tablename := new String'(Ada.Text_IO.Get_Line); tablename.all := To_Upper (tablename.all); count := count + 1; end loop; if count >= 5 then raise Constraint_Error; end if; end gettablename; procedure getchosenoptiondata is begin gettablename; --we don't do "4" here because it is just a select and we don't --need values for it and we already have the attribute names in --the schemas(sindex) object for which to SELECT or SHOW the --data. if line.all = "1" then getcolumnnamesandvalues; elsif line.all = "2" then getprimarykeynamesandvalues; pl (" ", True, True); pl ("Please enter new values for each item. You can enter the same ", True, True); pl ("data if you don't want it modified.", True, True); pl (" ", True, True); getcolumnnamesandvalues; elsif line.all = "3" then getprimarykeynamesandvalues; end if; end getchosenoptiondata; procedure parsechosenoption is pkattribs : attribute_array_ptr; newvalues : attribute_array_ptr; linelength : Integer; outline : string_ptr; begin if line.all = "1" then ------------------- -- INSERT DATA -- ------------------- newvalues := new attribute_array (1 .. schemas (sindex).attributes'length); --fill in the values on the objects and pass that to insert. for x in 1 .. newvalues'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then newvalues (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (datacols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then newvalues (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (newvalues (x).all).value, 1, max_stringlength, datacols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then newvalues (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (datacols (x).all)); else -- "DATE" newvalues (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (datacols (x).all), year => Year (Value (datacols (x).all)), month => Month (Value (datacols (x).all)), day => Day (Value (datacols (x).all))); end if; end loop; insertrec (schemas (sindex).all, newvalues.all); elsif line.all = "2" then ------------------- -- UPDATE DATA -- ------------------- pkattribs := new attribute_array (1 .. pkcols'length); --fill in the values on the objects and pass that to insert. for x in 1 .. pkcols'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then pkattribs (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (pkcols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then pkattribs (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (pkattribs (x).all).value, 1, max_stringlength, pkcols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then pkattribs (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (pkcols (x).all)); else -- "DATE" pkattribs (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (pkcols (x).all), year => Year (Value (pkcols (x).all)), month => Month (Value (pkcols (x).all)), day => Day (Value (pkcols (x).all))); end if; end loop; newvalues := new attribute_array (1 .. schemas (sindex).attributes'length); --fill in the values on the objects and pass that to insert. for x in 1 .. newvalues'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then newvalues (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (datacols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then newvalues (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (newvalues (x).all).value, 1, max_stringlength, datacols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then newvalues (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (datacols (x).all)); else -- "DATE" newvalues (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (datacols (x).all), year => Year (Value (datacols (x).all)), month => Month (Value (datacols (x).all)), day => Day (Value (datacols (x).all))); end if; end loop; updaterec (schemas (sindex).all, pkattribs.all, newvalues.all); elsif line.all = "3" then ------------------- -- DELETE DATA -- ------------------- Ada.Text_IO.Put_Line (Integer'image (sindex)); Ada.Text_IO.Put_Line (tablename.all); pkattribs := new attribute_array (1 .. pkcols'length); --fill in the values on the objects and pass that to delete. for x in 1 .. pkcols'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then pkattribs (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (pkcols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then pkattribs (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (pkattribs (x).all).value, 1, max_stringlength, pkcols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then pkattribs (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (pkcols (x).all)); else -- "DATE" pkattribs (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (pkcols (x).all), year => Year (Value (pkcols (x).all)), month => Month (Value (pkcols (x).all)), day => Day (Value (pkcols (x).all))); end if; end loop; deleterec (schemas (sindex).all, pkattribs.all); elsif line.all = "4" then ---------------------- -- SELECT RECORDS -- ---------------------- linelength := 60; sindex := markschema; outline := new String'(1 .. linelength => '-'); pl (outline.all, True, False); pl (schemas (sindex).tablename, True, False); pl (outline.all, True, False); pl ("| ", False, False); for x in 1 .. schemas (sindex).attributes'length loop pl (Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both), False, False); if x < schemas (sindex).attributes'length then pl (" | ", False, False); end if; end loop; pl (" |", True, False); pl (outline.all, True, False); tupls := selectrec (schemas (sindex).all); if tupls = null then pl ("No Data", True, False); else for y in 1 .. tupls'length loop newvalues := tupls (y); for x in 1 .. newvalues'length loop if Trim (newvalues (x).domain, Ada.Strings.Both) = "BOOLEAN" then pl (Trim (Boolean'image (booleanattribute (newvalues (x).all).value), Ada.Strings.Both), False, False); elsif Trim (newvalues (x).domain, Ada.Strings.Both) = "STRING" then pl (Trim (stringattribute (newvalues (x).all).value, Ada.Strings.Both), False, False); elsif Trim (newvalues (x).domain, Ada.Strings.Both) = "INTEGER" then pl (Trim (Integer'image (integerattribute (newvalues (x).all).value), Ada.Strings.Both), False, False); else -- "DATE" pl (Trim (Image (dateattribute (newvalues (x).all).value, ISO_Date), Ada.Strings.Both), False, False); end if; if x < newvalues'length then pl (" ", False, False); end if; end loop; pl (" ", True, False); end loop; end if; pl (outline.all, True, False); pl ("Press Enter >>", False, False); Ada.Text_IO.Get_Immediate (char); end if; sindex := 0; tablename := null; datacols := null; pkcols := null; tupls := null; end parsechosenoption; begin cls; pl ("---------------------------------------------------", True); pl ("Put your table definitions in a file named ", True); pl ("tables.txt and place the file in the same folder as", True); pl ("this program (Parser.exe). Type C to continue or.", True); pl ("~ to quit.", True); pl ("---------------------------------------------------", True); pl (">>", False); Ada.Text_IO.Get (char); line := new String'(Ada.Text_IO.Get_Line); if char = ETX or char = Tilde then raise Ada.IO_Exceptions.End_Error; end if; setinputfile ("tables.txt"); schemas := parsetables; closeinputfile; showoptionsmenu; while line.all /= "~" loop if line.all = "help" or line.all = "HELP" then pl ("---------------------------------------------------", True); pl ("If you want to quit type the tilde '~' character", True); pl ("---------------------------------------------------", True); pl (">>", False); line := new String'(Ada.Text_IO.Get_Line); cls; elsif line.all = "goodbye" or line.all = "GOODBYE" or line.all = "exit" or line.all = "EXIT" or line.all = "quit" or line.all = "QUIT" or line.all = "q" or line.all = "Q" then line := new String'("~"); else ------------------------ -- output results -- ------------------------ getchosenoptiondata; parsechosenoption; showoptionsmenu; end if; end loop; cls; pl ("---------------------------------------------------", True); pl ("Goodbye!", True); pl ("---------------------------------------------------", True); exception when Ada.IO_Exceptions.End_Error => if Ada.Text_IO.Is_Open (input) then Ada.Text_IO.Close (input); end if; cls; pl ("---------------------------------------------------", True); pl ("An error occured while reading data. Possibly a missing", True); pl ("semi-colon or other format character. Or, you pressed ", True); pl ("CTRL + C. Goodbye!", True); pl ("---------------------------------------------------", True); when Ada.Calendar.Time_Error => pl ("A date value was not entered correctly.", True); pl ("Unfortunately this will cause the program to exit.", True); pl ("Your data is safe so long as you don't 'create fresh'.", True); pl ("the table when you start the program again.", True); when Ada.IO_Exceptions.Data_Error => if Ada.Text_IO.Is_Open (input) then Ada.Text_IO.Close (input); end if; when Constraint_Error => Ada.Text_IO.Put_Line ("You entered the data wrong."); end dbprog; with Ada.Text_IO, schema_types, attribute_types; use schema_types, attribute_types; package parser is file : Ada.Text_IO.File_Type; --------------------------- -- Utility Methods -- --------------------------- procedure setinputfile (filename : String); procedure closeinputfile; function parsetables return schema_array_ptr; function parsetable return schema'class; function parseattributes return attribute_array_ptr; function parseattribute return attribute'class; end parser; with Ada.Text_IO, Ada.Directories, Ada.Integer_Text_IO, Ada.Strings.Fixed, Ada.Characters.Latin_1, Ada.IO_Exceptions, schema_types, attribute_types, util; use Ada.Strings.Fixed, Ada.Characters.Latin_1, schema_types, attribute_types, util; package body parser is procedure setinputfile (filename : String) is begin Ada.Text_IO.Open (file, Ada.Text_IO.In_File, filename); end setinputfile; procedure closeinputfile is begin if Ada.Text_IO.Is_Open (file) then Ada.Text_IO.Close (file); end if; end closeinputfile; ----------------------- -- parseTables -- ----------------------- function parsetables return schema_array_ptr is eof : Boolean := False; char : Character; schemas : schema_array_ptr := null; swap : schema_array_ptr := null; schemainfo : schema_ptr := null; i : Integer := 1; begin eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --at this point we should be ready to read the table name. swap := new schema_array (1 .. max_tables); while not eof loop schemainfo := new schema'class'(parsetable); pl ("Create the table fresh? [y/Y] >>", False, True); Ada.Text_IO.Get (char); swap(i) := new schema(schemainfo.attributes'length); if char = 'y' or char = 'Y' then swap (i) := schemainfo; createtable (swap (i)); else if Ada.Directories.Exists (schemainfo.tablename) then swap (i) := loadtable (schemainfo.tablename); else pl ("No table exists on disc with name = " & schemainfo.tablename, True, True); pl ("You will not be able to query " & schemainfo.tablename, True, True); pl (" ", True, False); end if; end if; i := i + 1; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); end if; end loop; i := i - 1; if i < 1 then schemas := null; swap := null; else schemas := new schema_array (1 .. i); for x in 1 .. i loop schemas (x) := swap (x); end loop; swap := null; end if; return schemas; end parsetables; ---------------------- -- parseTable -- ---------------------- function parsetable return schema'class is temp : schema_ptr := null; eof : Boolean := False; char : Character; tname : String (1 .. max_tablename_length); attribs : attribute_array_ptr; i : Integer := 1; begin eatWhite (file, eof); --at this point we should be ready to read the table name. --the call to eatwhite might be redundant from the instance that --called 'me' but we want to ensure we are in the right location within --the file. if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; while char /= Space and char /= HT and char /= LF and char /= CR and char /= Left_Parenthesis and not eof loop Ada.Text_IO.Get (file, char); tname (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_tablename_length loop tname (x) := ' '; end loop; --We just read the table name. We are expecting an opening '('. --If it's not there then there is a problem with the input file --format. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); if char = Left_Parenthesis then Ada.Text_IO.Get (file, char); else Ada.Text_IO.Put_Line( " Error in input file format: No attributes found. Must have (<attribute list>)"); end if; else raise Ada.IO_Exceptions.End_Error; end if; attribs := parseattributes; if attribs /= null then temp := new schema (attribs.all'length); temp.attributes := attribs.all; temp.tablename := tname; for x in 1 .. temp.attributes'length loop if temp.attributes (x).all.isprimarykey then temp.primary_key_count := temp.primary_key_count + 1; end if; end loop; else temp := null; end if; --at this point we should have read the ')' for the whole table spec. --if we peek, we should find a ';'. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); if char = Semicolon then Ada.Text_IO.Get (file, char); else Ada.Text_IO.Put_Line (" Error in input file format: Missing closing ';' on table spec."); temp := null; end if; else Ada.Text_IO.Put_Line (" Error in input file format: Missing closing ')' on table spec."); temp := null; end if; return temp.all; end parsetable; --------------------------- -- parseAttributes -- --------------------------- function parseattributes return attribute_array_ptr is eof : Boolean := False; char : Character; attribs : attribute_array_ptr := null; swap : attribute_array_ptr := null; i : Integer := 1; begin eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --at this point we should be ready to read the attribute name. if not eof and char /= Right_Parenthesis then Ada.Text_IO.Look_Ahead (file, char, eof); else Ada.Text_IO.Put_Line (" found eof prematurely or ')' is in wrong place."); raise Ada.IO_Exceptions.End_Error; end if; swap := new attribute_array (1 .. max_columns); while char /= Right_Parenthesis and char /= Semicolon and not eof loop swap (i) := new attribute'class'(parseattribute); i := i + 1; eatWhite (file, eof); if not eof and char /= Right_Parenthesis then --we are expecting a ')' or a comma. Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; if char /= Comma and char /= Right_Parenthesis and not eof then Ada.Text_IO.Put_Line (" Error in input file: Missing comma between attributes."); eof := True; swap := null; elsif not eof then --read the comma or the ')' Ada.Text_IO.Get (file, char); end if; eatWhite (file, eof); if eof then Ada.Text_IO.Put_Line ("Missing semi-colon or other format error."); raise Ada.IO_Exceptions.End_Error; end if; end loop; i := i - 1; if i < 1 then swap := null; else attribs := new attribute_array (1 .. i); for x in 1 .. i loop attribs (x) := swap (x); end loop; swap := null; end if; return attribs; end parseattributes; -------------------------- -- parseAttribute -- -------------------------- function parseattribute return attribute'class is temp : attribute_types.attribute_ptr; eof : Boolean := False; char : Character; aname : String (1 .. max_attributename_length); atype : String (1 .. max_typename_length); asize : Integer; isprimarykey : Boolean := False; i : Integer := 1; begin if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; while char /= Space and char /= HT and char /= LF and char /= CR and char /= Left_Parenthesis and char /= Colon and not eof loop Ada.Text_IO.Get (file, char); aname (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_attributename_length loop aname (x) := ' '; end loop; --at this point we have the attribute name. Read white space to --a parenthesis or an colon. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --the next character should be '(' or ':' if char = Left_Parenthesis then Ada.Text_IO.Get (file, char); eatWhite (file, eof); i := 1; --read "primary" while char /= Space and char /= HT and char /= LF and char /= CR and char /= Right_Parenthesis and not eof loop Ada.Text_IO.Get (file, char); atype (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_typename_length loop atype (x) := ' '; end loop; if Trim (atype, Ada.Strings.Both) = "PRIMARY" then isprimarykey := True; end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; i := 1; --read "key" while char /= Space and char /= HT and char /= LF and char /= CR and char /= Right_Parenthesis and not eof loop Ada.Text_IO.Get (file, char); atype (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_typename_length loop atype (x) := ' '; end loop; if Trim (atype, Ada.Strings.Both) = "KEY" then isprimarykey := True; else isprimarykey := False; end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; if char = ')' then Ada.Text_IO.Get (file, char); else Ada.Text_IO.Put_Line (" Error in input: Missing ')' after Primary Key designation."); end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; end if; if char = Colon then Ada.Text_IO.Get (file, char); eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; i := 1; --read the type of the attribute into atype variable while char /= Space and char /= HT and char /= LF and char /= CR and char /= Comma and char /= Left_Parenthesis and char /= Right_Parenthesis and char /= Semicolon and not eof loop Ada.Text_IO.Get (file, char); atype (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_typename_length loop atype (x) := ' '; end loop; eatWhite (file, eof); --read the left parenthesis if not eof and char = Left_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Get (file, char); Ada.Text_IO.Look_Ahead (file, char, eof); elsif not eof and char /= Left_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Put_Line (" Incorrect syntax: missing (size) for string."); elsif eof then raise Ada.IO_Exceptions.End_Error; end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --read the size of the type of the attribute into atype variable while char /= Space and char /= HT and char /= LF and char /= CR and char /= Comma and char /= Right_Parenthesis and char /= Left_Parenthesis and not eof loop Ada.Integer_Text_IO.Get (file, asize, 0); Ada.Text_IO.Look_Ahead (file, char, eof); end loop; --I have to do this temporarily to get this program --to work. ALL strings are the same length. The reason --is because there is no way to know how long the string is --when serializing it in from a file (see loadtable in --schema_types) before we serialize it so that we can --provide a length discriminant to the type defined in --attribute_types. So, we just make them all the same --length. asize := max_stringlength; eatWhite (file, eof); --read the right parenthesis if not eof and char = Right_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Get (file, char); Ada.Text_IO.Look_Ahead (file, char, eof); elsif not eof and char /= Right_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Put_Line (" Incorrect syntax: missing (size ~)~ for string."); elsif eof then raise Ada.IO_Exceptions.End_Error; end if; eatWhite (file, eof); if Trim (atype, Ada.Strings.Both) = "BOOLEAN" then temp := new booleanattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; elsif Trim (atype, Ada.Strings.Both) = "STRING" then temp := new stringattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; elsif Trim (atype, Ada.Strings.Both) = "INTEGER" then temp := new integerattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; elsif Trim (atype, Ada.Strings.Both) = "DATE" then temp := new dateattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; else Ada.Text_IO.Put_Line (" unknown type specified."); end if; --after eating the white space we should be left at the ',' or --the ')'. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --we leave the comma in the stream so that parseAttributes can --pick it up and loop for the next attribute. We leave the second --')' for parseAttributes to read to know when to exit the loop and --quit parsing attributes. if char /= Comma and char /= Right_Parenthesis then Ada.Text_IO.Put_Line( " Error in input: Missing ')' after Primary Key designation or ',' between attributes.") ; temp := null; end if; else Ada.Text_IO.Put_Line ( " Error in input file: Format not correct, no type specified for attribute " & aname); temp := null; end if; return temp.all; end parseattribute; begin null; end parser; with Ada.Text_IO, Ada.Characters.Latin_1, Ada.Strings.Fixed, Ada.Strings.Maps, Ada.IO_Exceptions; use Ada.Characters.Latin_1; package util is type string_ptr is access all String; type string_array is array (Integer range <>) of string_ptr; type string_array_ptr is access all string_array; max_columns : Integer := 5; max_tables : Integer := 5; max_tablename_length : Integer := 25; max_attributename_length : Integer := 25; max_stringlength : Integer := 255; max_typename_length : Integer := 7; max_filename_length : Integer := 45; max_index_namelength: integer := 50; procedure cls; procedure pl (text : in String; newline : in Boolean; setcolumn : in Boolean := True); function tokenize (text : in String) return string_array_ptr; procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in out Boolean); end util; package body Util is procedure cls is i : Integer := 1; begin while i < 40 loop Ada.Text_IO.New_Line; i := i + 1; end loop; end cls; procedure pl (text : in String; newline : in Boolean; setcolumn : in Boolean := True) is begin if newline then if setcolumn then Ada.Text_IO.Set_Col (15); end if; Ada.Text_IO.Put_Line (text); elsif setcolumn then Ada.Text_IO.Set_Col (15); Ada.Text_IO.Put (text); else Ada.Text_IO.Put (text); end if; end pl; function tokenize (text : in String) return string_array_ptr is temp : string_array_ptr; first : Integer := 1; i : Integer := 1; number_of_commas : Integer := 0; data : string_ptr; data2 : string_ptr; begin data := new String'(text); number_of_commas := Ada.Strings.Fixed.Count (data.all, Ada.Strings.Maps.To_Set (',')); if number_of_commas > max_columns then pl ("Invalid number of columns specified", True); raise Ada.IO_Exceptions.Data_Error; end if; temp := new string_array (1 .. number_of_commas + 1); --first will point to the first comma. first := Ada.Strings.Fixed.Index (data.all, Ada.Strings.Maps.To_Set (','), Ada.Strings.Inside, Ada.Strings.Forward); while i <= number_of_commas and number_of_commas < max_columns loop temp.all (i) := new String'(data.all (1 .. first - 1)); data2 := new String (1 .. data.all'length - first); data2.all := data.all (first + 1 .. data.all'length); data := new String'(data2.all); i := i + 1; first := Ada.Strings.Fixed.Index (data.all, Ada.Strings.Maps.To_Set (','), Ada.Strings.Inside, Ada.Strings.Forward); end loop; temp.all (i) := new String'(data.all); return temp; end tokenize; -------------------- -- eatWhite -- -------------------- procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in out Boolean) is char : Character; begin Ada.Text_IO.Look_Ahead (fin, char, eof); while Ada.Text_IO.End_Of_Line (fin) and not Ada.Text_IO.End_Of_File (fin) loop Ada.Text_IO.Skip_Line (fin); end loop; Ada.Text_IO.Look_Ahead (fin, char, eof); while (char = Space or char = HT or char = LF or char = CR) and not Ada.Text_IO.End_Of_File (fin) loop Ada.Text_IO.Get (fin, char); while Ada.Text_IO.End_Of_Line (fin) and not Ada.Text_IO.End_Of_File (fin) loop Ada.Text_IO.Skip_Line (fin); end loop; Ada.Text_IO.Look_Ahead (fin, char, eof); end loop; end eatWhite; begin null; end Util; with util, Ada.Calendar, attribute_types, Ada.Streams.Stream_IO; use util, attribute_types; package schema_types is --------------------------------- -- Variable Declarations -- --------------------------------- fin : Ada.Streams.Stream_IO.File_Type; fout : Ada.Streams.Stream_IO.File_Type; type schema (number_of_attributes : Integer) is tagged record tablename : String (1 .. max_tablename_length) := (1 .. max_tablename_length => ' '); attributes : attribute_array (1 .. number_of_attributes); byte_start : Integer := 0; byte_end : Integer := 0; primary_key_count : Integer := 0; end record; type schema_ptr is access all schema'class; type schema_array is array (Integer range <>) of schema_ptr; type schema_array_ptr is access all schema_array; type tuple is array (Integer range <>) of attribute_array_ptr; type tuple_ptr is access all tuple; procedure createtable (schemainfo : schema_ptr); function loadtable (sname : String) return schema_ptr; function findrecord (schemainfo : schema; values : attribute_array) return Integer; procedure insertrec (schemainfo : schema; values : attribute_array); procedure deleterec (schemainfo : schema; primary_key_values : attribute_array); procedure updaterec (schemainfo : schema; pkattribs : attribute_array; values : attribute_array); function selectrec (schemainfo : schema) return tuple_ptr; end schema_types; with Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO, Ada.Text_IO, Ada.Strings.Fixed, Ada.Directories, Ada.IO_Exceptions; use Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO, Ada.Strings.Fixed; package body schema_types is procedure createtable (schemainfo : schema_ptr) is fout : File_Type; attribs : attribute_array_ptr; attribs2 : attribute_array_ptr; i : Integer := 1; ii : Integer := 1; temp : access attribute'class; begin if schemainfo = null then return; end if; -- put them in order first for x in 1 .. schemainfo.attributes'length loop for y in x + 1 .. schemainfo.attributes'length loop if schemainfo.attributes (y).name < schemainfo.attributes (x).name then temp := schemainfo.attributes (y); schemainfo.attributes (y) := schemainfo.attributes (x); schemainfo.attributes (x).all := temp.all; end if; end loop; end loop; attribs := new attribute_array (1 .. schemainfo.attributes'length); attribs2 := new attribute_array (1 .. schemainfo.attributes'length); for x in 1 .. schemainfo.attributes'length loop if schemainfo.attributes (x).isprimarykey then attribs (i) := schemainfo.attributes (x); i := i + 1; else attribs2 (ii) := schemainfo.attributes (x); ii := ii + 1; end if; end loop; i := i - 1; ii := ii - 1; -- the primary_key attributes first for x in 1 .. i loop schemainfo.attributes (x) := attribs (x); end loop; -- non-primary key attributes next for x in 1 .. ii loop schemainfo.attributes (x + i) := attribs2 (x); end loop; Create (fout, Out_File, Trim (schemainfo.all.tablename, Ada.Strings.Both)); --We are writing the number of attributes so that when we load --the table we can determine the number of attributes to put --into the new, loading schema. Integer'write (Stream (fout), schemainfo.all.attributes'length); schemainfo.all.byte_start := Integer'val (Index (fout)); --we output it once so that we can capture the file position for byte_end schema'output (Stream (fout), schemainfo.all); --fill in byte_end schemainfo.all.byte_end := Integer'val (Index (fout)); close(fout); Open (fout, Out_File, Trim (schemainfo.all.tablename, Ada.Strings.Both)); Integer'write (Stream (fout), schemainfo.all.attributes'length); --now we have byte_start and byte_end schema'output (Stream (fout), schemainfo.all); for x in 1 .. schemainfo.all.attributes'length loop to_disc(fout, schemainfo.all.attributes(x).all); end loop; Close (fout); end createtable; function loadtable (sname : String) return schema_ptr is schemainfo : schema_ptr; fin : File_Type; length : Integer; position : integer; begin Open (fin, In_File, Trim (sname, Ada.Strings.Both)); Integer'read (Stream (fin), length); schemainfo := new schema (length); schemainfo.all := schema'class'input (Stream (fin)); --mark where we are at in the file to start reading attributes. position := Integer'val (Index (fin)); for x in 1 .. schemainfo.attributes'length loop ----------------------------------------------------- -- Old code I plan on removing ----------------------------------------------------- -- schemainfo.all.attributes (x).all.byte_start := position; -- -- if Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then -- schemainfo.all.attributes (x) := new booleanattribute; -- schemainfo.all.attributes (x).all := -- booleanattribute'input (Stream (fin)); -- elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "STRING" then -- schemainfo.all.attributes (x) := new stringattribute; -- schemainfo.all.attributes (x).all := -- stringattribute'input (Stream (fin)); -- elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "INTEGER" then -- schemainfo.all.attributes (x) := new integerattribute; -- schemainfo.all.attributes (x).all := -- integerattribute'input (Stream (fin)); -- else -- "DATE" -- schemainfo.all.attributes (x) := new dateattribute; -- schemainfo.all.attributes (x).all := -- dateattribute'input (Stream (fin)); -- end if; -- position := Integer'val (Index (fin)); -- schemainfo.all.attributes (x).all.byte_end := position; -- End old code ------------------------------------------------------ ----------------------------------------------------------- -- The code I want to use for dispatching ----------------------------------------------------------- -- schemainfo.all.attributes (x) := new attribute'class'(from_disc(fin, schemainfo.all.attributes (x).all)); ----------------------------------------------------------- ------------------------------------------------------------ -- Debug code below -- ------------------------------------------------------------ -- For some reason some of the attributes on schemainfo come through -- as "unknown" after the schemainfo was filled in from 'input(stream). -- It doesn't appear to me that createtable procedure in this package -- writes the schema object incorrectly so I don't understand why -- the attributes of the schemainfo object we retrieve with 'input are -- "unknown". Well, the domain member of the attribute is not one of -- BOOLEAN, STRING, INTEGER or DATE; that's why it prints it but why -- isn't the domain member one of those values? if Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "STRING" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "INTEGER" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "DATE" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); else ada.text_io.put_line("unknown"); end if; end loop; -- End Debug Code --------------------------------------------------------------- Close (fin); return schemainfo; exception when Ada.IO_Exceptions.Status_Error => Ada.Text_IO.Put_Line ("Status error in loadtable"); return null; end loadtable; --------------------- -- INSERT RECORD -- --------------------- procedure insertrec (schemainfo : schema; values : attribute_array) is location : Integer := -1; char : Character; begin location := findrecord (schemainfo, values); --if the record isn't in there it is -1 if location = -1 then Open (fout, Append_File, Trim (schemainfo.tablename, Ada.Strings.Both)); for x in 1 .. schemainfo.attributes'length loop to_disc(fout, values (x).all); end loop; Close (fout); else pl ("Record already exists with that key", True, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); end if; end insertrec; --------------------- -- SELECT RECORD -- --------------------- function selectrec (schemainfo : schema) return tuple_ptr is temp : attribute_array_ptr; recs : tuple_ptr; recs2 : tuple_ptr; i : Integer := 1; begin Open (fin, In_File, Trim (schemainfo.tablename, Ada.Strings.Both)); Set_Index (fin, Ada.Streams.Stream_IO.Count'val (schemainfo.attributes (schemainfo.attributes'length).all.byte_end)); temp := new attribute_array (1 .. schemainfo.attributes'length); if End_Of_File (fin) then Close (fin); return null; end if; recs := new tuple (1 .. 1); while not End_Of_File (fin) loop for x in 1 .. temp.all'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes (x).all)); end loop; if i < 2 then recs (recs'last) := temp; else recs2 := new tuple (1 .. recs'length); for z in 1 .. recs'length loop recs2 (z) := recs (z); end loop; recs := new tuple (1 .. i); for z in 1 .. recs2'length loop recs (z) := recs2 (z); end loop; recs (recs'last) := temp; end if; temp := new attribute_array (1 .. schemainfo.attributes'length); i := i + 1; end loop; Close (fin); return recs; end selectrec; ------------------- -- FIND RECORD -- ------------------- function findrecord (schemainfo : schema; values : attribute_array) return Integer is temp : attribute_array_ptr; location : Ada.Streams.Stream_IO.Count; found : Integer := 0; done : Boolean := False; comparrisons : Integer := 0; begin Open (fin, In_File, Trim (schemainfo.tablename, Ada.Strings.Both)); Set_Index (fin, Ada.Streams.Stream_IO.Count'val (schemainfo.attributes (schemainfo.attributes'length).all.byte_end)); temp := new attribute_array (1 .. schemainfo.attributes'length); while not End_Of_File (fin) and then not done loop --mark our current location in the file. location := Index (fin); --read the whole line from the file, for x in 1 .. schemainfo.attributes'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); end loop; --then compare them. comparrisons := 0; found := 0; for x in 1 .. values'length loop if schemainfo.attributes (x).isprimarykey then comparrisons := comparrisons + 1; if Trim (values (x).domain, Ada.Strings.Both) = "BOOLEAN" then if booleanattribute (temp (x).all).value = booleanattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(boolean'image(booleanattribute(temp(x).all).value --)); elsif Trim (values (x).domain, Ada.Strings.Both) = "STRING" then if stringattribute (temp (x).all).value = stringattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(stringattribute(temp(x).all).value); elsif Trim (values (x).domain, Ada.Strings.Both) = "INTEGER" then if integerattribute (temp (x).all).value = integerattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(integer'image(integerattribute(temp(x).all).value --)); else -- "DATE" if dateattribute (temp (x).all).value = dateattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(image(dateattribute(temp(x).all).value, --iso_date)); end if; end if; end loop; if found = comparrisons and then comparrisons > 0 then done := True; end if; if End_Of_File (fin) then done := True; end if; end loop; Close (fin); if found < comparrisons then return -1; elsif found = 0 and then comparrisons = 0 then return -1; else return Integer'val (location); end if; end findrecord; --------------------- -- DELETE RECORD -- --------------------- procedure deleterec (schemainfo : schema; primary_key_values : attribute_array) is location : Integer; original_byte_end : Integer := schemainfo.attributes (schemainfo.attributes'last).byte_end; temp : attribute_array_ptr; char : Character; begin location := findrecord (schemainfo, primary_key_values); --If findrecord seeks past the schema info header in the file and ends --on the end of file it will return -1. Therefore, no records to delete --in the file. if location = -1 then pl ("No records to delete with that key", True, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); return; end if; Create (fout, Out_File, "swapfile"); Open (fin, In_File, Trim (schemainfo.tablename, Ada.Strings.Both)); --output the schema header information to the file Integer'write (Stream (fout), schemainfo.attributes'length); --I took these out so that we could create a function for --updating records that returns an rrn. functions do not --allow out mode parameters and deleterec had an out mode --parameter because of this next line. --schemainfo.byte_start := Integer'val (Index (fout)); schema'output (Stream (fout), schemainfo); --I took these out so that we could create a function for --updating records that returns an rrn. functions do not --allow out mode parameters and deleterec had an out mode --parameter because of this next line. --schemainfo.byte_end := Integer'val (Index (fout)); for x in 1 .. schemainfo.attributes'length loop to_disc(fout, schemainfo.attributes(x).all); end loop; --set the index on the input file so we skip the header on input file. Set_Index (fin, Ada.Streams.Stream_IO.Count'val (original_byte_end)); temp := new attribute_array (1 .. schemainfo.attributes'length); --Read records from one file and insert them into the other file until --we get to the location of the record we want to delete. while Index (fin) < Ada.Streams.Stream_IO.Count'val (location) loop for x in 1 .. temp.all'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); to_disc(fin, temp(x).all); end loop; end loop; --do a blank read to move past the line to delete for x in 1 .. schemainfo.attributes'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); end loop; --output the rest of the records. while not End_Of_File (fin) loop for x in 1 .. temp.all'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); to_disc(fout, temp(x).all); end loop; end loop; Close (fin); Close (fout); Ada.Directories.Delete_File (Trim (schemainfo.tablename, Ada.Strings.Both)); Ada.Directories.Rename ("swapfile", Trim (schemainfo.tablename, Ada.Strings.Both)); location := findrecord (schemainfo, primary_key_values); if location >= 1 then deleterec (schemainfo, primary_key_values); end if; end deleterec; --------------------- -- UPDATE RECORD -- --------------------- procedure updaterec (schemainfo : schema; pkattribs : attribute_array; values : attribute_array) is position : Integer := 0; char : Character; begin position := findrecord (schemainfo, pkattribs); --if the record doesn't exist then insert it if position < 1 then pl ("That record doesn't exist in the database.", True, True); pl ("Insert it instead (menu item 1).", True, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); elsif position >= 1 then deleterec (schemainfo, pkattribs); insertrec (schemainfo, values); end if; end updaterec; begin null; end schema_types; 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 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 Ada.Streams.Stream_IO, util, attribute_types,Ada.Calendar; use util, attribute_types,Ada.Calendar; package index_types is --------------------------------- -- Variable Declarations -- --------------------------------- fin : Ada.Streams.Stream_IO.File_Type; fout : Ada.Streams.Stream_IO.File_Type; -------------------------------------------------------- -- THIS FILE IS NOT COMPLETE NOR USED YET!!! -- IT IS INCLUDED BECAUSE IT IS WITH'D -------------------------------------------------------- --an index is a file --it contains the primary key value and file position for the primary key for a primary index --the spec sounds like only one attribute will make up a primary key. --for a secondary index it contains an attribute and a position. --The spec says only one attribute. --primary indexes are named after the table it belongs to <tablename>_PIDX --secondary indexes are named after the table it belongs to like <tablename>_SIDX --each schema object has a list of index names for a table --initially the list of index names is empty --the user adds an index to the table and then the index name goes into the list of indexes on --the schema --the schema information will have to be re-written to the table file when an index is added. --This is the same for the secondary indexes --if a tuple that an index is based on is inserted, deleted or updated then the index must be --loaded and re-created. ----on updates we only have to change the index if the index value is being changed. --The attributes store the name of an index on itself. When we load the schema --we go through each attribute and determine if it is indexed then load that --index if it is. This gives us the "type" on the index value, elleviates the --need to maintain a list of index names in the schema object, ----what do we load an index into? --There are two types of indexes: primary and secondary --** note ** the primary index is just like the secondary; it only has one entry per item --because there is only --one item allowed per entry due to the fact that primary keys are unique. --The differences in indexes are: ----if we remove a value from a secondary we must match the rrn to remove the correct --item; with a primary key there is only one to remove. ----when finding a record, with a primary index when we find the value we don't ----have to search a bunch of records for the exact tuple match. With secondary ----, because there are multiple values that are the same with different rrn's ----we have to search each rrn and compare values to match the tuple. --we don't sort as we read the table, we read the table and then sort the index file. type index is abstract tagged record filename : String (1 .. max_index_namelength); rrn : Ada.Streams.Stream_IO.Count := 0; end record; type index_ptr is access all index; type index_array is array (Integer range <>) of index_ptr; type booleanindex is tagged record key : boolean; end record; type integerindex is tagged record key : integer; end record; type stringindex is tagged record key : string(1..max_stringlength); end record; type dateindex is tagged record key : time; end record; end index_types; ************************* * Contents of the table.txt file * This file is used by the main procedure dbprog. * It must be labeled tables.txt and placed in the * same directory as the executable dbprog.exe ************************* T3( ID(PRIMARY KEY):INTEGER ); T2( DATA(PRIMARY KEY):STRING(15) ); T4( II(PRIMARY KEY):DATE ); T1( mine(PRIMARY KEY):BOOLEAN ); ************************* ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 14:11 ` andrew.carroll @ 2007-04-02 18:43 ` andrew.carroll 2007-04-02 21:48 ` Georg Bauhaus 2007-04-02 20:45 ` Simon Wright 1 sibling, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-02 18:43 UTC (permalink / raw) Here is a backtrace: #0 probe () at c:\gnatmail\release-gpl\build-toulouse\tmp/ccwfbaaa.s: 19 #1 0x77c4123c in ?? () #2 0x00410ead in schema_types.loadtable (sname={P_ARRAY = 0x222840, P_BOUNDS = 0x260fc38}) at F:\dbprog\v5\schema_types.adb:99 #3 0x00419a97 in parser.parsetables () at F:\dbprog\v5\parser.adb:57 #4 0x0043a28e in dbprog () at F:\dbprog\v5\dbprog.adb:807 #5 0x0040164d in main (argc=1, argv=2237648, envp=2239688) at b~dbprog.adb:228 #6 0x004011d8 in __mingw_CRTStartup () #7 0x00401203 in mainCRTStartup () #8 0x7c816fd7 in ?? () ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 18:43 ` andrew.carroll @ 2007-04-02 21:48 ` Georg Bauhaus 2007-04-02 21:40 ` andrew.carroll 0 siblings, 1 reply; 46+ messages in thread From: Georg Bauhaus @ 2007-04-02 21:48 UTC (permalink / raw) On Mon, 2007-04-02 at 11:43 -0700, andrew.carroll@okstate.edu wrote: > Here is a backtrace: > Not sure whether I have been doing what you want to do. I joined a number of lines that were split in two in the news message, and then enabled this code: ----------------------------------------------------------- -- The code I want to use for dispatching ----------------------------------------------------------- schemainfo.all.attributes (x) := new attribute'class'(from_disc(fin, schemainfo.all.attributes (x).all)); FWIW, $ gnatmake -gnat05 -g -O -gnatwa -W -gnato -fstack-check dbprog $ ./dbprog --------------------------------------------------- Put your table definitions in a file named tables.txt and place the file in the same folder as this program (Parser.exe). Type C to continue or. ~ to quit. --------------------------------------------------- >>C Error in input file format: No attributes found. Must have (<attribute list>) Error in input file: Format not correct, no type specified for attribute * You entered the data wrong. $ uname -a Linux sonnenregen 2.6.17-11-server #2 SMP Thu Feb 1 19:53:33 UTC 2007 i686 GNU/Linux The system is Ubuntu being based on Debian, with GNAT GPL 2006. (Some new Ada 2005 features aren't in the system's 4.1.2 based compiler, I guess; the correct "Value" is not found.) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 21:48 ` Georg Bauhaus @ 2007-04-02 21:40 ` andrew.carroll 2007-04-03 10:25 ` Georg Bauhaus 0 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-02 21:40 UTC (permalink / raw) I should say that I am developing on a Windows box. Did you make a file called tables.txt? Is it in the same directory as the executable? Does it have the following lines in it: T1( mine(PRIMARY KEY):BOOLEAN ); T3( ID(PRIMARY KEY):INTEGER ); T2( DATA(PRIMARY KEY):STRING(15) ); T4( II(PRIMARY KEY):DATE ); ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 21:40 ` andrew.carroll @ 2007-04-03 10:25 ` Georg Bauhaus 2007-04-03 17:07 ` andrew.carroll 2007-04-03 19:43 ` Simon Wright 0 siblings, 2 replies; 46+ messages in thread From: Georg Bauhaus @ 2007-04-03 10:25 UTC (permalink / raw) On Mon, 2007-04-02 at 14:40 -0700, andrew.carroll@okstate.edu wrote: > I should say that I am developing on a Windows box. > Did you make a file called tables.txt? Is it in the same directory as > the executable? Yes. I used the lines from the tail of your posting as advice and created the file. (While the advice talks about about both "table.txt" and "tables.txt", I tried with and without "tables.txt".) > > Does it have the following lines in it: > > T1( > mine(PRIMARY KEY):BOOLEAN > ); > > T3( > ID(PRIMARY KEY):INTEGER > ); > > T2( > DATA(PRIMARY KEY):STRING(15) > ); > > T4( > II(PRIMARY KEY):DATE > ); > ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-03 10:25 ` Georg Bauhaus @ 2007-04-03 17:07 ` andrew.carroll 2007-04-03 19:43 ` Simon Wright 1 sibling, 0 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-03 17:07 UTC (permalink / raw) :-) Okay, try a lower case 'c' instead of upper case 'C'. On Apr 3, 5:25 am, Georg Bauhaus <bauh...@futureapps.de> wrote: > On Mon, 2007-04-02 at 14:40 -0700, andrew.carr...@okstate.edu wrote: > > I should say that I am developing on a Windows box. > > Did you make a file called tables.txt? Is it in the same directory as > > the executable? > > Yes. I used the lines from the tail of your posting as > advice and created the file. > (While the advice talks about about both "table.txt" and > "tables.txt", I tried with and without "tables.txt".) > > > > > > > Does it have the following lines in it: > > > T1( > > mine(PRIMARY KEY):BOOLEAN > > ); > > > T3( > > ID(PRIMARY KEY):INTEGER > > ); > > > T2( > > DATA(PRIMARY KEY):STRING(15) > > ); > > > T4( > > II(PRIMARY KEY):DATE > > );- Hide quoted text - > > - Show quoted text - ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-03 10:25 ` Georg Bauhaus 2007-04-03 17:07 ` andrew.carroll @ 2007-04-03 19:43 ` Simon Wright 2007-04-03 21:32 ` andrew.carroll 2007-04-04 0:49 ` Georg Bauhaus 1 sibling, 2 replies; 46+ messages in thread From: Simon Wright @ 2007-04-03 19:43 UTC (permalink / raw) Georg Bauhaus <bauhaus@futureapps.de> writes: > On Mon, 2007-04-02 at 14:40 -0700, andrew.carroll@okstate.edu wrote: >> I should say that I am developing on a Windows box. >> Did you make a file called tables.txt? Is it in the same directory as >> the executable? > > Yes. I used the lines from the tail of your posting as > advice and created the file. > (While the advice talks about about both "table.txt" and > "tables.txt", I tried with and without "tables.txt".) $ ./dbprog [...] >>c [...] >>y [...] >>y [...] >>y [...] >>y --------------------------------------------------- Type one of the following at the prompt: ~ QUIT 1 INSERT DATA 2 UPDATE DATA 3 DELETE DATA 4 SHOW RECORDS For help type 'help' --------------------------------------------------- >>1 Enter the table name in CAPITAL letters >>T1 Enter a value for mine(BOOLEAN) >>false Segmentation fault (Andrew, I hope you won't take it wrong if I say that you've spent quite a bit of effort making a UI that's rather difficult to use :-) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-03 19:43 ` Simon Wright @ 2007-04-03 21:32 ` andrew.carroll 2007-04-04 0:49 ` Georg Bauhaus 1 sibling, 0 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-03 21:32 UTC (permalink / raw) Yeah, I DEFINITELY need some testers!! I forgot to enclose the string compare with a call to upper. ;-) You can use 1/0 for true/false you can use TRUE or FALSE also but not True, true, tRue, trUe, ... and not False, fAlse, faLse, ... On Apr 3, 2:43 pm, Simon Wright <simon.j.wri...@mac.com> wrote: > Georg Bauhaus <bauh...@futureapps.de> writes: > > On Mon, 2007-04-02 at 14:40 -0700, andrew.carr...@okstate.edu wrote: > >> I should say that I am developing on a Windows box. > >> Did you make a file called tables.txt? Is it in the same directory as > >> the executable? > > > Yes. I used the lines from the tail of your posting as > > advice and created the file. > > (While the advice talks about about both "table.txt" and > > "tables.txt", I tried with and without "tables.txt".) > > $ ./dbprog > [...]>>c > [...] > >>y > [...] > >>y > [...] > >>y > [...] > >>y > > --------------------------------------------------- > Type one of the following at the prompt: > > ~ QUIT > 1 INSERT DATA > 2 UPDATE DATA > 3 DELETE DATA > 4 SHOW RECORDS > For help type 'help' > --------------------------------------------------- > >>1 > > Enter the table name in CAPITAL letters >>T1 > Enter a value for mine(BOOLEAN) >>false > Segmentation fault > > (Andrew, I hope you won't take it wrong if I say that you've spent > quite a bit of effort making a UI that's rather difficult to use :-) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-03 19:43 ` Simon Wright 2007-04-03 21:32 ` andrew.carroll @ 2007-04-04 0:49 ` Georg Bauhaus 2007-04-04 0:32 ` andrew.carroll 2007-04-05 0:56 ` andrew.carroll 1 sibling, 2 replies; 46+ messages in thread From: Georg Bauhaus @ 2007-04-04 0:49 UTC (permalink / raw) On Tue, 2007-04-03 at 20:43 +0100, Simon Wright wrote: > --------------------------------------------------- > Type one of the following at the prompt: > > ~ QUIT > 1 INSERT DATA > 2 UPDATE DATA > 3 DELETE DATA > 4 SHOW RECORDS > For help type 'help' > --------------------------------------------------- > >>1 Erh, got there, finally. Here is one observation, and a total lack of explanation: In function from_disc(...dateattribute), variable "temp", to be used as a pointer to the result value, is assigned a pointer to a newly allocated dateattribute. On my computer, this pointer isn't quite as I would have expected. In GDB, I get STORAGE_ERROR each time I try to print a field of the object (temp has an address), even though the contents at the address seem plausible by what (gdb) x/60c is showing me... It takes a few seconds until gdb dumps core after a seg fault in this case. (A temperature drop of some 15°C rel to yesterday is probably not be the only thing that is affecting me, so I'll stop being confused for today.) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-04 0:49 ` Georg Bauhaus @ 2007-04-04 0:32 ` andrew.carroll 2007-04-05 18:28 ` Georg Bauhaus 2007-04-05 0:56 ` andrew.carroll 1 sibling, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-04 0:32 UTC (permalink / raw) Ahhhhh, it's like a cool breeze on a hot day. Finally, someone else gets the results I do. I've tried several different configurations of from_disc. I always seem to get the results you did. Also, I moved table declarations around in the tables.txt file to see if I could narrow it down to one attribute type. Doing so gives me the same error on different attribute types. At first I thought it might be the to_disc function was writing "bad bytes" to the table file but I have not thought of a way to tell. This would cause from_disc to fail. I also tried moving table declarations around in the tables.txt file and it gives mixed results. The date type you mentioned, if you move the declaration to a different spot in the file, it will read it in fine. One of the other attribute types will then be broken. Hence, I think there are several problems: 1. somewhere I have a a pointer pointing to something it shouldn't. It's possibly sharing an attribute in the schema.attributes array. 2. Maybe? It could be that the file stream is not an in out parameter. 3. It is not dispatching properly. My goal is to get comp.lang.ada's thoughts. Thanks. On Apr 3, 7:49 pm, Georg Bauhaus <bauh...@futureapps.de> wrote: > On Tue, 2007-04-03 at 20:43 +0100, Simon Wright wrote: > > --------------------------------------------------- > > Type one of the following at the prompt: > > > ~ QUIT > > 1 INSERT DATA > > 2 UPDATE DATA > > 3 DELETE DATA > > 4 SHOW RECORDS > > For help type 'help' > > --------------------------------------------------- > > >>1 > > Erh, got there, finally. > > Here is one observation, and a total lack of explanation: In function > from_disc(...dateattribute), variable "temp", to be used as a > pointer to the result value, is assigned a pointer to a > newly allocated dateattribute. On my computer, this pointer isn't > quite as I would have expected. In GDB, I get STORAGE_ERROR each time > I try to print a field of the object (temp has an address), even > though the contents at the address seem plausible by what (gdb) x/60c > is showing me... It takes a few seconds until gdb dumps core after > a seg fault in this case. > > (A temperature drop of some 15°C rel to yesterday is probably not be > the only thing that is affecting me, so I'll stop being confused for > today.) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-04 0:32 ` andrew.carroll @ 2007-04-05 18:28 ` Georg Bauhaus 2007-04-09 13:12 ` andrew.carroll 0 siblings, 1 reply; 46+ messages in thread From: Georg Bauhaus @ 2007-04-05 18:28 UTC (permalink / raw) On Tue, 2007-04-03 at 17:32 -0700, andrew.carroll@okstate.edu wrote: > The date type you mentioned, if you move the declaration to > a different spot in the file, it will read it in fine. One of the > other attribute types will then be broken. Interestingly, attribute_types.ads seems to send gnatpp into a loop... Hm... ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-05 18:28 ` Georg Bauhaus @ 2007-04-09 13:12 ` andrew.carroll 2007-04-09 18:19 ` Georg Bauhaus 0 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-09 13:12 UTC (permalink / raw) On Apr 5, 1:28 pm, Georg Bauhaus <bauh...@futureapps.de> wrote: > On Tue, 2007-04-03 at 17:32 -0700, andrew.carr...@okstate.edu wrote: > > The date type you mentioned, if you move the declaration to > > a different spot in the file, it will read it in fine. One of the > > other attribute types will then be broken. > > Interestingly, attribute_types.ads seems to send gnatpp into > a loop... Hm... I'm not sure of the significance of that other than locking up gnatpp (if that's what happens). What does that mean to you? ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-09 13:12 ` andrew.carroll @ 2007-04-09 18:19 ` Georg Bauhaus 2007-04-10 13:22 ` andrew.carroll 0 siblings, 1 reply; 46+ messages in thread From: Georg Bauhaus @ 2007-04-09 18:19 UTC (permalink / raw) On Mon, 2007-04-09 at 06:12 -0700, andrew.carroll@okstate.edu wrote: > On Apr 5, 1:28 pm, Georg Bauhaus <bauh...@futureapps.de> wrote: > > On Tue, 2007-04-03 at 17:32 -0700, andrew.carr...@okstate.edu wrote: > > > The date type you mentioned, if you move the declaration to > > > a different spot in the file, it will read it in fine. One of the > > > other attribute types will then be broken. > > > > Interestingly, attribute_types.ads seems to send gnatpp into > > a loop... Hm... > > I'm not sure of the significance of that other than locking up gnatpp > (if that's what happens). What does that mean to you? Just helping me finding wild guesses about what could make the allocated objects behave differently from similar objects created in a stripped down from_dics toy function. (Which work as expected.) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-09 18:19 ` Georg Bauhaus @ 2007-04-10 13:22 ` andrew.carroll 2007-04-10 15:07 ` Ludovic Brenta 0 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-10 13:22 UTC (permalink / raw) One thing I am in the process of doing is to move the schema object output to its own file. The part of this project I am working on now is to add indexing and the index will have it's own file, the tuples will have their own file and the schema object will have it's own file so that I can move loading the schema or creating the schema to be the "responsibility" of the schema_types and creating the table to a table_types package. This would move the insertrec, updaterec, deleterec, and selectrec to table_types as well. From those methods I could remove any operations where I have to read past the schema information; that could just be read from the schema spec file for each table. There would be three data files. <tablename>_SCMA, <tablename>_PIDX and <tablename> (for the tuples). Then I can eliminate the byte_start and byte_end attributes of the attribute class. Also, I could remove record_size from the schema class because it is never used. Doing all this might help facilitate unit testing better, of which I need to do to track down the problem. Thanks for your help!! Andrew ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-10 13:22 ` andrew.carroll @ 2007-04-10 15:07 ` Ludovic Brenta 2007-04-10 20:55 ` andrew.carroll 0 siblings, 1 reply; 46+ messages in thread From: Ludovic Brenta @ 2007-04-10 15:07 UTC (permalink / raw) If you're going to have schemas and indexes, why don't you use a proper relational database engine like Berkeley DB or SQLite? (I suspect an out-of-process database server like PostgreSQL or MySQL might be overkill and too slow for your purposes, but they could be options, too). -- Ludovic Brenta. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-10 15:07 ` Ludovic Brenta @ 2007-04-10 20:55 ` andrew.carroll 2007-04-10 22:17 ` Georg Bauhaus 2007-04-11 1:55 ` Jeffrey R. Carter 0 siblings, 2 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-10 20:55 UTC (permalink / raw) On Apr 10, 10:07 am, "Ludovic Brenta" <ludo...@ludovic-brenta.org> wrote: > If you're going to have schemas and indexes, why don't you use a > proper relational database engine like Berkeley DB or SQLite? (I > suspect an out-of-process database server like PostgreSQL or MySQL > might be overkill and too slow for your purposes, but they could be > options, too). > > -- > Ludovic Brenta. I think I misled you with my last post. This is an assignment for my Master's degree class. I asked for help because I can't track down an error using the debugger (it crashes the debugger when I try to print things). So I posted it here for help and to get some opinions on what "could" be wrong with it based on the code and the error message "STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW". Anyway... I wish I could use Berkleley DB or SQLite. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-10 20:55 ` andrew.carroll @ 2007-04-10 22:17 ` Georg Bauhaus 2007-04-10 21:43 ` andrew.carroll 2007-04-11 1:55 ` Jeffrey R. Carter 1 sibling, 1 reply; 46+ messages in thread From: Georg Bauhaus @ 2007-04-10 22:17 UTC (permalink / raw) On Tue, 2007-04-10 at 13:55 -0700, andrew.carroll@okstate.edu wrote: > This is an assignment for my > Master's degree class. I can't imagine that everyone at AdaCore has adopted an MS style first-your-money-then-we-are-really-supportive- else-you-are-in-a-public-desert attitude. Given this might be a technical GNAT problem, perhaps with the help of a letter from your professor AdaCore might take an interest in a test run with a more recent compiler (and without signing a GAP contract first)? Another option might be to use Ada 95 first, then the choice of compilers is larger which might help pinpointing the error. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-10 22:17 ` Georg Bauhaus @ 2007-04-10 21:43 ` andrew.carroll 2007-04-12 8:32 ` Ludovic Brenta 0 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-10 21:43 UTC (permalink / raw) On Apr 10, 5:17 pm, Georg Bauhaus <bauh...@futureapps.de> wrote: > On Tue, 2007-04-10 at 13:55 -0700, andrew.carr...@okstate.edu wrote: > > This is an assignment for my > > Master's degree class. > > I can't imagine that everyone at AdaCore has adopted an > MS style first-your-money-then-we-are-really-supportive- > else-you-are-in-a-public-desert attitude. Given this might be > a technical GNAT problem, perhaps with the help of > a letter from your professor AdaCore might take an interest > in a test run with a more recent compiler (and without signing > a GAP contract first)? > > Another option might be to use Ada 95 first, then the choice > of compilers is larger which might help pinpointing the error. So using ada95 is as simple as checking that box in GPS? ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-10 21:43 ` andrew.carroll @ 2007-04-12 8:32 ` Ludovic Brenta 0 siblings, 0 replies; 46+ messages in thread From: Ludovic Brenta @ 2007-04-12 8:32 UTC (permalink / raw) Andrew Carrol writes: > So using ada95 is as simple as checking that box in GPS? Yes, it is. This is equivalent to passing -gnat95 to the compiler. BTW, GNAT GPL 2006 and GAP default to Ada 2005 (-gnat05) mode whereas GNAT Pro and GCC 4.1 default to Ada 95 (-gnat95) mode. I haven't yet looked what GCC 4.2 will default to. -- Ludovic Brenta. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-10 20:55 ` andrew.carroll 2007-04-10 22:17 ` Georg Bauhaus @ 2007-04-11 1:55 ` Jeffrey R. Carter 2007-04-11 2:34 ` andrew.carroll 1 sibling, 1 reply; 46+ messages in thread From: Jeffrey R. Carter @ 2007-04-11 1:55 UTC (permalink / raw) andrew.carroll@okstate.edu wrote: > > I think I misled you with my last post. This is an assignment for my > Master's degree class. I asked for help because I can't track down an > error using the debugger (it crashes the debugger when I try to print > things). So I posted it here for help and to get some opinions on > what "could" be wrong with it based on the code and the error message > "STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW". Anyway... Are you using the GNAT Academic version? I think that includes some support. -- Jeff Carter "Run away! Run away!" Monty Python and the Holy Grail 58 ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-11 1:55 ` Jeffrey R. Carter @ 2007-04-11 2:34 ` andrew.carroll 0 siblings, 0 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-11 2:34 UTC (permalink / raw) On Apr 10, 8:55 pm, "Jeffrey R. Carter" <jrcar...@acm.org> wrote: > andrew.carr...@okstate.edu wrote: > > > I think I misled you with my last post. This is an assignment for my > > Master's degree class. I asked for help because I can't track down an > > error using the debugger (it crashes the debugger when I try to print > > things). So I posted it here for help and to get some opinions on > > what "could" be wrong with it based on the code and the error message > > "STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW". Anyway... > > Are you using the GNAT Academic version? I think that includes some support. > > -- > Jeff Carter > "Run away! Run away!" > Monty Python and the Holy Grail > 58 I doubt that I am using the academic version. I did download it from AdaCore but I think it was just the "free" version. I'll check the website again and see if I have to have the GAP to get the academic version. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-04 0:49 ` Georg Bauhaus 2007-04-04 0:32 ` andrew.carroll @ 2007-04-05 0:56 ` andrew.carroll 1 sibling, 0 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-05 0:56 UTC (permalink / raw) Did you see my last post? What do you think it could be? Andrew ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 14:11 ` andrew.carroll 2007-04-02 18:43 ` andrew.carroll @ 2007-04-02 20:45 ` Simon Wright 2007-04-02 21:47 ` andrew.carroll 1 sibling, 1 reply; 46+ messages in thread From: Simon Wright @ 2007-04-02 20:45 UTC (permalink / raw) I've just spent over half an hour getting this to compile (hint: use zip, or restrict your line length to something your mailer won't mangle!); the operating instructions are a tad lacking, but I've got to the point of an EXC_BAD_ACCESS somewhere a way deeper in the stack than (my) schema_types.adb:320: 319 for x in 1 .. schemainfo.attributes'length loop 320 temp(x) := new attribute'class'(from_disc(fin, 321 schemainfo.attributes(x).all)); I notice that in attribute_types.adb, you have 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; which looks wrong; (a) the calculation of byte_end ought to say (foo'size + 7) / 8; but it's irrelevant, because (b) the disk size of the record written will not be equal to the memory size, for two reasons: first, 'output writes tag and constraint data as well as binary data, and second, the binary data is likely to be packed differently -- GNAT writes in multiples of one byte per item, without any alignment padding such as will be in memory. Could you work out where the record is in the disk file by noting the file position before and after the read? ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 20:45 ` Simon Wright @ 2007-04-02 21:47 ` andrew.carroll 0 siblings, 0 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-02 21:47 UTC (permalink / raw) On Apr 2, 3:45 pm, Simon Wright <simon.j.wri...@mac.com> wrote: > I've just spent over half an hour getting this to compile (hint: use > zip I am not sure how to add an attachment to google groups... > I notice that in attribute_types.adb, you have > > 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; > > which looks wrong; > > (a) the calculation of byte_end ought to say (foo'size + 7) / 8; but > it's irrelevant, because I could take byte_end and byte_start out. They are not really needed. > Could you work out where the record is in the disk file by noting the > file position before and after the read? I could do this but then I would have to write to disc twice. I would not have a correct value for byte_end until AFTER the object was written to the file. Then, to actually store the correct value of byte_end in the file I would have to set_index to byte_start again and write it again so that byte_end would be recorded as well. Probably better for me to remove these entirely. I had plans for them originally but deadlines are squeezing out features faster than I can code. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll 2007-04-02 10:10 ` Stephen Leake @ 2007-04-02 22:05 ` andrew.carroll 2007-04-03 0:09 ` Randy Brukardt 2007-04-11 2:49 ` andrew.carroll 2007-04-12 13:48 ` andrew.carroll 3 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-02 22:05 UTC (permalink / raw) I've made some further changes to the program. I made the following adjustments to the attribute_types. type attribute is abstract tagged null record; and I added the following functions/procedures function getName (item: attribute) return string is abstract; procedure setName(item: in out attribute; value: string) is abstract; function getDomain(item: attribute) return string is abstract; procedure setDomain(item: in out attribute; value: string) is abstract; function getByteEnd(item: attribute) return integer is abstract; function isprimarykey(item: attribute) return boolean is abstract; procedure makeprimarykey(item: in out attribute) is abstract; This way there is not mistaking that it is dispatched. The reason I did this is because I tried debugging it to find out what the domain value of an attribute was in the debug code inside the loadtable procedure. I would try to print the .domain field of schemainfo.attributes(x) and it would kill the debugger. Since I made the changes the error message is now "raised PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION". Which if I'm not mistaken means dangling pointer and that matches to errors I now get in gdb. Here is the new attribute_types.adb/ads files 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 null 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 access attribute'class; type attribute_array is array (Integer range <>) of attribute_ptr; 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; function getName (item: attribute) return string is abstract; procedure setName(item: in out attribute; value: string) is abstract; function getDomain(item: attribute) return string is abstract; procedure setDomain(item: in out attribute; value: string) is abstract; function getByteEnd(item: attribute) return integer is abstract; function isprimarykey(item: attribute) return boolean is abstract; procedure makeprimarykey(item: in out attribute) is abstract; ----------------------------------- -- Extended Attribute Types -- ----------------------------------- type booleanattribute is new attribute with 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; 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; function getName (item: booleanattribute) return string; procedure setName(item: in out booleanattribute; value: string); function getDomain(item: booleanattribute) return string; procedure setDomain(item: in out booleanattribute; value: string); function getByteEnd(item: booleanattribute) return integer; function isprimarykey(item: booleanattribute) return boolean; procedure makeprimarykey(item: in out booleanattribute); type integerattribute is new attribute with 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; 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; function getName (item: integerattribute) return string; procedure setName(item: in out integerattribute; value: string); function getDomain(item: integerattribute) return string; procedure setDomain(item: in out integerattribute; value: string); function getByteEnd(item: integerattribute) return integer; function isprimarykey(item: integerattribute) return boolean; procedure makeprimarykey(item: in out integerattribute); type stringattribute is new attribute with 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; 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; function getName (item: stringattribute) return string; procedure setName(item: in out stringattribute; value: string); function getDomain(item: stringattribute) return string; procedure setDomain(item: in out stringattribute; value: string); function getByteEnd(item: stringattribute) return integer; function isprimarykey(item: stringattribute) return boolean; procedure makeprimarykey(item: in out stringattribute); type dateattribute is new attribute with 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; 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; function getName (item: dateattribute) return string; procedure setName(item: in out dateattribute; value: string); function getDomain(item: dateattribute) return string; procedure setDomain(item: in out dateattribute; value: string); function getByteEnd(item: dateattribute) return integer; function isprimarykey(item: dateattribute) return boolean; procedure makeprimarykey(item: in out dateattribute); end attribute_types; with ada.text_io, util, ada.calendar; use util, ada.calendar; package body attribute_types is ------------------------------- -- BOOLEAN ATTRIBUTE STUFF -- ------------------------------- 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); booleanattribute'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)); temp.all := booleanattribute'input (Stream (fin)); return temp.all; end from_disc; function getName (item: booleanattribute) return string is begin return item.name; end getName; procedure setName(item: in out booleanattribute; value: string) is begin item.name := value(value'first - 1 + item.name'first..item.name'last); end setName; function getDomain(item: booleanattribute) return string is begin return item.domain; end getDomain; procedure setDomain(item: in out booleanattribute; value: string) is begin item.domain := value(value'first - 1 + item.domain'first..item.domain'last); end setdomain; function getByteEnd(item: booleanattribute) return integer is begin return item.byte_end; end getByteEnd; function isprimarykey(item: booleanattribute) return boolean is begin return item.isprimarykey; end isprimarykey; procedure makeprimarykey(item: in out booleanattribute) is begin item.isprimarykey := true; end makeprimarykey; ------------------------------- -- INTEGER ATTRIBUTE STUFF -- ------------------------------- 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); integerattribute'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)); temp.all := integerattribute'input (Stream (fin)); return temp.all; end from_disc; function getName (item: integerattribute) return string is begin return item.name; end getName; procedure setName(item: in out integerattribute; value: string) is begin item.name := value(value'first - 1 + item.name'first..item.name'last); end setName; function getDomain(item: integerattribute) return string is begin return item.domain; end getDomain; procedure setDomain(item: in out integerattribute; value: string) is begin item.domain := value(value'first - 1 + item.domain'first..item.domain'last); end setdomain; function getByteEnd(item: integerattribute) return integer is begin return item.byte_end; end getByteEnd; function isprimarykey(item: integerattribute) return boolean is begin return item.isprimarykey; end isprimarykey; procedure makeprimarykey(item: in out integerattribute) is begin item.isprimarykey := true; end makeprimarykey; ------------------------------ -- STRING ATTRIBUTE STUFF -- ------------------------------ 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); stringattribute'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)); temp.all := stringattribute'input (Stream (fin)); return temp.all; end from_disc; function getName (item: stringattribute) return string is begin return item.name; end getName; procedure setName(item: in out stringattribute; value: string) is begin item.name := value(value'first - 1 + item.name'first..item.name'last); end setName; function getDomain(item: stringattribute) return string is begin return item.domain; end getDomain; procedure setDomain(item: in out stringattribute; value: string) is begin item.domain := value(value'first - 1 + item.domain'first..item.domain'last); end setdomain; function getByteEnd(item: stringattribute) return integer is begin return item.byte_end; end getByteEnd; function isprimarykey(item: stringattribute) return boolean is begin return item.isprimarykey; end isprimarykey; procedure makeprimarykey(item: in out stringattribute) is begin item.isprimarykey := true; end makeprimarykey; ---------------------------- -- DATE ATTRIBUTE STUFF -- ---------------------------- 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); dateattribute'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)); temp.all := dateattribute'input (Stream (fin)); return temp.all; end from_disc; function getName (item: dateattribute) return string is begin return item.name; end getName; procedure setName(item: in out dateattribute; value: string) is begin item.name := value(value'first - 1 + item.name'first..item.name'last); end setName; function getDomain(item: dateattribute) return string is begin return item.domain; end getDomain; procedure setDomain(item: in out dateattribute; value: string) is begin item.domain := value(value'first - 1 + item.domain'first..item.domain'last); end setdomain; function getByteEnd(item: dateattribute) return integer is begin return item.byte_end; end getByteEnd; function isprimarykey(item: dateattribute) return boolean is begin return item.isprimarykey; end isprimarykey; procedure makeprimarykey(item: in out dateattribute) is begin item.isprimarykey := true; end makeprimarykey; begin null; end attribute_types; ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 22:05 ` andrew.carroll @ 2007-04-03 0:09 ` Randy Brukardt 0 siblings, 0 replies; 46+ messages in thread From: Randy Brukardt @ 2007-04-03 0:09 UTC (permalink / raw) <andrew.carroll@okstate.edu> wrote in message news:1175551506.025858.161810@l77g2000hsb.googlegroups.com... > I've made some further changes to the program. I made the following > adjustments to the attribute_types. ... > This way there is not mistaking that it is dispatched. If you want to be sure that a routine is dispatching from your root type, all of the child type's operations should include "overriding" on the subprogram declarations. (Unless, of course, that's not implemented in your compiler.) That way, if you make some error such that the compiler doesn't see the routines as dispatching, you'll get a compiler error. That's much better than the hours in the debugger that you'd need otherwise. (That advice doesn't apply to Ada 95, because it doesn't have the "overriding" keyword.) Randy. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll 2007-04-02 10:10 ` Stephen Leake 2007-04-02 22:05 ` andrew.carroll @ 2007-04-11 2:49 ` andrew.carroll 2007-04-11 8:07 ` Georg Bauhaus 2007-04-11 21:31 ` Simon Wright 2007-04-12 13:48 ` andrew.carroll 3 siblings, 2 replies; 46+ messages in thread From: andrew.carroll @ 2007-04-11 2:49 UTC (permalink / raw) Well, aparently the my university has to be a GAP member to get the academic version. I don't know how long that will take even if the University would consider it. It has already taken to long for that matter (ha ha). I did adjust the dispatching version of the program to be "Ada95". At least I think I did. I went into the project properties within GPS and selected the checkbox labeled Ada95. Then I did a make clean and then recompiled/made all the files. I did find some compile errors and fixed those. I still get an error but it is different. It's now an access violation. I'll see what I can do with it now as far as debugging. I might see if there are any other Ada compiler vendors out there. If I am not mistaken AdaCore would be expensive; at least for a student. Other than that I guess my options are to not use dispatching or write it in some other language. Ugh! Andrew ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-11 2:49 ` andrew.carroll @ 2007-04-11 8:07 ` Georg Bauhaus 2007-04-11 21:31 ` Simon Wright 1 sibling, 0 replies; 46+ messages in thread From: Georg Bauhaus @ 2007-04-11 8:07 UTC (permalink / raw) On Tue, 2007-04-10 at 19:49 -0700, andrew.carroll@okstate.edu wrote: > I did adjust the dispatching version of the program to be "Ada95". ... > I still get an error but it is different. It's now > an access violation. Ah. Good. Or not. An access violation isn't always easy to find; however, it may point you to a visibility issue introduced by anonymous access circuitry or some related thing, or some missing initialization, or something caused by the compiler/RTS. Can you try a not so recent GNAT, like 3.15p? And/Or if you stubbornly replace anonymous pointer types with named pointer types, the compiler might complain before the program is run. If you have some code that modern news systems will not hash, or can use eMail, send your Ada 95 program so another compiler gets a chance to produce a program, or a different error at least. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-11 2:49 ` andrew.carroll 2007-04-11 8:07 ` Georg Bauhaus @ 2007-04-11 21:31 ` Simon Wright 2007-04-12 16:00 ` andrew.carroll 1 sibling, 1 reply; 46+ messages in thread From: Simon Wright @ 2007-04-11 21:31 UTC (permalink / raw) Looking over your first complete posted code, I see that the procedure schema_types.createtable has an unusual approach when writing the schema to the file. Normally you rely on the compiler to support streaming through the inbuilt 'Output, 'Input, 'Wrtte, 'Read operations. The only place where this falls down in your code is when outputting the contents of attributes (an array of classwide pointers to attributes). The approach I'd start with is to override the default 'Output and 'Input for attribute_types.attribute_ptr so that what you write to disk is the thing designated by the pointer, and when you read back you allocate the appropriate memory and return the pointer .. something like return new attribute'class (attribute'class'input (fin)); This would completely remove all the hand-written stuff about outputting and inputting the different attribute records. I noticed when trying with T3 that the file's index (p fin.all in the debugger) was 104 which is not in any sensible position in the file. Something has got confused (I restored the commented-out line in schema_types.loadtable that actually reads attribute info back, no idea if it's getting called ... no, seems not) ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-11 21:31 ` Simon Wright @ 2007-04-12 16:00 ` andrew.carroll 2007-04-12 19:08 ` Simon Wright 0 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-12 16:00 UTC (permalink / raw) On Apr 11, 4:31 pm, Simon Wright <simon.j.wri...@mac.com> wrote: > Looking over your first complete posted code, I see that the procedure > schema_types.createtable has an unusual approach when writing the > schema to the file. This is "fixed" by moving the schema'output to its own file. > Normally you rely on the compiler to support streaming through the > inbuilt 'Output, 'Input, 'Wrtte, 'Read operations. The only place > where this falls down in your code is when outputting the contents of > attributes (an array of classwide pointers to attributes). > > The approach I'd start with is to override the default 'Output and > 'Input for attribute_types.attribute_ptr so that what you write to > disk is the thing designated by the pointer, and when you read back > you allocate the appropriate memory and return the pointer > .. something like > > return new attribute'class (attribute'class'input (fin)); I did something similar, AND IT WORKS!!! FINALLY!!!!!!!!!!!!!!!!!! I did: temp : attribute_array_ptr; ... temp(x) := new attribute'class'(attribute'class'input(stream(fin))); I can also do: attribute'class'output(stream(fout), temp(x).all); and the program is functioning as I had hoped. After reading Simon's post and reading http://www.grammatech.com/rm95html-1.0/rm9x-13-13-02.html it dawned on me that I was just using the attribute'input / attribute'output and not including the 'class part, which is the only way to tell what the actual type is for dispatching. duh! > > This would completely remove all the hand-written stuff about > outputting and inputting the different attribute records. Yep, it did. > I noticed when trying with T3 that the file's index (p fin.all in the > debugger) was 104 which is not in any sensible position in the > file. Something has got confused (I restored the commented-out line in > schema_types.loadtable that actually reads attribute info back, no > idea if it's getting called ... no, seems not) Resolved. <A HUGE SIGH OF RELIEF> ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-12 16:00 ` andrew.carroll @ 2007-04-12 19:08 ` Simon Wright 0 siblings, 0 replies; 46+ messages in thread From: Simon Wright @ 2007-04-12 19:08 UTC (permalink / raw) "andrew.carroll@okstate.edu" <andrew.carroll@okstate.edu> writes: > On Apr 11, 4:31 pm, Simon Wright <simon.j.wri...@mac.com> wrote: [...] >> .. something like >> >> return new attribute'class (attribute'class'input (fin)); > > I did something similar, AND IT WORKS!!! FINALLY!!!!!!!!!!!!!!!!!! > I did: > > temp : attribute_array_ptr; > ... > temp(x) := new attribute'class'(attribute'class'input(stream(fin))); Yes, my mistake -- new attribute'class'(.... ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll ` (2 preceding siblings ...) 2007-04-11 2:49 ` andrew.carroll @ 2007-04-12 13:48 ` andrew.carroll 2007-04-12 15:49 ` Georg Bauhaus 3 siblings, 1 reply; 46+ messages in thread From: andrew.carroll @ 2007-04-12 13:48 UTC (permalink / raw) S.I.T.R.E.P I changed the GPS compiler to Ada95 and fixed any compiler errors. Once I did that (and without using dispatching or abstract types) I was able to get the program _working_, again. I made some other changes to the overall design. The schema type now has it's own file for 'input and 'output so I don't have to read past it in the file that contains the tuples. I implemented accessor methods (set and get) for the attributes of the attribute types and extentions. So I have getValue, setValue... After all that was working I changed the attribute type to be abstract and all it's methods to be abstract and implemented the to_disc procedure again (dispatching for writing to disk). That part worked. After that I tried to implement the from_disc function (dispatching from the disk). Problem with this one is that when I used it, the context of the call is for an attribute type and of course attribute is abstract and therefore cannot be instantiated. Here is a small example: attrib : attribute_ptr; ... attrib.all := from_disc(fin, obj_of_desired_attribute_class.all) but in order to do this, attrib has to be "not null" like the following attrib: attribute_ptr; ... attrib := new attribute; attrib.all := from_disc(fin, obj_of_desired_attribute_class.all) and of course the type attribute is abstract so it cannot be instantiated. So I removed the abstract and implemented the methods for the attribute type. Now I can do: attrib: attribute_ptr; ... attrib := new attribute; attrib.all := from_disc(fin, obj_of_desired_attribute_class.all); but, it only ever dispatches to the from_disc of attribute even though I've supplied an object of booleanattribute or stringattribute or dateattribute or integerattribute as the actual parameter. So now I have some questions: 1. If I have the following function defined for attribute type, and also defined for types extending from attribute type, do they all need to have attribute'class as the return value so that it dispatches based on the actual parameter ONLY? function from_disc(fin :ada.streams.stream_io.file_type; item: attribute) return attribute; function from_disc(fin :ada.streams.stream_io.file_type; item: booleanattribute) return booleanattribute; function from_disc(fin :ada.streams.stream_io.file_type; item: integerattribute) return integerattribute; function from_disc(fin :ada.streams.stream_io.file_type; item: stringattribute) return stringattribute; function from_disc(fin :ada.streams.stream_io.file_type; item: dateattribute) return dateattribute; The reason the program crashes NOW is because when from_disc is called it only ever 'inputs an attribute type. An attribute type is smaller in size than the other attribute extentions. So if the file actually contains a booleanattribute then 'input will not read the full booleanattribute; just the attribute. This means that the fin file pointer is not on end_of_file. So a loop with the following sentinel; not end_of_file(fin), will not break (exit) when it should because fin is not at end_of_file and it will try to read another attribute. Of course for my test cases there is only one attribute in the file but because we are not at end_of_file the program loops and tries to read another attribute. If from_disc were dispatching, then the correct extention of attribute type would be 'input-ed and the fin file pointer would be at end of file, the loop would exit properly and things would be okay. Am I making any sense? Andrew ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2007-04-12 13:48 ` andrew.carroll @ 2007-04-12 15:49 ` Georg Bauhaus 0 siblings, 0 replies; 46+ messages in thread From: Georg Bauhaus @ 2007-04-12 15:49 UTC (permalink / raw) On Thu, 2007-04-12 at 06:48 -0700, andrew.carroll@okstate.edu wrote: > S.I.T.R.E.P > attrib := new attribute; > attrib.all := from_disc(fin, obj_of_desired_attribute_class.all); > > but, it only ever dispatches to the from_disc of attribute even though > I've supplied an object of booleanattribute or stringattribute or > dateattribute or integerattribute as the actual parameter. If the calls look like those above, are you really supplying an object of somethingelseattribute? I think that making the type `attribute' abstract is fine. If attrib is the returned object, it should be allocated as an object of the desired type, not attribute. Also, the concrete object on the left of := must be assignable from the returned object on the right. > 1. If I have the following function defined for attribute type, and > also defined for types extending from attribute type, do they all need > to have attribute'class as the return value so that it dispatches > based on the actual parameter ONLY? If the return type is the same as the parameter type, there should be no problem. OTOH, there is a redundancy, then... ^ permalink raw reply [flat|nested] 46+ messages in thread
* STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW @ 2005-08-05 0:55 Adaddict 2005-08-05 1:21 ` Adaddict 0 siblings, 1 reply; 46+ messages in thread From: Adaddict @ 2005-08-05 0:55 UTC (permalink / raw) Greetings, I'm doing a small program that uses a search function. That search function compares a given string with the strings returned by a second function until that second function can't return another string. During the execution of that search I get that error. Does anyone know what causes it and how could I solve it? P.S: Using GNAT 3.15p on AdaGIDE to develop a Win32 app. ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2005-08-05 0:55 Adaddict @ 2005-08-05 1:21 ` Adaddict 0 siblings, 0 replies; 46+ messages in thread From: Adaddict @ 2005-08-05 1:21 UTC (permalink / raw) Sorry, just after posting this I noticed the other thread about this error. My apologises. ^ permalink raw reply [flat|nested] 46+ messages in thread
[parent not found: <20050709100024.322314C41FD@lovelace.ada-france.org>]
* RE: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW [not found] <20050709100024.322314C41FD@lovelace.ada-france.org> @ 2005-07-09 12:29 ` Robert C. Leif 0 siblings, 0 replies; 46+ messages in thread From: Robert C. Leif @ 2005-07-09 12:29 UTC (permalink / raw) To: comp.lang.ada Marius Amado Alves wrote, "isn't it possible that your program has a logic fault that is exhausting that stack?" Since the original version with 16 bit pixels works and a new version with 16 bit pixels and an access type for the two dimensional array works, the existence of a logic fault that exhausts the stack is highly unlikely. The access type version with 32 bit pixels executes. However, there appears to be a problem with the creation of the normalized images, which have 8 bit pixels. These 8 bit pixel images are critical because the dynamic range of the human eye while looking at an image is of the order of 8 bits. The real problem is that I can not use a standard, simple data-type (a two dimensional array) for my program, which could be eventually used in a medical device. I am presently forced to increase the complexity of my program by the use of access types and consequently have decreased its safety. Hypothetically, if I find a sponsor with adequate funding to commercialize this research technology, the next step would be to use SPARK, which does not include access types. I suspect that there is a reasonable consensus amongst the readers of Comp.Lang.Ada that Ada and SPARK are excellent choices for medical imaging. Therefore, it would be very useful to either create large objects on the stack or have the compiler put them on the heap while maintaining the relatively simple syntax of a two dimensional array type. In short, the compiler should permit me to maintain the abstraction. Obviously under these circumstances, the use of a pragma would be acceptable. Is there anything to be learned from Java technology where it appears that simple data-types are put on the heap? Bob Leif ------------------------------------------------------------------ Date: Sat, 9 Jul 2005 10:27:55 +0100 From: Marius Amado Alves <amado.alves@netcabo.pt> Subject: Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW To: Robert C.Leif <rleif@rleif.com> Cc: "Comp. Lang. Ada" <comp.lang.ada@ada-france.org> Message-ID: <0374b45e755cd2faa7be393083f5d669@netcabo.pt> Content-Type: text/plain; charset=US-ASCII; format=flowed What does this message mean EXCEPTION_STACK_OVERFLOW? If it means overflow of a stack of exceptions, then isn't it possible that your program has a logic fault that is exhausting that stack? ------------------------------ ^ permalink raw reply [flat|nested] 46+ messages in thread
[parent not found: <200507082148.j68LmXhG002695@mail733.megamailservers.com>]
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW [not found] <200507082148.j68LmXhG002695@mail733.megamailservers.com> @ 2005-07-09 9:27 ` Marius Amado Alves 2005-07-09 19:14 ` Duncan Sands 1 sibling, 0 replies; 46+ messages in thread From: Marius Amado Alves @ 2005-07-09 9:27 UTC (permalink / raw) To: Robert C.Leif; +Cc: Comp. Lang. Ada What does this message mean EXCEPTION_STACK_OVERFLOW? If it means overflow of a stack of exceptions, then isn't it possible that your program has a logic fault that is exhausting that stack? ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW [not found] <200507082148.j68LmXhG002695@mail733.megamailservers.com> 2005-07-09 9:27 ` Marius Amado Alves @ 2005-07-09 19:14 ` Duncan Sands 1 sibling, 0 replies; 46+ messages in thread From: Duncan Sands @ 2005-07-09 19:14 UTC (permalink / raw) To: comp.lang.ada, rleif > Even with a 10 megabyte stack, I still get Stack_Overflow. Is this a multithreaded program? D. PS: I've heard it said that the default stack size is rather small on windows, but I'm afraid I don't know how this relates to GNAT/gcc. ^ permalink raw reply [flat|nested] 46+ messages in thread
* STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW
@ 2005-07-08 21:48 Robert C. Leif
2005-07-09 3:52 ` John B. Matthews
` (3 more replies)
0 siblings, 4 replies; 46+ messages in thread
From: Robert C. Leif @ 2005-07-08 21:48 UTC (permalink / raw)
To: Comp. Lang. Ada
I am creating software in Ada to visualize images obtained with a
fluorescence microscope. Unfortunately, when I switch my images from having
16 bit pixels to 32 bit pixels, I raise the exception STORAGE_ERROR :
EXCEPTION_STACK_OVERFLOW.
I am using GNAT 3.15p.
The Users Guide to Windows states: "5.3 Setting Stack Size from gnatlink
It is possible to specify the program stack size from gnatlink. Assuming
that the underlying linker is GNU ld there is two ways to do so:
using -Xlinker linker option
$ gnatlink hello -Xlinker --stack=0x10000,0x1000
This set the stack reserve size to 0x10000 bytes and the stack commit
size to 0x1000 bytes.
using -Wl linker option
$ gnatlink hello -Wl,--stack=0x1000000
This set the stack reserve size to 0x1000000 bytes. Note that with -Wl
option it is not possible to set the stack commit size because the coma is a
separator for this option."
My project file includes:
package Linker is
for Default_Switches ("ada") use ("-g", "-Xlinker
stack=0x10000000,0x10000000");
end Linker;
Even with a 10 megabyte stack, I still get Stack_Overflow.
Any suggestions would be greatly appreciated. I believe that I know how
to put the array on the heap using an access type. However, I greatly
prefer working with objects that are on the stack and omitting pointers from
my code.
Thank you.
Bob Leif
^ permalink raw reply [flat|nested] 46+ messages in thread* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2005-07-08 21:48 Robert C. Leif @ 2005-07-09 3:52 ` John B. Matthews 2005-07-12 0:29 ` jim hopper 2005-07-09 22:55 ` Björn Persson ` (2 subsequent siblings) 3 siblings, 1 reply; 46+ messages in thread From: John B. Matthews @ 2005-07-09 3:52 UTC (permalink / raw) In article <mailman.131.1120859354.17633.comp.lang.ada@ada-france.org>, "Robert C. Leif" <rleif@rleif.com> wrote: > I am creating software in Ada to visualize images obtained with a > fluorescence microscope. Unfortunately, when I switch my images from having > 16 bit pixels to 32 bit pixels, I raise the exception STORAGE_ERROR : > EXCEPTION_STACK_OVERFLOW. > I am using GNAT 3.15p. > The Users Guide to Windows states: "5.3 Setting Stack Size from gnatlink > It is possible to specify the program stack size from gnatlink. Assuming > that the underlying linker is GNU ld there is two ways to do so: > using -Xlinker linker option > $ gnatlink hello -Xlinker --stack=0x10000,0x1000 > This set the stack reserve size to 0x10000 bytes and the stack commit > size to 0x1000 bytes. > using -Wl linker option > $ gnatlink hello -Wl,--stack=0x1000000 > This set the stack reserve size to 0x1000000 bytes. Note that with -Wl > option it is not possible to set the stack commit size because the coma is a > separator for this option." > My project file includes: > > package Linker is > for Default_Switches ("ada") use ("-g", "-Xlinker > stack=0x10000000,0x10000000"); > end Linker; > > Even with a 10 megabyte stack, I still get Stack_Overflow. > Any suggestions would be greatly appreciated. I believe that I know how > to put the array on the heap using an access type. However, I greatly > prefer working with objects that are on the stack and omitting pointers from > my code. > Thank you. > Bob Leif On one particular implementation derived from 3.15 sources, I had to use the linker argument "-Xlstack= 10485760" to get 10 MB. You might look at 'man ld' on your machine to see if there's an alternative. As the requirements changed, I gave up and allocated space on the heap, though. -- John jmatthews at wright dot edu www dot wright dot edu/~john.matthews/ ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2005-07-09 3:52 ` John B. Matthews @ 2005-07-12 0:29 ` jim hopper 0 siblings, 0 replies; 46+ messages in thread From: jim hopper @ 2005-07-12 0:29 UTC (permalink / raw) This probably means you have an Array in your program thats grown to large to be stored as a stack based variable. the right thing to do is to change this so that the variable is a pointer to an array then set the point to "new <ARRAY>". this is pretty much transparent to the rest of your code and it will force the array onto the heap and out of the stack which allows you a MUCH larger data structure. jim In article <nospam-BBEA5F.23520608072005@news-server.woh.rr.com>, John B. Matthews <nospam@nospam.com> wrote: > > I am creating software in Ada to visualize images obtained with a > > fluorescence microscope. Unfortunately, when I switch my images from having > > 16 bit pixels to 32 bit pixels, I raise the exception STORAGE_ERROR : > > EXCEPTION_STACK_OVERFLOW. > > I am using GNAT 3.15p. > > The Users Guide to Windows states: "5.3 Setting Stack Size from gnatlink > > It is possible to specify the program stack size from gnatlink. Assuming > > that the underlying linker is GNU ld there is two ways to do so: > > using -Xlinker linker option > > $ gnatlink hello -Xlinker --stack=0x10000,0x1000 > > This set the stack reserve size to 0x10000 bytes and the stack commit > > size to 0x1000 bytes. > > using -Wl linker option > > $ gnatlink hello -Wl,--stack=0x1000000 > > This set the stack reserve size to 0x1000000 bytes. Note that with -Wl > > option it is not possible to set the stack commit size because the coma is a > > separator for this option." > > My project file includes: > > > > package Linker is > > for Default_Switches ("ada") use ("-g", "-Xlinker > > stack=0x10000000,0x10000000"); > > end Linker; > > > > Even with a 10 megabyte stack, I still get Stack_Overflow. > > Any suggestions would be greatly appreciated. I believe that I know how > > to put the array on the heap using an access type. However, I greatly > > prefer working with objects that are on the stack and omitting pointers from > > my code. > > Thank you. > > Bob Leif ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2005-07-08 21:48 Robert C. Leif 2005-07-09 3:52 ` John B. Matthews @ 2005-07-09 22:55 ` Björn Persson 2005-07-11 10:15 ` Alex R. Mosteo 2005-07-11 20:07 ` Keith Thompson 3 siblings, 0 replies; 46+ messages in thread From: Björn Persson @ 2005-07-09 22:55 UTC (permalink / raw) Robert C. Leif wrote: > $ gnatlink hello -Xlinker --stack=0x10000,0x1000 > for Default_Switches ("ada") use ("-g", "-Xlinker > stack=0x10000000,0x10000000"); I notice the absence of two hyphens. Is that intentional? -- Bj�rn Persson PGP key A88682FD omb jor ers @sv ge. r o.b n.p son eri nu ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2005-07-08 21:48 Robert C. Leif 2005-07-09 3:52 ` John B. Matthews 2005-07-09 22:55 ` Björn Persson @ 2005-07-11 10:15 ` Alex R. Mosteo 2005-07-11 20:07 ` Keith Thompson 3 siblings, 0 replies; 46+ messages in thread From: Alex R. Mosteo @ 2005-07-11 10:15 UTC (permalink / raw) Robert C. Leif wrote: > I am creating software in Ada to visualize images obtained with a > fluorescence microscope. Unfortunately, when I switch my images from having > 16 bit pixels to 32 bit pixels, I raise the exception STORAGE_ERROR : > EXCEPTION_STACK_OVERFLOW. > I am using GNAT 3.15p. > The Users Guide to Windows states: "5.3 Setting Stack Size from gnatlink > It is possible to specify the program stack size from gnatlink. Assuming > that the underlying linker is GNU ld there is two ways to do so: > using -Xlinker linker option > $ gnatlink hello -Xlinker --stack=0x10000,0x1000 > This set the stack reserve size to 0x10000 bytes and the stack commit > size to 0x1000 bytes. > using -Wl linker option > $ gnatlink hello -Wl,--stack=0x1000000 > This set the stack reserve size to 0x1000000 bytes. Note that with -Wl > option it is not possible to set the stack commit size because the coma is a > separator for this option." > My project file includes: > > package Linker is > for Default_Switches ("ada") use ("-g", "-Xlinker > stack=0x10000000,0x10000000"); > end Linker; > > Even with a 10 megabyte stack, I still get Stack_Overflow. > Any suggestions would be greatly appreciated. I believe that I know how > to put the array on the heap using an access type. However, I greatly > prefer working with objects that are on the stack and omitting pointers from > my code. You need to additionally use the pragma Storage_Size (...) in the tasks at risk. If it's the main task, you may need to move everything to a dummy task. I have had success using this format: --Xlinker --stack=4000000,4000000 ^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW 2005-07-08 21:48 Robert C. Leif ` (2 preceding siblings ...) 2005-07-11 10:15 ` Alex R. Mosteo @ 2005-07-11 20:07 ` Keith Thompson 3 siblings, 0 replies; 46+ messages in thread From: Keith Thompson @ 2005-07-11 20:07 UTC (permalink / raw) "Robert C. Leif" <rleif@rleif.com> writes: [...] > Even with a 10 megabyte stack, I still get Stack_Overflow. Unless you're using a very small, very old machine, 10 megabytes is probably a tiny fraction of your total memory. Is there any reason not to try 20 megabytes, or 100? And as Alex R. Mosteo pointed out, you might also have to worry about Storage_Size for tasks. -- Keith Thompson (The_Other_Keith) kst-u@mib.org <http://www.ghoti.net/~kst> San Diego Supercomputer Center <*> <http://users.sdsc.edu/~kst> We must do something. This is something. Therefore, we must do this. ^ permalink raw reply [flat|nested] 46+ messages in thread
end of thread, other threads:[~2007-04-12 19:08 UTC | newest]
Thread overview: 46+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll
2007-04-02 10:10 ` Stephen Leake
2007-04-02 14:11 ` andrew.carroll
2007-04-02 18:43 ` andrew.carroll
2007-04-02 21:48 ` Georg Bauhaus
2007-04-02 21:40 ` andrew.carroll
2007-04-03 10:25 ` Georg Bauhaus
2007-04-03 17:07 ` andrew.carroll
2007-04-03 19:43 ` Simon Wright
2007-04-03 21:32 ` andrew.carroll
2007-04-04 0:49 ` Georg Bauhaus
2007-04-04 0:32 ` andrew.carroll
2007-04-05 18:28 ` Georg Bauhaus
2007-04-09 13:12 ` andrew.carroll
2007-04-09 18:19 ` Georg Bauhaus
2007-04-10 13:22 ` andrew.carroll
2007-04-10 15:07 ` Ludovic Brenta
2007-04-10 20:55 ` andrew.carroll
2007-04-10 22:17 ` Georg Bauhaus
2007-04-10 21:43 ` andrew.carroll
2007-04-12 8:32 ` Ludovic Brenta
2007-04-11 1:55 ` Jeffrey R. Carter
2007-04-11 2:34 ` andrew.carroll
2007-04-05 0:56 ` andrew.carroll
2007-04-02 20:45 ` Simon Wright
2007-04-02 21:47 ` andrew.carroll
2007-04-02 22:05 ` andrew.carroll
2007-04-03 0:09 ` Randy Brukardt
2007-04-11 2:49 ` andrew.carroll
2007-04-11 8:07 ` Georg Bauhaus
2007-04-11 21:31 ` Simon Wright
2007-04-12 16:00 ` andrew.carroll
2007-04-12 19:08 ` Simon Wright
2007-04-12 13:48 ` andrew.carroll
2007-04-12 15:49 ` Georg Bauhaus
-- strict thread matches above, loose matches on Subject: below --
2005-08-05 0:55 Adaddict
2005-08-05 1:21 ` Adaddict
[not found] <20050709100024.322314C41FD@lovelace.ada-france.org>
2005-07-09 12:29 ` Robert C. Leif
[not found] <200507082148.j68LmXhG002695@mail733.megamailservers.com>
2005-07-09 9:27 ` Marius Amado Alves
2005-07-09 19:14 ` Duncan Sands
2005-07-08 21:48 Robert C. Leif
2005-07-09 3:52 ` John B. Matthews
2005-07-12 0:29 ` jim hopper
2005-07-09 22:55 ` Björn Persson
2005-07-11 10:15 ` Alex R. Mosteo
2005-07-11 20:07 ` Keith Thompson
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox