Permalink
Browse files

Forward port: Address a core runtime issue that resulted in 32bit tru…

…ncation of pointers to the stack when in 64bit mode.
  • Loading branch information...
1 parent 4034888 commit ed52cf17c47ee1adc2e3e05328b5e6d12bc2fcd1 @waywardmonkeys waywardmonkeys committed Dec 11, 2010
View
@@ -39,7 +39,7 @@ AC_SUBST(VERSION)
# $srcdir/version when incrementing this value.)
#--------------------------------------------------------------------
-CURRENT_BOOTSTRAP_COUNTER=1008
+CURRENT_BOOTSTRAP_COUNTER=1009
AC_SUBST(CURRENT_BOOTSTRAP_COUNTER)
#--------------------------------------------------------------------
@@ -943,11 +943,13 @@ define-primitive-emitter
let (state-expr, temp?)
= ref-leaf(*ptr-rep*, operation.depends-on.source-exp, file);
contact-bgh-if(temp?);
- let cluster = operation.depends-on.dependent-next.source-exp;
+ let sp = operation.depends-on.dependent-next.source-exp;
+ let (sp-name, sp-rep) = c-name-and-rep(sp, file);
+ let cluster = operation.depends-on.dependent-next.dependent-next.source-exp;
let (bottom-name, top-name) = consume-cluster(cluster, file);
spew-pending-defines(file);
format(file.file-guts-stream,
- "throw(%s, %s);\n", state-expr, top-name);
+ "throw(%s, %s, %s);\n", state-expr, sp-name, top-name);
end);
@@ -382,7 +382,7 @@ define-primitive
(#"unwind-stack", #(#"<raw-pointer>"), #(values:));
define-primitive
- (#"throw", #(#"<raw-pointer>", #"cluster"), #(union:));
+ (#"throw", #(#"<raw-pointer>", #"<raw-pointer>", #"cluster"), #(union:));
// Fixnum operations.
View
@@ -3,29 +3,38 @@
#include <setjmp.h>
/*
-Changes:
-
-- portable version using setjmp/jongjmp (andreas)
-
-*/
+ * We implement catch / throw here via setjmp / longjmp.
+ * Unfortunately, setjmp and longjmp exchange data via
+ * a 32 bit integer on most 64 bit platforms, so we
+ * can not just send back a pointer to the stack when
+ * we throw. We work around this by sending back the
+ * difference between the 2 stack pointers instead.
+ *
+ * As a further complication, passing 0 to longjmp results
+ * in a 1 being returned from setjmp, so we bias the result
+ * by +1 to work around that (we never need to send -1
+ * through the longjmp).
+ */
descriptor_t *catch(descriptor_t *(*fn)(descriptor_t *sp, void *state,
- heapptr_t body_func),
- descriptor_t *sp, heapptr_t body_func)
+ heapptr_t body_func),
+ descriptor_t *sp, heapptr_t body_func)
{
jmp_buf state;
- long rc;
+ int rc;
if ((rc = setjmp(state))) { /* This _is_ an assignment */
/* longjmp was called, return stack_top */
- return (descriptor_t *)rc;
+ /* See comment above for explanation of the -1 bias. */
+ return (descriptor_t *)(sp + rc - 1);
} else {
/* first pass */
return fn(sp, state, body_func);
}
}
-void throw(void *state, descriptor_t *stack_top)
+void throw(void *state, descriptor_t *sp, descriptor_t *stack_top)
{
- longjmp(state, (long)stack_top);
+ /* See comment above for explanation of the +1 bias. */
+ longjmp(state, (int)(stack_top - sp + 1));
}
@@ -116,5 +116,5 @@ define function throw (catcher :: <catcher>, values :: <simple-object-vector>)
%%primitive(unwind-stack, catcher.saved-stack);
this-thread.thread-current-handler := catcher.saved-handler;
// Note: the values-sequence has to happen after the unwind-stack.
- %%primitive(throw, catcher.saved-state, values-sequence(values));
+ %%primitive(throw, catcher.saved-state, catcher.saved-stack, values-sequence(values));
end;
View
@@ -52,7 +52,7 @@ extern heapptr_t make_trampoline(void *func, descriptor_t closure,
extern descriptor_t *catch(descriptor_t *(*fn)(descriptor_t *sp, void *state,
heapptr_t thunk),
descriptor_t *sp, heapptr_t func);
-extern void throw(void *state, descriptor_t *stack_top);
+extern void throw(void *state, descriptor_t *sp, descriptor_t *stack_top);
extern descriptor_t *pad_cluster(descriptor_t *start, descriptor_t *end,
int min_values);
View
@@ -1 +1 @@
-2.5.0pre3
+2.5.0pre4

0 comments on commit ed52cf1

Please sign in to comment.