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

[git] CMU Common Lisp branch master updated. snapshot-2014-09-7-gd03e178
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 d03e178481b3be542e4a2519890ed2772d081fb6 (commit) from 13bd32f69a31581b50582d6283ba08b745eca6d3 (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 d03e178481b3be542e4a2519890ed2772d081fb6 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Sep 19 22:35:27 2014 -0700 Fix error in type derivation for the sign in DECODE-FLOAT. Type derivation of the sign of (DECODE-FLOAT X) returned the incorrect value when x was declared to be of type (DOUBLE-FLOAT (0d0)). * src/compiler/float-tran.lisp * Fix type derivation * tests/float-tran.lisp * New file for tests of DECODE-FLOAT-SIGN-DERIVE-TYPE-AUX. * tests/float.lisp * New file to test that decode-float is compiled correctly. diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index ccb6e06..4aecd5c 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2082,24 +2082,19 @@ (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))))))) - + (if (numeric-type-format arg) + (let ((arg-range (interval-range-info (numeric-type->interval arg)))) + (case arg-range + (+ (make-member-type :members (list (coerce 1 (numeric-type-format arg))))) + (- (make-member-type :members (list (coerce -1 (numeric-type-format arg))))) + (otherwise + (make-member-type :members (list (coerce 1 (numeric-type-format arg)) + (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) diff --git a/tests/float-tran.lisp b/tests/float-tran.lisp new file mode 100644 index 0000000..9c81882 --- /dev/null +++ b/tests/float-tran.lisp @@ -0,0 +1,17 @@ +;; Tests for various float transformations. + +(defpackage :float-tran-tests + (:use :cl :lisp-unit)) + +(in-package "FLOAT-TRAN-TESTS") + +(define-test decode-float-sign + "Test type derivation of the sign from decode-float" + (assert-equalp (c::make-member-type :members (list 1f0 -1f0)) + (c::decode-float-sign-derive-type-aux (c::specifier-type 'single-float))) + (assert-equalp (c::make-member-type :members (list 1d0 -1d0)) + (c::decode-float-sign-derive-type-aux (c::specifier-type 'double-float))) + (assert-equalp (c::make-member-type :members (list 1f0)) + (c::decode-float-sign-derive-type-aux (c::specifier-type '(single-float (0f0)))))) + + \ No newline at end of file diff --git a/tests/float.lisp b/tests/float.lisp new file mode 100644 index 0000000..6fe1f50 --- /dev/null +++ b/tests/float.lisp @@ -0,0 +1,12 @@ +;; Tests of float functions + +(defpackage :float-tests + (:use :cl :lisp-unit)) + +(in-package "FLOAT-TESTS") + +(define-test decode-float + (assert-true (funcall (compile nil #'(lambda (x) + (declare (type (double-float (0d0)) x)) + (decode-float x))) + 1d0))) ----------------------------------------------------------------------- Summary of changes: src/compiler/float-tran.lisp | 31 +++++++++++++------------------ tests/float-tran.lisp | 17 +++++++++++++++++ tests/float.lisp | 12 ++++++++++++ 3 files changed, 42 insertions(+), 18 deletions(-) create mode 100644 tests/float-tran.lisp create mode 100644 tests/float.lisp hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-91-g4771859
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 47718592f9ef89fd8a52f07d41c8553aa8b525f2 (commit) from 2ecd18513a756d7583191cabb48d87037be365d1 (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 47718592f9ef89fd8a52f07d41c8553aa8b525f2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Aug 3 22:22:32 2014 -0700 Oops. Fix typo by removing the extraneous comma that was left in. diff --git a/src/lisp/e_pow.c b/src/lisp/e_pow.c index c0f0075..6c1aa88 100644 --- a/src/lisp/e_pow.c +++ b/src/lisp/e_pow.c @@ -101,7 +101,7 @@ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ { double z,ax,z_h,z_l,p_h,p_l; double y1,t1,t2,r,s,t,u,v,w; - int ,i,j,k,yisint,n; + int i,j,k,yisint,n; int hx,hy,ix,iy; unsigned lx,ly; union { int i[2]; double d; } ux; ----------------------------------------------------------------------- Summary of changes: src/lisp/e_pow.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp annotated tag 20e created. 20e
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, 20e has been created at 828631213b891de7d4b4ea690123488971d27e1f (tag) tagging bc828bed51339b951d84d2a264adf0221172f126 (commit) replaces snapshot-2013-09 tagged by Raymond Toy on Sat Sep 28 08:04:49 2013 -0700 - Log ----------------------------------------------------------------- CMUCL Release 20e -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.13 (Darwin) iEYEABECAAYFAlJG8B0ACgkQJ5IjUmgZO7J0LQCgwKZlRTOZ7IcN/7+k3HbR+5q2 IokAniRDnBEPgl6YOyqyOPuW7lipYI3y =N5yQ -----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-9-gcc7145c
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 cc7145cac2b298800b0650938d559c11c35caa24 (commit) via 7a11c612892beceb575257c8b2e7fe239964f0e7 (commit) from e934d7ccdc07f355d29014b670605d1bc0b92dc1 (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 cc7145cac2b298800b0650938d559c11c35caa24 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 22 08:09:42 2014 -0700 Comment out all of the trig functions in lisp in favor of calling out to C. Also add interface to sincos function in C. This needs more testing and currently some tests fail. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index bcd40c3..6d17c6c 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -197,6 +197,20 @@ (y0 double-float :out) (y1 double-float :out)) +(declaim (inline %%sincos)) +(alien:def-alien-routine ("sincos" %%sincos) c-call:void + (x double-float) + (s double-float :out) + (c double-float :out)) + +(declaim (inline %sincos)) +(defun %sincos (x) + (declare (double-float x)) + (multiple-value-bind (ign s c) + (%%sincos x) + (values s c))) + +#|| ;; Implement sin/cos/tan in Lisp. These are based on the routines ;; from fdlibm. @@ -603,7 +617,7 @@ (let ((flag (- 1 (ash (logand n 1) 1)))) ;; flag = 1 if n even, -1 if n odd (kernel-tan y0 y1 flag))))))) - +||# ;; Compute sin and cos of x, simultaneously. (defun %sincos (x) (declare (double-float x) @@ -628,7 +642,7 @@ (3 (values (- (kernel-cos y0 y1)) (kernel-sin y0 y1 1)))))))) -(declaim (ext:end-block)) +;;(declaim (ext:end-block)) ;;;; Power functions. commit 7a11c612892beceb575257c8b2e7fe239964f0e7 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 22 08:07:31 2014 -0700 Add implmeentation of sincos in C. Darwin/x86 doesn't have sincos in libm so include sincos when building on Darwin. diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin index 39c09bd..2af8d77 100644 --- a/src/lisp/Config.x86_darwin +++ b/src/lisp/Config.x86_darwin @@ -17,3 +17,14 @@ OS_LINK_FLAGS = -m32 $(MIN_VER) OS_LIBS = EXEC_FINAL_OBJ = exec-final.o + +OS_SRC += sincos.c k_sin.o k_cos.o + +sincos.o : sincos.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + +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) $< diff --git a/src/lisp/sincos.c b/src/lisp/sincos.c new file mode 100644 index 0000000..f5db8b3 --- /dev/null +++ b/src/lisp/sincos.c @@ -0,0 +1,43 @@ +#include "fdlibm.h" + +void sincos (double x, double *s, double *c) +{ + int ix; + union { int i[2]; double d; } ux; + + ux.d = x; + ix = ux.i[HIWORD] & 0x7fffffff; + + /* |x| ~< pi/4 */ + if (ix < 0x3fe921fb) { + *s = __kernel_sin(x, 0.0, 0); + *c = __kernel_cos(x, 0.0); + } else { + /* Argument reduction needed */ + double y[2]; + int n; + + n = __ieee754_rem_pio2(x, y); + + switch (n & 3) { + case 0: + *s = __kernel_sin(y[0], y[1], 1); + *c = __kernel_cos(y[0], y[1]); + break; + case 1: + *s = __kernel_cos(y[0], y[1]); + *c = - __kernel_sin(y[0], y[1], 1); + break; + case 2: + *s = - __kernel_sin(y[0], y[1], 1); + *c = - __kernel_cos(y[0], y[1]); + break; + case 3: + *s = - __kernel_cos(y[0], y[1]); + *c = __kernel_sin(y[0], y[1], 1); + break; + } + } + + return; +} ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 18 ++++++++++++++++-- src/lisp/Config.x86_darwin | 11 +++++++++++ src/lisp/sincos.c | 43 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 2 deletions(-) create mode 100644 src/lisp/sincos.c hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-35-ge38211a
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 e38211a12ceccae3b59938fd4815ab9055d6d5b8 (commit) from 1345f3b146c9840447fa7a943daf85f111011a7f (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 e38211a12ceccae3b59938fd4815ab9055d6d5b8 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Aug 26 20:33:54 2014 -0700 Implement a simpler (and faster?) algorithm to convert a double to an int. diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp index 013f184..74f279d 100644 --- a/src/compiler/sparc/float.lisp +++ b/src/compiler/sparc/float.lisp @@ -1252,17 +1252,13 @@ (inst fdtox r x) (inst fxtod r r))) +;; See Listing 2.2: Conversion from FP to int in in "CR-LIBM: A +;; library of correctly rounded elementary functions in +;; double-precision". #+sun4 (deftransform %unary-round ((x) (float) (signed-byte 32)) - '(let* ((trunc (truly-the (signed-byte 32) (%unary-truncate x))) - (extra (- x trunc)) - (absx (abs extra)) - (one-half (float 1/2 x))) - (if (if (oddp trunc) - (>= absx one-half) - (> absx one-half)) - (truly-the (signed-byte 32) (%unary-truncate (+ x extra))) - trunc))) + '(kernel:double-float-low-bits (+ x (+ (scale-float 1d0 52) + (scale-float 1d0 51))))) (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res ----------------------------------------------------------------------- Summary of changes: src/compiler/sparc/float.lisp | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-08-37-g98d3b69
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 98d3b693b06676dbc4f9785dca6c18516253370c (commit) from a7f3ba676413d2a0cbd0505940c4a966ee25134c (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 98d3b693b06676dbc4f9785dca6c18516253370c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Aug 27 19:53:30 2014 -0700 Tests for double-double arithmetic. diff --git a/tests/dd.lisp b/tests/dd.lisp new file mode 100644 index 0000000..37c3447 --- /dev/null +++ b/tests/dd.lisp @@ -0,0 +1,13 @@ +;;; Tests for the double-double arithmetic.. + +(defpackage :dd-tests + (:use :cl :lisp-unit)) + +(in-package "DD-TESTS") + +(define-test two-prod + "Test two-prod" + ;; This should not overflow anymore. + (assert-equal (values 1.7976931281653871d308 + -4.9896007738368d291) + (c::two-prod 1.7976931214684583d308 (1+ (scale-float 1d0 -28))))) ----------------------------------------------------------------------- Summary of changes: tests/dd.lisp | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 tests/dd.lisp hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch rtoy-lisp-trig updated. snapshot-2013-12-a-13-g5b9111e
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 5b9111e975748929ddcdd9052c5b5ec8138dcca5 (commit) via 0bd9e773136b7b827f711f51500fdca4122adf73 (commit) from 1ae2d46cf3e9776ff35c6d6eddf3d73f6b0b66a1 (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 5b9111e975748929ddcdd9052c5b5ec8138dcca5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Dec 17 20:09:42 2013 -0800 Need to build e_rem_pio2.c on sparc now. diff --git a/src/lisp/Config.sparc_common b/src/lisp/Config.sparc_common index f8f7524..c4a8ed6 100644 --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -56,6 +56,6 @@ ASSEM_SRC = sparc-assem.S ARCH_SRC = sparc-arch.c DEPEND=$(CC) -OS_SRC = solaris-os.c os-common.c undefineds.c elf.c k_rem_pio2.c +OS_SRC = solaris-os.c os-common.c undefineds.c elf.c e_rem_pio2.c k_rem_pio2.c OS_LIBS= -lsocket -lnsl -ldl EXEC_FINAL_OBJ = exec-final.o commit 0bd9e773136b7b827f711f51500fdca4122adf73 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Dec 17 20:09:15 2013 -0800 Add some comments and remove unneeded package qualifiers. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 4dc7773..4ccf80a 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -242,15 +242,17 @@ (optimize (speed 3) (safety 0))) (let ((ix (ldb (byte 31 0) (kernel:double-float-high-bits x)))) (when (< ix #x3e400000) + ;; |x| < 2^-27 + ;; Signal inexact if x /= 0 (if (zerop (truncate x)) (return-from kernel-sin x) (return-from kernel-sin x))) - (let* ((s1 -1.66666666666666324348d-01) - (s2 8.33333333332248946124d-03) - (s3 -1.98412698298579493134d-04) - (s4 2.75573137070700676789d-06) - (s5 -2.50507602534068634195d-08) - (s6 1.58969099521155010221d-10) + (let* ((s1 -1.66666666666666324348d-01) ; #xBFC55555 #x55555549 + (s2 8.33333333332248946124d-03) ; #x3F811111 #x1110F8A6 + (s3 -1.98412698298579493134d-04) ; #xBF2A01A0 #x19C161D5 + (s4 2.75573137070700676789d-06) ; #x3EC71DE3 #x57B1FE7D + (s5 -2.50507602534068634195d-08) ; #xBE5AE5E6 #x8A2B9CEB + (s6 1.58969099521155010221d-10) ; #x3DE5D93A #x5ACFD57C (z (* x x)) (v (* z x)) (r (+ s2 @@ -338,13 +340,15 @@ (- (* z r) (* x y))))) (t + ;; qx = 0.28125 if |x| > 0.78125, else x/4 dropping the + ;; least significant 32 bits. (let* ((qx (if (> ix #x3fe90000) 0.28125d0 ;; x/4, exactly, and also dropping the ;; least significant 32 bits of the - ;; fraction. (Why?) - (kernel:make-double-float (- ix #x00200000) - 0))) + ;; fraction. + (make-double-float (- ix #x00200000) + 0))) (hz (- (* 0.5 z) qx)) (a (- 1 qx))) (- a (- hz (- (* z r) @@ -419,7 +423,8 @@ (when (zerop (truncate x)) (cond ((zerop (logior (logior ix (kernel:double-float-low-bits x)) (+ iy 1))) - ;; x = 0 and iy = -1 (cot) + ;; x = 0 (because hi and low bits are 0) and iy = -1 + ;; (cot) (return-from kernel-tan (/ (abs x)))) ((= iy 1) (return-from kernel-tan x)) @@ -429,10 +434,10 @@ (let ((a 0d0) (tt 0d0)) (setf w (+ x y)) - (setf z (kernel:make-double-float (kernel:double-float-high-bits w) 0)) + (setf z (make-double-float (double-float-high-bits w) 0)) (setf v (- y (- z x))) (setf a (/ -1 w)) - (setf tt (kernel:make-double-float (kernel:double-float-high-bits a) 0)) + (setf tt (make-double-float (double-float-high-bits a) 0)) (setf s (+ 1 (* tt z))) (return-from kernel-tan (+ tt (* a (+ s (* tt v)))))))))) @@ -441,10 +446,13 @@ (when (minusp hx) (setf x (- x)) (setf y (- y))) + ;; The two constants below are such that pi/4 + pi/4_lo is pi/4 + ;; to twice the accuracy of a double float. + ;; ;; z = pi/4-x - (setf z (- (kernel:make-double-float #x3FE921FB #x54442D18) x)) - ;; w = pi/4_lo - y - (setf w (- (kernel:make-double-float #x3C81A626 #x33145C07) y)) + (setf z (- (make-double-float #x3FE921FB #x54442D18) x)) + ;; w = pi/4_lo - y. + (setf w (- (make-double-float #x3C81A626 #x33145C07) y)) (setf x (+ z w)) (setf y 0d0)) (setf z (* x x)) ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 38 +++++++++++++++++++++++--------------- src/lisp/Config.sparc_common | 2 +- 2 files changed, 24 insertions(+), 16 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-10-gd9fb490
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 d9fb490192d3e187fae1b6a34b40b84e191f1e6f (commit) from cc7145cac2b298800b0650938d559c11c35caa24 (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 d9fb490192d3e187fae1b6a34b40b84e191f1e6f Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Jul 22 09:15:27 2014 -0700 Oops. Didn't comment out quite enough. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 6d17c6c..f95e32c 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -617,7 +617,6 @@ (let ((flag (- 1 (ash (logand n 1) 1)))) ;; flag = 1 if n even, -1 if n odd (kernel-tan y0 y1 flag))))))) -||# ;; Compute sin and cos of x, simultaneously. (defun %sincos (x) (declare (double-float x) @@ -643,6 +642,7 @@ (values (- (kernel-cos y0 y1)) (kernel-sin y0 y1 1)))))))) ;;(declaim (ext:end-block)) +||# ;;;; Power functions. ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp annotated tag snapshot-2013-06 created. snapshot-2013-06
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, snapshot-2013-06 has been created at 5bb85899559aa56dff922bcc67cc65cef79364e4 (tag) tagging faf5cd6df3c8fd377891082e2f3bbcbada81e1d6 (commit) replaces snapshot-2013-05 tagged by Raymond Toy on Sat Jun 1 06:34:52 2013 -0700 - Log ----------------------------------------------------------------- Snapshot 2013-06 -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.11 (Darwin) iEYEABECAAYFAlGp+HwACgkQJ5IjUmgZO7K6NQCgq70jgG6j8OQHpW3/K2kOTQdF BoMAn2YuGpubnd1qy1IDYgmKoepc4jy6 =gVMY -----END PGP SIGNATURE----- Raymond Toy (21): Wrap exports in eval-when. Wrap exports in eval-when for ppc as was done for sparc and add Wrap exports in eval-when for x86 as was done for sparc and add Forgot to commit changes to code/x86-vm.lisp to: Fix ticket:81 and fix ticket:83. Update. Don't reverse surrogate pairs in strings; it's not allowed by the Fix ticket:82: If the form numbers are too large to be encoded, don't Regenerated from current sources. Update to ASDF 3.0.1. Fix typo. Remove all the extensions to string-upcase and friends. The extended Import many unicode symbols from LISP into the UNICODE package. Update. Use BYTE-BASH-COPY in COPY-SEQ on strings. Update. Use BYTE-BASH-COPY too when CONCATENATE'ing simple-strings. Minor corrections for the usage message. Update piglatin translations using the latest pot files. Regenerated from sparc build. Regenerated after sparc build. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-08-7-gddfb037
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 ddfb0372fb591209c4aba8ea46f94e469e0686ca (commit) from 0331b89234436da149eb5b142e206ae5af2d9c7b (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 ddfb0372fb591209c4aba8ea46f94e469e0686ca Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 23 19:38:38 2013 -0700 Make CL:DISASSEMBLE conforming. Also update some of the implementation details of DISASSEM:DISASSEMBLE. code/exports.lisp:: * Update packages so CL:DISASSEMBLE is not DISASSEM:DISASSEMBLE. code/misc.lisp:: * Define CL:DISASSEMBLE. compiler/fndb.lisp:: * Update defknow for disassemble. compiler/disassem.lisp:: * Print of source codes uses standard I/O syntax instead of inheriting from the environment. * Add new keyword arguments to DISASSEM:DISASSEMBLE for the base, case, and radix. These default to 16, :downcase, and *print-radix*, respectively. This means disassembly now prints out all numbers in base 16 and is in lowercase. * When printing a note for an assembler routine, we don't need to print the (hex) address if *print-base* is 16. compiler/x86/insts.lisp:: * Fix some issues when in print-mem-access. * Sometimes the absolute value of the value was printed instead of the value (displaying the wrong value). * Print out the value as an unsigned in some cases instead of signed value. * Fix print-label to print addresses as unsigned integers. This fixes the issue where things like call #x-4xxxxxxx were printed. i18n/locale/cmucl.pot:: * Update because of new or changed docstrings. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index b2bdeab..9322c5d 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1198,9 +1198,8 @@ )) (defpackage "CONDITIONS") -(intern "DISASSEMBLE" "LISP") (defpackage "DISASSEM" - (:import-from "LISP" "DISASSEMBLE") + (:shadow "DISASSEMBLE") (:export "*NOTE-COLUMN*" "*OPCODE-COLUMN-WIDTH*" "ADD-COMMENT-HOOK" "ADD-HOOK" "ADD-NOTE-HOOK" "ARG-VALUE" "CREATE-DSTATE" "DISASSEM-STATE" "DISASSEMBLE" "DISASSEMBLE-CODE-COMPONENT" diff --git a/src/code/misc.lisp b/src/code/misc.lisp index 788a912..907ce1c 100644 --- a/src/code/misc.lisp +++ b/src/code/misc.lisp @@ -259,3 +259,10 @@ loaded, ed can be used to edit a file" (declare (ignorable x)) (values)) + +(defun disassemble (object) + "Disassemble the machine code associated with OBJECT, which can be a + function, a lambda expression, or a symbol with a function definition. If + it is not already compiled, the compiler is called to produce something to + disassemble." + (disassem:disassemble object)) diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index a236592..1316aa2 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -2964,7 +2964,7 @@ (when stream (unless at-block-begin (terpri stream)) - (let ((*print-base* 10)) + (with-standard-io-syntax (pprint-logical-block (stream nil :per-line-prefix ";;; ") (format stream "[~D] " (di:code-location-form-number loc)) @@ -3304,17 +3304,36 @@ :format-arguments (list name))))) (defun disassemble (object &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 associated with OBJECT, which can be a function, a lambda expression, or a symbol with a function definition. If it is not already compiled, the compiler is called to produce something to - disassemble." + disassemble. + + :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 function symbol cons) object) (type (or (member t) stream) stream) (type (member t nil) use-labels) - (type c::backend backend)) - (let ((fun (compiled-function-or-lose object))) + (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))) (if (typep fun 'kernel:byte-function) (c:disassem-byte-fun fun) ;; we can't detect closures, so be careful @@ -3748,8 +3767,12 @@ symbol object that we know about.") (find-assembler-routine address)))) (unless (null name) (note #'(lambda (stream) - (if NOTE-ADDRESS-P - (format stream "#x~8,'0x: ~a" address name) + (if note-address-p + ;; No need to print out the address in hex if the + ;; print-base is already 16. + (if (= *print-base* 16) + (format stream " ~A" name) + (format stream "#x~8,'0x: ~a" address name)) (princ name stream))) dstate)) name)) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 052b4c1..b8645df 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1156,9 +1156,7 @@ (:xref t)) (values (or pathname null) boolean boolean)) -(defknown disassemble ((or callable cons) - &key (:stream stream) (:backend backend) - (:use-labels t)) +(defknown disassemble ((or callable cons)) (values)) (defknown documentation (t symbol) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 048b9ec..c0f1034 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -433,11 +433,7 @@ (write-char #\* stream) (princ scale stream)) (when (and disp (not (zerop disp))) - (when (and (or base index)) - (write-char (if (minusp disp) #\- #\+) stream)) - (let ((unsigned-offset (if (minusp disp) - (+ #x100000000 disp) - disp))) + (let ((unsigned-offset (ldb (byte vm:word-bits 0) disp))) (or (nth-value 1 (disassem::note-code-constant-absolute unsigned-offset dstate)) @@ -448,8 +444,12 @@ (when (typep offs 'disassem::offset) (or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs dstate) - (disassem::maybe-note-static-function offs dstate)))))) - (princ (abs disp) stream))) + (disassem::maybe-note-static-function offs dstate))))) + (cond ((or base index) + (write-char (if (minusp disp) #\- #\+) stream) + (princ (abs disp) stream)) + (t + (princ unsigned-offset stream)))))) (write-char #\] stream)) (defun print-imm-data (value stream dstate) @@ -457,9 +457,7 @@ (princ value stream) (when (typep offset 'disassem::offset) (or (disassem::maybe-note-nil-indexed-object offset dstate) - (let ((unsigned-offset (if (and (numberp value) (minusp value)) - (+ value #x100000000) - value))) + (let ((unsigned-offset (ldb (byte vm:word-bits 0) value))) (disassem::maybe-note-assembler-routine unsigned-offset stream dstate)) (nth-value 1 (disassem::note-code-constant-absolute offset @@ -493,7 +491,10 @@ (defun print-label (value stream dstate) (declare (ignore dstate)) - (disassem:princ16 value stream)) + (princ (if (and (numberp value) (minusp value)) + (ldb (byte vm:word-bits 0) value) + value) + stream)) ;;; Returns either an integer, meaning a register, or a list of ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index ff7b7cf..397fa4e 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -5607,6 +5607,16 @@ msgid "" " loaded, ed can be used to edit a file" msgstr "" +#: src/code/misc.lisp +msgid "" +"Disassemble the machine code associated with OBJECT, which can be a\n" +" function, a lambda expression, or a symbol with a function definition. " +"If\n" +" it is not already compiled, the compiler is called to produce something " +"to\n" +" disassemble." +msgstr "" + #: src/code/extensions.lisp msgid "" "This function can be used as the default value for keyword arguments that\n" @@ -17133,7 +17143,18 @@ msgid "" "If\n" " it is not already compiled, the compiler is called to produce something " "to\n" -" disassemble." +" disassemble.\n" +"\n" +" :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 ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 3 +-- src/code/misc.lisp | 7 +++++++ src/compiler/disassem.lisp | 39 +++++++++++++++++++++++++++++++-------- src/compiler/fndb.lisp | 4 +--- src/compiler/x86/insts.lisp | 23 ++++++++++++----------- src/i18n/locale/cmucl.pot | 23 ++++++++++++++++++++++- 6 files changed, 74 insertions(+), 25 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0