Always use unique names for object files.

This commit is contained in:
jjgarcia 2008-09-13 20:06:55 +00:00
parent b1b423956a
commit b05ef138e7
2 changed files with 13 additions and 8 deletions

View file

@ -392,7 +392,7 @@ static cl_object VV[VM];
(when (or (symbolp output-name) (stringp output-name))
(setf output-name (compile-file-pathname output-name :type target)))
(unless init-name
(setf init-name (guess-init-name output-name :kind target)))
(setf init-name (compute-init-name output-name :kind target)))
(ecase target
(:program
(format c-file +lisp-program-init+ init-name "" shared-data-file
@ -558,8 +558,8 @@ static cl_object VV[VM];
(incf (cdr ext:*source-location*))))
(cmpprogress "~&;;; End of Pass 1.")
(setf init-name (guess-init-name output-file :kind
(if system-p :object :fasl)))
(setf init-name (compute-init-name output-file :kind
(if system-p :object :fasl)))
(compiler-pass2 c-pathname h-pathname data-pathname system-p
init-name
shared-data-file)
@ -668,7 +668,7 @@ the environment variable TMPDIR to a different value." template)
(h-pathname (compile-file-pathname data-pathname :type :h))
(o-pathname (compile-file-pathname data-pathname :type :object))
(so-pathname (compile-file-pathname data-pathname))
(init-name (guess-init-name so-pathname :kind :fasl))
(init-name (compute-init-name so-pathname :kind :fasl))
(compiler-conditions nil))
(with-compiler-env (compiler-conditions)
@ -757,7 +757,7 @@ the environment variable TMPDIR to a different value." template)
(apply t3local-fun args))))
(data-init)
(t1expr disassembled-form)
(ctop-write (guess-init-name "foo" :kind :fasl)
(ctop-write (compute-init-name "foo" :kind :fasl)
(if h-file h-file "")
(if data-file data-file ""))
(data-dump data-file))

View file

@ -99,12 +99,17 @@ the function name it precedes."
name))
(defun guess-init-name (pathname &key (kind (guess-kind pathname)))
(if (eq kind :object)
(or (and (probe-file pathname)
(find-init-name pathname))
(error "Cannot find out entry point for binary file" pathname))
(compute-init-name pathname kind)))
(defun compute-init-name (pathname &key (kind (guess-kind pathname)))
(let ((filename (pathname-name pathname)))
(case kind
((:object :c)
(or (and (probe-file pathname)
(find-init-name pathname))
(unique-init-name pathname)))
(unique-init-name pathname))
((:fasl :fas)
(init-function-name "CODE" :kind :fas))
((:static-library :lib)