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

Conflicts:

	basis/cpu/x86/x86.factor

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
+: ^^neg ( src -- dst )
-: ^^allot-tuple ( n -- dst ) 2 + cells tuple ^^allot ; inline
+    [ 0 ^^load-literal ] dip ^^sub ;
-: ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline
+
-: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
+: ^^allot-tuple ( n -- dst )
-: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline
+    2 + cells tuple ^^allot ;
-: ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline
+
-: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
+: ^^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 ;

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
+use: obj/int-rep slot/int-rep ;
-literal: tag
-temp: temp/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
+use: src/int-rep obj/int-rep slot/int-rep ;
-literal: tag
-temp: temp/int-rep ;
 
 INSN: ##set-slot-imm
 use: src/int-rep obj/int-rep

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 ;

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*
+    [ 2inputs ] [ first value-tag ] bi*
-    ^^slot ;
+    ^^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*
+    [ 3inputs ] [ second value-tag ] bi*
-    pick [ next-vreg ##set-slot ] dip ;
+    ^^tag-offset>slot over [ ##set-slot ] dip ;
 
 : (emit-set-slot-imm) ( infos -- obj-reg )
     ds-drop

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

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 -- )

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 -- )

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 ;