rpms/ghdl/devel ghdl-svn49.patch,NONE,1.1 ghdl.spec,1.10,1.11

Thomas M. Sailer (sailer) fedora-extras-commits at redhat.com
Thu Mar 16 22:33:48 UTC 2006


Author: sailer

Update of /cvs/extras/rpms/ghdl/devel
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv9314

Modified Files:
	ghdl.spec 
Added Files:
	ghdl-svn49.patch 
Log Message:
update to svn49


ghdl-svn49.patch:

--- NEW FILE ghdl-svn49.patch ---
diff -urN ghdl-0.21/README ghdl-0.22dev/README
--- ghdl-0.21/README	2005-12-18 14:49:00.000000000 +0100
+++ ghdl-0.22dev/README	2006-03-16 20:52:11.000000000 +0100
@@ -27,19 +27,33 @@
 ***************************
 
 Required:
-* the sources of gcc-4.0.2 (at least the core part).
+* the sources of gcc-4.1.0 (at least the core part).
   Note: other versions of gcc sources have not been tested.
 * the Ada95 GNAT compiler (GNAT v3.15p and GNAT GPL 2005 are known to work;
   Ada compilers in most Linux distributions are more or less buggy)
 * GNU/Linux for ix86 (pc systems) (porting is necessary for other systems)
 
 Procedure:
+* Check your Ada compiler.  On some systems (or with some distribution), the
+  GNAT compiler seems broken.  Try this very simple example, using file
+  example.adb
+<<<<<<<<<<<<<<<<<<
+procedure Example is
+begin
+   null;
+end Example;
+<<<<<<<<<<<<<<<<<<
+  Compile with
+  $ gnatmake example
+  It should create an executable, 'example'.
+  If this doesn't work, your GNAT installation is broken.  It may be a PATH
+  problem or something else.
 * untar the gcc tarball
 * untar the ghdl tarball (this sould have been done, since you are reading a
   file from it).
 * move or copy the vhdl directory of ghdl into the gcc subdirectory of
   the gcc distribution.
-  You should have a gcc-4.0.2/gcc/vhdl directory.
+  You should have a gcc-4.1.0/gcc/vhdl directory.
 * configure gcc with the --enable-languages=vhdl option.  You may of course
   add other languages.
   Refer to the gcc installation documentation.
diff -urN ghdl-0.21/vhdl/Make-lang.in ghdl-0.22dev/vhdl/Make-lang.in
--- ghdl-0.21/vhdl/Make-lang.in	2005-12-18 14:48:59.000000000 +0100
+++ ghdl-0.22dev/vhdl/Make-lang.in	2006-03-16 20:52:10.000000000 +0100
@@ -96,22 +96,21 @@
 AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
  -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config \
  -I$(AGCC_GCCSRC_DIR)/libcpp/include
-AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS)
+AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS)
 
 AGCC_LOCAL_OBJS=ortho-lang.o gcc-version.o
 
 AGCC_DEPS := $(AGCC_LOCAL_OBJS)
 AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
 	$(AGCC_GCCOBJ_DIR)/gcc/toplev.o \
-	$(AGCC_GCCOBJ_DIR)/gcc/c-convert.o \
 	$(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \
 	$(AGCC_GCCOBJ_DIR)/libcpp/libcpp.a \
 	$(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
 
-gcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/version.c
+gcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/BASE-VER
 	-$(RM) -f $@
 	echo '#include "version.h"' > $@
-	sed  -n -e '/version_string/ s/";/ (ghdl)";/p' < $< >> $@
+	echo "const char version_string[] = \""`cat $<` "(ghdl)\";" >> $@
 	echo 'const char bug_report_url[] = "<URL:http://gna.org/projects/ghdl>";' >> $@
 
 gcc-version.o: gcc-version.c
diff -urN ghdl-0.21/vhdl/Makefile.in ghdl-0.22dev/vhdl/Makefile.in
--- ghdl-0.21/vhdl/Makefile.in	2005-12-18 14:48:59.000000000 +0100
+++ ghdl-0.22dev/vhdl/Makefile.in	2006-03-16 20:52:10.000000000 +0100
@@ -480,6 +480,7 @@
 
 #GRT_USE_PTHREADS=y
 ifeq ($(GRT_USE_PTHREADS),y)
+ GRT_CFLAGS+=-DUSE_THREADS
  GRT_ADD_OBJS+=grt-cthreads.o
  GRT_EXTRA_LIB+=-lpthread
 endif
@@ -527,7 +528,7 @@
 	$(CC) -c $(GRT_FLAGS) -o $@ $<
 
 linux.o: $(GRTSRCDIR)/config/linux.c
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
+	$(CC) -c $(GRT_FLAGS) $(GRT_CFLAGS) -o $@ $<
 
 win32.o: $(GRTSRCDIR)/config/win32.c
 	$(CC) -c $(GRT_FLAGS) -o $@ $<
diff -urN ghdl-0.21/vhdl/configuration.adb ghdl-0.22dev/vhdl/configuration.adb
--- ghdl-0.21/vhdl/configuration.adb	2005-09-22 23:26:43.000000000 +0200
+++ ghdl-0.22dev/vhdl/configuration.adb	2006-03-16 20:51:10.000000000 +0100
@@ -25,7 +25,7 @@
 package body Configuration is
    procedure Add_Design_Concurrent_Stmts (Parent : Iir);
    procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration);
-   procedure Add_Design_Aspect (Aspect : Iir);
+   procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean);
 
    Current_File_Dependence : Iir_List := Null_Iir_List;
    Current_Configuration : Iir_Configuration_Declaration := Null_Iir;
@@ -53,6 +53,16 @@
          return;
       end if;
 
+      --  May be enabled to debug dependency construction.
+      if False then
+         if From = Null_Iir then
+            Warning_Msg_Elab (Disp_Node (Unit) & " added", Unit);
+         else
+            Warning_Msg_Elab
+              (Disp_Node (Unit) & " added by " & Disp_Node (From), From);
+         end if;
+      end if;
+
       Set_Elab_Flag (Unit, True);
 
       Lib_Unit := Get_Library_Unit (Unit);
@@ -200,7 +210,7 @@
                begin
                   Unit := Get_Instantiated_Unit (Stmt);
                   if Get_Kind (Unit) /= Iir_Kind_Component_Declaration then
-                     Add_Design_Aspect (Unit);
+                     Add_Design_Aspect (Unit, True);
                   end if;
                end;
             when Iir_Kind_Generate_Statement
@@ -216,7 +226,7 @@
       end loop;
    end Add_Design_Concurrent_Stmts;
 
-   procedure Add_Design_Aspect (Aspect : Iir)
+   procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean)
    is
       use Libraries;
 
@@ -231,10 +241,13 @@
       end if;
       case Get_Kind (Aspect) is
          when Iir_Kind_Entity_Aspect_Entity =>
+            --  Add the entity.
             Entity := Get_Entity (Aspect);
-            Entity_Lib := Get_Library_Unit (Entity);
             Add_Design_Unit (Entity, Aspect);
+
+            --  Extract and add the architecture.
             Arch := Get_Architecture (Aspect);
+            Entity_Lib := Get_Library_Unit (Entity);
             if Arch /= Null_Iir then
                case Get_Kind (Arch) is
                   when Iir_Kind_Simple_Name =>
@@ -263,10 +276,15 @@
                Arch := Get_Design_Unit (Arch);
             end if;
             Load_Design_Unit (Arch, Aspect);
-            Config := Get_Default_Configuration_Declaration
-              (Get_Library_Unit (Arch));
-            if Config /= Null_Iir then
-               Add_Design_Unit (Config, Aspect);
+            Add_Design_Unit (Arch, Aspect);
+
+            --  Add the default configuration if required.
+            if Add_Default then
+               Config := Get_Default_Configuration_Declaration
+                 (Get_Library_Unit (Arch));
+               if Config /= Null_Iir then
+                  Add_Design_Unit (Config, Aspect);
+               end if;
             end if;
          when Iir_Kind_Entity_Aspect_Configuration =>
             Add_Design_Unit (Get_Configuration (Aspect), Aspect);
@@ -424,7 +442,9 @@
 
    --  CONF is either a configuration specification or a component
    --   configuration.
-   procedure Add_Design_Binding_Indication (Conf : Iir)
+   --  If ADD_DEFAULT is true, then the default configuration for the design
+   --  binding must be added if required.
+   procedure Add_Design_Binding_Indication (Conf : Iir; Add_Default : Boolean)
    is
       Bind : Iir_Binding_Indication;
       Inst : Iir;
@@ -442,12 +462,13 @@
          return;
       end if;
       Check_Binding_Indication (Conf);
-      Add_Design_Aspect (Get_Entity_Aspect (Bind));
+      Add_Design_Aspect (Get_Entity_Aspect (Bind), Add_Default);
    end Add_Design_Binding_Indication;
 
    procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration)
    is
       Item : Iir;
+      Sub_Config : Iir;
    begin
       if Blk = Null_Iir then
          return;
@@ -456,10 +477,11 @@
       while Item /= Null_Iir loop
          case Get_Kind (Item) is
             when Iir_Kind_Configuration_Specification =>
-               Add_Design_Binding_Indication (Item);
+               Add_Design_Binding_Indication (Item, True);
             when Iir_Kind_Component_Configuration =>
-               Add_Design_Binding_Indication (Item);
-               Add_Design_Block_Configuration (Get_Block_Configuration (Item));
+               Sub_Config := Get_Block_Configuration (Item);
+               Add_Design_Binding_Indication (Item, Sub_Config = Null_Iir);
+               Add_Design_Block_Configuration (Sub_Config);
             when Iir_Kind_Block_Configuration =>
                Add_Design_Block_Configuration (Item);
             when others =>
diff -urN ghdl-0.21/vhdl/errorout.adb ghdl-0.22dev/vhdl/errorout.adb
--- ghdl-0.21/vhdl/errorout.adb	2005-09-22 23:27:25.000000000 +0200
+++ ghdl-0.22dev/vhdl/errorout.adb	2006-03-16 20:51:10.000000000 +0100
@@ -501,7 +501,7 @@
               & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length)
               & ''';
          when Iir_Kind_Entity_Aspect_Entity =>
-            return Disp_Node (Get_Entity (Node))
+            return "aspect " & Disp_Node (Get_Entity (Node))
               & '(' & Iirs_Utils.Image_Identifier (Get_Architecture (Node))
               & ')';
          when Iir_Kind_Entity_Aspect_Configuration =>
diff -urN ghdl-0.21/vhdl/evaluation.adb ghdl-0.22dev/vhdl/evaluation.adb
--- ghdl-0.21/vhdl/evaluation.adb	2005-12-11 16:32:03.000000000 +0100
+++ ghdl-0.22dev/vhdl/evaluation.adb	2006-03-16 20:51:10.000000000 +0100
@@ -836,6 +836,28 @@
       return Build_Simple_Aggregate (Res_List, Orig, Res_Type);
    end Eval_Concatenation;
 
+   function Eval_Array_Equality (Left, Right : Iir) return Boolean
+   is
+      L_List : Iir_List;
+      R_List : Iir_List;
+      N : Natural;
+   begin
+      --  FIXME: the simple aggregates are lost.
+      L_List := Get_Simple_Aggregate_List (Eval_String_Literal (Left));
+      R_List := Get_Simple_Aggregate_List (Eval_String_Literal (Right));
+      N := Get_Nbr_Elements (L_List);
+      if N /= Get_Nbr_Elements (R_List) then
+         return False;
+      end if;
+      for I in 0 .. N - 1 loop
+         --  FIXME: this is wrong: (eg: evaluated lit)
+         if Get_Nth_Element (L_List, I) /= Get_Nth_Element (R_List, I) then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Eval_Array_Equality;
+
    --  ORIG is either a dyadic operator or a function call.
    function Eval_Dyadic_Operator (Orig : Iir; Left, Right : Iir)
      return Iir
@@ -1073,34 +1095,10 @@
               (Get_Fp_Value (Left) / Iir_Fp64 (Get_Value (Right)), Orig);
 
          when Iir_Predefined_Array_Equality =>
-            declare
-               L_List : Iir_List;
-               R_List : Iir_List;
-               R : Boolean;
-               N : Natural;
-            begin
-               --  FIXME: the simple aggregates are lost.
-               L_List :=
-                 Get_Simple_Aggregate_List (Eval_String_Literal (Left));
-               R_List :=
-                 Get_Simple_Aggregate_List (Eval_String_Literal (Right));
-               N := Get_Nbr_Elements (L_List);
-               if N /= Get_Nbr_Elements (R_List) then
-                  R := False;
-               else
-                  R := True;
-                  for I in 0 .. N - 1 loop
-                     --  FIXME: this is wrong: (eg: evaluated lit)
-                     if Get_Nth_Element (L_List, I)
-                       /= Get_Nth_Element (R_List, I)
-                     then
-                        R := False;
-                        exit;
-                     end if;
-                  end loop;
-               end if;
-               return Build_Boolean (R, Orig);
-            end;
+            return Build_Boolean (Eval_Array_Equality (Left, Right), Orig);
+
+         when Iir_Predefined_Array_Inequality =>
+            return Build_Boolean (not Eval_Array_Equality (Left, Right), Orig);
 
          when Iir_Predefined_Array_Sll
            | Iir_Predefined_Array_Srl
@@ -1111,8 +1109,7 @@
             return Eval_Shift_Operator
               (Eval_String_Literal (Left), Right, Orig, Func);
 
-         when Iir_Predefined_Array_Inequality
-           | Iir_Predefined_Array_Less
+         when Iir_Predefined_Array_Less
            | Iir_Predefined_Array_Less_Equal
            | Iir_Predefined_Array_Greater
            | Iir_Predefined_Array_Greater_Equal
diff -urN ghdl-0.21/vhdl/ghdl.texi ghdl-0.22dev/vhdl/ghdl.texi
--- ghdl-0.21/vhdl/ghdl.texi	2005-12-12 03:21:55.000000000 +0100
+++ ghdl-0.22dev/vhdl/ghdl.texi	2006-03-16 20:51:01.000000000 +0100
@@ -4,15 +4,19 @@
 @settitle GHDL guide
 @c %**end of header
 
+ at direntry
+* ghdl: (ghdl).         VHDL compiler.
+ at end direntry
+
 @titlepage
 @title GHDL guide
 @subtitle GHDL, a VHDL compiler
- at subtitle For GHDL version 0.21 (Sokcho edition)
+ at subtitle For GHDL version 0.22 (Sokcho edition)
 @author Tristan Gingold
 @c The following two commands start the copyright page.
 @page
 @vskip 0pt plus 1filll
-Copyright @copyright{} 2002, 2003, 2004, 2005 Tristan Gingold.
+Copyright @copyright{} 2002, 2003, 2004, 2005, 2006 Tristan Gingold.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.1 or
@@ -70,11 +74,11 @@
 @contents
 
 @ifnottex
- at node Top
+ at node Top, Introduction, (dir), (dir)
 @top GHDL guide
 GHDL, a VHDL compiler.
 
-Copyright @copyright{} 2002, 2003, 2004 Tristan Gingold.
+Copyright @copyright{} 2002, 2003, 2004, 2005, 2006 Tristan Gingold.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.1
@@ -90,7 +94,6 @@
 * Flaws and bugs report::       
 * Copyrights::                  
 * Index::                       
-
 @end menu
 
 @end ifnottex
@@ -902,6 +905,9 @@
 messages that report such constructions.  Some warnings are reported only
 during analysis, others during elaboration.
 
+You could disable a warning by using the @option{--warn-no-XXX}
+instead of @option{--warn-XXX}.
+
 @table @code
 @item --warn-reserved
 @cindex @option{--warn-reserved} switch
@@ -1688,6 +1694,7 @@
 * Library database::            
 * VHDL files format::           
 * Top entity::                  
+* Using vendor libraries::      
 * Interfacing to other languages::  
 @end menu
 
@@ -1865,7 +1872,7 @@
 If the type mark is a composite type (record or array), the file is composed
 of a 2 lines signature, followed by a raw stream.
 
- at node Top entity, Interfacing to other languages, VHDL files format, GHDL implementation of VHDL
+ at node Top entity, Using vendor libraries, VHDL files format, GHDL implementation of VHDL
 @comment  node-name,  next,  previous,  up
 @section Top entity
 There are some restrictions on the entity being at the apex of a design
@@ -1879,8 +1886,38 @@
 The ports type must be constrained.
 @end itemize
 
- at node Interfacing to other languages,  , Top entity, GHDL implementation of VHDL
- at comment  node-name,  next,  previous,  up at section Interfacing with other languages
+ at node Using vendor libraries, Interfacing to other languages, Top entity, GHDL implementation of VHDL
+ at comment  node-name,  next,  previous,  up
+ at section Using vendor libraries
+Many vendors libraries have been analyzed with GHDL.  There are
+usually no problems.  Be sure to use the @option{--work=} option.
+However, some problems have been encountered.
+
+GHDL follows the VHDL LRM (the manual which defines VHDL) more
+strictly than other VHDL tools.  You could try to relax the
+restrictions by using the @option{--std=93c}, @option{-fexplicit} and
+ at option{--warn-no-vital-generic}.
+
+Even with these relaxations, some broken libraries may fail.
+
+For example, @code{unisim_VITAL.vhd} from @code{Xilinx} can't be
+compiled because lines such as:
+ at smallexample
+ variable Write_A_Write_B : memory_collision_type := Write_A_Write_B;
+ variable Read_A_Write_B  : memory_collision_type := Read_A_Write_B;
+ at end smallexample
+(there are 6 such lines).
+According to VHDL visibility rules, @samp{Write_A_Write_B} cannot be used
+while it is defined.  This is very logical because it prevents from silly
+declarations such as
+ at smallexample
+  constant k : natural := 2 * k;
+ at end smallexample
+This files must be modified.  Fortunatly, in the example the variables
+are never written.  So it is enough to remove them.
+
+ at node Interfacing to other languages,  , Using vendor libraries, GHDL implementation of VHDL
+ at comment  node-name,  next,  previous,  up
 @section Interfacing to other languages
 @cindex interfacing
 @cindex other languages
@@ -1931,7 +1968,7 @@
 * Linking with foreign object files::  
 * Starting a simulation from a foreign program::  
 * Linking with Ada::            
-* Using GRT from Ada::
+* Using GRT from Ada::          
 @end menu
 
 @node Restrictions on foreign declarations, Linking with foreign object files, Interfacing to other languages, Interfacing to other languages
@@ -2036,7 +2073,7 @@
 $ gnatmake my_prog -largs `ghdl --list-link design`
 @end smallexample
 
- at node Using GRT from Ada, , Linking with Ada, Interfacing to other languages
+ at node Using GRT from Ada,  , Linking with Ada, Interfacing to other languages
 @comment  node-name,  next,  previous,  up
 @subsection Using GRT from Ada
 @quotation Warning
diff -urN ghdl-0.21/vhdl/ghdldrv/ghdlmain.adb ghdl-0.22dev/vhdl/ghdldrv/ghdlmain.adb
--- ghdl-0.21/vhdl/ghdldrv/ghdlmain.adb	2005-12-04 04:51:33.000000000 +0100
+++ ghdl-0.22dev/vhdl/ghdldrv/ghdlmain.adb	2006-03-16 20:51:04.000000000 +0100
@@ -1,5 +1,5 @@
 --  GHDL driver - main part.
---  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--  Copyright (C) 2002, 2003, 2004, 2005, 2006 Tristan Gingold
 --
 --  GHDL is free software; you can redistribute it and/or modify it under
 --  the terms of the GNU General Public License as published by the Free
@@ -225,7 +225,7 @@
       Put_Line ("Written by Tristan Gingold.");
       New_Line;
       --  Display copyright.  Assume 80 cols terminal.
-      Put_Line ("Copyright (C) 2003, 2004, 2005 Tristan Gingold.");
+      Put_Line ("Copyright (C) 2003, 2004, 2005, 2006 Tristan Gingold.");
       Put_Line ("GHDL is free software, covered by the "
                 & "GNU General Public License.  There is NO");
       Put_Line ("warranty; not even for MERCHANTABILITY or"
diff -urN ghdl-0.21/vhdl/grt/config/linux.c ghdl-0.22dev/vhdl/grt/config/linux.c
--- ghdl-0.21/vhdl/grt/config/linux.c	2005-12-12 03:29:26.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/config/linux.c	2006-03-16 20:51:05.000000000 +0100
@@ -189,7 +189,12 @@
 #endif
 
 /* Context for the main stack.  */
-static __thread struct stack_context main_stack_context;
+#ifdef USE_THREADS
+#define THREAD __thread
+#else
+#define THREAD
+#endif
+static THREAD struct stack_context main_stack_context;
 
 extern void grt_set_main_stack (struct stack_context *stack);
 
@@ -280,3 +285,28 @@
   res->cur_length = stack_size;
   return res;
 }
+
+#include <setjmp.h>
+static int run_env_en;
+static jmp_buf run_env;
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (run_env_en)
+    longjmp (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+
+  run_env_en = 1;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+  return res;
+}
+
diff -urN ghdl-0.21/vhdl/grt/config/pthread.c ghdl-0.22dev/vhdl/grt/config/pthread.c
--- ghdl-0.21/vhdl/grt/config/pthread.c	2005-12-12 03:37:47.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/config/pthread.c	2006-03-16 20:51:05.000000000 +0100
@@ -27,7 +27,7 @@
 #include <pthread.h>
 #include <stdlib.h>
 #include <stdio.h>
-
+#include <setjmp.h>
 
 //#define INFO printf
 #define INFO (void)
@@ -41,7 +41,8 @@
 	void*               Arg;            // ARG passed to FUNC
 } Stack_Type_t, *Stack_Type;
 
-Stack_Type_t      main_stack_context;
+static Stack_Type_t      main_stack_context;
+static Stack_Type_t	 *current;
 extern void grt_set_main_stack (Stack_Type_t *stack);
 
 //----------------------------------------------------------------------------
@@ -58,6 +59,8 @@
 	// lock the mutex, as we are currently running
 	pthread_mutex_lock(&(main_stack_context.mutex));
 	
+	current = &main_stack_context;
+
 	grt_set_main_stack (&main_stack_context);
 }
 
@@ -115,6 +118,10 @@
 	return newStack;
 }
 
+static int need_longjmp;
+static int run_env_en;
+static jmp_buf run_env;
+
 //----------------------------------------------------------------------------
 void grt_stack_switch(Stack_Type To, Stack_Type From)
 // Resume stack TO and save the current context to the stack pointed by
@@ -122,7 +129,9 @@
 // => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
 {	INFO("grt_stack_switch\n");
 	INFO("  from 0x%08x to 0x%08x\n", From, To);
-	
+
+	current = To;
+
 	// unlock 'To' mutex. this will make the other thread either
 	// - starts for first time in grt_stack_loop
 	// - resumes at lock below
@@ -132,6 +141,9 @@
 	// as we are running, our mutex is locked and we block here
 	// when stacks are switched, with above unlock, we may proceed
 	pthread_mutex_lock(&(From->mutex));
+
+	if (From == &main_stack_context && need_longjmp != 0)
+	  longjmp (run_env, need_longjmp);
 }
 
 //----------------------------------------------------------------------------
@@ -141,6 +153,35 @@
 {	INFO("grt_stack_delete\n");
 }
 
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (!run_env_en)
+    return;
+
+  if (current != &main_stack_context)
+    {
+      need_longjmp = val;
+      grt_stack_switch (&main_stack_context, current);
+    }
+  else
+    longjmp (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+
+  run_env_en = 1;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+  return res;
+}
+
+
 //----------------------------------------------------------------------------
 
 #ifndef WITH_GNAT_RUN_TIME
diff -urN ghdl-0.21/vhdl/grt/config/win32.c ghdl-0.22dev/vhdl/grt/config/win32.c
--- ghdl-0.21/vhdl/grt/config/win32.c	2005-12-12 03:39:16.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/config/win32.c	2006-03-16 20:51:05.000000000 +0100
@@ -1,5 +1,5 @@
-/*  GRT stack implementation for Win32
-    Copyright (C) 2004, 2005 Felix Bertram.
+/*  GRT stack implementation for Win32 using fibers.
+    Copyright (C) 2005 Tristan Gingold.
 
     GHDL is free software; you can redistribute it and/or modify it under
     the terms of the GNU General Public License as published by the Free
@@ -16,139 +16,120 @@
     Software Foundation, 59 Temple Place - Suite 330, Boston, MA
     02111-1307, USA.
 */
-//-----------------------------------------------------------------------------
-// Project:     GHDL - VHDL Simulator
-// Description: Win32 port of stacks package
-// Note:        Tristan's original i386/Linux used assembly-code 
-//              to manually switch stacks for performance reasons.
-// History:     2004feb09, FB, created.
-//-----------------------------------------------------------------------------
 
 #include <windows.h>
-//#include <pthread.h>
-//#include <stdlib.h>
-//#include <stdio.h>
-
-
-//#define INFO printf
-#define INFO (void)
-
-// GHDL names an endless loop calling FUNC with ARG a 'stack'
-// at a given time, only one stack may be 'executed'
-typedef struct 
-{	HANDLE              thread;         // stack's thread
-	HANDLE              mutex;          // mutex to suspend/resume thread
-	void                (*Func)(void*); // stack's FUNC
-	void*               Arg;            // ARG passed to FUNC
-} Stack_Type_t, *Stack_Type;
+#include <stdio.h>
+#include <setjmp.h>
+#include <assert.h>
 
-Stack_Type_t      main_stack_context;
-extern Stack_Type grt_stack_main_stack;
+struct stack_type
+{
+  LPVOID fiber; //  Win fiber.
+  void (*func)(void *);  // Function
+  void *arg; //  Function argument.
+};
+
+static struct stack_type main_stack_context;
+static struct stack_type *current;
+extern void grt_set_main_stack (struct stack_type *stack);
 
-//------------------------------------------------------------------------------
 void grt_stack_init(void)
-// Initialize the stacks package.
-// This may adjust stack sizes.
-// Must be called after grt.options.decode.
-// => procedure Stack_Init;
-{	INFO("grt_stack_init\n");
-	INFO("  main_stack_context=0x%08x\n", &main_stack_context);
-
-	// create event. reset event, as we are currently running
-	main_stack_context.mutex = CreateEvent(NULL,  // lpsa
-	                                       FALSE, // fManualReset
-	                                       FALSE, // fInitialState
-	                                       NULL); // lpszEventName
-
-	grt_stack_main_stack= &main_stack_context;
-}
-
-//------------------------------------------------------------------------------
-static unsigned long __stdcall grt_stack_loop(void* pv_myStack)
-{
-	Stack_Type myStack= (Stack_Type)pv_myStack;
-
-	INFO("grt_stack_loop\n");
-	
-	INFO("  myStack=0x%08x\n", myStack);
-
-	// block until event becomes set again.
-	// this happens when this stack is enabled for the first time
-	WaitForSingleObject(myStack->mutex, INFINITE);
-	
-	// run stack's function in endless loop
-	while(1)
-	{	INFO("  call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg);
-		myStack->Func(myStack->Arg);
-	}
-	
-	// we never get here...
-	return 0;
-}
-
-//------------------------------------------------------------------------------
-Stack_Type grt_stack_create(void* Func, void* Arg) 
-// Create a new stack, which on first execution will call FUNC with
-// an argument ARG.
-// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
-{  	Stack_Type newStack;
-	DWORD      m_IDThread; // Thread's ID (dummy)
-
-	INFO("grt_stack_create\n");
-	INFO("  call 0x%08x with 0x%08x\n", Func, Arg);
-			
-	newStack= malloc(sizeof(Stack_Type_t));
-	
-	// init function and argument
-	newStack->Func= Func;
-	newStack->Arg=  Arg;
-	
-	// create event. reset event, so that thread will blocked in grt_stack_loop
-	newStack->mutex= CreateEvent(NULL,  // lpsa
-	                             FALSE, // fManualReset
-	                             FALSE, // fInitialState
-	                             NULL); // lpszEventName
-	
-	INFO("  newStack=0x%08x\n", newStack);
-	
-	// create thread, which executes grt_stack_loop
-	newStack->thread= CreateThread(NULL,           // lpsa
-	                               0,              // cbStack
-	                               grt_stack_loop, // lpStartAddr
-	                               newStack,       // lpvThreadParm
-	                               0,              // fdwCreate
-	                               &m_IDThread);   // lpIDThread
-	
-	return newStack;
-}
-
-//------------------------------------------------------------------------------
-void grt_stack_switch(Stack_Type To, Stack_Type From)
-// Resume stack TO and save the current context to the stack pointed by
-// CUR.
-// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
-{	INFO("grt_stack_switch\n");
-	INFO("  from 0x%08x to 0x%08x\n", From, To);
-	
-	// set 'To' event. this will make the other thread either
-	// - start for first time in grt_stack_loop
-	// - resume at WaitForSingleObject below
-	SetEvent(To->mutex);
-		
-	// block until 'From' event becomes set again
-	// as we are running, our event is reset and we block here
-	// when stacks are switched, with above SetEvent, we may proceed
-	WaitForSingleObject(From->mutex, INFINITE);
-}
-
-//------------------------------------------------------------------------------
-void grt_stack_delete(Stack_Type Stack)
-// Delete stack STACK, which must not be currently executed.
-// => procedure Stack_Delete (Stack : Stack_Type);
-{	INFO("grt_stack_delete\n");
+{
+  main_stack_context.fiber = ConvertThreadToFiber (NULL);
+  if (main_stack_context.fiber == NULL)
+    {
+      fprintf (stderr, "convertThreadToFiber failed (err=%lu)\n",
+	       GetLastError ());
+      abort ();
+    }
+  grt_set_main_stack (&main_stack_context);
+  current = &main_stack_context;
+}
+
+static VOID __stdcall
+grt_stack_loop (void *v_stack)
+{
+  struct stack_type *stack = (struct stack_type *)v_stack;
+  while (1)
+    {
+      (*stack->func)(stack->arg);
+    }
+}
+
+struct stack_type *
+grt_stack_create (void (*func)(void *), void *arg) 
+{
+  struct stack_type *res;
+
+  res = malloc (sizeof (struct stack_type));
+  if (res == NULL)
+    return NULL;
+  res->func = func;
+  res->arg = arg;
+  res->fiber = CreateFiber (0, &grt_stack_loop, res);
+  if (res->fiber == NULL)
+    {
+      free (res);
+      return NULL;
+    }
+  return res;
+}
+
+static int run_env_en;
+static jmp_buf run_env;
+static int need_longjmp;
+
+void
+grt_stack_switch (struct stack_type *to, struct stack_type *from)
+{
+  assert (current == from);
+  current = to;
+  SwitchToFiber (to->fiber);
+  if (from == &main_stack_context && need_longjmp)
+    {
+      /* We returned to do the longjump.  */
+      current = &main_stack_context;
+      longjmp (run_env, need_longjmp);
+    }
+}
+
+void
+grt_stack_delete (struct stack_type *stack)
+{
+  DeleteFiber (stack->fiber);
+  stack->fiber = NULL;
+}
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (!run_env_en)
+    return;
+
+  if (current != &main_stack_context)
+    {
+      /* We are allowed to jump only in the same stack.
+	 First switch back to the main thread.  */
+      need_longjmp = val;
+      SwitchToFiber (main_stack_context.fiber);
+    }
+  else
+    longjmp (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+
+  run_env_en = 1;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+  return res;
 }
 
-//----------------------------------------------------------------------------
 #ifndef WITH_GNAT_RUN_TIME
 void __gnat_raise_storage_error(void)
 {
@@ -161,6 +142,3 @@
 }
 #endif
 
-//----------------------------------------------------------------------------
-// end of file
-
diff -urN ghdl-0.21/vhdl/grt/ghwlib.c ghdl-0.22dev/vhdl/grt/ghwlib.c
--- ghdl-0.21/vhdl/grt/ghwlib.c	2005-12-07 06:29:04.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/ghwlib.c	2006-03-16 20:51:05.000000000 +0100
@@ -1214,16 +1214,31 @@
   return 0;
 }
 
+static const char *
+ghw_get_lit (union ghw_type *type, int e)
+{
+  if (e >= type->en.nbr || e < 0)
+    return "??";
+  else
+    return type->en.lits[e];
+}
+
+static void
+ghw_disp_lit (union ghw_type *type, int e)
+{
+  printf ("%s (%d)", ghw_get_lit (type, e), e);
+}
+
 void
 ghw_disp_value (union ghw_val *val, union ghw_type *type)
 {
   switch (ghw_get_base_type (type)->kind)
     {
     case ghdl_rtik_type_b2:
-      printf ("%s (%d)", type->en.lits[val->b2], val->b2);
+      ghw_disp_lit (type, val->b2);
       break;
     case ghdl_rtik_type_e8:
-      printf ("%s (%d)", type->en.lits[val->e8], val->e8);
+      ghw_disp_lit (type, val->e8);
       break;
     case ghdl_rtik_type_i32:
       printf ("%d", val->i32);
@@ -1582,10 +1597,14 @@
 }
 
 void
-ghw_disp_range (union ghw_range *rng)
+ghw_disp_range (union ghw_type *type, union ghw_range *rng)
 {
   switch (rng->kind)
     {
+    case ghdl_rtik_type_e8:
+      printf ("%s %s %s", ghw_get_lit (type, rng->e8.left),
+	      ghw_get_dir (rng->e8.dir), ghw_get_lit (type, rng->e8.right));
+      break;
     case ghdl_rtik_type_i32:
     case ghdl_rtik_type_p32:
       printf ("%d %s %d",
@@ -1657,7 +1676,7 @@
 	printf ("subtype %s is ", s->name);
 	ghw_disp_typename (h, s->base);
 	printf (" range ");
-	ghw_disp_range (s->rng);
+	ghw_disp_range (s->base, s->rng);
 	printf (";\n");
       }
       break;
@@ -1692,7 +1711,7 @@
 	  {
 	    if (i != 0)
 	      printf (", ");
-	    ghw_disp_range (a->rngs[i]);
+	    ghw_disp_range ((union ghw_type *)a->base, a->rngs[i]);
 	  }
 	printf (");\n");
       }
diff -urN ghdl-0.21/vhdl/grt/ghwlib.h ghdl-0.22dev/vhdl/grt/ghwlib.h
--- ghdl-0.21/vhdl/grt/ghwlib.h	2005-12-07 06:27:09.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/ghwlib.h	2006-03-16 20:51:05.000000000 +0100
@@ -390,7 +390,8 @@
 
 const char *ghw_get_dir (int is_downto);
 
-void ghw_disp_range (union ghw_range *rng);
+/* Note: TYPE must be a base type (used only to display literals).  */
+void ghw_disp_range (union ghw_type *type, union ghw_range *rng);
 
 void ghw_disp_type (struct ghw_handler *h, union ghw_type *t);
 
diff -urN ghdl-0.21/vhdl/grt/grt-cbinding.c ghdl-0.22dev/vhdl/grt/grt-cbinding.c
--- ghdl-0.21/vhdl/grt/grt-cbinding.c	2005-12-11 15:03:18.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/grt-cbinding.c	2006-03-16 20:51:05.000000000 +0100
@@ -18,7 +18,6 @@
 */
 #include <stdio.h>
 #include <stdlib.h>
-#include <setjmp.h>
 
 FILE *
 __ghdl_get_stdout (void)
@@ -44,29 +43,6 @@
   fprintf (stream, "%g", val);
 }
 
-static int run_env_en;
-static jmp_buf run_env;
-
-void
-__ghdl_maybe_return_via_longjump (int val)
-{
-  if (run_env_en)
-    longjmp (run_env, val);
-}
-
-int
-__ghdl_run_through_longjump (int (*func)(void))
-{
-  int res;
-
-  run_env_en = 1;
-  res = setjmp (run_env);
-  if (res == 0)
-    res = (*func)();
-  run_env_en = 0;
-  return res;
-}
-
 #if 1
 void
 __gnat_last_chance_handler (void)
diff -urN ghdl-0.21/vhdl/grt/grt-signals.adb ghdl-0.22dev/vhdl/grt/grt-signals.adb
--- ghdl-0.21/vhdl/grt/grt-signals.adb	2005-11-18 03:13:36.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/grt-signals.adb	2006-03-16 20:51:05.000000000 +0100
@@ -1095,15 +1095,6 @@
          when others =>
             Internal_Error ("ghdl_create_signal_attribute");
       end case;
---       Sig_Instance_Name := new Ghdl_Instance_Name_Type'
---         (Kind => Ghdl_Name_Signal,
---          Name => null,
---          Parent => null,
---          Brother => null,
---          Sig_Mode => Mode,
---          Sig_Kind => Kind_Signal_No,
---        Sig_Indexes => (First => Sig_Table.Last + 1, Last => Sig_Table.Last),
---          Sig_Type_Desc => Sig_Type);
       --  Note: bit and boolean are both mode_b2.
       Res := Create_Signal
         (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => True),
diff -urN ghdl-0.21/vhdl/grt/grt-waves.adb ghdl-0.22dev/vhdl/grt/grt-waves.adb
--- ghdl-0.21/vhdl/grt/grt-waves.adb	2005-12-07 05:50:07.000000000 +0100
+++ ghdl-0.22dev/vhdl/grt/grt-waves.adb	2006-03-16 20:51:05.000000000 +0100
@@ -785,6 +785,15 @@
    Nbr_Scope_Signals : Natural := 0;
    Nbr_Dumped_Signals : Natural := 0;
 
+   --  This is only valid during write_hierarchy.
+   function Get_Signal_Number (Sig : Ghdl_Signal_Ptr) return Natural
+   is
+      function To_Integer_Address is new Ada.Unchecked_Conversion
+        (Ghdl_Signal_Ptr, Integer_Address);
+   begin
+      return Natural (To_Integer_Address (Sig.Alink));
+   end Get_Signal_Number;
+
    procedure Write_Signal_Number (Val_Addr : Address;
                                   Val_Name : Vstring;
                                   Val_Type : Ghdl_Rti_Access)
@@ -792,20 +801,28 @@
       pragma Unreferenced (Val_Name);
       pragma Unreferenced (Val_Type);
 
-      function To_Integer_Address is new Ada.Unchecked_Conversion
-        (Ghdl_Signal_Ptr, Integer_Address);
+      Num : Natural;
+
       function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
         (Source => Integer_Address, Target => Ghdl_Signal_Ptr);
       Sig : Ghdl_Signal_Ptr;
    begin
+      --  Convert to signal.
       Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
-      if not Sig.Flags.Is_Dumped then
-         Sig.Flags.Is_Dumped := True;
+
+      --  Get signal number.
+      Num := Get_Signal_Number (Sig);
+
+      --  If the signal number is 0, then assign a valid signal number.
+      if Num = 0 then
          Nbr_Dumped_Signals := Nbr_Dumped_Signals + 1;
-         Sig.Flink := To_Ghdl_Signal_Ptr
+         Sig.Alink := To_Ghdl_Signal_Ptr
            (Integer_Address (Nbr_Dumped_Signals));
+         Num := Nbr_Dumped_Signals;
       end if;
-      Wave_Put_ULEB128 (Ghdl_E32 (To_Integer_Address (Sig.Flink)));
+
+      --  Do the real job: write the signal number.
+      Wave_Put_ULEB128 (Ghdl_E32 (Num));
    end Write_Signal_Number;
 
    procedure Foreach_Scalar_Signal_Number is new
@@ -1370,13 +1387,18 @@
       Table_Initial => 32,
       Table_Increment => 100);
 
+   function Get_Dump_Entry (N : Natural) return Ghdl_Signal_Ptr is
+   begin
+      return Dump_Table.Table (N);
+   end Get_Dump_Entry;
+
    procedure Write_Hierarchy (Root : VhpiHandleT)
    is
       N : Natural;
    begin
-      --  Check Flink is 0.
+      --  Check Alink is 0.
       for I in Sig_Table.First .. Sig_Table.Last loop
-         if Sig_Table.Table (I).Flink /= null then
+         if Sig_Table.Table (I).Alink /= null then
             Internal_Error ("wave.write_hierarchy");
          end if;
       end loop;
@@ -1393,15 +1415,20 @@
       Wave_Put_Byte (0);
 
       Dump_Table.Set_Last (Nbr_Dumped_Signals);
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Dump_Table.Table (I) := null;
+      end loop;
 
       --  Save and clear.
-      N := 0;
       for I in Sig_Table.First .. Sig_Table.Last loop
-         if Sig_Table.Table (I).Flags.Is_Dumped then
-            N := N + 1;
+         N := Get_Signal_Number (Sig_Table.Table (I));
+         if N /= 0 then
+            if Dump_Table.Table (N) /= null then
+               Internal_Error ("wave.write_hierarchy(2)");
+            end if;
             Dump_Table.Table (N) := Sig_Table.Table (I);
+            Sig_Table.Table (I).Alink := null;
          end if;
-         Sig_Table.Table (I).Flink := null;
       end loop;
    end Write_Hierarchy;
 
diff -urN ghdl-0.21/vhdl/ortho-lang.c ghdl-0.22dev/vhdl/ortho-lang.c
--- ghdl-0.21/vhdl/ortho-lang.c	2005-12-10 12:04:40.000000000 +0100
+++ ghdl-0.22dev/vhdl/ortho-lang.c	2006-03-16 20:51:08.000000000 +0100
@@ -18,6 +18,8 @@
 #include "tree-gimple.h"
 #include "function.h"
 #include "cgraph.h"
+#include "target.h"
+#include "convert.h"
 
 const int tree_identifier_size = sizeof (struct tree_identifier);
 
@@ -494,6 +496,89 @@
     }
 }
 
+/* The following function has been copied and modified from c-convert.c.  */
+
+/* Change of width--truncation and extension of integers or reals--
+   is represented with NOP_EXPR.  Proper functioning of many things
+   assumes that no other conversions can be NOP_EXPRs.
+
+   Conversion between integer and pointer is represented with CONVERT_EXPR.
+   Converting integer to real uses FLOAT_EXPR
+   and real to integer uses FIX_TRUNC_EXPR.
+
+   Here is a list of all the functions that assume that widening and
+   narrowing is always done with a NOP_EXPR:
+     In convert.c, convert_to_integer.
+     In c-typeck.c, build_binary_op (boolean ops), and
+	c_common_truthvalue_conversion.
+     In expr.c: expand_expr, for operands of a MULT_EXPR.
+     In fold-const.c: fold.
+     In tree.c: get_narrower and get_unwidened.  */
+
+/* Subroutines of `convert'.  */
+
+
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.  */
+
+tree
+convert (tree type, tree expr)
+{
+  tree e = expr;
+  enum tree_code code = TREE_CODE (type);
+  const char *invalid_conv_diag;
+
+  if (type == error_mark_node
+      || expr == error_mark_node
+      || TREE_TYPE (expr) == error_mark_node)
+    return error_mark_node;
+
+  if ((invalid_conv_diag
+       = targetm.invalid_conversion (TREE_TYPE (expr), type)))
+    {
+      error (invalid_conv_diag);
+      return error_mark_node;
+    }
+
+  if (type == TREE_TYPE (expr))
+    return expr;
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_build1 (NOP_EXPR, type, expr);
+  if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE || code == VOID_TYPE)
+    {
+      abort ();
+      return error_mark_node;
+    }
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == BOOLEAN_TYPE)
+    {
+      tree t = ortho_truthvalue_conversion (expr);
+      if (TREE_CODE (t) == ERROR_MARK)
+	return t;
+
+      /* If it returns a NOP_EXPR, we must fold it here to avoid
+	 infinite recursion between fold () and convert ().  */
+      if (TREE_CODE (t) == NOP_EXPR)
+	return fold_build1 (NOP_EXPR, type, TREE_OPERAND (t, 0));
+      else
+	return fold_build1 (NOP_EXPR, type, t);
+    }
+  if (code == POINTER_TYPE || code == REFERENCE_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+
+  abort ();
+}
+
 /* Return a definition for a builtin function named NAME and whose data type
    is TYPE.  TYPE should be a function type with argument types.
    FUNCTION_CODE tells later passes how to compile calls to this function.
@@ -603,8 +688,6 @@
 #define LANG_HOOKS_POST_OPTIONS ortho_post_options
 #undef LANG_HOOKS_HONOR_READONLY
 #define LANG_HOOKS_HONOR_READONLY true
-#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
-#define LANG_HOOKS_TRUTHVALUE_CONVERSION ortho_truthvalue_conversion
 #undef LANG_HOOKS_MARK_ADDRESSABLE
 #define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
@@ -1234,7 +1317,7 @@
 void
 finish_record_aggr (struct o_record_aggr_list *list, tree *res)
 {
-  *res = build_constructor (list->atype, list->chain.first);
+  *res = build_constructor_from_list (list->atype, list->chain.first);
 }
  
 
@@ -1260,18 +1343,16 @@
 void
 finish_array_aggr (struct o_array_aggr_list *list, tree *res)
 {
-  *res = build_constructor (list->atype, list->chain.first);
+  *res = build_constructor_from_list (list->atype, list->chain.first);
 }
 
 
 tree
 new_union_aggr (tree atype, tree field, tree value)
 {
-  tree el;
   tree res;
 
-  el = build_tree_list (field, value);
-  res = build_constructor (atype, el);
+  res = build_constructor_single (atype, field, value);
   TREE_CONSTANT (res) = 1;
   return res;
 }
diff -urN ghdl-0.21/vhdl/parse.adb ghdl-0.22dev/vhdl/parse.adb
--- ghdl-0.21/vhdl/parse.adb	2005-12-17 07:18:00.000000000 +0100
+++ ghdl-0.22dev/vhdl/parse.adb	2006-03-16 20:51:10.000000000 +0100
@@ -3540,7 +3540,7 @@
       Set_Location (Res);
       Set_Expression (Res, Parse_Expression);
 
-      Expect (Tok_Select, "after expression");
+      Expect (Tok_Select, "'select' expected after expression");
       Scan.Scan;
       if Current_Token = Tok_Left_Paren then
          Target := Parse_Aggregate;
@@ -3556,13 +3556,13 @@
       Build_Init (Last);
       loop
          Wf_Chain := Parse_Waveform;
-         Expect (Tok_When, "after waveform");
+         Expect (Tok_When, "'when' expected after waveform");
          Scan.Scan;
          Assoc := Parse_Choices (Null_Iir);
          Set_Associated (Assoc, Wf_Chain);
          Append_Subchain (Last, Res, Assoc);
          exit when Current_Token = Tok_Semi_Colon;
-         Expect (Tok_Comma, "after choice");
+         Expect (Tok_Comma, "',' (comma) expected after choice");
          Scan.Scan;
       end loop;
       return Res;
diff -urN ghdl-0.21/vhdl/sem_assocs.adb ghdl-0.22dev/vhdl/sem_assocs.adb
--- ghdl-0.21/vhdl/sem_assocs.adb	2005-10-08 14:45:00.000000000 +0200
+++ ghdl-0.22dev/vhdl/sem_assocs.adb	2006-03-16 20:51:10.000000000 +0100
@@ -551,7 +551,7 @@
          exit when Index_Type = Null_Iir;
          Chain := Get_Individual_Association_Chain (Assoc);
          Sem_Choices_Range
-           (Chain, Index_Type, True, Get_Location (Assoc), Low, High);
+           (Chain, Index_Type, False, Get_Location (Assoc), Low, High);
          Set_Individual_Association_Chain (Assoc, Chain);
       end loop;
    end Finish_Individual_Assoc_Array_Subtype;
diff -urN ghdl-0.21/vhdl/sem_expr.adb ghdl-0.22dev/vhdl/sem_expr.adb
--- ghdl-0.21/vhdl/sem_expr.adb	2005-12-17 07:13:37.000000000 +0100
+++ ghdl-0.22dev/vhdl/sem_expr.adb	2006-03-16 20:51:10.000000000 +0100
@@ -2278,6 +2278,7 @@
             Lb := Low;
             Hb := High;
          end if;
+         --  Checks all values between POS and POS_MAX are handled.
          Pos := Eval_Pos (Lb);
          Pos_Max := Eval_Pos (Hb);
          if Pos > Pos_Max then
diff -urN ghdl-0.21/vhdl/sem_names.adb ghdl-0.22dev/vhdl/sem_names.adb
--- ghdl-0.21/vhdl/sem_names.adb	2005-12-11 14:50:31.000000000 +0100
+++ ghdl-0.22dev/vhdl/sem_names.adb	2006-03-16 20:51:10.000000000 +0100
@@ -1974,7 +1974,8 @@
                Error_Msg_Sem ("function name is a procedure", Name);
 
             when Iir_Kind_Process_Statement
-              | Iir_Kind_Component_Declaration =>
+              | Iir_Kind_Component_Declaration
+              | Iir_Kind_Type_Conversion =>
                Error_Msg_Sem
                  (Disp_Node (Prefix) & " cannot be indexed or sliced", Name);
                Res := Null_Iir;
diff -urN ghdl-0.21/vhdl/translation.adb ghdl-0.22dev/vhdl/translation.adb
--- ghdl-0.21/vhdl/translation.adb	2005-12-10 12:11:41.000000000 +0100
+++ ghdl-0.22dev/vhdl/translation.adb	2006-03-16 20:51:05.000000000 +0100
@@ -1,5 +1,5 @@
 --  Iir to ortho translator.
---  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--  Copyright (C) 2002, 2003, 2004, 2005, 2006 Tristan Gingold
 --
 --  GHDL is free software; you can redistribute it and/or modify it under
 --  the terms of the GNU General Public License as published by the Free
@@ -1797,15 +1797,13 @@
 
       --  Check bounds length of L match bounds length of R.
       --  If L_TYPE (resp. R_TYPE) is not a thin array, then L_NODE
-      --    (resp. R_NODE) are not used (and may be o_lnode_null).
+      --    (resp. R_NODE) are not used (and may be Mnode_Null).
       --  If L_TYPE (resp. T_TYPE) is a fat array, then L_NODE (resp. R_NODE)
-      --    must be a variable pointing to the array.
+      --    must designate the array.
       procedure Check_Array_Match (L_Type : Iir;
-                                   L_Node : O_Lnode;
-                                   L_Mode : Object_Kind_Type;
+                                   L_Node : Mnode;
                                    R_Type : Iir;
-                                   R_Node : O_Lnode;
-                                   R_Mode : Object_Kind_Type;
+                                   R_Node : Mnode;
                                    Loc : Iir);
 
       --  Create a subtype range to be stored into the location pointed by
@@ -8412,10 +8410,19 @@
          return True;
       end Need_Range_Check;
 
-      procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir)
+      procedure Check_Range_Low (Value : O_Dnode; Atype : Iir)
       is
          If_Blk : O_If_Block;
       begin
+         Open_Temp;
+         Start_If_Stmt (If_Blk, Not_In_Range (Value, Atype));
+         Chap6.Gen_Bound_Error (Null_Iir);
+         Finish_If_Stmt (If_Blk);
+         Close_Temp;
+      end Check_Range_Low;
+
+      procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir) is
+      begin
          if not Need_Range_Check (Expr, Atype) then
             return;
          end if;
@@ -8428,20 +8435,14 @@
                Chap6.Gen_Bound_Error (Expr);
             end if;
          else
-            Open_Temp;
-            Start_If_Stmt (If_Blk, Not_In_Range (Value, Atype));
-            Chap6.Gen_Bound_Error (Null_Iir);
-            Finish_If_Stmt (If_Blk);
-            Close_Temp;
+            Check_Range_Low (Value, Atype);
          end if;
       end Check_Range;
 
       procedure Check_Array_Match (L_Type : Iir;
-                                   L_Node : O_Lnode;
-                                   L_Mode : Object_Kind_Type;
+                                   L_Node : Mnode;
                                    R_Type : Iir;
-                                   R_Node : O_Lnode;
-                                   R_Mode : Object_Kind_Type;
+                                   R_Node : Mnode;
                                    Loc : Iir)
       is
          L_Tinfo, R_Tinfo : Type_Info_Acc;
@@ -8491,10 +8492,10 @@
                   exit when Index = Null_Iir;
                   Sub_Cond := New_Compare_Op
                     (ON_Neq,
-                     Chap6.Get_Array_Ptr_Bound_Length (L_Node, L_Type,
-                                                       I + 1, L_Mode),
-                     Chap6.Get_Array_Ptr_Bound_Length (R_Node, R_Type,
-                                                       I + 1, R_Mode),
+                     M2E (Range_To_Length
+                          (Get_Array_Range (L_Node, L_Type, I + 1))),
+                     M2E (Range_To_Length
+                          (Get_Array_Range (R_Node, R_Type, I + 1))),
                      Ghdl_Bool_Type);
                   if I = 0 then
                      Cond := Sub_Cond;
@@ -10081,8 +10082,8 @@
                New_Assign_Stmt
                  (Get_Var (Alias_Info.Alias_Var),
                   New_Value (M2Lp (Chap3.Get_Array_Base (Name_Node))));
-               Chap3.Check_Array_Match (Decl_Type, O_Lnode_Null, Kind,
-                                        Name_Type, M2Lp (Name_Node), Kind,
+               Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Kind),
+                                        Name_Type, Name_Node,
                                         Decl);
                Close_Temp;
             when Type_Mode_Scalar =>
@@ -11691,6 +11692,16 @@
                   end;
                end if;
 
+               if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition
+               then
+                  --  Check length matches.
+                  Stabilize (Formal_Node);
+                  Stabilize (Actual_Node);
+                  Chap3.Check_Array_Match (Formal_Type, Formal_Node,
+                                           Actual_Type, Actual_Node,
+                                           Assoc);
+               end if;
+
                Data := (Actual_Node => Actual_Node,
                         Actual_Type => Actual_Type,
                         Mode => Mode,
@@ -14420,8 +14431,8 @@
                   E := Create_Temp_Init
                     (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
                   Chap3.Check_Array_Match
-                    (Target_Type, M2Lp (T), Mode_Value,
-                     Get_Type (Expr), New_Obj (E), Mode_Value,
+                    (Target_Type, T,
+                     Get_Type (Expr), Dp2M (E, T_Info, Mode_Value),
                      Null_Iir);
                   Chap3.Translate_Object_Copy
                     (T, New_Obj_Value (E), Target_Type);
@@ -15169,9 +15180,10 @@
                begin
                   E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value),
                                          Expr);
-                  Chap3.Check_Array_Match (Res_Type, O_Lnode_Null, Mode_Value,
-                                           Expr_Type, New_Obj (E), Mode_Value,
-                                           Loc);
+                  Chap3.Check_Array_Match
+                    (Res_Type, T2M (Res_Type, Mode_Value),
+                     Expr_Type, Dp2M (E, Expr_Info, Mode_Value),
+                     Loc);
                   return New_Convert_Ov
                     (New_Value (Chap3.Get_Array_Ptr_Base_Ptr
                                 (New_Obj (E), Expr_Type, Mode_Value)),
@@ -15199,9 +15211,10 @@
                      Chap3.Get_Array_Bounds_Ptr (O_Lnode_Null, Expr_Type,
                                                  Mode_Value));
                   --  Check array match.
-                  Chap3.Check_Array_Match (Res_Type, New_Obj (Res), Mode_Value,
-                                           Expr_Type, New_Obj (E), Mode_Value,
-                                           Loc);
+                  Chap3.Check_Array_Match
+                    (Res_Type, Dv2M (Res, Res_Info, Mode_Value),
+                     Expr_Type, Dp2M (E, Expr_Info, Mode_Value),
+                     Loc);
                   Close_Temp;
                   return New_Address
                     (New_Obj (Res), Res_Info.Ortho_Ptr_Type (Mode_Value));
@@ -22283,19 +22296,58 @@
 
       function Translate_Val_Attribute (Attr : Iir) return O_Enode
       is
-         T : O_Dnode;
-         Prefix : Iir;
-         Ttype : O_Tnode;
+         Val : O_Enode;
+         Attr_Type : Iir;
+         Res_Var : O_Dnode;
+         Res_Type : O_Tnode;
       begin
-         Prefix := Get_Type (Attr);
-         Ttype := Get_Ortho_Type (Prefix, Mode_Value);
-         T := Create_Temp (Ttype);
-         New_Assign_Stmt
-           (New_Obj (T),
-            New_Convert_Ov (Chap7.Translate_Expression (Get_Parameter (Attr)),
-                            Ttype));
-         Chap3.Check_Range (T, Attr, Get_Type (Get_Prefix (Attr)));
-         return New_Obj_Value (T);
+         Attr_Type := Get_Type (Attr);
+         Res_Type := Get_Ortho_Type (Attr_Type, Mode_Value);
+         Res_Var := Create_Temp (Res_Type);
+         Val := Chap7.Translate_Expression (Get_Parameter (Attr));
+
+         case Get_Kind (Attr_Type) is
+            when Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition =>
+               --  For enumeration, always check the value is in the enum
+               --  range.
+               declare
+                  Val_Type : O_Tnode;
+                  Val_Var : O_Dnode;
+                  If_Blk : O_If_Block;
+               begin
+                  Val_Type := Get_Ortho_Type (Get_Type (Get_Parameter (Attr)),
+                                              Mode_Value);
+                  Val_Var := Create_Temp_Init (Val_Type, Val);
+                  Start_If_Stmt
+                    (If_Blk,
+                     New_Dyadic_Op
+                     (ON_Or,
+                      New_Compare_Op (ON_Lt,
+                                      New_Obj_Value (Val_Var),
+                                      New_Lit (New_Signed_Literal
+                                               (Val_Type, 0)),
+                                      Ghdl_Bool_Type),
+                      New_Compare_Op (ON_Ge,
+                                      New_Obj_Value (Val_Var),
+                                      New_Lit (New_Signed_Literal
+                                               (Val_Type,
+                                                Integer_64
+                                                (Get_Nbr_Elements
+                                                 (Get_Enumeration_Literal_List
+                                                  (Attr_Type))))),
+                                      Ghdl_Bool_Type)));
+                  Chap6.Gen_Bound_Error (Attr);
+                  Finish_If_Stmt (If_Blk);
+                  Val := New_Obj_Value (Val_Var);
+               end;
+            when others =>
+               null;
+         end case;
+
+         New_Assign_Stmt (New_Obj (Res_Var), New_Convert_Ov (Val, Res_Type));
+         Chap3.Check_Range (Res_Var, Attr, Get_Type (Get_Prefix (Attr)));
+         return New_Obj_Value (Res_Var);
       end Translate_Val_Attribute;
 
       function Translate_Pos_Attribute (Attr : Iir; Res_Type : Iir)
diff -urN ghdl-0.21/vhdl/version.ads ghdl-0.22dev/vhdl/version.ads
--- ghdl-0.21/vhdl/version.ads	2005-12-18 14:07:38.000000000 +0100
+++ ghdl-0.22dev/vhdl/version.ads	2006-03-16 20:51:10.000000000 +0100
@@ -1,4 +1,4 @@
 package Version is
    Ghdl_Version : constant String :=
-      "GHDL 0.21 (20051218) [Sokcho edition]";
+      "GHDL 0.22dev (20051220) [Sokcho edition]";
 end Version;


Index: ghdl.spec
===================================================================
RCS file: /cvs/extras/rpms/ghdl/devel/ghdl.spec,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- ghdl.spec	6 Mar 2006 14:50:41 -0000	1.10
+++ ghdl.spec	16 Mar 2006 22:33:48 -0000	1.11
@@ -1,10 +1,10 @@
-%define gccver 4.0.2
+%define gccver 4.1.0
 %define ghdlver 0.21
 
 Summary: A VHDL simulator, using the GCC technology
 Name: ghdl
 Version: 0.22
-Release: 0.40svn.0%{?dist}
+Release: 0.49svn.0%{?dist}
 License: GPL
 Group: Development/Languages
 URL: http://ghdl.free.fr/
@@ -14,7 +14,7 @@
 # ./dist.sh sources
 Source0: http://ghdl.free.fr/ghdl-%{ghdlver}.tar.bz2
 Source1: ftp://gcc.gnu.org/pub/gcc/releases/gcc-%{gccver}/gcc-core-%{gccver}.tar.bz2
-Patch0: ghdl-svn40.patch
+Patch0: ghdl-svn49.patch
 BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
 BuildRequires: gcc-gnat >= 4.0.0-0.40, texinfo
 Requires(post): /sbin/install-info
@@ -215,6 +215,9 @@
 %{_libexecdir}/gcc/
 
 %changelog
+* Thu Mar 16 2006 Thomas Sailer <t.sailer at alumni.ethz.ch> - 0.22-0.49svn.0
+- update to svn49, using gcc 4.1.0
+
 * Mon Mar  6 2006 Thomas Sailer <t.sailer at alumni.ethz.ch> - 0.22-0.40svn.0
 - update to svn40, to fix an array bounds checking bug apparently
   introduced in svn39




More information about the fedora-extras-commits mailing list