September 2011 - cmucl-cvs - mailman3.common-lisp.net

[cmucl-cvs] CMUCL commit: cmucl-www/cmucl-www/www (index.html)
by Raymond Toy 04 Sep '11

04 Sep '11

Date: Saturday, September 3, 2011 @ 22:38:45 Author: rtoy Path: /project/cmucl/cvsroot/cmucl-www/cmucl-www/www Modified: index.html Update news for 2011-09 snapshot. ------------+ index.html | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) Index: cmucl-www/cmucl-www/www/index.html diff -u cmucl-www/cmucl-www/www/index.html:1.25 cmucl-www/cmucl-www/www/index.html:1.26 --- cmucl-www/cmucl-www/www/index.html:1.25 Tue Jul 5 10:05:54 2011 +++ cmucl-www/cmucl-www/www/index.html Sat Sep 3 22:38:44 2011 @@ -68,7 +68,24 @@ Also see <a href="news/index.html">News</a> for older news. <dl> -<dt><strong>Snapshot 2011-07</strong> +<dt><strong>Snapshot 2011-09</strong> + +<dd> The 2011-09 snapshot has been released. See the release notes for +details, but here is a quick summary of the changes between the this +snapshot and the previous snapshot. + <ul> + <li> ASDF2 updated to version 2.017. + <li> Improve type propagation for LOAD-TIME-VALUE. + <li> Getting documentation of a structure via DOCUMENTATION no longer signals an error. + <li> Reduce unnecessary consing of SAPs in ROOM. + <li> Make stack overflow checking actually work on Mac OS X. The + implementation had the :stack-checking feature, but it didn't + actually prevent stack overflows from crashing lisp. + <li> Fix rounding of numbers larger than a fixnum. + </ul> +</dd> + +<dt>Snapshot 2011-07 <dd> The 2011-07 snapshot has been released. See the release notes for details, but here is a quick summary of the changes between the this

1 0

[cmucl-cvs] CMUCL commit: src/i18n/locale (cmucl.pot)
by Raymond Toy 03 Sep '11

03 Sep '11

Date: Saturday, September 3, 2011 @ 08:04:40 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: cmucl.pot Regenerated from current sources. -----------+ cmucl.pot | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) Index: src/i18n/locale/cmucl.pot diff -u src/i18n/locale/cmucl.pot:1.21 src/i18n/locale/cmucl.pot:1.22 --- src/i18n/locale/cmucl.pot:1.21 Tue Jun 28 12:20:09 2011 +++ src/i18n/locale/cmucl.pot Sat Sep 3 08:04:39 2011 @@ -10725,9 +10725,10 @@ #: src/code/interr.lisp msgid "" -"~2&~@<A control stack overflow has occurred: ~\n" -" the program has entered the yellow control stack guard zone. ~\n" -" Please note that you will be returned to the Top-Level if you ~\n" +"~2&~@<A control stack overflow has occurred:~%~\n" +" the program has entered the yellow control stack guard zone.~%~\n" +" Please note that you will be returned to the Top-Level if " +"you~%~\n" " enter the red control stack guard zone while debugging.~@:>~2%" msgstr ""

1 0

[cmucl-cvs] CMUCL commit: src (code/float.lisp general-info/release-20c.txt)
by Raymond Toy 03 Sep '11

03 Sep '11

Date: Friday, September 2, 2011 @ 22:19:03 Author: rtoy Path: /project/cmucl/cvsroot/src Modified: code/float.lisp general-info/release-20c.txt Fix rounding for large numbers. Bug was pointed by Christophe in private email. Fix is based on his suggested solution. Some examples that should work now: (round 100000000002.9d0) -> 100000000003 (round (+ most-positive-fixnum 1.5w0)) -> 536870912 ------------------------------+ code/float.lisp | 67 ++++++++++++++++++++++------------------- general-info/release-20c.txt | 2 + 2 files changed, 38 insertions(+), 31 deletions(-) Index: src/code/float.lisp diff -u src/code/float.lisp:1.48 src/code/float.lisp:1.49 --- src/code/float.lisp:1.48 Tue Apr 20 10:57:44 2010 +++ src/code/float.lisp Fri Sep 2 22:19:03 2011 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/float.lisp,v 1.48 2010/04/20 17:57:44 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/float.lisp,v 1.49 2011/09/03 05:19:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1257,40 +1257,45 @@ ;;; represented by an integer.] ;;; (defun %unary-round (number) - (number-dispatch ((number real)) - ((integer) number) - ((ratio) (values (round (numerator number) (denominator number)))) - (((foreach single-float double-float #+long-float long-float)) - (if (< (float most-negative-fixnum number) - number - (float most-positive-fixnum number)) - (truly-the fixnum (%unary-round number)) - (multiple-value-bind (bits exp) - (integer-decode-float number) + (flet ((round-integer (bits exp sign) (let* ((shifted (ash bits exp)) - (rounded (if (and (minusp exp) - (oddp shifted) - (not (zerop (logand bits - (ash 1 (- -1 exp)))))) + (roundup-p + ;; Round if the are fraction bits (exp is + ;; negative). + (when (minusp exp) + (let ((fraction (ldb (byte (- exp) 0) bits)) + (half (ash 1 (- -1 exp)))) + ;; If the fraction is less than half, then no + ;; rounding. Otherwise, round up if the + ;; fraction is greater than half or the + ;; integer part is odd (for round-to-even). + (cond ((> fraction half) t) + ((< fraction half) nil) + ((oddp shifted) + t))))) + (rounded (if roundup-p (1+ shifted) shifted))) - (if (minusp number) + + (if (minusp sign) (- rounded) - rounded))))) - #+double-double - ((double-double-float) - (multiple-value-bind (bits exp) - (integer-decode-float number) - (let* ((shifted (ash bits exp)) - (rounded (if (and (minusp exp) - (oddp shifted) - (not (zerop (logand bits - (ash 1 (- -1 exp)))))) - (1+ shifted) - shifted))) - (if (minusp number) - (- rounded) - rounded)))))) + rounded)))) + (number-dispatch ((number real)) + ((integer) number) + ((ratio) (values (round (numerator number) (denominator number)))) + (((foreach single-float double-float #+long-float long-float)) + (if (< (float most-negative-fixnum number) + number + (float most-positive-fixnum number)) + (truly-the fixnum (%unary-round number)) + (multiple-value-bind (bits exp sign) + (integer-decode-float number) + (round-integer bits exp sign)))) + #+double-double + ((double-double-float) + (multiple-value-bind (bits exp sign) + (integer-decode-float number) + (round-integer bits exp sign)))))) (declaim (maybe-inline %unary-ftruncate/single-float %unary-ftruncate/double-float)) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.31 src/general-info/release-20c.txt:1.32 --- src/general-info/release-20c.txt:1.31 Wed Aug 31 21:39:55 2011 +++ src/general-info/release-20c.txt Fri Sep 2 22:19:03 2011 @@ -141,6 +141,8 @@ - Make stack overflow checking actually work on Mac OS X. The implementation had the :stack-checking feature, but it didn't actually prevent stack overflows from crashing lisp. + - Fix rounding of numbers larger than a fixnum. (See Trac #10 for + a related issue.) * Trac Tickets:

1 0

[cmucl-cvs] CMUCL commit: src/lisp (Darwin-os.c)
by Raymond Toy 03 Sep '11

03 Sep '11

Date: Friday, September 2, 2011 @ 21:46:35 Author: rtoy Path: /project/cmucl/cvsroot/src/lisp Modified: Darwin-os.c Cleanup sigbus handler for stack overflow. We don't need sigbus_handler_tramp; sigbus_handle_now is good enough. Print out the PC too when we get a real sigbus. -------------+ Darwin-os.c | 32 +++----------------------------- 1 file changed, 3 insertions(+), 29 deletions(-) Index: src/lisp/Darwin-os.c diff -u src/lisp/Darwin-os.c:1.34 src/lisp/Darwin-os.c:1.35 --- src/lisp/Darwin-os.c:1.34 Thu Sep 1 09:16:49 2011 +++ src/lisp/Darwin-os.c Fri Sep 2 21:46:34 2011 @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.34 2011/09/01 16:16:49 rtoy Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.35 2011/09/03 04:46:34 rtoy Exp $ * */ @@ -462,18 +462,6 @@ interrupt_handle_now(signal, code, context); } - -static int tramp_signal; -static siginfo_t tramp_code; -static ucontext_t tramp_context; - -static void -sigbus_handler_tramp(void) -{ - sigbus_handle_now(tramp_signal, &tramp_code, &tramp_context); -} - - static void sigbus_handler(HANDLER_ARGS) { @@ -508,24 +496,10 @@ if (interrupt_maybe_gc(signal, code, context)) return; #endif -#ifdef RED_ZONE_HIT - { - /* - * Switch back to the normal stack and invoke the Lisp signal - * handler there. Global variables are used to pass the - * context * to the other stack. - */ - - tramp_signal = signal; - tramp_code = *code; - tramp_context = *context; - SC_PC(context) = sigbus_handler_tramp; - return; - } -#endif /* a *real* protection fault */ - fprintf(stderr, "sigbus_handler: Real protection violation: %p\n", fault_addr); + fprintf(stderr, "sigbus_handler: Real protection violation at %p, PC = %p\n", + fault_addr, SC_PC(context)); sigbus_handle_now(signal, code, context); #ifdef __ppc__ /* Work around G5 bug; fix courtesy gbyers via chandler */

1 0

[cmucl-cvs] CMUCL commit: src/code (interr.lisp)
by Raymond Toy 01 Sep '11

01 Sep '11

Date: Thursday, September 1, 2011 @ 09:53:46 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: interr.lisp Insert line breaks in the yellow-zone message. -------------+ interr.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) Index: src/code/interr.lisp diff -u src/code/interr.lisp:1.50 src/code/interr.lisp:1.51 --- src/code/interr.lisp:1.50 Tue Apr 20 10:57:44 2010 +++ src/code/interr.lisp Thu Sep 1 09:53:46 2011 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/interr.lisp,v 1.50 2010/04/20 17:57:44 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/interr.lisp,v 1.51 2011/09/01 16:53:46 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -666,9 +666,9 @@ (defun yellow-zone-hit () (let ((debug:*stack-top-hint* nil)) (format *error-output* - (intl:gettext "~2&~@<A control stack overflow has occurred: ~ - the program has entered the yellow control stack guard zone. ~ - Please note that you will be returned to the Top-Level if you ~ + (intl:gettext "~2&~@<A control stack overflow has occurred:~%~ + the program has entered the yellow control stack guard zone.~%~ + Please note that you will be returned to the Top-Level if you~%~ enter the red control stack guard zone while debugging.~@:>~2%")) (infinite-error-protect (error 'stack-overflow))))

1 0

[cmucl-cvs] CMUCL commit: src/lisp (Darwin-os.c)
by Raymond Toy 01 Sep '11

01 Sep '11

Date: Thursday, September 1, 2011 @ 09:16:50 Author: rtoy Path: /project/cmucl/cvsroot/src/lisp Modified: Darwin-os.c Oops. Need to check for gc write barrier before handling the sigbus. -------------+ Darwin-os.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) Index: src/lisp/Darwin-os.c diff -u src/lisp/Darwin-os.c:1.33 src/lisp/Darwin-os.c:1.34 --- src/lisp/Darwin-os.c:1.33 Wed Aug 31 22:18:26 2011 +++ src/lisp/Darwin-os.c Thu Sep 1 09:16:49 2011 @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.33 2011/09/01 05:18:26 rtoy Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.34 2011/09/01 16:16:49 rtoy Exp $ * */ @@ -497,6 +497,17 @@ DPRINTF(0, (stderr, " foreign_function_call = %d\n", foreign_function_call_active)); #endif +#if defined(GENCGC) +#if defined(SIGSEGV_VERBOSE) + fprintf(stderr, "Signal %d, fault_addr=%x\n", + signal, fault_addr); +#endif + if (gc_write_barrier(code->si_addr)) + return; +#else + if (interrupt_maybe_gc(signal, code, context)) + return; +#endif #ifdef RED_ZONE_HIT { /* @@ -504,6 +515,7 @@ * handler there. Global variables are used to pass the * context * to the other stack. */ + tramp_signal = signal; tramp_code = *code; tramp_context = *context; @@ -512,17 +524,6 @@ } #endif -#if defined(GENCGC) -#if defined(SIGSEGV_VERBOSE) - fprintf(stderr, "Signal %d, fault_addr=%x, page_index=%d:\n", - signal, fault_addr, page_index); -#endif - if (gc_write_barrier(code->si_addr)) - return; -#else - if (interrupt_maybe_gc(signal, code, context)) - return; -#endif /* a *real* protection fault */ fprintf(stderr, "sigbus_handler: Real protection violation: %p\n", fault_addr); sigbus_handle_now(signal, code, context);

1 0

[cmucl-cvs] CMUCL commit: src/lisp (13 files)
by Raymond Toy 01 Sep '11

01 Sep '11

Date: Wednesday, August 31, 2011 @ 22:18:26 Author: rtoy Path: /project/cmucl/cvsroot/src/lisp Modified: Darwin-os.c FreeBSD-os.c Linux-os.c NetBSD-os.c OpenBSD-os.c hpux-os.c irix-os.c lisp.c mach-os.c os.h osf1-os.c solaris-os.c sunos-os.c Add os_init0 to allow for some really early OS inits. On Linux, os_init can re-exec lisp to set up the correct personality. Not normally a problem, but if any output happens before os_init is called, the output appears to happen twice. So add os_init0 to do this early on, before any output. This is a bit of a kludge. lisp/lisp.c: o Call os_init0 early in main. lisp/Linux-os.c: o Move the personality stuff from os_init to os_init0. lisp/Darwin-os.c: lisp/FreeBSD-os.c: lisp/NetBSD-os.c: lisp/OpenBSD-os.c: lisp/hpux-os.c: lisp/irix-os.c: lisp/mach-os.c: lisp/osf1-os.c: lisp/solaris-os.c: lisp/sunos-os.c: o Add dummy implementation of os_init0. These OSes don't (currently) need anything special. lisp/os.h: o Declare os_init0. --------------+ Darwin-os.c | 5 ++++- FreeBSD-os.c | 6 +++++- Linux-os.c | 13 ++++++++++--- NetBSD-os.c | 6 +++++- OpenBSD-os.c | 6 +++++- hpux-os.c | 6 +++++- irix-os.c | 6 +++++- lisp.c | 12 +++++++++++- mach-os.c | 6 +++++- os.h | 3 ++- osf1-os.c | 6 +++++- solaris-os.c | 6 +++++- sunos-os.c | 6 +++++- 13 files changed, 72 insertions(+), 15 deletions(-) Index: src/lisp/Darwin-os.c diff -u src/lisp/Darwin-os.c:1.32 src/lisp/Darwin-os.c:1.33 --- src/lisp/Darwin-os.c:1.32 Wed Aug 31 21:39:56 2011 +++ src/lisp/Darwin-os.c Wed Aug 31 22:18:26 2011 @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.32 2011/09/01 04:39:56 rtoy Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.33 2011/09/01 05:18:26 rtoy Exp $ * */ @@ -99,6 +99,9 @@ } #endif +void +os_init0(const char *argv[], const char *envp[]) +{} void os_init(const char *argv[], const char *envp[]) Index: src/lisp/FreeBSD-os.c diff -u src/lisp/FreeBSD-os.c:1.37 src/lisp/FreeBSD-os.c:1.38 --- src/lisp/FreeBSD-os.c:1.37 Sun Dec 26 08:04:43 2010 +++ src/lisp/FreeBSD-os.c Wed Aug 31 22:18:26 2011 @@ -12,7 +12,7 @@ * Much hacked by Paul Werkowski * GENCGC support by Douglas Crosher, 1996, 1997. * - * $Header: /project/cmucl/cvsroot/src/lisp/FreeBSD-os.c,v 1.37 2010/12/26 16:04:43 rswindells Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/FreeBSD-os.c,v 1.38 2011/09/01 05:18:26 rtoy Exp $ * */ @@ -39,6 +39,10 @@ vm_size_t os_vm_page_size; void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { os_vm_page_size = getpagesize(); Index: src/lisp/Linux-os.c diff -u src/lisp/Linux-os.c:1.51 src/lisp/Linux-os.c:1.52 --- src/lisp/Linux-os.c:1.51 Sun Dec 26 08:04:43 2010 +++ src/lisp/Linux-os.c Wed Aug 31 22:18:26 2011 @@ -15,7 +15,7 @@ * GENCGC support by Douglas Crosher, 1996, 1997. * Alpha support by Julian Dolby, 1999. * - * $Header: /project/cmucl/cvsroot/src/lisp/Linux-os.c,v 1.51 2010/12/26 16:04:43 rswindells Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/Linux-os.c,v 1.52 2011/09/01 05:18:26 rtoy Exp $ * */ @@ -132,6 +132,15 @@ } void +os_init0(const char *argv[], const char *envp[]) +{ + struct utsname name; + + uname(&name); + check_personality(&name, argv, envp); +} + +void os_init(const char *argv[], const char *envp[]) { struct utsname name; @@ -146,8 +155,6 @@ } os_vm_page_size = getpagesize(); - - check_personality(&name, argv, envp); } #ifdef __i386 Index: src/lisp/NetBSD-os.c diff -u src/lisp/NetBSD-os.c:1.19 src/lisp/NetBSD-os.c:1.20 --- src/lisp/NetBSD-os.c:1.19 Sun Dec 26 08:04:43 2010 +++ src/lisp/NetBSD-os.c Wed Aug 31 22:18:26 2011 @@ -15,7 +15,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for NetBSD by Pierre R. Mai, 2002. * - * $Header: /project/cmucl/cvsroot/src/lisp/NetBSD-os.c,v 1.19 2010/12/26 16:04:43 rswindells Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/NetBSD-os.c,v 1.20 2011/09/01 05:18:26 rtoy Exp $ * */ @@ -46,6 +46,10 @@ void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; Index: src/lisp/OpenBSD-os.c diff -u src/lisp/OpenBSD-os.c:1.10 src/lisp/OpenBSD-os.c:1.11 --- src/lisp/OpenBSD-os.c:1.10 Mon Feb 1 08:04:43 2010 +++ src/lisp/OpenBSD-os.c Wed Aug 31 22:18:26 2011 @@ -13,7 +13,7 @@ * GENCGC support by Douglas Crosher, 1996, 1997. * Frobbed for OpenBSD by Pierre R. Mai, 2001. * - * $Header: /project/cmucl/cvsroot/src/lisp/OpenBSD-os.c,v 1.10 2010/02/01 16:04:43 rtoy Rel $ + * $Header: /project/cmucl/cvsroot/src/lisp/OpenBSD-os.c,v 1.11 2011/09/01 05:18:26 rtoy Exp $ * */ @@ -41,6 +41,10 @@ void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; Index: src/lisp/hpux-os.c diff -u src/lisp/hpux-os.c:1.10 src/lisp/hpux-os.c:1.11 --- src/lisp/hpux-os.c:1.10 Mon Feb 1 08:04:43 2010 +++ src/lisp/hpux-os.c Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/hpux-os.c,v 1.10 2010/02/01 16:04:43 rtoy Rel $ + * $Header: /project/cmucl/cvsroot/src/lisp/hpux-os.c,v 1.11 2011/09/01 05:18:26 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -53,6 +53,10 @@ } segments[MAX_SEGMENTS]; void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { int i; Index: src/lisp/irix-os.c diff -u src/lisp/irix-os.c:1.6 src/lisp/irix-os.c:1.7 --- src/lisp/irix-os.c:1.6 Mon Feb 1 08:04:43 2010 +++ src/lisp/irix-os.c Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/irix-os.c,v 1.6 2010/02/01 16:04:43 rtoy Rel $ + * $Header: /project/cmucl/cvsroot/src/lisp/irix-os.c,v 1.7 2011/09/01 05:18:26 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -30,6 +30,10 @@ int zero_fd; void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { zero_fd = open("/dev/zero", O_RDONLY); Index: src/lisp/lisp.c diff -u src/lisp/lisp.c:1.83 src/lisp/lisp.c:1.84 --- src/lisp/lisp.c:1.83 Fri Jun 10 12:32:31 2011 +++ src/lisp/lisp.c Wed Aug 31 22:18:26 2011 @@ -1,7 +1,7 @@ /* * main() entry point for a stand alone lisp image. * - * $Header: /project/cmucl/cvsroot/src/lisp/lisp.c,v 1.83 2011/06/10 19:32:31 rtoy Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/lisp.c,v 1.84 2011/09/01 05:18:26 rtoy Exp $ * */ @@ -461,6 +461,16 @@ } + /* + * Do any special OS initialization that needs to be done early. + * In particular, on Linux, we might re-exec ourselves to set our + * personality correctly. Not normally a problem, but this does + * cause any output to happen twice. That can be confusing. + * + * So make sure we don't do any output before this point! + */ + + os_init0(argv, envp); #if defined(SVR4) tzset(); #endif Index: src/lisp/mach-os.c diff -u src/lisp/mach-os.c:1.8 src/lisp/mach-os.c:1.9 --- src/lisp/mach-os.c:1.8 Mon Feb 1 08:04:43 2010 +++ src/lisp/mach-os.c Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/mach-os.c,v 1.8 2010/02/01 16:04:43 rtoy Rel $ + * $Header: /project/cmucl/cvsroot/src/lisp/mach-os.c,v 1.9 2011/09/01 05:18:26 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -38,6 +38,10 @@ #endif void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { os_vm_page_size = vm_page_size; Index: src/lisp/os.h diff -u src/lisp/os.h:1.27 src/lisp/os.h:1.28 --- src/lisp/os.h:1.27 Sun Dec 26 08:04:43 2010 +++ src/lisp/os.h Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/os.h,v 1.27 2010/12/26 16:04:43 rswindells Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/os.h,v 1.28 2011/09/01 05:18:26 rtoy Exp $ * * Common interface for os-dependent functions. * @@ -72,6 +72,7 @@ extern os_vm_size_t os_vm_page_size; +extern void os_init0(const char *argv[], const char *envp[]); extern void os_init(const char *argv[], const char *envp[]); extern void os_install_interrupt_handlers(void); Index: src/lisp/osf1-os.c diff -u src/lisp/osf1-os.c:1.6 src/lisp/osf1-os.c:1.7 --- src/lisp/osf1-os.c:1.6 Mon Feb 1 08:04:43 2010 +++ src/lisp/osf1-os.c Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/osf1-os.c,v 1.6 2010/02/01 16:04:43 rtoy Rel $ + * $Header: /project/cmucl/cvsroot/src/lisp/osf1-os.c,v 1.7 2011/09/01 05:18:26 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -26,6 +26,10 @@ vm_size_t os_vm_page_size; void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { int buf[2] = { SSIN_UACPROC, UAC_SIGBUS | UAC_NOPRINT }; Index: src/lisp/solaris-os.c diff -u src/lisp/solaris-os.c:1.29 src/lisp/solaris-os.c:1.30 --- src/lisp/solaris-os.c:1.29 Sun Dec 26 08:04:43 2010 +++ src/lisp/solaris-os.c Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/solaris-os.c,v 1.29 2010/12/26 16:04:43 rswindells Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/solaris-os.c,v 1.30 2011/09/01 05:18:26 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -73,6 +73,10 @@ } void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { zero_fd = open(ZEROFILE, O_RDONLY); Index: src/lisp/sunos-os.c diff -u src/lisp/sunos-os.c:1.12 src/lisp/sunos-os.c:1.13 --- src/lisp/sunos-os.c:1.12 Mon Feb 1 08:04:43 2010 +++ src/lisp/sunos-os.c Wed Aug 31 22:18:26 2011 @@ -1,5 +1,5 @@ /* - * $Header: /project/cmucl/cvsroot/src/lisp/sunos-os.c,v 1.12 2010/02/01 16:04:43 rtoy Rel $ + * $Header: /project/cmucl/cvsroot/src/lisp/sunos-os.c,v 1.13 2011/09/01 05:18:26 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -81,6 +81,10 @@ } void +os_init0(const char *argv[], const char *envp[]) +{} + +void os_init(const char *argv[], const char *envp[]) { char *empty_file = getenv("CMUCL_EMPTYFILE");

1 0

[cmucl-cvs] CMUCL commit: src (general-info/release-20c.txt lisp/Darwin-os.c)
by Raymond Toy 01 Sep '11

01 Sep '11

Date: Wednesday, August 31, 2011 @ 21:39:56 Author: rtoy Path: /project/cmucl/cvsroot/src Modified: general-info/release-20c.txt lisp/Darwin-os.c Make the stack checking feature actually work on Darwin. Previously, stack overflows would crash lisp. Darwin-os.c: o Need to check for stack overflow in the sigbus handler. (Without that, it's treated as a regular bus error.) o Add the rest of the infrastructure to handle the stack overflow. release-20c.txt: o Update ------------------------------+ general-info/release-20c.txt | 3 +++ lisp/Darwin-os.c | 41 +++++++++++++++++++++++++++++++++++++++-- 2 files changed, 42 insertions(+), 2 deletions(-) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.30 src/general-info/release-20c.txt:1.31 --- src/general-info/release-20c.txt:1.30 Mon Aug 22 21:16:04 2011 +++ src/general-info/release-20c.txt Wed Aug 31 21:39:55 2011 @@ -138,6 +138,9 @@ signals an error in DGETTEXT trying to translate the null documentation string. - Reduce unnecessary consing of SAPs in ROOM. + - Make stack overflow checking actually work on Mac OS X. The + implementation had the :stack-checking feature, but it didn't + actually prevent stack overflows from crashing lisp. * Trac Tickets: Index: src/lisp/Darwin-os.c diff -u src/lisp/Darwin-os.c:1.31 src/lisp/Darwin-os.c:1.32 --- src/lisp/Darwin-os.c:1.31 Sun Dec 26 08:04:43 2010 +++ src/lisp/Darwin-os.c Wed Aug 31 21:39:56 2011 @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.31 2010/12/26 16:04:43 rswindells Exp $ + * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.32 2011/09/01 04:39:56 rtoy Exp $ * */ @@ -453,6 +453,23 @@ return FALSE; } +static void +sigbus_handle_now(HANDLER_ARGS) +{ + interrupt_handle_now(signal, code, context); +} + + +static int tramp_signal; +static siginfo_t tramp_code; +static ucontext_t tramp_context; + +static void +sigbus_handler_tramp(void) +{ + sigbus_handle_now(tramp_signal, &tramp_code, &tramp_context); +} + static void sigbus_handler(HANDLER_ARGS) @@ -461,6 +478,11 @@ caddr_t fault_addr = code->si_addr; #endif +#ifdef RED_ZONE_HIT + if (os_control_stack_overflow((void *) fault_addr, context)) + return; +#endif + #ifdef __ppc__ DPRINTF(0, (stderr, "sigbus:\n")); DPRINTF(0, (stderr, " PC = %p\n", SC_PC(context))); @@ -472,6 +494,21 @@ DPRINTF(0, (stderr, " foreign_function_call = %d\n", foreign_function_call_active)); #endif +#ifdef RED_ZONE_HIT + { + /* + * Switch back to the normal stack and invoke the Lisp signal + * handler there. Global variables are used to pass the + * context * to the other stack. + */ + tramp_signal = signal; + tramp_code = *code; + tramp_context = *context; + SC_PC(context) = sigbus_handler_tramp; + return; + } +#endif + #if defined(GENCGC) #if defined(SIGSEGV_VERBOSE) fprintf(stderr, "Signal %d, fault_addr=%x, page_index=%d:\n", @@ -485,7 +522,7 @@ #endif /* a *real* protection fault */ fprintf(stderr, "sigbus_handler: Real protection violation: %p\n", fault_addr); - interrupt_handle_now(signal, code, context); + sigbus_handle_now(signal, code, context); #ifdef __ppc__ /* Work around G5 bug; fix courtesy gbyers via chandler */ sigreturn(context);

1 0