Changeset 11857


Ignore:
Timestamp:
05/11/09 21:38:49 (14 years ago)
Author:
ehuelsmann
Message:

P2-COMPILAND: Code re-ordering and merging of
blocks with the same conditions.

File:
1 edited

Legend:

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

    r11855 r11857  
    80868086        (incf index)))
    80878087
    8088     (when (and *using-arg-array*
    8089                (not (or *closure-variables* *child-p*)))
    8090       ;; Reserve a register for each parameter.
    8091       (dolist (variable (compiland-arg-vars compiland))
    8092         (aver (null (variable-register variable)))
    8093         (aver (null (variable-reserved-register variable)))
    8094         (unless (variable-special-p variable)
    8095           (setf (variable-reserved-register variable)
    8096                 (allocate-register)))))
    8097 
    8098     (p2-compiland-process-type-declarations body)
    8099 
     8088    ;; Reserve the next available slot for the thread register.
     8089    (setf *thread* (allocate-register))
    81008090
    81018091    (when (and *closure-variables* (not *child-p*))
     
    81038093       (dformat t "p2-compiland 2 closure register = ~S~%"
    81048094                (compiland-closure-register compiland)))
    8105     ;; Reserve the next available slot for the thread register.
    8106     (setf *thread* (allocate-register))
    8107 
    8108     ;; Move args from their original registers to the closure variables array,
    8109     ;; if applicable.
    8110     (when *closure-variables*
    8111       (dformat t "~S moving arguments to closure array (if applicable)~%"
     8095
     8096    ;; Move args from their original registers to the closure variables array
     8097    (when (or closure-args
     8098              (and *closure-variables* (not *child-p*)))
     8099      (dformat t "~S moving arguments to closure array~%"
    81128100               (compiland-name compiland))
    81138101      (cond (*child-p*
    81148102             (aver (eql (compiland-closure-register compiland) 1))
    8115              (when closure-args
    8116                (aload (compiland-closure-register compiland))))
    8117             (t
     8103             (aload (compiland-closure-register compiland)))
     8104            (t ;; if we're the ultimate parent: create the closure array
    81188105             (emit-push-constant-int (length *closure-variables*))
    8119              (dformat t "p2-compiland ~S anewarray 1~%" (compiland-name compiland))
     8106             (dformat t "p2-compiland ~S anewarray 1~%"
     8107                      (compiland-name compiland))
    81208108             (emit 'anewarray "org/armedbear/lisp/LispObject")))
    81218109      (dolist (variable closure-args)
    8122         (dformat t "considering ~S ...~%" (variable-name variable))
    81238110        (dformat t "moving variable ~S~%" (variable-name variable))
    81248111        (cond ((variable-register variable)
    8125                (when (eql (variable-register variable)
    8126                           (compiland-closure-register compiland))
    8127                  (error "ERROR! compiland closure register = ~S var ~S register = ~S~%"
    8128                         (compiland-closure-register compiland)
    8129                         (variable-name variable)
    8130                         (variable-register variable)))
     8112               (assert (not (eql (variable-register variable)
     8113                                 (compiland-closure-register compiland))))
    81318114               (emit 'dup) ; array
    81328115               (emit-push-constant-int (variable-closure-index variable))
     
    81348117               (emit 'aastore)
    81358118               (setf (variable-register variable) nil))
    8136               ;; The variable has moved.
    81378119              ((variable-index variable)
    81388120               (emit 'dup) ; array
     
    81438125               (emit 'aastore)
    81448126               (setf (variable-index variable) nil))))
    8145       ;; The variable has moved.
    81468127
    81478128      (aver (not (null (compiland-closure-register compiland))))
    81488129      (cond (*child-p*
    8149              (when closure-args
    8150                (emit 'pop)))
     8130             (emit 'pop))
    81518131            (t
    81528132             (astore (compiland-closure-register compiland))))
     
    81558135
    81568136    ;; If applicable, move args from arg array to registers.
    8157     (when *using-arg-array*
    8158       (unless (or *closure-variables* *child-p*)
    8159         (dolist (variable (compiland-arg-vars compiland))
    8160           (when (variable-reserved-register variable)
    8161             (aver (not (variable-special-p variable)))
     8137    (when (and *using-arg-array*
     8138               (not (or *closure-variables* *child-p*)))
     8139      (dolist (variable (compiland-arg-vars compiland))
     8140        (unless (variable-special-p variable)
     8141          (let ((register (allocate-register)))
    81628142            (aload (compiland-argument-register compiland))
    81638143            (emit-push-constant-int (variable-index variable))
    81648144            (emit 'aaload)
    8165             (astore (variable-reserved-register variable))
    8166             (setf (variable-register variable) (variable-reserved-register variable))
     8145            (astore register)
     8146            (setf (variable-register variable) register)
    81678147            (setf (variable-index variable) nil)))))
    81688148
     8149    (p2-compiland-process-type-declarations body)
    81698150    (generate-type-checks-for-variables (compiland-arg-vars compiland))
    81708151
Note: See TracChangeset for help on using the changeset viewer.