Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
A
asdf
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Hugo Ishimaru
asdf
Commits
e4de8bff
Commit
e4de8bff
authored
11 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Add option on ECL and MKCL to build images without UIOP, plus test.
parent
e2751f31
No related branches found
No related tags found
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
bundle.lisp
+17
-9
17 additions, 9 deletions
bundle.lisp
test/test-program.script
+21
-3
21 additions, 3 deletions
test/test-program.script
uiop/image.lisp
+21
-17
21 additions, 17 deletions
uiop/image.lisp
with
59 additions
and
29 deletions
bundle.lisp
+
17
−
9
View file @
e4de8bff
...
@@ -45,6 +45,7 @@ itself.")) ;; operation on a system and its dependencies
...
@@ -45,6 +45,7 @@ itself.")) ;; operation on a system and its dependencies
;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system
;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system
((
prologue-code
:initform
nil
:initarg
:prologue-code
:reader
prologue-code
)
((
prologue-code
:initform
nil
:initarg
:prologue-code
:reader
prologue-code
)
(
epilogue-code
:initform
nil
:initarg
:epilogue-code
:reader
epilogue-code
)
(
epilogue-code
:initform
nil
:initarg
:epilogue-code
:reader
epilogue-code
)
(
no-uiop
:initform
nil
:initarg
:no-uiop
:reader
no-uiop
)
(
prefix-lisp-object-files
:initarg
:prefix-lisp-object-files
(
prefix-lisp-object-files
:initarg
:prefix-lisp-object-files
:initform
nil
:accessor
prefix-lisp-object-files
)
:initform
nil
:accessor
prefix-lisp-object-files
)
(
postfix-lisp-object-files
:initarg
:postfix-lisp-object-files
(
postfix-lisp-object-files
:initarg
:postfix-lisp-object-files
...
@@ -56,6 +57,7 @@ itself.")) ;; operation on a system and its dependencies
...
@@ -56,6 +57,7 @@ itself.")) ;; operation on a system and its dependencies
(
defmethod
prologue-code
((
x
t
))
nil
)
(
defmethod
prologue-code
((
x
t
))
nil
)
(
defmethod
epilogue-code
((
x
t
))
nil
)
(
defmethod
epilogue-code
((
x
t
))
nil
)
(
defmethod
no-uiop
((
x
t
))
nil
)
(
defmethod
prefix-lisp-object-files
((
x
t
))
nil
)
(
defmethod
prefix-lisp-object-files
((
x
t
))
nil
)
(
defmethod
postfix-lisp-object-files
((
x
t
))
nil
)
(
defmethod
postfix-lisp-object-files
((
x
t
))
nil
)
(
defmethod
extra-object-files
((
x
t
))
nil
)
(
defmethod
extra-object-files
((
x
t
))
nil
)
...
@@ -219,7 +221,8 @@ itself.")) ;; operation on a system and its dependencies
...
@@ -219,7 +221,8 @@ itself.")) ;; operation on a system and its dependencies
#+
ecl
(
setf
(
extra-object-files
instance
)
lisp-files
)))
#+
ecl
(
setf
(
extra-object-files
instance
)
lisp-files
)))
(
setf
(
extra-build-args
instance
)
(
setf
(
extra-build-args
instance
)
(
remove-plist-keys
(
remove-plist-keys
'
(
:type
:monolithic
:name-suffix
:epilogue-code
:prologue-code
:lisp-files
)
'
(
:type
:monolithic
:name-suffix
:epilogue-code
:prologue-code
:lisp-files
:force
:force-not
:plan-class
)
;; TODO: refactor so we don't mix plan and operation arguments
(
operation-original-initargs
instance
))))
(
operation-original-initargs
instance
))))
(
defun
bundlable-file-p
(
pathname
)
(
defun
bundlable-file-p
(
pathname
)
...
@@ -469,25 +472,29 @@ itself.")) ;; operation on a system and its dependencies
...
@@ -469,25 +472,29 @@ itself.")) ;; operation on a system and its dependencies
;; (setf *load-system-operation* 'load-bundle-op))
;; (setf *load-system-operation* 'load-bundle-op))
(
defun
asdf-library-pathname
()
(
defun
asdf-library-pathname
()
#+
ecl
(
compile-file-pathname
"sys:asdf"
:type
:
lib
)
#+
ecl
(
compile-file-pathname
"sys:asdf"
:type
:
object
)
#+
mkcl
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
:defaults
#p"sys:contrib;asdf"
))
#+
mkcl
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
:defaults
#p"sys:contrib;asdf"
))
(
defun
compiler-library-pathname
()
#+
ecl
(
compile-file-pathname
"sys:cmp"
:type
:lib
)
#+
mkcl
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
:defaults
#p"sys:cmp"
))
(
defun
make-library-system
(
name
pathname
)
(
defun
make-library-system
(
name
pathname
)
(
make-instance
'prebuilt-system
:name
name
:static-library
(
resolve-symlinks*
pathname
)))
(
make-instance
'prebuilt-system
:name
(
coerce-name
name
)
:static-library
(
resolve-symlinks*
pathname
)))
(
defmethod
component-depends-on
:around
((
o
image-op
)
(
c
system
))
(
defmethod
component-depends-on
:around
((
o
image-op
)
(
c
system
))
(
destructuring-bind
((
lib-op
.
deps
))
(
call-next-method
)
(
destructuring-bind
((
lib-op
.
deps
))
(
call-next-method
)
(
flet
((
has-it-p
(
x
)
(
find
x
deps
:test
'equal
:key
'coerce-name
)))
(
flet
((
has-it-p
(
x
)
(
find
x
deps
:test
'equal
:key
'coerce-name
)))
`
((
,
lib-op
`
((
,
lib-op
#+
mkcl
,@
(
unless
(
has-it-p
"cmp"
)
,@
(
unless
(
or
(
no-uiop
c
)
(
has-it-p
"cmp"
))
`
(
,
(
make-library-system
`
(
,
(
make-library-system
"cmp"
(
make-pathname
:type
(
bundle-pathname-type
:lib
)
"cmp"
(
compiler-library-pathname
))))
:defaults
#p"sys:cmp"
))))
,@
(
unless
(
or
(
no-uiop
c
)
(
has-it-p
"uiop"
)
(
has-it-p
"asdf"
))
,@
(
unless
(
or
(
has-it-p
"asdf"
)
(
has-it-p
"uiop"
))
`
(
,
(
cond
`
(
,
(
cond
((
system-source-directory
:uiop
)
(
find-system
:uiop
))
((
system-source-directory
:uiop
)
(
find-system
:uiop
))
((
system-source-directory
:asdf
)
(
find-system
:asdf
))
((
system-source-directory
:asdf
)
(
find-system
:asdf
))
(
t
(
make-
fake-asdf
-system
"asdf"
(
asdf-library-pathname
))))))
(
t
(
make-
library
-system
"asdf"
(
asdf-library-pathname
))))))
,@
deps
)))))
,@
deps
)))))
(
defmethod
perform
((
o
link-op
)
(
c
system
))
(
defmethod
perform
((
o
link-op
)
(
c
system
))
...
@@ -507,6 +514,7 @@ itself.")) ;; operation on a system and its dependencies
...
@@ -507,6 +514,7 @@ itself.")) ;; operation on a system and its dependencies
:epilogue-code
(
or
(
epilogue-code
o
)
(
when
programp
(
epilogue-code
c
)))
:epilogue-code
(
or
(
epilogue-code
o
)
(
when
programp
(
epilogue-code
c
)))
:build-args
(
or
(
extra-build-args
o
)
(
when
programp
(
extra-build-args
c
)))
:build-args
(
or
(
extra-build-args
o
)
(
when
programp
(
extra-build-args
c
)))
:extra-object-files
(
or
(
extra-object-files
o
)
(
when
programp
(
extra-object-files
c
)))
:extra-object-files
(
or
(
extra-object-files
o
)
(
when
programp
(
extra-object-files
c
)))
:no-uiop
(
no-uiop
c
)
(
when
programp
`
(
:entry-point
,
(
component-entry-point
c
))))))))
(
when
programp
`
(
:entry-point
,
(
component-entry-point
c
))))))))
#+
(
and
(
not
asdf-use-unsafe-mac-bundle-op
)
#+
(
and
(
not
asdf-use-unsafe-mac-bundle-op
)
...
...
This diff is collapsed.
Click to expand it.
test/test-program.script
+
21
−
3
View file @
e4de8bff
;;; -*- Lisp -*-
;;; -*- Lisp -*-
(DBG :foo (current-lisp-file-pathname))
(DBG :foo (current-lisp-file-pathname))
#+mkcl (trace perform create-image component-depends-on) ;; compiler::build-shared-library compiler::build-static-library compiler::build-bundle compiler::build-program
#+ecl (trace perform create-image c::builder component-depends-on)
(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t)
(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t)
(DBG "Creating images is not supported on your CL implementation")
(DBG "Creating images is not supported on your CL implementation")
(leave-test "Skipping test" 0))
(leave-test "Skipping test" 0))
...
@@ -112,4 +109,25 @@
...
@@ -112,4 +109,25 @@
" \"b c\""
" \"b c\""
" \"d\""))
" \"d\""))
#+(or ecl mkcl)
(progn
(DBG "Now create an program without UIOP")
(assert (probe-file (asdf/bundle::asdf-library-pathname)))
(assert (probe-file (asdf/bundle::compiler-library-pathname)))
(def-test-system hello-no-uiop
:class program-system
:no-uiop t
:components ((:file "file1"))
:epilogue-code
(progn
(format t "~:[Look ma, no UIOP~;Oops, UIOP~]!~%" (find-package :uiop))
(format t "~:[But no TEST-PACKAGE :-(~;But TEST-PACKAGE~]!~%" (find-package :test-package))
#+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0)))
(operate 'program-op 'hello-no-uiop :force t)
(DBG :run (output-file 'program-op 'hello-no-uiop))
(assert-equal
(run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop)))
:output :lines :error-output t)
'("Look ma, no UIOP!" "But TEST-PACKAGE!")))
;;; TODO: include a regular system dependency and a prebuilt-system in the executable.
;;; TODO: include a regular system dependency and a prebuilt-system in the executable.
This diff is collapsed.
Click to expand it.
uiop/image.lisp
+
21
−
17
View file @
e4de8bff
...
@@ -419,7 +419,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
...
@@ -419,7 +419,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(
defun
create-image
(
destination
lisp-object-files
(
defun
create-image
(
destination
lisp-object-files
&key
kind
output-name
prologue-code
epilogue-code
extra-object-files
&key
kind
output-name
prologue-code
epilogue-code
extra-object-files
(
prelude
()
preludep
)
(
postlude
()
postludep
)
(
prelude
()
preludep
)
(
postlude
()
postludep
)
(
entry-point
()
entry-point-p
)
build-args
)
(
entry-point
()
entry-point-p
)
build-args
no-uiop
)
(
declare
(
ignorable
destination
lisp-object-files
extra-object-files
kind
output-name
(
declare
(
ignorable
destination
lisp-object-files
extra-object-files
kind
output-name
prologue-code
epilogue-code
prelude
preludep
postlude
postludep
prologue-code
epilogue-code
prelude
preludep
postlude
postludep
entry-point
entry-point-p
build-args
))
entry-point
entry-point-p
build-args
))
...
@@ -429,21 +429,25 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
...
@@ -429,21 +429,25 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
;; and otherwise simulate dump-image, including quitting at the end.
;; and otherwise simulate dump-image, including quitting at the end.
#-
(
or
ecl
mkcl
)
(
error
"~S not implemented for your implementation (yet)"
'create-image
)
#-
(
or
ecl
mkcl
)
(
error
"~S not implemented for your implementation (yet)"
'create-image
)
#+
(
or
ecl
mkcl
)
#+
(
or
ecl
mkcl
)
(
let
((
epilogue-forms
(
let
((
epilogue-code
(
append
(
if
no-uiop
(
when
epilogue-code
`
(
,
epilogue-code
))
epilogue-code
(
when
postludep
`
((
setf
*image-postlude*
',postlude
)))
(
let
((
forms
(
when
preludep
`
((
setf
*image-prelude*
',prelude
)))
(
append
(
when
entry-point-p
`
((
setf
*image-entry-point*
',entry-point
)))
(
when
epilogue-code
`
(
,
epilogue-code
))
(
case
kind
(
when
postludep
`
((
setf
*image-postlude*
',postlude
)))
((
:image
)
(
when
preludep
`
((
setf
*image-prelude*
',prelude
)))
(
setf
kind
:program
)
;; to ECL, it's just another program.
(
when
entry-point-p
`
((
setf
*image-entry-point*
',entry-point
)))
`
((
setf
*image-dumped-p*
t
)
(
case
kind
(
si::top-level
#+
ecl
t
)
(
quit
)))
((
:image
)
((
:program
)
(
setf
kind
:program
)
;; to ECL, it's just another program.
`
((
setf
*image-dumped-p*
:executable
)
`
((
setf
*image-dumped-p*
t
)
(
shell-boolean-exit
(
si::top-level
#+
ecl
t
)
(
quit
)))
(
restore-image
))))))))
((
:program
)
`
((
setf
*image-dumped-p*
:executable
)
(
shell-boolean-exit
(
restore-image
))))))))
(
when
forms
`
(
progn
,@
forms
))))))
#+
ecl
(
check-type
kind
(
member
:dll
:lib
:static-library
:program
:object
:fasl
))
#+
ecl
(
check-type
kind
(
member
:dll
:lib
:static-library
:program
:object
:fasl
))
(
apply
#+
ecl
'c::builder
#+
ecl
kind
(
apply
#+
ecl
'c::builder
#+
ecl
kind
#+
mkcl
(
ecase
kind
#+
mkcl
(
ecase
kind
...
@@ -456,7 +460,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
...
@@ -456,7 +460,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
#+
ecl
:init-name
#+
ecl
(
c::compute-init-name
(
or
output-name
destination
)
:kind
kind
)
#+
ecl
:init-name
#+
ecl
(
c::compute-init-name
(
or
output-name
destination
)
:kind
kind
)
(
append
(
append
(
when
prologue-code
`
(
:prologue-code
,
prologue-code
))
(
when
prologue-code
`
(
:prologue-code
,
prologue-code
))
(
when
epilogue-
forms
`
(
:epilogue-code
(
progn
,@
epilogue-
forms
)
))
(
when
epilogue-
code
`
(
:epilogue-code
,
epilogue-
code
))
#+
mkcl
(
when
extra-object-files
`
(
:object-files
,
extra-object-files
))
#+
mkcl
(
when
extra-object-files
`
(
:object-files
,
extra-object-files
))
build-args
)))))
build-args
)))))
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment