Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cml/src/core-cml/thread.sml
ViewVC logotype

Diff of /sml/trunk/src/cml/src/core-cml/thread.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1324, Tue May 13 01:54:42 2003 UTC revision 1325, Tue May 13 01:56:02 2003 UTC
# Line 40  Line 40 
40                  alert = ref false,                  alert = ref false,
41                  done_comm = ref false,                  done_comm = ref false,
42                  exnHandler = ref(! defaultExnHandler),                  exnHandler = ref(! defaultExnHandler),
43                    props = ref[],
44                  dead = cvar()                  dead = cvar()
45                }                }
46            end            end
# Line 92  Line 93 
93    
94      val getTid = S.getCurThread      val getTid = S.getCurThread
95    
96      fun exit () = notifyAndDispatch(getTid())      fun exit () = let
97              val (tid as TID{props, ...}) = getTid()
98              in
99                props := [];
100                notifyAndDispatch tid
101              end
102    
103      fun yield () = SMLofNJ.Cont.callcc (fn k => (      fun yield () = SMLofNJ.Cont.callcc (fn k => (
104            S.atomicBegin();            S.atomicBegin();
105            S.atomicYield k))            S.atomicYield k))
106    
107      (* thread-local data *)
108        local
109          fun mkProp () = let
110                exception E of 'a
111                fun cons (a, l) = E a :: l
112                fun peek [] = NONE
113                  | peek (E a :: _) = SOME a
114                  | peek (_ :: l) = peek l
115                fun delete [] = []
116                  | delete (E a :: r) = r
117                  | delete (x :: r) = x :: delete r
118                in
119                  { cons = cons, peek = peek, delete = delete }
120                end
121          fun mkFlag () = let
122                exception E
123                fun peek [] = false
124                  | peek (E :: _) = true
125                  | peek (_ :: l) = peek l
126                fun set (l, flg) = let
127                      fun set ([], _) = if flg then E::l else l
128                        | set (E::r, xs) = if flg then l else List.revAppend(xs, r)
129                        | set (x::r, xs) = set (r, x::xs)
130                      in
131                        set (l, [])
132                      end
133                in
134                  { set = set, peek = peek }
135                end
136          fun getProps () = let val TID{props, ...} = getTid() in props end
137        in
138        fun newThreadProp (init : unit -> 'b) = let
139              val {peek, cons, delete} = mkProp()
140              fun peekFn () = peek(!(getProps()))
141              fun getF () = let
142                    val h = getProps()
143                    in
144                      case peek(!h)
145                       of NONE => let val b = init() in h := cons(b, !h); b end
146                        | (SOME b) => b
147                      (* end case *)
148                    end
149              fun clrF () = let
150                    val h = getProps()
151                    in
152                      h := delete(!h)
153                    end
154              fun setFn x = let
155                    val h = getProps()
156                    in
157                      h := cons(x, delete(!h))
158                    end
159              in
160                {peekFn = peekFn, getFn = getF, clrFn = clrF, setFn = setFn}
161              end
162    
163        fun newThreadFlag () = let
164              val {peek, set} = mkFlag()
165              fun getF ()= peek(!(getProps()))
166              fun setF flg = let
167                    val h = getProps()
168                    in
169                      h := set(!h, flg)
170                    end
171              in
172                {getFn = getF, setFn = setF}
173              end
174        end (* local *)
175    
176    end;    end;

Legend:
Removed from v.1324  
changed lines
  Added in v.1325

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0