mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Check for working profiling and virtual itimers

Browse source 
* configure.ac (HAVE_USABLE_GETITIMER_PROF, HAVE_USABLE_GETITIMER_VIRTUAL): new tests
* doc/ref/posix.texi (setitimer, getitimer): document provided? 'ITIMER_VIRTUAL and 'ITIMER_PROF
* doc/ref/statprof.texi (statprof): document ITIMER_PROF requirements
* libguile/scmsigs.c (scm_setitimer, scm_getitimer): document (provided? 'ITIMER_VIRTUAL) and (provided? 'ITIMER_PROF)
  (scm_init_scmsigs): add features ITIMER_VIRTUAL and ITIMER_PROF
* test-suite/tests/asyncs.test ("prevention via sigprof"): throw when unsupported
* test-suite/tests/signals.test: throw when not supported
* test-suite/tests/statprof.test: throw when not supported
This commit is contained in:
Mike Gran 2017-03-06 23:06:12 -08:00
parent 4ce31fd387
commit 70cfabd7e8
7 changed files with 148 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

53
configure.ac
View file

@ -5,7 +5,7 @@ dnl
define(GUILE_CONFIGURE_COPYRIGHT,[[
Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016 Free Software Foundation, Inc.
2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Free Software Foundation, Inc.
This file is part of GUILE
@ -880,6 +880,57 @@ main (void)
esac
fi
# Cygwin and Hurd (circa 2017) and various prior versions defined stub
# versions of the virtual and profiling itimers that would always fail
# when called.
if test "$ac_cv_func_getitimer" = yes; then
AC_CACHE_CHECK([whether getitimer(ITIMER_PROF) is usable],
guile_cv_use_getitimer_prof,
[AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <sys/time.h>
int
main (void)
{
struct itimerval I;
if (getitimer (ITIMER_PROF, &I) == 0)
return 0; /* good */
else
return 1; /* bad */
}]])],
[guile_cv_use_getitimer_prof=yes],
[guile_cv_use_getitimer_prof=no],
[guile_cv_use_getitimer_prof="yes, hopefully (cross-compiling)"])])
case $guile_cv_use_getitimer_prof in
yes*)
AC_DEFINE([HAVE_USABLE_GETITIMER_PROF], 1, [Define to 1 if getitimer(ITIMER_PROF, ...) is functional])
;;
esac
AC_CACHE_CHECK([whether getitimer(ITIMER_VIRTUAL) is usable],
guile_cv_use_getitimer_virtual,
[AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <sys/time.h>
int
main (void)
{
struct itimerval I;
if (getitimer (ITIMER_VIRTUAL, &I) == 0)
return 0; /* good */
else
return 1; /* bad */
}]])],
[guile_cv_use_getitimer_virtual=yes],
[guile_cv_use_getitimer_virtual=no],
[guile_cv_use_getitimer_virtual="yes, hopefully (cross-compiling)"])])
case $guile_cv_use_getitimer_virtual in
yes*)
AC_DEFINE([HAVE_USABLE_GETITIMER_VIRTUAL], 1, [Define to 1 if getitimer(ITIMER_VIRTUAL, ...) is functional])
;;
esac
fi
AC_CACHE_SAVE
dnl GMP tests

15
doc/ref/posix.texi
View file

@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
@c 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node POSIX
@ -2162,12 +2162,12 @@ expiry will be signalled.
A real-time timer, counting down elapsed real time. At zero it raises
@code{SIGALRM}. This is like @code{alarm} above, but with a higher
resolution period.
@end defvar
@end defvar
@defvar ITIMER_VIRTUAL
A virtual-time timer, counting down while the current process is
actually using CPU. At zero it raises @code{SIGVTALRM}.
@end defvar
@end defvar
@defvar ITIMER_PROF
A profiling timer, counting down while the process is running (like
@ -2176,7 +2176,7 @@ process's behalf. At zero it raises a @code{SIGPROF}.
This timer is intended for profiling where a program is spending its
time (by looking where it is when the timer goes off).
@end defvar
@end defvar
@code{getitimer} returns the restart timer value and its current value,
as a list containing two pairs. Each pair is a time in seconds and
@ -2196,6 +2196,13 @@ previous setting, in the same form as @code{getitimer} returns.
Although the timers are programmed in microseconds, the actual
accuracy might not be that high.
Note that @code{ITIMER_PROF} and @code{ITIMER_VIRTUAL} are not
functional on all platforms and may always error when called.
@code{(provided? 'ITIMER_PROF)} and @code{(provided? 'ITIMER_VIRTUAL)}
can be used to test if the those itimers are supported on the given
host. @code{ITIMER_REAL} is supported on all platforms that support
@code{setitimer}.
@end deffn

12
doc/ref/statprof.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 2013, 2015 Free Software Foundation, Inc.
@c Copyright (C) 2013, 2015, 2017 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node Statprof
@ -128,17 +128,21 @@ After the @var{thunk} has been profiled, print out a profile to
@var{port}. If @var{display-style} is @code{flat}, the results will be
printed as a flat profile. Otherwise if @var{display-style} is
@code{tree}, print the results as a tree profile.
Note that @code{statprof} requires a working profiling timer. Some
platforms do not support profiling timers. @code{(provided?
'ITIMER_PROF)} can be used to check for support of profiling timers.
@end deffn
Profiling can also be enabled and disabled manually.
@deffn {Scheme Procedure} statprof-active?
@deffn {Scheme Procedure} statprof-active?
Returns @code{#t} if @code{statprof-start} has been called more times
than @code{statprof-stop}, @code{#f} otherwise.
@end deffn
@deffn {Scheme Procedure} statprof-start
@deffnx {Scheme Procedure} statprof-stop
@deffn {Scheme Procedure} statprof-start
@deffnx {Scheme Procedure} statprof-stop
Start or stop the profiler.
@end deffn

27
libguile/scmsigs.c
View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006,
* 2007, 2008, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
* 2007, 2008, 2009, 2011, 2013, 2014, 2017 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@ -554,7 +554,13 @@ SCM_DEFINE (scm_setitimer, "setitimer", 5, 0, 0,
"The return value will be a list of two cons pairs representing the\n"
"current state of the given timer. The first pair is the seconds and\n"
"microseconds of the timer @code{it_interval}, and the second pair is\n"
"the seconds and microseconds of the timer @code{it_value}.")
"the seconds and microseconds of the timer @code{it_value}."
"\n"
"@code{ITIMER_PROF} or @code{ITIMER_VIRTUAL} are not supported on\n"
"some platforms and will always error. @code{(provided? 'ITIMER_PROF)}\n"
"and @code{(provided? 'ITIMER_VIRTUAL)} report whether those timers\n"
"are supported.\n")
#define FUNC_NAME s_scm_setitimer
{
int rv;
@ -591,7 +597,12 @@ SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
"The return value will be a list of two cons pairs representing the\n"
"current state of the given timer. The first pair is the seconds and\n"
"microseconds of the timer @code{it_interval}, and the second pair is\n"
"the seconds and microseconds of the timer @code{it_value}.")
"the seconds and microseconds of the timer @code{it_value}."
"\n"
"@code{ITIMER_PROF} or @code{ITIMER_VIRTUAL} are not supported on\n"
"some platforms and will always error. @code{(provided? 'ITIMER_PROF)}\n"
"and @code{(provided? 'ITIMER_VIRTUAL)} report whether those timers\n"
"are supported.\n")
#define FUNC_NAME s_scm_getitimer
{
int rv;
@ -601,10 +612,10 @@ SCM_DEFINE (scm_getitimer, "getitimer", 1, 0, 0,
c_which_timer = SCM_NUM2INT(1, which_timer);
SCM_SYSCALL(rv = getitimer(c_which_timer, &old_timer));
if(rv != 0)
SCM_SYSERROR;
return scm_list_2 (scm_cons (scm_from_long (old_timer.it_interval.tv_sec),
scm_from_long (old_timer.it_interval.tv_usec)),
scm_cons (scm_from_long (old_timer.it_value.tv_sec),
@ -726,6 +737,12 @@ scm_init_scmsigs ()
scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL));
scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL));
scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF));
#ifdef HAVE_USABLE_GETITIMER_PROF
scm_add_feature ("ITIMER_PROF");
#endif
#ifdef HAVE_USABLE_GETITIMER_VIRTUAL
scm_add_feature ("ITIMER_VIRTUAL");
#endif
#endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */
#include "libguile/scmsigs.x"

5
test-suite/tests/asyncs.test
View file

@ -1,6 +1,6 @@
;;;; asyncs.test -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2016 Free Software Foundation, Inc.
;;;; Copyright (C) 2016, 2017 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -51,7 +51,8 @@
(setitimer ITIMER_PROF 0 0 0 0)
(sigaction SIGPROF prev-handler)))))
(when (defined? 'setitimer)
(when (and (defined? 'setitimer)
(provided? 'ITIMER_PROF))
(pass-if "preemption via sigprof"
;; Use an atomic box as a compiler barrier.
(let* ((box (make-atomic-box 0))

76
test-suite/tests/signals.test
View file

@ -1,17 +1,17 @@
;;;; signals.test --- test suite for Guile's signal functions -*- scheme -*-
;;;;
;;;; Copyright (C) 2009, 2014 Free Software Foundation, Inc.
;;;;
;;;;
;;;; Copyright (C) 2009, 2014, 2017 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free
;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
@ -41,39 +41,51 @@
(equal? (setitimer ITIMER_REAL 0 0 0 0)
'((0 . 0) (0 . 0))))
(pass-if "ITIMER_VIRTUAL"
(equal? (setitimer ITIMER_VIRTUAL 0 0 0 0)
'((0 . 0) (0 . 0))))
(if (not (provided? 'ITIMER_VIRTUAL))
(throw 'unsupported)
(equal? (setitimer ITIMER_VIRTUAL 0 0 0 0)
'((0 . 0) (0 . 0)))))
(pass-if "ITIMER_PROF"
(equal? (setitimer ITIMER_PROF 0 0 0 0)
'((0 . 0) (0 . 0)))))
(if (not (provided? 'ITIMER_PROF))
(throw 'unsupported)
(equal? (setitimer ITIMER_PROF 0 0 0 0)
'((0 . 0) (0 . 0))))))
(with-test-prefix "setting values correctly"
(pass-if "initial setting"
(equal? (setitimer ITIMER_PROF 1 0 3 0)
'((0 . 0) (0 . 0))))
(if (not (provided? 'ITIMER_PROF))
(throw 'unsupported)
(equal? (setitimer ITIMER_PROF 1 0 3 0)
'((0 . 0) (0 . 0)))))
(pass-if "reset to zero"
(match (setitimer ITIMER_PROF 0 0 0 0)
((interval value)
;; We don't presume that the timer is strictly lower than the
;; value at which we set it, given its limited internal
;; precision. Assert instead that the timer is between 2 and
;; 3.5 seconds.
(and (<= 0.9 (time-pair->secs interval) 1.1)
(<= 2.0 (time-pair->secs value) 3.5))))))
(if (not (provided? 'ITIMER_PROF))
(throw 'unsupported)
(match (setitimer ITIMER_PROF 0 0 0 0)
((interval value)
;; We don't presume that the timer is strictly lower than the
;; value at which we set it, given its limited internal
;; precision. Assert instead that the timer is between 2 and
;; 3.5 seconds.
(and (<= 0.9 (time-pair->secs interval) 1.1)
(<= 2.0 (time-pair->secs value) 3.5)))))))
(with-test-prefix "usecs > 1e6"
(pass-if "initial setting"
(equal? (setitimer ITIMER_PROF 1 0 0 #e3e6)
'((0 . 0) (0 . 0))))
(if (not (provided? 'ITIMER_PROF))
(throw 'unsupported)
(equal? (setitimer ITIMER_PROF 1 0 0 #e3e6)
'((0 . 0) (0 . 0)))))
(pass-if "reset to zero"
(match (setitimer ITIMER_PROF 0 0 0 0)
((interval value)
;; We don't presume that the timer is strictly lower than the
;; value at which we set it, given its limited internal
;; precision. Assert instead that the timer is between 2 and
;; 3.5 seconds.
(and (<= 0.9 (time-pair->secs interval) 1.1)
(<= 2.0 (time-pair->secs value) 3.5)
(match value
((secs . usecs)
(<= 0 usecs 999999))))))))))
(if (not (provided? 'ITIMER_PROF))
(throw 'unsupported)
(match (setitimer ITIMER_PROF 0 0 0 0)
((interval value)
;; We don't presume that the timer is strictly lower than the
;; value at which we set it, given its limited internal
;; precision. Assert instead that the timer is between 2 and
;; 3.5 seconds.
(and (<= 0.9 (time-pair->secs interval) 1.1)
(<= 2.0 (time-pair->secs value) 3.5)
(match value
((secs . usecs)
(<= 0 usecs 999999)))))))))))

15
test-suite/tests/statprof.test
View file

@ -1,4 +1,5 @@
;; guile-lib -*- scheme -*-
;;;; statprof.test --- test suite for Guile's profiler -*- scheme -*-
;;;; Copyright (C) 2017 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2009, 2010, 2014 Andy Wingo <wingo at pobox dot com>
;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
@ -31,9 +32,9 @@
#:use-module (srfi srfi-1)
#:use-module (statprof))
;; Throw `unresolved' upon ENOSYS. This is used to skip tests on
;; platforms such as GNU/Hurd where `ITIMER_PROF' is is currently
;; unimplemented.
;; Throw `unresolved' upon ENOSYS or EINVAL. This is used to skip tests
;; on platforms such as GNU/Hurd or Cygwin where `ITIMER_PROF' is is
;; currently unimplemented.
(define-syntax-rule (when-implemented body ...)
(catch 'system-error
(lambda ()
@ -41,7 +42,7 @@
(lambda args
(let ((errno (system-error-errno args)))
(false-if-exception (statprof-stop))
(if (= errno ENOSYS)
(if (or (= errno ENOSYS) (= errno EINVAL))
(throw 'unresolved)
(apply throw args))))))
@ -125,7 +126,7 @@
(define do-nothing
(compile '(lambda (n)
(simple-format #f "FOO ~A\n" (+ n n)))))
;; Run test.
(statprof-reset 0 50000 #t #f)
(statprof-start)
@ -136,7 +137,7 @@
(loop (- x 1))
#t)))
(statprof-stop)
;; Check result.
(let ((proc-data (statprof-proc-call-data do-nothing)))
(and proc-data