diff -urN ghdl-0.27/README ghdl-0.28dev/README
--- ghdl-0.27/README 2008-07-01 01:59:59.000000000 +0200
+++ ghdl-0.28dev/README 2008-10-07 10:41:34.000000000 +0200
@@ -4,7 +4,7 @@
Copyright:
**********
-GHDL is copyright (c) 2002, 2003, 2004, 2005, 2006, 2007 Tristan Gingold.
+GHDL is copyright (c) 2002 - 2008 Tristan Gingold.
See the GHDL manual for more details.
This program is free software; you can redistribute it and/or modify
@@ -27,9 +27,9 @@
***************************
Required:
-* the sources of gcc-4.2.4 (at least the core part).
+* the sources of gcc-4.3.1 (at least the core part).
Note: other versions of gcc sources have not been tested.
-* the Ada95 GNAT compiler (GNAT GPL 2005 are known to work;
+* the Ada95 GNAT compiler (GNAT GPL 2008 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)
@@ -53,12 +53,12 @@
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.2.4/gcc/vhdl directory.
+ You should have a gcc-4.3.1/gcc/vhdl directory.
* configure gcc with the --enable-languages=vhdl option. You may of course
add other languages.
Refer to the gcc installation documentation.
* compile gcc.
- 'make CFLAGS="-O"' is OK (gcc 2.8.1 bugs with -O2 on some files).
+ 'make CFLAGS="-O"' is OK
* install gcc. This installs the ghdl driver too.
'make install' is OK.
diff -urN ghdl-0.27/vhdl/back_end.adb ghdl-0.28dev/vhdl/back_end.adb
--- ghdl-0.27/vhdl/back_end.adb 2005-09-22 23:26:01.000000000 +0200
+++ ghdl-0.28dev/vhdl/back_end.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,11 +12,10 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Flags;
-with Types; use Types;
+with Flags; use Flags;
with Iirs_Utils; use Iirs_Utils;
package body Back_End is
@@ -27,11 +26,13 @@
return String
is
begin
- case Flags.Vhdl_Std is
+ case Vhdl_Std is
when Vhdl_87 =>
return Image_Identifier (Library) & "-obj87.cf";
when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 =>
return Image_Identifier (Library) & "-obj93.cf";
+ when Vhdl_08 =>
+ return Image_Identifier (Library) & "-obj08.cf";
end case;
end Default_Library_To_File_Name;
end Back_End;
diff -urN ghdl-0.27/vhdl/back_end.ads ghdl-0.28dev/vhdl/back_end.ads
--- ghdl-0.27/vhdl/back_end.ads 2006-08-16 08:17:07.000000000 +0200
+++ ghdl-0.28dev/vhdl/back_end.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/bug.adb ghdl-0.28dev/vhdl/bug.adb
--- ghdl-0.27/vhdl/bug.adb 2006-08-19 13:56:15.000000000 +0200
+++ ghdl-0.28dev/vhdl/bug.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO; use Ada.Text_IO;
diff -urN ghdl-0.27/vhdl/bug.ads ghdl-0.28dev/vhdl/bug.ads
--- ghdl-0.27/vhdl/bug.ads 2005-10-15 13:34:53.000000000 +0200
+++ ghdl-0.28dev/vhdl/bug.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Exceptions; use Ada.Exceptions;
diff -urN ghdl-0.27/vhdl/canon.adb ghdl-0.28dev/vhdl/canon.adb
--- ghdl-0.27/vhdl/canon.adb 2007-03-21 04:47:14.000000000 +0100
+++ ghdl-0.28dev/vhdl/canon.adb 2008-10-07 10:36:36.000000000 +0200
@@ -1,5 +1,5 @@
-- Canonicalization pass
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+-- Copyright (C) 2002, 2003, 2004, 2005, 2008 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
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Errorout; use Errorout;
@@ -21,9 +21,8 @@
with Name_Table;
with Sem;
with Std_Names;
-with Types; use Types;
with Iir_Chains; use Iir_Chains;
-with Flags;
+with Flags; use Flags;
package body Canon is
-- Canonicalize a list of declarations. LIST can be null.
@@ -239,6 +238,10 @@
--Canon_Extract_Sensitivity
-- (Get_Prefix (Expr), Sensitivity_List, Is_Target);
+ when Iir_Kinds_Scalar_Type_Attribute =>
+ Canon_Extract_Sensitivity
+ (Get_Parameter (Expr), Sensitivity_List, Is_Target);
+
when Iir_Kind_Aggregate =>
declare
Aggr_Type : Iir;
@@ -270,6 +273,226 @@
end case;
end Canon_Extract_Sensitivity;
+ procedure Canon_Extract_Sensitivity_If_Not_Null
+ (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is
+ begin
+ if Expr /= Null_Iir then
+ Canon_Extract_Sensitivity (Expr, Sensitivity_List, Is_Target);
+ end if;
+ end Canon_Extract_Sensitivity_If_Not_Null;
+
+ procedure Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Chain : Iir; List : Iir_List)
+ is
+ Stmt : Iir;
+ begin
+ Stmt := Chain;
+ while Stmt /= Null_Iir loop
+ case Get_Kind (Stmt) is
+ when Iir_Kind_Assertion_Statement =>
+ -- LRM08 11.3
+ -- * For each assertion, report, next, exit or return
+ -- statement, apply the rule of 10.2 to each expression
+ -- in the statement, and construct the union of the
+ -- resulting sets.
+ Canon_Extract_Sensitivity
+ (Get_Assertion_Condition (Stmt), List);
+ Canon_Extract_Sensitivity
+ (Get_Severity_Expression (Stmt), List);
+ Canon_Extract_Sensitivity
+ (Get_Report_Expression (Stmt), List);
+ when Iir_Kind_Report_Statement =>
+ -- LRM08 11.3
+ -- See assertion_statement case.
+ Canon_Extract_Sensitivity
+ (Get_Severity_Expression (Stmt), List);
+ Canon_Extract_Sensitivity
+ (Get_Report_Expression (Stmt), List);
+ when Iir_Kind_Next_Statement
+ | Iir_Kind_Exit_Statement =>
+ -- LRM08 11.3
+ -- See assertion_statement case.
+ Canon_Extract_Sensitivity
+ (Get_Condition (Stmt), List);
+ when Iir_Kind_Return_Statement =>
+ -- LRM08 11.3
+ -- See assertion_statement case.
+ Canon_Extract_Sensitivity_If_Not_Null
+ (Get_Expression (Stmt), List);
+ when Iir_Kind_Variable_Assignment_Statement =>
+ -- LRM08 11.3
+ -- * For each assignment statement, apply the rule of 10.2 to
+ -- each expression occuring in the assignment, including any
+ -- expressions occuring in the index names or slice names in
+ -- the target, and construct the union of the resulting sets.
+ Canon_Extract_Sensitivity (Get_Target (Stmt), List, True);
+ Canon_Extract_Sensitivity (Get_Expression (Stmt), List, False);
+ when Iir_Kind_Signal_Assignment_Statement =>
+ -- LRM08 11.3
+ -- See variable assignment statement case.
+ Canon_Extract_Sensitivity (Get_Target (Stmt), List, True);
+ Canon_Extract_Sensitivity_If_Not_Null
+ (Get_Reject_Time_Expression (Stmt), List);
+ declare
+ We: Iir_Waveform_Element;
+ begin
+ We := Get_Waveform_Chain (Stmt);
+ while We /= Null_Iir loop
+ Canon_Extract_Sensitivity (Get_We_Value (We), List);
+ We := Get_Chain (We);
+ end loop;
+ end;
+ when Iir_Kind_If_Statement =>
+ -- LRM08 11.3
+ -- * For each if statement, apply the rule of 10.2 to the
+ -- condition and apply this rule recursively to each
+ -- sequence of statements within the if statement, and
+ -- construct the union of the resuling sets.
+ declare
+ El1 : Iir := Stmt;
+ Cond : Iir;
+ begin
+ loop
+ Cond := Get_Condition (El1);
+ if Cond /= Null_Iir then
+ Canon_Extract_Sensitivity (Cond, List);
+ end if;
+ Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Get_Sequential_Statement_Chain (El1), List);
+ El1 := Get_Else_Clause (El1);
+ exit when El1 = Null_Iir;
+ end loop;
+ end;
+ when Iir_Kind_Case_Statement =>
+ -- LRM08 11.3
+ -- * For each case statement, apply the rule of 10.2 to the
+ -- expression and apply this rule recursively to each
+ -- sequence of statements within the case statement, and
+ -- construct the union of the resulting sets.
+ Canon_Extract_Sensitivity (Get_Expression (Stmt), List);
+ declare
+ Choice: Iir;
+ begin
+ Choice := Get_Case_Statement_Alternative_Chain (Stmt);
+ while Choice /= Null_Iir loop
+ Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Get_Associated (Choice), List);
+ Choice := Get_Chain (Choice);
+ end loop;
+ end;
+ when Iir_Kind_While_Loop_Statement =>
+ -- LRM08 11.3
+ -- * For each loop statement, apply the rule of 10.2 to each
+ -- expression in the iteration scheme, if present, and apply
+ -- this rule recursively to the sequence of statements within
+ -- the loop statement, and construct the union of the
+ -- resulting sets.
+ Canon_Extract_Sensitivity_If_Not_Null
+ (Get_Condition (Stmt), List);
+ Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Get_Sequential_Statement_Chain (Stmt), List);
+ when Iir_Kind_For_Loop_Statement =>
+ -- LRM08 11.3
+ -- See loop statement case.
+ declare
+ It : constant Iir := Get_Iterator_Scheme (Stmt);
+ It_Type : constant Iir := Get_Type (It);
+ Rng : constant Iir := Get_Range_Constraint (It_Type);
+ begin
+ if Get_Kind (Rng) = Iir_Kind_Range_Expression then
+ Canon_Extract_Sensitivity (Rng, List);
+ end if;
+ end;
+ Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Get_Sequential_Statement_Chain (Stmt), List);
+ when Iir_Kind_Null_Statement =>
+ -- LRM08 11.3
+ -- ?
+ null;
+ when Iir_Kind_Procedure_Call_Statement =>
+ -- LRM08 11.3
+ -- * For each procedure call statement, apply the rule of 10.2
+ -- to each actual designator (other than OPEN) associated
+ -- with each formal parameter of mode IN or INOUT, and
+ -- construct the union of the resulting sets.
+ declare
+ Param : Iir;
+ begin
+ Param := Get_Parameter_Association_Chain
+ (Get_Procedure_Call (Stmt));
+ while Param /= Null_Iir loop
+ if (Get_Kind (Param)
+ = Iir_Kind_Association_Element_By_Expression)
+ and then (Get_Mode (Get_Base_Name (Get_Formal (Param)))
+ /= Iir_Out_Mode)
+ then
+ Canon_Extract_Sensitivity (Get_Actual (Param), List);
+ end if;
+ Param := Get_Chain (Param);
+ end loop;
+ end;
+ when others =>
+ Error_Kind
+ ("canon_extract_sequential_statement_chain_sensitivity",
+ Stmt);
+ end case;
+ Stmt := Get_Chain (Stmt);
+ end loop;
+ end Canon_Extract_Sequential_Statement_Chain_Sensitivity;
+
+ procedure Canon_Extract_Sensitivity_From_Callees
+ (Callees_List : Iir_List; Sensitivity_List : Iir_List)
+ is
+ Callee : Iir;
+ begin
+ -- LRM08 11.3
+ -- Moreover, for each subprogram for which the process is a parent
+ -- (see 4.3), the sensitivity list includes members of the set
+ -- constructed by apply the preceding rule to the statements of the
+ -- subprogram, but excluding the members that denote formal signal
+ -- parameters or members of formal signal parameters of the subprogram
+ -- or any of its parents.
+ if Callees_List = Null_Iir_List then
+ return;
+ end if;
+ for I in Natural loop
+ Callee := Get_Nth_Element (Callees_List, I);
+ exit when Callee = Null_Iir;
+ if not Get_Seen_Flag (Callee) then
+ Set_Seen_Flag (Callee, True);
+ case Get_All_Sensitized_State (Callee) is
+ when Read_Signal =>
+ Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Get_Sequential_Statement_Chain
+ (Get_Subprogram_Body (Callee)),
+ Sensitivity_List);
+ Canon_Extract_Sensitivity_From_Callees
+ (Get_Callees_List (Callee), Sensitivity_List);
+ when No_Signal =>
+ null;
+ when Unknown | Invalid_Signal =>
+ raise Internal_Error;
+ end case;
+ end if;
+ end loop;
+ end Canon_Extract_Sensitivity_From_Callees;
+
+ function Canon_Extract_Process_Sensitivity
+ (Proc : Iir_Sensitized_Process_Statement)
+ return Iir_List
+ is
+ Res : Iir_List;
+ begin
+ Res := Create_Iir_List;
+ Canon_Extract_Sequential_Statement_Chain_Sensitivity
+ (Get_Sequential_Statement_Chain (Proc), Res);
+ Canon_Extract_Sensitivity_From_Callees
+ (Get_Callees_List (Proc), Res);
+ Set_Seen_Flag (Proc, True);
+ Clear_Seen_Flag (Proc);
+ return Res;
+ end Canon_Extract_Process_Sensitivity;
+
-- function Make_Aggregate (Array_Type : Iir_Array_Type_Definition; El : Iir)
-- return Iir_Aggregate
-- is
@@ -855,7 +1078,7 @@
-- be PROC, or an 'if' statement if the assignment is guarded.
-- See LRM93 9.5
procedure Canon_Concurrent_Signal_Assignment
- (Stmt: in out Iir;
+ (Stmt: Iir;
Proc: out Iir_Sensitized_Process_Statement;
Chain : out Iir)
is
@@ -1709,7 +1932,7 @@
end if;
when Iir_Kind_Generate_Statement =>
if False
- and then Flags.Vhdl_Std = Vhdl_87
+ and then Vhdl_Std = Vhdl_87
and then
Get_Kind (Conf) = Iir_Kind_Configuration_Specification
then
diff -urN ghdl-0.27/vhdl/canon.ads ghdl-0.28dev/vhdl/canon.ads
--- ghdl-0.27/vhdl/canon.ads 2005-09-22 23:08:22.000000000 +0200
+++ ghdl-0.28dev/vhdl/canon.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
@@ -58,4 +58,10 @@
-- as indexes of an indexed name) are added.
procedure Canon_Extract_Sensitivity
(Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False);
+
+ -- Compute the sensitivity list of all-sensitized process PROC.
+ -- Used for vhdl 08.
+ function Canon_Extract_Process_Sensitivity
+ (Proc : Iir_Sensitized_Process_Statement)
+ return Iir_List;
end Canon;
diff -urN ghdl-0.27/vhdl/configuration.adb ghdl-0.28dev/vhdl/configuration.adb
--- ghdl-0.27/vhdl/configuration.adb 2006-03-12 05:30:16.000000000 +0100
+++ ghdl-0.28dev/vhdl/configuration.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Libraries;
diff -urN ghdl-0.27/vhdl/configuration.ads ghdl-0.28dev/vhdl/configuration.ads
--- ghdl-0.27/vhdl/configuration.ads 2005-09-22 23:08:36.000000000 +0200
+++ ghdl-0.28dev/vhdl/configuration.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/disp_tree.adb ghdl-0.28dev/vhdl/disp_tree.adb
--- ghdl-0.27/vhdl/disp_tree.adb 2006-08-15 21:47:31.000000000 +0200
+++ ghdl-0.28dev/vhdl/disp_tree.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO; use Ada.Text_IO;
@@ -25,7 +25,7 @@
package body Disp_Tree is
procedure Disp_Tab (Tab: Natural) is
- Blanks : String (1 .. Tab) := (others => ' ');
+ Blanks : constant String (1 .. Tab) := (others => ' ');
begin
Put (Blanks);
end Disp_Tab;
@@ -549,7 +549,7 @@
procedure Disp_Tree (Tree: Iir;
Tab: Natural := 0;
Flat_Decl: Boolean := false) is
- Ntab: Natural := Inc_Tab (Tab);
+ Ntab: constant Natural := Inc_Tab (Tab);
Kind : Iir_Kind;
procedure Header (Str: String; Nl: Boolean := true) is
@@ -1018,7 +1018,8 @@
end if;
Header ("wait_state:", False);
Disp_State (Get_Wait_State (Tree));
-
+ Header ("all_sensitized_state: " & Iir_All_Sensitized'Image
+ (Get_All_Sensitized_State (Tree)));
Header ("subprogram_depth:", False);
Disp_Depth (Get_Subprogram_Depth (Tree));
Header ("subprogram_body:");
@@ -1158,7 +1159,7 @@
Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab);
Header ("base type:");
declare
- Base : Iir := Get_Base_Type (Tree);
+ Base : constant Iir := Get_Base_Type (Tree);
Fl : Boolean;
begin
if Base /= Null_Iir
@@ -1742,6 +1743,10 @@
Disp_Tree_Flat (Get_Prefix (Tree), Ntab);
Header ("type:");
Disp_Tree_Flat (Get_Type (Tree), Ntab);
+ if Kind /= Iir_Kind_Transaction_Attribute then
+ Header ("parameter:");
+ Disp_Tree (Get_Parameter (Tree), Ntab);
+ end if;
Header ("has_active_flag: ", False);
Disp_Flag (Get_Has_Active_Flag (Tree));
when Iir_Kind_Event_Attribute
diff -urN ghdl-0.27/vhdl/disp_tree.ads ghdl-0.28dev/vhdl/disp_tree.ads
--- ghdl-0.27/vhdl/disp_tree.ads 2005-09-22 23:09:11.000000000 +0200
+++ ghdl-0.28dev/vhdl/disp_tree.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/disp_vhdl.adb ghdl-0.28dev/vhdl/disp_vhdl.adb
--- ghdl-0.27/vhdl/disp_vhdl.adb 2007-03-21 04:42:39.000000000 +0100
+++ ghdl-0.28dev/vhdl/disp_vhdl.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
@@ -21,7 +21,6 @@
-- Try to be as pretty as possible, and to keep line numbers and positions
-- of the identifiers.
with Ada.Text_IO; use Ada.Text_IO;
-with Types; use Types;
with Std_Package;
with Flags; use Flags;
with Errorout; use Errorout;
@@ -372,9 +371,7 @@
procedure Disp_Enumeration_Subtype_Definition
(Def: Iir_Enumeration_Subtype_Definition)
is
- Base_Type: Iir;
begin
- Base_Type := Get_Base_Type (Def);
Disp_Resolution_Function (Def);
Put ("range ");
Disp_Range (Def);
@@ -385,11 +382,9 @@
(Def: Iir_Array_Subtype_Definition)
is
Index: Iir;
- A_Type: Iir_Array_Type_Definition;
begin
Disp_Resolution_Function (Def);
- A_Type := Get_Base_Type (Def);
Put ("array (");
for I in Natural loop
Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I);
@@ -893,11 +888,8 @@
Put_Line (";");
end Disp_Object_Declaration;
- procedure Disp_Subprogram_Declaration (Subprg: Iir)
- is
- Indent: Count;
+ procedure Disp_Subprogram_Declaration (Subprg: Iir) is
begin
- Indent := Col;
case Get_Kind (Subprg) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Implicit_Function_Declaration =>
@@ -1507,7 +1499,6 @@
is
El: Iir;
Formal: Iir;
- Indent: Count;
Need_Comma : Boolean;
Conv : Iir;
begin
@@ -1515,7 +1506,6 @@
return;
end if;
Put ("(");
- Indent := Col;
Need_Comma := False;
El := Chain;
@@ -2315,7 +2305,7 @@
procedure Disp_Int64 (Val: Iir_Int64)
is
- Str: String := Iir_Int64'Image (Val);
+ Str: constant String := Iir_Int64'Image (Val);
begin
if Str(Str'First) = ' ' then
Put (Str (Str'First + 1 .. Str'Last));
@@ -2326,7 +2316,7 @@
procedure Disp_Int32 (Val: Iir_Int32)
is
- Str: String := Iir_Int32'Image (Val);
+ Str: constant String := Iir_Int32'Image (Val);
begin
if Str(Str'First) = ' ' then
Put (Str (Str'First + 1 .. Str'Last));
@@ -2337,7 +2327,7 @@
procedure Disp_Fp64 (Val: Iir_Fp64)
is
- Str: String := Iir_Fp64'Image (Val);
+ Str: constant String := Iir_Fp64'Image (Val);
begin
if Str(Str'First) = ' ' then
Put (Str (Str'First + 1 .. Str'Last));
diff -urN ghdl-0.27/vhdl/disp_vhdl.ads ghdl-0.28dev/vhdl/disp_vhdl.ads
--- ghdl-0.27/vhdl/disp_vhdl.ads 2005-09-22 23:09:34.000000000 +0200
+++ ghdl-0.28dev/vhdl/disp_vhdl.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/errorout.adb ghdl-0.28dev/vhdl/errorout.adb
--- ghdl-0.27/vhdl/errorout.adb 2006-06-05 08:55:40.000000000 +0200
+++ ghdl-0.28dev/vhdl/errorout.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,13 +12,11 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO;
with Ada.Command_Line;
-with Types; use Types;
-with Iirs; use Iirs;
with Scan;
with Tokens; use Tokens;
with Name_Table;
@@ -50,8 +48,9 @@
Put_Line (Standard_Error, Str);
end Put_Line;
- procedure Disp_Natural (Val: Natural) is
- Str: String := Natural'Image (Val);
+ procedure Disp_Natural (Val: Natural)
+ is
+ Str: constant String := Natural'Image (Val);
begin
Put (Str(Str'First + 1 .. Str'Last));
end Disp_Natural;
@@ -810,8 +809,8 @@
(Name : Name_Id; Line, Col : Natural; Filename : Boolean)
return String
is
- Line_Str : String := Natural'Image (Line);
- Col_Str : String := Natural'Image (Col);
+ Line_Str : constant String := Natural'Image (Line);
+ Col_Str : constant String := Natural'Image (Col);
begin
if Filename then
return Name_Table.Image (Name)
@@ -861,7 +860,7 @@
function Image (N : Iir_Int64) return String
is
- Res : String := Iir_Int64'Image (N);
+ Res : constant String := Iir_Int64'Image (N);
begin
if Res (1) = ' ' then
return Res (2 .. Res'Last);
@@ -917,7 +916,7 @@
declare
use Name_Table;
- Id : Name_Id := Get_Identifier (Subprg);
+ Id : constant Name_Id := Get_Identifier (Subprg);
begin
Image (Id);
case Id is
diff -urN ghdl-0.27/vhdl/errorout.ads ghdl-0.28dev/vhdl/errorout.ads
--- ghdl-0.27/vhdl/errorout.ads 2005-09-22 23:09:47.000000000 +0200
+++ ghdl-0.28dev/vhdl/errorout.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/evaluation.adb ghdl-0.28dev/vhdl/evaluation.adb
--- ghdl-0.27/vhdl/evaluation.adb 2008-04-07 05:21:05.000000000 +0200
+++ ghdl-0.28dev/vhdl/evaluation.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,16 +12,15 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Types; use Types;
with Errorout; use Errorout;
with Name_Table; use Name_Table;
with Str_Table;
with Iirs_Utils; use Iirs_Utils;
with Std_Package; use Std_Package;
-with Flags;
+with Flags; use Flags;
with Std_Names;
package body Evaluation is
@@ -354,7 +353,6 @@
function Eval_String_Literal (Str : Iir) return Iir
is
- use Name_Table;
Ptr : String_Fat_Acc;
Len : Natural;
begin
@@ -495,8 +493,8 @@
return Iir
is
use Str_Table;
- L_Str : String_Fat_Acc := Get_String_Fat_Acc (Left);
- R_Str : String_Fat_Acc := Get_String_Fat_Acc (Right);
+ L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Left);
+ R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Right);
Len : Natural;
Id : String_Id;
begin
diff -urN ghdl-0.27/vhdl/evaluation.ads ghdl-0.28dev/vhdl/evaluation.ads
--- ghdl-0.27/vhdl/evaluation.ads 2007-03-24 08:30:19.000000000 +0100
+++ ghdl-0.28dev/vhdl/evaluation.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/files_map.adb ghdl-0.28dev/vhdl/files_map.adb
--- ghdl-0.27/vhdl/files_map.adb 2005-09-22 23:27:42.000000000 +0200
+++ ghdl-0.28dev/vhdl/files_map.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Interfaces.C;
@@ -22,7 +22,6 @@
with GNAT.Table;
with GNAT.OS_Lib;
with GNAT.Directory_Operations;
-with System;
with Name_Table; use Name_Table;
with Str_Table;
with Ada.Calendar;
@@ -859,8 +858,8 @@
function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean
is
use Str_Table;
- L_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
- R_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
+ L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+ R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
begin
return L_Str (1 .. Time_Stamp_String'Length)
= R_Str (1 .. Time_Stamp_String'Length);
@@ -869,8 +868,8 @@
function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean
is
use Str_Table;
- L_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
- R_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
+ L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+ R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
begin
return L_Str (1 .. Time_Stamp_String'Length)
> R_Str (1 .. Time_Stamp_String'Length);
diff -urN ghdl-0.27/vhdl/files_map.ads ghdl-0.28dev/vhdl/files_map.ads
--- ghdl-0.27/vhdl/files_map.ads 2005-09-22 23:10:15.000000000 +0200
+++ ghdl-0.28dev/vhdl/files_map.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/flags.adb ghdl-0.28dev/vhdl/flags.adb
--- ghdl-0.27/vhdl/flags.adb 2006-08-18 08:49:46.000000000 +0200
+++ ghdl-0.28dev/vhdl/flags.adb 2008-10-07 10:36:36.000000000 +0200
@@ -1,5 +1,5 @@
--- Command line flags.
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+-- Global flags.
+-- Copyright (C) 2002, 2003, 2004, 2005, 2008 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
@@ -12,209 +12,11 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Ada.Text_IO; use Ada.Text_IO;
-with Name_Table;
-with Libraries;
-with Scan;
-with Back_End; use Back_End;
package body Flags is
- function Option_Warning (Opt: String; Val : Boolean) return Boolean is
- begin
--- if Opt = "undriven" then
--- Warn_Undriven := True;
- if Opt = "library" then
- Warn_Library := Val;
- elsif Opt = "default-binding" then
- Warn_Default_Binding := Val;
- elsif Opt = "binding" then
- Warn_Binding := Val;
- elsif Opt = "reserved" then
- Warn_Reserved_Word := Val;
- elsif Opt = "vital-generic" then
- Warn_Vital_Generic := Val;
- elsif Opt = "delayed-checks" then
- Warn_Delayed_Checks := Val;
- elsif Opt = "body" then
- Warn_Body := Val;
- elsif Opt = "specs" then
- Warn_Specs := Val;
- elsif Opt = "unused" then
- Warn_Unused := Val;
- elsif Opt = "error" then
- Warn_Error := Val;
- else
- return False;
- end if;
- return True;
- end Option_Warning;
-
- function Parse_Option (Opt: String) return Boolean is
- Beg: Integer := Opt'First;
- begin
- if Opt'Length > 5 and then Opt (Beg .. Beg + 5) = "--std=" then
- if Opt'Length = 8 then
- if Opt (Beg + 6 .. Beg + 7) = "87" then
- Vhdl_Std := Vhdl_87;
- elsif Opt (Beg + 6 .. Beg + 7) = "93" then
- Vhdl_Std := Vhdl_93;
- elsif Opt (Beg + 6 .. Beg + 7) = "00" then
- Vhdl_Std := Vhdl_00;
- elsif Opt (Beg + 6 .. Beg + 7) = "02" then
- Vhdl_Std := Vhdl_02;
- else
- return False;
- end if;
- elsif Opt'Length = 9 and then Opt (Beg + 6 .. Beg + 8) = "93c" then
- Vhdl_Std := Vhdl_93c;
- else
- return False;
- end if;
- elsif Opt'Length > 2 and then Opt (Beg .. Beg + 1) = "-P" then
- Libraries.Add_Library_Path (Opt (Beg + 2 .. Opt'Last));
- elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--workdir=" then
- Libraries.Set_Work_Library_Path (Opt (Beg + 10 .. Opt'Last));
- elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--warn-no-" then
- return Option_Warning (Opt (Beg + 10 .. Opt'Last), False);
- elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--warn-" then
- return Option_Warning (Opt (Beg + 7 .. Opt'Last), True);
- elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--work=" then
- declare
- use Name_Table;
- begin
- Name_Length := Opt'Last - (Beg + 7) + 1;
- Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last);
- Scan.Convert_Identifier;
- Libraries.Work_Library_Name := Get_Identifier;
- end;
- elsif Opt = "-C" or else Opt = "--mb-comments" then
- Mb_Comment := True;
- elsif Opt = "--bootstrap" then
- Bootstrap := True;
- elsif Opt = "-fexplicit" then
- Flag_Explicit := True;
- elsif Opt = "--syn-binding" then
- Flag_Syn_Binding := True;
- elsif Opt = "--no-vital-checks" then
- Flag_Vital_Checks := False;
- elsif Opt = "--vital-checks" then
- Flag_Vital_Checks := True;
- elsif Opt = "-dp" then
- Dump_Parse := True;
- elsif Opt = "-ds" then
- Dump_Sem := True;
- elsif Opt = "-dc" then
- Dump_Canon := True;
- elsif Opt = "-da" then
- Dump_Annotate := True;
- elsif Opt = "--dall" then
- Dump_All := True;
- elsif Opt = "-dstats" then
- Dump_Stats := True;
- elsif Opt = "--lall" then
- List_All := True;
- elsif Opt = "-lv" then
- List_Verbose := True;
- elsif Opt = "-ls" then
- List_Sem := True;
- elsif Opt = "-lc" then
- List_Canon := True;
- elsif Opt = "-la" then
- List_Annotate := True;
- elsif Opt = "-v" then
- Verbose := True;
- elsif Opt = "--finteger64" then
- Flag_Integer_64 := True;
- elsif Opt = "--ftime32" then
- Flag_Time_64 := False;
--- elsif Opt'Length > 17
--- and then Opt (Beg .. Beg + 17) = "--time-resolution="
--- then
--- Beg := Beg + 18;
--- if Opt (Beg .. Beg + 1) = "fs" then
--- Time_Resolution := 'f';
--- elsif Opt (Beg .. Beg + 1) = "ps" then
--- Time_Resolution := 'p';
--- elsif Opt (Beg .. Beg + 1) = "ns" then
--- Time_Resolution := 'n';
--- elsif Opt (Beg .. Beg + 1) = "us" then
--- Time_Resolution := 'u';
--- elsif Opt (Beg .. Beg + 1) = "ms" then
--- Time_Resolution := 'm';
--- elsif Opt (Beg .. Beg + 2) = "sec" then
--- Time_Resolution := 's';
--- elsif Opt (Beg .. Beg + 2) = "min" then
--- Time_Resolution := 'M';
--- elsif Opt (Beg .. Beg + 1) = "hr" then
--- Time_Resolution := 'h';
--- else
--- return False;
--- end if;
- elsif Back_End.Parse_Option /= null
- and then Back_End.Parse_Option.all (Opt)
- then
- null;
- else
- return False;
- end if;
- return True;
- end Parse_Option;
-
- -- Disp help about these options.
- procedure Disp_Options_Help
- is
- procedure P (S : String) renames Put_Line;
- begin
- P ("Main options:");
- P (" --work=LIB use LIB as work library");
- P (" --workdir=DIR use DIR for the file library");
- P (" -PPATH add PATH in the library path list");
- P (" --std=87 select vhdl 87 standard");
- P (" --std=93 select vhdl 93 standard");
- P (" --std=93c select vhdl 93 standard and allow 87 syntax");
- P (" --[no-]vital-checks do [not] check VITAL restrictions");
- P ("Warnings:");
--- P (" --warn-undriven disp undriven signals");
- P (" --warn-binding warns for component not bound");
- P (" --warn-reserved warns use of 93 reserved words in vhdl87");
- P (" --warn-library warns for redefinition of a design unit");
- P (" --warn-vital-generic warns of non-vital generic names");
- P (" --warn-delayed-checks warns for checks performed at elaboration");
- P (" --warn-body warns for not necessary package body");
- P (" --warn-specs warns if a all/others spec does not apply");
- P (" --warn-unused warns if a subprogram is never used");
- P (" --warn-error turns warnings into errors");
--- P ("Simulation option:");
--- P (" --time-resolution=UNIT set the resolution of type time");
--- P (" UNIT can be fs, ps, ns, us, ms, sec, min or hr");
--- P (" --assert-level=LEVEL set the level which stop the");
--- P (" simulation. LEVEL is note, warning, error,");
--- P (" failure or none");
- P ("Illegal extensions:");
- P (" -fexplicit give priority to explicitly declared operator");
- P (" -C --mb-comments allow multi-bytes chars in a comment");
- P (" --bootstrap allow --work=std");
- P (" --syn-binding use synthesis default binding rule");
- P ("Compilation list:");
- P (" -ls after semantics");
- P (" -lc after canon");
- P (" -la after annotation");
- P (" --lall -lX options apply to all files");
- P (" -lv verbose list");
- P (" -v disp compilation stages");
- P ("Compilation dump:");
- P (" -dp dump tree after parsing");
- P (" -ds dump tree after semantics");
- P (" -da dump tree after annotate");
- P (" --dall -dX options apply to all files");
- if Back_End.Disp_Option /= null then
- Back_End.Disp_Option.all;
- end if;
- end Disp_Options_Help;
-
procedure Create_Flag_String is
begin
case Vhdl_Std is
@@ -225,6 +27,8 @@
| Vhdl_00
| Vhdl_02 =>
Flag_String (1 .. 2) := "93";
+ when Vhdl_08 =>
+ Flag_String (1 .. 2) := "08";
end case;
if Flag_Integer_64 then
Flag_String (3) := 'I';
diff -urN ghdl-0.27/vhdl/flags.ads ghdl-0.28dev/vhdl/flags.ads
--- ghdl-0.27/vhdl/flags.ads 2006-06-17 02:14:31.000000000 +0200
+++ ghdl-0.28dev/vhdl/flags.ads 2008-10-07 10:36:36.000000000 +0200
@@ -1,5 +1,5 @@
--- Command line flags.
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+-- Global flags.
+-- Copyright (C) 2002, 2003, 2004, 2005, 2008 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
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
@@ -22,20 +22,15 @@
-- Since the names are not prefixed, this package is expected to be with'ed
-- but not to be use'd.
-with Types; use Types;
-
package Flags is
+ -- List of vhdl standards.
+ -- VHDL_93c is vhdl_93 with backward compatibility with 87 (file).
+ type Vhdl_Std_Type is
+ (Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02, Vhdl_08);
+
-- Standard accepted.
Vhdl_Std: Vhdl_Std_Type := Vhdl_93c;
- -- Return true if opt is recognize by flags.
- -- Note: std_names.std_names_initialize and files_map.init_pathes must have
- -- been called before this subprogram.
- function Parse_Option (Opt: String) return Boolean;
-
- -- Disp help about these options.
- procedure Disp_Options_Help;
-
-- Some flags (such as vhdl version) must be the same for every design
-- units of a hierarchy.
-- The Flag_String is a signature of all these flags.
diff -urN ghdl-0.27/vhdl/ghdldrv/ghdldrv.adb ghdl-0.28dev/vhdl/ghdldrv/ghdldrv.adb
--- ghdl-0.27/vhdl/ghdldrv/ghdldrv.adb 2006-08-19 14:19:01.000000000 +0200
+++ ghdl-0.28dev/vhdl/ghdldrv/ghdldrv.adb 2008-10-07 10:36:33.000000000 +0200
@@ -36,6 +36,7 @@
with Ghdlmain; use Ghdlmain;
with Ghdllocal; use Ghdllocal;
with Version;
+with Options;
package body Ghdldrv is
-- Name of the tools used.
@@ -57,9 +58,6 @@
-- "-o" string.
Dash_O : String_Access;
- -- "-S" string.
- Dash_S : String_Access;
-
-- "-quiet" option.
Dash_Quiet : String_Access;
@@ -155,7 +153,8 @@
-- Compile.
declare
P : Natural;
- Nbr_Args : Natural := Last (Compiler_Args) + Options'Length + 4;
+ Nbr_Args : constant Natural :=
+ Last (Compiler_Args) + Options'Length + 4;
Args : Argument_List (1 .. Nbr_Args);
begin
P := 0;
@@ -199,7 +198,7 @@
if Compile_Kind = Compile_Debug then
declare
P : Natural;
- Nbr_Args : Natural := Last (Postproc_Args) + 4;
+ Nbr_Args : constant Natural := Last (Postproc_Args) + 4;
Args : Argument_List (1 .. Nbr_Args);
begin
P := 0;
@@ -229,7 +228,7 @@
elsif not Flag_Asm then
declare
P : Natural;
- Nbr_Args : Natural := Last (Assembler_Args) + 4;
+ Nbr_Args : constant Natural := Last (Assembler_Args) + 4;
Args : Argument_List (1 .. Nbr_Args);
Success : Boolean;
begin
@@ -358,7 +357,6 @@
is
use Files_Map;
- Dir : Name_Id;
Name : Name_Id;
File : Source_File_Entry;
@@ -368,7 +366,6 @@
return False;
end if;
- Dir := Get_Library_Directory (Get_Library (Design_File));
Name := Get_Design_File_Filename (Design_File);
declare
Obj_Pathname : String := Get_Object_Filename (Design_File) & Nul;
@@ -539,7 +536,6 @@
Tool_Not_Found (Linker_Cmd);
end if;
Dash_O := new String'("-o");
- Dash_S := new String'("-S");
Dash_Quiet := new String'("-quiet");
end Locate_Tools;
@@ -596,88 +592,87 @@
Res : out Option_Res)
is
Str : String_Access;
+ Opt : constant String (1 .. Option'Length) := Option;
begin
Res := Option_Bad;
- if Option = "-v" and then Flag_Verbose = False then
+ if Opt = "-v" and then Flag_Verbose = False then
-- Note: this is also decoded for command_lib, but we set
-- Flag_Disp_Commands too.
Flag_Verbose := True;
--Flags.Verbose := True;
Flag_Disp_Commands := True;
Res := Option_Ok;
- elsif Option'Length > 8 and then Option (1 .. 8) = "--GHDL1=" then
- Compiler_Cmd := new String'(Option (9 .. Option'Last));
+ elsif Opt'Length > 8 and then Opt (1 .. 8) = "--GHDL1=" then
+ Compiler_Cmd := new String'(Opt (9 .. Opt'Last));
Res := Option_Ok;
- elsif Option = "-S" then
+ elsif Opt = "-S" then
Flag_Asm := True;
Res := Option_Ok;
- elsif Option = "--post" then
+ elsif Opt = "--post" then
Compile_Kind := Compile_Debug;
Res := Option_Ok;
- elsif Option = "--mcode" then
+ elsif Opt = "--mcode" then
Compile_Kind := Compile_Mcode;
Res := Option_Ok;
- elsif Option = "-o" then
+ elsif Opt = "-o" then
if Arg'Length = 0 then
Res := Option_Arg_Req;
else
Output_File := new String'(Arg);
Res := Option_Arg;
end if;
- elsif Option = "-m32" then
+ elsif Opt = "-m32" then
Add_Argument (Compiler_Args, new String'("-m32"));
Add_Argument (Assembler_Args, new String'("--32"));
Add_Argument (Linker_Args, new String'("-m32"));
- Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
- elsif Option'Length > 4
- and then Option (2) = 'W' and then Option (4) = ','
+ Decode_Option (Command_Lib (Cmd), Opt, Arg, Res);
+ elsif Opt'Length > 4
+ and then Opt (2) = 'W' and then Opt (4) = ','
then
- if Option (3) = 'c' then
- Add_Arguments (Compiler_Args, Option);
- elsif Option (3) = 'a' then
- Add_Arguments (Assembler_Args, Option);
- elsif Option (3) = 'p' then
- Add_Arguments (Postproc_Args, Option);
- elsif Option (3) = 'l' then
- Add_Arguments (Linker_Args, Option);
+ if Opt (3) = 'c' then
+ Add_Arguments (Compiler_Args, Opt);
+ elsif Opt (3) = 'a' then
+ Add_Arguments (Assembler_Args, Opt);
+ elsif Opt (3) = 'p' then
+ Add_Arguments (Postproc_Args, Opt);
+ elsif Opt (3) = 'l' then
+ Add_Arguments (Linker_Args, Opt);
else
Error
- ("unknown tool name in '-W" & Option (3) & ",' option");
+ ("unknown tool name in '-W" & Opt (3) & ",' option");
raise Option_Error;
end if;
Res := Option_Ok;
- elsif Option'Length >= 2 and then Option (2) = 'g' then
+ elsif Opt'Length >= 2 and then Opt (2) = 'g' then
-- Debugging option.
- Str := new String'(Option);
+ Str := new String'(Opt);
Add_Argument (Compiler_Args, Str);
Add_Argument (Linker_Args, Str);
Res := Option_Ok;
- elsif Option = "-Q" then
+ elsif Opt = "-Q" then
Flag_Not_Quiet := True;
Res := Option_Ok;
- elsif Option = "--expect-failure" then
- Add_Argument (Compiler_Args, new String'(Option));
+ elsif Opt = "--expect-failure" then
+ Add_Argument (Compiler_Args, new String'(Opt));
Flag_Expect_Failure := True;
Res := Option_Ok;
- elsif Flags.Parse_Option (Option) then
- Add_Argument (Compiler_Args, new String'(Option));
+ elsif Options.Parse_Option (Opt) then
+ Add_Argument (Compiler_Args, new String'(Opt));
Res := Option_Ok;
- elsif Option'Length >= 2
- and then (Option (2) = 'O' or Option (2) = 'f')
+ elsif Opt'Length >= 2
+ and then (Opt (2) = 'O' or Opt (2) = 'f')
then
-- Optimization option.
-- This is put after Flags.Parse_Option, since it may catch -fxxx
-- options.
- Add_Argument (Compiler_Args, new String'(Option));
+ Add_Argument (Compiler_Args, new String'(Opt));
Res := Option_Ok;
else
- Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+ Decode_Option (Command_Lib (Cmd), Opt, Arg, Res);
end if;
end Decode_Option;
- procedure Disp_Long_Help (Cmd : Command_Comp)
- is
- use Ada.Text_IO;
+ procedure Disp_Long_Help (Cmd : Command_Comp) is
begin
Disp_Long_Help (Command_Lib (Cmd));
Put_Line (" -v Be verbose");
@@ -719,7 +714,6 @@
procedure Perform_Action (Cmd : in out Command_Dispconfig;
Args : Argument_List)
is
- use Ada.Text_IO;
use Libraries;
pragma Unreferenced (Cmd);
begin
@@ -912,7 +906,7 @@
-- call the linker
declare
P : Natural;
- Nbr_Args : Natural := Last (Linker_Args) + Filelist.Last + 4;
+ Nbr_Args : constant Natural := Last (Linker_Args) + Filelist.Last + 4;
Args : Argument_List (1 .. Nbr_Args);
Obj_File : String_Access;
Std_File : String_Access;
@@ -997,6 +991,7 @@
is
pragma Unreferenced (Cmd);
Success : Boolean;
+ pragma Unreferenced (Success);
begin
Set_Elab_Units ("-e", Args);
Setup_Compiler (False);
@@ -1614,7 +1609,7 @@
Put ("GHDLFLAGS=");
for I in 2 .. Argument_Count loop
declare
- Arg : String := Argument (I);
+ Arg : constant String := Argument (I);
begin
if Arg (1) = '-' then
if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=")
diff -urN ghdl-0.27/vhdl/ghdldrv/ghdllocal.adb ghdl-0.28dev/vhdl/ghdldrv/ghdllocal.adb
--- ghdl-0.27/vhdl/ghdldrv/ghdllocal.adb 2006-08-19 14:22:56.000000000 +0200
+++ ghdl-0.28dev/vhdl/ghdldrv/ghdllocal.adb 2008-10-07 10:36:33.000000000 +0200
@@ -16,7 +16,6 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO;
-with Ghdlmain;
with Types; use Types;
with Libraries;
with Std_Package;
@@ -34,13 +33,14 @@
with Files_Map;
with Post_Sems;
with Disp_Tree;
+with Options;
package body Ghdllocal is
-- Version of the IEEE library to use. This just change pathes.
type Ieee_Lib_Kind is (Lib_Standard, Lib_None, Lib_Synopsys, Lib_Mentor);
Flag_Ieee : Ieee_Lib_Kind;
- Flag_Create_Default_Config : Boolean := True;
+ Flag_Create_Default_Config : constant Boolean := True;
-- If TRUE, generate 32bits code on 64bits machines.
Flag_32bit : Boolean := False;
@@ -108,36 +108,37 @@
is
pragma Unreferenced (Cmd);
pragma Unreferenced (Arg);
+ Opt : constant String (1 .. Option'Length) := Option;
begin
Res := Option_Bad;
- if Option = "-v" and then Flag_Verbose = False then
+ if Opt = "-v" and then Flag_Verbose = False then
Flag_Verbose := True;
Res := Option_Ok;
- elsif Option'Length > 9 and then Option (1 .. 9) = "--PREFIX=" then
- Prefix_Path := new String'(Option (10 .. Option'Last));
+ elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then
+ Prefix_Path := new String'(Opt (10 .. Opt'Last));
Res := Option_Ok;
- elsif Option = "--ieee=synopsys" then
+ elsif Opt = "--ieee=synopsys" then
Flag_Ieee := Lib_Synopsys;
Res := Option_Ok;
- elsif Option = "--ieee=mentor" then
+ elsif Opt = "--ieee=mentor" then
Flag_Ieee := Lib_Mentor;
Res := Option_Ok;
- elsif Option = "--ieee=none" then
+ elsif Opt = "--ieee=none" then
Flag_Ieee := Lib_None;
Res := Option_Ok;
- elsif Option = "--ieee=standard" then
+ elsif Opt = "--ieee=standard" then
Flag_Ieee := Lib_Standard;
Res := Option_Ok;
- elsif Option = "-m32" then
+ elsif Opt = "-m32" then
Flag_32bit := True;
Res := Option_Ok;
- elsif Option'Length >= 2
- and then (Option (2) = 'g' or Option (2) = 'O')
+ elsif Opt'Length >= 2
+ and then (Opt (2) = 'g' or Opt (2) = 'O')
then
-- Silently accept -g and -O.
Res := Option_Ok;
else
- if Flags.Parse_Option (Option) then
+ if Options.Parse_Option (Opt) then
Res := Option_Ok;
end if;
end if;
@@ -161,9 +162,11 @@
P (" none: do not use a predefined ieee library");
end Disp_Long_Help;
- function Get_Version_Path return String is
+ function Get_Version_Path return String
+ is
+ use Flags;
begin
- case Flags.Vhdl_Std is
+ case Vhdl_Std is
when Vhdl_87 =>
return "v87";
when Vhdl_93c
@@ -171,6 +174,8 @@
| Vhdl_00
| Vhdl_02 =>
return "v93";
+ when Vhdl_08 =>
+ return "v08";
end case;
end Get_Version_Path;
@@ -326,7 +331,7 @@
function Append_Suffix (File : String; Suffix : String) return String_Access
is
use Name_Table;
- Basename : String := Get_Base_Name (File);
+ Basename : constant String := Get_Base_Name (File);
begin
Image (Libraries.Work_Directory);
Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) :=
@@ -429,7 +434,7 @@
Design_File : Iir_Design_File;
Unit : Iir;
Lib : Iir;
- Flag_Add : Boolean := False;
+ Flag_Add : constant Boolean := False;
begin
Flags.Bootstrap := True;
Libraries.Load_Std_Library;
@@ -646,7 +651,6 @@
procedure Delete (Str : String)
is
- use GNAT.OS_Lib;
use Ada.Text_IO;
Status : Boolean;
begin
@@ -659,7 +663,6 @@
procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List)
is
pragma Unreferenced (Cmd);
- use GNAT.OS_Lib;
use Name_Table;
procedure Delete_Asm_Obj (Str : String) is
@@ -805,6 +808,7 @@
procedure Extract_Library_Clauses (Unit : Iir_Design_Unit)
is
Lib1 : Iir_Library_Declaration;
+ pragma Unreferenced (Lib1);
Ctxt_Item : Iir;
begin
-- Extract library clauses.
@@ -1059,7 +1063,7 @@
if Args'Length >= 2 then
declare
- Sec : String_Access := Args (Next_Arg);
+ Sec : constant String_Access := Args (Next_Arg);
begin
if Sec (Sec'First) /= '-' then
Sec_Name := Convert_Name (Sec);
diff -urN ghdl-0.27/vhdl/ghdldrv/ghdlmain.adb ghdl-0.28dev/vhdl/ghdldrv/ghdlmain.adb
--- ghdl-0.27/vhdl/ghdldrv/ghdlmain.adb 2008-06-11 03:54:15.000000000 +0200
+++ ghdl-0.28dev/vhdl/ghdldrv/ghdlmain.adb 2008-10-07 10:36:33.000000000 +0200
@@ -18,9 +18,8 @@
with Ada.Text_IO;
with Ada.Command_Line;
with Version;
-with Flags;
with Bug;
-with Errorout;
+with Options;
package body Ghdlmain is
procedure Init (Cmd : in out Command_Type)
@@ -184,7 +183,7 @@
Error
("warning: command '--option-help' does not accept any argument");
end if;
- Flags.Disp_Options_Help;
+ Options.Disp_Options_Help;
end Perform_Action;
-- Command Version
@@ -275,7 +274,7 @@
Arg_Index := 2;
while Arg_Index <= Argument_Count loop
declare
- Arg : String := Argument (Arg_Index);
+ Arg : constant String := Argument (Arg_Index);
Res : Option_Res;
begin
if Arg (1) = '-' then
diff -urN ghdl-0.27/vhdl/ghdldrv/ghdlprint.adb ghdl-0.28dev/vhdl/ghdldrv/ghdlprint.adb
--- ghdl-0.27/vhdl/ghdldrv/ghdlprint.adb 2006-08-19 13:55:44.000000000 +0200
+++ ghdl-0.28dev/vhdl/ghdldrv/ghdlprint.adb 2008-10-07 10:36:33.000000000 +0200
@@ -75,6 +75,7 @@
procedure PP_Html_File (File : Source_File_Entry)
is
+ use Flags;
use Scan;
use Tokens;
use Files_Map;
@@ -84,9 +85,6 @@
Buf : File_Buffer_Acc;
Prev_Tok : Token_Type;
- -- True if tokens are between 'end' and ';'
- In_End : Boolean := False;
-
-- Current logical column number. Used to expand TABs.
Col : Natural;
@@ -372,9 +370,7 @@
Disp_Reserved;
when Tok_End =>
Disp_Reserved;
- In_End := True;
when Tok_Semi_Colon =>
- In_End := False;
Disp_Spaces;
Disp_Text;
when Tok_Xnor .. Tok_Ror =>
@@ -944,9 +940,7 @@
end if;
end Decode_Option;
- procedure Disp_Long_Help (Cmd : Command_Html)
- is
- use Ada.Text_IO;
+ procedure Disp_Long_Help (Cmd : Command_Html) is
begin
Disp_Long_Help (Command_Lib (Cmd));
Put_Line ("--format=html2 Use FONT attributes");
@@ -1068,9 +1062,7 @@
end if;
end Decode_Option;
- procedure Disp_Long_Help (Cmd : Command_Xref_Html)
- is
- use Ada.Text_IO;
+ procedure Disp_Long_Help (Cmd : Command_Xref_Html) is
begin
Disp_Long_Help (Command_Html (Cmd));
Put_Line ("-o DIR Put generated files into DIR (def: html/)");
@@ -1115,7 +1107,6 @@
Files : File_Data_Array;
Output : File_Type;
- Prev_Output : File_Access;
begin
Xrefs.Init;
Flags.Flag_Xref := True;
@@ -1220,8 +1211,6 @@
Filexref_Info (Files (I).Fe).Output := Files (I).Output;
end loop;
- Prev_Output := Current_Input;
-
for I in Files'Range loop
if Cmd.Output_Dir /= null then
Create (Output, Out_File,
@@ -1304,7 +1293,7 @@
and then Cmd.Output_Dir /= null
then
declare
- Css_Filename : String :=
+ Css_Filename : constant String :=
Cmd.Output_Dir.all & Directory_Separator & "ghdl.css";
begin
if not Is_Regular_File (Css_Filename & Nul) then
@@ -1427,6 +1416,7 @@
Loc_File : Source_File_Entry;
Loc_Pos : Source_Ptr;
C : Character;
+ Dir : Name_Id;
begin
New_Line;
Cur_Decl := N;
@@ -1435,8 +1425,11 @@
if Loc_File /= Cur_File then
Cur_File := Loc_File;
Put ("XFILE: ");
- Image (Get_Source_File_Directory (Cur_File));
- Put (Name_Buffer (1 .. Name_Length));
+ Dir := Get_Source_File_Directory (Cur_File);
+ if Dir /= Null_Identifier then
+ Image (Dir);
+ Put (Name_Buffer (1 .. Name_Length));
+ end if;
Image (Get_File_Name (Cur_File));
Put (Name_Buffer (1 .. Name_Length));
New_Line;
@@ -1537,8 +1530,6 @@
Emit_Ref (I, 'r');
when Xref_Body =>
Emit_Ref (I, 'b');
- when others =>
- null;
end case;
end if;
end loop;
diff -urN ghdl-0.27/vhdl/grt/grt.adc ghdl-0.28dev/vhdl/grt/grt.adc
--- ghdl-0.27/vhdl/grt/grt.adc 2005-11-08 21:01:08.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt.adc 2008-10-07 10:36:33.000000000 +0200
@@ -28,10 +28,12 @@
-- This files is *not* names gnat.adc, in order to ease the possibility of
-- not using it.
pragma Restrictions (No_Exception_Handlers);
-pragma restrictions (No_Exceptions);
+--pragma restrictions (No_Exceptions);
pragma Restrictions (No_Secondary_Stack);
--pragma Restrictions (No_Elaboration_Code);
pragma Restrictions (No_Io);
+pragma restrictions (no_dependence => Ada.Tags);
+pragma restrictions (no_dependence => GNAT);
pragma Restrictions (Max_Tasks => 0);
pragma Restrictions (No_Implicit_Heap_Allocations);
pragma No_Run_Time;
diff -urN ghdl-0.27/vhdl/grt/grt-astdio.adb ghdl-0.28dev/vhdl/grt/grt-astdio.adb
--- ghdl-0.27/vhdl/grt/grt-astdio.adb 2005-12-11 15:03:37.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-astdio.adb 2008-10-07 10:36:34.000000000 +0200
@@ -21,6 +21,7 @@
procedure Put (Stream : FILEs; Str : String)
is
S : size_t;
+ pragma Unreferenced (S);
begin
S := fwrite (Str'Address, Str'Length, 1, Stream);
end Put;
@@ -28,6 +29,7 @@
procedure Put (Stream : FILEs; C : Character)
is
R : int;
+ pragma Unreferenced (R);
begin
R := fputc (Character'Pos (C), Stream);
end Put;
@@ -36,6 +38,7 @@
is
Len : Natural;
S : size_t;
+ pragma Unreferenced (S);
begin
Len := strlen (Str);
S := fwrite (Str (1)'Address, size_t (Len), 1, Stream);
@@ -49,6 +52,7 @@
procedure Put (Str : String)
is
S : size_t;
+ pragma Unreferenced (S);
begin
S := fwrite (Str'Address, Str'Length, 1, stdout);
end Put;
@@ -56,6 +60,7 @@
procedure Put (C : Character)
is
R : int;
+ pragma Unreferenced (R);
begin
R := fputc (Character'Pos (C), stdout);
end Put;
@@ -64,6 +69,7 @@
is
Len : Natural;
S : size_t;
+ pragma Unreferenced (S);
begin
Len := strlen (Str);
S := fwrite (Str (1)'Address, size_t (Len), 1, stdout);
diff -urN ghdl-0.27/vhdl/grt/grt-avhpi.adb ghdl-0.28dev/vhdl/grt/grt-avhpi.adb
--- ghdl-0.27/vhdl/grt/grt-avhpi.adb 2008-05-25 07:56:02.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-avhpi.adb 2008-10-07 10:36:33.000000000 +0200
@@ -126,9 +126,9 @@
case Res.N_Type.Kind is
when Ghdl_Rtik_Subtype_Array =>
declare
- St : Ghdl_Rtin_Subtype_Array_Acc :=
+ St : constant Ghdl_Rtin_Subtype_Array_Acc :=
To_Ghdl_Rtin_Subtype_Array_Acc (Res.N_Type);
- Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+ Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
begin
Bound_To_Range
@@ -155,6 +155,7 @@
El_Type : Ghdl_Rti_Access;
Off : Ghdl_Index_Type) return Address
is
+ pragma Unreferenced (Ctxt);
Is_Sig : Boolean;
El_Size : Ghdl_Index_Type;
El_Type1 : Ghdl_Rti_Access;
@@ -389,7 +390,6 @@
is
Blk : Ghdl_Rtin_Block_Acc;
Ch : Ghdl_Rti_Access;
- Obj : Ghdl_Rtin_Object_Acc;
begin
Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
@@ -420,7 +420,6 @@
exit when Iterator.It_Cur >= Blk.Nbr_Child;
Ch := Blk.Children (Iterator.It_Cur);
- Obj := To_Ghdl_Rtin_Object_Acc (Ch);
Iterator.It_Cur := Iterator.It_Cur + 1;
@@ -874,11 +873,12 @@
when VhpiSubtypeIndicK =>
if Ref.Atype.Kind = Ghdl_Rtik_Subtype_Array then
declare
- Arr_Subtype : Ghdl_Rtin_Subtype_Array_Acc :=
+ Arr_Subtype : constant Ghdl_Rtin_Subtype_Array_Acc :=
To_Ghdl_Rtin_Subtype_Array_Acc (Ref.Atype);
- Basetype : Ghdl_Rtin_Type_Array_Acc :=
+ Basetype : constant Ghdl_Rtin_Type_Array_Acc :=
Arr_Subtype.Basetype;
- Idx : Ghdl_Index_Type := Ghdl_Index_Type (Index);
+ Idx : constant Ghdl_Index_Type :=
+ Ghdl_Index_Type (Index);
Bounds : Ghdl_Range_Array (0 .. Basetype.Nbr_Dim - 1);
Range_Basetype : Ghdl_Rti_Access;
begin
@@ -961,6 +961,7 @@
case Property is
when VhpiLeftBoundP =>
if Obj.Kind /= VhpiIntRangeK then
+ Res := 0;
Error := AvhpiErrorBadRel;
return;
end if;
@@ -999,6 +1000,7 @@
case Property is
when VhpiIsUpP =>
if Obj.Kind /= VhpiIntRangeK then
+ Res := False;
Error := AvhpiErrorBadRel;
return;
end if;
diff -urN ghdl-0.27/vhdl/grt/grt-c.ads ghdl-0.28dev/vhdl/grt/grt-c.ads
--- ghdl-0.27/vhdl/grt/grt-c.ads 2005-10-06 18:27:10.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-c.ads 2008-10-07 10:36:33.000000000 +0200
@@ -33,4 +33,15 @@
-- Type int. It is an alias on Integer for simplicity.
subtype int is Integer;
+
+ -- Low level memory management.
+ procedure Free (Addr : System.Address);
+ function Malloc (Size : size_t) return System.Address;
+ function Realloc (Ptr : System.Address; Size : size_t)
+ return System.Address;
+
+private
+ pragma Import (C, Free);
+ pragma Import (C, Malloc);
+ pragma Import (C, Realloc);
end Grt.C;
diff -urN ghdl-0.27/vhdl/grt/grt-disp.adb ghdl-0.28dev/vhdl/grt/grt-disp.adb
--- ghdl-0.27/vhdl/grt/grt-disp.adb 2006-09-07 07:08:08.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-disp.adb 2008-10-07 10:36:34.000000000 +0200
@@ -16,8 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
-with Grt.Types; use Grt.Types;
-with Grt.Signals; use Grt.Signals;
+pragma Unreferenced (System.Storage_Elements);
with Grt.Astdio; use Grt.Astdio;
with Grt.Stdio; use Grt.Stdio;
--with Grt.Errors; use Grt.Errors;
diff -urN ghdl-0.27/vhdl/grt/grt-disp_rti.adb ghdl-0.28dev/vhdl/grt/grt-disp_rti.adb
--- ghdl-0.27/vhdl/grt/grt-disp_rti.adb 2006-05-29 21:36:38.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-disp_rti.adb 2008-10-07 10:36:33.000000000 +0200
@@ -17,7 +17,6 @@
-- 02111-1307, USA.
with Grt.Astdio; use Grt.Astdio;
with Grt.Errors; use Grt.Errors;
-with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Hooks; use Grt.Hooks;
package body Grt.Disp_Rti is
@@ -153,7 +152,7 @@
Vals : Ghdl_Uc_Array_Acc;
Is_Sig : Boolean)
is
- Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim;
+ Nbr_Dim : constant Ghdl_Index_Type := Rti.Nbr_Dim;
Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
Obj : Address;
begin
@@ -166,7 +165,7 @@
procedure Disp_Record_Value (Stream : FILEs;
Rti : Ghdl_Rtin_Type_Record_Acc;
Ctxt : Rti_Context;
- Obj : in out Address;
+ Obj : Address;
Is_Sig : Boolean)
is
El : Ghdl_Rtin_Element_Acc;
@@ -214,9 +213,9 @@
To_Ghdl_Uc_Array_Acc (Obj), Is_Sig);
when Ghdl_Rtik_Subtype_Array =>
declare
- St : Ghdl_Rtin_Subtype_Array_Acc :=
+ St : constant Ghdl_Rtin_Subtype_Array_Acc :=
To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+ Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
B : Address;
begin
@@ -228,9 +227,9 @@
end;
when Ghdl_Rtik_Subtype_Array_Ptr =>
declare
- St : Ghdl_Rtin_Subtype_Array_Acc :=
+ St : constant Ghdl_Rtin_Subtype_Array_Acc :=
To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+ Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
B : Address;
begin
diff -urN ghdl-0.27/vhdl/grt/grt-disp_signals.adb ghdl-0.28dev/vhdl/grt/grt-disp_signals.adb
--- ghdl-0.27/vhdl/grt/grt-disp_signals.adb 2006-09-27 03:11:26.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-disp_signals.adb 2008-10-07 10:36:33.000000000 +0200
@@ -17,18 +17,15 @@
-- 02111-1307, USA.
with System; use System;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Ada.Unchecked_Conversion;
-with Grt.Types; use Grt.Types;
with Grt.Rtis; use Grt.Rtis;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Rtis_Utils; use Grt.Rtis_Utils;
-with Grt.Rtis; use Grt.Rtis;
with Grt.Astdio; use Grt.Astdio;
with Grt.Errors; use Grt.Errors;
pragma Elaborate_All (Grt.Rtis_Utils);
with Grt.Vstrings; use Grt.Vstrings;
-with Grt.Stdio; use Grt.Stdio;
-with Grt.Signals; use Grt.Signals;
with Grt.Options;
with Grt.Disp; use Grt.Disp;
@@ -231,6 +228,7 @@
procedure Disp_All_Signals
is
Res : Traverse_Result;
+ pragma Unreferenced (Res);
begin
if Boolean'(False) then
for I in Sig_Table.First .. Sig_Table.Last loop
@@ -308,6 +306,7 @@
procedure Disp_Signals_Map
is
Res : Traverse_Result;
+ pragma Unreferenced (Res);
begin
Res := Disp_Signals_Map_Blocks (Get_Top_Context);
Grt.Stdio.fflush (stdout);
@@ -351,7 +350,6 @@
procedure Disp_Signals_Table
is
- use Grt.Disp;
Sig : Ghdl_Signal_Ptr;
begin
for I in Sig_Table.First .. Sig_Table.Last loop
@@ -458,6 +456,7 @@
(Process_Block);
Res_Status : Traverse_Result;
+ pragma Unreferenced (Res_Status);
begin
Res_Status := Foreach_Block (Get_Top_Context);
if not Found then
diff -urN ghdl-0.27/vhdl/grt/grt-disp_tree.adb ghdl-0.28dev/vhdl/grt/grt-disp_tree.adb
--- ghdl-0.27/vhdl/grt/grt-disp_tree.adb 2005-12-11 18:16:59.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-disp_tree.adb 2008-10-07 10:36:34.000000000 +0200
@@ -83,7 +83,8 @@
| Ghdl_Rtik_Block
| Ghdl_Rtik_If_Generate =>
declare
- Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
+ Blk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Rti);
begin
Disp_Name (Blk.Name);
end;
@@ -104,7 +105,8 @@
end;
when Ghdl_Rtik_For_Generate =>
declare
- Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
+ Blk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Rti);
Iter : Ghdl_Rtin_Object_Acc;
Addr : Address;
begin
@@ -231,7 +233,8 @@
when Ghdl_Rtik_Process
| Ghdl_Rtik_Block =>
declare
- Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+ Nblk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Child);
Nctxt : Rti_Context;
begin
Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
@@ -241,7 +244,8 @@
end;
when Ghdl_Rtik_For_Generate =>
declare
- Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+ Nblk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Child);
Nctxt : Rti_Context;
Length : Ghdl_Index_Type;
Old_Child2 : Ghdl_Rti_Access;
@@ -268,7 +272,8 @@
end;
when Ghdl_Rtik_If_Generate =>
declare
- Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+ Nblk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Child);
Nctxt : Rti_Context;
begin
Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
@@ -402,8 +407,9 @@
end loop;
end Disp_Hierarchy;
- function Disp_Tree_Option (Opt : String) return Boolean
+ function Disp_Tree_Option (Option : String) return Boolean
is
+ Opt : constant String (1 .. Option'Length) := Option;
begin
if Opt'Length >= 11 and then Opt (1 .. 11) = "--disp-tree" then
if Opt'Length = 11 then
diff -urN ghdl-0.27/vhdl/grt/grt-errors.adb ghdl-0.28dev/vhdl/grt/grt-errors.adb
--- ghdl-0.27/vhdl/grt/grt-errors.adb 2007-12-02 03:00:40.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-errors.adb 2008-10-07 10:36:34.000000000 +0200
@@ -17,7 +17,6 @@
-- 02111-1307, USA.
with Grt.Stdio; use Grt.Stdio;
with Grt.Astdio; use Grt.Astdio;
-with Grt.Types; use Grt.Types;
with Grt.Options; use Grt.Options;
package body Grt.Errors is
@@ -106,7 +105,7 @@
procedure Report_C (Str : Ghdl_C_String)
is
- Len : Natural := strlen (Str);
+ Len : constant Natural := strlen (Str);
begin
Put_Err (Str (1 .. Len));
end Report_C;
@@ -154,7 +153,7 @@
procedure Error_C (Str : Ghdl_C_String)
is
- Len : Natural := strlen (Str);
+ Len : constant Natural := strlen (Str);
begin
if not Cont then
Error_H;
diff -urN ghdl-0.27/vhdl/grt/grt-files.adb ghdl-0.28dev/vhdl/grt/grt-files.adb
--- ghdl-0.27/vhdl/grt/grt-files.adb 2007-12-02 02:57:52.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-files.adb 2008-10-07 10:36:34.000000000 +0200
@@ -18,8 +18,9 @@
with Grt.Errors; use Grt.Errors;
with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
-with GNAT.Table;
+with Grt.Table;
with System; use System;
+pragma Elaborate_All (Grt.Table);
package body Grt.Files is
subtype C_Files is Grt.Stdio.FILEs;
@@ -31,12 +32,11 @@
Is_Alive : Boolean;
end record;
- package Files_Table is new GNAT.Table
+ package Files_Table is new Grt.Table
(Table_Component_Type => File_Entry_Type,
Table_Index_Type => Ghdl_File_Index,
Table_Low_Bound => 1,
- Table_Initial => 2,
- Table_Increment => 100);
+ Table_Initial => 2);
function Get_File (Index : Ghdl_File_Index) return C_Files
is
@@ -56,17 +56,13 @@
end Check_File_Mode;
function Create_File (Is_Text : Boolean; Sig : Ghdl_C_String)
- return Ghdl_File_Index
- is
- Res : Ghdl_File_Index;
+ return Ghdl_File_Index is
begin
- Files_Table.Increment_Last;
- Res := Files_Table.Last;
- Files_Table.Table (Res) := (Stream => NULL_Stream,
- Signature => Sig,
- Is_Text => Is_Text,
- Is_Alive => True);
- return Res;
+ Files_Table.Append ((Stream => NULL_Stream,
+ Signature => Sig,
+ Is_Text => Is_Text,
+ Is_Alive => True));
+ return Files_Table.Last;
end Create_File;
procedure Destroy_File (Is_Text : Boolean; Index : Ghdl_File_Index) is
@@ -289,6 +285,7 @@
Res : C_Files;
R : size_t;
R1 : int;
+ pragma Unreferenced (R, R1);
begin
Res := Get_File (File);
Check_File_Mode (File, True);
@@ -311,6 +308,7 @@
Res : C_Files;
R : size_t;
R1 : int;
+ pragma Unreferenced (R1);
begin
Res := Get_File (File);
Check_File_Mode (File, False);
diff -urN ghdl-0.27/vhdl/grt/grt-files.ads ghdl-0.28dev/vhdl/grt/grt-files.ads
--- ghdl-0.27/vhdl/grt/grt-files.ads 2005-09-23 00:26:54.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-files.ads 2008-10-07 10:36:34.000000000 +0200
@@ -83,7 +83,7 @@
procedure Ghdl_Text_File_Close (File : Ghdl_File_Index);
procedure Ghdl_File_Close (File : Ghdl_File_Index);
private
- pragma Export (C, Ghdl_File_Endfile, "__ghdl_file_endfile");
+ pragma Export (Ada, Ghdl_File_Endfile, "__ghdl_file_endfile");
pragma Export (C, Ghdl_Text_File_Elaborate, "__ghdl_text_file_elaborate");
pragma Export (C, Ghdl_File_Elaborate, "__ghdl_file_elaborate");
diff -urN ghdl-0.27/vhdl/grt/grt-images.adb ghdl-0.28dev/vhdl/grt/grt-images.adb
--- ghdl-0.27/vhdl/grt/grt-images.adb 2006-05-29 21:37:45.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-images.adb 2008-10-07 10:36:34.000000000 +0200
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
with System; use System;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Ada.Unchecked_Conversion;
with Grt.Processes; use Grt.Processes;
with Grt.Vstrings; use Grt.Vstrings;
@@ -98,7 +99,7 @@
Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name;
Unit_Len := strlen (Unit);
declare
- L : Natural := Str'Last + 1 - First;
+ L : constant Natural := Str'Last + 1 - First;
Str2 : String (1 .. L + 1 + Unit_Len);
begin
Str2 (1 .. L) := Str (First .. Str'Last);
@@ -122,7 +123,7 @@
Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name;
Unit_Len := strlen (Unit);
declare
- L : Natural := Str'Last + 1 - First;
+ L : constant Natural := Str'Last + 1 - First;
Str2 : String (1 .. L + 1 + Unit_Len);
begin
Str2 (1 .. L) := Str (First .. Str'Last);
diff -urN ghdl-0.27/vhdl/grt/grt-images.ads ghdl-0.28dev/vhdl/grt/grt-images.ads
--- ghdl-0.27/vhdl/grt/grt-images.ads 2006-05-29 21:38:17.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-images.ads 2008-10-07 10:36:34.000000000 +0200
@@ -32,7 +32,7 @@
procedure Ghdl_Image_P32
(Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access);
private
- pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2");
+ pragma Export (Ada, Ghdl_Image_B2, "__ghdl_image_b2");
pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8");
pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32");
pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32");
diff -urN ghdl-0.27/vhdl/grt/grt-lib.adb ghdl-0.28dev/vhdl/grt/grt-lib.adb
--- ghdl-0.27/vhdl/grt/grt-lib.adb 2008-06-27 02:26:06.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-lib.adb 2008-10-07 10:36:33.000000000 +0200
@@ -41,7 +41,7 @@
Unit : Ghdl_Rti_Access)
is
use Grt.Options;
- Level : Integer := Severity mod 256;
+ Level : constant Integer := Severity mod 256;
begin
-- Assertions from ieee library can be disabled.
if Unit /= null
@@ -51,9 +51,11 @@
and Current_Time = 0))
then
declare
- Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Unit);
- Pkg : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
- Lib : Ghdl_Rtin_Type_Scalar_Acc :=
+ Blk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Unit);
+ Pkg : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+ Lib : constant Ghdl_Rtin_Type_Scalar_Acc :=
To_Ghdl_Rtin_Type_Scalar_Acc (Pkg.Parent);
begin
-- Return now if this assert comes from the ieee library.
diff -urN ghdl-0.27/vhdl/grt/grt-main.adb ghdl-0.28dev/vhdl/grt/grt-main.adb
--- ghdl-0.27/vhdl/grt/grt-main.adb 2005-12-12 03:47:44.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-main.adb 2008-10-07 10:36:34.000000000 +0200
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Types; use Grt.Types;
with Grt.Errors;
with Grt.Stacks;
@@ -60,6 +61,9 @@
is
Err : Boolean;
begin
+ -- The conditions may be statically known.
+ pragma Warnings (Off);
+
Err := False;
if (Std_Integer'Size = 32 and Flag_String (3) /= 'i')
or else (Std_Integer'Size = 64 and Flag_String (3) /= 'I')
@@ -71,6 +75,9 @@
then
Err := True;
end if;
+
+ pragma Warnings (On);
+
if Err then
Grt.Errors.Error
("GRT is not consistent with the flags used for your design");
diff -urN ghdl-0.27/vhdl/grt/grt-modules.adb ghdl-0.28dev/vhdl/grt/grt-modules.adb
--- ghdl-0.27/vhdl/grt/grt-modules.adb 2005-12-12 03:47:22.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-modules.adb 2008-10-07 10:36:34.000000000 +0200
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Vcd;
with Grt.Vcdz;
with Grt.Vpi;
diff -urN ghdl-0.27/vhdl/grt/grt-names.adb ghdl-0.28dev/vhdl/grt/grt-names.adb
--- ghdl-0.27/vhdl/grt/grt-names.adb 2005-10-08 14:03:33.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-names.adb 2008-10-07 10:36:33.000000000 +0200
@@ -18,6 +18,7 @@
--with Grt.Errors; use Grt.Errors;
with Ada.Unchecked_Conversion;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Processes; use Grt.Processes;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Rtis_Utils; use Grt.Rtis_Utils;
diff -urN ghdl-0.27/vhdl/grt/grt-options.adb ghdl-0.28dev/vhdl/grt/grt-options.adb
--- ghdl-0.27/vhdl/grt/grt-options.adb 2008-06-27 02:26:06.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-options.adb 2008-10-07 10:36:34.000000000 +0200
@@ -253,7 +253,7 @@
Arg := Argv (I);
Len := strlen (Arg);
declare
- Argument : String := Arg (1 .. Len);
+ Argument : constant String := Arg (1 .. Len);
begin
if Argument = "--" then
Last_Opt := I;
diff -urN ghdl-0.27/vhdl/grt/grt-options.ads ghdl-0.28dev/vhdl/grt/grt-options.ads
--- ghdl-0.27/vhdl/grt/grt-options.ads 2008-06-27 02:26:06.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-options.ads 2008-10-07 10:36:34.000000000 +0200
@@ -41,7 +41,7 @@
-- Consistent flags used for analysis.
-- Format is "VVitr", where:
- -- 'VV' is the version (87 or 93).
+ -- 'VV' is the version (87, 93 or 08).
-- 'i' is the integer size ('i' for 32 bits, 'I' for 64 bits).
-- 't' is the time size ('t' for 32 bits, 'T' for 64 bits).
-- 'r' is the resolution ('?' for to be set by the user, '-' for any).
diff -urN ghdl-0.27/vhdl/grt/grt-processes.adb ghdl-0.28dev/vhdl/grt/grt-processes.adb
--- ghdl-0.27/vhdl/grt/grt-processes.adb 2008-06-28 16:59:12.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-processes.adb 2008-10-07 10:36:34.000000000 +0200
@@ -15,14 +15,13 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with GNAT.Table;
+with Grt.Table;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Storage_Elements; -- Work around GNAT bug.
-with Grt.Stack2; use Grt.Stack2;
+pragma Unreferenced (System.Storage_Elements);
with Grt.Disp;
with Grt.Astdio;
-with Grt.Signals; use Grt.Signals;
with Grt.Errors; use Grt.Errors;
with Grt.Stacks; use Grt.Stacks;
with Grt.Options;
@@ -30,28 +29,26 @@
with Grt.Rtis_Utils;
with Grt.Hooks;
with Grt.Disp_Signals;
-with Grt.Stdio;
with Grt.Stats;
with Grt.Threads; use Grt.Threads;
+pragma Elaborate_All (Grt.Table);
package body Grt.Processes is
Last_Time : constant Std_Time := Std_Time'Last;
-- Table of processes.
- package Process_Table is new GNAT.Table
+ package Process_Table is new Grt.Table
(Table_Component_Type => Process_Type,
Table_Index_Type => Process_Id,
Table_Low_Bound => 1,
- Table_Initial => 16,
- Table_Increment => 100);
+ Table_Initial => 16);
-- List of non_sensitized processes.
- package Non_Sensitized_Process_Table is new GNAT.Table
+ package Non_Sensitized_Process_Table is new Grt.Table
(Table_Component_Type => Process_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
- Table_Initial => 2,
- Table_Increment => 100);
+ Table_Initial => 2);
-- List of processes to be resume at next cycle.
type Process_Id_Array is array (Natural range <>) of Process_Id;
@@ -74,7 +71,7 @@
procedure Init is
begin
- Process_Table.Init;
+ null;
end Init;
function Get_Nbr_Processes return Natural is
@@ -380,7 +377,7 @@
procedure Ghdl_Protected_Enter (Obj : System.Address)
is
- Lock : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+ Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
begin
if Lock.Process = Nul_Process_Id then
if Lock.Count /= 0 then
@@ -398,13 +395,13 @@
procedure Ghdl_Protected_Leave (Obj : System.Address)
is
- Lock : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+ Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
begin
if Lock.Process /= Get_Current_Process_Id then
Internal_Error ("protected_leave(1)");
end if;
- if Lock.Count <= 0 then
+ if Lock.Count = 0 then
Internal_Error ("protected_leave(2)");
end if;
Lock.Count := Lock.Count - 1;
@@ -415,7 +412,7 @@
procedure Ghdl_Protected_Init (Obj : System.Address)
is
- Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+ Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
begin
Lock.all := new Object_Lock'(Process => Nul_Process_Id,
Count => 0);
@@ -426,7 +423,7 @@
procedure Deallocate is new Ada.Unchecked_Deallocation
(Object => Object_Lock, Name => Object_Lock_Acc);
- Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+ Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
begin
if Lock.all.Count /= 0 or Lock.all.Process /= Nul_Process_Id then
Internal_Error ("protected_fini");
@@ -455,7 +452,8 @@
Non_Sensitized_Process_Table.Last
loop
declare
- Pid : Process_Id := Non_Sensitized_Process_Table.Table (I);
+ Pid : constant Process_Id :=
+ Non_Sensitized_Process_Table.Table (I);
Proc : Process_Type renames Process_Table.Table (Pid);
begin
if Proc.State = State_Wait
@@ -488,7 +486,7 @@
-- pragma Convention (C, Run_Handler);
function Run_Through_Longjump (Hand : Run_Handler) return Integer;
- pragma Import (C, Run_Through_Longjump, "__ghdl_run_through_longjump");
+ pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump");
-- Run resumed processes.
-- If POSTPONED is true, resume postponed processes, else resume
@@ -703,7 +701,8 @@
Non_Sensitized_Process_Table.Last
loop
declare
- Pid : Process_Id := Non_Sensitized_Process_Table.Table (I);
+ Pid : constant Process_Id :=
+ Non_Sensitized_Process_Table.Table (I);
Proc : Process_Type renames Process_Table.Table (Pid);
El : Sensitivity_Acc;
begin
diff -urN ghdl-0.27/vhdl/grt/grt-processes.ads ghdl-0.28dev/vhdl/grt/grt-processes.ads
--- ghdl-0.27/vhdl/grt/grt-processes.ads 2005-12-07 06:46:16.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-processes.ads 2008-10-07 10:36:34.000000000 +0200
@@ -205,7 +205,7 @@
"__ghdl_process_wait_add_sensitivity");
pragma Export (C, Ghdl_Process_Wait_Set_Timeout,
"__ghdl_process_wait_set_timeout");
- pragma Export (C, Ghdl_Process_Wait_Suspend,
+ pragma Export (Ada, Ghdl_Process_Wait_Suspend,
"__ghdl_process_wait_suspend");
pragma Export (C, Ghdl_Process_Wait_Close,
"__ghdl_process_wait_close");
diff -urN ghdl-0.27/vhdl/grt/grt-rtis_addr.adb ghdl-0.28dev/vhdl/grt/grt-rtis_addr.adb
--- ghdl-0.27/vhdl/grt/grt-rtis_addr.adb 2006-07-29 21:49:26.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-rtis_addr.adb 2008-10-07 10:36:34.000000000 +0200
@@ -15,7 +15,6 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Ada.Unchecked_Conversion;
with Grt.Errors; use Grt.Errors;
package body Grt.Rtis_Addr is
diff -urN ghdl-0.27/vhdl/grt/grt-rtis_utils.adb ghdl-0.28dev/vhdl/grt/grt-rtis_utils.adb
--- ghdl-0.27/vhdl/grt/grt-rtis_utils.adb 2006-05-29 21:36:38.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-rtis_utils.adb 2008-10-07 10:36:34.000000000 +0200
@@ -15,9 +15,6 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with System; use System;
-with Grt.Rtis; use Grt.Rtis;
-with Grt.Types; use Grt.Types;
--with Grt.Disp; use Grt.Disp;
with Grt.Errors; use Grt.Errors;
@@ -318,7 +315,7 @@
procedure Handle_Array (Rti : Ghdl_Rtin_Type_Array_Acc;
Vals : Ghdl_Uc_Array_Acc)
is
- Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim;
+ Nbr_Dim : constant Ghdl_Index_Type := Rti.Nbr_Dim;
Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
begin
Bound_To_Range (Vals.Bounds, Rti, Rngs);
@@ -367,9 +364,9 @@
To_Ghdl_Uc_Array_Acc (Addr));
when Ghdl_Rtik_Subtype_Array =>
declare
- St : Ghdl_Rtin_Subtype_Array_Acc :=
+ St : constant Ghdl_Rtin_Subtype_Array_Acc :=
To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+ Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
begin
Bound_To_Range
@@ -385,9 +382,9 @@
end;
when Ghdl_Rtik_Subtype_Array_Ptr =>
declare
- St : Ghdl_Rtin_Subtype_Array_Acc :=
+ St : constant Ghdl_Rtin_Subtype_Array_Acc :=
To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+ Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
begin
Bound_To_Range
@@ -521,7 +518,7 @@
Addr : Address;
Type_Rti : Ghdl_Rti_Access)
is
- Value : Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr);
+ Value : constant Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr);
begin
case Type_Rti.Kind is
when Ghdl_Rtik_Type_I32 =>
diff -urN ghdl-0.27/vhdl/grt/grt-sdf.adb ghdl-0.28dev/vhdl/grt/grt-sdf.adb
--- ghdl-0.27/vhdl/grt/grt-sdf.adb 2008-05-01 07:44:46.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-sdf.adb 2008-10-07 10:36:34.000000000 +0200
@@ -16,7 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
-with Grt.Types; use Grt.Types;
+pragma Unreferenced (System.Storage_Elements);
with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Errors; use Grt.Errors;
diff -urN ghdl-0.27/vhdl/grt/grt-signals.adb ghdl-0.28dev/vhdl/grt/grt-signals.adb
--- ghdl-0.27/vhdl/grt/grt-signals.adb 2008-05-13 03:06:31.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-signals.adb 2008-10-07 10:36:33.000000000 +0200
@@ -17,8 +17,8 @@
-- 02111-1307, USA.
with System; use System;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Ada.Unchecked_Deallocation;
-with Ada.Unchecked_Conversion;
with Grt.Errors; use Grt.Errors;
with Grt.Processes; use Grt.Processes;
with Grt.Options; use Grt.Options;
@@ -1750,7 +1750,8 @@
procedure Compute_Resolved_Signal (Resolv : Resolved_Signal_Acc)
is
- Sig : Ghdl_Signal_Ptr := Sig_Table.Table (Resolv.Sig_Range.First);
+ Sig : constant Ghdl_Signal_Ptr :=
+ Sig_Table.Table (Resolv.Sig_Range.First);
Length : Ghdl_Index_Type;
type Bool_Array_Type is array (1 .. Sig.S.Nbr_Drivers) of Boolean;
Vec : Bool_Array_Type;
@@ -2135,7 +2136,7 @@
declare
S : Ghdl_Signal_Ptr;
- Old : Signal_Net_Type := Sig.Net;
+ Old : constant Signal_Net_Type := Sig.Net;
begin
-- Merge the old net into NET.
S := Sig;
diff -urN ghdl-0.27/vhdl/grt/grt-signals.ads ghdl-0.28dev/vhdl/grt/grt-signals.ads
--- ghdl-0.27/vhdl/grt/grt-signals.ads 2006-09-07 06:11:32.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-signals.ads 2008-10-07 10:36:33.000000000 +0200
@@ -17,9 +17,10 @@
-- 02111-1307, USA.
with System;
with Ada.Unchecked_Conversion;
-with GNAT.Table;
+with Grt.Table;
with Grt.Types; use Grt.Types;
with Grt.Rtis; use Grt.Rtis;
+pragma Elaborate_All (Grt.Table);
package Grt.Signals is
pragma Suppress (All_Checks);
@@ -264,12 +265,11 @@
end record;
-- Each simple signal declared can be accessed by SIG_TABLE.
- package Sig_Table is new GNAT.Table
+ package Sig_Table is new Grt.Table
(Table_Component_Type => Ghdl_Signal_Ptr,
Table_Index_Type => Sig_Table_Index,
Table_Low_Bound => 0,
- Table_Initial => 128,
- Table_Increment => 100);
+ Table_Initial => 128);
-- Return the next time at which a driver becomes active.
function Find_Next_Time return Std_Time;
@@ -380,12 +380,11 @@
end case;
end record;
- package Propagation is new GNAT.Table
+ package Propagation is new Grt.Table
(Table_Component_Type => Propagation_Type,
Table_Index_Type => Signal_Net_Type,
Table_Low_Bound => 1,
- Table_Initial => 128,
- Table_Increment => 100);
+ Table_Initial => 128);
-- Get the signal index of PTR.
function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index;
@@ -660,22 +659,22 @@
pragma Export (C, Ghdl_Signal_Disconnect,
"__ghdl_signal_disconnect");
- pragma Export (C, Ghdl_Signal_Driving,
+ pragma Export (Ada, Ghdl_Signal_Driving,
"__ghdl_signal_driving");
- pragma Export (C, Ghdl_Create_Signal_B2,
+ pragma Export (Ada, Ghdl_Create_Signal_B2,
"__ghdl_create_signal_b2");
- pragma Export (C, Ghdl_Signal_Init_B2,
+ pragma Export (Ada, Ghdl_Signal_Init_B2,
"__ghdl_signal_init_b2");
- pragma Export (C, Ghdl_Signal_Associate_B2,
+ pragma Export (Ada, Ghdl_Signal_Associate_B2,
"__ghdl_signal_associate_b2");
- pragma Export (C, Ghdl_Signal_Simple_Assign_B2,
+ pragma Export (Ada, Ghdl_Signal_Simple_Assign_B2,
"__ghdl_signal_simple_assign_b2");
- pragma Export (C, Ghdl_Signal_Start_Assign_B2,
+ pragma Export (Ada, Ghdl_Signal_Start_Assign_B2,
"__ghdl_signal_start_assign_b2");
- pragma Export (C, Ghdl_Signal_Next_Assign_B2,
+ pragma Export (Ada, Ghdl_Signal_Next_Assign_B2,
"__ghdl_signal_next_assign_b2");
- pragma Export (C, Ghdl_Signal_Driving_Value_B2,
+ pragma Export (Ada, Ghdl_Signal_Driving_Value_B2,
"__ghdl_signal_driving_value_b2");
pragma Export (C, Ghdl_Create_Signal_E8,
@@ -781,7 +780,7 @@
pragma Export (C, Ghdl_Create_Delayed_Signal,
"__ghdl_create_delayed_signal");
- pragma Export (C, Ghdl_Signal_Create_Guard,
+ pragma Export (Ada, Ghdl_Signal_Create_Guard,
"__ghdl_signal_create_guard");
pragma Export (C, Ghdl_Signal_Guard_Dependence,
"__ghdl_signal_guard_dependence");
diff -urN ghdl-0.27/vhdl/grt/grt-stats.adb ghdl-0.28dev/vhdl/grt/grt-stats.adb
--- ghdl-0.27/vhdl/grt/grt-stats.adb 2006-09-04 06:50:27.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-stats.adb 2008-10-07 10:36:33.000000000 +0200
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
with System; use System;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Stdio; use Grt.Stdio;
with Grt.Astdio; use Grt.Astdio;
with Grt.Signals;
diff -urN ghdl-0.27/vhdl/grt/grt-table.adb ghdl-0.28dev/vhdl/grt/grt-table.adb
--- ghdl-0.27/vhdl/grt/grt-table.adb 1970-01-01 01:00:00.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-table.adb 2008-10-07 10:36:33.000000000 +0200
@@ -0,0 +1,113 @@
+-- GHDL Run Time (GRT) - Resizable array
+-- Copyright (C) 2008 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
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with System; use System;
+with Grt.C; use Grt.C;
+
+package body Grt.Table is
+
+ -- Maximum index of table before resizing.
+ Max : Table_Index_Type := Table_Low_Bound - 1;
+
+ -- Current value of Last
+ Last_Val : Table_Index_Type;
+
+ function Malloc (Size : size_t) return Table_Ptr;
+ pragma Import (C, Malloc);
+
+ procedure Free (T : Table_Ptr);
+ pragma Import (C, Free);
+
+ -- Resize and reallocate the table according to LAST_VAL.
+ procedure Resize is
+ function Realloc (T : Table_Ptr; Size : size_t) return Table_Ptr;
+ pragma Import (C, Realloc);
+
+ New_Size : size_t;
+ begin
+ while Max < Last_Val loop
+ Max := Max + (Max - Table_Low_Bound + 1);
+ end loop;
+
+ New_Size := size_t ((Max - Table_Low_Bound + 1) *
+ (Table_Type'Component_Size / Storage_Unit));
+
+ Table := Realloc (Table, New_Size);
+
+ if Table = null then
+ raise Storage_Error;
+ end if;
+ end Resize;
+
+ procedure Append (New_Val : Table_Component_Type) is
+ begin
+ Increment_Last;
+ Table (Last_Val) := New_Val;
+ end Append;
+
+ procedure Decrement_Last is
+ begin
+ Last_Val := Last_Val - 1;
+ end Decrement_Last;
+
+ procedure Free is
+ begin
+ Free (Table);
+ Table := null;
+ end Free;
+
+ procedure Increment_Last is
+ begin
+ Last_Val := Last_Val + 1;
+
+ if Last_Val > Max then
+ Resize;
+ end if;
+ end Increment_Last;
+
+ function Last return Table_Index_Type is
+ begin
+ return Last_Val;
+ end Last;
+
+ procedure Release is
+ begin
+ Max := Last_Val;
+ Resize;
+ end Release;
+
+ procedure Set_Last (New_Val : Table_Index_Type) is
+ begin
+ if New_Val < Last_Val then
+ Last_Val := New_Val;
+ else
+ Last_Val := New_Val;
+
+ if Last_Val > Max then
+ Resize;
+ end if;
+ end if;
+ end Set_Last;
+
+begin
+ Last_Val := Table_Low_Bound - 1;
+ Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1;
+
+ Table := Malloc (size_t (Table_Initial *
+ (Table_Type'Component_Size / Storage_Unit)));
+end Grt.Table;
diff -urN ghdl-0.27/vhdl/grt/grt-table.ads ghdl-0.28dev/vhdl/grt/grt-table.ads
--- ghdl-0.27/vhdl/grt/grt-table.ads 1970-01-01 01:00:00.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-table.ads 2008-10-07 10:36:33.000000000 +0200
@@ -0,0 +1,68 @@
+-- GHDL Run Time (GRT) - Resizable array
+-- Copyright (C) 2008 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
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+generic
+ type Table_Component_Type is private;
+ type Table_Index_Type is range <>;
+
+ Table_Low_Bound : Table_Index_Type;
+ Table_Initial : Positive;
+
+package Grt.Table is
+ pragma Elaborate_Body;
+
+ type Table_Type is
+ array (Table_Index_Type range <>) of Table_Component_Type;
+ subtype Fat_Table_Type is
+ Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
+
+ -- Thin pointer.
+ type Table_Ptr is access all Fat_Table_Type;
+
+ -- The table itself.
+ Table : aliased Table_Ptr := null;
+
+ -- Get the high bound.
+ function Last return Table_Index_Type;
+ pragma Inline (Last);
+
+ -- Get the low bound.
+ First : constant Table_Index_Type := Table_Low_Bound;
+
+ -- Increase the length by 1.
+ procedure Increment_Last;
+ pragma Inline (Increment_Last);
+
+ -- Decrease the length by 1.
+ procedure Decrement_Last;
+ pragma Inline (Decrement_Last);
+
+ -- Set the last bound.
+ procedure Set_Last (New_Val : Table_Index_Type);
+
+ -- Release extra memory.
+ procedure Release;
+
+ -- Free all the memory used by the table.
+ -- The table won't be useable anymore.
+ procedure Free;
+
+ -- Append a new element.
+ procedure Append (New_Val : Table_Component_Type);
+ pragma Inline (Append);
+end Grt.Table;
diff -urN ghdl-0.27/vhdl/grt/grt-unithread.adb ghdl-0.28dev/vhdl/grt/grt-unithread.adb
--- ghdl-0.27/vhdl/grt/grt-unithread.adb 2005-11-05 14:44:25.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-unithread.adb 2008-10-07 10:36:33.000000000 +0200
@@ -15,7 +15,6 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Grt.Types; use Grt.Types;
package body Grt.Unithread is
procedure Init is
diff -urN ghdl-0.27/vhdl/grt/grt-unithread.ads ghdl-0.28dev/vhdl/grt/grt-unithread.ads
--- ghdl-0.27/vhdl/grt/grt-unithread.ads 2005-11-11 09:36:57.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-unithread.ads 2008-10-07 10:36:33.000000000 +0200
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Signals; use Grt.Signals;
with Grt.Stack2; use Grt.Stack2;
with Grt.Stacks; use Grt.Stacks;
diff -urN ghdl-0.27/vhdl/grt/grt-vcd.adb ghdl-0.28dev/vhdl/grt/grt-vcd.adb
--- ghdl-0.27/vhdl/grt/grt-vcd.adb 2005-11-11 15:41:37.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-vcd.adb 2008-10-07 10:36:34.000000000 +0200
@@ -17,53 +17,48 @@
-- 02111-1307, USA.
with Interfaces;
with Grt.Stdio; use Grt.Stdio;
-with System; use System;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Errors; use Grt.Errors;
-with Grt.Types; use Grt.Types;
with Grt.Signals; use Grt.Signals;
-with GNAT.Table;
+with Grt.Table;
with Grt.Astdio; use Grt.Astdio;
with Grt.C; use Grt.C;
with Grt.Hooks; use Grt.Hooks;
-with Grt.Avhpi; use Grt.Avhpi;
with Grt.Rtis; use Grt.Rtis;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Rtis_Types; use Grt.Rtis_Types;
with Grt.Vstrings;
+pragma Elaborate_All (Grt.Table);
package body Grt.Vcd is
-- If TRUE, put $date in vcd file.
-- Can be set to FALSE to make vcd comparaison easier.
Flag_Vcd_Date : Boolean := True;
- type Vcd_IO_Simple is new Vcd_IO_Handler with record
- Stream : FILEs;
- end record;
- type IO_Simple_Acc is access Vcd_IO_Simple;
- procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String);
- procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character);
- procedure Vcd_Close (Handler : access Vcd_IO_Simple);
+ Stream : FILEs;
- procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String)
+ procedure My_Vcd_Put (Str : String)
is
R : size_t;
+ pragma Unreferenced (R);
begin
- R := fwrite (Str'Address, Str'Length, 1, Handler.Stream);
- end Vcd_Put;
+ R := fwrite (Str'Address, Str'Length, 1, Stream);
+ end My_Vcd_Put;
- procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character)
+ procedure My_Vcd_Putc (C : Character)
is
R : int;
+ pragma Unreferenced (R);
begin
- R := fputc (Character'Pos (C), Handler.Stream);
- end Vcd_Putc;
+ R := fputc (Character'Pos (C), Stream);
+ end My_Vcd_Putc;
- procedure Vcd_Close (Handler : access Vcd_IO_Simple) is
+ procedure My_Vcd_Close is
begin
- fclose (Handler.Stream);
- Handler.Stream := NULL_Stream;
- end Vcd_Close;
+ fclose (Stream);
+ Stream := NULL_Stream;
+ end My_Vcd_Close;
-- VCD filename.
-- Stream corresponding to the VCD filename.
@@ -75,9 +70,8 @@
-- Return TRUE if OPT is an option for VCD.
function Vcd_Option (Opt : String) return Boolean
is
- F : Natural := Opt'First;
+ F : constant Natural := Opt'First;
Mode : constant String := "wt" & NUL;
- Handler : IO_Simple_Acc;
Vcd_Filename : String_Access;
begin
if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then
@@ -88,7 +82,7 @@
return True;
end if;
if Opt'Length > 6 and then Opt (F + 5) = '=' then
- if H /= null then
+ if Vcd_Close /= null then
Error ("--vcd: file already set");
return True;
end if;
@@ -98,19 +92,20 @@
Vcd_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
Vcd_Filename (Vcd_Filename'Last) := NUL;
- Handler := new Vcd_IO_Simple;
if Vcd_Filename.all = "-" & NUL then
- Handler.Stream := stdout;
+ Stream := stdout;
else
- Handler.Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
- if Handler.Stream = NULL_Stream then
+ Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+ if Stream = NULL_Stream then
Error_C ("cannot open ");
Error_E (Vcd_Filename (Vcd_Filename'First
.. Vcd_Filename'Last - 1));
return True;
end if;
end if;
- H := Handler_Acc (Handler);
+ Vcd_Putc := My_Vcd_Putc'Access;
+ Vcd_Put := My_Vcd_Put'Access;
+ Vcd_Close := My_Vcd_Close'Access;
return True;
else
return False;
@@ -123,24 +118,14 @@
Put_Line (" --vcd-nodate do not write date in VCD file");
end Vcd_Help;
- procedure Vcd_Put (Str : String) is
- begin
- Vcd_Put (H, Str);
- end Vcd_Put;
-
- procedure Vcd_Putc (C : Character) is
- begin
- Vcd_Putc (H, C);
- end Vcd_Putc;
-
procedure Vcd_Newline is
begin
- Vcd_Putc (H, Nl);
+ Vcd_Putc (Nl);
end Vcd_Newline;
procedure Vcd_Putline (Str : String) is
begin
- Vcd_Put (H, Str);
+ Vcd_Put (Str);
Vcd_Newline;
end Vcd_Putline;
@@ -200,7 +185,7 @@
procedure Vcd_Init
is
begin
- if H = null then
+ if Vcd_Close = null then
return;
end if;
if Flag_Vcd_Date then
@@ -236,12 +221,11 @@
Vcd_Put_End;
end Vcd_Init;
- package Vcd_Table is new GNAT.Table
+ package Vcd_Table is new Grt.Table
(Table_Component_Type => Verilog_Wire_Info,
Table_Index_Type => Vcd_Index_Type,
Table_Low_Bound => 0,
- Table_Initial => 32,
- Table_Increment => 100);
+ Table_Initial => 32);
procedure Avhpi_Error (Err : AvhpiErrorT)
is
@@ -306,13 +290,10 @@
procedure Get_Verilog_Wire (Sig : VhpiHandleT; Info : out Verilog_Wire_Info)
is
Sig_Type : VhpiHandleT;
- Sig_Rti : Ghdl_Rtin_Object_Acc;
Rti : Ghdl_Rti_Access;
Error : AvhpiErrorT;
Sig_Addr : Address;
begin
- Sig_Rti := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Sig));
-
-- Extract type of the signal.
Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Error);
if Error /= AvhpiErrorOk then
@@ -711,7 +692,7 @@
Root : VhpiHandleT;
begin
-- Do nothing if there is no VCD file to generate.
- if H = null then
+ if Vcd_Close = null then
return;
end if;
@@ -752,8 +733,8 @@
-- Called at the end of the simulation.
procedure Vcd_End is
begin
- if H /= null then
- Vcd_Close (H);
+ if Vcd_Close /= null then
+ Vcd_Close.all;
end if;
end Vcd_End;
diff -urN ghdl-0.27/vhdl/grt/grt-vcd.ads ghdl-0.28dev/vhdl/grt/grt-vcd.ads
--- ghdl-0.27/vhdl/grt/grt-vcd.ads 2005-10-06 18:25:54.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-vcd.ads 2008-10-07 10:36:34.000000000 +0200
@@ -21,16 +21,13 @@
package Grt.Vcd is
-- Abstract type for IO.
- type Vcd_IO_Handler is abstract tagged null record;
- procedure Vcd_Put (Handler : access Vcd_IO_Handler; Str : String)
- is abstract;
- procedure Vcd_Putc (Handler : access Vcd_IO_Handler; C : Character)
- is abstract;
- procedure Vcd_Close (Handler : access Vcd_IO_Handler)
- is abstract;
-
- type Handler_Acc is access all Vcd_IO_Handler'Class;
- H : Handler_Acc := null;
+ type Vcd_Put_Acc is access procedure (Str : String);
+ type Vcd_Putc_Acc is access procedure (C : Character);
+ type Vcd_Close_Acc is access procedure;
+
+ Vcd_Put : Vcd_Put_Acc;
+ Vcd_Putc : Vcd_Putc_Acc;
+ Vcd_Close : Vcd_Close_Acc;
type Vcd_Var_Kind is (Vcd_Bad,
Vcd_Bool,
diff -urN ghdl-0.27/vhdl/grt/grt-vcdz.adb ghdl-0.28dev/vhdl/grt/grt-vcdz.adb
--- ghdl-0.27/vhdl/grt/grt-vcdz.adb 2005-10-16 09:53:29.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-vcdz.adb 2008-10-07 10:36:33.000000000 +0200
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Vcd; use Grt.Vcd;
with Grt.Errors; use Grt.Errors;
with Grt.Types; use Grt.Types;
@@ -25,49 +26,44 @@
with Grt.C; use Grt.C;
package body Grt.Vcdz is
- type Vcd_IO_Gzip is new Vcd_IO_Handler with record
- Stream : gzFile;
- end record;
- type IO_Gzip_Acc is access Vcd_IO_Gzip;
- procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String);
- procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character);
- procedure Vcd_Close (Handler : access Vcd_IO_Gzip);
+ Stream : gzFile;
- procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String)
+ procedure My_Vcd_Put (Str : String)
is
R : int;
+ pragma Unreferenced (R);
begin
- R := gzwrite (Handler.Stream, Str'Address, Str'Length);
- end Vcd_Put;
+ R := gzwrite (Stream, Str'Address, Str'Length);
+ end My_Vcd_Put;
- procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character)
+ procedure My_Vcd_Putc (C : Character)
is
R : int;
+ pragma Unreferenced (R);
begin
- R := gzputc (Handler.Stream, Character'Pos (C));
- end Vcd_Putc;
+ R := gzputc (Stream, Character'Pos (C));
+ end My_Vcd_Putc;
- procedure Vcd_Close (Handler : access Vcd_IO_Gzip) is
+ procedure My_Vcd_Close is
begin
- gzclose (Handler.Stream);
- Handler.Stream := NULL_gzFile;
- end Vcd_Close;
+ gzclose (Stream);
+ Stream := NULL_gzFile;
+ end My_Vcd_Close;
-- VCD filename.
-- Return TRUE if OPT is an option for VCD.
function Vcdz_Option (Opt : String) return Boolean
is
- F : Natural := Opt'First;
+ F : constant Natural := Opt'First;
Vcd_Filename : String_Access := null;
- Handler : IO_Gzip_Acc;
Mode : constant String := "wb" & NUL;
begin
if Opt'Length < 7 or else Opt (F .. F + 6) /= "--vcdgz" then
return False;
end if;
if Opt'Length > 7 and then Opt (F + 7) = '=' then
- if H /= null then
+ if Vcd_Close /= null then
Error ("--vcdgz: file already set");
return True;
end if;
@@ -77,15 +73,16 @@
Vcd_Filename (1 .. Opt'Length - 8) := Opt (F + 8 .. Opt'Last);
Vcd_Filename (Vcd_Filename'Last) := NUL;
- Handler := new Vcd_IO_Gzip;
- Handler.Stream := gzopen (Vcd_Filename.all'Address, Mode'Address);
- if Handler.Stream = NULL_gzFile then
+ Stream := gzopen (Vcd_Filename.all'Address, Mode'Address);
+ if Stream = NULL_gzFile then
Error_C ("cannot open ");
Error_E (Vcd_Filename (Vcd_Filename'First
.. Vcd_Filename'Last - 1));
return True;
end if;
- H := Handler_Acc (Handler);
+ Vcd_Putc := My_Vcd_Putc'Access;
+ Vcd_Put := My_Vcd_Put'Access;
+ Vcd_Close := My_Vcd_Close'Access;
return True;
else
return False;
diff -urN ghdl-0.27/vhdl/grt/grt-vital_annotate.adb ghdl-0.28dev/vhdl/grt/grt-vital_annotate.adb
--- ghdl-0.27/vhdl/grt/grt-vital_annotate.adb 2008-05-25 07:59:04.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-vital_annotate.adb 2008-10-07 10:36:33.000000000 +0200
@@ -15,7 +15,6 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Grt.Sdf;
with Grt.Types; use Grt.Types;
with Grt.Hooks; use Grt.Hooks;
with Grt.Astdio; use Grt.Astdio;
@@ -32,7 +31,7 @@
Sdf_Inst : VhpiHandleT;
Flag_Dump : Boolean := False;
- Flag_Verbose : Boolean := False;
+ Flag_Verbose : constant Boolean := False;
function Name_Compare (Handle : VhpiHandleT;
Name : String;
@@ -140,7 +139,7 @@
end Find_Generic;
- procedure Sdf_Header (Context : in out Sdf_Context_Type)
+ procedure Sdf_Header (Context : Sdf_Context_Type)
is
begin
if Flag_Dump then
@@ -156,7 +155,7 @@
end if;
end Sdf_Header;
- procedure Sdf_Celltype (Context : in out Sdf_Context_Type)
+ procedure Sdf_Celltype (Context : Sdf_Context_Type)
is
begin
if Flag_Dump then
@@ -185,7 +184,7 @@
Find_Instance (Sdf_Inst, Sdf_Inst, Instance, Status);
end Sdf_Instance;
- procedure Sdf_Instance_End (Context : in out Sdf_Context_Type;
+ procedure Sdf_Instance_End (Context : Sdf_Context_Type;
Status : out Boolean)
is
begin
@@ -319,6 +318,9 @@
Right : VhpiIntT;
begin
Vhpi_Handle (VhpiSubtype, Port, Port_Type, Error);
+ Left := 0;
+ Len := 0;
+ Up := True;
if Error /= AvhpiErrorOk then
Internal_Error ("vhpiSubtype - port");
return;
@@ -434,10 +436,10 @@
then
Generic_Get_Bounds (Port2, Left2, Len2, Up2);
Pos := Pos * Len2;
- if Up1 then
+ if Up2 then
Pos := Pos + Ghdl_Index_Type (Context.Ports (2).L - Left2);
else
- Pos := Pos + Ghdl_Index_Type (Left1 - Context.Ports (2).L);
+ Pos := Pos + Ghdl_Index_Type (Left2 - Context.Ports (2).L);
end if;
end if;
Vhpi_Handle_By_Index
@@ -608,8 +610,9 @@
end loop;
end Sdf_Start;
- function Sdf_Option (Opt : String) return Boolean
+ function Sdf_Option (Option : String) return Boolean
is
+ Opt : constant String (1 .. Option'Length) := Option;
begin
if Opt'Length > 11 and then Opt (1 .. 11) = "--sdf-dump=" then
Flag_Dump := True;
diff -urN ghdl-0.27/vhdl/grt/grt-vital_annotate.ads ghdl-0.28dev/vhdl/grt/grt-vital_annotate.ads
--- ghdl-0.27/vhdl/grt/grt-vital_annotate.ads 2005-09-23 00:18:59.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-vital_annotate.ads 2008-10-07 10:36:34.000000000 +0200
@@ -20,12 +20,12 @@
package Grt.Vital_Annotate is
pragma Elaborate_Body (Grt.Vital_Annotate);
- procedure Sdf_Header (Context : in out Sdf_Context_Type);
- procedure Sdf_Celltype (Context : in out Sdf_Context_Type);
+ procedure Sdf_Header (Context : Sdf_Context_Type);
+ procedure Sdf_Celltype (Context : Sdf_Context_Type);
procedure Sdf_Instance (Context : in out Sdf_Context_Type;
Instance : String;
Status : out Boolean);
- procedure Sdf_Instance_End (Context : in out Sdf_Context_Type;
+ procedure Sdf_Instance_End (Context : Sdf_Context_Type;
Status : out Boolean);
procedure Sdf_Generic (Context : in out Sdf_Context_Type;
Name : String;
diff -urN ghdl-0.27/vhdl/grt/grt-vpi.adb ghdl-0.28dev/vhdl/grt/grt-vpi.adb
--- ghdl-0.27/vhdl/grt/grt-vpi.adb 2007-12-06 06:22:54.000000000 +0100
+++ ghdl-0.28dev/vhdl/grt/grt-vpi.adb 2008-10-07 10:36:34.000000000 +0200
@@ -40,15 +40,17 @@
with Ada.Unchecked_Deallocation;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Signals; use Grt.Signals;
-with GNAT.Table;
+with Grt.Table;
with Grt.Astdio; use Grt.Astdio;
with Grt.Hooks; use Grt.Hooks;
with Grt.Vcd; use Grt.Vcd;
with Grt.Errors; use Grt.Errors;
with Grt.Rtis_Types;
+pragma Elaborate_All (Grt.Table);
package body Grt.Vpi is
-- The VPI interface requires libdl (dlopen, dlsym) to be linked in.
@@ -69,6 +71,7 @@
procedure dbgPut (Str : String)
is
S : size_t;
+ pragma Unreferenced (S);
begin
S := fwrite (Str'Address, Str'Length, 1, stderr);
end dbgPut;
@@ -76,6 +79,7 @@
procedure dbgPut (C : Character)
is
R : int;
+ pragma Unreferenced (R);
begin
R := fputc (Character'Pos (C), stderr);
end dbgPut;
@@ -722,12 +726,11 @@
Cb : s_cb_data;
end record;
- package Vpi_Table is new GNAT.Table
+ package Vpi_Table is new Grt.Table
(Table_Component_Type => Vpi_Var_Type,
Table_Index_Type => Vpi_Index_Type,
Table_Low_Bound => 0,
- Table_Initial => 32,
- Table_Increment => 100);
+ Table_Initial => 32);
function vpi_register_cb (Data : p_cb_data) return vpiHandle
is
@@ -865,7 +868,7 @@
-- Return TRUE if OPT is an option for VPI.
function Vpi_Option (Opt : String) return Boolean
is
- F : Natural := Opt'First;
+ F : constant Natural := Opt'First;
begin
if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vpi" then
return False;
@@ -918,6 +921,7 @@
procedure Vpi_Start
is
Res : Integer;
+ pragma Unreferenced (Res);
begin
if Vpi_Filename = null then
return;
@@ -935,6 +939,7 @@
procedure Vpi_Cycle
is
Res : Integer;
+ pragma Unreferenced (Res);
begin
if g_cbReadOnlySync /= null
and then g_cbReadOnlySync.Time.mLow < Integer (Sim_Time / 1_000_000)
@@ -959,6 +964,7 @@
procedure Vpi_End
is
Res : Integer;
+ pragma Unreferenced (Res);
begin
if g_cbEndOfSimulation /= null then
Res := g_cbEndOfSimulation.Cb_Rtn.all (g_cbEndOfSimulation);
diff -urN ghdl-0.27/vhdl/grt/grt-vstrings.adb ghdl-0.28dev/vhdl/grt/grt-vstrings.adb
--- ghdl-0.27/vhdl/grt/grt-vstrings.adb 2005-10-08 14:04:34.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-vstrings.adb 2008-10-07 10:36:34.000000000 +0200
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Errors; use Grt.Errors;
with Grt.C; use Grt.C;
@@ -41,7 +42,7 @@
procedure Grow (Vstr : in out Vstring; Sum : Natural)
is
- Nlen : Natural := Vstr.Len + Sum;
+ Nlen : constant Natural := Vstr.Len + Sum;
Nmax : Natural;
begin
Vstr.Len := Nlen;
@@ -72,7 +73,7 @@
procedure Append (Vstr : in out Vstring; Str : String)
is
- S : Natural := Vstr.Len;
+ S : constant Natural := Vstr.Len;
begin
Grow (Vstr, Str'Length);
Vstr.Str (S + 1 .. S + Str'Length) := Str;
@@ -80,8 +81,8 @@
procedure Append (Vstr : in out Vstring; Str : Ghdl_C_String)
is
- S : Natural := Vstr.Len;
- L : Natural := strlen (Str);
+ S : constant Natural := Vstr.Len;
+ L : constant Natural := strlen (Str);
begin
Grow (Vstr, L);
Vstr.Str (S + 1 .. S + L) := Str (1 .. L);
@@ -125,8 +126,8 @@
procedure Grow (Rstr : in out Rstring; Min : Natural)
is
- Len : Natural := Length (Rstr);
- Nlen : Natural := Len + Min;
+ Len : constant Natural := Length (Rstr);
+ Nlen : constant Natural := Len + Min;
Nstr : Fat_String_Acc;
Nfirst : Natural;
Nmax : Natural;
@@ -171,7 +172,7 @@
procedure Prepend (Rstr : in out Rstring; Str : Ghdl_C_String)
is
- L : Natural := strlen (Str);
+ L : constant Natural := strlen (Str);
begin
Grow (Rstr, L);
Rstr.First := Rstr.First - L;
@@ -199,6 +200,7 @@
procedure Put (Stream : FILEs; Rstr : Rstring)
is
S : size_t;
+ pragma Unreferenced (S);
begin
S := fwrite (Get_Address (Rstr), size_t (Length (Rstr)), 1, Stream);
end Put;
diff -urN ghdl-0.27/vhdl/grt/grt-waves.adb ghdl-0.28dev/vhdl/grt/grt-waves.adb
--- ghdl-0.27/vhdl/grt/grt-waves.adb 2008-05-19 06:26:36.000000000 +0200
+++ ghdl-0.28dev/vhdl/grt/grt-waves.adb 2008-10-07 10:36:34.000000000 +0200
@@ -19,16 +19,15 @@
with Ada.Unchecked_Deallocation;
with Interfaces; use Interfaces;
with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
with Grt.Types; use Grt.Types;
with Grt.Avhpi; use Grt.Avhpi;
with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Errors; use Grt.Errors;
-with Grt.Types; use Grt.Types;
with Grt.Astdio; use Grt.Astdio;
with Grt.Hooks; use Grt.Hooks;
-with Grt.Avhpi; use Grt.Avhpi;
-with GNAT.Table;
+with Grt.Table;
with Grt.Avls; use Grt.Avls;
with Grt.Rtis; use Grt.Rtis;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
@@ -39,6 +38,7 @@
with Grt.Vstrings; use Grt.Vstrings;
pragma Elaborate_All (Grt.Rtis_Utils);
+pragma Elaborate_All (Grt.Table);
package body Grt.Waves is
-- Waves filename.
@@ -62,10 +62,13 @@
Ghw_Hie_Port_Buffer : constant Unsigned_8 := 20; -- Port
Ghw_Hie_Port_Linkage : constant Unsigned_8 := 21; -- Port
+ pragma Unreferenced (Ghw_Hie_Design);
+ pragma Unreferenced (Ghw_Hie_Generic);
+
-- Return TRUE if OPT is an option for wave.
function Wave_Option (Opt : String) return Boolean
is
- F : Natural := Opt'First;
+ F : constant Natural := Opt'First;
begin
if Opt'Length < 6 or else Opt (F .. F + 5) /= "--wave" then
return False;
@@ -89,6 +92,7 @@
procedure Wave_Put (Str : String)
is
R : size_t;
+ pragma Unreferenced (R);
begin
R := fwrite (Str'Address, Str'Length, 1, Wave_Stream);
end Wave_Put;
@@ -96,6 +100,7 @@
procedure Wave_Putc (C : Character)
is
R : int;
+ pragma Unreferenced (R);
begin
R := fputc (Character'Pos (C), Wave_Stream);
end Wave_Putc;
@@ -109,6 +114,7 @@
is
V : Unsigned_8 := B;
R : size_t;
+ pragma Unreferenced (R);
begin
R := fwrite (V'Address, 1, 1, Wave_Stream);
end Wave_Put_Byte;
@@ -180,6 +186,7 @@
is
V : Ghdl_I32 := Val;
R : size_t;
+ pragma Unreferenced (R);
begin
R := fwrite (V'Address, 4, 1, Wave_Stream);
end Wave_Put_I32;
@@ -188,6 +195,7 @@
is
V : Ghdl_I64 := Val;
R : size_t;
+ pragma Unreferenced (R);
begin
R := fwrite (V'Address, 8, 1, Wave_Stream);
end Wave_Put_I64;
@@ -196,6 +204,7 @@
is
V : Ghdl_F64 := F64;
R : size_t;
+ pragma Unreferenced (R);
begin
R := fwrite (V'Address, Ghdl_F64'Size / Storage_Unit, 1, Wave_Stream);
end Wave_Put_F64;
@@ -229,12 +238,11 @@
Pos : long;
end record;
- package Section_Table is new GNAT.Table
+ package Section_Table is new Grt.Table
(Table_Component_Type => Header_Type,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
- Table_Initial => 16,
- Table_Increment => 100);
+ Table_Initial => 16);
-- Create a new section.
-- Write the header in the file.
@@ -270,13 +278,7 @@
Wave_Put_Byte (V);
end;
-- Word size, 1 byte.
- if Integer'Size = 32 then
- Wave_Put_Byte (4);
- elsif Integer'Size = 64 then
- Wave_Put_Byte (8);
- else
- Wave_Put_Byte (0);
- end if;
+ Wave_Put_Byte (Integer'Size / 8);
-- File offset size, 1 byte
Wave_Put_Byte (1);
-- Unused, must be zero (MBZ).
@@ -347,19 +349,17 @@
null;
end Avhpi_Error;
- package Str_Table is new GNAT.Table
+ package Str_Table is new Grt.Table
(Table_Component_Type => Ghdl_C_String,
Table_Index_Type => AVL_Value,
Table_Low_Bound => 1,
- Table_Initial => 16,
- Table_Increment => 100);
+ Table_Initial => 16);
- package Str_AVL is new GNAT.Table
+ package Str_AVL is new Grt.Table
(Table_Component_Type => AVL_Node,
Table_Index_Type => AVL_Nid,
Table_Low_Bound => AVL_Root,
- Table_Initial => 16,
- Table_Increment => 100);
+ Table_Initial => 16);
Strings_Len : Natural := 0;
@@ -394,6 +394,8 @@
New_Line (stdout);
end Disp_Str_Avl;
+ pragma Unreferenced (Disp_Str_Avl);
+
function Create_Str_Index (Str : Ghdl_C_String) return AVL_Value
is
Res : AVL_Nid;
@@ -414,6 +416,8 @@
return Str_AVL.Table (Res).Val;
end Create_Str_Index;
+ pragma Unreferenced (Create_Str_Index);
+
procedure Create_String_Id (Str : Ghdl_C_String)
is
Res : AVL_Nid;
@@ -472,23 +476,20 @@
Context : Rti_Context;
end record;
- package Types_Table is new GNAT.Table
+ package Types_Table is new Grt.Table
(Table_Component_Type => Type_Node,
Table_Index_Type => AVL_Value,
Table_Low_Bound => 1,
- Table_Initial => 16,
- Table_Increment => 100);
+ Table_Initial => 16);
- package Types_AVL is new GNAT.Table
+ package Types_AVL is new Grt.Table
(Table_Component_Type => AVL_Node,
Table_Index_Type => AVL_Nid,
Table_Low_Bound => AVL_Root,
- Table_Initial => 16,
- Table_Increment => 100);
+ Table_Initial => 16);
function Type_Compare (L, R : AVL_Value) return Integer
is
- use System;
function To_Ia is new
Ada.Unchecked_Conversion (Ghdl_Rti_Access, Integer_Address);
@@ -1049,6 +1050,8 @@
fflush (Wave_Stream);
end Write_Strings;
+ pragma Unreferenced (Write_Strings);
+
procedure Freeze_Strings
is
type Str_Table1_Type is array (1 .. Str_Table.Last) of Ghdl_C_String;
@@ -1380,18 +1383,19 @@
end Write_Known_Types;
-- Table of signals to be dumped.
- package Dump_Table is new GNAT.Table
+ package Dump_Table is new Grt.Table
(Table_Component_Type => Ghdl_Signal_Ptr,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
- Table_Initial => 32,
- Table_Increment => 100);
+ Table_Initial => 32);
function Get_Dump_Entry (N : Natural) return Ghdl_Signal_Ptr is
begin
return Dump_Table.Table (N);
end Get_Dump_Entry;
+ pragma Unreferenced (Get_Dump_Entry);
+
procedure Write_Hierarchy (Root : VhpiHandleT)
is
N : Natural;
diff -urN ghdl-0.27/vhdl/ieee-std_logic_1164.adb ghdl-0.28dev/vhdl/ieee-std_logic_1164.adb
--- ghdl-0.27/vhdl/ieee-std_logic_1164.adb 2006-06-17 02:33:52.000000000 +0200
+++ ghdl-0.28dev/vhdl/ieee-std_logic_1164.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/ieee-std_logic_1164.ads ghdl-0.28dev/vhdl/ieee-std_logic_1164.ads
--- ghdl-0.27/vhdl/ieee-std_logic_1164.ads 2005-09-22 23:11:00.000000000 +0200
+++ ghdl-0.28dev/vhdl/ieee-std_logic_1164.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/ieee-vital_timing.adb ghdl-0.28dev/vhdl/ieee-vital_timing.adb
--- ghdl-0.27/vhdl/ieee-vital_timing.adb 2006-06-17 02:20:00.000000000 +0200
+++ ghdl-0.28dev/vhdl/ieee-vital_timing.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
@@ -417,7 +417,7 @@
use Name_Table;
Len : Natural;
- P : Natural := Gen_Name_Pos;
+ P : constant Natural := Gen_Name_Pos;
C : Character;
begin
Len := 0;
@@ -969,8 +969,10 @@
(Decl : Iir_Constant_Interface_Declaration)
is
Oport : Iir;
+ pragma Unreferenced (Oport);
Pos : Natural;
Kind : Timing_Generic_Type_Kind;
+ pragma Unreferenced (Kind);
begin
if not Check_Timing_Generic_Prefix (Decl, 8) then
return;
@@ -1012,6 +1014,7 @@
Iport : Iir;
Oport : Iir;
Cport : Iir;
+ pragma Unreferenced (Cport);
Clock_Start : Natural;
Clock_End : Natural;
begin
diff -urN ghdl-0.27/vhdl/ieee-vital_timing.ads ghdl-0.28dev/vhdl/ieee-vital_timing.ads
--- ghdl-0.27/vhdl/ieee-vital_timing.ads 2005-09-22 23:11:20.000000000 +0200
+++ ghdl-0.28dev/vhdl/ieee-vital_timing.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/iir_chain_handling.adb ghdl-0.28dev/vhdl/iir_chain_handling.adb
--- ghdl-0.27/vhdl/iir_chain_handling.adb 2005-09-22 23:28:29.000000000 +0200
+++ ghdl-0.28dev/vhdl/iir_chain_handling.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
package body Iir_Chain_Handling is
diff -urN ghdl-0.27/vhdl/iir_chain_handling.ads ghdl-0.28dev/vhdl/iir_chain_handling.ads
--- ghdl-0.27/vhdl/iir_chain_handling.ads 2005-09-22 23:12:07.000000000 +0200
+++ ghdl-0.28dev/vhdl/iir_chain_handling.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/iir_chains.adb ghdl-0.28dev/vhdl/iir_chains.adb
--- ghdl-0.27/vhdl/iir_chains.adb 2005-09-22 23:28:48.000000000 +0200
+++ ghdl-0.28dev/vhdl/iir_chains.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
package body Iir_Chains is
diff -urN ghdl-0.27/vhdl/iir_chains.ads ghdl-0.28dev/vhdl/iir_chains.ads
--- ghdl-0.27/vhdl/iir_chains.ads 2007-03-28 00:42:59.000000000 +0200
+++ ghdl-0.28dev/vhdl/iir_chains.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,12 +12,12 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
with Iir_Chain_Handling;
-pragma Elaborate (Iir_Chain_Handling);
+pragma Elaborate_All (Iir_Chain_Handling);
package Iir_Chains is
-- Chains are simply linked list of iirs.
diff -urN ghdl-0.27/vhdl/iirs.adb ghdl-0.28dev/vhdl/iirs.adb
--- ghdl-0.27/vhdl/iirs.adb 2007-03-28 00:41:19.000000000 +0200
+++ ghdl-0.28dev/vhdl/iirs.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,10 +12,9 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Ada.Unchecked_Deallocation;
with Ada.Unchecked_Conversion;
with Ada.Text_IO;
with Errorout; use Errorout;
@@ -4157,6 +4156,30 @@
Set_State1 (Proc, Tri_State_Type'Pos (State));
end Set_Wait_State;
+ procedure Check_Kind_For_All_Sensitized_State (Target : Iir) is
+ begin
+ case Get_Kind (Target) is
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Procedure_Declaration =>
+ null;
+ when others =>
+ Failed ("All_Sensitized_State", Target);
+ end case;
+ end Check_Kind_For_All_Sensitized_State;
+
+ function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized is
+ begin
+ Check_Kind_For_All_Sensitized_State (Proc);
+ return Iir_All_Sensitized'Val (Get_State3 (Proc));
+ end Get_All_Sensitized_State;
+
+ procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized)
+ is
+ begin
+ Check_Kind_For_All_Sensitized_State (Proc);
+ Set_State3 (Proc, Iir_All_Sensitized'Pos (State));
+ end Set_All_Sensitized_State;
+
procedure Check_Kind_For_Seen_Flag (Target : Iir) is
begin
case Get_Kind (Target) is
diff -urN ghdl-0.27/vhdl/iirs.ads ghdl-0.28dev/vhdl/iirs.ads
--- ghdl-0.27/vhdl/iirs.ads 2007-03-28 00:41:02.000000000 +0200
+++ ghdl-0.28dev/vhdl/iirs.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Unchecked_Deallocation;
@@ -865,7 +865,7 @@
--
-- Subprogram declaration.
--
- -- The declaration containing this type declaration.
+ -- The declaration containing this subrogram declaration.
-- Get/Set_Parent (Field0)
--
-- Only for Iir_Kind_Function_Declaration:
@@ -913,10 +913,12 @@
-- Only for Iir_Kind_Function_Declaration:
-- Get/Set_Resolution_Function_Flag (Flag7)
--
+ -- Get/Set_Wait_State (State1)
+ --
-- Only for Iir_Kind_Procedure_Declaration:
-- Get/Set_Purity_State (State2)
--
- -- Get/Set_Wait_State (State1)
+ -- Get/Set_All_Sensitized_State (State3)
-- Iir_Kind_Function_Body (Short)
-- Iir_Kind_Procedure_Body (Short)
@@ -2973,6 +2975,23 @@
-- PURE.
type Iir_Pure_State is (Unknown, Pure, Maybe_Impure, Impure);
+ -- State of subprograms for validity of use in all-sensitized process.
+ -- INVALID_SIGNAL means that the subprogram is in a package and
+ -- reads a signal or that the subprogram calls (indirectly) such
+ -- a subprogram. In this case, the subprogram cannot be called from
+ -- an all-sensitized process.
+ -- READ_SIGNAL means that the subprogram reads a signal and is defined
+ -- in an entity or an architecture or that the subprogram calls
+ -- (indirectly) such a subprogram. In this case, the subprogram can
+ -- be called from an all-sensitized process and the reference will be
+ -- part of the sensitivity list.
+ -- NO_SIGNAL means that the subprogram doesn't read any signal and don't
+ -- call such a subprogram. The subprogram can be called from an
+ -- all-sensitized process but there is no need to track this call.
+ -- UNKNOWN means that the state is not yet defined.
+ type Iir_All_Sensitized is
+ (Unknown, No_Signal, Read_Signal, Invalid_Signal);
+
---------------
-- subranges --
---------------
@@ -4498,6 +4517,18 @@
function Get_Wait_State (Proc : Iir) return Tri_State_Type;
procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type);
+ -- Get/Set wether the subprogram may be called by a sensitized process
+ -- whose sensitivity list is ALL.
+ -- FALSE if declared in a package unit and reads a signal that is not
+ -- one of its interface, or if it calls such a subprogram.
+ -- TRUE if it doesn't call a subprogram whose state is False and
+ -- either doesn't read a signal or declared within an entity or
+ -- architecture.
+ -- UNKNOWN if the status is not yet known.
+ -- Field: State3 (pos)
+ function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized;
+ procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized);
+
-- Get/Set the seen flag.
-- Used when the graph of callees is walked, to avoid infinite loops, since
-- the graph is not a DAG (there may be cycles).
diff -urN ghdl-0.27/vhdl/iirs_utils.adb ghdl-0.28dev/vhdl/iirs_utils.adb
--- ghdl-0.27/vhdl/iirs_utils.adb 2007-09-19 00:08:18.000000000 +0200
+++ ghdl-0.28dev/vhdl/iirs_utils.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,17 +12,16 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Types; use Types;
with Scan; use Scan;
with Tokens; use Tokens;
with Errorout; use Errorout;
with Name_Table;
with Str_Table;
with Std_Names; use Std_Names;
-with Flags;
+with Flags; use Flags;
package body Iirs_Utils is
-- Transform the current token into an iir literal.
@@ -653,7 +652,7 @@
function Is_Unidim_Array_Type (A_Type : Iir) return Boolean
is
- Base_Type : Iir := Get_Base_Type (A_Type);
+ Base_Type : constant Iir := Get_Base_Type (A_Type);
begin
if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition
and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1
@@ -838,6 +837,4 @@
end case;
end loop;
end Is_Signal_Object;
-
-
end Iirs_Utils;
diff -urN ghdl-0.27/vhdl/iirs_utils.ads ghdl-0.28dev/vhdl/iirs_utils.ads
--- ghdl-0.27/vhdl/iirs_utils.ads 2006-09-25 15:52:03.000000000 +0200
+++ ghdl-0.28dev/vhdl/iirs_utils.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/lang.opt ghdl-0.28dev/vhdl/lang.opt
--- ghdl-0.27/vhdl/lang.opt 2006-09-04 06:08:17.000000000 +0200
+++ ghdl-0.28dev/vhdl/lang.opt 2008-10-07 10:36:35.000000000 +0200
@@ -76,3 +76,11 @@
l
vhdl Joined Separate
-l<filename> Put list of files for link in <filename>
+
+C
+vhdl
+Allow any character in comments
+
+-mb-comments
+vhdl
+Allow any character in comments
\ No newline at end of file
diff -urN ghdl-0.27/vhdl/libraries.adb ghdl-0.28dev/vhdl/libraries.adb
--- ghdl-0.27/vhdl/libraries.adb 2008-06-16 06:41:40.000000000 +0200
+++ ghdl-0.28dev/vhdl/libraries.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO; use Ada.Text_IO;
@@ -29,7 +29,6 @@
with Tokens;
with Files_Map;
with Flags;
-with Std_Names;
with Std_Package;
package body Libraries is
@@ -114,7 +113,7 @@
Library: Iir_Library_Declaration)
return Boolean
is
- File_Name : String := Back_End.Library_To_File_Name (Library);
+ File_Name : constant String := Back_End.Library_To_File_Name (Library);
Fe : Source_File_Entry;
begin
Fe := Files_Map.Load_Source_File (Dir, Get_Identifier (File_Name));
@@ -362,7 +361,8 @@
if Dir = Null_Identifier then
-- Search in the library path.
declare
- File_Name : String := Back_End.Library_To_File_Name (Library);
+ File_Name : constant String :=
+ Back_End.Library_To_File_Name (Library);
L : Natural;
begin
for I in Pathes.First .. Pathes.Last loop
@@ -580,7 +580,6 @@
procedure Create_Virtual_Locations
is
use Files_Map;
- use Name_Table;
Implicit_Source_File : Source_File_Entry;
Command_Source_File : Source_File_Entry;
begin
@@ -1038,6 +1037,7 @@
end if;
Design_File := Get_Chain (Design_File);
end loop;
+ Last_Design_File := Design_File;
end if;
if Design_File /= Null_Iir
@@ -1140,7 +1140,7 @@
-- FIXME: directory
declare
use Files_Map;
- File_Name: String := Image (Work_Directory)
+ File_Name: constant String := Image (Work_Directory)
& Back_End.Library_To_File_Name (Library);
begin
Create (File, Out_File, File_Name);
@@ -1415,7 +1415,6 @@
Line, Off: Natural;
Pos: Source_Ptr;
Res: Iir;
- Library : Iir_Library_Declaration;
Design_File : Iir_Design_File;
Fe : Source_File_Entry;
begin
@@ -1425,7 +1424,6 @@
-- Load and parse the unit.
Design_File := Get_Design_File (Design_Unit);
- Library := Get_Library (Design_File);
Fe := Files_Map.Load_Source_File
(Get_Design_File_Directory (Design_File),
Get_Design_File_Filename (Design_File));
diff -urN ghdl-0.27/vhdl/libraries.ads ghdl-0.28dev/vhdl/libraries.ads
--- ghdl-0.27/vhdl/libraries.ads 2005-12-12 02:59:35.000000000 +0100
+++ ghdl-0.28dev/vhdl/libraries.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/lists.adb ghdl-0.28dev/vhdl/lists.adb
--- ghdl-0.27/vhdl/lists.adb 2005-09-22 23:29:51.000000000 +0200
+++ ghdl-0.28dev/vhdl/lists.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System;
@@ -36,11 +36,11 @@
Table_Initial => 128,
Table_Increment => 100);
- function Get_Max_Nbr_Elements (List : List_Type) return Natural;
- pragma Inline (Get_Max_Nbr_Elements);
+ --function Get_Max_Nbr_Elements (List : List_Type) return Natural;
+ --pragma Inline (Get_Max_Nbr_Elements);
- procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural);
- pragma Inline (Set_Max_Nbr_Elements);
+ --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural);
+ --pragma Inline (Set_Max_Nbr_Elements);
procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural);
pragma Inline (List_Set_Nbr_Elements);
@@ -55,15 +55,15 @@
Listt.Table (List).Nbr := Nbr;
end List_Set_Nbr_Elements;
- function Get_Max_Nbr_Elements (List : List_Type) return Natural is
- begin
- return Listt.Table (List).Max;
- end Get_Max_Nbr_Elements;
-
- procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural) is
- begin
- Listt.Table (List).Max := Max;
- end Set_Max_Nbr_Elements;
+ --function Get_Max_Nbr_Elements (List : List_Type) return Natural is
+ --begin
+ -- return Listt.Table (List).Max;
+ --end Get_Max_Nbr_Elements;
+
+ --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural) is
+ --begin
+ -- Listt.Table (List).Max := Max;
+ --end Set_Max_Nbr_Elements;
function Get_Nth_Element (List: List_Type; N: Natural)
return Node_Type
@@ -152,7 +152,7 @@
-- Add (append) an element only if it was not already present in the list.
procedure Add_Element (List: List_Type; El: Node_Type)
is
- Nbr : Natural := Get_Nbr_Elements (List);
+ Nbr : constant Natural := Get_Nbr_Elements (List);
begin
for I in 0 .. Nbr - 1 loop
if Listt.Table (List).Els (I) = El then
@@ -165,7 +165,7 @@
procedure Remove_Nth_Element (List: List_Type; N: Natural)
is
- Nbr : Natural := Get_Nbr_Elements (List);
+ Nbr : constant Natural := Get_Nbr_Elements (List);
begin
if N >= Nbr then
raise Program_Error;
diff -urN ghdl-0.27/vhdl/lists.ads ghdl-0.28dev/vhdl/lists.ads
--- ghdl-0.27/vhdl/lists.ads 2005-09-22 23:13:36.000000000 +0200
+++ ghdl-0.28dev/vhdl/lists.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/Makefile.in ghdl-0.28dev/vhdl/Makefile.in
--- ghdl-0.27/vhdl/Makefile.in 2008-07-01 01:59:58.000000000 +0200
+++ ghdl-0.28dev/vhdl/Makefile.in 2008-10-07 10:41:34.000000000 +0200
@@ -251,35 +251,44 @@
STD87_BSRCS := $(STD_SRCS:.vhdl=.v87)
STD93_BSRCS := $(STD_SRCS:.vhdl=.v93)
+STD08_BSRCS := $(STD_SRCS:.vhdl=.v08)
IEEE87_BSRCS := $(IEEE_SRCS:.vhdl=.v87)
IEEE93_BSRCS := $(IEEE_SRCS:.vhdl=.v93) $(MATH_SRCS)
SYNOPSYS87_BSRCS := $(SYNOPSYS_BSRCS)
SYNOPSYS93_BSRCS := $(SYNOPSYS_BSRCS)
MENTOR93_BSRCS := $(MENTOR_BSRCS)
-.PREFIXES: .vhdl .v93 .v87
+.PREFIXES: .vhdl .v93 .v87 .v08
%.v93: %.vhdl
sed -e '/--V87/s/^/ --/' < $< > $@
+%.v08: %.vhdl
+ sed -e '/--V87/s/^/ --/' < $< > $@
+
%.v87: %.vhdl
sed -e '/--V93/s/^/ --/' -e '/--START-V93/,/--END-V93/s/^/--/' \
< $< > $@
+STD87_DIR:=$(LIB87_DIR)/std
+IEEE87_DIR:=$(LIB87_DIR)/ieee
+SYN87_DIR:=$(LIB87_DIR)/synopsys
+
STD93_DIR:=$(LIB93_DIR)/std
IEEE93_DIR:=$(LIB93_DIR)/ieee
SYN93_DIR:=$(LIB93_DIR)/synopsys
MENTOR93_DIR:=$(LIB93_DIR)/mentor
-STD87_DIR:=$(LIB87_DIR)/std
-IEEE87_DIR:=$(LIB87_DIR)/ieee
-SYN87_DIR:=$(LIB87_DIR)/synopsys
+STD08_DIR:=$(LIB08_DIR)/std
-ANALYZE93:=$(ANALYZE) --std=93
ANALYZE87:=$(ANALYZE) --std=87
+ANALYZE93:=$(ANALYZE) --std=93
+ANALYZE08:=$(ANALYZE) --std=08
STD87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD87_BSRCS))
STD93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD93_BSRCS))
+STD08_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD08_BSRCS))
+
IEEE93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE93_BSRCS))
IEEE87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE87_BSRCS))
SYNOPSYS_SRCS=$(addprefix $(LIBSRC_DIR)/,$(SYNOPSYS_BSRCS))
@@ -375,6 +384,16 @@
done; \
cd $$prev
+std.v08: $(LIB08_DIR) $(STD08_SRCS) force
+ $(RM) -rf $(STD08_DIR)
+ mkdir $(STD08_DIR)
+ prev=`pwd`; cd $(STD08_DIR); \
+ for i in $(STD08_SRCS); do \
+ echo $$i; \
+ $(ANALYZE08) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \
+ done; \
+ cd $$prev
+
std87_standard.o: $(GHDL1)
$(GHDL1) --std=87 -quiet -o std_standard.s --compile-standard
../xgcc -c -o std_standard.o std_standard.s
@@ -432,7 +451,8 @@
# manufacturer, and operating system and assign each of those to its own
# variable.
-targ:=$(subst -, ,$(target))
+target1:=$(subst -gnu,,$(target))
+targ:=$(subst -, ,$(target1))
arch:=$(word 1,$(targ))
ifeq ($(words $(targ)),2)
osys:=$(word 2,$(targ))
@@ -512,10 +532,15 @@
$(GRT_RANLIB) $@
run-bind.adb: grt-force
- gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) ghdl_main \
- $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS)
+ gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) \
+ ghdl_main $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS)
gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali
+#system.ads:
+# sed -e "/Configurable_Run_Time/s/False/True/" \
+# -e "/Suppress_Standard_Library/s/False/True/" \
+# < `$(ADAC) -print-file-name=adainclude/system.ads` > $@
+
run-bind.o: run-bind.adb
$(GRT_ADACOMPILE)
diff -urN ghdl-0.27/vhdl/Make-lang.in ghdl-0.28dev/vhdl/Make-lang.in
--- ghdl-0.27/vhdl/Make-lang.in 2008-07-01 01:59:58.000000000 +0200
+++ ghdl-0.28dev/vhdl/Make-lang.in 2008-10-07 10:41:34.000000000 +0200
@@ -98,24 +98,16 @@
-I$(AGCC_GCCSRC_DIR)/libcpp/include
AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS)
-AGCC_LOCAL_OBJS=ortho-lang.o gcc-version.o
+AGCC_LOCAL_OBJS=ortho-lang.o
AGCC_DEPS := $(AGCC_LOCAL_OBJS)
AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
$(AGCC_GCCOBJ_DIR)gcc/toplev.o \
+ $(AGCC_GCCOBJ_DIR)gcc/attribs.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/BASE-VER
- -$(RM) -f $@
- echo '#include "version.h"' > $@
- 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
- $(CC) -c -o $@ $< $(AGCC_CFLAGS)
-
ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
$(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \
$(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h
@@ -140,7 +132,7 @@
-cargs $(CFLAGS) $(GHDL_ADAFLAGS)
$(GNATMAKE) -o $@ -aI$(srcdir)/vhdl -aOvhdl ortho_gcc-main \
-bargs -E -cargs $(CFLAGS) $(GHDL_ADAFLAGS) \
- -largs $(AGCC_OBJS) $(LIBS)
+ -largs $(AGCC_OBJS) $(LIBS) $(GMPLIBS)
# The driver for ghdl.
ghdl$(exeext): force
diff -urN ghdl-0.27/vhdl/name_table.adb ghdl-0.28dev/vhdl/name_table.adb
--- ghdl-0.27/vhdl/name_table.adb 2005-09-22 23:30:00.000000000 +0200
+++ ghdl-0.28dev/vhdl/name_table.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO; use Ada.Text_IO;
diff -urN ghdl-0.27/vhdl/name_table.ads ghdl-0.28dev/vhdl/name_table.ads
--- ghdl-0.27/vhdl/name_table.ads 2005-09-22 23:13:46.000000000 +0200
+++ ghdl-0.28dev/vhdl/name_table.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System;
diff -urN ghdl-0.27/vhdl/nodes.adb ghdl-0.28dev/vhdl/nodes.adb
--- ghdl-0.27/vhdl/nodes.adb 2006-08-19 23:27:50.000000000 +0200
+++ ghdl-0.28dev/vhdl/nodes.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with GNAT.Table;
@@ -45,10 +45,13 @@
Free_Chain : Node_Type := Null_Node;
+ -- Just to have the default value.
+ pragma Warnings (Off);
Init_Short : Node_Record (Format_Short);
Init_Medium : Node_Record (Format_Medium);
Init_Fp : Node_Record (Format_Fp);
Init_Int : Node_Record (Format_Int);
+ pragma Warnings (On);
function Create_Node (Format : Format_Type) return Node_Type
is
diff -urN ghdl-0.27/vhdl/nodes.ads ghdl-0.28dev/vhdl/nodes.ads
--- ghdl-0.27/vhdl/nodes.ads 2006-08-19 23:36:44.000000000 +0200
+++ ghdl-0.28dev/vhdl/nodes.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/options.adb ghdl-0.28dev/vhdl/options.adb
--- ghdl-0.27/vhdl/options.adb 1970-01-01 01:00:00.000000000 +0100
+++ ghdl-0.28dev/vhdl/options.adb 2008-10-07 10:36:36.000000000 +0200
@@ -0,0 +1,221 @@
+-- Command line options.
+-- Copyright (C) 2008 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
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Name_Table;
+with Libraries;
+with Scan;
+with Back_End; use Back_End;
+with Flags; use Flags;
+
+package body Options is
+ function Option_Warning (Opt: String; Val : Boolean) return Boolean is
+ begin
+-- if Opt = "undriven" then
+-- Warn_Undriven := True;
+ if Opt = "library" then
+ Warn_Library := Val;
+ elsif Opt = "default-binding" then
+ Warn_Default_Binding := Val;
+ elsif Opt = "binding" then
+ Warn_Binding := Val;
+ elsif Opt = "reserved" then
+ Warn_Reserved_Word := Val;
+ elsif Opt = "vital-generic" then
+ Warn_Vital_Generic := Val;
+ elsif Opt = "delayed-checks" then
+ Warn_Delayed_Checks := Val;
+ elsif Opt = "body" then
+ Warn_Body := Val;
+ elsif Opt = "specs" then
+ Warn_Specs := Val;
+ elsif Opt = "unused" then
+ Warn_Unused := Val;
+ elsif Opt = "error" then
+ Warn_Error := Val;
+ else
+ return False;
+ end if;
+ return True;
+ end Option_Warning;
+
+ function Parse_Option (Opt: String) return Boolean
+ is
+ Beg: constant Integer := Opt'First;
+ begin
+ if Opt'Length > 5 and then Opt (Beg .. Beg + 5) = "--std=" then
+ if Opt'Length = 8 then
+ if Opt (Beg + 6 .. Beg + 7) = "87" then
+ Vhdl_Std := Vhdl_87;
+ elsif Opt (Beg + 6 .. Beg + 7) = "93" then
+ Vhdl_Std := Vhdl_93;
+ elsif Opt (Beg + 6 .. Beg + 7) = "00" then
+ Vhdl_Std := Vhdl_00;
+ elsif Opt (Beg + 6 .. Beg + 7) = "02" then
+ Vhdl_Std := Vhdl_02;
+ elsif Opt (Beg + 6 .. Beg + 7) = "08" then
+ Vhdl_Std := Vhdl_08;
+ else
+ return False;
+ end if;
+ elsif Opt'Length = 9 and then Opt (Beg + 6 .. Beg + 8) = "93c" then
+ Vhdl_Std := Vhdl_93c;
+ else
+ return False;
+ end if;
+ elsif Opt'Length > 2 and then Opt (Beg .. Beg + 1) = "-P" then
+ Libraries.Add_Library_Path (Opt (Beg + 2 .. Opt'Last));
+ elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--workdir=" then
+ Libraries.Set_Work_Library_Path (Opt (Beg + 10 .. Opt'Last));
+ elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--warn-no-" then
+ return Option_Warning (Opt (Beg + 10 .. Opt'Last), False);
+ elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--warn-" then
+ return Option_Warning (Opt (Beg + 7 .. Opt'Last), True);
+ elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--work=" then
+ declare
+ use Name_Table;
+ begin
+ Name_Length := Opt'Last - (Beg + 7) + 1;
+ Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last);
+ Scan.Convert_Identifier;
+ Libraries.Work_Library_Name := Get_Identifier;
+ end;
+ elsif Opt = "-C" or else Opt = "--mb-comments" then
+ Mb_Comment := True;
+ elsif Opt = "--bootstrap" then
+ Bootstrap := True;
+ elsif Opt = "-fexplicit" then
+ Flag_Explicit := True;
+ elsif Opt = "--syn-binding" then
+ Flag_Syn_Binding := True;
+ elsif Opt = "--no-vital-checks" then
+ Flag_Vital_Checks := False;
+ elsif Opt = "--vital-checks" then
+ Flag_Vital_Checks := True;
+ elsif Opt = "-dp" then
+ Dump_Parse := True;
+ elsif Opt = "-ds" then
+ Dump_Sem := True;
+ elsif Opt = "-dc" then
+ Dump_Canon := True;
+ elsif Opt = "-da" then
+ Dump_Annotate := True;
+ elsif Opt = "--dall" then
+ Dump_All := True;
+ elsif Opt = "-dstats" then
+ Dump_Stats := True;
+ elsif Opt = "--lall" then
+ List_All := True;
+ elsif Opt = "-lv" then
+ List_Verbose := True;
+ elsif Opt = "-ls" then
+ List_Sem := True;
+ elsif Opt = "-lc" then
+ List_Canon := True;
+ elsif Opt = "-la" then
+ List_Annotate := True;
+ elsif Opt = "-v" then
+ Verbose := True;
+ elsif Opt = "--finteger64" then
+ Flag_Integer_64 := True;
+ elsif Opt = "--ftime32" then
+ Flag_Time_64 := False;
+-- elsif Opt'Length > 17
+-- and then Opt (Beg .. Beg + 17) = "--time-resolution="
+-- then
+-- Beg := Beg + 18;
+-- if Opt (Beg .. Beg + 1) = "fs" then
+-- Time_Resolution := 'f';
+-- elsif Opt (Beg .. Beg + 1) = "ps" then
+-- Time_Resolution := 'p';
+-- elsif Opt (Beg .. Beg + 1) = "ns" then
+-- Time_Resolution := 'n';
+-- elsif Opt (Beg .. Beg + 1) = "us" then
+-- Time_Resolution := 'u';
+-- elsif Opt (Beg .. Beg + 1) = "ms" then
+-- Time_Resolution := 'm';
+-- elsif Opt (Beg .. Beg + 2) = "sec" then
+-- Time_Resolution := 's';
+-- elsif Opt (Beg .. Beg + 2) = "min" then
+-- Time_Resolution := 'M';
+-- elsif Opt (Beg .. Beg + 1) = "hr" then
+-- Time_Resolution := 'h';
+-- else
+-- return False;
+-- end if;
+ elsif Back_End.Parse_Option /= null
+ and then Back_End.Parse_Option.all (Opt)
+ then
+ null;
+ else
+ return False;
+ end if;
+ return True;
+ end Parse_Option;
+
+ -- Disp help about these options.
+ procedure Disp_Options_Help
+ is
+ procedure P (S : String) renames Put_Line;
+ begin
+ P ("Main options:");
+ P (" --work=LIB use LIB as work library");
+ P (" --workdir=DIR use DIR for the file library");
+ P (" -PPATH add PATH in the library path list");
+ P (" --std=87/93/00/02/08 select vhdl 87/93/00/02/08 standard");
+ P (" --std=93c select vhdl 93 standard and allow 87 syntax");
+ P (" --[no-]vital-checks do [not] check VITAL restrictions");
+ P ("Warnings:");
+-- P (" --warn-undriven disp undriven signals");
+ P (" --warn-binding warns for component not bound");
+ P (" --warn-reserved warns use of 93 reserved words in vhdl87");
+ P (" --warn-library warns for redefinition of a design unit");
+ P (" --warn-vital-generic warns of non-vital generic names");
+ P (" --warn-delayed-checks warns for checks performed at elaboration");
+ P (" --warn-body warns for not necessary package body");
+ P (" --warn-specs warns if a all/others spec does not apply");
+ P (" --warn-unused warns if a subprogram is never used");
+ P (" --warn-error turns warnings into errors");
+-- P ("Simulation option:");
+-- P (" --time-resolution=UNIT set the resolution of type time");
+-- P (" UNIT can be fs, ps, ns, us, ms, sec, min or hr");
+-- P (" --assert-level=LEVEL set the level which stop the");
+-- P (" simulation. LEVEL is note, warning, error,");
+-- P (" failure or none");
+ P ("Illegal extensions:");
+ P (" -fexplicit give priority to explicitly declared operator");
+ P (" -C --mb-comments allow multi-bytes chars in a comment");
+ P (" --bootstrap allow --work=std");
+ P (" --syn-binding use synthesis default binding rule");
+ P ("Compilation list:");
+ P (" -ls after semantics");
+ P (" -lc after canon");
+ P (" -la after annotation");
+ P (" --lall -lX options apply to all files");
+ P (" -lv verbose list");
+ P (" -v disp compilation stages");
+ P ("Compilation dump:");
+ P (" -dp dump tree after parsing");
+ P (" -ds dump tree after semantics");
+ P (" -da dump tree after annotate");
+ P (" --dall -dX options apply to all files");
+ if Back_End.Disp_Option /= null then
+ Back_End.Disp_Option.all;
+ end if;
+ end Disp_Options_Help;
+
+end Options;
diff -urN ghdl-0.27/vhdl/options.ads ghdl-0.28dev/vhdl/options.ads
--- ghdl-0.27/vhdl/options.ads 1970-01-01 01:00:00.000000000 +0100
+++ ghdl-0.28dev/vhdl/options.ads 2008-10-07 10:36:36.000000000 +0200
@@ -0,0 +1,27 @@
+-- Command line options.
+-- Copyright (C) 2008 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
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+package Options is
+ -- Return true if opt is recognize by flags.
+ -- Note: std_names.std_names_initialize and files_map.init_pathes must have
+ -- been called before this subprogram.
+ function Parse_Option (Opt: String) return Boolean;
+
+ -- Disp help about these options.
+ procedure Disp_Options_Help;
+end Options;
diff -urN ghdl-0.27/vhdl/ortho_front.adb ghdl-0.28dev/vhdl/ortho_front.adb
--- ghdl-0.27/vhdl/ortho_front.adb 2006-08-16 08:23:58.000000000 +0200
+++ ghdl-0.28dev/vhdl/ortho_front.adb 2008-10-07 10:36:34.000000000 +0200
@@ -31,6 +31,7 @@
with Disp_Vhdl;
with Bug;
with Trans_Be;
+with Options;
package body Ortho_Front is
-- The action to be performed by the compiler.
@@ -197,18 +198,18 @@
end if;
return 2;
elsif Opt.all = "--help" then
- Flags.Disp_Options_Help;
+ Options.Disp_Options_Help;
return 1;
elsif Opt.all = "--expect-failure" then
Flag_Expect_Failure := True;
return 1;
elsif Opt'Length > 7 and then Opt (1 .. 7) = "--ghdl-" then
- if Flags.Parse_Option (Opt (7 .. Opt'Last)) then
+ if Options.Parse_Option (Opt (7 .. Opt'Last)) then
return 1;
else
return 0;
end if;
- elsif Flags.Parse_Option (Opt.all) then
+ elsif Options.Parse_Option (Opt.all) then
return 1;
else
return 0;
diff -urN ghdl-0.27/vhdl/ortho_ident.adb ghdl-0.28dev/vhdl/ortho_ident.adb
--- ghdl-0.27/vhdl/ortho_ident.adb 2005-09-13 15:01:58.000000000 +0200
+++ ghdl-0.28dev/vhdl/ortho_ident.adb 2008-10-07 10:36:35.000000000 +0200
@@ -7,6 +7,7 @@
(Id : O_Ident; Str : Address; Size : Integer)
return Boolean;
pragma Import (C, Compare_Identifier_String);
+ pragma Warnings (Off, Compare_Identifier_String);
function Get_Identifier (Str : String) return O_Ident is
begin
diff -urN ghdl-0.27/vhdl/ortho-lang.c ghdl-0.28dev/vhdl/ortho-lang.c
--- ghdl-0.27/vhdl/ortho-lang.c 2008-06-11 03:37:49.000000000 +0200
+++ ghdl-0.28dev/vhdl/ortho-lang.c 2008-10-07 10:36:35.000000000 +0200
@@ -247,7 +247,7 @@
{
tree n;
- input_location.line = 0;
+ input_location = BUILTINS_LOCATION;
/* Create a global binding. */
push_binding ();
@@ -372,13 +372,6 @@
}
}
-#if 0
-void
-linemap_init (void *s)
-{
-}
-#endif
-
extern int lang_parse_file (const char *filename);
static void
@@ -391,6 +384,9 @@
else
filename = in_fnames[0];
+ linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 1);
+ input_location = linemap_line_start (line_table, 0, 252);
+
if (!lang_parse_file (filename))
errorcount++;
else
@@ -398,19 +394,7 @@
cgraph_finalize_compilation_unit ();
cgraph_optimize ();
}
-}
-
-static void
-ortho_expand_function (tree fndecl)
-{
- if (DECL_CONTEXT (fndecl) != NULL_TREE)
- {
- push_function_context ();
- tree_rest_of_compilation (fndecl);
- pop_function_context ();
- }
- else
- tree_rest_of_compilation (fndecl);
+ linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
}
/* Called by the back-end or by the front-end when the address of EXP
@@ -610,6 +594,7 @@
make_decl_rtl (decl);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
+ DECL_SOURCE_LOCATION (decl) = input_location;
return decl;
}
@@ -653,32 +638,6 @@
return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
}
-/* Return the unsigned version of a TYPE_NODE, a scalar type. */
-static tree
-unsigned_type (tree type)
-{
- return type_for_size (TYPE_PRECISION (type), 1);
-}
-
-/* Return the signed version of a TYPE_NODE, a scalar type. */
-static tree
-signed_type (tree type)
-{
- return type_for_size (TYPE_PRECISION (type), 0);
-}
-
-/* Return a type the same as TYPE except unsigned or signed according to
- UNSIGNEDP. */
-static tree
-signed_or_unsigned_type (int unsignedp, tree type)
-{
- if (!INTEGRAL_TYPE_P (type)
- || TYPE_UNSIGNED (type) == unsignedp)
- return type;
- else
- return type_for_size (TYPE_PRECISION (type), unsignedp);
-}
-
#undef LANG_HOOKS_NAME
#define LANG_HOOKS_NAME "vhdl"
#undef LANG_HOOKS_IDENTIFIER_SIZE
@@ -752,23 +711,24 @@
union lang_tree_node
GTY((desc ("0"),
- chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+ chain_next ("(union lang_tree_node *) GENERIC_NEXT (&%h.generic)")))
{
- union tree_node GTY ((tag ("0"),
- desc ("tree_node_structure (&%h)")))
- generic;
+ union tree_node GTY ((tag ("0"))) generic;
};
struct lang_decl GTY(())
{
+ char dummy;
};
struct lang_type GTY (())
{
+ char dummy;
};
struct language_function GTY (())
{
+ char dummy;
};
struct chain_constr_type
@@ -1004,8 +964,7 @@
cur_binding_level->save_stack = 1;
args = tree_cons (NULL_TREE, fold_convert (size_type_node, size), NULL_TREE);
- res = build3 (CALL_EXPR, ptr_type_node, stack_alloc_function_ptr,
- args, NULL_TREE);
+ res = build_call_list (ptr_type_node, stack_alloc_function_ptr, args);
return fold_convert (rtype, res);
}
@@ -1074,9 +1033,9 @@
else
hi = s >> (8 * sizeof (HOST_WIDE_INT));
- res = build_int_cst_wide (ltype, lo, hi);
+ res = build_int_cst_wide (long_integer_type_node, lo, hi);
REAL_VALUE_FROM_INT (r_sign, lo, hi, DFmode);
- real_2expN (&r_exp, ex - 60);
+ real_2expN (&r_exp, ex - 60, DFmode);
real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
res = build_real (ltype, r);
return res;
@@ -1496,14 +1455,14 @@
ortho_mark_addressable (base);
- offset = fold_build2 (MULT_EXPR, TREE_TYPE (idx), idx,
+ idx = fold_convert (sizetype, idx);
+ offset = fold_build2 (MULT_EXPR, sizetype, 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));
+ res = build2 (POINTER_PLUS_EXPR, base_type, base, offset);
}
else
{
@@ -1606,7 +1565,7 @@
void
new_debug_line_decl (int line)
{
- input_location.line = line;
+ input_location = linemap_line_start (line_table, line, 252);
}
void
@@ -1806,6 +1765,8 @@
decl = build_decl (FUNCTION_DECL, interfaces->ident,
build_function_type (interfaces->rtype,
interfaces->param_list.first));
+ DECL_SOURCE_LOCATION (decl) = input_location;
+
is_global = current_function_decl == NULL_TREE
|| interfaces->storage == o_storage_external;
if (is_global)
@@ -1876,7 +1837,7 @@
DECL_SAVED_TREE (func) = bind;
/* Initialize the RTL code for the function. */
- allocate_struct_function (func);
+ allocate_struct_function (func, false);
/* Store the end of the function. */
cfun->function_end_locus = input_location;
@@ -1898,14 +1859,14 @@
cgraph_finalize_function (func, false);
current_function_decl = parent;
- cfun = NULL;
+ set_cfun (NULL);
}
void
new_debug_line_stmt (int line)
{
- input_location.line = line;
+ input_location = linemap_line_start (line_table, line, 252);
}
void
@@ -1948,10 +1909,9 @@
tree
new_function_call (struct o_assoc_list *assocs)
{
- return build3 (CALL_EXPR,
- TREE_TYPE (TREE_TYPE (assocs->subprg)),
- build_function_ptr (assocs->subprg),
- assocs->list.first, NULL_TREE);
+ return build_call_list (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+ build_function_ptr (assocs->subprg),
+ assocs->list.first);
}
void
@@ -1959,10 +1919,9 @@
{
tree res;
- res = build3 (CALL_EXPR,
- TREE_TYPE (TREE_TYPE (assocs->subprg)),
- build_function_ptr (assocs->subprg),
- assocs->list.first, NULL_TREE);
+ res = build_call_list (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+ build_function_ptr (assocs->subprg),
+ assocs->list.first);
TREE_SIDE_EFFECTS (res) = 1;
append_stmt (res);
}
@@ -1987,7 +1946,8 @@
res = DECL_RESULT (current_function_decl);
assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
TREE_SIDE_EFFECTS (assign) = 1;
- stmt = build1 (RETURN_EXPR, TREE_TYPE (value), assign);
+ stmt = build1 (RETURN_EXPR, void_type_node, assign);
+ TREE_SIDE_EFFECTS (stmt) = 1;
append_stmt (stmt);
}
diff -urN ghdl-0.27/vhdl/parse.adb ghdl-0.28dev/vhdl/parse.adb
--- ghdl-0.27/vhdl/parse.adb 2007-05-05 06:59:33.000000000 +0200
+++ ghdl-0.28dev/vhdl/parse.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,9 +12,10 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
+with Iir_Chains; use Iir_Chains;
with Ada.Text_IO; use Ada.Text_IO;
with Types; use Types;
with Tokens; use Tokens;
@@ -22,10 +23,9 @@
with Iirs_Utils; use Iirs_Utils;
with Errorout; use Errorout;
with Std_Names; use Std_Names;
-with Flags;
+with Flags; use Flags;
with Name_Table;
with Str_Table;
-with Iir_Chains; use Iir_Chains;
with Xrefs;
-- Recursive descendant parser.
@@ -97,7 +97,6 @@
-- Otherwise, accept the current_token (ie set it to tok_invalid, unless
-- TOKEN is Tok_Identifier).
procedure Expect (Token: Token_Type; Msg: String := "") is
- use Errorout;
begin
if Current_Token /= Token then
if Msg'Length > 0 then
@@ -857,6 +856,7 @@
is
Res : Iir;
Old : Iir;
+ pragma Unreferenced (Old);
begin
Res := Parse_Name (Allow_Indexes => False);
if Check_Paren and then Current_Token = Tok_Left_Paren then
@@ -3459,7 +3459,7 @@
--
-- [ §9.5 ]
-- options ::= [ GUARDED ] [ delay_mechanism ]
- procedure Parse_Options (Stmt : in out Iir) is
+ procedure Parse_Options (Stmt : Iir) is
begin
if Current_Token = Tok_Guarded then
Set_Guard (Stmt, Stmt);
@@ -4191,6 +4191,7 @@
Subprg: Iir;
Subprg_Body : Iir;
Old : Iir;
+ pragma Unreferenced (Old);
begin
-- Create the node.
case Current_Token is
@@ -4341,16 +4342,16 @@
-- precond: PROCESS
-- postcond: null
--
- -- [ §9.2 ]
+ -- [ LRM87 9.2 / LRM08 11.3 ]
-- process_statement ::=
-- [ PROCESS_label : ]
- -- [ POSTPONED ] PROCESS [ ( sensitivity_list ) ] [ IS ]
+ -- [ POSTPONED ] PROCESS [ ( process_sensitivity_list ) ] [ IS ]
-- process_declarative_part
-- BEGIN
-- process_statement_part
-- END [ POSTPONED ] PROCESS [ PROCESS_label ] ;
--
- -- FIXME: POSTPONED
+ -- process_sensitivity_list ::= ALL | sensitivity_list
function Parse_Process_Statement
(Label: Name_Id; Loc : Location_Type; Is_Postponed : Boolean)
return Iir
@@ -4364,9 +4365,18 @@
if Current_Token = Tok_Left_Paren then
Res := Create_Iir (Iir_Kind_Sensitized_Process_Statement);
Scan.Scan;
- Sensitivity_List := Create_Iir_List;
+ if Current_Token = Tok_All then
+ if Vhdl_Std < Vhdl_08 then
+ Error_Msg_Parse
+ ("all sensitized process allowed only in vhdl 08");
+ end if;
+ Sensitivity_List := Iir_List_All;
+ Scan.Scan;
+ else
+ Sensitivity_List := Create_Iir_List;
+ Parse_Sensitivity_List (Sensitivity_List);
+ end if;
Set_Sensitivity_List (Res, Sensitivity_List);
- Parse_Sensitivity_List (Sensitivity_List);
Expect (Tok_Right_Paren);
Scan.Scan;
else
diff -urN ghdl-0.27/vhdl/parse.ads ghdl-0.28dev/vhdl/parse.ads
--- ghdl-0.27/vhdl/parse.ads 2005-09-22 23:14:25.000000000 +0200
+++ ghdl-0.28dev/vhdl/parse.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/post_sems.adb ghdl-0.28dev/vhdl/post_sems.adb
--- ghdl-0.27/vhdl/post_sems.adb 2005-09-22 23:30:26.000000000 +0200
+++ ghdl-0.28dev/vhdl/post_sems.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/post_sems.ads ghdl-0.28dev/vhdl/post_sems.ads
--- ghdl-0.27/vhdl/post_sems.ads 2005-09-22 23:14:56.000000000 +0200
+++ ghdl-0.28dev/vhdl/post_sems.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/scan.adb ghdl-0.28dev/vhdl/scan.adb
--- ghdl-0.27/vhdl/scan.adb 2005-09-22 23:31:03.000000000 +0200
+++ ghdl-0.28dev/vhdl/scan.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,12 +12,11 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Characters.Handling;
-with Tokens; use Tokens;
with Errorout; use Errorout;
with Name_Table;
with Files_Map; use Files_Map;
diff -urN ghdl-0.27/vhdl/scan.ads ghdl-0.28dev/vhdl/scan.ads
--- ghdl-0.27/vhdl/scan.ads 2005-09-22 23:15:11.000000000 +0200
+++ ghdl-0.28dev/vhdl/scan.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/scan-scan_literal.adb ghdl-0.28dev/vhdl/scan-scan_literal.adb
--- ghdl-0.27/vhdl/scan-scan_literal.adb 2006-07-10 00:57:35.000000000 +0200
+++ ghdl-0.28dev/vhdl/scan-scan_literal.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Unchecked_Conversion;
diff -urN ghdl-0.27/vhdl/sem.adb ghdl-0.28dev/vhdl/sem.adb
--- ghdl-0.27/vhdl/sem.adb 2007-03-28 01:31:05.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,11 +12,10 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Unchecked_Conversion;
-with Types; use Types;
with Errorout; use Errorout;
with Std_Package; use Std_Package;
with Libraries;
@@ -28,7 +27,7 @@
with Sem_Decls; use Sem_Decls;
with Sem_Assocs; use Sem_Assocs;
with Iirs_Utils; use Iirs_Utils;
-with Flags;
+with Flags; use Flags;
with Name_Table;
with Str_Table;
with Sem_Stmts; use Sem_Stmts;
@@ -198,11 +197,11 @@
-- considered to occur immediatly within the declarative region
-- associated with the entity declaration corresponding to the given
-- architecture body.
- if Flags.Vhdl_Std >= Vhdl_02 then
+ if Vhdl_Std >= Vhdl_02 then
Open_Declarative_Region;
end if;
Sem_Block (Arch, True);
- if Flags.Vhdl_Std >= Vhdl_02 then
+ if Vhdl_Std >= Vhdl_02 then
Close_Declarative_Region;
end if;
@@ -479,6 +478,7 @@
then
declare
P : Boolean;
+ pragma Unreferenced (P);
begin
P := Check_Port_Association_Restriction
(Get_Base_Name (Formal), Prefix, El);
@@ -827,7 +827,6 @@
begin
El := Get_Declaration_Chain (Block_Conf);
while El /= Null_Iir loop
- exit when El = Null_Iir;
case Get_Kind (El) is
when Iir_Kind_Use_Clause =>
Sem_Use_Clause (El);
@@ -1107,7 +1106,7 @@
end if;
El_Left := Get_Default_Value (Left);
El_Right := Get_Default_Value (Right);
- if ((El_Left = Null_Iir) xor (El_Right = Null_Iir)) = True then
+ if (El_Left = Null_Iir) xor (El_Right = Null_Iir) then
return False;
end if;
if El_Left /= Null_Iir
@@ -1513,7 +1512,7 @@
begin
-- Set depth.
declare
- Parent : Iir := Get_Parent (Subprg);
+ Parent : constant Iir := Get_Parent (Subprg);
begin
case Get_Kind (Parent) is
when Iir_Kind_Function_Declaration
@@ -1542,12 +1541,14 @@
Sem_Interface_Chain (Interface_Chain, Interface_Function);
Set_Return_Type
(Subprg, Sem_Subtype_Indication (Get_Return_Type (Subprg)));
+ Set_All_Sensitized_State (Subprg, Unknown);
when Iir_Kind_Procedure_Declaration =>
Sem_Interface_Chain (Interface_Chain, Interface_Procedure);
-- Unless the body is analyzed, the procedure purity is unknown.
Set_Purity_State (Subprg, Unknown);
-- Check if the procedure is passive.
Set_Passive_Flag (Subprg, True);
+ Set_All_Sensitized_State (Subprg, Unknown);
declare
Inter : Iir;
begin
@@ -1605,7 +1606,7 @@
procedure Add_Analysis_Checks_List (El : Iir)
is
- Design : Iir := Get_Current_Design_Unit;
+ Design : constant Iir := Get_Current_Design_Unit;
List : Iir_List;
begin
List := Get_Analysis_Checks_List (Design);
@@ -1625,7 +1626,7 @@
Set_Impure_Depth (Subprg, Iir_Depth_Pure);
-- LRM 10.1 Declarative regions
- -- 3. A subprogram declaration, together with thr corresponding
+ -- 3. A subprogram declaration, together with the corresponding
-- subprogram body.
Open_Declarative_Region;
Set_Is_Within_Flag (Spec, True);
@@ -1647,7 +1648,7 @@
case Get_Kind (Spec) is
when Iir_Kind_Procedure_Declaration =>
- -- Update purity state of procedure.
+ -- Update purity state of procedure if there are no callees.
case Get_Purity_State (Spec) is
when Pure
| Maybe_Impure =>
@@ -1666,7 +1667,8 @@
end if;
end if;
end case;
- -- Update wait state if necessary.
+
+ -- Update wait state if the state of all callees is known.
if Get_Wait_State (Spec) = Unknown then
declare
Callees : Iir_List;
@@ -1706,6 +1708,17 @@
end if;
end;
end if;
+
+ -- Set All_Sensitized_State in trivial cases.
+ if Get_All_Sensitized_State (Spec) = Unknown
+ and then Get_Callees_List (Spec) = Null_Iir_List
+ then
+ Set_All_Sensitized_State (Spec, No_Signal);
+ end if;
+
+ -- Do not add to Analysis_Check_List as procedures can't
+ -- generate purity/wait/all-sensitized errors by themselves.
+
when Iir_Kind_Function_Declaration =>
if Get_Callees_List (Spec) /= Null_Iir_List then
-- Purity calls to be checked later.
@@ -1720,11 +1733,11 @@
-- Status of Update_And_Check_Pure_Wait.
type Update_Pure_Status is
(
- -- The purity is computed and known.
+ -- The purity/wait/all-sensitized are computed and known.
Update_Pure_Done,
- -- A missing body prevents from computing the purity.
+ -- A missing body prevents from computing the purity/wait/all-sensitized
Update_Pure_Missing,
- -- Purity is unknown (recursion).
+ -- Purity/wait/all-sensitized is unknown (recursion).
Update_Pure_Unknown
);
function Update_And_Check_Pure_Wait (Subprg : Iir)
@@ -1752,7 +1765,6 @@
-- Current purity depth of SUBPRG.
Depth : Iir_Int32;
Depth_Callee : Iir_Int32;
- Has_Pure_Errors : Boolean := False;
Has_Wait_Errors : Boolean := False;
Npos : Natural;
Res, Res1 : Update_Pure_Status;
@@ -1767,24 +1779,32 @@
else
Depth := Iir_Depth_Impure;
end if;
+
when Iir_Kind_Procedure_Declaration =>
Kind := K_Procedure;
if Get_Purity_State (Subprg) = Impure
and then Get_Wait_State (Subprg) /= Unknown
+ and then Get_All_Sensitized_State (Subprg) /= Unknown
then
-- No need to go further.
- Destroy_Iir_List (Callees_List);
- Set_Callees_List (Subprg, Null_Iir_List);
+ if Get_All_Sensitized_State (Subprg) = No_Signal
+ or else Vhdl_Std < Vhdl_08
+ then
+ Destroy_Iir_List (Callees_List);
+ Set_Callees_List (Subprg, Null_Iir_List);
+ end if;
return Update_Pure_Done;
end if;
Subprg_Bod := Get_Subprogram_Body (Subprg);
Subprg_Depth := Get_Subprogram_Depth (Subprg);
Depth := Get_Impure_Depth (Subprg_Bod);
+
when Iir_Kind_Sensitized_Process_Statement =>
Kind := K_Process;
Subprg_Bod := Null_Iir;
Subprg_Depth := Iir_Depth_Top;
Depth := Iir_Depth_Impure;
+
when others =>
Error_Kind ("update_and_check_pure_wait(1)", Subprg);
end case;
@@ -1815,12 +1835,9 @@
Callee := Get_Nth_Element (Callees_List, I);
exit when Callee = Null_Iir;
- -- Only procedures should appear in the list:
+ -- Note:
-- Pure functions should not be in the list.
-- Impure functions must have directly set Purity_State.
- if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then
- Error_Kind ("update_and_check_pure_wait(3)", Callee);
- end if;
-- Check pure.
Callee_Bod := Get_Subprogram_Body (Callee);
@@ -1831,8 +1848,11 @@
Res := Update_Pure_Missing;
else
-- Second loop: recurse if a state is not known.
- if J = 1 and then (Get_Purity_State (Callee) = Unknown
- or else Get_Wait_State (Callee) = Unknown)
+ if J = 1
+ and then
+ (Get_Purity_State (Callee) = Unknown
+ or else Get_Wait_State (Callee) = Unknown
+ or else Get_All_Sensitized_State (Callee) = Unknown)
then
Res1 := Update_And_Check_Pure_Wait (Callee);
if Res1 = Update_Pure_Missing then
@@ -1852,7 +1872,6 @@
Depth_Callee := Iir_Depth_Impure;
if Kind = K_Function then
Error_Pure (Subprg, Callee, Null_Iir);
- Has_Pure_Errors := True;
end if;
end if;
@@ -1882,19 +1901,55 @@
end if;
end if;
+ if Get_All_Sensitized_State (Callee) = Invalid_Signal then
+ case Kind is
+ when K_Function | K_Procedure =>
+ Set_All_Sensitized_State (Subprg, Invalid_Signal);
+ when K_Process =>
+ -- LRM08 11.3
+ --
+ -- It is an error if a process statement with the
+ -- reserved word ALL as its process sensitivity list
+ -- is the parent of a subprogram declared in a design
+ -- unit other than that containing the process statement
+ -- and the subprogram reads an explicitly declared
+ -- signal that is not a formal signal parameter or
+ -- member of a formal signal parameter of the
+ -- subprogram or of any of its parents. Similarly,
+ -- it is an error if such subprogram reads an implicit
+ -- signal whose explicit ancestor is not a formal signal
+ -- parameter or member of a formal parameter of
+ -- the subprogram or of any of its parents.
+ Error_Msg_Sem
+ ("all-sensitized " & Disp_Node (Subprg)
+ & " can't call " & Disp_Node (Callee), Subprg);
+ Error_Msg_Sem
+ (" (as this subprogram reads (indirectly) a signal)",
+ Subprg);
+ end case;
+ end if;
+
-- Keep in list.
if Callee_Bod = Null_Iir
- or else (Get_Purity_State (Callee) = Unknown
- and then Depth /= Iir_Depth_Impure)
- or else (Get_Wait_State (Callee) = Unknown
- and then (Kind /= K_Procedure
- or else Get_Wait_State (Subprg) = Unknown))
+ or else
+ (Get_Purity_State (Callee) = Unknown
+ and then Depth /= Iir_Depth_Impure)
+ or else
+ (Get_Wait_State (Callee) = Unknown
+ and then (Kind /= K_Procedure
+ or else Get_Wait_State (Subprg) = Unknown))
+ or else
+ (Vhdl_Std >= Vhdl_08
+ and then
+ (Get_All_Sensitized_State (Callee) = Unknown
+ or else Get_All_Sensitized_State (Callee) = Read_Signal))
then
Replace_Nth_Element (Callees_List, Npos, Callee);
Npos := Npos + 1;
end if;
end loop;
+ -- End of callee loop.
if Npos = 0 then
Destroy_Iir_List (Callees_List);
Callees_List := Null_Iir_List;
@@ -1906,6 +1961,11 @@
Set_Wait_State (Subprg, False);
end if;
end if;
+ if Kind = K_Procedure or Kind = K_Function then
+ if Get_All_Sensitized_State (Subprg) = Unknown then
+ Set_All_Sensitized_State (Subprg, No_Signal);
+ end if;
+ end if;
Res := Update_Pure_Done;
exit;
else
@@ -1918,6 +1978,9 @@
return Res;
end Update_And_Check_Pure_Wait;
+ -- Check pure/wait/all-sensitized issues for SUBPRG (subprogram or
+ -- process). Return False if the analysis is incomplete (and must
+ -- be deferred).
function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean
is
Res : Update_Pure_Status;
@@ -1939,6 +2002,11 @@
Set_Wait_State (Subprg, False);
end if;
end if;
+ if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then
+ if Get_All_Sensitized_State (Subprg) = Unknown then
+ Set_All_Sensitized_State (Subprg, No_Signal);
+ end if;
+ end if;
return True;
end case;
end Root_Update_And_Check_Pure_Wait;
diff -urN ghdl-0.27/vhdl/sem.ads ghdl-0.28dev/vhdl/sem.ads
--- ghdl-0.27/vhdl/sem.ads 2005-09-22 23:15:29.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_assocs.adb ghdl-0.28dev/vhdl/sem_assocs.adb
--- ghdl-0.27/vhdl/sem_assocs.adb 2007-03-14 00:22:40.000000000 +0100
+++ ghdl-0.28dev/vhdl/sem_assocs.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,12 +12,12 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Evaluation; use Evaluation;
with Errorout; use Errorout;
-with Flags;
+with Flags; use Flags;
with Types; use Types;
with Iirs_Utils; use Iirs_Utils;
with Sem_Names; use Sem_Names;
diff -urN ghdl-0.27/vhdl/sem_assocs.ads ghdl-0.28dev/vhdl/sem_assocs.ads
--- ghdl-0.27/vhdl/sem_assocs.ads 2005-09-22 23:15:42.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_assocs.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_decls.adb ghdl-0.28dev/vhdl/sem_decls.adb
--- ghdl-0.27/vhdl/sem_decls.adb 2008-05-31 10:49:44.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_decls.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,14 +12,14 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Errorout; use Errorout;
with Types; use Types;
with Std_Names;
with Tokens;
-with Flags;
+with Flags; use Flags;
with Std_Package; use Std_Package;
with Iir_Chains;
with Evaluation; use Evaluation;
@@ -31,8 +31,8 @@
with Sem_Names; use Sem_Names;
with Sem_Specs; use Sem_Specs;
with Sem_Types; use Sem_Types;
-with Iir_Chains; use Iir_Chains;
with Xrefs; use Xrefs;
+use Iir_Chains;
package body Sem_Decls is
-- Emit an error if the type of DECL is a file type, access type,
diff -urN ghdl-0.27/vhdl/sem_decls.ads ghdl-0.28dev/vhdl/sem_decls.ads
--- ghdl-0.27/vhdl/sem_decls.ads 2005-10-27 21:36:44.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_decls.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_expr.adb ghdl-0.28dev/vhdl/sem_expr.adb
--- ghdl-0.27/vhdl/sem_expr.adb 2008-04-25 06:10:31.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_expr.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,13 +12,12 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Types; use Types;
with Std_Package; use Std_Package;
with Errorout; use Errorout;
-with Flags;
+with Flags; use Flags;
with Sem_Scopes; use Sem_Scopes;
with Sem_Names; use Sem_Names;
with Sem;
@@ -731,8 +730,8 @@
Set_Expr_Staticness (Expr, Staticness);
end Set_Function_Call_Staticness;
- -- Add CALLEE in the calle list of SUBPRG (which must be a subprg decl).
- procedure Add_In_Callee_List (Subprg : Iir; Callee : Iir)
+ -- Add CALLEE in the callees list of SUBPRG (which must be a subprg decl).
+ procedure Add_In_Callees_List (Subprg : Iir; Callee : Iir)
is
List : Iir_List;
begin
@@ -744,7 +743,7 @@
-- FIXME: May use a flag in IMP to speed up the
-- add operation.
Add_Element (List, Callee);
- end Add_In_Callee_List;
+ end Add_In_Callees_List;
-- Check purity rules when SUBPRG calls CALLEE.
-- Both SUBPRG and CALLEE are subprogram declarations.
@@ -809,7 +808,7 @@
Depth := Get_Impure_Depth (Callee_Body);
when Unknown =>
-- Add in list.
- Add_In_Callee_List (Subprg, Callee);
+ Add_In_Callees_List (Subprg, Callee);
if Callee_Body /= Null_Iir then
Depth := Get_Impure_Depth (Callee_Body);
@@ -868,7 +867,7 @@
when True =>
null;
when Unknown =>
- Add_In_Callee_List (Subprg, Callee);
+ Add_In_Callees_List (Subprg, Callee);
return;
end case;
@@ -898,13 +897,88 @@
end case;
end Sem_Call_Wait_Check;
+ procedure Sem_Call_All_Sensitized_Check
+ (Subprg : Iir; Callee : Iir; Loc : Iir)
+ is
+ begin
+ -- No need to deal with 'process (all)' if standard predates it.
+ if Vhdl_Std < Vhdl_08 then
+ return;
+ end if;
+
+ -- If subprogram called is pure, then there is no signals reference.
+ case Get_Kind (Callee) is
+ when Iir_Kind_Function_Declaration =>
+ if Get_Pure_Flag (Callee) then
+ return;
+ end if;
+ when Iir_Kind_Procedure_Declaration =>
+ if Get_Purity_State (Callee) = Pure then
+ return;
+ end if;
+ when others =>
+ Error_Kind ("sem_call_all_sensitized_check", Callee);
+ end case;
+
+ case Get_All_Sensitized_State (Callee) is
+ when Invalid_Signal =>
+ case Get_Kind (Subprg) is
+ when Iir_Kind_Sensitized_Process_Statement =>
+ if Get_Sensitivity_List (Subprg) = Iir_List_All then
+ -- LRM08 11.3
+ --
+ -- It is an error if a process statement with the
+ -- reserved word ALL as its process sensitivity list
+ -- is the parent of a subprogram declared in a design
+ -- unit other than that containing the process statement
+ -- and the subprogram reads an explicitly declared
+ -- signal that is not a formal signal parameter or
+ -- member of a formal signal parameter of the
+ -- subprogram or of any of its parents. Similarly,
+ -- it is an error if such subprogram reads an implicit
+ -- signal whose explicit ancestor is not a formal signal
+ -- parameter or member of a formal parameter of
+ -- the subprogram or of any of its parents.
+ Error_Msg_Sem
+ ("all-sensitized " & Disp_Node (Subprg)
+ & " can't call " & Disp_Node (Callee), Loc);
+ Error_Msg_Sem
+ (" (as this subprogram reads (indirectly) a signal)",
+ Loc);
+ end if;
+ when Iir_Kind_Process_Statement =>
+ return;
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Procedure_Declaration =>
+ Set_All_Sensitized_State (Subprg, Invalid_Signal);
+ when others =>
+ Error_Kind ("sem_call_all_sensitized_check", Subprg);
+ end case;
+ when Read_Signal =>
+ -- Put this subprogram in callees list as it may read a signal.
+ -- Used by canon to build the sensitivity list.
+ Add_In_Callees_List (Subprg, Callee);
+ if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then
+ if Get_All_Sensitized_State (Subprg) < Read_Signal then
+ Set_All_Sensitized_State (Subprg, Read_Signal);
+ end if;
+ end if;
+ when Unknown =>
+ -- Put this subprogram in callees list as it may read a signal.
+ -- Used by canon to build the sensitivity list.
+ Add_In_Callees_List (Subprg, Callee);
+ when No_Signal =>
+ null;
+ end case;
+ end Sem_Call_All_Sensitized_Check;
+
-- Set IMP as the implementation to being called by EXPR.
-- If the context is a subprogram or a process (ie, if current_subprogram
-- is not NULL), then mark IMP as callee of current_subprogram, and
-- update states.
procedure Sem_Subprogram_Call_Finish (Expr : Iir; Imp : Iir)
is
- Subprg : Iir := Get_Current_Subprogram;
+ Subprg : constant Iir := Get_Current_Subprogram;
begin
Set_Implementation (Expr, Imp);
Set_Function_Call_Staticness (Expr, Imp);
@@ -930,9 +1004,11 @@
end if;
when Iir_Kind_Function_Declaration =>
Sem_Call_Purity_Check (Subprg, Imp, Expr);
+ Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr);
when Iir_Kind_Procedure_Declaration =>
Sem_Call_Purity_Check (Subprg, Imp, Expr);
Sem_Call_Wait_Check (Subprg, Imp, Expr);
+ Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr);
-- Check passive.
if Get_Passive_Flag (Imp) = False then
case Get_Kind (Subprg) is
@@ -1225,8 +1301,6 @@
procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir)
is
- use Iirs_Utils;
-
Imp: Iir;
Name : Iir;
Parameters_Chain : Iir;
@@ -1645,7 +1719,7 @@
function Check_Type_For_String_Literal (A_Type : Iir; Expr : Iir)
return Boolean
is
- Base_Type : Iir := Get_Base_Type (A_Type);
+ Base_Type : constant Iir := Get_Base_Type (A_Type);
El_Bt : Iir;
begin
-- LRM 7.3.1
@@ -1711,6 +1785,7 @@
Ptr : String_Fat_Acc;
El : Iir;
+ pragma Unreferenced (El);
Len : Natural;
begin
Len := Get_String_Length (Lit);
@@ -2420,7 +2495,7 @@
procedure Add_Match (El : Iir; Rec_El : Iir_Element_Declaration)
is
Ass_Type : Iir;
- Pos : Natural := Natural (Get_Element_Position (Rec_El));
+ Pos : constant Natural := Natural (Get_Element_Position (Rec_El));
begin
if Matches (Pos) /= Null_Iir then
Error_Msg_Sem
@@ -2634,7 +2709,6 @@
Constrained : Boolean;
Dim: Natural)
is
- Res: Boolean;
Assoc_Chain : Iir;
Choice: Iir;
Is_Positional: Tri_State_Type;
@@ -2655,7 +2729,6 @@
Info : Array_Aggr_Info renames Infos (Dim);
begin
- Res := True;
Index_List := Get_Index_Subtype_List (A_Type);
Index_Type := Get_Nth_Element (Index_List, Dim - 1);
@@ -2995,8 +3068,8 @@
is
A_Subtype: Iir;
Base_Type : Iir;
- Index_List : Iir_List := Get_Index_Subtype_List (Aggr_Type);
- Nbr_Dim : Natural := Get_Nbr_Elements (Index_List);
+ Index_List : constant Iir_List := Get_Index_Subtype_List (Aggr_Type);
+ Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
Infos : Array_Aggr_Info_Arr (1 .. Nbr_Dim);
Aggr_Constrained : Boolean;
Info, Prev_Info : Iir_Aggregate_Info;
diff -urN ghdl-0.27/vhdl/sem_expr.ads ghdl-0.28dev/vhdl/sem_expr.ads
--- ghdl-0.27/vhdl/sem_expr.ads 2007-03-24 08:22:14.000000000 +0100
+++ ghdl-0.28dev/vhdl/sem_expr.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/sem_names.adb ghdl-0.28dev/vhdl/sem_names.adb
--- ghdl-0.27/vhdl/sem_names.adb 2007-08-03 02:46:48.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_names.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,14 +12,14 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Evaluation; use Evaluation;
with Iirs_Utils; use Iirs_Utils;
with Libraries;
with Errorout; use Errorout;
-with Flags;
+with Flags; use Flags;
with Name_Table;
with Std_Package; use Std_Package;
with Types; use Types;
@@ -168,10 +168,10 @@
-- Move elements of result list LIST to result list RES.
-- Destroy LIST if necessary.
- procedure Add_Result_List (Res : in out Iir; List : in out Iir);
+ procedure Add_Result_List (Res : in out Iir; List : Iir);
pragma Unreferenced (Add_Result_List);
- procedure Add_Result_List (Res : in out Iir; List : in out Iir)
+ procedure Add_Result_List (Res : in out Iir; List : Iir)
is
El : Iir;
List_List : Iir_List;
@@ -201,9 +201,9 @@
end Add_Result_List;
-- Free interpretations of LIST except KEEP.
- procedure Sem_Name_Free_Result (List : in out Iir; Keep : Iir)
+ procedure Sem_Name_Free_Result (List : Iir; Keep : Iir)
is
- procedure Sem_Name_Free (El : in out Iir) is
+ procedure Sem_Name_Free (El : Iir) is
begin
case Get_Kind (El) is
when Iir_Kind_Function_Call
@@ -560,7 +560,6 @@
Prefix_Bt : Iir;
Index_List: Iir_List;
Index_Type: Iir;
- Index_Range : Iir;
Suffix: Iir;
Slice_Type : Iir;
Expr_Type : Iir;
@@ -591,7 +590,6 @@
end if;
Index_Type := Get_First_Element (Index_List);
- Index_Range := Get_Range_Constraint (Index_Type);
Prefix_Rng := Eval_Range (Index_Type);
-- LRM93 6.5
@@ -1085,7 +1083,7 @@
& Disp_Node (Subprg), Loc);
end Error_Pure;
- Subprg : Iir := Sem_Stmts.Get_Current_Subprogram;
+ Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram;
Subprg_Body : Iir;
Parent : Iir;
begin
@@ -1181,6 +1179,32 @@
end case;
end Sem_Check_Pure;
+ -- Set All_Sensitized_State to False iff OBJ is a signal declaration
+ -- and the current subprogram is in a package body.
+ procedure Sem_Check_All_Sensitized (Obj : Iir)
+ is
+ Subprg : Iir;
+ begin
+ -- We cares only of signals.
+ if Get_Kind (Obj) /= Iir_Kind_Signal_Declaration then
+ return;
+ end if;
+ -- We cares only of subprograms. Give up if we are in a process.
+ Subprg := Sem_Stmts.Get_Current_Subprogram;
+ if Subprg = Null_Iir
+ or else Get_Kind (Subprg) not in Iir_Kinds_Subprogram_Declaration
+ then
+ return;
+ end if;
+ if Get_Kind (Get_Library_Unit (Sem.Get_Current_Design_Unit))
+ = Iir_Kind_Package_Body
+ then
+ Set_All_Sensitized_State (Subprg, Invalid_Signal);
+ else
+ Set_All_Sensitized_State (Subprg, Read_Signal);
+ end if;
+ end Sem_Check_All_Sensitized;
+
procedure Finish_Sem_Name (Name : Iir; Res : Iir)
is
Pfx : Iir;
@@ -1336,7 +1360,7 @@
is
Sub_Res : Iir;
begin
- if Get_Is_Within_Flag (Sub_Name) = True then
+ if Get_Is_Within_Flag (Sub_Name) then
Sub_Res := Find_Declarations_In_List (Sub_Name, Name, Keep_Alias);
if Sub_Res /= Null_Iir then
Add_Result (Res, Sub_Res);
@@ -2465,7 +2489,13 @@
-- Set_Parameter (Res, Param);
-- end if;
-- end if;
+
if Get_Kind (Prefix) = Iir_Kind_Signal_Interface_Declaration then
+ -- LRM93 2.1.1.2 / LRM08 4.2.2.3
+ --
+ -- It is an error if signal-valued attributes 'STABLE , 'QUIET,
+ -- 'TRANSACTION, and 'DELAYED of formal signal paramaters of any
+ -- mode are read within a subprogram.
case Get_Kind (Get_Parent (Prefix)) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
@@ -2917,6 +2947,7 @@
when Iir_Kinds_Object_Declaration =>
Set_Base_Name (Name, Expr);
Sem_Check_Pure (Name, Expr);
+ Sem_Check_All_Sensitized (Expr);
when Iir_Kind_Indexed_Name
| Iir_Kind_Slice_Name
| Iir_Kind_Selected_Element
@@ -2935,6 +2966,7 @@
end if;
end loop;
Sem_Check_Pure (Name, E);
+ Sem_Check_All_Sensitized (E);
end;
when Iir_Kind_Enumeration_Literal
| Iir_Kind_Unit_Declaration =>
diff -urN ghdl-0.27/vhdl/sem_names.ads ghdl-0.28dev/vhdl/sem_names.ads
--- ghdl-0.27/vhdl/sem_names.ads 2006-08-25 04:43:19.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_names.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_scopes.adb ghdl-0.28dev/vhdl/sem_scopes.adb
--- ghdl-0.27/vhdl/sem_scopes.adb 2005-09-22 23:32:11.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_scopes.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,12 +12,11 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Text_IO;
with GNAT.Table;
-with Types; use Types;
with Name_Table; -- use Name_Table;
with Errorout; use Errorout;
with Iirs_Utils;
diff -urN ghdl-0.27/vhdl/sem_scopes.ads ghdl-0.28dev/vhdl/sem_scopes.ads
--- ghdl-0.27/vhdl/sem_scopes.ads 2005-09-22 23:16:35.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_scopes.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_specs.adb ghdl-0.28dev/vhdl/sem_specs.adb
--- ghdl-0.27/vhdl/sem_specs.adb 2006-07-14 22:48:59.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_specs.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
@@ -21,7 +21,6 @@
with Sem_Names; use Sem_Names;
with Evaluation; use Evaluation;
with Std_Package; use Std_Package;
-with Tokens;
with Errorout; use Errorout;
with Sem; use Sem;
with Sem_Scopes; use Sem_Scopes;
@@ -29,7 +28,7 @@
with Libraries;
with Iir_Chains; use Iir_Chains;
with Sem_Types;
-with Flags;
+with Flags; use Flags;
with Name_Table;
with Std_Names;
with Sem_Decls;
diff -urN ghdl-0.27/vhdl/sem_specs.ads ghdl-0.28dev/vhdl/sem_specs.ads
--- ghdl-0.27/vhdl/sem_specs.ads 2005-09-22 23:21:38.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_specs.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_stmts.adb ghdl-0.28dev/vhdl/sem_stmts.adb
--- ghdl-0.27/vhdl/sem_stmts.adb 2007-03-14 00:03:10.000000000 +0100
+++ ghdl-0.28dev/vhdl/sem_stmts.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,12 +12,12 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Errorout; use Errorout;
with Types; use Types;
-with Flags;
+with Flags; use Flags;
with Sem_Specs; use Sem_Specs;
with Std_Package; use Std_Package;
with Sem; use Sem;
@@ -791,7 +791,7 @@
-- Return FALSE in case of violation.
function Check_Odcat_Expression (Expr : Iir) return Boolean
is
- Expr_Type : Iir := Get_Type (Expr);
+ Expr_Type : constant Iir := Get_Type (Expr);
begin
-- LRM 8.8 Case Statement
-- If the expression is of a one-dimensional character array type,
@@ -819,7 +819,7 @@
if not Check_Odcat_Expression (Get_Prefix (Expr)) then
return False;
end if;
- -- GHDL: I don't understand why the indexsing expressions
+ -- GHDL: I don't understand why the indexing expressions
-- must be locally static. So I don't check this in 93c.
if Flags.Vhdl_Std /= Vhdl_93c
and then
@@ -927,10 +927,8 @@
Expr: Iir;
Chain : Iir;
El: Iir;
- Loc : Location_Type;
begin
Expr := Get_Expression (Stmt);
- Loc := Get_Location (Expr);
-- FIXME: overload.
Expr := Sem_Expression (Expr, Null_Iir);
if Expr = Null_Iir then
@@ -956,6 +954,10 @@
Res: Iir;
Prefix : Iir;
begin
+ if List = Iir_List_All then
+ return;
+ end if;
+
for I in Natural loop
-- El is an iir_identifier.
El := Get_Nth_Element (List, I);
@@ -994,7 +996,7 @@
-- signal name, and each name must denote a signal for which
-- reading is permitted.
if Get_Name_Staticness (Res) < Globally then
- Error_Msg_Sem ("sensitivity element " & Disp_Node (El)
+ Error_Msg_Sem ("sensitivity element " & Disp_Node (Res)
& " must be a static name", El);
end if;
@@ -1513,6 +1515,9 @@
if Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement
and then Get_Callees_List (Proc) /= Null_Iir_List
then
+ -- Check there is no wait statement in subprograms called.
+ -- Also in the case of all-sensitized process, check that package
+ -- subprograms don't read signals.
Sem.Add_Analysis_Checks_List (Proc);
end if;
end Sem_Process_Statement;
diff -urN ghdl-0.27/vhdl/sem_stmts.ads ghdl-0.28dev/vhdl/sem_stmts.ads
--- ghdl-0.27/vhdl/sem_stmts.ads 2005-09-22 23:21:51.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_stmts.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/sem_types.adb ghdl-0.28dev/vhdl/sem_types.adb
--- ghdl-0.27/vhdl/sem_types.adb 2007-03-24 08:27:55.000000000 +0100
+++ ghdl-0.28dev/vhdl/sem_types.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,11 +12,11 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Libraries;
-with Flags;
+with Flags; use Flags;
with Types; use Types;
with Errorout; use Errorout;
with Evaluation; use Evaluation;
@@ -1062,6 +1062,7 @@
Res: Iir;
El : Iir;
List : Iir_List;
+ Has_Error : Boolean;
begin
Name := Get_Resolution_Function (Decl);
if Name = Null_Iir then
@@ -1086,19 +1087,29 @@
if Is_Overload_List (Func) then
List := Get_Overload_List (Func);
+ Has_Error := False;
for I in Natural loop
El := Get_Nth_Element (List, I);
exit when El = Null_Iir;
if Is_A_Resolution_Function (El, Decl) then
- if Func /= Null_Iir then
- Error_Msg_Sem
- ("can't resolve overload for resolution function", Decl);
- return;
+ if Res /= Null_Iir then
+ if not Has_Error then
+ Has_Error := True;
+ Error_Msg_Sem
+ ("can't resolve overload for resolution function",
+ Decl);
+ Error_Msg_Sem ("candidate functions are:", Decl);
+ Error_Msg_Sem (" " & Disp_Subprg (Func), Func);
+ end if;
+ Error_Msg_Sem (" " & Disp_Subprg (El), El);
else
- Func := El;
+ Res := El;
end if;
end if;
end loop;
+ if Has_Error then
+ return;
+ end if;
else
if Is_A_Resolution_Function (Func, Decl) then
Res := Func;
@@ -1478,6 +1489,7 @@
-- constraint.
declare
Sub_Type : Iir;
+ pragma Unreferenced (Sub_Type);
Base_Type : Iir;
begin
Base_Type := Get_Designated_Type (Type_Mark);
diff -urN ghdl-0.27/vhdl/sem_types.ads ghdl-0.28dev/vhdl/sem_types.ads
--- ghdl-0.27/vhdl/sem_types.ads 2006-05-13 17:30:11.000000000 +0200
+++ ghdl-0.28dev/vhdl/sem_types.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/std_names.adb ghdl-0.28dev/vhdl/std_names.adb
--- ghdl-0.27/vhdl/std_names.adb 2006-06-14 22:01:16.000000000 +0200
+++ ghdl-0.28dev/vhdl/std_names.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Name_Table;
diff -urN ghdl-0.27/vhdl/std_names.ads ghdl-0.28dev/vhdl/std_names.ads
--- ghdl-0.27/vhdl/std_names.ads 2006-06-14 22:01:16.000000000 +0200
+++ ghdl-0.28dev/vhdl/std_names.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/std_package.adb ghdl-0.28dev/vhdl/std_package.adb
--- ghdl-0.27/vhdl/std_package.adb 2006-06-17 02:46:35.000000000 +0200
+++ ghdl-0.28dev/vhdl/std_package.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,16 +12,15 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Iirs; use Iirs;
with Types; use Types;
with Files_Map;
with Name_Table;
with Str_Table;
with Std_Names; use Std_Names;
-with Flags;
+with Flags; use Flags;
with Iirs_Utils;
with Sem;
with Sem_Decls;
@@ -331,6 +330,7 @@
-- characters.
declare
El: Iir;
+ pragma Unreferenced (El);
begin
Character_Type_Definition :=
Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
@@ -346,7 +346,7 @@
(Get_Std_Character (I), Character_Type_Definition);
end loop;
El := Create_Std_Literal (Name_Del, Character_Type_Definition);
- if Flags.Vhdl_Std /= Vhdl_87 then
+ if Vhdl_Std /= Vhdl_87 then
for I in Name_C128 .. Name_C159 loop
El := Create_Std_Literal (I, Character_Type_Definition);
end loop;
@@ -724,7 +724,7 @@
Time_Hr_Unit: Iir_Unit_Declaration;
Constraint : Iir_Range_Expression;
begin
- if Flags.Vhdl_Std >= Vhdl_93c then
+ if Vhdl_Std >= Vhdl_93c then
Time_Staticness := Globally;
else
Time_Staticness := Locally;
@@ -813,7 +813,7 @@
-- VHDL93
-- subtype DELAY_LENGTH is TIME range 0 to TIME'HIGH
- if Flags.Vhdl_Std >= Vhdl_93c then
+ if Vhdl_Std >= Vhdl_93c then
Delay_Length_Subtype_Definition :=
Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition);
Set_Type_Mark (Delay_Length_Subtype_Definition,
@@ -855,12 +855,12 @@
Function_Now :=
Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration);
Set_Std_Identifier (Function_Now, Std_Names.Name_Now);
- if Flags.Vhdl_Std = Vhdl_87 then
+ if Vhdl_Std = Vhdl_87 then
Set_Return_Type (Function_Now, Time_Subtype_Definition);
else
Set_Return_Type (Function_Now, Delay_Length_Subtype_Definition);
end if;
- if Flags.Vhdl_Std = Vhdl_02 then
+ if Vhdl_Std = Vhdl_02 then
Set_Pure_Flag (Function_Now, True);
else
Set_Pure_Flag (Function_Now, False);
@@ -872,7 +872,7 @@
-- VHDL93:
-- type file_open_kind is (read_mode, write_mode, append_mode);
- if Flags.Vhdl_Std >= Vhdl_93c then
+ if Vhdl_Std >= Vhdl_93c then
File_Open_Kind_Type_Definition :=
Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
Set_Base_Type (File_Open_Kind_Type_Definition,
@@ -912,7 +912,7 @@
-- VHDL93:
-- type file_open_status is
-- (open_ok, status_error, name_error, mode_error);
- if Flags.Vhdl_Std >= Vhdl_93c then
+ if Vhdl_Std >= Vhdl_93c then
File_Open_Status_Type_Definition :=
Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
Set_Base_Type (File_Open_Status_Type_Definition,
@@ -954,7 +954,7 @@
-- VHDL93:
-- attribute FOREIGN: string;
- if Flags.Vhdl_Std >= Vhdl_93c then
+ if Vhdl_Std >= Vhdl_93c then
Foreign_Attribute := Create_Std_Decl (Iir_Kind_Attribute_Declaration);
Set_Std_Identifier (Foreign_Attribute, Name_Foreign);
Set_Type (Foreign_Attribute, String_Type_Definition);
diff -urN ghdl-0.27/vhdl/std_package.ads ghdl-0.28dev/vhdl/std_package.ads
--- ghdl-0.27/vhdl/std_package.ads 2005-09-22 23:22:40.000000000 +0200
+++ ghdl-0.28dev/vhdl/std_package.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs; use Iirs;
diff -urN ghdl-0.27/vhdl/str_table.adb ghdl-0.28dev/vhdl/str_table.adb
--- ghdl-0.27/vhdl/str_table.adb 2005-09-22 23:33:18.000000000 +0200
+++ ghdl-0.28dev/vhdl/str_table.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System;
diff -urN ghdl-0.27/vhdl/str_table.ads ghdl-0.28dev/vhdl/str_table.ads
--- ghdl-0.27/vhdl/str_table.ads 2005-09-22 23:22:51.000000000 +0200
+++ ghdl-0.28dev/vhdl/str_table.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
diff -urN ghdl-0.27/vhdl/tokens.adb ghdl-0.28dev/vhdl/tokens.adb
--- ghdl-0.27/vhdl/tokens.adb 2005-09-22 23:33:25.000000000 +0200
+++ ghdl-0.28dev/vhdl/tokens.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
package body Tokens is
diff -urN ghdl-0.27/vhdl/tokens.ads ghdl-0.28dev/vhdl/tokens.ads
--- ghdl-0.27/vhdl/tokens.ads 2005-09-22 23:23:10.000000000 +0200
+++ ghdl-0.28dev/vhdl/tokens.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
package Tokens is
diff -urN ghdl-0.27/vhdl/trans_analyzes.adb ghdl-0.28dev/vhdl/trans_analyzes.adb
--- ghdl-0.27/vhdl/trans_analyzes.adb 2006-09-27 03:18:41.000000000 +0200
+++ ghdl-0.28dev/vhdl/trans_analyzes.adb 2008-10-07 10:36:34.000000000 +0200
@@ -33,6 +33,7 @@
function Extract_Driver_Stmt (Stmt : Iir) return Walk_Status
is
Status : Walk_Status;
+ pragma Unreferenced (Status);
We : Iir;
begin
case Get_Kind (Stmt) is
@@ -91,6 +92,7 @@
procedure Extract_Drivers_Sequential_Stmt_Chain (Chain : Iir)
is
Status : Walk_Status;
+ pragma Unreferenced (Status);
begin
Status := Walk_Sequential_Stmt_Chain (Chain, Extract_Driver_Stmt'Access);
end Extract_Drivers_Sequential_Stmt_Chain;
diff -urN ghdl-0.27/vhdl/trans_be.adb ghdl-0.28dev/vhdl/trans_be.adb
--- ghdl-0.27/vhdl/trans_be.adb 2006-09-25 15:54:59.000000000 +0200
+++ ghdl-0.28dev/vhdl/trans_be.adb 2008-10-07 10:36:34.000000000 +0200
@@ -135,6 +135,7 @@
is
use Translation;
Fi : Foreign_Info_Type;
+ pragma Unreferenced (Fi);
begin
case Get_Kind (Decl) is
when Iir_Kind_Design_Unit =>
diff -urN ghdl-0.27/vhdl/translation.adb ghdl-0.28dev/vhdl/translation.adb
--- ghdl-0.27/vhdl/translation.adb 2008-06-27 03:10:28.000000000 +0200
+++ ghdl-0.28dev/vhdl/translation.adb 2008-10-07 10:36:34.000000000 +0200
@@ -21,7 +21,7 @@
with Ortho_Nodes; use Ortho_Nodes;
with Ortho_Ident; use Ortho_Ident;
with Evaluation; use Evaluation;
-with Flags;
+with Flags; use Flags;
with Ada.Text_IO;
with Types; use Types;
with Errorout; use Errorout;
@@ -70,7 +70,6 @@
-- Global declarations.
Ghdl_Ptr_Type : O_Tnode;
- Const_Ptr_Type_Node : O_Tnode;
Sizetype : O_Tnode;
Ghdl_I32_Type : O_Tnode;
Ghdl_I64_Type : O_Tnode;
@@ -3114,7 +3113,7 @@
procedure Copy_Fat_Pointer
(D : O_Dnode; S : O_Dnode; Ftype : Iir; Is_Sig : Object_Kind_Type)
is
- Info : Type_Info_Acc := Get_Info (Ftype);
+ Info : constant Type_Info_Acc := Get_Info (Ftype);
begin
New_Assign_Stmt
(New_Selected_Acc_Value (New_Obj (D), Info.T.Base_Field (Is_Sig)),
@@ -3830,12 +3829,9 @@
procedure Translate_Entity_Init (Entity : Iir)
is
- Info : Block_Info_Acc;
El : Iir;
El_Type : Iir;
begin
- Info := Get_Info (Entity);
-
Push_Local_Factory;
-- Generics.
@@ -4716,7 +4712,6 @@
is
Inter : Iir;
Inter_Type : Iir;
- Inter_Kind : Iir_Kind;
Info : Subprg_Info_Acc;
Arg_Info : Ortho_Info_Acc;
Tinfo : Type_Info_Acc;
@@ -4791,7 +4786,6 @@
while Inter /= Null_Iir loop
Arg_Info := Add_Info (Inter, Kind_Interface);
Inter_Type := Get_Type (Inter);
- Inter_Kind := Get_Kind (Inter_Type);
Tinfo := Get_Info (Inter_Type);
if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration
and then Get_Mode (Inter) in Iir_Out_Modes
@@ -5206,6 +5200,7 @@
is
Info : Ortho_Info_Acc;
Final : Boolean;
+ pragma Unreferenced (Final);
begin
Info := Get_Info (Spec);
Start_Subprogram_Body (Info.Package_Elab_Spec_Subprg);
@@ -5963,7 +5958,7 @@
return;
end if;
declare
- Len : Natural := Get_File_Signature_Length (Type_Name);
+ Len : constant Natural := Get_File_Signature_Length (Type_Name);
Sig : String (1 .. Len + 2);
Off : Natural := 1;
begin
@@ -6822,6 +6817,7 @@
Mark : Id_Mark_Type;
Info : Type_Info_Acc;
Lock_Field : O_Fnode;
+ pragma Unreferenced (Lock_Field);
begin
Decl := Get_Protected_Type_Declaration (Bod);
Info := Get_Info (Decl);
@@ -7308,7 +7304,6 @@
Subtype_Info : Type_Info_Acc;
Base_Info : Type_Info_Acc)
is
- Base_Type : Iir;
Rng : Iir;
Lo, Hi : Iir;
begin
@@ -7325,7 +7320,6 @@
Subtype_Info.T.Nocheck_Low := False;
else
-- Bounds are locally static.
- Base_Type := Get_Base_Type (Def);
Get_Low_High_Limit (Rng, Lo, Hi);
Subtype_Info.T.Nocheck_Hi :=
Is_Equal_Limit (Hi, True, Def, Base_Info.Type_Mode);
@@ -7456,7 +7450,7 @@
when Iir_Kind_Access_Type_Definition =>
declare
- Dtype : Iir := Get_Designated_Type (Def);
+ Dtype : constant Iir := Get_Designated_Type (Def);
begin
-- Translate the subtype
if Is_Anonymous_Type_Definition (Dtype) then
@@ -7487,10 +7481,7 @@
procedure Translate_Bool_Type_Definition (Def : Iir)
is
- Decl : Iir;
- Id : Name_Id;
Info : Type_Info_Acc;
- Base_Type : Iir;
begin
-- If the definition is already translated, return now.
Info := Get_Info (Def);
@@ -7499,10 +7490,6 @@
end if;
Info := Add_Info (Def, Kind_Type);
- Base_Type := Get_Base_Type (Def);
- Decl := Get_Type_Declarator (Def);
-
- Id := Get_Identifier (Decl);
if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then
raise Internal_Error;
@@ -7577,9 +7564,7 @@
procedure Elab_Type_Definition (Def : Iir);
procedure Elab_Type_Definition_Depend is new Handle_Anonymous_Subtypes
(Handle_A_Subtype => Elab_Type_Definition);
- procedure Elab_Type_Definition (Def : Iir)
- is
- Info : Type_Info_Acc;
+ procedure Elab_Type_Definition (Def : Iir) is
begin
case Get_Kind (Def) is
when Iir_Kind_Incomplete_Type_Definition =>
@@ -7604,8 +7589,6 @@
return;
end if;
- Info := Get_Info (Def);
-
Elab_Type_Definition_Depend (Def);
Create_Type_Definition_Type_Range (Def);
@@ -7865,13 +7848,10 @@
function Get_Array_Type_Length (Atype : Iir) return O_Enode
is
Index_List : Iir_List;
- Index_Type : Iir;
Nbr_Dim : Natural;
Dim_Length : O_Enode;
Res : O_Enode;
Type_Info : Type_Info_Acc;
- Binfo : Type_Info_Acc;
- Index_Info : Type_Info_Acc;
Bounds : Mnode;
begin
Index_List := Get_Index_Subtype_List (Atype);
@@ -7891,10 +7871,7 @@
raise Internal_Error;
end case;
- Binfo := Get_Info (Get_Base_Type (Atype));
for Dim in 1 .. Nbr_Dim loop
- Index_Type := Get_Nth_Element (Index_List, Dim - 1);
- Index_Info := Get_Info (Get_Base_Type (Index_Type));
Dim_Length :=
M2E (Range_To_Length (Bounds_To_Range (Bounds, Atype, Dim)));
if Dim = 1 then
@@ -7909,13 +7886,10 @@
function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode
is
Index_List : Iir_List;
- Index_Type : Iir;
Nbr_Dim : Natural;
Dim_Length : O_Enode;
Res : O_Enode;
Type_Info : Type_Info_Acc;
- Binfo : Type_Info_Acc;
- Index_Info : Type_Info_Acc;
B : Mnode;
begin
Index_List := Get_Index_Subtype_List (Atype);
@@ -7933,10 +7907,7 @@
raise Internal_Error;
end case;
- Binfo := Get_Info (Get_Base_Type (Atype));
for Dim in 1 .. Nbr_Dim loop
- Index_Type := Get_Nth_Element (Index_List, Dim - 1);
- Index_Info := Get_Info (Get_Base_Type (Index_Type));
B := Get_Array_Bounds (Arr);
Dim_Length :=
M2E (Range_To_Length (Bounds_To_Range (B, Atype, Dim)));
@@ -7958,11 +7929,9 @@
when Type_Mode_Fat_Array
| Type_Mode_Fat_Acc =>
declare
- F : O_Fnode;
Kind : Object_Kind_Type;
begin
Kind := Get_Object_Kind (Arr);
- F := Info.T.Base_Field (Get_Object_Kind (Arr));
return Lp2M
(New_Selected_Element (M2Lv (Arr),
Info.T.Base_Field (Kind)),
@@ -9364,7 +9333,7 @@
if Get_Info (Obj).Object_Static then
return;
end if;
- if Get_Deferred_Declaration_Flag (Obj) = True then
+ if Get_Deferred_Declaration_Flag (Obj) then
-- No code generation for a deferred constant.
return;
end if;
@@ -9782,6 +9751,11 @@
Name_Node := Get_Var (Sig_Info.Object_Driver,
Type_Info, Mode_Value);
Name_Node := Stabilize (Name_Node);
+ -- Copy bounds from signal.
+ New_Assign_Stmt
+ (M2Lp (Chap3.Get_Array_Bounds (Name_Node)),
+ M2Addr (Chap3.Get_Array_Bounds (Chap6.Translate_Name (Decl))));
+ -- Allocate base.
Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type);
elsif Type_Info.C /= null then
Name_Node := Get_Var (Sig_Info.Object_Driver,
@@ -9801,7 +9775,6 @@
(Decl : Iir; Parent : Iir; Check_Null : Boolean)
is
Sig_Type : Iir;
- Type_Info : Type_Info_Acc;
Name_Node : Mnode;
Val : Iir;
Data : Elab_Signal_Data;
@@ -9812,7 +9785,6 @@
Open_Temp;
Sig_Type := Get_Type (Decl);
- Type_Info := Get_Info (Sig_Type);
Base_Decl := Get_Base_Name (Decl);
-- Set the name of the signal.
@@ -10231,7 +10203,6 @@
Name : Iir;
Name_Node : Mnode;
Alias_Node : Mnode;
- N_Info : Type_Info_Acc;
Alias_Info : Alias_Info_Acc;
Name_Type : Iir;
Tinfo : Type_Info_Acc;
@@ -10248,7 +10219,6 @@
Name_Type := Get_Type (Name);
Name_Node := Chap6.Translate_Name (Name);
Kind := Get_Object_Kind (Name_Node);
- N_Info := Get_Info (Name_Type);
case Tinfo.Type_Mode is
when Type_Mode_Fat_Array =>
@@ -12086,13 +12056,11 @@
Open_Temp;
declare
Actual_Type : Iir;
- Tinfo : Type_Info_Acc;
Bounds : Mnode;
Formal_Node : Mnode;
begin
Actual_Type := Get_Type (Get_Default_Value (Formal));
Chap3.Create_Array_Subtype (Actual_Type, True);
- Tinfo := Get_Info (Actual_Type);
Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
Formal_Node := Chap6.Translate_Name (Formal);
New_Assign_Stmt
@@ -12104,13 +12072,11 @@
Open_Temp;
declare
Actual_Type : Iir;
- Tinfo : Type_Info_Acc;
Bounds : Mnode;
Formal_Node : Mnode;
begin
Actual_Type := Get_Actual_Type (Assoc);
Chap3.Create_Array_Subtype (Actual_Type, False);
- Tinfo := Get_Info (Actual_Type);
Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
Formal_Node := Chap6.Translate_Name (Formal);
New_Assign_Stmt
@@ -12522,7 +12488,6 @@
Index : O_Enode;
Index_Base_Type : Iir;
Index_Range : Iir;
- Index_Info : Type_Info_Acc;
V : Iir_Int64;
B : Iir_Int64;
begin
@@ -12539,8 +12504,6 @@
(New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (B)));
else
Index_Base_Type := Get_Base_Type (Index_Type);
- Index_Info := Get_Info (Index_Base_Type);
-
Index := Chap7.Translate_Expression (Expr, Index_Base_Type);
if Get_Direction (Index_Range) = Iir_To then
@@ -12598,7 +12561,6 @@
Ibasetype : Iir;
Prefix_Info : Type_Info_Acc;
Nbr_Dim : Natural;
- Fat_Ptr : O_Lnode;
Range_Ptr : Mnode;
begin
Prefix_Type := Get_Type (Get_Prefix (Expr));
@@ -12610,7 +12572,6 @@
Prefix := Prefix_Orig;
when Type_Mode_Ptr_Array =>
-- FIXME: should save the bounds address ?
- Fat_Ptr := O_Lnode_Null;
Prefix := Prefix_Orig;
when others =>
raise Internal_Error;
@@ -12725,7 +12686,6 @@
-- Type of the slice.
Slice_Type : Iir;
Slice_Info : Type_Info_Acc;
- Slice_Binfo : Type_Info_Acc;
-- Type of the first (and only) index of the prefix array type.
Index_Type : Iir;
@@ -12822,8 +12782,6 @@
Data.Is_Off := False;
- Slice_Binfo := Get_Info (Get_Base_Type (Slice_Type));
-
-- Save prefix.
Prefix_Var := Stabilize (Prefix);
@@ -12938,12 +12896,6 @@
(Prefix : Mnode; Expr : Iir_Slice_Name; Data : Slice_Name_Data)
return Mnode
is
- -- Type of the prefix.
- Prefix_Type : Iir;
-
- -- Type info of the prefix.
- Prefix_Info : Type_Info_Acc;
-
-- Type of the slice.
Slice_Type : Iir;
Slice_Info : Type_Info_Acc;
@@ -12956,11 +12908,9 @@
begin
-- Evaluate the prefix.
Slice_Type := Get_Type (Expr);
- Prefix_Type := Get_Type (Get_Prefix (Expr));
Kind := Get_Object_Kind (Prefix);
- Prefix_Info := Get_Info (Prefix_Type);
Slice_Info := Get_Info (Slice_Type);
if Data.Is_Off then
@@ -14150,14 +14100,12 @@
is
Res : O_Dnode;
Type_Info : Type_Info_Acc;
- Expr_Type_Info : Type_Info_Acc;
begin
-- FIXME: to do.
-- Be sure the bounds variable was created.
-- This may be necessary for on-the-fly types, such as strings.
Chap3.Create_Array_Subtype (Expr_Type, True);
- Expr_Type_Info := Get_Info (Expr_Type);
Type_Info := Get_Info (Atype);
Res := Create_Temp (Type_Info.Ortho_Type (Kind));
New_Assign_Stmt
@@ -14372,7 +14320,6 @@
Res : O_Dnode;
Res_Type : O_Tnode;
If_Blk : O_If_Block;
- Op : ON_Op_Kind;
Val : Integer;
V : O_Cnode;
Kind : Iir_Predefined_Functions;
@@ -14391,22 +14338,18 @@
case Kind is
when Iir_Predefined_Bit_And
| Iir_Predefined_Boolean_And =>
- Op := ON_And;
Invert := False;
Val := 1;
when Iir_Predefined_Bit_Nand
| Iir_Predefined_Boolean_Nand =>
- Op := ON_And;
Invert := True;
Val := 1;
when Iir_Predefined_Bit_Or
| Iir_Predefined_Boolean_Or =>
- Op := ON_Or;
Invert := False;
Val := 0;
when Iir_Predefined_Bit_Nor
| Iir_Predefined_Boolean_Nor =>
- Op := ON_Or;
Invert := True;
Val := 0;
when others =>
@@ -15292,10 +15235,10 @@
procedure Translate_Record_Aggregate (Target : Mnode; Aggr : Iir)
is
Targ : Mnode;
- Aggr_Type : Iir := Get_Type (Aggr);
- Aggr_Base_Type : Iir_Record_Type_Definition :=
+ Aggr_Type : constant Iir := Get_Type (Aggr);
+ Aggr_Base_Type : constant Iir_Record_Type_Definition :=
Get_Base_Type (Aggr_Type);
- Nbr_El : Iir_Index32 :=
+ Nbr_El : constant Iir_Index32 :=
Get_Number_Element_Declaration (Aggr_Base_Type);
-- Record which elements of the record have been set. The 'others'
@@ -15360,7 +15303,6 @@
Bounds : Mnode;
Var_Index : O_Dnode;
Targ : Mnode;
- Tinfo : Type_Info_Acc;
Range_Ptr : Mnode;
Rinfo : Type_Info_Acc;
@@ -15400,7 +15342,6 @@
If_Blk : O_If_Block;
Op : ON_Op_Kind;
begin
- Tinfo := Get_Info (Target_Type);
Open_Temp;
Targ := Stabilize (Target);
Base := Stabilize (Chap3.Get_Array_Base (Targ));
@@ -16034,7 +15975,6 @@
declare
Unit : Iir;
Unit_Info : Object_Info_Acc;
- Unit_Type : Type_Info_Acc;
begin
Unit := Get_Unit_Name (Expr);
Unit_Info := Get_Info (Unit);
@@ -16043,7 +15983,6 @@
(Translate_Static_Expression (Expr, Rtype));
else
-- Time units might be not locally static.
- Unit_Type := Get_Info (Expr_Type);
return New_Dyadic_Op
(ON_Mul_Ov,
New_Lit (New_Signed_Literal
@@ -16057,7 +15996,6 @@
declare
Unit : Iir;
Unit_Info : Object_Info_Acc;
- Unit_Type : Type_Info_Acc;
L, R : O_Enode;
begin
Unit := Get_Unit_Name (Expr);
@@ -16067,7 +16005,6 @@
(Translate_Static_Expression (Expr, Rtype));
else
-- Time units might be not locally static.
- Unit_Type := Get_Info (Expr_Type);
L := New_Lit
(New_Float_Literal
(Ghdl_Real_Type, IEEE_Float_64 (Get_Fp_Value (Expr))));
@@ -16207,11 +16144,9 @@
| Iir_Kind_Attribute_Value =>
declare
L : Mnode;
- Expr_Type_Info : Type_Info_Acc;
begin
L := Chap6.Translate_Name (Expr);
- Expr_Type_Info := Get_Info (Expr_Type);
Res := M2E (L);
if Get_Object_Kind (L) = Mode_Signal then
Res := Translate_Signal (Res, Expr_Type);
@@ -19406,7 +19341,6 @@
is
Constr : O_Assoc_List;
Conv_Info : Subprg_Info_Acc;
- Res_Info : Type_Info_Acc;
Res : O_Dnode;
Imp : Iir;
begin
@@ -19441,7 +19375,6 @@
New_Association (Constr, M2E (Src));
- Res_Info := Get_Info (Get_Return_Type (Imp));
if Conv_Info.Res_Interface /= O_Dnode_Null then
-- Composite result.
New_Procedure_Call (Constr);
@@ -19464,8 +19397,9 @@
is
type Mnode_Array is array (Natural range <>) of Mnode;
type O_Enode_Array is array (Natural range <>) of O_Enode;
- Assoc_Chain : Iir := Get_Parameter_Association_Chain (Stmt);
- Nbr_Assoc : Natural := Iir_Chains.Get_Chain_Length (Assoc_Chain);
+ Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
+ Nbr_Assoc : constant Natural :=
+ Iir_Chains.Get_Chain_Length (Assoc_Chain);
Params : Mnode_Array (0 .. Nbr_Assoc - 1);
E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1);
Imp : Iir;
@@ -19480,7 +19414,6 @@
Base_Formal : Iir;
Formal_Type : Iir;
Ftype_Info : Type_Info_Acc;
- Atype_Info : Type_Info_Acc;
Formal_Info : Ortho_Info_Acc;
Val : O_Enode;
Param : Mnode;
@@ -19592,7 +19525,6 @@
| Iir_Kind_Signal_Interface_Declaration =>
Param := Chap6.Translate_Name (Act);
-- Atype may not have been set (eg: slice).
- Atype_Info := Get_Info (Actual_Type);
if Base_Formal /= Formal then
Stabilize (Param);
Params (Pos) := Param;
@@ -20697,6 +20629,7 @@
when Iir_Kind_Procedure_Call_Statement =>
declare
Assocs : Iir;
+ pragma Unreferenced (Assocs); -- FIXME
Call : Iir_Procedure_Call;
Imp : Iir;
begin
@@ -20752,8 +20685,8 @@
package body Chap9 is
procedure Set_Direct_Drivers (Proc : Iir)
is
- Proc_Info : Proc_Info_Acc := Get_Info (Proc);
- Drivers : Direct_Drivers_Acc := Proc_Info.Process_Drivers;
+ Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
+ Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers;
Info : Ortho_Info_Acc;
Var : Var_Acc;
Sig : Iir;
@@ -20777,8 +20710,8 @@
procedure Reset_Direct_Drivers (Proc : Iir)
is
- Proc_Info : Proc_Info_Acc := Get_Info (Proc);
- Drivers : Direct_Drivers_Acc := Proc_Info.Process_Drivers;
+ Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
+ Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers;
Info : Ortho_Info_Acc;
Var : Var_Acc;
Sig : Iir;
@@ -20941,6 +20874,7 @@
Chap4.Translate_Declaration_Chain (Proc);
if Flag_Direct_Drivers then
+ -- Create direct drivers.
Drivers := Trans_Analyzes.Extract_Drivers (Proc);
if Flag_Dump_Drivers then
Trans_Analyzes.Dump_Drivers (Proc, Drivers);
@@ -21436,6 +21370,7 @@
Constr : O_Assoc_List;
Info : Proc_Info_Acc;
List : Iir_List;
+ List_Orig : Iir_List;
Final : Boolean;
begin
New_Debug_Line_Stmt (Get_Line_Number (Proc));
@@ -21473,16 +21408,11 @@
New_Lit (New_Subprogram_Address (Info.Process_Subprg,
Ghdl_Ptr_Type)));
Rtis.Associate_Rti_Context (Constr, Proc);
--- New_Association
--- (Constr,
--- New_Address (New_Selected_Element
--- (Get_Instance_Ref (Info.Process_Decls_Type),
--- Info.Process_Name),
--- Ghdl_Instance_Name_Acc));
New_Procedure_Call (Constr);
-- First elaborate declarations since a driver may depend on
-- an alias declaration.
+ -- Also, with vhdl 08 a sensitivity element may depend on an alias.
Chap4.Elab_Declaration_Chain (Proc, Final);
-- Register drivers.
@@ -21528,9 +21458,17 @@
end if;
if Is_Sensitized then
- List := Get_Sensitivity_List (Proc);
+ List_Orig := Get_Sensitivity_List (Proc);
+ if List_Orig = Iir_List_All then
+ List := Canon.Canon_Extract_Process_Sensitivity (Proc);
+ else
+ List := List_Orig;
+ end if;
Destroy_Types_In_List (List);
Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
+ if List_Orig = Iir_List_All then
+ Destroy_Iir_List (List);
+ end if;
end if;
Pop_Scope (Info.Process_Decls_Type);
@@ -21640,7 +21578,7 @@
end if;
end Get_Arch_Name;
- Str : String :=
+ Str : constant String :=
Image_Identifier (Get_Library (Get_Design_File (Entity_Unit)))
& "__" & Image_Identifier (Entity) & "__"
& Get_Arch_Name & "__";
@@ -23260,28 +23198,22 @@
return Translate_Low_High_Type_Attribute (Atype, True);
end Translate_Low_Type_Attribute;
- function Translate_Left_Type_Attribute (Atype : Iir) return O_Enode
- is
- Info : Type_Info_Acc;
+ function Translate_Left_Type_Attribute (Atype : Iir) return O_Enode is
begin
if Get_Type_Staticness (Atype) = Locally then
return New_Lit (Chap7.Translate_Static_Range_Left
(Get_Range_Constraint (Atype), Atype));
else
- Info := Get_Info (Atype);
return M2E (Chap3.Range_To_Left (Chap3.Type_To_Range (Atype)));
end if;
end Translate_Left_Type_Attribute;
- function Translate_Right_Type_Attribute (Atype : Iir) return O_Enode
- is
- Info : Type_Info_Acc;
+ function Translate_Right_Type_Attribute (Atype : Iir) return O_Enode is
begin
if Get_Type_Staticness (Atype) = Locally then
return New_Lit (Chap7.Translate_Static_Range_Right
(Get_Range_Constraint (Atype), Atype));
else
- Info := Get_Info (Atype);
return M2E (Chap3.Range_To_Right (Chap3.Type_To_Range (Atype)));
end if;
end Translate_Right_Type_Attribute;
@@ -25149,8 +25081,9 @@
end if;
declare
- Lit_List : Iir_List := Get_Enumeration_Literal_List (Atype);
- Nbr_Lit : Integer := Get_Nbr_Elements (Lit_List);
+ Lit_List : constant Iir_List :=
+ Get_Enumeration_Literal_List (Atype);
+ Nbr_Lit : constant Integer := Get_Nbr_Elements (Lit_List);
Lit : Iir;
type Dnode_Array is array (Natural range <>) of O_Dnode;
@@ -25491,6 +25424,7 @@
Nbr_Indexes : Integer;
Index : Iir;
Tmp : O_Dnode;
+ pragma Unreferenced (Tmp);
Arr_Type : O_Tnode;
Arr_Aggr : O_Array_Aggr_List;
Val : O_Cnode;
@@ -25563,6 +25497,7 @@
declare
Mark : Id_Mark_Type;
El_Rti : O_Dnode;
+ pragma Unreferenced (El_Rti);
begin
Push_Identifier_Prefix (Mark, "EL");
El_Rti := Generate_Type_Definition (Element);
@@ -25603,6 +25538,7 @@
Aggr : O_Record_Aggr_List;
Val : O_Cnode;
Base_Rti : O_Dnode;
+ pragma Unreferenced (Base_Rti);
Bounds : Var_Acc;
Name : O_Dnode;
Kind : O_Cnode;
@@ -25950,6 +25886,7 @@
declare
Mark : Id_Mark_Type;
Tmp : O_Dnode;
+ pragma Unreferenced (Tmp);
begin
Push_Identifier_Prefix (Mark, "OT");
Tmp := Generate_Type_Definition (Decl_Type);
@@ -27015,7 +26952,6 @@
-- Generic pointer.
Ghdl_Ptr_Type := New_Access_Type (Char_Type_Node);
- Const_Ptr_Type_Node := Ghdl_Ptr_Type;
New_Type_Decl (Get_Identifier ("__ghdl_ptr"), Ghdl_Ptr_Type);
-- Create record
@@ -28252,6 +28188,7 @@
is
Lib_Mark, Unit_Mark : Id_Mark_Type;
Info : Ortho_Info_Acc;
+ pragma Unreferenced (Info);
begin
Update_Node_Infos;
@@ -28518,6 +28455,7 @@
procedure Gen_Setup_Info
is
Cst : O_Dnode;
+ pragma Unreferenced (Cst);
begin
Cst := Create_String (Flags.Flag_String,
Get_Identifier ("__ghdl_flag_string"),
@@ -28831,6 +28769,7 @@
F : FILEs;
R : int;
S : size_t;
+ pragma Unreferenced (R, S); -- FIXME
Id : Name_Id;
Lib : Iir_Library_Declaration;
File : Iir_Design_File;
diff -urN ghdl-0.27/vhdl/types.ads ghdl-0.28dev/vhdl/types.ads
--- ghdl-0.27/vhdl/types.ads 2008-04-07 05:20:31.000000000 +0200
+++ ghdl-0.28dev/vhdl/types.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Interfaces;
@@ -20,10 +20,6 @@
package Types is
pragma Preelaborate (Types);
- -- List of vhdl standards.
- -- VHDL_93c is vhdl_93 with backward compatibility with 87 (file).
- type Vhdl_Std_Type is (Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02);
-
-- A tri state type.
type Tri_State_Type is (Unknown, False, True);
diff -urN ghdl-0.27/vhdl/version.ads ghdl-0.28dev/vhdl/version.ads
--- ghdl-0.27/vhdl/version.ads 2008-07-01 01:59:18.000000000 +0200
+++ ghdl-0.28dev/vhdl/version.ads 2008-10-07 10:36:36.000000000 +0200
@@ -1,5 +1,5 @@
package Version is
Ghdl_Release : constant String :=
- "GHDL 0.27 (20080701) [Sokcho edition]";
- Ghdl_Ver : constant String := "0.27";
+ "GHDL 0.28dev (20080721) [Sokcho edition]";
+ Ghdl_Ver : constant String := "0.28dev";
end Version;
diff -urN ghdl-0.27/vhdl/xrefs.adb ghdl-0.28dev/vhdl/xrefs.adb
--- ghdl-0.27/vhdl/xrefs.adb 2005-09-22 23:33:32.000000000 +0200
+++ ghdl-0.28dev/vhdl/xrefs.adb 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with GNAT.Table;
diff -urN ghdl-0.27/vhdl/xrefs.ads ghdl-0.28dev/vhdl/xrefs.ads
--- ghdl-0.27/vhdl/xrefs.ads 2005-09-22 23:23:46.000000000 +0200
+++ ghdl-0.28dev/vhdl/xrefs.ads 2008-10-07 10:36:36.000000000 +0200
@@ -12,7 +12,7 @@
-- for more details.
--
-- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
+-- along with GHDL; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;