Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-09 22:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding integer->immediate utility

Browse source
This commit is contained in:
Alex Shinn 2011-04-03 17:46:55 +09:00
parent 7f8e003d08
commit 17afe65125
2 changed files with 10 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
lib/chibi/ast.c
View file

@ -164,6 +164,14 @@ static sexp sexp_object_size (sexp ctx sexp_api_params(self, n), sexp x) {
return sexp_make_fixnum(sexp_type_size_of_object(t, x)); return sexp_make_fixnum(sexp_type_size_of_object(t, x));
} }
static sexp sexp_integer_to_immediate (sexp ctx sexp_api_params(self, n), sexp i, sexp dflt) {
sexp x = (sexp)sexp_unbox_fixnum(i);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i);
if (sexp_pointerp(x))
return dflt;
return x;
}
static sexp sexp_analyze_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) { static sexp sexp_analyze_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) {
sexp ctx2 = ctx; sexp ctx2 = ctx;
if (sexp_envp(e)) { if (sexp_envp(e)) {
@ -285,6 +293,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
sexp_define_foreign(ctx, env, "type-cpl", 1, sexp_type_cpl_op); sexp_define_foreign(ctx, env, "type-cpl", 1, sexp_type_cpl_op);
sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op); sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op);
sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size); sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op); sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);
return SEXP_VOID; return SEXP_VOID;
} }

2
lib/chibi/ast.module
View file

@ -29,7 +29,7 @@
procedure-code procedure-vars procedure-name procedure-code procedure-vars procedure-name
bytecode-name bytecode-literals bytecode-name bytecode-literals
type? type-name type-cpl type-parent type-slots type? type-name type-cpl type-parent type-slots
object-size gc) object-size integer->immediate gc)
(import-immutable (scheme)) (import-immutable (scheme))
(include-shared "ast") (include-shared "ast")
(include "ast.scm")) (include "ast.scm"))