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

[Git][cmucl/cmucl][master] Better description for run-program :env
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f613124b by Raymond Toy at 2016-01-16T08:24:09Z Better description for run-program :env Fix #18. - - - - - 1 changed file: - src/code/run-program.lisp Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -471,8 +471,9 @@ The keyword arguments have the following meanings: :env - - An A-LIST mapping keyword environment variables to simple-string - values. + An A-LIST mapping keyword environment variables to + simple-string values. This is the shell environment for + Program. Defaults to *environment-list*. :wait - If non-NIL (default), wait until the created process finishes. If NIL, continue running Lisp until the program finishes. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f613124b7479c364d557e5f70…

1 0

[Git][cmucl/cmucl][master] Better docstring for *environment-list*
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 6ac8b5f6 by Raymond Toy at 2016-01-16T08:18:00Z Better docstring for *environment-list* Fix #17. - - - - - 1 changed file: - src/code/save.lisp Changes: ===================================== src/code/save.lisp ===================================== --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -36,7 +36,8 @@ might not be.") (defvar *environment-list* nil - "An alist mapping environment variables (as keywords) to either values") + "An alist mapping each environment variable (as a keyword) to its + value.") (defvar *environment-list-initialized* nil "Non-NIL if environment-init has been called") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/6ac8b5f6ee9fd9553d6ed2885…

1 0

[Git][cmucl/cmucl][master] 6 commits: Handle FP exceptions better.
by Raymond Toy 16 Jan '16

16 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e63bc1e9 by Raymond Toy at 2016-01-09T19:00:37Z Handle FP exceptions better. Don't restore the fpu state from the context in the interrupt handler code (interrupt_handle_now) because that just makes the fpu state the same as the sigcontext that received the exception. I think this was done to reset the x87 fpu precision to 53-bit so that lisp can continue with default double-float rounding. This isn't needed anymore since lisp doesn't use x87 anymore. In SIGFPE-HANDLER, don't modify the current fp state based on the state from the sigcontext. These two items cause the arithmetic-error exception printer to trigger inexact when printing out the args. We add a few debugging prints for now so we can see what the FP state is in the handler. Remove them later. - - - - - da2ff74d by Raymond Toy at 2016-01-10T14:13:10Z Handle FPU exceptions better. In sigfpe-handler, don't modify the modes; just use whatever they are. (They should be the default values.) In with-float-traps-*, actually just restore the floating-point mode to the exact original mode instead of trying to mask things out. - - - - - d9763e90 by Raymond Toy at 2016-01-10T15:42:41Z In WITH-FLOAT-TRAPS-*, remove the unused junk modifying the state. We just want to return the original modes, so remove all the old commented out stuff that was modifying the original modes to some strange state. This makes a lot more sense to me if WITH-FLOAT-TRAPS-* actually restored the modes exactly as they were before running the body. - - - - - d7850f57 by Raymond Toy at 2016-01-12T21:21:40Z Restore the FPU state before exiting. Put an unwind-protect around the error calls. The cleanup form restores the floating-point modes from the sigcontext so that the mode is restored. This is needed, I think, because we throw so that the signal handler doesn't return so the sigcontext isn't restored. If we don't restore the fpu state, it's set to the default processor state. We want the default state when calling error. In this way, things like (* 1d300 1d300) signals an overflow, and when we throw to top-level, the floating-point modes are restored to their original values they had before. - - - - - 1fab9bf3 by Raymond Toy at 2016-01-13T21:34:39Z Clean up sigfpe-handler; add comments. - - - - - 94bb2d9d by Raymond Toy at 2016-01-16T16:02:25Z Merge branch 'rtoy-15-handle-fpu-exceptions' into 'master' Handle FPU exceptions better Fix #15 Handle FPU exceptions better in sigfpe-handler. Linux now passes all of the tests, including the inexact tests. We can correctly print out the operands (if available) when we receive an inexact exception. The floating point modes are preserved as much as possible when we throw from an arithmetic-error. See merge request !7 - - - - - 2 changed files: - src/code/float-trap.lisp - src/lisp/interrupt.c Changes: ===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -319,102 +319,118 @@ (alien:sap-alien scp (* unix:sigcontext)))) (traps (logand (ldb float-exceptions-byte modes) (ldb float-traps-byte modes)))) - #+(and darwin ppc) - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) - ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; Clear out all exceptions and save them to the context. - ;; - ;; XXX: Should we just clear out the bits for the traps that are - ;; enabled? If we did that then the accrued exceptions would be - ;; correct. - (setf (ldb float-sticky-bits new-modes) 0) - ;; Clear out the various sticky invalid operation bits too. - ;; - ;; XXX: Should we only do that if the invalid trap is enabled? - (setf (ldb float-invalid-op-1-byte new-modes) 0) - (setf (ldb float-invalid-op-2-byte new-modes) 0) - ;; Clear the FP exception summary bit too. - (setf (ldb float-exceptions-summary-byte new-modes) 0) - ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) - (setf (floating-point-modes) new-modes) - (setf (sigcontext-floating-point-modes - (alien:sap-alien scp (* unix:sigcontext))) - new-modes)) - - #+sse2 - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; Clear out the status for any enabled traps. With SSE2, if - ;; the current exception is enabled, the next FP instruction - ;; will cause the exception to be signaled again. Hence, we - ;; need to clear out the exceptions that we are handling here. - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; XXX: This seems not right. Shouldn't we be setting the modes - ;; in the sigcontext instead? This however seems to do what we - ;; want. - (setf (vm:floating-point-modes) new-modes)) + (multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) (funcall sym (alien:sap-alien scp (* unix:sigcontext)) modes) (values nil nil))) - (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps))) - (error 'division-by-zero - :operation fop - :operands operands)) - ((not (zerop (logand float-invalid-trap-bit traps))) - (error 'floating-point-invalid-operation - :operation fop - :operands operands)) - ((not (zerop (logand float-overflow-trap-bit traps))) - (error 'floating-point-overflow - :operation fop - :operands operands)) - ((not (zerop (logand float-underflow-trap-bit traps))) - (error 'floating-point-underflow - :operation fop - :operands operands)) - ((not (zerop (logand float-inexact-trap-bit traps))) - (error 'floating-point-inexact - :operation fop - :operands operands)) - #+x86 - ((not (zerop (logand float-denormal-trap-bit traps))) - (error 'floating-point-denormal-operand - :operation fop - :operands operands)) - (t - ;; It looks like the sigcontext on Solaris/x86 doesn't - ;; actually save the status word of the FPU. The - ;; operands also seem to be missing. Signal a general - ;; arithmetic error. - #+(and x86 solaris) - (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" - code) - ;; For all other x86 ports, we should only get here if - ;; the SIGFPE was caused by an integer overflow on - ;; division. For sparc and ppc, I (rtoy) don't think - ;; there's any other way to get here since integer - ;; overflows aren't signaled. - ;; - ;; In that case, FOP should be /, so we can generate a - ;; nice arithmetic-error. It's possible to use CODE, - ;; which is supposed to indicate what caused the - ;; exception, but each OS is different, so we don't; FOP - ;; can tell us. - #-(and x86 solaris) - (if fop - (error 'arithmetic-error - :operation fop - :operands operands) - (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" - code))))))) + ;; Don't let throws get away without resetting the + ;; floating-point modes back to the original values which we get + ;; from the sigcontext. Because we can throw, we never return + ;; from the signal handler so the sigcontext is never restored. + ;; This means we need to restore the fpu state ourselves. + (unwind-protect + (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps))) + (error 'division-by-zero + :operation fop + :operands operands)) + ((not (zerop (logand float-invalid-trap-bit traps))) + (error 'floating-point-invalid-operation + :operation fop + :operands operands)) + ((not (zerop (logand float-overflow-trap-bit traps))) + (error 'floating-point-overflow + :operation fop + :operands operands)) + ((not (zerop (logand float-underflow-trap-bit traps))) + (error 'floating-point-underflow + :operation fop + :operands operands)) + ((not (zerop (logand float-inexact-trap-bit traps))) + (error 'floating-point-inexact + :operation fop + :operands operands)) + #+x86 + ((not (zerop (logand float-denormal-trap-bit traps))) + (error 'floating-point-denormal-operand + :operation fop + :operands operands)) + (t + ;; It looks like the sigcontext on Solaris/x86 doesn't + ;; actually save the status word of the FPU. The + ;; operands also seem to be missing. Signal a general + ;; arithmetic error. + #+(and x86 solaris) + (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" + code) + ;; For all other x86 ports, we should only get here if + ;; the SIGFPE was caused by an integer overflow on + ;; division. For sparc and ppc, I (rtoy) don't think + ;; there's any other way to get here since integer + ;; overflows aren't signaled. + ;; + ;; In that case, FOP should be /, so we can generate a + ;; nice arithmetic-error. It's possible to use CODE, + ;; which is supposed to indicate what caused the + ;; exception, but each OS is different, so we don't; FOP + ;; can tell us. + #-(and x86 solaris) + (if fop + (error 'arithmetic-error + :operation fop + :operands operands) + (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" + code)))) + ;; Cleanup + (let* ((new-modes modes) + (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) + traps))) + #+(and darwin ppc) + (progn + ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) + ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + ;; Clear out all exceptions. + ;; + ;; XXX: Should we just clear out the bits for the traps that are + ;; enabled? If we did that then the accrued exceptions would be + ;; correct. + (setf (ldb float-sticky-bits new-modes) 0) + ;; Clear out the various sticky invalid operation bits too. + ;; + ;; XXX: Should we only do that if the invalid trap is enabled? + (setf (ldb float-invalid-op-1-byte new-modes) 0) + (setf (ldb float-invalid-op-2-byte new-modes) 0) + ;; Clear the FP exception summary bit too. + (setf (ldb float-exceptions-summary-byte new-modes) 0) + ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) + (setf (floating-point-modes) new-modes)) + + #+sse2 + (progn + ;; Clear out the status for any enabled traps. With SSE2, if + ;; the current exception is enabled, the next FP instruction + ;; will cause the exception to be signaled again. Hence, we + ;; need to clear out the exceptions that we are handling here. + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + #+nil + (progn + (format *debug-io* "sigcontext modes: #x~4x (~A)~%" + modes (decode-floating-point-modes modes)) + (format *debug-io* "current modes: #x~4x (~A)~%" + (vm:floating-point-modes) (get-floating-point-modes)) + (format *debug-io* "new modes: #x~x (~A)~%" + new-modes (decode-floating-point-modes new-modes))) + (setf (vm:floating-point-modes) new-modes)) + + #-(or sse2 (and darwin ppc)) + (progn + ;; Apparently nothing needed for sparc it seems The FPU + ;; state in the signal handler is unchanged and it seems we + ;; don't need to reset it any way when we throw out. + )))))) (macrolet ((with-float-traps (name merge-traps docstring) @@ -440,6 +456,10 @@ ;; representing the invalid operation. Otherwise, if we ;; enable the invalid trap later, these sticky bits will cause ;; an exception. + ;; + ;; FIXME: Consider removing these for ppc. Since + ;; we now restore the original modes exactly, I + ;; don't think these are needed anymore. #+ppc (invalid-mask (if (member :invalid traps) (dpb 0 @@ -456,14 +476,8 @@ (logand (,',merge-traps ,orig-modes ,trap-mask) ,exception-mask))) ,@body) - ;; Restore the original traps and exceptions. - (setf (floating-point-modes) - (logior (logand ,orig-modes ,(logior traps exceptions)) - (logand (floating-point-modes) - ,(logand trap-mask exception-mask) - #+ppc - ,invalid-mask - #+mips ,(dpb 0 float-exceptions-byte #xffffffff)))))))))))) + ;; Restore the modes exactly as they were. + (setf (floating-point-modes) ,orig-modes))))))))) ;; WITH-FLOAT-TRAPS-MASKED -- Public (with-float-traps masked logand ===================================== src/lisp/interrupt.c ===================================== --- a/src/lisp/interrupt.c +++ b/src/lisp/interrupt.c @@ -252,7 +252,9 @@ interrupt_handle_now(HANDLER_ARGS) handler = interrupt_handlers[signal]; +#if 0 RESTORE_FPU(context); +#endif if (handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN) return; @@ -333,7 +335,9 @@ maybe_now_maybe_later(HANDLER_ARGS) setup_pending_signal(signal, code, context); arch_set_pseudo_atomic_interrupted(context); } else { +#if 0 RESTORE_FPU(context); +#endif interrupt_handle_now(signal, code, context); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/5c10ab93105fa6e095bbcbb0…

1 0

[Git][cmucl/cmucl][rtoy-15-handle-fpu-exceptions] Clean up sigfpe-handler; add comments.
by Raymond Toy 14 Jan '16

14 Jan '16

Raymond Toy pushed to branch rtoy-15-handle-fpu-exceptions at cmucl / cmucl Commits: 1fab9bf3 by Raymond Toy at 2016-01-13T21:34:39Z Clean up sigfpe-handler; add comments. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -312,7 +312,6 @@ ;;; ;;; Signal the appropriate condition when we get a floating-point error. ;;; -(defvar *debug-sigfpe-handler* nil) (defun sigfpe-handler (signal code scp) (declare (ignore signal) (type system-area-pointer scp)) @@ -385,54 +384,53 @@ (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" code)))) ;; Cleanup - #+(and darwin ppc) (let* ((new-modes modes) (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) traps))) - ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) - ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; Clear out all exceptions and save them to the context. - ;; - ;; XXX: Should we just clear out the bits for the traps that are - ;; enabled? If we did that then the accrued exceptions would be - ;; correct. - (setf (ldb float-sticky-bits new-modes) 0) - ;; Clear out the various sticky invalid operation bits too. - ;; - ;; XXX: Should we only do that if the invalid trap is enabled? - (setf (ldb float-invalid-op-1-byte new-modes) 0) - (setf (ldb float-invalid-op-2-byte new-modes) 0) - ;; Clear the FP exception summary bit too. - (setf (ldb float-exceptions-summary-byte new-modes) 0) - ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) - (setf (floating-point-modes) new-modes) - #+nil - (setf (sigcontext-floating-point-modes - (alien:sap-alien scp (* unix:sigcontext))) - new-modes)) - - #+sse2 - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; Clear out the status for any enabled traps. With SSE2, if - ;; the current exception is enabled, the next FP instruction - ;; will cause the exception to be signaled again. Hence, we - ;; need to clear out the exceptions that we are handling here. - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; XXX: This seems not right. Shouldn't we be setting the modes - ;; in the sigcontext instead? This however seems to do what we - ;; want. - - (when *debug-sigfpe-handler* - (format *debug-io* "sigcontext modes: #x~4x (~A)~%" - modes (decode-floating-point-modes modes)) - (format *debug-io* "current modes: #x~4x (~A)~%" - (vm:floating-point-modes) (get-floating-point-modes)) - (format *debug-io* "new modes: #x~x (~A)~%" - new-modes (decode-floating-point-modes new-modes))) - (setf (vm:floating-point-modes) new-modes)))))) + #+(and darwin ppc) + (progn + ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) + ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + ;; Clear out all exceptions. + ;; + ;; XXX: Should we just clear out the bits for the traps that are + ;; enabled? If we did that then the accrued exceptions would be + ;; correct. + (setf (ldb float-sticky-bits new-modes) 0) + ;; Clear out the various sticky invalid operation bits too. + ;; + ;; XXX: Should we only do that if the invalid trap is enabled? + (setf (ldb float-invalid-op-1-byte new-modes) 0) + (setf (ldb float-invalid-op-2-byte new-modes) 0) + ;; Clear the FP exception summary bit too. + (setf (ldb float-exceptions-summary-byte new-modes) 0) + ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) + (setf (floating-point-modes) new-modes)) + + #+sse2 + (progn + ;; Clear out the status for any enabled traps. With SSE2, if + ;; the current exception is enabled, the next FP instruction + ;; will cause the exception to be signaled again. Hence, we + ;; need to clear out the exceptions that we are handling here. + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + #+nil + (progn + (format *debug-io* "sigcontext modes: #x~4x (~A)~%" + modes (decode-floating-point-modes modes)) + (format *debug-io* "current modes: #x~4x (~A)~%" + (vm:floating-point-modes) (get-floating-point-modes)) + (format *debug-io* "new modes: #x~x (~A)~%" + new-modes (decode-floating-point-modes new-modes))) + (setf (vm:floating-point-modes) new-modes)) + + #-(or sse2 (and darwin ppc)) + (progn + ;; Apparently nothing needed for sparc it seems The FPU + ;; state in the signal handler is unchanged and it seems we + ;; don't need to reset it any way when we throw out. + )))))) (macrolet ((with-float-traps (name merge-traps docstring) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1fab9bf37ce138dba85e5fb85…

1 0

[Git][cmucl/cmucl][rtoy-15-handle-fpu-exceptions] Restore the FPU state before exiting.
by Raymond Toy 13 Jan '16

13 Jan '16

Raymond Toy pushed to branch rtoy-15-handle-fpu-exceptions at cmucl / cmucl Commits: d7850f57 by Raymond Toy at 2016-01-12T21:21:40Z Restore the FPU state before exiting. Put an unwind-protect around the error calls. The cleanup form restores the floating-point modes from the sigcontext so that the mode is restored. This is needed, I think, because we throw so that the signal handler doesn't return so the sigcontext isn't restored. If we don't restore the fpu state, it's set to the default processor state. We want the default state when calling error. In this way, things like (* 1d300 1d300) signals an overflow, and when we throw to top-level, the floating-point modes are restored to their original values they had before. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -312,7 +312,6 @@ ;;; ;;; Signal the appropriate condition when we get a floating-point error. ;;; -#+nil (defvar *debug-sigfpe-handler* nil) (defun sigfpe-handler (signal code scp) (declare (ignore signal) @@ -321,111 +320,119 @@ (alien:sap-alien scp (* unix:sigcontext)))) (traps (logand (ldb float-exceptions-byte modes) (ldb float-traps-byte modes)))) - #+(and darwin ppc) - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) - ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; Clear out all exceptions and save them to the context. - ;; - ;; XXX: Should we just clear out the bits for the traps that are - ;; enabled? If we did that then the accrued exceptions would be - ;; correct. - (setf (ldb float-sticky-bits new-modes) 0) - ;; Clear out the various sticky invalid operation bits too. - ;; - ;; XXX: Should we only do that if the invalid trap is enabled? - (setf (ldb float-invalid-op-1-byte new-modes) 0) - (setf (ldb float-invalid-op-2-byte new-modes) 0) - ;; Clear the FP exception summary bit too. - (setf (ldb float-exceptions-summary-byte new-modes) 0) - ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) - (setf (floating-point-modes) new-modes) - (setf (sigcontext-floating-point-modes - (alien:sap-alien scp (* unix:sigcontext))) - new-modes)) - - #+nil - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; Clear out the status for any enabled traps. With SSE2, if - ;; the current exception is enabled, the next FP instruction - ;; will cause the exception to be signaled again. Hence, we - ;; need to clear out the exceptions that we are handling here. - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; XXX: This seems not right. Shouldn't we be setting the modes - ;; in the sigcontext instead? This however seems to do what we - ;; want. - - (when *debug-sigfpe-handler* - (format *debug-io* "sigcontext modes: #x~4x (~A)~%" - modes (decode-floating-point-modes modes)) - (format *debug-io* "current modes: #x~4x (~A)~%" - (vm:floating-point-modes) (get-floating-point-modes)) - (format *debug-io* "new modes: #x~x (~A)~%" - new-modes (decode-floating-point-modes new-modes))) - #+nil - (setf (vm:floating-point-modes) new-modes)) + (multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) (funcall sym (alien:sap-alien scp (* unix:sigcontext)) modes) (values nil nil))) - (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps))) - (error 'division-by-zero - :operation fop - :operands operands)) - ((not (zerop (logand float-invalid-trap-bit traps))) - (error 'floating-point-invalid-operation - :operation fop - :operands operands)) - ((not (zerop (logand float-overflow-trap-bit traps))) - (error 'floating-point-overflow - :operation fop - :operands operands)) - ((not (zerop (logand float-underflow-trap-bit traps))) - (error 'floating-point-underflow - :operation fop - :operands operands)) - ((not (zerop (logand float-inexact-trap-bit traps))) - (error 'floating-point-inexact - :operation fop - :operands operands)) - #+x86 - ((not (zerop (logand float-denormal-trap-bit traps))) - (error 'floating-point-denormal-operand - :operation fop - :operands operands)) - (t - ;; It looks like the sigcontext on Solaris/x86 doesn't - ;; actually save the status word of the FPU. The - ;; operands also seem to be missing. Signal a general - ;; arithmetic error. - #+(and x86 solaris) - (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" - code) - ;; For all other x86 ports, we should only get here if - ;; the SIGFPE was caused by an integer overflow on - ;; division. For sparc and ppc, I (rtoy) don't think - ;; there's any other way to get here since integer - ;; overflows aren't signaled. - ;; - ;; In that case, FOP should be /, so we can generate a - ;; nice arithmetic-error. It's possible to use CODE, - ;; which is supposed to indicate what caused the - ;; exception, but each OS is different, so we don't; FOP - ;; can tell us. - #-(and x86 solaris) - (if fop - (error 'arithmetic-error - :operation fop - :operands operands) - (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" - code))))))) + ;; Don't let throws get away without resetting the + ;; floating-point modes back to the original values which we get + ;; from the sigcontext. Because we can throw, we never return + ;; from the signal handler so the sigcontext is never restored. + ;; This means we need to restore the fpu state ourselves. + (unwind-protect + (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps))) + (error 'division-by-zero + :operation fop + :operands operands)) + ((not (zerop (logand float-invalid-trap-bit traps))) + (error 'floating-point-invalid-operation + :operation fop + :operands operands)) + ((not (zerop (logand float-overflow-trap-bit traps))) + (error 'floating-point-overflow + :operation fop + :operands operands)) + ((not (zerop (logand float-underflow-trap-bit traps))) + (error 'floating-point-underflow + :operation fop + :operands operands)) + ((not (zerop (logand float-inexact-trap-bit traps))) + (error 'floating-point-inexact + :operation fop + :operands operands)) + #+x86 + ((not (zerop (logand float-denormal-trap-bit traps))) + (error 'floating-point-denormal-operand + :operation fop + :operands operands)) + (t + ;; It looks like the sigcontext on Solaris/x86 doesn't + ;; actually save the status word of the FPU. The + ;; operands also seem to be missing. Signal a general + ;; arithmetic error. + #+(and x86 solaris) + (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" + code) + ;; For all other x86 ports, we should only get here if + ;; the SIGFPE was caused by an integer overflow on + ;; division. For sparc and ppc, I (rtoy) don't think + ;; there's any other way to get here since integer + ;; overflows aren't signaled. + ;; + ;; In that case, FOP should be /, so we can generate a + ;; nice arithmetic-error. It's possible to use CODE, + ;; which is supposed to indicate what caused the + ;; exception, but each OS is different, so we don't; FOP + ;; can tell us. + #-(and x86 solaris) + (if fop + (error 'arithmetic-error + :operation fop + :operands operands) + (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" + code)))) + ;; Cleanup + #+(and darwin ppc) + (let* ((new-modes modes) + (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) + traps))) + ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) + ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + ;; Clear out all exceptions and save them to the context. + ;; + ;; XXX: Should we just clear out the bits for the traps that are + ;; enabled? If we did that then the accrued exceptions would be + ;; correct. + (setf (ldb float-sticky-bits new-modes) 0) + ;; Clear out the various sticky invalid operation bits too. + ;; + ;; XXX: Should we only do that if the invalid trap is enabled? + (setf (ldb float-invalid-op-1-byte new-modes) 0) + (setf (ldb float-invalid-op-2-byte new-modes) 0) + ;; Clear the FP exception summary bit too. + (setf (ldb float-exceptions-summary-byte new-modes) 0) + ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) + (setf (floating-point-modes) new-modes) + #+nil + (setf (sigcontext-floating-point-modes + (alien:sap-alien scp (* unix:sigcontext))) + new-modes)) + + #+sse2 + (let* ((new-modes modes) + (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) + traps))) + ;; Clear out the status for any enabled traps. With SSE2, if + ;; the current exception is enabled, the next FP instruction + ;; will cause the exception to be signaled again. Hence, we + ;; need to clear out the exceptions that we are handling here. + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + ;; XXX: This seems not right. Shouldn't we be setting the modes + ;; in the sigcontext instead? This however seems to do what we + ;; want. + + (when *debug-sigfpe-handler* + (format *debug-io* "sigcontext modes: #x~4x (~A)~%" + modes (decode-floating-point-modes modes)) + (format *debug-io* "current modes: #x~4x (~A)~%" + (vm:floating-point-modes) (get-floating-point-modes)) + (format *debug-io* "new modes: #x~x (~A)~%" + new-modes (decode-floating-point-modes new-modes))) + (setf (vm:floating-point-modes) new-modes)))))) (macrolet ((with-float-traps (name merge-traps docstring) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d7850f57887c6762fcb6c79a5…

1 0

[Git][cmucl/cmucl][rtoy-15-handle-fpu-exceptions] In WITH-FLOAT-TRAPS-*, remove the unused junk modifying the state.
by Raymond Toy 10 Jan '16

10 Jan '16

Raymond Toy pushed to branch rtoy-15-handle-fpu-exceptions at cmucl / cmucl Commits: d9763e90 by Raymond Toy at 2016-01-10T15:42:41Z In WITH-FLOAT-TRAPS-*, remove the unused junk modifying the state. We just want to return the original modes, so remove all the old commented out stuff that was modifying the original modes to some strange state. This makes a lot more sense to me if WITH-FLOAT-TRAPS-* actually restored the modes exactly as they were before running the body. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -451,6 +451,10 @@ ;; representing the invalid operation. Otherwise, if we ;; enable the invalid trap later, these sticky bits will cause ;; an exception. + ;; + ;; FIXME: Consider removing these for ppc. Since + ;; we now restore the original modes exactly, I + ;; don't think these are needed anymore. #+ppc (invalid-mask (if (member :invalid traps) (dpb 0 @@ -467,21 +471,8 @@ (logand (,',merge-traps ,orig-modes ,trap-mask) ,exception-mask))) ,@body) - ;; Restore the original traps and exceptions. - (format *debug-io* "Saved fpu mode: #x~4,'0x: ~S~%" - ,orig-modes (decode-floating-point-modes ,orig-modes)) - (format *debug-io* "Current fpu mode: #x~4,'0x: ~S~%" - (floating-point-modes) (get-floating-point-modes)) - #+nil - (setf (floating-point-modes) - (logior (logand ,orig-modes ,(logior traps exceptions)) - (logand ,orig-modes - ,(logand trap-mask exception-mask) - #+ppc - ,invalid-mask - #+mips ,(dpb 0 float-exceptions-byte #xffffffff)))) - (setf (floating-point-modes) ,orig-modes) - )))))))) + ;; Restore the modes exactly as they were. + (setf (floating-point-modes) ,orig-modes))))))))) ;; WITH-FLOAT-TRAPS-MASKED -- Public (with-float-traps masked logand View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d9763e9075310cfbbae3f43f0…

1 0

[Git][cmucl/cmucl][rtoy-15-handle-fpu-exceptions] Handle FPU exceptions better.
by Raymond Toy 10 Jan '16

10 Jan '16

Raymond Toy pushed to branch rtoy-15-handle-fpu-exceptions at cmucl / cmucl Commits: da2ff74d by Raymond Toy at 2016-01-10T14:13:10Z Handle FPU exceptions better. In sigfpe-handler, don't modify the modes; just use whatever they are. (They should be the default values.) In with-float-traps-*, actually just restore the floating-point mode to the exact original mode instead of trying to mask things out. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -312,6 +312,8 @@ ;;; ;;; Signal the appropriate condition when we get a floating-point error. ;;; +#+nil +(defvar *debug-sigfpe-handler* nil) (defun sigfpe-handler (signal code scp) (declare (ignore signal) (type system-area-pointer scp)) @@ -345,7 +347,7 @@ (alien:sap-alien scp (* unix:sigcontext))) new-modes)) - #+sse2 + #+nil (let* ((new-modes modes) (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) traps))) @@ -358,12 +360,13 @@ ;; in the sigcontext instead? This however seems to do what we ;; want. - (format *debug-io* "sigcontext modes: #x~4x (~A)~%" - modes (decode-floating-point-modes modes)) - (format *debug-io* "current modes: #x~4x (~A)~%" - (vm:floating-point-modes) (get-floating-point-modes)) - (format *debug-io* "new modes: #x~x (~A)~%" - new-modes (decode-floating-point-modes new-modes)) + (when *debug-sigfpe-handler* + (format *debug-io* "sigcontext modes: #x~4x (~A)~%" + modes (decode-floating-point-modes modes)) + (format *debug-io* "current modes: #x~4x (~A)~%" + (vm:floating-point-modes) (get-floating-point-modes)) + (format *debug-io* "new modes: #x~x (~A)~%" + new-modes (decode-floating-point-modes new-modes))) #+nil (setf (vm:floating-point-modes) new-modes)) @@ -465,13 +468,20 @@ ,exception-mask))) ,@body) ;; Restore the original traps and exceptions. + (format *debug-io* "Saved fpu mode: #x~4,'0x: ~S~%" + ,orig-modes (decode-floating-point-modes ,orig-modes)) + (format *debug-io* "Current fpu mode: #x~4,'0x: ~S~%" + (floating-point-modes) (get-floating-point-modes)) + #+nil (setf (floating-point-modes) (logior (logand ,orig-modes ,(logior traps exceptions)) - (logand (floating-point-modes) + (logand ,orig-modes ,(logand trap-mask exception-mask) #+ppc ,invalid-mask - #+mips ,(dpb 0 float-exceptions-byte #xffffffff)))))))))))) + #+mips ,(dpb 0 float-exceptions-byte #xffffffff)))) + (setf (floating-point-modes) ,orig-modes) + )))))))) ;; WITH-FLOAT-TRAPS-MASKED -- Public (with-float-traps masked logand View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/da2ff74d54707ab52b4b61675…

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-15-handle-fpu-exceptions
by Raymond Toy 10 Jan '16

10 Jan '16

Raymond Toy pushed new branch rtoy-15-handle-fpu-exceptions at cmucl / cmucl

1 0

[Git][cmucl/cmucl][master] Add list of features to README.
by Raymond Toy 09 Jan '16

09 Jan '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 5c10ab93 by Raymond Toy at 2016-01-09T10:50:21Z Add list of features to README. (Taken from the wiki intro.) - - - - - 1 changed file: - README.md Changes: ===================================== README.md ===================================== --- a/README.md +++ b/README.md @@ -8,3 +8,45 @@ debugger and code profiler; and an Emacs-like editor implemented in Common Lisp. CMUCL is maintained by a team of volunteers collaborating over the Internet, and is mostly in the public domain. +Here is a summary of its main features: + +* support for **static arrays** that are never moved by GC but are + properly removed when no longer referenced. +* **Unicode** support, including many of the most common external + formats such as UTF-8 and support for handling Unix, DOS, and + Mac end-of-line schemes. +* native **double-double floats** including complex double-double + floats and specialized arrays for double-double floats and and + complex double-double floats that give approximately 106 bits + (32 digits) of precision. +* a **sophisticated native-code compiler** which is capable of + powerful type inferences, and generates code competitive in + speed with C compilers. +* **generational garbage collection** on all supported + architectures. +* **multiprocessing capability** on the x86 ports. +* a foreign function interface which allows interfacing with C code + and system libraries, including shared libraries on most platforms, + and direct access to Unix system calls. +* support for interprocess communication and remote procedure calls. +* an implementation of CLOS, the [Common Lisp Object + System](http://en.wikipedia.org/wiki/Common_Lisp_Object_System), + which includes multimethods and a metaobject protocol. +* a graphical source-level debugger using a Motif interface, and a + code profiler. +* an interface to the X11 Window System (CLX), and a sophisticated + graphical widget library ([Garnet](https://www.cs.cmu.edu/~garnet/), + available separately). +* programmer-extensible input and output streams ([Gray + Streams](http://www.nhplace.com/kent/CL/Issues/stream-definition-by-user.ht… + and + [simple-streams](http://www.franz.com/support/documentation/current/doc/stre…) +* an Emacs-like editor, + [Hemlock](http://cmucl.org/hemlock/index.html), implemented in + Common Lisp. +* **freely redistributable**: free, with full source code (most of + which is in the public domain) and no strings attached (and no + warranty). Like the GNU/Linux and *BSD operating systems, CMUCL is + maintained and improved by a team of volunteers collaborating over + the Internet. + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5c10ab93105fa6e095bbcbb05…

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2016-01
by Raymond Toy 09 Jan '16

09 Jan '16

Raymond Toy pushed new tag snapshot-2016-01 at cmucl / cmucl

1 0