Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 06:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixnum/integer naming cleanup

Browse source 
Replacing sexp_make_integer, sexp_integerp, etc. with sexp_make_fixnum,
sexp_fixnump, etc.  Defining the old names as variants handling either
fixnums or bignums, or just as aliases for the new terms when compiled
without bignum support.  sexp_make_integer needs to take a context now
in case it generates a bignum.
This commit is contained in:
Alex Shinn 2009-11-02 23:39:42 +09:00
parent 5b14a3a19d
commit c4625e1c86
6 changed files with 268 additions and 251 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

267
eval.c
View file

@ -291,7 +291,7 @@ sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
} }
sexp_context_stack(res) = stack; sexp_context_stack(res) = stack;
sexp_context_env(res) sexp_context_env(res)
= (env ? env : sexp_make_standard_env(res, sexp_make_integer(5))); = (env ? env : sexp_make_standard_env(res, sexp_make_fixnum(5)));
sexp_context_bc(res) sexp_context_bc(res)
= sexp_alloc_tagged(ctx, sexp_sizeof(bytecode)+INIT_BCODE_SIZE, = sexp_alloc_tagged(ctx, sexp_sizeof(bytecode)+INIT_BCODE_SIZE,
SEXP_BYTECODE); SEXP_BYTECODE);
@ -690,9 +690,9 @@ static sexp analyze (sexp ctx, sexp object) {
/* res = analyze(tmp, x); */ /* res = analyze(tmp, x); */
} else if (sexp_opcodep(op)) { } else if (sexp_opcodep(op)) {
res = sexp_length(ctx, sexp_cdr(x)); res = sexp_length(ctx, sexp_cdr(x));
if (sexp_unbox_integer(res) < sexp_opcode_num_args(op)) { if (sexp_unbox_fixnum(res) < sexp_opcode_num_args(op)) {
res = sexp_compile_error(ctx, "not enough args for opcode", x); res = sexp_compile_error(ctx, "not enough args for opcode", x);
} else if ((sexp_unbox_integer(res) > sexp_opcode_num_args(op)) } else if ((sexp_unbox_fixnum(res) > sexp_opcode_num_args(op))
&& (! sexp_opcode_variadic_p(op))) { && (! sexp_opcode_variadic_p(op))) {
res = sexp_compile_error(ctx, "too many args for opcode", x); res = sexp_compile_error(ctx, "too many args for opcode", x);
} else { } else {
@ -855,7 +855,7 @@ static void generate_opcode_app (sexp ctx, sexp app) {
sexp_gc_var1(ls); sexp_gc_var1(ls);
sexp_gc_preserve1(ctx, ls); sexp_gc_preserve1(ctx, ls);
num_args = sexp_unbox_integer(sexp_length(ctx, sexp_cdr(app))); num_args = sexp_unbox_fixnum(sexp_length(ctx, sexp_cdr(app)));
sexp_context_tailp(ctx) = 0; sexp_context_tailp(ctx) = 0;
/* maybe push the default for an optional argument */ /* maybe push the default for an optional argument */
@ -935,7 +935,7 @@ static void generate_opcode_app (sexp ctx, sexp app) {
} }
static void generate_general_app (sexp ctx, sexp app) { static void generate_general_app (sexp ctx, sexp app) {
sexp_uint_t len = sexp_unbox_integer(sexp_length(ctx, sexp_cdr(app))), sexp_uint_t len = sexp_unbox_fixnum(sexp_length(ctx, sexp_cdr(app))),
tailp = sexp_context_tailp(ctx); tailp = sexp_context_tailp(ctx);
sexp_gc_var1(ls); sexp_gc_var1(ls);
sexp_gc_preserve1(ctx, ls); sexp_gc_preserve1(ctx, ls);
@ -950,7 +950,7 @@ static void generate_general_app (sexp ctx, sexp app) {
/* maybe overwrite the current frame */ /* maybe overwrite the current frame */
emit(ctx, (tailp ? OP_TAIL_CALL : OP_CALL)); emit(ctx, (tailp ? OP_TAIL_CALL : OP_CALL));
emit_word(ctx, (sexp_uint_t)sexp_make_integer(len)); emit_word(ctx, (sexp_uint_t)sexp_make_fixnum(len));
sexp_context_depth(ctx) -= len; sexp_context_depth(ctx) -= len;
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
@ -991,14 +991,14 @@ static void generate_lambda (sexp ctx, sexp lambda) {
} }
sexp_context_tailp(ctx2) = 1; sexp_context_tailp(ctx2) = 1;
generate(ctx2, sexp_lambda_body(lambda)); generate(ctx2, sexp_lambda_body(lambda));
flags = sexp_make_integer((sexp_listp(ctx2, sexp_lambda_params(lambda)) flags = sexp_make_fixnum((sexp_listp(ctx2, sexp_lambda_params(lambda))
== SEXP_FALSE) ? 1uL : 0uL); == SEXP_FALSE) ? 1uL : 0uL);
len = sexp_length(ctx2, sexp_lambda_params(lambda)); len = sexp_length(ctx2, sexp_lambda_params(lambda));
bc = finalize_bytecode(ctx2); bc = finalize_bytecode(ctx2);
sexp_bytecode_name(bc) = sexp_lambda_name(lambda); sexp_bytecode_name(bc) = sexp_lambda_name(lambda);
if (sexp_nullp(fv)) { if (sexp_nullp(fv)) {
/* shortcut, no free vars */ /* shortcut, no free vars */
tmp = sexp_make_vector(ctx2, sexp_make_integer(0), SEXP_VOID); tmp = sexp_make_vector(ctx2, sexp_make_fixnum(0), SEXP_VOID);
tmp = sexp_make_procedure(ctx2, flags, len, bc, tmp); tmp = sexp_make_procedure(ctx2, flags, len, bc, tmp);
sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), tmp); sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), tmp);
generate_lit(ctx, tmp); generate_lit(ctx, tmp);
@ -1012,7 +1012,7 @@ static void generate_lambda (sexp ctx, sexp lambda) {
ref = sexp_car(fv); ref = sexp_car(fv);
generate_non_global_ref(ctx, sexp_ref_name(ref), sexp_ref_cell(ref), generate_non_global_ref(ctx, sexp_ref_name(ref), sexp_ref_cell(ref),
prev_lambda, prev_fv, 0); prev_lambda, prev_fv, 0);
emit_push(ctx, sexp_make_integer(k)); emit_push(ctx, sexp_make_fixnum(k));
emit(ctx, OP_STACK_REF); emit(ctx, OP_STACK_REF);
emit_word(ctx, 3); emit_word(ctx, 3);
emit(ctx, OP_VECTOR_SET); emit(ctx, OP_VECTOR_SET);
@ -1116,7 +1116,7 @@ static sexp make_param_list(sexp ctx, sexp_uint_t i) {
sexp_gc_preserve1(ctx, res); sexp_gc_preserve1(ctx, res);
res = SEXP_NULL; res = SEXP_NULL;
for ( ; i>0; i--) for ( ; i>0; i--)
res = sexp_cons(ctx, sexp_make_integer(i), res); res = sexp_cons(ctx, sexp_make_fixnum(i), res);
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
return res; return res;
} }
@ -1141,7 +1141,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
generate_opcode_app(ctx2, refs); generate_opcode_app(ctx2, refs);
bc = finalize_bytecode(ctx2); bc = finalize_bytecode(ctx2);
sexp_bytecode_name(bc) = sexp_c_string(ctx2, sexp_opcode_name(op), -1); sexp_bytecode_name(bc) = sexp_c_string(ctx2, sexp_opcode_name(op), -1);
res = sexp_make_procedure(ctx2, sexp_make_integer(0), sexp_make_integer(i), res = sexp_make_procedure(ctx2, sexp_make_fixnum(0), sexp_make_fixnum(i),
bc, SEXP_VOID); bc, SEXP_VOID);
if (i == sexp_opcode_num_args(op)) if (i == sexp_opcode_num_args(op))
sexp_opcode_proc(op) = res; sexp_opcode_proc(op) = res;
@ -1154,7 +1154,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
static sexp sexp_save_stack(sexp ctx, sexp *stack, sexp_uint_t to) { static sexp sexp_save_stack(sexp ctx, sexp *stack, sexp_uint_t to) {
sexp res, *data; sexp res, *data;
sexp_uint_t i; sexp_uint_t i;
res = sexp_make_vector(ctx, sexp_make_integer(to), SEXP_VOID); res = sexp_make_vector(ctx, sexp_make_fixnum(to), SEXP_VOID);
data = sexp_vector_data(res); data = sexp_vector_data(res);
for (i=0; i<to; i++) for (i=0; i<to; i++)
data[i] = stack[i]; data[i] = stack[i];
@ -1221,9 +1221,9 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_RAISE: case OP_RAISE:
call_error_handler: call_error_handler:
stack[top] = (sexp) 1; stack[top] = (sexp) 1;
stack[top+1] = sexp_make_integer(ip-sexp_bytecode_data(bc)); stack[top+1] = sexp_make_fixnum(ip-sexp_bytecode_data(bc));
stack[top+2] = self; stack[top+2] = self;
stack[top+3] = sexp_make_integer(fp); stack[top+3] = sexp_make_fixnum(fp);
top += 4; top += 4;
self = env_global_ref(env, the_err_handler_symbol, SEXP_FALSE); self = env_global_ref(env, the_err_handler_symbol, SEXP_FALSE);
bc = sexp_procedure_code(self); bc = sexp_procedure_code(self);
@ -1234,29 +1234,29 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_RESUMECC: case OP_RESUMECC:
tmp1 = stack[fp-1]; tmp1 = stack[fp-1];
top = sexp_restore_stack(sexp_vector_ref(cp, 0), stack); top = sexp_restore_stack(sexp_vector_ref(cp, 0), stack);
fp = sexp_unbox_integer(_ARG1); fp = sexp_unbox_fixnum(_ARG1);
self = _ARG2; self = _ARG2;
bc = sexp_procedure_code(self); bc = sexp_procedure_code(self);
cp = sexp_procedure_vars(self); cp = sexp_procedure_vars(self);
ip = sexp_bytecode_data(bc) + sexp_unbox_integer(_ARG3); ip = sexp_bytecode_data(bc) + sexp_unbox_fixnum(_ARG3);
i = sexp_unbox_integer(_ARG4); i = sexp_unbox_fixnum(_ARG4);
top -= 4; top -= 4;
_ARG1 = tmp1; _ARG1 = tmp1;
break; break;
case OP_CALLCC: case OP_CALLCC:
stack[top] = sexp_make_integer(1); stack[top] = sexp_make_fixnum(1);
stack[top+1] = sexp_make_integer(ip-sexp_bytecode_data(bc)); stack[top+1] = sexp_make_fixnum(ip-sexp_bytecode_data(bc));
stack[top+2] = self; stack[top+2] = self;
stack[top+3] = sexp_make_integer(fp); stack[top+3] = sexp_make_fixnum(fp);
tmp1 = _ARG1; tmp1 = _ARG1;
i = 1; i = 1;
sexp_context_top(ctx) = top; sexp_context_top(ctx) = top;
tmp2 = sexp_make_vector(ctx, sexp_make_integer(1), SEXP_UNDEF); tmp2 = sexp_make_vector(ctx, sexp_make_fixnum(1), SEXP_UNDEF);
sexp_vector_set(tmp2, sexp_vector_set(tmp2,
sexp_make_integer(0), sexp_make_fixnum(0),
sexp_save_stack(ctx, stack, top+4)); sexp_save_stack(ctx, stack, top+4));
_ARG1 = sexp_make_procedure(ctx, sexp_make_integer(0), _ARG1 = sexp_make_procedure(ctx, sexp_make_fixnum(0),
sexp_make_integer(1), continuation_resumer, sexp_make_fixnum(1), continuation_resumer,
tmp2); tmp2);
top++; top++;
ip -= sizeof(sexp); ip -= sizeof(sexp);
@ -1264,7 +1264,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_APPLY1: case OP_APPLY1:
tmp1 = _ARG1; tmp1 = _ARG1;
tmp2 = _ARG2; tmp2 = _ARG2;
i = sexp_unbox_integer(sexp_length(ctx, tmp2)); i = sexp_unbox_fixnum(sexp_length(ctx, tmp2));
top += (i-2); top += (i-2);
for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--) for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
_ARG1 = sexp_car(tmp2); _ARG1 = sexp_car(tmp2);
@ -1272,28 +1272,28 @@ sexp sexp_vm (sexp ctx, sexp proc) {
ip -= sizeof(sexp); ip -= sizeof(sexp);
goto make_call; goto make_call;
case OP_TAIL_CALL: case OP_TAIL_CALL:
i = sexp_unbox_integer(_WORD0); /* number of params */ i = sexp_unbox_fixnum(_WORD0); /* number of params */
tmp1 = _ARG1; /* procedure to call */ tmp1 = _ARG1; /* procedure to call */
/* save frame info */ /* save frame info */
tmp2 = stack[fp+3]; tmp2 = stack[fp+3];
j = sexp_unbox_integer(stack[fp]); j = sexp_unbox_fixnum(stack[fp]);
self = stack[fp+2]; self = stack[fp+2];
bc = sexp_procedure_vars(self); bc = sexp_procedure_vars(self);
cp = sexp_procedure_vars(self); cp = sexp_procedure_vars(self);
ip = (sexp_bytecode_data(bc) ip = (sexp_bytecode_data(bc)
+ sexp_unbox_integer(stack[fp+1])) - sizeof(sexp); + sexp_unbox_fixnum(stack[fp+1])) - sizeof(sexp);
/* copy new args into place */ /* copy new args into place */
for (k=0; k<i; k++) for (k=0; k<i; k++)
stack[fp-j+k] = stack[top-1-i+k]; stack[fp-j+k] = stack[top-1-i+k];
top = fp+i-j+1; top = fp+i-j+1;
fp = sexp_unbox_integer(tmp2); fp = sexp_unbox_fixnum(tmp2);
goto make_call; goto make_call;
case OP_CALL: case OP_CALL:
#if USE_CHECK_STACK #if USE_CHECK_STACK
if (top+16 >= INIT_STACK_SIZE) if (top+16 >= INIT_STACK_SIZE)
errx(70, "out of stack space at %ld", top); errx(70, "out of stack space at %ld", top);
#endif #endif
i = sexp_unbox_integer(_WORD0); i = sexp_unbox_fixnum(_WORD0);
tmp1 = _ARG1; tmp1 = _ARG1;
make_call: make_call:
if (sexp_opcodep(tmp1)) { if (sexp_opcodep(tmp1)) {
@ -1307,10 +1307,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
} }
if (! sexp_procedurep(tmp1)) if (! sexp_procedurep(tmp1))
sexp_raise("non procedure application", sexp_list1(ctx, tmp1)); sexp_raise("non procedure application", sexp_list1(ctx, tmp1));
j = i - sexp_unbox_integer(sexp_procedure_num_args(tmp1)); j = i - sexp_unbox_fixnum(sexp_procedure_num_args(tmp1));
if (j < 0) if (j < 0)
sexp_raise("not enough args", sexp_raise("not enough args",
sexp_list2(ctx, tmp1, sexp_make_integer(i))); sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
if (j > 0) { if (j > 0) {
if (sexp_procedure_variadic_p(tmp1)) { if (sexp_procedure_variadic_p(tmp1)) {
stack[top-i-1] = sexp_cons(ctx, stack[top-i-1], SEXP_NULL); stack[top-i-1] = sexp_cons(ctx, stack[top-i-1], SEXP_NULL);
@ -1322,7 +1322,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
i -= (j-1); i -= (j-1);
} else { } else {
sexp_raise("too many args", sexp_raise("too many args",
sexp_list2(ctx, tmp1, sexp_make_integer(i))); sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
} }
} else if (sexp_procedure_variadic_p(tmp1)) { } else if (sexp_procedure_variadic_p(tmp1)) {
/* shift stack, set extra arg to null */ /* shift stack, set extra arg to null */
@ -1332,10 +1332,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top++; top++;
i++; i++;
} }
_ARG1 = sexp_make_integer(i); _ARG1 = sexp_make_fixnum(i);
stack[top] = sexp_make_integer(ip+sizeof(sexp)-sexp_bytecode_data(bc)); stack[top] = sexp_make_fixnum(ip+sizeof(sexp)-sexp_bytecode_data(bc));
stack[top+1] = self; stack[top+1] = self;
stack[top+2] = sexp_make_integer(fp); stack[top+2] = sexp_make_fixnum(fp);
top += 3; top += 3;
self = tmp1; self = tmp1;
bc = sexp_procedure_code(self); bc = sexp_procedure_code(self);
@ -1436,7 +1436,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_CLOSURE_REF: case OP_CLOSURE_REF:
_PUSH(sexp_vector_ref(cp, sexp_make_integer(_WORD0))); _PUSH(sexp_vector_ref(cp, sexp_make_fixnum(_WORD0)));
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_VECTOR_REF: case OP_VECTOR_REF:
@ -1455,7 +1455,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top-=2; top-=2;
break; break;
case OP_VECTOR_LENGTH: case OP_VECTOR_LENGTH:
_ARG1 = sexp_make_integer(sexp_vector_length(_ARG1)); _ARG1 = sexp_make_fixnum(sexp_vector_length(_ARG1));
break; break;
case OP_STRING_REF: case OP_STRING_REF:
_ARG2 = sexp_string_ref(_ARG1, _ARG2); _ARG2 = sexp_string_ref(_ARG1, _ARG2);
@ -1471,7 +1471,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top-=2; top-=2;
break; break;
case OP_STRING_LENGTH: case OP_STRING_LENGTH:
_ARG1 = sexp_make_integer(sexp_string_length(_ARG1)); _ARG1 = sexp_make_fixnum(sexp_string_length(_ARG1));
break; break;
case OP_MAKE_PROCEDURE: case OP_MAKE_PROCEDURE:
sexp_context_top(ctx) = top; sexp_context_top(ctx) = top;
@ -1493,9 +1493,6 @@ sexp sexp_vm (sexp ctx, sexp proc) {
_ARG1 = sexp_make_boolean(sexp_nullp(_ARG1)); break; _ARG1 = sexp_make_boolean(sexp_nullp(_ARG1)); break;
case OP_INTEGERP: case OP_INTEGERP:
j = sexp_integerp(_ARG1); j = sexp_integerp(_ARG1);
#if USE_BIGNUMS
if (! j) j = sexp_bignump(_ARG1);
#endif
#if USE_FLONUMS #if USE_FLONUMS
if (! j) if (! j)
j = (sexp_flonump(_ARG1) j = (sexp_flonump(_ARG1)
@ -1509,7 +1506,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
_ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break; _ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break;
case OP_TYPEP: case OP_TYPEP:
_ARG1 = sexp_make_boolean(sexp_pointerp(_ARG1) _ARG1 = sexp_make_boolean(sexp_pointerp(_ARG1)
&& (sexp_make_integer(sexp_pointer_tag(_ARG1)) && (sexp_make_fixnum(sexp_pointer_tag(_ARG1))
== _WORD0)); == _WORD0));
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
@ -1547,25 +1544,25 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_ADD: case OP_ADD:
#if USE_BIGNUMS #if USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2; tmp1 = _ARG1, tmp2 = _ARG2;
if (sexp_integerp(tmp1) && sexp_integerp(tmp2)) { if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
j = sexp_unbox_integer(tmp1) + sexp_unbox_integer(tmp2); j = sexp_unbox_fixnum(tmp1) + sexp_unbox_fixnum(tmp2);
if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM)) if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM))
_ARG2 = sexp_add(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2); _ARG2 = sexp_add(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
else else
_ARG2 = sexp_make_integer(j); _ARG2 = sexp_make_fixnum(j);
} }
else else
_ARG2 = sexp_add(ctx, tmp1, tmp2); _ARG2 = sexp_add(ctx, tmp1, tmp2);
#else #else
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_fx_add(_ARG1, _ARG2); _ARG2 = sexp_fx_add(_ARG1, _ARG2);
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_add(ctx, _ARG1, _ARG2); _ARG2 = sexp_fp_add(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) + (double)sexp_unbox_integer(_ARG2)); _ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) + (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) + sexp_flonum_value(_ARG2)); _ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) + sexp_flonum_value(_ARG2));
#endif #endif
else sexp_raise("+: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("+: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif #endif
@ -1574,25 +1571,25 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_SUB: case OP_SUB:
#if USE_BIGNUMS #if USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2; tmp1 = _ARG1, tmp2 = _ARG2;
if (sexp_integerp(tmp1) && sexp_integerp(tmp2)) { if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
j = sexp_unbox_integer(tmp1) - sexp_unbox_integer(tmp2); j = sexp_unbox_fixnum(tmp1) - sexp_unbox_fixnum(tmp2);
if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM)) if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM))
_ARG2 = sexp_sub(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2); _ARG2 = sexp_sub(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
else else
_ARG2 = sexp_make_integer(j); _ARG2 = sexp_make_fixnum(j);
} }
else else
_ARG2 = sexp_sub(ctx, tmp1, tmp2); _ARG2 = sexp_sub(ctx, tmp1, tmp2);
#else #else
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_fx_sub(_ARG1, _ARG2); _ARG2 = sexp_fx_sub(_ARG1, _ARG2);
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_sub(ctx, _ARG1, _ARG2); _ARG2 = sexp_fp_sub(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) - (double)sexp_unbox_integer(_ARG2)); _ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) - (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) - sexp_flonum_value(_ARG2)); _ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) - sexp_flonum_value(_ARG2));
#endif #endif
else sexp_raise("-: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("-: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif #endif
@ -1601,45 +1598,45 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_MUL: case OP_MUL:
#if USE_BIGNUMS #if USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2; tmp1 = _ARG1, tmp2 = _ARG2;
if (sexp_integerp(tmp1) && sexp_integerp(tmp2)) { if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
prod = sexp_unbox_integer(tmp1) * sexp_unbox_integer(tmp2); prod = sexp_unbox_fixnum(tmp1) * sexp_unbox_fixnum(tmp2);
if ((prod < SEXP_MIN_FIXNUM) || (prod > SEXP_MAX_FIXNUM)) if ((prod < SEXP_MIN_FIXNUM) || (prod > SEXP_MAX_FIXNUM))
_ARG2 = sexp_mul(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2); _ARG2 = sexp_mul(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
else else
_ARG2 = sexp_make_integer(prod); _ARG2 = sexp_make_fixnum(prod);
} }
else else
_ARG2 = sexp_mul(ctx, tmp1, tmp2); _ARG2 = sexp_mul(ctx, tmp1, tmp2);
#else #else
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_fx_mul(_ARG1, _ARG2); _ARG2 = sexp_fx_mul(_ARG1, _ARG2);
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_mul(ctx, _ARG1, _ARG2); _ARG2 = sexp_fp_mul(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) * (double)sexp_unbox_integer(_ARG2)); _ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) * (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) * sexp_flonum_value(_ARG2)); _ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) * sexp_flonum_value(_ARG2));
#endif #endif
else sexp_raise("*: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("*: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif #endif
top--; top--;
break; break;
case OP_DIV: case OP_DIV:
if (_ARG2 == sexp_make_integer(0)) { if (_ARG2 == sexp_make_fixnum(0)) {
#if USE_FLONUMS #if USE_FLONUMS
if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0) if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0)
_ARG2 = sexp_make_flonum(ctx, 0.0/0.0); _ARG2 = sexp_make_flonum(ctx, 0.0/0.0);
else else
#endif #endif
sexp_raise("divide by zero", SEXP_NULL); sexp_raise("divide by zero", SEXP_NULL);
} else if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { } else if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
#if USE_FLONUMS #if USE_FLONUMS
_ARG1 = sexp_integer_to_flonum(ctx, _ARG1); _ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1);
_ARG2 = sexp_integer_to_flonum(ctx, _ARG2); _ARG2 = sexp_fixnum_to_flonum(ctx, _ARG2);
_ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2); _ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2);
if (sexp_flonum_value(_ARG2) == trunc(sexp_flonum_value(_ARG2))) if (sexp_flonum_value(_ARG2) == trunc(sexp_flonum_value(_ARG2)))
_ARG2 = sexp_make_integer(sexp_flonum_value(_ARG2)); _ARG2 = sexp_make_fixnum(sexp_flonum_value(_ARG2));
#else #else
_ARG2 = sexp_fx_div(_ARG1, _ARG2); _ARG2 = sexp_fx_div(_ARG1, _ARG2);
#endif #endif
@ -1651,18 +1648,18 @@ sexp sexp_vm (sexp ctx, sexp proc) {
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2); _ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) / (double)sexp_unbox_integer(_ARG2)); _ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) / (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) / sexp_flonum_value(_ARG2)); _ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) / sexp_flonum_value(_ARG2));
#endif #endif
else sexp_raise("/: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("/: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif #endif
top--; top--;
break; break;
case OP_QUOTIENT: case OP_QUOTIENT:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
if (_ARG2 == sexp_make_integer(0)) if (_ARG2 == sexp_make_fixnum(0))
sexp_raise("divide by zero", SEXP_NULL); sexp_raise("divide by zero", SEXP_NULL);
_ARG2 = sexp_fx_div(_ARG1, _ARG2); _ARG2 = sexp_fx_div(_ARG1, _ARG2);
top--; top--;
@ -1677,8 +1674,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
#endif #endif
break; break;
case OP_REMAINDER: case OP_REMAINDER:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
if (_ARG2 == sexp_make_integer(0)) if (_ARG2 == sexp_make_fixnum(0))
sexp_raise("divide by zero", SEXP_NULL); sexp_raise("divide by zero", SEXP_NULL);
tmp1 = sexp_fx_rem(_ARG1, _ARG2); tmp1 = sexp_fx_rem(_ARG1, _ARG2);
top--; top--;
@ -1694,8 +1691,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
#endif #endif
break; break;
case OP_NEGATIVE: case OP_NEGATIVE:
if (sexp_integerp(_ARG1)) if (sexp_fixnump(_ARG1))
_ARG1 = sexp_make_integer(-sexp_unbox_integer(_ARG1)); _ARG1 = sexp_make_fixnum(-sexp_unbox_fixnum(_ARG1));
#if USE_BIGNUMS #if USE_BIGNUMS
else if (sexp_bignump(_ARG1)) { else if (sexp_bignump(_ARG1)) {
_ARG1 = sexp_copy_bignum(ctx, NULL, _ARG1, 0); _ARG1 = sexp_copy_bignum(ctx, NULL, _ARG1, 0);
@ -1709,8 +1706,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
else sexp_raise("-: not a number", sexp_list1(ctx, _ARG1)); else sexp_raise("-: not a number", sexp_list1(ctx, _ARG1));
break; break;
case OP_INVERSE: case OP_INVERSE:
if (sexp_integerp(_ARG1)) if (sexp_fixnump(_ARG1))
_ARG1 = sexp_make_flonum(ctx, 1/(double)sexp_unbox_integer(_ARG1)); _ARG1 = sexp_make_flonum(ctx, 1/(double)sexp_unbox_fixnum(_ARG1));
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(_ARG1)) else if (sexp_flonump(_ARG1))
_ARG1 = sexp_make_flonum(ctx, 1/sexp_flonum_value(_ARG1)); _ARG1 = sexp_make_flonum(ctx, 1/sexp_flonum_value(_ARG1));
@ -1718,23 +1715,23 @@ sexp sexp_vm (sexp ctx, sexp proc) {
else sexp_raise("/: not a number", sexp_list1(ctx, _ARG1)); else sexp_raise("/: not a number", sexp_list1(ctx, _ARG1));
break; break;
case OP_LT: case OP_LT:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
i = (sexp_sint_t)_ARG1 < (sexp_sint_t)_ARG2; i = (sexp_sint_t)_ARG1 < (sexp_sint_t)_ARG2;
#if USE_BIGNUMS #if USE_BIGNUMS
_ARG2 = sexp_make_boolean(i); _ARG2 = sexp_make_boolean(i);
} else { } else {
tmp1 = sexp_compare(ctx, _ARG1, _ARG2); tmp1 = sexp_compare(ctx, _ARG1, _ARG2);
_ARG2 = sexp_integerp(tmp1) _ARG2 = sexp_fixnump(tmp1)
? sexp_make_boolean(sexp_unbox_integer(tmp1) < 0) : tmp1; ? sexp_make_boolean(sexp_unbox_fixnum(tmp1) < 0) : tmp1;
} }
#else #else
#if USE_FLONUMS #if USE_FLONUMS
} else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) } else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
i = sexp_flonum_value(_ARG1) < sexp_flonum_value(_ARG2); i = sexp_flonum_value(_ARG1) < sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
i = sexp_flonum_value(_ARG1) < (double)sexp_unbox_integer(_ARG2); i = sexp_flonum_value(_ARG1) < (double)sexp_unbox_fixnum(_ARG2);
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_integer(_ARG1) < sexp_flonum_value(_ARG2); i = (double)sexp_unbox_fixnum(_ARG1) < sexp_flonum_value(_ARG2);
#endif #endif
else sexp_raise("<: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("<: not a number", sexp_list2(ctx, _ARG1, _ARG2));
_ARG2 = sexp_make_boolean(i); _ARG2 = sexp_make_boolean(i);
@ -1742,23 +1739,23 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--; top--;
break; break;
case OP_LE: case OP_LE:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
i = (sexp_sint_t)_ARG1 <= (sexp_sint_t)_ARG2; i = (sexp_sint_t)_ARG1 <= (sexp_sint_t)_ARG2;
#if USE_BIGNUMS #if USE_BIGNUMS
_ARG2 = sexp_make_boolean(i); _ARG2 = sexp_make_boolean(i);
} else { } else {
tmp1 = sexp_compare(ctx, _ARG1, _ARG2); tmp1 = sexp_compare(ctx, _ARG1, _ARG2);
_ARG2 = sexp_integerp(tmp1) _ARG2 = sexp_fixnump(tmp1)
? sexp_make_boolean(sexp_unbox_integer(tmp1) <= 0) : tmp1; ? sexp_make_boolean(sexp_unbox_fixnum(tmp1) <= 0) : tmp1;
} }
#else #else
#if USE_FLONUMS #if USE_FLONUMS
} else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) } else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
i = sexp_flonum_value(_ARG1) <= sexp_flonum_value(_ARG2); i = sexp_flonum_value(_ARG1) <= sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
i = sexp_flonum_value(_ARG1) <= (double)sexp_unbox_integer(_ARG2); i = sexp_flonum_value(_ARG1) <= (double)sexp_unbox_fixnum(_ARG2);
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_integer(_ARG1) <= sexp_flonum_value(_ARG2); i = (double)sexp_unbox_fixnum(_ARG1) <= sexp_flonum_value(_ARG2);
#endif #endif
else sexp_raise("<=: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("<=: not a number", sexp_list2(ctx, _ARG1, _ARG2));
_ARG2 = sexp_make_boolean(i); _ARG2 = sexp_make_boolean(i);
@ -1766,23 +1763,23 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--; top--;
break; break;
case OP_EQN: case OP_EQN:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
i = _ARG1 == _ARG2; i = _ARG1 == _ARG2;
#if USE_BIGNUMS #if USE_BIGNUMS
_ARG2 = sexp_make_boolean(i); _ARG2 = sexp_make_boolean(i);
} else { } else {
tmp1 = sexp_compare(ctx, _ARG1, _ARG2); tmp1 = sexp_compare(ctx, _ARG1, _ARG2);
_ARG2 = sexp_integerp(tmp1) _ARG2 = sexp_fixnump(tmp1)
? sexp_make_boolean(sexp_unbox_integer(tmp1) == 0) : tmp1; ? sexp_make_boolean(sexp_unbox_fixnum(tmp1) == 0) : tmp1;
} }
#else #else
#if USE_FLONUMS #if USE_FLONUMS
} else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) } else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
i = sexp_flonum_value(_ARG1) == sexp_flonum_value(_ARG2); i = sexp_flonum_value(_ARG1) == sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2)) else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
i = sexp_flonum_value(_ARG1) == (double)sexp_unbox_integer(_ARG2); i = sexp_flonum_value(_ARG1) == (double)sexp_unbox_fixnum(_ARG2);
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_integer(_ARG1) == sexp_flonum_value(_ARG2); i = (double)sexp_unbox_fixnum(_ARG1) == sexp_flonum_value(_ARG2);
#endif #endif
else sexp_raise("=: not a number", sexp_list2(ctx, _ARG1, _ARG2)); else sexp_raise("=: not a number", sexp_list2(ctx, _ARG1, _ARG2));
_ARG2 = sexp_make_boolean(i); _ARG2 = sexp_make_boolean(i);
@ -1794,8 +1791,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--; top--;
break; break;
case OP_FIX2FLO: case OP_FIX2FLO:
if (sexp_integerp(_ARG1)) if (sexp_fixnump(_ARG1))
_ARG1 = sexp_integer_to_flonum(ctx, _ARG1); _ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1);
#if USE_BIGNUMS #if USE_BIGNUMS
else if (sexp_bignump(_ARG1)) else if (sexp_bignump(_ARG1))
_ARG1 = sexp_make_flonum(ctx, sexp_bignum_to_double(_ARG1)); _ARG1 = sexp_make_flonum(ctx, sexp_bignum_to_double(_ARG1));
@ -1811,17 +1808,17 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|| sexp_flonum_value(_ARG1) < SEXP_MIN_FIXNUM) { || sexp_flonum_value(_ARG1) < SEXP_MIN_FIXNUM) {
_ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1)); _ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1));
} else { } else {
_ARG1 = sexp_make_integer((sexp_sint_t)sexp_flonum_value(_ARG1)); _ARG1 = sexp_make_fixnum((sexp_sint_t)sexp_flonum_value(_ARG1));
} }
} else if (! sexp_integerp(_ARG1) && ! sexp_bignump(_ARG1)) { } else if (! sexp_fixnump(_ARG1) && ! sexp_bignump(_ARG1)) {
sexp_raise("inexact->exact: not a number", sexp_list1(ctx, _ARG1)); sexp_raise("inexact->exact: not a number", sexp_list1(ctx, _ARG1));
} }
break; break;
case OP_CHAR2INT: case OP_CHAR2INT:
_ARG1 = sexp_make_integer(sexp_unbox_character(_ARG1)); _ARG1 = sexp_make_fixnum(sexp_unbox_character(_ARG1));
break; break;
case OP_INT2CHAR: case OP_INT2CHAR:
_ARG1 = sexp_make_character(sexp_unbox_integer(_ARG1)); _ARG1 = sexp_make_character(sexp_unbox_fixnum(_ARG1));
break; break;
case OP_CHAR_UPCASE: case OP_CHAR_UPCASE:
_ARG1 = sexp_make_character(toupper(sexp_unbox_character(_ARG1))); _ARG1 = sexp_make_character(toupper(sexp_unbox_character(_ARG1)));
@ -1875,19 +1872,19 @@ sexp sexp_vm (sexp ctx, sexp proc) {
_ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i); _ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i);
break; break;
case OP_RET: case OP_RET:
i = sexp_unbox_integer(stack[fp]); i = sexp_unbox_fixnum(stack[fp]);
stack[fp-i] = _ARG1; stack[fp-i] = _ARG1;
top = fp-i+1; top = fp-i+1;
self = stack[fp+2]; self = stack[fp+2];
bc = sexp_procedure_code(self); bc = sexp_procedure_code(self);
ip = sexp_bytecode_data(bc) + sexp_unbox_integer(stack[fp+1]); ip = sexp_bytecode_data(bc) + sexp_unbox_fixnum(stack[fp+1]);
cp = sexp_procedure_vars(self); cp = sexp_procedure_vars(self);
fp = sexp_unbox_integer(stack[fp+3]); fp = sexp_unbox_fixnum(stack[fp+3]);
break; break;
case OP_DONE: case OP_DONE:
goto end_loop; goto end_loop;
default: default:
sexp_raise("unknown opcode", sexp_list1(ctx, sexp_make_integer(*(ip-1)))); sexp_raise("unknown opcode", sexp_list1(ctx, sexp_make_fixnum(*(ip-1))));
} }
goto loop; goto loop;
@ -2011,8 +2008,8 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
double d; \ double d; \
if (sexp_flonump(z)) \ if (sexp_flonump(z)) \
d = sexp_flonum_value(z); \ d = sexp_flonum_value(z); \
else if (sexp_integerp(z)) \ else if (sexp_fixnump(z)) \
d = (double)sexp_unbox_integer(z); \ d = (double)sexp_unbox_fixnum(z); \
maybe_convert_bignum(z) \ maybe_convert_bignum(z) \
else \ else \
return sexp_type_exception(ctx, "not a number", z); \ return sexp_type_exception(ctx, "not a number", z); \
@ -2040,10 +2037,10 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
sexp res; sexp res;
#if USE_BIGNUMS #if USE_BIGNUMS
if (sexp_bignump(e)) { if (sexp_bignump(e)) {
if ((x == sexp_make_integer(0)) || (x == sexp_make_integer(-1))) if ((x == sexp_make_fixnum(0)) || (x == sexp_make_fixnum(-1)))
res = sexp_make_flonum(ctx, pow(0, 0)); res = sexp_make_flonum(ctx, pow(0, 0));
else if (x == sexp_make_integer(1)) else if (x == sexp_make_fixnum(1))
res = sexp_make_flonum(ctx, sexp_unbox_integer(x)); res = sexp_make_flonum(ctx, sexp_unbox_fixnum(x));
else if (sexp_flonump(x)) else if (sexp_flonump(x))
res = sexp_make_flonum(ctx, pow(sexp_flonum_value(x), sexp_bignum_to_double(e))); res = sexp_make_flonum(ctx, pow(sexp_flonum_value(x), sexp_bignum_to_double(e)));
else else
@ -2052,16 +2049,16 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
res = sexp_bignum_expt(ctx, x, e); res = sexp_bignum_expt(ctx, x, e);
} else { } else {
#endif #endif
if (sexp_integerp(x)) if (sexp_fixnump(x))
x1 = (double)sexp_unbox_integer(x); x1 = (double)sexp_unbox_fixnum(x);
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(x)) else if (sexp_flonump(x))
x1 = sexp_flonum_value(x); x1 = sexp_flonum_value(x);
#endif #endif
else else
return sexp_type_exception(ctx, "not a number", x); return sexp_type_exception(ctx, "not a number", x);
if (sexp_integerp(e)) if (sexp_fixnump(e))
e1 = (double)sexp_unbox_integer(e); e1 = (double)sexp_unbox_fixnum(e);
#if USE_FLONUMS #if USE_FLONUMS
else if (sexp_flonump(e)) else if (sexp_flonump(e))
e1 = sexp_flonum_value(e); e1 = sexp_flonum_value(e);
@ -2077,7 +2074,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e); res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e);
} else } else
#endif #endif
res = sexp_make_integer((sexp_sint_t)round(f)); res = sexp_make_fixnum((sexp_sint_t)round(f));
#if USE_BIGNUMS #if USE_BIGNUMS
} }
#endif #endif
@ -2099,7 +2096,7 @@ static sexp sexp_string_cmp (sexp ctx, sexp str1, sexp str2, sexp ci) {
diff = strncasecmp(sexp_string_data(str1), sexp_string_data(str2), len); diff = strncasecmp(sexp_string_data(str1), sexp_string_data(str2), len);
if (! diff) if (! diff)
diff = len1 - len2; diff = len1 - len2;
return sexp_make_integer(diff); return sexp_make_fixnum(diff);
} }
#ifdef PLAN9 #ifdef PLAN9
@ -2193,8 +2190,8 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
emit(ctx2, OP_DONE); emit(ctx2, OP_DONE);
tmp = sexp_make_vector(ctx2, 0, SEXP_VOID); tmp = sexp_make_vector(ctx2, 0, SEXP_VOID);
err_handler = sexp_make_procedure(ctx2, err_handler = sexp_make_procedure(ctx2,
sexp_make_integer(0), sexp_make_fixnum(0),
sexp_make_integer(0), sexp_make_fixnum(0),
finalize_bytecode(ctx2), finalize_bytecode(ctx2),
tmp); tmp);
env_define(ctx2, e, the_err_handler_symbol, err_handler); env_define(ctx2, e, the_err_handler_symbol, err_handler);
@ -2227,15 +2224,15 @@ sexp sexp_env_copy (sexp ctx, sexp to, sexp from, sexp ls) {
sexp sexp_apply (sexp ctx, sexp proc, sexp args) { sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
sexp ls, *stack = sexp_stack_data(sexp_context_stack(ctx)); sexp ls, *stack = sexp_stack_data(sexp_context_stack(ctx));
sexp_sint_t top = sexp_context_top(ctx), offset; sexp_sint_t top = sexp_context_top(ctx), offset;
offset = top + sexp_unbox_integer(sexp_length(ctx, args)); offset = top + sexp_unbox_fixnum(sexp_length(ctx, args));
for (ls=args; sexp_pairp(ls); ls=sexp_cdr(ls), top++) for (ls=args; sexp_pairp(ls); ls=sexp_cdr(ls), top++)
stack[--offset] = sexp_car(ls); stack[--offset] = sexp_car(ls);
stack[top] = sexp_make_integer(top); stack[top] = sexp_make_fixnum(top);
top++; top++;
sexp_context_top(ctx) = top + 3; sexp_context_top(ctx) = top + 3;
stack[top++] = sexp_make_integer(0); stack[top++] = sexp_make_fixnum(0);
stack[top++] = final_resumer; stack[top++] = final_resumer;
stack[top++] = sexp_make_integer(0); stack[top++] = sexp_make_fixnum(0);
return sexp_vm(ctx, proc); return sexp_vm(ctx, proc);
} }
@ -2250,7 +2247,7 @@ sexp sexp_compile (sexp ctx, sexp x) {
generate(ctx, ast); generate(ctx, ast);
res = finalize_bytecode(ctx); res = finalize_bytecode(ctx);
vec = sexp_make_vector(ctx, 0, SEXP_VOID); vec = sexp_make_vector(ctx, 0, SEXP_VOID);
res = sexp_make_procedure(ctx, sexp_make_integer(0), sexp_make_integer(0), res = sexp_make_procedure(ctx, sexp_make_fixnum(0), sexp_make_fixnum(0),
res, vec); res, vec);
} }
sexp_gc_release4(ctx); sexp_gc_release4(ctx);
@ -2311,8 +2308,8 @@ void sexp_scheme_init (void) {
ctx = sexp_make_child_context(ctx, NULL); ctx = sexp_make_child_context(ctx, NULL);
emit(ctx, OP_DONE); emit(ctx, OP_DONE);
final_resumer = sexp_make_procedure(ctx, final_resumer = sexp_make_procedure(ctx,
sexp_make_integer(0), sexp_make_fixnum(0),
sexp_make_integer(0), sexp_make_fixnum(0),
finalize_bytecode(ctx), finalize_bytecode(ctx),
sexp_make_vector(ctx, 0, SEXP_VOID)); sexp_make_vector(ctx, 0, SEXP_VOID));
sexp_bytecode_name(sexp_procedure_code(final_resumer)) sexp_bytecode_name(sexp_procedure_code(final_resumer))

4
gc.c
View file

@ -149,7 +149,7 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
} }
} }
sum_freed_ptr[0] = sum_freed; sum_freed_ptr[0] = sum_freed;
return sexp_make_integer(max_freed); return sexp_make_fixnum(max_freed);
} }
sexp sexp_gc (sexp ctx, size_t *sum_freed) { sexp sexp_gc (sexp ctx, size_t *sum_freed) {
@ -217,7 +217,7 @@ void* sexp_alloc (sexp ctx, size_t size) {
size = sexp_heap_align(size); size = sexp_heap_align(size);
res = sexp_try_alloc(ctx, size); res = sexp_try_alloc(ctx, size);
if (! res) { if (! res) {
max_freed = sexp_unbox_integer(sexp_gc(ctx, &sum_freed)); max_freed = sexp_unbox_fixnum(sexp_gc(ctx, &sum_freed));
h = sexp_heap_last(heap); h = sexp_heap_last(heap);
if (((max_freed < size) if (((max_freed < size)
|| ((h->size - sum_freed) < (h->size*(1 - SEXP_GROW_HEAP_RATIO)))) || ((h->size - sum_freed) < (h->size*(1 - SEXP_GROW_HEAP_RATIO))))

36
include/chibi/sexp.h
View file

@ -334,7 +334,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
#define sexp_nullp(x) ((x) == SEXP_NULL) #define sexp_nullp(x) ((x) == SEXP_NULL)
#define sexp_pointerp(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_POINTER_TAG) #define sexp_pointerp(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_POINTER_TAG)
#define sexp_integerp(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_FIXNUM_TAG) #define sexp_fixnump(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_FIXNUM_TAG)
#define sexp_isymbolp(x) (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_ISYMBOL_TAG) #define sexp_isymbolp(x) (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_ISYMBOL_TAG)
#define sexp_charp(x) (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_CHAR_TAG) #define sexp_charp(x) (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_CHAR_TAG)
#define sexp_booleanp(x) (((x) == SEXP_TRUE) || ((x) == SEXP_FALSE)) #define sexp_booleanp(x) (((x) == SEXP_TRUE) || ((x) == SEXP_FALSE))
@ -398,18 +398,26 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_make_boolean(x) ((x) ? SEXP_TRUE : SEXP_FALSE) #define sexp_make_boolean(x) ((x) ? SEXP_TRUE : SEXP_FALSE)
#define sexp_unbox_boolean(x) (((x) == SEXP_FALSE) ? 0 : 1) #define sexp_unbox_boolean(x) (((x) == SEXP_FALSE) ? 0 : 1)
#define sexp_make_integer(n) ((sexp) ((((sexp_sint_t)(n))<<SEXP_FIXNUM_BITS) + SEXP_FIXNUM_TAG)) #define sexp_make_fixnum(n) ((sexp) ((((sexp_sint_t)(n))<<SEXP_FIXNUM_BITS) + SEXP_FIXNUM_TAG))
#define sexp_unbox_integer(n) (((sexp_sint_t)(n))>>SEXP_FIXNUM_BITS) #define sexp_unbox_fixnum(n) (((sexp_sint_t)(n))>>SEXP_FIXNUM_BITS)
#define sexp_make_character(n) ((sexp) ((((sexp_sint_t)(n))<<SEXP_EXTENDED_BITS) + SEXP_CHAR_TAG)) #define sexp_make_character(n) ((sexp) ((((sexp_sint_t)(n))<<SEXP_EXTENDED_BITS) + SEXP_CHAR_TAG))
#define sexp_unbox_character(n) ((int) (((sexp_sint_t)(n))>>SEXP_EXTENDED_BITS)) #define sexp_unbox_character(n) ((int) (((sexp_sint_t)(n))>>SEXP_EXTENDED_BITS))
#define sexp_integer_to_double(x) ((double)sexp_unbox_integer(x)) #define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x))
#if USE_BIGNUMS
SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_integerp(x) (sexp_fixnump(x) || sexp_bignump(x))
#else
#define sexp_make_integer(ctx, x) sexp_make_fixnum(x)
#define sexp_integerp sexp_fixnump
#endif
#if USE_FLONUMS #if USE_FLONUMS
#define sexp_integer_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_integer(x))) #define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x)))
#else #else
#define sexp_integer_to_flonum(ctx, x) (x) #define sexp_fixnum_to_flonum(ctx, x) (x)
#endif #endif
/*************************** field accessors **************************/ /*************************** field accessors **************************/
@ -417,20 +425,20 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_vector_length(x) ((x)->value.vector.length) #define sexp_vector_length(x) ((x)->value.vector.length)
#define sexp_vector_data(x) ((x)->value.vector.data) #define sexp_vector_data(x) ((x)->value.vector.data)
#define sexp_vector_ref(x,i) (sexp_vector_data(x)[sexp_unbox_integer(i)]) #define sexp_vector_ref(x,i) (sexp_vector_data(x)[sexp_unbox_fixnum(i)])
#define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_integer(i)]=(v)) #define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v))
#define sexp_procedure_num_args(x) ((x)->value.procedure.num_args) #define sexp_procedure_num_args(x) ((x)->value.procedure.num_args)
#define sexp_procedure_flags(x) ((x)->value.procedure.flags) #define sexp_procedure_flags(x) ((x)->value.procedure.flags)
#define sexp_procedure_variadic_p(x) (sexp_unbox_integer(sexp_procedure_flags(x)) & 1) #define sexp_procedure_variadic_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & 1)
#define sexp_procedure_code(x) ((x)->value.procedure.bc) #define sexp_procedure_code(x) ((x)->value.procedure.bc)
#define sexp_procedure_vars(x) ((x)->value.procedure.vars) #define sexp_procedure_vars(x) ((x)->value.procedure.vars)
#define sexp_string_length(x) ((x)->value.string.length) #define sexp_string_length(x) ((x)->value.string.length)
#define sexp_string_data(x) ((x)->value.string.data) #define sexp_string_data(x) ((x)->value.string.data)
#define sexp_string_ref(x, i) (sexp_make_character(sexp_string_data(x)[sexp_unbox_integer(i)])) #define sexp_string_ref(x, i) (sexp_make_character(sexp_string_data(x)[sexp_unbox_fixnum(i)]))
#define sexp_string_set(x, i, v) (sexp_string_data(x)[sexp_unbox_integer(i)] = sexp_unbox_character(v)) #define sexp_string_set(x, i, v) (sexp_string_data(x)[sexp_unbox_fixnum(i)] = sexp_unbox_character(v))
#define sexp_symbol_string(x) ((x)->value.symbol.string) #define sexp_symbol_string(x) ((x)->value.symbol.string)
@ -552,10 +560,10 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_fx_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG)) #define sexp_fx_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG))
#define sexp_fx_sub(a, b) ((sexp)(((sexp_sint_t)a)-((sexp_sint_t)b)+SEXP_FIXNUM_TAG)) #define sexp_fx_sub(a, b) ((sexp)(((sexp_sint_t)a)-((sexp_sint_t)b)+SEXP_FIXNUM_TAG))
#define sexp_fx_mul(a, b) ((sexp)((((((sexp_sint_t)a)-SEXP_FIXNUM_TAG)*(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))+SEXP_FIXNUM_TAG))) #define sexp_fx_mul(a, b) ((sexp)((((((sexp_sint_t)a)-SEXP_FIXNUM_TAG)*(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))+SEXP_FIXNUM_TAG)))
#define sexp_fx_div(a, b) (sexp_make_integer(sexp_unbox_integer(a) / sexp_unbox_integer(b))) #define sexp_fx_div(a, b) (sexp_make_fixnum(sexp_unbox_fixnum(a) / sexp_unbox_fixnum(b)))
#define sexp_fx_rem(a, b) (sexp_make_integer(sexp_unbox_integer(a) % sexp_unbox_integer(b))) #define sexp_fx_rem(a, b) (sexp_make_fixnum(sexp_unbox_fixnum(a) % sexp_unbox_fixnum(b)))
#define sexp_fx_sign(a) (+1 | (((sexp_sint_t)(a)) >> (sizeof(int)*8 - 1))) #define sexp_fx_sign(a) (+1 | (((sexp_sint_t)(a)) >> (sizeof(int)*8 - 1)))
#define sexp_fx_neg(a) (sexp_make_integer(-(sexp_unbox_integer(a)))) #define sexp_fx_neg(a) (sexp_make_fixnum(-(sexp_unbox_fixnum(a))))
#define sexp_fx_abs(a) ((((sexp_sint_t)a) < 0) ? sexp_fx_neg(a) : a) #define sexp_fx_abs(a) ((((sexp_sint_t)a) < 0) ? sexp_fx_neg(a) : a)
#define sexp_fp_add(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) + sexp_flonum_value(b))) #define sexp_fp_add(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) + sexp_flonum_value(b)))

20
opcodes.c
View file

@ -30,8 +30,8 @@ _OP(OPC_GENERIC, OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL),
_OP(OPC_GENERIC, OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL), _OP(OPC_GENERIC, OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL),
_OP(OPC_GENERIC, OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL), _OP(OPC_GENERIC, OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL),
_OP(OPC_GENERIC, OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL), _OP(OPC_GENERIC, OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL),
_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_integer(0), NULL), _OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL),
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_integer(1), NULL), _OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL),
_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", 0, NULL), _OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", 0, NULL),
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", 0, NULL), _OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", 0, NULL),
_OP(OPC_ARITHMETIC, OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL), _OP(OPC_ARITHMETIC, OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL),
@ -50,14 +50,14 @@ _OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0), _OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0), _OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0), _OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_integer(SEXP_PAIR), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_fixnum(SEXP_PAIR), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_integer(SEXP_STRING), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_integer(SEXP_VECTOR), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_integer(SEXP_FLONUM), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_integer(SEXP_PROCEDURE), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_integer(SEXP_OPCODE), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_fixnum(SEXP_OPCODE), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_integer(SEXP_IPORT), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_fixnum(SEXP_IPORT), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_integer(SEXP_OPORT), 0), _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_fixnum(SEXP_OPORT), 0),
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL), _OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL),
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL), _OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL),
_OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL), _OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL),

78
opt/bignum.c
View file

@ -7,7 +7,7 @@
#define sexp_negate(x) \ #define sexp_negate(x) \
if (sexp_bignump(x)) \ if (sexp_bignump(x)) \
sexp_bignum_sign(x) = -sexp_bignum_sign(x); \ sexp_bignum_sign(x) = -sexp_bignum_sign(x); \
else if (sexp_integerp(x)) \ else if (sexp_fixnump(x)) \
x = sexp_fx_neg(x); x = sexp_fx_neg(x);
sexp sexp_make_bignum (sexp ctx, sexp_uint_t len) { sexp sexp_make_bignum (sexp ctx, sexp_uint_t len) {
@ -20,11 +20,23 @@ sexp sexp_make_bignum (sexp ctx, sexp_uint_t len) {
sexp sexp_fixnum_to_bignum (sexp ctx, sexp a) { sexp sexp_fixnum_to_bignum (sexp ctx, sexp a) {
sexp res = sexp_make_bignum(ctx, 1); sexp res = sexp_make_bignum(ctx, 1);
sexp_bignum_data(res)[0] = sexp_unbox_integer(sexp_fx_abs(a)); sexp_bignum_data(res)[0] = sexp_unbox_fixnum(sexp_fx_abs(a));
sexp_bignum_sign(res) = sexp_fx_sign(a); sexp_bignum_sign(res) = sexp_fx_sign(a);
return res; return res;
} }
sexp sexp_make_integer (sexp ctx, sexp_sint_t x) {
sexp res;
if ((SEXP_MIN_FIXNUM < x) && (x < SEXP_MAX_FIXNUM)) {
res = sexp_make_fixnum(x);
} else {
res = sexp_make_bignum(ctx, 1);
sexp_bignum_sign(res) = (x < 0 ? -1 : 1);
sexp_bignum_data(res)[0] = x * sexp_bignum_sign(res);
}
return res;
}
#define double_trunc_10s_digit(f) (trunc((f)/10.0)*10.0) #define double_trunc_10s_digit(f) (trunc((f)/10.0)*10.0)
#define double_10s_digit(f) ((f)-double_trunc_10s_digit(f)) #define double_10s_digit(f) ((f)-double_trunc_10s_digit(f))
@ -32,8 +44,8 @@ sexp sexp_double_to_bignum (sexp ctx, double f) {
int sign; int sign;
sexp_gc_var3(res, scale, tmp); sexp_gc_var3(res, scale, tmp);
sexp_gc_preserve3(ctx, res, scale, tmp); sexp_gc_preserve3(ctx, res, scale, tmp);
res = sexp_fixnum_to_bignum(ctx, sexp_make_integer(0)); res = sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(0));
scale = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1)); scale = sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(1));
sign = (f < 0 ? -1 : 1); sign = (f < 0 ? -1 : 1);
for (f=fabs(f); f >= 1.0; f=trunc(f/10)) { for (f=fabs(f); f >= 1.0; f=trunc(f/10)) {
tmp = sexp_bignum_fxmul(ctx, NULL, scale, double_10s_digit(f), 0); tmp = sexp_bignum_fxmul(ctx, NULL, scale, double_10s_digit(f), 0);
@ -105,7 +117,7 @@ sexp sexp_bignum_normalize (sexp a) {
if ((data[0] > SEXP_MAX_FIXNUM) if ((data[0] > SEXP_MAX_FIXNUM)
&& ! ((sexp_bignum_sign(a) == -1) && (data[0] == SEXP_MAX_FIXNUM+1))) && ! ((sexp_bignum_sign(a) == -1) && (data[0] == SEXP_MAX_FIXNUM+1)))
return a; return a;
return sexp_make_integer((sexp_sint_t)data[0] * sexp_bignum_sign(a)); return sexp_make_fixnum((sexp_sint_t)data[0] * sexp_bignum_sign(a));
} }
double sexp_bignum_to_double (sexp a) { double sexp_bignum_to_double (sexp a) {
@ -226,7 +238,7 @@ sexp sexp_write_bignum (sexp ctx, sexp a, sexp out, sexp_uint_t base) {
sexp_bignum_sign(b) = 1; sexp_bignum_sign(b) = 1;
i = str_len = (sexp_bignum_length(b)*sizeof(sexp_uint_t)*8 + lg_base - 1) i = str_len = (sexp_bignum_length(b)*sizeof(sexp_uint_t)*8 + lg_base - 1)
/ lg_base + 1; / lg_base + 1;
str = sexp_make_string(ctx, sexp_make_integer(str_len), str = sexp_make_string(ctx, sexp_make_fixnum(str_len),
sexp_make_character(' ')); sexp_make_character(' '));
data = sexp_string_data(str); data = sexp_string_data(str);
while (! sexp_bignum_zerop(b)) while (! sexp_bignum_zerop(b))
@ -247,9 +259,9 @@ sexp sexp_bignum_add_fixnum (sexp ctx, sexp a, sexp b) {
sexp_gc_preserve1(ctx, c); sexp_gc_preserve1(ctx, c);
c = sexp_copy_bignum(ctx, NULL, a, 0); c = sexp_copy_bignum(ctx, NULL, a, 0);
if (sexp_bignum_sign(c) == sexp_fx_sign(b)) if (sexp_bignum_sign(c) == sexp_fx_sign(b))
c = sexp_bignum_fxadd(ctx, c, sexp_unbox_integer(sexp_fx_abs(b))); c = sexp_bignum_fxadd(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b)));
else else
c = sexp_bignum_fxsub(ctx, c, sexp_unbox_integer(sexp_fx_abs(b))); c = sexp_bignum_fxsub(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b)));
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
return c; return c;
} }
@ -360,7 +372,7 @@ static sexp quot_step (sexp ctx, sexp *rem, sexp a, sexp b, sexp k, sexp i) {
sexp_gc_var5(x, prod, diff, k2, i2); sexp_gc_var5(x, prod, diff, k2, i2);
if (sexp_bignum_compare(k, a) > 0) { if (sexp_bignum_compare(k, a) > 0) {
*rem = a; *rem = a;
return sexp_fixnum_to_bignum(ctx, sexp_make_integer(0)); return sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(0));
} }
sexp_gc_preserve5(ctx, x, prod, diff, k2, i2); sexp_gc_preserve5(ctx, x, prod, diff, k2, i2);
k2 = sexp_bignum_double(ctx, k); k2 = sexp_bignum_double(ctx, k);
@ -388,7 +400,7 @@ sexp sexp_bignum_quot_rem (sexp ctx, sexp *rem, sexp a, sexp b) {
b1 = sexp_copy_bignum(ctx, NULL, b, 0); b1 = sexp_copy_bignum(ctx, NULL, b, 0);
sexp_bignum_sign(b1) = 1; sexp_bignum_sign(b1) = 1;
k = sexp_copy_bignum(ctx, NULL, b1, 0); k = sexp_copy_bignum(ctx, NULL, b1, 0);
i = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1)); i = sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(1));
res = quot_step(ctx, rem, a1, b1, k, i); res = quot_step(ctx, rem, a1, b1, k, i);
sexp_bignum_sign(res) = sexp_bignum_sign(a) * sexp_bignum_sign(b); sexp_bignum_sign(res) = sexp_bignum_sign(a) * sexp_bignum_sign(b);
if (sexp_bignum_sign(a) < 0) { if (sexp_bignum_sign(a) < 0) {
@ -414,10 +426,10 @@ sexp sexp_bignum_remainder (sexp ctx, sexp a, sexp b) {
} }
sexp sexp_bignum_expt (sexp ctx, sexp a, sexp b) { sexp sexp_bignum_expt (sexp ctx, sexp a, sexp b) {
sexp_sint_t e = sexp_unbox_integer(sexp_fx_abs(b)); sexp_sint_t e = sexp_unbox_fixnum(sexp_fx_abs(b));
sexp_gc_var2(res, acc); sexp_gc_var2(res, acc);
sexp_gc_preserve2(ctx, res, acc); sexp_gc_preserve2(ctx, res, acc);
res = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1)); res = sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(1));
acc = sexp_copy_bignum(ctx, NULL, a, 0); acc = sexp_copy_bignum(ctx, NULL, a, 0);
for (; e; e>>=1, acc=sexp_bignum_mul(ctx, NULL, acc, acc)) for (; e; e>>=1, acc=sexp_bignum_mul(ctx, NULL, acc, acc))
if (e & 1) if (e & 1)
@ -460,7 +472,7 @@ static int sexp_number_types[SEXP_NUM_TYPES] =
static int sexp_number_type (sexp a) { static int sexp_number_type (sexp a) {
return sexp_pointerp(a) ? sexp_number_types[sexp_pointer_tag(a)] return sexp_pointerp(a) ? sexp_number_types[sexp_pointer_tag(a)]
: sexp_integerp(a); : sexp_fixnump(a);
} }
sexp sexp_add (sexp ctx, sexp a, sexp b) { sexp sexp_add (sexp ctx, sexp a, sexp b) {
@ -476,7 +488,7 @@ sexp sexp_add (sexp ctx, sexp a, sexp b) {
r = sexp_fx_add(a, b); /* XXXX check overflow */ r = sexp_fx_add(a, b); /* XXXX check overflow */
break; break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
r = sexp_make_flonum(ctx, sexp_integer_to_double(a)+sexp_flonum_value(b)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)+sexp_flonum_value(b));
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_bignum_normalize(sexp_bignum_add_fixnum(ctx, b, a)); r = sexp_bignum_normalize(sexp_bignum_add_fixnum(ctx, b, a));
@ -509,7 +521,7 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_fx_sub(a, b); /* XXXX check overflow */ r = sexp_fx_sub(a, b); /* XXXX check overflow */
break; break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
r = sexp_make_flonum(ctx, sexp_integer_to_double(a)-sexp_flonum_value(b)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)-sexp_flonum_value(b));
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_bignum_sub(ctx, NULL, b, sexp_fixnum_to_bignum(ctx, a)); r = sexp_bignum_sub(ctx, NULL, b, sexp_fixnum_to_bignum(ctx, a));
@ -517,7 +529,7 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_bignum_normalize(r); r = sexp_bignum_normalize(r);
break; break;
case SEXP_NUM_FLO_FIX: case SEXP_NUM_FLO_FIX:
r = sexp_make_flonum(ctx, sexp_integer_to_double(b)+sexp_flonum_value(a)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(b)+sexp_flonum_value(a));
break; break;
case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_FLO:
r = sexp_fp_sub(ctx, a, b); r = sexp_fp_sub(ctx, a, b);
@ -550,10 +562,10 @@ sexp sexp_mul (sexp ctx, sexp a, sexp b) {
r = sexp_fx_mul(a, b); r = sexp_fx_mul(a, b);
break; break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
r = sexp_make_flonum(ctx, sexp_integer_to_double(a)*sexp_flonum_value(b)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)*sexp_flonum_value(b));
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_bignum_fxmul(ctx, NULL, b, sexp_unbox_integer(sexp_fx_abs(a)), 0); r = sexp_bignum_fxmul(ctx, NULL, b, sexp_unbox_fixnum(sexp_fx_abs(a)), 0);
sexp_bignum_sign(r) = sexp_fx_sign(a) * sexp_bignum_sign(b); sexp_bignum_sign(r) = sexp_fx_sign(a) * sexp_bignum_sign(b);
break; break;
case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_FLO:
@ -582,18 +594,18 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
r = sexp_type_exception(ctx, "/: not a number", b); r = sexp_type_exception(ctx, "/: not a number", b);
break; break;
case SEXP_NUM_FIX_FIX: case SEXP_NUM_FIX_FIX:
f = sexp_integer_to_double(a) / sexp_integer_to_double(b); f = sexp_fixnum_to_double(a) / sexp_fixnum_to_double(b);
r = ((f == trunc(f)) ? sexp_make_integer((sexp_sint_t)f) r = ((f == trunc(f)) ? sexp_make_fixnum((sexp_sint_t)f)
: sexp_make_flonum(ctx, f)); : sexp_make_flonum(ctx, f));
break; break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
r = sexp_make_flonum(ctx, sexp_integer_to_double(a)/sexp_flonum_value(b)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)/sexp_flonum_value(b));
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_make_flonum(ctx, sexp_integer_to_double(a)/sexp_bignum_to_double(b)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)/sexp_bignum_to_double(b));
break; break;
case SEXP_NUM_FLO_FIX: case SEXP_NUM_FLO_FIX:
r = sexp_make_flonum(ctx, sexp_integer_to_double(b)/sexp_flonum_value(a)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(b)/sexp_flonum_value(a));
break; break;
case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_FLO:
r = sexp_fp_div(ctx, a, b); r = sexp_fp_div(ctx, a, b);
@ -606,9 +618,9 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
case SEXP_NUM_BIG_BIG: case SEXP_NUM_BIG_BIG:
r = sexp_bignum_quot_rem(ctx, &rem, a, b); r = sexp_bignum_quot_rem(ctx, &rem, a, b);
if (sexp_bignum_normalize(rem) != sexp_make_integer(0)) if (sexp_bignum_normalize(rem) != sexp_make_fixnum(0))
r = sexp_make_flonum(ctx, sexp_bignum_to_double(a) r = sexp_make_flonum(ctx, sexp_bignum_to_double(a)
/ sexp_integer_to_double(b)); / sexp_fixnum_to_double(b));
else else
r = sexp_bignum_normalize(r); r = sexp_bignum_normalize(r);
break; break;
@ -640,7 +652,7 @@ sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
r = sexp_fx_div(a, b); r = sexp_fx_div(a, b);
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_make_integer(0); r = sexp_make_fixnum(0);
break; break;
case SEXP_NUM_BIG_FIX: case SEXP_NUM_BIG_FIX:
b = sexp_fixnum_to_bignum(ctx, b); b = sexp_fixnum_to_bignum(ctx, b);
@ -699,25 +711,25 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
r = sexp_type_exception(ctx, "compare: not a number", a); r = sexp_type_exception(ctx, "compare: not a number", a);
break; break;
case SEXP_NUM_FIX_FIX: case SEXP_NUM_FIX_FIX:
r = sexp_make_integer(sexp_unbox_integer(a) - sexp_unbox_integer(b)); r = sexp_make_fixnum(sexp_unbox_fixnum(a) - sexp_unbox_fixnum(b));
break; break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
f = sexp_integer_to_double(a) - sexp_flonum_value(b); f = sexp_fixnum_to_double(a) - sexp_flonum_value(b);
r = sexp_make_integer(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1);
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_make_integer(-1); r = sexp_make_fixnum(-1);
break; break;
case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_FLO:
f = sexp_flonum_value(a) - sexp_flonum_value(b); f = sexp_flonum_value(a) - sexp_flonum_value(b);
r = sexp_make_integer(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1);
break; break;
case SEXP_NUM_FLO_BIG: case SEXP_NUM_FLO_BIG:
f = sexp_flonum_value(a) - sexp_bignum_to_double(b); f = sexp_flonum_value(a) - sexp_bignum_to_double(b);
r = sexp_make_integer(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1);
break; break;
case SEXP_NUM_BIG_BIG: case SEXP_NUM_BIG_BIG:
r = sexp_make_integer(sexp_bignum_compare(a, b)); r = sexp_make_fixnum(sexp_bignum_compare(a, b));
break; break;
} }
} }

114
sexp.c
View file

@ -169,8 +169,8 @@ sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
} }
if (sexp_pairp(sexp_exception_source(exn))) { if (sexp_pairp(sexp_exception_source(exn))) {
ls = sexp_exception_source(exn); ls = sexp_exception_source(exn);
if (sexp_integerp(sexp_cdr(ls)) if (sexp_fixnump(sexp_cdr(ls))
&& (sexp_cdr(ls) >= sexp_make_integer(0))) { && (sexp_cdr(ls) >= sexp_make_fixnum(0))) {
sexp_write_string(ctx, " on line ", out); sexp_write_string(ctx, " on line ", out);
sexp_write(ctx, sexp_cdr(ls), out); sexp_write(ctx, sexp_cdr(ls), out);
} }
@ -218,7 +218,7 @@ static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) {
sexp_gc_var3(name, str, irr); sexp_gc_var3(name, str, irr);
sexp_gc_preserve3(ctx, name, str, irr); sexp_gc_preserve3(ctx, name, str, irr);
name = (sexp_port_name(port) ? sexp_port_name(port) : SEXP_FALSE); name = (sexp_port_name(port) ? sexp_port_name(port) : SEXP_FALSE);
name = sexp_cons(ctx, name, sexp_make_integer(sexp_port_line(port))); name = sexp_cons(ctx, name, sexp_make_fixnum(sexp_port_line(port)));
str = sexp_c_string(ctx, msg, -1); str = sexp_c_string(ctx, msg, -1);
irr = ((sexp_pairp(irritants) || sexp_nullp(irritants)) irr = ((sexp_pairp(irritants) || sexp_nullp(irritants))
? irritants : sexp_list1(ctx, irritants)); ? irritants : sexp_list1(ctx, irritants));
@ -320,7 +320,7 @@ sexp sexp_length (sexp ctx, sexp ls) {
sexp_uint_t res=0; sexp_uint_t res=0;
for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls)) for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls))
; ;
return sexp_make_integer(res); return sexp_make_fixnum(res);
} }
sexp sexp_equalp (sexp ctx, sexp a, sexp b) { sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
@ -334,17 +334,17 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
return return
sexp_make_boolean((a == b) sexp_make_boolean((a == b)
|| (sexp_flonump(a) || (sexp_flonump(a)
&& sexp_make_integer(sexp_flonum_value(a)) == b) && sexp_make_fixnum(sexp_flonum_value(a)) == b)
|| (sexp_flonump(b) || (sexp_flonump(b)
&& sexp_make_integer(sexp_flonum_value(b)) == a)); && sexp_make_fixnum(sexp_flonum_value(b)) == a));
#else #else
if (! sexp_pointerp(a)) if (! sexp_pointerp(a))
return sexp_make_boolean(sexp_integerp(a) && sexp_pointerp(b) return sexp_make_boolean(sexp_fixnump(a) && sexp_pointerp(b)
&& (sexp_unbox_integer(a) && (sexp_unbox_fixnum(a)
== sexp_flonum_value(b))); == sexp_flonum_value(b)));
else if (! sexp_pointerp(b)) else if (! sexp_pointerp(b))
return sexp_make_boolean(sexp_integerp(b) && sexp_pointerp(a) return sexp_make_boolean(sexp_fixnump(b) && sexp_pointerp(a)
&& (sexp_unbox_integer(b) && (sexp_unbox_fixnum(b)
== sexp_flonum_value(a))); == sexp_flonum_value(a)));
#endif #endif
if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) if (sexp_pointer_tag(a) != sexp_pointer_tag(b))
@ -395,9 +395,9 @@ sexp sexp_make_flonum(sexp ctx, double f) {
#endif #endif
sexp sexp_make_string(sexp ctx, sexp len, sexp ch) { sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
sexp_sint_t clen = sexp_unbox_integer(len); sexp_sint_t clen = sexp_unbox_fixnum(len);
sexp s; sexp s;
if (! sexp_integerp(len)) return sexp_type_exception(ctx, "bad length", len); if (! sexp_fixnump(len)) return sexp_type_exception(ctx, "bad length", len);
if (clen < 0) return sexp_type_exception(ctx, "negative length", len); if (clen < 0) return sexp_type_exception(ctx, "negative length", len);
s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1); s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1);
sexp_pointer_tag(s) = SEXP_STRING; sexp_pointer_tag(s) = SEXP_STRING;
@ -410,7 +410,7 @@ sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen) { sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen) {
sexp_sint_t len = ((slen >= 0) ? slen : strlen(str)); sexp_sint_t len = ((slen >= 0) ? slen : strlen(str));
sexp s = sexp_make_string(ctx, sexp_make_integer(len), SEXP_VOID); sexp s = sexp_make_string(ctx, sexp_make_fixnum(len), SEXP_VOID);
memcpy(sexp_string_data(s), str, len); memcpy(sexp_string_data(s), str, len);
sexp_string_data(s)[len] = '\0'; sexp_string_data(s)[len] = '\0';
return s; return s;
@ -420,21 +420,21 @@ sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
sexp res; sexp res;
if (! sexp_stringp(str)) if (! sexp_stringp(str))
return sexp_type_exception(ctx, "not a string", str); return sexp_type_exception(ctx, "not a string", str);
if (! sexp_integerp(start)) if (! sexp_fixnump(start))
return sexp_type_exception(ctx, "not a number", start); return sexp_type_exception(ctx, "not a number", start);
if (sexp_not(end)) if (sexp_not(end))
end = sexp_make_integer(sexp_string_length(str)); end = sexp_make_fixnum(sexp_string_length(str));
if (! sexp_integerp(end)) if (! sexp_fixnump(end))
return sexp_type_exception(ctx, "not a number", end); return sexp_type_exception(ctx, "not a number", end);
if ((sexp_unbox_integer(start) < 0) if ((sexp_unbox_fixnum(start) < 0)
|| (sexp_unbox_integer(start) > sexp_string_length(str)) || (sexp_unbox_fixnum(start) > sexp_string_length(str))
|| (sexp_unbox_integer(end) < 0) || (sexp_unbox_fixnum(end) < 0)
|| (sexp_unbox_integer(end) > sexp_string_length(str)) || (sexp_unbox_fixnum(end) > sexp_string_length(str))
|| (end < start)) || (end < start))
return sexp_range_exception(ctx, str, start, end); return sexp_range_exception(ctx, str, start, end);
res = sexp_make_string(ctx, sexp_fx_sub(end, start), SEXP_VOID); res = sexp_make_string(ctx, sexp_fx_sub(end, start), SEXP_VOID);
memcpy(sexp_string_data(res), memcpy(sexp_string_data(res),
sexp_string_data(str)+sexp_unbox_integer(start), sexp_string_data(str)+sexp_unbox_fixnum(start),
sexp_string_length(res)); sexp_string_length(res));
sexp_string_data(res)[sexp_string_length(res)] = '\0'; sexp_string_data(res)[sexp_string_length(res)] = '\0';
return res; return res;
@ -449,7 +449,7 @@ sexp sexp_string_concatenate (sexp ctx, sexp str_ls) {
return sexp_type_exception(ctx, "not a string", sexp_car(ls)); return sexp_type_exception(ctx, "not a string", sexp_car(ls));
else else
len += sexp_string_length(sexp_car(ls)); len += sexp_string_length(sexp_car(ls));
res = sexp_make_string(ctx, sexp_make_integer(len), SEXP_VOID); res = sexp_make_string(ctx, sexp_make_fixnum(len), SEXP_VOID);
p = sexp_string_data(res); p = sexp_string_data(res);
for (ls=str_ls; sexp_pairp(ls); ls=sexp_cdr(ls)) { for (ls=str_ls; sexp_pairp(ls); ls=sexp_cdr(ls)) {
len = sexp_string_length(sexp_car(ls)); len = sexp_string_length(sexp_car(ls));
@ -519,7 +519,7 @@ sexp sexp_string_to_symbol (sexp ctx, sexp str) {
sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) { sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
sexp v, *x; sexp v, *x;
int i, clen = sexp_unbox_integer(len); int i, clen = sexp_unbox_fixnum(len);
if (! clen) return the_empty_vector; if (! clen) return the_empty_vector;
v = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp), v = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp),
SEXP_VECTOR); SEXP_VECTOR);
@ -557,39 +557,39 @@ sexp sexp_make_cpointer (sexp ctx, void *value) {
#if SEXP_BSD #if SEXP_BSD
#define sexp_stream_ctx(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(0)) #define sexp_stream_ctx(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(0))
#define sexp_stream_buf(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(1)) #define sexp_stream_buf(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(1))
#define sexp_stream_size(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(2)) #define sexp_stream_size(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(2))
#define sexp_stream_pos(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(3)) #define sexp_stream_pos(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(3))
int sstream_read (void *vec, char *dst, int n) { int sstream_read (void *vec, char *dst, int n) {
sexp_uint_t len = sexp_unbox_integer(sexp_stream_size(vec)); sexp_uint_t len = sexp_unbox_fixnum(sexp_stream_size(vec));
sexp_uint_t pos = sexp_unbox_integer(sexp_stream_pos(vec)); sexp_uint_t pos = sexp_unbox_fixnum(sexp_stream_pos(vec));
if (pos >= len) return 0; if (pos >= len) return 0;
if (n > (len - pos)) n = (len - pos); if (n > (len - pos)) n = (len - pos);
memcpy(dst, sexp_string_data(sexp_stream_buf(vec))+pos, n); memcpy(dst, sexp_string_data(sexp_stream_buf(vec))+pos, n);
sexp_stream_pos(vec) = sexp_make_integer(n); sexp_stream_pos(vec) = sexp_make_fixnum(n);
return n; return n;
} }
int sstream_write (void *vec, const char *src, int n) { int sstream_write (void *vec, const char *src, int n) {
sexp_uint_t len, pos, newpos; sexp_uint_t len, pos, newpos;
sexp newbuf; sexp newbuf;
len = sexp_unbox_integer(sexp_stream_size(vec)); len = sexp_unbox_fixnum(sexp_stream_size(vec));
pos = sexp_unbox_integer(sexp_stream_pos(vec)); pos = sexp_unbox_fixnum(sexp_stream_pos(vec));
newpos = pos+n; newpos = pos+n;
if (newpos >= len) { if (newpos >= len) {
newbuf = sexp_make_string(sexp_stream_ctx(vec), newbuf = sexp_make_string(sexp_stream_ctx(vec),
sexp_make_integer(newpos*2), sexp_make_fixnum(newpos*2),
SEXP_VOID); SEXP_VOID);
memcpy(sexp_string_data(newbuf), memcpy(sexp_string_data(newbuf),
sexp_string_data(sexp_stream_buf(vec)), sexp_string_data(sexp_stream_buf(vec)),
pos); pos);
sexp_stream_buf(vec) = newbuf; sexp_stream_buf(vec) = newbuf;
sexp_stream_size(vec) = sexp_make_integer(newpos*2); sexp_stream_size(vec) = sexp_make_fixnum(newpos*2);
} }
memcpy(sexp_string_data(sexp_stream_buf(vec))+pos, src, n); memcpy(sexp_string_data(sexp_stream_buf(vec))+pos, src, n);
sexp_stream_pos(vec) = sexp_make_integer(newpos); sexp_stream_pos(vec) = sexp_make_fixnum(newpos);
return n; return n;
} }
@ -598,11 +598,11 @@ off_t sstream_seek (void *vec, off_t offset, int whence) {
if (whence == SEEK_SET) { if (whence == SEEK_SET) {
pos = offset; pos = offset;
} else if (whence == SEEK_CUR) { } else if (whence == SEEK_CUR) {
pos = sexp_unbox_integer(sexp_stream_pos(vec)) + offset; pos = sexp_unbox_fixnum(sexp_stream_pos(vec)) + offset;
} else { /* SEEK_END */ } else { /* SEEK_END */
pos = sexp_unbox_integer(sexp_stream_size(vec)) + offset; pos = sexp_unbox_fixnum(sexp_stream_size(vec)) + offset;
} }
sexp_stream_pos(vec) = sexp_make_integer(pos); sexp_stream_pos(vec) = sexp_make_fixnum(pos);
return pos; return pos;
} }
@ -611,11 +611,11 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
sexp res; sexp res;
sexp_gc_var1(cookie); sexp_gc_var1(cookie);
sexp_gc_preserve1(ctx, cookie); sexp_gc_preserve1(ctx, cookie);
cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID); cookie = sexp_make_vector(ctx, sexp_make_fixnum(4), SEXP_VOID);
sexp_stream_ctx(cookie) = ctx; sexp_stream_ctx(cookie) = ctx;
sexp_stream_buf(cookie) = str; sexp_stream_buf(cookie) = str;
sexp_stream_size(cookie) = sexp_make_integer(sexp_string_length(str)); sexp_stream_size(cookie) = sexp_make_fixnum(sexp_string_length(str));
sexp_stream_pos(cookie) = sexp_make_integer(0); sexp_stream_pos(cookie) = sexp_make_fixnum(0);
in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL); in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL);
res = sexp_make_input_port(ctx, in, SEXP_FALSE); res = sexp_make_input_port(ctx, in, SEXP_FALSE);
sexp_port_cookie(res) = cookie; sexp_port_cookie(res) = cookie;
@ -628,12 +628,12 @@ sexp sexp_make_output_string_port (sexp ctx) {
sexp res, size; sexp res, size;
sexp_gc_var1(cookie); sexp_gc_var1(cookie);
sexp_gc_preserve1(ctx, cookie); sexp_gc_preserve1(ctx, cookie);
size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE); size = sexp_make_fixnum(SEXP_INIT_STRING_PORT_SIZE);
cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID); cookie = sexp_make_vector(ctx, sexp_make_fixnum(4), SEXP_VOID);
sexp_stream_ctx(cookie) = ctx; sexp_stream_ctx(cookie) = ctx;
sexp_stream_buf(cookie) = sexp_make_string(ctx, size, SEXP_VOID); sexp_stream_buf(cookie) = sexp_make_string(ctx, size, SEXP_VOID);
sexp_stream_size(cookie) = size; sexp_stream_size(cookie) = size;
sexp_stream_pos(cookie) = sexp_make_integer(0); sexp_stream_pos(cookie) = sexp_make_fixnum(0);
out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL); out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL);
res = sexp_make_output_port(ctx, out, SEXP_FALSE); res = sexp_make_output_port(ctx, out, SEXP_FALSE);
sexp_port_cookie(res) = cookie; sexp_port_cookie(res) = cookie;
@ -646,7 +646,7 @@ sexp sexp_get_output_string (sexp ctx, sexp port) {
fflush(sexp_port_stream(port)); fflush(sexp_port_stream(port));
return sexp_substring(ctx, return sexp_substring(ctx,
sexp_stream_buf(cookie), sexp_stream_buf(cookie),
sexp_make_integer(0), sexp_make_fixnum(0),
sexp_stream_pos(cookie)); sexp_stream_pos(cookie));
} }
@ -883,8 +883,8 @@ void sexp_write (sexp ctx, sexp obj, sexp out) {
sexp_write_char(ctx, '>', out); sexp_write_char(ctx, '>', out);
break; break;
} }
} else if (sexp_integerp(obj)) { } else if (sexp_fixnump(obj)) {
sprintf(numbuf, "%ld", sexp_unbox_integer(obj)); sprintf(numbuf, "%ld", sexp_unbox_fixnum(obj));
sexp_write_string(ctx, numbuf, out); sexp_write_string(ctx, numbuf, out);
#if USE_IMMEDIATE_FLONUMS #if USE_IMMEDIATE_FLONUMS
} else if (sexp_flonump(obj)) { } else if (sexp_flonump(obj)) {
@ -1024,7 +1024,7 @@ sexp sexp_read_float_tail(sexp ctx, sexp in, sexp_uint_t whole, int negp) {
if (c=='e' || c=='E') { if (c=='e' || c=='E') {
exponent = sexp_read_number(ctx, in, 10); exponent = sexp_read_number(ctx, in, 10);
if (sexp_exceptionp(exponent)) return exponent; if (sexp_exceptionp(exponent)) return exponent;
e = (sexp_integerp(exponent) ? sexp_unbox_integer(exponent) e = (sexp_fixnump(exponent) ? sexp_unbox_fixnum(exponent)
: sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0); : sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0);
} else if ((c!=EOF) && ! is_separator(c)) { } else if ((c!=EOF) && ! is_separator(c)) {
return sexp_read_error(ctx, "invalid numeric syntax", return sexp_read_error(ctx, "invalid numeric syntax",
@ -1035,7 +1035,7 @@ sexp sexp_read_float_tail(sexp ctx, sexp in, sexp_uint_t whole, int negp) {
res = ((double)whole + res) * pow(10, e); res = ((double)whole + res) * pow(10, e);
if (negp) res *= -1; if (negp) res *= -1;
if ((scale == 0.1) && (exponent != SEXP_VOID) && (res == round(res))) if ((scale == 0.1) && (exponent != SEXP_VOID) && (res == round(res)))
return sexp_make_integer(res); return sexp_make_fixnum(res);
else else
return sexp_make_flonum(ctx, res); return sexp_make_flonum(ctx, res);
} }
@ -1072,11 +1072,11 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) {
return sexp_read_float_tail(ctx, in, res, negativep); return sexp_read_float_tail(ctx, in, res, negativep);
} else if (c=='/') { } else if (c=='/') {
den = sexp_read_number(ctx, in, base); den = sexp_read_number(ctx, in, base);
if (! sexp_integerp(den)) if (! sexp_fixnump(den))
return (sexp_exceptionp(den) return (sexp_exceptionp(den)
? den : sexp_read_error(ctx, "invalid rational syntax", den, in)); ? den : sexp_read_error(ctx, "invalid rational syntax", den, in));
return sexp_make_flonum(ctx, (double)(negativep ? -res : res) return sexp_make_flonum(ctx, (double)(negativep ? -res : res)
/ (double)sexp_unbox_integer(den)); / (double)sexp_unbox_fixnum(den));
} else { } else {
if ((c!=EOF) && ! is_separator(c)) if ((c!=EOF) && ! is_separator(c))
return sexp_read_error(ctx, "invalid numeric syntax", return sexp_read_error(ctx, "invalid numeric syntax",
@ -1084,7 +1084,7 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) {
sexp_push_char(ctx, c, in); sexp_push_char(ctx, c, in);
} }
return sexp_make_integer(negativep ? -res : res); return sexp_make_fixnum(negativep ? -res : res);
} }
sexp sexp_read_raw (sexp ctx, sexp in) { sexp sexp_read_raw (sexp ctx, sexp in) {
@ -1177,7 +1177,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
} }
if ((line >= 0) && sexp_pairp(res)) { if ((line >= 0) && sexp_pairp(res)) {
sexp_pair_source(res) sexp_pair_source(res)
= sexp_cons(ctx, sexp_port_name(in), sexp_make_integer(line)); = sexp_cons(ctx, sexp_port_name(in), sexp_make_fixnum(line));
} }
if (sexp_port_sourcep(in)) if (sexp_port_sourcep(in))
for (tmp=res; sexp_pairp(tmp); tmp=sexp_cdr(tmp)) for (tmp=res; sexp_pairp(tmp); tmp=sexp_cdr(tmp))
@ -1196,12 +1196,12 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
case 'e': case 'e':
res = sexp_read(ctx, in); res = sexp_read(ctx, in);
if (sexp_flonump(res)) if (sexp_flonump(res))
res = sexp_make_integer((sexp_sint_t)sexp_flonum_value(res)); res = sexp_make_fixnum((sexp_sint_t)sexp_flonum_value(res));
break; break;
case 'i': case 'i':
res = sexp_read(ctx, in); res = sexp_read(ctx, in);
if (sexp_integerp(res)) if (sexp_fixnump(res))
res = sexp_make_flonum(ctx, sexp_unbox_integer(res)); res = sexp_make_flonum(ctx, sexp_unbox_fixnum(res));
break; break;
case 'f': case 'f':
case 't': case 't':
@ -1308,7 +1308,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
sexp_bignum_sign(res) = -sexp_bignum_sign(res); sexp_bignum_sign(res) = -sexp_bignum_sign(res);
else else
#endif #endif
res = sexp_fx_mul(res, sexp_make_integer(-1)); res = sexp_fx_mul(res, sexp_make_fixnum(-1));
} }
} else { } else {
sexp_push_char(ctx, c2, in); sexp_push_char(ctx, c2, in);