From 60a469e6b5f3a6df29558e8e98fdc5510886dee3 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 25 Mar 2020 12:39:53 +0100 Subject: synth: improve propagation of errors. --- src/synth/synth-decls.adb | 7 +++++++ src/synth/synth-files_operations.adb | 11 +++++++---- src/synth/synth-insts.adb | 24 +++++++++++++++++------- src/synth/synth-stmts.adb | 32 ++++++++++++++++++++++---------- src/synth/synth-values.ads | 5 +++++ 5 files changed, 58 insertions(+), 21 deletions(-) diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 05e412f13..d61a67241 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -878,6 +878,8 @@ package body Synth.Decls is while Is_Valid (Decl) loop Synth_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type); + exit when Is_Error (Syn_Inst); + Decl := Get_Chain (Decl); end loop; end Synth_Declarations; @@ -892,6 +894,11 @@ package body Synth.Decls is Def_Val : Net; begin Val := Get_Value (Syn_Inst, Decl); + if Val = null then + pragma Assert (Is_Error (Syn_Inst)); + return; + end if; + Gate_Net := Get_Wire_Gate (Val.W); Gate := Get_Net_Parent (Gate_Net); case Get_Id (Gate) is diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index 29c70d98d..5c8b6b153 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -64,16 +64,19 @@ package body Synth.Files_Operations is procedure Convert_File_Name (Val : Value_Acc; Res : out C_File_Name; Len : out Natural; - Status : out Op_Status) is + Status : out Op_Status) + is + Name : constant Value_Acc := Strip_Alias_Const (Val); + pragma Unreferenced (Val); begin - Len := Natural (Val.Arr.Len); + Len := Natural (Name.Arr.Len); if Len >= Res'Length - 1 then Status := Op_Filename_Error; return; end if; - Convert_String (Val, Res (1 .. Len)); + Convert_String (Name, Res (1 .. Len)); Res (Len + 1) := Grt.Types.NUL; Status := Op_Ok; @@ -149,7 +152,7 @@ package body Synth.Files_Operations is if Status = Op_Name_Error then Error_Msg_Synth (+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len)); - raise File_Execution_Error; + Set_Error (Syn_Inst); else File_Error (Decl, Status); end if; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 18c23b8bb..797033bb8 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -1426,15 +1426,25 @@ package body Synth.Insts is Apply_Block_Configuration (Inst.Config, Arch); Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); - Synth_Concurrent_Statements - (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); + if not Is_Error (Syn_Inst) then + Synth_Concurrent_Statements + (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); + end if; - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); - Synth_Concurrent_Statements - (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); + if not Is_Error (Syn_Inst) then + Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); + end if; + if not Is_Error (Syn_Inst) then + Synth_Concurrent_Statements + (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); + end if; - Synth_Verification_Units (Syn_Inst, Entity); - Synth_Verification_Units (Syn_Inst, Arch); + if not Is_Error (Syn_Inst) then + Synth_Verification_Units (Syn_Inst, Entity); + end if; + if not Is_Error (Syn_Inst) then + Synth_Verification_Units (Syn_Inst, Arch); + end if; Finalize_Assignments (Get_Build (Syn_Inst)); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 20d0d3420..f7062ce68 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -1801,19 +1801,26 @@ package body Synth.Stmts is Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod)); + if not Is_Error (C.Inst) then + Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod)); + end if; - if Is_Func then - if C.Nbr_Ret = 0 then - raise Internal_Error; - elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then - Res := C.Ret_Value; + if Is_Error (C.Inst) then + Res := null; + else + if Is_Func then + if C.Nbr_Ret = 0 then + -- Function returned without a return statement. + raise Internal_Error; + else + pragma Assert (C.Nbr_Ret = 1); + pragma Assert (Is_Static (C.Ret_Value)); + Res := C.Ret_Value; + end if; else - raise Internal_Error; + Res := null; + Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); end if; - else - Res := null; - Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); end if; Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); @@ -1864,6 +1871,11 @@ package body Synth.Stmts is end if; end if; + -- Propagate error. + if Is_Error (Sub_Inst) then + Set_Error (Syn_Inst); + end if; + Free_Instance (Sub_Inst); Areapools.Release (Area_Mark, Instance_Pool.all); diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 416f2729d..7c4ec8b7c 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -335,6 +335,11 @@ package Synth.Values is procedure Strip_Const (Val : in out Value_Acc); function Strip_Const (Val : Value_Acc) return Value_Acc; + -- If VAL is a const or an alias, replace it by its value. + -- Used to extract the real data of a static value. Note that the type + -- is not correct anymore. + function Strip_Alias_Const (V : Value_Acc) return Value_Acc; + function Unshare (Src : Value_Acc; Pool : Areapool_Acc) return Value_Acc; -- cgit v1.2.3