[comp.lang.perl] itimers

tchrist@convex.com (Tom Christiansen) (02/12/90)

I've worked up [sg]etitimer routines and an alarm(), but when 
I run my test case, this is the output I get:

    timeleft is 0, 0
    setting alarms at Sun Feb 11 12:18:04 CDT 1990
    Bad free() ignored at itimers/ttimer line 61.
    alarm: setitimer failed: Invalid argument at itimers/ttimer line 79.
    alarm had 0 secs left

This means the getitimer was happy, but then there was some
internal glitch and then the setitimer failed.

Larry, is the failed system related to the bad free(), or am 
I miscalling the system call someway as it would have me believe?
Also, ttimer hasn't got 79 lines, why does it say it does?

Extract the sharchive and run itimers/ttimer to reproduce.  You'll
need syscall.h, sys/time.h, and ctime.pl to run this.  The first
two are generated with makelib, and the last has been passed around 
in this group before.  I'll supply it if you don't have it.

thanks

#!/bin/sh
#    This is a shell archive.
#    Run the following text with /bin/sh to extract.

echo mkdir itimers
mkdir itimers
echo cd itimers
cd itimers
echo x timers.pl
sed -e 's/^X//' << \EOFMARK > timers.pl
X#
X# timer manipulation functions
X#
X#	getitimer
X#	setitimer
X#	alarm
X
Xdo 'source.pl' unless defined &source;
Xdo source('syscall.h') unless defined &SYS_setitimer;
Xdo source('sys/time.h') unless defined &ITIMER_REAL;
X
X#
X# careful: implentation dependent!
X#
X$itimer_t = 'L2';  # itimers consist of two longs
X$sizeof{'itimer'} = '8' unless defined $sizeof{'itimer'};
X
X###########################################################################
X# itimer conversion function; this one goes both ways
Xsub itimer {
X    wantarray ? unpack($itimer_t, $_[0])
X	      : pack($itimer_t, $_[0], $_[1]); 
X} 
X
X
X###########################################################################
Xsub setitimer {
X    local($which) = shift;
X
X    die "setitimer: input itimer not length ".$sizeof{'itimer'} 
X	unless length($_[0]) == $sizeof{'itimer'};
X
X    $_[1] = &itimer(0,0);
X    !syscall(&SYS_setitimer, $which, $_[0], $_[1]);
X} 
X
X###########################################################################
Xsub getitimer {
X    local($which) = shift;
X
X    $_[0] = &itimer(0,0);
X
X    !syscall(&SYS_getitimer, $which, $_[0]);
X} 
X
X###########################################################################
X# 
X# alarm; send me a SIGALRM in this many seconds
X#
Xsub alarm {
X    local($ticks) = @_;
X    local($itimer,$otimer);
X    local($secs, $usecs);
X
X    $otimer = &itimer(0,0);
X    $itimer = &itimer($ticks,0);
X
X    do setitimer(&ITIMER_REAL, $itimer, $otimer) || warn "alarm: setitimer failed: $!";
X
X    ($secs, $usecs) = &itimer($otimer);
X    return $secs;
X} 
X
EOFMARK
echo x ttimer
sed -e 's/^X//' << \EOFMARK > ttimer
X#!/usr/bin/perl
X
Xdo 'source.pl' || die "can't do source.pl";
X
Xdo source('timers.pl');
Xdo source('ctime.pl');
X
X$| = 1;
X
X$SIG{'ALRM'} = 'bingo';
X
Xsub bingo {
X    print "i was alarmed at time ", &ctime(time);
X    $hit++;
X} 
X
Xdo timeleft();
X
Xprint "setting alarms at ", &ctime(time);
X
Xdo alarm(7);
X
Xprintf "alarm had %d secs left\n", &alarm(3);
X
Xdo { } until $hit; 
X
Xprint "escaped at ", &ctime(time);
X
Xsub timeleft {
X    &getitimer(&ITIMER_REAL, $timeleft) || die "can't getitimer: $!";
X    printf "timeleft is %d, %d\n", &itimer($timeleft);
X}
EOFMARK
echo chmod +x ttimer
chmod +x ttimer
echo x source.pl
sed -e 's/^X//' << \EOFMARK > source.pl
X
X###########################################################################
Xsub source {
X    local($file) = @_;
X    local($return) = 0;
X
X    $return = do $file;
X    die "couldn't do \"$file\": $!" unless defined $return;
X    die "couldn't parse \"$file\": $@" if $@;
X    die "couldn't run \"$file\"" unless $return;
X} 
X
X###########################################################################
X
X1;
EOFMARK
exit 0

lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (02/15/90)

In article <5334@convex.convex.com> tchrist@convex.com (Tom Christiansen) writes:
: I've worked up [sg]etitimer routines and an alarm(), but when 
: I run my test case, this is the output I get:
: 
:     timeleft is 0, 0
:     setting alarms at Sun Feb 11 12:18:04 CDT 1990
:     Bad free() ignored at itimers/ttimer line 61.
:     alarm: setitimer failed: Invalid argument at itimers/ttimer line 79.
:     alarm had 0 secs left
: 
: This means the getitimer was happy, but then there was some
: internal glitch and then the setitimer failed.
: 
: Larry, is the failed system related to the bad free(), or am 
: I miscalling the system call someway as it would have me believe?

You're miscalling the system call.  The two timer values are 4 longs long,
not 2, since each one has both an interval and a value, and each of those
has both a seconds and a microseconds.  Passing a short string for
syscall to write over could well cause a bad free, depending on which
malloc package you use.

: Also, ttimer hasn't got 79 lines, why does it say it does?

I'm not sure.  Part of the problem is that it should say timers.pl,
not ttimer, since the warn is over there.

Try the following.

Larry Wall
lwall@jpl-devvax.jpl.nasa.gov

#!/bin/sh
: make a subdirectory, cd to it, and run this through sh.
echo 'If this kit is complete, "End of kit" will echo at the end'
echo Extracting timers.pl
sed >timers.pl <<'!STUFFY!FUNK!' -e 's/X//'
X#
X# timer manipulation functions
X#
X#	getitimer
X#	setitimer
X#	alarm
X
Xdo 'source.pl' unless defined &source;
Xdo source('syscall.h') unless defined &SYS_setitimer;
Xdo source('sys/time.h') unless defined &ITIMER_REAL;
X
X#
X# careful: implentation dependent!
X#
X$itimer_t = 'L4';  # itimers consist of four longs
X$sizeof{'itimer'} = '16' unless defined $sizeof{'itimer'};
X
X###########################################################################
X# itimer conversion function; this one goes both ways
Xsub itimer {
X    wantarray ? unpack($itimer_t, $_[0])
X	      : pack($itimer_t, $_[0], $_[1], $_[2], $_[3]); 
X} 
X
X
X###########################################################################
Xsub setitimer {
X    local($which) = shift;
X
X    die "setitimer: input itimer not length ".$sizeof{'itimer'} 
X	unless length($_[0]) == $sizeof{'itimer'};
X
X    $_[1] = &itimer(0,0,0,0);
X    !syscall(&SYS_setitimer, $which, $_[0], $_[1]);
X} 
X
X###########################################################################
Xsub getitimer {
X    local($which) = shift;
X
X    $_[0] = &itimer(0,0,0,0);
X
X    !syscall(&SYS_getitimer, $which, $_[0]);
X} 
X
X###########################################################################
X# 
X# alarm; send me a SIGALRM in this many seconds
X#
Xsub alarm {
X    local($ticks) = @_;
X    local($itimer,$otimer);
X    local($secs, $usecs);
X
X    $otimer = &itimer(0,0,0,0);
X    $itimer = &itimer(0,0,$ticks,0);
X
X    do setitimer(&ITIMER_REAL, $itimer, $otimer) || warn "alarm: setitimer failed: $!";
X
X    ($isecs, $iusecs, $secs, $usecs) = &itimer($otimer);
X    return $secs;
X} 
X
!STUFFY!FUNK!
echo Extracting ttimer
sed >ttimer <<'!STUFFY!FUNK!' -e 's/X//'
X#!../perl
X
Xdo 'source.pl' || die "can't do source.pl";
X
Xdo source('timers.pl');
Xdo source('ctime.pl');
X
X$| = 1;
X
X$SIG{'ALRM'} = 'bingo';
X
Xsub bingo {
X    print "i was alarmed at time ", &ctime(time);
X    $hit++;
X} 
X
Xdo timeleft();
X
Xprint "setting alarms at ", &ctime(time);
X
Xdo alarm(7);
X
Xprintf "alarm had %d secs left\n", &alarm(3);
X
Xdo { &timeleft; } until $hit; 
X
Xprint "escaped at ", &ctime(time);
X
Xsub timeleft {
X    &getitimer(&ITIMER_REAL, $timeleft) || die "can't getitimer: $!";
X    printf "timeleft is %d, %d, %d, %d\n", &itimer($timeleft);
X}
!STUFFY!FUNK!
echo ""
echo "End of kit"
: I do not append .signature, but someone might mail this.
exit

tchrist@convex.COM (Tom Christiansen) (02/16/90)

YARG, I was using 2 timeval's instead of 2 itimerval's.  Chastisement
accepted.

The routines work now with one minor change to compensate for
what *seems* to be a perl bug regarding return values from syscall.
The last statement in setitimer() had to be changed from :

    !syscall(&SYS_setitimer, $which, $_[0], $_[1]);
to:
    syscall(&SYS_setitimer, $which, $_[0], $_[1]) != -1;

I found that in the test case posted, syscall was returning 1, 3, and 1, 
although errno was OK and everything worked.  This is true on both
a Sun and a Convex.  I coded up the same thing in C using the 
indirect syscall() interface, and it was just fine, returning 0's 
not 1, 3, and 1.  Looking at do_syscall() in perl/doarg.c, I put
this debugging line in perl itself right after the call:

	printf("perl: syscall returned %d\n", retval);

and confirmed that the syscall()s really are working fine.  BUT
by the time the interpreted code gets a hold of it, it's been 
changed into 1, 3, and 1.  

I can't help wondering whether my array-sensitive &itimer function
is messing with perl's stack (the one it keeps of my code, not
its own stack.)


--tom
--

    Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
    Convex Computer Corporation                            tchrist@convex.COM
		 "EMACS belongs in <sys/errno.h>: Editor too big!"