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

merge

Browse source
This commit is contained in:
Alex Shinn 2011-11-02 13:13:40 +00:00
commit e7f12f88c2
2 changed files with 38 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gc.c
View file

@ -526,24 +526,32 @@ void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types
} else if (sexp_bytecodep(p)) { } else if (sexp_bytecodep(p)) {
for (i=0; i<sexp_bytecode_length(p); ) { for (i=0; i<sexp_bytecode_length(p); ) {
switch (sexp_bytecode_data(p)[i++]) { switch (sexp_bytecode_data(p)[i++]) {
case SEXP_OP_STACK_REF: case SEXP_OP_LOCAL_REF: case SEXP_OP_CLOSURE_REF: case SEXP_OP_PUSH:
case SEXP_OP_LOCAL_SET: case SEXP_OP_CLOSURE_REF:
case SEXP_OP_JUMP: case SEXP_OP_JUMP_UNLESS:
case SEXP_OP_TYPEP: case SEXP_OP_RESERVE:
case SEXP_OP_FCALL0: case SEXP_OP_FCALL1: case SEXP_OP_FCALL0: case SEXP_OP_FCALL1:
case SEXP_OP_FCALL2: case SEXP_OP_FCALL3: case SEXP_OP_FCALL2: case SEXP_OP_FCALL3:
case SEXP_OP_FCALL4: case SEXP_OP_CALL: case SEXP_OP_FCALL4: case SEXP_OP_CALL:
case SEXP_OP_GLOBAL_REF: case SEXP_OP_GLOBAL_KNOWN_REF:
case SEXP_OP_TAIL_CALL: case SEXP_OP_PARAMETER_REF: case SEXP_OP_TAIL_CALL: case SEXP_OP_PARAMETER_REF:
case SEXP_OP_PUSH: case SEXP_OP_GLOBAL_REF: case SEXP_OP_GLOBAL_KNOWN_REF:
#if SEXP_USE_EXTENDED_FCALL
case SEXP_OP_FCALLN:
#endif
v = (sexp*)(&(sexp_bytecode_data(p)[i])); v = (sexp*)(&(sexp_bytecode_data(p)[i]));
if (v[0] && sexp_pointerp(v[0])) v[0] = (sexp) ((char*)v[0] + off); if (v[0] && sexp_pointerp(v[0])) v[0] = (sexp) (((char*)v[0]) + off);
/* ... FALLTHROUGH ... */
case SEXP_OP_JUMP: case SEXP_OP_JUMP_UNLESS:
case SEXP_OP_STACK_REF: case SEXP_OP_LOCAL_REF:
case SEXP_OP_LOCAL_SET: case SEXP_OP_TYPEP:
#if SEXP_USE_RESERVE_OPCODE
case SEXP_OP_RESERVE:
#endif
i += sizeof(sexp); break; i += sizeof(sexp); break;
case SEXP_OP_SLOT_REF: case SEXP_OP_SLOT_SET: case SEXP_OP_MAKE: case SEXP_OP_MAKE: case SEXP_OP_SLOT_REF: case SEXP_OP_SLOT_SET:
i += 2*sizeof(sexp); break; i += 2*sizeof(sexp); break;
case SEXP_OP_MAKE_PROCEDURE: case SEXP_OP_MAKE_PROCEDURE:
v = (sexp*)(&(sexp_bytecode_data(p)[i])); v = (sexp*)(&(sexp_bytecode_data(p)[i]));
if (v[2] && sexp_pointerp(v[2])) v[2] = (sexp) ((char*)v[2] + off); if (v[0] && sexp_pointerp(v[0])) v[0] = (sexp) (((char*)v[0]) + off);
if (v[1] && sexp_pointerp(v[1])) v[1] = (sexp) (((char*)v[1]) + off);
if (v[2] && sexp_pointerp(v[2])) v[2] = (sexp) (((char*)v[2]) + off);
i += 3*sizeof(sexp); break; i += 3*sizeof(sexp); break;
} }
} }

32
main.c
View file

@ -76,8 +76,8 @@ static sexp sexp_load_image (const char* file, sexp_uint_t heap_size, sexp_uint_
offset = (sexp_sint_t)((char*)heap - (sexp_sint_t)header.base); offset = (sexp_sint_t)((char*)heap - (sexp_sint_t)header.base);
/* expand the last free chunk if necessary */ /* expand the last free chunk if necessary */
if (heap->size < heap_size) { if (heap->size < heap_size) {
for (q=(sexp_free_list)((char*)heap->free_list + offset); q->next; for (q=(sexp_free_list)(((char*)heap->free_list) + offset); q->next;
q=(sexp_free_list)((char*)q->next + offset)) q=(sexp_free_list)(((char*)q->next) + offset))
; ;
if ((char*)q + q->size >= (char*)heap->data + heap->size) { if ((char*)q + q->size >= (char*)heap->data + heap->size) {
/* last free chunk at end of heap */ /* last free chunk at end of heap */
@ -85,7 +85,7 @@ static sexp sexp_load_image (const char* file, sexp_uint_t heap_size, sexp_uint_
} else { } else {
/* last free chunk in the middle of the heap */ /* last free chunk in the middle of the heap */
q->next = (sexp_free_list)((char*)heap->data + heap->size); q->next = (sexp_free_list)((char*)heap->data + heap->size);
q = (sexp_free_list)((char*)q->next + offset); q = (sexp_free_list)(((char*)q->next) + offset);
q->size = heap_size - heap->size; q->size = heap_size - heap->size;
q->next = NULL; q->next = NULL;
} }
@ -204,11 +204,9 @@ static sexp check_exception (sexp ctx, sexp res) {
return res; return res;
} }
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) { static sexp sexp_load_standard_params (sexp ctx, sexp e) {
sexp_gc_var3(e, p, res); sexp_gc_var2(p, res);
sexp_gc_preserve3(ctx, e, p, res); sexp_gc_preserve2(ctx, p, res);
e = sexp_load_standard_env(ctx, env, k);
if (sexp_exceptionp(e)) return e;
sexp_load_standard_ports(ctx, e, stdin, stdout, stderr, 0); sexp_load_standard_ports(ctx, e, stdin, stdout, stderr, 0);
#if SEXP_USE_GREEN_THREADS #if SEXP_USE_GREEN_THREADS
p = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL)); p = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
@ -221,6 +219,16 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
return res; return res;
} }
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
sexp_gc_var1(e);
sexp_gc_preserve1(ctx, e);
e = sexp_load_standard_env(ctx, env, k);
if (sexp_exceptionp(e)) return e;
e = sexp_load_standard_params(ctx, e);
sexp_gc_release1(ctx);
return e;
}
static void do_init_context (sexp* ctx, sexp* env, sexp_uint_t heap_size, static void do_init_context (sexp* ctx, sexp* env, sexp_uint_t heap_size,
sexp_uint_t heap_max_size, sexp_sint_t fold_case) { sexp_uint_t heap_max_size, sexp_sint_t fold_case) {
*ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size, heap_max_size); *ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size, heap_max_size);
@ -333,12 +341,14 @@ void run_main (int argc, char **argv) {
fprintf(stderr, "-:i <file>: couldn't open file for reading: %s\n", arg); fprintf(stderr, "-:i <file>: couldn't open file for reading: %s\n", arg);
exit_failure(); exit_failure();
} }
env = sexp_context_env(ctx); env = sexp_load_standard_params(ctx, sexp_context_env(ctx));
sexp_load_standard_ports(ctx, env, stdin, stdout, stderr, 0);
init_loaded++; init_loaded++;
break; break;
case 'd': case 'd':
load_init(); if (! init_loaded++) {
init_context();
env = sexp_load_standard_env(ctx, env, SEXP_SEVEN);
}
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2); arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
if (!sexp_save_image(ctx, arg)) if (!sexp_save_image(ctx, arg))
exit_failure(); exit_failure();