From e6001445a14d5e96db78ff56c68d8ae96dec0968 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 8 Mar 2014 07:04:05 +0100 Subject: Share spec of ortho_nodes, adjust code. --- ortho/gcc/Makefile | 10 +- ortho/gcc/ortho-lang.c | 31 ++--- ortho/gcc/ortho_gcc.adb | 27 ++-- ortho/gcc/ortho_gcc.ads | 205 ++++++++++++++++++------------- ortho/gcc/ortho_gcc.private.ads | 265 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 416 insertions(+), 122 deletions(-) create mode 100644 ortho/gcc/ortho_gcc.private.ads (limited to 'ortho/gcc') diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile index 01a33d0..36ff842 100644 --- a/ortho/gcc/Makefile +++ b/ortho/gcc/Makefile @@ -3,6 +3,7 @@ orthobe_srcdir=$(ortho_srcdir)/gcc agcc_objdir=. agcc_srcdir=$(ortho_srcdir)/gcc SED=sed +BE=gcc GNATMAKE=gnatmake CC=gcc CXX=g++ @@ -28,10 +29,9 @@ ZLIB=-lz all: $(ortho_exec) +ORTHO_BASENAME=ortho_gcc include $(orthobe_srcdir)/Makefile.inc - -ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc -ORTHO_PACKAGE=Ortho_Gcc +include $(ortho_srcdir)/Makefile.inc LIBBACKTRACE = $(AGCC_GCCOBJ_DIR)/libbacktrace/.libs/libbacktrace.a LIBDECNUMBER = $(AGCC_GCCOBJ_DIR)/libdecnumber/libdecnumber.a @@ -47,10 +47,10 @@ LIBS = $(AGCC_GCCOBJ_DIR)/gcc/libcommon.a \ $(CPPLIB) $(LIBINTL) $(LIBICONV) $(LIBBACKTRACE) \ $(LIBIBERTY) $(LIBDECNUMBER) $(HOST_LIBS) -$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force +$(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force $(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \ -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \ - -bargs -E -largs --GCC=$(LINKER) $(AGCC_OBJS) \ + -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \ $(BACKEND) $(LIBS) $(BACKENDLIBS) clean: agcc-clean diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c index fe02dbc..6b4b8a5 100644 --- a/ortho/gcc/ortho-lang.c +++ b/ortho/gcc/ortho-lang.c @@ -268,7 +268,6 @@ append_stmt (tree stmt) static GTY(()) tree top; static GTY(()) tree stack_alloc_function_ptr; -extern "C" void ortho_fe_init (void); static bool global_bindings_p (void) @@ -367,8 +366,6 @@ ortho_init (void) REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode); } - ortho_fe_init (); - build_common_builtin_nodes (); // FIXME: this MAY remove the need for creating the builtins above... // Evaluate tree.c / build_common_builtin_nodes (); for each in turn. @@ -849,8 +846,6 @@ enum ON_op_kind { ON_And, ON_Or, ON_Xor, - ON_And_Then, - ON_Or_Else, /* Monadic operations. */ ON_Not, @@ -882,8 +877,6 @@ static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = { BIT_AND_EXPR, BIT_IOR_EXPR, BIT_XOR_EXPR, - TRUTH_ANDIF_EXPR, - TRUTH_ORIF_EXPR, BIT_NOT_EXPR, NEGATE_EXPR, @@ -902,6 +895,9 @@ new_dyadic_op (enum ON_op_kind kind, tree left, tree right) { tree left_type; enum tree_code code; + + /* Truncate to avoid representations issue. */ + kind = (enum ON_op_kind)((unsigned)kind & 0xff); left_type = TREE_TYPE (left); gcc_assert (left_type == TREE_TYPE (right)); @@ -924,6 +920,9 @@ new_dyadic_op (enum ON_op_kind kind, tree left, tree right) tree new_monadic_op (enum ON_op_kind kind, tree operand) { + /* Truncate to avoid representations issue. */ + kind = (enum ON_op_kind)((unsigned)kind & 0xff); + return build1 (ON_op_to_TREE_CODE[kind], TREE_TYPE (operand), operand); } @@ -932,6 +931,10 @@ new_compare_op (enum ON_op_kind kind, tree left, tree right, tree ntype) { gcc_assert (TREE_CODE (ntype) == BOOLEAN_TYPE); gcc_assert (TREE_TYPE (left) == TREE_TYPE (right)); + + /* Truncate to avoid representations issue. */ + kind = (enum ON_op_kind)((unsigned)kind & 0xff); + return build2 (ON_op_to_TREE_CODE[kind], ntype, left, right); } @@ -2024,20 +2027,6 @@ start_if_stmt (struct o_if_block *block, tree cond) push_stmts (stmts); } -void -new_elsif_stmt (struct o_if_block *block, tree cond) -{ - tree stmts; - tree stmt; - - pop_stmts (); - stmts = alloc_stmt_list (); - stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE); - COND_EXPR_ELSE (block->stmt) = stmt; - block->stmt = stmt; - push_stmts (stmts); -} - void new_else_stmt (struct o_if_block *block) { diff --git a/ortho/gcc/ortho_gcc.adb b/ortho/gcc/ortho_gcc.adb index c5234fc..ae7b4f5 100644 --- a/ortho/gcc/ortho_gcc.adb +++ b/ortho/gcc/ortho_gcc.adb @@ -1,3 +1,20 @@ +-- GCC back-end for ortho. +-- Copyright (C) 2002-1014 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 Ada.Unchecked_Deallocation; with Ortho_Gcc_Front; use Ortho_Gcc_Front; @@ -8,9 +25,9 @@ package body Ortho_Gcc is return O_Enode (Lit); end New_Lit; - function New_Obj (Decl : O_Dnode) return O_Lnode is + function New_Obj (Obj : O_Dnode) return O_Lnode is begin - return O_Lnode (Decl); + return O_Lnode (Obj); end New_Obj; function New_Obj_Value (Obj : O_Dnode) return O_Enode is @@ -18,12 +35,6 @@ package body Ortho_Gcc is return O_Enode (Obj); end New_Obj_Value; - procedure Init - is - begin - null; - end Init; - procedure New_Debug_Filename_Decl (Filename : String) is begin null; diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads index d01caee..f0a4724 100644 --- a/ortho/gcc/ortho_gcc.ads +++ b/ortho/gcc/ortho_gcc.ads @@ -1,3 +1,23 @@ +-- DO NOT MODIFY - this file was generated from: +-- ortho_nodes.common.ads and ortho_gcc.private.ads +-- +-- GCC back-end for ortho. +-- Copyright (C) 2002-1014 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 System; with Interfaces; use Interfaces; with Ortho_Ident; @@ -5,26 +25,25 @@ use Ortho_Ident; -- Interface to create nodes. package Ortho_Gcc is - --- PUBLIC DECLARATIONS - -- PUBLIC PART is defined in ortho_nodes.common.ads - type O_Cnode is private; + +-- Start of common part + type O_Enode is private; + type O_Cnode is private; type O_Lnode is private; type O_Tnode is private; - type O_Fnode is private; - type O_Dnode is private; type O_Snode is private; - - -- Must be called during initialization, before use of any subprograms. - procedure Init; + type O_Dnode is private; + type O_Fnode is private; O_Cnode_Null : constant O_Cnode; + O_Dnode_Null : constant O_Dnode; O_Enode_Null : constant O_Enode; - O_Lnode_Null : constant O_Lnode; - O_Tnode_Null : constant O_Tnode; O_Fnode_Null : constant O_Fnode; + O_Lnode_Null : constant O_Lnode; O_Snode_Null : constant O_Snode; - O_Dnode_Null : constant O_Dnode; + O_Tnode_Null : constant O_Tnode; + ------------------------ -- Type definitions -- @@ -101,6 +120,75 @@ package Ortho_Gcc is Ident : O_Ident; Res : out O_Cnode); procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode); + ---------------- + -- Literals -- + ---------------- + + -- Create a literal from an integer. + function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64) + return O_Cnode; + function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64) + return O_Cnode; + + function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64) + return O_Cnode; + + -- Create a null access literal. + function New_Null_Access (Ltype : O_Tnode) return O_Cnode; + + -- 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. + type O_Record_Aggr_List is limited private; + type O_Array_Aggr_List is limited private; + + procedure Start_Record_Aggr (List : out O_Record_Aggr_List; + Atype : O_Tnode); + procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List; + Value : O_Cnode); + procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; + Res : out O_Cnode); + + procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; + Value : O_Cnode); + procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; + Res : out O_Cnode); + + -- Build an union aggregate. + function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode) + return O_Cnode; + + -- 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; + + -- Returns the alignment in bytes for ATYPE. The result is a literal of + -- unsgined type RTYPE. + function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode; + + -- Returns the offset of FIELD in its record ATYPE. The result is a + -- literal of unsigned type or access type RTYPE. + function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode) + return O_Cnode; + + -- Get the address of a subprogram. + function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) + return O_Cnode; + + -- 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_Global_Address (Decl : O_Dnode; Atype : O_Tnode) + return O_Cnode; + + -- Same as New_Address but without any restriction. + function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) + return O_Cnode; + ------------------- -- Expressions -- ------------------- @@ -122,8 +210,6 @@ package Ortho_Gcc is ON_And, -- ON_Dyadic_Op_Kind ON_Or, -- ON_Dyadic_Op_Kind ON_Xor, -- ON_Dyadic_Op_Kind - ON_And_Then, -- ON_Dyadic_Op_Kind - ON_Or_Else, -- ON_Dyadic_Op_Kind -- Monadic operations. ON_Not, -- ON_Monadic_Op_Kind @@ -139,9 +225,7 @@ package Ortho_Gcc is ON_Gt -- ON_Compare_Op_Kind ); - pragma Convention (C, ON_Op_Kind); - - subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Or_Else; + 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; @@ -149,7 +233,6 @@ package Ortho_Gcc is O_Storage_Public, O_Storage_Private, O_Storage_Local); - pragma Convention (C, O_Storage); -- Specifies the storage kind of a declaration. -- O_STORAGE_EXTERNAL: -- The declaration do not either reserve memory nor generate code, and @@ -164,8 +247,8 @@ package Ortho_Gcc is Type_Error : exception; Syntax_Error : exception; + -- Create a value from a literal. function New_Lit (Lit : O_Cnode) return O_Enode; - pragma Inline (New_Lit); -- Create a dyadic operation. -- Left and right nodes must have the same type. @@ -185,63 +268,13 @@ package Ortho_Gcc is (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode) return O_Enode; - -- Create a literal from an integer. - function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64) - return O_Cnode; - function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64) - return O_Cnode; - - function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64) - return O_Cnode; - - -- Create a null access literal. - function New_Null_Access (Ltype : O_Tnode) return O_Cnode; type O_Inter_List is limited private; - type O_Record_Aggr_List is limited private; - type O_Array_Aggr_List is limited private; type O_Assoc_List is limited private; - type O_Loop_Block is limited private; type O_If_Block is limited private; type O_Case_Block is limited private; - -- 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); - procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List; - Value : O_Cnode); - procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; - Res : out O_Cnode); - - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); - procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; - Value : O_Cnode); - procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; - Res : out O_Cnode); - - -- Build an union aggregate. - function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode) - return O_Cnode; - - -- 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; - - -- Returns the alignment in bytes for ATYPE. The result is a literal of - -- unsgined type RTYPE. - function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode; - - -- Returns the offset of FIELD in its record REC_TYPE. The result is a - -- literal of unsigned type or access type RTYPE. - function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode) - return O_Cnode; - -- 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) @@ -273,24 +306,17 @@ package Ortho_Gcc is -- 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; - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode; -- Same as New_Address but without any restriction. function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode; - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode; - - -- Get the address of a subprogram. - function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) - return O_Cnode; -- Get the value of an Lvalue. function New_Value (Lvalue : O_Lnode) return O_Enode; - -- Get the value of an object. function New_Obj_Value (Obj : O_Dnode) return O_Enode; - pragma Inline (New_Obj_Value); + + -- Get an lvalue from a declaration. + function New_Obj (Obj : O_Dnode) return O_Lnode; -- 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; @@ -303,7 +329,7 @@ package Ortho_Gcc is -- Declarations. -- --------------------- - -- Filename. + -- Filename of the next declaration. procedure New_Debug_Filename_Decl (Filename : String); -- Line number of the next declaration. @@ -335,9 +361,6 @@ package Ortho_Gcc is Storage : O_Storage; Atype : O_Tnode); - function New_Obj (Decl : O_Dnode) return O_Lnode; - pragma Inline (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 @@ -402,14 +425,12 @@ package Ortho_Gcc is -- Build an IF statement. procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode); - -- COND is NULL for the final else statement. - procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode); procedure New_Else_Stmt (Block : in out O_If_Block); procedure Finish_If_Stmt (Block : in out O_If_Block); -- Create a infinite loop statement. procedure Start_Loop_Stmt (Label : out O_Snode); - procedure Finish_Loop_Stmt (Block : in out O_Snode); + procedure Finish_Loop_Stmt (Label : in out O_Snode); -- Exit from a loop stmt or from a for stmt. procedure New_Exit_Stmt (L : O_Snode); @@ -420,6 +441,9 @@ package Ortho_Gcc is -- Case statement. -- VALUE is the selector and must be a discrete type. procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode); + -- A choice branch is composed of expr, range or default choices. + -- A choice branch is enclosed between a Start_Choice and a Finish_Choice. + -- The statements are after the finish_choice. procedure Start_Choice (Block : in out O_Case_Block); procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode); procedure New_Range_Choice (Block : in out O_Case_Block; @@ -428,7 +452,11 @@ package Ortho_Gcc is procedure Finish_Choice (Block : in out O_Case_Block); procedure Finish_Case_Stmt (Block : in out O_Case_Block); +-- End of common part private + pragma Convention (C, O_Storage); + -- pragma Convention (C, ON_Op_Kind); + subtype Tree is System.Address; NULL_TREE : constant Tree := System.Null_Address; @@ -446,8 +474,6 @@ private end record; pragma Convention (C, O_Snode); - pragma Export (C, Init, "ortho_fe_init"); - O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE); O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE); O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE); @@ -456,6 +482,10 @@ private O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE); O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE); + pragma Inline (New_Lit); + pragma Inline (New_Obj); + pragma Inline (New_Obj_Value); + -- Efficiently append element EL to a chain. -- FIRST is the first element of the chain (must NULL_TREE if the chain -- is empty), @@ -641,7 +671,6 @@ private pragma Import (C, New_Assign_Stmt); pragma Import (C, Start_If_Stmt); - pragma Import (C, New_Elsif_Stmt); pragma Import (C, New_Else_Stmt); pragma Import (C, Finish_If_Stmt); diff --git a/ortho/gcc/ortho_gcc.private.ads b/ortho/gcc/ortho_gcc.private.ads new file mode 100644 index 0000000..c113f2f --- /dev/null +++ b/ortho/gcc/ortho_gcc.private.ads @@ -0,0 +1,265 @@ +-- GCC back-end for ortho. +-- Copyright (C) 2002-1014 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 System; +with Interfaces; use Interfaces; +with Ortho_Ident; +use Ortho_Ident; + +-- Interface to create nodes. +package Ortho_Gcc is + +private + pragma Convention (C, O_Storage); + -- pragma Convention (C, ON_Op_Kind); + + subtype Tree is System.Address; + NULL_TREE : constant Tree := System.Null_Address; + + subtype Vec_Ptr is System.Address; + + type O_Cnode is new Tree; + type O_Enode is new Tree; + type O_Lnode is new Tree; + type O_Tnode is new Tree; + type O_Fnode is new Tree; + type O_Dnode is new Tree; + type O_Snode is record + Beg_Label : Tree; + End_Label : Tree; + end record; + pragma Convention (C, O_Snode); + + O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE); + O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE); + O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE); + O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE); + O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE); + O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE); + O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE); + + pragma Inline (New_Lit); + pragma Inline (New_Obj); + pragma Inline (New_Obj_Value); + + -- Efficiently append element EL to a chain. + -- FIRST is the first element of the chain (must NULL_TREE if the chain + -- is empty), + -- LAST is the last element of the chain (idem). + type Chain_Constr_Type is record + First : Tree; + Last : Tree; + end record; + pragma Convention (C, Chain_Constr_Type); + procedure Chain_Init (Constr : out Chain_Constr_Type); + pragma Import (C, Chain_Init); + procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree); + pragma Import (C, Chain_Append); + + -- Efficiently append element EL to a list. + type List_Constr_Type is record + First : Tree; + Last : Tree; + end record; + pragma Convention (C, List_Constr_Type); + procedure List_Init (Constr : out List_Constr_Type); + pragma Import (C, List_Init); + procedure List_Append (Constr : in out List_Constr_Type; El : Tree); + pragma Import (C, List_Append, "ortho_list_append"); + + type O_Loop_Block is record + Beg_Label : Tree; + End_Label : Tree; + end record; + pragma Convention (C, O_Loop_Block); + + type O_Inter_List is record + Ident : O_Ident; + Storage : O_Storage; + -- Return type. + Rtype : O_Tnode; + -- List of parameter types. + Param_List : List_Constr_Type; + -- Chain of parameters declarations. + Param_Chain : Chain_Constr_Type; + end record; + pragma Convention (C, O_Inter_List); + + type O_Element_List is record + Res : Tree; + Chain : Chain_Constr_Type; + end record; + pragma Convention (C, O_Element_List); + + type O_Case_Block is record + End_Label : Tree; + Add_Break : Integer; + end record; + pragma Convention (C, O_Case_Block); + + type O_If_Block is record + Stmt : Tree; + end record; + pragma Convention (C, O_If_Block); + + type O_Aggr_List is record + Atype : Tree; + Chain : Chain_Constr_Type; + end record; + + type O_Record_Aggr_List is record + Atype : Tree; + Afield : Tree; + Vec : Vec_Ptr; + end record; + pragma Convention (C, O_Record_Aggr_List); + + type O_Array_Aggr_List is record + Atype : Tree; + Vec : Vec_Ptr; + end record; + pragma Convention (C, O_Array_Aggr_List); + + type O_Assoc_List is record + Subprg : Tree; + List : List_Constr_Type; + end record; + pragma Convention (C, O_Assoc_List); + + type O_Enum_List is record + -- The enumeral_type node. + Res : Tree; + -- Chain of literals. + Chain : Chain_Constr_Type; + -- Numeral value (from 0 to nbr - 1) of the next literal to be declared. + Num : Natural; + -- Size of the enumeration type. + Size : Natural; + end record; + pragma Convention (C, O_Enum_List); + + pragma Import (C, New_Dyadic_Op); + pragma Import (C, New_Monadic_Op); + pragma Import (C, New_Compare_Op); + + pragma Import (C, New_Convert_Ov); + pragma Import (C, New_Alloca); + + pragma Import (C, New_Signed_Literal); + pragma Import (C, New_Unsigned_Literal); + pragma Import (C, New_Float_Literal); + pragma Import (C, New_Null_Access); + + pragma Import (C, Start_Record_Type); + pragma Import (C, New_Record_Field); + pragma Import (C, Finish_Record_Type); + pragma Import (C, New_Uncomplete_Record_Type); + pragma Import (C, Start_Uncomplete_Record_Type); + + pragma Import (C, Start_Union_Type); + pragma Import (C, New_Union_Field); + pragma Import (C, Finish_Union_Type); + + pragma Import (C, New_Unsigned_Type); + pragma Import (C, New_Signed_Type); + pragma Import (C, New_Float_Type); + + pragma Import (C, New_Access_Type); + pragma Import (C, Finish_Access_Type); + + pragma Import (C, New_Array_Type); + pragma Import (C, New_Constrained_Array_Type); + + pragma Import (C, New_Boolean_Type); + pragma Import (C, Start_Enum_Type); + pragma Import (C, New_Enum_Literal); + pragma Import (C, Finish_Enum_Type); + + pragma Import (C, Start_Record_Aggr); + pragma Import (C, New_Record_Aggr_El); + pragma Import (C, Finish_Record_Aggr); + pragma Import (C, Start_Array_Aggr); + pragma Import (C, New_Array_Aggr_El); + pragma Import (C, Finish_Array_Aggr); + pragma Import (C, New_Union_Aggr); + + pragma Import (C, New_Indexed_Element); + pragma Import (C, New_Slice); + pragma Import (C, New_Selected_Element); + pragma Import (C, New_Access_Element); + + pragma Import (C, New_Sizeof); + pragma Import (C, New_Alignof); + pragma Import (C, New_Offsetof); + + pragma Import (C, New_Address); + pragma Import (C, New_Global_Address); + pragma Import (C, New_Unchecked_Address); + pragma Import (C, New_Global_Unchecked_Address); + pragma Import (C, New_Subprogram_Address); + + pragma Import (C, New_Value); + + pragma Import (C, New_Type_Decl); + pragma Import (C, New_Debug_Line_Decl); + pragma Import (C, New_Const_Decl); + pragma Import (C, New_Var_Decl); + + pragma Import (C, Start_Const_Value); + pragma Import (C, Finish_Const_Value); + + pragma Import (C, Start_Function_Decl); + pragma Import (C, Start_Procedure_Decl); + pragma Import (C, New_Interface_Decl); + pragma Import (C, Finish_Subprogram_Decl); + + pragma Import (C, Start_Subprogram_Body); + pragma Import (C, Finish_Subprogram_Body); + + pragma Import (C, New_Debug_Line_Stmt); + pragma Import (C, Start_Declare_Stmt); + pragma Import (C, Finish_Declare_Stmt); + pragma Import (C, Start_Association); + pragma Import (C, New_Association); + pragma Import (C, New_Function_Call); + pragma Import (C, New_Procedure_Call); + + pragma Import (C, New_Assign_Stmt); + + pragma Import (C, Start_If_Stmt); + pragma Import (C, New_Else_Stmt); + pragma Import (C, Finish_If_Stmt); + + pragma Import (C, New_Return_Stmt); + pragma Import_Procedure (New_Return_Stmt, + "new_func_return_stmt", (O_Enode)); + pragma Import_Procedure (New_Return_Stmt, + "new_proc_return_stmt", null); + + pragma Import (C, Start_Loop_Stmt); + pragma Import (C, Finish_Loop_Stmt); + pragma Import (C, New_Exit_Stmt); + pragma Import (C, New_Next_Stmt); + + pragma Import (C, Start_Case_Stmt); + pragma Import (C, Start_Choice); + pragma Import (C, New_Expr_Choice); + pragma Import (C, New_Range_Choice); + pragma Import (C, New_Default_Choice); + pragma Import (C, Finish_Choice); + pragma Import (C, Finish_Case_Stmt); +end Ortho_Gcc; -- cgit