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

slightly faster type checking

cvs
Slava Pestov 2004-09-19 04:57:33 +00:00
parent 436c2f85f5
commit bf023df887
8 changed files with 52 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
native/arithmetic.c
View File

@ -31,28 +31,37 @@ CELL to_cell(CELL x)
}
}
CELL upgraded_arithmetic_type(CELL type1, CELL type2)
void primitive_arithmetic_type(void)
{
CELL type2 = type_of(dpop());
CELL type1 = type_of(dpop());
CELL type;
switch(type1)
{
case FIXNUM_TYPE:
return type2;
type = type2;
break;
case BIGNUM_TYPE:
switch(type2)
{
case FIXNUM_TYPE:
return type1;
type = type1;
break;
default:
return type2;
type = type2;
break;
}
case RATIO_TYPE:
switch(type2)
{
case FIXNUM_TYPE:
case BIGNUM_TYPE:
return type1;
type = type1;
break;
default:
return type2;
type = type2;
break;
}
case FLOAT_TYPE:
switch(type2)
@ -60,9 +69,11 @@ CELL upgraded_arithmetic_type(CELL type1, CELL type2)
case FIXNUM_TYPE:
case BIGNUM_TYPE:
case RATIO_TYPE:
return type1;
type = type1;
break;
default:
return type2;
type = type2;
break;
}
case COMPLEX_TYPE:
switch(type2)
@ -71,20 +82,17 @@ CELL upgraded_arithmetic_type(CELL type1, CELL type2)
case BIGNUM_TYPE:
case RATIO_TYPE:
case FLOAT_TYPE:
return type1;
type = type1;
break;
default:
return type2;
type = type2;
break;
}
default:
return type1;
type = type1;
break;
}
}
void primitive_arithmetic_type(void)
{
CELL type2 = type_of(dpop());
CELL type1 = type_of(dpop());
dpush(tag_fixnum(upgraded_arithmetic_type(type1,type2)));
dpush(tag_fixnum(type));
}
bool realp(CELL tagged)

1
native/arithmetic.h
View File

@ -1,6 +1,5 @@
#include "factor.h"
CELL upgraded_arithmetic_type(CELL type1, CELL type2);
void primitive_arithmetic_type(void);
CELL tag_integer(FIXNUM x);

26
native/complex.c
View File

@ -1,21 +1,5 @@
#include "factor.h"
COMPLEX* complex(CELL real, CELL imaginary)
{
COMPLEX* complex = allot(sizeof(COMPLEX));
complex->real = real;
complex->imaginary = imaginary;
return complex;
}
CELL possibly_complex(CELL real, CELL imaginary)
{
if(zerop(imaginary))
return real;
else
return tag_complex(complex(real,imaginary));
}
void primitive_real(void)
{
switch(type_of(dpeek()))
@ -87,5 +71,13 @@ void primitive_from_rect(void)
if(!realp(real))
type_error(REAL_TYPE,real);
dpush(possibly_complex(real,imaginary));
if(zerop(imaginary))
dpush(real);
else
{
COMPLEX* complex = allot(sizeof(COMPLEX));
complex->real = real;
complex->imaginary = imaginary;
dpush(tag_complex(complex));
}
}

14
native/complex.h
View File

@ -14,21 +14,7 @@ INLINE CELL tag_complex(COMPLEX* complex)
return RETAG(complex,COMPLEX_TYPE);
}
COMPLEX* complex(CELL real, CELL imaginary);
COMPLEX* to_complex(CELL x);
CELL possibly_complex(CELL real, CELL imaginary);
void primitive_real(void);
void primitive_imaginary(void);
void primitive_to_rect(void);
void primitive_from_rect(void);
CELL number_eq_complex(COMPLEX* x, COMPLEX* y);
CELL add_complex(COMPLEX* x, COMPLEX* y);
CELL subtract_complex(COMPLEX* x, COMPLEX* y);
CELL multiply_complex(COMPLEX* x, COMPLEX* y);
CELL divide_complex(COMPLEX* x, COMPLEX* y);
CELL divfloat_complex(COMPLEX* x, COMPLEX* y);
CELL less_complex(COMPLEX* x, COMPLEX* y);
CELL lesseq_complex(COMPLEX* x, COMPLEX* y);
CELL greater_complex(COMPLEX* x, COMPLEX* y);
CELL greatereq_complex(COMPLEX* x, COMPLEX* y);

15
native/ratio.c
View File

@ -1,13 +1,5 @@
#include "factor.h"
RATIO* ratio(CELL numerator, CELL denominator)
{
RATIO* ratio = allot(sizeof(RATIO));
ratio->numerator = numerator;
ratio->denominator = denominator;
return ratio;
}
/* Does not reduce to lowest terms, so should only be used by math
library implementation, to avoid breaking invariants. */
void primitive_from_fraction(void)
@ -19,7 +11,12 @@ void primitive_from_fraction(void)
if(onep(denominator))
dpush(numerator);
else
dpush(tag_ratio(ratio(numerator,denominator)));
{
RATIO* ratio = allot(sizeof(RATIO));
ratio->numerator = numerator;
ratio->denominator = denominator;
dpush(tag_ratio(ratio));
}
}
void primitive_to_fraction(void)

13
native/ratio.h
View File

@ -14,20 +14,7 @@ INLINE CELL tag_ratio(RATIO* ratio)
return RETAG(ratio,RATIO_TYPE);
}
RATIO* ratio(CELL numerator, CELL denominator);
RATIO* to_ratio(CELL x);
void primitive_numerator(void);
void primitive_denominator(void);
void primitive_from_fraction(void);
void primitive_to_fraction(void);
CELL number_eq_ratio(RATIO* x, RATIO* y);
CELL add_ratio(RATIO* x, RATIO* y);
CELL subtract_ratio(RATIO* x, RATIO* y);
CELL multiply_ratio(RATIO* x, RATIO* y);
CELL divide_ratio(RATIO* x, RATIO* y);
CELL divfloat_ratio(RATIO* x, RATIO* y);
CELL less_ratio(RATIO* x, RATIO* y);
CELL lesseq_ratio(RATIO* x, RATIO* y);
CELL greater_ratio(RATIO* x, RATIO* y);
CELL greatereq_ratio(RATIO* x, RATIO* y);

6
native/types.c
View File

@ -19,12 +19,6 @@ bool typep(CELL type, CELL tagged)
return type_of(tagged) == type;
}
void type_check(CELL type, CELL tagged)
{
if(type_of(tagged) != type)
type_error(type,tagged);
}
/*
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!

12
native/types.h
View File

@ -42,7 +42,6 @@ CELL T;
CELL type_of(CELL tagged);
bool typep(CELL type, CELL tagged);
void type_check(CELL type, CELL tagged);
INLINE CELL tag_boolean(CELL untagged)
{
@ -79,6 +78,17 @@ INLINE CELL object_type(CELL tagged)
return untag_header(get(UNTAG(tagged)));
}
INLINE void type_check(CELL type, CELL tagged)
{
if(type < HEADER_TYPE)
{
if(TAG(tagged) != type)
type_error(type,tagged);
}
else if(object_type(tagged) != type)
type_error(type,tagged);
}
void* allot_object(CELL type, CELL length);
CELL untagged_object_size(CELL pointer);
CELL object_size(CELL pointer);