nicer multiply_fixnum; thanks The_Vulture
Slava Pestov
parent
5a0e002764
commit
5542e7c199
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)));
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue