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

[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

[git] CMU Common Lisp branch master updated. snapshot-2014-08-33-gdf548f6
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 df548f6e69bc4fa0aec3825d10074135c9e4ac03 (commit) from 54dd52c6348b74051dd63be6abdd1952be7137af (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 df548f6e69bc4fa0aec3825d10074135c9e4ac03 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Aug 26 19:07:54 2014 -0700 Oops. Fix mistake in handling underflow for %exp. * src/lisp/e_exp.c: * Signal underflow instead of returning the arg. * tests/trig.lisp: * Add tests for %exp when exp underflows. diff --git a/src/lisp/e_exp.c b/src/lisp/e_exp.c index 034c590..93b638e 100644 --- a/src/lisp/e_exp.c +++ b/src/lisp/e_exp.c @@ -142,7 +142,10 @@ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ return fdlibm_setexception(x, FDLIBM_OVERFLOW); } - if(x < u_threshold) return x; /* underflow */ + if(x < u_threshold) { + /* underflow */ + return fdlibm_setexception(0.0, FDLIBM_UNDERFLOW); + } } /* argument reduction */ diff --git a/tests/trig.lisp b/tests/trig.lisp index 724fabe..cfd7ea2 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -945,9 +945,18 @@ (kernel:%exp *snan*)) (assert-equal ext:double-float-positive-infinity (kernel:%exp ext:double-float-positive-infinity)) + (assert-equal 0d0 + (kernel:%exp -1000d0)) (kernel::with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity - (kernel:%exp 710d0)))) + (kernel:%exp 710d0))) + (let ((modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:underflow)) + (assert-error 'floating-point-underflow + (kernel:%exp -1000d0))) + (apply #'ext:set-floating-point-modes modes)))) (define-test %log.exception (:tag :fdlibm) ----------------------------------------------------------------------- Summary of changes: src/lisp/e_exp.c | 5 ++++- tests/trig.lisp | 11 ++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-47-g7618374
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 76183742d841486c85cfa1a26f811373c40208f2 (commit) via 1620d4c19d12e0c96f72aadb4bfda13ea8297529 (commit) from f11c37a6547e87f5438a6f66969c7f531e061054 (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 76183742d841486c85cfa1a26f811373c40208f2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Aug 1 22:52:41 2014 -0700 Compile the new fdlibm routines. diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin index d9d1bfd..4edf0eb 100644 --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -74,7 +74,7 @@ OS_LIBS = -lSystem -lc -lm e_rem_pio2.o : e_rem_pio2.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< -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 e_pow.c k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -93,3 +93,12 @@ 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) $< + +e_pow.o : e_pow.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + commit 1620d4c19d12e0c96f72aadb4bfda13ea8297529 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 01:52:01 2014 -0400 Compile the new fdlibm routines. diff --git a/src/lisp/Config.sparc_sunc b/src/lisp/Config.sparc_sunc index ffe4598..1578b56 100644 --- a/src/lisp/Config.sparc_sunc +++ b/src/lisp/Config.sparc_sunc @@ -29,7 +29,7 @@ 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 +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 k_sin.o : k_sin.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< @@ -47,3 +47,12 @@ 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) $< + +e_pow.o : e_pow.c + $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $< + ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.ppc_darwin | 11 ++++++++++- src/lisp/Config.sparc_sunc | 11 ++++++++++- 2 files changed, 20 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-11-3-g8674b2d
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 8674b2d2b73bf7d7402d323f8179d1312b0843f6 (commit) from 20ee8ef20cd01a0be841695d6beaf98968e5be31 (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 8674b2d2b73bf7d7402d323f8179d1312b0843f6 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun Nov 10 10:39:01 2013 -0800 Print out the value of the non-zero word. diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index 9caae2d..f06b23b 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -1194,8 +1194,8 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) for (p = (int *) alloc_region->start_addr; p < (int *) alloc_region->end_addr; p++) if (*p != 0) - fprintf(stderr, "** new region not zero @ %lx\n", - (unsigned long) p); + fprintf(stderr, "** new region not zero @ %lx: %lx\n", + (unsigned long) p, *p); } /* Setup the pages. */ ----------------------------------------------------------------------- Summary of changes: src/lisp/gencgc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-08-6-g0331b89
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 0331b89234436da149eb5b142e206ae5af2d9c7b (commit) from 864c24bdd0abbf86dd35529c79657c9ed3db62ac (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 0331b89234436da149eb5b142e206ae5af2d9c7b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Aug 21 20:16:01 2013 -0700 Allow disasembler to work for any value of *print-base*. With these changes, you can bind *print-base* to 16 and *print-case* to :downcase to get correctly printed disassembly in lower case with all numerical values in hex. If you want the radix marker as well, bind *print-radix* to T; the disassembly is still correct. src/compiler/disassem.lisp: o When printing out the source code, bind *print-base* to 10 so that the code is printed "naturally". src/compiler/x86/insts.lisp: o Use Carl's much cleaned-up print-mem-access o Update print-imm-data to use princ for all values, removing the special casing for NIL o When printing out xmm registers, honor *print-case*. src/general-info/release-20e.txt: o Update diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 13f6b35..a236592 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -2964,10 +2964,11 @@ (when stream (unless at-block-begin (terpri stream)) - (pprint-logical-block (stream nil :per-line-prefix ";;; ") - (format stream "[~D] " - (di:code-location-form-number loc)) - (prin1-short form stream)) + (let ((*print-base* 10)) + (pprint-logical-block (stream nil :per-line-prefix ";;; ") + (format stream "[~D] " + (di:code-location-form-number loc)) + (prin1-short form stream))) (terpri stream) (terpri stream))) t))))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 2417c04..048b9ec 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -422,52 +422,39 @@ (princ (disassem:dstate-get-prop dstate 'width) stream) (princ '| PTR | stream)) (write-char #\[ stream) - (let ((firstp t)) - (macrolet ((pel ((var val) &body body) - ;; Print an element of the address, maybe with - ;; a leading separator. - `(let ((,var ,val)) - (when ,var - (unless firstp - (write-char #\+ stream)) - ,@body - (setq firstp nil))))) - (pel (base-reg (first value)) - (print-addr-reg base-reg stream dstate)) - (pel (index-reg (third value)) - (print-addr-reg index-reg stream dstate) - (let ((index-scale (fourth value))) - (when (and index-scale (not (= index-scale 1))) - (write-char #\* stream) - (princ index-scale stream)))) - (let ((offset (second value))) - (when (and offset (or firstp (not (zerop offset)))) - (unless (or firstp (minusp offset)) - (write-char #\+ stream)) - (if firstp - (let ((unsigned-offset (if (minusp offset) - (+ #x100000000 offset) - offset))) - (disassem:princ16 unsigned-offset stream) - (or (nth-value 1 - (disassem::note-code-constant-absolute unsigned-offset - dstate)) - (disassem:maybe-note-assembler-routine unsigned-offset - stream - dstate) - (let ((offs (- offset disassem::nil-addr))) - (when (typep offs 'disassem::offset) - (or (disassem::maybe-note-nil-indexed-symbol-slot-ref offs - dstate) - (disassem::maybe-note-static-function offs dstate)))))) - (princ offset stream)))))) + (destructuring-bind (&optional base disp index scale) value + (when base + (print-addr-reg base stream dstate) + (when index + (write-char #\+ stream))) + (when index + (print-addr-reg index stream dstate)) + (when (and scale (> scale 1)) + (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))) + (or (nth-value 1 + (disassem::note-code-constant-absolute unsigned-offset + dstate)) + (disassem:maybe-note-assembler-routine unsigned-offset + stream + dstate) + (let ((offs (- disp disassem::nil-addr))) + (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))) (write-char #\] stream)) (defun print-imm-data (value stream dstate) (let ((offset (- value disassem::nil-addr))) - (if (zerop offset) - (format stream "#x~X" value) - (format stream "~A" value)) + (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)) @@ -603,7 +590,7 @@ (declare (type xmmreg value) (type stream stream) (ignore dstate)) - (format stream "XMM~d" value)) + (format stream "~A~D" 'xmm value)) (defun print-xmmreg/mem (value stream dstate) (declare (type (or list xmmreg) value) diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt index 6c4fd1a..9d91bcc 100644 --- a/src/general-info/release-20e.txt +++ b/src/general-info/release-20e.txt @@ -21,6 +21,8 @@ New in this release: * Known issues: * Feature enhancements + * The disassembler (on x86) prints correctly for any value of + *print-base*. * Changes * ASDF2 updated to version 3.0.2. ----------------------------------------------------------------------- Summary of changes: src/compiler/disassem.lisp | 9 ++--- src/compiler/x86/insts.lisp | 73 ++++++++++++++++---------------------- src/general-info/release-20e.txt | 2 ++ 3 files changed, 37 insertions(+), 47 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-09-3-g9b83625d
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 9b83625d4fc0809170354f5397afb7dab2103d42 (commit) from 2ec1fda2a83f17fe9ee580ef14b887b5c66f844a (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 9b83625d4fc0809170354f5397afb7dab2103d42 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Sep 4 21:15:58 2014 -0700 Wrap all exports in eval-when since export is now an ordinary function without any compiler magic. Untested. diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 79e396f..4916ebf 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -40,6 +40,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits word-shift word-bytes float-sign-shift single-float-bias single-float-exponent-byte @@ -55,6 +56,7 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit)) +; ; eval-when @@ -128,11 +130,13 @@ ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) ;;; Where to put the different spaces. ;;; @@ -157,10 +161,12 @@ ;;;; Other random constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap single-step-breakpoint trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -trap :start 8) halt @@ -181,7 +187,9 @@ ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; These symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 90259c2..2ad4692 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -39,6 +39,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits word-shift word-bytes float-sign-shift single-float-bias single-float-exponent-byte @@ -54,7 +55,7 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit)) - +) ; eval-when (eval-when (compile load eval) @@ -119,11 +120,13 @@ ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) ;;; Where to put the different spaces. @@ -143,11 +146,13 @@ ;;;; Other random constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap single-step-breakpoint-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -trap :start 8) halt @@ -168,7 +173,9 @@ ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; These symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 7cf4b8a..740258d 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -50,6 +50,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits word-shift word-bytes float-sign-shift single-float-bias single-float-exponent-byte @@ -65,7 +66,7 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit)) - +) ; eval-when (eval-when (compile load eval) @@ -129,11 +130,13 @@ ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) ;;; Where to put the different spaces. ;;; @@ -147,7 +150,8 @@ ;;; large object space instead. Must be less then a page. ;;; #+gengc -(export 'large-object-cutoff) +(eval-when (:compile-toplevel :load-toplevel :execute) + (export 'large-object-cutoff)) #+gengc (defparameter large-object-cutoff 1024) @@ -155,10 +159,12 @@ ;;;; Other non-type constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(atomic-flag interrupted-flag halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap after-breakpoint-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -flag) atomic @@ -183,7 +189,9 @@ ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; Static symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant ----------------------------------------------------------------------- Summary of changes: src/compiler/alpha/parms.lisp | 8 ++++++++ src/compiler/hppa/parms.lisp | 9 ++++++++- src/compiler/mips/parms.lisp | 12 ++++++++++-- 3 files changed, 26 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2014-06-73-gfdc6db4
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 fdc6db4b7af14ce1ceb6e38e92135335a4921fa3 (commit) via 797b00817a9ecfb6e13badf1aa2b88ff87acc2ac (commit) via d2e935a5b3a1a3922be0c52059fa99a332178483 (commit) from efbeb89b14488c258f8f95e4f443460e428a2046 (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 fdc6db4b7af14ce1ceb6e38e92135335a4921fa3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:46:50 2014 -0700 Use fdlibm_atan instead of atan. * fdlibm.h: * Declare fdlibm_atan * e_atan2.c: * Use fdlibm_atan instead of atan. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c index f4c1c12..7e177e8 100644 --- a/src/lisp/e_atan2.c +++ b/src/lisp/e_atan2.c @@ -75,7 +75,7 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ if(((ix|((lx|-lx)>>31))>0x7ff00000)|| ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ return x+y; - if((hx-0x3ff00000|lx)==0) return atan(y); /* x=1.0 */ + if((hx-0x3ff00000|lx)==0) return fdlibm_atan(y); /* x=1.0 */ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ @@ -115,7 +115,7 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ k = (iy-ix)>>20; if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */ else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */ - else z=atan(fabs(y/x)); /* safe to do y/x */ + else z=fdlibm_atan(fabs(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: diff --git a/src/lisp/fdlibm.h b/src/lisp/fdlibm.h index 72f57f8..9d25664 100644 --- a/src/lisp/fdlibm.h +++ b/src/lisp/fdlibm.h @@ -53,6 +53,7 @@ extern double fdlibm_cos(double x); extern double fdlibm_tan(double x); extern double fdlibm_expm1(double x); extern double fdlibm_log1p(double x); +extern double fdlibm_atan(double x); extern double __ieee754_exp(double x); extern double __ieee754_log(double x); commit 797b00817a9ecfb6e13badf1aa2b88ff87acc2ac Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:43:49 2014 -0700 Fix up atan2 by using unions. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c index 4e731ba..f4c1c12 100644 --- a/src/lisp/e_atan2.c +++ b/src/lisp/e_atan2.c @@ -63,11 +63,15 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ double z; int k,m,hx,hy,ix,iy; unsigned lx,ly; + union { int i[2]; double d; } ux; + union { int i[2]; double d; } uy; - hx = __HI(x); ix = hx&0x7fffffff; - lx = __LO(x); - hy = __HI(y); iy = hy&0x7fffffff; - ly = __LO(y); + ux.d = x; + hx = ux.i[HIWORD]; ix = hx&0x7fffffff; + lx = ux.i[LOWORD]; + uy.d = y; + hy = uy.i[HIWORD]; iy = hy&0x7fffffff; + ly = uy.i[LOWORD]; if(((ix|((lx|-lx)>>31))>0x7ff00000)|| ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ return x+y; @@ -114,7 +118,10 @@ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ else z=atan(fabs(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ - case 1: __HI(z) ^= 0x80000000; + case 1: + ux.d = z; + ux.i[HIWORD] ^= 0x80000000; + z = ux.d; return z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ commit d2e935a5b3a1a3922be0c52059fa99a332178483 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Aug 2 15:40:31 2014 -0700 Import atan2 function from fdlibm, as is. diff --git a/src/lisp/e_atan2.c b/src/lisp/e_atan2.c new file mode 100644 index 0000000..4e731ba --- /dev/null +++ b/src/lisp/e_atan2.c @@ -0,0 +1,123 @@ + +/* @(#)e_atan2.c 1.3 95/01/18 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + * + */ + +/* __ieee754_atan2(y,x) + * Method : + * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x). + * 2. Reduce x to positive by (if x and y are unexceptional): + * ARG (x+iy) = arctan(y/x) ... if x > 0, + * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0, + * + * Special cases: + * + * ATAN2((anything), NaN ) is NaN; + * ATAN2(NAN , (anything) ) is NaN; + * ATAN2(+-0, +(anything but NaN)) is +-0 ; + * ATAN2(+-0, -(anything but NaN)) is +-pi ; + * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2; + * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ; + * ATAN2(+-(anything but INF and NaN), -INF) is +-pi; + * ATAN2(+-INF,+INF ) is +-pi/4 ; + * ATAN2(+-INF,-INF ) is +-3pi/4; + * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2; + * + * 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 +tiny = 1.0e-300, +zero = 0.0, +pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */ +pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */ +pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */ +pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ + +#ifdef __STDC__ + double __ieee754_atan2(double y, double x) +#else + double __ieee754_atan2(y,x) + double y,x; +#endif +{ + double z; + int k,m,hx,hy,ix,iy; + unsigned lx,ly; + + hx = __HI(x); ix = hx&0x7fffffff; + lx = __LO(x); + hy = __HI(y); iy = hy&0x7fffffff; + ly = __LO(y); + if(((ix|((lx|-lx)>>31))>0x7ff00000)|| + ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ + return x+y; + if((hx-0x3ff00000|lx)==0) return atan(y); /* x=1.0 */ + m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ + + /* when y = 0 */ + if((iy|ly)==0) { + switch(m) { + case 0: + case 1: return y; /* atan(+-0,+anything)=+-0 */ + case 2: return pi+tiny;/* atan(+0,-anything) = pi */ + case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ + } + } + /* when x = 0 */ + if((ix|lx)==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; + + /* when x is INF */ + if(ix==0x7ff00000) { + if(iy==0x7ff00000) { + switch(m) { + case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */ + case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */ + case 2: return 3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/ + case 3: return -3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/ + } + } else { + switch(m) { + case 0: return zero ; /* atan(+...,+INF) */ + case 1: return -zero ; /* atan(-...,+INF) */ + case 2: return pi+tiny ; /* atan(+...,-INF) */ + case 3: return -pi-tiny ; /* atan(-...,-INF) */ + } + } + } + /* when y is INF */ + if(iy==0x7ff00000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; + + /* compute y/x */ + k = (iy-ix)>>20; + if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */ + else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */ + else z=atan(fabs(y/x)); /* safe to do y/x */ + switch (m) { + case 0: return z ; /* atan(+,+) */ + case 1: __HI(z) ^= 0x80000000; + return z ; /* atan(-,+) */ + case 2: return pi-(z-pi_lo);/* atan(+,-) */ + default: /* case 3 */ + return (z-pi_lo)-pi;/* atan(-,-) */ + } +} ----------------------------------------------------------------------- Summary of changes: src/lisp/e_atan2.c | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/lisp/fdlibm.h | 1 + 2 files changed, 131 insertions(+) create mode 100644 src/lisp/e_atan2.c hooks/post-receive -- CMU Common Lisp

1 0