home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / s / s48.zip / MISC / DEBUGINF.SCM < prev    next >
Text File  |  1992-06-17  |  1KB  |  56 lines
  1. ; Copyright (c) 1992 by Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; Reading/writing debugging info
  5.  
  6. (define (write-debug-info file)
  7.   (call-with-output-file file
  8.     (lambda (port)
  9.       (table-walk (lambda (id name)
  10.             (write (list id (name->symbol name)) port)
  11.             (newline port))
  12.           location-name-table)
  13.       (write '- port) (newline port)
  14.  
  15.       (table-walk (lambda (id data)
  16.             ;; Fields: (uid name parent pc-in-parent
  17.             ;;            env-maps source)
  18.             (write (list id
  19.                  (name->symbol (debug-data-name data))
  20.                  (let ((p (debug-data-parent data)))
  21.                    ;; we'd like to (note-debug-data! p)
  22.                    (if (debug-data? p)
  23.                        (debug-data-uid p)
  24.                        p))
  25.                  (debug-data-pc-in-parent data)
  26.                  (debug-data-env-maps data)
  27.                  ;; Don't retain source code, right?
  28.                  )
  29.                port)
  30.             (newline port))
  31.           debug-data-table)
  32.       (write '- port) (newline port))))
  33.  
  34. (define (read-debug-info file)
  35.   (call-with-input-file file
  36.     (lambda (port)
  37.       (let loop ()
  38.     (let ((z (read port)))
  39.       (if (pair? z)
  40.           (begin ;; (set! *location-uid*
  41.              ;;          (max *location-uid* (+ (car z) 1)))
  42.              (table-set! location-name-table (car z) (cadr z))
  43.              (loop)))))
  44.  
  45.       (let loop ()
  46.     (let ((z (read port)))
  47.       (if (pair? z)
  48.           (begin ;; (set! *template-uid*
  49.              ;;          (max *template-uid* (+ (car z) 1)))
  50.              (table-set! debug-data-table
  51.                  (car z)
  52.                  (apply make-debug-data
  53.                     (append z '(()))))
  54.              (loop))))))))
  55.  
  56.