Stack traces skip RTL boot frames
[bpt/guile.git] / libguile / frames.c
index 0338d18..b2973bf 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
@@ -110,7 +110,7 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
 
   proc = scm_frame_procedure (frame);
 
-  if (SCM_PROGRAM_P (proc))
+  if (SCM_PROGRAM_P (proc) || SCM_RTL_PROGRAM_P (proc))
     return scm_program_source (scm_frame_procedure (frame),
                                scm_frame_instruction_pointer (frame),
                                SCM_UNDEFINED);
@@ -129,11 +129,21 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0,
            "")
 #define FUNC_NAME s_scm_frame_num_locals
 {
-  SCM *sp, *p;
+  SCM *fp, *sp, *p;
   unsigned int n = 0;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
 
+  fp = SCM_VM_FRAME_FP (frame);
+  sp = SCM_VM_FRAME_SP (frame);
+  p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
+
+  if (SCM_RTL_PROGRAM_P (fp[-1]))
+    /* The frame size of an RTL program is fixed, except in the case of
+       passing a wrong number of arguments to the program.  So we do
+       need to use an SP for determining the number of locals.  */
+    return scm_from_uint32 (sp + 1 - p);
+
   sp = SCM_VM_FRAME_SP (frame);
   p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
   while (p <= sp)
@@ -250,6 +260,10 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0,
   SCM_VALIDATE_VM_FRAME (1, frame);
   program = scm_frame_procedure (frame);
 
+  if (SCM_RTL_PROGRAM_P (program))
+    return scm_from_ptrdiff_t (SCM_VM_FRAME_IP (frame) -
+                               (scm_t_uint8 *) SCM_RTL_PROGRAM_CODE (program));
+
   if (!SCM_PROGRAM_P (program))
     return SCM_INUM0;
 
@@ -320,7 +334,8 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
                                 SCM_VM_FRAME_OFFSET (frame));
       proc = scm_frame_procedure (frame);
 
-      if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
+      if ((SCM_PROGRAM_P (proc) || SCM_RTL_PROGRAM_P (proc))
+          && SCM_PROGRAM_IS_BOOT (proc))
         goto again;
       else
         return frame;