Changeset 12897


Ignore:
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:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12896 r12897  
    798798         ;; We don't normally need to see debugging output for constructors.
    799799         (method (make-method :constructor :void nil
    800                                :flags '(:public)))
     800                              :flags '(:public)))
    801801         (code (method-add-code method))
    802802         req-params-register
     
    908908
    909909
    910 (defun write-source-file-attr (source-file stream)
    911   (let* ((name-index (pool-name "SourceFile"))
    912          (source-file-index (pool-name source-file)))
    913     (write-u2 name-index stream)
    914     ;; "The value of the attribute_length item of a SourceFile_attribute
    915     ;; structure must be 2."
    916     (write-u4 2 stream)
    917     (write-u2 source-file-index stream)))
    918 
    919910(defvar *source-line-number* nil)
    920911
    921 (defun write-line-number-table (stream)
    922   (let* ((name-index (pool-name "LineNumberTable")))
    923     (write-u2 name-index stream)
    924     (write-u4 6 stream) ; "the length of the attribute, excluding the initial six bytes"
    925     (write-u2 1 stream) ; number of entries
    926     (write-u2 0 stream) ; start_pc
    927     (write-u2 *source-line-number* stream)))
    928 
     912
     913(defun write-class-file (class stream)
     914  (class-add-method class (make-constructor (class-file-superclass class)
     915                                            (abcl-class-file-lambda-name class)
     916                                            (abcl-class-file-lambda-list class)))
     917  (finalize-class-file class)
     918  (!write-class-file class stream))
    929919
    930920
     
    12041194   local-function *declared-functions* ht g
    12051195   (setf g (symbol-name (gensym "LFUN")))
    1206    (let* ((class-name (abcl-class-file-class
     1196   (let* ((class-name (abcl-class-file-class-name
    12071197                       (local-function-class-file local-function)))
    12081198          (*code* *static-code*))
     
    38003790      (with-saved-compiler-policy
    38013791    (p2-compiland compiland)
     3792;;        (finalize-class-file (compiland-class-file compiland))
    38023793  (write-class-file (compiland-class-file compiland) stream)))))
    38033794
     
    38223813           (let* ((pathname (funcall *pathnames-generator*))
    38233814                  (class-file (make-abcl-class-file :pathname pathname
    3824                                                :lambda-list lambda-list)))
     3815                                                    :lambda-list lambda-list)))
    38253816             (with-open-class-file (f class-file)
    38263817               (set-compiland-and-write-class class-file compiland f))
     
    68106801     ,@body))
    68116802
    6812 (defun write-class-file (class-file stream)
    6813   (let* ((super (abcl-class-file-superclass class-file))
    6814          (this (abcl-class-file-class class-file))
    6815          (this-index (pool-class this))
    6816          (super-index (pool-class super))
    6817          (constructor (make-constructor super
    6818                                         (abcl-class-file-lambda-name class-file)
    6819                                         (abcl-class-file-lambda-list class-file))))
    6820     (pool-name "Code") ; Must be in pool!
    6821     (class-add-method class-file constructor)
    6822 
    6823     (when *file-compilation*
    6824       (pool-name "SourceFile") ; Must be in pool!
    6825       (pool-name (file-namestring *compile-file-truename*)))
    6826     (when (and (boundp '*source-line-number*)
    6827                (fixnump *source-line-number*))
    6828       (pool-name "LineNumberTable")) ; Must be in pool!
    6829     (dolist (field (class-file-fields class-file))
    6830       (finalize-field field class-file))
    6831     (dolist (method (class-file-methods class-file))
    6832       (finalize-method method class-file))
    6833 
    6834     (write-u4 #xCAFEBABE stream)
    6835     (write-u2 3 stream)
    6836     (write-u2 45 stream)
    6837     (write-constants *pool* stream)
    6838     ;; access flags
    6839     (write-u2 #x21 stream)
    6840     (write-u2 this-index stream)
    6841     (write-u2 super-index stream)
    6842     ;; interfaces count
    6843     (write-u2 0 stream)
    6844     ;; fields count
    6845     (write-u2 (length (class-file-fields class-file)) stream)
    6846     ;; fields
    6847     (dolist (field (class-file-fields class-file))
    6848       (write-field field stream))
    6849     ;; methods count
    6850     (write-u2 (length (abcl-class-file-methods class-file)) stream)
    6851     ;; methods
    6852     (dolist (method (abcl-class-file-methods class-file))
    6853       (write-method method stream))
    6854     ;; attributes count
    6855     (cond (*file-compilation*
    6856      ;; attributes count
    6857      (write-u2 1 stream)
    6858      ;; attributes table
    6859      (write-source-file-attr (file-namestring *compile-file-truename*)
    6860            stream))
    6861     (t
    6862      ;; attributes count
    6863      (write-u2 0 stream)))
    6864     stream))
    68656803
    68666804(defknown p2-compiland-process-type-declarations (list) t)
     
    71317069    (setf (code-code code) *code*))
    71327070
     7071
    71337072  t)
    71347073
     
    71737112      (with-class-file (compiland-class-file compiland)
    71747113        (p2-compiland compiland)
     7114;;        (finalize-class-file (compiland-class-file compiland))
    71757115        (write-class-file (compiland-class-file compiland) stream)))))
    71767116
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp

    r12896 r12897  
    122122                            (:constructor %make-abcl-class-file))
    123123  pathname ; pathname of output file
     124  class-name
    124125  lambda-name
    125126  lambda-list ; as advertised
     
    159160                         (make-unique-class-name)))
    160161         (class-file (%make-abcl-class-file :pathname pathname
    161                                             :class class-name
     162                                            :class class-name ; to be finalized
     163                                            :class-name class-name
    162164                                            :lambda-name lambda-name
    163                                             :lambda-list lambda-list)))
     165                                            :lambda-list lambda-list
     166                                            :access-flags '(:public :final))))
    164167    (when *file-compilation*
    165168      (let ((source-attribute
Note: See TracChangeset for help on using the changeset viewer.