From: William Harold Newman Date: Mon, 27 Nov 2000 17:20:27 +0000 (+0000) Subject: 0.6.8.26: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6df93cdd503b613151de9c82982259b558465915;p=sbcl.git 0.6.8.26: MNA megapatch to src/runtime/, zillions of little fixes --- diff --git a/NEWS b/NEWS index 62b8ff0..6521845 100644 --- a/NEWS +++ b/NEWS @@ -597,7 +597,7 @@ changes in sbcl-0.6.9 relative to sbcl-0.6.8: * Martin Atzmueller also fixed ROOM, so that it no longer fails with an undefined function error. * gave up on fixing bug 3 (forbidden-by-ANSI warning for type mismatch - in structure slot initforms) for now, wrote workaround instead:-| + in structure slot initforms) for now, documented workaround instead:-| * fixed bug 4 (no WARNING for DECLAIM FTYPE of slot accessor function) * fixed bug 5: added stubs for various Gray stream functions called in the not-a-CL:STREAM case, so that even when Gray streams aren't @@ -607,6 +607,8 @@ changes in sbcl-0.6.9 relative to sbcl-0.6.8: consistently in DEFMETHOD forms. * removed bug 21 from BUGS, since Martin Atzmueller points out that it doesn't seem to affect SBCL after all +* The C runtime system now builds with better optimization and many + fewer warnings, thanks to lots of cleanups by Martin Atzmueller. planned incompatible changes in 0.7.x: * The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc. diff --git a/src/code/debug.lisp b/src/code/debug.lisp index a8cb121..7711c50 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -660,11 +660,11 @@ reset to ~S." (let (;; FIXME: The first two bindings here seem wrong, ;; violating the principle of least surprise, and making ;; it impossible for the user to do reasonable things - ;; like using PRINT to send output to the program's - ;; ordinary (possibly redirected-to-a-file) - ;; *STANDARD-OUTPUT*, or using PEEK-CHAR or some such - ;; thing on the program's ordinary (possibly also - ;; redirected) *STANDARD-INPUT*. + ;; like using PRINT at the debugger prompt to send output + ;; to the program's ordinary (possibly + ;; redirected-to-a-file) *STANDARD-OUTPUT*, or using + ;; PEEK-CHAR or some such thing on the program's ordinary + ;; (possibly also redirected) *STANDARD-INPUT*. (*standard-input* *debug-io*) (*standard-output* *debug-io*) ;; This seems reasonable: e.g. if the user has redirected @@ -674,10 +674,11 @@ reset to ~S." (*error-output* *debug-io*)) (unless (typep condition 'step-condition) (format *debug-io* - "~%~@~2%" + "~%~@~2%" '*debug-condition*) (show-restarts *debug-restarts* *debug-io*) (terpri *debug-io*)) diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp index 3d20068..dfd2834 100644 --- a/src/compiler/ir1final.lisp +++ b/src/compiler/ir1final.lisp @@ -12,10 +12,11 @@ (in-package "SB!C") -;;; Give the user grief about optimizations that we weren't able to do. It -;;; is assumed that they want to hear, or there wouldn't be any entries in the -;;; table. If the node has been deleted or is no longer a known call, then do -;;; nothing; some other optimization must have gotten to it. +;;; Give the user grief about optimizations that we weren't able to +;;; do. It is assumed that the user wants to hear about this, or there +;;; wouldn't be any entries in the table. If the node has been deleted +;;; or is no longer a known call, then do nothing; some other +;;; optimization must have gotten to it. (defun note-failed-optimization (node failures) (declare (type combination node) (list failures)) (unless (or (node-deleted node) @@ -26,6 +27,12 @@ (note (transform-note (car failure)))) (cond ((consp what) + ;; FIXME: This sometimes gets too long for a single line, e.g. + ;; "note: unable to optimize away possible call to FDEFINITION at runtime due to type uncertainty:" + ;; It would be nice to pretty-print it somehow, but how? + ;; ~@<..~:@> adds ~_ directives to the spaces which are in + ;; the format string, but a lot of the spaces where we'd want + ;; to break are in the included ~A string instead. (compiler-note "unable to ~A because:~%~6T~?" note (first what) (rest what))) ((valid-function-use node what diff --git a/src/runtime/GNUmakefile b/src/runtime/GNUmakefile index fcd391b..7b8159c 100644 --- a/src/runtime/GNUmakefile +++ b/src/runtime/GNUmakefile @@ -19,7 +19,8 @@ all: sbcl sbcl.nm # from CMU CL. It's presumably to work around some optimizer bug in gcc, # but the fork was a long time ago, and the optimizer could easily # have been fixed since then. Try doing without it. -CFLAGS = -g -Wall -O2 -fno-strength-reduce -DGENCGC +# CFLAGS = -g -Wall -O2 -fno-strength-reduce -DGENCGC +CFLAGS = -g -Wall -O3 -DGENCGC ASFLAGS = -g -DGENCGC DEPEND_FLAGS = CPPFLAGS = -I. diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 8619da0..f0a966d 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -386,7 +386,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ gc_assert(generations[i].bytes_allocated == generation_bytes_allocated(i)); fprintf(stderr, - " %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4lf\n", + " %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4f\n", i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt, generations[i].bytes_allocated, @@ -397,7 +397,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ generations[i].num_gc, gen_av_mem_age(i)); } - fprintf(stderr," Total bytes allocated=%d\n", bytes_allocated); + fprintf(stderr," Total bytes allocated=%ld\n", bytes_allocated); fpu_restore(fpu_state); } @@ -691,7 +691,7 @@ struct new_area { int size; }; static struct new_area (*new_areas)[]; -static new_areas_index; +static int new_areas_index; int max_new_areas; /* Add a new area to new_areas. */ @@ -1196,6 +1196,7 @@ static void /* shouldn't happen */ gc_assert(0); + return((void *) NIL); /* dummy value: return something ... */ } /* Allocate space from the boxed_region. If there is not enough free @@ -1314,6 +1315,7 @@ static void /* shouldn't happen? */ gc_assert(0); + return((void *) NIL); /* dummy value: return something ... */ } static inline void @@ -1750,7 +1752,10 @@ scavenge(lispobj *start, long nwords) { while (nwords > 0) { lispobj object; - int type, words_scavenged; +#if DIRECT_SCAV + int type; +#endif + int words_scavenged; object = *start; @@ -1916,8 +1921,6 @@ void sniff_code_object(struct code *code, unsigned displacement) { int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; void *p; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; @@ -2097,7 +2100,6 @@ apply_code_fixups(struct code *old_code, struct code *new_code) int nheader_words, ncode_words, nwords; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; - lispobj p; lispobj fixups = NIL; unsigned displacement = (unsigned)new_code - (unsigned)old_code; struct vector *fixups_vector; @@ -2537,7 +2539,6 @@ trans_list(lispobj object) { lispobj new_list_pointer; struct cons *cons, *new_cons; - int n = 0; lispobj cdr; gc_assert(from_space_p(object)); @@ -2883,12 +2884,14 @@ scav_vector(lispobj *where, lispobj object) { unsigned int kv_length; lispobj *kv_vector; - unsigned int length; + unsigned int length = 0; /* (0 = dummy to stop GCC warning) */ lispobj *hash_table; lispobj empty_symbol; - unsigned int *index_vector, *next_vector, *hash_vector; + unsigned int *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */ + unsigned int *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */ + unsigned int *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */ lispobj weak_p_obj; - unsigned next_vector_length; + unsigned next_vector_length = 0; /* FIXME: A comment explaining this would be nice. It looks as * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based @@ -3653,7 +3656,7 @@ static lispobj trans_weak_pointer(lispobj object) { lispobj copy; - struct weak_pointer *wp; + /* struct weak_pointer *wp; */ gc_assert(Pointerp(object)); @@ -3686,7 +3689,7 @@ void scan_weak_pointers(void) struct weak_pointer *wp; for (wp = weak_pointers; wp != NULL; wp = wp->next) { lispobj value = wp->value; - lispobj first, *first_pointer; + lispobj *first_pointer; first_pointer = (lispobj *)PTR(value); @@ -4316,9 +4319,6 @@ valid_dynamic_space_pointer(lispobj *pointer) static void maybe_adjust_large_object(lispobj *where) { - int tag; - lispobj *new; - lispobj *source, *dest; int first_page; int nwords; @@ -4979,12 +4979,10 @@ scavenge_newspace_generation(int generation) /* the new_areas array currently being written to by gc_alloc */ struct new_area (*current_new_areas)[] = &new_areas_1; int current_new_areas_index; - int current_new_areas_allocated; /* the new_areas created but the previous scavenge cycle */ struct new_area (*previous_new_areas)[] = NULL; int previous_new_areas_index; - int previous_new_areas_allocated; #define SC_NS_GEN_CK 0 #if SC_NS_GEN_CK @@ -5117,14 +5115,13 @@ scavenge_newspace_generation(int generation) static void unprotect_oldspace(void) { - int bytes_freed = 0; int i; for (i = 0; i < last_free_page; i++) { if ((page_table[i].allocated != FREE_PAGE) && (page_table[i].bytes_used != 0) && (page_table[i].gen == from_space)) { - void *page_start, *addr; + void *page_start; page_start = (void *)page_address(i); @@ -5239,7 +5236,7 @@ print_ptr(lispobj *addr) if (pi1 != -1) fprintf(stderr," %x: page %d alloc %d gen %d bytes_used %d offset %d dont_move %d\n", - addr, + (unsigned int) addr, pi1, page_table[pi1].allocated, page_table[pi1].gen, @@ -5610,7 +5607,6 @@ write_protect_generation_pages(int generation) static void garbage_collect_generation(int generation, int raise) { - unsigned long allocated = bytes_allocated; unsigned long bytes_freed; unsigned long i; unsigned long read_only_space_size, static_space_size; @@ -5692,7 +5688,7 @@ garbage_collect_generation(int generation, int raise) } /* Scavenge the binding stack. */ - scavenge(BINDING_STACK_START, + scavenge( (lispobj *) BINDING_STACK_START, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - (lispobj *)BINDING_STACK_START); @@ -5703,7 +5699,7 @@ garbage_collect_generation(int generation, int raise) FSHOW((stderr, "/scavenge read only space: %d bytes\n", read_only_space_size * sizeof(lispobj))); - scavenge(READ_ONLY_SPACE_START, read_only_space_size); + scavenge( (lispobj *) READ_ONLY_SPACE_START, read_only_space_size); } static_space_size = @@ -5713,7 +5709,7 @@ garbage_collect_generation(int generation, int raise) FSHOW((stderr, "/scavenge static space: %d bytes\n", static_space_size * sizeof(lispobj))); - scavenge(STATIC_SPACE_START, static_space_size); + scavenge( (lispobj *) STATIC_SPACE_START, static_space_size); /* All generations but the generation being GCed need to be * scavenged. The new_space generation needs special handling as @@ -5812,6 +5808,7 @@ update_x86_dynamic_space_free_pointer(void) SetSymbolValue(ALLOCATION_POINTER, (lispobj)(((char *)heap_base) + last_free_page*4096)); + return 0; /* dummy value: return something ... */ } /* GC all generations below last_gen, raising their objects to the @@ -5986,14 +5983,11 @@ gc_free_heap(void) addr); } } else if (gencgc_zero_check_during_free_heap) { - int *page_start, i; - /* Double-check that the page is zero filled. */ + int *page_start, i; gc_assert(page_table[page].allocated == FREE_PAGE); gc_assert(page_table[page].bytes_used == 0); - - page_start = (int *)page_address(i); - + page_start = (int *)page_address(page); for (i=0; i<1024; i++) { if (page_start[i] != 0) { lose("free region not zero at %x", page_start + i); @@ -6323,9 +6317,9 @@ component_ptr_from_pc(lispobj *pc) { lispobj *object = NULL; - if (object = search_read_only_space(pc)) + if ( (object = search_read_only_space(pc)) ) ; - else if (object = search_static_space(pc)) + else if ( (object = search_static_space(pc)) ) ; else object = search_dynamic_space(pc); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 616bc78..40c7e6b 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -220,7 +220,7 @@ void interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context, boolean continuable) { - lispobj context_sap; + lispobj context_sap = 0; fake_foreign_function_call(context); @@ -257,7 +257,9 @@ interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context, void interrupt_handle_pending(os_context_t *context) { +#ifndef __i386__ boolean were_in_lisp = !foreign_function_call_active; +#endif SetSymbolValue(INTERRUPT_PENDING, NIL); @@ -302,7 +304,9 @@ void interrupt_handle_now(int signal, siginfo_t *info, void *void_context) { os_context_t *context = (os_context_t*)void_context; - int were_in_lisp; +#ifndef __i386__ + boolean were_in_lisp; +#endif union interrupt_handler handler; #ifdef __linux__ @@ -315,8 +319,8 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) return; } - were_in_lisp = !foreign_function_call_active; #ifndef __i386__ + were_in_lisp = !foreign_function_call_active; if (were_in_lisp) #endif { diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index bc3800e..93a9a72 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -236,7 +236,7 @@ static void search_cmd(char **ptr) static void call_cmd(char **ptr) { - lispobj thing = parse_lispobj(ptr), function, result, cons, args[3]; + lispobj thing = parse_lispobj(ptr), function, result = 0, cons, args[3]; int numargs; if (LowtagOf(thing) == type_OtherPointer) { diff --git a/src/runtime/print.c b/src/runtime/print.c index 142e7e1..56cdb39 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -34,7 +34,7 @@ static int max_lines = 20, cur_lines = 0; static int max_depth = 5, brief_depth = 2, cur_depth = 0; static int max_length = 5; static boolean dont_descend = 0, skip_newline = 0; -static cur_clock = 0; +static int cur_clock = 0; static void print_obj(char *prefix, lispobj obj); @@ -277,7 +277,7 @@ static void print_otherimm(lispobj obj) break; default: - printf(": data=%ld", (obj>>8)&0xffffff); + printf(": data=%ld", (long) (obj>>8)&0xffffff); break; } } @@ -334,7 +334,7 @@ static void print_list(lispobj obj) static void brief_struct(lispobj obj) { printf("#", - ((struct instance *)PTR(obj))->slots[0]); + (unsigned long) ((struct instance *)PTR(obj))->slots[0]); } static void print_struct(lispobj obj) @@ -461,7 +461,7 @@ static void print_otherptr(lispobj obj) NEWLINE; printf("0x"); while (count-- > 0) - printf("%08lx", *--ptr); + printf("%08lx", (unsigned long) *--ptr); break; case type_Ratio: @@ -608,9 +608,9 @@ static void print_otherptr(lispobj obj) case type_Sap: NEWLINE; #ifndef alpha - printf("0x%08lx", *ptr); + printf("0x%08lx", (unsigned long) *ptr); #else - printf("0x%016lx", *(long*)(ptr+1)); + printf("0x%016lx", *(lispobj*)(ptr+1)); #endif break; @@ -670,7 +670,7 @@ static void print_obj(char *prefix, lispobj obj) } else newline(NULL); - printf("%s0x%08lx: ", prefix, obj); + printf("%s0x%08lx: ", prefix, (unsigned long) obj); if (cur_depth < brief_depth) { fputs(lowtag_Names[type], stdout); (*verbose_fns[type])(obj); diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 18a310c..2d1e4f4 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -246,14 +246,16 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case type_ByteCodeClosure: if ((int)pointer != ((int)start_addr+type_FunctionPointer)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wf2: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } break; default: if (pointer_filter_verbose) { - fprintf(stderr,"*Wf3: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } @@ -261,7 +263,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case type_ListPointer: if ((int)pointer != ((int)start_addr+type_ListPointer)) { if (pointer_filter_verbose) - fprintf(stderr,"*Wl1: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); return 0; } /* Is it plausible cons? */ @@ -276,20 +279,23 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) break; } else { if (pointer_filter_verbose) { - fprintf(stderr,"*Wl2: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } case type_InstancePointer: if ((int)pointer != ((int)start_addr+type_InstancePointer)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wi1: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } if (TypeOf(start_addr[0]) != type_InstanceHeader) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wi2: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } @@ -297,14 +303,16 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case type_OtherPointer: if ((int)pointer != ((int)start_addr+type_OtherPointer)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wo1: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } /* Is it plausible? Not a cons. X should check the headers. */ if(Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wo2: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } @@ -312,7 +320,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case type_UnboundMarker: case type_BaseChar: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo3: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; @@ -322,13 +331,15 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case type_ByteCodeFunction: case type_ByteCodeClosure: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo4: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; case type_InstanceHeader: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo5: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; @@ -399,14 +410,16 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) default: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo6: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } break; default: if (pointer_filter_verbose) { - fprintf(stderr,"*W?: %x %x %x\n", pointer, start_addr, *start_addr); + fprintf(stderr,"*W?: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } @@ -476,7 +489,7 @@ pscav_i386_stack(void) *valid_stack_ra_locations[i], (int)(*valid_stack_ra_locations[i]) - ((int)valid_stack_ra_code_objects[i] - (int)code_obj), - valid_stack_ra_code_objects[i], code_obj); + (unsigned int) valid_stack_ra_code_objects[i], code_obj); } *valid_stack_ra_locations[i] = ((int)(*valid_stack_ra_locations[i]) @@ -590,6 +603,7 @@ static lispobj ptrans_instance(lispobj thing, lispobj header, boolean constant) } default: gc_abort(); + return NIL; /* dummy value: return something ... */ } } @@ -682,7 +696,6 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) int nheader_words, ncode_words, nwords; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; - lispobj p; lispobj fixups = NIL; unsigned displacement = (unsigned)new_code - (unsigned)old_code; struct vector *fixups_vector; @@ -1143,7 +1156,7 @@ pscav_code(struct code*code) static lispobj *pscav(lispobj *addr, int nwords, boolean constant) { lispobj thing, *thingp, header; - int count; + int count = 0; /* (0 = dummy init value to stop GCC warning) */ struct vector *vector; while (nwords > 0) { @@ -1436,11 +1449,11 @@ int purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif #if !defined(ibmrt) && !defined(__i386__) - pscav(BINDING_STACK_START, - current_binding_stack_pointer - (lispobj *)BINDING_STACK_START, + pscav( (lispobj *)BINDING_STACK_START, + (lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START, 0); #else - pscav(BINDING_STACK_START, + pscav( (lispobj *)BINDING_STACK_START, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - (lispobj *)BINDING_STACK_START, 0); @@ -1455,7 +1468,7 @@ int purify(lispobj static_roots, lispobj read_only_roots) fprintf(stderr, "scavenging read only space: %d bytes\n", read_only_space_size * sizeof(lispobj)); - pscav(READ_ONLY_SPACE_START, read_only_space_size, 0); + pscav( (lispobj *)READ_ONLY_SPACE_START, read_only_space_size, 0); } #endif diff --git a/src/runtime/run-program.c b/src/runtime/run-program.c index 6a88000..6e7bf18 100644 --- a/src/runtime/run-program.c +++ b/src/runtime/run-program.c @@ -16,7 +16,7 @@ #include #include #include -#ifdef SVR4 +#if defined(SVR4) || defined(__linux__) #include #endif @@ -32,7 +32,7 @@ int spawn(char *program, char *argv[], char *envp[], char *pty_name, /* Put us in our own process group. */ #if defined(hpux) setsid(); -#elif defined(SVR4) +#elif defined(SVR4) || defined(__linux__) setpgrp(); #else setpgrp(0, getpid()); diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 3b36bf8..e4ce0d8 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -51,7 +51,8 @@ static void sigint_handler(int signal, siginfo_t *info, void *void_context) { - printf("\nSIGINT hit at 0x%08lX\n", *os_context_pc_addr(void_context)); + printf("\nSIGINT hit at 0x%08lX\n", + (unsigned long) *os_context_pc_addr(void_context)); ldb_monitor(); } @@ -75,6 +76,7 @@ successful_malloc(size_t size) } else { return result; } + return (void *) NULL; /* dummy value: return something ... */ } char * @@ -185,7 +187,9 @@ main(int argc, char *argv[], char *envp[]) char *sbcl_home = getenv("SBCL_HOME"); if (sbcl_home) { char *lookhere; - asprintf(&lookhere, "%s/sbcl.core", sbcl_home); + lookhere = (char *) calloc(strlen("/sbcl.core") + strlen(sbcl_home) + 1, + sizeof(char)); + sprintf(lookhere, "%s/sbcl.core", sbcl_home); core = copied_existing_filename_or_null(lookhere); free(lookhere); } else { @@ -293,4 +297,6 @@ More information on SBCL is available at . /* initial_function() is not supposed to return. */ lose("Lisp initial_function gave up control."); + return 0; /* dummy value: return something */ } + diff --git a/src/runtime/save.c b/src/runtime/save.c index 9412f46..76e7ad7 100644 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@ -144,7 +144,7 @@ save(char *filename, lispobj init_function) gc_alloc_update_page_tables(1,&unboxed_region); update_x86_dynamic_space_free_pointer(); #endif - output_space(file, DYNAMIC_SPACE_ID, DYNAMIC_SPACE_START, + output_space(file, DYNAMIC_SPACE_ID, (lispobj *)DYNAMIC_SPACE_START, (lispobj *)SymbolValue(ALLOCATION_POINTER)); #endif diff --git a/src/runtime/validate.c b/src/runtime/validate.c index 20fad4a..3e021a5 100644 --- a/src/runtime/validate.c +++ b/src/runtime/validate.c @@ -24,7 +24,7 @@ static void ensure_space(lispobj *start, unsigned long size) { if (os_validate((os_vm_address_t)start,(os_vm_size_t)size)==NULL) { fprintf(stderr, - "ensure_space: failed to validate %ld bytes at 0x%08X\n", + "ensure_space: failed to validate %ld bytes at 0x%08lx\n", size, (unsigned long)start); exit(1); @@ -59,11 +59,11 @@ void validate(void) fflush(stdout); #endif - ensure_space(READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE); - ensure_space(STATIC_SPACE_START , STATIC_SPACE_SIZE); - ensure_space(DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE); - ensure_space(CONTROL_STACK_START , CONTROL_STACK_SIZE); - ensure_space(BINDING_STACK_START , BINDING_STACK_SIZE); + ensure_space( (lispobj *)READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE); + ensure_space( (lispobj *)STATIC_SPACE_START , STATIC_SPACE_SIZE); + ensure_space( (lispobj *)DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE); + ensure_space( (lispobj *)CONTROL_STACK_START , CONTROL_STACK_SIZE); + ensure_space( (lispobj *)BINDING_STACK_START , BINDING_STACK_SIZE); #ifdef HOLES make_holes(); diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index e599077..de5edbe 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -79,7 +79,7 @@ void arch_skip_instruction(os_context_t *context) vlen = *(char*)(*os_context_pc_addr(context))++; /* Skip Lisp error arg data bytes. */ while (vlen-- > 0) { - (char*)(*os_context_pc_addr(context))++; + ( (char*)(*os_context_pc_addr(context)) )++; } break; @@ -203,7 +203,6 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) if (*os_context_pc_addr(context) == (int)single_stepping + 1) { fprintf(stderr, "warning: couldn't reinstall breakpoint\n"); } else { - char *ptr = (char*)single_stepping; *((char *)single_stepping) = BREAKPOINT_INST; /* x86 INT3 */ *((char *)single_stepping+1) = trap_Breakpoint; } diff --git a/tests/clos-ignore.interactive.lisp b/tests/clos-ignore.interactive.lisp new file mode 100644 index 0000000..1d69116 --- /dev/null +++ b/tests/clos-ignore.interactive.lisp @@ -0,0 +1,62 @@ +;;;; To test the IGNORE/IGNORABLE behavior in CLOS, run COMPILE-FILE on +;;;; this file and look at the output (warnings, etc.). +;;;; +;;;; (In sbcl-0.6.8.25, the handling of IGNORE and IGNORABLE in +;;;; DEFMETHOD forms was rewritten to systematize the old PCL behavior. +;;;; Now all required variables are IGNORABLE by default.) + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(in-package :cl-user) + +(defgeneric foo ((x t) (y t) &key &allow-other-keys)) + +;;; should have no STYLE-WARNINGs (e.g. about unused vars) +(defmethod foo ((x t) (y t)) + nil) + +;;; should have no STYLE-WARNINGs +(defmethod foo ((x t) (y t) &key &allow-other-keys) + (declare (ignore x))) + +;;; should have no STYLE-WARNINGs +(defmethod foo ((x t) (y t) &key &allow-other-keys) + (declare (ignorable x y)) + (declare (ignore y))) + +;;; should have no STYLE-WARNINGs +(defmethod foo ((x t) (y t) &key &allow-other-keys) + x) + +;;; should have a STYLE-WARNING: using an IGNOREd variable +(defmethod foo ((x t) (y t) &key &allow-other-keys) + (declare (ignore x y)) + x) + +;;; should have no STYLE-WARNINGs +(defmethod foo (x y &key &allow-other-keys) + (declare (ignore x y)) + (call-next-method)) + +;;; should have no STYLE-WARNINGs +(defmethod foo ((x integer) (y t) &key &allow-other-keys) + (declare (ignore x y)) + (call-next-method)) + +;;; should have no STYLE-WARNINGs +(defmethod foo ((x integer) (y t) &key &allow-other-keys) + (declare (ignore x)) + (call-next-method)) + +;;; should have a STYLE-WARNING: Z is unused. +(defmethod foo ((x t) (y integer) &key z) + nil) diff --git a/version.lisp-expr b/version.lisp-expr index 66fe2cc..1e9b549 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.8.25" +"0.6.8.26"