Commit 31e4fd17 authored by David Kågedal's avatar David Kågedal
Browse files

Bytte ut ett par assoc mot assq.

Byggde ut perf.el så att den riktigt intressant info.
parent fad4385b
Sat Jan 3 22:25:51 1998 David Kgedal <davidk@lysator.liu.se>
* internal.el (lyskom-halt,lyskom-resume): Anvnd assq istllet
fr assoc.
Thu Dec 25 10:39:23 1997 David Byers <dbyers@atp>
* lyskom-buttons.el (lyskom-button-open-email): Anvnd
......
......@@ -313,6 +313,7 @@ Att g
Har detta att göra med lite för optimistisk cache att göra? Kanske
bör man läsa om person-staten innan man varnar för lapp på dörren?
[Det gör man väl? /davidk]
Använd blocking.el som innehåller en reentrant blocking-do.
......@@ -382,6 +383,8 @@ Att g
prioritetsordning. Prefetchen måste kunna sortera in medlemsskap i
prioritetsordning när den får dem från servern.
Det finns rester av den gamla vilkabufferten kvar i koden i cache.el.
Local variables:
......
......@@ -229,7 +229,7 @@ all previous calls to the server via KOM-QUEUE have been handled."
(defun lyskom-halt (queue-name)
"Prohibit execution of handlers on QUEUE-NAME.
The execution will resume when (lyskom-resume KOM-QUEUE) is called."
(let ((queue-pair (assoc queue-name lyskom-call-data)))
(let ((queue-pair (assq queue-name lyskom-call-data)))
(if (null queue-pair)
(setq queue-pair (lyskom-add-new-queue queue-name)))
(kom-queue-halt (cdr queue-pair))))
......@@ -238,7 +238,7 @@ The execution will resume when (lyskom-resume KOM-QUEUE) is called."
(defun lyskom-resume (kom-queue)
"Resume execution of waiting handlers on KOM-QUEUE.
See documentation for lyskom-halt."
(let ((queue (assoc kom-queue lyskom-call-data)))
(let ((queue (assq kom-queue lyskom-call-data)))
(cond
((null queue) ;A new kom-queue?
(signal 'lyskom-internal-error
......
......@@ -4,6 +4,31 @@
(require 'lyskom)
(defvar lyskom-prof-template "\
text: [text]
text-stat: [text-stat]
conf-stat: [conf-stat]
uconf-stat: [uconf-stat]
pers-stat: [pers-stat]
static-session-info: [static-session-info]
pending calls: [pending-calls]
Queues 0: [queuelen-0] [queuenames-0]
1: [queuelen-1] [queuenames-1]
2: [queuelen-2] [queuenames-2]
3: [queuelen-3] [queuenames-3]
4: [queuelen-4] [queuenames-4]
5: [queuelen-5] [queuenames-5]
6: [queuelen-6] [queuenames-6]
7: [queuelen-7] [queuenames-7]
8: [queuelen-8] [queuenames-8]
9: [queuelen-9] [queuenames-9]
call: [in-call]")
(defvar lyskom-prof-buffer nil)
(defvar lyskom-prof-fields nil)
(defun fields-new (string)
(let ((fields nil))
(while (string-match "\\[" string)
......@@ -37,45 +62,27 @@
(require 'advice)
;; (require 'fields)
;;; Cache statistics
(defvar lyskom-caches-stat '(text text-stat pers-stat uconf-stat conf-stat
static-session-info))
(mapcar (lambda (cache)
(put cache 'cache-hits 0)
(put cache 'cache-misses 0)
(put cache 'cache-prefetch-hits 0)
(put cache 'cache-prefetch-misses 0)
(let ((cache-fun (intern (concat "cache-get-" (symbol-name cache)))))
(eval
`(defadvice ,cache-fun (after stat activate)
"Collect statistics about cache hits."
(if lyskom-inhibit-prefetch
(if ad-return-value
(cache-prefetch-hit ',cache)
(cache-prefetch-miss ',cache))
(if ad-return-value
(cache-hit ',cache)
(cache-miss ',cache)))
ad-return-value))))
lyskom-caches-stat)
(defun cache-hit (what)
(put what 'cache-hits (1+ (get what 'cache-hits)))
(fields-replace cache-info-fields what (cache-format what)))
(fields-replace lyskom-prof-fields what (cache-format what)))
(defun cache-miss (what)
(put what 'cache-misses (1+ (get what 'cache-misses)))
(fields-replace cache-info-fields what (cache-format what)))
(fields-replace lyskom-prof-fields what (cache-format what)))
(defun cache-prefetch-hit (what)
(put what 'cache-prefetch-hits (1+ (get what 'cache-prefetch-hits)))
(fields-replace cache-info-fields what (cache-format what)))
(fields-replace lyskom-prof-fields what (cache-format what)))
(defun cache-prefetch-miss (what)
(put what 'cache-prefetch-misses (1+ (get what 'cache-prefetch-misses)))
(fields-replace cache-info-fields what (cache-format what)))
(fields-replace lyskom-prof-fields what (cache-format what)))
(defun cache-format (what)
(let* ((hits (get what 'cache-hits))
......@@ -87,8 +94,31 @@
(format "%d hits, %d misses (%d%%) prefetch: %d/%d"
hits misses hitrate phits pmisses)))
(mapcar (lambda (cache)
(put cache 'cache-hits 0)
(put cache 'cache-misses 0)
(put cache 'cache-prefetch-hits 0)
(put cache 'cache-prefetch-misses 0)
(let ((cache-fun (intern (concat "cache-get-" (symbol-name cache)))))
(eval
`(defadvice ,cache-fun (after stat activate)
"Collect statistics about cache hits."
(if lyskom-inhibit-prefetch
(if ad-return-value
(cache-prefetch-hit ',cache)
(cache-prefetch-miss ',cache))
(if ad-return-value
(cache-hit ',cache)
(cache-miss ',cache)))
ad-return-value))))
lyskom-caches-stat)
;;; Queue statistics
(defvar queue-sizes (make-vector 10 0))
(defvar queue-names (make-vector 10 nil))
(defun lyskom-send-packet (kom-queue string)
"Send a packet to the server.
......@@ -101,17 +131,17 @@ Args: KOM-QUEUE STRING."
(lyskom-queue-enter (aref lyskom-output-queues pri)
(cons lyskom-ref-no string))
(aset queue-sizes pri sz)
(fields-replace cache-info-fields
(intern (concat "queue" (int-to-string pri)))
(format "%d" sz)))
(setq lyskom-pending-calls
(cons (cons lyskom-ref-no kom-queue)
lyskom-pending-calls))
(++ lyskom-ref-no)
;; Send something from the output queues
(lyskom-check-output-queues)
(sit-for 0))
(fields-replace lyskom-prof-fields
(intern (concat "queuelen-" (int-to-string pri)))
(format "%d" sz))
(setq lyskom-pending-calls
(cons (cons lyskom-ref-no kom-queue)
lyskom-pending-calls))
(++ lyskom-ref-no)
;; Send something from the output queues
(sit-for 0) ;; (if (= pri 9) 0.5 0))
(lyskom-check-output-queues)))
(defun lyskom-check-output-queues ()
"Check for pending calls to the server.
......@@ -129,47 +159,79 @@ most lyskom-max-pending-calls are sent to the server at the same time."
(sz (1- (aref queue-sizes i))))
(++ lyskom-number-of-pending-calls)
(aset queue-sizes i sz)
(fields-replace cache-info-fields
(intern (concat "queue" (int-to-string i)))
(fields-replace lyskom-prof-fields
(intern (concat "queuelen-" (int-to-string i)))
(format "%d" sz))
(fields-replace lyskom-prof-fields 'pending-calls
(int-to-string lyskom-number-of-pending-calls))
(lyskom-process-send-string
lyskom-proc
(concat (car entry) (cdr entry) "\n")))))))
(concat (car entry) (cdr entry) "\n"))))))
(sit-for 0))
;; (defadvice lyskom-check-output-queues (before stat activate)
;; (fields-replace cache-info-fields
;; 'pending-calls
;; (int-to-string lyskom-number-of-pending-calls)))
(defvar cache-info-template "\
text: [text]
text-stat: [text-stat]
conf-stat: [conf-stat]
uconf-stat: [uconf-stat]
pers-stat: [pers-stat]
static-session-info: [static-session-info]
pending calls: [pending-calls]
(defun lyskom-prof-set-queue-priority (queue-name priority)
(let ((oldpri (get queue-name 'lyskom-queue-priority)))
(when oldpri
(aset queue-names oldpri (delq queue-name (aref queue-names oldpri)))
(fields-replace lyskom-prof-fields
(intern (concat "queuenames-" (int-to-string oldpri)))
(mapconcat 'symbol-name (aref queue-names oldpri) ","))))
(aset queue-names priority (cons queue-name (aref queue-names priority)))
(fields-replace lyskom-prof-fields
(intern (concat "queuenames-" (int-to-string priority)))
(mapconcat 'symbol-name (aref queue-names priority) ",")))
(defadvice lyskom-set-queue-priority (before stat activate)
(lyskom-prof-set-queue-priority queue-name priority)
(sit-for 0))
(defadvice lyskom-add-new-queue (before stat activate)
(let ((pri (get queue-name 'lyskom-queue-priority)))
(when (null pri)
(ding)
(message "Queue %S has no priority" queue-name))
(lyskom-prof-set-queue-priority queue-name (or pri 0))))
(defadvice lyskom-decrease-pending-calls (after stat activate compile)
(fields-replace lyskom-prof-fields
'pending-calls
(int-to-string lyskom-number-of-pending-calls))
(sit-for 0))
Queues 0: [queue0]
1: [queue1]
2: [queue2]
3: [queue3]
4: [queue4]
5: [queue5]
6: [queue6]
7: [queue7]
8: [queue8]
9: [queue9]")
(defvar cache-info-buffer nil)
(defvar cache-info-fields nil)
(progn
(setq cache-info-buffer (generate-new-buffer "LysKOM cache"))
(set-buffer cache-info-buffer)
;; Misc
(defadvice lyskom-prefetch-map-handler (around stat activate)
(fields-replace lyskom-prof-fields 'in-call "lyskom-prefetch-map-handler")
(sit-for 0)
ad-do-it
(fields-replace lyskom-prof-fields 'in-call "")
(sit-for 0))
;; Initialazation
(defun lyskom-prof-init ()
(interactive)
(setq lyskom-prof-buffer (get-buffer-create "LysKOM profile"))
(set-buffer lyskom-prof-buffer)
(buffer-disable-undo)
(erase-buffer)
(setq cache-info-fields (fields-new cache-info-template))
(let ((w (selected-window)))
(split-window nil 8)
(set-window-buffer w cache-info-buffer)
(select-window w)))
(setq lyskom-prof-fields (fields-new lyskom-prof-template))
(if window-system
(progn
(select-frame (make-frame '((height . 22))))
(display-buffer lyskom-prof-buffer))
(let ((w (selected-window)))
(split-window nil 8)
(set-window-buffer w lyskom-prof-buffer)
(select-window w))))
(lyskom-prof-init)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment