Clean up non optimizing compiler, rewrite more primitives in assembly
Slava Pestov
parent
b0f8680438
commit
a876005c98
|
|
@ -85,8 +85,16 @@ SYMBOL: objects
|
|||
: 1-offset 8 ; inline
|
||||
: -1-offset 9 ; inline
|
||||
|
||||
SYMBOL: sub-primitives
|
||||
|
||||
: make-jit ( quot rc rt offset -- quad )
|
||||
{ [ { } make ] [ ] [ ] [ ] } spread 4array ; inline
|
||||
|
||||
: jit-define ( quot rc rt offset name -- )
|
||||
>r { [ { } make ] [ ] [ ] [ ] } spread 4array r> set ;
|
||||
>r make-jit r> set ; inline
|
||||
|
||||
: define-sub-primitive ( quot rc rt offset word -- )
|
||||
>r make-jit r> sub-primitives get set-at ;
|
||||
|
||||
! The image being constructed; a vector of word-size integers
|
||||
SYMBOL: image
|
||||
|
|
@ -118,29 +126,7 @@ SYMBOL: jit-dispatch
|
|||
SYMBOL: jit-epilog
|
||||
SYMBOL: jit-return
|
||||
SYMBOL: jit-profiling
|
||||
SYMBOL: jit-tag
|
||||
SYMBOL: jit-tag-word
|
||||
SYMBOL: jit-eq?
|
||||
SYMBOL: jit-eq?-word
|
||||
SYMBOL: jit-slot
|
||||
SYMBOL: jit-slot-word
|
||||
SYMBOL: jit-declare-word
|
||||
SYMBOL: jit-drop
|
||||
SYMBOL: jit-drop-word
|
||||
SYMBOL: jit-dup
|
||||
SYMBOL: jit-dup-word
|
||||
SYMBOL: jit->r
|
||||
SYMBOL: jit->r-word
|
||||
SYMBOL: jit-r>
|
||||
SYMBOL: jit-r>-word
|
||||
SYMBOL: jit-swap
|
||||
SYMBOL: jit-swap-word
|
||||
SYMBOL: jit-over
|
||||
SYMBOL: jit-over-word
|
||||
SYMBOL: jit-fixnum-fast
|
||||
SYMBOL: jit-fixnum-fast-word
|
||||
SYMBOL: jit-fixnum>=
|
||||
SYMBOL: jit-fixnum>=-word
|
||||
|
||||
! Default definition for undefined words
|
||||
SYMBOL: undefined-quot
|
||||
|
|
@ -163,29 +149,7 @@ SYMBOL: undefined-quot
|
|||
{ jit-epilog 33 }
|
||||
{ jit-return 34 }
|
||||
{ jit-profiling 35 }
|
||||
{ jit-tag 36 }
|
||||
{ jit-tag-word 37 }
|
||||
{ jit-eq? 38 }
|
||||
{ jit-eq?-word 39 }
|
||||
{ jit-slot 40 }
|
||||
{ jit-slot-word 41 }
|
||||
{ jit-declare-word 42 }
|
||||
{ jit-drop 43 }
|
||||
{ jit-drop-word 44 }
|
||||
{ jit-dup 45 }
|
||||
{ jit-dup-word 46 }
|
||||
{ jit->r 47 }
|
||||
{ jit->r-word 48 }
|
||||
{ jit-r> 49 }
|
||||
{ jit-r>-word 50 }
|
||||
{ jit-swap 51 }
|
||||
{ jit-swap-word 52 }
|
||||
{ jit-over 53 }
|
||||
{ jit-over-word 54 }
|
||||
{ jit-fixnum-fast 55 }
|
||||
{ jit-fixnum-fast-word 56 }
|
||||
{ jit-fixnum>= 57 }
|
||||
{ jit-fixnum>=-word 58 }
|
||||
{ undefined-quot 60 }
|
||||
} at header-size + ;
|
||||
|
||||
|
|
@ -305,6 +269,9 @@ M: f '
|
|||
|
||||
! Words
|
||||
|
||||
: word-sub-primitive ( word -- obj )
|
||||
global [ target-word ] bind sub-primitives get at ;
|
||||
|
||||
: emit-word ( word -- )
|
||||
[
|
||||
[ subwords [ emit-word ] each ]
|
||||
|
|
@ -316,12 +283,13 @@ M: f '
|
|||
[ vocabulary>> , ]
|
||||
[ def>> , ]
|
||||
[ props>> , ]
|
||||
[ drop f , ]
|
||||
[ drop 0 , ] ! count
|
||||
[ word-sub-primitive , ]
|
||||
[ drop 0 , ] ! xt
|
||||
[ drop 0 , ] ! code
|
||||
[ drop 0 , ] ! profiling
|
||||
} cleave
|
||||
f ,
|
||||
0 , ! count
|
||||
0 , ! xt
|
||||
0 , ! code
|
||||
0 , ! profiling
|
||||
] { } make [ ' ] map
|
||||
] bi
|
||||
\ word type-number object tag-number
|
||||
|
|
@ -460,18 +428,7 @@ M: quotation '
|
|||
\ if jit-if-word set
|
||||
\ dispatch jit-dispatch-word set
|
||||
\ do-primitive jit-primitive-word set
|
||||
\ tag jit-tag-word set
|
||||
\ eq? jit-eq?-word set
|
||||
\ slot jit-slot-word set
|
||||
\ declare jit-declare-word set
|
||||
\ drop jit-drop-word set
|
||||
\ dup jit-dup-word set
|
||||
\ >r jit->r-word set
|
||||
\ r> jit-r>-word set
|
||||
\ swap jit-swap-word set
|
||||
\ over jit-over-word set
|
||||
\ fixnum-fast jit-fixnum-fast-word set
|
||||
\ fixnum>= jit-fixnum>=-word set
|
||||
[ undefined ] undefined-quot set
|
||||
{
|
||||
jit-code-format
|
||||
|
|
@ -488,29 +445,7 @@ M: quotation '
|
|||
jit-epilog
|
||||
jit-return
|
||||
jit-profiling
|
||||
jit-tag
|
||||
jit-tag-word
|
||||
jit-eq?
|
||||
jit-eq?-word
|
||||
jit-slot
|
||||
jit-slot-word
|
||||
jit-declare-word
|
||||
jit-drop
|
||||
jit-drop-word
|
||||
jit-dup
|
||||
jit-dup-word
|
||||
jit->r
|
||||
jit->r-word
|
||||
jit-r>
|
||||
jit-r>-word
|
||||
jit-swap
|
||||
jit-swap-word
|
||||
jit-over
|
||||
jit-over-word
|
||||
jit-fixnum-fast
|
||||
jit-fixnum-fast-word
|
||||
jit-fixnum>=
|
||||
jit-fixnum>=-word
|
||||
undefined-quot
|
||||
} [ emit-userenv ] each ;
|
||||
|
||||
|
|
|
|||
|
|
@ -13,6 +13,8 @@ IN: bootstrap.primitives
|
|||
|
||||
crossref off
|
||||
|
||||
H{ } clone sub-primitives set
|
||||
|
||||
"resource:core/bootstrap/syntax.factor" parse-file
|
||||
|
||||
"resource:core/cpu/" architecture get {
|
||||
|
|
@ -256,6 +258,7 @@ bi
|
|||
"props"
|
||||
{ "compiled" read-only }
|
||||
{ "counter" { "fixnum" "math" } }
|
||||
{ "sub-primitive" read-only }
|
||||
} define-builtin
|
||||
|
||||
"byte-array" "byte-arrays" create { } define-builtin
|
||||
|
|
@ -323,14 +326,55 @@ tuple
|
|||
[ tuple-layout [ <tuple-boa> ] curry ] tri
|
||||
(( quot1 quot2 -- compose )) define-declared
|
||||
|
||||
! Sub-primitive words
|
||||
: make-sub-primitive ( word vocab -- )
|
||||
create
|
||||
dup reset-word
|
||||
dup 1quotation define ;
|
||||
|
||||
{
|
||||
{ "(execute)" "words.private" }
|
||||
{ "(call)" "kernel.private" }
|
||||
{ "fixnum+fast" "math.private" }
|
||||
{ "fixnum-fast" "math.private" }
|
||||
{ "fixnum*fast" "math.private" }
|
||||
{ "fixnum-bitand" "math.private" }
|
||||
{ "fixnum-bitor" "math.private" }
|
||||
{ "fixnum-bitxor" "math.private" }
|
||||
{ "fixnum-bitnot" "math.private" }
|
||||
{ "fixnum<" "math.private" }
|
||||
{ "fixnum<=" "math.private" }
|
||||
{ "fixnum>" "math.private" }
|
||||
{ "fixnum>=" "math.private" }
|
||||
{ "drop" "kernel" }
|
||||
{ "2drop" "kernel" }
|
||||
{ "3drop" "kernel" }
|
||||
{ "dup" "kernel" }
|
||||
{ "2dup" "kernel" }
|
||||
{ "3dup" "kernel" }
|
||||
{ "rot" "kernel" }
|
||||
{ "-rot" "kernel" }
|
||||
{ "dupd" "kernel" }
|
||||
{ "swapd" "kernel" }
|
||||
{ "nip" "kernel" }
|
||||
{ "2nip" "kernel" }
|
||||
{ "tuck" "kernel" }
|
||||
{ "over" "kernel" }
|
||||
{ "pick" "kernel" }
|
||||
{ "swap" "kernel" }
|
||||
{ ">r" "kernel" }
|
||||
{ "r>" "kernel" }
|
||||
{ "eq?" "kernel" }
|
||||
{ "tag" "kernel.private" }
|
||||
{ "slot" "slots.private" }
|
||||
} [ make-sub-primitive ] assoc-each
|
||||
|
||||
! Primitive words
|
||||
: make-primitive ( word vocab n -- )
|
||||
>r create dup reset-word r>
|
||||
[ do-primitive ] curry [ ] like define ;
|
||||
|
||||
{
|
||||
{ "(execute)" "words.private" }
|
||||
{ "(call)" "kernel.private" }
|
||||
{ "bignum>fixnum" "math.private" }
|
||||
{ "float>fixnum" "math.private" }
|
||||
{ "fixnum>bignum" "math.private" }
|
||||
|
|
@ -346,24 +390,13 @@ tuple
|
|||
{ "bits>double" "math" }
|
||||
{ "<complex>" "math.private" }
|
||||
{ "fixnum+" "math.private" }
|
||||
{ "fixnum+fast" "math.private" }
|
||||
{ "fixnum-" "math.private" }
|
||||
{ "fixnum-fast" "math.private" }
|
||||
{ "fixnum*" "math.private" }
|
||||
{ "fixnum*fast" "math.private" }
|
||||
{ "fixnum/i" "math.private" }
|
||||
{ "fixnum-mod" "math.private" }
|
||||
{ "fixnum/mod" "math.private" }
|
||||
{ "fixnum-bitand" "math.private" }
|
||||
{ "fixnum-bitor" "math.private" }
|
||||
{ "fixnum-bitxor" "math.private" }
|
||||
{ "fixnum-bitnot" "math.private" }
|
||||
{ "fixnum-shift" "math.private" }
|
||||
{ "fixnum-shift-fast" "math.private" }
|
||||
{ "fixnum<" "math.private" }
|
||||
{ "fixnum<=" "math.private" }
|
||||
{ "fixnum>" "math.private" }
|
||||
{ "fixnum>=" "math.private" }
|
||||
{ "bignum=" "math.private" }
|
||||
{ "bignum+" "math.private" }
|
||||
{ "bignum-" "math.private" }
|
||||
|
|
@ -395,25 +428,6 @@ tuple
|
|||
{ "float>=" "math.private" }
|
||||
{ "<word>" "words" }
|
||||
{ "word-xt" "words" }
|
||||
{ "drop" "kernel" }
|
||||
{ "2drop" "kernel" }
|
||||
{ "3drop" "kernel" }
|
||||
{ "dup" "kernel" }
|
||||
{ "2dup" "kernel" }
|
||||
{ "3dup" "kernel" }
|
||||
{ "rot" "kernel" }
|
||||
{ "-rot" "kernel" }
|
||||
{ "dupd" "kernel" }
|
||||
{ "swapd" "kernel" }
|
||||
{ "nip" "kernel" }
|
||||
{ "2nip" "kernel" }
|
||||
{ "tuck" "kernel" }
|
||||
{ "over" "kernel" }
|
||||
{ "pick" "kernel" }
|
||||
{ "swap" "kernel" }
|
||||
{ ">r" "kernel" }
|
||||
{ "r>" "kernel" }
|
||||
{ "eq?" "kernel" }
|
||||
{ "getenv" "kernel.private" }
|
||||
{ "setenv" "kernel.private" }
|
||||
{ "(exists?)" "io.files.private" }
|
||||
|
|
@ -433,7 +447,6 @@ tuple
|
|||
{ "code-room" "memory" }
|
||||
{ "os-env" "system" }
|
||||
{ "millis" "system" }
|
||||
{ "tag" "kernel.private" }
|
||||
{ "modify-code-heap" "compiler.units" }
|
||||
{ "dlopen" "alien" }
|
||||
{ "dlsym" "alien" }
|
||||
|
|
@ -468,7 +481,6 @@ tuple
|
|||
{ "set-alien-cell" "alien.accessors" }
|
||||
{ "(throw)" "kernel.private" }
|
||||
{ "alien-address" "alien" }
|
||||
{ "slot" "slots.private" }
|
||||
{ "set-slot" "slots.private" }
|
||||
{ "string-nth" "strings.private" }
|
||||
{ "set-string-nth" "strings.private" }
|
||||
|
|
|
|||
|
|
@ -18,8 +18,8 @@ IN: compiler.constants
|
|||
: underlying-alien-offset ( -- n ) bootstrap-cell object tag-number - ;
|
||||
: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ;
|
||||
: class-hash-offset ( -- n ) bootstrap-cell object tag-number - ;
|
||||
: word-xt-offset ( -- n ) 8 bootstrap-cells object tag-number - ;
|
||||
: word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ;
|
||||
: quot-xt-offset ( -- n ) 3 bootstrap-cells object tag-number - ;
|
||||
: word-code-offset ( -- n ) 9 bootstrap-cells object tag-number - ;
|
||||
: word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ;
|
||||
: array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ;
|
||||
: compiled-header-size ( -- n ) 4 bootstrap-cells ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image.private kernel namespaces system
|
||||
cpu.x86.assembler layouts compiler.units math generator.fixup
|
||||
compiler.constants vocabs ;
|
||||
USING: bootstrap.image.private kernel kernel.private namespaces
|
||||
system cpu.x86.assembler layouts compiler.units math math.private
|
||||
generator.fixup compiler.constants vocabs slots.private words
|
||||
words.private ;
|
||||
IN: bootstrap.x86
|
||||
|
||||
big-endian off
|
||||
|
|
@ -74,27 +75,34 @@ big-endian off
|
|||
arg0 quot-xt-offset [+] JMP ! execute branch
|
||||
] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
|
||||
|
||||
[
|
||||
stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
|
||||
] f f f jit-epilog jit-define
|
||||
|
||||
[ 0 RET ] f f f jit-return jit-define
|
||||
|
||||
! Sub-primitives
|
||||
|
||||
! Quotations and words
|
||||
[
|
||||
arg0 ds-reg [] MOV ! load from stack
|
||||
ds-reg bootstrap-cell SUB ! pop stack
|
||||
arg0 quot-xt-offset [+] JMP ! call quotation
|
||||
] f f f \ (call) define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV ! load from stack
|
||||
ds-reg bootstrap-cell SUB ! pop stack
|
||||
arg0 word-xt-offset [+] JMP ! execute word
|
||||
] f f f \ (execute) define-sub-primitive
|
||||
|
||||
! Objects
|
||||
[
|
||||
arg1 ds-reg [] MOV ! load from stack
|
||||
arg1 tag-mask get AND ! compute tag
|
||||
arg1 tag-bits get SHL ! tag the tag
|
||||
ds-reg [] arg1 MOV ! push to stack
|
||||
] f f f jit-tag jit-define
|
||||
|
||||
: jit-compare ( -- )
|
||||
arg1 0 MOV ! load t
|
||||
arg1 dup [] MOV
|
||||
temp-reg \ f tag-number MOV ! load f
|
||||
arg0 ds-reg [] MOV ! load first value
|
||||
ds-reg bootstrap-cell SUB ! adjust stack pointer
|
||||
ds-reg [] arg0 CMP ! compare with second value
|
||||
;
|
||||
|
||||
[
|
||||
jit-compare
|
||||
arg1 temp-reg CMOVNE ! not equal?
|
||||
ds-reg [] arg1 MOV ! store
|
||||
] rc-absolute-cell rt-literal 1 rex-length + jit-eq? jit-define
|
||||
] f f f \ tag define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV ! load slot number
|
||||
|
|
@ -105,63 +113,187 @@ big-endian off
|
|||
arg1 tag-bits get SHL
|
||||
arg0 arg1 arg0 [+] MOV ! load slot value
|
||||
ds-reg [] arg0 MOV ! push to stack
|
||||
] f f f jit-slot jit-define
|
||||
] f f f \ slot define-sub-primitive
|
||||
|
||||
! Shufflers
|
||||
[
|
||||
ds-reg bootstrap-cell SUB
|
||||
] f f f jit-drop jit-define
|
||||
] f f f \ drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
] f f f \ 2drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 3 bootstrap-cells SUB
|
||||
] f f f \ 3drop define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f jit-dup jit-define
|
||||
] f f f \ dup define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
arg1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg 2 bootstrap-cells ADD
|
||||
ds-reg [] arg0 MOV
|
||||
ds-reg bootstrap-cell neg [+] arg1 MOV
|
||||
] f f f \ 2dup define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
arg1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp-reg ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg 3 bootstrap-cells ADD
|
||||
ds-reg [] arg0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] arg1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp-reg MOV
|
||||
] f f f \ 3dup define-sub-primitive
|
||||
|
||||
[
|
||||
rs-reg bootstrap-cell ADD
|
||||
arg0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
rs-reg [] arg0 MOV
|
||||
] f f f jit->r jit-define
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f \ nip define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg bootstrap-cell ADD
|
||||
arg0 rs-reg [] MOV
|
||||
rs-reg bootstrap-cell SUB
|
||||
arg0 ds-reg [] MOV
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f jit-r> jit-define
|
||||
] f f f \ 2nip define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f \ over define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f \ pick define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
arg1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg [] arg1 MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f \ dupd define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
arg1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] arg0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] arg1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] arg0 MOV
|
||||
] f f f \ tuck define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
arg1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg bootstrap-cell neg [+] arg0 MOV
|
||||
ds-reg [] arg1 MOV
|
||||
] f f f jit-swap jit-define
|
||||
] f f f \ swap define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f jit-over jit-define
|
||||
arg0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
arg1 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] arg0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] arg1 MOV
|
||||
] f f f \ swapd define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
arg1 ds-reg [] MOV
|
||||
arg1 arg0 SUB
|
||||
arg1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp-reg ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] arg1 MOV
|
||||
ds-reg -1 bootstrap-cells [+] arg0 MOV
|
||||
ds-reg [] temp-reg MOV
|
||||
] f f f \ rot define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV
|
||||
arg1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp-reg ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] arg0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp-reg MOV
|
||||
ds-reg [] arg1 MOV
|
||||
] f f f jit-fixnum-fast jit-define
|
||||
] f f f \ -rot define-sub-primitive
|
||||
|
||||
[
|
||||
jit-compare
|
||||
arg1 temp-reg CMOVL ! not equal?
|
||||
rs-reg bootstrap-cell ADD
|
||||
arg0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
rs-reg [] arg0 MOV
|
||||
] f f f \ >r define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg bootstrap-cell ADD
|
||||
arg0 rs-reg [] MOV
|
||||
rs-reg bootstrap-cell SUB
|
||||
ds-reg [] arg0 MOV
|
||||
] f f f \ r> define-sub-primitive
|
||||
|
||||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
arg1 0 MOV ! load t
|
||||
arg1 dup [] MOV
|
||||
temp-reg \ f tag-number MOV ! load f
|
||||
arg0 ds-reg [] MOV ! load first value
|
||||
ds-reg bootstrap-cell SUB ! adjust stack pointer
|
||||
ds-reg [] arg0 CMP ! compare with second value
|
||||
[ arg1 temp-reg ] dip execute ! move t if true
|
||||
ds-reg [] arg1 MOV ! store
|
||||
] rc-absolute-cell rt-literal 1 rex-length + jit-fixnum>= jit-define
|
||||
;
|
||||
|
||||
: define-jit-compare ( insn word -- )
|
||||
[ [ jit-compare ] curry rc-absolute-cell rt-literal 1 rex-length + ] dip
|
||||
define-sub-primitive ;
|
||||
|
||||
\ CMOVNE \ eq? define-jit-compare
|
||||
\ CMOVL \ fixnum>= define-jit-compare
|
||||
\ CMOVG \ fixnum<= define-jit-compare
|
||||
\ CMOVLE \ fixnum> define-jit-compare
|
||||
\ CMOVGE \ fixnum< define-jit-compare
|
||||
|
||||
! Math
|
||||
: jit-math ( insn -- )
|
||||
arg0 ds-reg [] MOV ! load second input
|
||||
ds-reg bootstrap-cell SUB ! pop stack
|
||||
arg1 ds-reg [] MOV ! load first input
|
||||
[ arg1 arg0 ] dip execute ! compute result
|
||||
ds-reg [] arg1 MOV ! push result
|
||||
;
|
||||
|
||||
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
|
||||
|
||||
[ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive
|
||||
|
||||
[
|
||||
stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
|
||||
] f f f jit-epilog jit-define
|
||||
arg0 ds-reg [] MOV ! load second input
|
||||
ds-reg bootstrap-cell SUB ! pop stack
|
||||
arg1 ds-reg [] MOV ! load first input
|
||||
arg0 tag-bits get SAR ! untag second input
|
||||
arg0 arg1 IMUL2 ! multiply
|
||||
ds-reg [] arg1 MOV ! push result
|
||||
] f f f \ fixnum*fast define-sub-primitive
|
||||
|
||||
[ 0 RET ] f f f jit-return jit-define
|
||||
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
|
||||
|
||||
[ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
|
||||
|
||||
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
|
||||
|
||||
[
|
||||
arg0 ds-reg [] MOV ! load input input
|
||||
arg0 NOT ! complement
|
||||
arg0 tag-mask get XOR ! clear tag bits
|
||||
ds-reg [] arg0 MOV ! save
|
||||
] f f f \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[ "bootstrap.x86" forget-vocab ] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -104,6 +104,8 @@ M: object infer-call
|
|||
] if
|
||||
] "infer" set-word-prop
|
||||
|
||||
\ execute t "no-compile" set-word-prop
|
||||
|
||||
\ if [
|
||||
3 ensure-values
|
||||
2 d-tail [ special? ] contains? [
|
||||
|
|
@ -123,6 +125,8 @@ M: object infer-call
|
|||
[ #dispatch ] infer-branches
|
||||
] "infer" set-word-prop
|
||||
|
||||
\ dispatch t "no-compile" set-word-prop
|
||||
|
||||
\ curry [
|
||||
2 ensure-values
|
||||
pop-d pop-d swap <curried> push-d
|
||||
|
|
|
|||
|
|
@ -34,7 +34,9 @@ M: symbol definer drop \ SYMBOL: f ;
|
|||
M: symbol definition drop f ;
|
||||
|
||||
PREDICATE: primitive < word ( obj -- ? )
|
||||
def>> [ do-primitive ] tail? ;
|
||||
[ def>> [ do-primitive ] tail? ]
|
||||
[ sub-primitive>> >boolean ]
|
||||
bi or ;
|
||||
M: primitive definer drop \ PRIMITIVE: f ;
|
||||
M: primitive definition drop f ;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,6 @@ and the callstack top is passed in EDX */
|
|||
|
||||
#define ARG0 %eax
|
||||
#define ARG1 %edx
|
||||
#define XT_REG %ecx
|
||||
#define STACK_REG %esp
|
||||
#define DS_REG %esi
|
||||
#define RETURN_REG %eax
|
||||
|
|
@ -22,9 +21,6 @@ and the callstack top is passed in EDX */
|
|||
pop %ebx
|
||||
|
||||
#define QUOT_XT_OFFSET 9
|
||||
#define PROFILING_OFFSET 25
|
||||
#define WORD_DEF_OFFSET 13
|
||||
#define WORD_XT_OFFSET 29
|
||||
|
||||
/* We pass a function pointer to memcpy to work around a Mac OS X
|
||||
ABI limitation which would otherwise require us to do a bizzaro PC-relative
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
|
||||
#define ARG0 %rdi
|
||||
#define ARG1 %rsi
|
||||
#define XT_REG %rcx
|
||||
#define STACK_REG %rsp
|
||||
#define DS_REG %r14
|
||||
#define RETURN_REG %rax
|
||||
|
|
@ -22,9 +21,6 @@
|
|||
pop %rbx
|
||||
|
||||
#define QUOT_XT_OFFSET 21
|
||||
#define PROFILING_OFFSET 53
|
||||
#define WORD_DEF_OFFSET 29
|
||||
#define WORD_XT_OFFSET 61
|
||||
|
||||
/* We pass a function pointer to memcpy to work around a Mac OS X
|
||||
ABI limitation which would otherwise require us to do a bizzaro PC-relative
|
||||
|
|
|
|||
17
vm/cpu-x86.S
17
vm/cpu-x86.S
|
|
@ -1,5 +1,3 @@
|
|||
#define JUMP_QUOT jmp *QUOT_XT_OFFSET(ARG0)
|
||||
|
||||
DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
|
||||
PUSH_NONVOLATILE
|
||||
push ARG0 /* Save quot */
|
||||
|
|
@ -14,20 +12,9 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
|
|||
POP_NONVOLATILE
|
||||
ret
|
||||
|
||||
DEF(F_FASTCALL void,primitive_call,(void)):
|
||||
mov (DS_REG),ARG0 /* Load quotation from data stack */
|
||||
sub $CELL_SIZE,DS_REG /* Pop data stack */
|
||||
JUMP_QUOT
|
||||
|
||||
/* Don't mess up EDX, it's the callstack top parameter to primitives. */
|
||||
DEF(F_FASTCALL void,primitive_execute,(void)):
|
||||
mov (DS_REG),ARG0 /* Load word from data stack */
|
||||
sub $CELL_SIZE,DS_REG /* Pop data stack */
|
||||
jmp *WORD_XT_OFFSET(ARG0) /* Load word-xt slot */
|
||||
|
||||
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
|
||||
mov ARG1,STACK_REG /* rewind_to */
|
||||
JUMP_QUOT
|
||||
jmp *QUOT_XT_OFFSET(ARG0)
|
||||
|
||||
DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
|
||||
mov STACK_REG,ARG1 /* Save stack pointer */
|
||||
|
|
@ -39,7 +26,7 @@ DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
|
|||
pop ARG1 /* OK to clobber ARG1 here */
|
||||
pop ARG1
|
||||
pop ARG1
|
||||
JUMP_QUOT /* Call the quotation */
|
||||
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
||||
|
||||
#ifdef WINDOWS
|
||||
.section .drectve
|
||||
|
|
|
|||
|
|
@ -129,6 +129,8 @@ typedef struct {
|
|||
CELL compiledp;
|
||||
/* TAGGED call count for profiling */
|
||||
CELL counter;
|
||||
/* TAGGED machine code for sub-primitive */
|
||||
CELL subprimitive;
|
||||
/* UNTAGGED execution token: jump here to execute word */
|
||||
XT xt;
|
||||
/* UNTAGGED compiled code block */
|
||||
|
|
|
|||
68
vm/math.c
68
vm/math.c
|
|
@ -35,33 +35,18 @@ DEFINE_PRIMITIVE(float_to_fixnum)
|
|||
F_FIXNUM y = untag_fixnum_fast(dpop()); \
|
||||
F_FIXNUM x = untag_fixnum_fast(dpop());
|
||||
|
||||
/* The fixnum arithmetic operations defined in C are relatively slow.
|
||||
The Factor compiler has optimized assembly intrinsics for some of these
|
||||
operations. */
|
||||
DEFINE_PRIMITIVE(fixnum_add)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
box_signed_cell(x + y);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_add_fast)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
dpush(tag_fixnum(x + y));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_subtract)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
box_signed_cell(x - y);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_subtract_fast)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
dpush(tag_fixnum(x - y));
|
||||
}
|
||||
|
||||
/* Multiply two integers, and trap overflow.
|
||||
Thanks to David Blaikie (The_Vulture from freenode #java) for the hint. */
|
||||
DEFINE_PRIMITIVE(fixnum_multiply)
|
||||
|
|
@ -87,12 +72,6 @@ DEFINE_PRIMITIVE(fixnum_multiply)
|
|||
}
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_multiply_fast)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
dpush(tag_fixnum(x * y));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_divint)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
|
|
@ -112,24 +91,6 @@ DEFINE_PRIMITIVE(fixnum_mod)
|
|||
dpush(tag_fixnum(x % y));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_and)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
dpush(tag_fixnum(x & y));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_or)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
dpush(tag_fixnum(x | y));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_xor)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
dpush(tag_fixnum(x ^ y));
|
||||
}
|
||||
|
||||
/*
|
||||
* Note the hairy overflow check.
|
||||
* If we're shifting right by n bits, we won't overflow as long as none of the
|
||||
|
|
@ -172,35 +133,6 @@ DEFINE_PRIMITIVE(fixnum_shift_fast)
|
|||
dpush(tag_fixnum(y < 0 ? (x >> -y) : (x << y)));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_less)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
box_boolean(x < y);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_lesseq)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
box_boolean(x <= y);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_greater)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
box_boolean(x > y);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_greatereq)
|
||||
{
|
||||
POP_FIXNUMS(x,y)
|
||||
box_boolean(x >= y);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(fixnum_not)
|
||||
{
|
||||
drepl(tag_fixnum(~untag_fixnum_fast(dpeek())));
|
||||
}
|
||||
|
||||
/* Bignums */
|
||||
DEFINE_PRIMITIVE(fixnum_to_bignum)
|
||||
{
|
||||
|
|
|
|||
11
vm/math.h
11
vm/math.h
|
|
@ -11,23 +11,12 @@ DECLARE_PRIMITIVE(float_to_fixnum);
|
|||
|
||||
DECLARE_PRIMITIVE(fixnum_add);
|
||||
DECLARE_PRIMITIVE(fixnum_subtract);
|
||||
DECLARE_PRIMITIVE(fixnum_add_fast);
|
||||
DECLARE_PRIMITIVE(fixnum_subtract_fast);
|
||||
DECLARE_PRIMITIVE(fixnum_multiply);
|
||||
DECLARE_PRIMITIVE(fixnum_multiply_fast);
|
||||
DECLARE_PRIMITIVE(fixnum_divint);
|
||||
DECLARE_PRIMITIVE(fixnum_divmod);
|
||||
DECLARE_PRIMITIVE(fixnum_mod);
|
||||
DECLARE_PRIMITIVE(fixnum_and);
|
||||
DECLARE_PRIMITIVE(fixnum_or);
|
||||
DECLARE_PRIMITIVE(fixnum_xor);
|
||||
DECLARE_PRIMITIVE(fixnum_shift);
|
||||
DECLARE_PRIMITIVE(fixnum_shift_fast);
|
||||
DECLARE_PRIMITIVE(fixnum_less);
|
||||
DECLARE_PRIMITIVE(fixnum_lesseq);
|
||||
DECLARE_PRIMITIVE(fixnum_greater);
|
||||
DECLARE_PRIMITIVE(fixnum_greatereq);
|
||||
DECLARE_PRIMITIVE(fixnum_not);
|
||||
|
||||
CELL bignum_zero;
|
||||
CELL bignum_pos_one;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
#include "master.h"
|
||||
|
||||
void *primitives[] = {
|
||||
primitive_execute,
|
||||
primitive_call,
|
||||
primitive_bignum_to_fixnum,
|
||||
primitive_float_to_fixnum,
|
||||
primitive_fixnum_to_bignum,
|
||||
|
|
@ -18,24 +16,13 @@ void *primitives[] = {
|
|||
primitive_bits_double,
|
||||
primitive_from_rect,
|
||||
primitive_fixnum_add,
|
||||
primitive_fixnum_add_fast,
|
||||
primitive_fixnum_subtract,
|
||||
primitive_fixnum_subtract_fast,
|
||||
primitive_fixnum_multiply,
|
||||
primitive_fixnum_multiply_fast,
|
||||
primitive_fixnum_divint,
|
||||
primitive_fixnum_mod,
|
||||
primitive_fixnum_divmod,
|
||||
primitive_fixnum_and,
|
||||
primitive_fixnum_or,
|
||||
primitive_fixnum_xor,
|
||||
primitive_fixnum_not,
|
||||
primitive_fixnum_shift,
|
||||
primitive_fixnum_shift_fast,
|
||||
primitive_fixnum_less,
|
||||
primitive_fixnum_lesseq,
|
||||
primitive_fixnum_greater,
|
||||
primitive_fixnum_greatereq,
|
||||
primitive_bignum_eq,
|
||||
primitive_bignum_add,
|
||||
primitive_bignum_subtract,
|
||||
|
|
@ -67,25 +54,6 @@ void *primitives[] = {
|
|||
primitive_float_greatereq,
|
||||
primitive_word,
|
||||
primitive_word_xt,
|
||||
primitive_drop,
|
||||
primitive_2drop,
|
||||
primitive_3drop,
|
||||
primitive_dup,
|
||||
primitive_2dup,
|
||||
primitive_3dup,
|
||||
primitive_rot,
|
||||
primitive__rot,
|
||||
primitive_dupd,
|
||||
primitive_swapd,
|
||||
primitive_nip,
|
||||
primitive_2nip,
|
||||
primitive_tuck,
|
||||
primitive_over,
|
||||
primitive_pick,
|
||||
primitive_swap,
|
||||
primitive_to_r,
|
||||
primitive_from_r,
|
||||
primitive_eq,
|
||||
primitive_getenv,
|
||||
primitive_setenv,
|
||||
primitive_existsp,
|
||||
|
|
@ -105,7 +73,6 @@ void *primitives[] = {
|
|||
primitive_code_room,
|
||||
primitive_os_env,
|
||||
primitive_millis,
|
||||
primitive_tag,
|
||||
primitive_modify_code_heap,
|
||||
primitive_dlopen,
|
||||
primitive_dlsym,
|
||||
|
|
@ -140,7 +107,6 @@ void *primitives[] = {
|
|||
primitive_set_alien_cell,
|
||||
primitive_throw,
|
||||
primitive_alien_address,
|
||||
primitive_slot,
|
||||
primitive_set_slot,
|
||||
primitive_string_nth,
|
||||
primitive_set_string_nth,
|
||||
|
|
|
|||
174
vm/quotations.c
174
vm/quotations.c
|
|
@ -32,15 +32,15 @@ bool jit_ignore_declare_p(F_ARRAY *array, CELL i)
|
|||
&& array_nth(array,i + 1) == userenv[JIT_DECLARE_WORD];
|
||||
}
|
||||
|
||||
F_ARRAY *code_to_emit(CELL name)
|
||||
F_ARRAY *code_to_emit(CELL code)
|
||||
{
|
||||
return untag_object(array_nth(untag_object(userenv[name]),0));
|
||||
return untag_object(array_nth(untag_object(code),0));
|
||||
}
|
||||
|
||||
F_REL rel_to_emit(CELL name, CELL code_format, CELL code_length,
|
||||
F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length,
|
||||
CELL rel_argument, bool *rel_p)
|
||||
{
|
||||
F_ARRAY *quadruple = untag_object(userenv[name]);
|
||||
F_ARRAY *quadruple = untag_object(code);
|
||||
CELL rel_class = array_nth(quadruple,1);
|
||||
CELL rel_type = array_nth(quadruple,2);
|
||||
CELL offset = array_nth(quadruple,3);
|
||||
|
|
@ -82,20 +82,9 @@ bool jit_stack_frame_p(F_ARRAY *array)
|
|||
CELL obj = array_nth(array,i);
|
||||
if(type_of(obj) == WORD_TYPE)
|
||||
{
|
||||
if(obj != userenv[JIT_TAG_WORD]
|
||||
&& obj != userenv[JIT_EQP_WORD]
|
||||
&& obj != userenv[JIT_SLOT_WORD]
|
||||
&& obj != userenv[JIT_DROP_WORD]
|
||||
&& obj != userenv[JIT_DUP_WORD]
|
||||
&& obj != userenv[JIT_TO_R_WORD]
|
||||
&& obj != userenv[JIT_FROM_R_WORD]
|
||||
&& obj != userenv[JIT_SWAP_WORD]
|
||||
&& obj != userenv[JIT_OVER_WORD]
|
||||
&& obj != userenv[JIT_FIXNUM_MINUS_WORD]
|
||||
&& obj != userenv[JIT_FIXNUM_GE_WORD])
|
||||
{
|
||||
F_WORD *word = untag_object(obj);
|
||||
if(word->subprimitive == F && obj != userenv[JIT_DECLARE_WORD])
|
||||
return true;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -139,7 +128,7 @@ void jit_compile(CELL quot, bool relocate)
|
|||
bool stack_frame = jit_stack_frame_p(untag_object(array));
|
||||
|
||||
if(stack_frame)
|
||||
EMIT(JIT_PROLOG,0);
|
||||
EMIT(userenv[JIT_PROLOG],0);
|
||||
|
||||
CELL i;
|
||||
CELL length = array_capacity(untag_object(array));
|
||||
|
|
@ -154,84 +143,44 @@ void jit_compile(CELL quot, bool relocate)
|
|||
switch(type_of(obj))
|
||||
{
|
||||
case WORD_TYPE:
|
||||
word = untag_object(obj);
|
||||
|
||||
/* Intrinsics */
|
||||
if(obj == userenv[JIT_TAG_WORD])
|
||||
if(word->subprimitive != F)
|
||||
{
|
||||
EMIT(JIT_TAG,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_EQP_WORD])
|
||||
{
|
||||
GROWABLE_ARRAY_ADD(literals,T);
|
||||
EMIT(JIT_EQP,literals_count - 1);
|
||||
}
|
||||
else if(obj == userenv[JIT_SLOT_WORD])
|
||||
{
|
||||
EMIT(JIT_SLOT,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_DROP_WORD])
|
||||
{
|
||||
EMIT(JIT_DROP,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_DUP_WORD])
|
||||
{
|
||||
EMIT(JIT_DUP,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_TO_R_WORD])
|
||||
{
|
||||
EMIT(JIT_TO_R,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_FROM_R_WORD])
|
||||
{
|
||||
EMIT(JIT_FROM_R,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_SWAP_WORD])
|
||||
{
|
||||
EMIT(JIT_SWAP,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_OVER_WORD])
|
||||
{
|
||||
EMIT(JIT_OVER,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_FIXNUM_MINUS_WORD])
|
||||
{
|
||||
EMIT(JIT_FIXNUM_MINUS,0);
|
||||
}
|
||||
else if(obj == userenv[JIT_FIXNUM_GE_WORD])
|
||||
{
|
||||
GROWABLE_ARRAY_ADD(literals,T);
|
||||
EMIT(JIT_FIXNUM_GE,literals_count - 1);
|
||||
if(array_nth(untag_object(word->subprimitive),1) != F)
|
||||
{
|
||||
GROWABLE_ARRAY_ADD(literals,T);
|
||||
}
|
||||
|
||||
EMIT(word->subprimitive,literals_count - 1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Emit the epilog before the primitive call gate
|
||||
so that we save the C stack pointer minus the
|
||||
current stack frame. */
|
||||
word = untag_object(obj);
|
||||
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
|
||||
|
||||
if(i == length - 1)
|
||||
{
|
||||
if(stack_frame)
|
||||
EMIT(JIT_EPILOG,0);
|
||||
EMIT(userenv[JIT_EPILOG],0);
|
||||
|
||||
EMIT(JIT_WORD_JUMP,literals_count - 1);
|
||||
EMIT(userenv[JIT_WORD_JUMP],literals_count - 1);
|
||||
|
||||
tail_call = true;
|
||||
}
|
||||
else
|
||||
EMIT(JIT_WORD_CALL,literals_count - 1);
|
||||
EMIT(userenv[JIT_WORD_CALL],literals_count - 1);
|
||||
}
|
||||
break;
|
||||
case WRAPPER_TYPE:
|
||||
wrapper = untag_object(obj);
|
||||
GROWABLE_ARRAY_ADD(literals,wrapper->object);
|
||||
EMIT(JIT_PUSH_LITERAL,literals_count - 1);
|
||||
EMIT(userenv[JIT_PUSH_LITERAL],literals_count - 1);
|
||||
break;
|
||||
case FIXNUM_TYPE:
|
||||
if(jit_primitive_call_p(untag_object(array),i))
|
||||
{
|
||||
EMIT(JIT_PRIMITIVE,to_fixnum(obj));
|
||||
EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj));
|
||||
|
||||
i++;
|
||||
|
||||
|
|
@ -242,11 +191,11 @@ void jit_compile(CELL quot, bool relocate)
|
|||
if(jit_fast_if_p(untag_object(array),i))
|
||||
{
|
||||
if(stack_frame)
|
||||
EMIT(JIT_EPILOG,0);
|
||||
EMIT(userenv[JIT_EPILOG],0);
|
||||
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
|
||||
EMIT(JIT_IF_JUMP,literals_count - 2);
|
||||
EMIT(userenv[JIT_IF_JUMP],literals_count - 2);
|
||||
|
||||
i += 2;
|
||||
|
||||
|
|
@ -257,10 +206,10 @@ void jit_compile(CELL quot, bool relocate)
|
|||
if(jit_fast_dispatch_p(untag_object(array),i))
|
||||
{
|
||||
if(stack_frame)
|
||||
EMIT(JIT_EPILOG,0);
|
||||
EMIT(userenv[JIT_EPILOG],0);
|
||||
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
|
||||
EMIT(JIT_DISPATCH,literals_count - 1);
|
||||
EMIT(userenv[JIT_DISPATCH],literals_count - 1);
|
||||
|
||||
i++;
|
||||
|
||||
|
|
@ -274,7 +223,7 @@ void jit_compile(CELL quot, bool relocate)
|
|||
}
|
||||
default:
|
||||
GROWABLE_ARRAY_ADD(literals,obj);
|
||||
EMIT(JIT_PUSH_LITERAL,literals_count - 1);
|
||||
EMIT(userenv[JIT_PUSH_LITERAL],literals_count - 1);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
@ -282,9 +231,9 @@ void jit_compile(CELL quot, bool relocate)
|
|||
if(!tail_call)
|
||||
{
|
||||
if(stack_frame)
|
||||
EMIT(JIT_EPILOG,0);
|
||||
EMIT(userenv[JIT_EPILOG],0);
|
||||
|
||||
EMIT(JIT_RETURN,0);
|
||||
EMIT(userenv[JIT_RETURN],0);
|
||||
}
|
||||
|
||||
GROWABLE_ARRAY_TRIM(code);
|
||||
|
|
@ -330,7 +279,7 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
|
|||
bool stack_frame = jit_stack_frame_p(untag_object(array));
|
||||
|
||||
if(stack_frame)
|
||||
COUNT(JIT_PROLOG,0)
|
||||
COUNT(userenv[JIT_PROLOG],0)
|
||||
|
||||
CELL i;
|
||||
CELL length = array_capacity(untag_object(array));
|
||||
|
|
@ -339,55 +288,34 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
|
|||
for(i = 0; i < length; i++)
|
||||
{
|
||||
CELL obj = array_nth(untag_object(array),i);
|
||||
F_WORD *word;
|
||||
|
||||
switch(type_of(obj))
|
||||
{
|
||||
case WORD_TYPE:
|
||||
/* Intrinsics */
|
||||
if(obj == userenv[JIT_TAG_WORD])
|
||||
COUNT(JIT_TAG,i)
|
||||
else if(obj == userenv[JIT_EQP_WORD])
|
||||
COUNT(JIT_EQP,i)
|
||||
else if(obj == userenv[JIT_SLOT_WORD])
|
||||
COUNT(JIT_SLOT,i)
|
||||
else if(obj == userenv[JIT_DROP_WORD])
|
||||
COUNT(JIT_DROP,i)
|
||||
else if(obj == userenv[JIT_DUP_WORD])
|
||||
COUNT(JIT_DUP,i)
|
||||
else if(obj == userenv[JIT_TO_R_WORD])
|
||||
COUNT(JIT_TO_R,i)
|
||||
else if(obj == userenv[JIT_FROM_R_WORD])
|
||||
COUNT(JIT_FROM_R,i)
|
||||
else if(obj == userenv[JIT_SWAP_WORD])
|
||||
COUNT(JIT_SWAP,i)
|
||||
else if(obj == userenv[JIT_OVER_WORD])
|
||||
COUNT(JIT_OVER,i)
|
||||
else if(obj == userenv[JIT_FIXNUM_MINUS_WORD])
|
||||
COUNT(JIT_FIXNUM_MINUS,i)
|
||||
else if(obj == userenv[JIT_FIXNUM_GE_WORD])
|
||||
COUNT(JIT_FIXNUM_GE,i)
|
||||
else
|
||||
word = untag_object(obj);
|
||||
if(word->subprimitive != F)
|
||||
COUNT(word->subprimitive,i)
|
||||
else if(i == length - 1)
|
||||
{
|
||||
if(i == length - 1)
|
||||
{
|
||||
if(stack_frame)
|
||||
COUNT(JIT_EPILOG,i);
|
||||
|
||||
COUNT(JIT_WORD_JUMP,i)
|
||||
|
||||
tail_call = true;
|
||||
}
|
||||
else
|
||||
COUNT(JIT_WORD_CALL,i)
|
||||
if(stack_frame)
|
||||
COUNT(userenv[JIT_EPILOG],i);
|
||||
|
||||
COUNT(userenv[JIT_WORD_JUMP],i)
|
||||
|
||||
tail_call = true;
|
||||
}
|
||||
else
|
||||
COUNT(userenv[JIT_WORD_CALL],i)
|
||||
break;
|
||||
case WRAPPER_TYPE:
|
||||
COUNT(JIT_PUSH_LITERAL,i)
|
||||
COUNT(userenv[JIT_PUSH_LITERAL],i)
|
||||
break;
|
||||
case FIXNUM_TYPE:
|
||||
if(jit_primitive_call_p(untag_object(array),i))
|
||||
{
|
||||
COUNT(JIT_PRIMITIVE,i);
|
||||
COUNT(userenv[JIT_PRIMITIVE],i);
|
||||
|
||||
i++;
|
||||
|
||||
|
|
@ -398,11 +326,11 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
|
|||
if(jit_fast_if_p(untag_object(array),i))
|
||||
{
|
||||
if(stack_frame)
|
||||
COUNT(JIT_EPILOG,i)
|
||||
COUNT(userenv[JIT_EPILOG],i)
|
||||
|
||||
i += 2;
|
||||
|
||||
COUNT(JIT_IF_JUMP,i)
|
||||
COUNT(userenv[JIT_IF_JUMP],i)
|
||||
|
||||
tail_call = true;
|
||||
break;
|
||||
|
|
@ -411,11 +339,11 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
|
|||
if(jit_fast_dispatch_p(untag_object(array),i))
|
||||
{
|
||||
if(stack_frame)
|
||||
COUNT(JIT_EPILOG,i)
|
||||
COUNT(userenv[JIT_EPILOG],i)
|
||||
|
||||
i++;
|
||||
|
||||
COUNT(JIT_DISPATCH,i)
|
||||
COUNT(userenv[JIT_DISPATCH],i)
|
||||
|
||||
tail_call = true;
|
||||
break;
|
||||
|
|
@ -429,7 +357,7 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
|
|||
break;
|
||||
}
|
||||
default:
|
||||
COUNT(JIT_PUSH_LITERAL,i)
|
||||
COUNT(userenv[JIT_PUSH_LITERAL],i)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
@ -437,9 +365,9 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
|
|||
if(!tail_call)
|
||||
{
|
||||
if(stack_frame)
|
||||
COUNT(JIT_EPILOG,length)
|
||||
COUNT(userenv[JIT_EPILOG],length)
|
||||
|
||||
COUNT(JIT_RETURN,length)
|
||||
COUNT(userenv[JIT_RETURN],length)
|
||||
}
|
||||
|
||||
return -1;
|
||||
|
|
|
|||
146
vm/run.c
146
vm/run.c
|
|
@ -90,133 +90,6 @@ void init_stacks(CELL ds_size_, CELL rs_size_)
|
|||
stack_chain = NULL;
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(drop)
|
||||
{
|
||||
dpop();
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(2drop)
|
||||
{
|
||||
ds -= 2 * CELLS;
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(3drop)
|
||||
{
|
||||
ds -= 3 * CELLS;
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(dup)
|
||||
{
|
||||
dpush(dpeek());
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(2dup)
|
||||
{
|
||||
CELL top = dpeek();
|
||||
CELL next = get(ds - CELLS);
|
||||
ds += CELLS * 2;
|
||||
put(ds - CELLS,next);
|
||||
put(ds,top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(3dup)
|
||||
{
|
||||
CELL c1 = dpeek();
|
||||
CELL c2 = get(ds - CELLS);
|
||||
CELL c3 = get(ds - CELLS * 2);
|
||||
ds += CELLS * 3;
|
||||
put (ds,c1);
|
||||
put (ds - CELLS,c2);
|
||||
put (ds - CELLS * 2,c3);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(rot)
|
||||
{
|
||||
CELL c1 = dpeek();
|
||||
CELL c2 = get(ds - CELLS);
|
||||
CELL c3 = get(ds - CELLS * 2);
|
||||
put(ds,c3);
|
||||
put(ds - CELLS,c1);
|
||||
put(ds - CELLS * 2,c2);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(_rot)
|
||||
{
|
||||
CELL c1 = dpeek();
|
||||
CELL c2 = get(ds - CELLS);
|
||||
CELL c3 = get(ds - CELLS * 2);
|
||||
put(ds,c2);
|
||||
put(ds - CELLS,c3);
|
||||
put(ds - CELLS * 2,c1);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(dupd)
|
||||
{
|
||||
CELL top = dpeek();
|
||||
CELL next = get(ds - CELLS);
|
||||
put(ds,next);
|
||||
put(ds - CELLS,next);
|
||||
dpush(top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(swapd)
|
||||
{
|
||||
CELL top = get(ds - CELLS);
|
||||
CELL next = get(ds - CELLS * 2);
|
||||
put(ds - CELLS,next);
|
||||
put(ds - CELLS * 2,top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(nip)
|
||||
{
|
||||
CELL top = dpop();
|
||||
drepl(top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(2nip)
|
||||
{
|
||||
CELL top = dpeek();
|
||||
ds -= CELLS * 2;
|
||||
drepl(top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(tuck)
|
||||
{
|
||||
CELL top = dpeek();
|
||||
CELL next = get(ds - CELLS);
|
||||
put(ds,next);
|
||||
put(ds - CELLS,top);
|
||||
dpush(top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(over)
|
||||
{
|
||||
dpush(get(ds - CELLS));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(pick)
|
||||
{
|
||||
dpush(get(ds - CELLS * 2));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(swap)
|
||||
{
|
||||
CELL top = dpeek();
|
||||
CELL next = get(ds - CELLS);
|
||||
put(ds,next);
|
||||
put(ds - CELLS,top);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(to_r)
|
||||
{
|
||||
rpush(dpop());
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(from_r)
|
||||
{
|
||||
dpush(rpop());
|
||||
}
|
||||
|
||||
bool stack_to_array(CELL bottom, CELL top)
|
||||
{
|
||||
F_FIXNUM depth = (F_FIXNUM)(top - bottom + CELLS);
|
||||
|
|
@ -280,13 +153,6 @@ DEFINE_PRIMITIVE(exit)
|
|||
exit(to_fixnum(dpop()));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(eq)
|
||||
{
|
||||
CELL lhs = dpop();
|
||||
CELL rhs = dpeek();
|
||||
drepl((lhs == rhs) ? T : F);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(millis)
|
||||
{
|
||||
box_unsigned_8(current_millis());
|
||||
|
|
@ -297,18 +163,6 @@ DEFINE_PRIMITIVE(sleep)
|
|||
sleep_millis(to_cell(dpop()));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(tag)
|
||||
{
|
||||
drepl(tag_fixnum(TAG(dpeek())));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(slot)
|
||||
{
|
||||
F_FIXNUM slot = untag_fixnum_fast(dpop());
|
||||
CELL obj = dpop();
|
||||
dpush(get(SLOT(obj,slot)));
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(set_slot)
|
||||
{
|
||||
F_FIXNUM slot = untag_fixnum_fast(dpop());
|
||||
|
|
|
|||
24
vm/run.h
24
vm/run.h
|
|
@ -245,28 +245,9 @@ DLLEXPORT void save_stacks(void);
|
|||
DLLEXPORT void nest_stacks(void);
|
||||
DLLEXPORT void unnest_stacks(void);
|
||||
void init_stacks(CELL ds_size, CELL rs_size);
|
||||
DECLARE_PRIMITIVE(drop);
|
||||
DECLARE_PRIMITIVE(2drop);
|
||||
DECLARE_PRIMITIVE(3drop);
|
||||
DECLARE_PRIMITIVE(dup);
|
||||
DECLARE_PRIMITIVE(2dup);
|
||||
DECLARE_PRIMITIVE(3dup);
|
||||
DECLARE_PRIMITIVE(rot);
|
||||
DECLARE_PRIMITIVE(_rot);
|
||||
DECLARE_PRIMITIVE(dupd);
|
||||
DECLARE_PRIMITIVE(swapd);
|
||||
DECLARE_PRIMITIVE(nip);
|
||||
DECLARE_PRIMITIVE(2nip);
|
||||
DECLARE_PRIMITIVE(tuck);
|
||||
DECLARE_PRIMITIVE(over);
|
||||
DECLARE_PRIMITIVE(pick);
|
||||
DECLARE_PRIMITIVE(swap);
|
||||
DECLARE_PRIMITIVE(to_r);
|
||||
DECLARE_PRIMITIVE(from_r);
|
||||
|
||||
DECLARE_PRIMITIVE(datastack);
|
||||
DECLARE_PRIMITIVE(retainstack);
|
||||
DECLARE_PRIMITIVE(execute);
|
||||
DECLARE_PRIMITIVE(call);
|
||||
DECLARE_PRIMITIVE(getenv);
|
||||
DECLARE_PRIMITIVE(setenv);
|
||||
DECLARE_PRIMITIVE(exit);
|
||||
|
|
@ -275,11 +256,8 @@ DECLARE_PRIMITIVE(os_envs);
|
|||
DECLARE_PRIMITIVE(set_os_env);
|
||||
DECLARE_PRIMITIVE(unset_os_env);
|
||||
DECLARE_PRIMITIVE(set_os_envs);
|
||||
DECLARE_PRIMITIVE(eq);
|
||||
DECLARE_PRIMITIVE(millis);
|
||||
DECLARE_PRIMITIVE(sleep);
|
||||
DECLARE_PRIMITIVE(tag);
|
||||
DECLARE_PRIMITIVE(slot);
|
||||
DECLARE_PRIMITIVE(set_slot);
|
||||
|
||||
bool stage2;
|
||||
|
|
|
|||
|
|
@ -49,6 +49,7 @@ F_WORD *allot_word(CELL vocab, CELL name)
|
|||
word->props = F;
|
||||
word->counter = tag_fixnum(0);
|
||||
word->compiledp = F;
|
||||
word->subprimitive = F;
|
||||
word->profiling = NULL;
|
||||
word->code = NULL;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue