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*) |
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." |
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 |
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 |
)) |
)) |