Add allegro support (untested) by just concatenating fasls.
authorFrancois-Rene Rideau <tunes@google.com>
Wed, 14 Nov 2012 23:33:44 +0000 (18:33 -0500)
committerFrancois-Rene Rideau <tunes@google.com>
Wed, 14 Nov 2012 23:33:44 +0000 (18:33 -0500)
asdf-bundle.asd
fasl-concat.lisp

index fcf5f07..3daef4d 100644 (file)
@@ -10,7 +10,8 @@
 ;;; 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"
@@ -20,6 +21,6 @@
   :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"))))
index c820e14..ac8e975 100644 (file)
@@ -6,26 +6,28 @@
 
 (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