Changeset 13046

Timestamp:

11/25/10 13:15:18 (13 years ago)

Author:

ehuelsmann

Message:

Fix ANSI regressions caused by the implementation
of the new class writer.

Found by: Mark Evenson
Patch by: me

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compile-file.lisp (modified) (2 diffs)
• compiler-pass2.lisp (modified) (3 diffs)
• jvm-class-file.lisp (modified) (7 diffs)
• jvm.lisp (modified) (2 diffs)
• known-symbols.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -675 +675 @@
 
 (defconstant +fasl-classloader+
-  (jvm::make-class-name "org.armedbear.lisp.FaslClassLoader"))
+  (jvm::make-jvm-class-name "org.armedbear.lisp.FaslClassLoader"))
 
 (defun generate-loader-function ()
@@ -694 +694 @@
        (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 ()

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -796 +796 @@
 (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))
@@ -910 +910 @@
 (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)
@@ -6762 +6762 @@
 
          (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*)
 

trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -81 +81 @@
 |#
 
-(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.
 
@@ -97 +97 @@
   )
 
-(defun make-class-name (name)
+(defun make-jvm-class-name (name)
   "Creates a `class-name' structure for the class or interface `name'.
 
@@ -103 +103 @@
 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)
@@ -121 +121 @@
     (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))
 
@@ -128 +128 @@
   "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))
 
@@ -836 +836 @@
 
 
-(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
@@ -859 +859 @@
     (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)

trunk/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -139 +139 @@
                 (char= (char name i) #\Space))
         (setf (char name i) #\_)))
-    (make-class-name
+    (make-jvm-class-name
      (concatenate 'string "org.armedbear.lisp." name))))
 
@@ -145 +145 @@
   "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 #\_ #\-

trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp

@@ -39 +39 @@
   (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)))