Changeset 12897

Timestamp:

08/13/10 23:31:55 (13 years ago)

Author:

ehuelsmann

Message:

Use the new generator's WRITE-CLASS-FILE function,
axing other WRITE-* methods from pass2.

Location:

branches/generic-class-file/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (8 diffs)
• jvm.lisp (modified) (2 diffs)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -798 +798 @@
          ;; We don't normally need to see debugging output for constructors.
          (method (make-method :constructor :void nil
-                               :flags '(:public)))
+                              :flags '(:public)))
          (code (method-add-code method))
          req-params-register
@@ -908 +908 @@
 
 
-(defun write-source-file-attr (source-file stream)
-  (let* ((name-index (pool-name "SourceFile"))
-         (source-file-index (pool-name source-file)))
-    (write-u2 name-index stream)
-    ;; "The value of the attribute_length item of a SourceFile_attribute
-    ;; structure must be 2."
-    (write-u4 2 stream)
-    (write-u2 source-file-index stream)))
-
 (defvar *source-line-number* nil)
 
-(defun write-line-number-table (stream)
-  (let* ((name-index (pool-name "LineNumberTable")))
-    (write-u2 name-index stream)
-    (write-u4 6 stream) ; "the length of the attribute, excluding the initial six bytes"
-    (write-u2 1 stream) ; number of entries
-    (write-u2 0 stream) ; start_pc
-    (write-u2 *source-line-number* stream)))
-
+
+(defun write-class-file (class stream)
+  (class-add-method class (make-constructor (class-file-superclass class)
+                                            (abcl-class-file-lambda-name class)
+                                            (abcl-class-file-lambda-list class)))
+  (finalize-class-file class)
+  (!write-class-file class stream))
 
 
@@ -1204 +1194 @@
    local-function *declared-functions* ht g
    (setf g (symbol-name (gensym "LFUN")))
-   (let* ((class-name (abcl-class-file-class
+   (let* ((class-name (abcl-class-file-class-name
                        (local-function-class-file local-function)))
           (*code* *static-code*))
@@ -3800 +3790 @@
       (with-saved-compiler-policy
     (p2-compiland compiland)
+;;        (finalize-class-file (compiland-class-file compiland))
   (write-class-file (compiland-class-file compiland) stream)))))
 
@@ -3822 +3813 @@
            (let* ((pathname (funcall *pathnames-generator*))
                   (class-file (make-abcl-class-file :pathname pathname
-                                               :lambda-list lambda-list)))
+                                                    :lambda-list lambda-list)))
              (with-open-class-file (f class-file)
                (set-compiland-and-write-class class-file compiland f))
@@ -6810 +6801 @@
      ,@body))
 
-(defun write-class-file (class-file stream)
-  (let* ((super (abcl-class-file-superclass class-file))
-         (this (abcl-class-file-class class-file))
-         (this-index (pool-class this))
-         (super-index (pool-class super))
-         (constructor (make-constructor super
-                                        (abcl-class-file-lambda-name class-file)
-                                        (abcl-class-file-lambda-list class-file))))
-    (pool-name "Code") ; Must be in pool!
-    (class-add-method class-file constructor)
-
-    (when *file-compilation*
-      (pool-name "SourceFile") ; Must be in pool!
-      (pool-name (file-namestring *compile-file-truename*)))
-    (when (and (boundp '*source-line-number*)
-               (fixnump *source-line-number*))
-      (pool-name "LineNumberTable")) ; Must be in pool!
-    (dolist (field (class-file-fields class-file))
-      (finalize-field field class-file))
-    (dolist (method (class-file-methods class-file))
-      (finalize-method method class-file))
-
-    (write-u4 #xCAFEBABE stream)
-    (write-u2 3 stream)
-    (write-u2 45 stream)
-    (write-constants *pool* stream)
-    ;; access flags
-    (write-u2 #x21 stream)
-    (write-u2 this-index stream)
-    (write-u2 super-index stream)
-    ;; interfaces count
-    (write-u2 0 stream)
-    ;; fields count
-    (write-u2 (length (class-file-fields class-file)) stream)
-    ;; fields
-    (dolist (field (class-file-fields class-file))
-      (write-field field stream))
-    ;; methods count
-    (write-u2 (length (abcl-class-file-methods class-file)) stream)
-    ;; methods
-    (dolist (method (abcl-class-file-methods class-file))
-      (write-method method stream))
-    ;; attributes count
-    (cond (*file-compilation*
-     ;; attributes count
-     (write-u2 1 stream)
-     ;; attributes table
-     (write-source-file-attr (file-namestring *compile-file-truename*)
-           stream))
-    (t
-     ;; attributes count
-     (write-u2 0 stream)))
-    stream))
 
 (defknown p2-compiland-process-type-declarations (list) t)
@@ -7131 +7069 @@
     (setf (code-code code) *code*))
 
+
   t)
 
@@ -7173 +7112 @@
       (with-class-file (compiland-class-file compiland)
         (p2-compiland compiland)
+;;        (finalize-class-file (compiland-class-file compiland))
         (write-class-file (compiland-class-file compiland) stream)))))
 

branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -122 +122 @@
                             (:constructor %make-abcl-class-file))
   pathname ; pathname of output file
+  class-name
   lambda-name
   lambda-list ; as advertised
@@ -159 +160 @@
                          (make-unique-class-name)))
          (class-file (%make-abcl-class-file :pathname pathname
-                                            :class class-name
+                                            :class class-name ; to be finalized
+                                            :class-name class-name
                                             :lambda-name lambda-name
-                                            :lambda-list lambda-list)))
+                                            :lambda-list lambda-list
+                                            :access-flags '(:public :final))))
     (when *file-compilation*
       (let ((source-attribute