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/branches/SMLNJ/src/cml/src/core-cml/scheduler.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/cml/src/core-cml/scheduler.sml

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

revision 7, Sun Jan 18 00:59:30 1998 UTC revision 8, Sun Jan 18 01:01:29 1998 UTC
# Line 20  Line 20 
20      val enqueueThread : (thread_id * unit cont) -> unit      val enqueueThread : (thread_id * unit cont) -> unit
21    
22      val enqueueAndSwitchCurThread : (unit cont * thread_id) -> unit      val enqueueAndSwitchCurThread : (unit cont * thread_id) -> unit
23          (* enqueue the current thread, and make the given thread ID be          (* enqueue the given continuation with the current thread ID, and make
24           * the current one.           * the given thread ID be the current one.
25           *)           *)
26    
27      val enqueueTmpThread : (unit -> unit) -> unit      val enqueueTmpThread : (unit -> unit) -> unit
# Line 46  Line 46 
46           * an atomic region.  Use atomicDispatch() for that case.           * an atomic region.  Use atomicDispatch() for that case.
47           *)           *)
48    
     val atomicThrow : ('a cont * 'a) -> 'b  
   
49      val atomicSwitchTo : (thread_id * 'a cont * 'a) -> unit      val atomicSwitchTo : (thread_id * 'a cont * 'a) -> unit
50          (* switch to the given thread, while leaving the atomic region *)          (* switch to the given thread, while leaving the atomic region *)
51    
# Line 59  Line 57 
57      val schedulerHook : unit cont ref      val schedulerHook : unit cont ref
58          (* this hook points to a continuation that gets dispatched when          (* this hook points to a continuation that gets dispatched when
59           * a preemption is received, or when a thread exits an atomic           * a preemption is received, or when a thread exits an atomic
60           * region and there is a signal pending.           * region and there is a signal pending.  It is invoked after
61             * leaving the atomic region.
62           *)           *)
63    
64      val pauseHook : unit cont ref      val pauseHook : unit cont ref
# Line 108  Line 107 
107    (* The scheduler defines three continuation "hooks":    (* The scheduler defines three continuation "hooks":
108     *   schedulerHook    -- this points to a continuation that gets dispatched     *   schedulerHook    -- this points to a continuation that gets dispatched
109     *                       when a thread attempts to exit an atomic region and     *                       when a thread attempts to exit an atomic region and
110     *                       there is a signal pending.     *                       there is a signal pending.  It is invoked after
111       *                       leaving the atomic region.
112     *   pauseHook        -- this points to a continuation that gets invoked when     *   pauseHook        -- this points to a continuation that gets invoked when
113     *                       there is nothing else to do.     *                       there is nothing else to do.
114     *   shutdownHook     -- this points to a continuation that gets invoked when     *   shutdownHook     -- this points to a continuation that gets invoked when
# Line 196  Line 196 
196              | NONE => ()              | NONE => ()
197            (* end case *))            (* end case *))
198    
   (* preempt the current thread (with continuation k). *)  
     fun preempt k = let  
           val curTid = getCurThread()  
           val curP = (curTid, k)  
           in  
             if (isMarked curTid)  
               then (  
                 unmarkTid curTid;  
                 promote ();  
                 enqueue curP)  
               else Q.enqueue(rdyQ2, curP)  
           end  
   
199    (* global flag for implementing atomic operations *)    (* global flag for implementing atomic operations *)
200      datatype atomic_state = NonAtomic | Atomic | SignalPending      datatype atomic_state = NonAtomic | Atomic | SignalPending
201      val atomicState = ref NonAtomic      val atomicState = ref NonAtomic
202    
203      fun dispatchHook () = (    (* Note, the first thing the scheduler hook does is a atomicBegin, so we don't
204            atomicState := NonAtomic;     * need to clear the atomic state here.
205            throw (!schedulerHook) ())     *)
206        fun dispatchSchedulerHook () = throw (!schedulerHook) ()
207    
208    (*
209        fun enqueueSchedulerHook () =  let
210              val kont = callcc (fn k => (
211                    callcc (fn k' => throw k k');
212                    dispatchSchedulerHook ()))
213              val R.Q{front, ...} = rdyQ1
214              in
215                front := (dummyTid, kont) :: !front
216              end
217    *)
218    
219      fun atomicBegin () = atomicState := Atomic      fun atomicBegin () = atomicState := Atomic
220    
# Line 227  Line 226 
226     *)     *)
227      fun atomicEnd () = (case !atomicState      fun atomicEnd () = (case !atomicState
228             of SignalPending => callcc (fn k => (             of SignalPending => callcc (fn k => (
229                  preempt k;                  enqueue(getCurThread(), k);
230                  dispatchHook()))                  dispatchSchedulerHook()))
231              | _ => atomicState := NonAtomic              | _ => atomicState := NonAtomic
232            (* end case *))            (* end case *))
233    
234      fun atomicDispatch () = let      fun atomicDispatch () = (case !atomicState
235            val _ = (case !atomicState             of SignalPending => dispatchSchedulerHook()
236                   of SignalPending => dispatchHook()              | _ => let
                   | _ => ()  
                 (* end case *))  
237            val (id, kont) = dequeue1()            val (id, kont) = dequeue1()
238            in            in
239              setCurThread id;              setCurThread id;
240              atomicState := NonAtomic;              atomicState := NonAtomic;
241              throw kont ()              throw kont ()
242            end            end
243              (* end case *))
244    
245      fun dispatch () = (atomicBegin(); atomicDispatch ())      fun dispatch () = (atomicBegin(); atomicDispatch ())
246    
247      fun atomicThrow (k, x) = (      fun atomicSwitchTo (tid, k, x) =
248              callcc (fn curK => (
249            case !atomicState            case !atomicState
250             of SignalPending => dispatchHook()               of SignalPending =>
251              | _ => ()                    callcc (fn k' => (
252            (* end case *);                      enqueue(tid, k');
253            throw k x)                      enqueue(getCurThread(), curK);
254                        dispatchSchedulerHook()))
255      fun atomicSwitchTo (tid, k, x) = callcc (fn curK => (                | _ => (
256            enqueueAndSwitchCurThread (curK, tid);            enqueueAndSwitchCurThread (curK, tid);
257            atomicThrow (k, x)))                    atomicState := NonAtomic)
258                (* end case *);
259                throw k x))
260    
261    (* Yield control to the next thread, while leaving the atomic region. *)    (* Yield control to the next thread, while leaving the atomic region. *)
262      fun atomicYield k = (      fun atomicYield k = (
# Line 267  Line 268 
268     * of the scheduling queue.     * of the scheduling queue.
269     *)     *)
270      fun enqueueTmpThread f = let      fun enqueueTmpThread f = let
271  (** this should be, but the overhead is too hi right now. **  (** this should be, but the overhead is too high right now. **
272            val kont = SMLofNJ.Cont.isolate f            val kont = SMLofNJ.Cont.isolate f
273  **)  **)
274            val kont = callcc (fn k => (            val kont = callcc (fn k => (
# Line 297  Line 298 
298              | (SOME t) => t              | (SOME t) => t
299            (* end case *))            (* end case *))
300    
301      structure IT = SMLofNJ.IntervalTimer    (* preempt the current thread (with continuation k). *)
302        fun preempt k = let
303              val curTid = getCurThread()
304              val curP = (curTid, k)
305              in
306                if (isMarked curTid)
307                  then (
308                    unmarkTid curTid;
309                    promote ();
310                    enqueue curP)
311                  else Q.enqueue(rdyQ2, curP)
312              end
313    
314    (* the preemption handler *)    (* the preemption handler *)
315      fun alrmHandler (_, _, k) = (      fun alrmHandler (_, _, k) = (
# Line 311  Line 323 
323      val defaultTimeQ = Time.fromMilliseconds 20      val defaultTimeQ = Time.fromMilliseconds 20
324      val timeQ = ref defaultTimeQ      val timeQ = ref defaultTimeQ
325    
326        structure IT = SMLofNJ.IntervalTimer
327    
328      fun startTimer tq = let      fun startTimer tq = let
329            val tq = if Time.<(Time.zeroTime, tq) then tq else defaultTimeQ            val tq = if Time.<(Time.zeroTime, tq) then tq else defaultTimeQ
330            in            in

Legend:
Removed from v.7  
changed lines
  Added in v.8

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