Memory ricing to make deploy tests pass on Mac OS X/PowerPC

diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor
index bb21391f0a875d0d42586dee73f518c99b7639f6..6bec4b23c0958453baea559550e09fb818c27dc3 100644 (file)
--- a/basis/core-foundation/fsevents/fsevents.factor
+++ b/basis/core-foundation/fsevents/fsevents.factor
@@ -3,13 +3,10 @@
 USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
 continuations combinators core-foundation
-core-foundation.run-loop io.encodings.utf8 destructors ;
+core-foundation.run-loop core-foundation.run-loop.thread
+io.encodings.utf8 destructors ;
 IN: core-foundation.fsevents
 
-! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
-! FSEventStream API, Leopard only !
-! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
-
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline
 : kFSEventStreamCreateFlagWatchRoot 4 ; inline
 

diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor
index 5ffcafbbafb5fba51af4f8d29be8420f42ba0c8d..e30cc2eb6013141d3d8b139f4355901fcf430b4f 100644 (file)
--- a/basis/core-foundation/run-loop/run-loop.factor
+++ b/basis/core-foundation/run-loop/run-loop.factor
@@ -35,5 +35,3 @@ FUNCTION: SInt32 CFRunLoopRunInMode (
 
 : start-run-loop-thread ( -- )
     [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
-
-[ start-run-loop-thread ] "core-foundation.run-loop" add-init-hook

diff --git a/basis/core-foundation/run-loop/thread/thread.factor b/basis/core-foundation/run-loop/thread/thread.factor
new file mode 100644 (file)
index 0000000..326226e
--- /dev/null
+++ b/basis/core-foundation/run-loop/thread/thread.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: init core-foundation.run-loop ;
+IN: core-foundation.run-loop.thread
+
+! Load this vocabulary if you need a run loop running.
+
+[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook

diff --git a/basis/random/unix/unix.factor b/basis/random/unix/unix.factor
index 90f3d1efbb7b76a8ddafb57451826a6c5cb84d65..599cd5e0ad6b3cbc03e1015e3eac9c324935ef5b 100644 (file)
--- a/basis/random/unix/unix.factor
+++ b/basis/random/unix/unix.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Doug Coleman
+! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types io io.files kernel namespaces random
 io.encodings.binary init accessors system ;
 IN: random.unix

diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index 41c7e2c9729f74655eb9ebe0c074bd371e121252..abc3ae1950962550730774b2e392585e25c4181c 100755 (executable)
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/basis/stack-checker/transforms/transforms.factor
@@ -96,7 +96,7 @@ IN: stack-checker.transforms
 \ boa [
     dup tuple-class? [
         dup inlined-dependency depends-on
-        [ "boa-check" word-prop ]
+        [ "boa-check" word-prop [ ] or ]
         [ tuple-layout '[ _ <tuple-boa> ] ]
         bi append
     ] [ drop f ] if

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index f2726c00fa21ad104fa5e81a686ace8d1988dbb4..8713be54bbeae093006797ccf50c05c3baec10a2 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -4,7 +4,7 @@ USING: accessors qualified io.streams.c init fry 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 ;
+strings sets vectors quotations byte-arrays sorting ;
 QUALIFIED: bootstrap.stage2
 QUALIFIED: classes
 QUALIFIED: command-line
@@ -29,6 +29,7 @@ IN: tools.deploy.shaker
     "cpu.x86" init-hooks get delete-at
     "command-line" init-hooks get delete-at
     "libc" init-hooks get delete-at
+    "system" init-hooks get delete-at
     deploy-threads? get [
         "threads" init-hooks get delete-at
     ] unless
@@ -36,7 +37,11 @@ IN: tools.deploy.shaker
         "io.thread" init-hooks get delete-at
     ] unless
     strip-io? [
+        "io.files" init-hooks get delete-at
         "io.backend" init-hooks get delete-at
+    ] when
+    strip-dictionary? [
+        "compiler.units" init-hooks get delete-at
     ] when ;
 
 : strip-debugger ( -- )
@@ -74,17 +79,22 @@ IN: tools.deploy.shaker
 : strip-word-props ( stripped-props words -- )
     "Stripping word properties" show
     [
-        [
-            props>> swap
-            '[ drop _ member? not ] assoc-filter sift-assoc
-            dup assoc-empty? [ drop f ] [ >alist >vector ] if
-        ] keep (>>props)
-    ] with each ;
+        swap '[
+            [
+                [ drop _ member? not ] assoc-filter sift-assoc
+                >alist f like
+            ] change-props drop
+        ] each
+    ] [
+        "Remaining word properties:" print
+        [ props>> keys ] gather .
+    ] bi ;
 
 : stripped-word-props ( -- seq )
     [
         strip-dictionary? [
             {
+                "boa-check"
                 "cannot-infer"
                 "coercer"
                 "combination"
@@ -92,12 +102,15 @@ IN: tools.deploy.shaker
                 "compiled-generic-uses"
                 "compiled-uses"
                 "constraints"
+                "custom-inlining"
                 "declared-effect"
                 "default"
                 "default-method"
                 "default-output-classes"
                 "derived-from"
                 "engines"
+                "forgotten"
+                "identities"
                 "if-intrinsics"
                 "infer"
                 "inferred-effect"
@@ -116,9 +129,11 @@ IN: tools.deploy.shaker
                 "macro"
                 "members"
                 "memo-quot"
+                "mixin"
                 "method-class"
                 "method-generic"
                 "methods"
+                "modular-arithmetic"
                 "no-compile"
                 "optimizer-hooks"
                 "outputs"
@@ -126,6 +141,7 @@ IN: tools.deploy.shaker
                 "predicate"
                 "predicate-definition"
                 "predicating"
+                "primitive"
                 "reader"
                 "reading"
                 "recursive"
@@ -230,6 +246,7 @@ IN: tools.deploy.shaker
                 compiled-generic-crossref
                 compiler.units:recompile-hook
                 compiler.units:update-tuples-hook
+                compiler.units:definition-observers
                 definitions:crossref
                 interactive-vocabs
                 layouts:num-tags
@@ -244,6 +261,7 @@ IN: tools.deploy.shaker
                 vocabs:dictionary
                 vocabs:load-vocab-hook
                 word
+                parser-notes
             } %
 
             { } { "math.partial-dispatch" } strip-vocab-globals %
@@ -273,7 +291,7 @@ IN: tools.deploy.shaker
             "ui-error-hook" "ui.gadgets.worlds" lookup ,
         ] when
 
-        "<computer>" "inference.dataflow" lookup [ , ] when*
+        "<value>" "stack-checker.state" lookup [ , ] when*
 
         "windows-messages" "windows.messages" lookup [ , ] when*
 

diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor
index de5aee68e20aff79e0a7ef056a24e20a598dfe65..2cf803e2703b26984b156db03b846f4519f4e83d 100755 (executable)
--- a/basis/tools/deploy/shaker/strip-cocoa.factor
+++ b/basis/tools/deploy/shaker/strip-cocoa.factor
@@ -1,30 +1,50 @@
-USING: cocoa cocoa.messages cocoa.application cocoa.nibs
-assocs namespaces kernel words compiler.units sequences
-ui ui.cocoa ;
+! Copyright (C) 2007, 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: cocoa cocoa.messages cocoa.application cocoa.nibs assocs
+namespaces kernel kernel.private words compiler.units sequences
+ui ui.cocoa init ;
+IN: tools.deploy.shaker.cocoa
+
+: pool ( obj -- obj' ) \ pool get [ ] cache ;
+
+: pool-array ( obj -- obj' ) [ pool ] map pool ;
+
+: pool-keys ( assoc -- assoc' ) [ [ pool-array ] dip ] assoc-map ;
+
+: pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ;
+
+IN: cocoa.application
+
+: objc-error ( error -- ) die ;
+
+[ [ die ] 19 setenv ] "cocoa.application" add-init-hook
 
 "stop-after-last-window?" get
-global [
-    stop-after-last-window? set
 
-    [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global
+H{ } clone \ pool [
+    global [
+        stop-after-last-window? set
+
+        [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global
 
-    ! Only keeps those methods that we actually call
-    sent-messages get super-sent-messages get assoc-union
-    objc-methods [ assoc-intersect ] change
+        ! Only keeps those methods that we actually call
+        sent-messages get super-sent-messages get assoc-union
+        objc-methods [ assoc-intersect pool-values ] change
 
-    sent-messages get
-    super-sent-messages get
-    [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
-    super-message-senders [ assoc-intersect ] change
-    message-senders [ assoc-intersect ] change
+        sent-messages get
+        super-sent-messages get
+        [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
+        super-message-senders [ assoc-intersect pool-keys ] change
+        message-senders [ assoc-intersect pool-keys ] change
 
-    sent-messages off
-    super-sent-messages off
+        sent-messages off
+        super-sent-messages off
 
-    alien>objc-types off
-    objc>alien-types off
+        alien>objc-types off
+        objc>alien-types off
 
-    ! We need this for strip-stack-traces to work fully
-    { message-senders super-message-senders }
-    [ get values compile ] each
-] bind
+        ! We need this for strip-stack-traces to work fully
+        { message-senders super-message-senders }
+        [ get values compile ] each
+    ] bind
+] with-variable

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index f92c9c0fd58730e9c5e0191df761cdd319b9c24b..577ad133e19bf004bba1d170b255ad956edeefa9 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -125,7 +125,8 @@ ERROR: bad-superclass class ;
     } cond ;
 
 : boa-check-quot ( class -- quot )
-    all-slots [ class>> instance-check-quot ] map spread>quot ;
+    all-slots [ class>> instance-check-quot ] map spread>quot
+    f like ;
 
 : define-boa-check ( class -- )
     dup boa-check-quot "boa-check" set-word-prop ;
@@ -311,7 +312,7 @@ M: tuple-class new
     [ (clone) ] [ tuple-layout <tuple> ] ?if ;
 
 M: tuple-class boa
-    [ "boa-check" word-prop call ]
+    [ "boa-check" word-prop [ call ] when* ]
     [ tuple-layout ]
     bi <tuple-boa> ;