steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

complex numbers

cvs
Slava Pestov 2004-08-06 00:29:52 +00:00
parent d7eb8e8b2d
commit 2740c77a10
15 changed files with 186 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.FACTOR.txt
View File

@ -1,5 +1,8 @@
+ native:
- printing floats: append .0 always
- vector=
- make-image: take a parameter, include le & be images in dist
- do something about "base" variable -- too fragile
ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ]
- errors: don't show .factor-rc

2
build.sh
View File

@ -1,5 +1,5 @@
export CC=gcc34
export CFLAGS="-pedantic -Wall -Winline -O2 -march=pentium4 -fomit-frame-pointer"
export CFLAGS="-pedantic -Wall -Winline -Os -march=pentium4 -fomit-frame-pointer"
$CC $CFLAGS -o f native/*.c

5
library/cross-compiler.factor
View File

@ -134,6 +134,11 @@ IN: cross-compiler
float?
str>float
unparse-float
complex?
real
imaginary
>rect
rect>
+
-
*

4
library/image.factor
View File

@ -68,7 +68,9 @@ USE: words
: cons-tag BIN: 010 ;
: object-tag BIN: 011 ;
: rational-tag BIN: 100 ;
: header-tag BIN: 101 ;
: complex-tag BIN: 101 ;
: header-tag BIN: 110 ;
: gc-fwd-ptr BIN: 111 ; ( we don't output these )
: immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
: >header ( id -- tagged ) header-tag immediate ;

2
library/platform/jvm/arithmetic.factor
View File

@ -63,7 +63,7 @@ USE: stack
jinvoke-static ; inline
: /mod ( a b -- a/b a%b )
2dup / >fixnum -rot mod ;
2dup /i -rot mod ;
: > ( a b -- boolean )
[ "java.lang.Number" "java.lang.Number" ]

1
library/platform/native/boot.factor
View File

@ -79,6 +79,7 @@ primitives,
"/library/vocabulary-style.factor"
"/library/words.factor"
"/library/math/math-combinators.factor"
"/library/math/list-math.factor"
"/library/math/namespace-math.factor"
"/library/test/test.factor"
"/library/platform/native/arithmetic.factor"

1
library/platform/native/kernel.factor
View File

@ -77,6 +77,7 @@ USE: unparser
[ bignum? ] [ drop "bignum" ]
[ ratio? ] [ drop "ratio" ]
[ float? ] [ drop "float" ]
[ complex? ] [ drop "complex" ]
[ cons? ] [ drop "cons" ]
[ word? ] [ drop "word" ]
[ f = ] [ drop "f" ]

41
native/arithmetic.c
View File

@ -36,24 +36,51 @@ FLOAT* ratio_to_float(CELL tagged)
return (FLOAT*)UNTAG(divfloat(r->numerator,r->denominator));
}
void primitive_numberp(void)
bool realp(CELL tagged)
{
check_non_empty(env.dt);
switch(type_of(env.dt))
switch(type_of(tagged))
{
case FIXNUM_TYPE:
case BIGNUM_TYPE:
case RATIO_TYPE:
case FLOAT_TYPE:
env.dt = T;
return true;
break;
default:
env.dt = F;
return false;
break;
}
}
bool numberp(CELL tagged)
{
return realp(tagged) || type_of(tagged) == COMPLEX_TYPE;
}
void primitive_numberp(void)
{
check_non_empty(env.dt);
env.dt = tag_boolean(numberp(env.dt));
}
bool zerop(CELL tagged)
{
switch(type_of(tagged))
{
case FIXNUM_TYPE:
return tagged == 0;
case BIGNUM_TYPE:
return ((BIGNUM*)UNTAG(tagged))->n == 0;
case FLOAT_TYPE:
return ((FLOAT*)UNTAG(tagged))->n == 0.0;
case RATIO_TYPE:
return false;
default:
critical_error("Bad parameter to zerop",tagged);
return false; /* Can't happen */
}
}
CELL to_integer(CELL tagged)
{
RATIO* r;
@ -67,7 +94,7 @@ CELL to_integer(CELL tagged)
r = (RATIO*)UNTAG(tagged);
return divint(r->numerator,r->denominator);
default:
type_error(FIXNUM_TYPE,tagged);
type_error(INTEGER_TYPE,tagged);
return NULL; /* can't happen */
}
}

111
native/arithmetic.h
View File

@ -35,14 +35,28 @@ CELL OP(CELL x, CELL y) \
return OP##_fixnum(x,y); \
case RATIO_TYPE: \
if(integerOnly) \
return OP(x,to_integer(y)); \
{ \
type_error(FIXNUM_TYPE,y); \
return F; \
} \
else \
return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
case COMPLEX_TYPE: \
if(integerOnly) \
{ \
type_error(FIXNUM_TYPE,y); \
return F; \
} \
else \
return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
case BIGNUM_TYPE: \
return OP##_bignum((CELL)fixnum_to_bignum(x),y); \
case FLOAT_TYPE: \
if(integerOnly) \
return OP(x,to_integer(y)); \
{ \
type_error(FIXNUM_TYPE,y); \
return F; \
} \
else \
return OP##_float((CELL)fixnum_to_float(x),y); \
default: \
@ -54,28 +68,24 @@ CELL OP(CELL x, CELL y) \
} \
\
case RATIO_TYPE: \
\
if(integerOnly) \
{ \
type_error(FIXNUM_TYPE,x); \
return F; \
} \
\
switch(type_of(y)) \
{ \
case FIXNUM_TYPE: \
if(integerOnly) \
return OP(to_integer(x),y); \
else \
return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
case RATIO_TYPE: \
if(integerOnly) \
return OP(to_integer(x),to_integer(y)); \
else \
return OP##_ratio(x,y); \
case COMPLEX_TYPE: \
return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
case BIGNUM_TYPE: \
if(integerOnly) \
return OP(to_integer(x),y); \
else \
return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
case FLOAT_TYPE: \
if(integerOnly) \
return OP(to_integer(x),to_integer(y)); \
else \
return OP##_float((CELL)ratio_to_float(x),y); \
default: \
if(anytype) \
@ -84,6 +94,34 @@ CELL OP(CELL x, CELL y) \
type_error(FIXNUM_TYPE,y); \
return F; \
} \
\
case COMPLEX_TYPE: \
\
if(integerOnly) \
{ \
type_error(FIXNUM_TYPE,x); \
return F; \
} \
\
switch(type_of(y)) \
{ \
case FIXNUM_TYPE: \
return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
case RATIO_TYPE: \
return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
case COMPLEX_TYPE: \
return OP##_complex(x,y); \
case BIGNUM_TYPE: \
return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
case FLOAT_TYPE: \
return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
default: \
if(anytype) \
return OP##_anytype(x,y); \
else \
type_error(FIXNUM_TYPE,y); \
return F; \
} \
\
case BIGNUM_TYPE: \
\
@ -93,14 +131,28 @@ CELL OP(CELL x, CELL y) \
return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
case RATIO_TYPE: \
if(integerOnly) \
return OP(x,to_integer(y)); \
{ \
type_error(BIGNUM_TYPE,y); \
return F; \
} \
else \
return OP##_ratio((CELL)bignum_to_ratio(x),y); \
case COMPLEX_TYPE: \
if(integerOnly) \
{ \
type_error(BIGNUM_TYPE,y); \
return F; \
} \
else \
return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
case BIGNUM_TYPE: \
return OP##_bignum(x,y); \
case FLOAT_TYPE: \
if(integerOnly) \
return OP(x,to_integer(y)); \
{ \
type_error(BIGNUM_TYPE,y); \
return F; \
} \
else \
return OP##_float((CELL)bignum_to_float(x),y); \
default: \
@ -112,33 +164,26 @@ CELL OP(CELL x, CELL y) \
} \
\
case FLOAT_TYPE: \
\
if(integerOnly) \
{ \
type_error(FIXNUM_TYPE,x); \
return F; \
} \
\
switch(type_of(y)) \
{ \
case FIXNUM_TYPE: \
if(integerOnly) \
return OP(to_integer(x),y); \
else \
return OP##_float(x,(CELL)fixnum_to_float(y)); \
case RATIO_TYPE: \
if(integerOnly) \
return OP(x,to_integer(y)); \
else \
return OP##_float(x,(CELL)ratio_to_float(y)); \
case COMPLEX_TYPE: \
return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
case BIGNUM_TYPE: \
if(integerOnly) \
return OP(to_integer(x),y); \
else \
return OP##_float(x,(CELL)bignum_to_float(y)); \
case FLOAT_TYPE: \
if(integerOnly) \
return OP(to_integer(x),to_integer(y)); \
else \
return OP##_float(x,y); \
default: \
if(anytype) \
return OP##_anytype(x,y); \
else \
type_error(FLOAT_TYPE,y); \
return F; \
} \
@ -159,8 +204,12 @@ void primitive_##OP(void) \
env.dt = OP(x,y); \
}
bool realp(CELL tagged);
bool numberp(CELL tagged);
void primitive_numberp(void);
bool zerop(CELL tagged);
FIXNUM to_fixnum(CELL tagged);
void primitive_to_fixnum(void);
BIGNUM* to_bignum(CELL tagged);

1
native/factor.h
View File

@ -47,6 +47,7 @@ typedef unsigned char BYTE;
#include "bignum.h"
#include "ratio.h"
#include "float.h"
#include "complex.h"
#include "arithmetic.h"
#include "misc.h"
#include "string.h"

5
native/primitives.c
View File

@ -48,6 +48,11 @@ XT primitives[] = {
primitive_floatp,
primitive_str_to_float,
primitive_float_to_str,
primitive_complexp,
primitive_real,
primitive_imaginary,
primitive_to_rect,
primitive_from_rect,
primitive_add,
primitive_subtract,
primitive_multiply,

2
native/primitives.h
View File

@ -1,4 +1,4 @@
extern XT primitives[];
#define PRIMITIVE_COUNT 107
#define PRIMITIVE_COUNT 112
CELL primitive_to_xt(CELL primitive);

6
native/ratio.c
View File

@ -2,7 +2,7 @@
RATIO* ratio(CELL numerator, CELL denominator)
{
RATIO* ratio = (RATIO*)allot(sizeof(RATIO));
RATIO* ratio = allot(sizeof(RATIO));
ratio->numerator = numerator;
ratio->denominator = denominator;
return ratio;
@ -26,7 +26,7 @@ void primitive_numerator(void)
env.dt = untag_ratio(env.dt)->numerator;
break;
default:
type_error(RATIO_TYPE,env.dt);
type_error(RATIONAL_TYPE,env.dt);
break;
}
}
@ -43,7 +43,7 @@ void primitive_denominator(void)
env.dt = untag_ratio(env.dt)->denominator;
break;
default:
type_error(RATIO_TYPE,env.dt);
type_error(RATIONAL_TYPE,env.dt);
break;
}
}

22
native/types.c
View File

@ -60,20 +60,32 @@ void* allot_object(CELL type, CELL length)
CELL object_size(CELL pointer)
{
CELL size;
switch(TAG(pointer))
{
case CONS_TYPE:
return align8(sizeof(CONS));
size = sizeof(CONS);
break;
case WORD_TYPE:
return align8(sizeof(WORD));
size = sizeof(WORD);
break;
case RATIO_TYPE:
return align8(sizeof(RATIO));
size = sizeof(RATIO);
break;
case COMPLEX_TYPE:
size = sizeof(COMPLEX);
break;
case OBJECT_TYPE:
return untagged_object_size(UNTAG(pointer));
size = untagged_object_size(UNTAG(pointer));
break;
default:
critical_error("Cannot determine size",pointer);
return -1;
size = 0; /* Can't happen */
break;
}
return align8(size);
}
CELL untagged_object_size(CELL pointer)

10
native/types.h
View File

@ -10,8 +10,9 @@
#define CONS_TYPE 2
#define OBJECT_TYPE 3
#define RATIO_TYPE 4
#define HEADER_TYPE 5
#define GC_COLLECTED 6 /* See gc.c */
#define COMPLEX_TYPE 5
#define HEADER_TYPE 6
#define GC_COLLECTED 7 /* See gc.c */
/*** Header types ***/
@ -35,6 +36,11 @@ CELL empty;
#define BIGNUM_TYPE 14
#define FLOAT_TYPE 15
/* Pseudo-types. For error reporting only. */
#define INTEGER_TYPE 100 /* FIXNUM or BIGNUM */
#define RATIONAL_TYPE 101 /* INTEGER or RATIO */
#define REAL_TYPE 102 /* RATIONAL or FLOAT */
bool typep(CELL type, CELL tagged);
CELL type_of(CELL tagged);
void type_check(CELL type, CELL tagged);