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
;;; -*- Mode: Lisp ; Syntax: ANSI-Common-Lisp -*-
#+xcvb (module ())
(in-package :asdf)
(defmethod perform ((o bundle-op) (c system))
(let* ((object-files (remove "fas" (input-files o c)
:key #'pathname-type :test #'string=))
(output (output-files o c)))
(ensure-directories-exist (first output))
(apply #'c::builder (bundle-op-type o) (first output) :lisp-files object-files
(append (bundle-op-build-args o)
(when (and (typep o 'monolithic-bundle-op)
(monolithic-op-prologue-code o))
`(:prologue-code ,(monolithic-op-prologue-code o)))
(when (and (typep o 'monolithic-bundle-op)
(monolithic-op-epilogue-code o))
`(:epilogue-code ,(monolithic-op-epilogue-code o)))))))
;;;
;;; Final integration steps
;;;
(export '(make-build load-fasl-op prebuilt-system))
(push '("fasb" . si::load-binary) ext:*load-hooks*)
(defun register-pre-built-system (name)
(register-system (make-instance 'system :name name :source-file nil)))
(setf ext:*module-provider-functions*
(loop :for f :in ext:*module-provider-functions*
:unless (eq f 'module-provide-asdf)
:collect #'(lambda (name)
(let ((l (multiple-value-list (funcall f name))))
(and (first l) (register-pre-built-system name))
(values-list l)))))
#+win32 (push '("asd" . si::load-source) ext:*load-hooks*)
(pushnew (translate-logical-pathname "SYS:") *central-registry*)
(provide :asdf)