Fix stack bugs in alarms and UI
parent
8226f8b295
commit
eeb05ec857
|
@ -15,3 +15,5 @@ concurrency.count-downs ;
|
||||||
[ resume ] curry instant later drop
|
[ resume ] curry instant later drop
|
||||||
] "test" suspend drop
|
] "test" suspend drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
\ alarm-thread-loop must-infer
|
||||||
|
|
|
@ -38,7 +38,7 @@ SYMBOL: alarm-thread
|
||||||
|
|
||||||
: call-alarm ( alarm -- )
|
: call-alarm ( alarm -- )
|
||||||
dup alarm-entry box> drop
|
dup alarm-entry box> drop
|
||||||
dup alarm-quot try
|
dup alarm-quot "Alarm execution" spawn drop
|
||||||
dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
|
dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
|
||||||
|
|
||||||
: (trigger-alarms) ( alarms now -- )
|
: (trigger-alarms) ( alarms now -- )
|
||||||
|
@ -62,8 +62,7 @@ SYMBOL: alarm-thread
|
||||||
: alarm-thread-loop ( -- )
|
: alarm-thread-loop ( -- )
|
||||||
alarms get-global
|
alarms get-global
|
||||||
dup next-alarm sleep-until
|
dup next-alarm sleep-until
|
||||||
dup trigger-alarms
|
trigger-alarms ;
|
||||||
alarm-thread-loop ;
|
|
||||||
|
|
||||||
: cancel-alarms ( alarms -- )
|
: cancel-alarms ( alarms -- )
|
||||||
[
|
[
|
||||||
|
@ -72,7 +71,7 @@ SYMBOL: alarm-thread
|
||||||
|
|
||||||
: init-alarms ( -- )
|
: init-alarms ( -- )
|
||||||
alarms global [ cancel-alarms <min-heap> ] change-at
|
alarms global [ cancel-alarms <min-heap> ] change-at
|
||||||
[ alarm-thread-loop ] "Alarms" spawn
|
[ alarm-thread-loop t ] "Alarms" spawn-server
|
||||||
alarm-thread set-global ;
|
alarm-thread set-global ;
|
||||||
|
|
||||||
[ init-alarms ] "alarms" add-init-hook
|
[ init-alarms ] "alarms" add-init-hook
|
||||||
|
|
|
@ -148,7 +148,7 @@ SYMBOL: ui-thread
|
||||||
\ ui-running get-global ;
|
\ ui-running get-global ;
|
||||||
|
|
||||||
: update-ui-loop ( -- )
|
: update-ui-loop ( -- )
|
||||||
ui-running? ui-thread get-global self eq? [
|
ui-running? ui-thread get-global self eq? and [
|
||||||
ui-notify-flag get lower-flag
|
ui-notify-flag get lower-flag
|
||||||
[ update-ui ] ui-try
|
[ update-ui ] ui-try
|
||||||
update-ui-loop
|
update-ui-loop
|
||||||
|
|
Loading…
Reference in New Issue