diff --git a/module/system/base/language.scm b/module/system/base/language.scm index 41d577b53..6e22398d7 100644 --- a/module/system/base/language.scm +++ b/module/system/base/language.scm @@ -28,8 +28,7 @@ :use-module (system vm assemble) :use-module (ice-9 regex) :export (define-language lookup-language - read-in compile-in print-in compile-file-in load-file-in - hacked-load-in)) + read-in compile-in print-in compile-file-in load-file-in)) ;;; @@ -108,10 +107,6 @@ (uniform-vector-read! bytes p) bytes))))) -(define (hacked-load-in file lang) - ((vm-load (make-vm) - (load-file-in file (global-ref 'user) (lookup-language lang))))) - (define (object-file-name file) (let ((m (string-match "\\.[^.]*$" file))) (string-append (if m (match:prefix m) file) ".go"))) diff --git a/module/system/base/module.scm b/module/system/base/module.scm index 99cc0ec7b..20da03729 100644 --- a/module/system/base/module.scm +++ b/module/system/base/module.scm @@ -216,7 +216,3 @@ (let ((core (make-vmodule))) (env-define *root-package* 'core core) (hash-fold (lambda (s v d) (env-define core s v)) #f (builtin-bindings))) - -(let ((module (make-vmodule))) - (env-define (global-ref 'System::Base) 'module module) - (import-old-module! module (current-module))) diff --git a/module/system/il/compile.scm b/module/system/il/compile.scm index fa73486e6..3384e25f4 100644 --- a/module/system/il/compile.scm +++ b/module/system/il/compile.scm @@ -22,7 +22,6 @@ (define-module (system il compile) :use-module (oop goops) :use-syntax (system base syntax) - :use-module (system base module) :use-module (system il glil) :use-module (system il ghil) :use-module (ice-9 common-list) diff --git a/module/system/il/ghil.scm b/module/system/il/ghil.scm index 9fdcf97fa..57e78d327 100644 --- a/module/system/il/ghil.scm +++ b/module/system/il/ghil.scm @@ -22,7 +22,6 @@ (define-module (system il ghil) :use-module (oop goops) :use-syntax (system base syntax) - :use-module (system base module) :use-module (ice-9 match) :use-module (ice-9 regex) :export @@ -83,7 +82,8 @@ (define-method (ghil-lookup (mod ) (sym )) (or (assq-ref mod.table sym) - (let ((var (make-ghil-var (env-identifier mod.module) sym 'module))) + ;; (let ((var (make-ghil-var (env-identifier mod.module) sym 'module))) + (let ((var (make-ghil-var #f sym 'module))) (set! mod.table (acons sym var mod.table)) var))) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 8fbe50e4d..31ae71cfe 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -65,10 +65,10 @@ error-handler)) (define (error-handler key . args) - (case key - ((vm-error) - (write (frame->call (cadddr args))) - (newline))) +;; (case key +;; ((vm-error) +;; (write (frame->call (cadddr args))) +;; (newline))) (display "ERROR: ") (apply format #t (cadr args) (caddr args)) (newline)) diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm index 84ff00d94..0c394b76b 100644 --- a/module/system/vm/assemble.scm +++ b/module/system/vm/assemble.scm @@ -21,7 +21,6 @@ (define-module (system vm assemble) :use-syntax (system base syntax) - :use-module (system base module) :use-module (system il glil) :use-module (system vm core) :use-module (system vm conv) @@ -119,15 +118,15 @@ (+ index i)))))) (($ op module name) - (let ((mod (make-vmod module))) - (if toplevel - (begin - ;; (push-code! `(load-module ,module)) - (push-code! `(load-symbol ,name)) - (push-code! `(link/current-module))) - (let ((vlink (make-vlink mod name))) - (push-code! `(object-ref ,(object-index vlink))))) - (push-code! (list (symbol-append 'variable- op))))) + (if toplevel + (begin + ;; (push-code! `(load-module ,module)) + (push-code! `(load-symbol ,name)) + (push-code! `(link/current-module))) + ;; (let ((vlink (make-vlink (make-vmod module) name))) + (let ((vlink (make-vlink #f name))) + (push-code! `(object-ref ,(object-index vlink))))) + (push-code! (list (symbol-append 'variable- op)))) (($ label) (label-set label (current-address))) @@ -263,7 +262,7 @@ (define (build-object-table bytespec) (let ((table '()) (index 0)) (define (insert! x) - (if (vlink? x) (begin (insert! (vlink-module x)))) + ;; (if (vlink? x) (begin (insert! (vlink-module x)))) (if (not (object-find table x)) (begin (set! table (acons x index table)) diff --git a/module/system/vm/load.scm b/module/system/vm/load.scm new file mode 100644 index 000000000..655927e64 --- /dev/null +++ b/module/system/vm/load.scm @@ -0,0 +1,54 @@ +;;; Guile VM compiling loader + +;; 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-module (system vm load) + :use-module (system vm core) + :autoload (system base module) (global-ref) + :autoload (system base language) (compile-file-in lookup-language) + :use-module (ice-9 regex) + :export (load/compile)) + +(define *the-vm* (make-vm)) + +(define (load/compile file) + (let* ((file (file-name-full-name file)) + (compiled (object-file-name file))) + (if (or (not (file-exists? compiled)) + (> (stat:mtime (stat file)) (stat:mtime (stat compiled)))) + (compile-file-in file (global-ref 'user) (lookup-language 'r5rs))) + (let ((bytes (make-uniform-vector (stat:size (stat compiled)) #\a))) + (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) + (port-filename (current-load-port))))) + (if (and oldname + (> (string-length filename) 0) + (not (char=? (string-ref filename 0) #\/)) + (not (string=? (dirname oldname) "."))) + (string-append (dirname oldname) "/" filename) + filename))) + +(define (object-file-name file) + (let ((m (string-match "\\.[^.]*$" file))) + (string-append (if m (match:prefix m) file) ".go"))) diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm index 88933003d..3b5d4f1f0 100644 --- a/module/system/vm/trace.scm +++ b/module/system/vm/trace.scm @@ -20,9 +20,6 @@ ;;; Code: (define-module (system vm trace) - :use-module (oop goops) - :use-syntax (system base syntax) - :use-module (system base module) :use-module (system vm core) :use-module (system vm frame) :use-module (ice-9 format)