Re: Stack calibration

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

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

Hi there,

2008/9/12 Ludovic Courtès <ludo@gnu.org>:
>
> That's the second important thing that should go in 1.8.6 IMO.

Cool...

>> +  /* x1 and x2 are the stack depth values that we get on a Debian
>> +     GNU/Linux ia32 system - which we take as our canonical system.
>> +     y1 and y2 are the values measured on the system where Guile is
>> +     currently running. */
>> +  int x1 = 170, x2 = 690, y1, y2;
>
> These results are dependent on what the loop in `boot-9.scm' does.
> Thus, it'd be nicer if they weren't that far away from it.

Agreed, and I think I've addressed this in my latest version (below).

> It might be worth mentioning the GCC version and optimization level that
> led to this result.

Good idea, will do.  (This isn't yet in the attached patch.)

> Also, `x1' and `x2' can be made "static const" or some such.

In the new version, they are #defines.

>> +  SCM_VALIDATE_INT_COPY (1, d1, y1);
>> +  SCM_VALIDATE_INT_COPY (2, d2, y2);
>> +
>> +  calibrated_m = ((double) (y2 - y1)) / (x2 - x1);
>> +  calibrated_c = ((double) y2) - calibrated_m * x2;
>
> Shouldn't it be:
>
>  calibrated_c = y1 - x1;

No, don't think so!  My model equation is y = mx + c, so c = y - mx.

> Also, the computation of `calibrated_m' needs more casts to `double' I
> think.

I don't think so, and this hasn't changed in the new version.  Where
and why do you think more casts are needed?

> Could it be moved to a `%print-stack-calibration' function that we'd use
> for troubleshooting?

Yes.  In the attached patch, I've left this out completely, but I
think we should add it back in as %get-stack-calibration.

> How about entirely removing the startup overhead by computing the
> calibration factors only once, at installation time?
>
> This would mean:
>
>  1. Compile all of Guile with the default calibration factors (m = 1
>     and c = 0).

Agreed.

>  2. Run a Scheme script that computes `m' and `c' and produces, say,
>     `calibration.h', which is included by `stackchk.c'.  Both the
>     computation and the reference stack depths (`x1' and `x2' above)
>     would live in this script, which is clearer IMO.

Agreed, see new libguile/calibrate.scm file.

>  3. Invoke `make' recursively, which should rebuild libguile with the
>     appropriate calibration factor (typically, only `stackchk.lo' would
>     need to be recompiled).

I've done this part a bit differently - see the libguile/Makefile.am
changes - because I couldn't see exactly how the recursive make
approach would work.  If you think recursive make would be
significantly better, can you describe or propose the detailed changes
that would be needed?

> Also, the on-line and Texi documentation of `eval-options' must be
> updated to specify that the stack depth unit is "abstract" and
> (hopefully) portable across platforms.

I will do this (and also NEWS), but let's agree all the code first.

Many thanks for your detailed review, BTW!

Regards,
      Neil

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Avoid-stack-overflow-errors.patch --]
[-- Type: text/x-patch; name=0001-Avoid-stack-overflow-errors.patch, Size: 15738 bytes --]

From 6f84b52bd76e2777dbfddcda571f52dbc82895f3 Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Sat, 27 Sep 2008 19:08:07 +0100
Subject: [PATCH] Avoid stack overflow errors

... when building and testing Guile, by adjusting Guile's stack
overflow algorithm for the actual average depth of stack per eval call
that the build platform uses.

To avoid a penalty at runtime when using an installed Guile, we build
Guile in two stages.  An "uncalibrated" Guile (uguile) is built with
an arbitrary assumption about the platform's stack usage.  Then we use
uguile to run a Scheme script that measures actual stack usage, and
generates a modified C source file (stackchk-calibrated.c) that
contains these measurements.  Then we build a properly calibrated
Guile, from sources that include stackchk-calibrated.c.

* am/pre-inst-guile (preinstuguile, preinstuguiletool): New
  definitions.

* configure.in (UGUILE_FOR_BUILD): Set up in the same way as
  GUILE_FOR_BUILD.
  (pre-inst-uguile): Generate, from pre-inst-uguile.in.

* libguile/Makefile.am (noinst_PROGRAMS): Add uguile.
  (noinst_LTLIBRARIES): New, containing libuguile.la.
  (uguile_LDADD, uguile_CFLAGS, uguile_LDADD, uguile_LDFLAGS): New.
  (LIBGUILE_SOURCES): New, containing what used to be in libguile_la_SOURCES, minus stackchk.c.
  (libguile_la_SOURCES): Changed to LIBGUILE_SOURCES + stackchk-calibrated.c.
  (libuguile_la_CFLAGS): New.
  (libuguile_la_SOURCES): New, LIBGUILE_SOURCES + stackchk.c
  (EXTRA_libuguile_la_SOURCES): New, same as EXTRA_libguile_la_SOURCES.
  (libuguile_la_DEPENDENCIES, libuguile_la_LIBADD,
  libuguile_la_LDFLAGS): New, same as corresponding libguile*
  definitions.
  (stackchk-calibrated.c): New, built by uncalibrated guile.

* libguile/calibrate.scm: New, to generate stack calibration
  measurements.

* libguile/debug.h (SCM_RESET_DEBUG_MODE): Add
  scm_calculate_stack_limit () call.

* libguile/stackchk.c (scm_stack_limit, calibrated_m, calibrated_c):
  New variables.
  (scm_sys_get_stack_depth, scm_calculate_stack_limit): New functions.
  (scm_init_stackchk): If possible, calculate non-default values for
  calibrated_c and calibrated_m.  Also call scm_calculate_stack_limit ().

* libguile/stackchk.h (SCM_STACK_OVERFLOW_P): Rewrite to use
  scm_stack_limit instead of SCM_STACK_LIMIT.
  (scm_stack_limit, scm_sys_get_stack_depth,
  scm_calculate_stack_limit): New declarations.

* pre-inst-uguile.in: New file, just like pre-inst-guile.in, but to
  run the uncalibrated Guile instead of the calibrated one.
---
 am/pre-inst-guile      |    3 +
 configure.in           |   16 ++++++++
 libguile/Makefile.am   |   28 ++++++++++++-
 libguile/calibrate.scm |   32 +++++++++++++++
 libguile/debug.h       |    1 +
 libguile/stackchk.c    |   34 ++++++++++++++++
 libguile/stackchk.h    |   12 +++---
 pre-inst-uguile.in     |   99 ++++++++++++++++++++++++++++++++++++++++++++++++
 8 files changed, 216 insertions(+), 9 deletions(-)
 create mode 100644 libguile/calibrate.scm
 create mode 100644 pre-inst-uguile.in

diff --git a/am/pre-inst-guile b/am/pre-inst-guile
index c1a7407..35ba6c3 100644
--- a/am/pre-inst-guile
+++ b/am/pre-inst-guile
@@ -31,4 +31,7 @@
 preinstguile     = $(top_builddir_absolute)/pre-inst-guile
 preinstguiletool = GUILE="$(preinstguile)" $(top_srcdir)/scripts
 
+preinstuguile     = $(top_builddir_absolute)/pre-inst-uguile
+preinstuguiletool = GUILE="$(preinstuguile)" $(top_srcdir)/scripts
+
 ## am/pre-inst-guile ends here
diff --git a/configure.in b/configure.in
index 713e634..35118cf 100644
--- a/configure.in
+++ b/configure.in
@@ -1413,6 +1413,21 @@ if test "$cross_compiling" = "yes"; then
 fi
 AC_ARG_VAR(GUILE_FOR_BUILD,[guile for build system])
 AC_SUBST(GUILE_FOR_BUILD)
+
+if test "$cross_compiling" = "yes"; then
+  AC_MSG_CHECKING(uncalibrated guile for build)
+  UGUILE_FOR_BUILD="${UGUILE_FOR_BUILD-uguile}"
+else
+  UGUILE_FOR_BUILD='$(preinstuguile)'
+fi   
+
+## AC_MSG_CHECKING("if we are cross compiling")
+## AC_MSG_RESULT($cross_compiling)
+if test "$cross_compiling" = "yes"; then
+   AC_MSG_RESULT($UGUILE_FOR_BUILD)
+fi
+AC_ARG_VAR(UGUILE_FOR_BUILD,[uncalibrated guile for build system])
+AC_SUBST(UGUILE_FOR_BUILD)
   			
 ## If we're using GCC, ask for aggressive warnings.
 case "$GCC" in
@@ -1556,6 +1571,7 @@ AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile])
 AC_CONFIG_FILES([guile-tools], [chmod +x guile-tools])
 AC_CONFIG_FILES([pre-inst-guile], [chmod +x pre-inst-guile])
 AC_CONFIG_FILES([pre-inst-guile-env], [chmod +x pre-inst-guile-env])
+AC_CONFIG_FILES([pre-inst-uguile], [chmod +x pre-inst-uguile])
 AC_CONFIG_FILES([libguile/guile-snarf],
                 [chmod +x libguile/guile-snarf])
 AC_CONFIG_FILES([libguile/guile-doc-snarf],
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index eb76237..4398e14 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -40,7 +40,8 @@ ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_L
 lib_LTLIBRARIES = libguile.la
 bin_PROGRAMS = guile
 
-noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig
+noinst_LTLIBRARIES = libuguile.la
+noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig uguile
 
 gen_scmconfig_SOURCES = gen-scmconfig.c
 
@@ -96,9 +97,14 @@ guile_CFLAGS = $(GUILE_CFLAGS)
 guile_LDADD = libguile.la
 guile_LDFLAGS = @DLPREOPEN@ $(GUILE_CFLAGS)
 
+uguile_SOURCES = guile.c
+uguile_CFLAGS = $(GUILE_CFLAGS)
+uguile_LDADD = libuguile.la
+uguile_LDFLAGS = @DLPREOPEN@ $(GUILE_CFLAGS)
+
 libguile_la_CFLAGS = $(GUILE_CFLAGS)
 
-libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
+LIBGUILE_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
     chars.c continuations.c convert.c debug.c deprecation.c		\
     deprecated.c discouraged.c dynwind.c environments.c eq.c error.c	\
     eval.c evalext.c extensions.c feature.c fluids.c fports.c		\
@@ -110,11 +116,17 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
     modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c	\
     print.c procprop.c procs.c properties.c random.c rdelim.c read.c	\
     root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c	\
-    stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c	\
+    stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c	        \
     strorder.c strports.c struct.c symbols.c threads.c null-threads.c	\
     throw.c values.c variable.c vectors.c version.c vports.c weaks.c	\
     ramap.c unif.c
 
+libguile_la_SOURCES = stackchk-calibrated.c $(LIBGUILE_SOURCES)
+
+libuguile_la_CFLAGS = $(GUILE_CFLAGS)
+
+libuguile_la_SOURCES = stackchk.c $(LIBGUILE_SOURCES)
+
 DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
     continuations.x debug.x deprecation.x deprecated.x discouraged.x	\
     dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x	\
@@ -162,6 +174,8 @@ EXTRA_libguile_la_SOURCES = _scm.h		\
     debug-malloc.c mkstemp.c	\
     win32-uname.c win32-dirent.c win32-socket.c
 
+EXTRA_libuguile_la_SOURCES = $(EXTRA_libguile_la_SOURCES)
+
 ## delete guile-snarf.awk from the installation bindir, in case it's
 ## lingering there due to an earlier guile version not having been
 ## wiped out.
@@ -183,6 +197,10 @@ libguile_la_DEPENDENCIES = @LIBLOBJS@
 libguile_la_LIBADD = @LIBLOBJS@
 libguile_la_LDFLAGS = @LTLIBINTL@ -version-info @LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGUILE_INTERFACE_AGE@ -export-dynamic -no-undefined
 
+libuguile_la_DEPENDENCIES = $(libguile_la_DEPENDENCIES)
+libuguile_la_LIBADD = $(libguile_la_LIBADD)
+libuguile_la_LDFLAGS = $(libguile_la_LDFLAGS)
+
 # These are headers visible as <guile/mumble.h>
 pkginclude_HEADERS = gh.h
 
@@ -294,6 +312,10 @@ alldotdocfiles    = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
 snarf2checkedtexi = GUILE="$(GUILE_FOR_BUILD)" $(top_srcdir)/scripts/snarf-check-and-output-texi
 dotdoc2texi       = cat $(alldotdocfiles) | $(snarf2checkedtexi)
 
+stackchk-calibrated.c: uguile$(EXEEXT)
+	$(UGUILE_FOR_BUILD) -s calibrate.scm > $@
+	cat stackchk.c >> $@
+
 guile.texi: $(alldotdocfiles) guile$(EXEEXT)
 	$(dotdoc2texi) --manual > $@ || { rm $@; false; }
 
diff --git a/libguile/calibrate.scm b/libguile/calibrate.scm
new file mode 100644
index 0000000..39abc7b
--- /dev/null
+++ b/libguile/calibrate.scm
@@ -0,0 +1,32 @@
+
+;;; Stack depth calibration, for the 'stack debug option.
+
+;; Make sure we don't overflow while performing this calibration!
+(debug-set! stack 0)
+
+;; Select the debugging evaluator.
+(debug-enable 'debug)
+
+;; Note that this loop must be non-tail-recursive!  170 and 690 are
+;; the values that we get for measured-depth1 and measured-depth2 when
+;; we run this code on a Debian GNU/Linux ia32 system - which we take
+;; as our canonical system.
+(let ((reference-depth1 170)
+      (reference-depth2 690)
+      (measured-depth1 (%get-stack-depth))
+      (measured-depth2 0))
+  (let loop ((count 10))
+    (if (zero? count)
+	(set! measured-depth2 (%get-stack-depth))
+	(cons count (loop (- count 1)))))
+  (format #t
+	  "
+#define GUILE_CALIBRATION_REFERENCE_DEPTH_1 ~a
+#define GUILE_CALIBRATION_REFERENCE_DEPTH_2 ~a
+#define GUILE_CALIBRATION_MEASURED_DEPTH_1 ~a
+#define GUILE_CALIBRATION_MEASURED_DEPTH_2 ~a
+"
+	  reference-depth1
+	  reference-depth2
+	  measured-depth1
+	  measured-depth2))
diff --git a/libguile/debug.h b/libguile/debug.h
index c292004..f6b1608 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -75,6 +75,7 @@ do {\
     && scm_is_true (SCM_EXIT_FRAME_HDLR);\
   scm_debug_mode_p = SCM_DEVAL_P\
     || scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\
+  scm_calculate_stack_limit ();\
 } while (0)
 
 /* {Evaluator}
diff --git a/libguile/stackchk.c b/libguile/stackchk.c
index 391ce21..f770822 100644
--- a/libguile/stackchk.c
+++ b/libguile/stackchk.c
@@ -33,6 +33,13 @@
 
 #ifdef STACK_CHECKING
 int scm_stack_checking_enabled_p;
+int scm_stack_limit;
+
+/* As in y = mx + c.  These numbers define a linear transformation
+   from the stack depth specified as the 'stack debug option, to the
+   actual max stack depth that we allow. */
+static double calibrated_m = 1;
+static double calibrated_c = 0;
 
 SCM_SYMBOL (scm_stack_overflow_key, "stack-overflow");
 
@@ -47,6 +54,24 @@ scm_report_stack_overflow ()
 	     SCM_BOOL_F);
 }
 
+/* Stack depth calibration. */
+
+SCM_DEFINE (scm_sys_get_stack_depth, "%get-stack-depth", 0, 0, 0,
+	    (),
+	    "Return current stack depth.")
+#define FUNC_NAME s_scm_sys_get_stack_depth
+{
+  SCM_STACKITEM stack;
+  return scm_from_int (SCM_STACK_DEPTH (&stack));
+}
+#undef FUNC_NAME
+
+void
+scm_calculate_stack_limit ()
+{
+  scm_stack_limit = (int) (calibrated_m * SCM_STACK_LIMIT + calibrated_c);
+}
+
 #endif
 
 long
@@ -81,6 +106,15 @@ scm_stack_report ()
 void
 scm_init_stackchk ()
 {
+#ifdef GUILE_CALIBRATION_MEASURED_DEPTH_1
+  /* Calculate calibrated stack depth limit. */
+  calibrated_m = ((double) (GUILE_CALIBRATION_MEASURED_DEPTH_2 - GUILE_CALIBRATION_MEASURED_DEPTH_1))
+    / (GUILE_CALIBRATION_REFERENCE_DEPTH_2 - GUILE_CALIBRATION_REFERENCE_DEPTH_1);
+  calibrated_c = ((double) GUILE_CALIBRATION_MEASURED_DEPTH_2)
+    - calibrated_m * GUILE_CALIBRATION_REFERENCE_DEPTH_2;
+#endif
+  scm_calculate_stack_limit ();
+
 #include "libguile/stackchk.x"
 }
 
diff --git a/libguile/stackchk.h b/libguile/stackchk.h
index 9a5c59f..d14e959 100644
--- a/libguile/stackchk.h
+++ b/libguile/stackchk.h
@@ -35,14 +35,11 @@
 
 #ifdef STACK_CHECKING
 # if SCM_STACK_GROWS_UP
-#  define SCM_STACK_OVERFLOW_P(s)\
-   (SCM_STACK_PTR (s) \
-    > (SCM_I_CURRENT_THREAD->base + SCM_STACK_LIMIT))
+#  define SCM_STACK_DEPTH(s) (SCM_STACK_PTR (s) - SCM_I_CURRENT_THREAD->base)
 # else
-#  define SCM_STACK_OVERFLOW_P(s)\
-   (SCM_STACK_PTR (s) \
-    < (SCM_I_CURRENT_THREAD->base - SCM_STACK_LIMIT))
+#  define SCM_STACK_DEPTH(s) (SCM_I_CURRENT_THREAD->base - SCM_STACK_PTR (s))
 # endif
+# define SCM_STACK_OVERFLOW_P(s) (SCM_STACK_DEPTH (s) > scm_stack_limit)
 # define SCM_CHECK_STACK\
     {\
        SCM_STACKITEM stack;\
@@ -54,10 +51,13 @@
 #endif /* STACK_CHECKING */
 
 SCM_API int scm_stack_checking_enabled_p;
+SCM_API int scm_stack_limit;
 
 \f
 
 SCM_API void scm_report_stack_overflow (void);
+SCM_API SCM scm_sys_get_stack_depth (void);
+SCM_API void scm_calculate_stack_limit (void);
 SCM_API long scm_stack_size (SCM_STACKITEM *start);
 SCM_API void scm_stack_report (void);
 SCM_API void scm_init_stackchk (void);
diff --git a/pre-inst-uguile.in b/pre-inst-uguile.in
new file mode 100644
index 0000000..fc8ffc3
--- /dev/null
+++ b/pre-inst-uguile.in
@@ -0,0 +1,99 @@
+#!/bin/sh
+
+#	Copyright (C) 2002, 2006, 2008 Free Software Foundation
+#
+#   This file is part of GUILE.
+#
+#   GUILE is free software; you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as
+#   published by the Free Software Foundation; either version 2, or
+#   (at your option) any later version.
+#
+#   GUILE 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 General Public License for more details.
+#
+#   You should have received a copy of the GNU General Public
+#   License along with GUILE; see the file COPYING.  If not, write
+#   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+#   Floor, Boston, MA 02110-1301 USA
+
+# NOTE: at some point we might consider invoking this under
+# pre-inst-guile-env.  If this will work, then most of the code below
+# can be removed.
+
+# NOTE: If you update this file, please update pre-inst-guile-env.in
+# as well, if appropriate.
+
+# Commentary:
+
+# Usage: pre-inst-uguile [ARGS]
+#
+# This script arranges for the environment to support, and eventaully execs,
+# the uninstalled binary uncalibrated guile executable located under libguile/,
+# passing ARGS to it.  In the process, env var GUILE is clobbered, and the
+# following env vars are modified (but not clobbered):
+#   GUILE_LOAD_PATH
+#   LTDL_LIBRARY_PATH
+#
+# This script can be used as a drop-in replacement for $bindir/guile;
+# if there is a discrepency in behavior, that's a bug.
+
+# Code:
+
+# config
+subdirs_with_ltlibs="srfi guile-readline"       # maintain me
+
+# env (set by configure)
+top_srcdir="@top_srcdir_absolute@"
+top_builddir="@top_builddir_absolute@"
+
+[ x"$top_srcdir"   = x -o ! -d "$top_srcdir" -o \
+  x"$top_builddir" = x -o ! -d "$top_builddir" ] && {
+    echo $0: bad environment
+    echo top_srcdir=$top_srcdir
+    echo top_builddir=$top_builddir
+    exit 1
+}
+
+# handle GUILE_LOAD_PATH (no clobber)
+if [ x"$GUILE_LOAD_PATH" = x ]
+then
+    GUILE_LOAD_PATH="${top_srcdir}/guile-readline:${top_srcdir}"
+else
+  for d in "${top_srcdir}" "${top_srcdir}/guile-readline"
+  do
+    # This hair prevents double inclusion.
+    # The ":" prevents prefix aliasing.
+    case x"$GUILE_LOAD_PATH" in
+      x*${d}:*) ;;
+      *) GUILE_LOAD_PATH="${d}:$GUILE_LOAD_PATH" ;;
+    esac
+  done
+fi
+export GUILE_LOAD_PATH
+
+# handle LTDL_LIBRARY_PATH (no clobber)
+ltdl_prefix=""
+dyld_prefix=""
+for dir in $subdirs_with_ltlibs ; do
+    ltdl_prefix="${top_builddir}/${dir}:${ltdl_prefix}"
+    dyld_prefix="${top_builddir}/${dir}/.libs:${dyld_prefix}"
+done
+LTDL_LIBRARY_PATH="${ltdl_prefix}$LTDL_LIBRARY_PATH"
+export LTDL_LIBRARY_PATH
+DYLD_LIBRARY_PATH="${dyld_prefix}${top_builddir}/libguile/.libs:$DYLD_LIBRARY_PATH"
+export DYLD_LIBRARY_PATH
+
+# set GUILE (clobber)
+GUILE=${top_builddir}/libguile/uguile
+export GUILE
+
+# do it
+exec $GUILE "$@"
+
+# never reached
+exit 1
+
+# pre-inst-uguile ends here
-- 
1.5.6.5