lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixing bug in truncate 

simplifying nconc loop
This commit is contained in:
JeffBezanson 2009-04-22 15:02:49 +00:00
parent 291b5f86e0
commit 27120b0ce4
2 changed files with 30 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
femtolisp/builtins.c
View File

@ -33,12 +33,17 @@ static value_t fl_nconc(value_t *args, u_int32_t nargs)
value_t lst, first=NIL; value_t lst, first=NIL;
value_t *pcdr = &first; value_t *pcdr = &first;
cons_t *c; cons_t *c;
int a; int i=0;
FOR_ARGS(a, 0, lst, args) { while (1) {
// skip last if (i >= MAX_ARGS) {
if ((nargs > MAX_ARGS && !iscons(args[MAX_ARGS])) || lst = car_(args[MAX_ARGS]);
(nargs <= MAX_ARGS && a == nargs-1)) args[MAX_ARGS] = cdr_(args[MAX_ARGS]);
break; if (!iscons(args[MAX_ARGS])) break;
}
else {
lst = args[i++];
if (i >= nargs) break;
}
if (iscons(lst)) { if (iscons(lst)) {
*pcdr = lst; *pcdr = lst;
c = (cons_t*)ptr(lst); c = (cons_t*)ptr(lst);
@ -254,8 +259,13 @@ static value_t fl_truncate(value_t *args, u_int32_t nargs)
d = *(double*)data; d = *(double*)data;
else else
return args[0]; return args[0];
if (d > 0) if (d > 0) {
if (d > (double)U64_MAX)
return args[0];
return return_from_uint64((uint64_t)d); return return_from_uint64((uint64_t)d);
}
if (d > (double)S64_MAX || d < (double)S64_MIN)
return args[0];
return return_from_int64((int64_t)d); return return_from_int64((int64_t)d);
} }
type_error("truncate", "number", args[0]); type_error("truncate", "number", args[0]);

28
femtolisp/flisp.c
View File

@ -814,7 +814,19 @@ static value_t apply_cl(uint32_t nargs)
do_call: do_call:
s = SP; s = SP;
func = Stack[SP-i-1]; func = Stack[SP-i-1];
if (isbuiltinish(func)) { if (isfunction(func)) {
if (op == OP_TCALL) {
for(s=-1; s < (fixnum_t)i; s++)
Stack[bp+s] = Stack[SP-i+s];
SP = bp+i;
nargs = i;
goto apply_cl_top;
}
else {
v = apply_cl(i);
}
}
else if (isbuiltinish(func)) {
op = uintval(func); op = uintval(func);
if (op > N_BUILTINS) { if (op > N_BUILTINS) {
v = ((builtin_t)ptr(func))(&Stack[SP-i], i); v = ((builtin_t)ptr(func))(&Stack[SP-i], i);
@ -842,18 +854,6 @@ static value_t apply_cl(uint32_t nargs)
} }
} }
} }
else if (isfunction(func)) {
if (op == OP_TCALL) {
for(s=-1; s < (fixnum_t)i; s++)
Stack[bp+s] = Stack[SP-i+s];
SP = bp+i;
nargs = i;
goto apply_cl_top;
}
else {
v = apply_cl(i);
}
}
else { else {
type_error("apply", "function", func); type_error("apply", "function", func);
} }
@ -1021,7 +1021,6 @@ static value_t apply_cl(uint32_t nargs)
case OP_SUB: case OP_SUB:
n = code[ip++]; n = code[ip++];
apply_sub: apply_sub:
if (__unlikely(n < 1)) lerror(ArgError, "-: too few arguments");
i = SP-n; i = SP-n;
if (n == 1) { if (n == 1) {
if (__likely(isfixnum(Stack[i]))) if (__likely(isfixnum(Stack[i])))
@ -1084,7 +1083,6 @@ static value_t apply_cl(uint32_t nargs)
case OP_DIV: case OP_DIV:
n = code[ip++]; n = code[ip++];
apply_div: apply_div:
if (__unlikely(n < 1)) lerror(ArgError, "/: too few arguments");
i = SP-n; i = SP-n;
if (n == 1) { if (n == 1) {
Stack[SP-1] = fl_div2(fixnum(1), Stack[i]); Stack[SP-1] = fl_div2(fixnum(1), Stack[i]);