;; drop buffers when direction changes
(when (and (fd-stream-obuf-sap fd-stream) (not output-p))
(with-available-buffers-lock ()
- (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
- (setf (fd-stream-obuf-sap fd-stream) nil)))
+ (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
+ (setf (fd-stream-obuf-sap fd-stream) nil)))
(when (and (fd-stream-ibuf-sap fd-stream) (not input-p))
(with-available-buffers-lock ()
- (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
- (setf (fd-stream-ibuf-sap fd-stream) nil)))
+ (push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
+ (setf (fd-stream-ibuf-sap fd-stream) nil)))
(when input-p
(setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
(setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
(defun get3 (symbol indicator default)
(let (cdr-pl)
(do ((pl (symbol-plist symbol) (cdr cdr-pl)))
- ((atom pl) default)
+ ((atom pl) default)
(setq cdr-pl (cdr pl))
(cond ((atom cdr-pl)
- (error "~S has an odd number of items in its property list."
- symbol))
- ((eq (car pl) indicator)
- (return (car cdr-pl)))))))
+ (error "~S has an odd number of items in its property list."
+ symbol))
+ ((eq (car pl) indicator)
+ (return (car cdr-pl)))))))
(defun %put (symbol indicator value)
#!+sb-doc
;; First check the cache. Use EQ here for speed.
(let ((cache (hash-table-cache hash-table))
(table (hash-table-table hash-table)))
-
+
(if (and cache (< cache (length table)) (eq (aref table cache) key))
(values (aref table (1+ cache)) t)
(hash-vector (hash-table-hash-vector hash-table))
(test-fun (hash-table-test-fun hash-table)))
(declare (type index index))
-
+
(cond ((or eq-based (not hash-vector))
(when eq-based
(set-header-data kv-vector sb!vm:vector-valid-hashing-subtype))
-
+
;; Search next-vector chain for a matching key.
(do ((next next (aref next-vector next)))
((zerop next))
(setf (hash-table-cache hash-table) (* 2 next))
(setf (aref kv-vector (1+ (* 2 next))) value)
(return-from %puthash value)))))
-
+
;; Pop a KV slot off the free list
(let ((free-kv-slot (hash-table-next-free-kv hash-table)))
;; Double-check for overflow.
(setf (hash-table-next-free-kv hash-table)
(aref next-vector free-kv-slot))
(incf (hash-table-number-entries hash-table))
-
+
(setf (hash-table-cache hash-table) (* 2 free-kv-slot))
(setf (aref kv-vector (* 2 free-kv-slot)) key)
(setf (aref kv-vector (1+ (* 2 free-kv-slot))) value)
-
+
;; Setup the hash-vector if necessary.
(when hash-vector
(if (not eq-based)
(setf (aref hash-vector free-kv-slot) hashing)
(aver (= (aref hash-vector free-kv-slot) +magic-hash-vector-value+))))
-
+
;; Push this slot into the next chain.
(setf (aref next-vector free-kv-slot) next)
(setf (aref index-vector index) free-kv-slot)))))))
((not (zerop (hash-table-needing-rehash hash-table)))
(flush-needing-rehash hash-table)))
- ;; For now, just clear the cache
+ ;; For now, just clear the cache
(setf (hash-table-cache hash-table) nil)
;; Search for key in the hash table.
#+sb-xc (/nohexstr class)
(prog1
(flet ((lookup (class)
- (or (gethash class *info-classes*)
- (error "~S is not a defined info class." class))))
- (if (symbolp class)
- (or (get class 'class-info-or-lose-cache)
- (setf (get class 'class-info-or-lose-cache)
- (lookup class)))
- (lookup class)))
+ (or (gethash class *info-classes*)
+ (error "~S is not a defined info class." class))))
+ (if (symbolp class)
+ (or (get class 'class-info-or-lose-cache)
+ (setf (get class 'class-info-or-lose-cache)
+ (lookup class)))
+ (lookup class)))
#+sb-xc (/noshow0 "returning from CLASS-INFO-OR-LOSE")))
(declaim (ftype (function (keyword keyword) type-info) type-info-or-lose))
(defun type-info-or-lose (class type)
(defun use-dispatch-dfun-p (gf &optional (caching-p (use-caching-dfun-p gf)))
(when (eq *boot-state* 'complete)
- (unless (or caching-p
+ (unless (or caching-p
(gf-requires-emf-keyword-checks gf))
;; This should return T when almost all dispatching is by
;; eql specializers or built-in classes. In other words,
(defun generate-discrimination-net (generic-function methods types sorted-p)
(let* ((arg-info (gf-arg-info generic-function))
- (c-a-m-emf-std-p (gf-info-c-a-m-emf-std-p arg-info))
+ (c-a-m-emf-std-p (gf-info-c-a-m-emf-std-p arg-info))
(precedence (arg-info-precedence arg-info)))
(generate-discrimination-net-internal
generic-function methods types
(lambda (methods known-types)
(if (or sorted-p
- (and c-a-m-emf-std-p
- (block one-order-p
- (let ((sorted-methods nil))
- (map-all-orders
- (copy-list methods) precedence
- (lambda (methods)
- (when sorted-methods (return-from one-order-p nil))
- (setq sorted-methods methods)))
- (setq methods sorted-methods))
- t)))
+ (and c-a-m-emf-std-p
+ (block one-order-p
+ (let ((sorted-methods nil))
+ (map-all-orders
+ (copy-list methods) precedence
+ (lambda (methods)
+ (when sorted-methods (return-from one-order-p nil))
+ (setq sorted-methods methods)))
+ (setq methods sorted-methods))
+ t)))
`(methods ,methods ,known-types)
`(unordered-methods ,methods ,known-types)))
(lambda (position type true-value false-value)
va_list ap;
fprintf(stderr, "fatal error encountered in SBCL pid %d",getpid());
#if defined(LISP_FEATURE_SB_THREAD)
- fprintf(stderr, "(tid %ld)",thread_self());
+ fprintf(stderr, "(tid %lu)",thread_self());
#endif
if (fmt) {
fprintf(stderr, ":\n");
fake_foreign_function_call(context);
}
-#ifdef QSHOW_SIGNALS
- FSHOW((stderr,
- "/entering interrupt_handle_now(%d, info, context)\n",
- signal));
-#endif
+ FSHOW_SIGNAL((stderr,
+ "/entering interrupt_handle_now(%d, info, context)\n",
+ signal));
if (ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
/* Allow signals again. */
thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
-#ifdef QSHOW_SIGNALS
- SHOW("calling Lisp-level handler");
-#endif
+ FSHOW_SIGNAL((stderr,"/calling Lisp-level handler\n"));
funcall3(handler.lisp,
make_fixnum(signal),
context_sap);
} else {
-#ifdef QSHOW_SIGNALS
- SHOW("calling C-level handler");
-#endif
+ FSHOW_SIGNAL((stderr,"/calling C-level handler\n"));
/* Allow signals again. */
thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
undo_fake_foreign_function_call(context); /* block signals again */
}
-#ifdef QSHOW_SIGNALS
- FSHOW((stderr,
- "/returning from interrupt_handle_now(%d, info, context)\n",
- signal));
-#endif
+ FSHOW_SIGNAL((stderr,
+ "/returning from interrupt_handle_now(%d, info, context)\n",
+ signal));
}
/* This is called at the end of a critical section if the indications
lose("interrupt already pending");
/* If interrupts are disabled then INTERRUPT_PENDING is set and
* not PSEDUO_ATOMIC_INTERRUPTED. This is important for a pseudo
- * atomic section inside a without-interrupts.
+ * atomic section inside a WITHOUT-INTERRUPTS.
*/
if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) {
store_signal_data_for_later(data,handler,signal,info,context);
SetSymbolValue(INTERRUPT_PENDING, T,thread);
-#ifdef QSHOW_SIGNALS
- FSHOW((stderr,
- "/maybe_defer_handler(%x,%d),thread=%ld: deferred\n",
- (unsigned int)handler,signal,thread->os_thread));
-#endif
+ FSHOW_SIGNAL((stderr,
+ "/maybe_defer_handler(%x,%d),thread=%lu: deferred\n",
+ (unsigned int)handler,signal,
+ (unsigned long)thread->os_thread));
return 1;
}
/* a slightly confusing test. arch_pseudo_atomic_atomic() doesn't
arch_pseudo_atomic_atomic(context)) {
store_signal_data_for_later(data,handler,signal,info,context);
arch_set_pseudo_atomic_interrupted(context);
-#ifdef QSHOW_SIGNALS
- FSHOW((stderr,
- "/maybe_defer_handler(%x,%d),thread=%ld: deferred(PA)\n",
- (unsigned int)handler,signal,thread->os_thread));
-#endif
+ FSHOW_SIGNAL((stderr,
+ "/maybe_defer_handler(%x,%d),thread=%lu: deferred(PA)\n",
+ (unsigned int)handler,signal,
+ (unsigned long)thread->os_thread));
return 1;
}
-#ifdef QSHOW_SIGNALS
- FSHOW((stderr,
- "/maybe_defer_handler(%x,%d),thread=%ld: not deferred\n",
- (unsigned int)handler,signal,thread->os_thread));
-#endif
+ FSHOW_SIGNAL((stderr,
+ "/maybe_defer_handler(%x,%d),thread=%lu: not deferred\n",
+ (unsigned int)handler,signal,
+ (unsigned long)thread->os_thread));
return 0;
}
}
#ifdef LISP_FEATURE_SB_THREAD
+
void
sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
{
{
os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
/* The order of interrupt execution is peculiar. If thread A
- * interrupts thread B with I1, I2 and B for some reason recieves
+ * interrupts thread B with I1, I2 and B for some reason receives
* I1 when FUN2 is already on the list, then it is FUN2 that gets
* to run first. But when FUN2 is run SIG_INTERRUPT_THREAD is
* enabled again and I2 hits pretty soon in FUN2 and run
/* signal information for pending signal. pending_signal=0 when there
* is no pending signal. */
void (*pending_handler) (int, siginfo_t*, void*) ;
- int pending_signal ;
+ int pending_signal;
siginfo_t pending_info;
sigset_t pending_mask;
};
lose("CATS. CATS ARE NICE.");
return 0;
}
-
* problem.. */
#define QSHOW_SIGNALS 0
+#ifdef QSHOW_SIGNALS
+#define FSHOW_SIGNAL FSHOW
+#else
+#define FSHOW_SIGNAL(args)
+#endif
+
/* KLUDGE: These are in theory machine-dependent and OS-dependent, but
* in practice the "foo int" definitions work for all the machines
* that SBCL runs on as of 0.6.7. If we port to the Alpha or some
sigemptyset(&empty);
thread_sigmask(SIG_BLOCK, &empty, ¤t);
if (sigismember(¤t,SIG_STOP_FOR_GC))
- lose("SIG_STOP_FOR_GC is blocked\n");
+ lose("SIG_STOP_FOR_GC cannot arrive: it is blocked\n");
if (SymbolValue(INTERRUPTS_ENABLED,arch_os_get_current_thread()) == NIL)
- lose("interrupts disabled\n");
+ lose("SIG_STOP_FOR_GC cannot arrive: interrupts disabled\n");
if (arch_pseudo_atomic_atomic(NULL))
- lose("n pseudo atomic\n");
+ lose("SIG_STOP_FOR_GC cannot arrive: in pseudo atomic\n");
}
-#ifdef QSHOW_SIGNALS
-#define FSHOW_SIGNAL FSHOW
-#else
-#define FSHOW_SIGNAL(args)
-#endif
-
#define GET_ALL_THREADS_LOCK(name) \
{ \
sigset_t _newset,_oldset; \
sigdelset(&_newset,SIG_STOP_FOR_GC); \
thread_sigmask(SIG_BLOCK, &_newset, &_oldset); \
check_sig_stop_for_gc_can_arrive_or_lose(); \
- FSHOW_SIGNAL((stderr,"/%s:waiting on lock=%ld, thread=%ld\n",name, \
+ FSHOW_SIGNAL((stderr,"/%s:waiting on lock=%ld, thread=%lu\n",name, \
all_threads_lock,arch_os_get_current_thread()->os_thread)); \
get_spinlock(&all_threads_lock,(long)arch_os_get_current_thread()); \
- FSHOW_SIGNAL((stderr,"/%s:got lock, thread=%ld\n", \
+ FSHOW_SIGNAL((stderr,"/%s:got lock, thread=%lu\n", \
name,arch_os_get_current_thread()->os_thread));
#define RELEASE_ALL_THREADS_LOCK(name) \
#ifndef __USE_XOPEN2K
extern int pthread_attr_setstack (pthread_attr_t *__attr, void *__stackaddr,
- size_t __stacksize);
+ size_t __stacksize);
#endif
boolean create_os_thread(struct thread *th,os_thread_t *kid_tid)
}
#endif
GET_ALL_THREADS_LOCK("reap_dead_thread")
- FSHOW((stderr,"/reap_dead_thread: reaping %ld\n",th->os_thread));
+ FSHOW((stderr,"/reap_dead_thread: reaping %lu\n",th->os_thread));
if(th->prev)
th->prev->next=th->next;
else all_threads=th->next;
lispobj c=alloc_cons(function,NIL);
int kill_status;
/* interrupt_thread_handler locks this spinlock with
- * interrupts blocked and it does so for the sake of
- * arrange_return_to_lisp_function, so we must also block
- * them. */
+ * interrupts blocked (it does so for the sake of
+ * arrange_return_to_lisp_function), so we must also block
+ * them or else SIG_STOP_FOR_GC and all_threads_lock will find
+ * a way to deadlock. */
sigset_t newset,oldset;
sigemptyset(&newset);
sigaddset_blockable(&newset);
void gc_stop_the_world()
{
struct thread *p,*th=arch_os_get_current_thread();
- FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on lock, thread=%ld\n",
+ FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on lock, thread=%lu\n",
th->os_thread));
/* keep threads from starting while the world is stopped. */
get_spinlock(&all_threads_lock,(long)th);
- FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got lock, thread=%ld\n",
+ FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got lock, thread=%lu\n",
th->os_thread));
/* stop all other threads by sending them SIG_STOP_FOR_GC */
for(p=all_threads; p; p=p->next) {
while(p->state==STATE_STARTING) sched_yield();
if((p!=th) && (p->state==STATE_RUNNING)) {
- FSHOW_SIGNAL((stderr,"/gc_stop_the_world:sending sig_stop to %ld\n",
+ FSHOW_SIGNAL((stderr, "/gc_stop_the_world: suspending %lu\n",
p->os_thread));
if(thread_kill(p->os_thread,SIG_STOP_FOR_GC)==-1) {
/* we can't kill the thread; assume because it died
* since we last checked */
p->state=STATE_DEAD;
- FSHOW_SIGNAL((stderr,"/gc_stop_the_world:assuming %ld dead\n",
+ FSHOW_SIGNAL((stderr,"/gc_stop_the_world:assuming %lu dead\n",
p->os_thread));
}
}
gc_assert(p->os_thread!=0);
if((p!=th) && (p->state!=STATE_DEAD)) {
if(p->state!=STATE_SUSPENDED) {
- lose("gc_start_the_world: wrong thread state is %ld\n",
+ lose("gc_start_the_world: wrong thread state is %d\n",
fixnum_value(p->state));
}
+ FSHOW_SIGNAL((stderr, "/gc_start_the_world: resuming %lu\n",
+ p->os_thread));
thread_kill(p->os_thread,SIG_STOP_FOR_GC);
}
}
- /* we must wait for all threads to leave stopped state else we
+ /* we must wait for all threads to leave suspended state else we
* risk signal accumulation and lose any meaning of
* thread->state */
for(p=all_threads;p;) {
(let ((result '()))
(dolist (method methods)
(if (and (consp result)
- (equal (method-qualifiers method)
+ (equal (method-qualifiers method)
(method-qualifiers (caar result))))
(push method (car result))
(push (list method) result)))
(defmethod compute-applicable-methods ((gf msl-generic-function) arguments)
(reverse-method-list (call-next-method)))
-(defmethod compute-applicable-methods-using-classes
+(defmethod compute-applicable-methods-using-classes
((gf msl-generic-function) classes)
(reverse-method-list (call-next-method)))
-(defgeneric testgf07 (x)
+(defgeneric testgf07 (x)
(:generic-function-class msl-generic-function)
- (:method ((x integer))
+ (:method ((x integer))
(cons 'integer (if (next-method-p) (call-next-method))))
- (:method ((x real))
+ (:method ((x real))
(cons 'real (if (next-method-p) (call-next-method))))
- (:method ((x number))
+ (:method ((x number))
(cons 'number (if (next-method-p) (call-next-method))))
- (:method :around ((x integer))
+ (:method :around ((x integer))
(coerce (call-next-method) 'vector)))
(assert (equalp (list (testgf07 5.0) (testgf07 17))
(sb-pcl:method-specializers method)))
methods))
-(defmethod compute-applicable-methods
+(defmethod compute-applicable-methods
((gf nonumber-generic-function) arguments)
(nonumber-method-list (call-next-method)))
-(defmethod compute-applicable-methods-using-classes
+(defmethod compute-applicable-methods-using-classes
((gf nonumber-generic-function) classes)
(nonumber-method-list (call-next-method)))
-(defgeneric testgf08 (x)
+(defgeneric testgf08 (x)
(:generic-function-class nonumber-generic-function)
- (:method ((x integer))
+ (:method ((x integer))
(cons 'integer (if (next-method-p) (call-next-method))))
- (:method ((x real))
+ (:method ((x real))
(cons 'real (if (next-method-p) (call-next-method))))
- (:method ((x number))
+ (:method ((x number))
(cons 'number (if (next-method-p) (call-next-method))))
- (:method :around ((x integer))
+ (:method :around ((x integer))
(coerce (call-next-method) 'vector)))
(assert (equalp (list (testgf08 5.0) (testgf08 17))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.33"
+"0.9.3.34"
projects / sbcl.git / commitdiff