From: Espen S J. <esp...@on...> - 2000-08-08 22:34:30
|
Some issues which came up when I was trying to build C files with defsystem. 1. Specifying language gives correct extensions only when done at the system level. Calling component-extension with nil as local argument instead of t in create-component-pathnames seems to fix this. What exactly is the local argument good for? 2. I belive the type of the compiler and loader slots in the component structure should be (or null symbol function) and not (or null function). 3. In define-language :c, the :loader argument should be #'alien:load-foreign in CMUCL. 4. I have extended c-compile-file with compiler options and also made it behave more like compile-file, especially in CMUCL. Here is a patch with my changes: --- defsystem.lisp-1.21 Sun Aug 6 01:55:09 2000 +++ defsystem.lisp Tue Aug 8 00:17:36 2000 @@ -2061,8 +2061,8 @@ ;; #'load. Unlike fdmm's SET-LANGUAGE macro, this allows a defsystem to ;; mix languages. (language nil :type (or null symbol)) - (compiler nil :type (or null function)) - (loader nil :type (or null function)) + (compiler nil :type (or null symbol function)) + (loader nil :type (or null symbol function)) (compiler-options nil :type list) ; A list of compiler options to ; use for compiling this ; component. These must be @@ -2607,11 +2607,11 @@ ;; Set up extension defaults (setf (component-extension component :source) - (or (component-extension component :source :local t) ; local default + (or (component-extension component :source :local nil) ; local default (when parent ; parent's default (component-extension parent :source)))) (setf (component-extension component :binary) - (or (component-extension component :binary :local t) ; local default + (or (component-extension component :binary :local nil) ; local default (when parent ; parent's default (component-extension parent :binary)))) @@ -3692,20 +3692,105 @@ output-file))) ||# -(defun c-compile-file (filename &rest args &key output-file error-file) - ;; gcc -c foo.c -o foo.o - (declare (ignore args error-file)) - (run-unix-program *c-compiler* - `("-c" ,filename ,@(if output-file `("-o" ,output-file))))) +(defun default-pathname (path1 path2 type) + (etypecase path1 + (null nil) + (pathname path1) + (string (parse-namestring path1)) + ((eql t) + (merge-pathnames + (make-pathname :type type) + (translate-logical-pathname + (etypecase path2 + (pathname path2) + (string (parse-namestring path2)))))))) + + +(defun run-compiler (program arguments output-file error-file error-output + verbose) + #-cmu(declare (ignore error-file error-output)) + (flet ((make-useable-stream (&rest streams) + (apply #'make-broadcast-stream (delete nil streams)))) + (let* (#+cmu + (error-file (default-pathname error-file output-file "err")) + #+cmu + (error-file-stream + (and + error-file + (open error-file :direction :output :if-exists :supersede))) + (verbose-stream + (make-useable-stream + #+cmu error-file-stream (and verbose *standard-input*))) + (old-timestamp (file-write-date output-file))) + + (format verbose-stream "Running ~A~@[ ~{~A~^ ~}~]~%" program arguments) + (let ((fatal-error + #-cmu(and (run-unix-program program arguments) nil) ; can't tell + #+cmu + (let* ((error-output + (make-useable-stream + error-file-stream + (if (eq error-output t) *error-output* error-output))) + (process + (ext:run-program program arguments :error error-output))) + (not (zerop (ext:process-exit-code process)))))) + + (prog1 + (cond + ((and + (probe-file output-file) + (not (eql old-timestamp (file-write-date output-file)))) + (format verbose-stream "~A written~%" output-file) + (values output-file fatal-error fatal-error)) + (t + (values nil fatal-error fatal-error))) + (format verbose-stream "Running of ~A finished~%" program) + #+cmu + (when error-file + (close error-file-stream) + (unless fatal-error (delete-file error-file)))))))) +(defun c-compile-file (filename &rest args &key (output-file t) (error-file t) + (error-output t) (verbose *compile-verbose*) + debug link optimize cflags definitions include-paths + library-paths libraries) + ;; gcc -c foo.c -o foo.o + (declare (ignore args)) + (flet ((map-options (flag options &optional (func #'identity)) + (map + 'list + #'(lambda (option) + (format nil "~A~A" flag (funcall func option))) + options))) + (let* ((output-file (default-pathname output-file filename "o")) + (arguments + `(,@(if (not link) '("-c")) + ,@(if debug '("-g")) + ,@(if optimize (list (format nil "-O~D" optimize))) + ,@cflags + ,@(map-options + "-D" definitions + #'(lambda (definition) + (if (atom definition) + definition + (apply #'format nil "~A=~A" definition)))) + ,@(map-options "-I" include-paths #'truename) + ,(namestring (truename filename)) + "-o" ,(namestring (translate-logical-pathname output-file)) + ,@(map-options "-L" library-paths #'truename) + ,@(map-options "-l" libraries)))) + (run-compiler + *c-compiler* arguments output-file error-file error-output verbose)))) + (define-language :c :compiler #'c-compile-file :loader #+:lucid #'load-foreign-files #+:allegro #'load - #-(or :lucid :allegro) #'load + #+:cmu #'alien:load-foreign + #-(or :lucid :allegro :cmu) #'load :source-extension "c" :binary-extension "o") -- Espen |