From 6856e5253f15c83031e3d20febe99d1f4f2be09b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 21 Apr 2014 14:53:23 -0600
Subject: [PATCH] fix incorrect sharing of submodule-declaration tables

Cuts the peak memory use of

 racket -c -l match

from 1.2 GB to 400 MB on a 64-bit machine.
---
 racket/src/racket/src/env.c     | 5 +++--
 racket/src/racket/src/module.c  | 6 +++---
 racket/src/racket/src/schpriv.h | 3 ++-
 3 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c
index 5c0e178499..23840fc54e 100644
--- a/racket/src/racket/src/env.c
+++ b/racket/src/racket/src/env.c
@@ -937,14 +937,15 @@ static Scheme_Env *make_env(Scheme_Env *base, int toplevel_size)
 }
 
 Scheme_Env *
-scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree)
+scheme_new_module_env(Scheme_Env *env, Scheme_Module *m,
+                      int new_exp_module_tree, int new_pre_registry)
 {
   Scheme_Env *menv;
   Scheme_Module_Registry *reg;
 
   menv = make_env(env, 7);
 
-  if (new_exp_module_tree && !menv->module_pre_registry) {
+  if (new_pre_registry) {
     /* pre_registry is for declarations to be used by submodules */
     reg = MALLOC_ONE_TAGGED(Scheme_Module_Registry);
     reg->so.type = scheme_module_registry_type;
diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c
index 0a3342e0de..5f401ec93d 100644
--- a/racket/src/racket/src/module.c
+++ b/racket/src/racket/src/module.c
@@ -5332,7 +5332,7 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
                             scheme_write_to_string(m->modname, NULL));
 
       /* printf("new %ld %s\n", env->phase, scheme_write_to_string(m->modname, NULL)); */
-      menv = scheme_new_module_env(env, m, 0);
+      menv = scheme_new_module_env(env, m, 0, 0);
       scheme_hash_set(MODCHAIN_TABLE(env->modchain), m->modname, (Scheme_Object *)menv);
 
       running = (char *)scheme_malloc_atomic(menv->module->num_phases);
@@ -5975,7 +5975,7 @@ Scheme_Env *scheme_primitive_module(Scheme_Object *name, Scheme_Env *for_env)
   m->predefined = scheme_starting_up;
   m->phaseless = scheme_true;
   
-  env = scheme_new_module_env(for_env, m, 0);
+  env = scheme_new_module_env(for_env, m, 0, 0);
 
   if (!scheme_defining_primitives) {
     config = scheme_current_config();
@@ -7295,7 +7295,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 
   /* Create module environment. This environment gets a fresh table
      for phase-1 instances: */
-  menv = scheme_new_module_env(top_env, m, 1);
+  menv = scheme_new_module_env(top_env, m, 1, SCHEME_NULLP(submodule_ancestry));
 
   menv->disallow_unbound = 1;
   
diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h
index dcff078dbe..496a610710 100644
--- a/racket/src/racket/src/schpriv.h
+++ b/racket/src/racket/src/schpriv.h
@@ -3478,7 +3478,8 @@ Scheme_Object *scheme_sys_wraps_phase(Scheme_Object *phase);
 THREAD_LOCAL_DECL(extern Scheme_Bucket_Table *scheme_module_code_cache);
 Scheme_Object *scheme_module_execute(Scheme_Object *data, Scheme_Env *genv);
 
-Scheme_Env *scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree);
+Scheme_Env *scheme_new_module_env(Scheme_Env *env, Scheme_Module *m,
+                                  int new_exp_module_tree, int new_pre_registry);
 int scheme_is_module_env(Scheme_Comp_Env *env);
 
 Scheme_Object *scheme_module_resolve(Scheme_Object *modidx, int load_it);