%-----------------------------------------------------------------------------% % Copyright (C) 2001-2006 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% % % File: gcc.m % Main author: fjh % % This module is the Mercury interface to the GCC compiler back-end. % % This module provides a thin wrapper around the C types, % constants, and functions defined in gcc/tree.{c,h,def} % and gcc/mercury/mercury-gcc.c in the GCC source. % (The functions in gcc/mercury/mercury-gcc.c are in turn a % thicker wrapper around the more complicated parts of GCC's % source-language-independent back-end.) % % Note that we want to keep this code as simple as possible. % Any complicated C code, which might require changes for new versions % of gcc, should go in gcc/mercury/mercury-gcc.c rather than in % inline C code here. That way, the GCC developers (who know C, % but probably don't know Mercury) can help maintain it. % % For symmetry, any complicated Mercury code should probably go in % mlds_to_gcc.m rather than here, although that is not so important. % % This module makes no attempt to be a *complete* interface to the % gcc back-end; we only define interfaces to those parts of the gcc % back-end that we need for compiling Mercury. % % GARBAGE COLLECTION % % The GCC compiler uses its own garbage collector (see gcc/ggc.h). % This garbage collector only collects memory when ggc_collect() % is called, which currently only happens in rest_of_compilation(), % which is called from gcc__end_function//0. But it requires % that all pointers to the GCC heap be either explicitly registered % with e.g. ggc_register_tree_root(), or protected by calling % gcc__push_context//0 and gcc__pop_context//0. % % REFERENCES % % For more information about the GCC compiler back-end, % see the documentation at and % , in particular % "Writing a Compiler Front End to GCC" by Joachim Nadler % and Tim Josling . % % Many of the procedures here which are implemented using % stuff defined by the gcc back-end are documented better % in the comments in the gcc source code. % % QUOTES % % ``GCC is a software Vietnam.'' % -- Simon Peyton-Jones. % % ``Never get involved in a land war in Asia.'' % -- from the movie "The Princess Bride". % % %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- module gcc. :- interface. :- import_module bool. :- import_module io. %-----------------------------------------------------------------------------% % gcc__run_backend(CommandLine, ReturnValue, FrontEndCallBack, Output): % % This is the top-level routine that MUST be used to invoke the % GCC back-end. It makes sure GCC has been initialized, using % the specified CommandLine for GCC's command-line parameters, % and then calls the specified FrontEndCallBack procedure. % The FrontEndCallBack should then call the appropriate % routines defined below (e.g. gcc__{start,end}_function, % gcc__gen_expr_stmt, etc.) to generate code. When it % is finished, the FrontEndCallBack can return an Output. % gcc__run_backend will then finish generating the assembler % file and clean up. Finally gcc__run_backend will return % the Output of the FrontEndCallBack procedure back to the % caller of gcc__run_backend. ReturnValue will be the % return value from the GCC backend, i.e. zero if all is OK, % and non-zero if something went wrong. % % WARNING: The other functions and predicates defined in this % module MUST NOT be called directly; they can only be called % from the FrontEndCallBack routine passed to gcc__run_backend. % Otherwise the GCC back-end won't get properly initialized. % % Due to limitations in the GCC back-end, this routine must % not be called more than once; if it is, it will print an % error message and abort execution. :- type frontend_callback(T) == pred(T, io__state, io__state). :- inst frontend_callback == (pred(out, di, uo) is det). :- pred gcc__run_backend(string::in, int::out, frontend_callback(T)::in(frontend_callback), T::out, io__state::di, io__state::uo) is det. %-----------------------------------------------------------------------------% % The GCC `tree' type. :- type gcc__tree. :- type gcc__tree_code. %-----------------------------------------------------------------------------% % % Types % % A GCC `tree' representing a type. :- type gcc__type. % Builtin types :- func void_type_node = gcc__type. :- func boolean_type_node = gcc__type. :- func char_type_node = gcc__type. :- func string_type_node = gcc__type. % `char *' :- func double_type_node = gcc__type. :- func ptr_type_node = gcc__type. % `void *' :- func integer_type_node = gcc__type. % C `int'. % (Note that we use `intptr_t' for % the Mercury `int' type.) :- func int8_type_node = gcc__type. % C99 `int8_t' :- func int16_type_node = gcc__type. % C99 `int16_t' :- func int32_type_node = gcc__type. % C99 `int32_t' :- func int64_type_node = gcc__type. % C99 `int64_t' :- func intptr_type_node = gcc__type. % C99 `intptr_t' :- func jmpbuf_type_node = gcc__type. % `__builtin_jmpbuf', i.e. `void *[5]' % This is used for `__builtin_setjmp' % and `__builtin_longjmp'. % Given a type `T', produce a pointer type `T *'. :- pred build_pointer_type(gcc__type::in, gcc__type::out, io__state::di, io__state::uo) is det. % Given a type `T', and a size N, produce an array type `T[N]'. :- pred build_array_type(gcc__type::in, int::in, gcc__type::out, io__state::di, io__state::uo) is det. % build_range_type(Type, Min, Max, RangeType): % Given a discrete (integer, enum, boolean, or char) type, % produce a new type which is the sub-range of that type % with low bound Min and high bound Max. :- pred build_range_type(gcc__type::in, int::in, int::in, gcc__type::out, io__state::di, io__state::uo) is det. % A GCC `tree' representing a list of parameter types. :- type gcc__param_types. :- func empty_param_types = gcc__param_types. :- func cons_param_types(gcc__type, gcc__param_types) = gcc__param_types. % Produce a function type, given the return type and % the parameter types. :- pred build_function_type(gcc__type::in, gcc__param_types::in, gcc__type::out, io__state::di, io__state::uo) is det. % Return a type that was defined in a type declaration % (see the section on type declarations, below). :- func declared_type(gcc__type_decl) = gcc__type. % Given an array type, return the array element type. % This procedure must only be called with an array type, % otherwise it will abort. :- pred get_array_elem_type(gcc__type::in, gcc__type::out, io__state::di, io__state::uo) is det. % Given a struct type, return the field declarations for % that struct. % This procedure must only be called with a struct type, % otherwise it will abort. :- pred get_struct_field_decls(gcc__type::in, gcc__field_decls::out, io__state::di, io__state::uo) is det. %-----------------------------------------------------------------------------% % % Declarations % % A GCC `tree' representing a declaration. % XXX This doesn't have a definition and appears to be unused anyway. % - juliensf % %:- type gcc__decl. % % Stuff for variable declarations % % A GCC `tree' representing a local variable. :- type gcc__var_decl. :- type var_name == string. % build an extern variable declaration :- pred build_extern_var_decl(var_name::in, gcc__type::in, gcc__var_decl::out, io__state::di, io__state::uo) is det. % build an initialized static variable definition % This can be used for either global variables % or local static variables. % % After calling this, the caller should call set_var_decl_public, % set_var_decl_readonly, and/or set_var_asm_name, if appropriate, % and then finish_static_var_decl. % % The name passed in here should be the source level name. % By default, this is also used as the assembler name. % If that name contains special characters that might confuse % the assembler, the caller needs call set_var_asm_name with % a mangled name that is free of such characters. :- pred build_static_var_decl(var_name::in, gcc__type::in, gcc__expr::in, gcc__var_decl::out, io__state::di, io__state::uo) is det. % Finish off the definition of a static variable that % was begun with build_static_var_decl, above. :- pred finish_static_var_decl(gcc__var_decl::in, io__state::di, io__state::uo) is det. % build an ordinary local variable definition % i.e. one with automatic (rather than static) storage duration :- pred build_local_var_decl(var_name::in, gcc__type::in, gcc__var_decl::out, io__state::di, io__state::uo) is det. % mark a variable as being accessible from outside this % translation unit :- pred set_var_decl_public(gcc__var_decl::in, io__state::di, io__state::uo) is det. % mark a variable as read-only :- pred set_var_decl_readonly(gcc__var_decl::in, io__state::di, io__state::uo) is det. % set the assembler name to use for a variable. :- pred set_var_decl_asm_name(gcc__var_decl::in, gcc__var_name::in, io__state::di, io__state::uo) is det. % % Routines to start/end a block. % % Every start_block must be matched by a corresponding end_block. % The lifetime of any local variable declarations % within the block will end at the corresponding end_block. % % Like `{' in C. :- pred start_block(io__state, io__state). :- mode start_block(di, uo) is det. % Like `}' in C. :- pred end_block(io__state, io__state). :- mode end_block(di, uo) is det. % % Stuff for function declarations % % A GCC `tree' representing a function parameter. :- type gcc__param_decl == gcc__var_decl. % build a function parameter declaration :- type param_name == string. :- pred build_param_decl(param_name::in, gcc__type::in, gcc__param_decl::out, io__state::di, io__state::uo) is det. % A GCC `tree' representing a list of parameters. :- type gcc__param_decls. % routines for building parameter lists :- func empty_param_decls = gcc__param_decls. :- func cons_param_decls(gcc__param_decl, gcc__param_decls) = gcc__param_decls. % A GCC `tree' representing a function declaration. :- type gcc__func_decl. % build a function declaration :- type func_name == string. :- type func_asm_name == string. :- pred build_function_decl(func_name, func_asm_name, gcc__type, gcc__param_types, gcc__param_decls, gcc__func_decl, io__state, io__state). :- mode build_function_decl(in, in, in, in, in, out, di, uo) is det. % Declarations for builtin functions. % % Note that some of these are quite Mercury-specific; % they are defined by C part of the Mercury front-end, % in gcc/mercury/mercury-gcc.c. (XXX We might want to % consider moving these to a separate module, to make % this module more language-independent.) :- func alloc_func_decl = gcc__func_decl. % GC_malloc() :- func strcmp_func_decl = gcc__func_decl. % strcmp() :- func hash_string_func_decl = gcc__func_decl. % MR_hash_string() :- func box_float_func_decl = gcc__func_decl. % MR_asm_box_float() :- func setjmp_func_decl = gcc__func_decl. % __builtin_setjmp() :- func longjmp_func_decl = gcc__func_decl. % __builtin_longjmp() % mark a function as being accessible from outside this % translation unit :- pred set_func_decl_public(gcc__func_decl::in, io__state::di, io__state::uo) is det. % % Stuff for type declarations % % A GCC `tree' representing a field declaration :- type gcc__field_decl. % build a field declaration :- type field_name == string. :- pred build_field_decl(field_name::in, gcc__type::in, gcc__field_decl::out, io__state::di, io__state::uo) is det. % get the type of a field :- pred field_type(gcc__field_decl::in, gcc__type::out, io__state::di, io__state::uo) is det. % A GCC `tree' representing a list of field declarations :- type gcc__field_decls. % Construct an empty field list. :- pred empty_field_list(gcc__field_decls, io__state, io__state). :- mode empty_field_list(out, di, uo) is det. % Give a new field decl, cons it into the start of a field list. % Note that each field decl can only be on one field list. :- pred cons_field_list(gcc__field_decl, gcc__field_decls, gcc__field_decls, io__state, io__state). :- mode cons_field_list(in, in, out, di, uo) is det. % Given a non-empty field list, return the first field decl % and the remaining field decls. % This procedure must only be called with a non-empty input list, % otherwise it will abort. :- pred next_field_decl(gcc__field_decls, gcc__field_decl, gcc__field_decls, io__state, io__state). :- mode next_field_decl(in, out, out, di, uo) is det. :- type gcc__type_decl. :- type struct_name == string. :- pred build_struct_type_decl(gcc__struct_name, gcc__field_decls, gcc__type_decl, io__state, io__state). :- mode build_struct_type_decl(in, in, out, di, uo) is det. %-----------------------------------------------------------------------------% % % Operators % % GCC tree_codes for operators % See gcc/tree.def for documentation on these. :- type gcc__op. :- func plus_expr = gcc__op. % + :- func minus_expr = gcc__op. % * :- func mult_expr = gcc__op. % - :- func rdiv_expr = gcc__op. % / (floating-point division) :- func trunc_div_expr = gcc__op. % / (truncating integer division) :- func trunc_mod_expr = gcc__op. % % (remainder after truncating % integer division) :- func eq_expr = gcc__op. % == :- func ne_expr = gcc__op. % != :- func lt_expr = gcc__op. % < :- func gt_expr = gcc__op. % > :- func le_expr = gcc__op. % <= :- func ge_expr = gcc__op. % >= :- func truth_andif_expr = gcc__op. % && :- func truth_orif_expr = gcc__op. % || :- func truth_not_expr = gcc__op. % ! :- func bit_ior_expr = gcc__op. % | (bitwise inclusive or) :- func bit_xor_expr = gcc__op. % ^ (bitwise exclusive or) :- func bit_and_expr = gcc__op. % & (bitwise and) :- func bit_not_expr = gcc__op. % ~ (bitwise complement) :- func lshift_expr = gcc__op. % << (left shift) :- func rshift_expr = gcc__op. % >> (left shift) :- func array_ref = gcc__op. % [] (array indexing) % first operand is the array, % second operand is the index %-----------------------------------------------------------------------------% % % Expressions % % A GCC `tree' representing an expression. :- type gcc__expr. % look up the type of an expression :- pred expr_type(gcc__expr, gcc__type, io__state, io__state). :- mode expr_type(in, out, di, uo) is det. % % constants % % build an expression for an integer constant :- pred build_int(int, gcc__expr, io__state, io__state). :- mode build_int(in, out, di, uo) is det. % build an expression for a floating-point constant :- pred build_float(float, gcc__expr, io__state, io__state). :- mode build_float(in, out, di, uo) is det. % build an expression for a Mercury string constant :- pred build_string(string, gcc__expr, io__state, io__state). :- mode build_string(in, out, di, uo) is det. % Build an expression for a string constant, % with the specified length. This length must % include the terminating null, if one is desired. :- pred build_string(int, string, gcc__expr, io__state, io__state). :- mode build_string(in, in, out, di, uo) is det. % build an expression for a null pointer :- pred build_null_pointer(gcc__expr, io__state, io__state). :- mode build_null_pointer(out, di, uo) is det. % % operator expressions % % build a unary expression :- pred build_unop(gcc__op, gcc__type, gcc__expr, gcc__expr, io__state, io__state). :- mode build_unop(in, in, in, out, di, uo) is det. % build a binary expression :- pred build_binop(gcc__op, gcc__type, gcc__expr, gcc__expr, gcc__expr, io__state, io__state). :- mode build_binop(in, in, in, in, out, di, uo) is det. % take the address of an expression :- pred build_addr_expr(gcc__expr, gcc__expr, io__state, io__state). :- mode build_addr_expr(in, out, di, uo) is det. % build a pointer dereference expression :- pred build_pointer_deref(gcc__expr, gcc__expr, io__state, io__state). :- mode build_pointer_deref(in, out, di, uo) is det. % build a field extraction expression :- pred build_component_ref(gcc__expr, gcc__field_decl, gcc__expr, io__state, io__state). :- mode build_component_ref(in, in, out, di, uo) is det. % build a type conversion expression :- pred convert_type(gcc__expr, gcc__type, gcc__expr, io__state, io__state). :- mode convert_type(in, in, out, di, uo) is det. % % variables % % build an expression for a variable :- func var_expr(gcc__var_decl) = gcc__expr. % % stuff for function calls % % build a function pointer expression % i.e. take the address of a function :- pred build_func_addr_expr(gcc__func_decl, gcc__expr, io__state, io__state). :- mode build_func_addr_expr(in, out, di, uo) is det. % A GCC `tree' representing a list of arguments. :- type gcc__arg_list. :- pred empty_arg_list(gcc__arg_list, io__state, io__state). :- mode empty_arg_list(out, di, uo) is det. :- pred cons_arg_list(gcc__expr, gcc__arg_list, gcc__arg_list, io__state, io__state). :- mode cons_arg_list(in, in, out, di, uo) is det. % build an expression for a function call :- pred build_call_expr(gcc__expr, gcc__arg_list, bool, gcc__expr, io__state, io__state). :- mode build_call_expr(in, in, in, out, di, uo) is det. % % Initializers % % A GCC `tree' representing an array index or field to initialize. :- type gcc__init_elem. % Create a gcc__init_elem that represents an initializer % for an array element at the given array index. :- pred array_elem_initializer(int, gcc__init_elem, io__state, io__state). :- mode array_elem_initializer(in, out, di, uo) is det. % Create a gcc__init_elem that represents an initializer % for the given field of a structure. :- pred struct_field_initializer(gcc__field_decl, gcc__init_elem, io__state, io__state). :- mode struct_field_initializer(in, out, di, uo) is det. % A GCC `tree' representing a list of initializers % for an array or structure. :- type gcc__init_list. :- pred empty_init_list(gcc__init_list, io__state, io__state). :- mode empty_init_list(out, di, uo) is det. :- pred cons_init_list(gcc__init_elem, gcc__expr, gcc__init_list, gcc__init_list, io__state, io__state). :- mode cons_init_list(in, in, in, out, di, uo) is det. % build an expression for an array or structure initializer :- pred build_initializer_expr(gcc__init_list, gcc__type, gcc__expr, io__state, io__state). :- mode build_initializer_expr(in, in, out, di, uo) is det. %-----------------------------------------------------------------------------% % % Routines to protect memory from being collected by the GCC garbage % collector (see gcc/ggc.h). % % This starts a new GGC context. Memory allocated in previous contexts % will not be collected while the new context is active. :- pred push_gc_context(io__state, io__state). :- mode push_gc_context(di, uo) is det. % Finish a GC context. Any uncollected memory in the new context % will be merged with the old context. :- pred pop_gc_context(io__state, io__state). :- mode pop_gc_context(di, uo) is det. %-----------------------------------------------------------------------------% % % Functions % % start generating code for a function :- pred start_function(gcc__func_decl, io__state, io__state). :- mode start_function(in, di, uo) is det. % finish generating code for a function % WARNING: this will invoke the GCC garbage collector. % So any GCC tree nodes which are referenced only from the stack(s), % from Mercury data structures, or from global variables, and which % were allocated since the most recent call to gcc__push_gc_context, % must be registered as roots (e.g. using ggc_add_tree_root()) % when this is called. Generally it is easier to call % gcc__push_gc_context. :- pred end_function(io__state, io__state). :- mode end_function(di, uo) is det. % set_context(Filename, LineNumber): % Set the source location that GCC uses for subsequent % declarations and diagnostics. This should be called % before `start_function' and also before `end_function'. :- pred set_context(string, int, io__state, io__state). :- mode set_context(in, in, di, uo) is det. % gen_line_note(FileName, LineNumber): % Generate a marker indicating the source location. % This should be called before generating each statement. :- pred gen_line_note(string, int, io__state, io__state). :- mode gen_line_note(in, in, di, uo) is det. %-----------------------------------------------------------------------------% % % Statements % % % routines to generate code for if-then-elses % % start generating code for an if-then-else % the argument is the gcc tree for the condition :- pred gen_start_cond(gcc__expr, io__state, io__state). :- mode gen_start_cond(in, di, uo) is det. % start the else part (optional) :- pred gen_start_else(io__state, io__state). :- mode gen_start_else(di, uo) is det. % finish the if-then-else :- pred gen_end_cond(io__state, io__state). :- mode gen_end_cond(di, uo) is det. % % routines to generate code for switches % :- pred gen_start_switch(gcc__expr, gcc__type, io__state, io__state). :- mode gen_start_switch(in, in, di, uo) is det. :- pred gen_case_label(gcc__expr, gcc__label, io__state, io__state). :- mode gen_case_label(in, in, di, uo) is det. :- pred gen_default_case_label(gcc__label, io__state, io__state). :- mode gen_default_case_label(in, di, uo) is det. :- pred gen_break(io__state, io__state). :- mode gen_break(di, uo) is det. :- pred gen_end_switch(gcc__expr, io__state, io__state). :- mode gen_end_switch(in, di, uo) is det. % % routines to generate code for loops % :- type gcc__loop. :- pred gen_start_loop(gcc__loop, io__state, io__state). :- mode gen_start_loop(out, di, uo) is det. :- pred gen_exit_loop_if_false(gcc__loop, gcc__expr, io__state, io__state). :- mode gen_exit_loop_if_false(in, in, di, uo) is det. :- pred gen_end_loop(io__state, io__state). :- mode gen_end_loop(di, uo) is det. % % routines to generate code for calls/returns % % generate code for an expression with side effects % (e.g. a call) :- pred gen_expr_stmt(gcc__expr, io__state, io__state). :- mode gen_expr_stmt(in, di, uo) is det. % generate code for a return statement :- pred gen_return(gcc__expr, io__state, io__state). :- mode gen_return(in, di, uo) is det. % % assignment % % gen_assign(LHS, RHS): % generate code for an assignment statement :- pred gen_assign(gcc__expr, gcc__expr, io__state, io__state). :- mode gen_assign(in, in, di, uo) is det. % % labels and goto % :- type gcc__label. :- type gcc__label_name == string. % Build a gcc tree node for a label. % Note that you also need to use gen_label % (or gen_case_label) to define the label. :- pred build_label(gcc__label_name, gcc__label, io__state, io__state). :- mode build_label(in, out, di, uo) is det. :- pred build_unnamed_label(gcc__label, io__state, io__state). :- mode build_unnamed_label(out, di, uo) is det. :- pred gen_label(gcc__label, io__state, io__state). :- mode gen_label(in, di, uo) is det. :- pred gen_goto(gcc__label, io__state, io__state). :- mode gen_goto(in, di, uo) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module int. :- import_module string. :- pragma foreign_decl("C", " #ifndef MC_GUARD_GCC_HEADERS #define MC_GUARD_GCC_HEADERS #include ""gcc/config.h"" #include ""gcc/system.h"" #include ""gcc/toplev.h"" #include ""gcc/tree.h"" /* XXX The inclusion of c-tree.h is an undesirable dependency on GCC's C front-end. It is only needed for versions of the mercury-gcc distribution based on GCC 3.2 or earlier. In later versions, I modified the mercury-gcc distribution so that it no longer depends on the C front-end, making the inclusion of c-tree.h unnecessary. This line should be removed once GCC 3.3 has been official released and we have then officially released a version of Mercury that uses GCC 3.3. */ #include ""gcc/c-tree.h"" #include ""gcc/ggc.h"" #include ""gcc/mercury/mercury-gcc.h"" #endif "). %-----------------------------------------------------------------------------% % % For gcc__run_backend, there's two possible cases, depending on who % defined main(): % % 1. GCC main(): % gcc/toplev.c gets control first. % % In this case, by the time we get to here % (gcc.m), the GCC back-end has already % been initialized. We can go ahead and directly % call the front-end callback to generate the % GCC tree and RTL. When we return back to % main/2 in mercury_compile, and that returns, % the gcc back-end will continue on and will % generate the asm file. % % Note that mercury_compile.m can't invoke the % assembler to produce an object file, since % the assembler won't get produced until % after main/2 has exited! Instead, the gcc % driver program (`gcc') will invoke the assembler. % % 2. Mercury main(): % mercury_compile.m gets control first. % % When we get here (gcc.m), the gcc back-end % has not been initialized. We need to save % the front-end callback in a global variable, % and then invoke the GCC toplev_main() here. % This will start the GCC back-end, which will % eventually call MC_continue_frontend(). % MC_continue_frontend() will then call the front-end % callback that we saved in a global earlier. % Eventually MC_continue_frontend() will % return and the gcc back-end will continue. % % It's OK for mercury_compile.m to invoke the assembler. % % XXX For programs with nested modules, % we'll end up calling the gcc back-end % more than once; this will lead to an abort. % gcc__run_backend(CommandLine, ReturnValue, FrontEndCallBack, Output) --> in_gcc(InGCC), ( { InGCC = yes } -> FrontEndCallBack(Output), { ReturnValue = 0 } ; set_global_frontend_callback(FrontEndCallBack), call_gcc_backend(CommandLine, ReturnValue), get_global_frontend_callback_output(Output) ). % Returns `yes' iff we've already entered the gcc back-end. :- pred in_gcc(bool::out, io__state::di, io__state::uo) is det. :- pragma import(in_gcc(out, di, uo), [will_not_call_mercury, tabled_for_io], "MC_in_gcc"). :- pred call_gcc_backend(string::in, int::out, io__state::di, io__state::uo) is det. :- pragma import(call_gcc_backend(in, out, di, uo), [may_call_mercury, tabled_for_io], "MC_call_gcc_backend"). :- pragma foreign_decl("C", " /* We use an `MC_' prefix for C code in the mercury/compiler directory. */ extern MR_Word MC_frontend_callback; extern MR_Word MC_frontend_callback_output; extern MR_Word MC_frontend_callback_type; void MC_in_gcc(MR_Word *result); void MC_call_gcc_backend(MR_String all_args, MR_Integer *result); void MC_continue_frontend(void); #include ""mercury_wrapper.h"" /* for MR_make_argv() */ #include /* for fprintf() */ #include /* for exit() */ "). :- pragma foreign_code("C", " /* We use an `MC_' prefix for C code in the mercury/compiler directory. */ MR_Word MC_frontend_callback; MR_Word MC_frontend_callback_output; MR_Word MC_frontend_callback_type; extern int toplev_main(int argc, char **argv); void MC_in_gcc(MR_Word *result) { /* If we've already entered gcc, then gcc will have set progname. */ *result = (progname != NULL); } void MC_call_gcc_backend(MR_String all_args, MR_Integer *result) { char *args; char **argv; int argc; const char *error_msg; static int num_calls = 0; /* ** The gcc back-end cannot be called more than once. ** If you try, it uses up all available memory. ** So we need to abort nicely in that case. ** ** That case will happen if (a) there were nested ** sub-modules or (b) the user specified more than ** one module on the command line. */ num_calls++; if (num_calls > 1) { fprintf(stderr, ""Sorry, not implemented: "" ""calling GCC back-end multiple times.\\n"" ""This can occur if you are trying to "" ""compile more than one module\\n"" ""at a time with `--target asm'.\\n"" ""Please use separate sub-modules "" ""rather than nested sub-modules,\\n"" ""i.e. put each sub-module in its own file, "" ""and don't specify more\\n"" ""than one module on the command line "" ""(use Mmake instead).\\n"" ""Or alternatively, just use `--target c'.\\n""); exit(EXIT_FAILURE); } error_msg = MR_make_argv(all_args, &args, &argv, &argc); if (error_msg) { fprintf(stderr, ""Error parsing GCC back-end arguments:\n%s\n"", error_msg); exit(EXIT_FAILURE); } merc_continue_frontend = &MC_continue_frontend; *result = toplev_main(argc, argv); /* ** Reset GCC's progname after we return from toplev_main(), ** so that MC_in_gcc() knows that we're no longer in GCC. */ progname = NULL; MR_GC_free(args); MR_GC_free(argv); } /* ** This is called from yyparse() in mercury/mercury-gcc.c ** in the gcc back-end. */ void MC_continue_frontend(void) { MC_call_frontend_callback(MC_frontend_callback_type, MC_frontend_callback, &MC_frontend_callback_output); } "). :- pred call_frontend_callback(frontend_callback(T)::in(frontend_callback), T::out, io__state::di, io__state::uo) is det. :- pragma export(call_frontend_callback(in(frontend_callback), out, di, uo), "MC_call_frontend_callback"). call_frontend_callback(FrontEndCallBack, Output) --> FrontEndCallBack(Output). :- pred get_global_frontend_callback( frontend_callback(T)::out(frontend_callback), io__state::di, io__state::uo) is det. :- pred set_global_frontend_callback( frontend_callback(T)::in(frontend_callback), io__state::di, io__state::uo) is det. :- pred get_global_frontend_callback_output(T::out, io__state::di, io__state::uo) is det. :- pred set_global_frontend_callback_output(T::in, io__state::di, io__state::uo) is det. :- pragma foreign_proc("C", get_global_frontend_callback(CallBack::out(frontend_callback), _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " CallBack = MC_frontend_callback; "). :- pragma foreign_proc("C", set_global_frontend_callback(CallBack::in(frontend_callback), _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " MC_frontend_callback = CallBack; MC_frontend_callback_type = TypeInfo_for_T; "). :- pragma foreign_proc("C", get_global_frontend_callback_output(Output::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Output = MC_frontend_callback_output; "). :- pragma foreign_proc("C", set_global_frontend_callback_output(Output::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " MC_frontend_callback_output = Output; "). %-----------------------------------------------------------------------------% :- type gcc__tree ---> gcc__tree(c_pointer). :- type gcc__tree_code == int. %-----------------------------------------------------------------------------% % % Types % :- type gcc__type == gcc__tree. :- type gcc__func_decl == gcc__type. :- pragma foreign_proc("C", void_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) void_type_node; "). :- pragma foreign_proc("C", boolean_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) boolean_type_node; "). :- pragma foreign_proc("C", char_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) char_type_node; "). :- pragma foreign_proc("C", string_type_node = (Type::out), [will_not_call_mercury, promise_pure], " /* ** XXX we should consider using const when appropriate, ** i.e. when the string doesn't have a unique mode */ Type = (MR_Word) string_type_node; "). :- pragma foreign_proc("C", double_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) double_type_node; "). :- pragma foreign_proc("C", ptr_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) ptr_type_node; "). :- pragma foreign_proc("C", integer_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) integer_type_node; "). :- pragma foreign_proc("C", int8_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) merc_int8_type_node; "). :- pragma foreign_proc("C", int16_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) merc_int16_type_node; "). :- pragma foreign_proc("C", int32_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) merc_int32_type_node; "). :- pragma foreign_proc("C", int64_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) merc_int64_type_node; "). :- pragma foreign_proc("C", intptr_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) merc_intptr_type_node; "). :- pragma foreign_proc("C", jmpbuf_type_node = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) merc_jmpbuf_type_node; "). :- pragma foreign_proc("C", build_pointer_type(Type::in, PtrType::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " PtrType = (MR_Word) build_pointer_type((tree) Type); "). :- pragma foreign_proc("C", build_array_type(ElemType::in, NumElems::in, ArrayType::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " /* XXX Move this code to `mercury-gcc.c'. */ /* XXX Do we need to check that NumElems fits in a HOST_WIDE_INT? */ HOST_WIDE_INT max = (HOST_WIDE_INT) NumElems - (HOST_WIDE_INT) 1; tree index_type = build_index_type (build_int_2 (max, (max < 0 ? -1 : 0))); ArrayType = (MR_Word) build_array_type((tree) ElemType, index_type); "). :- pragma foreign_proc("C", build_range_type(Type::in, Min::in, Max::in, RangeType::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " RangeType = (MR_Word) build_range_type((tree) Type, build_int_2 (Min, (Min < 0 ? -1 : 0)), build_int_2 (Max, (Max < 0 ? -1 : 0))); "). :- type gcc__param_types == gcc__tree. :- pragma foreign_proc("C", empty_param_types = (ParamTypes::out), [will_not_call_mercury, promise_pure], " ParamTypes = (MR_Word) merc_empty_param_type_list(); "). :- pragma foreign_proc("C", cons_param_types(Type::in, Types0::in) = (Types::out), [will_not_call_mercury, promise_pure], " Types = (MR_Word) merc_cons_param_type_list((tree) Type, (tree) Types0); "). :- pragma foreign_proc("C", build_function_type(RetType::in, ParamTypes::in, FunctionType::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " FunctionType = (MR_Word) build_function_type((tree) RetType, (tree) ParamTypes); "). :- pragma foreign_proc("C", declared_type(TypeDecl::in) = (Type::out), [will_not_call_mercury, promise_pure], " Type = (MR_Word) TREE_TYPE((tree) TypeDecl); "). :- pragma foreign_proc("C", get_array_elem_type(ArrayType::in, ElemType::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " ElemType = (MR_Word) TREE_TYPE((tree) ArrayType); "). :- pragma foreign_proc("C", get_struct_field_decls(StructType::in, FieldDecls::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " FieldDecls = (MR_Word) TYPE_FIELDS((tree) StructType); "). %-----------------------------------------------------------------------------% % % Declarations % % % Stuff for variable declarations % :- type gcc__var_decl == gcc__tree. :- pragma foreign_proc("C", build_extern_var_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_extern_var_decl(Name, (tree) Type); "). :- pragma foreign_proc("C", build_static_var_decl(Name::in, Type::in, Init::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_static_var_decl(Name, (tree) Type, (tree) Init); "). :- pragma foreign_proc("C", finish_static_var_decl(Decl::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_finish_static_var_decl((tree) Decl); "). :- pragma foreign_proc("C", build_local_var_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_local_var_decl(Name, (tree) Type); "). :- pragma foreign_proc("C", set_var_decl_public(Decl::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " TREE_PUBLIC((tree) Decl) = 1; "). :- pragma foreign_proc("C", set_var_decl_readonly(Decl::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " TREE_READONLY((tree) Decl) = 1; "). :- pragma foreign_proc("C", set_var_decl_asm_name(Decl::in, AsmName::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " SET_DECL_ASSEMBLER_NAME((tree) Decl, get_identifier(AsmName)); "). % % Stuff for function declarations % :- type gcc__param_decls == gcc__tree. :- pragma foreign_proc("C", build_param_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_param_decl(Name, (tree) Type); "). :- pragma foreign_proc("C", empty_param_decls = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_empty_param_list(); "). :- pragma foreign_proc("C", cons_param_decls(Decl::in, Decls0::in) = (Decls::out), [will_not_call_mercury, promise_pure], " Decls = (MR_Word) merc_cons_param_list((tree) Decl, (tree) Decls0); "). :- pragma foreign_proc("C", build_function_decl(Name::in, AsmName::in, RetType::in, ParamTypes::in, Params::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_function_decl(Name, AsmName, (tree) RetType, (tree) ParamTypes, (tree) Params); "). :- pragma foreign_proc("C", alloc_func_decl = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_alloc_function_node; "). :- pragma foreign_proc("C", strcmp_func_decl = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_strcmp_function_node; "). :- pragma foreign_proc("C", hash_string_func_decl = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_hash_string_function_node; "). :- pragma foreign_proc("C", box_float_func_decl = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_box_float_function_node; "). :- pragma foreign_proc("C", setjmp_func_decl = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_setjmp_function_node; "). :- pragma foreign_proc("C", longjmp_func_decl = (Decl::out), [will_not_call_mercury, promise_pure], " Decl = (MR_Word) merc_longjmp_function_node; "). :- pragma foreign_proc("C", set_func_decl_public(Decl::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " TREE_PUBLIC((tree) Decl) = 1; "). % % Stuff for type declarations. % :- type gcc__field_decl == gcc__tree. :- pragma foreign_proc("C", build_field_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_field_decl(Name, (tree) Type); "). :- pragma foreign_proc("C", field_type(Decl::in, Type::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Type = (MR_Word) TREE_TYPE((tree) Decl); "). :- type gcc__field_decls == gcc__tree. :- pragma foreign_proc("C", empty_field_list(Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_empty_field_list(); "). :- pragma foreign_proc("C", cons_field_list(Decl::in, Decls0::in, Decls::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decls = (MR_Word) merc_cons_field_list((tree) Decl, (tree) Decls0); "). :- pragma foreign_proc("C", next_field_decl(Decls::in, Decl::out, RemainingDecls::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " assert((tree) Decls != NULL_TREE); Decl = (MR_Word) (tree) Decls; RemainingDecls = (MR_Word) TREE_CHAIN((tree) Decls); "). :- type gcc__type_decl == gcc__tree. :- pragma foreign_proc("C", build_struct_type_decl(Name::in, FieldTypes::in, Decl::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Decl = (MR_Word) merc_build_struct_type_decl(Name, (tree) FieldTypes); "). %-----------------------------------------------------------------------------% % % Operators % :- type gcc__op == gcc__tree_code. :- pragma foreign_proc("C", plus_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = PLUS_EXPR; "). :- pragma foreign_proc("C", minus_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = MINUS_EXPR; "). :- pragma foreign_proc("C", mult_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = MULT_EXPR; "). :- pragma foreign_proc("C", rdiv_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = RDIV_EXPR; "). :- pragma foreign_proc("C", trunc_div_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = TRUNC_DIV_EXPR; "). :- pragma foreign_proc("C", trunc_mod_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = TRUNC_MOD_EXPR; "). :- pragma foreign_proc("C", eq_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = EQ_EXPR; "). :- pragma foreign_proc("C", ne_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = NE_EXPR; "). :- pragma foreign_proc("C", lt_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = LT_EXPR; "). :- pragma foreign_proc("C", gt_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = GT_EXPR; "). :- pragma foreign_proc("C", le_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = LE_EXPR; "). :- pragma foreign_proc("C", ge_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = GE_EXPR; "). :- pragma foreign_proc("C", truth_andif_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = TRUTH_ANDIF_EXPR; "). :- pragma foreign_proc("C", truth_orif_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = TRUTH_ORIF_EXPR; "). :- pragma foreign_proc("C", truth_not_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = TRUTH_NOT_EXPR; "). :- pragma foreign_proc("C", bit_ior_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = BIT_IOR_EXPR; "). :- pragma foreign_proc("C", bit_xor_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = BIT_XOR_EXPR; "). :- pragma foreign_proc("C", bit_and_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = BIT_AND_EXPR; "). :- pragma foreign_proc("C", bit_not_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = BIT_NOT_EXPR; "). :- pragma foreign_proc("C", lshift_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = LSHIFT_EXPR; "). :- pragma foreign_proc("C", rshift_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = RSHIFT_EXPR; "). :- pragma foreign_proc("C", array_ref = (Code::out), [will_not_call_mercury, promise_pure], " Code = ARRAY_REF; "). %-----------------------------------------------------------------------------% % % Expressions % :- type gcc__expr == gcc__tree. :- pragma foreign_proc("C", expr_type(Expr::in, Type::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Type = (MR_Word) TREE_TYPE((tree) Expr); "). % % constants % build_int(Val, IntExpr) --> { Lowpart = Val }, { Highpart = (if Val < 0 then -1 else 0) }, build_int_2(Lowpart, Highpart, IntExpr). % build_int_2(Lowpart, Highpart): % build an expression for an integer constant. % Lowpart gives the low word, and Highpart gives the high word. :- pred build_int_2(int, int, gcc__expr, io__state, io__state). :- mode build_int_2(in, in, out, di, uo) is det. :- pragma foreign_proc("C", build_int_2(Low::in, High::in, Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Expr = (MR_Word) build_int_2(Low, High); "). build_float(Val, Expr) --> build_real(gcc__double_type_node, Val, Expr). % build an expression for a floating-point constant % of the specified type. :- pred build_real(gcc__type, float, gcc__expr, io__state, io__state). :- mode build_real(in, in, out, di, uo) is det. :- pragma foreign_proc("C", build_real(Type::in, Value::in, Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Expr = (MR_Word) merc_build_real((tree) Type, Value); "). build_string(String, Expr) --> build_string(string__length(String) + 1, String, Expr). :- pragma foreign_proc("C", build_string(Len::in, String::in, Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Expr = (MR_Word) merc_build_string(Len, String); "). :- pragma foreign_proc("C", build_null_pointer(NullPointerExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " NullPointerExpr = (MR_Word) null_pointer_node; "). % % operator expressions % :- pragma foreign_proc("C", build_unop(Op::in, Type::in, Arg::in, Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Expr = (MR_Word) fold(build1(Op, (tree) Type, (tree) Arg)); "). :- pragma foreign_proc("C", build_binop(Op::in, Type::in, Arg1::in, Arg2::in, Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Expr = (MR_Word) fold(build(Op, (tree) Type, (tree) Arg1, (tree) Arg2)); "). :- pragma foreign_proc("C", build_pointer_deref(Pointer::in, DerefExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " /* XXX should move to mercury-gcc.c */ tree ptr = (tree) Pointer; tree ptr_type = TREE_TYPE (ptr); tree type = TREE_TYPE (ptr_type); DerefExpr = (MR_Word) build1 (INDIRECT_REF, type, ptr); "). :- pragma foreign_proc("C", build_component_ref(ObjectExpr::in, FieldDecl::in, FieldExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " /* XXX should move to mercury-gcc.c */ tree field_type = TREE_TYPE ((tree) FieldDecl); FieldExpr = (MR_Word) build (COMPONENT_REF, field_type, (tree) ObjectExpr, (tree) FieldDecl); "). :- pragma foreign_proc("C", convert_type(Expr::in, Type::in, ResultExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " /* ** XXX should we use convert() instead? ** if not, should we expose the CONVERT_EXPR gcc__op ** and just use gcc__build_binop? */ ResultExpr = (MR_Word) build1 (CONVERT_EXPR, (tree) Type, (tree) Expr); "). % We building an address expression, we need to call % mark_addressable to let the gcc back-end know that we've % taken the address of this expression, so that (e.g.) % if the expression is a variable, then gcc will know to % put it in a stack slot rather than a register. % To make the interface to this module safer, % we don't export the `addr_expr' operator directly. % Instead, we only export the procedure `build_addr_expr' % which includes the necessary call to mark_addressable. build_addr_expr(Expr, AddrExpr) --> mark_addressable(Expr), expr_type(Expr, Type), build_pointer_type(Type, PtrType), build_unop(addr_expr, PtrType, Expr, AddrExpr). :- func addr_expr = gcc__op. % & (address-of) :- pragma foreign_proc("C", addr_expr = (Code::out), [will_not_call_mercury, promise_pure], " Code = ADDR_EXPR; "). :- pred mark_addressable(gcc__expr::in, io__state::di, io__state::uo) is det. :- pragma foreign_proc("C", mark_addressable(Expr::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " mark_addressable((tree) Expr); "). % % variables % % GCC represents variable expressions just by (the pointer to) % their declaration tree node. var_expr(Decl) = Decl. % % stuff for function calls % % GCC represents functions pointer expressions just as ordinary % ADDR_EXPR nodes whose operand is the function declaration tree node. build_func_addr_expr(FuncDecl, Expr) --> build_addr_expr(FuncDecl, Expr). :- type gcc__arg_list == gcc__tree. :- pragma foreign_proc("C", empty_arg_list(ArgList::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " ArgList = (MR_Word) merc_empty_arg_list(); "). :- pragma foreign_proc("C", cons_arg_list(Arg::in, ArgList0::in, ArgList::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " ArgList = (MR_Word) merc_cons_arg_list((tree) Arg, (tree) ArgList0); "). :- pragma foreign_proc("C", build_call_expr(Func::in, Args::in, IsTailCall::in, CallExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " CallExpr = (MR_Word) merc_build_call_expr((tree) Func, (tree) Args, (int) IsTailCall); "). % % Initializers % :- type gcc__init_elem == gcc__tree. gcc__array_elem_initializer(Int, GCC_Int) --> build_int(Int, GCC_Int). gcc__struct_field_initializer(FieldDecl, FieldDecl) --> []. :- type gcc__init_list == gcc__tree. :- pragma foreign_proc("C", empty_init_list(InitList::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " InitList = (MR_Word) merc_empty_init_list(); "). :- pragma foreign_proc("C", cons_init_list(Elem::in, Init::in, InitList0::in, InitList::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " InitList = (MR_Word) merc_cons_init_list((tree) Elem, (tree) Init, (tree) InitList0); "). :- pragma foreign_proc("C", build_initializer_expr(InitList::in, Type::in, Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Expr = (MR_Word) build(CONSTRUCTOR, (tree) Type, NULL_TREE, (tree) InitList); "). %-----------------------------------------------------------------------------% % % Routines to protect memory from being collected by the GCC garbage % collector (see gcc/ggc.h). % :- pragma import(push_gc_context(di, uo), [will_not_call_mercury, tabled_for_io], "ggc_push_context"). :- pragma import(pop_gc_context(di, uo), [will_not_call_mercury, tabled_for_io], "ggc_pop_context"). %-----------------------------------------------------------------------------% % % Functions % :- pragma foreign_proc("C", start_function(FuncDecl::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_start_function((tree) FuncDecl); "). :- pragma import(end_function(di, uo), [will_not_call_mercury, tabled_for_io], "merc_end_function"). :- pragma foreign_proc("C", set_context(FileName::in, LineNumber::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_set_context(FileName, LineNumber); "). :- pragma foreign_proc("C", gen_line_note(FileName::in, LineNumber::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " emit_line_note(FileName, LineNumber); "). %-----------------------------------------------------------------------------% % % Statements. % % % blocks % :- pragma foreign_proc("C", start_block(_IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " pushlevel(0); expand_start_bindings(0); "). :- pragma foreign_proc("C", end_block(_IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " tree block = poplevel(/*keep=*/1, /*reverse=*/1, /*functionbody=*/0); expand_end_bindings(block, /*mark_ends=*/1, /*dont_jump_in=*/0); "). % % if-then-else % :- pragma foreign_proc("C", gen_start_cond(Cond::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " expand_start_cond((tree) Cond, 0); "). :- pragma import(gen_start_else(di, uo), [will_not_call_mercury, tabled_for_io], "expand_start_else"). :- pragma import(gen_end_cond(di, uo), [will_not_call_mercury, tabled_for_io], "expand_end_cond"). % % switch statements % :- pragma foreign_proc("C", gen_start_switch(Expr::in, Type::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " expand_start_case(1, (tree) Expr, (tree) Type, ""switch""); "). :- pragma foreign_proc("C", gen_case_label(Value::in, Label::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_gen_switch_case_label((tree) Value, (tree) Label); "). :- pragma foreign_proc("C", gen_default_case_label(Label::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_gen_switch_case_label(NULL_TREE, (tree) Label); "). :- pragma foreign_proc("C", gen_break(_IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " int result = expand_exit_something(); assert(result != 0); "). :- pragma foreign_proc("C", gen_end_switch(Expr::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " expand_end_case((tree) Expr); "). % % loops % % the type `gcc__loop' corresponds to the % C type `struct nesting *' :- type gcc__loop ---> gcc__loop(c_pointer). :- pragma foreign_proc("C", gen_start_loop(Loop::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Loop = (MR_Word) expand_start_loop(0); "). :- pragma foreign_proc("C", gen_exit_loop_if_false(Loop::in, Expr::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " int res = expand_exit_loop_if_false((struct nesting *) Loop, (tree) Expr); assert(res != 0); "). :- pragma foreign_proc("C", gen_end_loop(_IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " expand_end_loop(); "). % % calls and return % :- pragma foreign_proc("C", gen_expr_stmt(Expr::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_gen_expr_stmt((tree) Expr); "). :- pragma foreign_proc("C", gen_return(Expr::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_gen_return((tree) Expr); "). % % assignment % :- pragma foreign_proc("C", gen_assign(LHS::in, RHS::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " merc_gen_assign((tree) LHS, (tree) RHS); "). % % labels and gotos % :- type gcc__label == gcc__tree. :- pragma foreign_proc("C", build_label(Name::in, Label::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Label = (MR_Word) merc_build_label(Name); "). :- pragma foreign_proc("C", build_unnamed_label(Label::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " Label = (MR_Word) merc_build_label(NULL); "). :- pragma foreign_proc("C", gen_label(Label::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " expand_label((tree) Label); "). :- pragma foreign_proc("C", gen_goto(Label::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " expand_goto((tree) Label); "). %-----------------------------------------------------------------------------%