* Added Scheme LOAD procedure

src/api.c

@@ -856,6 +856,30 @@ void sly_call(sly_state_t *S, uint32_t n_args)
   S->stack[S->sp++] = S->accum;
 }
 
+void sly_load_file(sly_state_t* S, int idx)
+{
+  int idx2;
+  sly_module_t mod;
+
+  idx = calc_index(S, idx);
+  idx2 = calc_index(S, -1);
+
+#ifdef SLY_DEBUG_API
+  assert(S->stack[idx].type = SLY_TYPE_STRING);
+#endif
+
+  sly_get_global(S, "compile-from-port");
+  S->stack[S->sp++] = S->stack[idx];
+  sly_open_input_file(S);
+  sly_call(S, 1);
+
+  sly_vm_vector_to_module(S->stack[S->sp-1], &mod);
+
+  sly_vm_link_run_module(S, &mod);
+  S->sp = ++idx2 + 1;
+  S->stack[idx2] = S->accum;
+}
+
 void sly_push_current_input_port(sly_state_t *S)
 {
   sly_get_global(S, "current-input-port");

src/sly.c

@@ -45,8 +45,10 @@ int main(int argc, char *argv[])
     sly_push_current_input_port(S);
     sly_push_current_output_port(S);
     sly_repl(S);
-  } else if(!sly_load_file(S, argv[1])) {
-    printf("Error!\n");
+  } else {
+    sly_push_string(S, argv[1]);
+    sly_load_file(S, -1);
+    sly_pop(S, 2);
   }
 
   sly_close(S);

src/sly.h

@@ -74,7 +74,6 @@ void sly_register(sly_state_t* S, sly_reg_t* regs);
 /* the input and output ports must be on stack */
 void sly_repl(sly_state_t *S);
 
-int sly_load_file(sly_state_t* S, const char *fname);
 int sly_load_buffer(sly_state_t* S, const uint8_t *buffer);
 
 /*
@@ -166,6 +165,7 @@ void sly_apply(sly_state_t* S, int idx, uint32_t nr_args);
 /* evaluation */
 void sly_eval(sly_state_t* S, int idx);
 void sly_call(sly_state_t* S, uint32_t n_args);
+void sly_load_file(sly_state_t* S, int idx);
 
 /* I/O */
 void sly_open_input_file(sly_state_t* S);

src/std.c

@@ -555,6 +555,20 @@ static int eval(sly_state_t* S)
   return 1;
 }
 
+static int load(sly_state_t* S)
+{
+  int nargs = sly_get_top(S);
+
+  if(nargs != 1) {
+    sly_push_string(S, "wrong number of arguments");
+    sly_error(S, 1);
+  }
+
+  sly_load_file(S, 0);
+
+  return 1;
+}
+
 /*
  * R5RS 6.6.1
  */
@@ -886,6 +900,7 @@ static sly_reg_t std_regs[] = {
   {"procedure?", procedurep},
   {"apply", apply},
   {"eval", eval},
+  {"load", load},
   {"eof-object?", eof_objectp},
   {"input-port?", input_portp},
   {"output-port?", output_portp},

src/vm.c

@@ -881,21 +881,6 @@ void sly_vm_call(sly_state_t* S, sly_object_t proc, uint32_t nargs)
  * loading
  */
 
-typedef struct sly_module_t sly_module_t;
-
-struct sly_module_t {
-
-  /* uninterned globals */
-  uint32_t nr_globals;
-  sly_string_t **globals;
-
-  /* constants */
-  uint32_t nr_consts;
-
-  /* code */
-  uint32_t *code, code_size;
-};
-
 static void sly_destroy_module(sly_module_t *M)
 {
   uint32_t i;
@@ -1014,7 +999,7 @@ static uint32_t sly_link_module(sly_state_t* S, sly_module_t *mod)
   return code_base;
 }
 
-static int sly_link_run_module(sly_state_t* S, sly_module_t *mod)
+int sly_vm_link_run_module(sly_state_t* S, sly_module_t *mod)
 {
   S->pc = sly_link_module(S, mod);
   sly_destroy_module(mod);
@@ -1072,7 +1057,7 @@ static uint32_t list_length(sly_object_t lis)
   }
 }
 
-static void vector_to_module(sly_object_t vec, sly_module_t *mod)
+void sly_vm_vector_to_module(sly_object_t vec, sly_module_t *mod)
 {
   uint32_t sz;
   sly_object_t p;
@@ -1133,8 +1118,8 @@ int sly_vm_load(sly_state_t* S, sly_object_t vec)
 
   assert(vec.type == SLY_TYPE_VECTOR);
 
-  vector_to_module(vec, &mod);
-  return sly_link_run_module(S, &mod);
+  sly_vm_vector_to_module(vec, &mod);
+  return sly_vm_link_run_module(S, &mod);
 }
 
 #define FIXNUM(o, n) do {(o).type = SLY_TYPE_FIXNUM; (o).value.fixnum = (n);} while(0)
@@ -1176,7 +1161,7 @@ void sly_vm_write_code(sly_state_t *S, sly_object_t vec, sly_object_t *port)
   sly_module_t mod;
   sly_object_t o;
 
-  vector_to_module(vec, &mod);
+  sly_vm_vector_to_module(vec, &mod);
 
   sly_io_write_c_string(S, "#( ", port);
   FIXNUM(o, mod.nr_globals);
@@ -1383,28 +1368,6 @@ static int load_code_from_file(sly_module_t *mod, const char* fname)
   return 1;
 }
 
-int sly_load_file(sly_state_t* S, const char *fname)
-{
-  sly_module_t mod;
-
-#if 0
-  /* tries to load code into module */
-  if(!load_code_from_file(&mod, fname)) {
-    return 0;
-  }
-#endif
-
-  sly_get_global(S, "compile-from-port");
-  sly_push_string(S, fname);
-  sly_open_input_file(S);
-  sly_call(S, 1);
-
-  vector_to_module(S->stack[S->sp-1], &mod);
-  S->sp -= 3;
-
-  return sly_link_run_module(S, &mod);
-}
-
 static void get_fixnum_b(uint8_t **buf, uint32_t *num)
 {
   uint32_t b1, b2, b3, b4;
@@ -1499,5 +1462,5 @@ int sly_load_buffer(sly_state_t* S, const uint8_t *buffer)
     return 0;
   }
 
-  return sly_link_run_module(S, &mod);
+  return sly_vm_link_run_module(S, &mod);
 }

src/vm.h

@@ -106,6 +106,21 @@
 /* address of HALT instruction */
 #define SLY_HALT_ADDRESS               0
 
+typedef struct sly_module_t sly_module_t;
+
+struct sly_module_t {
+
+  /* uninterned globals */
+  uint32_t nr_globals;
+  sly_string_t **globals;
+
+  /* constants */
+  uint32_t nr_consts;
+
+  /* code */
+  uint32_t *code, code_size;
+};
+
 /* initialises the virtual machine */
 void sly_vm_init(sly_state_t* S);
 
@@ -118,4 +133,10 @@ void sly_vm_call(sly_state_t* S, sly_object_t proc, uint32_t nargs);
 /* loads compiled code into the vm */
 int sly_vm_load(sly_state_t* S, sly_object_t mod);
 
+/* deserialises a module */
+void sly_vm_vector_to_module(sly_object_t vec, sly_module_t *mod);
+
+/* links a module to the running image and executes it */
+int sly_vm_link_run_module(sly_state_t* S, sly_module_t *mod);
+
 #endif