Ignore:
Timestamp:
08/05/11 21:25:10 (11 years ago)
Author:
ehuelsmann
Message:

Rename writeToString() to printObject() since that's what it's being used for.
Additionally, create princToString() for use in error messages, making the

required replacement where appropriate.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r13435 r13440  
    904904  attribute)
    905905
    906 (defun method-add-code (method)
     906(defun method-add-code (method &optional (optimize t))
    907907  "Creates an (empty) 'Code' attribute for the method,
    908908returning the created attribute."
     
    911911   (make-code-attribute (+ (length (cdr (method-descriptor method)))
    912912                           (if (member :static (method-access-flags method))
    913                                0 1))))) ;; 1 == implicit 'this'
    914 
    915 (defun method-ensure-code (method)
     913                               0 1)) ;; 1 == implicit 'this'
     914      optimize)))
     915
     916(defun method-ensure-code (method &optional (optimize t))
    916917  "Ensures the existence of a 'Code' attribute for the method,
    917918returning the attribute."
    918919  (let ((code (method-attribute method "Code")))
    919920    (if (null code)
    920         (method-add-code method)
     921        (method-add-code method optimize)
    921922        code)))
    922923
     
    10031004  ;; labels contains offsets into the code array after it's finalized
    10041005  labels ;; an alist
    1005 
     1006  optimize
    10061007  (current-local 0)) ;; used for handling nested WITH-CODE-TO-METHOD blocks
    10071008
     
    10271028                            (mapcar #'exception-end-pc handlers)
    10281029                            (mapcar #'exception-handler-pc handlers))
    1029                      t)))
     1030                     (code-optimize code))))
    10301031    (invoke-callbacks :code-finalized class parent
    10311032                      (coerce c 'list) handlers)
     
    10871088  (write-attributes (code-attributes code) stream))
    10881089
    1089 (defun make-code-attribute (arg-count)
     1090(defun make-code-attribute (arg-count &optional optimize)
    10901091  "Creates an empty 'Code' attribute for a method which takes
    10911092`arg-count` parameters, including the implicit `this` parameter."
    1092   (%make-code-attribute :max-locals arg-count))
     1093  (%make-code-attribute :max-locals arg-count :optimize optimize))
    10931094
    10941095(defun code-add-attribute (code attribute)
     
    11931194       (when *current-code-attribute*
    11941195         (save-code-specials *current-code-attribute*))
    1195        (let* ((,m ,method)
    1196               (*method* ,m)
    1197               (,c (method-ensure-code ,method))
    1198               (*pool* (class-file-constants ,class-file))
    1199               (*code* (code-code ,c))
    1200               (*registers-allocated* (code-max-locals ,c))
    1201               (*register* (code-current-local ,c))
    1202               (*current-code-attribute* ,c))
    1203          ,@body
    1204          (setf (code-code ,c) *code*
    1205                (code-current-local ,c) *register*
    1206                (code-max-locals ,c) *registers-allocated*))
    1207        (when *current-code-attribute*
    1208          (restore-code-specials *current-code-attribute*)))))
     1196       (unwind-protect
     1197           (let* ((,m ,method)
     1198                  (*method* ,m)
     1199                  (,c (method-ensure-code ,method))
     1200                  (*pool* (class-file-constants ,class-file))
     1201                  (*code* (code-code ,c))
     1202                  (*registers-allocated* (code-max-locals ,c))
     1203                  (*register* (code-current-local ,c))
     1204                  (*current-code-attribute* ,c))
     1205             (unwind-protect
     1206                 ,@body
     1207               ;; in case of a RETURN-FROM or GO, save the current state
     1208               (setf (code-code ,c) *code*
     1209                     (code-current-local ,c) *register*
     1210                     (code-max-locals ,c) *registers-allocated*)))
     1211         ;; using the same line of reasoning, restore the outer-scope state
     1212         (when *current-code-attribute*
     1213           (restore-code-specials *current-code-attribute*))))))
    12091214
    12101215
Note: See TracChangeset for help on using the changeset viewer.