diff --git a/native/complex.c b/native/complex.c index e9f201be40..3c0a417f83 100644 --- 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 0a4151737e..13dd058fb4 100644 --- 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 d8cad03013..3cb1999df8 100644 --- 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 1aeb8a36c8..0df4f2cf2d 100644 --- 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 cbd2682ac7..9e4c1a87a9 100644 --- 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 9857d80ef3..ae297bf7d8 100644 --- 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 a395a0b2ba..5740fdedbd 100644 --- 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 dd1831c187..716c895157 100644 --- 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 88c468dc4e..e9937fa38b 100644 --- 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)