%type vop on powerpc

diff --git a/doc/vops.txt b/doc/vops.txt
index 9aa64a496159d9636275a5928eaf543128a700f9..c6b0770667f5fc72faea00a05526934b9a00ca21 100644 (file)
--- a/doc/vops.txt
+++ b/doc/vops.txt
@@ -54,4 +54,5 @@ VOPs:
 %untag-fixnum  shift vop-in-1 to the right by 3 bits, store result in
                vop-in-1 (which should equal vop-out-1!)
 
-
+%type          Intrinstic version of type primitive. It outputs an
+               unboxed value in vop-out-1.

diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor
index e034a753827aa30662badc74f8c3719dd5fcdf15..cf187b5086fdf2d4e82d1011e1475dcb09261d83 100644 (file)
--- a/library/compiler/ppc/alien.factor
+++ b/library/compiler/ppc/alien.factor
@@ -4,9 +4,6 @@ IN: assembler
 USING: alien compiler compiler-backend inference kernel
 kernel-internals lists math memory namespaces words ;
 
-: compile-c-call ( symbol dll -- )
-    2dup 1 1 rel-dlsym dlsym  19 LOAD32  19 MTLR  BLRL ;
-
 M: %alien-invoke generate-node ( vop -- )
     vop-in-1 uncons load-library compile-c-call ;
 

diff --git a/library/compiler/ppc/assembler.factor b/library/compiler/ppc/assembler.factor
index 8350d0e877d44b7e38bf4a9a052213493bef3eb2..cebc93e08692a0cb30d851468ce0b9927cdef968 100644 (file)
--- a/library/compiler/ppc/assembler.factor
+++ b/library/compiler/ppc/assembler.factor
@@ -108,6 +108,9 @@ USING: compiler errors kernel math memory words ;
 : ORC 0 (ORC) ;
 : ORC. 1 (ORC) ;
 
+: MR over OR ;
+: MR. over OR. ;
+
 : (SLW) 24 swap x-form 31 insn ;
 : SLW 0 (SLW) ;
 : SLW. 1 (SLW) ;

diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor
index d68381d9e7164ec09677849180f237cf21653aad..a3df52edd23c8f85689e52704142242c132de6ad 100644 (file)
--- a/library/compiler/ppc/generator.factor
+++ b/library/compiler/ppc/generator.factor
@@ -1,14 +1,17 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
-USING: assembler compiler inference kernel kernel-internals
-lists math memory namespaces words ;
+USING: alien assembler compiler inference kernel
+kernel-internals lists math memory namespaces words ;
 
 ! PowerPC register assignments
 ! r14 data stack
 ! r15 call stack
 ! r16-r30 vregs
 
+: compile-c-call ( symbol dll -- )
+    2dup 1 1 rel-dlsym dlsym  19 LOAD32  19 MTLR  BLRL ;
+
 M: integer v>operand tag-bits shift ;
 M: vreg v>operand vreg-n 17 + ;
 
@@ -96,6 +99,30 @@ M: %dispatch generate-node ( vop -- )
     17 MTLR
     BLR ;
 
+M: %type generate-node ( vop -- )
+    0 <vreg> check-src
+    <label> "f" set
+    <label> "end" set
+    ! Get the tag
+    17 18 tag-mask ANDI
+    ! Compare with object tag number (3).
+    0 18 object-tag CMPI
+    ! Jump if the object doesn't store type info in its header
+    "end" get BNE
+    ! It does store type info in its header
+    ! Is the pointer itself equal to 3? Then its F_TYPE (9).
+    0 17 object-tag CMPI
+    "f" get BEQ
+    ! The pointer is not equal to 3. Load the object header.
+    18 17 object-tag neg LWZ
+    18 18 3 SRAWI
+    "end" get B
+    "f" get save-xt
+    ! The pointer is equal to 3. Load F_TYPE (9).
+    f type 18 LI
+    "end" get save-xt
+    18 17 MR ;
+
 M: %arithmetic-type generate-node ( vop -- )
     0 <vreg> check-dest
     <label> "end" set