summaryrefslogtreecommitdiff
path: root/libguile/frames.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/frames.c')
-rw-r--r--libguile/frames.c103
1 files changed, 71 insertions, 32 deletions
diff --git a/libguile/frames.c b/libguile/frames.c
index 11d4f12ee..0bb40579c 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -1,31 +1,47 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 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 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
- * 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
- */
+/* Copyright 2001,2009-2015,2018
+ Free Software Foundation, Inc.
+
+ This file is part of Guile.
+
+ Guile 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 3 of the License, or
+ (at your option) any later version.
+
+ Guile 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 Guile. If not, see
+ <https://www.gnu.org/licenses/>. */
#if HAVE_CONFIG_H
-# include <config.h>
+# include <config.h>
#endif
#include <stdlib.h>
#include <string.h>
-#include "_scm.h"
-#include "frames.h"
+
+#include "boolean.h"
+#include "eval.h"
+#include "extensions.h"
+#include "gsubr.h"
+#include "instructions.h"
+#include "modules.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "symbols.h"
+#include "threads.h"
+#include "variable.h"
+#include "version.h"
#include "vm.h"
+#include "frames.h"
+
+
SCM
scm_c_make_frame (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
{
@@ -315,6 +331,33 @@ scm_frame_local_set_x (SCM frame, SCM index, SCM val, SCM representation)
}
#undef FUNC_NAME
+static const char s_scm_frame_return_values[] = "frame-return-values";
+static SCM
+scm_frame_return_values (SCM frame)
+#define FUNC_NAME s_scm_frame_return_values
+{
+ const uint32_t *ip;
+ union scm_vm_stack_element *fp, *sp;
+ SCM vals = SCM_EOL;
+ size_t n;
+
+ SCM_VALIDATE_VM_FRAME (1, frame);
+
+ ip = SCM_VM_FRAME_IP (frame);
+ fp = SCM_VM_FRAME_FP (frame);
+ sp = SCM_VM_FRAME_SP (frame);
+
+ if ((*ip & 0xff) != scm_op_return_values)
+ scm_wrong_type_arg_msg (FUNC_NAME, 1, frame, "not a return frame");
+
+ n = SCM_FRAME_NUM_LOCALS (fp, sp);
+ while (n--)
+ vals = scm_cons (SCM_FRAME_LOCAL (fp, n), vals);
+
+ return vals;
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_frame_address, "frame-address", 1, 0, 0,
(SCM frame),
"Return the frame pointer for @var{frame}.")
@@ -343,7 +386,7 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0,
{
SCM_VALIDATE_VM_FRAME (1, frame);
- return scm_from_uintptr_t ((scm_t_uintptr) SCM_VM_FRAME_IP (frame));
+ return scm_from_uintptr_t ((uintptr_t) SCM_VM_FRAME_IP (frame));
}
#undef FUNC_NAME
@@ -353,8 +396,8 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
#define FUNC_NAME s_scm_frame_return_address
{
SCM_VALIDATE_VM_FRAME (1, frame);
- return scm_from_uintptr_t ((scm_t_uintptr) (SCM_FRAME_RETURN_ADDRESS
- (SCM_VM_FRAME_FP (frame))));
+ return scm_from_uintptr_t ((uintptr_t) (SCM_FRAME_VIRTUAL_RETURN_ADDRESS
+ (SCM_VM_FRAME_FP (frame))));
}
#undef FUNC_NAME
@@ -366,7 +409,7 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
SCM_VALIDATE_VM_FRAME (1, frame);
/* fixme: munge fp if holder is a continuation */
return scm_from_uintptr_t
- ((scm_t_uintptr)
+ ((uintptr_t)
SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame)));
}
#undef FUNC_NAME
@@ -391,7 +434,7 @@ scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame)
new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
frame->fp_offset = stack_top - new_fp;
frame->sp_offset = stack_top - new_sp;
- frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp);
+ frame->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (this_fp);
if (scm_i_vm_is_boot_continuation_code (frame->ip))
goto again;
@@ -429,13 +472,15 @@ scm_init_frames_builtins (void *unused)
(scm_t_subr) scm_frame_local_ref);
scm_c_define_gsubr (s_scm_frame_local_set_x, 4, 0, 0,
(scm_t_subr) scm_frame_local_set_x);
+ scm_c_define_gsubr (s_scm_frame_return_values, 1, 0, 0,
+ (scm_t_subr) scm_frame_return_values);
}
void
scm_init_frames (void)
{
#ifndef SCM_MAGIC_SNARFER
-#include "libguile/frames.x"
+#include "frames.x"
#endif
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
@@ -443,9 +488,3 @@ scm_init_frames (void)
scm_init_frames_builtins,
NULL);
}
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/