56 |
(equal ext "h")) |
(equal ext "h")) |
57 |
(get-output-pathname file ext "Float" )) |
(get-output-pathname file ext "Float" )) |
58 |
(t |
(t |
59 |
(make-pathname :directory (or (and (not (null file)) |
(make-pathname :directory (or (and (not (null file)) |
60 |
(not (eq file t)) |
(not (eq file t)) |
61 |
(pathname-directory file)) |
(pathname-directory file)) |
62 |
dir) |
dir) |
63 |
:name (or (and (not (null file)) |
:name (or (and (not (null file)) |
64 |
(not (eq file t)) |
(not (eq file t)) |
65 |
(pathname-name file)) |
(pathname-name file)) |
66 |
name) |
name) |
67 |
:type ext)))) |
:type ext)))) |
68 |
|
|
69 |
|
|
70 |
(defun safe-system (string) |
(defun safe-system (string) |
439 |
(with-open-file |
(with-open-file |
440 |
(st (setq gaz (gazonk-name)) :direction :output) |
(st (setq gaz (gazonk-name)) :direction :output) |
441 |
(prin1-cmp `(defun ,name ,@ (cddr tem)) st)) |
(prin1-cmp `(defun ,name ,@ (cddr tem)) st)) |
442 |
(let ((fi (compile-file gaz :h-file t :c-file t |
(let ((fi (compile-file gaz |
443 |
:system-p 't |
:c-debug t |
444 |
:data-file t :o-file t))) |
:h-file t |
445 |
(with-open-file (st (get-output-pathname gaz "c" gaz )) |
:c-file t |
446 |
(si::copy-stream st *standard-output*)(delete-file st)) |
:system-p 't |
447 |
(with-open-file (st (get-output-pathname gaz "data" gaz )) |
:data-file t |
448 |
(si::copy-stream st *standard-output*)(delete-file st)) |
:o-file t)) |
449 |
(with-open-file (st (get-output-pathname gaz "h" gaz )) |
(cn (get-output-pathname gaz "c" gaz )) |
450 |
(si::copy-stream st *standard-output*)(delete-file st)) |
(dn (get-output-pathname gaz "data" gaz )) |
451 |
(with-open-file (st |
(hn (get-output-pathname gaz "h" gaz )) |
452 |
(si::string-concatenate |
(on (get-output-pathname gaz "o" gaz ))) |
453 |
"| objdump -d " |
(with-open-file (st cn) |
454 |
(namestring (get-output-pathname gaz "o" gaz )) |
(si::copy-stream st *standard-output*)) |
455 |
" 2>/dev/null || echo No objdump found")) |
(with-open-file (st dn) |
456 |
(si::copy-stream st *standard-output*)) |
(si::copy-stream st *standard-output*)) |
457 |
(delete-file (get-output-pathname gaz "o" gaz )) |
(with-open-file (st hn) |
458 |
(delete-file gaz) |
(si::copy-stream st *standard-output*)) |
459 |
)) |
(system (si::string-concatenate "objdump -d -l " |
460 |
|
(namestring on))) |
461 |
|
(delete-file cn) |
462 |
|
(delete-file dn) |
463 |
|
(delete-file hn) |
464 |
|
(delete-file on) |
465 |
|
(delete-file gaz))) |
466 |
(t (error "can't disassemble ~a" name)))) |
(t (error "can't disassemble ~a" name)))) |
467 |
|
|
468 |
|
|