Införde lyskom-ok-to-send-calls.

Byggde ut perf till att innehålla information om antal anrop etc.

src/ChangeLog

 Sun Jan  4 01:42:08 1998  David Kgedal  <davidk@lysator.liu.se>
 
+	* services.el (lyskom-ok-to-send-new-calls): Ny variabel
+	(blocking-return,blocking-do): Stt den.
+
+	* internal.el (lyskom-check-output-queues): Kolla
+	lyskom-ok-to-send-new-calls.
+
 	* utilities.el (lyskom-next-apo-timeout): Gjorde om till en defun.
 	(lyskom-reset-apo-timeout): Dito.
 	(lyskom-accept-process-output): Dito.

src/internal.el

@@ -358,8 +358,9 @@ Send calls from queues with higher priority first, and make sure that at
 most lyskom-max-pending-calls are sent to the server at the same time."
   (catch 'done
     (let ((i 9))
-      (while (< lyskom-number-of-pending-calls
-		lyskom-max-pending-calls)
+      (while (and lyskom-ok-to-send-new-calls
+		  (< lyskom-number-of-pending-calls
+		     lyskom-max-pending-calls))
 	(while (lyskom-queue-isempty (aref lyskom-output-queues i))
 	  (-- i)
 	  (if (< i 0) (throw 'done nil)))

src/perf.el

@@ -5,27 +5,30 @@
 (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]
-        [apo] [blocking-do]")
+
+ Cache performance
+
+   text:       	       	[text]
+   text-stat:  	       	[text-stat]
+   conf-stat:  	       	[conf-stat]
+   uconf-stat: 	       	[uconf-stat]
+   pers-stat:           [pers-stat]
+   static-session-info: [static-session-info]
+
+ Server calls
+
+   queue 0: [queuelen-0]  [queuenames-0]
+	 3: [queuelen-3]  [queuenames-3]
+	 6: [queuelen-6]  [queuenames-6]
+	 9: [queuelen-9]  [queuenames-9]
+
+   sent:     [sent]    returned: [returned]   pending:  [pending-calls]
+   async:    [async]    errors:   [errors]
+
+ Lisp functions
+
+   call: [in-call]
+	 [apo] [blocking-do]")
 
 (defvar lyskom-prof-buffer nil)
 (defvar lyskom-prof-fields nil)
@@ -96,24 +99,26 @@
     (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)
+(defun lyskom-prof-init-cache ()
+  (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
@@ -121,6 +126,10 @@
 
 (defvar queue-sizes (make-vector 10 0))
 (defvar queue-names (make-vector 10 nil))
+(defvar lyskom-prof-sent 0)
+(defvar lyskom-prof-returned 0)
+(defvar lyskom-prof-async 0)
+(defvar lyskom-prof-errors 0)
 
 (defun lyskom-send-packet (kom-queue string)
   "Send a packet to the server.
@@ -151,8 +160,9 @@ Send calls from queues with higher priority first, and make sure that at
 most lyskom-max-pending-calls are sent to the server at the same time."
   (catch 'done
     (let ((i 9))
-      (while (< lyskom-number-of-pending-calls
-		lyskom-max-pending-calls)
+      (while (and lyskom-ok-to-send-new-calls
+		  (< lyskom-number-of-pending-calls
+		     lyskom-max-pending-calls))
 	(while (lyskom-queue-isempty (aref lyskom-output-queues i))
 	  (-- i)
 	  (if (< i 0) (throw 'done nil)))
@@ -168,7 +178,10 @@ most lyskom-max-pending-calls are sent to the server at the same time."
 			  (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"))
+	  (++ lyskom-prof-sent)
+	  (fields-replace lyskom-prof-fields 'sent
+			  (int-to-string lyskom-prof-sent))))))
   (sit-for 0))
 
 
@@ -205,6 +218,23 @@ most lyskom-max-pending-calls are sent to the server at the same time."
   (sit-for 0))
 
 
+;; Server responses
+
+(defadvice lyskom-parse-success (after stat activate)
+  (++ lyskom-prof-returned)
+  (fields-replace lyskom-prof-fields 'returned
+		  (int-to-string lyskom-prof-returned)))
+
+(defadvice lyskom-parse-async (after stat activate)
+  (++ lyskom-prof-async)
+  (fields-replace lyskom-prof-fields 'async
+		  (int-to-string lyskom-prof-async)))
+
+(defadvice lyskom-parse-error (after stat activate)
+  (++ lyskom-prof-errors)
+  (fields-replace lyskom-prof-fields 'errors
+		  (int-to-string lyskom-prof-errors)))
+
 ;; Misc
 
 
@@ -243,6 +273,11 @@ most lyskom-max-pending-calls are sent to the server at the same time."
   (buffer-disable-undo)
   (erase-buffer)
   (setq lyskom-prof-fields (fields-new lyskom-prof-template))
+  (setq lyskom-prof-sent 0
+	lyskom-prof-returned 0
+	lyskom-prof-async 0
+	lyskom-prof-errors 0)
+  (lyskom-prof-init-cache)
   (if window-system
       (progn
 	(when (not (frame-live-p lyskom-prof-frame))

src/services.el

@@ -1119,9 +1119,21 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
 (defvar lyskom-blocking-return nil
   "Return from blocking-do.")
 
+;; This variable is used to prevent "starvation" of the blocking-do call.
+;; When there are heavy prefetch going on in the background and a
+;; blocking-do call is made there is a good chance that the
+;; accept-process-output call will not return within a reasonable
+;; time, because there will always be data to read from the server,
+;; which means that Emacs will call lyskom-filter instead of returning
+;; from accept-process-output.
+(defvar lyskom-ok-to-send-new-calls t
+  "This variable controls whether calls are passed to the server.
+If it is nil, all outgoing calls are inhibited.")
+
 (defun blocking-return (retval)
   "Sets blocking variable."
-  (setq lyskom-blocking-return retval))
+  (setq lyskom-blocking-return retval
+	lyskom-ok-to-send-new-calls nil))
 
 (defun blocking-do (command &rest data)
   "Does the COMMAND agains the lyskom-server and returns the result.
@@ -1144,11 +1156,21 @@ or get-text-stat."
 				  (symbol-name command)))
 	     'blocking 'blocking-return
 	     data)
+
+      ;; This should not be necessary, but for robustness sake...
+      ;; There are occasions when it is needed.
+      (setq lyskom-ok-to-send-new-calls t)
+
       (while (and (eq lyskom-blocking-return 'not-yet-gotten)
 		  (memq (process-status lyskom-proc) '(open run))
 		  ;; The following test should probably be removed
 		  (not lyskom-quit-flag))
         (lyskom-accept-process-output))
+
+      ;; OK to continue with prefetch and stuff again
+      (setq lyskom-ok-to-send-new-calls t)
+      (lyskom-check-output-queues)
+      
       (if (or lyskom-quit-flag quit-flag)
           (signal 'quit nil))
       (setq lyskom-quit-flag nil)