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

Diff of /gcl/cmpnew/cmpmain.lsp

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

revision 1.9 by mjthomas, Wed Jul 10 07:41:06 2002 UTC revision 1.10 by mjthomas, Thu Jul 11 06:22:36 2002 UTC
# Line 56  Line 56 
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)
# Line 439  Cannot compile ~a.~%" Line 439  Cannot compile ~a.~%"
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    

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

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