flambda-backend: Long frames in frametable (#797)

runtime/backtrace_nat.c

@@ -47,7 +47,7 @@ frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp)
     /* Skip to next frame */
     if (d->frame_size != 0xFFFF) {
       /* Regular frame, update sp/pc and return the frame descriptor */
-      *sp += (d->frame_size & 0xFFFC);
+      *sp += (get_frame_size(d) & 0xFFFFFFFC);
       *pc = Saved_return_address(*sp);
 #ifdef Mask_already_scanned
       *pc = Mask_already_scanned(*pc);
@@ -164,17 +164,19 @@ static debuginfo debuginfo_extract(frame_descr* d, int alloc_idx)
 {
   unsigned char* infoptr;
   uint32_t debuginfo_offset;
+  uint32_t frame_size;
 
   /* The special frames marking the top of an ML stack chunk are never
      returned by caml_next_frame_descriptor, so should never reach here. */
-  CAMLassert(d->frame_size != 0xffff);
+  CAMLassert(d->frame_size != 0xFFFF);
+  frame_size = get_frame_size(d);
 
-  if ((d->frame_size & 1) == 0) {
+  if ((frame_size & 1) == 0) {
     return NULL;
   }
   /* Recover debugging info */
-  infoptr = (unsigned char*)&d->live_ofs[d->num_live];
-  if (d->frame_size & 2) {
+  infoptr = get_end_of_live_ofs(d);
+  if (frame_size & 2) {
     CAMLassert(alloc_idx == -1 || (0 <= alloc_idx && alloc_idx < *infoptr));
     /* skip alloc_lengths */
     infoptr += *infoptr + 1;

runtime/caml/stack.h

@@ -86,7 +86,6 @@ struct caml_context {
 };
 
 /* Structure of frame descriptors */
-
 typedef struct {
   uintnat retaddr;
   unsigned short frame_size;
@@ -104,6 +103,29 @@ typedef struct {
     num_debug is num_alloc if frame_size & 2, otherwise 1. */
 } frame_descr;
 
+typedef struct {
+  uintnat retaddr;
+  unsigned short marker;        /* LONG_FRAME_MARKER */
+  unsigned short _pad;  /* Ensure frame_size is 4-byte aligned */
+  uint32_t frame_size;
+  uint32_t num_live;
+  uint32_t live_ofs[1 /* num_live */];
+  /*
+    If frame_size & 2, then allocation info follows:
+  unsigned char num_allocs;
+  unsigned char alloc_lengths[num_alloc];
+
+    If frame_size & 1, then debug info follows:
+  uint32_t debug_info_offset[num_debug];
+
+    Debug info is stored as relative offsets to debuginfo structures.
+    num_debug is num_alloc if frame_size & 2, otherwise 1. */
+} frame_descr_long;
+
+/* Helpers for long frames */
+uint32_t get_frame_size(frame_descr *);
+unsigned char * get_end_of_live_ofs (frame_descr *d);
+
 /* Allocation lengths are encoded as 0-255, giving sizes 1-256 */
 #define Wosize_encoded_alloc_len(n) ((uintnat)(n) + 1)
 

runtime/roots_nat.c

@@ -80,21 +80,48 @@ static link* frametables_list_tail(link *list) {
   return tail;
 }
 
+/* Special marker instead of frame_size for frame_descr in long format */
+static uint32_t LONG_FRAME_MARKER = 0x7FFF;
+
+uint32_t get_frame_size(frame_descr *d) {
+  CAMLassert(d && d->frame_size != 0xFFFF);
+  if (d->frame_size == LONG_FRAME_MARKER) {
+    /* Handle long frames */
+    frame_descr_long *dl = (frame_descr_long *)d;
+    return (dl->frame_size);
+  } else {
+    return (d->frame_size);
+  }
+}
+
+/* Skip to end of live_ofs */
+unsigned char * get_end_of_live_ofs (frame_descr *d) {
+  CAMLassert(d && d->frame_size != 0xFFFF);
+  if (d->frame_size == LONG_FRAME_MARKER) {
+    /* Handle long frames */
+    frame_descr_long *dl = (frame_descr_long *)d;
+    return ((unsigned char*)&dl->live_ofs[dl->num_live]);
+  } else {
+    return ((unsigned char*)&d->live_ofs[d->num_live]);
+  }
+}
+
 static frame_descr * next_frame_descr(frame_descr * d) {
   unsigned char num_allocs = 0, *p;
+  uint32_t frame_size;
   CAMLassert(d->retaddr >= 4096);
-  /* Skip to end of live_ofs */
-  p = (unsigned char*)&d->live_ofs[d->num_live];
+  frame_size = get_frame_size(d);
+  p = get_end_of_live_ofs(d);
   /* Skip alloc_lengths if present */
-  if (d->frame_size & 2) {
+  if (frame_size & 2) {
     num_allocs = *p;
     p += num_allocs + 1;
   }
   /* Skip debug info if present */
-  if (d->frame_size & 1) {
+  if (frame_size & 1) {
     /* Align to 32 bits */
     p = Align_to(p, uint32_t);
-    p += sizeof(uint32_t) * (d->frame_size & 2 ? num_allocs : 1);
+    p += sizeof(uint32_t) * (frame_size & 2 ? num_allocs : 1);
   }
   /* Align to word size */
   p = Align_to(p, void*);
@@ -624,17 +651,33 @@ void caml_do_local_roots_nat(scanning_action maj, scanning_action min,
       }
       if (d->frame_size != 0xFFFF) {
         /* Scan the roots in this frame */
-        for (p = d->live_ofs, n = d->num_live; n > 0; n--, p++) {
-          ofs = *p;
-          if (ofs & 1) {
-            root = regs + (ofs >> 1);
-          } else {
-            root = (value *)(sp + ofs);
+        if (d->frame_size == LONG_FRAME_MARKER) {
+          /* Handle long frames */
+          frame_descr_long *dl = (frame_descr_long *)d;
+          uint32_t * p;
+          uint32_t n;
+          for (p = dl->live_ofs, n = dl->num_live; n > 0; n--, p++) {
+            uint32_t ofs = *p;
+            if (ofs & 1) {
+              root = regs + (ofs >> 1);
+            } else {
+              root = (value *)(sp + ofs);
+            }
+            visit(maj, min, root);
+          }
+        } else {
+          for (p = d->live_ofs, n = d->num_live; n > 0; n--, p++) {
+            ofs = *p;
+            if (ofs & 1) {
+              root = regs + (ofs >> 1);
+            } else {
+              root = (value *)(sp + ofs);
+            }
+            visit(maj, min, root);
           }
-          visit(maj, min, root);
         }
         /* Move to next frame */
-        sp += (d->frame_size & 0xFFFC);
+        sp += (get_frame_size(d) & 0xFFFFFFFC);
         retaddr = Saved_return_address(sp);
 #ifdef Mask_already_scanned
         retaddr = Mask_already_scanned(retaddr);

runtime/signals_nat.c

@@ -72,12 +72,13 @@ void caml_garbage_collection(void)
       h = (h + 1) & caml_frame_descriptors_mask;
     }
     /* Must be an allocation frame */
-    CAMLassert(d && d->frame_size != 0xFFFF && (d->frame_size & 2));
+    CAMLassert(d && d->frame_size != 0xFFFF &&
+               (get_frame_size(d) & 2));
   }
 
   /* Compute the total allocation size at this point,
      including allocations combined by Comballoc */
-  alloc_len = (unsigned char*)(&d->live_ofs[d->num_live]);
+  alloc_len = get_end_of_live_ofs(d);
   nallocs = *alloc_len++;
 
   if (nallocs == 0) {