I/O in Allegro CL multiprocessing code

Recent posting by one Timur Sufiev on slime-devel mailing list about tracing not working in threaded sbcl made me check how it looks for Allegro CL. First I found out what swank does in Allegro backend when you set swank:*globally-redirect-io* in your ~/.swank.lisp. It occurs that it creates a set of bindings in excl:*cl-default-special-bindings* for common stream variables:

• *terminal-io*
• *query-io*
• *debug-io*
• *standard-input*
• *standard-output*
• *trace-output*
• *error-output*

Each of them pointing to a synonym stream connected to current slime session streams. Unfortunately Allegro CL doesn't use this variable on every mp:make-process (or mp:process-run-function wrapper for that matter). Franz treats this variable as a set of sensible defaults which you can use in your own process creating code with the keyword argument :initial-bindings to mp:make-process or mp:process-run-function. OK - I read too much into the documentation :-/ It was all kindly explained to me by a Franz engineer in a swift follow-up to a "bug-report" I submited. Unfortunately there are situations where you don't want or simply can't modify code spawning a subprocess (notable example being hunchentoot or any other MP enabled web server). It would make you patch each and every new release of the software either by modifying the source code or replacing it's internal functions - both things a huge no-no. So - what to do if you really want to direct I/O from a subprocess to your slime session? The answer is pretty simple - use advice or fwrap facility in Allegro CL to instrument mp:process-run-function or mp:make-process invocation to add these defaults when you need it. Here is a relevant snippet:

(excl:def-fwrapper default-special-bindings (&rest args)
 (declare (special user::*provide-initial-bindings*))
 (when (and (boundp 'user::*provide-initial-bindings*)
            user::*provide-initial-bindings*)
   (let ((name-or-args (car args)))
     (when (not (listp name-or-args))
       (setq name-or-args (list :name name-or-args))) ;listify
     (unless (getf name-or-args :initial-bindings)    ;update arglist
       (setf (car args)
             (list* :initial-bindings
                    excl:*cl-default-special-bindings*
                    name-or-args)))))
 (call-next-fwrapper))

(excl:fwrap 'mp:process-run-function 'dsb 'default-special-bindings)

The way you enable this is not complicated as well. Just start the main thread with special variable user::*provide-initial-bindings* bound to non nil value. Like this:

CL-USER> (let ((user::*provide-initial-bindings* t))
         (hunchentoot:start-server))

Now every I/O you you do the above-mentioned streams should appear in your slime repl window. Function tracing of course will work as well.