Changeset 12193


Ignore:
Timestamp:
10/13/09 22:09:14 (12 years ago)
Author:
ehuelsmann
Message:

Fix temp file leakage.

Note: this change is mostly for backport to 0.16.x, because

the real change is to add a source for semi-unique class names.

File:
1 edited

Legend:

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

    r12188 r12193  
    49474947                  (class-file (make-class-file :pathname pathname
    49484948                                               :lambda-list lambda-list)))
    4949        (with-open-class-file (f class-file)
    4950          (set-compiland-and-write-class class-file compiland f))
     4949             (with-open-class-file (f class-file)
     4950               (set-compiland-and-write-class class-file compiland f))
    49514951             (setf (local-function-class-file local-function) class-file)))
    49524952          (t
    4953      (let ((class-file (make-class-file
    4954             :pathname (funcall *pathnames-generator*)
    4955             :lambda-list lambda-list)))
    4956        (with-open-stream (stream (sys::%make-byte-array-output-stream))
    4957          (set-compiland-and-write-class class-file compiland stream)
    4958          (setf (local-function-class-file local-function) class-file)
    4959          (setf (local-function-function local-function)
    4960                      (load-compiled-function (sys::%get-output-stream-bytes stream)))))))))
     4953           (let ((class-file (make-class-file
     4954                              :pathname (funcall *pathnames-generator*)
     4955                              :lambda-list lambda-list)))
     4956             (unwind-protect
     4957                  (with-open-stream (stream (sys::%make-byte-array-output-stream))
     4958                    (set-compiland-and-write-class class-file compiland stream)
     4959                    (setf (local-function-class-file local-function) class-file)
     4960                    (setf (local-function-function local-function)
     4961                          (load-compiled-function (sys::%get-output-stream-bytes stream))))
     4962               (delete-file (class-file-pathname class-file))))))))
    49614963
    49624964(defun emit-make-compiled-closure-for-labels
     
    49824984                  (class-file (make-class-file :pathname pathname
    49834985                                               :lambda-list lambda-list)))
    4984        (with-open-class-file (f class-file)
    4985          (set-compiland-and-write-class class-file compiland f))
     4986             (with-open-class-file (f class-file)
     4987               (set-compiland-and-write-class class-file compiland f))
    49864988             (setf (local-function-class-file local-function) class-file)
    49874989             (let ((g (declare-local-function local-function)))
    4988          (emit-make-compiled-closure-for-labels
    4989     local-function compiland g))))
     4990               (emit-make-compiled-closure-for-labels
     4991                local-function compiland g))))
    49904992          (t
    4991      (let ((class-file (make-class-file
    4992             :pathname (funcall *pathnames-generator*)
    4993             :lambda-list lambda-list)))
    4994        (with-open-stream (stream (sys::%make-byte-array-output-stream))
    4995          (set-compiland-and-write-class class-file compiland stream)
    4996          (setf (local-function-class-file local-function) class-file)
    4997          (let ((g (declare-object
    4998        (load-compiled-function
    4999         (sys::%get-output-stream-bytes stream)))))
    5000      (emit-make-compiled-closure-for-labels
    5001       local-function compiland g))))))))
     4993           (let ((class-file (make-class-file
     4994                              :pathname (funcall *pathnames-generator*)
     4995                              :lambda-list lambda-list)))
     4996             (unwind-protect
     4997                  (with-open-stream (stream (sys::%make-byte-array-output-stream))
     4998                    (set-compiland-and-write-class class-file compiland stream)
     4999                    (setf (local-function-class-file local-function) class-file)
     5000                    (let ((g (declare-object
     5001                              (load-compiled-function
     5002                               (sys::%get-output-stream-bytes stream)))))
     5003                      (emit-make-compiled-closure-for-labels
     5004                       local-function compiland g)))
     5005               (delete-file (class-file-pathname class-file))))))))
    50025006
    50035007(defknown p2-flet-node (t t t) t)
     
    50585062                   (make-class-file :pathname pathname
    50595063                                    :lambda-list lambda-list))
    5060        (with-open-stream (stream (sys::%make-byte-array-output-stream))
    5061          (compile-and-write-to-stream (compiland-class-file compiland)
    5062               compiland stream)
    5063          (emit 'getstatic *this-class*
    5064          (declare-object (load-compiled-function
    5065               (sys::%get-output-stream-bytes stream)))
    5066          +lisp-object+)))))
     5064             (unwind-protect
     5065                  (with-open-stream (stream (sys::%make-byte-array-output-stream))
     5066                    (compile-and-write-to-stream (compiland-class-file compiland)
     5067                                                 compiland stream)
     5068                    (emit 'getstatic *this-class*
     5069                          (declare-object (load-compiled-function
     5070                                           (sys::%get-output-stream-bytes stream)))
     5071                          +lisp-object+))
     5072               (delete-file pathname)))))
    50675073    (cond ((null *closure-variables*))  ; Nothing to do.
    50685074          ((compiland-closure-register *current-compiland*)
     
    85258531  (let* (compiled-function
    85268532         (tempfile (make-temp-file)))
    8527     (with-compilation-unit ()
    8528       (with-saved-compiler-policy
    8529     (setf compiled-function
    8530     (load-compiled-function   
    8531      (if *file-compilation*
    8532          (unwind-protect
    8533         (progn
    8534           (with-open-file (f tempfile
    8535                  :direction :output
    8536                  :element-type '(unsigned-byte 8)
    8537                  :if-exists :supersede)
    8538             (compile-defun name expr env tempfile f))
    8539           tempfile)
    8540            (delete-file tempfile))
    8541          (with-open-stream (s (sys::%make-byte-array-output-stream))
    8542            (compile-defun name expr env tempfile s)
    8543            (finish-output s)
    8544            (sys::%get-output-stream-bytes s)))))))
     8533    (unwind-protect
     8534         (with-compilation-unit ()
     8535           (with-saved-compiler-policy
     8536               (setf compiled-function
     8537                     (load-compiled-function     
     8538                      (if *file-compilation*
     8539                          (progn
     8540                            (with-open-file (f tempfile
     8541                                               :direction :output
     8542                                               :element-type '(unsigned-byte 8)
     8543                                               :if-exists :supersede)
     8544                              (compile-defun name expr env tempfile f))
     8545                            tempfile)
     8546                          (with-open-stream (s (sys::%make-byte-array-output-stream))
     8547                            (compile-defun name expr env tempfile s)
     8548                            (finish-output s)
     8549                            (sys::%get-output-stream-bytes s)))))))
     8550      (delete-file tempfile))
    85458551    (when (and name (functionp compiled-function))
    85468552      (sys::set-function-definition name compiled-function definition))
Note: See TracChangeset for help on using the changeset viewer.