Tcl Library Source Code

Check-in [9d43ec95cf]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Removed the special case for coroutine sleeps
Timelines: family | ancestors | descendants | both | odie
Files: files | file ages | folders
SHA1: 9d43ec95cf47403fdda7a6ab69ed493ddec27a36
User & Date: tne 2016-07-20 23:25:59
Context
2016-07-21
20:47
Checking in a new version of Cron. This one does a much more comprehensive job of managing objects and coroutines check-in: 1d00b41109 user: tne tags: odie
2016-07-20
23:25
Removed the special case for coroutine sleeps check-in: 9d43ec95cf user: tne tags: odie
21:47
Moved the cluster::sleep function to the cron module Added a coroutine aware function called "sleep" to the cron system. This allows either a routine or coroutine to sleep in a multi-tasking friendly way. check-in: bc65bd4004 user: tne tags: odie
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/cron/cron.tcl.

87
88
89
90
91
92
93




94
95

96
97
98
99
100
101
102
103
104


105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
  lappend all_coroutines $coroutine
  lappend object_coroutines($objname) $coroutine
  set coroutine_object($coroutine) $objname
  return 0
}

proc ::cron::sleep_handle {ms} {




  set eventid [incr ::cron::eventcount]
  set var ::cron::event($eventid)

  set ${var} [expr {[clock milliseconds]+$ms}]
  return $var
}


proc ::cron::sleep ms {
  set coro [info coroutine]
  if {$coro eq {}} {
    set handle [sleep_handle $ms]


    ::cron::wake CRON_SLEEP
    while {[set $handle]>0} {
      vwait $handle
    }
    unset $handle
    return
  }
  variable all_coroutines
  variable coroutine_sleep
  if {$coro ni $all_coroutines} {
    coroutine_register {} $coro
  }
  if {![info exists coroutine_sleep($coro)]} {
    set coroutine_sleep($coro) [expr {[clock milliseconds]+$ms}]
    ::cron::wake COROUTINE_SLEEP
  }
  yield
  while {$coroutine_sleep($coro)>[clock milliseconds]} {
    yield
  }
  unset coroutine_sleep($coro)
}

proc ::cron::coroutine_unregister {coroutine} {
  variable all_coroutines
  variable object_coroutines
  variable coroutine_object
  ldelete all_coroutines $coroutine
  if {[info exists coroutine_object($coroutine)]} {
    set objname $coroutine_object($coroutine)
    ldelete object_coroutines($objname) $coroutine
    unset coroutine_object($coroutine)
  }
}

proc ::cron::do_events {} {
  # Process coroutines
  variable all_coroutines
  variable coroutine_object
  variable coroutine_busy
  variable coroutine_sleep
  variable last_event
  set last_event [clock seconds]
  set count 0
  set mnow [clock milliseconds]
  foreach coro $all_coroutines {
    if {[info exists coroutine_sleep($coro)]} {
      if {$coroutine_sleep($coro) > $mnow} continue
    }
    if {![info exists coroutine_busy($coro)]} {
      set coroutine_busy($coro) 0
    }
    # Prevent a stuck coroutine from logjamming the entire event loop
    if {$coroutine_busy($coro)} continue
    set coroutine_busy($coro) 1







>
>
>
>
|
|
>








|
>
>
|
|
|

|


<
<
|
<
<
<
|
|
<
<
|
<
<
|



















<





|
|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118


119



120
121


122


123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

143
144
145
146
147
148
149
150
151
152
153
154
155
156
  lappend all_coroutines $coroutine
  lappend object_coroutines($objname) $coroutine
  set coroutine_object($coroutine) $objname
  return 0
}

proc ::cron::sleep_handle {ms} {
  set coro [info coroutine]
  if {$coro ne {}} {
    set var ::cron::event($coro)
  } else {
    set eventid [incr ::cron::eventcount]
    set var ::cron::event($eventid)
  }
  set ${var} [expr {[clock milliseconds]+$ms}]
  return $var
}


proc ::cron::sleep ms {
  set coro [info coroutine]
  if {$coro eq {}} {
    set eventid [incr ::cron::eventcount]
    set ::cron::event($eventid) [expr {[clock milliseconds]+$ms}]
    after $ms [list set ::cron::event($eventid) -1]
    vwait ::cron::event($eventid)
    while {$::cron::event($eventid) > [clock milliseconds]} {
      vwait ::cron::event($eventid)
    }
    unset ::cron::event($eventid)
    return
  }


  set eventid $coro



  set ::cron::event($eventid) [expr {[clock milliseconds]+$ms}]
  after $ms [list set ::cron::event($eventid) -1]


  ::coroutine::util::vwait ::cron::event($eventid)


  unset ::cron::event($eventid)
}

proc ::cron::coroutine_unregister {coroutine} {
  variable all_coroutines
  variable object_coroutines
  variable coroutine_object
  ldelete all_coroutines $coroutine
  if {[info exists coroutine_object($coroutine)]} {
    set objname $coroutine_object($coroutine)
    ldelete object_coroutines($objname) $coroutine
    unset coroutine_object($coroutine)
  }
}

proc ::cron::do_events {} {
  # Process coroutines
  variable all_coroutines
  variable coroutine_object
  variable coroutine_busy

  variable last_event
  set last_event [clock seconds]
  set count 0
  set mnow [clock milliseconds]
  foreach coro $all_coroutines {
    if {[info exists ::cron::event($coro)]} {
      if {$::cron::event($coro) > $mnow} continue
    }
    if {![info exists coroutine_busy($coro)]} {
      set coroutine_busy($coro) 0
    }
    # Prevent a stuck coroutine from logjamming the entire event loop
    if {$coroutine_busy($coro)} continue
    set coroutine_busy($coro) 1
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
          set nexttask $process
          set nextevent $scheduled
        }
        set lastevent $now
      }
    }
    set mnow [clock milliseconds]
    foreach {coro msec} [array get ::cron::coroutine_sleep] {
      set scheduled [expr $msec/1000]
      if {$scheduled<$nextevent} {
        set nexttask $coro
        set nextevent $scheduled
      }
    }
    foreach {eventid msec} [array get ::cron::event] {
      if {$msec < 0} continue
      if {$msec < $mnow} {
        set ::cron::event($eventid) -1
      }
      set scheduled [expr $msec/1000]
      if {$scheduled<$nextevent} {
        set nexttask "SLEEP $eventid"
        set nextevent $scheduled
      }
    }  
    set delay [expr {$nextevent-$now}]
    if {$delay < 0} {







<
<
<
<
<
<
<





|







289
290
291
292
293
294
295







296
297
298
299
300
301
302
303
304
305
306
307
308
          set nexttask $process
          set nextevent $scheduled
        }
        set lastevent $now
      }
    }
    set mnow [clock milliseconds]







    foreach {eventid msec} [array get ::cron::event] {
      if {$msec < 0} continue
      if {$msec < $mnow} {
        set ::cron::event($eventid) -1
      }
      set scheduled [expr {$msec/1000}]
      if {$scheduled<$nextevent} {
        set nexttask "SLEEP $eventid"
        set nextevent $scheduled
      }
    }  
    set delay [expr {$nextevent-$now}]
    if {$delay < 0} {
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
  }
  if {$who eq "PANIC"} {
    # Cron is overdue and may be stuck
    set ::cron::busy 0
    set ::cron::panic_event {}
  }
  if {$::cron::busy && $::cron::panic_event eq {}} {
    puts "BUSY..."
    after cancel $::cron::panic_event
    set ::cron::panic_event [after 120000 {::cron::wake PANIC}]
    return
  }
  set now [clock seconds]
  set ::cron::busy 1
  while {$::cron::busy} {







<







328
329
330
331
332
333
334

335
336
337
338
339
340
341
  }
  if {$who eq "PANIC"} {
    # Cron is overdue and may be stuck
    set ::cron::busy 0
    set ::cron::panic_event {}
  }
  if {$::cron::busy && $::cron::panic_event eq {}} {

    after cancel $::cron::panic_event
    set ::cron::panic_event [after 120000 {::cron::wake PANIC}]
    return
  }
  set now [clock seconds]
  set ::cron::busy 1
  while {$::cron::busy} {