summaryrefslogtreecommitdiff
path: root/libguile/debug.c
diff options
context:
space:
mode:
authorNeil Jerram <neil@ossau.uklinux.net>2010-04-10 13:32:42 +0100
committerNeil Jerram <neil@ossau.uklinux.net>2010-04-10 13:32:42 +0100
commit26b9f9090073c896762af3125af54958e153f8f2 (patch)
tree11c799f1191ef122c66329c36d6b03230c6962ef /libguile/debug.c
parent3ce5e1304bd77eb167f856a2a163038f01f452c8 (diff)
parent96ec2c9c65468b1404865371d19342d6badb0be9 (diff)
downloadguile-26b9f9090073c896762af3125af54958e153f8f2.tar.gz
Merge branch 'master' into wip-manual-2
Conflicts: doc/ref/api-procedures.texi doc/ref/misc-modules.texi (Caused by me removing `@page' from a couple of sections that have been modified by others.)
Diffstat (limited to 'libguile/debug.c')
-rw-r--r--libguile/debug.c31
1 files changed, 10 insertions, 21 deletions
diff --git a/libguile/debug.c b/libguile/debug.c
index 0f83ea012..c8e908fdf 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,5 +1,5 @@
/* Debugging extensions for Guile
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation
+ * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010 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
@@ -35,6 +35,7 @@
#include "libguile/throw.h"
#include "libguile/macros.h"
#include "libguile/smob.h"
+#include "libguile/struct.h"
#include "libguile/procprop.h"
#include "libguile/srcprop.h"
#include "libguile/alist.h"
@@ -136,18 +137,15 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
"Return the name of the procedure @var{proc}")
#define FUNC_NAME s_scm_procedure_name
{
+ SCM name;
+
SCM_VALIDATE_PROC (1, proc);
- switch (SCM_TYP7 (proc)) {
- case scm_tc7_gsubr:
- return SCM_SUBR_NAME (proc);
- default:
- {
- SCM name = scm_procedure_property (proc, scm_sym_name);
- if (scm_is_false (name) && SCM_PROGRAM_P (proc))
- name = scm_program_name (proc);
- return name;
- }
- }
+ while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
+ proc = SCM_STRUCT_PROCEDURE (proc);
+ name = scm_procedure_property (proc, scm_sym_name);
+ if (scm_is_false (name) && SCM_PROGRAM_P (proc))
+ name = scm_program_name (proc);
+ return name;
}
#undef FUNC_NAME
@@ -210,15 +208,6 @@ scm_reverse_lookup (SCM env, SCM data)
return SCM_BOOL_F;
}
-SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0,
- (SCM id, SCM thunk),
- "Call @var{thunk} on an evaluator stack tagged with @var{id}.")
-#define FUNC_NAME s_scm_sys_start_stack
-{
- return scm_vm_call_with_new_stack (scm_the_vm (), thunk, id);
-}
-#undef FUNC_NAME
-
/* Undocumented debugging procedure */