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

Diff of /gcl/cmpnew/gcl_cmpmain.lsp

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

revision 1.20 by mjthomas, Tue Nov 23 07:30:24 2004 UTC revision 1.21 by mjthomas, Wed Nov 24 08:01:22 2004 UTC
# Line 27  Line 27 
27  (in-package 'compiler)  (in-package 'compiler)
28    
29    
30  (export '(*compile-print* *compile-verbose*))  (export '(*compile-print* *compile-verbose* *compile-file-truename* *compile-file-pathname*))
31    
32  ;;; This had been true with Linux 1.2.13 a.out or even older  ;;; This had been true with Linux 1.2.13 a.out or even older
33  ;;; #+linux   (push :ld-not-accept-data  *features*)  ;;; #+linux   (push :ld-not-accept-data  *features*)
# Line 52  Line 52 
52  (defvar *cmpinclude-string* t)  (defvar *cmpinclude-string* t)
53  (defvar *compiler-default-type* #p".lsp")  (defvar *compiler-default-type* #p".lsp")
54  (defvar *compiler-normal-type* #p".lsp")  (defvar *compiler-normal-type* #p".lsp")
55    (defvar *compile-file-truename* nil)
56    (defvar *compile-file-pathname* nil)
57    
58  (defun compiler-default-type (pname)  (defun compiler-default-type (pname)
59    "Set the default file extension (type) for compilable file names."    "Set the default file extension (type) for compilable file names."
# Line 148  Line 150 
150            (let ((gaz (let ((*DEFAULT-PATHNAME-DEFAULTS* (car args)))            (let ((gaz (let ((*DEFAULT-PATHNAME-DEFAULTS* (car args)))
151                                                      (gazonk-name)))                                                      (gazonk-name)))
152                  (*readtable* (si::standard-readtable)))                  (*readtable* (si::standard-readtable)))
153                (setf *compile-file-pathname* (pathname (merge-pathnames gaz)))
154                (setf *compile-file-truename* (truename *compile-file-pathname*))
155              (setq gaz (get-output-pathname gaz "lsp" (car args)))              (setq gaz (get-output-pathname gaz "lsp" (car args)))
156              (with-open-file (st gaz :direction :output)              (with-open-file (st gaz :direction :output)
157                (print                (print
# Line 163  Line 167 
167                 (unless *keep-gaz* (delete-file gaz))))                 (unless *keep-gaz* (delete-file gaz))))
168              ))              ))
169           (t nil))           (t nil))
170       (setf *compile-file-pathname* nil)
171       (setf *compile-file-truename* nil)
172     (if (consp *split-files*)     (if (consp *split-files*)
173         (setf (car *split-files*) (+ (third *split-files*) section-length)))         (setf (car *split-files*) (+ (third *split-files*) section-length)))
174     ))     ))

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

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