------------------------------------------ -------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . G E N E R A T O R S . C _ T R E E . G E N E R A T O R -- -- -- -- B o d y -- -- -- -- 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 Namet; use Namet; with Output; use Output; with Utils; use Utils; with GNAT.OS_Lib; use GNAT.OS_Lib; with Ocarina.Generators.Utils; with Ocarina.Generators.C_Tree.Nodes; with Ocarina.Generators.C_Tree.Nutils; with Ocarina.Generators.C_Values; with Ocarina.Generators.Messages; package body Ocarina.Generators.C_Tree.Generator is use Ocarina.Generators.Utils; use Ocarina.Generators.C_Tree.Nodes; use Ocarina.Generators.C_Tree.Nutils; use Ocarina.Generators.C_Values; use Ocarina.Generators.Messages; procedure Generate_Define_Statement (N : node_id); procedure Generate_Pointer_Type (N : node_id); procedure Generate_Constant_Type (N : node_id); procedure Generate_Array_Declaration (N : node_id); procedure Generate_Base_Type (N : node_id); procedure Generate_C_Comment (N : node_id); procedure Generate_Call_Profile (N : node_id); procedure Generate_HI_Distributed_Application (N : node_id); procedure Generate_HI_Node (N : node_id); procedure Generate_Assignment_Statement (N : node_id); procedure Generate_Defining_Identifier (N : node_id); procedure Generate_Expression (N : node_id); procedure Generate_Enum_Aggregate (N : node_id); procedure Generate_Array_Values (N : node_id); procedure Generate_For_Statement (N : node_id); procedure Generate_Full_Type_Declaration (N : node_id); procedure Generate_Function_Implementation (N : node_id); procedure Generate_Function_Specification (N : node_id); procedure Generate_If_Statement (N : node_id); procedure Generate_Literal (N : node_id); procedure Generate_Member_Declaration (N : node_id); procedure Generate_Variable_Declaration (N : node_id); procedure Generate_Parameter (N : node_id); procedure Generate_Parameter_List (L : list_id); procedure Generate_Return_Statement (N : node_id); procedure Generate_Struct_Aggregate (N : node_id); procedure Generate_Type_Conversion (N : node_id); procedure Generate_Union_Aggregate (N : node_id); procedure Generate_While_Statement (N : node_id); procedure Generate_Source_File (N : node_id); procedure Generate_Header_File (N : node_id); procedure Generate_HI_Unit (N : node_id); procedure Generate_Included_Files (N : list_id); procedure Generate_Variable_Address (N : node_id); procedure Generate_Member_Designator (N : node_id); procedure Generate_Switch_Alternative (N : node_id); procedure Generate_Switch_Statement (N : node_id); procedure Generate_Extern_Entity_Declaration (N : node_id); procedure Write (T : token_type); procedure Write_Line (T : token_type); procedure Generate_Statement_Delimiter (N : node_id); procedure Generate_Comment_Box (M : name_id); function Get_File_Name (N : node_id) return name_id; -- Generate an Ada file name from the package node given as -- parameter procedure Release_Output (Fd : File_Descriptor); -- Releases the output by closing the opened files function Set_Output (N : node_id) return File_Descriptor; -- Adjust the output depending on the command line options and -- return a file descriptor in order to be able to close it. ------------------- -- Get_File_Name -- ------------------- function Get_File_Name (N : node_id) return name_id is Header_Suffix : constant String := ".h"; Source_Suffix : constant String := ".c"; begin -- The File name corresponding to a package is the lowerd filly -- qualified name of the package. All '.' separators are -- replaced by '-'. Get_Name_String (Conventional_Base_Name (Fully_Qualified_Name (Defining_Identifier (N)))); -- Adding file suffix if Kind (N) = k_header_file then Add_Str_To_Name_Buffer (Header_Suffix); else Add_Str_To_Name_Buffer (Source_Suffix); end if; return Name_Find; end Get_File_Name; ---------------- -- Set_Output -- ---------------- function Set_Output (N : node_id) return File_Descriptor is begin if not Print_On_Stdout then declare File_Name : constant name_id := Get_File_Name (N); Fd : File_Descriptor; begin Get_Name_String (File_Name); -- Create a new file and overwrites existing file with -- the same name Fd := Create_File (Name_Buffer (1 .. Name_Len), Text); if Fd = Invalid_FD then raise Program_Error; end if; -- Setting the output Set_Output (Fd); return Fd; end; end if; return Invalid_FD; end Set_Output; -------------------- -- Release_Output -- -------------------- procedure Release_Output (Fd : File_Descriptor) is begin if not Print_On_Stdout and then Fd /= Invalid_FD then Set_Standard_Output; Close (Fd); end if; end Release_Output; -------------- -- Generate -- -------------- procedure Generate (N : node_id) is begin case Kind (N) is when k_header_file => Generate_Header_File (N); when k_source_file => Generate_Source_File (N); when k_c_comment => Generate_C_Comment (N); when k_hi_distributed_application => Generate_HI_Distributed_Application (N); when k_hi_unit => Generate_HI_Unit (N); when k_hi_node => Generate_HI_Node (N); when k_assignment_statement => Generate_Assignment_Statement (N); when k_call_profile => Generate_Call_Profile (N); when k_defining_identifier => Generate_Defining_Identifier (N); when k_expression => Generate_Expression (N); when k_enum_aggregate => Generate_Enum_Aggregate (N); when k_for_statement => Generate_For_Statement (N); when k_while_statement => Generate_While_Statement (N); when k_full_type_declaration => Generate_Full_Type_Declaration (N); when k_if_statement => Generate_If_Statement (N); when k_function_implementation => Generate_Function_Implementation (N); when k_function_specification => Generate_Function_Specification (N); when k_literal => Generate_Literal (N); when k_extern_entity_declaration => Generate_Extern_Entity_Declaration (N); when k_array_values => Generate_Array_Values (N); when k_member_declaration => Generate_Member_Declaration (N); when k_variable_declaration => Generate_Variable_Declaration (N); when k_return_statement => Generate_Return_Statement (N); when k_struct_aggregate => Generate_Struct_Aggregate (N); when k_type_conversion => Generate_Type_Conversion (N); when k_union_aggregate => Generate_Union_Aggregate (N); when k_define_statement => Generate_Define_Statement (N); when k_pointer_type => Generate_Pointer_Type (N); when k_constant_type => Generate_Constant_Type (N); when k_variable_address => Generate_Variable_Address (N); when k_member_designator => Generate_Member_Designator (N); when k_switch_statement => Generate_Switch_Statement (N); when k_switch_alternative => Generate_Switch_Alternative (N); when k_array_declaration => Generate_Array_Declaration (N); when k_float .. k_void => Generate_Base_Type (N); when others => Display_Error ("other element in generator", Fatal => False); null; end case; end Generate; -------------------------- -- Generate_C_Comment -- -------------------------- procedure Generate_C_Comment (N : node_id) is -- This procedure does the following : -- * It generates an ada comment basing on the name of node N -- * If the name it too long, and depending on the location of -- the comment in the source code, the procedure splits the -- comment into more than a line. -- The comment is assumed to be a sequence of caracters, -- beginning and ending with a NON-SPACE caracter. -- A word is : -- a space character, or else a sequence of non space -- characters located between two spaces. -- The maximum length of a line, in colums Max_Line_Length : constant Natural := 78; function Are_There_More_Words return Boolean; -- This function returns True if there are words in the buffer function Next_Word_Length return Natural; -- This function returns the size of the next word to be -- got. It returns zero when the buffer is empty. function Get_Next_Word return String; -- This function extracts the next word from the buffer -------------------------- -- Are_There_More_Words -- -------------------------- function Are_There_More_Words return Boolean is begin return (Name_Len /= 0); end Are_There_More_Words; ---------------------- -- Next_Word_Length -- ---------------------- function Next_Word_Length return Natural is L : Natural; begin if not Are_There_More_Words then L := 0; elsif Name_Buffer (1) = ' ' then L := 1; else L := 0; while L + 1 <= Name_Len and then Name_Buffer (L + 1) /= ' ' loop L := L + 1; end loop; end if; return L; end Next_Word_Length; ------------------- -- Get_Next_Word -- ------------------- function Get_Next_Word return String is L : constant Natural := Next_Word_Length; begin if L = 0 then return ""; else declare Next_Word : constant String := Name_Buffer (1 .. L); begin if Name_Len = L then Name_Len := 0; else Set_Str_To_Name_Buffer (Name_Buffer (L + 1 .. Name_Len)); end if; return Next_Word; end; end if; end Get_Next_Word; First_Line : Boolean := True; Used_Columns : Natural; begin Get_Name_String (Name (Defining_Identifier (N))); while Are_There_More_Words loop Used_Columns := N_Space; if First_Line then First_Line := False; else Write_Indentation; end if; -- We consume 4 colums Used_Columns := Used_Columns + 2; Write_Str ("/*"); if Has_Header_Spaces (N) then Used_Columns := Used_Columns + 2; Write_Str (" "); end if; Used_Columns := Used_Columns + Next_Word_Length; Write_Str (Get_Next_Word); while Are_There_More_Words and then (Used_Columns + Next_Word_Length < Max_Line_Length) loop Used_Columns := Used_Columns + Next_Word_Length; Write_Str (Get_Next_Word); end loop; Write_Str ("*/"); if Are_There_More_Words then Write_Eol; end if; end loop; Write_Eol; end Generate_C_Comment; ----------------------------------- -- Generate_Assignment_Statement -- ----------------------------------- procedure Generate_Assignment_Statement (N : node_id) is begin Generate (Defining_Identifier (N)); Write_Space; Write (tok_equal); Write_Eol; Increment_Indentation; Write_Indentation (-1); Generate (Expression (N)); Decrement_Indentation; end Generate_Assignment_Statement; -------------------------------- -- Generate_Array_Declaration -- -------------------------------- procedure Generate_Array_Declaration (N : node_id) is begin Generate (Defining_Identifier (N)); Write (tok_left_hook); Generate (Array_Size (N)); Write (tok_right_hook); end Generate_Array_Declaration; ---------------------------------------- -- Generate_Extern_Entity_Declaration -- ---------------------------------------- procedure Generate_Extern_Entity_Declaration (N : node_id) is begin Write (tok_extern); Write_Space; Generate (Entity (N)); end Generate_Extern_Entity_Declaration; --------------------------- -- Generate_Array_Values -- --------------------------- procedure Generate_Array_Values (N : node_id) is D : node_id := First_Node (Values (N)); begin Write (tok_left_brace); while Present (D) loop Generate (D); D := Next_Node (D); if Present (D) then Write (tok_comma); end if; end loop; Write (tok_right_brace); end Generate_Array_Values; ---------------------------------- -- Generate_Defining_Identifier -- ---------------------------------- procedure Generate_Defining_Identifier (N : node_id) is begin Write_Name (Name (N)); end Generate_Defining_Identifier; ------------------------- -- Generate_Expression -- ------------------------- procedure Generate_Expression (N : node_id) is L_Expr : constant node_id := Left_Expression (N); Op : constant operator_id := Operator (N); R_Expr : constant node_id := Right_Expression (N); begin -- Each expression having a right part and a left part is -- systematically put between two parentheses. Generate (L_Expr); Write_Space; Write_Name (Operator_Image (Standard.Integer (Op))); Write_Space; Generate (R_Expr); end Generate_Expression; ---------------------------- -- Generate_For_Statement -- ---------------------------- procedure Generate_For_Statement (N : node_id) is D : node_id := First_Node (Statements (N)); begin Write (tok_for); Write_Space; Write (tok_left_paren); Generate (Pre_Cond (N)); Write (tok_semicolon); Generate (Condition (N)); Write (tok_semicolon); Generate (Post_Cond (N)); Write (tok_right_paren); Write_Eol; Write (tok_left_brace); Increment_Indentation; while Present (D) loop Write_Indentation; Generate (D); Generate_Statement_Delimiter (D); D := Next_Node (D); end loop; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_For_Statement; ------------------------------------ -- Generate_Full_Type_Declaration -- ------------------------------------ procedure Generate_Full_Type_Declaration (N : node_id) is begin Write (tok_typedef); Write_Space; Generate (Type_Definition (N)); Write_Space; Write_Name (Name (Defining_Identifier (N))); end Generate_Full_Type_Declaration; --------------------------- -- Generate_If_Statement -- --------------------------- procedure Generate_If_Statement (N : node_id) is T : constant list_id := Statements (N); E : constant list_id := Else_Statements (N); I : node_id; begin -- Enter If_Statement Write (tok_if); Write_Space; Write (tok_left_paren); Generate (Condition (N)); Write (tok_right_paren); Write_Eol; Write_Indentation; Write (tok_left_brace); Write_Eol; Write_Indentation; -- If_Statement cannot be empty. A null statement is always -- there if needed. Increment_Indentation; I := First_Node (T); while Present (I) loop Write_Indentation; Generate (I); Generate_Statement_Delimiter (I); I := Next_Node (I); end loop; Write_Eol; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); -- Else_Statement can be empty if not Is_Empty (E) then Write_Indentation; Write (tok_else); Write_Eol; Write (tok_left_brace); Write_Eol; Increment_Indentation; I := First_Node (E); while Present (I) loop Write_Indentation; Generate (I); Generate_Statement_Delimiter (I); I := Next_Node (I); end loop; Decrement_Indentation; Write_Eol; Write_Indentation; Write (tok_right_brace); Write_Eol; end if; end Generate_If_Statement; ---------------------- -- Generate_Literal -- ---------------------- procedure Generate_Literal (N : node_id) is begin Write_Str (Image (Value (N))); end Generate_Literal; ----------------------------- -- Generate_While_Statement -- ----------------------------- procedure Generate_While_Statement (N : node_id) is D : node_id := First_Node (Statements (N)); begin Write (tok_while); Write_Space; Write (tok_left_paren); Generate (Condition (N)); Write (tok_right_paren); Write_Eol; Write_Indentation; Write (tok_left_brace); Write_Eol; Increment_Indentation; while Present (D) loop Write_Indentation; Generate (D); Generate_Statement_Delimiter (D); D := Next_Node (D); end loop; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_While_Statement; ------------------------ -- Generate_Parameter -- ------------------------ procedure Generate_Parameter (N : node_id) is begin Generate (Parameter_Type (N)); Write_Space; Name_Buffer (1 .. Var_Name_Len) := (others => ' '); Get_Name_String (Name (Defining_Identifier (N))); if Var_Name_Len > Name_Len then Name_Len := Var_Name_Len; end if; Write_Str (Name_Buffer (1 .. Name_Len)); end Generate_Parameter; ----------------------------- -- Generate_Parameter_List -- ----------------------------- procedure Generate_Parameter_List (L : list_id) is N : node_id; begin -- If we got there, then L is not empty. if Is_Empty (L) then Write (tok_left_paren); Write (tok_right_paren); return; end if; Write_Eol; Increment_Indentation; Increment_Indentation; Write_Indentation; Write (tok_left_paren); N := First_Node (L); loop Generate_Parameter (N); exit when No (Next_Node (N)); Write (tok_comma); N := Next_Node (N); Write_Eol; Write_Indentation; end loop; Write (tok_right_paren); Decrement_Indentation; Decrement_Indentation; Write_Indentation; end Generate_Parameter_List; ------------------------------- -- Generate_Return_Statement -- ------------------------------- procedure Generate_Return_Statement (N : node_id) is E : constant node_id := Expression (N); begin Write (tok_return); if Present (E) then Write_Space; Write (tok_left_paren); Generate (E); Write (tok_right_paren); end if; end Generate_Return_Statement; --------------------------- -- Generate_Call_Profile -- --------------------------- procedure Generate_Call_Profile (N : node_id) is L : constant list_id := Parameters (N); P : node_id; begin Generate (Defining_Identifier (N)); Write (tok_left_paren); if not Is_Empty (L) then P := First_Node (L); loop Generate (P); P := Next_Node (P); exit when No (P); Write (tok_comma); end loop; end if; Write (tok_right_paren); end Generate_Call_Profile; -------------------------------------- -- Generate_Function_Implementation -- -------------------------------------- procedure Generate_Function_Implementation (N : node_id) is D : constant list_id := Declarations (N); S : constant list_id := Statements (N); P : constant node_id := Specification (N); M : node_id; begin Generate_Comment_Box (Name (Defining_Identifier (P))); Write_Eol; Write_Indentation; Generate (P); Write_Eol; Write (tok_left_brace); Write_Eol; Increment_Indentation; if not Is_Empty (D) then M := First_Node (D); while Present (M) loop Write_Indentation; Generate (M); Generate_Statement_Delimiter (M); M := Next_Node (M); end loop; end if; Write_Eol; if not Is_Empty (S) then M := First_Node (S); while Present (M) loop Write_Indentation; Generate (M); Generate_Statement_Delimiter (M); M := Next_Node (M); end loop; end if; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); Write_Eol; end Generate_Function_Implementation; --------------------------------------- -- Generate_Function_Specification -- --------------------------------------- procedure Generate_Function_Specification (N : node_id) is P : constant list_id := Parameters (N); T : constant node_id := Return_Type (N); begin -- If we deal with a main subprogram, then we generate its -- withed packages if T /= No_Node then Generate (T); end if; if Present (Defining_Identifier (N)) then Write_Space; Write_Name (Name (Defining_Identifier (N))); end if; Write_Space; Generate_Parameter_List (P); end Generate_Function_Specification; ------------------------------ -- Generate_Struct_Aggregate -- ------------------------------ procedure Generate_Struct_Aggregate (N : node_id) is P : node_id := First_Node (Struct_Members (N)); begin Write (tok_struct); Write_Eol; Write_Indentation; Write (tok_left_brace); Write_Eol; Increment_Indentation; while Present (P) loop Write_Indentation; Generate (P); Generate_Statement_Delimiter (P); P := Next_Node (P); Write_Eol; end loop; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_Struct_Aggregate; ----------------------------- -- Generate_Enum_Aggregate -- ----------------------------- procedure Generate_Enum_Aggregate (N : node_id) is P : node_id := First_Node (Enum_Members (N)); begin Write (tok_enum); Write_Eol; Write (tok_left_brace); Write_Eol; Increment_Indentation; while Present (P) loop Write_Indentation; Generate (P); P := Next_Node (P); if Present (P) then Write (tok_comma); end if; Write_Eol; end loop; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_Enum_Aggregate; ------------------------------ -- Generate_Union_Aggregate -- ------------------------------ procedure Generate_Union_Aggregate (N : node_id) is P : node_id; begin Write (tok_union); Write_Eol; Write_Indentation; Write (tok_left_brace); Write_Eol; Increment_Indentation; if not Is_Empty (Union_Members (N)) then P := First_Node (Union_Members (N)); while Present (P) loop Write_Indentation; Generate (P); Generate_Statement_Delimiter (P); P := Next_Node (P); Write_Eol; end loop; end if; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_Union_Aggregate; ------------------------------- -- Generate_Switch_Statement -- ------------------------------- procedure Generate_Switch_Statement (N : node_id) is P : node_id; begin if Is_Empty (Alternatives (N)) then return; end if; Write (tok_switch); Write_Space; Write (tok_left_paren); Generate (Expression (N)); Write (tok_right_paren); Write_Eol; Write_Indentation; Write (tok_left_brace); Write_Eol; Increment_Indentation; P := First_Node (Alternatives (N)); while Present (P) loop Write_Indentation; Generate (P); P := Next_Node (P); Write_Eol; end loop; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_Switch_Statement; --------------------------------- -- Generate_Switch_Alternative -- --------------------------------- procedure Generate_Switch_Alternative (N : node_id) is P : node_id; begin if Is_Empty (Labels (N)) then Write (tok_default); Write (tok_colon); else P := First_Node (Labels (N)); while Present (P) loop Write (tok_case); Write_Space; Generate (P); Write (tok_colon); P := Next_Node (P); end loop; end if; Write_Eol; Write_Indentation; Write (tok_left_brace); Write_Eol; Increment_Indentation; if not Is_Empty (Statements (N)) then P := First_Node (Statements (N)); while Present (P) loop Write_Indentation; Generate (P); Generate_Statement_Delimiter (P); P := Next_Node (P); Write_Eol; end loop; end if; Write_Indentation; Write (tok_break); Write (tok_semicolon); Write_Eol; Decrement_Indentation; Write_Indentation; Write (tok_right_brace); end Generate_Switch_Alternative; ----------------------------------- -- Generate_Variable_Declaration -- ----------------------------------- procedure Generate_Variable_Declaration (N : node_id) is begin Generate (Used_Type (N)); Write_Space; Generate (Defining_Identifier (N)); end Generate_Variable_Declaration; --------------------------------- -- Generate_Member_Declaration -- --------------------------------- procedure Generate_Member_Declaration (N : node_id) is begin Generate (Used_Type (N)); Write_Space; Generate (Defining_Identifier (N)); end Generate_Member_Declaration; ----------------------------------------- -- Generate_HI_Distributed_Application -- ----------------------------------------- procedure Generate_HI_Distributed_Application (N : node_id) is P : node_id := First_Node (HI_Nodes (N)); Application_Directory : name_id; begin -- Create the application directory (a lower case string) Get_Name_String (Name (N)); Application_Directory := To_Lower (Name_Find); Create_Directory (Application_Directory); -- Process the application nodes Enter_Directory (Application_Directory); while Present (P) loop Generate (P); P := Next_Node (P); end loop; Leave_Directory; end Generate_HI_Distributed_Application; ---------------------- -- Generate_HI_Node -- ---------------------- procedure Generate_HI_Node (N : node_id) is U : node_id := First_Node (Units (N)); Partition_Directory : constant name_id := To_Lower (Name (N)); begin -- Create the node directory Create_Directory (Partition_Directory); Enter_Directory (Partition_Directory); while Present (U) loop Generate (U); U := Next_Node (U); end loop; Leave_Directory; end Generate_HI_Node; ----------- -- Write -- ----------- procedure Write (T : token_type) is begin Write_Name (Token_Image (T)); end Write; ---------------- -- Write_Line -- ---------------- procedure Write_Line (T : token_type) is begin Write (T); Write_Eol; end Write_Line; ---------------------------------- -- Generate_Statement_Delimiter -- ---------------------------------- procedure Generate_Statement_Delimiter (N : node_id) is begin if No (N) or else Kind (N) = k_define_statement or else Kind (N) = k_switch_statement or else Kind (N) = k_switch_alternative or else Kind (N) = k_while_statement or else Kind (N) = k_if_statement or else Kind (N) = k_function_implementation then Write_Eol; elsif Kind (N) /= k_c_comment then Write_Line (tok_semicolon); end if; end Generate_Statement_Delimiter; -------------------------- -- Generate_Comment_Box -- -------------------------- procedure Generate_Comment_Box (M : name_id) is begin Get_Name_String (M); Write_Eol; Write_Str ("/*"); for I in 1 .. Name_Len + 4 loop Write_Char ('*'); end loop; Write_Str ("*/"); Write_Eol; Write_Indentation; Write_Str ("/* "); Write_Name (M); Write_Str (" */ "); Write_Eol; Write_Indentation; Write_Str ("/*"); for I in 1 .. Name_Len + 4 loop Write_Char ('*'); end loop; Write_Str ("*/"); Write_Eol; end Generate_Comment_Box; ------------------------------ -- Generate_Type_Conversion -- ------------------------------ procedure Generate_Type_Conversion (N : node_id) is begin Generate (Subtype_Mark (N)); Write_Eol; Increment_Indentation; Write_Indentation (-1); Write (tok_left_paren); Generate (Expression (N)); Write (tok_right_paren); Decrement_Indentation; end Generate_Type_Conversion; -------------------------- -- Generate_Source_File -- -------------------------- procedure Generate_Source_File (N : node_id) is Fd : File_Descriptor; D : node_id := First_Node (Declarations (N)); begin if No (N) then return; end if; Fd := Set_Output (N); if not Is_Empty (Included_Headers (N)) then Generate_Included_Files (Included_Headers (N)); end if; while Present (D) loop Generate (D); Generate_Statement_Delimiter (D); D := Next_Node (D); end loop; Write_Eol; -- Always leave a blank line at the end of a C-source file Release_Output (Fd); end Generate_Source_File; ----------------------------- -- Generate_Included_Files -- ----------------------------- procedure Generate_Included_Files (N : list_id) is H : node_id := First_Node (N); begin while Present (H) loop Write (tok_sharp); Write (tok_include); Write_Space; Write (tok_less); Generate (H); Write (tok_dot); Write_Str ("h"); Write (tok_greater); Write_Eol; H := Next_Node (H); end loop; end Generate_Included_Files; -------------------------- -- Generate_Header_File -- -------------------------- procedure Generate_Header_File (N : node_id) is Fd : File_Descriptor; D : node_id := First_Node (Declarations (N)); NA : name_id; begin if No (D) then return; end if; NA := Name (Defining_Identifier (N)); NA := To_Upper (NA); Fd := Set_Output (N); Write (tok_sharp); Write (tok_ifndef); Write_Space; Write (tok_underscore); Write (tok_underscore); Write_Name (NA); Write (tok_underscore); Write_Str ("H"); Write (tok_underscore); Write_Eol; Write (tok_sharp); Write (tok_define); Write_Space; Write (tok_underscore); Write (tok_underscore); Write_Name (NA); Write (tok_underscore); Write_Str ("H"); Write (tok_underscore); Write_Space; Write_Eol; if not Is_Empty (Included_Headers (N)) then Generate_Included_Files (Included_Headers (N)); end if; while Present (D) loop Generate (D); Generate_Statement_Delimiter (D); Write_Eol; D := Next_Node (D); end loop; Write (tok_sharp); Write (tok_endif); Write_Eol; -- Always leave a blank line at the end of a C-source file Release_Output (Fd); end Generate_Header_File; ------------------------ -- Generate_Base_Type -- ------------------------ procedure Generate_Base_Type (N : node_id) is begin case Kind (N) is when k_int => Write_Str ("int"); when k_float => Write_Str ("float"); when k_char => Write_Str ("char"); when k_void => Write_Str ("void"); when others => Display_Error ("other element in generator", Fatal => False); null; end case; end Generate_Base_Type; ---------------------- -- Generate_HI_Unit -- ---------------------- procedure Generate_HI_Unit (N : node_id) is S : node_id := First_Node (Sources (N)); H : node_id := First_Node (Headers (N)); begin while Present (S) loop Generate (S); S := Next_Node (S); end loop; while Present (H) loop Generate (H); H := Next_Node (H); end loop; end Generate_HI_Unit; ------------------------------- -- Generate_Define_Statement -- ------------------------------- procedure Generate_Define_Statement (N : node_id) is V : constant node_id := Defined_Value (N); I : constant node_id := Defining_Identifier (N); begin Write (tok_sharp); Write (tok_define); Write_Space; Generate (I); Write_Space; Generate (V); end Generate_Define_Statement; --------------------------- -- Generate_Pointer_Type -- --------------------------- procedure Generate_Pointer_Type (N : node_id) is begin Generate (Used_Type (N)); Write (tok_asterisk); end Generate_Pointer_Type; ---------------------------- -- Generate_Constant_Type -- ---------------------------- procedure Generate_Constant_Type (N : node_id) is begin Write (tok_const); Write_Space; Generate (Used_Type (N)); end Generate_Constant_Type; ------------------------------- -- Generate_Variable_Address -- ------------------------------- procedure Generate_Variable_Address (N : node_id) is begin Write (tok_ampersand); Write (tok_left_paren); Generate (Expression (N)); Write (tok_right_paren); end Generate_Variable_Address; -------------------------------- -- Generate_Member_Designator -- -------------------------------- procedure Generate_Member_Designator (N : node_id) is begin Generate (Aggregate_Name (N)); if Is_Pointer (N) then Write (tok_arrow); else Write (tok_dot); end if; Generate (Defining_Identifier (N)); end Generate_Member_Designator; end Ocarina.Generators.C_Tree.Generator;