86 |
(defvar *default-c-file* nil) |
(defvar *default-c-file* nil) |
87 |
(defvar *default-h-file* nil) |
(defvar *default-h-file* nil) |
88 |
(defvar *default-data-file* nil) |
(defvar *default-data-file* nil) |
89 |
|
(defvar *keep-gaz* nil) |
90 |
|
|
91 |
;; (list section-length split-file-names next-section-start-file-position) |
;; (list section-length split-file-names next-section-start-file-position) |
92 |
;; Many c compilers cannot handle the large C files resulting from large lisp files. |
;; Many c compilers cannot handle the large C files resulting from large lisp files. |
139 |
(setq args (append args (list :output-file (car args))))) |
(setq args (append args (list :output-file (car args))))) |
140 |
(return |
(return |
141 |
(prog1 (apply 'compile-file gaz (cdr args)) |
(prog1 (apply 'compile-file gaz (cdr args)) |
142 |
(delete-file gaz))) |
(unless *keep-gaz* (delete-file gaz)))) |
143 |
)) |
)) |
144 |
(t nil)) |
(t nil)) |
145 |
(if (consp *split-files*) |
(if (consp *split-files*) |
396 |
|
|
397 |
|
|
398 |
(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) |
(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) |
399 |
|
|
400 |
(cond ((not(symbolp name)) (error "Must be a name")) |
(cond ((not(symbolp name)) (error "Must be a name")) |
401 |
((and (consp def) |
((and (consp def) |
402 |
(member (car def) '(lambda ))) |
(member (car def) '(lambda ))) |
405 |
def) |
def) |
406 |
(compile name)) |
(compile name)) |
407 |
(def (error "def not a lambda expression")) |
(def (error "def not a lambda expression")) |
408 |
((setq tem(macro-function name)) |
((setq tem (macro-function name)) |
409 |
(setf (symbol-function 'cmp-anon) tem) |
(setf (symbol-function 'cmp-anon) tem) |
410 |
(compile 'cmp-anon) |
(compile 'cmp-anon) |
411 |
(setf (macro-function name) (macro-function name)) |
(setf (macro-function name) (macro-function name)) |
413 |
((and (setq tem (symbol-function name)) |
((and (setq tem (symbol-function name)) |
414 |
(consp tem)) |
(consp tem)) |
415 |
(let ((na (if (symbol-package name) name 'cmp-anon))) |
(let ((na (if (symbol-package name) name 'cmp-anon))) |
416 |
(with-open-file |
(unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon))) |
417 |
(st (setq gaz (gazonk-name)) :direction :output) |
(with-open-file |
418 |
(prin1-cmp `(defun ,na ,@ (ecase (car tem) |
(st (setq gaz (gazonk-name)) :direction :output) |
419 |
(lambda (cdr tem)) |
(prin1-cmp `(defun ,na ,@ (ecase (car tem) |
420 |
(lambda-block (cddr tem)) |
(lambda (cdr tem)) |
421 |
)) st)) |
(lambda-block (cddr tem)) |
422 |
(let ((fi (compile-file gaz))) |
)) st)) |
423 |
(load fi) |
(let ((fi (compile-file gaz))) |
424 |
(delete-file fi) |
(load fi) |
425 |
(delete-file gaz) |
(delete-file fi)) |
426 |
(or (eq na name) (setf (symbol-function name) (symbol-function na))) |
(unless *keep-gaz* (delete-file gaz))) |
427 |
(symbol-function name) |
(or (eq na name) (setf (symbol-function name) (symbol-function na))) |
428 |
))) |
(symbol-function name) |
429 |
|
)) |
430 |
(t (error "can't compile ~a" name)))) |
(t (error "can't compile ~a" name)))) |
431 |
|
|
432 |
(defun disassemble (name &aux tem) |
(defun disassemble (name &aux tem) |
470 |
(delete-file dn) |
(delete-file dn) |
471 |
(delete-file hn) |
(delete-file hn) |
472 |
(delete-file on) |
(delete-file on) |
473 |
(delete-file gaz)))) |
(unless *keep-gaz* (delete-file gaz))))) |
474 |
(t (error "can't disassemble ~a" name)))) |
(t (error "can't disassemble ~a" name)))) |
475 |
|
|
476 |
|
|