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

[git] CMU Common Lisp branch master updated. 20e-5-g61218b9
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 61218b92d2f2ed8b83816a5037b1afb46c3c6619 (commit) from 07e2d61f67dbd0e099c256052ba70358125cc008 (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 61218b92d2f2ed8b83816a5037b1afb46c3c6619 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Oct 21 18:12:11 2013 -0700 Update according to commit logs. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 3c6db52..3b3f9ef 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -25,6 +25,8 @@ New in this release: * Changes * When *PRINT-CASE* is :DOWNCASE, integers are printed with lowercase letters when needed. + * Micro-optimize KERNEL:DOUBLE-FLOAT-BITS for x86/sse2. + * Add micro-optimization for unary FTRUNCATE for x86/sse2. * ANSI compliance fixes: ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20f.txt | 2 ++ 1 file changed, 2 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-43-g6d3144f
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 6d3144f9382a4aede51913d7465d300a320412e3 (commit) from 386d97b2222de3cb7d175013d6509722c10b3846 (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 6d3144f9382a4aede51913d7465d300a320412e3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 19:54:27 2014 -0700 Update to use unions. * e_pow.c: * Use unions to get to the parts of a double * fdlibm.h: * Declare sqrt function. diff --git a/src/lisp/e_pow.c b/src/lisp/e_pow.c index 5683bf5..9dafc26 100644 --- a/src/lisp/e_pow.c +++ b/src/lisp/e_pow.c @@ -109,10 +109,15 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ int i0,i1,i,j,k,yisint,n; int hx,hy,ix,iy; unsigned lx,ly; + union { int i[2]; double d; } ux; + union { int i[2]; double d; } uy; + union { int i[2]; double d; } utmp; i0 = ((*(int*)&one)>>29)^1; i1=1-i0; - hx = __HI(x); lx = __LO(x); - hy = __HI(y); ly = __LO(y); + ux.d = x; + hx = ux.i[HIWORD]; lx = ux.i[LOWORD]; + uy.d = y; + hy = uy.i[HIWORD]; ly = uy.i[LOWORD]; ix = hx&0x7fffffff; iy = hy&0x7fffffff; /* y==zero: x**0 = 1 */ @@ -203,14 +208,20 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ u = ivln2_h*t; /* ivln2_h has 21 sig. bits */ v = t*ivln2_l-w*ivln2; t1 = u+v; - __LO(t1) = 0; + utmp.d = t1; + utmp.i[LOWORD] = 0; + t1 = utmp.d; t2 = v-(t1-u); } else { double ss,s2,s_h,s_l,t_h,t_l; n = 0; /* take care subnormal number */ - if(ix<0x00100000) - {ax *= two53; n -= 53; ix = __HI(ax); } + if(ix<0x00100000) { + ax *= two53; + n -= 53; + utmp.d = ax; + ix = utmp.i[HIWORD]; + } n += ((ix)>>20)-0x3ff; j = ix&0x000fffff; /* determine interval */ @@ -218,17 +229,23 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ if(j<=0x3988E) k=0; /* |x|<sqrt(3/2) */ else if(j<0xBB67A) k=1; /* |x|<sqrt(3) */ else {k=0;n+=1;ix -= 0x00100000;} - __HI(ax) = ix; + utmp.d = ax; + utmp.i[HIWORD] = ix; + ax = utmp.d; /* compute ss = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ v = one/(ax+bp[k]); ss = u*v; s_h = ss; - __LO(s_h) = 0; + utmp.d = s_h; + utmp.i[LOWORD] = 0; + s_h = utmp.d; /* t_h=ax+bp[k] High */ t_h = zero; - __HI(t_h)=((ix>>1)|0x20000000)+0x00080000+(k<<18); + utmp.d = t_h; + utmp.i[HIWORD]=((ix>>1)|0x20000000)+0x00080000+(k<<18); + t_h = utmp.d; t_l = ax - (t_h-bp[k]); s_l = v*((u-s_h*t_h)-s_h*t_l); /* compute log(ax) */ @@ -237,32 +254,41 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ r += s_l*(s_h+ss); s2 = s_h*s_h; t_h = 3.0+s2+r; - __LO(t_h) = 0; + utmp.d = t_h; + utmp.i[LOWORD] = 0; + t_h = utmp.d; t_l = r-((t_h-3.0)-s2); /* u+v = ss*(1+...) */ u = s_h*t_h; v = s_l*t_h+t_l*ss; /* 2/(3log2)*(ss+...) */ p_h = u+v; - __LO(p_h) = 0; + utmp.d = p_h; + utmp.i[LOWORD] = 0; + p_h = utmp.d; p_l = v-(p_h-u); z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ z_l = cp_l*p_h+p_l*cp+dp_l[k]; /* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */ t = (double)n; t1 = (((z_h+z_l)+dp_h[k])+t); - __LO(t1) = 0; + utmp.d = t1; + utmp.i[LOWORD] = 0; + t1 = utmp.d; t2 = z_l-(((t1-t)-dp_h[k])-z_h); } /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ y1 = y; - __LO(y1) = 0; + utmp.d = y1; + utmp.i[LOWORD] = 0; + y1 = utmp.d; p_l = (y-y1)*t1+y*t2; p_h = y1*t1; z = p_l+p_h; - j = __HI(z); - i = __LO(z); + utmp.d = z; + j = utmp.i[HIWORD]; + i = utmp.i[LOWORD]; if (j>=0x40900000) { /* z >= 1024 */ if(((j-0x40900000)|i)!=0) /* if z > 1024 */ return s*huge*huge; /* overflow */ @@ -286,13 +312,17 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ n = j+(0x00100000>>(k+1)); k = ((n&0x7fffffff)>>20)-0x3ff; /* new k for n */ t = zero; - __HI(t) = (n&~(0x000fffff>>k)); + utmp.d = t; + utmp.i[HIWORD] = (n&~(0x000fffff>>k)); + t = utmp.d; n = ((n&0x000fffff)|0x00100000)>>(20-k); if(j<0) n = -n; p_h -= t; } t = p_l+p_h; - __LO(t) = 0; + utmp.d = t; + utmp.i[LOWORD] = 0; + t = utmp.d; u = t*lg2_h; v = (p_l-(t-p_h))*lg2+t*lg2_l; z = u+v; @@ -301,9 +331,14 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); r = (z*t1)/(t1-two)-(w+z*w); z = one-(r-z); - j = __HI(z); + utmp.d = z; + j = utmp.i[HIWORD]; j += (n<<20); if((j>>20)<=0) z = scalbn(z,n); /* subnormal output */ - else __HI(z) += (n<<20); + else { + utmp.d = z; + utmp.i[HIWORD] += (n<<20); + z = utmp.d; + } return s*z; } diff --git a/src/lisp/fdlibm.h b/src/lisp/fdlibm.h index 467daa5..180137b 100644 --- a/src/lisp/fdlibm.h +++ b/src/lisp/fdlibm.h @@ -32,6 +32,7 @@ enum { HIWORD = 0, LOWORD = 1 }; */ extern double fabs(double); extern double floor(double); +extern double sqrt(double); /* ieee style elementary functions */ extern int __ieee754_rem_pio2(double,double*); ----------------------------------------------------------------------- Summary of changes: src/lisp/e_pow.c | 71 +++++++++++++++++++++++++++++++++++++++-------------- src/lisp/fdlibm.h | 1 + 2 files changed, 54 insertions(+), 18 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-100-ga4cb51f
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 a4cb51f3ce2e599377f122b79dad696603c6b202 (commit) from 7e5b00bfacdf0a3693fef1d92329da18bf4e028b (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 a4cb51f3ce2e599377f122b79dad696603c6b202 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Aug 6 19:57:55 2014 -0700 Remove commented-out LDFLAGS. diff --git a/src/motif/server/Config.x86 b/src/motif/server/Config.x86 index d830710..fb0e8f9 100644 --- a/src/motif/server/Config.x86 +++ b/src/motif/server/Config.x86 @@ -1,5 +1,4 @@ CFLAGS += -m32 -O2 -I/usr/X11R6/include -I. -I$(VPATH) -# LDFLAGS += -L/usr/X11R6/lib # On OpenSuSE 11.3,the 32-bit X libraries are in /usr/lib. LDFLAGS += -m32 -L/usr/lib LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE -lXp -ldl -lpthread ----------------------------------------------------------------------- Summary of changes: src/motif/server/Config.x86 | 1 - 1 file changed, 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. begin-x87-removal-3-g0592141
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 0592141ab9256ca0382a501b418523194ed66e3c (commit) via 85c164325d8fe115eddefe9566ff0dcb206e76cf (commit) from a746e0218269ff24d8d88e5edfd01b284558d33b (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 0592141ab9256ca0382a501b418523194ed66e3c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Mar 30 10:10:58 2014 -0700 Remove -fpu command-line switch. diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c index 7b08fd1..c484129 100644 --- a/src/lisp/lisp.c +++ b/src/lisp/lisp.c @@ -422,7 +422,7 @@ prepend_core_path(const char *lib, const char *corefile) extern int builtin_image_flag; extern long initial_function_addr; -fpu_mode_t fpu_mode = AUTO; +fpu_mode_t fpu_mode = SSE2; static const char* locate_core(const char* cmucllib, const char* core, const char* default_core) @@ -662,32 +662,6 @@ main(int argc, const char *argv[], const char *envp[]) } else if (strcmp(arg, "-unidata") == 0) { unidata = *++argptr; } -#ifdef i386 - else if (strcmp(arg, "-fpu") == 0) { - const char *str; - - str = *++argptr; - if (str == NULL) { - fprintf(stderr, "-fpu must be followed by the FPU type: auto, x87, sse2\n"); - exit(1); - } - - if (builtin_image_flag != 0) { - fprintf(stderr, - "Warning: -fpu cannot change the fpu mode of an executable image\n"); - } else { - if (strcmp(str, "auto") == 0) { - fpu_mode = AUTO; - } else if (strcmp(str, "x87") == 0) { - fpu_mode = X87; - } else if (strcmp(str, "sse2") == 0) { - fpu_mode = SSE2; - } else { - fprintf(stderr, "Unknown fpu type: `%s'. Using auto\n", str); - } - } - } -#endif } default_core = arch_init(fpu_mode); commit 85c164325d8fe115eddefe9566ff0dcb206e76cf Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Mar 30 10:10:05 2014 -0700 Remove lisp -fpu command-line switch. diff --git a/src/code/commandline.lisp b/src/code/commandline.lisp index 4500bd4..2480a93 100644 --- a/src/code/commandline.lisp +++ b/src/code/commandline.lisp @@ -333,17 +333,6 @@ "Specify the unidata.bin file to be used." "filename") -#+x86 -(intl:with-textdomain ("cmucl" "cmucl-x86-vm") -(defswitch "fpu" nil - "Specifies what kind of floating-point support should be used on x86 - systems. If 'x87', Lisp will use the x87 floating-point unit; if - 'sse2', Lisp uses SSE2 floating-point unit. The default is - 'auto',which causes Lisp to check to see if SSE2 is available. If - so, then SSE2 is used. If the SSE2 core file cannot be found,Lisp - will fallback to the x87 core, which can run on any machine." - "mode")) - (defun help-switch-demon (switch) (declare (ignore switch)) (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*) ----------------------------------------------------------------------- Summary of changes: src/code/commandline.lisp | 11 ----------- src/lisp/lisp.c | 28 +--------------------------- 2 files changed, 1 insertion(+), 38 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-11-8-g5d7af87
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 5d7af879d56be571ab7818d3a547c08035287967 (commit) via daa00b2733984884a56834efc28a4859872fa8ac (commit) from d5983ca74965ef16fb3cb47d78024c3eb68a4a59 (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 5d7af879d56be571ab7818d3a547c08035287967 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Dec 7 15:26:26 2013 -0800 Teach compiler to derive the results of DECODE-FLOAT. src/compiler/float-tran.lisp o Add defoptimizer for DECODE-FLOAT. src/general-info/release-20f.txt: o Update notes. diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 187d17b..5fbc2e0 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2014,6 +2014,89 @@ (specifier-type `(complex ,(or (numeric-type-format arg) 'float)))) #'cis)) +;;; Derive the result types of DECODE-FLOAT + +(defun decode-float-frac-derive-type-aux (arg) + ;; The fraction part of DECODE-FLOAT is always a subset of the + ;; interval [0.5, 1), even for subnormals. While possible to derive + ;; a tighter bound in some cases, we don't. Just return that + ;; interval of the approriate type when possible. If not, just use + ;; float. + (if (numeric-type-format arg) + (specifier-type `(,(numeric-type-format arg) + ,(coerce 1/2 (numeric-type-format arg)) + (,(coerce 1 (numeric-type-format arg))))) + (specifier-type '(float 0.5 (1.0))))) + +(defun decode-float-exp-derive-type-aux (arg) + ;; Derive the exponent part of the float. It's always an integer + ;; type. + (flet ((calc-exp (x) + (when x + (nth-value 1 (decode-float x)))) + (min-exp () + ;; Use decode-float on 0 of the appropriate type to find + ;; the min exponent. If we don't know the actual number + ;; format, use double, which has the widest range + ;; (including double-double-float). + (if (numeric-type-format arg) + (nth-value 1 (decode-float (coerce 0 (numeric-type-format arg)))) + (nth-value 1 (decode-float (coerce 0 'double-float))))) + (max-exp () + ;; Use decode-float on the most postive number of the + ;; appropriate type to find the max exponent. If we don't + ;; know the actual number format, use double, which has the + ;; widest range (including double-double-float). + (if (eq (numeric-type-format arg) 'single-float) + (nth-value 1 (decode-float most-positive-single-float)) + (nth-value 1 (decode-float most-positive-double-float))))) + (let* ((lo (or (bound-func #'calc-exp + (numeric-type-low arg)) + (min-exp))) + (hi (or (bound-func #'calc-exp + (numeric-type-high arg)) + (max-exp)))) + (specifier-type `(integer ,(or lo '*) ,(or hi '*)))))) + +(defun decode-float-sign-derive-type-aux (arg) + ;; Derive the sign of the float. + (flet ((calc-sign (x) + (when x + (nth-value 2 (decode-float x))))) + (let* ((lo (bound-func #'calc-sign + (numeric-type-low arg))) + (hi (bound-func #'calc-sign + (numeric-type-high arg)))) + (if (numeric-type-format arg) + (specifier-type `(,(numeric-type-format arg) + ;; If lo or high bounds are NIL, use -1 + ;; or 1 of the appropriate type instead. + ,(or lo (coerce -1 (numeric-type-format arg))) + ,(or hi (coerce 1 (numeric-type-format arg))))) + (specifier-type '(or (member 1f0 -1f0 + 1d0 -1d0 + #+double-double 1w0 + #+double-double -1w0))))))) + +(defoptimizer (decode-float derive-type) ((num)) + (let ((f (one-arg-derive-type num + #'(lambda (arg) + (decode-float-frac-derive-type-aux arg)) + #'(lambda (arg) + (nth-value 0 (decode-float arg))))) + (e (one-arg-derive-type num + #'(lambda (arg) + (decode-float-exp-derive-type-aux arg)) + #'(lambda (arg) + (nth-value 1 (decode-float arg))))) + (s (one-arg-derive-type num + #'(lambda (arg) + (decode-float-sign-derive-type-aux arg)) + #'(lambda (arg) + (nth-value 2 (decode-float arg)))))) + (make-values-type :required (list f + e + s)))) ;;; Support for double-double floats ;;; diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 4077097..dd1cf1b 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -28,6 +28,7 @@ New in this release: lowercase letters when needed. * Micro-optimize KERNEL:DOUBLE-FLOAT-BITS for x86/sse2. * Add micro-optimization for unary FTRUNCATE for x86/sse2. + * Compiler can derive the types of the results of DECODE-FLOAT. * ANSI compliance fixes: commit daa00b2733984884a56834efc28a4859872fa8ac Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Dec 7 15:25:26 2013 -0800 Regenerated. diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 3d53de0..283dcaf 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -14480,7 +14480,7 @@ msgid "" msgstr "" #: src/code/macros.lisp -msgid "Cond clause is not a list: ~S." +msgid "Cond clause should be a non-empty list: ~S." msgstr "" #: src/code/macros.lisp ----------------------------------------------------------------------- Summary of changes: src/compiler/float-tran.lisp | 83 ++++++++++++++++++++++++++++++++++++++ src/general-info/release-20f.txt | 1 + src/i18n/locale/cmucl.pot | 2 +- 3 files changed, 85 insertions(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-12-a-37-gb3b6dce
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 b3b6dce07ceb5538e89ce8c49a8bd1fe2d6a15d1 (commit) via 6b8ebd981528242319eeb8d8ef931df8ceaaefe5 (commit) from 4e3589d9d175382fe85b6efe2e3e94ccf598a88e (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 b3b6dce07ceb5538e89ce8c49a8bd1fe2d6a15d1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Dec 22 22:59:37 2013 -0800 Fix test trac.69: Move the setting of the logical pathname translation outside of the test. diff --git a/tests/trac.lisp b/tests/trac.lisp index a2a1e35..64cbe81 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -207,10 +207,11 @@ (replace s s :start2 100 :end2 105))) (copy-seq "1234567890")))) +(setf (logical-pathname-translations "trac69") + '(("**;*.*.*" "/tmp/**/*.*"))) + (define-test trac.69 (:tag :trac) - (setf (logical-pathname-translations "trac69") - '(("**;*.*.*" "/tmp/**/*.*"))) (assert-error 'lisp::namestring-parse-error (let ((*default-pathname-defaults* #p"trac69:")) (pathname "/tmp/bar.lisp")))) commit 6b8ebd981528242319eeb8d8ef931df8ceaaefe5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Dec 22 22:53:24 2013 -0800 Fix typo. diff --git a/tests/trac.lisp b/tests/trac.lisp index 2f9a4ae..a2a1e35 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -157,7 +157,7 @@ (dotimes (i 300) (let ((ch (read-char s nil nil))) (unless (= i (char-code ch)) - (push (list i ch (char-code ch)) faillures))))) + (push (list i ch (char-code ch)) failures))))) failures) (delete-file path))))) ----------------------------------------------------------------------- Summary of changes: tests/trac.lisp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-43-g458231d
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 458231d178c7c98798c653f574b6aab839637bc1 (commit) from 9ca40a2b90607cd33577644c5cd5d38ae5fe1354 (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 458231d178c7c98798c653f574b6aab839637bc1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Aug 28 20:03:24 2014 -0700 If a process is not schedulable because it has no run-reasons and/or an arrest-reason, destroy-process doesn't take effect. Destroy-process sets process-state to :active to try to ensure it gets the interrupt, but it also needs to clear process-%arrest-reasons and push something on process-%run-reasons. Patch from Paul Foley. diff --git a/src/code/multi-proc.lisp b/src/code/multi-proc.lisp index 4e2b1bc..c73f0b4 100644 --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -1044,7 +1044,9 @@ (process-interrupts process)) ;; Ensure that the process is active so that it can accept this ;; interrupt. - (setf (process-state process) :active))) + (setf (process-state process) :active + (process-%arrest-reasons process) nil) + (push :destroyed (process-%run-reasons process)))) ;; Should we wait until it's dead? (process-yield)) ----------------------------------------------------------------------- Summary of changes: src/code/multi-proc.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch rtoy-lisp-trig updated. snapshot-2013-12-a-11-g1ae2d46
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, rtoy-lisp-trig has been updated via 1ae2d46cf3e9776ff35c6d6eddf3d73f6b0b66a1 (commit) from 1266d1ff1eb938136e8ae684eb9e3be8009ec350 (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 1ae2d46cf3e9776ff35c6d6eddf3d73f6b0b66a1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Dec 17 19:45:02 2013 -0800 Remove RT. diff --git a/src/code/module.lisp b/src/code/module.lisp index 42b0ac2..70ccba7 100644 --- a/src/code/module.lisp +++ b/src/code/module.lisp @@ -148,12 +148,6 @@ (defmodule "asdf" "modules:asdf/asdf") -(defmodule :rt - "modules:rt/rt") - -(defmodule "rt" - "modules:rt/rt") - ;; Allow user to specify "cmu-contribs" or :cmu-contribs. (defmodule "cmu-contribs" "modules:contrib") diff --git a/src/contrib/rt/rt.asd b/src/contrib/rt/rt.asd deleted file mode 100644 index 718e965..0000000 --- a/src/contrib/rt/rt.asd +++ /dev/null @@ -1,33 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: rt.asd -;;;; Purpose: ASDF definition file for Rt -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Sep 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of cl-rt, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; cl-rt users are granted the rights to distribute and use this software -;;;; as governed by the terms of the GNU Lesser General Public License -;;;; (http://www.gnu.org/licenses/lgpl.html) -;;;; ************************************************************************* - -(in-package :asdf) - -(defsystem :rt - :name "cl-rt" - :version "1990.12.19" - :maintainer "Kevin M. Rosenberg <kmr(a)debian.org>" - :licence "MIT" - :description "MIT Regression Tester" - :long-description "RT provides a framework for writing regression test suites" - :perform (load-op :after (op rt) - (pushnew :rt cl:*features*)) - :components - ((:file "rt"))) - - diff --git a/src/contrib/rt/rt.lisp b/src/contrib/rt/rt.lisp deleted file mode 100644 index 3df87c4..0000000 --- a/src/contrib/rt/rt.lisp +++ /dev/null @@ -1,409 +0,0 @@ -;-*-syntax:COMMON-LISP;Package:(RT :use "COMMON-LISP" :colon-mode :external)-*- - -#|----------------------------------------------------------------------------| - | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | - | | - | Permission to use, copy, modify, and distribute this software and its | - | documentation for any purpose and without fee is hereby granted, provided | - | that this copyright and permission notice appear in all copies and | - | supporting documentation, and that the name of M.I.T. not be used in | - | advertising or publicity pertaining to distribution of the software | - | without specific, written prior permission. M.I.T. makes no | - | representations about the suitability of this software for any purpose. | - | It is provided "as is" without express or implied warranty. | - | | - | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING | - | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL | - | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR | - | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, | - | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, | - | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS | - | SOFTWARE. | - |----------------------------------------------------------------------------|# - -(defpackage #:regression-test - (:nicknames #:rtest #-lispworks #:rt) - (:use #:cl) - (:export #:*do-tests-when-defined* #:*test* #:continue-testing - #:deftest #:do-test #:do-tests #:get-test #:pending-tests - #:rem-all-tests #:rem-test) - (:documentation "The MIT regression tester with pfdietz's modifications")) - -;;This was the December 19, 1990 version of the regression tester, but -;;has since been modified. - -(in-package :regression-test) - -(declaim (ftype (function (t) t) get-entry expanded-eval do-entries)) -(declaim (type list *entries*)) -(declaim (ftype (function (t &rest t) t) report-error)) -(declaim (ftype (function (t &optional t) t) do-entry)) - -(defvar *test* nil "Current test name") -(defvar *do-tests-when-defined* nil) -(defvar *entries* '(nil) "Test database. Has a leading dummy cell that does not contain an entry.") -(defvar *entries-tail* *entries* "Tail of the *entries* list") -(defvar *entries-table* (make-hash-table :test #'equal) - "Map the names of entries to the cons cell in *entries* that precedes the one whose car is the entry.") -(defvar *in-test* nil "Used by TEST") -(defvar *debug* nil "For debugging") -(defvar *catch-errors* t "When true, causes errors in a test to be caught.") -(defvar *print-circle-on-failure* nil - "Failure reports are printed with *PRINT-CIRCLE* bound to this value.") - -(defvar *compile-tests* nil "When true, compile the tests before running them.") -(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") -(defvar *optimization-settings* '((safety 3))) - -(defvar *expected-failures* nil - "A list of test names that are expected to fail.") - -(defvar *notes* (make-hash-table :test 'equal) - "A mapping from names of notes to note objects.") - -(defstruct (entry (:conc-name nil)) - pend name props form vals) - -;;; Note objects are used to attach information to tests. -;;; A typical use is to mark tests that depend on a particular -;;; part of a set of requirements, or a particular interpretation -;;; of the requirements. - -(defstruct note - name - contents - disabled ;; When true, tests with this note are considered inactive - ) - -;; (defmacro vals (entry) `(cdddr ,entry)) - -(defmacro defn (entry) - (let ((var (gensym))) - `(let ((,var ,entry)) - (list* (name ,var) (form ,var) (vals ,var))))) - -(defun entry-notes (entry) - (let* ((props (props entry)) - (notes (getf props :notes))) - (if (listp notes) - notes - (list notes)))) - -(defun has-disabled-note (entry) - (let ((notes (entry-notes entry))) - (loop for n in notes - for note = (if (note-p n) n - (gethash n *notes*)) - thereis (and note (note-disabled note))))) - -(defun pending-tests () - (loop for entry in (cdr *entries*) - when (and (pend entry) (not (has-disabled-note entry))) - collect (name entry))) - -(defun rem-all-tests () - (setq *entries* (list nil)) - (setq *entries-tail* *entries*) - (clrhash *entries-table*) - nil) - -(defun rem-test (&optional (name *test*)) - (let ((pred (gethash name *entries-table*))) - (when pred - (if (null (cddr pred)) - (setq *entries-tail* pred) - (setf (gethash (name (caddr pred)) *entries-table*) pred)) - (setf (cdr pred) (cddr pred)) - (remhash name *entries-table*) - name))) - -(defun get-test (&optional (name *test*)) - (defn (get-entry name))) - -(defun get-entry (name) - (let ((entry ;; (find name (the list (cdr *entries*)) - ;; :key #'name :test #'equal) - (cadr (gethash name *entries-table*)) - )) - (when (null entry) - (report-error t - "~%No test with name ~:@(~S~)." - name)) - entry)) - -(defmacro deftest (name &rest body) - (let* ((p body) - (properties - (loop while (keywordp (first p)) - unless (cadr p) - do (error "Poorly formed deftest: ~A~%" - (list* 'deftest name body)) - append (list (pop p) (pop p)))) - (form (pop p)) - (vals p)) - `(add-entry (make-entry :pend t - :name ',name - :props ',properties - :form ',form - :vals ',vals)))) - -(defun add-entry (entry) - (setq entry (copy-entry entry)) - (let* ((pred (gethash (name entry) *entries-table*))) - (cond - (pred - (setf (cadr pred) entry) - (report-error nil - "Redefining test ~:@(~S~)" - (name entry))) - (t - (setf (gethash (name entry) *entries-table*) *entries-tail*) - (setf (cdr *entries-tail*) (cons entry nil)) - (setf *entries-tail* (cdr *entries-tail*)) - ))) - (when *do-tests-when-defined* - (do-entry entry)) - (setq *test* (name entry))) - -(defun report-error (error? &rest args) - (cond (*debug* - (apply #'format t args) - (if error? (throw '*debug* nil))) - (error? (apply #'error args)) - (t (apply #'warn args))) - nil) - -(defun do-test (&optional (name *test*)) - #-sbcl (do-entry (get-entry name)) - #+sbcl (handler-bind ((sb-ext:code-deletion-note #'muffle-warning)) - (do-entry (get-entry name)))) - -(defun my-aref (a &rest args) - (apply #'aref a args)) - -(defun my-row-major-aref (a index) - (row-major-aref a index)) - -(defun equalp-with-case (x y) - "Like EQUALP, but doesn't do case conversion of characters. - Currently doesn't work on arrays of dimension > 2." - (cond - ((eq x y) t) - ((consp x) - (and (consp y) - (equalp-with-case (car x) (car y)) - (equalp-with-case (cdr x) (cdr y)))) - ((and (typep x 'array) - (= (array-rank x) 0)) - (equalp-with-case (my-aref x) (my-aref y))) - ((typep x 'vector) - (and (typep y 'vector) - (let ((x-len (length x)) - (y-len (length y))) - (and (eql x-len y-len) - (loop - for i from 0 below x-len - for e1 = (my-aref x i) - for e2 = (my-aref y i) - always (equalp-with-case e1 e2)))))) - ((and (typep x 'array) - (typep y 'array) - (not (equal (array-dimensions x) - (array-dimensions y)))) - nil) - - ((typep x 'array) - (and (typep y 'array) - (let ((size (array-total-size x))) - (loop for i from 0 below size - always (equalp-with-case (my-row-major-aref x i) - (my-row-major-aref y i)))))) - - (t (eql x y)))) - -(defun do-entry (entry &optional - (s *standard-output*)) - (catch '*in-test* - (setq *test* (name entry)) - (setf (pend entry) t) - (let* ((*in-test* t) - ;; (*break-on-warnings* t) - (aborted nil) - r) - ;; (declare (special *break-on-warnings*)) - - (block aborted - (setf r - (flet ((%do - () - (cond - (*compile-tests* - (multiple-value-list - (funcall (compile - nil - `(lambda () - (declare - (optimize ,@*optimization-settings*)) - ,(form entry)))))) - (*expanded-eval* - (multiple-value-list - (expanded-eval (form entry)))) - (t - (multiple-value-list - (eval (form entry))))))) - (if *catch-errors* - (handler-bind - (#-ecl (style-warning #'muffle-warning) - (error #'(lambda (c) - (setf aborted t) - (setf r (list c)) - (return-from aborted nil)))) - (%do)) - (%do))))) - - (setf (pend entry) - (or aborted - (not (equalp-with-case r (vals entry))))) - - (when (pend entry) - (let ((*print-circle* *print-circle-on-failure*)) - (format s "~&Test ~:@(~S~) failed~ - ~%Form: ~S~ - ~%Expected value~P: ~ - ~{~S~^~%~17t~}~%" - *test* (form entry) - (length (vals entry)) - (vals entry)) - (handler-case - (let ((st (format nil "Actual value~P: ~ - ~{~S~^~%~15t~}.~%" - (length r) r))) - (format s "~A" st)) - (error () (format s "Actual value: #<error during printing>~%") - )) - (finish-output s) - )))) - (when (not (pend entry)) *test*)) - -(defun expanded-eval (form) - "Split off top level of a form and eval separately. This reduces the chance that - compiler optimizations will fold away runtime computation." - (if (not (consp form)) - (eval form) - (let ((op (car form))) - (cond - ((eq op 'let) - (let* ((bindings (loop for b in (cadr form) - collect (if (consp b) b (list b nil)))) - (vars (mapcar #'car bindings)) - (binding-forms (mapcar #'cadr bindings))) - (apply - (the function - (eval `(lambda ,vars ,@(cddr form)))) - (mapcar #'eval binding-forms)))) - ((and (eq op 'let*) (cadr form)) - (let* ((bindings (loop for b in (cadr form) - collect (if (consp b) b (list b nil)))) - (vars (mapcar #'car bindings)) - (binding-forms (mapcar #'cadr bindings))) - (funcall - (the function - (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form)))) - (eval (car binding-forms))))) - ((eq op 'progn) - (loop for e on (cdr form) - do (if (null (cdr e)) (return (eval (car e))) - (eval (car e))))) - ((and (symbolp op) (fboundp op) - (not (macro-function op)) - (not (special-operator-p op))) - (apply (symbol-function op) - (mapcar #'eval (cdr form)))) - (t (eval form)))))) - -(defun continue-testing () - (if *in-test* - (throw '*in-test* nil) - (do-entries *standard-output*))) - -(defun do-tests (&optional - (out *standard-output*)) - (dolist (entry (cdr *entries*)) - (setf (pend entry) t)) - (if (streamp out) - (do-entries out) - (with-open-file - (stream out :direction :output) - (do-entries stream)))) - -(defun do-entries* (s) - (format s "~&Doing ~A pending test~:P ~ - of ~A tests total.~%" - (count t (the list (cdr *entries*)) :key #'pend) - (length (cdr *entries*))) - (finish-output s) - (dolist (entry (cdr *entries*)) - (when (and (pend entry) - (not (has-disabled-note entry))) - (format s "~@[~<~%~:; ~:@(~S~)~>~]" - (do-entry entry s)) - (finish-output s) - )) - (let ((pending (pending-tests)) - (expected-table (make-hash-table :test #'equal))) - (dolist (ex *expected-failures*) - (setf (gethash ex expected-table) t)) - (let ((new-failures - (loop for pend in pending - unless (gethash pend expected-table) - collect pend))) - (if (null pending) - (format s "~&No tests failed.") - (progn - (format s "~&~A out of ~A ~ - total tests failed: ~ - ~:@(~{~<~% ~1:;~S~>~ - ~^, ~}~)." - (length pending) - (length (cdr *entries*)) - pending) - (if (null new-failures) - (format s "~&No unexpected failures.") - (when *expected-failures* - (format s "~&~A unexpected failures: ~ - ~:@(~{~<~% ~1:;~S~>~ - ~^, ~}~)." - (length new-failures) - new-failures))) - )) - (finish-output s) - (null pending)))) - -(defun do-entries (s) - #-sbcl (do-entries* s) - #+sbcl (handler-bind ((sb-ext:code-deletion-note #'muffle-warning)) - (do-entries* s))) - -;;; Note handling functions and macros - -(defmacro defnote (name contents &optional disabled) - `(eval-when (:load-toplevel :execute) - (let ((note (make-note :name ',name - :contents ',contents - :disabled ',disabled))) - (setf (gethash (note-name note) *notes*) note) - note))) - -(defun disable-note (n) - (let ((note (if (note-p n) n - (setf n (gethash n *notes*))))) - (unless note (error "~A is not a note or note name." n)) - (setf (note-disabled note) t) - note)) - -(defun enable-note (n) - (let ((note (if (note-p n) n - (setf n (gethash n *notes*))))) - (unless note (error "~A is not a note or note name." n)) - (setf (note-disabled note) nil) - note)) ----------------------------------------------------------------------- Summary of changes: src/code/module.lisp | 6 - src/contrib/rt/rt.asd | 33 ---- src/contrib/rt/rt.lisp | 409 ------------------------------------------------ 3 files changed, 448 deletions(-) delete mode 100644 src/contrib/rt/rt.asd delete mode 100644 src/contrib/rt/rt.lisp hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp annotated tag release-20e-base created. release-20e-base
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 annotated tag, release-20e-base has been created at 02b2c537d6272ece6b56e45b6b9ae61b9dfe167e (tag) tagging bc828bed51339b951d84d2a264adf0221172f126 (commit) replaces snapshot-2013-09 tagged by Raymond Toy on Sat Sep 28 07:41:19 2013 -0700 - Log ----------------------------------------------------------------- Base for the 20e release. -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.13 (Darwin) iEYEABECAAYFAlJG6qsACgkQJ5IjUmgZO7KZVQCgsnV5wSyZf0YnzELua+LVp4Yg zfMAoLyY6JU1hBrCWsenw3H5xtOZzKuA =KfgX -----END PGP SIGNATURE----- Raymond Toy (9): Change Sparc default variant to sparc_sunc instead of sparc_gcc. Allow disabling the use of git for the file-comment. Set lvshort to solaris too if lisp_variant=sparc*. Support all sun4 archs, not just sun4u. (sun4v is T1). Update for new documentation. Update for release 20e. Update to date to Oct 2013, 20e. Make :plus-integer actually print + or - as documented. Update for 20e. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-66-g21aad0e
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 21aad0ecc9f96297deedf9362c19fd877910592a (commit) via a0138a0ccc5d7bd08a7e8445cdd5e05ae83d4618 (commit) from 6ea8fc645c5c60634e864a2741ee897b93a4ef5f (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 21aad0ecc9f96297deedf9362c19fd877910592a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:15:53 2014 -0700 Use fdlibm hyperbolic functions instead of libm. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index ef1628b..86c7d9e 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -71,9 +71,9 @@ (def-math-rtn "atan2" 2) (def-math-rtn ("__ieee754_asin" %asin) 1) (def-math-rtn ("__ieee754_acos" %acos) 1) -(def-math-rtn "sinh" 1) -(def-math-rtn "cosh" 1) -(def-math-rtn "tanh" 1) +(def-math-rtn ("__ieee754_sinh" %sinh) 1) +(def-math-rtn ("__ieee754_cosh" %cosh) 1) +(def-math-rtn ("fdlibm_tanh" %tanh) 1) (def-math-rtn "asinh" 1) (def-math-rtn "acosh" 1) (def-math-rtn "atanh" 1) commit a0138a0ccc5d7bd08a7e8445cdd5e05ae83d4618 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:15:36 2014 -0700 Compile the fdlibm hyperbolic functions. diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin index 9a2c467..7ced0db 100644 --- a/src/lisp/Config.x86_darwin +++ b/src/lisp/Config.x86_darwin @@ -18,7 +18,10 @@ 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 s_log1p.c s_expm1.c e_pow.c e_exp.c e_log.c e_acos.c e_asin.c s_atan.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 e_pow.c e_exp.c e_log.c \ + e_acos.c e_asin.c s_atan.c \ + e_cosh.c e_sinh.c s_tanh.c k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -55,3 +58,10 @@ e_asin.o : e_asin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< s_atan.o : s_atan.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +e_cosh.o : e_cosh.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +e_sinh.o : e_sinh.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< +s_tanh.o : s_tanh.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 6 +++--- src/lisp/Config.x86_darwin | 12 +++++++++++- 2 files changed, 14 insertions(+), 4 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0