[m-rev.] diff: delete GCC backend
Julien Fischer
jfischer at opturion.com
Wed Jan 16 15:21:06 AEDT 2013
Delete the MLDS->GCC (assembler) backend.
As discussed in the recent Mercury meeting, remove support for the GCC backend.
It was very much out of date and supporting it proprerly would means having to
track changes to GCC's internals. Furthermore, its presence complicates
building the compiler.
The main thing this change does not address is the fact that we invoke
the compiler through C code, e.g. main.c in the top-level of the source
tree. This was required by the GCC backend and can now be removed, but
I will do that as a separate change.
configure.ac:
Mmake.common.in:
scripts/Mmake.rules:
compiler/Mercury.options:
compiler/Mmakefile:
compiler/gcc.m:
compiler/maybe_mlds_to_gcc.pp:
compiler/mlds_to_gcc.m:
Delete the files containing the GCC backend.
compiler/options.m:
compiler/handle_options.m:
Delete support for `--target asm' and `--pic'.
(The latter was only used by the GCC backend.)
compiler/*.m:
doc/user_guide.texi:
compiler/notes/comiler_design.html:
compiler/notes/work_in_progress.m:
Conform to the above change.
README.gcc-backend.m:
Delete this file.
Julien.
diff --git a/Mmake.common.in b/Mmake.common.in
index 5fdd170..f8e2395 100644
--- a/Mmake.common.in
+++ b/Mmake.common.in
@@ -198,22 +198,6 @@ LIBRARY_INTERMODULE = yes
# directory.
LIBRARY_TRACE_MINIMUM = yes
-# Do we want to include the support for compiling directly to assembler
-# using the GCC back-end in the compiler?
-# This requires that you have the source code for gcc in the
-# directory specified by GCC_SRC_DIR (below).
-# This can be set using the `--enable-gcc-back-end' or `--disable-gcc-back-end'
-# options to configure; by default, configure will try to autoconfigure
-# it based on whether the gcc source is present.
-ENABLE_GCC_BACK_END = @ENABLE_GCC_BACK_END@
-
-# Specify the directory containing the GCC sources.
-# This must be a relative path, not an absolute path.
-# The directory named should contain subdirectories `gcc', `libiberty', etc.,
-# and the `gcc' subdirectory should contain files `gcc.c',
-# `tree.c', `tree.h', etc.
-GCC_SRC_DIR = @GCC_SRC_DIR@
-
# Enable building of the deep profiler?
# The value of ENABLE_DEEP_PROFILER is either yes or no.
ENABLE_DEEP_PROFILER=@ENABLE_DEEP_PROFILER@
diff --git a/README.gcc-backend b/README.gcc-backend
deleted file mode 100644
index 65fa703..0000000
--- a/README.gcc-backend
+++ /dev/null
@@ -1,4 +0,0 @@
-For information about the GCC-based native-code back-end for the Mercury
-compiler, see:
-
- <http://www.mercury.csse.unimelb.edu.au/download/gcc-backend.html>
diff --git a/compiler/Mercury.options b/compiler/Mercury.options
index cb770a1..93d67c4 100644
--- a/compiler/Mercury.options
+++ b/compiler/Mercury.options
@@ -73,18 +73,3 @@ MCFLAGS-mode_robdd.implications = -O0
# Work around a problem in the HiPE compiler (as of Erlang R11B5).
MCFLAGS-libs.options += --erlang-switch-on-strings-as-atoms
-
-# The c_code in the module gcc.m needs the header files from the GNU C
-# distribution. Note that we need to compile these with
-# -DMR_NO_BACKWARDS_COMPAT, because otherwise there are name
-# conflicts with symbols defined in the GCC headers.
-CFLAGS-gcc = -DMR_NO_BACKWARDS_COMPAT \
- -DIN_GCC -DHAVE_CONFIG_H \
- -I. \
- -I$(GCC_SRC_DIR)/gcc \
- -I$(GCC_SRC_DIR)/gcc/mercury \
- -I$(GCC_SRC_DIR)/gcc/config \
- -I$(GCC_SRC_DIR)/include \
- -I$(GCC_SRC_DIR)
-# Likewise for mlds_to_gcc.m
-CFLAGS-mlds_to_gcc = $(CFLAGS-gcc)
diff --git a/compiler/Mmakefile b/compiler/Mmakefile
index b9ab499..68f8809 100644
--- a/compiler/Mmakefile
+++ b/compiler/Mmakefile
@@ -25,15 +25,11 @@ Mmake.compiler.params:
# Module-specific options should go in Mercury.options so they
# can be found by `mmc --make'.
-# Mercury.options uses $(GCC_SRC_DIR), so make sure it is
-# in the environment of `mmc --make'.
-GCC_SRC_DIR := $(MERCURY_DIR)/$(GCC_SRC_DIR)
-export GCC_SRC_DIR
include Mercury.options
MAIN_TARGET=all
-MERCURY_MAIN_MODULES = top_level mlds_to_gcc
+MERCURY_MAIN_MODULES = top_level
VPATH = \
$(LIBRARY_DIR) \
@@ -43,27 +39,6 @@ VPATH = \
#-----------------------------------------------------------------------------#
-# Specify how to link in the GCC back-end.
-# This uses the file `mercury_gcc_backend_libs', which is generated by
-# the gcc Makefile (from gcc/mercury/Make-lang.in), which contains
-# a list of the object files and libraries that we need to link in.
-ifeq ($(ENABLE_GCC_BACK_END),yes)
-GCC_LIBS = $(shell cat $(GCC_SRC_DIR)/gcc/mercury_gcc_backend_libs)
-GCC_EXTRA_LIBS = $(filter -l%,$(GCC_LIBS))
-GCC_MAIN_LIBS = $(patsubst %,$(GCC_SRC_DIR)/gcc/%,$(filter-out
-l%,$(GCC_LIBS)))
-GCC_BACKEND_LIBS = $(GCC_MAIN_LIBS) $(GCC_EXTRA_LIBS)
-else
-GCC_MAIN_LIBS =
-GCC_BACKEND_LIBS =
-endif
-
-# Ensure that we rebuild the GCC libbackend.a, etc., if it is out-of-date
-.PHONY: force
-force: ;
-
-$(GCC_MAIN_LIBS): force
- cd $(GCC_SRC_DIR)/gcc && $(MAKE) mercury_gcc_backend_libs
-
MCFLAGS += --flags COMP_FLAGS $(CONFIG_OVERRIDE)
ifeq ("$(filter il% csharp% java% erlang%,$(GRADE))","")
@@ -75,7 +50,7 @@ else
MLOBJS =
endif
-ALL_MLLIBS = $(MLLIBS) $(EXTRA_MLLIBS) $(GCC_BACKEND_LIBS)
+ALL_MLLIBS = $(MLLIBS) $(EXTRA_MLLIBS)
MLFLAGS += --no-main --shared
C2INITARGS += $(MDBCOMP_DIR)/$(MDBCOMP_LIB_NAME).init
@@ -128,38 +103,7 @@ $(dates_subdir)%.pp_date: %.pp
# Define $(PP_SED_EXPR) appropriately for each preprocessed module.
#
PP_SED_EXPR = $(PP_SED_EXPR-$*)
-PP_SED_EXPR-maybe_mlds_to_gcc = $(GCC_SED_EXPR)
-#
-# For GCC .pp files, enable/disable code within
-# `#if ENABLE_GCC_BACK_END ... #else .. #endif'
-#
-ifeq ($(ENABLE_GCC_BACK_END),yes)
-# Remove the #if line and everything between the #else and #endif lines.
-GCC_SED_EXPR = -e "/^$${hash}if *ENABLE_GCC_BACK_END/s/.*//" \
- -e "/^$${hash}else/,/^$${hash}endif/s/.*//"
-else
-# Remove everything between the #if line and the #else line,
-# and the #endif line.
-GCC_SED_EXPR = -e "/^$${hash}if *ENABLE_GCC_BACK_END/,/^$${hash}else/s/.*//" \
- -e "/^$${hash}endif/s/.*//"
-endif
-
-PREPROCESSED_MODULES = maybe_mlds_to_gcc
-PREPROCESSED_FILES = $(PREPROCESSED_MODULES:%=%.pp)
-PREPROCESSED_M_FILES = $(PREPROCESSED_MODULES:%=%.m)
-PP_DATE_FILES = $(PREPROCESSED_MODULES:%=$(dates_subdir)%.pp_date)
-
-# Force regeneration of the preprocessed modules.
-# This is necessary if the setting of `INCLUDE_ADITI_OUTPUT' has changed.
-regenerate_preprocessed_files:
- -[ -d ./$(dates_subdir) ] || mkdir -p ./$(dates_subdir)
- touch $(PREPROCESSED_FILES)
- MMAKE_DIR=$(SCRIPTS_DIR) $(MMAKE) $(PREPROCESSED_M_FILES)
-
-# The `.m' files for the preprocessed modules depend on the `.pp_date' files.
-$(PREPROCESSED_M_FILES): %.m: $(dates_subdir)%.pp_date
- @:
#-----------------------------------------------------------------------------#
@@ -173,7 +117,7 @@ MC_PROG = top_level
.PHONY: depend
depend: $(MC_PROG).depend
-$(MC_PROG).depend: regenerate_preprocessed_files Mercury.modules COMP_FLAGS
+$(MC_PROG).depend: Mercury.modules COMP_FLAGS
# This directory contains source files for which the module
# name doesn't match the file name, so smart recompilation
@@ -224,31 +168,6 @@ mercury_compile_init.$O: $(MC_PROG)_init.$O
#-----------------------------------------------------------------------------#
-# The GCC back-end stuff is conditionally compiled out of maybe_mlds_to_gcc.m.
-# But we want to make sure that the GCC back-end continues to compile,
-# even when the compiler was configured without the GCC back-end.
-# So we include the following rules, which tell Mmake to build the
-# dependencies for mlds_to_gcc and to build mlds_to_gcc.c and gcc.c.
-# (We used to just build mlds_to_gcc.err, but that caused
bootstrapping problems
-# with the source distribution; using the .c files is little more robust.)
-
-ifeq ("$(filter il% csharp% java% erlang%,$(GRADE))","")
-
-.PHONY: depend
-depend: COMP_FLAGS mlds_to_gcc.depend
-
-mlds_to_gcc.depend: regenerate_preprocessed_files
-
-.PHONY: mercury
-mercury: mlds_to_gcc.c gcc.c
-
-.PHONY: cs
-cs: mlds_to_gcc.c gcc.c
-
-endif
-
-#-----------------------------------------------------------------------------#
-
# Tell the C# compiler where the stdlib and mdbcomp assemblies are.
#
ifneq ("$(filter csharp%,$(GRADE))","")
@@ -278,7 +197,6 @@ $(MC_PROG): $(TRACE_DIR)/lib$(TRACE_LIB_NAME).$A
$(MC_PROG): $(TRACE_DIR)/lib$(EVENTSPEC_LIB_NAME).$A
# XXX should also depend on $(BOEHM_GC_DIR)/libgc(_prof).$A, but only
# if in .gc(.prof) grade
-$(MC_PROG): $(GCC_MAIN_LIBS)
endif
endif
@@ -305,7 +223,7 @@ ints: $(MC_PROG).ints
.PHONY: tags
tags: .compiler_tags
-.compiler_tags: $(MTAGS) $(PREPROCESSED_M_FILES) \
+.compiler_tags: $(MTAGS) \
$(wildcard *.m) \
$(wildcard $(LIBRARY_DIR)/*.m) \
$(wildcard $(MDBCOMP_DIR)/*.m)
diff --git a/compiler/add_pragma.m b/compiler/add_pragma.m
index f018cbc..1d3ace2 100644
--- a/compiler/add_pragma.m
+++ b/compiler/add_pragma.m
@@ -1192,8 +1192,6 @@ target_lang_to_foreign_enum_lang(target_c) = lang_c.
target_lang_to_foreign_enum_lang(target_il) = lang_il.
target_lang_to_foreign_enum_lang(target_csharp) = lang_csharp.
target_lang_to_foreign_enum_lang(target_java) = lang_java.
-target_lang_to_foreign_enum_lang(target_asm) =
- sorry($module, $pred, "pragma foreign_enum and --target `asm'.").
target_lang_to_foreign_enum_lang(target_x86_64) =
sorry($module, $pred, "pragma foreign_enum and --target `x86_64'.").
target_lang_to_foreign_enum_lang(target_erlang) = lang_erlang.
@@ -2772,7 +2770,6 @@ create_tabling_reset_pred(ProcId, Context,
SimpleCallId, SingleProc,
get_target(Globals, TargetLang),
(
( TargetLang = target_c
- ; TargetLang = target_asm
; TargetLang = target_x86_64
),
ForeignLang = lang_c
diff --git a/compiler/add_solver.m b/compiler/add_solver.m
index 3e76c35..f0d6aaa 100644
--- a/compiler/add_solver.m
+++ b/compiler/add_solver.m
@@ -216,7 +216,6 @@ add_solver_type_clause_items(TypeSymName,
TypeParams, SolverTypeDetails,
Lang = lang_erlang
;
( Target = target_il
- ; Target = target_asm
; Target = target_x86_64
),
WhatMsg = "solver type conversion functions for this backend",
diff --git a/compiler/add_type.m b/compiler/add_type.m
index 215fdf3..080e4a4 100644
--- a/compiler/add_type.m
+++ b/compiler/add_type.m
@@ -454,7 +454,6 @@ check_foreign_type(TypeCtor, ForeignTypeBody,
Context, FoundError, !ModuleInfo,
; Target = target_il, LangStr = "IL"
; Target = target_csharp, LangStr = "C#"
; Target = target_java, LangStr = "Java"
- ; Target = target_asm, LangStr = "C"
; Target = target_x86_64, LangStr = "C"
; Target = target_erlang, LangStr = "Erlang"
),
diff --git a/compiler/compile_target_code.m b/compiler/compile_target_code.m
index 6e24c89..64f0830 100644
--- a/compiler/compile_target_code.m
+++ b/compiler/compile_target_code.m
@@ -1411,28 +1411,8 @@ link_module_list(Modules, ExtraObjFiles,
Globals, Succeeded, !IO) :-
get_object_code_type(Globals, TargetType, PIC),
maybe_pic_object_file_extension(Globals, PIC, Obj),
- globals.get_target(Globals, Target),
io.output_stream(OutputStream, !IO),
- (
- Target = target_asm,
- % For --target asm, we generate everything into a single object file.
- (
- Modules = [FirstModule | _],
- join_module_list(Globals, [FirstModule], Obj, ObjectsList, !IO)
- ;
- Modules = [],
- unexpected($module, $pred, "no modules")
- )
- ;
- ( Target = target_c
- ; Target = target_java
- ; Target = target_csharp
- ; Target = target_il
- ; Target = target_x86_64
- ; Target = target_erlang
- ),
- join_module_list(Globals, Modules, Obj, ObjectsList, !IO)
- ),
+ join_module_list(Globals, Modules, Obj, ObjectsList, !IO),
(
TargetType = executable,
list.map(
@@ -2684,7 +2664,6 @@ process_link_library(Globals, MercuryLibDirs,
LibName, LinkerOpt, !Succeeded,
globals.get_target(Globals, Target),
(
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64
),
globals.lookup_string_option(Globals, mercury_linkage, MercuryLinkage),
@@ -3109,54 +3088,46 @@ get_object_code_type(Globals, FileType,
ObjectCodeType) :-
globals.lookup_string_option(Globals, mercury_linkage, MercuryLinkage),
globals.lookup_bool_option(Globals, gcc_global_registers, GCCGlobals),
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
- globals.lookup_bool_option(Globals, pic, PIC),
globals.get_target(Globals, Target),
(
- PIC = yes,
- % We've been explicitly told to use position independent code.
+ ( FileType = static_library
+ ; FileType = csharp_executable
+ ; FileType = csharp_library
+ ; FileType = java_launcher
+ ; FileType = java_archive
+ ; FileType = erlang_launcher
+ ; FileType = erlang_archive
+ ),
+ ObjectCodeType = non_pic
+ ;
+ FileType = shared_library,
ObjectCodeType = ( if PicObjExt = ObjExt then non_pic else pic )
;
- PIC = no,
- (
- ( FileType = static_library
- ; FileType = csharp_executable
- ; FileType = csharp_library
- ; FileType = java_launcher
- ; FileType = java_archive
- ; FileType = erlang_launcher
- ; FileType = erlang_archive
- ),
- ObjectCodeType = non_pic
- ;
- FileType = shared_library,
- ObjectCodeType = ( if PicObjExt = ObjExt then non_pic else pic )
- ;
- FileType = executable,
- ( MercuryLinkage = "shared" ->
- (
- % We only need to create `.lpic' files if `-DMR_PIC_REG'
- % has an effect, which is currently nowhere.
- ( LinkWithPicObjExt = ObjExt
- ; HighLevelCode = yes
- ; GCCGlobals = no
- ; Target \= target_c
- )
- ->
- ObjectCodeType = non_pic
- ;
- LinkWithPicObjExt = PicObjExt
- ->
- ObjectCodeType = pic
- ;
- ObjectCodeType = link_with_pic
+ FileType = executable,
+ ( MercuryLinkage = "shared" ->
+ (
+ % We only need to create `.lpic' files if `-DMR_PIC_REG'
+ % has an effect, which is currently nowhere.
+ ( LinkWithPicObjExt = ObjExt
+ ; HighLevelCode = yes
+ ; GCCGlobals = no
+ ; Target \= target_c
)
- ; MercuryLinkage = "static" ->
+ ->
ObjectCodeType = non_pic
;
- % The linkage string is checked by options.m.
- unexpected($module, $pred,
- "unknown linkage " ++ MercuryLinkage)
+ LinkWithPicObjExt = PicObjExt
+ ->
+ ObjectCodeType = pic
+ ;
+ ObjectCodeType = link_with_pic
)
+ ; MercuryLinkage = "static" ->
+ ObjectCodeType = non_pic
+ ;
+ % The linkage string is checked by options.m.
+ unexpected($module, $pred,
+ "unknown linkage " ++ MercuryLinkage)
)
).
diff --git a/compiler/const_struct.m b/compiler/const_struct.m
index 61648be..a9def75 100644
--- a/compiler/const_struct.m
+++ b/compiler/const_struct.m
@@ -177,7 +177,6 @@ const_struct_db_init(Globals, Db) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
diff --git a/compiler/foreign.m b/compiler/foreign.m
index d8525e1..3e0f0dd 100644
--- a/compiler/foreign.m
+++ b/compiler/foreign.m
@@ -391,8 +391,6 @@ have_foreign_type_for_backend(target_csharp,
ForeignTypeBody,
( ForeignTypeBody ^ csharp = yes(_) -> yes ; no )).
have_foreign_type_for_backend(target_erlang, ForeignTypeBody,
( ForeignTypeBody ^ erlang = yes(_) -> yes ; no )).
-have_foreign_type_for_backend(target_asm, ForeignTypeBody, Result) :-
- have_foreign_type_for_backend(target_c, ForeignTypeBody, Result).
have_foreign_type_for_backend(target_x86_64, ForeignTypeBody, Result) :-
have_foreign_type_for_backend(target_c, ForeignTypeBody, Result).
@@ -501,17 +499,6 @@ foreign_type_body_to_exported_type(ModuleInfo,
ForeignTypeBody, Name,
unexpected($module, $pred, "no Erlang type")
)
;
- Target = target_asm,
- (
- MaybeC = yes(Data),
- Data = foreign_type_lang_data(c_type(NameStr), MaybeUserEqComp,
- Assertions),
- Name = unqualified(NameStr)
- ;
- MaybeC = no,
- unexpected($module, $pred, "no C type")
- )
- ;
Target = target_x86_64,
(
MaybeC = yes(Data),
diff --git a/compiler/gcc.m b/compiler/gcc.m
deleted file mode 100644
index aedab96..0000000
--- a/compiler/gcc.m
+++ /dev/null
@@ -1,1931 +0,0 @@
-%-----------------------------------------------------------------------------%
-% 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 <http://gcc.gnu.org> and
-% <http://gcc.gnu.org/readings.html>, in particular
-% "Writing a Compiler Front End to GCC" by Joachim Nadler
-% and Tim Josling <tej at melbpc.org.au>.
-%
-% 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 <stdio.h> /* for fprintf() */
-#include <stdlib.h> /* 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);
-").
-
-%-----------------------------------------------------------------------------%
diff --git a/compiler/globals.m b/compiler/globals.m
index d16512f..723942b 100644
--- a/compiler/globals.m
+++ b/compiler/globals.m
@@ -43,10 +43,6 @@
% IL is the Microsoft .NET Intermediate Language.
; target_csharp % Generate C#.
; target_java % Generate Java.
- ; target_asm % Compile directly to assembler via the GCC
- % back-end. Do not go via C, instead generate GCC's
- % internal `tree' data structure.
- % (Work in progress.)
; target_x86_64 % Compile directly to x86_64 assembler.
% (Work in progress.)
; target_erlang. % Generate Erlang.
@@ -371,7 +367,6 @@ convert_target(String, Target) :-
convert_target_2("csharp", target_csharp).
convert_target_2("java", target_java).
-convert_target_2("asm", target_asm).
convert_target_2("il", target_il).
convert_target_2("c", target_c).
convert_target_2("x86_64", target_x86_64).
@@ -561,7 +556,6 @@ compilation_target_string(target_c) = "C".
compilation_target_string(target_csharp) = "C#".
compilation_target_string(target_il) = "IL".
compilation_target_string(target_java) = "Java".
-compilation_target_string(target_asm) = "asm".
compilation_target_string(target_x86_64) = "x86_64".
compilation_target_string(target_erlang) = "Erlang".
@@ -793,10 +787,7 @@ current_grade_supports_concurrency(Globals,
ThreadsSupported) :-
ThreadsSupported = yes
;
% Threads are not yet supported in the x86_64 backend.
- % XXX I'm not sure what their status in the gcc backend is.
- ( Target = target_asm
- ; Target = target_x86_64
- ),
+ Target = target_x86_64,
ThreadsSupported = no
).
diff --git a/compiler/granularity.m b/compiler/granularity.m
index dd33ad7..499beb0 100644
--- a/compiler/granularity.m
+++ b/compiler/granularity.m
@@ -148,7 +148,6 @@ runtime_granularity_test_in_goal(Goal0, Goal,
!Changed, SCC, ModuleInfo) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index 5826f6c..eb75a3d 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -841,7 +841,6 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
( Target = target_c
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
@@ -933,7 +932,6 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
;
( Target = target_c
; Target = target_il
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
@@ -985,37 +983,16 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
;
( Target = target_c
; Target = target_il
- ; Target = target_asm
; Target = target_x86_64
; Target = target_java
; Target = target_csharp
)
),
- % Generating assembler via the gcc back-end requires
- % using high-level code.
- (
- Target = target_asm,
- globals.set_option(highlevel_code, bool(yes), !Globals),
- globals.set_option(highlevel_data, bool(no), !Globals)
- ;
- ( Target = target_c
- ; Target = target_il
- ; Target = target_csharp
- ; Target = target_java
- ; Target = target_x86_64
- ; Target = target_erlang
- )
- ),
-
- % Generating high-level C or asm code requires putting each commit
+ % Generating high-level C code requires putting each commit
% in its own function, to avoid problems with setjmp() and
% non-volatile local variables.
- (
- ( Target = target_c
- ; Target = target_asm
- )
- ->
+ ( Target = target_c ->
option_implies(highlevel_code, put_commit_in_own_func, bool(yes),
!Globals)
;
@@ -1027,8 +1004,7 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
Target = target_x86_64,
globals.set_option(use_local_vars, bool(no), !Globals)
;
- ( Target = target_asm
- ; Target = target_c
+ ( Target = target_c
; Target = target_il
; Target = target_csharp
; Target = target_java
@@ -1044,15 +1020,11 @@ convert_options_to_globals(OptionTable0,
Target, GC_Method, TagsMethod0,
%
% Shared libraries always use `--linkage shared'.
- option_implies(compile_to_shared_lib, pic, bool(yes), !Globals),
option_implies(compile_to_shared_lib, linkage, string("shared"),
!Globals),
option_implies(compile_to_shared_lib, mercury_linkage,
string("shared"), !Globals),
- % On x86, using PIC takes a register away from us.
- option_implies(pic, pic_reg, bool(yes), !Globals),
-
% --high-level-code disables the use of low-level gcc extensions
option_implies(highlevel_code, gcc_non_local_gotos, bool(no),
!Globals),
@@ -1420,7 +1392,6 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
( Target = target_csharp
; Target = target_java
; Target = target_x86_64
- ; Target = target_asm
; Target = target_il
; Target = target_erlang
),
@@ -1452,7 +1423,6 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
)
;
( Target = target_x86_64
- ; Target = target_asm
; Target = target_il
; Target = target_erlang
),
@@ -1593,7 +1563,6 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
( Target = target_c
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
@@ -2270,10 +2239,6 @@ convert_options_to_globals(OptionTable0,
Target, GC_Method, TagsMethod0,
Target = target_csharp,
BackendForeignLanguages = ["csharp"]
;
- Target = target_asm,
- % XXX This is wrong! It should be asm.
- BackendForeignLanguages = ["c"]
- ;
Target = target_java,
BackendForeignLanguages = ["java"]
;
@@ -2318,9 +2283,7 @@ convert_options_to_globals(OptionTable0, Target,
GC_Method, TagsMethod0,
(
% In the non-C backends, it may not be possible to cast a value
% of a non-enum du type to an integer.
- ( Target = target_c
- ; Target = target_asm
- ),
+ Target = target_c,
% To ensure that all constants in general du types are
% allocated in one word, make_tags.m need to have at least one
diff --git a/compiler/hlds_code_util.m b/compiler/hlds_code_util.m
index 9fc4e9a..a4ea923 100644
--- a/compiler/hlds_code_util.m
+++ b/compiler/hlds_code_util.m
@@ -151,7 +151,6 @@ cons_id_to_tag(ModuleInfo, ConsId) = Tag:-
globals.get_target(Globals, TargetLang),
(
( TargetLang = target_c
- ; TargetLang = target_asm
; TargetLang = target_x86_64
; TargetLang = target_erlang
),
diff --git a/compiler/intermod.m b/compiler/intermod.m
index 15eb36e..5118f22 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -1118,7 +1118,6 @@
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
(
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -1137,7 +1136,6 @@
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
MaybeIL0, MaybeIL, !Info)
;
( Target = target_c
- ; Target = target_asm
; Target = target_csharp
; Target = target_java
; Target = target_x86_64
@@ -1151,7 +1149,6 @@
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
MaybeCSharp0, MaybeCSharp, !Info)
;
( Target = target_c
- ; Target = target_asm
; Target = target_il
; Target = target_java
; Target = target_x86_64
@@ -1165,7 +1162,6 @@
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
MaybeJava0, MaybeJava, !Info)
;
( Target = target_c
- ; Target = target_asm
; Target = target_il
; Target = target_csharp
; Target = target_x86_64
@@ -1179,7 +1175,6 @@
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
MaybeErlang0, MaybeErlang, !Info)
;
( Target = target_c
- ; Target = target_asm
; Target = target_il
; Target = target_csharp
; Target = target_x86_64
diff --git a/compiler/lambda.m b/compiler/lambda.m
index a19e2b1..f35a67f 100644
--- a/compiler/lambda.m
+++ b/compiler/lambda.m
@@ -518,7 +518,6 @@ expand_lambda(Purity, _Groundness, PredOrFunc,
EvalMethod, RegWrapperProc,
; Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
),
(
diff --git a/compiler/make.dependencies.m b/compiler/make.dependencies.m
index c1452e4..c481ea7 100644
--- a/compiler/make.dependencies.m
+++ b/compiler/make.dependencies.m
@@ -441,8 +441,6 @@ target_dependencies(_, module_target_erlang_beam_code) =
module_target_erlang_header `of` indirect_imports,
module_target_erlang_header `of` intermod_imports
]).
-target_dependencies(Globals, module_target_asm_code(_)) =
- compiled_code_dependencies(Globals).
target_dependencies(Globals, module_target_object_code(PIC)) = Deps :-
globals.get_target(Globals, CompilationTarget),
TargetCode = target_to_module_target_code(CompilationTarget, PIC),
@@ -522,20 +520,10 @@ get_foreign_deps(Globals, PIC) = Deps :-
:- func target_to_module_target_code(compilation_target, pic)
= module_target_type.
-target_to_module_target_code(CompilationTarget, PIC) = TargetCode :-
- (
- CompilationTarget = target_asm,
- TargetCode = module_target_asm_code(PIC)
- ;
- ( CompilationTarget = target_c
- ; CompilationTarget = target_il
- ; CompilationTarget = target_csharp
- ; CompilationTarget = target_java
- ; CompilationTarget = target_x86_64
- ; CompilationTarget = target_erlang
- ),
- TargetCode = module_target_c_code
- ).
+target_to_module_target_code(_CompilationTarget, _PIC) = TargetCode :-
+ % XXX it looks wrong to be returning module_target_c_code for
+ % all compilation targets.
+ TargetCode = module_target_c_code.
:- func interface_file_dependencies =
(find_module_deps(dependency_file_index)::out(find_module_deps)) is det.
diff --git a/compiler/make.m b/compiler/make.m
index ec28ea6..2c1c649 100644
--- a/compiler/make.m
+++ b/compiler/make.m
@@ -232,7 +232,6 @@
; module_target_erlang_header
; module_target_erlang_code
; module_target_erlang_beam_code
- ; module_target_asm_code(pic)
; module_target_object_code(pic)
; module_target_foreign_il_asm(foreign_language)
; module_target_foreign_object(pic, foreign_language)
@@ -567,7 +566,6 @@ get_executable_type(Globals) = ExecutableType :-
(
( CompilationTarget = target_c
; CompilationTarget = target_il
- ; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
),
ExecutableType = executable
diff --git a/compiler/make.module_target.m b/compiler/make.module_target.m
index eef8ac1..6ee247a 100644
--- a/compiler/make.module_target.m
+++ b/compiler/make.module_target.m
@@ -459,15 +459,13 @@ build_target_2(ModuleName, Task, ArgFileName,
Imports, Globals, AllOptionArgs,
Verbose = no
),
- % Run compilations to target code in a separate process. This is
- % necessary for `--target asm' because the GCC backend can only be
- % invoked once per process. It's a good idea for other the backends
- % because it avoids problems with the Boehm GC retaining memory by
- % scanning too much of the Mercury stacks. If the compilation is run in
- % a separate process, it is also easier to kill if an interrupt
- % arrives. We do the same for intermodule-optimization interfaces
- % because if type checking gets overloaded by ambiguities it can be
- % difficult to kill the compiler otherwise.
+ % Run compilations to target code in a separate process. This avoids
+ % problems with the Boehm GC retaining memory by scanning too much of
+ % the Mercury stacks. If the compilation is run in a separate process,
+ % it is also easier to kill if an interrupt arrives. We do the same for
+ % intermodule-optimization interfaces because if type checking gets
+ % overloaded by ambiguities it can be difficult to kill the compiler
+ % otherwise.
io.set_output_stream(ErrorStream, OldOutputStream, !IO),
IsForkable = forkable_module_compilation_task_type(ModuleTask),
(
@@ -538,9 +536,6 @@ build_object_code(Globals, ModuleName, Target,
PIC, ErrorStream, Imports,
Target = target_c,
compile_c_file(ErrorStream, PIC, ModuleName, Globals, Succeeded, !IO)
;
- Target = target_asm,
- assemble(ErrorStream, PIC, ModuleName, Globals, Succeeded, !IO)
- ;
Target = target_java,
module_name_to_file_name(Globals, ModuleName, ".java", do_create_dirs,
JavaFile, !IO),
@@ -645,9 +640,6 @@ get_object_extension(Globals, PIC) = Ext :-
CompilationTarget = target_c,
maybe_pic_object_file_extension(Globals, PIC, Ext)
;
- CompilationTarget = target_asm,
- maybe_pic_object_file_extension(Globals, PIC, Ext)
- ;
CompilationTarget = target_il,
Ext = ".dll"
;
@@ -865,9 +857,6 @@ compilation_task(_, module_target_erlang_code) =
process_module(task_compile_to_target_code) - ["--erlang-only"].
compilation_task(_, module_target_erlang_beam_code) =
target_code_to_object_code(non_pic) - [].
-compilation_task(_, module_target_asm_code(PIC)) =
- process_module(task_compile_to_target_code) -
- ( PIC = pic -> ["--pic"] ; [] ).
compilation_task(_, module_target_object_code(PIC)) =
target_code_to_object_code(PIC) - get_pic_flags(PIC).
compilation_task(_, module_target_foreign_il_asm(Lang)) =
@@ -961,16 +950,7 @@ touched_files_process_module(Globals, TargetFile,
Task, TouchedTargetFiles,
),
globals.get_target(Globals, CompilationTarget),
- (
- Task = task_compile_to_target_code,
- CompilationTarget = target_asm
- ->
- % For `--target asm' the code for the nested children is placed
- % in the `.s' file for the top-level module in the source file.
- TargetModuleNames = [ModuleName]
- ;
- TargetModuleNames = SourceFileModuleNames
- ),
+ TargetModuleNames = SourceFileModuleNames,
% Find out what header files are generated.
(
@@ -996,18 +976,6 @@ touched_files_process_module(Globals, TargetFile,
Task, TouchedTargetFiles,
HeaderTargets0 = []
)
;
- CompilationTarget = target_asm,
- % When compiling to assembler, we only generate a header file
- % if the module contains foreign code.
- HeaderModuleNames =
- list.filter_map(
- (func(MImports) = MImports ^ mai_module_name is semidet :-
- contains_foreign_code(_) =
- MImports ^ mai_has_foreign_code
- ), ModuleImportsList),
- HeaderTargets0 = make_target_file_list(HeaderModuleNames,
- module_target_c_header(header_mih))
- ;
( CompilationTarget = target_il
; CompilationTarget = target_csharp
; CompilationTarget = target_java
@@ -1025,9 +993,7 @@ touched_files_process_module(Globals, TargetFile,
Task, TouchedTargetFiles,
),
(
- ( CompilationTarget = target_c
- ; CompilationTarget = target_asm
- ),
+ CompilationTarget = target_c,
Names = SourceFileModuleNames,
HeaderTargets =
make_target_file_list(Names, module_target_c_header(header_mh))
@@ -1089,18 +1055,6 @@ external_foreign_code_files(Globals, PIC,
Imports, ForeignFiles, !IO) :-
globals.get_target(Globals, CompilationTarget),
ModuleName = Imports ^ mai_module_name,
(
- CompilationTarget = target_asm,
- Imports ^ mai_has_foreign_code = contains_foreign_code(Langs),
- set.member(lang_c, Langs)
- ->
- module_name_to_file_name(Globals,
- foreign_language_module_name(ModuleName, lang_c),
- ".c", do_not_create_dirs, CCodeFileName, !IO),
- module_name_to_file_name(Globals,
- foreign_language_module_name(ModuleName, lang_c),
- ObjExt, do_not_create_dirs, ObjFileName, !IO),
- ForeignFiles0 = [foreign_code_file(lang_c, CCodeFileName, ObjFileName)]
- ;
CompilationTarget = target_il,
Imports ^ mai_has_foreign_code = contains_foreign_code(Langs)
->
@@ -1113,9 +1067,7 @@ external_foreign_code_files(Globals, PIC,
Imports, ForeignFiles, !IO) :-
% Find externally compiled foreign code files for fact tables.
(
- ( CompilationTarget = target_c
- ; CompilationTarget = target_asm
- ),
+ CompilationTarget = target_c,
list.map_foldl(
(pred(FactTableFile::in, FactTableForeignFile::out, di, uo)
is det -->
@@ -1162,9 +1114,7 @@ external_foreign_code_files_for_il(Globals,
ModuleName, Language, ForeignFiles,
target_type_to_pic(TargetType) = Result :-
(
- ( TargetType = module_target_asm_code(PIC)
- ; TargetType = module_target_object_code(PIC)
- ),
+ TargetType = module_target_object_code(PIC),
Result = PIC
;
( TargetType = module_target_source
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index 27dc573..03c32b3 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -165,10 +165,6 @@ make_linked_target_2(LinkedTargetFile, Globals,
_, Succeeded, !Info, !IO) :-
IntermediateTargetType = module_target_c_code,
ObjectTargetType = module_target_object_code(PIC)
;
- CompilationTarget = target_asm,
- IntermediateTargetType = module_target_asm_code(PIC),
- ObjectTargetType = module_target_object_code(PIC)
- ;
CompilationTarget = target_il,
IntermediateTargetType = module_target_il_code,
ObjectTargetType = module_target_il_asm
@@ -284,18 +280,8 @@ make_linked_target_2(LinkedTargetFile, Globals,
_, Succeeded, !Info, !IO) :-
get_target_modules(Globals, TargetType, AllModules, TargetModules,
!Info, !IO) :-
- globals.get_target(Globals, CompilationTarget),
- (
- (
- TargetType = module_target_errors
- ;
- CompilationTarget = target_asm,
- ( TargetType = module_target_asm_code(_)
- ; TargetType = module_target_object_code(_)
- )
- )
- ->
- % `.err' and `.s' files are only produced for the top-level module
+ ( TargetType = module_target_errors ->
+ % `.err' files are only produced for the top-level module
% in each source file.
list.foldl3(get_target_modules_2(Globals), AllModules,
[], TargetModules, !Info, !IO)
@@ -386,14 +372,6 @@ get_foreign_object_targets(Globals, PIC,
ModuleName, ObjectTargets,
unexpected($module, $pred, "unknown imports")
),
(
- CompilationTarget = target_asm,
- Imports ^ mai_has_foreign_code = contains_foreign_code(Langs),
- set.member(lang_c, Langs)
- ->
- ForeignObjectFileType = module_target_foreign_object(PIC, lang_c),
- ForeignObjectTarget = target_file(ModuleName, ForeignObjectFileType),
- ForeignObjectTargets = [dep_target(ForeignObjectTarget)]
- ;
CompilationTarget = target_il,
Imports ^ mai_has_foreign_code = contains_foreign_code(Langs)
->
@@ -408,9 +386,7 @@ get_foreign_object_targets(Globals, PIC,
ModuleName, ObjectTargets,
% Find out if any externally compiled foreign code files for fact tables
% exist.
(
- ( CompilationTarget = target_c
- ; CompilationTarget = target_asm
- ),
+ CompilationTarget = target_c,
FactObjectTargets = list.map(
(func(FactFile) =
dep_target(target_file(ModuleName,
@@ -609,7 +585,6 @@ build_linked_target_2(Globals, MainModuleName,
FileType, OutputFileName,
(
( CompilationTarget = target_c
- ; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
),
maybe_pic_object_file_extension(NoLinkObjsGlobals, PIC,
@@ -641,7 +616,6 @@ build_linked_target_2(Globals, MainModuleName,
FileType, OutputFileName,
AllObjects = InitObjects ++ ObjList ++ ForeignObjects ++ LinkObjects,
(
( CompilationTarget = target_c
- ; CompilationTarget = target_asm
; CompilationTarget = target_erlang
; CompilationTarget = target_java
; CompilationTarget = target_csharp
@@ -1238,9 +1212,7 @@
reset_analysis_registry_dependency_status(ModuleName, !Info) :-
build_library(MainModuleName, AllModules, Globals, Succeeded, !Info, !IO) :-
globals.get_target(Globals, Target),
(
- ( Target = target_c
- ; Target = target_asm
- ),
+ Target = target_c,
build_c_library(Globals, MainModuleName, AllModules, Succeeded,
!Info, !IO)
;
@@ -1414,9 +1386,7 @@ install_ints_and_headers(Globals,
SubdirLinkSucceeded, ModuleName, Succeeded,
% otherwise there is trouble using libraries installed by
% `mmc --make' with Mmake.
% XXX If we ever phase out mmake we could revert this behaviour.
- ( Target = target_c
- ; Target = target_asm
- ),
+ Target = target_c,
% XXX Should we test
% Imports ^ contains_foreign_export = contains_foreign_export?
module_name_to_file_name(Globals, ModuleName, ".mh",
@@ -1666,20 +1636,15 @@ install_grade_ints_and_headers(Globals,
LinkSucceeded, GradeDir, ModuleName,
Succeeded, !Info, !IO) :-
get_module_dependencies(Globals, ModuleName, MaybeImports, !Info, !IO),
(
- MaybeImports = yes(Imports),
+ MaybeImports = yes(_Imports),
globals.lookup_string_option(Globals, install_prefix, Prefix),
LibDir = Prefix/"lib"/"mercury",
globals.get_target(Globals, Target),
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
(
- (
- Target = target_c,
- HighLevelCode = yes
- ;
- Target = target_asm,
- Imports ^ mai_has_foreign_code = contains_foreign_code(_)
- )
+ Target = target_c,
+ HighLevelCode = yes
->
GradeIncDir = LibDir/"lib"/GradeDir/"inc",
install_subdir_file(Globals, LinkSucceeded, GradeIncDir,
@@ -2071,8 +2036,6 @@ make_module_clean(Globals, ModuleName, !Info, !IO) :-
make_remove_target_file_by_name(Globals, very_verbose, ModuleName,
module_target_object_code(PIC), !Info, !IO),
make_remove_target_file_by_name(Globals, very_verbose, ModuleName,
- module_target_asm_code(PIC), !Info, !IO),
- make_remove_target_file_by_name(Globals, very_verbose, ModuleName,
module_target_foreign_object(PIC, lang_c), !Info, !IO),
list.foldl2(
(pred(FactTableFile::in, !.Info::in, !:Info::out,
diff --git a/compiler/make.util.m b/compiler/make.util.m
index ccd6c78..1fbf8db 100644
--- a/compiler/make.util.m
+++ b/compiler/make.util.m
@@ -1473,9 +1473,6 @@ target_extension(_,
module_target_java_class_code) = yes(".class").
target_extension(_, module_target_erlang_header) = yes(".hrl").
target_extension(_, module_target_erlang_code) = yes(".erl").
target_extension(_, module_target_erlang_beam_code) = yes(".beam").
-target_extension(_, module_target_asm_code(non_pic)) = yes(".s").
-target_extension(_, module_target_asm_code(link_with_pic)) = yes(".s").
-target_extension(_, module_target_asm_code(pic)) = yes(".pic_s").
target_extension(Globals, module_target_object_code(PIC)) = yes(Ext) :-
maybe_pic_object_file_extension(Globals, PIC, Ext).
target_extension(_, module_target_xml_doc) = yes(".xml").
@@ -1598,7 +1595,6 @@ module_target_to_file_name_maybe_search(Globals,
ModuleName, TargetType,
FileName, !IO)
;
( TargetType = module_target_analysis_registry
- ; TargetType = module_target_asm_code(_)
; TargetType = make.module_target_c_code
; TargetType = module_target_c_header(_)
; TargetType = module_target_erlang_beam_code
@@ -1645,30 +1641,13 @@ timestamp_extension(_,
module_target_intermodule_interface) = ".optdate".
timestamp_extension(_, module_target_analysis_registry) = ".analysis_date".
timestamp_extension(_, module_target_c_code) = ".c_date".
timestamp_extension(Globals, module_target_c_header(_)) = Ext :-
- globals.get_target(Globals, Target),
- (
- Target = target_asm,
- ModuleTargetType = module_target_asm_code(non_pic)
- ;
- % XXX Some of these alternatives don't look right.
- ( Target = target_c
- ; Target = target_x86_64
- ; Target = target_il
- ; Target = target_csharp
- ; Target = target_java
- ; Target = target_erlang
- ),
- ModuleTargetType = module_target_c_code
- ),
- Ext = timestamp_extension(Globals, ModuleTargetType).
+ Ext = timestamp_extension(Globals, module_target_c_code).
timestamp_extension(_, module_target_il_code) = ".il_date".
timestamp_extension(_, module_target_csharp_code) = ".cs_date".
timestamp_extension(_, module_target_java_code) = ".java_date".
timestamp_extension(_, module_target_erlang_code) = ".erl_date".
timestamp_extension(Globals, module_target_erlang_header) =
timestamp_extension(Globals, module_target_erlang_code).
-timestamp_extension(_, module_target_asm_code(non_pic)) = ".s_date".
-timestamp_extension(_, module_target_asm_code(pic)) = ".pic_s_date".
:- func search_for_file_type(module_target_type) = maybe(option).
@@ -1697,7 +1676,6 @@ search_for_file_type(module_target_erlang_header) =
yes(erlang_include_directory).
search_for_file_type(module_target_erlang_code) = no.
search_for_file_type(module_target_erlang_beam_code) = no.
-search_for_file_type(module_target_asm_code(_)) = no.
search_for_file_type(module_target_object_code(_)) = no.
search_for_file_type(module_target_foreign_object(_, _)) = no.
search_for_file_type(module_target_foreign_il_asm(_)) = no.
@@ -1735,7 +1713,6 @@ is_target_grade_or_arch_dependent(Target) = IsDependent :-
; Target = module_target_erlang_code
; Target = module_target_erlang_beam_code
; Target = module_target_erlang_header
- ; Target = module_target_asm_code(_)
; Target = module_target_object_code(_)
; Target = module_target_foreign_object(_, _)
; Target = module_target_foreign_il_asm(_)
@@ -2000,32 +1977,29 @@ module_target_type_to_nonce(Type) = X :-
Type = module_target_erlang_beam_code,
X = 17
;
- Type = module_target_asm_code(_PIC),
- X = 18
- ;
Type = module_target_object_code(PIC),
- X = 19 `mix` pic_to_nonce(PIC)
+ X = 18 `mix` pic_to_nonce(PIC)
;
Type = module_target_foreign_il_asm(_ForeignLang),
- X = 20
+ X = 19
;
Type = module_target_foreign_object(_PIC, _ForeignLang),
- X = 21
+ X = 20
;
Type = module_target_fact_table_object(_PIC, _FileName),
- X = 22
+ X = 21
;
Type = module_target_xml_doc,
- X = 23
+ X = 22
;
Type = module_target_track_flags,
- X = 24
+ X = 23
;
Type = module_target_java_class_code,
- X = 25
+ X = 24
;
Type = module_target_csharp_code,
- X = 26
+ X = 25
).
:- func pic_to_nonce(pic) = int.
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index 528b854..296b5ac 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -312,7 +312,6 @@ use_double_word_floats(Globals, DoubleWordFloats) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -795,7 +794,6 @@ add_pass_1_mutable(Item, Status, !ModuleInfo, !Specs) :-
WantUnsafeAccessDecls = no
;
( CompilationTarget = target_il
- ; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
),
% Not supported yet.
@@ -1175,7 +1173,6 @@ add_pass_2_mutable(ItemMutable, Status,
!ModuleInfo, !Specs) :-
)
;
( CompilationTarget = target_il
- ; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
),
Pieces = [words("Error: foreign_name mutable attribute not yet"),
@@ -1609,8 +1606,7 @@ add_pass_3_initialise(ItemInitialise, Status,
!ModuleInfo, !QualInfo,
MaybeExportLang = yes(lang_erlang)
;
% Untested.
- ( CompilationTarget = target_asm
- ; CompilationTarget = target_il
+ ( CompilationTarget = target_il
; CompilationTarget = target_x86_64
),
MaybeExportLang = no
@@ -1766,7 +1762,6 @@ add_pass_3_finalise(ItemFinalise, Status,
!ModuleInfo, !QualInfo, !Specs) :-
target_lang_to_foreign_export_lang(CompilationTarget) = ExportLang :-
(
( CompilationTarget = target_c
- ; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
),
ExportLang = lang_c
@@ -1859,7 +1854,6 @@ add_pass_3_mutable(ItemMutable, Status,
!ModuleInfo, !QualInfo, !Specs) :-
Status, _, !ModuleInfo, !QualInfo, !Specs)
;
( CompilationTarget = target_il
- ; CompilationTarget = target_asm
; CompilationTarget = target_x86_64
)
% Not supported yet.
diff --git a/compiler/make_tags.m b/compiler/make_tags.m
index 24f3e43..64884bb 100644
--- a/compiler/make_tags.m
+++ b/compiler/make_tags.m
@@ -459,7 +459,6 @@ post_process_type_defns(!HLDS, Specs) :-
; Target = target_csharp
; Target = target_java
; Target = target_erlang
- ; Target = target_asm
; Target = target_x86_64
),
% Direct arg functors have not (yet) been implemented on these targets.
diff --git a/compiler/maybe_mlds_to_gcc.pp b/compiler/maybe_mlds_to_gcc.pp
deleted file mode 100644
index c64a4ce..0000000
--- a/compiler/maybe_mlds_to_gcc.pp
+++ /dev/null
@@ -1,74 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ts=4 sw=4 et ft=mercury
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2001, 2003-2006, 2008-2009 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.
-%-----------------------------------------------------------------------------%
-
-% maybe_mlds_to_gcc - Convert MLDS to the GCC back-end representation,
-% if the GCC back-end interface has been enabled.
-% Main author: fjh.
-
-% This is just a wrapper around mlds_to_gcc.m to enable that
-% file to be included iff we were configured with the
-% gcc back-end interface enabled.
-
-%-----------------------------------------------------------------------------%
-
-:- module ml_backend.maybe_mlds_to_gcc.
-:- interface.
-
-:- import_module ml_backend.mlds.
-
-:- import_module bool.
-:- import_module io.
-
-:- type frontend_callback(T) == pred(T, io.state, io.state).
-:- inst frontend_callback == (pred(out, di, uo) is det).
-
- % Invoke the callback either via gcc.run_backend, or directly,
- % depending on whether the gcc back-end interface has been enabled.
- %
-:- pred maybe_run_gcc_backend(mercury_module_name::in,
- frontend_callback(T)::in(frontend_callback), T::out,
- io::di, io::uo) is det.
-
- % Either invoke mlds_to_gcc.compile_to_asm, or report an error message,
- % depending on whether the gcc back-end interface has been enabled.
- % In the former case, the bool returned is `yes' iff the module
- % contained C code.
- %
-:- pred maybe_compile_to_asm(mlds::in, bool::out, io::di, io::uo) is det.
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-#if ENABLE_GCC_BACK_END
-
-:- use_module mlds_to_gcc.
-
-maybe_run_gcc_backend(ModuleName, CallBack, CallBackOutput, !IO) :-
- mlds_to_gcc.run_gcc_backend(ModuleName, CallBack, CallBackOutput, !IO).
-
-maybe_compile_to_asm(MLDS, ContainsCCode, !IO) :-
- mlds_to_gcc.compile_to_asm(MLDS, ContainsCCode, !IO).
-
-#else
-
-:- import_module libs.file_util.
-:- import_module string.
-
-maybe_run_gcc_backend(_ModuleName, CallBack, CallBackOutput, !IO) :-
- CallBack(CallBackOutput, !IO).
-
-maybe_compile_to_asm(_MLDS, no, !IO) :-
- report_error(
-"Sorry, `--target asm' not supported: this installation of the Mercury\n" ++
-"compiler was built without support for the GCC back-end interface.",
- !IO).
-
-#endif
-
-%-----------------------------------------------------------------------------%
diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m
index 2127f08..71820b4 100644
--- a/compiler/mercury_compile.m
+++ b/compiler/mercury_compile.m
@@ -58,7 +58,6 @@
:- import_module make.util.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.shared_utilities.
-:- import_module ml_backend.maybe_mlds_to_gcc.
:- import_module parse_tree.equiv_type.
:- import_module parse_tree.error_util.
:- import_module parse_tree.file_names.
@@ -437,7 +436,6 @@ main_after_setup(OptionVariables, OptionArgs,
Args, Link, Globals, !IO) :-
io.set_exit_status(1, !IO)
;
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64
),
make_standalone_interface(Globals, StandaloneIntBasename, !IO)
@@ -469,7 +467,6 @@ main_after_setup(OptionVariables, OptionArgs,
Args, Link, Globals, !IO) :-
( Target = target_c
; Target = target_csharp
; Target = target_il
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -534,161 +531,8 @@ maybe_report_cmd_line(Report, OptionArgs, Args, !IO) :-
process_all_args(Globals, OptionVariables, OptionArgs, Args,
ModulesToLink, ExtraObjFiles, !IO) :-
- % Because of limitations in the GCC back-end, we can only call the
- % GCC back-end once (per process), to generate a single assembler file,
- % rather than calling it multiple times to generate individual assembler
- % files for each module. So if we're generating code using the GCC
- % back-end, we need to call maybe_run_gcc_backend here at the top level.
- ( compiling_to_asm(Globals) ->
- (
- Args = [FirstArg | LaterArgs],
- globals.lookup_bool_option(Globals, smart_recompilation, Smart),
- io_get_disable_smart_recompilation(DisableSmart, !IO),
- (
- Smart = yes,
- DisableSmart = no
- ->
- (
- LaterArgs = [],
- % With smart recompilation we need to delay starting
- % the gcc backend to avoid overwriting the output assembler
- % file even if recompilation is found to be unnecessary.
- process_args(Globals, OptionVariables, OptionArgs, Args,
- ModulesToLink, ExtraObjFiles, !IO)
- ;
- LaterArgs = [_ | _],
- Msg = "Sorry, not implemented: " ++
- "`--target asm' with `--smart-recompilation' " ++
- "with more than one module to compile.",
- write_error_pieces_plain(Globals, [words(Msg)], !IO),
- io.set_exit_status(1, !IO),
- ModulesToLink = [],
- ExtraObjFiles = [],
- io_set_disable_smart_recompilation(yes, !IO)
- )
- ;
- compile_using_gcc_backend(Globals,
- OptionVariables, OptionArgs,
- string_to_file_or_module(FirstArg),
- process_args_callback(OptionVariables, OptionArgs, Args,
- Globals),
- ModulesToLink, ExtraObjFiles, !IO)
- )
- ;
- Args = [],
- Msg = "Sorry, not implemented: `--target asm' " ++
- "with `--filenames-from-stdin",
- write_error_pieces_plain(Globals, [words(Msg)], !IO),
- io.set_exit_status(1, !IO),
- ModulesToLink = [],
- ExtraObjFiles = []
- )
- ;
- % If we're NOT using the GCC back-end, then we can just call
- % process_args directly, rather than via GCC.
- process_args(Globals, OptionVariables, OptionArgs, Args,
- ModulesToLink, ExtraObjFiles, !IO)
- ).
-
-:- pred compiling_to_asm(globals::in) is semidet.
-
-compiling_to_asm(Globals) :-
- globals.get_target(Globals, target_asm),
- % even if --target asm is specified,
- % it can be overridden by other options:
- OptionList = [convert_to_mercury, generate_dependencies,
- generate_dependency_file, make_interface,
- make_short_interface, make_private_interface,
- make_optimization_interface, make_transitive_opt_interface,
- make_analysis_registry,
- typecheck_only, errorcheck_only],
- BoolList = list.map((func(Opt) = Bool :-
- globals.lookup_bool_option(Globals, Opt, Bool)),
- OptionList),
- bool.or_list(BoolList) = no.
-
-:- pred compile_using_gcc_backend(globals::in, options_variables::in,
- list(string)::in, file_or_module::in,
- frontend_callback({list(string), list(string)})
- ::in(frontend_callback),
- list(string)::out, list(string)::out, io::di, io::uo) is det.
-
-compile_using_gcc_backend(Globals, OptionVariables, OptionArgs,
- FirstFileOrModule, CallBack, ModulesToLink, ExtraObjFiles, !IO) :-
- % The name of the assembler file that we generate is based on name
- % of the first module named on the command line. (Mmake requires this.)
- %
- % There are two cases:
- %
- % (1) If the argument ends in ".m", we assume that the argument is a file
- % name. To find the corresponding module name, we would need to read in
- % the file (at least up to the first item); this is needed to handle
- % the case where the module name does not match the file name, e.g.
- % file "browse.m" containing ":- module mdb.browse." as its first item.
- % Rather than reading in the source file here, we just pick a name
- % for the asm file based on the file name argument, (e.g. "browse.s")
- % and if necessary rename it later (e.g. to "mdb.browse.s").
- %
- % (2) If the argument doesn't end in `.m', then we assume it is
- % a module name. (Is it worth checking that the name doesn't contain
- % directory separators, and issuing a warning or error in that case?)
-
- (
- FirstFileOrModule = fm_file(FirstFileName),
- file_name_to_module_name(FirstFileName, FirstModuleName)
- ;
- FirstFileOrModule = fm_module(FirstModuleName)
- ),
-
- % Invoke maybe_run_gcc_backend. It will call us back, and then we will
- % continue with the normal work of the compilation, which will be done
- % by the % callback function (`process_args').
- %
- % The CallBack closure should have the current Globals as one of the
- % presupplied arguments. We cannot easily supply it here, since the
- % type_info for the type variable T in CallBack's type needs to be passed
- % first.
- maybe_run_gcc_backend(FirstModuleName, CallBack,
- {ModulesToLink, ExtraObjFiles}, !IO),
-
- % Now we know what the real module name was, so we can rename
- % the assembler file if needed (see above).
- (
- ModulesToLink = [Module | _],
- file_name_to_module_name(Module, ModuleName),
- globals.lookup_bool_option(Globals, pic, Pic),
- AsmExt = (Pic = yes -> ".pic_s" ; ".s"),
- module_name_to_file_name(Globals, ModuleName, AsmExt,
- do_create_dirs, AsmFile, !IO),
- ( ModuleName \= FirstModuleName ->
- module_name_to_file_name(Globals, FirstModuleName, AsmExt,
- do_not_create_dirs, FirstAsmFile, !IO),
- do_rename_file(Globals, FirstAsmFile, AsmFile, Result, !IO)
- ;
- Result = ok
- ),
-
- % Invoke the assembler to produce an object file, if needed.
- globals.lookup_bool_option(Globals, target_code_only, TargetCodeOnly),
- (
- Result = ok,
- TargetCodeOnly = no
- ->
- io.output_stream(OutputStream, !IO),
- get_linked_target_type(Globals, TargetType),
- get_object_code_type(Globals, TargetType, PIC),
- compile_with_module_options(Globals, ModuleName, OptionVariables,
- OptionArgs, assemble(OutputStream, PIC, ModuleName),
- AssembleOK, !IO),
- maybe_set_exit_status(AssembleOK, !IO)
- ;
- true
- )
- ;
- ModulesToLink = []
- % This can happen if smart recompilation decided
- % that nothing needed to be compiled.
- ).
+ process_args(Globals, OptionVariables, OptionArgs, Args, ModulesToLink,
+ ExtraObjFiles, !IO).
:- pred do_rename_file(globals::in, string::in, string::in, io.res::out,
io::di, io::uo) is det.
@@ -860,7 +704,7 @@ process_arg(Globals, OptionVariables, OptionArgs, Arg,
build_with_module_options_args(Globals,
file_or_module_to_module_name(FileOrModule),
OptionVariables, OptionArgs, [],
- process_arg_build(FileOrModule, OptionVariables, OptionArgs),
+ process_arg_build(FileOrModule, OptionArgs),
_, [], MaybeTuple, !IO),
(
MaybeTuple = yes(Tuple),
@@ -873,26 +717,26 @@ process_arg(Globals, OptionVariables, OptionArgs, Arg,
;
InvokedByMake = yes,
% `mmc --make' has already set up the options.
- process_arg_2(Globals, OptionVariables, OptionArgs, FileOrModule,
- ModulesToLink, ExtraObjFiles, !IO)
+ process_arg_2(Globals, OptionArgs, FileOrModule, ModulesToLink,
+ ExtraObjFiles, !IO)
).
-:- pred process_arg_build(file_or_module::in, options_variables::in,
+:- pred process_arg_build(file_or_module::in,
list(string)::in, globals::in, list(string)::in, bool::out,
list(string)::in, {list(string), list(string)}::out,
io::di, io::uo) is det.
-process_arg_build(FileOrModule, OptionVariables, OptionArgs, Globals, _, yes,
- _, {Modules, ExtraObjFiles}, !IO) :-
- process_arg_2(Globals, OptionVariables, OptionArgs, FileOrModule,
- Modules, ExtraObjFiles, !IO).
+process_arg_build(FileOrModule, OptionArgs, Globals, _, yes, _,
+ {Modules, ExtraObjFiles}, !IO) :-
+ process_arg_2(Globals, OptionArgs, FileOrModule, Modules, ExtraObjFiles,
+ !IO).
-:- pred process_arg_2(globals::in, options_variables::in, list(string)::in,
+:- pred process_arg_2(globals::in, list(string)::in,
file_or_module::in, list(string)::out, list(string)::out,
io::di, io::uo) is det.
-process_arg_2(Globals, OptionVariables, OptionArgs, FileOrModule,
- ModulesToLink, ExtraObjFiles, !IO) :-
+process_arg_2(Globals, OptionArgs, FileOrModule, ModulesToLink, ExtraObjFiles,
+ !IO) :-
globals.lookup_bool_option(Globals, generate_dependencies, GenerateDeps),
(
GenerateDeps = yes,
@@ -922,8 +766,8 @@ process_arg_2(Globals, OptionVariables,
OptionArgs, FileOrModule,
)
;
GenerateDepFile = no,
- process_module(Globals, OptionVariables, OptionArgs, FileOrModule,
- ModulesToLink, ExtraObjFiles, !IO)
+ process_module(Globals, OptionArgs, FileOrModule, ModulesToLink,
+ ExtraObjFiles, !IO)
)
).
@@ -1090,12 +934,11 @@ read_module_or_file(Globals0, Globals,
FileOrModuleName, ReturnTimestamp,
version_numbers_return_timestamp(no) = do_not_return_timestamp.
version_numbers_return_timestamp(yes) = do_return_timestamp.
-:- pred process_module(globals::in, options_variables::in, list(string)::in,
- file_or_module::in, list(string)::out, list(string)::out,
- io::di, io::uo) is det.
+:- pred process_module(globals::in, list(string)::in, file_or_module::in,
+ list(string)::out, list(string)::out, io::di, io::uo) is det.
-process_module(Globals0, OptionVariables, OptionArgs, FileOrModule,
- ModulesToLink, ExtraObjFiles, !IO) :-
+process_module(Globals0, OptionArgs, FileOrModule, ModulesToLink,
+ ExtraObjFiles, !IO) :-
globals.lookup_bool_option(Globals0, halt_at_syntax_errors, HaltSyntax),
globals.lookup_bool_option(Globals0, make_interface, MakeInterface),
globals.lookup_bool_option(Globals0, make_short_interface,
@@ -1170,7 +1013,6 @@ process_module(Globals0, OptionVariables,
OptionArgs, FileOrModule,
Globals = Globals0,
Smart = Smart0
),
- globals.get_target(Globals, Target),
(
Smart = yes,
(
@@ -1185,24 +1027,11 @@ process_module(Globals0, OptionVariables,
OptionArgs, FileOrModule,
% mapping will be explicitly recorded.
file_name_to_module_name(FileName, ModuleName)
),
-
- find_smart_recompilation_target_files(ModuleName, Globals,
- FindTargetFiles),
- find_timestamp_files(ModuleName, Globals, FindTimestampFiles),
+ find_smart_recompilation_target_files(Globals, FindTargetFiles),
+ find_timestamp_files(Globals, FindTimestampFiles),
recompilation.check.should_recompile(Globals, ModuleName,
- FindTargetFiles, FindTimestampFiles, ModulesToRecompile0,
- HaveReadModuleMap, !IO),
- (
- Target = target_asm,
- ModulesToRecompile0 = some_modules([_ | _])
- ->
- % With `--target asm', if one module needs to be recompiled,
- % all need to be recompiled because they are all compiled
- % into a single object file.
- ModulesToRecompile = all_modules
- ;
- ModulesToRecompile = ModulesToRecompile0
- )
+ FindTargetFiles, FindTimestampFiles, ModulesToRecompile,
+ HaveReadModuleMap, !IO)
;
Smart = no,
map.init(HaveReadModuleMap),
@@ -1215,21 +1044,9 @@ process_module(Globals0, OptionVariables,
OptionArgs, FileOrModule,
ModulesToLink = [],
ExtraObjFiles = []
;
- (
- Target = target_asm,
- Smart = yes
- ->
- % See the comment in process_all_args.
- compile_using_gcc_backend(Globals, OptionVariables,
- OptionArgs, FileOrModule,
- process_module_2_callback(OptionArgs, FileOrModule,
- ModulesToRecompile, HaveReadModuleMap, Globals),
- ModulesToLink, ExtraObjFiles, !IO)
- ;
- process_module_2(Globals, OptionArgs, FileOrModule,
- ModulesToRecompile, HaveReadModuleMap, ModulesToLink,
- ExtraObjFiles, !IO)
- )
+ process_module_2(Globals, OptionArgs, FileOrModule,
+ ModulesToRecompile, HaveReadModuleMap, ModulesToLink,
+ ExtraObjFiles, !IO)
)
).
@@ -1310,7 +1127,7 @@ process_module_2(Globals0, OptionArgs,
FileOrModule, MaybeModulesToRecompile,
assoc_list.keys(SubModuleList0, NestedSubModules0),
list.delete_all(NestedSubModules0, ModuleName, NestedSubModules),
- find_timestamp_files(ModuleName, Globals, FindTimestampFiles),
+ find_timestamp_files(Globals, FindTimestampFiles),
globals.lookup_bool_option(Globals, trace_prof, TraceProf),
@@ -1442,48 +1259,35 @@ compile_with_module_options(Globals,
ModuleName, OptionVariables, OptionArgs,
% not a sensible thing to do. handle_options.m will disable smart
% recompilation if `--target-code-only' is not set.
%
-:- pred find_smart_recompilation_target_files(module_name::in, globals::in,
+:- pred find_smart_recompilation_target_files(globals::in,
find_target_file_names::out(find_target_file_names)) is det.
-find_smart_recompilation_target_files(TopLevelModuleName,
- Globals, FindTargetFiles) :-
+find_smart_recompilation_target_files(Globals, FindTargetFiles) :-
globals.get_target(Globals, CompilationTarget),
( CompilationTarget = target_c, TargetSuffix = ".c"
; CompilationTarget = target_il, TargetSuffix = ".il"
; CompilationTarget = target_csharp, TargetSuffix = ".cs"
; CompilationTarget = target_java, TargetSuffix = ".java"
- ; CompilationTarget = target_asm, TargetSuffix = ".s"
; CompilationTarget = target_x86_64, TargetSuffix = ".s"
; CompilationTarget = target_erlang, TargetSuffix = ".erl"
),
- FindTargetFiles = usual_find_target_files(Globals, CompilationTarget,
- TargetSuffix, TopLevelModuleName).
+ FindTargetFiles = usual_find_target_files(Globals, TargetSuffix).
-:- pred usual_find_target_files(globals::in, compilation_target::in,
- string::in, module_name::in, module_name::in, list(file_name)::out,
+:- pred usual_find_target_files(globals::in,
+ string::in, module_name::in, list(file_name)::out,
io::di, io::uo) is det.
-usual_find_target_files(Globals, CompilationTarget, TargetSuffix,
- TopLevelModuleName, ModuleName, TargetFiles, !IO) :-
+usual_find_target_files(Globals, TargetSuffix, ModuleName, TargetFiles,
+ !IO) :-
% XXX Should we check the generated header files?
- (
- CompilationTarget = target_asm,
- ModuleName \= TopLevelModuleName
- ->
- % With `--target asm' all the nested sub-modules are placed
- % in the `.s' file of the top-level module.
- TargetFiles = []
- ;
- module_name_to_file_name(Globals, ModuleName, TargetSuffix,
- do_create_dirs, FileName, !IO),
- TargetFiles = [FileName]
- ).
+ module_name_to_file_name(Globals, ModuleName, TargetSuffix,
+ do_create_dirs, FileName, !IO),
+ TargetFiles = [FileName].
-:- pred find_timestamp_files(module_name::in, globals::in,
+:- pred find_timestamp_files(globals::in,
find_timestamp_file_names::out(find_timestamp_file_names)) is det.
-find_timestamp_files(TopLevelModuleName, Globals, FindTimestampFiles) :-
- globals.lookup_bool_option(Globals, pic, Pic),
+find_timestamp_files(Globals, FindTimestampFiles) :-
globals.get_target(Globals, CompilationTarget),
(
CompilationTarget = target_c,
@@ -1498,42 +1302,22 @@ find_timestamp_files(TopLevelModuleName,
Globals, FindTimestampFiles) :-
CompilationTarget = target_java,
TimestampSuffix = ".java_date"
;
- CompilationTarget = target_asm,
- (
- Pic = yes,
- TimestampSuffix = ".pic_s_date"
- ;
- Pic = no,
- TimestampSuffix = ".s_date"
- )
- ;
CompilationTarget = target_x86_64,
TimestampSuffix = ".s_date"
;
CompilationTarget = target_erlang,
TimestampSuffix = ".erl_date"
),
- FindTimestampFiles = find_timestamp_files_2(Globals, CompilationTarget,
- TimestampSuffix, TopLevelModuleName).
+ FindTimestampFiles = find_timestamp_files_2(Globals, TimestampSuffix).
-:- pred find_timestamp_files_2(globals::in, compilation_target::in, string::in,
- module_name::in, module_name::in, list(file_name)::out,
- io::di, io::uo) is det.
+:- pred find_timestamp_files_2(globals::in, string::in, module_name::in,
+ list(file_name)::out, io::di, io::uo) is det.
-find_timestamp_files_2(Globals, CompilationTarget, TimestampSuffix,
- TopLevelModuleName, ModuleName, TimestampFiles, !IO) :-
- (
- CompilationTarget = target_asm,
- ModuleName \= TopLevelModuleName
- ->
- % With `--target asm' all the nested sub-modules are placed in
- % the `.s' file of the top-level module.
- TimestampFiles = []
- ;
- module_name_to_file_name(Globals, ModuleName, TimestampSuffix,
- do_create_dirs, FileName, !IO),
- TimestampFiles = [FileName]
- ).
+find_timestamp_files_2(Globals, TimestampSuffix, ModuleName, TimestampFiles,
+ !IO) :-
+ module_name_to_file_name(Globals, ModuleName, TimestampSuffix,
+ do_create_dirs, FileName, !IO),
+ TimestampFiles = [FileName].
%-----------------------------------------------------------------------------%
@@ -1742,7 +1526,6 @@
mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
->
(
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64
),
% Produce the grade independent header file <module>.mh
@@ -1795,32 +1578,6 @@
mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
),
ExtraObjFiles = []
;
- Target = target_asm,
- % Compile directly to assembler using the gcc back-end.
- mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
- maybe_mlds_to_gcc(Globals, MLDS, ContainsCCode, !IO),
- (
- TargetCodeOnly = yes,
- ExtraObjFiles = []
- ;
- TargetCodeOnly = no,
- % We don't invoke the assembler to produce an object file yet
- % -- that is done at the top level.
- %
- % But if the module contained C foreign code then we will
- % have compiled that to a separate C file. We need to invoke
- % the C compiler on that.
- (
- ContainsCCode = yes,
- mercury_compile_asm_c_code(Globals, ModuleName,
- ExtraObjFile, !IO),
- ExtraObjFiles = [ExtraObjFile]
- ;
- ContainsCCode = no,
- ExtraObjFiles = []
- )
- )
- ;
Target = target_c,
(
HighLevelCode = yes,
diff --git a/compiler/mercury_compile_middle_passes.m
b/compiler/mercury_compile_middle_passes.m
index 2c3d168..73bda94 100644
--- a/compiler/mercury_compile_middle_passes.m
+++ b/compiler/mercury_compile_middle_passes.m
@@ -1222,7 +1222,6 @@ maybe_control_granularity(Verbose, Stats, !HLDS, !IO) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
@@ -1270,7 +1269,6 @@ maybe_control_distance_granularity(Verbose,
Stats, !HLDS, !IO) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
diff --git a/compiler/mercury_compile_mlds_back_end.m
b/compiler/mercury_compile_mlds_back_end.m
index 2510690..25776f2 100644
--- a/compiler/mercury_compile_mlds_back_end.m
+++ b/compiler/mercury_compile_mlds_back_end.m
@@ -44,9 +44,6 @@
:- pred mlds_to_csharp(module_info::in, mlds::in, io::di, io::uo) is det.
-:- pred maybe_mlds_to_gcc(globals::in, mlds::in, bool::out, io::di, io::uo)
- is det.
-
:- pred mlds_to_il_assembler(globals::in, mlds::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -72,7 +69,6 @@
:- import_module ml_backend.mlds_to_java. % MLDS -> Java
:- import_module ml_backend.mlds_to_cs. % MLDS -> C#
:- import_module ml_backend.mlds_to_ilasm. % MLDS -> IL assembler
-:- import_module ml_backend.maybe_mlds_to_gcc. % MLDS -> GCC back-end
:- import_module ml_backend.ml_util. % MLDS utility predicates
:- import_module parse_tree.
:- import_module parse_tree.error_util.
@@ -304,7 +300,6 @@ maybe_add_trail_ops(Verbose, Stats, !HLDS, !IO) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -410,16 +405,6 @@ mlds_to_csharp(HLDS, MLDS, !IO) :-
maybe_write_string(Verbose, "% Finished converting MLDS to C#.\n", !IO),
maybe_report_stats(Stats, !IO).
-maybe_mlds_to_gcc(Globals, MLDS, ContainsCCode, !IO) :-
- globals.lookup_bool_option(Globals, verbose, Verbose),
- globals.lookup_bool_option(Globals, statistics, Stats),
-
- maybe_write_string(Verbose,
- "% Passing MLDS to GCC and compiling to assembler...\n", !IO),
- maybe_compile_to_asm(MLDS, ContainsCCode, !IO),
- maybe_write_string(Verbose, "% Finished compiling to assembler.\n", !IO),
- maybe_report_stats(Stats, !IO).
-
mlds_to_il_assembler(Globals, MLDS, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
diff --git a/compiler/ml_backend.m b/compiler/ml_backend.m
index ec924c1..f5267ca 100644
--- a/compiler/ml_backend.m
+++ b/compiler/ml_backend.m
@@ -68,11 +68,6 @@
% MLDS->C back-end
:- include_module mlds_to_c.
-% MLDS->Assembler back-end
-:- include_module maybe_mlds_to_gcc.
-% :- include_module mlds_to_gcc
-% :- include_module gcc.
-
% MLDS->Java back-end
:- include_module mlds_to_java.
:- include_module java_util.
diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
index 5a896f5..093e803 100644
--- a/compiler/ml_code_util.m
+++ b/compiler/ml_code_util.m
@@ -1380,7 +1380,6 @@ ml_must_box_field_type(ModuleInfo, Type, Width) :-
( Target = target_c
; Target = target_csharp
; Target = target_il
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -1454,7 +1453,6 @@ ml_gen_box_const_rval(ModuleInfo, Context,
MLDS_Type, DoubleWidth, Rval,
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64
)
->
diff --git a/compiler/ml_disj_gen.m b/compiler/ml_disj_gen.m
index aff0d68..756a613 100644
--- a/compiler/ml_disj_gen.m
+++ b/compiler/ml_disj_gen.m
@@ -202,7 +202,6 @@ allow_lookup_disj(target_c) = yes.
allow_lookup_disj(target_il) = no.
allow_lookup_disj(target_csharp) = yes.
allow_lookup_disj(target_java) = yes.
-allow_lookup_disj(target_asm) = no.
allow_lookup_disj(target_x86_64) = no.
allow_lookup_disj(target_erlang) = no.
diff --git a/compiler/ml_foreign_proc_gen.m b/compiler/ml_foreign_proc_gen.m
index bbc1974..47bd050 100644
--- a/compiler/ml_foreign_proc_gen.m
+++ b/compiler/ml_foreign_proc_gen.m
@@ -152,7 +152,6 @@ ml_gen_ordinary_pragma_foreign_proc(CodeModel,
Attributes, PredId, ProcId,
;
( Target = target_c
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
diff --git a/compiler/ml_global_data.m b/compiler/ml_global_data.m
index 7031381..c9ccb9c 100644
--- a/compiler/ml_global_data.m
+++ b/compiler/ml_global_data.m
@@ -654,8 +654,7 @@ ml_gen_static_vector_type(MLDS_ModuleName,
MLDS_Context, Target, ArgTypes,
MLDS_Context),
CtorDefns = [CtorDefn]
;
- ( Target = target_asm
- ; Target = target_il
+ ( Target = target_il
; Target = target_erlang
; Target = target_x86_64
),
diff --git a/compiler/ml_proc_gen.m b/compiler/ml_proc_gen.m
index 515f5ef..ef48570 100644
--- a/compiler/ml_proc_gen.m
+++ b/compiler/ml_proc_gen.m
@@ -154,7 +154,6 @@ foreign_type_required_imports(Target, _TypeCtor -
TypeDefn) = Imports :-
( Target = target_c
; Target = target_java
; Target = target_csharp
- ; Target = target_asm
),
Imports = []
;
@@ -213,8 +212,7 @@ ml_gen_init_common_data(ModuleInfo, GlobalData) :-
),
UseCommonCells = use_common_cells
;
- ( Target = target_asm
- ; Target = target_il
+ ( Target = target_il
; Target = target_erlang
; Target = target_x86_64
),
diff --git a/compiler/ml_target_util.m b/compiler/ml_target_util.m
index 60a89ed..a2a7891 100644
--- a/compiler/ml_target_util.m
+++ b/compiler/ml_target_util.m
@@ -68,7 +68,6 @@ globals_target_supports_break_and_continue(Globals)
= SupportsBreakContinue :-
%-----------------------------------------------------------------------------%
target_supports_int_switch(target_c) = yes.
-target_supports_int_switch(target_asm) = yes.
target_supports_int_switch(target_il) = no.
target_supports_int_switch(target_csharp) = yes.
target_supports_int_switch(target_java) = yes.
@@ -78,7 +77,6 @@ target_supports_int_switch(target_erlang) =
unexpected($module, $pred, "target erlang").
target_supports_string_switch(target_c) = no.
-target_supports_string_switch(target_asm) = no.
target_supports_string_switch(target_il) = no.
target_supports_string_switch(target_csharp) = yes.
target_supports_string_switch(target_java) = no.
@@ -89,9 +87,6 @@ target_supports_string_switch(target_erlang) =
unexpected($module, $pred, "target erlang").
target_supports_computed_goto(target_c) = yes.
-target_supports_computed_goto(target_asm) = no.
- % XXX for asm, it should be `yes', but currently
- % computed gotos are not yet implemented in gcc.m.
target_supports_computed_goto(target_il) = yes.
target_supports_computed_goto(target_csharp) = yes.
target_supports_computed_goto(target_java) = no.
@@ -102,7 +97,6 @@ target_supports_computed_goto(target_erlang) =
unexpected($module, $pred, "target erlang").
target_supports_goto(target_c) = yes.
-target_supports_goto(target_asm) = yes.
target_supports_goto(target_il) = yes.
target_supports_goto(target_csharp) = yes.
target_supports_goto(target_java) = no.
@@ -112,8 +106,6 @@ target_supports_goto(target_erlang) =
unexpected($module, $pred, "target erlang").
target_supports_break_and_continue(target_c) = yes.
-target_supports_break_and_continue(target_asm) = no.
- % asm means via gnu back-end
target_supports_break_and_continue(target_il) = no.
target_supports_break_and_continue(target_csharp) = yes.
target_supports_break_and_continue(target_java) = yes.
@@ -127,7 +119,6 @@ target_supports_inheritence(target_c) = no.
target_supports_inheritence(target_il) = yes.
target_supports_inheritence(target_csharp) = yes.
target_supports_inheritence(target_java) = yes.
-target_supports_inheritence(target_asm) = no.
target_supports_inheritence(target_x86_64) =
unexpected($module, $pred, "target_x86_64 and --high-level-code").
target_supports_inheritence(target_erlang) =
diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index a3a5d24..1cfb35d 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -270,7 +270,6 @@ ml_gen_enum_type(Target, TypeCtor, TypeDefn,
Ctors, TagValues,
( Target = target_c
; Target = target_il
; Target = target_csharp
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -517,7 +516,6 @@ ml_gen_du_parent_type(ModuleInfo, TypeCtor,
TypeDefn, Ctors, TagValues,
( Target = target_c
; Target = target_il
; Target = target_csharp
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -891,7 +889,6 @@ ml_target_uses_constructors(target_c) = no.
ml_target_uses_constructors(target_il) = yes.
ml_target_uses_constructors(target_csharp) = yes.
ml_target_uses_constructors(target_java) = yes.
-ml_target_uses_constructors(target_asm) = no.
ml_target_uses_constructors(target_x86_64) =
unexpected($module, $pred, "target_x86_64 and --high-level-code").
ml_target_uses_constructors(target_erlang) =
@@ -903,7 +900,6 @@ target_uses_empty_base_classes(target_c) = no.
target_uses_empty_base_classes(target_il) = yes.
target_uses_empty_base_classes(target_csharp) = no.
target_uses_empty_base_classes(target_java) = yes.
-target_uses_empty_base_classes(target_asm) = no.
target_uses_empty_base_classes(target_x86_64) =
unexpected($module, $pred, "target_x86_64 and --high-level-code").
target_uses_empty_base_classes(target_erlang) =
@@ -923,7 +919,6 @@ target_requires_module_qualified_params(target_c) = no.
target_requires_module_qualified_params(target_il) = no.
target_requires_module_qualified_params(target_csharp) = yes.
target_requires_module_qualified_params(target_java) = yes.
-target_requires_module_qualified_params(target_asm) = no.
target_requires_module_qualified_params(target_x86_64) =
unexpected($module, $pred, "target_x86_64 with --high-level-code").
target_requires_module_qualified_params(target_erlang) =
diff --git a/compiler/mlds.m b/compiler/mlds.m
index cd234a8..2b2cdd5 100644
--- a/compiler/mlds.m
+++ b/compiler/mlds.m
@@ -1424,7 +1424,6 @@
---> ml_target_c
; ml_target_gnu_c
% ; ml_target_c_minus_minus
- ; ml_target_asm
; ml_target_il
; ml_target_csharp
; ml_target_java.
@@ -1917,7 +1916,6 @@ mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :-
( Target = target_c
; Target = target_il
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -2007,18 +2005,6 @@ foreign_type_to_mlds_type(ModuleInfo,
ForeignTypeBody) = MLDSType :-
unexpected($module, $pred, "no Java foreign type")
)
;
- Target = target_asm,
- (
- MaybeC = yes(Data),
- Data = foreign_type_lang_data(CForeignType, _, _),
- ForeignType = c(CForeignType)
- ;
- MaybeC = no,
- % XXX This ought to be checked by the front-end, e.g.
- % check_foreign_type in make_hlds.
- sorry($module, $pred, "no C foreign type")
- )
- ;
Target = target_x86_64,
unexpected($module, $pred, "target x86_64 with --high-level-code")
;
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index 30391aa..bb02cd2 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -295,15 +295,6 @@ mlds_output_hdr_imports(_Indent, _Imports, !IO).
mlds_output_src_imports(Opts, Indent, Imports, !IO) :-
Target = Opts ^ m2co_target,
(
- Target = target_asm
- % For --target asm, we don't create the header files for modules that
- % don't contain C code, so we'd better not include them, since they
- % might not exist.
-
- % XXX This is a hack; it may lead to warnings or errors when compiling
- % the generated code, since the functions that we call (e.g. for
- % `pragma foreign_export') may not have been declared.
- ;
Target = target_c,
list.foldl(mlds_output_src_import(Opts, Indent), Imports, !IO)
;
@@ -313,7 +304,7 @@ mlds_output_src_imports(Opts, Indent, Imports, !IO) :-
; Target = target_x86_64
; Target = target_erlang
),
- unexpected($module, $pred, "expected target asm or target c")
+ unexpected($module, $pred, "expected target c")
).
:- pred mlds_output_src_import(mlds_to_c_opts::in, indent::in, mlds_import::in,
@@ -507,7 +498,6 @@ mlds_output_hdr_start(Opts, Indent, ModuleName, !IO) :-
( Target = target_il
; Target = target_java
; Target = target_csharp
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
@@ -620,7 +610,6 @@ mlds_output_hdr_end(Opts, Indent, ModuleName, !IO) :-
( Target = target_il
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
)
@@ -3876,7 +3865,6 @@ mlds_output_atomic_stmt(Opts, Indent, _FuncInfo,
Statement, Context, !IO) :-
Components, !IO)
;
( TargetLang = ml_target_gnu_c
- ; TargetLang = ml_target_asm
; TargetLang = ml_target_il
; TargetLang = ml_target_csharp
; TargetLang = ml_target_java
diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m
index a1e754b..e8d2659 100644
--- a/compiler/mlds_to_cs.m
+++ b/compiler/mlds_to_cs.m
@@ -3150,7 +3150,6 @@ output_atomic_stmt(Info, Indent, AtomicStmt,
Context, !IO) :-
;
( TargetLang = ml_target_c
; TargetLang = ml_target_gnu_c
- ; TargetLang = ml_target_asm
; TargetLang = ml_target_il
; TargetLang = ml_target_java
),
diff --git a/compiler/mlds_to_gcc.m b/compiler/mlds_to_gcc.m
deleted file mode 100644
index cae0df3..0000000
--- a/compiler/mlds_to_gcc.m
+++ /dev/null
@@ -1,3790 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 1999-2011 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.
-%-----------------------------------------------------------------------------%
-%
-% mlds_to_gcc - Convert MLDS to the GCC back-end representation.
-% Main author: fjh.
-%
-% Note that this does *not* compile to GNU C -- instead it
-% actually generates GCC's internal "Tree" representation,
-% and then invokes the GCC back-end to compile it to assembler,
-% without going via an external file.
-%
-% Code using the C interface, however, does get compiled to C; this module
-% invokes mlds_to_c.m to do that. We split off all the parts of the MLDS for
-% `foreign_code' declarations, `foreign_decl' declarations, `foreign_export'
-% declarations, and procedures defined with `foreign_proc', and pass them to
-% mlds_to_c.m. That will generate a `<module>.c' file for this module;
-% mercury_compile.m will invoke the C compiler to compile that to
-% `<module>__c_code.o'. The remainding parts of the MLDS, which don't contain
-% any foreign code, we handle normally, converting them to GCC trees and
-% passing them to the GCC back-end to generate an assembler file. Calls to
-% procedures defined using `foreign_proc' will end up calling the functions
-% defined in `<module>__c_code.o'. This works because the calling convention
-% that is used for the MLDS->C back-end is the same as (i.e. binary compatible
-% with) the calling convention that we use here in the MLDS->GCC back-end.
-%
-% Currently this back-end supports grade hlc.gc only.
-%
-% Trailing will probably work too, but since trailing
-% is currently implemented using the C interface,
-% it will end up compiling everything via C.
-%
-% See also gcc/mercury/README.
-%
-% TODO:
-% Fix configuration issues:
-% - document installation procedure better
-% (there is some documentation in gcc/mercury/README,
-% but probably there should also be something in the INSTALL
-% file in the Mercury distribution)
-% - test more
-%
-% Fix unimplemented standard Mercury features:
-% - Mmake support for nested modules
-% - support modules containing foreign_decls but no
-% foreign_procs or foreign code
-%
-% Implement implementation-specific features that are supported
-% by other Mercury back-ends:
-% - support --high-level-data (enum types, pred types, user_type)
-% - support --profiling and --heap-profiling
-% - support --nondet-copy-out
-% - support --gcc-nested-functions (probably not worth it)
-% - pragma foreign_code(asm, ...)
-%
-% Implement implementation-specific features that are supported
-% by other gcc front-ends:
-% - generate gcc trees rather than expanding as we go
-% This should probably wait until the GCC back-end
-% has a language-independent representation for switches.
-% - support gdb (hard!):
-% - improve accuracy of line numbers (e.g. for decls).
-% - make variable names match what's in the original source
-% - use nested functions or something like that to hide
-% from the user the environment struct stuff that we
-% generate for nondet code
-% - teach gdb to demangle Mercury symbol names
-% - extend gdb to print Mercury data structures better
-% - extend gdb to print Mercury stacks better
-% - extend gdb to support mdb's `retry' command
-% ...
-%
-% Improve efficiency of generated code:
-% - implement annotation in gcc tree to force tailcalls
-% - improve code for switches with default_is_unreachable.
-% (We already do a reasonably good job, so this is a low priority.)
-% One way would be to implement computed_goto and unsigned_le,
-% and change target_supports_computed_goto_2(asm) in ml_switch_gen.m
-% to `yes'.
-%
-% Improve efficiency of compilation:
-% - improve symbol table handling
-%
-% See also the TODO list in ml_code_gen.m.
-%
-%-----------------------------------------------------------------------------%
-
-:- module mlds_to_gcc.
-:- interface.
-
-:- import_module libs.
-:- import_module libs.globals.
-:- import_module ml_backend.
-:- import_module ml_backend.maybe_mlds_to_gcc.
-:- import_module ml_backend.mlds.
-
-:- import_module bool.
-:- import_module io.
-
-%-----------------------------------------------------------------------------%
-
- % run_gcc_backend(Globals, ModuleName, CallBack, CallBackOutput):
- %
- % Set things up to generate an assembler file whose name
- % is based on the specified module name, and then call the
- % CallBack procedure. When the CallBack procedure exits
- % (returning CallBackOutput), finish generating the assembler
- % file, and then return the CallBackOutput back to the caller.
- %
- % Due to limitations in the GCC back-end, this procedure
- % must not be called more than once per process.
-
-:- pred mlds_to_gcc.run_gcc_backend(globals::in, mercury_module_name::in,
- frontend_callback(T)::in(frontend_callback), T::out,
- io.state::di, io.state::uo) is det.
-
- % compile_to_gcc(MLDS, ContainsCCode):
- %
- % Generate GCC trees and/or RTL for the given MLDS,
- % and invoke the GCC back-end to output assembler for
- % them to the assembler file.
- %
- % This procedure must only be called from within a callback
- % function passed to run_gcc_backend. Otherwise it may
- % try to use the GCC back-end before it has been properly
- % initialized.
- %
- % The ContainsCCode bool returned is `yes' iff the module contained
- % C code. In that case, we will have output a separate C file which
- % needs to be compiled with the C compiler.
- %
- % XXX Currently the only foreign language we handle is C.
- % To make it work properly we'd need to change the `ContainsCCode' boolean
- % that we return to instead be a list of the foreign languages used,
- % so that mercury_compile.m will know which foreign language files
- % have been generated which foreign language compilers it needs to invoke,
- % and which object files to link into the executable.
- %
-:- pred compile_to_asm(globals::in, mlds::in, bool::out,
- io::di, io::uo) is det.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- use_module gcc.
-
-:- import_module backend_libs.
-:- import_module hlds.
-:- import_module parse_tree.
-
-:- import_module backend_libs.builtin_ops.
-:- import_module backend_libs.rtti. % for rtti.addr_to_string.
-:- import_module hlds.code_model.
-:- import_module hlds.hlds_pred. % for proc_id_to_int and invalid_pred_id
-:- import_module libs.file_util.
-:- import_module libs.options.
-:- import_module mdbcomp.prim_data.
-:- import_module ml_backend.ml_code_util.
- % For ml_gen_public_field_decl_flags, which is used by the code
- % that handles derived classes.
-:- import_module ml_backend.ml_global_data.
-:- import_module ml_backend.ml_util.
-:- import_module ml_backend.mlds_to_c. % to handle C foreign_code
-:- import_module parse_tree.file_names.
-:- import_module parse_tree.prog_data.
-:- import_module parse_tree.prog_foreign.
-:- import_module parse_tree.prog_type.
-
-:- import_module int.
-:- import_module list.
-:- import_module map.
-:- import_module maybe.
-:- import_module pair.
-:- import_module require.
-:- import_module set.
-:- import_module solutions.
-:- import_module string.
-:- import_module term.
-
-%-----------------------------------------------------------------------------%
-
-run_gcc_backend(Globals, ModuleName, CallBack, CallBackOutput, !IO) :-
- globals.lookup_bool_option(Globals, pic, Pic),
- ( Pic = yes ->
- PicExt = ".pic_s",
- PicOpt = "-fpic "
- ;
- PicExt = ".s",
- PicOpt = ""
- ),
- module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
- SourceFileName, !IO),
- module_name_to_file_name(Globals, ModuleName, PicExt, do_create_dirs,
- AsmFileName, !IO),
- % XXX should use new gcc_* options rather than
- % reusing cflags, c_optimize.
- globals.lookup_bool_option(Globals, statistics, Statistics),
- (
- Statistics = yes,
- QuietOption = ""
- ;
- Statistics = no,
- QuietOption = "-quiet "
- ),
- globals.lookup_bool_option(Globals, c_optimize, C_optimize),
- (
- C_optimize = yes,
- OptimizeOpt = "-O2 -fomit-frame-pointer "
- ;
- C_optimize = no,
- OptimizeOpt = ""
- ),
- globals.lookup_bool_option(Globals, target_debug, Target_Debug),
- (
- Target_Debug = yes,
- Target_DebugOpt = "-g "
- ;
- Target_Debug = no,
- Target_DebugOpt = ""
- ),
- globals.lookup_accumulating_option(Globals, cflags, C_Flags_List),
- CFLAGS = string.append_list(list.map(func(Flag) = Flag ++ " ",
- C_Flags_List)),
- % Be careful with the order here.
- % Also be careful that each option is separated by spaces.
- string.append_list(["""<GCC back-end>"" ", PicOpt,
- QuietOption, OptimizeOpt, Target_DebugOpt, CFLAGS,
- SourceFileName, " -o ", AsmFileName], CommandLine),
- globals.lookup_bool_option(Globals, verbose, Verbose),
- maybe_write_string(Verbose, "% Invoking GCC back-end as `", !IO),
- maybe_write_string(Verbose, CommandLine, !IO),
- maybe_write_string(Verbose, "':\n", !IO),
- maybe_flush_output(Verbose, !IO),
- gcc.run_backend(CommandLine, Result, CallBack, CallBackOutput, !IO),
- ( Result = 0 ->
- maybe_write_string(Verbose, "% GCC back-end done.\n", !IO)
- ;
- report_error("GCC back-end failed!\n", !IO)
- ).
-
-compile_to_asm(Globals, MLDS, ContainsCCode, !IO) :-
- % XXX We need to handle initialise declarations properly here.
- % XXX zs: I am not sure whether the handling of _GlobalData is right.
- MLDS = mlds(ModuleName, AllForeignCode, Imports, _GlobalData, Defns0,
- InitPreds, FinalPreds, ExportedEnums),
-
- % Handle output of any foreign code (C, Ada, Fortran, etc.)
- % to appropriate files.
-
- list.filter(defn_contains_foreign_code(ml_target_asm), Defns0,
- ForeignDefns, Defns),
- % We only handle C currently, so we just look up C.
- ForeignCode = map.lookup(AllForeignCode, lang_c),
- (
- % Check if there is any C code from pragma foreign_code,
- % pragma export, or pragma foreign_proc declarations.
- % We only want to generate a `.c' file if there is C foreign
- % code.
- %
- % We don't generate a `.c' file if the
- % module contains only `pragma foreign_decls' . This
- % is needed to avoid generating a `.c' file when intermodule
- % optimization is enabled and `pragma foreign_decls'
- % declarations have been read in from the `.opt' files
- % and have propagated through to the MLDS.
- % Creating a C file when the module itself doesn't contain
- % C code breaks things, since Mmake won't compile and link
- % in the generated `.c' files, but those files contain the
- % definition of the `*__init_type_tables()' functions that
- % are referenced by `*_init.c'.
- %
- % XXX This is not quite right, since if the module itself
- % contains `pragma foreign_decls', the `.c' file might
- % be needed. But the Mercury standard library needs
- % intermodule optimization enabled for `make install'
- % to work. A better fix would be to ignore foreign_decls
- % that were defined in other modules, but to create the `.c'
- % file if there are foreign_decls that were defined in the
- % module that we're compiling.
- ForeignCode = mlds_foreign_code(_Decls, _Imports, [], []),
- ForeignDefns = []
- ->
- ContainsCCode = no,
- NeedInitFn = yes
- ;
- % XXX currently the only foreign code we handle is C;
- % see comments above (at the declaration for
- % mlds_to_c.compile_to_asm)
- ContainsCCode = yes,
- NeedInitFn = no,
- % create a new MLDS containing just the foreign code
- % (with all definitions made public, so we can use
- % them from the asm file!) and pass that to mlds_to_c.m
- % to create the .mih file, and if necessary the .c file.
- ForeignMLDS = mlds(ModuleName, AllForeignCode, Imports,
- ml_global_data_init(do_not_use_common_cells,
- do_not_have_unboxed_floats),
- list.map(make_public, ForeignDefns),
- InitPreds, FinalPreds, ExportedEnums),
- mlds_to_c.output_c_file(ForeignMLDS, Globals, "", !IO)
- ),
-
- % Generate the .mih C header file for this module.
- % We do this regardless of whether the module contains C code,
- % because this is needed to allow interoperability between modules
- % compiled with --target asm and --target c.
- %
- mlds_to_c.output_c_header_file(MLDS, Globals, "", !IO),
-
- % We generate things in this order:
- % #1. definitions of the types,
- % #2. definitions of all the non-types
- % #3. initialization functions
- % #1 needs to come before #2 since we need the types to be
- % complete before we generate local variables of that type.
- % (This happens for the environment structs that we
- % use for nested functions.)
- %
- % Declarations of functions and types referred to by this
- % module are generated on-demand.
- %
- list.filter(defn_is_type, Defns, TypeDefns, NonTypeDefns),
- MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- GlobalInfo0 = global_info(map.init, map.init, Globals),
- gen_defns(MLDS_ModuleName, TypeDefns, GlobalInfo0, GlobalInfo1, !IO),
- gen_defns(MLDS_ModuleName, NonTypeDefns, GlobalInfo1, GlobalInfo2, !IO),
-
- % XXX currently we just generate an empty initialization function.
- % Initialization functions are only needed for --profiling
- % and --heap-profiling, which we don't support yet.
- (
- NeedInitFn = yes,
- gen_init_fn_defns(MLDS_ModuleName, GlobalInfo2, _GlobalInfo, !IO)
- ;
- NeedInitFn = no
- ).
-/****
-not yet:
- { list.filter(defn_is_function, NonTypeDefns, FuncDefns) },
- { list.filter(defn_is_type_ctor_info, NonTypeDefns,
- TypeCtorInfoDefns) },
- mlds_output_init_fn_defns(MLDS_ModuleName, FuncDefns,
- TypeCtorInfoDefns), io.nl,
-*****/
-
- % XXX we ought to output a reference to the mangled grade name,
- % to prevent linking with the wrong grade.
- % But this would require duplicating the logic in
- % runtime/mercury_grade.h. Some of it is already duplicated
- % in
- % of the code in
-/******
-not yet:
- % mlds_output_grade_var, io.nl.
-******/
-
-/******
-not yet implemented for mlds_to_gcc:
- %
- % Output a reference to the mangled grade name for the grade
- % that the C file gets compiled with. This ensures that
- % we don't try to link objects files compiled in different
- % grades.
- %
-:- pred mlds_output_grade_var(io::di, io::uo) is det.
-mlds_output_grade_var -->
- io.write_string(
- "// ensure everything is compiled with the same grade\n"),
- io.write_string(
- "static const void *const MR_grade = &MR_GRADE_VAR;\n").
-******/
-
-:- func make_public(mlds_defn) = mlds_defn.
-
-make_public(Defn0) = Defn :-
- Defn0 = mlds_defn(EntityName, Context, Flags0, EntityDefn),
- Flags = mlds.set_access(Flags0, acc_public),
- Defn = mlds_defn(EntityName, Context, Flags, EntityDefn).
-
-%-----------------------------------------------------------------------------%
-
-:- pred gen_init_fn_defns(mlds_module_name::in,
- global_info::in, global_info::out, io::di, io::uo) is det.
-
-gen_init_fn_defns(MLDS_ModuleName, !GlobalInfo, !IO) :-
- % Generate an empty function of the form
- %
- % void <foo>_init_type_tables() {}
-
- FuncName = init_fn_name(MLDS_ModuleName, "_type_tables"),
- GCC_ParamTypes = gcc.empty_param_types,
- GCC_ParamDecls = gcc.empty_param_decls,
- GCC_RetType = gcc.void_type_node,
- gcc.build_function_decl(FuncName, FuncName,
- GCC_RetType, GCC_ParamTypes, GCC_ParamDecls, GCC_FuncDecl, !IO),
- Name = entity_export(FuncName),
- map.init(SymbolTable),
- map.init(LabelTable),
- DefnInfo = defn_info(!.GlobalInfo,
- qual(MLDS_ModuleName, module_qual, Name),
- SymbolTable, LabelTable),
- term.context_init(Context),
- FuncBody = statement(ml_stmt_block([], []),
- mlds_make_context(Context)),
- gcc.start_function(GCC_FuncDecl, !IO),
- gen_statement(DefnInfo, FuncBody, !IO),
- gcc.end_function(!IO).
-
-:- func init_fn_name(mlds_module_name, string) = string.
-
-init_fn_name(ModuleName, Suffix) = InitFnName :-
- % Here we ensure that we only get one "mercury__" at the
- % start of the function name.
- ModuleNameString0 = sym_name_to_string_sep(
- mlds_module_name_to_sym_name(ModuleName), "__"),
- (
- string.prefix(ModuleNameString0, "mercury__")
- ->
- ModuleNameString = ModuleNameString0
- ;
- string.append("mercury__", ModuleNameString0, ModuleNameString)
- ),
- string.append_list([ModuleNameString, "__init", Suffix], InitFnName).
-
-%-----------------------------------------------------------------------------%
-
-/***************
-XXX The following is all not yet implemented for mlds_to_gcc.m.
-The code below shows what mlds_to_c.m does
-(modified to avoid using C macros, which we'll need to do for mlds_to_gcc.m).
-
- %
- % Maybe output the function `mercury__<modulename>__init()'.
- % The body of the function consists of calls
- % MR_init_entry(<function>) for each function defined in the
- % module.
- %
-:- pred mlds_output_init_fn_decls(mlds_module_name::in,
- io::di, io::uo) is det.
-
-mlds_output_init_fn_decls(ModuleName) -->
- output_init_fn_name(ModuleName, ""),
- io.write_string(";\n"),
- output_init_fn_name(ModuleName, "_type_tables"),
- io.write_string(";\n"),
- output_init_fn_name(ModuleName, "_debugger"),
- io.write_string(";\n").
-
-:- pred mlds_output_init_fn_defns(mlds_module_name::in, list(mlds_defn)::in,
- list(mlds_defn)::in, io::di, io::uo) is det.
-
-mlds_output_init_fn_defns(ModuleName, FuncDefns, TypeCtorInfoDefns) -->
- output_init_fn_name(ModuleName, ""),
- io.write_string("\n{\n"),
- io_get_globals(Globals),
- (
- { need_to_init_entries(Globals) },
- { FuncDefns \= [] }
- ->
- io.write_strings(
- ["\tstatic MR_bool initialised = MR_FALSE;\n",
- "\tif (initialised) return;\n",
- "\tinitialised = MR_TRUE;\n\n"]),
- mlds_output_calls_to_init_entry(ModuleName, FuncDefns)
- ;
- []
- ),
- io.write_string("}\n\n"),
-
- output_init_fn_name(ModuleName, "_type_tables"),
- io.write_string("\n{\n"),
- (
- { TypeCtorInfoDefns \= [] }
- ->
- io.write_strings(
- ["\tstatic MR_bool initialised = MR_FALSE;\n",
- "\tif (initialised) return;\n",
- "\tinitialised = MR_TRUE;\n\n"]),
- mlds_output_calls_to_register_tci(ModuleName,
- TypeCtorInfoDefns)
- ;
- []
- ),
- io.write_string("}\n\n"),
-
- output_init_fn_name(ModuleName, "_debugger"),
- io.write_string("\n{\n"),
- io.write_string(
- "\tMR_fatal_error(""debugger initialization in MLDS grade"");\n"),
- io.write_string("}\n").
-
-:- pred output_init_fn_name(mlds_module_name::in, string::in,
- io::di, io::uo) is det.
-
-output_init_fn_name(ModuleName, Suffix) -->
- % Here we ensure that we only get one "mercury__" at the
- % start of the function name.
- { mdbcomp.prim_data.sym_name_to_string(
- mlds_module_name_to_sym_name(ModuleName), "__",
- ModuleNameString0) },
- { string.prefix(ModuleNameString0, "mercury__") ->
- ModuleNameString = ModuleNameString0
- ;
- string.append("mercury__", ModuleNameString0, ModuleNameString)
- },
- io.write_string("void "),
- io.write_string(ModuleNameString),
- io.write_string("__init"),
- io.write_string(Suffix),
- io.write_string("(void)").
-
-:- pred need_to_init_entries(globals::in) is semidet.
-
-need_to_init_entries(Globals) :-
- % We only need to output calls to MR_init_entry() if profiling is
- % enabled.
- ( Option = profile_calls
- ; Option = profile_time
- ; Option = profile_memory
- ),
- globals.lookup_bool_option(Globals, Option, yes).
-
- % Generate calls to MR_init_entry() for the specified functions.
- %
-:- pred mlds_output_calls_to_init_entry(mlds_module_name::in,
- list(mlds_defn)::in, io::di, io::uo) is det.
-
-mlds_output_calls_to_init_entry(_ModuleName, []) --> [].
-mlds_output_calls_to_init_entry(ModuleName, [FuncDefn | FuncDefns]) -->
- { FuncDefn = mlds_defn(EntityName, _, _, _) },
- % Generate a call to MR_insert_entry_label(), which is declared as
- % MR_insert_entry_label(const char *name, MR_Code *addr,
- % const MR_Stack_Layout_Entry *entry_layout);
- io.write_string("\tMR_insert_entry_label("""),
- { QualifiedName = qual(ModuleName, module_qual, EntityName) },
- mlds_output_fully_qualified_name(QualifiedName),
- io.write_string("\t"", "),
- mlds_output_fully_qualified_name(QualifiedName),
- io.write_string(", NULL);\n"),
- mlds_output_calls_to_init_entry(ModuleName, FuncDefns).
-
- % Generate calls to MR_register_type_ctor_info() for the specified
- % type_ctor_infos.
- %
-:- pred mlds_output_calls_to_register_tci(mlds_module_name::in,
- list(mlds_defn)::in, io::di, io::uo) is det.
-
-mlds_output_calls_to_register_tci(_ModuleName, []) --> [].
-mlds_output_calls_to_register_tci(ModuleName,
- [TypeCtorInfoDefn | TypeCtorInfoDefns]) -->
- { TypeCtorInfoDefn = mlds_defn(EntityName, _, _, _) },
- io.write_string("\tMR_register_type_ctor_info(&"),
- mlds_output_fully_qualified_name(
- qual(ModuleName, module_qual, EntityName)),
- io.write_string(");\n"),
- mlds_output_calls_to_register_tci(ModuleName, TypeCtorInfoDefns).
-********************/
-
-%-----------------------------------------------------------------------------%
-%
-% Foreign language interface stuff.
-%
-
-/****************
-XXX The following code for handling `pragma export'
-is all not yet implemented for mlds_to_gcc.m.
-The code below is copied from mlds_to_c.m.
-It shows what we need to do.
-
-:- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
- mlds_pragma_export, io::di, io::uo) is det.
-:- mode mlds_output_pragma_export_decl(in, in, in, di, uo) is det.
-
-mlds_output_pragma_export_decl(ModuleName, Indent, PragmaExport) -->
- mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport),
- io.write_string(";").
-
-:- pred mlds_output_pragma_export_defn(mlds_module_name, indent,
- mlds_pragma_export, io::di, io::uo) is det.
-:- mode mlds_output_pragma_export_defn(in, in, in, di, uo) is det.
-
-mlds_output_pragma_export_defn(ModuleName, Indent, PragmaExport) -->
- { PragmaExport = ml_pragma_export(_C_name, MLDS_Name, MLDS_Signature,
- Context) },
- mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport),
- io.write_string("\n"),
- mlds_indent(Context, Indent),
- io.write_string("{\n"),
- mlds_indent(Context, Indent),
- mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name,
- MLDS_Signature),
- io.write_string("}\n").
-
-:- pred mlds_output_pragma_export_func_name(mlds_module_name, indent,
- mlds_pragma_export, io::di, io::uo) is det.
-:- mode mlds_output_pragma_export_func_name(in, in, in, di, uo) is det.
-
-mlds_output_pragma_export_func_name(ModuleName, Indent,
- ml_pragma_export(C_name, _MLDS_Name, Signature, Context)) -->
- { Name = qual(ModuleName, module_qual, export(C_name)) },
- mlds_indent(Context, Indent),
- % For functions exported using `pragma export',
- % we use the default C calling convention.
- { CallingConvention = "" },
- mlds_output_func_decl_ho(Indent, Name, Context,
- CallingConvention, Signature,
- mlds_output_pragma_export_type(prefix),
- mlds_output_pragma_export_type(suffix)).
-
-:- type locn ---> prefix ; suffix.
-:- pred mlds_output_pragma_export_type(locn, mlds_type, io::di, io::uo) is det.
-:- mode mlds_output_pragma_export_type(in, in, di, uo) is det.
-
-mlds_output_pragma_export_type(suffix, _Type) --> [].
-mlds_output_pragma_export_type(prefix, mercury_type(Type, _)) -->
- { export.type_to_type_string(Type, String) },
- io.write_string(String).
-mlds_output_pragma_export_type(prefix, mlds_cont_type(_)) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_commit_type) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_native_bool_type) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_native_int_type) -->
- io.write_string("MR_Integer").
-mlds_output_pragma_export_type(prefix, mlds_native_float_type) -->
- io.write_string("MR_Float").
-mlds_output_pragma_export_type(prefix, mlds_native_char_type) -->
- io.write_string("MR_Char").
-mlds_output_pragma_export_type(prefix, mlds_class_type(_, _, _)) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_array_type(_)) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_ptr_type(Type)) -->
- mlds_output_pragma_export_type(prefix, Type),
- io.write_string(" *").
-mlds_output_pragma_export_type(prefix, mlds_func_type(_)) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_generic_type) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_generic_env_ptr_type) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_pseudo_type_info_type) -->
- io.write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mlds_rtti_type(_)) -->
- io.write_string("MR_Word").
-
- % Output the definition body for a pragma export
- %
-:- pred mlds_output_pragma_export_defn_body(mlds_module_name,
- mlds_qualified_entity_name, func_params, io::di, io::uo) is det.
-:- mode mlds_output_pragma_export_defn_body(in, in, in, di, uo) is det.
-
-mlds_output_pragma_export_defn_body(ModuleName, FuncName, Signature) -->
- { Signature = mlds_func_params(Parameters, RetTypes) },
-
- ( { RetTypes = [] } ->
- io.write_string("\t")
- ; { RetTypes = [RetType] } ->
- io.write_string("\treturn ("),
- mlds_output_pragma_export_type(prefix, RetType),
- mlds_output_pragma_export_type(suffix, RetType),
- io.write_string(") ")
- ;
- { unexpected($module, $pred, "multiple return types") }
- ),
-
- mlds_output_fully_qualified_name(FuncName),
- io.write_string("("),
- io.write_list(Parameters, ", ",
- mlds_output_name_with_cast(ModuleName)),
- io.write_string(");\n").
-
- % Write out the arguments to the MLDS function. Note the last
- % in the list of the arguments is the return value, so it must
- % be "&arg"
- %
-:- pred write_func_args(mlds_module_name::in, mlds_arguments::in,
- io::di, io::uo) is det.
-
-write_func_args(_ModuleName, []) -->
- { error("write_func_args: empty list") }.
-write_func_args(_ModuleName, [_Arg]) -->
- io.write_string("&arg").
-write_func_args(ModuleName, [Arg | Args]) -->
- { Args = [_|_] },
- mlds_output_name_with_cast(ModuleName, Arg),
- io.write_string(", "),
- write_func_args(ModuleName, Args).
-
- %
- % Output a fully qualified name preceded by a cast.
- %
-:- pred mlds_output_name_with_cast(mlds_module_name::in,
- pair(mlds_entity_name, mlds_type)::in,
- io::di, io::uo) is det.
-
-mlds_output_name_with_cast(ModuleName, Name - Type) -->
- mlds_output_cast(Type),
- mlds_output_fully_qualified_name(qual(ModuleName, module_qual, Name)).
-
-************************/
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output declarations and definitions.
-%
-
- % Handle MLDS definitions that occur at global scope.
- %
-:- pred gen_defns(mlds_module_name::in, list(mlds_defn)::in,
- global_info::in, global_info::out, io::di, io::uo) is det.
-
-gen_defns(_ModuleName, [], !GlobalInfo, !IO).
-gen_defns(ModuleName, [Defn | Defns], !GlobalInfo, !IO) :-
- gen_defn(ModuleName, Defn, !GlobalInfo, !IO),
- gen_defns(ModuleName, Defns, !GlobalInfo, !IO).
-
- % Handle MLDS definitions that are nested inside a
- % function definition (or inside a block within a function),
- % and which are hence local to that function.
- %
-:- pred build_local_defns(list(mlds_defn)::in, mlds_module_name::in,
- defn_info::in, defn_info::out, io::di, io::uo) is det.
-
-build_local_defns([], _, !DefnInfo, !IO).
-build_local_defns([Defn | Defns], ModuleName, !DefnInfo, !IO) :-
- build_local_defn(Defn, !.DefnInfo, ModuleName, GCC_Defn, !IO),
- % Insert the variable definition into our symbol table.
- % The MLDS code that the MLDS code generator generates should
- % not have any shadowing of parameters or local variables by
- % nested local variables, so we use map.det_insert rather
- % than map.set here. (Actually nothing in this module depends
- % on it, so this sanity check here is perhaps a bit paranoid.)
- Defn = mlds_defn(Name, _, _, _),
- !DefnInfo ^ di_local_vars :=
- map.det_insert(!.DefnInfo ^ di_local_vars,
- qual(ModuleName, module_qual, Name), GCC_Defn),
- build_local_defns(Defns, ModuleName, !DefnInfo, !IO).
-
- % Handle MLDS definitions that are nested inside a type,
- % i.e. fields of that type.
- %
-:- pred build_field_defns(list(mlds_defn)::in, mlds_module_name::in,
- global_info::in, gcc.field_decls::out, field_table::in, field_table::out,
- io::di, io::uo) is det.
-
-build_field_defns([], _, _, FieldList, !FieldTable, !IO) :-
- gcc.empty_field_list(FieldList, !IO).
-build_field_defns([Defn|Defns], ModuleName, GlobalInfo, FieldList,
- !FieldTable, !IO) :-
- build_field_defn(Defn, ModuleName, GlobalInfo, GCC_FieldDefn, !IO),
- % Insert the field definition into our field symbol table.
- Defn = mlds_defn(Name, _, _, _),
- ( Name = entity_data(mlds_data_var(FieldName)) ->
- GCC_FieldName = ml_var_name_to_string(FieldName),
- QualFieldName = qual(ModuleName, type_qual, GCC_FieldName),
- map.det_insert(QualFieldName, GCC_FieldDefn, !FieldTable)
- ;
- unexpected($module, $pred, "non-var field")
- ),
- build_field_defns(Defns, ModuleName, GlobalInfo, FieldList0,
- !FieldTable, !IO),
- gcc.cons_field_list(GCC_FieldDefn, FieldList0, FieldList, !IO).
-
-:- pred gen_defn(mlds_module_name::in, mlds_defn::in,
- global_info::in, global_info::out, io::di, io::uo) is det.
-
-gen_defn(ModuleName, Defn, !GlobalInfo, !IO) :-
- Defn = mlds_defn(Name, Context, Flags, DefnBody),
- gen_defn_body(qual(ModuleName, module_qual, Name), Context, Flags,
- DefnBody, !GlobalInfo, !IO).
-
-:- pred build_local_defn(mlds_defn::in, defn_info::in, mlds_module_name::in,
- gcc.var_decl::out, io::di, io::uo) is det.
-
-build_local_defn(Defn, DefnInfo, ModuleName, GCC_Defn, !IO) :-
- Defn = mlds_defn(Name, Context, Flags, DefnBody),
- build_local_defn_body(qual(ModuleName, module_qual, Name),
- DefnInfo, Context, Flags, DefnBody, GCC_Defn, !IO).
-
-:- pred build_field_defn(mlds_defn::in, mlds_module_name::in, global_info::in,
- gcc.field_decl::out, io::di, io::uo) is det.
-
-build_field_defn(Defn, ModuleName, GlobalInfo, GCC_Defn, !IO) :-
- Defn = mlds_defn(Name, Context, Flags, DefnBody),
- build_field_defn_body(qual(ModuleName, type_qual, Name),
- Context, Flags, DefnBody, GlobalInfo, GCC_Defn, !IO).
-
-:- pred gen_defn_body(mlds_qualified_entity_name::in,
- mlds_context::in, mlds_decl_flags::in, mlds_entity_defn::in,
- global_info::in, global_info::out, io::di, io::uo) is det.
-
-gen_defn_body(Name, Context, Flags, DefnBody, !GlobalInfo, !IO) :-
- (
- DefnBody = mlds_data(Type, Initializer, _GCStatement),
- LocalVars = map.init,
- LabelTable = map.init,
- DefnInfo = defn_info(!.GlobalInfo, Name, LocalVars, LabelTable),
- GCC_Name = build_qualified_name(Name),
- build_type(Type, get_initializer_array_size(Initializer),
- !.GlobalInfo, GCC_Type, !IO),
- build_initializer(Initializer, GCC_Type, DefnInfo,
- GCC_Initializer, !IO),
- gcc.build_static_var_decl(GCC_Name, GCC_Type, GCC_Initializer,
- GCC_Defn, !IO),
- add_var_decl_flags(Flags, GCC_Defn, !IO),
- gcc.finish_static_var_decl(GCC_Defn, !IO),
-
- % Insert the definition in our symbol table.
- GlobalVars0 = !.GlobalInfo ^ gi_global_vars,
- map.det_insert(Name, GCC_Defn, GlobalVars0, GlobalVars),
- !GlobalInfo ^ gi_global_vars := GlobalVars
- ;
- DefnBody = mlds_function(_MaybePredProcId, Signature, FunctionBody,
- _Attributes, EnvVarNames),
- expect(set.empty(EnvVarNames), $module, $pred, "EnvVarNames"),
- gen_func(Name, Context, Flags, Signature, FunctionBody,
- !GlobalInfo, !IO)
- ;
- DefnBody = mlds_class(ClassDefn),
- gen_class(Name, Context, ClassDefn, !GlobalInfo, !IO)
- ).
-
-:- pred build_local_defn_body(mlds_qualified_entity_name::in, defn_info::in,
- mlds_context::in, mlds_decl_flags::in, mlds_entity_defn::in,
- gcc.var_decl::out, io::di, io::uo) is det.
-
-build_local_defn_body(Name, DefnInfo, _Context, Flags, DefnBody, GCC_Defn,
- !IO) :-
- (
- DefnBody = mlds_data(Type, Initializer, _GCStatement),
- build_local_data_defn(Name, Flags, Type,
- Initializer, DefnInfo, GCC_Defn, !IO)
- ;
- DefnBody = mlds_function(_, _, _, _, _),
- % nested functions should get eliminated by ml_elim_nested,
- % unless --gcc-nested-functions is enabled.
- % XXX --gcc-nested-functions is not yet implemented
- sorry($module, $pred, "nested function (`--gcc-nested-functions' "
- ++ "not yet supported with `--target asm')")
- ;
- DefnBody = mlds_class(_),
- % currently the MLDS code generator doesn't generate
- % types nested inside functions, so we don't need to
- % implement this
- unexpected($module, $pred, "nested type")
- ).
-
-:- pred build_field_defn_body(mlds_qualified_entity_name::in, mlds_context::in,
- mlds_decl_flags::in, mlds_entity_defn::in, global_info::in,
- gcc.field_decl::out, io::di, io::uo) is det.
-
-build_field_defn_body(Name, _Context, Flags, DefnBody, GlobalInfo,
- GCC_Defn, !IO) :-
- (
- DefnBody = mlds_data(Type, Initializer, _GCStatement),
- build_field_data_defn(Name, Type, Initializer, GlobalInfo,
- GCC_Defn, !IO),
- add_field_decl_flags(Flags, GCC_Defn, !IO)
- ;
- DefnBody = mlds_function(_, _, _, _, _),
- unexpected($module, $pred, "function nested in type")
- ;
- DefnBody = mlds_class(_),
- unexpected($module, $pred, "type nested in type")
- ).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to handle declaration flags.
-%
-
-%
-% Decl flags for variables.
-%
-
-:- pred add_var_decl_flags(mlds_decl_flags::in, gcc.var_decl::in,
- io::di, io::uo) is det.
-
-add_var_decl_flags(Flags, GCC_Defn, !IO) :-
- add_var_access_flag(access(Flags), GCC_Defn, !IO),
- % note that the per_instance flag is handled separately,
- % by calling build_local_var or build_static_var
- add_var_virtuality_flag(virtuality(Flags), GCC_Defn, !IO),
- add_var_overridability_flag(overridability(Flags), GCC_Defn, !IO),
- add_var_constness_flag(constness(Flags), GCC_Defn, !IO),
- add_var_abstractness_flag(abstractness(Flags), GCC_Defn, !IO).
-
-:- pred add_var_access_flag(access::in, gcc.var_decl::in,
- io::di, io::uo) is det.
-
-add_var_access_flag(acc_public, GCC_Defn, !IO) :-
- gcc.set_var_decl_public(GCC_Defn, !IO).
-add_var_access_flag(acc_private, _GCC_Defn, !IO).
- % This should only be used for global variables, where it is the default.
-add_var_access_flag(acc_protected, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`protected' access").
-add_var_access_flag(acc_default, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`default' access").
-add_var_access_flag(acc_local, _GCC_Defn, !IO).
- % This should only be used for local variables, where it is the default.
-
-:- pred add_var_virtuality_flag(virtuality::in, gcc.var_decl::in,
- io::di, io::uo) is det.
-
-add_var_virtuality_flag(virtual, _GCC_Defn, !IO) :-
- % `virtual' should only be used for methods,
- % not for variables.
- unexpected($module, $pred, "`virtual' variable").
-add_var_virtuality_flag(non_virtual, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_var_constness_flag(constness::in, gcc.var_decl::in,
- io::di, io::uo) is det.
-
-add_var_constness_flag(const, GCC_Defn, !IO) :-
- gcc.set_var_decl_readonly(GCC_Defn, !IO).
-add_var_constness_flag(modifiable, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_var_overridability_flag(overridability::in, gcc.var_decl::in,
- io::di, io::uo) is det.
-
-add_var_overridability_flag(sealed, _GCC_Defn, !IO) :-
- unexpected($module, $pred, "`sealed' variable").
-add_var_overridability_flag(overridable, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_var_abstractness_flag(mlds.abstractness::in, gcc.var_decl::in,
- io::di, io::uo) is det.
-
-add_var_abstractness_flag(concrete, _GCC_Defn, !IO).
- % This is the default.
-add_var_abstractness_flag(abstract, _GCC_Defn, !IO) :-
- % `abstract' should only be used for fields or methods, not for variables.
- unexpected($module, $pred, "`abstract' variable").
-
-%
-% Decl flags for fields.
-%
-
-:- pred add_field_decl_flags(mlds_decl_flags::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_decl_flags(Flags, GCC_Defn, !IO) :-
- add_field_access_flag(access(Flags), GCC_Defn, !IO),
- add_field_per_instance_flag(per_instance(Flags), GCC_Defn, !IO),
- add_field_virtuality_flag(virtuality(Flags), GCC_Defn, !IO),
- add_field_overridability_flag(overridability(Flags), GCC_Defn, !IO),
- add_field_constness_flag(constness(Flags), GCC_Defn, !IO),
- add_field_abstractness_flag(abstractness(Flags), GCC_Defn, !IO).
-
-:- pred add_field_access_flag(access::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_access_flag(acc_public, _GCC_Defn, !IO).
- % This is the default.
-add_field_access_flag(acc_private, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`private' field").
-add_field_access_flag(acc_protected, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`protected' field").
-add_field_access_flag(acc_default, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`default' field").
-add_field_access_flag(acc_local, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`local' field").
-
-:- pred add_field_per_instance_flag(mlds.per_instance::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_per_instance_flag(per_instance, _GCC_Defn, !IO).
- % This is the default.
-add_field_per_instance_flag(one_copy, _GCC_Defn, !IO) :-
- % Static fields should be hoisted out as global variables.
- unexpected($module, $pred, "`static' field").
-
-:- pred add_field_virtuality_flag(virtuality::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_virtuality_flag(virtual, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`virtual' field").
-add_field_virtuality_flag(non_virtual, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_field_constness_flag(constness::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_constness_flag(const, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`const' field").
-add_field_constness_flag(modifiable, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_field_overridability_flag(overridability::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_overridability_flag(sealed, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`sealed' field").
-add_field_overridability_flag(overridable, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_field_abstractness_flag(mlds.abstractness::in, gcc.field_decl::in,
- io::di, io::uo) is det.
-
-add_field_abstractness_flag(concrete, _GCC_Defn, !IO).
- % This is the default.
-add_field_abstractness_flag(abstract, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`abstract' field").
-
-%
-% Decl flags for functions.
-%
-
-:- pred add_func_decl_flags(mlds_decl_flags::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
-add_func_decl_flags(Flags, GCC_Defn, !IO) :-
- add_func_access_flag(access(Flags), GCC_Defn, !IO),
- add_func_per_instance_flag(per_instance(Flags), GCC_Defn, !IO),
- add_func_virtuality_flag(virtuality(Flags), GCC_Defn, !IO),
- add_func_overridability_flag(overridability(Flags), GCC_Defn, !IO),
- add_func_constness_flag(constness(Flags), GCC_Defn, !IO),
- add_func_abstractness_flag(abstractness(Flags), GCC_Defn, !IO).
-
-:- pred add_func_access_flag(access::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
-add_func_access_flag(acc_public, GCC_Defn, !IO) :-
- gcc.set_func_decl_public(GCC_Defn, !IO).
-add_func_access_flag(acc_private, _GCC_Defn, !IO).
- % This is the default.
-add_func_access_flag(acc_protected, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`protected' access").
-add_func_access_flag(acc_default, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`default' access").
-add_func_access_flag(acc_local, _GCC_Defn, !IO) :-
- % Nested functions are not supported.
- sorry($module, $pred, "`local' access").
-
-:- pred add_func_per_instance_flag(mlds.per_instance::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
- % For functions, we ignore the `per_instance' flag here.
- % For global functions, this flag is meaningless;
- % and currently we don't support nested functions
- % or class member functions.
-add_func_per_instance_flag(per_instance, _GCC_Defn, !IO).
-add_func_per_instance_flag(one_copy, _GCC_Defn, !IO).
-
-:- pred add_func_virtuality_flag(virtuality::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
-add_func_virtuality_flag(virtual, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`virtual' function").
-add_func_virtuality_flag(non_virtual, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_func_constness_flag(constness::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
-add_func_constness_flag(const, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`const' function").
-add_func_constness_flag(modifiable, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_func_overridability_flag(overridability::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
-add_func_overridability_flag(sealed, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`sealed' function").
-add_func_overridability_flag(overridable, _GCC_Defn, !IO).
- % This is the default.
-
-:- pred add_func_abstractness_flag(mlds.abstractness::in, gcc.func_decl::in,
- io::di, io::uo) is det.
-
-add_func_abstractness_flag(abstract, _GCC_Defn, !IO) :-
- sorry($module, $pred, "`abstract' function").
-add_func_abstractness_flag(concrete, _GCC_Defn, !IO).
- % This is the default.
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output data declarations/definitions.
-%
-
- % Handle an MLDS data definition that is nested inside a function
- % definition (or inside a block within a function), and which is hence
- % local to that function.
- %
-:- pred build_local_data_defn(mlds_qualified_entity_name::in,
- mlds_decl_flags::in, mlds_type::in, mlds_initializer::in, defn_info::in,
- gcc.var_decl::out, io::di, io::uo) is det.
-
-build_local_data_defn(Name, Flags, Type, Initializer, DefnInfo, GCC_Defn,
- !IO) :-
- build_type(Type, get_initializer_array_size(Initializer),
- DefnInfo ^ di_global_info, GCC_Type, !IO),
- Name = qual(_ModuleName, _QualKind, UnqualName),
- ( UnqualName = entity_data(mlds_data_var(VarName0)) ->
- VarName = VarName0
- ;
- % var/1 should be the only kind of mlds_data_name for which
- % the MLDS code generator generates local definitions
- % (within functions)
- unexpected($module, $pred, "non-var")
- ),
- PerInstance = per_instance(Flags),
- (
- PerInstance = per_instance,
- % an ordinary local variable
- GCC_VarName = ml_var_name_to_string(VarName),
- gcc.build_local_var_decl(GCC_VarName, GCC_Type, GCC_Defn, !IO),
- add_var_decl_flags(Flags, GCC_Defn, !IO),
- ( Initializer = no_initializer ->
- true
- ;
- build_initializer(Initializer, GCC_Type, DefnInfo,
- GCC_InitExpr, !IO),
- gcc.gen_assign(gcc.var_expr(GCC_Defn), GCC_InitExpr, !IO)
- )
- ;
- PerInstance = one_copy,
- % a local static variable
- % these must always have initializers
- build_initializer(Initializer, GCC_Type, DefnInfo,
- GCC_InitExpr, !IO),
- GCC_VarName = ml_var_name_to_string(VarName),
- gcc.build_static_var_decl(GCC_VarName, GCC_Type, GCC_InitExpr,
- GCC_Defn, !IO),
- MangledVarName = name_mangle(GCC_VarName),
- gcc.set_var_decl_asm_name(GCC_Defn, MangledVarName, !IO),
- add_var_decl_flags(Flags, GCC_Defn, !IO),
- gcc.finish_static_var_decl(GCC_Defn, !IO)
- ).
-
- % Handle an MLDS data definition that is nested inside a type,
- % i.e. a field definition.
- %
-:- pred build_field_data_defn(mlds_qualified_entity_name::in, mlds_type::in,
- mlds_initializer::in, global_info::in, gcc.field_decl::out,
- io::di, io::uo) is det.
-
-build_field_data_defn(Name, Type, Initializer, GlobalInfo, GCC_Defn, !IO) :-
- build_type(Type, get_initializer_array_size(Initializer),
- GlobalInfo, GCC_Type, !IO),
- Name = qual(_ModuleName, _QualKind, UnqualName),
- ( UnqualName = entity_data(mlds_data_var(VarName)) ->
- GCC_VarName = ml_var_name_to_string(VarName),
- gcc.build_field_decl(GCC_VarName, GCC_Type, GCC_Defn, !IO)
- ;
- sorry($module, $pred, "non-var")
- ),
- ( Initializer = no_initializer ->
- true
- ;
- % Fields can't have initializers.
- sorry($module, $pred, "initializer")
- ).
-
-:- pred build_initializer(mlds_initializer::in, gcc.gcc_type::in,
- defn_info::in, gcc.expr::out, io::di, io::uo) is det.
-
-build_initializer(Initializer, GCC_Type, DefnInfo, GCC_Expr, !IO) :-
- (
- Initializer = no_initializer,
- unexpected($module, $pred, "no_initializer (build_initializer)")
- ;
- Initializer = init_obj(Rval),
- build_rval(Rval, DefnInfo, GCC_Expr, !IO)
- ;
- Initializer = init_struct(_Type, InitList),
- gcc.get_struct_field_decls(GCC_Type, GCC_FieldDecls, !IO),
- build_struct_initializer(InitList, GCC_FieldDecls, DefnInfo,
- GCC_InitList, !IO),
- gcc.build_initializer_expr(GCC_InitList, GCC_Type, GCC_Expr, !IO)
- ;
- Initializer = init_array(InitList),
- gcc.get_array_elem_type(GCC_Type, GCC_ElemType, !IO),
- build_array_initializer(InitList, GCC_ElemType, 0, DefnInfo,
- GCC_InitList, !IO),
- gcc.build_initializer_expr(GCC_InitList, GCC_Type, GCC_Expr, !IO)
- ).
-
-:- pred build_array_initializer(list(mlds_initializer)::in, gcc.gcc_type::in,
- int::in, defn_info::in, gcc.init_list::out, io::di, io::uo) is det.
-
-build_array_initializer([], _, _, _, GCC_InitList, !IO) :-
- gcc.empty_init_list(GCC_InitList, !IO).
-build_array_initializer([Init | Inits], GCC_ElemType, Index, DefnInfo,
- GCC_InitList, !IO) :-
- gcc.array_elem_initializer(Index, GCC_InitIndex, !IO),
- build_initializer(Init, GCC_ElemType, DefnInfo, GCC_InitValue, !IO),
- build_array_initializer(Inits, GCC_ElemType, Index + 1, DefnInfo,
- GCC_InitList0, !IO),
- gcc.cons_init_list(GCC_InitIndex, GCC_InitValue,
- GCC_InitList0, GCC_InitList, !IO).
-
-:- pred build_struct_initializer(list(mlds_initializer)::in,
- gcc.field_decls::in, defn_info::in, gcc.init_list::out,
- io::di, io::uo) is det.
-
-build_struct_initializer([], _, _, GCC_InitList, !IO) :-
- gcc.empty_init_list(GCC_InitList, !IO).
-build_struct_initializer([Init | Inits], GCC_FieldDecls, DefnInfo,
- GCC_InitList, !IO) :-
- gcc.next_field_decl(GCC_FieldDecls, GCC_ThisFieldDecl,
- GCC_RemainingFieldDecls, !IO),
- gcc.struct_field_initializer(GCC_ThisFieldDecl, GCC_InitField, !IO),
- gcc.field_type(GCC_ThisFieldDecl, GCC_ThisFieldType, !IO),
- build_initializer(Init, GCC_ThisFieldType, DefnInfo, GCC_InitValue, !IO),
- build_struct_initializer(Inits, GCC_RemainingFieldDecls, DefnInfo,
- GCC_InitList0, !IO),
- gcc.cons_init_list(GCC_InitField, GCC_InitValue,
- GCC_InitList0, GCC_InitList, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output type definitions.
-%
-
-:- pred gen_class(mlds_qualified_entity_name::in, mlds_context::in,
- mlds_class_defn::in, global_info::in, global_info::out,
- io::di, io::uo) is det.
-
-gen_class(Name, Context, ClassDefn, !GlobalInfo, !IO) :-
- % To avoid name clashes, we need to qualify the names of the member
- % constants with the class name.
- % (In particular, this is needed for enumeration constants
- % and for the nested classes that we generate for constructors
- % of discriminated union types.)
- % Here we compute the appropriate qualifier.
-
- Name = qual(ModuleName, QualKind, UnqualName),
- Globals = !.GlobalInfo ^ gi_globals,
- ( UnqualName = entity_type(ClassName, ClassArity) ->
- globals.get_target(Globals, Target),
- ClassModuleName = mlds_append_class_qualifier(Target, ModuleName,
- QualKind, ClassName, ClassArity)
- ;
- unexpected($module, $pred, "unexpected entity")
- ),
-
- % Hoist out static members, since plain old C doesn't support
- % static members in structs (except for enumeration constants).
- %
- % XXX this should be conditional: only when compiling to C,
- % not when compiling to C++
-
- ClassDefn = mlds_class_defn(Kind, _Imports, BaseClasses, _Implements,
- _TypeParams, Ctors, AllMembers),
- (
- Ctors = []
- ;
- Ctors = [_ | _],
- unexpected($module, $pred, "constructors")
- ),
- ( Kind = mlds_enum ->
- StaticMembers = [],
- StructMembers = AllMembers
- ;
- list.filter(is_static_member, AllMembers, StaticMembers,
- NonStaticMembers),
- StructMembers = NonStaticMembers
- ),
-
- % Convert the base classes into member variables,
- % since plain old C doesn't support base classes.
- %
- % This is copied from the MLDS->C back-end.
- % We could probably handle it more directly for the MLDS->GCC back-end,
- % but doing it this way is simple enough, and works.
-
- list.map_foldl(mlds_make_base_class(Context),
- BaseClasses, BaseDefns, 1, _),
- list.append(BaseDefns, StructMembers, BasesAndMembers),
-
- % Output the class declaration and the class members.
- % We treat enumerations specially.
- ( Kind = mlds_enum ->
- % XXX enumeration definitions are not yet implemented
- sorry($module, $pred, "enum type (`--high-level-data' not yet "
- ++ "implemented for `--target asm')")
- /************
- mlds_output_class_decl(Indent, Name, ClassDefn),
- io.write_string(" {\n"),
- mlds_output_enum_constants(Indent + 1, ClassModuleName,
- BasesAndMembers)
- *************/
- ;
- % Build a gcc declaration node for the struct and for the fields
- % it contains. Create a field table mapping the field names
- % to their respective nodes.
- map.init(FieldTable0),
- build_field_defns(BasesAndMembers, ClassModuleName,
- !.GlobalInfo, FieldDecls, FieldTable0, FieldTable, !IO),
- AsmStructName = build_qualified_name(Name),
- gcc.build_struct_type_decl(AsmStructName,
- FieldDecls, StructTypeDecl, !IO),
-
- % Insert the gcc declaration node and the field table
- % for this type into the global type table
- TypeTable0 = !.GlobalInfo ^ gi_type_table,
- map.det_insert(Name, gcc_type_info(StructTypeDecl, FieldTable),
- TypeTable0, TypeTable),
- !GlobalInfo ^ gi_type_table := TypeTable
- ),
-
- % Output the static members.
- gen_defns(ClassModuleName, StaticMembers, !GlobalInfo, !IO).
-
-:- pred is_static_member(mlds_defn::in) is semidet.
-
-is_static_member(Defn) :-
- Defn = mlds_defn(Name, _, Flags, _),
- ( Name = entity_type(_, _)
- ; per_instance(Flags) = one_copy
- ).
-
- % Convert a base class class_id into a member variable
- % that holds the value of the base class.
- %
-:- pred mlds_make_base_class(mlds_context::in, mlds_class_id::in,
- mlds_defn::out, int::in, int::out) is det.
-
-mlds_make_base_class(Context, ClassId, MLDS_Defn, BaseNum0, BaseNum) :-
- BaseName = string.format("base_%d", [i(BaseNum0)]),
- Type = ClassId,
- % We only need GC tracing code for top-level variables,
- % not for base classes.
- GCStatement = gc_no_stmt,
- MLDS_Defn = mlds_defn(
- entity_data(mlds_data_var(mlds_var_name(BaseName, no))), Context,
- ml_gen_public_field_decl_flags,
- mlds_data(Type, no_initializer, GCStatement)),
- BaseNum = BaseNum0 + 1.
-
-/***********
-XXX enumeration definitions are not yet implemented for mlds_to_gcc.m.
-The following code for handling enumeration definitions is copied from
-mlds_to_c.m. It shows what we should generate.
-
-:- pred mlds_output_class_decl(indent, mlds_qualified_entity_name,
- mlds_class_defn, io::di, io::uo) is det.
-:- mode mlds_output_class_decl(in, in, in, di, uo) is det.
-
-mlds_output_class_decl(_Indent, Name, ClassDefn) -->
- ( { ClassDefn^kind = mlds_enum } ->
- io.write_string("enum "),
- mlds_output_fully_qualified_name(Name),
- io.write_string("_e")
- ;
- io.write_string("struct "),
- mlds_output_fully_qualified_name(Name),
- io.write_string("_s")
- ).
-
- % Output the definitions of the enumeration constants
- % for an enumeration type.
- %
-:- pred mlds_output_enum_constants(indent, mlds_module_name,
- list(mlds_defn), io::di, io::uo) is det.
-:- mode mlds_output_enum_constants(in, in, in, di, uo) is det.
-
-mlds_output_enum_constants(Indent, EnumModuleName, Members) -->
- %
- % Select the enumeration constants from the list of members
- % for this enumeration type, and output them.
- %
- { EnumConsts = list.filter(is_enum_const, Members) },
- io.write_list(EnumConsts, ",\n",
- mlds_output_enum_constant(Indent, EnumModuleName)),
- io.nl.
-
- % Test whether one of the members of an mlds_enum class
- % is an enumeration constant.
- %
-:- pred is_enum_const(mlds_defn).
-:- mode is_enum_const(in) is semidet.
-
-is_enum_const(Defn) :-
- Defn = mlds_defn(_Name, _Context, Flags, _DefnBody),
- constness(Flags) = const.
-
- % Output the definition of a single enumeration constant.
- %
-:- pred mlds_output_enum_constant(indent, mlds_module_name, mlds_defn,
- io::di, io::uo) is det.
-:- mode mlds_output_enum_constant(in, in, in, di, uo) is det.
-
-mlds_output_enum_constant(Indent, EnumModuleName, Defn) -->
- { Defn = mlds_defn(Name, Context, _Flags, DefnBody) },
- (
- { DefnBody = data(Type, Initializer) }
- ->
- mlds_indent(Context, Indent),
- mlds_output_fully_qualified_name(
- qual(EnumModuleName, type_qual, Name)),
- mlds_output_initializer(Type, Initializer)
- ;
- { unexpected($module, $pred, "constant is not data") }
- ).
-
-***********/
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output function declarations/definitions.
-%
-
-:- pred gen_func(mlds_qualified_entity_name::in, mlds_context::in,
- mlds_decl_flags::in, mlds_func_params::in, mlds_function_body::in,
- global_info::in, global_info::out, io::di, io::uo) is det.
-
-gen_func(Name, Context, Flags, Signature, MaybeBody, !GlobalInfo, !IO) :-
- (
- MaybeBody = body_external
- ;
- MaybeBody = body_defined_here(Body),
- gcc.push_gc_context(!IO),
- make_func_decl_for_defn(Name, Signature, !.GlobalInfo,
- FuncDecl, SymbolTable, !IO),
- add_func_decl_flags(Flags, FuncDecl, !IO),
- build_label_table(Body, LabelTable, !IO),
- DefnInfo = defn_info(!.GlobalInfo, Name, SymbolTable, LabelTable),
- set_context(Context, !IO),
- gcc.start_function(FuncDecl, !IO),
- % mlds_maybe_output_time_profile_instr(Context, Name, !IO)
- gen_statement(DefnInfo, Body, !IO),
- set_context(Context, !IO),
- gcc.end_function(!IO),
- gcc.pop_gc_context(!IO)
- ).
-
- % Before generating code for a function, we build a table of all the label
- % declarations in that function body.
- %
-:- pred build_label_table(statement::in, label_table::out,
- io::di, io::uo) is det.
-
-build_label_table(Statement, LabelTable, !IO) :-
- solutions.solutions(statement_contains_label(Statement), Labels),
- list.map_foldl(gcc.build_label, Labels, GCC_LabelDecls, !IO),
- map.from_corresponding_lists(Labels, GCC_LabelDecls, LabelTable).
-
-:- pred statement_contains_label(statement::in, mlds_label::out) is nondet.
-
-statement_contains_label(Statement, Label) :-
- statement_contains_statement(Statement, SubStatement),
- SubStatement = statement(ml_stmt_label(Label), _).
-
- % XXX We should lookup the existing definition, if there is one,
- % rather than always making a new one.
- %
-:- pred make_func_decl(mlds_qualified_entity_name::in, mlds_func_signature::in,
- global_info::in, gcc.func_decl::out, io::di, io::uo) is det.
-
-make_func_decl(Name, Signature, GlobalInfo, GCC_FuncDecl, !IO) :-
- Signature = mlds_func_signature(Arguments, ReturnTypes),
- get_return_type(ReturnTypes, GlobalInfo, RetType, !IO),
- get_qualified_func_name(Name, _ModuleName, FuncName, AsmFuncName),
- build_param_types(Arguments, GlobalInfo, GCC_Types, GCC_ParamTypes, !IO),
- build_dummy_param_decls(GCC_Types, GCC_ParamDecls, !IO),
- gcc.build_function_decl(FuncName, AsmFuncName,
- RetType, GCC_ParamTypes, GCC_ParamDecls, GCC_FuncDecl, !IO).
-
-:- pred build_dummy_param_decls(list(gcc.gcc_type)::in, gcc.param_decls::out,
- io::di, io::uo) is det.
-
-build_dummy_param_decls([], gcc.empty_param_decls, !IO).
-build_dummy_param_decls([Type | Types],
- gcc.cons_param_decls(ParamDecl, ParamDecls), !IO) :-
- gcc.build_param_decl("<unnamed param>", Type, ParamDecl, !IO),
- build_dummy_param_decls(Types, ParamDecls, !IO).
-
- % Like make_func_decl, except that it fills in the
- % function parameters properly
- %
-:- pred make_func_decl_for_defn(mlds_qualified_entity_name::in,
- mlds_func_params::in, global_info::in, gcc.func_decl::out,
- symbol_table::out, io::di, io::uo) is det.
-
-make_func_decl_for_defn(Name, Parameters, GlobalInfo, FuncDecl, SymbolTable,
- !IO) :-
- Parameters = mlds_func_params(Arguments, ReturnTypes),
- get_return_type(ReturnTypes, GlobalInfo, RetType, !IO),
- get_qualified_func_name(Name, ModuleName, FuncName, AsmFuncName),
- build_param_types_and_decls(Arguments, ModuleName, GlobalInfo,
- ParamTypes, ParamDecls, SymbolTable, !IO),
- gcc.build_function_decl(FuncName, AsmFuncName,
- RetType, ParamTypes, ParamDecls, FuncDecl, !IO).
-
-:- pred get_return_type(list(mlds_type)::in, global_info::in,
- gcc.gcc_type::out, io::di, io::uo) is det.
-
-get_return_type(List, GlobalInfo, GCC_Type, !IO) :-
- (
- List = [],
- GCC_Type = gcc.void_type_node
- ;
- List = [Type],
- build_type(Type, GlobalInfo, GCC_Type, !IO)
- ;
- List = [_, _ | _],
- unexpected($module, $pred, "multiple return types")
- ).
-
- % get_func_name(Name, ModuleName, FuncName, AsmFuncName):
- %
- % Get the module name and the function name.
- % `FuncName' is the name used for generating debug symbols,
- % whereas `AsmFuncName' is what we actually spit out in the
- % assembler file.
- %
-:- pred get_qualified_func_name(mlds_qualified_entity_name::in,
- mlds_module_name::out, string::out, string::out) is det.
-
-get_qualified_func_name(Name, ModuleName, FuncName, AsmFuncName) :-
- Name = qual(ModuleName, _QualKind, EntityName),
- get_func_name(EntityName, FuncName, AsmFuncName0),
- maybe_add_module_qualifier(Name, AsmFuncName0, AsmFuncName).
-
- % get_func_name(Name, FuncName, AsmFuncName):
- %
- % Get the function name (without any module qualifier).
- % `FuncName' is the name used for generating debug symbols,
- % whereas `AsmFuncName' is what we actually spit out in the
- % assembler file.
- %
-:- pred get_func_name(mlds_entity_name::in, string::out, string::out) is det.
-
-get_func_name(FunctionName, FuncName, AsmFuncName) :-
- (
- FunctionName = entity_function(PredLabel, ProcId, MaybeSeqNum,
- _PredId)
- ->
- % Generate the AsmFuncName
- % This needs to be fully name mangled to ensure that it
- % is unique.
- %
- % XXX We should consider not appending the modenum and seqnum
- % if they are not needed.
- %
- get_pred_label_name(PredLabel, AsmFuncName0),
- proc_id_to_int(ProcId, ProcIdNum),
- (
- MaybeSeqNum = yes(SeqNum),
- AsmFuncName = string.format("%s_%d_%d",
- [s(AsmFuncName0), i(ProcIdNum), i(SeqNum)])
- ;
- MaybeSeqNum = no,
- AsmFuncName = string.format("%s_%d",
- [s(AsmFuncName0), i(ProcIdNum)])
- ),
-
- % Generate the FuncName.
- % This is for human consumption, and does not necessarily
- % need to be unique.
- (
- PredLabel = mlds_user_pred_label(_PorF, _ModuleName,
- PredName, _Arity, _CodeModel, _NonOutputFunc),
- FuncName = PredName
- ;
- PredLabel = mlds_special_pred_label(SpecialPredName,
- _ModuleName, TypeName, _Arity),
- FuncName = SpecialPredName ++ TypeName
- )
- ;
- unexpected($module, $pred, "non-function")
- ).
-
- % XXX Same as mlds_output_pred_label in mlds_to_c, except that
- % it returns a string.
- %
-:- pred get_pred_label_name(mlds_pred_label::in, string::out) is det.
-
-get_pred_label_name(PredLabel, LabelName) :-
- (
- PredLabel = mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
- Arity, _CodeMode, _NonOutputFunc),
- ( PredOrFunc = pf_predicate, Suffix = "p"
- ; PredOrFunc = pf_function, Suffix = "f"
- ),
- MangledName = name_mangle(Name),
- string.format("%s_%d_%s", [s(MangledName), i(Arity), s(Suffix)],
- LabelName0),
- ( MaybeDefiningModule = yes(DefiningModule) ->
- LabelName = LabelName0 ++ "_in__" ++
- get_module_name(DefiningModule)
- ;
- LabelName = LabelName0
- )
- ;
- PredLabel = mlds_special_pred_label(PredName, MaybeTypeModule,
- TypeName, TypeArity),
- MangledPredName = name_mangle(PredName),
- MangledTypeName = name_mangle(TypeName),
- TypeNameString = string.format("%s_%d",
- [s(MangledTypeName), i(TypeArity)]),
- (
- MaybeTypeModule = yes(TypeModule),
- TypeNameList = [get_module_name(TypeModule), "__", TypeNameString]
- ;
- MaybeTypeModule = no,
- TypeNameList = [TypeNameString]
- ),
- LabelName = string.append_list([MangledPredName, "__" | TypeNameList])
- ).
-
-:- func get_module_name(module_name) = string.
-
-get_module_name(ModuleName) = sym_name_mangle(ModuleName).
-
-:- pred build_param_types(mlds_arg_types::in, global_info::in,
- list(gcc.gcc_type)::out, gcc.param_types::out,
- io::di, io::uo) is det.
-
-build_param_types(ArgTypes, GlobalInfo, GCC_Types, ParamTypes, !IO) :-
- build_param_types(ArgTypes, GlobalInfo, GCC_Types,
- gcc.empty_param_types, ParamTypes, !IO).
-
- % Build a list of parameter types, and prepend this list to the
- % gcc.param_types list passed as input.
- %
-:- pred build_param_types(mlds_arg_types::in, global_info::in,
- list(gcc.gcc_type)::out, gcc.param_types::in, gcc.param_types::out,
- io::di, io::uo) is det.
-
-build_param_types([], _, [], ParamTypes, ParamTypes, !IO).
-build_param_types([ArgType | ArgTypes], GlobalInfo, [GCC_Type | GCC_Types],
- ParamTypes0, ParamTypes, !IO) :-
- build_param_types(ArgTypes, GlobalInfo, GCC_Types,
- ParamTypes0, ParamTypes1, !IO),
- build_type(ArgType, GlobalInfo, GCC_Type, !IO),
- ParamTypes = gcc.cons_param_types(GCC_Type, ParamTypes1).
-
-:- pred build_param_types_and_decls(mlds_arguments::in, mlds_module_name::in,
- global_info::in, gcc.param_types::out, gcc.param_decls::out,
- symbol_table::out, io::di, io::uo) is det.
-
-build_param_types_and_decls([], _, _, gcc.empty_param_types,
- gcc.empty_param_decls, SymbolTable, !IO) :-
- map.init(SymbolTable).
-build_param_types_and_decls([Arg | Args], ModuleName, GlobalInfo,
- ParamTypes, ParamDecls, SymbolTable, !IO) :-
- build_param_types_and_decls(Args, ModuleName, GlobalInfo,
- ParamTypes0, ParamDecls0, SymbolTable0, !IO),
- Arg = mlds_argument(ArgName, Type, _Statement),
- build_type(Type, GlobalInfo, GCC_Type, !IO),
- ( ArgName = entity_data(mlds_data_var(ArgVarName)) ->
- GCC_ArgVarName = ml_var_name_to_string(ArgVarName),
- gcc.build_param_decl(GCC_ArgVarName, GCC_Type, ParamDecl, !IO),
- SymbolTable = map.det_insert(SymbolTable0,
- qual(ModuleName, module_qual, ArgName), ParamDecl)
- ;
- unexpected($module, $pred, "invalid param name")
- ),
- ParamTypes = gcc.cons_param_types(GCC_Type, ParamTypes0),
- ParamDecls = gcc.cons_param_decls(ParamDecl, ParamDecls0).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to build types.
-%
-
-:- pred build_type(mlds_type::in, global_info::in, gcc.gcc_type::out,
- io::di, io::uo) is det.
-
-build_type(Type, GlobalInfo, GCC_Type, !IO) :-
- build_type(Type, no_size, GlobalInfo, GCC_Type, !IO).
-
-:- pred build_type(mlds_type::in, initializer_array_size::in,
- global_info::in, gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_type(Type, ArraySize, GlobalInfo, GCC_Type, !IO) :-
- (
- Type = mlds_mercury_array_type(_ElemType),
- % Just represent Mercury arrays as MR_Word.
- GCC_Type = 'MR_Word'
- ;
- Type = mercury_type(MercuryType, TypeCategory, _),
- build_mercury_type(MercuryType, TypeCategory, GCC_Type, !IO)
- ;
- Type = mlds_foreign_type(_),
- GCC_Type = 'MR_Box'
- ;
- Type = mlds_native_int_type,
- GCC_Type = gcc.integer_type_node
- ;
- Type = mlds_native_float_type,
- GCC_Type = gcc.double_type_node
- ;
- Type = mlds_native_bool_type,
- GCC_Type = gcc.boolean_type_node
- ;
- Type = mlds_native_char_type,
- GCC_Type = gcc.char_type_node
- ;
- Type = mlds_class_type(Name, Arity, ClassKind),
- ( ClassKind = mlds_enum ->
- % XXX following comment is copied from mlds_to_c;
- % it is wrong for mlds_to_gcc back-end
- %
- % We can't just use the enumeration type,
- % since the enumeration type's definition
- % is not guaranteed to be in scope at this point.
- % (Fixing that would be somewhat complicated; it would
- % require writing enum definitions to a separate header file.)
- % Also the enumeration might not be word-sized,
- % which would cause problems for e.g. `std_util:arg/2'.
- % So we just use `MR_Integer'.
-
- GCC_Type = 'MR_Integer'
- ;
- % Check to see whether we already have a definition for
- % this type.
-
- Name = qual(ModuleName, QualKind, TypeName),
- EntityName = qual(ModuleName, QualKind,
- entity_type(TypeName, Arity)),
- (
- map.search(GlobalInfo ^ gi_type_table, EntityName,
- gcc_type_info(GCC_TypeDecl, _))
- ->
- GCC_Type = gcc.declared_type(GCC_TypeDecl)
- ;
- % The type was not already defined.
- % This case only arises with `--high-level-data'.
- % For struct types which are not defined in this
- % module, it's OK to use an incomplete type,
- % since don't use such types directly, we only
- % use pointers to them.
- %
- % XXX currently we use `void' as the canonical
- % incomplete type. Probably it would be better
- % to generate an incomplete struct type decl
- % for each struct type.
-
- GCC_Type = gcc.void_type_node,
-
- % XXX The I/O code below is just for debugging,
- % and should eventually be removed.
- io.write_string("note: undeclared class_type ", !IO),
- io.print(EntityName, !IO),
- io.write_string(", i.e. ", !IO),
- AsmName = build_qualified_name(EntityName),
- io.write_string(AsmName, !IO),
- io.nl(!IO)
- )
- )
- ;
- Type = mlds_ptr_type(BaseType),
- build_type(BaseType, GlobalInfo, GCC_BaseType, !IO),
- gcc.build_pointer_type(GCC_BaseType, GCC_Type, !IO)
- ;
- Type = mlds_array_type(BaseType),
- build_type(BaseType, GlobalInfo, GCC_BaseType, !IO),
- build_sized_array_type(GCC_BaseType, ArraySize, GCC_Type, !IO)
- ;
- Type = mlds_mostly_generic_array_type(_),
- BaseType = mlds_generic_type,
- build_type(BaseType, GlobalInfo, GCC_BaseType, !IO),
- build_sized_array_type(GCC_BaseType, ArraySize, GCC_Type, !IO)
- ;
- Type = mlds_func_type(Params),
- Signature = mlds_get_func_signature(Params),
- Signature = mlds_func_signature(ArgTypes, RetTypes),
- (
- RetTypes = [],
- GCC_RetType = gcc.void_type_node
- ;
- RetTypes = [RetType],
- build_type(RetType, no_size, GlobalInfo, GCC_RetType, !IO)
- ;
- RetTypes = [_, _ | _],
- sorry($module, $pred, "multiple return types")
- ),
- build_param_types(ArgTypes, GlobalInfo, _, GCC_ParamTypes, !IO),
- gcc.build_function_type(GCC_RetType, GCC_ParamTypes,
- GCC_FuncType, !IO),
- gcc.build_pointer_type(GCC_FuncType, GCC_Type, !IO)
- ;
- Type = mlds_generic_type,
- GCC_Type = 'MR_Box'
- ;
- Type = mlds_generic_env_ptr_type,
- GCC_Type = gcc.ptr_type_node
- ;
- Type = mlds_type_info_type,
- GCC_Type = 'MR_TypeInfo'
- ;
- Type = mlds_pseudo_type_info_type,
- GCC_Type = 'MR_PseudoTypeInfo'
- ;
- Type = mlds_cont_type(ArgTypes),
- % mlds_to_c treats the ArgTypes = [] case specially -- it generates
- % references to typedefs `MR_NestedCont' and `MR_Cont', which are
- % defined as follows:
- % typedef void MR_CALL (*MR_NestedCont)(void)
- % typedef void MR_CALL (*MR_Cont)(void *)
- % However, the generic code here works fine for those cases too,
- % i.e. it generates the same types.
-
- % First get the type for the environment parameter, if needed.
- Globals = GlobalInfo ^ gi_globals,
- globals.lookup_bool_option(Globals, gcc_nested_functions,
- GCC_NestedFuncs),
- (
- GCC_NestedFuncs = no,
- GCC_ParamTypes0 = gcc.cons_param_types(gcc.ptr_type_node,
- gcc.empty_param_types)
- ;
- GCC_NestedFuncs = yes,
- GCC_ParamTypes0 = gcc.empty_param_types
- ),
- % Then prepend the types for the other arguments.
- build_param_types(ArgTypes, GlobalInfo, _GCC_Types,
- GCC_ParamTypes0, GCC_ParamTypes, !IO),
- gcc.build_function_type(gcc.void_type_node, GCC_ParamTypes, FuncType,
- !IO),
- gcc.build_pointer_type(FuncType, GCC_Type, !IO)
- ;
- Type = mlds_commit_type,
- GCC_Type = gcc.jmpbuf_type_node
- ;
- Type = mlds_rtti_type(RttiIdMaybeElement),
- build_rtti_type(RttiIdMaybeElement, ArraySize, GCC_Type, !IO)
- ;
- Type = mlds_tabling_type(_TablingId),
- sorry($module, $pred, "NYI: tabling in the asm backend")
- ;
- Type = mlds_unknown_type,
- unexpected($module, $pred, "unknown type")
- ).
-
-:- pred build_mercury_type(mer_type::in, type_ctor_category::in,
- gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_mercury_type(Type, CtorCat, GCC_Type, !IO) :-
- (
- CtorCat = ctor_cat_builtin(cat_builtin_char),
- GCC_Type = 'MR_Char'
- ;
- CtorCat = ctor_cat_builtin(cat_builtin_int),
- GCC_Type = 'MR_Integer'
- ;
- CtorCat = ctor_cat_builtin(cat_builtin_string),
- GCC_Type = 'MR_String'
- ;
- CtorCat = ctor_cat_builtin(cat_builtin_float),
- GCC_Type = 'MR_Float'
- ;
- CtorCat = ctor_cat_void,
- GCC_Type = 'MR_Word'
- ;
- CtorCat = ctor_cat_system(cat_system_type_info),
- build_mercury_type(Type, ctor_cat_user(cat_user_general),
- GCC_Type, !IO)
- ;
- CtorCat = ctor_cat_system(cat_system_type_ctor_info),
- build_mercury_type(Type, ctor_cat_user(cat_user_general),
- GCC_Type, !IO)
- ;
- CtorCat = ctor_cat_system(cat_system_typeclass_info),
- GCC_Type = 'MR_Word'
- ;
- CtorCat = ctor_cat_system(cat_system_base_typeclass_info),
- GCC_Type = 'MR_Word'
- ;
- CtorCat = ctor_cat_variable,
- GCC_Type = 'MR_Box'
- ;
- CtorCat = ctor_cat_tuple,
- % tuples are always (pointers to)
- % arrays of polymorphic terms
- gcc.build_pointer_type('MR_Box', MR_Tuple, !IO),
- GCC_Type = MR_Tuple
- ;
- CtorCat = ctor_cat_higher_order,
- GCC_Type = 'MR_Word'
- ;
- ( CtorCat = ctor_cat_enum(_)
- ; CtorCat = ctor_cat_builtin_dummy
- ),
- % Note that the MLDS -> C back-end uses 'MR_Word' here,
- % unless --high-level-data is enabled. But 'MR_Integer'
- % seems better, I think. It probably doesn't make any real
- % difference either way.
- % XXX for --high-level-data, we should use a real enum type
- GCC_Type = 'MR_Integer'
- ;
- CtorCat = ctor_cat_user(_),
- GCC_Type = 'MR_Word'
- ).
-
-:- pred build_sized_array_type(gcc.gcc_type::in, initializer_array_size::in,
- gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_sized_array_type(GCC_Type, ArraySize, GCC_ArrayType, !IO) :-
- ( ArraySize = no_size, Size = 0
- ; ArraySize = array_size(Size)
- ),
- gcc.build_array_type(GCC_Type, Size, GCC_ArrayType, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to build RTTI types.
-%
-
-% The types constructed here should be the same as the types
-% defined in runtime/mercury_type_info.h for the C back-end.
-% See that file for documentation on these types.
-
-% XXX We should consider avoiding the code duplication, by
-% generating the relevant parts of runtime/mercury_type_info.h
-% automatically, from a Mercury data structure describing the
-% types. The same Mercury data structure could be used here.
-
-% XXX it would be more efficient to construct these types once,
-% at initialization time, rather than every time they are used.
-
-:- pred build_rtti_type(rtti_id_maybe_element::in, initializer_array_size::in,
- gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_rtti_type(RttiIdMaybeElement, Size, GCC_Type, !IO) :-
- (
- RttiIdMaybeElement = item_type(RttiId)
- ;
- RttiIdMaybeElement = element_type(RttiId)
- ),
- (
- RttiId = ctor_rtti_id(_, RttiName),
- build_rtti_type_name(RttiName, BaseType, !IO)
- ;
- RttiId = tc_rtti_id(_, TCRttiName),
- build_rtti_type_tc_name(TCRttiName, BaseType, !IO)
- ),
- IsArray = rtti_id_has_array_type(RttiId),
- (
- RttiIdMaybeElement = item_type(_),
- (
- IsArray = not_array,
- GCC_Type = BaseType
- ;
- IsArray = is_array,
- build_sized_array_type(BaseType, Size, GCC_Type, !IO)
- )
- ;
- RttiIdMaybeElement = element_type(_),
- expect(unify(IsArray, is_array), $module, $pred,
- "element of non-array"),
- GCC_Type = BaseType
- ).
-
-:- pred build_rtti_type_name(ctor_rtti_name::in, gcc.gcc_type::out,
- io::di, io::uo) is det.
-
-build_rtti_type_name(type_ctor_exist_locns(_), GCC_Type, !IO) :-
- build_du_exist_locn_type(GCC_Type, !IO).
-build_rtti_type_name(type_ctor_exist_locn, GCC_Type, !IO) :-
- build_du_exist_locn_type(GCC_Type, !IO).
-build_rtti_type_name(type_ctor_exist_tc_constr(_, _, N), GCC_Type, !IO) :-
- build_tc_constr_struct_type(N, GCC_Type, !IO).
-build_rtti_type_name(type_ctor_exist_tc_constrs(_), GCC_Type, !IO) :-
- build_tc_constr_type(GCC_Type, !IO).
-build_rtti_type_name(type_ctor_exist_info(_), GCC_Type, !IO) :-
- build_du_exist_info_type(GCC_Type, !IO).
-build_rtti_type_name(type_ctor_field_names(_), 'MR_ConstString', !IO).
-build_rtti_type_name(type_ctor_field_types(_), 'MR_PseudoTypeInfo', !IO).
-build_rtti_type_name(type_ctor_field_locns(_), _, !IO) :-
- sorry($module, $pred, "MR_DuArgLocn").
-build_rtti_type_name(type_ctor_res_addrs, gcc.ptr_type_node, !IO).
-build_rtti_type_name(type_ctor_res_addr_functors, gcc.ptr_type_node, !IO).
-build_rtti_type_name(type_ctor_enum_functor_desc(_), GCC_Type, !IO) :-
- % typedef struct {
- % MR_ConstString MR_enum_functor_name;
- % MR_int_least32_t MR_enum_functor_ordinal;
- % } MR_EnumFunctorDesc;
- build_struct_type("MR_EnumFunctorDesc",
- ['MR_ConstString' - "MR_enum_functor_name",
- 'MR_int_least32_t' - "MR_enum_functor_ordinal"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_foreign_enum_functor_desc(_), _, _, _) :-
- sorry($module, $pred, "NYI foreign enums and asm backend").
-build_rtti_type_name(type_ctor_notag_functor_desc, GCC_Type, !IO) :-
- % typedef struct {
- % MR_ConstString MR_notag_functor_name;
- % MR_PseudoTypeInfo MR_notag_functor_arg_type;
- % MR_ConstString MR_notag_functor_arg_name;
- % } MR_NotagFunctorDesc;
- build_struct_type("MR_NotagFunctorDesc",
- ['MR_ConstString' - "MR_notag_functor_name",
- 'MR_PseudoTypeInfo' - "MR_notag_functor_arg_type",
- 'MR_ConstString' - "MR_notag_functor_arg_name"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_du_functor_desc(_), GCC_Type, !IO) :-
- % typedef struct {
- % MR_ConstString MR_du_functor_name;
- % MR_int_least16_t MR_du_functor_orig_arity;
- % MR_int_least16_t MR_du_functor_arg_type_contains_var;
- % MR_Sectag_Locn MR_du_functor_sectag_locn;
- % MR_int_least8_t MR_du_functor_primary;
- % MR_int_least32_t MR_du_functor_secondary;
- % MR_int_least32_t MR_du_functor_ordinal;
- % const MR_PseudoTypeInfo *MR_du_functor_arg_types;
- % const MR_ConstString *MR_du_functor_arg_names;
- % const MR_DuExistInfo *MR_du_functor_exist_info;
- % const MR_DuArgLocn *MR_du_functor_arg_locns; /* XXX not yet */
- % } MR_DuFunctorDesc;
- build_du_exist_info_type(MR_DuExistInfo, !IO),
- gcc.build_pointer_type('MR_PseudoTypeInfo', MR_PseudoTypeInfoPtr, !IO),
- gcc.build_pointer_type(MR_DuExistInfo, MR_DuExistInfoPtr, !IO),
- gcc.build_pointer_type('MR_ConstString', MR_ConstStringPtr, !IO),
- build_struct_type("MR_DuFunctorDesc",
- ['MR_ConstString' - "MR_du_functor_name",
- 'MR_int_least16_t' - "MR_du_functor_orig_arity",
- 'MR_int_least16_t' - "MR_du_functor_arg_type_contains_var",
- 'MR_Sectag_Locn' - "MR_du_functor_sectag_locn",
- 'MR_int_least8_t' - "MR_du_functor_primary",
- 'MR_int_least32_t' - "MR_du_functor_secondary",
- 'MR_int_least32_t' - "MR_du_functor_ordinal",
- MR_PseudoTypeInfoPtr - "MR_du_functor_arg_types",
- MR_ConstStringPtr - "MR_du_functor_arg_names",
- MR_DuExistInfoPtr - "MR_du_functor_exist_info"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_res_functor_desc(_), GCC_Type, !IO) :-
- % typedef struct {
- % MR_ConstString MR_ra_functor_name;
- % MR_int_least32_t MR_ra_functor_ordinal;
- % const void * MR_ra_functor_reserved_addr;
- % } MR_ReservedAddrFunctorDesc;
- build_struct_type("MR_ReservedAddrFunctorDesc",
- ['MR_ConstString' - "MR_ra_functor_name",
- 'MR_int_least32_t' - "MR_ra_functor_ordinal",
- gcc.ptr_type_node - "MR_ra_functor_reserved_addr"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_enum_name_ordered_table, gcc.ptr_type_node,
- !IO).
-build_rtti_type_name(type_ctor_enum_value_ordered_table, gcc.ptr_type_node,
- !IO).
-build_rtti_type_name(type_ctor_foreign_enum_name_ordered_table,
- gcc.ptr_type_node, !IO).
-build_rtti_type_name(type_ctor_foreign_enum_ordinal_ordered_table,
- gcc.ptr_type_node, !IO).
-build_rtti_type_name(type_ctor_du_name_ordered_table, gcc.ptr_type_node, !IO).
-build_rtti_type_name(type_ctor_du_stag_ordered_table(_), gcc.ptr_type_node,
- !IO).
-build_rtti_type_name(type_ctor_du_ptag_ordered_table, GCC_Type, !IO) :-
- build_rtti_type_name(type_ctor_du_ptag_layout(0), GCC_Type, !IO).
-build_rtti_type_name(type_ctor_du_ptag_layout(_), GCC_Type, !IO) :-
- % typedef struct {
- % MR_int_least32_t MR_sectag_sharers;
- % MR_Sectag_Locn MR_sectag_locn;
- % const MR_DuFunctorDesc * const * MR_sectag_alternatives;
- % } MR_DuPtagLayout;
- build_struct_type("MR_DuPtagLayout",
- ['MR_int_least32_t' - "MR_sectag_sharers",
- 'MR_Sectag_Locn' - "MR_sectag_locn",
- gcc.ptr_type_node - "MR_sectag_alternatives"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_res_value_ordered_table, GCC_Type, !IO) :-
- % typedef struct {
- % MR_int_least16_t MR_ra_num_res_numeric_addrs;
- % MR_int_least16_t MR_ra_num_res_symbolic_addrs;
- % const void * const *MR_ra_res_symbolic_addrs;
- % const MR_ReservedAddrFunctorDesc * const * MR_ra_constants;
- % MR_DuTypeLayout MR_ra_other_functors;
- % } MR_ReservedAddrTypeDesc;
- build_struct_type("MR_ReservedAddrTypeDesc",
- ['MR_int_least16_t' - "MR_ra_num_res_numeric_addrs",
- 'MR_int_least16_t' - "MR_ra_num_res_symbolic_addrs",
- gcc.ptr_type_node - "MR_ra_res_symbolic_addrs",
- gcc.ptr_type_node - "MR_ra_constants",
- gcc.ptr_type_node - "MR_ra_other_functors"
- ], GCC_Type, !IO).
-build_rtti_type_name(type_ctor_res_name_ordered_table, GCC_Type, !IO) :-
- build_rtti_type_name(type_ctor_maybe_res_addr_functor_desc, GCC_Type,
- !IO).
-build_rtti_type_name(type_ctor_maybe_res_addr_functor_desc, GCC_Type, !IO) :-
- % typedef union {
- % MR_DuFunctorDesc *MR_maybe_res_du_ptr;
- % MR_ReservedAddrFunctorDesc *MR_maybe_res_res_ptr;
- % } MR_MaybeResFunctorDescPtr;
- %
- % typedef struct {
- % MR_ConstString MR_maybe_res_name;
- % MR_Integer MR_maybe_res_arity;
- % MR_bool MR_maybe_res_is_res;
- % MR_MaybeResFunctorDescPtr MR_maybe_res_ptr;
- % } MR_MaybeResAddrFunctorDesc;
- build_struct_type("MR_MaybeResFunctorDesc",
- [gcc.ptr_type_node - "MR_maybe_res_init"],
- MR_MaybeResFunctorDescPtr, !IO),
- build_struct_type("MR_MaybeResAddrFunctorDesc",
- ['MR_ConstString' - "MR_maybe_res_name",
- 'MR_Integer' - "MR_maybe_res_arity",
- 'MR_bool' - "MR_maybe_res_is_res",
- MR_MaybeResFunctorDescPtr - "MR_maybe_res_ptr"
- ], GCC_Type, !IO).
-build_rtti_type_name(type_ctor_type_functors, GCC_Type, !IO) :-
- build_struct_type("MR_TypeFunctors",
- [gcc.ptr_type_node - "MR_functors_init"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_type_layout, GCC_Type, !IO) :-
- build_struct_type("MR_TypeLayout",
- [gcc.ptr_type_node - "MR_layout_init"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_functor_number_map, gcc.ptr_type_node,
- !IO).
-build_rtti_type_name(type_ctor_type_ctor_info, GCC_Type, !IO) :-
- % MR_Integer MR_type_ctor_arity;
- % MR_int_least8_t MR_type_ctor_version;
- % MR_int_least8_t MR_type_ctor_num_ptags; /* if DU */
- % MR_TypeCtorRepInt MR_type_ctor_rep_CAST_ME;
- % MR_ProcAddr MR_type_ctor_unify_pred;
- % MR_ProcAddr MR_type_ctor_compare_pred;
- % MR_ConstString MR_type_ctor_module_name;
- % MR_ConstString MR_type_ctor_name;
- % MR_TypeFunctors MR_type_ctor_functors;
- % MR_TypeLayout MR_type_ctor_layout;
- % MR_int_least32_t MR_type_ctor_num_functors;
- % MR_int_least16_t MR_type_ctor_flags;
- % MR_Integer * MR_type_ctor_functor_number_map;
- build_rtti_type_name(type_ctor_type_functors, MR_TypeFunctors, !IO),
- build_rtti_type_name(type_ctor_type_layout, MR_TypeLayout, !IO),
- build_struct_type("MR_TypeCtorInfo_Struct",
- ['MR_Integer' - "MR_type_ctor_arity",
- 'MR_int_least8_t' - "MR_type_ctor_version",
- 'MR_int_least8_t' - "MR_type_ctor_num_ptags",
- % MR_TypeCtorRepInt is typedef'd to be MR_int_least16_t
- 'MR_int_least16_t' - "MR_type_ctor_rep_CAST_ME",
- 'MR_ProcAddr' - "MR_type_ctor_unify_pred",
- 'MR_ProcAddr' - "MR_type_ctor_compare_pred",
- 'MR_ConstString' - "MR_type_ctor_module_name",
- 'MR_ConstString' - "MR_type_ctor_name",
- MR_TypeFunctors - "MR_type_ctor_functors",
- MR_TypeLayout - "MR_type_ctor_layout",
- 'MR_int_least32_t' - "MR_type_ctor_num_functors",
- 'MR_int_least16_t' - "MR_type_ctor_flags",
- gcc.ptr_type_node - "MR_type_ctor_functor_number_map"],
- GCC_Type, !IO).
-build_rtti_type_name(type_ctor_type_info(TypeInfo), GCC_Type, !IO) :-
- build_type_info_type(TypeInfo, GCC_Type, !IO).
-build_rtti_type_name(type_ctor_pseudo_type_info(PseudoTypeInfo), GCC_Type,
- !IO) :-
- build_pseudo_type_info_type(PseudoTypeInfo, GCC_Type, !IO).
-build_rtti_type_name(type_ctor_type_hashcons_pointer, gcc.ptr_type_node, !IO).
-
-:- pred build_rtti_type_tc_name(tc_rtti_name::in, gcc.gcc_type::out,
- io::di, io::uo) is det.
-
-build_rtti_type_tc_name(type_class_base_typeclass_info(_, _),
- gcc.ptr_type_node, !IO).
-build_rtti_type_tc_name(type_class_id, GCC_Type, !IO) :-
- build_tc_id_type(GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_id_var_names, 'MR_ConstString', !IO).
-build_rtti_type_tc_name(type_class_id_method_ids, GCC_Type, !IO) :-
- build_tc_id_method_type(GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_decl, GCC_Type, !IO) :-
- build_tc_decl_type(GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_decl_super(_, N), GCC_Type, !IO) :-
- build_tc_constr_struct_type(N, GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_decl_supers, GCC_Type, !IO) :-
- build_tc_constr_type(StructType, !IO),
- gcc.build_pointer_type(StructType, GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_instance(_), GCC_Type, !IO) :-
- build_tc_instance_type(GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_instance_tc_type_vector(_),
- 'MR_PseudoTypeInfo', !IO).
-build_rtti_type_tc_name(type_class_instance_constraint(_, _, N),
- GCC_Type, !IO) :-
- build_tc_constr_struct_type(N, GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_instance_constraints(_), GCC_Type, !IO) :-
- build_tc_constr_type(StructType, !IO),
- gcc.build_pointer_type(StructType, GCC_Type, !IO).
-build_rtti_type_tc_name(type_class_instance_methods(_), _GCC_Type, !IO) :-
- sorry($module, $pred, "type_class_instance_methods").
-
-:- pred build_type_info_type(rtti_type_info::in,
- gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_type_info_type(plain_arity_zero_type_info(_), GCC_Type, !IO) :-
- build_rtti_type_name(type_ctor_type_ctor_info, GCC_Type, !IO).
-build_type_info_type(plain_type_info(_TypeCtor, ArgTypes), GCC_Type, !IO) :-
- Arity = list.length(ArgTypes),
- % typedef struct {
- % MR_TypeCtorInfo MR_ti_type_ctor_info;
- % MR_TypeInfo MR_ti_fixed_arity_arg_typeinfos[<ARITY>];
- % } MR_FA_TypeInfo_Struct<ARITY>;
- MR_TypeCtorInfo = gcc.ptr_type_node,
- gcc.build_array_type('MR_TypeInfo', Arity, MR_TypeInfoArray, !IO),
- StructName = string.format("MR_FA_TypeInfo_Struct%d", [i(Arity)]),
- build_struct_type(StructName,
- [MR_TypeCtorInfo - "MR_ti_type_ctor_info",
- MR_TypeInfoArray - "MR_ti_fixed_arity_arg_typeinfos"],
- GCC_Type, !IO).
-build_type_info_type(var_arity_type_info(_VarArityTypeId, ArgTypes), GCC_Type,
- !IO) :-
- Arity = list.length(ArgTypes),
- % struct NAME {
- % MR_TypeCtorInfo MR_ti_type_ctor_info;
- % MR_Integer MR_ti_var_arity_arity;
- % MR_TypeInfo MR_ti_var_arity_arg_typeinfos[ARITY];
- % }
- MR_TypeCtorInfo = gcc.ptr_type_node,
- gcc.build_array_type('MR_TypeInfo', Arity, MR_TypeInfoArray, !IO),
- StructName = string.format("MR_VA_TypeInfo_Struct%d", [i(Arity)]),
- build_struct_type(StructName,
- [MR_TypeCtorInfo - "MR_ti_type_ctor_info",
- 'MR_Integer' - "MR_ti_var_arity_arity",
- MR_TypeInfoArray - "MR_ti_var_arity_arg_typeinfos"],
- GCC_Type, !IO).
-
-:- pred build_pseudo_type_info_type(rtti_pseudo_type_info::in,
- gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_pseudo_type_info_type(type_var(_), _, !IO) :-
- % We use small integers to represent type_vars,
- % rather than pointers, so there is no pointed-to type.
- unexpected($module, $pred, "type_var").
-build_pseudo_type_info_type(plain_arity_zero_pseudo_type_info(_), GCC_Type,
- !IO) :-
- build_rtti_type_name(type_ctor_type_ctor_info, GCC_Type, !IO).
-build_pseudo_type_info_type(plain_pseudo_type_info(_TypeCtor, ArgTypes),
- GCC_Type, !IO) :-
- Arity = list.length(ArgTypes),
- % typedef struct {
- % MR_TypeCtorInfo MR_pti_type_ctor_info;
- % MR_PseudoTypeInfo MR_pti_fixed_arity_arg_pseudo_typeinfos[<ARITY>];
- % } MR_FA_PseudoTypeInfo_Struct<ARITY>;
- MR_TypeCtorInfo = gcc.ptr_type_node,
- gcc.build_array_type('MR_PseudoTypeInfo', Arity,
- MR_PseudoTypeInfoArray, !IO),
- StructName = string.format("MR_FA_PseudoTypeInfo_Struct%d", [i(Arity)]),
- build_struct_type(StructName,
- [MR_TypeCtorInfo - "MR_pti_type_ctor_info",
- MR_PseudoTypeInfoArray - "MR_pti_fixed_arity_arg_pseudo_typeinfos"],
- GCC_Type, !IO).
-build_pseudo_type_info_type(var_arity_pseudo_type_info(_VarArityTypeId,
- ArgTypes), GCC_Type, !IO) :-
- Arity = list.length(ArgTypes),
- % struct NAME {
- % MR_TypeCtorInfo MR_pti_type_ctor_info;
- % MR_Integer MR_pti_var_arity_arity;
- % MR_PseudoTypeInfo MR_pti_var_arity_arg_pseudo_typeinfos[ARITY];
- % }
- MR_TypeCtorInfo = gcc.ptr_type_node,
- gcc.build_array_type('MR_PseudoTypeInfo', Arity,
- MR_PseudoTypeInfoArray, !IO),
- StructName = string.format("MR_VA_PseudoTypeInfo_Struct%d", [i(Arity)]),
- build_struct_type(StructName,
- [MR_TypeCtorInfo - "MR_pti_type_ctor_info",
- 'MR_Integer' - "MR_pti_var_arity_arity",
- MR_PseudoTypeInfoArray -
- "MR_pti_var_arity_arg_pseudo_typeinfos"],
- GCC_Type, !IO).
-
-:- pred build_tc_constr_struct_type(int::in, gcc.gcc_type::out,
- io::di, io::uo) is det.
-
-build_tc_constr_struct_type(N, MR_TypeClassConstraint_NStruct, !IO) :-
- % typedef struct MR_TypeClassConstraint_NStruct{
- % MR_TypeClassDecl MR_tc_constr_type_class;
- % MR_PseudoTypeInfo MR_tc_constr_arg_ptis[Arity];
- % } MR_TypeClassConstraint_N;
- gcc.build_array_type('MR_PseudoTypeInfo', N, MR_PseudoTypeInfoArray, !IO),
- build_tc_decl_type(MR_TypeClassDecl, !IO),
- gcc.build_pointer_type(MR_TypeClassDecl, MR_TypeClassDeclPtr, !IO),
- StructName = string.format("MR_TypeClassConstraint_%dStruct", [i(N)]),
- build_struct_type(StructName,
- [MR_TypeClassDeclPtr - "MR_tc_constr_type_class",
- MR_PseudoTypeInfoArray - "MR_tc_constr_arg_ptis"],
- MR_TypeClassConstraint_NStruct, !IO).
-
-:- pred build_tc_constr_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_tc_constr_type(MR_TypeClassConstraint, !IO) :-
- build_tc_constr_struct_type(5, MR_TypeClassConstraint5Struct, !IO),
- gcc.build_pointer_type(MR_TypeClassConstraint5Struct,
- MR_TypeClassConstraint, !IO).
-
-:- pred build_tc_id_method_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_tc_id_method_type(MR_TypeClassMethod, !IO) :-
- % typedef struct {
- % MR_ConstString MR_tc_method_name;
- % const MR_int_least8_t MR_tc_method_arity;
- % const MR_PredFunc MR_tc_method_pred_func;
- % } MR_TypeClassMethod;
- build_struct_type("MR_TypeClassMethod",
- ['MR_ConstString' - "MR_tc_method_name",
- 'MR_int_least8_t' - "MR_tc_method_arity",
- 'MR_PredFunc' - "MR_tc_method_pred_func"],
- MR_TypeClassMethod, !IO).
-
-:- pred build_tc_id_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_tc_id_type(MR_TypeClassId, !IO) :-
- % typedef struct {
- % MR_ConstString MR_tc_id_module_name;
- % MR_ConstString MR_tc_id_name;
- % const MR_int_least8_t MR_tc_id_arity;
- % const MR_int_least8_t MR_tc_id_num_type_vars;
- % const MR_int_least16_t MR_tc_id_num_methods;
- % const MR_ConstString *MR_tc_id_type_var_names;
- % const MR_TypeClassMethod *MR_tc_id_methods;
- % } MR_TypeClassId;
- gcc.build_pointer_type('MR_ConstString', MR_ConstStringPtr, !IO),
- build_tc_id_method_type(MR_TypeClassMethod, !IO),
- gcc.build_pointer_type(MR_TypeClassMethod, MR_TypeClassMethodPtr, !IO),
- build_struct_type("MR_TypeClassId",
- ['MR_ConstString' - "MR_tc_id_module_name",
- 'MR_ConstString' - "MR_tc_id_name",
- 'MR_int_least8_t' - "MR_tc_id_arity",
- 'MR_int_least8_t' - "MR_tc_id_num_type_vars",
- 'MR_int_least16_t' - "MR_tc_id_num_methods",
- MR_ConstStringPtr - "MR_tc_id_type_var_names",
- MR_TypeClassMethodPtr - "MR_tc_id_methods"],
- MR_TypeClassId, !IO).
-
-:- pred build_tc_decl_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_tc_decl_type(MR_TypeClassDecl, !IO) :-
- % struct MR_TypeClassDecl_Struct {
- % const MR_TypeClassId *MR_tc_decl_id;
- % const MR_int_least8_t MR_tc_decl_version_number;
- % const MR_int_least8_t MR_tc_decl_num_supers;
- % const MR_TypeClassConstraint *MR_tc_decl_supers;
- % };
- build_du_exist_locn_type(MR_TypeClassId, !IO),
- gcc.build_pointer_type(MR_TypeClassId, MR_TypeClassIdPtr, !IO),
- build_tc_constr_type(MR_TypeClassConstraint, !IO),
- gcc.build_pointer_type(MR_TypeClassConstraint,
- MR_TypeClassConstraintPtr, !IO),
- build_struct_type("MR_TypeClassDeclStruct",
- [MR_TypeClassIdPtr - "MR_tc_decl_id",
- 'MR_int_least8_t' - "MR_tc_decl_version_number",
- 'MR_int_least8_t' - "MR_tc_decl_num_supers",
- MR_TypeClassConstraintPtr - "MR_tc_decl_supers"],
- MR_TypeClassDecl, !IO).
-
-:- pred build_tc_instance_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_tc_instance_type(MR_Instance, !IO) :-
- % struct MR_Instance_Struct {
- % const MR_TypeClassDecl MR_tc_inst_type_class;
- % const MR_int_least8_t MR_tc_inst_num_type_vars;
- % const MR_int_least8_t MR_tc_inst_num_instance_constraints;
- % const MR_PseudoTypeInfo *MR_tc_inst_type_args;
- % const MR_TypeClassConstraint *MR_tc_inst_instance_constraints;
- % const MR_CodePtr MR_tc_inst_methods;
- % };
- build_tc_decl_type(MR_TypeClassDecl, !IO),
- gcc.build_pointer_type(MR_TypeClassDecl, MR_TypeClassDeclPtr, !IO),
- gcc.build_pointer_type('MR_PseudoTypeInfo', MR_PseudoTypeInfoPtr, !IO),
- build_tc_constr_type(MR_TypeClassConstraint, !IO),
- gcc.build_pointer_type(MR_TypeClassConstraint,
- MR_TypeClassConstraintPtr, !IO),
- build_struct_type("MR_Instance",
- [MR_TypeClassDeclPtr - "MR_tc_inst_type_class",
- 'MR_int_least8_t' - "MR_tc_inst_num_type_vars",
- 'MR_int_least8_t' - "MR_tc_inst_num_instance_constraints",
- 'MR_int_least8_t' - "MR_tc_decl_num_supers",
- MR_PseudoTypeInfoPtr - "MR_tc_inst_type_args",
- MR_TypeClassConstraintPtr - "MR_tc_inst_instance_constraints"],
- MR_Instance, !IO).
-
-:- pred build_du_exist_locn_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_du_exist_locn_type(MR_DuExistLocn, !IO) :-
- % typedef struct {
- % MR_int_least16_t MR_exist_arg_num;
- % MR_int_least16_t MR_exist_offset_in_tci;
- % } MR_DuExistLocn;
- build_struct_type("MR_DuExistLocn",
- ['MR_int_least16_t' - "MR_exist_arg_num",
- 'MR_int_least16_t' - "MR_exist_offset_in_tci"],
- MR_DuExistLocn, !IO).
-
-:- pred build_du_exist_info_type(gcc.gcc_type::out, io::di, io::uo) is det.
-
-build_du_exist_info_type(MR_DuExistInfo, !IO) :-
- % typedef struct {
- % MR_int_least16_t MR_exist_typeinfos_plain;
- % MR_int_least16_t MR_exist_typeinfos_in_tci;
- % MR_int_least16_t MR_exist_tcis;
- % const MR_DuExistLocn *MR_exist_typeinfo_locns;
- % } MR_DuExistInfo;
- build_du_exist_locn_type(MR_DuExistLocn, !IO),
- gcc.build_pointer_type(MR_DuExistLocn, MR_DuExistLocnPtr, !IO),
- build_struct_type("MR_DuExistInfo",
- ['MR_int_least16_t' - "MR_exist_typeinfos_plain",
- 'MR_int_least16_t' - "MR_exist_typeinfos_in_tci",
- 'MR_int_least16_t' - "MR_exist_tcis",
- MR_DuExistLocnPtr - "MR_exist_typeinfo_locns"],
- MR_DuExistInfo, !IO).
-
- % rtti_enum_const(Name, Value):
- %
- % Succeed iff Name is the name of an RTTI enumeration constant
- % whose integer value is Value. The values here must match the definitions
- % of the MR_TypeCtor and MR_Sectag_Locn enumerations in
- % runtime/mercury_type_info.h.
- %
-:- pred rtti_enum_const(string::in, int::out) is semidet.
-
-rtti_enum_const("MR_TYPECTOR_REP_ENUM", 0).
-rtti_enum_const("MR_TYPECTOR_REP_ENUM_USEREQ", 1).
-rtti_enum_const("MR_TYPECTOR_REP_DU", 2).
-rtti_enum_const("MR_TYPECTOR_REP_DU_USEREQ", 3).
-rtti_enum_const("MR_TYPECTOR_REP_NOTAG", 4).
-rtti_enum_const("MR_TYPECTOR_REP_NOTAG_USEREQ", 5).
-rtti_enum_const("MR_TYPECTOR_REP_EQUIV", 6).
-rtti_enum_const("MR_TYPECTOR_REP_FUNC", 7).
-rtti_enum_const("MR_TYPECTOR_REP_INT", 8).
-rtti_enum_const("MR_TYPECTOR_REP_CHAR", 9).
-rtti_enum_const("MR_TYPECTOR_REP_FLOAT", 10).
-rtti_enum_const("MR_TYPECTOR_REP_STRING", 11).
-rtti_enum_const("MR_TYPECTOR_REP_PRED", 12).
-rtti_enum_const("MR_TYPECTOR_REP_SUBGOAL", 13).
-rtti_enum_const("MR_TYPECTOR_REP_VOID", 14).
-rtti_enum_const("MR_TYPECTOR_REP_C_POINTER", 15).
-rtti_enum_const("MR_TYPECTOR_REP_TYPEINFO", 16).
-rtti_enum_const("MR_TYPECTOR_REP_TYPECLASSINFO", 17).
-rtti_enum_const("MR_TYPECTOR_REP_ARRAY", 18).
-rtti_enum_const("MR_TYPECTOR_REP_SUCCIP", 19).
-rtti_enum_const("MR_TYPECTOR_REP_HP", 20).
-rtti_enum_const("MR_TYPECTOR_REP_CURFR", 21).
-rtti_enum_const("MR_TYPECTOR_REP_MAXFR", 22).
-rtti_enum_const("MR_TYPECTOR_REP_REDOFR", 23).
-rtti_enum_const("MR_TYPECTOR_REP_REDOIP", 24).
-rtti_enum_const("MR_TYPECTOR_REP_TRAIL_PTR", 25).
-rtti_enum_const("MR_TYPECTOR_REP_TICKET", 26).
-rtti_enum_const("MR_TYPECTOR_REP_NOTAG_GROUND", 27).
-rtti_enum_const("MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ", 28).
-rtti_enum_const("MR_TYPECTOR_REP_EQUIV_GROUND", 29).
-rtti_enum_const("MR_TYPECTOR_REP_TUPLE", 30).
-rtti_enum_const("MR_TYPECTOR_REP_RESERVED_ADDR", 31).
-rtti_enum_const("MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ", 32).
-rtti_enum_const("MR_TYPECTOR_REP_TYPECTORINFO", 33).
-rtti_enum_const("MR_TYPECTOR_REP_BASETYPECLASSINFO", 34).
-rtti_enum_const("MR_TYPECTOR_REP_TYPEDESC", 35).
-rtti_enum_const("MR_TYPECTOR_REP_TYPECTORDESC", 36).
-rtti_enum_const("MR_TYPECTOR_REP_FOREIGN", 37).
-rtti_enum_const("MR_TYPECTOR_REP_REFERENCE", 38).
-rtti_enum_const("MR_TYPECTOR_REP_STABLE_C_POINTER", 39).
-rtti_enum_const("MR_TYPECTOR_REP_STABLE_FOREIGN", 40).
-rtti_enum_const("MR_TYPECTOR_REP_PSEUDOTYPEDESC", 41).
-rtti_enum_const("MR_TYPECTOR_REP_DUMMY", 42).
-rtti_enum_const("MR_TYPECTOR_REP_BITMAP", 43).
-rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 44).
-rtti_enum_const("MR_SECTAG_NONE", 0).
-rtti_enum_const("MR_SECTAG_NONE_DIRECT_ARG", 1).
-rtti_enum_const("MR_SECTAG_LOCAL", 2).
-rtti_enum_const("MR_SECTAG_REMOTE", 3).
-rtti_enum_const("MR_SECTAG_VARIABLE", 4).
-rtti_enum_const("MR_PREDICATE", 0).
-rtti_enum_const("MR_FUNCTION", 1).
-
-:- pred build_struct_type(gcc.struct_name::in,
- list(pair(gcc.gcc_type, gcc.field_name))::in, gcc.gcc_type::out,
- io::di, io::uo) is det.
-
-build_struct_type(StructName, Fields, GCC_Type, !IO) :-
- build_fields(Fields, GCC_Fields, !IO),
- gcc.build_struct_type_decl(StructName, GCC_Fields, GCC_TypeDecl, !IO),
- GCC_Type = gcc.declared_type(GCC_TypeDecl).
-
-:- pred build_fields(list(pair(gcc.gcc_type, gcc.field_name))::in,
- gcc.field_decls::out, io::di, io::uo) is det.
-
-build_fields([], GCC_Fields, !IO) :-
- gcc.empty_field_list(GCC_Fields, !IO).
-build_fields([Type - Name | Fields0], GCC_Fields, !IO) :-
- build_fields(Fields0, GCC_Fields0, !IO),
- gcc.build_field_decl(Name, Type, FieldDecl, !IO),
- gcc.cons_field_list(FieldDecl, GCC_Fields0, GCC_Fields, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output names of various entities.
-%
-
-:- func build_qualified_name(mlds_qualified_entity_name) = string.
-
-build_qualified_name(QualifiedName) = AsmName :-
- QualifiedName = qual(_ModuleName, _QualKind, Name),
- AsmName0 = build_name(Name),
- maybe_add_module_qualifier(QualifiedName, AsmName0, AsmName).
-
-:- pred maybe_add_module_qualifier(mlds_qualified_entity_name::in,
- string::in, string::out) is det.
-
-maybe_add_module_qualifier(QualifiedName, AsmName0, AsmName) :-
- QualifiedName = qual(ModuleName, _QualKind, Name),
- (
- (
- % Don't module-qualify main/2.
- Name = entity_function(PredLabel, _, _, _),
- PredLabel = mlds_user_pred_label(pf_predicate, no, "main", 2,
- model_det, no)
- ;
- Name = entity_data(mlds_rtti(RttiId)),
- module_qualify_name_of_rtti_id(RttiId) = no
- ;
- % We don't module qualify pragma export names.
- Name = entity_export(_)
- )
- ->
- AsmName = AsmName0
- ;
- ModuleSymName = mlds_module_name_to_sym_name(ModuleName),
- AsmName = string.format("%s__%s",
- [s(get_module_name(ModuleSymName)), s(AsmName0)])
- ).
-
-% XXX we should consider not appending the arity, modenum, and seqnum
-% if they are not needed.
-
-:- func build_name(mlds_entity_name) = string.
-
-build_name(entity_type(Name, Arity)) = TypeName :-
- MangledName = name_mangle(Name),
- TypeName = string.format("%s_%d", [s(MangledName), i(Arity)]).
-build_name(entity_data(DataName)) = build_data_name(DataName).
-build_name(EntityName) = AsmFuncName :-
- EntityName = entity_function(_, _, _, _),
- get_func_name(EntityName, _FuncName, AsmFuncName).
-build_name(entity_export(Name)) = Name.
-
-:- func build_data_name(mlds_data_name) = string.
-
-build_data_name(mlds_data_var(Name)) =
- name_mangle(ml_var_name_to_string(Name)).
-build_data_name(mlds_scalar_common_ref(_)) =
- sorry($module, $pred, "mlds_scalar_common_ref").
-build_data_name(mlds_rtti(RttiId0)) = RttiAddrName :-
- RttiId = fixup_rtti_id(RttiId0),
- rtti.id_to_c_identifier(RttiId, RttiAddrName).
-build_data_name(mlds_module_layout) = _ :-
- sorry($module, $pred, "mlds_module_layout").
-build_data_name(mlds_proc_layout(_ProcLabel)) = _ :-
- sorry($module, $pred, "mlds_proc_layout").
-build_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum)) = _ :-
- sorry($module, $pred, "mlds_internal_layout").
-build_data_name(mlds_tabling_ref(ProcLabel, Id)) = TablingPointerName :-
- % convert the proc_label into an entity_name,
- % so we can use get_func_name below
- ProcLabel = mlds_proc_label(PredLabel, ProcId),
- MaybeSeqNum = no,
- Name = entity_function(PredLabel, ProcId, MaybeSeqNum, invalid_pred_id),
- get_func_name(Name, _FuncName, AsmFuncName),
- TablingPointerName = tabling_info_id_str(Id) ++ "_" ++ AsmFuncName.
-
-:- func fixup_rtti_id(rtti_id) = rtti_id.
-
-fixup_rtti_id(ctor_rtti_id(RttiTypeCtor0, RttiName0))
- = ctor_rtti_id(RttiTypeCtor, RttiName) :-
- RttiTypeCtor = fixup_rtti_type_ctor(RttiTypeCtor0),
- RttiName = fixup_rtti_name(RttiName0).
-fixup_rtti_id(tc_rtti_id(TCName, TCRttiName)) = tc_rtti_id(TCName, TCRttiName).
-
- % XXX Sometimes earlier stages of the compiler forget to add
- % the appropriate qualifiers for stuff in the `builtin' module;
- % we fix that here.
- %
-:- func fixup_rtti_type_ctor(rtti_type_ctor) = rtti_type_ctor.
-
-fixup_rtti_type_ctor(RttiTypeCtor0) = RttiTypeCtor :-
- (
- RttiTypeCtor0 = rtti_type_ctor(ModuleName0, Name, Arity),
- ModuleName0 = unqualified("")
- ->
- ModuleName = unqualified("builtin"),
- RttiTypeCtor = rtti_type_ctor(ModuleName, Name, Arity)
- ;
- RttiTypeCtor = RttiTypeCtor0
- ).
-
-:- func fixup_rtti_name(ctor_rtti_name) = ctor_rtti_name.
-
-fixup_rtti_name(RttiTypeCtor0) = RttiTypeCtor :-
- ( RttiTypeCtor0 = type_ctor_pseudo_type_info(PseudoTypeInfo) ->
- RttiTypeCtor = type_ctor_pseudo_type_info(
- fixup_pseudo_type_info(PseudoTypeInfo))
- ;
- RttiTypeCtor = RttiTypeCtor0
- ).
-
-:- func fixup_pseudo_type_info(rtti_pseudo_type_info) = rtti_pseudo_type_info.
-
-fixup_pseudo_type_info(PseudoTypeInfo0) = PseudoTypeInfo :-
- ( PseudoTypeInfo0 = plain_arity_zero_pseudo_type_info(RttiTypeCtor0) ->
- PseudoTypeInfo = plain_arity_zero_pseudo_type_info(
- fixup_rtti_type_ctor(RttiTypeCtor0))
- ;
- PseudoTypeInfo = PseudoTypeInfo0
- ).
-
-%-----------------------------------------------------------------------------%
-%
-% Symbol tables and other (semi-)global data structures.
-%
-
-:- type global_info
- ---> global_info(
- gi_type_table :: gcc_type_table,
- gi_global_vars :: symbol_table,
- gi_globals :: globals
- ).
-
- % The type field table records the mapping from MLDS type names
- % to the table of field declarations for that type.
-:- type gcc_type_table == map(mlds_qualified_entity_name, gcc_type_info).
-:- type gcc_type_info
- ---> gcc_type_info(gcc.type_decl, field_table).
-
- % The field table records the mapping from MLDS field names
- % to GCC field declarations.
-:- type field_table ==
- map(mlds_fully_qualified_name(mlds_field_name), gcc.field_decl).
-
- % The defn_info holds information used while generating code
- % inside a function, or in the initializers for a global variable.
-:- type defn_info
- ---> defn_info(
- di_global_info :: global_info,
- di_func_name :: mlds_qualified_entity_name,
- di_local_vars :: symbol_table,
- di_label_table :: label_table
- ).
-
- % The symbol table records the mapping from MLDS variable names
- % to GCC variable declarations.
- % We initialize the symbol table with the function parameters,
- % and update it whenever we enter a block with local variables.
-:- type symbol_table == map(mlds_qualified_entity_name, gcc.var_decl).
-
- % The label table records the mapping from MLDS label names
- % to GCC label declaration tree nodes.
- % We initialize it using a separate pass over the function body
- % before we generate code for the function.
-:- type label_table == map(mlds_label, gcc.label).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output statements.
-%
-
-:- pred gen_statements(defn_info::in, list(statement)::in,
- io::di, io::uo) is det.
-
-gen_statements(DefnInfo, Statements, !IO) :-
- list.foldl(gen_statement(DefnInfo), Statements, !IO).
-
-:- pred gen_statement(defn_info::in, statement::in, io::di, io::uo) is det.
-
-gen_statement(DefnInfo, statement(Statement, Context), !IO) :-
- gen_context(Context, !IO),
- gen_stmt(DefnInfo, Statement, Context, !IO).
-
-:- pred gen_stmt(defn_info::in, mlds_stmt::in, mlds_context::in,
- io::di, io::uo) is det.
-
-gen_stmt(DefnInfo, Stmt, Context, !IO) :-
- (
- Stmt = ml_stmt_block(Defns, Statements),
- gcc.start_block(!IO),
- FuncName = DefnInfo ^ di_func_name,
- FuncName = qual(ModuleName, _, _),
- build_local_defns(Defns, ModuleName, DefnInfo, BlockDefnInfo, !IO),
- gen_statements(BlockDefnInfo, Statements, !IO),
- gcc.end_block(!IO)
- ;
- Stmt = ml_stmt_while(Kind, Cond, Statement),
- gcc.gen_start_loop(Loop, !IO),
- build_rval(Cond, DefnInfo, GCC_Cond, !IO),
- (
- Kind = loop_at_least_once,
- % Generate the test at the end of the loop.
- gen_statement(DefnInfo, Statement, !IO),
- gcc.gen_exit_loop_if_false(Loop, GCC_Cond, !IO)
- ;
- Kind = may_loop_zero_times,
- % Generate the test at the start of the loop.
- gcc.gen_exit_loop_if_false(Loop, GCC_Cond, !IO),
- gen_statement(DefnInfo, Statement, !IO)
- ),
- gcc.gen_end_loop(!IO)
- ;
- Stmt = ml_stmt_if_then_else(Cond, Then, MaybeElse),
- build_rval(Cond, DefnInfo, GCC_Cond, !IO),
- gcc.gen_start_cond(GCC_Cond, !IO),
- gen_statement(DefnInfo, Then, !IO),
- (
- MaybeElse = no
- ;
- MaybeElse = yes(Else),
- gcc.gen_start_else(!IO),
- gen_statement(DefnInfo, Else, !IO)
- ),
- gcc.gen_end_cond(!IO)
- ;
- Stmt = ml_stmt_switch(Type, Val, Range, Cases, Default),
- build_type(Type, DefnInfo ^ di_global_info, GCC_Type, !IO),
- ( Range = mlds_switch_range(Min, Max) ->
- gcc.build_range_type(GCC_Type, Min, Max, GCC_RangeType, !IO)
- ;
- GCC_RangeType = GCC_Type
- ),
- build_rval(Val, DefnInfo, GCC_Expr, !IO),
- gcc.gen_start_switch(GCC_Expr, GCC_RangeType, !IO),
- % We put the default case first, so that if it is unreachable,
- % it will get merged in with the first case.
- gen_default(DefnInfo, Default, !IO),
- gen_cases(DefnInfo, Cases, !IO),
- gcc.gen_end_switch(GCC_Expr, !IO)
- ;
- Stmt = ml_stmt_label(LabelName),
- LabelTable = DefnInfo ^ di_label_table,
- GCC_Label = map.lookup(LabelTable, LabelName),
- gcc.gen_label(GCC_Label, !IO)
- ;
- Stmt = ml_stmt_goto(goto_label(LabelName)),
- LabelTable = DefnInfo ^ di_label_table,
- GCC_Label = map.lookup(LabelTable, LabelName),
- gcc.gen_goto(GCC_Label, !IO)
- ;
- Stmt = ml_stmt_goto(goto_break),
- gcc.gen_break(!IO)
- ;
- Stmt = ml_stmt_goto(goto_continue),
- % XXX not yet implemented
- % but we set target_supports_break_and_continue to no
- % for this target, so we shouldn't get any.
- unexpected($module, $pred, "NYI continue")
- ;
- Stmt = ml_stmt_computed_goto(_Expr, _Labels),
- % XXX not yet implemented
- % but we set target_supports_computed_goto to no
- % for this target, so we shouldn't get any.
- unexpected($module, $pred, "NYI computed goto")
- ;
- Stmt = ml_stmt_call(_Signature, FuncRval, MaybeObject, CallArgs,
- Results, CallKind),
- expect(unify(MaybeObject, no), $module, $pred, "method call"),
- build_args(CallArgs, DefnInfo, GCC_ArgList, !IO),
- build_rval(FuncRval, DefnInfo, GCC_FuncRval, !IO),
- (
- CallKind = no_return_call,
- % XXX trying to optimize these leads to
- % problems because we don't mark such calls
- % with __attribute__((__noreturn__)) and so
- % GCC thinks that they are not in a tail position.
- % Marking them as with __attribute__((__noreturn__))
- % doesn't help because GCC (3.3 beta) inhibits tail
- % call optimization for such functions.
- % Also, we can't insert a return statement (below)
- % if the return type for the caller doesn't match
- % that for the callee, but mlds_to_gcc.m currently doesn't
- % pass down the signature of the caller to this point.
- % So for now, treat these as if they were not tail calls.
- IsTailCall = no
- ;
- CallKind = tail_call,
- IsTailCall = yes
- ;
- CallKind = ordinary_call,
- IsTailCall = no
- ),
- gcc.build_call_expr(GCC_FuncRval, GCC_ArgList, IsTailCall, GCC_Call,
- !IO),
- (
- Results = [],
- gcc.gen_expr_stmt(GCC_Call, !IO)
- ;
- Results = [ResultLval],
- (
- IsTailCall = yes,
- gcc.gen_return(GCC_Call, !IO)
- ;
- IsTailCall = no,
- build_lval(ResultLval, DefnInfo, GCC_ResultExpr, !IO),
- gcc.gen_assign(GCC_ResultExpr, GCC_Call, !IO)
- )
- ;
- Results = [_, _ | _],
- sorry($module, $pred, "call with multiple outputs")
- )
- ;
- Stmt = ml_stmt_return(Results),
- (
- Results = [],
- % XXX Not yet implemented
- % These are not generated by the current MLDS code
- % generator, so I didn't bother to implement them.
- sorry($module, $pred, "return without return value")
- ;
- Results = [Rval],
- build_rval(Rval, DefnInfo, Expr, !IO),
- gcc.gen_return(Expr, !IO)
- ;
- Results = [_, _ | _],
- sorry($module, $pred, "multiple return values")
- )
- ;
- Stmt = ml_stmt_do_commit(Ref),
- % generate `__builtin_longjmp(&<Ref>, 1);'
- ( Ref = ml_lval(RefLval0) ->
- RefLval = RefLval0
- ;
- unexpected($module, $pred, "non-lval argument to do_commit")
- ),
- build_call(gcc.longjmp_func_decl,
- [ml_mem_addr(RefLval), ml_const(mlconst_int(1))],
- DefnInfo, GCC_CallLongjmp, !IO),
- gcc.gen_expr_stmt(GCC_CallLongjmp, !IO)
- ;
- Stmt = ml_stmt_try_commit(Ref, SubStatement, Handler),
-
- % Generate the following:
- %
- % if (__builtin_setjmp(&<Ref>) == 0)
- % <SubStatement>
- % else
- % <Handler>
-
- build_call(gcc.setjmp_func_decl, [ml_mem_addr(Ref)], DefnInfo,
- GCC_CallSetjmp, !IO),
- gcc.build_int(0, GCC_Zero, !IO),
- gcc.build_binop(gcc.eq_expr, gcc.boolean_type_node,
- GCC_CallSetjmp, GCC_Zero, GCC_SetjmpEqZero, !IO),
- gcc.gen_start_cond(GCC_SetjmpEqZero, !IO),
- gen_statement(DefnInfo, SubStatement, !IO),
- gcc.gen_start_else(!IO),
- gen_statement(DefnInfo, Handler, !IO),
- gcc.gen_end_cond(!IO)
- ;
- Stmt = ml_stmt_atomic(AtomicStatement),
- gen_atomic_stmt(DefnInfo, AtomicStatement, Context, !IO)
- ).
-
-%-----------------------------------------------------------------------------%
-%
-% Extra code for outputting switch statements..
-%
-
-:- pred gen_cases(defn_info::in, list(mlds_switch_case)::in,
- io::di, io::uo) is det.
-
-gen_cases(DefnInfo, Cases, !IO) :-
- list.foldl(gen_case(DefnInfo), Cases, !IO).
-
-:- pred gen_case(defn_info::in, mlds_switch_case::in, io::di, io::uo) is det.
-
-gen_case(DefnInfo, mlds_switch_case(FirstCond, LaterConds, Code), !IO) :-
- gen_case_label(DefnInfo, FirstCond, !IO),
- list.foldl(gen_case_label(DefnInfo), LaterConds, !IO),
- gen_statement(DefnInfo, Code, !IO),
- gcc.gen_break(!IO).
-
-:- pred gen_case_label(defn_info::in, mlds_case_match_cond::in,
- io::di, io::uo) is det.
-
-gen_case_label(DefnInfo, match_value(Val), !IO) :-
- build_rval(Val, DefnInfo, GCC_Val, !IO),
- gcc.build_unnamed_label(Label, !IO),
- gcc.gen_case_label(GCC_Val, Label, !IO).
-gen_case_label(DefnInfo, match_range(Min, Max), !IO) :-
- build_rval(Min, DefnInfo, _GCC_Min, !IO),
- build_rval(Max, DefnInfo, _GCC_Max, !IO),
- gcc.build_unnamed_label(_Label, !IO),
- % The following is not yet implemented (would be easy to do, but
- % not needed so far, since these are not generated by the current
- % MLDS code generator)
- %%% gcc.gen_case_range_label(GCC_Min, GCC_Max, Label).
- sorry($module, $pred, "match_range").
-
-:- pred gen_default(defn_info::in, mlds_switch_default::in,
- io::di, io::uo) is det.
-
-gen_default(_, default_do_nothing, !IO).
-gen_default(_, default_is_unreachable, !IO) :-
- % If the default is unreachable, we just generate a label
- % which will just drop through into the first case.
- % This generally leads to more efficient code than default_do_nothing.
- gcc.build_unnamed_label(Label, !IO),
- gcc.gen_default_case_label(Label, !IO).
-gen_default(DefnInfo, default_case(Statement), !IO) :-
- gcc.build_unnamed_label(Label, !IO),
- gcc.gen_default_case_label(Label, !IO),
- gen_statement(DefnInfo, Statement, !IO),
- gcc.gen_break(!IO).
-
-%-----------------------------------------------------------------------------%
-
-/**********
-XXX Profiling is not yet implemented for mlds_to_gcc.m.
-The following code for handling profiling is copied from
-mlds_to_c.m. It shows what we should generate.
-
- %
- % If memory profiling is turned on output an instruction to
- % record the heap allocation.
- %
-:- pred mlds_maybe_output_heap_profile_instr(mlds_context::in,
- indent::in, list(mlds_rval)::in,
- mlds_qualified_entity_name::in, maybe(ctor_name)::in,
- io::di, io::uo) is det.
-
-mlds_maybe_output_heap_profile_instr(Context, Indent, Args, FuncName,
- MaybeCtorName) -->
- globals.lookup_bool_option(Globals, profile_memory, ProfileMem),
- (
- { ProfileMem = yes }
- ->
- mlds_indent(Context, Indent),
- io.write_string("MR_record_allocation("),
- io.write_int(list.length(Args)),
- io.write_string(", "),
- mlds_output_fully_qualified_name(FuncName),
- io.write_string(", """),
- mlds_output_fully_qualified_name(FuncName),
- io.write_string(""", "),
- ( { MaybeCtorName = yes(CtorName) } ->
- io.write_char('"'),
- c_util.output_quoted_string(CtorName),
- io.write_char('"')
- ;
- io.write_string("NULL")
- ),
- io.write_string(");\n")
- ;
- []
- ).
-
- %
- % If call profiling is turned on output an instruction to record
- % an arc in the call profile between the callee and caller.
- %
-:- pred mlds_maybe_output_call_profile_instr(mlds_context::in,
- indent::in, mlds_rval::in, mlds_qualified_entity_name::in,
- io::di, io::uo) is det.
-
-mlds_maybe_output_call_profile_instr(Context, Indent,
- CalleeFuncRval, CallerName) -->
- globals.lookup_bool_option(Globals, profile_calls, ProfileCalls),
- ( { ProfileCalls = yes } ->
- mlds_indent(Context, Indent),
- io.write_string("MR_prof_call_profile("),
- mlds_output_bracketed_rval(CalleeFuncRval),
- io.write_string(", "),
- mlds_output_fully_qualified_name(CallerName),
- io.write_string(");\n")
- ;
- []
- ).
-
- %
- % If time profiling is turned on output an instruction which
- % informs the runtime which procedure we are currently located
- % in.
- %
-:- pred mlds_maybe_output_time_profile_instr(mlds_context::in,
- indent::in, mlds_qualified_entity_name::in,
- io::di, io::uo) is det.
-
-mlds_maybe_output_time_profile_instr(Context, Indent, Name) -->
- globals.lookup_bool_option(Globals, profile_time, ProfileTime),
- (
- { ProfileTime = yes }
- ->
- mlds_indent(Context, Indent),
- io.write_string("MR_set_prof_current_proc("),
- mlds_output_fully_qualified_name(Name),
- io.write_string(");\n")
- ;
- []
- ).
-
-***************/
-
-%-----------------------------------------------------------------------------%
-%
-% Atomic statements.
-%
-
-:- pred gen_atomic_stmt(defn_info::in, mlds_atomic_statement::in,
- mlds_context::in, io::di, io::uo) is det.
-
-gen_atomic_stmt(DefnInfo, AtomicStmt, Context, !IO) :-
- (
- AtomicStmt = comment(_Comment)
- % For now, we just ignore the comments.
- % XXX Does gcc provide some way of inserting
- % comments into the generated assembler?
- ;
- AtomicStmt = assign(Lval, Rval),
- build_lval(Lval, DefnInfo, GCC_Lval, !IO),
- build_rval(Rval, DefnInfo, GCC_Rval, !IO),
- gcc.gen_assign(GCC_Lval, GCC_Rval, !IO)
- ;
- AtomicStmt = assign_if_in_heap(_, _),
- sorry($module, $pred, "assign_if_in_heap")
- ;
- AtomicStmt = delete_object(_Lval),
- % XXX not yet implemented
- % we should generate a call to GC_free()
- % (would be easy to do, but not needed so far, since
- % these are not generated by the current MLDS code generator)
- sorry($module, $pred, "NYI delete_object")
- ;
- AtomicStmt = new_object(Target, MaybeTag, _ExplicitSecTag, Type,
- MaybeSize, _MaybeCtorName, Args, ArgTypes, _MayUseAtomic,
- _AllocId),
-
- % Calculate the size that we're going to allocate.
- (
- MaybeSize = yes(SizeInWords),
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- globals.lookup_int_option(Globals, bytes_per_word, BytesPerWord),
- SizeOfWord = ml_const(mlconst_int(BytesPerWord)),
- SizeInBytes = ml_binop(int_mul, SizeInWords, SizeOfWord)
- ;
- MaybeSize = no,
- sorry($module, $pred, "new_object with unknown size")
- ),
-
- % Generate code to allocate the memory and optionally tag the pointer,
- % i.e. `Target = (Type) GC_malloc(SizeInBytes)'
- % or `Target = MR_mkword(Tag, (Type) GC_malloc(SizeInBytes))'.
-
- % Generate `GC_malloc(SizeInBytes)'.
- build_call(gcc.alloc_func_decl, [SizeInBytes], DefnInfo,
- GCC_Call, !IO),
-
- % Cast the result to (Type).
- build_type(Type, DefnInfo ^ di_global_info, GCC_Type, !IO),
- gcc.convert_type(GCC_Call, GCC_Type, GCC_CastCall, !IO),
-
- % Add a tag to the pointer, if necessary.
- (
- MaybeTag = yes(Tag),
- gcc.build_int(Tag, GCC_Tag, !IO),
- gcc.build_binop(gcc.plus_expr, GCC_Type,
- GCC_CastCall, GCC_Tag, GCC_TaggedCastCall, !IO)
- ;
- MaybeTag = no,
- Tag = 0,
- GCC_TaggedCastCall = GCC_CastCall
- ),
-
- % Assign it to Target.
- build_lval(Target, DefnInfo, GCC_Target, !IO),
- gcc.gen_assign(GCC_Target, GCC_TaggedCastCall, !IO),
-
- % Initialize the fields.
- gen_init_args(Args, ArgTypes, Context, 0, Target, Type, Tag,
- DefnInfo, !IO)
- ;
- AtomicStmt = gc_check,
- sorry($module, $pred, "gc_check")
- ;
- AtomicStmt = mark_hp(_Lval),
- sorry($module, $pred, "mark_hp")
- ;
- AtomicStmt = restore_hp(_Rval),
- sorry($module, $pred, "restore_hp")
- ;
- AtomicStmt = trail_op(_TrailOp),
- % Currently trail ops are implemented via calls to
- % impure predicates implemented in C, rather than as
- % MLDS trail ops, so this should never be reached.
- unexpected($module, $pred, "trail_op")
- % XXX That approach should work OK, but it is not
- % maximally efficient for this back-end, since for
- % this back-end the calls to C will end up as out-of-line
- % calls. It would be more efficient to recognize
- % the calls to the impure trail predicates and treat them
- % as as builtins, expanding them to MLDS trail ops in
- % ml_code_gen/ml_call_gen, and then generating inline
- % code for them here.
- ;
- AtomicStmt = inline_target_code(_TargetLang, _Components),
- % XXX We should support inserting inline asm code fragments.
- sorry($module, $pred, "target_code (for `--target asm')")
- ;
- AtomicStmt = outline_foreign_proc(_, _, _, _),
- % XXX I'm not sure if we need to handle this case.
- sorry($module, $pred, "outline_foreign_proc (for `--target asm')")
- ).
-
- % gen_init_args generates code to initialize the fields
- % of an object allocated with a new_object MLDS instruction.
- %
-:- pred gen_init_args(list(mlds_rval)::in, list(mlds_type)::in,
- mlds_context::in, int::in, mlds_lval::in, mlds_type::in,
- mlds_tag::in, defn_info::in, io::di, io::uo) is det.
-
-gen_init_args([_ | _], [], _, _, _, _, _, _, !IO) :-
- unexpected($module, $pred, "length mismatch").
-gen_init_args([], [_ | _], _, _, _, _, _, _, !IO) :-
- unexpected($module, $pred, "length mismatch").
-gen_init_args([], [], _, _, _, _, _, _, !IO).
-gen_init_args([Arg | Args], [ArgType | ArgTypes], Context, ArgNum, Target,
- Type, Tag, DefnInfo, !IO) :-
- % Currently all fields of new_object instructions are
- % represented as MR_Box, so we need to box them if necessary.
- Lval = ml_field(yes(Tag), ml_lval(Target),
- ml_field_offset(ml_const(mlconst_int(ArgNum))), mlds_generic_type,
- Type),
- Rval = ml_unop(box(ArgType), Arg),
- build_lval(Lval, DefnInfo, GCC_Lval, !IO),
- build_rval(Rval, DefnInfo, GCC_Rval, !IO),
- gcc.gen_assign(GCC_Lval, GCC_Rval, !IO),
- gen_init_args(Args, ArgTypes, Context, ArgNum + 1, Target, Type, Tag,
- DefnInfo, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output expressions.
-%
-
-:- pred build_lval(mlds_lval::in, defn_info::in, gcc.expr::out,
- io::di, io::uo) is det.
-
-build_lval(Lval, DefnInfo, GCC_Expr, !IO) :-
- (
- Lval = ml_field(MaybeTag, Rval, FieldId, FieldType, _ClassType),
- FieldId = ml_field_offset(OffsetRval),
- % Sanity check (copied from mlds_to_c.m).
- (
- ( FieldType = mlds_generic_type
- ; FieldType = mercury_type(type_variable(_, _), _, _)
- )
- ->
- true
- ;
- % The field type for field(_, _, offset(_), _, _) lvals
- % must be something that maps to MR_Box.
- unexpected($module, $pred, "unexpected field type")
- ),
-
- % Generate the tagged pointer whose field we want to extract.
- build_rval(Rval, DefnInfo, GCC_TaggedPointer, !IO),
-
- % Subtract or mask out the tag.
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- (
- MaybeTag = yes(Tag),
- gcc.build_int(Tag, GCC_Tag, !IO),
- gcc.build_binop(gcc.minus_expr, gcc.ptr_type_node,
- GCC_TaggedPointer, GCC_Tag, GCC_Pointer, !IO)
- ;
- MaybeTag = no,
- globals.lookup_int_option(Globals, num_tag_bits, TagBits),
- gcc.build_int(\ ((1 << TagBits) - 1), GCC_Mask, !IO),
- gcc.build_binop(gcc.bit_and_expr, gcc.ptr_type_node,
- GCC_TaggedPointer, GCC_Mask, GCC_Pointer, !IO)
- ),
-
- % Add the appropriate offset.
- build_rval(OffsetRval, DefnInfo, GCC_OffsetInWords, !IO),
- globals.lookup_int_option(Globals, bytes_per_word, BytesPerWord),
- gcc.build_int(BytesPerWord, GCC_BytesPerWord, !IO),
- gcc.build_binop(gcc.mult_expr, 'MR_intptr_t',
- GCC_OffsetInWords, GCC_BytesPerWord, GCC_OffsetInBytes, !IO),
- gcc.build_binop(gcc.plus_expr, gcc.ptr_type_node,
- GCC_Pointer, GCC_OffsetInBytes, GCC_FieldPointer0, !IO),
-
- % Cast the pointer to the right type (XXX is this necessary?)
- build_type(FieldType, DefnInfo ^ di_global_info, GCC_FieldType, !IO),
- gcc.build_pointer_type(GCC_FieldType, GCC_FieldPointerType, !IO),
- gcc.convert_type(GCC_FieldPointer0, GCC_FieldPointerType,
- GCC_FieldPointer, !IO),
-
- % Deference it.
- gcc.build_pointer_deref(GCC_FieldPointer, GCC_Expr, !IO)
- ;
- Lval = ml_field(MaybeTag, PtrRval, FieldId, _FieldType, _PtrType),
- FieldId = ml_field_named(FieldName, CtorType),
- % Generate the tagged pointer whose field we want to extract.
- build_rval(PtrRval, DefnInfo, GCC_TaggedPointer, !IO),
-
- % Subtract or mask out the tag.
- (
- MaybeTag = yes(Tag),
- gcc.build_int(Tag, GCC_Tag, !IO),
- gcc.build_binop(gcc.minus_expr, gcc.ptr_type_node,
- GCC_TaggedPointer, GCC_Tag, GCC_Pointer, !IO)
- ;
- MaybeTag = no,
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- globals.lookup_int_option(Globals, num_tag_bits, TagBits),
- gcc.build_int(\ ((1 << TagBits) - 1), GCC_Mask, !IO),
- gcc.build_binop(gcc.bit_and_expr, gcc.ptr_type_node,
- GCC_TaggedPointer, GCC_Mask, GCC_Pointer, !IO)
- ),
-
- % Cast the pointer to the right type.
- build_type(CtorType, DefnInfo ^ di_global_info, GCC_CtorType, !IO),
- gcc.build_pointer_type(GCC_CtorType, GCC_PointerType, !IO),
- gcc.convert_type(GCC_Pointer, GCC_PointerType,
- GCC_CastPointer, !IO),
-
- % Deference it.
- gcc.build_pointer_deref(GCC_CastPointer, GCC_ObjectRef, !IO),
-
- % Extract the right field.
- TypeTable = DefnInfo ^ di_global_info ^ gi_type_table,
- TypeName = get_class_type_name(CtorType),
- gcc_type_info(_, FieldTable) = map.lookup(TypeTable, TypeName),
- GCC_FieldDecl = map.lookup(FieldTable, FieldName),
- gcc.build_component_ref(GCC_ObjectRef, GCC_FieldDecl,
- GCC_Expr, !IO)
- ;
- Lval = ml_mem_ref(PointerRval, _Type),
- build_rval(PointerRval, DefnInfo, PointerExpr, !IO),
- gcc.build_pointer_deref(PointerExpr, GCC_Expr, !IO)
- ;
- Lval = ml_global_var_ref(_),
- sorry($module, $pred, "global_var_ref NYI")
- ;
- Lval = ml_var(qual(ModuleName, QualKind, VarName), _VarType),
- % Look up the variable in the symbol table. We try the symbol table
- % for local vars first, and then if its not there, we look in the
- % global vars symbol table. If it's not in either of those,
- % we check if its an RTTI enumeration constant.
-
- Name = qual(ModuleName, QualKind, entity_data(mlds_data_var(VarName))),
- (
- map.search(DefnInfo ^ di_local_vars, Name, LocalVarDecl)
- ->
- GCC_Expr = gcc.var_expr(LocalVarDecl)
- ;
- map.search(DefnInfo ^ di_global_info ^ gi_global_vars,
- Name, GlobalVarDecl)
- ->
- GCC_Expr = gcc.var_expr(GlobalVarDecl)
- ;
- % check if it's in the private_builtin module
- % and is an RTTI enumeration constant.
- PrivateBuiltin = mercury_private_builtin_module,
- mercury_module_name_to_mlds(PrivateBuiltin) = ModuleName,
- VarName = mlds_var_name(VarNameBase, _MaybeNum),
- rtti_enum_const(VarNameBase, IntVal)
- ->
- gcc.build_int(IntVal, GCC_Expr, !IO)
- ;
- % Check if it's private_builtin.dummy_var.
- PrivateBuiltin = mercury_private_builtin_module,
- mercury_module_name_to_mlds(PrivateBuiltin) = ModuleName,
- VarName = mlds_var_name("dummy_var", _)
- ->
- % If so, generate an extern declaration for it, and use that.
- GCC_VarName = build_data_var_name(ModuleName,
- mlds_data_var(VarName)),
- Type = 'MR_Word',
- gcc.build_extern_var_decl(GCC_VarName, Type, Decl, !IO),
- GCC_Expr = gcc.var_expr(Decl)
- ;
- unexpected($module, $pred, "undeclared variable: " ++
- build_qualified_name(Name))
- )
- ).
-
-:- func get_class_type_name(mlds_type) = mlds_qualified_entity_name.
-
-get_class_type_name(Type) = Name :-
- (
- (
- Type = mlds_class_type(ClassName, Arity, _Kind)
- ;
- Type = mlds_ptr_type(mlds_class_type(ClassName, Arity, _Kind))
- )
- ->
- ClassName = qual(ModuleName, QualKind, UnqualClassName),
- Name = qual(ModuleName, QualKind, entity_type(UnqualClassName, Arity))
- ;
- unexpected($module, $pred, "non-class_type in get_type_name")
- ).
-
-:- pred build_rval(mlds_rval::in, defn_info::in, gcc.expr::out,
- io::di, io::uo) is det.
-
-build_rval(Rval, DefnInfo, Expr, !IO) :-
- (
- Rval = ml_lval(Lval),
- build_lval(Lval, DefnInfo, Expr, !IO)
- ;
- Rval = ml_mkword(Tag, Arg),
- gcc.build_int(Tag, GCC_Tag, !IO),
- build_rval(Arg, DefnInfo, GCC_Arg, !IO),
- gcc.build_binop(gcc.plus_expr, gcc.ptr_type_node,
- GCC_Arg, GCC_Tag, Expr, !IO)
- ;
- Rval = ml_const(Const),
- build_rval_const(Const, DefnInfo ^ di_global_info, Expr, !IO)
- ;
- Rval = ml_unop(Op, SubRval),
- build_unop(Op, SubRval, DefnInfo, Expr, !IO)
- ;
- Rval = ml_binop(Op, SubRval1, SubRval2),
- build_std_binop(Op, SubRval1, SubRval2, DefnInfo, Expr, !IO)
- ;
- Rval = ml_mem_addr(Lval),
- build_lval(Lval, DefnInfo, LvalExpr, !IO),
- gcc.build_addr_expr(LvalExpr, Expr, !IO)
- ;
- Rval = ml_scalar_common(_),
- unexpected($module, $pred, "scalar_common rval")
- ;
- Rval = ml_vector_common_row(_, _),
- unexpected($module, $pred, "vector_common rval")
- ;
- Rval = ml_self(_),
- unexpected($module, $pred, "self rval")
- ).
-
-:- pred build_unop(mlds_unary_op::in, mlds_rval::in, defn_info::in,
- gcc.expr::out, io::di, io::uo) is det.
-
-build_unop(Unop, Rval, DefnInfo, GCC_Expr, !IO) :-
- (
- Unop = cast(Type),
- build_cast_rval(Type, Rval, DefnInfo, GCC_Expr, !IO)
- ;
- Unop = box(Type),
- ( type_is_float(Type) ->
- build_call(gcc.box_float_func_decl, [Rval], DefnInfo,
- GCC_Expr, !IO)
- ; Type = mlds_array_type(_) ->
- % When boxing arrays, we need to take the address of the array.
- % This implies that the array must be an lval.
- % But we also allow null arrays as a special case;
- % boxing a null array results in a null pointer.
- ( Rval = ml_const(mlconst_null(_)) ->
- PtrRval = ml_const(mlconst_null(mlds_generic_type)),
- build_rval(PtrRval, DefnInfo, GCC_Expr, !IO)
- ; Rval = ml_lval(ArrayLval) ->
- PtrRval = ml_mem_addr(ArrayLval),
- build_cast_rval(mlds_generic_type, PtrRval, DefnInfo,
- GCC_Expr, !IO)
- ;
- unexpected($module, $pred, "boxing non-lval, non-null array")
- )
- ;
- build_cast_rval(mlds_generic_type, Rval, DefnInfo, GCC_Expr, !IO)
- )
- ;
- Unop = unbox(Type),
- ( type_is_float(Type) ->
- % Generate `* (MR_Float *) <Rval>'
- build_rval(Rval, DefnInfo, GCC_Pointer, !IO),
- gcc.build_pointer_type('MR_Float', FloatPointerType, !IO),
- gcc.convert_type(GCC_Pointer, FloatPointerType,
- GCC_CastPointer, !IO),
- gcc.build_pointer_deref(GCC_CastPointer, GCC_Expr, !IO)
- ;
- build_cast_rval(Type, Rval, DefnInfo, GCC_Expr, !IO)
- )
- ;
- Unop = std_unop(StdUnop),
- build_std_unop(StdUnop, Rval, DefnInfo, GCC_Expr, !IO)
- ).
-
-:- pred type_is_float(mlds_type::in) is semidet.
-
-type_is_float(Type) :-
- ( Type = mercury_type(builtin_type(builtin_type_float), _, _)
- ; Type = mlds_native_float_type
- ).
-
-:- pred build_cast_rval(mlds_type::in, mlds_rval::in, defn_info::in,
- gcc.expr::out, io::di, io::uo) is det.
-
-build_cast_rval(Type, Rval, DefnInfo, GCC_Expr, !IO) :-
- build_rval(Rval, DefnInfo, GCC_Rval, !IO),
- build_type(Type, DefnInfo ^ di_global_info, GCC_Type, !IO),
- gcc.convert_type(GCC_Rval, GCC_Type, GCC_Expr, !IO).
-
-:- pred build_std_unop(builtin_ops.unary_op::in, mlds_rval::in, defn_info::in,
- gcc.expr::out, io::di, io::uo) is det.
-
-build_std_unop(UnaryOp, Arg, DefnInfo, Expr, !IO) :-
- build_rval(Arg, DefnInfo, GCC_Arg, !IO),
- build_unop_expr(UnaryOp, GCC_Arg, DefnInfo, Expr, !IO).
-
-:- pred build_unop_expr(builtin_ops.unary_op::in, gcc.expr::in,
- defn_info::in, gcc.expr::out, io::di, io::uo) is det.
-
-build_unop_expr(Unop, Arg, DefnInfo, Expr, !IO) :-
- (
- Unop = mktag,
- % We assume that the tag bits are kept on the low bits
- % (`--tags low'), not on the high bits (`--tags high').
- % XXX we should enforce this in handle_options.m.
- Expr = Arg
- ;
- Unop = tag,
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- globals.lookup_int_option(Globals, num_tag_bits, TagBits),
- gcc.build_int((1 << TagBits) - 1, Mask, !IO),
- gcc.build_binop(gcc.bit_and_expr, 'MR_intptr_t',
- Arg, Mask, Expr, !IO)
- ;
- Unop = unmktag,
- Expr = Arg
- ;
- Unop = mkbody,
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- globals.lookup_int_option(Globals, num_tag_bits, TagBits),
- gcc.build_int(TagBits, TagBitsExpr, !IO),
- gcc.build_binop(gcc.lshift_expr, 'MR_intptr_t',
- Arg, TagBitsExpr, Expr, !IO)
- ;
- Unop = unmkbody,
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- globals.lookup_int_option(Globals, num_tag_bits, TagBits),
- gcc.build_int(TagBits, TagBitsExpr, !IO),
- gcc.build_binop(gcc.rshift_expr, 'MR_intptr_t',
- Arg, TagBitsExpr, Expr, !IO)
- ;
- Unop = strip_tag,
- Globals = DefnInfo ^ di_global_info ^ gi_globals,
- globals.lookup_int_option(Globals, num_tag_bits, TagBits),
- gcc.build_int((1 << TagBits) - 1, Mask, !IO),
- gcc.build_unop(gcc.bit_not_expr, 'MR_intptr_t',
- Mask, InvertedMask, !IO),
- gcc.build_binop(gcc.bit_and_expr, 'MR_intptr_t',
- Arg, InvertedMask, Expr, !IO)
- ;
- Unop = bitwise_complement,
- gcc.build_unop(gcc.bit_not_expr, 'MR_Integer', Arg, Expr, !IO)
- ;
- Unop = logical_not,
- gcc.build_unop(gcc.truth_not_expr, gcc.boolean_type_node,
- Arg, Expr, !IO)
- ;
- Unop = hash_string,
- gcc.build_func_addr_expr(gcc.hash_string_func_decl,
- HashStringFuncExpr, !IO),
- gcc.empty_arg_list(GCC_ArgList0, !IO),
- gcc.cons_arg_list(Arg, GCC_ArgList0, GCC_ArgList, !IO),
- IsTailCall = no,
- gcc.build_call_expr(HashStringFuncExpr, GCC_ArgList, IsTailCall,
- Expr, !IO)
- ;
- ( Unop = hash_string2
- ; Unop = hash_string3
- ),
- unexpected($module, $pred, "hash_string2/3")
- ).
-
-:- pred build_std_binop(builtin_ops.binary_op::in,
- mlds_rval::in, mlds_rval::in, defn_info::in, gcc.expr::out,
- io::di, io::uo) is det.
-
-build_std_binop(BinaryOp, Arg1, Arg2, DefnInfo, Expr, !IO) :-
- ( string_compare_op(BinaryOp, CorrespondingIntOp) ->
- % treat string comparison operators specially:
- % convert "X `str_OP` Y" into "strcmp(X, Y) `OP` 0".
- build_call(gcc.strcmp_func_decl, [Arg1, Arg2], DefnInfo,
- GCC_Call, !IO),
- gcc.build_int(0, Zero, !IO),
- gcc.build_binop(CorrespondingIntOp, gcc.boolean_type_node,
- GCC_Call, Zero, Expr, !IO)
- ; unsigned_compare_op(BinaryOp, _GCC_BinaryOp) ->
- % XXX This is not implemented yet, because we don't have
- % 'MR_Unsigned'. But unsigned_le is only needed for dense
- % (computed_goto) switches, and we set
- % target_supports_computed_goto to no for this target,
- % so we shouldn't get any of these.
- unexpected($module, $pred, "unsigned comparison operator")
- /***
- %
- % Treat unsigned comparison operators specially:
- % convert the arguments to unsigned.
- %
- build_rval(Arg1, DefnInfo, GCC_Arg1),
- build_rval(Arg2, DefnInfo, GCC_Arg2),
- gcc.convert_type(GCC_Arg1, 'MR_Unsigned', GCC_UnsignedArg1),
- gcc.convert_type(GCC_Arg2, 'MR_Unsigned', GCC_UnsignedArg2),
- gcc.build_binop(GCC_BinaryOp, gcc.boolean_type_node,
- GCC_UnsignedArg1, GCC_UnsignedArg2, Expr)
- ***/
- ;
- % The usual case: just build a gcc tree node for the expr.
-
- build_rval(Arg1, DefnInfo, GCC_Arg1, !IO),
- build_rval(Arg2, DefnInfo, GCC_Arg2, !IO),
- ( BinaryOp = array_index(ElemType) ->
- % for array index operations,
- % we need to convert the element type into a GCC type
- GCC_BinaryOp = gcc.array_ref,
- MLDS_Type = ml_gen_array_elem_type(ElemType),
- build_type(MLDS_Type, DefnInfo ^ di_global_info,
- GCC_ResultType, !IO)
- ;
- convert_binary_op(BinaryOp, GCC_BinaryOp, GCC_ResultType)
- ),
- gcc.build_binop(GCC_BinaryOp, GCC_ResultType,
- GCC_Arg1, GCC_Arg2, Expr, !IO)
- ).
-
-:- pred string_compare_op(builtin_ops.binary_op::in, gcc.op::out) is semidet.
-
-string_compare_op(str_eq, gcc.eq_expr).
-string_compare_op(str_ne, gcc.ne_expr).
-string_compare_op(str_lt, gcc.lt_expr).
-string_compare_op(str_gt, gcc.gt_expr).
-string_compare_op(str_le, gcc.le_expr).
-string_compare_op(str_ge, gcc.ge_expr).
-
-:- pred unsigned_compare_op(builtin_ops.binary_op::in, gcc.op::out) is semidet.
-
-unsigned_compare_op(unsigned_le, gcc.le_expr).
-
- % Convert one of our operators to the corresponding gcc operator.
- % Also compute the gcc return type.
- %
-:- pred convert_binary_op(builtin_ops.binary_op::in,
- gcc.op::out, gcc.gcc_type::out) is det.
-
- % Operator GCC operator GCC result type
-convert_binary_op(int_add, gcc.plus_expr, 'MR_Integer').
-convert_binary_op(int_sub, gcc.minus_expr, 'MR_Integer').
-convert_binary_op(int_mul, gcc.mult_expr, 'MR_Integer').
-convert_binary_op(int_div, gcc.trunc_div_expr, 'MR_Integer').
-convert_binary_op(int_mod, gcc.trunc_mod_expr, 'MR_Integer').
-convert_binary_op(unchecked_left_shift, gcc.lshift_expr, 'MR_Integer').
-convert_binary_op(unchecked_right_shift,gcc.rshift_expr, 'MR_Integer').
-convert_binary_op(bitwise_and, gcc.bit_and_expr, 'MR_Integer').
-convert_binary_op(bitwise_or, gcc.bit_ior_expr, 'MR_Integer').
-convert_binary_op(bitwise_xor, gcc.bit_xor_expr, 'MR_Integer').
-convert_binary_op(logical_and, gcc.truth_andif_expr, gcc.boolean_type_node).
-convert_binary_op(logical_or, gcc.truth_orif_expr, gcc.boolean_type_node).
-convert_binary_op(eq, gcc.eq_expr, gcc.boolean_type_node).
-convert_binary_op(ne, gcc.ne_expr, gcc.boolean_type_node).
-convert_binary_op(body, gcc.minus_expr, 'MR_intptr_t').
-convert_binary_op(array_index(_), _, _) :-
- unexpected($module, $pred, "array_index").
-convert_binary_op(str_eq, _, _) :- unexpected($module, $pred, "str_eq").
-convert_binary_op(str_ne, _, _) :- unexpected($module, $pred, "str_ne").
-convert_binary_op(str_lt, _, _) :- unexpected($module, $pred, "str_lt").
-convert_binary_op(str_gt, _, _) :- unexpected($module, $pred, "str_gt").
-convert_binary_op(str_le, _, _) :- unexpected($module, $pred, "str_le").
-convert_binary_op(str_ge, _, _) :- unexpected($module, $pred, "str_ge").
-convert_binary_op(str_cmp, _, _) :-
- unexpected($module, $pred, "str_cmp").
-convert_binary_op(int_lt, gcc.lt_expr, gcc.boolean_type_node).
-convert_binary_op(int_gt, gcc.gt_expr, gcc.boolean_type_node).
-convert_binary_op(int_le, gcc.le_expr, gcc.boolean_type_node).
-convert_binary_op(int_ge, gcc.ge_expr, gcc.boolean_type_node).
-convert_binary_op(unsigned_le, _, _) :-
- unexpected($module, $pred, "unsigned_le").
-convert_binary_op(float_plus, gcc.plus_expr, 'MR_Float').
-convert_binary_op(float_minus, gcc.minus_expr, 'MR_Float').
-convert_binary_op(float_times, gcc.mult_expr, 'MR_Float').
-convert_binary_op(float_divide, gcc.rdiv_expr, 'MR_Float').
-convert_binary_op(float_eq, gcc.eq_expr, gcc.boolean_type_node).
-convert_binary_op(float_ne, gcc.ne_expr, gcc.boolean_type_node).
-convert_binary_op(float_lt, gcc.lt_expr, gcc.boolean_type_node).
-convert_binary_op(float_gt, gcc.gt_expr, gcc.boolean_type_node).
-convert_binary_op(float_le, gcc.le_expr, gcc.boolean_type_node).
-convert_binary_op(float_ge, gcc.ge_expr, gcc.boolean_type_node).
-convert_binary_op(float_word_bits, _, _) :-
- unexpected($module, $pred, "float_word_bits").
-convert_binary_op(float_from_dword, _, _) :-
- unexpected($module, $pred, "float_from_dword").
-convert_binary_op(compound_eq, _, _) :-
- unexpected($module, $pred, "compound_eq").
-convert_binary_op(compound_lt, _, _) :-
- unexpected($module, $pred, "compound_lt").
-
-:- pred build_call(gcc.func_decl::in, list(mlds_rval)::in, defn_info::in,
- gcc.expr::out, io::di, io::uo) is det.
-
-build_call(FuncDecl, ArgList, DefnInfo, GCC_Call, !IO) :-
- gcc.build_func_addr_expr(FuncDecl, FuncExpr, !IO),
- build_args(ArgList, DefnInfo, GCC_ArgList, !IO),
- IsTailCall = no,
- gcc.build_call_expr(FuncExpr, GCC_ArgList, IsTailCall, GCC_Call, !IO).
-
-:- pred build_args(list(mlds_rval)::in, defn_info::in, gcc.arg_list::out,
- io::di, io::uo) is det.
-
-build_args([], _DefnInfo, EmptyArgList, !IO) :-
- gcc.empty_arg_list(EmptyArgList, !IO).
-build_args([Arg | Args], DefnInfo, GCC_ArgList, !IO) :-
- build_rval(Arg, DefnInfo, GCC_Expr, !IO),
- build_args(Args, DefnInfo, GCC_ArgList0, !IO),
- gcc.cons_arg_list(GCC_Expr, GCC_ArgList0, GCC_ArgList, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% Code to output constants.
-%
-
-:- pred build_rval_const(mlds_rval_const::in, global_info::in, gcc.expr::out,
- io::di, io::uo) is det.
-
-build_rval_const(Const, GlobalInfo, Expr, !IO) :-
- (
- Const = mlconst_true,
- % XXX currently we don't use a separate boolean type
- gcc.build_int(1, Expr, !IO)
- ;
- Const = mlconst_false,
- % XXX currently we don't use a separate boolean type
- gcc.build_int(0, Expr, !IO)
- ;
- ( Const = mlconst_int(N)
- ; Const = mlconst_char(N)
- ; Const = mlconst_enum(N, _)
- ),
- gcc.build_int(N, Expr, !IO)
- ;
- Const = mlconst_foreign(_Lang, _Value, _Type),
- sorry($module, $pred,
- "foreign tags not yet supported with `--target asm'")
- ;
- Const = mlconst_float(FloatVal),
- gcc.build_float(FloatVal, Expr, !IO)
- ;
- Const = mlconst_string(String),
- gcc.build_string(String, Expr, !IO)
- ;
- Const = mlconst_multi_string(_Strings),
- % multi-strings are only used for the debugger
- sorry($module, $pred,
- "debugging not yet supported with `--target asm'")
- ;
- Const = mlconst_named_const(_NamedConst),
- sorry($module, $pred,
- "named consts not yet supported with `--target asm'")
- ;
- Const = mlconst_code_addr(CodeAddr),
- build_code_addr(CodeAddr, GlobalInfo, Expr, !IO)
- ;
- Const = mlconst_data_addr(DataAddr),
- build_data_addr(DataAddr, Expr, !IO)
- ;
- Const = mlconst_null(_Type),
- % XXX is it OK to ignore the type here?
- gcc.build_null_pointer(Expr, !IO)
- ).
-
-:- pred build_code_addr(mlds_code_addr::in, global_info::in, gcc.expr::out,
- io::di, io::uo) is det.
-
-build_code_addr(CodeAddr, GlobalInfo, Expr, !IO) :-
- (
- CodeAddr = code_addr_proc(Label, Signature),
- MaybeSeqNum = no
- ;
- CodeAddr = code_addr_internal(Label, SeqNum, Signature),
- MaybeSeqNum = yes(SeqNum)
- ),
- % Convert the label into a entity_name, so we can use make_func_decl below.
- Label = qual(ModuleName, QualKind,
- mlds_proc_label(PredLabel, ProcId)),
- Name = qual(ModuleName, QualKind, entity_function(PredLabel, ProcId,
- MaybeSeqNum, invalid_pred_id)),
- % Build a function declaration for the function, and take its address.
- make_func_decl(Name, Signature, GlobalInfo, FuncDecl, !IO),
- gcc.build_func_addr_expr(FuncDecl, Expr, !IO).
-
-:- pred build_data_addr(mlds_data_addr::in, gcc.expr::out,
- io::di, io::uo) is det.
-
-build_data_addr(DataAddr, Expr, !IO) :-
- build_data_decl(DataAddr, Decl, !IO),
- gcc.build_addr_expr(gcc.var_expr(Decl), Expr, !IO).
-
-:- pred build_data_decl(mlds_data_addr::in, gcc.var_decl::out,
- io::di, io::uo) is det.
-
-build_data_decl(data_addr(ModuleName, DataName), Decl, !IO) :-
- % XXX Bug! Type won't always be 'MR_Word'
- % XXX Bug! Shouldn't always be extern
- VarName = build_data_var_name(ModuleName, DataName),
- Type = 'MR_Word',
- gcc.build_extern_var_decl(VarName, Type, Decl, !IO).
-
-:- func build_data_var_name(mlds_module_name, mlds_data_name) = string.
-
-build_data_var_name(ModuleName, DataName) =
- ModuleQualifier ++ build_data_name(DataName) :-
- (
- DataName = mlds_rtti(RttiId),
- module_qualify_name_of_rtti_id(RttiId) = no
- ->
- ModuleQualifier = ""
- ;
- ModuleNameString = get_module_name(
- mlds_module_name_to_sym_name(ModuleName)),
- ModuleQualifier = string.append(ModuleNameString, "__")
- ).
-
-%-----------------------------------------------------------------------------%
-%
-% Generation of source context info (file name and line number annotations).
-%
-
-:- pred set_context(mlds_context::in, io::di, io::uo) is det.
-
-set_context(MLDS_Context, !IO) :-
- ProgContext = mlds_get_prog_context(MLDS_Context),
- FileName = term.context_file(ProgContext),
- LineNumber = term.context_line(ProgContext),
- gcc.set_context(FileName, LineNumber, !IO).
-
-:- pred gen_context(mlds_context::in, io::di, io::uo) is det.
-
-gen_context(MLDS_Context, !IO) :-
- ProgContext = mlds_get_prog_context(MLDS_Context),
- FileName = term.context_file(ProgContext),
- LineNumber = term.context_line(ProgContext),
- gcc.gen_line_note(FileName, LineNumber, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% "Typedefs", i.e. constants of type `gcc.gcc_type'.
-%
-% We use the same names for types as in the MLDS -> C back-end.
-%
-
-:- func 'MR_Box' = gcc.gcc_type.
-:- func 'MR_Integer' = gcc.gcc_type.
-:- func 'MR_Float' = gcc.gcc_type.
-:- func 'MR_Char' = gcc.gcc_type.
-:- func 'MR_String' = gcc.gcc_type.
-:- func 'MR_ConstString' = gcc.gcc_type.
-:- func 'MR_Word' = gcc.gcc_type.
-:- func 'MR_bool' = gcc.gcc_type.
-:- func 'MR_ProcAddr' = gcc.gcc_type.
-:- func 'MR_TypeInfo' = gcc.gcc_type.
-:- func 'MR_TypeCtorInfo' = gcc.gcc_type.
-:- func 'MR_PseudoTypeInfo' = gcc.gcc_type.
-:- func 'MR_Sectag_Locn' = gcc.gcc_type.
-:- func 'MR_TypeCtorRep' = gcc.gcc_type.
-:- func 'MR_Determinism' = gcc.gcc_type.
-:- func 'MR_PredFunc' = gcc.gcc_type.
-
-:- func 'MR_int_least8_t' = gcc.gcc_type.
-:- func 'MR_int_least16_t' = gcc.gcc_type.
-:- func 'MR_int_least32_t' = gcc.gcc_type.
-:- func 'MR_int_least64_t' = gcc.gcc_type.
-:- func 'MR_intptr_t' = gcc.gcc_type.
-
-'MR_Box' = gcc.ptr_type_node.
-'MR_Integer' = gcc.intptr_type_node.
-'MR_Float' = gcc.double_type_node.
-'MR_Char' = gcc.char_type_node.
-'MR_String' = gcc.string_type_node.
- % XXX 'MR_ConstString' should really be const
-'MR_ConstString' = gcc.string_type_node.
- % XXX 'MR_Word' should perhaps be unsigned, to match the C back-end
-'MR_Word' = gcc.intptr_type_node.
-'MR_bool' = gcc.integer_type_node. % i.e. typedef int MR_bool
-'MR_ProcAddr' = gcc.ptr_type_node.
-
-'MR_TypeInfo' = gcc.ptr_type_node.
-'MR_TypeCtorInfo' = gcc.ptr_type_node.
-'MR_PseudoTypeInfo' = gcc.ptr_type_node.
-
- % XXX MR_Sectag_Locn, MR_TypeCtorRep, MR_Determinism and MR_PredFunc
- % are actually enums in the C back-end. Binary compatibility between
- % this back-end and the C back-end only works if the C compiler
- % represents these enums the same as `int'.
-'MR_Sectag_Locn' = gcc.integer_type_node.
-'MR_TypeCtorRep' = gcc.integer_type_node.
-'MR_Determinism' = gcc.integer_type_node.
-'MR_PredFunc' = gcc.integer_type_node.
-
-'MR_int_least8_t' = gcc.int8_type_node.
-'MR_int_least16_t' = gcc.int16_type_node.
-'MR_int_least32_t' = gcc.int32_type_node.
-'MR_int_least64_t' = gcc.int64_type_node.
-'MR_intptr_t' = gcc.intptr_type_node.
-
-%-----------------------------------------------------------------------------%
-:- end_module mlds_to_gcc.
-%-----------------------------------------------------------------------------%
diff --git a/compiler/mlds_to_il.m b/compiler/mlds_to_il.m
index 1bddc1d..a7ea120 100644
--- a/compiler/mlds_to_il.m
+++ b/compiler/mlds_to_il.m
@@ -1989,8 +1989,6 @@
atomic_statement_to_il(inline_target_code(ml_target_csharp, _Code),
_Instrs,
atomic_statement_to_il(inline_target_code(ml_target_java, _Code), _Instrs,
!Info) :-
unexpected($module, $pred, "ml_target_java").
-atomic_statement_to_il(inline_target_code(ml_target_asm, _), _, !Info) :-
- unexpected($module, $pred, "ml_target_asm").
atomic_statement_to_il(inline_target_code(ml_target_gnu_c, _), _, !Info) :-
unexpected($module, $pred, "ml_target_gnu_c").
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 8bd3794..5acbe9f 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -1690,7 +1690,6 @@ rename_class_names_atomic(Renaming, !Statement) :-
;
( Lang = ml_target_c
; Lang = ml_target_gnu_c
- ; Lang = ml_target_asm
; Lang = ml_target_il
; Lang = ml_target_csharp
)
@@ -4532,7 +4531,6 @@ output_atomic_stmt(Info, Indent, AtomicStmt,
Context, !IO) :-
;
( TargetLang = ml_target_c
; TargetLang = ml_target_gnu_c
- ; TargetLang = ml_target_asm
; TargetLang = ml_target_il
; TargetLang = ml_target_csharp
),
diff --git a/compiler/modules.m b/compiler/modules.m
index 2644f22..4ff0cb1 100644
--- a/compiler/modules.m
+++ b/compiler/modules.m
@@ -2688,7 +2688,6 @@ generate_dependencies_write_d_files(Globals, [Dep | Deps],
globals.get_target(Globals, Target),
( Target = target_c, Lang = lang_c
- ; Target = target_asm, Lang = lang_c
; Target = target_java, Lang = lang_java
; Target = target_csharp, Lang = lang_csharp
; Target = target_il, Lang = lang_il
diff --git a/compiler/notes/compiler_design.html
b/compiler/notes/compiler_design.html
index 922271c..3ccd106 100644
--- a/compiler/notes/compiler_design.html
+++ b/compiler/notes/compiler_design.html
@@ -1666,15 +1666,6 @@ and one generates Java.
<p>
-The MLDS->asm backend is logically part of the MLDS back-ends,
-but it is in a module of its own (mlds_to_gcc.m), rather than being
-part of the ml_backend package, so that we can distribute a version
-of the Mercury compiler which does not include it. There is a wrapper
-module called maybe_mlds_to_gcc.m which is generated at configuration time
-so that mlds_to_gcc.m will be linked in iff the GCC back-end is available.
-
-<p>
-
The MLDS->IL backend is broken into several submodules.
<ul>
<li> mlds_to_ilasm.m converts MLDS to IL assembler and writes it to a .il file.
diff --git a/compiler/notes/work_in_progress.html
b/compiler/notes/work_in_progress.html
index 3f65979..c4621ea 100644
--- a/compiler/notes/work_in_progress.html
+++ b/compiler/notes/work_in_progress.html
@@ -69,9 +69,6 @@ distribution.
<li> Better support for inter-module analysis and optimization.
-<li> Support for GCC 3.3 in the native code back-end.
- This is on the "gcc_3_3" branch of our CVS repository.
-
</ul>
<hr>
diff --git a/compiler/options.m b/compiler/options.m
index 82cfb86..ceee077 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -607,7 +607,6 @@
; num_real_f_regs
; num_real_r_temps
; num_real_f_temps
- ; pic
; max_jump_table_size
; max_specialized_do_call_closure
; max_specialized_do_call_class_method
@@ -1458,7 +1457,6 @@ option_defaults_2(code_gen_option, [
% The `mmc' script will override the
% above defaults with values determined
% at configuration time.
- pic - bool(no),
max_jump_table_size - int(0),
% 0 indicates any size.
max_specialized_do_call_closure - int(5),
@@ -2270,7 +2268,6 @@ long_option("use-minimal-model-own-stacks",
use_minimal_model_own_stacks).
long_option("minimal-model-debug", minimal_model_debug).
long_option("single-prec-float", single_prec_float).
long_option("single-precision-float", single_prec_float).
-long_option("pic", pic).
long_option("pic-reg", pic_reg).
long_option("tags", tags).
long_option("num-tag-bits", num_tag_bits).
@@ -3792,7 +3789,6 @@ options_help_output -->
"\tCheck the module for errors, but do not generate any code.",
"-C, --target-code-only",
"\tGenerate target code (i.e. C code in `<module>.c',",
- "\tassembler code in `<module>.s' or `<module>.pic_s',",
"\tIL code in `<module>.il', or Java code in",
"\t`<module>.java'), but not object code.",
"-c, --compile-only",
@@ -4242,21 +4238,15 @@ options_help_compilation_model -->
write_tabbed_lines([
"--target c\t\t\t(grades: none, reg, jump, fast,",
"\t\t\t\t\tasm_jump, asm_fast, hl, hlc)",
- "--target asm\t\t\t(grades: hlc)",
"--target il\t\t\t(grades: il)",
"--target csharp\t\t\t(grades: csharp)",
"--target java\t\t\t(grades: java)",
"--target erlang\t\t\t(grades: erlang)",
- "\tSpecify the target language: C, assembler, IL, C#, Java or Erlang.",
+ "\tSpecify the target language: C, IL, C#, Java or Erlang.",
"\tThe default is C. ""IL"" (also known as ""CIL"" or ""MSIL"")",
"\tis the Intermediate Language for the .NET Common Language",
"\tRuntime.",
"\tTargets other than C imply `--high-level-code' (see below).",
- "\tAs an exception to the usual rule for options in this section,",
- "\twhere different option settings normally correspond to different",
- "\tABIs, code generated using `--target asm' is binary compatible",
- "\twith code generated using `--target c --high-level-code', so",
- "\tthese both use grade `hlc'.",
% IL options are commented out to reduce confusion.
% "--il",
@@ -4811,12 +4801,6 @@ options_help_code_generation -->
% "\tEnables the generation of code that helps to debug tabling",
% "\tprimitives.",
- "--pic",
- "\tGenerate position-independent code.",
- "\tThis option is only used by the `--target asm' back-end.",
- "\tThe generated assembler code will be written to",
- "\t`<module>.pic_s' rather than to `<module>.s'.",
-
"--no-trad-passes",
"\tThe default `--trad-passes' completely processes each predicate",
"\tbefore going on to the next predicate.",
diff --git a/compiler/prog_foreign.m b/compiler/prog_foreign.m
index ef95b3f..5785212 100644
--- a/compiler/prog_foreign.m
+++ b/compiler/prog_foreign.m
@@ -300,14 +300,6 @@ prefer_foreign_language(_Globals, target_c, Lang1, Lang2) =
no
).
-prefer_foreign_language(_Globals, target_asm, Lang1, Lang2) =
- % When compiling to asm, C is always preferred over any other language.
- ( Lang2 = lang_c, not Lang1 = lang_c ->
- yes
- ;
- no
- ).
-
prefer_foreign_language(_Globals, target_il, Lang1, Lang2) = Comp :-
% When compiling to il, first we prefer il, then csharp.
% After that we don't care.
diff --git a/compiler/prog_item.m b/compiler/prog_item.m
index eab5652..a648128 100644
--- a/compiler/prog_item.m
+++ b/compiler/prog_item.m
@@ -1176,9 +1176,7 @@ do_get_item_foreign_code(Globals, Pragma,
Context, !Info) :-
(
% We generate some C code for fact tables, so we need to treat
% modules containing fact tables as if they contain foreign code.
- ( Target = target_asm
- ; Target = target_c
- )
+ Target = target_c
->
!Info ^ used_foreign_languages :=
set.insert(!.Info ^ used_foreign_languages, lang_c)
diff --git a/compiler/simplify.m b/compiler/simplify.m
index c368519..76557bc 100644
--- a/compiler/simplify.m
+++ b/compiler/simplify.m
@@ -2181,7 +2181,6 @@ simplify_goal_trace_goal(MaybeCompiletimeExpr,
MaybeRuntimeExpr, SubGoal,
!:EvalAttributes = default_attributes(lang_csharp)
;
( Target = target_il
- ; Target = target_asm
; Target = target_x86_64
),
sorry($module, $pred,
diff --git a/compiler/write_deps_file.m b/compiler/write_deps_file.m
index 9072084..af70be2 100644
--- a/compiler/write_deps_file.m
+++ b/compiler/write_deps_file.m
@@ -587,10 +587,6 @@ write_dependency_file(Globals, Module,
AllDepsSet, MaybeTransOptDeps, !IO) :-
ForeignImportTargets = [ObjFileName, PicObjFileName],
ForeignImportExt = ".mh"
;
- Target = target_asm,
- ForeignImportTargets = [ObjFileName, PicObjFileName],
- ForeignImportExt = ".mh"
- ;
% XXX These are just the C ones at the moment.
Target = target_x86_64,
ForeignImportTargets = [ObjFileName, PicObjFileName],
@@ -1139,7 +1135,6 @@ generate_dv_file(Globals, SourceFileName,
ModuleName, DepsMap, DepStream,
( Target = target_c
; Target = target_csharp
; Target = target_java
- ; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
),
@@ -1252,85 +1247,35 @@ generate_dv_file(Globals, SourceFileName,
ModuleName, DepsMap, DepStream,
".$(EXT_FOR_PIC_OBJECTS)", DepStream, !IO),
io.write_string(DepStream, "\n", !IO),
- IsNested = (pred(Mod::in) is semidet :-
- get_submodule_kind(Mod, DepsMap) = nested_submodule
- ),
- (
- % For --target asm, we only generate separate object files
- % for top-level modules and separate sub-modules, not for
- % nested sub-modules.
- Target = target_asm,
- list.filter(IsNested, Modules, NestedModules, MainModules),
- NestedModules = [_ | _]
- ->
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".ss = ", !IO),
- write_dependencies_list(Globals, MainModules, ".s", DepStream, !IO),
- io.write_string(DepStream, "\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".pic_ss = ", !IO),
- write_dependencies_list(Globals, MainModules,
- ".pic_s", DepStream, !IO),
- io.write_string(DepStream, "\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".s_dates = ", !IO),
- write_dependencies_list(Globals, MainModules,
- ".s_date", DepStream, !IO),
- io.write_string(DepStream, "\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".pic_s_dates = ", !IO),
- write_dependencies_list(Globals, MainModules,
- ".pic_s_date", DepStream, !IO),
- io.write_string(DepStream, "\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".os = ", !IO),
- write_dependencies_list(Globals, MainModules, ".$O", DepStream, !IO),
- write_extra_link_dependencies_list(Globals, ExtraLinkObjs,
- ".$O", DepStream, !IO),
- io.write_string(DepStream, "\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".pic_os = ", !IO),
- write_dependencies_list(Globals, MainModules,
- ".$(EXT_FOR_PIC_OBJECTS)", DepStream, !IO),
- write_extra_link_dependencies_list(Globals, ExtraLinkObjs,
- ".$(EXT_FOR_PIC_OBJECTS)", DepStream, !IO),
- io.write_string(DepStream, "\n", !IO)
- ;
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".ss = $(", !IO),
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".all_ss)\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".pic_ss = $(", !IO),
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".all_pic_ss)\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".s_dates = $(", !IO),
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".all_s_dates)\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".pic_s_dates = $(", !IO),
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".all_pic_s_dates)\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".os = $(", !IO),
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".all_os)\n", !IO),
-
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".pic_os = $(", !IO),
- io.write_string(DepStream, MakeVarName, !IO),
- io.write_string(DepStream, ".all_pic_os)\n", !IO)
- ),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".ss = $(", !IO),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".all_ss)\n", !IO),
+
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".pic_ss = $(", !IO),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".all_pic_ss)\n", !IO),
+
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".s_dates = $(", !IO),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".all_s_dates)\n", !IO),
+
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".pic_s_dates = $(", !IO),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".all_pic_s_dates)\n", !IO),
+
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".os = $(", !IO),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".all_os)\n", !IO),
+
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".pic_os = $(", !IO),
+ io.write_string(DepStream, MakeVarName, !IO),
+ io.write_string(DepStream, ".all_pic_os)\n", !IO),
% $(foo.cs_or_ss) contains the names of the generated intermediate
% files between `.m' and `.o' files. This is used in foo.dep
@@ -1462,16 +1407,9 @@ generate_dv_file(Globals, SourceFileName,
ModuleName, DepsMap, DepStream,
(
HighLevelCode = yes,
(
- ( Target = target_c
- ; Target = target_asm
- ),
+ Target = target_c,
% For the `--target c' MLDS back-end, we generate `.mih' files
- % for every module. Likewise for the `--target asm' back-end.
- % (For the `--target asm' back-end, we previously used to do
- % that only for modules that contain C code, but this caused
- % trouble when trying to interoperate between compiled with
- % `--target c' and code compiled with `--target asm', so now we
- % generate them unconditionally.)
+ % for every module.
write_compact_dependencies_list(Globals, Modules,
"$(mihs_subdir)", ".mih", Basis, DepStream, !IO)
;
@@ -1496,7 +1434,6 @@ generate_dv_file(Globals, SourceFileName,
ModuleName, DepsMap, DepStream,
io.write_string(DepStream, ".mhs = ", !IO),
(
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64
),
write_compact_dependencies_list(Globals, Modules, "", ".mh", Basis,
@@ -1689,17 +1626,9 @@ get_extra_link_objects_2([Module | Modules],
DepsMap, Target,
assoc_list.from_corresponding_lists(FactDeps, ModuleList, FactTableObjs),
% Handle object files for foreign code.
- % XXX Currently we only support `C' foreign code.
- (
- Target = target_asm,
- ModuleImports ^ mai_has_foreign_code = contains_foreign_code(Langs),
- set.member(lang_c, Langs)
- ->
- FileName = sym_name_to_string(Module),
- NewLinkObjs = [(FileName ++ "__c_code") - Module | FactTableObjs]
- ;
- NewLinkObjs = FactTableObjs
- ),
+ % NOTE: currently none of the backends support foreign code in a non
+ % target language.
+ NewLinkObjs = FactTableObjs,
list.append(NewLinkObjs, !ExtraLinkObjs),
get_extra_link_objects_2(Modules, DepsMap, Target, !ExtraLinkObjs).
@@ -1865,7 +1794,6 @@ generate_dep_file_exec_library_targets(Globals,
DepStream, ModuleName,
Rules = []
;
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64 % XXX this is only provisional.
),
Rules = MainRule
@@ -1962,7 +1890,6 @@ generate_dep_file_exec_library_targets(Globals,
DepStream, ModuleName,
LibRules = []
;
( Target = target_c
- ; Target = target_asm
; Target = target_x86_64 % XXX This is only provisional.
),
LibRules = LibRule
diff --git a/configure.ac b/configure.ac
index 13c2af1..39bbffe 100644
--- a/configure.ac
+++ b/configure.ac
@@ -99,7 +99,6 @@ AC_SUBST(RECONFIGURE_ARGS)
#-----------------------------------------------------------------------------#
-remake_dependencies=false
AC_CONFIG_HEADER(runtime/mercury_conf.h)
AC_PREFIX_DEFAULT(/usr/local/mercury-`. ./VERSION; echo $VERSION`)
@@ -674,90 +673,6 @@ esac
AC_SUBST(ENABLE_BOEHM_USE_MUNMAP)
#-----------------------------------------------------------------------------#
-#
-# Find the GCC source code
-# and determine whether or not to enable the GCC back-end interface.
-#
-
-AC_ARG_ENABLE(gcc-back-end,
- AC_HELP_STRING([--enable-gcc-back-end],
- [enable the Mercury compiler's GCC back-end interface]),
- enable_gcc_back_end="$enableval",enable_gcc_back_end=default)
-
-AC_MSG_CHECKING(for GCC source directory)
-gcc_src_dir=not_found
-case "$enable_gcc_back_end" in
- yes|no|default)
- # Search for the gcc source code;
- # first try in a subdirectory of this directory,
- # then one parallel to this directory,
- # and finally try one level up.
- for dir in gcc ../gcc ..; do
- if test -f $dir/gcc/tree.c; then
- gcc_src_dir="$dir"
- break
- fi
- done
- ;;
- *)
- # The user has specified the gcc source directory via
- # `--enable-gcc-back-end=<directory>'. Check that
- # they specified it correctly.
- gcc_src_dir="$enable_gcc_back_end"
- if test -f "$gcc_src_dir"/gcc/tree.c; then
- enable_gcc_back_end=yes
- else
- AC_MSG_RESULT($gcc_src_dir)
- AC_MSG_ERROR(
-[--enable-gcc-back-end=$gcc_src_dir specified,
- but GCC source code not found in $gcc_src_dir])
- fi
- ;;
-esac
-AC_MSG_RESULT($gcc_src_dir)
-AC_MSG_CHECKING(whether to enable the GCC back-end interface)
-case "$enable_gcc_back_end" in
- yes|default)
- if test "$gcc_src_dir" = not_found; then
- case $enable_gcc_back_end in
- yes)
- AC_MSG_RESULT(yes)
- AC_MSG_ERROR(
-[--enable-gcc-back-end specified, but gcc source
- code not found])
- ;;
- default)
- enable_gcc_back_end=no
- ;;
- esac
- else
- enable_gcc_back_end=yes
- fi
- ;;
- no)
- ;;
-esac
-case $enable_gcc_back_end in
- yes)
- if test "$BOOTSTRAP_MC" = ""; then
- AC_MSG_RESULT(yes)
- AC_MSG_ERROR(
-[--enable-gcc-back-end requires an already
- installed Mercury compiler])
- else
- # This will regenerate compiler/maybe_mlds_to_gcc.m.
- remake_dependencies=true
- fi
- ;;
-esac
-
-AC_MSG_RESULT($enable_gcc_back_end)
-ENABLE_GCC_BACK_END=$enable_gcc_back_end
-GCC_SRC_DIR=$gcc_src_dir
-AC_SUBST(ENABLE_GCC_BACK_END)
-AC_SUBST(GCC_SRC_DIR)
-
-#-----------------------------------------------------------------------------#
MERCURY_MSG("looking for GNU Make...")
AC_PROGRAMS_CHECK(GNU_MAKE,gmake make)
@@ -5585,11 +5500,4 @@ MERCURY_MSG("as shown by the fine-tuning
section of the INSTALL file or by")
MERCURY_MSG("compiling the files of each grade in parallel which you can do")
MERCURY_MSG("via a command such as make PARALLEL=-j2 install.")
-case "$remake_dependencies.$reconfiguring" in
- "true.no")
- MERCURY_MSG("regenerating dependencies to enable GCC backend.")
- MMAKE_DIR="`pwd`"/scripts scripts/mmake depend || exit 1
- ;;
-esac
-
#-----------------------------------------------------------------------------#
diff --git a/doc/user_guide.texi b/doc/user_guide.texi
index 66379d2..f089eea 100644
--- a/doc/user_guide.texi
+++ b/doc/user_guide.texi
@@ -7004,7 +7004,6 @@ Check the module for errors, but do not generate any code.
@findex -C
@findex --target-code-only
Generate target code (i.e.@: C in @file{@var{module}.c},
-assembler in @file{@var{module}.s} or @file{@var{module}.pic_s},
IL in @file{@var{module}.il}, C# in @file{@var{module}.cs},
Java in @file{@var{module}.java}
or Erlang in @file{@var{module}.erl}),
@@ -7832,12 +7831,11 @@ and grade modifier; they are followed by
descriptions of those options.
@table @asis
@item @code{--target c} (grades: none, reg, jump, fast, asm_jump,
asm_fast, hl, hlc)
- at item @code{--target asm} (grades: hlc)
@itemx @code{--il}, @code{--target il} (grades: il)
@itemx @code{--csharp}, @code{--target csharp} (grades: csharp)
@itemx @code{--java}, @code{--target java} (grades: java)
@itemx @code{--erlang}, @code{--target erlang} (grades: erlang)
-Specify the target language used for compilation: C, assembler, IL, C#, Java
+Specify the target language used for compilation: C, IL, C#, Java
or Erlang.
C means ANSI/ISO C, optionally with GNU C extensions (see below).
IL means the Intermediate Language of the .NET Common Language Runtime.
@@ -8340,16 +8338,6 @@ implementors. It causes the generated code to
become very big and very
inefficient, and slows down compilation a lot.
@sp 1
- at item --pic
- at findex --pic
- at cindex Position independent code
- at cindex PIC (position independent code)
-Generate position independent code.
-This option is only used by the @samp{--target asm} back-end.
-The generated assembler will be written to @samp{@var{module}.pic_s}
-rather than to @samp{@var{module}.s}.
-
- at sp 1
@item --no-trad-passes
@findex --no-trad-passes
@findex --trad-passes
@@ -10794,9 +10782,8 @@ procedure but there are Mercury clauses, they
will be used instead.
@table @asis
@item @samp{C}
-This is the default foreign language on all backends which compile to C
-or assembler.
-Only available on backends that compile to C or assembler.
+This is the default foreign language on all backends which compile to C.
+Only available on backends that compile to C.
@item @samp{C#}
Only available on backends that compile to IL or C#.
diff --git a/scripts/Mmake.rules b/scripts/Mmake.rules
index 93d05f6..2f24236 100644
--- a/scripts/Mmake.rules
+++ b/scripts/Mmake.rules
@@ -188,46 +188,6 @@ endif # MMAKE_USE_MMC_MAKE != yes
ifneq ($(MMAKE_USE_MMC_MAKE),yes)
-ifeq ($(TARGET_ASM),yes)
-
-# `--target asm' back-end
-
-# When smart recompilation finds that a module does not need to be
-# recompiled, it only touches the `.s_date' or `.pic_s_date' file.
-$(ss_subdir)%.s : $(s_dates_subdir)%.s_date
- @:
-
-$(pic_ss_subdir)%.pic_s : $(pic_s_dates_subdir)%.pic_s_date
- @:
-
-$(s_dates_subdir)%.s_date : %.m
- $(MCG) $(ALL_GRADEFLAGS) --target-code-only $(ALL_MCGFLAGS) \
- $(*F) $(ERR_REDIRECT)
-
-$(pic_s_dates_subdir)%.pic_s_date : %.m
- $(MCG) $(ALL_GRADEFLAGS) --target-code-only $(ALL_MCGFLAGS) \
- --pic --cflags "$(GCCFLAGS_FOR_PIC)" $(*F) $(ERR_REDIRECT)
-
-$(os_subdir)%.$O : $(ss_subdir)%.s
- $(AS) $< $(OBJFILE_OPT)$@
-
-$(os_subdir)%.pic_o : $(pic_ss_subdir)%.pic_s
- $(AS) $< $(OBJFILE_OPT)$@
-
-# For *__c_code.{o,pic_o}, we depend on the .s or .pic_s file rather
-# than the .c file, since the .c file is produced as a side-effect of
-# generating the .s/.pic_s file.
-
-$(os_subdir)%__c_code.$O : $(ss_subdir)%.s
- $(MGNUC) $(ALL_GRADEFLAGS) $(ALL_MGNUCFLAGS) \
- -c $(cs_subdir)$*.c $(OBJFILE_OPT)$@
-
-$(os_subdir)%__c_code.pic_o : $(pic_ss_subdir)%.pic_s
- $(MGNUC) $(ALL_GRADEFLAGS) $(ALL_MGNUCFLAGS) $(CFLAGS_FOR_PIC) \
- -c $(cs_subdir)$*.c $(OBJFILE_OPT)$@
-
-endif
-
# C back-end
# When smart recompilation finds that a module does not need to be
More information about the reviews
mailing list