[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Check for working profiling and virtual itimers
|
From: |
Mike Gran |
|
Subject: |
[Guile-commits] 01/01: Check for working profiling and virtual itimers |
|
Date: |
Tue, 7 Mar 2017 09:42:59 -0500 (EST) |
mike121 pushed a commit to branch master
in repository guile.
commit 70cfabd7e87f93d210bad377feb7ca50fa3bd133
Author: Mike Gran <address@hidden>
Date: Mon Mar 6 23:06:12 2017 -0800
Check for working profiling and virtual itimers
* 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
---
configure.ac | 53 ++++++++++++++++++++++++++++-
doc/ref/posix.texi | 15 ++++++---
doc/ref/statprof.texi | 12 ++++---
libguile/scmsigs.c | 27 ++++++++++++---
test-suite/tests/asyncs.test | 5 +--
test-suite/tests/signals.test | 76 ++++++++++++++++++++++++------------------
test-suite/tests/statprof.test | 15 +++++----
7 files changed, 148 insertions(+), 55 deletions(-)
diff --git a/configure.ac b/configure.ac
index 8c90d3f..24ee878 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 64e668d..5cb68a2 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -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,
address@hidden 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
address@hidden 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.
address@hidden defvar
address@hidden defvar
@defvar ITIMER_VIRTUAL
A virtual-time timer, counting down while the current process is
actually using CPU. At zero it raises @code{SIGVTALRM}.
address@hidden defvar
address@hidden 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).
address@hidden defvar
address@hidden 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.
address@hidden(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
address@hidden
@end deffn
diff --git a/doc/ref/statprof.texi b/doc/ref/statprof.texi
index 65f0d47..850c5bd 100644
--- a/doc/ref/statprof.texi
+++ b/doc/ref/statprof.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 2013, 2015 Free Software Foundation, Inc.
address@hidden 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.
address@hidden {Scheme Procedure} statprof-active?
address@hidden {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
address@hidden {Scheme Procedure} statprof-start
address@hidden {Scheme Procedure} statprof-stop
address@hidden {Scheme Procedure} statprof-start
address@hidden {Scheme Procedure} statprof-stop
Start or stop the profiler.
@end deffn
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index f210380..21b2a95 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -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"
diff --git a/test-suite/tests/asyncs.test b/test-suite/tests/asyncs.test
index 437927a..4ac9020 100644
--- a/test-suite/tests/asyncs.test
+++ b/test-suite/tests/asyncs.test
@@ -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))
diff --git a/test-suite/tests/signals.test b/test-suite/tests/signals.test
index ef61aaa..ac730a9 100644
--- a/test-suite/tests/signals.test
+++ b/test-suite/tests/signals.test
@@ -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)))))))))))
diff --git a/test-suite/tests/statprof.test b/test-suite/tests/statprof.test
index a597f31..994d882 100644
--- a/test-suite/tests/statprof.test
+++ b/test-suite/tests/statprof.test
@@ -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