nicer multiply_fixnum; thanks The_Vulture

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)
 {

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)

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)
 {

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)));
+	CELL c = cons(tag_fixnum(type),tag_cons(cons(tagged,F)));
-	general_error(ERROR_TYPE,tag_cons(c));
+	general_error(ERROR_TYPE,c);
 }
 
 void range_error(CELL tagged, CELL index, CELL max)
 {
-	CONS* c = cons(tagged,tag_cons(cons(tag_fixnum(index),
+	CELL c = cons(tagged,cons(tag_fixnum(index),cons(tag_fixnum(max),F)));
-		tag_cons(cons(tag_fixnum(max),F)))));
+	general_error(ERROR_RANGE,c);
-	general_error(ERROR_RANGE,tag_cons(c));
 }

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 = cons(tag_object(from_c_string(argv[argc])),args);
-			args));
 	}
 
 	userenv[ARGS_ENV] = args;

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(
+					cons(
-						mtime,F)))))))));
+						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);

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;
+	if(x == 0 || y == 0)
-	FIXNUM hx, lx, hy, ly;
+		return tag_fixnum(0);
-	FIXNUM hprod, lprod, xprod, result;
-
-	if(x < 0)
-	{
-		negp = true;
-		x = -x;
-	}
 	else
-		negp = false;
-
-	if(y < 0)
 	{
-		negp = !negp;
+		FIXNUM prod = x * y;
-		y = -y;
+		if(prod / x == y)
+			return tag_integer(prod);
 	}
 
-	hx = x >> HALF_WORD_SIZE;
+	return tag_object(
-	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(
 		s48_bignum_multiply(
 			s48_long_to_bignum(x),
 			s48_long_to_bignum(y)));

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 = cons(callback,
-		io_tasks[fd].callbacks));
+		io_tasks[fd].callbacks);
 
 	if(fd >= *fd_count)
 		*fd_count = fd + 1;

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(
+	return cons(tag_object(function),cons(tag_object(error),F));
-		cons(tag_object(error),F)));
-
-	return tag_cons(c);
 }
 
 void postpone_io_error(PORT* port, const char* func)