diff options
author | Andy Wingo <wingo@pobox.com> | 2009-03-28 22:31:20 -0700 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-03-28 22:31:20 -0700 |
commit | 9c0cd73e614e338528e1d323dedec54f3dfad1d8 (patch) | |
tree | f9b153084447d2c2d36efbdf052b331c3278fc12 | |
parent | 6ecae97fb8dca2e5e26af44a649a706431c65756 (diff) | |
parent | a5fc657043e1af9b2e79799059069f8172afb66c (diff) | |
download | guile-9c0cd73e614e338528e1d323dedec54f3dfad1d8.tar.gz |
Merge branch 'wingo'
41 files changed, 323 insertions, 232 deletions
diff --git a/.gitignore b/.gitignore index 884d819f1..3aa1f0471 100644 --- a/.gitignore +++ b/.gitignore @@ -72,7 +72,6 @@ guile-readline/guile-readline-config.h.in TAGS guile-1.8.pc gdb-pre-inst-guile -libguile/stack-limit-calibration.scm cscope.out cscope.files *.log diff --git a/Makefile.am b/Makefile.am index 556b32141..0e61f531d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -24,16 +24,14 @@ # AUTOMAKE_OPTIONS = 1.10 -SUBDIRS = lib libguile guile-config guile-readline emacs \ +SUBDIRS = lib meta libguile guile-readline emacs \ scripts srfi doc examples test-suite benchmark-suite lang am \ module testsuite -bin_SCRIPTS = guile-tools - include_HEADERS = libguile.h EXTRA_DIST = LICENSE HACKING GUILE-VERSION \ - m4/ChangeLog-2008 FAQ guile-1.8.pc.in \ + m4/ChangeLog-2008 FAQ \ m4/autobuild.m4 ChangeLog-2008 TESTS = check-guile @@ -42,7 +40,4 @@ ACLOCAL_AMFLAGS = -I m4 DISTCLEANFILES = check-guile.log -pkgconfigdir = $(libdir)/pkgconfig -pkgconfig_DATA = guile-1.8.pc - # Makefile.am ends here @@ -223,9 +223,23 @@ GUILE_FOR_BUILD variable, it defaults to just "guile". Using Guile Without Installing It ========================================= -The top directory of the Guile sources contains a script called -"pre-inst-guile" that can be used to run the Guile that has just been -built. +The "meta/" subdirectory of the Guile sources contains a script called +"guile" that can be used to run the Guile that has just been built. Note +that this is not the same "guile" as the one that is installed; this +"guile" is a wrapper script that sets up the environment appropriately, +then invokes the Guile binary. + +You may also build external packages against an uninstalled Guile build +tree. The "uninstalled-env" script in the "meta/" subdirectory will set +up an environment with a path including "meta/", a modified dynamic +linker path, a modified PKG_CONFIG_PATH, etc. + +For example, you can enter this environment via invoking + + meta/uninstalled-env bash + +Within that shell, other packages should be able to build against +uninstalled Guile. Installing SLIB =========================================================== @@ -10,6 +10,4 @@ CLEANFILES = $(GOBJECTS) SUFFIXES = .scm .go .scm.go: $(MKDIR_P) `dirname $@` - $(top_builddir)/pre-inst-guile \ - -l $(top_builddir)/libguile/stack-limit-calibration.scm \ - $(top_srcdir)/scripts/compile -o "$@" "$<" + $(top_builddir)/meta/uninstalled-env guile-tools compile -o "$@" "$<" diff --git a/am/pre-inst-guile b/am/pre-inst-guile index c1a7407c9..353908dfb 100644 --- a/am/pre-inst-guile +++ b/am/pre-inst-guile @@ -28,7 +28,7 @@ ## Code: -preinstguile = $(top_builddir_absolute)/pre-inst-guile +preinstguile = $(top_builddir_absolute)/meta/guile preinstguiletool = GUILE="$(preinstguile)" $(top_srcdir)/scripts ## am/pre-inst-guile ends here diff --git a/check-guile.in b/check-guile.in index 9ee2ea3f6..3162fa6fc 100644 --- a/check-guile.in +++ b/check-guile.in @@ -1,6 +1,6 @@ #! /bin/sh # Usage: check-guile [-i GUILE-INTERPRETER] [GUILE-TEST-ARGS] -# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile. +# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/meta/guile. # See ${top_srcdir}/test-suite/guile-test for documentation on GUILE-TEST-ARGS. # # Example invocations: @@ -21,7 +21,7 @@ if [ x"$1" = x-i ] ; then shift shift else - guile=${top_builddir}/pre-inst-guile + guile=${top_builddir}/meta/guile fi GUILE_LOAD_PATH=$TEST_SUITE_DIR @@ -41,7 +41,6 @@ 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 60166d80f..9503fcbcd 100644 --- a/configure.in +++ b/configure.in @@ -883,6 +883,8 @@ if test -n "$have_sys_un_h" ; then [Define if the system supports Unix-domain (file-domain) sockets.]) fi +AC_CHECK_FUNCS(getrlimit setrlimit) + AC_CHECK_FUNCS(socketpair getgroups setgroups setpwent pause tzset) AC_CHECK_FUNCS(sethostent gethostent endhostent dnl @@ -1532,13 +1534,13 @@ AC_CONFIG_FILES([ doc/tutorial/Makefile emacs/Makefile examples/Makefile - guile-config/Makefile lang/Makefile libguile/Makefile scripts/Makefile srfi/Makefile test-suite/Makefile test-suite/standalone/Makefile + meta/Makefile module/Makefile module/ice-9/Makefile module/ice-9/debugger/Makefile @@ -1549,13 +1551,15 @@ AC_CONFIG_FILES([ testsuite/Makefile ]) -AC_CONFIG_FILES([guile-1.8.pc]) +AC_CONFIG_FILES([meta/guile-1.8.pc]) +AC_CONFIG_FILES([meta/guile-1.8-uninstalled.pc]) AC_CONFIG_FILES([check-guile], [chmod +x check-guile]) 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([gdb-pre-inst-guile], [chmod +x gdb-pre-inst-guile]) +AC_CONFIG_FILES([meta/guile-config], [chmod +x meta/guile-config]) +AC_CONFIG_FILES([meta/guile-tools], [chmod +x meta/guile-tools]) +AC_CONFIG_FILES([meta/guile], [chmod +x meta/guile]) +AC_CONFIG_FILES([meta/uninstalled-env], [chmod +x meta/uninstalled-env]) +AC_CONFIG_FILES([meta/gdb-uninstalled-guile], [chmod +x meta/gdb-uninstalled-guile]) AC_CONFIG_FILES([libguile/guile-snarf], [chmod +x libguile/guile-snarf]) AC_CONFIG_FILES([libguile/guile-doc-snarf], diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 9799a5e0b..d534351dd 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -89,8 +89,8 @@ include $(top_srcdir)/am/pre-inst-guile # Automated snarfing autoconf.texi: autoconf-macros.texi -autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4 - $(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/guile-config/guile.m4 \ +autoconf-macros.texi: $(top_srcdir)/meta/guile.m4 + $(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/meta/guile.m4 \ > $(srcdir)/$@ lib-version.texi: $(top_srcdir)/GUILE-VERSION diff --git a/gc-benchmarks/run-benchmark.scm b/gc-benchmarks/run-benchmark.scm index 509f978ee..a50fb48c2 100755 --- a/gc-benchmarks/run-benchmark.scm +++ b/gc-benchmarks/run-benchmark.scm @@ -233,7 +233,7 @@ Report bugs to <bug-guile@gnu.org>.~%")) (ref-env (assoc-ref args 'reference-environment)) (bdwgc-env (or (assoc-ref args 'bdwgc-environment) (string-append "GUILE=" bench-dir - "/../pre-inst-guile"))) + "/../meta/guile"))) (prof-opts (assoc-ref args 'profile-options))) (for-each (lambda (benchmark) (let ((ref (parse-result (run-reference-guile ref-env diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 580114093..8f26e34d2 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -256,7 +256,7 @@ EXTRA_DIST = ChangeLog-scm ChangeLog-threads \ cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c \ cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk \ c-tokenize.lex version.h.in \ - scmconfig.h.top libgettext.h measure-hwm.scm + scmconfig.h.top libgettext.h # $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \ # guile-procedures.txt guile.texi @@ -351,24 +351,6 @@ guile-procedures.txt: guile-procedures.texi endif -# Stack limit calibration to allow the compiler to run when creating -# the initial `.go' files and for `make check'. (For why we do this, see -# the comments in measure-hwm.scm.) -# -# The fact that "libguile" comes before "module" and "test-suite" -# in SUBDIRS in our toplevel Makefile.am ensures that the -# stack-limit-calibration.scm program will be run before we compile -# files or run tests. -# -# We don't care about the exit code of `measure-hwm.scm' because the -# important thing about stack-limit-calibration.scm is just that it is -# generated in the first place, so that it can be loaded in `am/guilec' -# and by the test suite. -BUILT_SOURCES += stack-limit-calibration.scm - -stack-limit-calibration.scm: measure-hwm.scm guile$(EXEEXT) - -$(preinstguile) -s $(srcdir)/measure-hwm.scm > $@ - c-tokenize.c: c-tokenize.lex flex -t $(srcdir)/c-tokenize.lex > $@ || { rm $@; false; } @@ -423,8 +405,9 @@ MOSTLYCLEANFILES = \ cpp_err_symbols_here cpp_err_symbols_diff cpp_err_symbols_new \ cpp_sig_symbols_here cpp_sig_symbols_diff cpp_sig_symbols_new \ version.h version.h.tmp \ - scmconfig.h scmconfig.h.tmp stack-limit-calibration.scm + scmconfig.h scmconfig.h.tmp -CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi +CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi \ + vm-i-*.i MAINTAINERCLEANFILES = c-tokenize.c diff --git a/libguile/debug.c b/libguile/debug.c index 5d0e20899..ec37d3aaa 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -21,6 +21,11 @@ # include <config.h> #endif +#ifdef HAVE_GETRLIMIT +#include <sys/time.h> +#include <sys/resource.h> +#endif + #include "libguile/_scm.h" #include "libguile/async.h" #include "libguile/eval.h" @@ -513,11 +518,42 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0, #undef FUNC_NAME #endif +static void +init_stack_limit (void) +{ +#ifdef HAVE_GETRLIMIT + struct rlimit lim; + if (getrlimit (RLIMIT_STACK, &lim) == 0) + { + int bytes = lim.rlim_cur, words; + + /* set our internal stack limit to 1 MB or 80% of the rlimit, whichever + is lower. */ + if (bytes == RLIM_INFINITY) + bytes = lim.rlim_max; + + if (bytes == RLIM_INFINITY) + words = 1024 * 1024 / sizeof (scm_t_bits); + else + { + bytes = bytes * 8 / 10; + if (bytes > 1024 * 1024) + bytes = 1024 * 1024; + words = bytes / sizeof (scm_t_bits); + } + + SCM_STACK_LIMIT = words; + } + errno = 0; +#endif +} + void scm_init_debug () { + init_stack_limit (); scm_init_opts (scm_debug_options, scm_debug_opts); scm_tc16_memoized = scm_make_smob_type ("memoized", 0); diff --git a/libguile/extensions.c b/libguile/extensions.c index 1090b8bd5..29cb58cbe 100644 --- a/libguile/extensions.c +++ b/libguile/extensions.c @@ -76,6 +76,7 @@ load_extension (SCM lib, SCM init) { extension_t *ext; char *clib, *cinit; + int found = 0; scm_dynwind_begin (0); @@ -89,10 +90,14 @@ load_extension (SCM lib, SCM init) && !strcmp (ext->init, cinit)) { ext->func (ext->data); + found = 1; break; } scm_dynwind_end (); + + if (found) + return; } /* Dynamically link the library. */ diff --git a/libguile/extensions.h b/libguile/extensions.h index 596b43ae0..260567e51 100644 --- a/libguile/extensions.h +++ b/libguile/extensions.h @@ -26,6 +26,8 @@ +typedef void (*scm_t_extension_init_func)(void*); + SCM_API void scm_c_register_extension (const char *lib, const char *init, void (*func) (void *), void *data); diff --git a/libguile/frames.c b/libguile/frames.c index 647cb608d..eb3bc22ee 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -297,6 +297,8 @@ scm_bootstrap_frames (void) scm_set_smob_mark (scm_tc16_vm_frame, vm_frame_mark); scm_set_smob_free (scm_tc16_vm_frame, vm_frame_free); scm_set_smob_print (scm_tc16_vm_frame, vm_frame_print); + scm_c_register_extension ("libguile", "scm_init_frames", + (scm_t_extension_init_func)scm_init_frames, NULL); } void diff --git a/libguile/instructions.c b/libguile/instructions.c index b33c8d203..4f504f0a2 100644 --- a/libguile/instructions.c +++ b/libguile/instructions.c @@ -215,6 +215,9 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0, void scm_bootstrap_instructions (void) { + scm_c_register_extension ("libguile", "scm_init_instructions", + (scm_t_extension_init_func)scm_init_instructions, + NULL); } void diff --git a/libguile/measure-hwm.scm b/libguile/measure-hwm.scm deleted file mode 100644 index 53a30d560..000000000 --- a/libguile/measure-hwm.scm +++ /dev/null @@ -1,136 +0,0 @@ -;;;; 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) - -;; Use 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. -(trap-set! enter-frame-handler - (lambda _ - (let ((stack-size (%get-stack-size))) - (if (< top-repl-hwm-measured stack-size) - (set! top-repl-hwm-measured stack-size))))) -(trap-enable 'enter-frame) -(trap-enable 'traps) - -;; 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 9461) - -;; 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/objcodes.c b/libguile/objcodes.c index 3e30b2d60..c53cf2253 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -266,6 +266,8 @@ scm_bootstrap_objcodes (void) { scm_tc16_objcode = scm_make_smob_type ("objcode", 0); scm_set_smob_mark (scm_tc16_objcode, objcode_mark); + scm_c_register_extension ("libguile", "scm_init_objcodes", + (scm_t_extension_init_func)scm_init_objcodes, NULL); } /* Before, we used __BYTE_ORDER, but that is not defined on all diff --git a/libguile/posix.c b/libguile/posix.c index 00e0fa1a3..78fd295b5 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -33,6 +33,7 @@ #include "libguile/srfi-13.h" #include "libguile/srfi-14.h" #include "libguile/vectors.h" +#include "libguile/values.h" #include "libguile/lang.h" #include "libguile/validate.h" @@ -463,6 +464,179 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0, #endif /* HAVE_GETGRENT */ +#ifdef HAVE_GETRLIMIT +#ifdef RLIMIT_AS +SCM_SYMBOL (sym_as, "as"); +#endif +#ifdef RLIMIT_CORE +SCM_SYMBOL (sym_core, "core"); +#endif +#ifdef RLIMIT_CPU +SCM_SYMBOL (sym_cpu, "cpu"); +#endif +#ifdef RLIMIT_DATA +SCM_SYMBOL (sym_data, "data"); +#endif +#ifdef RLIMIT_FSIZE +SCM_SYMBOL (sym_fsize, "fsize"); +#endif +#ifdef RLIMIT_MEMLOCK +SCM_SYMBOL (sym_memlock, "memlock"); +#endif +#ifdef RLIMIT_MSGQUEUE +SCM_SYMBOL (sym_msgqueue, "msgqueue"); +#endif +#ifdef RLIMIT_NICE +SCM_SYMBOL (sym_nice, "nice"); +#endif +#ifdef RLIMIT_NOFILE +SCM_SYMBOL (sym_nofile, "nofile"); +#endif +#ifdef RLIMIT_NPROC +SCM_SYMBOL (sym_nproc, "nproc"); +#endif +#ifdef RLIMIT_RSS +SCM_SYMBOL (sym_rss, "rss"); +#endif +#ifdef RLIMIT_RTPRIO +SCM_SYMBOL (sym_rtprio, "rtprio"); +#endif +#ifdef RLIMIT_RTPRIO +SCM_SYMBOL (sym_rttime, "rttime"); +#endif +#ifdef RLIMIT_SIGPENDING +SCM_SYMBOL (sym_sigpending, "sigpending"); +#endif +#ifdef RLIMIT_STACK +SCM_SYMBOL (sym_stack, "stack"); +#endif + +static int +scm_to_resource (SCM s, const char *func, int pos) +{ + if (scm_is_number (s)) + return scm_to_int (s); + + SCM_ASSERT_TYPE (scm_is_symbol (s), s, pos, func, "symbol"); + +#ifdef RLIMIT_AS + if (s == sym_as) + return RLIMIT_AS; +#endif +#ifdef RLIMIT_CORE + if (s == sym_core) + return RLIMIT_CORE; +#endif +#ifdef RLIMIT_CPU + if (s == sym_cpu) + return RLIMIT_CPU; +#endif +#ifdef RLIMIT_DATA + if (s == sym_data) + return RLIMIT_DATA; +#endif +#ifdef RLIMIT_FSIZE + if (s == sym_fsize) + return RLIMIT_FSIZE; +#endif +#ifdef RLIMIT_MEMLOCK + if (s == sym_memlock) + return RLIMIT_MEMLOCK; +#endif +#ifdef RLIMIT_MSGQUEUE + if (s == sym_msgqueue) + return RLIMIT_MSGQUEUE; +#endif +#ifdef RLIMIT_NICE + if (s == sym_nice) + return RLIMIT_NICE; +#endif +#ifdef RLIMIT_NOFILE + if (s == sym_nofile) + return RLIMIT_NOFILE; +#endif +#ifdef RLIMIT_NPROC + if (s == sym_nproc) + return RLIMIT_NPROC; +#endif +#ifdef RLIMIT_RSS + if (s == sym_rss) + return RLIMIT_RSS; +#endif +#ifdef RLIMIT_RTPRIO + if (s == sym_rtprio) + return RLIMIT_RTPRIO; +#endif +#ifdef RLIMIT_RTPRIO + if (s == sym_rttime) + return RLIMIT_RTPRIO; +#endif +#ifdef RLIMIT_SIGPENDING + if (s == sym_sigpending) + return RLIMIT_SIGPENDING; +#endif +#ifdef RLIMIT_STACK + if (s == sym_stack) + return RLIMIT_STACK; +#endif + + scm_misc_error (func, "invalid rlimit resource ~A", scm_list_1 (s)); + return 0; +} + +SCM_DEFINE (scm_getrlimit, "getrlimit", 1, 0, 0, + (SCM resource), + "Get a resource limit for this process. @var{resource} identifies the resource,\n" + "either as an integer or as a symbol. For example, @code{(getrlimit 'stack)}\n" + "gets the limits associated with @code{RLIMIT_STACK}.\n\n" + "@code{getrlimit} returns two values, the soft and the hard limit. If no\n" + "limit is set for the resource in question, the returned limit will be @code{#f}.") +#define FUNC_NAME s_scm_getrlimit +{ + int iresource; + struct rlimit lim = { 0, 0 }; + + iresource = scm_to_resource (resource, FUNC_NAME, 1); + + if (getrlimit (iresource, &lim) != 0) + scm_syserror (FUNC_NAME); + + return scm_values (scm_list_2 ((lim.rlim_cur == RLIM_INFINITY) ? SCM_BOOL_F + : scm_from_long (lim.rlim_cur), + (lim.rlim_max == RLIM_INFINITY) ? SCM_BOOL_F + : scm_from_long (lim.rlim_max))); +} +#undef FUNC_NAME + + +#ifdef HAVE_SETRLIMIT +SCM_DEFINE (scm_setrlimit, "setrlimit", 3, 0, 0, + (SCM resource, SCM soft, SCM hard), + "Set a resource limit for this process. @var{resource} identifies the resource,\n" + "either as an integer or as a symbol. @var{soft} and @var{hard} should be integers,\n" + "or @code{#f} to indicate no limit (i.e., @code{RLIM_INFINITY}).\n\n" + "For example, @code{(setrlimit 'stack 150000 300000)} sets the @code{RLIMIT_STACK}\n" + "limit to 150 kilobytes, with a hard limit of 300 kB.") +#define FUNC_NAME s_scm_setrlimit +{ + int iresource; + struct rlimit lim = { 0, 0 }; + + iresource = scm_to_resource (resource, FUNC_NAME, 1); + + lim.rlim_cur = (soft == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (soft); + lim.rlim_max = (hard == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (hard); + + if (setrlimit (iresource, &lim) != 0) + scm_syserror (FUNC_NAME); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif /* HAVE_SETRLIMIT */ +#endif /* HAVE_GETRLIMIT */ + + SCM_DEFINE (scm_kill, "kill", 2, 0, 0, (SCM pid, SCM sig), "Sends a signal to the specified process or group of processes.\n\n" diff --git a/libguile/posix.h b/libguile/posix.h index 34e1fc77f..6d282e0bf 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -41,6 +41,8 @@ SCM_API SCM scm_getpwuid (SCM user); SCM_API SCM scm_setpwent (SCM arg); SCM_API SCM scm_getgrgid (SCM name); SCM_API SCM scm_setgrent (SCM arg); +SCM_API SCM scm_getrlimit (SCM resource); +SCM_API SCM scm_setrlimit (SCM resource, SCM soft, SCM hard); SCM_API SCM scm_kill (SCM pid, SCM sig); SCM_API SCM scm_waitpid (SCM pid, SCM options); SCM_API SCM scm_status_exit_val (SCM status); diff --git a/libguile/programs.c b/libguile/programs.c index 1d6318c6c..c97f61e13 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -368,6 +368,8 @@ scm_bootstrap_programs (void) scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_1 = program_apply_1; scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_2 = program_apply_2; scm_set_smob_print (scm_tc16_program, program_print); + scm_c_register_extension ("libguile", "scm_init_programs", + (scm_t_extension_init_func)scm_init_programs, NULL); } void diff --git a/libguile/vm.c b/libguile/vm.c index 0646becdb..53e9e154e 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -662,6 +662,9 @@ scm_bootstrap_vm (void) sym_vm_error = scm_permanent_object (scm_from_locale_symbol ("vm-error")); sym_debug = scm_permanent_object (scm_from_locale_symbol ("debug")); + scm_c_register_extension ("libguile", "scm_init_vm", + (scm_t_extension_init_func)scm_init_vm, NULL); + strappage = 1; } diff --git a/guile-config/ChangeLog-2008 b/meta/ChangeLog-2008 index d450f2536..d450f2536 100644 --- a/guile-config/ChangeLog-2008 +++ b/meta/ChangeLog-2008 diff --git a/guile-config/Makefile.am b/meta/Makefile.am index cedcba968..76544b30d 100644 --- a/guile-config/Makefile.am +++ b/meta/Makefile.am @@ -20,27 +20,14 @@ ## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth ## Floor, Boston, MA 02110-1301 USA -bin_SCRIPTS=guile-config -CLEANFILES=guile-config -EXTRA_DIST=guile-config.in guile.m4 ChangeLog-2008 +bin_SCRIPTS=guile-config guile-tools +EXTRA_DIST=guile-config.in guile-tools.in guile.m4 ChangeLog-2008 \ + guile-1.8.pc.in guile-1.8-uninstalled.pc.in + +pkgconfigdir = $(libdir)/pkgconfig +pkgconfig_DATA = guile-1.8.pc ## FIXME: in the future there will be direct automake support for ## doing this. When that happens, switch over. aclocaldir = $(datadir)/aclocal aclocal_DATA = guile.m4 - -## We use @-...-@ as the substitution brackets here, instead of the -## usual @...@, so autoconf doesn't go and substitute the values -## directly into the left-hand sides of the sed substitutions. *sigh* -guile-config: guile-config.in ${top_builddir}/libguile/libpath.h - rm -f guile-config.tmp - sed < ${srcdir}/guile-config.in > guile-config.tmp \ - -e 's|@-bindir-@|${bindir}|' \ - -e s:@-GUILE_VERSION-@:${GUILE_VERSION}: - chmod +x guile-config.tmp - mv guile-config.tmp guile-config - -## Get rid of any copies of the configuration script under the old -## name, so people don't end up running ancient copies of it. -install-exec-local: - rm -f ${bindir}/build-guile diff --git a/gdb-pre-inst-guile.in b/meta/gdb-uninstalled-guile.in index d1f4e38ec..457ab2bd7 100644 --- a/gdb-pre-inst-guile.in +++ b/meta/gdb-uninstalled-guile.in @@ -21,18 +21,18 @@ # Commentary: -# Usage: gdb-pre-inst-guile [ARGS] +# Usage: gdb-uninstalled-guile [ARGS] # # This script runs Guile from the build tree under GDB. See -# ./pre-inst-guile for more information. +# ./guile for more information. # -# In addition to running ./gdb-pre-inst-guile, sometimes it's useful to -# run e.g. ./check-guile -i ./gdb-pre-inst-guile foo.test. +# In addition to running ./gdb-uninstalled-guile, sometimes it's useful to +# run e.g. ./check-guile -i meta/gdb-uninstalled-guile foo.test. # Code: set -e # env (set by configure) top_builddir="@top_builddir_absolute@" -exec ${top_builddir}/pre-inst-guile-env libtool --mode=execute \ +exec ${top_builddir}/uninstalled-env libtool --mode=execute \ gdb --args ${top_builddir}/libguile/guile "$@" diff --git a/meta/guile-1.8-uninstalled.pc.in b/meta/guile-1.8-uninstalled.pc.in new file mode 100644 index 000000000..50d337fd3 --- /dev/null +++ b/meta/guile-1.8-uninstalled.pc.in @@ -0,0 +1,8 @@ +builddir=@abs_top_builddir@ +srcdir=@abs_top_srcdir@ + +Name: GNU Guile (uninstalled) +Description: GNU's Ubiquitous Intelligent Language for Extension (uninstalled) +Version: @GUILE_VERSION@ +Libs: -L${builddir}/libguile -lguile @GUILE_LIBS@ +Cflags: -I${srcdir} -I${builddir} @GUILE_CFLAGS@ diff --git a/guile-1.8.pc.in b/meta/guile-1.8.pc.in index 15c83d84b..15c83d84b 100644 --- a/guile-1.8.pc.in +++ b/meta/guile-1.8.pc.in diff --git a/guile-config/guile-config.in b/meta/guile-config.in index b782292d8..b1640b629 100644 --- a/guile-config/guile-config.in +++ b/meta/guile-config.in @@ -1,5 +1,6 @@ -#!@-bindir-@/guile \ --e main -s +#!/bin/sh +bindir=`dirname $0` +exec $bindir/guile -e main -s $0 "$@" !# ;;;; guile-config --- utility for linking programs with Guile ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 @@ -47,7 +48,7 @@ (define program-name #f) (define subcommand-name #f) -(define program-version "@-GUILE_VERSION-@") +(define program-version "@GUILE_VERSION@") ;;; Given an executable path PATH, set program-name to something ;;; appropriate f or use in error messages (i.e., with leading diff --git a/guile-tools.in b/meta/guile-tools.in index ca940a0da..68db26887 100644 --- a/guile-tools.in +++ b/meta/guile-tools.in @@ -53,7 +53,7 @@ top_builddir="@top_builddir_absolute@" # pre-install invocation frob mydir=$(cd $(dirname $0) && pwd) -if [ "$mydir" = "$top_builddir" ] ; then +if [ "$mydir" = "$top_builddir/meta" ] ; then default_scriptsdir=$top_srcdir/scripts fi diff --git a/pre-inst-guile.in b/meta/guile.in index 5adbabea2..d7bc893e6 100644 --- a/pre-inst-guile.in +++ b/meta/guile.in @@ -21,7 +21,7 @@ # Commentary: -# Usage: pre-inst-guile [ARGS] +# Usage: guile [ARGS] # # This script arranges for the environment to support, and eventaully execs, # the uninstalled binary guile executable located somewhere under libguile/, @@ -43,9 +43,9 @@ GUILE=${top_builddir}/libguile/guile export GUILE # do it -exec ${top_builddir}/pre-inst-guile-env $GUILE "$@" +exec ${top_builddir}/meta/uninstalled-env $GUILE "$@" # never reached exit 1 -# pre-inst-guile ends here +# guile ends here diff --git a/guile-config/guile.m4 b/meta/guile.m4 index bcded2bdc..bcded2bdc 100644 --- a/guile-config/guile.m4 +++ b/meta/guile.m4 diff --git a/pre-inst-guile-env.in b/meta/uninstalled-env.in index bb0a81c06..fa8285d94 100644 --- a/pre-inst-guile-env.in +++ b/meta/uninstalled-env.in @@ -18,17 +18,17 @@ # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -# NOTE: If you update this file, please update pre-inst-guile.in as +# NOTE: If you update this file, please update uninstalled.in as # well, if appropriate. -# Usage: pre-inst-guile-env [ARGS] +# Usage: uninstalled-env [ARGS] # This script arranges for the environment to support running Guile # from the build tree. The following env vars are modified (but not # clobbered): GUILE_LOAD_PATH, LTDL_LIBRARY_PATH, and PATH. -# Example: pre-inst-guile-env guile -c '(display "hello\n")' -# Example: ../../pre-inst-guile-env ./guile-test-foo +# Example: uninstalled-env guile -c '(display "hello\n")' +# Example: ../../uninstalled-env ./guile-test-foo # config subdirs_with_ltlibs="srfi guile-readline libguile" # maintain me @@ -83,9 +83,18 @@ export LTDL_LIBRARY_PATH DYLD_LIBRARY_PATH="${dyld_prefix}${top_builddir}/libguile/.libs:$DYLD_LIBRARY_PATH" export DYLD_LIBRARY_PATH +if [ x"$PKG_CONFIG_PATH" = x ] +then + PKG_CONFIG_PATH="${top_builddir}" +else + PKG_CONFIG_PATH="${top_builddir}:$PKG_CONFIG_PATH" +fi +export PKG_CONFIG_PATH + # handle PATH (no clobber) PATH="${top_builddir}/guile-config:${PATH}" PATH="${top_builddir}/libguile:${PATH}" +PATH="${top_builddir}/meta:${PATH}" export PATH exec "$@" diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index a74d903da..33a1e1b60 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -42,8 +42,7 @@ frame-return-address frame-program frame-dynamic-link heap-frame?)) -;; fixme: avoid the dynamic-call? -(dynamic-call "scm_init_frames" (dynamic-link "libguile")) +(load-extension "libguile" "scm_init_frames") ;;; ;;; Frame chain diff --git a/module/system/vm/instruction.scm b/module/system/vm/instruction.scm index c820e9952..3ad718ea8 100644 --- a/module/system/vm/instruction.scm +++ b/module/system/vm/instruction.scm @@ -25,4 +25,4 @@ instruction-pops instruction-pushes instruction->opcode opcode->instruction)) -(dynamic-call "scm_init_instructions" (dynamic-link "libguile")) +(load-extension "libguile" "scm_init_instructions") diff --git a/module/system/vm/objcode.scm b/module/system/vm/objcode.scm index df1ff26e4..ab6bb4bae 100644 --- a/module/system/vm/objcode.scm +++ b/module/system/vm/objcode.scm @@ -25,4 +25,4 @@ load-objcode write-objcode word-size byte-order)) -(dynamic-call "scm_init_objcodes" (dynamic-link "libguile")) +(load-extension "libguile" "scm_init_objcodes") diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm index 7e4007b75..5a490b9d9 100644 --- a/module/system/vm/program.scm +++ b/module/system/vm/program.scm @@ -36,7 +36,7 @@ program-objcode program? program-objects program-module program-base program-external)) -(dynamic-call "scm_init_programs" (dynamic-link "libguile")) +(load-extension "libguile" "scm_init_programs") (define arity:nargs car) (define arity:nrest cadr) diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm index de5c3fa21..48dc4f2b8 100644 --- a/module/system/vm/vm.scm +++ b/module/system/vm/vm.scm @@ -32,7 +32,7 @@ vm-next-hook vm-apply-hook vm-boot-hook vm-return-hook vm-break-hook vm-exit-hook vm-halt-hook vm-enter-hook)) -(dynamic-call "scm_init_vm" (dynamic-link "libguile")) +(load-extension "libguile" "scm_init_vm") (define (vms:time stat) (vector-ref stat 0)) (define (vms:clock stat) (vector-ref stat 1)) diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 854a4a028..b8d6e81e4 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -28,7 +28,7 @@ check_SCRIPTS = BUILT_SOURCES = EXTRA_DIST = -TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env" +TESTS_ENVIRONMENT = "${top_builddir}/meta/uninstalled-env" test_cflags = \ -I$(top_srcdir)/test-suite/standalone \ diff --git a/test-suite/standalone/README b/test-suite/standalone/README index 4e0bd652e..164c6ab46 100644 --- a/test-suite/standalone/README +++ b/test-suite/standalone/README @@ -12,7 +12,7 @@ If you want to use a scheme script, prefix it as follows: !# Makefile.am will arrange for all tests (scripts or executables) to be -run under pre-inst-guile-env so that the PATH, LD_LIBRARY_PATH, and +run under uninstalled-env so that the PATH, LD_LIBRARY_PATH, and GUILE_LOAD_PATH will be augmented appropriately. The Makefile.am has an example of creating a shared library to be used diff --git a/test-suite/standalone/test-fast-slot-ref.in b/test-suite/standalone/test-fast-slot-ref.in index 5bd063876..774cfe269 100644 --- a/test-suite/standalone/test-fast-slot-ref.in +++ b/test-suite/standalone/test-fast-slot-ref.in @@ -25,7 +25,7 @@ # executing the (%fast-slot-ref i 3) line. For reasons as yet # unknown, it does not cause a segmentation fault if the same code is # loaded as a script; that is why we run it here using "guile -q <<EOF". -exec guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm >/dev/null 2>&1 <<EOF +exec guile -q >/dev/null 2>&1 <<EOF (use-modules (oop goops)) (define-module (oop goops)) (define-class <c> () (a #:init-value 1) (b #:init-value 2) (c #:init-value 3)) diff --git a/test-suite/standalone/test-use-srfi.in b/test-suite/standalone/test-use-srfi.in index 57f84afe4..7186b5a24 100755 --- a/test-suite/standalone/test-use-srfi.in +++ b/test-suite/standalone/test-use-srfi.in @@ -19,7 +19,7 @@ # 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 +guile -q --use-srfi=1,10 >/dev/null <<EOF (if (and (defined? 'partition) (defined? 'define-reader-ctor)) (exit 0) ;; good @@ -38,7 +38,7 @@ fi # `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 +guile -q --use-srfi=1 >/dev/null <<EOF (catch #t (lambda () (iota 2 3 4)) @@ -56,7 +56,7 @@ fi # 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 +guile -q --use-srfi=17 >/dev/null <<EOF (if (procedure-with-setter? car) (exit 0) ;; good (exit 1)) ;; bad diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am index c523eff8d..2bc78142c 100644 --- a/testsuite/Makefile.am +++ b/testsuite/Makefile.am @@ -1,5 +1,5 @@ TESTS_ENVIRONMENT = \ - $(top_builddir)/pre-inst-guile \ + $(top_builddir)/meta/guile \ -l $(srcdir)/run-vm-tests.scm -e run-vm-tests TESTS = \ |