From ae77cddba036342f135e5cf5e8e8f0b556abe550 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Wed, 2 Nov 2011 13:13:07 +0000
Subject: [PATCH] image loading fixes

---
 gc.c   | 26 +++++++++++++++++---------
 main.c | 32 +++++++++++++++++++++-----------
 2 files changed, 38 insertions(+), 20 deletions(-)

diff --git a/gc.c b/gc.c
index 7e0687f9..d7971668 100644
--- a/gc.c
+++ b/gc.c
@@ -526,24 +526,32 @@ void sexp_offset_heap_pointers (sexp_heap heap, sexp_heap from_heap, sexp* types
       } 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_CLOSURE_REF: case SEXP_OP_PUSH:
             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:
+            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]));
-              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;
-            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;
             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);
+              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;
           }
         }
diff --git a/main.c b/main.c
index 62c52464..06584b56 100644
--- a/main.c
+++ b/main.c
@@ -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);
   /* 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))
+    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 */
@@ -85,7 +85,7 @@ static sexp sexp_load_image (const char* file, sexp_uint_t heap_size, sexp_uint_
     } 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 = (sexp_free_list)(((char*)q->next) + offset);
       q->size = heap_size - heap->size;
       q->next = NULL;
     }
@@ -204,11 +204,9 @@ static sexp check_exception (sexp ctx, sexp res) {
   return res;
 }
 
-static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
-  sexp_gc_var3(e, p, res);
-  sexp_gc_preserve3(ctx, e, p, res);
-  e = sexp_load_standard_env(ctx, env, k);
-  if (sexp_exceptionp(e)) return e;
+static sexp sexp_load_standard_params (sexp ctx, sexp e) {
+  sexp_gc_var2(p, res);
+  sexp_gc_preserve2(ctx, p, res);
   sexp_load_standard_ports(ctx, e, stdin, stdout, stderr, 0);
 #if SEXP_USE_GREEN_THREADS
   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;
 }
 
+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,
                              sexp_uint_t heap_max_size, sexp_sint_t fold_case) {
   *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);
         exit_failure();
       }
-      env = sexp_context_env(ctx);
-      sexp_load_standard_ports(ctx, env, stdin, stdout, stderr, 0);
+      env = sexp_load_standard_params(ctx, sexp_context_env(ctx));
       init_loaded++;
       break;
     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);
       if (!sexp_save_image(ctx, arg))
         exit_failure();