----------------------------------------------- --------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . G E N E R A T O R S . C _ T R E E . N U T I L S -- -- -- -- S p e c -- -- -- -- Copyright (C) 2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina 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 distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Ocarina.Generators.C_Tree.Nodes; use Ocarina.Generators.C_Tree.Nodes; package Ocarina.Generators.C_Tree.Nutils is Int0_Val : value_id; Int1_Val : value_id; Var_Suffix : constant String := "_j"; Initialized : Boolean := False; Output_Tree_Warnings : Boolean := False; Output_Unit_Withing : Boolean := False; -- Control flags type token_type is ( -- Token name Token type -- Keywords tok_null, -- NULL **** First Keyword tok_break, -- BREAK tok_case, -- CASE tok_const, -- CONST tok_define, -- DEFINE tok_default, -- DEFAULT tok_endif, -- ENDIF tok_else, -- ELSE tok_enum, -- ENUM tok_extern, -- EXTERN tok_struct, -- STRUCT tok_union, -- UNION tok_exit, -- EXIT tok_goto, -- GOTO tok_if, -- IF tok_ifndef, -- IFNDEF tok_include, -- INCLUDE tok_return, -- RETURN tok_until, -- UNTIL tok_for, -- FOR tok_while, -- WHILE tok_switch, -- SWITCH tok_typedef, -- TYPEDEF -- Graphic Characters tok_xor, -- ^ tok_sharp, -- # tok_mod, -- % tok_not, -- ! tok_left_brace, -- { tok_right_brace, -- } tok_or, -- || tok_and, -- && tok_ampersand, -- & tok_minus, -- - tok_underscore, -- _ tok_plus, -- + tok_asterisk, -- * tok_slash, -- / tok_dot, -- . tok_apostrophe, -- ' tok_left_paren, -- ( tok_right_paren, -- ) tok_left_hook, -- [ tok_right_hook, -- ] tok_comma, -- , tok_less, -- < tok_equal, -- = tok_greater, -- > tok_not_equal, -- /= tok_greater_equal, -- >= tok_less_equal, -- <= tok_colon, -- : tok_greater_greater, -- >> tok_less_less, -- << tok_semicolon, -- ; tok_arrow, -- -> tok_vertical_bar); -- | Token_Image : array (token_type) of name_id; subtype keyword_type is token_type range tok_null .. tok_typedef; type operator_type is (op_not, -- not op_and, -- and op_in, -- in op_and_then, -- and then op_or, -- or op_or_else, -- or else op_and_symbol, -- & op_double_asterisk, -- ** op_minus, -- - op_plus, -- + op_asterisk, -- * op_slash, -- / op_less, -- < op_equal, -- = op_greater, -- > op_not_equal, -- /= op_greater_equal, -- >= op_less_equal, -- <= op_greater_greater, -- >> op_less_less, -- << op_semicolon, -- ; op_arrow, -- -> op_vertical_bar, -- | op_none); -- No operation Operator_Image : array (operator_type'pos (op_and) .. operator_type'pos (op_vertical_bar)) of name_id; subtype keyword_operator is operator_type range operator_type'first .. op_or_else; type parameter_id is (p_from, p_to, p_message, p_msg, p_request, p_status, p_offset, p_value); PN : array (parameter_id) of name_id; type member_id is (m_operation, m_protected_id, m_port, m_flags, m_vars); MN : array (member_id) of name_id; type constant_id is (c_null); CONST : array (constant_id) of name_id; type variable_id is (v_request, v_entity_table, v_mynode, v_node_addr, v_node_port, v_port_global_to_entity, v_port_global_to_local_port, v_server_entity_table, v_invalid_server, v_got_data, v_entity, v_port, v_message); VN : array (variable_id) of name_id; type function_id is (f_process_request, f_register_source, f_init_lane, f_sizeof, f_create); FN : array (function_id) of name_id; type component_id is (c_address, c_dispatcher, c_from, c_los, c_name, c_pid, c_proc_id, c_switch, c_conf_table, c_priority, c_operation); CN : array (component_id) of name_id; type attribute_id is (a_access, a_class, a_first, a_pos, a_range, a_val, a_identity, a_adress, a_last); AN : array (attribute_id) of name_id; type type_id is (t_char, t_float, t_int, t_int8_t, t_int16_t, t_int32_t, t_int64_t, t_void, t_unsigned); TN : array (type_id) of name_id; type pragma_id is (pragma_elaborate_body, pragma_import, pragma_export, pragma_inline, pragma_no_return, pragma_preelaborate, pragma_priority, pragma_style_checks, pragma_unreferenced, pragma_warnings); GN : array (pragma_id) of name_id; type error_id is (e_program_error, e_constraint_error, e_nyi); EN : array (error_id) of name_id; function Add_Prefix_To_Name (Prefix : String; Name : name_id) return name_id; function Add_Suffix_To_Name (Suffix : String; Name : name_id) return name_id; function Remove_Suffix_From_Name (Suffix : String; Name : name_id) return name_id; -- This function returns a new name without the suffix. If the -- suffix does not exist, the returned name is equal to the given -- name. procedure Append_Node_To_List (E : node_id; L : list_id); procedure Insert_After_Node (E : node_id; N : node_id); procedure Insert_Before_Node (E : node_id; N : node_id; L : list_id); procedure Push_Entity (E : node_id); procedure Pop_Entity; function Current_Entity return node_id; function Current_File return node_id; function Copy_Node (N : node_id) return node_id; function New_Node (Kind : node_kind; From : node_id := No_Node) return node_id; function New_List (Kind : node_kind; From : node_id := No_Node) return list_id; function Image (T : token_type) return String; function Image (O : operator_type) return String; procedure Initialize; procedure New_Token (T : token_type; I : String := ""); function Length (L : list_id) return Natural; procedure Remove_Node_From_List (E : node_id; L : list_id); -- Remove node N to list L. function Is_Empty (L : list_id) return Boolean; pragma inline (Is_Empty); -- Return True when L is empty function Make_C_Comment (N : name_id; Has_Header_Spaces : Boolean := True) return node_id; -- This function does only the fllowing thing: it creates a node -- whose name is the full text of the comment. It does not split -- the comment into many lines. This is done in the code -- generation phase function Make_Assignment_Statement (Variable_Identifier : node_id; Expression : node_id) return node_id; function Make_Defining_Identifier (Name : name_id; C_Conversion : Boolean := True) return node_id; function Make_Expression (Left_Expr : node_id; Operator : operator_type := op_none; Right_Expr : node_id := No_Node) return node_id; function Make_For_Statement (Defining_Identifier : node_id; Pre_Cond : node_id; Condition : node_id; Post_Cond : node_id; Statements : list_id) return node_id; function Make_Variable_Declaration (Defining_Identifier : node_id; Used_Type : node_id) return node_id; function Make_Member_Declaration (Defining_Identifier : node_id; Used_Type : node_id) return node_id; function Make_Enum_Aggregate (Members : list_id) return node_id; function Make_Struct_Aggregate (Defining_Identifier : node_id := No_Node; Members : list_id) return node_id; function Make_Union_Aggregate (Defining_Identifier : node_id := No_Node; Members : list_id) return node_id; function Make_While_Statement (Condition : node_id; Statements : list_id) return node_id; function Make_Full_Type_Declaration (Defining_Identifier : node_id; Type_Definition : node_id) return node_id; -- No_Node as Type_Definition made type declaration without actual -- definition (eg. "type X;"). function Make_If_Statement (Condition : node_id; Statements : list_id; Else_Statements : list_id := No_List) return node_id; function Make_List_Id (N1 : node_id; N2 : node_id := No_Node; N3 : node_id := No_Node) return list_id; function Make_Parameter_Specification (Defining_Identifier : node_id; Parameter_Type : node_id := No_Node) return node_id; function Make_Return_Statement (Expression : node_id := No_Node) return node_id; function Make_Call_Profile (Defining_Identifier : node_id; Parameters : list_id := No_List) return node_id; function Make_Function_Implementation (Specification : node_id; Declarations : list_id; Statements : list_id) return node_id; function Make_Function_Specification (Defining_Identifier : node_id; Parameters : list_id := No_List; Return_Type : node_id := No_Node) return node_id; function Make_Type_Attribute (Designator : node_id; Attribute : attribute_id) return node_id; function Make_Type_Conversion (Subtype_Mark : node_id; Expression : node_id) return node_id; procedure Make_Comment_Header (Header : list_id); -- This procedure generates a comment header for the generated -- packages. function Next_N_Node (N : node_id; Num : Natural) return node_id; -- This function executes Next_Node Num times function Message_Comment (M : name_id) return node_id; function Message_Comment (M : String) return node_id; -- Return a comment message. Used by all the tree -- converters procedure Set_Activity_Source (N : node_id := No_Node); procedure Set_Activity_Header (N : node_id := No_Node); procedure Set_Main_Source (N : node_id := No_Node); procedure Set_Main_Header (N : node_id := No_Node); procedure Set_Request_Source (N : node_id := No_Node); procedure Set_Request_Header (N : node_id := No_Node); function To_C_Name (N : name_id) return name_id; -- Convert N to a valid Ada identifier (no clashing with keywords, -- no consecutive '_', no heading '_'...). function Unit_Name (N : name_id) return name_id; -- Given an ENTITY fully qualified name A.B.C.D, returns A.B.C -- Raises an arror if the name does not contains any dot. function Local_Name (N : name_id) return name_id; -- Given an ENTITY fully qualified name A.B.C.D, returns D function Conventional_Base_Name (N : name_id) return name_id; -- Given a UNIT fully qualified name A.D.C, returns a-b-c function Fully_Qualified_Name (N : node_id) return name_id; function Make_Source_File (Identifier : node_id) return node_id; function Make_Header_File (Identifier : node_id) return node_id; procedure Set_Deployment_Header (N : node_id := No_Node); function Make_Literal (Value : value_id) return node_id; function Make_Define_Statement (Defining_Identifier : node_id; Value : node_id) return node_id; function Make_Pointer_Type (Used_Type : node_id) return node_id; procedure Add_Include (E : node_id); procedure Set_Types_Header (N : node_id := No_Node); procedure Set_Types_Source (N : node_id := No_Node); procedure Set_Naming_Source (N : node_id := No_Node); procedure Set_Subprograms_Source (N : node_id := No_Node); procedure Set_Subprograms_Header (N : node_id := No_Node); procedure Set_Marshallers_Source (N : node_id := No_Node); procedure Set_Marshallers_Header (N : node_id := No_Node); function Make_Variable_Address (Expression : node_id) return node_id; function Make_Member_Designator (Defining_Identifier : node_id; Aggregate_Name : node_id; Is_Pointer : Boolean := False) return node_id; function Make_Switch_Alternative (Labels : list_id; Statements : list_id) return node_id; function Make_Switch_Statement (Expression : node_id; Alternatives : list_id) return node_id; procedure Handle_Call_Sequence (Caller : node_id; Call_Seq : node_id; Declarations : list_id; Statements : list_id); procedure Set_Deployment_Source (N : node_id := No_Node); function Make_Array_Declaration (Defining_Identifier : node_id; Array_Size : node_id) return node_id; function Make_Array_Values (Values : list_id := No_List) return node_id; function Make_Extern_Entity_Declaration (Entity : node_id) return node_id; function Make_Constant_Type (Used_Type : node_id) return node_id; procedure Set_Naming_Header (N : node_id := No_Node); function Get_C_Default_Value (D : node_id) return node_id; end Ocarina.Generators.C_Tree.Nutils;