Changeset 14098
- Timestamp:
- 08/16/12 20:09:23 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r14096 r14098 3252 3252 (push variable *visible-variables*)) 3253 3253 ;; Body. 3254 (let ((*blocks* (cons block *blocks*))) 3255 (compile-progn-body (cdddr form) target)) 3254 (with-saved-compiler-policy 3255 (process-optimization-declarations (cdddr form)) 3256 (let ((*blocks* (cons block *blocks*))) 3257 (compile-progn-body (cdddr form) target))) 3256 3258 (when bind-special-p 3257 3259 (restore-dynamic-environment (m-v-b-environment-register block))))) … … 4103 4105 :if-exists :supersede))) 4104 4106 (with-class-file class-file 4105 (let ((*current-compiland* compiland)) 4106 (with-saved-compiler-policy 4107 (compile-to-jvm-class compiland) 4108 (finish-class (compiland-class-file compiland) f))))) 4107 (compile-to-jvm-class compiland) 4108 (finish-class (compiland-class-file compiland) f))) 4109 4109 (when stream 4110 4110 (let ((bytes (sys::%get-output-stream-bytes stream))) … … 4128 4128 (dolist (special (flet-free-specials block)) 4129 4129 (push special *visible-variables*)) 4130 (let ((*blocks* (cons block *blocks*))) 4131 (compile-progn-body body target representation)))) 4130 (with-saved-compiler-policy 4131 (process-optimization-declarations body) 4132 (let ((*blocks* (cons block *blocks*))) 4133 (compile-progn-body body target representation))))) 4132 4134 4133 4135 (defknown p2-labels-node (t t t) t) … … 4144 4146 (dolist (special (labels-free-specials block)) 4145 4147 (push special *visible-variables*)) 4146 (let ((*blocks* (cons block *blocks*))) 4147 (compile-progn-body body target representation)))) 4148 (with-saved-compiler-policy 4149 (process-optimization-declarations body) 4150 (let ((*blocks* (cons block *blocks*))) 4151 (compile-progn-body body target representation))))) 4148 4152 4149 4153 (defun p2-lambda (local-function target) … … 7056 7060 7057 7061 (*thread* nil) 7058 (*initialize-thread-var* nil)) 7062 (*initialize-thread-var* nil) 7063 (*current-compiland* compiland)) 7059 7064 7060 7065 (with-code-to-method (class-file method) … … 7172 7177 (setf (variable-index variable) nil))))) 7173 7178 7174 (p2-compiland-process-type-declarations body) 7175 (generate-type-checks-for-variables (compiland-arg-vars compiland)) 7179 (with-saved-compiler-policy 7180 (process-optimization-declarations body) 7181 7182 (p2-compiland-process-type-declarations body) 7183 (generate-type-checks-for-variables (compiland-arg-vars compiland)) 7176 7184 7177 7185 ;; Unbox variables. 7178 (dolist (variable (compiland-arg-vars compiland))7179 (p2-compiland-unbox-variable variable))7186 (dolist (variable (compiland-arg-vars compiland)) 7187 (p2-compiland-unbox-variable variable)) 7180 7188 7181 7189 ;; Establish dynamic bindings for any variables declared special. 7182 (when (some #'variable-special-p (compiland-arg-vars compiland))7183 ;; Save the dynamic environment7184 (setf (compiland-environment-register compiland)7185 (allocate-register nil))7186 (save-dynamic-environment (compiland-environment-register compiland))7187 (dolist (variable (compiland-arg-vars compiland))7188 (when (variable-special-p variable)7189 (setf (variable-binding-register variable) (allocate-register nil))7190 (emit-push-current-thread)7191 (emit-push-variable-name variable)7192 (cond ((variable-register variable)7193 (aload (variable-register variable))7194 (setf (variable-register variable) nil))7195 ((variable-index variable)7196 (aload (compiland-argument-register compiland))7197 (emit-push-constant-int (variable-index variable))7198 (emit 'aaload)7199 (setf (variable-index variable) nil)))7200 (emit-invokevirtual +lisp-thread+ "bindSpecial"7201 (list +lisp-symbol+ +lisp-object+)7202 +lisp-special-binding+)7203 (astore (variable-binding-register variable)))))7204 7205 (compile-progn-body body 'stack)7190 (when (some #'variable-special-p (compiland-arg-vars compiland)) 7191 ;; Save the dynamic environment 7192 (setf (compiland-environment-register compiland) 7193 (allocate-register nil)) 7194 (save-dynamic-environment (compiland-environment-register compiland)) 7195 (dolist (variable (compiland-arg-vars compiland)) 7196 (when (variable-special-p variable) 7197 (setf (variable-binding-register variable) (allocate-register nil)) 7198 (emit-push-current-thread) 7199 (emit-push-variable-name variable) 7200 (cond ((variable-register variable) 7201 (aload (variable-register variable)) 7202 (setf (variable-register variable) nil)) 7203 ((variable-index variable) 7204 (aload (compiland-argument-register compiland)) 7205 (emit-push-constant-int (variable-index variable)) 7206 (emit 'aaload) 7207 (setf (variable-index variable) nil))) 7208 (emit-invokevirtual +lisp-thread+ "bindSpecial" 7209 (list +lisp-symbol+ +lisp-object+) 7210 +lisp-special-binding+) 7211 (astore (variable-binding-register variable))))) 7212 7213 (compile-progn-body body 'stack)) 7206 7214 7207 7215 (when (compiland-environment-register compiland) … … 7293 7301 (*closure-variables* nil) 7294 7302 (*undefined-variables* nil) 7295 (*local-functions* *local-functions*) 7296 (*current-compiland* compiland)) 7297 (with-saved-compiler-policy 7298 ;; Pass 1. 7299 (p1-compiland compiland)) 7300 7303 (*local-functions* *local-functions*)) 7304 7305 (p1-compiland compiland) 7301 7306 ;; *all-variables* doesn't contain variables which 7302 7307 ;; are in an enclosing lexical environment (variable-environment) … … 7324 7329 7325 7330 (with-class-file (compiland-class-file compiland) 7326 (with-saved-compiler-policy 7327 (compile-to-jvm-class compiland) 7328 ;; (finalize-class-file (compiland-class-file compiland)) 7329 (finish-class (compiland-class-file compiland) stream))))) 7331 (compile-to-jvm-class compiland) 7332 (finish-class (compiland-class-file compiland) stream)))) 7330 7333 7331 7334 (defvar *compiler-error-bailout*)
Note: See TracChangeset
for help on using the changeset viewer.