%-----------------------------------------------------------------------------% % vim: ts=4 sw=4 et ft=mercury %-----------------------------------------------------------------------------% % Copyright (C) 2001-2006, 2009-2010 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 gcc_frontend_callback(T) == pred(T, io.state, io.state). :- inst gcc_frontend_callback == (pred(out, di, uo) is det). :- pred gcc.run_backend(string::in, int::out, gcc_frontend_callback(T)::in(gcc_frontend_callback), T::out, io::di, io::uo) is det. %-----------------------------------------------------------------------------% % The GCC `tree' type. :- type gcc.tree. :- type gcc.tree_code. %-----------------------------------------------------------------------------% % % Types. % % A GCC `tree' representing a type. :- type gcc.gcc_type. % Builtin types :- func void_type_node = gcc.gcc_type. :- func boolean_type_node = gcc.gcc_type. :- func char_type_node = gcc.gcc_type. :- func string_type_node = gcc.gcc_type. % `char *' :- func double_type_node = gcc.gcc_type. :- func ptr_type_node = gcc.gcc_type. % `void *' :- func integer_type_node = gcc.gcc_type. % C `int'. % (Note that we use `intptr_t' for % the Mercury `int' type.) :- func int8_type_node = gcc.gcc_type. % C99 `int8_t' :- func int16_type_node = gcc.gcc_type. % C99 `int16_t' :- func int32_type_node = gcc.gcc_type. % C99 `int32_t' :- func int64_type_node = gcc.gcc_type. % C99 `int64_t' :- func intptr_type_node = gcc.gcc_type. % C99 `intptr_t' :- func jmpbuf_type_node = gcc.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.gcc_type::in, gcc.gcc_type::out, io::di, io::uo) is det. % Given a type `T', and a size N, produce an array type `T[N]'. % :- pred build_array_type(gcc.gcc_type::in, int::in, gcc.gcc_type::out, io::di, io::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.gcc_type::in, int::in, int::in, gcc.gcc_type::out, io::di, io::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.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.gcc_type::in, gcc.param_types::in, gcc.gcc_type::out, io::di, io::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.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.gcc_type::in, gcc.gcc_type::out, io::di, io::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.gcc_type::in, gcc.field_decls::out, io::di, io::uo) is det. %-----------------------------------------------------------------------------% % % Declarations. % % % 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.gcc_type::in, gcc.var_decl::out, io::di, io::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.gcc_type::in, gcc.expr::in, gcc.var_decl::out, io::di, io::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::di, io::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.gcc_type::in, gcc.var_decl::out, io::di, io::uo) is det. % Mark a variable as being accessible from outside this translation unit. % :- pred set_var_decl_public(gcc.var_decl::in, io::di, io::uo) is det. % Mark a variable as read-only. % :- pred set_var_decl_readonly(gcc.var_decl::in, io::di, io::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::di, io::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::di, io::uo) is det. % Like `}' in C. :- pred end_block(io::di, io::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.gcc_type::in, gcc.param_decl::out, io::di, io::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::in, func_asm_name::in, gcc.gcc_type::in, gcc.param_types::in, gcc.param_decls::in, gcc.func_decl::out, io::di, io::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::di, io::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.gcc_type::in, gcc.field_decl::out, io::di, io::uo) is det. % Get the type of a field. % :- pred field_type(gcc.field_decl::in, gcc.gcc_type::out, io::di, io::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::out, io::di, io::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::in, gcc.field_decls::in, gcc.field_decls::out, io::di, io::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::in, gcc.field_decl::out, gcc.field_decls::out, io::di, io::uo) is det. :- type gcc.type_decl. :- type struct_name == string. :- pred build_struct_type_decl(gcc.struct_name::in, gcc.field_decls::in, gcc.type_decl::out, io::di, io::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::in, gcc.gcc_type::out, io::di, io::uo) is det. % % Constants. % % Build an expression for an integer constant. % :- pred build_int(int::in, gcc.expr::out, io::di, io::uo) is det. % Build an expression for a floating-point constant. % :- pred build_float(float::in, gcc.expr::out, io::di, io::uo) is det. % Build an expression for a Mercury string constant. % :- pred build_string(string::in, gcc.expr::out, io::di, io::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::in, string::in, gcc.expr::out, io::di, io::uo) is det. % Build an expression for a null pointer. % :- pred build_null_pointer(gcc.expr::out, io::di, io::uo) is det. % % Operator expressions. % % Build a unary expression. % :- pred build_unop(gcc.op::in, gcc.gcc_type::in, gcc.expr::in, gcc.expr::out, io::di, io::uo) is det. % Build a binary expression. % :- pred build_binop(gcc.op::in, gcc.gcc_type::in, gcc.expr::in, gcc.expr::in, gcc.expr::out, io::di, io::uo) is det. % Take the address of an expression. % :- pred build_addr_expr(gcc.expr::in, gcc.expr::out, io::di, io::uo) is det. % Build a pointer dereference expression. % :- pred build_pointer_deref(gcc.expr::in, gcc.expr::out, io::di, io::uo) is det. % Build a field extraction expression. % :- pred build_component_ref(gcc.expr::in, gcc.field_decl::in, gcc.expr::out, io::di, io::uo) is det. % Build a type conversion expression. % :- pred convert_type(gcc.expr::in, gcc.gcc_type::in, gcc.expr::out, io::di, io::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::in, gcc.expr::out, io::di, io::uo) is det. % A GCC `tree' representing a list of arguments. :- type gcc.arg_list. :- pred empty_arg_list(gcc.arg_list::out, io::di, io::uo) is det. :- pred cons_arg_list(gcc.expr::in, gcc.arg_list::in, gcc.arg_list::out, io::di, io::uo) is det. % Build an expression for a function call. % :- pred build_call_expr(gcc.expr::in, gcc.arg_list::in, bool::in, gcc.expr::out, io::di, io::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::in, gcc.init_elem::out, io::di, io::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::in, gcc.init_elem::out, io::di, io::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::out, io::di, io::uo) is det. :- pred cons_init_list(gcc.init_elem::in, gcc.expr::in, gcc.init_list::in, gcc.init_list::out, io::di, io::uo) is det. % Build an expression for an array or structure initializer. % :- pred build_initializer_expr(gcc.init_list::in, gcc.gcc_type::in, gcc.expr::out, io::di, io::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::di, io::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::di, io::uo) is det. %-----------------------------------------------------------------------------% % % Functions % % Start generating code for a function. % :- pred start_function(gcc.func_decl::in, io::di, io::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::di, io::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::in, int::in, io::di, io::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::in, int::in, io::di, io::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::in, io::di, io::uo) is det. % Start the else part (optional). % :- pred gen_start_else(io::di, io::uo) is det. % Finish the if-then-else. % :- pred gen_end_cond(io::di, io::uo) is det. % % Routines to generate code for switches. % :- pred gen_start_switch(gcc.expr::in, gcc.gcc_type::in, io::di, io::uo) is det. :- pred gen_case_label(gcc.expr::in, gcc.label::in, io::di, io::uo) is det. :- pred gen_default_case_label(gcc.label::in, io::di, io::uo) is det. :- pred gen_break(io::di, io::uo) is det. :- pred gen_end_switch(gcc.expr::in, io::di, io::uo) is det. % % Routines to generate code for loops. % :- type gcc.loop. :- pred gen_start_loop(gcc.loop::out, io::di, io::uo) is det. :- pred gen_exit_loop_if_false(gcc.loop::in, gcc.expr::in, io::di, io::uo) is det. :- pred gen_end_loop(io::di, io::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::in, io::di, io::uo) is det. % Generate code for a return statement. % :- pred gen_return(gcc.expr::in, io::di, io::uo) is det. % % Assignment. % % gen_assign(LHS, RHS): % % Generate code for an assignment statement. % :- pred gen_assign(gcc.expr::in, gcc.expr::in, io::di, io::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::in, gcc.label::out, io::di, io::uo) is det. :- pred build_unnamed_label(gcc.label::out, io::di, io::uo) is det. :- pred gen_label(gcc.label::in, io::di, io::uo) is det. :- pred gen_goto(gcc.label::in, io::di, io::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 "). %-----------------------------------------------------------------------------% gcc.run_backend(CommandLine, ReturnValue, FrontEndCallBack, Output, !IO) :- in_gcc(InGCC, !IO), % 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. % ( InGCC = yes, FrontEndCallBack(Output, !IO), ReturnValue = 0 ; InGCC = no, set_global_frontend_callback(FrontEndCallBack, !IO), call_gcc_backend(CommandLine, ReturnValue, !IO), get_global_frontend_callback_output(Output, !IO) ). % Returns `yes' iff we've already entered the gcc back-end. % :- pred in_gcc(bool::out, io::di, io::uo) is det. :- pragma foreign_proc("C", in_gcc(Result::out, _IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, tabled_for_io], " MC_in_gcc(&Result); "). :- pred call_gcc_backend(string::in, int::out, io::di, io::uo) is det. :- pragma foreign_proc("C", call_gcc_backend(AllArgs::in, Result::out, _IO0::di, _IO::uo), [promise_pure, may_call_mercury, tabled_for_io], " MC_call_gcc_backend(AllArgs, &Result); "). :- 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( gcc_frontend_callback(T)::in(gcc_frontend_callback), T::out, io::di, io::uo) is det. :- pragma foreign_export("C", call_frontend_callback(in(gcc_frontend_callback), out, di, uo), "MC_call_frontend_callback"). call_frontend_callback(FrontEndCallBack, Output) --> FrontEndCallBack(Output). :- pred get_global_frontend_callback( gcc_frontend_callback(T)::out(gcc_frontend_callback), io::di, io::uo) is det. :- pred set_global_frontend_callback( gcc_frontend_callback(T)::in(gcc_frontend_callback), io::di, io::uo) is det. :- pred get_global_frontend_callback_output(T::out, io::di, io::uo) is det. :- pred set_global_frontend_callback_output(T::in, io::di, io::uo) is det. :- pragma foreign_proc("C", get_global_frontend_callback(CallBack::out(gcc_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(gcc_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.gcc_type == gcc.tree. :- type gcc.func_decl == gcc.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::in, int::in, gcc.expr::out, io::di, io::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.gcc_type::in, float::in, gcc.expr::out, io::di, io::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, !IO) :- mark_addressable(Expr, !IO), expr_type(Expr, Type, !IO), build_pointer_type(Type, PtrType, !IO), build_unop(addr_expr, PtrType, Expr, AddrExpr, !IO). :- 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::di, io::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. % build_func_addr_expr(FuncDecl, Expr, !IO) :- % GCC represents functions pointer expressions just as ordinary % ADDR_EXPR nodes whose operand is the function declaration tree node. build_addr_expr(FuncDecl, Expr, !IO). :- 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 foreign_proc("C", push_gc_context(_IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, tabled_for_io], " ggc_push_context(); "). :- pragma foreign_proc("C", pop_gc_context(_IO0::di, _IO::uo), [promise_pure, 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 foreign_proc("C", end_function(_IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, 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 foreign_proc("C", gen_start_else(_IO0::di, _IO::uo), [promise_pure, will_not_call_mercury, tabled_for_io], " expand_start_else(); "). :- pragma foreign_proc("C", gen_end_cond(_IO0::di, _IO::uo), [promise_pure, 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); "). %-----------------------------------------------------------------------------%