[Openmcl-devel] Help with error: [Stacks reset due to overflow.]
Barry Perryman
gekki_uk at hotmail.com
Sun May 18 11:50:13 PDT 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