;;; Copyright (c) 2008 - 2011, Juan Jose Garcia Ripoll
;;; Copyright (c) 2012 - 2012, Francois-Rene Rideau
;;;
-;;; Currently works on SBCL, CCL, maybe CCL. For ABCL, see the abcl-jar contrib instead.
+;;; Currently works on Allegro, Clozure CL, ECL, SBCL, maybe MKCL.
+;;; For ABCL, see the abcl-jar contrib instead.
(defsystem :asdf-bundle
:licence "MIT"
:components
((:file "specials")
(:file "bundle" :depends-on ("specials"))
- #+(or clozure sbcl) (:file "fasl-concat" :depends-on ("bundle"))
+ #+(or allegro clozure sbcl) (:file "fasl-concat" :depends-on ("bundle"))
#+ecl (:file "ecl" :depends-on ("specials"))
#+mkcl (:file "mkcl" :depends-on ("specials"))))
(declaim (optimize (debug 3) (safety 3) (speed 1)))
-#+sbcl
+(defun copy-stream-to-stream (input output &key (element-type 'character) (buffer-size 8192))
+ "Copy the contents of the INPUT stream into the OUTPUT stream,
+using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
+ (with-open-stream (input input)
+ (loop
+ :for buffer = (make-array (list buffer-size) :element-type element-type)
+ :for end = (read-sequence buffer input)
+ :until (zerop end)
+ :do (write-sequence buffer output :end end)
+ (when (< end buffer-size) (return)))))
+
(defun concatenate-files (inputs output)
- (let ((infiles (mapcar #'sb-ext:native-namestring inputs))
- (outfile (sb-ext:native-namestring output)))
- (assert
- (= 0 (sb-ext:process-exit-code
- #+win32
- (sb-ext:run-program
- "copy" `("/b" ,@(loop :for (i . morep) :on infiles
- :collect i :when morep :collect "+") ,output)
- :input nil :output nil :error nil :wait t)
- #-win32
- (sb-ext:run-program
- "cat" infiles :output outfile
- :if-output-exists :supersede :external-format :latin1
- :input nil :error nil :search t :wait t))))))
+ (with-open-file (o output :element-type '(unsigned-byte 8)
+ :direction :output :if-exists :rename-and-delete)
+ (dolist (input inputs)
+ (with-open-file (i input :element-type '(unsigned-byte 8)
+ :direction :input :if-does-not-exist :error)
+ (copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
(defun combine-fasls (inputs output)
- #+ccl (ccl:fasl-concatenate output inputs :if-exists :supersede)
- #+sbcl (concatenate-files inputs output))
+ #+clozure (ccl:fasl-concatenate output inputs :if-exists :supersede)
+ #+(or allegro sbcl) (concatenate-files inputs output))
(defun call-with-staging-pathname (pathname fun)
"Calls fun with a staging pathname, and atomically