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
asdf
asdf
Commits
f127ffb8
Commit
f127ffb8
authored
Mar 17, 2014
by
Robert P. Goldman
Browse files
Patch from Jean-Claude Beaudoin adding MKCL support.
parent
52bce047
Changes
23
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
f127ffb8
...
...
@@ -60,7 +60,9 @@ all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
# Making ASDF itself should be our first, default, target:
build/asdf.lisp
:
$(all_lisp)
mkdir
-p
build
rm
-f
$@
cat
$(all_lisp)
>
$@
chmod
-w
$@
# try to prevent accidental editing.
# This quickly locates such mistakes as unbalanced parentheses:
load
:
build/asdf.lisp
...
...
@@ -120,6 +122,7 @@ clean:
fi
;
\
done
rm
-rf
build/ LICENSE
test
/try-reloading-dependency.asd
test
/hello-world-example asdf.lisp
rm
-rf
test
/hello-world-example.exe
test
/mkcl_
*
.dll
# needed only on MS-Windows
rm
-rf
.pc/ build-stamp debian/patches/ debian/debhelper.log debian/cl-asdf/
# debian crap
${MAKE}
-C
doc clean
...
...
bundle.lisp
View file @
f127ffb8
...
...
@@ -26,9 +26,7 @@
((
build-args
:initarg
:args
:initform
nil
:accessor
bundle-op-build-args
)
(
name-suffix
:initarg
:name-suffix
:initform
nil
)
(
bundle-type
:initform
:no-output-file
:reader
bundle-type
)
#+
ecl
(
lisp-files
:initform
nil
:accessor
bundle-op-lisp-files
)
#+
mkcl
(
do-fasb
:initarg
:do-fasb
:initform
t
:reader
bundle-op-do-fasb-p
)
#+
mkcl
(
do-static-library
:initarg
:do-static-library
:initform
t
:reader
bundle-op-do-static-library-p
)))
#+
ecl
(
lisp-files
:initform
nil
:accessor
bundle-op-lisp-files
)))
(
defclass
monolithic-op
(
operation
)
()
(
:documentation
"A MONOLITHIC operation operates on a system *and all of its
...
...
@@ -47,6 +45,20 @@ itself.")) ;; operation on a system and its dependencies
((
prologue-code
:accessor
prologue-code
)
(
epilogue-code
:accessor
epilogue-code
)))
#+
mkcl
(
defclass
program
(
bundle-system
)
(
(
prologue-code
:initarg
:prologue-code
:initform
nil
:accessor
prologue-code
)
(
epilogue-code
:initarg
:epilogue-code
:initform
nil
:accessor
epilogue-code
)
(
prefix-lisp-object-files
:initarg
:prefix-lisp-object-files
:initform
nil
:accessor
program-prefix-lisp-object-files
)
(
postfix-lisp-object-files
:initarg
:postfix-lisp-object-files
:initform
nil
:accessor
program-postfix-lisp-object-files
)
(
object-files
:initarg
:object-files
:initform
nil
:accessor
program-object-files
)
(
extra-build-args
:initarg
:extra-build-args
:initform
nil
:accessor
program-extra-build-args
)))
(
defmethod
prologue-code
((
x
t
))
nil
)
(
defmethod
epilogue-code
((
x
t
))
nil
)
...
...
@@ -77,7 +89,7 @@ itself.")) ;; operation on a system and its dependencies
((
bundle-type
:initform
:fasl
)))
(
defclass
prepare-fasl-op
(
sideway-operation
)
((
sideway-operation
:initform
#+
ecl
'load-fasl-op
#-
ecl
'load-op
:allocation
:class
)))
((
sideway-operation
:initform
#+
(
or
ecl
mkcl
)
'load-fasl-op
#-
(
or
ecl
mkcl
)
'load-op
:allocation
:class
)))
(
defclass
lib-op
(
link-op
gather-op
non-propagating-operation
)
((
bundle-type
:initform
:lib
))
...
...
@@ -123,7 +135,7 @@ itself.")) ;; operation on a system and its dependencies
(
defclass
image-op
(
monolithic-bundle-op
selfward-operation
#+
ecl
link-op
#+
(
or
ecl
mkcl
)
gather-op
)
((
bundle-type
:initform
:image
)
(
selfward-operation
:initform
'
(
#-
ecl
load-op
)
:allocation
:class
))
(
selfward-operation
:initform
'
(
#-
(
or
ecl
mkcl
)
load-op
)
:allocation
:class
))
(
:documentation
"create an image file from the system and its dependencies"
))
(
defclass
program-op
(
image-op
)
...
...
@@ -139,8 +151,9 @@ itself.")) ;; operation on a system and its dependencies
((
member
:dll
:lib
:shared-library
:static-library
:program
:object
:program
)
(
compile-file-type
:type
bundle-type
))
((
member
:image
)
"image"
)
((
eql
:dll
)
(
cond
((
os-macosx-p
)
"dylib"
)
((
os-unix-p
)
"so"
)
((
os-windows-p
)
"dll"
)))
((
member
:lib
:static-library
)
(
cond
((
os-unix-p
)
"a"
)
((
os-windows-p
)
"lib"
)))
((
member
:dll
:shared-library
)
(
cond
((
os-macosx-p
)
"dylib"
)
((
os-unix-p
)
"so"
)
((
os-windows-p
)
"dll"
)))
((
member
:lib
:static-library
)
(
cond
((
os-unix-p
)
"a"
)
((
os-windows-p
)
(
if
(
featurep
'
(
:or
:mingw32
:mingw64
))
"a"
"lib"
))))
((
eql
:program
)
(
cond
((
os-unix-p
)
nil
)
((
os-windows-p
)
"exe"
)))))
(
defun
bundle-output-files
(
o
c
)
...
...
@@ -189,14 +202,14 @@ 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"
#-
ecl
"--system"
))))
; . no good for Logical Pathnames
(
if
(
operation-monolithic-p
instance
)
"--all-systems"
#-
(
or
ecl
mkcl
)
"--system"
))))
; . no good for Logical Pathnames
(
when
(
typep
instance
'monolithic-bundle-op
)
(
destructuring-bind
(
&key
lisp-files
prologue-code
epilogue-code
(
destructuring-bind
(
&key
#-
mkcl
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
epilogue-code
prologue-code
)))
#-
(
or
ecl
mkcl
)
(
assert
(
null
(
or
lisp-files
epilogue-code
prologue-code
)))
#+
ecl
(
setf
(
bundle-op-lisp-files
instance
)
lisp-files
)))
(
setf
(
bundle-op-build-args
instance
)
(
remove-plist-keys
...
...
@@ -208,7 +221,9 @@ itself.")) ;; operation on a system and its dependencies
(
declare
(
ignorable
type
))
(
or
#+
ecl
(
or
(
equalp
type
(
compile-file-type
:type
:object
))
(
equalp
type
(
compile-file-type
:type
:static-library
)))
#+
mkcl
(
equalp
type
(
compile-file-type
:fasl-p
nil
))
#+
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"
))
#+
(
or
abcl
allegro
clisp
clozure
cmu
lispworks
sbcl
scl
xcl
)
(
equalp
type
(
compile-file-type
)))))
(
defgeneric*
(
trivial-system-p
)
(
component
))
...
...
@@ -344,7 +359,15 @@ itself.")) ;; operation on a system and its dependencies
nil
)
(
defmethod
component-depends-on
((
o
monolithic-lib-op
)
(
c
prebuilt-system
))
nil
))
nil
)
#+
mkcl
(
defmethod
perform
((
o
fasl-op
)
(
c
prebuilt-system
))
nil
)
#+
mkcl
(
defmethod
output-files
((
o
lib-op
)
(
c
prebuilt-system
))
(
list
(
prebuilt-system-static-library
c
))))
;;;
...
...
@@ -361,6 +384,7 @@ itself.")) ;; operation on a system and its dependencies
(
library
(
second
inputs
))
(
asd
(
first
(
output-files
o
s
)))
(
name
(
if
(
and
fasl
asd
)
(
pathname-name
asd
)
(
return-from
perform
)))
(
version
(
component-version
s
))
(
dependencies
(
if
(
operation-monolithic-p
o
)
(
remove-if-not
'builtin-system-p
...
...
@@ -388,8 +412,9 @@ itself.")) ;; operation on a system and its dependencies
(
machine-type
)
(
software-version
))
(
let
((
*package*
(
find-package
:asdf-user
)))
(
pprint
`
(
defsystem
,
name
(
pprint
`
(
asdf/defsystem:
defsystem
,
name
:class
prebuilt-system
:version
,
version
:depends-on
,
depends-on
:components
((
:compiled-file
,
(
pathname-name
fasl
)))
,@
(
when
library
`
(
:lib
,
(
file-namestring
library
))))
...
...
@@ -430,7 +455,7 @@ itself.")) ;; operation on a system and its dependencies
(asdf:load-system :precompiled-asdf-utils)
|#
#+
(
or
ecl
mkcl
)
#+
ecl
(
with-upgradability
()
(
defun
uiop-library-file
()
(
or
(
and
(
find-system
:uiop
nil
)
...
...
@@ -447,8 +472,10 @@ itself.")) ;; operation on a system and its dependencies
(
and
(
system-source-directory
:asdf
)
(
plan-operates-on-p
plan
'
(
"asdf"
))))
(
pushnew
(
uiop-library-file
)
files
:test
'pathname-equal
))
files
))
files
))
)
#+
(
or
ecl
mkcl
)
(
with-upgradability
()
(
defun
register-pre-built-system
(
name
)
(
register-system
(
make-instance
'system
:name
(
coerce-name
name
)
:source-file
nil
))))
...
...
@@ -477,14 +504,28 @@ itself.")) ;; operation on a system and its dependencies
#+
mkcl
(
with-upgradability
()
(
defmethod
perform
((
o
dll-op
)
(
s
system
))
(
apply
#'
compiler::build-shared-library
(
output-file
o
s
)
:lisp-object-files
(
input-files
o
s
)
(
bundle-op-build-args
o
)))
(
defmethod
perform
((
o
lib-op
)
(
s
system
))
(
apply
#'
compiler::build-static-library
(
output-file
o
c
)
(
apply
#'
compiler::build-static-library
(
output-file
o
s
)
:lisp-object-files
(
input-files
o
s
)
(
bundle-op-build-args
o
)))
(
defmethod
perform
((
o
basic-fasl-op
)
(
s
system
))
(
apply
#'
compiler::build-bundle
(
output-file
o
c
)
;; second???
(
apply
#'
compiler::build-bundle
(
output-file
o
s
)
:lisp-object-files
(
input-files
o
s
)
(
bundle-op-build-args
o
)))
(
defmethod
perform
((
o
program-op
)
(
s
system
))
(
apply
#'
compiler::build-program
(
output-file
o
s
)
:lisp-object-files
(
append
(
program-prefix-lisp-object-files
s
)
(
input-files
o
s
)
(
program-postfix-lisp-object-files
s
))
:object-files
(
program-object-files
s
)
:prologue-code
(
prologue-code
s
)
:epilogue-code
(
epilogue-code
s
)
(
program-extra-build-args
s
)))
(
defun
bundle-system
(
system
&rest
args
&key
force
(
verbose
t
)
version
&allow-other-keys
)
(
declare
(
ignore
force
verbose
version
))
(
apply
#'
operate
'deliver-asd-op
system
args
)))
...
...
footer.lisp
View file @
f127ffb8
...
...
@@ -20,7 +20,7 @@
#+
(
or
ecl
mkcl
)
(
progn
(
pushnew
'
(
"fasb"
.
si::load-binary
)
si:*load-hooks*
:test
'equal
:key
'car
)
(
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
)
...
...
source-registry.lisp
View file @
f127ffb8
...
...
@@ -155,8 +155,8 @@ system names to pathnames of .asd files")
(
defun
wrapping-source-registry
()
`
(
:source-registry
#+
(
or
ecl
sbcl
)
(
:tree
,
(
resolve-symlinks*
(
lisp-implementation-directory
)))
#+
mkcl
(
:tree
,
(
translate-logical-pathname
"CONTRIB:"
))
:inherit-configuration
#+
mkcl
(
:tree
,
(
translate-logical-pathname
"CONTRIB:"
))
#+
cmu
(
:tree
#p"modules:"
)
#+
scl
(
:tree
#p"file://modules/"
)))
(
defun
default-source-registry
()
...
...
test/dll-test.lisp
View file @
f127ffb8
...
...
@@ -9,3 +9,13 @@ int sample_function()
return 42;
}
"
)
#+
mkcl
(
ffi:clines
"
extern MKCL_DLLEXPORT int sample_function(void);
int sample_function(void)
{
return 42;
}
"
)
test/dll-user.lisp
View file @
f127ffb8
(
defpackage
:test-asdf/dll-user
(
:use
))
;; dummy, for package-system dependencies.
(
in-package
:test-package
)
#+
(
and
mkcl
windows
)
(
ffi:clines
"extern __declspec(dllimport) int sample_function(void);"
)
#-
(
and
mkcl
windows
)
(
ffi:clines
"extern int sample_function(void);"
)
(
ffi:def-function
"sample_function"
()
:returning
:int
)
test/hello-world-example.asd
View file @
f127ffb8
;; Example executable program
#-
mkcl
(
defsystem
:hello-world-example
:build-operation
program-op
:entry-point
"hello:entry-point"
:depends-on
(
:uiop
)
:components
((
:file
"hello"
)))
#+
mkcl
(
defsystem
:hello-world-example
:class
asdf/bundle::program
:build-operation
program-op
:entry-point
"hello:entry-point"
:depends-on
(
:uiop
)
:components
((
:file
"hello"
))
:prefix-lisp-object-files
#.
(
list
(
namestring
(
truename
(
translate-logical-pathname
#P"SYS:cmp.a"
))))
:extra-build-args
#.
(
or
#-
windows
'
(
:use-mkcl-shared-libraries
nil
))
:epilogue-code
(
progn
(
setq
uiop/image:*image-dumped-p*
:executable
)
(
uiop/image:restore-image
:entry-point
(
read-from-string
"hello:entry-point"
))))
test/hello.lisp
View file @
f127ffb8
...
...
@@ -12,4 +12,5 @@
t
)
(
defun
entry-point
()
(
apply
'main
*command-line-arguments*
))
(
apply
'main
*command-line-arguments*
)
#+
mkcl
(
quit
))
test/make-hello-world.lisp
View file @
f127ffb8
...
...
@@ -2,7 +2,7 @@
#+
lispworks
(
lispworks:load-all-patches
)
(
load
(
make-pathname
:name
"script-support"
:defaults
*load-pathname*
))
(
load-asdf
)
#+
ecl
(
require
:cmp
)
#+
(
or
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 @
f127ffb8
...
...
@@ -9,3 +9,13 @@ int always_7()
return 7;
}
"
)
#+
mkcl
(
ffi:clines
"
extern MKCL_DLLEXPORT int always_7(void);
int always_7(void)
{
return 7;
}
"
)
test/monodll.lisp
View file @
f127ffb8
...
...
@@ -9,3 +9,13 @@ int always_42()
return 6*always_7();
}
"
)
#+
mkcl
(
ffi:clines
"
extern MKCL_DLLEXPORT int always_42(void);
int always_42(void)
{
return 6*always_7();
}
"
)
test/script-support.lisp
View file @
f127ffb8
...
...
@@ -142,6 +142,9 @@ Some constraints:
(
cond
((
equal
x
y
)
(
format
t
"~S and~% ~S both evaluate to same path:~% ~S~%"
qx
qy
x
))
#+
mkcl
((
acall
:pathname-equal
x
y
)
(
format
t
"~S and ~S evaluate to functionaly equivalent paths, respectively:~% ~S~%and~% ~S~%"
qx
qy
x
y
))
((
acall
:pathname-equal
x
y
)
(
warn
"These two expressions yield pathname-equal yet not equal path~%~
the first expression ~S yields this:~% ~S~% ~S~%
...
...
test/test-bundle.script
View file @
f127ffb8
...
...
@@ -61,3 +61,23 @@
(si:load-foreign-module (first (output-files 'monolithic-dll-op :test-asdf/monodll)))
(operate 'load-op :test-asdf/monodll-user)
(assert-equal (test-package::always-42) 42))
;;; Test DLL-op and monolithic-dll-op on MKCL.
#+mkcl
(progn
(require 'sockets) ;; Test the pre-compiled system feature
(operate 'dll-op :test-asdf/dll-test)
(let ((dll (first (output-files 'dll-op :test-asdf/dll-test))))
(si:load-foreign-module dll)
(let* ( #+windows (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/dll-user)))
(assert (= (test-package::sample-function) 42))
(let* #+windows ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1)))
(compiler::*builder-default-libraries* (list (namestring lib))))
#-windows ()
(operate 'monolithic-dll-op :test-asdf/monodll))
(let ((dll (first (output-files 'monolithic-dll-op :test-asdf/monodll))))
(si:load-foreign-module dll)
(let* ( #+windows (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/monodll-user)))
(assert-equal (test-package::always-42) 42))
test/test-program.script
View file @
f127ffb8
...
...
@@ -2,7 +2,7 @@
(DBG :foo (current-lisp-file-pathname))
(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks sbcl) t
(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks
mkcl
sbcl) t
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
...
...
@@ -13,6 +13,8 @@
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
#-mkcl
(progn
;; Try to load lisp-invocation from xcvb
(setf *central-registry*
(list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF
...
...
@@ -35,7 +37,23 @@
(symbol-call :lisp-invocation :lisp-invocation-arglist
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")))
:output t :error-output :output :input nil))
0)
0))
#+mkcl
(progn
(operate 'program-op :hello-world-example)
#+windows
(let*
((dll-orig (merge-pathnames (make-pathname :name (mkcl:str+ "mkcl_" (lisp-implementation-version)) :type "dll")
(si::self-truename)))
(exe (car (asdf::output-files 'program-op :hello-world-example)))
(exe-dir (make-pathname :name nil :type nil :defaults exe))
(dll-dest (merge-pathnames exe-dir dll-orig)))
;; make sure mkcl-X.X.X.dll is the same directory as the executable
(copy-file dll-orig dll-dest)))
(assert (probe-file* exe))
(assert-equal (run-program `(,(native-namestring exe)) :output :lines)
...
...
uiop/common-lisp.lisp
View file @
f127ffb8
...
...
@@ -30,7 +30,7 @@
;;;; Early meta-level tweaks
#+
(
or
abcl
allegro
clisp
cmu
ecl
mkcl
clozure
lispworks
sbcl
scl
)
#+
(
or
abcl
allegro
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.
...
...
uiop/driver.lisp
View file @
f127ffb8
...
...
@@ -13,3 +13,5 @@
:uiop/os
:uiop/pathname
:uiop/stream
:uiop/filesystem
:uiop/image
:uiop/run-program
:uiop/lisp-build
:uiop/configuration
:uiop/backward-driver
))
#+
mkcl
(
provide
:uiop
)
uiop/filesystem.lisp
View file @
f127ffb8
...
...
@@ -598,7 +598,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
clisp
clozure
cmu
cormanlisp
digitool
ecl
gcl
lispworks
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clisp
clozure
cmu
cormanlisp
digitool
ecl
gcl
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
))
...
...
uiop/image.lisp
View file @
f127ffb8
...
...
@@ -118,7 +118,7 @@ This is designed to abstract away the implementation specific quit forms."
(
let
((
debug:*debug-print-level*
*print-level*
)
(
debug:*debug-print-length*
*print-length*
))
(
debug:backtrace
(
or
count
most-positive-fixnum
)
stream
))
#+
ecl
#+
(
or
ecl
mkcl
)
(
let*
((
top
(
si:ihs-top
))
(
repeats
(
if
count
(
min
top
count
)
top
))
(
backtrace
(
loop
:for
ihs
:from
0
:below
top
...
...
@@ -233,9 +233,10 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+
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
clisp
clozure
cmu
ecl
gcl
genera
lispworks
mcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clisp
clozure
cmu
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
)))
...
...
@@ -266,7 +267,7 @@ Otherwise, return NIL."
;; NB: not currently available on ABCL, Corman, Genera, MCL, MKCL
(
or
#+
(
or
allegro
clisp
clozure
cmu
gcl
lispworks
sbcl
scl
xcl
)
(
first
(
raw-command-line-arguments
))
#+
ecl
(
si:argv
0
)))
#+
ecl
(
si:argv
0
)
#+
mkcl
(
mkcl:argv
0
)))
(
t
;; argv[0] is the name of the interpreter.
;; The wrapper script can export __CL_ARGV0. cl-launch does as of 4.0.1.8.
(
getenvp
"__CL_ARGV0"
))))
...
...
uiop/lisp-build.lisp
View file @
f127ffb8
...
...
@@ -62,16 +62,17 @@ This can help you produce more deterministic output for FASLs."))
"Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS"
)
(
defun
get-optimization-settings
()
"Get current compiler optimization settings, ready to PROCLAIM again"
#-
(
or
clisp
clozure
cmu
ecl
sbcl
scl
)
#-
(
or
clisp
clozure
cmu
ecl
mkcl
sbcl
scl
)
(
warn
"~S does not support ~S. Please help me fix that."
'get-optimization-settings
(
implementation-type
))
#+
clozure
(
ccl:declaration-information
'optimize
nil
)
#+
(
or
clisp
cmu
ecl
sbcl
scl
)
#+
(
or
clisp
cmu
ecl
mkcl
sbcl
scl
)
(
let
((
settings
'
(
speed
space
safety
debug
compilation-speed
#+
(
or
cmu
scl
)
c::brevity
)))
#.`
(
loop
:for
x
:in
settings
,@
(
or
#+
ecl
'
(
:for
v
:in
'
(
c::*speed*
c::*space*
c::*safety*
c::*debug*
))
#+
mkcl
'
(
:for
v
:in
'
(
si::*speed*
si::*space*
si::*safety*
si::*debug*
))
#+
(
or
cmu
scl
)
'
(
:for
f
:in
'
(
c::cookie-speed
c::cookie-space
c::cookie-safety
c::cookie-debug
c::cookie-cspeed
c::cookie-brevity
)))
:for
y
=
(
or
#+
clisp
(
gethash
x
system::*optimize*
)
#+
(
or
ecl
)
(
symbol-value
v
)
#+
(
or
ecl
mkcl
)
(
symbol-value
v
)
#+
(
or
cmu
scl
)
(
funcall
f
c::*default-cookie*
)
#+
sbcl
(
cdr
(
assoc
x
sb-c::*policy*
)))
:when
y
:collect
(
list
x
y
))))
...
...
uiop/os.lisp
View file @
f127ffb8
...
...
@@ -49,7 +49,7 @@ keywords explicitly."
(
defun
os-windows-p
()
"Is the underlying operating system Microsoft Windows?"
(
or
#+
abcl
(
featurep
:windows
)
#+
(
and
(
not
(
or
abcl
unix
cygwin
darwin
))
(
or
win32
windows
mswindows
mingw32
))
t
))
#+
(
and
(
not
(
or
abcl
unix
cygwin
darwin
))
(
or
win32
windows
mswindows
mingw32
mingw64
))
t
))
(
defun
os-genera-p
()
"Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?"
...
...
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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