[m-rev.] for review: mmc --make [4]

Simon Taylor stayl at cs.mu.OZ.AU
Mon Mar 11 17:25:45 AEDT 2002


On 06-Feb-2002, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> Also it might be nicer to isolate the stuff that needs to be
> implemented in C in a separate module, e.g. say make.process_util.m.

I'll do this as a separate change.

I'll commit this change in the next couple of days.

Simon.

--- ../../review/mercury/compiler/make.util.m	Mon Mar 11 17:16:46 2002
+++ make.util.m	Mon Mar 11 16:43:09 2002
@@ -140,16 +140,21 @@
 	maybe_error(timestamp)::out, make_info::in, make_info::out,
 	io__state::di, io__state::uo) is det.
 
+	% Find the timestamp for the given dependency file.
 :- pred get_dependency_timestamp(dependency_file::in,
 	maybe_error(timestamp)::out, make_info::in, make_info::out,
 	io__state::di, io__state::uo) is det.
 
+	% Find the timestamp for the given target file.
 :- pred get_target_timestamp(target_file::in, maybe_error(timestamp)::out,
 	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
 
+	% Compute a file name for the given target file.
 :- pred get_file_name(target_file::in, file_name::out,
 	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
 
+	% Find the timestamp of the first file matching the given
+	% file name in one of the given directories.
 :- pred get_file_timestamp(list(dir_name)::in, file_name::in,
 	maybe_error(timestamp)::out, make_info::in, make_info::out,
 	io__state::di, io__state::uo) is det.
@@ -157,9 +162,11 @@
 %-----------------------------------------------------------------------------%
 	% Remove file a file, deleting the cached timestamp.
 
+	% Remove the target file and the corresponding timestamp file.
 :- pred remove_target_file(target_file::in, make_info::in, make_info::out,
 	io__state::di, io__state::uo) is det.
 
+	% Remove the target file and the corresponding timestamp file.
 :- pred remove_target_file(module_name::in, module_target_type::in,
 	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
 
@@ -282,9 +289,9 @@
 %-----------------------------------------------------------------------------%
 
 build_with_check_for_interrupt(Build, Cleanup, Succeeded, Info0, Info) -->
-	setup_signal_handlers(SigIntHandler),
+	setup_signal_handlers(MaybeSigIntHandler),
 	Build(Succeeded0, Info0, Info1),
-	restore_signal_handlers(SigIntHandler),
+	restore_signal_handlers(MaybeSigIntHandler),
 	check_for_signal(Signalled, Signal),
 	( { Signalled = 1 } ->
 		{ Succeeded = no },
@@ -308,15 +315,15 @@
 
 :- pragma foreign_decl("C",
 "
-#ifdef HAVE_UNISTD_H
+#ifdef MR_HAVE_UNISTD_H
   #include <unistd.h>
 #endif
 
-#ifdef HAVE_SYS_TYPES_H
+#ifdef MR_HAVE_SYS_TYPES_H
   #include <sys/types.h>
 #endif
 
-#ifdef HAVE_SYS_WAIT
+#ifdef MR_HAVE_SYS_WAIT_H
   #include <sys/wait.h>
 #endif
 
@@ -327,18 +334,21 @@
 #include ""mercury_heap.h""
 #include ""mercury_misc.h""
 
-#if defined(HAVE_FORK) && defined(HAVE_WAIT) && defined(HAVE_KILL)
+#if defined(MR_HAVE_FORK) && defined(MR_HAVE_WAIT) && defined(MR_HAVE_KILL)
   #define MC_CAN_FORK 1
 #endif
 
 #define MC_SETUP_SIGNAL_HANDLER(sig, handler) \
-		MR_setup_signal(sig, (MR_Code *) handler, FALSE,	\
+		MR_setup_signal(sig, (MR_Code *) handler, MR_FALSE,	\
 			""mercury_compile: cannot install signal handler"");
 
 	/* Have we received a signal. */
 volatile sig_atomic_t MC_signalled;
 
-	/* Which signal did we receive. */
+	/*
+	** Which signal did we receive.
+	** XXX This assumes a signal number will fit into a sig_atomic_t.
+	*/
 volatile sig_atomic_t MC_signal_received;
 
 void MC_mercury_compile_signal_handler(int sig);
@@ -346,26 +356,51 @@
 
 :- pragma foreign_code("C",
 "
-volatile sig_atomic_t MC_signalled = FALSE;
+volatile sig_atomic_t MC_signalled = MR_FALSE;
 volatile sig_atomic_t MC_signal_received = 0;
 
 void
 MC_mercury_compile_signal_handler(int sig)
 {
-	MC_signalled = TRUE;
+	MC_signalled = MR_TRUE;
 	MC_signal_received = sig;
 }
 ").
 
-:- pred setup_signal_handlers(signal_action::out,
+:- pred setup_signal_handlers(maybe(signal_action)::out,
+		io__state::di, io__state::uo) is det.
+
+setup_signal_handlers(MaybeSigIntHandler) -->
+	( { have_signal_handlers(1) } ->
+		setup_signal_handlers_2(SigintHandler),
+		{ MaybeSigIntHandler = yes(SigintHandler) }
+	;
+		{ MaybeSigIntHandler = no }
+	).
+
+	% Dummy argument to work around bug mixing Mercury and foreign clauses.
+:- pred have_signal_handlers(T::unused) is semidet.
+
+have_signal_handlers(_::unused) :- semidet_fail.
+
+:- pragma foreign_proc("C", have_signal_handlers(_T::unused),
+		[will_not_call_mercury, promise_pure],
+"{
+	SUCCESS_INDICATOR = MR_TRUE;
+}").
+
+:- pred setup_signal_handlers_2(signal_action::out,
 		io__state::di, io__state::uo) is det.
 
+setup_signal_handlers_2(_::out, _::di, _::uo) :-
+	error("setup_signal_handlers_2").
+
 :- pragma foreign_proc("C",
-		setup_signal_handlers(SigintHandler::out, IO0::di, IO::uo),
+		setup_signal_handlers_2(SigintHandler::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure],
 "{
 	IO = IO0;
-	MC_signalled = FALSE;
+	MC_signalled = MR_FALSE;
 
 	MR_incr_hp_msg(SigintHandler,
 		MR_bytes_to_words(sizeof(MR_signal_action)),
@@ -387,11 +422,21 @@
 #endif
 }").
 
-:- pred restore_signal_handlers(signal_action::in,
+:- pred restore_signal_handlers(maybe(signal_action)::in,
+		io__state::di, io__state::uo) is det.
+
+restore_signal_handlers(no) --> [].
+restore_signal_handlers(yes(SigintHandler)) -->
+	restore_signal_handlers_2(SigintHandler).
+
+:- pred restore_signal_handlers_2(signal_action::in,
 		io__state::di, io__state::uo) is det.
 
+restore_signal_handlers_2(_::in, _::di, _::uo) :-
+	error("restore_signal_handlers_2").
+
 :- pragma foreign_proc("C",
-		restore_signal_handlers(SigintHandler::in, IO0::di, IO::uo),
+		restore_signal_handlers_2(SigintHandler::in, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure],
 "{
 	IO = IO0;
@@ -434,7 +479,7 @@
 	call_in_forked_process(P, P, Success).
 
 call_in_forked_process(P, AltP, Success) -->
-	( { can_fork } ->
+	( { can_fork(1) } ->
 		debug_msg(io__write_string("call_in_forked_process\n")),
 		call_in_forked_process_2(P, ForkStatus, CallStatus),
 		{ ForkStatus = 1 ->
@@ -450,21 +495,27 @@
 		AltP(Success)
 	).
 
-:- pred can_fork is semidet.
+	% Dummy argument to work around bug mixing Mercury and foreign clauses.
+:- pred can_fork(T::unused) is semidet.
+
+can_fork(_::unused) :- semidet_fail.
 
-:- pragma foreign_proc("C", can_fork,
+:- pragma foreign_proc("C", can_fork(_T::unused),
 		[will_not_call_mercury, thread_safe, promise_pure],
 "
 #ifdef MC_CAN_FORK
-	SUCCESS_INDICATOR = TRUE;
+	SUCCESS_INDICATOR = MR_TRUE;
 #else
-	SUCCESS_INDICATOR = FALSE;
+	SUCCESS_INDICATOR = MR_FALSE;
 #endif
 ").
 
 :- pred call_in_forked_process_2(io_pred::in(io_pred), int::out, int::out,
 		io__state::di, io__state::uo) is det.
 
+call_in_forked_process_2(_::in(io_pred), _::out, _::out, _::di, _::uo) :-
+	error("call_in_forked_process_2").
+
 :- pragma foreign_proc("C",
 		call_in_forked_process_2(Pred::in(io_pred),
 			ForkStatus::out, Status::out, IO0::di, IO::uo),
@@ -484,7 +535,7 @@
 	} else if (child_pid == 0) {	/* child */
 		MR_Integer exit_status;
 
-		call_io_pred(Pred, &exit_status);
+		MC_call_io_pred(Pred, &exit_status);
 		exit(exit_status);
 	} else {			/* parent */
 		int child_status;
@@ -494,13 +545,13 @@
 		** Make sure the wait() is interrupted by the signals
 		** which cause us to exit.
 		*/
-		MR_signal_should_restart(SIGINT, FALSE);
-		MR_signal_should_restart(SIGTERM, FALSE);
+		MR_signal_should_restart(SIGINT, MR_FALSE);
+		MR_signal_should_restart(SIGTERM, MR_FALSE);
 #ifdef SIGHUP
-		MR_signal_should_restart(SIGHUP, FALSE);
+		MR_signal_should_restart(SIGHUP, MR_FALSE);
 #endif
 #ifdef SIGQUIT
-		MR_signal_should_restart(SIGQUIT, FALSE);
+		MR_signal_should_restart(SIGQUIT, MR_FALSE);
 #endif
 
 		while (1) {
@@ -536,27 +587,27 @@
 		/*
 		** Restore the system call signal behaviour. 
 		*/
-		MR_signal_should_restart(SIGINT, TRUE);
-		MR_signal_should_restart(SIGTERM, TRUE);
+		MR_signal_should_restart(SIGINT, MR_TRUE);
+		MR_signal_should_restart(SIGTERM, MR_TRUE);
 #ifdef SIGHUP
-		MR_signal_should_restart(SIGHUP, TRUE);
+		MR_signal_should_restart(SIGHUP, MR_TRUE);
 #endif
 #ifdef SIGQUIT
-		MR_signal_should_restart(SIGQUIT, TRUE);
+		MR_signal_should_restart(SIGQUIT, MR_TRUE);
 #endif
 
 	}
-#else
+#else /* ! MC_CAN_FORK */
 	IO = IO0;
 	ForkStatus = 1;
 	Status = 1;
-#endif
+#endif /* ! MC_CAN_FORK */
 }").
 
 	% call_io_pred(P, ExitStatus).
 :- pred call_io_pred(io_pred::in(io_pred), int::out,
 		io__state::di, io__state::uo) is det.
-:- pragma export(call_io_pred(in(io_pred), out, di, uo), "call_io_pred").
+:- pragma export(call_io_pred(in(io_pred), out, di, uo), "MC_call_io_pred").
 
 call_io_pred(P, Status) -->
 	P(Success),
@@ -905,8 +956,8 @@
 	globals__lookup_string_option(Globals, shared_library_extension, Ext).
 
 	% Note that we need a timestamp file for `.err' files because
-	% errors is written to the `.err'. The timestamp is only updated
-	% when compiling to target code.
+	% errors are written to the `.err' file even when writing interfaces.
+	% The timestamp is only updated when compiling to target code.
 timestamp_extension(errors) = ".err_date".
 timestamp_extension(private_interface) = ".date0".
 timestamp_extension(long_interface) = ".date".
Index: mercury_compile.m
===================================================================
--- mercury_compile.m	8 Mar 2002 04:03:23 -0000	1.238
+++ mercury_compile.m	11 Mar 2002 05:05:20 -0000
@@ -15,9 +15,83 @@
 	( { Help = yes } ->
-		long_usage
+		io__stdout_stream(Stdout),
+		io__set_output_stream(Stdout, OldOutputStream),
+		long_usage,
+		io__set_output_stream(OldOutputStream, _)
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list