/[slime]/slime/swank-cmucl.lisp
ViewVC logotype

Diff of /slime/swank-cmucl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.127 by heller, Mon Nov 1 17:18:56 2004 UTC revision 1.128 by heller, Mon Nov 15 22:59:44 2004 UTC
# Line 203  specific functions.") Line 203  specific functions.")
203      ((:force-output :finish-output)      ((:force-output :finish-output)
204       (let ((end (sos.index stream)))       (let ((end (sos.index stream)))
205         (unless (zerop end)         (unless (zerop end)
206           (funcall (sos.output-fn stream) (subseq (sos.buffer stream) 0 end))           (let ((s (subseq (sos.buffer stream) 0 end)))
207           (setf (sos.index stream) 0))))             (setf (sos.index stream) 0)
208               (funcall (sos.output-fn stream) s)))))
209      (:charpos (sos.column stream))      (:charpos (sos.column stream))
210      (:line-length 75)      (:line-length 75)
211      (:file-position nil)      (:file-position nil)
# Line 2058  The `symbol-value' of each element is a Line 2059  The `symbol-value' of each element is a
2059    
2060    ) ;; #+mp    ) ;; #+mp
2061    
2062    
2063    
2064    ;;;; GC hooks
2065    ;;;
2066    ;;; Display GC messages in the echo area to avoid cluttering the
2067    ;;; normal output.
2068    ;;;
2069    
2070    ;; this should probably not be here, but where else?
2071    (defun eval-in-emacs (form)
2072      (let ((sym (find-symbol (string :eval-in-emacs) :swank)))
2073        (funcall sym form)))
2074    
2075    (defun print-bytes (nbytes &optional stream)
2076      "Print the number NBYTES to STREAM in KB, MB, or GB units."
2077      (let ((names '((0 bytes) (10 kb) (20 mb) (30 gb) (40 tb) (50 eb))))
2078        (multiple-value-bind (power name)
2079            (loop for ((p1 n1) (p2 n2)) on names
2080                  while n2 do
2081                  (when (<= (expt 2 p1) nbytes (1- (expt 2 p2)))
2082                    (return (values p1 n1))))
2083          (cond (name
2084                 (format stream "~,1F ~A" (/ nbytes (expt 2 power)) name))
2085                (t
2086                 (format stream "~:D bytes" nbytes))))))
2087    
2088    (defun pre-gc-hook (bytes-in-use)
2089      (let ((msg (format nil "[Commencing GC with ~A in use.]"
2090                         (print-bytes bytes-in-use))))
2091        (eval-in-emacs `(slime-background-message "%s" ,msg))))
2092    
2093    (defun post-gc-hook (bytes-retained bytes-freed trigger)
2094      (force-output)
2095      (let ((msg (format nil "[GC completed. ~A freed  ~A retained  ~A trigger]"
2096                         (print-bytes bytes-freed)
2097                         (print-bytes bytes-retained)
2098                         (print-bytes trigger))))
2099        (eval-in-emacs `(slime-background-message "%s" ,msg))))
2100    
2101    (defun install-gc-hooks ()
2102      (setq ext:*gc-notify-before* #'pre-gc-hook)
2103      (setq ext:*gc-notify-after* #'post-gc-hook))
2104    
2105    (defimplementation emacs-connected ()
2106      (install-gc-hooks))
2107    
2108  ;; Local Variables:  ;; Local Variables:
2109  ;; pbook-heading-regexp:    "^;;;\\(;+\\)"  ;; pbook-heading-regexp:    "^;;;\\(;+\\)"
2110  ;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)"  ;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)"

Legend:
Removed from v.1.127  
changed lines
  Added in v.1.128

  ViewVC Help
Powered by ViewVC 1.1.5