LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032935. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "WHO-LINE-CONSING" :DIRECTORY ("REL3-PUBLIC" "PUBLIC") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2753216123. :AUTHOR "REL3" :LENGTH-IN-BYTES 3959. :LENGTH-IN-BLOCKS 4. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;; -*- Mode: Common-Lisp; Package: TV; Patch-File: T; Base: 8; Fonts: CPTFONT,HL12B,HL12BI -*-;;;                           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) 1985, Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1986, Douglas Johnson. All rights reserved.#|This file redefines the function which displays the user-id to display the current consing activity instead.  It also displays the lisp mode (common or zeta) and thecurrent base.  The consing is displayed as the number of words consed in the lastsecond (or since the last update of the who line if that was longer than a second). It will display a negative number occasionally when a temporary area (usually theextra PDL) is reset.  This code is provided without warranty or support of any kind. |#(defvar *last-cons-count* 0)(defvar *who-cons-string* (make-array 10 :type :art-string :leader-length 1))(setf (fill-pointer *who-cons-string*) 0)(defvar *last-cons-time* 0)#| WARNING:  I believe this function, WHO-LINE-STRING, *MUST* be loaded before   WHO-LINE-USER-OR-PROCESS which calls it.  Otherwise, a sequence break between   the load of the two functions causes the new WHO-LINE-USER-OR-PROCESS to call   the old WHO-LINE-STRING with an extra argument which causes an error inside the   Scheduler.                                                 - Mac|#(DEFUN WHO-LINE-STRING (WHO-SHEET NEW-STRING &optional force-display)  "Output NEW-STRING on WHO-SHEET, a part of the who line if it has changed or   FORCE-DISPLAY is not nil.  The last value is remembered in the   WHO-LINE-ITEM-STATE instance variable."  (DECLARE (:SELF-FLAVOR WHO-LINE-SHEET))  (SETQ NEW-STRING (STRING NEW-STRING))  (COND ((or force-display (NEQ WHO-LINE-ITEM-STATE NEW-STRING)) (PREPARE-SHEET (WHO-SHEET)   (SHEET-CLEAR WHO-SHEET)   (SHEET-STRING-OUT WHO-SHEET NEW-STRING     0 (MIN (ARRAY-ACTIVE-LENGTH NEW-STRING)    (TRUNCATE (SHEET-INSIDE-WIDTH WHO-SHEET)      (SHEET-CHAR-WIDTH   WHO-SHEET))))) (SETQ WHO-LINE-ITEM-STATE NEW-STRING))))(DEFUN WHO-LINE-USER-OR-PROCESS       (WHO-SHEET &AUX CURRENT-LANGUAGE CURRENT-PRINT-BASE SG)  (DECLARE (:SELF-FLAVOR WHO-LINE-SHEET))  (WHEN (SETQ LAST-WHO-LINE-PROCESS (OR WHO-LINE-PROCESS                                        (AND                                          SELECTED-IO-BUFFER                                          (IO-BUFFER-LAST-OUTPUT-PROCESS                                            SELECTED-IO-BUFFER))))    (when (> (time-difference (time) *last-cons-time*) 60)      (SETQ SG (PROCESS-STACK-GROUP LAST-WHO-LINE-PROCESS))      (COND ((EQ SG %CURRENT-STACK-GROUP)     (SETQ CURRENT-LANGUAGE   SI:*LISP-MODE*   CURRENT-PRINT-BASE *READ-BASE*))    ((TYPEP SG ':STACK-GROUP)     (SETQ CURRENT-LANGUAGE   (SYMEVAL-IN-STACK-GROUP 'SI:*LISP-MODE* SG)   CURRENT-PRINT-BASE (SYMEVAL-IN-STACK-GROUP '*READ-BASE*    SG)))    (T (SETQ CURRENT-LANGUAGE   SI:*LISP-MODE*     CURRENT-PRINT-BASE *READ-BASE*)))      (setf (fill-pointer *who-cons-string*) 0)      (let ((current-consing (time:area-size)))(setf *last-cons-time* (time))(format *who-cons-string* "~5d " (let ((cons  (- current-consing *last-cons-count*)))    (setq tv:*last-cons-count* current-consing)   cons))(string-nconc *who-cons-string* (if (EQ CURRENT-LANGUAGE :ZETALISP) "ZL" "CL"))(FORMAT *who-cons-string* " ~d" CURRENT-PRINT-BASE))        (WHO-LINE-STRING WHO-SHEET  *who-cons-string* t))))                                                ()  (PROGN    (SEND PRINTER-STREAM :STRING-OUT VERSA-CHAR-ARRAY)    (STORE-ARRAY-LEADER 0 VERSA-CHAR-ARRAY 0))) (DEFMETHOD (VERSA 