From 7d0f18ef9e07fbac110b5c58f650ff2fae20eef6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 14 Jun 2005 23:10:48 +0000 Subject: [PATCH] single float parameters in powerpc ffi are working --- TODO.FACTOR.txt | 1 + doc/handbook.tex | 13 +++++++++++++ library/alien/compiler.factor | 27 ++++++++++++++++++++------- library/compiler/ppc/alien.factor | 21 ++++++++++++++------- library/compiler/vops.factor | 2 +- library/test/crashes.factor | 12 ++++++++++++ native/float.c | 16 ++++++++++++++-- 7 files changed, 75 insertions(+), 17 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 5f6f3e5cce..1e861ded9a 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -6,6 +6,7 @@ http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup +- there is a problem with hashcodes of words and bootstrapping if write returns -1 and errno == EINTR then it's not a real error, you can try again - http keep alive, and range get - sleep word diff --git a/doc/handbook.tex b/doc/handbook.tex index dd0b7ccd77..aaf2cfa18c 100644 --- a/doc/handbook.tex +++ b/doc/handbook.tex @@ -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{ diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 71604e7673..ea41fad274 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -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" = [ diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor index ad0c8cabdd..f3dd15c020 100644 --- a/library/compiler/ppc/alien.factor +++ b/library/compiler/ppc/alien.factor @@ -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 ; diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor index ebf90fde57..5e14359be4 100644 --- a/library/compiler/vops.factor +++ b/library/compiler/vops.factor @@ -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 ; diff --git a/library/test/crashes.factor b/library/test/crashes.factor index 894cf0affe..37a978ae79 100644 --- a/library/test/crashes.factor +++ b/library/test/crashes.factor @@ -29,3 +29,15 @@ prettyprint sequences strings test vectors words ; full-gc full-gc ] unit-test + +! Out of memory handling +1000000 drop +1000000 drop +1000000 drop +1000000 drop +1000000 drop +1000000 drop +1000000 drop +1000000 drop +1000000 drop +1000000 drop diff --git a/native/float.c b/native/float.c index 2c11461e47..2c5f5237b1 100644 --- a/native/float.c +++ b/native/float.c @@ -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)