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

Conflicts:

	basis/cpu/x86/x86.factor

diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor
index 1b99b5d4dd185144c19a03660a7abc182b7928da..36fa631050d234965b5de7d032314005606c79d9 100644 (file)
--- 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
-
-: ^^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
+    [ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
+
+: ^^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 8f0a5d5402f7d5c3b03b5997d41781247db69323..6f5a05c672f298f15fd2bac0749283d111477346 100644 (file)
--- 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 f9f34887736f3c222937dba1ec3482369df93d60..ce005e8353650e5f6461b4d4188b8fef7be11f8c 100644 (file)
--- 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 5ae51a28e28853af48d641de66e0c4fd76636578..07202ae60b53465694d96944a2b382451e551aac 100644 (file)
--- 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 76d7e6de420df90d570bf3bd5051817add7ffd1d..5df04a4d9d2bcafb8872c3a063b6dc39646deeab 100644 (file)
--- 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 eb3c43210183a3243bf9f6ddf0707e18bd1170f3..c27aacb875ae7d622699ce544fd365b1b914af22 100644 (file)
--- 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 bcd52206a0caeebab86cdea25e96fa91b5e60db1..5461002dc86a3465a371fd2384010714d6990989 100644 (file)
--- 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 -- ) 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 -- )

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index d6bf8feaa1b38b3a1453347fe4ff3cafe70be4a1..d89e360d09a32ebe8897b0b2936fcb32200e2a27 100644 (file)
--- 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 <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 ;