Changeset 11857
- Timestamp:
- 05/11/09 21:38:49 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11855 r11857 8086 8086 (incf index))) 8087 8087 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)) 8100 8090 8101 8091 (when (and *closure-variables* (not *child-p*)) … … 8103 8093 (dformat t "p2-compiland 2 closure register = ~S~%" 8104 8094 (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~%" 8112 8100 (compiland-name compiland)) 8113 8101 (cond (*child-p* 8114 8102 (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 8118 8105 (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)) 8120 8108 (emit 'anewarray "org/armedbear/lisp/LispObject"))) 8121 8109 (dolist (variable closure-args) 8122 (dformat t "considering ~S ...~%" (variable-name variable))8123 8110 (dformat t "moving variable ~S~%" (variable-name variable)) 8124 8111 (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)))) 8131 8114 (emit 'dup) ; array 8132 8115 (emit-push-constant-int (variable-closure-index variable)) … … 8134 8117 (emit 'aastore) 8135 8118 (setf (variable-register variable) nil)) 8136 ;; The variable has moved.8137 8119 ((variable-index variable) 8138 8120 (emit 'dup) ; array … … 8143 8125 (emit 'aastore) 8144 8126 (setf (variable-index variable) nil)))) 8145 ;; The variable has moved.8146 8127 8147 8128 (aver (not (null (compiland-closure-register compiland)))) 8148 8129 (cond (*child-p* 8149 (when closure-args 8150 (emit 'pop))) 8130 (emit 'pop)) 8151 8131 (t 8152 8132 (astore (compiland-closure-register compiland)))) … … 8155 8135 8156 8136 ;; If applicable, move args from arg array to registers. 8157 (when *using-arg-array*8158 (unless (or *closure-variables* *child-p*)8159 8160 (when (variable-reserved-registervariable)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))) 8162 8142 (aload (compiland-argument-register compiland)) 8163 8143 (emit-push-constant-int (variable-index variable)) 8164 8144 (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) 8167 8147 (setf (variable-index variable) nil))))) 8168 8148 8149 (p2-compiland-process-type-declarations body) 8169 8150 (generate-type-checks-for-variables (compiland-arg-vars compiland)) 8170 8151
Note: See TracChangeset
for help on using the changeset viewer.