rpms/ghdl/devel ghdl-svn50.patch, NONE, 1.1 ghdl.spec, 1.13, 1.14 ghdl-svn38.patch, 1.1, NONE ghdl-svn39.patch, 1.1, NONE ghdl-svn40.patch, 1.1, NONE ghdl-svn49.patch, 1.1, NONE
Thomas M. Sailer (sailer)
fedora-extras-commits at redhat.com
Wed Mar 22 10:56:48 UTC 2006
Author: sailer
Update of /cvs/extras/rpms/ghdl/devel
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv10203
Modified Files:
ghdl.spec
Added Files:
ghdl-svn50.patch
Removed Files:
ghdl-svn38.patch ghdl-svn39.patch ghdl-svn40.patch
ghdl-svn49.patch
Log Message:
update to svn50
ghdl-svn50.patch:
--- NEW FILE ghdl-svn50.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-22 11:15:27.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/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/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/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/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/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-22 11:15:27.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/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-22 11:15:27.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/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-22 11:15:00.000000000 +0100
@@ -18,6 +18,10 @@
#include "tree-gimple.h"
#include "function.h"
#include "cgraph.h"
+#include "target.h"
+#include "convert.h"
+#include "tree-pass.h"
+#include "tree-dump.h"
const int tree_identifier_size = sizeof (struct tree_identifier);
@@ -431,6 +435,7 @@
case COMPONENT_REF:
case ARRAY_REF:
+ case ARRAY_RANGE_REF:
n = TREE_OPERAND (n, 0);
break;
@@ -494,6 +499,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 +691,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 +1320,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 +1346,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;
}
@@ -1298,6 +1382,7 @@
abort ();
ortho_mark_addressable (arr);
+ return build4 (ARRAY_RANGE_REF, res_type, arr, index, NULL_TREE, NULL_TREE);
el_type = TREE_TYPE (TREE_TYPE (arr));
el_ptr_type = build_pointer_type (el_type);
@@ -1371,78 +1456,117 @@
return fold (build1 (NOP_EXPR, rtype, size));
}
-#if 0
-static tree
-ortho_build_addr (tree operand, tree atype)
-{
- tree base = exp;
+/* Convert the array expression EXP to a pointer. */
+static tree array_to_pointer_conversion (tree exp);
- while (handled_component_p (base))
- base = TREE_OPERAND (base, 0);
-
- if (DECL_P (base))
- TREE_ADDRESSABLE (base) = 1;
-
- return build1 (ADDR_EXPR, atype, exp);
-}
-#endif
-
-tree
-new_unchecked_address (tree lvalue, tree atype)
+static tree
+ortho_build_addr (tree lvalue, tree atype)
{
tree res;
if (TREE_CODE (lvalue) == INDIRECT_REF)
{
+ /* ADDR_REF(INDIRECT_REF(x)) -> x. */
res = TREE_OPERAND (lvalue, 0);
}
else
{
- ortho_mark_addressable (lvalue);
-
- if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+ /* &base[off] -> base+off. */
+ if (TREE_CODE (lvalue) == ARRAY_REF
+ || TREE_CODE (lvalue) == ARRAY_RANGE_REF)
{
- tree ptr;
- ptr = build_pointer_type (TREE_TYPE (lvalue));
- res = build1 (ADDR_EXPR, ptr, lvalue);
+ tree base = TREE_OPERAND (lvalue, 0);
+ tree idx = TREE_OPERAND (lvalue, 1);
+ tree offset;
+ tree base_type;
+
+ ortho_mark_addressable (base);
+
+ offset = fold_build2 (MULT_EXPR, TREE_TYPE (idx), idx,
+ array_ref_element_size (lvalue));
+
+ base = array_to_pointer_conversion (base);
+ base_type = TREE_TYPE (base);
+
+ res = build2 (PLUS_EXPR, base_type,
+ base, convert (base_type, offset));
}
else
- res = build1 (ADDR_EXPR, atype, lvalue);
+ {
+ ortho_mark_addressable (lvalue);
+
+ if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+ {
+ tree ptr;
+ ptr = build_pointer_type (TREE_TYPE (lvalue));
+ res = build1 (ADDR_EXPR, ptr, lvalue);
+ }
+ else
+ res = build1 (ADDR_EXPR, atype, lvalue);
+ }
+ res = fold (res);
}
if (TREE_TYPE (res) != atype)
- res = fold (build1 (NOP_EXPR, atype, res));
+ res = fold_build1 (NOP_EXPR, atype, res);
return res;
+}
-#if 0
- /* res = build_addr (lvalue, atype); */
- if (TREE_TYPE (res) != atype)
+/* Convert the array expression EXP to a pointer. */
+static tree
+array_to_pointer_conversion (tree exp)
+{
+ tree type = TREE_TYPE (exp);
+ tree adr;
+ tree restype = TREE_TYPE (type);
+ tree ptrtype;
+
+ gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+
+ /* Create a pointer to elements. */
+ ptrtype = build_pointer_type (restype);
+
+ switch (TREE_CODE (exp))
{
- if (TREE_CODE (TREE_TYPE (res)) != POINTER_TYPE)
- abort ();
- res = build1 (NOP_EXPR, atype, res);
+ case INDIRECT_REF:
+ return convert (ptrtype, TREE_OPERAND (exp, 0));
+
+ case VAR_DECL:
+ /* Convert array to pointer to elements. */
+ adr = build1 (ADDR_EXPR, ptrtype, exp);
+ ortho_mark_addressable (exp);
+ TREE_SIDE_EFFECTS (adr) = 0; /* Default would be, same as EXP. */
+ return adr;
+
+ default:
+ /* Get address. */
+ return ortho_build_addr (exp, ptrtype);
}
- return res;
-#endif
+}
+
+tree
+new_unchecked_address (tree lvalue, tree atype)
+{
+ return ortho_build_addr (lvalue, atype);
}
tree
new_address (tree lvalue, tree atype)
{
- return new_unchecked_address (lvalue, atype);
+ return ortho_build_addr (lvalue, atype);
}
tree
new_global_address (tree lvalue, tree atype)
{
- return new_unchecked_address (lvalue, atype);
+ return ortho_build_addr (lvalue, atype);
}
tree
new_global_unchecked_address (tree lvalue, tree atype)
{
- return new_unchecked_address (lvalue, atype);
+ return ortho_build_addr (lvalue, atype);
}
/* Return a pointer to function FUNC. */
@@ -1748,6 +1872,10 @@
gimplify_function_tree (func);
+ /* Dump the genericized tree IR.
+ Enabled by -fdump-tree-gimple. */
+ dump_function (TDI_generic, func);
+
parent = DECL_CONTEXT (func);
if (parent != NULL)
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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- ghdl.spec 19 Mar 2006 15:13:36 -0000 1.13
+++ ghdl.spec 22 Mar 2006 10:56:48 -0000 1.14
@@ -1,11 +1,12 @@
%define gccver 4.1.0
%define ghdlver 0.21
+%define ghdlsvnver 50
%define DATE 20060304
Summary: A VHDL simulator, using the GCC technology
Name: ghdl
Version: 0.22
-Release: 0.49svn.1%{?dist}
+Release: 0.%{ghdlsvnver}svn.1%{?dist}
License: GPL
Group: Development/Languages
URL: http://ghdl.free.fr/
@@ -28,7 +29,7 @@
Patch11: gcc41-mni.patch
Patch12: gcc41-cfaval.patch
Patch13: gcc41-rh184446.patch
-Patch100: ghdl-svn49.patch
+Patch100: ghdl-svn%{ghdlsvnver}.patch
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
Requires(post): /sbin/install-info
Requires(preun): /sbin/install-info
@@ -84,6 +85,8 @@
Requires: glibc >= 2.3.90-35
%endif
+Requires: ghdl-grt = %{version}-%{release}
+
# Make sure we don't use clashing namespaces
%define _vendor fedora_ghdl
@@ -110,6 +113,15 @@
functions or procedures written in a foreign language, such as C, C++, or
Ada95.
+%package grt
+Summary: GHDL runtime libraries
+Group: System Environment/Libraries
+
+%description grt
+This package contains the runtime libraries needed to link ghdl-compiled
+object files into simulator executables. grt contains the simulator kernel
+that tracks signal updates and schedules processes.
+
%prep
%setup -q -n gcc-%{gccver}-%{DATE} -T -b 0 -a 100
%patch1 -p0 -b .ice-hack~
@@ -297,14 +309,22 @@
%doc ghdl-%{ghdlver}/COPYING
%{_bindir}/ghdl
%{_infodir}/ghdl.info.gz
-# Need to own directory %{_libdir}/gcc even though we only want the
-# %{gcc_target_platform}/%{gccver} subdirectory
-%{_libdir}/gcc/
# Need to own directory %{_libexecdir}/gcc even though we only want the
# %{gcc_target_platform}/%{gccver} subdirectory
%{_libexecdir}/gcc/
+%files grt
+# Need to own directory %{_libdir}/gcc even though we only want the
+# %{gcc_target_platform}/%{gccver} subdirectory
+%{_libdir}/gcc/
+
+
%changelog
+* Wed Mar 22 2006 Thomas Sailer <t.sailer at alumni.ethz.ch> - 0.22-0.50svn.0
+- update to svn50, to fix x86_64 breakage
+- move grt (ghdl runtime library) into separate package, to allow parallel
+ install of i386 and x86_64 grt on x86_64 machines, thus making -m32 work
+
* Sun Mar 19 2006 Thomas Sailer <t.sailer at alumni.ethz.ch> - 0.22-0.49svn.1
- use core gcc as base compiler sources
--- ghdl-svn38.patch DELETED ---
--- ghdl-svn39.patch DELETED ---
--- ghdl-svn40.patch DELETED ---
--- ghdl-svn49.patch DELETED ---
More information about the fedora-extras-commits
mailing list