Changeset 12894


Ignore:
Timestamp:
08/13/10 20:25:20 (12 years ago)
Author:
ehuelsmann
Message:

Generate the execute() methods through the new generator.

Changed:

  • CLEAR-VALUES instruction now takes the thread-register as its argument, to disconnect code-finalization from the scope of the *THREAD* binding.

Clean up:

  • JAVA-METHOD (structure)
  • HANDLER (structure)
  • WRITE-METHOD (function)
  • MAKE-METHOD (function)
  • WRITE-CODE-ATTR (function)
  • WRITE-EXCEPTION-TABLE (function)
  • remove code-finalization from P2-COMPILAND
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

    r12893 r12894  
    8181
    8282(defun add-exception-handler (start end handler type)
    83   (if (null *current-code-attribute*)
    84       (push (make-handler :from start
    85                           :to end
    86                           :code handler
    87                           :catch-type (if (null type)
    88                                           0
    89                                           (pool-class type)))
    90             *handlers*)
    91       (code-add-exception-handler *current-code-attribute*
    92                                   start end handler type)))
     83  (code-add-exception-handler *current-code-attribute*
     84                              start end handler type))
    9385
    9486
     
    636628  (declare (optimize speed (safety 0)))
    637629  (ensure-thread-var-initialized)
    638   (emit 'clear-values))
     630  (emit 'clear-values *thread*))
    639631
    640632(defknown maybe-emit-clear-values (&rest t) t)
     
    644636    (unless (single-valued-p form)
    645637      (ensure-thread-var-initialized)
    646       (emit 'clear-values)
     638      (emit 'clear-values *thread*)
    647639      (return))))
    648640
     
    777769
    778770
    779 
    780 
    781 (defstruct (java-method (:include method)
    782                         (:conc-name method-)
    783                         (:constructor %make-method))
    784   name-index
    785   descriptor-index
    786   max-stack
    787   max-locals
    788   code
    789   handlers)
    790 
    791 (defun make-method (&rest args &key descriptor name
    792                                     descriptor-index name-index
    793                                &allow-other-keys)
    794   (apply #'%make-method
    795          (list* :descriptor-index (or descriptor-index (pool-name descriptor))
    796                 :name-index (or name-index (pool-name name))
    797                 args)))
    798771
    799772(defun emit-constructor-lambda-name (lambda-name)
     
    934907    method))
    935908
    936 (defun write-exception-table (method stream)
    937   (let ((handlers (method-handlers method)))
    938     (write-u2 (length handlers) stream) ; number of entries
    939     (dolist (handler handlers)
    940       (write-u2 (symbol-value (handler-from handler)) stream)
    941       (write-u2 (symbol-value (handler-to handler)) stream)
    942       (write-u2 (symbol-value (handler-code handler)) stream)
    943       (write-u2 (handler-catch-type handler) stream))))
    944909
    945910(defun write-source-file-attr (source-file stream)
     
    962927    (write-u2 *source-line-number* stream)))
    963928
    964 (defun write-code-attr (method stream)
    965   (declare (optimize speed))
    966   (declare (type stream stream))
    967   (let* ((name-index (pool-name "Code"))
    968          (code (method-code method))
    969          (code-length (length code))
    970          (line-number-available-p (and (fixnump *source-line-number*)
    971                                        (plusp *source-line-number*)))
    972          (length (+ code-length 12
    973                     (* (length (method-handlers method)) 8)
    974                     (if line-number-available-p 12 0)))
    975          (max-stack (or (method-max-stack method) 20))
    976          (max-locals (or (method-max-locals method) 1)))
    977     (write-u2 name-index stream)
    978     (write-u4 length stream)
    979     (write-u2 max-stack stream)
    980     (write-u2 max-locals stream)
    981     (write-u4 code-length stream)
    982     (dotimes (i code-length)
    983       (declare (type index i))
    984       (write-u1 (the (unsigned-byte 8) (svref code i)) stream))
    985     (write-exception-table method stream)
    986     (cond (line-number-available-p
    987            ; attributes count
    988            (write-u2 1 stream)
    989            (write-line-number-table stream))
    990           (t
    991            ; attributes count
    992            (write-u2 0 stream)))))
    993 
    994 (defun write-method (method stream)
    995   (declare (optimize speed))
    996   (write-u2 (or (method-access-flags method) #x1) stream) ; access flags
    997   (write-u2 (method-name-index method) stream)
    998   (write-u2 (method-descriptor-index method) stream)
    999   (write-u2 1 stream) ; attributes count
    1000   (write-code-attr method stream))
    1001929
    1002930
     
    68916819                                        (abcl-class-file-lambda-list class-file))))
    68926820    (pool-name "Code") ; Must be in pool!
     6821    (class-add-method class-file constructor)
    68936822
    68946823    (when *file-compilation*
     
    69006829    (dolist (field (class-file-fields class-file))
    69016830      (finalize-field field class-file))
    6902     (finalize-method constructor class-file)
     6831    (dolist (method (class-file-methods class-file))
     6832      (finalize-method method class-file))
    69036833
    69046834    (write-u4 #xCAFEBABE stream)
     
    69186848      (write-field field stream))
    69196849    ;; methods count
    6920     (write-u2 (1+ (length (abcl-class-file-methods class-file))) stream)
     6850    (write-u2 (length (abcl-class-file-methods class-file)) stream)
    69216851    ;; methods
    69226852    (dolist (method (abcl-class-file-methods class-file))
    6923       (write-method method stream))
    6924     (!write-method constructor stream)
     6853      (!write-method method stream))
    69256854    ;; attributes count
    69266855    (cond (*file-compilation*
     
    69976926
    69986927         (arg-types (analyze-args compiland))
    6999          (execute-method (make-method :name "execute"
    7000                                       :descriptor (apply #'descriptor
    7001                                                          +lisp-object+
    7002                                                          arg-types)))
     6928         (method (!make-method "execute" +lisp-object+ arg-types
     6929                               :flags '(:final :public)))
     6930         (code (method-add-code method))
     6931         (*current-code-attribute* code)
    70036932         (*code* ())
    70046933         (*register* 1) ;; register 0: "this" pointer
    70056934         (*registers-allocated* 1)
    7006          (*handlers* ())
    70076935         (*visible-variables* *visible-variables*)
    70086936
     
    70106938         (*initialize-thread-var* nil)
    70116939         (label-START (gensym)))
     6940
     6941    (class-add-method class-file method)
    70126942
    70136943    (dolist (var (compiland-arg-vars compiland))
     
    71927122
    71937123    (setf (abcl-class-file-lambda-list class-file) args)
    7194     (setf (method-max-locals execute-method) *registers-allocated*)
    7195     (push execute-method (abcl-class-file-methods class-file))
    7196 
    7197 
    7198     ;;;  Move here
    7199     (setf *code* (finalize-code *code*
    7200                                 (nconc (mapcar #'handler-from *handlers*)
    7201                                        (mapcar #'handler-to *handlers*)
    7202                                        (mapcar #'handler-code *handlers*)) t))
    7203 
    7204     (setf (method-max-stack execute-method)
    7205           (analyze-stack *code* (mapcar #'handler-code *handlers*)))
    7206     (setf (method-code execute-method) (code-bytes *code*))
    7207 
    7208     ;; Remove handler if its protected range is empty.
    7209     (setf *handlers*
    7210           (delete-if (lambda (handler)
    7211                        (eql (symbol-value (handler-from handler))
    7212                             (symbol-value (handler-to handler))))
    7213                      *handlers*))
    7214     ;;; to here
    7215     ;;; To a separate function which is part of class file finalization
    7216     ;;;  when we have a section of class-file-generation centered code
    7217 
    7218 
    7219     (setf (method-handlers execute-method) (nreverse *handlers*)))
     7124    (setf (code-max-locals code) *registers-allocated*)
     7125    (setf (code-code code) *code*))
     7126
    72207127  t)
    72217128
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp

    r12877 r12894  
    448448           (dolist (instruction
    449449                     (list
    450                       (inst 'aload *thread*)
     450                      (inst 'aload (car (instruction-args instruction)))
    451451                      (inst 'aconst_null)
    452452                      (inst 'putfield (u2 (pool-field +lisp-thread+ "_values"
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp

    r12890 r12894  
    230230(defvar *registers-allocated* 0)
    231231
    232 (defvar *handlers* ())
    233 
    234 (defstruct handler
    235   from       ;; label indicating the start of the protected block
    236   to         ;; label indicating the end of the protected block
    237   code       ;; label to jump to if the specified exception occurs
    238   catch-type ;; pool index of the class name of the exception, or 0 (zero)
    239              ;; for 'all'
    240   )
    241 
    242232;; Variables visible at the current point of compilation.
    243233(defvar *visible-variables* nil
Note: See TracChangeset for help on using the changeset viewer.