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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Aug 13 02:13:53 2011
New Revision: 13485

Log:
Remove two structure slots which are read only once, in favor of
passing in the right values to the reading function.

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

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sat Aug 13 01:29:08 2011	(r13484)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sat Aug 13 02:13:53 2011	(r13485)
@@ -937,14 +937,12 @@
 (defun emit-read-from-string (object)
   (emit-constructor-lambda-list object))
 
-(defun make-constructor (class)
+(defun make-constructor (class lambda-name args)
   (let* ((*compiler-debug* nil)
          (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))
-         (args (abcl-class-file-lambda-list class))
          req-params-register
          opt-params-register
          key-params-register
@@ -4036,9 +4034,7 @@
 either to stream or the pathname of the class file if `stream' is NIL."
   (let* ((pathname (funcall *pathnames-generator*))
          (class-file (make-abcl-class-file
-                      :pathname pathname
-                      :lambda-list
-                      (cadr (compiland-lambda-expression compiland)))))
+                      :pathname pathname)))
     (setf (compiland-class-file compiland) class-file)
     (with-open-stream (f (or stream
                              (open pathname :direction :output
@@ -7124,14 +7120,14 @@
 
     (class-add-method class-file method)
 
-    (setf (abcl-class-file-lambda-list class-file) args)
     (setf (abcl-class-file-superclass class-file)
           (if (or *hairy-arglist-p*
                   (and *child-p* *closure-variables*))
               +lisp-compiled-closure+
               +lisp-compiled-primitive+))
 
-    (let ((constructor (make-constructor class-file)))
+    (let ((constructor
+           (make-constructor class-file (compiland-name compiland) args)))
       (setf (abcl-class-file-constructor class-file) constructor)
       (class-add-method class-file constructor))
     #+enable-when-generating-clinit
@@ -7386,18 +7382,14 @@
 generated class."
   (aver (eq (car form) 'LAMBDA))
   (catch 'compile-defun-abort
-    (let* ((class-file (make-abcl-class-file :pathname filespec
-                                             :lambda-name name
-                                             :lambda-list (cadr form)))
+    (let* ((class-file (make-abcl-class-file :pathname filespec))
            (*compiler-error-bailout*
             `(lambda ()
                (compile-1
                 (make-compiland :name ',name
                                 :lambda-expression (make-compiler-error-form ',form)
                                 :class-file
-                                (make-abcl-class-file :pathname ,filespec
-                                                      :lambda-name ',name
-                                                      :lambda-list (cadr ',form)))
+                                (make-abcl-class-file :pathname ,filespec))
                 ,stream)))
            (*compile-file-environment* environment))
       (compile-1 (make-compiland :name name

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Sat Aug 13 01:29:08 2011	(r13484)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Sat Aug 13 02:13:53 2011	(r13485)
@@ -130,8 +130,6 @@
                             (:constructor %make-abcl-class-file))
   pathname ; pathname of output file
   class-name
-  lambda-name
-  lambda-list ; as advertised
   static-initializer
   constructor
   objects ;; an alist of externalized objects and their field names
@@ -160,7 +158,7 @@
                                         (java:jstatic "randomUUID"
                                                       "java.util.UUID"))))))
 
-(defun make-abcl-class-file (&key pathname lambda-name lambda-list)
+(defun make-abcl-class-file (&key pathname)
   "Creates a `class-file' structure. If `pathname' is non-NIL, it's
 used to derive a class name. If it is NIL, a random one created
 using `make-unique-class-name'."
@@ -170,8 +168,6 @@
          (class-file (%make-abcl-class-file :pathname pathname
                                             :class class-name ; to be finalized
                                             :class-name class-name
-                                            :lambda-name lambda-name
-                                            :lambda-list lambda-list
                                             :access-flags '(:public :final))))
     (when *file-compilation*
       (let ((source-attribute