steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Slava Pestov 2008-09-19 00:26:27 -05:00
parent 09ecec270a
commit 3d790d8ac8
8 changed files with 84 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/core-foundation/fsevents/fsevents.factor
View File

@ -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

2
basis/core-foundation/run-loop/run-loop.factor
View File

@ -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

8
basis/core-foundation/run-loop/thread/thread.factor Normal file
View File

@ -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

2
basis/random/unix/unix.factor
View File

@ -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

2
basis/stack-checker/transforms/transforms.factor
View File

@ -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

34
basis/tools/deploy/shaker/shaker.factor
View File

@ -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*

64
basis/tools/deploy/shaker/strip-cocoa.factor
View File

@ -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
! Only keeps those methods that we actually call
sent-messages get super-sent-messages get assoc-union
objc-methods [ assoc-intersect ] change
[ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global
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
! 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 off
super-sent-messages off
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
alien>objc-types off
objc>alien-types off
sent-messages off
super-sent-messages off
! We need this for strip-stack-traces to work fully
{ message-senders super-message-senders }
[ get values compile ] each
] bind
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
] with-variable

5
core/classes/tuple/tuple.factor
View File

@ -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> ;