[m-dev.] for review: independent AND parallelism [runtime]

Thomas Charles CONWAY conway at cs.mu.OZ.AU
Thu May 21 18:21:40 AEST 1998


Fergus Henderson, you write:
> > library/{nc,sp}_builtin.nl:
> > 	add an op declaration for &.
> 
> Shouldn't you also modify library/ops.m and
> compiler/mercury_to_mercury.m?
> 

It already was in the other places.

Here is a relative diff to fix the other comments you made.
-- 
Thomas Conway <conway at cs.mu.oz.au>
Nail here [] for new monitor.  )O+

diff -ur bak/mercury/boehm_gc/solaris_pthreads.c mercury/boehm_gc/solaris_pthreads.c
--- bak/mercury/boehm_gc/solaris_pthreads.c	Tue Apr 28 10:05:46 1998
+++ mercury/boehm_gc/solaris_pthreads.c	Tue Apr 28 12:32:29 1998
@@ -143,7 +143,6 @@
 #endif
     result = 
 	    pthread_create(&my_new_thread, &attr, thread_execp, arg);
-	fprintf(stderr, "%d %s\n", result, strerror(result));
 #if 0
 #ifdef I386
     LOCK();
diff -ur bak/mercury/compiler/hlds_out.m mercury/compiler/hlds_out.m
--- bak/mercury/compiler/hlds_out.m	Tue Apr 28 10:06:44 1998
+++ mercury/compiler/hlds_out.m	Tue Apr 28 10:37:08 1998
@@ -995,7 +995,7 @@
 		io__write_string(Follow),
 		io__write_string("\n")
 	;
-		io__write_string("fail"),
+		io__write_string("/* parallel */ true"),
 		io__write_string(Follow),
 		io__write_string("\n")
 	).
diff -ur bak/mercury/compiler/instmap.m mercury/compiler/instmap.m
--- bak/mercury/compiler/instmap.m	Tue Apr 28 10:06:47 1998
+++ mercury/compiler/instmap.m	Tue Apr 28 10:41:38 1998
@@ -767,12 +767,10 @@
 	->
 		instmap__lookup_var(InstMap, Var, VarInst),
 		(
-			% We unify the accumulated inst and the inst from the
-			% given instmap - we don't care about the determinism.
-			% Variable locking during mode analysis ensures that
-			% there is a unique producer for each variable - whether
-			% or not the unification may fail is up to determinism
-			% analysis.
+			% We can ignore the determinsm of the unification:
+			% if it isn't det, then there will be a mode error
+			% or a determinism error in one of the parallel
+			% conjuncts.
 
 			abstractly_unify_inst(live, Inst0, VarInst, fake_unify,
 				ModuleInfo0, Inst1, _Det, ModuleInfo1)
@@ -952,12 +950,10 @@
 	( map__search(InstMappingA, Var, InstA) ->
 		( map__search(InstMappingB, Var, InstB) ->
 			(
-			% We unify the accumulated inst and the inst from the
-			% given instmap - we don't care about the determinism.
-			% Variable locking during mode analysis ensures that
-			% there is a unique producer for each variable - whether
-			% or not the unification may fail is up to determinism
-			% analysis.
+				% We can ignore the determinsm of the
+				% unification: if it isn't det, then there
+				% will be a mode error or a determinism error
+				% in one of the parallel conjuncts.
 
 				abstractly_unify_inst(live, InstA, InstB,
 					fake_unify, ModuleInfo0, Inst, _Det,
diff -ur bak/mercury/compiler/llds.m mercury/compiler/llds.m
--- bak/mercury/compiler/llds.m	Tue Apr 28 10:06:50 1998
+++ mercury/compiler/llds.m	Tue Apr 28 10:46:29 1998
@@ -257,29 +257,37 @@
 
 	;	init_sync_term(lval, int)
 			% Initialize a synchronization term.
+			% the first arguement contains the lvalue into
+			% which we will store the synchronization term,
+			% and the second argument indicates how many
+			% branches we expect to join at the end of the
+			% parallel conjunction.
+			% (See the documentation in par_conj_gen.m and
+			% runtime/context.{c,h} for further information about
+			% synchronisation terms.)
 
 	;	fork(label, label, int)
 			% Create a new context.
 			% fork(Child, Parent, NumSlots) creates a new thread
-			% which will start executing at Child, then execution
-			% in the current context branches to Parent.
+			% which will start executing at Child. After spawning
+			% execution in the child, control branches to Parent.
 			% NumSlots is the number of stack slots that need to
 			% be copied to the child's stack (see comments in
-			% runtime/context.{h,mod}).
+			% runtime/context.{h,c}).
 
 	;	join_and_terminate(lval)
 			% Signal that this thread of execution has finished in
 			% the current parallel conjunction, then terminate it.
-			% The synchronisation term specified by the
+			% The synchronisation term is specified by the
 			% given lval. (See the documentation in par_conj_gen.m
-			% and runtime/context.mod for further information about
-			% synchronisation terms.)
+			% and runtime/context.{c,h} for further information
+			% about synchronisation terms.)
 
 	;	join_and_continue(lval, label)
 			% Signal that this thread of execution has finished
 			% in the current parallel conjunction, then branch to
 			% the given label. The synchronisation
-			% term specified by the given lval.
+			% term is specified by the given lval.
 	.
 
 	% Procedures defined by nondet pragma C codes must have some way of
diff -ur bak/mercury/compiler/llds_out.m mercury/compiler/llds_out.m
--- bak/mercury/compiler/llds_out.m	Tue Apr 28 10:06:51 1998
+++ mercury/compiler/llds_out.m	Tue Apr 28 10:47:00 1998
@@ -1177,7 +1177,7 @@
 	io__write_string(");\n").
 
 output_instruction(fork(Child, Parent, Lval), _) -->
-	io__write_string("\tfork_new_context("),
+	io__write_string("\tMR_fork_new_context("),
 	output_label_as_code_addr(Child),
 	io__write_string(", "),
 	output_label_as_code_addr(Parent),
@@ -1186,12 +1186,12 @@
 	io__write_string(");\n").
 
 output_instruction(join_and_terminate(Lval), _) -->
-	io__write_string("\tjoin_and_terminate("),
+	io__write_string("\tMR_join_and_terminate("),
 	output_lval(Lval),
 	io__write_string(");\n").
 
 output_instruction(join_and_continue(Lval, Label), _) -->
-	io__write_string("\tjoin_and_continue("),
+	io__write_string("\tMR_join_and_continue("),
 	output_lval(Lval),
 	io__write_string(", "),
 	output_label_as_code_addr(Label),
diff -ur bak/mercury/compiler/mode_errors.m mercury/compiler/mode_errors.m
--- bak/mercury/compiler/mode_errors.m	Tue Apr 28 10:06:56 1998
+++ mercury/compiler/mode_errors.m	Tue Apr 28 11:31:31 1998
@@ -42,7 +42,8 @@
 			% different insts for some non-local variables
 	;	mode_error_par_conj(merge_errors)
 			% different arms of a parallel conj result in
-			% mutually exclusive bindings
+			% mutually exclusive bindings to the same variable
+			% (eg ... p(X::out), ( X = a & X = b ), ...)
 	;	mode_error_higher_order_pred_var(pred_or_func, var, inst, arity)
 			% the predicate variable in a higher-order predicate
 			% or function call didn't have a higher-order
@@ -92,9 +93,6 @@
 	;	mode_error_final_inst(int, var, inst, inst, final_inst_error)
 			% one of the head variables did not have the
 			% expected final inst on exit from the proc
-	;	mode_error_parallel_var(var, inst, inst)
-			% attempt to bind a non-local variable that has already
-			% been bound in another parallel conjunct.
 	.
 
 :- type schedule_culprit
@@ -221,8 +219,6 @@
 		ModeInfo) -->
 	report_mode_error_final_inst(ModeInfo, ArgNum, Var, VarInst, Inst,
 		Reason).
-report_mode_error(mode_error_parallel_var(Var, InstA, InstB), ModeInfo) -->
-	report_mode_error_parallel_var(ModeInfo, Var, InstA, InstB).
 
 %-----------------------------------------------------------------------------%
 
@@ -369,6 +365,12 @@
 	mode_info_write_context(ModeInfo),
 	prog_out__write_context(Context),
 	io__write_string("  mode error: mutually exclusive bindings in parallel conjunction.\n"),
+	mode_info_write_context(ModeInfo),
+	prog_out__write_context(Context),
+	io__write_string("              (The current implementation does not permit\n"),
+	mode_info_write_context(ModeInfo),
+	prog_out__write_context(Context),
+	io__write_string("              parallel conjunctions to fail.)\n"),
 	write_merge_error_list(ErrorList, ModeInfo).
 
 :- pred write_merge_error_list(merge_errors, mode_info, io__state, io__state).
@@ -829,25 +831,6 @@
 	output_inst(Inst, InstVarSet),
 	io__write_string("'.\n").
 
-
-%-----------------------------------------------------------------------------%
-
-:- pred report_mode_error_parallel_var(mode_info, var, inst, inst,
-		io__state, io__state).
-:- mode report_mode_error_parallel_var(mode_info_ui, in, in, in, di, uo) is det.
-
-report_mode_error_parallel_var(ModeInfo, Var, _VarInst, _Inst) -->
-	{ mode_info_get_context(ModeInfo, Context) },
-	{ mode_info_get_varset(ModeInfo, VarSet) },
-	mode_info_write_context(ModeInfo),
-	prog_out__write_context(Context),
-	io__write_string("  mode error: attempt to bind a variable already bound\n"),
-	prog_out__write_context(Context),
-	io__write_string("  in anonther parallel conjunct.\n"),
-	prog_out__write_context(Context),
-	io__write_string("  The variable concerned was `"),
-	mercury_output_var(Var, VarSet, no),
-	io__write_string("'.\n").
 
 %-----------------------------------------------------------------------------%
 
diff -ur bak/mercury/compiler/par_conj_gen.m mercury/compiler/par_conj_gen.m
--- bak/mercury/compiler/par_conj_gen.m	Tue Apr 28 10:07:28 1998
+++ mercury/compiler/par_conj_gen.m	Thu May 21 08:48:05 1998
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1995 University of Melbourne.
+% Copyright (C) 1998 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.
 %---------------------------------------------------------------------------%
@@ -15,20 +15,23 @@
 % Notes on parallel conjunction:
 %
 % A parallel conjunction (A & B) denotes that the goals `A' and `B' should
-% be executed concurrently. Ideally, parallel conjunction should have exactly
-% the same declarative semantics as normal conjunction; in practice this is
-% not quite the case for a couple of reasons:
-%	- `,'/2 does not quite behave as *logical* conjunction; by default,
+% be executed concurrently. Parallel conjunction has exactly the same
+% declarative semantics as normal conjunction, but it has different (stricter)
+% rules for mode-correctness and determinism-correctness, and it has different
+% operational semantics.
+%	[Operational semantics]
+%	- `,'/2 gives some operational guarantees that `&'/2 does not:
 %	  if `--no-reorder-conj' is set, there is an implied ordering
 %	  in the code:  conjunctions must not be reordered beyond the
 %	  minimum necessary for mode correctness.
 %	  This is justified for reasons performance modeling and ensuring
-%	  predicatble termination properties.
+%	  predicatable termination properties.
 %	  Parallel conjunction does not of itself suggest any information
 %	  about which order two goals should be executed, however if
 %	  coroutining (not currently implemented) is being used, then the
 %	  data dependancies between the two goals will constrain the order
 %	  of execution at runtime.
+%	[Mode correctness]
 %	- `,'/2 has a *sequential* behaviour `A, B' proves `A' *then*
 %	  proves `B'. Mode analysis only allows unidirectional data-
 %	  dependancies for conjunction. In independant and-parallelism,
@@ -79,7 +82,7 @@
 % are refered to in the code as 'sync_term's.
 %
 % The runtime support for parallel conjunction is documented in the runtime
-% directory in context.mod.
+% directory in mercury_context.{c,h}.
 %
 %---------------------------------------------------------------------------%
 
diff -ur bak/mercury/configure.in mercury/configure.in
--- bak/mercury/configure.in	Tue Apr 28 10:05:15 1998
+++ mercury/configure.in	Wed May 20 10:54:05 1998
@@ -742,6 +742,37 @@
 )
 AC_MSG_RESULT($mercury_cv_sync_term_size)
 AC_DEFINE_UNQUOTED(SYNC_TERM_SIZE, $mercury_cv_sync_term_size)
+SYNC_TERM_SIZE=$mercury_cv_sync_term_size
+AC_SUBST(SYNC_TERM_SIZE)
+#-----------------------------------------------------------------------------#
+AC_MSG_CHECKING(the number of words in a synchronization term)
+AC_CACHE_VAL(mercury_cv_sync_term_size,
+	AC_TRY_RUN([
+	#include <stdio.h>
+	#include <stdlib.h>
+	#include <pthread.h>
+	int main() {
+		struct {
+			pthread_mutex_t lock;
+			int		count;
+			void		*parent;
+		} x;
+		FILE *fp;
+
+		fp = fopen("conftest.syncsize", "w");
+		if (fp == NULL)
+			exit(1);
+		fprintf(fp, "%d\n", (sizeof(void *) - 1 + sizeof(x))/
+				sizeof(void *));
+
+		exit(0);
+	}],
+	[mercury_cv_sync_term_size=`cat conftest.syncsize`],
+	[mercury_cv_sync_term_size=0],
+	[mercury_cv_sync_term_size=0])
+)
+AC_MSG_RESULT($mercury_cv_sync_term_size)
+AC_DEFINE_UNQUOTED(SYNC_TERM_SIZE, $mercury_cv_sync_term_size)
 BYTES_PER_WORD=$mercury_cv_sync_term_size
 AC_SUBST(SYNC_TERM_SIZE)
 #-----------------------------------------------------------------------------#
@@ -1124,10 +1155,9 @@
 	AC_TRY_RUN([
 	#define USE_GCC_NONLOCAL_GOTOS
 	#define USE_GCC_GLOBAL_REGISTERS
-	#include "mercury_regs.h"
-	#include "mercury_memory.h"
+	#include "mercury_engine.h"
 	changequote(<<,>>) 
-	Word fake_reg[MAX_FAKE_REG];
+	MercuryEngine MR_engine_base;
 	changequote([,]) 
 	main() {
 		mr0 = 20;
@@ -1185,10 +1215,9 @@
 AC_CACHE_VAL(mercury_cv_gcc_model_reg,
 AC_TRY_RUN([
 #define USE_GCC_GLOBAL_REGISTERS
-#include "mercury_regs.h"
-#include "mercury_memory.h"
+#include "mercury_engine.h"
 changequote(<<,>>) 
-Word fake_reg[MAX_FAKE_REG];
+MercuryEngine MR_engine_base;
 changequote([,]) 
 main() {
 	mr0 = 20;
@@ -1200,6 +1229,23 @@
 	[mercury_cv_gcc_model_reg=no])
 )
 AC_MSG_RESULT($mercury_cv_gcc_model_reg)
+#-----------------------------------------------------------------------------#
+
+# Figure out which flavour of pthreads to use, since none of the
+# implementations seem to be exactly the same
+case $host in
+	alpha-dec-osf*)
+		mercury_cv_use_digital_unix_threads=yes ;;
+
+	*)
+		mercury_cv_use_digital_unix_threads=no ;;
+esac
+
+if $mercury_cv_use_digital_unix_threads = yes
+then
+	AC_DEFINE(MR_DIGITAL_UNIX_PTHREADS)
+fi
+
 #-----------------------------------------------------------------------------#
 
 #
diff -ur bak/mercury/library/Mmakefile mercury/library/Mmakefile
--- bak/mercury/library/Mmakefile	Tue Apr 28 10:10:05 1998
+++ mercury/library/Mmakefile	Tue Apr 28 13:06:16 1998
@@ -81,8 +81,7 @@
 		$(INTERMODULE_OPTS) $(CHECK_TERM_OPTS)
 MGNUC	=	MERCURY_C_INCL_DIR=$(RUNTIME_DIR) $(SCRIPTS_DIR)/mgnuc
 
-# --no-ansi is needed to avoid syntax errors in Solaris pthread.h :-(
-MGNUCFLAGS =	--no-ansi -I$(RUNTIME_DIR) -I$(BOEHM_GC_DIR) \
+MGNUCFLAGS =	-I$(RUNTIME_DIR) -I$(BOEHM_GC_DIR) \
 		$(DLL_CFLAGS) $(EXTRA_CFLAGS)
 LDFLAGS	=	-L$(BOEHM_GC_DIR) -L$(RUNTIME_DIR)
 LDLIBS	=	-lmer							\
diff -ur bak/mercury/runtime/mercury_conf.h.in mercury/runtime/mercury_conf.h.in
--- bak/mercury/runtime/mercury_conf.h.in	Tue Apr 28 10:10:48 1998
+++ mercury/runtime/mercury_conf.h.in	Wed May 20 10:45:54 1998
@@ -138,10 +138,9 @@
 #undef	SIGACTION_FIELD
 
 /*
-** PARALLEL: defined iff we are configuring for parallel execution.
-** (This is work in progress... parallel execution is not yet supported.)
+** Multithreaded execution support.
 */
-#undef	PARALLEL
+#undef MR_DIGITAL_UNIX_PTHREADS
 
 /*
 ** The bytecode files represent floats in 64-bit IEEE format.
diff -ur bak/mercury/runtime/mercury_context.c mercury/runtime/mercury_context.c
--- bak/mercury/runtime/mercury_context.c	Tue Apr 28 10:10:48 1998
+++ mercury/runtime/mercury_context.c	Wed May  6 14:48:53 1998
@@ -15,7 +15,7 @@
 #include <stdio.h>
 #include <unistd.h>		/* for getpid() and fork() */
 #ifdef MR_THREAD_SAFE
-#include "mercury_thread.h"
+  #include "mercury_thread.h"
 #endif
 
 #include "mercury_context.h"
@@ -23,14 +23,14 @@
 
 Context		*MR_runqueue;
 #ifdef	MR_THREAD_SAFE
-MercuryLock	*MR_runqueue_lock;
-MercuryCond	*MR_runqueue_cond;
+  MercuryLock	*MR_runqueue_lock;
+  MercuryCond	*MR_runqueue_cond;
 #endif
 
 
 static Context	*free_context_list = NULL;
 #ifdef	MR_THREAD_SAFE
-static	MercuryLock *free_context_list_lock;
+  static	MercuryLock *free_context_list_lock;
 #endif
 
 void
diff -ur bak/mercury/runtime/mercury_context.h mercury/runtime/mercury_context.h
--- bak/mercury/runtime/mercury_context.h	Tue Apr 28 10:10:48 1998
+++ mercury/runtime/mercury_context.h	Thu May 21 16:12:06 1998
@@ -10,7 +10,7 @@
 ** A Context is like a thread. It contains a detstack, a nondetstack, a trail,
 ** the various pointers that refer to them, a succip, and a thread-
 ** resumption continuation. Contexts are initally stored in a free-list.
-** When one is running, the Unix process that is executing it has a pointer
+** When one is running, the Unix thread that is executing it has a pointer
 ** to its context structure `this_context'. When a context suspends, it
 ** calls `save_context(context_ptr)' which copies the context from the
 ** various registers and global variables into the structure referred to
@@ -22,22 +22,18 @@
 ** become the first det stackframe in the new process. (XXX this will need
 ** fixing eventually to include the nondet frame as well.)
 **
-** Threads can migrate transparently between multiple Unix processes.
-** This is implicit since all the state of the thread is allocated in
-** shared memory, and all the heaps are also in shared memory.
+** Contexts can migrate transparently between multiple Unix threads.
 **
-** Each Unix process has its own heap and solutions heap (both allocated
+** Each Unix thread has its own heap and solutions heap (both allocated
 ** in shared memory). This makes GC harder, but enables heap allocation
-** to be done without locking.
+** to be done without locking which is very important for performance.
 ** Each context has a copy of the heap pointer that is taken when it is
-** switched out. If the Unix process' heap pointer is the same as the
+** switched out. If the Unix thread's heap pointer is the same as the
 ** copied one when the context is switched back in, then it is safe for
 ** the context to do heap reclamation on failure.
 **
-** If PARALLEL is not defined, then everything gets executed within a
-** single Unix process. No locking is required. No shared memory is
-** required. Since there is only one process, no signalling is needed
-** to wake suspended processes.
+** If MR_THREAD_SAFE is not defined, then everything gets executed within a
+** single Unix thread. No locking is required.
 */
 
 #ifndef MERCURY_CONTEXT_H
@@ -140,11 +136,11 @@
 ** runnable.
 */
 
-extern	Context		*MR_runqueue;
-extern	Context		*MR_suspended_forks;
+extern		Context		*MR_runqueue;
+extern		Context		*MR_suspended_forks;
 #ifdef	MR_THREAD_SAFE
-extern	MercuryLock	*MR_runqueue_lock;
-extern	MercuryCond	*MR_runqueue_cond;
+  extern	MercuryLock	*MR_runqueue_lock;
+  extern	MercuryCond	*MR_runqueue_cond;
 #endif
 
 
@@ -188,7 +184,7 @@
 */
 
 #ifdef	MR_THREAD_SAFE
-#define schedule(cptr)	do {					\
+  #define schedule(cptr)	do {				\
 		MR_LOCK(MR_runqueue_lock, "schedule");		\
 		((Context *)cptr)->next = MR_runqueue;		\
 		MR_runqueue = (Context *) (cptr);		\
@@ -207,7 +203,7 @@
 	** into the runqueue. Currently, it is not possible for
 	** floundering to occur, so we haven't got a check for it.
 	*/
-#define runnext()	do {					\
+  #define runnext()	do {					\
 		Context *rn_c, *rn_p;				\
 		unsigned x;					\
 		MercuryThread t;				\
@@ -240,12 +236,12 @@
 		GOTO(MR_ENGINE(this_context)->resume);		\
 	} while(0)
 #else
-#define schedule(cptr)	do {					\
+  #define schedule(cptr)	do {				\
 		((Context *)cptr)->next = MR_runqueue;		\
 		MR_runqueue = (Context *) (cptr);		\
 	} while(0)
 
-#define runnext()	do {					\
+  #define runnext()	do {					\
 		if (MR_runqueue == NULL) {			\
 			fatal_error("empty runqueue");		\
 		}						\
@@ -257,9 +253,9 @@
 #endif
 
 #ifdef	MR_THREAD_SAFE
-#define	IF_MR_THREAD_SAFE(x)	x
+  #define IF_MR_THREAD_SAFE(x)	x
 #else
-#define IF_MR_THREAD_SAFE(x)
+  #define IF_MR_THREAD_SAFE(x)
 #endif
 /*
 ** fork_new_context(Code *child, Code *parent, int numslots):
@@ -268,26 +264,23 @@
 ** The new context gets put on the runqueue, and the current
 ** context resumes at `parent'.
 */
-#define fork_new_context(child, parent, numslots) do {			\
+#define MR_fork_new_context(child, parent, numslots) do {		\
 		Context	*f_n_c_context;					\
 		int	fork_new_context_i;				\
-		MR_LOCK(MR_runqueue_lock, "fork");			\
-		MR_UNLOCK(MR_runqueue_lock, "fork");			\
 		f_n_c_context = create_context();			\
 		IF_MR_THREAD_SAFE(					\
 			f_n_c_context->owner_thread = NULL;		\
 		)							\
 		for (fork_new_context_i = (numslots) ;			\
 				fork_new_context_i > 0 ;		\
-				fork_new_context_i--) {			\
+				fork_new_context_i-- ) {		\
 			*(f_n_c_context->context_sp) = 			\
 				detstackvar(fork_new_context_i);	\
 			f_n_c_context->context_sp++;			\
 		}							\
 		f_n_c_context->resume = (child);			\
 		schedule(f_n_c_context);				\
-		GOTO((parent));						\
-		}							\
+		GOTO(parent);						\
 	} while (0)
 
 #ifndef	CONSERVATIVE_GC
@@ -320,7 +313,7 @@
 ** furthest back that we can backtrack is the same as it was last time we
 ** were executing.
 */
-#define set_min_heap_reclamation_point(ctxt)	do {		\
+  #define set_min_heap_reclamation_point(ctxt)	do {		\
 		if (hp != (ctxt)->context_hp 			\
 			|| (ctxt)->context_hp == NULL)		\
 		{						\
@@ -333,23 +326,23 @@
 		}						\
 	} while (0)
 
-#define	save_hp_in_context(ctxt)	do {		\
+  #define	save_hp_in_context(ctxt)	do {		\
 		(ctxt)->context_hp = hp;		\
 		(ctxt)->min_hp_rec = MR_min_hp_rec;	\
 	} while (0)
 
 #else
 
-#define set_min_heap_reclamation_point(ctxt)	do { } while (0)
+  #define set_min_heap_reclamation_point(ctxt)	do { } while (0)
 
-#define	save_hp_in_context(ctxt)		do { } while (0)
+  #define save_hp_in_context(ctxt)		do { } while (0)
 
 #endif
 
 #ifdef MR_USE_TRAIL
-#define MR_IF_USE_TRAIL(x) x
+  #define MR_IF_USE_TRAIL(x) x
 #else
-#define MR_IF_USE_TRAIL(x)
+  #define MR_IF_USE_TRAIL(x)
 #endif
 
 #define	load_context(cptr)	do {					\
@@ -394,29 +387,23 @@
 
 typedef struct SYNCTERM SyncTerm;
 struct SYNCTERM {
-#ifdef	MR_THREAD_SAFE
+  #ifdef MR_THREAD_SAFE
 	MercuryLock	lock;
-#endif
+  #endif
 	int		count;
 	Context		*parent;
 };
 
-#ifdef	MR_THREAD_SAFE
-#define MR_init_sync_term(sync_term, nbranches)	do {			\
-		SyncTerm *st = (SyncTerm *) sync_term;			\
-		pthread_mutex_init(&(st->lock), MR_MUTEX_ATTR);		\
-		st->count = (nbranches);				\
-		st->parent = NULL;					\
-	} while (0)
-#else
 #define MR_init_sync_term(sync_term, nbranches)	do {			\
 		SyncTerm *st = (SyncTerm *) sync_term;			\
+		MR_IF_THREAD_SAFE(					\
+			pthread_mutex_init(&(st->lock), MR_MUTEX_ATTR);	\
+		)							\
 		st->count = (nbranches);				\
 		st->parent = NULL;					\
 	} while (0)
-#endif
 
-#define join_and_terminate(sync_term)	do {				\
+#define MR_join_and_terminate(sync_term)	do {			\
 		SyncTerm *st = (SyncTerm *) sync_term;			\
 		MR_LOCK(&(st->lock), "terminate");			\
 		(st->count)--;						\
@@ -432,7 +419,7 @@
 		runnext();						\
 	} while (0)
 
-#define join_and_continue(sync_term, where_to)	do {			\
+#define MR_join_and_continue(sync_term, where_to)	do {		\
 		SyncTerm *st = (SyncTerm *) sync_term;			\
 		MR_LOCK(&(st->lock), "continue");			\
 		(st->count)--;						\
diff -ur bak/mercury/runtime/mercury_engine.c mercury/runtime/mercury_engine.c
--- bak/mercury/runtime/mercury_engine.c	Tue Apr 28 10:10:51 1998
+++ mercury/runtime/mercury_engine.c	Wed May  6 15:00:32 1998
@@ -37,7 +37,7 @@
 bool	debugflag[MAXFLAG];
 
 #ifndef MR_THREAD_SAFE
-MercuryEngine	MR_engine_base;
+  MercuryEngine	MR_engine_base;
 #endif
 
 /*---------------------------------------------------------------------------*/
@@ -54,7 +54,7 @@
 void 
 init_engine(MercuryEngine *eng)
 {
-	/* XXX */ init_memory();
+	init_memory();
 
 #ifndef	CONSERVATIVE_GC
 	eng->heap_zone = create_zone("heap", 1, heap_size, next_offset(),
diff -ur bak/mercury/runtime/mercury_engine.h mercury/runtime/mercury_engine.h
--- bak/mercury/runtime/mercury_engine.h	Tue Apr 28 10:10:51 1998
+++ mercury/runtime/mercury_engine.h	Tue Apr 28 12:14:15 1998
@@ -20,6 +20,7 @@
 #include "mercury_goto.h"		/* for `Define_entry()' */
 #include "mercury_regs.h"		/* for NUM_REAL_REGS */
 #include "mercury_thread.h"		/* for pthread types */
+#include "mercury_context.h"		/* for MR_IF_USE_TRAIL */
 
 #define	PROGFLAG	0
 #define	GOTOFLAG	1
diff -ur bak/mercury/runtime/mercury_grade.h mercury/runtime/mercury_grade.h
--- bak/mercury/runtime/mercury_grade.h	Tue Apr 28 10:10:53 1998
+++ mercury/runtime/mercury_grade.h	Thu May 21 08:13:55 1998
@@ -31,11 +31,11 @@
 #define MR_PASTE2(p1,p2)	MR_PASTE2_2(p1,p2)
 #define MR_PASTE2_2(p1,p2)	p1##p2
 
-/* paste 9 macros together */
-#define MR_PASTE10(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10) \
-				MR_PASTE10_2(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10)
-#define MR_PASTE10_2(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10) \
-				p1##p2##p3##p4##p5##p6##p7##p8##p9##p10
+/* paste 11 macros together */
+#define MR_PASTE11(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11) \
+				MR_PASTE11_2(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11)
+#define MR_PASTE11_2(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11) \
+				p1##p2##p3##p4##p5##p6##p7##p8##p9##p10##p11
 
 /*
 ** Here we build up the MR_GRADE macro part at a time,
@@ -65,20 +65,25 @@
   #endif
 #endif
 
+#ifdef MR_THREAD_SAFE
+  #define MR_GRADE_PART_3	_par
+#else
+  #define MR_GRADE_PART_3
+#endif
 #ifdef CONSERVATIVE_GC
-  #define MR_GRADE_PART_3	_gc
+  #define MR_GRADE_PART_4	_gc
 #elif defined(NATIVE_GC)
-  #define MR_GRADE_PART_3	_agc
+  #define MR_GRADE_PART_4	_agc
 #else
-  #define MR_GRADE_PART_3
+  #define MR_GRADE_PART_4
 #endif
 
 #ifdef PROFILE_TIME
   #ifdef PROFILE_CALLS
     #ifdef PROFILE_MEMORY
-      #define MR_GRADE_PART_4	_profall
+      #define MR_GRADE_PART_5	_profall
     #else
-      #define MR_GRADE_PART_4	_prof
+      #define MR_GRADE_PART_5	_prof
     #endif
   #else
     #ifdef PROFILE_MEMORY
@@ -89,15 +94,15 @@
       #error "Invalid combination of profiling options"
     #else
       /* Currently useless, but... */
-      #define MR_GRADE_PART_4	_proftime
+      #define MR_GRADE_PART_5	_proftime
     #endif
   #endif
 #else
   #ifdef PROFILE_CALLS
     #ifdef PROFILE_MEMORY
-      #define MR_GRADE_PART_4	_memprof
+      #define MR_GRADE_PART_5	_memprof
     #else
-      #define MR_GRADE_PART_4	_profcalls
+      #define MR_GRADE_PART_5	_profcalls
     #endif
   #else
     #ifdef PROFILE_MEMORY
@@ -108,50 +113,50 @@
       */
       #error "Invalid combination of profiling options"
     #else
-      #define MR_GRADE_PART_4
+      #define MR_GRADE_PART_5
     #endif
   #endif
 #endif
 
 #ifdef MR_USE_TRAIL
-  #define MR_GRADE_PART_5	_tr
+  #define MR_GRADE_PART_6	_tr
 #else
-  #define MR_GRADE_PART_5
+  #define MR_GRADE_PART_6
 #endif
 
 #if TAGBITS == 0
-  #define MR_GRADE_PART_6	_notags
+  #define MR_GRADE_PART_7	_notags
 #elif defined(HIGHTAGS)
-  #define MR_GRADE_PART_6	MR_PASTE2(_hightags, TAGBITS)
+  #define MR_GRADE_PART_7	MR_PASTE2(_hightags, TAGBITS)
 #else
-  #define MR_GRADE_PART_6	MR_PASTE2(_tags, TAGBITS)
+  #define MR_GRADE_PART_7	MR_PASTE2(_tags, TAGBITS)
 #endif
 
 #ifdef BOXED_FLOAT
-  #define MR_GRADE_PART_7
+  #define MR_GRADE_PART_8
 #else				/* "ubf" stands for "unboxed float" */
-  #define MR_GRADE_PART_7	_ubf
+  #define MR_GRADE_PART_8	_ubf
 #endif
 
 #ifdef COMPACT_ARGS
-  #define MR_GRADE_PART_8	
+  #define MR_GRADE_PART_9	
 #else				/* "sa" stands for "simple args" */
-  #define MR_GRADE_PART_8	_sa
+  #define MR_GRADE_PART_9	_sa
 #endif
 
 #ifdef SPEED
-  #define MR_GRADE_PART_9
+  #define MR_GRADE_PART_10
 #else
-  #define MR_GRADE_PART_9	_debug
+  #define MR_GRADE_PART_10	_debug
 #endif
 
 #if defined(PIC_REG) && defined(USE_GCC_GLOBAL_REGISTERS) && defined(__i386__)
-  #define MR_GRADE_PART_10	_picreg
+  #define MR_GRADE_PART_11	_picreg
 #else
-  #define MR_GRADE_PART_10
+  #define MR_GRADE_PART_11
 #endif
 
-#define MR_GRADE		MR_PASTE10(			\
+#define MR_GRADE		MR_PASTE11(			\
 					MR_GRADE_PART_1,	\
 					MR_GRADE_PART_2,	\
 					MR_GRADE_PART_3,	\
@@ -161,7 +166,8 @@
 					MR_GRADE_PART_7,	\
 					MR_GRADE_PART_8,	\
 					MR_GRADE_PART_9,	\
-					MR_GRADE_PART_10	\
+					MR_GRADE_PART_10,	\
+					MR_GRADE_PART_11	\
 				)
 
 #define MR_GRADE_VAR		MR_PASTE2(MR_grade_,MR_GRADE)
diff -ur bak/mercury/runtime/mercury_memory.c mercury/runtime/mercury_memory.c
--- bak/mercury/runtime/mercury_memory.c	Tue Apr 28 10:10:55 1998
+++ mercury/runtime/mercury_memory.c	Wed May  6 15:02:11 1998
@@ -205,11 +205,11 @@
 void 
 init_memory(void)
 {
-	static first_time_only=0;
+	static bool already_initialized = FALSE;
 
-	if (first_time_only != 0)
+	if (already_initialized != FALSE)
 		return;
-	first_time_only = 1;
+	already_initialized = TRUE;
 
 	/*
 	** Convert all the sizes are from kilobytes to bytes and
diff -ur bak/mercury/runtime/mercury_misc.c mercury/runtime/mercury_misc.c
--- bak/mercury/runtime/mercury_misc.c	Tue Apr 28 10:10:56 1998
+++ mercury/runtime/mercury_misc.c	Wed May  6 15:17:31 1998
@@ -488,6 +488,13 @@
 	return p;
 }
 
+void
+MR_memcpy(char *dest, const char *src, size_t nbytes)
+{
+	while (nbytes-- > 0)
+		*dest++ = *src++;
+}
+
 /*
 **  Note that hash_string is actually defined as a macro in mercury_imp.h,
 **  if we're using GNU C.  We define it here whether or not we're using
@@ -502,3 +509,4 @@
 {
 	HASH_STRING_FUNC_BODY
 }
+
diff -ur bak/mercury/runtime/mercury_misc.h mercury/runtime/mercury_misc.h
--- bak/mercury/runtime/mercury_misc.h	Tue Apr 28 10:10:56 1998
+++ mercury/runtime/mercury_misc.h	Wed May  6 15:19:17 1998
@@ -4,7 +4,12 @@
 ** Public License - see the file COPYING.LIB in the Mercury distribution.
 */
 
-/* mercury_misc.h - debugging messages, fatal_error(), and checked_malloc() */
+/*
+** mercury_misc.h -	debugging messages,
+**			fatal_error(),
+**			checked_malloc(),
+**			MR_memcpy
+*/
 
 #ifndef	MERCURY_MISC_H
 #define	MERCURY_MISC_H
@@ -68,5 +73,13 @@
 */
 #include <stddef.h>	/* for size_t */
 void *checked_malloc(size_t n);
+
+/*
+** We use our own version of memcpy because gcc recognises calls to the
+** standard memcpy and generates inline code for them. Unfortunately this
+** causes it to abort because it tries to use a register that we're already
+** reserved.
+*/
+void MR_memcpy(char *dest, const char *src, size_t nbytes);
 
 #endif /* not MERCURY_MISC_H */
diff -ur bak/mercury/runtime/mercury_thread.c mercury/runtime/mercury_thread.c
--- bak/mercury/runtime/mercury_thread.c	Tue Apr 28 10:11:13 1998
+++ mercury/runtime/mercury_thread.c	Wed May  6 15:21:49 1998
@@ -69,7 +69,7 @@
 
 	save_registers();
 #else
-	MR_engine_base = *eng;
+	MR_memcpy(&MR_engine_base, eng, sizeof(MercuryEngine));
 	restore_registers();
 
 	load_engine_regs(MR_engine_base);
diff -ur bak/mercury/runtime/mercury_thread.h mercury/runtime/mercury_thread.h
--- bak/mercury/runtime/mercury_thread.h	Tue Apr 28 10:11:13 1998
+++ mercury/runtime/mercury_thread.h	Wed May 20 10:44:45 1998
@@ -7,7 +7,7 @@
 #include <pthread.h>
 #include "mercury_std.h"
 
-#if defined(__alpha__)
+#if defined(MR_DIGITAL_UNIX_PTHREADS)
 #define MR_MUTEX_ATTR	pthread_mutexattr_default
 #define MR_COND_ATTR	pthread_condattr_default
 #define MR_THREAD_ATTR	pthread_attr_default
@@ -41,7 +41,7 @@
 #define	MR_WAIT(cnd, mtx)	MR_cond_wait((cnd), (mtx))
 #endif
 
-#if defined(__alpha__)
+#if defined(MR_DIGITAL_UNIX_PTHREADS)
 #define MR_GETSPECIFIC(key) 	({			\
 		pthread_addr_t gstmp;			\
 		pthread_getspecific((key), &gstmp);	\
diff -ur bak/mercury/scripts/init_grade_options.sh-subr mercury/scripts/init_grade_options.sh-subr
--- bak/mercury/scripts/init_grade_options.sh-subr	Tue Apr 28 10:11:47 1998
+++ mercury/scripts/init_grade_options.sh-subr	Tue Apr 28 13:02:27 1998
@@ -23,7 +23,7 @@
 use_trail=false
 args_method=compact
 debug=false
-thread_safe=true
+thread_safe=false
 
 case $# in
 	0) set - "--grade $DEFAULT_GRADE" ;;
diff -ur bak/mercury/scripts/mgnuc.in mercury/scripts/mgnuc.in
--- bak/mercury/scripts/mgnuc.in	Tue Apr 28 10:11:48 1998
+++ mercury/scripts/mgnuc.in	Tue Apr 28 13:06:00 1998
@@ -286,6 +286,13 @@
 		# disabling the warning.
 		CHECK_OPTS="$CHECK_OPTS -Wno-uninitialized"
 		;;
+	sparc-*)
+		# The solaris headers for pthreads are not ansi :-(
+		if [ $thread_safe = true ]
+		then
+			ANSI_OPTS=""
+		fi
+		;;
 esac
 
 #
diff -ur bak/mercury/scripts/ml.in mercury/scripts/ml.in
--- bak/mercury/scripts/ml.in	Tue Apr 28 10:11:48 1998
+++ mercury/scripts/ml.in	Wed May  6 14:45:48 1998
@@ -316,9 +316,13 @@
 case $thread_safe in
 	true)
 		case "$FULLARCH" in
-		*alpha*)	THREAD_LIBS="-lpthreads -lc_r" ;;
-		*linux*)	THREAD_LIBS="-lpthread" ;;
-		*sparc*)	THREAD_LIBS="-lpthread -ldl" ;;
+		*-osf*)		THREAD_LIBS="-lpthreads -lc_r" ;;
+		*-linux*)	THREAD_LIBS="-lpthread" ;;
+		*-solaris*)	THREAD_LIBS="-lpthread -ldl" ;;
+		*)		echo "$0: warning: don't know which" \
+					"library to use for pthreads" 1>&2
+				 THREAD_LIBS=""
+				 ;;
 		esac ;;
 	false)	THREAD_LIBS="" ;;
 esac



More information about the developers mailing list