PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("DEFER-FLOAT-EXCEPTIONS", Prim_defer_float_exceptions, 0, 0, 0)
+DEFINE_PRIMITIVE ("DEFER-FLOAT-EXCEPTION-TRAPS", Prim_defer_float_exception_traps, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
#ifdef HAVE_FEHOLDEXCEPT
}
/* It is not safe to run Scheme with the inexact result exception
- unmasked, but the exception can sometimes be useful to test.
- Consequently, we go to some trouble to make sure that it is masked,
- and signal an error if anyone ever tries to unmask it. */
+ trapped, but the exception can sometimes be useful to test.
+ Consequently, we go to some trouble to make sure that it is not
+ trapped, and signal an error if anyone ever tries to trap it. */
-static const int always_masked_exceptions = 0
+static const int non_trappable_exceptions = 0
#ifdef FE_INEXACT
| FE_INEXACT
#endif
;
static int
-arg_maskable_float_exceptions (int n)
+arg_untrappable_float_exceptions (int n)
{
- return (always_masked_exceptions | (arg_float_exceptions (n)));
+ return (non_trappable_exceptions | (arg_float_exceptions (n)));
}
static int
-arg_unmaskable_float_exceptions (int n)
+arg_trappable_float_exceptions (int n)
{
int exceptions = (arg_float_exceptions (n));
- if (exceptions & always_masked_exceptions)
+ if (exceptions & non_trappable_exceptions)
error_bad_range_arg (n);
return (exceptions);
}
static int
-arg_float_exception_mask (int n)
+arg_float_exceptions_to_trap (int n)
{
int exceptions = (arg_float_exceptions (n));
- if (! (exceptions & always_masked_exceptions))
+ if (exceptions & non_trappable_exceptions)
error_bad_range_arg (n);
return (exceptions);
}
DEFINE_PRIMITIVE ("FLOAT-EXCEPTIONS", Prim_float_exceptions, 0, 0, 0)
FLOAT_EXCEPTIONS_PRIMITIVE (FE_ALL_EXCEPT)
-DEFINE_PRIMITIVE ("UNMASKABLE-FLOAT-EXCEPTIONS", Prim_unmaskable_float_exceptions, 0, 0, 0)
- FLOAT_EXCEPTIONS_PRIMITIVE (FE_ALL_EXCEPT &~ always_masked_exceptions)
+DEFINE_PRIMITIVE ("TRAPPABLE-FLOAT-EXCEPTIONS", Prim_trappable_float_exceptions, 0, 0, 0)
+ FLOAT_EXCEPTIONS_PRIMITIVE (FE_ALL_EXCEPT &~ non_trappable_exceptions)
DEFINE_PRIMITIVE ("TEST-FLOAT-EXCEPTIONS", Prim_test_float_exceptions, 1, 1, 0)
{
PRIMITIVE_RETURN (UNSPECIFIC);
}
\f
-DEFINE_PRIMITIVE ("MASKED-FLOAT-EXCEPTIONS", Prim_masked_float_exceptions, 0, 0, 0)
+DEFINE_PRIMITIVE ("TRAPPED-FLOAT-EXCEPTIONS", Prim_trapped_float_exceptions, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
#ifdef HAVE_FEGETEXCEPT
{
int exceptions = (fegetexcept ());
if (exceptions < 0) error_external_return ();
- FLOAT_EXCEPTIONS_RESULT (FE_ALL_EXCEPT &~ exceptions);
+ FLOAT_EXCEPTIONS_RESULT (exceptions);
}
#else
error_unimplemented_primitive ();
#endif
}
-DEFINE_PRIMITIVE ("SET-MASKED-FLOAT-EXCEPTIONS", Prim_set_masked_float_exceptions, 1, 1, 0)
+DEFINE_PRIMITIVE ("SET-TRAPPED-FLOAT-EXCEPTIONS", Prim_set_trapped_float_exceptions, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
#if ((defined (HAVE_FEENABLEEXCEPT)) && (defined (HAVE_FEDISABLEEXCEPT)))
{
- int masked_exceptions = (arg_float_exception_mask (1));
- int previous_exceptions = (fedisableexcept (masked_exceptions));
+ int exceptions = (arg_float_exceptions_to_trap (1));
+ int previous_exceptions = (feenableexcept (exceptions));
if ((0 > previous_exceptions)
- || (0 > (feenableexcept (FE_ALL_EXCEPT &~ masked_exceptions))))
+ || (0 > (fedisableexcept (FE_ALL_EXCEPT &~ exceptions))))
error_external_return ();
cache_float_environment ();
- FLOAT_EXCEPTIONS_RESULT (FE_ALL_EXCEPT &~ previous_exceptions);
+ FLOAT_EXCEPTIONS_RESULT (previous_exceptions);
}
#else
error_unimplemented_primitive ();
#endif
}
-DEFINE_PRIMITIVE ("MASK-FLOAT-EXCEPTIONS", Prim_mask_float_exceptions, 1, 1, 0)
+DEFINE_PRIMITIVE ("UNTRAP-FLOAT-EXCEPTIONS", Prim_untrap_float_exceptions, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
#ifdef HAVE_FEDISABLEEXCEPT
{
- int exceptions = (arg_maskable_float_exceptions (1));
+ int exceptions = (arg_untrappable_float_exceptions (1));
int previous_exceptions = (fedisableexcept (exceptions));
if (previous_exceptions < 0) error_external_return ();
cache_float_environment ();
- FLOAT_EXCEPTIONS_RESULT (FE_ALL_EXCEPT &~ previous_exceptions);
+ FLOAT_EXCEPTIONS_RESULT (previous_exceptions);
}
#else
error_unimplemented_primitive ();
#endif
}
-DEFINE_PRIMITIVE ("UNMASK-FLOAT-EXCEPTIONS", Prim_unmask_float_exceptions, 1, 1, 0)
+DEFINE_PRIMITIVE ("TRAP-FLOAT-EXCEPTIONS", Prim_trap_float_exceptions, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
#ifdef HAVE_FEENABLEEXCEPT
{
- int exceptions = (arg_unmaskable_float_exceptions (1));
+ int exceptions = (arg_trappable_float_exceptions (1));
int previous_exceptions = (feenableexcept (exceptions));
if (previous_exceptions < 0) error_external_return ();
cache_float_environment ();
- FLOAT_EXCEPTIONS_RESULT (FE_ALL_EXCEPT &~ previous_exceptions);
+ FLOAT_EXCEPTIONS_RESULT (previous_exceptions);
}
#else
error_unimplemented_primitive ();
(define-primitives
(flo:environment float-environment 0)
(flo:set-environment! set-float-environment 1)
- (flo:defer-exceptions! defer-float-exceptions 0)
+ (flo:defer-exception-traps! defer-float-exception-traps 0)
(flo:update-environment! update-float-environment 1))
-(define (flo:deferring-exceptions procedure)
+(define (flo:deferring-exception-traps procedure)
(flo:preserving-environment
(lambda ()
- (let ((environment (flo:defer-exceptions!)))
+ (let ((environment (flo:defer-exception-traps!)))
(let ((result (procedure)))
(flo:update-environment! environment)
result)))))
-(define (flo:ignoring-exceptions procedure)
+(define (flo:ignoring-exception-traps procedure)
(flo:preserving-environment
(lambda ()
- (flo:defer-exceptions!)
+ (flo:defer-exception-traps!)
(procedure))))
(define (flo:preserving-environment procedure)
(let ((environment (flo:environment)))
(flo:set-rounding-mode! (flo:default-rounding-mode))
(flo:clear-exceptions! (flo:supported-exceptions))
- (flo:set-masked-exceptions! (flo:default-exception-mask))
+ (flo:set-trapped-exceptions! (flo:default-trapped-exceptions))
(let ((environment* (flo:environment)))
(flo:set-environment! environment)
environment*)))
(flo:save-exception-flags save-float-exception-flags 1)
(flo:test-exception-flags test-float-exception-flags 2)
(flo:restore-exception-flags! restore-float-exception-flags 2)
- (flo:masked-exceptions masked-float-exceptions 0)
- (flo:set-masked-exceptions! set-masked-float-exceptions 1)
- (flo:mask-exceptions! mask-float-exceptions 1)
- (flo:unmask-exceptions! unmask-float-exceptions 1)
- (flo:unmaskable-exceptions unmaskable-float-exceptions 0))
-
-(define (flo:default-exception-mask)
- ;; By default, we unmask the standard IEEE 754 exceptions that Scheme
- ;; can safely run with, in order to report errors as soon as they
- ;; happen. Scheme cannot safely run with the inexact result
- ;; exception (which you almost never want *trapping* anyway), and
- ;; there are some non-standard exceptions which we will mask in order
+ (flo:trapped-exceptions trapped-float-exceptions 0)
+ (flo:set-trapped-exceptions! set-trapped-float-exceptions 1)
+ (flo:trap-exceptions! trap-float-exceptions 1)
+ (flo:untrap-exceptions! untrap-float-exceptions 1)
+ (flo:trappable-exceptions trappable-float-exceptions 0))
+
+(define (flo:default-trapped-exceptions)
+ ;; By default, we trap the standard IEEE 754 exceptions that Scheme
+ ;; can safely run with trapped, in order to report errors as soon as
+ ;; they happen. Scheme cannot safely run with the inexact result
+ ;; exception trapped (which you almost never want anyway), and there
+ ;; are some non-standard exceptions which we will not trap in order
;; to keep behaviour consistent between host systems.
- (fix:andc (flo:supported-exceptions)
- (fix:or (fix:or (flo:exception:divide-by-zero)
- (flo:exception:invalid-operation))
- (fix:or (flo:exception:overflow)
- (flo:exception:underflow)))))
+ (fix:or (fix:or (flo:exception:divide-by-zero)
+ (flo:exception:invalid-operation))
+ (fix:or (flo:exception:overflow)
+ (flo:exception:underflow))))
-(define (flo:with-exception-mask exceptions procedure)
+(define (flo:with-trapped-exceptions exceptions procedure)
(flo:preserving-environment
(lambda ()
- (flo:set-masked-exceptions! exceptions)
+ (flo:set-trapped-exceptions! exceptions)
(procedure))))
-(define (flo:with-exceptions-masked exceptions procedure)
+(define (flo:with-exceptions-trapped exceptions procedure)
(flo:preserving-environment
(lambda ()
- (flo:mask-exceptions! exceptions)
+ (flo:trap-exceptions! exceptions)
+ (procedure))))
+
+(define (flo:with-exceptions-untrapped exceptions procedure)
+ (flo:preserving-environment
+ (lambda ()
+ (flo:untrap-exceptions! exceptions)
(procedure))))
;++ Include machine-dependent bits, by number rather than by name.
;;;; Tests of the floating-point environment
+;;; Many tests fail if there are accrued exceptions when you run them.
+;;; This is pretty silly, but you can work around it provisionally by
+;;; evaluating (FLO:CLEAR-EXCEPTIONS! (FLO:SUPPORTED-EXCEPTIONS))
+;;; before running the tests.
+
(declare (usual-integrations))
\f
(define-test 'FLO:DEFAULT-ROUNDING-MODE
(define (no-op x) x) ;Do not integrate!
-(define (define-fpe-descriptor name unmaskable? exception condition-type)
- (let ((descriptor (list name exception condition-type unmaskable? '())))
+(define (define-fpe-descriptor name trappable? exception condition-type)
+ (let ((descriptor (list name exception condition-type trappable? '())))
(cond ((assq name floating-point-exception-descriptors)
=> (lambda (descriptor*)
(set-cdr! descriptor* (cdr descriptor))))
(apply receiver descriptor))
floating-point-exception-descriptors))
-(define (for-each-unmaskable-exception receiver)
+(define (for-each-trappable-exception receiver)
(for-each-exception
- (lambda (name exception condition-type unmaskable? elicitors)
- (if unmaskable?
+ (lambda (name exception condition-type trappable? elicitors)
+ (if trappable?
(receiver name exception condition-type elicitors)))))
(define (for-each-exception-elicitor receiver)
(for-each-exception
- (lambda (name exception condition-type unmaskable? elicitors)
+ (lambda (name exception condition-type trappable? elicitors)
(for-each (lambda (name.elicitor)
- (receiver name exception condition-type unmaskable?
+ (receiver name exception condition-type trappable?
(car name.elicitor)
(cdr name.elicitor)))
elicitors))))
-(define (for-each-unmaskable-exception-elicitor receiver)
- (for-each-unmaskable-exception
+(define (for-each-trappable-exception-elicitor receiver)
+ (for-each-trappable-exception
(lambda (name exception condition-type elicitors)
(for-each (lambda (name.elicitor)
(receiver name exception condition-type
;; relying on the exception flag will fail.
(flo:* (no-op .5) (flo:shift (no-op 1.) -1022)))))
\f
-(define (for-each-unmaskable-exception receiver)
+(define (for-each-trappable-exception receiver)
(for-each-exception
- (lambda (name exception condition-type unmaskable? elicitors)
- (if unmaskable? (receiver name exception condition-type elicitors)))))
+ (lambda (name exception condition-type trappable? elicitors)
+ (if trappable? (receiver name exception condition-type elicitors)))))
(for-each-exception
- (lambda (name exception condition-type unmaskable? elicitors)
- condition-type unmaskable? elicitors ;ignore
+ (lambda (name exception condition-type trappable? elicitors)
+ condition-type trappable? elicitors ;ignore
(define-test (symbol-append 'FLO:EXCEPTIONS->NAMES ': name)
(lambda ()
(assert-equal (flo:exceptions->names (exception)) (list name))))
(map car floating-point-exception-descriptors))
'())))
-(define-test 'FLO:MASKED-EXCEPTIONS
+(define-test 'FLO:TRAPPED-EXCEPTIONS
(lambda ()
- (flo:masked-exceptions)))
+ (flo:trapped-exceptions)))
-(define (define-set-masked-exceptions-test name to-mask)
- (define-test (symbol-append 'FLO:SET-MASKED-EXCEPTIONS! ': name)
+(define (define-set-trapped-exceptions-test name to-trap)
+ (define-test (symbol-append 'FLO:SET-TRAPPED-EXCEPTIONS! ': name)
(lambda ()
- (let ((exceptions (fix:andc (flo:supported-exceptions) (to-mask)))
- (mask (flo:masked-exceptions)))
+ (let ((exceptions (to-trap))
+ (trapped (flo:trapped-exceptions)))
(dynamic-wind
(lambda () unspecific)
(lambda ()
- (assert-eqv (flo:set-masked-exceptions! exceptions) mask)
- (assert-eqv (flo:masked-exceptions) exceptions))
- (lambda () (flo:set-masked-exceptions! mask)))))))
+ (assert-eqv (flo:set-trapped-exceptions! exceptions) trapped)
+ (assert-eqv (flo:trapped-exceptions) exceptions))
+ (lambda () (flo:set-trapped-exceptions! trapped)))))))
-(define (define-with-exception-mask-test name to-mask)
- (define-test (symbol-append 'FLO:WITH-EXCEPTION-MASK ': name)
+(define (define-with-trapped-exceptions-test name to-trap)
+ (define-test (symbol-append 'FLO:WITH-TRAPPED-EXCEPTIONS ': name)
(lambda ()
- (let ((exceptions (fix:andc (flo:supported-exceptions) (to-mask))))
- (flo:with-exception-mask exceptions
+ (let ((exceptions (to-trap)))
+ (flo:with-trapped-exceptions exceptions
(lambda ()
- (assert-eqv (flo:masked-exceptions) exceptions)))))))
+ (assert-eqv (flo:trapped-exceptions) exceptions)))))))
-(define-set-masked-exceptions-test 'ALL (lambda () 0))
-(define-set-masked-exceptions-test 'NONE flo:unmaskable-exceptions)
+(define-set-trapped-exceptions-test 'ALL (lambda () 0))
+(define-set-trapped-exceptions-test 'NONE flo:trappable-exceptions)
-(define-with-exception-mask-test 'ALL (lambda () 0))
-(define-with-exception-mask-test 'NONE flo:unmaskable-exceptions)
+(define-with-trapped-exceptions-test 'ALL (lambda () 0))
+(define-with-trapped-exceptions-test 'NONE flo:trappable-exceptions)
-(for-each-unmaskable-exception
+(for-each-trappable-exception
(lambda (name exception condition-type elicitors)
elicitors ;ignore
- (define-test (symbol-append 'FLO:WITH-EXCEPTION-MASK ': name)
+ (define-test (symbol-append 'FLO:WITH-TRAPPED-EXCEPTIONS ': name)
(lambda ()
- (let ((mask (fix:andc (flo:supported-exceptions) (exception))))
- (flo:with-exception-mask mask
- (lambda ()
- (assert-eqv (flo:masked-exceptions) mask))))))))
+ (flo:with-trapped-exceptions (exception)
+ (lambda ()
+ (assert-eqv (flo:trapped-exceptions) (exception))))))))
\f
-(for-each-unmaskable-exception
+(for-each-trappable-exception
(lambda (name exception condition-type elicitors)
elicitors ;ignore
- (define-test (symbol-append 'FLO:MASK-EXCEPTIONS! ': name)
+ (define-test (symbol-append 'FLO:TRAP-EXCEPTIONS! ': name)
(lambda ()
- (let ((mask
- (fix:andc (flo:supported-exceptions)
- (flo:unmaskable-exceptions))))
- (flo:with-exception-mask mask
- (lambda ()
- (assert-eqv (flo:mask-exceptions! (exception)) mask)
- (assert-eqv (flo:masked-exceptions)
- (fix:or mask (exception))))))))))
+ (flo:with-trapped-exceptions 0
+ (lambda ()
+ (assert-eqv (flo:trap-exceptions! (exception)) 0)
+ (assert-eqv (flo:trapped-exceptions) (exception))))))))
-(for-each-unmaskable-exception
+(for-each-trappable-exception
(lambda (name exception condition-type elicitors)
elicitors ;ignore
- (define-test (symbol-append 'FLO:UNMASK-EXCEPTIONS! ': name)
+ (define-test (symbol-append 'FLO:UNTRAP-EXCEPTIONS! ': name)
(lambda ()
- (flo:with-exception-mask (flo:supported-exceptions)
+ (flo:with-trapped-exceptions (flo:trappable-exceptions)
(lambda ()
- (assert-eqv (flo:unmask-exceptions! (exception))
- (flo:supported-exceptions))
- (assert-eqv (flo:masked-exceptions)
- (fix:andc (flo:supported-exceptions) (exception)))))))))
+ (assert-eqv (flo:untrap-exceptions! (exception))
+ (flo:trappable-exceptions))
+ (assert-eqv (flo:trapped-exceptions)
+ (fix:andc (flo:trappable-exceptions) (exception)))))))))
-(for-each-unmaskable-exception
+(for-each-trappable-exception
(lambda (name exception condition-type elicitors)
elicitors ;ignore
- (define-test (symbol-append 'FLO:SET-MASKED-EXCEPTIONS! ': name ': 'ENABLE)
+ (define-test (symbol-append 'FLO:SET-TRAPPED-EXCEPTIONS! ': name ': 'ENABLE)
(lambda ()
- (let ((mask
- (fix:andc (flo:supported-exceptions)
- (flo:unmaskable-exceptions))))
- (flo:with-exception-mask (fix:or mask (exception))
- (lambda ()
- (assert-eqv (flo:set-masked-exceptions! mask)
- (fix:or mask (exception)))
- (assert-eqv (flo:masked-exceptions) mask))))))))
+ (flo:with-trapped-exceptions 0
+ (lambda ()
+ (assert-eqv (flo:set-trapped-exceptions! (exception)) 0)
+ (assert-eqv (flo:trapped-exceptions) (exception))))))))
-(for-each-unmaskable-exception
+(for-each-trappable-exception
(lambda (name exception condition-type elicitors)
elicitors ;ignore
- (define-test (symbol-append 'FLO:SET-MASKED-EXCEPTIONS! ': name ': 'DISABLE)
+ (define-test (symbol-append 'FLO:SET-TRAPPED-EXCEPTIONS! ': name ': 'DISABLE)
(lambda ()
- (let ((mask (fix:andc (flo:supported-exceptions) (exception))))
- (flo:with-exception-mask (flo:supported-exceptions)
+ (let ((exceptions (fix:andc (flo:trappable-exceptions) (exception))))
+ (flo:with-trapped-exceptions (flo:trappable-exceptions)
(lambda ()
- (assert-eqv (flo:set-masked-exceptions! mask)
- (flo:supported-exceptions))
- (assert-eqv (flo:masked-exceptions) mask))))))))
+ (assert-eqv (flo:set-trapped-exceptions! exceptions)
+ (flo:trappable-exceptions))
+ (assert-eqv (flo:trapped-exceptions) exceptions))))))))
\f
-(for-each-unmaskable-exception-elicitor
+(for-each-trappable-exception-elicitor
(lambda (name exception condition-type elicitor-name elicitor)
(define-test (symbol-append 'ELICIT ': name ': elicitor-name)
(lambda ()
(assert-error (lambda ()
- (flo:with-exception-mask
- (fix:andc (flo:supported-exceptions) (exception))
- elicitor))
+ (flo:with-trapped-exceptions (exception) elicitor))
(list condition-type))))))
-(for-each-unmaskable-exception-elicitor
+(for-each-trappable-exception-elicitor
(lambda (name exception condition-type elicitor-name elicitor)
(define-test (symbol-append 'ELICIT-DEFERRED ': name ': elicitor-name)
(lambda ()
(assert-error
(lambda ()
- (flo:with-exception-mask
- (fix:andc (flo:supported-exceptions) (flo:unmaskable-exceptions))
+ (flo:with-trapped-exceptions (flo:trappable-exceptions)
(lambda ()
- (flo:deferring-exceptions
+ (flo:deferring-exception-traps
(lambda ()
(let ((flag #f))
(dynamic-wind (lambda () unspecific)
(list condition-type))))))
(for-each-exception-elicitor
- (lambda (name exception condition-type unmaskable? elicitor-name elicitor)
- unmaskable? ;ignore
+ (lambda (name exception condition-type trappable? elicitor-name elicitor)
+ trappable? ;ignore
(define-test (symbol-append 'ELICIT-IGNORED ': name ': elicitor-name)
(lambda ()
- (flo:ignoring-exceptions elicitor)))))
+ (flo:ignoring-exception-traps elicitor)))))
(for-each-exception-elicitor
- (lambda (name exception condition-type unmaskable? elicitor-name elicitor)
- unmaskable? ;ignore
+ (lambda (name exception condition-type trappable? elicitor-name elicitor)
+ trappable? ;ignore
(define-test (symbol-append 'ELICIT-AND-TEST ': name ': elicitor-name)
(lambda ()
- (assert-eqv (flo:ignoring-exceptions
+ (assert-eqv (flo:ignoring-exception-traps
(lambda ()
(elicitor)
(flo:test-exceptions (exception))))
(exception))))))
(for-each-exception-elicitor
- (lambda (name exception condition-type unmaskable? elicitor-name elicitor)
- unmaskable? ;ignore
+ (lambda (name exception condition-type trappable? elicitor-name elicitor)
+ trappable? ;ignore
(define-test (symbol-append 'ELICIT-CLEAR-TEST ': name ': elicitor-name)
(lambda ()
- (assert-eqv (flo:ignoring-exceptions
+ (assert-eqv (flo:ignoring-exception-traps
(lambda ()
(elicitor)
(flo:clear-exceptions! (exception))
(if (eq? 'UPWARD (flo:default-rounding-mode))
'TO-NEAREST
'UPWARD))
- (flo:set-masked-exceptions!
- (if (= (flo:supported-exceptions) (flo:default-exception-mask))
- (fix:andc (flo:supported-exceptions)
- (flo:unmaskable-exceptions))
- (flo:supported-exceptions)))
+ (flo:set-trapped-exceptions!
+ (if (= (flo:trappable-exceptions) (flo:default-trapped-exceptions))
+ (fix:andc (flo:default-trapped-exceptions)
+ (flo:trappable-exceptions))
+ (flo:trappable-exceptions)))
(flo:with-default-environment procedure))))))
(define-default-environment-test 'ROUNDING-MODE
(lambda ()
(assert-eqv (flo:rounding-mode) (flo:default-rounding-mode))))
-(define-default-environment-test 'MASKED-EXCEPTIONS
+(define-default-environment-test 'TRAPPED-EXCEPTIONS
(lambda ()
- (assert-eqv (flo:masked-exceptions) (flo:default-exception-mask))))
+ (assert-eqv (flo:trapped-exceptions) (flo:default-trapped-exceptions))))