Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
ef75676b
Commit
ef75676b
authored
Apr 29, 2010
by
Francois-Rene Rideau
Browse files
1.710: update asdf-ecl, make gcl happier with in-package, refresh gitignore.
parent
c26da0a3
Changes
3
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
ef75676b
# really this is private to my build process
make/
common-lisp.net
.vcs
init-lisp.lisp
website/changelog.xml
push
resbcl
reccl
reecl
# Temporary files from documentation build
doc/asdf/
...
...
@@ -28,9 +24,7 @@ doc/asdf.vrs
# We build these at various stages in the make process
LICENSE
website/output/
tmp/
lift-local.config
*.dribble
*.fasl
*.dfsl
...
...
@@ -38,5 +32,6 @@ lift-local.config
*.fas
*.lib
*.o
*.a
*.*fsl
*.bak
asdf-ecl.lisp
View file @
ef75676b
...
...
@@ -52,12 +52,12 @@
(
prologue-code
:accessor
monolithic-op-prologue-code
)
(
epilogue-code
:accessor
monolithic-op-epilogue-code
)))
(
defclass
monolithic-fasl-op
(
fasl-op
monolithic-bundle-op
)
())
(
defclass
monolithic-fasl-op
(
monolithic-bundle-op
fasl-op
)
())
(
defclass
monolithic-lib-op
(
lib-op
monolithic-bundle-op
)
(
defclass
monolithic-lib-op
(
monolithic-bundle-op
lib-op
)
((
type
:initform
:lib
)))
(
defclass
monolithic-dll-op
(
dll-op
monolithic-bundle-op
)
(
defclass
monolithic-dll-op
(
monolithic-bundle-op
dll-op
)
((
type
:initform
:dll
)))
(
defclass
program-op
(
monolithic-bundle-op
)
...
...
@@ -141,6 +141,7 @@
;;; with the static library of this module.
;;;
(
defmethod
bundle-sub-operations
((
o
dll-op
)
c
)
(
declare
(
ignore
o
))
(
list
(
cons
(
make-instance
'lib-op
)
c
)))
;;;
;;; FASL FILES
...
...
@@ -148,6 +149,7 @@
;;; Gather the statically linked library of this component.
;;;
(
defmethod
bundle-sub-operations
((
o
fasl-op
)
c
)
(
declare
(
ignore
o
))
(
list
(
cons
(
make-instance
'lib-op
)
c
)))
(
defmethod
component-depends-on
((
o
bundle-op
)
(
c
system
))
...
...
@@ -157,9 +159,11 @@
(
component-name
dep
))))
(
defmethod
component-depends-on
((
o
lib-op
)
(
c
system
))
(
declare
(
ignore
o
))
(
list
(
list
'compile-op
(
component-name
c
))))
(
defmethod
component-depends-on
((
o
bundle-op
)
c
)
(
declare
(
ignore
o
c
))
nil
)
(
defmethod
input-files
((
o
bundle-op
)
(
c
system
))
...
...
@@ -173,17 +177,21 @@
(
component-relative-pathname
c
)))))
(
defmethod
output-files
((
o
fasl-op
)
(
c
system
))
(
declare
(
ignore
c
))
(
loop
for
file
in
(
call-next-method
)
collect
(
make-pathname
:type
"fasb"
:defaults
file
)))
(
defmethod
perform
((
o
bundle-op
)
(
c
t
))
(
declare
(
ignore
o
c
))
t
)
(
defmethod
operation-done-p
((
o
bundle-op
)
(
c
source-file
))
(
declare
(
ignore
o
c
))
t
)
(
defmethod
perform
((
o
bundle-op
)
(
c
system
))
(
let*
((
object-files
(
remove
"fas"
(
input-files
o
c
)
:key
#'
pathname-type
:test
#'
string=
))
(
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
...
...
@@ -197,6 +205,8 @@
(
defun
select-operation
(
monolithic
type
)
(
ecase
type
((
:binary
)
(
if
monolithic
'monolithic-binary-op
'binary-op
))
((
:dll
:shared-library
)
(
if
monolithic
'monolithic-dll-op
'dll-op
))
((
:lib
:static-library
)
...
...
@@ -206,37 +216,31 @@
((
:program
)
'program-op
)))
(
defun
make-build
(
system
&rest
args
&key
(
monolithic
nil
)
(
type
:fasl
)
(
move-here
nil
move-here-p
)
&allow-other-keys
)
(
let*
((
operation-name
(
select-operation
monolithic
type
))
(
move-here-path
(
if
(
and
move-here
(
typep
move-here
'
(
or
pathname
string
)))
(
pathname
move-here
)
(
merge-pathnames
"./asdf-output/"
)))
(
operation
(
apply
#'
operate
operation-name
system
(
remove-keys
'
(
monolithic
type
move-here
)
args
)))
(
system
(
find-system
system
))
(
files
(
and
system
(
output-files
operation
system
))))
(
print
files
)
(
print
move-here
)
(
if
(
or
move-here
(
and
(
null
move-here-p
)
(
member
operation-name
'
(
:program
))))
(
loop
for
path
in
files
for
filename
=
(
namestring
(
truename
path
))
for
new-path
=
(
make-pathname
:name
(
pathname-name
path
)
:type
(
pathname-type
path
)
:defaults
*default-pathname-defaults*
)
for
new-filename
=
(
namestring
new-path
)
for
command
=
#+
windows
(
format
nil
"move ~S ~S"
filename
new-filename
)
#-
windows
(
format
nil
"mv ~S ~S"
filename
new-filename
)
do
(
unless
(
equalp
new-filename
filename
)
(
when
(
plusp
(
si::system
(
print
command
)))
(
error
"Unable to move file~& ~S~&to new location~& ~S"
path
new-path
)))
collect
new-path
)
(
if
(
or
move-here
(
and
(
null
move-here-p
)
(
member
operation-name
'
(
:program
:binary
))))
(
loop
with
dest-path
=
(
truename
(
ensure-directories-exist
move-here-path
))
for
f
in
files
for
new-f
=
(
make-pathname
:name
(
pathname-name
f
)
:type
(
pathname-type
f
)
:defaults
dest-path
)
do
(
progn
(
when
(
probe-file
new-f
)
(
delete-file
new-f
))
(
rename-file
f
new-f
))
collect
new-f
)
files
)))
;;;
...
...
@@ -257,10 +261,12 @@
(
component-depends-on
(
make-instance
'load-op
)
c
)))))
(
defmethod
input-files
((
o
load-fasl-op
)
(
c
system
))
(
declare
(
ignore
o
))
(
unless
(
trivial-system-p
c
)
(
output-files
(
make-instance
'fasl-op
)
c
)))
(
defmethod
perform
((
o
load-fasl-op
)
(
c
t
))
(
declare
(
ignore
o
c
))
nil
)
(
defmethod
perform
((
o
load-fasl-op
)
(
c
system
))
...
...
@@ -287,14 +293,19 @@
:type
"fas"
)))
(
defmethod
output-files
(
o
(
c
compiled-file
))
(
declare
(
ignore
o
c
))
nil
)
(
defmethod
input-files
(
o
(
c
compiled-file
))
(
declare
(
ignore
o
c
))
nil
)
(
defmethod
perform
((
o
load-op
)
(
c
compiled-file
))
(
declare
(
ignore
o
))
(
load
(
component-pathname
c
)))
(
defmethod
perform
((
o
load-fasl-op
)
(
c
compiled-file
))
(
declare
(
ignore
o
))
(
load
(
component-pathname
c
)))
(
defmethod
perform
(
o
(
c
compiled-file
))
(
declare
(
ignore
o
c
))
nil
)
;;;
...
...
@@ -304,6 +315,7 @@
((
static-library
:accessor
prebuilt-system-static-library
:initarg
:lib
)))
(
defmethod
output-files
((
o
lib-op
)
(
c
prebuilt-system
))
(
declare
(
ignore
o
))
(
values
(
list
(
compile-file-pathname
(
prebuilt-system-static-library
c
)
:type
:lib
))
t
; Advertise that we do not want this path renamed
...
...
@@ -313,22 +325,89 @@
(
car
(
output-files
o
c
)))
(
defmethod
component-depends-on
((
o
lib-op
)
(
c
prebuilt-system
))
(
declare
(
ignore
o
c
))
nil
)
(
defmethod
bundle-sub-operations
((
o
lib-op
)
(
c
prebuilt-system
))
(
declare
(
ignore
o
c
))
nil
)
(
defmethod
bundle-sub-operations
((
o
monolithic-lib-op
)
(
c
prebuilt-system
))
(
declare
(
ignore
o
c
))
(
error
"Prebuilt system ~S shipped with ECL can not be used in a monolithic library operation."
c
))
(
defmethod
bundle-sub-operations
((
o
monolithic-bundle-op
)
(
c
prebuilt-system
))
(
declare
(
ignore
o
c
))
nil
)
;;;
;;; PREBUILT SYSTEM CREATOR
;;;
(
defclass
binary-op
(
bundle-op
)
())
(
defclass
monolithic-binary-op
(
binary-op
monolithic-bundle-op
)
())
(
defun
binary-op-dependencies
(
o
s
)
(
let
(
lib-op
fasl-op
)
(
if
(
bundle-op-monolithic-p
o
)
(
setf
lib-op
'monolithic-lib-op
fasl-op
'monolithic-fasl-op
)
(
setf
lib-op
'lib-op
fasl-op
'fasl-op
))
(
list
(
list
(
make-instance
lib-op
:args
(
bundle-op-build-args
o
))
s
)
(
list
(
make-instance
fasl-op
:args
(
bundle-op-build-args
o
))
s
))))
(
defmethod
component-depends-on
((
o
binary-op
)
(
s
system
))
(
loop
for
dep
in
(
binary-op-dependencies
o
s
)
append
(
apply
#'
component-depends-on
dep
)))
(
defmethod
input-files
((
o
binary-op
)
(
s
system
))
(
loop
for
dep
in
(
binary-op-dependencies
o
s
)
append
(
apply
#'
input-files
dep
)))
(
defmethod
output-files
((
o
binary-op
)
(
s
system
))
(
list*
(
merge-pathnames*
(
make-pathname
:name
(
component-name
s
)
:type
"asd"
)
(
component-relative-pathname
s
))
(
loop
for
dep
in
(
binary-op-dependencies
o
s
)
append
(
apply
#'
output-files
dep
))))
(
defmethod
perform
((
o
binary-op
)
(
s
system
))
(
let*
((
dependencies
(
binary-op-dependencies
o
s
))
(
library
(
first
(
apply
#'
output-files
(
first
dependencies
))))
(
fasl
(
first
(
apply
#'
output-files
(
second
dependencies
))))
(
filename
(
first
(
output-files
o
s
)))
(
name
(
component-name
s
))
(
name-keyword
(
intern
(
string
name
)
(
find-package
:keyword
))))
(
loop
for
dep
in
dependencies
do
(
apply
#'
perform
dep
))
(
with-open-file
(
s
filename
:direction
:output
:if-exists
:supersede
:if-does-not-exist
:create
)
(
format
s
";;; Prebuilt ASDF definition for system ~A"
name
)
(
format
s
";;; Built for ~A ~A on a ~A/~A ~A"
(
lisp-implementation-type
)
(
lisp-implementation-version
)
(
software-type
)
(
machine-type
)
(
software-version
))
(
let
((
*package*
(
find-package
:keyword
)))
(
pprint
`
(
defsystem
,
name-keyword
:class
asdf::prebuilt-system
:components
((
:compiled-file
,
(
pathname-name
fasl
)))
:lib
,
(
make-pathname
:name
(
pathname-name
library
)
:type
(
pathname-type
library
)))
s
)))))
;;;
;;; Final integration steps
;;;
(
export
'
(
make-build
load-fasl-op
))
(
export
'
(
make-build
load-fasl-op
prebuilt-system
))
(
push
'
(
"fasb"
.
si::load-binary
)
si::*load-hooks*
)
(
require
'cmp
)
...
...
asdf.lisp
View file @
ef75676b
...
...
@@ -63,7 +63,7 @@
(
remove
"asdf"
excl::*autoload-package-name-alist*
:test
'equalp
:key
'car
))
(
let*
((
asdf-version
;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
(
subseq
"VERSION:1.70
9
"
(
1+
(
length
"VERSION"
))))
(
subseq
"VERSION:1.7
1
0"
(
1+
(
length
"VERSION"
))))
(
existing-asdf
(
find-package
:asdf
))
(
versym
'
#:*asdf-version*
)
(
existing-version
(
and
existing-asdf
...
...
@@ -278,7 +278,7 @@
(
eval
`
(
defparameter
,
(
intern
(
string
versym
)
(
find-package
:asdf
))
,
asdf-version
))))))
(
in-package
#
:asdf
)
(
in-package
:asdf
)
;;;; -------------------------------------------------------------------------
;;;; User-visible parameters
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment