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

fixing bytecode offsets in images, allowing the image heap size and init heap size to differ

Browse source
This commit is contained in:
Alex Shinn 2011-10-31 00:10:56 +09:00
parent 79e7f0b90d
commit 1e01258724
4 changed files with 157 additions and 104 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
gc.c
View file

@ -384,8 +384,8 @@ sexp sexp_gc (sexp ctx, size_t *sum_freed) {
sexp_conservative_mark(ctx); sexp_conservative_mark(ctx);
sexp_reset_weak_references(ctx); sexp_reset_weak_references(ctx);
res = sexp_sweep(ctx, sum_freed); res = sexp_sweep(ctx, sum_freed);
sexp_debug_printf("%p (freed: %lu max_freed: %lu)", ctx, *sum_freed, sexp_debug_printf("%p (freed: %lu max_freed: %lu)", ctx,
sexp_unbox_fixnum(res)); (sum_freed ? *sum_freed : 0), sexp_unbox_fixnum(res));
return res; return res;
} }
@ -519,10 +519,34 @@ void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types
/* adjust context heaps, don't copy saved sexp_gc_vars */ /* adjust context heaps, don't copy saved sexp_gc_vars */
if (sexp_contextp(p)) { if (sexp_contextp(p)) {
sexp_context_ip(p) += off; sexp_context_ip(p) += off;
sexp_context_last_fp(p) += off;
sexp_stack_top(sexp_context_stack(p)) = 0;
sexp_context_saves(p) = NULL; sexp_context_saves(p) = NULL;
/* if (sexp_context_heap(p) - off != from_heap) */
/* fprintf(stderr, "unexpected heap: %p\n", sexp_context_heap(p)); */
sexp_context_heap(p) = heap; sexp_context_heap(p) = heap;
} else if (sexp_bytecodep(p)) {
for (i=0; i<sexp_bytecode_length(p); ) {
switch (sexp_bytecode_data(p)[i++]) {
case SEXP_OP_STACK_REF: case SEXP_OP_LOCAL_REF:
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_FCALL2: case SEXP_OP_FCALL3:
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_PUSH:
v = (sexp*)(&(sexp_bytecode_data(p)[i]));
if (v[0] && sexp_pointerp(v[0])) v[0] = (sexp) ((char*)v[0] + off);
i += sizeof(sexp); break;
case SEXP_OP_SLOT_REF: case SEXP_OP_SLOT_SET: case SEXP_OP_MAKE:
i += 2*sizeof(sexp); break;
case SEXP_OP_MAKE_PROCEDURE:
v = (sexp*)(&(sexp_bytecode_data(p)[i]));
if (v[2] && sexp_pointerp(v[2])) v[2] = (sexp) ((char*)v[2] + off);
i += 3*sizeof(sexp); break;
}
}
} else if (sexp_portp(p) && sexp_port_stream(p)) { } else if (sexp_portp(p) && sexp_port_stream(p)) {
sexp_port_stream(p) = 0; sexp_port_stream(p) = 0;
sexp_port_openp(p) = 0; sexp_port_openp(p) = 0;
@ -554,6 +578,11 @@ void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types
} else { } else {
sexp_opcode_func(p) = dlsym(SEXP_RTLD_DEFAULT, sexp_string_data(name)); sexp_opcode_func(p) = dlsym(SEXP_RTLD_DEFAULT, sexp_string_data(name));
} }
} else if (sexp_typep(p)) {
if (sexp_type_finalize(p))
sexp_type_finalize(p) = sexp_type_tag(p) == SEXP_DL ? sexp_finalize_dl : SEXP_FINALIZE_PORT;
if (sexp_type_print(p))
sexp_type_print(p) = sexp_write_simple_object;
} }
t = types[sexp_pointer_tag(p)]; t = types[sexp_pointer_tag(p)];
p = (sexp) (((char*)p)+sexp_heap_align(sexp_type_size_of_object(t, p))); p = (sexp) (((char*)p)+sexp_heap_align(sexp_type_size_of_object(t, p)));

87
include/chibi/eval.h
View file

@ -46,93 +46,6 @@ enum sexp_opcode_classes {
SEXP_OPC_NUM_OP_CLASSES SEXP_OPC_NUM_OP_CLASSES
}; };
enum sexp_opcode_names {
SEXP_OP_NOOP,
SEXP_OP_RAISE,
SEXP_OP_RESUMECC,
SEXP_OP_CALLCC,
SEXP_OP_APPLY1,
SEXP_OP_TAIL_CALL,
SEXP_OP_CALL,
SEXP_OP_FCALL0,
SEXP_OP_FCALL1,
SEXP_OP_FCALL2,
SEXP_OP_FCALL3,
SEXP_OP_FCALL4,
SEXP_OP_FCALLN,
SEXP_OP_JUMP_UNLESS,
SEXP_OP_JUMP,
SEXP_OP_PUSH,
SEXP_OP_RESERVE,
SEXP_OP_DROP,
SEXP_OP_GLOBAL_REF,
SEXP_OP_GLOBAL_KNOWN_REF,
SEXP_OP_PARAMETER_REF,
SEXP_OP_STACK_REF,
SEXP_OP_LOCAL_REF,
SEXP_OP_LOCAL_SET,
SEXP_OP_CLOSURE_REF,
SEXP_OP_CLOSURE_VARS,
SEXP_OP_VECTOR_REF,
SEXP_OP_VECTOR_SET,
SEXP_OP_VECTOR_LENGTH,
SEXP_OP_BYTES_REF,
SEXP_OP_BYTES_SET,
SEXP_OP_BYTES_LENGTH,
SEXP_OP_STRING_REF,
SEXP_OP_STRING_SET,
SEXP_OP_STRING_LENGTH,
SEXP_OP_STRING_CURSOR_NEXT,
SEXP_OP_STRING_CURSOR_PREV,
SEXP_OP_STRING_SIZE,
SEXP_OP_MAKE_PROCEDURE,
SEXP_OP_MAKE_VECTOR,
SEXP_OP_MAKE_EXCEPTION,
SEXP_OP_AND,
SEXP_OP_NULLP,
SEXP_OP_FIXNUMP,
SEXP_OP_SYMBOLP,
SEXP_OP_CHARP,
SEXP_OP_EOFP,
SEXP_OP_TYPEP,
SEXP_OP_MAKE,
SEXP_OP_SLOT_REF,
SEXP_OP_SLOT_SET,
SEXP_OP_ISA,
SEXP_OP_SLOTN_REF,
SEXP_OP_SLOTN_SET,
SEXP_OP_CAR,
SEXP_OP_CDR,
SEXP_OP_SET_CAR,
SEXP_OP_SET_CDR,
SEXP_OP_CONS,
SEXP_OP_ADD,
SEXP_OP_SUB,
SEXP_OP_MUL,
SEXP_OP_DIV,
SEXP_OP_QUOTIENT,
SEXP_OP_REMAINDER,
SEXP_OP_LT,
SEXP_OP_LE,
SEXP_OP_EQN,
SEXP_OP_EQ,
SEXP_OP_FIX2FLO,
SEXP_OP_FLO2FIX,
SEXP_OP_CHAR2INT,
SEXP_OP_INT2CHAR,
SEXP_OP_CHAR_UPCASE,
SEXP_OP_CHAR_DOWNCASE,
SEXP_OP_WRITE_CHAR,
SEXP_OP_NEWLINE,
SEXP_OP_READ_CHAR,
SEXP_OP_PEEK_CHAR,
SEXP_OP_YIELD,
SEXP_OP_FORCE,
SEXP_OP_RET,
SEXP_OP_DONE,
SEXP_OP_NUM_OPCODES
};
/**************************** prototypes ******************************/ /**************************** prototypes ******************************/
SEXP_API void sexp_scheme_init (void); SEXP_API void sexp_scheme_init (void);

87
include/chibi/sexp.h
View file

@ -1289,6 +1289,93 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj)
#define sexp_make_setter(ctx, a, b, c) sexp_make_setter_op(ctx sexp_api_pass(NULL, 3), a, b, c) #define sexp_make_setter(ctx, a, b, c) sexp_make_setter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
#define sexp_lookup_type(ctx, name, id) sexp_lookup_type_op(ctx sexp_api_pass(NULL, 2), name, id) #define sexp_lookup_type(ctx, name, id) sexp_lookup_type_op(ctx sexp_api_pass(NULL, 2), name, id)
enum sexp_opcode_names {
SEXP_OP_NOOP,
SEXP_OP_RAISE,
SEXP_OP_RESUMECC,
SEXP_OP_CALLCC,
SEXP_OP_APPLY1,
SEXP_OP_TAIL_CALL,
SEXP_OP_CALL,
SEXP_OP_FCALL0,
SEXP_OP_FCALL1,
SEXP_OP_FCALL2,
SEXP_OP_FCALL3,
SEXP_OP_FCALL4,
SEXP_OP_FCALLN,
SEXP_OP_JUMP_UNLESS,
SEXP_OP_JUMP,
SEXP_OP_PUSH,
SEXP_OP_RESERVE,
SEXP_OP_DROP,
SEXP_OP_GLOBAL_REF,
SEXP_OP_GLOBAL_KNOWN_REF,
SEXP_OP_PARAMETER_REF,
SEXP_OP_STACK_REF,
SEXP_OP_LOCAL_REF,
SEXP_OP_LOCAL_SET,
SEXP_OP_CLOSURE_REF,
SEXP_OP_CLOSURE_VARS,
SEXP_OP_VECTOR_REF,
SEXP_OP_VECTOR_SET,
SEXP_OP_VECTOR_LENGTH,
SEXP_OP_BYTES_REF,
SEXP_OP_BYTES_SET,
SEXP_OP_BYTES_LENGTH,
SEXP_OP_STRING_REF,
SEXP_OP_STRING_SET,
SEXP_OP_STRING_LENGTH,
SEXP_OP_STRING_CURSOR_NEXT,
SEXP_OP_STRING_CURSOR_PREV,
SEXP_OP_STRING_SIZE,
SEXP_OP_MAKE_PROCEDURE,
SEXP_OP_MAKE_VECTOR,
SEXP_OP_MAKE_EXCEPTION,
SEXP_OP_AND,
SEXP_OP_NULLP,
SEXP_OP_FIXNUMP,
SEXP_OP_SYMBOLP,
SEXP_OP_CHARP,
SEXP_OP_EOFP,
SEXP_OP_TYPEP,
SEXP_OP_MAKE,
SEXP_OP_SLOT_REF,
SEXP_OP_SLOT_SET,
SEXP_OP_ISA,
SEXP_OP_SLOTN_REF,
SEXP_OP_SLOTN_SET,
SEXP_OP_CAR,
SEXP_OP_CDR,
SEXP_OP_SET_CAR,
SEXP_OP_SET_CDR,
SEXP_OP_CONS,
SEXP_OP_ADD,
SEXP_OP_SUB,
SEXP_OP_MUL,
SEXP_OP_DIV,
SEXP_OP_QUOTIENT,
SEXP_OP_REMAINDER,
SEXP_OP_LT,
SEXP_OP_LE,
SEXP_OP_EQN,
SEXP_OP_EQ,
SEXP_OP_FIX2FLO,
SEXP_OP_FLO2FIX,
SEXP_OP_CHAR2INT,
SEXP_OP_INT2CHAR,
SEXP_OP_CHAR_UPCASE,
SEXP_OP_CHAR_DOWNCASE,
SEXP_OP_WRITE_CHAR,
SEXP_OP_NEWLINE,
SEXP_OP_READ_CHAR,
SEXP_OP_PEEK_CHAR,
SEXP_OP_YIELD,
SEXP_OP_FORCE,
SEXP_OP_RET,
SEXP_OP_DONE,
SEXP_OP_NUM_OPCODES
};
#ifdef __cplusplus #ifdef __cplusplus
} /* extern "C" */ } /* extern "C" */
#endif #endif

50
main.c
View file

@ -26,23 +26,26 @@
#define SEXP_IMAGE_MAGIC "\x07\x07chibi\n\0" #define SEXP_IMAGE_MAGIC "\x07\x07chibi\n\0"
#define SEXP_IMAGE_MAJOR_VERSION 1 #define SEXP_IMAGE_MAJOR_VERSION 1
#define SEXP_IMAGE_MINOR_VERSION 0 #define SEXP_IMAGE_MINOR_VERSION 1
typedef struct sexp_image_header_t* sexp_image_header; typedef struct sexp_image_header_t* sexp_image_header;
struct sexp_image_header_t { struct sexp_image_header_t {
const char magic[8]; const char magic[8];
short major, minor; short major, minor;
sexp_uint_t size, base, context; sexp_uint_t size;
sexp_heap base;
sexp context;
}; };
sexp sexp_gc (sexp ctx, size_t *sum_freed); sexp sexp_gc (sexp ctx, size_t *sum_freed);
void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types, sexp flags); void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types, sexp flags);
static sexp sexp_load_image (const char* file) { static sexp sexp_load_image (const char* file, sexp_uint_t heap_size, sexp_uint_t heap_max_size) {
sexp ctx, *globals, *types; sexp ctx, flags, *globals, *types;
int fd; int fd;
sexp_sint_t offset; sexp_sint_t offset;
char* image; sexp_heap heap;
sexp_free_list q;
struct sexp_image_header_t header; struct sexp_image_header_t header;
fd = open(file, O_RDONLY); fd = open(file, O_RDONLY);
if (fd < 0) { if (fd < 0) {
@ -56,19 +59,39 @@ static sexp sexp_load_image (const char* file) {
return NULL; return NULL;
} else if (header.major != SEXP_IMAGE_MAJOR_VERSION } else if (header.major != SEXP_IMAGE_MAJOR_VERSION
|| header.major < SEXP_IMAGE_MINOR_VERSION) { || header.major < SEXP_IMAGE_MINOR_VERSION) {
fprintf(stderr, "unsupported image version: %d.%d\n", header.major, header.minor); fprintf(stderr, "unsupported image version: %d.%d\n",
header.major, header.minor);
return NULL; return NULL;
} }
image = malloc(sexp_heap_pad_size(header.size)); if (heap_size < header.size) heap_size = header.size;
if (read(fd, image, header.size) != header.size) { heap = (sexp_heap)malloc(sexp_heap_pad_size(heap_size));
if (read(fd, heap, header.size) != header.size) {
fprintf(stderr, "error reading image\n"); fprintf(stderr, "error reading image\n");
return NULL; return NULL;
} }
offset = (sexp_sint_t)(image - (sexp_sint_t)header.base); offset = (sexp_sint_t)((char*)heap - (sexp_sint_t)header.base);
/* expand the last free chunk if necessary */
if (heap->size < heap_size) {
for (q=(sexp_free_list)((char*)heap->free_list + offset); q->next;
q=(sexp_free_list)((char*)q->next + offset))
;
if ((char*)q + q->size >= (char*)heap->data + heap->size) {
/* last free chunk at end of heap */
q->size += heap_size - heap->size;
} else {
/* last free chunk in the middle of the heap */
q->next = (sexp_free_list)((char*)heap->data + heap->size);
q = (sexp_free_list)((char*)q->next + offset);
q->size = heap_size - heap->size;
q->next = NULL;
}
heap->size += (heap_size - heap->size);
}
ctx = (sexp)(header.context + offset); ctx = (sexp)(header.context + offset);
globals = sexp_vector_data((sexp)((char*)sexp_context_globals(ctx) + offset)); globals = sexp_vector_data((sexp)((char*)sexp_context_globals(ctx) + offset));
types = sexp_vector_data((sexp)((char*)(globals[SEXP_G_TYPES]) + offset)); types = sexp_vector_data((sexp)((char*)(globals[SEXP_G_TYPES]) + offset));
sexp_offset_heap_pointers((sexp_heap)image, (sexp_heap)header.base, types, sexp_fx_add(SEXP_COPY_LOADP, SEXP_COPY_FREEP)); flags = sexp_fx_add(SEXP_COPY_LOADP, SEXP_COPY_FREEP);
sexp_offset_heap_pointers(heap, header.base, types, flags);
close(fd); close(fd);
return ctx; return ctx;
} }
@ -77,6 +100,7 @@ static int sexp_save_image (sexp ctx, const char* path) {
sexp_heap heap; sexp_heap heap;
FILE* file; FILE* file;
struct sexp_image_header_t header; struct sexp_image_header_t header;
sexp_free_list q;
file = fopen(path, "w"); file = fopen(path, "w");
if (!file) { if (!file) {
fprintf(stderr, "couldn't open image file for writing: %s\n", path); fprintf(stderr, "couldn't open image file for writing: %s\n", path);
@ -87,8 +111,8 @@ static int sexp_save_image (sexp ctx, const char* path) {
header.major = SEXP_IMAGE_MAJOR_VERSION; header.major = SEXP_IMAGE_MAJOR_VERSION;
header.minor = SEXP_IMAGE_MINOR_VERSION; header.minor = SEXP_IMAGE_MINOR_VERSION;
header.size = heap->size; header.size = heap->size;
header.base = (sexp_uint_t)heap; header.base = heap;
header.context = (sexp_uint_t)ctx; header.context = ctx;
sexp_gc(ctx, NULL); sexp_gc(ctx, NULL);
if (! (fwrite(&header, sizeof(header), 1, file) == 1 if (! (fwrite(&header, sizeof(header), 1, file) == 1
&& fwrite(heap, heap->size, 1, file) == 1)) { && fwrite(heap, heap->size, 1, file) == 1)) {
@ -301,7 +325,7 @@ void run_main (int argc, char **argv) {
fprintf(stderr, "-:i <file>: image files must be loaded first\n"); fprintf(stderr, "-:i <file>: image files must be loaded first\n");
exit_failure(); exit_failure();
} }
ctx = sexp_load_image(arg); ctx = sexp_load_image(arg, heap_size, heap_max_size);
if (!ctx) { if (!ctx) {
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();