我有一些常见的lisp代码表现得很奇怪。它是一个TCP客户端/服务器应用程序。
除非我在代码末尾添加(sleep 0.01)或类似内容，否则在我的程序完成后，我会收到以下完全无用的错误消息 。这是一个非常短命的程序，只需托管TCP服务器并测试它是否可以连接到。
;
;编制单位中止
;陷入1致命的错误状况
每次都不会发生这种情况，可能80％的运行都会导致这种情况发生。没有背景，也没有解释。
重现问题的代码：
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,@body))
(defmacro kilobytes (qty)
(* qty 1024))
(defun is-sequence (sequence)
(or (listp sequence) (vectorp sequence)))
(defmacro append-to (seq values)
(with-gensyms (cached-values)
`(let ((,cached-values ,values))
(cond
((is-sequence ,cached-values)
(setf ,seq (append ,seq (coerce ,cached-values 'list))))
(t
(setf ,seq (append ,seq (list ,cached-values))))))))
(defmacro remove-from (seq value)
(with-gensyms (cached-value)
`(let ((,cached-value ,value))
(delete-if (lambda (value) (equalp value ,cached-value)) ,seq))))
(defclass tcp-server ()
((server-socket :initform nil)
(server-threads :initform (list))))
(defgeneric start-server (this &key port bind-address buffer-length))
(defmethod start-server ((this tcp-server) &key (port 0) (bind-address #(127 0 0 1)) (buffer-length (kilobytes 10)))
(with-slots (server-socket server-threads) this
(when server-socket
(error "Server already running"))
(let ((backlog 5))
(setf server-socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
(sb-bsd-sockets:socket-bind server-socket bind-address port)
(sb-bsd-sockets:socket-listen server-socket backlog)
(flet ((handle-connection (client-socket)
(let ((buffer (make-array buffer-length :element-type '(unsigned-byte 8) :fill-pointer t)))
(catch 'eof
(loop
while (sb-bsd-sockets:socket-open-p client-socket)
do (let ((length (nth-value 1 (sb-bsd-sockets:socket-receive client-socket buffer nil))))
(when (eq 0 length)
(throw 'eof nil)))))
(sb-bsd-sockets::socket-close client-socket)
(remove-from server-threads sb-thread:*current-thread*))))
(sb-thread:make-thread
(lambda ()
(loop
while (and server-socket (sb-bsd-sockets:socket-open-p server-socket))
do
(let ((client-socket (sb-bsd-sockets:socket-accept server-socket))) ;; Listen for incoming connections
(append-to server-threads
(sb-thread:make-thread #'handle-connection :name "Connection handler" :arguments client-socket)))) ;; Spawn a process to handle the connection))
(remove-from server-threads sb-thread:*current-thread*))
:name "Server")))
nil))
(defun start-tcp-server (&key (port 0) (bind-address #(127 0 0 1)) (buffer-length (kilobytes 10)))
(let ((server (make-instance 'tcp-server)))
(start-server server :port port :bind-address bind-address :buffer-length buffer-length)
server))
(defgeneric stop-server (this))
(defmethod stop-server ((this tcp-server))
(with-slots (server-socket server-threads) this
(unless server-socket
(error "Server not running"))
(sb-bsd-sockets:socket-close server-socket)
(setf server-socket nil)
(loop for thread in (reverse server-threads)
; do (sb-thread:interrupt-thread thread 'sb-thread:abort-thread))
do (sb-thread:terminate-thread thread))
(loop for thread in (reverse server-threads)
do (sb-thread:join-thread thread :default nil))))
(defgeneric server-running? (this))
(defmethod server-running? ((this tcp-server))
(if (slot-value this 'server-socket) t nil))
(defgeneric server-port (this))
(defmethod server-port ((this tcp-server))
(nth-value 1 (sb-bsd-sockets:socket-name (slot-value this 'server-socket))))
(let ((server-instance nil))
(defun deltabackup-start-server (&key (port 0) (bind-address #(127 0 0 1)) (buffer-length (kilobytes 10)))
(setf server-instance (start-tcp-server :port port
:bind-address bind-address
:buffer-length buffer-length))
nil)
(defun deltabackup-stop-server ()
(unless server-instance
(error "Server not running"))
(stop-server server-instance)
(setf server-instance nil))
(defun deltabackup-server-running? ()
(server-running? server-instance))
(defun deltabackup-server-port ()
(server-port server-instance)))
(defmacro with-tcp-client-connection (address port socket-var &body body-forms)
(with-gensyms (client-socket)
`(let* ((,client-socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
(,socket-var ,client-socket)) ; duplicate this, to prevent body-form modifying the original
(sb-bsd-sockets:socket-connect ,client-socket ,address ,port)
(unless ,client-socket
(error "Failed to connect"))
,@body-forms
(sb-bsd-sockets:socket-close ,client-socket))))
(defmacro with-running-server ( (&optional (port 0)) &body body-forms)
`(progn
(deltabackup-start-server :port ,port)
(unless (deltabackup-server-running?)
(error "Server did not run"))
,@body-forms
(deltabackup-stop-server)))
(with-running-server ()
(with-tcp-client-connection #(127 0 0 1) (deltabackup-server-port) client-socket
client-socket))
使用SBCL常见的lisp。
答案 0 :(得分：0)
您收到如此模糊的错误消息的原因是您直接从命令行运行并且错误发生在一个线程中。如果您可以在SLIME下的EMACS中发生错误，您将获得更详细的错误信息。
我从SLIME运行你的程序：
CL-USER> (loop repeat 100 do (load "/tmp/stackoverflow.lisp"))
...并在SLIME中出现以下错误：
Socket error in "accept": EBADF (Bad file descriptor)
[Condition of type SB-BSD-SOCKETS:BAD-FILE-DESCRIPTOR-ERROR]
因此，当您尝试接受连接时，服务器上的某些内容会出错。我的理论是你有竞争条件。在服务器线程中，您有：
(loop
while (and server-socket (sb-bsd-sockets:socket-open-p server-socket))
do
(let ((client-socket (sb-bsd-sockets:socket-accept server-socket))) ;; Listen for incoming connections
....))
...在客户端线程中，你这样做：
(defmethod stop-server ((this tcp-server))
(with-slots (server-socket server-threads) this
(unless server-socket
(error "Server not running"))
(sb-bsd-sockets:socket-close server-socket)
可以调用sb-bsd-sockets:socket-close并在服务器线程中对socket-open-p和socket-accept的调用之间完成，以便{{1在一个封闭的套接字上调用。