[m-rev.] for review: add maybe_thread_safe attribute

Julien Fischer juliensf at cs.mu.OZ.AU
Mon Feb 21 17:29:05 AEDT 2005


For review by anyone.

Estimated hours taken: 4.5
Branches: main

Add a new foreign proc attribute `maybe_thread_safe' and
a new compiler option `--maybe-thread-safe'.

The thread safety of foreign procs that have the `maybe_thread_safety'
attribute set is dependent upon the value of the `--maybe-thread-safe'
option.  This facility is intended for use in writing bindings to
libraries whose thread safety is itself conditional.

At quite an early stage `maybe_thread_safe' is turned into
either `thread_safe' or `not_thread_safe' depending on the
value of the `--maybe-thread-safe' option.  In particular,
it will appear as either `thread_safe' or `not_thread_safe'
in any optimization interfaces.

compiler/prog_io_pragma.m
compiler/prog_data.m
	Parse the new foreign code attribute, `maybe_thread_safe'.

	Fix a place where the line width was > 79 characters.

compiler/options.m:
compiler/globals.m:
compiler/handle_options.m:
	Add a new option `--maybe-thread-safe' that tells the compiler
	how to handle `maybe_thread_safe' foreign code attributes.

compiler/make_hlds.m:
	Convert a any `maybe_thread_safe' attributes into `thread_safe'
	or `not_thread_safe' attributes depending upon the value of the
	`--maybe-thread-safe' option.

compiler/pragma_c_gen.m:
	Call unexpected/2 if we encounter the `maybe_thread_safe'
	attribute here, as it should have been replaced with either
	`thread_safe' or `not_thread_safe' by this point.

doc/reference_manual.texi:
doc/user_guide.texi:
	Document the new attribute and option.

vim/syntax/mercury.vim:
	Highlight the new attribute.

Julien.

Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.64
diff -u -r1.64 globals.m
--- compiler/globals.m	27 Jan 2005 03:38:06 -0000	1.64
+++ compiler/globals.m	19 Feb 2005 17:00:57 -0000
@@ -100,11 +100,15 @@
 	% Map from module name to file name.
 :- type source_file_map == map(module_name, string).

+:- type maybe_thread_safe == bool.
+
 :- pred convert_target(string::in, compilation_target::out) is semidet.
 :- pred convert_foreign_language(string::in, foreign_language::out) is semidet.
 :- pred convert_gc_method(string::in, gc_method::out) is semidet.
 :- pred convert_tags_method(string::in, tags_method::out) is semidet.
 :- pred convert_termination_norm(string::in, termination_norm::out) is semidet.
+:- pred convert_maybe_thread_safe(string::in, maybe_thread_safe::out)
+	is semidet.

 %-----------------------------------------------------------------------------%

@@ -112,7 +116,8 @@

 :- pred globals__init(option_table::di, compilation_target::di, gc_method::di,
 	tags_method::di, termination_norm::di,
-	trace_level::di, trace_suppress_items::di, globals::uo) is det.
+	trace_level::di, trace_suppress_items::di,
+	maybe_thread_safe::di, globals::uo) is det.

 :- pred globals__get_options(globals::in, option_table::out) is det.
 :- pred globals__get_target(globals::in, compilation_target::out) is det.
@@ -127,6 +132,8 @@
 	is det.
 :- pred globals__get_source_file_map(globals::in, maybe(source_file_map)::out)
 	is det.
+:- pred globals__get_maybe_thread_safe(globals::in, maybe_thread_safe::out)
+	is det.

 :- pred globals__set_options(option_table::in, globals::in, globals::out)
 	is det.
@@ -182,7 +189,7 @@
 :- pred globals__io_init(option_table::di, compilation_target::in,
 	gc_method::in, tags_method::in,
 	termination_norm::in, trace_level::in, trace_suppress_items::in,
-	io::di, io::uo) is det.
+	maybe_thread_safe::in, io::di, io::uo) is det.

 :- pred globals__io_get_target(compilation_target::out, io::di, io::uo) is det.
 :- pred globals__io_get_backend_foreign_languages(list(foreign_language)::out,
@@ -198,6 +205,8 @@
 :- pred globals__io_get_trace_level(trace_level::out, io::di, io::uo) is det.
 :- pred globals__io_get_trace_suppress(trace_suppress_items::out,
 	io::di, io::uo) is det.
+:- pred globals__io_get_maybe_thread_safe(maybe_thread_safe::out,
+	io::di, io::uo) is det.

 :- pred globals__io_get_globals(globals::out, io::di, io::uo) is det.

@@ -280,6 +289,9 @@
 convert_termination_norm("num-data-elems", num_data_elems).
 convert_termination_norm("size-data-elems", size_data_elems).

+convert_maybe_thread_safe("yes", yes).
+convert_maybe_thread_safe("no",  no).
+
 foreign_language_string(c) = "C".
 foreign_language_string(managed_cplusplus) = "Managed C++".
 foreign_language_string(csharp) = "C#".
@@ -310,13 +322,15 @@
 			trace_level 		:: trace_level,
 			trace_suppress_items	:: trace_suppress_items,
 			source_file_map		:: maybe(source_file_map),
-			have_printed_usage	:: bool
+			have_printed_usage	:: bool,
+			maybe_thread_safe	:: bool
 		).

 globals__init(Options, Target, GC_Method, TagsMethod,
-		TerminationNorm, TraceLevel, TraceSuppress,
+		TerminationNorm, TraceLevel, TraceSuppress, MaybeThreadSafe,
 	globals(Options, Target, GC_Method, TagsMethod,
-		TerminationNorm, TraceLevel, TraceSuppress, no, no)).
+		TerminationNorm, TraceLevel, TraceSuppress,
+		no, no, MaybeThreadSafe)).

 globals__get_options(Globals, Globals ^ options).
 globals__get_target(Globals, Globals ^ target).
@@ -326,6 +340,7 @@
 globals__get_trace_level(Globals, Globals ^ trace_level).
 globals__get_trace_suppress(Globals, Globals ^ trace_suppress_items).
 globals__get_source_file_map(Globals, Globals ^ source_file_map).
+globals__get_maybe_thread_safe(Globals, Globals ^ maybe_thread_safe).

 globals__get_backend_foreign_languages(Globals, ForeignLangs) :-
 	globals__lookup_accumulating_option(Globals, backend_foreign_languages,
@@ -459,15 +474,18 @@
 %-----------------------------------------------------------------------------%

 globals__io_init(Options, Target, GC_Method, TagsMethod,
-		TerminationNorm, TraceLevel, TraceSuppress) -->
+		TerminationNorm, TraceLevel, TraceSuppress,
+		MaybeThreadSafe) -->
 	{ copy(Target, Target1) },
 	{ copy(GC_Method, GC_Method1) },
 	{ copy(TagsMethod, TagsMethod1) },
 	{ copy(TerminationNorm, TerminationNorm1) },
 	{ copy(TraceLevel, TraceLevel1) },
 	{ copy(TraceSuppress, TraceSuppress1) },
+	{ copy(MaybeThreadSafe, MaybeThreadSafe1) },
 	{ globals__init(Options, Target1, GC_Method1, TagsMethod1,
-		TerminationNorm1, TraceLevel1, TraceSuppress1, Globals) },
+		TerminationNorm1, TraceLevel1, TraceSuppress1,
+		MaybeThreadSafe1, Globals) },
 	globals__io_set_globals(Globals).

 globals__io_get_target(Target) -->
@@ -493,6 +511,10 @@
 globals__io_get_trace_suppress(TraceSuppress) -->
 	globals__io_get_globals(Globals),
 	{ globals__get_trace_suppress(Globals, TraceSuppress) }.
+
+globals__io_get_maybe_thread_safe(MaybeThreadSafe, !IO) :-
+	globals__io_get_globals(Globals, !IO),
+	globals__get_maybe_thread_safe(Globals, MaybeThreadSafe).

 globals__io_get_globals(Globals) -->
 	io__get_globals(UnivGlobals),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.219
diff -u -r1.219 handle_options.m
--- compiler/handle_options.m	15 Feb 2005 05:22:16 -0000	1.219
+++ compiler/handle_options.m	19 Feb 2005 17:01:45 -0000
@@ -154,11 +154,11 @@
 postprocess_options(ok(OptionTable0), Errors, !IO) :-
 	check_option_values(OptionTable0, OptionTable, Target, GC_Method,
 		TagsMethod, TermNorm, TraceLevel, TraceSuppress,
-		[], CheckErrors),
+		MaybeThreadSafe, [], CheckErrors),
 	( CheckErrors = [] ->
 		postprocess_options_2(OptionTable, Target, GC_Method,
 			TagsMethod, TermNorm, TraceLevel, TraceSuppress,
-			[], Errors, !IO)
+			MaybeThreadSafe, [], Errors, !IO)
 	;
 		Errors = CheckErrors
 	).
@@ -166,10 +166,11 @@
 :- pred check_option_values(option_table::in, option_table::out,
 	compilation_target::out, gc_method::out, tags_method::out,
 	termination_norm::out, trace_level::out, trace_suppress_items::out,
-	list(string)::in, list(string)::out) is det.
+	maybe_thread_safe::out, list(string)::in, list(string)::out) is det.

 check_option_values(OptionTable0, OptionTable, Target, GC_Method, TagsMethod,
-		TermNorm, TraceLevel, TraceSuppress, !Errors) :-
+		TermNorm, TraceLevel, TraceSuppress, MaybeThreadSafe,
+		!Errors) :-
 	map__lookup(OptionTable0, target, Target0),
 	(
 		Target0 = string(TargetStr),
@@ -263,6 +264,16 @@
 		add_error("Invalid argument to option `--suppress-trace'.",
 			!Errors)
 	),
+	map__lookup(OptionTable0, maybe_thread_safe, MaybeThreadSafeOption),
+	( MaybeThreadSafeOption = string("yes") ->
+		MaybeThreadSafe = yes
+	; MaybeThreadSafeOption = string("no") ->
+		MaybeThreadSafe = no
+	;
+		MaybeThreadSafe = no, % dummy
+		add_error("Invalid argument to option `--maybe-thread-safe'.",
+			!Errors)
+	),
 	map__lookup(OptionTable0, dump_hlds_alias, DumpAliasOption),
 	(
 		DumpAliasOption = string(DumpAlias),
@@ -290,14 +301,15 @@

 :- pred postprocess_options_2(option_table::in, compilation_target::in,
 	gc_method::in, tags_method::in, termination_norm::in,
-	trace_level::in, trace_suppress_items::in,
+	trace_level::in, trace_suppress_items::in, maybe_thread_safe::in,
 	list(string)::in, list(string)::out, io::di, io::uo) is det.

 postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
-		TermNorm, TraceLevel, TraceSuppress, !Errors) -->
+		TermNorm, TraceLevel, TraceSuppress, MaybeThreadSafe,
+		!Errors) -->
 	{ unsafe_promise_unique(OptionTable0, OptionTable1) }, % XXX
 	globals__io_init(OptionTable1, Target, GC_Method, TagsMethod0,
-		TermNorm, TraceLevel, TraceSuppress),
+		TermNorm, TraceLevel, TraceSuppress, MaybeThreadSafe),

 	% Conservative GC implies --no-reclaim-heap-*
 	( { gc_is_conservative(GC_Method) = yes } ->
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.498
diff -u -r1.498 make_hlds.m
--- compiler/make_hlds.m	15 Feb 2005 00:04:54 -0000	1.498
+++ compiler/make_hlds.m	19 Feb 2005 15:58:43 -0000
@@ -5053,8 +5053,27 @@
     module_info::in, module_info::out, qual_info::in, qual_info::out,
     io::di, io::uo) is det.

-module_add_pragma_foreign_proc(Attributes, PredName, PredOrFunc, PVars, VarSet,
+module_add_pragma_foreign_proc(Attributes0, PredName, PredOrFunc, PVars, VarSet,
         PragmaImpl, Status, Context, !ModuleInfo, !QualInfo, !IO) :-
+    %
+    % Begin by replacing any maybe_thread_safe foreign_proc attributes
+    % with the actual thread safety attributes which we get from the
+    % `--maybe-thread-safe' option.
+    %
+    globals__io_get_globals(Globals, !IO),
+    globals__get_maybe_thread_safe(Globals, MaybeThreadSafe),
+    ThreadSafe = Attributes0 ^ thread_safe,
+    ( ThreadSafe = maybe_thread_safe ->
+        (
+            MaybeThreadSafe = yes,
+            set_thread_safe(thread_safe, Attributes0, Attributes)
+        ;
+            MaybeThreadSafe = no,
+            set_thread_safe(not_thread_safe, Attributes0, Attributes)
+        )
+    ;
+        Attributes = Attributes0
+    ),
     module_info_name(!.ModuleInfo, ModuleName),
     PragmaForeignLanguage = foreign_language(Attributes),
     list__length(PVars, Arity),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.444
diff -u -r1.444 options.m
--- compiler/options.m	15 Feb 2005 05:22:19 -0000	1.444
+++ compiler/options.m	21 Feb 2005 06:22:13 -0000
@@ -249,6 +249,7 @@
 		;	use_minimal_model_own_stacks
 		;	minimal_model_debug
 		;	type_layout
+		;	maybe_thread_safe

 		% Data representation compilation model options
 		;	reserve_tag
@@ -913,6 +914,7 @@
 	gc			-	string("boehm"),
 	parallel		-	bool(no),
 	use_trail		-	bool(no),
+	maybe_thread_safe	-	string("no"),
 	use_minimal_model_stack_copy	-	bool(no),
 	use_minimal_model_own_stacks	-	bool(no),
 	minimal_model_debug	-	bool(no),
@@ -1574,6 +1576,7 @@
 long_option("parallel",			parallel).
 long_option("use-trail",		use_trail).
 long_option("type-layout",		type_layout).
+long_option("maybe-thread-safe",	maybe_thread_safe).
 long_option("aditi",			aditi).
 long_option("aditi-calls-mercury",	aditi_calls_mercury).
 	% Data representation options
@@ -3187,7 +3190,14 @@
 		"\tEnable use of a trail.",
 		"\tThis is necessary for interfacing with constraint solvers,",
 		"\tor for backtrackable destructive update.",
-		"\tThis option is not yet supported for the IL or Java back-ends."
+		"\tThis option is not yet supported for the IL or Java back-ends.",
+		"--maybe-thread-safe {yes, no}",
+		"\tSpecify how to treat the `maybe_thread_safe' foreign code",
+		"\tattribute.  `yes' means that a foreign procedure with the",
+		"\t`maybe_thread_safe' option is treated as though it has a",
+		"\t`thread_safe' attribute.  `no' means that the foreign",
+		"\tprocedure is treated as though it has a `not_thread_safe'",
+		"\tattribute.  The default is no."
 	]),

 	io__write_string("\n    LLDS back-end compilation model options:\n"),
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.74
diff -u -r1.74 pragma_c_gen.m
--- compiler/pragma_c_gen.m	21 Jan 2005 06:20:45 -0000	1.74
+++ compiler/pragma_c_gen.m	20 Feb 2005 13:33:44 -0000
@@ -373,7 +373,16 @@
 	%
 	MayCallMercury = may_call_mercury(Attributes),
 	ThreadSafe = thread_safe(Attributes),
-
+	%
+	% The maybe_thread_safe attribute should have been changed
+	% to the real value by now.
+	%
+	( ThreadSafe = maybe_thread_safe ->
+		unexpected(this_file, "ordinary_pragma_c_code/12: " ++
+			"maybe_thread_safe encountered.")
+	;
+		true
+	),
 	%
 	% First we need to get a list of input and output arguments
 	%
@@ -512,6 +521,11 @@
 			MangledName, """);\n"], ReleaseLockStr),
 		ReleaseLock = pragma_c_raw_code(ReleaseLockStr,
 			live_lvals_info(set__init))
+
+	;
+		ThreadSafe = maybe_thread_safe,
+		unexpected(this_file, "ordinary_pragma_c_code/12: " ++
+			"maybe_thread_safe encountered.")
 	),

 	%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.118
diff -u -r1.118 prog_data.m
--- compiler/prog_data.m	19 Jan 2005 03:10:51 -0000	1.118
+++ compiler/prog_data.m	20 Feb 2005 13:41:42 -0000
@@ -905,7 +905,8 @@
 :- func foreign_language(pragma_foreign_proc_attributes) = foreign_language.
 :- func tabled_for_io(pragma_foreign_proc_attributes) = tabled_for_io.
 :- func legacy_purity_behaviour(pragma_foreign_proc_attributes) = bool.
-:- func may_throw_exception(pragma_foreign_proc_attributes) = may_throw_exception.
+:- func may_throw_exception(pragma_foreign_proc_attributes) =
+	may_throw_exception.
 :- func ordinary_despite_detism(pragma_foreign_proc_attributes) = bool.
 :- func extra_attributes(pragma_foreign_proc_attributes)
 	= pragma_foreign_proc_extra_attributes.
@@ -960,10 +961,15 @@

 	% If thread_safe execution is enabled, then we need to put a mutex
 	% around the C code for each `pragma c_code' declaration, unless
-	% it's declared to be thread_safe.
+	% it's declared to be thread_safe.  If a piece of foreign code is
+	% declared to be maybe_thread_safe whether we put the mutex around
+	% the foreign code depends upon the `--maybe-thread-safe' compiler
+	% flag.
+	%
 :- type thread_safe
 	--->	not_thread_safe
-	;	thread_safe.
+	;	thread_safe
+	;	maybe_thread_safe.

 :- type tabled_for_io
 	--->	not_tabled_for_io
@@ -1715,6 +1721,9 @@
 	;
 		ThreadSafe = thread_safe,
 		ThreadSafeStr = "thread_safe"
+	;
+		ThreadSafe = maybe_thread_safe,
+		ThreadSafeStr = "maybe_thread_safe"
 	),
 	(
 		TabledForIO = tabled_for_io,
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.77
diff -u -r1.77 prog_io_pragma.m
--- compiler/prog_io_pragma.m	19 Jan 2005 03:10:52 -0000	1.77
+++ compiler/prog_io_pragma.m	10 Feb 2005 14:39:00 -0000
@@ -1443,6 +1443,8 @@
     thread_safe).
 parse_threadsafe(term__functor(term__atom("not_thread_safe"), [], _),
     not_thread_safe).
+parse_threadsafe(term__functor(term__atom("maybe_thread_safe"), [], _),
+    maybe_thread_safe).

 :- pred parse_tabled_for_io(term::in, tabled_for_io::out) is semidet.

Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.307
diff -u -r1.307 reference_manual.texi
--- doc/reference_manual.texi	27 Jan 2005 03:46:59 -0000	1.307
+++ doc/reference_manual.texi	21 Feb 2005 06:17:27 -0000
@@ -5729,15 +5729,14 @@
 If omitted, the clause specified by the @samp{foreign_proc} is
 assumed to be impure.

- at item @samp{thread_safe}/@samp{not_thread_safe}
+ at item @samp{thread_safe}/@samp{not_thread_safe}/@samp{maybe_thread_safe}
 This attribute declares whether or not it is safe for multiple threads
 to execute this foreign language code concurrently.
-The default, in case neither is specified, is @samp{not_thread_safe}.
+The default, in case none is specified, is @samp{not_thread_safe}.
 If the foreign language code is declared @samp{thread_safe}, then the
 Mercury implementation is permitted to execute the code concurrently
-from multiple threads without taking any special precautions.  If the
-foreign language code is declared
- at samp{not_thread_safe},
+from multiple threads without taking any special precautions.
+If the foreign language code is declared @samp{not_thread_safe},
 then the Mercury implementation must not invoke the code concurrently from
 multiple threads.  If the Mercury implementation does use multithreading,
 then it must take appropriate steps to prevent this.
@@ -5749,6 +5748,12 @@
 single mutex.)
 @c XXX this can cause deadlocks if not_thread_safe foreign language code calls
 @c     Mercury which calls foreign language code
+If the foreign language code is declared @samp{maybe_thread_safe} then
+whether the code is considered @samp{thread_safe} or @samp{not_thread_safe}
+depends upon a compiler flag.  This attribute is useful when the
+thread safety of the foreign code itself is conditional.
+The Melbourne Mercury compiler uses the @samp{--maybe-thread-safe}
+option to set the value of the @samp{maybe_thread_safe} attribute.
 @end table

 Additional attributes which are supported by the Melbourne Mercury
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.421
diff -u -r1.421 user_guide.texi
--- doc/user_guide.texi	18 Feb 2005 04:05:33 -0000	1.421
+++ doc/user_guide.texi	21 Feb 2005 06:24:57 -0000
@@ -6256,6 +6256,16 @@
 or for backtrackable destructive update.
 This option is not yet supported for the IL or Java back-ends.

+ at sp 1
+ at item @code{--maybe-thread-safe @{yes, no@}}
+ at findex --maybe-thread-safe
+Specify how to treate the @samp{maybe_thread_safe} foreign code
+attribute.  @samp{yes} means that a foreign procedure with the
+ at samp{maybe_thread_safe} option is treated as thought is has a
+ at samp{thread_safe} attribute.  @samp{no} means that the foreign
+procedure is treated as though it has a @samp{not_thread_safe}
+attribute.  The default is @samp{no}.
+
 @ifset aditi
 @sp 1
 @item --aditi
Index: vim/syntax/mercury.vim
===================================================================
RCS file: /home/mercury1/repository/mercury/vim/syntax/mercury.vim,v
retrieving revision 1.12
diff -u -r1.12 mercury.vim
--- vim/syntax/mercury.vim	9 Feb 2005 07:46:51 -0000	1.12
+++ vim/syntax/mercury.vim	19 Feb 2005 16:01:10 -0000
@@ -48,7 +48,7 @@
 syn keyword mercuryCInterface   foreign_proc foreign_decl foreign_code
 syn keyword mercuryCInterface   foreign_type foreign_import_module
 syn keyword mercuryCInterface   may_call_mercury will_not_call_mercury
-syn keyword mercuryCInterface   thread_safe not_thread_safe
+syn keyword mercuryCInterface   thread_safe not_thread_safe maybe_thread_safe
 syn keyword mercuryCInterface   promise_pure promise_semipure
 syn keyword mercuryCInterface   tabled_for_io local
 syn keyword mercuryCInterface   can_pass_as_mercury_type stable

--------------------------------------------------------------------------
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