From fe94cb3cc3fd4517271faa9046c74b0c455aeb79 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 9 Nov 2014 18:31:54 +0100 Subject: Split translation into child packages. --- src/vhdl/translate/trans-helpers2.adb | 318 ++++++++++++++++++++++++++++++++++ 1 file changed, 318 insertions(+) create mode 100644 src/vhdl/translate/trans-helpers2.adb (limited to 'src/vhdl/translate/trans-helpers2.adb') diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb new file mode 100644 index 000000000..cf61883a7 --- /dev/null +++ b/src/vhdl/translate/trans-helpers2.adb @@ -0,0 +1,318 @@ +-- Iir to ortho translator. +-- Copyright (C) 2002 - 2014 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 Name_Table; +with Trans.Chap3; +with Trans.Chap6; +with Trans_Decls; use Trans_Decls; +with Files_Map; +with Trans.Foreach_Non_Composite; + +package body Trans.Helpers2 is + use Trans.Helpers; + + procedure Copy_Fat_Pointer (D : Mnode; S: Mnode) + is + begin + New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (D)), + M2Addr (Chap3.Get_Array_Base (S))); + New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (D)), + M2Addr (Chap3.Get_Array_Bounds (S))); + end Copy_Fat_Pointer; + + -- Convert NAME into a STRING_CST. + -- Append a NUL terminator (to make interfaces with C easier). + function Create_String_Type (Str : String) return O_Tnode is + begin + return New_Constrained_Array_Type + (Chararray_Type, + New_Unsigned_Literal (Ghdl_Index_Type, + Unsigned_64 (Str'Length + 1))); + end Create_String_Type; + + procedure Create_String_Value + (Const : in out O_Dnode; Const_Type : O_Tnode; Str : String) + is + Res : O_Cnode; + List : O_Array_Aggr_List; + begin + Start_Const_Value (Const); + Start_Array_Aggr (List, Const_Type); + for I in Str'Range loop + New_Array_Aggr_El + (List, + New_Unsigned_Literal (Char_Type_Node, Character'Pos (Str (I)))); + end loop; + New_Array_Aggr_El (List, New_Unsigned_Literal (Char_Type_Node, 0)); + Finish_Array_Aggr (List, Res); + Finish_Const_Value (Const, Res); + end Create_String_Value; + + function Create_String (Str : String; Id : O_Ident) return O_Dnode + is + Atype : O_Tnode; + Const : O_Dnode; + begin + Atype := Create_String_Type (Str); + New_Const_Decl (Const, Id, O_Storage_Private, Atype); + Create_String_Value (Const, Atype, Str); + return Const; + end Create_String; + + function Create_String (Str : String; Id : O_Ident; Storage : O_Storage) + return O_Dnode + is + Atype : O_Tnode; + Const : O_Dnode; + begin + Atype := Create_String_Type (Str); + New_Const_Decl (Const, Id, Storage, Atype); + if Storage /= O_Storage_External then + Create_String_Value (Const, Atype, Str); + end if; + return Const; + end Create_String; + + function Create_String (Str : Name_Id; Id : O_Ident; Storage : O_Storage) + return O_Dnode + is + use Name_Table; + begin + if Name_Table.Is_Character (Str) then + raise Internal_Error; + end if; + Image (Str); + return Create_String (Name_Buffer (1 .. Name_Length), Id, Storage); + end Create_String; + + function Create_String_Len (Str : String; Id : O_Ident) return O_Cnode + is + Str_Cst : O_Dnode; + Str_Len : O_Cnode; + List : O_Record_Aggr_List; + Res : O_Cnode; + begin + Str_Cst := Create_String (Str, Id); + Str_Len := New_Unsigned_Literal (Ghdl_Index_Type, + Unsigned_64 (Str'Length)); + Start_Record_Aggr (List, Ghdl_Str_Len_Type_Node); + New_Record_Aggr_El (List, Str_Len); + New_Record_Aggr_El (List, New_Global_Address (Str_Cst, + Char_Ptr_Type)); + Finish_Record_Aggr (List, Res); + return Res; + end Create_String_Len; + + procedure Gen_Memcpy (Dest : O_Enode; Src : O_Enode; Length : O_Enode) + is + Constr : O_Assoc_List; + begin + Start_Association (Constr, Ghdl_Memcpy); + New_Association (Constr, New_Convert_Ov (Dest, Ghdl_Ptr_Type)); + New_Association (Constr, New_Convert_Ov (Src, Ghdl_Ptr_Type)); + New_Association (Constr, Length); + New_Procedure_Call (Constr); + end Gen_Memcpy; + + -- function Gen_Malloc (Length : O_Enode; Ptype : O_Tnode) return O_Enode + -- is + -- Constr : O_Assoc_List; + -- begin + -- Start_Association (Constr, Ghdl_Malloc); + -- New_Association (Constr, Length); + -- return New_Convert_Ov (New_Function_Call (Constr), Ptype); + -- end Gen_Malloc; + + function Gen_Alloc + (Kind : Allocation_Kind; Size : O_Enode; Ptype : O_Tnode) + return O_Enode + is + Constr : O_Assoc_List; + begin + case Kind is + when Alloc_Heap => + Start_Association (Constr, Ghdl_Malloc); + New_Association (Constr, Size); + return New_Convert_Ov (New_Function_Call (Constr), Ptype); + when Alloc_System => + Start_Association (Constr, Ghdl_Malloc0); + New_Association (Constr, Size); + return New_Convert_Ov (New_Function_Call (Constr), Ptype); + when Alloc_Stack => + return New_Alloca (Ptype, Size); + when Alloc_Return => + Start_Association (Constr, Ghdl_Stack2_Allocate); + New_Association (Constr, Size); + return New_Convert_Ov (New_Function_Call (Constr), Ptype); + end case; + end Gen_Alloc; + + procedure Register_Non_Composite_Signal (Targ : Mnode; + Targ_Type : Iir; + Proc : O_Dnode) + is + pragma Unreferenced (Targ_Type); + Constr : O_Assoc_List; + begin + Start_Association (Constr, Proc); + New_Association + (Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr)); + New_Procedure_Call (Constr); + end Register_Non_Composite_Signal; + + function Register_Update_Data_Array + (Data : O_Dnode; Targ_Type : Iir; Index : O_Dnode) + return O_Dnode + is + pragma Unreferenced (Targ_Type); + pragma Unreferenced (Index); + begin + return Data; + end Register_Update_Data_Array; + + function Register_Prepare_Data_Composite (Targ : Mnode; + Targ_Type : Iir; + Data : O_Dnode) + return O_Dnode + is + pragma Unreferenced (Targ); + pragma Unreferenced (Targ_Type); + begin + return Data; + end Register_Prepare_Data_Composite; + + function Register_Update_Data_Record + (Data : O_Dnode; Targ_Type : Iir; El : Iir_Element_Declaration) + return O_Dnode + is + pragma Unreferenced (Targ_Type); + pragma Unreferenced (El); + begin + return Data; + end Register_Update_Data_Record; + + procedure Register_Finish_Data_Composite (D : in out O_Dnode) + is + pragma Unreferenced (D); + begin + null; + end Register_Finish_Data_Composite; + + procedure Register_Signal_1 is new Foreach_Non_Composite + (Data_Type => O_Dnode, + Composite_Data_Type => O_Dnode, + Do_Non_Composite => Register_Non_Composite_Signal, + Prepare_Data_Array => Register_Prepare_Data_Composite, + Update_Data_Array => Register_Update_Data_Array, + Finish_Data_Array => Register_Finish_Data_Composite, + Prepare_Data_Record => Register_Prepare_Data_Composite, + Update_Data_Record => Register_Update_Data_Record, + Finish_Data_Record => Register_Finish_Data_Composite); + + procedure Register_Signal (Targ : Mnode; + Targ_Type : Iir; + Proc : O_Dnode) + renames Register_Signal_1; + + procedure Register_Signal_List (List : Iir_List; Proc : O_Dnode) + is + El : Iir; + Sig : Mnode; + begin + if List = Null_Iir_List then + return; + end if; + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Open_Temp; + Sig := Chap6.Translate_Name (El); + Register_Signal (Sig, Get_Type (El), Proc); + Close_Temp; + end loop; + end Register_Signal_List; + + function Gen_Oenode_Prepare_Data_Composite + (Targ : Mnode; Targ_Type : Iir; Val : O_Enode) + return Mnode + is + pragma Unreferenced (Targ); + Res : Mnode; + Type_Info : Type_Info_Acc; + begin + Type_Info := Get_Info (Targ_Type); + Res := E2M (Val, Type_Info, Mode_Value); + case Type_Info.Type_Mode is + when Type_Mode_Array + | Type_Mode_Fat_Array => + Res := Chap3.Get_Array_Base (Res); + when Type_Mode_Record => + Res := Stabilize (Res); + when others => + -- Not a composite type! + raise Internal_Error; + end case; + return Res; + end Gen_Oenode_Prepare_Data_Composite; + + function Gen_Oenode_Update_Data_Array (Val : Mnode; + Targ_Type : Iir; + Index : O_Dnode) + return O_Enode + is + begin + return M2E (Chap3.Index_Base (Val, Targ_Type, New_Obj_Value (Index))); + end Gen_Oenode_Update_Data_Array; + + function Gen_Oenode_Update_Data_Record + (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration) + return O_Enode + is + pragma Unreferenced (Targ_Type); + begin + return M2E (Chap6.Translate_Selected_Element (Val, El)); + end Gen_Oenode_Update_Data_Record; + + procedure Gen_Oenode_Finish_Data_Composite (Data : in out Mnode) + is + pragma Unreferenced (Data); + begin + null; + end Gen_Oenode_Finish_Data_Composite; + + function Get_Line_Number (Target: Iir) return Natural + is + Line, Col: Natural; + Name : Name_Id; + begin + Files_Map.Location_To_Position + (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 Trans.Helpers2; + -- cgit v1.2.3