Changeset 12895


Ignore:
Timestamp:
08/13/10 21:10:39 (11 years ago)
Author:
ehuelsmann
Message:

Remove exclamation marks which were in place to avoid naming
conflicts; the conflicting names have been deleted from pass2 now.

Location:
branches/generic-class-file/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

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

    r12894 r12895  
    797797  (let* ((*compiler-debug* nil)
    798798         ;; We don't normally need to see debugging output for constructors.
    799          (method (!make-method :constructor :void nil
     799         (method (make-method :constructor :void nil
    800800                               :flags '(:public)))
    801801         (code (method-add-code method))
     
    38093809(defmacro with-temp-class-file (pathname class-file lambda-list &body body)
    38103810  `(let* ((,pathname (make-temp-file))
    3811     (,class-file (make-class-file :pathname ,pathname
     3811    (,class-file (make-abcl-class-file :pathname ,pathname
    38123812                                             :lambda-list ,lambda-list)))
    38133813     (unwind-protect
     
    38213821    (cond (*file-compilation*
    38223822           (let* ((pathname (funcall *pathnames-generator*))
    3823                   (class-file (make-class-file :pathname pathname
     3823                  (class-file (make-abcl-class-file :pathname pathname
    38243824                                               :lambda-list lambda-list)))
    38253825             (with-open-class-file (f class-file)
     
    38273827             (setf (local-function-class-file local-function) class-file)))
    38283828          (t
    3829            (let ((class-file (make-class-file :lambda-list lambda-list)))
     3829           (let ((class-file (make-abcl-class-file :lambda-list lambda-list)))
    38303830             (with-open-stream (stream (sys::%make-byte-array-output-stream))
    38313831               (set-compiland-and-write-class class-file compiland stream)
     
    38553855    (cond (*file-compilation*
    38563856           (let* ((pathname (funcall *pathnames-generator*))
    3857                   (class-file (make-class-file :pathname pathname
    3858                                                :lambda-list lambda-list)))
     3857                  (class-file (make-abcl-class-file :pathname pathname
     3858                                                    :lambda-list lambda-list)))
    38593859             (with-open-class-file (f class-file)
    38603860               (set-compiland-and-write-class class-file compiland f))
     
    38643864                local-function compiland g))))
    38653865          (t
    3866            (let ((class-file (make-class-file :lambda-list lambda-list)))
     3866           (let ((class-file (make-abcl-class-file :lambda-list lambda-list)))
    38673867             (with-open-stream (stream (sys::%make-byte-array-output-stream))
    38683868               (set-compiland-and-write-class class-file compiland stream)
     
    39173917    (cond (*file-compilation*
    39183918           (setf (compiland-class-file compiland)
    3919                  (make-class-file :pathname (funcall *pathnames-generator*)
    3920                                   :lambda-list lambda-list))
     3919                 (make-abcl-class-file :pathname (funcall *pathnames-generator*)
     3920                                       :lambda-list lambda-list))
    39213921           (let ((class-file (compiland-class-file compiland)))
    39223922       (with-open-class-file (f class-file)
     
    39283928          (t
    39293929           (setf (compiland-class-file compiland)
    3930                  (make-class-file :lambda-list lambda-list))
     3930                 (make-abcl-class-file :lambda-list lambda-list))
    39313931           (with-open-stream (stream (sys::%make-byte-array-output-stream))
    39323932             (compile-and-write-to-stream (compiland-class-file compiland)
     
    68516851    ;; methods
    68526852    (dolist (method (abcl-class-file-methods class-file))
    6853       (!write-method method stream))
     6853      (write-method method stream))
    68546854    ;; attributes count
    68556855    (cond (*file-compilation*
     
    69266926
    69276927         (arg-types (analyze-args compiland))
    6928          (method (!make-method "execute" +lisp-object+ arg-types
     6928         (method (make-method "execute" +lisp-object+ arg-types
    69296929                               :flags '(:final :public)))
    69306930         (code (method-add-code method))
     
    71127112        (astore (compiland-argument-register compiland)))
    71137113
    7114       (maybe-initialize-thread-var)
     7114      (unless (and *hairy-arglist-p*
     7115                   (or (memq '&OPTIONAL args) (memq '&KEY args)))
     7116        (maybe-initialize-thread-var))
    71157117      (setf *code* (nconc code *code*)))
    71167118
     
    71817183  (aver (eq (car form) 'LAMBDA))
    71827184  (catch 'compile-defun-abort
    7183     (let* ((class-file (make-class-file :pathname filespec
    7184                                         :lambda-name name
    7185                                         :lambda-list (cadr form)))
     7185    (let* ((class-file (make-abcl-class-file :pathname filespec
     7186                                             :lambda-name name
     7187                                             :lambda-list (cadr form)))
    71867188           (*compiler-error-bailout*
    71877189            `(lambda ()
    7188                (compile-1 (make-compiland :name ',name
    7189                                           :lambda-expression (make-compiler-error-form ',form)
    7190                                           :class-file
    7191                                           (make-class-file :pathname ,filespec
    7192                                                            :lambda-name ',name
    7193                                                            :lambda-list (cadr ',form)))
    7194         ,stream)))
     7190               (compile-1
     7191                (make-compiland :name ',name
     7192                                :lambda-expression (make-compiler-error-form ',form)
     7193                                :class-file
     7194                                (make-abcl-class-file :pathname ,filespec
     7195                                                      :lambda-name ',name
     7196                                                      :lambda-list (cadr ',form)))
     7197                ,stream)))
    71957198           (*compile-file-environment* environment))
    7196         (compile-1 (make-compiland :name name
    7197                                    :lambda-expression
    7198                                    (precompiler:precompile-form form t
    7199                                                                 environment)
    7200                                    :class-file class-file)
    7201        stream))))
     7199      (compile-1 (make-compiland :name name
     7200                                 :lambda-expression
     7201                                 (precompiler:precompile-form form t
     7202                                                              environment)
     7203                                 :class-file class-file)
     7204                 stream))))
    72027205
    72037206(defvar *catch-errors* t)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r12886 r12895  
    504504
    505505(defstruct (class-file (:constructor
    506                         !make-class-file (class superclass access-flags)))
     506                        make-class-file (class superclass access-flags)))
    507507  "Holds the components of a class file."
    508508  (constants (make-pool))
     
    534534  "Returns all methods which have `name'."
    535535  (remove name (class-file-methods class)
    536           :test-not #'string= :key #'!method-name))
     536          :test-not #'string= :key #'method-name))
    537537
    538538(defun class-method (class name return &rest args)
     
    540540  (let ((return-and-args (cons return args)))
    541541    (find-if #'(lambda (c)
    542                  (and (string= (!method-name c) name)
    543                       (equal (!method-descriptor c) return-and-args)))
     542                 (and (string= (method-name c) name)
     543                      (equal (method-descriptor c) return-and-args)))
    544544             (class-file-methods class))))
    545545
     
    674674  ;; flags
    675675  (write-u2  (class-file-access-flags class) stream)
     676
    676677  ;; class name
    677 
    678678  (write-u2 (class-file-class class) stream)
     679
    679680  ;; superclass
    680681  (write-u2 (class-file-superclass class) stream)
     
    691692  (write-u2 (length (class-file-methods class)) stream)
    692693  (dolist (method (class-file-methods class))
    693     (!write-method method stream))
     694    (write-method method stream))
    694695
    695696  ;; attributes
     
    832833
    833834
    834 (defstruct (method (:constructor %!make-method)
    835                    (:conc-name !method-))
     835(defstruct (method (:constructor %make-method)
     836                   (:conc-name method-))
    836837  "Holds information on the properties of methods in the class(-file)."
    837838  access-flags
     
    855856    (t name)))
    856857
    857 (defun !make-method (name return args &key (flags '(:public)))
     858(defun make-method (name return args &key (flags '(:public)))
    858859  "Creates a method for addition to a class file."
    859   (%!make-method :descriptor (cons return args)
     860  (%make-method :descriptor (cons return args)
    860861                :access-flags flags
    861862                :name name))
     
    864865  "Add `attribute' to the list of attributes of `method',
    865866returning `attribute'."
    866   (push attribute (!method-attributes method))
     867  (push attribute (method-attributes method))
    867868  attribute)
    868869
     
    872873  (method-add-attribute
    873874   method
    874    (make-code-attribute (+ (length (cdr (!method-descriptor method)))
    875                            (if (member :static (!method-access-flags method))
     875   (make-code-attribute (+ (length (cdr (method-descriptor method)))
     876                           (if (member :static (method-access-flags method))
    876877                               0 1))))) ;; 1 == implicit 'this'
    877878
     
    886887(defun method-attribute (method name)
    887888  "Returns the first attribute of `method' with `name'."
    888   (find name (!method-attributes method)
     889  (find name (method-attributes method)
    889890        :test #'string= :key #'attribute-name))
    890891
     
    893894  "Prepares `method' for serialization."
    894895  (let ((pool (class-file-constants class)))
    895     (setf (!method-access-flags method)
    896           (map-flags (!method-access-flags method))
    897           (!method-descriptor method)
    898           (pool-add-utf8 pool (apply #'descriptor (!method-descriptor method)))
    899           (!method-name method)
    900           (pool-add-utf8 pool (map-method-name (!method-name method)))))
    901   (finalize-attributes (!method-attributes method) nil class))
    902 
    903 
    904 (defun !write-method (method stream)
     896    (setf (method-access-flags method)
     897          (map-flags (method-access-flags method))
     898          (method-descriptor method)
     899          (pool-add-utf8 pool (apply #'descriptor (method-descriptor method)))
     900          (method-name method)
     901          (pool-add-utf8 pool (map-method-name (method-name method)))))
     902  (finalize-attributes (method-attributes method) nil class))
     903
     904
     905(defun write-method (method stream)
    905906  "Write class file representation of `method' to `stream'."
    906   (write-u2 (!method-access-flags method) stream)
    907   (write-u2 (!method-name method) stream)
    908   ;;(sys::%format t "method-name: ~a~%" (!method-name method))
    909   (write-u2 (!method-descriptor method) stream)
    910   (write-attributes (!method-attributes method) stream))
     907  (write-u2 (method-access-flags method) stream)
     908  (write-u2 (method-name method) stream)
     909  ;;(sys::%format t "method-name: ~a~%" (method-name method))
     910  (write-u2 (method-descriptor method) stream)
     911  (write-attributes (method-attributes method) stream))
    911912
    912913(defstruct attribute
     
    951952                           (:include attribute
    952953                                     (name "Code")
    953                                      (finalizer #'!finalize-code)
    954                                      (writer #'!write-code))
     954                                     (finalizer #'finalize-code-attribute)
     955                                     (writer #'write-code-attribute))
    955956                           (:constructor %make-code-attribute))
    956957  "The attribute containing the actual JVM byte code;
     
    982983        (acons label offset (code-labels code))))
    983984
    984 (defun !finalize-code (code parent class)
     985(defun finalize-code-attribute (code parent class)
    985986  "Prepares the `code' attribute for serialization, within method `parent'."
    986987  (declare (ignore parent))
     
    10001001            (code-labels code) labels)))
    10011002
     1003  (setf (code-exception-handlers code)
     1004        (remove-if #'(lambda (h)
     1005                       (eql (code-label-offset code (exception-start-pc h))
     1006                            (code-label-offset code (exception-end-pc h))))
     1007                   (code-exception-handlers code)))
     1008
    10021009  (dolist (exception (code-exception-handlers code))
    10031010    (setf (exception-start-pc exception)
     
    10151022  (finalize-attributes (code-attributes code) code class))
    10161023
    1017 (defun !write-code (code stream)
     1024(defun write-code-attribute (code stream)
    10181025  "Writes the attribute `code' to `stream'."
    10191026  ;;(sys::%format t "max-stack: ~a~%" (code-max-stack code))
     
    10861093
    10871094"
    1088  
     1095  ;;; ### TODO
    10891096  )
    10901097
     
    11301137  (setf (code-code code) *code*
    11311138        (code-max-locals code) *registers-allocated*
    1132 ;;        (code-exception-handlers code) *handlers*
    11331139        (code-current-local code) *register*))
    11341140
    11351141(defun restore-code-specials (code)
    11361142  (setf *code* (code-code code)
    1137 ;;        *handlers* (code-exception-handlers code)
    11381143        *registers-allocated* (code-max-locals code)
    11391144        *register* (code-current-local code)))
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp

    r12894 r12895  
    151151                                                      "java.util.UUID"))))))
    152152
    153 (defun make-class-file (&key pathname lambda-name lambda-list)
     153(defun make-abcl-class-file (&key pathname lambda-name lambda-list)
    154154  "Creates a `class-file' structure. If `pathname' is non-NIL, it's
    155155used to derive a class name. If it is NIL, a random one created
Note: See TracChangeset for help on using the changeset viewer.