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
Eric Timmons
asdf
Commits
3af29fa0
Commit
3af29fa0
authored
Nov 18, 2015
by
Francois-Rene Rideau
Browse files
Use #+cmucl instead of #+cmu
It's been the official way of calling CMUCL since 2011.
parent
3a9457a8
Changes
11
Hide whitespace changes
Inline
Side-by-side
component.lisp
View file @
3af29fa0
...
...
@@ -74,7 +74,7 @@ another pathname in a degenerate way."))
;; condition objects, which in turn does inheritance of :report options at
;; run-time. fortunately, inheritance means we only need this kludge here in
;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.]
#+
cmu
(
:report
print-object
))
#+
cmu
cl
(
:report
print-object
))
(
define-condition
duplicate-names
(
system-definition-error
)
((
name
:initarg
:name
:reader
duplicate-names-name
))
...
...
footer.lisp
View file @
3af29fa0
...
...
@@ -8,12 +8,12 @@
(
in-package
:asdf/footer
)
;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
#+
(
or
abcl
clasp
clisp
clozure
cmu
ecl
mkcl
sbcl
)
#+
(
or
abcl
clasp
clisp
clozure
cmu
cl
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*
#+
(
or
clasp
cmu
cl
ecl
)
ext:*module-provider-functions*
#+
clisp
,
x
#+
clozure
ccl:*module-provider-functions*
#+
mkcl
mk-ext:*module-provider-functions*
...
...
@@ -37,7 +37,7 @@
(
and
(
first
l
)
(
register-preloaded-system
(
coerce-name
name
)))
(
values-list
l
))))))))
#+
cmu
;; Hook into the CMUCL herald.
#+
cmu
cl
;; Hook into the CMUCL herald.
(
with-upgradability
()
(
defun
herald-asdf
(
stream
)
(
format
stream
" ASDF ~A"
(
asdf-version
)))
...
...
source-registry.lisp
View file @
3af29fa0
...
...
@@ -180,7 +180,7 @@ after having found a .asd file? True by default.")
#+
(
or
clasp
ecl
sbcl
)
(
:tree
,
(
resolve-symlinks*
(
lisp-implementation-directory
)))
:inherit-configuration
#+
mkcl
(
:tree
,
(
translate-logical-pathname
"CONTRIB:"
))
#+
cmu
(
:tree
#p"modules:"
)
#+
cmu
cl
(
:tree
#p"modules:"
)
#+
scl
(
:tree
#p"file://modules/"
)))
(
defun
default-user-source-registry
()
`
(
:source-registry
...
...
uiop/common-lisp.lisp
View file @
3af29fa0
...
...
@@ -22,7 +22,7 @@
#+
mcl
(
:shadow
#:user-homedir-pathname
))
(
in-package
:uiop/common-lisp
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cormanlisp
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
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,13 +30,13 @@
;;;; Early meta-level tweaks
#+
(
or
abcl
allegro
clasp
clisp
cmu
ecl
mkcl
clozure
lispworks
mkcl
sbcl
scl
)
#+
(
or
allegro
clasp
clisp
cmu
cl
ecl
mkcl
mkcl
sbcl
)
(
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
clasp
clisp
cmu
ecl
mkcl
)
(
member
:unicode
*features*
)
#+
(
or
clasp
clisp
cmu
cl
ecl
mkcl
)
(
member
:unicode
*features*
)
#+
sbcl
(
member
:sb-unicode
*features*
))
;; 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.
(
pushnew
:asdf-unicode
*features*
)))
#+
allegro
...
...
uiop/filesystem.lisp
View file @
3af29fa0
...
...
@@ -34,9 +34,9 @@
(
when
x
(
let
((
p
(
pathname
x
)))
#+
clozure
(
with-pathname-defaults
()
(
ccl:native-translated-namestring
p
))
; see ccl bug 978
#+
(
or
cmu
scl
)
(
ext:unix-namestring
p
nil
)
#+
(
or
cmu
cl
scl
)
(
ext:unix-namestring
p
nil
)
#+
sbcl
(
sb-ext:native-namestring
p
)
#-
(
or
clozure
cmu
sbcl
scl
)
#-
(
or
clozure
cmu
cl
sbcl
scl
)
(
os-cond
((
os-unix-p
)
(
unix-namestring
p
))
(
t
(
namestring
p
))))))
...
...
@@ -135,10 +135,10 @@ or the original (parsed) pathname if it is false (the default)."
(
if
truename
(
probe-file
p
)
(
and
#+
(
or
cmu
scl
)
(
unix:unix-stat
(
ext:unix-namestring
p
))
#+
(
or
cmu
cl
scl
)
(
unix:unix-stat
(
ext:unix-namestring
p
))
#+
(
and
lispworks
unix
)
(
system:get-file-stat
p
)
#+
sbcl
(
sb-unix:unix-stat
(
sb-ext:native-namestring
p
))
#-
(
or
cmu
(
and
lispworks
unix
)
sbcl
scl
)
(
file-write-date
p
)
#-
(
or
cmu
cl
(
and
lispworks
unix
)
sbcl
scl
)
(
file-write-date
p
)
p
))))))
(
defun
directory-exists-p
(
x
)
...
...
@@ -165,7 +165,7 @@ Try to override the defaults to not resolving symlinks, if implementation allows
(
append
keys
'#.
(
or
#+
allegro
'
(
:directories-are-files
nil
:follow-symbolic-links
nil
)
#+
(
or
clozure
digitool
)
'
(
:follow-links
nil
)
#+
clisp
'
(
:circle
t
:if-does-not-exist
:ignore
)
#+
(
or
cmu
scl
)
'
(
:follow-links
nil
:truenamep
nil
)
#+
(
or
cmu
cl
scl
)
'
(
:follow-links
nil
:truenamep
nil
)
#+
lispworks
'
(
:link-transparency
nil
)
#+
sbcl
(
when
(
find-symbol*
:resolve-symlinks
'
#:sb-impl
nil
)
'
(
:resolve-symlinks
nil
))))))
...
...
@@ -231,9 +231,9 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s
(
let*
((
directory
(
ensure-directory-pathname
directory
))
#-
(
or
abcl
cormanlisp
genera
xcl
)
(
wild
(
merge-pathnames*
#-
(
or
abcl
allegro
cmu
lispworks
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
cmu
cl
lispworks
sbcl
scl
xcl
)
*wild-directory*
#+
(
or
abcl
allegro
cmu
lispworks
sbcl
scl
xcl
)
"*.*"
#+
(
or
abcl
allegro
cmu
cl
lispworks
sbcl
scl
xcl
)
"*.*"
directory
))
(
dirs
#-
(
or
abcl
cormanlisp
genera
xcl
)
...
...
@@ -243,16 +243,16 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s
#+
(
or
abcl
xcl
)
(
system:list-directory
directory
)
#+
cormanlisp
(
cl::directory-subdirs
directory
)
#+
genera
(
fs:directory-list
directory
))
#+
(
or
abcl
allegro
cmu
genera
lispworks
sbcl
scl
xcl
)
#+
(
or
abcl
allegro
cmu
cl
genera
lispworks
sbcl
scl
xcl
)
(
dirs
(
loop
:for
x
:in
dirs
:for
d
=
#+
(
or
abcl
xcl
)
(
extensions:probe-directory
x
)
#+
allegro
(
excl:probe-directory
x
)
#+
(
or
cmu
sbcl
scl
)
(
directory-pathname-p
x
)
#+
(
or
cmu
cl
sbcl
scl
)
(
directory-pathname-p
x
)
#+
genera
(
getf
(
cdr
x
)
:directory
)
#+
lispworks
(
lw:file-directory-p
x
)
:when
d
:collect
#+
(
or
abcl
allegro
xcl
)
d
#+
genera
(
ensure-directory-pathname
(
first
x
))
#+
(
or
cmu
lispworks
sbcl
scl
)
x
)))
#+
(
or
cmu
cl
lispworks
sbcl
scl
)
x
)))
(
filter-logical-directory-results
directory
dirs
(
let
((
prefix
(
or
(
normalize-pathname-directory-component
(
pathname-directory
directory
))
...
...
@@ -549,7 +549,7 @@ NILs."
#+
(
or
allegro
clasp
ecl
mkcl
)
#p"SYS:"
;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!)
#+
clozure
#p"ccl:"
#+
cmu
(
ignore-errors
(
pathname-parent-directory-pathname
(
truename
#p"modules:"
)))
#+
cmu
cl
(
ignore-errors
(
pathname-parent-directory-pathname
(
truename
#p"modules:"
)))
#+
gcl
system::*system-directory*
#+
lispworks
lispworks:*lispworks-directory*
#+
sbcl
(
if-let
(
it
(
find-symbol*
:sbcl-homedir-pathname
:sb-int
nil
))
...
...
@@ -603,10 +603,10 @@ in an atomic way if the implementation allows."
#+
allegro
(
excl:delete-directory
directory-pathname
)
#+
clisp
(
ext:delete-directory
directory-pathname
)
#+
clozure
(
ccl::delete-empty-directory
directory-pathname
)
#+
(
or
cmu
scl
)
(
multiple-value-bind
(
ok
errno
)
#+
(
or
cmu
cl
scl
)
(
multiple-value-bind
(
ok
errno
)
(
unix:unix-rmdir
(
native-namestring
directory-pathname
))
(
unless
ok
#+
cmu
(
error
"Error number ~A when trying to delete directory ~A"
#+
cmu
cl
(
error
"Error number ~A when trying to delete directory ~A"
errno
directory-pathname
)
#+
scl
(
error
"~@<Error deleting ~S: ~A~@:>"
directory-pathname
(
unix:get-unix-error-msg
errno
))))
...
...
@@ -619,7 +619,7 @@ in an atomic way if the implementation allows."
`
(
,
dd
directory-pathname
)
;; requires SBCL 1.0.44 or later
`
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:rmdir
directory-pathname
)))
#+
xcl
(
symbol-call
:uiop
:run-program
`
(
"rmdir"
,
(
native-namestring
directory-pathname
)))
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cormanlisp
digitool
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
cormanlisp
digitool
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"~S not implemented on ~S"
'delete-empty-directory
(
implementation-type
)))
; genera
(
defun
delete-directory-tree
(
directory-pathname
&key
(
validate
nil
validatep
)
(
if-does-not-exist
:error
))
...
...
@@ -653,7 +653,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
(
error
"~S was asked to delete ~S but the directory does not exist"
'delete-directory-tree
directory-pathname
))
(
:ignore
nil
)))
#-
(
or
allegro
cmu
clozure
genera
sbcl
scl
)
#-
(
or
allegro
cmu
cl
clozure
genera
sbcl
scl
)
((
os-unix-p
)
;; On Unix, don't recursively walk the directory and delete everything in Lisp,
;; except on implementations where we can prevent DIRECTORY from following symlinks;
;; instead spawn a standard external program to do the dirty work.
...
...
uiop/image.lisp
View file @
3af29fa0
...
...
@@ -69,7 +69,7 @@ This is designed to abstract away the implementation specific quit forms."
#+
clisp
(
ext:quit
code
)
#+
clozure
(
ccl:quit
code
)
#+
cormanlisp
(
win32:exitprocess
code
)
#+
(
or
cmu
scl
)
(
unix:unix-exit
code
)
#+
(
or
cmu
cl
scl
)
(
unix:unix-exit
code
)
#+
gcl
(
system:quit
code
)
#+
genera
(
error
"~S: You probably don't want to Halt Genera. (code: ~S)"
'quit
code
)
#+
lispworks
(
lispworks:quit
:status
code
:confirm
nil
:return
nil
:ignore-errors-p
t
)
...
...
@@ -80,7 +80,7 @@ This is designed to abstract away the implementation specific quit forms."
(
cond
(
exit
`
(
,
exit
:code
code
:abort
(
not
finish-output
)))
(
quit
`
(
,
quit
:unix-status
code
:recklessly-p
(
not
finish-output
)))))
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
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
))
(
defun
die
(
code
format
&rest
arguments
)
...
...
@@ -123,7 +123,7 @@ This is designed to abstract away the implementation specific quit forms."
#+
clozure
(
ccl:print-call-history
:count
count
:start-frame-number
1
)
#+
mcl
(
ccl:print-call-history
:detailed-p
nil
)
(
finish-output
stream
))
#+
(
or
cmu
scl
)
#+
(
or
cmu
cl
scl
)
(
let
((
debug:*debug-print-level*
*print-level*
)
(
debug:*debug-print-length*
*print-length*
))
(
debug:backtrace
(
or
count
most-positive-fixnum
)
stream
))
...
...
@@ -227,14 +227,14 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+
(
or
clasp
ecl
)
(
loop
:for
i
:from
0
:below
(
si:argc
)
:collect
(
si:argv
i
))
#+
clisp
(
coerce
(
ext:argv
)
'list
)
#+
clozure
ccl:*command-line-argument-list*
#+
(
or
cmu
scl
)
extensions:*command-line-strings*
#+
(
or
cmu
cl
scl
)
extensions:*command-line-strings*
#+
gcl
si:*command-args*
#+
(
or
genera
mcl
)
nil
#+
lispworks
sys:*line-arguments-list*
#+
mkcl
(
loop
:for
i
:from
0
:below
(
mkcl:argc
)
:collect
(
mkcl:argv
i
))
#+
sbcl
sb-ext:*posix-argv*
#+
xcl
system:*argv*
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"raw-command-line-arguments not implemented yet"
))
(
defun
command-line-arguments
(
&optional
(
arguments
(
raw-command-line-arguments
)))
...
...
@@ -263,7 +263,7 @@ Otherwise, return NIL."
(
cond
((
eq
*image-dumped-p*
:executable
)
; yes, this ARGV0 is our argv0 !
;; NB: not currently available on ABCL, Corman, Genera, MCL
(
or
#+
(
or
allegro
clisp
clozure
cmu
gcl
lispworks
sbcl
scl
xcl
)
(
or
#+
(
or
allegro
clisp
clozure
cmu
cl
gcl
lispworks
sbcl
scl
xcl
)
(
first
(
raw-command-line-arguments
))
#+
(
or
clasp
ecl
)
(
si:argv
0
)
#+
mkcl
(
mkcl:argv
0
)))
(
t
;; argv[0] is the name of the interpreter.
...
...
@@ -353,7 +353,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(
setf
*image-dump-hook*
dump-hook
)
(
call-image-dump-hook
)
(
setf
*image-restored-p*
nil
)
#-
(
or
clisp
clozure
cmu
lispworks
sbcl
scl
)
#-
(
or
clisp
clozure
cmu
cl
lispworks
sbcl
scl
)
(
when
executable
(
error
"Dumping an executable is not supported on this implementation! Aborting."
))
#+
allegro
...
...
@@ -381,13 +381,13 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(
funcall
(
fdefinition
'ccl::write-elf-symbols-to-file
)
path
)
(
dump
path
))
(
dump
t
)))
#+
(
or
cmu
scl
)
#+
(
or
cmu
cl
scl
)
(
progn
(
ext:gc
:full
t
)
(
setf
ext:*batch-mode*
nil
)
(
setf
ext::*gc-run-time*
0
)
(
apply
'ext:save-lisp
filename
#+
cmu
:executable
#+
cmu
t
#+
cmu
cl
:executable
#+
cmu
cl
t
(
when
executable
'
(
:init-function
restore-image
:process-command-line
nil
))))
#+
gcl
(
progn
...
...
@@ -410,7 +410,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
#+
(
and
sbcl
os-windows
)
;; passing :application-type :gui will disable the console window.
;; the default is :console - only works with SBCL 1.1.15 or later.
(
when
application-type
(
list
:application-type
application-type
)))))
#-
(
or
allegro
clisp
clozure
cmu
gcl
lispworks
sbcl
scl
)
#-
(
or
allegro
clisp
clozure
cmu
cl
gcl
lispworks
sbcl
scl
)
(
error
"Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
'dump-image
filename
(
nth-value
1
(
implementation-type
))))
...
...
uiop/lisp-build.lisp
View file @
3af29fa0
...
...
@@ -66,7 +66,7 @@ This can help you produce more deterministic output for FASLs."))
#+
clisp
'
()
;; system::*optimize* is a constant hash-table! (with non-constant contents)
#+
clozure
'
(
ccl::*nx-speed*
ccl::*nx-space*
ccl::*nx-safety*
ccl::*nx-debug*
ccl::*nx-cspeed*
)
#+
(
or
cmu
scl
)
'
(
c::*default-cookie*
)
#+
(
or
cmu
cl
scl
)
'
(
c::*default-cookie*
)
#+
(
and
ecl
(
not
clasp
))
(
unless
(
use-ecl-byte-compiler-p
)
'
(
c::*speed*
c::*space*
c::*safety*
c::*debug*
))
#+
clasp
'
()
#+
gcl
'
(
compiler::*speed*
compiler::*space*
compiler::*compiler-new-safety*
compiler::*debug*
)
...
...
@@ -75,11 +75,11 @@ This can help you produce more deterministic output for FASLs."))
#+
sbcl
'
(
sb-c::*policy*
)))
(
defun
get-optimization-settings
()
"Get current compiler optimization settings, ready to PROCLAIM again"
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
ecl
lispworks
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
ecl
lispworks
mkcl
sbcl
scl
xcl
)
(
warn
"~S does not support ~S. Please help me fix that."
'get-optimization-settings
(
implementation-type
))
#+
(
or
abcl
allegro
clasp
clisp
clozure
cmu
ecl
lispworks
mkcl
sbcl
scl
xcl
)
(
let
((
settings
'
(
speed
space
safety
debug
compilation-speed
#+
(
or
cmu
scl
)
c::brevity
)))
#+
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
ecl
lispworks
mkcl
sbcl
scl
xcl
)
(
let
((
settings
'
(
speed
space
safety
debug
compilation-speed
#+
(
or
cmu
cl
scl
)
c::brevity
)))
#.`
(
loop
#+
(
or
allegro
clozure
)
,@'
(
:with
info
=
#+
allegro
(
sys:declaration-information
'optimize
)
#+
clozure
(
ccl:declaration-information
'optimize
nil
))
...
...
@@ -88,7 +88,7 @@ This can help you produce more deterministic output for FASLs."))
:for
y
=
(
or
#+
(
or
allegro
clozure
)
(
second
(
assoc
x
info
))
; normalize order
#+
clisp
(
gethash
x
system::*optimize*
1
)
#+
(
or
abcl
clasp
ecl
mkcl
xcl
)
(
symbol-value
v
)
#+
(
or
cmu
scl
)
(
slot-value
c::*default-cookie*
#+
(
or
cmu
cl
scl
)
(
slot-value
c::*default-cookie*
(
case
x
(
compilation-speed
'c::cspeed
)
(
otherwise
x
)))
#+
lispworks
(
slot-value
compiler::*optimization-level*
x
)
...
...
@@ -130,7 +130,7 @@ This can help you produce more deterministic output for FASLs."))
(
defvar
*usual-uninteresting-conditions*
(
append
;;#+clozure '(ccl:compiler-warning)
#+
cmu
'
(
"Deleting unreachable code."
)
#+
cmu
cl
'
(
"Deleting unreachable code."
)
#+
lispworks
'
(
"~S being redefined in ~A (previously in ~A)."
"~S defined more than once in ~A."
)
;; lispworks gets confused by eval-when.
#+
sbcl
...
...
@@ -315,7 +315,7 @@ Simple means made of symbols, numbers, characters, simple-strings, pathnames, co
:warning-type
warning-type
:args
(
destructuring-bind
(
fun
.
more
)
args
(
cons
(
symbolify-function-name
fun
)
more
))))))
#+
(
or
cmu
scl
)
#+
(
or
cmu
cl
scl
)
(
defun
reify-undefined-warning
(
warning
)
;; Extracting undefined-warnings from the compilation-unit
;; To be passed through the above reify/unreify link, it must be a "simple-sexp"
...
...
@@ -367,7 +367,7 @@ WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings sup
(
if-let
(
dw
ccl::*outstanding-deferred-warnings*
)
(
let
((
mdw
(
ccl::ensure-merged-deferred-warnings
dw
)))
(
ccl::deferred-warnings.warnings
mdw
))))
#+
(
or
cmu
scl
)
#+
(
or
cmu
cl
scl
)
(
when
lisp::*in-compilation-unit*
;; Try to send nothing through the pipe if nothing needs to be accumulated
`
(
,@
(
when
c::*undefined-warnings*
...
...
@@ -413,7 +413,7 @@ One of three functions required for deferred-warnings support in ASDF."
(
setf
ccl::*outstanding-deferred-warnings*
(
ccl::%defer-warnings
t
)))))
(
appendf
(
ccl::deferred-warnings.warnings
dw
)
(
mapcar
'unreify-deferred-warning
reified-deferred-warnings
)))
#+
(
or
cmu
scl
)
#+
(
or
cmu
cl
scl
)
(
dolist
(
item
reified-deferred-warnings
)
;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
;; For *undefined-warnings*, the adjustment is a list of initargs.
...
...
@@ -476,7 +476,7 @@ One of three functions required for deferred-warnings support in ASDF."
(
if-let
(
dw
ccl::*outstanding-deferred-warnings*
)
(
let
((
mdw
(
ccl::ensure-merged-deferred-warnings
dw
)))
(
setf
(
ccl::deferred-warnings.warnings
mdw
)
nil
)))
#+
(
or
cmu
scl
)
#+
(
or
cmu
cl
scl
)
(
when
lisp::*in-compilation-unit*
(
setf
c::*undefined-warnings*
nil
c::*compiler-error-count*
0
...
...
uiop/os.lisp
View file @
3af29fa0
...
...
@@ -87,7 +87,7 @@ use getenvp to return NIL in such a case."
#+
(
or
abcl
clasp
clisp
ecl
xcl
)
(
ext:getenv
x
)
#+
allegro
(
sys:getenv
x
)
#+
clozure
(
ccl:getenv
x
)
#+
cmu
(
unix:unix-getenv
x
)
#+
cmu
cl
(
unix:unix-getenv
x
)
#+
scl
(
cdr
(
assoc
x
ext:*environment-list*
:test
#'
string=
))
#+
cormanlisp
(
let*
((
buffer
(
ct:malloc
1
))
...
...
@@ -108,7 +108,7 @@ use getenvp to return NIL in such a case."
(
ccl:%get-cstring
value
))))
#+
mkcl
(
#.
(
or
(
find-symbol*
'getenv
:si
nil
)
(
find-symbol*
'getenv
:mk-ext
nil
))
x
)
#+
sbcl
(
sb-ext:posix-getenv
x
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cormanlisp
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
cormanlisp
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"~S is not supported on your implementation"
'getenv
))
(
defsetf
getenv
(
x
)
(
val
)
...
...
@@ -117,12 +117,12 @@ use getenvp to return NIL in such a case."
#+
allegro
`
(
setf
(
sys:getenv
,
x
)
,
val
)
#+
clisp
`
(
system::setenv
,
x
,
val
)
#+
clozure
`
(
ccl:setenv
,
x
,
val
)
#+
cmu
`
(
unix:unix-setenv
,
x
,
val
1
)
#+
cmu
cl
`
(
unix:unix-setenv
,
x
,
val
1
)
#+
ecl
`
(
ext:setenv
,
x
,
val
)
#+
lispworks
`
(
hcl:setenv
,
x
,
val
)
#+
mkcl
`
(
mkcl:setenv
,
x
,
val
)
#+
sbcl
`
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:setenv
,
x
,
val
1
))
#-
(
or
allegro
clisp
clozure
cmu
ecl
lispworks
mkcl
sbcl
)
#-
(
or
allegro
clisp
clozure
cmu
cl
ecl
lispworks
mkcl
sbcl
)
'
(
error
"~S ~S is not supported on your implementation"
'setf
'getenv
))
(
defun
getenvp
(
x
)
...
...
@@ -214,7 +214,7 @@ then returning the non-empty string value of the variable"
ccl::*openmcl-major-version*
ccl::*openmcl-minor-version*
(
logand
(
ccl-fasl-version
)
#xFF
))
#+
cmu
(
substitute
#\-
#\/
s
)
#+
cmu
cl
(
substitute
#\-
#\/
s
)
#+
scl
(
format
nil
"~A~A"
s
;; ANSI upper case vs lower case.
(
ecase
ext:*case-mode*
(
:upper
""
)
(
:lower
"l"
)))
...
...
@@ -248,7 +248,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(
defun
hostname
()
"return the hostname of the current host"
;; Note: untested on RMCL
#+
(
or
abcl
clasp
clozure
cmu
ecl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
machine-instance
)
#+
(
or
abcl
clasp
clozure
cmu
cl
ecl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
machine-instance
)
#+
cormanlisp
"localhost"
;; is there a better way? Does it matter?
#+
allegro
(
symbol-call
:excl.osi
:gethostname
)
#+
clisp
(
first
(
split-string
(
machine-instance
)
:separator
" "
))
...
...
@@ -258,7 +258,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
;;; Current directory
(
with-upgradability
()
#+
cmu
#+
cmu
cl
(
defun
parse-unix-namestring*
(
unix-namestring
)
"variant of LISP::PARSE-UNIX-NAMESTRING that returns a pathname object"
(
multiple-value-bind
(
host
device
directory
name
type
version
)
...
...
@@ -272,7 +272,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
#+
allegro
(
excl::current-directory
)
#+
clisp
(
ext:default-directory
)
#+
clozure
(
ccl:current-directory
)
#+
(
or
cmu
scl
)
(
#+
cmu
parse-unix-namestring*
#+
scl
lisp::parse-unix-namestring
#+
(
or
cmu
cl
scl
)
(
#+
cmu
cl
parse-unix-namestring*
#+
scl
lisp::parse-unix-namestring
(
strcat
(
nth-value
1
(
unix:unix-current-directory
))
"/"
))
#+
cormanlisp
(
pathname
(
pl::get-current-directory
))
;; Q: what type does it return?
#+
(
or
clasp
ecl
)
(
ext:getcwd
)
...
...
@@ -290,7 +290,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
#+
allegro
(
excl:chdir
x
)
#+
clisp
(
ext:cd
x
)
#+
clozure
(
setf
(
ccl:current-directory
)
x
)
#+
(
or
cmu
scl
)
(
unix:unix-chdir
(
ext:unix-namestring
x
))
#+
(
or
cmu
cl
scl
)
(
unix:unix-chdir
(
ext:unix-namestring
x
))
#+
cormanlisp
(
unless
(
zerop
(
win32::_chdir
(
namestring
x
)))
(
error
"Could not set current directory to ~A"
x
))
#+
(
or
clasp
ecl
)
(
ext:chdir
x
)
...
...
@@ -298,7 +298,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
#+
lispworks
(
hcl:change-directory
x
)
#+
mkcl
(
mk-ext:chdir
x
)
#+
sbcl
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:chdir
(
sb-ext:native-namestring
x
)))
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cormanlisp
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
cormanlisp
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"chdir not supported on your implementation"
))))
...
...
uiop/pathname.lisp
View file @
3af29fa0
...
...
@@ -48,7 +48,7 @@
implementation's MAKE-PATHNAME and other primitives to a CLHS-standard format
that is a list and not a string."
(
cond
#-
(
or
cmu
sbcl
scl
)
;; these implementations already normalize directory components.
#-
(
or
cmu
cl
sbcl
scl
)
;; these implementations already normalize directory components.
((
stringp
directory
)
`
(
:absolute
,
directory
))
((
or
(
null
directory
)
(
and
(
consp
directory
)
(
member
(
first
directory
)
'
(
:absolute
:relative
))))
...
...
@@ -91,7 +91,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives"
;; See CLHS make-pathname and 19.2.2.2.3.
;; This will be :unspecific if supported, or NIL if not.
(
defparameter
*unspecific-pathname-type*
#+
(
or
abcl
allegro
clozure
cmu
genera
lispworks
sbcl
scl
)
:unspecific
#+
(
or
abcl
allegro
clozure
cmu
cl
genera
lispworks
sbcl
scl
)
:unspecific
#+
(
or
clasp
clisp
ecl
mkcl
gcl
xcl
#|These haven't been tested:|#
cormanlisp
mcl
)
nil
"Unspecific type component to use with the underlying implementation's MAKE-PATHNAME"
)
...
...
@@ -187,7 +187,7 @@ when merging, making or parsing pathnames"
(
declare
(
ignorable
defaults
))
#.`
(
make-pathname
:directory
nil
:name
nil
:type
nil
:version
nil
:device
(
or
#+
(
and
mkcl
unix
)
:unspecific
)
:host
(
or
#+
cmu
lisp::*unix-host*
#+
(
and
mkcl
unix
)
"localhost"
)
:host
(
or
#+
cmu
cl
lisp::*unix-host*
#+
(
and
mkcl
unix
)
"localhost"
)
#+
scl
,@'
(
:scheme
nil
:scheme-specific-part
nil
:username
nil
:password
nil
:parameters
nil
:query
nil
:fragment
nil
)
;; the default shouldn't matter, but we really want something physical
...
...
uiop/stream.lisp
View file @
3af29fa0
...
...
@@ -34,7 +34,7 @@
(
with-upgradability
()
(
defvar
*default-stream-element-type*
(
or
#+
(
or
abcl
cmu
cormanlisp
scl
xcl
)
'character
(
or
#+
(
or
abcl
cmu
cl
cormanlisp
scl
xcl
)
'character
#+
lispworks
'lw:simple-char
:default
)
"default element-type for open (depends on the current CL implementation)"
)
...
...
@@ -45,7 +45,7 @@
(
defun
setup-stdin
()
(
setf
*stdin*
#.
(
or
#+
clozure
'ccl::*stdin*
#+
(
or
cmu
scl
)
'system:*stdin*
#+
(
or
cmu
cl
scl
)
'system:*stdin*
#+
(
or
clasp
ecl
)
'ext::+process-standard-input+
#+
sbcl
'sb-sys:*stdin*
'*standard-input*
)))
...
...
@@ -56,7 +56,7 @@
(
defun
setup-stdout
()
(
setf
*stdout*
#.
(
or
#+
clozure
'ccl::*stdout*
#+
(
or
cmu
scl
)
'system:*stdout*
#+
(
or
cmu
cl
scl
)
'system:*stdout*
#+
(
or
clasp
ecl
)
'ext::+process-standard-output+
#+
sbcl
'sb-sys:*stdout*
'*standard-output*
)))
...
...
@@ -68,7 +68,7 @@
(
setf
*stderr*
#.
(
or
#+
allegro
'excl::*stderr*
#+
clozure
'ccl::*stderr*
#+
(
or
cmu
scl
)
'system:*stderr*
#+
(
or
cmu
cl
scl
)
'system:*stderr*
#+
(
or
clasp
ecl
)
'ext::+process-error-output+
#+
sbcl
'sb-sys:*stderr*
'*error-output*
)))
...
...
uiop/utility.lisp
View file @
3af29fa0
...
...
@@ -585,11 +585,11 @@ with later being determined by a lexicographical comparison of minor numbers."
#+
allegro
'excl::format-control
#+
clisp
'system::$format-control
#+
clozure
'ccl::format-control
#+
(
or
cmu
scl
)
'conditions::format-control
#+
(
or
cmu
cl
scl
)
'conditions::format-control
#+
(
or
clasp
ecl
mkcl
)
'si::format-control
#+
(
or
gcl
lispworks
)
'conditions::format-string
#+
sbcl
'sb-kernel:format-control
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
ecl
gcl
lispworks
mkcl
sbcl
scl
)
nil
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmu
cl
ecl
gcl
lispworks
mkcl
sbcl
scl
)
nil
"Name of the slot for FORMAT-CONTROL in simple-condition"
)
(
defun
match-condition-p
(
x
condition
)
...
...
@@ -604,7 +604,7 @@ or a string describing the format-control of a simple-condition."
(
function
(
funcall
x
condition
))
(
string
(
and
(
typep
condition
'simple-condition
)
;; On SBCL, it's always set and the check triggers a warning
#+
(
or
allegro
clozure
cmu
lispworks
scl
)
#+
(
or
allegro
clozure
cmu
cl
lispworks
scl
)
(
slot-boundp
condition
+simple-condition-format-control-slot+
)
(
ignore-errors
(
equal
(
simple-condition-format-control
condition
)
x
))))))
...
...
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