[m-rev.] for review: use foreign_type instead of c_pointer

[Simon Taylor]

Estimated hours taken: 0.5
Branches: main, release

compiler/process_util.m:
	Avoid possible misaligned memory accesses by using
	`:- pragma foreign_type' for the signal_action type
	instead of c_pointer.  It's now up to the compiler
	and runtime to get the alignment correct.

Index: process_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/process_util.m,v
retrieving revision 1.6
diff -u -u -r1.6 process_util.m
--- process_util.m	21 Nov 2002 06:31:20 -0000	1.6
+++ process_util.m	21 Nov 2002 16:24:32 -0000
@@ -100,7 +100,8 @@
 		{ Info = Info1 }
 	).	
 
-:- type signal_action ---> signal_action(c_pointer).
+:- type signal_action ---> signal_action.
+:- pragma foreign_type("C", signal_action, "MR_signal_action").
 
 :- pragma foreign_decl("C",
 "
@@ -156,55 +157,23 @@
 }
 ").
 
-:- pred setup_signal_handlers(maybe(signal_action)::out,
+:- pred setup_signal_handlers(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").
+setup_signal_handlers(signal_action::out, IO::di, IO::uo).
 
 :- pragma foreign_proc("C",
-	setup_signal_handlers_2(SigintHandler::out, IO0::di, IO::uo),
+	setup_signal_handlers(SigintHandler::out, IO0::di, IO::uo),
 	[will_not_call_mercury, promise_pure, tabled_for_io],
 "{
 	IO = IO0;
 	MC_signalled = MR_FALSE;
 
 	/*
-	** XXX There is no guarantee that the memory allocated by
-	** MR_incr_hp_msg() will be sufficiently aligned to hold
-	** a value of type MR_signal_action.
-	*/
-	MR_incr_hp_msg(SigintHandler,
-		MR_bytes_to_words(sizeof(MR_signal_action)),
-		MR_PROC_LABEL, ""libs.process_util.signal_action/0"");
-
-	/*
 	** mdb sets up a SIGINT handler, so we should restore
 	** it after we're done.
 	*/
-	MR_get_signal_action(SIGINT, (MR_signal_action *) SigintHandler,
+	MR_get_signal_action(SIGINT, &SigintHandler,
 		""error getting SIGINT handler"");
 	MC_SETUP_SIGNAL_HANDLER(SIGINT, MC_mercury_compile_signal_handler);
 	MC_SETUP_SIGNAL_HANDLER(SIGTERM, MC_mercury_compile_signal_handler);
@@ -216,25 +185,17 @@
 #endif
 }").
 
-:- 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,
+:- pred restore_signal_handlers(signal_action::in,
 		io__state::di, io__state::uo) is det.
 
-restore_signal_handlers_2(_::in, _::di, _::uo) :-
-	error("restore_signal_handlers_2").
+restore_signal_handlers(_::in, IO::di, IO::uo).
 
 :- pragma foreign_proc("C",
-	restore_signal_handlers_2(SigintHandler::in, IO0::di, IO::uo),
+	restore_signal_handlers(SigintHandler::in, IO0::di, IO::uo),
 	[will_not_call_mercury, promise_pure, tabled_for_io],
 "{
 	IO = IO0;
-	MR_set_signal_action(SIGINT, (MR_signal_action *) SigintHandler,
+	MR_set_signal_action(SIGINT, &SigintHandler,
 		""error resetting SIGINT handler"");
 	MC_SETUP_SIGNAL_HANDLER(SIGTERM, SIG_DFL);
 #ifdef SIGHUP
@@ -251,39 +212,15 @@
 :- pred setup_child_signal_handlers(io__state::di, io__state::uo) is det.
 
 setup_child_signal_handlers -->
-	( { SIG_DFL = sig_dfl } ->
-		restore_signal_handlers(yes(SIG_DFL))
-	;
-		[]
-	).
-
-:- func sig_dfl = signal_action is semidet.
-
-sig_dfl = SIG_DFL :-
-	( have_signal_handlers(1) ->
-		SIG_DFL = sig_dfl_2
-	;
-		fail
-	).
+	restore_signal_handlers(sig_dfl).
 
-:- func sig_dfl_2 = signal_action.
+:- func sig_dfl = signal_action.
 
-sig_dfl_2 = (_::out) :- error("process_util__sig_dfl_2 called").
+sig_dfl = (signal_action::out).
 
-:- pragma foreign_proc("C", sig_dfl_2 = (Result::out),
+:- pragma foreign_proc("C", sig_dfl = (Result::out),
 		[will_not_call_mercury, promise_pure],
-"
-	/*
-	** XXX There is no guarantee that the memory allocated by
-	** MR_incr_hp_msg() will be sufficiently aligned to hold
-	** a value of type MR_signal_action.
-	*/
-	MR_incr_hp_msg(Result,
-		MR_bytes_to_words(sizeof(MR_signal_action)),
-		MR_PROC_LABEL, ""libs.process_util.signal_action/0"");
-	MR_init_signal_action((MR_signal_action *) Result,
-		SIG_DFL, MR_FALSE, MR_TRUE);
-").
+	"MR_init_signal_action(&Result, SIG_DFL, MR_FALSE, MR_TRUE);").
 
 :- pred check_for_signal(int::out, int::out,
 		io__state::di, io__state::uo) is det.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------