-- 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 (Nam_Buffer (1 .. Nam_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;