%arithmetic-type generator

doc/vops.txt

@@ -47,3 +47,11 @@ VOPs:
 		on x86, in the cdecl ABI, the caller must pop input
 		parameters off the C stack. In stdcall, the callee does
 		it, so this node is not used in that case.
+		
+%untag		mask off the low 3 bits of vop-in-1, store result in
+		vop-in-1 (which should equal vop-out-1!)
+
+%untag-fixnum	shift vop-in-1 to the right by 3 bits, store result in
+		vop-in-1 (which should equal vop-out-1!)
+
+

library/compiler/ppc/alien.factor

@@ -4,10 +4,11 @@ IN: assembler
 USING: alien compiler compiler-backend inference kernel
 kernel-internals lists math memory namespaces words ;
 
-: compile-call-far ( addr -- ) 19 LOAD32  19 MTLR  BLRL ;
+: compile-c-call ( symbol dll -- )
+    2dup 1 1 rel-dlsym dlsym  19 LOAD32  19 MTLR  BLRL ;
 
 M: %alien-invoke generate-node ( vop -- )
-    uncons load-library 2dup 1 rel-dlsym dlsym compile-call-far ;
+    vop-in-1 uncons load-library compile-c-call ;
 
 : stack-size 8 + 16 align ;
 : stack@ 3 + cell * ;
@@ -16,14 +17,13 @@ M: %parameters generate-node ( vop -- )
     dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte ;
 
 M: %unbox generate-node ( vop -- )
-    uncons f 2dup 1 rel-dlsym dlsym compile-call-far
-    3 1 rot stack@ STW ;
+    vop-in-1 uncons f compile-c-call 3 1 rot stack@ STW ;
 
 M: %parameter generate-node ( vop -- )
-    dup 3 + 1 rot stack@ LWZ ;
+    vop-in-1 dup 3 + 1 rot stack@ LWZ ;
 
 M: %box generate-node ( vop -- )
-    f 2dup 1 rel-dlsym dlsym compile-call-far ;
+    vop-in-1 f compile-c-call ;
 
 M: %cleanup generate-node ( vop -- )
-    dup 0 = [ drop ] [ stack-size 1 1 rot ADDI ] ifte ;
+    vop-in-1 dup 0 = [ drop ] [ stack-size 1 1 rot ADDI ] ifte ;

library/compiler/ppc/assembler.factor

@@ -129,6 +129,12 @@ USING: compiler errors kernel math memory words ;
 : XOR 0 (XOR) ;
 : XOR. 1 (XOR) ;
 
+: CMPI d-form 11 insn ;
+: CMPLI d-form 10 insn ;
+
+: CMP 0 0 x-form 31 insn ;
+: CMPL 32 0 x-form 31 insn ;
+
 : (RLWINM) m-form 21 insn ;
 : RLWINM 0 (RLWINM) ;
 : RLWINM. 1 (RLWINM) ;
@@ -166,7 +172,6 @@ M: word BC >r 0 BC r> relative-14 ;
 : MTSPR 5 shift 467 xfx-form 31 insn ;
 : MTLR 8 MTSPR ;
 : MTCTR 9 MTSPR ;
-: CMPI d-form 11 insn ;
 
 : LOAD32 >r w>h/h r> tuck LIS dup rot ORI ;
 

library/compiler/ppc/generator.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
 USING: assembler compiler inference kernel kernel-internals
-lists math memory words ;
+lists math memory namespaces words ;
 
 ! PowerPC register assignments
 ! r14 data stack
@@ -79,8 +79,13 @@ M: %untag generate-node ( vop -- )
 M: %untag-fixnum generate-node ( vop -- )
     dest/src tag-bits SRAWI ;
 
+M: %tag-fixnum generate-node ( vop -- )
+    ! todo: formalize scratch register usage
+    3 19 LI
+    dest/src 19 SLW ;
+
 M: %dispatch generate-node ( vop -- )
-    drop
+    0 <vreg> check-src
     2 18 LI
     17 17 18 SLW
     ! The value 24 is a magic number. It is the length of the
@@ -90,3 +95,20 @@ M: %dispatch generate-node ( vop -- )
     17 17 0 LWZ
     17 MTLR
     BLR ;
+
+M: %arithmetic-type generate-node ( vop -- )
+    0 <vreg> check-dest
+    <label> "end" set
+    ! Load top two stack values
+    17 14 -4 LWZ
+    18 14 0 LWZ
+    ! Compute their tags
+    17 17 tag-mask ANDI
+    18 18 tag-mask ANDI
+    ! Are the tags equal?
+    0 17 18 CMPL
+    "end" get BEQ
+    ! No, they are not equal. Call a runtime function to
+    ! coerce the integers to a higher type.
+    "arithmetic_type" f compile-c-call
+    "end" get save-xt ;

library/compiler/vops.factor

@@ -257,9 +257,10 @@ VOP: %untag-fixnum
 M: %untag-fixnum basic-block? drop t ;
 
 : check-dest ( vop reg -- )
-    swap vop-out-1 = [
-        "invalid VOP destination" throw
-    ] unless ;
+    swap vop-out-1 = [ "bad VOP destination" throw ] unless ;
+
+: check-src ( vop reg -- )
+    swap vop-out-1 = [ "bad VOP source" throw ] unless ;
 
 VOP: %getenv
 : %getenv swap src/dest-vop <%getenv> ;

library/compiler/x86/generator.factor

@@ -102,8 +102,8 @@ M: %arithmetic-type generate-node ( vop -- )
     EAX [ ESI -4 ] MOV
     ECX [ ESI ] MOV
     ! Compute their tags
-    EAX BIN: 111 AND
-    ECX BIN: 111 AND
+    EAX tag-mask AND
+    ECX tag-mask AND
     ! Are the tags equal?
     EAX ECX CMP
     "end" get JE