diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 1b99b5d4dd..36fa631050 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -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 ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 8f0a5d5402..6f5a05c672 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/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor index f9f3488773..ce005e8353 100644 --- a/basis/compiler/cfg/intrinsics/misc/misc.factor +++ b/basis/compiler/cfg/intrinsics/misc/misc.factor @@ -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 ; diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index 5ae51a28e2..07202ae60b 100644 --- a/basis/compiler/cfg/intrinsics/slots/slots.factor +++ b/basis/compiler/cfg/intrinsics/slots/slots.factor @@ -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 diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor index 76d7e6de42..5df04a4d9d 100644 --- a/basis/compiler/tests/low-level-ir.factor +++ b/basis/compiler/tests/low-level-ir.factor @@ -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 diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index eb3c432101..c27aacb875 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -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 -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index bcd52206a0..64df207975 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -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 -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index d6bf8feaa1..d89e360d09 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -94,16 +94,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 ;