本质上，我想拥有一个高优先级线程，它以给定的时间间隔(此处为 0.5 毫秒)运行并中断“一切”，执行一个短任务，然后返回“ sleep ”；使用 Ubuntu 11.04 和 perl v5.10.1。问题是，虽然我得到了某种结果，但我不确定是否有可能获得“时间紧迫”。
我制作了三个测试脚本，其中“循环”基本上是将计数器增加 10 倍，获取时间戳 - 然后它终止，并打印时间戳(以微秒为单位)。
脚本 1
第一个基于我在 Perl- How to call an event after a time delay - Perl 中找到的一个片段 - 但是，我无法让那个特定的片段工作；所以有了一些变化，它是:
#!/usr/bin/env perl
# testloop01.pl
use strict;
use warnings;
use Time::HiRes qw ( setitimer ITIMER_VIRTUAL time );
my @tstamps;
my $cnt = 0;
my $numloops = 10;
my $loopperiod = 500e-6; # 0.000500 - 500 us
sub myfunc() {
push(@tstamps, time);
# repeat call for looping
if ($cnt < $numloops) {
$cnt++;
$SIG{VTALRM} = &myfunc; # must have this!
setitimer(ITIMER_VIRTUAL, 1, $loopperiod );
}
}
# take first timestamp at start
push(@tstamps, time);
# start it off
#~ $SIG{VTALRM} = sub { print time, "\n"; }; # no work like this on Linux ?!
$SIG{VTALRM} = &myfunc;
setitimer(ITIMER_VIRTUAL, 1, $loopperiod );
# wait - sleep 2 s
Time::HiRes::sleep(2);
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
执行此报告:
$ ./testloop01.pl
0 (diff: 0)
10 (diff: 10)
25 (diff: 15)
36 (diff: 10)
46 (diff: 10)
57 (diff: 10)
66 (diff: 9)
75 (diff: 8)
83 (diff: 8)
92 (diff: 9)
102 (diff: 9)
118 (diff: 15)
... 意味着循环基本上以尽可能快的速度运行，并且不遵守所要求的时间。我猜，可能 ITIMER_VIRTUAL 在我的机器上不起作用。
脚本 2
第二个脚本基于 Measurements at Regular Intervals in Perl 中的一个示例:
#!/usr/bin/env perl
# testloop02.pl
use strict;
use warnings;
use POSIX qw(pause);
# this does NOT work w/ ITIMER_VIRTUAL
use Time::HiRes qw(setitimer ITIMER_REAL time);
my @tstamps;
my $cnt = 0;
my $numloops = 10;
my $loopperiod = 500e-6; # 0.000500 - 500 us
# take first timestamp at start
push(@tstamps, time);
# how often do we trigger (seconds)?
my $first_interval = $loopperiod;
my $interval = $loopperiod;
# signal handler is empty
$SIG{ALRM} = sub { };
# first value is the initial wait, second is the wait thereafter
setitimer(ITIMER_REAL, $first_interval, $interval);
while (1) {
# wait for alarm from timer
pause;
# do work that takes less than $interval to complete
push(@tstamps, time);
# repeat call for looping
if ($cnt < $numloops) {
$cnt++;
} else {
last;
}
}
Time::HiRes::sleep(2); # helps avoid segfault, but doesn't seem to do anything;
# "it's apparently not safe to use sleep and a timer at
# the same time, as one may reset the other"
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
运行结果如下:
$ ./testloop02.pl
0 (diff: 0)
717 (diff: 717)
1190 (diff: 473)
1724 (diff: 534)
2206 (diff: 481)
2705 (diff: 499)
3204 (diff: 499)
3705 (diff: 500)
4203 (diff: 498)
4682 (diff: 478)
5206 (diff: 524)
5704 (diff: 498)
...我想，在这样的 PC 上，时间可能很紧迫(使用“ self 测量”)。但是，这里的问题是它在单线程上下文中运行(并且 usleep 显然不再工作了)。
脚本 3
第三个脚本试图对线程和usleep做同样的事情:
#!/usr/bin/env perl
# testloop03.pl
use strict;
use warnings;
use Time::HiRes qw ( usleep time );
use threads;
use threads::shared; # for shared variables
my @tstamps :shared;
my $cnt :shared = 0;
my $numloops :shared = 10;
my $loopperiod = 500e-6; # 0.000500 s - 500 us
my $loopperiodus :shared = $loopperiod*1e6; # 500 us
sub myfunc() {
# repeat call for looping
while ($cnt < $numloops) {
push(@tstamps, time);
$cnt++;
usleep($loopperiodus);
}
}
# take first timestamp at start
push(@tstamps, time);
# start it off
my $mthr = threads->create('myfunc');
$mthr->join();
# wait - sleep 2 s
Time::HiRes::sleep(2);
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
当我运行它时，我会得到类似的东西:
$ ./testloop03.pl
0 (diff: 0)
7498 (diff: 7498)
8569 (diff: 1070)
9300 (diff: 731)
9992 (diff: 691)
10657 (diff: 664)
11328 (diff: 671)
11979 (diff: 650)
12623 (diff: 643)
13284 (diff: 661)
13924 (diff: 639)
... 这有点接近，但与要求的时期相差甚远 - 我也不会像第二个脚本那样严格(事实上，我对此进行了一些实验，以及我的经验是它可能会相对较快地不稳定 - 即使对于非常简单的任务 - 取决于来自操作系统的压力，如 GUI 更新等)。
所以我的问题是 - 有没有办法在 Perl 中获得“紧”时间(如示例 2，w/setitimer) - 但在线程的上下文中(如示例 3 ; 因为我基本上希望在这个“定时循环”处于 sleep 状态时在主线程中完成其他事情)？不幸的是，试图将信号发送到线程:
...
sub myfunc() {
setitimer(ITIMER_REAL, $loopperiod, $loopperiod);
# repeat call for looping
while ($cnt < $numloops) {
push(@tstamps, time);
$cnt++;
pause;
# usleep($loopperiodus);
# wait for alarm from timer
}
}
# signal handler is empty
$SIG{ALRM} = sub { };
# take first timestamp at start
push(@tstamps, time);
# start it off
my $mthr = threads->create('myfunc');
# first value is the initial wait, second is the wait thereafter
#~ setitimer(ITIMER_REAL, $loopperiod, $loopperiod);
$mthr->join();
...
...不会工作:
$ ./testloop04.pl
Maximal count of pending signals (120) exceeded at ./testloop04.pl line 48.
Perl exited with active threads:
1 running and unjoined
-1 finished and unjoined
0 running and detached
EDIT2:示例 2 可以与 fork 一起使用以给出 impression of multithreading ；但是，fork 变量不共享(并且不再共享 Can't install IPC:Shareable，这将是简单的出路)。
非常感谢您的任何回答，
干杯!
EDIT3:感谢 answer from @daxim ，这是上面的 AnyEvent:
#!/usr/bin/env perl
# http://linux.die.net/man/3/anyevent
# http://search.cpan.org/~mlehmann/AnyEvent-6.02/lib/AnyEvent.pm
use 5.010;
use AnyEvent qw();
my @tstamps;
my $cnt = 0;
my $numloops = 10;
my $loopperiod = 500e-6; # 0.000500 - 500 us
my $result_ready = AnyEvent->condvar;
my %events = (
timer => AE::timer(0, $loopperiod, sub {
push(@tstamps, AE::time);
if ($cnt < $numloops) {
$cnt++;
} else {
#~ AE::cv->send; # doesn't exit loop?
$result_ready->broadcast; # exits loop
}
}),
#~ quit => AE::cv->recv,
quit => $result_ready->wait,
);
sleep 1; # this will kick in only after loop is complete!
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
请注意，在我的机器上，对于 0.5 毫秒，它给出了一些奇怪的测量值(左) - 然而，已经在 1.5 毫秒，有一些不错的结果(右):
$ ./testloop05.pl
0 (diff: 0) 0 (diff: 0)
34 (diff: 34) 32 (diff: 32)
117 (diff: 82) 2152 (diff: 2120)
1665 (diff: 1548) 3597 (diff: 1445)
1691 (diff: 25) 5090 (diff: 1492)
3300 (diff: 1609) 6547 (diff: 1456)
3319 (diff: 18) 8090 (diff: 1542)
4970 (diff: 1651) 9592 (diff: 1502)
4990 (diff: 20) 11089 (diff: 1497)
6607 (diff: 1616) 12589 (diff: 1500)
6625 (diff: 18) 14091 (diff: 1501)
最佳答案
线程不是多道程序的唯一方式。在 Perl 世界中，它们是最糟糕的之一。想尝试一下事件循环吗？
use 5.010;
use AnyEvent qw();
my %events = (
timer => AE::timer(0, 0.5, sub {
$now = AE::time;
say sprintf 'now: %f difference: %f', $now, $now - $previous;
$previous = $now;
}),
quit => AE::cv->recv,
);
$ perl testloop-ae.pl
now: 1316799028.264925 difference: 1316799028.264925
now: 1316799028.762484 difference: 0.497559
now: 1316799029.262058 difference: 0.499574
now: 1316799029.762640 difference: 0.500582
now: 1316799030.262207 difference: 0.499567
now: 1316799030.762668 difference: 0.500461
now: 1316799031.262242 difference: 0.499574
now: 1316799031.761805 difference: 0.499563
now: 1316799032.262378 difference: 0.500573
now: 1316799032.761953 difference: 0.499575
now: 1316799033.262513 difference: 0.500560
now: 1316799033.762081 difference: 0.499568
now: 1316799034.262674 difference: 0.500593
now: 1316799034.762256 difference: 0.499582
now: 1316799035.261837 difference: 0.499581
^C
关于multithreading - Perl 中的线程定时循环，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/7531709/