A handled condition's sentence is consumed when it is copied, and the class-slot, migration and destroyed-allocator traps put their own sentence on the wire

runtime/flan_dyn.c

@@ -33,6 +33,7 @@
  * be thread-local, and that is one change in two places rather than a rewrite.
  */
 
+#include <stdarg.h>
 #include <stdint.h>
 #include <stddef.h>
 #include <stdio.h>
@@ -855,11 +856,20 @@ static void say(char *buf, int64_t cap, flan_dyn v) {
  * and [push]) pass NULL, and so does test/dyn_ops.c, which calls the runtime
  * directly and has no source position to offer. */
 
-/* The site prefix alone, for a trap whose sentence is written in several
+/* A trap's sentence written in pieces, then said in one through [flan_say],
- * pieces and so cannot go through [flan_say] in one. */
+ * so it reaches the break loop like every other. */
-static void trap_where(const uint8_t *loc, int64_t loclen) {
+static char   said_buf[2048];
-  if (loc != NULL && loclen > 0)
+static size_t said_len;
-    fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc);
+
+static void said_add(const char *fmt, ...) {
+  va_list ap;
+  int n;
+  if (said_len >= sizeof said_buf) return;
+  va_start(ap, fmt);
+  n = vsnprintf(said_buf + said_len, sizeof said_buf - said_len, fmt, ap);
+  va_end(ap);
+  if (n > 0) said_len += (size_t)n;
+  if (said_len >= sizeof said_buf) said_len = sizeof said_buf - 1;
 }
 
 static _Noreturn void trap2(const uint8_t *loc, int64_t loclen,
@@ -1917,14 +1927,13 @@ static void class_hook(flan_obj *o, flan_dyn inst, flan_dyn added,
   free(snap);
   if (r == 2) {
     kw_entry *c = o->u.v.klass;
-    fflush(stdout);
+    flan_say(NULL, 0,
-    fprintf(stderr,
              "dyn migrate: update-instance-for-redefined-class, migrating an "
              "instance of %.*s, was left for a restart established outside "
              "it. A migration runs inside get, put or set, and cannot be "
              "left for one of their callers; the instance is kept as its "
              "slots matched by name. Take migrate-by-name, or handle the "
-            "condition inside the method\n",
+             "condition inside the method",
              (int)c->len, (const char *)(c + 1));
     flan_trap((const uint8_t *)"DynMigrate", 10);
   }
@@ -3065,12 +3074,8 @@ static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
   say(sm, SAY_MAX, m);
   say(sv, SAY_MAX, v);
   slot_type_text(t, st, sizeof st);
-  fflush(stdout);
+  said_len = 0;
-  /* A constructor's refusal is placed at the call that was wrong, when the
+  said_add("dyn %s: the slot :%.*s of %.*s is declared %s, and ",
-     call said where it was, and names the slot's declaration after it. */
-  trap_where(by == BY_NEW && site_building != NULL ? site_building : loc,
-             by == BY_NEW && site_building != NULL ? site_building_len : loclen);
-  fprintf(stderr, "dyn %s: the slot :%.*s of %.*s is declared %s, and ",
           by == BY_PUT ? "put" : by == BY_SET ? "set" : "construct", sn, ss,
           cn, cs, st);
   /* A number of the right kind that does not fit is not news about its tag. */
@@ -3078,20 +3083,25 @@ static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
       || (t->kind == ST_FLOAT
           && (flan_dyn_tag(v) == FLAN_DYN_TAG_INT
               || flan_dyn_tag(v) == FLAN_DYN_TAG_FLOAT)))
-    fprintf(stderr, "%s is not a value it holds exactly — ", sv);
+    said_add("%s is not a value it holds exactly — ", sv);
   else if (t->kind == ST_CLASS && flan_dyn_tag(v) == FLAN_DYN_TAG_MAP)
-    fprintf(stderr, "this is not an instance of it — ");
+    said_add("this is not an instance of it — ");
   else
-    fprintf(stderr, "this is %s — ", tag_of(v));
+    said_add("this is %s — ", tag_of(v));
   if (by == BY_PUT)
-    fprintf(stderr, "(put %s :%.*s %s)\n", sm, sn, ss, sv);
+    said_add("(put %s :%.*s %s)", sm, sn, ss, sv);
   else if (by == BY_SET)
-    fprintf(stderr, "(set (get %s :%.*s) %s)\n", sm, sn, ss, sv);
+    said_add("(set (get %s :%.*s) %s)", sm, sn, ss, sv);
   else if (site_building != NULL && loc != NULL)
-    fprintf(stderr, "(%.*s ...) with :%.*s %s; the slot is declared at %.*s\n",
+    said_add("(%.*s ...) with :%.*s %s; the slot is declared at %.*s",
             cn, cs, sn, ss, sv, (int)loclen, (const char *)loc);
   else
-    fprintf(stderr, "(%.*s ...) with :%.*s %s\n", cn, cs, sn, ss, sv);
+    said_add("(%.*s ...) with :%.*s %s", cn, cs, sn, ss, sv);
+  /* A constructor's refusal is placed at the call that was wrong, when the
+     call said where it was, and names the slot's declaration after it. */
+  flan_say(by == BY_NEW && site_building != NULL ? site_building : loc,
+           by == BY_NEW && site_building != NULL ? site_building_len : loclen,
+           "%s", said_buf);
   flan_trap((const uint8_t *)"DynType", 7);
 }
 
@@ -3138,11 +3148,9 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
   if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) {
     char sm[SAY_MAX];
     say(sm, SAY_MAX, m);
-    fflush(stdout);
+    flan_say(loc, loclen,
-    trap_where(loc, loclen);
-    fprintf(stderr,
              "dyn set: (get m k) is a place only on a class instance, and "
-            "this is %s%s — %s. A map's entries are written with put\n",
+             "this is %s%s — %s. A map's entries are written with put",
              is_map(m) ? "a map with no class" : "a ",
              is_map(m) ? "" : tag_of(m), sm);
     flan_trap((const uint8_t *)"DynType", 7);
@@ -3155,17 +3163,16 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
     kw_entry *c = o->u.v.klass;
     int64_t i;
     say(sk, SAY_MAX, k);
-    fflush(stdout);
+    said_len = 0;
-    trap_where(loc, loclen);
+    said_add("dyn set: %.*s has no slot %s. Its slots are",
-    fprintf(stderr, "dyn set: %.*s has no slot %s. Its slots are",
              (int)c->len, (const char *)(c + 1), sk);
-    if (e == NULL || e->nslots == 0) fprintf(stderr, " none");
+    if (e == NULL || e->nslots == 0) said_add(" none");
     else
       for (i = 0; i < e->nslots; i++)
-        fprintf(stderr, " :%.*s", (int)e->slots[i]->len,
+        said_add(" :%.*s", (int)e->slots[i]->len,
                  (const char *)(e->slots[i] + 1));
-    fprintf(stderr, "; a key the class does not declare is added with put, "
+    said_add("; a key the class does not declare is added with put, not set");
-                    "not set\n");
+    flan_say(loc, loclen, "%s", said_buf);
     flan_trap((const uint8_t *)"DynType", 7);
   }
   if (!slot_admit(&e->types[j], v, &out))

runtime/flan_rt.c

@@ -92,6 +92,9 @@ typedef struct flan_condesc {
 } flan_condesc;
 
 #define FLAN_CONDESC_SELF 1
+/* The runtime's own condition, whose name is this file's and whose message is
+ * already a copy in context/temp: a parent's view takes both as they are. */
+#define FLAN_CONDESC_RT   2
 
 /* The view a parent's handler reads: Error's layout. */
 typedef struct {
@@ -157,6 +160,13 @@ static void rt_view(const flan_condesc *d, void *condition, flan_view *v) {
     *v = *(const flan_view *)condition;
     return;
   }
+  if (d->flags & FLAN_CONDESC_RT) {
+    v->name = d->name;
+    v->namelen = d->namelen;
+    v->message = d->message;
+    v->messagelen = d->messagelen;
+    return;
+  }
   v->name = rt_temp_copy(d->name, d->namelen, &v->namelen);
   if (d->messagelen > 0)
     v->message = rt_temp_copy(d->message, d->messagelen, &v->messagelen);
@@ -1212,15 +1222,14 @@ static const uint8_t flan_error_name[] = "Error";
 #define FLAN_ERROR_NAMELEN 5
 
 /* A descriptor for one of the runtime's own conditions, on the caller's
- * stack; [chain] is the caller's too, two entries long. [message] is the
+ * stack; [chain] is the caller's too, two entries long. Its message is the
- * sentence with its values, which the caller has formatted into a buffer of
+ * sentence the caller has just formatted, copied into context/temp: that copy
- * its own frame before signalling: a parent's handler reads it, and so does
+ * is what a parent's handler reads. The break loop does not read it — the
- * the break loop after the walk, when a handler may have written over the
+ * caller formats the sentence again, in full, if nothing handled it. */
- * shared one. */
 static void rt_condesc(flan_condesc *d, uint32_t chain[2], const uint8_t *name,
                        int64_t namelen, const uint8_t *loc, int64_t loclen) {
   d->render = NULL;
-  d->flags = 0;
+  d->flags = FLAN_CONDESC_RT;
   chain[0] = flan_name_id(name, namelen);
   chain[1] = flan_name_id(flan_error_name, FLAN_ERROR_NAMELEN);
   d->name = name;
@@ -1230,6 +1239,9 @@ static void rt_condesc(flan_condesc *d, uint32_t chain[2], const uint8_t *name,
    * it. */
   d->message = rt_temp_copy((const uint8_t *)flan_break_sentence,
                             flan_break_sentence_len, &d->messagelen);
+  /* Consumed: if a handler takes the condition, the next stop must not find
+   * this sentence waiting under its own name. */
+  flan_break_sentence_len = 0;
   d->chain = chain;
   d->chainlen = 2;
   d->loc = loc;
@@ -2231,11 +2243,9 @@ flan_allocator *flan_alloc_use(const flan_alloc_value *v, const uint8_t *loc,
 }
 
 _Noreturn static void flan_destroyed_fail(const uint8_t *loc, int64_t loclen) {
-  rt_flush_out();
+  flan_say(loc, loclen,
-  fprintf(stderr,
+           "this allocator was destroyed by arena-destroy, so nothing can be "
-          "%.*s: this allocator was destroyed by arena-destroy, so nothing "
+           "allocated from it or released through it");
-          "can be allocated from it or released through it\n",
-          (int)loclen, (const char *)loc);
   rt_trap((const uint8_t *)"DestroyedAllocator", 18);
 }
 

test/programs/dev-trap-stale-sentence.flan

@@ -0,0 +1,16 @@
+;;;; A handled condition's sentence does not linger for the next stop: a bad
+;;;; index is caught through Error, then a set on a slot the class does not
+;;;; declare traps, and the break must carry that trap's own sentence.
+(import agent "vendor:agent")
+
+(defclass point [x y])
+
+(defonce grid [3 i32])
+(defonce far i32 4)
+
+(defn main [] i32
+  (agent/start "/tmp/flan-dev-trap-stale-sentence-fallback.sock")
+  (println (handler-case (at grid far) [(Error [_e] -1)]))
+  (let [p (point 1 2)]
+    (set (get p :z) 1))
+  0)

test/test_dev.ml

@@ -1894,8 +1894,8 @@ let () =
        standalone half of the same claim is test_acceptance.ml's
        free-all-refused, which still exits 134: nothing installs the hook in a
        program that did not import the agent. *)
-    let trap_park ?(refault = false) ?(trapping = "") ?(sentence = "") what prog
+    let trap_park ?(refault = false) ?(trapping = "") ?(sentence = "")
-        cond restarts =
+        ?(x86 = false) what prog cond restarts =
       let tsock = tmp (prog ^ ".sock") and tout = tmp (prog ^ ".out") in
       (try Sys.remove tsock with Sys_error _ -> ());
       let tfd =
@@ -1903,7 +1903,8 @@ let () =
       in
       let tpid =
         Unix.create_process flan
-          [| flan; "dev"; "programs/" ^ prog; "-s"; tsock |]
+          (Array.append [| flan; "dev"; "programs/" ^ prog; "-s"; tsock |]
+             (if x86 then [| "--x86" |] else [||]))
           Unix.stdin tfd Unix.stderr
       in
       Unix.close tfd;
@@ -2143,6 +2144,14 @@ let () =
       "dev-trap-null-alloc.flan" "NullAllocator" [];
     trap_park ~sentence:"dyn +: int and text"
       "dyn type" "dev-trap-dyn.flan" "DynType" [];
+    (* A condition a handler took leaves no sentence behind for the next stop,
+       and a class-slot trap says its own. *)
+    List.iter
+      (fun x86 ->
+         trap_park ~x86 ~sentence:"dyn set: point has no slot :z"
+           (if x86 then "stale sentence, --x86" else "stale sentence")
+           "dev-trap-stale-sentence.flan" "DynType" [])
+      [ false; true ];
     (* And the one that used to be a silent death rather than an exit code:
        SIGSEGV. The author's dogfooding session sorted (bytes "INSERTIONSORT")
        in place — the old aliasing bytes — and the session vanished without a