cmucl-cvs April 2015

cmucl-cvs@common-lisp.net

3 participants
318 discussions

Start a nNew thread

[git] CMU Common Lisp branch master updated. snapshot-2013-11-1-g373bc97
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-25-g712df0b
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 712df0bc4e655226bc5c9ed91aa9c875b4a5eb0d (commit) via bf84dbc8c5bd5478fd36b55f99e119cfff11ca6d (commit) via 2e3e48d466c67a09ea7aeb23106fdc50143be3b5 (commit) via 949acab5719c22e51a45a936271b46b04edaa8ac (commit) via 6f25e2e894bdf13c00a29651031ad0bbedb50f0e (commit) via 408aa78aa3947f2c8f8a5b2a03429d5c05e93fbe (commit) via 00bd409b8d9de4f5f6223bf4d017e6f1c0826e48 (commit) from 82d0a77961bbbe867e78086800203e6af80c2d9c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- ----------------------------------------------------------------------- Summary of changes: src/code/irrat-dd.lisp | 200 +++++++++++--------------------------- src/code/irrat.lisp | 4 +- src/compiler/float-tran.lisp | 5 +- src/tests/trig.lisp | 216 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 278 insertions(+), 147 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-01-6-g87ef443
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-28-g7a5843f
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

1 0

[git] CMU Common Lisp branch master updated. 20e-1-ga7ace14
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via a7ace14123e6cbe17f041142328593287cdf6586 (commit) from bc828bed51339b951d84d2a264adf0221172f126 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a7ace14123e6cbe17f041142328593287cdf6586 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Sep 29 14:44:15 2013 -0700 Print integers with lowercase when *print-case* is :downcase. Could optimize SUB-OUTPUT-INTEGER and DIGIT-TO-CHAR if needed, but I'm assuming printing of fixnums and bignums is not limited by the conversion of each digit to a character. * src/code/print.lisp: * Print integers in lowercase if *print-case* is :downcase * Update a docstring. * src/i18n/locale/cmucl.pot: * Update * src/general-info/release-20f.txt: * New file with updated info. diff --git a/src/code/print.lisp b/src/code/print.lisp index f2f42c9..999bc94 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1297,17 +1297,22 @@ (write-char #\. stream))) (defun sub-output-integer (integer stream) - (let ((quotient ()) - (remainder ())) + (declare (type (and fixnum unsigned-byte) integer)) + (let ((quotient 0) + (remainder 0)) + (declare (fixnum quotient remainder)) ;; Recurse until you have all the digits pushed on the stack. - (if (not (zerop (multiple-value-setq (quotient remainder) - (truncate integer *print-base*)))) - (sub-output-integer quotient stream)) + (when (not (zerop (multiple-value-setq (quotient remainder) + (truncate integer (the (integer 2 35) *print-base*))))) + (sub-output-integer quotient stream)) ;; Then as each recursive call unwinds, turn the digit (in remainder) ;; into a character and output the character. (write-char (code-char (if (and (> remainder 9.) (> *print-base* 10.)) - (+ (char-code #\A) (- remainder 10.)) + (+ (if (eq *print-case* :downcase) + (char-code #\a) + (char-code #\A)) + (- remainder 10.)) (+ (char-code #\0) remainder))) stream))) @@ -1343,12 +1348,12 @@ greater than n." (declaim (inline digit-to-char)) (defun digit-to-char (d) - "Convert digit into a character representation. We use 0..9, a..z for -10..35, and A..Z for 36..52." + "Convert digit into a character representation." (declare (fixnum d)) (labels ((offset (d b) (code-char (+ d (char-code b))))) (cond ((< d 10) (offset d #\0)) - ((< d 36) (offset (- d 10) #\A)) + ((< d 36) (offset (- d 10) (if (eq *print-case* :downcase) + #\a #\A))) (t (error _"overflow in digit-to-char"))))) (defun print-fixnum-sub (n r z s) diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt new file mode 100644 index 0000000..3c6db52 --- /dev/null +++ b/src/general-info/release-20f.txt @@ -0,0 +1,51 @@ +========================== C M U C L 20 f ============================= + +[In Progress] + +The CMUCL project is pleased to announce the release of CMUCL 20f. +This is a major release which contains numerous enhancements and +bug fixes from the 20c release. + +CMUCL is a free, high performance implementation of the Common Lisp +programming language which runs on most major Unix platforms. It +mainly conforms to the ANSI Common Lisp standard. CMUCL provides a +sophisticated native code compiler; a powerful foreign function +interface; an implementation of CLOS, the Common Lisp Object System, +which includes multi-methods and a meta-object protocol; a source-level +debugger and code profiler; and an Emacs-like editor implemented in +Common Lisp. CMUCL is maintained by a team of volunteers collaborating +over the Internet, and is mostly in the public domain. + +New in this release: + + * Known issues: + + * Feature enhancements + + * Changes + * When *PRINT-CASE* is :DOWNCASE, integers are printed with + lowercase letters when needed. + + * ANSI compliance fixes: + + * Bugfixes: + + + * Trac Tickets: + + * Other changes: + + * Improvements to the PCL implementation of CLOS: + + * Changes to building procedure: + + +This release is not binary compatible with code compiled using CMUCL +20e; you will need to recompile FASL files. + +See <URL:http://www.cmucl.org> or +<URL:http://trac.common-lisp.net/cmucl> for download information, +guidelines on reporting bugs, and mailing list details. + + +We hope you enjoy using this release of CMUCL! diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 896d902..3d53de0 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -7355,9 +7355,7 @@ msgid "overflow in digit-to-char" msgstr "" #: src/code/print.lisp -msgid "" -"Convert digit into a character representation. We use 0..9, a..z for\n" -"10..35, and A..Z for 36..52." +msgid "Convert digit into a character representation." msgstr "" #: src/code/print.lisp ----------------------------------------------------------------------- Summary of changes: src/code/print.lisp | 23 ++++++++++------- src/general-info/release-20f.txt | 51 ++++++++++++++++++++++++++++++++++++++ src/i18n/locale/cmucl.pot | 4 +-- 3 files changed, 66 insertions(+), 12 deletions(-) create mode 100644 src/general-info/release-20f.txt hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-03-a-12-gb722521
by rtoy＠alpha-cl-net.common-lisp.net 08 Apr '15

08 Apr '15

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-4-g1b9697d
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 1b9697d7923b1e9f7d875b94a13e427ddc651453 (commit) from da059a86b5eca795f157ca85e74520a76ab5207f (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 1b9697d7923b1e9f7d875b94a13e427ddc651453 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Jul 20 21:00:47 2014 -0700 Update to use unions, using the style of e_rem_pio2.c. diff --git a/src/lisp/k_cos.c b/src/lisp/k_cos.c index 7fb855d..2be76e0 100644 --- a/src/lisp/k_cos.c +++ b/src/lisp/k_cos.c @@ -70,7 +70,10 @@ C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */ { double a,hz,z,r,qx; int ix; - ix = __HI(x)&0x7fffffff; /* ix = |x|'s high word*/ + union { int i[2]; double d; } ux; + + ux.d = x; + ix = ux.i[HIWORD]&0x7fffffff; /* ix = |x|'s high word*/ if(ix<0x3e400000) { /* if x < 2**27 */ if(((int)x)==0) return one; /* generate inexact */ } @@ -82,8 +85,9 @@ C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */ if(ix > 0x3fe90000) { /* x > 0.78125 */ qx = 0.28125; } else { - __HI(qx) = ix-0x00200000; /* x/4 */ - __LO(qx) = 0; + ux.i[HIWORD] = ix-0x00200000; + ux.i[LOWORD] = 0; + qx = ux.d; } hz = 0.5*z-qx; a = one-qx; diff --git a/src/lisp/k_sin.c b/src/lisp/k_sin.c index dfcad76..dd660af 100644 --- a/src/lisp/k_sin.c +++ b/src/lisp/k_sin.c @@ -63,7 +63,10 @@ S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */ { double z,r,v; int ix; - ix = __HI(x)&0x7fffffff; /* high word of x */ + union { int i[2]; double d; } ux; + + ux.d = x; + ix = ux.i[HIWORD]&0x7fffffff; /* high word of x */ if(ix<0x3e400000) /* |x| < 2**-27 */ {if((int)x==0) return x;} /* generate inexact */ z = x*x; diff --git a/src/lisp/k_tan.c b/src/lisp/k_tan.c index 017c1e5..10fa562 100644 --- a/src/lisp/k_tan.c +++ b/src/lisp/k_tan.c @@ -1,5 +1,3 @@ -#pragma ident "@(#)k_tan.c 1.5 04/04/22 SMI" - /* * ==================================================== * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. @@ -74,12 +72,14 @@ double __kernel_tan(double x, double y, int iy) { double z, r, v, w, s; int ix, hx; + union { int i[2]; double d; } ux,uz; - hx = __HI(x); /* high word of x */ + ux.d = x; + hx = ux.i[HIWORD]; /* high word of x */ ix = hx & 0x7fffffff; /* high word of |x| */ if (ix < 0x3e300000) { /* x < 2**-28 */ if ((int) x == 0) { /* generate inexact */ - if (((ix | __LO(x)) | (iy + 1)) == 0) + if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0) return one / fabs(x); else { if (iy == 1) @@ -88,10 +88,16 @@ __kernel_tan(double x, double y, int iy) { double a, t; z = w = x + y; - __LO(z) = 0; + uz.d = z; + uz.i[LOWORD] = 0; + z = ux.d; + v = y - (z - x); t = a = -one / w; - __LO(t) = 0; + uz.d = t; + uz.i[LOWORD] = 0; + t = uz.d; + s = one + t * z; return t + a * (s + t * v); } @@ -138,10 +144,14 @@ __kernel_tan(double x, double y, int iy) { /* compute -1.0 / (x+r) accurately */ double a, t; z = w; - __LO(z) = 0; + uz.d = z; + uz.i[LOWORD] = 0; + z = uz.d; v = r - (z - x); /* z+v = r+x */ t = a = -1.0 / w; /* a = -1.0/w */ - __LO(t) = 0; + uz.d = t; + uz.i[LOWORD] = 0; + t = uz.d; s = 1.0 + t * z; return t + a * (s + t * v); } diff --git a/src/lisp/s_cos.c b/src/lisp/s_cos.c index 3bab516..a897133 100644 --- a/src/lisp/s_cos.c +++ b/src/lisp/s_cos.c @@ -53,9 +53,12 @@ { double y[2],z=0.0; int n, ix; + union { int i[2]; double d; } ux; /* High word of x. */ - ix = __HI(x); + ux.d = x; + ix = ux.i[HIWORD]; + /* |x| ~< pi/4 */ ix &= 0x7fffffff; diff --git a/src/lisp/s_sin.c b/src/lisp/s_sin.c index 43394e5..1dba1c8 100644 --- a/src/lisp/s_sin.c +++ b/src/lisp/s_sin.c @@ -53,9 +53,11 @@ { double y[2],z=0.0; int n, ix; - + union { int i[2]; double d; } ux; + /* High word of x. */ - ix = __HI(x); + ux.d = x; + ix = ux.i[HIWORD]; /* |x| ~< pi/4 */ ix &= 0x7fffffff; diff --git a/src/lisp/s_tan.c b/src/lisp/s_tan.c index 1f5564b..4761a4c 100644 --- a/src/lisp/s_tan.c +++ b/src/lisp/s_tan.c @@ -52,9 +52,11 @@ { double y[2],z=0.0; int n, ix; + union { int i[2]; double d; } ux; /* High word of x. */ - ix = __HI(x); + ux.d = x; + ix = ux.i[HIWORD]; /* |x| ~< pi/4 */ ix &= 0x7fffffff; ----------------------------------------------------------------------- Summary of changes: src/lisp/k_cos.c | 10 +++++++--- src/lisp/k_sin.c | 5 ++++- src/lisp/k_tan.c | 26 ++++++++++++++++++-------- src/lisp/s_cos.c | 5 ++++- src/lisp/s_sin.c | 6 ++++-- src/lisp/s_tan.c | 4 +++- 6 files changed, 40 insertions(+), 16 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-11-g32ad743
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 32ad743155af81b7c3e2ee31726272a85e8f3247 (commit) via 68d2565d81c3db6aa23943d9f371213914b3747c (commit) from 128d65bef6e7d5c4d2701f05b2944bd5ec2223c9 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 32ad743155af81b7c3e2ee31726272a85e8f3247 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 20 13:48:07 2014 -0700 Use fdlibm_setexception to signal appropriate exceptions. diff --git a/src/lisp/e_log10.c b/src/lisp/e_log10.c index f963cc7..73fa7f3 100644 --- a/src/lisp/e_log10.c +++ b/src/lisp/e_log10.c @@ -77,8 +77,8 @@ static double zero = 0.0; k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ if (((hx&0x7fffffff)|lx)==0) - return -two54/zero; /* log(+-0)=-inf */ - if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ + return fdlibm_setexception(-1.0, FDLIBM_DIVIDE_BY_ZERO); /* log(+-0)=-inf */ + if (hx<0) return fdlibm_setexception(x-x, FDLIBM_INVALID); /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ ux.d = x; hx = ux.i[HIWORD]; commit 68d2565d81c3db6aa23943d9f371213914b3747c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 20 13:27:43 2014 -0700 Update to use a union. diff --git a/src/lisp/e_log10.c b/src/lisp/e_log10.c index dc7e312..f963cc7 100644 --- a/src/lisp/e_log10.c +++ b/src/lisp/e_log10.c @@ -68,9 +68,11 @@ static double zero = 0.0; double y,z; int i,k,hx; unsigned lx; + union { int i[2]; double d; } ux; - hx = __HI(x); /* high word of x */ - lx = __LO(x); /* low word of x */ + ux.d = x; + hx = ux.i[HIWORD]; + lx = ux.i[LOWORD]; k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ @@ -78,14 +80,16 @@ static double zero = 0.0; return -two54/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ - hx = __HI(x); /* high word of x */ + ux.d = x; + hx = ux.i[HIWORD]; } if (hx >= 0x7ff00000) return x+x; k += (hx>>20)-1023; i = ((unsigned)k&0x80000000)>>31; hx = (hx&0x000fffff)|((0x3ff-i)<<20); y = (double)(k+i); - __HI(x) = hx; + ux.i[HIWORD] = hx; + x = ux.d; z = y*log10_2lo + ivln10*__ieee754_log(x); return z+y*log10_2hi; } ----------------------------------------------------------------------- Summary of changes: src/lisp/e_log10.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-6-g13bd32f
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 13bd32f69a31581b50582d6283ba08b745eca6d3 (commit) from ee7c488f2d0b57d8431ff3bff1b15bb58762e197 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 13bd32f69a31581b50582d6283ba08b745eca6d3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Sep 12 00:29:00 2014 -0700 Remove the NetBSD setexception changes on the master branch. This is only for the upcoming release. diff --git a/src/lisp/GNUmakefile b/src/lisp/GNUmakefile index 056e9ea..c557d3b 100644 --- a/src/lisp/GNUmakefile +++ b/src/lisp/GNUmakefile @@ -12,7 +12,7 @@ FDLIBM = k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \ e_acosh.c s_asinh.c e_atanh.c \ e_atan2.c \ e_rem_pio2.c k_rem_pio2.c \ - setexception.c double-values.c + setexception.c SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ vars.c parse.c interrupt.c search.c validate.c globals.c \ diff --git a/src/lisp/double-values.c b/src/lisp/double-values.c deleted file mode 100644 index 79d5921..0000000 --- a/src/lisp/double-values.c +++ /dev/null @@ -1,40 +0,0 @@ -/* - * Some helper functions to return specific double values for use by - * fdlibm_setexceptions on NetBSD. Currently, NetBSD doesn't have - * feraiseexcept so we have to do something special. See - * fdlibm_setexceptions. - */ - -#include "fdlibm.h" - -double -double_zero() -{ - return 0.0; -} - -/* - * Return most-positive-double-float - */ -double -double_huge() -{ - union { int i[2]; double d; } ux; - ux.i[HIWORD] = 0x7fefffff; - ux.i[LOWORD] = 0xffffffff; - - return ux.d; -} - -/* - * Return least-positive-double-float - */ -double -double_tiny() -{ - union { int i[2]; double d; } ux; - ux.i[HIWORD] = 0; - ux.i[LOWORD] = 1; - - return ux.d; -} diff --git a/src/lisp/setexception.c b/src/lisp/setexception.c index d0f4519..a77a9d8 100644 --- a/src/lisp/setexception.c +++ b/src/lisp/setexception.c @@ -1,25 +1,4 @@ -#if defined(__NetBSD__) -/* - * NetBSD doesn't have fenv.h. At least the version currently being - * used to build cmucl doesn't. Assume this also means we don't have - * feraiseexcept. So, to generate the desired exceptions, we have to - * create the appropriate operations to generate the desired - * exceptions. - */ -#undef HAVE_FERAISEEXCEPT - -extern double double_zero(); -extern double double_huge(); -extern double double_tiny(); - -#else -#define HAVE_FERAISEEXCEPT -#endif - -#ifdef HAVE_FERAISEEXCEPT #include <fenv.h> -#endif - #include <math.h> #include <stdio.h> @@ -71,48 +50,32 @@ fdlibm_setexception(double x, enum FDLIBM_EXCEPTION type) /* Division by zero. Use the sign of x to get the correct * signed infinity */ -#ifdef HAVE_FERAISEEXCEPT feraiseexcept(FE_DIVBYZERO); - ret = copysign(INFINITY, x); -#else - ret = copysign(1, x) / double_zero(); -#endif + ret = copysign(INFINITY, x); break; case 1: /* Underflow. Use the sign of x to get a signed zero. */ -#ifdef HAVE_FERAISEEXCEPT feraiseexcept(FE_UNDERFLOW); ret = copysign(0.0, x); -#else - ret = double_tiny() * double_tiny();; -#endif break; case 2: /* overflow */ -#ifdef HAVE_FERAISEEXCEPT feraiseexcept(FE_OVERFLOW); ret = copysign(INFINITY, x); -#else - ret = double_huge() * copysign(double_huge(), x); -#endif break; case 3: { - /* if */ + /* invalid */ if (!isQNaN(x)) { /* * If it's not a quiet NaN, we want to signal an invalid * operation. Otherwise, we silently return a NaN. */ -#ifdef HAVE_FERAISEEXCEPT feraiseexcept(FE_INVALID); -#else - ret = double_zero() / double_zero(); - return ret; -#endif } + /* * FIXME: Of the many NaN values that we have, what NaN * should we return? ----------------------------------------------------------------------- Summary of changes: src/lisp/GNUmakefile | 2 +- src/lisp/double-values.c | 40 ---------------------------------------- src/lisp/setexception.c | 43 +++---------------------------------------- 3 files changed, 4 insertions(+), 81 deletions(-) delete mode 100644 src/lisp/double-values.c hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-06-3-gd2e0e8e
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via d2e0e8e2e96eb30a54d9649cb5d757e44a64f71b (commit) from d671c3595768543efbf2b01ddac321c9d87936af (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit d2e0e8e2e96eb30a54d9649cb5d757e44a64f71b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Jul 1 20:20:05 2013 -0700 Fix some compiler warnings about unused variables or variables that are set but never used. diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index 6909292..9caae2d 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -223,7 +223,7 @@ check_escaped_stack_object(lispobj * where, lispobj obj) if (!(ex)) gc_abort (); \ } while (0) #else -#define gc_assert(ex) (void) 0 +#define gc_assert(ex) (void) (ex) #endif @@ -807,8 +807,10 @@ print_generation_stats(int verbose) } } +#ifdef GC_ASSERTIONS gc_assert(generations[i].bytes_allocated == generation_bytes_allocated(i)); +#endif fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n", i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt, generations[i].bytes_allocated, @@ -3249,11 +3251,13 @@ static void apply_code_fixups(struct code *old_code, struct code *new_code) { int nheader_words, ncode_words, nwords; + char *code_start_addr; +#ifdef DEBUG_APPLY_CODE_FIXUPS char *constants_start_addr, *constants_end_addr; - char *code_start_addr, *code_end_addr; + char *code_end_addr; +#endif lispobj fixups = NIL; unsigned long displacement = - (unsigned long) new_code - (unsigned long) old_code; struct vector *fixups_vector; @@ -3262,8 +3266,8 @@ apply_code_fixups(struct code *old_code, struct code *new_code) * be a fixnum if it's x86 compiled code - check. */ if (new_code->trace_table_offset & 0x3) { -#if 0 - fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code); +#ifdef DEBUG_APPLY_CODE_FIXUPS + fprintf(stderr, "*** Byte compiled code object at %p.\n", new_code); #endif return; } @@ -3272,18 +3276,18 @@ apply_code_fixups(struct code *old_code, struct code *new_code) ncode_words = fixnum_value(new_code->code_size); nheader_words = HeaderValue(*(lispobj *) new_code); nwords = ncode_words + nheader_words; -#if 0 +#ifdef DEBUG_APPLY_CODE_FIXUPS fprintf(stderr, - "*** Compiled code object at %x: header_words=%d code_words=%d .\n", + "*** Compiled code object at %p: header_words=%d code_words=%d .\n", new_code, nheader_words, ncode_words); #endif + code_start_addr = (char *) new_code + nheader_words * sizeof(lispobj); +#ifdef DEBUG_APPLY_CODE_FIXUPS constants_start_addr = (char *) new_code + 5 * sizeof(lispobj); constants_end_addr = (char *) new_code + nheader_words * sizeof(lispobj); - code_start_addr = (char *) new_code + nheader_words * sizeof(lispobj); code_end_addr = (char *) new_code + nwords * sizeof(lispobj); -#if 0 fprintf(stderr, - "*** Const. start = %x; end= %x; Code start = %x; end = %x\n", + "*** Const. start = %p; end= %p; Code start = %p; end = %p\n", constants_start_addr, constants_end_addr, code_start_addr, code_end_addr); #endif @@ -3303,13 +3307,13 @@ apply_code_fixups(struct code *old_code, struct code *new_code) if (check_code_fixups) sniff_code_object(new_code, displacement); -#if 0 +#ifdef DEBUG_APPLY_CODE_FIXUPS fprintf(stderr, "Fixups for code object not found!?\n"); fprintf(stderr, - "*** Compiled code object at %x: header_words=%d code_words=%d .\n", + "*** Compiled code object at %p: header_words=%d code_words=%d .\n", new_code, nheader_words, ncode_words); fprintf(stderr, - "*** Const. start = %x; end= %x; Code start = %x; end = %x\n", + "*** Const. start = %p; end= %p; Code start = %p; end = %p\n", constants_start_addr, constants_end_addr, code_start_addr, code_end_addr); #endif @@ -3321,13 +3325,13 @@ apply_code_fixups(struct code *old_code, struct code *new_code) /* Could be pointing to a forwarding pointer. */ if (Pointerp(fixups) && find_page_index((void *) fixups_vector) != -1 && fixups_vector->header == 0x01) { -#if 0 +#ifdef DEBUG_APPLY_CODE_FIXUPS fprintf(stderr, "* FF\n"); #endif /* If so then follow it. */ fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length); } -#if 0 +#ifdef DEBUG_APPLY_CODE_FIXUPS fprintf(stderr, "Got the fixups\n"); #endif @@ -4386,7 +4390,9 @@ scav_hash_entries(struct hash_table *hash_table, lispobj weak, int removep) { unsigned kv_length; lispobj *kv_vector; +#ifdef DEBUG_SCAV_HASH_ENTRIES lispobj empty_symbol; +#endif unsigned *index_vector, *next_vector, *hash_vector; unsigned length = UINT_MAX; unsigned next_vector_length = UINT_MAX; @@ -4396,7 +4402,9 @@ scav_hash_entries(struct hash_table *hash_table, lispobj weak, int removep) kv_length = fixnum_value(kv_vector[1]); kv_vector += 2; +#ifdef DEBUG_SCAV_HASH_ENTRIES empty_symbol = kv_vector[1]; +#endif index_vector = u32_vector(hash_table->index_vector, &length); next_vector = u32_vector(hash_table->next_vector, &next_vector_length); @@ -4430,7 +4438,7 @@ scav_hash_entries(struct hash_table *hash_table, lispobj weak, int removep) } else { /* If the key is EQ-hashed and moves, schedule it for rehashing. */ scavenge(&kv_vector[2 * i], 2); -#if 0 +#ifdef DEBUG_SCAV_HASH_ENTRIES new_key = kv_vector[2 * i]; new_index = EQ_HASH(new_key) % length; ----------------------------------------------------------------------- Summary of changes: src/lisp/gencgc.c | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs April 2015