cvsuser 04/01/09 02:28:20
Modified: classes timer.pmc
dynoplibs myops.ops
include/parrot events.h
src events.c
t/pmc timer.t
Log:
event-handling-16
* repeat count for timers
* del_timer
Revision Changes Path
1.9 +6 -8 parrot/classes/timer.pmc
Index: timer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/timer.pmc,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- timer.pmc 7 Jan 2004 15:22:02 -0000 1.8
+++ timer.pmc 9 Jan 2004 10:28:11 -0000 1.9
@@ -1,7 +1,7 @@
/* timer.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: timer.pmc,v 1.8 2004/01/07 15:22:02 leo Exp $
+ * $Id: timer.pmc,v 1.9 2004/01/09 10:28:11 leo Exp $
* Overview:
* This is the Timer base class
* Data Structure and Algorithms:
@@ -67,15 +67,15 @@
add_timer(Parrot_Interp interpreter, PMC *pmc)
{
parrot_timer_event *t = pmc->cache.struct_val;
- /* TODO handle interval, repeat count */
if (!PMC_IS_NULL(t->sub))
- Parrot_new_timer_event(interpreter, t->abs_time, 0, t->sub);
+ Parrot_new_timer_event(interpreter, pmc, t->abs_time,
+ t->interval, t->repeat, t->sub);
}
static void
del_timer(Parrot_Interp interpreter, PMC *pmc)
{
- /* TODO find timer in queue, set inactive flag */
+ Parrot_del_timer_event(interpreter, pmc);
}
@@ -141,14 +141,12 @@
switch(key) {
case PARROT_TIMER_SEC:
return (INTVAL)t->abs_time;
- break;
case PARROT_TIMER_USEC:
return (t->abs_time - (INTVAL)t->abs_time) *1000000.0;
- break;
case PARROT_TIMER_REPEAT:
+ return (INTVAL) t->repeat;
case PARROT_TIMER_RUNNING:
return 0;
- break;
}
return -1;
}
@@ -187,7 +185,7 @@
t->abs_time += value / 1000000.0;
break;
case PARROT_TIMER_REPEAT:
- /* t->repeat = value; */
+ t->repeat = value;
break;
case PARROT_TIMER_RUNNING:
if (value) {
1.5 +2 -2 parrot/dynoplibs/myops.ops
Index: myops.ops
===================================================================
RCS file: /cvs/public/parrot/dynoplibs/myops.ops,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- myops.ops 16 Dec 2003 11:33:07 -0000 1.4
+++ myops.ops 9 Jan 2004 10:28:13 -0000 1.5
@@ -54,12 +54,12 @@
=cut
op alarm(in NUM, in PMC) {
- Parrot_new_timer_event(interpreter, $1, 0.0, $2);
+ Parrot_new_timer_event(interpreter, NULL, $1, 0.0, 0, $2);
goto NEXT();
}
op alarm(in NUM, in NUM, in PMC) {
- Parrot_new_timer_event(interpreter, $1, $2, $3);
+ Parrot_new_timer_event(interpreter, NULL, $1, $2, -1, $3);
goto NEXT();
}
1.8 +5 -2 parrot/include/parrot/events.h
Index: events.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/events.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- events.h 18 Dec 2003 16:14:58 -0000 1.7
+++ events.h 9 Jan 2004 10:28:15 -0000 1.8
@@ -1,7 +1,7 @@
/* events.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: events.h,v 1.7 2003/12/18 16:14:58 leo Exp $
+ * $Id: events.h,v 1.8 2004/01/09 10:28:15 leo Exp $
* Overview:
* This api will handle parrot events
* Data Structure and Algorithms:
@@ -33,6 +33,7 @@
typedef struct {
FLOATVAL abs_time;
FLOATVAL interval;
+ int repeat; /* 0 = once, -1 = forever */
PMC* sub; /* handler sub */
} parrot_timer_event;
@@ -61,10 +62,12 @@
void* Parrot_do_check_events(Parrot_Interp, void*);
void* Parrot_do_handle_events(Parrot_Interp, int, void*);
-void Parrot_new_timer_event(Parrot_Interp, FLOATVAL, FLOATVAL,PMC*);
+void Parrot_new_timer_event(Parrot_Interp, PMC*, FLOATVAL, FLOATVAL, int, PMC*);
+void Parrot_del_timer_event(Parrot_Interp, PMC* timer);
void Parrot_new_terminate_event(Parrot_Interp);
void disable_event_checking(Parrot_Interp);
void enable_event_checking(Parrot_Interp);
+
#endif
/*
1.17 +41 -7 parrot/src/events.c
Index: events.c
===================================================================
RCS file: /cvs/public/parrot/src/events.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- events.c 27 Dec 2003 11:40:55 -0000 1.16
+++ events.c 9 Jan 2004 10:28:17 -0000 1.17
@@ -1,7 +1,7 @@
/* events.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: events.c,v 1.16 2003/12/27 11:40:55 leo Exp $
+ * $Id: events.c,v 1.17 2004/01/09 10:28:17 leo Exp $
* Overview:
* Event handling stuff
* Data Structure and Algorithms:
@@ -147,20 +147,46 @@
* interval running the passed sub
*/
void
-Parrot_new_timer_event(Parrot_Interp interpreter, FLOATVAL diff,
- FLOATVAL interval, PMC* sub)
+Parrot_new_timer_event(Parrot_Interp interpreter, PMC* timer, FLOATVAL diff,
+ FLOATVAL interval, int repeat, PMC* sub)
{
parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
FLOATVAL now = Parrot_floatval_time();
ev->type = EVENT_TYPE_TIMER;
- ev->data = NULL;
+ ev->data = timer;
ev->u.timer_event.abs_time = now + diff;
ev->u.timer_event.interval = interval;
+ ev->u.timer_event.repeat = repeat;
+ if (repeat && !interval)
+ ev->u.timer_event.interval = diff;
ev->u.timer_event.sub = sub;
Parrot_schedule_event(interpreter, ev);
}
/*
+ * deactivate timer identified by timer PMC
+ */
+void
+Parrot_del_timer_event(Parrot_Interp interpreter, PMC* timer)
+{
+ QUEUE_ENTRY *entry;
+ parrot_event* event;
+
+ LOCK(event_queue->queue_mutex);
+ for (entry = event_queue->head; entry; entry = entry->next) {
+ if (entry->type == QUEUE_ENTRY_TYPE_TIMED_EVENT) {
+ event = entry->data;
+ if (event->interp == interpreter && event->data == timer) {
+ event->u.timer_event.interval = 0.0;
+ event->type = EVENT_TYPE_NONE;
+ break;
+ }
+ }
+ }
+ UNLOCK(event_queue->queue_mutex);
+}
+
+/*
* create a terminate event, interpreter will leave runloop
* when this event arrives
*/
@@ -258,9 +284,13 @@
* if event is repeated dup and reinsert it
*/
if (event->u.timer_event.interval) {
+ if (event->u.timer_event.repeat) {
+ if (event->u.timer_event.repeat != -1)
+ event->u.timer_event.repeat--;
nosync_insert_entry(event_q,
dup_entry_interval(entry, now));
}
+ }
break;
default:
internal_exception(1, "Unknown queue entry");
@@ -268,10 +298,14 @@
/*
* TODO check for a stop event to do cleanup
*/
+ assert(event);
+ if (event->type == EVENT_TYPE_NONE) {
+ mem_sys_free(entry);
+ continue;
+ }
/*
* now insert entry in interpreter task queue
*/
- assert(event);
if (event->interp) {
Parrot_schedule_interp_qentry(event->interp, entry);
}
1.4 +61 -2 parrot/t/pmc/timer.t
Index: timer.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/timer.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- timer.t 7 Jan 2004 15:22:04 -0000 1.3
+++ timer.t 9 Jan 2004 10:28:20 -0000 1.4
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 3;
+use Parrot::Test tests => 5;
use Test::More;
output_is(<<'CODE', <<'OUT', "Timer setup");
@@ -64,7 +64,7 @@
OUT
SKIP: {
- skip("No thread config yet", 1) unless ($^O eq 'linux' or $^O eq 'darwin');
+ skip("No thread config yet", 3) unless ($^O eq 'linux' or $^O eq 'darwin');
output_is(<<'CODE', <<'OUT', "Timer setup - initializer/start");
.include "timer.pasm"
@@ -89,6 +89,65 @@
invoke P1
CODE
ok 1
+ok 2
+ok 3
+OUT
+
+output_is(<<'CODE', <<'OUT', "Timer setup - initializer/start/stop");
+.include "timer.pasm"
+ bounds 1 # cant run with JIT core yet
+ new P1, .SArray
+ set P1, 6
+ set P1[0], .PARROT_TIMER_NSEC
+ set P1[1], 0.5
+ set P1[2], .PARROT_TIMER_HANDLER
+ find_global P2, "_timer_sub"
+ set P1[3], P2
+ set P1[4], .PARROT_TIMER_RUNNING
+ set P1[5], 1
+
+ new P0, .Timer, P1
+ print "ok 1\n"
+ # stop the timer
+ set P0[.PARROT_TIMER_RUNNING], 0
+ sleep 1
+ print "ok 2\n"
+ end
+.pcc_sub _timer_sub:
+ print "never\n"
+ invoke P1
+CODE
+ok 1
+ok 2
+OUT
+
+output_is(<<'CODE', <<'OUT', "Timer setup - initializer/start/repeat");
+.include "timer.pasm"
+ bounds 1 # cant run with JIT core yet
+ new P1, .SArray
+ set P1, 8
+ set P1[0], .PARROT_TIMER_NSEC
+ set P1[1], 0.2
+ set P1[2], .PARROT_TIMER_HANDLER
+ find_global P2, "_timer_sub"
+ set P1[3], P2
+ set P1[4], .PARROT_TIMER_REPEAT
+ set P1[5], 2
+ set P1[6], .PARROT_TIMER_RUNNING
+ set P1[7], 1
+
+ new P0, .Timer, P1
+ print "ok 1\n"
+ sleep 1
+ print "ok 3\n"
+ end
+.pcc_sub _timer_sub:
+ print "ok 2\n"
+ invoke P1
+CODE
+ok 1
+ok 2
+ok 2
ok 2
ok 3
OUT
