From 8a45f9d3416415d229dc63ee552d840fc7321d9a Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 21 Oct 2014 13:41:02 -0600
Subject: [PATCH] impersonated mutator: fix internal stack overflow

This is not a new bug, but it was exposed by the interaction
of the changed to the impersonated-mutator protocol and
the `unstable/option` test suite.
---
 .../racket-test/tests/racket/chaperone.rktl   | 16 +++++++
 racket/src/racket/src/struct.c                | 43 +++++++++++++++++++
 2 files changed, 59 insertions(+)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
index b6349cb857..857fb041da 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
@@ -1252,6 +1252,22 @@
 
 ;; ----------------------------------------
 
+;; Check internal stack-overflow handling:
+(let ()
+  (define-struct a (x [y #:mutable]))
+  (let* ([a1 (make-a 1 2)]
+         [a2 (impersonate-struct a1 set-a-y!
+                                 (lambda (s v)
+                                   (if (zero? v)
+                                       v
+                                       (let ([v (sub1 v)])
+                                         (set-a-y! s v)
+                                         v))))])
+    (set-a-y! a2 100000)
+    (test 99999 a-y a1)))
+
+;; ----------------------------------------
+
 (as-chaperone-or-impersonator
  ([chaperone-procedure impersonate-procedure])
  (let ()
diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c
index b3d191b8c7..c9b94a34e1 100644
--- a/racket/src/racket/src/struct.c
+++ b/racket/src/racket/src/struct.c
@@ -2154,11 +2154,54 @@ Scheme_Object *scheme_struct_ref(Scheme_Object *sv, int pos)
   }
 }
 
+static void chaperone_struct_set(const char *who, Scheme_Object *prim,
+                                 Scheme_Object *o, int i, Scheme_Object *v);
+
+static Scheme_Object *chaperone_struct_set_k(void)
+{
+  Scheme_Thread *p = scheme_current_thread;
+  Scheme_Object *o = (Scheme_Object *)p->ku.k.p1;
+  Scheme_Object *prim = (Scheme_Object *)p->ku.k.p3;
+  const char *who = (const char *)p->ku.k.p2;
+  Scheme_Object *v = (Scheme_Object *)p->ku.k.p4;
+
+  p->ku.k.p1 = NULL;
+  p->ku.k.p2 = NULL;
+  p->ku.k.p3 = NULL;
+  p->ku.k.p4 = NULL;
+
+  chaperone_struct_set(who, prim, o, p->ku.k.i1, v);
+
+  return scheme_false;
+}
+
+static void chaperone_struct_set_overflow(const char *who, Scheme_Object *prim, 
+                                          Scheme_Object *o, int i, Scheme_Object *v)
+{
+  Scheme_Thread *p = scheme_current_thread;
+
+  p->ku.k.p1 = (void *)o;
+  p->ku.k.p2 = (void *)who;
+  p->ku.k.p3 = (void *)prim;
+  p->ku.k.p4 = (void *)v;
+  p->ku.k.i1 = i;
+
+  (void)scheme_handle_stack_overflow(chaperone_struct_set_k);
+}
+
 static void chaperone_struct_set(const char *who, Scheme_Object *prim,
                                  Scheme_Object *o, int i, Scheme_Object *v)
 {
   Scheme_Object *orig_o = o;
 
+#ifdef DO_STACK_CHECK
+# include "mzstkchk.h"
+  {
+    chaperone_struct_set_overflow(who, prim, o, i, v);
+    return;
+  }
+#endif
+
   while (1) {
     if (!SCHEME_CHAPERONEP(o)) {
       ((Scheme_Structure *)o)->slots[i] = v;