From 6f84b52bd76e2777dbfddcda571f52dbc82895f3 Mon Sep 17 00:00:00 2001 From: Neil Jerram 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 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; 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