[Openmcl-devel] Help with error: [Stacks reset due to overflow.]

Barry Perryman gekki_uk at hotmail.com
Sun May 18 18:50:13 UTC 2003


Hi,

I am having some problems with the finger server, from the samples folder, 
and multiple processes. This code has been tidied up a bit and included at 
the end.

The ideas was to try out the new native processes with a simple "stress 
test" type app that would start n threads and just make multiple finger 
queries to a server. This would be done in both lisp processes and native 
threads, and then repeated using thread/process pooling.

When I run this I get the following error:

;[Stacks reset due to overflow.]

in Lisp processes this seems to continue quite nicely after the reset - I 
haven't examined the data, but the load on the processor continues and there 
is information being shipped across the network. In native threads this 
error does not show and there is no graceful recovery the load on the 
processor stops and so does any further network traffic - to be expected I 
guess.

My problems is that I've never seen this type of error and I don't have the 
first clue about what could be causing it, and where to look to rectify the 
situation. I've looked for resource leaks and I can't see any; it could be 
simple and that I've got code blindness, but even re-working the some of the 
code to tidy up my previous hacks didn't help.

If anybody could offer up any pointers it would be appreciated.

Barry


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; finger code + server

(defconstant +input-buffer-size+ 1024
  "Size of the input buffer used by read-sequence.")

(defun write-net-line (line stream)
  "Write out the string line to the stream, terminating with CRLF."
  (format stream "~a~c~c" line #\return #\linefeed))

(defun read-net-line (stream)
  "Read a line from stream."
  (let ((line (make-array 10 :element-type 'character :adjustable t 
:fill-pointer 0)))
    (do ((c (read-char stream nil nil) (read-char stream nil nil)))
	((or (null c)
	     (and (char= c #\return)
		  (char= (peek-char nil stream nil nil) #\linefeed)))
	 (progn
	   (read-char stream nil nil)
	   line))
      (vector-push-extend c line))))

(defmacro aif (test yes no)
  `(let ((it ,test))
    (if it
	,yes
	,no)))

(defun %finger (host query port)
  "Send query to host:port using the finger protocol, RFC 1288. Returns the 
output as a string."
  (declare (ignore verbose))
  (with-open-socket (net :remote-host host :remote-port port)
    (write-net-line query net)
    (force-output net)			; Doesn't seem to be needed, but just incase
    (let ((inbuf (make-array +input-buffer-size+ :element-type 'character 
:initial-element #\space)))
      (do* ((pos (read-sequence inbuf net) (read-sequence inbuf net))
	    (output (subseq inbuf 0 pos) (concatenate 'string output (subseq inbuf 
0 pos))))
	   ((zerop pos) output)))))

(defun finger (query &key (verbose nil) (port 79))
  "Takes a query, in the same format as the unix command line tool and 
execute it."
  (let (host
	(host-query (if verbose "/W " "")))
    (aif (position #\@ query :from-end t)
	 (setf host (subseq query (1+ it))
	       host-query (concatenate 'string host-query (subseq query 0 it)))
	 (setf host query))
    (%finger host host-query port)))

;; For testing try:
;;   (finger "idsoftware.com")
;; and/or
;;   (finger "johnc at idsoftware.com")
;; to find out how Doom 3 is comming along!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Server code
(defun finger-daemon (handler &key (port 79) (subqueries nil))
  "Start up a listner on port that responds to the finger protocol"
  (process-run-function (format nil "finger-daemon on port ~d" port)
			#'%finger-daemon handler port subqueries))

(defun %finger-daemon (handler port subqueries)
  "Specific implementation routine."
  (with-open-socket (sock :type :stream :connect :passive :local-port port 
:reuse-address t)
    (loop
       (let ((insock (accept-connection sock)))
	 (process-run-function "Finger request handler"
			       #'%finger-daemon-handler handler insock subqueries)))))

(defun %finger-daemon-handler (handler socket subqueries)
  (let* ((line (read-net-line socket))
	 (verbose (and (>= (length line) 3)
		       (string= line "/W " :end1 3)))
	 (proc-line (if verbose (subseq line 3) line))
	 (req-sub (find #\@ line :test #'char=))
	 (ret-str (cond ((and subqueries req-sub)
			 (finger-forward-handler proc-line verbose))
			(req-sub
			 "Sub-Queries not supported.")
			(t
			 (funcall handler proc-line verbose)))))
    (if (null ret-str)
	(write-sequence "Unknown." socket)
	(write-sequence ret-str socket))
    (force-output socket)
    (close socket)))

(defun finger-forward-handler (line verbose)
  "Handler for forwarding requests a third party"
  (handler-bind ((error #'(lambda (c)
			    (declare (ignore c))
			    (return-from finger-forward-handler "Unable to process the 
request."))))
    (finger line verbose)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Vending machine code, which becomes a simple server
(defstruct vending
  button
  contents
  description
  price)

(defparameter *vending-machine* nil
  "Holds the data for the vending machine.")

(defun populate-vending-machine (data)
  "Takes a list of data in the format (button short-desc long-desc price) 
and turns it into a vending mahcine."
  (setf *vending-machine* (mapcar #'(lambda (x)
				      (destructuring-bind (b c d p) x
					(make-vending :button b
						      :contents c
						      :description d
						      :price p)))
				  data)))

(populate-vending-machine
'(("T1" "English Breakfast Tea" "Probably the best tea in the world." 1.0)
   ("T2" "Earl Grey" "Well if you like the taste of washing up liquid..." 
1.1)
   ("T3" "Herbal Tea (Various)" "Smells great, tastes just like water." 
0.80)
   ("C1" "Cheap 'n' Nasty coffee." "It's awful, doesn't even taste like 
coffee." 0.50)
   ("C2" "Freeze Dried Coffee." "Do yourself a favour and go to a coffee 
shop and get a real coffee." 1.0)
   ("H1" "Hot Chocolate" "Carefull, this is so hot it'll cook your 
tastebuds." 1.0)))

(defun vending-machine-details ()
  (with-output-to-string (stream)
    (format stream "~%Button~10,0TContents~50,4TPrice~%")
    (format stream 
"-------------------------------------------------------~%")
    (dolist (i *vending-machine*)
      (format stream "~a~10,0T~a~50,4T~,2f~%"
	      (vending-button i)
	      (vending-contents i)
	      (vending-price i)))))

(defun specific-button-details (button)
  "This write the specific information for the button"
  (with-output-to-string (stream)
    (let ((item (find button *vending-machine*
		      :key #'vending-button
		      :test #'string-equal)))
      (cond ((null item)
	     (format stream "Not available on this machine.~%"))
	    (t
	     (format stream "Button: ~a~50,0tPrice: ~,2f~%"
		     (vending-button item)
		     (vending-price item))
	     (format stream "Contents: ~a~%"
		     (vending-contents item))
	     (format stream "Description: ~a~%"
		     (vending-description item)))))))

(defun process-vending-machine-command (command verbose)
  "This is the vending machine."
  (declare (ignore verbose))
  (if (string= command "")
      (vending-machine-details)
      (specific-button-details command)))

(defun vending-machine-demo (port)
  (finger-daemon #'process-vending-machine-command :port port))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Multiple request test code

(defvar *finished* nil)

(defun one-of (list)
  "Return a random element from the list."
  (nth (random (length list)) list))

(defun finger-stress-test (host &key (queries nil) (time 60)
			   (concurrent 10) (port 79))
  "Simple stress test routines."
  (setf *finished* nil)
  (dotimes (i concurrent)
    (process-run-function (format nil "Stress test thread ~d" i)
			  #'(lambda ()
			      (do ((local-count 0 (1+ local-count)))
				  (*finished*)
				(%finger host (one-of queries) port)))))
  (sleep time)
  (setf *finished* t))

_________________________________________________________________
Surf together with new Shared Browsing 
http://join.msn.com/?page=features/browse&pgmarket=en-gb&XAPID=74&DI=1059


_______________________________________________
Openmcl-devel mailing list
Openmcl-devel at clozure.com
http://clozure.com/cgi-bin/mailman/listinfo/openmcl-devel



More information about the Openmcl-devel mailing list