@@ -112,6 +112,13 @@ typedef struct {
112
112
JanetHandle write_pipe ;
113
113
} JanetEVThreadInit ;
114
114
115
+ /* Structure used to initialize threads that run timeouts */
116
+ typedef struct {
117
+ double sec ;
118
+ JanetVM * vm ;
119
+ JanetFiber * fiber ;
120
+ } JanetThreadedTimeout ;
121
+
115
122
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF
116
123
117
124
static void janet_q_init (JanetQueue * q ) {
@@ -623,6 +630,7 @@ void janet_addtimeout(double sec) {
623
630
to .curr_fiber = NULL ;
624
631
to .sched_id = fiber -> sched_id ;
625
632
to .is_error = 1 ;
633
+ to .has_worker = 0 ;
626
634
add_timeout (to );
627
635
}
628
636
@@ -635,9 +643,54 @@ void janet_addtimeout_nil(double sec) {
635
643
to .curr_fiber = NULL ;
636
644
to .sched_id = fiber -> sched_id ;
637
645
to .is_error = 0 ;
646
+ to .has_worker = 0 ;
638
647
add_timeout (to );
639
648
}
640
649
650
+ #ifdef JANET_WINDOWS
651
+ static VOID CALLBACK janet_timeout_stop (ULONG_PTR ptr ) {
652
+ UNREFERENCED_PARAMETER (ptr );
653
+ ExitThread (0 );
654
+ }
655
+ #endif
656
+
657
+ static void janet_timeout_cb (JanetEVGenericMessage msg ) {
658
+ (void ) msg ;
659
+ janet_interpreter_interrupt_handled (& janet_vm );
660
+ }
661
+
662
+ #ifdef JANET_WINDOWS
663
+ static DWORD WINAPI janet_timeout_body (LPVOID ptr ) {
664
+ JanetThreadedTimeout tto = * (JanetThreadedTimeout * )ptr ;
665
+ janet_free (ptr );
666
+ SleepEx ((DWORD )(tto .sec * 1000 ), TRUE);
667
+ if (janet_fiber_can_resume (tto .fiber )) {
668
+ janet_interpreter_interrupt (tto .vm );
669
+ JanetEVGenericMessage msg = {0 };
670
+ janet_ev_post_event (tto .vm , janet_timeout_cb , msg );
671
+ }
672
+ return 0 ;
673
+ }
674
+ #else
675
+ static void * janet_timeout_body (void * ptr ) {
676
+ JanetThreadedTimeout tto = * (JanetThreadedTimeout * )ptr ;
677
+ janet_free (ptr );
678
+ struct timespec ts ;
679
+ ts .tv_sec = (time_t ) tto .sec ;
680
+ ts .tv_nsec = (tto .sec <= UINT32_MAX )
681
+ ? (long )((tto .sec - ((uint32_t )tto .sec )) * 1000000000 )
682
+ : 0 ;
683
+ nanosleep (& ts , & ts );
684
+ if (janet_fiber_can_resume (tto .fiber )) {
685
+ janet_interpreter_interrupt (tto .vm );
686
+ JanetEVGenericMessage msg = {0 };
687
+ janet_ev_post_event (tto .vm , janet_timeout_cb , msg );
688
+ }
689
+ return NULL ;
690
+ }
691
+ #endif
692
+
693
+
641
694
void janet_ev_inc_refcount (void ) {
642
695
janet_atomic_inc (& janet_vm .listener_count );
643
696
}
@@ -1431,6 +1484,17 @@ JanetFiber *janet_loop1(void) {
1431
1484
while ((has_timeout = peek_timeout (& to ))) {
1432
1485
if (to .curr_fiber != NULL ) {
1433
1486
if (!janet_fiber_can_resume (to .curr_fiber )) {
1487
+ if (to .has_worker ) {
1488
+ #ifdef JANET_WINDOWS
1489
+ QueueUserAPC (janet_timeout_stop , to .worker , 0 );
1490
+ WaitForSingleObject (to .worker , INFINITE );
1491
+ CloseHandle (to .worker );
1492
+ #else
1493
+ pthread_cancel (to .worker );
1494
+ void * res ;
1495
+ pthread_join (to .worker , & res );
1496
+ #endif
1497
+ }
1434
1498
janet_table_remove (& janet_vm .active_tasks , janet_wrap_fiber (to .curr_fiber ));
1435
1499
pop_timeout (0 );
1436
1500
continue ;
@@ -3103,26 +3167,53 @@ JANET_CORE_FN(cfun_ev_sleep,
3103
3167
}
3104
3168
3105
3169
JANET_CORE_FN (cfun_ev_deadline ,
3106
- "(ev/deadline sec &opt tocancel tocheck)" ,
3107
- "Schedules the event loop to try to cancel the `tocancel` "
3108
- "task as with `ev/cancel`. After `sec` seconds, the event "
3109
- "loop will attempt cancellation of `tocancel` if the "
3110
- "`tocheck` fiber is resumable. `sec` is a number that can "
3111
- "have a fractional part. `tocancel` defaults to "
3112
- "`(fiber/root)`, but if specified, must be a task (root "
3113
- "fiber). `tocheck` defaults to `(fiber/current)`, but if "
3114
- "specified, should be a fiber. Returns `tocancel` "
3115
- "immediately." ) {
3116
- janet_arity (argc , 1 , 3 );
3170
+ "(ev/deadline sec &opt tocancel tocheck intr?)" ,
3171
+ "Schedules the event loop to try to cancel the `tocancel` task as with `ev/cancel`. "
3172
+ "After `sec` seconds, the event loop will attempt cancellation of `tocancel` if the "
3173
+ "`tocheck` fiber is resumable. `sec` is a number that can have a fractional part. "
3174
+ "`tocancel` defaults to `(fiber/root)`, but if specified, must be a task (root "
3175
+ "fiber). `tocheck` defaults to `(fiber/current)`, but if specified, must be a fiber. "
3176
+ "Returns `tocancel` immediately. If `interrupt?` is set to true, will create a "
3177
+ "background thread to try to interrupt the VM if the timeout expires." ) {
3178
+ janet_arity (argc , 1 , 4 );
3117
3179
double sec = janet_getnumber (argv , 0 );
3180
+ sec = (sec < 0 ) ? 0 : sec ;
3118
3181
JanetFiber * tocancel = janet_optfiber (argv , argc , 1 , janet_vm .root_fiber );
3119
3182
JanetFiber * tocheck = janet_optfiber (argv , argc , 2 , janet_vm .fiber );
3183
+ int use_interrupt = janet_optboolean (argv , argc , 3 , 0 );
3120
3184
JanetTimeout to ;
3121
3185
to .when = ts_delta (ts_now (), sec );
3122
3186
to .fiber = tocancel ;
3123
3187
to .curr_fiber = tocheck ;
3124
3188
to .is_error = 0 ;
3125
3189
to .sched_id = to .fiber -> sched_id ;
3190
+ if (use_interrupt ) {
3191
+ JanetThreadedTimeout * tto = janet_malloc (sizeof (JanetThreadedTimeout ));
3192
+ if (NULL == tto ) {
3193
+ JANET_OUT_OF_MEMORY ;
3194
+ }
3195
+ tto -> sec = sec ;
3196
+ tto -> vm = & janet_vm ;
3197
+ tto -> fiber = tocheck ;
3198
+ #ifdef JANET_WINDOWS
3199
+ HANDLE worker = CreateThread (NULL , 0 , janet_timeout_body , tto , 0 , NULL );
3200
+ if (NULL == worker ) {
3201
+ janet_free (tto );
3202
+ janet_panic ("failed to create thread" );
3203
+ }
3204
+ #else
3205
+ pthread_t worker ;
3206
+ int err = pthread_create (& worker , NULL , janet_timeout_body , tto );
3207
+ if (err ) {
3208
+ janet_free (tto );
3209
+ janet_panicf ("%s" , janet_strerror (err ));
3210
+ }
3211
+ #endif
3212
+ to .has_worker = 1 ;
3213
+ to .worker = worker ;
3214
+ } else {
3215
+ to .has_worker = 0 ;
3216
+ }
3126
3217
add_timeout (to );
3127
3218
return janet_wrap_fiber (tocancel );
3128
3219
}
0 commit comments