(in-package :cl-user)

(defun print-shark-spatch-record (symbol &optional (stream t))
  (when (fboundp symbol)
    (let ((cl (find-package "COMMON-LISP-USER"))
          (package (symbol-package symbol))
          (name (symbol-name symbol))
          (fn (fdefinition symbol)))
      (let* ((startaddr (- (ccl::%address-of (uvref fn 0)) 2))
             (endaddr (+ startaddr #x32b)))
        ;; i hope all lisp sym characters are allowed... we'll see
        (format stream "{~@
                        ~@[~a~]~@[~[_~;__~]~]~a~@
                        0x~8,'0x~@
                        0x~8,'0x~@
                        }~%"
                (unless (eq package cl) (string-downcase (package-name package)))
                (unless (eq package cl)
                  (multiple-value-bind (symbolpkg status)
				       (find-symbol name (symbol-package symbol))
                    (if (eq :external status) 0 1)))
                (string-downcase name)
                startaddr
                endaddr)))))

(defun print-shark-spatch-file (&optional packages)
  (ccl::purify)
  (with-open-file (f (format nil "dppccl_~D.spatch" (ccl::getpid))
		     :direction :output
		     :if-exists :supersede)
    (format f "!SHARK_SPATCH_BEGIN~%")
    (loop for symbol being each external-symbol in "CL"
	 do
	 (print-shark-spatch-record symbol f))
    (loop for package in packages do
	 (loop for symbol being each symbol in package
	      do
	      (print-shark-spatch-record symbol f)))
    (format f "!SHARK_SPATCH_END~%")
    t))