comp.lang.ada
 help / color / mirror / Atom feed
* 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
       [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] <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

* 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

* 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

* 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

* 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

* 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 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 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 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 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  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 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-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-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  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-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 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 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 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-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-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-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

* 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

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