From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.4 required=5.0 tests=BAYES_00,SUBJ_ALL_CAPS autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: 103376,ade59281d0eea302,start X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news1.google.com!postnews.google.com!l77g2000hsb.googlegroups.com!not-for-mail From: "andrew.carroll@okstate.edu" Newsgroups: comp.lang.ada Subject: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW Date: 1 Apr 2007 23:13:08 -0700 Organization: http://groups.google.com Message-ID: <1175494388.509572.267790@l77g2000hsb.googlegroups.com> NNTP-Posting-Host: 74.195.245.232 Mime-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" X-Trace: posting.google.com 1175494390 31414 127.0.0.1 (2 Apr 2007 06:13:10 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Mon, 2 Apr 2007 06:13:10 +0000 (UTC) User-Agent: G2/1.0 X-HTTP-UserAgent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1),gzip(gfe),gzip(gfe) Complaints-To: groups-abuse@google.com Injection-Info: l77g2000hsb.googlegroups.com; posting-host=74.195.245.232; posting-account=Kq9unQ0AAADh_grEViI3JGqegXKDDjxt Xref: g2news1.google.com comp.lang.ada:14720 Date: 2007-04-01T23:13:08-07:00 List-Id: 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));