LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031328. :SYSTEM-TYPE :LOGICAL :VERSION 13. :TYPE "LISP" :NAME "DRIBBL" :DIRECTORY ("REL3-SOURCE" "IO") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758637281. :AUTHOR "REL3" :LENGTH-IN-BYTES 7125. :LENGTH-IN-BLOCKS 7. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ;;; -*- Mode:Common-LISP; Package:SYSTEM-INTERNALS; Lowercase:T; Base:10. -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;; Copyright (c) 1980 Massachusetts Institute of Technology ;; Copyright (c) 1984,1987 Texas Instruments Incorporated.  All Rights Reserved.;;; 04.15.87 DAB Fixed Dribble-end error trying to throw with no catch.(DEFUN DRIBBLE (&OPTIONAL FILENAME)  "Sends input and output to a dribble file, FILENAME by rebinding *STANDARD-OUTPUT* and *STANDARD-INPUT*.  With no arg, exits a previously entered DRIBBLE and closes the dribble file.To rebind *TERMINAL-IO*, see DRIBBLE-ALL"  (IF FILENAME    (DRIBBLE-START FILENAME)    (DRIBBLE-END)))  ;This binds STANDARD-OUTPUT and STANDARD-INPUT and enters a new read-eval-print;loop.  SETQ'ing them would be global for all processes and would leave you;totally shafted if the file connection broke.(DEFUN DRIBBLE-START (FILENAME &OPTIONAL EDITOR-P)  "Sends input and output to a file or an file editor buffer, if second arg is T.  Rebinds *STANDARD-OUTPUT* and *STANDARD-INPUT*.  With no arg, exits a previously entered DRIBBLE and closes the dribble file.To rebind *TERMINAL-IO*, see DRIBBLE-ALL"  (IF (AND (NULL FILENAME) (NULL EDITOR-P))    (DRIBBLE-END)    (PROGN      (FORMAT T "~&Entering Dribble Read-Eval-Print Loop.  Type (DRIBBLE) to exit.")      (LET* ((DRIBBLE-STREAM      (MAKE-DRIBBLE-STREAM *TERMINAL-IO*   (IF (NOT EDITOR-P)     (OPEN FILENAME :DIRECTION :OUTPUT :ERROR :REPROMPT)     (ZWEI:MAKE-FILE-BUFFER-STREAM FILENAME))))     (*STANDARD-INPUT* DRIBBLE-STREAM)     (*STANDARD-OUTPUT* DRIBBLE-STREAM))(UNWIND-PROTECT (CATCH 'DRIBBLE-END (IF (AND (GET 'UCL::BASIC-COMMAND-LOOP 'FLAVOR)     (TYPEP *TERMINAL-IO* 'UCL::BASIC-COMMAND-LOOP)     (ZEROP EH::ERROR-DEPTH))   (UCL-DRIBBLE-LOOP *TERMINAL-IO*)   (LISP-TOP-LEVEL1 *TERMINAL-IO*)))  (SEND *STANDARD-OUTPUT* :DRIBBLE-END))))))  (DEFUN DRIBBLE-ALL (&OPTIONAL FILENAME EDITOR-P)  "Sends input and output to a file or a file editor buffer,if second arg is T.  This differs from DRIBBLE and DRIBBLE-START in that it rebinds *TERMINAL-IO*, not just *STANDARD-INPUT* and *STANDARD-OUTPUT*,so that queries, break loops, etc. are also included.With no argument, exits a previously entered DRIBBLE-ALL and closes the file."  (IF (AND (NULL FILENAME) (NULL EDITOR-P))    (DRIBBLE-END)    (PROGN      (FORMAT T "~&Entering Dribble Read-Eval-Print Loop.  Type (DRIBBLE-END) to exit.")      (LET* ((DRIBBLE-STREAM      (MAKE-DRIBBLE-STREAM *TERMINAL-IO*   (IF (NOT EDITOR-P)     (OPEN FILENAME :DIRECTION :OUTPUT :ERROR :REPROMPT)     (ZWEI:MAKE-FILE-BUFFER-STREAM FILENAME))))     (*STANDARD-INPUT* DRIBBLE-STREAM)     (*STANDARD-OUTPUT* DRIBBLE-STREAM))(UNWIND-PROTECT (CATCH 'DRIBBLE-END  (COND    ((AND (GET 'UCL::BASIC-COMMAND-LOOP 'FLAVOR)(TYPEP *TERMINAL-IO* 'UCL::BASIC-COMMAND-LOOP)(ZEROP EH::ERROR-DEPTH))     (UCL-DRIBBLE-LOOP DRIBBLE-STREAM))    ((AND (BOUNDP 'UCL::THIS-APPLICATION) UCL::THIS-APPLICATION)     (UCL-DRIBBLE-LOOP DRIBBLE-STREAM UCL::THIS-APPLICATION))    (T (LISP-TOP-LEVEL1 DRIBBLE-STREAM)))) ;; Do this with old definition of *terminal-io*, in case it gets an error.  (SEND DRIBBLE-STREAM :DRIBBLE-END))))))  (DEFUN UCL-DRIBBLE-LOOP (*TERMINAL-IO* &OPTIONAL (UCL-APPLICATION *TERMINAL-IO*))  (CATCH 'UCL::EXIT-COMMAND-LOOP    (ERROR-RESTART-LOOP ((ERROR ABORT) "Return to the Dribble command loop.")       (CONDITION-CASE () (CATCH 'UCL::COMMAND-ABORT    (SEND UCL-APPLICATION :FETCH-AND-EXECUTE))  (ABORT (SEND UCL-APPLICATION :HANDLE-PROMPT))))))  (DEFUN DRIBBLE-END ()  "Exit from the recursive read-eval-print loop entered by DRIBBLE-START or DRIBBLE-ALL."  (and (closurep *standard-input*)  ;check to make sure you are in a dribble loop. 04.15.87 DAB       (member 'dribble-stream (closure-alist *standard-input*) :key #'car :test #'eq)    (THROW 'DRIBBLE-END   ())))  (DEFUN MAKE-DRIBBLE-STREAM (TV-STREAM FILE-STREAM)  (LET ((*RUBOUT-HANDLER-BUFFER* (MAKE-ARRAY 100. :ELEMENT-TYPE 'STRING-CHAR :FILL-POINTER 0.))(DRIBBLE-STREAM)(*TV-STREAM* TV-STREAM)(*FILE-STREAM* FILE-STREAM))    (DECLARE (SPECIAL *TV-STREAM* *FILE-STREAM* DRIBBLE-STREAM *RUBOUT-HANDLER-BUFFER*))    (SETQ DRIBBLE-STREAM  (CLOSURE '(*TV-STREAM* *FILE-STREAM* *RUBOUT-HANDLER-BUFFER* DRIBBLE-STREAM)   'DRIBBLE-STREAM-IO))))  (DEFUN DRIBBLE-STREAM-IO (OP &REST ARGS)  (DECLARE (SPECIAL *TV-STREAM* *FILE-STREAM* DRIBBLE-STREAM *RUBOUT-HANDLER-BUFFER*))  (CASE    OP    ((:ANY-TYO :TYO) (APPLY *TV-STREAM* OP ARGS) (FUNCALL *FILE-STREAM* OP (CAR ARGS)))    ((:STRING-OUT :LINE-OUT) (APPLY *TV-STREAM* OP ARGS)     (APPLY *FILE-STREAM* OP (STRING (CAR ARGS)) (CDR ARGS)))    (:FRESH-LINE (FUNCALL *TV-STREAM* OP) (FUNCALL *FILE-STREAM* OP))    ((:ANY-TYI :TYI :TYI-NO-HANG :ANY-TYI-NO-HANG)     (BLOCK       NIL       (OR RUBOUT-HANDLER (SEND *FILE-STREAM* :SEND-IF-HANDLES :FORCE-OUTPUT))       (CATCH (IF RUBOUT-HANDLER 'RUBOUT-HANDLER 'DUMMY-TAG) (LET ((CH (SEND *TV-STREAM* OP)))   (AND CHRUBOUT-HANDLER(VECTOR-PUSH-EXTEND (IF (LISTP CH) (CADR CH) CH)    *RUBOUT-HANDLER-BUFFER*))   (RETURN CH)))       (STORE-ARRAY-LEADER 0 *RUBOUT-HANDLER-BUFFER* 0)       (THROW 'RUBOUT-HANDLER NIL)       NIL))    (:UNTYI (SEND *TV-STREAM* :UNTYI (CAR ARGS))    (AND RUBOUT-HANDLER (PLUSP (LENGTH *RUBOUT-HANDLER-BUFFER*)) (DECF (ARRAY-LEADER *RUBOUT-HANDLER-BUFFER* 0))))    ((:RUBOUT-HANDLER :PREEMPTABLE-READ)     (STORE-ARRAY-LEADER 0 *RUBOUT-HANDLER-BUFFER* 0)     (PROG (VALS)   (SETQ VALS (MULTIPLE-VALUE-LIST (APPLY *TV-STREAM* OP ARGS)))   (SEND *FILE-STREAM* :STRING-OUT *RUBOUT-HANDLER-BUFFER*)   (SEND *FILE-STREAM* :SEND-IF-HANDLES :FORCE-OUTPUT)   (RETURN (VALUES-LIST VALS))))    (:DRIBBLE-END (FORMAT *TV-STREAM*  "~&Closing dribble file, ~A.~%"  (SEND *FILE-STREAM* :TRUENAME))  (CLOSE *FILE-STREAM*)  (SEND *FILE-STREAM* :SEND-IF-HANDLES :TRUENAME))    (:NOTICE (IF (SEND *TV-STREAM* :OPERATION-HANDLED-P :NOTICE) (APPLY *TV-STREAM* :NOTICE ARGS) 'COLD-LOAD-STREAM))    (:INCREMENT-CURSORPOS (COND ((EQ (CADDR ARGS) :CHARACTER) (DOTIMES (Y-INCREMENT  (CADR ARGS))   (SEND *FILE-STREAM* :TYO #\NEWLINE)) (DOTIMES (X-INCREMENT  (CAR ARGS))   (SEND *FILE-STREAM* :TYO #\SPACE))))  (APPLY *TV-STREAM* OP ARGS))    ((:FINISH :FORCE-OUTPUT) (APPLY *FILE-STREAM* :SEND-IF-HANDLES OP ARGS)     (APPLY *TV-STREAM* OP ARGS))    (:SEND-IF-HANDLES (APPLY *FILE-STREAM* :SEND-IF-HANDLES OP ARGS)      (APPLY *TV-STREAM* OP ARGS))    (OTHERWISE (APPLY *TV-STREAM* OP ARGS))))Data buffer length in Qs)         |      ov