[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv20706

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Fixes for heap dumping.

* swank.lisp (*log-output*): Don't initialize at load-time,
otherwise the stream would end up in a heap image.

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/09 19:57:17	1.1425
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/09 19:57:22	1.1426
@@ -18,6 +18,13 @@
 
 2008-08-09  Helmut Eller  <heller at common-lisp.net>
 
+	Fixes for heap dumping.
+
+	* swank.lisp (*log-output*): Don't initialize at load-time,
+	otherwise the stream would end up in a heap image.
+
+2008-08-09  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-lispworks.lisp (defimplementation): Record location.
 
 2008-08-09  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/swank.lisp	2008/08/09 19:57:12	1.559
+++ /project/slime/cvsroot/slime/swank.lisp	2008/08/09 19:57:22	1.560
@@ -374,12 +374,18 @@
 ;;;;; Logging
 
 (defvar *log-events* nil)
-(defvar *log-output* 
-  (labels ((ref (x)
+(defvar *log-output* nil) ; should be nil for image dumpers
+
+(defun init-log-output ()
+  (labels ((deref (x)
              (cond ((typep x 'synonym-stream)
-                    (ref (symbol-value (synonym-stream-symbol x))))
+                    (deref (symbol-value (synonym-stream-symbol x))))
                    (t x))))
-    (ref *error-output*)))
+    (unless *log-output*
+      (setq *log-output* (deref *error-output*)))))
+
+(add-hook *after-init-hook* 'init-log-output)
+
 (defvar *event-history* (make-array 40 :initial-element nil)
   "A ring buffer to record events for better error messages.")
 (defvar *event-history-index* 0)
@@ -611,6 +617,7 @@
 
 (defun setup-server (port announce-fn style dont-close external-format)
   (declare (type function announce-fn))
+  (init-log-output)
   (let* ((socket (create-socket *loopback-interface* port))
          (local-port (local-port socket)))
     (funcall announce-fn local-port)