Merge branch 'master' of git://factorcode.org/git/factor
commit
45293cc7fb
|
@ -2,12 +2,19 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators fry generalizations
|
||||
io.encodings.ascii io.files io.files.temp io.launcher kernel
|
||||
locals make sequences system vocabs.parser words ;
|
||||
locals make sequences system vocabs.parser words io.directories
|
||||
io.pathnames ;
|
||||
IN: alien.inline.compiler
|
||||
|
||||
SYMBOL: C
|
||||
SYMBOL: C++
|
||||
|
||||
: inline-libs-directory ( -- path )
|
||||
"alien-inline-libs" resource-path dup make-directories ;
|
||||
|
||||
: inline-library-file ( name -- path )
|
||||
inline-libs-directory prepend-path ;
|
||||
|
||||
: library-suffix ( -- str )
|
||||
os {
|
||||
{ [ dup macosx? ] [ drop ".dylib" ] }
|
||||
|
@ -16,10 +23,7 @@ SYMBOL: C++
|
|||
} cond ;
|
||||
|
||||
: library-path ( str -- str' )
|
||||
'[
|
||||
"lib-" % current-vocab name>> %
|
||||
"-" % _ % library-suffix %
|
||||
] "" make temp-file ;
|
||||
'[ "lib" % _ % library-suffix % ] "" make temp-file ;
|
||||
|
||||
: src-suffix ( lang -- str )
|
||||
{
|
||||
|
|
|
@ -0,0 +1,211 @@
|
|||
! Copyright (C) 2009 Jeremy Hughes.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax kernel strings effects quotations ;
|
||||
IN: alien.inline
|
||||
|
||||
: $binding-note ( x -- )
|
||||
drop
|
||||
{ "This word requires that certain variables are correctly bound. "
|
||||
"Call " { $link POSTPONE: define-c-library } " to set them up." } print-element ;
|
||||
|
||||
HELP: ;C-LIBRARY
|
||||
{ $syntax ";C-LIBRARY" }
|
||||
{ $description "Writes, compiles, and links code generated since previous invocation of " { $link POSTPONE: C-LIBRARY: } "." }
|
||||
{ $see-also POSTPONE: compile-c-library } ;
|
||||
|
||||
HELP: C-FRAMEWORK:
|
||||
{ $syntax "C-FRAMEWORK: name" }
|
||||
{ $description "OS X only. Link to named framework. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
|
||||
{ $see-also POSTPONE: c-use-framework } ;
|
||||
|
||||
HELP: C-FUNCTION:
|
||||
{ $syntax "C-FUNCTION: return name ( args ... )\nbody\n;" }
|
||||
{ $description "Appends a function to the C library in scope and defines an FFI word that calls it." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: alien.inline prettyprint ;"
|
||||
"IN: cmath.ffi"
|
||||
""
|
||||
"C-LIBRARY: cmathlib"
|
||||
""
|
||||
"C-FUNCTION: int add ( int a, int b )"
|
||||
" return a + b;"
|
||||
";"
|
||||
""
|
||||
";C-LIBRARY"
|
||||
""
|
||||
"1 2 add ."
|
||||
"3" }
|
||||
}
|
||||
{ $see-also POSTPONE: define-c-function } ;
|
||||
|
||||
HELP: C-INCLUDE:
|
||||
{ $syntax "C-INCLUDE: name" }
|
||||
{ $description "Appends an include line to the C library in scope." }
|
||||
{ $see-also POSTPONE: c-include } ;
|
||||
|
||||
HELP: C-LIBRARY:
|
||||
{ $syntax "C-LIBRARY: name" }
|
||||
{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " syntax can be used after this word." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: alien.inline ;"
|
||||
"IN: rectangle.ffi"
|
||||
""
|
||||
"C-LIBRARY: rectlib"
|
||||
""
|
||||
"C-STRUCTURE: rectangle { \"int\" \"width\" } { \"int\" \"height\" } ;"
|
||||
""
|
||||
"C-FUNCTION: int area ( rectangle c )"
|
||||
" return c.width * c.height;"
|
||||
";"
|
||||
""
|
||||
";C-LIBRARY"
|
||||
"" }
|
||||
}
|
||||
{ $see-also POSTPONE: define-c-library } ;
|
||||
|
||||
HELP: C-LINK/FRAMEWORK:
|
||||
{ $syntax "C-LINK/FRAMEWORK: name" }
|
||||
{ $description "Equivalent to " { $link POSTPONE: C-FRAMEWORK: } " on OS X and " { $link POSTPONE: C-LINK: } " everywhere else." }
|
||||
{ $see-also POSTPONE: c-link-to/use-framework } ;
|
||||
|
||||
HELP: C-LINK:
|
||||
{ $syntax "C-LINK: name" }
|
||||
{ $description "Link to named library. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
|
||||
{ $see-also POSTPONE: c-link-to } ;
|
||||
|
||||
HELP: C-STRUCTURE:
|
||||
{ $syntax "C-STRUCTURE: name pairs ... ;" }
|
||||
{ $description "Like " { $snippet "C-STRUCT:" } " but also generates equivalent C code."}
|
||||
{ $see-also POSTPONE: define-c-struct } ;
|
||||
|
||||
HELP: C-TYPEDEF:
|
||||
{ $syntax "C-TYPEDEF: old new" }
|
||||
{ $description "Like " { $snippet "TYPEDEF:" } " but generates a C typedef statement too." }
|
||||
{ $see-also POSTPONE: define-c-typedef } ;
|
||||
|
||||
HELP: COMPILE-AS-C++
|
||||
{ $syntax "COMPILE-AS-C++" }
|
||||
{ $description "Insert this word anywhere between " { $link POSTPONE: C-LIBRARY: } " and " { $link POSTPONE: ;C-LIBRARY } " and the generated code will be treated as C++ with " { $snippet "extern \"C\"" } " prepended to each function prototype." } ;
|
||||
|
||||
HELP: DELETE-C-LIBRARY:
|
||||
{ $syntax "DELETE-C-LIBRARY: name" }
|
||||
{ $description "Deletes the shared library file corresponding to " { $snippet "name" } " . " }
|
||||
{ $notes
|
||||
{ $list
|
||||
{ "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " }
|
||||
"This word is mainly useful for unit tests."
|
||||
}
|
||||
}
|
||||
{ $see-also POSTPONE: delete-inline-library } ;
|
||||
|
||||
HELP: RAW-C:
|
||||
{ $syntax "RAW-C:" "body" ";" }
|
||||
{ $description "Insert a string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ;
|
||||
|
||||
CONSTANT: foo "abc"
|
||||
|
||||
HELP: compile-c-library
|
||||
{ $description "Writes, compiles, and links code generated since last invocation of " { $link POSTPONE: define-c-library } ". "
|
||||
"Also calls " { $snippet "add-library" } ". "
|
||||
"This word does nothing if the shared library is younger than the factor source file." }
|
||||
{ $notes $binding-note } ;
|
||||
|
||||
HELP: c-use-framework
|
||||
{ $values
|
||||
{ "str" string }
|
||||
}
|
||||
{ $description "OS X only. Adds " { $snippet "-framework name" } " to linker command." }
|
||||
{ $notes $binding-note }
|
||||
{ $see-also c-link-to c-link-to/use-framework } ;
|
||||
|
||||
HELP: define-c-function
|
||||
{ $values
|
||||
{ "function" "function name" } { "types" "a sequence of C types" } { "effect" effect } { "body" string }
|
||||
}
|
||||
{ $description "Defines a C function and a factor word which calls it." }
|
||||
{ $notes
|
||||
{ $list
|
||||
{ "The number of " { $snippet "types" } " must match the " { $snippet "in" } " count of the " { $snippet "effect" } "." }
|
||||
{ "There must be only one " { $snippet "out" } " element. It must be a legal C return type with dashes (-) instead of spaces." }
|
||||
$binding-note
|
||||
}
|
||||
}
|
||||
{ $see-also POSTPONE: define-c-function' } ;
|
||||
|
||||
HELP: define-c-function'
|
||||
{ $values
|
||||
{ "function" "function name" } { "effect" effect } { "body" string }
|
||||
}
|
||||
{ $description "Defines a C function and a factor word which calls it. See " { $link define-c-function } " for more information." }
|
||||
{ $notes
|
||||
{ $list
|
||||
{ "Each effect element must be a legal C type with dashes (-) instead of spaces. "
|
||||
"C argument names will be generated alphabetically, starting with " { $snippet "a" } "." }
|
||||
$binding-note
|
||||
}
|
||||
}
|
||||
{ $see-also define-c-function } ;
|
||||
|
||||
HELP: c-include
|
||||
{ $values
|
||||
{ "str" string }
|
||||
}
|
||||
{ $description "Appends an include line to the C library in scope." }
|
||||
{ $notes $binding-note } ;
|
||||
|
||||
HELP: define-c-library
|
||||
{ $values
|
||||
{ "name" string }
|
||||
}
|
||||
{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " words can be used after this one." } ;
|
||||
|
||||
HELP: c-link-to
|
||||
{ $values
|
||||
{ "str" string }
|
||||
}
|
||||
{ $description "Adds " { $snippet "-lname" } " to linker command." }
|
||||
{ $notes $binding-note }
|
||||
{ $see-also c-use-framework c-link-to/use-framework } ;
|
||||
|
||||
HELP: c-link-to/use-framework
|
||||
{ $values
|
||||
{ "str" string }
|
||||
}
|
||||
{ $description "Equivalent to " { $link c-use-framework } " on OS X and " { $link c-link-to } " everywhere else." }
|
||||
{ $notes $binding-note }
|
||||
{ $see-also c-link-to c-use-framework } ;
|
||||
|
||||
HELP: define-c-struct
|
||||
{ $values
|
||||
{ "name" string } { "fields" "type/name pairs" }
|
||||
}
|
||||
{ $description "Defines a C struct and factor words which operate on it." }
|
||||
{ $notes $binding-note } ;
|
||||
|
||||
HELP: define-c-typedef
|
||||
{ $values
|
||||
{ "old" "C type" } { "new" "C type" }
|
||||
}
|
||||
{ $description "Define C and factor typedefs." }
|
||||
{ $notes $binding-note } ;
|
||||
|
||||
HELP: delete-inline-library
|
||||
{ $values
|
||||
{ "name" string }
|
||||
}
|
||||
{ $description "Delete the shared library file corresponding to " { $snippet "name" } "." }
|
||||
{ $notes "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " } ;
|
||||
|
||||
HELP: with-c-library
|
||||
{ $values
|
||||
{ "name" string } { "quot" quotation }
|
||||
}
|
||||
{ $description "Calls " { $link define-c-library } ", then the quotation, then " { $link compile-c-library } ", then sets all variables bound by " { $snippet "define-c-library" } " to " { $snippet "f" } "." } ;
|
||||
|
||||
ARTICLE: "alien.inline" "Inline C"
|
||||
{ $vocab-link "alien.inline" }
|
||||
;
|
||||
|
||||
ABOUT: "alien.inline"
|
|
@ -6,7 +6,7 @@ generalizations grouping io.directories io.files
|
|||
io.files.info io.files.temp kernel lexer math math.order
|
||||
math.ranges multiline namespaces sequences source-files
|
||||
splitting strings system vocabs.loader vocabs.parser words
|
||||
alien.c-types alien.structs make parser ;
|
||||
alien.c-types alien.structs make parser continuations ;
|
||||
IN: alien.inline
|
||||
|
||||
<PRIVATE
|
||||
|
@ -15,6 +15,10 @@ SYMBOL: library-is-c++
|
|||
SYMBOL: compiler-args
|
||||
SYMBOL: c-strings
|
||||
|
||||
: cleanup-variables ( -- )
|
||||
{ c-library library-is-c++ compiler-args c-strings }
|
||||
[ off ] each ;
|
||||
|
||||
: function-types-effect ( -- function types effect )
|
||||
scan scan swap ")" parse-tokens
|
||||
[ "(" subseq? not ] filter swap parse-arglist ;
|
||||
|
@ -39,8 +43,8 @@ SYMBOL: c-strings
|
|||
: prototype-string' ( function types return -- str )
|
||||
[ dup arg-list ] <effect> prototype-string ;
|
||||
|
||||
: append-function-body ( prototype-str -- str )
|
||||
" {\n" append parse-here append "\n}\n" append ;
|
||||
: append-function-body ( prototype-str body -- str )
|
||||
[ swap % " {\n" % % "\n}\n" % ] "" make ;
|
||||
|
||||
: compile-library? ( -- ? )
|
||||
c-library get library-path dup exists? [
|
||||
|
@ -55,10 +59,13 @@ SYMBOL: c-strings
|
|||
compiler-args get
|
||||
c-strings get "\n" join
|
||||
c-library get compile-to-library ;
|
||||
|
||||
: c-library-name ( name -- name' )
|
||||
[ current-vocab name>> % "_" % % ] "" make ;
|
||||
PRIVATE>
|
||||
|
||||
: define-c-library ( name -- )
|
||||
c-library set
|
||||
c-library-name c-library set
|
||||
V{ } clone c-strings set
|
||||
V{ } clone compiler-args set ;
|
||||
|
||||
|
@ -66,25 +73,29 @@ PRIVATE>
|
|||
compile-library? [ compile-library ] when
|
||||
c-library get dup library-path "cdecl" add-library ;
|
||||
|
||||
: define-c-function ( function types effect -- )
|
||||
[ factor-function define-declared ] 3keep prototype-string
|
||||
append-function-body c-strings get push ;
|
||||
: define-c-function ( function types effect body -- )
|
||||
[
|
||||
[ factor-function define-declared ]
|
||||
[ prototype-string ] 3bi
|
||||
] dip append-function-body c-strings get push ;
|
||||
|
||||
: define-c-function' ( function effect -- )
|
||||
[ in>> ] keep [ factor-function define-declared ] 3keep
|
||||
out>> prototype-string'
|
||||
append-function-body c-strings get push ;
|
||||
: define-c-function' ( function effect body -- )
|
||||
[
|
||||
[ in>> ] keep
|
||||
[ factor-function define-declared ]
|
||||
[ out>> prototype-string' ] 3bi
|
||||
] dip append-function-body c-strings get push ;
|
||||
|
||||
: define-c-link ( str -- )
|
||||
: c-link-to ( str -- )
|
||||
"-l" prepend compiler-args get push ;
|
||||
|
||||
: define-c-framework ( str -- )
|
||||
: c-use-framework ( str -- )
|
||||
"-framework" swap compiler-args get '[ _ push ] bi@ ;
|
||||
|
||||
: define-c-link/framework ( str -- )
|
||||
os macosx? [ define-c-framework ] [ define-c-link ] if ;
|
||||
: c-link-to/use-framework ( str -- )
|
||||
os macosx? [ c-use-framework ] [ c-link-to ] if ;
|
||||
|
||||
: define-c-include ( str -- )
|
||||
: c-include ( str -- )
|
||||
"#include " prepend c-strings get push ;
|
||||
|
||||
: define-c-typedef ( old new -- )
|
||||
|
@ -93,38 +104,43 @@ PRIVATE>
|
|||
"" make c-strings get push
|
||||
] 2bi ;
|
||||
|
||||
: define-c-struct ( name vocab fields -- )
|
||||
[ define-struct ] [
|
||||
nip over
|
||||
: define-c-struct ( name fields -- )
|
||||
[ current-vocab swap define-struct ] [
|
||||
over
|
||||
[
|
||||
"typedef struct " % "_" % % " {\n" %
|
||||
[ first2 swap % " " % % ";\n" % ] each
|
||||
"} " % % ";\n" %
|
||||
] "" make c-strings get push
|
||||
] 3bi ;
|
||||
] 2bi ;
|
||||
|
||||
: delete-inline-library ( str -- )
|
||||
library-path dup exists? [ delete-file ] [ drop ] if ;
|
||||
: delete-inline-library ( name -- )
|
||||
c-library-name [ remove-library ]
|
||||
[ library-path dup exists? [ delete-file ] [ drop ] if ] bi ;
|
||||
|
||||
: with-c-library ( name quot -- )
|
||||
[ [ define-c-library ] dip call compile-c-library ]
|
||||
[ cleanup-variables ] [ ] cleanup ; inline
|
||||
|
||||
SYNTAX: C-LIBRARY: scan define-c-library ;
|
||||
|
||||
SYNTAX: COMPILE-AS-C++ t library-is-c++ set ;
|
||||
|
||||
SYNTAX: C-LINK: scan define-c-link ;
|
||||
SYNTAX: C-LINK: scan c-link-to ;
|
||||
|
||||
SYNTAX: C-FRAMEWORK: scan define-c-framework ;
|
||||
SYNTAX: C-FRAMEWORK: scan c-use-framework ;
|
||||
|
||||
SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ;
|
||||
SYNTAX: C-LINK/FRAMEWORK: scan c-link-to/use-framework ;
|
||||
|
||||
SYNTAX: C-INCLUDE: scan define-c-include ;
|
||||
SYNTAX: C-INCLUDE: scan c-include ;
|
||||
|
||||
SYNTAX: C-FUNCTION:
|
||||
function-types-effect define-c-function ;
|
||||
function-types-effect parse-here define-c-function ;
|
||||
|
||||
SYNTAX: C-TYPEDEF: scan scan define-c-typedef ;
|
||||
|
||||
SYNTAX: C-STRUCTURE:
|
||||
scan current-vocab parse-definition define-c-struct ;
|
||||
scan parse-definition define-c-struct ;
|
||||
|
||||
SYNTAX: ;C-LIBRARY compile-c-library ;
|
||||
|
||||
|
|
|
@ -26,7 +26,7 @@ M: word test-cfg
|
|||
] map ;
|
||||
|
||||
: insn. ( insn -- )
|
||||
tuple>array [ pprint bl ] each nl ;
|
||||
tuple>array but-last [ pprint bl ] each nl ;
|
||||
|
||||
: mr. ( mrs -- )
|
||||
[
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences
|
||||
USING: accessors kernel sequences namespaces assocs fry
|
||||
combinators.short-circuit
|
||||
compiler.cfg.linear-scan.live-intervals
|
||||
compiler.cfg.linear-scan.allocation.state ;
|
||||
|
@ -20,9 +20,16 @@ IN: compiler.cfg.linear-scan.allocation.coalescing
|
|||
[ avoids-inactive-intervals? ]
|
||||
} 1&& ;
|
||||
|
||||
: reuse-spill-slot ( old new -- )
|
||||
[ vreg>> spill-slots get at ] dip '[ _ vreg>> spill-slots get set-at ] when* ;
|
||||
|
||||
: reuse-register ( old new -- )
|
||||
reg>> >>reg drop ;
|
||||
|
||||
: (coalesce) ( old new -- )
|
||||
[ add-active ] [ [ delete-active ] [ add-handled ] bi ] bi* ;
|
||||
|
||||
: coalesce ( live-interval -- )
|
||||
dup copy-from>> active-interval
|
||||
[ [ add-active ] [ [ delete-active ] [ add-handled ] bi ] bi* ]
|
||||
[ reg>> >>reg drop ]
|
||||
2bi ;
|
||||
[ reuse-spill-slot ] [ reuse-register ] [ (coalesce) ] 2tri ;
|
||||
|
|
@ -17,7 +17,7 @@ ERROR: bad-live-ranges interval ;
|
|||
] [ drop ] if ;
|
||||
|
||||
: trim-before-ranges ( live-interval -- )
|
||||
[ ranges>> ] [ uses>> last ] bi
|
||||
[ ranges>> ] [ uses>> last 1 + ] bi
|
||||
[ '[ from>> _ <= ] filter-here ]
|
||||
[ swap last (>>to) ]
|
||||
2bi ;
|
||||
|
@ -38,10 +38,10 @@ ERROR: bad-live-ranges interval ;
|
|||
} 2cleave ;
|
||||
|
||||
: assign-spill ( live-interval -- )
|
||||
dup assign-spill-slot >>spill-to f >>split-next drop ;
|
||||
dup vreg>> assign-spill-slot >>spill-to f >>split-next drop ;
|
||||
|
||||
: assign-reload ( live-interval -- )
|
||||
dup assign-spill-slot >>reload-from drop ;
|
||||
dup vreg>> assign-spill-slot >>reload-from drop ;
|
||||
|
||||
: split-and-spill ( live-interval n -- before after )
|
||||
split-for-spill 2dup [ assign-spill ] [ assign-reload ] bi* ;
|
||||
|
|
|
@ -126,18 +126,8 @@ SYMBOL: spill-counts
|
|||
! Mapping from vregs to spill slots
|
||||
SYMBOL: spill-slots
|
||||
|
||||
DEFER: assign-spill-slot
|
||||
|
||||
: compute-spill-slot ( live-interval -- n )
|
||||
dup copy-from>>
|
||||
[ assign-spill-slot ]
|
||||
[ vreg>> reg-class>> next-spill-slot ] ?if ;
|
||||
|
||||
: assign-spill-slot ( live-interval -- n )
|
||||
dup vreg>> spill-slots get at [ ] [
|
||||
[ compute-spill-slot dup ] keep
|
||||
vreg>> spill-slots get set-at
|
||||
] ?if ;
|
||||
: assign-spill-slot ( vreg -- n )
|
||||
spill-slots get [ reg-class>> next-spill-slot ] cache ;
|
||||
|
||||
: init-allocator ( registers -- )
|
||||
registers set
|
||||
|
|
|
@ -107,7 +107,7 @@ SYMBOL: check-assignment?
|
|||
ERROR: overlapping-registers intervals ;
|
||||
|
||||
: check-assignment ( intervals -- )
|
||||
dup [ copy-from>> ] map sift [ vreg>> ] map '[ vreg>> _ member? not ] filter
|
||||
dup [ copy-from>> ] map sift '[ vreg>> _ member? not ] filter
|
||||
dup [ reg>> ] map all-unique? [ drop ] [ overlapping-registers ] if ;
|
||||
|
||||
: active-intervals ( n -- intervals )
|
||||
|
@ -150,7 +150,7 @@ ERROR: bad-live-values live-values ;
|
|||
|
||||
: begin-block ( bb -- )
|
||||
dup basic-block set
|
||||
dup block-from prepare-insn
|
||||
dup block-from activate-new-intervals
|
||||
[ [ live-in ] [ block-from ] bi compute-live-values ] keep
|
||||
register-live-ins get set-at ;
|
||||
|
||||
|
|
|
@ -82,9 +82,9 @@ check-numbering? on
|
|||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 1 }
|
||||
{ end 2 }
|
||||
{ uses V{ 0 1 } }
|
||||
{ ranges V{ T{ live-range f 0 1 } } }
|
||||
{ ranges V{ T{ live-range f 0 2 } } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
|
@ -107,9 +107,9 @@ check-numbering? on
|
|||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 0 }
|
||||
{ end 1 }
|
||||
{ uses V{ 0 } }
|
||||
{ ranges V{ T{ live-range f 0 0 } } }
|
||||
{ ranges V{ T{ live-range f 0 1 } } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
|
@ -132,9 +132,9 @@ check-numbering? on
|
|||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 0 }
|
||||
{ end 1 }
|
||||
{ uses V{ 0 } }
|
||||
{ ranges V{ T{ live-range f 0 0 } } }
|
||||
{ ranges V{ T{ live-range f 0 1 } } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
|
@ -1317,38 +1317,6 @@ USING: math.private ;
|
|||
allocate-registers drop
|
||||
] unit-test
|
||||
|
||||
! Spill slot liveness was computed incorrectly, leading to a FEP
|
||||
! early in bootstrap on x86-32
|
||||
[ t ] [
|
||||
[
|
||||
H{ } clone live-ins set
|
||||
H{ } clone live-outs set
|
||||
H{ } clone phi-live-ins set
|
||||
T{ basic-block
|
||||
{ id 12345 }
|
||||
{ instructions
|
||||
V{
|
||||
T{ ##gc f V int-regs 6 V int-regs 7 }
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##peek f V int-regs 2 D 2 }
|
||||
T{ ##peek f V int-regs 3 D 3 }
|
||||
T{ ##peek f V int-regs 4 D 4 }
|
||||
T{ ##peek f V int-regs 5 D 5 }
|
||||
T{ ##replace f V int-regs 0 D 1 }
|
||||
T{ ##replace f V int-regs 1 D 2 }
|
||||
T{ ##replace f V int-regs 2 D 3 }
|
||||
T{ ##replace f V int-regs 3 D 4 }
|
||||
T{ ##replace f V int-regs 4 D 5 }
|
||||
T{ ##replace f V int-regs 5 D 0 }
|
||||
}
|
||||
}
|
||||
} dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
|
||||
instructions>> first
|
||||
live-values>> assoc-empty?
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
T{ live-range f 0 10 }
|
||||
T{ live-range f 20 30 }
|
||||
|
@ -1802,7 +1770,8 @@ test-diamond
|
|||
2 get instructions>> first regs>> V int-regs 1 swap at assert=
|
||||
] unit-test
|
||||
|
||||
[ _copy ] [ 3 get instructions>> second class ] unit-test
|
||||
! Not until splitting is finished
|
||||
! [ _copy ] [ 3 get instructions>> second class ] unit-test
|
||||
|
||||
! Resolve pass; make sure the spilling is done correctly
|
||||
V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
|
||||
|
@ -2482,4 +2451,161 @@ V{
|
|||
7 get 9 get 1vector >>successors drop
|
||||
8 get 9 get 1vector >>successors drop
|
||||
|
||||
[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
|
||||
[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
! Fencepost error in assignment pass
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##compare-imm-branch f V int-regs 0 5 cc= }
|
||||
} 1 test-bb
|
||||
|
||||
V{ T{ ##branch } } 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##peek f V int-regs 2 D 0 }
|
||||
T{ ##replace f V int-regs 1 D 0 }
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##return }
|
||||
} 4 test-bb
|
||||
|
||||
test-diamond
|
||||
|
||||
[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
[ 0 ] [ 1 get instructions>> [ _spill? ] count ] unit-test
|
||||
|
||||
[ 1 ] [ 2 get instructions>> [ _spill? ] count ] unit-test
|
||||
|
||||
[ 1 ] [ 3 get instructions>> [ _spill? ] count ] unit-test
|
||||
|
||||
[ 1 ] [ 4 get instructions>> [ _reload? ] count ] unit-test
|
||||
|
||||
! Another test case for fencepost error in assignment pass
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##compare-imm-branch f V int-regs 0 5 cc= }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##peek f V int-regs 2 D 0 }
|
||||
T{ ##replace f V int-regs 1 D 0 }
|
||||
T{ ##replace f V int-regs 2 D 0 }
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##branch }
|
||||
} 3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##return }
|
||||
} 4 test-bb
|
||||
|
||||
test-diamond
|
||||
|
||||
[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
[ 0 ] [ 1 get instructions>> [ _spill? ] count ] unit-test
|
||||
|
||||
[ 1 ] [ 2 get instructions>> [ _spill? ] count ] unit-test
|
||||
|
||||
[ 1 ] [ 2 get instructions>> [ _reload? ] count ] unit-test
|
||||
|
||||
[ 0 ] [ 3 get instructions>> [ _spill? ] count ] unit-test
|
||||
|
||||
[ 0 ] [ 4 get instructions>> [ _reload? ] count ] unit-test
|
||||
|
||||
! GC check tests
|
||||
|
||||
! Spill slot liveness was computed incorrectly, leading to a FEP
|
||||
! early in bootstrap on x86-32
|
||||
[ t ] [
|
||||
[
|
||||
H{ } clone live-ins set
|
||||
H{ } clone live-outs set
|
||||
H{ } clone phi-live-ins set
|
||||
T{ basic-block
|
||||
{ id 12345 }
|
||||
{ instructions
|
||||
V{
|
||||
T{ ##gc f V int-regs 6 V int-regs 7 }
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##peek f V int-regs 2 D 2 }
|
||||
T{ ##peek f V int-regs 3 D 3 }
|
||||
T{ ##peek f V int-regs 4 D 4 }
|
||||
T{ ##peek f V int-regs 5 D 5 }
|
||||
T{ ##replace f V int-regs 0 D 1 }
|
||||
T{ ##replace f V int-regs 1 D 2 }
|
||||
T{ ##replace f V int-regs 2 D 3 }
|
||||
T{ ##replace f V int-regs 3 D 4 }
|
||||
T{ ##replace f V int-regs 4 D 5 }
|
||||
T{ ##replace f V int-regs 5 D 0 }
|
||||
}
|
||||
}
|
||||
} dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
|
||||
instructions>> first
|
||||
live-values>> assoc-empty?
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##replace f V int-regs 1 D 1 }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##gc f V int-regs 2 V int-regs 3 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##return }
|
||||
} 2 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 1vector >>successors drop
|
||||
|
||||
[ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
[ H{ { V int-regs 0 3 } } ] [ 1 get instructions>> first live-values>> ] unit-test
|
||||
|
||||
|
||||
|
||||
V{
|
||||
T{ ##peek f V int-regs 0 D 0 }
|
||||
T{ ##peek f V int-regs 1 D 1 }
|
||||
T{ ##compare-imm-branch f V int-regs 1 5 cc= }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##gc f V int-regs 2 V int-regs 3 }
|
||||
T{ ##replace f V int-regs 0 D 0 }
|
||||
T{ ##return }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##return }
|
||||
} 2 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
[ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
[ H{ { V int-regs 0 3 } } ] [ 1 get instructions>> first live-values>> ] unit-test
|
||||
|
|
|
@ -1,18 +1,23 @@
|
|||
! Copyright (C) 2009 Matthew Willis.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.libraries alien.syntax ;
|
||||
USING: alien.libraries alien.syntax system sequences combinators kernel ;
|
||||
|
||||
IN: llvm.core
|
||||
|
||||
<<
|
||||
|
||||
"LLVMSystem" "/usr/local/lib/libLLVMSystem.dylib" "cdecl" add-library
|
||||
: add-llvm-library ( name -- )
|
||||
dup
|
||||
{
|
||||
{ [ os macosx? ] [ "/usr/local/lib/lib" ".dylib" surround ] }
|
||||
{ [ os windows? ] [ ".dll" append ] }
|
||||
{ [ os unix? ] [ "lib" ".so" surround ] }
|
||||
} cond "cdecl" add-library ;
|
||||
|
||||
"LLVMSupport" "/usr/local/lib/libLLVMSupport.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMCore" "/usr/local/lib/libLLVMCore.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMBitReader" "/usr/local/lib/libLLVMBitReader.dylib" "cdecl" add-library
|
||||
"LLVMSystem" add-llvm-library
|
||||
"LLVMSupport" add-llvm-library
|
||||
"LLVMCore" add-llvm-library
|
||||
"LLVMBitReader" add-llvm-library
|
||||
|
||||
>>
|
||||
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -5,29 +5,18 @@ IN: llvm.engine
|
|||
|
||||
<<
|
||||
|
||||
"LLVMExecutionEngine" "/usr/local/lib/libLLVMExecutionEngine.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMTarget" "/usr/local/lib/libLLVMTarget.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMAnalysis" "/usr/local/lib/libLLVMAnalysis.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMipa" "/usr/local/lib/libLLVMipa.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMTransformUtils" "/usr/local/lib/libLLVMTransformUtils.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMScalarOpts" "/usr/local/lib/libLLVMScalarOpts.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMCodeGen" "/usr/local/lib/libLLVMCodeGen.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMAsmPrinter" "/usr/local/lib/libLLVMAsmPrinter.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMSelectionDAG" "/usr/local/lib/libLLVMSelectionDAG.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMX86CodeGen" "/usr/local/lib/libLLVMX86CodeGen.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMJIT" "/usr/local/lib/libLLVMJIT.dylib" "cdecl" add-library
|
||||
|
||||
"LLVMInterpreter.dylib" "/usr/local/lib/libLLVMInterpreter.dylib" "cdecl" add-library
|
||||
"LLVMExecutionEngine" add-llvm-library
|
||||
"LLVMTarget" add-llvm-library
|
||||
"LLVMAnalysis" add-llvm-library
|
||||
"LLVMipa" add-llvm-library
|
||||
"LLVMTransformUtils" add-llvm-library
|
||||
"LLVMScalarOpts" add-llvm-library
|
||||
"LLVMCodeGen" add-llvm-library
|
||||
"LLVMAsmPrinter" add-llvm-library
|
||||
"LLVMSelectionDAG" add-llvm-library
|
||||
"LLVMX86CodeGen" add-llvm-library
|
||||
"LLVMJIT" add-llvm-library
|
||||
"LLVMInterpreter" add-llvm-library
|
||||
|
||||
>>
|
||||
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -1 +1,2 @@
|
|||
bindings
|
||||
unportable
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1 @@
|
|||
unportable
|
Loading…
Reference in New Issue