started linearizer, and new compiler framework
Slava Pestov
parent
7308c11b18
commit
ec849514bb
|
|
@ -1,169 +1,174 @@
|
|||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: init
|
||||
USE: combinators
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: parser
|
||||
USE: stack
|
||||
USE: stdio
|
||||
|
||||
"Cold boot in progress..." print
|
||||
[
|
||||
"/version.factor"
|
||||
"/library/kernel.factor"
|
||||
"/library/stack.factor"
|
||||
"/library/types.factor"
|
||||
"/library/math/math.factor"
|
||||
"/library/cons.factor"
|
||||
"/library/combinators.factor"
|
||||
"/library/logic.factor"
|
||||
"/library/vector-combinators.factor"
|
||||
"/library/lists.factor"
|
||||
"/library/assoc.factor"
|
||||
"/library/math/arithmetic.factor"
|
||||
"/library/math/math-combinators.factor"
|
||||
"/library/vectors.factor"
|
||||
"/library/strings.factor"
|
||||
"/library/hashtables.factor"
|
||||
"/library/namespaces.factor"
|
||||
"/library/generic.factor"
|
||||
"/library/math/namespace-math.factor"
|
||||
"/library/list-namespaces.factor"
|
||||
"/library/sbuf.factor"
|
||||
"/library/continuations.factor"
|
||||
"/library/errors.factor"
|
||||
"/library/threads.factor"
|
||||
"/library/io/stream.factor"
|
||||
"/library/io/io-internals.factor"
|
||||
"/library/io/stream-impl.factor"
|
||||
"/library/io/stdio.factor"
|
||||
"/library/words.factor"
|
||||
"/library/vocabularies.factor"
|
||||
"/library/syntax/parse-numbers.factor"
|
||||
"/library/syntax/parser.factor"
|
||||
"/library/syntax/parse-syntax.factor"
|
||||
"/library/syntax/parse-stream.factor"
|
||||
"/library/math/generic.factor"
|
||||
"/library/bootstrap/init.factor"
|
||||
|
||||
"/library/format.factor"
|
||||
"/library/syntax/unparser.factor"
|
||||
"/library/io/presentation.factor"
|
||||
"/library/io/vocabulary-style.factor"
|
||||
"/library/syntax/prettyprint.factor"
|
||||
"/library/syntax/see.factor"
|
||||
"/library/tools/debugger.factor"
|
||||
|
||||
"/library/math/constants.factor"
|
||||
"/library/math/pow.factor"
|
||||
"/library/math/trig-hyp.factor"
|
||||
"/library/math/arc-trig-hyp.factor"
|
||||
|
||||
"/library/in-thread.factor"
|
||||
"/library/io/network.factor"
|
||||
"/library/io/logging.factor"
|
||||
"/library/random.factor"
|
||||
"/library/io/stdio-binary.factor"
|
||||
"/library/io/files.factor"
|
||||
"/library/eval-catch.factor"
|
||||
"/library/tools/listener.factor"
|
||||
"/library/tools/inspector.factor"
|
||||
"/library/tools/word-tools.factor"
|
||||
"/library/test/test.factor"
|
||||
"/library/io/ansi.factor"
|
||||
"/library/tools/telnetd.factor"
|
||||
"/library/tools/jedit-wire.factor"
|
||||
"/library/tools/profiler.factor"
|
||||
"/library/tools/heap-stats.factor"
|
||||
"/library/gensym.factor"
|
||||
"/library/tools/interpreter.factor"
|
||||
|
||||
! Inference needs to know primitive stack effects at load time
|
||||
"/library/primitives.factor"
|
||||
|
||||
"/library/inference/dataflow.factor"
|
||||
"/library/inference/inference.factor"
|
||||
"/library/inference/words.factor"
|
||||
"/library/inference/branches.factor"
|
||||
"/library/inference/stack.factor"
|
||||
|
||||
"/library/bootstrap/image.factor"
|
||||
"/library/bootstrap/cross-compiler.factor"
|
||||
|
||||
"/library/httpd/url-encoding.factor"
|
||||
"/library/httpd/html-tags.factor"
|
||||
"/library/httpd/html.factor"
|
||||
"/library/httpd/http-common.factor"
|
||||
"/library/httpd/responder.factor"
|
||||
"/library/httpd/httpd.factor"
|
||||
"/library/httpd/file-responder.factor"
|
||||
"/library/httpd/inspect-responder.factor"
|
||||
"/library/httpd/test-responder.factor"
|
||||
"/library/httpd/quit-responder.factor"
|
||||
"/library/httpd/resource-responder.factor"
|
||||
"/library/httpd/default-responders.factor"
|
||||
|
||||
"/library/tools/jedit.factor"
|
||||
|
||||
"/library/cli.factor"
|
||||
] [
|
||||
dup print
|
||||
run-resource
|
||||
] each
|
||||
|
||||
cpu "x86" = [
|
||||
[
|
||||
"/library/compiler/assembler.factor"
|
||||
"/library/compiler/assembly-x86.factor"
|
||||
"/library/compiler/compiler-macros.factor"
|
||||
"/library/compiler/compiler.factor"
|
||||
"/library/compiler/ifte.factor"
|
||||
"/library/compiler/generic.factor"
|
||||
"/library/compiler/stack.factor"
|
||||
"/library/compiler/interpret-only.factor"
|
||||
"/library/compiler/alien-types.factor"
|
||||
"/library/compiler/alien-macros.factor"
|
||||
"/library/compiler/alien.factor"
|
||||
|
||||
"/library/sdl/sdl.factor"
|
||||
"/library/sdl/sdl-video.factor"
|
||||
"/library/sdl/sdl-event.factor"
|
||||
"/library/sdl/sdl-gfx.factor"
|
||||
"/library/sdl/sdl-keysym.factor"
|
||||
"/library/sdl/sdl-utils.factor"
|
||||
"/library/sdl/hsv.factor"
|
||||
] [
|
||||
dup print
|
||||
run-resource
|
||||
] each
|
||||
] [
|
||||
"/library/compiler/dummy-compiler.factor" dup print run-resource
|
||||
] ifte
|
||||
|
||||
"/library/bootstrap/init-stage2.factor" dup print run-resource
|
||||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: init
|
||||
USE: combinators
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: parser
|
||||
USE: stack
|
||||
USE: stdio
|
||||
|
||||
"Cold boot in progress..." print
|
||||
[
|
||||
"/version.factor"
|
||||
"/library/kernel.factor"
|
||||
"/library/stack.factor"
|
||||
"/library/types.factor"
|
||||
"/library/math/math.factor"
|
||||
"/library/cons.factor"
|
||||
"/library/combinators.factor"
|
||||
"/library/logic.factor"
|
||||
"/library/vector-combinators.factor"
|
||||
"/library/lists.factor"
|
||||
"/library/assoc.factor"
|
||||
"/library/math/arithmetic.factor"
|
||||
"/library/math/math-combinators.factor"
|
||||
"/library/vectors.factor"
|
||||
"/library/strings.factor"
|
||||
"/library/hashtables.factor"
|
||||
"/library/namespaces.factor"
|
||||
"/library/generic.factor"
|
||||
"/library/math/namespace-math.factor"
|
||||
"/library/list-namespaces.factor"
|
||||
"/library/sbuf.factor"
|
||||
"/library/continuations.factor"
|
||||
"/library/errors.factor"
|
||||
"/library/threads.factor"
|
||||
"/library/io/stream.factor"
|
||||
"/library/io/io-internals.factor"
|
||||
"/library/io/stream-impl.factor"
|
||||
"/library/io/stdio.factor"
|
||||
"/library/words.factor"
|
||||
"/library/vocabularies.factor"
|
||||
"/library/syntax/parse-numbers.factor"
|
||||
"/library/syntax/parser.factor"
|
||||
"/library/syntax/parse-syntax.factor"
|
||||
"/library/syntax/parse-stream.factor"
|
||||
"/library/math/generic.factor"
|
||||
"/library/bootstrap/init.factor"
|
||||
|
||||
"/library/format.factor"
|
||||
"/library/syntax/unparser.factor"
|
||||
"/library/io/presentation.factor"
|
||||
"/library/io/vocabulary-style.factor"
|
||||
"/library/syntax/prettyprint.factor"
|
||||
"/library/syntax/see.factor"
|
||||
"/library/tools/debugger.factor"
|
||||
|
||||
"/library/math/constants.factor"
|
||||
"/library/math/pow.factor"
|
||||
"/library/math/trig-hyp.factor"
|
||||
"/library/math/arc-trig-hyp.factor"
|
||||
|
||||
"/library/in-thread.factor"
|
||||
"/library/io/network.factor"
|
||||
"/library/io/logging.factor"
|
||||
"/library/random.factor"
|
||||
"/library/io/stdio-binary.factor"
|
||||
"/library/io/files.factor"
|
||||
"/library/eval-catch.factor"
|
||||
"/library/tools/listener.factor"
|
||||
"/library/tools/inspector.factor"
|
||||
"/library/tools/word-tools.factor"
|
||||
"/library/test/test.factor"
|
||||
"/library/io/ansi.factor"
|
||||
"/library/tools/telnetd.factor"
|
||||
"/library/tools/jedit-wire.factor"
|
||||
"/library/tools/profiler.factor"
|
||||
"/library/tools/heap-stats.factor"
|
||||
"/library/gensym.factor"
|
||||
"/library/tools/interpreter.factor"
|
||||
|
||||
! Inference needs to know primitive stack effects at load time
|
||||
"/library/primitives.factor"
|
||||
|
||||
"/library/inference/dataflow.factor"
|
||||
"/library/inference/inference.factor"
|
||||
"/library/inference/words.factor"
|
||||
"/library/inference/branches.factor"
|
||||
"/library/inference/stack.factor"
|
||||
|
||||
"/library/compiler/linearizer.factor"
|
||||
"/library/compiler/assembler.factor"
|
||||
"/library/compiler/xt.factor"
|
||||
"/library/compiler/generator.factor"
|
||||
"/library/compiler/compiler.factor"
|
||||
|
||||
"/library/bootstrap/image.factor"
|
||||
"/library/bootstrap/cross-compiler.factor"
|
||||
|
||||
"/library/httpd/url-encoding.factor"
|
||||
"/library/httpd/html-tags.factor"
|
||||
"/library/httpd/html.factor"
|
||||
"/library/httpd/http-common.factor"
|
||||
"/library/httpd/responder.factor"
|
||||
"/library/httpd/httpd.factor"
|
||||
"/library/httpd/file-responder.factor"
|
||||
"/library/httpd/inspect-responder.factor"
|
||||
"/library/httpd/test-responder.factor"
|
||||
"/library/httpd/quit-responder.factor"
|
||||
"/library/httpd/resource-responder.factor"
|
||||
"/library/httpd/default-responders.factor"
|
||||
|
||||
"/library/tools/jedit.factor"
|
||||
|
||||
"/library/cli.factor"
|
||||
] [
|
||||
dup print
|
||||
run-resource
|
||||
] each
|
||||
|
||||
cpu "x86" = [
|
||||
[
|
||||
"/library/compiler/assembly-x86.factor"
|
||||
"/library/compiler/generator-x86.factor"
|
||||
! "/library/compiler/compiler-macros.factor"
|
||||
! "/library/compiler/ifte.factor"
|
||||
! "/library/compiler/generic.factor"
|
||||
! "/library/compiler/stack.factor"
|
||||
! "/library/compiler/interpret-only.factor"
|
||||
! "/library/compiler/alien-types.factor"
|
||||
! "/library/compiler/alien-macros.factor"
|
||||
! "/library/compiler/alien.factor"
|
||||
!
|
||||
! "/library/sdl/sdl.factor"
|
||||
! "/library/sdl/sdl-video.factor"
|
||||
! "/library/sdl/sdl-event.factor"
|
||||
! "/library/sdl/sdl-gfx.factor"
|
||||
! "/library/sdl/sdl-keysym.factor"
|
||||
! "/library/sdl/sdl-utils.factor"
|
||||
! "/library/sdl/hsv.factor"
|
||||
] [
|
||||
dup print
|
||||
run-resource
|
||||
] each
|
||||
] [
|
||||
"/library/compiler/dummy-compiler.factor" dup print run-resource
|
||||
] ifte
|
||||
|
||||
"/library/bootstrap/init-stage2.factor" dup print run-resource
|
||||
|
|
|
|||
|
|
@ -27,9 +27,12 @@
|
|||
|
||||
IN: compiler
|
||||
USE: combinators
|
||||
USE: dataflow
|
||||
USE: errors
|
||||
USE: generator
|
||||
USE: hashtables
|
||||
USE: kernel
|
||||
USE: linearizer
|
||||
USE: lists
|
||||
USE: logic
|
||||
USE: math
|
||||
|
|
@ -43,175 +46,9 @@ USE: unparser
|
|||
USE: vectors
|
||||
USE: words
|
||||
|
||||
! We use a hashtable "compiled-xts" that maps words to
|
||||
! xt's that are currently being compiled. The commit-xt's word
|
||||
! sets the xt of each word in the hashtable to the value in the
|
||||
! hastable.
|
||||
!
|
||||
! This has the advantage that we can compile a word before the
|
||||
! words it depends on and perform a fixup later; among other
|
||||
! things this enables mutually recursive words.
|
||||
|
||||
SYMBOL: compiled-xts
|
||||
|
||||
: save-xt ( word -- )
|
||||
cell compile-aligned
|
||||
compiled-offset swap compiled-xts acons@ ;
|
||||
|
||||
: commit-xt ( xt word -- )
|
||||
dup t "compiled" set-word-property set-word-xt ;
|
||||
|
||||
: commit-xts ( -- )
|
||||
compiled-xts get [ unswons commit-xt ] each
|
||||
compiled-xts off ;
|
||||
|
||||
: compiled-xt ( word -- xt )
|
||||
dup compiled-xts get assoc [ nip ] [ word-xt ] ifte* ;
|
||||
|
||||
! "deferred-xts" is a list of [ where word relative ] pairs; the
|
||||
! xt of word when its done compiling will be written to the
|
||||
! offset, relative to the offset.
|
||||
|
||||
SYMBOL: deferred-xts
|
||||
|
||||
! Words being compiled are consed onto this list. When a word
|
||||
! is encountered that has not been previously compiled, it is
|
||||
! consed onto this list. Compilation stops when the list is
|
||||
! empty.
|
||||
|
||||
SYMBOL: compile-words
|
||||
|
||||
: defer-xt ( word where relative -- )
|
||||
#! After word is compiled, put its XT at where, relative.
|
||||
3list deferred-xts cons@ ;
|
||||
|
||||
: compiling? ( word -- ? )
|
||||
#! A word that is compiling or already compiled will not be
|
||||
#! added to the list of words to be compiled.
|
||||
dup compiled? [
|
||||
drop t
|
||||
] [
|
||||
dup compile-words get contains? [
|
||||
drop t
|
||||
] [
|
||||
compiled-xts get assoc
|
||||
] ifte
|
||||
] ifte ;
|
||||
|
||||
: fixup-deferred-xt ( word where relative -- )
|
||||
rot dup compiling? [
|
||||
compiled-xt swap - swap set-compiled-cell
|
||||
] [
|
||||
"Not compiled: " swap word-name cat2 throw
|
||||
] ifte ;
|
||||
|
||||
: fixup-deferred-xts ( -- )
|
||||
deferred-xts get [
|
||||
uncons uncons car fixup-deferred-xt
|
||||
] each
|
||||
deferred-xts off ;
|
||||
|
||||
: postpone-word ( word -- )
|
||||
dup compiling? [ drop ] [ compile-words unique@ ] ifte ;
|
||||
|
||||
! During compilation, these two variables store pending
|
||||
! literals. Literals are either consumed at compile-time by
|
||||
! words with special compilation behavior, or otherwise they are
|
||||
! compiled into code that pushes them.
|
||||
|
||||
SYMBOL: compile-datastack
|
||||
SYMBOL: compile-callstack
|
||||
|
||||
: pop-literal ( -- obj )
|
||||
compile-datastack get vector-pop ;
|
||||
|
||||
: immediate? ( obj -- ? )
|
||||
#! fixnums and f have a pointerless representation, and
|
||||
#! are compiled immediately. Everything else can be moved
|
||||
#! by GC, and is indexed through a table.
|
||||
dup fixnum? swap f eq? or ;
|
||||
|
||||
: compile-literal ( obj -- )
|
||||
dup immediate? [
|
||||
address LITERAL
|
||||
] [
|
||||
intern-literal [LITERAL]
|
||||
] ifte ;
|
||||
|
||||
: commit-literals ( -- )
|
||||
compile-datastack get
|
||||
dup vector-empty? [
|
||||
drop
|
||||
] [
|
||||
dup [ compile-literal ] vector-each
|
||||
0 swap set-vector-length
|
||||
] ifte ;
|
||||
|
||||
: postpone-literal ( obj -- )
|
||||
#! Literals are not compiled immediately, so that words like
|
||||
#! ifte with special compilation behavior can work.
|
||||
compile-datastack get vector-push ;
|
||||
|
||||
: tail? ( -- ? )
|
||||
compile-callstack get vector-empty? ;
|
||||
|
||||
: compile-simple-word ( word -- )
|
||||
#! Compile a JMP at the end (tail call optimization)
|
||||
dup postpone-word
|
||||
commit-literals tail? [ JUMP ] [ CALL ] ifte
|
||||
compiled-offset defer-xt ;
|
||||
|
||||
: compile-word ( word -- )
|
||||
#! If a word has a compiling property, then it has special
|
||||
#! compilation behavior.
|
||||
dup "compiling" word-property dup [
|
||||
nip call
|
||||
] [
|
||||
drop compile-simple-word
|
||||
] ifte ;
|
||||
|
||||
: begin-compiling-quot ( quot -- )
|
||||
compile-callstack get vector-push ;
|
||||
|
||||
: end-compiling-quot ( -- )
|
||||
compile-callstack get vector-pop drop ;
|
||||
|
||||
: compiling ( quot -- )
|
||||
#! Called on each iteration of compile-loop, with the
|
||||
#! remaining quotation.
|
||||
[
|
||||
compile-callstack get
|
||||
dup vector-length pred
|
||||
swap set-vector-nth
|
||||
] [
|
||||
end-compiling-quot
|
||||
] ifte* ;
|
||||
|
||||
: compile-atom ( obj -- )
|
||||
dup word? [ compile-word ] [ postpone-literal ] ifte ;
|
||||
|
||||
: compile-loop ( quot -- )
|
||||
[
|
||||
uncons dup compiling swap compile-atom compile-loop
|
||||
] when* ;
|
||||
|
||||
: compile-quot ( quot -- )
|
||||
[
|
||||
dup begin-compiling-quot compile-loop commit-literals
|
||||
] when* ;
|
||||
|
||||
: with-compiler ( quot -- )
|
||||
[
|
||||
10 <vector> compile-datastack set
|
||||
10 <vector> compile-callstack set
|
||||
call
|
||||
fixup-deferred-xts
|
||||
commit-xts
|
||||
] with-scope ;
|
||||
|
||||
: (compile) ( word -- )
|
||||
#! Should be called inside the with-compiler scope.
|
||||
dup save-xt word-parameter compile-quot RET ;
|
||||
dup save-xt word-parameter dataflow linearize generate ;
|
||||
|
||||
: compile-postponed ( -- )
|
||||
compile-words get [
|
||||
|
|
@ -225,19 +62,4 @@ SYMBOL: compile-callstack
|
|||
#! Compile the most recently defined word.
|
||||
word compile ; parsing
|
||||
|
||||
: cannot-compile ( word -- )
|
||||
"verbose-compile" get [
|
||||
"Cannot compile " write .
|
||||
] [
|
||||
drop
|
||||
] ifte ;
|
||||
|
||||
: compile-all ( -- )
|
||||
#! Compile all words.
|
||||
[
|
||||
dup "infer-effect" word-property [
|
||||
[ compile ] [ [ cannot-compile ] when ] catch
|
||||
] [
|
||||
drop
|
||||
] ifte
|
||||
] each-word ;
|
||||
: compile-all ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,100 @@
|
|||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: generator
|
||||
USE: alien
|
||||
USE: combinators
|
||||
USE: compiler
|
||||
USE: dataflow
|
||||
USE: errors
|
||||
USE: kernel
|
||||
USE: linearizer
|
||||
USE: lists
|
||||
USE: logic
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: stack
|
||||
USE: strings
|
||||
USE: words
|
||||
|
||||
: LITERAL ( cell -- )
|
||||
#! Push literal on data stack.
|
||||
4 ESI R+I
|
||||
ESI I>[R] ;
|
||||
|
||||
: [LITERAL] ( cell -- )
|
||||
#! Push complex literal on data stack by following an
|
||||
#! indirect pointer.
|
||||
4 ESI R+I
|
||||
EAX [I]>R
|
||||
EAX ESI R>[R] ;
|
||||
|
||||
: immediate? ( obj -- ? )
|
||||
#! fixnums and f have a pointerless representation, and
|
||||
#! are compiled immediately. Everything else can be moved
|
||||
#! by GC, and is indexed through a table.
|
||||
dup fixnum? swap f eq? or ;
|
||||
|
||||
: compile-literal ( obj -- )
|
||||
dup immediate? [
|
||||
address LITERAL
|
||||
] [
|
||||
intern-literal [LITERAL]
|
||||
] ifte ;
|
||||
|
||||
: PUSH-DS ( -- )
|
||||
#! Push contents of EAX onto datastack.
|
||||
4 ESI R+I
|
||||
EAX ESI R>[R] ;
|
||||
|
||||
: POP-DS ( -- )
|
||||
#! Pop datastack, store pointer to datastack top in EAX.
|
||||
ESI EAX [R]>R
|
||||
4 ESI R-I ;
|
||||
|
||||
: SELF-CALL ( name -- )
|
||||
#! Call named C function in Factor interpreter executable.
|
||||
dlsym-self CALL JUMP-FIXUP ;
|
||||
|
||||
: TYPE ( -- )
|
||||
#! Peek datastack, store type # in EAX.
|
||||
ESI PUSH-[R]
|
||||
"type_of" SELF-CALL
|
||||
4 ESP R+I ;
|
||||
|
||||
: ARITHMETIC-TYPE ( -- )
|
||||
#! Peek top two on datastack, store arithmetic type # in EAX.
|
||||
ESI EAX R>R
|
||||
EAX PUSH-[R]
|
||||
4 EAX R-I
|
||||
EAX PUSH-[R]
|
||||
"arithmetic_type" SELF-CALL
|
||||
8 ESP R+I ;
|
||||
|
||||
\ #push [ compile-literal ] "generator" set-word-property
|
||||
\ #call [ CALL compiled-offset defer-xt ] "generator" set-word-property
|
||||
\ #return [ drop RET ] "generator" set-word-property
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: generator
|
||||
USE: combinators
|
||||
USE: compiler
|
||||
USE: dataflow
|
||||
USE: errors
|
||||
USE: linearizer
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: stack
|
||||
USE: strings
|
||||
USE: words
|
||||
|
||||
: generate-node ( [ op | params ] -- )
|
||||
#! Generate machine code for a node.
|
||||
unswons dup "generator" word-property dup [
|
||||
nip call
|
||||
] [
|
||||
"No generator" throw
|
||||
] ifte ;
|
||||
|
||||
: generate ( linear -- )
|
||||
#! Compile a word definition from linear IR.
|
||||
[ generate-node ] each ;
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: linearizer
|
||||
USE: lists
|
||||
USE: words
|
||||
USE: stack
|
||||
USE: namespaces
|
||||
USE: dataflow
|
||||
USE: combinators
|
||||
|
||||
! Linear IR nodes. This is in addition to the symbols already
|
||||
! defined in dataflow vocab.
|
||||
|
||||
SYMBOL: #branch-t ( branch if top of stack is true )
|
||||
SYMBOL: #branch ( unconditional branch )
|
||||
SYMBOL: #label ( branch target )
|
||||
SYMBOL: #jump ( tail-call )
|
||||
SYMBOL: #return ( return to caller )
|
||||
|
||||
: linear, ( param op -- )
|
||||
swons , ;
|
||||
|
||||
: >linear ( node -- )
|
||||
#! Dataflow OPs have a linearizer word property. This
|
||||
#! quotation is executed to convert the node into linear
|
||||
#! form.
|
||||
[ node-param get node-op get ] bind
|
||||
dup "linearizer" word-property dup [
|
||||
nip call
|
||||
] [
|
||||
drop linear,
|
||||
] ifte ;
|
||||
|
||||
: (linearize) ( dataflow -- )
|
||||
[ >linear ] each ;
|
||||
|
||||
: linearize ( dataflow -- linear )
|
||||
#! Transform dataflow IR into linear IR. This strips out
|
||||
#! stack flow information, flattens conditionals into
|
||||
#! jumps and labels, and turns dataflow IR nodes into
|
||||
#! lists where the first element is an operation, and the
|
||||
#! rest is arguments.
|
||||
[ (linearize) f #return linear, ] make-list ;
|
||||
|
||||
: <label> ( -- label )
|
||||
gensym ;
|
||||
|
||||
: label, ( label -- )
|
||||
#label linear, ;
|
||||
|
||||
: linearize-ifte ( param -- )
|
||||
#! The parameter is a list of two lists, each one a dataflow
|
||||
#! IR.
|
||||
uncons car
|
||||
<label> [
|
||||
#branch-t linear,
|
||||
(linearize) ( false branch )
|
||||
<label> dup #branch linear,
|
||||
] keep label, ( branch target of BRANCH-T )
|
||||
swap (linearize) ( true branch )
|
||||
label, ( branch target of false branch end ) ;
|
||||
|
||||
\ #ifte [ linearize-ifte ] "linearizer" set-word-property
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: compiler
|
||||
USE: combinators
|
||||
USE: dataflow
|
||||
USE: errors
|
||||
USE: generator
|
||||
USE: hashtables
|
||||
USE: kernel
|
||||
USE: linearizer
|
||||
USE: lists
|
||||
USE: logic
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: parser
|
||||
USE: prettyprint
|
||||
USE: stack
|
||||
USE: stdio
|
||||
USE: strings
|
||||
USE: unparser
|
||||
USE: vectors
|
||||
USE: words
|
||||
|
||||
! We use a hashtable "compiled-xts" that maps words to
|
||||
! xt's that are currently being compiled. The commit-xt's word
|
||||
! sets the xt of each word in the hashtable to the value in the
|
||||
! hastable.
|
||||
!
|
||||
! This has the advantage that we can compile a word before the
|
||||
! words it depends on and perform a fixup later; among other
|
||||
! things this enables mutually recursive words.
|
||||
|
||||
SYMBOL: compiled-xts
|
||||
|
||||
: save-xt ( word -- )
|
||||
cell compile-aligned
|
||||
compiled-offset swap compiled-xts acons@ ;
|
||||
|
||||
: commit-xt ( xt word -- )
|
||||
dup t "compiled" set-word-property set-word-xt ;
|
||||
|
||||
: commit-xts ( -- )
|
||||
compiled-xts get [ unswons commit-xt ] each
|
||||
compiled-xts off ;
|
||||
|
||||
: compiled-xt ( word -- xt )
|
||||
dup compiled-xts get assoc [ nip ] [ word-xt ] ifte* ;
|
||||
|
||||
! "deferred-xts" is a list of [ where word relative ] pairs; the
|
||||
! xt of word when its done compiling will be written to the
|
||||
! offset, relative to the offset.
|
||||
|
||||
SYMBOL: deferred-xts
|
||||
|
||||
! Words being compiled are consed onto this list. When a word
|
||||
! is encountered that has not been previously compiled, it is
|
||||
! consed onto this list. Compilation stops when the list is
|
||||
! empty.
|
||||
|
||||
SYMBOL: compile-words
|
||||
|
||||
: defer-xt ( word where relative -- )
|
||||
#! After word is compiled, put its XT at where, relative.
|
||||
3list deferred-xts cons@ ;
|
||||
|
||||
: compiling? ( word -- ? )
|
||||
#! A word that is compiling or already compiled will not be
|
||||
#! added to the list of words to be compiled.
|
||||
dup compiled? [
|
||||
drop t
|
||||
] [
|
||||
dup compile-words get contains? [
|
||||
drop t
|
||||
] [
|
||||
compiled-xts get assoc
|
||||
] ifte
|
||||
] ifte ;
|
||||
|
||||
: fixup-deferred-xt ( word where relative -- )
|
||||
rot dup compiling? [
|
||||
compiled-xt swap - swap set-compiled-cell
|
||||
] [
|
||||
"Not compiled: " swap word-name cat2 throw
|
||||
] ifte ;
|
||||
|
||||
: fixup-deferred-xts ( -- )
|
||||
deferred-xts get [
|
||||
uncons uncons car fixup-deferred-xt
|
||||
] each
|
||||
deferred-xts off ;
|
||||
|
||||
: with-compiler ( quot -- )
|
||||
[
|
||||
call
|
||||
fixup-deferred-xts
|
||||
commit-xts
|
||||
] with-scope ;
|
||||
|
||||
: postpone-word ( word -- )
|
||||
dup compiling? [ drop ] [ compile-words unique@ ] ifte ;
|
||||
|
|
@ -133,7 +133,7 @@ USE: hashtables
|
|||
3 ensure-d
|
||||
dataflow-drop, pop-d
|
||||
dataflow-drop, pop-d 2list
|
||||
>r 1 meta-d get vector-tail* IFTE r>
|
||||
>r 1 meta-d get vector-tail* #ifte r>
|
||||
pop-d drop ( condition )
|
||||
infer-branches ;
|
||||
|
||||
|
|
@ -147,14 +147,14 @@ USE: hashtables
|
|||
#! Infer effects for all branches, unify.
|
||||
2 ensure-d
|
||||
dataflow-drop, pop-d vtable>list
|
||||
>r 1 meta-d get vector-tail* GENERIC r>
|
||||
>r 1 meta-d get vector-tail* #generic r>
|
||||
infer-branches ;
|
||||
|
||||
: infer-2generic ( -- )
|
||||
#! Infer effects for all branches, unify.
|
||||
3 ensure-d
|
||||
dataflow-drop, pop-d vtable>list
|
||||
>r 2 meta-d get vector-tail* 2GENERIC r>
|
||||
>r 2 meta-d get vector-tail* #2generic r>
|
||||
infer-branches ;
|
||||
|
||||
\ ifte [ infer-ifte ] "infer" set-word-property
|
||||
|
|
|
|||
|
|
@ -39,13 +39,12 @@ USE: vectors
|
|||
! We build a dataflow graph for the compiler.
|
||||
SYMBOL: dataflow-graph
|
||||
|
||||
SYMBOL: CALL ( non-tail call )
|
||||
SYMBOL: JUMP ( tail-call )
|
||||
SYMBOL: PUSH ( literal )
|
||||
SYMBOL: #call ( non-tail call )
|
||||
SYMBOL: #push ( literal )
|
||||
|
||||
SYMBOL: IFTE
|
||||
SYMBOL: GENERIC
|
||||
SYMBOL: 2GENERIC
|
||||
SYMBOL: #ifte
|
||||
SYMBOL: #generic
|
||||
SYMBOL: #2generic
|
||||
|
||||
SYMBOL: node-consume-d
|
||||
SYMBOL: node-produce-d
|
||||
|
|
@ -53,8 +52,8 @@ SYMBOL: node-consume-r
|
|||
SYMBOL: node-produce-r
|
||||
SYMBOL: node-op
|
||||
|
||||
! PUSH nodes have this field set to the value being pushed.
|
||||
! CALL nodes have this as the word being called
|
||||
! #push nodes have this field set to the value being pushed.
|
||||
! #call nodes have this as the word being called
|
||||
SYMBOL: node-param
|
||||
|
||||
: <dataflow-node> ( param op -- node )
|
||||
|
|
@ -93,4 +92,4 @@ SYMBOL: node-param
|
|||
: dataflow-drop, ( -- )
|
||||
#! Remove the top stack element and add a dataflow node
|
||||
#! noting this.
|
||||
\ drop CALL dataflow, [ 1 0 node-inputs ] bind ;
|
||||
\ drop #call dataflow, [ 1 0 node-inputs ] bind ;
|
||||
|
|
|
|||
|
|
@ -110,7 +110,7 @@ DEFER: apply-word
|
|||
#! Literals are annotated with the current recursive
|
||||
#! state.
|
||||
dup recursive-state get cons push-d
|
||||
PUSH dataflow, [ 1 0 node-outputs ] bind ;
|
||||
#push dataflow, [ 1 0 node-outputs ] bind ;
|
||||
|
||||
: apply-object ( obj -- )
|
||||
#! Apply the object's stack effect to the inferencer state.
|
||||
|
|
@ -149,10 +149,12 @@ DEFER: apply-word
|
|||
#! Stack effect of a quotation.
|
||||
[ f init-inference (infer) effect ] with-scope ;
|
||||
|
||||
: dataflow ( quot -- dataflow )
|
||||
#! Data flow of a quotation.
|
||||
[ f init-inference (infer) get-dataflow ] with-scope ;
|
||||
|
||||
: try-infer ( quot -- effect/f )
|
||||
#! Push f if inference fails.
|
||||
[ infer ] [ [ drop f ] when ] catch ;
|
||||
|
||||
IN: dataflow
|
||||
|
||||
: dataflow ( quot -- dataflow )
|
||||
#! Data flow of a quotation.
|
||||
[ f init-inference (infer) get-dataflow ] with-scope ;
|
||||
|
|
|
|||
|
|
@ -34,13 +34,13 @@ USE: lists
|
|||
USE: namespaces
|
||||
|
||||
\ >r [
|
||||
\ >r CALL dataflow, [ 1 0 node-inputs ] extend
|
||||
\ >r #call dataflow, [ 1 0 node-inputs ] extend
|
||||
pop-d push-r
|
||||
[ 0 1 node-outputs ] bind
|
||||
] "infer" set-word-property
|
||||
|
||||
\ r> [
|
||||
\ r> CALL dataflow, [ 0 1 node-inputs ] extend
|
||||
\ r> #call dataflow, [ 0 1 node-inputs ] extend
|
||||
pop-r push-d
|
||||
[ 1 0 node-outputs ] bind
|
||||
] "infer" set-word-property
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ USE: prettyprint
|
|||
#! parameters, add node. The quotation is called with the
|
||||
#! stack effect.
|
||||
over car ensure-d
|
||||
rot CALL dataflow,
|
||||
rot #call dataflow,
|
||||
[ pick swap dataflow-inputs ] keep
|
||||
pick 2slip swap dataflow-outputs ; inline
|
||||
|
||||
|
|
@ -149,7 +149,7 @@ USE: prettyprint
|
|||
] ifte ;
|
||||
|
||||
: infer-call ( [ rstate | quot ] -- )
|
||||
\ drop CALL dataflow, drop
|
||||
\ drop #call dataflow, drop
|
||||
[
|
||||
dataflow-graph off
|
||||
pop-d uncons recursive-state set (infer)
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ USE: prettyprint
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
IFTE [ [ drop ] [ + ] ifte ] dataflow dataflow-contains-op? >boolean
|
||||
#ifte [ [ drop ] [ + ] ifte ] dataflow dataflow-contains-op? >boolean
|
||||
] unit-test
|
||||
|
||||
: dataflow-consume-d-len ( object -- n )
|
||||
|
|
@ -47,7 +47,7 @@ USE: prettyprint
|
|||
[ t ] [ [ 2 ] dataflow car dataflow-produce-d-len 1 = ] unit-test
|
||||
|
||||
: dataflow-ifte-node-consume-d ( list -- node )
|
||||
IFTE swap dataflow-contains-op? car [ node-consume-d get ] bind ;
|
||||
#ifte swap dataflow-contains-op? car [ node-consume-d get ] bind ;
|
||||
|
||||
[ t ] [
|
||||
[ 2 [ swap ] [ nip "hi" ] ifte ] dataflow
|
||||
|
|
@ -56,7 +56,7 @@ USE: prettyprint
|
|||
|
||||
[ t ] [
|
||||
[ { drop no-method drop no-method } generic ] dataflow
|
||||
GENERIC swap dataflow-contains-op? car [
|
||||
#generic swap dataflow-contains-op? car [
|
||||
node-param get [
|
||||
[ [ node-param get \ no-method = ] bind ] some?
|
||||
] some?
|
||||
|
|
|
|||
Loading…
Reference in New Issue