Changeset 12195


Ignore:
Timestamp:
10/15/09 20:35:05 (12 years ago)
Author:
ehuelsmann
Message:

Remove temp file creation which was solely used

for generation of unique names.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r12193 r12195  
    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              (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))))))))
     4953           (let ((class-file (make-class-file :lambda-list lambda-list)))
     4954             (with-open-stream (stream (sys::%make-byte-array-output-stream))
     4955               (set-compiland-and-write-class class-file compiland stream)
     4956               (setf (local-function-class-file local-function) class-file)
     4957               (setf (local-function-function local-function)
     4958                     (load-compiled-function
     4959                      (sys::%get-output-stream-bytes stream)))))))))
    49634960
    49644961(defun emit-make-compiled-closure-for-labels
     
    49914988                local-function compiland g))))
    49924989          (t
    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))))))))
     4990           (let ((class-file (make-class-file :lambda-list lambda-list)))
     4991             (with-open-stream (stream (sys::%make-byte-array-output-stream))
     4992               (set-compiland-and-write-class class-file compiland stream)
     4993               (setf (local-function-class-file local-function) class-file)
     4994               (let ((g (declare-object
     4995                         (load-compiled-function
     4996                          (sys::%get-output-stream-bytes stream)))))
     4997                 (emit-make-compiled-closure-for-labels
     4998                  local-function compiland g))))))))
    50064999
    50075000(defknown p2-flet-node (t t t) t)
     
    50585051                   +lisp-object+)))
    50595052          (t
    5060            (let ((pathname (funcall *pathnames-generator*)))
    5061              (setf (compiland-class-file compiland)
    5062                    (make-class-file :pathname pathname
    5063                                     :lambda-list lambda-list))
    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)))))
     5053           (setf (compiland-class-file compiland)
     5054                 (make-class-file :lambda-list lambda-list))
     5055           (with-open-stream (stream (sys::%make-byte-array-output-stream))
     5056             (compile-and-write-to-stream (compiland-class-file compiland)
     5057                                          compiland stream)
     5058             (emit 'getstatic *this-class*
     5059                   (declare-object (load-compiled-function
     5060                                    (sys::%get-output-stream-bytes stream)))
     5061                   +lisp-object+))))
    50735062    (cond ((null *closure-variables*))  ; Nothing to do.
    50745063          ((compiland-closure-register *current-compiland*)
     
    84178406
    84188407(defun compile-defun (name form environment filespec stream)
     8408  "Compiles a lambda expression `form'. If `filespec' is NIL,
     8409a random Java class name is generated, if it is non-NIL, it's used
     8410to derive a Java class name from."
    84198411  (aver (eq (car form) 'LAMBDA))
    84208412  (catch 'compile-defun-abort
     
    85298521
    85308522(defun %jvm-compile (name definition expr env)
    8531   (let* (compiled-function
    8532          (tempfile (make-temp-file)))
    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))
     8523  ;; This function is part of the call chain from COMPILE, but
     8524  ;; not COMPILE-FILE
     8525  (let* (compiled-function)
     8526    (with-compilation-unit ()
     8527      (with-saved-compiler-policy
     8528          (setf compiled-function
     8529                (load-compiled-function
     8530                 (with-open-stream (s (sys::%make-byte-array-output-stream))
     8531                   (compile-defun name expr env nil s)
     8532                   (finish-output s)
     8533                   (sys::%get-output-stream-bytes s))))))
    85518534    (when (and name (functionp compiled-function))
    85528535      (sys::set-function-definition name compiled-function definition))
     
    85558538
    85568539(defun jvm-compile (name &optional definition)
     8540  ;; This function is part of the call chain from COMPILE, but
     8541  ;; not COMPILE-FILE
    85578542  (unless definition
    85588543    (resolve name) ;; Make sure the symbol has been resolved by the autoloader
     
    85688553        (*visible-variables* nil)
    85698554        (*local-functions* nil)
    8570         (*pathnames-generator* #'make-temp-file)
     8555        (*pathnames-generator* (constantly nil))
    85718556        (sys::*fasl-anonymous-package* (sys::%make-package))
    85728557        environment)
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r12168 r12195  
    118118    (concatenate 'string "org/armedbear/lisp/" name)))
    119119
     120(defun make-unique-class-name ()
     121  "Creates a random class name for use with a `class-file' structure's
     122`class' slot."
     123  (concatenate 'string "abcl_"
     124          (java:jcall (java:jmethod "java.lang.String" "replace" "char" "char")
     125                      (java:jcall (java:jmethod "java.util.UUID" "toString")
     126                             (java:jstatic "randomUUID" "java.util.UUID"))
     127                      #\- #\_)))
     128
    120129(defun make-class-file (&key pathname lambda-name lambda-list)
    121   (aver (not (null pathname)))
    122   (let ((class-file (%make-class-file :pathname pathname
    123                                       :lambda-name lambda-name
    124                                       :lambda-list lambda-list)))
    125     (setf (class-file-class class-file) (class-name-from-filespec pathname))
     130  "Creates a `class-file' structure. If `pathname' is non-NIL, it's
     131used to derive a class name. If it is NIL, a random one created
     132using `make-unique-class-name'."
     133  (let* ((class-name (if pathname
     134                         (class-name-from-filespec  pathname)
     135                         (make-unique-class-name)))
     136         (class-file (%make-class-file :pathname pathname
     137                                       :class class-name
     138                                       :lambda-name lambda-name
     139                                       :lambda-list lambda-list)))
    126140    class-file))
    127141
Note: See TracChangeset for help on using the changeset viewer.