Merge branch 'master' into simd-cleanup
commit
788289e51e
|
@ -12,6 +12,8 @@ compiler.errors compiler.units compiler.utilities
|
||||||
compiler.tree.builder
|
compiler.tree.builder
|
||||||
compiler.tree.optimizer
|
compiler.tree.optimizer
|
||||||
|
|
||||||
|
compiler.crossref
|
||||||
|
|
||||||
compiler.cfg
|
compiler.cfg
|
||||||
compiler.cfg.builder
|
compiler.cfg.builder
|
||||||
compiler.cfg.optimizer
|
compiler.cfg.optimizer
|
||||||
|
@ -193,6 +195,14 @@ M: optimizing-compiler recompile ( words -- alist )
|
||||||
] with-scope
|
] with-scope
|
||||||
"--- compile done" compiler-message ;
|
"--- compile done" compiler-message ;
|
||||||
|
|
||||||
|
M: optimizing-compiler to-recompile ( -- words )
|
||||||
|
changed-definitions get compiled-usages
|
||||||
|
changed-generics get compiled-generic-usages
|
||||||
|
append assoc-combine keys ;
|
||||||
|
|
||||||
|
M: optimizing-compiler process-forgotten-words
|
||||||
|
[ delete-compiled-xref ] each ;
|
||||||
|
|
||||||
: with-optimizer ( quot -- )
|
: with-optimizer ( quot -- )
|
||||||
[ optimizing-compiler compiler-impl ] dip with-variable ; inline
|
[ optimizing-compiler compiler-impl ] dip with-variable ; inline
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1,67 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: assocs classes.algebra compiler.units definitions graphs
|
||||||
|
grouping kernel namespaces sequences words stack-checker.state ;
|
||||||
|
IN: compiler.crossref
|
||||||
|
|
||||||
|
SYMBOL: compiled-crossref
|
||||||
|
|
||||||
|
compiled-crossref [ H{ } clone ] initialize
|
||||||
|
|
||||||
|
SYMBOL: compiled-generic-crossref
|
||||||
|
|
||||||
|
compiled-generic-crossref [ H{ } clone ] initialize
|
||||||
|
|
||||||
|
: compiled-usage ( word -- assoc )
|
||||||
|
compiled-crossref get at ;
|
||||||
|
|
||||||
|
: (compiled-usages) ( word -- assoc )
|
||||||
|
#! If the word is not flushable anymore, we have to recompile
|
||||||
|
#! all words which flushable away a call (presumably when the
|
||||||
|
#! word was still flushable). If the word is flushable, we
|
||||||
|
#! don't have to recompile words that folded this away.
|
||||||
|
[ compiled-usage ]
|
||||||
|
[ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
|
||||||
|
[ dependency>= nip ] curry assoc-filter ;
|
||||||
|
|
||||||
|
: compiled-usages ( seq -- assocs )
|
||||||
|
[ drop word? ] assoc-filter
|
||||||
|
[ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ;
|
||||||
|
|
||||||
|
: compiled-generic-usage ( word -- assoc )
|
||||||
|
compiled-generic-crossref get at ;
|
||||||
|
|
||||||
|
: (compiled-generic-usages) ( generic class -- assoc )
|
||||||
|
[ compiled-generic-usage ] dip
|
||||||
|
[
|
||||||
|
2dup [ valid-class? ] both?
|
||||||
|
[ classes-intersect? ] [ 2drop f ] if nip
|
||||||
|
] curry assoc-filter ;
|
||||||
|
|
||||||
|
: compiled-generic-usages ( assoc -- assocs )
|
||||||
|
[ (compiled-generic-usages) ] { } assoc>map ;
|
||||||
|
|
||||||
|
: (compiled-xref) ( word dependencies word-prop variable -- )
|
||||||
|
[ [ concat ] dip set-word-prop ] [ get add-vertex* ] bi-curry* 2bi ;
|
||||||
|
|
||||||
|
: compiled-xref ( word dependencies generic-dependencies -- )
|
||||||
|
[ [ drop crossref? ] { } assoc-filter-as ] bi@
|
||||||
|
[ "compiled-uses" compiled-crossref (compiled-xref) ]
|
||||||
|
[ "compiled-generic-uses" compiled-generic-crossref (compiled-xref) ]
|
||||||
|
bi-curry* bi ;
|
||||||
|
|
||||||
|
: (compiled-unxref) ( word word-prop variable -- )
|
||||||
|
[ [ [ dupd word-prop 2 <groups> ] dip get remove-vertex* ] 2curry ]
|
||||||
|
[ drop [ remove-word-prop ] curry ]
|
||||||
|
2bi bi ;
|
||||||
|
|
||||||
|
: compiled-unxref ( word -- )
|
||||||
|
[ "compiled-uses" compiled-crossref (compiled-unxref) ]
|
||||||
|
[ "compiled-generic-uses" compiled-generic-crossref (compiled-unxref) ]
|
||||||
|
bi ;
|
||||||
|
|
||||||
|
: delete-compiled-xref ( word -- )
|
||||||
|
[ compiled-unxref ]
|
||||||
|
[ compiled-crossref get delete-at ]
|
||||||
|
[ compiled-generic-crossref get delete-at ]
|
||||||
|
tri ;
|
|
@ -1,6 +1,6 @@
|
||||||
USING: accessors compiler compiler.units tools.test math parser
|
USING: accessors compiler compiler.units tools.test math parser
|
||||||
kernel sequences sequences.private classes.mixin generic
|
kernel sequences sequences.private classes.mixin generic
|
||||||
definitions arrays words assocs eval ;
|
definitions arrays words assocs eval grouping ;
|
||||||
IN: compiler.tests.redefine3
|
IN: compiler.tests.redefine3
|
||||||
|
|
||||||
GENERIC: sheeple ( obj -- x )
|
GENERIC: sheeple ( obj -- x )
|
||||||
|
@ -13,20 +13,23 @@ M: empty-mixin sheeple drop "wake up" ; inline
|
||||||
|
|
||||||
: sheeple-test ( -- string ) { } sheeple ;
|
: sheeple-test ( -- string ) { } sheeple ;
|
||||||
|
|
||||||
|
: compiled-use? ( key word -- ? )
|
||||||
|
"compiled-uses" word-prop 2 <groups> key? ;
|
||||||
|
|
||||||
[ "sheeple" ] [ sheeple-test ] unit-test
|
[ "sheeple" ] [ sheeple-test ] unit-test
|
||||||
[ t ] [ \ sheeple-test optimized? ] unit-test
|
[ t ] [ \ sheeple-test optimized? ] unit-test
|
||||||
[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
[ t ] [ object \ sheeple method \ sheeple-test compiled-use? ] unit-test
|
||||||
[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
[ f ] [ empty-mixin \ sheeple method \ sheeple-test compiled-use? ] unit-test
|
||||||
|
|
||||||
[ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
|
[ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
|
||||||
|
|
||||||
[ "wake up" ] [ sheeple-test ] unit-test
|
[ "wake up" ] [ sheeple-test ] unit-test
|
||||||
[ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
[ f ] [ object \ sheeple method \ sheeple-test compiled-use? ] unit-test
|
||||||
[ t ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
[ t ] [ empty-mixin \ sheeple method \ sheeple-test compiled-use? ] unit-test
|
||||||
|
|
||||||
[ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
|
[ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
|
||||||
|
|
||||||
[ "sheeple" ] [ sheeple-test ] unit-test
|
[ "sheeple" ] [ sheeple-test ] unit-test
|
||||||
[ t ] [ \ sheeple-test optimized? ] unit-test
|
[ t ] [ \ sheeple-test optimized? ] unit-test
|
||||||
[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
[ t ] [ object \ sheeple method \ sheeple-test compiled-use? ] unit-test
|
||||||
[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
[ f ] [ empty-mixin \ sheeple method \ sheeple-test compiled-use? ] unit-test
|
||||||
|
|
|
@ -38,12 +38,15 @@ INSTANCE: fried-callable fried
|
||||||
[ [ \ 3curry suffix! ] dip 3 - (ncurry) ]
|
[ [ \ 3curry suffix! ] dip 3 - (ncurry) ]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
|
: wrap-non-callable ( obj -- quot )
|
||||||
|
dup callable? [ ] [ [ call ] curry ] if ; inline
|
||||||
|
|
||||||
: [ncurry] ( n -- quot )
|
: [ncurry] ( n -- quot )
|
||||||
[ V{ } clone ] dip (ncurry) >quotation ;
|
[ V{ } clone ] dip (ncurry) >quotation ;
|
||||||
|
|
||||||
: [ndip] ( quot n -- quot' )
|
: [ndip] ( quot n -- quot' )
|
||||||
{
|
{
|
||||||
{ 0 [ ] }
|
{ 0 [ wrap-non-callable ] }
|
||||||
{ 1 [ \ dip [ ] 2sequence ] }
|
{ 1 [ \ dip [ ] 2sequence ] }
|
||||||
{ 2 [ \ 2dip [ ] 2sequence ] }
|
{ 2 [ \ 2dip [ ] 2sequence ] }
|
||||||
{ 3 [ \ 3dip [ ] 2sequence ] }
|
{ 3 [ \ 3dip [ ] 2sequence ] }
|
||||||
|
|
|
@ -177,7 +177,7 @@ M: winnt file-system-info ( path -- file-system-info )
|
||||||
handle buf buf-length FindNextVolume :> ret
|
handle buf buf-length FindNextVolume :> ret
|
||||||
ret 0 = [
|
ret 0 = [
|
||||||
GetLastError ERROR_NO_MORE_FILES =
|
GetLastError ERROR_NO_MORE_FILES =
|
||||||
[ drop f ] [ win32-error-string throw ] if
|
[ f ] [ win32-error-string throw ] if
|
||||||
] [
|
] [
|
||||||
buf utf16n alien>string
|
buf utf16n alien>string
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
@ -389,7 +389,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
|
||||||
eval( -- ) call
|
eval( -- ) call
|
||||||
] [ error>> >r/r>-in-fry-error? ] must-fail-with
|
] [ error>> >r/r>-in-fry-error? ] must-fail-with
|
||||||
|
|
||||||
:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
|
:: (funny-macro-test) ( obj quot -- ? ) obj { [ quot call ] } 1&& ; inline
|
||||||
: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
|
: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
|
||||||
|
|
||||||
\ funny-macro-test def>> must-infer
|
\ funny-macro-test def>> must-infer
|
||||||
|
|
|
@ -28,3 +28,11 @@ SYMBOL: b
|
||||||
b inlined-dependency depends-on
|
b inlined-dependency depends-on
|
||||||
] computing-dependencies
|
] computing-dependencies
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test
|
||||||
|
[ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test
|
||||||
|
[ inlined-dependency ] [ flushed-dependency inlined-dependency strongest-dependency ] unit-test
|
||||||
|
[ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
|
||||||
|
[ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
|
||||||
|
[ called-dependency ] [ called-dependency f strongest-dependency ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -48,6 +48,18 @@ SYMBOL: literals
|
||||||
! Words that the current quotation depends on
|
! Words that the current quotation depends on
|
||||||
SYMBOL: dependencies
|
SYMBOL: dependencies
|
||||||
|
|
||||||
|
SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
|
||||||
|
|
||||||
|
: index>= ( obj1 obj2 seq -- ? )
|
||||||
|
[ index ] curry bi@ >= ;
|
||||||
|
|
||||||
|
: dependency>= ( how1 how2 -- ? )
|
||||||
|
{ called-dependency flushed-dependency inlined-dependency }
|
||||||
|
index>= ;
|
||||||
|
|
||||||
|
: strongest-dependency ( how1 how2 -- how )
|
||||||
|
[ called-dependency or ] bi@ [ dependency>= ] most ;
|
||||||
|
|
||||||
: depends-on ( word how -- )
|
: depends-on ( word how -- )
|
||||||
over primitive? [ 2drop ] [
|
over primitive? [ 2drop ] [
|
||||||
dependencies get dup [
|
dependencies get dup [
|
||||||
|
|
|
@ -9,6 +9,7 @@ compiler.units definitions generic generic.standard
|
||||||
generic.single tools.deploy.config combinators classes
|
generic.single tools.deploy.config combinators classes
|
||||||
classes.builtin slots.private grouping command-line ;
|
classes.builtin slots.private grouping command-line ;
|
||||||
QUALIFIED: bootstrap.stage2
|
QUALIFIED: bootstrap.stage2
|
||||||
|
QUALIFIED: compiler.crossref
|
||||||
QUALIFIED: compiler.errors
|
QUALIFIED: compiler.errors
|
||||||
QUALIFIED: continuations
|
QUALIFIED: continuations
|
||||||
QUALIFIED: definitions
|
QUALIFIED: definitions
|
||||||
|
@ -340,8 +341,8 @@ IN: tools.deploy.shaker
|
||||||
implementors-map
|
implementors-map
|
||||||
update-map
|
update-map
|
||||||
main-vocab-hook
|
main-vocab-hook
|
||||||
compiled-crossref
|
compiler.crossref:compiled-crossref
|
||||||
compiled-generic-crossref
|
compiler.crossref:compiled-generic-crossref
|
||||||
compiler-impl
|
compiler-impl
|
||||||
compiler.errors:compiler-errors
|
compiler.errors:compiler-errors
|
||||||
lexer-factory
|
lexer-factory
|
||||||
|
|
|
@ -1,9 +1,10 @@
|
||||||
! Copyright (C) 2007, 2008 Slava Pestov.
|
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors words sequences math prettyprint kernel arrays io
|
USING: accessors words sequences math prettyprint kernel arrays
|
||||||
io.styles namespaces assocs kernel.private strings combinators
|
io io.styles namespaces assocs kernel.private strings
|
||||||
sorting math.parser vocabs definitions tools.profiler.private
|
combinators sorting math.parser vocabs definitions
|
||||||
tools.crossref continuations generic compiler.units sets classes fry ;
|
tools.profiler.private tools.crossref continuations generic
|
||||||
|
compiler.units compiler.crossref sets classes fry ;
|
||||||
IN: tools.profiler
|
IN: tools.profiler
|
||||||
|
|
||||||
: profile ( quot -- )
|
: profile ( quot -- )
|
||||||
|
|
|
@ -5,13 +5,6 @@ IN: compiler.units.tests
|
||||||
[ [ [ ] define-temp ] with-compilation-unit ] must-infer
|
[ [ [ ] define-temp ] with-compilation-unit ] must-infer
|
||||||
[ [ [ ] define-temp ] with-nested-compilation-unit ] must-infer
|
[ [ [ ] define-temp ] with-nested-compilation-unit ] must-infer
|
||||||
|
|
||||||
[ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test
|
|
||||||
[ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test
|
|
||||||
[ inlined-dependency ] [ flushed-dependency inlined-dependency strongest-dependency ] unit-test
|
|
||||||
[ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
|
|
||||||
[ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
|
|
||||||
[ called-dependency ] [ called-dependency f strongest-dependency ] unit-test
|
|
||||||
|
|
||||||
! Non-optimizing compiler bugs
|
! Non-optimizing compiler bugs
|
||||||
[ 1 1 ] [
|
[ 1 1 ] [
|
||||||
"A" "B" <word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
|
"A" "B" <word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
|
||||||
|
|
|
@ -40,8 +40,19 @@ SYMBOL: compiler-impl
|
||||||
|
|
||||||
HOOK: recompile compiler-impl ( words -- alist )
|
HOOK: recompile compiler-impl ( words -- alist )
|
||||||
|
|
||||||
|
HOOK: to-recompile compiler-impl ( -- words )
|
||||||
|
|
||||||
|
HOOK: process-forgotten-words compiler-impl ( words -- )
|
||||||
|
|
||||||
! Non-optimizing compiler
|
! Non-optimizing compiler
|
||||||
M: f recompile [ dup def>> ] { } map>assoc ;
|
M: f recompile
|
||||||
|
[ dup def>> ] { } map>assoc ;
|
||||||
|
|
||||||
|
M: f to-recompile
|
||||||
|
changed-definitions get [ drop word? ] assoc-filter
|
||||||
|
changed-generics get assoc-union keys ;
|
||||||
|
|
||||||
|
M: f process-forgotten-words drop ;
|
||||||
|
|
||||||
: without-optimizer ( quot -- )
|
: without-optimizer ( quot -- )
|
||||||
[ f compiler-impl ] dip with-variable ; inline
|
[ f compiler-impl ] dip with-variable ; inline
|
||||||
|
@ -50,8 +61,12 @@ M: f recompile [ dup def>> ] { } map>assoc ;
|
||||||
! during stage1 bootstrap, it would just waste time.
|
! during stage1 bootstrap, it would just waste time.
|
||||||
SINGLETON: dummy-compiler
|
SINGLETON: dummy-compiler
|
||||||
|
|
||||||
|
M: dummy-compiler to-recompile f ;
|
||||||
|
|
||||||
M: dummy-compiler recompile drop { } ;
|
M: dummy-compiler recompile drop { } ;
|
||||||
|
|
||||||
|
M: dummy-compiler process-forgotten-words drop ;
|
||||||
|
|
||||||
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
|
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
|
||||||
|
|
||||||
SYMBOL: definition-observers
|
SYMBOL: definition-observers
|
||||||
|
@ -89,59 +104,9 @@ GENERIC: definitions-changed ( assoc obj -- )
|
||||||
|
|
||||||
: compile ( words -- ) recompile modify-code-heap ;
|
: compile ( words -- ) recompile modify-code-heap ;
|
||||||
|
|
||||||
: index>= ( obj1 obj2 seq -- ? )
|
|
||||||
[ index ] curry bi@ >= ;
|
|
||||||
|
|
||||||
: dependency>= ( how1 how2 -- ? )
|
|
||||||
{ called-dependency flushed-dependency inlined-dependency }
|
|
||||||
index>= ;
|
|
||||||
|
|
||||||
: strongest-dependency ( how1 how2 -- how )
|
|
||||||
[ called-dependency or ] bi@ [ dependency>= ] most ;
|
|
||||||
|
|
||||||
: weakest-dependency ( how1 how2 -- how )
|
|
||||||
[ inlined-dependency or ] bi@ [ dependency>= not ] most ;
|
|
||||||
|
|
||||||
: compiled-usage ( word -- assoc )
|
|
||||||
compiled-crossref get at ;
|
|
||||||
|
|
||||||
: (compiled-usages) ( word -- assoc )
|
|
||||||
#! If the word is not flushable anymore, we have to recompile
|
|
||||||
#! all words which flushable away a call (presumably when the
|
|
||||||
#! word was still flushable). If the word is flushable, we
|
|
||||||
#! don't have to recompile words that folded this away.
|
|
||||||
[ compiled-usage ]
|
|
||||||
[ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
|
|
||||||
[ dependency>= nip ] curry assoc-filter ;
|
|
||||||
|
|
||||||
: compiled-usages ( assoc -- assocs )
|
|
||||||
[ drop word? ] assoc-filter
|
|
||||||
[ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ;
|
|
||||||
|
|
||||||
: compiled-generic-usage ( word -- assoc )
|
|
||||||
compiled-generic-crossref get at ;
|
|
||||||
|
|
||||||
: (compiled-generic-usages) ( generic class -- assoc )
|
|
||||||
[ compiled-generic-usage ] dip
|
|
||||||
[
|
|
||||||
2dup [ valid-class? ] both?
|
|
||||||
[ classes-intersect? ] [ 2drop f ] if nip
|
|
||||||
] curry assoc-filter ;
|
|
||||||
|
|
||||||
: compiled-generic-usages ( assoc -- assocs )
|
|
||||||
[ (compiled-generic-usages) ] { } assoc>map ;
|
|
||||||
|
|
||||||
: words-only ( assoc -- assoc' )
|
|
||||||
[ drop word? ] assoc-filter ;
|
|
||||||
|
|
||||||
: to-recompile ( -- seq )
|
|
||||||
changed-definitions get compiled-usages
|
|
||||||
changed-generics get compiled-generic-usages
|
|
||||||
append assoc-combine keys ;
|
|
||||||
|
|
||||||
: process-forgotten-definitions ( -- )
|
: process-forgotten-definitions ( -- )
|
||||||
forgotten-definitions get keys
|
forgotten-definitions get keys
|
||||||
[ [ word? ] filter [ delete-compiled-xref ] each ]
|
[ [ word? ] filter process-forgotten-words ]
|
||||||
[ [ delete-definition-errors ] each ]
|
[ [ delete-definition-errors ] each ]
|
||||||
bi ;
|
bi ;
|
||||||
|
|
||||||
|
|
|
@ -7,15 +7,13 @@ MIXIN: definition
|
||||||
|
|
||||||
ERROR: no-compilation-unit definition ;
|
ERROR: no-compilation-unit definition ;
|
||||||
|
|
||||||
SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
|
|
||||||
|
|
||||||
: set-in-unit ( value key assoc -- )
|
: set-in-unit ( value key assoc -- )
|
||||||
[ set-at ] [ no-compilation-unit ] if* ;
|
[ set-at ] [ no-compilation-unit ] if* ;
|
||||||
|
|
||||||
SYMBOL: changed-definitions
|
SYMBOL: changed-definitions
|
||||||
|
|
||||||
: changed-definition ( defspec -- )
|
: changed-definition ( defspec -- )
|
||||||
inlined-dependency swap changed-definitions get set-in-unit ;
|
dup changed-definitions get set-in-unit ;
|
||||||
|
|
||||||
SYMBOL: changed-effects
|
SYMBOL: changed-effects
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,8 @@ classes.tuple classes.union compiler.units continuations
|
||||||
definitions eval generic generic.math generic.standard
|
definitions eval generic generic.math generic.standard
|
||||||
hashtables io io.streams.string kernel layouts math math.order
|
hashtables io io.streams.string kernel layouts math math.order
|
||||||
namespaces parser prettyprint quotations sequences sorting
|
namespaces parser prettyprint quotations sequences sorting
|
||||||
strings tools.test vectors words generic.single ;
|
strings tools.test vectors words generic.single
|
||||||
|
compiler.crossref ;
|
||||||
IN: generic.tests
|
IN: generic.tests
|
||||||
|
|
||||||
GENERIC: foobar ( x -- y )
|
GENERIC: foobar ( x -- y )
|
||||||
|
|
|
@ -102,7 +102,7 @@ HELP: load-docs
|
||||||
|
|
||||||
HELP: reload
|
HELP: reload
|
||||||
{ $values { "name" "a vocabulary name" } }
|
{ $values { "name" "a vocabulary name" } }
|
||||||
{ $description "Loads it's source code and documentation." }
|
{ $description "Reloads the source code and documentation for a vocabulary." }
|
||||||
{ $errors "Throws a " { $link no-vocab } " error if the vocabulary does not exist on disk." } ;
|
{ $errors "Throws a " { $link no-vocab } " error if the vocabulary does not exist on disk." } ;
|
||||||
|
|
||||||
HELP: require
|
HELP: require
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: arrays generic assocs kernel math namespaces
|
USING: arrays generic assocs kernel math namespaces
|
||||||
sequences tools.test words definitions parser quotations
|
sequences tools.test words definitions parser quotations
|
||||||
vocabs continuations classes.tuple compiler.units
|
vocabs continuations classes.tuple compiler.units
|
||||||
io.streams.string accessors eval words.symbol ;
|
io.streams.string accessors eval words.symbol grouping ;
|
||||||
IN: words.tests
|
IN: words.tests
|
||||||
|
|
||||||
[ 4 ] [
|
[ 4 ] [
|
||||||
|
@ -121,7 +121,7 @@ DEFER: x
|
||||||
[ { } ]
|
[ { } ]
|
||||||
[
|
[
|
||||||
all-words [
|
all-words [
|
||||||
"compiled-uses" word-prop
|
"compiled-uses" word-prop 2 <groups>
|
||||||
keys [ "forgotten" word-prop ] filter
|
keys [ "forgotten" word-prop ] filter
|
||||||
] map harvest
|
] map harvest
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -64,41 +64,6 @@ GENERIC: crossref? ( word -- ? )
|
||||||
M: word crossref?
|
M: word crossref?
|
||||||
dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
|
dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
|
||||||
|
|
||||||
SYMBOL: compiled-crossref
|
|
||||||
|
|
||||||
compiled-crossref [ H{ } clone ] initialize
|
|
||||||
|
|
||||||
SYMBOL: compiled-generic-crossref
|
|
||||||
|
|
||||||
compiled-generic-crossref [ H{ } clone ] initialize
|
|
||||||
|
|
||||||
: (compiled-xref) ( word dependencies word-prop variable -- )
|
|
||||||
[ [ set-word-prop ] curry ]
|
|
||||||
[ [ get add-vertex* ] curry ]
|
|
||||||
bi* 2bi ;
|
|
||||||
|
|
||||||
: compiled-xref ( word dependencies generic-dependencies -- )
|
|
||||||
[ [ drop crossref? ] { } assoc-filter-as f like ] bi@
|
|
||||||
[ "compiled-uses" compiled-crossref (compiled-xref) ]
|
|
||||||
[ "compiled-generic-uses" compiled-generic-crossref (compiled-xref) ]
|
|
||||||
bi-curry* bi ;
|
|
||||||
|
|
||||||
: (compiled-unxref) ( word word-prop variable -- )
|
|
||||||
[ [ [ dupd word-prop ] dip get remove-vertex* ] 2curry ]
|
|
||||||
[ drop [ remove-word-prop ] curry ]
|
|
||||||
2bi bi ;
|
|
||||||
|
|
||||||
: compiled-unxref ( word -- )
|
|
||||||
[ "compiled-uses" compiled-crossref (compiled-unxref) ]
|
|
||||||
[ "compiled-generic-uses" compiled-generic-crossref (compiled-unxref) ]
|
|
||||||
bi ;
|
|
||||||
|
|
||||||
: delete-compiled-xref ( word -- )
|
|
||||||
[ compiled-unxref ]
|
|
||||||
[ compiled-crossref get delete-at ]
|
|
||||||
[ compiled-generic-crossref get delete-at ]
|
|
||||||
tri ;
|
|
||||||
|
|
||||||
: inline? ( word -- ? ) "inline" word-prop ; inline
|
: inline? ( word -- ? ) "inline" word-prop ; inline
|
||||||
|
|
||||||
GENERIC: subwords ( word -- seq )
|
GENERIC: subwords ( word -- seq )
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Joe Groff
|
|
@ -0,0 +1,28 @@
|
||||||
|
! (c)2009 Joe Groff bsd license
|
||||||
|
USING: fry io io.directories io.encodings.ascii
|
||||||
|
io.encodings.utf8 io.launcher io.pathnames kernel lexer
|
||||||
|
namespaces parser sequences splitting vocabs vocabs.loader ;
|
||||||
|
IN: vocabs.git
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
: git-object-id ( filename rev -- id/f )
|
||||||
|
[ [ parent-directory ] [ file-name ] bi ] dip swap '[
|
||||||
|
{ "git" "ls-tree" } _ suffix _ suffix ascii [
|
||||||
|
readln
|
||||||
|
[ " " split1 nip " " split1 nip "\t" split1 drop ]
|
||||||
|
[ f ] if*
|
||||||
|
] with-process-reader
|
||||||
|
] with-directory ;
|
||||||
|
|
||||||
|
: with-git-object-stream ( id quot -- )
|
||||||
|
[ { "git" "cat-file" "-p" } swap suffix utf8 ] dip with-process-reader ; inline
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
ERROR: git-revision-not-found path ;
|
||||||
|
|
||||||
|
: use-vocab-rev ( vocab-name rev -- )
|
||||||
|
[ create-vocab vocab-source-path dup ] dip git-object-id
|
||||||
|
[ [ input-stream get swap parse-stream call( -- ) ] with-git-object-stream ]
|
||||||
|
[ git-revision-not-found ] if* ;
|
||||||
|
|
||||||
|
SYNTAX: USE-REV: scan scan use-vocab-rev ;
|
|
@ -1,7 +1,29 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
/* These algorithms were snarfed from various places. I did not come up with them myself */
|
inline cell log2(cell x)
|
||||||
|
{
|
||||||
|
cell n;
|
||||||
|
#if defined(FACTOR_X86) || defined(FACTOR_AMD64)
|
||||||
|
asm ("bsr %1, %0;":"=r"(n):"r"(x));
|
||||||
|
#elif defined(FACTOR_PPC)
|
||||||
|
asm ("cntlzw %1, %0;":"=r"(n):"r"(x));
|
||||||
|
n = (31 - n);
|
||||||
|
#else
|
||||||
|
#error Unsupported CPU
|
||||||
|
#endif
|
||||||
|
return n;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell rightmost_clear_bit(cell x)
|
||||||
|
{
|
||||||
|
return log2(~x & (x + 1));
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell rightmost_set_bit(cell x)
|
||||||
|
{
|
||||||
|
return log2(x & -x);
|
||||||
|
}
|
||||||
|
|
||||||
inline cell popcount(cell x)
|
inline cell popcount(cell x)
|
||||||
{
|
{
|
||||||
|
@ -24,39 +46,7 @@ inline cell popcount(cell x)
|
||||||
x = (x + (x >> 4)) & k4 ; // put count of each 8 bits into those 8 bits
|
x = (x + (x >> 4)) & k4 ; // put count of each 8 bits into those 8 bits
|
||||||
x = (x * kf) >> ks; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ...
|
x = (x * kf) >> ks; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ...
|
||||||
|
|
||||||
return (cell)x;
|
return x;
|
||||||
}
|
|
||||||
|
|
||||||
inline cell log2(cell x)
|
|
||||||
{
|
|
||||||
#if defined(FACTOR_X86)
|
|
||||||
cell n;
|
|
||||||
asm ("bsr %1, %0;":"=r"(n):"r"(x));
|
|
||||||
#elif defined(FACTOR_AMD64)
|
|
||||||
cell n;
|
|
||||||
asm ("bsr %1, %0;":"=r"(n):"r"(x));
|
|
||||||
#else
|
|
||||||
cell n = 0;
|
|
||||||
#ifdef FACTOR_64
|
|
||||||
if (x >= (cell)1 << 32) { x >>= 32; n += 32; }
|
|
||||||
#endif
|
|
||||||
if (x >= (cell)1 << 16) { x >>= 16; n += 16; }
|
|
||||||
if (x >= (cell)1 << 8) { x >>= 8; n += 8; }
|
|
||||||
if (x >= (cell)1 << 4) { x >>= 4; n += 4; }
|
|
||||||
if (x >= (cell)1 << 2) { x >>= 2; n += 2; }
|
|
||||||
if (x >= (cell)1 << 1) { n += 1; }
|
|
||||||
#endif
|
|
||||||
return n;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell rightmost_clear_bit(cell x)
|
|
||||||
{
|
|
||||||
return log2(~x & (x + 1));
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell rightmost_set_bit(cell x)
|
|
||||||
{
|
|
||||||
return log2(x & -x);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -3,6 +3,20 @@
|
||||||
namespace factor
|
namespace factor
|
||||||
{
|
{
|
||||||
|
|
||||||
|
context::context(cell ds_size, cell rs_size) :
|
||||||
|
callstack_top(NULL),
|
||||||
|
callstack_bottom(NULL),
|
||||||
|
datastack(0),
|
||||||
|
retainstack(0),
|
||||||
|
datastack_save(0),
|
||||||
|
retainstack_save(0),
|
||||||
|
magic_frame(NULL),
|
||||||
|
datastack_region(new segment(ds_size,false)),
|
||||||
|
retainstack_region(new segment(rs_size,false)),
|
||||||
|
catchstack_save(0),
|
||||||
|
current_callback_save(0),
|
||||||
|
next(NULL) {}
|
||||||
|
|
||||||
void factor_vm::reset_datastack()
|
void factor_vm::reset_datastack()
|
||||||
{
|
{
|
||||||
ds = ds_bot - sizeof(cell);
|
ds = ds_bot - sizeof(cell);
|
||||||
|
@ -42,11 +56,7 @@ context *factor_vm::alloc_context()
|
||||||
unused_contexts = unused_contexts->next;
|
unused_contexts = unused_contexts->next;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
new_context = new context(ds_size,rs_size);
|
||||||
new_context = new context;
|
|
||||||
new_context->datastack_region = new segment(ds_size,false);
|
|
||||||
new_context->retainstack_region = new segment(rs_size,false);
|
|
||||||
}
|
|
||||||
|
|
||||||
return new_context;
|
return new_context;
|
||||||
}
|
}
|
||||||
|
|
|
@ -46,6 +46,8 @@ struct context {
|
||||||
cell current_callback_save;
|
cell current_callback_save;
|
||||||
|
|
||||||
context *next;
|
context *next;
|
||||||
|
|
||||||
|
context(cell ds_size, cell rs_size);
|
||||||
};
|
};
|
||||||
|
|
||||||
#define ds_bot (ctx->datastack_region->start)
|
#define ds_bot (ctx->datastack_region->start)
|
||||||
|
|
|
@ -126,7 +126,7 @@ void factor_vm::collect_full(bool trace_contexts_p)
|
||||||
{
|
{
|
||||||
collect_mark_impl(trace_contexts_p);
|
collect_mark_impl(trace_contexts_p);
|
||||||
collect_sweep_impl();
|
collect_sweep_impl();
|
||||||
if(data->tenured->largest_free_block() <= data->nursery->size + data->aging->size)
|
if(data->low_memory_p())
|
||||||
collect_compact_impl(trace_contexts_p);
|
collect_compact_impl(trace_contexts_p);
|
||||||
else
|
else
|
||||||
update_code_heap_words_and_literals();
|
update_code_heap_words_and_literals();
|
||||||
|
|
Loading…
Reference in New Issue