From 7bd330cfd590679b28f6477322d14e40de8c8d5c Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 26 Sep 2009 00:28:14 -0500 Subject: [PATCH 1/5] Making ##slot and ##set-slot not have a temporary parameter --- basis/compiler/cfg/hats/hats.factor | 32 +++++++++++++------ .../cfg/instructions/instructions.factor | 8 ++--- .../cfg/intrinsics/slots/slots.factor | 4 +-- basis/cpu/x86/x86.factor | 10 ++---- 4 files changed, 30 insertions(+), 24 deletions(-) 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 From 51f2bbd74bd1a4eea3f38572d97f4f4f1a355e21 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 26 Sep 2009 01:39:48 -0500 Subject: [PATCH 2/5] Completing slot and set-slot changes on x86 --- basis/compiler/cfg/hats/hats.factor | 8 +++++--- basis/compiler/cfg/intrinsics/misc/misc.factor | 2 +- basis/compiler/cfg/intrinsics/slots/slots.factor | 8 ++++---- basis/cpu/architecture/architecture.factor | 4 ++-- 4 files changed, 12 insertions(+), 10 deletions(-) diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 5a42ad2c99..36fa631050 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -63,9 +63,11 @@ insn-classes get [ : ^^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 ; +: ^^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 ; 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 93de5188af..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* - ^^sub-imm ^^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* - ^^sub-imm over [ ##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/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index fbec9f697a..6b41613c00 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -102,9 +102,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 -- ) From c704a823e706cae61d8a6af610d3ca801830e35b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 26 Sep 2009 02:48:40 -0500 Subject: [PATCH 3/5] Fixing low-level-ir compiler tests for slot changes --- basis/compiler/tests/low-level-ir.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) 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 From 30bca97b61ef5b28b5c7cabd64dcbca517a41b83 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 26 Sep 2009 02:58:18 -0500 Subject: [PATCH 4/5] An attempt at porting the slot change to PPC --- basis/cpu/ppc/ppc.factor | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index eb9709a350..4ae92e7230 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -142,16 +142,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 -- ) 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 -- ) STWX ; M: ppc %set-slot-imm ( src obj slot tag -- ) (%slot-imm) STW ; M:: ppc %string-nth ( dst src index temp -- ) From 3476f2e28c5e23169a7c6bf79f1fa7006fcd346f Mon Sep 17 00:00:00 2001 From: sheeple Date: Sat, 26 Sep 2009 13:21:42 -0500 Subject: [PATCH 5/5] Fixing PPC backend for ##slot change --- basis/cpu/ppc/ppc.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 5461002dc8..64df207975 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -142,9 +142,9 @@ M:: ppc %dispatch ( src temp -- ) : (%slot-imm) ( obj slot tag -- reg offset ) [ cells ] dip - ; inline -M: ppc %slot ( dst obj slot -- ) LWZX ; +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 -- ) STWX ; +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 -- )