Changeset 11885


Ignore:
Timestamp:
05/16/09 19:03:21 (9 years ago)
Author:
ehuelsmann
Message:

p2-compiland cleanup.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11883 r11885  
    17631763  descriptor-index)
    17641764
    1765 (defstruct (java-method (:conc-name method-) (:constructor make-method))
     1765(defstruct (java-method (:conc-name method-) (:constructor %make-method))
    17661766  access-flags
    17671767  name
     
    17741774  handlers)
    17751775
     1776(defun make-method (&rest args &key descriptor name
     1777                                    descriptor-index name-index
     1778                               &allow-other-keys)
     1779  (apply #'%make-method
     1780         (list* :descriptor-index (or descriptor-index (pool-name descriptor))
     1781                :name-index (or name-index (pool-name name))
     1782                args)))
     1783
    17761784(defun emit-constructor-lambda-name (lambda-name)
    17771785  (cond ((and lambda-name (symbolp lambda-name) (symbol-package (truly-the symbol lambda-name)))
     
    18011809         (*code* ())
    18021810         (*handlers* nil))
    1803     (setf (method-name-index constructor) (pool-name (method-name constructor)))
    1804     (setf (method-descriptor-index constructor) (pool-name (method-descriptor constructor)))
    18051811    (setf (method-max-locals constructor) 1)
    18061812    (aload 0) ;; this
     
    80098015         (*thread* nil)
    80108016         (*initialize-thread-var* nil)
    8011          (super nil)
    80128017         (label-START (gensym)))
    80138018
     
    80168021    (dolist (var (compiland-free-specials compiland))
    80178022      (push var *visible-variables*))
    8018 
    8019     (setf (method-name-index execute-method)
    8020           (pool-name (method-name execute-method)))
    8021     (setf (method-descriptor-index execute-method)
    8022           (pool-name (method-descriptor execute-method)))
    80238023
    80248024    (when *using-arg-array*
     
    80418041    (when *closure-variables*
    80428042      (setf (compiland-closure-register compiland) (allocate-register))
    8043        (dformat t "p2-compiland 2 closure register = ~S~%"
    8044                 (compiland-closure-register compiland)))
     8043      (dformat t "p2-compiland 2 closure register = ~S~%"
     8044               (compiland-closure-register compiland)))
    80458045
    80468046    (when *closure-variables*
     
    81998199    ;; Remove handler if its protected range is empty.
    82008200    (setf *handlers*
    8201           (delete-if (lambda (handler) (eql (symbol-value (handler-from handler))
    8202                                             (symbol-value (handler-to handler))))
     8201          (delete-if (lambda (handler)
     8202                       (eql (symbol-value (handler-from handler))
     8203                            (symbol-value (handler-to handler))))
    82038204                     *handlers*))
    82048205
     
    82078208
    82088209    (setf (class-file-superclass class-file)
    8209           (cond (super
    8210                  super)
    8211                 (*child-p*
    8212                  (if *closure-variables*
    8213                      (progn
    8214                        (setf (method-name-index execute-method)
    8215                              (pool-name (method-name execute-method)))
    8216                        (setf (method-descriptor-index execute-method)
    8217                              (pool-name (method-descriptor execute-method)))
    8218                        +lisp-compiled-closure-class+)
    8219                      (if *hairy-arglist-p*
    8220                          +lisp-compiled-function-class+
    8221                          +lisp-primitive-class+)))
    8222                 (*hairy-arglist-p*
    8223                  +lisp-compiled-function-class+)
    8224                 (t
    8225                  +lisp-primitive-class+)))
     8210          (cond
     8211            ((and *child-p* *closure-variables*) +lisp-compiled-closure-class+)
     8212            (*hairy-arglist-p* +lisp-compiled-function-class+)
     8213            (t +lisp-primitive-class+)))
    82268214
    82278215    (setf (class-file-lambda-list class-file) args)
Note: See TracChangeset for help on using the changeset viewer.