[armedbear-cvs] r13046 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Thu Nov 25 13:15:22 UTC 2010
Author: ehuelsmann
Date: Thu Nov 25 08:15:18 2010
New Revision: 13046
Log:
Fix ANSI regressions caused by the implementation
of the new class writer.
Found by: Mark Evenson
Patch by: me
Modified:
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
trunk/abcl/src/org/armedbear/lisp/jvm.lisp
trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Thu Nov 25 08:15:18 2010
@@ -674,7 +674,7 @@
`(case ,expr , at clauses))))
(defconstant +fasl-classloader+
- (jvm::make-class-name "org.armedbear.lisp.FaslClassLoader"))
+ (jvm::make-jvm-class-name "org.armedbear.lisp.FaslClassLoader"))
(defun generate-loader-function ()
(let* ((basename (base-classname))
@@ -693,7 +693,7 @@
:collect
(let* ((class (%format nil "org/armedbear/lisp/~A_~A"
basename i))
- (class-name (jvm::make-class-name class)))
+ (class-name (jvm::make-jvm-class-name class)))
`(,(1- i)
(jvm::with-inline-code ()
(jvm::emit-new ,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 Thu Nov 25 08:15:18 2010
@@ -795,8 +795,8 @@
(defun make-constructor (class)
(let* ((*compiler-debug* nil)
- (method (make-method :constructor :void nil
- :flags '(:public)))
+ (method (make-jvm-method :constructor :void nil
+ :flags '(:public)))
;; We don't normally need to see debugging output for constructors.
(super (class-file-superclass class))
(lambda-name (abcl-class-file-lambda-name class))
@@ -909,8 +909,8 @@
(defun make-static-initializer (class)
(let ((*compiler-debug* nil)
- (method (make-method :static-initializer
- :void nil :flags '(:public :static))))
+ (method (make-jvm-method :static-initializer
+ :void nil :flags '(:public :static))))
;; We don't normally need to see debugging output for <clinit>.
(with-code-to-method (class method)
(setf (code-max-locals *current-code-attribute*) 0)
@@ -6761,8 +6761,8 @@
(*child-p* (not (null (compiland-parent compiland))))
(arg-types (analyze-args compiland))
- (method (make-method "execute" +lisp-object+ arg-types
- :flags '(:final :public)))
+ (method (make-jvm-method "execute" +lisp-object+ arg-types
+ :flags '(:final :public)))
(*visible-variables* *visible-variables*)
(*thread* nil)
Modified: trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp Thu Nov 25 08:15:18 2010
@@ -80,8 +80,8 @@
|#
-(defstruct (class-name (:conc-name class-)
- (:constructor %make-class-name))
+(defstruct (jvm-class-name (:conc-name class-)
+ (:constructor %make-jvm-class-name))
"Used for class identification.
The caller should instantiate only one `class-name' per class, as they are
@@ -96,14 +96,14 @@
;; name comparisons to be EQ: all classes should exist only once,
)
-(defun make-class-name (name)
+(defun make-jvm-class-name (name)
"Creates a `class-name' structure for the class or interface `name'.
`name' should be specified using Java representation, which is converted
to 'internal' (JVM) representation by this function."
(setf name (substitute #\/ #\. name))
- (%make-class-name :name-internal name
- :ref (concatenate 'string "L" name ";")))
+ (%make-jvm-class-name :name-internal name
+ :ref (concatenate 'string "L" name ";")))
(defun class-array (class-name)
"Returns a class-name representing an array of `class-name'.
@@ -120,14 +120,14 @@
;; are identified by the same string
(let ((name-and-ref (concatenate 'string "[" (class-ref class-name))))
(setf (class-array-class class-name)
- (%make-class-name :name-internal name-and-ref
- :ref name-and-ref))))
+ (%make-jvm-class-name :name-internal name-and-ref
+ :ref name-and-ref))))
(class-array-class class-name))
(defmacro define-class-name (symbol java-dotted-name &optional documentation)
"Convenience macro to define constants for `class-name' structures,
initialized from the `java-dotted-name'."
- `(defconstant ,symbol (make-class-name ,java-dotted-name)
+ `(defconstant ,symbol (make-jvm-class-name ,java-dotted-name)
,documentation))
(define-class-name +java-object+ "java.lang.Object")
@@ -835,8 +835,8 @@
(write-attributes (field-attributes field) stream))
-(defstruct (method (:constructor %make-method)
- (:conc-name method-))
+(defstruct (jvm-method (:constructor %make-jvm-method)
+ (:conc-name method-))
"Holds information on the properties of methods in the class(-file)."
access-flags
name
@@ -858,11 +858,11 @@
"<init>")
(t name)))
-(defun make-method (name return args &key (flags '(:public)))
+(defun make-jvm-method (name return args &key (flags '(:public)))
"Creates a method for addition to a class file."
- (%make-method :descriptor (cons return args)
- :access-flags flags
- :name (map-method-name name)))
+ (%make-jvm-method :descriptor (cons return args)
+ :access-flags flags
+ :name (map-method-name name)))
(defun method-add-attribute (method attribute)
"Add `attribute' to the list of attributes of `method',
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 Thu Nov 25 08:15:18 2010
@@ -138,13 +138,13 @@
(when (or (char= (char name i) #\-)
(char= (char name i) #\Space))
(setf (char name i) #\_)))
- (make-class-name
+ (make-jvm-class-name
(concatenate 'string "org.armedbear.lisp." name))))
(defun make-unique-class-name ()
"Creates a random class name for use with a `class-file' structure's
`class' slot."
- (make-class-name
+ (make-jvm-class-name
(concatenate 'string "abcl_"
(substitute #\_ #\-
(java:jcall (java:jmethod "java.util.UUID"
Modified: trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp Thu Nov 25 08:15:18 2010
@@ -38,7 +38,7 @@
(let ((symbols (make-hash-table :test 'eq :size 2048)))
(defun initialize-known-symbols (source ht)
(let* ((source-class (java:jclass source))
- (class-designator (jvm::make-class-name source))
+ (class-designator (jvm::make-jvm-class-name source))
(symbol-class (java:jclass "org.armedbear.lisp.Symbol"))
(fields (java:jclass-fields source-class :declared t :public t)))
(dotimes (i (length fields))
More information about the armedbear-cvs
mailing list