Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 21:59:17 +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_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_alloc_tagged(ctx, sexp_sizeof(bytecode)+INIT_BCODE_SIZE,
SEXP_BYTECODE);
@ -690,9 +690,9 @@ static sexp analyze (sexp ctx, sexp object) {
/* res = analyze(tmp, x); */
} else if (sexp_opcodep(op)) {
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);
} 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))) {
res = sexp_compile_error(ctx, "too many args for opcode", x);
} else {
@ -855,7 +855,7 @@ static void generate_opcode_app (sexp ctx, sexp app) {
sexp_gc_var1(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;
/* 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) {
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);
sexp_gc_var1(ls);
sexp_gc_preserve1(ctx, ls);
@ -950,7 +950,7 @@ static void generate_general_app (sexp ctx, sexp app) {
/* maybe overwrite the current frame */
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_gc_release1(ctx);
@ -991,14 +991,14 @@ static void generate_lambda (sexp ctx, sexp lambda) {
}
sexp_context_tailp(ctx2) = 1;
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);
len = sexp_length(ctx2, sexp_lambda_params(lambda));
bc = finalize_bytecode(ctx2);
sexp_bytecode_name(bc) = sexp_lambda_name(lambda);
if (sexp_nullp(fv)) {
/* 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);
sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), tmp);
generate_lit(ctx, tmp);
@ -1012,7 +1012,7 @@ static void generate_lambda (sexp ctx, sexp lambda) {
ref = sexp_car(fv);
generate_non_global_ref(ctx, sexp_ref_name(ref), sexp_ref_cell(ref),
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_word(ctx, 3);
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);
res = SEXP_NULL;
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);
return res;
}
@ -1141,7 +1141,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) {
generate_opcode_app(ctx2, refs);
bc = finalize_bytecode(ctx2);
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);
if (i == sexp_opcode_num_args(op))
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) {
sexp res, *data;
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);
for (i=0; i<to; i++)
data[i] = stack[i];
@ -1221,9 +1221,9 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_RAISE:
call_error_handler:
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+3] = sexp_make_integer(fp);
stack[top+3] = sexp_make_fixnum(fp);
top += 4;
self = env_global_ref(env, the_err_handler_symbol, SEXP_FALSE);
bc = sexp_procedure_code(self);
@ -1234,29 +1234,29 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_RESUMECC:
tmp1 = stack[fp-1];
top = sexp_restore_stack(sexp_vector_ref(cp, 0), stack);
fp = sexp_unbox_integer(_ARG1);
fp = sexp_unbox_fixnum(_ARG1);
self = _ARG2;
bc = sexp_procedure_code(self);
cp = sexp_procedure_vars(self);
ip = sexp_bytecode_data(bc) + sexp_unbox_integer(_ARG3);
i = sexp_unbox_integer(_ARG4);
ip = sexp_bytecode_data(bc) + sexp_unbox_fixnum(_ARG3);
i = sexp_unbox_fixnum(_ARG4);
top -= 4;
_ARG1 = tmp1;
break;
case OP_CALLCC:
stack[top] = sexp_make_integer(1);
stack[top+1] = sexp_make_integer(ip-sexp_bytecode_data(bc));
stack[top] = sexp_make_fixnum(1);
stack[top+1] = sexp_make_fixnum(ip-sexp_bytecode_data(bc));
stack[top+2] = self;
stack[top+3] = sexp_make_integer(fp);
stack[top+3] = sexp_make_fixnum(fp);
tmp1 = _ARG1;
i = 1;
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_make_integer(0),
sexp_make_fixnum(0),
sexp_save_stack(ctx, stack, top+4));
_ARG1 = sexp_make_procedure(ctx, sexp_make_integer(0),
sexp_make_integer(1), continuation_resumer,
_ARG1 = sexp_make_procedure(ctx, sexp_make_fixnum(0),
sexp_make_fixnum(1), continuation_resumer,
tmp2);
top++;
ip -= sizeof(sexp);
@ -1264,7 +1264,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_APPLY1:
tmp1 = _ARG1;
tmp2 = _ARG2;
i = sexp_unbox_integer(sexp_length(ctx, tmp2));
i = sexp_unbox_fixnum(sexp_length(ctx, tmp2));
top += (i-2);
for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
_ARG1 = sexp_car(tmp2);
@ -1272,28 +1272,28 @@ sexp sexp_vm (sexp ctx, sexp proc) {
ip -= sizeof(sexp);
goto make_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 */
/* save frame info */
tmp2 = stack[fp+3];
j = sexp_unbox_integer(stack[fp]);
j = sexp_unbox_fixnum(stack[fp]);
self = stack[fp+2];
bc = sexp_procedure_vars(self);
cp = sexp_procedure_vars(self);
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 */
for (k=0; k<i; k++)
stack[fp-j+k] = stack[top-1-i+k];
top = fp+i-j+1;
fp = sexp_unbox_integer(tmp2);
fp = sexp_unbox_fixnum(tmp2);
goto make_call;
case OP_CALL:
#if USE_CHECK_STACK
if (top+16 >= INIT_STACK_SIZE)
errx(70, "out of stack space at %ld", top);
#endif
i = sexp_unbox_integer(_WORD0);
i = sexp_unbox_fixnum(_WORD0);
tmp1 = _ARG1;
make_call:
if (sexp_opcodep(tmp1)) {
@ -1307,10 +1307,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
}
if (! sexp_procedurep(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)
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 (sexp_procedure_variadic_p(tmp1)) {
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);
} else {
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)) {
/* shift stack, set extra arg to null */
@ -1332,10 +1332,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top++;
i++;
}
_ARG1 = sexp_make_integer(i);
stack[top] = sexp_make_integer(ip+sizeof(sexp)-sexp_bytecode_data(bc));
_ARG1 = sexp_make_fixnum(i);
stack[top] = sexp_make_fixnum(ip+sizeof(sexp)-sexp_bytecode_data(bc));
stack[top+1] = self;
stack[top+2] = sexp_make_integer(fp);
stack[top+2] = sexp_make_fixnum(fp);
top += 3;
self = tmp1;
bc = sexp_procedure_code(self);
@ -1436,7 +1436,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
ip += sizeof(sexp);
break;
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);
break;
case OP_VECTOR_REF:
@ -1455,7 +1455,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top-=2;
break;
case OP_VECTOR_LENGTH:
_ARG1 = sexp_make_integer(sexp_vector_length(_ARG1));
_ARG1 = sexp_make_fixnum(sexp_vector_length(_ARG1));
break;
case OP_STRING_REF:
_ARG2 = sexp_string_ref(_ARG1, _ARG2);
@ -1471,7 +1471,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top-=2;
break;
case OP_STRING_LENGTH:
_ARG1 = sexp_make_integer(sexp_string_length(_ARG1));
_ARG1 = sexp_make_fixnum(sexp_string_length(_ARG1));
break;
case OP_MAKE_PROCEDURE:
sexp_context_top(ctx) = top;
@ -1493,9 +1493,6 @@ sexp sexp_vm (sexp ctx, sexp proc) {
_ARG1 = sexp_make_boolean(sexp_nullp(_ARG1)); break;
case OP_INTEGERP:
j = sexp_integerp(_ARG1);
#if USE_BIGNUMS
if (! j) j = sexp_bignump(_ARG1);
#endif
#if USE_FLONUMS
if (! j)
j = (sexp_flonump(_ARG1)
@ -1509,7 +1506,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
_ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break;
case OP_TYPEP:
_ARG1 = sexp_make_boolean(sexp_pointerp(_ARG1)
&& (sexp_make_integer(sexp_pointer_tag(_ARG1))
&& (sexp_make_fixnum(sexp_pointer_tag(_ARG1))
== _WORD0));
ip += sizeof(sexp);
break;
@ -1547,25 +1544,25 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_ADD:
#if USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2;
if (sexp_integerp(tmp1) && sexp_integerp(tmp2)) {
j = sexp_unbox_integer(tmp1) + sexp_unbox_integer(tmp2);
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
j = sexp_unbox_fixnum(tmp1) + sexp_unbox_fixnum(tmp2);
if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM))
_ARG2 = sexp_add(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
else
_ARG2 = sexp_make_integer(j);
_ARG2 = sexp_make_fixnum(j);
}
else
_ARG2 = sexp_add(ctx, tmp1, tmp2);
#else
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2))
if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_fx_add(_ARG1, _ARG2);
#if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_add(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) + (double)sexp_unbox_integer(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) + sexp_flonum_value(_ARG2));
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) + (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) + sexp_flonum_value(_ARG2));
#endif
else sexp_raise("+: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif
@ -1574,25 +1571,25 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_SUB:
#if USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2;
if (sexp_integerp(tmp1) && sexp_integerp(tmp2)) {
j = sexp_unbox_integer(tmp1) - sexp_unbox_integer(tmp2);
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
j = sexp_unbox_fixnum(tmp1) - sexp_unbox_fixnum(tmp2);
if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM))
_ARG2 = sexp_sub(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
else
_ARG2 = sexp_make_integer(j);
_ARG2 = sexp_make_fixnum(j);
}
else
_ARG2 = sexp_sub(ctx, tmp1, tmp2);
#else
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2))
if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_fx_sub(_ARG1, _ARG2);
#if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_sub(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) - (double)sexp_unbox_integer(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) - sexp_flonum_value(_ARG2));
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) - (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) - sexp_flonum_value(_ARG2));
#endif
else sexp_raise("-: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif
@ -1601,45 +1598,45 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case OP_MUL:
#if USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2;
if (sexp_integerp(tmp1) && sexp_integerp(tmp2)) {
prod = sexp_unbox_integer(tmp1) * sexp_unbox_integer(tmp2);
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
prod = sexp_unbox_fixnum(tmp1) * sexp_unbox_fixnum(tmp2);
if ((prod < SEXP_MIN_FIXNUM) || (prod > SEXP_MAX_FIXNUM))
_ARG2 = sexp_mul(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
else
_ARG2 = sexp_make_integer(prod);
_ARG2 = sexp_make_fixnum(prod);
}
else
_ARG2 = sexp_mul(ctx, tmp1, tmp2);
#else
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2))
if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_fx_mul(_ARG1, _ARG2);
#if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_mul(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) * (double)sexp_unbox_integer(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) * sexp_flonum_value(_ARG2));
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) * (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) * sexp_flonum_value(_ARG2));
#endif
else sexp_raise("*: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif
top--;
break;
case OP_DIV:
if (_ARG2 == sexp_make_integer(0)) {
if (_ARG2 == sexp_make_fixnum(0)) {
#if USE_FLONUMS
if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0)
_ARG2 = sexp_make_flonum(ctx, 0.0/0.0);
else
#endif
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
_ARG1 = sexp_integer_to_flonum(ctx, _ARG1);
_ARG2 = sexp_integer_to_flonum(ctx, _ARG2);
_ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1);
_ARG2 = sexp_fixnum_to_flonum(ctx, _ARG2);
_ARG2 = sexp_fp_div(ctx, _ARG1, _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
_ARG2 = sexp_fx_div(_ARG1, _ARG2);
#endif
@ -1651,18 +1648,18 @@ sexp sexp_vm (sexp ctx, sexp proc) {
#if USE_FLONUMS
else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) / (double)sexp_unbox_integer(_ARG2));
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_integer(_ARG1) / sexp_flonum_value(_ARG2));
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, sexp_flonum_value(_ARG1) / (double)sexp_unbox_fixnum(_ARG2));
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
_ARG2 = sexp_make_flonum(ctx, (double)sexp_unbox_fixnum(_ARG1) / sexp_flonum_value(_ARG2));
#endif
else sexp_raise("/: not a number", sexp_list2(ctx, _ARG1, _ARG2));
#endif
top--;
break;
case OP_QUOTIENT:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) {
if (_ARG2 == sexp_make_integer(0))
if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
if (_ARG2 == sexp_make_fixnum(0))
sexp_raise("divide by zero", SEXP_NULL);
_ARG2 = sexp_fx_div(_ARG1, _ARG2);
top--;
@ -1677,8 +1674,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
#endif
break;
case OP_REMAINDER:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) {
if (_ARG2 == sexp_make_integer(0))
if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
if (_ARG2 == sexp_make_fixnum(0))
sexp_raise("divide by zero", SEXP_NULL);
tmp1 = sexp_fx_rem(_ARG1, _ARG2);
top--;
@ -1694,8 +1691,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
#endif
break;
case OP_NEGATIVE:
if (sexp_integerp(_ARG1))
_ARG1 = sexp_make_integer(-sexp_unbox_integer(_ARG1));
if (sexp_fixnump(_ARG1))
_ARG1 = sexp_make_fixnum(-sexp_unbox_fixnum(_ARG1));
#if USE_BIGNUMS
else if (sexp_bignump(_ARG1)) {
_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));
break;
case OP_INVERSE:
if (sexp_integerp(_ARG1))
_ARG1 = sexp_make_flonum(ctx, 1/(double)sexp_unbox_integer(_ARG1));
if (sexp_fixnump(_ARG1))
_ARG1 = sexp_make_flonum(ctx, 1/(double)sexp_unbox_fixnum(_ARG1));
#if USE_FLONUMS
else if (sexp_flonump(_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));
break;
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;
#if USE_BIGNUMS
_ARG2 = sexp_make_boolean(i);
} else {
tmp1 = sexp_compare(ctx, _ARG1, _ARG2);
_ARG2 = sexp_integerp(tmp1)
? sexp_make_boolean(sexp_unbox_integer(tmp1) < 0) : tmp1;
_ARG2 = sexp_fixnump(tmp1)
? sexp_make_boolean(sexp_unbox_fixnum(tmp1) < 0) : tmp1;
}
#else
#if USE_FLONUMS
} else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
i = sexp_flonum_value(_ARG1) < sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
i = sexp_flonum_value(_ARG1) < (double)sexp_unbox_integer(_ARG2);
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_integer(_ARG1) < sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
i = sexp_flonum_value(_ARG1) < (double)sexp_unbox_fixnum(_ARG2);
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_fixnum(_ARG1) < sexp_flonum_value(_ARG2);
#endif
else sexp_raise("<: not a number", sexp_list2(ctx, _ARG1, _ARG2));
_ARG2 = sexp_make_boolean(i);
@ -1742,23 +1739,23 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--;
break;
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;
#if USE_BIGNUMS
_ARG2 = sexp_make_boolean(i);
} else {
tmp1 = sexp_compare(ctx, _ARG1, _ARG2);
_ARG2 = sexp_integerp(tmp1)
? sexp_make_boolean(sexp_unbox_integer(tmp1) <= 0) : tmp1;
_ARG2 = sexp_fixnump(tmp1)
? sexp_make_boolean(sexp_unbox_fixnum(tmp1) <= 0) : tmp1;
}
#else
#if USE_FLONUMS
} else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
i = sexp_flonum_value(_ARG1) <= sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
i = sexp_flonum_value(_ARG1) <= (double)sexp_unbox_integer(_ARG2);
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_integer(_ARG1) <= sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
i = sexp_flonum_value(_ARG1) <= (double)sexp_unbox_fixnum(_ARG2);
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_fixnum(_ARG1) <= sexp_flonum_value(_ARG2);
#endif
else sexp_raise("<=: not a number", sexp_list2(ctx, _ARG1, _ARG2));
_ARG2 = sexp_make_boolean(i);
@ -1766,23 +1763,23 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--;
break;
case OP_EQN:
if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) {
if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) {
i = _ARG1 == _ARG2;
#if USE_BIGNUMS
_ARG2 = sexp_make_boolean(i);
} else {
tmp1 = sexp_compare(ctx, _ARG1, _ARG2);
_ARG2 = sexp_integerp(tmp1)
? sexp_make_boolean(sexp_unbox_integer(tmp1) == 0) : tmp1;
_ARG2 = sexp_fixnump(tmp1)
? sexp_make_boolean(sexp_unbox_fixnum(tmp1) == 0) : tmp1;
}
#else
#if USE_FLONUMS
} else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2))
i = sexp_flonum_value(_ARG1) == sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_integerp(_ARG2))
i = sexp_flonum_value(_ARG1) == (double)sexp_unbox_integer(_ARG2);
else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_integer(_ARG1) == sexp_flonum_value(_ARG2);
else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2))
i = sexp_flonum_value(_ARG1) == (double)sexp_unbox_fixnum(_ARG2);
else if (sexp_fixnump(_ARG1) && sexp_flonump(_ARG2))
i = (double)sexp_unbox_fixnum(_ARG1) == sexp_flonum_value(_ARG2);
#endif
else sexp_raise("=: not a number", sexp_list2(ctx, _ARG1, _ARG2));
_ARG2 = sexp_make_boolean(i);
@ -1794,8 +1791,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--;
break;
case OP_FIX2FLO:
if (sexp_integerp(_ARG1))
_ARG1 = sexp_integer_to_flonum(ctx, _ARG1);
if (sexp_fixnump(_ARG1))
_ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1);
#if USE_BIGNUMS
else if (sexp_bignump(_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) {
_ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1));
} 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));
}
break;
case OP_CHAR2INT:
_ARG1 = sexp_make_integer(sexp_unbox_character(_ARG1));
_ARG1 = sexp_make_fixnum(sexp_unbox_character(_ARG1));
break;
case OP_INT2CHAR:
_ARG1 = sexp_make_character(sexp_unbox_integer(_ARG1));
_ARG1 = sexp_make_character(sexp_unbox_fixnum(_ARG1));
break;
case OP_CHAR_UPCASE:
_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);
break;
case OP_RET:
i = sexp_unbox_integer(stack[fp]);
i = sexp_unbox_fixnum(stack[fp]);
stack[fp-i] = _ARG1;
top = fp-i+1;
self = stack[fp+2];
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);
fp = sexp_unbox_integer(stack[fp+3]);
fp = sexp_unbox_fixnum(stack[fp+3]);
break;
case OP_DONE:
goto end_loop;
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;
@ -2011,8 +2008,8 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
double d; \
if (sexp_flonump(z)) \
d = sexp_flonum_value(z); \
else if (sexp_integerp(z)) \
d = (double)sexp_unbox_integer(z); \
else if (sexp_fixnump(z)) \
d = (double)sexp_unbox_fixnum(z); \
maybe_convert_bignum(z) \
else \
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;
#if USE_BIGNUMS
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));
else if (x == sexp_make_integer(1))
res = sexp_make_flonum(ctx, sexp_unbox_integer(x));
else if (x == sexp_make_fixnum(1))
res = sexp_make_flonum(ctx, sexp_unbox_fixnum(x));
else if (sexp_flonump(x))
res = sexp_make_flonum(ctx, pow(sexp_flonum_value(x), sexp_bignum_to_double(e)));
else
@ -2052,16 +2049,16 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
res = sexp_bignum_expt(ctx, x, e);
} else {
#endif
if (sexp_integerp(x))
x1 = (double)sexp_unbox_integer(x);
if (sexp_fixnump(x))
x1 = (double)sexp_unbox_fixnum(x);
#if USE_FLONUMS
else if (sexp_flonump(x))
x1 = sexp_flonum_value(x);
#endif
else
return sexp_type_exception(ctx, "not a number", x);
if (sexp_integerp(e))
e1 = (double)sexp_unbox_integer(e);
if (sexp_fixnump(e))
e1 = (double)sexp_unbox_fixnum(e);
#if USE_FLONUMS
else if (sexp_flonump(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);
} else
#endif
res = sexp_make_integer((sexp_sint_t)round(f));
res = sexp_make_fixnum((sexp_sint_t)round(f));
#if USE_BIGNUMS
}
#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);
if (! diff)
diff = len1 - len2;
return sexp_make_integer(diff);
return sexp_make_fixnum(diff);
}
#ifdef PLAN9
@ -2193,8 +2190,8 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
emit(ctx2, OP_DONE);
tmp = sexp_make_vector(ctx2, 0, SEXP_VOID);
err_handler = sexp_make_procedure(ctx2,
sexp_make_integer(0),
sexp_make_integer(0),
sexp_make_fixnum(0),
sexp_make_fixnum(0),
finalize_bytecode(ctx2),
tmp);
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 ls, *stack = sexp_stack_data(sexp_context_stack(ctx));
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++)
stack[--offset] = sexp_car(ls);
stack[top] = sexp_make_integer(top);
stack[top] = sexp_make_fixnum(top);
top++;
sexp_context_top(ctx) = top + 3;
stack[top++] = sexp_make_integer(0);
stack[top++] = sexp_make_fixnum(0);
stack[top++] = final_resumer;
stack[top++] = sexp_make_integer(0);
stack[top++] = sexp_make_fixnum(0);
return sexp_vm(ctx, proc);
}
@ -2250,7 +2247,7 @@ sexp sexp_compile (sexp ctx, sexp x) {
generate(ctx, ast);
res = finalize_bytecode(ctx);
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);
}
sexp_gc_release4(ctx);
@ -2311,8 +2308,8 @@ void sexp_scheme_init (void) {
ctx = sexp_make_child_context(ctx, NULL);
emit(ctx, OP_DONE);
final_resumer = sexp_make_procedure(ctx,
sexp_make_integer(0),
sexp_make_integer(0),
sexp_make_fixnum(0),
sexp_make_fixnum(0),
finalize_bytecode(ctx),
sexp_make_vector(ctx, 0, SEXP_VOID));
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;
return sexp_make_integer(max_freed);
return sexp_make_fixnum(max_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);
res = sexp_try_alloc(ctx, size);
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);
if (((max_freed < size)
|| ((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_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_charp(x) (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_CHAR_TAG)
#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_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_unbox_integer(n) (((sexp_sint_t)(n))>>SEXP_FIXNUM_BITS)
#define sexp_make_fixnum(n) ((sexp) ((((sexp_sint_t)(n))<<SEXP_FIXNUM_BITS) + SEXP_FIXNUM_TAG))
#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_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
#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
#define sexp_integer_to_flonum(ctx, x) (x)
#define sexp_fixnum_to_flonum(ctx, x) (x)
#endif
/*************************** 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_data(x) ((x)->value.vector.data)
#define sexp_vector_ref(x,i) (sexp_vector_data(x)[sexp_unbox_integer(i)])
#define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_integer(i)]=(v))
#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_fixnum(i)]=(v))
#define sexp_procedure_num_args(x) ((x)->value.procedure.num_args)
#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_vars(x) ((x)->value.procedure.vars)
#define sexp_string_length(x) ((x)->value.string.length)
#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_set(x, i, v) (sexp_string_data(x)[sexp_unbox_integer(i)] = sexp_unbox_character(v))
#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_fixnum(i)] = sexp_unbox_character(v))
#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_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_div(a, b) (sexp_make_integer(sexp_unbox_integer(a) / sexp_unbox_integer(b)))
#define sexp_fx_rem(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_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_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_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_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_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_integer(0), NULL),
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_integer(1), 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_fixnum(1), 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, 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_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_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_integer(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, "vector?", sexp_make_integer(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, "closure?", sexp_make_integer(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, "input-port?", sexp_make_integer(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, "pair?", sexp_make_fixnum(SEXP_PAIR), 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_fixnum(SEXP_VECTOR), 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_fixnum(SEXP_PROCEDURE), 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_fixnum(SEXP_IPORT), 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_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),

78
opt/bignum.c
View file

@ -7,7 +7,7 @@
#define sexp_negate(x) \
if (sexp_bignump(x)) \
sexp_bignum_sign(x) = -sexp_bignum_sign(x); \
else if (sexp_integerp(x)) \
else if (sexp_fixnump(x)) \
x = sexp_fx_neg(x);
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 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);
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_10s_digit(f) ((f)-double_trunc_10s_digit(f))
@ -32,8 +44,8 @@ sexp sexp_double_to_bignum (sexp ctx, double f) {
int sign;
sexp_gc_var3(res, scale, tmp);
sexp_gc_preserve3(ctx, res, scale, tmp);
res = sexp_fixnum_to_bignum(ctx, sexp_make_integer(0));
scale = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1));
res = sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(0));
scale = sexp_fixnum_to_bignum(ctx, sexp_make_fixnum(1));
sign = (f < 0 ? -1 : 1);
for (f=fabs(f); f >= 1.0; f=trunc(f/10)) {
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)
&& ! ((sexp_bignum_sign(a) == -1) && (data[0] == SEXP_MAX_FIXNUM+1)))
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) {
@ -226,7 +238,7 @@ sexp sexp_write_bignum (sexp ctx, sexp a, sexp out, sexp_uint_t base) {
sexp_bignum_sign(b) = 1;
i = str_len = (sexp_bignum_length(b)*sizeof(sexp_uint_t)*8 + 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(' '));
data = sexp_string_data(str);
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);
c = sexp_copy_bignum(ctx, NULL, a, 0);
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
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);
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);
if (sexp_bignum_compare(k, a) > 0) {
*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);
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);
sexp_bignum_sign(b1) = 1;
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);
sexp_bignum_sign(res) = sexp_bignum_sign(a) * sexp_bignum_sign(b);
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_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_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);
for (; e; e>>=1, acc=sexp_bignum_mul(ctx, NULL, acc, acc))
if (e & 1)
@ -460,7 +472,7 @@ static int sexp_number_types[SEXP_NUM_TYPES] =
static int sexp_number_type (sexp 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) {
@ -476,7 +488,7 @@ sexp sexp_add (sexp ctx, sexp a, sexp b) {
r = sexp_fx_add(a, b); /* XXXX check overflow */
break;
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;
case SEXP_NUM_FIX_BIG:
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 */
break;
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;
case SEXP_NUM_FIX_BIG:
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);
break;
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;
case SEXP_NUM_FLO_FLO:
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);
break;
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;
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);
break;
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);
break;
case SEXP_NUM_FIX_FIX:
f = sexp_integer_to_double(a) / sexp_integer_to_double(b);
r = ((f == trunc(f)) ? sexp_make_integer((sexp_sint_t)f)
f = sexp_fixnum_to_double(a) / sexp_fixnum_to_double(b);
r = ((f == trunc(f)) ? sexp_make_fixnum((sexp_sint_t)f)
: sexp_make_flonum(ctx, f));
break;
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;
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;
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;
case SEXP_NUM_FLO_FLO:
r = sexp_fp_div(ctx, a, b);
@ -606,9 +618,9 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
/* ... FALLTHROUGH ... */
case SEXP_NUM_BIG_BIG:
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)
/ sexp_integer_to_double(b));
/ sexp_fixnum_to_double(b));
else
r = sexp_bignum_normalize(r);
break;
@ -640,7 +652,7 @@ sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
r = sexp_fx_div(a, b);
break;
case SEXP_NUM_FIX_BIG:
r = sexp_make_integer(0);
r = sexp_make_fixnum(0);
break;
case SEXP_NUM_BIG_FIX:
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);
break;
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;
case SEXP_NUM_FIX_FLO:
f = sexp_integer_to_double(a) - sexp_flonum_value(b);
r = sexp_make_integer(f > 0.0 ? 1 : f == 0.0 ? 0 : -1);
f = sexp_fixnum_to_double(a) - sexp_flonum_value(b);
r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1);
break;
case SEXP_NUM_FIX_BIG:
r = sexp_make_integer(-1);
r = sexp_make_fixnum(-1);
break;
case SEXP_NUM_FLO_FLO:
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;
case SEXP_NUM_FLO_BIG:
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;
case SEXP_NUM_BIG_BIG:
r = sexp_make_integer(sexp_bignum_compare(a, b));
r = sexp_make_fixnum(sexp_bignum_compare(a, b));
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))) {
ls = sexp_exception_source(exn);
if (sexp_integerp(sexp_cdr(ls))
&& (sexp_cdr(ls) >= sexp_make_integer(0))) {
if (sexp_fixnump(sexp_cdr(ls))
&& (sexp_cdr(ls) >= sexp_make_fixnum(0))) {
sexp_write_string(ctx, " on line ", 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_preserve3(ctx, name, str, irr);
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);
irr = ((sexp_pairp(irritants) || sexp_nullp(irritants))
? irritants : sexp_list1(ctx, irritants));
@ -320,7 +320,7 @@ sexp sexp_length (sexp ctx, sexp ls) {
sexp_uint_t res=0;
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) {
@ -334,17 +334,17 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
return
sexp_make_boolean((a == b)
|| (sexp_flonump(a)
&& sexp_make_integer(sexp_flonum_value(a)) == b)
&& sexp_make_fixnum(sexp_flonum_value(a)) == b)
|| (sexp_flonump(b)
&& sexp_make_integer(sexp_flonum_value(b)) == a));
&& sexp_make_fixnum(sexp_flonum_value(b)) == a));
#else
if (! sexp_pointerp(a))
return sexp_make_boolean(sexp_integerp(a) && sexp_pointerp(b)
&& (sexp_unbox_integer(a)
return sexp_make_boolean(sexp_fixnump(a) && sexp_pointerp(b)
&& (sexp_unbox_fixnum(a)
== sexp_flonum_value(b)));
else if (! sexp_pointerp(b))
return sexp_make_boolean(sexp_integerp(b) && sexp_pointerp(a)
&& (sexp_unbox_integer(b)
return sexp_make_boolean(sexp_fixnump(b) && sexp_pointerp(a)
&& (sexp_unbox_fixnum(b)
== sexp_flonum_value(a)));
#endif
if (sexp_pointer_tag(a) != sexp_pointer_tag(b))
@ -395,9 +395,9 @@ sexp sexp_make_flonum(sexp ctx, double f) {
#endif
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;
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);
s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1);
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_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);
sexp_string_data(s)[len] = '\0';
return s;
@ -420,21 +420,21 @@ sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
sexp res;
if (! sexp_stringp(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);
if (sexp_not(end))
end = sexp_make_integer(sexp_string_length(str));
if (! sexp_integerp(end))
end = sexp_make_fixnum(sexp_string_length(str));
if (! sexp_fixnump(end))
return sexp_type_exception(ctx, "not a number", end);
if ((sexp_unbox_integer(start) < 0)
|| (sexp_unbox_integer(start) > sexp_string_length(str))
|| (sexp_unbox_integer(end) < 0)
|| (sexp_unbox_integer(end) > sexp_string_length(str))
if ((sexp_unbox_fixnum(start) < 0)
|| (sexp_unbox_fixnum(start) > sexp_string_length(str))
|| (sexp_unbox_fixnum(end) < 0)
|| (sexp_unbox_fixnum(end) > sexp_string_length(str))
|| (end < start))
return sexp_range_exception(ctx, str, start, end);
res = sexp_make_string(ctx, sexp_fx_sub(end, start), SEXP_VOID);
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_data(res)[sexp_string_length(res)] = '\0';
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));
else
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);
for (ls=str_ls; sexp_pairp(ls); ls=sexp_cdr(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 v, *x;
int i, clen = sexp_unbox_integer(len);
int i, clen = sexp_unbox_fixnum(len);
if (! clen) return the_empty_vector;
v = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp),
SEXP_VECTOR);
@ -557,39 +557,39 @@ sexp sexp_make_cpointer (sexp ctx, void *value) {
#if SEXP_BSD
#define sexp_stream_ctx(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(0))
#define sexp_stream_buf(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(1))
#define sexp_stream_size(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(2))
#define sexp_stream_pos(vec) sexp_vector_ref((sexp)vec, sexp_make_integer(3))
#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_fixnum(1))
#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_fixnum(3))
int sstream_read (void *vec, char *dst, int n) {
sexp_uint_t len = sexp_unbox_integer(sexp_stream_size(vec));
sexp_uint_t pos = sexp_unbox_integer(sexp_stream_pos(vec));
sexp_uint_t len = sexp_unbox_fixnum(sexp_stream_size(vec));
sexp_uint_t pos = sexp_unbox_fixnum(sexp_stream_pos(vec));
if (pos >= len) return 0;
if (n > (len - pos)) n = (len - pos);
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;
}
int sstream_write (void *vec, const char *src, int n) {
sexp_uint_t len, pos, newpos;
sexp newbuf;
len = sexp_unbox_integer(sexp_stream_size(vec));
pos = sexp_unbox_integer(sexp_stream_pos(vec));
len = sexp_unbox_fixnum(sexp_stream_size(vec));
pos = sexp_unbox_fixnum(sexp_stream_pos(vec));
newpos = pos+n;
if (newpos >= len) {
newbuf = sexp_make_string(sexp_stream_ctx(vec),
sexp_make_integer(newpos*2),
sexp_make_fixnum(newpos*2),
SEXP_VOID);
memcpy(sexp_string_data(newbuf),
sexp_string_data(sexp_stream_buf(vec)),
pos);
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);
sexp_stream_pos(vec) = sexp_make_integer(newpos);
sexp_stream_pos(vec) = sexp_make_fixnum(newpos);
return n;
}
@ -598,11 +598,11 @@ off_t sstream_seek (void *vec, off_t offset, int whence) {
if (whence == SEEK_SET) {
pos = offset;
} 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 */
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;
}
@ -611,11 +611,11 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
sexp res;
sexp_gc_var1(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_buf(cookie) = str;
sexp_stream_size(cookie) = sexp_make_integer(sexp_string_length(str));
sexp_stream_pos(cookie) = sexp_make_integer(0);
sexp_stream_size(cookie) = sexp_make_fixnum(sexp_string_length(str));
sexp_stream_pos(cookie) = sexp_make_fixnum(0);
in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL);
res = sexp_make_input_port(ctx, in, SEXP_FALSE);
sexp_port_cookie(res) = cookie;
@ -628,12 +628,12 @@ sexp sexp_make_output_string_port (sexp ctx) {
sexp res, size;
sexp_gc_var1(cookie);
sexp_gc_preserve1(ctx, cookie);
size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE);
cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID);
size = sexp_make_fixnum(SEXP_INIT_STRING_PORT_SIZE);
cookie = sexp_make_vector(ctx, sexp_make_fixnum(4), SEXP_VOID);
sexp_stream_ctx(cookie) = ctx;
sexp_stream_buf(cookie) = sexp_make_string(ctx, size, SEXP_VOID);
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);
res = sexp_make_output_port(ctx, out, SEXP_FALSE);
sexp_port_cookie(res) = cookie;
@ -646,7 +646,7 @@ sexp sexp_get_output_string (sexp ctx, sexp port) {
fflush(sexp_port_stream(port));
return sexp_substring(ctx,
sexp_stream_buf(cookie),
sexp_make_integer(0),
sexp_make_fixnum(0),
sexp_stream_pos(cookie));
}
@ -883,8 +883,8 @@ void sexp_write (sexp ctx, sexp obj, sexp out) {
sexp_write_char(ctx, '>', out);
break;
}
} else if (sexp_integerp(obj)) {
sprintf(numbuf, "%ld", sexp_unbox_integer(obj));
} else if (sexp_fixnump(obj)) {
sprintf(numbuf, "%ld", sexp_unbox_fixnum(obj));
sexp_write_string(ctx, numbuf, out);
#if USE_IMMEDIATE_FLONUMS
} 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') {
exponent = sexp_read_number(ctx, in, 10);
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);
} else if ((c!=EOF) && ! is_separator(c)) {
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);
if (negp) res *= -1;
if ((scale == 0.1) && (exponent != SEXP_VOID) && (res == round(res)))
return sexp_make_integer(res);
return sexp_make_fixnum(res);
else
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);
} else if (c=='/') {
den = sexp_read_number(ctx, in, base);
if (! sexp_integerp(den))
if (! sexp_fixnump(den))
return (sexp_exceptionp(den)
? den : sexp_read_error(ctx, "invalid rational syntax", den, in));
return sexp_make_flonum(ctx, (double)(negativep ? -res : res)
/ (double)sexp_unbox_integer(den));
/ (double)sexp_unbox_fixnum(den));
} else {
if ((c!=EOF) && ! is_separator(c))
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);
}
return sexp_make_integer(negativep ? -res : res);
return sexp_make_fixnum(negativep ? -res : res);
}
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)) {
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))
for (tmp=res; sexp_pairp(tmp); tmp=sexp_cdr(tmp))
@ -1196,12 +1196,12 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
case 'e':
res = sexp_read(ctx, in);
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;
case 'i':
res = sexp_read(ctx, in);
if (sexp_integerp(res))
res = sexp_make_flonum(ctx, sexp_unbox_integer(res));
if (sexp_fixnump(res))
res = sexp_make_flonum(ctx, sexp_unbox_fixnum(res));
break;
case 'f':
case 't':
@ -1308,7 +1308,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
sexp_bignum_sign(res) = -sexp_bignum_sign(res);
else
#endif
res = sexp_fx_mul(res, sexp_make_integer(-1));
res = sexp_fx_mul(res, sexp_make_fixnum(-1));
}
} else {
sexp_push_char(ctx, c2, in);