Represent bytecode pointers (return address and traps) as ints on stack.

Removes most of the out-of-heap pointers the interpreter uses by replacing
them with stack offsets.

Author: stedolan

byterun/backtrace.c

@@ -110,30 +110,33 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise)
     /* testing the code region is needed: PR#1554 */
     caml_backtrace_buffer[caml_backtrace_pos++] = pc;
   }
-  for (/*nothing*/; sp < caml_trapsp; sp++) {
-    code_t p = (code_t) *sp;
-    if (p >= caml_start_code && p < end_code) {
+  for (/*nothing*/; sp < caml_stack_high + caml_trap_sp_off; sp++) {
+    if (Is_long(*sp) && Pc_val(*sp) >= caml_start_code && Pc_val(*sp) < end_code) {
       if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) break;
-      caml_backtrace_buffer[caml_backtrace_pos++] = p;
+      caml_backtrace_buffer[caml_backtrace_pos++] = Pc_val(*sp);
     }
   }
 }
 
 /* returns the next frame pointer (or NULL if none is available);
-   updates *sp to point to the following one, and *trapsp to the next
+   updates *sp to point to the following one, and *trap_spoff to the next
    trap frame, which we will skip when we reach it  */
 
-code_t caml_next_frame_pointer(value ** sp, value ** trapsp)
+code_t caml_next_frame_pointer(value ** sp, intnat * trap_spoff)
 {
   code_t end_code = (code_t) ((char *) caml_start_code + caml_code_size);
 
   while (*sp < caml_stack_high) {
-    code_t *p = (code_t*) (*sp)++;
-    if(&Trap_pc(*trapsp) == p) {
-      *trapsp = Trap_link(*trapsp);
+    value* p = (*sp)++;
+    if(&Trap_pc(caml_stack_high + *trap_spoff) == p) {
+      *trap_spoff = Trap_link(caml_stack_high + *trap_spoff);
       continue;
     }
-    if (*p >= caml_start_code && *p < end_code) return *p;
+    if (Is_long(*p) &&
+        Pc_val(*p) >= caml_start_code &&
+        Pc_val(*p) < end_code) {
+      return Pc_val(*p);
+    }
   }
   return NULL;
 }
@@ -157,10 +160,10 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
   /* first compute the size of the trace */
   {
     value * sp = caml_extern_sp;
-    value * trapsp = caml_trapsp;
+    intnat trap_spoff = caml_trap_sp_off;
 
     for (trace_size = 0; trace_size < max_frames; trace_size++) {
-      code_t p = caml_next_frame_pointer(&sp, &trapsp);
+      code_t p = caml_next_frame_pointer(&sp, &trap_spoff);
       if (p == NULL) break;
     }
   }
@@ -170,11 +173,11 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
   /* then collect the trace */
   {
     value * sp = caml_extern_sp;
-    value * trapsp = caml_trapsp;
+    intnat trap_spoff = caml_trap_sp_off;
     uintnat trace_pos;
 
     for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
-      code_t p = caml_next_frame_pointer(&sp, &trapsp);
+      code_t p = caml_next_frame_pointer(&sp, &trap_spoff);
       Assert(p != NULL);
       /* The assignment below is safe because we assign into an Abstract_tag block */
       Field(trace, trace_pos) = (value) p;

byterun/callback.c

@@ -70,7 +70,7 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
   caml_extern_sp -= narg + 4;
   for (i = 0; i < narg; i++) caml_extern_sp[i] = args[i]; /* arguments */
 #ifndef LOCAL_CALLBACK_BYTECODE
-  caml_extern_sp[narg] = (value) (callback_code + 4); /* return address */
+  caml_extern_sp[narg] = Val_pc (callback_code + 4); /* return address */
   caml_extern_sp[narg + 1] = Val_unit;    /* environment */
   caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
   caml_extern_sp[narg + 3] = closure;
@@ -79,7 +79,7 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
   callback_code[3] = narg;
   res = caml_interprete(callback_code, sizeof(callback_code));
 #else /*have LOCAL_CALLBACK_BYTECODE*/
-  caml_extern_sp[narg] = (value) (local_callback_code + 4); /* return address */
+  caml_extern_sp[narg] = Val_pc (local_callback_code + 4); /* return address */
   caml_extern_sp[narg + 1] = Val_unit;    /* environment */
   caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
   caml_extern_sp[narg + 3] = closure;

byterun/compatibility.h

@@ -271,8 +271,6 @@
 #define stack_high caml_stack_high
 #define stack_threshold caml_stack_threshold
 #define extern_sp caml_extern_sp
-#define trapsp caml_trapsp
-#define trap_barrier caml_trap_barrier
 
 /* **** asmrun/startup.c */
 #define static_data_start caml_static_data_start

byterun/debugger.c

@@ -211,7 +211,7 @@ void caml_debugger_init(void)
   }
   open_connection();
   caml_debugger_in_use = 1;
-  caml_trap_barrier = caml_stack_high;
+  caml_trap_barrier_off = 0;
 }
 
 static value getval(struct channel *chan)
@@ -372,7 +372,7 @@ void caml_debugger(enum event_kind event)
       break;
     case REQ_SET_TRAP_BARRIER:
       i = caml_getword(dbg_in);
-      caml_trap_barrier = caml_stack_high - i;
+      caml_trap_barrier_off = -i;
       break;
     case REQ_GET_LOCAL:
       i = caml_getword(dbg_in);

byterun/interp.c

@@ -77,13 +77,13 @@ sp is a local copy of the global variable caml_extern_sp. */
     sp[0] = accu; /* accu */ \
     sp[1] = Val_unit; /* C_CALL frame: dummy environment */ \
     sp[2] = Val_unit; /* RETURN frame: dummy local 0 */ \
-    sp[3] = (value) pc; /* RETURN frame: saved return address */ \
+    sp[3] = Val_pc(pc); /* RETURN frame: saved return address */  \
     sp[4] = env; /* RETURN frame: saved environment */ \
     sp[5] = Val_long(extra_args); /* RETURN frame: saved extra args */ \
     caml_extern_sp = sp; }
 #define Restore_after_event \
   { sp = caml_extern_sp; accu = sp[0]; \
-    pc = (code_t) sp[3]; env = sp[4]; extra_args = Long_val(sp[5]); \
+    pc = Pc_val(sp[3]); env = sp[4]; extra_args = Long_val(sp[5]); \
     sp += 6; }
 
 /* Debugger interface */
@@ -379,7 +379,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
 
     Instruct(PUSH_RETADDR): {
       sp -= 3;
-      sp[0] = (value) (pc + *pc);
+      sp[0] = Val_pc(pc + *pc);
       sp[1] = env;
       sp[2] = Val_long(extra_args);
       pc++;
@@ -395,7 +395,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       value arg1 = sp[0];
       sp -= 3;
       sp[0] = arg1;
-      sp[1] = (value)pc;
+      sp[1] = Val_pc(pc);
       sp[2] = env;
       sp[3] = Val_long(extra_args);
       pc = Code_val(accu);
@@ -409,7 +409,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       sp -= 3;
       sp[0] = arg1;
       sp[1] = arg2;
-      sp[2] = (value)pc;
+      sp[2] = Val_pc(pc);
       sp[3] = env;
       sp[4] = Val_long(extra_args);
       pc = Code_val(accu);
@@ -425,7 +425,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       sp[0] = arg1;
       sp[1] = arg2;
       sp[2] = arg3;
-      sp[3] = (value)pc;
+      sp[3] = Val_pc(pc);
       sp[4] = env;
       sp[5] = Val_long(extra_args);
       pc = Code_val(accu);
@@ -489,7 +489,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
         pc = Code_val(accu);
         env = accu;
       } else {
-        pc = (code_t)(sp[0]);
+        pc = Pc_val(sp[0]);
         env = sp[1];
         extra_args = Long_val(sp[2]);
         sp += 3;
@@ -517,9 +517,9 @@ value caml_interprete(code_t prog, asize_t prog_size)
         Alloc_small(accu, num_args + 2, Closure_tag);
         Field(accu, 1) = env;
         for (i = 0; i < num_args; i++) Field(accu, i + 2) = sp[i];
-        Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
+        Field(accu, 0) = Val_bytecode(pc - 3); /* Point to the preceding RESTART instr. */
         sp += num_args;
-        pc = (code_t)(sp[0]);
+        pc = Pc_val(sp[0]);
         env = sp[1];
         extra_args = Long_val(sp[2]);
         sp += 3;
@@ -532,7 +532,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       int i;
       if (nvars > 0) *--sp = accu;
       Alloc_small(accu, 1 + nvars, Closure_tag);
-      Code_val(accu) = pc + *pc;
+      Field(accu, 0) = Val_bytecode(pc + *pc);
       pc++;
       for (i = 0; i < nvars; i++) Field(accu, i + 1) = sp[i];
       sp += nvars;
@@ -552,13 +552,13 @@ value caml_interprete(code_t prog, asize_t prog_size)
       }
       sp += nvars;
       p = &Field(accu, 0);
-      *p = (value) (pc + pc[0]);
+      *p = Val_bytecode(pc + pc[0]);
       *--sp = accu;
       p++;
       for (i = 1; i < nfuncs; i++) {
         *p = Make_header(i * 2, Infix_tag, Caml_white);  /* color irrelevant. */
         p++;
-        *p = (value) (pc + pc[i]);
+        *p = Val_bytecode (pc + pc[i]);
         *--sp = (value) p;
         p++;
       }
@@ -800,11 +800,11 @@ value caml_interprete(code_t prog, asize_t prog_size)
 
     Instruct(PUSHTRAP):
       sp -= 4;
-      Trap_pc(sp) = pc + *pc;
-      Trap_link(sp) = caml_trapsp;
+      Trap_pc(sp) = Val_pc(pc + *pc);
+      Trap_link(sp) = Val_long(caml_trap_sp_off);
       sp[2] = env;
       sp[3] = Val_long(extra_args);
-      caml_trapsp = sp;
+      caml_trap_sp_off = sp - caml_stack_high;
       pc++;
       Next;
 
@@ -816,35 +816,34 @@ value caml_interprete(code_t prog, asize_t prog_size)
         pc--; /* restart the POPTRAP after processing the signal */
         goto process_signal;
       }
-      caml_trapsp = Trap_link(sp);
+      caml_trap_sp_off = Long_val(Trap_link(sp));
       sp += 4;
       Next;
 
     Instruct(RAISE_NOTRACE):
-      if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER);
+      if (caml_trap_sp_off >= caml_trap_barrier_off) caml_debugger(TRAP_BARRIER);
       goto raise_notrace;
 
     Instruct(RERAISE):
-      if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER);
+      if (caml_trap_sp_off >= caml_trap_barrier_off) caml_debugger(TRAP_BARRIER);
       if (caml_backtrace_active) caml_stash_backtrace(accu, pc, sp, 1);
       goto raise_notrace;
 
     Instruct(RAISE):
     raise_exception:
-      if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER);
+      if (caml_trap_sp_off >= caml_trap_barrier_off) caml_debugger(TRAP_BARRIER);
       if (caml_backtrace_active) caml_stash_backtrace(accu, pc, sp, 0);
     raise_notrace:
-      if ((char *) caml_trapsp
-          >= (char *) caml_stack_high - initial_sp_offset) {
+      if (caml_trap_sp_off >= -initial_sp_offset) {
         caml_external_raise = initial_external_raise;
         caml_extern_sp = (value *) ((char *) caml_stack_high
                                     - initial_sp_offset);
         caml_callback_depth--;
         return Make_exception_result(accu);
       }
-      sp = caml_trapsp;
-      pc = Trap_pc(sp);
-      caml_trapsp = Trap_link(sp);
+      sp = caml_stack_high + caml_trap_sp_off;
+      pc = Pc_val(Trap_pc(sp));
+      caml_trap_sp_off = Long_val(Trap_link(sp));
       env = sp[2];
       extra_args = Long_val(sp[3]);
       sp += 4;

byterun/meta.c

@@ -56,7 +56,7 @@ CAMLprim value caml_reify_bytecode(value prog, value len)
 #endif
   caml_prepare_bytecode((code_t) prog, (asize_t) Long_val(len));
   clos = caml_alloc_small (1, Closure_tag);
-  Code_val(clos) = (code_t) prog;
+  Field(clos, 0) = Val_bytecode(prog);
   return clos;
 }
 
@@ -175,7 +175,7 @@ value * caml_stack_low;
 value * caml_stack_high;
 value * caml_stack_threshold;
 value * caml_extern_sp;
-value * caml_trapsp;
+intnat caml_trap_sp_off;
 int caml_callback_depth;
 int volatile caml_something_to_do;
 void (* volatile caml_async_action_hook)(void);

byterun/mlvalues.h

@@ -196,9 +196,14 @@ CAMLextern value caml_get_public_method (value obj, value tag);
    Note however that tags being hashed, same tag does not necessarily mean
    same method name. */
 
+#define Val_pc(pc) (Assert(((value)(pc) & 1) == 0), (value)(((char*)(pc)) + 1))
+#define Pc_val(val) (Assert(val & 1),  (code_t)((char*)(val) - 1))
+
 /* Special case of tuples of fields: closures */
 #define Closure_tag 247
-#define Code_val(val) (((code_t *) (val)) [0])     /* Also an l-value. */
+#define Bytecode_val(val) ((code_t)(val))
+#define Val_bytecode(code) ((value)(code))
+#define Code_val(val) Bytecode_val(Field((val), 0))
 
 /* This tag is used (with Forward_tag) to implement lazy values.
    See major_gc.c and stdlib/lazy.ml. */

byterun/stacks.c

@@ -24,8 +24,8 @@ CAMLexport value * caml_stack_low;
 CAMLexport value * caml_stack_high;
 CAMLexport value * caml_stack_threshold;
 CAMLexport value * caml_extern_sp;
-CAMLexport value * caml_trapsp;
-CAMLexport value * caml_trap_barrier;
+CAMLexport intnat caml_trap_sp_off;
+CAMLexport intnat caml_trap_barrier_off;
 value caml_global_data = 0;
 
 uintnat caml_max_stack_size;            /* also used in gc_ctrl.c */
@@ -36,8 +36,8 @@ void caml_init_stack (uintnat initial_max_size)
   caml_stack_high = caml_stack_low + Stack_size / sizeof (value);
   caml_stack_threshold = caml_stack_low + Stack_threshold / sizeof (value);
   caml_extern_sp = caml_stack_high;
-  caml_trapsp = caml_stack_high;
-  caml_trap_barrier = caml_stack_high + 1;
+  caml_trap_sp_off = 0;
+  caml_trap_barrier_off = 1;
   caml_max_stack_size = initial_max_size;
   caml_gc_message (0x08, "Initial stack limit: %luk bytes\n",
                    caml_max_stack_size / 1024 * sizeof (value));
@@ -47,7 +47,6 @@ void caml_realloc_stack(asize_t required_space)
 {
   asize_t size;
   value * new_low, * new_high, * new_sp;
-  value * p;
 
   Assert(caml_extern_sp >= caml_stack_low);
   size = caml_stack_high - caml_stack_low;
@@ -69,10 +68,6 @@ void caml_realloc_stack(asize_t required_space)
           (char *) caml_extern_sp,
           (caml_stack_high - caml_extern_sp) * sizeof(value));
   caml_stat_free(caml_stack_low);
-  caml_trapsp = (value *) shift(caml_trapsp);
-  caml_trap_barrier = (value *) shift(caml_trap_barrier);
-  for (p = caml_trapsp; p < new_high; p = Trap_link(p))
-    Trap_link(p) = (value *) shift(Trap_link(p));
   caml_stack_low = new_low;
   caml_stack_high = new_high;
   caml_stack_threshold = caml_stack_low + Stack_threshold / sizeof (value);

byterun/stacks.h

@@ -25,11 +25,13 @@ CAMLextern value * caml_stack_low;
 CAMLextern value * caml_stack_high;
 CAMLextern value * caml_stack_threshold;
 CAMLextern value * caml_extern_sp;
-CAMLextern value * caml_trapsp;
-CAMLextern value * caml_trap_barrier;
+CAMLextern intnat caml_trap_sp_off;
+CAMLextern intnat caml_trap_barrier_off;
 
-#define Trap_pc(tp) (((code_t *)(tp))[0])
-#define Trap_link(tp) (((value **)(tp))[1])
+#define Val_off(off) (caml_stack_high + Long_val (off))
+#define Off_val(p) Val_long (caml_stack_high - Long_val (p))
+#define Trap_pc(tp) Field((tp), 0)
+#define Trap_link(tp) Field((tp), 1)
 
 void caml_init_stack (uintnat init_max_size);
 void caml_realloc_stack (asize_t required_size);