From 323f95d3f4c9e48b7b8c8f92fffc22612a105663 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 22 Nov 2008 19:58:23 -0600
Subject: [PATCH] Pre-compute next-methods when deploying

---
 basis/tools/deploy/deploy-tests.factor        |  5 +++
 basis/tools/deploy/shaker/next-methods.factor |  4 ++
 basis/tools/deploy/shaker/shaker.factor       | 39 ++++++++++---------
 .../tools/deploy/shaker/strip-debugger.factor |  8 +++-
 4 files changed, 35 insertions(+), 21 deletions(-)
 create mode 100644 basis/tools/deploy/shaker/next-methods.factor

diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor
index 226cf654b1..e0ac391fdf 100644
--- a/basis/tools/deploy/deploy-tests.factor
+++ b/basis/tools/deploy/deploy-tests.factor
@@ -106,3 +106,8 @@ M: quit-responder call-responder*
     "tools.deploy.test.6" shake-and-bake
     run-temp-image
 ] unit-test
+
+[ ] [
+    "tools.deploy.test.7" shake-and-bake
+    run-temp-image
+] unit-test
diff --git a/basis/tools/deploy/shaker/next-methods.factor b/basis/tools/deploy/shaker/next-methods.factor
new file mode 100644
index 0000000000..2bff407525
--- /dev/null
+++ b/basis/tools/deploy/shaker/next-methods.factor
@@ -0,0 +1,4 @@
+USING: words ;
+IN: generic
+
+: next-method-quot ( method -- quot ) "next-method-quot" word-prop ;
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index f5778e410f..9cc5a66f70 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -5,7 +5,7 @@ namespaces make assocs kernel parser lexer strings.parser
 tools.deploy.config vocabs sequences words words.private memory
 kernel.private continuations io prettyprint vocabs.loader
 debugger system strings sets vectors quotations byte-arrays
-sorting compiler.units definitions ;
+sorting compiler.units definitions generic generic.standard ;
 QUALIFIED: bootstrap.stage2
 QUALIFIED: classes
 QUALIFIED: command-line
@@ -14,7 +14,6 @@ QUALIFIED: continuations
 QUALIFIED: definitions
 QUALIFIED: init
 QUALIFIED: layouts
-QUALIFIED: listener
 QUALIFIED: prettyprint.config
 QUALIFIED: source-files
 QUALIFIED: vocabs
@@ -95,20 +94,13 @@ IN: tools.deploy.shaker
 
 : stripped-word-props ( -- seq )
     [
-        strip-dictionary? deploy-compiler? get and [
-            {
-                "combination"
-                "members"
-                "methods"
-            } %
-        ] when
-
         strip-dictionary? [
             {
                 "alias"
                 "boa-check"
                 "cannot-infer"
                 "coercer"
+                "combination"
                 "compiled-effect"
                 "compiled-generic-uses"
                 "compiled-uses"
@@ -138,7 +130,9 @@ IN: tools.deploy.shaker
                 "local-writer?"
                 "local?"
                 "macro"
+                "members"
                 "memo-quot"
+                "methods"
                 "mixin"
                 "method-class"
                 "method-generic"
@@ -201,17 +195,13 @@ IN: tools.deploy.shaker
 
 : stripped-globals ( -- seq )
     [
-        "callbacks" "alien.compiler" lookup ,
-
         "inspector-hook" "inspector" lookup ,
 
         {
-            bootstrap.stage2:bootstrap-time
             continuations:error
             continuations:error-continuation
             continuations:error-thread
             continuations:restarts
-            listener:error-hook
             init:init-hooks
             source-files:source-files
             input-stream
@@ -234,6 +224,10 @@ IN: tools.deploy.shaker
             "tools"
             "io.launcher"
             "random"
+            "compiler"
+            "stack-checker"
+            "bootstrap"
+            "listener"
         } strip-vocab-globals %
 
         strip-dictionary? [
@@ -244,6 +238,7 @@ IN: tools.deploy.shaker
             {
                 gensym
                 name>char-hook
+                classes:next-method-quot-cache
                 classes:class-and-cache
                 classes:class-not-cache
                 classes:class-or-cache
@@ -304,10 +299,7 @@ IN: tools.deploy.shaker
             "ui-error-hook" "ui.gadgets.worlds" lookup ,
         ] when
 
-        "<value>" "stack-checker.state" lookup [ , ] when*
-
         "windows-messages" "windows.messages" lookup [ , ] when*
-
     ] { } make ;
 
 : strip-globals ( stripped-globals -- )
@@ -368,11 +360,21 @@ SYMBOL: deploy-vocab
     t "quiet" set-global
     f output-stream set-global ;
 
+: compute-next-methods ( -- )
+    [ standard-generic? ] instances [
+        "methods" word-prop [
+            nip
+            dup next-method-quot "next-method-quot" set-word-prop
+        ] assoc-each
+    ] each
+    "resource:basis/tools/deploy/shaker/next-methods.factor" run-file ;
+
 : strip ( -- )
     init-stripper
     strip-libc
     strip-cocoa
     strip-debugger
+    compute-next-methods
     strip-init-hooks
     strip-c-io
     f 5 setenv ! we can't use the Factor debugger or Factor I/O anymore
@@ -382,8 +384,7 @@ SYMBOL: deploy-vocab
     r> strip-words
     compress-byte-arrays
     compress-quotations
-    compress-strings
-    H{ } clone classes:next-method-quot-cache set-global ;
+    compress-strings ;
 
 : (deploy) ( final-image vocab config -- )
     #! Does the actual work of a deployment in the slave
diff --git a/basis/tools/deploy/shaker/strip-debugger.factor b/basis/tools/deploy/shaker/strip-debugger.factor
index bdcc6c237e..db7eb63bbf 100644
--- a/basis/tools/deploy/shaker/strip-debugger.factor
+++ b/basis/tools/deploy/shaker/strip-debugger.factor
@@ -1,9 +1,13 @@
 USING: compiler.units words vocabs kernel threads.private ;
 IN: debugger
 
-: print-error ( error -- ) die drop ;
+: consume ( error -- )
+    #! We don't want DCE to drop the error before the die call!
+    drop ;
 
-: error. ( error -- ) die drop ;
+: print-error ( error -- ) die consume ;
+
+: error. ( error -- ) die consume ;
 
 "threads" vocab [
     [