vm-error>exception-flags word to extract exception flag information from a trap exception

Joe Groff 2009-09-14 14:10:51 -05:00
parent bbea60809d
commit 016caed095
2 changed files with 34 additions and 8 deletions

View File

@ -1,5 +1,5 @@
! (c)Joe Groff bsd license
USING: help help.markup help.syntax quotations ;
USING: help help.markup help.syntax kernel quotations ;
IN: math.floats.env
HELP: fp-exception
@ -97,13 +97,21 @@ HELP: fp-traps
HELP: with-fp-traps
{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } { "quot" quotation } }
{ $description "Replaces the floating-point exception mask to enable processor traps to be raised for the set of exception conditions specified in " { $snippet "exceptions" } " for the dynamic extent of " { $snippet "quot" } ", restoring the original exception mask on " { $snippet "quot" } "'s completion." } ;
{ $description "Clears the floating-point exception flags and replaces the exception mask, enabling processor traps for the set of exception conditions specified in " { $snippet "exceptions" } " for the dynamic extent of " { $snippet "quot" } ". The original exception mask is restored on " { $snippet "quot" } "'s completion." } ;
HELP: without-fp-traps
{ $values { "quot" quotation } }
{ $description "Disables all floating-pointer processor traps for the dynamic extent of " { $snippet "quot" } ", restoring the original exception mask on " { $snippet "quot" } "'s completion." } ;
{ fp-traps with-fp-traps without-fp-traps } related-words
{ fp-traps with-fp-traps without-fp-traps vm-error>exception-flags vm-error-exception-flag? } related-words
HELP: vm-error>exception-flags
{ $values { "error" "a floating-point error object from the Factor VM" } { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
{ $description "When a floating-point trap is raised, the Factor VM reports the trap by throwing a Factor exception containing the exception flags at the time the trap was raised. This word extracts the exception flag information from " { $snippet "error" } " and converts it into a sequence of " { $link fp-exception } "s." } ;
HELP: vm-error-exception-flag?
{ $values { "error" "a floating-point error object from the Factor VM" } { "flag" fp-exception } { "?" boolean } }
{ $description "When a floating-point trap is raised, the Factor VM reports the trap by throwing a Factor exception containing the exception flags at the time the trap was raised. This word returns a boolean indicating whether the exception " { $snippet "flag" } " was raised at the time " { $snippet "error" } " was thrown." } ;
ARTICLE: "math.floats.env" "Controlling the floating-point environment"
"The " { $vocab-link "math.floats.env" } " vocabulary contains words for querying and controlling the floating-point environment."
@ -117,11 +125,13 @@ $nl
{ $subsection fp-traps }
{ $subsection with-fp-traps }
{ $subsection without-fp-traps }
"Getting the floating-point exception state from errors raised by enabled traps:"
{ $subsection vm-error>exception-flags }
{ $subsection vm-error-exception-flag? }
"Querying and controlling the rounding mode and treatment of denormals:"
{ $subsection rounding-mode }
{ $subsection with-rounding-mode }
{ $subsection denormal-mode }
{ $subsection with-denormal-mode }
{ $notes "On PowerPC, the above words only modify the scalar FPU's state (in FPSCR); the AltiVec unit is currently unaffected." } ;
{ $subsection with-denormal-mode } ;
ABOUT: "math.floats.env"

View File

@ -1,7 +1,8 @@
! (c)Joe Groff bsd license
USING: alien.syntax arrays assocs biassocs combinators continuations
generalizations kernel literals locals math math.bitwise
sequences sets system vocabs.loader ;
USING: alien.syntax arrays assocs biassocs combinators
combinators.short-circuit continuations generalizations kernel
literals locals math math.bitwise sequences sets system
vocabs.loader ;
IN: math.floats.env
SINGLETONS:
@ -102,6 +103,15 @@ GENERIC# (set-denormal-mode) 1 ( fp-env mode -- fp-env )
} spread
] 4 ncurry change-fp-env-registers ;
CONSTANT: vm-error-exception-flag>bit
H{
{ +fp-invalid-operation+ HEX: 01 }
{ +fp-overflow+ HEX: 02 }
{ +fp-underflow+ HEX: 04 }
{ +fp-zero-divide+ HEX: 08 }
{ +fp-inexact+ HEX: 10 }
}
PRIVATE>
: fp-exception-flags ( -- exceptions )
@ -113,6 +123,11 @@ PRIVATE>
: collect-fp-exceptions ( quot -- exceptions )
[ clear-fp-exception-flags ] dip call fp-exception-flags ; inline
: vm-error>exception-flags ( error -- exceptions )
third vm-error-exception-flag>bit mask> ;
: vm-error-exception-flag? ( error flag -- ? )
vm-error>exception-flags member? ;
: denormal-mode ( -- mode ) fp-env-register (get-denormal-mode) ;
:: with-denormal-mode ( mode quot -- )
@ -131,6 +146,7 @@ PRIVATE>
(fp-env-registers) [ (get-fp-traps) ] [ union ] map-reduce >array ; inline
:: with-fp-traps ( exceptions quot -- )
clear-fp-exception-flags
fp-traps :> orig
exceptions set-fp-traps
quot [ orig set-fp-traps ] [ ] cleanup ; inline