Changeset 11452


Ignore:
Timestamp:
12/18/08 21:01:44 (13 years ago)
Author:
ehuelsmann
Message:

Introduce WITH-SAVED-COMPILER-POLICY macro to consistently save all policy variables.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r11396 r11452  
    6262(defmacro dformat (&rest ignored)
    6363  (declare (ignore ignored)))
     64
     65
     66(defmacro with-saved-compiler-policy (&body body)
     67  "Saves compiler policy variables, restoring them after evaluating `body'."
     68  `(let ((*speed* *speed*)
     69         (*space* *space*)
     70         (*safety* *safety*)
     71         (*debug* *debug*)
     72         (*explain* *explain*)
     73         (*inline-declarations* *inline-declarations*))
     74     ,@body))
     75
    6476
    6577(eval-when (:compile-toplevel :load-toplevel :execute)
     
    786798        (when variable
    787799          (push variable *visible-variables*))))
    788     (let ((*speed* *speed*)
    789           (*safety* *safety*)
    790           (*debug* *debug*)
    791           (*explain* *explain*)
    792           (*inline-declarations* *inline-declarations*))
     800    (with-saved-compiler-policy
    793801      (process-optimization-declarations (cddr form))
    794802      (list* (car form) local-functions (p1-body (cddr form))))))
     
    54625470      (push variable *visible-variables*))
    54635471    ;; Body of LET/LET*.
    5464     (let ((*speed*  *speed*)
    5465           (*space*  *space*)
    5466           (*safety* *safety*)
    5467           (*debug*  *debug*)
    5468           (*explain* *explain*)
    5469           (*inline-declarations* *inline-declarations*))
     5472    (with-saved-compiler-policy
    54705473      (process-optimization-declarations (cddr form))
    54715474      (compile-progn-body (cddr form) target representation))
     
    54775480
    54785481(defun p2-locally (form target representation)
    5479   (let ((*speed*  *speed*)
    5480         (*space*  *space*)
    5481         (*safety* *safety*)
    5482         (*debug*  *debug*)
    5483         (*explain* *explain*)
    5484         (*inline-declarations* *inline-declarations*)
    5485         (body (cdr form)))
    5486     (process-optimization-declarations body)
    5487     (compile-progn-body body target representation)))
     5482  (with-saved-compiler-policy
     5483    (let ((body (cdr form)))
     5484      (process-optimization-declarations body)
     5485      (compile-progn-body body target representation))))
    54885486
    54895487(defknown find-tag (t) t)
     
    60316029             (setf (compiland-class-file compiland) class-file)
    60326030             (with-class-file class-file
    6033                (let ((*current-compiland* compiland)
    6034                      (*speed* *speed*)
    6035                      (*safety* *safety*)
    6036                      (*debug* *debug*)
    6037                      (*explain* *explain*))
    6038                  (p2-compiland compiland)
    6039                  (write-class-file (compiland-class-file compiland))))
     6031               (let ((*current-compiland* compiland))
     6032                 (with-saved-compiler-policy
     6033                   (p2-compiland compiland)
     6034                   (write-class-file (compiland-class-file compiland)))))
    60406035             ;; Verify that the class file is loadable.
    60416036             (let ((*load-truename* (pathname pathname)))
     
    60686063                 (progn
    60696064                   (with-class-file class-file
    6070                      (let ((*current-compiland* compiland)
    6071                            (*speed* *speed*)
    6072                            (*safety* *safety*)
    6073                            (*debug* *debug*)
    6074                            (*explain* *explain*))
    6075                        (p2-compiland compiland)
    6076                        (write-class-file (compiland-class-file compiland))))
     6065                     (let ((*current-compiland* compiland))
     6066                       (with-saved-compiler-policy
     6067                         (p2-compiland compiland)
     6068                         (write-class-file (compiland-class-file compiland)))))
    60776069                   (setf (local-function-class-file local-function) class-file)
    60786070                   (setf (local-function-function local-function) (load-compiled-function pathname))
     
    61056097             (setf (compiland-class-file compiland) class-file)
    61066098             (with-class-file class-file
    6107                (let ((*current-compiland* compiland)
    6108                      (*speed* *speed*)
    6109                      (*safety* *safety*)
    6110                      (*debug* *debug*)
    6111                      (*explain* *explain*))
    6112                  (p2-compiland compiland)
    6113                  (write-class-file (compiland-class-file compiland))))
     6099               (let ((*current-compiland* compiland))
     6100                 (with-saved-compiler-policy
     6101                   (p2-compiland compiland)
     6102                   (write-class-file (compiland-class-file compiland)))))
    61146103             ;; Verify that the class file is loadable.
    61156104             (let ((*load-truename* (pathname pathname)))
     
    61406129                 (progn
    61416130                   (with-class-file class-file
    6142                      (let ((*current-compiland* compiland)
    6143                            (*speed* *speed*)
    6144                            (*safety* *safety*)
    6145                            (*debug* *debug*)
    6146                            (*explain* *explain*))
    6147                        (p2-compiland compiland)
    6148                        (write-class-file (compiland-class-file compiland))))
     6131                     (let ((*current-compiland* compiland))
     6132                       (with-saved-compiler-policy
     6133                         (p2-compiland compiland)
     6134                         (write-class-file (compiland-class-file compiland)))))
    61496135                   (setf (local-function-class-file local-function) class-file)
    61506136                   (let ((g (declare-object (load-compiled-function pathname))))
     
    62196205                                  :lambda-list lambda-list))
    62206206           (with-class-file (compiland-class-file compiland)
    6221              (let ((*current-compiland* compiland)
    6222                    (*speed* *speed*)
    6223                    (*safety* *safety*)
    6224                    (*debug* *debug*)
    6225                    (*explain* *explain*))
    6226                (p2-compiland compiland)
    6227                (write-class-file (compiland-class-file compiland))))
     6207             (let ((*current-compiland* compiland))
     6208               (with-saved-compiler-policy
     6209                 (p2-compiland compiland)
     6210                 (write-class-file (compiland-class-file compiland)))))
    62286211           (let ((class-file (compiland-class-file compiland)))
    62296212             (emit 'getstatic *this-class*
     
    62386221                 (progn
    62396222                   (with-class-file (compiland-class-file compiland)
    6240                      (let ((*current-compiland* compiland)
    6241                            (*speed* *speed*)
    6242                            (*safety* *safety*)
    6243                            (*debug* *debug*)
    6244                            (*explain* *explain*))
    6245                        (p2-compiland compiland)
    6246                        (write-class-file (compiland-class-file compiland))))
     6223                     (let ((*current-compiland* compiland))
     6224                       (with-saved-compiler-policy
     6225                         (p2-compiland compiland)
     6226                         (write-class-file (compiland-class-file compiland)))))
    62476227                   (emit 'getstatic *this-class*
    62486228                         (declare-object (load-compiled-function pathname))
     
    1026210242        (*undefined-variables* nil)
    1026310243        (*local-functions* nil)
    10264         (*current-compiland* compiland)
    10265         (*speed* *speed*)
    10266         (*safety* *safety*)
    10267         (*debug* *debug*)
    10268         (*explain* *explain*)
    10269         (*inline-declarations* *inline-declarations*))
    10270     ;; Pass 1.
    10271     (p1-compiland compiland)
    10272     (setf *closure-variables*
    10273           (remove-if-not #'variable-used-non-locally-p *all-variables*))
    10274     (when *closure-variables*
     10244        (*current-compiland* compiland))
     10245    (with-saved-compiler-policy
     10246      ;; Pass 1.
     10247      (p1-compiland compiland)
    1027510248      (setf *closure-variables*
    10276             (remove-if #'variable-special-p *closure-variables*))
     10249            (remove-if-not #'variable-used-non-locally-p *all-variables*))
    1027710250      (when *closure-variables*
    10278         (let ((i 0))
    10279           (dolist (var (reverse *closure-variables*))
    10280             (setf (variable-closure-index var) i)
    10281             (dformat t "var = ~S closure index = ~S~%" (variable-name var)
    10282                      (variable-closure-index var))
    10283             (incf i)))))
    10284     ;; Pass 2.
    10285     (with-class-file (compiland-class-file compiland)
    10286       (p2-compiland compiland)
    10287       (write-class-file (compiland-class-file compiland)))
    10288     (class-file-pathname (compiland-class-file compiland))))
     10251        (setf *closure-variables*
     10252              (remove-if #'variable-special-p *closure-variables*))
     10253        (when *closure-variables*
     10254          (let ((i 0))
     10255            (dolist (var (reverse *closure-variables*))
     10256              (setf (variable-closure-index var) i)
     10257              (dformat t "var = ~S closure index = ~S~%" (variable-name var)
     10258                       (variable-closure-index var))
     10259              (incf i)))))
     10260      ;; Pass 2.
     10261      (with-class-file (compiland-class-file compiland)
     10262        (p2-compiland compiland)
     10263        (write-class-file (compiland-class-file compiland)))
     10264      (class-file-pathname (compiland-class-file compiland)))))
    1028910265
    1029010266(defvar *compiler-error-bailout*)
     
    1038210358           (failure-p t))
    1038310359      (with-compilation-unit ()
    10384         (let* ((*speed* *speed*)
    10385                (*space* *space*)
    10386                (*safety* *safety*)
    10387                (*debug* *debug*)
    10388                (*explain* *explain*)
    10389                (tempfile (make-temp-file)))
    10390           (unwind-protect
    10391               (setf compiled-function
    10392                     (load-compiled-function (compile-defun name expr env tempfile)))
    10393             (delete-file tempfile)))
     10360        (with-saved-compiler-policy
     10361          (let* ((tempfile (make-temp-file)))
     10362            (unwind-protect
     10363                 (setf compiled-function
     10364                       (load-compiled-function (compile-defun name expr env tempfile)))
     10365              (delete-file tempfile))))
    1039410366        (when (and name (functionp compiled-function))
    1039510367          (sys::%set-lambda-name compiled-function name)
Note: See TracChangeset for help on using the changeset viewer.