diff --git a/module/system/repl/command.gs b/module/system/repl/command.gs
deleted file mode 100644
index a4efa5364..000000000
--- a/module/system/repl/command.gs
+++ /dev/null
@@ -1,483 +0,0 @@
-;;; Repl commands
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;; 
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;; 
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(define (puts x) (display x) (newline))
-
-(define (user-error msg . args)
-  (throw 'user-error #f msg args #f))
-
-
-;;;
-;;; Meta command
-;;;
-
-(define *command-table*
-  '((help     (help h) (apropos a) (describe d) (option o) (quit q))
-    (module   (module m) (use u) (import i) (load l) (binding b) (lsmod lm))
-    (package  (package p) (lspkg lp) (autopackage) (globals g))
-    (language (language L))
-    (compile  (compile c) (compile-file cc)
-	      (disassemble x) (disassemble-file xx))
-    (profile  (time t) (profile pr))
-    (debug    (backtrace bt) (debugger db) (trace tr) (step st))
-    (system   (statistics stat) (gc))))
-
-(define (group-name g) (car g))
-(define (group-commands g) (cdr g))
-
-(define *command-module* (current-module))
-(define (command-name c) (car c))
-(define (command-abbrev c) (if (null? (cdr c)) #f (cadr c)))
-(define (command-procedure c) (module-ref *command-module* (command-name c)))
-(define (command-doc c) (procedure-documentation (command-procedure c)))
-
-(define (command-usage c)
-  (let ((doc (command-doc c)))
-    (substring doc 0 (string-index doc #\newline))))
-
-(define (command-summary c)
-  (let* ((doc (command-doc c))
-	 (start (1+ (string-index doc #\newline))))
-    (cond ((string-index doc #\newline start)
-	   => (lambda (end) (substring doc start end)))
-	  (else (substring doc start)))))
-
-(define (lookup-group name)
-  (assq name *command-table*))
-
-(define (lookup-command key)
-  (let loop ((groups *command-table*) (commands '()))
-    (cond ((and (null? groups) (null? commands)) #f)
-	  ((null? commands)
-	   (loop (cdr groups) (cdar groups)))
-	  ((memq key (car commands)) (car commands))
-	  (else (loop groups (cdr commands))))))
-
-(define (display-group group . opts)
-  (format #t "~:(~A~) Commands [abbrev]:~2%" (group-name group))
-  (for-each (lambda (c)
-	      (display-summary (command-usage c)
-			       (command-abbrev c)
-			       (command-summary c)))
-	    (group-commands group))
-  (newline))
-
-(define (display-command command)
-  (display "Usage: ")
-  (display (command-doc command))
-  (newline))
-
-(define (display-summary usage abbrev summary)
-  (let ((abbrev (if abbrev (format #f "[,~A]" abbrev) "")))
-    (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
-
-(define (meta-command repl line)
-  (let ((input (call-with-input-string (string-append "(" line ")") read)))
-    (if (not (null? input))
-	(do ((key (car input))
-	     (args (cdr input) (cdr args))
-	     (opts '() (cons (make-keyword-from-dash-symbol (car args)) opts)))
-	    ((or (null? args)
-		 (not (symbol? (car args)))
-		 (not (eq? (string-ref (symbol->string (car args)) 0) #\-)))
-	     (let ((c (lookup-command key)))
-	       (if c
-		   (cond ((memq :h opts) (display-command c))
-			 (else (apply (command-procedure c)
-				      repl (append! args opts))))
-		   (user-error "Unknown meta command: ~A" key))))))))
-
-
-;;;
-;;; Help commands
-;;;
-
-(define (help repl . args)
-  "help [GROUP]
-Show help messages.
-The optional argument can be either one of command groups or
-command names.  Without argument, a list of help commands and
-all command groups are displayed, as you have already seen :)"
-  (match args
-    (()
-     (display-group (lookup-group 'help))
-     (display "Command Groups:\n\n")
-     (display-summary "help all" #f "List all commands")
-     (for-each (lambda (g)
-		 (let* ((name (symbol->string (group-name g)))
-			(usage (string-append "help " name))
-			(header (string-append "List " name " commands")))
-		   (display-summary usage #f header)))
-	       (cdr *command-table*))
-     (newline)
-     (display "Enter `,COMMAND -h' to display documentation of each command.")
-     (newline))
-    (('all)
-     (for-each display-group *command-table*))
-    ((? lookup-group group)
-     (display-group (lookup-group group)))
-    (else (user-error "Unknown command group: ~A" (car args)))))
-
-(define guile-apropos apropos)
-(define (apropos repl regexp)
-  "apropos [options] REGEXP
-Find bindings/modules/packages."
-  (guile-apropos (object->string regexp display)))
-
-(define (describe repl obj)
-  "describe OBJ
-Show description/documentation."
-  (display "Not implemented yet\n"))
-
-(define (option repl . args)
-  "option [KEY [VALUE]]
-List/show/set options."
-  (display "Not implemented yet\n"))
-
-(define (quit repl)
-  "quit
-Quit this session."
-  (throw 'quit))
-
-
-;;;
-;;; Module commands
-;;;
-
-(define (module repl . args)
-  "module [MODULE]
-Change modules / Show current module."
-  (match args
-    (() (puts (binding repl.module)))))
-
-(define (use repl . args)
-  "use [MODULE ...]
-Use modules."
-  (define (use name)
-    (let ((mod (resolve-interface name)))
-      (if mod
-	  (module-use! repl.module mod)
-	  (user-error "No such module: ~A" name))))
-  (if (null? args)
-      (for-each puts (map module-name
-			  (cons repl.module (module-uses repl.module))))
-      (for-each (lambda (name)
-		  (cond
-		   ((pair? name) (use name))
-		   ((symbol? name)
-		    (cond ((find-one-module (symbol->string name)) => use)))
-		   (else (user-error "Invalid module name: ~A" name))))
-		args)))
-
-(define (import repl . args)
-  "import [MODULE ...]
-Import modules / List those imported."
-  (define (use name)
-    (let ((mod (resolve-interface name)))
-      (if mod
-	  (module-use! repl.module mod)
-	  (user-error "No such module: ~A" name))))
-  (if (null? args)
-      (for-each puts (map module-name
-			  (cons repl.module (module-uses repl.module))))
-      (for-each (lambda (name)
-		  (cond
-		   ((pair? name) (use name))
-		   ((symbol? name)
-		    (and-let* ((m (find-one-module (symbol->string name))))
-		      (puts m) (use m)))
-		   (else (user-error "Invalid module name: ~A" name))))
-		args)))
-
-(define (load repl file . opts)
-  "load [options] FILE
-Load a file in the current module."
-  (apply repl-load-file repl (->string file) opts))
-
-(define (binding repl . opts)
-  "binding [-a]
-List current bindings."
-  (fold (lambda (s v d) (format #t "~23A ~A\n" s v)) #f repl.module))
-
-(define (lsmod repl . args)
-  "lsmod
-."
-  (define (use name)
-    (set! repl.module (resolve-module name))
-    (module-use! repl.module repl.value-history))
-  (if (null? args)
-      (use '(guile-user))
-      (let ((name (car args)))
-	(cond
-	 ((pair? name) (use name))
-	 ((symbol? name)
-	  (and-let* ((m (find-one-module (symbol->string name))))
-	    (puts m) (use m)))
-	 (else (user-error "Invalid module name: ~A" name))))))
-
-
-;;;
-;;; Package commands
-;;;
-
-(define (package repl)
-  "package [PACKAGE]
-List available packages/modules."
-  (for-each puts (find-module "")))
-
-(define (lspkg repl)
-  "lspkg
-List available packages/modules."
-  (for-each puts (find-module "")))
-
-(define (autopackage repl)
-  "autopackage
-List available packages/modules."
-  (for-each puts (find-module "")))
-
-(define (globals repl)
-  "globals
-List all global variables."
-  (global-fold (lambda (s v d) (format #t "~A\t~S\n" s v)) #f))
-
-
-;;;
-;;; Language commands
-;;;
-
-(define (language repl name)
-  "language LANGUAGE
-Change languages."
-  (set! repl.language (lookup-language name))
-  (repl-welcome repl))
-
-
-;;;
-;;; Compile commands
-;;;
-
-(define (compile repl form . opts)
-  "compile [options] FORM
-Generate compiled code.
-
-  -e    Stop after expanding syntax/macro
-  -t    Stop after translating into GHIL
-  -c    Stop after generating GLIL
-
-  -O    Enable optimization
-  -D    Add debug information"
-  (let ((x (apply repl-compile repl form opts)))
-    (cond ((null? opts)
-	   (disassemble-bytecode x))
-	  ((memq :c opts)
-	   (pprint-glil x))
-	  (else (puts x)))))
-
-(define (compile-file repl file . opts)
-  "compile-file [options] FILE
-Compile a file."
-  (apply repl-compile-file repl (->string file) opts))
-
-(define (disassemble repl prog)
-  "disassemble PROGRAM
-Disassemble a program."
-  (disassemble-program (repl-eval repl prog)))
-
-(define (disassemble-file repl file)
-  "disassemble-file FILE
-Disassemble a file."
-  (disassemble-bytecode (load-file-in (->string file)
-				      repl.module
-				      repl.language)))
-
-(define (->string x)
-  (object->string x display))
-
-
-;;;
-;;; Profile commands
-;;;
-
-(define (profile repl form . opts)
-  "profile FORM
-Profile execution."
-  (apply vm-profile repl.vm (repl-compile repl form) opts))
-
-
-;;;
-;;; Debug commands
-;;;
-
-(define guile-backtrace backtrace)
-(define (backtrace repl)
-  "backtrace
-Show backtrace (if any)."
-  (guile-backtrace))
-
-(define (debugger repl)
-  "debugger
-Start debugger."
-  (debug))
-
-(define (trace repl form . opts)
-  "trace [-a] FORM
-Trace execution."
-  (apply vm-trace repl.vm (repl-compile repl form) opts))
-
-(define (step repl)
-  "step FORM
-Step execution."
-  (display "Not implemented yet\n"))
-
-
-;;;
-;;; System commands 
-;;;
-
-(define (time repl form)
-  "time FORM
-Time execution."
-  (let* ((vms-start (vm-stats repl.vm))
-	 (gc-start (gc-run-time))
-	 (tms-start (times))
-	 (result (repl-eval repl form))
-	 (tms-end (times))
-	 (gc-end (gc-run-time))
-	 (vms-end (vm-stats repl.vm)))
-    (define (get proc start end)
-      (/ (- (proc end) (proc start)) internal-time-units-per-second))
-    (repl-print repl result)
-    (display "clock utime stime cutime cstime gctime\n")
-    (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
-	    (get tms:clock tms-start tms-end)
-	    (get tms:utime tms-start tms-end)
-	    (get tms:stime tms-start tms-end)
-	    (get tms:cutime tms-start tms-end)
-	    (get tms:cstime tms-start tms-end)
-	    (get id gc-start gc-end))
-    result))
-
-;;;
-;;; Statistics
-;;;
-
-(define guile-gc gc)
-(define (gc repl)
-  "gc
-Garbage collection."
-  (guile-gc))
-
-(define (display-stat title flag field1 field2 unit)
-  (let ((str (format #f "~~20~AA ~~10@A /~~10@A ~~A~~%" (if flag "" "@"))))
-    (format #t str title field1 field2 unit)))
-
-(define (display-stat-title title field1 field2)
-  (display-stat title #t field1 field2 ""))
-
-(define (display-diff-stat title flag this last unit)
-  (display-stat title flag (- this last) this unit))
-
-(define (display-time-stat title this last)
-  (define (conv num)
-    (format #f "~10,2F" (/ num internal-time-units-per-second)))
-  (display-stat title #f (conv (- this last)) (conv this) "s"))
-
-(define (display-mips-stat title this-time this-clock last-time last-clock)
-  (define (mips time clock)
-    (if (= time 0) "----" (format #f "~10,2F" (/ clock time 1000000))))
-  (display-stat title #f
-		(mips (- this-time last-time) (- this-clock last-clock))
-		(mips this-time this-clock) "mips"))
-
-(define (statistics repl)
-  "statistics
-Display statistics."
-  (let ((this-tms (times))
-	(this-vms (vm-stats repl.vm))
-	(this-gcs (gc-stats))
-	(last-tms repl.tm-stats)
-	(last-vms repl.vm-stats)
-	(last-gcs repl.gc-stats))
-    ;; GC times
-    (let ((this-times  (assq-ref this-gcs 'gc-times))
-	  (last-times  (assq-ref last-gcs 'gc-times)))
-      (display-diff-stat "GC times:" #t this-times last-times "times")
-      (newline))
-    ;; Memory size
-    (let ((this-cells  (assq-ref this-gcs 'cells-allocated))
-	  (this-heap   (assq-ref this-gcs 'cell-heap-size))
-	  (this-bytes  (assq-ref this-gcs 'bytes-malloced))
-	  (this-malloc (assq-ref this-gcs 'gc-malloc-threshold)))
-      (display-stat-title "Memory size:" "current" "limit")
-      (display-stat "heap" #f this-cells this-heap "cells")
-      (display-stat "malloc" #f this-bytes this-malloc "bytes")
-      (newline))
-    ;; Cells collected
-    (let ((this-marked (assq-ref this-gcs 'cells-marked))
-	  (last-marked (assq-ref last-gcs 'cells-marked))
-	  (this-swept  (assq-ref this-gcs 'cells-swept))
-	  (last-swept  (assq-ref last-gcs 'cells-swept)))
-      (display-stat-title "Cells collected:" "diff" "total")
-      (display-diff-stat "marked" #f this-marked last-marked "cells")
-      (display-diff-stat "swept" #f this-swept last-swept "cells")
-      (newline))
-    ;; GC time taken
-    (let ((this-mark  (assq-ref this-gcs 'gc-mark-time-taken))
-	  (last-mark  (assq-ref last-gcs 'gc-mark-time-taken))
-	  (this-sweep (assq-ref this-gcs 'gc-sweep-time-taken))
-	  (last-sweep (assq-ref last-gcs 'gc-sweep-time-taken))
-	  (this-total (assq-ref this-gcs 'gc-time-taken))
-	  (last-total (assq-ref last-gcs 'gc-time-taken)))
-      (display-stat-title "GC time taken:" "diff" "total")
-      (display-time-stat "mark" this-mark last-mark)
-      (display-time-stat "sweep" this-sweep last-sweep)
-      (display-time-stat "total" this-total last-total)
-      (newline))
-    ;; Process time spent
-    (let ((this-utime  (tms:utime this-tms))
-	  (last-utime  (tms:utime last-tms))
-	  (this-stime  (tms:stime this-tms))
-	  (last-stime  (tms:stime last-tms))
-	  (this-cutime (tms:cutime this-tms))
-	  (last-cutime (tms:cutime last-tms))
-	  (this-cstime (tms:cstime this-tms))
-	  (last-cstime (tms:cstime last-tms)))
-      (display-stat-title "Process time spent:" "diff" "total")
-      (display-time-stat "user" this-utime last-utime)
-      (display-time-stat "system" this-stime last-stime)
-      (display-time-stat "child user" this-cutime last-cutime)
-      (display-time-stat "child system" this-cstime last-cstime)
-      (newline))
-    ;; VM statistics
-    (let ((this-time  (vms:time this-vms))
-	  (last-time  (vms:time last-vms))
-	  (this-clock (vms:clock this-vms))
-	  (last-clock (vms:clock last-vms)))
-      (display-stat-title "VM statistics:" "diff" "total")
-      (display-time-stat "time spent" this-time last-time)
-      (display-diff-stat "bogoclock" #f this-clock last-clock "clock")
-      (display-mips-stat "bogomips" this-time this-clock last-time last-clock)
-      (newline))
-    ;; Save statistics
-    ;; Save statistics
-    (set! repl.tm-stats this-tms)
-    (set! repl.vm-stats this-vms)
-    (set! repl.gc-stats this-gcs)))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 9cf21df01..9991b571d 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -35,4 +35,464 @@
   :use-module (ice-9 debugger)
   :export (meta-command))
 
-(load "command.gs")
+(define (puts x) (display x) (newline))
+
+(define (user-error msg . args)
+  (throw 'user-error #f msg args #f))
+
+
+;;;
+;;; Meta command
+;;;
+
+(define *command-table*
+  '((help     (help h) (apropos a) (describe d) (option o) (quit q))
+    (module   (module m) (use u) (import i) (load l) (binding b) (lsmod lm))
+    (package  (package p) (lspkg lp) (autopackage) (globals g))
+    (language (language L))
+    (compile  (compile c) (compile-file cc)
+	      (disassemble x) (disassemble-file xx))
+    (profile  (time t) (profile pr))
+    (debug    (backtrace bt) (debugger db) (trace tr) (step st))
+    (system   (statistics stat) (gc))))
+
+(define (group-name g) (car g))
+(define (group-commands g) (cdr g))
+
+(define *command-module* (current-module))
+(define (command-name c) (car c))
+(define (command-abbrev c) (if (null? (cdr c)) #f (cadr c)))
+(define (command-procedure c) (module-ref *command-module* (command-name c)))
+(define (command-doc c) (procedure-documentation (command-procedure c)))
+
+(define (command-usage c)
+  (let ((doc (command-doc c)))
+    (substring doc 0 (string-index doc #\newline))))
+
+(define (command-summary c)
+  (let* ((doc (command-doc c))
+	 (start (1+ (string-index doc #\newline))))
+    (cond ((string-index doc #\newline start)
+	   => (lambda (end) (substring doc start end)))
+	  (else (substring doc start)))))
+
+(define (lookup-group name)
+  (assq name *command-table*))
+
+(define (lookup-command key)
+  (let loop ((groups *command-table*) (commands '()))
+    (cond ((and (null? groups) (null? commands)) #f)
+	  ((null? commands)
+	   (loop (cdr groups) (cdar groups)))
+	  ((memq key (car commands)) (car commands))
+	  (else (loop groups (cdr commands))))))
+
+(define (display-group group . opts)
+  (format #t "~:(~A~) Commands [abbrev]:~2%" (group-name group))
+  (for-each (lambda (c)
+	      (display-summary (command-usage c)
+			       (command-abbrev c)
+			       (command-summary c)))
+	    (group-commands group))
+  (newline))
+
+(define (display-command command)
+  (display "Usage: ")
+  (display (command-doc command))
+  (newline))
+
+(define (display-summary usage abbrev summary)
+  (let ((abbrev (if abbrev (format #f "[,~A]" abbrev) "")))
+    (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
+
+(define (meta-command repl line)
+  (let ((input (call-with-input-string (string-append "(" line ")") read)))
+    (if (not (null? input))
+	(do ((key (car input))
+	     (args (cdr input) (cdr args))
+	     (opts '() (cons (make-keyword-from-dash-symbol (car args)) opts)))
+	    ((or (null? args)
+		 (not (symbol? (car args)))
+		 (not (eq? (string-ref (symbol->string (car args)) 0) #\-)))
+	     (let ((c (lookup-command key)))
+	       (if c
+		   (cond ((memq :h opts) (display-command c))
+			 (else (apply (command-procedure c)
+				      repl (append! args opts))))
+		   (user-error "Unknown meta command: ~A" key))))))))
+
+
+;;;
+;;; Help commands
+;;;
+
+(define (help repl . args)
+  "help [GROUP]
+Show help messages.
+The optional argument can be either one of command groups or
+command names.  Without argument, a list of help commands and
+all command groups are displayed, as you have already seen :)"
+  (match args
+    (()
+     (display-group (lookup-group 'help))
+     (display "Command Groups:\n\n")
+     (display-summary "help all" #f "List all commands")
+     (for-each (lambda (g)
+		 (let* ((name (symbol->string (group-name g)))
+			(usage (string-append "help " name))
+			(header (string-append "List " name " commands")))
+		   (display-summary usage #f header)))
+	       (cdr *command-table*))
+     (newline)
+     (display "Enter `,COMMAND -h' to display documentation of each command.")
+     (newline))
+    (('all)
+     (for-each display-group *command-table*))
+    ((? lookup-group group)
+     (display-group (lookup-group group)))
+    (else (user-error "Unknown command group: ~A" (car args)))))
+
+(define guile-apropos apropos)
+(define (apropos repl regexp)
+  "apropos [options] REGEXP
+Find bindings/modules/packages."
+  (guile-apropos (object->string regexp display)))
+
+(define (describe repl obj)
+  "describe OBJ
+Show description/documentation."
+  (display "Not implemented yet\n"))
+
+(define (option repl . args)
+  "option [KEY [VALUE]]
+List/show/set options."
+  (display "Not implemented yet\n"))
+
+(define (quit repl)
+  "quit
+Quit this session."
+  (throw 'quit))
+
+
+;;;
+;;; Module commands
+;;;
+
+(define (module repl . args)
+  "module [MODULE]
+Change modules / Show current module."
+  (match args
+    (() (puts (binding repl.module)))))
+
+(define (use repl . args)
+  "use [MODULE ...]
+Use modules."
+  (define (use name)
+    (let ((mod (resolve-interface name)))
+      (if mod
+	  (module-use! repl.module mod)
+	  (user-error "No such module: ~A" name))))
+  (if (null? args)
+      (for-each puts (map module-name
+			  (cons repl.module (module-uses repl.module))))
+      (for-each (lambda (name)
+		  (cond
+		   ((pair? name) (use name))
+		   ((symbol? name)
+		    (cond ((find-one-module (symbol->string name)) => use)))
+		   (else (user-error "Invalid module name: ~A" name))))
+		args)))
+
+(define (import repl . args)
+  "import [MODULE ...]
+Import modules / List those imported."
+  (define (use name)
+    (let ((mod (resolve-interface name)))
+      (if mod
+	  (module-use! repl.module mod)
+	  (user-error "No such module: ~A" name))))
+  (if (null? args)
+      (for-each puts (map module-name
+			  (cons repl.module (module-uses repl.module))))
+      (for-each (lambda (name)
+		  (cond
+		   ((pair? name) (use name))
+		   ((symbol? name)
+		    (and-let* ((m (find-one-module (symbol->string name))))
+		      (puts m) (use m)))
+		   (else (user-error "Invalid module name: ~A" name))))
+		args)))
+
+(define (load repl file . opts)
+  "load [options] FILE
+Load a file in the current module."
+  (apply repl-load-file repl (->string file) opts))
+
+(define (binding repl . opts)
+  "binding [-a]
+List current bindings."
+  (fold (lambda (s v d) (format #t "~23A ~A\n" s v)) #f repl.module))
+
+(define (lsmod repl . args)
+  "lsmod
+."
+  (define (use name)
+    (set! repl.module (resolve-module name))
+    (module-use! repl.module repl.value-history))
+  (if (null? args)
+      (use '(guile-user))
+      (let ((name (car args)))
+	(cond
+	 ((pair? name) (use name))
+	 ((symbol? name)
+	  (and-let* ((m (find-one-module (symbol->string name))))
+	    (puts m) (use m)))
+	 (else (user-error "Invalid module name: ~A" name))))))
+
+
+;;;
+;;; Package commands
+;;;
+
+(define (package repl)
+  "package [PACKAGE]
+List available packages/modules."
+  (for-each puts (find-module "")))
+
+(define (lspkg repl)
+  "lspkg
+List available packages/modules."
+  (for-each puts (find-module "")))
+
+(define (autopackage repl)
+  "autopackage
+List available packages/modules."
+  (for-each puts (find-module "")))
+
+(define (globals repl)
+  "globals
+List all global variables."
+  (global-fold (lambda (s v d) (format #t "~A\t~S\n" s v)) #f))
+
+
+;;;
+;;; Language commands
+;;;
+
+(define (language repl name)
+  "language LANGUAGE
+Change languages."
+  (set! repl.language (lookup-language name))
+  (repl-welcome repl))
+
+
+;;;
+;;; Compile commands
+;;;
+
+(define (compile repl form . opts)
+  "compile [options] FORM
+Generate compiled code.
+
+  -e    Stop after expanding syntax/macro
+  -t    Stop after translating into GHIL
+  -c    Stop after generating GLIL
+
+  -O    Enable optimization
+  -D    Add debug information"
+  (let ((x (apply repl-compile repl form opts)))
+    (cond ((null? opts)
+	   (disassemble-bootcode x))
+	  ((memq :c opts)
+	   (pprint-glil x))
+	  (else (puts x)))))
+
+(define (compile-file repl file . opts)
+  "compile-file [options] FILE
+Compile a file."
+  (apply repl-compile-file repl (->string file) opts))
+
+(define (disassemble repl prog)
+  "disassemble PROGRAM
+Disassemble a program."
+  (disassemble-program (repl-eval repl prog)))
+
+(define (disassemble-file repl file)
+  "disassemble-file FILE
+Disassemble a file."
+  (disassemble-bootcode
+   (load-file-in (->string file) repl.module repl.language)))
+
+(define (->string x)
+  (object->string x display))
+
+
+;;;
+;;; Profile commands
+;;;
+
+(define (profile repl form . opts)
+  "profile FORM
+Profile execution."
+  (apply vm-profile repl.vm (repl-compile repl form) opts))
+
+
+;;;
+;;; Debug commands
+;;;
+
+(define guile-backtrace backtrace)
+(define (backtrace repl)
+  "backtrace
+Show backtrace (if any)."
+  (guile-backtrace))
+
+(define (debugger repl)
+  "debugger
+Start debugger."
+  (debug))
+
+(define (trace repl form . opts)
+  "trace [-a] FORM
+Trace execution."
+  (apply vm-trace repl.vm (repl-compile repl form) opts))
+
+(define (step repl)
+  "step FORM
+Step execution."
+  (display "Not implemented yet\n"))
+
+
+;;;
+;;; System commands 
+;;;
+
+(define (time repl form)
+  "time FORM
+Time execution."
+  (let* ((vms-start (vm-stats repl.vm))
+	 (gc-start (gc-run-time))
+	 (tms-start (times))
+	 (result (repl-eval repl form))
+	 (tms-end (times))
+	 (gc-end (gc-run-time))
+	 (vms-end (vm-stats repl.vm)))
+    (define (get proc start end)
+      (/ (- (proc end) (proc start)) internal-time-units-per-second))
+    (repl-print repl result)
+    (display "clock utime stime cutime cstime gctime\n")
+    (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
+	    (get tms:clock tms-start tms-end)
+	    (get tms:utime tms-start tms-end)
+	    (get tms:stime tms-start tms-end)
+	    (get tms:cutime tms-start tms-end)
+	    (get tms:cstime tms-start tms-end)
+	    (get id gc-start gc-end))
+    result))
+
+;;;
+;;; Statistics
+;;;
+
+(define guile-gc gc)
+(define (gc repl)
+  "gc
+Garbage collection."
+  (guile-gc))
+
+(define (display-stat title flag field1 field2 unit)
+  (let ((str (format #f "~~20~AA ~~10@A /~~10@A ~~A~~%" (if flag "" "@"))))
+    (format #t str title field1 field2 unit)))
+
+(define (display-stat-title title field1 field2)
+  (display-stat title #t field1 field2 ""))
+
+(define (display-diff-stat title flag this last unit)
+  (display-stat title flag (- this last) this unit))
+
+(define (display-time-stat title this last)
+  (define (conv num)
+    (format #f "~10,2F" (/ num internal-time-units-per-second)))
+  (display-stat title #f (conv (- this last)) (conv this) "s"))
+
+(define (display-mips-stat title this-time this-clock last-time last-clock)
+  (define (mips time clock)
+    (if (= time 0) "----" (format #f "~10,2F" (/ clock time 1000000))))
+  (display-stat title #f
+		(mips (- this-time last-time) (- this-clock last-clock))
+		(mips this-time this-clock) "mips"))
+
+(define (statistics repl)
+  "statistics
+Display statistics."
+  (let ((this-tms (times))
+	(this-vms (vm-stats repl.vm))
+	(this-gcs (gc-stats))
+	(last-tms repl.tm-stats)
+	(last-vms repl.vm-stats)
+	(last-gcs repl.gc-stats))
+    ;; GC times
+    (let ((this-times  (assq-ref this-gcs 'gc-times))
+	  (last-times  (assq-ref last-gcs 'gc-times)))
+      (display-diff-stat "GC times:" #t this-times last-times "times")
+      (newline))
+    ;; Memory size
+    (let ((this-cells  (assq-ref this-gcs 'cells-allocated))
+	  (this-heap   (assq-ref this-gcs 'cell-heap-size))
+	  (this-bytes  (assq-ref this-gcs 'bytes-malloced))
+	  (this-malloc (assq-ref this-gcs 'gc-malloc-threshold)))
+      (display-stat-title "Memory size:" "current" "limit")
+      (display-stat "heap" #f this-cells this-heap "cells")
+      (display-stat "malloc" #f this-bytes this-malloc "bytes")
+      (newline))
+    ;; Cells collected
+    (let ((this-marked (assq-ref this-gcs 'cells-marked))
+	  (last-marked (assq-ref last-gcs 'cells-marked))
+	  (this-swept  (assq-ref this-gcs 'cells-swept))
+	  (last-swept  (assq-ref last-gcs 'cells-swept)))
+      (display-stat-title "Cells collected:" "diff" "total")
+      (display-diff-stat "marked" #f this-marked last-marked "cells")
+      (display-diff-stat "swept" #f this-swept last-swept "cells")
+      (newline))
+    ;; GC time taken
+    (let ((this-mark  (assq-ref this-gcs 'gc-mark-time-taken))
+	  (last-mark  (assq-ref last-gcs 'gc-mark-time-taken))
+	  (this-sweep (assq-ref this-gcs 'gc-sweep-time-taken))
+	  (last-sweep (assq-ref last-gcs 'gc-sweep-time-taken))
+	  (this-total (assq-ref this-gcs 'gc-time-taken))
+	  (last-total (assq-ref last-gcs 'gc-time-taken)))
+      (display-stat-title "GC time taken:" "diff" "total")
+      (display-time-stat "mark" this-mark last-mark)
+      (display-time-stat "sweep" this-sweep last-sweep)
+      (display-time-stat "total" this-total last-total)
+      (newline))
+    ;; Process time spent
+    (let ((this-utime  (tms:utime this-tms))
+	  (last-utime  (tms:utime last-tms))
+	  (this-stime  (tms:stime this-tms))
+	  (last-stime  (tms:stime last-tms))
+	  (this-cutime (tms:cutime this-tms))
+	  (last-cutime (tms:cutime last-tms))
+	  (this-cstime (tms:cstime this-tms))
+	  (last-cstime (tms:cstime last-tms)))
+      (display-stat-title "Process time spent:" "diff" "total")
+      (display-time-stat "user" this-utime last-utime)
+      (display-time-stat "system" this-stime last-stime)
+      (display-time-stat "child user" this-cutime last-cutime)
+      (display-time-stat "child system" this-cstime last-cstime)
+      (newline))
+    ;; VM statistics
+    (let ((this-time  (vms:time this-vms))
+	  (last-time  (vms:time last-vms))
+	  (this-clock (vms:clock this-vms))
+	  (last-clock (vms:clock last-vms)))
+      (display-stat-title "VM statistics:" "diff" "total")
+      (display-time-stat "time spent" this-time last-time)
+      (display-diff-stat "bogoclock" #f this-clock last-clock "clock")
+      (display-mips-stat "bogomips" this-time this-clock last-time last-clock)
+      (newline))
+    ;; Save statistics
+    ;; Save statistics
+    (set! repl.tm-stats this-tms)
+    (set! repl.vm-stats this-vms)
+    (set! repl.gc-stats this-gcs)))
diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm
index 90e0411bf..bda7490a1 100644
--- a/module/system/vm/assemble.scm
+++ b/module/system/vm/assemble.scm
@@ -30,7 +30,7 @@
   :export (assemble))
 
 (define (assemble glil env . opts)
-  (optimizing-dump (codegen (preprocess glil #f) #t)))
+  (codegen (preprocess glil #f) #t))
 
 
 ;;;
@@ -147,24 +147,29 @@
        ;;
        ;; main
        (for-each generate-code body)
-       (let ((bytes (apply string-append (stack-finalize (reverse! stack))))
+       (let ((bytes (stack->bytes stack))
 	     (objs (map car (reverse! object-alist))))
-	 (make-bytespec nargs nrest nlocs nexts bytes objs))))))
+	 (if toplevel
+	     (make-bootcode nlocs nexts bytes)
+	     (make-bytespec nargs nrest nlocs nexts bytes objs)))))))
 
-(define (stack-finalize stack)
-  (let loop ((list '()) (stack stack) (addr 0))
+(define (stack->bytes stack)
+  (let loop ((result '()) (stack (reverse! stack)) (addr 0))
     (if (null? stack)
-	(reverse! list)
+	(apply string-append (reverse! result))
 	(let* ((orig (car stack))
 	       (addr (+ addr (length orig)))
 	       (code (if (and (pair? (cdr orig)) (procedure? (cadr orig)))
 			 `(,(car orig) ,((cadr orig) addr))
 			 orig)))
-	  (loop (cons (code->bytes code) list) (cdr stack) addr)))))
+	  (loop (cons (code->bytes code) result) (cdr stack) addr)))))
 
-;; Optimization
+
+;;;
+;;; Bytecode optimization
+;;;
 
-(define *optimize-table*
+(define *optimization-table*
   '((not       (not       . not-not)
 	       (eq?       . not-eq?)
 	       (null?     . not-null?)
@@ -185,53 +190,48 @@
 	       (not-null? . br-if-null))))
 
 (define (optimizing-push code stack)
-  (let ((alist (assq-ref *optimize-table* (car code))))
+  (let ((alist (assq-ref *optimization-table* (car code))))
     (cond ((and alist (pair? stack) (assq-ref alist (caar stack))) =>
 	   (lambda (inst) (cons (cons inst (cdr code)) (cdr stack))))
 	  (else (cons (code-pack code) stack)))))
 
 
 ;;;
-;;; Stage3: Dump optimization
+;;; Object dump
 ;;;
 
-(define (optimizing-dump bytespec)
-  ;; no optimization yet
-  (bytespec-bytes bytespec))
+;; NOTE: undumpped in vm_load.c.
 
 (define (dump-object! x push-code!)
   (let dump! ((x x))
     (cond
      ((object->code x) => push-code!)
      ((bytespec? x)
-      (let ((nargs (bytespec-nargs x))
-	    (nrest (bytespec-nrest x))
-	    (nlocs (bytespec-nlocs x))
-	    (nexts (bytespec-nexts x))
-	    (bytes (bytespec-bytes x))
-	    (objs  (bytespec-objs x)))
-	;; dump parameters
-	(cond ((and (< nargs 4) (< nlocs 8) (< nexts 4))
-	       ;; 8-bit representation
-	       (let ((x (+ (* nargs 64) (* nrest 32) (* nlocs 4) nexts)))
-		 (push-code! `(make-int8 ,x))))
-	      ((and (< nargs 16) (< nlocs 128) (< nexts 16))
-	       ;; 16-bit representation
-	       (let ((x (+ (* nargs 4096) (* nrest 2048) (* nlocs 16) nexts)))
-		 (push-code! `(make-int16 ,(quotient x 256) ,(modulo x 256)))))
-	      (else
-	       ;; Other cases
-	       (push-code! (object->code nargs))
-	       (push-code! (object->code nrest))
-	       (push-code! (object->code nlocs))
-	       (push-code! (object->code nexts))
-	       (push-code! (object->code #f))))
-	;; dump object table
-	(cond ((not (null? objs))
-	       (for-each dump! objs)
-	       (push-code! `(vector ,(length objs)))))
-	;; dump bytecode
-	(push-code! `(load-program ,bytes))))
+      (match x
+	(($ bytespec nargs nrest nlocs nexts bytes objs)
+	 ;; dump parameters
+	 (cond
+	  ((and (< nargs 4) (< nlocs 8) (< nexts 4))
+	   ;; 8-bit representation
+	   (let ((x (+ (* nargs 64) (* nrest 32) (* nlocs 4) nexts)))
+	     (push-code! `(make-int8 ,x))))
+	  ((and (< nargs 16) (< nlocs 128) (< nexts 16))
+	   ;; 16-bit representation
+	   (let ((x (+ (* nargs 4096) (* nrest 2048) (* nlocs 16) nexts)))
+	     (push-code! `(make-int16 ,(quotient x 256) ,(modulo x 256)))))
+	  (else
+	   ;; Other cases
+	   (push-code! (object->code nargs))
+	   (push-code! (object->code nrest))
+	   (push-code! (object->code nlocs))
+	   (push-code! (object->code nexts))
+	   (push-code! (object->code #f))))
+	 ;; dump object table
+	 (cond ((not (null? objs))
+		(for-each dump! objs)
+		(push-code! `(vector ,(length objs)))))
+	 ;; dump bytecode
+	 (push-code! `(load-program ,bytes)))))
      ((vlink? x)
       ;; (push-code! `(local-ref ,(object-index (vlink-module x))))
       (dump! (vlink-name x))
@@ -264,10 +264,3 @@
       (push-code! `(vector ,(vector-length x))))
      (else
       (error "Cannot dump:" x)))))
-
-;;;(define (dump-table-object! obj+index)
-;;;  (let dump! ((x (car obj+index)))
-;;;    (cond
-;;;     (else
-;;;      (for-each push-code! (dump-object! x)))))
-;;;  (push-code! `(local-set ,(cdr obj+index))))
diff --git a/module/system/vm/conv.scm b/module/system/vm/conv.scm
index 543a8fa93..1151dc2b9 100644
--- a/module/system/vm/conv.scm
+++ b/module/system/vm/conv.scm
@@ -131,9 +131,11 @@
 
 
 ;;;
-;;; Variable-length code
+;;; Variable-length interface
 ;;;
 
+;; NOTE: decoded in vm_fetch_length in vm.c.
+
 (define (encode-length len)
   (define C integer->char)
   (cond ((< len 254) (string (C len)))
diff --git a/module/system/vm/core.scm b/module/system/vm/core.scm
index 07d5bd205..79e73c0dc 100644
--- a/module/system/vm/core.scm
+++ b/module/system/vm/core.scm
@@ -21,14 +21,60 @@
 
 (define-module (system vm core))
 
+;;;
+;;; Core procedures
+;;;
+
 (dynamic-call "scm_init_vm" (dynamic-link "libguilevm.so"))
 
-(export vms:cons vms:time vms:clock)
-
-(define (vms:time stat) (vector-ref stat 0))
-(define (vms:clock stat) (vector-ref stat 1))
-
 (module-export! (current-module)
 		(delq! '%module-public-interface
 		       (hash-fold (lambda (k v d) (cons k d)) '()
 				  (module-obarray (current-module)))))
+
+;;;
+;;; Bootcode interface
+;;;
+
+(export make-bootcode bootcode? bootcode-version
+	bootcode-nlocs bootcode-nexts bootcode-bytecode)
+
+(define *bootcode-cookie* (string-append "\0GBC-" (vm-version)))
+
+(define (make-bootcode nlocs nexts bytes)
+  (string-append *bootcode-cookie*
+		 (integer->bytes nlocs)
+		 (integer->bytes nexts)
+		 bytes))
+
+(define (bootcode? x)
+  (and (string? x)
+       (> (string-length x) 10)
+       (string=? (substring x 1 4) "GBC")))
+
+(define (bootcode-version x)
+  (substring x 5 8))
+
+(define (bootcode-nlocs x)
+  (bytes->integer x 8))
+
+(define (bootcode-nexts x)
+  (bytes->integer x 9))
+
+(define (bootcode-bytecode x)
+  (substring x 10))
+
+(define (integer->bytes n)
+  (string (integer->char n)))
+
+(define (bytes->integer bytes start)
+  (char->integer (string-ref bytes start)))
+
+;;;
+;;; Statistics interface
+;;;
+
+(export vms:time vms:clock)
+
+(define (vms:time stat) (vector-ref stat 0))
+(define (vms:clock stat) (vector-ref stat 1))
diff --git a/module/system/vm/disasm.scm b/module/system/vm/disasm.scm
index f18952abb..bad1166a4 100644
--- a/module/system/vm/disasm.scm
+++ b/module/system/vm/disasm.scm
@@ -27,18 +27,28 @@
   :use-module (ice-9 format)
   :use-module (ice-9 receive)
   :use-module (ice-9 and-let-star)
-  :export (disassemble-program disassemble-bytecode))
+  :export (disassemble-bootcode disassemble-program))
+
+(define (disassemble-bootcode bytes . opts)
+  (if (not (bootcode? bytes)) (error "Invalid bootcode"))
+  (format #t "Disassembly of bootcode:\n\n")
+  (format #t "Compiled for Guile VM ~A\n\n" (bootcode-version bytes))
+  (format #t "nlocs = ~A  nexts = ~A\n\n"
+	  (bootcode-nlocs bytes) (bootcode-nexts bytes))
+  (disassemble-bytecode (bootcode-bytecode bytes) #f))
 
 (define (disassemble-program prog . opts)
   (let* ((arity (program-arity prog))
 	 (nargs (car arity))
 	 (nrest (cadr arity))
 	 (nlocs (caddr arity))
+	 (nexts (cadddr arity))
 	 (bytes (program-bytecode prog))
 	 (objs  (program-objects prog)))
     ;; Disassemble this bytecode
     (format #t "Disassembly of ~A:\n\n" prog)
-    (format #t "args = ~A  rest = ~A  locals = ~A\n\n" nargs nrest nlocs)
+    (format #t "nargs = ~A  nrest = ~A  nlocs = ~A nexts ~A\n\n"
+	    nargs nrest nlocs nexts)
     (format #t "Bytecode:\n\n")
     (disassemble-bytecode bytes objs)
     (if (> (vector-length objs) 0)
@@ -51,7 +61,7 @@
 		  (apply disassemble-program x opts))))
      (vector->list objs))))
 
-(define (disassemble-bytecode bytes . opt)
+(define (disassemble-bytecode bytes objs)
   (let ((decode (make-byte-decoder bytes))
 	(rest '()))
     (do ((addr+code (decode) (decode)))
@@ -64,12 +74,11 @@
 	     (print-info addr (format #f "load-program #~A" sym) #f)))
 	  (else
 	   (let ((info (list->info code))
-		 (extra (original-value addr code
-					(if (null? opt) #f (car opt)))))
+		 (extra (original-value addr code objs)))
 	     (print-info addr info extra))))))
     (for-each (lambda (sym+bytes)
 		(format #t "Bytecode #~A:\n\n" (car sym+bytes))
-		(disassemble-bytecode (cdr sym+bytes)))
+		(disassemble-bytecode (cdr sym+bytes) #f))
 	      (reverse! rest))))
 
 (define (disassemble-objects objs)
diff --git a/src/programs.c b/src/programs.c
index d224524ca..406c00952 100644
--- a/src/programs.c
+++ b/src/programs.c
@@ -119,18 +119,12 @@ static int
 program_print (SCM obj, SCM port, scm_print_state *pstate)
 {
   SCM name = scm_object_property (obj, scm_sym_name);
+  scm_puts ("#<program ", port);
   if (SCM_FALSEP (name))
-    {
-      scm_puts ("#<program 0x", port);
-      scm_intprint ((long) SCM_PROGRAM_BASE (obj), 16, port);
-      scm_putc ('>', port);
-    }
+    scm_intprint ((long) SCM_PROGRAM_BASE (obj), 16, port);
   else
-    {
-      scm_puts ("#<program ", port);
-      scm_display (name, port);
-      scm_putc ('>', port);
-    }
+    scm_display (name, port);
+  scm_putc ('>', port);
   return 1;
 }
 
diff --git a/src/vm.c b/src/vm.c
index 9428890f3..4aae67880 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -203,6 +203,7 @@ SCM_SYMBOL (sym_vm_error, "vm-error");
 static scm_byte_t *
 vm_fetch_length (scm_byte_t *ip, size_t *lenp)
 {
+  /* NOTE: format defined in system/vm/conv.scm */
   *lenp = *ip++;
   if (*lenp < 254)
     return ip;
@@ -566,18 +567,30 @@ SCM_DEFINE (scm_vm_fetch_stack, "vm-fetch-stack", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_vm_load, "vm-load", 2, 0, 0,
-	    (SCM vm, SCM bytes),
+	    (SCM vm, SCM bootcode),
 	    "")
 #define FUNC_NAME s_scm_vm_load
 {
   SCM prog;
+  int len;
+  char *base;
 
   SCM_VALIDATE_VM (1, vm);
-  SCM_VALIDATE_STRING (2, bytes);
+  SCM_VALIDATE_STRING (2, bootcode);
 
-  prog = scm_c_make_program (SCM_STRING_CHARS (bytes),
-			     SCM_STRING_LENGTH (bytes),
-			     bytes);
+  base = SCM_STRING_CHARS (bootcode);
+  len  = SCM_STRING_LENGTH (bootcode);
+
+  /* Check bootcode */
+  if (strncmp (base, "\0GBC", 4) != 0)
+    SCM_MISC_ERROR ("Invalid bootcode: ~S", SCM_LIST1 (bootcode));
+
+  /* Create program */
+  prog  = scm_c_make_program (base + 10, len - 10, bootcode);
+  SCM_PROGRAM_NLOCS (prog) = base[8];
+  SCM_PROGRAM_NEXTS (prog) = base[9];
+
+  /* Load it */
   return scm_vm_apply (vm, prog, SCM_EOL);
 }
 #undef FUNC_NAME
diff --git a/src/vm_loader.c b/src/vm_loader.c
index 6578198f6..558997232 100644
--- a/src/vm_loader.c
+++ b/src/vm_loader.c
@@ -124,6 +124,7 @@ VM_DEFINE_INSTRUCTION (load_program, "load-program", -1, 0, 1)
     }
 
   /* init parameters */
+  /* NOTE: format defined in system/vm/assemble.scm */
   if (SCM_INUMP (x))
     {
       int i = SCM_INUM (x);