From 5b458e22f3054e64e231160cb91370da63ff1640 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 11 Jan 2023 07:25:07 +0100 Subject: synth: rework error handling in file operations --- src/synth/elab-vhdl_files.adb | 101 +++++++++++++++++++++++++----------------- src/synth/elab-vhdl_files.ads | 3 +- src/synth/synth-vhdl_oper.adb | 2 +- 3 files changed, 63 insertions(+), 43 deletions(-) diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index 1c621f802..aec343170 100644 --- a/src/synth/elab-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -33,6 +33,7 @@ with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +with Synth.Errors; use Synth.Errors; package body Elab.Vhdl_Files is @@ -44,14 +45,11 @@ package body Elab.Vhdl_Files is -- Representation of file name compatible with C (so NUL terminated). subtype C_File_Name is String (1 .. 1025); - procedure File_Error (Loc : Node; Status : Op_Status); - pragma No_Return (File_Error); - - procedure File_Error (Loc : Node; Status : Op_Status) is + procedure File_Error + (Syn_Inst : Synth_Instance_Acc; Loc : Node; Status : Op_Status) is begin pragma Assert (Status /= Op_Ok); - Error_Msg_Elab (+Loc, "file operation failed"); - raise File_Execution_Error; + Error_Msg_Synth (Syn_Inst, Loc, "file operation failed"); end File_Error; -- VAL represents a string, so an array of characters. @@ -254,14 +252,15 @@ package body Elab.Vhdl_Files is (+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len)); Set_Error (Syn_Inst); else - File_Error (Decl, Status); + File_Error (Syn_Inst, Decl, Status); end if; end if; return F; end Elaborate_File_Declaration; - function Endfile (F : File_Index; Loc : Node) return Boolean + function Endfile (Syn_Inst : Synth_Instance_Acc; F : File_Index; Loc : Node) + return Boolean is Status : Op_Status; begin @@ -272,7 +271,8 @@ package body Elab.Vhdl_Files is elsif Status = Op_End_Of_File then return True; else - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); + return False; end if; end Endfile; @@ -312,7 +312,7 @@ package body Elab.Vhdl_Files is (+Loc, "cannot open file: " & C_Name (1 .. C_Name_Len)); raise File_Execution_Error; else - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; end if; end Synth_File_Open; @@ -398,7 +398,7 @@ package body Elab.Vhdl_Files is end if; if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; end Synth_File_Close; @@ -412,7 +412,7 @@ package body Elab.Vhdl_Files is Ghdl_File_Flush (F, Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; end Synth_File_Flush; @@ -437,7 +437,7 @@ package body Elab.Vhdl_Files is Ghdl_Untruncated_Text_Read (File, To_Ghdl_C_String (Buf'Address), Len, Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; for I in 1 .. Natural (Len) loop @@ -447,7 +447,10 @@ package body Elab.Vhdl_Files is Write_Discrete (Param_Len, Int64 (Len)); end Synth_Untruncated_Text_Read; - procedure File_Read_Value (File : File_Index; Val : Memtyp; Loc : Node) + procedure File_Read_Value (Syn_Inst : Synth_Instance_Acc; + File : File_Index; + Val : Memtyp; + Loc : Node) is Status : Op_Status; begin @@ -459,7 +462,7 @@ package body Elab.Vhdl_Files is Ghdl_Read_Scalar (File, Ghdl_Ptr (Val.Mem.all'Address), Ghdl_Index_Type (Val.Typ.Sz), Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; when Type_Vector | Type_Array => @@ -469,15 +472,17 @@ package body Elab.Vhdl_Files is begin Off := 0; for I in 1 .. Get_Bound_Length (Val.Typ) loop - File_Read_Value (File, (El_Typ, Val.Mem + Off), Loc); + File_Read_Value + (Syn_Inst, File, (El_Typ, Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; end loop; end; when Type_Record => for I in Val.Typ.Rec.E'Range loop File_Read_Value - (File, (Val.Typ.Rec.E (I).Typ, - Val.Mem + Val.Typ.Rec.E (I).Offs.Mem_Off), + (Syn_Inst, File, + (Val.Typ.Rec.E (I).Typ, + Val.Mem + Val.Typ.Rec.E (I).Offs.Mem_Off), Loc); end loop; when Type_Unbounded_Record @@ -492,7 +497,10 @@ package body Elab.Vhdl_Files is end case; end File_Read_Value; - procedure File_Skip_Value (File : File_Index; Typ : Type_Acc; Loc : Node) + procedure File_Skip_Value (Syn_Inst : Synth_Instance_Acc; + File : File_Index; + Typ : Type_Acc; + Loc : Node) is Status : Op_Status; begin @@ -508,7 +516,7 @@ package body Elab.Vhdl_Files is Ghdl_Read_Scalar (File, Ghdl_Ptr (Mem'Address), Ghdl_Index_Type (Typ.Sz), Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; end; when Type_Vector @@ -517,12 +525,12 @@ package body Elab.Vhdl_Files is El_Typ : constant Type_Acc := Get_Array_Element (Typ); begin for I in 1 .. Get_Bound_Length (Typ) loop - File_Skip_Value (File, El_Typ, Loc); + File_Skip_Value (Syn_Inst, File, El_Typ, Loc); end loop; end; when Type_Record => for I in Typ.Rec.E'Range loop - File_Skip_Value (File, Typ.Rec.E (I).Typ, Loc); + File_Skip_Value (Syn_Inst, File, Typ.Rec.E (I).Typ, Loc); end loop; when Type_Unbounded_Record | Type_Array_Unbounded @@ -544,11 +552,14 @@ package body Elab.Vhdl_Files is Param2 : constant Node := Get_Chain (Inters); Value : constant Valtyp := Get_Value (Syn_Inst, Param2); begin - File_Read_Value (File, (Value.Typ, Value.Val.Mem), Loc); + File_Read_Value (Syn_Inst, File, (Value.Typ, Value.Val.Mem), Loc); end Synth_File_Read; - procedure Synth_File_Text_Read_Length - (File : File_Index; Value : Valtyp; Length : Valtyp; Loc : Node) + procedure Synth_File_Text_Read_Length (Syn_Inst : Synth_Instance_Acc; + File : File_Index; + Value : Valtyp; + Length : Valtyp; + Loc : Node) is Bnd : aliased Std_String_Bound; Str : aliased Std_String; @@ -559,7 +570,7 @@ package body Elab.Vhdl_Files is Bounds => Bnd'Unrestricted_Access); Ghdl_Text_Read_Length (File, Str'Unrestricted_Access, Status, Len); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); Len := 0; end if; Write_Discrete (Length, Int64 (Len)); @@ -583,21 +594,22 @@ package body Elab.Vhdl_Files is Off : Size_Type; begin if Is_Text then - Synth_File_Text_Read_Length (File, Value, Length, Loc); + Synth_File_Text_Read_Length (Syn_Inst, File, Value, Length, Loc); else Ghdl_Read_Scalar (File, Ghdl_Ptr (Len'Address), 4, Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); return; end if; Off := 0; for I in 1 .. Len loop if I <= Value.Typ.Abound.Len then - File_Read_Value (File, (El_Typ, Value.Val.Mem + Off), Loc); + File_Read_Value + (Syn_Inst, File, (El_Typ, Value.Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; else -- Loose extra data. - File_Skip_Value (File, El_Typ, Loc); + File_Skip_Value (Syn_Inst, File, El_Typ, Loc); Len := Len - 1; end if; end loop; @@ -605,7 +617,10 @@ package body Elab.Vhdl_Files is end if; end Synth_File_Read_Length; - procedure File_Write_Value (File : File_Index; Val : Memtyp; Loc : Node) + procedure File_Write_Value (Syn_Inst : Synth_Instance_Acc; + File : File_Index; + Val : Memtyp; + Loc : Node) is Status : Op_Status; begin @@ -617,7 +632,7 @@ package body Elab.Vhdl_Files is Ghdl_Write_Scalar (File, Ghdl_Ptr (Val.Mem.all'Address), Ghdl_Index_Type (Val.Typ.Sz), Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; when Type_Vector | Type_Array => @@ -627,13 +642,14 @@ package body Elab.Vhdl_Files is begin Off := 0; for I in 1 .. Get_Bound_Length (Val.Typ) loop - File_Write_Value (File, (El_Typ, Val.Mem + Off), Loc); + File_Write_Value (Syn_Inst, File, + (El_Typ, Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; end loop; end; when Type_Record => for I in Val.Typ.Rec.E'Range loop - File_Write_Value (File, + File_Write_Value (Syn_Inst, File, (Val.Typ.Rec.E (I).Typ, Val.Mem + Val.Typ.Rec.E (I).Offs.Mem_Off), Loc); @@ -660,7 +676,10 @@ package body Elab.Vhdl_Files is end case; end Dir_To_Dir; - procedure File_Write_Text (File : File_Index; Val : Memtyp; Loc : Node) + procedure File_Write_Text (Syn_Inst : Synth_Instance_Acc; + File : File_Index; + Val : Memtyp; + Loc : Node) is B : Bound_Type; Status : Op_Status; @@ -676,7 +695,7 @@ package body Elab.Vhdl_Files is Bounds => To_Std_String_Boundp (Bnd'Address)); Ghdl_Text_Write (File, To_Std_String_Ptr (Str'Address), Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; end File_Write_Text; @@ -694,7 +713,7 @@ package body Elab.Vhdl_Files is Status : Op_Status; begin if Is_Text then - File_Write_Text (File, (Value.Typ, Value.Val.Mem), Loc); + File_Write_Text (Syn_Inst, File, (Value.Typ, Value.Val.Mem), Loc); else Type_Mark := Get_Type (Get_File_Type_Mark (File_Type)); if not Is_Fully_Constrained_Type (Type_Mark) then @@ -703,10 +722,10 @@ package body Elab.Vhdl_Files is Len := Value.Typ.Abound.Len; Ghdl_Write_Scalar (File, Ghdl_Ptr (Len'Address), 4, Status); if Status /= Op_Ok then - File_Error (Loc, Status); + File_Error (Syn_Inst, Loc, Status); end if; end if; - File_Write_Value (File, (Value.Typ, Value.Val.Mem), Loc); + File_Write_Value (Syn_Inst, File, (Value.Typ, Value.Val.Mem), Loc); end if; end Synth_File_Write; @@ -722,7 +741,7 @@ package body Elab.Vhdl_Files is Ghdl_File_Close (File, Status); end if; if Status /= Op_Ok then - File_Error (Decl, Status); + File_Error (Syn_Inst, Decl, Status); end if; if Is_Text then Ghdl_Text_File_Finalize (File, Status); @@ -730,7 +749,7 @@ package body Elab.Vhdl_Files is Ghdl_File_Finalize (File, Status); end if; if Status /= Op_Ok then - File_Error (Decl, Status); + File_Error (Syn_Inst, Decl, Status); end if; end Finalize_File; end Elab.Vhdl_Files; diff --git a/src/synth/elab-vhdl_files.ads b/src/synth/elab-vhdl_files.ads index c0d97790f..5f1656952 100644 --- a/src/synth/elab-vhdl_files.ads +++ b/src/synth/elab-vhdl_files.ads @@ -33,7 +33,8 @@ package Elab.Vhdl_Files is (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index; procedure Finalize_File (Syn_Inst : Synth_Instance_Acc; Decl : Node); - function Endfile (F : File_Index; Loc : Node) return Boolean; + function Endfile (Syn_Inst : Synth_Instance_Acc; F : File_Index; Loc : Node) + return Boolean; procedure Synth_File_Open (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index 9063e84c4..206faf1a6 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -1965,7 +1965,7 @@ package body Synth.Vhdl_Oper is declare Res : Boolean; begin - Res := Elab.Vhdl_Files.Endfile (L.Val.File, Expr); + Res := Elab.Vhdl_Files.Endfile (Syn_Inst, L.Val.File, Expr); return Create_Value_Memtyp (Create_Memory_U8 (Boolean'Pos (Res), Boolean_Type)); exception -- cgit v1.2.3