Outf-console is now outf-error, writing to stderr.

diff --git a/doc/ffi/ffi.texinfo b/doc/ffi/ffi.texinfo
index e023561a3d77682fc2ee891a2a779d32e69a6b61..b0dbc157a4688cea0bd44873888ff2762bd27aca 100644 (file)
--- a/doc/ffi/ffi.texinfo
+++ b/doc/ffi/ffi.texinfo
@@ -589,14 +589,13 @@ balk at a callback procedure that calls @code{yield-thread}, waits for
 I/O, sleeps, or otherwise causes a thread switch.  Presumably such a
 procedure has some other way of enforcing the LIFO ordering.
 
-The @code{outf-console} procedure is provided for debugging purposes.
+The @code{outf-error} procedure is provided for debugging purposes.
 It writes one or more argument strings (and @code{write}s any
-non-strings) to the console and flushes, atomically, via a machine
+non-strings) to the Unix ``stderr'' channel, atomically, via a machine
 primitive, bypassing the runtime's I/O buffering and thread switching.
-Thus multiple debugging trace messages arrive on the console intact
+Thus trace messages from multiple threads will appear on stderr intact
 and uninterrupted.
 
-
 @node Compiling and Linking, Hello World, Callbacks, Top
 @chapter Compiling and Linking
 

diff --git a/doc/ffi/prhello.scm b/doc/ffi/prhello.scm
index 25caeff5f3b4f565fa84a10f2ac7b25ef50a9003..9ceb62d11f71008984b5fd7461cfe52934743d54 100644 (file)
--- a/doc/ffi/prhello.scm
+++ b/doc/ffi/prhello.scm
@@ -32,7 +32,7 @@ callbacks. |#
              (C-callback "delete_event")       ;trampoline
              (C-callback                       ;callback ID
               (lambda (w e)
-                (outf-console ";Delete me "(- 2 counter)" times.\n")
+                (outf-error ";Delete me "(- 2 counter)" times.\n")
                 (set! counter (1+ counter))
                 ;; Three or more is the charm.
                 (if (> counter 2)

diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm
index 25a9d4bf4d06258c18b02f9f07cf411a9509e5d4..1960c56bd0957bc2b48c6614986a69a4402b0e8e 100644 (file)
--- a/src/gtk/fix-demo.scm
+++ b/src/gtk/fix-demo.scm
@@ -253,7 +253,7 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
 (define-syntax %trace2
   (syntax-rules ()
-    ((_ . ARGS) (if %trace2? ((lambda () (outf-console . ARGS)))))))
\ No newline at end of file
+    ((_ . ARGS) (if %trace2? ((lambda () (outf-error . ARGS)))))))
\ No newline at end of file

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index f2cd57d07f03089712e384dfb5ec616c5673ee4a..932906f1d2ace4bb6272a0014168170ae2fe9b1f 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -1901,10 +1901,10 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
 
 (define %trace2? #f)
 
 (define-syntax %trace2
   (syntax-rules ()
-    ((_ . ARGS) (if %trace2? ((lambda () (outf-console . ARGS)))))))
\ No newline at end of file
+    ((_ . ARGS) (if %trace2? ((lambda () (outf-error . ARGS)))))))
\ No newline at end of file

diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm
index f8b347f62fcdf9da5069c4e3343b7e2223342ace..c389c491d5aa9dde317a271240c4f091f2126716 100644 (file)
--- a/src/gtk/gio.scm
+++ b/src/gtk/gio.scm
@@ -1141,4 +1141,4 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
\ No newline at end of file
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
\ No newline at end of file

diff --git a/src/gtk/gobject.scm b/src/gtk/gobject.scm
index 30f32d8fa4e89658dbca5c290a28b3be85ea2b9f..b1d4d9316ff81baae0c87a72f6bdb5f46f41c7bc 100644 (file)
--- a/src/gtk/gobject.scm
+++ b/src/gtk/gobject.scm
@@ -634,6 +634,6 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
 
 (initialize-package!)
\ No newline at end of file

diff --git a/src/gtk/gtk-ev.scm b/src/gtk/gtk-ev.scm
index 1fbe35899baa1a8888e8d116747bcab217bb619c..28aa48f5698bf4273ef5fc7d4fecb40b4ca0c396 100644 (file)
--- a/src/gtk/gtk-ev.scm
+++ b/src/gtk/gtk-ev.scm
@@ -440,10 +440,10 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
 
 (define %trace2? #f)
 
 (define-syntax %trace2
   (syntax-rules ()
-    ((_ . ARGS) (if %trace2? ((lambda () (outf-console . ARGS)))))))
\ No newline at end of file
+    ((_ . ARGS) (if %trace2? ((lambda () (outf-error . ARGS)))))))
\ No newline at end of file

diff --git a/src/gtk/gtk-object.scm b/src/gtk/gtk-object.scm
index e1b62849d3ff11f3fe4815146d81b53bfe9d214d..ae6214627753c90d440b8711bea342ee7fe20019 100644 (file)
--- a/src/gtk/gtk-object.scm
+++ b/src/gtk/gtk-object.scm
@@ -905,4 +905,4 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
\ No newline at end of file
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
\ No newline at end of file

diff --git a/src/gtk/hello.scm b/src/gtk/hello.scm
index 2c34bdd3b052e6e5e8ddc61964a2c212a992f4a6..951ef2c0bc956afe61586c43a69831827ba0b22f 100644 (file)
--- a/src/gtk/hello.scm
+++ b/src/gtk/hello.scm
@@ -14,7 +14,7 @@ This is Havoc Pennington's Hello World example from GGAD, wrapped in Scheme. |#
       (set-gtk-window-delete-event-callback!
        window
        (lambda (window)
-        (outf-console ";Bite me "(- 2 counter)" times.\n")
+        (outf-error ";Bite me "(- 2 counter)" times.\n")
         (set! counter (1+ counter))
         ;; Three or more is the charm.
         (if (> counter 2) 0 1)))

diff --git a/src/gtk/swat.scm b/src/gtk/swat.scm
index d1c0a5c2bd0b86a6e24a2b95f1ebd66c3083e739..5ab9bedcdf910a115298b39f42c1e554feffe537 100644 (file)
--- a/src/gtk/swat.scm
+++ b/src/gtk/swat.scm
@@ -1224,12 +1224,12 @@ USA.
 
 (define-syntax %trace
   (syntax-rules ()
-    ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS)))))))
+    ((_ . ARGS) (if %trace? ((lambda () (outf-error . ARGS)))))))
 
 (define %trace2? #f)
 
 (define-syntax %trace2
   (syntax-rules ()
-    ((_ . ARGS) (if %trace2? ((lambda () (outf-console . ARGS)))))))
+    ((_ . ARGS) (if %trace2? ((lambda () (outf-error . ARGS)))))))
 
 (initialize-package!)
\ No newline at end of file

diff --git a/src/gtk/thread.scm b/src/gtk/thread.scm
index 67bbbec676157d28425f833f5eccbc9d2851665c..6a65fb86787682bdd29f2c67acb84efd734635a9 100644 (file)
--- a/src/gtk/thread.scm
+++ b/src/gtk/thread.scm
@@ -93,4 +93,4 @@ USA.
 (define-syntax %trace
   (syntax-rules ()
     ((_ . MSG)
-     (if %trace? ((lambda () (outf-console . MSG)))))))
\ No newline at end of file
+     (if %trace? ((lambda () (outf-error . MSG)))))))
\ No newline at end of file

diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index 805d6eb40ca1292e22ec702b5eee0dddfde9c702..bdaab84cc29345c2cbef6408acead17b9b6edd40 100644 (file)
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -1024,9 +1024,10 @@ empty_list (void)
   return (EMPTY_LIST);
 }
 
-DEFINE_PRIMITIVE ("OUTF-CONSOLE", Prim_outf_console, 1, 1, 0)
+DEFINE_PRIMITIVE ("OUTF-ERROR", Prim_outf_error, 1, 1, 0)
 {
-  /* To avoid the normal i/o system when debugging a callback. */
+  /* To avoid the normal i/o system when debugging a callback.  Uses
+     the Unix "stderr" channel. */
 
   PRIMITIVE_HEADER (1);
   { 
@@ -1034,8 +1035,8 @@ DEFINE_PRIMITIVE ("OUTF-CONSOLE", Prim_outf_console, 1, 1, 0)
     if (STRING_P (arg))
       {
        char * string = ((char *) STRING_LOC (arg, 0));
-       outf_console ("%s", string);
-       outf_flush_console ();
+       outf_error ("%s", string);
+       outf_flush_error ();
       }
     else
       {

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index a0714a3711ecc795e7b3869e9d033c5aebb8d759..11ed5e89530017631b150a1583008dffe2e5655f 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -334,14 +334,14 @@ USA.
 (define (call-alien* alien-function args)
   (let ((old-top calloutback-stack))
     (%if-tracing
-     (outf-console ";"(tindent)"=> "alien-function" "args"\n")
+     (outf-error ";"(tindent)"=> "alien-function" "args"\n")
      (set! calloutback-stack (cons (cons* alien-function args) old-top)))
     (let ((value (apply (ucode-primitive c-call -1) alien-function args)))
       (%if-tracing
        (%assert (eq? old-top (cdr calloutback-stack))
                "call-alien: freak stack "calloutback-stack"\n")
        (set! calloutback-stack old-top)
-       (outf-console ";"(tindent)"<= "value"\n"))
+       (outf-error ";"(tindent)"<= "value"\n"))
       value)))
 \f
 
@@ -479,7 +479,7 @@ USA.
     (normalize-aliens! args)
     (let ((old-top calloutback-stack))
       (%if-tracing
-       (outf-console ";"(tindent)"=>> "procedure" "args"\n")
+       (outf-error ";"(tindent)"=>> "procedure" "args"\n")
        (set! calloutback-stack (cons (cons procedure args) old-top)))
       (let ((value (apply-callback-proc procedure args)))
        (%if-tracing
@@ -487,7 +487,7 @@ USA.
                       (eq? old-top (cdr calloutback-stack)))
                  "callback-handler: freak stack "calloutback-stack"\n")
         (set! calloutback-stack old-top)
-        (outf-console ";"(tindent)"<<= "value"\n"))
+        (outf-error ";"(tindent)"<<= "value"\n"))
        value))))
 
 (define (apply-callback-proc procedure args)
@@ -512,8 +512,8 @@ USA.
 
 ;;; For callback debugging:
 
-(define (outf-console . objects)
-  ((ucode-primitive outf-console 1)
+(define (outf-error . objects)
+  ((ucode-primitive outf-error 1)
    (apply string-append
          (map (lambda (o) (if (string? o) o (write-to-string o)))
               objects))))
@@ -565,7 +565,7 @@ USA.
 (define-syntax %trace
   (syntax-rules ()
     ((_ . MSG)
-     (if %trace? ((lambda () (outf-console . MSG)))))))
+     (if %trace? ((lambda () (outf-error . MSG)))))))
 
 (define (tindent)
   (make-string (* 2 (length calloutback-stack)) #\space))
\ No newline at end of file

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 45160b7a5bc13c5f83a31772a54c13a31a8575df..18837dd581ed58fe34f60c52fad867f6674c4801 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3301,7 +3301,7 @@ USA.
          free
          register-c-callback
          de-register-c-callback
-         outf-console)
+         outf-error)
   (initialization (initialize-package!)))
 
 (define-package (runtime program-copier)

diff --git a/src/runtime/thread-queue.scm b/src/runtime/thread-queue.scm
index 6eba438b86c8855822d2200795221c553fb95b5f..56cb81010f573d562141ea187e3cb136b653dea5 100644 (file)
--- a/src/runtime/thread-queue.scm
+++ b/src/runtime/thread-queue.scm
@@ -256,26 +256,26 @@ USA.
   ;; Sets up a "producer" thread that puts the letters of the alphabet
   ;; into a thread-queue, one each 2-3 seconds.  A "consumer" thread
   ;; waits on the queue, printing what it reads.
-  (outf-console ";Thread Queue Test\n")
+  (outf-error ";Thread Queue Test\n")
   (let ((queue (make-thread-queue)))
     (create-thread
      #f
      (lambda ()
-       (outf-console ";    Consumer: "(current-thread)"\n")
+       (outf-error ";    Consumer: "(current-thread)"\n")
        (let loop ()
-        (outf-console ";    Consumer reads.\n")
+        (outf-error ";    Consumer reads.\n")
         (let ((item (thread-queue/dequeue! queue)))
-          (outf-console ";    Consumer read "item"\n")
+          (outf-error ";    Consumer read "item"\n")
           (loop)))))
     (create-thread
      #f
      (lambda ()
-       (outf-console ";    Producer: "(current-thread)"\n")
+       (outf-error ";    Producer: "(current-thread)"\n")
        (for-each (lambda (item)
-                  (outf-console ";    Producer: sleeping...\n")
+                  (outf-error ";    Producer: sleeping...\n")
                   (sleep-current-thread 2000)
-                  (outf-console ";    Producer: queuing "item"...\n")
+                  (outf-error ";    Producer: queuing "item"...\n")
                   (thread-queue/queue! queue item)
-                  (outf-console ";    Producer: queued "item"\n"))
+                  (outf-error ";    Producer: queued "item"\n"))
                 '(#\a #\b #\c #\d #\e))
-       (outf-console ";    Producer done.\n")))))
\ No newline at end of file
+       (outf-error ";    Producer done.\n")))))
\ No newline at end of file

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 8c6bce041a5ed664d408efde64b4f8925cfa78c3..75bf4cd78178ee66a1f32fe5fb9bb7943679cdcf 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -329,7 +329,7 @@ USA.
 (define-syntax %trace
   (syntax-rules ()
     ((_ . MSG)
-     (if %trace? ((lambda () (outf-console . MSG)))))))
+     (if %trace? ((lambda () (outf-error . MSG)))))))
 
 (define (yield-current-thread)
   (without-interrupts