[armedbear-cvs] r12181 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Fri Oct 9 20:38:28 UTC 2009
Author: ehuelsmann
Date: Fri Oct 9 16:38:25 2009
New Revision: 12181
Log:
Prevent nested compilation of CLOS generated methods.
This prevents recursive compilation of the same method
while it's already being compiled.
Modified:
trunk/abcl/src/org/armedbear/lisp/Primitives.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/clos.lisp
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Fri Oct 9 16:38:25 2009
@@ -1449,6 +1449,7 @@
}
};
+ /** Stub to be replaced later when signal.lisp has been loaded. */
// ### error
private static final Primitive ERROR =
new Primitive(Symbol.ERROR, "datum &rest arguments")
@@ -1470,6 +1471,18 @@
}
};
+ /** Stub replaced when compiler-pass2.lisp has been loaded */
+ // ### autocompile
+ private static final Primitive AUTOCOMPILE =
+ new Primitive(Symbol.AUTOCOMPILE, "function")
+ {
+ @Override
+ public LispObject execute(LispObject function) throws ConditionThrowable
+ {
+ return NIL;
+ }
+ };
+
// ### signal
private static final Primitive SIGNAL =
new Primitive(Symbol.SIGNAL, "datum &rest arguments")
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Fri Oct 9 16:38:25 2009
@@ -2943,6 +2943,10 @@
PACKAGE_JAVA.addExternalSymbol("JMETHOD-RETURN-TYPE");
// External symbols in SYSTEM package.
+ public static final Symbol _ENABLE_AUTOCOMPILE_ =
+ PACKAGE_SYS.addExternalSymbol("*ENABLE-AUTOCOMPILE*");
+ public static final Symbol AUTOCOMPILE =
+ PACKAGE_SYS.addExternalSymbol("AUTOCOMPILE");
public static final Symbol ENVIRONMENT =
PACKAGE_SYS.addExternalSymbol("ENVIRONMENT");
public static final Symbol FORWARD_REFERENCED_CLASS =
Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Fri Oct 9 16:38:25 2009
@@ -1335,9 +1335,9 @@
(slow-method-lookup ,gf args))))))
nil))))))
- (when (and (fboundp 'compile)
+ (when (and (fboundp 'autocompile)
(not (autoloadp 'compile)))
- (setf code (or (compile nil code) code)))
+ (setf code (or (autocompile code) code)))
code))
@@ -1535,7 +1535,7 @@
(lambda (primary)
`(funcall ,(%method-function primary) args nil))
primaries)))))))))
- (or (ignore-errors (compile nil emf-form))
+ (or (ignore-errors (autocompile emf-form))
(coerce-to-function emf-form))))
(defun generate-emf-lambda (method-function next-emfun)
@@ -1753,10 +1753,10 @@
:specializers (list class)
:function (if (autoloadp 'compile)
method-function
- (compile nil method-function))
+ (autocompile method-function))
:fast-function (if (autoloadp 'compile)
fast-function
- (compile nil fast-function))
+ (autocompile fast-function))
:slot-name slot-name)))
(%add-method gf method)
method))))
@@ -1778,10 +1778,10 @@
;; :function `(function ,method-function)
:function (if (autoloadp 'compile)
method-function
- (compile nil method-function))
+ (autocompile method-function))
:fast-function (if (autoloadp 'compile)
fast-function
- (compile nil fast-function))
+ (autocompile fast-function))
)))
(fmakunbound 'class-name)
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 Fri Oct 9 16:38:25 2009
@@ -8758,4 +8758,11 @@
(initialize-p2-handlers)
+(defun sys:autocompile (function)
+ (when sys:*enable-autocompile*
+ (let ((sys:*enable-autocompile* nil))
+ (values (compile nil function)))))
+
+(setf sys:*enable-autocompile* t)
+
(provide "COMPILER-PASS2")
More information about the armedbear-cvs
mailing list