slightly faster type checking

diff --git a/native/arithmetic.c b/native/arithmetic.c
index e491164adb9f2bcbc116a8a521f1a6dbef1a6fde..8d013c2c0e6e7088cc2b9e9a6a3cf72875d516af 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -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)

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 156be116410bf0a573f5fc6b9aa4c661fcf23059..fd2b6f94fd6eff2d0fb67d291db15d9775767798 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -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);

diff --git a/native/complex.c b/native/complex.c
index d19726ceebf82cc6952aad39b1bc9f98f792386b..c62f84ca5c36f0eebedc817b7b4392d05f350ed4 100644 (file)
--- a/native/complex.c
+++ b/native/complex.c
@@ -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));
+       }
 }

diff --git a/native/complex.h b/native/complex.h
index a8f2c28387101190d5316d1b651ba4b1eae3d6e1..5640c4244a377e298bbd93071a56ca1e4abc01eb 100644 (file)
--- a/native/complex.h
+++ b/native/complex.h
@@ -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);

diff --git a/native/ratio.c b/native/ratio.c
index 12abfc9635b12da4cf5649d3dee89b61b34d8e48..005f7ca4f05c90f3828c475b450aacdbfa36d621 100644 (file)
--- a/native/ratio.c
+++ b/native/ratio.c
@@ -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)

diff --git a/native/ratio.h b/native/ratio.h
index 298b1d5893ee6e27fa65b3d69b84d16893a4a2ca..4f83905991098c726b8f430b75fc2b98ef08af67 100644 (file)
--- a/native/ratio.h
+++ b/native/ratio.h
@@ -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);

diff --git a/native/types.c b/native/types.c
index 4c8ab74acc1c2989b66012c4b66528467a22e45f..57a7393c8dd73d3ecfb45e1e763dba229289b159 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -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!

diff --git a/native/types.h b/native/types.h
index 2cec34d58b3813205a96c5401ad664a2c50844fe..2291f6ed7a77dead908a9dec38d0592f727c7888 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -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);