/[slime]/slime/swank-scl.lisp
ViewVC logotype

Diff of /slime/swank-scl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by heller, Wed Aug 9 17:01:13 2006 UTC revision 1.10 by heller, Thu Aug 10 11:53:35 2006 UTC
# Line 36  Line 36 
36  (defimplementation close-socket (socket)  (defimplementation close-socket (socket)
37    (ext:close-socket (socket-fd socket)))    (ext:close-socket (socket-fd socket)))
38    
39  (defimplementation accept-connection (socket &key  (defimplementation accept-connection (socket
40                                        (external-format :iso-latin-1-unix)                                        &key external-format buffering timeout)
                                       (buffering :full)  
                                       (timeout nil))  
41    (let ((external-format (or external-format :iso-latin-1-unix))    (let ((external-format (or external-format :iso-latin-1-unix))
42            (buffering (or buffering :full))
43          (fd (socket-fd socket)))          (fd (socket-fd socket)))
44        (loop        (loop
45         (let ((ready (sys:wait-until-fd-usable fd :input timeout)))         (let ((ready (sys:wait-until-fd-usable fd :input timeout)))
# Line 1168  Signal an error if no constructor can be Line 1167  Signal an error if no constructor can be
1167                               (list symbol))))                               (list symbol))))
1168                   ((:defined)                   ((:defined)
1169                    (ext:info :alien-type :definition symbol))                    (ext:info :alien-type :definition symbol))
1170                   (:unknown                   (:unknown :unknown))))))
                   (return-from describe-definition  
                     (format nil "Unknown alien type: ~S" symbol))))))))  
1171    
1172  ;;;;; Argument lists  ;;;;; Argument lists
1173    
1174  (defimplementation arglist ((name symbol))  (defimplementation arglist (fun)
1175    (cond ((and (symbolp name) (macro-function name))    (cond ((and (symbolp fun) (macro-function fun))
1176           (arglist (macro-function name)))           (arglist (macro-function fun)))
1177          ((fboundp name)          ((fboundp fun)
1178           (arglist (fdefinition name)))           (function-arglist (fdefinition fun)))
1179          (t          (t
1180           :not-available)))           :not-available)))
1181    
1182  (defimplementation arglist ((fun function))  (defun function-arglist (fun function)
1183    (flet ((compiled-function-arglist (x)    (flet ((compiled-function-arglist (x)
1184             (let ((args (kernel:%function-arglist x)))             (let ((args (kernel:%function-arglist x)))
1185               (if args               (if args
# Line 1588  Signal an error if no constructor can be Line 1585  Signal an error if no constructor can be
1585     (values  :initarg :values  :reader breakpoint.values))     (values  :initarg :values  :reader breakpoint.values))
1586    (:report (lambda (c stream) (princ (breakpoint.message c) stream))))    (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
1587    
1588    #+nil
1589  (defimplementation condition-extras ((c breakpoint))  (defimplementation condition-extras ((c breakpoint))
1590    ;; simply pop up the source buffer    ;; simply pop up the source buffer
1591    `((:short-frame-source 0)))    `((:short-frame-source 0)))
# Line 1933  The `symbol-value' of each element is a Line 1931  The `symbol-value' of each element is a
1931                (incf *thread-id-counter*)))))                (incf *thread-id-counter*)))))
1932    
1933  (defimplementation find-thread (id)  (defimplementation find-thread (id)
1934    (thread:map-over-threads    (block find-thread
1935     #'(lambda (thread)      (thread:map-over-threads
1936         (when (eql (getf (thread:thread-plist thread) 'id) id)       #'(lambda (thread)
1937           (return-from find-thread thread)))))           (when (eql (getf (thread:thread-plist thread) 'id) id)
1938               (return-from find-thread thread))))))
1939    
1940  (defimplementation thread-name (thread)  (defimplementation thread-name (thread)
1941    (princ-to-string (thread:thread-name thread)))    (princ-to-string (thread:thread-name thread)))

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

  ViewVC Help
Powered by ViewVC 1.1.5