mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

frame-source available in default environment

Browse source 
* libguile/frames.c (scm_frame_source): Don't call out to (system vm
  frames), as this routine is used when printing exceptions.  Make
  available in the default environment (ugh).

* module/system/vm/frame.scm: Remove frame-source definition and
  export.
This commit is contained in:
Andy Wingo 2011-02-11 12:43:05 +01:00
parent 7948811252
commit 423fca76e6
2 changed files with 12 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

19
libguile/frames.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 2001, 2009, 2010, 2011 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
@ -92,17 +92,18 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
}
#undef FUNC_NAME
SCM
scm_frame_source (SCM frame)
SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
(SCM frame),
"")
#define FUNC_NAME s_scm_frame_source
{
static SCM var = SCM_BOOL_F;
if (scm_is_false (var))
var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
"frame-source");
SCM_VALIDATE_VM_FRAME (1, frame);
return scm_call_1 (SCM_VARIABLE_REF (var), frame);
return scm_program_source (scm_frame_procedure (frame),
scm_frame_instruction_pointer (frame),
SCM_UNDEFINED);
}
#undef FUNC_NAME
/* The number of locals would be a simple thing to compute, if it weren't for
the presence of not-yet-active frames on the stack. So we have a cheap

10
module/system/vm/frame.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM frame functions
;;; Copyright (C) 2001, 2005, 2009, 2010 Free Software Foundation, Inc.
;;; Copyright (C) 2001, 2005, 2009, 2010, 2011 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
@ -26,7 +26,7 @@
#:export (frame-bindings
frame-lookup-binding
frame-binding-ref frame-binding-set!
frame-source frame-next-source frame-call-representation
frame-next-source frame-call-representation
frame-environment
frame-object-binding frame-object-name
frame-return-values))
@ -70,12 +70,6 @@
;;; Pretty printing
;;;
(define (frame-source frame)
(let ((proc (frame-procedure frame)))
(program-source proc
(frame-instruction-pointer frame)
(program-sources proc))))
(define (frame-next-source frame)
(let ((proc (frame-procedure frame)))
(program-source proc