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

Making ##slot and ##set-slot not have a temporary parameter

db4
Daniel Ehrenberg 2009-09-26 00:28:14 -05:00
parent b0f87fd6a0
commit 7bd330cfd5
4 changed files with 30 additions and 24 deletions
basis
compiler/cfg
hats
instructions
intrinsics/slots
cpu/x86

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

@ -46,15 +46,29 @@ 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 ( tag slot -- vreg' )
cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if
swap ^^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

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

@ -10,7 +10,7 @@ IN: compiler.cfg.intrinsics.slots
: (emit-slot) ( infos -- dst )
[ 2inputs ^^offset>slot ] [ first value-tag ] bi*
^^slot ;
^^sub-imm ^^slot ;
: (emit-slot-imm) ( infos -- dst )
ds-drop
@ -29,7 +29,7 @@ IN: compiler.cfg.intrinsics.slots
: (emit-set-slot) ( infos -- obj-reg )
[ 3inputs ^^offset>slot ] [ second value-tag ] bi*
pick [ next-vreg ##set-slot ] dip ;
^^sub-imm over [ ##set-slot ] dip ;
: (emit-set-slot-imm) ( infos -- obj-reg )
ds-drop

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

@ -95,16 +95,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 ;
@ -778,4 +774,4 @@ M: x86 small-enough? ( n -- ? )
enable-sse3-simd ;
enable-min/max
enable-fixnum-log2
enable-fixnum-log2