guile-vm is completely self-compiling now!

* module/language/scheme/translate.scm (*the-compile-toplevel-symbol*):
  Reset to compile-toplevel, which requires a patch to guile.

* module/system/base/compile.scm (compile-file): Some foo so that we load
  up the scheme language before call-with-output-file. Fixes compilation
  of (language scheme) modules.

* module/system/base/language.scm (define-language): Don't unquote in
  make-language; refer to it by name instead, and export it.

* module/system/repl/Makefile.am (vm_DATA): Don't compile describe.scm,
  because we really can't deal with goops yet.

* module/system/repl/repl.scm (compile-toplevel): If we're compiling, put
  in a stub definition of start-stack, which is closely tied to the
  interpreter.

* src/vm_loader.c (load-program): Fix a very tricky corruption bug!

module/language/scheme/translate.scm

@@ -127,7 +127,7 @@
                 (else (syntax-error ,loc (format #f "bad ~A" ',sym) ,exp)))))))
   `(list ,@(map make1 body)))
 
-(define *the-compile-toplevel-symbol* 'load-toplevel)
+(define *the-compile-toplevel-symbol* 'compile-toplevel)
 
 (define primitive-syntax-table
   (make-pmatch-transformers

module/system/base/compile.scm

@@ -58,16 +58,17 @@
 (define (scheme) (lookup-language 'scheme))
 
 (define (compile-file file . opts)
-  (let ((comp (compiled-file-name file)))
+  (let ((comp (compiled-file-name file))
+        (scheme (scheme)))
     (catch 'nothing-at-all
       (lambda ()
 	(call-with-compile-error-catch
 	 (lambda ()
 	   (call-with-output-file comp
 	     (lambda (port)
-	       (let* ((source (read-file-in file (scheme)))
+	       (let* ((source (read-file-in file scheme))
 		      (objcode (apply compile-in source (current-module)
-				      (scheme) opts)))
+				      scheme opts)))
 		 (if (memq :c opts)
 		   (pprint-glil objcode port)
 		   (uniform-vector-write (objcode->u8vector objcode) port)))))

module/system/base/language.scm

@@ -21,7 +21,7 @@
 
 (define-module (system base language)
   :use-syntax (system base syntax)
-  :export (define-language lookup-language
+  :export (define-language lookup-language make-language
            language-name language-title language-version language-reader
            language-printer language-read-file language-expander
            language-translator language-evaluator language-environment))
@@ -39,7 +39,7 @@
 			   ))
 
 (define-macro (define-language name . spec)
-  `(define ,name (,make-language :name ',name ,@spec)))
+  `(define ,name (make-language :name ',name ,@spec)))
 
 (define (lookup-language name)
   (let ((m (resolve-module `(language ,name spec))))

module/system/repl/Makefile.am

@@ -1,8 +1,9 @@
-SOURCES = repl.scm common.scm command.scm describe.scm
+NOCOMP_SOURCES = describe.scm
+SOURCES = repl.scm common.scm command.scm
 GOBJECTS = $(SOURCES:%.scm=%.go)
 
 vmdir = $(guiledir)/system/repl
-vm_DATA = $(SOURCES) $(GOBJECTS)
+vm_DATA = $(SOURCES) $(NOCOMP_SOURCES) $(GOBJECTS)
 
 CLEANFILES = $(GOBJECTS)
 

module/system/repl/repl.scm

@@ -85,6 +85,11 @@
     (else
      (apply bad-throw args))))
 
+(eval-case
+ ((compile-toplevel)
+  (define-macro (start-stack tag expr)
+    expr)))
+
 (define (start-repl lang)
   (let ((repl (make-repl lang)))
     (repl-welcome repl)

src/vm_loader.c

@@ -165,11 +165,12 @@ VM_DEFINE_LOADER (load_program, "load-program")
   else
     {
       /* Other cases */
+      /* x is #f, and already popped off */
+      p->nargs = SCM_I_INUM (sp[-3]);
+      p->nrest = SCM_I_INUM (sp[-2]);
+      p->nlocs = SCM_I_INUM (sp[-1]);
+      p->nexts = SCM_I_INUM (sp[0]);
       sp -= 4;
-      p->nargs = SCM_I_INUM (sp[0]);
-      p->nrest = SCM_I_INUM (sp[1]);
-      p->nlocs = SCM_I_INUM (sp[2]);
-      p->nexts = SCM_I_INUM (sp[3]);
     }
 
   PUSH (prog);