Bytte ut ett par assoc mot assq.

Byggde ut perf.el så att den riktigt intressant info.

src/ChangeLog

+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

src/TODO

@@ -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:

src/internal.el

@@ -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

src/perf.el

@@ -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)
+