Re: Stack calibration

["Neil Jerram" <neiljerram@googlemail.com>]

[-- Attachment #1: Type: text/plain, Size: 490 bytes --]

2008/10/12 Neil Jerram <neiljerram@googlemail.com>:
>
> So yes, I think we can actually do this without any change to the C
> code except adding %get-stack-depth, by using an evaluator trap.
>>
>> As Greg suggested, this could be in `check_DATA' or something like that.
>
> Yes, but thanks for the more specific hint!
>
>> I'd tend to use the actual GNU triplet, like `i386-pc-linux-gnu'.
>
> OK, will do.

Here's the new patch.  Please (as ever!) let me know what you think.

        Neil

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Stack-calibration-mark-3.patch --]
[-- Type: text/x-patch; name=0001-Stack-calibration-mark-3.patch, Size: 15380 bytes --]

From ff700bf19cf787a34a7a4f5c16b0403c4221e547 Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Sun, 12 Oct 2008 22:11:01 +0100
Subject: [PATCH] Stack calibration mark 3

---
 .gitignore                             |    1 +
 check-guile.in                         |    1 +
 configure.in                           |    2 +
 libguile/Makefile.am                   |   23 ++++++
 libguile/measure-hwm.scm               |  136 ++++++++++++++++++++++++++++++++
 libguile/stackchk.c                    |   12 +++
 libguile/stackchk.h                    |    1 +
 test-suite/standalone/test-use-srfi    |   67 ----------------
 test-suite/standalone/test-use-srfi.in |   67 ++++++++++++++++
 9 files changed, 243 insertions(+), 67 deletions(-)
 create mode 100644 libguile/measure-hwm.scm
 delete mode 100755 test-suite/standalone/test-use-srfi
 create mode 100755 test-suite/standalone/test-use-srfi.in

diff --git a/.gitignore b/.gitignore
index a122176..39c4b49 100644
--- a/.gitignore
+++ b/.gitignore
@@ -70,3 +70,4 @@ guile-readline/guile-readline-config.h
 guile-readline/guile-readline-config.h.in
 TAGS
 guile-1.8.pc
+stack-limit-calibration.scm
diff --git a/check-guile.in b/check-guile.in
index f66bf13..9ee2ea3 100644
--- a/check-guile.in
+++ b/check-guile.in
@@ -41,6 +41,7 @@ if [ ! -f guile-procedures.txt ] ; then
 fi
 
 exec $guile \
+    -l ${top_builddir}/libguile/stack-limit-calibration.scm \
     -e main -s "$TEST_SUITE_DIR/guile-test" \
     --test-suite "$TEST_SUITE_DIR/tests" \
     --log-file check-guile.log "$@"
diff --git a/configure.in b/configure.in
index 713e634..e77f460 100644
--- a/configure.in
+++ b/configure.in
@@ -1564,6 +1564,8 @@ AC_CONFIG_FILES([libguile/guile-func-name-check],
                 [chmod +x libguile/guile-func-name-check])
 AC_CONFIG_FILES([libguile/guile-snarf-docs],
                 [chmod +x libguile/guile-snarf-docs])
+AC_CONFIG_FILES([test-suite/standalone/test-use-srfi],
+                [chmod +x test-suite/standalone/test-use-srfi])
 
 AC_OUTPUT
 
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index eb76237..d44c5ca 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -313,6 +313,29 @@ guile-procedures.txt: guile-procedures.texi
 
 endif
 
+# Stack limit calibration for `make check'.  (For why we do this, see
+# the comments in measure-hwm.scm.)  We're relying here on a couple of
+# bits of Automake magic.
+#
+# 1. The fact that "libguile" comes before "test-suite" in SUBDIRS in
+# our toplevel Makefile.am.  This ensures that the
+# stack-limit-calibration.scm "test" will be run before any of the
+# tests under test-suite.
+#
+# 2. The fact that each test is invoked as $TESTS_ENVIRONMENT $test.
+# This allows us to ensure that the test will be considered to have
+# passed, by using `true' as TESTS_ENVIRONMENT.
+#
+# Why don't we care about the test "actually passing"?  Because the
+# important thing about stack-limit-calibration.scm is just that it is
+# generated in the first place, so that other tests under test-suite
+# can use it.
+TESTS = stack-limit-calibration.scm
+TESTS_ENVIRONMENT = true
+
+stack-limit-calibration.scm: measure-hwm.scm guile$(EXEEXT)
+	$(preinstguile) -s measure-hwm.scm > $@
+
 c-tokenize.c: c-tokenize.lex
 	flex -t $(srcdir)/c-tokenize.lex > $@ || { rm $@; false; }
 
diff --git a/libguile/measure-hwm.scm b/libguile/measure-hwm.scm
new file mode 100644
index 0000000..364740b
--- /dev/null
+++ b/libguile/measure-hwm.scm
@@ -0,0 +1,136 @@
+;;;; Copyright (C) 2008 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 2.1 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, Boston, MA 02110-1301 USA
+;;;;
+
+;;; Commentary:
+
+;;; This code is run during the Guile build, in order to set the stack
+;;; limit to a value that will allow the `make check' tests to pass,
+;;; taking into account the average stack usage on the build platform.
+;;; For more detail, see the text below that gets written out to the
+;;; stack limit calibration file.
+
+;;; Code:
+
+;; Store off Guile's default stack limit.
+(define default-stack-limit (cadr (memq 'stack (debug-options))))
+
+;; Now disable the stack limit, so that we don't get a stack overflow
+;; while running this code!
+(debug-set! stack 0)
+
+;; Define a variable to hold the measured stack high water mark (HWM).
+(define top-repl-hwm-measured 0)
+
+;; Install an evaluator trap to measure the stack size at every
+;; evaluation step, and increase top-repl-hwm-measured if it is less
+;; than the measured stack size.
+(use-modules (ice-9 debugging traps)
+	     (oop goops))
+(install-trap (make <entry-trap>
+		#:behaviour (lambda (trap-context)
+			      (let ((stack-size (%get-stack-size)))
+				(if (< top-repl-hwm-measured stack-size)
+				    (set! top-repl-hwm-measured stack-size))))))
+
+;; Call (turn-on-debugging) and (top-repl) in order to simulate as
+;; closely as possible what happens - and in particular, how much
+;; stack is used - when a standard Guile REPL is started up.
+;;
+;; `make check' stack overflow errors have been reported in the past
+;; for:
+;;
+;; - test-suite/standalone/test-use-srfi, which runs `guile -q
+;;   --use-srfi=...' a few times, with standard input for the REPL
+;;   coming from a shell script
+;;
+;; - test-suite/tests/elisp.test, which does not involve the REPL, but
+;;   has a lot of `use-modules' calls.
+;;
+;; Stack high water mark (HWM) measurements show that the HWM is
+;; higher in the test-use-srfi case - specifically because of the
+;; complexity of (top-repl) - so that is what we simulate for our
+;; calibration model here.
+(turn-on-debugging)
+(with-output-to-port (%make-void-port "w")
+  (lambda ()
+    (with-input-from-string "\n" top-repl)))
+
+;; top-repl-hwm-measured now contains the stack HWM that resulted from
+;; running that code.
+
+;; This is the value of top-repl-hwm-measured that we get on a
+;; `canonical' build platform.  (See text below for what that means.)
+(define top-repl-hwm-i686-pc-linux-gnu 9685)
+
+;; Using the above results, output code that tests can run in order to
+;; configure the stack limit correctly for the current build platform.
+(format #t "\
+;; Stack limit calibration file.
+;;
+;; This file is automatically generated by Guile when it builds, in
+;; order to set the stack limit to a value that reflects the stack
+;; usage of the build platform (OS + compiler + compilation options),
+;; specifically so that none of Guile's own tests (which are run by
+;; `make check') fail because of a benign stack overflow condition.
+;;
+;; By a `benign' stack overflow condition, we mean one where the test
+;; code is behaving correctly, but exceeds the configured stack limit
+;; because the limit is set too low.  A non-benign stack overflow
+;; condition would be if a piece of test code behaved significantly
+;; differently on some platform to how it does normally, and as a
+;; result consumed a lot more stack.  Although they seem pretty
+;; unlikely, we would want to catch non-benign conditions like this,
+;; and that is why we don't just do `(debug-set! stack 0)' when
+;; running `make check'.
+;;
+;; Although the primary purpose of this file is to prevent `make
+;; check' from failing without good reason, Guile developers and users
+;; may also find the following information useful, when determining
+;; what stack limit to configure for their own programs.
+
+ (let (;; The stack high water mark measured when starting up the
+       ;; standard Guile REPL on the current build platform.
+       (top-repl-hwm-measured ~a)
+
+       ;; The value of top-repl-hwm-measured that we get when building
+       ;; Guile on an i686 PC GNU/Linux system, after configuring with
+       ;; `./configure --enable-maintainer-mode --with-threads'.
+       ;; (Hereafter referred to as the `canonical' build platform.)
+       (top-repl-hwm-i686-pc-linux-gnu ~a)
+
+       ;; Guile's default stack limit (i.e. the initial, C-coded value
+       ;; of the 'stack debug option).  In the context of this file,
+       ;; the important thing about this number is that we know that
+       ;; it allows all of the `make check' tests to pass on the
+       ;; canonical build platform.
+       (default-stack-limit ~a)
+
+       ;; Calibrated stack limit.  This is the default stack limit,
+       ;; scaled by the factor between top-repl-hwm-i686-pc-linux-gnu
+       ;; and top-repl-hwm-measured.
+       (calibrated-stack-limit ~a))
+
+   ;; Configure the calibrated stack limit.
+   (debug-set! stack calibrated-stack-limit))
+"
+	top-repl-hwm-measured
+	top-repl-hwm-i686-pc-linux-gnu
+	default-stack-limit
+	;; Use quotient here to get an integer result, rather than a
+	;; rational.
+	(quotient (* default-stack-limit top-repl-hwm-measured)
+		  top-repl-hwm-i686-pc-linux-gnu))
diff --git a/libguile/stackchk.c b/libguile/stackchk.c
index 391ce21..10a5e3f 100644
--- a/libguile/stackchk.c
+++ b/libguile/stackchk.c
@@ -24,6 +24,7 @@
 #include "libguile/_scm.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
+#include "libguile/threads.h"
 
 #include "libguile/stackchk.h"
 \f
@@ -78,6 +79,17 @@ scm_stack_report ()
   scm_puts ("\n", port);
 }
 
+
+SCM_DEFINE (scm_sys_get_stack_size, "%get-stack-size", 0, 0, 0,
+	    (),
+	    "Return the current thread's C stack size (in units of sizeof (SCM_STACKITEM *)).")
+#define FUNC_NAME s_scm_sys_get_stack_size
+{
+  return scm_from_long (scm_stack_size (SCM_I_CURRENT_THREAD->base));
+}
+#undef FUNC_NAME
+
+
 void
 scm_init_stackchk ()
 {
diff --git a/libguile/stackchk.h b/libguile/stackchk.h
index 9a5c59f..c094e03 100644
--- a/libguile/stackchk.h
+++ b/libguile/stackchk.h
@@ -60,6 +60,7 @@ SCM_API int scm_stack_checking_enabled_p;
 SCM_API void scm_report_stack_overflow (void);
 SCM_API long scm_stack_size (SCM_STACKITEM *start);
 SCM_API void scm_stack_report (void);
+SCM_API SCM scm_sys_get_stack_size (void);
 SCM_API void scm_init_stackchk (void);
 
 #endif  /* SCM_STACKCHK_H */
diff --git a/test-suite/standalone/test-use-srfi b/test-suite/standalone/test-use-srfi
deleted file mode 100755
index 7186b5a..0000000
--- a/test-suite/standalone/test-use-srfi
+++ /dev/null
@@ -1,67 +0,0 @@
-#!/bin/sh
-
-# Copyright (C) 2006 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 2.1 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, Boston, MA 02110-1301 USA
-
-
-# Test that two srfi numbers on the command line work.
-#
-guile -q --use-srfi=1,10 >/dev/null <<EOF
-(if (and (defined? 'partition)
-         (defined? 'define-reader-ctor))
-    (exit 0)   ;; good
-    (exit 1))  ;; bad
-EOF
-if test $? = 0; then :; else
-  echo "guile --use-srfi=1,10 fails to run"
-  exit 1
-fi
-
-
-# Test that running "guile --use-srfi=1" leaves the interactive REPL with
-# the srfi-1 version of iota.
-#
-# In guile 1.8.1 and earlier, and 1.6.8 and earlier, these failed because in
-# `top-repl' the core bindings got ahead of anything --use-srfi gave.
-#
-
-guile -q --use-srfi=1 >/dev/null <<EOF
-(catch #t
-  (lambda ()
-    (iota 2 3 4))
-  (lambda args
-    (exit 1))) ;; bad
-(exit 0)       ;; good
-EOF
-if test $? = 0; then :; else
-  echo "guile --use-srfi=1 doesn't give SRFI-1 iota"
-  exit 1
-fi
-
-
-# Similar test on srfi-17 car, which differs in being a #:replacement.  This
-# exercises duplicates handling in `top-repl' versus `use-srfis' (in
-# boot-9.scm).
-#
-guile -q --use-srfi=17 >/dev/null <<EOF
-(if (procedure-with-setter? car)
-    (exit 0)   ;; good
-    (exit 1))  ;; bad
-EOF
-if test $? = 0; then :; else
-  echo "guile --use-srfi=17 doesn't give SRFI-17 car"
-  exit 1
-fi
diff --git a/test-suite/standalone/test-use-srfi.in b/test-suite/standalone/test-use-srfi.in
new file mode 100755
index 0000000..57f84af
--- /dev/null
+++ b/test-suite/standalone/test-use-srfi.in
@@ -0,0 +1,67 @@
+#!/bin/sh
+
+# Copyright (C) 2006 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 2.1 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, Boston, MA 02110-1301 USA
+
+
+# Test that two srfi numbers on the command line work.
+#
+guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm --use-srfi=1,10 >/dev/null <<EOF
+(if (and (defined? 'partition)
+         (defined? 'define-reader-ctor))
+    (exit 0)   ;; good
+    (exit 1))  ;; bad
+EOF
+if test $? = 0; then :; else
+  echo "guile --use-srfi=1,10 fails to run"
+  exit 1
+fi
+
+
+# Test that running "guile --use-srfi=1" leaves the interactive REPL with
+# the srfi-1 version of iota.
+#
+# In guile 1.8.1 and earlier, and 1.6.8 and earlier, these failed because in
+# `top-repl' the core bindings got ahead of anything --use-srfi gave.
+#
+
+guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm --use-srfi=1 >/dev/null <<EOF
+(catch #t
+  (lambda ()
+    (iota 2 3 4))
+  (lambda args
+    (exit 1))) ;; bad
+(exit 0)       ;; good
+EOF
+if test $? = 0; then :; else
+  echo "guile --use-srfi=1 doesn't give SRFI-1 iota"
+  exit 1
+fi
+
+
+# Similar test on srfi-17 car, which differs in being a #:replacement.  This
+# exercises duplicates handling in `top-repl' versus `use-srfis' (in
+# boot-9.scm).
+#
+guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm --use-srfi=17 >/dev/null <<EOF
+(if (procedure-with-setter? car)
+    (exit 0)   ;; good
+    (exit 1))  ;; bad
+EOF
+if test $? = 0; then :; else
+  echo "guile --use-srfi=17 doesn't give SRFI-17 car"
+  exit 1
+fi
-- 
1.5.6.5