nicer multiply_fixnum; thanks The_Vulture

diff --git a/native/complex.c b/native/complex.c
index e9f201be40e1dc9fe9b4620c148bdda7d2618f2e..3c0a417f831612e9cf6e6bdca740f4cffb459264 100644 (file)
--- a/native/complex.c
+++ b/native/complex.c
@@ -170,7 +170,7 @@ CELL divfloat_complex(COMPLEX* x, COMPLEX* y)
 }
 
 #define INCOMPARABLE(x,y) general_error(ERROR_INCOMPARABLE, \
-       tag_cons(cons(RETAG(x,COMPLEX_TYPE),RETAG(y,COMPLEX_TYPE))));
+       cons(RETAG(x,COMPLEX_TYPE),RETAG(y,COMPLEX_TYPE)));
 
 CELL less_complex(COMPLEX* x, COMPLEX* y)
 {

diff --git a/native/cons.c b/native/cons.c
index 0a4151737e52b2fd0c9e01ef8738fcc0ec8b272c..13dd058fb469a022e2753319234adf6e39f1e8d6 100644 (file)
--- a/native/cons.c
+++ b/native/cons.c
@@ -1,11 +1,11 @@
 #include "factor.h"
 
-CONS* cons(CELL car, CELL cdr)
+CELL cons(CELL car, CELL cdr)
 {
        CONS* cons = allot(sizeof(CONS));
        cons->car = car;
        cons->cdr = cdr;
-       return cons;
+       return tag_cons(cons);
 }
 
 void primitive_consp(void)
@@ -17,7 +17,7 @@ void primitive_cons(void)
 {
        CELL cdr = dpop();
        CELL car = dpop();
-       dpush(tag_cons(cons(car,cdr)));
+       dpush(cons(car,cdr));
 }
 
 void primitive_car(void)

diff --git a/native/cons.h b/native/cons.h
index d8cad030134451b237e9c50f42922a4929e05bea..3cb1999df8729fef39b4bd7116069087f47144f7 100644 (file)
--- a/native/cons.h
+++ b/native/cons.h
@@ -14,7 +14,7 @@ INLINE CELL tag_cons(CONS* cons)
        return RETAG(cons,CONS_TYPE);
 }
 
-CONS* cons(CELL car, CELL cdr);
+CELL cons(CELL car, CELL cdr);
 
 INLINE CELL car(CELL cons)
 {

diff --git a/native/error.c b/native/error.c
index 1aeb8a36c810ea7d1eff47cdb8064480c70c716c..0df4f2cf2dbc67efb70ded6a579c32384b4c2072 100644 (file)
--- a/native/error.c
+++ b/native/error.c
@@ -37,7 +37,7 @@ void throw_error(CELL error)
 
 void general_error(CELL error, CELL tagged)
 {
-       CONS* c = cons(error,tag_cons(cons(tagged,F)));
+       CELL c = cons(error,tag_cons(cons(tagged,F)));
        if(userenv[BREAK_ENV] == 0)
        {
                /* Crash at startup */
@@ -52,18 +52,17 @@ void general_error(CELL error, CELL tagged)
                }
                exit(1);
        }
-       throw_error(tag_cons(c));
+       throw_error(c);
 }
 
 void type_error(CELL type, CELL tagged)
 {
-       CONS* c = cons(tag_fixnum(type),tag_cons(cons(tagged,F)));
-       general_error(ERROR_TYPE,tag_cons(c));
+       CELL c = cons(tag_fixnum(type),tag_cons(cons(tagged,F)));
+       general_error(ERROR_TYPE,c);
 }
 
 void range_error(CELL tagged, CELL index, CELL max)
 {
-       CONS* c = cons(tagged,tag_cons(cons(tag_fixnum(index),
-               tag_cons(cons(tag_fixnum(max),F)))));
-       general_error(ERROR_RANGE,tag_cons(c));
+       CELL c = cons(tagged,cons(tag_fixnum(index),cons(tag_fixnum(max),F)));
+       general_error(ERROR_RANGE,c);
 }

diff --git a/native/factor.c b/native/factor.c
index cbd2682ac777a997c4c6a27dc47df7272417b54a..9e4c1a87a94166150b7ab1fa0bdcea2feb65118f 100644 (file)
--- a/native/factor.c
+++ b/native/factor.c
@@ -21,8 +21,7 @@ int main(int argc, char** argv)
        args = F;
        while(--argc != 0)
        {
-               args = tag_cons(cons(tag_object(from_c_string(argv[argc])),
-                       args));
+               args = cons(tag_object(from_c_string(argv[argc])),args);
        }
 
        userenv[ARGS_ENV] = args;

diff --git a/native/file.c b/native/file.c
index 9857d80ef3972f07cd8d3a1b35da03c471c54e80..ae297bf7d843aca1dbc064f032b4d91ad953cbc6 100644 (file)
--- a/native/file.c
+++ b/native/file.c
@@ -37,14 +37,14 @@ void primitive_stat(void)
                CELL mode = tag_fixnum(sb.st_mode & ~S_IFMT);
                CELL size = tag_object(s48_long_long_to_bignum(sb.st_size));
                CELL mtime = tag_integer(sb.st_mtime);
-               dpush(tag_cons(cons(
+               dpush(cons(
                        dirp,
-                       tag_cons(cons(
+                       cons(
                                mode,
-                               tag_cons(cons(
+                               cons(
                                        size,
-                                       tag_cons(cons(
-                                               mtime,F)))))))));
+                                       cons(
+                                               mtime,F)))));
        }
 }
 
@@ -61,7 +61,7 @@ void primitive_read_dir(void)
                {
                        CELL name = tag_object(from_c_string(
                                file->d_name));
-                       result = tag_cons(cons(name,result));
+                       result = cons(name,result);
                }
 
                closedir(dir);

diff --git a/native/fixnum.c b/native/fixnum.c
index a395a0b2bab41c585298a0714ede58d4ff72e410..5740fdedbd4e3fcfd36103298da6171c065a39bc 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -50,55 +50,20 @@ CELL subtract_fixnum(FIXNUM x, FIXNUM y)
 
 /**
  * Multiply two integers, and trap overflow.
- * I'm sure a more efficient algorithm exists.
+ * Thanks to David Blaikie (The_Vulture from freenode #java) for the hint.
  */
 CELL multiply_fixnum(FIXNUM x, FIXNUM y)
 {
-       bool negp;
-       FIXNUM hx, lx, hy, ly;
-       FIXNUM hprod, lprod, xprod, result;
-
-       if(x < 0)
-       {
-               negp = true;
-               x = -x;
-       }
+       if(x == 0 || y == 0)
+               return tag_fixnum(0);
        else
-               negp = false;
-
-       if(y < 0)
        {
-               negp = !negp;
-               y = -y;
+               FIXNUM prod = x * y;
+               if(prod / x == y)
+                       return tag_integer(prod);
        }
 
-       hx = x >> HALF_WORD_SIZE;
-       hy = y >> HALF_WORD_SIZE;
-
-       hprod = hx * hy;
-
-       if(hprod != 0)
-               goto bignum;
-
-       lx = x & HALF_WORD_MASK;
-       ly = y & HALF_WORD_MASK;
-
-       lprod = lx * ly;
-
-       if(lprod > FIXNUM_MAX)
-               goto bignum;
-
-       xprod = lx * hy + hx * ly;
-
-       if(xprod > (FIXNUM_MAX >> HALF_WORD_SIZE))
-               goto bignum;
-
-       result = (xprod << HALF_WORD_SIZE) + lprod;
-       if(negp)
-               result = -result;
-       return tag_integer(result);
-
-bignum:        return tag_object(
+       return tag_object(
                s48_bignum_multiply(
                        s48_long_to_bignum(x),
                        s48_long_to_bignum(y)));

diff --git a/native/io.c b/native/io.c
index dd1831c1874efc291881f4131bdf757302d7a56f..716c89515789d6d24d14013263715b0ae4012367 100644 (file)
--- a/native/io.c
+++ b/native/io.c
@@ -42,8 +42,8 @@ IO_TASK* add_io_task(
        io_tasks[fd].type = type;
        io_tasks[fd].port = port;
        io_tasks[fd].other_port = other_port;
-       io_tasks[fd].callbacks = tag_cons(cons(callback,
-               io_tasks[fd].callbacks));
+       io_tasks[fd].callbacks = cons(callback,
+               io_tasks[fd].callbacks);
 
        if(fd >= *fd_count)
                *fd_count = fd + 1;

diff --git a/native/port.c b/native/port.c
index 88c468dc4e2435fb80c10987e7b0f1c5b40f2d3c..e9937fa38b427a23206f5f3c843775f01541afa5 100644 (file)
--- a/native/port.c
+++ b/native/port.c
@@ -75,10 +75,7 @@ CELL make_io_error(const char* func)
        STRING* function = from_c_string(func);
        STRING* error = from_c_string(strerror(errno));
 
-       CONS* c = cons(tag_object(function),tag_cons(
-               cons(tag_object(error),F)));
-
-       return tag_cons(c);
+       return cons(tag_object(function),cons(tag_object(error),F));
 }
 
 void postpone_io_error(PORT* port, const char* func)