single float parameters in powerpc ffi are working
parent
69334b2043
commit
7d0f18ef9e
|
@ -6,6 +6,7 @@
|
||||||
<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html
|
<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html
|
||||||
<magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
|
<magnus--> 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
|
||||||
<erg> if write returns -1 and errno == EINTR then it's not a real error, you can try again
|
<erg> if write returns -1 and errno == EINTR then it's not a real error, you can try again
|
||||||
- http keep alive, and range get
|
- http keep alive, and range get
|
||||||
- sleep word
|
- sleep word
|
||||||
|
|
|
@ -3388,6 +3388,19 @@ Computes the absolute value and argument individually.
|
||||||
|
|
||||||
\section{Algebraic and transcedential functions}\label{algebraic}
|
\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.
|
The library includes the standard set of words for rounding real numbers to integers.
|
||||||
|
|
||||||
\wordtable{
|
\wordtable{
|
||||||
|
|
|
@ -82,11 +82,25 @@ C: alien-node make-node ;
|
||||||
: stack-space ( parameters -- n )
|
: stack-space ( parameters -- n )
|
||||||
0 swap [ c-size cell align + ] each ;
|
0 swap [ c-size cell align + ] each ;
|
||||||
|
|
||||||
: unbox-parameter ( n parameter -- )
|
: unbox-parameter ( n parameter -- node )
|
||||||
c-type [ "unboxer" get "reg-class" get ] bind %unbox , ;
|
c-type [ "unboxer" get "reg-class" get ] bind %unbox ;
|
||||||
|
|
||||||
: load-parameter ( n parameter -- )
|
: unbox-parameters ( len params -- )
|
||||||
c-type "reg-class" swap hash %parameter , ;
|
[ >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 -- )
|
: linearize-parameters ( parameters -- )
|
||||||
#! Generate code for boxing a list of C types, then generate
|
#! 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
|
#! architectures where parameters are passed in registers
|
||||||
#! (PowerPC).
|
#! (PowerPC).
|
||||||
dup stack-space %parameters ,
|
dup stack-space %parameters ,
|
||||||
[ length ] keep 2dup
|
[ length ] keep tuck
|
||||||
[ >r 1 - dup r> unbox-parameter ] each drop
|
unbox-parameters load-parameters ;
|
||||||
[ >r 1 - dup r> load-parameter ] each drop ;
|
|
||||||
|
|
||||||
: linearize-return ( return -- )
|
: linearize-return ( return -- )
|
||||||
alien-node-return dup "void" = [
|
alien-node-return dup "void" = [
|
||||||
|
|
|
@ -1,29 +1,33 @@
|
||||||
! Copyright (C) 2005 Slava Pestov.
|
! Copyright (C) 2005 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: assembler
|
IN: compiler-backend
|
||||||
USING: alien compiler compiler-backend inference kernel
|
USING: alien assembler kernel math ;
|
||||||
kernel-internals lists math memory namespaces words ;
|
|
||||||
|
|
||||||
M: %alien-invoke generate-node ( vop -- )
|
M: %alien-invoke generate-node ( vop -- )
|
||||||
dup vop-in-1 swap vop-in-2 load-library compile-c-call ;
|
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 * ;
|
: stack@ 3 + cell * ;
|
||||||
|
|
||||||
M: %parameters generate-node ( vop -- )
|
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: store-insn
|
||||||
|
GENERIC: load-insn
|
||||||
GENERIC: return-reg
|
GENERIC: return-reg
|
||||||
|
|
||||||
M: int-regs store-insn drop STW ;
|
M: int-regs store-insn drop STW ;
|
||||||
M: int-regs return-reg drop 3 ;
|
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 store-insn drop STFS ;
|
||||||
M: float-regs return-reg drop 1 ;
|
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 store-insn drop STFD ;
|
||||||
M: double-regs return-reg drop 1 ;
|
M: double-regs return-reg drop 1 ;
|
||||||
|
M: double-regs load-insn drop 1 + 1 rot LFD ;
|
||||||
|
|
||||||
M: %unbox generate-node ( vop -- )
|
M: %unbox generate-node ( vop -- )
|
||||||
[ vop-in-2 f compile-c-call ] keep
|
[ vop-in-2 f compile-c-call ] keep
|
||||||
|
@ -32,10 +36,13 @@ M: %unbox generate-node ( vop -- )
|
||||||
vop-in-3 store-insn ;
|
vop-in-3 store-insn ;
|
||||||
|
|
||||||
M: %parameter generate-node ( vop -- )
|
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 -- )
|
M: %box generate-node ( vop -- )
|
||||||
vop-in-1 f compile-c-call ;
|
vop-in-1 f compile-c-call ;
|
||||||
|
|
||||||
M: %cleanup generate-node ( vop -- )
|
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 ;
|
||||||
|
|
|
@ -340,7 +340,7 @@ C: %parameters make-vop ;
|
||||||
|
|
||||||
TUPLE: %parameter ;
|
TUPLE: %parameter ;
|
||||||
C: %parameter make-vop ;
|
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 ;
|
TUPLE: %cleanup ;
|
||||||
C: %cleanup make-vop ;
|
C: %cleanup make-vop ;
|
||||||
|
|
|
@ -29,3 +29,15 @@ prettyprint sequences strings test vectors words ;
|
||||||
full-gc
|
full-gc
|
||||||
full-gc
|
full-gc
|
||||||
] unit-test
|
] 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
|
||||||
|
|
|
@ -10,9 +10,21 @@ double d_test(void)
|
||||||
return 1.0;
|
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)
|
double to_float(CELL tagged)
|
||||||
|
|
Loading…
Reference in New Issue