[armedbear-cvs] r13047 - branches/0.23.x/abcl/src/org/armedbear/lisp

Erik Huelsmann ehuelsmann at common-lisp.net
Thu Nov 25 13:52:52 UTC 2010


Author: ehuelsmann
Date: Thu Nov 25 08:52:51 2010
New Revision: 13047

Log:
Backport r13046; ANSI test regressions.

Modified:
   branches/0.23.x/abcl/src/org/armedbear/lisp/compile-file.lisp
   branches/0.23.x/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   branches/0.23.x/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
   branches/0.23.x/abcl/src/org/armedbear/lisp/jvm.lisp
   branches/0.23.x/abcl/src/org/armedbear/lisp/known-symbols.lisp

Modified: branches/0.23.x/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/compile-file.lisp	(original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/compile-file.lisp	Thu Nov 25 08:52:51 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: branches/0.23.x/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Thu Nov 25 08:52:51 2010
@@ -796,8 +796,8 @@
 (defun make-constructor (super lambda-name args)
   (let* ((*compiler-debug* nil)
          ;; We don't normally need to see debugging output for constructors.
-         (method (make-method :constructor :void nil
-                              :flags '(:public)))
+         (method (make-jvm-method :constructor :void nil
+                                  :flags '(:public)))
          (code (method-add-code method))
          req-params-register
          opt-params-register
@@ -906,7 +906,6 @@
     (setf (code-code code) *code*)
     method))
 
-
 (defvar *source-line-number* nil)
 
 
@@ -6754,7 +6753,7 @@
          (*child-p* (not (null (compiland-parent compiland))))
 
          (arg-types (analyze-args compiland))
-         (method (make-method "execute" +lisp-object+ arg-types
+         (method (make-jvm-method "execute" +lisp-object+ arg-types
                                :flags '(:final :public)))
          (code (method-add-code method))
          (*current-code-attribute* code)

Modified: branches/0.23.x/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	(original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Thu Nov 25 08:52:51 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: branches/0.23.x/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/jvm.lisp	Thu Nov 25 08:52:51 2010
@@ -137,13 +137,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: branches/0.23.x/abcl/src/org/armedbear/lisp/known-symbols.lisp
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/known-symbols.lisp	(original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/known-symbols.lisp	Thu Nov 25 08:52:51 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