[armedbear-cvs] r11905 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Wed May 20 17:12:49 2009
New Revision: 11905

Log:
Move COMPILE from jvm.lisp to compiler-pass2.lisp;
Move SET-FUNCTION-DEFINITION helper from compiler-pass2.lisp to precompiler.lisp;
Add a closing paren forgotten in r11904.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm.lisp
   trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Wed May 20 17:12:49 2009
@@ -8350,16 +8350,6 @@
                   (format *error-output* ";     ~S~%" name))))
             (terpri *error-output*))))))
 
-(defun set-function-definition (name new old)
-  (let ((*warn-on-redefinition* nil))
-    (sys::%set-lambda-name new name)
-    (sys:set-call-count new (sys:call-count old))
-    (sys::%set-arglist new (sys::arglist old))
-    (when (macro-function name)
-      (setf new (make-macro name new)))
-    (if (typep old 'standard-generic-function)
-        (mop:set-funcallable-instance-function old new)
-        (setf (fdefinition name) new))))
 
 (defun %jvm-compile (name definition expr env)
   (let* (compiled-function
@@ -8375,6 +8365,18 @@
       (set-function-definition name compiled-function definition))
     (or name compiled-function)))
 
+
+(defvar *file-compilation* nil)
+(defvar *pathnames-generator* #'make-temp-file)
+
+(defun compile (name &optional definition)
+  (jvm-compile name definition))
+
+(defmacro with-file-compilation (&body body)
+  `(let ((*file-compilation* t)
+         (*pathnames-generator* #'sys::next-classfile-name))
+     , at body))
+
 (defun jvm-compile (name &optional definition)
   (unless definition
     (resolve name) ;; Make sure the symbol has been resolved by the autoloader
@@ -8386,6 +8388,10 @@
         (failure-p nil)
         (*package* (or (and name (symbol-package name)) *package*))
         (expression definition)
+        (*file-compilation* nil)
+        (*visible-variables* nil)
+        (*pathnames-generator* #'make-temp-file)
+        (sys::*fasl-anonymous-package* (sys::%make-package))
         environment)
     (unless (and (consp definition) (eq (car definition) 'LAMBDA))
       (when (typep definition 'standard-generic-function)
@@ -8404,7 +8410,7 @@
                 (sys::%format t "; Unable to compile ~S.~%"
                               (or name "top-level form"))
                 (return-from jvm-compile
-                  (precompiler::precompile name definition))))
+                  (precompiler::precompile name definition)))))
          (style-warning
           #'(lambda (c) (declare (ignore c))
               (setf warnings-p t) nil))

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Wed May 20 17:12:49 2009
@@ -481,20 +481,6 @@
                 (t
                  (setf (variable-ignorable-p variable) t))))))))
 
-(defvar *file-compilation* nil)
-(defvar *pathnames-generator* #'make-temp-file)
-
-(defun compile (name &optional definition)
-  (let ((*file-compilation* nil)
-        (*pathnames-generator* #'make-temp-file)
-        (sys::*fasl-anonymous-package* (sys::%make-package)))
-    (jvm-compile name definition)))
-
-(defmacro with-file-compilation (&body body)
-  `(let ((*file-compilation* t)
-         (*pathnames-generator* #'sys::next-classfile-name))
-     , at body))
-
 (defun finalize-generic-functions ()
   (dolist (sym '(make-instance
                  initialize-instance

Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Wed May 20 17:12:49 2009
@@ -1019,6 +1019,17 @@
                        (eval (cadr binding))) bindings)
       (macroexpand-all `(progn , at forms) env))))
 
+(defun set-function-definition (name new old)
+  (let ((*warn-on-redefinition* nil))
+    (sys::%set-lambda-name new name)
+    (sys:set-call-count new (sys:call-count old))
+    (sys::%set-arglist new (sys::arglist old))
+    (when (macro-function name)
+      (setf new (make-macro name new)))
+    (if (typep old 'standard-generic-function)
+        (mop:set-funcallable-instance-function old new)
+        (setf (fdefinition name) new))))
+
 (defun precompile (name &optional definition)
   (unless definition
     (setq definition (or (and (symbolp name) (macro-function name))