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

Merge branch 'slots' of git://factorcode.org/git/factor into slots

db4
Slava Pestov 2009-09-26 16:38:24 -05:00
parent 0730f3a149 3476f2e28c
commit 117a0e2ac7
8 changed files with 42 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
basis/compiler/cfg/hats/hats.factor
View File

@ -46,15 +46,31 @@ insn-classes get [
{ [ dup not ] [ drop \ f tag-number ##load-immediate ] }
{ [ dup fixnum? ] [ tag-fixnum ##load-immediate ] }
[ ##load-reference ]
} cond ; inline
} cond ;
: ^^unbox-c-ptr ( src class -- dst )
[ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ; inline
[ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
: ^^neg ( src -- dst ) [ 0 ^^load-literal ] dip ^^sub ; inline
: ^^allot-tuple ( n -- dst ) 2 + cells tuple ^^allot ; inline
: ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline
: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline
: ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline
: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
: ^^neg ( src -- dst )
[ 0 ^^load-literal ] dip ^^sub ;
: ^^allot-tuple ( n -- dst )
2 + cells tuple ^^allot ;
: ^^allot-array ( n -- dst )
2 + cells array ^^allot ;
: ^^allot-byte-array ( n -- dst )
2 cells + byte-array ^^allot ;
: ^^offset>slot ( slot -- vreg' )
cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ;
: ^^tag-offset>slot ( slot tag -- vreg' )
[ ^^offset>slot ] dip ^^sub-imm ;
: ^^tag-fixnum ( src -- dst )
tag-bits get ^^shl-imm ;
: ^^untag-fixnum ( src -- dst )
tag-bits get ^^sar-imm ;

8
basis/compiler/cfg/instructions/instructions.factor
View File

@ -63,9 +63,7 @@ temp: temp/int-rep ;
! Slot access
INSN: ##slot
def: dst/int-rep
use: obj/int-rep slot/int-rep
literal: tag
temp: temp/int-rep ;
use: obj/int-rep slot/int-rep ;
INSN: ##slot-imm
def: dst/int-rep
@ -73,9 +71,7 @@ use: obj/int-rep
literal: slot tag ;
INSN: ##set-slot
use: src/int-rep obj/int-rep slot/int-rep
literal: tag
temp: temp/int-rep ;
use: src/int-rep obj/int-rep slot/int-rep ;
INSN: ##set-slot-imm
use: src/int-rep obj/int-rep

2
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -12,5 +12,5 @@ IN: compiler.cfg.intrinsics.misc
: emit-getenv ( node -- )
"userenv" ^^vm-field-ptr
swap node-input-infos first literal>>
[ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot 0 ^^slot ] if*
[ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot ^^slot ] if*
ds-push ;

8
basis/compiler/cfg/intrinsics/slots/slots.factor
View File

@ -9,8 +9,8 @@ IN: compiler.cfg.intrinsics.slots
: value-tag ( info -- n ) class>> class-tag ; inline
: (emit-slot) ( infos -- dst )
[ 2inputs ^^offset>slot ] [ first value-tag ] bi*
^^slot ;
[ 2inputs ] [ first value-tag ] bi*
^^tag-offset>slot ^^slot ;
: (emit-slot-imm) ( infos -- dst )
ds-drop
@ -28,8 +28,8 @@ IN: compiler.cfg.intrinsics.slots
] [ drop emit-primitive ] if ;
: (emit-set-slot) ( infos -- obj-reg )
[ 3inputs ^^offset>slot ] [ second value-tag ] bi*
pick [ next-vreg ##set-slot ] dip ;
[ 3inputs ] [ second value-tag ] bi*
^^tag-offset>slot over [ ##set-slot ] dip ;
: (emit-set-slot-imm) ( infos -- obj-reg )
ds-drop

8
basis/compiler/tests/low-level-ir.factor
View File

@ -64,9 +64,9 @@ IN: compiler.tests.low-level-ir
! one of the sources
[ t ] [
V{
T{ ##load-immediate f 1 $[ 2 cell log2 shift ] }
T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
T{ ##load-reference f 0 { t f t } }
T{ ##slot f 0 0 1 $[ array tag-number ] 2 }
T{ ##slot f 0 0 1 }
} compile-test-bb
] unit-test
@ -79,9 +79,9 @@ IN: compiler.tests.low-level-ir
[ t ] [
V{
T{ ##load-immediate f 1 $[ 2 cell log2 shift ] }
T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
T{ ##load-reference f 0 { t f t } }
T{ ##set-slot f 0 0 1 $[ array tag-number ] 2 }
T{ ##set-slot f 0 0 1 }
} compile-test-bb
dup first eq?
] unit-test

4
basis/cpu/architecture/architecture.factor
View File

@ -153,9 +153,9 @@ HOOK: %return cpu ( -- )
HOOK: %dispatch cpu ( src temp -- )
HOOK: %slot cpu ( dst obj slot tag temp -- )
HOOK: %slot cpu ( dst obj slot -- )
HOOK: %slot-imm cpu ( dst obj slot tag -- )
HOOK: %set-slot cpu ( src obj slot tag temp -- )
HOOK: %set-slot cpu ( src obj slot -- )
HOOK: %set-slot-imm cpu ( src obj slot tag -- )
HOOK: %string-nth cpu ( dst obj index temp -- )

8
basis/cpu/ppc/ppc.factor
View File

@ -139,16 +139,12 @@ M:: ppc %dispatch ( src temp -- )
temp MTCTR
BCTR ;
:: (%slot) ( obj slot tag temp -- reg offset )
temp slot obj ADD
temp tag neg ; inline
: (%slot-imm) ( obj slot tag -- reg offset )
[ cells ] dip - ; inline
M: ppc %slot ( dst obj slot tag temp -- ) (%slot) LWZ ;
M: ppc %slot ( dst obj slot -- ) swapd LWZX ;
M: ppc %slot-imm ( dst obj slot tag -- ) (%slot-imm) LWZ ;
M: ppc %set-slot ( src obj slot tag temp -- ) (%slot) STW ;
M: ppc %set-slot ( src obj slot -- ) swapd STWX ;
M: ppc %set-slot-imm ( src obj slot tag -- ) (%slot-imm) STW ;
M:: ppc %string-nth ( dst src index temp -- )

8
basis/cpu/x86/x86.factor
View File

@ -94,16 +94,12 @@ M: x86 %return ( -- ) 0 RET ;
: align-code ( n -- )
0 <repetition> % ;
:: (%slot) ( obj slot tag temp -- op )
temp slot obj [+] LEA
temp tag neg [+] ; inline
:: (%slot-imm) ( obj slot tag -- op )
obj slot cells tag - [+] ; inline
M: x86 %slot ( dst obj slot tag temp -- ) (%slot) MOV ;
M: x86 %slot ( dst obj slot -- ) [+] MOV ;
M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ;
M: x86 %set-slot ( src obj slot tag temp -- ) (%slot) swap MOV ;
M: x86 %set-slot ( src obj slot -- ) [+] swap MOV ;
M: x86 %set-slot-imm ( src obj slot tag -- ) (%slot-imm) swap MOV ;
M: x86 %add 2over eq? [ nip ADD ] [ [+] LEA ] if ;