Changeset 11854


Ignore:
Timestamp:
05/11/09 19:40:10 (12 years ago)
Author:
ehuelsmann
Message:

P2-COMPILAND: baby step at cleaning up for readability.

File:
1 edited

Legend:

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

    r11853 r11854  
    80438043                                      :descriptor descriptor))
    80448044         (*code* ())
    8045          (*register* 0)
    8046          (*registers-allocated* 0)
     8045         (*register* 1) ;; register 0: "this" pointer
     8046         (*registers-allocated* 1)
    80478047         (*handlers* ())
    80488048         (*visible-variables* *visible-variables*)
     
    80628062    (setf (method-descriptor-index execute-method)
    80638063          (pool-name (method-descriptor execute-method)))
    8064     (cond (*hairy-arglist-p*
    8065            (let ((index 0))
    8066              (dolist (variable (compiland-arg-vars compiland))
    8067                (aver (null (variable-register variable)))
    8068                (aver (null (variable-index variable)))
    8069                (setf (variable-index variable) index)
    8070                (incf index))))
     8064
     8065    (when (and *closure-variables* *child-p*)
     8066      (setf (compiland-closure-register compiland)
     8067            (allocate-register)) ;; register 1: the closure array
     8068      (dformat t "p2-compiland 1 closure register = ~S~%"
     8069               (compiland-closure-register compiland)))
     8070
     8071
     8072    (let ((register *register*)
     8073          (index 0))
     8074      (dolist (variable (compiland-arg-vars compiland))
     8075        (aver (null (variable-register variable)))
     8076        (aver (null (variable-index variable)))
     8077        (cond
     8078          (*hairy-arglist-p*
     8079           (setf (variable-index variable) index))
     8080          (*using-arg-array*
     8081           (setf (variable-index variable) index))
    80718082          (t
    8072            (let ((register (if (and *closure-variables* *child-p*)
    8073                                2 ; Reg 1 is reserved for closure variables array.
    8074                                1))
    8075                  (index 0))
    8076              (dolist (variable (compiland-arg-vars compiland))
    8077                (aver (null (variable-register variable)))
    8078                (setf (variable-register variable)
    8079                      (if *using-arg-array* nil register))
    8080                (aver (null (variable-index variable)))
    8081                (if *using-arg-array*
    8082                    (setf (variable-index variable) index))
    8083                (incf register)
    8084                (incf index)))))
    8085 
    8086     (p2-compiland-process-type-declarations body)
    8087 
    8088     (allocate-register) ;; register 0: "this" pointer
    8089     (when (and *closure-variables* *child-p*)
    8090       (setf (compiland-closure-register compiland) (allocate-register)) ;; register 1
    8091       (dformat t "p2-compiland 1 closure register = ~S~%" (compiland-closure-register compiland)))
     8083           (setf (variable-register variable) register)))
     8084        (incf register)
     8085        (incf index)))
     8086
    80928087    (cond (*using-arg-array*
    80938088           ;; One slot for arg array.
     
    81008095               (aver (null (variable-reserved-register variable)))
    81018096               (unless (variable-special-p variable)
    8102                  (setf (variable-reserved-register variable) (allocate-register))))))
     8097                 (setf (variable-reserved-register variable)
     8098                       (allocate-register))))))
    81038099          (t
    81048100           ;; Otherwise, one register for each argument.
     
    81068102             (declare (ignore variable))
    81078103             (allocate-register))))
     8104
     8105    (p2-compiland-process-type-declarations body)
     8106
     8107
    81088108    (when (and *closure-variables* (not *child-p*))
    81098109      (setf (compiland-closure-register compiland) (allocate-register))
    8110        (dformat t "p2-compiland 2 closure register = ~S~%" (compiland-closure-register compiland)))
     8110       (dformat t "p2-compiland 2 closure register = ~S~%"
     8111                (compiland-closure-register compiland)))
    81118112    ;; Reserve the next available slot for the thread register.
    81128113    (setf *thread* (allocate-register))
Note: See TracChangeset for help on using the changeset viewer.