Subject: [clisp-list] (DRIBBLE) in debugger

From: Edi Weitz <[email-masked]>
Date: Sat Nov 30 15:15:03 2002

edi@bird:/tmp > clisp
    i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
    I I I I I I I      8     8   8           8     8     o  8    8
    I  \ `+' /  I      8         8           8     8        8    8
     \  `-+-'  /       8         8           8      ooooo   8oooo
      `-__|__-'        8         8           8           8  8
          |            8     o   8           8     o     8  8
    ------+------       ooooo    8oooooo  ooo8ooo   ooooo   8

  Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
  Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
  Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
  Copyright (c) Bruno Haible, Sam Steingold 1999-2002

  ;; Loading file /home/edi/.clisp.lisp ...
  ;;  Loading file /usr/local/lisp/defsystem.fas ...
  ;;  Loaded file /usr/local/lisp/defsystem.fas
  ;; Loaded file /home/edi/.clisp.lisp
  [1]> (dribble "foo")
  #<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"foo" @1>
  [2]> (/ 1 0)

  *** - division by zero
  1. Break [3]> (dribble)
  #<CLOSED OUTPUT BUFFERED FILE-STREAM CHARACTER #P"foo" @1>
  1. Break [3]> :a

  *** - The value of SYSTEM::*DRIBBLE-STREAM* is not a stream: NIL
  1. Break [5]> (quit)

  *** - The value of SYSTEM::*DRIBBLE-STREAM* is not a stream: NIL
  1. Break [6]>

I don't think this is a bug but I'd say it is a bit
uncomfortable. CMUCL shows the same behaviour, LispWorks - on
executing (DRIBBLE) - will automatically take you back to the top
level while AllegroCL just carries on without problems - I think this
is done by setting EXCL::*DRIBBLE-ACTIVE* to NIL.

I prefer ACL's behaviour and think it would be worthwhile to add it to
CLISP.

Cheers,
Edi.

---

From: Sam Steingold <[email-masked]>
Date: Sun Dec 1 16:38:53 2002

> * In message <[email-masked]>
> * On the subject of "[clisp-list] (DRIBBLE) in debugger"
> * Sent on 01 Dec 2002 00:14:07 +0100
> * Honorable Edi Weitz <[email-masked]> writes:
>
>   edi@bird:/tmp > clisp
>   [1]> (dribble "foo")

this is because debug loop binds i/o stream vars which interferes with
dribble "bindings".
basically, starting and stopping dribble should be on the same debug
loop level.

> executing (DRIBBLE) - will automatically take you back to the top

this is not hard to go - just do (UNWIND-TO-DRIVER T) at the beginning
of DRIBBLE.
personally, I would find this behavior inconvenient.

> I prefer ACL's behaviour and think it would be worthwhile to add it to

Instead of the current (quite complicated) implementation, we could
just check SYS::*DRIBBLE-STREAM* whenever a stream action is done on a
strmtype_terminal and act appropriately on SYS::*DRIBBLE-STREAM*.
This will not be too hard to implement.
The drawback is some (probably negligible) slowdown of terminal i/o
(which should not be too important since people generally do not use
terminal to do much i/o).

Bruno, what do you think?

Edi, are you prepared to check out the CVS head and test this change?

-- 
Sam Steingold (http://www.podval.org/~sds) running RedHat8 GNU/Linux
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.palestine-central.com/links.html>
The difference between genius and stupidity is that genius has its limits.

---

From: Edi Weitz <[email-masked]>
Date: Sun Dec 1 17:12:39 2002

> Edi, are you prepared to check out the CVS head and test this

Yep, would be OK with me if you allow for short delays (maybe one to
three days - sometimes I'm quite busy with other things). Let me know
when there's something to test.

Cheers,
Edi.

---

From: Sam Steingold <[email-masked]>
Date: Tue Dec 3 09:20:05 2002

> terminal to do much i/o).

instead I decided that DRIBBLE will change *TERMINAL-IO* (which is not
bound by any other routine).
now you can make a DRIBBLE-STREAM for any i/o stream FOO using
the same idiom:

(setq foo
      (make-dribble-stream foo
                           (open "dribble-file" ...)))

and then restore FOO using

(setq foo (dribble-stream-source foo))

please stress-test this patch.

thanks.

-- 
Sam Steingold (http://www.podval.org/~sds) running RedHat8 GNU/Linux
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.palestine-central.com/links.html>
Failure is not an option. It comes bundled with your Microsoft product.

Index: src/savemem.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/savemem.lisp,v
retrieving revision 1.15
diff -u -w -b -r1.15 savemem.lisp
--- src/savemem.lisp	4 Jun 2002 18:46:54 -0000	1.15
+++ src/savemem.lisp	3 Dec 2002 17:15:08 -0000
@@ -55,7 +55,6 @@
                      *condition-restarts* nil
                      *command-index* 0
                      *home-package* nil)
-               (dribble-reset)
                (setq *driver* old-driver)
                (when init-function (funcall init-function))
                (funcall *driver*))))
Index: src/dribble.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/dribble.lisp,v
retrieving revision 1.4
diff -u -w -b -r1.4 dribble.lisp
--- src/dribble.lisp	2 Dec 2002 00:38:10 -0000	1.4
+++ src/dribble.lisp	3 Dec 2002 17:15:08 -0000
@@ -1,86 +1,54 @@
 ;;;; Dribble
 
+(in-package "EXT")
+(export '(make-dribble-stream dribble-stream-p dribble-stream
+          dribble-stream-source dribble-stream-target))
+
 (in-package "SYSTEM")
 
 ;;-----------------------------------------------------------------------------
 ;; DRIBBLE
 
-;; The use of an intermediate synonym-stream is for robustness.
-;; (Just try dribbling to a file on a full disk partition...)
-(defvar *dribble-stream* nil)
+(defun make-dribble-stream (source target)
+  (make-two-way-stream (make-echo-stream source target)
+                       (make-broadcast-stream source target)))
+(defun dribble-stream-p (stream)
+  (and (sys::two-way-stream-p stream)
+       (let ((in (two-way-stream-input-stream stream))
+             (out (two-way-stream-output-stream stream)))
+         (and (sys::echo-stream-p in) (sys::broadcast-stream-p out)
+              (let ((so (echo-stream-input-stream in))
+                    (ta (echo-stream-output-stream in))
+                    (bl (broadcast-stream-streams out)))
+                (and (eq so (pop bl))
+                     (eq ta (pop bl))))))))
+(deftype dribble-stream () '(satisfies dribble-stream-p))
+(defun dribble-stream-source (ds)
+  (check-type ds dribble-stream)
+  (echo-stream-input-stream (two-way-stream-input-stream ds)))
+(defun dribble-stream-target (ds)
+  (check-type ds dribble-stream)
+  (echo-stream-output-stream (two-way-stream-input-stream ds)))
 
-(let ((dribble-file nil) (dribbled-input nil) (dribbled-output nil)
-      (dribbled-error-output nil) (dribbled-trace-output nil)
-      (dribbled-query-io nil) (dribbled-debug-io nil))
-  (defun dribble-reset ()
-    (setq dribble-file nil dribbled-input nil dribbled-output nil
-          dribbled-error-output nil dribbled-trace-output nil
-          dribbled-query-io nil dribbled-debug-io nil
-          *dribble-stream* nil))
   (defun dribble (&optional file)
-    (if file
-      (if dribble-file
-        (warn (TEXT "Already dribbling to ~S") *dribble-stream*)
-        ;; Dribbling means to redirect all screen output to the file.
-        ;; We redirect all standard streams. More precisely, those
-        ;; which are #<SYNONYM-STREAM *TERMINAL-IO*>. Those which are
-        ;; synonyms to other standard streams indirectly referring
-        ;; to #<SYNONYM-STREAM *TERMINAL-IO*> are not redirected,
-        ;; because that would cause each output to this stream to
-        ;; be written twice to the dribble-file.
-        (labels ((goes-to-terminal (stream) ; this is a hack
-                   (and (typep stream 'synonym-stream)
-                        (eq (synonym-stream-symbol stream) '*terminal-io*)))
-                 (goes-indirectly-to-terminal (stream) ; an even bigger hack
-                   (and (typep stream 'synonym-stream)
-                        (let ((sym (synonym-stream-symbol stream)))
-                          (and (boundp sym)
-                               (let ((stream (symbol-value sym)))
-                                 (or (goes-to-terminal stream)
-                                     (goes-indirectly-to-terminal
-                                      stream))))))))
-          (setq *dribble-stream* (open file :direction :output
+  (if (dribble-stream-p *terminal-io*)
+    (if file                    ; already dribbling
+      (warn (TEXT "Already dribbling to ~S")
+            (dribble-stream-target *terminal-io*))
+      (let ((so (dribble-stream-source *terminal-io*))
+            (ta (dribble-stream-target *terminal-io*)))
+        (setq *terminal-io* so)
+        (write-string (TEXT ";; Dribble finished ") ta)
+        (funcall (date-format) ta (multiple-value-list (get-decoded-time)))
+        (terpri ta) (close ta)
+        ta))
+    (if file                    ; not dribbling
+      (let ((ta (open file :direction :output
                                        :if-exists :append
-                                       :if-does-not-exist :create)
-                dribble-file (make-synonym-stream '*dribble-stream*))
-          (write-string (TEXT ";; Dribble started ") *dribble-stream*)
-          (funcall (date-format) *dribble-stream*
-                   (multiple-value-list (get-decoded-time)))
-          (terpri *dribble-stream*)
-          (macrolet ((save (glo loc type)
-                       `(if (goes-indirectly-to-terminal ,glo)
-                          (setq ,loc nil)
-                          (setq ,loc ,glo
-                                ,glo
-                                ,(ecase type
-                                   (:in `(make-echo-stream
-                                          ,glo dribble-file))
-                                   (:out `(make-broadcast-stream
-                                           ,glo dribble-file))
-                                   (:io `(make-two-way-stream
-                                          (make-echo-stream ,glo dribble-file)
-                                          (make-broadcast-stream
-                                           ,glo dribble-file))))))))
-            (save *standard-input*  dribbled-input        :in)
-            (save *standard-output* dribbled-output       :out)
-            (save *error-output*    dribbled-error-output :out)
-            (save *trace-output*    dribbled-trace-output :out)
-            (save *query-io*        dribbled-query-io     :io)
-            (save *debug-io*        dribbled-debug-io     :io))
-          *dribble-stream*))
-      (if dribble-file
-        (macrolet ((restore (loc glo) `(when ,loc (setq ,glo ,loc ,loc nil))))
-          (restore dribbled-input        *standard-input*)
-          (restore dribbled-output       *standard-output*)
-          (restore dribbled-error-output *error-output*)
-          (restore dribbled-trace-output *trace-output*)
-          (restore dribbled-query-io     *query-io*)
-          (restore dribbled-debug-io     *debug-io*)
-          (setq dribble-file nil)
-          (write-string (TEXT ";; Dribble finished ") *dribble-stream*)
-          (funcall (date-format) *dribble-stream*
-                   (multiple-value-list (get-decoded-time)))
-          (terpri *dribble-stream*)
-          (close *dribble-stream*)
-          (prog1 *dribble-stream* (setq *dribble-stream* nil)))
-        (warn (TEXT "Currently not dribbling."))))))
+                      :if-does-not-exist :create)))
+        (write-string (TEXT ";; Dribble started ") ta)
+        (funcall (date-format) ta (multiple-value-list (get-decoded-time)))
+        (terpri ta)
+        (setq *terminal-io* (make-dribble-stream *terminal-io* ta))
+        ta)
+      (warn (TEXT "Currently not dribbling.")))))

---

From: Sam Steingold <[email-masked]>
Date: Mon Dec 9 10:42:07 2002

> * In message <[email-masked]>
> * On the subject of "Re: [clisp-list] (DRIBBLE) in debugger"
> * Sent on 02 Dec 2002 02:10:23 +0100

you had a week to test the patch.
so, any problems so far?

-- 
Sam Steingold (http://www.podval.org/~sds) running RedHat8 GNU/Linux
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.palestine-central.com/links.html>
Your mouse has moved - WinNT has to be restarted for this to take effect.

---

From: Edi Weitz <[email-masked]>
Date: Wed Dec 11 16:48:07 2002

> you had a week to test the patch.

I was away for a couple of days but I'm back now. I checked out CLISP
from CVS, rebuilt it and tried the example that I sent originally but
got the same results:

  edi@bird:~ > clisp

  [1]> (dribble "frob")
  #<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"frob" @1>
  [2]> (/ 1 0)

  *** - division by zero
  1. Break [3]> (dribble)
  #<CLOSED OUTPUT BUFFERED FILE-STREAM CHARACTER #P"frob" @1>
  1. Break [3]> :a

  1. Break [5]>

Wasn't this supposed to work now? I understand from your explanations
that I can manually make a dribble stream and restore it but I somehow
thought the behaviour described above would also go away.

Cheers,
Edi.

---

From: Sam Steingold <[email-masked]>
Date: Wed Dec 11 18:24:05 2002

> * In message <[email-masked]>
> * Sent on 12 Dec 2002 01:24:00 +0100

I sent a patch to the list.
did you apply it?
the patch was against the release, not the CVS.
if you prefer, you can update cvs now and try again.

-- 
Sam Steingold (http://www.podval.org/~sds) running RedHat8 GNU/Linux
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.palestine-central.com/links.html>
(let((a'(list'let(list(list'a(list'quote a)))a)))`(let((a(quote ,a))),a))

---

From: Edi Weitz <[email-masked]>
Date: Thu Dec 12 02:48:05 2002

> the patch was against the release, not the CVS.

No, sorry, my bad.

> if you prefer, you can update cvs now and try again.

OK, just did 'cvs update' and rebuilt. But it's still as before:

  edi@bird:~ > clisp

  *** - division by zero
  1. Break [3]> (dribble)

---

From: Sam Steingold <[email-masked]>
Date: Thu Dec 12 06:41:04 2002

> * In message <[email-masked]>
> * Sent on 12 Dec 2002 11:47:18 +0100

check that you have no sticky tags.
remove your build directory and reconfigure.

>   *** - The value of SYSTEM::*DRIBBLE-STREAM* is not a stream: NIL

there is no such symbol in the CVS head CLISP.

[2]> (dribble "frob")
[3]> (/ 0)

*** - division by zero
1. Break [4]> (dribble)
1. Break [4]>  
[5]> 

-- 
Sam Steingold (http://www.podval.org/~sds) running RedHat8 GNU/Linux
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.palestine-central.com/links.html>
Save your burned out bulbs for me, I'm building my own dark room.

---

From: Edi Weitz <[email-masked]>
Date: Fri Dec 13 05:12:02 2002

> remove your build directory and reconfigure.

OK, that was it. DRIBBLE now works fine and as I had hoped.

Thanks,
Edi.