/[gcl]/gcl/cmpnew/cmpmain.lsp
ViewVC logotype

Diff of /gcl/cmpnew/cmpmain.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by camm, Wed Feb 26 22:21:35 2003 UTC revision 1.19 by mjthomas, Tue Jul 8 04:20:42 2003 UTC
# Line 45  Line 45 
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*)))
# Line 179  Line 190 
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*)

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26