<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
\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{
: 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
#! 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" = [
! 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
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 ;
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 ;
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
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)