*** empty log message ***
authorwenzelm
Sun Sep 07 17:46:44 2008 +0200 (2008-09-07)
changeset 28152c1277547d59f
parent 28151 61f9c918b410
child 28153 67147cc3f967
*** empty log message ***
src/Pure/ML-Systems/polyml-5.1.ML
src/Pure/ML-Systems/polyml.ML
src/Pure/ML-Systems/thread_dummy.ML
     1.1 --- a/src/Pure/ML-Systems/polyml-5.1.ML	Sun Sep 07 17:46:43 2008 +0200
     1.2 +++ b/src/Pure/ML-Systems/polyml-5.1.ML	Sun Sep 07 17:46:44 2008 +0200
     1.3 @@ -4,12 +4,9 @@
     1.4  Compatibility wrapper for Poly/ML 5.1.
     1.5  *)
     1.6  
     1.7 -structure PolyML_Thread = Thread;
     1.8 +open Thread;
     1.9  use "ML-Systems/polyml_common.ML";
    1.10 -
    1.11 -open PolyML_Thread;
    1.12  use "ML-Systems/multithreading_polyml.ML";
    1.13 -
    1.14  use "ML-Systems/polyml_old_compiler5.ML";
    1.15  
    1.16  val pointer_eq = PolyML.pointerEq;
     2.1 --- a/src/Pure/ML-Systems/polyml.ML	Sun Sep 07 17:46:43 2008 +0200
     2.2 +++ b/src/Pure/ML-Systems/polyml.ML	Sun Sep 07 17:46:44 2008 +0200
     2.3 @@ -4,10 +4,8 @@
     2.4  Compatibility wrapper for Poly/ML (after 5.1).
     2.5  *)
     2.6  
     2.7 -structure PolyML_Thread = Thread;
     2.8 +open Thread;
     2.9  use "ML-Systems/polyml_common.ML";
    2.10 -
    2.11 -open PolyML_Thread;
    2.12  use "ML-Systems/multithreading_polyml.ML";
    2.13  
    2.14  val pointer_eq = PolyML.pointerEq;
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/Pure/ML-Systems/thread_dummy.ML	Sun Sep 07 17:46:44 2008 +0200
     3.3 @@ -0,0 +1,82 @@
     3.4 +(*  Title:      Pure/ML-Systems/thread_dummy.ML
     3.5 +    ID:         $Id$
     3.6 +    Author:     Makarius
     3.7 +
     3.8 +Default (mostly dummy) implementation of thread structures
     3.9 +(cf. polyml/basis/Thread.sml).
    3.10 +*)
    3.11 +
    3.12 +exception Thread of string;
    3.13 +
    3.14 +local fun fail _ = raise Thread "No multithreading support on this ML platform" in
    3.15 +
    3.16 +structure Mutex =
    3.17 +struct
    3.18 +  type mutex = unit;
    3.19 +  fun mutex _ = ();
    3.20 +  fun lock _ = fail ();
    3.21 +  fun unlock _ = fail ();
    3.22 +  fun trylock _ = fail ();
    3.23 +end;
    3.24 +
    3.25 +structure ConditionVar =
    3.26 +struct
    3.27 +  type conditionVar = unit;
    3.28 +  fun conditionVar _ = ();
    3.29 +  fun wait _ = fail ();
    3.30 +  fun waitUntil _ = fail ();
    3.31 +  fun signal _ = fail ();
    3.32 +  fun broadcast _ = fail ();
    3.33 +end;
    3.34 +
    3.35 +structure Thread =
    3.36 +struct
    3.37 +  type thread = unit;
    3.38 +
    3.39 +  datatype threadAttribute = EnableBroadcastInterrupt of bool | InterruptState of interruptState
    3.40 +    and interruptState = InterruptDefer | InterruptSynch | InterruptAsynch | InterruptAsynchOnce;
    3.41 +
    3.42 +  fun fork _ = fail ();
    3.43 +  fun exit _ = fail ();
    3.44 +  fun isActive _ = fail ();
    3.45 +
    3.46 +  fun equal _ = fail ();
    3.47 +  fun self _ = fail ();
    3.48 +
    3.49 +  fun interrupt _ = fail ();
    3.50 +  fun broadcastInterrupt _ = fail ();
    3.51 +  fun testInterrupt _ = fail ();
    3.52 +
    3.53 +  fun kill _ = fail ();
    3.54 +
    3.55 +  fun setAttributes _ = fail ();
    3.56 +  fun getAttributes _ = fail ();
    3.57 +
    3.58 +  fun numProcessors _ = fail ();
    3.59 +
    3.60 +
    3.61 +(* thread data *)
    3.62 +
    3.63 +local
    3.64 +
    3.65 +val data = ref ([]: Universal.universal ref list);
    3.66 +
    3.67 +fun find_data tag =
    3.68 +  let
    3.69 +    fun find (r :: rs) = if Universal.tagIs tag (! r) then SOME r else find rs
    3.70 +      | find [] = NONE;
    3.71 +  in find (! data) end;
    3.72 +
    3.73 +in
    3.74 +
    3.75 +fun getLocal tag = Option.map (Universal.tagProject tag o !) (find_data tag);
    3.76 +
    3.77 +fun setLocal (tag, x) =
    3.78 +  (case find_data tag of
    3.79 +    SOME r => r := Universal.tagInject tag x
    3.80 +  | NONE => data := ref (Universal.tagInject tag x) :: ! data);
    3.81 +
    3.82 +end;
    3.83 +end;
    3.84 +end;
    3.85 +