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

[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

[git] CMU Common Lisp branch master updated. snapshot-2014-03-2-gf15327b
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 f15327ba2aba87dea3c67204ca0f1100c1a605d9 (commit) from 508b6594cf003d6a9d400d59d4ec32255728d0e9 (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 f15327ba2aba87dea3c67204ca0f1100c1a605d9 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Mar 8 13:29:52 2014 -0800 Add double-double-float-positive-infinity and double-double-float-negative-infinity. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index a5f5ca6..ca0a60b 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1425,7 +1425,9 @@ "LEAST-POSITIVE-DOUBLE-DOUBLE-FLOAT" "LEAST-NEGATIVE-DOUBLE-DOUBLE-FLOAT" "MOST-POSITIVE-DOUBLE-DOUBLE-FLOAT" - "MOST-NEGATIVE-DOUBLE-DOUBLE-FLOAT") + "MOST-NEGATIVE-DOUBLE-DOUBLE-FLOAT" + "DOUBLE-DOUBLE-FLOAT-NEGATIVE-INFINITY" + "DOUBLE-DOUBLE-FLOAT-POSITIVE-INFINITY") ;; Spice lisp extensions (:export "LETF*" "LETF" "DOVECTOR" "DELETEF" "INDENTING-FURTHER" "FILE-COMMENT" diff --git a/src/code/float.lisp b/src/code/float.lisp index 01b7002..de80bc4 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -65,7 +65,8 @@ least-positive-double-double-float least-negative-double-double-float most-positive-double-double-float - most-negative-double-double-float)) + most-negative-double-double-float + double-double-float-negative-infinity)) (in-package "KERNEL") @@ -159,6 +160,15 @@ ;; What is the right value? (kernel:make-double-double-float most-negative-double-float 0d0)) +(defconstant double-double-float-positive-infinity + ;; What is the right value? + (kernel:make-double-double-float double-float-positive-infinity + 0d0)) +(defconstant double-double-float-negative-infinity + ;; What is the right value? + (kernel:make-double-double-float double-float-negative-infinity + 0d0)) + ); double-double (defconstant least-positive-normalized-single-float ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 4 +++- src/code/float.lisp | 12 +++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-05-16-g8f5653c
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 8f5653cb8d14200905a7ef653bcaccd490e25404 (commit) from b1d65255d021886369e544caa1864aac6eec64cc (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 8f5653cb8d14200905a7ef653bcaccd490e25404 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sun May 26 10:51:34 2013 -0700 Update. diff --git a/src/i18n/locale/cmucl-sparc-vm.pot b/src/i18n/locale/cmucl-sparc-vm.pot index e8a69ef..271439e 100644 --- a/src/i18n/locale/cmucl-sparc-vm.pot +++ b/src/i18n/locale/cmucl-sparc-vm.pot @@ -782,12 +782,6 @@ msgstr "" msgid "Method ~S not defined for ~S" msgstr "" -#: src/compiler/sparc/c-callback.lisp -msgid "" -"Cons up a piece of code which calls call-callback with INDEX and a\n" -"pointer to the arguments." -msgstr "" - #: src/compiler/sparc/call.lisp msgid "more-arg-context" msgstr "" diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 4b2964a..ff7b7cf 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -3867,25 +3867,11 @@ msgstr "" #: src/code/string.lisp msgid "" "Given a string, returns a new string that is a copy of it with all\n" -" lower case alphabetic characters converted to uppercase. Casing is\n" -" :simple or :full for simple or full case conversion, respectively." -msgstr "" - -#: src/code/string.lisp -msgid "" -"Given a string, returns a new string that is a copy of it with all\n" " upper case alphabetic characters converted to lowercase." msgstr "" #: src/code/string.lisp msgid "" -"Given a string, returns a new string that is a copy of it with all\n" -" upper case alphabetic characters converted to lowercase. Casing is\n" -" :simple or :full for simple or full case conversion, respectively." -msgstr "" - -#: src/code/string.lisp -msgid "" "Given a string, returns a copy of the string with the first\n" " character of each ``word'' converted to upper-case, and remaining\n" " chars in the word converted to lower case. A ``word'' is defined\n" @@ -3895,18 +3881,6 @@ msgstr "" #: src/code/string.lisp msgid "" -"Given a string, returns a copy of the string with the first\n" -" character of each ``word'' converted to upper-case, and remaining\n" -" chars in the word converted to lower case. Casing is :simple or\n" -" :full for simple or full case conversion, respectively. If\n" -" Unicode-Word-Break is non-Nil, then the Unicode word-breaking\n" -" algorithm is used to determine the word boundaries. Otherwise, A\n" -" ``word'' is defined to be a string of case-modifiable characters\n" -" delimited by non-case-modifiable chars. " -msgstr "" - -#: src/code/string.lisp -msgid "" "Given a string, returns that string with all lower case alphabetic\n" " characters converted to uppercase." msgstr "" @@ -14995,6 +14969,71 @@ msgstr "" msgid "~&Dumping ~D messages for domain ~S~%" msgstr "" +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with\n" +" all lower case alphabetic characters converted to uppercase using\n" +" full case conversion." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with\n" +" all lower case alphabetic characters converted to uppercase. Casing\n" +" is :simple or :full for simple or full case conversion,\n" +" respectively." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with\n" +" all uppercase alphabetic characters converted to lowercase using\n" +" full case conversion.." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a new string that is a copy of it with all\n" +" uppercase alphabetic characters converted to lowercase. Casing is\n" +" :simple or :full for simple or full case conversion, respectively." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, S, and a starting index, return the index of the\n" +" next character that is not part of the word containing the character\n" +" at the index, or the length of S if the word containing the\n" +" character extends to the end of S. If the index is negative or\n" +" valid index into S, the returned value will be strictly greater than\n" +" the index." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Capitalize String using the Unicode word-break algorithm to find\n" +" the words in String. The beginning is capitalized depending on the\n" +" value of Casing" +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Capitalize String using the Common Lisp word-break algorithm to find\n" +" the words in String. The beginning is capitalized depending on the\n" +" value of Casing" +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"Given a string, returns a copy of the string with the first\n" +" character of each ``word'' converted to upper-case, and remaining\n" +" chars in the word converted to lower case. Casing is :simple, :full\n" +" or :title for simple, full or title case conversion, respectively. If\n" +" Unicode-Word-Break is non-Nil, then the Unicode word-breaking\n" +" algorithm is used to determine the word boundaries. Otherwise, A\n" +" ``word'' is defined to be a string of case-modifiable characters\n" +" delimited by non-case-modifiable chars. " +msgstr "" + #: src/compiler/macros.lisp msgid "" "Policy Node Condition*\n" ----------------------------------------------------------------------- Summary of changes: src/i18n/locale/cmucl-sparc-vm.pot | 6 --- src/i18n/locale/cmucl.pot | 91 +++++++++++++++++++++++++----------- 2 files changed, 65 insertions(+), 32 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-04-8-g99250b4
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 99250b40fa0b1f424a9a1f458060a16d698c71d8 (commit) from b76e59723e21a2c494948dcc4be940e5d7e802ec (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 99250b40fa0b1f424a9a1f458060a16d698c71d8 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu May 2 20:09:04 2013 -0700 Fix some issues with zero check in gc_free_heap. In gc_free_heap, the check that unallocated pages are zero can only be done if gencgc_unmap_zero is MODE_MAP or MODE_MEMSET. The other modes are known not to zero memory. Also, don't limit the check to the first 16K pages, and also check the entire page of GC_PAGE_SIZE bytes, not just the first 1024 words. diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c index fb4a741..9bdc16a 100644 --- a/src/lisp/gencgc.c +++ b/src/lisp/gencgc.c @@ -361,13 +361,21 @@ boolean gencgc_zero_check_during_free_heap = FALSE; #endif /* - * For now, enable the gencgc_zero_check if gencgc_unmap_zero is lazy - * or madvise. XXX: Remove this additional condition when we feel - * that gencgc_unmap_zero is good enough. + * For now, enable the zero check if gencgc_zero_check is true or if + * gencgc_unmap_zero is MODE_LAZY or MODE_MADVISE. XXX: Remove this + * additional condition when we feel that gencgc_unmap_zero is good + * enough. */ #define DO_GENCGC_ZERO_CHECK (gencgc_zero_check || (gencgc_unmap_zero == MODE_LAZY) || (gencgc_unmap_zero == MODE_MADVISE)) -#define DO_GENCGC_ZERO_CHECK_DURING_FREE_HEAP (gencgc_zero_check_during_free_heap || (gencgc_unmap_zero == MODE_LAZY) || (gencgc_unmap_zero == MODE_MADVISE)) + +/* + * Only to the zero check during free_heap if both + * gencgc_zero_check_during_free_heap is true and gencgc_unmap_zero is + * MODE_MAP or MODE_MEMSET because in all other modes, unallocated + * pages are known not to contain zeroes. + */ +#define DO_GENCGC_ZERO_CHECK_DURING_FREE_HEAP (gencgc_zero_check_during_free_heap && ((gencgc_unmap_zero == MODE_MAP) || (gencgc_unmap_zero == MODE_MEMSET))) /* * The minimum size for a large object. @@ -7942,7 +7950,7 @@ gc_free_heap(void) if (gencgc_verbose > 1) fprintf(stderr, "Free heap\n"); - for (page = 0; page < dynamic_space_pages; page++) + for (page = 0; page < dynamic_space_pages; page++) { /* Skip Free pages which should already be zero filled. */ if (PAGE_ALLOCATED(page)) { char *page_start, *addr; @@ -7963,27 +7971,46 @@ gc_free_heap(void) os_protect((os_vm_address_t) page_start, GC_PAGE_SIZE, OS_VM_PROT_ALL); page_table[page].flags &= ~PAGE_WRITE_PROTECTED_MASK; - os_invalidate((os_vm_address_t) page_start, GC_PAGE_SIZE); - addr = - (char *) os_validate((os_vm_address_t) page_start, GC_PAGE_SIZE); - if (addr == NULL || addr != page_start) - fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n", - (unsigned long) page_start, (unsigned long) addr); - } else if (DO_GENCGC_ZERO_CHECK_DURING_FREE_HEAP && page < 16384) { + switch (gencgc_unmap_zero) { + case MODE_MAP: + os_invalidate((os_vm_address_t) page_start, GC_PAGE_SIZE); + addr = + (char *) os_validate((os_vm_address_t) page_start, GC_PAGE_SIZE); + if (addr == NULL || addr != page_start) + fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n", + (unsigned long) page_start, (unsigned long) addr); + break; + case MODE_MEMSET: + case MODE_MADVISE: + case MODE_LAZY: + /* + * XXX: Do we really need to zero the page here? + */ + + memset(page_start, 0, GC_PAGE_SIZE); + break; + } + } else if (DO_GENCGC_ZERO_CHECK_DURING_FREE_HEAP) { int *page_start; unsigned i; - /* Double check that the page is zero filled. */ + /* + * Double check that the page is zero filled. + */ gc_assert(!PAGE_ALLOCATED(page)); gc_assert(page_table[page].bytes_used == 0); - page_start = (int *) page_address(page); + page_start = (int *) page_address(page); - for (i = 0; i < 1024; i++) - if (page_start[i] != 0) - fprintf(stderr, "** Free region not zero @ %lx\n", - (unsigned long) (page_start + i)); + for (i = 0; i < GC_PAGE_SIZE/sizeof(*page_start); i++) { + if (page_start[i] != 0) { + fprintf(stderr, "** Free region not zero @ page %d, %lx\n", + page, + (unsigned long) (page_start + i)); + } + } } + } bytes_allocated = 0; ----------------------------------------------------------------------- Summary of changes: src/lisp/gencgc.c | 63 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 18 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[git] CMU Common Lisp branch master updated. snapshot-2013-05-2-ge5a2fa1
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 e5a2fa14f92ca98db53d5241378c5850434998aa (commit) from ba06f21ff5d6192b78746bd634eacb69fee17739 (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 e5a2fa14f92ca98db53d5241378c5850434998aa Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue May 14 20:20:44 2013 -0700 Wrap exports in eval-when for ppc as was done for sparc and add CHAR-BYTES to ppc cross-compile script. This is untested. diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp index bba9f78..fa6a643 100644 --- a/src/code/ppc-vm.lisp +++ b/src/code/ppc-vm.lisp @@ -19,12 +19,13 @@ (intl:textdomain "cmucl-ppc-vm") +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(fixup-code-object internal-error-arguments sigcontext-program-counter sigcontext-register sigcontext-float-register sigcontext-floating-point-modes extern-alien-name sanctify-for-execution sigcontext-lr)) - +) ;;;; The sigcontext structure. ;;;; Note that the layout of this thing matches the word offsets PT_xxx, not diff --git a/src/compiler/ppc/c-callback.lisp b/src/compiler/ppc/c-callback.lisp index 928de09..29d6731 100644 --- a/src/compiler/ppc/c-callback.lisp +++ b/src/compiler/ppc/c-callback.lisp @@ -19,8 +19,10 @@ (in-package "PPC") +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(make-callback-trampoline callback-accessor-form compatible-function-types-p)) +) (defun callback-accessor-form (type sp offset) (let ((parsed-type (alien::parse-alien-type type))) diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index a885626..deac614 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -49,6 +49,7 @@ ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits char-bits word-shift word-bytes char-bytes float-sign-shift @@ -66,6 +67,7 @@ float-imprecise-trap-bit float-invalid-trap-bit float-divide-by-zero-trap-bit float-invalid-op-1-byte)) +) #+double-double (export '(double-double-float-digits)) @@ -166,11 +168,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. @@ -188,12 +192,14 @@ ;;;; 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 after-breakpoint-trap object-not-list-trap object-not-instance-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) +) (defenum (:suffix -trap :start 8) @@ -217,8 +223,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/tools/cross-scripts/cross-x86-ppc-darwin.lisp b/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp index 0d492de..417d4e0 100644 --- a/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp +++ b/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp @@ -158,8 +158,10 @@ (find-symbol ,(symbol-name sym) :vm)))) syms)))) - (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS + (frob OLD-VM:BYTE-BITS + OLD-VM:WORD-BITS OLD-VM:CHAR-BITS + OLD-VM:CHAR-BYTES OLD-VM:LOWTAG-BITS #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE ----------------------------------------------------------------------- Summary of changes: src/code/ppc-vm.lisp | 3 ++- src/compiler/ppc/c-callback.lisp | 2 ++ src/compiler/ppc/parms.lisp | 9 ++++++++- src/tools/cross-scripts/cross-x86-ppc-darwin.lisp | 4 +++- 4 files changed, 15 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0