From 1e012587242537230b5917acf0b01efba5612490 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Mon, 31 Oct 2011 00:10:56 +0900
Subject: [PATCH] fixing bytecode offsets in images, allowing the image heap
 size and init heap size to differ

---
 gc.c                 | 37 +++++++++++++++++--
 include/chibi/eval.h | 87 --------------------------------------------
 include/chibi/sexp.h | 87 ++++++++++++++++++++++++++++++++++++++++++++
 main.c               | 50 ++++++++++++++++++-------
 4 files changed, 157 insertions(+), 104 deletions(-)

diff --git a/gc.c b/gc.c
index 184b79db..7e0687f9 100644
--- a/gc.c
+++ b/gc.c
@@ -384,8 +384,8 @@ sexp sexp_gc (sexp ctx, size_t *sum_freed) {
   sexp_conservative_mark(ctx);
   sexp_reset_weak_references(ctx);
   res = sexp_sweep(ctx, sum_freed);
-  sexp_debug_printf("%p (freed: %lu max_freed: %lu)", ctx, *sum_freed,
-                    sexp_unbox_fixnum(res));
+  sexp_debug_printf("%p (freed: %lu max_freed: %lu)", ctx,
+                    (sum_freed ? *sum_freed : 0), sexp_unbox_fixnum(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 */
       if (sexp_contextp(p)) {
         sexp_context_ip(p) += off;
+        sexp_context_last_fp(p) += off;
+        sexp_stack_top(sexp_context_stack(p)) = 0;
         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;
+      } 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)) {
         sexp_port_stream(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 {
             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)];
         p = (sexp) (((char*)p)+sexp_heap_align(sexp_type_size_of_object(t, p)));
diff --git a/include/chibi/eval.h b/include/chibi/eval.h
index 3a4aa4eb..47f1c03f 100644
--- a/include/chibi/eval.h
+++ b/include/chibi/eval.h
@@ -46,93 +46,6 @@ enum sexp_opcode_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 ******************************/
 
 SEXP_API void sexp_scheme_init (void);
diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index 639a289b..4d2caf8e 100755
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -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_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
 } /* extern "C" */
 #endif
diff --git a/main.c b/main.c
index 427aecbb..7edce825 100644
--- a/main.c
+++ b/main.c
@@ -26,23 +26,26 @@
 
 #define SEXP_IMAGE_MAGIC "\x07\x07chibi\n\0"
 #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;
 struct sexp_image_header_t {
   const char magic[8];
   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);
 void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types, sexp flags);
 
-static sexp sexp_load_image (const char* file) {
-  sexp ctx, *globals, *types;
+static sexp sexp_load_image (const char* file, sexp_uint_t heap_size, sexp_uint_t heap_max_size) {
+  sexp ctx, flags, *globals, *types;
   int fd;
   sexp_sint_t offset;
-  char* image;
+  sexp_heap heap;
+  sexp_free_list q;
   struct sexp_image_header_t header;
   fd = open(file, O_RDONLY);
   if (fd < 0) {
@@ -56,19 +59,39 @@ static sexp sexp_load_image (const char* file) {
     return NULL;
   } else if (header.major != SEXP_IMAGE_MAJOR_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;
   }
-  image = malloc(sexp_heap_pad_size(header.size));
-  if (read(fd, image, header.size) != header.size) {
+  if (heap_size < header.size) heap_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");
     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);
   globals = sexp_vector_data((sexp)((char*)sexp_context_globals(ctx) + 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);
   return ctx;
 }
@@ -77,6 +100,7 @@ static int sexp_save_image (sexp ctx, const char* path) {
   sexp_heap heap;
   FILE* file;
   struct sexp_image_header_t header;
+  sexp_free_list q;
   file = fopen(path, "w");
   if (!file) {
     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.minor = SEXP_IMAGE_MINOR_VERSION;
   header.size = heap->size;
-  header.base = (sexp_uint_t)heap;
-  header.context = (sexp_uint_t)ctx;
+  header.base = heap;
+  header.context = ctx;
   sexp_gc(ctx, NULL);
   if (! (fwrite(&header, sizeof(header), 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");
         exit_failure();
       }
-      ctx = sexp_load_image(arg);
+      ctx = sexp_load_image(arg, heap_size, heap_max_size);
       if (!ctx) {
         fprintf(stderr, "-:i <file>: couldn't open file for reading: %s\n", arg);
         exit_failure();