summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/frames.c9
-rw-r--r--libguile/objcodes.c18
-rw-r--r--libguile/objcodes.h14
-rw-r--r--libguile/programs.c5
-rw-r--r--libguile/vm-engine.c2
-rw-r--r--libguile/vm-i-system.c6
-rw-r--r--libguile/vm.c2
7 files changed, 36 insertions, 20 deletions
diff --git a/libguile/frames.c b/libguile/frames.c
index 80c556b45..5c61eb088 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -111,7 +111,8 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
return scm_c_program_source (SCM_FRAME_PROGRAM (fp),
- SCM_VM_FRAME_IP (frame) - bp->base);
+ SCM_VM_FRAME_IP (frame)
+ - SCM_C_OBJCODE_BASE (bp));
}
#undef FUNC_NAME
@@ -219,10 +220,14 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0,
"")
#define FUNC_NAME s_scm_frame_instruction_pointer
{
+ const struct scm_objcode *c_objcode;
+
SCM_VALIDATE_VM_FRAME (1, frame);
+
+ c_objcode = SCM_PROGRAM_DATA (scm_frame_procedure (frame));
return scm_from_ulong ((unsigned long)
(SCM_VM_FRAME_IP (frame)
- - SCM_PROGRAM_DATA (scm_frame_procedure (frame))->base));
+ - SCM_C_OBJCODE_BASE (c_objcode)));
}
#undef FUNC_NAME
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 1b896df42..87ffaa5d1 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -106,17 +106,19 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
#define FUNC_NAME "make-objcode-slice"
{
const struct scm_objcode *data, *parent_data;
+ const scm_t_uint8 *parent_base;
SCM ret;
SCM_VALIDATE_OBJCODE (1, parent);
parent_data = SCM_OBJCODE_DATA (parent);
-
- if (ptr < parent_data->base
- || ptr >= (parent_data->base + parent_data->len + parent_data->metalen
+ parent_base = SCM_C_OBJCODE_BASE (parent_data);
+
+ if (ptr < parent_base
+ || ptr >= (parent_base + parent_data->len + parent_data->metalen
- sizeof (struct scm_objcode)))
scm_misc_error (FUNC_NAME, "offset out of bounds (~a vs ~a + ~a + ~a)",
- scm_list_4 (scm_from_ulong ((unsigned long)ptr),
- scm_from_ulong ((unsigned long)parent_data->base),
+ scm_list_4 (scm_from_ulong ((unsigned long) ptr),
+ scm_from_ulong ((unsigned long) parent_base),
scm_from_uint32 (parent_data->len),
scm_from_uint32 (parent_data->metalen)));
@@ -125,9 +127,9 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
assert ((((scm_t_bits) ptr) &
(alignof_type (struct scm_objcode) - 1UL)) == 0);
- data = (struct scm_objcode*)ptr;
- if (data->base + data->len + data->metalen > parent_data->base + parent_data->len + parent_data->metalen)
- abort ();
+ data = (struct scm_objcode*) ptr;
+ assert (SCM_C_OBJCODE_BASE (data) + data->len + data->metalen
+ <= parent_base + parent_data->len + parent_data->metalen);
SCM_NEWSMOB2 (ret, scm_tc16_objcode, data, parent);
SCM_SET_SMOB_FLAGS (ret, SCM_F_OBJCODE_IS_SLICE);
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
index ab4db3dab..4627cfb89 100644
--- a/libguile/objcodes.h
+++ b/libguile/objcodes.h
@@ -21,14 +21,20 @@
#include <libguile.h>
-/* objcode data should be directly mappable to this C structure. */
-struct scm_objcode {
+/* Objcode data should be directly mappable to this C structure. */
+struct scm_objcode
+{
scm_t_uint32 len; /* the maximum index of base[] */
scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of
base[] for metadata */
- scm_t_uint8 base[0];
+ /* In C99, we'd have:
+ scm_t_uint8 base[]; */
};
+/* Return a pointer to the base of objcode OBJ. */
+#define SCM_C_OBJCODE_BASE(obj) \
+ ((scm_t_uint8 *)(obj) + sizeof (struct scm_objcode))
+
#define SCM_F_OBJCODE_IS_MMAP (1<<0)
#define SCM_F_OBJCODE_IS_U8VECTOR (1<<1)
#define SCM_F_OBJCODE_IS_SLICE (1<<2)
@@ -42,7 +48,7 @@ SCM_API scm_t_bits scm_tc16_objcode;
#define SCM_OBJCODE_LEN(x) (SCM_OBJCODE_DATA (x)->len)
#define SCM_OBJCODE_META_LEN(x) (SCM_OBJCODE_DATA (x)->metalen)
#define SCM_OBJCODE_TOTAL_LEN(x) (SCM_OBJCODE_LEN (x) + SCM_OBJCODE_META_LEN (x))
-#define SCM_OBJCODE_BASE(x) (SCM_OBJCODE_DATA (x)->base)
+#define SCM_OBJCODE_BASE(x) (SCM_C_OBJCODE_BASE (SCM_OBJCODE_DATA (x)))
#define SCM_OBJCODE_IS_MMAP(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
#define SCM_OBJCODE_IS_U8VECTOR(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_U8VECTOR)
diff --git a/libguile/programs.c b/libguile/programs.c
index 7736ea5e6..336e621e3 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -96,9 +96,12 @@ SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0,
"")
#define FUNC_NAME s_scm_program_base
{
+ const struct scm_objcode *c_objcode;
+
SCM_VALIDATE_PROGRAM (1, program);
- return scm_from_ulong ((unsigned long) SCM_PROGRAM_DATA (program)->base);
+ c_objcode = SCM_PROGRAM_DATA (program);
+ return scm_from_ulong ((unsigned long) SCM_C_OBJCODE_BASE (c_objcode));
}
#undef FUNC_NAME
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 71cb636a6..2d28bbf35 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -92,7 +92,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
CACHE_PROGRAM ();
PUSH (program);
fp = sp + 1;
- ip = bp->base;
+ ip = SCM_C_OBJCODE_BASE (bp);
/* MV-call frame, function & arguments */
PUSH ((SCM)fp); /* dynamic link */
PUSH (0); /* mvra */
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 102c1d791..09da85f9e 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -764,7 +764,7 @@ VM_DEFINE_INSTRUCTION (54, call, "call", 1, -1, 1)
ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0);
- ip = bp->base;
+ ip = SCM_C_OBJCODE_BASE (bp);
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
@@ -841,7 +841,7 @@ VM_DEFINE_INSTRUCTION (55, goto_args, "goto/args", 1, -1, 1)
NULLSTACK (old_sp - sp);
- ip = bp->base;
+ ip = SCM_C_OBJCODE_BASE (bp);
ENTER_HOOK ();
APPLY_HOOK ();
@@ -929,7 +929,7 @@ VM_DEFINE_INSTRUCTION (58, mv_call, "mv-call", 4, -1, 1)
ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra);
- ip = bp->base;
+ ip = SCM_C_OBJCODE_BASE (bp);
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
diff --git a/libguile/vm.c b/libguile/vm.c
index c7ece1158..dc57163fe 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -190,7 +190,7 @@ really_make_boot_program (long nargs)
text[1] = (scm_t_uint8)nargs;
bp = scm_malloc (sizeof (struct scm_objcode) + sizeof (text));
- memcpy (bp->base, text, sizeof (text));
+ memcpy (SCM_C_OBJCODE_BASE (bp), text, sizeof (text));
bp->len = sizeof(text);
bp->metalen = 0;