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
abcl
abcl
Commits
f3286619
Commit
f3286619
authored
Aug 18, 2012
by
ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files
Make compile-file generate a file with EXPORTed symbols
so we can use it in COMPILE-SYSTEM.
parent
63d976b9
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/org/armedbear/lisp/compile-file.lisp
View file @
f3286619
...
...
@@ -41,6 +41,7 @@
(
defvar
*toplevel-functions*
)
(
defvar
*toplevel-macros*
)
(
defvar
*toplevel-exports*
)
(
defun
base-classname
(
&optional
(
output-file-pathname
*output-file-pathname*
))
...
...
@@ -281,6 +282,16 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
(
eval
form
)))
nil
)
(
declaim
(
ftype
(
function
(
t
t
t
)
t
)
process-toplevel-export
))
(
defun
process-toplevel-export
(
form
stream
compile-time-too
)
(
when
(
eq
(
car
(
second
form
))
'QUOTE
)
;; constant export list
(
let
((
sym-or-syms
(
second
(
second
form
))))
(
setf
*toplevel-exports*
(
append
*toplevel-exports*
(
if
(
listp
sym-or-syms
)
sym-or-syms
(
list
sym-or-syms
))))))
(
precompile-toplevel-form
form
stream
compile-time-too
))
(
declaim
(
ftype
(
function
(
t
t
t
)
t
)
process-toplevel-mop.ensure-method
))
(
defun
process-toplevel-mop.ensure-method
(
form
stream
compile-time-too
)
(
declare
(
ignore
stream
))
...
...
@@ -561,7 +572,7 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
(
DEFUN
process-toplevel-defun
)
(
DEFVAR
process-toplevel-defvar/defparameter
)
(
EVAL-WHEN
process-toplevel-eval-when
)
(
EXPORT
pr
ecompile
-toplevel-
f
or
m
)
(
EXPORT
pr
ocess
-toplevel-
exp
or
t
)
(
IMPORT
process-toplevel-import
)
(
IN-PACKAGE
process-toplevel-defpackage/in-package
)
(
LOCALLY
process-toplevel-locally
)
...
...
@@ -697,7 +708,7 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
(
defun
compile-from-stream
(
in
output-file
temp-file
temp-file2
extract-toplevel-funcs-and-macros
functions-file
macros-file
)
functions-file
macros-file
exports-file
)
(
let*
((
*compile-file-pathname*
(
make-pathname
:defaults
(
pathname
in
)
:version
nil
))
(
*compile-file-truename*
(
make-pathname
:defaults
(
truename
in
)
...
...
@@ -776,7 +787,20 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
:if-does-not-exist
:create
:if-exists
:supersede
)
(
let
((
*package*
(
find-package
:keyword
)))
(
write
*toplevel-macros*
:stream
m-out
)))))
(
write
*toplevel-macros*
:stream
m-out
))))
(
setf
*toplevel-exports*
(
remove-if-not
(
lambda
(
sym
)
(
if
(
symbolp
sym
)
(
symbol-package
sym
)
T
))
(
remove-duplicates
*toplevel-exports*
)))
(
when
*toplevel-exports*
(
with-open-file
(
e-out
exports-file
:direction
:output
:if-does-not-exist
:create
:if-exists
:supersede
)
(
let
((
*package*
(
find-package
:keyword
)))
(
write
*toplevel-exports*
:stream
e-out
)))))
(
with-open-file
(
in
temp-file
:direction
:input
)
(
with-open-file
(
out
temp-file2
:direction
:output
:if-does-not-exist
:create
...
...
@@ -863,14 +887,16 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
(
temp-file2
(
pathname-with-type
output-file
type
"-tmp2"
))
(
functions-file
(
pathname-with-type
output-file
"funcs"
))
(
macros-file
(
pathname-with-type
output-file
"macs"
))
(
exports-file
(
pathname-with-type
output-file
"exps"
))
*toplevel-functions*
*toplevel-macros*
*toplevel-exports*
(
warnings-p
nil
)
(
failure-p
nil
))
(
with-open-file
(
in
input-file
:direction
:input
)
(
compile-from-stream
in
output-file
temp-file
temp-file2
extract-toplevel-funcs-and-macros
functions-file
macros-file
))
functions-file
macros-file
exports-file
))
(
values
(
truename
output-file
)
warnings-p
failure-p
))))
(
defun
compile-file-if-needed
(
input-file
&rest
allargs
&key
force-compile
...
...
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