[m-dev.] for review: MLDS back-end: add runtime library
Fergus Henderson
fjh at cs.mu.OZ.AU
Sat Dec 4 07:36:06 AEDT 1999
Hi,
Tyson, would you mind reviewing this one?
Thanks,
Fergus.
P.S. With this header file, if I disable the check for
`pragma c_code', then I can now compile all of the
Mercury standard library using --high-level-c.
I do get a few undefined symbols when linking,
because I have not yet implemented the following:
- unify/compare/index procs for builtin types
- catch/throw
- copy/2
As well as those, I still need to implement the C interface,
RTTI support (type_functors & type_layout), and type classes.
Then of course there is debugging, profiling, etc. to worry
about ;-)
----------
Estimated hours taken: 3
runtime/mercury.h:
runtime/mercury.c:
Add the (beginnings of a) run-time library for the
high-level C back-end.
Workspace: /d-drive/home/hg/fjh/mercury
Index: runtime/mercury.h
===================================================================
RCS file: mercury.h
diff -N mercury.h
--- /dev/null Wed May 6 06:32:27 1998
+++ mercury.h Sat Dec 4 01:24:28 1999
@@ -0,0 +1,236 @@
+/*
+** Copyright (C) 1999 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury.h - This file defines the macros, types, etc. that
+** are used when generating high-level C code.
+** (For the low-level C code, see mercury_imp.h.)
+*/
+
+#ifndef MERCURY_H
+#define MERCURY_H
+
+/*---------------------------------------------------------------------------*/
+/*
+** Header files to include
+*/
+
+#include "mercury_conf.h"
+#include "mercury_types.h"
+#include "mercury_float.h" /* for the `Float' type */
+#include "mercury_tags.h"
+#include "mercury_grade.h"
+#include "mercury_std.h"
+
+#include "gc.h"
+
+#include <setjmp.h> /* for jmp_buf etc., which are used for commits */
+#include <string.h> /* for strcmp(), which is used for =/2 on strings */
+
+/*---------------------------------------------------------------------------*/
+/*
+** Type definitions
+*/
+
+/*
+** The following types are used to represent the Mercury builtin types.
+** See mercury_types.h and mercury_float.h.
+*/
+typedef Char MR_Char;
+typedef Float MR_Float;
+typedef Integer MR_Integer;
+typedef String MR_String;
+
+/*
+** The MR_Box type is used for representing polymorphic types.
+*/
+typedef Word MR_Box;
+
+/*
+** With the low-level data representation, the MR_Word type
+** is used for representing user-defined types.
+*/
+typedef Word MR_Word;
+
+/*
+** The MR_BaseTypeInfo struct holds information about
+** a type constructor.
+** This is essentially the same as MR_TypeCtorInfo
+** in runtime/mercury_type_info.h, but for the MLDS back-end
+** rather than the LLDS back-end.
+*/
+typedef struct MR_BaseTypeInfo_struct {
+ /*
+ ** The unify, index, and compare fields hold pointers
+ ** to functions which take N type_info arguments, followed
+ ** by their other parameters, where the value of N is given
+ ** by the type_arity field.
+ */
+ Integer type_arity;
+ MR_Box unify; /* bool (*)(..., MR_Box, MR_Box); */
+ MR_Box index; /* void (*)(..., MR_Box, Integer *); */
+ MR_Box compare; /* void (*)(..., Word *, MR_Box, MR_Box)' */
+ /*
+ ** The type_ctor_rep holds an enumeration value
+ ** (of type `enum MR_TypeCtorRepresentation') indicating
+ ** what kind of type it is and how the type is represented.
+ */
+ Integer type_ctor_rep;
+ void * base_type_functors; /* XXX currently always NULL */
+ void * base_type_layout; /* XXX currently always NULL */
+ /*
+ ** The module_name and type_name, together with the type_arity
+ ** field above, serve to identify the type constructor.
+ */
+ const char * module_name;
+ const char * type_name;
+ /*
+ ** This field indicates which version of the various RRTI
+ ** structures this is.
+ */
+ Integer rtti_version;
+} MR_BaseTypeInfo;
+
+/*---------------------------------------------------------------------------*/
+/*
+** Declarations of contants and variables
+*/
+
+/* declare MR_BaseTypeInfos for the builtin types */
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_int_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_string_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_float_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_character_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_void_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_c_pointer_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_pred_0;
+extern const MR_BaseTypeInfo mercury__builtin__base_type_info_func_0;
+extern const MR_BaseTypeInfo mercury__array__base_type_info_array_1;
+extern const MR_BaseTypeInfo mercury__std_util__base_type_info_univ_0;
+extern const MR_BaseTypeInfo mercury__std_util__base_type_info_type_info_0;
+extern const MR_BaseTypeInfo
+ mercury__private_builtin__base_type_info_type_ctor_info_1,
+ mercury__private_builtin__base_type_info_type_info_1,
+ mercury__private_builtin__base_type_info_typeclass_info_1,
+ mercury__private_builtin__base_type_info_base_typeclass_info_1;
+
+/*
+** The compiler generates references to this constant.
+** This avoids the need for the mlds__rval type to
+** have a `sizeof' operator.
+*/
+#ifdef MR_AVOID_MACROS
+ enum { mercury__private_builtin__SIZEOF_WORD = sizeof(MR_Word); }
+#else
+ #define mercury__private_builtin__SIZEOF_WORD sizeof(MR_Word)
+#endif
+
+/*
+** When generating code which passes an io__state or a store__store
+** to a polymorphic procedure, or which does a higher-order call
+** that passes one of these, then we need to generate a reference to
+** a dummy variable. We use this variable for that purpose.
+*/
+extern Word mercury__private_builtin__dummy_var;
+
+/*---------------------------------------------------------------------------*/
+/*
+** Macro / inline function definitions
+*/
+
+/*
+** MR_new_object():
+** Allocates memory on the garbage-collected heap.
+*/
+
+#ifdef INLINE_ALLOC
+ #ifndef __GNUC__
+ #error "INLINE_ALLOC requires GNU C"
+ #endif
+ /*
+ ** This must be a macro, not an inline function, because
+ ** GNU C's `__builtin_constant_p' does not work inside
+ ** inline functions
+ */
+ #define MR_GC_MALLOC_INLINE(bytes) \
+ ( __extension__ __builtin_constant_p(bytes) && \
+ (bytes) <= 16 * sizeof(MR_Word) \
+ ? ({ void * temp; \
+ /* if size > 1 word, round up to multiple of 8 bytes */ \
+ MR_Word rounded_bytes = \
+ ( (bytes) <= sizeof(MR_Word) \
+ ? sizeof(MR_Word) \
+ : 8 * (((bytes) + 7) / 8) \
+ ); \
+ MR_Word num_words = rounded_bytes / sizeof(MR_Word); \
+ GC_MALLOC_WORDS(temp, num_words); \
+ /* return */ temp; \
+ }) \
+ : GC_MALLOC(bytes) \
+ )
+ /* XXX why do we need to cast to MR_Word here? */
+ #define MR_new_object(type, size, name) \
+ ((MR_Word) (type *) MR_GC_MALLOC_INLINE(size))
+#else
+ /* XXX why do we need to cast to MR_Word here? */
+ #define MR_new_object(type, size, name) \
+ ((MR_Word) (type *) GC_MALLOC(size))
+#endif
+
+/* this should probably go in mercury_std.h */
+#if defined(__GNUC__)
+ #define MR_INLINE __inline__
+ #define MR_EXTERN_INLINE extern __inline__
+#elif defined(__cplusplus) || __STDC_VERSION__ >= 199901
+ #define MR_INLINE inline
+ #define MR_EXTERN_INLINE extern inline
+#else
+ #define MR_INLINE static
+ #define MR_EXTERN_INLINE static
+#endif
+
+/*
+** Code to box/unbox floats
+**
+** XXX we should optimize the case where sizeof(MR_Float) == sizeof(MR_Box)
+*/
+
+MR_EXTERN_INLINE MR_Box MR_box_float(MR_Float f);
+
+MR_EXTERN_INLINE MR_Box
+MR_box_float(MR_Float f) {
+ MR_Float *ptr = (MR_Float *)
+ MR_new_object(MR_Float, sizeof(MR_Float), "float");
+ *ptr = f;
+ return (MR_Box) ptr;
+}
+
+#ifdef MR_AVOID_MACROS
+ MR_EXTERN_INLINE MR_Float MR_unbox_float(MR_Box b);
+
+ MR_EXTERN_INLINE
+ MR_Float MR_unbox_float(MR_Box b) {
+ return *(MR_Float *)b;
+ }
+#else
+ #define MR_unbox_float(ptr) (*(MR_Float *)ptr)
+#endif
+
+/*-----------------------------------------------------------------------------*/
+/*
+** Function declarations
+*/
+
+bool mercury__builtin__unify_2_p_0(Word type_info, MR_Box, MR_Box);
+void mercury__builtin__index_2_p_3(Word type_info, MR_Box, Integer *);
+void mercury__builtin__compare_3_p_0(Word type_info, Word *, MR_Box, MR_Box);
+void mercury__builtin__compare_3_p_1(Word type_info, Word *, MR_Box, MR_Box);
+void mercury__builtin__compare_3_p_2(Word type_info, Word *, MR_Box, MR_Box);
+void mercury__builtin__compare_3_p_3(Word type_info, Word *, MR_Box, MR_Box);
+
+/*-----------------------------------------------------------------------------*/
+
+#endif /* not MERCURY_H */
Index: runtime/mercury.c
===================================================================
RCS file: mercury.c
diff -N mercury.c
--- /dev/null Wed May 6 06:32:27 1998
+++ mercury.c Sat Dec 4 06:37:23 1999
@@ -0,0 +1,316 @@
+/*
+** Copyright (C) 1999 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury.c - This file defines the builtin functions, constants, etc. that
+** are used when generating high-level C code.
+** (For the low-level C code, see mercury_imp.h.)
+*/
+
+#include "mercury.h"
+#include "mercury_type_info.h" /* for MR_TYPECTOR_REP* */
+#include "mercury_misc.h" /* for fatal_error() */
+
+/*---------------------------------------------------------------------------*/
+/*
+** Variable definitions
+*/
+
+MR_Word mercury__private_builtin__dummy_var;
+
+/*---------------------------------------------------------------------------*/
+/*
+** Type definitions
+*/
+
+typedef bool MR_UnifyFunc_0(MR_Box, MR_Box);
+typedef bool MR_UnifyFunc_1(MR_Word, MR_Box, MR_Box);
+typedef bool MR_UnifyFunc_2(MR_Word, MR_Word, MR_Box, MR_Box);
+typedef bool MR_UnifyFunc_3(MR_Word, MR_Word, MR_Word, MR_Box, MR_Box);
+typedef bool MR_UnifyFunc_4(MR_Word, MR_Word, MR_Word, MR_Word,
+ MR_Box, MR_Box);
+typedef bool MR_UnifyFunc_5(MR_Word, MR_Word, MR_Word, MR_Word, MR_Word,
+ MR_Box, MR_Box);
+
+typedef void MR_IndexFunc_0(MR_Box, MR_Integer *);
+typedef void MR_IndexFunc_1(MR_Word, MR_Box, MR_Integer *);
+typedef void MR_IndexFunc_2(MR_Word, MR_Word, MR_Box, MR_Integer *);
+typedef void MR_IndexFunc_3(MR_Word, MR_Word, MR_Word, MR_Box, MR_Integer *);
+typedef void MR_IndexFunc_4(MR_Word, MR_Word, MR_Word, MR_Word,
+ MR_Box, MR_Integer *);
+typedef void MR_IndexFunc_5(MR_Word, MR_Word, MR_Word, MR_Word, MR_Word,
+ MR_Box, MR_Integer *);
+
+typedef void MR_CompareFunc_0(MR_Word *, MR_Box, MR_Box);
+typedef void MR_CompareFunc_1(MR_Word, MR_Word *, MR_Box, MR_Box);
+typedef void MR_CompareFunc_2(MR_Word, MR_Word, MR_Word *, MR_Box, MR_Box);
+typedef void MR_CompareFunc_3(MR_Word, MR_Word, MR_Word,
+ MR_Word *, MR_Box, MR_Box);
+typedef void MR_CompareFunc_4(MR_Word, MR_Word, MR_Word, MR_Word,
+ MR_Word *, MR_Box, MR_Box);
+typedef void MR_CompareFunc_5(MR_Word, MR_Word, MR_Word, MR_Word, MR_Word,
+ MR_Word *, MR_Box, MR_Box);
+
+/*---------------------------------------------------------------------------*/
+/*
+** Constant definitions
+*/
+
+/*
+** Define MR_BaseTypeInfos for the builtin types
+*/
+
+#define MR_base_type_info_name(MODULE, TYPE, ARITY) \
+ MR_PASTE2(mercury__, \
+ MR_PASTE2(MODULE, \
+ MR_PASTE2(__base_type_info_, \
+ MR_PASTE2(TYPE, \
+ MR_PASTE2(_, \
+ ARITY)))))
+
+#define MR_base_type_info_func_name(MODULE, TYPE, ARITY, FUNC) \
+ MR_PASTE2(mercury__, \
+ MR_PASTE2(MODULE, \
+ MR_PASTE2(__, \
+ MR_PASTE2(FUNC, \
+ MR_PASTE2(__, \
+ MR_PASTE2(TYPE, \
+ MR_PASTE2(_, \
+ ARITY)))))))
+
+#define MR_special_func_type(NAME, ARITY) \
+ MR_PASTE2(MR_, MR_PASTE2(NAME, MR_PASTE2(Func_, ARITY)))
+
+#define MR_define_base_type_info(module, type, arity, type_rep) \
+ \
+ extern MR_special_func_type(Unify, arity) \
+ MR_base_type_info_func_name(module, type, arity, __Unify__); \
+ extern MR_special_func_type(Index, arity) \
+ MR_base_type_info_func_name(module, type, arity, __Index__); \
+ extern MR_special_func_type(Compare, arity) \
+ MR_base_type_info_func_name(module, type, arity, __Compare__);\
+ \
+ const MR_BaseTypeInfo MR_base_type_info_name(module, type, arity) = \
+ { \
+ arity, \
+ (MR_Box) MR_base_type_info_func_name(module, type, arity, \
+ __Unify__), \
+ (MR_Box) MR_base_type_info_func_name(module, type, arity, \
+ __Index__), \
+ (MR_Box) MR_base_type_info_func_name(module, type, arity, \
+ __Compare__), \
+ type_rep, \
+ NULL, \
+ NULL, \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(type), \
+ MR_RTTI_VERSION \
+ }
+
+MR_define_base_type_info(builtin, int, 0, MR_TYPECTOR_REP_INT);
+MR_define_base_type_info(builtin, string, 0, MR_TYPECTOR_REP_STRING);
+MR_define_base_type_info(builtin, float, 0, MR_TYPECTOR_REP_FLOAT);
+MR_define_base_type_info(builtin, character, 0, MR_TYPECTOR_REP_CHAR);
+MR_define_base_type_info(builtin, void, 0, MR_TYPECTOR_REP_VOID);
+MR_define_base_type_info(builtin, c_pointer, 0, MR_TYPECTOR_REP_C_POINTER);
+MR_define_base_type_info(builtin, pred, 0, MR_TYPECTOR_REP_PRED);
+MR_define_base_type_info(builtin, func, 0, MR_TYPECTOR_REP_PRED);
+MR_define_base_type_info(array, array, 1, MR_TYPECTOR_REP_ARRAY);
+MR_define_base_type_info(std_util, univ, 0, MR_TYPECTOR_REP_UNIV);
+MR_define_base_type_info(std_util, type_info, 0, MR_TYPECTOR_REP_TYPEINFO);
+MR_define_base_type_info(private_builtin, type_ctor_info, 1,
+ MR_TYPECTOR_REP_TYPEINFO);
+MR_define_base_type_info(private_builtin, type_info, 1,
+ MR_TYPECTOR_REP_TYPEINFO);
+MR_define_base_type_info(private_builtin, base_typeclass_info, 1,
+ MR_TYPECTOR_REP_TYPECLASSINFO);
+MR_define_base_type_info(private_builtin, typeclass_info, 1,
+ MR_TYPECTOR_REP_TYPECLASSINFO);
+
+/*---------------------------------------------------------------------------*/
+/*
+** Function definitions
+*/
+
+/*
+** Define the builtin unify/2, index/2, and compare/3 functions.
+*/
+
+bool
+mercury__builtin__unify_2_p_0(Word ti, MR_Box x, MR_Box y)
+{
+ Word *type_info;
+ MR_BaseTypeInfo *base_type_info;
+ int arity;
+
+ type_info = (Word *) ti;
+ if (*type_info == 0) {
+ base_type_info = (MR_BaseTypeInfo *)type_info;
+ } else {
+ base_type_info = *(MR_BaseTypeInfo **)type_info;
+ }
+
+ /*
+ ** For higher-order predicates and functions,
+ ** the arity is stored in the type_info, not in the
+ ** base_type_info, and so we need to skip past the
+ ** arity field.
+ */
+ if (base_type_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ arity = type_info[1];
+ type_info++;
+ } else {
+ arity = base_type_info->type_arity;
+ }
+
+ switch(arity) {
+ /*
+ ** cast base_type_info->unify to the right type
+ ** and then call it, passing the right number of
+ ** type_info arguments
+ */
+ case 0: return ((MR_UnifyFunc_0 *) base_type_info->unify)
+ (x, y);
+ case 1: return ((MR_UnifyFunc_1 *) base_type_info->unify)
+ (type_info[1], x, y);
+ case 2: return ((MR_UnifyFunc_2 *) base_type_info->unify)
+ (type_info[1], type_info[2], x, y);
+ case 3: return ((MR_UnifyFunc_3 *) base_type_info->unify)
+ (type_info[1], type_info[2], type_info[3],
+ x, y);
+ case 4: return ((MR_UnifyFunc_4 *) base_type_info->unify)
+ (type_info[1], type_info[2], type_info[3],
+ type_info[4], x, y);
+ case 5: return ((MR_UnifyFunc_5 *) base_type_info->unify)
+ (type_info[1], type_info[2], type_info[3],
+ type_info[4], type_info[5], x, y);
+ default:
+ fatal_error("unify/2: type arity > 5 not supported");
+ }
+}
+
+void
+mercury__builtin__index_2_p_3(Word ti, MR_Box x, Integer *y)
+{
+ Word *type_info;
+ MR_BaseTypeInfo *base_type_info;
+ int arity;
+
+ type_info = (Word *) ti;
+ if (*type_info == 0) {
+ base_type_info = (MR_BaseTypeInfo *)type_info;
+ } else {
+ base_type_info = *(MR_BaseTypeInfo **)type_info;
+ }
+
+ /*
+ ** For higher-order predicates and functions,
+ ** the arity is stored in the type_info, not in the
+ ** base_type_info, and so we need to skip past the
+ ** arity field.
+ */
+ if (base_type_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ arity = type_info[1];
+ type_info++;
+ } else {
+ arity = base_type_info->type_arity;
+ }
+
+ switch(arity) {
+ /*
+ ** cast base_type_info->index to the right type
+ ** and then call it, passing the right number of
+ ** type_info arguments
+ */
+ case 0: return ((MR_IndexFunc_0 *) base_type_info->index)
+ (x, y);
+ case 1: return ((MR_IndexFunc_1 *) base_type_info->index)
+ (type_info[1], x, y);
+ case 2: return ((MR_IndexFunc_2 *) base_type_info->index)
+ (type_info[1], type_info[2], x, y);
+ case 3: return ((MR_IndexFunc_3 *) base_type_info->index)
+ (type_info[1], type_info[2], type_info[3],
+ x, y);
+ case 4: return ((MR_IndexFunc_4 *) base_type_info->index)
+ (type_info[1], type_info[2], type_info[3],
+ type_info[4], x, y);
+ case 5: return ((MR_IndexFunc_5 *) base_type_info->index)
+ (type_info[1], type_info[2], type_info[3],
+ type_info[4], type_info[5], x, y);
+ default:
+ fatal_error("index/2: type arity > 5 not supported");
+ }
+}
+
+void
+mercury__builtin__compare_3_p_0(Word ti, Word *res, MR_Box x, MR_Box y)
+{
+ Word *type_info;
+ MR_BaseTypeInfo *base_type_info;
+ int arity;
+
+ type_info = (Word *) ti;
+ if (*type_info == 0) {
+ base_type_info = (MR_BaseTypeInfo *)type_info;
+ } else {
+ base_type_info = *(MR_BaseTypeInfo **)type_info;
+ }
+
+ /*
+ ** For higher-order predicates and functions,
+ ** the arity is stored in the type_info, not in the
+ ** base_type_info, and so we need to skip past the
+ ** arity field.
+ */
+ if (base_type_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ arity = type_info[1];
+ type_info++;
+ } else {
+ arity = base_type_info->type_arity;
+ }
+
+ switch(arity) {
+ /*
+ ** cast base_type_info->compare to the right type
+ ** and then call it, passing the right number of
+ ** type_info arguments
+ */
+ case 0: ((MR_CompareFunc_0 *) base_type_info->compare)
+ (res, x, y);
+ case 1: ((MR_CompareFunc_1 *) base_type_info->compare)
+ (type_info[1], res, x, y);
+ case 2: ((MR_CompareFunc_2 *) base_type_info->compare)
+ (type_info[1], type_info[2], res, x, y);
+ case 3: ((MR_CompareFunc_3 *) base_type_info->compare)
+ (type_info[1], type_info[2], type_info[3], res, x, y);
+ case 4: ((MR_CompareFunc_4 *) base_type_info->compare)
+ (type_info[1], type_info[2], type_info[3],
+ type_info[4], res, x, y);
+ case 5: ((MR_CompareFunc_5 *) base_type_info->compare)
+ (type_info[1], type_info[2], type_info[3],
+ type_info[4], type_info[5], res, x, y);
+ default:
+ fatal_error("index/2: type arity > 5 not supported");
+ }
+}
+
+void
+mercury__builtin__compare_3_p_1(Word type_info, Word *res, MR_Box x, MR_Box y)
+{
+ return mercury__builtin__compare_3_p_0(type_info, res, x, y);
+}
+
+void
+mercury__builtin__compare_3_p_2(Word type_info, Word *res, MR_Box x, MR_Box y)
+{
+ return mercury__builtin__compare_3_p_0(type_info, res, x, y);
+}
+
+void
+mercury__builtin__compare_3_p_3(Word type_info, Word *res, MR_Box x, MR_Box y)
+{
+ return mercury__builtin__compare_3_p_0(type_info, res, x, y);
+}
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list