Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
6c3ef91642
|
|
@ -34,7 +34,7 @@ M: ppc-vmx-env (set-fp-env-register)
|
|||
M: ppc (fp-env-registers)
|
||||
<ppc-fpu-env> <ppc-vmx-env> 2array ;
|
||||
|
||||
CONSTANT: ppc-exception-flag-bits HEX: 3e00,0000
|
||||
CONSTANT: ppc-exception-flag-bits HEX: fff8,0000
|
||||
CONSTANT: ppc-exception-flag>bit
|
||||
H{
|
||||
{ +fp-invalid-operation+ HEX: 2000,0000 }
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,534 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs combinators constructors eval help.markup kernel
|
||||
multiline namespaces parser sequences sequences.private slides
|
||||
vocabs.refresh words fry ;
|
||||
IN: tc-lisp-talk
|
||||
|
||||
CONSTANT: tc-lisp-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
"Development started in 2003"
|
||||
"Open source (BSD license)"
|
||||
"Influenced by Forth, Lisp, and Smalltalk"
|
||||
"Blurs the line between language and library"
|
||||
"Interactive development"
|
||||
}
|
||||
{ $slide "First, some examples"
|
||||
{ $code "3 weeks ago noon monday ." }
|
||||
{ $code "USE: roman 2009 >roman ." }
|
||||
{ $code <" : average ( seq -- x )
|
||||
[ sum ] [ length ] bi / ;"> }
|
||||
{ $code "1 miles [ km ] undo >float ." }
|
||||
{ $code "[ readln eval>string print t ] loop" }
|
||||
}
|
||||
{ $slide "XML Literals"
|
||||
{ $code
|
||||
<" USING: splitting xml.writer xml.syntax ;
|
||||
{ "one" "two" "three" }
|
||||
[ [XML <item><-></item> XML] ] map
|
||||
<XML <doc><-></doc> XML> pprint-xml">
|
||||
}
|
||||
}
|
||||
{ $slide "Differences between Factor and Lisp"
|
||||
"Single-implementation language"
|
||||
"Less nesting, shorter word length"
|
||||
{ "Dynamic reloading of code from files with " { $link refresh-all } }
|
||||
"More generic protocols -- sequences, assocs, streams"
|
||||
"More cross-platform"
|
||||
"No standard for the language"
|
||||
"Evaluates left to right"
|
||||
}
|
||||
{ $slide "Terminology"
|
||||
{ "Words - functions" }
|
||||
{ "Vocabularies - collections of code in the same namespace" }
|
||||
{ "Quotations - blocks of code" { $code "[ dup reverse append ]" } }
|
||||
{ "Combinators - higher order functions" }
|
||||
{ "Static stack effect - known stack effect at compile-time" }
|
||||
}
|
||||
{ $slide "Defining a word"
|
||||
"Defined at parse time"
|
||||
"Parts: name, stack effect, definition"
|
||||
"Composed of tokens separated by whitespace"
|
||||
{ $code ": palindrome? ( string -- ? ) dup reverse = ;" }
|
||||
}
|
||||
{ $slide "Non-static stack effect"
|
||||
"Not a good practice, nor useful"
|
||||
"Not compiled by the optimizing compiler"
|
||||
{ $code "100 iota [ ] each" }
|
||||
}
|
||||
{ $slide "Module system"
|
||||
"Code divided up into vocabulary roots"
|
||||
"core/ -- just enough code to bootstrap Factor"
|
||||
"basis/ -- optimizing compiler, the UI, tools, libraries"
|
||||
"extra/ -- demos, unpolished code, experiments"
|
||||
"work/ -- your works in progress"
|
||||
}
|
||||
{ $slide "Module system (part 2)"
|
||||
"Each vocabulary corresponds to a directory on disk, with documentation and test files"
|
||||
{ "Code for the " { $snippet "math" } " vocabulary: " { $snippet "~/factor/core/math/math.factor" } }
|
||||
{ "Documentation for the " { $snippet "math" } " vocabulary: " { $snippet "~/factor/core/math/math-docs.factor" } }
|
||||
{ "Unit tests for the " { $snippet "math" } " vocabulary: " { $snippet " ~/factor/core/math/math-tests.factor" } }
|
||||
}
|
||||
{ $slide "Using a library"
|
||||
"Each file starts with a USING: list"
|
||||
"To use a library, simply include it in this list"
|
||||
"Refreshing code loads dependencies correctly"
|
||||
}
|
||||
{ $slide "Object system"
|
||||
"Based on CLOS"
|
||||
{ "We define generic words that operate on the top of the stack with " { $link POSTPONE: GENERIC: } " or on an implicit parameter with " { $link POSTPONE: HOOK: } }
|
||||
}
|
||||
{ $slide "Object system example: shape protocol"
|
||||
"In ~/factor/work/shapes/shapes.factor"
|
||||
{ $code <" IN: shapes
|
||||
|
||||
GENERIC: area ( shape -- x )
|
||||
GENERIC: perimeter ( shape -- x )">
|
||||
}
|
||||
}
|
||||
{ $slide "Implementing the shape protocol: circles"
|
||||
"In ~/factor/work/shapes/circle/circle.factor"
|
||||
{ $code <" USING: shapes constructors math
|
||||
math.constants ;
|
||||
IN: shapes.circle
|
||||
|
||||
TUPLE: circle radius ;
|
||||
CONSTRUCTOR: circle ( radius -- obj ) ;
|
||||
M: circle area radius>> sq pi * ;
|
||||
M: circle perimeter radius>> pi * 2 * ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Dynamic variables"
|
||||
"Implemented as a stack of hashtables"
|
||||
{ "Useful words are " { $link get } ", " { $link set } }
|
||||
"Input, output, error streams are stored in dynamic variables"
|
||||
{ $code <" "Today is the first day of the rest of your life."
|
||||
[
|
||||
readln print
|
||||
] with-string-reader">
|
||||
}
|
||||
}
|
||||
{ $slide "The global namespace"
|
||||
"The global namespace is just the namespace at the bottom of the namespace stack"
|
||||
{ "Useful words are " { $link get-global } ", " { $link set-global } }
|
||||
"Factor idiom for changing a particular namespace"
|
||||
{ $code <" SYMBOL: king
|
||||
global [ "Henry VIII" king set ] bind">
|
||||
}
|
||||
{ $code "with-scope" }
|
||||
{ $code "namestack" }
|
||||
}
|
||||
{ $slide "Hooks"
|
||||
"Dispatch on a dynamic variable"
|
||||
{ $code <" HOOK: computer-name os ( -- string )
|
||||
M: macosx computer-name uname first ;
|
||||
macosx \ os set-global
|
||||
computer-name">
|
||||
}
|
||||
}
|
||||
{ $slide "Interpolate"
|
||||
"Replaces variables in a string"
|
||||
{ $code
|
||||
<" "Dawg" "name" set
|
||||
"rims" "noun" set
|
||||
"bling" "verb1" set
|
||||
"roll" "verb2" set
|
||||
[
|
||||
"Sup ${name}, we heard you liked ${noun}, so we put ${noun} on your car so you can ${verb1} while you ${verb2}."
|
||||
interpolate
|
||||
] with-string-writer print ">
|
||||
}
|
||||
}
|
||||
{ $slide "Sequence protocol"
|
||||
"All sequences obey a protocol of generics"
|
||||
{ "Is an object a " { $link sequence? } }
|
||||
{ "Getting the " { $link length } }
|
||||
{ "Accessing the " { $link nth } " element" }
|
||||
{ "Setting an element - " { $link set-nth } }
|
||||
}
|
||||
{ $slide "Examples of sequences in Factor"
|
||||
"Arrays are mutable"
|
||||
"Vectors are mutable and growable"
|
||||
{ "Arrays " { $code "{ \"abc\" \"def\" 50 }" } }
|
||||
{ "Vectors " { $code "V{ \"abc\" \"def\" 50 }" } }
|
||||
{ "Byte-arrays " { $code "B{ 1 2 3 }" } }
|
||||
{ "Byte-vectors " { $code "BV{ 11 22 33 }" } }
|
||||
}
|
||||
{ $slide "Specialized arrays and vectors"
|
||||
{ "Specialized int arrays " { $code "int-array{ -20 -30 40 }" } }
|
||||
{ "Specialized uint arrays " { $code "uint-array{ 20 30 40 }" } }
|
||||
{ "Specialized float vectors " { $code "float-vector{ 20 30 40 }" } }
|
||||
"35 others C-type arrays"
|
||||
}
|
||||
{ $slide "Specialized arrays code"
|
||||
"One line per array/vector"
|
||||
{ "In ~/factor/basis/specialized-arrays/float/float.factor"
|
||||
{ $code <" << "float" define-array >>"> }
|
||||
}
|
||||
{ "In ~/factor/basis/specialized-vectors/float/float.factor"
|
||||
{ $code <" << "float" define-vector >>"> }
|
||||
}
|
||||
}
|
||||
|
||||
{ $slide "Speciailzied arrays are implemented using functors"
|
||||
"Like C++ templates"
|
||||
"Eliminate boilerplate in ways other abstractions don't"
|
||||
"Contains a definition section and a functor body"
|
||||
"Uses the interpolate vocabulary"
|
||||
}
|
||||
{ $slide "Functor for sorting"
|
||||
{ $code
|
||||
<" FUNCTOR: define-sorting ( NAME QUOT -- )
|
||||
|
||||
NAME<=> DEFINES ${NAME}<=>
|
||||
NAME>=< DEFINES ${NAME}>=<
|
||||
|
||||
WHERE
|
||||
|
||||
: NAME<=> ( obj1 obj2 -- <=> ) QUOT compare ;
|
||||
: NAME>=< ( obj1 obj2 -- >=< )
|
||||
NAME<=> invert-comparison ;
|
||||
|
||||
;FUNCTOR">
|
||||
}
|
||||
}
|
||||
{ $slide "Example of sorting functor"
|
||||
{ $code <" USING: sorting.functor ;
|
||||
<< "length" [ length ] define-sorting >>">
|
||||
}
|
||||
{ $code
|
||||
<" { { 1 2 3 } { 1 2 } { 1 } }
|
||||
[ length<=> ] sort">
|
||||
}
|
||||
}
|
||||
{ $slide "Combinators"
|
||||
"Used to implement higher order functions (dataflow and control flow)"
|
||||
"Compiler optimizes away quotations completely"
|
||||
"Optimized code is just tight loops in registers"
|
||||
"Most loops can be expressed with combinators or tail-recursion"
|
||||
}
|
||||
{ $slide "Combinators that act on one value"
|
||||
{ $link bi }
|
||||
{ $code "10 [ 1 - ] [ 1 + ] bi" }
|
||||
{ $link tri }
|
||||
{ $code "10 [ 1 - ] [ 1 + ] [ 2 * ] tri" }
|
||||
}
|
||||
{ $slide "Combinators that act on two values"
|
||||
{ $link 2bi }
|
||||
{ $code "10 1 [ - ] [ + ] 2bi" }
|
||||
{ $link bi* }
|
||||
{ $code "10 20 [ 1 - ] [ 1 + ] bi*" }
|
||||
{ $link bi@ }
|
||||
{ $code "5 9 [ sq ] bi@" }
|
||||
}
|
||||
{ $slide "Sequence combinators"
|
||||
|
||||
{ $link each }
|
||||
{ $code "{ 1 2 3 4 5 } [ sq . ] each" }
|
||||
{ $link map }
|
||||
{ $code "{ 1 2 3 4 5 } [ sq ] map" }
|
||||
{ $link filter }
|
||||
{ $code "{ 1 2 3 4 5 } [ even? ] filter" }
|
||||
}
|
||||
{ $slide "Multiple sequence combinators"
|
||||
|
||||
{ $link 2each }
|
||||
{ $code "{ 1 2 3 } { 10 20 30 } [ + . ] 2each" }
|
||||
{ $link 2map }
|
||||
{ $code "{ 1 2 3 } { 10 20 30 } [ + ] 2map" }
|
||||
}
|
||||
{ $slide "Control flow: if"
|
||||
{ $link if }
|
||||
{ $code <" 10 random dup even? [ 2 / ] [ 1 - ] if"> }
|
||||
{ $link when }
|
||||
{ $code <" 10 random dup even? [ 2 / ] when"> }
|
||||
{ $link unless }
|
||||
{ $code <" 10 random dup even? [ 1 - ] unless"> }
|
||||
}
|
||||
{ $slide "Control flow: case"
|
||||
{ $link case }
|
||||
{ $code <" ERROR: not-possible obj ;
|
||||
10 random 5 <=> {
|
||||
{ +lt+ [ "Less" ] }
|
||||
{ +gt+ [ "More" ] }
|
||||
{ +eq+ [ "Equal" ] }
|
||||
[ not-possible ]
|
||||
} case">
|
||||
}
|
||||
}
|
||||
{ $slide "Fry"
|
||||
"Used to construct quotations"
|
||||
{ "'Holes', represented by " { $snippet "_" } " are filled left to right" }
|
||||
{ $code "10 4 '[ _ + ] call" }
|
||||
{ $code "3 4 '[ _ sq _ + ] call" }
|
||||
}
|
||||
{ $slide "Locals"
|
||||
"When data flow combinators and shuffle words are not enough"
|
||||
"Name your input parameters"
|
||||
"Used in about 1% of all words"
|
||||
}
|
||||
{ $slide "Locals example"
|
||||
"Area of a triangle using Heron's formula"
|
||||
{ $code
|
||||
<" :: area ( a b c -- x )
|
||||
a b c + + 2 / :> p
|
||||
p
|
||||
p a - *
|
||||
p b - *
|
||||
p c - * sqrt ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Previous example without locals"
|
||||
"A bit unwieldy..."
|
||||
{ $code
|
||||
<" : area ( a b c -- x )
|
||||
[ ] [ + + 2 / ] 3bi
|
||||
[ '[ _ - ] tri@ ] [ neg ] bi
|
||||
* * * sqrt ;"> }
|
||||
}
|
||||
{ $slide "More idiomatic version"
|
||||
"But there's a trick: put the lengths in an array"
|
||||
{ $code <" : v-n ( v n -- w ) '[ _ - ] map ;
|
||||
|
||||
: area ( seq -- x )
|
||||
[ 0 suffix ] [ sum 2 / ] bi
|
||||
v-n product sqrt ;"> }
|
||||
}
|
||||
{ $slide "Implementing an abstraction"
|
||||
{ "Suppose we want to get the price of the customer's first order, but any one of the steps along the way could be a nil value (" { $link f } " in Factor):" }
|
||||
{ $code
|
||||
"dup [ orders>> ] when"
|
||||
"dup [ first ] when"
|
||||
"dup [ price>> ] when"
|
||||
}
|
||||
}
|
||||
{ $slide "This is hard with mainstream syntax!"
|
||||
{ $code
|
||||
<" var customer = ...;
|
||||
var orders = (customer == null ? null : customer.orders);
|
||||
var order = (orders == null ? null : orders[0]);
|
||||
var price = (order == null ? null : order.price);"> }
|
||||
}
|
||||
{ $slide "An ad-hoc solution"
|
||||
"Something like..."
|
||||
{ $code "var price = customer.?orders.?[0].?price;" }
|
||||
}
|
||||
{ $slide "Macros in Factor"
|
||||
"Expand at compile-time"
|
||||
"Return a quotation to be compiled"
|
||||
"Can express non-static stack effects"
|
||||
"Not as widely used as combinators, 60 macros so far"
|
||||
{ $code "{ 1 2 3 4 5 } 5 firstn" }
|
||||
}
|
||||
{ $slide "A macro solution"
|
||||
"Returns a quotation to the compiler"
|
||||
"Constructed using map, fry, and concat"
|
||||
{ $code <" MACRO: plox ( seq -- quot )
|
||||
[
|
||||
'[ dup _ when ]
|
||||
] map [ ] concat-as ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Macro example"
|
||||
"Return the caaar of a sequence"
|
||||
{ "Return " { $snippet f } " on failure" }
|
||||
{ $code <" : caaar ( seq/f -- x/f )
|
||||
{
|
||||
[ first ]
|
||||
[ first ]
|
||||
[ first ]
|
||||
} plox ;">
|
||||
}
|
||||
{ $code <" { { f } } caaar"> }
|
||||
{ $code <" { { { 1 2 3 } } } caaar"> }
|
||||
}
|
||||
{ $slide "Smart combinators"
|
||||
"Use stack checker to infer inputs and outputs"
|
||||
"Even fewer uses than macros"
|
||||
{ $code "{ 1 10 20 34 } sum" }
|
||||
{ $code "[ 1 10 20 34 ] sum-outputs" }
|
||||
{ $code "[ 2 2 [ even? ] both? ] [ + ] [ - ] smart-if" }
|
||||
}
|
||||
{ $slide "Fibonacci"
|
||||
"Not tail recursive"
|
||||
"Call tree is huge"
|
||||
{ $code <" : fib ( n -- x )
|
||||
dup 1 <= [
|
||||
[ 1 - fib ] [ 2 - fib ] bi +
|
||||
] unless ;">
|
||||
}
|
||||
{ $code "36 iota [ fib ] map ." }
|
||||
}
|
||||
{ $slide "Memoized Fibonacci"
|
||||
"Change one word and it's efficient"
|
||||
{ $code <" MEMO: fib ( n -- x )
|
||||
dup 1 <= [
|
||||
[ 1 - fib ] [ 2 - fib ] bi +
|
||||
] unless ;">
|
||||
}
|
||||
{ $code "36 iota [ fib ] map ." }
|
||||
}
|
||||
{ $slide "Destructors"
|
||||
"Deterministic resource disposal"
|
||||
"Any step can fail and we don't want to leak resources"
|
||||
"We want to conditionally clean up sometimes -- if everything succeeds, we might wish to retain the buffer"
|
||||
}
|
||||
|
||||
{ $slide "Example in C"
|
||||
{ $code
|
||||
<" void do_stuff()
|
||||
{
|
||||
void *obj1, *obj2;
|
||||
if(!(*obj1 = malloc(256))) goto end;
|
||||
if(!(*obj2 = malloc(256))) goto cleanup1;
|
||||
... work goes here...
|
||||
cleanup2: free(*obj2);
|
||||
cleanup1: free(*obj1);
|
||||
end: return;
|
||||
}">
|
||||
}
|
||||
}
|
||||
{ $slide "Example: allocating and disposing two buffers"
|
||||
{ $code <" : do-stuff ( -- )
|
||||
[
|
||||
256 malloc &free
|
||||
256 malloc &free
|
||||
... work goes here ...
|
||||
] with-destructors ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Example: allocating two buffers for later"
|
||||
{ $code <" : do-stuff ( -- )
|
||||
[
|
||||
256 malloc |free
|
||||
256 malloc |free
|
||||
... work goes here ...
|
||||
] with-destructors ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Example: disposing of an output port"
|
||||
{ $code <" M: output-port dispose*
|
||||
[
|
||||
{
|
||||
[ handle>> &dispose drop ]
|
||||
[ buffer>> &dispose drop ]
|
||||
[ port-flush ]
|
||||
[ handle>> shutdown ]
|
||||
} cleave
|
||||
] with-destructors ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Rapid application development"
|
||||
"We lost the dice to Settlers of Catan: Cities and Knights"
|
||||
"Two regular dice, one special die"
|
||||
{ $vocab-link "dice" }
|
||||
}
|
||||
{ $slide "The essence of Factor"
|
||||
"Nicely named words abstract away the stack, leaving readable code"
|
||||
{ $code <" : surround ( seq left right -- seq' )
|
||||
swapd 3append ;">
|
||||
}
|
||||
{ $code <" : glue ( left right middle -- seq' )
|
||||
swap 3append ;">
|
||||
}
|
||||
{ $code HEREDOC: xyz
|
||||
"a" "b" "c" 3append
|
||||
"a" "<" ">" surround
|
||||
"a" "b" ", " glue
|
||||
xyz
|
||||
}
|
||||
}
|
||||
{ $slide "C FFI demo"
|
||||
"Easy to call C functions from Factor"
|
||||
"Handles C structures, C types, callbacks"
|
||||
"Used extensively in the Windows and Unix backends"
|
||||
{ $code
|
||||
<" FUNCTION: double pow ( double x, double y ) ;
|
||||
2 5.0 pow .">
|
||||
}
|
||||
}
|
||||
{ $slide "Windows win32 example"
|
||||
{ $code
|
||||
<" M: windows gmt-offset
|
||||
( -- hours minutes seconds )
|
||||
"TIME_ZONE_INFORMATION" <c-object>
|
||||
dup GetTimeZoneInformation {
|
||||
{ TIME_ZONE_ID_INVALID [
|
||||
win32-error-string throw
|
||||
] }
|
||||
{ TIME_ZONE_ID_STANDARD [
|
||||
TIME_ZONE_INFORMATION-Bias
|
||||
] }
|
||||
} case neg 60 /mod 0 ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Struct and function"
|
||||
{ $code <" C-STRUCT: TIME_ZONE_INFORMATION
|
||||
{ "LONG" "Bias" }
|
||||
{ { "WCHAR" 32 } "StandardName" }
|
||||
{ "SYSTEMTIME" "StandardDate" }
|
||||
{ "LONG" "StandardBias" }
|
||||
{ { "WCHAR" 32 } "DaylightName" }
|
||||
{ "SYSTEMTIME" "DaylightDate" }
|
||||
{ "LONG" "DaylightBias" } ;">
|
||||
}
|
||||
{ $code <" FUNCTION: DWORD GetTimeZoneInformation (
|
||||
LPTIME_ZONE_INFORMATION
|
||||
lpTimeZoneInformation
|
||||
) ;">
|
||||
}
|
||||
|
||||
}
|
||||
{ $slide "Cocoa FFI"
|
||||
{ $code <" IMPORT: NSAlert [
|
||||
NSAlert -> new
|
||||
[ -> retain ] [
|
||||
"Raptor" <CFString> &CFRelease
|
||||
-> setMessageText:
|
||||
] [
|
||||
"Look out!" <CFString> &CFRelease
|
||||
-> setInformativeText:
|
||||
] tri -> runModal drop
|
||||
] with-destructors">
|
||||
}
|
||||
}
|
||||
{ $slide "Deployment demo"
|
||||
"Vocabularies can be deployed"
|
||||
"Standalone .app on Mac"
|
||||
"An executable and dll on Windows"
|
||||
{ $vocab-link "webkit-demo" }
|
||||
}
|
||||
{ $slide "Interesting programs"
|
||||
{ $vocab-link "terrain" }
|
||||
{ $vocab-link "gpu.demos.raytrace" }
|
||||
{ $vocab-link "gpu.demos.bunny" }
|
||||
}
|
||||
{ $slide "Factor's source tree"
|
||||
"Lines of code in core/: 9,500"
|
||||
"Lines of code in basis/: 120,000"
|
||||
"Lines of code in extra/: 51,000"
|
||||
"Lines of tests: 44,000"
|
||||
"Lines of documentation: 44,500"
|
||||
}
|
||||
{ $slide "VM trivia"
|
||||
"Lines of C++ code: 12860"
|
||||
"Generational garbage collection"
|
||||
"Non-optimizing compiler"
|
||||
"Loads an image file and runs it"
|
||||
}
|
||||
{ $slide "Why should I use Factor?"
|
||||
"More abstractions over time"
|
||||
"We fix reported bugs quickly"
|
||||
"Stackable, fluent language"
|
||||
"Supports extreme programming"
|
||||
"Beer-friendly programming"
|
||||
}
|
||||
{ $slide "Questions?"
|
||||
}
|
||||
}
|
||||
|
||||
: tc-lisp-talk ( -- ) tc-lisp-slides slides-window ;
|
||||
|
||||
MAIN: tc-lisp-talk
|
||||
|
|
@ -62,6 +62,24 @@ inline static bool tail_call_site_p(cell return_address)
|
|||
return (insn & 0x1) == 0;
|
||||
}
|
||||
|
||||
inline static unsigned int fpu_status(unsigned int status)
|
||||
{
|
||||
unsigned int r = 0;
|
||||
|
||||
if (status & 0x20000000)
|
||||
r |= FP_TRAP_INVALID_OPERATION;
|
||||
if (status & 0x10000000)
|
||||
r |= FP_TRAP_OVERFLOW;
|
||||
if (status & 0x08000000)
|
||||
r |= FP_TRAP_UNDERFLOW;
|
||||
if (status & 0x04000000)
|
||||
r |= FP_TRAP_ZERO_DIVIDE;
|
||||
if (status & 0x02000000)
|
||||
r |= FP_TRAP_INEXACT;
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
/* Defined in assembly */
|
||||
VM_ASM_API void c_to_factor(cell quot);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind);
|
||||
|
|
|
|||
|
|
@ -50,6 +50,24 @@ inline static bool tail_call_site_p(cell return_address)
|
|||
return call_site_opcode(return_address) == jmp_opcode;
|
||||
}
|
||||
|
||||
inline static unsigned int fpu_status(unsigned int status)
|
||||
{
|
||||
unsigned int r = 0;
|
||||
|
||||
if (status & 0x01)
|
||||
r |= FP_TRAP_INVALID_OPERATION;
|
||||
if (status & 0x04)
|
||||
r |= FP_TRAP_ZERO_DIVIDE;
|
||||
if (status & 0x08)
|
||||
r |= FP_TRAP_OVERFLOW;
|
||||
if (status & 0x10)
|
||||
r |= FP_TRAP_UNDERFLOW;
|
||||
if (status & 0x20)
|
||||
r |= FP_TRAP_INEXACT;
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
/* Defined in assembly */
|
||||
VM_ASM_API void c_to_factor(cell quot);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ namespace factor
|
|||
user-space */
|
||||
cell signal_number;
|
||||
cell signal_fault_addr;
|
||||
unsigned int signal_fpu_status;
|
||||
stack_frame *signal_callstack_top;
|
||||
|
||||
void out_of_memory()
|
||||
|
|
@ -130,9 +131,9 @@ void divide_by_zero_error()
|
|||
general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
|
||||
}
|
||||
|
||||
void fp_trap_error(stack_frame *signal_callstack_top)
|
||||
void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
|
||||
{
|
||||
general_error(ERROR_FP_TRAP,F,F,signal_callstack_top);
|
||||
general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),F,signal_callstack_top);
|
||||
}
|
||||
|
||||
PRIMITIVE(call_clear)
|
||||
|
|
@ -158,7 +159,7 @@ void misc_signal_handler_impl()
|
|||
|
||||
void fp_signal_handler_impl()
|
||||
{
|
||||
fp_trap_error(signal_callstack_top);
|
||||
fp_trap_error(signal_fpu_status,signal_callstack_top);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ void memory_protection_error(cell addr, stack_frame *native_stack);
|
|||
void signal_error(int signal, stack_frame *native_stack);
|
||||
void type_error(cell type, cell tagged);
|
||||
void not_implemented_error();
|
||||
void fp_trap_error();
|
||||
void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
|
||||
|
||||
PRIMITIVE(call_clear);
|
||||
PRIMITIVE(unimplemented);
|
||||
|
|
@ -45,6 +45,7 @@ PRIMITIVE(unimplemented);
|
|||
user-space */
|
||||
extern cell signal_number;
|
||||
extern cell signal_fault_addr;
|
||||
extern unsigned int signal_fpu_status;
|
||||
extern stack_frame *signal_callstack_top;
|
||||
|
||||
void memory_signal_handler_impl();
|
||||
|
|
|
|||
|
|
@ -67,6 +67,16 @@ inline static cell align8(cell a)
|
|||
/* Not a real type, but code_block's type field can be set to this */
|
||||
#define PIC_TYPE 69
|
||||
|
||||
/* Constants used when floating-point trap exceptions are thrown */
|
||||
enum
|
||||
{
|
||||
FP_TRAP_INVALID_OPERATION = 1 << 0,
|
||||
FP_TRAP_OVERFLOW = 1 << 1,
|
||||
FP_TRAP_UNDERFLOW = 1 << 2,
|
||||
FP_TRAP_ZERO_DIVIDE = 1 << 3,
|
||||
FP_TRAP_INEXACT = 1 << 4,
|
||||
};
|
||||
|
||||
inline static bool immediate_p(cell obj)
|
||||
{
|
||||
return (obj == F || TAG(obj) == FIXNUM_TYPE);
|
||||
|
|
|
|||
|
|
@ -32,7 +32,8 @@ static void call_fault_handler(
|
|||
exception_type_t exception,
|
||||
exception_data_type_t code,
|
||||
MACH_EXC_STATE_TYPE *exc_state,
|
||||
MACH_THREAD_STATE_TYPE *thread_state)
|
||||
MACH_THREAD_STATE_TYPE *thread_state,
|
||||
MACH_FLOAT_STATE_TYPE *float_state)
|
||||
{
|
||||
/* There is a race condition here, but in practice an exception
|
||||
delivered during stack frame setup/teardown or while transitioning
|
||||
|
|
@ -56,6 +57,8 @@ static void call_fault_handler(
|
|||
}
|
||||
else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV)
|
||||
{
|
||||
signal_fpu_status = fpu_status(mach_fpu_status(float_state));
|
||||
mach_clear_fpu_status(float_state);
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)fp_signal_handler_impl;
|
||||
}
|
||||
else
|
||||
|
|
@ -78,14 +81,15 @@ catch_exception_raise (mach_port_t exception_port,
|
|||
{
|
||||
MACH_EXC_STATE_TYPE exc_state;
|
||||
MACH_THREAD_STATE_TYPE thread_state;
|
||||
mach_msg_type_number_t state_count;
|
||||
MACH_FLOAT_STATE_TYPE float_state;
|
||||
mach_msg_type_number_t exc_state_count, thread_state_count, float_state_count;
|
||||
|
||||
/* Get fault information and the faulting thread's register contents..
|
||||
|
||||
See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_get_state.html. */
|
||||
state_count = MACH_EXC_STATE_COUNT;
|
||||
exc_state_count = MACH_EXC_STATE_COUNT;
|
||||
if (thread_get_state (thread, MACH_EXC_STATE_FLAVOR,
|
||||
(natural_t *)&exc_state, &state_count)
|
||||
(natural_t *)&exc_state, &exc_state_count)
|
||||
!= KERN_SUCCESS)
|
||||
{
|
||||
/* The thread is supposed to be suspended while the exception
|
||||
|
|
@ -93,9 +97,19 @@ catch_exception_raise (mach_port_t exception_port,
|
|||
return KERN_FAILURE;
|
||||
}
|
||||
|
||||
state_count = MACH_THREAD_STATE_COUNT;
|
||||
thread_state_count = MACH_THREAD_STATE_COUNT;
|
||||
if (thread_get_state (thread, MACH_THREAD_STATE_FLAVOR,
|
||||
(natural_t *)&thread_state, &state_count)
|
||||
(natural_t *)&thread_state, &thread_state_count)
|
||||
!= KERN_SUCCESS)
|
||||
{
|
||||
/* The thread is supposed to be suspended while the exception
|
||||
handler is called. This shouldn't fail. */
|
||||
return KERN_FAILURE;
|
||||
}
|
||||
|
||||
float_state_count = MACH_FLOAT_STATE_COUNT;
|
||||
if (thread_get_state (thread, MACH_FLOAT_STATE_FLAVOR,
|
||||
(natural_t *)&float_state, &float_state_count)
|
||||
!= KERN_SUCCESS)
|
||||
{
|
||||
/* The thread is supposed to be suspended while the exception
|
||||
|
|
@ -105,13 +119,20 @@ catch_exception_raise (mach_port_t exception_port,
|
|||
|
||||
/* Modify registers so to have the thread resume executing the
|
||||
fault handler */
|
||||
call_fault_handler(exception,code[0],&exc_state,&thread_state);
|
||||
call_fault_handler(exception,code[0],&exc_state,&thread_state,&float_state);
|
||||
|
||||
/* Set the faulting thread's register contents..
|
||||
|
||||
See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_set_state.html. */
|
||||
if (thread_set_state (thread, MACH_FLOAT_STATE_FLAVOR,
|
||||
(natural_t *)&float_state, float_state_count)
|
||||
!= KERN_SUCCESS)
|
||||
{
|
||||
return KERN_FAILURE;
|
||||
}
|
||||
|
||||
if (thread_set_state (thread, MACH_THREAD_STATE_FLAVOR,
|
||||
(natural_t *)&thread_state, state_count)
|
||||
(natural_t *)&thread_state, thread_state_count)
|
||||
!= KERN_SUCCESS)
|
||||
{
|
||||
return KERN_FAILURE;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#include <ucontext.h>
|
||||
#include <machine/npx.h>
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
|
@ -9,6 +10,32 @@ inline static void *ucontext_stack_pointer(void *uap)
|
|||
return (void *)ucontext->uc_mcontext.mc_esp;
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387) {
|
||||
struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate);
|
||||
return x87->sv_env.en_sw;
|
||||
} else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) {
|
||||
struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
|
||||
return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr;
|
||||
} else
|
||||
return 0;
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
if (uap->uc_mcontext.mc_fpformat == _MC_FPFMT_387) {
|
||||
struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate);
|
||||
x87->sv_env.en_sw = 0;
|
||||
} else if (uap->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) {
|
||||
struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
|
||||
xmm->sv_env.en_sw = 0;
|
||||
xmm->sv_env.en_mxcsr &= 0xffffffc0;
|
||||
}
|
||||
}
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_eip)
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#include <ucontext.h>
|
||||
#include <machine/fpu.h>
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
|
@ -9,6 +10,26 @@ inline static void *ucontext_stack_pointer(void *uap)
|
|||
return (void *)ucontext->uc_mcontext.mc_rsp;
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) {
|
||||
struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
|
||||
return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr;
|
||||
} else
|
||||
return 0;
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM) {
|
||||
struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
|
||||
xmm->sv_env.en_sw = 0;
|
||||
xmm->sv_env.en_mxcsr &= 0xffffffc0;
|
||||
}
|
||||
}
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_rip)
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,6 +9,20 @@ inline static void *ucontext_stack_pointer(void *uap)
|
|||
return (void *)ucontext->uc_mcontext.gregs[7];
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
return ucontext->uc_mcontext.fpregs->swd
|
||||
| ucontext->uc_mcontext.fpregs->mxcsr;
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
ucontext->uc_mcontext.fpregs->swd = 0;
|
||||
ucontext->uc_mcontext.fpregs->mxcsr &= 0xffffffc0;
|
||||
}
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
(((ucontext_t *)(ucontext))->uc_mcontext.gregs[14])
|
||||
|
||||
|
|
|
|||
|
|
@ -9,6 +9,20 @@ inline static void *ucontext_stack_pointer(void *uap)
|
|||
return (void *)ucontext->uc_mcontext.gregs[15];
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
return ucontext->uc_mcontext.fpregs->swd
|
||||
| ucontext->uc_mcontext.fpregs->mxcsr;
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
ucontext_t *ucontext = (ucontext_t *)uap;
|
||||
ucontext->uc_mcontext.fpregs->swd = 0;
|
||||
ucontext->uc_mcontext.fpregs->mxcsr &= 0xffffffc0;
|
||||
}
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
(((ucontext_t *)(ucontext))->uc_mcontext.gregs[16])
|
||||
|
||||
|
|
|
|||
|
|
@ -18,28 +18,63 @@ Modified for Factor by Slava Pestov */
|
|||
#define MACH_EXC_STATE_TYPE ppc_exception_state_t
|
||||
#define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE
|
||||
#define MACH_EXC_STATE_COUNT PPC_EXCEPTION_STATE_COUNT
|
||||
|
||||
#define MACH_EXC_INTEGER_DIV EXC_PPC_ZERO_DIVIDE
|
||||
|
||||
#define MACH_THREAD_STATE_TYPE ppc_thread_state_t
|
||||
#define MACH_THREAD_STATE_FLAVOR PPC_THREAD_STATE
|
||||
#define MACH_THREAD_STATE_COUNT PPC_THREAD_STATE_COUNT
|
||||
|
||||
#define MACH_FLOAT_STATE_TYPE ppc_float_state_t
|
||||
#define MACH_FLOAT_STATE_FLAVOR PPC_FLOAT_STATE
|
||||
#define MACH_FLOAT_STATE_COUNT PPC_FLOAT_STATE_COUNT
|
||||
|
||||
#if __DARWIN_UNIX03
|
||||
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->__dar
|
||||
#define MACH_STACK_POINTER(thr_state) (thr_state)->__r1
|
||||
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->__srr0
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->__ss))
|
||||
|
||||
#define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__ss)
|
||||
#define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__fs)
|
||||
|
||||
#define FPSCR(float_state) (float_state)->__fpscr
|
||||
#else
|
||||
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->dar
|
||||
#define MACH_STACK_POINTER(thr_state) (thr_state)->r1
|
||||
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->srr0
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->ss))
|
||||
|
||||
#define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->ss)
|
||||
#define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->fs)
|
||||
|
||||
#define FPSCR(float_state) (float_state)->fpscr
|
||||
#endif
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(UAP_SS(ucontext))
|
||||
|
||||
inline static unsigned int mach_fpu_status(ppc_float_state_t *float_state)
|
||||
{
|
||||
return FPSCR(float_state);
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
return mach_fpu_status(UAP_FS(uap));
|
||||
}
|
||||
|
||||
inline static cell fix_stack_pointer(cell sp)
|
||||
{
|
||||
return sp;
|
||||
}
|
||||
|
||||
inline static void mach_clear_fpu_status(ppc_float_state_t *float_state)
|
||||
{
|
||||
FPSCR(float_state) &= 0x0007ffff;
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
mach_clear_fpu_status(UAP_FS(uap));
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -16,28 +16,68 @@ Modified for Factor by Slava Pestov */
|
|||
#define MACH_EXC_STATE_TYPE i386_exception_state_t
|
||||
#define MACH_EXC_STATE_FLAVOR i386_EXCEPTION_STATE
|
||||
#define MACH_EXC_STATE_COUNT i386_EXCEPTION_STATE_COUNT
|
||||
|
||||
#define MACH_EXC_INTEGER_DIV EXC_I386_DIV
|
||||
|
||||
#define MACH_THREAD_STATE_TYPE i386_thread_state_t
|
||||
#define MACH_THREAD_STATE_FLAVOR i386_THREAD_STATE
|
||||
#define MACH_THREAD_STATE_COUNT i386_THREAD_STATE_COUNT
|
||||
|
||||
#define MACH_FLOAT_STATE_TYPE i386_float_state_t
|
||||
#define MACH_FLOAT_STATE_FLAVOR i386_FLOAT_STATE
|
||||
#define MACH_FLOAT_STATE_COUNT i386_FLOAT_STATE_COUNT
|
||||
|
||||
#if __DARWIN_UNIX03
|
||||
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->__faultvaddr
|
||||
#define MACH_STACK_POINTER(thr_state) (thr_state)->__esp
|
||||
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->__eip
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->__ss))
|
||||
|
||||
#define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__ss)
|
||||
#define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__fs)
|
||||
|
||||
#define MXCSR(float_state) (float_state)->__fpu_mxcsr
|
||||
#define X87SW(float_state) (float_state)->__fpu_fsw
|
||||
#else
|
||||
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->faultvaddr
|
||||
#define MACH_STACK_POINTER(thr_state) (thr_state)->esp
|
||||
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->eip
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->ss))
|
||||
|
||||
#define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->ss)
|
||||
#define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->fs)
|
||||
|
||||
#define MXCSR(float_state) (float_state)->fpu_mxcsr
|
||||
#define X87SW(float_state) (float_state)->fpu_fsw
|
||||
#endif
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(UAP_SS(ucontext))
|
||||
|
||||
inline static unsigned int mach_fpu_status(i386_float_state_t *float_state)
|
||||
{
|
||||
unsigned short x87sw;
|
||||
memcpy(&x87sw, &X87SW(float_state), sizeof(x87sw));
|
||||
return MXCSR(float_state) | x87sw;
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
return mach_fpu_status(UAP_FS(uap));
|
||||
}
|
||||
|
||||
inline static cell fix_stack_pointer(cell sp)
|
||||
{
|
||||
return ((sp + 4) & ~15) - 4;
|
||||
}
|
||||
|
||||
inline static void mach_clear_fpu_status(i386_float_state_t *float_state)
|
||||
{
|
||||
MXCSR(float_state) &= 0xffffffc0;
|
||||
memset(&X87SW(float_state), 0, sizeof(X87SW(float_state)));
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
mach_clear_fpu_status(UAP_FS(uap));
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -16,28 +16,66 @@ Modified for Factor by Slava Pestov and Daniel Ehrenberg */
|
|||
#define MACH_EXC_STATE_TYPE x86_exception_state64_t
|
||||
#define MACH_EXC_STATE_FLAVOR x86_EXCEPTION_STATE64
|
||||
#define MACH_EXC_STATE_COUNT x86_EXCEPTION_STATE64_COUNT
|
||||
|
||||
#define MACH_EXC_INTEGER_DIV EXC_I386_DIV
|
||||
|
||||
#define MACH_THREAD_STATE_TYPE x86_thread_state64_t
|
||||
#define MACH_THREAD_STATE_FLAVOR x86_THREAD_STATE64
|
||||
#define MACH_THREAD_STATE_COUNT MACHINE_THREAD_STATE_COUNT
|
||||
|
||||
#define MACH_FLOAT_STATE_TYPE x86_float_state64_t
|
||||
#define MACH_FLOAT_STATE_FLAVOR x86_FLOAT_STATE64
|
||||
#define MACH_FLOAT_STATE_COUNT x86_FLOAT_STATE64_COUNT
|
||||
|
||||
#if __DARWIN_UNIX03
|
||||
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->__faultvaddr
|
||||
#define MACH_STACK_POINTER(thr_state) (thr_state)->__rsp
|
||||
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->__rip
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->__ss))
|
||||
#define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__ss)
|
||||
#define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__fs)
|
||||
|
||||
#define MXCSR(float_state) (float_state)->__fpu_mxcsr
|
||||
#define X87SW(float_state) (float_state)->__fpu_fsw
|
||||
#else
|
||||
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->faultvaddr
|
||||
#define MACH_STACK_POINTER(thr_state) (thr_state)->rsp
|
||||
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->rip
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->ss))
|
||||
#define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->ss)
|
||||
#define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->fs)
|
||||
|
||||
#define MXCSR(float_state) (float_state)->fpu_mxcsr
|
||||
#define X87SW(float_state) (float_state)->fpu_fsw
|
||||
#endif
|
||||
|
||||
#define UAP_PROGRAM_COUNTER(ucontext) \
|
||||
MACH_PROGRAM_COUNTER(UAP_SS(ucontext))
|
||||
|
||||
inline static unsigned int mach_fpu_status(x86_float_state64_t *float_state)
|
||||
{
|
||||
unsigned short x87sw;
|
||||
memcpy(&x87sw, &X87SW(float_state), sizeof(x87sw));
|
||||
return MXCSR(float_state) | x87sw;
|
||||
}
|
||||
|
||||
inline static unsigned int uap_fpu_status(void *uap)
|
||||
{
|
||||
return mach_fpu_status(UAP_FS(uap));
|
||||
}
|
||||
|
||||
inline static cell fix_stack_pointer(cell sp)
|
||||
{
|
||||
return ((sp + 8) & ~15) - 8;
|
||||
}
|
||||
|
||||
inline static void mach_clear_fpu_status(x86_float_state64_t *float_state)
|
||||
{
|
||||
MXCSR(float_state) &= 0xffffffc0;
|
||||
memset(&X87SW(float_state), 0, sizeof(X87SW(float_state)));
|
||||
}
|
||||
|
||||
inline static void uap_clear_fpu_status(void *uap)
|
||||
{
|
||||
mach_clear_fpu_status(UAP_FS(uap));
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -5,4 +5,7 @@ namespace factor
|
|||
|
||||
#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap))
|
||||
|
||||
static inline unsigned int uap_fpu_status(void *uap) { return 0; }
|
||||
static inline void uap_clear_fpu_status(void *uap) { }
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,4 +6,7 @@ namespace factor
|
|||
#define ucontext_stack_pointer(uap) \
|
||||
((void *)(((ucontext_t *)(uap))->uc_mcontext.__gregs[_REG_URSP]))
|
||||
|
||||
static inline unsigned int uap_fpu_status(void *uap) { return 0; }
|
||||
static inline void uap_clear_fpu_status(void *uap) { }
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -12,4 +12,7 @@ inline static void *openbsd_stack_pointer(void *uap)
|
|||
#define ucontext_stack_pointer openbsd_stack_pointer
|
||||
#define UAP_PROGRAM_COUNTER(uap) (((struct sigcontext*)(uap))->sc_eip)
|
||||
|
||||
static inline unsigned int uap_fpu_status(void *uap) { return 0; }
|
||||
static inline void uap_clear_fpu_status(void *uap) { }
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -12,4 +12,7 @@ inline static void *openbsd_stack_pointer(void *uap)
|
|||
#define ucontext_stack_pointer openbsd_stack_pointer
|
||||
#define UAP_PROGRAM_COUNTER(uap) (((struct sigcontext*)(uap))->sc_rip)
|
||||
|
||||
static inline unsigned int uap_fpu_status(void *uap) { return 0; }
|
||||
static inline void uap_clear_fpu_status(void *uap) { }
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -136,6 +136,8 @@ void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
|||
{
|
||||
signal_number = signal;
|
||||
signal_callstack_top = uap_stack_pointer(uap);
|
||||
signal_fpu_status = fpu_status(uap_fpu_status(uap));
|
||||
uap_clear_fpu_status(uap);
|
||||
UAP_PROGRAM_COUNTER(uap) =
|
||||
(siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF)
|
||||
? (cell)misc_signal_handler_impl
|
||||
|
|
|
|||
|
|
@ -34,6 +34,9 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
|||
case EXCEPTION_FLT_OVERFLOW:
|
||||
case EXCEPTION_FLT_STACK_CHECK:
|
||||
case EXCEPTION_FLT_UNDERFLOW:
|
||||
/* XXX MxCsr is not available in CONTEXT structure on x86.32 */
|
||||
signal_fpu_status = c->FloatSave.StatusWord;
|
||||
c->FloatSave.StatusWord = 0;
|
||||
c->EIP = (cell)fp_signal_handler_impl;
|
||||
break;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue