diff options
Diffstat (limited to 'libguile/frames.c')
-rw-r--r-- | libguile/frames.c | 200 |
1 files changed, 91 insertions, 109 deletions
diff --git a/libguile/frames.c b/libguile/frames.c index a7143c411..b0f451f7d 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -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 @@ -24,11 +24,12 @@ #include <string.h> #include "_scm.h" #include "frames.h" +#include "vm.h" #include <verify.h> /* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */ verify (sizeof (SCM) == sizeof (SCM *)); -verify (sizeof (struct scm_vm_frame) == 5 * sizeof (SCM)); +verify (sizeof (struct scm_vm_frame) == 3 * sizeof (SCM)); verify (offsetof (struct scm_vm_frame, dynamic_link) == 0); @@ -36,30 +37,78 @@ verify (offsetof (struct scm_vm_frame, dynamic_link) == 0); (((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame)) SCM -scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp, - scm_t_uint8 *ip, scm_t_ptrdiff offset) +scm_c_make_frame (enum scm_vm_frame_kind frame_kind, void *stack_holder, + scm_t_ptrdiff fp_offset, scm_t_ptrdiff sp_offset, + scm_t_uint32 *ip) { struct scm_frame *p = scm_gc_malloc (sizeof (struct scm_frame), "vmframe"); p->stack_holder = stack_holder; - p->fp = fp; - p->sp = sp; + p->fp_offset = fp_offset; + p->sp_offset = sp_offset; p->ip = ip; - p->offset = offset; - return scm_cell (scm_tc7_frame, (scm_t_bits)p); + return scm_cell (scm_tc7_frame | (frame_kind << 8), (scm_t_bits)p); } void scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate) { - scm_puts ("#<frame ", port); + scm_puts_unlocked ("#<frame ", port); scm_uintprint (SCM_UNPACK (frame), 16, port); - scm_putc (' ', port); + scm_putc_unlocked (' ', port); scm_write (scm_frame_procedure (frame), port); /* don't write args, they can get us into trouble. */ - scm_puts (">", port); + scm_puts_unlocked (">", port); } +SCM* +scm_i_frame_stack_base (SCM frame) +#define FUNC_NAME "frame-stack-base" +{ + void *stack_holder; + + SCM_VALIDATE_VM_FRAME (1, frame); + + stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame); + + switch (SCM_VM_FRAME_KIND (frame)) + { + case SCM_VM_FRAME_KIND_CONT: + return ((struct scm_vm_cont *) stack_holder)->stack_base; + + case SCM_VM_FRAME_KIND_VM: + return ((struct scm_vm *) stack_holder)->stack_base; + + default: + abort (); + } +} +#undef FUNC_NAME + +scm_t_ptrdiff +scm_i_frame_offset (SCM frame) +#define FUNC_NAME "frame-offset" +{ + void *stack_holder; + + SCM_VALIDATE_VM_FRAME (1, frame); + + stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame); + + switch (SCM_VM_FRAME_KIND (frame)) + { + case SCM_VM_FRAME_KIND_CONT: + return ((struct scm_vm_cont *) stack_holder)->reloc; + + case SCM_VM_FRAME_KIND_VM: + return 0; + + default: + abort (); + } +} +#undef FUNC_NAME + /* Scheme interface */ @@ -104,81 +153,45 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0, "") #define FUNC_NAME s_scm_frame_source { - SCM proc; - SCM_VALIDATE_VM_FRAME (1, frame); - proc = scm_frame_procedure (frame); - - if (SCM_PROGRAM_P (proc)) - return scm_program_source (scm_frame_procedure (frame), - scm_frame_instruction_pointer (frame), - SCM_UNDEFINED); - - return SCM_BOOL_F; + return scm_find_source_for_addr (scm_frame_instruction_pointer (frame)); } #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 - heuristic to detect not-yet-active frames, and skip over them. Perhaps we - should represent them more usefully. -*/ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0, (SCM frame), "") #define FUNC_NAME s_scm_frame_num_locals { - SCM *sp, *p; - unsigned int n = 0; + SCM *fp, *sp; 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)); - while (p <= sp) - { - if (SCM_UNPACK (p[0]) == 0) - /* skip over not-yet-active frame */ - p += 3; - else - { - p++; - n++; - } - } - return scm_from_uint (n); + + return scm_from_ptrdiff_t (SCM_FRAME_NUM_LOCALS (fp, sp)); } #undef FUNC_NAME -/* Need same not-yet-active frame logic here as in frame-num-locals */ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0, (SCM frame, SCM index), "") #define FUNC_NAME s_scm_frame_local_ref { - SCM *sp, *p; - unsigned int n = 0; + SCM *fp, *sp; unsigned int i; SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_UINT_COPY (2, index, i); + fp = SCM_VM_FRAME_FP (frame); sp = SCM_VM_FRAME_SP (frame); - p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); - while (p <= sp) - { - if (SCM_UNPACK (p[0]) == 0) - /* skip over not-yet-active frame */ - p += 3; - else if (n == i) - return *p; - else - { - p++; - n++; - } - } + + if (i < SCM_FRAME_NUM_LOCALS (fp, sp)) + return SCM_FRAME_LOCAL (fp, i); + SCM_OUT_OF_RANGE (SCM_ARG2, index); } #undef FUNC_NAME @@ -189,31 +202,21 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0, "") #define FUNC_NAME s_scm_frame_local_set_x { - SCM *sp, *p; - unsigned int n = 0; + SCM *fp, *sp; unsigned int i; SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_UINT_COPY (2, index, i); + fp = SCM_VM_FRAME_FP (frame); sp = SCM_VM_FRAME_SP (frame); - p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); - while (p <= sp) + + if (i < SCM_FRAME_NUM_LOCALS (fp, sp)) { - if (SCM_UNPACK (p[0]) == 0) - /* skip over not-yet-active frame */ - p += 3; - else if (n == i) - { - *p = val; - return SCM_UNSPECIFIED; - } - else - { - p++; - n++; - } + SCM_FRAME_LOCAL (fp, i) = val; + return SCM_UNSPECIFIED; } + SCM_OUT_OF_RANGE (SCM_ARG2, index); } #undef FUNC_NAME @@ -224,7 +227,7 @@ SCM_DEFINE (scm_frame_address, "frame-address", 1, 0, 0, #define FUNC_NAME s_scm_frame_address { SCM_VALIDATE_VM_FRAME (1, frame); - return scm_from_unsigned_integer ((scm_t_bits) SCM_VM_FRAME_FP (frame)); + return scm_from_uintptr_t ((scm_t_uintptr) SCM_VM_FRAME_FP (frame)); } #undef FUNC_NAME @@ -235,7 +238,7 @@ SCM_DEFINE (scm_frame_stack_pointer, "frame-stack-pointer", 1, 0, 0, { SCM_VALIDATE_VM_FRAME (1, frame); - return scm_from_unsigned_integer ((scm_t_bits) SCM_VM_FRAME_SP (frame)); + return scm_from_uintptr_t ((scm_t_uintptr) SCM_VM_FRAME_SP (frame)); } #undef FUNC_NAME @@ -244,18 +247,9 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0, "") #define FUNC_NAME s_scm_frame_instruction_pointer { - SCM program; - const struct scm_objcode *c_objcode; - SCM_VALIDATE_VM_FRAME (1, frame); - program = scm_frame_procedure (frame); - - if (!SCM_PROGRAM_P (program)) - return SCM_INUM0; - c_objcode = SCM_PROGRAM_DATA (program); - return scm_from_unsigned_integer ((SCM_VM_FRAME_IP (frame) - - SCM_C_OBJCODE_BASE (c_objcode))); + return scm_from_uintptr_t ((scm_t_uintptr) SCM_VM_FRAME_IP (frame)); } #undef FUNC_NAME @@ -265,21 +259,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_unsigned_integer ((scm_t_bits) - (SCM_FRAME_RETURN_ADDRESS - (SCM_VM_FRAME_FP (frame)))); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_frame_mv_return_address, "frame-mv-return-address", 1, 0, 0, - (SCM frame), - "") -#define FUNC_NAME s_scm_frame_mv_return_address -{ - SCM_VALIDATE_VM_FRAME (1, frame); - return scm_from_unsigned_integer ((scm_t_bits) - (SCM_FRAME_MV_RETURN_ADDRESS - (SCM_VM_FRAME_FP (frame)))); + return scm_from_uintptr_t ((scm_t_uintptr) (SCM_FRAME_RETURN_ADDRESS + (SCM_VM_FRAME_FP (frame)))); } #undef FUNC_NAME @@ -290,8 +271,8 @@ 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_ulong - ((unsigned long) + return scm_from_uintptr_t + ((scm_t_uintptr) RELOC (frame, SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame)))); } @@ -312,12 +293,13 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp); if (new_fp) { + SCM *stack_base = scm_i_frame_stack_base (frame); new_fp = RELOC (frame, new_fp); - new_sp = SCM_FRAME_LOWER_ADDRESS (this_fp) - 1; - frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame), - new_fp, new_sp, - SCM_FRAME_RETURN_ADDRESS (this_fp), - SCM_VM_FRAME_OFFSET (frame)); + new_sp = SCM_FRAME_PREVIOUS_SP (this_fp); + frame = scm_c_make_frame (SCM_VM_FRAME_KIND (frame), + SCM_VM_FRAME_STACK_HOLDER (frame), + new_fp - stack_base, new_sp - stack_base, + SCM_FRAME_RETURN_ADDRESS (this_fp)); proc = scm_frame_procedure (frame); if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc)) |