summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-05-20 11:33:28 +0200
committerAndy Wingo <wingo@pobox.com>2008-05-20 11:33:28 +0200
commitd79d908ef0c421798b79bd72403b2a8fd196173c (patch)
treefe7e67509db982375627a215a1223d83885d208d
parent5163e9513896580f2f809cd032b121ba1e2e6276 (diff)
downloadguile-d79d908ef0c421798b79bd72403b2a8fd196173c.tar.gz
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!
-rw-r--r--module/language/scheme/translate.scm2
-rw-r--r--module/system/base/compile.scm7
-rw-r--r--module/system/base/language.scm4
-rw-r--r--module/system/repl/Makefile.am5
-rw-r--r--module/system/repl/repl.scm5
-rw-r--r--src/vm_loader.c9
6 files changed, 20 insertions, 12 deletions
diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
index bb16ce91a..4aaefdc54 100644
--- 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 b48ed9fb2..e73c09274 100644
--- 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 87ca077fa..47c408f67 100644
--- 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 f54b3864a..d5a9f68fb 100644
--- 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 29146221a..5f04ef215 100644
--- 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 6ad230ab7..f91627856 100644
--- 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);