-- Mcode back-end for ortho. -- Copyright (C) 2006 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 Interfaces; use Interfaces; with Ortho_Code; use Ortho_Code; with Ortho_Code.Types; use Ortho_Code.Types; with Ortho_Code.Consts; use Ortho_Code.Consts; with Ortho_Code.Decls; use Ortho_Code.Decls; with Ortho_Code.Exprs; use Ortho_Code.Exprs; with Ortho_Code.Abi; -- Interface to create nodes. package Ortho_Mcode is --- PUBLIC DECLARATIONS subtype O_Tnode is Ortho_Code.O_Tnode; subtype O_Cnode is Ortho_Code.O_Cnode; subtype O_Dnode is Ortho_Code.O_Dnode; subtype O_Enode is Ortho_Code.O_Enode; subtype O_Fnode is Ortho_Code.O_Fnode; subtype O_Lnode is Ortho_Code.O_Lnode; subtype O_Snode is Ortho_Code.Exprs.O_Snode; O_Lnode_Null : constant O_Lnode := Ortho_Code.O_Lnode_Null; O_Cnode_Null : constant O_Cnode := Ortho_Code.O_Cnode_Null; O_Dnode_Null : constant O_Dnode := Ortho_Code.O_Dnode_Null; O_Enode_Null : constant O_Enode := Ortho_Code.O_Enode_Null; O_Fnode_Null : constant O_Fnode := Ortho_Code.O_Fnode_Null; O_Snode_Null : O_Snode renames Ortho_Code.Exprs.O_Snode_Null; O_Tnode_Null : constant O_Tnode := Ortho_Code.O_Tnode_Null; function "=" (L, R : O_Tnode) return Boolean renames Ortho_Code."="; function "=" (L, R : O_Cnode) return Boolean renames Ortho_Code."="; function "=" (L, R : O_Snode) return Boolean renames Ortho_Code.Exprs."="; function "=" (L, R : O_Dnode) return Boolean renames Ortho_Code."="; function "=" (L, R : O_Enode) return Boolean renames Ortho_Code."="; function "=" (L, R : O_Fnode) return Boolean renames Ortho_Code."="; function "=" (L, R : O_Lnode) return Boolean renames Ortho_Code."="; -- Initialize nodes. procedure Init; procedure Finish; procedure Free_All; subtype O_Element_List is Ortho_Code.Types.O_Element_List; -- Build a record type. procedure Start_Record_Type (Elements : out O_Element_List) renames Ortho_Code.Types.Start_Record_Type; -- Add a field in the record; not constrained array are prohibited, since -- its size is unlimited. procedure New_Record_Field (Elements : in out O_Element_List; El : out O_Fnode; Ident : O_Ident; Etype : O_Tnode) renames Ortho_Code.Types.New_Record_Field; -- Finish the record type. procedure Finish_Record_Type (Elements : in out O_Element_List; Res : out O_Tnode) renames Ortho_Code.Types.Finish_Record_Type; -- Build an uncomplete record type: -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type. -- This type can be declared or used to define access types on it. -- Then, complete (if necessary) the record type, by calling -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE. procedure New_Uncomplete_Record_Type (Res : out O_Tnode) renames Ortho_Code.Types.New_Uncomplete_Record_Type; procedure Start_Uncomplete_Record_Type (Res : O_Tnode; Elements : out O_Element_List) renames Ortho_Code.Types.Start_Uncomplete_Record_Type; -- Build an union type. procedure Start_Union_Type (Elements : out O_Element_List) renames Ortho_Code.Types.Start_Union_Type; procedure New_Union_Field (Elements : in out O_Element_List; El : out O_Fnode; Ident : O_Ident; Etype : O_Tnode) renames Ortho_Code.Types.New_Union_Field; procedure Finish_Union_Type (Elements : in out O_Element_List; Res : out O_Tnode) renames Ortho_Code.Types.Finish_Union_Type; -- Build an access type. -- DTYPE may be O_tnode_null in order to build an incomplete access type. -- It is completed with finish_access_type. function New_Access_Type (Dtype : O_Tnode) return O_Tnode renames Ortho_Code.Types.New_Access_Type; procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) renames Ortho_Code.Types.Finish_Access_Type; -- Build an array type. -- The array is not constrained and unidimensional. function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode) return O_Tnode renames Ortho_Code.Types.New_Array_Type; -- Build a constrained array type. function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode) return O_Tnode; -- Build a scalar type; size may be 8, 16, 32 or 64. function New_Unsigned_Type (Size : Natural) return O_Tnode renames Ortho_Code.Types.New_Unsigned_Type; function New_Signed_Type (Size : Natural) return O_Tnode renames Ortho_Code.Types.New_Signed_Type; -- Build a float type. function New_Float_Type return O_Tnode renames Ortho_Code.Types.New_Float_Type; -- Build a boolean type. procedure New_Boolean_Type (Res : out O_Tnode; False_Id : O_Ident; False_E : out O_Cnode; True_Id : O_Ident; True_E : out O_Cnode) renames Ortho_Code.Types.New_Boolean_Type; -- Create an enumeration subtype O_Enum_List is Ortho_Code.Types.O_Enum_List; -- Elements are declared in order, the first is ordered from 0. procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural) renames Ortho_Code.Types.Start_Enum_Type; procedure New_Enum_Literal (List : in out O_Enum_List; Ident : O_Ident; Res : out O_Cnode) renames Ortho_Code.Types.New_Enum_Literal; procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) renames Ortho_Code.Types.Finish_Enum_Type; ------------------- -- Expressions -- ------------------- subtype ON_Op_Kind is Ortho_Code.ON_Op_Kind; function "=" (L, R : ON_Op_Kind) return Boolean renames Ortho_Code."="; ON_Nil : constant ON_Op_Kind := Ortho_Code.ON_Nil; ON_Add_Ov : constant ON_Op_Kind := Ortho_Code.ON_Add_Ov; ON_Sub_Ov : constant ON_Op_Kind := Ortho_Code.ON_Sub_Ov; ON_Mul_Ov : constant ON_Op_Kind := Ortho_Code.ON_Mul_Ov; ON_Div_Ov : constant ON_Op_Kind := Ortho_Code.ON_Div_Ov; ON_Rem_Ov : constant ON_Op_Kind := Ortho_Code.ON_Rem_Ov; ON_Mod_Ov : constant ON_Op_Kind := Ortho_Code.ON_Mod_Ov; ON_And : constant ON_Op_Kind := Ortho_Code.ON_And; ON_Or : constant ON_Op_Kind := Ortho_Code.ON_Or; ON_Xor : constant ON_Op_Kind := Ortho_Code.ON_Xor; -- Monadic operations. ON_Not : constant ON_Op_Kind := Ortho_Code.ON_Not; ON_Neg_Ov : constant ON_Op_Kind := Ortho_Code.ON_Neg_Ov; ON_Abs_Ov : constant ON_Op_Kind := Ortho_Code.ON_Abs_Ov; -- Comparaisons ON_Eq : constant ON_Op_Kind := Ortho_Code.ON_Eq; ON_Neq : constant ON_Op_Kind := Ortho_Code.ON_Neq; ON_Le : constant ON_Op_Kind := Ortho_Code.ON_Le; ON_Lt : constant ON_Op_Kind := Ortho_Code.ON_Lt; ON_Ge : constant ON_Op_Kind := Ortho_Code.ON_Ge; ON_Gt : constant ON_Op_Kind := Ortho_Code.ON_Gt; subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor; subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov; subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt; subtype O_Storage is Ortho_Code.O_Storage; O_Storage_Private : constant O_Storage := Ortho_Code.O_Storage_Private; O_Storage_Local : constant O_Storage := Ortho_Code.O_Storage_Local; O_Storage_Public : constant O_Storage := Ortho_Code.O_Storage_Public; O_Storage_External : constant O_Storage := Ortho_Code.O_Storage_External; function "=" (L, R : O_Storage) return Boolean renames Ortho_Code."="; Type_Error : exception; Syntax_Error : exception; function New_Lit (Lit : O_Cnode) return O_Enode renames Ortho_Code.Exprs.New_Lit; -- Create a dyadic operation. -- Left and right nodes must have the same type. -- Binary operation is allowed only on boolean types. -- The result is of the type of the operands. function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode) return O_Enode renames Ortho_Code.Exprs.New_Dyadic_Op; -- Create a monadic operation. -- Result is of the type of operand. function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode) return O_Enode renames Ortho_Code.Exprs.New_Monadic_Op; -- Create a comparaison operator. -- NTYPE is the type of the result and must be a boolean type. function New_Compare_Op (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode) return O_Enode renames Ortho_Code.Exprs.New_Compare_Op; -- Create a literal from an integer. function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64) return O_Cnode renames Ortho_Code.Consts.New_Signed_Literal; function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64) return O_Cnode renames Ortho_Code.Consts.New_Unsigned_Literal; function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64) return O_Cnode renames Ortho_Code.Consts.New_Float_Literal; -- Create a null access literal. function New_Null_Access (Ltype : O_Tnode) return O_Cnode renames Ortho_Code.Consts.New_Null_Access; subtype O_Inter_List is Ortho_Code.Decls.O_Inter_List; subtype O_Record_Aggr_List is Ortho_Code.Consts.O_Record_Aggr_List; subtype O_Array_Aggr_List is Ortho_Code.Consts.O_Array_Aggr_List; subtype O_Assoc_List is Ortho_Code.Exprs.O_Assoc_List; subtype O_If_Block is Ortho_Code.Exprs.O_If_Block; subtype O_Case_Block is Ortho_Code.Exprs.O_Case_Block; -- Build a record/array aggregate. -- The aggregate is constant, and therefore can be only used to initialize -- constant declaration. -- ATYPE must be either a record type or an array subtype. -- Elements must be added in the order, and must be literals or aggregates. procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode) renames Ortho_Code.Consts.Start_Record_Aggr; procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List; Value : O_Cnode) renames Ortho_Code.Consts.New_Record_Aggr_El; procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode) renames Ortho_Code.Consts.Finish_Record_Aggr; procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode) renames Ortho_Code.Consts.Start_Array_Aggr; procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode) renames Ortho_Code.Consts.New_Array_Aggr_El; procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; Res : out O_Cnode) renames Ortho_Code.Consts.Finish_Array_Aggr; -- Build an union aggregate. function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode) return O_Cnode renames Ortho_Code.Consts.New_Union_Aggr; -- Returns the size in bytes of ATYPE. The result is a literal of -- unsigned type RTYPE -- ATYPE cannot be an unconstrained array type. function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode renames Ortho_Code.Consts.New_Sizeof; -- Returns the offset of FIELD in its record. The result is a literal -- of unsigned type RTYPE. function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode renames Ortho_Code.Consts.New_Offsetof; -- Get an element of an array. -- INDEX must be of the type of the array index. function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode) return O_Lnode renames Ortho_Code.Exprs.New_Indexed_Element; -- Get a slice of an array; this is equivalent to a conversion between -- an array or an array subtype and an array subtype. -- RES_TYPE must be an array_sub_type whose base type is the same as the -- base type of ARR. -- INDEX must be of the type of the array index. function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode) return O_Lnode renames Ortho_Code.Exprs.New_Slice; -- Get an element of a record. -- Type of REC must be a record type. function New_Selected_Element (Rec : O_Lnode; El : O_Fnode) return O_Lnode renames Ortho_Code.Exprs.New_Selected_Element; -- Reference an access. -- Type of ACC must be an access type. function New_Access_Element (Acc : O_Enode) return O_Lnode renames Ortho_Code.Exprs.New_Access_Element; -- Do a conversion. -- Allowed conversions are: -- FIXME: to write. function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode renames Ortho_Code.Exprs.New_Convert_Ov; -- Get the address of LVALUE. -- ATYPE must be a type access whose designated type is the type of LVALUE. -- FIXME: what about arrays. function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode renames Ortho_Code.Exprs.New_Address; function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode renames Ortho_Code.Consts.New_Global_Address; -- Same as New_Address but without any restriction. function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode renames Ortho_Code.Exprs.New_Unchecked_Address; function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode renames Ortho_Code.Consts.New_Global_Unchecked_Address; -- Get the address of a subprogram. function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) return O_Cnode renames Ortho_Code.Consts.New_Subprogram_Address; -- Get the value of an Lvalue. function New_Value (Lvalue : O_Lnode) return O_Enode renames Ortho_Code.Exprs.New_Value; -- Get the value of object OBJ. function New_Obj_Value (Obj : O_Dnode) return O_Enode; -- Return a pointer of type RTPE to SIZE bytes allocated on the stack. function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode renames Ortho_Code.Exprs.New_Alloca; --------------------- -- Declarations. -- --------------------- -- Following lines applies to FILENAME. procedure New_Debug_Filename_Decl (Filename : String) renames Ortho_Code.Abi.New_Debug_Filename_Decl; -- Line number of the next declaration. procedure New_Debug_Line_Decl (Line : Natural); -- Add a comment in the declarative region. procedure New_Debug_Comment_Decl (Comment : String); -- Declare a type. -- This simply gives a name to a type. procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) renames Ortho_Code.Decls.New_Type_Decl; -- Declare a constant. -- This simply gives a name to a constant value or aggregate. -- A constant cannot be modified and its storage cannot be local. -- ATYPE must be constrained. procedure New_Const_Decl (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode) renames Ortho_Code.Decls.New_Const_Decl; -- Set the value of a non-external constant. procedure Start_Const_Value (Const : in out O_Dnode); procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode); -- Create a variable declaration. -- A variable can be local only inside a function. -- ATYPE must be constrained. procedure New_Var_Decl (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode) renames Ortho_Code.Decls.New_Var_Decl; function New_Obj (Decl : O_Dnode) return O_Lnode renames Ortho_Code.Exprs.New_Obj; -- Start a subprogram declaration. -- Note: nested subprograms are allowed, ie o_storage_local subprograms can -- be declared inside a subprograms. It is not allowed to declare -- o_storage_external subprograms inside a subprograms. -- Return type and interfaces cannot be a composite type. procedure Start_Function_Decl (Interfaces : out O_Inter_List; Ident : O_Ident; Storage : O_Storage; Rtype : O_Tnode) renames Ortho_Code.Decls.Start_Function_Decl; -- For a subprogram without return value. procedure Start_Procedure_Decl (Interfaces : out O_Inter_List; Ident : O_Ident; Storage : O_Storage) renames Ortho_Code.Decls.Start_Procedure_Decl; -- Add an interface declaration to INTERFACES. procedure New_Interface_Decl (Interfaces : in out O_Inter_List; Res : out O_Dnode; Ident : O_Ident; Atype : O_Tnode) renames Ortho_Code.Decls.New_Interface_Decl; -- Finish the function declaration, get the node and a statement list. procedure Finish_Subprogram_Decl (Interfaces : in out O_Inter_List; Res : out O_Dnode) renames Ortho_Code.Decls.Finish_Subprogram_Decl; -- Start a subprogram body. -- Note: the declaration may have an external storage, in this case it -- becomes public. procedure Start_Subprogram_Body (Func : O_Dnode) renames Ortho_Code.Exprs.Start_Subprogram_Body; -- Finish a subprogram body. procedure Finish_Subprogram_Body renames Ortho_Code.Exprs.Finish_Subprogram_Body; ------------------- -- Statements. -- ------------------- -- Add a line number as a statement. procedure New_Debug_Line_Stmt (Line : Natural) renames Ortho_Code.Exprs.New_Debug_Line_Stmt; -- Add a comment as a statement. procedure New_Debug_Comment_Stmt (Comment : String); -- Start a declarative region. procedure Start_Declare_Stmt; procedure Finish_Declare_Stmt; -- Create a function call or a procedure call. procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode) renames Ortho_Code.Exprs.Start_Association; procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) renames Ortho_Code.Exprs.New_Association; function New_Function_Call (Assocs : O_Assoc_List) return O_Enode renames Ortho_Code.Exprs.New_Function_Call; procedure New_Procedure_Call (Assocs : in out O_Assoc_List) renames Ortho_Code.Exprs.New_Procedure_Call; -- Assign VALUE to TARGET, type must be the same or compatible. -- FIXME: what about slice assignment? procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode) renames Ortho_Code.Exprs.New_Assign_Stmt; -- Exit from the subprogram and return VALUE. procedure New_Return_Stmt (Value : O_Enode) renames Ortho_Code.Exprs.New_Return_Stmt; -- Exit from the subprogram, which doesn't return value. procedure New_Return_Stmt renames Ortho_Code.Exprs.New_Return_Stmt; -- Build an IF statement. procedure Start_If_Stmt (Block : out O_If_Block; Cond : O_Enode) renames Ortho_Code.Exprs.Start_If_Stmt; -- COND is NULL for the final else statement. procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode) renames Ortho_Code.Exprs.New_Elsif_Stmt; procedure New_Else_Stmt (Block : in out O_If_Block) renames Ortho_Code.Exprs.New_Else_Stmt; procedure Finish_If_Stmt (Block : in out O_If_Block) renames Ortho_Code.Exprs.Finish_If_Stmt; -- Create a infinite loop statement. procedure Start_Loop_Stmt (Label : out O_Snode) renames Ortho_Code.Exprs.Start_Loop_Stmt; procedure Finish_Loop_Stmt (Label : in out O_Snode) renames Ortho_Code.Exprs.Finish_Loop_Stmt; -- Exit from a loop stmt or from a for stmt. procedure New_Exit_Stmt (L : O_Snode) renames Ortho_Code.Exprs.New_Exit_Stmt; -- Go to the start of a loop stmt or of a for stmt. -- Loops/Fors between L and the current points are exited. procedure New_Next_Stmt (L : O_Snode) renames Ortho_Code.Exprs.New_Next_Stmt; -- Case statement. -- VALUE is the selector and must be a discrete type. procedure Start_Case_Stmt (Block : out O_Case_Block; Value : O_Enode) renames Ortho_Code.Exprs.Start_Case_Stmt; -- Start a branch before the choices. procedure Start_Choice (Block : in out O_Case_Block) renames Ortho_Code.Exprs.Start_Choice; procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) renames Ortho_Code.Exprs.New_Expr_Choice; procedure New_Range_Choice (Block : in out O_Case_Block; Low, High : O_Cnode) renames Ortho_Code.Exprs.New_Range_Choice; procedure New_Default_Choice (Block : in out O_Case_Block) renames Ortho_Code.Exprs.New_Default_Choice; -- Finish a branch after a choice, allow regular statements. procedure Finish_Choice (Block : in out O_Case_Block) renames Ortho_Code.Exprs.Finish_Choice; procedure Finish_Case_Stmt (Block : in out O_Case_Block) renames Ortho_Code.Exprs.Finish_Case_Stmt; end Ortho_Mcode;