diff options
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 2 | ||||
| -rw-r--r-- | translate/grt/config/win32.c | 17 | ||||
| -rw-r--r-- | translate/grt/grt-lib.adb | 26 | ||||
| -rw-r--r-- | translate/grt/grt-lib.ads | 4 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 80 | ||||
| -rw-r--r-- | translate/grt/grt-signals.ads | 19 | ||||
| -rwxr-xr-x | translate/mcode/dist.sh | 13 | ||||
| -rw-r--r-- | translate/mcode/winbuild.bat | 9 | ||||
| -rw-r--r-- | translate/translation.adb | 231 | ||||
| -rw-r--r-- | version.ads | 2 |
10 files changed, 322 insertions, 81 deletions
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index b08ac82c7..ed12e2c3e 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -405,6 +405,8 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Simple_Assign_Error'Address); Def (Trans_Decls.Ghdl_Signal_Start_Assign_Error, Grt.Signals.Ghdl_Signal_Start_Assign_Error'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_Error, + Grt.Signals.Ghdl_Signal_Next_Assign_Error'Address); Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null, Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address); diff --git a/translate/grt/config/win32.c b/translate/grt/config/win32.c index 18e5a2d4c..465f9290b 100644 --- a/translate/grt/config/win32.c +++ b/translate/grt/config/win32.c @@ -130,6 +130,23 @@ __ghdl_run_through_longjump (int (*func)(void)) return res; } +#include <math.h> + +double acosh (double x) +{ + return log (x + sqrt (x*x - 1)); +} + +double asinh (double x) +{ + return log (x + sqrt (x*x + 1)); +} + +double atanh (double x) +{ + return log ((1 + x) / (1 - x)) / 2; +} + #ifndef WITH_GNAT_RUN_TIME void __gnat_raise_storage_error(void) { diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb index 65abdac5c..3b3f1f388 100644 --- a/translate/grt/grt-lib.adb +++ b/translate/grt/grt-lib.adb @@ -84,9 +84,31 @@ package body Grt.Lib is Do_Report ("report", Str, Severity, Loc); end Ghdl_Report; - procedure Ghdl_Program_Error is + procedure Ghdl_Program_Error (Filename : Ghdl_C_String; + Line : Ghdl_I32; + Code : Ghdl_Index_Type) + is begin - Error ("program error"); + case Code is + when 1 => + Error_C ("missing return in function"); + when 2 => + Error_C ("block already configured"); + when 3 => + Error_C ("bad configuration"); + when others => + Error_C ("unknown error code "); + Error_C (Integer (Code)); + end case; + Error_C (" at "); + if Filename = null then + Error_C ("*unknown*"); + else + Error_C (Filename); + end if; + Error_C (":"); + Error_C (Integer(Line)); + Error_E (""); end Ghdl_Program_Error; procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type) is diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads index bb1723a0a..2c25ab161 100644 --- a/translate/grt/grt-lib.ads +++ b/translate/grt/grt-lib.ads @@ -40,7 +40,9 @@ package Grt.Lib is -- Program error has occured: -- * configuration of an already configured block. - procedure Ghdl_Program_Error; + procedure Ghdl_Program_Error (Filename : Ghdl_C_String; + Line : Ghdl_I32; + Code : Ghdl_Index_Type); function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32) return Ghdl_I32; diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index a165144f4..113c992d4 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -271,6 +271,7 @@ package body Grt.Signals is Sign.S.Drivers := Realloc (Sign.S.Drivers, Size (Sign.S.Nbr_Drivers)); end if; Trans := new Transaction'(Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Sign.Value); @@ -595,6 +596,7 @@ package body Grt.Signals is end if; Trans := new Transaction'(Kind => Trans_Value, + Line => 0, Time => Current_Time + After, Next => null, Val => Val); @@ -605,28 +607,64 @@ package body Grt.Signals is Driver.Last_Trans := Trans; end Ghdl_Signal_Next_Assign; - procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr) + procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr; + File : Ghdl_C_String; + Line : Ghdl_I32) is Trans : Transaction_Acc; begin Trans := new Transaction'(Kind => Trans_Error, + Line => Line, Time => 0, - Next => null); + Next => null, + File => File); Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); end Ghdl_Signal_Simple_Assign_Error; procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; - After : Std_Time) + After : Std_Time; + File : Ghdl_C_String; + Line : Ghdl_I32) is Trans : Transaction_Acc; begin Trans := new Transaction'(Kind => Trans_Error, + Line => Line, Time => 0, - Next => null); + Next => null, + File => File); Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); end Ghdl_Signal_Start_Assign_Error; + procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr; + After : Std_Time; + File : Ghdl_C_String; + Line : Ghdl_I32) + is + Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers; + Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign)); + + Trans : Transaction_Acc; + begin + if After > 0 and then Sign.Flink = null then + -- Put SIGN on the future list. + Sign.Flink := Future_List; + Future_List := Sign; + end if; + + Trans := new Transaction'(Kind => Trans_Error, + Line => Line, + Time => Current_Time + After, + Next => null, + File => File); + if Trans.Time <= Driver.Last_Trans.Time then + Error ("transactions not in ascending order"); + end if; + Driver.Last_Trans.Next := Trans; + Driver.Last_Trans := Trans; + end Ghdl_Signal_Next_Assign_Error; + procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; After : Std_Time) @@ -637,6 +675,7 @@ package body Grt.Signals is Error ("null transaction for a non-guarded target"); end if; Trans := new Transaction'(Kind => Trans_Null, + Line => 0, Time => 0, Next => null); Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); @@ -651,6 +690,7 @@ package body Grt.Signals is Error ("null transaction for a non-guarded target"); end if; Trans := new Transaction'(Kind => Trans_Null, + Line => 0, Time => 0, Next => null); Time := Sign.S.Resolv.Disconnect_Time; @@ -702,6 +742,7 @@ package body Grt.Signals is Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_B2, B2 => Val)); @@ -718,6 +759,7 @@ package body Grt.Signals is begin Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_B2, B2 => Val)); @@ -771,6 +813,7 @@ package body Grt.Signals is Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_E8, E8 => Val)); @@ -787,6 +830,7 @@ package body Grt.Signals is begin Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_E8, E8 => Val)); @@ -842,6 +886,7 @@ package body Grt.Signals is Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_E32, E32 => Val)); @@ -858,6 +903,7 @@ package body Grt.Signals is begin Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_E32, E32 => Val)); @@ -913,6 +959,7 @@ package body Grt.Signals is Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_I32, I32 => Val)); @@ -929,6 +976,7 @@ package body Grt.Signals is begin Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_I32, I32 => Val)); @@ -984,6 +1032,7 @@ package body Grt.Signals is Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_I64, I64 => Val)); @@ -1000,6 +1049,7 @@ package body Grt.Signals is begin Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_I64, I64 => Val)); @@ -1055,6 +1105,7 @@ package body Grt.Signals is Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_F64, F64 => Val)); @@ -1071,6 +1122,7 @@ package body Grt.Signals is begin Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Value_Union'(Mode => Mode_F64, F64 => Val)); @@ -1176,6 +1228,7 @@ package body Grt.Signals is if Mode /= Mode_Transaction then Res.S.Time := Time; Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Res.Value); @@ -1264,6 +1317,7 @@ package body Grt.Signals is Future_List := Res; end if; Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value, + Line => 0, Time => 0, Next => null, Val => Res.Value); @@ -1307,6 +1361,16 @@ package body Grt.Signals is return To_Ghdl_Value_Ptr (Sig.Ports (Index).Driving_Value'Address); end Ghdl_Signal_Read_Port; + procedure Error_Trans_Error (Trans : Transaction_Acc) is + begin + Error_C ("range check error on signal at "); + Error_C (Trans.File); + Error_C (":"); + Error_C (Natural (Trans.Line)); + Error_E (""); + end Error_Trans_Error; + pragma No_Return (Error_Trans_Error); + function Ghdl_Signal_Read_Driver (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type) return Ghdl_Value_Ptr @@ -1323,7 +1387,7 @@ package body Grt.Signals is when Trans_Null => return null; when Trans_Error => - Error ("range check error on signal"); + Error_Trans_Error (Trans); end case; end Ghdl_Signal_Read_Driver; @@ -2472,6 +2536,7 @@ package body Grt.Signals is -- R <= transport S after T; -- end process; Trans := new Transaction'(Kind => Trans_Value, + Line => 0, Time => Current_Time + Sig.S.Time, Next => null, Val => Pfx.Value); @@ -2551,7 +2616,7 @@ package body Grt.Signals is when Trans_Null => Error ("null transaction"); when Trans_Error => - Error ("range check error on signal"); + Error_Trans_Error (Trans); end case; end if; when Drv_One_Resolved @@ -2671,6 +2736,7 @@ package body Grt.Signals is -- Set driver. Trans := new Transaction' (Kind => Trans_Value, + Line => 0, Time => Current_Time + Sig.S.Time, Next => null, Val => Value_Union'(Mode => Mode_B2, B2 => True)); @@ -2789,7 +2855,7 @@ package body Grt.Signals is when Trans_Null => Error ("null transaction"); when Trans_Error => - Error ("range check error on signal"); + Error_Trans_Error (Trans); end case; Set_Effective_Value (Sig, Sig.Driving_Value); diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index 69cee8c9e..9abea657c 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -38,8 +38,9 @@ package Grt.Signals is type Transaction; type Transaction_Acc is access Transaction; type Transaction (Kind : Transaction_Kind) is record - Time : Std_Time; + Line : Ghdl_I32; Next : Transaction_Acc; + Time : Std_Time; case Kind is when Trans_Value => Val : Value_Union; @@ -48,7 +49,7 @@ package Grt.Signals is when Trans_Error => -- FIXME: should have a location field, to be able to display -- a message. - null; + File : Ghdl_C_String; end case; end record; @@ -403,10 +404,18 @@ package Grt.Signals is procedure Ghdl_Signal_Internal_Checks; -- Subprograms to be called by generated code. - procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr); + procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr; + File : Ghdl_C_String; + Line : Ghdl_I32); procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; - After : Std_Time); + After : Std_Time; + File : Ghdl_C_String; + Line : Ghdl_I32); + procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr; + After : Std_Time; + File : Ghdl_C_String; + Line : Ghdl_I32); procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr; Time : Std_Time); @@ -615,6 +624,8 @@ private "__ghdl_signal_simple_assign_error"); pragma Export (C, Ghdl_Signal_Start_Assign_Error, "__ghdl_signal_start_assign_error"); + pragma Export (C, Ghdl_Signal_Next_Assign_Error, + "__ghdl_signal_next_assign_error"); pragma Export (C, Ghdl_Signal_Start_Assign_Null, "__ghdl_signal_start_assign_null"); diff --git a/translate/mcode/dist.sh b/translate/mcode/dist.sh index 132ba0b59..18c09e91a 100755 --- a/translate/mcode/dist.sh +++ b/translate/mcode/dist.sh @@ -161,6 +161,16 @@ ghdlfilter.adb grt-modules.adb " +drv_files=" +ghdlcomp.ads +ghdlcomp.adb +foreigns.ads +foreigns.adb +ghdlrun.adb +ghdlrun.ads +ghdl_mcode.adb +" + for i in $cfiles; do ln -sf $CWD/../../$i $distdir/ghdl/$i; done for i in $tfiles; do ln -sf $CWD/../$i $distdir/ghdl/$i; done @@ -172,8 +182,7 @@ for i in $ortho_mcode_files; do ln -sf $CWD/../../ortho/mcode/$i $distdir/ortho/$i done -for i in $ghdl_files ghdlcomp.ads ghdlcomp.adb \ - ghdlrun.adb ghdlrun.ads ghdl_mcode.adb; do +for i in $ghdl_files $drv_files; do ln -sf $CWD/../ghdldrv/$i $distdir/ghdldrv/$i done diff --git a/translate/mcode/winbuild.bat b/translate/mcode/winbuild.bat index c4008631b..7d5b942db 100644 --- a/translate/mcode/winbuild.bat +++ b/translate/mcode/winbuild.bat @@ -1,3 +1,12 @@ call windows\compile
+if errorlevel 1 goto end
call windows\complib
+if errorlevel 1 goto end
"f:\Program Files\NSIS\makensis" windows\ghdl.nsi
+if errorlevel 1 goto end
+exit /b 0
+
+:end
+echo "Error during compilation"
+exit /b 1
+
diff --git a/translate/translation.adb b/translate/translation.adb index 37a1074f0..b1ed78788 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -150,7 +150,7 @@ package body Translation is Wkie_This, Wkie_Size, Wkie_Res, Wkie_Dir_To, Wkie_Dir_Downto, Wkie_Left, Wkie_Right, Wkie_Dir, Wkie_Length, Wkie_Kind, Wkie_Dim, Wkie_I, Wkie_Instance, Wkie_Arch_Instance, Wkie_Name, Wkie_Sig, - Wkie_Obj, Wkie_Rti, Wkie_Parent + Wkie_Obj, Wkie_Rti, Wkie_Parent, Wkie_Filename, Wkie_Line ); type Wk_Ident_Tree_Array is array (Wk_Ident_Type) of O_Ident; Wk_Idents : Wk_Ident_Tree_Array; @@ -173,6 +173,8 @@ package body Translation is Wki_Obj : O_Ident renames Wk_Idents (Wkie_Obj); Wki_Rti : O_Ident renames Wk_Idents (Wkie_Rti); Wki_Parent : O_Ident renames Wk_Idents (Wkie_Parent); + Wki_Filename : O_Ident renames Wk_Idents (Wkie_Filename); + Wki_Line : O_Ident renames Wk_Idents (Wkie_Line); -- ALLOCATION_KIND defines the type of memory storage. -- ALLOC_STACK means the object is allocated on the local stack and @@ -582,6 +584,10 @@ package body Translation is package Chap8 is procedure Translate_Statements_Chain (First : Iir); + -- Return true if there is a return statement in the chain. + function Translate_Statements_Chain_Has_Return (First : Iir) + return Boolean; + -- Create a case branch for CHOICE. -- Used by case statement and aggregates. procedure Translate_Case_Choice @@ -1982,7 +1988,10 @@ package body Translation is procedure Gen_Bound_Error (Loc : Iir); -- Generate code to emit a program error. - procedure Gen_Program_Error (Loc : Iir); + Prg_Err_Missing_Return : constant Natural := 1; + Prg_Err_Block_Configured : constant Natural := 2; + Prg_Err_Dummy_Config : constant Natural := 3; + procedure Gen_Program_Error (Loc : Iir; Code : Natural); -- Generate code to emit a failure if COND is TRUE, indicating an -- index violation for dimension DIM of an array. LOC is usually @@ -2371,6 +2380,9 @@ package body Translation is N2hex : constant Hexstr_Type := "0123456789abcdef"; function Get_Line_Number (Target: Iir) return Natural; + + procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List; + Line : Natural); private end Helpers; use Helpers; @@ -3763,6 +3775,16 @@ package body Translation is (Get_Location (Target), Name, Line, Col); return Line; end Get_Line_Number; + + procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List; + Line : Natural) is + begin + New_Association (Assoc, + New_Lit (New_Global_Address (Current_Filename_Node, + Char_Ptr_Type))); + New_Association (Assoc, New_Lit (New_Signed_Literal + (Ghdl_I32_Type, Integer_64 (Line)))); + end Assoc_Filename_Line; end Helpers; package body Chap1 is @@ -4282,7 +4304,8 @@ package body Translation is if Fails then New_Else_Stmt (If_Blk); -- Already configured. - Chap6.Gen_Program_Error (Block_Config); + Chap6.Gen_Program_Error + (Block_Config, Chap6.Prg_Err_Block_Configured); end if; Finish_If_Stmt (If_Blk); @@ -4844,6 +4867,8 @@ package body Translation is -- and retained. Is_Prot : Boolean := False; + Has_Return : Boolean; + Subprg_Instances : Chap2.Subprg_Instance_Stack; begin Spec := Get_Subprogram_Specification (Subprg); @@ -4923,7 +4948,7 @@ package body Translation is Old_Subprogram := Current_Subprogram; Current_Subprogram := Spec; - Chap8.Translate_Statements_Chain + Has_Return := Chap8.Translate_Statements_Chain_Has_Return (Get_Sequential_Statement_Chain (Subprg)); Current_Subprogram := Old_Subprogram; @@ -4931,6 +4956,12 @@ package body Translation is -- FIXME: create a barrier to catch missing return statement. if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then New_Exit_Stmt (Info.Subprg_Exit); + else + if not Has_Return then + -- Missing return + Chap6.Gen_Program_Error + (Subprg, Chap6.Prg_Err_Missing_Return); + end if; end if; Finish_Loop_Stmt (Info.Subprg_Exit); Chap4.Final_Declaration_Chain (Subprg, False); @@ -4943,6 +4974,14 @@ package body Translation is if Is_Ortho_Func then New_Return_Stmt (New_Obj_Value (Info.Subprg_Result)); end if; + else + if Get_Kind (Spec) = Iir_Kind_Function_Declaration + and then not Has_Return + then + -- Missing return + Chap6.Gen_Program_Error + (Subprg, Chap6.Prg_Err_Missing_Return); + end if; end if; Chap2.Restore_Subprg_Instance (Subprg_Instances); @@ -12141,12 +12180,7 @@ package body Translation is (Get_Location (Loc), Name, Line, Col); Start_Association (Constr, Ghdl_Bound_Check_Failed_L1); - New_Association - (Constr, New_Lit (New_Global_Address (Current_Filename_Node, - Char_Ptr_Type))); - New_Association - (Constr, New_Lit (New_Signed_Literal (Ghdl_I32_Type, - Integer_64 (Line)))); + Assoc_Filename_Line (Constr, Line); New_Procedure_Call (Constr); else Start_Association (Constr, Ghdl_Bound_Check_Failed_L0); @@ -12158,13 +12192,23 @@ package body Translation is end if; end Gen_Bound_Error; - procedure Gen_Program_Error (Loc : Iir) + procedure Gen_Program_Error (Loc : Iir; Code : Natural) is - pragma Unreferenced (Loc); - Constr : O_Assoc_List; + Assoc : O_Assoc_List; begin - Start_Association (Constr, Ghdl_Program_Error); - New_Procedure_Call (Constr); + Start_Association (Assoc, Ghdl_Program_Error); + + if Current_Filename_Node = O_Dnode_Null then + New_Association (Assoc, New_Lit (New_Null_Access (Char_Ptr_Type))); + New_Association (Assoc, + New_Lit (New_Signed_Literal (Ghdl_I32_Type, 0))); + else + Assoc_Filename_Line (Assoc, Get_Line_Number (Loc)); + end if; + New_Association + (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, + Unsigned_64 (Code)))); + New_Procedure_Call (Assoc); end Gen_Program_Error; -- Generate code to emit a failure if COND is TRUE, indicating an @@ -19586,6 +19630,7 @@ package body Translation is end Translate_Wait_Statement; -- Signal assignment. + Signal_Assign_Line : Natural; procedure Gen_Simple_Signal_Assign_Non_Composite (Targ : Mnode; Targ_Type : Iir; Val : O_Enode) @@ -19637,6 +19682,7 @@ package body Translation is Start_If_Stmt (If_Blk, Chap3.Not_In_Range (Val2, Targ_Type)); Start_Association (Assoc, Ghdl_Signal_Simple_Assign_Error); New_Association (Assoc, New_Obj_Value (Targ2)); + Assoc_Filename_Line (Assoc, Signal_Assign_Line); New_Procedure_Call (Assoc); New_Else_Stmt (If_Blk); Start_Association (Assoc, Subprg); @@ -19765,6 +19811,7 @@ package body Translation is New_Association (Assoc, New_Obj_Value (Starg)); New_Association (Assoc, New_Obj_Value (Data.Reject)); New_Association (Assoc, New_Obj_Value (Data.After)); + Assoc_Filename_Line (Assoc, Signal_Assign_Line); New_Procedure_Call (Assoc); New_Else_Stmt (If_Blk); Start_Association (Assoc, Subprg); @@ -19916,13 +19963,45 @@ package body Translation is when others => Error_Kind ("gen_signal_next_assign_non_composite", Targ_Type); end case; - -- FIXME: check in range. - Start_Association (Assoc, Subprg); - New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)), - Ghdl_Signal_Ptr)); - New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv)); - New_Association (Assoc, New_Obj_Value (Data.After)); - New_Procedure_Call (Assoc); + if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then + declare + If_Blk : O_If_Block; + V : Mnode; + Starg : O_Dnode; + begin + Open_Temp; + V := Stabilize_Value (Data.Expr); + Starg := Create_Temp_Init + (Ghdl_Signal_Ptr, + New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr)); + Start_If_Stmt + (If_Blk, Chap3.Not_In_Range (M2Dv (V), Targ_Type)); + + Start_Association (Assoc, Ghdl_Signal_Next_Assign_Error); + New_Association (Assoc, New_Obj_Value (Starg)); + New_Association (Assoc, New_Obj_Value (Data.After)); + Assoc_Filename_Line (Assoc, Signal_Assign_Line); + New_Procedure_Call (Assoc); + + New_Else_Stmt (If_Blk); + + Start_Association (Assoc, Subprg); + New_Association (Assoc, New_Obj_Value (Starg)); + New_Association (Assoc, New_Convert_Ov (M2E (V), Conv)); + New_Association (Assoc, New_Obj_Value (Data.After)); + New_Procedure_Call (Assoc); + + Finish_If_Stmt (If_Blk); + Close_Temp; + end; + else + Start_Association (Assoc, Subprg); + New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)), + Ghdl_Signal_Ptr)); + New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv)); + New_Association (Assoc, New_Obj_Value (Data.After)); + New_Procedure_Call (Assoc); + end if; end Gen_Next_Signal_Assign_Non_Composite; procedure Gen_Next_Signal_Assign is new Foreach_Non_Composite @@ -20074,6 +20153,7 @@ package body Translation is -- Handle a simple and common case: only one waveform, inertial, -- and no time (eg: sig <= expr). Value := Get_We_Value (We); + Signal_Assign_Line := Get_Line_Number (Value); if Get_Chain (We) = Null_Iir and then Get_Time (We) = Null_Iir and then Get_Delay_Mechanism (Stmt) = Iir_Inertial_Delay @@ -20161,6 +20241,7 @@ package body Translation is Chap7.Translate_Expression (Get_Time (We), Time_Type_Definition)); Value := Get_We_Value (We); + Signal_Assign_Line := Get_Line_Number (Value); if Get_Kind (Value) = Iir_Kind_Null_Literal then Val := Mnode_Null; else @@ -20255,6 +20336,23 @@ package body Translation is Stmt := Get_Chain (Stmt); end loop; end Translate_Statements_Chain; + + function Translate_Statements_Chain_Has_Return (First : Iir) + return Boolean + is + Stmt : Iir; + Has_Return : Boolean := False; + begin + Stmt := First; + while Stmt /= Null_Iir loop + Translate_Statement (Stmt); + if Get_Kind (Stmt) = Iir_Kind_Return_Statement then + Has_Return := True; + end if; + Stmt := Get_Chain (Stmt); + end loop; + return Has_Return; + end Translate_Statements_Chain_Has_Return; end Chap8; package body Chap9 is @@ -26161,6 +26259,8 @@ package body Translation is Wki_Obj := Get_Identifier ("OBJ"); Wki_Rti := Get_Identifier ("RTI"); Wki_Parent := Get_Identifier ("parent"); + Wki_Filename := Get_Identifier ("filename"); + Wki_Line := Get_Identifier ("line"); Sizetype := New_Unsigned_Type (32); New_Type_Decl (Get_Identifier ("__ghdl_size_type"), Sizetype); @@ -26277,20 +26377,18 @@ package body Translation is -- Create: -- type __ghdl_location is record - -- file : __ghdl_str_len_ptr; - -- line : integer; - -- col : Integer; + -- file : char_ptr_type; + -- line : ghdl_i32; + -- col : ghdl_i32; -- end record; declare Constr : O_Element_List; begin Start_Record_Type (Constr); - New_Record_Field (Constr, Ghdl_Location_Filename_Node, - Get_Identifier ("filename"), - Char_Ptr_Type); - New_Record_Field (Constr, Ghdl_Location_Line_Node, - Get_Identifier ("line"), - Ghdl_I32_Type); + New_Record_Field + (Constr, Ghdl_Location_Filename_Node, Wki_Filename, Char_Ptr_Type); + New_Record_Field + (Constr, Ghdl_Location_Line_Node, Wki_Line, Ghdl_I32_Type); New_Record_Field (Constr, Ghdl_Location_Col_Node, Get_Identifier ("col"), Ghdl_I32_Type); @@ -26321,13 +26419,18 @@ package body Translation is New_Interface_Decl (Interfaces, Param, Wki_Size, Sizetype); Finish_Subprogram_Decl (Interfaces, Ghdl_Alloc_Ptr); - -- procedure __ghdl_program_error -- (loc : __ghdl_location_acc); + -- procedure __ghdl_program_error (filename : char_ptr_type; + -- line : ghdl_i32; + -- code : ghdl_index_type); Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_program_error"), O_Storage_External); - --New_Interface_Decl (Interfaces, Param, - -- Get_Identifier ("location"), - -- Ghdl_Location_Ptr_Node); + New_Interface_Decl + (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl + (Interfaces, Param, Wki_Line, Ghdl_I32_Type); + New_Interface_Decl + (Interfaces, Param, Get_Identifier ("code"), Ghdl_Index_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error); -- procedure __ghdl_bound_check_failed_l0; @@ -26343,10 +26446,8 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l1"), O_Storage_External); - New_Interface_Decl - (Interfaces, Param, Get_Identifier ("filename"), Char_Ptr_Type); - New_Interface_Decl - (Interfaces, Param, Get_Identifier ("line"), Ghdl_I32_Type); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L1); -- Secondary stack subprograms. @@ -26546,8 +26647,7 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_init_" & Suffix), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type); Finish_Subprogram_Decl (Interfaces, Init_Signal); @@ -26556,8 +26656,7 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_" & Suffix), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type); Finish_Subprogram_Decl (Interfaces, Simple_Assign); @@ -26568,8 +26667,7 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_" & Suffix), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"), Std_Time_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), @@ -26584,8 +26682,7 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_" & Suffix), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), @@ -26597,8 +26694,7 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_associate_" & Suffix), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type); Finish_Subprogram_Decl (Interfaces, Associate_Value); @@ -26608,8 +26704,7 @@ package body Translation is Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_signal_driving_value_" & Suffix), O_Storage_External, Val_Type); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); Finish_Subprogram_Decl (Interfaces, Driving_Value); end Create_Signal_Subprograms; @@ -27063,46 +27158,55 @@ package body Translation is Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Driving); -- procedure __ghdl_signal_simple_assign_error - -- (sig : __ghdl_signal_ptr); + -- (sig : __ghdl_signal_ptr; + -- filename : char_ptr_type; + -- line : ghdl_i32); Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_error"), O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Simple_Assign_Error); -- procedure __ghdl_signal_start_assign_error (sign : __ghdl_signal_ptr; -- reject : std_time; - -- after : std_time); + -- after : std_time; + -- filename : char_ptr_type; + -- line : ghdl_i32); Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_error"), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"), Std_Time_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), Std_Time_Type); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Error); -- procedure __ghdl_signal_next_assign_error (sig : __ghdl_signal_ptr; - -- after : std_time); + -- after : std_time; + -- filename : char_ptr_type; + -- line : ghdl_i32); Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_error"), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), Std_Time_Type); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Error); - -- procedure __ghdl_signal_start_assign_null (sign : __ghdl_signal_ptr; + -- procedure __ghdl_signal_start_assign_null (sig : __ghdl_signal_ptr; -- reject : std_time; -- after : std_time); Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_null"), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"), Std_Time_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), @@ -27114,8 +27218,7 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_null"), O_Storage_External); - New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"), - Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), Std_Time_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Null); @@ -27839,7 +27942,7 @@ package body Translation is Finish_Subprogram_Decl (Inter_List, Subprg); Start_Subprogram_Body (Subprg); - Chap6.Gen_Program_Error (Arch); + Chap6.Gen_Program_Error (Arch, Chap6.Prg_Err_Dummy_Config); Finish_Subprogram_Body; Pop_Identifier_Prefix (Arch_Mark); diff --git a/version.ads b/version.ads index 82f2adba5..aa4bb2046 100644 --- a/version.ads +++ b/version.ads @@ -1,4 +1,4 @@ package Version is Ghdl_Version : constant String := - "GHDL 0.24 (20060625) [Sokcho edition]"; + "GHDL 0.25 (20060811) [Sokcho edition]"; end Version; |