*** empty log message ***

module/system/base/language.scm

@@ -90,21 +90,15 @@
 		   (do ((x (read-in lang in) (read-in lang in))
 			(l '() (cons (lang.translator (lang.expander x)) l)))
 		       ((eof-object? x) (reverse! l))))))
-	 (asm (apply compile (cons '@begin code) env opts))
+	 (asm (apply compile (cons '@begin code) env opts)))
-	 (bytes (apply assemble asm env opts)))
+    (save-dumpcode (apply assemble asm env opts) (object-file-name file))))
-    (call-with-output-file (object-file-name file)
-      (lambda (out) (uniform-vector-write bytes out)))))
 
 (define (load-file-in file env lang . opts)
   (let ((compiled (object-file-name file)))
     (if (or (not (file-exists? compiled))
 	    (> (stat:mtime (stat file)) (stat:mtime (stat compiled))))
 	(compile-file-in file env lang :O))
-    (call-with-input-file compiled
+    (load-dumpcode compiled)))
-      (lambda (p)
-	(let ((bytes (make-uniform-vector (stat:size (stat compiled)) #\a)))
-	  (uniform-vector-read! bytes p)
-	  bytes)))))
 
 (define (object-file-name file)
   (let ((m (string-match "\\.[^.]*$" file)))

module/system/repl/command.scm

@@ -303,7 +303,7 @@ Generate compiled code.
   (let ((x (apply repl-compile repl form opts)))
     (cond ((or (memq :e opts) (memq :t opts)) (puts x))
 	  ((memq :c opts) (pprint-glil x))
-	  (else (disassemble-bootcode x)))))
+	  (else (disassemble-dumpcode x)))))
 
 (define (compile-file repl file . opts)
   "compile-file [options] FILE
@@ -318,7 +318,7 @@ Disassemble a program."
 (define (disassemble-file repl file)
   "disassemble-file FILE
 Disassemble a file."
-  (disassemble-bootcode
+  (disassemble-dumpcode
    (load-file-in (->string file) repl.module repl.language)))
 
 (define (->string x)

module/system/vm/assemble.scm

@@ -151,7 +151,7 @@
        (let ((bytes (stack->bytes stack))
 	     (objs (map car (reverse! object-alist))))
 	 (if toplevel
-	     (make-bootcode nlocs nexts bytes)
+	     (make-dumpcode nlocs nexts bytes)
 	     (make-bytespec nargs nrest nlocs nexts bytes objs)))))))
 
 (define (stack->bytes stack)

module/system/vm/core.scm

@@ -33,37 +33,48 @@
 				  (module-obarray (current-module)))))
 
 ;;;
-;;; Bootcode interface
+;;; Dumpcode interface
 ;;;
 
-(export make-bootcode bootcode? bootcode-version
+(export make-dumpcode dumpcode? dumpcode-version
-	bootcode-nlocs bootcode-nexts bootcode-bytecode)
+	dumpcode-nlocs dumpcode-nexts dumpcode-bytecode
+	load-dumpcode save-dumpcode)
 
-(define *bootcode-cookie* (string-append "\0GBC-" (vm-version)))
+(define *dumpcode-cookie* (string-append "\0GBC-" (vm-version)))
 
-(define (make-bootcode nlocs nexts bytes)
+(define (make-dumpcode nlocs nexts bytes)
-  (string-append *bootcode-cookie*
+  (string-append *dumpcode-cookie*
 		 (integer->bytes nlocs)
 		 (integer->bytes nexts)
 		 bytes))
 
-(define (bootcode? x)
+(define (dumpcode? x)
   (and (string? x)
        (> (string-length x) 10)
        (string=? (substring x 1 4) "GBC")))
 
-(define (bootcode-version x)
+(define (dumpcode-version x)
   (substring x 5 8))
 
-(define (bootcode-nlocs x)
+(define (dumpcode-nlocs x)
   (bytes->integer x 8))
 
-(define (bootcode-nexts x)
+(define (dumpcode-nexts x)
   (bytes->integer x 9))
 
-(define (bootcode-bytecode x)
+(define (dumpcode-bytecode x)
   (substring x 10))
 
+(define (load-dumpcode file)
+  (let ((bytes (make-uniform-vector (stat:size (stat file)) #\a)))
+    (call-with-input-file file
+      (lambda (p) (uniform-vector-read! bytes p)))
+    bytes))
+
+(define (save-dumpcode dump file)
+  (call-with-output-file file
+    (lambda (out) (uniform-vector-write bytes out))))
+
 (define (integer->bytes n)
   (string (integer->char n)))
 

module/system/vm/disasm.scm

@@ -27,15 +27,15 @@
   :use-module (ice-9 format)
   :use-module (ice-9 receive)
   :use-module (ice-9 and-let-star)
-  :export (disassemble-bootcode disassemble-program))
+  :export (disassemble-dumpcode disassemble-program))
 
-(define (disassemble-bootcode bytes . opts)
+(define (disassemble-dumpcode dumpcode . opts)
-  (if (not (bootcode? bytes)) (error "Invalid bootcode"))
+  (if (not (dumpcode? dumpcode)) (error "Invalid dumpcode"))
-  (format #t "Disassembly of bootcode:\n\n")
+  (format #t "Disassembly of dumpcode:\n\n")
-  (format #t "Compiled for Guile VM ~A\n\n" (bootcode-version bytes))
+  (format #t "Compiled for Guile VM ~A\n\n" (dumpcode-version dumpcode))
   (format #t "nlocs = ~A  nexts = ~A\n\n"
-	  (bootcode-nlocs bytes) (bootcode-nexts bytes))
+	  (dumpcode-nlocs dumpcode) (dumpcode-nexts dumpcode))
-  (disassemble-bytecode (bootcode-bytecode bytes) #f))
+  (disassemble-bytecode (dumpcode-bytecode dumpcode) #f))
 
 (define (disassemble-program prog . opts)
   (let* ((arity (program-arity prog))
@@ -63,14 +63,14 @@
 
 (define (disassemble-bytecode bytes objs)
   (let ((decode (make-byte-decoder bytes))
-	(rest '()))
+	(programs '()))
     (do ((addr+code (decode) (decode)))
 	((not addr+code) (newline))
       (receive (addr code) addr+code
 	(match code
 	  (('load-program x)
 	   (let ((sym (gensym "")))
-	     (set! rest (acons sym x rest))
+	     (set! programs (acons sym x programs))
 	     (print-info addr (format #f "load-program #~A" sym) #f)))
 	  (else
 	   (let ((info (list->info code))
@@ -79,7 +79,7 @@
     (for-each (lambda (sym+bytes)
 		(format #t "Bytecode #~A:\n\n" (car sym+bytes))
 		(disassemble-bytecode (cdr sym+bytes) #f))
-	      (reverse! rest))))
+	      (reverse! programs))))
 
 (define (disassemble-objects objs)
   (display "Objects:\n\n")
@@ -109,13 +109,6 @@
 	       ((make-false) "#f")
 	       ((object-ref)
 		(if objs (object->string (vector-ref objs (car args))) #f))
-;;;	       ((local-ref local-set)
-;;;		;;'(ref x))
-;;;		#f)
-;;;	     ((module-ref module-set)
-;;;	      (let ((var (vector-ref objs (car args))))
-;;;		(list (if (eq? inst 'module-ref) 'ref 'set)
-;;;		      (if (pair? var) (car var) var))))
 	       (else #f)))))))
 
 (define (list->info list)

module/system/vm/load.scm

@@ -31,10 +31,7 @@
     (if (or (not (file-exists? compiled))
 	    (> (stat:mtime (stat file)) (stat:mtime (stat compiled))))
 	(compile-file-in file #f (lookup-language 'gscheme) #:O))
-    (let ((bytes (make-uniform-vector (stat:size (stat compiled)) #\a)))
+    (vm-load (the-vm) (load-dumpcode compiled))))
-      (call-with-input-file compiled
-	(lambda (p) (uniform-vector-read! bytes p)))
-      (vm-load (the-vm) bytes))))
 
 (define (file-name-full-name filename)
   (let ((oldname (and (current-load-port)