]> gitweb.factorcode.org Git - factor.git/commitdiff
single float parameters in powerpc ffi are working
authorSlava Pestov <slava@factorcode.org>
Tue, 14 Jun 2005 23:10:48 +0000 (23:10 +0000)
committerSlava Pestov <slava@factorcode.org>
Tue, 14 Jun 2005 23:10:48 +0000 (23:10 +0000)
TODO.FACTOR.txt
doc/handbook.tex
library/alien/compiler.factor
library/compiler/ppc/alien.factor
library/compiler/vops.factor
library/test/crashes.factor
native/float.c

index 5f6f3e5cceb3682080966696670379789c3ac380..1e861ded9a3185edd2be135321b8543b5ea8386c 100644 (file)
@@ -6,6 +6,7 @@
 <magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html\r
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
 \r
+- there is a problem with hashcodes of words and bootstrapping\r
 <erg> if write returns -1  and errno == EINTR then it's not a real error, you can try again\r
 - http keep alive, and range get\r
 - sleep word\r
index dd0b7ccd773b6c66a6dfd34169ba09854e80c132..aaf2cfa18c7ee7ae4e97a83e69e83231652c72fa 100644 (file)
@@ -3388,6 +3388,19 @@ Computes the absolute value and argument individually.
 
 \section{Algebraic and transcedential functions}\label{algebraic}
 
+There is a pair of words for computing additive and multiplicative inverses.
+
+\wordtable{
+\vocabulary{math}
+\ordinaryword{neg}{neg ( x -- -x )}
+\ordinaryword{recip}{recip ( x -- -x )}
+}
+These words are defined in the obvious way:
+\begin{verbatim}
+: neg 0 swap - ;
+: recip 1 swap / ;
+\end{verbatim}
+
 The library includes the standard set of words for rounding real numbers to integers.
 
 \wordtable{
index 71604e7673d4925aae93578ccd126a8d6e017c6f..ea41fad2740001de2b918efd7d61046c2658d744 100644 (file)
@@ -82,11 +82,25 @@ C: alien-node make-node ;
 : stack-space ( parameters -- n )
     0 swap [ c-size cell align + ] each ;
 
-: unbox-parameter ( n parameter -- )
-    c-type [ "unboxer" get "reg-class" get ] bind %unbox ;
+: unbox-parameter ( n parameter -- node )
+    c-type [ "unboxer" get "reg-class" get ] bind %unbox ;
 
-: load-parameter ( n parameter -- )
-    c-type "reg-class" swap hash %parameter , ;
+: unbox-parameters ( len params -- )
+    [ >r 1 - dup r> unbox-parameter ] map nip % ;
+
+: load-parameter ( n parameter -- node )
+    c-type "reg-class" swap hash
+    [ class dup get dup 1 + rot set ] keep
+    %parameter ;
+
+: load-parameters ( params -- )
+    [
+        0 int-regs set
+        0 float-regs set
+        0 double-regs set
+        reverse 0 swap
+        [ dupd load-parameter >r 1 + r> ] map nip
+    ] with-scope % ;
 
 : linearize-parameters ( parameters -- )
     #! Generate code for boxing a list of C types, then generate
@@ -94,9 +108,8 @@ C: alien-node make-node ;
     #! architectures where parameters are passed in registers
     #! (PowerPC).
     dup stack-space %parameters ,
-    [ length ] keep 2dup
-    [ >r 1 - dup r> unbox-parameter ] each drop
-    [ >r 1 - dup r> load-parameter ] each drop ;
+    [ length ] keep tuck
+    unbox-parameters load-parameters ;
 
 : linearize-return ( return -- )
     alien-node-return dup "void" = [
index ad0c8cabdd534fdf177adfb937e13a9997cbfb1a..f3dd15c020d91b4bc204a7fee94b91c860fe8ede 100644 (file)
@@ -1,29 +1,33 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: assembler
-USING: alien compiler compiler-backend inference kernel
-kernel-internals lists math memory namespaces words ;
+IN: compiler-backend
+USING: alien assembler kernel math ;
 
 M: %alien-invoke generate-node ( vop -- )
     dup vop-in-1 swap vop-in-2 load-library compile-c-call ;
 
-: stack-size 8 + 16 align ;
+: stack-reserve 8 + 16 align ;
 : stack@ 3 + cell * ;
 
 M: %parameters generate-node ( vop -- )
-    vop-in-1 dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte ;
+    vop-in-1 dup 0 =
+    [ drop ] [ stack-reserve 1 1 rot SUBI ] ifte ;
 
 GENERIC: store-insn
+GENERIC: load-insn
 GENERIC: return-reg
 
 M: int-regs store-insn drop STW ;
 M: int-regs return-reg drop 3 ;
+M: int-regs load-insn drop 3 + 1 rot LWZ ;
 
 M: float-regs store-insn drop STFS ;
 M: float-regs return-reg drop 1 ;
+M: float-regs load-insn drop 1 + 1 rot LFS ;
 
 M: double-regs store-insn drop STFD ;
 M: double-regs return-reg drop 1 ;
+M: double-regs load-insn drop 1 + 1 rot LFD ;
 
 M: %unbox generate-node ( vop -- )
     [ vop-in-2 f compile-c-call ] keep
@@ -32,10 +36,13 @@ M: %unbox generate-node ( vop -- )
     vop-in-3 store-insn ; 
 
 M: %parameter generate-node ( vop -- )
-    vop-in-1 dup 3 + 1 rot stack@ LWZ ;
+    dup vop-in-1 stack@
+    over vop-in-2
+    rot vop-in-3 load-insn ;
 
 M: %box generate-node ( vop -- )
     vop-in-1 f compile-c-call ;
 
 M: %cleanup generate-node ( vop -- )
-    vop-in-1 dup 0 = [ drop ] [ stack-size 1 1 rot ADDI ] ifte ;
+    vop-in-1 dup 0 =
+    [ drop ] [ stack-reserve 1 1 rot ADDI ] ifte ;
index ebf90fde5767c100a2f4791f30067bdf019c3f9e..5e14359be4d4013616f5a07c667dddf6ba5f6ff6 100644 (file)
@@ -340,7 +340,7 @@ C: %parameters make-vop ;
 
 TUPLE: %parameter ;
 C: %parameter make-vop ;
-: %parameter ( n reg-class -- vop ) 2-in-vop <%parameter> ;
+: %parameter ( n reg reg-class -- vop ) 3-in-vop <%parameter> ;
 
 TUPLE: %cleanup ;
 C: %cleanup make-vop ;
index 894cf0affefc2d349c787e7948853994b6a2e97f..37a978ae792d3dfdce31431dcaa57e7826a93c71 100644 (file)
@@ -29,3 +29,15 @@ prettyprint sequences strings test vectors words ;
     full-gc
     full-gc
 ] unit-test
+
+! Out of memory handling
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
+1000000 <vector> drop
index 2c11461e47808290c7c990dd29f16a0b788a2d66..2c5f5237b1aca5c2b07a9fa0438c3d5563f56bce 100644 (file)
@@ -10,9 +10,21 @@ double d_test(void)
        return 1.0;
 }
 
-float in_f_test(float x, float y)
+float in_f_test(float x, float y, float z)
 {
-       return x + y;
+       return (x + y) * z;
+}
+
+float in_i_test(int x, int y, int z)
+{
+       return x + y + z;
+}
+
+void in_if_test(float x, int y, float z)
+{
+       printf("%f\n",x);
+       printf("%d\n",y);
+       printf("%f\n",z);
 }
 
 double to_float(CELL tagged)