Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Didier Verna
asdf
Commits
2fceea52
Commit
2fceea52
authored
Mar 12, 2015
by
Francois-Rene Rideau
Browse files
Add CLASP support
Based on a contribution by Christian Shafmeister.
parent
99feb369
Changes
25
Hide whitespace changes
Inline
Side-by-side
backward-interface.lisp
View file @
2fceea52
...
...
@@ -86,15 +86,15 @@ processed in order by OPERATE."))
(
default-toplevel-directory
(
subpathname
(
user-homedir-pathname
)
".fasls/"
))
;; Use ".cache/common-lisp/" instead ???
(
include-per-user-information
nil
)
(
map-all-source-files
(
or
#+
(
or
clisp
ecl
mkcl
)
t
nil
))
(
map-all-source-files
(
or
#+
(
or
clasp
clisp
ecl
mkcl
)
t
nil
))
(
source-to-target-mappings
nil
)
(
file-types
`
(
,
(
compile-file-type
)
"build-report"
#+
ecl
(
compile-file-type
:type
:object
)
#+
(
or
clasp
ecl
)
(
compile-file-type
:type
:object
)
#+
mkcl
(
compile-file-type
:fasl-p
nil
)
#+
clisp
"lib"
#+
sbcl
"cfasl"
#+
sbcl
"sbcl-warnings"
#+
clozure
"ccl-warnings"
)))
#+
(
or
clisp
ecl
mkcl
)
#+
(
or
clasp
clisp
ecl
mkcl
)
(
when
(
null
map-all-source-files
)
(
error
"asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on CLISP, ECL and MKCL"
))
(
let*
((
patterns
(
if
map-all-source-files
(
list
*wild-file*
)
...
...
bundle.lisp
View file @
2fceea52
...
...
@@ -26,7 +26,7 @@
((
build-args
:initarg
:args
:initform
nil
:accessor
extra-build-args
)
(
name-suffix
:initarg
:name-suffix
:initform
nil
)
(
bundle-type
:initform
:no-output-file
:reader
bundle-type
)
#+
ecl
(
lisp-files
:initform
nil
:accessor
extra-object-files
)))
#+
(
or
clasp
ecl
)
(
lisp-files
:initform
nil
:accessor
extra-object-files
)))
(
defclass
monolithic-op
(
operation
)
()
(
:documentation
"A MONOLITHIC operation operates on a system *and all of its
...
...
@@ -89,16 +89,18 @@ itself.")) ;; operation on a system and its dependencies
((
bundle-type
:initform
:fasl
)))
(
defclass
prepare-bundle-op
(
sideway-operation
)
((
sideway-operation
:initform
#+
(
or
ecl
mkcl
)
'load-bundle-op
#-
(
or
ecl
mkcl
)
'load-op
:allocation
:class
)))
((
sideway-operation
:initform
#+
(
or
clasp
ecl
mkcl
)
'load-bundle-op
#-
(
or
clasp
ecl
mkcl
)
'load-op
:allocation
:class
)))
(
defclass
lib-op
(
link-op
gather-op
non-propagating-operation
)
((
bundle-type
:initform
:lib
))
(
:documentation
"compile the system and produce linkable (.a) library for it."
))
(
defclass
compile-bundle-op
(
basic-compile-bundle-op
selfward-operation
#+
(
or
ecl
mkcl
)
link-op
#-
ecl
gather-op
)
((
selfward-operation
:initform
'
(
prepare-bundle-op
#+
ecl
lib-op
)
:allocation
:class
)))
#+
(
or
clasp
ecl
mkcl
)
link-op
#-
(
or
clasp
ecl
)
gather-op
)
((
selfward-operation
:initform
'
(
prepare-bundle-op
#+
(
or
clasp
ecl
)
lib-op
)
:allocation
:class
)))
(
defclass
load-bundle-op
(
basic-load-op
selfward-operation
)
((
selfward-operation
:initform
'
(
prepare-bundle-op
compile-bundle-op
)
:allocation
:class
)))
...
...
@@ -113,18 +115,19 @@ itself.")) ;; operation on a system and its dependencies
(
:documentation
"compile the system and produce dynamic (.so/.dll) library for it."
))
(
defclass
deliver-asd-op
(
basic-compile-op
selfward-operation
)
((
selfward-operation
:initform
'
(
compile-bundle-op
#+
(
or
ecl
mkcl
)
lib-op
)
:allocation
:class
))
((
selfward-operation
:initform
'
(
compile-bundle-op
#+
(
or
clasp
ecl
mkcl
)
lib-op
)
:allocation
:class
))
(
:documentation
"produce an asd file for delivering the system as a single fasl"
))
(
defclass
monolithic-deliver-asd-op
(
monolithic-bundle-op
deliver-asd-op
)
((
selfward-operation
:initform
'
(
monolithic-compile-bundle-op
#+
(
or
ecl
mkcl
)
monolithic-lib-op
)
:allocation
:class
))
((
selfward-operation
:initform
'
(
monolithic-compile-bundle-op
#+
(
or
clasp
ecl
mkcl
)
monolithic-lib-op
)
:allocation
:class
))
(
:documentation
"produce fasl and asd files for combined system and dependencies."
))
(
defclass
monolithic-compile-bundle-op
(
monolithic-bundle-op
basic-compile-bundle-op
#+
(
or
ecl
mkcl
)
link-op
gather-op
non-propagating-operation
)
((
gather-op
:initform
#+
(
or
ecl
mkcl
)
'lib-op
#-
(
or
ecl
mkcl
)
'compile-bundle-op
:allocation
:class
))
#+
(
or
clasp
ecl
mkcl
)
link-op
gather-op
non-propagating-operation
)
((
gather-op
:initform
#+
(
or
clasp
ecl
mkcl
)
'lib-op
#-
(
or
clasp
ecl
mkcl
)
'compile-bundle-op
:allocation
:class
))
(
:documentation
"Create a single fasl for the system and its dependencies."
))
(
defclass
monolithic-load-bundle-op
(
monolithic-bundle-op
load-bundle-op
)
...
...
@@ -139,9 +142,9 @@ itself.")) ;; operation on a system and its dependencies
(
:documentation
"Create a single dynamic (.so/.dll) library for the system and its dependencies."
))
(
defclass
image-op
(
monolithic-bundle-op
selfward-operation
#+
(
or
ecl
mkcl
)
link-op
#+
(
or
ecl
mkcl
)
gather-op
)
#+
(
or
clasp
ecl
mkcl
)
link-op
#+
(
or
clasp
ecl
mkcl
)
gather-op
)
((
bundle-type
:initform
:image
)
(
selfward-operation
:initform
'
(
#-
(
or
ecl
mkcl
)
load-op
)
:allocation
:class
))
(
selfward-operation
:initform
'
(
#-
(
or
clasp
ecl
mkcl
)
load-op
)
:allocation
:class
))
(
:documentation
"create an image file from the system and its dependencies"
))
(
defclass
program-op
(
image-op
)
...
...
@@ -152,8 +155,8 @@ itself.")) ;; operation on a system and its dependencies
(
etypecase
bundle-type
((
eql
:no-output-file
)
nil
)
;; should we error out instead?
((
or
null
string
)
bundle-type
)
((
eql
:fasl
)
#-
(
or
ecl
mkcl
)
(
compile-file-type
)
#+
(
or
ecl
mkcl
)
"fasb"
)
#+
ecl
((
eql
:fasl
)
#-
(
or
clasp
ecl
mkcl
)
(
compile-file-type
)
#+
(
or
clasp
ecl
mkcl
)
"fasb"
)
#+
(
or
clasp
ecl
)
((
member
:dll
:lib
:shared-library
:static-library
:program
:object
:program
)
(
compile-file-type
:type
bundle-type
))
((
member
:image
)
#-
allegro
"image"
#+
allegro
"dxl"
)
...
...
@@ -175,7 +178,7 @@ itself.")) ;; operation on a system and its dependencies
(
defmethod
output-files
((
o
bundle-op
)
(
c
system
))
(
bundle-output-files
o
c
))
#-
(
or
ecl
mkcl
)
#-
(
or
clasp
ecl
mkcl
)
(
progn
(
defmethod
perform
((
o
image-op
)
(
c
system
))
(
dump-image
(
output-file
o
c
)
:executable
(
typep
o
'program-op
)))
...
...
@@ -183,7 +186,7 @@ itself.")) ;; operation on a system and its dependencies
(
setf
*image-entry-point*
(
ensure-function
(
component-entry-point
c
)))))
(
defclass
compiled-file
(
file-component
)
((
type
:initform
#-
(
or
ecl
mkcl
)
(
compile-file-type
)
#+
(
or
ecl
mkcl
)
"fasb"
)))
((
type
:initform
#-
(
or
clasp
ecl
mkcl
)
(
compile-file-type
)
#+
(
or
clasp
ecl
mkcl
)
"fasb"
)))
(
defclass
precompiled-system
(
system
)
((
build-pathname
:initarg
:fasl
)))
...
...
@@ -209,15 +212,16 @@ itself.")) ;; operation on a system and its dependencies
(
unless
name-suffix-p
(
setf
(
slot-value
instance
'name-suffix
)
(
unless
(
typep
instance
'program-op
)
(
if
(
operation-monolithic-p
instance
)
"--all-systems"
#-
(
or
ecl
mkcl
)
"--system"
))))
; . no good for Logical Pathnames
;; "." is no good separator for Logical Pathnames, so we use "--"
(
if
(
operation-monolithic-p
instance
)
"--all-systems"
#-
(
or
clasp
ecl
mkcl
)
"--system"
))))
(
when
(
typep
instance
'monolithic-bundle-op
)
(
destructuring-bind
(
&key
lisp-files
prologue-code
epilogue-code
&allow-other-keys
)
(
operation-original-initargs
instance
)
(
setf
(
prologue-code
instance
)
prologue-code
(
epilogue-code
instance
)
epilogue-code
)
#-
ecl
(
assert
(
null
(
or
lisp-files
#-
mkcl
epilogue-code
#-
mkcl
prologue-code
)))
#+
ecl
(
setf
(
extra-object-files
instance
)
lisp-files
)))
#-
(
or
clasp
ecl
)
(
assert
(
null
(
or
lisp-files
#-
mkcl
epilogue-code
#-
mkcl
prologue-code
)))
#+
(
or
clasp
ecl
)
(
setf
(
extra-object-files
instance
)
lisp-files
)))
(
setf
(
extra-build-args
instance
)
(
remove-plist-keys
'
(
:type
:monolithic
:name-suffix
:epilogue-code
:prologue-code
:lisp-files
...
...
@@ -227,8 +231,8 @@ itself.")) ;; operation on a system and its dependencies
(
defun
bundlable-file-p
(
pathname
)
(
let
((
type
(
pathname-type
pathname
)))
(
declare
(
ignorable
type
))
(
or
#+
ecl
(
or
(
equalp
type
(
compile-file-type
:type
:object
))
(
equalp
type
(
compile-file-type
:type
:static-library
)))
(
or
#+
(
or
clasp
ecl
)
(
or
(
equalp
type
(
compile-file-type
:type
:object
))
(
equalp
type
(
compile-file-type
:type
:static-library
)))
#+
mkcl
(
or
(
equalp
type
(
compile-file-type
:fasl-p
nil
))
#+
(
or
unix
mingw32
mingw64
)
(
equalp
type
"a"
)
;; valid on Unix and MinGW
#+
(
and
windows
(
not
(
or
mingw32
mingw64
)))
(
equalp
type
"lib"
))
...
...
@@ -427,7 +431,7 @@ itself.")) ;; operation on a system and its dependencies
s
)
(
terpri
s
)))))
#-
(
or
ecl
mkcl
)
#-
(
or
clasp
ecl
mkcl
)
(
defmethod
perform
((
o
basic-compile-bundle-op
)
(
c
system
))
(
let*
((
input-files
(
input-files
o
c
))
(
fasl-files
(
remove
(
compile-file-type
)
input-files
:key
#'
pathname-type
:test-not
#'
equalp
))
...
...
@@ -461,26 +465,29 @@ itself.")) ;; operation on a system and its dependencies
(asdf:load-system :precompiled-asdf-utils)
|#
#+
(
or
ecl
mkcl
)
#+
(
or
clasp
ecl
mkcl
)
(
with-upgradability
()
;; I think that Juanjo intended for this to be,
;; but beware the weird bug in test-xach-update-bug.script,
;; and also it makes mkcl fail test-logical-pathname.script,
;; and ecl fail test-bundle.script.
;;(unless (or #+ecl (use-ecl-byte-compiler-p))
;;(unless (or #+
(or clasp
ecl
)
(use-ecl-byte-compiler-p))
;; (setf *load-system-operation* 'load-bundle-op))
(
defun
uiop-library-pathname
()
#+
clasp
(
probe-file*
(
compile-file-pathname
"sys:uiop"
:output-type
:object
))
#+
ecl
(
or
(
probe-file*
(
compile-file-pathname
"sys:uiop"
:type
:lib
))
;; new style
(
probe-file*
(
compile-file-pathname
"sys:uiop"
:type
:object
)))
;; old style
#+
mkcl
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
:defaults
#p"sys:contrib;uiop"
))
(
defun
asdf-library-pathname
()
#+
clasp
(
probe-file*
(
compile-file-pathname
"sys:asdf"
:output-type
:object
))
#+
ecl
(
or
(
probe-file*
(
compile-file-pathname
"sys:asdf"
:type
:lib
))
;; new style
(
probe-file*
(
compile-file-pathname
"sys:asdf"
:type
:object
)))
;; old style
#+
mkcl
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
:defaults
#p"sys:contrib;asdf"
))
(
defun
compiler-library-pathname
()
#+
clasp
(
compile-file-pathname
"sys:cmp"
:output-type
:lib
)
#+
ecl
(
compile-file-pathname
"sys:cmp"
:type
:lib
)
#+
mkcl
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
:defaults
#p"sys:cmp"
))
...
...
@@ -525,7 +532,7 @@ itself.")) ;; operation on a system and its dependencies
(
when
programp
`
(
:entry-point
,
(
component-entry-point
c
))))))))
#+
(
and
(
not
asdf-use-unsafe-mac-bundle-op
)
(
or
(
and
ecl
darwin
)
(
or
(
and
clasp
ecl
darwin
)
(
and
abcl
darwin
(
not
abcl-bundle-op-supported
))))
(
defmethod
perform
:before
((
o
basic-compile-bundle-op
)
(
c
component
))
(
unless
(
featurep
:asdf-use-unsafe-mac-bundle-op
)
...
...
footer.lisp
View file @
2fceea52
...
...
@@ -8,27 +8,27 @@
(
in-package
:asdf/footer
)
;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
#+
(
or
abcl
clisp
clozure
cmu
ecl
mkcl
sbcl
)
#+
(
or
abcl
clasp
clisp
clozure
cmu
ecl
mkcl
sbcl
)
(
with-upgradability
()
(
if-let
(
x
(
and
#+
clisp
(
find-symbol*
'
#:*module-provider-functions*
:custom
nil
)))
(
eval
`
(
pushnew
'module-provide-asdf
#+
abcl
sys::*module-provider-functions*
#+
(
or
clasp
cmu
ecl
)
ext:*module-provider-functions*
#+
clisp
,
x
#+
clozure
ccl:*module-provider-functions*
#+
(
or
cmu
ecl
)
ext:*module-provider-functions*
#+
mkcl
mk-ext:*module-provider-functions*
#+
sbcl
sb-ext:*module-provider-functions*
)))
#+
(
or
ecl
mkcl
)
#+
(
or
clasp
ecl
mkcl
)
(
progn
(
pushnew
'
(
"fasb"
.
si::load-binary
)
si::*load-hooks*
:test
'equal
:key
'car
)
#+
(
or
(
and
ecl
win32
)
(
and
mkcl
windows
))
(
unless
(
assoc
"asd"
#+
ecl
ext:*load-hooks*
#+
mkcl
si::*load-hooks*
:test
'equal
)
(
appendf
#+
ecl
ext:*load-hooks*
#+
mkcl
si::*load-hooks*
'
((
"asd"
.
si::load-source
))))
#+
(
or
(
and
clasp
windows
)
(
and
ecl
win32
)
(
and
mkcl
windows
))
(
unless
(
assoc
"asd"
#+
(
or
clasp
ecl
)
ext:*load-hooks*
#+
mkcl
si::*load-hooks*
:test
'equal
)
(
appendf
#+
(
or
clasp
ecl
)
ext:*load-hooks*
#+
mkcl
si::*load-hooks*
'
((
"asd"
.
si::load-source
))))
(
setf
#+
ecl
ext:*module-provider-functions*
#+
mkcl
mk-ext::*module-provider-functions*
(
loop
:for
f
:in
#+
ecl
ext:*module-provider-functions*
(
setf
#+
(
or
clasp
ecl
)
ext:*module-provider-functions*
#+
mkcl
mk-ext::*module-provider-functions*
(
loop
:for
f
:in
#+
(
or
clasp
ecl
)
ext:*module-provider-functions*
#+
mkcl
mk-ext::*module-provider-functions*
:collect
(
if
(
eq
f
'module-provide-asdf
)
f
...
...
lisp-action.lisp
View file @
2fceea52
...
...
@@ -87,8 +87,8 @@
(
destructuring-bind
(
output-file
&optional
#+
(
or
clasp
ecl
mkcl
)
object-file
#+
clisp
lib-file
#+
(
or
ecl
mkcl
)
object-file
warnings-file
)
outputs
(
call-with-around-compile-hook
c
#'
(
lambda
(
&rest
flags
)
...
...
@@ -98,7 +98,7 @@
:warnings-file
warnings-file
(
append
#+
clisp
(
list
:lib-file
lib-file
)
#+
(
or
ecl
mkcl
)
(
list
:object-file
object-file
)
#+
(
or
clasp
ecl
mkcl
)
(
list
:object-file
object-file
)
flags
(
compile-op-flags
o
))))))
(
check-lisp-compile-results
output
warnings-p
failure-p
"~/asdf-action::format-action/"
(
list
(
cons
o
c
))))))
...
...
@@ -123,8 +123,12 @@
(
defun
lisp-compilation-output-files
(
o
c
)
(
let*
((
i
(
first
(
input-files
o
c
)))
(
f
(
compile-file-pathname
i
#+
mkcl
:fasl-p
#+
mkcl
t
#+
ecl
:type
#+
ecl
:fasl
)))
i
#+
clasp
:output-type
#+
ecl
:type
#+
(
or
clasp
ecl
)
:fasl
#+
mkcl
:fasl-p
#+
mkcl
t
)))
`
(
,
f
;; the fasl is the primary output, in first position
#+
clasp
,@
(
unless
nil
;; was (use-ecl-byte-compiler-p)
`
(
,
(
compile-file-pathname
i
:output-type
:object
)))
#+
clisp
,@`
(
,
(
make-pathname
:type
"lib"
:defaults
f
))
#+
ecl
...
...
output-translations.lisp
View file @
2fceea52
...
...
@@ -139,7 +139,7 @@ and the order is by decreasing length of namestring of the source pathname.")
`
(
:output-translations
;; Some implementations have precompiled ASDF systems,
;; so we must disable translations for implementation paths.
#+
(
or
#|clozure|#
ecl
mkcl
sbcl
)
#+
(
or
clasp
#|clozure|#
ecl
mkcl
sbcl
)
,@
(
let
((
h
(
resolve-symlinks*
(
lisp-implementation-directory
))))
(
when
h
`
(((
,
h
,
*wild-path*
)
()))))
#+
mkcl
(
,
(
translate-logical-pathname
"CONTRIB:"
)
())
...
...
source-registry.lisp
View file @
2fceea52
...
...
@@ -175,7 +175,7 @@ after having found a .asd file? True by default.")
(
defun
wrapping-source-registry
()
`
(
:source-registry
#+
(
or
ecl
sbcl
)
(
:tree
,
(
resolve-symlinks*
(
lisp-implementation-directory
)))
#+
(
or
clasp
ecl
sbcl
)
(
:tree
,
(
resolve-symlinks*
(
lisp-implementation-directory
)))
:inherit-configuration
#+
mkcl
(
:tree
,
(
translate-logical-pathname
"CONTRIB:"
))
#+
cmu
(
:tree
#p"modules:"
)
...
...
test/dll-test.lisp
View file @
2fceea52
(
defpackage
:test-asdf/dll-test
(
:use
))
;; dummy, for package-inferred-system dependencies.
#+
ecl
#+
(
and
ecl
(
not
clasp
))
(
ffi:clines
"
extern int sample_function();
...
...
@@ -10,6 +10,8 @@ int sample_function()
}
"
)
#+
clasp
(
leave-test
"Doesn't work on CLASP yet"
0
)
#+
mkcl
(
ffi:clines
"
extern MKCL_DLLEXPORT int sample_function(void);
...
...
test/make-hello-world.lisp
View file @
2fceea52
...
...
@@ -2,7 +2,7 @@
#+
lispworks
(
lispworks:load-all-patches
)
(
load
(
make-pathname
:name
"script-support"
:defaults
*load-pathname*
))
(
load-asdf
)
#+
(
or
ecl
mkcl
)
(
require
:cmp
)
#+
(
or
clasp
ecl
mkcl
)
(
require
:cmp
)
(
asdf-test::register-directory
asdf-test::*asdf-directory*
)
;; we need UIOP, and ECL can dump.
(
asdf-test::register-directory
asdf-test::*uiop-directory*
)
...
...
test/monodll-1.lisp
View file @
2fceea52
(
defpackage
:test-asdf/monodll-1
(
:use
))
;; dummy, for package-inferred-system dependencies.
#+
ecl
#+
(
and
ecl
(
not
clasp
))
(
ffi:clines
"
extern int always_7();
...
...
@@ -10,6 +10,8 @@ int always_7()
}
"
)
#+
clasp
(
leave-test
"Not supported by CLASP yet"
0
)
#+
mkcl
(
ffi:clines
"
extern MKCL_DLLEXPORT int always_7(void);
...
...
test/monodll.lisp
View file @
2fceea52
(
defpackage
:test-asdf/monodll
(
:use
:test-asdf/monodll-1
))
;; dummy, for package-inferred-system dependencies.
#+
ecl
#+
(
and
ecl
(
not
clasp
))
(
ffi:clines
"
extern int always_42();
...
...
@@ -10,6 +10,8 @@ int always_42()
}
"
)
#+
clasp
(
leave-test
"Not supported by CLASP yet"
0
)
#+
mkcl
(
ffi:clines
"
extern MKCL_DLLEXPORT int always_42(void);
...
...
test/run-tests.sh
View file @
2fceea52
...
...
@@ -229,6 +229,10 @@ case "$lisp" in
flags
=
"--no-init --quiet"
nodebug
=
"--batch"
eval
=
"--eval"
;;
clasp
)
command
=
"
${
CLASP
:-
clasp
}
"
flags
=
""
eval
=
""
;;
clisp
)
command
=
"
${
CLISP
:-
clisp
}
"
flags
=
"-norc --silent -ansi -I "
...
...
test/script-support.lisp
View file @
2fceea52
...
...
@@ -204,12 +204,12 @@ Some constraints:
(
:case-sensitive-lower
:mlisp
)
(
:case-insensitive-upper
:alisp
))
#+
armedbear
:abcl
#+
(
or
clasp
ecl
)
(
or
#+
ecl-bytecmp
:ecl_bytecodes
:ecl
)
#+
clisp
:clisp
#+
clozure
:ccl
#+
cmu
:cmucl
#+
corman
:cormanlisp
#+
digitool
:mcl
#+
ecl
(
or
#+
ecl-bytecmp
:ecl_bytecodes
:ecl
)
#+
gcl
:gcl
#+
lispworks
:lispworks
#+
mkcl
:mkcl
...
...
@@ -284,11 +284,11 @@ Some constraints:
(
finish-outputs*
)
#+
(
or
abcl
xcl
)
(
ext:quit
:status
code
)
#+
allegro
(
excl:exit
code
:quiet
t
)
#+
(
or
clasp
ecl
)
(
si:quit
code
)
#+
clisp
(
ext:quit
code
)
#+
clozure
(
ccl:quit
code
)
#+
cormanlisp
(
win32:exitprocess
code
)
#+
(
or
cmu
scl
)
(
unix:unix-exit
code
)
#+
ecl
(
si:quit
code
)
#+
gcl
(
system:quit
code
)
#+
genera
(
error
"You probably don't want to Halt the Machine. (code: ~S)"
code
)
#+
lispworks
(
lispworks:quit
:status
code
:confirm
nil
:return
nil
:ignore-errors-p
t
)
...
...
@@ -299,7 +299,7 @@ Some constraints:
(
cond
(
exit
`
(
,
exit
:code
code
:abort
t
))
(
quit*
`
(
,
quit*
:unix-status
code
:recklessly-p
t
))))
#-
(
or
abcl
allegro
clisp
clozure
cmu
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"~S called with exit code ~S but there's no quitting on this implementation"
'quit
code
))
...
...
@@ -386,15 +386,15 @@ is bound, write a message and exit on an error. If
(
defun
call-with-asdf-conditions
(
thunk
&optional
verbose
)
(
declare
(
ignorable
verbose
))
(
handler-bind
(
#+
sbcl
((
or
sb-c::simple-compiler-note
sb-kernel:redefinition-warning
)
#'
muffle-warning
)
#+
(
and
ecl
(
not
ecl-bytecmp
))
(
handler-bind
(
#+
(
and
ecl
(
not
ecl-bytecmp
))
((
or
c::compiler-note
c::compiler-debug-note
c::compiler-warning
)
;; ECL emits more serious warnings than it should.
#'
muffle-warning
)
#+
mkcl
((
or
compiler:compiler-note
)
#'
muffle-warning
)
#+
sbcl
((
or
sb-c::simple-compiler-note
sb-kernel:redefinition-warning
)
#'
muffle-warning
)
#-
(
or
cmu
scl
)
;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
(
style-warning
...
...
@@ -436,7 +436,7 @@ is bound, write a message and exit on an error. If
;; CMUCL: ?
;; ECL 11.1.1 has spurious warnings, same with XCL 0.0.0.291.
;; SCL has no warning but still raises the warningp flag since 2.20.15 (?)
#+
(
or
clisp
cmu
ecl
scl
xcl
)
(
good
:expected-style-warnings
)
#+
(
or
clasp
clisp
cmu
ecl
scl
xcl
)
(
good
:expected-style-warnings
)
(
and
upgradep
(
good
:unexpected-style-warnings
))
(
bad
:unexpected-style-warnings
)))
(
t
(
good
:success
)))))))
...
...
test/test-compile-file-failure.lisp
View file @
2fceea52
...
...
@@ -6,6 +6,6 @@
;; Work around:
#+
(
and
ecl
ecl-bytecmp
)
(
when
(
and
(
eq
asdf:*compile-file-failure-behaviour*
:error
)
#+
ecl
(
equal
(
compile-file-type
)
"fasc"
))
#+
(
or
clasp
ecl
)
(
equal
(
compile-file-type
)
"fasc"
))
(
error
'compile-file-error
:description
"faking it"
))
(
warn
"Warning."
))
tools/install-asdf.lisp
View file @
2fceea52
...
...
@@ -54,16 +54,16 @@ It notably doesn't work on:
(
defun
module-directory
()
#+
allegro
#p"sys:code;"
#+
(
or
clasp
ecl
mkcl
)
#p"sys:"
#+
clisp
(
subpathname
custom:*lib-directory*
"asdf/"
)
#+
clozure
#p"ccl:tools;"
#+
cmu
#p"modules:asdf/"
#+
(
or
ecl
mkcl
)
#p"sys:"
#+
gcl
(
subpathname
system:*system-directory*
"../modules/"
)
#+
lispworks
(
system:lispworks-dir
"load-on-demand/utilities/"
)
#+
sbcl
(
subpathname
(
sb-int:sbcl-homedir-pathname
)
"contrib/"
)
#+
scl
#p"file://modules/"
#+
xcl
ext:*xcl-home*
#-
(
or
allegro
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
#-
(
or
allegro
clasp
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"module-directory not implemented on ~A"
(
implementation-type
)))
(
defun
module-fasl
(
name
)
...
...
@@ -76,17 +76,17 @@ It notably doesn't work on:
(
t
-1
)))))
(
first
(
sort
(
directory
(
merge-pathnames*
(
strcat
name
".*"
)
(
module-directory
)))
#'
>
:key
#'
pathname-key
)))
#+
(
or
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
#+
(
or
clasp
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
(
compile-file-pathname
(
subpathname
(
truename
(
module-directory
))
name
:type
"lisp"
))
#-
(
or
allegro
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
#-
(
or
allegro
clasp
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"Not implemented on ~A"
(
implementation-type
)))
(
defun
uiop-module-fasl
()
(
module-fasl
"uiop"
))
(
defun
asdf-module-fasl
()
(
module-fasl
"asdf"
))
(
defun
object-file
(
name
&optional
(
type
:object
))
#-
(
or
ecl
mkcl
)
(
progn
name
type
(
assert
nil
))
#+
ecl
(
compile-file-pathname
name
:type
type
)
#-
(
or
clasp
ecl
mkcl
)
(
progn
name
type
(
assert
nil
))
#+
(
or
clasp
ecl
)
(
compile-file-pathname
name
:type
type
)
#+
mkcl
(
make-pathname
:defaults
name
:type
(
bundle-pathname-type
type
)))
(
defun
call-with-file-replacement
(
file
thunk
)
...
...
@@ -105,14 +105,14 @@ It notably doesn't work on:
(
nest
(
let*
((
asdf.lisp
(
system-relative-pathname
:uiop
"../build/asdf.lisp"
))
(
asdf.fasl
(
asdf-module-fasl
))
#+
(
or
ecl
mkcl
)
(
asdf.o
(
object-file
asdf.fasl
:object
))
#+
(
or
ecl
mkcl
)
(
asdf.a
(
object-file
asdf.fasl
:lib
))))
#+
(
or
clasp
ecl
mkcl
)
(
asdf.o
(
object-file
asdf.fasl
:object
))
#+
(
or
clasp
ecl
mkcl
)
(
asdf.a
(
object-file
asdf.fasl
:lib
))))
(
with-file-replacement
(
asdf.fasl
))
#+
(
or
ecl
mkcl
)
(
with-file-replacement
(
asdf.o
))
#+
(
or
ecl
mkcl
)
(
with-file-replacement
(
asdf.a
))
#+
(
or
clasp
ecl
mkcl
)
(
with-file-replacement
(
asdf.o
))
#+
(
or
clasp
ecl
mkcl
)
(
with-file-replacement
(
asdf.a
))
(
progn
(
compile-file*
asdf.lisp
:output-file
asdf.fasl
#+
(
or
ecl
mkcl
)
:object-file
#+
(
or
ecl
mkcl
)
asdf.o
)
#+
(
or
clasp
ecl
mkcl
)
:object-file
#+
(
or
clasp
ecl
mkcl
)
asdf.o
)
#+
(
or
ecl
mkcl
)
(
create-image
asdf.a
(
list
asdf.o
)
:kind
:lib
))))
...
...
@@ -122,7 +122,7 @@ It notably doesn't work on:
(
operate
'compile-bundle-op
"uiop"
)
(
rename-file-overwriting-target
(
first
(
output-files
'compile-bundle-op
"uiop"
))
uiop.fasl
)
(
load
uiop.fasl
))
#+
(
or
ecl
mkcl
)
#+
(
or
clasp
ecl
mkcl
)
(
let
((
uiop.a
(
object-file
asdf.fasl
:lib
)))
(
with-file-replacement
(
uiop.a
)
(
operate
'lib-op
"uiop"
)
...
...
@@ -130,12 +130,12 @@ It notably doesn't work on:
(
nest
(
let*
((
asdf.fasl
(
asdf-module-fasl
))
(
asdf.lisp
(
make-pathname
:type
"lisp"
:defaults
asdf.fasl
))
#+
(
or
ecl
mkcl
)
(
asdf.o
(
object-file
asdf.fasl
:object
))
#+
(
or
ecl
mkcl
)
(
asdf.a
(
object-file
asdf.fasl
:lib
))))
#+
(
or
clasp
ecl
mkcl
)
(
asdf.o
(
object-file
asdf.fasl
:object
))
#+
(
or
clasp
ecl
mkcl
)
(
asdf.a
(
object-file
asdf.fasl
:lib
))))
(
with-file-replacement
(
asdf.lisp
))
(
with-file-replacement
(
asdf.fasl
))
#+
(
or
ecl
mkcl
)
(
with-file-replacement
(
asdf.o
))
#+
(
or
ecl
mkcl
)
(
with-file-replacement
(
asdf.a
))
#+
(
or
clasp
ecl
mkcl
)
(
with-file-replacement
(
asdf.o
))
#+
(
or
clasp
ecl
mkcl
)
(
with-file-replacement
(
asdf.a
))
(
progn
(
with-output-file
(
o
asdf.lisp
:if-exists
:rename-and-delete
:if-does-not-exist
:create
)
(
println
"(cl:require \"uiop\")"
o
)
...
...
@@ -143,13 +143,13 @@ It notably doesn't work on:
(
with-input-file
(
i
(
component-pathname
c
))
(
copy-stream-to-stream
i
o
))))
(
compile-file*
asdf.lisp
:output-file
asdf.fasl
#+
(
or
ecl
mkcl
)
:object-file
#+
(
or
ecl
mkcl
)
asdf.o
)
#+
(
or
ecl
mkcl
)
#+
(
or
clasp
ecl
mkcl
)
:object-file
#+
(
or
clasp
ecl
mkcl
)
asdf.o
)
#+
(
or
clasp
ecl
mkcl
)
(
create-image
asdf.a
(
list
asdf.o
)
:kind
:lib
)))))
#+
(
or
sbcl
mkcl
)
(
progn
(
install-uiop-and-asdf-as-modules
)
(
quit
))
#+
(
or
allegro
clisp
clozure
cmu
ecl
gcl
lispworks
scl
xcl
)
#+
(
or
allegro
clasp
clisp
clozure
cmu
ecl
gcl
lispworks
scl
xcl
)
(
progn
(
install-asdf-as-module
)
(
quit
))
#+
(
or
abcl
cormanlisp
genera
mcl
mocl
)
(
die
2
"Not supported on ~A"
(
implementation-type
))
...
...
uiop/backward-driver.lisp
View file @
2fceea52
...
...
@@ -10,7 +10,7 @@
:uiop/configuration
)
(
:export
#:coerce-pathname
#:component-name-to-pathname-components
#+
(
or
ecl
mkcl
)
#:compile-file-keeping-object
#+
(
or
clasp
ecl
mkcl
)
#:compile-file-keeping-object
))
(
in-package
:uiop/backward-driver
)
...
...
@@ -37,5 +37,5 @@
unix-style-namestring
))
(
values
relabs
path
filename
)))
#+
(
or
ecl
mkcl
)
#+
(
or
clasp
ecl
mkcl
)
(
defun
compile-file-keeping-object
(
&rest
args
)
(
apply
#'
compile-file*
args
)))
uiop/common-lisp.lisp
View file @
2fceea52
...
...
@@ -22,7 +22,7 @@
#+
mcl
(
:shadow
#:user-homedir-pathname
))
(
in-package
:uiop/common-lisp
)
#-
(
or
abcl
allegro
clisp
clozure
cmu
cormanlisp
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cormanlisp
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"ASDF is not supported on your implementation. Please help us port it."
)
;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults.
...
...
@@ -30,12 +30,12 @@
;;;; Early meta-level tweaks
#+
(
or
abcl
allegro
clisp
cmu
ecl
mkcl
clozure
lispworks
mkcl
sbcl
scl
)
#+
(
or
abcl
allegro
clasp
clisp
cmu
ecl
mkcl
clozure
lispworks
mkcl
sbcl
scl
)
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode
;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie.
(
when
(
and
#+
allegro
(
member
:ics
*features*
)
#+
(
or
clisp
cmu
ecl
mkcl
)
(
member
:unicode
*features*
)
#+
(
or
clasp
clisp
cmu
ecl
mkcl
)
(
member
:unicode
*features*
)
#+
sbcl
(
member
:sb-unicode
*features*
))
(
pushnew
:asdf-unicode
*features*
)))
...
...
@@ -48,6 +48,11 @@
(
setf
excl:*warn-on-nested-reader-conditionals*
nil
))
(
setf
*print-readably*
nil
))
#+
clasp
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
setf
*load-verbose*
nil
)
(
defun
use-ecl-byte-compiler-p
()
nil
))
#+
clozure
(
in-package
:ccl
)
#+
(
and
clozure
windows-target
)
;; See http://trac.clozure.com/ccl/ticket/1117
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
...
...
@@ -61,7 +66,6 @@
(
external-process-%status
proc
))))))
#+
clozure
(
in-package
:uiop/common-lisp
)
#+
cormanlisp
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
deftype
logical-pathname
()
nil
)
...
...
@@ -74,7 +78,7 @@
(
setf
p
(
pathname
p
))
(
format
nil
"~@[~A~]~@[.~A~]"
(
pathname-name
p
)
(
pathname-type
p
))))
#+
ecl
#+
(
and
ecl
(
not
clasp
))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
setf
*load-verbose*
nil
)