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

[git] CMU Common Lisp branch master updated. snapshot-2013-09-7-geee2366
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 eee2366d1dd68701aa210dd62e2319e5e50b631a (commit) from aca64f0932d5ae34c1dca7d7819dd4a6319a7a5c (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 eee2366d1dd68701aa210dd62e2319e5e50b631a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 21 12:08:51 2013 -0700 Update to date to Oct 2013, 20e. diff --git a/src/docs/cmu-user/cmu-user.tex b/src/docs/cmu-user/cmu-user.tex index 55e8cde..ce45970 100644 --- a/src/docs/cmu-user/cmu-user.tex +++ b/src/docs/cmu-user/cmu-user.tex @@ -48,7 +48,7 @@ \newcommand{\keywords}{lisp, Common Lisp, manual, compiler, programming language implementation, programming environment} -\date{November 2011 \\ 20c} +\date{October 2013 \\ 20e} \begin{document} ----------------------------------------------------------------------- Summary of changes: src/docs/cmu-user/cmu-user.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-40-ge0b1f9f
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 e0b1f9f8b2142397cbf4ea76dd3ba862862baa49 (commit) via e19642f9bb877846f2fa05701bebcef1073821f3 (commit) via ae8eb31e7757d351eca8fd5b9693637843cda611 (commit) from 6795c643cd67e3ea2d950aa249cf39f929dc7798 (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 e0b1f9f8b2142397cbf4ea76dd3ba862862baa49 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 19:31:39 2014 -0700 Compile s_log1p and s_expm1. diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin index 3dcdc61..70c2df4 100644 --- a/src/lisp/Config.x86_darwin +++ b/src/lisp/Config.x86_darwin @@ -18,7 +18,7 @@ OS_LIBS = EXEC_FINAL_OBJ = exec-final.o -OS_SRC += k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c +OS_SRC += k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c s_log1p.c s_expm1.c k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -37,3 +37,7 @@ s_tan.o : s_tan.c sincos.o : sincos.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_log1p.o : s_log1p.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_exmp1.o : s_expm1.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< commit e19642f9bb877846f2fa05701bebcef1073821f3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 19:30:45 2014 -0700 Modify to use unions and change name to include fdlibm prefix. diff --git a/src/lisp/s_expm1.c b/src/lisp/s_expm1.c index e4dd820..d6a1827 100644 --- a/src/lisp/s_expm1.c +++ b/src/lisp/s_expm1.c @@ -127,17 +127,20 @@ Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ #ifdef __STDC__ - double expm1(double x) + double fdlibm_expm1(double x) #else - double expm1(x) + double fdlibm_expm1(x) double x; #endif { double y,hi,lo,c,t,e,hxs,hfx,r1; int k,xsb; unsigned hx; + union { int i[2]; double d; } ux; + union { int i[2]; double d; } utmp; - hx = __HI(x); /* high word of x */ + ux.d = x; + hx = ux.i[HIWORD]; /* high word of x */ xsb = hx&0x80000000; /* sign bit of x */ if(xsb==0) y=x; else y= -x; /* y = |x| */ hx &= 0x7fffffff; /* high word of |x| */ @@ -146,7 +149,7 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { - if(((hx&0xfffff)|__LO(x))!=0) + if(((hx&0xfffff)|ux.i[LOWORD])!=0) return x+x; /* NaN */ else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ } @@ -196,19 +199,29 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ else return one+2.0*(x-e); if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ y = one-(e-x); - __HI(y) += (k<<20); /* add k to y's exponent */ + utmp.d = y; + utmp.i[HIWORD] += (k<<20); /* add k to y's exponent */ + y = utmp.d; return y-one; } t = one; if(k<20) { - __HI(t) = 0x3ff00000 - (0x200000>>k); /* t=1-2^-k */ + utmp.d = t; + utmp.i[HIWORD] = 0x3ff00000 - (0x200000>>k); /* t=1-2^-k */ + t = utmp.d; y = t-(e-x); - __HI(y) += (k<<20); /* add k to y's exponent */ + utmp.d = y; + utmp.i[HIWORD] += (k<<20); /* add k to y's exponent */ + y = utmp.d; } else { - __HI(t) = ((0x3ff-k)<<20); /* 2^-k */ + utmp.d = t; + utmp.i[HIWORD] = ((0x3ff-k)<<20); /* 2^-k */ + t = utmp.d; y = x-(e+t); y += one; - __HI(y) += (k<<20); /* add k to y's exponent */ + utmp.d = y; + utmp.i[HIWORD] += (k<<20); /* add k to y's exponent */ + y = utmp.d; } } return y; diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c index 3d1059a..eaec38a 100644 --- a/src/lisp/s_log1p.c +++ b/src/lisp/s_log1p.c @@ -97,16 +97,18 @@ Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ static double zero = 0.0; #ifdef __STDC__ - double log1p(double x) + double fdlibm_log1p(double x) #else - double log1p(x) + double fdlibm_log1p(x) double x; #endif { double hfsq,f,c,s,z,R,u; int k,hx,hu,ax; + union { int i[2]; double d; } ux; - hx = __HI(x); /* high word of x */ + ux.d = x; + hx = ux.i[HIWORD]; /* high word of x */ ax = hx&0x7fffffff; k = 1; @@ -128,23 +130,29 @@ static double zero = 0.0; if (hx >= 0x7ff00000) return x+x; if(k!=0) { if(hx<0x43400000) { - u = 1.0+x; - hu = __HI(u); /* high word of u */ + u = 1.0+x; + ux.d = u; + hu = ux.i[HIWORD]; /* high word of u */ k = (hu>>20)-1023; c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */ c /= u; } else { u = x; - hu = __HI(u); /* high word of u */ + ux.d = u; + hu = ux.i[HIWORD]; /* high word of u */ k = (hu>>20)-1023; c = 0; } hu &= 0x000fffff; if(hu<0x6a09e) { - __HI(u) = hu|0x3ff00000; /* normalize u */ + ux.d = u; + ux.i[HIWORD] = hu|0x3ff00000; /* normalize u */ + u = ux.d; } else { - k += 1; - __HI(u) = hu|0x3fe00000; /* normalize u/2 */ + k += 1; + ux.d = u; + ux.i[HIWORD] = hu|0x3fe00000; /* normalize u/2 */ + u = ux.d; hu = (0x00100000-hu)>>2; } f = u-1.0; commit ae8eb31e7757d351eca8fd5b9693637843cda611 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 19:21:05 2014 -0700 Import expm1 from fdlibm, as is. diff --git a/src/lisp/s_expm1.c b/src/lisp/s_expm1.c new file mode 100644 index 0000000..e4dd820 --- /dev/null +++ b/src/lisp/s_expm1.c @@ -0,0 +1,215 @@ + +/* @(#)s_expm1.c 1.5 04/04/22 */ +/* + * ==================================================== + * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved. + * + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* expm1(x) + * Returns exp(x)-1, the exponential of x minus 1. + * + * Method + * 1. Argument reduction: + * Given x, find r and integer k such that + * + * x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658 + * + * Here a correction term c will be computed to compensate + * the error in r when rounded to a floating-point number. + * + * 2. Approximating expm1(r) by a special rational function on + * the interval [0,0.34658]: + * Since + * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ... + * we define R1(r*r) by + * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r) + * That is, + * R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r) + * = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r)) + * = 1 - r^2/60 + r^4/2520 - r^6/100800 + ... + * We use a special Remes algorithm on [0,0.347] to generate + * a polynomial of degree 5 in r*r to approximate R1. The + * maximum error of this polynomial approximation is bounded + * by 2**-61. In other words, + * R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5 + * where Q1 = -1.6666666666666567384E-2, + * Q2 = 3.9682539681370365873E-4, + * Q3 = -9.9206344733435987357E-6, + * Q4 = 2.5051361420808517002E-7, + * Q5 = -6.2843505682382617102E-9; + * (where z=r*r, and the values of Q1 to Q5 are listed below) + * with error bounded by + * | 5 | -61 + * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2 + * | | + * + * expm1(r) = exp(r)-1 is then computed by the following + * specific way which minimize the accumulation rounding error: + * 2 3 + * r r [ 3 - (R1 + R1*r/2) ] + * expm1(r) = r + --- + --- * [--------------------] + * 2 2 [ 6 - r*(3 - R1*r/2) ] + * + * To compensate the error in the argument reduction, we use + * expm1(r+c) = expm1(r) + c + expm1(r)*c + * ~ expm1(r) + c + r*c + * Thus c+r*c will be added in as the correction terms for + * expm1(r+c). Now rearrange the term to avoid optimization + * screw up: + * ( 2 2 ) + * ({ ( r [ R1 - (3 - R1*r/2) ] ) } r ) + * expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- ) + * ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 ) + * ( ) + * + * = r - E + * 3. Scale back to obtain expm1(x): + * From step 1, we have + * expm1(x) = either 2^k*[expm1(r)+1] - 1 + * = or 2^k*[expm1(r) + (1-2^-k)] + * 4. Implementation notes: + * (A). To save one multiplication, we scale the coefficient Qi + * to Qi*2^i, and replace z by (x^2)/2. + * (B). To achieve maximum accuracy, we compute expm1(x) by + * (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf) + * (ii) if k=0, return r-E + * (iii) if k=-1, return 0.5*(r-E)-0.5 + * (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E) + * else return 1.0+2.0*(r-E); + * (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1) + * (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else + * (vii) return 2^k(1-((E+2^-k)-r)) + * + * Special cases: + * expm1(INF) is INF, expm1(NaN) is NaN; + * expm1(-INF) is -1, and + * for finite argument, only expm1(0)=0 is exact. + * + * Accuracy: + * according to an error analysis, the error is always less than + * 1 ulp (unit in the last place). + * + * Misc. info. + * For IEEE double + * if x > 7.09782712893383973096e+02 then expm1(x) overflow + * + * Constants: + * The hexadecimal values are the intended ones for the following + * constants. The decimal values may be used, provided that the + * compiler will convert from decimal to binary accurately enough + * to produce the hexadecimal values shown. + */ + +#include "fdlibm.h" + +#ifdef __STDC__ +static const double +#else +static double +#endif +one = 1.0, +huge = 1.0e+300, +tiny = 1.0e-300, +o_threshold = 7.09782712893383973096e+02,/* 0x40862E42, 0xFEFA39EF */ +ln2_hi = 6.93147180369123816490e-01,/* 0x3fe62e42, 0xfee00000 */ +ln2_lo = 1.90821492927058770002e-10,/* 0x3dea39ef, 0x35793c76 */ +invln2 = 1.44269504088896338700e+00,/* 0x3ff71547, 0x652b82fe */ + /* scaled coefficients related to expm1 */ +Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */ +Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */ +Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */ +Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */ +Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ + +#ifdef __STDC__ + double expm1(double x) +#else + double expm1(x) + double x; +#endif +{ + double y,hi,lo,c,t,e,hxs,hfx,r1; + int k,xsb; + unsigned hx; + + hx = __HI(x); /* high word of x */ + xsb = hx&0x80000000; /* sign bit of x */ + if(xsb==0) y=x; else y= -x; /* y = |x| */ + hx &= 0x7fffffff; /* high word of |x| */ + + /* filter out huge and non-finite argument */ + if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */ + if(hx >= 0x40862E42) { /* if |x|>=709.78... */ + if(hx>=0x7ff00000) { + if(((hx&0xfffff)|__LO(x))!=0) + return x+x; /* NaN */ + else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ + } + if(x > o_threshold) return huge*huge; /* overflow */ + } + if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */ + if(x+tiny<0.0) /* raise inexact */ + return tiny-one; /* return -1 */ + } + } + + /* argument reduction */ + if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */ + if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */ + if(xsb==0) + {hi = x - ln2_hi; lo = ln2_lo; k = 1;} + else + {hi = x + ln2_hi; lo = -ln2_lo; k = -1;} + } else { + k = invln2*x+((xsb==0)?0.5:-0.5); + t = k; + hi = x - t*ln2_hi; /* t*ln2_hi is exact here */ + lo = t*ln2_lo; + } + x = hi - lo; + c = (hi-x)-lo; + } + else if(hx < 0x3c900000) { /* when |x|<2**-54, return x */ + t = huge+x; /* return x with inexact flags when x!=0 */ + return x - (t-(huge+x)); + } + else k = 0; + + /* x is now in primary range */ + hfx = 0.5*x; + hxs = x*hfx; + r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5)))); + t = 3.0-r1*hfx; + e = hxs*((r1-t)/(6.0 - x*t)); + if(k==0) return x - (x*e-hxs); /* c is 0 */ + else { + e = (x*(e-c)-c); + e -= hxs; + if(k== -1) return 0.5*(x-e)-0.5; + if(k==1) + if(x < -0.25) return -2.0*(e-(x+0.5)); + else return one+2.0*(x-e); + if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ + y = one-(e-x); + __HI(y) += (k<<20); /* add k to y's exponent */ + return y-one; + } + t = one; + if(k<20) { + __HI(t) = 0x3ff00000 - (0x200000>>k); /* t=1-2^-k */ + y = t-(e-x); + __HI(y) += (k<<20); /* add k to y's exponent */ + } else { + __HI(t) = ((0x3ff-k)<<20); /* 2^-k */ + y = x-(e+t); + y += one; + __HI(y) += (k<<20); /* add k to y's exponent */ + } + } + return y; +} ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.x86_darwin | 6 +- src/lisp/s_expm1.c | 228 ++++++++++++++++++++++++++++++++++++++++++++ src/lisp/s_log1p.c | 26 +++-- 3 files changed, 250 insertions(+), 10 deletions(-) create mode 100644 src/lisp/s_expm1.c hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-8-ge585e8d
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 e585e8d6acbc146e978d1c2c5171987b6ba2fddf (commit) via 63d44f2cd88f1675a99b98d0c7f91f091e375823 (commit) via fc3d88a64b6d6297d2b8639032b4f92d6d242149 (commit) via 53bfdda42de6d4f464546cdba1456262d4065ee7 (commit) from c0052f5544d27980c74d5a17cd55dc2069085602 (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 e585e8d6acbc146e978d1c2c5171987b6ba2fddf Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 9 23:49:14 2014 -0700 Fix ticket:101, implementing STREAM-ADVANCE-TO-COLUMN for FORMAT ~T. * code/format.lisp: * Add support for Gray streams for tabulation, calling STREAM-ADVANCE-TO-COLUMN as needed. * tests/gray-stream.lisp: * Add tests for absolute and relative tabulation. These are simple and just compare that lisp streams and Gray streams produce the same output. * general-info/release-20f.txt: * Update. diff --git a/src/code/format.lisp b/src/code/format.lisp index 704ec34..7a2de48 100644 --- a/src/code/format.lisp +++ b/src/code/format.lisp @@ -2122,27 +2122,73 @@ (decf n (length spaces))) (write-string spaces stream :end n))) +;; CLHS 22.3.6.1 for relative tabulations says: +;; +;; ... outputs COLREL spaces and then outputs the smallest +;; non-negative number of additional spaces necessary to move the +;; cursor to a column that is a multiple of COLINC.... If the +;; current output column cannot be determined, however, then colinc +;; is ignored, and exactly colrel spaces are output. (defun format-relative-tab (stream colrel colinc) (if (pp:pretty-stream-p stream) (pprint-tab :line-relative colrel colinc stream) - (let* ((cur (lisp::charpos stream)) - (spaces (if (and cur (plusp colinc)) - (- (* (ceiling (+ cur colrel) colinc) colinc) cur) - colrel))) - (output-spaces stream spaces)))) - + (flet ((advance-to-column () + (let* ((cur (lisp::charpos stream)) + (spaces (if (and cur (plusp colinc)) + (- (* (ceiling (+ cur colrel) colinc) colinc) cur) + colrel))) + (output-spaces stream spaces)))) + (lisp::stream-dispatch stream + ;; simple-stream + (advance-to-column) + ;; lisp-stream + (advance-to-column) + ;; fundamental-stream + (let ((cur (stream-line-column stream))) + (cond ((and cur (plusp colinc)) + (stream-advance-to-column stream + (+ cur + (* (floor (+ cur colrel) colinc) + colinc)))) + (t + (stream-advance-to-column stream (+ cur colrel))))))))) + +;; CLHS 22.3.6.1 says: +;; +;; If the cursor is already at or beyond the column COLNUM, it will +;; output spaces to move it to COLNUM + k*COLINC for the smallest +;; positive integer k possible, unless COLINC is zero, in which case +;; no spaces are output. (defun format-absolute-tab (stream colnum colinc) (if (pp:pretty-stream-p stream) (pprint-tab :line colnum colinc stream) - (let ((cur (lisp::charpos stream))) - (cond ((null cur) - (write-string " " stream)) - ((< cur colnum) - (output-spaces stream (- colnum cur))) - (t - (unless (zerop colinc) - (output-spaces stream - (- colinc (rem (- cur colnum) colinc))))))))) + (flet ((advance-to-column () + (let ((cur (lisp::charpos stream))) + (cond ((null cur) + (write-string " " stream)) + ((< cur colnum) + (output-spaces stream (- colnum cur))) + (t + (unless (zerop colinc) + (output-spaces stream + (- colinc (rem (- cur colnum) colinc))))))))) + (lisp::stream-dispatch stream + ;; simple-stream. NOTE: Do we need to do soemthing better for + ;; simple streams? + (advance-to-column) + ;; lisp-stream + (advance-to-column) + ;; fundamental-stream + (let ((cur (stream-line-column stream))) + (cond ((null cur) + (write-string " " stream)) + ((< cur colnum) + (stream-advance-to-column stream colnum)) + (t + (unless (zerop colinc) + (let ((k (ceiling (- cur colnum) colinc))) + (stream-advance-to-column stream + (+ colnum (* k colinc)))))))))))) (def-format-directive #\_ (colonp atsignp params) (expand-bind-defaults () params diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 388ca02..265b0b5 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -110,6 +110,7 @@ New in this release: * Ticket #105, fixed. * Ticket #84 fixed on x86. * Ticket #105 fixed. + * Ticket #101 fixed. * Other changes: diff --git a/tests/gray-streams.lisp b/tests/gray-streams.lisp index 7de3c1b..8afeb50 100644 --- a/tests/gray-streams.lisp +++ b/tests/gray-streams.lisp @@ -16,6 +16,9 @@ (defparameter *test-file* (merge-pathnames #p"test-data.tmp" *test-path*)) +(defparameter *test-file-2* + (merge-pathnames #P"test-data-gray.tmp" *test-path*)) + (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t)) @@ -37,3 +40,73 @@ (file-length s)) (close s) (delete-file *test-file*))))) + +(define-test format-abs-stream-advance + (:tag :trac) + ;; Create a lisp stream and a Gray stream and test format ~T on + ;; each. Compare the length of each file and declare success if the + ;; lengths are the same. + ;; + ;; FIXME: This doesn't actually test that STREAM-ADVANCE-TO-COLUMN + ;; was actually called. Another test should be added for that. We're + ;; testing functionality here. It was verified manually using TRACE + ;; that FORMAT on a Gray stream does in fact call + ;; STREAM-ADVANCE-TO-COLUMN + (assert-equal "18 18" + (let ((lisp-stream (open *test-file* + :direction :output + :if-exists :supersede)) + (gray-stream (open *test-file-2* + :direction :output + :if-exists :supersede + :class 'lisp::character-output-stream))) + (unwind-protect + (progn + (format lisp-stream "~10T") + (format lisp-stream "~8,10T") + (format gray-stream "~10T") + (format gray-stream "~8,10T") + (force-output lisp-stream) + (force-output gray-stream) + (format nil "~D ~D" + (file-position lisp-stream) + (file-position gray-stream))) + (close lisp-stream) + (close gray-stream) + (delete-file *test-file*) + (delete-file *test-file-2*))))) + +(define-test format-rel-stream-advance + (:tag :trac) + ;; Create a lisp stream and a Gray stream and test format ~@T on + ;; each. Compare the length of each file and declare success if the + ;; lengths are the same. + ;; + ;; FIXME: This doesn't actually test that STREAM-ADVANCE-TO-COLUMN + ;; was actually called. Another test should be added for that. We're + ;; testing functionality here. It was verified manually using TRACE + ;; that FORMAT on a Gray stream does in fact call + ;; STREAM-ADVANCE-TO-COLUMN + (assert-equal "20 20" + (let ((lisp-stream (open *test-file* + :direction :output + :if-exists :supersede)) + (gray-stream (open *test-file-2* + :direction :output + :if-exists :supersede + :class 'lisp::character-output-stream))) + (unwind-protect + (progn + (format lisp-stream "~10T") + (format lisp-stream "~8,10@T") + (format gray-stream "~10T") + (format gray-stream "~8,10@T") + (force-output lisp-stream) + (force-output gray-stream) + (format nil "~D ~D" + (file-position lisp-stream) + (file-position gray-stream))) + (close lisp-stream) + (close gray-stream) + (delete-file *test-file*) + (delete-file *test-file-2*))))) commit 63d44f2cd88f1675a99b98d0c7f91f091e375823 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 9 23:44:57 2014 -0700 Regenerated. diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 19b58d4..15366ac 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -21046,6 +21046,14 @@ msgid "Implements WRITE-SEQUENCE for the stream." msgstr "" #: src/pcl/gray-streams.lisp +msgid "Implements FILE-POSITION for the stream." +msgstr "" + +#: src/pcl/gray-streams.lisp +msgid "Implements FILE-POSITION for the stream for setting the position." +msgstr "" + +#: src/pcl/gray-streams.lisp msgid "" "Used by READ-BYTE; returns either an integer, or the symbol :EOF\n" " if the stream is at end-of-file." commit fc3d88a64b6d6297d2b8639032b4f92d6d242149 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 9 22:15:31 2014 -0700 Clean up the CLEAR-OUTPUT test a bit. diff --git a/tests/gray-streams.lisp b/tests/gray-streams.lisp index 6308882..7de3c1b 100644 --- a/tests/gray-streams.lisp +++ b/tests/gray-streams.lisp @@ -24,16 +24,16 @@ ;; Create a Gray stream and make sure that clear-output works. (assert-eql 0 - (unwind-protect - (let ((s (open *test-file* - :direction :output - :if-exists :supersede - :class 'lisp::character-output-stream))) - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) - (delete-file *test-file*)))) - - \ No newline at end of file + (let ((s (open *test-file* + :direction :output + :if-exists :supersede + :class 'lisp::character-output-stream))) + (unwind-protect + (progn + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open *test-file*)) + (file-length s)) + (close s) + (delete-file *test-file*))))) commit 53bfdda42de6d4f464546cdba1456262d4065ee7 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 9 22:15:07 2014 -0700 Add test for ticket:101 for the case of CLEAR-OUTPUT of a lisp stream. diff --git a/tests/trac.lisp b/tests/trac.lisp index 571b069..8253bc2 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -367,6 +367,36 @@ (assert-error 'reader-error (read-from-string "1d-324")) (assert-error 'reader-error (read-from-string "1w-324"))) +(defparameter *test-path* + (merge-pathnames (make-pathname :name :unspecific :type :unspecific + :version :unspecific) + *load-truename*) + "Directory for temporary test files.") + +(defparameter *test-file* + (merge-pathnames #p"test-data.tmp" *test-path*)) + + +;; Not quite what ticket 101 is about, but it came up in investigating +;; CLEAR-OUTPUT on a Gray stream. Verify CLEAR-OUTPUT actually +;; does. Previously, it did nothing. +(define-test trac.101 + (:tag :trac) + (assert-eql + 0 + (let ((s (open *test-file* + :direction :output + :if-exists :supersede))) + (unwind-protect + (progn + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open *test-file*)) + (file-length s)) + (close s) + (delete-file *test-file*))))) + (defun read-string-fn (str) (handler-case (let ((acc nil)) ----------------------------------------------------------------------- Summary of changes: src/code/format.lisp | 76 +++++++++++++++++++++++------ src/general-info/release-20f.txt | 1 + src/i18n/locale/cmucl.pot | 8 +++ tests/gray-streams.lisp | 99 +++++++++++++++++++++++++++++++++----- tests/trac.lisp | 30 ++++++++++++ 5 files changed, 186 insertions(+), 28 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. 20e-7-gd337d00
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 d337d008ea8f8a47a34b27516bd4f60f8299881a (commit) from 861ae22a3596ca5e40530a734076d6dea131c273 (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 d337d008ea8f8a47a34b27516bd4f60f8299881a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 23 19:48:29 2013 -0700 Update message from inline ftruncate support that was recently added on x86. diff --git a/src/i18n/locale/cmucl-sse2.pot b/src/i18n/locale/cmucl-sse2.pot index 9f27271..2236ac7 100644 --- a/src/i18n/locale/cmucl-sse2.pot +++ b/src/i18n/locale/cmucl-sse2.pot @@ -83,6 +83,10 @@ msgid "inline float truncate" msgstr "" #: src/compiler/x86/float-sse2.lisp +msgid "inline ftruncate" +msgstr "" + +#: src/compiler/x86/float-sse2.lisp msgid "inline complex single-float creation" msgstr "" ----------------------------------------------------------------------- Summary of changes: src/i18n/locale/cmucl-sse2.pot | 4 ++++ 1 file changed, 4 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-17-g01a3f47
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 01a3f47b4b6d0a6f89bd533c967b32f2357acab6 (commit) via a013ec10932b01cded996713579f211586250f7c (commit) from 7916cfb0b1b01e42901d92d9669c3c6099a6cab6 (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 01a3f47b4b6d0a6f89bd533c967b32f2357acab6 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Dec 20 00:09:20 2013 -0800 Regenerated. diff --git a/src/i18n/locale/cmucl-x87.pot b/src/i18n/locale/cmucl-x87.pot index 2c52230..d0118ce 100644 --- a/src/i18n/locale/cmucl-x87.pot +++ b/src/i18n/locale/cmucl-x87.pot @@ -127,10 +127,6 @@ msgid "inline scalb function" msgstr "" #: src/compiler/x86/float.lisp -msgid "inline log1p function" -msgstr "" - -#: src/compiler/x86/float.lisp msgid "inline log1p with limited x range function" msgstr "" @@ -147,6 +143,10 @@ msgid "inline atan2 function" msgstr "" #: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp msgid "inline complex single-float creation" msgstr "" diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 283dcaf..0c327c9 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -17157,10 +17157,22 @@ msgstr "" #: src/compiler/disassem.lisp msgid "" -"Disassembles the given area of memory starting at ADDRESS and LENGTH long.\n" -" Note that if CODE-COMPONENT is NIL and this memory could move during a GC," +"Disassembles the given area of memory starting at ADDRESS and\n" +" LENGTH (octets) long. Note that if CODE-COMPONENT is NIL and this\n" +" memory could move during a GC, you'd better disable it around the\n" +" call to this function. ADDRESS can be either an integer or a\n" +" system-area-pointer.\n" "\n" -" you'd better disable it around the call to this function." +" :Stream stream\n" +" The dissassembly is written to this stream.\n" +" :Use-labels\n" +" Labels are generated instead of using instruction addresses.\n" +" :Base\n" +" :Case\n" +" :Radix\n" +" The disassembler uses the specified base, case, and radix when\n" +" printing the disassembled code. The default values are 16,\n" +" :downcase, and *print-radix*, respectively. " msgstr "" #: src/compiler/disassem.lisp commit a013ec10932b01cded996713579f211586250f7c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Dec 19 20:15:57 2013 -0800 Make all top-level disassembly functions accept base, case, and radix options just like for DISASSEM:DISASSEMBLE. * DISASSEMBLE-SEGMENTS actually implements the base, case and radix options. * DISASSEMBLE doesn't implement the options but calls DISASSEMBLE-SEGMENTS with the appropriate args. * DISASSEMBLE-FUNCTION, DISASSEMBLE-MEMORY, and DISASSEMBLE-CODE-COMPONENT accepts the new keyword args. * Update the docstrings to indicate the new keyword args. diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 762b77b..cb04a00 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -3232,12 +3232,17 @@ dstate stream))) -(defun disassemble-segments (segments stream dstate) +(defun disassemble-segments (segments stream dstate &key + (base 16) + (case :downcase) + (radix *print-radix*)) "Disassemble the machine code instructions in each memory segment in SEGMENTS in turn to STREAM." (declare (type list segments) (type stream stream) - (type disassem-state dstate)) + (type disassem-state dstate) + (type (integer 2 36) base) + (type (member :upcase :downcase :capitalize) case)) (unless (null segments) (let ((first (car segments)) (last (car (last segments)))) @@ -3257,15 +3262,21 @@ ;; Initialize these to a sane value, just in case. (setf vm::*note-addis-inst* nil) (setf vm::*pseudo-atomic-set* nil)) - (dolist (seg segments) - (disassemble-segment seg stream dstate))))) + (let ((*print-base* base) + (*print-case* case) + (*print-radix* radix)) + (dolist (seg segments) + (disassemble-segment seg stream dstate)))))) ;;; ---------------------------------------------------------------- ;;; top-level functions (defun disassemble-function (function &key (stream *standard-output*) - (use-labels t) - (backend c:*native-backend*)) + (use-labels t) + (backend c:*native-backend*) + (base 16) + (case :downcase) + (radix *print-radix*)) "Disassemble the machine code instructions for FUNCTION." (declare (type compiled-function function) (type stream stream) @@ -3275,7 +3286,8 @@ (segments (get-function-segments function))) (when use-labels (label-segments segments dstate)) - (disassemble-segments segments stream dstate))) + (disassemble-segments segments stream dstate + :base base :case case :radix radix))) (defun compile-function-lambda-expr (function) (declare (type function function)) @@ -3328,33 +3340,49 @@ (declare (type (or function symbol cons) object) (type (or (member t) stream) stream) (type (member t nil) use-labels) - (type c::backend backend) - (type (integer 2 36) base) - (type (member :upcase :downcase :capitalize) case)) - (let ((*print-base* base) - (*print-case* case) - (*print-radix* radix) - (fun (compiled-function-or-lose object))) + (type c::backend backend)) + (let ((fun (compiled-function-or-lose object))) (if (typep fun 'kernel:byte-function) (c:disassem-byte-fun fun) ;; we can't detect closures, so be careful (disassemble-function (fun-self fun) :stream stream :use-labels use-labels - :backend backend))) + :backend backend + :base base + :case case + :radix radix))) (values)) (defun disassemble-memory (address length &key - (stream *standard-output*) - code-component - (use-labels t) - (backend c:*backend*)) - "Disassembles the given area of memory starting at ADDRESS and LENGTH long. - Note that if CODE-COMPONENT is NIL and this memory could move during a GC, - you'd better disable it around the call to this function." - (declare (type (or address system:system-area-pointer) address) + (stream *standard-output*) + code-component + (use-labels t) + (backend c:*backend*) + (base 16) + (case :downcase) + (radix *print-radix*)) + "Disassembles the given area of memory starting at ADDRESS and + LENGTH (octets) long. Note that if CODE-COMPONENT is NIL and this + memory could move during a GC, you'd better disable it around the + call to this function. ADDRESS can be either an integer or a + system-area-pointer. + + :Stream stream + The dissassembly is written to this stream. + :Use-labels + Labels are generated instead of using instruction addresses. + :Base + :Case + :Radix + The disassembler uses the specified base, case, and radix when + printing the disassembled code. The default values are 16, + :downcase, and *print-radix*, respectively. " + + (declare (type (or address + system:system-area-pointer) address) (type length length) (type stream stream) (type (or null kernel:code-component) code-component) @@ -3379,12 +3407,16 @@ (list (make-memory-segment address length))))) (when use-labels (label-segments segments dstate)) - (disassemble-segments segments stream dstate))) + (disassemble-segments segments stream dstate + :base base :case case :radix radix))) (defun disassemble-code-component (code-component &key - (stream *standard-output*) - (use-labels t) - (backend c:*native-backend*)) + (stream *standard-output*) + (use-labels t) + (backend c:*native-backend*) + (base 16) + (case :downcase) + (radix *print-radix*)) "Disassemble the machine code instructions associated with CODE-COMPONENT (this may include multiple entry points)." (declare (type (or null kernel:code-component compiled-function) @@ -3400,7 +3432,8 @@ (segments (get-code-segments code-component))) (when use-labels (label-segments segments dstate)) - (disassemble-segments segments stream dstate))) + (disassemble-segments segments stream dstate + :base base :case case :radix radix))) ;;; ---------------------------------------------------------------- ;;; Code for making useful segments from arbitrary lists of code-blocks ----------------------------------------------------------------------- Summary of changes: src/compiler/disassem.lisp | 89 ++++++++++++++++++++++++++++------------- src/i18n/locale/cmucl-x87.pot | 8 ++-- src/i18n/locale/cmucl.pot | 18 +++++++-- 3 files changed, 80 insertions(+), 35 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-01-4-gc4aaa90
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 c4aaa9099d992a0b2cec538a503f87a4e86e0663 (commit) from 89a16ec62716a5eaf544d8aa0bd490e0c3c267ff (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 c4aaa9099d992a0b2cec538a503f87a4e86e0663 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Jan 5 20:36:01 2014 -0800 In the summary, print out all test failures and errors. diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index e4b8b99..c77fec5 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -59,7 +59,7 @@ test-results)) (nreverse test-results))) -(defun print-test-results (results) +(defun print-test-results (results &key verbose) (let ((passed 0) (failed 0) (execute-errors 0) @@ -92,16 +92,20 @@ ;; determine if there were any test failures. (cond ((plusp (+ failed execute-errors)) (when failed-tests - (format t "~2&Failed tests: ~S~%" failed-tests)) + (format t "~2&Failed tests: ~S~%" failed-tests) + (dolist (result results) + (lisp-unit:print-failures result))) (when execute-error-tests - (format t "~2&Execute failures: ~S~%" execute-error-tests)) + (format t "~2&Execute failures: ~S~%" execute-error-tests) + (dolist (result results) + (lisp-unit:print-errors result))) (unix:unix-exit 1)) (t (unix:unix-exit 0))))) -(defun run-all-tests (&optional (test-directory #P"tests/")) +(defun run-all-tests (&key (test-directory #P"tests/") (verbose t)) (load-test-files test-directory) - (print-test-results (run-loaded-tests))) + (print-test-results (run-loaded-tests) :verbose t)) ;;(run-all-tests) ;;(quit) ----------------------------------------------------------------------- Summary of changes: tests/run-tests.lisp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-8-g2e18254
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 2e182540e895f16b26224ba11b2f38de93ab2672 (commit) from d03e178481b3be542e4a2519890ed2772d081fb6 (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 2e182540e895f16b26224ba11b2f38de93ab2672 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Sep 20 11:55:27 2014 -0700 Make (log (scale-float 1d0 k) 2) = k * src/code/irrat.lisp * Improve accuracy of log2 for the case when x=2^k. There might be some loss in accuracy for other values of x, however. * tests/float.lisp * Add test for log2(2^k) = k. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 5f24bf9..2591907 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -598,7 +598,17 @@ (float 2 float-type))))))))) (etypecase x (float - (/ (log (float x float-type)) (log-of-2 float-type))) + (multiple-value-bind (f e s) + (decode-float x) + ;; If x = 2^e*f then log2(x) = e + log2(f) = e + + ;; log(f)/log(2). Accuracy could be improved some since this + ;; has 2 rounding operations instead of just 1 for + ;; log(x)/log(2). + (let ((log2 (+ e (/ (log (float f float-type)) + (log-of-2 float-type))))) + (if (minusp s) + (complex log2 (log-2-pi float-type)) + log2)))) (ratio (let ((top (numerator x)) (bot (denominator x))) diff --git a/tests/float.lisp b/tests/float.lisp index 6fe1f50..ff07270 100644 --- a/tests/float.lisp +++ b/tests/float.lisp @@ -10,3 +10,8 @@ (declare (type (double-float (0d0)) x)) (decode-float x))) 1d0))) + +(define-test log2 + (loop for k from -1074 to 1023 do + (let ((x (scale-float 1d0 k))) + (assert-equal k (log x 2))))) ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 12 +++++++++++- tests/float.lisp | 5 +++++ 2 files changed, 16 insertions(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-04-23-g31b1a5a
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 31b1a5a17dfebc3fd532f4443e7cbad70be2b4ba (commit) via 2d4d5a7f1ce6dd95f2c268a880b6e4f8e16de44b (commit) via 29d75bdbebc5d83ee777403999c36a6e1342b2d8 (commit) from f7506ddc36c87beb770661e6f22e74807023a06a (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 31b1a5a17dfebc3fd532f4443e7cbad70be2b4ba Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 14:13:46 2013 -0700 Add -z noexecstack to disable exec flag for the C stack. diff --git a/src/lisp/Config.x86_linux b/src/lisp/Config.x86_linux index de24e73..569f4f5 100644 --- a/src/lisp/Config.x86_linux +++ b/src/lisp/Config.x86_linux @@ -6,7 +6,8 @@ CPPFLAGS += -m32 -rdynamic -D__NO_CTYPE -D_GNU_SOURCE UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S OS_SRC += Linux-os.c elf.c -OS_LINK_FLAGS = -m32 -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo OS_LIBS = -ldl +OS_LINK_FLAGS = -m32 -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo +OS_LINK_FLAGS += -Wl,-z,noexecstack EXEC_FINAL_OBJ = exec-final.o commit 2d4d5a7f1ce6dd95f2c268a880b6e4f8e16de44b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 14:11:25 2013 -0700 Don't need to set CC or CPP. But add a note that we implicitly assume cc is Sun's C compiler, not an alias to gcc. diff --git a/src/lisp/Config.sparc_sunc b/src/lisp/Config.sparc_sunc index e1614e6..f5fb0e7 100644 --- a/src/lisp/Config.sparc_sunc +++ b/src/lisp/Config.sparc_sunc @@ -1,5 +1,9 @@ # -*- Mode: makefile -*- +# Build cmucl using Sun C compiler. We assume cc is Sun's C compiler. +# If you don't have it, why are you using this Config anyway? You're +# on your own if you use this Config without Sun C compiler available. + include Config.sparc_common # For v8plus support (allows 64-bit integer support on V9 @@ -20,8 +24,6 @@ CC_V8PLUS = -m32 -xarch=sparc AS_V8PLUS = -m32 -xarch=sparc endif -CC = cc -CPP = cc CFLAGS += -xlibmieee -O -DEPEND_FLAGS = -E -xM +DEPEND_FLAGS = -xM ASFLAGS = $(AS_V8PLUS) commit 29d75bdbebc5d83ee777403999c36a6e1342b2d8 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 4 14:08:17 2013 -0700 Make stacks not executable. diff --git a/src/lisp/Config.sparc_common b/src/lisp/Config.sparc_common index 89e2de0..551491a 100644 --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -57,6 +57,6 @@ ARCH_SRC = sparc-arch.c DEPEND=$(CC) OS_SRC = solaris-os.c os-common.c undefineds.c elf.c k_rem_pio2.c -OS_LINK_FLAGS= +OS_LINK_FLAGS = -M /usr/lib/ld/map.noexstk OS_LIBS= -lsocket -lnsl -ldl EXEC_FINAL_OBJ = exec-final.o ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.sparc_common | 2 +- src/lisp/Config.sparc_sunc | 8 +++++--- src/lisp/Config.x86_linux | 3 ++- 3 files changed, 8 insertions(+), 5 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-17-g30696a3
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 30696a3a294bf520a303108d6ada81c741cd2590 (commit) from 0c78392056e9471f98f63e32a03ba5ab9e6bbc97 (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 30696a3a294bf520a303108d6ada81c741cd2590 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Jul 23 21:24:11 2014 -0700 Add fdlibm trig for sparc. Sparc's libm almost gets everything right but it fails two tests; | Failed Form: (COS (* 13/4 PI)) | Expected -0.7071067811865471d0 but saw -0.7071067811865472d0 | | Failed Form: (SIN (SCALE-FLOAT 1.0d0 120)) | Expected 0.377820109360752d0 but saw 0.37782010936075205d0 In both of these cases, the expected value is the correct one, as confirmed by computing these values with maxima to 64 digits of precision. (Care must be used to look at the actual bits instead of rounding the printed decimal form.) diff --git a/src/lisp/Config.sparc_sunc b/src/lisp/Config.sparc_sunc index 2e0b4e0..ffe4598 100644 --- a/src/lisp/Config.sparc_sunc +++ b/src/lisp/Config.sparc_sunc @@ -28,3 +28,22 @@ CFLAGS += -xlibmieee -O DEPEND_FLAGS = -xM ASFLAGS = $(AS_V8PLUS) OS_LINK_FLAGS = -M /usr/lib/ld/map.noexstk + +OS_SRC += k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c + +k_sin.o : k_sin.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +k_cos.o : k_cos.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +k_tan.o : k_tan.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +s_sin.o : s_sin.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_cos.o : s_cos.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_tan.o : s_tan.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +sincos.o : sincos.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.sparc_sunc | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. begin-x87-removal-14-g10781b1
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 10781b15fcff354eedf177d9608eb7d98eda297d (commit) via 35a7f85c0211aaf962a6aa82c3c94a874d180d24 (commit) via 40028a0338821e72bd709153b598bce90c19edef (commit) from de72f9875abf89fd7084afbd56f9d4eb72094d5b (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 10781b15fcff354eedf177d9608eb7d98eda297d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Apr 15 21:43:45 2014 -0700 Make sse2 the default and always call alloc_overflow_sse2. diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index bbd5ef5..01e7983 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -162,15 +162,13 @@ (inst sub alloc-tn (make-symbol-value-ea '*current-region-free-pointer*)) (case (tn-offset alloc-tn) (#.eax-offset - (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" - #+sse2 "alloc_overflow_sse2") + (inst call (make-fixup (extern-alien-name "alloc_overflow_sse2") :foreign)) (inst jmp done)) (t (inst push eax-tn) ; Save any value in eax (inst mov eax-tn alloc-tn) - (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" - #+sse2 "alloc_overflow_sse2") + (inst call (make-fixup (extern-alien-name "alloc_overflow_sse2") :foreign)) (inst mov alloc-tn eax-tn) ; Put allocated address in alloc-tn (inst pop eax-tn) ; Restore old value of eax @@ -188,14 +186,12 @@ (load-size alloc-tn alloc-tn size) (case (tn-offset alloc-tn) (#.eax-offset - (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" - #+sse2 "alloc_overflow_sse2") + (inst call (make-fixup (extern-alien-name "alloc_overflow_sse2") :foreign))) (t (inst push eax-tn) ; Save any value in eax (inst mov eax-tn alloc-tn) - (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87" - #+sse2 "alloc_overflow_sse2") + (inst call (make-fixup (extern-alien-name "alloc_overflow_sse2") :foreign)) (inst mov alloc-tn eax-tn) ; Save allocated address in alloc-tn (inst pop eax-tn))) commit 35a7f85c0211aaf962a6aa82c3c94a874d180d24 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Apr 15 21:43:08 2014 -0700 Make sse2 the default and remove the conditionals. diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index bd69453..39ea767 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -40,9 +40,9 @@ (setf (backend-name *target-backend*) "X86") (setf (backend-version *target-backend*) - (if (backend-featurep :sse2) "Intel x86/sse2" "Intel x86/x87")) + "Intel x86/sse2") (setf (backend-fasl-file-type *target-backend*) - (if (backend-featurep :sse2) "sse2f" "x86f")) + "sse2f") (setf (backend-fasl-file-implementation *target-backend*) x86-fasl-file-implementation) (setf (backend-fasl-file-version *target-backend*) byte-fasl-file-version) @@ -209,12 +209,6 @@ (defconstant float-traps-byte (byte 6 7)) (defconstant float-exceptions-byte (byte 6 0)) -#-sse2 -(progn -(defconstant float-fast-bit 0) ; No fast mode on x86 -) - -#+sse2 (progn ;; SSE2 has a flush-to-zero flag, which we use as the fast bit. Some ;; versions of sse2 also have a denormals-are-zeros flag. We don't commit 40028a0338821e72bd709153b598bce90c19edef Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Apr 15 21:42:49 2014 -0700 Make sse2 the default and remove the conditioals. diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 56f683b..ff54d37 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -96,7 +96,14 @@ ;;; added by jrd (eval-when (compile load eval) - (defparameter *float-register-names* (make-array #-sse2 8 #+sse2 16 :initial-element nil))) + (defparameter *float-register-names* (make-array 16 :initial-element nil))) + +;; Note: The first 8 values are for the x87 FPU registers and the next +;; 8 values are for the SSE2 registers. Even though we only support +;; SSE2, we need to define the FPU registers so we can access them. +;; Why? The x86 ABI says floats are returned in fr0 (aka ST(0)) and we +;; need to be able to reference this register in the compiler. +;; However, for all other uses, we can only use the xmm registers. (defreg fr0 0 :float) (defreg fr1 1 :float) (defreg fr2 2 :float) @@ -105,8 +112,6 @@ (defreg fr5 5 :float) (defreg fr6 6 :float) (defreg fr7 7 :float) -#+sse2 -(progn (defreg xmm0 8 :float) (defreg xmm1 9 :float) (defreg xmm2 10 :float) @@ -115,12 +120,7 @@ (defreg xmm5 13 :float) (defreg xmm6 14 :float) (defreg xmm7 15 :float) -) - -#-sse2 -(defregset float-regs fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7) -#+sse2 (defregset float-regs fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7 xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7) @@ -142,7 +142,7 @@ ;;; sense to use the 387's idea of a stack. 8 separate registers is easier ;;; to deal with. ;;; (define-storage-base float-registers :finite :size 1) -(define-storage-base float-registers :finite :size #-sse2 8 #+sse2 16) +(define-storage-base float-registers :finite :size 16) (define-storage-base stack :unbounded :size 8) (define-storage-base constant :non-packed) @@ -276,14 +276,14 @@ ;; Non-Descriptor single-floats. (single-reg float-registers - :locations #-sse2 (0 1 2 3 4 5 6 7) #+sse2 (8 9 10 11 12 13 14 15) + :locations (8 9 10 11 12 13 14 15) :constant-scs (fp-constant) :save-p t :alternate-scs (single-stack)) ;; Non-Descriptor double-floats. (double-reg float-registers - :locations #-sse2 (0 1 2 3 4 5 6 7) #+sse2 (8 9 10 11 12 13 14 15) + :locations (8 9 10 11 12 13 14 15) :constant-scs (fp-constant) :save-p t :alternate-scs (double-stack)) @@ -298,22 +298,32 @@ #+double-double (double-double-reg float-registers - :locations #-sse2 (0 2 4 6) #+sse2 (8 10 12 14) + ;; For SSE2, we currently don't store two + ;; double-floats (1 double-double-float) in each + ;; register. Hence, use every other xmm register + ;; here. + :locations (8 10 12 14) :element-size 2 :constant-scs () :save-p t :alternate-scs (double-double-stack)) (complex-single-reg float-registers - :locations #-sse2 (0 2 4 6) #+sse2 (8 9 10 11 12 13 14 15) - :element-size #-sse2 2 #+sse2 1 + ;; The SSE2 float registers can store two + ;; single-float values (1 complex single-float) + ;; in each register. + :locations (8 9 10 11 12 13 14 15) + :element-size 1 :constant-scs () :save-p t :alternate-scs (complex-single-stack)) (complex-double-reg float-registers - :locations #-sse2 (0 2 4 6) #+sse2 (8 9 10 11 12 13 14 15) - :element-size #-sse2 2 #+sse2 1 + ;; The SSE2 float registers can store two + ;; double-float values (1 complex double-float) + ;; in each register. + :locations (8 9 10 11 12 13 14 15) + :element-size 1 :constant-scs () :save-p t :alternate-scs (complex-double-stack)) @@ -327,7 +337,11 @@ :alternate-scs (complex-long-stack)) #+double-double (complex-double-double-reg float-registers - :locations #-sse2 (0 4) #+sse2 (8 12) + ;; For SSE2, we don't pack the + ;; complex-double-double value into registers + ;; but use four separate registers to hold the + ;; value. + :locations (8 12) :element-size 4 :constant-scs () :save-p t @@ -376,11 +390,6 @@ (def-random-reg-tns word-reg ax bx cx dx bp sp di si) (def-random-reg-tns byte-reg al ah bl bh cl ch dl dh) -;; added by jrd -#-sse2 -(def-random-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7) - -#+sse2 (def-random-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7 xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7) @@ -406,12 +415,10 @@ (when (static-symbol-p value) (sc-number-or-lose 'immediate *backend*))) (single-float - (when (or (eql value 0f0) - #-sse2 (eql value 1f0)) + (when (eql value 0f0) (sc-number-or-lose 'fp-constant *backend*))) (double-float - (when (or (eql value 0d0) - #-sse2 (eql value 1d0)) + (when (eql value 0d0) (sc-number-or-lose 'fp-constant *backend*))) #+long-float (long-float @@ -479,9 +486,6 @@ (svref name-vec offset)) (format nil "<Unknown Reg: off=~D, sc=~A>" offset sc-name)))) (float-registers - #-sse2 - (format nil "FR~D" offset) - #+sse2 (format nil (if (< offset 8) "FR~D" "XMM~D") ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/macros.lisp | 12 +++----- src/compiler/x86/parms.lisp | 10 ++----- src/compiler/x86/vm.lisp | 62 ++++++++++++++++++++++-------------------- 3 files changed, 39 insertions(+), 45 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0