mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Merge branch 'master' into boehm-demers-weiser-gc

Browse source 
Conflicts:
	lib/Makefile.am
	libguile/Makefile.am
	libguile/frames.c
	libguile/gc-card.c
	libguile/gc-freelist.c
	libguile/gc-mark.c
	libguile/gc-segment.c
	libguile/gc_os_dep.c
	libguile/load.c
	libguile/macros.c
	libguile/objcodes.c
	libguile/programs.c
	libguile/strings.c
	libguile/vm.c
	m4/gnulib-cache.m4
	m4/gnulib-comp.m4
	m4/inline.m4
This commit is contained in:
Ludovic Courtès 2009-08-17 23:39:56 +02:00
commit fbb857a472
823 changed files with 61674 additions and 14111 deletions
Download patch file Download diff file Expand all files Collapse all files

56
libguile/debug.c
View file

@ -2,18 +2,19 @@
* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation
*
* 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.
* 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
* 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
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
@ -21,6 +22,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"
@ -303,7 +309,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
SCM_VALIDATE_PROC (1, proc);
switch (SCM_TYP7 (proc)) {
case scm_tcs_subrs:
return SCM_SNAME (proc);
return SCM_SUBR_NAME (proc);
default:
{
SCM name = scm_procedure_property (proc, scm_sym_name);
@ -395,6 +401,21 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0,
(SCM proc),
"Return the module that was current when @var{proc} was defined.")
#define FUNC_NAME s_scm_procedure_module
{
SCM_VALIDATE_PROC (SCM_ARG1, proc);
if (scm_is_true (scm_program_p (proc)))
return scm_program_module (proc);
else
return scm_env_module (scm_procedure_environment (proc));
}
#undef FUNC_NAME
/* Eval in a local environment. We would like to have the ability to
@ -513,11 +534,32 @@ 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)
{
rlim_t bytes = lim.rlim_cur;
/* set our internal stack limit to 80% of the rlimit. */
if (bytes == RLIM_INFINITY)
bytes = lim.rlim_max;
if (bytes != RLIM_INFINITY)
SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits);
}
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);