163 |
(if (consp *split-files*) |
(if (consp *split-files*) |
164 |
(setf (car *split-files*) (+ (third *split-files*) section-length))))) |
(setf (car *split-files*) (+ (third *split-files*) section-length))))) |
165 |
|
|
166 |
|
(defvar *init-name*) |
167 |
|
|
168 |
(defun compile-file1 (input-pathname |
(defun compile-file1 (input-pathname |
169 |
&key (output-file (merge-pathnames *o-ext* input-pathname)) |
&key (output-file (merge-pathnames *o-ext* input-pathname)) |
191 |
nil ;inits |
nil ;inits |
192 |
nil |
nil |
193 |
)) |
)) |
|
*init-name* |
|
194 |
(*fasd-data* *fasd-data*) |
(*fasd-data* *fasd-data*) |
195 |
(*error-count* 0)) |
(*error-count* 0)) |
196 |
(declare (special *c-debug* *init-name* system-p)) |
(declare (special *c-debug* system-p)) |
197 |
(when input-pathname |
(when input-pathname |
198 |
(setq input-pathname (si:search-local-pathname input-pathname))) |
(setq input-pathname (si:search-local-pathname input-pathname))) |
199 |
(when output-file |
(when output-file |
408 |
(values) |
(values) |
409 |
))))) |
))))) |
410 |
|
|
411 |
(defun gazonk-name ( &aux tem) |
(defun gazonk-name () |
412 |
(dotimes (i 1000) |
(dotimes (i 1000) |
413 |
(let ((tem (merge-pathnames (format nil "gazonk~d.lsp" i)))) |
(let ((tem (merge-pathnames (format nil "gazonk~d.lsp" i)))) |
414 |
(unless (probe-file tem) |
(unless (probe-file tem) |
476 |
(setf (macro-function name) (macro-function name)) |
(setf (macro-function name) (macro-function name)) |
477 |
nil) |
nil) |
478 |
((and (setq tem (symbol-function name)) |
((and (setq tem (symbol-function name)) |
479 |
(or (consp tem) (when (typep tem 'interpreted-function) (setq tem (si::interpreted-function-lambda tem)))) |
(or (consp tem) (when (typep tem 'interpreted-function) |
480 |
|
(setq tem (si::interpreted-function-lambda tem)))) |
481 |
(eq (car tem) 'lambda-block)) |
(eq (car tem) 'lambda-block)) |
482 |
(let ((gaz (gazonk-name))) |
(let ((gaz (gazonk-name))) |
483 |
(with-open-file |
(with-open-file |
495 |
(on (get-output-pathname gaz "o" gaz ))) |
(on (get-output-pathname gaz "o" gaz ))) |
496 |
(with-open-file (st cn) |
(with-open-file (st cn) |
497 |
(do () ((let ((a (read-line st))) |
(do () ((let ((a (read-line st))) |
498 |
(when (>= (si::string-match "gazonk[0-9]*.h" a) 0) |
(when (>= (si::string-match |
499 |
|
(load-time-value |
500 |
|
(si::compile-regexp |
501 |
|
#u"gazonk[0-9]*.h")) a) 0) |
502 |
(format t "~%~d~%" a) |
(format t "~%~d~%" a) |
503 |
a)))) |
a)))) |
504 |
(si::copy-stream st *standard-output*)) |
(si::copy-stream st *standard-output*)) |
749 |
; the loading of binary objects on systems relocating with dlopen. |
; the loading of binary objects on systems relocating with dlopen. |
750 |
; |
; |
751 |
|
|
752 |
(defun make-user-init (files outn &aux tem) |
(defun make-user-init (files outn) |
753 |
|
|
754 |
(let* ((c (pathname outn)) |
(let* ((c (pathname outn)) |
755 |
(c (merge-pathnames c (make-pathname :directory '(:current)))) |
(c (merge-pathnames c (make-pathname :directory '(:current)))) |
830 |
new |
new |
831 |
(mysub (subseq str y) it new))))) |
(mysub (subseq str y) it new))))) |
832 |
|
|
833 |
(defun link (files image &optional post extra-libs (run-user-init t) &aux raw init) |
(defun link (files image &optional post extra-libs (run-user-init t)) |
834 |
|
|
835 |
(let* ((ui (make-user-init files "user-init")) |
(let* ((ui (make-user-init files "user-init")) |
836 |
(raw (pathname image)) |
(raw (pathname image)) |