From 92c8db80e039f60623e53a0b9355cf0a9ec49f3d Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Tue, 9 Aug 2005 13:57:46 +0000 Subject: [PATCH] 0.9.3.34: cosmetics * move FSHOW_SIGNAL to runtime.h * print os_thread_t with %lu * recanonicalize whitespace (offenders: crhodes, jsnell, pfdietz and me (but I was handed a tainted patch by crhodes, honest)) --- src/code/fd-stream.lisp | 8 +++--- src/code/symbol.lisp | 10 +++---- src/code/target-hash-table.lisp | 16 +++++------ src/compiler/globaldb.lisp | 14 +++++----- src/pcl/dfun.lisp | 2 +- src/pcl/methods.lisp | 22 +++++++-------- src/runtime/interr.c | 2 +- src/runtime/interrupt.c | 56 ++++++++++++++++----------------------- src/runtime/interrupt.h | 2 +- src/runtime/runtime.c | 1 - src/runtime/runtime.h | 6 +++++ src/runtime/thread.c | 41 +++++++++++++--------------- tests/mop-3.impure-cload.lisp | 28 ++++++++++---------- version.lisp-expr | 2 +- 14 files changed, 101 insertions(+), 109 deletions(-) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 1d98e0e..70c0b57 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1377,12 +1377,12 @@ ;; 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) diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index 2ef5dc5..39f89a7 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -113,13 +113,13 @@ (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 diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index d3a9bdb..67ef677 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -436,7 +436,7 @@ ;; 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) @@ -510,11 +510,11 @@ (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)) @@ -536,7 +536,7 @@ (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. @@ -544,17 +544,17 @@ (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))))))) @@ -575,7 +575,7 @@ ((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. diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index b72a672..3e6476d 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -198,13 +198,13 @@ #+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) diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index ac1234f..51bcea8 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -615,7 +615,7 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (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, diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 9f181f7..8db6b37 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -1043,22 +1043,22 @@ (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) diff --git a/src/runtime/interr.c b/src/runtime/interr.c index 4ef3766..64eacea 100644 --- a/src/runtime/interr.c +++ b/src/runtime/interr.c @@ -49,7 +49,7 @@ lose(char *fmt, ...) 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"); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 1fa2547..22e6a76 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -406,11 +406,9 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) 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)) { @@ -437,9 +435,7 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) /* 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), @@ -447,9 +443,7 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) 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); @@ -464,11 +458,9 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) 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 @@ -501,16 +493,15 @@ maybe_defer_handler(void *handler, struct interrupt_data *data, 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 @@ -523,18 +514,16 @@ maybe_defer_handler(void *handler, struct interrupt_data *data, 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; } @@ -621,6 +610,7 @@ low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context) } #ifdef LISP_FEATURE_SB_THREAD + void sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context) { @@ -835,7 +825,7 @@ void interrupt_thread_handler(int num, siginfo_t *info, void *v_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 diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h index 87b8b23..1329123 100644 --- a/src/runtime/interrupt.h +++ b/src/runtime/interrupt.h @@ -52,7 +52,7 @@ struct interrupt_data { /* 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; }; diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 3605794..8a44604 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -346,4 +346,3 @@ main(int argc, char *argv[], char *envp[]) lose("CATS. CATS ARE NICE."); return 0; } - diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h index b97a15f..48f0710 100644 --- a/src/runtime/runtime.h +++ b/src/runtime/runtime.h @@ -37,6 +37,12 @@ * 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 diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 2a6bc40..adeada3 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -43,19 +43,13 @@ void check_sig_stop_for_gc_can_arrive_or_lose() 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; \ @@ -64,10 +58,10 @@ void check_sig_stop_for_gc_can_arrive_or_lose() 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) \ @@ -278,7 +272,7 @@ void create_initial_thread(lispobj initial_function) { #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) @@ -352,7 +346,7 @@ void reap_dead_thread(struct thread *th) } #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; @@ -389,9 +383,10 @@ int interrupt_thread(struct thread *th, lispobj function) 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); @@ -422,23 +417,23 @@ int interrupt_thread(struct thread *th, lispobj function) 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)); } } @@ -468,13 +463,15 @@ void gc_start_the_world() 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;) { diff --git a/tests/mop-3.impure-cload.lisp b/tests/mop-3.impure-cload.lisp index 173ba20..44b3a84 100644 --- a/tests/mop-3.impure-cload.lisp +++ b/tests/mop-3.impure-cload.lisp @@ -32,7 +32,7 @@ (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))) @@ -40,19 +40,19 @@ (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)) @@ -69,22 +69,22 @@ (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)) diff --git a/version.lisp-expr b/version.lisp-expr index 21c3d00..7e073fa 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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" -- 1.7.10.4