45 |
;;If the following is a string, then it is inserted instead of |
;;If the following is a string, then it is inserted instead of |
46 |
;; the include file cmpinclude.h, EXCEPT for system-p calls. |
;; the include file cmpinclude.h, EXCEPT for system-p calls. |
47 |
(defvar *cmpinclude-string* t) |
(defvar *cmpinclude-string* t) |
48 |
|
(defvar *compiler-default-type* #p".lsp") |
49 |
|
(defvar *compiler-normal-type* #p".lsp") |
50 |
|
|
51 |
|
(defun compiler-default-type (pname) |
52 |
|
"Set the default file extension (type) for compilable file names." |
53 |
|
(setf *compiler-default-type* (if (pathnamep pname) |
54 |
|
pname |
55 |
|
(make-pathname :type (string-left-trim "." pname))))) |
56 |
|
|
57 |
|
(defun compiler-reset-type () |
58 |
|
"Set the default file extension (type) to <.lsp>." |
59 |
|
(compiler-default-type *compiler-normal-type*)) |
60 |
|
|
61 |
;; Let the user write dump c-file etc to /dev/null. |
;; Let the user write dump c-file etc to /dev/null. |
62 |
(defun get-output-pathname (file ext name &optional (dir (pathname-directory *default-pathname-defaults*))) |
(defun get-output-pathname (file ext name &optional (dir (pathname-directory *default-pathname-defaults*))) |
190 |
(cond (*compiler-in-use* |
(cond (*compiler-in-use* |
191 |
(format t "~&The compiler was called recursively.~%~ |
(format t "~&The compiler was called recursively.~%~ |
192 |
Cannot compile ~a.~%" |
Cannot compile ~a.~%" |
193 |
(namestring (merge-pathnames input-pathname #".lsp"))) |
(namestring (merge-pathnames input-pathname *compiler-default-type*))) |
194 |
(setq *error-p* t) |
(setq *error-p* t) |
195 |
(return-from compile-file1 (values))) |
(return-from compile-file1 (values))) |
196 |
(t (setq *error-p* nil) |
(t (setq *error-p* nil) |
197 |
(setq *compiler-in-use* t))) |
(setq *compiler-in-use* t))) |
198 |
|
|
199 |
(unless (probe-file (merge-pathnames input-pathname #".lsp")) |
(unless (probe-file (merge-pathnames input-pathname *compiler-default-type*)) |
200 |
(format t "~&The source file ~a is not found.~%" |
(format t "~&The source file ~a is not found.~%" |
201 |
(namestring (merge-pathnames input-pathname #".lsp"))) |
(namestring (merge-pathnames input-pathname *compiler-default-type*))) |
202 |
(setq *error-p* t) |
(setq *error-p* t) |
203 |
(return-from compile-file1 (values))) |
(return-from compile-file1 (values))) |
204 |
|
|
205 |
(when *compile-verbose* |
(when *compile-verbose* |
206 |
(format t "~&Compiling ~a.~%" |
(format t "~&Compiling ~a.~%" |
207 |
(namestring (merge-pathnames input-pathname #".lsp")))) |
(namestring (merge-pathnames input-pathname *compiler-default-type*)))) |
208 |
|
|
209 |
(and *record-call-info* (clear-call-table)) |
(and *record-call-info* (clear-call-table)) |
210 |
|
|
211 |
(with-open-file |
(with-open-file |
212 |
(*compiler-input* (merge-pathnames input-pathname #".lsp")) |
(*compiler-input* (merge-pathnames input-pathname *compiler-default-type*)) |
213 |
|
|
214 |
|
|
215 |
(cond ((numberp *split-files*) |
(cond ((numberp *split-files*) |