diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 1b99b5d4dd..5a42ad2c99 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -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 ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 7c28198f67..5f46f833ee 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -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 diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index 5ae51a28e2..93de5188af 100644 --- a/basis/compiler/cfg/intrinsics/slots/slots.factor +++ b/basis/compiler/cfg/intrinsics/slots/slots.factor @@ -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 diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index d8e02fe516..fc89e1cfd6 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -95,16 +95,12 @@ M: x86 %return ( -- ) 0 RET ; : align-code ( n -- ) 0 % ; -:: (%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 \ No newline at end of file +enable-fixnum-log2