]> gitweb.factorcode.org Git - factor.git/commitdiff
%arithmetic-type generator
authorSlava Pestov <slava@factorcode.org>
Mon, 30 May 2005 07:37:22 +0000 (07:37 +0000)
committerSlava Pestov <slava@factorcode.org>
Mon, 30 May 2005 07:37:22 +0000 (07:37 +0000)
doc/vops.txt
library/compiler/ppc/alien.factor
library/compiler/ppc/assembler.factor
library/compiler/ppc/generator.factor
library/compiler/vops.factor
library/compiler/x86/generator.factor

index 4c466e1c04ee5fc2e7b716dc2ef4dde785b06c18..9aa64a496159d9636275a5928eaf543128a700f9 100644 (file)
@@ -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!)
+
+
index d6edcfd9a753e298d8ef515e3a95e5d6486301a7..e034a753827aa30662badc74f8c3719dd5fcdf15 100644 (file)
@@ -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 ;
index d75c2d9b48aa0bbc857b935400168f113eda69cc..8350d0e877d44b7e38bf4a9a052213493bef3eb2 100644 (file)
@@ -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 ;
 
index 54175be7a99b942df085c8552ed1f755beb18ba7..d68381d9e7164ec09677849180f237cf21653aad 100644 (file)
@@ -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 ;
index fbe14f278cf59e969a33cd3dd71e0b29b6fd64b8..9d161ad7303a1020e156b705e6323bda2c530a3e 100644 (file)
@@ -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> ;
index c69d2e9cdd6e73866b30459597179aa7524f6fc1..97e32fbba3566ac946671429855faef64e544025 100644 (file)
@@ -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