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
Hugo Ishimaru
asdf
Commits
604f5422
Commit
604f5422
authored
Nov 07, 2016
by
Francois-Rene Rideau
Browse files
Include DEFINE-OP in mark-component-preloaded
Move it to asdf/find-system.
parent
3d0d07c3
Changes
3
Show whitespace changes
Inline
Side-by-side
find-system.lisp
View file @
604f5422
...
...
@@ -246,5 +246,19 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
load-asd
pathname
:name
name
)))))
;; Try again after having loaded from disk if needed
(
or
(
registered-system
name
)
(
when
error-p
(
error
'missing-component
:requires
name
))))))))
(
when
error-p
(
error
'missing-component
:requires
name
)))))))
;; Resolved forward reference for asdf/system-registry.
(
defun
mark-component-preloaded
(
component
)
"Mark a component as preloaded."
(
let
((
component
(
find-component
component
nil
:registered
t
)))
;; Recurse to children, so asdf/plan will hopefully be happy.
(
map
()
'mark-component-preloaded
(
component-children
component
))
;; Mark the timestamps of the common lisp-action operations as 0.
(
let
((
times
(
component-operation-times
component
)))
(
dolist
(
o
`
(
,@
(
when
(
and
(
typep
component
'system
)
(
equal
(
coerce-name
component
)
(
primary-system-name
component
)))
'
(
define-op
))
prepare-op
compile-op
load-op
))
(
setf
(
gethash
(
make-operation
o
)
times
)
0
))))))
operate.lisp
View file @
604f5422
...
...
@@ -272,17 +272,4 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(
upgrade-configuration
)
;; If we were in the middle of an operation, be sure to restore the system being defined.
(
dolist
(
s
systems-being-defined
)
(
find-system
s
nil
))))
(
register-hook-function
'*post-upgrade-cleanup-hook*
'restart-upgraded-asdf
)
;; The following function's symbol is from asdf/find-system.
;; It is defined here to resolve what would otherwise be forward package references.
(
defun
mark-component-preloaded
(
component
)
"Mark a component as preloaded."
(
let
((
component
(
find-component
component
nil
:registered
t
)))
;; Recurse to children, so asdf/plan will hopefully be happy.
(
map
()
'mark-component-preloaded
(
component-children
component
))
;; Mark the timestamps of the common lisp-action operations as 0.
(
let
((
times
(
component-operation-times
component
)))
(
dolist
(
o
'
(
load-op
compile-op
prepare-op
))
(
setf
(
gethash
(
make-operation
o
)
times
)
0
))))))
(
register-hook-function
'*post-upgrade-cleanup-hook*
'restart-upgraded-asdf
))
system-registry.lisp
View file @
604f5422
...
...
@@ -15,7 +15,7 @@
#:find-system-if-being-defined
#:contrib-sysdef-search
#:sysdef-find-asdf
;; backward compatibility symbols, functions removed
#:sysdef-preloaded-system-search
#:register-preloaded-system
#:*preloaded-systems*
#:mark-component-preloaded
;; forward reference to asdf/
opera
te
#:mark-component-preloaded
;; forward reference to asdf/
find-sys
te
m
#:sysdef-immutable-system-search
#:register-immutable-system
#:*immutable-systems*
#:*defined-systems*
#:clear-defined-systems
;; defined in source-registry, but specially mentioned here:
...
...
@@ -81,7 +81,7 @@ called with an object of type asdf:system."
(
defvar
*preloaded-systems*
(
make-hash-table
:test
'equal
)
"Registration table for preloaded systems."
)
(
declaim
(
ftype
(
function
(
t
)
t
)
mark-component-preloaded
))
; defined in asdf/
opera
te
(
declaim
(
ftype
(
function
(
t
)
t
)
mark-component-preloaded
))
; defined in asdf/
find-sys
te
m
(
defun
make-preloaded-system
(
name
keys
)
"Make a preloaded system of given NAME with build information from KEYS"
...
...
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