Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
;;; -*- Mode: Lisp ; Syntax: ANSI-Common-Lisp -*-
#+xcvb (module (:depends-on ("bundle")))
(in-package :asdf)
(declaim (optimize (debug 3) (safety 3) (speed 1)))
(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))))))
(defun combine-fasls (inputs outputs)
(assert (length=n-p outputs 1))
(ensure-directories-exist (first outputs))
(concatenate-files inputs (first outputs)))
(defmethod perform ((o bundle-op) (c system))
(let* ((input-files (input-files o c))
(fasl-files (remove "fasl" input-files :key #'pathname-type :test-not #'string=))
(non-fasl-files (remove "fasl" input-files :key #'pathname-type :test #'string=))
(output-files (output-files o c))
(output-file (first output-files)))
(when input-files
(assert output-files)
(when non-fasl-files
(error "On SBCL, asdf-bundle can only bundle FASL files, but these were also produced: ~S" non-fasl-files))
(when (and (typep o 'monolithic-bundle-op)
(or (monolithic-op-prologue-code o) (monolithic-op-epilogue-code o)))
(error "prologue-code and epilogue-code are not supported on SBCL"))
(ensure-directories-exist output-file)
(combine-fasls fasl-files output-files))))
;;; On SBCL, everything happens in the lib-op dependency
(defmethod output-files ((o fasl-op) (c component))
(declare (ignorable o c))
nil)
(defmethod input-files ((o fasl-op) (c component))
(declare (ignorable o c))
nil)