From 7680adf486d875dc75d2f5b13a94fc907b36498e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 5 Oct 2011 19:12:15 -0600
Subject: [PATCH] fix compiler bug related to lifting and unbox flonums

As variables are dropped for lifted functions, the bitmap
for flonum closure variables was not shifted down by the
number of dropped variables.

Closes PR 12259
---
 collects/compiler/zo-parse.rkt |  7 +++++--
 src/racket/src/marshal.c       | 10 ++++++++++
 src/racket/src/resolve.c       | 11 +++++++++--
 3 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt
index 6c9493537b..5f47e9cc54 100644
--- a/collects/compiler/zo-parse.rkt
+++ b/collects/compiler/zo-parse.rkt
@@ -111,12 +111,15 @@
                                       (case (check-bit i)
                                         [(0) 'val]
                                         [(1) 'ref]
-                                        [(2) 'flonum])))]
+                                        [(2) 'flonum]
+                                        [else (error "both 'ref and 'flonum argument?")])))]
                      [(closure-types) (for/list ([i (in-range closure-size)]
                                                  [j (in-naturals num-params)])
                                         (case (check-bit j)
                                           [(0) 'val/ref]
-                                          [(2) 'flonum]))])
+                                          [(1) (error "invalid 'ref closure variable")]
+                                          [(2) 'flonum]
+                                          [else (error "both 'ref and 'flonum closure var?")]))])
          (make-lam name
                    (append
                     (if (zero? (bitwise-and flags flags CLOS_PRESERVES_MARKS)) null '(preserves-marks))
diff --git a/src/racket/src/marshal.c b/src/racket/src/marshal.c
index fdab4fd8c9..09d7dd8a63 100644
--- a/src/racket/src/marshal.c
+++ b/src/racket/src/marshal.c
@@ -672,6 +672,16 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
   svec_size = data->closure_size;
   if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
     svec_size += ((2 * (data->num_params + data->closure_size)) + BITS_PER_MZSHORT - 1) / BITS_PER_MZSHORT;
+    {
+      int k, mv;
+      for (k = data->num_params + data->closure_size; --k; ) {
+        mv = ((data->closure_map[data->closure_size + ((2 * k) / BITS_PER_MZSHORT)]
+               >> ((2 * k) %  BITS_PER_MZSHORT))
+              & 0x3);
+        if (mv == 0x3)
+          scheme_signal_error("internal error: inconsistent closure/argument type");
+      }
+    }
   }
 
   if (SCHEME_RPAIRP(data->code)) {
diff --git a/src/racket/src/resolve.c b/src/racket/src/resolve.c
index c8ade83fa1..0ea6766036 100644
--- a/src/racket/src/resolve.c
+++ b/src/racket/src/resolve.c
@@ -1927,6 +1927,13 @@ resolve_closure_compilation(Scheme_Object *_data, Resolve_Info *info,
     offset++;
   }
 
+  if (!convert && !just_compute_lift && (offset < data->closure_size) && expanded_already) {
+    /* shift boxmap down, since we're dropping closure elements */
+    int bsz;
+    bsz = boxmap_size(data->num_params + offset);
+    memmove(closure_map + offset, closure_map + data->closure_size, sizeof(mzshort) * bsz);
+  }
+
   /* Reset closure_size, in case a lifted variable was removed: */
   closure_size = offset;
   if (!just_compute_lift) {
@@ -1949,7 +1956,7 @@ resolve_closure_compilation(Scheme_Object *_data, Resolve_Info *info,
       data->num_params = 0;
   } else {
     new_info = resolve_info_extend(info, data->num_params, data->num_params,
-					  cl->base_closure_size + data->num_params);
+                                   cl->base_closure_size + data->num_params);
     for (i = 0; i < data->num_params; i++) {
       resolve_info_add_mapping(new_info, i, i + closure_size + convert_size,
                                (((cl->local_flags[i] & SCHEME_WAS_SET_BANGED)
@@ -1959,7 +1966,7 @@ resolve_closure_compilation(Scheme_Object *_data, Resolve_Info *info,
                                    ? SCHEME_INFO_FLONUM_ARG
                                    : 0)),
                                NULL);
-      if (cl->flonum_map && cl->flonum_map[i])
+      if (cl->flonum_map && cl->flonum_map[i] && !just_compute_lift)
         boxmap_set(closure_map, i + convert_size, 2, closure_size);
     }
     if (expanded_already && !just_compute_lift)