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!

diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
index bb16ce9..4aaefdc 100644 (file)
--- a/module/language/scheme/translate.scm
+++ b/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

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index b48ed9f..e73c092 100644 (file)
--- a/module/system/base/compile.scm
+++ b/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)))))

diff --git a/module/system/base/language.scm b/module/system/base/language.scm
index 87ca077..47c408f 100644 (file)
--- a/module/system/base/language.scm
+++ b/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))))

diff --git a/module/system/repl/Makefile.am b/module/system/repl/Makefile.am
index f54b386..d5a9f68 100644 (file)
--- a/module/system/repl/Makefile.am
+++ b/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)
 

diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 2914622..5f04ef2 100644 (file)
--- a/module/system/repl/repl.scm
+++ b/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)

diff --git a/src/vm_loader.c b/src/vm_loader.c
index 6ad230a..f916278 100644 (file)
--- a/src/vm_loader.c
+++ b/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);