Changeset 14098


Ignore:
Timestamp:
08/16/12 20:09:23 (9 years ago)
Author:
ehuelsmann
Message:

Reorganize binding *CURRENT-COMPILAND*, WITH-SAVED-COMPILER-POLICY.
Add missing WITH-SAVED-COMPILER-POLICY and PROCESS-OPTIMIZATION-DECLARATIONS.

File:
1 edited

Legend:

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

    r14096 r14098  
    32523252      (push variable *visible-variables*))
    32533253    ;; 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)))
    32563258    (when bind-special-p
    32573259      (restore-dynamic-environment (m-v-b-environment-register block)))))
     
    41034105                                   :if-exists :supersede)))
    41044106      (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)))
    41094109    (when stream
    41104110      (let ((bytes (sys::%get-output-stream-bytes stream)))
     
    41284128    (dolist (special (flet-free-specials block))
    41294129      (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)))))
    41324134
    41334135(defknown p2-labels-node (t t t) t)
     
    41444146    (dolist (special (labels-free-specials block))
    41454147      (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)))))
    41484152
    41494153(defun p2-lambda (local-function target)
     
    70567060
    70577061         (*thread* nil)
    7058          (*initialize-thread-var* nil))
     7062         (*initialize-thread-var* nil)
     7063         (*current-compiland* compiland))
    70597064
    70607065    (with-code-to-method (class-file method)
     
    71727177              (setf (variable-index variable) nil)))))
    71737178
    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))
    71767184
    71777185      ;; 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))
    71807188
    71817189      ;; Establish dynamic bindings for any variables declared special.
    7182       (when (some #'variable-special-p (compiland-arg-vars compiland))
    7183         ;; Save the dynamic environment
    7184         (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))
    72067214
    72077215      (when (compiland-environment-register compiland)
     
    72937301        (*closure-variables* nil)
    72947302        (*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)
    73017306    ;; *all-variables* doesn't contain variables which
    73027307    ;; are in an enclosing lexical environment (variable-environment)
     
    73247329
    73257330    (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))))
    73307333
    73317334(defvar *compiler-error-bailout*)
Note: See TracChangeset for help on using the changeset viewer.