[m-rev.] for review: thread-local mutables

Peter Wang wangp at students.csse.unimelb.edu.au
Wed Jan 10 17:25:50 AEDT 2007


Estimated hours taken: 15
Branches: main

Add support for thread-local mutables.  These can take on a different value for
each Mercury thread.  Child threads automatically inherit the thread-local
values of the parent thread that spawned it.

compiler/make_hlds_passes.m:
compiler/prog_io.m:
compiler/prog_item.m:
compiler/prog_mutable.m:
	Accept a `thread_local' attribute for mutables and update the
	source-to-source transformation.

doc/reference_manual.texi:
	Document the `thread_local' attribute as a Melbourne Mercury compiler
	extension.

runtime/mercury_context.c:
runtime/mercury_context.h:
	Add a `thread_local_mutables' field to MR_Context, which points to an
	array which holds all the values of thread-local mutables in the program.
	Each thread-local mutable has an associated index into the array, which
	is allocated during initialisation.  The arrays are copied-on-write.  A
	child thread inherits the parent's thread-locals simply by pointing to
	the same array.

	Add a `thread_local_mutables' field to MR_Spark and update the parallel
	conjunction implementation to take into account thread-locals.
	Note that setting the value of a thread-local mutable inside a parallel
	conjunction is not supported.

runtime/mercury_thread.c:
runtime/mercury_thread.h:
	Add the functions and macros which are used by the code generated for
	thread-local mutables.

runtime/mercury_wrapper.c:
	Allocate a thread-local mutable array for the initial context at
	startup.

extras/concurrency/spawn.m:
	Update the spawn/3 implementation to make child threads inherit the
	thread-local values of the parent.

	Make different threads in high-level C grades use different
	MR_Contexts.  This makes it possible to use the same implementation of
	thread-local mutables as in the low-level C grades.

tests/hard_coded/mutable_decl.exp:
tests/hard_coded/mutable_decl.m:
tests/hard_coded/pure_mutable.exp:
tests/hard_coded/pure_mutable.m:
tests/invalid/bad_mutable.err_exp:
tests/invalid/bad_mutable.m:
	Add some thread-local mutables to these test cases.


PS. extras/concurrency/stream.m now conflicts with library/stream.m


Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.63
diff -u -r1.63 make_hlds_passes.m
--- compiler/make_hlds_passes.m	8 Jan 2007 03:03:10 -0000	1.63
+++ compiler/make_hlds_passes.m	9 Jan 2007 01:40:02 -0000
@@ -474,10 +474,10 @@
         (
             IsConstant = no,
 
-            % Create the mutex initialisation predicate.  This is called
+            % Create the pre-initialisation predicate.  This is called
             % by the mutable initialisation predicate.
-            InitMutexPredDecl = mutable_init_mutex_pred_decl(ModuleName, Name),
-            add_item_decl_pass_1(InitMutexPredDecl, Context, !Status,
+            PreInitPredDecl = mutable_pre_init_pred_decl(ModuleName, Name),
+            add_item_decl_pass_1(PreInitPredDecl, Context, !Status,
                 !ModuleInfo, _, !Specs),
 
             % Create the primitive access and locking predicates.
@@ -1306,6 +1306,7 @@
         DefinedThisModule = yes,
         module_info_get_name(!.ModuleInfo, ModuleName),
         IsConstant = mutable_var_constant(MutAttrs),
+        IsThreadLocal = mutable_var_thread_local(MutAttrs),
 
         % Work out what name to give the global in the target language.
         decide_mutable_target_var_name(!.ModuleInfo, MutAttrs, ModuleName,
@@ -1315,7 +1316,7 @@
         % global variable used to implement the mutable.  If the mutable is
         % not constant then add a mutex to synchronize access to it as well.
         add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant,
-            Context, !QualInfo, !ModuleInfo, !Specs),
+            IsThreadLocal, Context, !QualInfo, !ModuleInfo, !Specs),
 
         % Set up the default attributes for the foreign_procs used for the
         % access predicates.
@@ -1344,15 +1345,17 @@
             IsConstant = no,
             InitSetPredName = mutable_set_pred_sym_name(ModuleName,
                 MercuryMutableName),
+            TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
+                !.ModuleInfo, Type),
             add_mutable_primitive_preds(TargetMutableName, ModuleName,
-                MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, Context,
-                !Status, !QualInfo, !ModuleInfo, !Specs),
+                MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
+                Context, !Status, !QualInfo, !ModuleInfo, !Specs),
             add_mutable_user_access_preds(ModuleName, MercuryMutableName,
                 MutAttrs, Context, !Status, !QualInfo, !ModuleInfo, !Specs)
         ),
-        add_mutable_initialisation(IsConstant, TargetMutableName, ModuleName,
-            MercuryMutableName, MutVarset, InitSetPredName, InitTerm, Attrs,
-            !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+        add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
+            ModuleName, MercuryMutableName, MutVarset, InitSetPredName, InitTerm,
+            Attrs, !Status, Context, !ModuleInfo, !QualInfo, !Specs)
     ;
         DefinedThisModule = no
     ).
@@ -1381,13 +1384,13 @@
     % Add the foreign_decl and foreign_code items that declare/define
     % the global variable used to hold the mutable.
     %
-:- pred add_mutable_defn_and_decl(string::in, mer_type::in, bool::in,
+:- pred add_mutable_defn_and_decl(string::in, mer_type::in, bool::in, bool::in,
     prog_context::in, qual_info::in, qual_info::out,
     module_info::in, module_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant, Context,
-        !QualInfo, !ModuleInfo, !Specs) :-
+add_mutable_defn_and_decl(TargetMutableName, Type, IsConstant, IsThreadLocal,
+        Context, !QualInfo, !ModuleInfo, !Specs) :-
     module_info_get_globals(!.ModuleInfo, Globals),
     globals.get_target(Globals, CompilationTarget),
 
@@ -1397,7 +1400,8 @@
     (
         CompilationTarget = target_c,
         get_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
-            TargetMutableName, IsConstant, ForeignDecl, ForeignDefn),
+            TargetMutableName, IsConstant, IsThreadLocal,
+            ForeignDecl, ForeignDefn),
         ItemStatus0 = item_status(status_local, may_be_unqualified),
         add_item_decl_pass_2(ForeignDecl, Context, ItemStatus0, _,
             !ModuleInfo, !Specs),
@@ -1463,14 +1467,15 @@
     %
 :- pred add_mutable_primitive_preds(string::in, module_name::in, string::in,
     mutable_var_attributes::in, pragma_foreign_proc_attributes::in,
-    mer_inst::in, box_policy::in, prog_context::in,
+    mer_inst::in, box_policy::in, string::in, prog_context::in,
     import_status::in, import_status::out, qual_info::in, qual_info::out,
     module_info::in, module_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
 add_mutable_primitive_preds(TargetMutableName, ModuleName, Name,
-        MutAttrs, Attrs, Inst, BoxPolicy, Context, !Status, !QualInfo,
-        !ModuleInfo, !Specs) :-
+        MutAttrs, Attrs, Inst, BoxPolicy, TypeName, Context,
+        !Status, !QualInfo, !ModuleInfo, !Specs) :-
+    IsThreadLocal = mutable_var_thread_local(MutAttrs),
     set_thread_safe(proc_thread_safe, Attrs, LockAndUnlockAttrs),
 
     % Construct the lock predicate.
@@ -1478,12 +1483,18 @@
     MutableMutexVarName = mutable_mutex_var_name(TargetMutableName),
     % XXX the second argument should be the name of the mercury predicate,
     % with chars escaped as appropriate.
-    LockForeignProcBody = string.append_list([
-        "#ifdef MR_THREAD_SAFE\n",
-        "  MR_LOCK(&" ++ MutableMutexVarName ++ ",
-            \"" ++ MutableMutexVarName ++ "\");\n" ++
-        "#endif\n"
-    ]),
+    (
+        IsThreadLocal = no,
+        LockForeignProcBody = string.append_list([
+            "#ifdef MR_THREAD_SAFE\n",
+            "  MR_LOCK(&" ++ MutableMutexVarName ++ ",
+                \"" ++ MutableMutexVarName ++ "\");\n" ++
+            "#endif\n"
+        ])
+    ;
+        IsThreadLocal = yes,
+        LockForeignProcBody = ""
+    ),
     LockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
         mutable_lock_pred_sym_name(ModuleName, Name),
         predicate,
@@ -1499,12 +1510,18 @@
     % Construct the unlock predicate.
     % XXX as above regarding the second argument to MR_UNLOCK.
 
-    UnlockForeignProcBody = string.append_list([
-        "#ifdef MR_THREAD_SAFE\n",
-        "  MR_UNLOCK(&" ++ MutableMutexVarName ++ ",
-            \"" ++ MutableMutexVarName ++ "\");\n" ++
-        "#endif\n"
-    ]),
+    (
+        IsThreadLocal = no,
+        UnlockForeignProcBody = string.append_list([
+            "#ifdef MR_THREAD_SAFE\n",
+            "  MR_UNLOCK(&" ++ MutableMutexVarName ++ ",
+                \"" ++ MutableMutexVarName ++ "\");\n" ++
+            "#endif\n"
+        ])
+    ;
+        IsThreadLocal = yes,
+        UnlockForeignProcBody = ""
+    ),
     UnlockForeignProc = pragma_foreign_proc(LockAndUnlockAttrs,
         mutable_unlock_pred_sym_name(ModuleName, Name),
         predicate,
@@ -1522,13 +1539,21 @@
     set_purity(purity_semipure, Attrs, UnsafeGetAttrs0),
     set_thread_safe(proc_thread_safe, UnsafeGetAttrs0, UnsafeGetAttrs), 
     varset.new_named_var(varset.init, "X", X, ProgVarSet),
+    (
+        IsThreadLocal = no,
+        UnsafeGetCode = "X = " ++ TargetMutableName ++ ";"
+    ;
+        IsThreadLocal = yes,
+        UnsafeGetCode = "MR_get_thread_local_mutable(" ++
+            TypeName ++ ", X, " ++ TargetMutableName ++ ");"
+    ),
     UnsafeGetForeignProc = pragma_foreign_proc(UnsafeGetAttrs,
         mutable_unsafe_get_pred_sym_name(ModuleName, Name),
         predicate,
         [pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
         ProgVarSet,
         varset.init, % Inst varset.
-        fc_impl_ordinary("X = " ++ TargetMutableName ++ ";", yes(Context))
+        fc_impl_ordinary(UnsafeGetCode, yes(Context))
     ),
     UnsafeGetClause = item_pragma(compiler(mutable_decl),
         UnsafeGetForeignProc),
@@ -1565,14 +1590,21 @@
             TrailCode = ""
         )
     ),
+    (
+        IsThreadLocal = no,
+        SetCode = TargetMutableName ++ "= X;"
+    ;
+        IsThreadLocal = yes,
+        SetCode = "MR_set_thread_local_mutable(" ++
+            TypeName ++ ", X, " ++ TargetMutableName ++ ");"
+    ),
     UnsafeSetForeignProc = pragma_foreign_proc(UnsafeSetAttrs,
         mutable_unsafe_set_pred_sym_name(ModuleName, Name),
         predicate,
         [pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
         ProgVarSet,
         varset.init, % Inst varset.
-        fc_impl_ordinary(TrailCode ++ TargetMutableName ++ "= X;",
-            yes(Context))
+        fc_impl_ordinary(TrailCode ++ SetCode, yes(Context))
     ),
     UnsafeSetClause = item_pragma(compiler(mutable_decl),
         UnsafeSetForeignProc),
@@ -1693,16 +1725,16 @@
 
     % Add the code required to initialise a mutable.
     %
-:- pred add_mutable_initialisation(bool::in, string::in, module_name::in,
-    string::in, prog_varset::in, sym_name::in, prog_term::in,
+:- pred add_mutable_initialisation(bool::in, bool::in, string::in,
+    module_name::in, string::in, prog_varset::in, sym_name::in, prog_term::in,
     pragma_foreign_proc_attributes::in, import_status::in, import_status::out,
     prog_context::in, module_info::in, module_info::out,
     qual_info::in, qual_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-add_mutable_initialisation(IsConstant, TargetMutableName, ModuleName, Name,
-    MutVarset, InitSetPredName, InitTerm, Attrs, !Status, Context,
-    !ModuleInfo, !QualInfo, !Specs) :-
+add_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
+    ModuleName, Name, MutVarset, InitSetPredName, InitTerm, Attrs, !Status,
+    Context, !ModuleInfo, !QualInfo, !Specs) :-
     %
     % Add the `:- initialise' declaration and clause for the
     % mutable initialise predicate.
@@ -1724,35 +1756,43 @@
                 - Context)
     ;
         IsConstant = no,
-        % Construct the clause for the mutex initialisation predicate.
-        InitMutexCode = string.append_list([
-            "#ifdef MR_THREAD_SAFE\n",
-            "   pthread_mutex_init(&",
-                    mutable_mutex_var_name(TargetMutableName),
-                    ", MR_MUTEX_ATTR);\n",
-            "#endif\n"
-        ]),
-        InitMutexPredName = mutable_init_mutex_pred_sym_name(ModuleName,
-            Name),
-        InitMutexForeignProc = pragma_foreign_proc(Attrs,
-            InitMutexPredName,
+        (
+            IsThreadLocal = no,
+            % Construct the clause for the mutex initialisation predicate.
+            PreInitCode = string.append_list([
+                "#ifdef MR_THREAD_SAFE\n",
+                "   pthread_mutex_init(&",
+                        mutable_mutex_var_name(TargetMutableName),
+                        ", MR_MUTEX_ATTR);\n",
+                "#endif\n"
+            ])
+        ;
+            IsThreadLocal = yes,
+            PreInitCode = string.append_list([
+                TargetMutableName,
+                " = MR_new_thread_local_mutable_index();\n"
+            ])
+        ),
+        PreInitPredName = mutable_pre_init_pred_sym_name(ModuleName, Name),
+        PreInitForeignProc = pragma_foreign_proc(Attrs,
+            PreInitPredName,
             predicate,
             [],
             varset.init,    % ProgVarSet
             varset.init,    % InstVarSet
-            fc_impl_ordinary(InitMutexCode, yes(Context))
+            fc_impl_ordinary(PreInitCode, yes(Context))
         ),
-        InitMutexClause = item_pragma(compiler(mutable_decl),
-            InitMutexForeignProc),
-        add_item_clause(InitMutexClause, !Status, Context, !ModuleInfo,
+        PreInitClause = item_pragma(compiler(mutable_decl),
+            PreInitForeignProc),
+        add_item_clause(PreInitClause, !Status, Context, !ModuleInfo,
             !QualInfo, !Specs),
       
-        CallInitMutexExpr =
-            call_expr(InitMutexPredName, [], purity_impure) - Context,
+        CallPreInitExpr =
+            call_expr(PreInitPredName, [], purity_impure) - Context,
         CallSetPredExpr = 
             call_expr(InitSetPredName, [InitTerm], purity_impure)
                 - Context,
-        InitClauseExpr = conj_expr(CallInitMutexExpr, CallSetPredExpr)
+        InitClauseExpr = conj_expr(CallPreInitExpr, CallSetPredExpr)
             - Context,
         %
         % See the comments for prog_io.parse_mutable_decl for the reason
@@ -1774,26 +1814,38 @@
     % or not.
     %
 :- pred get_mutable_global_foreign_decl_defn(module_info::in, mer_type::in,
-    string::in, bool::in, item::out, item::out) is det.
+    string::in, bool::in, bool::in, item::out, item::out) is det.
 
 get_mutable_global_foreign_decl_defn(ModuleInfo, Type, TargetMutableName,
-        IsConstant, Decl, Defn) :-
+        IsConstant, IsThreadLocal, Decl, Defn) :-
     module_info_get_globals(ModuleInfo, Globals),
     globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
     globals.get_target(Globals, Backend),
     (
         Backend = target_c,
-        TypeName = global_foreign_type_name(AlwaysBoxed, lang_c, ModuleInfo,
-            Type),
+        (
+            IsThreadLocal = no,
+            TypeName = global_foreign_type_name(AlwaysBoxed, lang_c,
+                ModuleInfo, Type)
+        ;
+            IsThreadLocal = yes,
+            %
+            % For thread-local mutables, the variable holds an index into an
+            % array.
+            %
+            TypeName = "MR_Unsigned"
+        ),
         %
         % Constant mutables do not require mutexes as their values are never
-        % updated.
+        % updated.  Thread-local mutables do not require mutexes either.
         %
         ( 
-            IsConstant = yes,
+            ( IsConstant = yes
+            ; IsThreadLocal = yes
+            )
+        ->
             LockDecl = []
         ;
-            IsConstant = no,
             LockDecl = [
                 "#ifdef MR_THREAD_SAFE\n",
                 "    extern MercuryLock ",
@@ -1807,10 +1859,12 @@
             pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody)),
         
         (
-            IsConstant = yes,
+            ( IsConstant = yes
+            ; IsThreadLocal = yes
+            )
+        ->
             LockDefn = []
         ;
-            IsConstant = no,
             LockDefn = [
                 "#ifdef MR_THREAD_SAFE\n",
                 "    MercuryLock ",
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.279
diff -u -r1.279 prog_io.m
--- compiler/prog_io.m	6 Jan 2007 09:23:48 -0000	1.279
+++ compiler/prog_io.m	9 Jan 2007 03:08:53 -0000
@@ -1878,7 +1878,8 @@
     --->    mutable_attr_trailed(mutable_trailed)
     ;       mutable_attr_foreign_name(foreign_name)
     ;       mutable_attr_attach_to_io_state(bool)
-    ;       mutable_attr_constant(bool).
+    ;       mutable_attr_constant(bool)
+    ;       mutable_attr_thread_local(bool).
 
 :- pred parse_mutable_attrs(term::in,
     maybe1(mutable_var_attributes)::out) is det.
@@ -1888,17 +1889,20 @@
     ConflictingAttributes = [
         mutable_attr_trailed(mutable_trailed) -
             mutable_attr_trailed(mutable_untrailed),
+        mutable_attr_trailed(mutable_trailed) - mutable_attr_thread_local(yes),
         mutable_attr_constant(yes) - mutable_attr_trailed(mutable_trailed),
-        mutable_attr_constant(yes) - mutable_attr_attach_to_io_state(yes)
+        mutable_attr_constant(yes) - mutable_attr_attach_to_io_state(yes),
+        mutable_attr_constant(yes) - mutable_attr_thread_local(yes)
     ],
     (
         list_term_to_term_list(MutAttrsTerm, MutAttrTerms),
         map_parser(parse_mutable_attr, MutAttrTerms, MaybeAttrList),
         MaybeAttrList = ok1(CollectedMutAttrs)
     ->
-        % We check for trailed/untrailed, constant/trailed and
-        % constant/attach_to_io_state conflicts here and deal with
-        % conflicting foreign_name attributes in make_hlds_passes.m.
+        % We check for trailed/untrailed, constant/trailed,
+        % trailed/thread_local, constant/attach_to_io_state,
+        % constant/thread_local conflicts here and deal with conflicting
+        % foreign_name attributes in make_hlds_passes.m.
         %
         (
             list.member(Conflict1 - Conflict2, ConflictingAttributes),
@@ -1937,6 +1941,8 @@
     ;
         Constant = no
     ).
+process_mutable_attribute(mutable_attr_thread_local(ThrLocal), !Attributes) :-
+    set_mutable_var_thread_local(ThrLocal, !Attributes).
 
 :- pred parse_mutable_attr(term::in,
     maybe1(collected_mutable_attribute)::out) is det.
@@ -1956,6 +1962,9 @@
         ;
             String = "constant",
             MutAttr = mutable_attr_constant(yes)
+        ;
+            String = "thread_local",
+            MutAttr = mutable_attr_thread_local(yes)
         )
     ->
         MutAttrResult = ok1(MutAttr)
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.24
diff -u -r1.24 prog_item.m
--- compiler/prog_item.m	6 Jan 2007 09:23:48 -0000	1.24
+++ compiler/prog_item.m	7 Jan 2007 06:13:33 -0000
@@ -340,6 +340,7 @@
     = maybe(list(foreign_name)).
 :- func mutable_var_constant(mutable_var_attributes) = bool.
 :- func mutable_var_attach_to_io_state(mutable_var_attributes) = bool.
+:- func mutable_var_thread_local(mutable_var_attributes) = bool.
 
 :- pred set_mutable_var_trailed(mutable_trailed::in,
     mutable_var_attributes::in, mutable_var_attributes::out) is det.
@@ -353,6 +354,9 @@
 :- pred set_mutable_var_constant(bool::in,
     mutable_var_attributes::in, mutable_var_attributes::out) is det.
 
+:- pred set_mutable_var_thread_local(bool::in,
+    mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
 %-----------------------------------------------------------------------------%
 %
 % Pragmas
@@ -812,17 +816,19 @@
                 mutable_trailed             :: mutable_trailed,
                 mutable_foreign_names       :: maybe(list(foreign_name)),
                 mutable_attach_to_io_state  :: bool,
-                mutable_constant            :: bool
+                mutable_constant            :: bool,
+                mutable_thread_local        :: bool
             ).
 
 default_mutable_attributes =
-    mutable_var_attributes(mutable_trailed, no, no, no).
+    mutable_var_attributes(mutable_trailed, no, no, no, no).
 
 mutable_var_trailed(MVarAttrs) = MVarAttrs ^ mutable_trailed.
 mutable_var_maybe_foreign_names(MVarAttrs) = MVarAttrs ^ mutable_foreign_names.
 mutable_var_attach_to_io_state(MVarAttrs) =
     MVarAttrs ^ mutable_attach_to_io_state.
 mutable_var_constant(MVarAttrs) = MVarAttrs ^ mutable_constant.
+mutable_var_thread_local(MVarAttrs) = MVarAttrs ^ mutable_thread_local.
 
 set_mutable_var_trailed(Trailed, !Attributes) :-
     !:Attributes = !.Attributes ^ mutable_trailed := Trailed.
@@ -842,6 +848,8 @@
         := AttachToIOState.
 set_mutable_var_constant(Constant, !Attributes) :-
     !:Attributes = !.Attributes ^ mutable_constant := Constant.
+set_mutable_var_thread_local(ThreadLocal, !Attributes) :-
+    !:Attributes = !.Attributes ^ mutable_thread_local := ThreadLocal.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.19
diff -u -r1.19 prog_mutable.m
--- compiler/prog_mutable.m	1 Dec 2006 15:04:17 -0000	1.19
+++ compiler/prog_mutable.m	9 Jan 2007 03:10:21 -0000
@@ -51,12 +51,12 @@
 %   :- impure pred initialise_mutable_<varname> is det.
 %
 %   initialise_mutable_<varname> :-
-%       impure initialise_mutex_for_mutable_<varname>,
+%       impure pre_initialise_mutable_<varname>,
 %       impure set_<varname>(<initval>).
 % 
-%   :- impure pred initialise_mutex_for_mutable_<varname> is det.
+%   :- impure pred pre_initialise_mutable_<varname> is det.
 %   :- pragma foreign_proc("C",
-%       initialise_mutex_for_mutable_<varname>,
+%       pre_initialise_mutable_<varname>,
 %       [will_not_call_mercury],
 %   "
 %       #ifdef MR_THREAD_SAFE
@@ -78,8 +78,8 @@
 %
 %   :- semipure pred unsafe_get_<varname>(<vartype>::out(<varinst>)) is det.
 %   :- pragma foreign_proc("C",
-%       unsafe_get_varname(X::in(<varinst>)),
-%       [promise_semipure, will_not_all_mercury, thread_safe],
+%       unsafe_get_varname(X::out(<varinst>)),
+%       [promise_semipure, will_not_call_mercury, thread_safe],
 %   "
 %        X = mutable_<varname>;
 %   ").   
@@ -124,6 +124,51 @@
 %
 % etc.
 % 
+% For thread-local mutables the transformation is as above, with the following
+% differences:
+%
+%   :- mutable(<varname>, <vartype>, <initvalue>, <varinst>, [thread_local]).
+%
+% ===>
+%
+%   :- pragma foreign_decl("C", "extern MR_Unsigned mutable_<varname>;").
+%   :- pragma foreign_code("C", "MR_Unsigned mutable_<varname>;").
+%
+%   :- pragma foreign_proc("C",
+%       pre_initialise_mutable_<varname>,
+%       [will_not_call_mercury],
+%   "
+%       mutable_<varname> = MR_new_thread_local_mutable_index();
+%   ").
+%
+%   :- pragma foreign_proc("C",
+%       unsafe_set_<varname)(X::in(<varinst>)),
+%       [will_not_call_mercury, thread_safe],
+%   "
+%       MR_set_thread_local_mutable(<type>, X, mutable_<varname>);
+%   ").
+%
+%   :- pragma foreign_proc("C",
+%       unsafe_get_varname(X::out(<varinst>)),
+%       [promise_semipure, will_not_call_mercury, thread_safe],
+%   "
+%        MR_get_thread_local_mutable(<type>, X, mutable_<varname>);
+%   ").   
+%
+%   :- pramga foreign_proc("C",
+%       lock_<varname>,
+%       [will_not_call_mercury, promise_pure],
+%   "
+%       /* blank */
+%   ").
+%
+%   :- pramga foreign_proc("C",
+%       unlock_<varname>,
+%       [will_not_call_mercury, promise_pure],
+%   "
+%       /* blank */
+%   ").
+%
 % For constant mutables the transformation is:
 %
 %   :- mutable(<varname>, <vartype>, <initvalue>, <varinst>, [constant]).
@@ -214,10 +259,12 @@
     %
 :- func mutable_init_pred_decl(module_name, string) = item.
 
-    % Create a predmode declaration for the mutable mutex initialisation
-    % predicate.
+    % Create a predmode declaration for the mutable pre-initialisation
+    % predicate.  For normal mutables this initialises the mutex protecting
+    % the mutable.  For thread-local mutables this allocates an index
+    % into an array of thread-local mutable values.
     %
-:- func mutable_init_mutex_pred_decl(module_name, string) = item.
+:- func mutable_pre_init_pred_decl(module_name, string) = item.
 
     % Names of the primtive operations.
     %
@@ -248,7 +295,7 @@
 
 :- func mutable_init_pred_sym_name(module_name, string) = sym_name.
 
-:- func mutable_init_mutex_pred_sym_name(module_name, string) = sym_name.
+:- func mutable_pre_init_pred_sym_name(module_name, string) = sym_name.
 
 :- func mutable_c_var_name(module_name, string) = string.
 
@@ -431,7 +478,7 @@
         WithType, WithInst, yes(detism_det), Condition,
         purity_impure, Constraints).
 
-mutable_init_mutex_pred_decl(ModuleName, Name) = InitMutexPredDecl :-
+mutable_pre_init_pred_decl(ModuleName, Name) = PreInitPredDecl :-
     VarSet = varset.init,
     InstVarSet = varset.init,
     ExistQVars = [],
@@ -441,9 +488,9 @@
     WithInst = no,
     Condition = cond_true,
     Origin = compiler(mutable_decl),
-    InitMutexPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet,
+    PreInitPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet,
         ExistQVars, predicate,
-        mutable_init_mutex_pred_sym_name(ModuleName, Name),
+        mutable_pre_init_pred_sym_name(ModuleName, Name),
         ArgDecls, WithType, WithInst, yes(detism_det), Condition,
         purity_impure, Constraints).
 
@@ -473,8 +520,8 @@
 mutable_init_pred_sym_name(ModuleName, Name) =
     qualified(ModuleName, "initialise_mutable_" ++ Name).
 
-mutable_init_mutex_pred_sym_name(ModuleName, Name) = 
-    qualified(ModuleName, "initialise_mutex_for_mutable_" ++ Name).
+mutable_pre_init_pred_sym_name(ModuleName, Name) = 
+    qualified(ModuleName, "pre_initialise_mutable_" ++ Name).
 
 mutable_c_var_name(ModuleName, Name) = MangledCVarName :-
     RawCVarName       = "mutable_variable_" ++ Name,
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.377
diff -u -r1.377 reference_manual.texi
--- doc/reference_manual.texi	6 Jan 2007 10:49:04 -0000	1.377
+++ doc/reference_manual.texi	9 Jan 2007 03:12:58 -0000
@@ -4837,6 +4837,19 @@
 It also cannot be specified together with an explicit @samp{trailed}
 attribute.
 
+ at item @samp{thread_local}
+This attribute causes the mutable to behave differently in threaded
+programs.  A thread-local mutable can take on a different value in each
+thread.  When a child thread is spawned, it inherits all the values of
+thread-local mutables of the parent thread.  Changing the value of a
+thread-local mutable does not affect its value in any other threads.
+
+The @samp{thread_local} attribute cannot be specified together with
+either of the @samp{trailed} or @samp{constant} attributes.
+
+ at c Note: don't set thread-local mutables in parallel conjunctions, as
+ at c the behaviour will be unpredictable.
+
 @end table
 
 The Melbourne Mercury compiler also supports the following attribute.
Index: extras/concurrency/spawn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/concurrency/spawn.m,v
retrieving revision 1.17
diff -u -r1.17 spawn.m
--- extras/concurrency/spawn.m	2 Oct 2006 10:14:39 -0000	1.17
+++ extras/concurrency/spawn.m	10 Jan 2007 02:22:16 -0000
@@ -66,6 +66,7 @@
         /* Store the closure on the top of the new context's stack. */
     *(ctxt->MR_ctxt_sp) = Goal;
     ctxt->MR_ctxt_next = NULL;
+    ctxt->MR_ctxt_thread_local_mutables = MR_THREAD_LOCAL_MUTABLES;
     MR_schedule_context(ctxt);
     if (0) {
 spawn_call_back_to_mercury_cc_multi:
@@ -77,7 +78,7 @@
         MR_runnext();
     }
 #else
-    ME_create_thread(ME_thread_wrapper, (void *) Goal);
+    ME_create_thread(Goal);
 #endif
     IO = IO0;
 ").
@@ -127,18 +128,34 @@
 #ifdef MR_HIGHLEVEL_CODE
   #include  <pthread.h>
 
-  int ME_create_thread(void *(*func)(void *), void *arg);
+  int ME_create_thread(MR_Word goal);
   void *ME_thread_wrapper(void *arg);
+
+  typedef struct ME_ThreadWrapperArgs ME_ThreadWrapperArgs;
+  struct ME_ThreadWrapperArgs {
+        MR_Word     goal;
+        MR_Word     *thread_local_mutables;
+  };
 #endif
 ").
 
 :- pragma foreign_code("C", "
 #ifdef MR_HIGHLEVEL_CODE
-  int ME_create_thread(void *(*func)(void *), void *arg)
+  int ME_create_thread(MR_Word goal)
   {
-    pthread_t   thread;
+    ME_ThreadWrapperArgs    *args;
+    pthread_t               thread;
 
-    if (pthread_create(&thread, MR_THREAD_ATTR, func, arg)) {
+    /*
+    ** We can't allocate `args' on the stack because this function may return
+    ** before the child thread has got all the information it needs out of the
+    ** structure.
+    */
+    args = MR_malloc(sizeof(ME_ThreadWrapperArgs));
+    args->goal = goal;
+    args->thread_local_mutables = MR_THREAD_LOCAL_MUTABLES;
+
+    if (pthread_create(&thread, MR_THREAD_ATTR, ME_thread_wrapper, args)) {
         MR_fatal_error(""Unable to create thread."");
     }
 
@@ -152,7 +169,20 @@
 
   void *ME_thread_wrapper(void *arg)
   {
-    call_back_to_mercury_cc_multi((MR_Word) arg);
+    ME_ThreadWrapperArgs    *args = arg;
+    MR_Word                 goal;
+
+    if (MR_init_thread(MR_use_now) == MR_FALSE) {
+        MR_fatal_error(""Unable to init thread."");
+    }
+
+    assert(MR_THREAD_LOCAL_MUTABLES == NULL);
+    MR_SET_THREAD_LOCAL_MUTABLES(args->thread_local_mutables);
+
+    goal = args->goal;
+    MR_free(args);
+
+    call_back_to_mercury_cc_multi(goal);
 
     return NULL;
   }
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_context.c,v
retrieving revision 1.53
diff -u -r1.53 mercury_context.c
--- runtime/mercury_context.c	3 Jan 2007 05:17:16 -0000	1.53
+++ runtime/mercury_context.c	10 Jan 2007 02:15:44 -0000
@@ -263,6 +263,9 @@
     c->MR_ctxt_call_depth = 0;
     c->MR_ctxt_event_number = 0;
 #endif
+
+    /* The caller is responsible for initialising this field. */
+    c->MR_ctxt_thread_local_mutables = NULL;
 }
 
 MR_Context *
@@ -585,6 +588,7 @@
         MR_load_context(MR_ENGINE(MR_eng_this_context));
     }
     MR_parent_sp = spark->MR_spark_parent_sp;
+    MR_SET_THREAD_LOCAL_MUTABLES(spark->MR_spark_thread_local_mutables);
     MR_GOTO(spark->MR_spark_resume);
 }
 #else /* !MR_THREAD_SAFE */
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_context.h,v
retrieving revision 1.38
diff -u -r1.38 mercury_context.h
--- runtime/mercury_context.h	3 Jan 2007 05:17:16 -0000	1.38
+++ runtime/mercury_context.h	10 Jan 2007 02:08:14 -0000
@@ -127,6 +127,9 @@
 ** min_hp_rec       This pointer marks the minimum value of MR_hp to which
 **                  we can truncate the heap on backtracking. See comments
 **                  before the macro MR_set_min_heap_reclamation_point below.
+**
+** thread_local_mutables
+**                  The array of thread-local mutable values for this context.
 */
 
 typedef struct MR_Context_Struct        MR_Context;
@@ -201,6 +204,8 @@
     MR_Unsigned         MR_ctxt_call_depth;
     MR_Unsigned         MR_ctxt_event_number;
 #endif
+
+    MR_Word             *MR_ctxt_thread_local_mutables;
 };
 
 /*
@@ -224,6 +229,7 @@
     MR_Spark            *MR_spark_next;
     MR_Code             *MR_spark_resume;
     MR_Word             *MR_spark_parent_sp;
+    MR_Word             *MR_spark_thread_local_mutables;
 };
 #endif
 
@@ -318,6 +324,7 @@
 /*
 ** Allocates and initializes a new context structure, and gives it the given
 ** id. If gen is non-NULL, the context is for the given generator.
+** The `MR_ctxt_thread_local_mutables' member must be initialised separately.
 */
 extern  MR_Context  *MR_create_context(const char *id,
                         MR_ContextSize ctxt_size, MR_Generator *gen);
@@ -388,6 +395,7 @@
         fnc_spark = MR_GC_NEW(MR_Spark);                        \
         fnc_spark->MR_spark_resume = (child);                   \
         fnc_spark->MR_spark_parent_sp = MR_parent_sp;           \
+        fnc_spark->MR_spark_thread_local_mutables = MR_THREAD_LOCAL_MUTABLES; \
         if (MR_fork_globally_criteria) {                        \
             MR_schedule_spark_globally(fnc_spark);              \
         } else {                                                \
Index: runtime/mercury_thread.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_thread.c,v
retrieving revision 1.28
diff -u -r1.28 mercury_thread.c
--- runtime/mercury_thread.c	3 Oct 2006 11:41:46 -0000	1.28
+++ runtime/mercury_thread.c	10 Jan 2007 02:07:24 -0000
@@ -32,6 +32,8 @@
 MR_bool             MR_exit_now;
 MR_bool             MR_debug_threads = MR_FALSE;
 
+MR_Unsigned         MR_num_thread_local_mutables = 0;
+
 #ifdef MR_THREAD_SAFE
 
 static void         *MR_create_thread_2(void *goal);
@@ -212,4 +214,13 @@
     assert(err == 0);
 }
 
-#endif
+#endif  /* MR_THREAD_SAFE */
+
+MR_Unsigned
+MR_new_thread_local_mutable_index(void)
+{
+    if (MR_num_thread_local_mutables >= MR_MAX_THREAD_LOCAL_MUTABLES-1) {
+        MR_fatal_error("too many thread-local mutables");
+    }
+    return MR_num_thread_local_mutables++;
+}
Index: runtime/mercury_thread.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_thread.h,v
retrieving revision 1.19
diff -u -r1.19 mercury_thread.h
--- runtime/mercury_thread.h	5 Jul 2006 03:00:43 -0000	1.19
+++ runtime/mercury_thread.h	10 Jan 2007 01:59:18 -0000
@@ -199,4 +199,46 @@
 
 extern	void    MR_finalize_thread_engine(void);
 
-#endif
+/*
+** The values of thread-local mutables are stored in an array per Mercury
+** thread.  This makes it easy for a newly spawned thread to inherit all the
+** thread-local mutables of its parent thread.  The arrays are copied-on-write,
+** but copy-on-spawn would also work.
+**
+** Each thread-local mutable has an associated index into the array, which is
+** allocated to it during initialisation.  For ease of implementation there is
+** an arbitrary limit to the number of thread-local mutables that are allowed.
+*/
+#define MR_MAX_THREAD_LOCAL_MUTABLES    128
+extern MR_Unsigned  MR_num_thread_local_mutables;
+
+/*
+** Allocate an index into the thread-local mutable array for a mutable.
+*/
+extern MR_Unsigned  MR_new_thread_local_mutable_index(void);
+
+#define MR_THREAD_LOCAL_MUTABLES                                         \
+    (MR_ENGINE(MR_eng_this_context)->MR_ctxt_thread_local_mutables)
+
+#define MR_SET_THREAD_LOCAL_MUTABLES(mut_array)                          \
+    (MR_THREAD_LOCAL_MUTABLES = mut_array)
+
+#define MR_get_thread_local_mutable(type, var, mut_index)                \
+    (var = *((type *) &MR_THREAD_LOCAL_MUTABLES[mut_index]))
+
+#define MR_set_thread_local_mutable(type, var, mut_index)                \
+    do {                                                                 \
+        MR_Word     *old_table;                                          \
+        MR_Word     *new_table;                                          \
+        MR_Unsigned i;                                                   \
+                                                                         \
+        old_table = MR_THREAD_LOCAL_MUTABLES;                            \
+        new_table = MR_NEW_ARRAY(MR_Word, MR_num_thread_local_mutables); \
+        for (i = 0; i < MR_num_thread_local_mutables; i++) {             \
+            new_table[i] = old_table[i];                                 \
+        }                                                                \
+        *((type *) &new_table[mut_index]) = var;                         \
+        MR_SET_THREAD_LOCAL_MUTABLES(new_table);                         \
+    } while (0)                                                          \
+
+#endif	/* MERCURY_THREAD_H */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.177
diff -u -r1.177 mercury_wrapper.c
--- runtime/mercury_wrapper.c	3 Jan 2007 05:17:18 -0000	1.177
+++ runtime/mercury_wrapper.c	10 Jan 2007 02:14:36 -0000
@@ -584,13 +584,17 @@
     MR_ticket_high_water = 1;
   #endif
 #else
-    /* start up the Mercury engine */
-  #ifndef MR_THREAD_SAFE
+    /* 
+    ** Start up the Mercury engine.  We don't yet know how many slots will be
+    ** needed for thread-local mutable values so allocate the maximum number.
+    */
     MR_init_thread(MR_use_now);
-  #else
+    MR_SET_THREAD_LOCAL_MUTABLES(
+        MR_NEW_ARRAY(MR_Word, MR_MAX_THREAD_LOCAL_MUTABLES));
+
+  #ifdef MR_THREAD_SAFE
     {
         int i;
-        MR_init_thread(MR_use_now);
         MR_exit_now = MR_FALSE;
         for (i = 1 ; i < MR_num_threads ; i++) {
             MR_create_thread(NULL);
@@ -600,7 +604,7 @@
         }
     }
   #endif /* ! MR_THREAD_SAFE */
-#endif /* ! MR_HIGHLEVEL_CODE */
+#endif /* ! 0 */
 
     if (MR_memdebug) {
         MR_debug_memory(stderr);
Index: tests/hard_coded/mutable_decl.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/mutable_decl.exp,v
retrieving revision 1.1
diff -u -r1.1 mutable_decl.exp
--- tests/hard_coded/mutable_decl.exp	5 Sep 2005 02:29:59 -0000	1.1
+++ tests/hard_coded/mutable_decl.exp	9 Jan 2007 02:59:10 -0000
@@ -1,3 +1,4 @@
 0, 1, 2
 0
 5
+5
Index: tests/hard_coded/mutable_decl.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/mutable_decl.m,v
retrieving revision 1.2
diff -u -r1.2 mutable_decl.m
--- tests/hard_coded/mutable_decl.m	14 Aug 2006 09:09:21 -0000	1.2
+++ tests/hard_coded/mutable_decl.m	9 Jan 2007 02:59:57 -0000
@@ -31,6 +31,8 @@
 
 :- mutable(y, int, 0, ground, [untrailed]).
 
+:- mutable(z, int, 0, ground, [untrailed, thread_local]).
+
 main(!IO) :-
     semipure get_x(X0), impure set_x(X0 + 1),
     semipure get_x(X1), impure set_x(X1 + 1),
@@ -43,13 +45,15 @@
       else true
     ),
     semipure get_x(X), io.write_int(X, !IO), io.nl(!IO),
-    semipure get_y(Y), io.write_int(Y, !IO), io.nl(!IO).
+    semipure get_y(Y), io.write_int(Y, !IO), io.nl(!IO),
+    semipure get_z(Z), io.write_int(Z, !IO), io.nl(!IO).
 
 :- impure pred my_member(int::in, list(int)::in) is nondet.
 
 my_member(A, [B | Bs]) :-
     semipure get_x(X), impure set_x(X + 1),
     semipure get_y(Y), impure set_y(Y + 1),
+    semipure get_z(Z), impure set_z(Z + 1),
     (
         A = B
     ;
Index: tests/hard_coded/pure_mutable.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/pure_mutable.exp,v
retrieving revision 1.2
diff -u -r1.2 pure_mutable.exp
--- tests/hard_coded/pure_mutable.exp	27 Apr 2006 07:34:37 -0000	1.2
+++ tests/hard_coded/pure_mutable.exp	9 Jan 2007 02:55:16 -0000
@@ -1,3 +1,5 @@
 Initial value of global = 561
 Final value of global = 562
 Value of const = 562
+Initial value of thrlocal = 563
+Final value of thrlocal = 564
Index: tests/hard_coded/pure_mutable.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/pure_mutable.m,v
retrieving revision 1.3
diff -u -r1.3 pure_mutable.m
--- tests/hard_coded/pure_mutable.m	14 Aug 2006 09:09:21 -0000	1.3
+++ tests/hard_coded/pure_mutable.m	9 Jan 2007 02:56:46 -0000
@@ -17,6 +17,9 @@
 
 :- mutable(const, int, 562, ground, [constant]).
 
+:- mutable(thrlocal, int, 563, ground,
+	[untrailed, attach_to_io_state, thread_local]).
+
 main(!IO) :-
 	get_global(X0, !IO),
 	io.format("Initial value of global = %d\n", [i(X0)], !IO),
@@ -25,4 +28,11 @@
 	io.format("Final value of global = %d\n", [i(X)], !IO),
 
 	get_const(C),
-	io.format("Value of const = %d\n", [i(C)], !IO).
+	io.format("Value of const = %d\n", [i(C)], !IO),
+
+	get_thrlocal(Y0, !IO),
+	io.format("Initial value of thrlocal = %d\n", [i(Y0)], !IO),
+	set_thrlocal(Y0 + 1, !IO),
+	get_thrlocal(Y, !IO),
+	io.format("Final value of thrlocal = %d\n", [i(Y)], !IO).
+
Index: tests/invalid/bad_mutable.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/bad_mutable.err_exp,v
retrieving revision 1.7
diff -u -r1.7 bad_mutable.err_exp
--- tests/invalid/bad_mutable.err_exp	4 Oct 2006 06:37:00 -0000	1.7
+++ tests/invalid/bad_mutable.err_exp	9 Jan 2007 13:24:03 -0000
@@ -1,6 +1,8 @@
 bad_mutable.m:015: Error: malformed attribute list in mutable declaration: [untrailed, bad_attrib].
 bad_mutable.m:017: Error: the type in a mutable declaration cannot contain variables: list(_1).
 bad_mutable.m:019: Error: conflicting attributes in attribute list: [untrailed, trailed].
+bad_mutable.m:024: Error: conflicting attributes in attribute list: [thread_local, trailed].
+bad_mutable.m:026: Error: conflicting attributes in attribute list: [thread_local, constant].
 bad_mutable.m:011: In declaration for mutable `not_a_type':
 bad_mutable.m:011:   error: undefined type `no_type'/0.
 bad_mutable.m:013: In declaration for mutable `not_an_inst':
Index: tests/invalid/bad_mutable.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/bad_mutable.m,v
retrieving revision 1.5
diff -u -r1.5 bad_mutable.m
--- tests/invalid/bad_mutable.m	15 Aug 2006 04:04:48 -0000	1.5
+++ tests/invalid/bad_mutable.m	9 Jan 2007 02:51:20 -0000
@@ -20,3 +20,8 @@
 
 :- mutable(multiple_foreign, int, 0, ground,
 	[untrailed, foreign_name("C", "one"), foreign_name("C", "two")]).
+
+:- mutable(conflicting_thr_local1, int, 0, ground, [thread_local, trailed]).
+
+:- mutable(conflicting_thr_local2, int, 0, ground, [thread_local, constant]).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list