--- /dev/null
+Jeremy Hughes
--- /dev/null
+Jeremy Hughes
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! 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 ;
+IN: alien.inline.compiler
+
+SYMBOL: C
+SYMBOL: C++
+
+: library-suffix ( -- str )
+ os {
+ { [ dup macosx? ] [ drop ".dylib" ] }
+ { [ dup unix? ] [ drop ".so" ] }
+ { [ dup windows? ] [ drop ".dll" ] }
+ } cond ;
+
+: library-path ( str -- str' )
+ '[
+ "lib-" % current-vocab name>> %
+ "-" % _ % library-suffix %
+ ] "" make temp-file ;
+
+: src-suffix ( lang -- str )
+ {
+ { C [ ".c" ] }
+ { C++ [ ".cpp" ] }
+ } case ;
+
+HOOK: compiler os ( lang -- str )
+
+M: word compiler ( lang -- str )
+ {
+ { C [ "gcc" ] }
+ { C++ [ "g++" ] }
+ } case ;
+
+M: openbsd compiler ( lang -- str )
+ {
+ { C [ "gcc" ] }
+ { C++ [ "eg++" ] }
+ } case ;
+
+HOOK: compiler-descr os ( lang -- descr )
+
+M: word compiler-descr compiler 1array ;
+M: macosx compiler-descr
+ call-next-method cpu x86.64?
+ [ { "-arch" "x86_64" } append ] when ;
+
+HOOK: link-descr os ( -- descr )
+
+M: word link-descr { "-shared" "-o" } ;
+M: macosx link-descr
+ { "-g" "-prebind" "-dynamiclib" "-o" }
+ cpu x86.64? [ { "-arch" "x86_64" } prepend ] when ;
+
+: link-command ( in out lang -- descr )
+ compiler-descr link-descr append prepend prepend ;
+
+:: compile-to-object ( lang contents name -- )
+ name ".o" append temp-file
+ contents name lang src-suffix append temp-file
+ [ ascii set-file-contents ] keep 2array
+ lang compiler-descr { "-fPIC" "-c" "-o" } append prepend
+ try-process ;
+
+:: link-object ( lang args name -- )
+ args name [ library-path ]
+ [ ".o" append temp-file ] bi 2array
+ lang link-command try-process ;
+
+:: compile-to-library ( lang args contents name -- )
+ lang contents name compile-to-object
+ lang args name link-object ;
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.inline alien.inline.private io.directories io.files
+kernel namespaces tools.test alien.c-types alien.structs ;
+IN: alien.inline.tests
+
+DELETE-C-LIBRARY: test
+C-LIBRARY: test
+
+C-FUNCTION: const-int add ( int a, int b )
+ return a + b;
+;
+
+C-TYPEDEF: double bigfloat
+
+C-FUNCTION: bigfloat smaller ( bigfloat a )
+ return a / 10;
+;
+
+C-STRUCTURE: rectangle
+ { "int" "width" }
+ { "int" "height" } ;
+
+C-FUNCTION: int area ( rectangle c )
+ return c.width * c.height;
+;
+
+;C-LIBRARY
+
+{ 2 1 } [ add ] must-infer-as
+[ 5 ] [ 2 3 add ] unit-test
+
+[ t ] [ "double" "bigfloat" [ resolve-typedef ] bi@ = ] unit-test
+{ 1 1 } [ smaller ] must-infer-as
+[ 1.0 ] [ 10 smaller ] unit-test
+
+[ t ] [ "rectangle" resolve-typedef struct-type? ] unit-test
+{ 1 1 } [ area ] must-infer-as
+[ 20 ] [
+ "rectangle" <c-object>
+ 4 over set-rectangle-width
+ 5 over set-rectangle-height
+ area
+] unit-test
+
+
+DELETE-C-LIBRARY: cpplib
+C-LIBRARY: cpplib
+
+COMPILE-AS-C++
+
+C-INCLUDE: <string>
+
+C-FUNCTION: const-char* hello ( )
+ std::string s("hello world");
+ return s.c_str();
+;
+
+;C-LIBRARY
+
+{ 0 1 } [ hello ] must-infer-as
+[ "hello world" ] [ hello ] unit-test
+
+
+DELETE-C-LIBRARY: compile-error
+C-LIBRARY: compile-error
+
+C-FUNCTION: char* breakme ( )
+ return not a string;
+;
+
+<< [ compile-c-library ] must-fail >>
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.inline.compiler alien.inline.types
+alien.libraries alien.parser arrays assocs effects fry
+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 ;
+IN: alien.inline
+
+<PRIVATE
+SYMBOL: c-library
+SYMBOL: library-is-c++
+SYMBOL: compiler-args
+SYMBOL: c-strings
+
+: function-types-effect ( -- function types effect )
+ scan scan swap ")" parse-tokens
+ [ "(" subseq? not ] filter swap parse-arglist ;
+
+: arg-list ( types -- params )
+ CHAR: a swap length CHAR: a + [a,b]
+ [ 1string ] map ;
+
+: factor-function ( function types effect -- word quot effect )
+ annotate-effect [ c-library get ] 3dip
+ [ [ factorize-type ] map ] dip
+ types-effect>params-return factorize-type -roll
+ concat make-function ;
+
+: prototype-string ( function types effect -- str )
+ [ [ cify-type ] map ] dip
+ types-effect>params-return cify-type -rot
+ [ " " join ] map ", " join
+ "(" prepend ")" append 3array " " join
+ library-is-c++ get [ "extern \"C\" " prepend ] when ;
+
+: 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 ;
+
+: compile-library? ( -- ? )
+ c-library get library-path dup exists? [
+ file get [
+ path>>
+ [ file-info modified>> ] bi@ <=> +lt+ =
+ ] [ drop t ] if*
+ ] [ drop t ] if ;
+
+: compile-library ( -- )
+ library-is-c++ get [ C++ ] [ C ] if
+ compiler-args get
+ c-strings get "\n" join
+ c-library get compile-to-library ;
+PRIVATE>
+
+: define-c-library ( name -- )
+ c-library set
+ V{ } clone c-strings set
+ V{ } clone compiler-args set ;
+
+: compile-c-library ( -- )
+ 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 effect -- )
+ [ in>> ] keep [ factor-function define-declared ] 3keep
+ out>> prototype-string'
+ append-function-body c-strings get push ;
+
+: define-c-link ( str -- )
+ "-l" prepend compiler-args get push ;
+
+: define-c-framework ( str -- )
+ "-framework" swap compiler-args get '[ _ push ] bi@ ;
+
+: define-c-link/framework ( str -- )
+ os macosx? [ define-c-framework ] [ define-c-link ] if ;
+
+: define-c-include ( str -- )
+ "#include " prepend c-strings get push ;
+
+: define-c-typedef ( old new -- )
+ [ typedef ] [
+ [ swap "typedef " % % " " % % ";" % ]
+ "" make c-strings get push
+ ] 2bi ;
+
+: define-c-struct ( name vocab fields -- )
+ [ define-struct ] [
+ nip over
+ [
+ "typedef struct " % "_" % % " {\n" %
+ [ first2 swap % " " % % ";\n" % ] each
+ "} " % % ";\n" %
+ ] "" make c-strings get push
+ ] 3bi ;
+
+: delete-inline-library ( str -- )
+ library-path dup exists? [ delete-file ] [ drop ] if ;
+
+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-FRAMEWORK: scan define-c-framework ;
+
+SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ;
+
+SYNTAX: C-INCLUDE: scan define-c-include ;
+
+SYNTAX: C-FUNCTION:
+ function-types-effect define-c-function ;
+
+SYNTAX: C-TYPEDEF: scan scan define-c-typedef ;
+
+SYNTAX: C-STRUCTURE:
+ scan current-vocab parse-definition define-c-struct ;
+
+SYNTAX: ;C-LIBRARY compile-c-library ;
+
+SYNTAX: DELETE-C-LIBRARY: scan delete-inline-library ;
+
+SYNTAX: RAW-C:
+ [ "\n" % parse-here % "\n" % c-strings get push ] "" make ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types assocs combinators.short-circuit
+continuations effects fry kernel math memoize sequences
+splitting ;
+IN: alien.inline.types
+
+: factorize-type ( str -- str' )
+ "const-" ?head drop
+ "unsigned-" ?head [ "u" prepend ] when
+ "long-" ?head [ "long" prepend ] when ;
+
+: cify-type ( str -- str' )
+ { { CHAR: - CHAR: space } } substitute ;
+
+: const-type? ( str -- ? )
+ "const-" head? ;
+
+MEMO: resolved-primitives ( -- seq )
+ primitive-types [ resolve-typedef ] map ;
+
+: primitive-type? ( type -- ? )
+ [
+ factorize-type resolve-typedef [ resolved-primitives ] dip
+ '[ _ = ] any?
+ ] [ 2drop f ] recover ;
+
+: pointer? ( type -- ? )
+ [ "*" tail? ] [ "&" tail? ] bi or ;
+
+: type-sans-pointer ( type -- type' )
+ [ '[ _ = ] "*&" swap any? ] trim-tail ;
+
+: pointer-to-primitive? ( type -- ? )
+ { [ pointer? ] [ type-sans-pointer primitive-type? ] } 1&& ;
+
+: types-effect>params-return ( types effect -- params return )
+ [ in>> zip ]
+ [ nip out>> dup length 0 > [ first ] [ drop "void" ] if ]
+ 2bi ;
+
+: annotate-effect ( types effect -- types effect' )
+ [ in>> ] [ out>> ] bi [
+ zip
+ [ over pointer-to-primitive? [ ">" prepend ] when ]
+ assoc-map unzip
+ ] dip <effect> ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.syntax assocs help.markup
-help.syntax io.backend kernel namespaces ;
+help.syntax io.backend kernel namespaces strings ;
IN: alien.libraries
HELP: <library>
{ $description "A global hashtable that keeps a list of open libraries. Use the " { $link add-library } " word to construct a library and add it with a single call." } ;
HELP: library
-{ $values { "name" "a string" } { "library" assoc } }
+{ $values { "name" string } { "library" assoc } }
{ $description "Looks up a library by its logical name. The library object is a hashtable with the following keys:"
{ $list
{ { $snippet "name" } " - the full path of the C library binary" }
{ $description "Closes a DLL handle created by " { $link dlopen } ". This word might not be implemented on all platforms." } ;
HELP: load-library
-{ $values { "name" "a string" } { "dll" "a DLL handle" } }
+{ $values { "name" string } { "dll" "a DLL handle" } }
{ $description "Loads a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } ". If the library is already loaded, returns the existing handle." } ;
HELP: add-library
-{ $values { "name" "a string" } { "path" "a string" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } }
+{ $values { "name" string } { "path" string } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } }
{ $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } "and the specified ABI." }
{ $notes "Because the entire source file is parsed before top-level forms are executed, " { $link add-library } " cannot be used in the same file as " { $link POSTPONE: FUNCTION: } " definitions from that library. The " { $link add-library } " call will happen too late, after compilation, and the alien calls will not work."
$nl
}
"Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
+HELP: remove-library
+{ $values { "name" string } }
+{ $description "Unloads a library and removes it from the internal list of libraries. The " { $snippet "name" } " parameter should be a name that was previously passed to " { $link add-library } ". If no library with that name exists, this word does nothing." } ;
+
ARTICLE: "loading-libs" "Loading native libraries"
"Before calling a C library, you must associate its path name on disk with a logical name which Factor uses to identify the library:"
{ $subsection add-library }
+{ $subsection remove-library }
"Once a library has been defined, you can try loading it to see if the path name is correct:"
{ $subsection load-library }
"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;
--- /dev/null
+IN: alien.libraries.tests
+USING: alien.libraries alien.syntax tools.test kernel ;
+
+[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
+
+[ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
+
+[ ] [ "doesnotexist" dlopen dlclose ] unit-test
+
+[ "fdasfsf" dll-valid? drop ] must-fail
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.strings assocs io.backend kernel namespaces ;
+USING: accessors alien alien.strings assocs io.backend
+kernel namespaces destructors ;
IN: alien.libraries
: dlopen ( path -- dll ) native-string>alien (dlopen) ;
: load-library ( name -- dll )
library dup [ dll>> ] when ;
-: add-library ( name path abi -- )
- <library> swap libraries get set-at ;
\ No newline at end of file
+M: dll dispose dlclose ;
+
+M: library dispose dll>> [ dispose ] when* ;
+
+: remove-library ( name -- )
+ libraries get delete-at* [ dispose ] [ drop ] if ;
+
+: add-library ( name path abi -- )
+ <library> swap libraries get [ delete-at ] [ set-at ] 2bi ;
\ No newline at end of file
}
"C structure objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
$nl
-"Arrays of C structures can be created by calling " { $link <c-array> } " or " { $link malloc-array } ". Elements can be read and written using words named " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } "; these words are automatically generated by " { $link POSTPONE: C-STRUCT: } "." ;
+"Arrays of C structures can be created with the " { $vocab-link "struct-arrays" } " vocabulary." ;
ARTICLE: "c-unions" "C unions"
"A " { $snippet "union" } " in C defines a type large enough to hold its largest member. This is usually used to allocate a block of memory which can hold one of several types of values."
{ $subsection POSTPONE: C-UNION: }
"C union objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
$nl
-"Arrays of C unions can be created by calling " { $link <c-array> } " or " { $link malloc-array } ". Elements can be read and written using words named " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } "; these words are automatically generated by " { $link POSTPONE: C-UNION: } "." ;
+"Arrays of C unions can be created with the " { $vocab-link "struct-arrays" } " vocabulary." ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
--- /dev/null
+IN: bit-sets.tests
+USING: bit-sets tools.test bit-arrays ;
+
+[ ?{ t f t f t f } ] [
+ ?{ t f f f t f }
+ ?{ f f t f t f } bit-set-union
+] unit-test
+
+[ ?{ f f f f t f } ] [
+ ?{ t f f f t f }
+ ?{ f f t f t f } bit-set-intersect
+] unit-test
+
+[ ?{ t f t f f f } ] [
+ ?{ t t t f f f }
+ ?{ f t f f t t } bit-set-diff
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences byte-arrays bit-arrays math hints ;
+IN: bit-sets
+
+<PRIVATE
+
+: bit-set-map ( seq1 seq2 quot -- seq )
+ [ 2drop length>> ]
+ [
+ [
+ [ [ length ] bi@ assert= ]
+ [ [ underlying>> ] bi@ ] 2bi
+ ] dip 2map
+ ] 3bi bit-array boa ; inline
+
+PRIVATE>
+
+: bit-set-union ( seq1 seq2 -- seq ) [ bitor ] bit-set-map ;
+
+HINTS: bit-set-union bit-array bit-array ;
+
+: bit-set-intersect ( seq1 seq2 -- seq ) [ bitand ] bit-set-map ;
+
+HINTS: bit-set-intersect bit-array bit-array ;
+
+: bit-set-diff ( seq1 seq2 -- seq ) [ bitnot bitand ] bit-set-map ;
+
+HINTS: bit-set-diff bit-array bit-array ;
\ No newline at end of file
--- /dev/null
+Efficient bitwise operations on bit arrays
{ $description "The class of resizable bit vectors. See " { $link "bit-vectors" } " for information." } ;\r
\r
HELP: <bit-vector>\r
-{ $values { "n" "a positive integer specifying initial capacity" } { "bit-vector" bit-vector } }\r
+{ $values { "capacity" "a positive integer specifying initial capacity" } { "vector" bit-vector } }\r
{ $description "Creates a new bit vector that can hold " { $snippet "n" } " bits before resizing." } ;\r
\r
HELP: >bit-vector\r
-{ $values { "seq" "a sequence" } { "bit-vector" bit-vector } }\r
+{ $values { "seq" "a sequence" } { "vector" bit-vector } }\r
{ $description "Outputs a freshly-allocated bit vector with the same elements as a given sequence." } ;\r
\r
HELP: ?V{\r
-! Copyright (C) 2008 Slava Pestov.\r
+! Copyright (C) 2008, 2009 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: arrays kernel kernel.private math sequences\r
sequences.private growable bit-arrays prettyprint.custom\r
-parser accessors ;\r
+parser accessors vectors.functor classes.parser ;\r
IN: bit-vectors\r
\r
-TUPLE: bit-vector\r
-{ underlying bit-array initial: ?{ } }\r
-{ length array-capacity } ;\r
-\r
-: <bit-vector> ( n -- bit-vector )\r
- <bit-array> 0 bit-vector boa ; inline\r
-\r
-: >bit-vector ( seq -- bit-vector )\r
- T{ bit-vector f ?{ } 0 } clone-like ;\r
-\r
-M: bit-vector like\r
- drop dup bit-vector? [\r
- dup bit-array?\r
- [ dup length bit-vector boa ] [ >bit-vector ] if\r
- ] unless ;\r
-\r
-M: bit-vector new-sequence\r
- drop [ <bit-array> ] [ >fixnum ] bi bit-vector boa ;\r
-\r
-M: bit-vector equal?\r
- over bit-vector? [ sequence= ] [ 2drop f ] if ;\r
-\r
-M: bit-array new-resizable drop <bit-vector> ;\r
-\r
-INSTANCE: bit-vector growable\r
+<< "bit-vector" create-class-in \ bit-array \ <bit-array> define-vector >>\r
\r
SYNTAX: ?V{ \ } [ >bit-vector ] parse-literal ;\r
\r
+M: bit-vector contract 2drop ;\r
M: bit-vector >pprint-sequence ;\r
M: bit-vector pprint-delims drop \ ?V{ \ } ;\r
M: bit-vector pprint* pprint-object ;\r
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel splitting grouping math sequences namespaces make
-io.binary math.bitwise checksums checksums.common
-sbufs strings combinators.smart math.ranges fry combinators
-accessors locals checksums.stream multiline literals
-generalizations ;
+USING: accessors checksums checksums.common checksums.stream
+combinators combinators.smart fry generalizations grouping
+io.binary kernel literals locals make math math.bitwise
+math.ranges multiline namespaces sbufs sequences
+sequences.private splitting strings ;
IN: checksums.sha
SINGLETON: sha1
: prepare-M-256 ( n seq -- )
{
- [ [ 16 - ] dip nth ]
- [ [ 15 - ] dip nth s0-256 ]
- [ [ 7 - ] dip nth ]
- [ [ 2 - ] dip nth s1-256 w+ w+ w+ ]
+ [ [ 16 - ] dip nth-unsafe ]
+ [ [ 15 - ] dip nth-unsafe s0-256 ]
+ [ [ 7 - ] dip nth-unsafe ]
+ [ [ 2 - ] dip nth-unsafe s1-256 w+ w+ w+ ]
[ ]
- } 2cleave set-nth ; inline
+ } 2cleave set-nth-unsafe ; inline
: prepare-M-512 ( n seq -- )
{
- [ [ 16 - ] dip nth ]
- [ [ 15 - ] dip nth s0-512 ]
- [ [ 7 - ] dip nth ]
- [ [ 2 - ] dip nth s1-512 w+ w+ w+ ]
+ [ [ 16 - ] dip nth-unsafe ]
+ [ [ 15 - ] dip nth-unsafe s0-512 ]
+ [ [ 7 - ] dip nth-unsafe ]
+ [ [ 2 - ] dip nth-unsafe s1-512 w+ w+ w+ ]
[ ]
- } 2cleave set-nth ; inline
+ } 2cleave set-nth-unsafe ; inline
: ch ( x y z -- x' )
[ bitxor bitand ] keep bitxor ; inline
GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
:: T1-256 ( n M H sha2 -- T1 )
- n M nth
- n sha2 K>> nth +
+ n M nth-unsafe
+ n sha2 K>> nth-unsafe +
e H slice3 ch w+
- e H nth S1-256 w+
- h H nth w+ ; inline
+ e H nth-unsafe S1-256 w+
+ h H nth-unsafe w+ ; inline
: T2-256 ( H -- T2 )
- [ a swap nth S0-256 ]
+ [ a swap nth-unsafe S0-256 ]
[ a swap slice3 maj w+ ] bi ; inline
:: T1-512 ( n M H sha2 -- T1 )
- n M nth
- n sha2 K>> nth +
+ n M nth-unsafe
+ n sha2 K>> nth-unsafe +
e H slice3 ch w+
- e H nth S1-512 w+
- h H nth w+ ; inline
+ e H nth-unsafe S1-512 w+
+ h H nth-unsafe w+ ; inline
: T2-512 ( H -- T2 )
- [ a swap nth S0-512 ]
+ [ a swap nth-unsafe S0-512 ]
[ a swap slice3 maj w+ ] bi ; inline
: update-H ( T1 T2 H -- )
- h g pick exchange
- g f pick exchange
- f e pick exchange
- pick d pick nth w+ e pick set-nth
- d c pick exchange
- c b pick exchange
- b a pick exchange
- [ w+ a ] dip set-nth ; inline
+ h g pick exchange-unsafe
+ g f pick exchange-unsafe
+ f e pick exchange-unsafe
+ pick d pick nth-unsafe w+ e pick set-nth-unsafe
+ d c pick exchange-unsafe
+ c b pick exchange-unsafe
+ b a pick exchange-unsafe
+ [ w+ a ] dip set-nth-unsafe ; inline
: prepare-message-schedule ( seq sha2 -- w-seq )
[ word-size>> <sliced-groups> [ be> ] map ]
[ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;
: seq>byte-array ( seq n -- string )
- '[ _ >be ] map B{ } join ;
+ '[ _ >be ] map B{ } concat-as ;
: sha1>checksum ( sha2 -- bytes )
H>> 4 seq>byte-array ;
drop
[ <sha-256-state> ] dip add-checksum-stream get-checksum ;
-
-
: sha1-W ( t seq -- )
{
- [ [ 3 - ] dip nth ]
- [ [ 8 - ] dip nth bitxor ]
- [ [ 14 - ] dip nth bitxor ]
- [ [ 16 - ] dip nth bitxor 1 bitroll-32 ]
+ [ [ 3 - ] dip nth-unsafe ]
+ [ [ 8 - ] dip nth-unsafe bitxor ]
+ [ [ 14 - ] dip nth-unsafe bitxor ]
+ [ [ 16 - ] dip nth-unsafe bitxor 1 bitroll-32 ]
[ ]
- } 2cleave set-nth ;
+ } 2cleave set-nth-unsafe ;
: prepare-sha1-message-schedule ( seq -- w-seq )
4 <sliced-groups> [ be> ] map
} case ;
:: inner-loop ( n H W K -- temp )
- a H nth :> A
- b H nth :> B
- c H nth :> C
- d H nth :> D
- e H nth :> E
+ a H nth-unsafe :> A
+ b H nth-unsafe :> B
+ c H nth-unsafe :> C
+ d H nth-unsafe :> D
+ e H nth-unsafe :> E
[
A 5 bitroll-32
E
- n K nth
+ n K nth-unsafe
- n W nth
+ n W nth-unsafe
] sum-outputs 32 bits ;
:: process-sha1-chunk ( bytes H W K state -- )
80 [
H W K inner-loop
- d H nth e H set-nth
- c H nth d H set-nth
- b H nth 30 bitroll-32 c H set-nth
- a H nth b H set-nth
- a H set-nth
+ d H nth-unsafe e H set-nth-unsafe
+ c H nth-unsafe d H set-nth-unsafe
+ b H nth-unsafe 30 bitroll-32 c H set-nth-unsafe
+ a H nth-unsafe b H set-nth-unsafe
+ a H set-nth-unsafe
] each
state [ H [ w+ ] 2map ] change-H drop ; inline
--- /dev/null
+IN: compiler.cfg.branch-folding.tests
+USING: compiler.cfg.branch-folding compiler.cfg.instructions
+compiler.cfg compiler.cfg.registers compiler.cfg.debugger
+arrays compiler.cfg.phi-elimination compiler.cfg.dce
+compiler.cfg.predecessors kernel accessors assocs
+sequences classes namespaces tools.test cpu.architecture ;
+
+V{ T{ ##branch } } 0 test-bb
+
+V{
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##compare-branch f V int-regs 0 V int-regs 0 cc< }
+} 1 test-bb
+
+V{
+ T{ ##load-immediate f V int-regs 1 1 }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##load-immediate f V int-regs 2 2 }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##phi f V int-regs 3 { } }
+ T{ ##replace f V int-regs 3 D 0 }
+ T{ ##return }
+} 4 test-bb
+
+4 get instructions>> first
+2 get V int-regs 1 2array
+3 get V int-regs 2 2array 2array
+>>inputs drop
+
+test-diamond
+
+[ ] [ cfg new 0 get >>entry fold-branches compute-predecessors eliminate-phis drop ] unit-test
+
+[ 1 ] [ 1 get successors>> length ] unit-test
+[ t ] [ 1 get successors>> first 3 get eq? ] unit-test
+
+[ T{ ##copy f V int-regs 3 V int-regs 2 } ] [ 3 get instructions>> second ] unit-test
+[ 2 ] [ 4 get instructions>> length ] unit-test
+
+V{
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##branch }
+} 0 test-bb
+
+V{
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##compare-branch f V int-regs 1 V int-regs 1 cc< }
+} 1 test-bb
+
+V{
+ T{ ##copy f V int-regs 2 V int-regs 0 }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##phi f V int-regs 3 V{ } }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##replace f V int-regs 3 D 0 }
+ T{ ##return }
+} 4 test-bb
+
+1 get V int-regs 1 2array
+2 get V int-regs 0 2array 2array 3 get instructions>> first (>>inputs)
+
+test-diamond
+
+[ ] [
+ cfg new 0 get >>entry
+ compute-predecessors
+ fold-branches
+ compute-predecessors
+ eliminate-dead-code
+ drop
+] unit-test
+
+[ 1 ] [ 3 get instructions>> first inputs>> assoc-size ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit kernel sequences vectors
+compiler.cfg.instructions compiler.cfg.rpo ;
+IN: compiler.cfg.branch-folding
+
+! Fold comparisons where both inputs are the same. Predecessors must be
+! recomputed after this
+
+: fold-branch? ( bb -- ? )
+ instructions>> last {
+ [ ##compare-branch? ]
+ [ [ src1>> ] [ src2>> ] bi = ]
+ } 1&& ;
+
+: chosen-successor ( bb -- succ )
+ [ instructions>> last cc>> { cc= cc<= cc>= } memq? 0 1 ? ]
+ [ successors>> ]
+ bi nth ;
+
+: fold-branch ( bb -- )
+ dup chosen-successor 1vector >>successors
+ instructions>> [ pop* ] [ [ \ ##branch new-insn ] dip push ] bi ;
+
+: fold-branches ( cfg -- cfg' )
+ dup [
+ dup fold-branch?
+ [ fold-branch ] [ drop ] if
+ ] each-basic-block
+ f >>post-order ;
\ No newline at end of file
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit kernel math sequences
+compiler.cfg.def-use compiler.cfg compiler.cfg.rpo ;
+IN: compiler.cfg.branch-splitting
+
+! Predecessors must be recomputed after this
+
+: split-branch-for ( bb predecessor -- )
+ [
+ [
+ <basic-block>
+ swap
+ [ instructions>> [ clone ] map >>instructions ]
+ [ successors>> clone >>successors ]
+ bi
+ ] keep
+ ] dip
+ [ [ 2dup eq? [ 2drop ] [ 2nip ] if ] with with map ] change-successors
+ drop ;
+
+: split-branch ( bb -- )
+ dup predecessors>> [ split-branch-for ] with each ;
+
+: split-branches? ( bb -- ? )
+ {
+ [ successors>> empty? ]
+ [ predecessors>> length 1 > ]
+ [ instructions>> [ defs-vregs ] any? not ]
+ [ instructions>> [ temp-vregs ] any? not ]
+ } 1&& ;
+
+: split-branches ( cfg -- cfg' )
+ dup [
+ dup split-branches? [ split-branch ] [ drop ] if
+ ] each-basic-block
+ f >>post-order ;
[ 3 fixnum+fast ]
[ fixnum*fast ]
[ 3 fixnum*fast ]
+ [ 3 swap fixnum*fast ]
[ fixnum-shift-fast ]
[ 10 fixnum-shift-fast ]
[ -10 fixnum-shift-fast ]
[ 0 fixnum-shift-fast ]
+ [ 10 swap fixnum-shift-fast ]
+ [ -10 swap fixnum-shift-fast ]
+ [ 0 swap fixnum-shift-fast ]
[ fixnum-bitnot ]
[ eq? ]
[ "hi" eq? ]
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators hashtables kernel
math fry namespaces make sequences words byte-arrays
compiler.cfg
compiler.cfg.hats
compiler.cfg.stacks
-compiler.cfg.iterator
compiler.cfg.utilities
compiler.cfg.registers
compiler.cfg.intrinsics
SYMBOL: current-word
SYMBOL: current-label
SYMBOL: loops
-SYMBOL: first-basic-block
-
-! Basic block after prologue, makes recursion faster
-SYMBOL: current-label-start
: add-procedure ( -- )
basic-block get current-word get current-label get
: with-cfg-builder ( nodes word label quot -- )
'[ begin-procedure @ ] with-scope ; inline
-GENERIC: emit-node ( node -- next )
+GENERIC: emit-node ( node -- )
: check-basic-block ( node -- node' )
basic-block get [ drop f ] unless ; inline
: emit-nodes ( nodes -- )
- [ current-node emit-node check-basic-block ] iterate-nodes ;
+ [ basic-block get [ emit-node ] [ drop ] if ] each ;
: begin-word ( -- )
- #! We store the basic block after the prologue as a loop
- #! labeled by the current word, so that self-recursive
- #! calls can skip an epilogue/prologue.
##prologue
##branch
- begin-basic-block
- basic-block get first-basic-block set ;
+ begin-basic-block ;
: (build-cfg) ( nodes word label -- )
[
begin-word
- V{ } clone node-stack set
emit-nodes
] with-cfg-builder ;
] with-variable
] keep ;
-: local-recursive-call ( basic-block -- next )
+: emit-loop-call ( basic-block -- )
##branch
basic-block get successors>> push
- stop-iterating ;
+ basic-block off ;
-: emit-call ( word height -- next )
- {
- { [ over loops get key? ] [ drop loops get at local-recursive-call ] }
- { [ terminate-call? ] [ ##call stop-iterating ] }
- { [ tail-call? not ] [ ##call ##branch begin-basic-block iterate-next ] }
- { [ dup current-label get eq? ] [ 2drop first-basic-block get local-recursive-call ] }
- [ drop ##epilogue ##jump stop-iterating ]
- } cond ;
+: emit-call ( word -- )
+ dup loops get key?
+ [ loops get at emit-loop-call ]
+ [ ##call ##branch begin-basic-block ]
+ if ;
! #recursive
-: recursive-height ( #recursive -- n )
- [ label>> return>> in-d>> length ] [ in-d>> length ] bi - ;
-
-: emit-recursive ( #recursive -- next )
- [ [ label>> id>> ] [ recursive-height ] bi emit-call ]
+: emit-recursive ( #recursive -- )
+ [ label>> id>> emit-call ]
[ [ child>> ] [ label>> word>> ] [ label>> id>> ] tri (build-cfg) ] bi ;
: remember-loop ( label -- )
basic-block get swap loops get set-at ;
-: emit-loop ( node -- next )
+: emit-loop ( node -- )
##loop-entry
##branch
begin-basic-block
- [ label>> id>> remember-loop ] [ child>> emit-nodes ] bi
- iterate-next ;
+ [ label>> id>> remember-loop ] [ child>> emit-nodes ] bi ;
M: #recursive emit-node
dup label>> loop?>> [ emit-loop ] [ emit-recursive ] if ;
] with-scope ;
: emit-if ( node -- )
- children>> [ emit-branch ] map
+ children>> [ emit-branch ] map
end-basic-block
begin-basic-block
basic-block get '[ [ _ swap successors>> push ] when* ] each ;
{ [ dup trivial-if? ] [ drop emit-trivial-if ] }
{ [ dup trivial-not-if? ] [ drop emit-trivial-not-if ] }
[ ds-pop ##branch-t emit-if ]
- } cond iterate-next ;
+ } cond ;
! #dispatch
M: #dispatch emit-node
- ds-pop ^^offset>slot i ##dispatch emit-if iterate-next ;
+ ds-pop ^^offset>slot i ##dispatch emit-if ;
! #call
M: #call emit-node
dup word>> dup "intrinsic" word-prop
- [ emit-intrinsic ] [ swap call-height emit-call ] if ;
+ [ emit-intrinsic ] [ nip emit-call ] if ;
! #call-recursive
-M: #call-recursive emit-node [ label>> id>> ] [ call-height ] bi emit-call ;
+M: #call-recursive emit-node label>> id>> emit-call ;
! #push
M: #push emit-node
- literal>> ^^load-literal ds-push iterate-next ;
+ literal>> ^^load-literal ds-push ;
! #shuffle
M: #shuffle emit-node
[ [ in-r>> [ length rs-load ] keep ] dip '[ _ set-at ] 2each ]
[ nip ] 2tri
[ [ [ out-d>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map ds-store ]
- [ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi
- iterate-next ;
+ [ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi ;
! #return
M: #return emit-node
- drop ##epilogue ##return stop-iterating ;
+ drop ##epilogue ##return ;
M: #return-recursive emit-node
label>> id>> loops get key?
- [ iterate-next ] [ ##epilogue ##return stop-iterating ] if ;
+ [ ##epilogue ##return ] unless ;
! #terminate
-M: #terminate emit-node drop stop-iterating ;
+M: #terminate emit-node drop ##no-tco basic-block off ;
! FFI
: return-size ( ctype -- n )
: alien-stack-frame ( params -- )
<alien-stack-frame> ##stack-frame ;
-: emit-alien-node ( node quot -- next )
+: emit-alien-node ( node quot -- )
[ params>> ] dip [ drop alien-stack-frame ] [ call ] 2bi
- ##branch begin-basic-block iterate-next ; inline
+ ##branch begin-basic-block ; inline
M: #alien-invoke emit-node
[ ##alien-invoke ] emit-alien-node ;
dup params>> xt>> dup
[
##prologue
- dup [ ##alien-callback ] emit-alien-node drop
+ dup [ ##alien-callback ] emit-alien-node
##epilogue
params>> ##callback-return
- ] with-cfg-builder
- iterate-next ;
+ ] with-cfg-builder ;
! No-op nodes
-M: #introduce emit-node drop iterate-next ;
+M: #introduce emit-node drop ;
-M: #copy emit-node drop iterate-next ;
+M: #copy emit-node drop ;
-M: #enter-recursive emit-node drop iterate-next ;
+M: #enter-recursive emit-node drop ;
-M: #phi emit-node drop iterate-next ;
+M: #phi emit-node drop ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays vectors accessors
-namespaces math make fry sequences ;
+USING: kernel arrays vectors accessors assocs sets
+namespaces math make fry sequences
+combinators.short-circuit
+compiler.cfg.instructions ;
IN: compiler.cfg
TUPLE: basic-block < identity-tuple
V{ } clone >>predecessors
\ basic-block counter >>id ;
+: empty-block? ( bb -- ? )
+ instructions>> {
+ [ length 1 = ]
+ [ first ##branch? ]
+ } 1&& ;
+
+SYMBOL: visited
+
+: (skip-empty-blocks) ( bb -- bb' )
+ dup visited get key? [
+ dup empty-block? [
+ dup visited get conjoin
+ successors>> first (skip-empty-blocks)
+ ] when
+ ] unless ;
+
+: skip-empty-blocks ( bb -- bb' )
+ H{ } clone visited [ (skip-empty-blocks) ] with-variable ;
+
: add-instructions ( bb quot -- )
[ instructions>> building ] dip '[
building get pop
building get push
] with-variable ; inline
+: back-edge? ( from to -- ? )
+ [ number>> ] bi@ > ;
+
TUPLE: cfg { entry basic-block } word label spill-counts post-order ;
: <cfg> ( entry word label -- cfg ) f f cfg boa ;
[ ##fixnum-add-tail? ]
[ ##fixnum-sub-tail? ]
[ ##fixnum-mul-tail? ]
- [ ##call? ]
+ [ ##no-tco? ]
} 1|| [ drop ] [ last-insn-not-a-jump ] if ;
ERROR: bad-loop-entry ;
-Slava Pestov
\ No newline at end of file
+Slava Pestov
+Daniel Ehrenberg
--- /dev/null
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test compiler.cfg kernel accessors compiler.cfg.dce
+compiler.cfg.instructions compiler.cfg.registers cpu.architecture ;
+IN: compiler.cfg.dce.tests
+
+: test-dce ( insns -- insns' )
+ <basic-block> swap >>instructions
+ cfg new swap >>entry
+ eliminate-dead-code
+ entry>> instructions>> ;
+
+[ V{
+ T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
+ T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
+ T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
+ T{ ##replace { src V int-regs 3 } { loc D 0 } }
+} ] [ V{
+ T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
+ T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
+ T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
+ T{ ##replace { src V int-regs 3 } { loc D 0 } }
+} test-dce ] unit-test
+
+[ V{ } ] [ V{
+ T{ ##load-immediate { dst V int-regs 1 } { val 8 } }
+ T{ ##load-immediate { dst V int-regs 2 } { val 16 } }
+ T{ ##add { dst V int-regs 3 } { src1 V int-regs 1 } { src2 V int-regs 2 } }
+} test-dce ] unit-test
+
+[ V{ } ] [ V{
+ T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+} test-dce ] unit-test
+
+[ V{ } ] [ V{
+ T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+} test-dce ] unit-test
+
+[ V{
+ T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+ T{ ##replace { src V int-regs 1 } { loc D 0 } }
+} ] [ V{
+ T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+ T{ ##replace { src V int-regs 1 } { loc D 0 } }
+} test-dce ] unit-test
+
+[ V{
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##replace { src V int-regs 1 } { loc D 0 } }
+} ] [ V{
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##replace { src V int-regs 1 } { loc D 0 } }
+} test-dce ] unit-test
+
+[ V{
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##replace { src V int-regs 1 } { loc D 0 } }
+ T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+ T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+} ] [ V{
+ T{ ##allot { dst V int-regs 1 } { temp V int-regs 2 } }
+ T{ ##replace { src V int-regs 1 } { loc D 0 } }
+ T{ ##load-immediate { dst V int-regs 3 } { val 8 } }
+ T{ ##set-slot-imm { obj V int-regs 1 } { src V int-regs 3 } }
+} test-dce ] unit-test
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sets kernel namespaces sequences
compiler.cfg.instructions compiler.cfg.def-use
! vregs which participate in side effects and thus are always live
SYMBOL: live-vregs
+: live-vreg? ( vreg -- ? )
+ live-vregs get key? ;
+
+! vregs which are the result of an allocation
+SYMBOL: allocations
+
+: allocation? ( vreg -- ? )
+ allocations get key? ;
+
: init-dead-code ( -- )
H{ } clone liveness-graph set
- H{ } clone live-vregs set ;
+ H{ } clone live-vregs set
+ H{ } clone allocations set ;
+
+GENERIC: build-liveness-graph ( insn -- )
+
+: add-edges ( insn register -- )
+ [ uses-vregs ] dip liveness-graph get [ union ] change-at ;
+
+: setter-liveness-graph ( insn vreg -- )
+ dup allocation? [ add-edges ] [ 2drop ] if ;
+
+M: ##set-slot build-liveness-graph
+ dup obj>> setter-liveness-graph ;
+
+M: ##set-slot-imm build-liveness-graph
+ dup obj>> setter-liveness-graph ;
+
+M: ##write-barrier build-liveness-graph
+ dup src>> setter-liveness-graph ;
+
+M: ##flushable build-liveness-graph
+ dup dst>> add-edges ;
-GENERIC: update-liveness-graph ( insn -- )
+M: ##allot build-liveness-graph
+ [ dst>> allocations get conjoin ]
+ [ call-next-method ] bi ;
-M: ##flushable update-liveness-graph
- [ uses-vregs ] [ dst>> ] bi liveness-graph get set-at ;
+M: insn build-liveness-graph drop ;
-: record-live ( vregs -- )
+GENERIC: compute-live-vregs ( insn -- )
+
+: (record-live) ( vregs -- )
[
dup live-vregs get key? [ drop ] [
[ live-vregs get conjoin ]
- [ liveness-graph get at record-live ]
+ [ liveness-graph get at (record-live) ]
bi
] if
] each ;
-M: insn update-liveness-graph uses-vregs record-live ;
+: record-live ( insn -- )
+ uses-vregs (record-live) ;
+
+: setter-live-vregs ( insn vreg -- )
+ allocation? [ drop ] [ record-live ] if ;
+
+M: ##set-slot compute-live-vregs
+ dup obj>> setter-live-vregs ;
+
+M: ##set-slot-imm compute-live-vregs
+ dup obj>> setter-live-vregs ;
+
+M: ##write-barrier compute-live-vregs
+ dup src>> setter-live-vregs ;
+
+M: ##flushable compute-live-vregs drop ;
+
+M: insn compute-live-vregs
+ record-live ;
GENERIC: live-insn? ( insn -- ? )
-M: ##flushable live-insn? dst>> live-vregs get key? ;
+M: ##flushable live-insn? dst>> live-vreg? ;
+
+M: ##set-slot live-insn? obj>> live-vreg? ;
+
+M: ##set-slot-imm live-insn? obj>> live-vreg? ;
+
+M: ##write-barrier live-insn? src>> live-vreg? ;
M: insn live-insn? drop t ;
: eliminate-dead-code ( cfg -- cfg' )
init-dead-code
- [ [ instructions>> [ update-liveness-graph ] each ] each-basic-block ]
- [ [ [ [ live-insn? ] filter ] change-instructions drop ] each-basic-block ]
- [ ]
- tri ;
\ No newline at end of file
+ dup
+ [ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ]
+ [ [ instructions>> [ compute-live-vregs ] each ] each-basic-block ]
+ [ [ instructions>> [ live-insn? ] filter-here ] each-basic-block ]
+ tri ;
--- /dev/null
+Dead code elimination
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words sequences quotations namespaces io
+USING: kernel words sequences quotations namespaces io vectors
classes.tuple accessors prettyprint prettyprint.config
prettyprint.backend prettyprint.custom prettyprint.sections
parser compiler.tree.builder compiler.tree.optimizer
compiler.cfg.registers compiler.cfg.stack-frame
compiler.cfg.linear-scan compiler.cfg.two-operand
compiler.cfg.liveness compiler.cfg.optimizer
-compiler.cfg.mr ;
+compiler.cfg.mr compiler.cfg ;
IN: compiler.cfg.debugger
GENERIC: test-cfg ( quot -- cfgs )
] map ;
: insn. ( insn -- )
- tuple>array [ pprint bl ] each nl ;
+ tuple>array but-last [ pprint bl ] each nl ;
: mr. ( mrs -- )
[
M: ds-loc pprint* \ D pprint-loc ;
M: rs-loc pprint* \ R pprint-loc ;
+
+: test-bb ( insns n -- )
+ [ <basic-block> swap >>number swap >>instructions ] keep set ;
+
+: test-diamond ( -- )
+ 1 get 1vector 0 get (>>successors)
+ 2 get 3 get V{ } 2sequence 1 get (>>successors)
+ 4 get 1vector 2 get (>>successors)
+ 4 get 1vector 3 get (>>successors) ;
\ No newline at end of file
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel compiler.cfg.instructions ;
+USING: accessors arrays kernel assocs compiler.cfg.instructions ;
IN: compiler.cfg.def-use
GENERIC: defs-vregs ( insn -- seq )
M: ##alien-getter uses-vregs src>> 1array ;
M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
-M: ##phi uses-vregs inputs>> ;
+M: ##phi uses-vregs inputs>> values ;
M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: _compare-imm-branch uses-vregs src1>> 1array ;
M: _dispatch uses-vregs src>> 1array ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences assocs
-cpu.architecture compiler.cfg.rpo
-compiler.cfg.liveness compiler.cfg.instructions
+compiler.cfg.rpo compiler.cfg.instructions
compiler.cfg.hats ;
IN: compiler.cfg.gc-checks
: gc? ( bb -- ? )
instructions>> [ ##allocation? ] any? ;
-: object-pointer-regs ( basic-block -- vregs )
- live-in keys [ reg-class>> int-regs eq? ] filter ;
-
: insert-gc-check ( basic-block -- )
dup gc? [
- [ i i f f \ ##gc new-insn prefix ] change-instructions drop
+ [ i i f \ ##gc new-insn prefix ] change-instructions drop
] [ drop ] if ;
: insert-gc-checks ( cfg -- cfg' )
+++ /dev/null
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors math namespaces sequences kernel fry
-compiler.cfg compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.liveness compiler.cfg.local ;
-IN: compiler.cfg.height
-
-! Combine multiple stack height changes into one at the
-! start of the basic block.
-
-SYMBOL: ds-height
-SYMBOL: rs-height
-
-GENERIC: compute-heights ( insn -- )
-
-M: ##inc-d compute-heights n>> ds-height [ + ] change ;
-M: ##inc-r compute-heights n>> rs-height [ + ] change ;
-M: insn compute-heights drop ;
-
-GENERIC: normalize-height* ( insn -- insn' )
-
-: normalize-inc-d/r ( insn stack -- insn' )
- swap n>> '[ _ - ] change f ; inline
-
-M: ##inc-d normalize-height* ds-height normalize-inc-d/r ;
-M: ##inc-r normalize-height* rs-height normalize-inc-d/r ;
-
-GENERIC: loc-stack ( loc -- stack )
-
-M: ds-loc loc-stack drop ds-height ;
-M: rs-loc loc-stack drop rs-height ;
-
-GENERIC: <loc> ( n stack -- loc )
-
-M: ds-loc <loc> drop <ds-loc> ;
-M: rs-loc <loc> drop <rs-loc> ;
-
-: normalize-peek/replace ( insn -- insn' )
- [ [ [ n>> ] [ loc-stack get ] bi + ] keep <loc> ] change-loc ; inline
-
-M: ##peek normalize-height* normalize-peek/replace ;
-M: ##replace normalize-height* normalize-peek/replace ;
-
-M: insn normalize-height* ;
-
-: height-step ( insns -- insns' )
- 0 ds-height set
- 0 rs-height set
- [ [ compute-heights ] each ]
- [ [ [ normalize-height* ] map sift ] with-scope ] bi
- ds-height get dup 0 = [ drop ] [ \ ##inc-d new-insn prefix ] if
- rs-height get dup 0 = [ drop ] [ \ ##inc-r new-insn prefix ] if ;
-
-: normalize-height ( cfg -- cfg' )
- [ drop ] [ height-step ] local-optimization ;
+++ /dev/null
-Stack height normalization coalesces height changes at start of basic block
! Subroutine calls
INSN: ##stack-frame stack-frame ;
-INSN: ##call word { height integer } ;
+INSN: ##call word ;
INSN: ##jump word ;
INSN: ##return ;
+! Dummy instruction that simply inhibits TCO
+INSN: ##no-tco ;
+
! Jump tables
INSN: ##dispatch src temp ;
{ cc/= cc= }
} at ;
+: swap-cc ( cc -- cc' )
+ H{
+ { cc< cc> }
+ { cc<= cc>= }
+ { cc> cc< }
+ { cc>= cc<= }
+ { cc= cc= }
+ { cc/= cc/= }
+ } at ;
+
: evaluate-cc ( result cc -- ? )
H{
{ cc< { +lt+ } }
INSN: ##compare-float-branch < ##conditional-branch ;
INSN: ##compare-float < ##binary cc temp ;
-INSN: ##gc { temp1 vreg } { temp2 vreg } live-registers live-spill-slots ;
+INSN: ##gc { temp1 vreg } { temp2 vreg } live-values ;
! Instructions used by machine IR only.
INSN: _prologue stack-frame ;
INSN: _reload dst class n ;
INSN: _copy dst src class ;
INSN: _spill-counts counts ;
+
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences accessors layouts kernel math namespaces
combinators fry locals
compiler.tree.propagation.info
compiler.cfg.hats
compiler.cfg.stacks
-compiler.cfg.iterator
compiler.cfg.instructions
compiler.cfg.utilities
compiler.cfg.registers ;
0 cc= ^^compare-imm
ds-push ;
-: (emit-fixnum-imm-op) ( infos insn -- dst )
- ds-drop
- [ ds-pop ]
- [ second literal>> [ tag-fixnum ] [ \ f tag-number ] if* ]
- [ ]
- tri*
- call ; inline
+: tag-literal ( n -- tagged )
+ literal>> [ tag-fixnum ] [ \ f tag-number ] if* ;
+
+: emit-fixnum-imm-op1 ( infos insn -- dst )
+ [ ds-pop ds-drop ] [ first tag-literal ] [ ] tri* call ; inline
+
+: emit-fixnum-imm-op2 ( infos insn -- dst )
+ [ ds-drop ds-pop ] [ second tag-literal ] [ ] tri* call ; inline
: (emit-fixnum-op) ( insn -- dst )
[ 2inputs ] dip call ; inline
:: emit-fixnum-op ( node insn imm-insn -- )
[let | infos [ node node-input-infos ] |
infos second value-info-small-tagged?
- [ infos imm-insn (emit-fixnum-imm-op) ]
- [ insn (emit-fixnum-op) ]
- if
+ [ infos imm-insn emit-fixnum-imm-op2 ]
+ [ insn (emit-fixnum-op) ] if
+ ds-push
+ ] ; inline
+
+:: emit-commutative-fixnum-op ( node insn imm-insn -- )
+ [let | infos [ node node-input-infos ] |
+ {
+ { [ infos first value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op1 ] }
+ { [ infos second value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op2 ] }
+ [ insn (emit-fixnum-op) ]
+ } cond
ds-push
] ; inline
} case
ds-push
] [ drop emit-primitive ] if ;
-
+
: emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
: (emit-fixnum*fast) ( -- dst )
2inputs ^^untag-fixnum ^^mul ;
-: (emit-fixnum*fast-imm) ( infos -- dst )
- ds-drop
- [ ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
+: (emit-fixnum*fast-imm1) ( infos -- dst )
+ [ ds-pop ds-drop ] [ first literal>> ] bi* ^^mul-imm ;
+
+: (emit-fixnum*fast-imm2) ( infos -- dst )
+ [ ds-drop ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
: emit-fixnum*fast ( node -- )
node-input-infos
- dup second value-info-small-fixnum?
- [ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if
+ dup first value-info-small-fixnum? drop f
+ [
+ (emit-fixnum*fast-imm1)
+ ] [
+ dup second value-info-small-fixnum?
+ [ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if
+ ] if
ds-push ;
+: (emit-fixnum-comparison) ( cc -- quot1 quot2 )
+ [ ^^compare ] [ ^^compare-imm ] bi-curry ; inline
+
+: emit-eq ( node -- )
+ cc= (emit-fixnum-comparison) emit-commutative-fixnum-op ;
+
: emit-fixnum-comparison ( node cc -- )
- [ ^^compare ] [ ^^compare-imm ] bi-curry
- emit-fixnum-op ;
+ (emit-fixnum-comparison) emit-fixnum-op ;
: emit-bignum>fixnum ( -- )
ds-pop ^^bignum>integer ^^tag-fixnum ds-push ;
: emit-fixnum>bignum ( -- )
ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
-: emit-fixnum-overflow-op ( quot quot-tail -- next )
- [ 2inputs 1 ##inc-d ] 2dip
- tail-call? [
- ##epilogue
- nip call
- stop-iterating
- ] [
- drop call
- ##branch
- begin-basic-block
- iterate-next
- ] if ; inline
+: emit-fixnum-overflow-op ( quot -- next )
+ [ 2inputs 1 ##inc-d ] dip call ##branch
+ begin-basic-block ; inline
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel combinators cpu.architecture
compiler.cfg.hats
compiler.cfg.intrinsics.fixnum
compiler.cfg.intrinsics.float
compiler.cfg.intrinsics.slots
-compiler.cfg.intrinsics.misc
-compiler.cfg.iterator ;
+compiler.cfg.intrinsics.misc ;
QUALIFIED: kernel
QUALIFIED: arrays
QUALIFIED: byte-arrays
: enable-fixnum-log2 ( -- )
\ math.integers.private:fixnum-log2 t "intrinsic" set-word-prop ;
-: emit-intrinsic ( node word -- node/f )
+: emit-intrinsic ( node word -- )
{
- { \ kernel.private:tag [ drop emit-tag iterate-next ] }
- { \ kernel.private:getenv [ emit-getenv iterate-next ] }
- { \ math.private:both-fixnums? [ drop emit-both-fixnums? iterate-next ] }
- { \ math.private:fixnum+ [ drop [ ##fixnum-add ] [ ##fixnum-add-tail ] emit-fixnum-overflow-op ] }
- { \ math.private:fixnum- [ drop [ ##fixnum-sub ] [ ##fixnum-sub-tail ] emit-fixnum-overflow-op ] }
- { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] [ i i ##fixnum-mul-tail ] emit-fixnum-overflow-op ] }
- { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op iterate-next ] }
- { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op iterate-next ] }
- { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op iterate-next ] }
- { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op iterate-next ] }
- { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op iterate-next ] }
- { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast iterate-next ] }
- { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot iterate-next ] }
- { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 iterate-next ] }
- { \ math.private:fixnum*fast [ emit-fixnum*fast iterate-next ] }
- { \ math.private:fixnum< [ cc< emit-fixnum-comparison iterate-next ] }
- { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] }
- { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison iterate-next ] }
- { \ math.private:fixnum> [ cc> emit-fixnum-comparison iterate-next ] }
- { \ kernel:eq? [ cc= emit-fixnum-comparison iterate-next ] }
- { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum iterate-next ] }
- { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum iterate-next ] }
- { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op iterate-next ] }
- { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op iterate-next ] }
- { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op iterate-next ] }
- { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op iterate-next ] }
- { \ math.private:float< [ drop cc< emit-float-comparison iterate-next ] }
- { \ math.private:float<= [ drop cc<= emit-float-comparison iterate-next ] }
- { \ math.private:float>= [ drop cc>= emit-float-comparison iterate-next ] }
- { \ math.private:float> [ drop cc> emit-float-comparison iterate-next ] }
- { \ math.private:float= [ drop cc= emit-float-comparison iterate-next ] }
- { \ math.private:float>fixnum [ drop emit-float>fixnum iterate-next ] }
- { \ math.private:fixnum>float [ drop emit-fixnum>float iterate-next ] }
- { \ slots.private:slot [ emit-slot iterate-next ] }
- { \ slots.private:set-slot [ emit-set-slot iterate-next ] }
- { \ strings.private:string-nth [ drop emit-string-nth iterate-next ] }
- { \ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast iterate-next ] }
- { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> iterate-next ] }
- { \ arrays:<array> [ emit-<array> iterate-next ] }
- { \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
- { \ byte-arrays:(byte-array) [ emit-(byte-array) iterate-next ] }
- { \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
- { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter iterate-next ] }
- { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter iterate-next ] }
- { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter iterate-next ] }
- { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter iterate-next ] }
- { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter iterate-next ] }
- { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter iterate-next ] }
- { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter iterate-next ] }
- { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter iterate-next ] }
- { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter iterate-next ] }
- { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter iterate-next ] }
- { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter iterate-next ] }
- { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter iterate-next ] }
- { \ alien.accessors:alien-cell [ emit-alien-cell-getter iterate-next ] }
- { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter iterate-next ] }
- { \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter iterate-next ] }
- { \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter iterate-next ] }
- { \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter iterate-next ] }
- { \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter iterate-next ] }
+ { \ kernel.private:tag [ drop emit-tag ] }
+ { \ kernel.private:getenv [ emit-getenv ] }
+ { \ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
+ { \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] }
+ { \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] }
+ { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] }
+ { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-commutative-fixnum-op ] }
+ { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op ] }
+ { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-commutative-fixnum-op ] }
+ { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-commutative-fixnum-op ] }
+ { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-commutative-fixnum-op ] }
+ { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
+ { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
+ { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
+ { \ math.private:fixnum*fast [ emit-fixnum*fast ] }
+ { \ math.private:fixnum< [ cc< emit-fixnum-comparison ] }
+ { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison ] }
+ { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison ] }
+ { \ math.private:fixnum> [ cc> emit-fixnum-comparison ] }
+ { \ kernel:eq? [ emit-eq ] }
+ { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] }
+ { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] }
+ { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
+ { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
+ { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
+ { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
+ { \ math.private:float< [ drop cc< emit-float-comparison ] }
+ { \ math.private:float<= [ drop cc<= emit-float-comparison ] }
+ { \ math.private:float>= [ drop cc>= emit-float-comparison ] }
+ { \ math.private:float> [ drop cc> emit-float-comparison ] }
+ { \ math.private:float= [ drop cc= emit-float-comparison ] }
+ { \ math.private:float>fixnum [ drop emit-float>fixnum ] }
+ { \ math.private:fixnum>float [ drop emit-fixnum>float ] }
+ { \ slots.private:slot [ emit-slot ] }
+ { \ slots.private:set-slot [ emit-set-slot ] }
+ { \ strings.private:string-nth [ drop emit-string-nth ] }
+ { \ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
+ { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
+ { \ arrays:<array> [ emit-<array> ] }
+ { \ byte-arrays:<byte-array> [ emit-<byte-array> ] }
+ { \ byte-arrays:(byte-array) [ emit-(byte-array) ] }
+ { \ kernel:<wrapper> [ emit-simple-allot ] }
+ { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
+ { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
+ { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
+ { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
+ { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
+ { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
+ { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
+ { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
+ { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
+ { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
+ { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
+ { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
+ { \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
+ { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
+ { \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter ] }
+ { \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter ] }
+ { \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter ] }
+ { \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter ] }
} case ;
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces sequences kernel compiler.tree ;
-IN: compiler.cfg.iterator
-
-SYMBOL: node-stack
-
-: >node ( cursor -- ) node-stack get push ;
-: node> ( -- cursor ) node-stack get pop ;
-: node@ ( -- cursor ) node-stack get last ;
-: current-node ( -- node ) node@ first ;
-: iterate-next ( -- cursor ) node@ rest-slice ;
-: skip-next ( -- next ) node> rest-slice [ first ] [ >node ] bi ;
-
-: iterate-nodes ( cursor quot: ( -- ) -- )
- over empty? [
- 2drop
- ] [
- [ swap >node call node> drop ] keep iterate-nodes
- ] if ; inline recursive
-
-DEFER: (tail-call?)
-
-: tail-phi? ( cursor -- ? )
- [ first #phi? ] [ rest-slice (tail-call?) ] bi and ;
-
-: (tail-call?) ( cursor -- ? )
- [ t ] [
- [
- first
- [ #return? ]
- [ #return-recursive? ]
- [ #terminate? ] tri or or
- ] [ tail-phi? ] bi or
- ] if-empty ;
-
-: tail-call? ( -- ? )
- node-stack get [
- rest-slice
- [ t ] [ (tail-call?) ] if-empty
- ] all? ;
-
-: terminate-call? ( -- ? )
- node-stack get last
- rest-slice [ f ] [ first #terminate? ] if-empty ;
+++ /dev/null
-Utility for iterating for high-level IR
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel namespaces sequences fry math
-combinators arrays sorting compiler.utilities
+math.order combinators arrays sorting compiler.utilities
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation.coalescing
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.allocation
-: free-positions ( new -- assoc )
- vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
+: active-positions ( new assoc -- )
+ [ vreg>> active-intervals-for ] dip
+ '[ [ 0 ] dip reg>> _ add-use-position ] each ;
-: active-positions ( new -- assoc )
- vreg>> active-intervals-for [ reg>> 0 ] H{ } map>assoc ;
+: inactive-positions ( new assoc -- )
+ [ [ vreg>> inactive-intervals-for ] keep ] dip
+ '[
+ [ _ relevant-ranges intersect-live-ranges 1/0. or ] [ reg>> ] bi
+ _ add-use-position
+ ] each ;
-: inactive-positions ( new -- assoc )
- dup vreg>> inactive-intervals-for
- [ [ reg>> swap ] keep relevant-ranges intersect-live-ranges ]
- with H{ } map>assoc ;
-
-: compute-free-pos ( new -- free-pos )
- [ free-positions ] [ inactive-positions ] [ active-positions ] tri
- 3array assoc-combine >alist alist-max ;
+: register-status ( new -- free-pos )
+ dup free-positions
+ [ inactive-positions ] [ active-positions ] [ nip ] 2tri
+ >alist alist-max ;
: no-free-registers? ( result -- ? )
second 0 = ; inline
-: register-available? ( new result -- ? )
- [ end>> ] [ second ] bi* < ; inline
-
-: register-available ( new result -- )
- first >>reg add-active ;
+: split-to-fit ( new n -- before after )
+ split-interval
+ [ [ compute-start/end ] bi@ ]
+ [ >>split-next drop ]
+ [ ]
+ 2tri ;
: register-partially-available ( new result -- )
- [ second split-before-use ] keep
- '[ _ register-available ] [ add-unhandled ] bi* ;
+ {
+ { [ 2dup second 1 - spill-live-out? ] [ drop spill-live-out ] }
+ { [ 2dup second 1 - spill-live-in? ] [ drop spill-live-in ] }
+ [
+ [ second 1 - split-to-fit ] keep
+ '[ _ register-available ] [ add-unhandled ] bi*
+ ]
+ } cond ;
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
- dup compute-free-pos {
+ dup register-status {
{ [ dup no-free-registers? ] [ drop assign-blocked-register ] }
{ [ 2dup register-available? ] [ register-available ] }
- [ register-partially-available ]
+ ! [ register-partially-available ]
+ [ drop assign-blocked-register ]
} cond
] if ;
! 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 ;
: active-interval ( vreg -- live-interval )
dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ;
-: intersects-inactive-intervals? ( live-interval -- ? )
+: avoids-inactive-intervals? ( live-interval -- ? )
dup vreg>> inactive-intervals-for
- [ relevant-ranges intersect-live-ranges 1/0. = ] with all? ;
+ [ intervals-intersect? not ] with all? ;
: coalesce? ( live-interval -- ? )
{
[ copy-from>> active-interval ]
[ [ start>> ] [ copy-from>> active-interval end>> ] bi = ]
- [ intersects-inactive-intervals? ]
+ [ 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 ;
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators fry hints kernel locals
-math sequences sets sorting splitting compiler.utilities
+math sequences sets sorting splitting namespaces
+combinators.short-circuit compiler.utilities
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.spilling
-: find-use ( live-interval n quot -- elt )
- [ uses>> ] 2dip curry find nip ; inline
+ERROR: bad-live-ranges interval ;
-: spill-existing? ( new existing -- ? )
- #! Test if 'new' will be used before 'existing'.
- over start>> '[ _ [ > ] find-use -1 or ] bi@ < ;
+: check-ranges ( live-interval -- )
+ check-allocation? get [
+ dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all?
+ [ drop ] [ bad-live-ranges ] if
+ ] [ drop ] if ;
-: interval-to-spill ( active-intervals current -- live-interval )
- #! We spill the interval with the most distant use location.
- start>> '[ dup _ [ >= ] find-use ] { } map>assoc
- alist-max first ;
+: trim-before-ranges ( live-interval -- )
+ [ ranges>> ] [ uses>> last 1 + ] bi
+ [ '[ from>> _ <= ] filter-here ]
+ [ swap last (>>to) ]
+ 2bi ;
+
+: trim-after-ranges ( live-interval -- )
+ [ ranges>> ] [ uses>> first ] bi
+ [ '[ to>> _ >= ] filter-here ]
+ [ swap first (>>from) ]
+ 2bi ;
: split-for-spill ( live-interval n -- before after )
split-interval
+ {
+ [ [ trim-before-ranges ] [ trim-after-ranges ] bi* ]
+ [ [ compute-start/end ] bi@ ]
+ [ [ check-ranges ] bi@ ]
+ [ ]
+ } 2cleave ;
+
+: assign-spill ( live-interval -- )
+ dup vreg>> assign-spill-slot >>spill-to f >>split-next drop ;
+
+: assign-reload ( live-interval -- )
+ 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* ;
+
+: find-use-position ( live-interval new -- n )
+ [ uses>> ] [ start>> '[ _ >= ] ] bi* find nip 1/0. or ;
+
+: find-use-positions ( live-intervals new assoc -- )
+ '[ [ _ find-use-position ] [ reg>> ] bi _ add-use-position ] each ;
+
+: active-positions ( new assoc -- )
+ [ [ vreg>> active-intervals-for ] keep ] dip
+ find-use-positions ;
+
+: inactive-positions ( new assoc -- )
[
- [ [ ranges>> last ] [ uses>> last ] bi >>to drop ]
- [ [ ranges>> first ] [ uses>> first ] bi >>from drop ] bi*
- ]
- [ [ compute-start/end ] bi@ ]
- [ ]
- 2tri ;
-
-: assign-spill ( before after -- before after )
- #! If it has been spilled already, reuse spill location.
- over reload-from>>
- [ over vreg>> reg-class>> next-spill-location ] unless*
- [ >>spill-to ] [ >>reload-from ] bi-curry bi* ;
-
-: split-and-spill ( new existing -- before after )
- swap start>> split-for-spill assign-spill ;
-
-: spill-existing ( new existing -- )
- #! Our new interval will be used before the active interval
- #! with the most distant use location. Spill the existing
- #! interval, then process the new interval and the tail end
- #! of the existing interval again.
- [ nip delete-active ]
- [ reg>> >>reg add-active ]
- [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
-
-: spill-new ( new existing -- )
- #! Our new interval will be used after the active interval
- #! with the most distant use location. Split the new
- #! interval, then process both parts of the new interval
- #! again.
- [ dup split-and-spill add-unhandled ] dip spill-existing ;
+ [ vreg>> inactive-intervals-for ] keep
+ [ '[ _ intervals-intersect? ] filter ] keep
+ ] dip
+ find-use-positions ;
-: assign-blocked-register ( new -- )
- [ dup vreg>> active-intervals-for ] keep interval-to-spill
- 2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
+: spill-status ( new -- use-pos )
+ H{ } clone
+ [ inactive-positions ] [ active-positions ] [ nip ] 2tri
+ >alist alist-max ;
+
+: spill-new? ( new pair -- ? )
+ [ uses>> first ] [ second ] bi* > ;
+
+: spill-new ( new pair -- )
+ drop
+ {
+ [ trim-after-ranges ]
+ [ compute-start/end ]
+ [ assign-reload ]
+ [ add-unhandled ]
+ } cleave ;
+: spill-live-out? ( live-interval n -- ? ) [ uses>> last ] dip < ;
+
+: spill-live-out ( live-interval -- )
+ ! The interval has no more usages after the spill location. This
+ ! means it is the first child of an interval that was split. We
+ ! spill the value and let the resolve pass insert a reload later.
+ {
+ [ trim-before-ranges ]
+ [ compute-start/end ]
+ [ assign-spill ]
+ [ add-handled ]
+ } cleave ;
+
+: spill-live-in? ( live-interval n -- ? ) [ uses>> first ] dip > ;
+
+: spill-live-in ( live-interval -- )
+ ! The interval does not have any usages before the spill location.
+ ! This means it is the second child of an interval that was
+ ! split. We reload the value and let the resolve pass insert a
+ ! split later.
+ {
+ [ trim-after-ranges ]
+ [ compute-start/end ]
+ [ assign-reload ]
+ [ add-unhandled ]
+ } cleave ;
+
+: spill ( live-interval n -- )
+ {
+ { [ 2dup spill-live-out? ] [ drop spill-live-out ] }
+ { [ 2dup spill-live-in? ] [ drop spill-live-in ] }
+ [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ]
+ } cond ;
+
+:: spill-intersecting-active ( new reg -- )
+ ! If there is an active interval using 'reg' (there should be at
+ ! most one) are split and spilled and removed from the inactive
+ ! set.
+ new vreg>> active-intervals-for [ [ reg>> reg = ] find swap dup ] keep
+ '[ _ delete-nth new start>> spill ] [ 2drop ] if ;
+
+:: spill-intersecting-inactive ( new reg -- )
+ ! Any inactive intervals using 'reg' are split and spilled
+ ! and removed from the inactive set.
+ new vreg>> inactive-intervals-for [
+ dup reg>> reg = [
+ dup new intervals-intersect? [
+ new start>> spill f
+ ] [ drop t ] if
+ ] [ drop t ] if
+ ] filter-here ;
+
+: spill-intersecting ( new reg -- )
+ ! Split and spill all active and inactive intervals
+ ! which intersect 'new' and use 'reg'.
+ [ spill-intersecting-active ]
+ [ spill-intersecting-inactive ]
+ 2bi ;
+
+: spill-available ( new pair -- )
+ ! A register would become fully available if all
+ ! active and inactive intervals using it were split
+ ! and spilled.
+ [ first spill-intersecting ] [ register-available ] 2bi ;
+
+: spill-partially-available ( new pair -- )
+ ! A register would be available for part of the new
+ ! interval's lifetime if all active and inactive intervals
+ ! using that register were split and spilled.
+ [ second 1 - split-and-spill add-unhandled ] keep
+ spill-available ;
+
+: assign-blocked-register ( new -- )
+ dup spill-status {
+ { [ 2dup spill-new? ] [ spill-new ] }
+ { [ 2dup register-available? ] [ spill-available ] }
+ [ spill-partially-available ]
+ } cond ;
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators fry hints kernel locals
-math sequences sets sorting splitting
+math sequences sets sorting splitting namespaces
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.splitting
ERROR: splitting-too-early ;
+ERROR: splitting-too-late ;
+
ERROR: splitting-atomic-interval ;
: check-split ( live-interval n -- )
- [ [ start>> ] dip > [ splitting-too-early ] when ]
- [ drop [ end>> ] [ start>> ] bi - 0 = [ splitting-atomic-interval ] when ]
- 2bi ; inline
+ check-allocation? get [
+ [ [ start>> ] dip > [ splitting-too-early ] when ]
+ [ [ end>> ] dip <= [ splitting-too-late ] when ]
+ [ drop [ end>> ] [ start>> ] bi = [ splitting-atomic-interval ] when ]
+ 2tri
+ ] [ 2drop ] if ; inline
: split-before ( before -- before' )
f >>spill-to ; inline
after split-after ;
HINTS: split-interval live-interval object ;
-
-: split-between-blocks ( new n -- before after )
- split-interval
- 2dup [ compute-start/end ] bi@ ;
-
-: insert-use-for-copy ( seq n -- seq' )
- dup 1 + [ nip 1array split1 ] 2keep 2array glue ;
-
-: split-before-use ( new n -- before after )
- ! Find optimal split position
- ! Insert move instruction
- 1 -
- 2dup swap covers? [
- [ '[ _ insert-use-for-copy ] change-uses ] keep
- split-between-blocks
- 2dup >>split-next drop
- ] [
- split-between-blocks
- ] if ;
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators cpu.architecture fry heaps
-kernel math namespaces sequences vectors
+kernel math math.order namespaces sequences vectors
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.state
+! Start index of current live interval. We ensure that all
+! live intervals added to the unhandled set have a start index
+! strictly greater than this one. This ensures that we can catch
+! infinite loop situations. We also ensure that all live
+! intervals added to the handled set have an end index strictly
+! smaller than this one. This helps catch bugs.
+SYMBOL: progress
+
+: check-unhandled ( live-interval -- )
+ start>> progress get <= [ "check-unhandled" throw ] when ; inline
+
+: check-handled ( live-interval -- )
+ end>> progress get > [ "check-handled" throw ] when ; inline
+
! Mapping from register classes to sequences of machine registers
SYMBOL: registers
: add-inactive ( live-interval -- )
dup vreg>> inactive-intervals-for push ;
+: delete-inactive ( live-interval -- )
+ dup vreg>> inactive-intervals-for delq ;
+
! Vector of handled live intervals
SYMBOL: handled-intervals
: add-handled ( live-interval -- )
- handled-intervals get push ;
+ [ check-handled ] [ handled-intervals get push ] bi ;
: finished? ( n live-interval -- ? ) end>> swap < ;
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
-! Start index of current live interval. We ensure that all
-! live intervals added to the unhandled set have a start index
-! strictly greater than ths one. This ensures that we can catch
-! infinite loop situations.
-SYMBOL: progress
-
-: check-progress ( live-interval -- )
- start>> progress get <= [ "No progress" throw ] when ; inline
-
: add-unhandled ( live-interval -- )
- [ check-progress ]
+ [ check-unhandled ]
[ dup start>> unhandled-intervals get heap-push ]
bi ;
: reg-class-assoc ( quot -- assoc )
[ reg-classes ] dip { } map>assoc ; inline
+! Mapping from register classes to spill counts
SYMBOL: spill-counts
-: next-spill-location ( reg-class -- n )
+: next-spill-slot ( reg-class -- n )
spill-counts get [ dup 1 + ] change-at ;
+! Mapping from vregs to spill slots
+SYMBOL: spill-slots
+
+: assign-spill-slot ( vreg -- n )
+ spill-slots get [ reg-class>> next-spill-slot ] cache ;
+
: init-allocator ( registers -- )
registers set
- [ 0 ] reg-class-assoc spill-counts set
<min-heap> unhandled-intervals set
[ V{ } clone ] reg-class-assoc active-intervals set
[ V{ } clone ] reg-class-assoc inactive-intervals set
V{ } clone handled-intervals set
+ [ 0 ] reg-class-assoc spill-counts set
+ H{ } clone spill-slots set
-1 progress set ;
: init-unhandled ( live-intervals -- )
[ [ start>> ] keep ] { } map>assoc
- unhandled-intervals get heap-push-all ;
\ No newline at end of file
+ unhandled-intervals get heap-push-all ;
+
+! A utility used by register-status and spill-status words
+: free-positions ( new -- assoc )
+ vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
+
+: add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
+
+: register-available? ( new result -- ? )
+ [ end>> ] [ second ] bi* < ; inline
+
+: register-available ( new result -- )
+ first >>reg add-active ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math assocs namespaces sequences heaps
-fry make combinators sets
+fry make combinators sets locals
cpu.architecture
+compiler.cfg
compiler.cfg.def-use
+compiler.cfg.liveness
compiler.cfg.registers
compiler.cfg.instructions
+compiler.cfg.linear-scan.mapping
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.live-intervals ;
: init-unhandled ( live-intervals -- )
[ add-unhandled ] each ;
-! Mapping spill slots to vregs
-SYMBOL: spill-slots
+! Mapping from basic blocks to values which are live at the start
+SYMBOL: register-live-ins
-: spill-slots-for ( vreg -- assoc )
- reg-class>> spill-slots get at ;
+! Mapping from basic blocks to values which are live at the end
+SYMBOL: register-live-outs
-ERROR: already-spilled ;
-
-: record-spill ( live-interval -- )
- [ dup spill-to>> ] [ vreg>> spill-slots-for ] bi
- 2dup key? [ already-spilled ] [ set-at ] if ;
-
-: insert-spill ( live-interval -- )
- {
- [ reg>> ]
- [ vreg>> reg-class>> ]
- [ spill-to>> ]
- [ end>> ]
- } cleave f swap \ _spill boa , ;
+: init-assignment ( live-intervals -- )
+ V{ } clone pending-intervals set
+ <min-heap> unhandled-intervals set
+ H{ } clone register-live-ins set
+ H{ } clone register-live-outs set
+ init-unhandled ;
: handle-spill ( live-interval -- )
- dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
+ dup spill-to>> [
+ [ reg>> ] [ spill-to>> <spill-slot> ] [ vreg>> reg-class>> ] tri
+ register->memory
+ ] [ drop ] if ;
-: insert-copy ( live-interval -- )
- {
- [ split-next>> reg>> ]
- [ reg>> ]
- [ vreg>> reg-class>> ]
- [ end>> ]
- } cleave f swap \ _copy boa , ;
+: first-split ( live-interval -- live-interval' )
+ dup split-before>> [ first-split ] [ ] ?if ;
+
+: next-interval ( live-interval -- live-interval' )
+ split-next>> first-split ;
: handle-copy ( live-interval -- )
- dup [ spill-to>> not ] [ split-next>> ] bi and
- [ insert-copy ] [ drop ] if ;
+ dup split-next>> [
+ [ reg>> ] [ next-interval reg>> ] [ vreg>> reg-class>> ] tri
+ register->register
+ ] [ drop ] if ;
: expire-old-intervals ( n -- )
- [ pending-intervals get ] dip '[
- dup end>> _ <
- [ [ handle-spill ] [ handle-copy ] bi f ] [ drop t ] if
- ] filter-here ;
-
-ERROR: already-reloaded ;
-
-: record-reload ( live-interval -- )
- [ reload-from>> ] [ vreg>> spill-slots-for ] bi
- 2dup key? [ delete-at ] [ already-reloaded ] if ;
+ [
+ [ pending-intervals get ] dip '[
+ dup end>> _ <
+ [ [ handle-spill ] [ handle-copy ] bi f ] [ drop t ] if
+ ] filter-here
+ ] { } make mapping-instructions % ;
: insert-reload ( live-interval -- )
{
[ reg>> ]
[ vreg>> reg-class>> ]
[ reload-from>> ]
- [ end>> ]
+ [ start>> ]
} cleave f swap \ _reload boa , ;
: handle-reload ( live-interval -- )
- dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
+ dup reload-from>> [ insert-reload ] [ drop ] if ;
: activate-new-intervals ( n -- )
#! Any live intervals which start on the current instruction
] [ 2drop ] if
] if ;
+: prepare-insn ( n -- )
+ [ expire-old-intervals ] [ activate-new-intervals ] bi ;
+
GENERIC: assign-registers-in-insn ( insn -- )
: register-mapping ( live-intervals -- alist )
- [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
+ [ [ vreg>> ] [ reg>> ] bi ] H{ } map>assoc ;
: all-vregs ( insn -- vregs )
[ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
-: active-intervals ( insn -- intervals )
- insn#>> pending-intervals get [ covers? ] with filter ;
+SYMBOL: check-assignment?
+
+ERROR: overlapping-registers intervals ;
+
+: check-assignment ( intervals -- )
+ dup [ copy-from>> ] map sift '[ vreg>> _ member? not ] filter
+ dup [ reg>> ] map all-unique? [ drop ] [ overlapping-registers ] if ;
+
+: active-intervals ( n -- intervals )
+ pending-intervals get [ covers? ] with filter
+ check-assignment? get [ dup check-assignment ] when ;
M: vreg-insn assign-registers-in-insn
- dup [ active-intervals ] [ all-vregs ] bi
- '[ vreg>> _ member? ] filter
+ dup [ all-vregs ] [ insn#>> active-intervals ] bi
+ '[ _ [ vreg>> = ] with find nip ] map
register-mapping
>>regs drop ;
-: compute-live-registers ( insn -- regs )
- [ active-intervals ] [ temp-vregs ] bi
- '[ vreg>> _ memq? not ] filter
- register-mapping ;
-
-: compute-live-spill-slots ( -- spill-slots )
- spill-slots get values [ values ] map concat
- [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
-
M: ##gc assign-registers-in-insn
+ ! This works because ##gc is always the first instruction
+ ! in a block.
dup call-next-method
- dup compute-live-registers >>live-registers
- compute-live-spill-slots >>live-spill-slots
+ basic-block get register-live-ins get at >>live-values
drop ;
M: insn assign-registers-in-insn drop ;
-: init-assignment ( live-intervals -- )
- V{ } clone pending-intervals set
- <min-heap> unhandled-intervals set
- [ H{ } clone ] reg-class-assoc spill-slots set
- init-unhandled ;
+: compute-live-spill-slots ( vregs -- assoc )
+ spill-slots get '[ _ at dup [ <spill-slot> ] when ] assoc-map ;
-: assign-registers-in-block ( bb -- )
- [
+: compute-live-registers ( n -- assoc )
+ active-intervals register-mapping ;
+
+ERROR: bad-live-values live-values ;
+
+: check-live-values ( assoc -- assoc )
+ check-assignment? get [
+ dup values [ not ] any? [ bad-live-values ] when
+ ] when ;
+
+: compute-live-values ( vregs n -- assoc )
+ ! If a live vreg is not in active or inactive, then it must have been
+ ! spilled.
+ [ compute-live-spill-slots ] [ compute-live-registers ] bi*
+ assoc-union check-live-values ;
+
+: begin-block ( bb -- )
+ dup basic-block set
+ dup block-from activate-new-intervals
+ [ [ live-in ] [ block-from ] bi compute-live-values ] keep
+ register-live-ins get set-at ;
+
+: end-block ( bb -- )
+ [ [ live-out ] [ block-to ] bi compute-live-values ] keep
+ register-live-outs get set-at ;
+
+ERROR: bad-vreg vreg ;
+
+: vreg-at-start ( vreg bb -- state )
+ register-live-ins get at ?at [ bad-vreg ] unless ;
+
+: vreg-at-end ( vreg bb -- state )
+ register-live-outs get at ?at [ bad-vreg ] unless ;
+
+:: assign-registers-in-block ( bb -- )
+ bb [
[
+ bb begin-block
[
- [
- insn#>>
- [ expire-old-intervals ]
- [ activate-new-intervals ]
- bi
- ]
- [ assign-registers-in-insn ]
- [ , ]
- tri
+ {
+ [ insn#>> 1 - prepare-insn ]
+ [ insn#>> prepare-insn ]
+ [ assign-registers-in-insn ]
+ [ , ]
+ } cleave
] each
+ bb end-block
] V{ } make
] change-instructions drop ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences sets arrays math strings fry
namespaces prettyprint compiler.cfg.linear-scan.live-intervals
-compiler.cfg.linear-scan.allocation compiler.cfg ;
+compiler.cfg.linear-scan.allocation compiler.cfg assocs ;
IN: compiler.cfg.linear-scan.debugger
: check-assigned ( live-intervals -- )
] [ 1array ] if ;
: check-linear-scan ( live-intervals machine-registers -- )
- [ [ clone ] map ] dip allocate-registers
+ [
+ [ clone ] map dup [ [ vreg>> ] keep ] H{ } map>assoc
+ live-intervals set
+ ] dip allocate-registers
[ split-children ] map concat check-assigned ;
: picture ( uses -- str )
: live-intervals. ( seq -- )
[ interval-picture ] map simple-table. ;
-
-: test-bb ( insns n -- )
- [ <basic-block> swap >>number swap >>instructions ] keep set ;
\ No newline at end of file
IN: compiler.cfg.linear-scan.tests
USING: tools.test random sorting sequences sets hashtables assocs
kernel fry arrays splitting namespaces math accessors vectors locals
-math.order grouping
+math.order grouping strings strings.private classes
cpu.architecture
compiler.cfg
compiler.cfg.optimizer
compiler.cfg.linearization
compiler.cfg.debugger
compiler.cfg.linear-scan
+compiler.cfg.linear-scan.numbering
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.allocation.splitting
compiler.cfg.linear-scan.allocation.spilling
-compiler.cfg.linear-scan.assignment
compiler.cfg.linear-scan.debugger ;
+FROM: compiler.cfg.linear-scan.assignment => check-assignment? ;
+
check-allocation? on
+check-assignment? on
+check-numbering? on
[
{ T{ live-range f 1 10 } T{ live-range f 15 15 } }
{ T{ live-range f 0 5 } } 0 split-ranges
] unit-test
-[ 7 ] [
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 2 } } }
- { start 0 }
- { end 10 }
- { uses V{ 0 1 3 7 10 } }
- }
- 4 [ >= ] find-use
-] unit-test
-
-[ 4 ] [
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 2 } } }
- { start 0 }
- { end 10 }
- { uses V{ 0 1 3 4 10 } }
- }
- 4 [ >= ] find-use
-] unit-test
-
-[ f ] [
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 2 } } }
- { start 0 }
- { end 10 }
- { uses V{ 0 1 3 4 10 } }
- }
- 100 [ >= ] find-use
-] unit-test
-
[
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 } } }
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 } } }
} 0 split-for-spill [ f >>split-next ] bi@
] unit-test
+[
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 1 }
+ { uses V{ 0 } }
+ { ranges V{ T{ live-range f 0 1 } } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 20 }
+ { end 30 }
+ { uses V{ 20 30 } }
+ { ranges V{ T{ live-range f 20 30 } } }
+ }
+] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 30 }
+ { uses V{ 0 20 30 } }
+ { ranges V{ T{ live-range f 0 8 } T{ live-range f 10 18 } T{ live-range f 20 30 } } }
+ } 10 split-for-spill [ f >>split-next ] bi@
+] unit-test
+
[
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 5 }
- { end 5 }
- { uses V{ 5 } }
- { ranges V{ T{ live-range f 5 5 } } }
+ { end 10 }
+ { uses V{ 5 10 } }
+ { ranges V{ T{ live-range f 5 10 } } }
}
] [
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
- { end 5 }
- { uses V{ 0 1 5 } }
- { ranges V{ T{ live-range f 0 5 } } }
- } 5 split-before-use [ f >>split-next ] bi@
+ { end 10 }
+ { uses V{ 0 1 4 5 10 } }
+ { ranges V{ T{ live-range f 0 10 } } }
+ } 4 split-to-fit [ f >>split-next ] bi@
] unit-test
[
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 3 }
- { end 10 }
- { uses V{ 3 10 } }
- }
-] [
{
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 1 }
- { end 15 }
- { uses V{ 1 3 7 10 15 } }
- }
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 3 }
- { end 8 }
- { uses V{ 3 4 8 } }
- }
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 3 }
- { end 10 }
- { uses V{ 3 10 } }
- }
+ 3
+ 10
}
+] [
+ H{
+ { int-regs
+ V{
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { reg 1 }
+ { start 1 }
+ { end 15 }
+ { uses V{ 1 3 7 10 15 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+ { reg 2 }
+ { start 3 }
+ { end 8 }
+ { uses V{ 3 4 8 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 3 } } }
+ { reg 3 }
+ { start 3 }
+ { end 10 }
+ { uses V{ 3 10 } }
+ }
+ }
+ }
+ } active-intervals set
+ H{ } inactive-intervals set
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 5 }
{ end 5 }
{ uses V{ 5 } }
}
- interval-to-spill
+ spill-status
] unit-test
-[ t ] [
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 5 }
- { end 15 }
- { uses V{ 5 10 15 } }
- }
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 1 }
- { end 20 }
- { uses V{ 1 20 } }
- }
- spill-existing?
-] unit-test
-
-[ f ] [
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 5 }
- { end 15 }
- { uses V{ 5 10 15 } }
- }
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 1 }
- { end 20 }
- { uses V{ 1 7 20 } }
+[
+ {
+ 1
+ 1/0.
}
- spill-existing?
-] unit-test
-
-[ t ] [
+] [
+ H{
+ { int-regs
+ V{
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { reg 1 }
+ { start 1 }
+ { end 15 }
+ { uses V{ 1 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+ { reg 2 }
+ { start 3 }
+ { end 8 }
+ { uses V{ 3 8 } }
+ }
+ }
+ }
+ } active-intervals set
+ H{ } inactive-intervals set
T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { vreg T{ vreg { reg-class int-regs } { n 3 } } }
{ start 5 }
{ end 5 }
{ uses V{ 5 } }
}
- T{ live-interval
- { vreg T{ vreg { reg-class int-regs } { n 1 } } }
- { start 1 }
- { end 20 }
- { uses V{ 1 7 20 } }
- }
- spill-existing?
+ spill-status
] unit-test
[ ] [
allocate-registers drop
] unit-test
-! Spill slot liveness was computed incorrectly, leading to a FEP
-! early in bootstrap on x86-32
-[ t 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-spill-slots>> empty? ]
- [ live-registers>> empty? ] bi
- ] with-scope
-] unit-test
-
[ f ] [
T{ live-range f 0 10 }
T{ live-range f 20 30 }
intersect-live-ranges
] unit-test
+[ f ] [
+ {
+ T{ live-range f 0 10 }
+ T{ live-range f 20 30 }
+ T{ live-range f 40 50 }
+ }
+ {
+ T{ live-range f 11 15 }
+ T{ live-range f 31 36 }
+ T{ live-range f 51 55 }
+ }
+ intersect-live-ranges
+] unit-test
+
[ 5 ] [
T{ live-interval
{ start 0 }
{ uses { 5 10 } }
{ ranges V{ T{ live-range f 5 10 } } }
}
- intersect-inactive
+ relevant-ranges intersect-live-ranges
+] unit-test
+
+! register-status had problems because it used map>assoc where the sequence
+! had multiple keys
+[ { 0 10 } ] [
+ H{ { int-regs { 0 1 } } } registers set
+ H{
+ { int-regs
+ {
+ T{ live-interval
+ { vreg V int-regs 1 }
+ { start 0 }
+ { end 20 }
+ { reg 0 }
+ { ranges V{ T{ live-range f 0 2 } T{ live-range f 10 20 } } }
+ { uses V{ 0 2 10 20 } }
+ }
+
+ T{ live-interval
+ { vreg V int-regs 2 }
+ { start 4 }
+ { end 40 }
+ { reg 0 }
+ { ranges V{ T{ live-range f 4 6 } T{ live-range f 30 40 } } }
+ { uses V{ 4 6 30 40 } }
+ }
+ }
+ }
+ } inactive-intervals set
+ H{
+ { int-regs
+ {
+ T{ live-interval
+ { vreg V int-regs 3 }
+ { start 0 }
+ { end 40 }
+ { reg 1 }
+ { ranges V{ T{ live-range f 0 40 } } }
+ { uses V{ 0 40 } }
+ }
+ }
+ }
+ } active-intervals set
+
+ T{ live-interval
+ { vreg V int-regs 4 }
+ { start 8 }
+ { end 10 }
+ { ranges V{ T{ live-range f 8 10 } } }
+ { uses V{ 8 10 } }
+ }
+ register-status
] unit-test
! Bug in live spill slots calculation
SYMBOL: linear-scan-result
:: test-linear-scan-on-cfg ( regs -- )
- [ ] [
+ [
cfg new 0 get >>entry
compute-predecessors
compute-liveness
dup reverse-post-order
{ { int-regs regs } } (linear-scan)
flatten-cfg 1array mr.
- ] unit-test ;
+ ] with-scope ;
! This test has a critical edge -- do we care about these?
-! { 1 2 } test-linear-scan-on-cfg
+! [ { 1 2 } test-linear-scan-on-cfg ] unit-test
! Bug in inactive interval handling
! [ rot dup [ -rot ] when ]
T{ ##return }
} 4 test-bb
-: test-diamond ( -- )
- 1 get 1vector 0 get (>>successors)
- 2 get 3 get V{ } 2sequence 1 get (>>successors)
- 4 get 1vector 2 get (>>successors)
- 4 get 1vector 3 get (>>successors) ;
-
test-diamond
-{ 1 2 3 4 } test-linear-scan-on-cfg
+[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test
! Similar to the above
! [ swap dup [ rot ] when ]
test-diamond
-{ 1 2 3 4 } test-linear-scan-on-cfg
+[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test
! compute-live-registers was inaccurate since it didn't take
! lifetime holes into account
test-diamond
-{ 1 2 3 4 } test-linear-scan-on-cfg
+[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test
! Inactive interval handling: splitting active interval
! if it fits in lifetime hole only partially
test-diamond
-{ 1 2 } test-linear-scan-on-cfg
-
-USING: classes ;
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
[ ] [
1 get instructions>> first regs>> V int-regs 0 swap at
test-diamond
-{ 1 2 } test-linear-scan-on-cfg
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
[ _spill ] [ 2 get instructions>> first class ] unit-test
[ _spill ] [ 3 get instructions>> second class ] unit-test
-[ _reload ] [ 4 get instructions>> first class ] unit-test
\ No newline at end of file
+[ f ] [ 3 get instructions>> [ _reload? ] any? ] unit-test
+
+[ _reload ] [ 4 get instructions>> first class ] unit-test
+
+! Resolve 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{ ##replace f V int-regs 0 D 0 }
+ 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 }
+} 2 test-bb
+
+V{
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##peek f V int-regs 1 D 0 }
+ T{ ##compare-imm-branch f V int-regs 1 5 cc= }
+} 4 test-bb
+
+V{
+ T{ ##replace f V int-regs 0 D 0 }
+ T{ ##return }
+} 5 test-bb
+
+V{
+ T{ ##replace f V int-regs 0 D 0 }
+ T{ ##return }
+} 6 test-bb
+
+0 get 1 get V{ } 1sequence >>successors drop
+1 get 2 get 3 get V{ } 2sequence >>successors drop
+2 get 4 get V{ } 1sequence >>successors drop
+3 get 4 get V{ } 1sequence >>successors drop
+4 get 5 get 6 get V{ } 2sequence >>successors drop
+
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
+
+[ t ] [ 2 get instructions>> [ _spill? ] any? ] unit-test
+
+[ t ] [ 3 get instructions>> [ _spill? ] any? ] unit-test
+
+[ t ] [ 5 get instructions>> [ _reload? ] any? ] unit-test
+
+! A more complicated failure case with resolve that came up after the above
+! got fixed
+V{ T{ ##branch } } 0 test-bb
+V{
+ 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 0 }
+ T{ ##branch }
+} 1 test-bb
+V{ T{ ##branch } } 2 test-bb
+V{ T{ ##branch } } 3 test-bb
+V{
+
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 3 D 3 }
+ T{ ##replace f V int-regs 4 D 4 }
+ T{ ##replace f V int-regs 0 D 0 }
+ T{ ##branch }
+} 4 test-bb
+V{ T{ ##replace f V int-regs 0 D 0 } T{ ##branch } } 5 test-bb
+V{ T{ ##return } } 6 test-bb
+V{ T{ ##branch } } 7 test-bb
+V{
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 3 D 3 }
+ T{ ##peek f V int-regs 5 D 1 }
+ T{ ##peek f V int-regs 6 D 2 }
+ T{ ##peek f V int-regs 7 D 3 }
+ T{ ##peek f V int-regs 8 D 4 }
+ T{ ##replace f V int-regs 5 D 1 }
+ T{ ##replace f V int-regs 6 D 2 }
+ T{ ##replace f V int-regs 7 D 3 }
+ T{ ##replace f V int-regs 8 D 4 }
+ T{ ##branch }
+} 8 test-bb
+V{
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 3 D 3 }
+ T{ ##return }
+} 9 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 7 get V{ } 2sequence >>successors drop
+7 get 8 get 1vector >>successors drop
+8 get 9 get 1vector >>successors drop
+2 get 3 get 5 get V{ } 2sequence >>successors drop
+3 get 4 get 1vector >>successors drop
+4 get 9 get 1vector >>successors drop
+5 get 6 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test
+
+[ _spill ] [ 1 get instructions>> second class ] unit-test
+[ _reload ] [ 4 get instructions>> 4 swap nth class ] unit-test
+[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ n>> ] map ] unit-test
+[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> ] map ] unit-test
+
+! Resolve pass should insert this
+[ _reload ] [ 5 get instructions>> first class ] unit-test
+
+! Some random bug
+V{
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##peek f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##peek f V int-regs 3 D 0 }
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##branch }
+} 0 test-bb
+
+V{ T{ ##branch } } 1 test-bb
+
+V{
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##peek f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 3 D 3 }
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 0 D 3 }
+ T{ ##branch }
+} 2 test-bb
+
+V{ T{ ##branch } } 3 test-bb
+
+V{
+ T{ ##return }
+} 4 test-bb
+
+test-diamond
+
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
+
+! Spilling an interval immediately after its activated;
+! and the interval does not have a use at the activation point
+V{
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##peek f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##branch }
+} 0 test-bb
+
+V{ T{ ##branch } } 1 test-bb
+
+V{
+ T{ ##peek f V int-regs 1 D 1 }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##replace f V int-regs 1 D 1 }
+ T{ ##peek f V int-regs 2 D 2 }
+ T{ ##replace f V int-regs 2 D 2 }
+ T{ ##branch }
+} 3 test-bb
+
+V{ T{ ##branch } } 4 test-bb
+
+V{
+ T{ ##replace f V int-regs 0 D 0 }
+ T{ ##return }
+} 5 test-bb
+
+1 get 1vector 0 get (>>successors)
+2 get 4 get V{ } 2sequence 1 get (>>successors)
+5 get 1vector 4 get (>>successors)
+3 get 1vector 2 get (>>successors)
+5 get 1vector 3 get (>>successors)
+
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
+
+! Reduction of push-all regression, x86-32
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+
+V{
+ T{ ##load-immediate { dst V int-regs 61 } }
+ T{ ##peek { dst V int-regs 62 } { loc D 0 } }
+ T{ ##peek { dst V int-regs 64 } { loc D 1 } }
+ T{ ##slot-imm
+ { dst V int-regs 69 }
+ { obj V int-regs 64 }
+ { slot 1 }
+ { tag 2 }
+ }
+ T{ ##copy { dst V int-regs 79 } { src V int-regs 69 } }
+ T{ ##slot-imm
+ { dst V int-regs 85 }
+ { obj V int-regs 62 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##compare-branch
+ { src1 V int-regs 69 }
+ { src2 V int-regs 85 }
+ { cc cc> }
+ }
+} 1 test-bb
+
+V{
+ T{ ##slot-imm
+ { dst V int-regs 97 }
+ { obj V int-regs 62 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##replace { src V int-regs 79 } { loc D 3 } }
+ T{ ##replace { src V int-regs 62 } { loc D 4 } }
+ T{ ##replace { src V int-regs 79 } { loc D 1 } }
+ T{ ##replace { src V int-regs 62 } { loc D 2 } }
+ T{ ##replace { src V int-regs 61 } { loc D 5 } }
+ T{ ##replace { src V int-regs 62 } { loc R 0 } }
+ T{ ##replace { src V int-regs 69 } { loc R 1 } }
+ T{ ##replace { src V int-regs 97 } { loc D 0 } }
+ T{ ##call { word resize-array } }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 98 } { loc R 0 } }
+ T{ ##peek { dst V int-regs 100 } { loc D 0 } }
+ T{ ##set-slot-imm
+ { src V int-regs 100 }
+ { obj V int-regs 98 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##peek { dst V int-regs 108 } { loc D 2 } }
+ T{ ##peek { dst V int-regs 110 } { loc D 3 } }
+ T{ ##peek { dst V int-regs 112 } { loc D 0 } }
+ T{ ##peek { dst V int-regs 114 } { loc D 1 } }
+ T{ ##peek { dst V int-regs 116 } { loc D 4 } }
+ T{ ##peek { dst V int-regs 119 } { loc R 0 } }
+ T{ ##copy { dst V int-regs 109 } { src V int-regs 108 } }
+ T{ ##copy { dst V int-regs 111 } { src V int-regs 110 } }
+ T{ ##copy { dst V int-regs 113 } { src V int-regs 112 } }
+ T{ ##copy { dst V int-regs 115 } { src V int-regs 114 } }
+ T{ ##copy { dst V int-regs 117 } { src V int-regs 116 } }
+ T{ ##copy { dst V int-regs 120 } { src V int-regs 119 } }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##copy { dst V int-regs 109 } { src V int-regs 62 } }
+ T{ ##copy { dst V int-regs 111 } { src V int-regs 61 } }
+ T{ ##copy { dst V int-regs 113 } { src V int-regs 62 } }
+ T{ ##copy { dst V int-regs 115 } { src V int-regs 79 } }
+ T{ ##copy { dst V int-regs 117 } { src V int-regs 64 } }
+ T{ ##copy { dst V int-regs 120 } { src V int-regs 69 } }
+ T{ ##branch }
+} 4 test-bb
+
+V{
+ T{ ##replace { src V int-regs 120 } { loc D 0 } }
+ T{ ##replace { src V int-regs 109 } { loc D 3 } }
+ T{ ##replace { src V int-regs 111 } { loc D 4 } }
+ T{ ##replace { src V int-regs 113 } { loc D 1 } }
+ T{ ##replace { src V int-regs 115 } { loc D 2 } }
+ T{ ##replace { src V int-regs 117 } { loc D 5 } }
+ T{ ##epilogue }
+ T{ ##return }
+} 5 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 4 get V{ } 2sequence >>successors drop
+2 get 3 get 1vector >>successors drop
+3 get 5 get 1vector >>successors drop
+4 get 5 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
+
+! Another reduction of push-all
+V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 85 } { loc D 0 } }
+ T{ ##slot-imm
+ { dst V int-regs 89 }
+ { obj V int-regs 85 }
+ { slot 3 }
+ { tag 7 }
+ }
+ T{ ##peek { dst V int-regs 91 } { loc D 1 } }
+ T{ ##slot-imm
+ { dst V int-regs 96 }
+ { obj V int-regs 91 }
+ { slot 1 }
+ { tag 2 }
+ }
+ T{ ##add
+ { dst V int-regs 109 }
+ { src1 V int-regs 89 }
+ { src2 V int-regs 96 }
+ }
+ T{ ##slot-imm
+ { dst V int-regs 115 }
+ { obj V int-regs 85 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##slot-imm
+ { dst V int-regs 118 }
+ { obj V int-regs 115 }
+ { slot 1 }
+ { tag 2 }
+ }
+ T{ ##compare-branch
+ { src1 V int-regs 109 }
+ { src2 V int-regs 118 }
+ { cc cc> }
+ }
+} 1 test-bb
+
+V{
+ T{ ##add-imm
+ { dst V int-regs 128 }
+ { src1 V int-regs 109 }
+ { src2 8 }
+ }
+ T{ ##load-immediate { dst V int-regs 129 } { val 24 } }
+ T{ ##inc-d { n 4 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##replace { src V int-regs 109 } { loc D 2 } }
+ T{ ##replace { src V int-regs 85 } { loc D 3 } }
+ T{ ##replace { src V int-regs 128 } { loc D 0 } }
+ T{ ##replace { src V int-regs 85 } { loc D 1 } }
+ T{ ##replace { src V int-regs 89 } { loc D 4 } }
+ T{ ##replace { src V int-regs 96 } { loc R 0 } }
+ T{ ##fixnum-mul
+ { src1 V int-regs 128 }
+ { src2 V int-regs 129 }
+ { temp1 V int-regs 132 }
+ { temp2 V int-regs 133 }
+ }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 134 } { loc D 1 } }
+ T{ ##slot-imm
+ { dst V int-regs 140 }
+ { obj V int-regs 134 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##inc-d { n 1 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##replace { src V int-regs 140 } { loc D 0 } }
+ T{ ##replace { src V int-regs 134 } { loc R 0 } }
+ T{ ##call { word resize-array } }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 141 } { loc R 0 } }
+ T{ ##peek { dst V int-regs 143 } { loc D 0 } }
+ T{ ##set-slot-imm
+ { src V int-regs 143 }
+ { obj V int-regs 141 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##write-barrier
+ { src V int-regs 141 }
+ { card# V int-regs 145 }
+ { table V int-regs 146 }
+ }
+ T{ ##inc-d { n -1 } }
+ T{ ##inc-r { n -1 } }
+ T{ ##peek { dst V int-regs 156 } { loc D 2 } }
+ T{ ##peek { dst V int-regs 158 } { loc D 3 } }
+ T{ ##peek { dst V int-regs 160 } { loc D 0 } }
+ T{ ##peek { dst V int-regs 162 } { loc D 1 } }
+ T{ ##peek { dst V int-regs 164 } { loc D 4 } }
+ T{ ##peek { dst V int-regs 167 } { loc R 0 } }
+ T{ ##copy { dst V int-regs 157 } { src V int-regs 156 } }
+ T{ ##copy { dst V int-regs 159 } { src V int-regs 158 } }
+ T{ ##copy { dst V int-regs 161 } { src V int-regs 160 } }
+ T{ ##copy { dst V int-regs 163 } { src V int-regs 162 } }
+ T{ ##copy { dst V int-regs 165 } { src V int-regs 164 } }
+ T{ ##copy { dst V int-regs 168 } { src V int-regs 167 } }
+ T{ ##branch }
+} 4 test-bb
+
+V{
+ T{ ##inc-d { n 3 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##copy { dst V int-regs 157 } { src V int-regs 85 } }
+ T{ ##copy { dst V int-regs 159 } { src V int-regs 89 } }
+ T{ ##copy { dst V int-regs 161 } { src V int-regs 85 } }
+ T{ ##copy { dst V int-regs 163 } { src V int-regs 109 } }
+ T{ ##copy { dst V int-regs 165 } { src V int-regs 91 } }
+ T{ ##copy { dst V int-regs 168 } { src V int-regs 96 } }
+ T{ ##branch }
+} 5 test-bb
+
+V{
+ T{ ##set-slot-imm
+ { src V int-regs 163 }
+ { obj V int-regs 161 }
+ { slot 3 }
+ { tag 7 }
+ }
+ T{ ##inc-d { n 1 } }
+ T{ ##inc-r { n -1 } }
+ T{ ##replace { src V int-regs 168 } { loc D 0 } }
+ T{ ##replace { src V int-regs 157 } { loc D 3 } }
+ T{ ##replace { src V int-regs 159 } { loc D 4 } }
+ T{ ##replace { src V int-regs 161 } { loc D 1 } }
+ T{ ##replace { src V int-regs 163 } { loc D 2 } }
+ T{ ##replace { src V int-regs 165 } { loc D 5 } }
+ T{ ##epilogue }
+ T{ ##return }
+} 6 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 5 get V{ } 2sequence >>successors drop
+2 get 3 get 1vector >>successors drop
+3 get 4 get 1vector >>successors drop
+4 get 6 get 1vector >>successors drop
+5 get 6 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
+
+! Another push-all reduction to demonstrate numbering anamoly
+V{ T{ ##prologue } T{ ##branch } }
+0 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 1 } { loc D 0 } }
+ T{ ##slot-imm
+ { dst V int-regs 5 }
+ { obj V int-regs 1 }
+ { slot 3 }
+ { tag 7 }
+ }
+ T{ ##peek { dst V int-regs 7 } { loc D 1 } }
+ T{ ##slot-imm
+ { dst V int-regs 12 }
+ { obj V int-regs 7 }
+ { slot 1 }
+ { tag 6 }
+ }
+ T{ ##add
+ { dst V int-regs 25 }
+ { src1 V int-regs 5 }
+ { src2 V int-regs 12 }
+ }
+ T{ ##compare-branch
+ { src1 V int-regs 25 }
+ { src2 V int-regs 5 }
+ { cc cc> }
+ }
+}
+1 test-bb
+
+V{
+ T{ ##slot-imm
+ { dst V int-regs 41 }
+ { obj V int-regs 1 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##slot-imm
+ { dst V int-regs 44 }
+ { obj V int-regs 41 }
+ { slot 1 }
+ { tag 6 }
+ }
+ T{ ##compare-branch
+ { src1 V int-regs 25 }
+ { src2 V int-regs 44 }
+ { cc cc> }
+ }
+}
+2 test-bb
+
+V{
+ T{ ##add-imm
+ { dst V int-regs 54 }
+ { src1 V int-regs 25 }
+ { src2 8 }
+ }
+ T{ ##load-immediate { dst V int-regs 55 } { val 24 } }
+ T{ ##inc-d { n 4 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##replace { src V int-regs 25 } { loc D 2 } }
+ T{ ##replace { src V int-regs 1 } { loc D 3 } }
+ T{ ##replace { src V int-regs 5 } { loc D 4 } }
+ T{ ##replace { src V int-regs 1 } { loc D 1 } }
+ T{ ##replace { src V int-regs 54 } { loc D 0 } }
+ T{ ##replace { src V int-regs 12 } { loc R 0 } }
+ T{ ##fixnum-mul
+ { src1 V int-regs 54 }
+ { src2 V int-regs 55 }
+ { temp1 V int-regs 58 }
+ { temp2 V int-regs 59 }
+ }
+ T{ ##branch }
+}
+3 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 60 } { loc D 1 } }
+ T{ ##slot-imm
+ { dst V int-regs 66 }
+ { obj V int-regs 60 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##inc-d { n 1 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##replace { src V int-regs 66 } { loc D 0 } }
+ T{ ##replace { src V int-regs 60 } { loc R 0 } }
+ T{ ##call { word resize-string } }
+ T{ ##branch }
+}
+4 test-bb
+
+V{
+ T{ ##peek { dst V int-regs 67 } { loc R 0 } }
+ T{ ##peek { dst V int-regs 68 } { loc D 0 } }
+ T{ ##set-slot-imm
+ { src V int-regs 68 }
+ { obj V int-regs 67 }
+ { slot 2 }
+ { tag 7 }
+ }
+ T{ ##write-barrier
+ { src V int-regs 67 }
+ { card# V int-regs 75 }
+ { table V int-regs 76 }
+ }
+ T{ ##inc-d { n -1 } }
+ T{ ##inc-r { n -1 } }
+ T{ ##peek { dst V int-regs 94 } { loc D 0 } }
+ T{ ##peek { dst V int-regs 96 } { loc D 1 } }
+ T{ ##peek { dst V int-regs 98 } { loc D 2 } }
+ T{ ##peek { dst V int-regs 100 } { loc D 3 } }
+ T{ ##peek { dst V int-regs 102 } { loc D 4 } }
+ T{ ##peek { dst V int-regs 106 } { loc R 0 } }
+ T{ ##copy { dst V int-regs 95 } { src V int-regs 94 } }
+ T{ ##copy { dst V int-regs 97 } { src V int-regs 96 } }
+ T{ ##copy { dst V int-regs 99 } { src V int-regs 98 } }
+ T{ ##copy { dst V int-regs 101 } { src V int-regs 100 } }
+ T{ ##copy { dst V int-regs 103 } { src V int-regs 102 } }
+ T{ ##copy { dst V int-regs 107 } { src V int-regs 106 } }
+ T{ ##branch }
+}
+5 test-bb
+
+V{
+ T{ ##inc-d { n 3 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##copy { dst V int-regs 95 } { src V int-regs 1 } }
+ T{ ##copy { dst V int-regs 97 } { src V int-regs 25 } }
+ T{ ##copy { dst V int-regs 99 } { src V int-regs 1 } }
+ T{ ##copy { dst V int-regs 101 } { src V int-regs 5 } }
+ T{ ##copy { dst V int-regs 103 } { src V int-regs 7 } }
+ T{ ##copy { dst V int-regs 107 } { src V int-regs 12 } }
+ T{ ##branch }
+}
+6 test-bb
+
+V{
+ T{ ##load-immediate
+ { dst V int-regs 78 }
+ { val 4611686018427387896 }
+ }
+ T{ ##and
+ { dst V int-regs 81 }
+ { src1 V int-regs 97 }
+ { src2 V int-regs 78 }
+ }
+ T{ ##set-slot-imm
+ { src V int-regs 81 }
+ { obj V int-regs 95 }
+ { slot 3 }
+ { tag 7 }
+ }
+ T{ ##inc-d { n -2 } }
+ T{ ##copy { dst V int-regs 110 } { src V int-regs 99 } }
+ T{ ##copy { dst V int-regs 111 } { src V int-regs 101 } }
+ T{ ##copy { dst V int-regs 112 } { src V int-regs 103 } }
+ T{ ##copy { dst V int-regs 117 } { src V int-regs 107 } }
+ T{ ##branch }
+}
+7 test-bb
+
+V{
+ T{ ##inc-d { n 1 } }
+ T{ ##inc-r { n 1 } }
+ T{ ##copy { dst V int-regs 110 } { src V int-regs 1 } }
+ T{ ##copy { dst V int-regs 111 } { src V int-regs 5 } }
+ T{ ##copy { dst V int-regs 112 } { src V int-regs 7 } }
+ T{ ##copy { dst V int-regs 117 } { src V int-regs 12 } }
+ T{ ##branch }
+}
+8 test-bb
+
+V{
+ T{ ##inc-d { n 1 } }
+ T{ ##inc-r { n -1 } }
+ T{ ##replace { src V int-regs 117 } { loc D 0 } }
+ T{ ##replace { src V int-regs 110 } { loc D 1 } }
+ T{ ##replace { src V int-regs 111 } { loc D 2 } }
+ T{ ##replace { src V int-regs 112 } { loc D 3 } }
+ T{ ##epilogue }
+ T{ ##return }
+}
+9 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 8 get V{ } 2sequence >>successors drop
+2 get 3 get 6 get V{ } 2sequence >>successors drop
+3 get 4 get 1vector >>successors drop
+4 get 5 get 1vector >>successors drop
+5 get 7 get 1vector >>successors drop
+6 get 7 get 1vector >>successors drop
+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
+
+! 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
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.assignment
-compiler.cfg.linear-scan.resolve ;
+compiler.cfg.linear-scan.resolve
+compiler.cfg.linear-scan.mapping ;
IN: compiler.cfg.linear-scan
! References:
rpo number-instructions
rpo compute-live-intervals machine-registers allocate-registers
rpo assign-registers
- rpo resolve-data-flow ;
+ rpo resolve-data-flow
+ rpo check-numbering ;
: linear-scan ( cfg -- cfg' )
[
+ init-mapping
dup reverse-post-order machine-registers (linear-scan)
spill-counts get >>spill-counts
] with-scope ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs accessors sequences math math.order fry
-binary-search combinators compiler.cfg.instructions compiler.cfg.registers
+combinators compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ;
IN: compiler.cfg.linear-scan.live-intervals
V{ } clone >>ranges
swap >>vreg ;
-: block-from ( bb -- n ) instructions>> first insn#>> ;
+: block-from ( bb -- n ) instructions>> first insn#>> 1 - ;
: block-to ( bb -- n ) instructions>> last insn#>> ;
<reversed> [ compute-live-intervals-step ] each
] keep values dup finish-live-intervals ;
-: relevant-ranges ( new inactive -- new' inactive' )
- ! Slice off all ranges of 'inactive' that precede the start of 'new'
+: relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
[ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
: intersect-live-range ( range1 range2 -- n/f )
: intersect-live-ranges ( ranges1 ranges2 -- n )
{
- { [ over empty? ] [ 2drop 1/0. ] }
- { [ dup empty? ] [ 2drop 1/0. ] }
+ { [ over empty? ] [ 2drop f ] }
+ { [ dup empty? ] [ 2drop f ] }
[
2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
drop
] if
]
} cond ;
+
+: intervals-intersect? ( interval1 interval2 -- ? )
+ relevant-ranges intersect-live-ranges >boolean ; inline
\ No newline at end of file
--- /dev/null
+USING: compiler.cfg.instructions
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.mapping cpu.architecture kernel
+namespaces tools.test ;
+IN: compiler.cfg.linear-scan.mapping.tests
+
+H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set
+init-mapping
+
+[
+ {
+ T{ _copy { dst 5 } { src 4 } { class int-regs } }
+ T{ _spill { src 1 } { class int-regs } { n 10 } }
+ T{ _copy { dst 1 } { src 0 } { class int-regs } }
+ T{ _reload { dst 0 } { class int-regs } { n 10 } }
+ T{ _spill { src 1 } { class float-regs } { n 20 } }
+ T{ _copy { dst 1 } { src 0 } { class float-regs } }
+ T{ _reload { dst 0 } { class float-regs } { n 20 } }
+ }
+] [
+ {
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ T{ register->register { from 1 } { to 0 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 1 } { reg-class float-regs } }
+ T{ register->register { from 1 } { to 0 } { reg-class float-regs } }
+ T{ register->register { from 4 } { to 5 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ {
+ T{ _spill { src 2 } { class int-regs } { n 10 } }
+ T{ _copy { dst 2 } { src 1 } { class int-regs } }
+ T{ _copy { dst 1 } { src 0 } { class int-regs } }
+ T{ _reload { dst 0 } { class int-regs } { n 10 } }
+ }
+] [
+ {
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
+ T{ register->register { from 2 } { to 0 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ {
+ T{ _spill { src 0 } { class int-regs } { n 10 } }
+ T{ _copy { dst 0 } { src 2 } { class int-regs } }
+ T{ _copy { dst 2 } { src 1 } { class int-regs } }
+ T{ _reload { dst 1 } { class int-regs } { n 10 } }
+ }
+] [
+ {
+ T{ register->register { from 1 } { to 2 } { reg-class int-regs } }
+ T{ register->register { from 2 } { to 0 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ {
+ T{ _copy { dst 1 } { src 0 } { class int-regs } }
+ T{ _copy { dst 2 } { src 0 } { class int-regs } }
+ }
+] [
+ {
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ { }
+] [
+ {
+ T{ register->register { from 4 } { to 4 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ {
+ T{ _spill { src 3 } { class int-regs } { n 4 } }
+ T{ _reload { dst 2 } { class int-regs } { n 1 } }
+ }
+] [
+ {
+ T{ register->memory { from 3 } { to T{ spill-slot f 4 } } { reg-class int-regs } }
+ T{ memory->register { from T{ spill-slot f 1 } } { to 2 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+
+[
+ {
+ T{ _copy { dst 1 } { src 0 } { class int-regs } }
+ T{ _copy { dst 2 } { src 0 } { class int-regs } }
+ T{ _copy { dst 0 } { src 3 } { class int-regs } }
+ }
+] [
+ {
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ T{ register->register { from 3 } { to 0 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ {
+ T{ _copy { dst 1 } { src 0 } { class int-regs } }
+ T{ _copy { dst 2 } { src 0 } { class int-regs } }
+ T{ _spill { src 4 } { class int-regs } { n 10 } }
+ T{ _copy { dst 4 } { src 0 } { class int-regs } }
+ T{ _copy { dst 0 } { src 3 } { class int-regs } }
+ T{ _reload { dst 3 } { class int-regs } { n 10 } }
+ }
+] [
+ {
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
+ T{ register->register { from 3 } { to 0 } { reg-class int-regs } }
+ T{ register->register { from 4 } { to 3 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 4 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
+
+[
+ {
+ T{ _copy { dst 2 } { src 0 } { class int-regs } }
+ T{ _copy { dst 9 } { src 1 } { class int-regs } }
+ T{ _copy { dst 1 } { src 0 } { class int-regs } }
+ T{ _spill { src 4 } { class int-regs } { n 10 } }
+ T{ _copy { dst 4 } { src 0 } { class int-regs } }
+ T{ _copy { dst 0 } { src 3 } { class int-regs } }
+ T{ _reload { dst 3 } { class int-regs } { n 10 } }
+ }
+] [
+ {
+ T{ register->register { from 0 } { to 1 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 2 } { reg-class int-regs } }
+ T{ register->register { from 1 } { to 9 } { reg-class int-regs } }
+ T{ register->register { from 3 } { to 0 } { reg-class int-regs } }
+ T{ register->register { from 4 } { to 3 } { reg-class int-regs } }
+ T{ register->register { from 0 } { to 4 } { reg-class int-regs } }
+ } mapping-instructions
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs classes.parser classes.tuple
+combinators compiler.cfg.instructions
+compiler.cfg.linear-scan.allocation.state fry hashtables kernel
+locals make namespaces parser sequences sets words ;
+IN: compiler.cfg.linear-scan.mapping
+
+SYMBOL: spill-temps
+
+: spill-temp ( reg-class -- n )
+ spill-temps get [ next-spill-slot ] cache ;
+
+<<
+
+TUPLE: operation from to reg-class ;
+
+SYNTAX: OPERATION:
+ CREATE-CLASS dup save-location
+ [ operation { } define-tuple-class ]
+ [ dup '[ _ boa , ] (( from to reg-class -- )) define-declared ] bi ;
+
+>>
+
+OPERATION: register->memory
+OPERATION: memory->register
+OPERATION: register->register
+
+! This should never come up because of how spill slots are assigned,
+! so make it an error.
+: memory->memory ( from to reg-class -- ) drop [ n>> ] bi@ assert= ;
+
+GENERIC: >insn ( operation -- )
+
+M: register->memory >insn
+ [ from>> ] [ reg-class>> ] [ to>> n>> ] tri _spill ;
+
+M: memory->register >insn
+ [ to>> ] [ reg-class>> ] [ from>> n>> ] tri _reload ;
+
+M: register->register >insn
+ [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
+
+SYMBOL: froms
+SYMBOL: tos
+
+SINGLETONS: memory register ;
+
+: from-loc ( operation -- obj ) from>> spill-slot? memory register ? ;
+
+: to-loc ( operation -- obj ) to>> spill-slot? memory register ? ;
+
+: from-reg ( operation -- seq )
+ [ from-loc ] [ from>> ] [ reg-class>> ] tri 3array ;
+
+: to-reg ( operation -- seq )
+ [ to-loc ] [ to>> ] [ reg-class>> ] tri 3array ;
+
+: start? ( operations -- pair )
+ from-reg tos get key? not ;
+
+: independent-assignment? ( operations -- pair )
+ to-reg froms get key? not ;
+
+: set-tos/froms ( operations -- )
+ [ [ [ from-reg ] keep ] H{ } map>assoc froms set ]
+ [ [ [ to-reg ] keep ] H{ } map>assoc tos set ]
+ bi ;
+
+:: (trace-chain) ( obj hashtable -- )
+ obj to-reg froms get at* [
+ dup ,
+ obj over hashtable clone [ maybe-set-at ] keep swap
+ [ (trace-chain) ] [ 2drop ] if
+ ] [
+ drop
+ ] if ;
+
+: trace-chain ( obj -- seq )
+ [
+ dup ,
+ dup dup associate (trace-chain)
+ ] { } make prune reverse ;
+
+: trace-chains ( seq -- seq' )
+ [ trace-chain ] map concat ;
+
+ERROR: resolve-error ;
+
+: split-cycle ( operations -- chain spilled-operation )
+ unclip [
+ [ set-tos/froms ]
+ [
+ [ start? ] find nip
+ [ resolve-error ] unless* trace-chain
+ ] bi
+ ] dip ;
+
+: break-cycle-n ( operations -- operations' )
+ split-cycle [
+ [ from>> ]
+ [ reg-class>> spill-temp <spill-slot> ]
+ [ reg-class>> ]
+ tri \ register->memory boa
+ ] [
+ [ reg-class>> spill-temp <spill-slot> ]
+ [ to>> ]
+ [ reg-class>> ]
+ tri \ memory->register boa
+ ] bi [ 1array ] bi@ surround ;
+
+: break-cycle ( operations -- operations' )
+ dup length {
+ { 1 [ ] }
+ [ drop break-cycle-n ]
+ } case ;
+
+: (group-cycles) ( seq -- )
+ [
+ dup set-tos/froms
+ unclip trace-chain
+ [ diff ] keep , (group-cycles)
+ ] unless-empty ;
+
+: group-cycles ( seq -- seqs )
+ [ (group-cycles) ] { } make ;
+
+: remove-dead-mappings ( seq -- seq' )
+ prune [ [ from-reg ] [ to-reg ] bi = not ] filter ;
+
+: parallel-mappings ( operations -- seq )
+ [
+ [ independent-assignment? not ] partition %
+ [ start? not ] partition
+ [ trace-chain ] map concat dup %
+ diff group-cycles [ break-cycle ] map concat %
+ ] { } make remove-dead-mappings ;
+
+: mapping-instructions ( mappings -- insns )
+ [ { } ] [
+ [
+ [ set-tos/froms ] [ parallel-mappings ] bi
+ [ [ >insn ] each ] { } make
+ ] with-scope
+ ] if-empty ;
+
+: init-mapping ( -- )
+ H{ } clone spill-temps set ;
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math sequences ;
+USING: kernel accessors math sequences grouping namespaces ;
IN: compiler.cfg.linear-scan.numbering
: number-instructions ( rpo -- )
instructions>> [
[ (>>insn#) ] [ drop 2 + ] 2bi
] each
- ] each drop ;
\ No newline at end of file
+ ] each drop ;
+
+SYMBOL: check-numbering?
+
+ERROR: bad-numbering bb ;
+
+: check-block-numbering ( bb -- )
+ dup instructions>> [ insn#>> ] map sift [ <= ] monotonic?
+ [ drop ] [ bad-numbering ] if ;
+
+: check-numbering ( rpo -- )
+ check-numbering? get [ [ check-block-numbering ] each ] [ drop ] if ;
\ No newline at end of file
-USING: accessors arrays compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.debugger
-compiler.cfg.linear-scan.live-intervals
-compiler.cfg.linear-scan.numbering
-compiler.cfg.linear-scan.resolve compiler.cfg.predecessors
-compiler.cfg.registers compiler.cfg.rpo cpu.architecture kernel
-namespaces tools.test vectors ;
+USING: arrays compiler.cfg.linear-scan.resolve kernel
+tools.test ;
IN: compiler.cfg.linear-scan.resolve.tests
[ { 1 2 3 4 5 6 } ] [
{ 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
] unit-test
-
-V{
- T{ ##peek f V int-regs 0 D 0 }
- T{ ##branch }
-} 0 test-bb
-
-V{
- T{ ##replace f V int-regs 0 D 1 }
- T{ ##return }
-} 1 test-bb
-
-1 get 1vector 0 get (>>successors)
-
-cfg new 0 get >>entry
-compute-predecessors
-dup reverse-post-order number-instructions
-drop
-
-CONSTANT: test-live-interval-1
-T{ live-interval
- { start 0 }
- { end 6 }
- { uses V{ 0 6 } }
- { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
- { spill-to 0 }
- { vreg V int-regs 0 }
-}
-
-[ f ] [
- 0 get test-live-interval-1 spill-to
-] unit-test
-
-[ 0 ] [
- 1 get test-live-interval-1 spill-to
-] unit-test
-
-CONSTANT: test-live-interval-2
-T{ live-interval
- { start 0 }
- { end 6 }
- { uses V{ 0 6 } }
- { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
- { reload-from 0 }
- { vreg V int-regs 0 }
-}
-
-[ 0 ] [
- 0 get test-live-interval-2 reload-from
-] unit-test
-
-[ f ] [
- 1 get test-live-interval-2 reload-from
-] unit-test
\ No newline at end of file
-! Copyright (C) 2009 Slava Pestov
+! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel math namespaces sequences
-classes.tuple classes.parser parser fry words make arrays
-locals combinators compiler.cfg.linear-scan.live-intervals
-compiler.cfg.liveness compiler.cfg.instructions ;
+USING: accessors arrays assocs combinators
+combinators.short-circuit fry kernel locals
+make math sequences
+compiler.cfg.instructions
+compiler.cfg.linear-scan.assignment
+compiler.cfg.linear-scan.mapping compiler.cfg.liveness ;
IN: compiler.cfg.linear-scan.resolve
-<<
-
-TUPLE: operation from to reg-class ;
-
-SYNTAX: OPERATION:
- CREATE-CLASS dup save-location
- [ operation { } define-tuple-class ]
- [
- [ scan-word scan-word ] keep
- '[
- [ [ _ execute ] [ _ execute ] bi* ]
- [ vreg>> reg-class>> ]
- bi _ boa ,
- ] (( from to -- )) define-declared
- ] bi ;
-
->>
-
-: reload-from ( bb live-interval -- n/f )
- 2dup [ block-from ] [ start>> ] bi* =
- [ nip reload-from>> ] [ 2drop f ] if ;
-
-: spill-to ( bb live-interval -- n/f )
- 2dup [ block-to ] [ end>> ] bi* =
- [ nip spill-to>> ] [ 2drop f ] if ;
-
-OPERATION: memory->memory spill-to>> reload-from>>
-OPERATION: register->memory reg>> reload-from>>
-OPERATION: memory->register spill-to>> reg>>
-OPERATION: register->register reg>> reg>>
-
-:: add-mapping ( bb1 bb2 li1 li2 -- )
- bb2 li2 reload-from [
- bb1 li1 spill-to
- [ li1 li2 memory->memory ]
- [ li1 li2 register->memory ] if
+: add-mapping ( from to reg-class -- )
+ over spill-slot? [
+ pick spill-slot?
+ [ memory->memory ]
+ [ register->memory ] if
] [
- bb1 li1 spill-to
- [ li1 li2 memory->register ]
- [ li1 li2 register->register ] if
+ pick spill-slot?
+ [ memory->register ]
+ [ register->register ] if
] if ;
-: resolve-value-data-flow ( bb to vreg -- )
- [ 2dup ] dip
- live-intervals get at
- [ [ block-to ] dip child-interval-at ]
- [ [ block-from ] dip child-interval-at ]
- bi-curry bi* 2dup eq? [ 2drop 2drop ] [ add-mapping ] if ;
+:: resolve-value-data-flow ( bb to vreg -- )
+ vreg bb vreg-at-end
+ vreg to vreg-at-start
+ 2dup eq? [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
: compute-mappings ( bb to -- mappings )
[
[ resolve-value-data-flow ] with with each
] { } make ;
-GENERIC: >insn ( operation -- )
-
-M: memory->memory >insn
- [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
-
-M: register->memory >insn
- [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
-
-M: memory->register >insn
- [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
-
-M: register->register >insn
- [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
-
-: mapping-instructions ( mappings -- insns )
- [ [ >insn ] each ] { } make ;
-
: fork? ( from to -- ? )
- [ successors>> length 1 >= ]
- [ predecessors>> length 1 = ] bi* and ; inline
+ {
+ [ drop successors>> length 1 >= ]
+ [ nip predecessors>> length 1 = ]
+ } 2&& ; inline
: insert-position/fork ( from to -- before after )
nip instructions>> [ >array ] [ dup delete-all ] bi swap ;
: join? ( from to -- ? )
- [ successors>> length 1 = ]
- [ predecessors>> length 1 >= ] bi* and ; inline
+ {
+ [ drop successors>> length 1 = ]
+ [ nip predecessors>> length 1 >= ]
+ } 2&& ; inline
: insert-position/join ( from to -- before after )
drop instructions>> dup pop 1array ;
dup successors>> [ resolve-edge-data-flow ] with each ;
: resolve-data-flow ( rpo -- )
- [ resolve-block-data-flow ] each ;
\ No newline at end of file
+ [ resolve-block-data-flow ] each ;
#! don't need to branch.
[ number>> ] bi@ 1 - = ; inline
-: branch-to-branch? ( successor -- ? )
- #! A branch to a block containing just a jump return is cloned.
- instructions>> dup length 2 = [
- [ first ##epilogue? ]
- [ second [ ##return? ] [ ##jump? ] bi or ] bi and
- ] [ drop f ] if ;
-
: emit-branch ( basic-block successor -- )
- {
- { [ 2dup useless-branch? ] [ 2drop ] }
- { [ dup branch-to-branch? ] [ nip linearize-basic-block ] }
- [ nip number>> _branch ]
- } cond ;
+ 2dup useless-branch? [ 2drop ] [ nip number>> _branch ] if ;
M: ##branch linearize-insn
drop dup successors>> first emit-branch ;
[ successors>> [ number>> _dispatch-label ] each ]
bi* ;
-: gc-root-registers ( n live-registers -- n )
- [
- [ second 2array , ]
- [ first reg-class>> reg-size + ]
- 2bi
- ] each ;
-
-: gc-root-spill-slots ( n live-spill-slots -- n )
+: (compute-gc-roots) ( n live-values -- n )
[
- dup first reg-class>> int-regs eq? [
- [ second <spill-slot> 2array , ]
- [ first reg-class>> reg-size + ]
- 2bi
- ] [ drop ] if
- ] each ;
+ [ nip 2array , ]
+ [ drop reg-class>> reg-size + ]
+ 3bi
+ ] assoc-each ;
-: oop-registers ( regs -- regs' )
- [ first reg-class>> int-regs eq? ] filter ;
+: oop-values ( regs -- regs' )
+ [ drop reg-class>> int-regs eq? ] assoc-filter ;
-: data-registers ( regs -- regs' )
- [ first reg-class>> double-float-regs eq? ] filter ;
+: data-values ( regs -- regs' )
+ [ drop reg-class>> double-float-regs eq? ] assoc-filter ;
-:: compute-gc-roots ( live-registers live-spill-slots -- alist )
+: compute-gc-roots ( live-values -- alist )
[
- 0
+ [ 0 ] dip
! we put float registers last; the GC doesn't actually scan them
- live-registers oop-registers gc-root-registers
- live-spill-slots gc-root-spill-slots
- live-registers data-registers gc-root-registers
+ [ oop-values (compute-gc-roots) ]
+ [ data-values (compute-gc-roots) ] bi
drop
] { } make ;
-: count-gc-roots ( live-registers live-spill-slots -- n )
+: count-gc-roots ( live-values -- n )
! Size of GC root area, minus the float registers
- [ oop-registers length ] bi@ + ;
+ oop-values assoc-size ;
M: ##gc linearize-insn
nip
[ temp1>> ]
[ temp2>> ]
[
- [ live-registers>> ] [ live-spill-slots>> ] bi
+ live-values>>
[ compute-gc-roots ]
[ count-gc-roots ]
[ gc-roots-size ]
- 2tri
+ tri
] tri
_gc
] with-regs ;
--- /dev/null
+USING: compiler.cfg compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.liveness accessors tools.test cpu.architecture ;
+IN: compiler.cfg.liveness.tests
+
+[
+ H{
+ { "A" H{ { V int-regs 1 V int-regs 1 } { V int-regs 4 V int-regs 4 } } }
+ { "B" H{ { V int-regs 3 V int-regs 3 } { V int-regs 2 V int-regs 2 } } }
+ }
+] [
+ <basic-block> V{
+ T{ ##phi f V int-regs 0 { { "A" V int-regs 1 } { "B" V int-regs 2 } } }
+ T{ ##phi f V int-regs 1 { { "B" V int-regs 3 } { "A" V int-regs 4 } } }
+ } >>instructions compute-phi-live-in
+] unit-test
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces deques accessors sets sequences assocs fry
-dlists compiler.cfg.def-use compiler.cfg.instructions
+hashtables dlists compiler.cfg.def-use compiler.cfg.instructions
compiler.cfg.rpo ;
IN: compiler.cfg.liveness
! is in conrrespondence with a predecessor
SYMBOL: phi-live-ins
-: phi-live-in ( predecessor basic-block -- set )
- [ predecessors>> index ] keep phi-live-ins get at
- dup [ nth ] [ 2drop f ] if ;
+: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ;
! Assoc mapping basic blocks to sets of vregs
SYMBOL: live-outs
[ nip kill-set ]
2bi assoc-diff ;
+: conjoin-at ( value key assoc -- )
+ [ dupd ?set-at ] change-at ;
+
: compute-phi-live-in ( basic-block -- phi-live-in )
- instructions>> [ ##phi? ] filter
- [ f ] [ [ inputs>> ] map flip [ unique ] map ] if-empty ;
+ instructions>> [ ##phi? ] filter [ f ] [
+ H{ } clone [
+ '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each
+ ] keep
+ ] if-empty ;
: update-live-in ( basic-block -- changed? )
[ [ compute-live-in ] keep live-ins get maybe-set-at ]
-USING: arrays sequences tools.test compiler.cfg.checker compiler.cfg.debugger
-compiler.cfg.def-use sets kernel kernel.private fry slots.private vectors
-sequences.private math sbufs math.private slots.private strings ;
+USING: accessors arrays compiler.cfg.checker
+compiler.cfg.debugger compiler.cfg.def-use
+compiler.cfg.instructions fry kernel kernel.private math
+math.private sbufs sequences sequences.private sets
+slots.private strings tools.test vectors layouts ;
IN: compiler.cfg.optimizer.tests
! Miscellaneous tests
} [
[ [ ] ] dip '[ _ test-mr first check-mr ] unit-test
] each
+
+cell 8 = [
+ [ t ]
+ [
+ [
+ 1 50 fixnum-shift-fast fixnum+fast
+ ] test-mr first instructions>> [ ##add? ] any?
+ ] unit-test
+] when
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors combinators namespaces
+compiler.cfg.tco
compiler.cfg.predecessors
-compiler.cfg.useless-blocks
-compiler.cfg.height
+compiler.cfg.useless-conditionals
compiler.cfg.stack-analysis
+compiler.cfg.branch-splitting
compiler.cfg.alias-analysis
compiler.cfg.value-numbering
compiler.cfg.dce
+compiler.cfg.branch-folding
compiler.cfg.write-barrier
compiler.cfg.liveness
compiler.cfg.rpo
] when ;
: optimize-cfg ( cfg -- cfg' )
+ ! Note that compute-predecessors has to be called several times.
+ ! The passes that need this document it.
[
+ optimize-tail-calls
compute-predecessors
- delete-useless-blocks
delete-useless-conditionals
- normalize-height
+ split-branches
+ compute-predecessors
stack-analysis
compute-liveness
alias-analysis
value-numbering
+ fold-branches
+ compute-predecessors
eliminate-dead-code
eliminate-write-barriers
eliminate-phis
--- /dev/null
+IN: compiler.cfg.phi-elimination.tests
+USING: compiler.cfg.instructions compiler.cfg compiler.cfg.registers
+compiler.cfg.debugger compiler.cfg.phi-elimination kernel accessors
+sequences classes namespaces tools.test cpu.architecture arrays ;
+
+V{ T{ ##branch } } 0 test-bb
+
+V{
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##compare-branch f V int-regs 0 V int-regs 0 cc< }
+} 1 test-bb
+
+V{
+ T{ ##load-immediate f V int-regs 1 1 }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##load-immediate f V int-regs 2 2 }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##phi f V int-regs 3 { } }
+ T{ ##replace f V int-regs 3 D 0 }
+ T{ ##return }
+} 4 test-bb
+
+4 get instructions>> first
+2 get V int-regs 1 2array
+3 get V int-regs 2 2array 2array
+>>inputs drop
+
+test-diamond
+
+[ ] [ cfg new 0 get >>entry eliminate-phis drop ] unit-test
+
+[ T{ ##copy f V int-regs 3 V int-regs 1 } ] [ 2 get instructions>> second ] unit-test
+[ T{ ##copy f V int-regs 3 V int-regs 2 } ] [ 3 get instructions>> second ] unit-test
+[ 2 ] [ 4 get instructions>> length ] unit-test
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors compiler.cfg compiler.cfg.instructions
-compiler.cfg.rpo fry kernel sequences ;
+USING: accessors assocs fry kernel sequences
+compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
IN: compiler.cfg.phi-elimination
: insert-copy ( predecessor input output -- )
'[ _ _ swap ##copy ] add-instructions ;
-: eliminate-phi ( bb ##phi -- )
- [ predecessors>> ] [ [ inputs>> ] [ dst>> ] bi ] bi*
- '[ _ insert-copy ] 2each ;
+: eliminate-phi ( ##phi -- )
+ [ inputs>> ] [ dst>> ] bi '[ _ insert-copy ] assoc-each ;
: eliminate-phi-step ( bb -- )
- dup [
- [ ##phi? ] partition
- [ [ eliminate-phi ] with each ] dip
- ] change-instructions drop ;
+ instructions>> [ dup ##phi? [ eliminate-phi f ] [ drop t ] if ] filter-here ;
: eliminate-phis ( cfg -- cfg' )
dup [ eliminate-phi-step ] each-basic-block ;
\ No newline at end of file
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences compiler.cfg.rpo ;
+USING: kernel accessors combinators fry sequences assocs compiler.cfg.rpo
+compiler.cfg.instructions ;
IN: compiler.cfg.predecessors
-: predecessors-step ( bb -- )
+: update-predecessors ( bb -- )
dup successors>> [ predecessors>> push ] with each ;
+: update-phi ( bb ##phi -- )
+ [
+ swap predecessors>>
+ '[ drop _ memq? ] assoc-filter
+ ] change-inputs drop ;
+
+: update-phis ( bb -- )
+ dup instructions>> [
+ dup ##phi? [ update-phi ] [ 2drop ] if
+ ] with each ;
+
: compute-predecessors ( cfg -- cfg' )
- [ [ V{ } clone >>predecessors drop ] each-basic-block ]
- [ [ predecessors-step ] each-basic-block ]
- [ ]
- tri ;
+ {
+ [ [ V{ } clone >>predecessors drop ] each-basic-block ]
+ [ [ update-predecessors ] each-basic-block ]
+ [ [ update-phis ] each-basic-block ]
+ [ ]
+ } cleave ;
SYMBOL: vreg-counter
: next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
-! Stack locations
+! Stack locations -- 'n' is an index starting from the top of the stack
+! going down. So 0 is the top of the stack, 1 is what would be the top
+! of the stack after a 'drop', and so on.
+
+! ##inc-d and ##inc-r affect locations as follows. Location D 0 before
+! an ##inc-d 1 becomes D 1 after ##inc-d 1.
TUPLE: loc { n read-only } ;
TUPLE: ds-loc < loc ;
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel namespaces sequences
+compiler.cfg.instructions compiler.cfg.registers ;
+IN: compiler.cfg.renaming
+
+SYMBOL: renamings
+
+: rename-value ( vreg -- vreg' ) renamings get at ;
+
+GENERIC: rename-insn-defs ( insn -- )
+
+M: ##flushable rename-insn-defs
+ [ rename-value ] change-dst
+ drop ;
+
+M: insn rename-insn-defs drop ;
+
+GENERIC: rename-insn-uses ( insn -- )
+
+M: ##effect rename-insn-uses
+ [ rename-value ] change-src
+ drop ;
+
+M: ##unary rename-insn-uses
+ [ rename-value ] change-src
+ drop ;
+
+M: ##binary rename-insn-uses
+ [ rename-value ] change-src1
+ [ rename-value ] change-src2
+ drop ;
+
+M: ##binary-imm rename-insn-uses
+ [ rename-value ] change-src1
+ drop ;
+
+M: ##slot rename-insn-uses
+ [ rename-value ] change-obj
+ [ rename-value ] change-slot
+ drop ;
+
+M: ##slot-imm rename-insn-uses
+ [ rename-value ] change-obj
+ drop ;
+
+M: ##set-slot rename-insn-uses
+ dup call-next-method
+ [ rename-value ] change-obj
+ [ rename-value ] change-slot
+ drop ;
+
+M: ##string-nth rename-insn-uses
+ [ rename-value ] change-obj
+ [ rename-value ] change-index
+ drop ;
+
+M: ##set-slot-imm rename-insn-uses
+ dup call-next-method
+ [ rename-value ] change-obj
+ drop ;
+
+M: ##alien-getter rename-insn-uses
+ dup call-next-method
+ [ rename-value ] change-src
+ drop ;
+
+M: ##alien-setter rename-insn-uses
+ dup call-next-method
+ [ rename-value ] change-value
+ drop ;
+
+M: ##conditional-branch rename-insn-uses
+ [ rename-value ] change-src1
+ [ rename-value ] change-src2
+ drop ;
+
+M: ##compare-imm-branch rename-insn-uses
+ [ rename-value ] change-src1
+ drop ;
+
+M: ##dispatch rename-insn-uses
+ [ rename-value ] change-src
+ drop ;
+
+M: ##fixnum-overflow rename-insn-uses
+ [ rename-value ] change-src1
+ [ rename-value ] change-src2
+ drop ;
+
+M: insn rename-insn-uses drop ;
+
+: fresh-vreg ( vreg -- vreg' )
+ reg-class>> next-vreg ;
+
+GENERIC: fresh-insn-temps ( insn -- )
+
+M: ##write-barrier fresh-insn-temps
+ [ fresh-vreg ] change-card#
+ [ fresh-vreg ] change-table
+ drop ;
+
+M: ##unary/temp fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##allot fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##dispatch fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##slot fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##set-slot fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##string-nth fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##set-string-nth-fast fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##compare fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##compare-imm fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##compare-float fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: ##fixnum-mul fresh-insn-temps
+ [ fresh-vreg ] change-temp1
+ [ fresh-vreg ] change-temp2
+ drop ;
+
+M: ##fixnum-mul-tail fresh-insn-temps
+ [ fresh-vreg ] change-temp1
+ [ fresh-vreg ] change-temp2
+ drop ;
+
+M: ##gc fresh-insn-temps
+ [ fresh-vreg ] change-temp1
+ [ fresh-vreg ] change-temp2
+ drop ;
+
+M: _dispatch fresh-insn-temps
+ [ fresh-vreg ] change-temp drop ;
+
+M: insn fresh-insn-temps drop ;
\ No newline at end of file
--- /dev/null
+IN: compiler.cfg.stack-analysis.merge.tests
+USING: compiler.cfg.stack-analysis.merge tools.test arrays accessors
+compiler.cfg.instructions compiler.cfg.stack-analysis.state
+compiler.cfg compiler.cfg.registers compiler.cfg.debugger
+cpu.architecture make assocs
+sequences kernel classes ;
+
+[
+ { D 0 }
+ { V int-regs 0 V int-regs 1 }
+] [
+ <state>
+
+ <basic-block> V{ T{ ##branch } } >>instructions
+ <basic-block> V{ T{ ##branch } } >>instructions 2array
+
+ <state> H{ { D 0 V int-regs 0 } } >>locs>vregs
+ <state> H{ { D 0 V int-regs 1 } } >>locs>vregs 2array
+
+ [ merge-locs locs>vregs>> keys ] { } make first inputs>> values
+] unit-test
+
+[
+ { D 0 }
+ ##peek
+] [
+ <state>
+
+ <basic-block> V{ T{ ##branch } } >>instructions
+ <basic-block> V{ T{ ##branch } } >>instructions 2array
+
+ [
+ <state>
+ <state> H{ { D 0 V int-regs 1 } } >>locs>vregs 2array
+
+ [ merge-locs locs>vregs>> keys ] { } make drop
+ ] keep first instructions>> first class
+] unit-test
+
+[
+ 0 ##inc-d
+] [
+ <state>
+
+ <basic-block> V{ T{ ##branch } } >>instructions
+ <basic-block> V{ T{ ##branch } } >>instructions 2array
+
+ [
+ <state> -1 >>ds-height
+ <state> 2array
+
+ [ merge-ds-heights ds-height>> ] { } make drop
+ ] keep first instructions>> first class
+] unit-test
+
+[
+ 0
+ { D 0 }
+ { 1 1 }
+] [
+ <state>
+
+ <basic-block> V{ T{ ##branch } } >>instructions
+ <basic-block> V{ T{ ##branch } } >>instructions 2array
+
+ [
+ <state> -1 >>ds-height H{ { D 1 V int-regs 0 } } >>locs>vregs
+ <state> H{ { D 0 V int-regs 1 } } >>locs>vregs 2array
+
+ [ merge-locs [ ds-height>> ] [ locs>vregs>> keys ] bi ] { } make drop
+ ] keep
+ [ instructions>> length ] map
+] unit-test
+
+[
+ -1
+ { D -1 }
+ { 1 1 }
+] [
+ <state>
+
+ <basic-block> V{ T{ ##branch } } >>instructions
+ <basic-block> V{ T{ ##branch } } >>instructions 2array
+
+ [
+ <state> -1 >>ds-height H{ { D -1 V int-regs 0 } } >>locs>vregs
+ <state> -1 >>ds-height H{ { D -1 V int-regs 1 } } >>locs>vregs 2array
+
+ [ [ merge-ds-heights ] [ merge-locs ] 2bi ] { } make drop
+ [ ds-height>> ] [ locs>vregs>> keys ] bi
+ ] keep
+ [ instructions>> length ] map
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel assocs sequences accessors fry combinators grouping
+sets locals compiler.cfg compiler.cfg.hats compiler.cfg.instructions
+compiler.cfg.stack-analysis.state ;
+IN: compiler.cfg.stack-analysis.merge
+
+! XXX critical edges
+
+: initial-state ( bb states -- state ) 2drop <state> ;
+
+: single-predecessor ( bb states -- state ) nip first clone ;
+
+: save-ds-height ( n -- )
+ dup 0 = [ drop ] [ ##inc-d ] if ;
+
+: merge-ds-heights ( state predecessors states -- state )
+ [ ds-height>> ] map dup all-equal?
+ [ nip first >>ds-height ]
+ [ [ '[ _ save-ds-height ] add-instructions ] 2each ] if ;
+
+: save-rs-height ( n -- )
+ dup 0 = [ drop ] [ ##inc-r ] if ;
+
+: merge-rs-heights ( state predecessors states -- state )
+ [ rs-height>> ] map dup all-equal?
+ [ nip first >>rs-height ]
+ [ [ '[ _ save-rs-height ] add-instructions ] 2each ] if ;
+
+: assoc-map-values ( assoc quot -- assoc' )
+ '[ _ dip ] assoc-map ; inline
+
+: translate-locs ( assoc state -- assoc' )
+ '[ _ translate-loc ] assoc-map-values ;
+
+: untranslate-locs ( assoc state -- assoc' )
+ '[ _ untranslate-loc ] assoc-map-values ;
+
+: collect-locs ( loc-maps states -- assoc )
+ ! assoc maps locs to sequences
+ [ untranslate-locs ] 2map
+ [ [ keys ] map concat prune ] keep
+ '[ dup _ [ at ] with map ] H{ } map>assoc ;
+
+: insert-peek ( predecessor loc state -- vreg )
+ '[ _ _ translate-loc ^^peek ] add-instructions ;
+
+: merge-loc ( predecessors vregs loc state -- vreg )
+ ! Insert a ##phi in the current block where the input
+ ! is the vreg storing loc from each predecessor block
+ [ dup ] 3dip
+ '[ [ ] [ _ _ insert-peek ] ?if ] 2map
+ dup all-equal? [ nip first ] [ zip ^^phi ] if ;
+
+:: merge-locs ( state predecessors states -- state )
+ states [ locs>vregs>> ] map states collect-locs
+ [| key value |
+ key
+ predecessors value key state merge-loc
+ ] assoc-map
+ state translate-locs
+ state (>>locs>vregs)
+ state ;
+
+: merge-actual-loc ( vregs -- vreg/f )
+ dup all-equal? [ first ] [ drop f ] if ;
+
+:: merge-actual-locs ( state states -- state )
+ states [ actual-locs>vregs>> ] map states collect-locs
+ [ merge-actual-loc ] assoc-map [ nip ] assoc-filter
+ state translate-locs
+ state (>>actual-locs>vregs)
+ state ;
+
+: merge-changed-locs ( state states -- state )
+ [ [ changed-locs>> ] keep untranslate-locs ] map assoc-combine
+ over translate-locs
+ >>changed-locs ;
+
+ERROR: cannot-merge-poisoned states ;
+
+: multiple-predecessors ( bb states -- state )
+ dup [ not ] any? [
+ 2drop <state>
+ ] [
+ dup [ poisoned?>> ] any? [
+ cannot-merge-poisoned
+ ] [
+ [ state new ] 2dip
+ [ predecessors>> ] dip
+ {
+ [ merge-ds-heights ]
+ [ merge-rs-heights ]
+ [ merge-locs ]
+ [ nip merge-actual-locs ]
+ [ nip merge-changed-locs ]
+ } 2cleave
+ ] if
+ ] if ;
+
+: merge-states ( bb states -- state )
+ ! If any states are poisoned, save all registers
+ ! to the stack in each branch
+ dup length {
+ { 0 [ initial-state ] }
+ { 1 [ single-predecessor ] }
+ [ drop multiple-predecessors ]
+ } case ;
compiler.cfg.predecessors compiler.cfg.stack-analysis
compiler.cfg.instructions sequences kernel tools.test accessors
sequences.private alien math combinators.private compiler.cfg
-compiler.cfg.checker compiler.cfg.height compiler.cfg.rpo
-compiler.cfg.dce compiler.cfg.registers compiler.cfg.useless-blocks
-sets namespaces ;
+compiler.cfg.checker compiler.cfg.rpo
+compiler.cfg.dce compiler.cfg.registers
+sets namespaces arrays cpu.architecture ;
IN: compiler.cfg.stack-analysis.tests
! Fundamental invariant: a basic block should not load or store a value more than once
-: check-for-redundant-ops ( cfg -- )
- [
- instructions>>
- [
- [ ##peek? ] filter [ loc>> ] map duplicates empty?
- [ "Redundant peeks" throw ] unless
- ] [
- [ ##replace? ] filter [ loc>> ] map duplicates empty?
- [ "Redundant replaces" throw ] unless
- ] bi
- ] each-basic-block ;
-
: test-stack-analysis ( quot -- cfg )
dup cfg? [ test-cfg first ] unless
compute-predecessors
- delete-useless-blocks
- delete-useless-conditionals
- normalize-height
stack-analysis
- dup check-cfg
- dup check-for-redundant-ops ;
+ dup check-cfg ;
: linearize ( cfg -- mr )
flatten-cfg instructions>> ;
-local-only? off
-
[ ] [ [ ] test-stack-analysis drop ] unit-test
! Only peek once
[ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize
[ [ ##add-imm? ] count ] [ [ ##load-immediate? ] any? ] bi
] unit-test
+
+! Correct height tracking
+[ t ] [
+ [ pick [ <array> ] [ drop ] if swap ] test-stack-analysis eliminate-dead-code
+ reverse-post-order 3 swap nth
+ instructions>> [ ##peek? ] filter first2 [ loc>> ] [ loc>> ] bi*
+ 2array { D 1 D 0 } set=
+] unit-test
+
+[ D 1 ] [
+ V{ T{ ##branch } } 0 test-bb
+
+ V{ T{ ##peek f V int-regs 0 D 2 } T{ ##branch } } 1 test-bb
+
+ V{
+ T{ ##peek f V int-regs 1 D 2 }
+ T{ ##inc-d f -1 }
+ T{ ##branch }
+ } 2 test-bb
+
+ V{ T{ ##call f \ + -1 } T{ ##branch } } 3 test-bb
+
+ V{ T{ ##return } } 4 test-bb
+
+ test-diamond
+
+ cfg new 0 get >>entry
+ compute-predecessors
+ stack-analysis
+ drop
+
+ 3 get instructions>> second loc>>
+] unit-test
+
+! Do inserted ##peeks reference the correct stack location if
+! an ##inc-d/r was also inserted?
+[ D 0 ] [
+ V{ T{ ##branch } } 0 test-bb
+
+ V{ T{ ##branch } } 1 test-bb
+
+ V{
+ T{ ##peek f V int-regs 1 D 0 }
+ T{ ##branch }
+ } 2 test-bb
+
+ V{
+ T{ ##call f \ + -1 }
+ T{ ##inc-d f 1 }
+ T{ ##branch }
+ } 3 test-bb
+
+ V{ T{ ##return } } 4 test-bb
+
+ test-diamond
+
+ cfg new 0 get >>entry
+ compute-predecessors
+ stack-analysis
+ drop
+
+ 3 get instructions>> [ ##peek? ] find nip loc>>
+] unit-test
+
+! Missing ##replace
+[ t ] [
+ [ [ "B" ] 2dip dup [ [ /mod ] dip ] when ] test-stack-analysis
+ reverse-post-order last
+ instructions>> [ ##replace? ] filter [ loc>> ] map
+ { D 0 D 1 D 2 } set=
+] unit-test
+
+! Inserted ##peeks reference the wrong stack location
+[ t ] [
+ [ [ "B" ] 2dip dup [ [ /mod ] dip ] when ] test-stack-analysis
+ eliminate-dead-code reverse-post-order 3 swap nth
+ instructions>> [ ##peek? ] filter [ loc>> ] map
+ { R 0 D 0 D 1 } set=
+] unit-test
+
+[ D 0 ] [
+ V{ T{ ##branch } } 0 test-bb
+
+ V{ T{ ##branch } } 1 test-bb
+
+ V{
+ T{ ##peek f V int-regs 1 D 0 }
+ T{ ##inc-d f 1 }
+ T{ ##branch }
+ } 2 test-bb
+
+ V{
+ T{ ##inc-d f 1 }
+ T{ ##branch }
+ } 3 test-bb
+
+ V{ T{ ##return } } 4 test-bb
+
+ test-diamond
+
+ cfg new 0 get >>entry
+ compute-predecessors
+ stack-analysis
+ drop
+
+ 3 get instructions>> [ ##peek? ] find nip loc>>
+] unit-test
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel namespaces math sequences fry grouping
-sets make combinators compiler.cfg.copy-prop compiler.cfg.def-use
-compiler.cfg.instructions compiler.cfg.registers compiler.cfg.rpo
-compiler.cfg.hats compiler.cfg ;
+sets make combinators
+compiler.cfg
+compiler.cfg.copy-prop
+compiler.cfg.def-use
+compiler.cfg.instructions
+compiler.cfg.registers
+compiler.cfg.rpo
+compiler.cfg.hats
+compiler.cfg.stack-analysis.state
+compiler.cfg.stack-analysis.merge ;
IN: compiler.cfg.stack-analysis
-! Convert stack operations to register operations
-
-! If 'poisoned' is set, disregard height information. This is set if we don't have
-! height change information for an instruction.
-TUPLE: state locs>vregs actual-locs>vregs changed-locs ds-height rs-height poisoned? ;
-
-: <state> ( -- state )
- state new
- H{ } clone >>locs>vregs
- H{ } clone >>actual-locs>vregs
- H{ } clone >>changed-locs
- 0 >>ds-height
- 0 >>rs-height ;
-
-M: state clone
- call-next-method
- [ clone ] change-locs>vregs
- [ clone ] change-actual-locs>vregs
- [ clone ] change-changed-locs ;
-
-: loc>vreg ( loc -- vreg ) state get locs>vregs>> at ;
-
-: record-peek ( dst loc -- )
- state get [ locs>vregs>> set-at ] [ actual-locs>vregs>> set-at ] 3bi ;
-
-: changed-loc ( loc -- )
- state get changed-locs>> conjoin ;
-
-: record-replace ( src loc -- )
- dup changed-loc state get locs>vregs>> set-at ;
-
-GENERIC: height-for ( loc -- n )
-
-M: ds-loc height-for drop state get ds-height>> ;
-M: rs-loc height-for drop state get rs-height>> ;
-
-: (translate-loc) ( loc -- n height ) [ n>> ] [ height-for ] bi ; inline
-
-GENERIC: translate-loc ( loc -- loc' )
-
-M: ds-loc translate-loc (translate-loc) - <ds-loc> ;
-M: rs-loc translate-loc (translate-loc) - <rs-loc> ;
-
-GENERIC: untranslate-loc ( loc -- loc' )
-
-M: ds-loc untranslate-loc (translate-loc) + <ds-loc> ;
-M: rs-loc untranslate-loc (translate-loc) + <rs-loc> ;
-
: redundant-replace? ( vreg loc -- ? )
- dup untranslate-loc n>> 0 <
+ dup state get untranslate-loc n>> 0 <
[ 2drop t ] [ state get actual-locs>vregs>> at = ] if ;
: save-changed-locs ( state -- )
- [ changed-locs>> ] [ locs>vregs>> ] bi '[
- _ at swap 2dup redundant-replace?
- [ 2drop ] [ untranslate-loc ##replace ] if
- ] assoc-each ;
-
-: clear-state ( state -- )
- [ locs>vregs>> clear-assoc ]
- [ actual-locs>vregs>> clear-assoc ]
- [ changed-locs>> clear-assoc ]
- tri ;
+ [ changed-locs>> keys ] [ locs>vregs>> ] bi '[
+ dup _ at swap 2dup redundant-replace?
+ [ 2drop ] [ state get untranslate-loc ##replace ] if
+ ] each ;
ERROR: poisoned-state state ;
: sync-state ( -- )
state get {
[ dup poisoned?>> [ poisoned-state ] [ drop ] if ]
+ [ ds-height>> save-ds-height ]
+ [ rs-height>> save-rs-height ]
[ save-changed-locs ]
[ clear-state ]
} cleave ;
! Abstract interpretation
GENERIC: visit ( insn -- )
+M: ##inc-d visit
+ n>> state get [ + ] change-ds-height drop ;
+
+M: ##inc-r visit
+ n>> state get [ + ] change-rs-height drop ;
+
! Instructions which don't have any effect on the stack
UNION: neutral-insn
+ ##effect
##flushable
- ##effect ;
+ ##no-tco ;
M: neutral-insn visit , ;
##dispatch
##loop-entry ;
-SYMBOL: local-only?
-
-t local-only? set-global
-
-: back-edge? ( from to -- ? )
- [ number>> ] bi@ > ;
-
: sync-state? ( -- ? )
basic-block get successors>>
- [ [ predecessors>> ] keep '[ _ back-edge? ] any? ] any?
- local-only? get or ;
+ [ [ predecessors>> ] keep '[ _ back-edge? ] any? ] any? ;
M: sync-if-back-edge visit
sync-state? [ sync-state ] when , ;
-: adjust-d ( n -- ) state get [ + ] change-ds-height drop ;
-
-M: ##inc-d visit [ , ] [ n>> adjust-d ] bi ;
-
-: adjust-r ( n -- ) state get [ + ] change-rs-height drop ;
-
-M: ##inc-r visit [ , ] [ n>> adjust-r ] bi ;
-
: eliminate-peek ( dst src -- )
! the requested stack location is already in 'src'
[ ##copy ] [ swap copies get set-at ] 2bi ;
M: ##peek visit
- dup
- [ dst>> ] [ loc>> translate-loc ] bi
- dup loc>vreg dup [ nip eliminate-peek drop ] [ drop record-peek , ] if ;
+ [ dst>> ] [ loc>> state get translate-loc ] bi dup loc>vreg
+ [ eliminate-peek ] [ [ record-peek ] [ ##peek ] 2bi ] ?if ;
M: ##replace visit
- [ src>> resolve ] [ loc>> translate-loc ] bi
+ [ src>> resolve ] [ loc>> state get translate-loc ] bi
record-replace ;
M: ##copy visit
[ call-next-method ] [ record-copy ] bi ;
-M: ##call visit
- [ call-next-method ] [ height>> adjust-d ] bi ;
-
! Instructions that poison the stack state
UNION: poison-insn
##jump
##fixnum-add
##fixnum-sub
##alien-invoke
- ##alien-indirect ;
+ ##alien-indirect
+ ##alien-callback ;
M: kill-vreg-insn visit sync-state , ;
-: visit-alien-node ( node -- )
- params>> [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
-
-M: ##alien-invoke visit
- [ call-next-method ] [ visit-alien-node ] bi ;
-
-M: ##alien-indirect visit
- [ call-next-method ] [ visit-alien-node ] bi ;
-
-M: ##alien-callback visit , ;
-
! Maps basic-blocks to states
SYMBOLS: state-in state-out ;
-: initial-state ( bb states -- state ) 2drop <state> ;
-
-: single-predecessor ( bb states -- state ) nip first clone ;
-
-ERROR: must-equal-failed seq ;
-
-: must-equal ( seq -- elt )
- dup all-equal? [ first ] [ must-equal-failed ] if ;
-
-: merge-heights ( state predecessors states -- state )
- nip
- [ [ ds-height>> ] map must-equal >>ds-height ]
- [ [ rs-height>> ] map must-equal >>rs-height ] bi ;
-
-: insert-peek ( predecessor loc -- vreg )
- ! XXX critical edges
- '[ _ ^^peek ] add-instructions ;
-
-: merge-loc ( predecessors locs>vregs loc -- vreg )
- ! Insert a ##phi in the current block where the input
- ! is the vreg storing loc from each predecessor block
- [ '[ [ _ ] dip at ] map ] keep
- '[ [ ] [ _ insert-peek ] ?if ] 2map
- dup all-equal? [ first ] [ ^^phi ] if ;
-
-: (merge-locs) ( predecessors assocs -- assoc )
- dup [ keys ] map concat prune
- [ [ 2nip ] [ merge-loc ] 3bi ] with with
- H{ } map>assoc ;
-
-: merge-locs ( state predecessors states -- state )
- [ locs>vregs>> ] map (merge-locs) >>locs>vregs ;
-
-: merge-loc' ( locs>vregs loc -- vreg )
- ! Insert a ##phi in the current block where the input
- ! is the vreg storing loc from each predecessor block
- '[ [ _ ] dip at ] map
- dup all-equal? [ first ] [ drop f ] if ;
-
-: merge-actual-locs ( state predecessors states -- state )
- nip
- [ actual-locs>vregs>> ] map
- dup [ keys ] map concat prune
- [ [ nip ] [ merge-loc' ] 2bi ] with
- H{ } map>assoc
- [ nip ] assoc-filter
- >>actual-locs>vregs ;
-
-: merge-changed-locs ( state predecessors states -- state )
- nip [ changed-locs>> ] map assoc-combine >>changed-locs ;
-
-ERROR: cannot-merge-poisoned states ;
-
-: multiple-predecessors ( bb states -- state )
- dup [ not ] any? [
- [ <state> ] 2dip
- sift merge-heights
- ] [
- dup [ poisoned?>> ] any? [
- cannot-merge-poisoned
- ] [
- [ state new ] 2dip
- [ predecessors>> ] dip
- {
- [ merge-locs ]
- [ merge-actual-locs ]
- [ merge-heights ]
- [ merge-changed-locs ]
- } 2cleave
- ] if
- ] if ;
-
-: merge-states ( bb states -- state )
- ! If any states are poisoned, save all registers
- ! to the stack in each branch
- dup length {
- { 0 [ initial-state ] }
- { 1 [ single-predecessor ] }
- [ drop multiple-predecessors ]
- } case ;
-
: block-in-state ( bb -- states )
dup predecessors>> state-out get '[ _ at ] map merge-states ;
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors namespaces assocs sets math
+compiler.cfg.registers ;
+IN: compiler.cfg.stack-analysis.state
+
+TUPLE: state
+locs>vregs actual-locs>vregs changed-locs
+{ ds-height integer }
+{ rs-height integer }
+poisoned? ;
+
+: <state> ( -- state )
+ state new
+ H{ } clone >>locs>vregs
+ H{ } clone >>actual-locs>vregs
+ H{ } clone >>changed-locs
+ 0 >>ds-height
+ 0 >>rs-height ;
+
+M: state clone
+ call-next-method
+ [ clone ] change-locs>vregs
+ [ clone ] change-actual-locs>vregs
+ [ clone ] change-changed-locs ;
+
+: loc>vreg ( loc -- vreg ) state get locs>vregs>> at ;
+
+: record-peek ( dst loc -- )
+ state get [ locs>vregs>> set-at ] [ actual-locs>vregs>> set-at ] 3bi ;
+
+: changed-loc ( loc -- )
+ state get changed-locs>> conjoin ;
+
+: record-replace ( src loc -- )
+ dup changed-loc state get locs>vregs>> set-at ;
+
+: clear-state ( state -- )
+ 0 >>ds-height 0 >>rs-height
+ [ locs>vregs>> ] [ actual-locs>vregs>> ] [ changed-locs>> ] tri
+ [ clear-assoc ] tri@ ;
+
+GENERIC# translate-loc 1 ( loc state -- loc' )
+M: ds-loc translate-loc [ n>> ] [ ds-height>> ] bi* - <ds-loc> ;
+M: rs-loc translate-loc [ n>> ] [ rs-height>> ] bi* - <rs-loc> ;
+
+GENERIC# untranslate-loc 1 ( loc state -- loc' )
+M: ds-loc untranslate-loc [ n>> ] [ ds-height>> ] bi* + <ds-loc> ;
+M: rs-loc untranslate-loc [ n>> ] [ rs-height>> ] bi* + <rs-loc> ;
: gc-root-offset ( n -- n' ) gc-root-base + ;
-: gc-roots-size ( live-registers live-spill-slots -- n )
- [ keys [ reg-class>> reg-size ] sigma ] bi@ + ;
+: gc-roots-size ( live-values -- n )
+ keys [ reg-class>> reg-size ] sigma ;
: (stack-frame-size) ( stack-frame -- n )
[
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit kernel math
+namespaces sequences fry combinators
+compiler.cfg
+compiler.cfg.rpo
+compiler.cfg.hats
+compiler.cfg.instructions ;
+IN: compiler.cfg.tco
+
+! Tail call optimization. You must run compute-predecessors after this
+
+: return? ( bb -- ? )
+ skip-empty-blocks
+ instructions>> {
+ [ length 2 = ]
+ [ first ##epilogue? ]
+ [ second ##return? ]
+ } 1&& ;
+
+: penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
+
+: tail-call? ( bb -- ? )
+ {
+ [ instructions>> { [ length 2 >= ] [ last ##branch? ] } 1&& ]
+ [ successors>> first return? ]
+ } 1&& ;
+
+: word-tail-call? ( bb -- ? )
+ instructions>> penultimate ##call? ;
+
+: convert-tail-call ( bb quot: ( insn -- tail-insn ) -- )
+ '[
+ instructions>>
+ [ pop* ] [ pop ] [ ] tri
+ [ [ \ ##epilogue new-insn ] dip push ]
+ [ _ dip push ] bi
+ ]
+ [ successors>> delete-all ]
+ bi ; inline
+
+: convert-word-tail-call ( bb -- )
+ [ word>> \ ##jump new-insn ] convert-tail-call ;
+
+: loop-tail-call? ( bb -- ? )
+ instructions>> penultimate
+ { [ ##call? ] [ word>> cfg get label>> eq? ] } 1&& ;
+
+: convert-loop-tail-call ( bb -- )
+ ! If a word calls itself, this becomes a loop in the CFG.
+ [ instructions>> [ pop* ] [ pop* ] [ [ \ ##branch new-insn ] dip push ] tri ]
+ [ successors>> delete-all ]
+ [ [ cfg get entry>> successors>> first ] dip successors>> push ]
+ tri ;
+
+: fixnum-tail-call? ( bb -- ? )
+ instructions>> penultimate
+ { [ ##fixnum-add? ] [ ##fixnum-sub? ] [ ##fixnum-mul? ] } 1|| ;
+
+GENERIC: convert-fixnum-tail-call* ( src1 src2 insn -- insn' )
+
+M: ##fixnum-add convert-fixnum-tail-call* drop \ ##fixnum-add-tail new-insn ;
+M: ##fixnum-sub convert-fixnum-tail-call* drop \ ##fixnum-sub-tail new-insn ;
+M: ##fixnum-mul convert-fixnum-tail-call* drop i i \ ##fixnum-mul-tail new-insn ;
+
+: convert-fixnum-tail-call ( bb -- )
+ [
+ [ src1>> ] [ src2>> ] [ ] tri
+ convert-fixnum-tail-call*
+ ] convert-tail-call ;
+
+: optimize-tail-call ( bb -- )
+ dup tail-call? [
+ {
+ { [ dup loop-tail-call? ] [ convert-loop-tail-call ] }
+ { [ dup word-tail-call? ] [ convert-word-tail-call ] }
+ { [ dup fixnum-tail-call? ] [ convert-fixnum-tail-call ] }
+ [ drop ]
+ } cond
+ ] [ drop ] if ;
+
+: optimize-tail-calls ( cfg -- cfg' )
+ dup cfg set
+ dup [ optimize-tail-call ] each-basic-block
+ f >>post-order ;
\ No newline at end of file
+++ /dev/null
-Eliminating unreachable basic blocks and unconditional jumps
+++ /dev/null
-IN: compiler.cfg.useless-blocks.tests
-USING: fry kernel sequences compiler.cfg.useless-blocks compiler.cfg.checker
-compiler.cfg.debugger compiler.cfg.predecessors tools.test ;
-
-{
- [ [ drop 1 ] when ]
- [ [ drop 1 ] unless ]
-} [
- [ [ ] ] dip
- '[ _ test-cfg first compute-predecessors delete-useless-blocks check-cfg ] unit-test
-] each
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences combinators combinators.short-circuit
-classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
-IN: compiler.cfg.useless-blocks
-
-: update-predecessor-for-delete ( bb -- )
- ! We have to replace occurrences of bb with bb's successor
- ! in bb's predecessor's list of successors.
- dup predecessors>> first [
- [
- 2dup eq? [ drop successors>> first ] [ nip ] if
- ] with map
- ] change-successors drop ;
-
-: update-successor-for-delete ( bb -- )
- ! We have to replace occurrences of bb with bb's predecessor
- ! in bb's sucessor's list of predecessors.
- dup successors>> first [
- [
- 2dup eq? [ drop predecessors>> first ] [ nip ] if
- ] with map
- ] change-predecessors drop ;
-
-: delete-basic-block ( bb -- )
- [ update-predecessor-for-delete ]
- [ update-successor-for-delete ]
- bi ;
-
-: delete-basic-block? ( bb -- ? )
- {
- [ instructions>> length 1 = ]
- [ predecessors>> length 1 = ]
- [ successors>> length 1 = ]
- [ instructions>> first ##branch? ]
- } 1&& ;
-
-: delete-useless-blocks ( cfg -- cfg' )
- dup [
- dup delete-basic-block? [ delete-basic-block ] [ drop ] if
- ] each-basic-block
- f >>post-order ;
-
-: delete-conditional? ( bb -- ? )
- dup instructions>> [ drop f ] [
- last class {
- ##compare-branch
- ##compare-imm-branch
- ##compare-float-branch
- } memq? [ successors>> first2 eq? ] [ drop f ] if
- ] if-empty ;
-
-: delete-conditional ( bb -- )
- dup successors>> first 1vector >>successors
- [ but-last \ ##branch new-insn suffix ] change-instructions
- drop ;
-
-: delete-useless-conditionals ( cfg -- cfg' )
- dup [
- dup delete-conditional? [ delete-conditional ] [ drop ] if
- ] each-basic-block
- f >>post-order ;
--- /dev/null
+Eliminating unreachable basic blocks and unconditional jumps
--- /dev/null
+! Copyright (C) 2008, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences math combinators combinators.short-circuit
+classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
+IN: compiler.cfg.useless-conditionals
+
+: delete-conditional? ( bb -- ? )
+ {
+ [ instructions>> last class { ##compare-branch ##compare-imm-branch ##compare-float-branch } memq? ]
+ [ successors>> first2 [ skip-empty-blocks ] bi@ eq? ]
+ } 1&& ;
+
+: delete-conditional ( bb -- )
+ [ first skip-empty-blocks 1vector ] change-successors
+ instructions>> [ pop* ] [ [ \ ##branch new-insn ] dip push ] bi ;
+
+: delete-useless-conditionals ( cfg -- cfg' )
+ dup [
+ dup delete-conditional? [ delete-conditional ] [ drop ] if
+ ] each-basic-block
+ f >>post-order ;
: stop-iterating ( -- next ) end-basic-block f ;
-: call-height ( ##call -- n )
- [ out-d>> length ] [ in-d>> length ] bi - ;
-
: emit-primitive ( node -- )
- [ word>> ] [ call-height ] bi ##call ##branch begin-basic-block ;
+ word>> ##call ##branch begin-basic-block ;
: vn>constant ( vn -- constant ) vn>expr value>> ; inline
+: vreg>constant ( vreg -- constant ) vreg>vn vn>constant ; inline
+
: init-value-graph ( -- )
0 vn-counter set
<bihash> exprs>vns set
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs sequences kernel accessors
-compiler.cfg.instructions compiler.cfg.value-numbering.graph ;
-IN: compiler.cfg.value-numbering.propagate
-
-! If two vregs compute the same value, replace references to
-! the latter with the former.
-
-: resolve ( vreg -- vreg' ) vreg>vn vn>vreg ; inline
-
-GENERIC: propagate ( insn -- insn )
-
-M: ##effect propagate
- [ resolve ] change-src ;
-
-M: ##unary propagate
- [ resolve ] change-src ;
-
-M: ##binary propagate
- [ resolve ] change-src1
- [ resolve ] change-src2 ;
-
-M: ##binary-imm propagate
- [ resolve ] change-src1 ;
-
-M: ##slot propagate
- [ resolve ] change-obj
- [ resolve ] change-slot ;
-
-M: ##slot-imm propagate
- [ resolve ] change-obj ;
-
-M: ##set-slot propagate
- call-next-method
- [ resolve ] change-obj
- [ resolve ] change-slot ;
-
-M: ##string-nth propagate
- [ resolve ] change-obj
- [ resolve ] change-index ;
-
-M: ##set-slot-imm propagate
- call-next-method
- [ resolve ] change-obj ;
-
-M: ##alien-getter propagate
- call-next-method
- [ resolve ] change-src ;
-
-M: ##alien-setter propagate
- call-next-method
- [ resolve ] change-value ;
-
-M: ##conditional-branch propagate
- [ resolve ] change-src1
- [ resolve ] change-src2 ;
-
-M: ##compare-imm-branch propagate
- [ resolve ] change-src1 ;
-
-M: ##dispatch propagate
- [ resolve ] change-src ;
-
-M: ##fixnum-overflow propagate
- [ resolve ] change-src1
- [ resolve ] change-src2 ;
-
-M: insn propagate ;
+++ /dev/null
-Propagation pass to update code after value numbering
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences layouts accessors combinators namespaces
-math fry
-compiler.cfg.hats
-compiler.cfg.instructions
+USING: accessors locals combinators combinators.short-circuit arrays
+fry kernel layouts math namespaces sequences cpu.architecture
+math.bitwise compiler.cfg.hats compiler.cfg.instructions
+compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
-compiler.cfg.value-numbering.simplify
-compiler.cfg.value-numbering.expressions ;
+compiler.cfg.value-numbering.simplify ;
IN: compiler.cfg.value-numbering.rewrite
GENERIC: rewrite ( insn -- insn' )
-M: ##mul-imm rewrite
- dup src2>> dup power-of-2? [
- [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn
- dup number-values
- ] [ drop ] if ;
+M: insn rewrite ;
: ##branch-t? ( insn -- ? )
dup ##compare-imm-branch? [
- [ cc>> cc/= eq? ]
- [ src2>> \ f tag-number eq? ] bi and
+ {
+ [ cc>> cc/= eq? ]
+ [ src2>> \ f tag-number eq? ]
+ } 1&&
] [ drop f ] if ; inline
: rewrite-boolean-comparison? ( insn -- ? )
: rewrite-tagged-comparison? ( insn -- ? )
#! Are we comparing two tagged fixnums? Then untag them.
- [ src1>> vreg>expr tag-fixnum-expr? ]
- [ src2>> tag-mask get bitand 0 = ]
- bi and ; inline
+ {
+ [ src1>> vreg>expr tag-fixnum-expr? ]
+ [ src2>> tag-mask get bitand 0 = ]
+ } 1&& ; inline
: (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
[ src1>> vreg>expr in1>> vn>vreg ]
dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when
] when ;
-: flip-comparison? ( insn -- ? )
- dup cc>> cc= eq? [ src1>> vreg>expr constant-expr? ] [ drop f ] if ;
-
-: flip-comparison ( insn -- insn' )
- [ dst>> ]
- [ src2>> ]
- [ src1>> vreg>vn vn>constant ] tri
- cc= i \ ##compare-imm new-insn ;
-
-M: ##compare rewrite
- dup flip-comparison? [
- flip-comparison
- dup number-values
- rewrite
- ] when ;
+:: >compare-imm ( insn swap? -- insn' )
+ insn dst>>
+ insn src1>>
+ insn src2>> swap? [ swap ] when vreg>constant
+ insn cc>> swap? [ swap-cc ] when
+ i \ ##compare-imm new-insn ; inline
+
+! M: ##compare rewrite
+! dup [ src1>> ] [ src2>> ] bi
+! [ vreg>expr constant-expr? ] bi@ 2array {
+! { { f t } [ f >compare-imm ] }
+! { { t f } [ t >compare-imm ] }
+! [ drop ]
+! } case ;
+
+:: >compare-imm-branch ( insn swap? -- insn' )
+ insn src1>>
+ insn src2>> swap? [ swap ] when vreg>constant
+ insn cc>> swap? [ swap-cc ] when
+ \ ##compare-imm-branch new-insn ; inline
+
+! M: ##compare-branch rewrite
+! dup [ src1>> ] [ src2>> ] bi
+! [ vreg>expr constant-expr? ] bi@ 2array {
+! { { f t } [ f >compare-imm-branch ] }
+! { { t f } [ t >compare-imm-branch ] }
+! [ drop ]
+! } case ;
: rewrite-redundant-comparison? ( insn -- ? )
- [ src1>> vreg>expr compare-expr? ]
- [ src2>> \ f tag-number = ]
- [ cc>> { cc= cc/= } memq? ]
- tri and and ; inline
+ {
+ [ src1>> vreg>expr compare-expr? ]
+ [ src2>> \ f tag-number = ]
+ [ cc>> { cc= cc/= } memq? ]
+ } 1&& ; inline
: rewrite-redundant-comparison ( insn -- insn' )
[ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
] when
] when ;
-M: insn rewrite ;
+: constant-fold ( insn -- insn' )
+ dup dst>> vreg>expr dup constant-expr? [
+ [ dst>> ] [ value>> ] bi* \ ##load-immediate new-insn
+ dup number-values
+ ] [
+ drop
+ ] if ;
+
+: (new-imm-insn) ( insn dst src1 n op -- new-insn/insn )
+ [ cell-bits bits ] dip over small-enough? [
+ new-insn dup number-values nip
+ ] [
+ 2drop 2drop
+ ] if constant-fold ; inline
+
+: new-imm-insn ( insn dst src n op -- n' op' )
+ 2dup [ sgn ] dip 2array
+ {
+ { { -1 ##add-imm } [ drop neg \ ##sub-imm (new-imm-insn) ] }
+ { { -1 ##sub-imm } [ drop neg \ ##add-imm (new-imm-insn) ] }
+ [ drop (new-imm-insn) ]
+ } case ; inline
+
+: combine-imm? ( insn op -- ? )
+ [ src1>> vreg>expr op>> ] dip = ;
+
+: (combine-imm) ( insn quot op -- insn )
+ [
+ {
+ [ ]
+ [ dst>> ]
+ [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
+ [ src2>> ]
+ } cleave
+ ] [ call ] [ ] tri* new-imm-insn ; inline
+
+:: combine-imm ( insn quot op -- insn )
+ insn op combine-imm? [
+ insn quot op (combine-imm)
+ ] [
+ insn
+ ] if ; inline
+
+M: ##add-imm rewrite
+ {
+ { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm (combine-imm) ] }
+ { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm (combine-imm) ] }
+ [ ]
+ } cond ;
+
+M: ##sub-imm rewrite
+ {
+ { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm (combine-imm) ] }
+ { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm (combine-imm) ] }
+ [ ]
+ } cond ;
+
+M: ##mul-imm rewrite
+ dup src2>> dup power-of-2? [
+ [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn
+ dup number-values
+ ] [
+ drop [ * ] \ ##mul-imm combine-imm
+ ] if ;
+
+M: ##and-imm rewrite [ bitand ] \ ##and-imm combine-imm ;
+
+M: ##or-imm rewrite [ bitor ] \ ##or-imm combine-imm ;
+
+M: ##xor-imm rewrite [ bitxor ] \ ##xor-imm combine-imm ;
+
+: rewrite-add? ( insn -- ? )
+ src2>> {
+ [ vreg>expr constant-expr? ]
+ [ vreg>constant small-enough? ]
+ } 1&& ;
+
+M: ##add rewrite
+ dup rewrite-add? [
+ [ dst>> ]
+ [ src1>> ]
+ [ src2>> vreg>constant ] tri \ ##add-imm new-insn
+ dup number-values
+ ] when ;
+
+M: ##sub rewrite constant-fold ;
USING: kernel accessors combinators classes math layouts
compiler.cfg.instructions
compiler.cfg.value-numbering.graph
-compiler.cfg.value-numbering.expressions ;
+compiler.cfg.value-numbering.expressions locals ;
IN: compiler.cfg.value-numbering.simplify
! Return value of f means we didn't simplify.
[ 2drop f ]
} cond ; inline
+: simplify-sub ( expr -- vn/expr/f )
+ >binary-expr< {
+ { [ 2dup eq? ] [ 2drop T{ constant-expr f f 0 } ] }
+ { [ dup expr-zero? ] [ drop ] }
+ [ 2drop f ]
+ } cond ; inline
+
: useless-shift? ( in1 in2 -- ? )
over op>> \ ##shl-imm eq?
[ [ in2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline
dup op>> {
{ \ ##add [ simplify-add ] }
{ \ ##add-imm [ simplify-add ] }
+ { \ ##sub [ simplify-sub ] }
+ { \ ##sub-imm [ simplify-sub ] }
{ \ ##shr-imm [ simplify-shift ] }
{ \ ##sar-imm [ simplify-shift ] }
[ 2drop f ]
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs biassocs classes kernel math accessors
-sorting sets sequences
+sorting sets sequences fry
compiler.cfg.local
compiler.cfg.liveness
+compiler.cfg.renaming
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.expressions
-compiler.cfg.value-numbering.propagate
compiler.cfg.value-numbering.simplify
compiler.cfg.value-numbering.rewrite ;
IN: compiler.cfg.value-numbering
init-expressions
number-input-values ;
+: vreg>vreg-mapping ( -- assoc )
+ vregs>vns get [ keys ] keep
+ '[ dup _ [ at ] [ value-at ] bi ] H{ } map>assoc ;
+
+: rename-uses ( insns -- )
+ vreg>vreg-mapping renamings [
+ [ rename-insn-uses ] each
+ ] with-variable ;
+
: value-numbering-step ( insns -- insns' )
- [ [ number-values ] [ rewrite propagate ] bi ] map ;
+ [ [ number-values ] [ rewrite ] bi ] map
+ dup rename-uses ;
: value-numbering ( cfg -- cfg' )
[ init-value-numbering ] [ value-numbering-step ] local-optimization ;
: lookup-label ( id -- label )
labels get [ drop <label> ] cache ;
+M: ##no-tco generate-insn drop ;
+
M: ##load-immediate generate-insn
[ dst>> register ] [ val>> ] bi %load-immediate ;
}
] [
[ { 1 2 3 } "x" "y" linear-scan-regression ] { } make
-] unit-test
\ No newline at end of file
+] unit-test
+
+! Regression from Doug's value numbering changes
+[ t ] [ 2 [ 1 swap fixnum< ] compile-call ] unit-test
+[ 3 ] [ 2 [ 1 swap fixnum< [ 3 ] [ 4 ] if ] compile-call ] unit-test
\ No newline at end of file
[ t ] [ f [ f eq? ] compile-call ] unit-test
+cell 8 = [
+ [ HEX: 40400000 ] [
+ HEX: 4200 [ HEX: 7fff fixnum-bitand 13 fixnum-shift-fast 112 23 fixnum-shift-fast fixnum+fast ]
+ compile-call
+ ] unit-test
+] when
+
! regression
[ 3 ] [
100001 f <array> 3 100000 pick set-nth
math.order math.functions accessors hashtables classes assocs
io.encodings.utf8 io.encodings.ascii io.encodings fry slots
sorting.private combinators.short-circuit grouping prettyprint
+generalizations
compiler.tree
compiler.tree.combinators
compiler.tree.cleanup
[ { integer integer } declare + drop ]
{ + +-integer-integer } inlined?
] unit-test
+
+[ [ ] ] [
+ [
+ 20 f <array>
+ [ 0 swap nth ] keep
+ [ 1 swap nth ] keep
+ [ 2 swap nth ] keep
+ [ 3 swap nth ] keep
+ [ 4 swap nth ] keep
+ [ 5 swap nth ] keep
+ [ 6 swap nth ] keep
+ [ 7 swap nth ] keep
+ [ 8 swap nth ] keep
+ [ 9 swap nth ] keep
+ [ 10 swap nth ] keep
+ [ 11 swap nth ] keep
+ [ 12 swap nth ] keep
+ 14 ndrop
+ ] cleaned-up-tree nodes>quot
+] unit-test
\ No newline at end of file
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors words assocs sequences arrays namespaces
-fry locals definitions classes.algebra
+fry locals definitions classes classes.algebra generic
stack-checker.state
stack-checker.backend
compiler.tree
compiler.tree.dead-code.liveness ;
IN: compiler.tree.dead-code.simple
-: flushable? ( word -- ? )
- [ "flushable" word-prop ] [ "predicating" word-prop ] bi or ;
+GENERIC: flushable? ( word -- ? )
+
+M: predicate flushable? drop t ;
+
+M: word flushable? "flushable" word-prop ;
+
+M: method-body flushable? "method-generic" word-prop flushable? ;
: flushable-call? ( #call -- ? )
dup word>> dup flushable? [
--- /dev/null
+Slava Pestov
+Daniel Ehrenberg
+! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
IN: compiler.tree.modular-arithmetic.tests
USING: kernel kernel.private tools.test math math.partial-dispatch
math.private accessors slots.private sequences strings sbufs
compiler.tree.builder
compiler.tree.optimizer
-compiler.tree.debugger ;
+compiler.tree.debugger
+alien.accessors layouts combinators byte-arrays ;
: test-modular-arithmetic ( quot -- quot' )
build-tree optimize-tree nodes>quot ;
] unit-test
[ [ >fixnum 255 fixnum-bitand ] ]
-[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
\ No newline at end of file
+[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-1 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-1 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-2 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-2 ] test-modular-arithmetic ] unit-test
+
+cell {
+ { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
+ { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-4 ] ] ] }
+} case
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-4 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-8 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-1 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-1 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-2 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-2 ] test-modular-arithmetic ] unit-test
+
+cell {
+ { 4 [ [ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
+ { 8 [ [ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-4 ] ] ] }
+} case
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-4 ] test-modular-arithmetic ] unit-test
+
+[ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] ]
+[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
+
+[ t ] [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: math math.partial-dispatch namespaces sequences sets
accessors assocs words kernel memoize fry combinators
-combinators.short-circuit
+combinators.short-circuit layouts alien.accessors
compiler.tree
compiler.tree.combinators
compiler.tree.def-use
{ bitand bitor bitxor bitnot }
[ t "modular-arithmetic" set-word-prop ] each
+{
+ >fixnum
+ set-alien-unsigned-1 set-alien-signed-1
+ set-alien-unsigned-2 set-alien-signed-2
+}
+cell 8 = [
+ { set-alien-unsigned-4 set-alien-signed-4 } append
+] when
+[ t "low-order" set-word-prop ] each
+
SYMBOL: modularize-values
: modular-value? ( value -- ? )
GENERIC: compute-modularized-values* ( node -- )
M: #call compute-modularized-values*
- dup word>> \ >fixnum eq?
+ dup word>> "low-order" word-prop
[ in-d>> first maybe-modularize ] [ drop ] if ;
M: node compute-modularized-values* drop ;
: ?check ( nodes -- nodes' )
check-optimizer? get [
- compute-def-use
dup check-nodes
] when ;
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes classes.algebra classes.tuple
classes.tuple.private kernel accessors math math.intervals
-namespaces sequences words combinators
+namespaces sequences words combinators byte-arrays strings
arrays compiler.tree.propagation.copy ;
IN: compiler.tree.propagation.info
[ read-only>> [ <literal-info> ] [ drop f ] if ] 2map
f prefix ;
+UNION: fixed-length array byte-array string ;
+
: init-literal-info ( info -- info )
+ [-inf,inf] >>interval
dup literal>> class >>class
- dup literal>> dup real? [ [a,a] >>interval ] [
- [ [-inf,inf] >>interval ] dip
- dup tuple? [ tuple-slot-infos >>slots ] [ drop ] if
- ] if ; inline
+ dup literal>> {
+ { [ dup real? ] [ [a,a] >>interval ] }
+ { [ dup tuple? ] [ tuple-slot-infos >>slots ] }
+ { [ dup fixed-length? ] [ length <literal-info> >>length ] }
+ [ drop ]
+ } cond ; inline
: init-value-info ( info -- info )
dup literal?>> [
[ { fixnum } declare dup 10 eq? [ "A" throw ] unless ] final-literals
] unit-test
+[ V{ 3 } ] [ [ [ { 1 2 3 } ] [ { 4 5 6 } ] if length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ [ B{ 1 2 3 } ] [ B{ 4 5 6 } ] if length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ [ "yay" ] [ "hah" ] if length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ 3 <byte-array> length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ 3 f <string> length ] final-literals ] unit-test
+
! Slot propagation
TUPLE: prop-test-tuple { x integer } ;
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: locals alien.c-types alien.syntax arrays kernel
+USING: locals alien.c-types alien.syntax arrays kernel fry
math namespaces sequences system layouts io vocabs.loader
accessors init combinators command-line cpu.x86.assembler
cpu.x86 cpu.architecture make compiler compiler.units
M:: x86.32 %dispatch ( src temp -- )
! Load jump table base.
- src HEX: ffffffff ADD
+ temp src HEX: ffffffff [+] LEA
+ building get length cell - :> start
0 rc-absolute-cell rel-here
! Go
- src HEX: 7f [+] JMP
+ temp HEX: 7f [+] JMP
+ building get length :> end
! Fix up the displacement above
cell code-alignment
- [ 7 + building get dup pop* push ]
+ [ end start - + building get dup pop* push ]
[ align-code ]
bi ;
align-stack incr-stack-reg ;
: with-aligned-stack ( n quot -- )
- [ [ align-sub ] [ call ] bi* ]
- [ [ align-add ] [ drop ] bi* ] 2bi ; inline
+ '[ align-sub @ ] [ align-add ] bi ; inline
M: x86.32 %prologue ( n -- )
dup PUSH
0 PUSH rc-absolute-cell rel-this
- stack-reg swap 3 cells - SUB ;
+ 3 cells - decr-stack-reg ;
M: object %load-param-reg 3drop ;
M: x86.64 stack-reg RSP ;
M:: x86.64 %dispatch ( src temp -- )
+ building get length :> start
! Load jump table base.
temp HEX: ffffffff MOV
0 rc-absolute-cell rel-here
! Add jump table base
- src temp ADD
- src HEX: 7f [+] JMP
+ temp src ADD
+ temp HEX: 7f [+] JMP
+ building get length :> end
! Fix up the displacement above
cell code-alignment
- [ 15 + building get dup pop* push ]
+ [ end start - 2 - + building get dup pop* push ]
[ align-code ]
bi ;
--- /dev/null
+IN: disjoint-sets.testes
+USING: tools.test disjoint-sets namespaces slots.private ;
+
+SYMBOL: +blah+
+-405534154 +blah+ 1 set-slot
+
+SYMBOL: uf
+
+[ ] [
+ <disjoint-set> uf set
+ +blah+ uf get add-atom
+ 19026 uf get add-atom
+ 19026 +blah+ uf get equate
+] unit-test
+
+[ 2 ] [ 19026 uf get equiv-set-size ] unit-test
USING: parser lexer kernel namespaces sequences definitions
io.files io.backend io.pathnames io summary continuations
tools.crossref vocabs.hierarchy prettyprint source-files
-source-files.errors assocs vocabs vocabs.loader splitting
+source-files.errors assocs vocabs.loader splitting
accessors debugger help.topics ;
+FROM: vocabs => vocab-name >vocab-link ;
IN: editors
TUPLE: no-edit-hook ;
SYMBOL: edit-hook
: available-editors ( -- seq )
- "editors" all-child-vocabs-seq [ vocab-name ] map ;
+ "editors" child-vocabs no-roots no-prefixes [ vocab-name ] map ;
: editor-restarts ( -- alist )
available-editors
[ "<p><a href=\"a\">a</a> <a href=\"b\">c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
-[ "<p><a href=\"C%2b%2b\">C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
+[ "<p><a href=\"C%2B%2B\">C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
[ "<p><foo></p>" ] [ "<foo>" convert-farkup ] unit-test
SYNTAX: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ;
+SYNTAX: DEFERS [ current-vocab create ] (INTERPOLATE) ;
+
SYNTAX: DEFINES [ create-in ] (INTERPOLATE) ;
SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ;
[ dup name>> >lower ] { } map>assoc ;
: vocab-candidates ( -- candidates )
- all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
+ all-vocabs-recursive no-roots no-prefixes
+ [ dup vocab-name >lower ] { } map>assoc ;
: help-candidates ( seq -- candidates )
[ [ >link ] [ article-title >lower ] bi ] { } map>assoc
assocs sequences make words accessors arrays help.topics vocabs
vocabs.hierarchy help.vocabs namespaces prettyprint io
vocabs.loader serialize fry memoize unicode.case math.order
-sorting debugger html xml.syntax xml.writer math.parser ;
+sorting debugger html xml.syntax xml.writer math.parser
+sets hashtables ;
FROM: io.encodings.ascii => ascii ;
FROM: ascii => ascii? ;
IN: help.html
{ CHAR: / "__slash__" }
{ CHAR: , "__comma__" }
{ CHAR: @ "__at__" }
+ { CHAR: # "__hash__" }
} at [ % ] [ , ] ?if
] [ number>string "__" "__" surround % ] if ;
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
: all-vocabs-really ( -- seq )
- #! Hack.
- all-vocabs values concat
- vocabs [ find-vocab-root not ] filter [ vocab ] map append ;
+ all-vocabs >hashtable f over delete-at no-roots remove-redundant-prefixes ;
: all-topics ( -- topics )
[
source-files.errors vocabs.hierarchy vocabs words classes
locals tools.errors listener ;
FROM: help.lint.checks => all-vocabs ;
+FROM: vocabs => child-vocabs ;
IN: help.lint
SYMBOL: lint-failures
: help-lint ( prefix -- )
[
auto-use? off
- all-vocabs-seq [ vocab-name ] map all-vocabs set
+ all-vocab-names all-vocabs set
group-articles vocab-articles set
child-vocabs
[ check-vocab ] each
make namespaces prettyprint sequences sets sorting summary
vocabs vocabs.files vocabs.hierarchy vocabs.loader
vocabs.metadata words words.symbol definitions.icons ;
+FROM: vocabs.hierarchy => child-vocabs ;
IN: help.vocabs
: about ( vocab -- )
$heading ;
: $vocabs ( seq -- )
- [ vocab-row ] map vocab-headings prefix $table ;
+ convert-prefixes [ vocab-row ] map vocab-headings prefix $table ;
: $vocab-roots ( assoc -- )
[
] unless-empty ;
: describe-children ( vocab -- )
- vocab-name all-child-vocabs $vocab-roots ;
+ vocab-name child-vocabs
+ $vocab-roots ;
: files. ( seq -- )
snippet-style get [
{ version "1.1" }
{ cookies V{ } }
{ header H{ { "connection" "close" } { "user-agent" "Factor http.client" } } }
+ { redirects 10 }
}
] [
"http://www.apple.com/index.html"
{ version "1.1" }
{ cookies V{ } }
{ header H{ { "connection" "close" } { "user-agent" "Factor http.client" } } }
+ { redirects 10 }
}
] [
"https://www.amazon.com/index.html"
ERROR: too-many-redirects ;
-CONSTANT: max-redirects 10
-
<PRIVATE
: write-request-line ( request -- request )
:: do-redirect ( quot: ( chunk -- ) response -- response )
redirects inc
- redirects get max-redirects < [
+ redirects get request get redirects>> < [
request get clone
response "location" header redirect-url
response code>> 307 = [ "GET" >>method ] unless
with-output-stream*
] [
in>> [
- read-response dup redirect? [ t ] [
+ read-response dup redirect?
+ request get redirects>> 0 > and [ t ] [
[ nip response set ]
[ read-response-body ]
[ ]
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel summary debugger io make math.parser
-prettyprint http.client accessors ;
+prettyprint http http.client accessors ;
IN: http.client.debugger
M: too-many-redirects summary
{ { $slot "header" } { "An assoc of HTTP header values. See " { $link "http.headers" } } }
{ { $slot "post-data" } { "See " { $link "http.post-data" } } }
{ { $slot "cookies" } { "A sequence of HTTP cookies. See " { $link "http.cookies" } } }
+ { { $slot "redirects" } { "Number of redirects to attempt before throwing an error. Default is " { $snippet "max-redirects" } " ." } }
} } ;
HELP: <response>
{ header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
{ post-data T{ post-data { data "blah" } { content-type "application/octet-stream" } } }
{ cookies V{ } }
+ { redirects 10 }
}
] [
read-request-test-1 lf>crlf [
{ version "1.1" }
{ header H{ { "host" "www.sex.com" } } }
{ cookies V{ } }
+ { redirects 10 }
}
] [
read-request-test-2 lf>crlf [
base64 ;
IN: http
+CONSTANT: max-redirects 10
+
: (read-header) ( -- alist )
[ read-crlf dup f like ] [ parse-header-line ] produce nip ;
version
header
post-data
-cookies ;
+cookies
+redirects ;
: set-header ( request/response value key -- request/response )
pick header>> set-at ;
H{ } clone >>header
V{ } clone >>cookies
"close" "connection" set-header
- "Factor http.client" "user-agent" set-header ;
+ "Factor http.client" "user-agent" set-header
+ max-redirects >>redirects ;
: header ( request/response key -- value )
swap header>> at ;
IN: images
SINGLETONS:
- L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
- ubyte-components ushort-components
+ A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
+ INTENSITY DEPTH DEPTH-STENCIL R RG
+ ubyte-components ushort-components uint-components
half-components float-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
- int-integer-components uint-integer-components ;
+ int-integer-components uint-integer-components
+ u-5-5-5-1-components u-5-6-5-components
+ u-10-10-10-2-components
+ u-24-components u-24-8-components
+ float-32-u-8-components
+ u-9-9-9-e5-components
+ float-11-11-10-components ;
UNION: component-order
- L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
+ A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
+ INTENSITY DEPTH DEPTH-STENCIL R RG ;
UNION: component-type
- ubyte-components ushort-components
+ ubyte-components ushort-components uint-components
half-components float-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
- int-integer-components uint-integer-components ;
+ int-integer-components uint-integer-components
+ u-5-5-5-1-components u-5-6-5-components
+ u-10-10-10-2-components
+ u-24-components u-24-8-components
+ float-32-u-8-components
+ u-9-9-9-e5-components
+ float-11-11-10-components ;
UNION: unnormalized-integer-components
byte-integer-components ubyte-integer-components
short-integer-components ushort-integer-components
int-integer-components uint-integer-components ;
-UNION: alpha-channel BGRA RGBA ABGR ARGB ;
+UNION: signed-unnormalized-integer-components
+ byte-integer-components
+ short-integer-components
+ int-integer-components ;
+
+UNION: unsigned-unnormalized-integer-components
+ ubyte-integer-components
+ ushort-integer-components
+ uint-integer-components ;
+
+UNION: packed-components
+ u-5-5-5-1-components u-5-6-5-components
+ u-10-10-10-2-components
+ u-24-components u-24-8-components
+ float-32-u-8-components
+ u-9-9-9-e5-components
+ float-11-11-10-components ;
+
+UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
+
+UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
TUPLE: image dim component-order component-type upside-down? bitmap ;
GENERIC: load-image* ( path class -- image )
-DEFER: bytes-per-pixel
-
-<PRIVATE
-
: bytes-per-component ( component-type -- n )
{
{ ubyte-components [ 1 ] }
{ ushort-components [ 2 ] }
+ { uint-components [ 4 ] }
{ half-components [ 2 ] }
{ float-components [ 4 ] }
{ byte-integer-components [ 1 ] }
{ uint-integer-components [ 4 ] }
} case ;
+: bytes-per-packed-pixel ( component-type -- n )
+ {
+ { u-5-5-5-1-components [ 2 ] }
+ { u-5-6-5-components [ 2 ] }
+ { u-10-10-10-2-components [ 4 ] }
+ { u-24-components [ 4 ] }
+ { u-24-8-components [ 4 ] }
+ { u-9-9-9-e5-components [ 4 ] }
+ { float-11-11-10-components [ 4 ] }
+ { float-32-u-8-components [ 8 ] }
+ } case ;
+
: component-count ( component-order -- n )
{
+ { A [ 1 ] }
{ L [ 1 ] }
{ LA [ 2 ] }
{ BGR [ 3 ] }
{ XRGB [ 4 ] }
{ BGRX [ 4 ] }
{ XBGR [ 4 ] }
+ { INTENSITY [ 1 ] }
+ { DEPTH [ 1 ] }
+ { DEPTH-STENCIL [ 1 ] }
+ { R [ 1 ] }
+ { RG [ 2 ] }
} case ;
+: (bytes-per-pixel) ( component-order component-type -- n )
+ dup packed-components?
+ [ nip bytes-per-packed-pixel ] [
+ [ component-count ] [ bytes-per-component ] bi* *
+ ] if ;
+
+: bytes-per-pixel ( image -- n )
+ [ component-order>> ] [ component-type>> ] bi (bytes-per-pixel) ;
+
+<PRIVATE
+
: pixel@ ( x y image -- start end bitmap )
[ dim>> first * + ]
[ bytes-per-pixel [ * dup ] keep + ]
PRIVATE>
-: bytes-per-pixel ( image -- n )
- [ component-order>> component-count ]
- [ component-type>> bytes-per-component ] bi * ;
-
: pixel-at ( x y image -- pixel )
pixel@ subseq ;
{ [ os winnt? ] [ "io.launcher.windows.nt" require ] }
[ ]
} cond
-
-: run-desc ( desc -- result ) ascii <process-reader> f swap stream-read-until drop ;
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays columns kernel math math.bits
-math.order math.vectors sequences sequences.private fry ;
+USING: accessors arrays columns kernel locals math math.bits
+math.functions math.order math.vectors sequences
+sequences.private fry ;
IN: math.matrices
! Matrices
#! Make a nxn identity matrix.
dup [ [ = 1 0 ? ] with map ] curry map ;
+:: rotation-matrix3 ( axis theta -- matrix )
+ theta cos :> c
+ theta sin :> s
+ axis first3 :> z :> y :> x
+ x sq 1.0 x sq - c * + x y * 1.0 c - * z s * - x z * 1.0 c - * y s * + 3array
+ x y * 1.0 c - * z s * + y sq 1.0 y sq - c * + y z * 1.0 c - * x s * - 3array
+ x z * 1.0 c - * y s * - y z * 1.0 c - * x s * + z sq 1.0 z sq - c * + 3array
+ 3array ;
+
+:: rotation-matrix4 ( axis theta -- matrix )
+ theta cos :> c
+ theta sin :> s
+ axis first3 :> z :> y :> x
+ x sq 1.0 x sq - c * + x y * 1.0 c - * z s * - x z * 1.0 c - * y s * + 0 4array
+ x y * 1.0 c - * z s * + y sq 1.0 y sq - c * + y z * 1.0 c - * x s * - 0 4array
+ x z * 1.0 c - * y s * - y z * 1.0 c - * x s * + z sq 1.0 z sq - c * + 0 4array
+ { 0.0 0.0 0.0 1.0 } 4array ;
+
+:: translation-matrix4 ( offset -- matrix )
+ offset first3 :> z :> y :> x
+ {
+ { 1.0 0.0 0.0 x }
+ { 0.0 1.0 0.0 y }
+ { 0.0 0.0 1.0 z }
+ { 0.0 0.0 0.0 1.0 }
+ } ;
+
+: >scale-factors ( number/sequence -- x y z )
+ dup number? [ dup dup ] [ first3 ] if ;
+
+:: scale-matrix3 ( factors -- matrix )
+ factors >scale-factors :> z :> y :> x
+ {
+ { x 0.0 0.0 }
+ { 0.0 y 0.0 }
+ { 0.0 0.0 z }
+ } ;
+
+:: scale-matrix4 ( factors -- matrix )
+ factors >scale-factors :> z :> y :> x
+ {
+ { x 0.0 0.0 0.0 }
+ { 0.0 y 0.0 0.0 }
+ { 0.0 0.0 z 0.0 }
+ { 0.0 0.0 0.0 1.0 }
+ } ;
+
+: ortho-matrix4 ( dim -- matrix )
+ [ recip ] map scale-matrix4 ;
+
+:: frustum-matrix4 ( xy-dim near far -- matrix )
+ xy-dim first2 :> y :> x
+ near x /f :> xf
+ near y /f :> yf
+ near far + near far - /f :> zf
+ 2 near far * * near far - /f :> wf
+
+ {
+ { xf 0.0 0.0 0.0 }
+ { 0.0 yf 0.0 0.0 }
+ { 0.0 0.0 zf wf }
+ { 0.0 0.0 -1.0 0.0 }
+ } ;
+
+:: skew-matrix4 ( theta -- matrix )
+ theta tan :> zf
+
+ {
+ { 1.0 0.0 0.0 0.0 }
+ { 0.0 1.0 0.0 0.0 }
+ { 0.0 zf 1.0 0.0 }
+ { 0.0 0.0 0.0 1.0 }
+ } ;
+
! Matrix operations
: mneg ( m -- m ) [ vneg ] map ;
USING: help.markup help.syntax math sequences ;
IN: math.primes.factors
-{ factors group-factors unique-factors } related-words
+{ divisors factors group-factors unique-factors } related-words
HELP: factors
{ $values { "n" "a positive integer" } { "seq" sequence } }
HELP: totient
{ $values { "n" "a positive integer" } { "t" integer } }
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
+
+HELP: divisors
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return the ordered list of divisors of " { $snippet "n" } ", including 1 and " { $snippet "n" } "." } } ;
-USING: math.primes.factors tools.test ;
+USING: math.primes.factors sequences tools.test ;
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
{ { } } [ -5 factors ] unit-test
{ 0 } [ 1 totient ] unit-test
{ { 425612003 } } [ 425612003 factors ] unit-test
{ { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test
+{ { 1 2 3 4 6 8 12 24 } } [ 24 divisors ] unit-test
+{ 24 } [ 360 divisors length ] unit-test
! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators kernel make math math.functions
-math.primes sequences ;
+math.primes math.ranges sequences sequences.product sorting ;
IN: math.primes.factors
<PRIVATE
{ [ dup 2 < ] [ drop 0 ] }
[ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ]
} cond ; foldable
+
+: divisors ( n -- seq )
+ group-factors [ first2 [0,b] [ ^ ] with map ] map
+ [ product ] product-map natural-sort ;
! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel math math.bitwise math.functions
-math.order math.primes.erato math.primes.erato.private
-math.primes.miller-rabin math.ranges literals random sequences sets ;
+USING: combinators combinators.short-circuit fry kernel math
+math.bitwise math.functions math.order math.primes.erato
+math.primes.erato.private math.primes.miller-rabin math.ranges
+literals random sequences sets vectors ;
IN: math.primes
<PRIVATE
: (prime?) ( n -- ? )
dup 8999999 <= [ look-in-bitmap ] [ miller-rabin ] if ;
+! In order not to reallocate large vectors, we compute the upper bound
+! of the number of primes in a given interval. We use a double inequality given
+! by Pierre Dusart in http://www.ams.org/mathscinet-getitem?mr=99d:11133
+! for x > 598. Under this limit, we know that there are at most 108 primes.
+: upper-pi ( x -- y )
+ dup log [ / ] [ 1.2762 swap / 1 + ] bi * ceiling ;
+
+: lower-pi ( x -- y )
+ dup log [ / ] [ 0.992 swap / 1 + ] bi * floor ;
+
+: <primes-vector> ( low high -- vector )
+ swap [ [ upper-pi ] [ lower-pi ] bi* - >integer
+ 108 max 10000 min <vector> ] keep
+ 3 < [ [ 2 swap push ] keep ] when ;
+
+: simple? ( n -- ? ) { [ even? ] [ 3 mod 0 = ] [ 5 mod 0 = ] } 1|| ;
+
PRIVATE>
: prime? ( n -- ? )
{
{ [ dup 7 < ] [ { 2 3 5 } member? ] }
- { [ dup even? ] [ 2 = ] }
+ { [ dup simple? ] [ drop f ] }
[ (prime?) ]
} cond ; foldable
] if ; foldable
: primes-between ( low high -- seq )
- [ dup 3 max dup even? [ 1 + ] when ] dip
- 2 <range> [ prime? ] filter
- swap 3 < [ 2 prefix ] when ;
+ [ [ 3 max dup even? [ 1 + ] when ] dip 2 <range> ]
+ [ <primes-vector> ] 2bi
+ [ '[ [ prime? ] _ push-if ] each ] keep clone ;
: primes-upto ( n -- seq ) 2 swap primes-between ;
[ { 1.75 2.125 } ] [ { 1.0 2.5 } { 2.5 1.0 } { 0.5 0.25 } vlerp ] unit-test
[ 1.125 ] [ 0.0 1.0 2.0 4.0 { 0.5 0.25 } bilerp ] unit-test
+
+[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test
\ No newline at end of file
HELP: gen-framebuffer
{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ;
+{ $description "Wrapper for " { $link glGenFramebuffers } " to handle the common case of generating a single framebuffer ID." } ;
HELP: gen-renderbuffer
{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
+{ $description "Wrapper for " { $link glGenRenderbuffers } " to handle the common case of generating a single render buffer ID." } ;
HELP: delete-framebuffer
{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ;
+{ $description "Wrapper for " { $link glDeleteFramebuffers } " to handle the common case of deleting a single framebuffer ID." } ;
HELP: delete-renderbuffer
{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
+{ $description "Wrapper for " { $link glDeleteRenderbuffers } " to handle the common case of deleting a single render buffer ID." } ;
{ gen-framebuffer delete-framebuffer } related-words
{ gen-renderbuffer delete-renderbuffer } related-words
HELP: framebuffer-incomplete?
{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }
-{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebuffer } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ;
HELP: check-framebuffer
-{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
+{ $description "Checks the framebuffer currently bound by " { $link glBindFramebuffer } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ;
HELP: with-framebuffer
{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } }
-{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
+{ $description "Binds framebuffer " { $snippet "id" } " for drawing in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ;
-ABOUT: "gl-utilities"
\ No newline at end of file
+ABOUT: "gl-utilities"
IN: opengl.framebuffers
: gen-framebuffer ( -- id )
- [ glGenFramebuffersEXT ] (gen-gl-object) ;
+ [ glGenFramebuffers ] (gen-gl-object) ;
: gen-renderbuffer ( -- id )
- [ glGenRenderbuffersEXT ] (gen-gl-object) ;
+ [ glGenRenderbuffers ] (gen-gl-object) ;
: delete-framebuffer ( id -- )
- [ glDeleteFramebuffersEXT ] (delete-gl-object) ;
+ [ glDeleteFramebuffers ] (delete-gl-object) ;
: delete-renderbuffer ( id -- )
- [ glDeleteRenderbuffersEXT ] (delete-gl-object) ;
+ [ glDeleteRenderbuffers ] (delete-gl-object) ;
: framebuffer-incomplete? ( -- status/f )
- GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
- dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;
+ GL_DRAW_FRAMEBUFFER glCheckFramebufferStatus
+ dup GL_FRAMEBUFFER_COMPLETE = f rot ? ;
: framebuffer-error ( status -- * )
{
- { GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] }
- { GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] }
- { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] }
- { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] }
+ { GL_FRAMEBUFFER_COMPLETE [ "framebuffer complete" ] }
+ { GL_FRAMEBUFFER_UNSUPPORTED [ "framebuffer configuration unsupported" ] }
+ { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT [ "framebuffer incomplete (incomplete attachment)" ] }
+ { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT [ "framebuffer incomplete (missing attachment)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] }
{ GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] }
- { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
- { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] }
- { GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT [ "framebuffer incomplete (multisample counts don't match)" ] }
+ { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] }
+ { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER [ "framebuffer incomplete (read buffer has no attachment)" ] }
+ { GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE [ "framebuffer incomplete (multisample counts don't match)" ] }
[ drop gl-error "unknown framebuffer error" ]
} case throw ;
framebuffer-incomplete? [ framebuffer-error ] when* ;
: with-framebuffer ( id quot -- )
- [ GL_FRAMEBUFFER_EXT swap glBindFramebufferEXT ] dip
- [ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline
+ [ GL_DRAW_FRAMEBUFFER swap glBindFramebuffer ] dip
+ [ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer ] [ ] cleanup ; inline
: with-draw-read-framebuffers ( draw-id read-id quot -- )
[
- [ GL_DRAW_FRAMEBUFFER_EXT swap glBindFramebufferEXT ]
- [ GL_READ_FRAMEBUFFER_EXT swap glBindFramebufferEXT ] bi*
+ [ GL_DRAW_FRAMEBUFFER swap glBindFramebuffer ]
+ [ GL_READ_FRAMEBUFFER swap glBindFramebuffer ] bi*
] dip
[
- GL_DRAW_FRAMEBUFFER_EXT 0 glBindFramebufferEXT
- GL_READ_FRAMEBUFFER_EXT 0 glBindFramebufferEXT
+ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer
+ GL_READ_FRAMEBUFFER 0 glBindFramebuffer
] [ ] cleanup ; inline
: framebuffer-attachment ( attachment -- id )
- GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT
- 0 <uint> [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ;
+ GL_FRAMEBUFFER swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME
+ 0 <uint> [ glGetFramebufferAttachmentParameteriv ] keep *uint ;
CONSTANT: GL_NONE HEX: 0
CONSTANT: GL_LEFT HEX: 0406
CONSTANT: GL_RIGHT HEX: 0407
-
+CONSTANT: GL_FRONT_LEFT HEX: 0400
CONSTANT: GL_FRONT_RIGHT HEX: 0401
CONSTANT: GL_BACK_LEFT HEX: 0402
CONSTANT: GL_BACK_RIGHT HEX: 0403
GL-FUNCTION: void glTexSubImage3D { glTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels ) ;
+! GL_ARB_imaging
+
+
+CONSTANT: GL_CONSTANT_COLOR HEX: 8001
+CONSTANT: GL_ONE_MINUS_CONSTANT_COLOR HEX: 8002
+CONSTANT: GL_CONSTANT_ALPHA HEX: 8003
+CONSTANT: GL_ONE_MINUS_CONSTANT_ALPHA HEX: 8004
+CONSTANT: GL_BLEND_COLOR HEX: 8005
+CONSTANT: GL_FUNC_ADD HEX: 8006
+CONSTANT: GL_MIN HEX: 8007
+CONSTANT: GL_MAX HEX: 8008
+CONSTANT: GL_BLEND_EQUATION HEX: 8009
+CONSTANT: GL_FUNC_SUBTRACT HEX: 800A
+CONSTANT: GL_FUNC_REVERSE_SUBTRACT HEX: 800B
+
+
! OpenGL 1.3
GL-FUNCTION: void glMultiDrawElements { glMultiDrawElementsEXT } ( GLenum mode, GLsizei* count, GLenum type, GLvoid** indices, GLsizei primcount ) ;
GL-FUNCTION: void glPointParameterf { glPointParameterfARB } ( GLenum pname, GLfloat param ) ;
GL-FUNCTION: void glPointParameterfv { glPointParameterfvARB } ( GLenum pname, GLfloat* params ) ;
+GL-FUNCTION: void glPointParameteri { glPointParameteriARB } ( GLenum pname, GLint param ) ;
+GL-FUNCTION: void glPointParameteriv { glPointParameterivARB } ( GLenum pname, GLint* params ) ;
GL-FUNCTION: void glSecondaryColor3b { glSecondaryColor3bEXT } ( GLbyte red, GLbyte green, GLbyte blue ) ;
GL-FUNCTION: void glSecondaryColor3bv { glSecondaryColor3bvEXT } ( GLbyte* v ) ;
GL-FUNCTION: void glSecondaryColor3d { glSecondaryColor3dEXT } ( GLdouble red, GLdouble green, GLdouble blue ) ;
CONSTANT: GL_STENCIL_BACK_REF HEX: 8CA3
CONSTANT: GL_STENCIL_BACK_VALUE_MASK HEX: 8CA4
CONSTANT: GL_STENCIL_BACK_WRITEMASK HEX: 8CA5
-CONSTANT: GL_BLEND_EQUATION HEX: 8009
ALIAS: GL_BLEND_EQUATION_RGB GL_BLEND_EQUATION
TYPEDEF: char GLchar
CONSTANT: GL_COMPRESSED_SRGB_ALPHA HEX: 8C49
CONSTANT: GL_COMPRESSED_SLUMINANCE HEX: 8C4A
CONSTANT: GL_COMPRESSED_SLUMINANCE_ALPHA HEX: 8C4B
+CONSTANT: GL_FLOAT_MAT2x3 HEX: 8B65
+CONSTANT: GL_FLOAT_MAT2x4 HEX: 8B66
+CONSTANT: GL_FLOAT_MAT3x2 HEX: 8B67
+CONSTANT: GL_FLOAT_MAT3x4 HEX: 8B68
+CONSTANT: GL_FLOAT_MAT4x2 HEX: 8B69
+CONSTANT: GL_FLOAT_MAT4x3 HEX: 8B6A
GL-FUNCTION: void glUniformMatrix2x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
GL-FUNCTION: void glUniformMatrix2x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
GL-FUNCTION: void glUniformMatrix4x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-! GL_EXT_framebuffer_object
-
-
-CONSTANT: GL_INVALID_FRAMEBUFFER_OPERATION_EXT HEX: 0506
-CONSTANT: GL_MAX_RENDERBUFFER_SIZE_EXT HEX: 84E8
-CONSTANT: GL_FRAMEBUFFER_BINDING_EXT HEX: 8CA6
-CONSTANT: GL_RENDERBUFFER_BINDING_EXT HEX: 8CA7
-CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT HEX: 8CD0
-CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT HEX: 8CD1
-CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT HEX: 8CD2
-CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT HEX: 8CD3
-CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT HEX: 8CD4
-CONSTANT: GL_FRAMEBUFFER_COMPLETE_EXT HEX: 8CD5
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT HEX: 8CD6
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT HEX: 8CD7
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT HEX: 8CD9
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT HEX: 8CDA
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT HEX: 8CDB
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT HEX: 8CDC
-CONSTANT: GL_FRAMEBUFFER_UNSUPPORTED_EXT HEX: 8CDD
-CONSTANT: GL_MAX_COLOR_ATTACHMENTS_EXT HEX: 8CDF
-CONSTANT: GL_COLOR_ATTACHMENT0_EXT HEX: 8CE0
-CONSTANT: GL_COLOR_ATTACHMENT1_EXT HEX: 8CE1
-CONSTANT: GL_COLOR_ATTACHMENT2_EXT HEX: 8CE2
-CONSTANT: GL_COLOR_ATTACHMENT3_EXT HEX: 8CE3
-CONSTANT: GL_COLOR_ATTACHMENT4_EXT HEX: 8CE4
-CONSTANT: GL_COLOR_ATTACHMENT5_EXT HEX: 8CE5
-CONSTANT: GL_COLOR_ATTACHMENT6_EXT HEX: 8CE6
-CONSTANT: GL_COLOR_ATTACHMENT7_EXT HEX: 8CE7
-CONSTANT: GL_COLOR_ATTACHMENT8_EXT HEX: 8CE8
-CONSTANT: GL_COLOR_ATTACHMENT9_EXT HEX: 8CE9
-CONSTANT: GL_COLOR_ATTACHMENT10_EXT HEX: 8CEA
-CONSTANT: GL_COLOR_ATTACHMENT11_EXT HEX: 8CEB
-CONSTANT: GL_COLOR_ATTACHMENT12_EXT HEX: 8CEC
-CONSTANT: GL_COLOR_ATTACHMENT13_EXT HEX: 8CED
-CONSTANT: GL_COLOR_ATTACHMENT14_EXT HEX: 8CEE
-CONSTANT: GL_COLOR_ATTACHMENT15_EXT HEX: 8CEF
-CONSTANT: GL_DEPTH_ATTACHMENT_EXT HEX: 8D00
-CONSTANT: GL_STENCIL_ATTACHMENT_EXT HEX: 8D20
-CONSTANT: GL_FRAMEBUFFER_EXT HEX: 8D40
-CONSTANT: GL_RENDERBUFFER_EXT HEX: 8D41
-CONSTANT: GL_RENDERBUFFER_WIDTH_EXT HEX: 8D42
-CONSTANT: GL_RENDERBUFFER_HEIGHT_EXT HEX: 8D43
-CONSTANT: GL_RENDERBUFFER_INTERNAL_FORMAT_EXT HEX: 8D44
-CONSTANT: GL_STENCIL_INDEX1_EXT HEX: 8D46
-CONSTANT: GL_STENCIL_INDEX4_EXT HEX: 8D47
-CONSTANT: GL_STENCIL_INDEX8_EXT HEX: 8D48
-CONSTANT: GL_STENCIL_INDEX16_EXT HEX: 8D49
-CONSTANT: GL_RENDERBUFFER_RED_SIZE_EXT HEX: 8D50
-CONSTANT: GL_RENDERBUFFER_GREEN_SIZE_EXT HEX: 8D51
-CONSTANT: GL_RENDERBUFFER_BLUE_SIZE_EXT HEX: 8D52
-CONSTANT: GL_RENDERBUFFER_ALPHA_SIZE_EXT HEX: 8D53
-CONSTANT: GL_RENDERBUFFER_DEPTH_SIZE_EXT HEX: 8D54
-CONSTANT: GL_RENDERBUFFER_STENCIL_SIZE_EXT HEX: 8D55
-
-GL-FUNCTION: void glBindFramebufferEXT { } ( GLenum target, GLuint framebuffer ) ;
-GL-FUNCTION: void glBindRenderbufferEXT { } ( GLenum target, GLuint renderbuffer ) ;
-GL-FUNCTION: GLenum glCheckFramebufferStatusEXT { } ( GLenum target ) ;
-GL-FUNCTION: void glDeleteFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
-GL-FUNCTION: void glDeleteRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
-GL-FUNCTION: void glFramebufferRenderbufferEXT { } ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
-GL-FUNCTION: void glFramebufferTexture1DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
-GL-FUNCTION: void glFramebufferTexture2DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
-GL-FUNCTION: void glFramebufferTexture3DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
-GL-FUNCTION: void glGenFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
-GL-FUNCTION: void glGenRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
-GL-FUNCTION: void glGenerateMipmapEXT { } ( GLenum target ) ;
-GL-FUNCTION: void glGetFramebufferAttachmentParameterivEXT { } ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetRenderbufferParameterivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
-GL-FUNCTION: GLboolean glIsFramebufferEXT { } ( GLuint framebuffer ) ;
-GL-FUNCTION: GLboolean glIsRenderbufferEXT { } ( GLuint renderbuffer ) ;
-GL-FUNCTION: void glRenderbufferStorageEXT { } ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
-
-
-! GL_EXT_framebuffer_blit
-
-
-GL-FUNCTION: void glBlitFramebufferEXT { } ( GLint srcX0, GLint srcY0, GLint srcX1, GLint srcY1,
+! OpenGL 3.0
+
+
+TYPEDEF: ushort GLhalf
+
+CONSTANT: GL_VERTEX_ATTRIB_ARRAY_INTEGER HEX: 88FD
+CONSTANT: GL_SAMPLER_CUBE_SHADOW HEX: 8DC5
+CONSTANT: GL_UNSIGNED_INT_VEC2 HEX: 8DC6
+CONSTANT: GL_UNSIGNED_INT_VEC3 HEX: 8DC7
+CONSTANT: GL_UNSIGNED_INT_VEC4 HEX: 8DC8
+CONSTANT: GL_INT_SAMPLER_1D HEX: 8DC9
+CONSTANT: GL_INT_SAMPLER_2D HEX: 8DCA
+CONSTANT: GL_INT_SAMPLER_3D HEX: 8DCB
+CONSTANT: GL_INT_SAMPLER_CUBE HEX: 8DCC
+CONSTANT: GL_INT_SAMPLER_2D_RECT HEX: 8DCD
+CONSTANT: GL_INT_SAMPLER_1D_ARRAY HEX: 8DCE
+CONSTANT: GL_INT_SAMPLER_2D_ARRAY HEX: 8DCF
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D HEX: 8DD1
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D HEX: 8DD2
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_3D HEX: 8DD3
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_CUBE HEX: 8DD4
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_RECT HEX: 8DD5
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D_ARRAY HEX: 8DD6
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_ARRAY HEX: 8DD7
+CONSTANT: GL_MIN_PROGRAM_TEXEL_OFFSET HEX: 8904
+CONSTANT: GL_MAX_PROGRAM_TEXEL_OFFSET HEX: 8905
+
+CONSTANT: GL_RGBA32F HEX: 8814
+CONSTANT: GL_RGB32F HEX: 8815
+CONSTANT: GL_RGBA16F HEX: 881A
+CONSTANT: GL_RGB16F HEX: 881B
+CONSTANT: GL_TEXTURE_RED_TYPE HEX: 8C10
+CONSTANT: GL_TEXTURE_GREEN_TYPE HEX: 8C11
+CONSTANT: GL_TEXTURE_BLUE_TYPE HEX: 8C12
+CONSTANT: GL_TEXTURE_ALPHA_TYPE HEX: 8C13
+CONSTANT: GL_TEXTURE_DEPTH_TYPE HEX: 8C16
+CONSTANT: GL_UNSIGNED_NORMALIZED HEX: 8C17
+
+CONSTANT: GL_QUERY_WAIT HEX: 8E13
+CONSTANT: GL_QUERY_NO_WAIT HEX: 8E14
+CONSTANT: GL_QUERY_BY_REGION_WAIT HEX: 8E15
+CONSTANT: GL_QUERY_BY_REGION_NO_WAIT HEX: 8E16
+
+CONSTANT: GL_HALF_FLOAT HEX: 140B
+
+CONSTANT: GL_MAP_READ_BIT HEX: 0001
+CONSTANT: GL_MAP_WRITE_BIT HEX: 0002
+CONSTANT: GL_MAP_INVALIDATE_RANGE_BIT HEX: 0004
+CONSTANT: GL_MAP_INVALIDATE_BUFFER_BIT HEX: 0008
+CONSTANT: GL_MAP_FLUSH_EXPLICIT_BIT HEX: 0010
+CONSTANT: GL_MAP_UNSYNCHRONIZED_BIT HEX: 0020
+
+CONSTANT: GL_R8 HEX: 8229
+CONSTANT: GL_R16 HEX: 822A
+CONSTANT: GL_RG8 HEX: 822B
+CONSTANT: GL_RG16 HEX: 822C
+CONSTANT: GL_R16F HEX: 822D
+CONSTANT: GL_R32F HEX: 822E
+CONSTANT: GL_RG16F HEX: 822F
+CONSTANT: GL_RG32F HEX: 8230
+CONSTANT: GL_R8I HEX: 8231
+CONSTANT: GL_R8UI HEX: 8232
+CONSTANT: GL_R16I HEX: 8233
+CONSTANT: GL_R16UI HEX: 8234
+CONSTANT: GL_R32I HEX: 8235
+CONSTANT: GL_R32UI HEX: 8236
+CONSTANT: GL_RG8I HEX: 8237
+CONSTANT: GL_RG8UI HEX: 8238
+CONSTANT: GL_RG16I HEX: 8239
+CONSTANT: GL_RG16UI HEX: 823A
+CONSTANT: GL_RG32I HEX: 823B
+CONSTANT: GL_RG32UI HEX: 823C
+CONSTANT: GL_RG HEX: 8227
+CONSTANT: GL_COMPRESSED_RED HEX: 8225
+CONSTANT: GL_COMPRESSED_RG HEX: 8226
+CONSTANT: GL_RG_INTEGER HEX: 8228
+
+CONSTANT: GL_VERTEX_ARRAY_BINDING HEX: 85B5
+
+CONSTANT: GL_CLAMP_READ_COLOR HEX: 891C
+CONSTANT: GL_FIXED_ONLY HEX: 891D
+
+CONSTANT: GL_DEPTH_COMPONENT32F HEX: 8CAC
+CONSTANT: GL_DEPTH32F_STENCIL8 HEX: 8CAD
+
+CONSTANT: GL_RGB9_E5 HEX: 8C3D
+CONSTANT: GL_UNSIGNED_INT_5_9_9_9_REV HEX: 8C3E
+CONSTANT: GL_TEXTURE_SHARED_SIZE HEX: 8C3F
+
+CONSTANT: GL_R11F_G11F_B10F HEX: 8C3A
+CONSTANT: GL_UNSIGNED_INT_10F_11F_11F_REV HEX: 8C3B
+
+CONSTANT: GL_INVALID_FRAMEBUFFER_OPERATION HEX: 0506
+CONSTANT: GL_MAX_RENDERBUFFER_SIZE HEX: 84E8
+CONSTANT: GL_FRAMEBUFFER_BINDING HEX: 8CA6
+CONSTANT: GL_RENDERBUFFER_BINDING HEX: 8CA7
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE HEX: 8CD0
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME HEX: 8CD1
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL HEX: 8CD2
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE HEX: 8CD3
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING HEX: 8210
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE HEX: 8211
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE HEX: 8212
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE HEX: 8213
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE HEX: 8214
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE HEX: 8215
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE HEX: 8216
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE HEX: 8217
+CONSTANT: GL_FRAMEBUFFER_DEFAULT HEX: 8218
+CONSTANT: GL_FRAMEBUFFER_UNDEFINED HEX: 8219
+CONSTANT: GL_DEPTH_STENCIL_ATTACHMENT HEX: 821A
+CONSTANT: GL_FRAMEBUFFER_COMPLETE HEX: 8CD5
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT HEX: 8CD6
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT HEX: 8CD7
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER HEX: 8CDB
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER HEX: 8CDC
+CONSTANT: GL_FRAMEBUFFER_UNSUPPORTED HEX: 8CDD
+CONSTANT: GL_MAX_COLOR_ATTACHMENTS HEX: 8CDF
+CONSTANT: GL_COLOR_ATTACHMENT0 HEX: 8CE0
+CONSTANT: GL_COLOR_ATTACHMENT1 HEX: 8CE1
+CONSTANT: GL_COLOR_ATTACHMENT2 HEX: 8CE2
+CONSTANT: GL_COLOR_ATTACHMENT3 HEX: 8CE3
+CONSTANT: GL_COLOR_ATTACHMENT4 HEX: 8CE4
+CONSTANT: GL_COLOR_ATTACHMENT5 HEX: 8CE5
+CONSTANT: GL_COLOR_ATTACHMENT6 HEX: 8CE6
+CONSTANT: GL_COLOR_ATTACHMENT7 HEX: 8CE7
+CONSTANT: GL_COLOR_ATTACHMENT8 HEX: 8CE8
+CONSTANT: GL_COLOR_ATTACHMENT9 HEX: 8CE9
+CONSTANT: GL_COLOR_ATTACHMENT10 HEX: 8CEA
+CONSTANT: GL_COLOR_ATTACHMENT11 HEX: 8CEB
+CONSTANT: GL_COLOR_ATTACHMENT12 HEX: 8CEC
+CONSTANT: GL_COLOR_ATTACHMENT13 HEX: 8CED
+CONSTANT: GL_COLOR_ATTACHMENT14 HEX: 8CEE
+CONSTANT: GL_COLOR_ATTACHMENT15 HEX: 8CEF
+CONSTANT: GL_DEPTH_ATTACHMENT HEX: 8D00
+CONSTANT: GL_STENCIL_ATTACHMENT HEX: 8D20
+CONSTANT: GL_FRAMEBUFFER HEX: 8D40
+CONSTANT: GL_RENDERBUFFER HEX: 8D41
+CONSTANT: GL_RENDERBUFFER_WIDTH HEX: 8D42
+CONSTANT: GL_RENDERBUFFER_HEIGHT HEX: 8D43
+CONSTANT: GL_RENDERBUFFER_INTERNAL_FORMAT HEX: 8D44
+CONSTANT: GL_STENCIL_INDEX1 HEX: 8D46
+CONSTANT: GL_STENCIL_INDEX4 HEX: 8D47
+CONSTANT: GL_STENCIL_INDEX8 HEX: 8D48
+CONSTANT: GL_STENCIL_INDEX16 HEX: 8D49
+CONSTANT: GL_RENDERBUFFER_RED_SIZE HEX: 8D50
+CONSTANT: GL_RENDERBUFFER_GREEN_SIZE HEX: 8D51
+CONSTANT: GL_RENDERBUFFER_BLUE_SIZE HEX: 8D52
+CONSTANT: GL_RENDERBUFFER_ALPHA_SIZE HEX: 8D53
+CONSTANT: GL_RENDERBUFFER_DEPTH_SIZE HEX: 8D54
+CONSTANT: GL_RENDERBUFFER_STENCIL_SIZE HEX: 8D55
+
+CONSTANT: GL_READ_FRAMEBUFFER HEX: 8CA8
+CONSTANT: GL_DRAW_FRAMEBUFFER HEX: 8CA9
+
+ALIAS: GL_DRAW_FRAMEBUFFER_BINDING GL_FRAMEBUFFER_BINDING
+CONSTANT: GL_READ_FRAMEBUFFER_BINDING HEX: 8CAA
+
+CONSTANT: GL_RENDERBUFFER_SAMPLES HEX: 8CAB
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE HEX: 8D56
+CONSTANT: GL_MAX_SAMPLES HEX: 8D57
+
+CONSTANT: GL_DEPTH_STENCIL HEX: 84F9
+CONSTANT: GL_UNSIGNED_INT_24_8 HEX: 84FA
+CONSTANT: GL_DEPTH24_STENCIL8 HEX: 88F0
+CONSTANT: GL_TEXTURE_STENCIL_SIZE HEX: 88F1
+
+CONSTANT: GL_RGBA32UI HEX: 8D70
+CONSTANT: GL_RGB32UI HEX: 8D71
+
+CONSTANT: GL_RGBA16UI HEX: 8D76
+CONSTANT: GL_RGB16UI HEX: 8D77
+
+CONSTANT: GL_RGBA8UI HEX: 8D7C
+CONSTANT: GL_RGB8UI HEX: 8D7D
+
+CONSTANT: GL_RGBA32I HEX: 8D82
+CONSTANT: GL_RGB32I HEX: 8D83
+
+CONSTANT: GL_RGBA16I HEX: 8D88
+CONSTANT: GL_RGB16I HEX: 8D89
+
+CONSTANT: GL_RGBA8I HEX: 8D8E
+CONSTANT: GL_RGB8I HEX: 8D8F
+
+CONSTANT: GL_RED_INTEGER HEX: 8D94
+CONSTANT: GL_GREEN_INTEGER HEX: 8D95
+CONSTANT: GL_BLUE_INTEGER HEX: 8D96
+CONSTANT: GL_RGB_INTEGER HEX: 8D98
+CONSTANT: GL_RGBA_INTEGER HEX: 8D99
+CONSTANT: GL_BGR_INTEGER HEX: 8D9A
+CONSTANT: GL_BGRA_INTEGER HEX: 8D9B
+
+CONSTANT: GL_FLOAT_32_UNSIGNED_INT_24_8_REV HEX: 8DAD
+
+CONSTANT: GL_TEXTURE_1D_ARRAY HEX: 8C18
+CONSTANT: GL_TEXTURE_2D_ARRAY HEX: 8C1A
+
+CONSTANT: GL_PROXY_TEXTURE_2D_ARRAY HEX: 8C1B
+
+CONSTANT: GL_PROXY_TEXTURE_1D_ARRAY HEX: 8C19
+
+CONSTANT: GL_TEXTURE_BINDING_1D_ARRAY HEX: 8C1C
+CONSTANT: GL_TEXTURE_BINDING_2D_ARRAY HEX: 8C1D
+CONSTANT: GL_MAX_ARRAY_TEXTURE_LAYERS HEX: 88FF
+
+CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER HEX: 8CD4
+
+CONSTANT: GL_SAMPLER_1D_ARRAY HEX: 8DC0
+CONSTANT: GL_SAMPLER_2D_ARRAY HEX: 8DC1
+CONSTANT: GL_SAMPLER_1D_ARRAY_SHADOW HEX: 8DC3
+CONSTANT: GL_SAMPLER_2D_ARRAY_SHADOW HEX: 8DC4
+
+CONSTANT: GL_COMPRESSED_RED_RGTC1 HEX: 8DBB
+CONSTANT: GL_COMPRESSED_SIGNED_RED_RGTC1 HEX: 8DBC
+CONSTANT: GL_COMPRESSED_RG_RGTC2 HEX: 8DBD
+CONSTANT: GL_COMPRESSED_SIGNED_RG_RGTC2 HEX: 8DBE
+
+CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER HEX: 8C8E
+CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_START HEX: 8C84
+CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_SIZE HEX: 8C85
+CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_BINDING HEX: 8C8F
+CONSTANT: GL_INTERLEAVED_ATTRIBS HEX: 8C8C
+CONSTANT: GL_SEPARATE_ATTRIBS HEX: 8C8D
+CONSTANT: GL_PRIMITIVES_GENERATED HEX: 8C87
+CONSTANT: GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN HEX: 8C88
+CONSTANT: GL_RASTERIZER_DISCARD HEX: 8C89
+CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS HEX: 8C8A
+CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS HEX: 8C8B
+CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS HEX: 8C80
+CONSTANT: GL_TRANSFORM_FEEDBACK_VARYINGS HEX: 8C83
+CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_MODE HEX: 8C7F
+CONSTANT: GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH HEX: 8C76
+
+CONSTANT: GL_FRAMEBUFFER_SRGB HEX: 8DB9
+
+CONSTANT: GL_MAJOR_VERSION HEX: 821B
+CONSTANT: GL_MINOR_VERSION HEX: 821C
+CONSTANT: GL_NUM_EXTENSIONS HEX: 821D
+CONSTANT: GL_CONTEXT_FLAGS HEX: 821E
+CONSTANT: GL_INDEX HEX: 8222
+CONSTANT: GL_DEPTH_BUFFER HEX: 8223
+CONSTANT: GL_STENCIL_BUFFER HEX: 8224
+CONSTANT: GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT HEX: 0001
+
+ALIAS: GL_COMPARE_REF_TO_TEXTURE GL_COMPARE_R_TO_TEXTURE
+ALIAS: GL_MAX_VARYING_COMPONENTS GL_MAX_VARYING_FLOATS
+ALIAS: GL_MAX_CLIP_DISTANCES GL_MAX_CLIP_PLANES
+ALIAS: GL_CLIP_DISTANCE0 GL_CLIP_PLANE0
+ALIAS: GL_CLIP_DISTANCE1 GL_CLIP_PLANE1
+ALIAS: GL_CLIP_DISTANCE2 GL_CLIP_PLANE2
+ALIAS: GL_CLIP_DISTANCE3 GL_CLIP_PLANE3
+ALIAS: GL_CLIP_DISTANCE4 GL_CLIP_PLANE4
+ALIAS: GL_CLIP_DISTANCE5 GL_CLIP_PLANE5
+
+GL-FUNCTION: void glVertexAttribIPointer { glVertexAttribIPointerEXT } ( GLuint index, GLint size, GLenum type, GLsizei stride, void* pointer ) ;
+
+GL-FUNCTION: void glGetVertexAttribIiv { glGetVertexAttribIivEXT } ( GLuint index, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetVertexAttribIuiv { glGetVertexAttribIuivEXT } ( GLuint index, GLenum pname, GLuint* params ) ;
+
+GL-FUNCTION: void glUniform1ui { glUniform1uiEXT } ( GLint location, GLuint v0 ) ;
+GL-FUNCTION: void glUniform2ui { glUniform2uiEXT } ( GLint location, GLuint v0, GLuint v1 ) ;
+GL-FUNCTION: void glUniform3ui { glUniform3uiEXT } ( GLint location, GLuint v0, GLuint v1, GLuint v2 ) ;
+GL-FUNCTION: void glUniform4ui { glUniform4uiEXT } ( GLint location, GLuint v0, GLuint v1, GLuint v2, GLuint v3 ) ;
+
+GL-FUNCTION: void glUniform1uiv { glUniform1uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
+GL-FUNCTION: void glUniform2uiv { glUniform2uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
+GL-FUNCTION: void glUniform3uiv { glUniform3uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
+GL-FUNCTION: void glUniform4uiv { glUniform4uivEXT } ( GLint location, GLsizei count, GLuint* value ) ;
+
+GL-FUNCTION: void glGetUniformuiv { glGetUniformuivEXT } ( GLuint program, GLint location, GLuint* params ) ;
+
+GL-FUNCTION: void glBindFragDataLocation { glBindFragDataLocationEXT } ( GLuint program, GLuint colorNumber, GLchar* name ) ;
+GL-FUNCTION: GLint glGetFragDataLocation { glGetFragDataLocationEXT } ( GLuint program, GLchar* name ) ;
+
+GL-FUNCTION: void glBeginConditionalRender { glBeginConditionalRenderNV } ( GLuint id, GLenum mode ) ;
+GL-FUNCTION: void glEndConditionalRender { glEndConditionalRenderNV } ( ) ;
+
+GL-FUNCTION: void glBindVertexArray { glBindVertexArrayAPPLE } ( GLuint array ) ;
+GL-FUNCTION: void glDeleteVertexArrays { glDeleteVertexArraysAPPLE } ( GLsizei n, GLuint* arrays ) ;
+GL-FUNCTION: void glGenVertexArrays { glGenVertexArraysAPPLE } ( GLsizei n, GLuint* arrays ) ;
+GL-FUNCTION: GLboolean glIsVertexArray { glIsVertexArrayAPPLE } ( GLuint array ) ;
+
+GL-FUNCTION: void glClampColor { glClampColorARB } ( GLenum target, GLenum clamp ) ;
+
+GL-FUNCTION: void glBindFramebuffer { glBindFramebufferEXT } ( GLenum target, GLuint framebuffer ) ;
+GL-FUNCTION: void glBindRenderbuffer { glBindRenderbufferEXT } ( GLenum target, GLuint renderbuffer ) ;
+GL-FUNCTION: GLenum glCheckFramebufferStatus { glCheckFramebufferStatusEXT } ( GLenum target ) ;
+GL-FUNCTION: void glDeleteFramebuffers { glDeleteFramebuffersEXT } ( GLsizei n, GLuint* framebuffers ) ;
+GL-FUNCTION: void glDeleteRenderbuffers { glDeleteRenderbuffersEXT } ( GLsizei n, GLuint* renderbuffers ) ;
+GL-FUNCTION: void glFramebufferRenderbuffer { glFramebufferRenderbufferEXT } ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
+GL-FUNCTION: void glFramebufferTexture1D { glFramebufferTexture1DEXT } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
+GL-FUNCTION: void glFramebufferTexture2D { glFramebufferTexture2DEXT } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
+GL-FUNCTION: void glFramebufferTexture3D { glFramebufferTexture3DEXT } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
+GL-FUNCTION: void glFramebufferTextureLayer { glFramebufferTextureLayerEXT }
+ ( GLenum target, GLenum attachment,
+ GLuint texture, GLint level, GLint layer ) ;
+GL-FUNCTION: void glGenFramebuffers { glGenFramebuffersEXT } ( GLsizei n, GLuint* framebuffers ) ;
+GL-FUNCTION: void glGenRenderbuffers { glGenRenderbuffersEXT } ( GLsizei n, GLuint* renderbuffers ) ;
+GL-FUNCTION: void glGenerateMipmap { glGenerateMipmapEXT } ( GLenum target ) ;
+GL-FUNCTION: void glGetFramebufferAttachmentParameteriv { glGetFramebufferAttachmentParameterivEXT } ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetRenderbufferParameteriv { glGetRenderbufferParameterivEXT } ( GLenum target, GLenum pname, GLint* params ) ;
+GL-FUNCTION: GLboolean glIsFramebuffer { glIsFramebufferEXT } ( GLuint framebuffer ) ;
+GL-FUNCTION: GLboolean glIsRenderbuffer { glIsRenderbufferEXT } ( GLuint renderbuffer ) ;
+GL-FUNCTION: void glRenderbufferStorage { glRenderbufferStorageEXT } ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
+
+GL-FUNCTION: void glBlitFramebuffer { glBlitFramebufferEXT }
+ ( GLint srcX0, GLint srcY0, GLint srcX1, GLint srcY1,
GLint dstX0, GLint dstY0, GLint dstX1, GLint dstY1,
GLbitfield mask, GLenum filter ) ;
-CONSTANT: GL_READ_FRAMEBUFFER_EXT HEX: 8CA8
-CONSTANT: GL_DRAW_FRAMEBUFFER_EXT HEX: 8CA9
-
-ALIAS: GL_DRAW_FRAMEBUFFER_BINDING_EXT GL_FRAMEBUFFER_BINDING_EXT
-CONSTANT: GL_READ_FRAMEBUFFER_BINDING_EXT HEX: 8CAA
-
-
-! GL_EXT_framebuffer_multisample
-
-
-GL-FUNCTION: void glRenderbufferStorageMultisampleEXT { } (
+GL-FUNCTION: void glRenderbufferStorageMultisample { glRenderbufferStorageMultisampleEXT } (
GLenum target, GLsizei samples,
GLenum internalformat,
GLsizei width, GLsizei height ) ;
-CONSTANT: GL_RENDERBUFFER_SAMPLES_EXT HEX: 8CAB
-CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT HEX: 8D56
-CONSTANT: GL_MAX_SAMPLES_EXT HEX: 8D57
+GL-FUNCTION: void glTexParameterIiv { glTexParameterIivEXT } ( GLenum target, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glTexParameterIuiv { glTexParameterIuivEXT } ( GLenum target, GLenum pname, GLuint* params ) ;
+GL-FUNCTION: void glGetTexParameterIiv { glGetTexParameterIivEXT } ( GLenum target, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetTexParameterIuiv { glGetTexParameterIuivEXT } ( GLenum target, GLenum pname, GLuint* params ) ;
+GL-FUNCTION: void glColorMaski { glColorMaskIndexedEXT }
+ ( GLuint buf, GLboolean r, GLboolean g, GLboolean b, GLboolean a ) ;
-! GL_ARB_half_float_pixel, GL_ARB_half_float_vertex
+GL-FUNCTION: void glGetBooleani_v { glGetBooleanIndexedvEXT } ( GLenum value, GLuint index, GLboolean* data ) ;
+GL-FUNCTION: void glGetIntegeri_v { glGetIntegerIndexedvEXT } ( GLenum value, GLuint index, GLint* data ) ;
-CONSTANT: GL_HALF_FLOAT_ARB HEX: 140B
+GL-FUNCTION: void glEnablei { glEnableIndexedEXT } ( GLenum target, GLuint index ) ;
+GL-FUNCTION: void glDisablei { glDisableIndexedEXT } ( GLenum target, GLuint index ) ;
-! GL_ARB_texture_float
+GL-FUNCTION: GLboolean glIsEnabledi { glIsEnabledIndexedEXT } ( GLenum target, GLuint index ) ;
+GL-FUNCTION: void glBindBufferRange { glBindBufferRangeEXT } ( GLenum target, GLuint index, GLuint buffer,
+ GLintptr offset, GLsizeiptr size ) ;
+GL-FUNCTION: void glBindBufferBase { glBindBufferBaseEXT } ( GLenum target, GLuint index, GLuint buffer ) ;
-CONSTANT: GL_RGBA32F_ARB HEX: 8814
-CONSTANT: GL_RGB32F_ARB HEX: 8815
-CONSTANT: GL_ALPHA32F_ARB HEX: 8816
-CONSTANT: GL_INTENSITY32F_ARB HEX: 8817
-CONSTANT: GL_LUMINANCE32F_ARB HEX: 8818
-CONSTANT: GL_LUMINANCE_ALPHA32F_ARB HEX: 8819
-CONSTANT: GL_RGBA16F_ARB HEX: 881A
-CONSTANT: GL_RGB16F_ARB HEX: 881B
-CONSTANT: GL_ALPHA16F_ARB HEX: 881C
-CONSTANT: GL_INTENSITY16F_ARB HEX: 881D
-CONSTANT: GL_LUMINANCE16F_ARB HEX: 881E
-CONSTANT: GL_LUMINANCE_ALPHA16F_ARB HEX: 881F
-CONSTANT: GL_TEXTURE_RED_TYPE_ARB HEX: 8C10
-CONSTANT: GL_TEXTURE_GREEN_TYPE_ARB HEX: 8C11
-CONSTANT: GL_TEXTURE_BLUE_TYPE_ARB HEX: 8C12
-CONSTANT: GL_TEXTURE_ALPHA_TYPE_ARB HEX: 8C13
-CONSTANT: GL_TEXTURE_LUMINANCE_TYPE_ARB HEX: 8C14
-CONSTANT: GL_TEXTURE_INTENSITY_TYPE_ARB HEX: 8C15
-CONSTANT: GL_TEXTURE_DEPTH_TYPE_ARB HEX: 8C16
-CONSTANT: GL_UNSIGNED_NORMALIZED_ARB HEX: 8C17
-
-
-! GL_EXT_gpu_shader4
-
-
-GL-FUNCTION: void glVertexAttribI1iEXT { } ( GLuint index, GLint x ) ;
-GL-FUNCTION: void glVertexAttribI2iEXT { } ( GLuint index, GLint x, GLint y ) ;
-GL-FUNCTION: void glVertexAttribI3iEXT { } ( GLuint index, GLint x, GLint y, GLint z ) ;
-GL-FUNCTION: void glVertexAttribI4iEXT { } ( GLuint index, GLint x, GLint y, GLint z, GLint w ) ;
-
-GL-FUNCTION: void glVertexAttribI1uiEXT { } ( GLuint index, GLuint x ) ;
-GL-FUNCTION: void glVertexAttribI2uiEXT { } ( GLuint index, GLuint x, GLuint y ) ;
-GL-FUNCTION: void glVertexAttribI3uiEXT { } ( GLuint index, GLuint x, GLuint y, GLuint z ) ;
-GL-FUNCTION: void glVertexAttribI4uiEXT { } ( GLuint index, GLuint x, GLuint y, GLuint z, GLuint w ) ;
-
-GL-FUNCTION: void glVertexAttribI1ivEXT { } ( GLuint index, GLint* v ) ;
-GL-FUNCTION: void glVertexAttribI2ivEXT { } ( GLuint index, GLint* v ) ;
-GL-FUNCTION: void glVertexAttribI3ivEXT { } ( GLuint index, GLint* v ) ;
-GL-FUNCTION: void glVertexAttribI4ivEXT { } ( GLuint index, GLint* v ) ;
-
-GL-FUNCTION: void glVertexAttribI1uivEXT { } ( GLuint index, GLuint* v ) ;
-GL-FUNCTION: void glVertexAttribI2uivEXT { } ( GLuint index, GLuint* v ) ;
-GL-FUNCTION: void glVertexAttribI3uivEXT { } ( GLuint index, GLuint* v ) ;
-GL-FUNCTION: void glVertexAttribI4uivEXT { } ( GLuint index, GLuint* v ) ;
-
-GL-FUNCTION: void glVertexAttribI4bvEXT { } ( GLuint index, GLbyte* v ) ;
-GL-FUNCTION: void glVertexAttribI4svEXT { } ( GLuint index, GLshort* v ) ;
-GL-FUNCTION: void glVertexAttribI4ubvEXT { } ( GLuint index, GLubyte* v ) ;
-GL-FUNCTION: void glVertexAttribI4usvEXT { } ( GLuint index, GLushort* v ) ;
-
-GL-FUNCTION: void glVertexAttribIPointerEXT { } ( GLuint index, GLint size, GLenum type, GLsizei stride, void* pointer ) ;
-
-GL-FUNCTION: void glGetVertexAttribIivEXT { } ( GLuint index, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetVertexAttribIuivEXT { } ( GLuint index, GLenum pname, GLuint* params ) ;
-
-GL-FUNCTION: void glUniform1uiEXT { } ( GLint location, GLuint v0 ) ;
-GL-FUNCTION: void glUniform2uiEXT { } ( GLint location, GLuint v0, GLuint v1 ) ;
-GL-FUNCTION: void glUniform3uiEXT { } ( GLint location, GLuint v0, GLuint v1, GLuint v2 ) ;
-GL-FUNCTION: void glUniform4uiEXT { } ( GLint location, GLuint v0, GLuint v1, GLuint v2, GLuint v3 ) ;
-
-GL-FUNCTION: void glUniform1uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
-GL-FUNCTION: void glUniform2uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
-GL-FUNCTION: void glUniform3uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
-GL-FUNCTION: void glUniform4uivEXT { } ( GLint location, GLsizei count, GLuint* value ) ;
-
-GL-FUNCTION: void glGetUniformuivEXT { } ( GLuint program, GLint location, GLuint* params ) ;
-
-GL-FUNCTION: void glBindFragDataLocationEXT { } ( GLuint program, GLuint colorNumber, GLchar* name ) ;
-GL-FUNCTION: GLint glGetFragDataLocationEXT { } ( GLuint program, GLchar* name ) ;
-
-CONSTANT: GL_VERTEX_ATTRIB_ARRAY_INTEGER_EXT HEX: 88FD
-CONSTANT: GL_SAMPLER_1D_ARRAY_EXT HEX: 8DC0
-CONSTANT: GL_SAMPLER_2D_ARRAY_EXT HEX: 8DC1
-CONSTANT: GL_SAMPLER_BUFFER_EXT HEX: 8DC2
-CONSTANT: GL_SAMPLER_1D_ARRAY_SHADOW_EXT HEX: 8DC3
-CONSTANT: GL_SAMPLER_2D_ARRAY_SHADOW_EXT HEX: 8DC4
-CONSTANT: GL_SAMPLER_CUBE_SHADOW_EXT HEX: 8DC5
-CONSTANT: GL_UNSIGNED_INT_VEC2_EXT HEX: 8DC6
-CONSTANT: GL_UNSIGNED_INT_VEC3_EXT HEX: 8DC7
-CONSTANT: GL_UNSIGNED_INT_VEC4_EXT HEX: 8DC8
-CONSTANT: GL_INT_SAMPLER_1D_EXT HEX: 8DC9
-CONSTANT: GL_INT_SAMPLER_2D_EXT HEX: 8DCA
-CONSTANT: GL_INT_SAMPLER_3D_EXT HEX: 8DCB
-CONSTANT: GL_INT_SAMPLER_CUBE_EXT HEX: 8DCC
-CONSTANT: GL_INT_SAMPLER_2D_RECT_EXT HEX: 8DCD
-CONSTANT: GL_INT_SAMPLER_1D_ARRAY_EXT HEX: 8DCE
-CONSTANT: GL_INT_SAMPLER_2D_ARRAY_EXT HEX: 8DCF
-CONSTANT: GL_INT_SAMPLER_BUFFER_EXT HEX: 8DD0
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D_EXT HEX: 8DD1
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_EXT HEX: 8DD2
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_3D_EXT HEX: 8DD3
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_CUBE_EXT HEX: 8DD4
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_RECT_EXT HEX: 8DD5
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_1D_ARRAY_EXT HEX: 8DD6
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_2D_ARRAY_EXT HEX: 8DD7
-CONSTANT: GL_UNSIGNED_INT_SAMPLER_BUFFER_EXT HEX: 8DD8
-CONSTANT: GL_MIN_PROGRAM_TEXEL_OFFSET_EXT HEX: 8904
-CONSTANT: GL_MAX_PROGRAM_TEXEL_OFFSET_EXT HEX: 8905
+GL-FUNCTION: void glBeginTransformFeedback { glBeginTransformFeedbackEXT } ( GLenum primitiveMode ) ;
+GL-FUNCTION: void glEndTransformFeedback { glEndTransformFeedbackEXT } ( ) ;
+
+GL-FUNCTION: void glTransformFeedbackVaryings { glTransformFeedbackVaryingsEXT } ( GLuint program, GLsizei count,
+ GLchar** varyings, GLenum bufferMode ) ;
+GL-FUNCTION: void glGetTransformFeedbackVarying { glGetTransformFeedbackVaryingEXT } ( GLuint program, GLuint index,
+ GLsizei bufSize, GLsizei* length,
+ GLsizei* size, GLenum* type, GLchar* name ) ;
+
+GL-FUNCTION: void glClearBufferiv { } ( GLenum buffer, GLint drawbuffer, GLint* value ) ;
+GL-FUNCTION: void glClearBufferuiv { } ( GLenum buffer, GLint drawbuffer, GLuint* value ) ;
+GL-FUNCTION: void glClearBufferfv { } ( GLenum buffer, GLint drawbuffer, GLfloat* value ) ;
+GL-FUNCTION: void glClearBufferfi { } ( GLenum buffer, GLint drawbuffer, GLfloat depth, GLint stencil ) ;
+
+GL-FUNCTION: GLubyte* glGetStringi { } ( GLenum value, GLuint index ) ;
+
+GL-FUNCTION: GLvoid* glMapBufferRange { } ( GLenum target, GLintptr offset, GLsizeiptr length, GLbitfield access ) ;
+GL-FUNCTION: void glFlushMappedBufferRange { glFlushMappedBufferRangeAPPLE } ( GLenum target, GLintptr offset, GLsizeiptr size ) ;
+
+
+! OpenGL 3.1
+
+CONSTANT: GL_RED_SNORM HEX: 8F90
+CONSTANT: GL_RG_SNORM HEX: 8F91
+CONSTANT: GL_RGB_SNORM HEX: 8F92
+CONSTANT: GL_RGBA_SNORM HEX: 8F93
+CONSTANT: GL_R8_SNORM HEX: 8F94
+CONSTANT: GL_RG8_SNORM HEX: 8F95
+CONSTANT: GL_RGB8_SNORM HEX: 8F96
+CONSTANT: GL_RGBA8_SNORM HEX: 8F97
+CONSTANT: GL_R16_SNORM HEX: 8F98
+CONSTANT: GL_RG16_SNORM HEX: 8F99
+CONSTANT: GL_RGB16_SNORM HEX: 8F9A
+CONSTANT: GL_RGBA16_SNORM HEX: 8F9B
+CONSTANT: GL_SIGNED_NORMALIZED HEX: 8F9C
+
+CONSTANT: GL_PRIMITIVE_RESTART HEX: 8F9D
+CONSTANT: GL_PRIMITIVE_RESTART_INDEX HEX: 8F9E
+
+CONSTANT: GL_COPY_READ_BUFFER HEX: 8F36
+CONSTANT: GL_COPY_WRITE_BUFFER HEX: 8F37
+
+CONSTANT: GL_UNIFORM_BUFFER HEX: 8A11
+CONSTANT: GL_UNIFORM_BUFFER_BINDING HEX: 8A28
+CONSTANT: GL_UNIFORM_BUFFER_START HEX: 8A29
+CONSTANT: GL_UNIFORM_BUFFER_SIZE HEX: 8A2A
+CONSTANT: GL_MAX_VERTEX_UNIFORM_BLOCKS HEX: 8A2B
+CONSTANT: GL_MAX_GEOMETRY_UNIFORM_BLOCKS HEX: 8A2C
+CONSTANT: GL_MAX_FRAGMENT_UNIFORM_BLOCKS HEX: 8A2D
+CONSTANT: GL_MAX_COMBINED_UNIFORM_BLOCKS HEX: 8A2E
+CONSTANT: GL_MAX_UNIFORM_BUFFER_BINDINGS HEX: 8A2F
+CONSTANT: GL_MAX_UNIFORM_BLOCK_SIZE HEX: 8A30
+CONSTANT: GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS HEX: 8A31
+CONSTANT: GL_MAX_COMBINED_GEOMETRY_UNIFORM_COMPONENTS HEX: 8A32
+CONSTANT: GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS HEX: 8A33
+CONSTANT: GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT HEX: 8A34
+CONSTANT: GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH HEX: 8A35
+CONSTANT: GL_ACTIVE_UNIFORM_BLOCKS HEX: 8A36
+CONSTANT: GL_UNIFORM_TYPE HEX: 8A37
+CONSTANT: GL_UNIFORM_SIZE HEX: 8A38
+CONSTANT: GL_UNIFORM_NAME_LENGTH HEX: 8A39
+CONSTANT: GL_UNIFORM_BLOCK_INDEX HEX: 8A3A
+CONSTANT: GL_UNIFORM_OFFSET HEX: 8A3B
+CONSTANT: GL_UNIFORM_ARRAY_STRIDE HEX: 8A3C
+CONSTANT: GL_UNIFORM_MATRIX_STRIDE HEX: 8A3D
+CONSTANT: GL_UNIFORM_IS_ROW_MAJOR HEX: 8A3E
+CONSTANT: GL_UNIFORM_BLOCK_BINDING HEX: 8A3F
+CONSTANT: GL_UNIFORM_BLOCK_DATA_SIZE HEX: 8A40
+CONSTANT: GL_UNIFORM_BLOCK_NAME_LENGTH HEX: 8A41
+CONSTANT: GL_UNIFORM_BLOCK_ACTIVE_UNIFORMS HEX: 8A42
+CONSTANT: GL_UNIFORM_BLOCK_ACTIVE_UNIFORM_INDICES HEX: 8A43
+CONSTANT: GL_UNIFORM_BLOCK_REFERENCED_BY_VERTEX_SHADER HEX: 8A44
+CONSTANT: GL_UNIFORM_BLOCK_REFERENCED_BY_GEOMETRY_SHADER HEX: 8A45
+CONSTANT: GL_UNIFORM_BLOCK_REFERENCED_BY_FRAGMENT_SHADER HEX: 8A46
+CONSTANT: GL_INVALID_INDEX HEX: FFFFFFFF
+
+CONSTANT: GL_TEXTURE_RECTANGLE HEX: 84F5
+CONSTANT: GL_TEXTURE_BINDING_RECTANGLE HEX: 84F6
+CONSTANT: GL_PROXY_TEXTURE_RECTANGLE HEX: 84F7
+CONSTANT: GL_MAX_RECTANGLE_TEXTURE_SIZE HEX: 84F8
+CONSTANT: GL_SAMPLER_2D_RECT HEX: 8B63
+CONSTANT: GL_SAMPLER_2D_RECT_SHADOW HEX: 8B64
+
+CONSTANT: GL_SAMPLER_BUFFER HEX: 8DC2
+CONSTANT: GL_INT_SAMPLER_BUFFER HEX: 8DD0
+CONSTANT: GL_UNSIGNED_INT_SAMPLER_BUFFER HEX: 8DD8
+
+CONSTANT: GL_TEXTURE_BUFFER HEX: 8C2A
+
+CONSTANT: GL_MAX_TEXTURE_BUFFER_SIZE HEX: 8C2B
+CONSTANT: GL_TEXTURE_BINDING_BUFFER HEX: 8C2C
+CONSTANT: GL_TEXTURE_BUFFER_DATA_STORE_BINDING HEX: 8C2D
+CONSTANT: GL_TEXTURE_BUFFER_FORMAT HEX: 8C2E
+
+GL-FUNCTION: void glDrawArraysInstanced { glDrawArraysInstancedARB } ( GLenum mode, GLint first, GLsizei count, GLsizei primcount ) ;
+GL-FUNCTION: void glDrawElementsInstanced { glDrawElementsInstancedARB } ( GLenum mode, GLsizei count, GLenum type, GLvoid* indices, GLsizei primcount ) ;
+GL-FUNCTION: void glTexBuffer { glTexBufferEXT } ( GLenum target, GLenum internalformat, GLuint buffer ) ;
+GL-FUNCTION: void glPrimitiveRestartIndex { } ( GLuint index ) ;
+
+GL-FUNCTION: void glGetUniformIndices { } ( GLuint program, GLsizei uniformCount, GLchar** uniformNames, GLuint* uniformIndices ) ;
+GL-FUNCTION: void glGetActiveUniformsiv { } ( GLuint program, GLsizei uniformCount, GLuint* uniformIndices, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetActiveUniformName { } ( GLuint program, GLuint uniformIndex, GLsizei bufSize, GLsizei* length, GLchar* uniformName ) ;
+GL-FUNCTION: GLuint glGetUniformBlockIndex { } ( GLuint program, GLchar* uniformBlockName ) ;
+GL-FUNCTION: void glGetActiveUniformBlockiv { } ( GLuint program, GLuint uniformBlockIndex, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetActiveUniformBlockName { } ( GLuint program, GLuint uniformBlockIndex, GLsizei bufSize, GLsizei* length, GLchar* uniformName ) ;
+GL-FUNCTION: void glUniformBlockBinding { } ( GLuint buffer, GLuint uniformBlockIndex, GLuint uniformBlockBinding ) ;
+
+GL-FUNCTION: void glCopyBufferSubData { glCopyBufferSubDataEXT } ( GLenum readtarget, GLenum writetarget, GLintptr readoffset, GLintptr writeoffset, GLsizeiptr size ) ;
! GL_EXT_geometry_shader4
GL-FUNCTION: void glProgramParameteriEXT { } ( GLuint program, GLenum pname, GLint value ) ;
GL-FUNCTION: void glFramebufferTextureEXT { } ( GLenum target, GLenum attachment,
GLuint texture, GLint level ) ;
-GL-FUNCTION: void glFramebufferTextureLayerEXT { } ( GLenum target, GLenum attachment,
- GLuint texture, GLint level, GLint layer ) ;
-GL-FUNCTION: void glFramebufferTextureFaceEXT { } ( GLenum target, GLenum attachment,
- GLuint texture, GLint level, GLenum face ) ;
CONSTANT: GL_GEOMETRY_SHADER_EXT HEX: 8DD9
CONSTANT: GL_GEOMETRY_VERTICES_OUT_EXT HEX: 8DDA
CONSTANT: GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS_EXT HEX: 8C29
CONSTANT: GL_MAX_GEOMETRY_VARYING_COMPONENTS_EXT HEX: 8DDD
CONSTANT: GL_MAX_VERTEX_VARYING_COMPONENTS_EXT HEX: 8DDE
-CONSTANT: GL_MAX_VARYING_COMPONENTS_EXT HEX: 8B4B
CONSTANT: GL_MAX_GEOMETRY_UNIFORM_COMPONENTS_EXT HEX: 8DDF
CONSTANT: GL_MAX_GEOMETRY_OUTPUT_VERTICES_EXT HEX: 8DE0
CONSTANT: GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS_EXT HEX: 8DE1
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS_EXT HEX: 8DA8
CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_EXT HEX: 8DA9
CONSTANT: GL_FRAMEBUFFER_ATTACHMENT_LAYERED_EXT HEX: 8DA7
-ALIAS: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER_EXT GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT
CONSTANT: GL_PROGRAM_POINT_SIZE_EXT HEX: 8642
-! GL_EXT_texture_integer
+! GL_EXT_framebuffer_object
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT HEX: 8CD9
+CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT HEX: 8CDA
-GL-FUNCTION: void glClearColorIiEXT { } ( GLint r, GLint g, GLint b, GLint a ) ;
-GL-FUNCTION: void glClearColorIuiEXT { } ( GLuint r, GLuint g, GLuint b, GLuint a ) ;
-GL-FUNCTION: void glTexParameterIivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glTexParameterIuivEXT { } ( GLenum target, GLenum pname, GLuint* params ) ;
-GL-FUNCTION: void glGetTexParameterIivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetTexParameterIuivEXT { } ( GLenum target, GLenum pname, GLuint* params ) ;
+! GL_ARB_texture_float
-CONSTANT: GL_RGBA_INTEGER_MODE_EXT HEX: 8D9E
+CONSTANT: GL_ALPHA32F_ARB HEX: 8816
+CONSTANT: GL_INTENSITY32F_ARB HEX: 8817
+CONSTANT: GL_LUMINANCE32F_ARB HEX: 8818
+CONSTANT: GL_LUMINANCE_ALPHA32F_ARB HEX: 8819
+CONSTANT: GL_ALPHA16F_ARB HEX: 881C
+CONSTANT: GL_INTENSITY16F_ARB HEX: 881D
+CONSTANT: GL_LUMINANCE16F_ARB HEX: 881E
+CONSTANT: GL_LUMINANCE_ALPHA16F_ARB HEX: 881F
+CONSTANT: GL_TEXTURE_LUMINANCE_TYPE_ARB HEX: 8C14
+CONSTANT: GL_TEXTURE_INTENSITY_TYPE_ARB HEX: 8C15
+
+! GL_EXT_texture_integer
-CONSTANT: GL_RGBA32UI_EXT HEX: 8D70
-CONSTANT: GL_RGB32UI_EXT HEX: 8D71
CONSTANT: GL_ALPHA32UI_EXT HEX: 8D72
CONSTANT: GL_INTENSITY32UI_EXT HEX: 8D73
CONSTANT: GL_LUMINANCE32UI_EXT HEX: 8D74
CONSTANT: GL_LUMINANCE_ALPHA32UI_EXT HEX: 8D75
-CONSTANT: GL_RGBA16UI_EXT HEX: 8D76
-CONSTANT: GL_RGB16UI_EXT HEX: 8D77
CONSTANT: GL_ALPHA16UI_EXT HEX: 8D78
CONSTANT: GL_INTENSITY16UI_EXT HEX: 8D79
CONSTANT: GL_LUMINANCE16UI_EXT HEX: 8D7A
CONSTANT: GL_LUMINANCE_ALPHA16UI_EXT HEX: 8D7B
-CONSTANT: GL_RGBA8UI_EXT HEX: 8D7C
-CONSTANT: GL_RGB8UI_EXT HEX: 8D7D
CONSTANT: GL_ALPHA8UI_EXT HEX: 8D7E
CONSTANT: GL_INTENSITY8UI_EXT HEX: 8D7F
CONSTANT: GL_LUMINANCE8UI_EXT HEX: 8D80
CONSTANT: GL_LUMINANCE_ALPHA8UI_EXT HEX: 8D81
-CONSTANT: GL_RGBA32I_EXT HEX: 8D82
-CONSTANT: GL_RGB32I_EXT HEX: 8D83
CONSTANT: GL_ALPHA32I_EXT HEX: 8D84
CONSTANT: GL_INTENSITY32I_EXT HEX: 8D85
CONSTANT: GL_LUMINANCE32I_EXT HEX: 8D86
CONSTANT: GL_LUMINANCE_ALPHA32I_EXT HEX: 8D87
-CONSTANT: GL_RGBA16I_EXT HEX: 8D88
-CONSTANT: GL_RGB16I_EXT HEX: 8D89
CONSTANT: GL_ALPHA16I_EXT HEX: 8D8A
CONSTANT: GL_INTENSITY16I_EXT HEX: 8D8B
CONSTANT: GL_LUMINANCE16I_EXT HEX: 8D8C
CONSTANT: GL_LUMINANCE_ALPHA16I_EXT HEX: 8D8D
-CONSTANT: GL_RGBA8I_EXT HEX: 8D8E
-CONSTANT: GL_RGB8I_EXT HEX: 8D8F
CONSTANT: GL_ALPHA8I_EXT HEX: 8D90
CONSTANT: GL_INTENSITY8I_EXT HEX: 8D91
CONSTANT: GL_LUMINANCE8I_EXT HEX: 8D92
CONSTANT: GL_LUMINANCE_ALPHA8I_EXT HEX: 8D93
-CONSTANT: GL_RED_INTEGER_EXT HEX: 8D94
-CONSTANT: GL_GREEN_INTEGER_EXT HEX: 8D95
-CONSTANT: GL_BLUE_INTEGER_EXT HEX: 8D96
CONSTANT: GL_ALPHA_INTEGER_EXT HEX: 8D97
-CONSTANT: GL_RGB_INTEGER_EXT HEX: 8D98
-CONSTANT: GL_RGBA_INTEGER_EXT HEX: 8D99
-CONSTANT: GL_BGR_INTEGER_EXT HEX: 8D9A
-CONSTANT: GL_BGRA_INTEGER_EXT HEX: 8D9B
-CONSTANT: GL_LUMINANCE_INTEGER_EXT HEX: 8D9C
-CONSTANT: GL_LUMINANCE_ALPHA_INTEGER_EXT HEX: 8D9D
-
-
-! GL_EXT_transform_feedback
-
-
-GL-FUNCTION: void glBindBufferRangeEXT { } ( GLenum target, GLuint index, GLuint buffer,
- GLintptr offset, GLsizeiptr size ) ;
-GL-FUNCTION: void glBindBufferOffsetEXT { } ( GLenum target, GLuint index, GLuint buffer,
- GLintptr offset ) ;
-GL-FUNCTION: void glBindBufferBaseEXT { } ( GLenum target, GLuint index, GLuint buffer ) ;
+CONSTANT: GL_LUMINANCE_INTEGER_EXT HEX: 8D9C
+CONSTANT: GL_LUMINANCE_ALPHA_INTEGER_EXT HEX: 8D9D
-GL-FUNCTION: void glBeginTransformFeedbackEXT { } ( GLenum primitiveMode ) ;
-GL-FUNCTION: void glEndTransformFeedbackEXT { } ( ) ;
-
-GL-FUNCTION: void glTransformFeedbackVaryingsEXT { } ( GLuint program, GLsizei count,
- GLchar** varyings, GLenum bufferMode ) ;
-GL-FUNCTION: void glGetTransformFeedbackVaryingEXT { } ( GLuint program, GLuint index,
- GLsizei bufSize, GLsizei* length,
- GLsizei* size, GLenum* type, GLchar* name ) ;
-
-GL-FUNCTION: void glGetIntegerIndexedvEXT { } ( GLenum param, GLuint index, GLint* values ) ;
-GL-FUNCTION: void glGetBooleanIndexedvEXT { } ( GLenum param, GLuint index, GLboolean* values ) ;
-
-CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_EXT HEX: 8C8E
-CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_START_EXT HEX: 8C84
-CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_SIZE_EXT HEX: 8C85
-CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_BINDING_EXT HEX: 8C8F
-CONSTANT: GL_INTERLEAVED_ATTRIBS_EXT HEX: 8C8C
-CONSTANT: GL_SEPARATE_ATTRIBS_EXT HEX: 8C8D
-CONSTANT: GL_PRIMITIVES_GENERATED_EXT HEX: 8C87
-CONSTANT: GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN_EXT HEX: 8C88
-CONSTANT: GL_RASTERIZER_DISCARD_EXT HEX: 8C89
-CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS_EXT HEX: 8C8A
-CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS_EXT HEX: 8C8B
-CONSTANT: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS_EXT HEX: 8C80
-CONSTANT: GL_TRANSFORM_FEEDBACK_VARYINGS_EXT HEX: 8C83
-CONSTANT: GL_TRANSFORM_FEEDBACK_BUFFER_MODE_EXT HEX: 8C7F
-CONSTANT: GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH_EXT HEX: 8C76
+GL-FUNCTION: void glClearColorIiEXT { } ( GLint r, GLint g, GLint b, GLint a ) ;
+GL-FUNCTION: void glClearColorIuiEXT { } ( GLuint r, GLuint g, GLuint b, GLuint a ) ;
--- /dev/null
+! (c)2009 Joe Groff bsd license
+! This vocab only exports forward-compatible OpenGL 3.x symbols.
+! For legacy OpenGL and extensions, use opengl.gl
+
+QUALIFIED-WITH: opengl.gl gl
+IN: opengl.gl3
+
+ALIAS: GL_DEPTH_BUFFER_BIT gl:GL_DEPTH_BUFFER_BIT
+ALIAS: GL_STENCIL_BUFFER_BIT gl:GL_STENCIL_BUFFER_BIT
+ALIAS: GL_COLOR_BUFFER_BIT gl:GL_COLOR_BUFFER_BIT
+ALIAS: GL_FALSE gl:GL_FALSE
+ALIAS: GL_TRUE gl:GL_TRUE
+ALIAS: GL_POINTS gl:GL_POINTS
+ALIAS: GL_LINES gl:GL_LINES
+ALIAS: GL_LINE_LOOP gl:GL_LINE_LOOP
+ALIAS: GL_LINE_STRIP gl:GL_LINE_STRIP
+ALIAS: GL_TRIANGLES gl:GL_TRIANGLES
+ALIAS: GL_TRIANGLE_STRIP gl:GL_TRIANGLE_STRIP
+ALIAS: GL_TRIANGLE_FAN gl:GL_TRIANGLE_FAN
+ALIAS: GL_NEVER gl:GL_NEVER
+ALIAS: GL_LESS gl:GL_LESS
+ALIAS: GL_EQUAL gl:GL_EQUAL
+ALIAS: GL_LEQUAL gl:GL_LEQUAL
+ALIAS: GL_GREATER gl:GL_GREATER
+ALIAS: GL_NOTEQUAL gl:GL_NOTEQUAL
+ALIAS: GL_GEQUAL gl:GL_GEQUAL
+ALIAS: GL_ALWAYS gl:GL_ALWAYS
+ALIAS: GL_ZERO gl:GL_ZERO
+ALIAS: GL_ONE gl:GL_ONE
+ALIAS: GL_SRC_COLOR gl:GL_SRC_COLOR
+ALIAS: GL_ONE_MINUS_SRC_COLOR gl:GL_ONE_MINUS_SRC_COLOR
+ALIAS: GL_SRC_ALPHA gl:GL_SRC_ALPHA
+ALIAS: GL_ONE_MINUS_SRC_ALPHA gl:GL_ONE_MINUS_SRC_ALPHA
+ALIAS: GL_DST_ALPHA gl:GL_DST_ALPHA
+ALIAS: GL_ONE_MINUS_DST_ALPHA gl:GL_ONE_MINUS_DST_ALPHA
+ALIAS: GL_DST_COLOR gl:GL_DST_COLOR
+ALIAS: GL_ONE_MINUS_DST_COLOR gl:GL_ONE_MINUS_DST_COLOR
+ALIAS: GL_SRC_ALPHA_SATURATE gl:GL_SRC_ALPHA_SATURATE
+ALIAS: GL_NONE gl:GL_NONE
+ALIAS: GL_FRONT_LEFT gl:GL_FRONT_LEFT
+ALIAS: GL_FRONT_RIGHT gl:GL_FRONT_RIGHT
+ALIAS: GL_BACK_LEFT gl:GL_BACK_LEFT
+ALIAS: GL_BACK_RIGHT gl:GL_BACK_RIGHT
+ALIAS: GL_FRONT gl:GL_FRONT
+ALIAS: GL_BACK gl:GL_BACK
+ALIAS: GL_LEFT gl:GL_LEFT
+ALIAS: GL_RIGHT gl:GL_RIGHT
+ALIAS: GL_FRONT_AND_BACK gl:GL_FRONT_AND_BACK
+ALIAS: GL_NO_ERROR gl:GL_NO_ERROR
+ALIAS: GL_INVALID_ENUM gl:GL_INVALID_ENUM
+ALIAS: GL_INVALID_VALUE gl:GL_INVALID_VALUE
+ALIAS: GL_INVALID_OPERATION gl:GL_INVALID_OPERATION
+ALIAS: GL_OUT_OF_MEMORY gl:GL_OUT_OF_MEMORY
+ALIAS: GL_CW gl:GL_CW
+ALIAS: GL_CCW gl:GL_CCW
+ALIAS: GL_POINT_SIZE gl:GL_POINT_SIZE
+ALIAS: GL_POINT_SIZE_RANGE gl:GL_POINT_SIZE_RANGE
+ALIAS: GL_POINT_SIZE_GRANULARITY gl:GL_POINT_SIZE_GRANULARITY
+ALIAS: GL_LINE_SMOOTH gl:GL_LINE_SMOOTH
+ALIAS: GL_LINE_WIDTH gl:GL_LINE_WIDTH
+ALIAS: GL_LINE_WIDTH_RANGE gl:GL_LINE_WIDTH_RANGE
+ALIAS: GL_LINE_WIDTH_GRANULARITY gl:GL_LINE_WIDTH_GRANULARITY
+ALIAS: GL_POLYGON_SMOOTH gl:GL_POLYGON_SMOOTH
+ALIAS: GL_CULL_FACE gl:GL_CULL_FACE
+ALIAS: GL_CULL_FACE_MODE gl:GL_CULL_FACE_MODE
+ALIAS: GL_FRONT_FACE gl:GL_FRONT_FACE
+ALIAS: GL_DEPTH_RANGE gl:GL_DEPTH_RANGE
+ALIAS: GL_DEPTH_TEST gl:GL_DEPTH_TEST
+ALIAS: GL_DEPTH_WRITEMASK gl:GL_DEPTH_WRITEMASK
+ALIAS: GL_DEPTH_CLEAR_VALUE gl:GL_DEPTH_CLEAR_VALUE
+ALIAS: GL_DEPTH_FUNC gl:GL_DEPTH_FUNC
+ALIAS: GL_STENCIL_TEST gl:GL_STENCIL_TEST
+ALIAS: GL_STENCIL_CLEAR_VALUE gl:GL_STENCIL_CLEAR_VALUE
+ALIAS: GL_STENCIL_FUNC gl:GL_STENCIL_FUNC
+ALIAS: GL_STENCIL_VALUE_MASK gl:GL_STENCIL_VALUE_MASK
+ALIAS: GL_STENCIL_FAIL gl:GL_STENCIL_FAIL
+ALIAS: GL_STENCIL_PASS_DEPTH_FAIL gl:GL_STENCIL_PASS_DEPTH_FAIL
+ALIAS: GL_STENCIL_PASS_DEPTH_PASS gl:GL_STENCIL_PASS_DEPTH_PASS
+ALIAS: GL_STENCIL_REF gl:GL_STENCIL_REF
+ALIAS: GL_STENCIL_WRITEMASK gl:GL_STENCIL_WRITEMASK
+ALIAS: GL_VIEWPORT gl:GL_VIEWPORT
+ALIAS: GL_DITHER gl:GL_DITHER
+ALIAS: GL_BLEND_DST gl:GL_BLEND_DST
+ALIAS: GL_BLEND_SRC gl:GL_BLEND_SRC
+ALIAS: GL_BLEND gl:GL_BLEND
+ALIAS: GL_LOGIC_OP_MODE gl:GL_LOGIC_OP_MODE
+ALIAS: GL_COLOR_LOGIC_OP gl:GL_COLOR_LOGIC_OP
+ALIAS: GL_DRAW_BUFFER gl:GL_DRAW_BUFFER
+ALIAS: GL_READ_BUFFER gl:GL_READ_BUFFER
+ALIAS: GL_SCISSOR_BOX gl:GL_SCISSOR_BOX
+ALIAS: GL_SCISSOR_TEST gl:GL_SCISSOR_TEST
+ALIAS: GL_COLOR_CLEAR_VALUE gl:GL_COLOR_CLEAR_VALUE
+ALIAS: GL_COLOR_WRITEMASK gl:GL_COLOR_WRITEMASK
+ALIAS: GL_DOUBLEBUFFER gl:GL_DOUBLEBUFFER
+ALIAS: GL_STEREO gl:GL_STEREO
+ALIAS: GL_LINE_SMOOTH_HINT gl:GL_LINE_SMOOTH_HINT
+ALIAS: GL_POLYGON_SMOOTH_HINT gl:GL_POLYGON_SMOOTH_HINT
+ALIAS: GL_UNPACK_SWAP_BYTES gl:GL_UNPACK_SWAP_BYTES
+ALIAS: GL_UNPACK_LSB_FIRST gl:GL_UNPACK_LSB_FIRST
+ALIAS: GL_UNPACK_ROW_LENGTH gl:GL_UNPACK_ROW_LENGTH
+ALIAS: GL_UNPACK_SKIP_ROWS gl:GL_UNPACK_SKIP_ROWS
+ALIAS: GL_UNPACK_SKIP_PIXELS gl:GL_UNPACK_SKIP_PIXELS
+ALIAS: GL_UNPACK_ALIGNMENT gl:GL_UNPACK_ALIGNMENT
+ALIAS: GL_PACK_SWAP_BYTES gl:GL_PACK_SWAP_BYTES
+ALIAS: GL_PACK_LSB_FIRST gl:GL_PACK_LSB_FIRST
+ALIAS: GL_PACK_ROW_LENGTH gl:GL_PACK_ROW_LENGTH
+ALIAS: GL_PACK_SKIP_ROWS gl:GL_PACK_SKIP_ROWS
+ALIAS: GL_PACK_SKIP_PIXELS gl:GL_PACK_SKIP_PIXELS
+ALIAS: GL_PACK_ALIGNMENT gl:GL_PACK_ALIGNMENT
+ALIAS: GL_MAX_TEXTURE_SIZE gl:GL_MAX_TEXTURE_SIZE
+ALIAS: GL_MAX_VIEWPORT_DIMS gl:GL_MAX_VIEWPORT_DIMS
+ALIAS: GL_SUBPIXEL_BITS gl:GL_SUBPIXEL_BITS
+ALIAS: GL_TEXTURE_1D gl:GL_TEXTURE_1D
+ALIAS: GL_TEXTURE_2D gl:GL_TEXTURE_2D
+ALIAS: GL_POLYGON_OFFSET_UNITS gl:GL_POLYGON_OFFSET_UNITS
+ALIAS: GL_POLYGON_OFFSET_POINT gl:GL_POLYGON_OFFSET_POINT
+ALIAS: GL_POLYGON_OFFSET_LINE gl:GL_POLYGON_OFFSET_LINE
+ALIAS: GL_POLYGON_OFFSET_FILL gl:GL_POLYGON_OFFSET_FILL
+ALIAS: GL_POLYGON_OFFSET_FACTOR gl:GL_POLYGON_OFFSET_FACTOR
+ALIAS: GL_TEXTURE_BINDING_1D gl:GL_TEXTURE_BINDING_1D
+ALIAS: GL_TEXTURE_BINDING_2D gl:GL_TEXTURE_BINDING_2D
+ALIAS: GL_TEXTURE_WIDTH gl:GL_TEXTURE_WIDTH
+ALIAS: GL_TEXTURE_HEIGHT gl:GL_TEXTURE_HEIGHT
+ALIAS: GL_TEXTURE_INTERNAL_FORMAT gl:GL_TEXTURE_INTERNAL_FORMAT
+ALIAS: GL_TEXTURE_BORDER_COLOR gl:GL_TEXTURE_BORDER_COLOR
+ALIAS: GL_TEXTURE_BORDER gl:GL_TEXTURE_BORDER
+ALIAS: GL_TEXTURE_RED_SIZE gl:GL_TEXTURE_RED_SIZE
+ALIAS: GL_TEXTURE_GREEN_SIZE gl:GL_TEXTURE_GREEN_SIZE
+ALIAS: GL_TEXTURE_BLUE_SIZE gl:GL_TEXTURE_BLUE_SIZE
+ALIAS: GL_TEXTURE_ALPHA_SIZE gl:GL_TEXTURE_ALPHA_SIZE
+ALIAS: GL_DONT_CARE gl:GL_DONT_CARE
+ALIAS: GL_FASTEST gl:GL_FASTEST
+ALIAS: GL_NICEST gl:GL_NICEST
+ALIAS: GL_BYTE gl:GL_BYTE
+ALIAS: GL_UNSIGNED_BYTE gl:GL_UNSIGNED_BYTE
+ALIAS: GL_SHORT gl:GL_SHORT
+ALIAS: GL_UNSIGNED_SHORT gl:GL_UNSIGNED_SHORT
+ALIAS: GL_INT gl:GL_INT
+ALIAS: GL_UNSIGNED_INT gl:GL_UNSIGNED_INT
+ALIAS: GL_FLOAT gl:GL_FLOAT
+ALIAS: GL_DOUBLE gl:GL_DOUBLE
+ALIAS: GL_CLEAR gl:GL_CLEAR
+ALIAS: GL_AND gl:GL_AND
+ALIAS: GL_AND_REVERSE gl:GL_AND_REVERSE
+ALIAS: GL_COPY gl:GL_COPY
+ALIAS: GL_AND_INVERTED gl:GL_AND_INVERTED
+ALIAS: GL_NOOP gl:GL_NOOP
+ALIAS: GL_XOR gl:GL_XOR
+ALIAS: GL_OR gl:GL_OR
+ALIAS: GL_NOR gl:GL_NOR
+ALIAS: GL_EQUIV gl:GL_EQUIV
+ALIAS: GL_INVERT gl:GL_INVERT
+ALIAS: GL_OR_REVERSE gl:GL_OR_REVERSE
+ALIAS: GL_COPY_INVERTED gl:GL_COPY_INVERTED
+ALIAS: GL_OR_INVERTED gl:GL_OR_INVERTED
+ALIAS: GL_NAND gl:GL_NAND
+ALIAS: GL_SET gl:GL_SET
+ALIAS: GL_TEXTURE gl:GL_TEXTURE
+ALIAS: GL_COLOR gl:GL_COLOR
+ALIAS: GL_DEPTH gl:GL_DEPTH
+ALIAS: GL_STENCIL gl:GL_STENCIL
+ALIAS: GL_STENCIL_INDEX gl:GL_STENCIL_INDEX
+ALIAS: GL_DEPTH_COMPONENT gl:GL_DEPTH_COMPONENT
+ALIAS: GL_RED gl:GL_RED
+ALIAS: GL_GREEN gl:GL_GREEN
+ALIAS: GL_BLUE gl:GL_BLUE
+ALIAS: GL_ALPHA gl:GL_ALPHA
+ALIAS: GL_RGB gl:GL_RGB
+ALIAS: GL_RGBA gl:GL_RGBA
+ALIAS: GL_POINT gl:GL_POINT
+ALIAS: GL_LINE gl:GL_LINE
+ALIAS: GL_FILL gl:GL_FILL
+ALIAS: GL_KEEP gl:GL_KEEP
+ALIAS: GL_REPLACE gl:GL_REPLACE
+ALIAS: GL_INCR gl:GL_INCR
+ALIAS: GL_DECR gl:GL_DECR
+ALIAS: GL_VENDOR gl:GL_VENDOR
+ALIAS: GL_RENDERER gl:GL_RENDERER
+ALIAS: GL_VERSION gl:GL_VERSION
+ALIAS: GL_EXTENSIONS gl:GL_EXTENSIONS
+ALIAS: GL_NEAREST gl:GL_NEAREST
+ALIAS: GL_LINEAR gl:GL_LINEAR
+ALIAS: GL_NEAREST_MIPMAP_NEAREST gl:GL_NEAREST_MIPMAP_NEAREST
+ALIAS: GL_LINEAR_MIPMAP_NEAREST gl:GL_LINEAR_MIPMAP_NEAREST
+ALIAS: GL_NEAREST_MIPMAP_LINEAR gl:GL_NEAREST_MIPMAP_LINEAR
+ALIAS: GL_LINEAR_MIPMAP_LINEAR gl:GL_LINEAR_MIPMAP_LINEAR
+ALIAS: GL_TEXTURE_MAG_FILTER gl:GL_TEXTURE_MAG_FILTER
+ALIAS: GL_TEXTURE_MIN_FILTER gl:GL_TEXTURE_MIN_FILTER
+ALIAS: GL_TEXTURE_WRAP_S gl:GL_TEXTURE_WRAP_S
+ALIAS: GL_TEXTURE_WRAP_T gl:GL_TEXTURE_WRAP_T
+ALIAS: GL_PROXY_TEXTURE_1D gl:GL_PROXY_TEXTURE_1D
+ALIAS: GL_PROXY_TEXTURE_2D gl:GL_PROXY_TEXTURE_2D
+ALIAS: GL_REPEAT gl:GL_REPEAT
+ALIAS: GL_R3_G3_B2 gl:GL_R3_G3_B2
+ALIAS: GL_RGB4 gl:GL_RGB4
+ALIAS: GL_RGB5 gl:GL_RGB5
+ALIAS: GL_RGB8 gl:GL_RGB8
+ALIAS: GL_RGB10 gl:GL_RGB10
+ALIAS: GL_RGB12 gl:GL_RGB12
+ALIAS: GL_RGB16 gl:GL_RGB16
+ALIAS: GL_RGBA2 gl:GL_RGBA2
+ALIAS: GL_RGBA4 gl:GL_RGBA4
+ALIAS: GL_RGB5_A1 gl:GL_RGB5_A1
+ALIAS: GL_RGBA8 gl:GL_RGBA8
+ALIAS: GL_RGB10_A2 gl:GL_RGB10_A2
+ALIAS: GL_RGBA12 gl:GL_RGBA12
+ALIAS: GL_RGBA16 gl:GL_RGBA16
+ALIAS: GL_UNSIGNED_BYTE_3_3_2 gl:GL_UNSIGNED_BYTE_3_3_2
+ALIAS: GL_UNSIGNED_SHORT_4_4_4_4 gl:GL_UNSIGNED_SHORT_4_4_4_4
+ALIAS: GL_UNSIGNED_SHORT_5_5_5_1 gl:GL_UNSIGNED_SHORT_5_5_5_1
+ALIAS: GL_UNSIGNED_INT_8_8_8_8 gl:GL_UNSIGNED_INT_8_8_8_8
+ALIAS: GL_UNSIGNED_INT_10_10_10_2 gl:GL_UNSIGNED_INT_10_10_10_2
+ALIAS: GL_TEXTURE_BINDING_3D gl:GL_TEXTURE_BINDING_3D
+ALIAS: GL_PACK_SKIP_IMAGES gl:GL_PACK_SKIP_IMAGES
+ALIAS: GL_PACK_IMAGE_HEIGHT gl:GL_PACK_IMAGE_HEIGHT
+ALIAS: GL_UNPACK_SKIP_IMAGES gl:GL_UNPACK_SKIP_IMAGES
+ALIAS: GL_UNPACK_IMAGE_HEIGHT gl:GL_UNPACK_IMAGE_HEIGHT
+ALIAS: GL_TEXTURE_3D gl:GL_TEXTURE_3D
+ALIAS: GL_PROXY_TEXTURE_3D gl:GL_PROXY_TEXTURE_3D
+ALIAS: GL_TEXTURE_DEPTH gl:GL_TEXTURE_DEPTH
+ALIAS: GL_TEXTURE_WRAP_R gl:GL_TEXTURE_WRAP_R
+ALIAS: GL_MAX_3D_TEXTURE_SIZE gl:GL_MAX_3D_TEXTURE_SIZE
+ALIAS: GL_UNSIGNED_BYTE_2_3_3_REV gl:GL_UNSIGNED_BYTE_2_3_3_REV
+ALIAS: GL_UNSIGNED_SHORT_5_6_5 gl:GL_UNSIGNED_SHORT_5_6_5
+ALIAS: GL_UNSIGNED_SHORT_5_6_5_REV gl:GL_UNSIGNED_SHORT_5_6_5_REV
+ALIAS: GL_UNSIGNED_SHORT_4_4_4_4_REV gl:GL_UNSIGNED_SHORT_4_4_4_4_REV
+ALIAS: GL_UNSIGNED_SHORT_1_5_5_5_REV gl:GL_UNSIGNED_SHORT_1_5_5_5_REV
+ALIAS: GL_UNSIGNED_INT_8_8_8_8_REV gl:GL_UNSIGNED_INT_8_8_8_8_REV
+ALIAS: GL_UNSIGNED_INT_2_10_10_10_REV gl:GL_UNSIGNED_INT_2_10_10_10_REV
+ALIAS: GL_BGR gl:GL_BGR
+ALIAS: GL_BGRA gl:GL_BGRA
+ALIAS: GL_MAX_ELEMENTS_VERTICES gl:GL_MAX_ELEMENTS_VERTICES
+ALIAS: GL_MAX_ELEMENTS_INDICES gl:GL_MAX_ELEMENTS_INDICES
+ALIAS: GL_CLAMP_TO_EDGE gl:GL_CLAMP_TO_EDGE
+ALIAS: GL_TEXTURE_MIN_LOD gl:GL_TEXTURE_MIN_LOD
+ALIAS: GL_TEXTURE_MAX_LOD gl:GL_TEXTURE_MAX_LOD
+ALIAS: GL_TEXTURE_BASE_LEVEL gl:GL_TEXTURE_BASE_LEVEL
+ALIAS: GL_TEXTURE_MAX_LEVEL gl:GL_TEXTURE_MAX_LEVEL
+ALIAS: GL_SMOOTH_POINT_SIZE_RANGE gl:GL_SMOOTH_POINT_SIZE_RANGE
+ALIAS: GL_SMOOTH_POINT_SIZE_GRANULARITY gl:GL_SMOOTH_POINT_SIZE_GRANULARITY
+ALIAS: GL_SMOOTH_LINE_WIDTH_RANGE gl:GL_SMOOTH_LINE_WIDTH_RANGE
+ALIAS: GL_SMOOTH_LINE_WIDTH_GRANULARITY gl:GL_SMOOTH_LINE_WIDTH_GRANULARITY
+ALIAS: GL_ALIASED_LINE_WIDTH_RANGE gl:GL_ALIASED_LINE_WIDTH_RANGE
+ALIAS: GL_CONSTANT_COLOR gl:GL_CONSTANT_COLOR
+ALIAS: GL_ONE_MINUS_CONSTANT_COLOR gl:GL_ONE_MINUS_CONSTANT_COLOR
+ALIAS: GL_CONSTANT_ALPHA gl:GL_CONSTANT_ALPHA
+ALIAS: GL_ONE_MINUS_CONSTANT_ALPHA gl:GL_ONE_MINUS_CONSTANT_ALPHA
+ALIAS: GL_BLEND_COLOR gl:GL_BLEND_COLOR
+ALIAS: GL_FUNC_ADD gl:GL_FUNC_ADD
+ALIAS: GL_MIN gl:GL_MIN
+ALIAS: GL_MAX gl:GL_MAX
+ALIAS: GL_BLEND_EQUATION gl:GL_BLEND_EQUATION
+ALIAS: GL_FUNC_SUBTRACT gl:GL_FUNC_SUBTRACT
+ALIAS: GL_FUNC_REVERSE_SUBTRACT gl:GL_FUNC_REVERSE_SUBTRACT
+ALIAS: GL_TEXTURE0 gl:GL_TEXTURE0
+ALIAS: GL_TEXTURE1 gl:GL_TEXTURE1
+ALIAS: GL_TEXTURE2 gl:GL_TEXTURE2
+ALIAS: GL_TEXTURE3 gl:GL_TEXTURE3
+ALIAS: GL_TEXTURE4 gl:GL_TEXTURE4
+ALIAS: GL_TEXTURE5 gl:GL_TEXTURE5
+ALIAS: GL_TEXTURE6 gl:GL_TEXTURE6
+ALIAS: GL_TEXTURE7 gl:GL_TEXTURE7
+ALIAS: GL_TEXTURE8 gl:GL_TEXTURE8
+ALIAS: GL_TEXTURE9 gl:GL_TEXTURE9
+ALIAS: GL_TEXTURE10 gl:GL_TEXTURE10
+ALIAS: GL_TEXTURE11 gl:GL_TEXTURE11
+ALIAS: GL_TEXTURE12 gl:GL_TEXTURE12
+ALIAS: GL_TEXTURE13 gl:GL_TEXTURE13
+ALIAS: GL_TEXTURE14 gl:GL_TEXTURE14
+ALIAS: GL_TEXTURE15 gl:GL_TEXTURE15
+ALIAS: GL_TEXTURE16 gl:GL_TEXTURE16
+ALIAS: GL_TEXTURE17 gl:GL_TEXTURE17
+ALIAS: GL_TEXTURE18 gl:GL_TEXTURE18
+ALIAS: GL_TEXTURE19 gl:GL_TEXTURE19
+ALIAS: GL_TEXTURE20 gl:GL_TEXTURE20
+ALIAS: GL_TEXTURE21 gl:GL_TEXTURE21
+ALIAS: GL_TEXTURE22 gl:GL_TEXTURE22
+ALIAS: GL_TEXTURE23 gl:GL_TEXTURE23
+ALIAS: GL_TEXTURE24 gl:GL_TEXTURE24
+ALIAS: GL_TEXTURE25 gl:GL_TEXTURE25
+ALIAS: GL_TEXTURE26 gl:GL_TEXTURE26
+ALIAS: GL_TEXTURE27 gl:GL_TEXTURE27
+ALIAS: GL_TEXTURE28 gl:GL_TEXTURE28
+ALIAS: GL_TEXTURE29 gl:GL_TEXTURE29
+ALIAS: GL_TEXTURE30 gl:GL_TEXTURE30
+ALIAS: GL_TEXTURE31 gl:GL_TEXTURE31
+ALIAS: GL_ACTIVE_TEXTURE gl:GL_ACTIVE_TEXTURE
+ALIAS: GL_MULTISAMPLE gl:GL_MULTISAMPLE
+ALIAS: GL_SAMPLE_ALPHA_TO_COVERAGE gl:GL_SAMPLE_ALPHA_TO_COVERAGE
+ALIAS: GL_SAMPLE_ALPHA_TO_ONE gl:GL_SAMPLE_ALPHA_TO_ONE
+ALIAS: GL_SAMPLE_COVERAGE gl:GL_SAMPLE_COVERAGE
+ALIAS: GL_SAMPLE_BUFFERS gl:GL_SAMPLE_BUFFERS
+ALIAS: GL_SAMPLES gl:GL_SAMPLES
+ALIAS: GL_SAMPLE_COVERAGE_VALUE gl:GL_SAMPLE_COVERAGE_VALUE
+ALIAS: GL_SAMPLE_COVERAGE_INVERT gl:GL_SAMPLE_COVERAGE_INVERT
+ALIAS: GL_TEXTURE_CUBE_MAP gl:GL_TEXTURE_CUBE_MAP
+ALIAS: GL_TEXTURE_BINDING_CUBE_MAP gl:GL_TEXTURE_BINDING_CUBE_MAP
+ALIAS: GL_TEXTURE_CUBE_MAP_POSITIVE_X gl:GL_TEXTURE_CUBE_MAP_POSITIVE_X
+ALIAS: GL_TEXTURE_CUBE_MAP_NEGATIVE_X gl:GL_TEXTURE_CUBE_MAP_NEGATIVE_X
+ALIAS: GL_TEXTURE_CUBE_MAP_POSITIVE_Y gl:GL_TEXTURE_CUBE_MAP_POSITIVE_Y
+ALIAS: GL_TEXTURE_CUBE_MAP_NEGATIVE_Y gl:GL_TEXTURE_CUBE_MAP_NEGATIVE_Y
+ALIAS: GL_TEXTURE_CUBE_MAP_POSITIVE_Z gl:GL_TEXTURE_CUBE_MAP_POSITIVE_Z
+ALIAS: GL_TEXTURE_CUBE_MAP_NEGATIVE_Z gl:GL_TEXTURE_CUBE_MAP_NEGATIVE_Z
+ALIAS: GL_PROXY_TEXTURE_CUBE_MAP gl:GL_PROXY_TEXTURE_CUBE_MAP
+ALIAS: GL_MAX_CUBE_MAP_TEXTURE_SIZE gl:GL_MAX_CUBE_MAP_TEXTURE_SIZE
+ALIAS: GL_COMPRESSED_RGB gl:GL_COMPRESSED_RGB
+ALIAS: GL_COMPRESSED_RGBA gl:GL_COMPRESSED_RGBA
+ALIAS: GL_TEXTURE_COMPRESSION_HINT gl:GL_TEXTURE_COMPRESSION_HINT
+ALIAS: GL_TEXTURE_COMPRESSED_IMAGE_SIZE gl:GL_TEXTURE_COMPRESSED_IMAGE_SIZE
+ALIAS: GL_TEXTURE_COMPRESSED gl:GL_TEXTURE_COMPRESSED
+ALIAS: GL_NUM_COMPRESSED_TEXTURE_FORMATS gl:GL_NUM_COMPRESSED_TEXTURE_FORMATS
+ALIAS: GL_COMPRESSED_TEXTURE_FORMATS gl:GL_COMPRESSED_TEXTURE_FORMATS
+ALIAS: GL_CLAMP_TO_BORDER gl:GL_CLAMP_TO_BORDER
+ALIAS: GL_BLEND_DST_RGB gl:GL_BLEND_DST_RGB
+ALIAS: GL_BLEND_SRC_RGB gl:GL_BLEND_SRC_RGB
+ALIAS: GL_BLEND_DST_ALPHA gl:GL_BLEND_DST_ALPHA
+ALIAS: GL_BLEND_SRC_ALPHA gl:GL_BLEND_SRC_ALPHA
+ALIAS: GL_POINT_FADE_THRESHOLD_SIZE gl:GL_POINT_FADE_THRESHOLD_SIZE
+ALIAS: GL_DEPTH_COMPONENT16 gl:GL_DEPTH_COMPONENT16
+ALIAS: GL_DEPTH_COMPONENT24 gl:GL_DEPTH_COMPONENT24
+ALIAS: GL_DEPTH_COMPONENT32 gl:GL_DEPTH_COMPONENT32
+ALIAS: GL_MIRRORED_REPEAT gl:GL_MIRRORED_REPEAT
+ALIAS: GL_MAX_TEXTURE_LOD_BIAS gl:GL_MAX_TEXTURE_LOD_BIAS
+ALIAS: GL_TEXTURE_LOD_BIAS gl:GL_TEXTURE_LOD_BIAS
+ALIAS: GL_INCR_WRAP gl:GL_INCR_WRAP
+ALIAS: GL_DECR_WRAP gl:GL_DECR_WRAP
+ALIAS: GL_TEXTURE_DEPTH_SIZE gl:GL_TEXTURE_DEPTH_SIZE
+ALIAS: GL_TEXTURE_COMPARE_MODE gl:GL_TEXTURE_COMPARE_MODE
+ALIAS: GL_TEXTURE_COMPARE_FUNC gl:GL_TEXTURE_COMPARE_FUNC
+ALIAS: GL_BUFFER_SIZE gl:GL_BUFFER_SIZE
+ALIAS: GL_BUFFER_USAGE gl:GL_BUFFER_USAGE
+ALIAS: GL_QUERY_COUNTER_BITS gl:GL_QUERY_COUNTER_BITS
+ALIAS: GL_CURRENT_QUERY gl:GL_CURRENT_QUERY
+ALIAS: GL_QUERY_RESULT gl:GL_QUERY_RESULT
+ALIAS: GL_QUERY_RESULT_AVAILABLE gl:GL_QUERY_RESULT_AVAILABLE
+ALIAS: GL_ARRAY_BUFFER gl:GL_ARRAY_BUFFER
+ALIAS: GL_ELEMENT_ARRAY_BUFFER gl:GL_ELEMENT_ARRAY_BUFFER
+ALIAS: GL_ARRAY_BUFFER_BINDING gl:GL_ARRAY_BUFFER_BINDING
+ALIAS: GL_ELEMENT_ARRAY_BUFFER_BINDING gl:GL_ELEMENT_ARRAY_BUFFER_BINDING
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING gl:GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING
+ALIAS: GL_READ_ONLY gl:GL_READ_ONLY
+ALIAS: GL_WRITE_ONLY gl:GL_WRITE_ONLY
+ALIAS: GL_READ_WRITE gl:GL_READ_WRITE
+ALIAS: GL_BUFFER_ACCESS gl:GL_BUFFER_ACCESS
+ALIAS: GL_BUFFER_MAPPED gl:GL_BUFFER_MAPPED
+ALIAS: GL_BUFFER_MAP_POINTER gl:GL_BUFFER_MAP_POINTER
+ALIAS: GL_STREAM_DRAW gl:GL_STREAM_DRAW
+ALIAS: GL_STREAM_READ gl:GL_STREAM_READ
+ALIAS: GL_STREAM_COPY gl:GL_STREAM_COPY
+ALIAS: GL_STATIC_DRAW gl:GL_STATIC_DRAW
+ALIAS: GL_STATIC_READ gl:GL_STATIC_READ
+ALIAS: GL_STATIC_COPY gl:GL_STATIC_COPY
+ALIAS: GL_DYNAMIC_DRAW gl:GL_DYNAMIC_DRAW
+ALIAS: GL_DYNAMIC_READ gl:GL_DYNAMIC_READ
+ALIAS: GL_DYNAMIC_COPY gl:GL_DYNAMIC_COPY
+ALIAS: GL_SAMPLES_PASSED gl:GL_SAMPLES_PASSED
+ALIAS: GL_BLEND_EQUATION_RGB gl:GL_BLEND_EQUATION_RGB
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_ENABLED gl:GL_VERTEX_ATTRIB_ARRAY_ENABLED
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_SIZE gl:GL_VERTEX_ATTRIB_ARRAY_SIZE
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_STRIDE gl:GL_VERTEX_ATTRIB_ARRAY_STRIDE
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_TYPE gl:GL_VERTEX_ATTRIB_ARRAY_TYPE
+ALIAS: GL_CURRENT_VERTEX_ATTRIB gl:GL_CURRENT_VERTEX_ATTRIB
+ALIAS: GL_VERTEX_PROGRAM_POINT_SIZE gl:GL_VERTEX_PROGRAM_POINT_SIZE
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_POINTER gl:GL_VERTEX_ATTRIB_ARRAY_POINTER
+ALIAS: GL_STENCIL_BACK_FUNC gl:GL_STENCIL_BACK_FUNC
+ALIAS: GL_STENCIL_BACK_FAIL gl:GL_STENCIL_BACK_FAIL
+ALIAS: GL_STENCIL_BACK_PASS_DEPTH_FAIL gl:GL_STENCIL_BACK_PASS_DEPTH_FAIL
+ALIAS: GL_STENCIL_BACK_PASS_DEPTH_PASS gl:GL_STENCIL_BACK_PASS_DEPTH_PASS
+ALIAS: GL_MAX_DRAW_BUFFERS gl:GL_MAX_DRAW_BUFFERS
+ALIAS: GL_DRAW_BUFFER0 gl:GL_DRAW_BUFFER0
+ALIAS: GL_DRAW_BUFFER1 gl:GL_DRAW_BUFFER1
+ALIAS: GL_DRAW_BUFFER2 gl:GL_DRAW_BUFFER2
+ALIAS: GL_DRAW_BUFFER3 gl:GL_DRAW_BUFFER3
+ALIAS: GL_DRAW_BUFFER4 gl:GL_DRAW_BUFFER4
+ALIAS: GL_DRAW_BUFFER5 gl:GL_DRAW_BUFFER5
+ALIAS: GL_DRAW_BUFFER6 gl:GL_DRAW_BUFFER6
+ALIAS: GL_DRAW_BUFFER7 gl:GL_DRAW_BUFFER7
+ALIAS: GL_DRAW_BUFFER8 gl:GL_DRAW_BUFFER8
+ALIAS: GL_DRAW_BUFFER9 gl:GL_DRAW_BUFFER9
+ALIAS: GL_DRAW_BUFFER10 gl:GL_DRAW_BUFFER10
+ALIAS: GL_DRAW_BUFFER11 gl:GL_DRAW_BUFFER11
+ALIAS: GL_DRAW_BUFFER12 gl:GL_DRAW_BUFFER12
+ALIAS: GL_DRAW_BUFFER13 gl:GL_DRAW_BUFFER13
+ALIAS: GL_DRAW_BUFFER14 gl:GL_DRAW_BUFFER14
+ALIAS: GL_DRAW_BUFFER15 gl:GL_DRAW_BUFFER15
+ALIAS: GL_BLEND_EQUATION_ALPHA gl:GL_BLEND_EQUATION_ALPHA
+ALIAS: GL_MAX_VERTEX_ATTRIBS gl:GL_MAX_VERTEX_ATTRIBS
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_NORMALIZED gl:GL_VERTEX_ATTRIB_ARRAY_NORMALIZED
+ALIAS: GL_MAX_TEXTURE_IMAGE_UNITS gl:GL_MAX_TEXTURE_IMAGE_UNITS
+ALIAS: GL_FRAGMENT_SHADER gl:GL_FRAGMENT_SHADER
+ALIAS: GL_VERTEX_SHADER gl:GL_VERTEX_SHADER
+ALIAS: GL_MAX_FRAGMENT_UNIFORM_COMPONENTS gl:GL_MAX_FRAGMENT_UNIFORM_COMPONENTS
+ALIAS: GL_MAX_VERTEX_UNIFORM_COMPONENTS gl:GL_MAX_VERTEX_UNIFORM_COMPONENTS
+ALIAS: GL_MAX_VARYING_FLOATS gl:GL_MAX_VARYING_FLOATS
+ALIAS: GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS gl:GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS
+ALIAS: GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS gl:GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS
+ALIAS: GL_SHADER_TYPE gl:GL_SHADER_TYPE
+ALIAS: GL_FLOAT_VEC2 gl:GL_FLOAT_VEC2
+ALIAS: GL_FLOAT_VEC3 gl:GL_FLOAT_VEC3
+ALIAS: GL_FLOAT_VEC4 gl:GL_FLOAT_VEC4
+ALIAS: GL_INT_VEC2 gl:GL_INT_VEC2
+ALIAS: GL_INT_VEC3 gl:GL_INT_VEC3
+ALIAS: GL_INT_VEC4 gl:GL_INT_VEC4
+ALIAS: GL_BOOL gl:GL_BOOL
+ALIAS: GL_BOOL_VEC2 gl:GL_BOOL_VEC2
+ALIAS: GL_BOOL_VEC3 gl:GL_BOOL_VEC3
+ALIAS: GL_BOOL_VEC4 gl:GL_BOOL_VEC4
+ALIAS: GL_FLOAT_MAT2 gl:GL_FLOAT_MAT2
+ALIAS: GL_FLOAT_MAT3 gl:GL_FLOAT_MAT3
+ALIAS: GL_FLOAT_MAT4 gl:GL_FLOAT_MAT4
+ALIAS: GL_SAMPLER_1D gl:GL_SAMPLER_1D
+ALIAS: GL_SAMPLER_2D gl:GL_SAMPLER_2D
+ALIAS: GL_SAMPLER_3D gl:GL_SAMPLER_3D
+ALIAS: GL_SAMPLER_CUBE gl:GL_SAMPLER_CUBE
+ALIAS: GL_SAMPLER_1D_SHADOW gl:GL_SAMPLER_1D_SHADOW
+ALIAS: GL_SAMPLER_2D_SHADOW gl:GL_SAMPLER_2D_SHADOW
+ALIAS: GL_DELETE_STATUS gl:GL_DELETE_STATUS
+ALIAS: GL_COMPILE_STATUS gl:GL_COMPILE_STATUS
+ALIAS: GL_LINK_STATUS gl:GL_LINK_STATUS
+ALIAS: GL_VALIDATE_STATUS gl:GL_VALIDATE_STATUS
+ALIAS: GL_INFO_LOG_LENGTH gl:GL_INFO_LOG_LENGTH
+ALIAS: GL_ATTACHED_SHADERS gl:GL_ATTACHED_SHADERS
+ALIAS: GL_ACTIVE_UNIFORMS gl:GL_ACTIVE_UNIFORMS
+ALIAS: GL_ACTIVE_UNIFORM_MAX_LENGTH gl:GL_ACTIVE_UNIFORM_MAX_LENGTH
+ALIAS: GL_SHADER_SOURCE_LENGTH gl:GL_SHADER_SOURCE_LENGTH
+ALIAS: GL_ACTIVE_ATTRIBUTES gl:GL_ACTIVE_ATTRIBUTES
+ALIAS: GL_ACTIVE_ATTRIBUTE_MAX_LENGTH gl:GL_ACTIVE_ATTRIBUTE_MAX_LENGTH
+ALIAS: GL_FRAGMENT_SHADER_DERIVATIVE_HINT gl:GL_FRAGMENT_SHADER_DERIVATIVE_HINT
+ALIAS: GL_SHADING_LANGUAGE_VERSION gl:GL_SHADING_LANGUAGE_VERSION
+ALIAS: GL_CURRENT_PROGRAM gl:GL_CURRENT_PROGRAM
+ALIAS: GL_POINT_SPRITE_COORD_ORIGIN gl:GL_POINT_SPRITE_COORD_ORIGIN
+ALIAS: GL_LOWER_LEFT gl:GL_LOWER_LEFT
+ALIAS: GL_UPPER_LEFT gl:GL_UPPER_LEFT
+ALIAS: GL_STENCIL_BACK_REF gl:GL_STENCIL_BACK_REF
+ALIAS: GL_STENCIL_BACK_VALUE_MASK gl:GL_STENCIL_BACK_VALUE_MASK
+ALIAS: GL_STENCIL_BACK_WRITEMASK gl:GL_STENCIL_BACK_WRITEMASK
+ALIAS: GL_PIXEL_PACK_BUFFER gl:GL_PIXEL_PACK_BUFFER
+ALIAS: GL_PIXEL_UNPACK_BUFFER gl:GL_PIXEL_UNPACK_BUFFER
+ALIAS: GL_PIXEL_PACK_BUFFER_BINDING gl:GL_PIXEL_PACK_BUFFER_BINDING
+ALIAS: GL_PIXEL_UNPACK_BUFFER_BINDING gl:GL_PIXEL_UNPACK_BUFFER_BINDING
+ALIAS: GL_FLOAT_MAT2x3 gl:GL_FLOAT_MAT2x3
+ALIAS: GL_FLOAT_MAT2x4 gl:GL_FLOAT_MAT2x4
+ALIAS: GL_FLOAT_MAT3x2 gl:GL_FLOAT_MAT3x2
+ALIAS: GL_FLOAT_MAT3x4 gl:GL_FLOAT_MAT3x4
+ALIAS: GL_FLOAT_MAT4x2 gl:GL_FLOAT_MAT4x2
+ALIAS: GL_FLOAT_MAT4x3 gl:GL_FLOAT_MAT4x3
+ALIAS: GL_SRGB gl:GL_SRGB
+ALIAS: GL_SRGB8 gl:GL_SRGB8
+ALIAS: GL_SRGB_ALPHA gl:GL_SRGB_ALPHA
+ALIAS: GL_SRGB8_ALPHA8 gl:GL_SRGB8_ALPHA8
+ALIAS: GL_COMPRESSED_SRGB gl:GL_COMPRESSED_SRGB
+ALIAS: GL_COMPRESSED_SRGB_ALPHA gl:GL_COMPRESSED_SRGB_ALPHA
+ALIAS: GL_COMPARE_REF_TO_TEXTURE gl:GL_COMPARE_REF_TO_TEXTURE
+ALIAS: GL_CLIP_DISTANCE0 gl:GL_CLIP_DISTANCE0
+ALIAS: GL_CLIP_DISTANCE1 gl:GL_CLIP_DISTANCE1
+ALIAS: GL_CLIP_DISTANCE2 gl:GL_CLIP_DISTANCE2
+ALIAS: GL_CLIP_DISTANCE3 gl:GL_CLIP_DISTANCE3
+ALIAS: GL_CLIP_DISTANCE4 gl:GL_CLIP_DISTANCE4
+ALIAS: GL_CLIP_DISTANCE5 gl:GL_CLIP_DISTANCE5
+ALIAS: GL_MAX_CLIP_DISTANCES gl:GL_MAX_CLIP_DISTANCES
+ALIAS: GL_MAJOR_VERSION gl:GL_MAJOR_VERSION
+ALIAS: GL_MINOR_VERSION gl:GL_MINOR_VERSION
+ALIAS: GL_NUM_EXTENSIONS gl:GL_NUM_EXTENSIONS
+ALIAS: GL_CONTEXT_FLAGS gl:GL_CONTEXT_FLAGS
+ALIAS: GL_DEPTH_BUFFER gl:GL_DEPTH_BUFFER
+ALIAS: GL_STENCIL_BUFFER gl:GL_STENCIL_BUFFER
+ALIAS: GL_COMPRESSED_RED gl:GL_COMPRESSED_RED
+ALIAS: GL_COMPRESSED_RG gl:GL_COMPRESSED_RG
+ALIAS: GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT gl:GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT
+ALIAS: GL_RGBA32F gl:GL_RGBA32F
+ALIAS: GL_RGB32F gl:GL_RGB32F
+ALIAS: GL_RGBA16F gl:GL_RGBA16F
+ALIAS: GL_RGB16F gl:GL_RGB16F
+ALIAS: GL_VERTEX_ATTRIB_ARRAY_INTEGER gl:GL_VERTEX_ATTRIB_ARRAY_INTEGER
+ALIAS: GL_MAX_ARRAY_TEXTURE_LAYERS gl:GL_MAX_ARRAY_TEXTURE_LAYERS
+ALIAS: GL_MIN_PROGRAM_TEXEL_OFFSET gl:GL_MIN_PROGRAM_TEXEL_OFFSET
+ALIAS: GL_MAX_PROGRAM_TEXEL_OFFSET gl:GL_MAX_PROGRAM_TEXEL_OFFSET
+ALIAS: GL_CLAMP_READ_COLOR gl:GL_CLAMP_READ_COLOR
+ALIAS: GL_FIXED_ONLY gl:GL_FIXED_ONLY
+ALIAS: GL_MAX_VARYING_COMPONENTS gl:GL_MAX_VARYING_COMPONENTS
+ALIAS: GL_TEXTURE_1D_ARRAY gl:GL_TEXTURE_1D_ARRAY
+ALIAS: GL_PROXY_TEXTURE_1D_ARRAY gl:GL_PROXY_TEXTURE_1D_ARRAY
+ALIAS: GL_TEXTURE_2D_ARRAY gl:GL_TEXTURE_2D_ARRAY
+ALIAS: GL_PROXY_TEXTURE_2D_ARRAY gl:GL_PROXY_TEXTURE_2D_ARRAY
+ALIAS: GL_TEXTURE_BINDING_1D_ARRAY gl:GL_TEXTURE_BINDING_1D_ARRAY
+ALIAS: GL_TEXTURE_BINDING_2D_ARRAY gl:GL_TEXTURE_BINDING_2D_ARRAY
+ALIAS: GL_R11F_G11F_B10F gl:GL_R11F_G11F_B10F
+ALIAS: GL_UNSIGNED_INT_10F_11F_11F_REV gl:GL_UNSIGNED_INT_10F_11F_11F_REV
+ALIAS: GL_RGB9_E5 gl:GL_RGB9_E5
+ALIAS: GL_UNSIGNED_INT_5_9_9_9_REV gl:GL_UNSIGNED_INT_5_9_9_9_REV
+ALIAS: GL_TEXTURE_SHARED_SIZE gl:GL_TEXTURE_SHARED_SIZE
+ALIAS: GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH gl:GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH
+ALIAS: GL_TRANSFORM_FEEDBACK_BUFFER_MODE gl:GL_TRANSFORM_FEEDBACK_BUFFER_MODE
+ALIAS: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS gl:GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS
+ALIAS: GL_TRANSFORM_FEEDBACK_VARYINGS gl:GL_TRANSFORM_FEEDBACK_VARYINGS
+ALIAS: GL_TRANSFORM_FEEDBACK_BUFFER_START gl:GL_TRANSFORM_FEEDBACK_BUFFER_START
+ALIAS: GL_TRANSFORM_FEEDBACK_BUFFER_SIZE gl:GL_TRANSFORM_FEEDBACK_BUFFER_SIZE
+ALIAS: GL_PRIMITIVES_GENERATED gl:GL_PRIMITIVES_GENERATED
+ALIAS: GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN gl:GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN
+ALIAS: GL_RASTERIZER_DISCARD gl:GL_RASTERIZER_DISCARD
+ALIAS: GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS gl:GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS
+ALIAS: GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS gl:GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS
+ALIAS: GL_INTERLEAVED_ATTRIBS gl:GL_INTERLEAVED_ATTRIBS
+ALIAS: GL_SEPARATE_ATTRIBS gl:GL_SEPARATE_ATTRIBS
+ALIAS: GL_TRANSFORM_FEEDBACK_BUFFER gl:GL_TRANSFORM_FEEDBACK_BUFFER
+ALIAS: GL_TRANSFORM_FEEDBACK_BUFFER_BINDING gl:GL_TRANSFORM_FEEDBACK_BUFFER_BINDING
+ALIAS: GL_RGBA32UI gl:GL_RGBA32UI
+ALIAS: GL_RGB32UI gl:GL_RGB32UI
+ALIAS: GL_RGBA16UI gl:GL_RGBA16UI
+ALIAS: GL_RGB16UI gl:GL_RGB16UI
+ALIAS: GL_RGBA8UI gl:GL_RGBA8UI
+ALIAS: GL_RGB8UI gl:GL_RGB8UI
+ALIAS: GL_RGBA32I gl:GL_RGBA32I
+ALIAS: GL_RGB32I gl:GL_RGB32I
+ALIAS: GL_RGBA16I gl:GL_RGBA16I
+ALIAS: GL_RGB16I gl:GL_RGB16I
+ALIAS: GL_RGBA8I gl:GL_RGBA8I
+ALIAS: GL_RGB8I gl:GL_RGB8I
+ALIAS: GL_RED_INTEGER gl:GL_RED_INTEGER
+ALIAS: GL_GREEN_INTEGER gl:GL_GREEN_INTEGER
+ALIAS: GL_BLUE_INTEGER gl:GL_BLUE_INTEGER
+ALIAS: GL_RGB_INTEGER gl:GL_RGB_INTEGER
+ALIAS: GL_RGBA_INTEGER gl:GL_RGBA_INTEGER
+ALIAS: GL_BGR_INTEGER gl:GL_BGR_INTEGER
+ALIAS: GL_BGRA_INTEGER gl:GL_BGRA_INTEGER
+ALIAS: GL_SAMPLER_1D_ARRAY gl:GL_SAMPLER_1D_ARRAY
+ALIAS: GL_SAMPLER_2D_ARRAY gl:GL_SAMPLER_2D_ARRAY
+ALIAS: GL_SAMPLER_1D_ARRAY_SHADOW gl:GL_SAMPLER_1D_ARRAY_SHADOW
+ALIAS: GL_SAMPLER_2D_ARRAY_SHADOW gl:GL_SAMPLER_2D_ARRAY_SHADOW
+ALIAS: GL_SAMPLER_CUBE_SHADOW gl:GL_SAMPLER_CUBE_SHADOW
+ALIAS: GL_UNSIGNED_INT_VEC2 gl:GL_UNSIGNED_INT_VEC2
+ALIAS: GL_UNSIGNED_INT_VEC3 gl:GL_UNSIGNED_INT_VEC3
+ALIAS: GL_UNSIGNED_INT_VEC4 gl:GL_UNSIGNED_INT_VEC4
+ALIAS: GL_INT_SAMPLER_1D gl:GL_INT_SAMPLER_1D
+ALIAS: GL_INT_SAMPLER_2D gl:GL_INT_SAMPLER_2D
+ALIAS: GL_INT_SAMPLER_3D gl:GL_INT_SAMPLER_3D
+ALIAS: GL_INT_SAMPLER_CUBE gl:GL_INT_SAMPLER_CUBE
+ALIAS: GL_INT_SAMPLER_1D_ARRAY gl:GL_INT_SAMPLER_1D_ARRAY
+ALIAS: GL_INT_SAMPLER_2D_ARRAY gl:GL_INT_SAMPLER_2D_ARRAY
+ALIAS: GL_UNSIGNED_INT_SAMPLER_1D gl:GL_UNSIGNED_INT_SAMPLER_1D
+ALIAS: GL_UNSIGNED_INT_SAMPLER_2D gl:GL_UNSIGNED_INT_SAMPLER_2D
+ALIAS: GL_UNSIGNED_INT_SAMPLER_3D gl:GL_UNSIGNED_INT_SAMPLER_3D
+ALIAS: GL_UNSIGNED_INT_SAMPLER_CUBE gl:GL_UNSIGNED_INT_SAMPLER_CUBE
+ALIAS: GL_UNSIGNED_INT_SAMPLER_1D_ARRAY gl:GL_UNSIGNED_INT_SAMPLER_1D_ARRAY
+ALIAS: GL_UNSIGNED_INT_SAMPLER_2D_ARRAY gl:GL_UNSIGNED_INT_SAMPLER_2D_ARRAY
+ALIAS: GL_QUERY_WAIT gl:GL_QUERY_WAIT
+ALIAS: GL_QUERY_NO_WAIT gl:GL_QUERY_NO_WAIT
+ALIAS: GL_QUERY_BY_REGION_WAIT gl:GL_QUERY_BY_REGION_WAIT
+ALIAS: GL_QUERY_BY_REGION_NO_WAIT gl:GL_QUERY_BY_REGION_NO_WAIT
+ALIAS: GL_DEPTH_COMPONENT32F gl:GL_DEPTH_COMPONENT32F
+ALIAS: GL_DEPTH32F_STENCIL8 gl:GL_DEPTH32F_STENCIL8
+ALIAS: GL_FLOAT_32_UNSIGNED_INT_24_8_REV gl:GL_FLOAT_32_UNSIGNED_INT_24_8_REV
+ALIAS: GL_INVALID_FRAMEBUFFER_OPERATION gl:GL_INVALID_FRAMEBUFFER_OPERATION
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING gl:GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE gl:GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE gl:GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE gl:GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE gl:GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE gl:GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE gl:GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE gl:GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE
+ALIAS: GL_FRAMEBUFFER_DEFAULT gl:GL_FRAMEBUFFER_DEFAULT
+ALIAS: GL_FRAMEBUFFER_UNDEFINED gl:GL_FRAMEBUFFER_UNDEFINED
+ALIAS: GL_DEPTH_STENCIL_ATTACHMENT gl:GL_DEPTH_STENCIL_ATTACHMENT
+ALIAS: GL_INDEX gl:GL_INDEX
+ALIAS: GL_MAX_RENDERBUFFER_SIZE gl:GL_MAX_RENDERBUFFER_SIZE
+ALIAS: GL_DEPTH_STENCIL gl:GL_DEPTH_STENCIL
+ALIAS: GL_UNSIGNED_INT_24_8 gl:GL_UNSIGNED_INT_24_8
+ALIAS: GL_DEPTH24_STENCIL8 gl:GL_DEPTH24_STENCIL8
+ALIAS: GL_TEXTURE_STENCIL_SIZE gl:GL_TEXTURE_STENCIL_SIZE
+ALIAS: GL_TEXTURE_RED_TYPE gl:GL_TEXTURE_RED_TYPE
+ALIAS: GL_TEXTURE_GREEN_TYPE gl:GL_TEXTURE_GREEN_TYPE
+ALIAS: GL_TEXTURE_BLUE_TYPE gl:GL_TEXTURE_BLUE_TYPE
+ALIAS: GL_TEXTURE_ALPHA_TYPE gl:GL_TEXTURE_ALPHA_TYPE
+ALIAS: GL_TEXTURE_DEPTH_TYPE gl:GL_TEXTURE_DEPTH_TYPE
+ALIAS: GL_UNSIGNED_NORMALIZED gl:GL_UNSIGNED_NORMALIZED
+ALIAS: GL_FRAMEBUFFER_BINDING gl:GL_FRAMEBUFFER_BINDING
+ALIAS: GL_DRAW_FRAMEBUFFER_BINDING gl:GL_DRAW_FRAMEBUFFER_BINDING
+ALIAS: GL_RENDERBUFFER_BINDING gl:GL_RENDERBUFFER_BINDING
+ALIAS: GL_READ_FRAMEBUFFER gl:GL_READ_FRAMEBUFFER
+ALIAS: GL_DRAW_FRAMEBUFFER gl:GL_DRAW_FRAMEBUFFER
+ALIAS: GL_READ_FRAMEBUFFER_BINDING gl:GL_READ_FRAMEBUFFER_BINDING
+ALIAS: GL_RENDERBUFFER_SAMPLES gl:GL_RENDERBUFFER_SAMPLES
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE gl:GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME gl:GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL gl:GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE gl:GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE
+ALIAS: GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER gl:GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER
+ALIAS: GL_FRAMEBUFFER_COMPLETE gl:GL_FRAMEBUFFER_COMPLETE
+ALIAS: GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT gl:GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT
+ALIAS: GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT gl:GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT
+ALIAS: GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER gl:GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER
+ALIAS: GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER gl:GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER
+ALIAS: GL_FRAMEBUFFER_UNSUPPORTED gl:GL_FRAMEBUFFER_UNSUPPORTED
+ALIAS: GL_MAX_COLOR_ATTACHMENTS gl:GL_MAX_COLOR_ATTACHMENTS
+ALIAS: GL_COLOR_ATTACHMENT0 gl:GL_COLOR_ATTACHMENT0
+ALIAS: GL_COLOR_ATTACHMENT1 gl:GL_COLOR_ATTACHMENT1
+ALIAS: GL_COLOR_ATTACHMENT2 gl:GL_COLOR_ATTACHMENT2
+ALIAS: GL_COLOR_ATTACHMENT3 gl:GL_COLOR_ATTACHMENT3
+ALIAS: GL_COLOR_ATTACHMENT4 gl:GL_COLOR_ATTACHMENT4
+ALIAS: GL_COLOR_ATTACHMENT5 gl:GL_COLOR_ATTACHMENT5
+ALIAS: GL_COLOR_ATTACHMENT6 gl:GL_COLOR_ATTACHMENT6
+ALIAS: GL_COLOR_ATTACHMENT7 gl:GL_COLOR_ATTACHMENT7
+ALIAS: GL_COLOR_ATTACHMENT8 gl:GL_COLOR_ATTACHMENT8
+ALIAS: GL_COLOR_ATTACHMENT9 gl:GL_COLOR_ATTACHMENT9
+ALIAS: GL_COLOR_ATTACHMENT10 gl:GL_COLOR_ATTACHMENT10
+ALIAS: GL_COLOR_ATTACHMENT11 gl:GL_COLOR_ATTACHMENT11
+ALIAS: GL_COLOR_ATTACHMENT12 gl:GL_COLOR_ATTACHMENT12
+ALIAS: GL_COLOR_ATTACHMENT13 gl:GL_COLOR_ATTACHMENT13
+ALIAS: GL_COLOR_ATTACHMENT14 gl:GL_COLOR_ATTACHMENT14
+ALIAS: GL_COLOR_ATTACHMENT15 gl:GL_COLOR_ATTACHMENT15
+ALIAS: GL_DEPTH_ATTACHMENT gl:GL_DEPTH_ATTACHMENT
+ALIAS: GL_STENCIL_ATTACHMENT gl:GL_STENCIL_ATTACHMENT
+ALIAS: GL_FRAMEBUFFER gl:GL_FRAMEBUFFER
+ALIAS: GL_RENDERBUFFER gl:GL_RENDERBUFFER
+ALIAS: GL_RENDERBUFFER_WIDTH gl:GL_RENDERBUFFER_WIDTH
+ALIAS: GL_RENDERBUFFER_HEIGHT gl:GL_RENDERBUFFER_HEIGHT
+ALIAS: GL_RENDERBUFFER_INTERNAL_FORMAT gl:GL_RENDERBUFFER_INTERNAL_FORMAT
+ALIAS: GL_STENCIL_INDEX1 gl:GL_STENCIL_INDEX1
+ALIAS: GL_STENCIL_INDEX4 gl:GL_STENCIL_INDEX4
+ALIAS: GL_STENCIL_INDEX8 gl:GL_STENCIL_INDEX8
+ALIAS: GL_STENCIL_INDEX16 gl:GL_STENCIL_INDEX16
+ALIAS: GL_RENDERBUFFER_RED_SIZE gl:GL_RENDERBUFFER_RED_SIZE
+ALIAS: GL_RENDERBUFFER_GREEN_SIZE gl:GL_RENDERBUFFER_GREEN_SIZE
+ALIAS: GL_RENDERBUFFER_BLUE_SIZE gl:GL_RENDERBUFFER_BLUE_SIZE
+ALIAS: GL_RENDERBUFFER_ALPHA_SIZE gl:GL_RENDERBUFFER_ALPHA_SIZE
+ALIAS: GL_RENDERBUFFER_DEPTH_SIZE gl:GL_RENDERBUFFER_DEPTH_SIZE
+ALIAS: GL_RENDERBUFFER_STENCIL_SIZE gl:GL_RENDERBUFFER_STENCIL_SIZE
+ALIAS: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE gl:GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE
+ALIAS: GL_MAX_SAMPLES gl:GL_MAX_SAMPLES
+ALIAS: GL_FRAMEBUFFER_SRGB gl:GL_FRAMEBUFFER_SRGB
+ALIAS: GL_HALF_FLOAT gl:GL_HALF_FLOAT
+ALIAS: GL_MAP_READ_BIT gl:GL_MAP_READ_BIT
+ALIAS: GL_MAP_WRITE_BIT gl:GL_MAP_WRITE_BIT
+ALIAS: GL_MAP_INVALIDATE_RANGE_BIT gl:GL_MAP_INVALIDATE_RANGE_BIT
+ALIAS: GL_MAP_INVALIDATE_BUFFER_BIT gl:GL_MAP_INVALIDATE_BUFFER_BIT
+ALIAS: GL_MAP_FLUSH_EXPLICIT_BIT gl:GL_MAP_FLUSH_EXPLICIT_BIT
+ALIAS: GL_MAP_UNSYNCHRONIZED_BIT gl:GL_MAP_UNSYNCHRONIZED_BIT
+ALIAS: GL_COMPRESSED_RED_RGTC1 gl:GL_COMPRESSED_RED_RGTC1
+ALIAS: GL_COMPRESSED_SIGNED_RED_RGTC1 gl:GL_COMPRESSED_SIGNED_RED_RGTC1
+ALIAS: GL_COMPRESSED_RG_RGTC2 gl:GL_COMPRESSED_RG_RGTC2
+ALIAS: GL_COMPRESSED_SIGNED_RG_RGTC2 gl:GL_COMPRESSED_SIGNED_RG_RGTC2
+ALIAS: GL_RG gl:GL_RG
+ALIAS: GL_RG_INTEGER gl:GL_RG_INTEGER
+ALIAS: GL_R8 gl:GL_R8
+ALIAS: GL_R16 gl:GL_R16
+ALIAS: GL_RG8 gl:GL_RG8
+ALIAS: GL_RG16 gl:GL_RG16
+ALIAS: GL_R16F gl:GL_R16F
+ALIAS: GL_R32F gl:GL_R32F
+ALIAS: GL_RG16F gl:GL_RG16F
+ALIAS: GL_RG32F gl:GL_RG32F
+ALIAS: GL_R8I gl:GL_R8I
+ALIAS: GL_R8UI gl:GL_R8UI
+ALIAS: GL_R16I gl:GL_R16I
+ALIAS: GL_R16UI gl:GL_R16UI
+ALIAS: GL_R32I gl:GL_R32I
+ALIAS: GL_R32UI gl:GL_R32UI
+ALIAS: GL_RG8I gl:GL_RG8I
+ALIAS: GL_RG8UI gl:GL_RG8UI
+ALIAS: GL_RG16I gl:GL_RG16I
+ALIAS: GL_RG16UI gl:GL_RG16UI
+ALIAS: GL_RG32I gl:GL_RG32I
+ALIAS: GL_RG32UI gl:GL_RG32UI
+ALIAS: GL_VERTEX_ARRAY_BINDING gl:GL_VERTEX_ARRAY_BINDING
+ALIAS: GL_SAMPLER_2D_RECT gl:GL_SAMPLER_2D_RECT
+ALIAS: GL_SAMPLER_2D_RECT_SHADOW gl:GL_SAMPLER_2D_RECT_SHADOW
+ALIAS: GL_SAMPLER_BUFFER gl:GL_SAMPLER_BUFFER
+ALIAS: GL_INT_SAMPLER_2D_RECT gl:GL_INT_SAMPLER_2D_RECT
+ALIAS: GL_INT_SAMPLER_BUFFER gl:GL_INT_SAMPLER_BUFFER
+ALIAS: GL_UNSIGNED_INT_SAMPLER_2D_RECT gl:GL_UNSIGNED_INT_SAMPLER_2D_RECT
+ALIAS: GL_UNSIGNED_INT_SAMPLER_BUFFER gl:GL_UNSIGNED_INT_SAMPLER_BUFFER
+ALIAS: GL_TEXTURE_BUFFER gl:GL_TEXTURE_BUFFER
+ALIAS: GL_MAX_TEXTURE_BUFFER_SIZE gl:GL_MAX_TEXTURE_BUFFER_SIZE
+ALIAS: GL_TEXTURE_BINDING_BUFFER gl:GL_TEXTURE_BINDING_BUFFER
+ALIAS: GL_TEXTURE_BUFFER_DATA_STORE_BINDING gl:GL_TEXTURE_BUFFER_DATA_STORE_BINDING
+ALIAS: GL_TEXTURE_BUFFER_FORMAT gl:GL_TEXTURE_BUFFER_FORMAT
+ALIAS: GL_TEXTURE_RECTANGLE gl:GL_TEXTURE_RECTANGLE
+ALIAS: GL_TEXTURE_BINDING_RECTANGLE gl:GL_TEXTURE_BINDING_RECTANGLE
+ALIAS: GL_PROXY_TEXTURE_RECTANGLE gl:GL_PROXY_TEXTURE_RECTANGLE
+ALIAS: GL_MAX_RECTANGLE_TEXTURE_SIZE gl:GL_MAX_RECTANGLE_TEXTURE_SIZE
+ALIAS: GL_RED_SNORM gl:GL_RED_SNORM
+ALIAS: GL_RG_SNORM gl:GL_RG_SNORM
+ALIAS: GL_RGB_SNORM gl:GL_RGB_SNORM
+ALIAS: GL_RGBA_SNORM gl:GL_RGBA_SNORM
+ALIAS: GL_R8_SNORM gl:GL_R8_SNORM
+ALIAS: GL_RG8_SNORM gl:GL_RG8_SNORM
+ALIAS: GL_RGB8_SNORM gl:GL_RGB8_SNORM
+ALIAS: GL_RGBA8_SNORM gl:GL_RGBA8_SNORM
+ALIAS: GL_R16_SNORM gl:GL_R16_SNORM
+ALIAS: GL_RG16_SNORM gl:GL_RG16_SNORM
+ALIAS: GL_RGB16_SNORM gl:GL_RGB16_SNORM
+ALIAS: GL_RGBA16_SNORM gl:GL_RGBA16_SNORM
+ALIAS: GL_SIGNED_NORMALIZED gl:GL_SIGNED_NORMALIZED
+ALIAS: GL_PRIMITIVE_RESTART gl:GL_PRIMITIVE_RESTART
+ALIAS: GL_PRIMITIVE_RESTART_INDEX gl:GL_PRIMITIVE_RESTART_INDEX
+ALIAS: GL_COPY_READ_BUFFER gl:GL_COPY_READ_BUFFER
+ALIAS: GL_COPY_WRITE_BUFFER gl:GL_COPY_WRITE_BUFFER
+ALIAS: GL_UNIFORM_BUFFER gl:GL_UNIFORM_BUFFER
+ALIAS: GL_UNIFORM_BUFFER_BINDING gl:GL_UNIFORM_BUFFER_BINDING
+ALIAS: GL_UNIFORM_BUFFER_START gl:GL_UNIFORM_BUFFER_START
+ALIAS: GL_UNIFORM_BUFFER_SIZE gl:GL_UNIFORM_BUFFER_SIZE
+ALIAS: GL_MAX_VERTEX_UNIFORM_BLOCKS gl:GL_MAX_VERTEX_UNIFORM_BLOCKS
+ALIAS: GL_MAX_FRAGMENT_UNIFORM_BLOCKS gl:GL_MAX_FRAGMENT_UNIFORM_BLOCKS
+ALIAS: GL_MAX_COMBINED_UNIFORM_BLOCKS gl:GL_MAX_COMBINED_UNIFORM_BLOCKS
+ALIAS: GL_MAX_UNIFORM_BUFFER_BINDINGS gl:GL_MAX_UNIFORM_BUFFER_BINDINGS
+ALIAS: GL_MAX_UNIFORM_BLOCK_SIZE gl:GL_MAX_UNIFORM_BLOCK_SIZE
+ALIAS: GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS gl:GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS
+ALIAS: GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS gl:GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS
+ALIAS: GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT gl:GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT
+ALIAS: GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH gl:GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH
+ALIAS: GL_ACTIVE_UNIFORM_BLOCKS gl:GL_ACTIVE_UNIFORM_BLOCKS
+ALIAS: GL_UNIFORM_TYPE gl:GL_UNIFORM_TYPE
+ALIAS: GL_UNIFORM_SIZE gl:GL_UNIFORM_SIZE
+ALIAS: GL_UNIFORM_NAME_LENGTH gl:GL_UNIFORM_NAME_LENGTH
+ALIAS: GL_UNIFORM_BLOCK_INDEX gl:GL_UNIFORM_BLOCK_INDEX
+ALIAS: GL_UNIFORM_OFFSET gl:GL_UNIFORM_OFFSET
+ALIAS: GL_UNIFORM_ARRAY_STRIDE gl:GL_UNIFORM_ARRAY_STRIDE
+ALIAS: GL_UNIFORM_MATRIX_STRIDE gl:GL_UNIFORM_MATRIX_STRIDE
+ALIAS: GL_UNIFORM_IS_ROW_MAJOR gl:GL_UNIFORM_IS_ROW_MAJOR
+ALIAS: GL_UNIFORM_BLOCK_BINDING gl:GL_UNIFORM_BLOCK_BINDING
+ALIAS: GL_UNIFORM_BLOCK_DATA_SIZE gl:GL_UNIFORM_BLOCK_DATA_SIZE
+ALIAS: GL_UNIFORM_BLOCK_NAME_LENGTH gl:GL_UNIFORM_BLOCK_NAME_LENGTH
+ALIAS: GL_UNIFORM_BLOCK_ACTIVE_UNIFORMS gl:GL_UNIFORM_BLOCK_ACTIVE_UNIFORMS
+ALIAS: GL_UNIFORM_BLOCK_ACTIVE_UNIFORM_INDICES gl:GL_UNIFORM_BLOCK_ACTIVE_UNIFORM_INDICES
+ALIAS: GL_UNIFORM_BLOCK_REFERENCED_BY_VERTEX_SHADER gl:GL_UNIFORM_BLOCK_REFERENCED_BY_VERTEX_SHADER
+ALIAS: GL_UNIFORM_BLOCK_REFERENCED_BY_FRAGMENT_SHADER gl:GL_UNIFORM_BLOCK_REFERENCED_BY_FRAGMENT_SHADER
+ALIAS: GL_INVALID_INDEX gl:GL_INVALID_INDEX
+
+ALIAS: glCullFace gl:glCullFace
+ALIAS: glFrontFace gl:glFrontFace
+ALIAS: glHint gl:glHint
+ALIAS: glLineWidth gl:glLineWidth
+ALIAS: glPointSize gl:glPointSize
+ALIAS: glPolygonMode gl:glPolygonMode
+ALIAS: glScissor gl:glScissor
+ALIAS: glTexParameterf gl:glTexParameterf
+ALIAS: glTexParameterfv gl:glTexParameterfv
+ALIAS: glTexParameteri gl:glTexParameteri
+ALIAS: glTexParameteriv gl:glTexParameteriv
+ALIAS: glTexImage1D gl:glTexImage1D
+ALIAS: glTexImage2D gl:glTexImage2D
+ALIAS: glDrawBuffer gl:glDrawBuffer
+ALIAS: glClear gl:glClear
+ALIAS: glClearColor gl:glClearColor
+ALIAS: glClearStencil gl:glClearStencil
+ALIAS: glClearDepth gl:glClearDepth
+ALIAS: glStencilMask gl:glStencilMask
+ALIAS: glColorMask gl:glColorMask
+ALIAS: glDepthMask gl:glDepthMask
+ALIAS: glDisable gl:glDisable
+ALIAS: glEnable gl:glEnable
+ALIAS: glFinish gl:glFinish
+ALIAS: glFlush gl:glFlush
+ALIAS: glBlendFunc gl:glBlendFunc
+ALIAS: glLogicOp gl:glLogicOp
+ALIAS: glStencilFunc gl:glStencilFunc
+ALIAS: glStencilOp gl:glStencilOp
+ALIAS: glDepthFunc gl:glDepthFunc
+ALIAS: glPixelStoref gl:glPixelStoref
+ALIAS: glPixelStorei gl:glPixelStorei
+ALIAS: glReadBuffer gl:glReadBuffer
+ALIAS: glReadPixels gl:glReadPixels
+ALIAS: glGetBooleanv gl:glGetBooleanv
+ALIAS: glGetDoublev gl:glGetDoublev
+ALIAS: glGetError gl:glGetError
+ALIAS: glGetFloatv gl:glGetFloatv
+ALIAS: glGetIntegerv gl:glGetIntegerv
+ALIAS: glGetString gl:glGetString
+ALIAS: glGetTexImage gl:glGetTexImage
+ALIAS: glGetTexParameterfv gl:glGetTexParameterfv
+ALIAS: glGetTexParameteriv gl:glGetTexParameteriv
+ALIAS: glGetTexLevelParameterfv gl:glGetTexLevelParameterfv
+ALIAS: glGetTexLevelParameteriv gl:glGetTexLevelParameteriv
+ALIAS: glIsEnabled gl:glIsEnabled
+ALIAS: glDepthRange gl:glDepthRange
+ALIAS: glViewport gl:glViewport
+ALIAS: glDrawArrays gl:glDrawArrays
+ALIAS: glDrawElements gl:glDrawElements
+ALIAS: glGetPointerv gl:glGetPointerv
+ALIAS: glPolygonOffset gl:glPolygonOffset
+ALIAS: glCopyTexImage1D gl:glCopyTexImage1D
+ALIAS: glCopyTexImage2D gl:glCopyTexImage2D
+ALIAS: glCopyTexSubImage1D gl:glCopyTexSubImage1D
+ALIAS: glCopyTexSubImage2D gl:glCopyTexSubImage2D
+ALIAS: glTexSubImage1D gl:glTexSubImage1D
+ALIAS: glTexSubImage2D gl:glTexSubImage2D
+ALIAS: glBindTexture gl:glBindTexture
+ALIAS: glDeleteTextures gl:glDeleteTextures
+ALIAS: glGenTextures gl:glGenTextures
+ALIAS: glIsTexture gl:glIsTexture
+ALIAS: glBlendColor gl:glBlendColor
+ALIAS: glBlendEquation gl:glBlendEquation
+ALIAS: glDrawRangeElements gl:glDrawRangeElements
+ALIAS: glTexImage3D gl:glTexImage3D
+ALIAS: glTexSubImage3D gl:glTexSubImage3D
+ALIAS: glCopyTexSubImage3D gl:glCopyTexSubImage3D
+ALIAS: glActiveTexture gl:glActiveTexture
+ALIAS: glSampleCoverage gl:glSampleCoverage
+ALIAS: glCompressedTexImage3D gl:glCompressedTexImage3D
+ALIAS: glCompressedTexImage2D gl:glCompressedTexImage2D
+ALIAS: glCompressedTexImage1D gl:glCompressedTexImage1D
+ALIAS: glCompressedTexSubImage3D gl:glCompressedTexSubImage3D
+ALIAS: glCompressedTexSubImage2D gl:glCompressedTexSubImage2D
+ALIAS: glCompressedTexSubImage1D gl:glCompressedTexSubImage1D
+ALIAS: glGetCompressedTexImage gl:glGetCompressedTexImage
+ALIAS: glBlendFuncSeparate gl:glBlendFuncSeparate
+ALIAS: glMultiDrawArrays gl:glMultiDrawArrays
+ALIAS: glMultiDrawElements gl:glMultiDrawElements
+ALIAS: glPointParameterf gl:glPointParameterf
+ALIAS: glPointParameterfv gl:glPointParameterfv
+ALIAS: glPointParameteri gl:glPointParameteri
+ALIAS: glPointParameteriv gl:glPointParameteriv
+ALIAS: glGenQueries gl:glGenQueries
+ALIAS: glDeleteQueries gl:glDeleteQueries
+ALIAS: glIsQuery gl:glIsQuery
+ALIAS: glBeginQuery gl:glBeginQuery
+ALIAS: glEndQuery gl:glEndQuery
+ALIAS: glGetQueryiv gl:glGetQueryiv
+ALIAS: glGetQueryObjectiv gl:glGetQueryObjectiv
+ALIAS: glGetQueryObjectuiv gl:glGetQueryObjectuiv
+ALIAS: glBindBuffer gl:glBindBuffer
+ALIAS: glDeleteBuffers gl:glDeleteBuffers
+ALIAS: glGenBuffers gl:glGenBuffers
+ALIAS: glIsBuffer gl:glIsBuffer
+ALIAS: glBufferData gl:glBufferData
+ALIAS: glBufferSubData gl:glBufferSubData
+ALIAS: glGetBufferSubData gl:glGetBufferSubData
+ALIAS: glMapBuffer gl:glMapBuffer
+ALIAS: glUnmapBuffer gl:glUnmapBuffer
+ALIAS: glGetBufferParameteriv gl:glGetBufferParameteriv
+ALIAS: glGetBufferPointerv gl:glGetBufferPointerv
+ALIAS: glBlendEquationSeparate gl:glBlendEquationSeparate
+ALIAS: glDrawBuffers gl:glDrawBuffers
+ALIAS: glStencilOpSeparate gl:glStencilOpSeparate
+ALIAS: glStencilFuncSeparate gl:glStencilFuncSeparate
+ALIAS: glStencilMaskSeparate gl:glStencilMaskSeparate
+ALIAS: glAttachShader gl:glAttachShader
+ALIAS: glBindAttribLocation gl:glBindAttribLocation
+ALIAS: glCompileShader gl:glCompileShader
+ALIAS: glCreateProgram gl:glCreateProgram
+ALIAS: glCreateShader gl:glCreateShader
+ALIAS: glDeleteProgram gl:glDeleteProgram
+ALIAS: glDeleteShader gl:glDeleteShader
+ALIAS: glDetachShader gl:glDetachShader
+ALIAS: glDisableVertexAttribArray gl:glDisableVertexAttribArray
+ALIAS: glEnableVertexAttribArray gl:glEnableVertexAttribArray
+ALIAS: glGetActiveAttrib gl:glGetActiveAttrib
+ALIAS: glGetActiveUniform gl:glGetActiveUniform
+ALIAS: glGetAttachedShaders gl:glGetAttachedShaders
+ALIAS: glGetAttribLocation gl:glGetAttribLocation
+ALIAS: glGetProgramiv gl:glGetProgramiv
+ALIAS: glGetProgramInfoLog gl:glGetProgramInfoLog
+ALIAS: glGetShaderiv gl:glGetShaderiv
+ALIAS: glGetShaderInfoLog gl:glGetShaderInfoLog
+ALIAS: glGetShaderSource gl:glGetShaderSource
+ALIAS: glGetUniformLocation gl:glGetUniformLocation
+ALIAS: glGetUniformfv gl:glGetUniformfv
+ALIAS: glGetUniformiv gl:glGetUniformiv
+ALIAS: glGetVertexAttribdv gl:glGetVertexAttribdv
+ALIAS: glGetVertexAttribfv gl:glGetVertexAttribfv
+ALIAS: glGetVertexAttribiv gl:glGetVertexAttribiv
+ALIAS: glGetVertexAttribPointerv gl:glGetVertexAttribPointerv
+ALIAS: glIsProgram gl:glIsProgram
+ALIAS: glIsShader gl:glIsShader
+ALIAS: glLinkProgram gl:glLinkProgram
+ALIAS: glShaderSource gl:glShaderSource
+ALIAS: glUseProgram gl:glUseProgram
+ALIAS: glUniform1f gl:glUniform1f
+ALIAS: glUniform2f gl:glUniform2f
+ALIAS: glUniform3f gl:glUniform3f
+ALIAS: glUniform4f gl:glUniform4f
+ALIAS: glUniform1i gl:glUniform1i
+ALIAS: glUniform2i gl:glUniform2i
+ALIAS: glUniform3i gl:glUniform3i
+ALIAS: glUniform4i gl:glUniform4i
+ALIAS: glUniform1fv gl:glUniform1fv
+ALIAS: glUniform2fv gl:glUniform2fv
+ALIAS: glUniform3fv gl:glUniform3fv
+ALIAS: glUniform4fv gl:glUniform4fv
+ALIAS: glUniform1iv gl:glUniform1iv
+ALIAS: glUniform2iv gl:glUniform2iv
+ALIAS: glUniform3iv gl:glUniform3iv
+ALIAS: glUniform4iv gl:glUniform4iv
+ALIAS: glUniformMatrix2fv gl:glUniformMatrix2fv
+ALIAS: glUniformMatrix3fv gl:glUniformMatrix3fv
+ALIAS: glUniformMatrix4fv gl:glUniformMatrix4fv
+ALIAS: glValidateProgram gl:glValidateProgram
+ALIAS: glVertexAttrib1d gl:glVertexAttrib1d
+ALIAS: glVertexAttrib1dv gl:glVertexAttrib1dv
+ALIAS: glVertexAttrib1f gl:glVertexAttrib1f
+ALIAS: glVertexAttrib1fv gl:glVertexAttrib1fv
+ALIAS: glVertexAttrib1s gl:glVertexAttrib1s
+ALIAS: glVertexAttrib1sv gl:glVertexAttrib1sv
+ALIAS: glVertexAttrib2d gl:glVertexAttrib2d
+ALIAS: glVertexAttrib2dv gl:glVertexAttrib2dv
+ALIAS: glVertexAttrib2f gl:glVertexAttrib2f
+ALIAS: glVertexAttrib2fv gl:glVertexAttrib2fv
+ALIAS: glVertexAttrib2s gl:glVertexAttrib2s
+ALIAS: glVertexAttrib2sv gl:glVertexAttrib2sv
+ALIAS: glVertexAttrib3d gl:glVertexAttrib3d
+ALIAS: glVertexAttrib3dv gl:glVertexAttrib3dv
+ALIAS: glVertexAttrib3f gl:glVertexAttrib3f
+ALIAS: glVertexAttrib3fv gl:glVertexAttrib3fv
+ALIAS: glVertexAttrib3s gl:glVertexAttrib3s
+ALIAS: glVertexAttrib3sv gl:glVertexAttrib3sv
+ALIAS: glVertexAttrib4Nbv gl:glVertexAttrib4Nbv
+ALIAS: glVertexAttrib4Niv gl:glVertexAttrib4Niv
+ALIAS: glVertexAttrib4Nsv gl:glVertexAttrib4Nsv
+ALIAS: glVertexAttrib4Nub gl:glVertexAttrib4Nub
+ALIAS: glVertexAttrib4Nubv gl:glVertexAttrib4Nubv
+ALIAS: glVertexAttrib4Nuiv gl:glVertexAttrib4Nuiv
+ALIAS: glVertexAttrib4Nusv gl:glVertexAttrib4Nusv
+ALIAS: glVertexAttrib4bv gl:glVertexAttrib4bv
+ALIAS: glVertexAttrib4d gl:glVertexAttrib4d
+ALIAS: glVertexAttrib4dv gl:glVertexAttrib4dv
+ALIAS: glVertexAttrib4f gl:glVertexAttrib4f
+ALIAS: glVertexAttrib4fv gl:glVertexAttrib4fv
+ALIAS: glVertexAttrib4iv gl:glVertexAttrib4iv
+ALIAS: glVertexAttrib4s gl:glVertexAttrib4s
+ALIAS: glVertexAttrib4sv gl:glVertexAttrib4sv
+ALIAS: glVertexAttrib4ubv gl:glVertexAttrib4ubv
+ALIAS: glVertexAttrib4uiv gl:glVertexAttrib4uiv
+ALIAS: glVertexAttrib4usv gl:glVertexAttrib4usv
+ALIAS: glVertexAttribPointer gl:glVertexAttribPointer
+ALIAS: glUniformMatrix2x3fv gl:glUniformMatrix2x3fv
+ALIAS: glUniformMatrix3x2fv gl:glUniformMatrix3x2fv
+ALIAS: glUniformMatrix2x4fv gl:glUniformMatrix2x4fv
+ALIAS: glUniformMatrix4x2fv gl:glUniformMatrix4x2fv
+ALIAS: glUniformMatrix3x4fv gl:glUniformMatrix3x4fv
+ALIAS: glUniformMatrix4x3fv gl:glUniformMatrix4x3fv
+ALIAS: glColorMaski gl:glColorMaski
+ALIAS: glGetBooleani_v gl:glGetBooleani_v
+ALIAS: glGetIntegeri_v gl:glGetIntegeri_v
+ALIAS: glEnablei gl:glEnablei
+ALIAS: glDisablei gl:glDisablei
+ALIAS: glIsEnabledi gl:glIsEnabledi
+ALIAS: glBeginTransformFeedback gl:glBeginTransformFeedback
+ALIAS: glEndTransformFeedback gl:glEndTransformFeedback
+ALIAS: glBindBufferRange gl:glBindBufferRange
+ALIAS: glBindBufferBase gl:glBindBufferBase
+ALIAS: glTransformFeedbackVaryings gl:glTransformFeedbackVaryings
+ALIAS: glGetTransformFeedbackVarying gl:glGetTransformFeedbackVarying
+ALIAS: glClampColor gl:glClampColor
+ALIAS: glBeginConditionalRender gl:glBeginConditionalRender
+ALIAS: glEndConditionalRender gl:glEndConditionalRender
+ALIAS: glVertexAttribIPointer gl:glVertexAttribIPointer
+ALIAS: glGetVertexAttribIiv gl:glGetVertexAttribIiv
+ALIAS: glGetVertexAttribIuiv gl:glGetVertexAttribIuiv
+ALIAS: glGetUniformuiv gl:glGetUniformuiv
+ALIAS: glBindFragDataLocation gl:glBindFragDataLocation
+ALIAS: glGetFragDataLocation gl:glGetFragDataLocation
+ALIAS: glUniform1ui gl:glUniform1ui
+ALIAS: glUniform2ui gl:glUniform2ui
+ALIAS: glUniform3ui gl:glUniform3ui
+ALIAS: glUniform4ui gl:glUniform4ui
+ALIAS: glUniform1uiv gl:glUniform1uiv
+ALIAS: glUniform2uiv gl:glUniform2uiv
+ALIAS: glUniform3uiv gl:glUniform3uiv
+ALIAS: glUniform4uiv gl:glUniform4uiv
+ALIAS: glTexParameterIiv gl:glTexParameterIiv
+ALIAS: glTexParameterIuiv gl:glTexParameterIuiv
+ALIAS: glGetTexParameterIiv gl:glGetTexParameterIiv
+ALIAS: glGetTexParameterIuiv gl:glGetTexParameterIuiv
+ALIAS: glClearBufferiv gl:glClearBufferiv
+ALIAS: glClearBufferuiv gl:glClearBufferuiv
+ALIAS: glClearBufferfv gl:glClearBufferfv
+ALIAS: glClearBufferfi gl:glClearBufferfi
+ALIAS: glGetStringi gl:glGetStringi
+ALIAS: glDrawArraysInstanced gl:glDrawArraysInstanced
+ALIAS: glDrawElementsInstanced gl:glDrawElementsInstanced
+ALIAS: glTexBuffer gl:glTexBuffer
+ALIAS: glPrimitiveRestartIndex gl:glPrimitiveRestartIndex
+ALIAS: glIsRenderbuffer gl:glIsRenderbuffer
+ALIAS: glBindRenderbuffer gl:glBindRenderbuffer
+ALIAS: glDeleteRenderbuffers gl:glDeleteRenderbuffers
+ALIAS: glGenRenderbuffers gl:glGenRenderbuffers
+ALIAS: glRenderbufferStorage gl:glRenderbufferStorage
+ALIAS: glGetRenderbufferParameteriv gl:glGetRenderbufferParameteriv
+ALIAS: glIsFramebuffer gl:glIsFramebuffer
+ALIAS: glBindFramebuffer gl:glBindFramebuffer
+ALIAS: glDeleteFramebuffers gl:glDeleteFramebuffers
+ALIAS: glGenFramebuffers gl:glGenFramebuffers
+ALIAS: glCheckFramebufferStatus gl:glCheckFramebufferStatus
+ALIAS: glFramebufferTexture1D gl:glFramebufferTexture1D
+ALIAS: glFramebufferTexture2D gl:glFramebufferTexture2D
+ALIAS: glFramebufferTexture3D gl:glFramebufferTexture3D
+ALIAS: glFramebufferRenderbuffer gl:glFramebufferRenderbuffer
+ALIAS: glGetFramebufferAttachmentParameteriv gl:glGetFramebufferAttachmentParameteriv
+ALIAS: glGenerateMipmap gl:glGenerateMipmap
+ALIAS: glBlitFramebuffer gl:glBlitFramebuffer
+ALIAS: glRenderbufferStorageMultisample gl:glRenderbufferStorageMultisample
+ALIAS: glFramebufferTextureLayer gl:glFramebufferTextureLayer
+ALIAS: glMapBufferRange gl:glMapBufferRange
+ALIAS: glFlushMappedBufferRange gl:glFlushMappedBufferRange
+ALIAS: glBindVertexArray gl:glBindVertexArray
+ALIAS: glDeleteVertexArrays gl:glDeleteVertexArrays
+ALIAS: glGenVertexArrays gl:glGenVertexArrays
+ALIAS: glIsVertexArray gl:glIsVertexArray
+ALIAS: glGetUniformIndices gl:glGetUniformIndices
+ALIAS: glGetActiveUniformsiv gl:glGetActiveUniformsiv
+ALIAS: glGetActiveUniformName gl:glGetActiveUniformName
+ALIAS: glGetUniformBlockIndex gl:glGetUniformBlockIndex
+ALIAS: glGetActiveUniformBlockiv gl:glGetActiveUniformBlockiv
+ALIAS: glGetActiveUniformBlockName gl:glGetActiveUniformBlockName
+ALIAS: glUniformBlockBinding gl:glUniformBlockBinding
+ALIAS: glCopyBufferSubData gl:glCopyBufferSubData
--- /dev/null
+Forward-compatible subset of OpenGL 3.1
{ $description "Binds texture " { $snippet "id" } " to texture target " { $snippet "target" } " of texture unit " { $snippet "unit" } ". Equivalent to " { $snippet "unit glActiveTexture target id glBindTexture" } "." } ;
HELP: set-draw-buffers
-{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet "GL_BACK" } ", " { $snippet "GL_COLOR_ATTACHMENT0_EXT" } ")"} }
+{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet "GL_BACK" } ", " { $snippet "GL_COLOR_ATTACHMENT0" } ")"} }
{ $description "Wrapper for " { $link glDrawBuffers } ". Sets up the buffers named in the sequence for simultaneous drawing." } ;
HELP: do-attribs
: (gen-gl-object) ( quot -- id )
[ 1 0 <uint> ] dip keep *uint ; inline
-: gen-gl-buffer ( -- id )
- [ glGenBuffers ] (gen-gl-object) ;
-
: (delete-gl-object) ( id quot -- )
[ 1 swap <uint> ] dip call ; inline
+: gen-gl-buffer ( -- id )
+ [ glGenBuffers ] (gen-gl-object) ;
+
: delete-gl-buffer ( id -- )
[ glDeleteBuffers ] (delete-gl-object) ;
GL_ARRAY_BUFFER swap _ with-gl-buffer
] with-gl-buffer ; inline
+: gen-vertex-array ( -- id )
+ [ glGenVertexArrays ] (gen-gl-object) ;
+
+: delete-vertex-array ( id -- )
+ [ glDeleteVertexArrays ] (delete-gl-object) ;
+
+:: with-vertex-array ( id quot -- )
+ id glBindVertexArray
+ quot [ 0 glBindVertexArray ] [ ] cleanup ; inline
+
: <gl-buffer> ( target data hint -- id )
pick gen-gl-buffer [
[
glCreateProgram
[
[ swap [ glAttachShader ] with each ]
- [ swap [ first2 swap glBindFragDataLocationEXT ] with each ] bi-curry bi*
+ [ swap [ first2 swap glBindFragDataLocation ] with each ] bi-curry bi*
]
[ glLinkProgram ]
[ ] tri
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test opengl.textures opengl.textures.private
-images kernel namespaces accessors sequences ;
+USING: tools.test opengl.gl opengl.textures opengl.textures.private
+images kernel namespaces accessors sequences literals ;
IN: opengl.textures.tests
[
{ { 10 30 } { 30 300 } }
}
[ [ image new swap >>dim ] map ] map image-locs
-] unit-test
\ No newline at end of file
+] unit-test
+
+${ GL_RGBA8 GL_RGBA GL_UNSIGNED_BYTE }
+[ RGBA ubyte-components (image-format) ] unit-test
+
+${ GL_RGBA8 GL_BGRA GL_UNSIGNED_BYTE }
+[ BGRA ubyte-components (image-format) ] unit-test
+
+${ GL_RGBA8 GL_BGRA GL_UNSIGNED_INT_8_8_8_8_REV }
+[ ARGB ubyte-components (image-format) ] unit-test
+
+${ GL_RGBA32F GL_RGBA GL_FLOAT }
+[ RGBA float-components (image-format) ] unit-test
+
+${ GL_RGBA32UI GL_BGRA_INTEGER GL_UNSIGNED_INT }
+[ BGRA uint-integer-components (image-format) ] unit-test
+
+${ GL_RGB9_E5 GL_RGB GL_UNSIGNED_INT_5_9_9_9_REV }
+[ BGR u-9-9-9-e5-components (image-format) ] unit-test
+
+${ GL_R11F_G11F_B10F GL_RGB GL_UNSIGNED_INT_10F_11F_11F_REV }
+[ BGR float-11-11-10-components (image-format) ] unit-test
opengl opengl.gl opengl.capabilities combinators images
images.tesselation grouping specialized-arrays.float sequences math
math.vectors math.matrices generalizations fry arrays namespaces
-system locals ;
+system locals literals ;
IN: opengl.textures
SYMBOL: non-power-of-2-textures?
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
-GENERIC: component-type>type ( component-type -- internal-format type )
-GENERIC: component-order>format ( type component-order -- type format )
-GENERIC: component-order>integer-format ( type component-order -- type format )
-
-ERROR: unsupported-component-order component-order ;
-
-M: ubyte-components component-type>type drop GL_RGBA8 GL_UNSIGNED_BYTE ;
-M: ushort-components component-type>type drop GL_RGBA16 GL_UNSIGNED_SHORT ;
-M: half-components component-type>type drop GL_RGBA16F_ARB GL_HALF_FLOAT_ARB ;
-M: float-components component-type>type drop GL_RGBA32F_ARB GL_FLOAT ;
-M: byte-integer-components component-type>type drop GL_RGBA8I_EXT GL_BYTE ;
-M: short-integer-components component-type>type drop GL_RGBA16I_EXT GL_SHORT ;
-M: int-integer-components component-type>type drop GL_RGBA32I_EXT GL_INT ;
-M: ubyte-integer-components component-type>type drop GL_RGBA8I_EXT GL_UNSIGNED_BYTE ;
-M: ushort-integer-components component-type>type drop GL_RGBA16I_EXT GL_UNSIGNED_SHORT ;
-M: uint-integer-components component-type>type drop GL_RGBA32I_EXT GL_UNSIGNED_INT ;
-
-M: RGB component-order>format drop GL_RGB ;
-M: BGR component-order>format drop GL_BGR ;
-M: RGBA component-order>format drop GL_RGBA ;
-M: ARGB component-order>format
- swap GL_UNSIGNED_BYTE =
- [ drop GL_UNSIGNED_INT_8_8_8_8_REV GL_BGRA ]
- [ unsupported-component-order ] if ;
-M: BGRA component-order>format drop GL_BGRA ;
-M: BGRX component-order>format drop GL_BGRA ;
-M: LA component-order>format drop GL_LUMINANCE_ALPHA ;
-M: L component-order>format drop GL_LUMINANCE ;
+ERROR: unsupported-component-order component-order component-type ;
+
+CONSTANT: image-internal-formats H{
+ { { A ubyte-components } $ GL_ALPHA8 }
+ { { A ushort-components } $ GL_ALPHA16 }
+ { { A half-components } $ GL_ALPHA16F_ARB }
+ { { A float-components } $ GL_ALPHA32F_ARB }
+ { { A byte-integer-components } $ GL_ALPHA8I_EXT }
+ { { A ubyte-integer-components } $ GL_ALPHA8UI_EXT }
+ { { A short-integer-components } $ GL_ALPHA16I_EXT }
+ { { A ushort-integer-components } $ GL_ALPHA16UI_EXT }
+ { { A int-integer-components } $ GL_ALPHA32I_EXT }
+ { { A uint-integer-components } $ GL_ALPHA32UI_EXT }
+
+ { { L ubyte-components } $ GL_LUMINANCE8 }
+ { { L ushort-components } $ GL_LUMINANCE16 }
+ { { L half-components } $ GL_LUMINANCE16F_ARB }
+ { { L float-components } $ GL_LUMINANCE32F_ARB }
+ { { L byte-integer-components } $ GL_LUMINANCE8I_EXT }
+ { { L ubyte-integer-components } $ GL_LUMINANCE8UI_EXT }
+ { { L short-integer-components } $ GL_LUMINANCE16I_EXT }
+ { { L ushort-integer-components } $ GL_LUMINANCE16UI_EXT }
+ { { L int-integer-components } $ GL_LUMINANCE32I_EXT }
+ { { L uint-integer-components } $ GL_LUMINANCE32UI_EXT }
+
+ { { R ubyte-components } $ GL_R8 }
+ { { R ushort-components } $ GL_R16 }
+ { { R half-components } $ GL_R16F }
+ { { R float-components } $ GL_R32F }
+ { { R byte-integer-components } $ GL_R8I }
+ { { R ubyte-integer-components } $ GL_R8UI }
+ { { R short-integer-components } $ GL_R16I }
+ { { R ushort-integer-components } $ GL_R16UI }
+ { { R int-integer-components } $ GL_R32I }
+ { { R uint-integer-components } $ GL_R32UI }
+
+ { { INTENSITY ubyte-components } $ GL_INTENSITY8 }
+ { { INTENSITY ushort-components } $ GL_INTENSITY16 }
+ { { INTENSITY half-components } $ GL_INTENSITY16F_ARB }
+ { { INTENSITY float-components } $ GL_INTENSITY32F_ARB }
+ { { INTENSITY byte-integer-components } $ GL_INTENSITY8I_EXT }
+ { { INTENSITY ubyte-integer-components } $ GL_INTENSITY8UI_EXT }
+ { { INTENSITY short-integer-components } $ GL_INTENSITY16I_EXT }
+ { { INTENSITY ushort-integer-components } $ GL_INTENSITY16UI_EXT }
+ { { INTENSITY int-integer-components } $ GL_INTENSITY32I_EXT }
+ { { INTENSITY uint-integer-components } $ GL_INTENSITY32UI_EXT }
+
+ { { DEPTH ushort-components } $ GL_DEPTH_COMPONENT16 }
+ { { DEPTH u-24-components } $ GL_DEPTH_COMPONENT24 }
+ { { DEPTH uint-components } $ GL_DEPTH_COMPONENT32 }
+ { { DEPTH float-components } $ GL_DEPTH_COMPONENT32F }
+
+ { { LA ubyte-components } $ GL_LUMINANCE8_ALPHA8 }
+ { { LA ushort-components } $ GL_LUMINANCE16_ALPHA16 }
+ { { LA half-components } $ GL_LUMINANCE_ALPHA16F_ARB }
+ { { LA float-components } $ GL_LUMINANCE_ALPHA32F_ARB }
+ { { LA byte-integer-components } $ GL_LUMINANCE_ALPHA8I_EXT }
+ { { LA ubyte-integer-components } $ GL_LUMINANCE_ALPHA8UI_EXT }
+ { { LA short-integer-components } $ GL_LUMINANCE_ALPHA16I_EXT }
+ { { LA ushort-integer-components } $ GL_LUMINANCE_ALPHA16UI_EXT }
+ { { LA int-integer-components } $ GL_LUMINANCE_ALPHA32I_EXT }
+ { { LA uint-integer-components } $ GL_LUMINANCE_ALPHA32UI_EXT }
+
+ { { RG ubyte-components } $ GL_RG8 }
+ { { RG ushort-components } $ GL_RG16 }
+ { { RG half-components } $ GL_RG16F }
+ { { RG float-components } $ GL_RG32F }
+ { { RG byte-integer-components } $ GL_RG8I }
+ { { RG ubyte-integer-components } $ GL_RG8UI }
+ { { RG short-integer-components } $ GL_RG16I }
+ { { RG ushort-integer-components } $ GL_RG16UI }
+ { { RG int-integer-components } $ GL_RG32I }
+ { { RG uint-integer-components } $ GL_RG32UI }
+
+ { { DEPTH-STENCIL u-24-8-components } $ GL_DEPTH24_STENCIL8 }
+ { { DEPTH-STENCIL float-32-u-8-components } $ GL_DEPTH32F_STENCIL8 }
+
+ { { RGB ubyte-components } $ GL_RGB8 }
+ { { RGB ushort-components } $ GL_RGB16 }
+ { { RGB half-components } $ GL_RGB16F }
+ { { RGB float-components } $ GL_RGB32F }
+ { { RGB byte-integer-components } $ GL_RGB8I }
+ { { RGB ubyte-integer-components } $ GL_RGB8UI }
+ { { RGB byte-integer-components } $ GL_RGB8I }
+ { { RGB ubyte-integer-components } $ GL_RGB8UI }
+ { { RGB short-integer-components } $ GL_RGB16I }
+ { { RGB ushort-integer-components } $ GL_RGB16UI }
+ { { RGB int-integer-components } $ GL_RGB32I }
+ { { RGB uint-integer-components } $ GL_RGB32UI }
+ { { RGB u-5-6-5-components } $ GL_RGB5 }
+ { { RGB u-9-9-9-e5-components } $ GL_RGB9_E5 }
+ { { RGB float-11-11-10-components } $ GL_R11F_G11F_B10F }
+
+ { { RGBA ubyte-components } $ GL_RGBA8 }
+ { { RGBA ushort-components } $ GL_RGBA16 }
+ { { RGBA half-components } $ GL_RGBA16F }
+ { { RGBA float-components } $ GL_RGBA32F }
+ { { RGBA byte-integer-components } $ GL_RGBA8I }
+ { { RGBA ubyte-integer-components } $ GL_RGBA8UI }
+ { { RGBA byte-integer-components } $ GL_RGBA8I }
+ { { RGBA ubyte-integer-components } $ GL_RGBA8UI }
+ { { RGBA short-integer-components } $ GL_RGBA16I }
+ { { RGBA ushort-integer-components } $ GL_RGBA16UI }
+ { { RGBA int-integer-components } $ GL_RGBA32I }
+ { { RGBA uint-integer-components } $ GL_RGBA32UI }
+ { { RGBA u-5-5-5-1-components } $ GL_RGB5_A1 }
+ { { RGBA u-10-10-10-2-components } $ GL_RGB10_A2 }
+}
+
+GENERIC: fix-internal-component-order ( order -- order' )
+
+M: object fix-internal-component-order ;
+M: BGR fix-internal-component-order drop RGB ;
+M: BGRA fix-internal-component-order drop RGBA ;
+M: ARGB fix-internal-component-order drop RGBA ;
+M: ABGR fix-internal-component-order drop RGBA ;
+M: RGBX fix-internal-component-order drop RGBA ;
+M: BGRX fix-internal-component-order drop RGBA ;
+M: XRGB fix-internal-component-order drop RGBA ;
+M: XBGR fix-internal-component-order drop RGBA ;
+
+: image-internal-format ( component-order component-type -- internal-format )
+ 2dup
+ [ fix-internal-component-order ] dip 2array image-internal-formats at
+ [ 2nip ] [ unsupported-component-order ] if* ;
+
+: reversed-type? ( component-type -- ? )
+ { u-9-9-9-e5-components float-11-11-10-components } member? ;
+
+: (component-order>format) ( component-order component-type -- gl-format )
+ dup unnormalized-integer-components? [
+ swap {
+ { A [ drop GL_ALPHA_INTEGER_EXT ] }
+ { L [ drop GL_LUMINANCE_INTEGER_EXT ] }
+ { R [ drop GL_RED_INTEGER ] }
+ { LA [ drop GL_LUMINANCE_ALPHA_INTEGER_EXT ] }
+ { RG [ drop GL_RG_INTEGER ] }
+ { BGR [ drop GL_BGR_INTEGER ] }
+ { RGB [ drop GL_RGB_INTEGER ] }
+ { BGRA [ drop GL_BGRA_INTEGER ] }
+ { RGBA [ drop GL_RGBA_INTEGER ] }
+ { BGRX [ drop GL_BGRA_INTEGER ] }
+ { RGBX [ drop GL_RGBA_INTEGER ] }
+ [ swap unsupported-component-order ]
+ } case
+ ] [
+ swap {
+ { A [ drop GL_ALPHA ] }
+ { L [ drop GL_LUMINANCE ] }
+ { R [ drop GL_RED ] }
+ { LA [ drop GL_LUMINANCE_ALPHA ] }
+ { RG [ drop GL_RG ] }
+ { BGR [ reversed-type? GL_RGB GL_BGR ? ] }
+ { RGB [ reversed-type? GL_BGR GL_RGB ? ] }
+ { BGRA [ drop GL_BGRA ] }
+ { RGBA [ drop GL_RGBA ] }
+ { ARGB [ drop GL_BGRA ] }
+ { ABGR [ drop GL_RGBA ] }
+ { BGRX [ drop GL_BGRA ] }
+ { RGBX [ drop GL_RGBA ] }
+ { XRGB [ drop GL_BGRA ] }
+ { XBGR [ drop GL_RGBA ] }
+ { INTENSITY [ drop GL_INTENSITY ] }
+ { DEPTH [ drop GL_DEPTH_COMPONENT ] }
+ { DEPTH-STENCIL [ drop GL_DEPTH_STENCIL ] }
+ [ swap unsupported-component-order ]
+ } case
+ ] if ;
-M: object component-order>format unsupported-component-order ;
+GENERIC: (component-type>type) ( component-order component-type -- gl-type )
-M: RGB component-order>integer-format drop GL_RGB_INTEGER_EXT ;
-M: BGR component-order>integer-format drop GL_BGR_INTEGER_EXT ;
-M: RGBA component-order>integer-format drop GL_RGBA_INTEGER_EXT ;
-M: BGRA component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
-M: BGRX component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
-M: LA component-order>integer-format drop GL_LUMINANCE_ALPHA_INTEGER_EXT ;
-M: L component-order>integer-format drop GL_LUMINANCE_INTEGER_EXT ;
+M: object (component-type>type) unsupported-component-order ;
-M: object component-order>integer-format unsupported-component-order ;
+: four-channel-alpha-first? ( component-order component-type -- ? )
+ over component-count 4 =
+ [ drop alpha-channel-precedes-colors? ]
+ [ unsupported-component-order ] if ;
+
+: not-alpha-first ( component-order component-type -- )
+ over alpha-channel-precedes-colors?
+ [ unsupported-component-order ]
+ [ 2drop ] if ;
+
+M: ubyte-components (component-type>type)
+ drop alpha-channel-precedes-colors?
+ [ GL_UNSIGNED_INT_8_8_8_8_REV ]
+ [ GL_UNSIGNED_BYTE ] if ;
+
+M: ushort-components (component-type>type) not-alpha-first GL_UNSIGNED_SHORT ;
+M: uint-components (component-type>type) not-alpha-first GL_UNSIGNED_INT ;
+M: half-components (component-type>type) not-alpha-first GL_HALF_FLOAT ;
+M: float-components (component-type>type) not-alpha-first GL_FLOAT ;
+M: byte-integer-components (component-type>type) not-alpha-first GL_BYTE ;
+M: ubyte-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_BYTE ;
+M: short-integer-components (component-type>type) not-alpha-first GL_SHORT ;
+M: ushort-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_SHORT ;
+M: int-integer-components (component-type>type) not-alpha-first GL_INT ;
+M: uint-integer-components (component-type>type) not-alpha-first GL_UNSIGNED_INT ;
+
+M: u-5-5-5-1-components (component-type>type)
+ four-channel-alpha-first?
+ [ GL_UNSIGNED_SHORT_1_5_5_5_REV ]
+ [ GL_UNSIGNED_SHORT_5_5_5_1 ] if ;
+
+M: u-5-6-5-components (component-type>type) 2drop GL_UNSIGNED_SHORT_5_6_5 ;
+
+M: u-10-10-10-2-components (component-type>type)
+ four-channel-alpha-first?
+ [ GL_UNSIGNED_INT_2_10_10_10_REV ]
+ [ GL_UNSIGNED_INT_10_10_10_2 ] if ;
+
+M: u-24-components (component-type>type)
+ over DEPTH =
+ [ 2drop GL_UNSIGNED_INT ] [ unsupported-component-order ] if ;
+
+M: u-24-8-components (component-type>type)
+ over DEPTH-STENCIL =
+ [ 2drop GL_UNSIGNED_INT_24_8 ] [ unsupported-component-order ] if ;
+
+M: u-9-9-9-e5-components (component-type>type)
+ over BGR =
+ [ 2drop GL_UNSIGNED_INT_5_9_9_9_REV ] [ unsupported-component-order ] if ;
+
+M: float-11-11-10-components (component-type>type)
+ over BGR =
+ [ 2drop GL_UNSIGNED_INT_10F_11F_11F_REV ] [ unsupported-component-order ] if ;
+
+: image-data-format ( component-order component-type -- gl-format gl-type )
+ [ (component-order>format) ] [ (component-type>type) ] 2bi ;
SLOT: display-list
DEFER: make-texture
+: (image-format) ( component-order component-type -- internal-format format type )
+ [ image-internal-format ] [ image-data-format ] 2bi ;
+
+: image-format ( image -- internal-format format type )
+ [ component-order>> ] [ component-type>> ] bi (image-format) ;
+
<PRIVATE
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
[ dup 1 = [ next-power-of-2 ] unless ] map
] unless ;
-: image-format ( image -- internal-format format type )
- dup component-type>>
- [ nip component-type>type ]
- [
- unnormalized-integer-components?
- [ component-order>> component-order>integer-format ]
- [ component-order>> component-order>format ] if
- ] 2bi swap ;
-
:: tex-image ( image bitmap -- )
image image-format :> type :> format :> internal-format
GL_TEXTURE_2D 0 internal-format
[ "Hi" ] [ "Hi" present ] unit-test
[ "+" ] [ \ + present ] unit-test
[ "kernel" ] [ "kernel" vocab present ] unit-test
-[ ] [ all-vocabs-seq [ present ] map drop ] unit-test
\ No newline at end of file
+[ ] [ all-vocabs-recursive no-roots no-prefixes [ present ] map drop ] unit-test
\ No newline at end of file
USE: specialized-arrays.functor
IN: specialized-arrays.alien
-<< "void*" define-array >>
\ No newline at end of file
+<< "void*" define-array >>
+<< "ptrdiff_t" define-array >>
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: functors sequences sequences.private growable
prettyprint.custom kernel words classes math parser ;
+QUALIFIED: vectors.functor
IN: specialized-vectors.functor
FUNCTOR: define-vector ( T -- )
+V DEFINES-CLASS ${T}-vector
+
A IS ${T}-array
<A> IS <${A}>
-V DEFINES-CLASS ${T}-vector
-<V> DEFINES <${V}>
->V DEFINES >${V}
+>V DEFERS >${V}
V{ DEFINES ${V}{
WHERE
-TUPLE: V { underlying A } { length array-capacity } ;
-
-: <V> ( capacity -- vector ) <A> 0 V boa ; inline
-
-M: V like
- drop dup V instance? [
- dup A instance? [ dup length V boa ] [ >V ] if
- ] unless ;
-
-M: V new-sequence drop [ <A> ] [ >fixnum ] bi V boa ;
-
-M: A new-resizable drop <V> ;
-
-M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
+V A <A> vectors.functor:define-vector
-: >V ( seq -- vector ) V new clone-like ; inline
+M: V contract 2drop ;
M: V pprint-delims drop \ V{ \ } ;
IN: struct-arrays.tests
USING: struct-arrays tools.test kernel math sequences
-alien.syntax alien.c-types destructors libc accessors ;
+alien.syntax alien.c-types destructors libc accessors sequences.private ;
C-STRUCT: test-struct
{ "int" "x" }
10 "test-struct" malloc-struct-array
&free drop
] with-destructors
-] unit-test
\ No newline at end of file
+] unit-test
+
+[ 15 ] [ 15 10 "test-struct" <struct-array> resize length ] unit-test
\ No newline at end of file
{ element-size array-capacity read-only } ;
M: struct-array length length>> ;
+M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ;
M: struct-array nth-unsafe
[ element-size>> * ] [ underlying>> ] bi <displaced-alien> ;
M: struct-array new-sequence
element-size>> [ * <byte-array> ] 2keep struct-array boa ; inline
+M: struct-array resize ( n seq -- newseq )
+ [ [ element-size>> * ] [ underlying>> ] bi resize ] [ element-size>> ] 2bi
+ struct-array boa ;
+
: <struct-array> ( length c-type -- struct-array )
heap-size [ * <byte-array> ] 2keep struct-array boa ; inline
--- /dev/null
+IN: struct-vectors
+USING: help.markup help.syntax alien strings math ;
+
+HELP: struct-vector
+{ $class-description "The class of growable C struct and union arrays." } ;
+
+HELP: <struct-vector>
+{ $values { "capacity" integer } { "c-type" string } { "struct-vector" struct-vector } }
+{ $description "Creates a new vector with the given initial capacity." } ;
+
+ARTICLE: "struct-vectors" "C struct and union vectors"
+"The " { $vocab-link "struct-vectors" } " vocabulary implements vectors specialized for holding C struct and union values. These are growable versions of " { $vocab-link "struct-arrays" } "."
+{ $subsection struct-vector }
+{ $subsection <struct-vector> } ;
+
+ABOUT: "struct-vectors"
--- /dev/null
+IN: struct-vectors.tests
+USING: struct-vectors tools.test alien.c-types alien.syntax
+namespaces kernel sequences ;
+
+C-STRUCT: point
+ { "float" "x" }
+ { "float" "y" } ;
+
+: make-point ( x y -- point )
+ "point" <c-object>
+ [ set-point-y ] keep
+ [ set-point-x ] keep ;
+
+[ ] [ 1 "point" <struct-vector> "v" set ] unit-test
+
+[ 1.5 6.0 ] [
+ 1.0 2.0 make-point "v" get push
+ 3.0 4.5 make-point "v" get push
+ 1.5 6.0 make-point "v" get push
+ "v" get pop [ point-x ] [ point-y ] bi
+] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types byte-arrays growable kernel math sequences
+sequences.private struct-arrays ;
+IN: struct-vectors
+
+TUPLE: struct-vector
+{ underlying struct-array }
+{ length array-capacity }
+{ c-type read-only } ;
+
+: <struct-vector> ( capacity c-type -- struct-vector )
+ [ <struct-array> 0 ] keep struct-vector boa ; inline
+
+M: struct-vector byte-length underlying>> byte-length ;
+M: struct-vector new-sequence
+ [ c-type>> <struct-array> ] [ [ >fixnum ] [ c-type>> ] bi* ] 2bi
+ struct-vector boa ;
+
+M: struct-vector contract 2drop ;
+
+M: struct-array new-resizable c-type>> <struct-vector> ;
+
+INSTANCE: struct-vector growable
--- /dev/null
+
+: spill-integer-base ( -- n )
+ stack-frame get spill-counts>> double-float-regs swap at
+ double-float-regs reg-size * ;
+
+: spill-integer@ ( n -- offset )
+ cells spill-integer-base + param@ ;
+
+: spill-float@ ( n -- offset )
+ double-float-regs reg-size * param@ ;
+
+: (stack-frame-size) ( stack-frame -- n )
+ [
+ {
+ [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
+ [ gc-roots>> cells ]
+ [ params>> ]
+ [ return>> ]
+ } cleave
+ ] sum-outputs ;
\ No newline at end of file
: thread-registered? ( thread -- ? )
id>> threads key? ;
+ERROR: already-stopped thread ;
+
: check-unregistered ( thread -- thread )
- dup thread-registered?
- [ "Thread already stopped" throw ] when ;
+ dup thread-registered? [ already-stopped ] when ;
+
+ERROR: not-running thread ;
: check-registered ( thread -- thread )
- dup thread-registered?
- [ "Thread is not running" throw ] unless ;
+ dup thread-registered? [ not-running ] unless ;
<PRIVATE
[ ] [ M\ string blah-generic watch ] unit-test
[ "hi" ] [ "hi" blah-generic ] unit-test
+
+! See how well watch interacts with optimizations.
+GENERIC: my-generic ( a -- b )
+M: object my-generic ;
+
+\ my-generic watch
+
+: some-code ( -- )
+ f my-generic drop ;
+
+[ ] [ some-code ] unit-test
\ No newline at end of file
USING: accessors kernel math sorting words parser io summary
quotations sequences prettyprint continuations effects
definitions compiler.units namespaces assocs tools.walker
-tools.time generic inspector fry tools.continuations ;
+tools.time generic inspector fry tools.continuations
+locals generalizations macros ;
IN: tools.annotations
GENERIC: reset ( word -- )
<PRIVATE
-: stack-values ( names -- alist )
- [ datastack ] dip [ nip ] [ length tail* ] 2bi zip ;
-
-: trace-message ( word quot str -- )
- "--- " write write bl over .
- [ stack-effect ] dip '[ @ stack-values ] [ f ] if*
- [ simple-table. ] unless-empty flush ; inline
+:: trace-quot ( word effect quot str -- quot' )
+ effect quot call :> values
+ values length :> n
+ [
+ "--- " write str write bl word .
+ n ndup n narray values swap zip simple-table.
+ flush
+ ] ; inline
-: entering ( str -- ) [ in>> ] "Entering" trace-message ;
+MACRO: entering ( word -- quot )
+ dup stack-effect [ in>> ] "Entering" trace-quot ;
-: leaving ( str -- ) [ out>> ] "Leaving" trace-message ;
+MACRO: leaving ( word -- quot )
+ dup stack-effect [ out>> ] "Leaving" trace-quot ;
: (watch) ( word def -- def )
over '[ _ entering @ _ leaving ] ;
all-words name-completions ;
: vocabs-matching ( str -- seq )
- all-vocabs-seq name-completions ;
+ all-vocabs-recursive no-roots no-prefixes name-completions ;
: chars-matching ( str -- seq )
name-map keys dup zip completions ;
[ nip require ]
} 2cleave ;
+: scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ;
+
+: scaffold-basis ( string -- ) "resource:basis" swap scaffold-vocab ;
+
+: scaffold-extra ( string -- ) "resource:extra" swap scaffold-vocab ;
+
+: scaffold-work ( string -- ) "resource:work" swap scaffold-vocab ;
+
<PRIVATE
: tests-file-string ( vocab -- string )
HOOK: offscreen-pixels ui-backend ( world -- alien w h )
-: with-gl-context ( handle quot -- )
- '[ select-gl-context @ ]
- [ flush-gl-context gl-error ] bi ; inline
-
HOOK: (with-ui) ui-backend ( quot -- )
HOOK: (grab-input) ui-backend ( handle -- )
] [ drop ] if ;
: end-selection ( pane -- )
- f >>selecting?
- hand-moved?
+ dup selecting?>> hand-moved? or
+ [ f >>selecting? ] dip
[ [ com-copy-selection ] [ request-focus ] bi ]
[ [ relayout-1 ] [ focus-input ] bi ]
if ;
if ;
: row-action? ( table -- ? )
- [ [ mouse-row ] keep valid-line? ]
- [ single-click?>> hand-click# get 2 = or ] bi and ;
+ single-click?>> hand-click# get 2 = or ;
<PRIVATE
: table-button-up ( table -- )
- dup row-action? [ row-action ] [ update-selected-value ] if ;
+ dup [ mouse-row ] keep valid-line? [
+ dup row-action? [ row-action ] [ update-selected-value ] if
+ ] [ drop ] if ;
PRIVATE>
USING: ui.gadgets ui.render ui.text ui.text.private
ui.gestures ui.backend help.markup help.syntax
-models opengl sequences strings ;
+models opengl sequences strings destructors ;
IN: ui.gadgets.worlds
HELP: user-input
{ $description "Sets the title bar of the native window containing the world." }
{ $notes "This word should not be called directly by user code. Instead, change the " { $snippet "title" } " slot model; see " { $link "models" } "." } ;
-HELP: select-gl-context
-{ $values { "handle" "a backend-specific handle" } }
+HELP: context-world
+{ $var-description "Holds the " { $link world } " whose OpenGL context was most recently made active by " { $link set-gl-context } "." } ;
+
+HELP: set-gl-context
+{ $values { "world" world } }
{ $description "Selects an OpenGL context to be the implicit destination for subsequent GL rendering calls. This word is called automatically by the UI before drawing a " { $link world } "." } ;
+HELP: window-resource
+{ $values { "resource" disposable } { "resource" disposable } }
+{ $description "Marks " { $snippet "resource" } " to be destroyed with " { $link dispose } " when the window with the currently active OpenGL context (set by " { $link set-gl-context } ") is closed. " { $snippet "resource" } " is left unmodified at the top of the stack." } ;
+
HELP: flush-gl-context
{ $values { "handle" "a backend-specific handle" } }
{ $description "Ensures all GL rendering calls made to an OpenGL context finish rendering to the screen. This word is called automatically by the UI after drawing a " { $link world } "." } ;
text-handle handle images
window-loc
pixel-format-attributes
- window-controls ;
+ window-controls
+ window-resources ;
TUPLE: world-attributes
{ world-class initial: world }
'[ f _ [ (>>status-owner) ] [ status>> set-model ] 2bi ] when
] [ 2drop ] if ;
+SYMBOL: context-world
+
+: window-resource ( resource -- resource )
+ dup context-world get-global window-resources>> push ;
+
+: set-gl-context ( world -- )
+ [ context-world set-global ]
+ [ handle>> select-gl-context ] bi ;
+
+: with-gl-context ( world quot -- )
+ '[ set-gl-context @ ]
+ [ handle>> flush-gl-context gl-error ] bi ; inline
+
ERROR: no-world-found ;
: find-gl-context ( gadget -- )
find-world dup
- [ handle>> select-gl-context ] [ no-world-found ] if ;
+ [ set-gl-context ] [ no-world-found ] if ;
: (request-focus) ( child world ? -- )
pick parent>> pick eq? [
t >>root?
f >>active?
{ 0 0 } >>window-loc
- f >>grab-input? ;
+ f >>grab-input?
+ V{ } clone >>window-resources ;
: apply-world-attributes ( world attributes -- world )
{
[ call-next-method ]
[
dup handle>>
- [ select-gl-context resize-world ]
- [ drop ] if*
+ [ [ set-gl-context ] [ resize-world ] bi ]
+ [ drop ] if
] bi ;
GENERIC: draw-world* ( world -- )
dup draw-world? [
dup world [
[
- dup handle>> [ draw-world* ] with-gl-context
+ dup [ draw-world* ] with-gl-context
flush-layout-cache-hook get call( -- )
] [
over <world-error> ui-error
M: word-completion row-color
[ vocabulary>> ] [ manifest>> ] bi* {
+ { [ dup not ] [ COLOR: black ] }
{ [ 2dup search-vocabs>> memq? ] [ COLOR: black ] }
{ [ over ".private" tail? ] [ COLOR: dark-red ] }
[ COLOR: dark-gray ]
[ ] [ "h" get history-recall-previous ] unit-test
[ "22" ] [ "d" get doc-string ] unit-test
+
+[ ] [ <document> "d" set ] unit-test
+[ ] [ "d" get <history> "h" set ] unit-test
+
+[ ] [ "aaa" "d" get set-doc-string ] unit-test
+[ T{ input f "aaa" } ] [ "h" get history-add ] unit-test
+
+[ ] [ "" "d" get set-doc-string ] unit-test
+[ T{ input f "" } ] [ "h" get history-add ] unit-test
+[ T{ input f "" } ] [ "h" get history-add ] unit-test
+[ ] [ " " "d" get set-doc-string ] unit-test
+[ ] [ "h" get history-recall-previous ] unit-test
+
<PRIVATE
+: (save-history) ( input index elements -- )
+ 2dup length > [
+ [ [ T{ input f "" } ] dip push ] keep
+ (save-history)
+ ] [ set-nth ] if ;
+
: save-history ( history -- )
[ document>> doc-string ] keep
- '[ <input> _ [ index>> ] [ elements>> ] bi set-nth ]
+ '[ <input> _ [ index>> ] [ elements>> ] bi (save-history) ]
unless-empty ;
: update-document ( history -- )
} define-command-map
tool "common" f {
- { T{ key-down f { A+ } "s" } save }
{ T{ key-down f { A+ } "w" } close-window }
{ T{ key-down f { A+ } "q" } com-exit }
{ T{ key-down f f "F2" } refresh-all }
: set-up-window ( world -- )
{
- [ handle>> select-gl-context ]
+ [ set-gl-context ]
[ [ title>> ] keep set-title ]
[ begin-world ]
[ resize-world ]
: (ungraft-world) ( world -- )
{
- [ handle>> select-gl-context ]
+ [ set-gl-context ]
[ text-handle>> [ dispose ] when* ]
[ images>> [ dispose ] when* ]
[ hand-clicked close-global ]
[ hand-gadget close-global ]
[ end-world ]
+ [ [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ]
} cleave ;
M: world ungraft*
"The " { $vocab-link "unicode.breaks" "unicode.breaks" } " vocabulary partially implements Unicode Standard Annex #29. This provides for segmentation of a string along grapheme and word boundaries. In Unicode, a grapheme, or a basic unit of display in text, may be more than one code point. For example, in the string \"e\\u000301\" (where U+0301 is a combining acute accent), there is only one grapheme, as the acute accent goes above the e, forming a single grapheme. Word breaks, in general, are more complicated than simply splitting by whitespace, and the Unicode algorithm provides for that."
$nl "Operations for graphemes:"
{ $subsection first-grapheme }
+{ $subsection first-grapheme-from }
{ $subsection last-grapheme }
+{ $subsection last-grapheme-from }
{ $subsection >graphemes }
{ $subsection string-reverse }
"Operations on words:"
{ $subsection first-word }
+{ $subsection first-word-from }
+{ $subsection last-word }
+{ $subsection last-word-from }
{ $subsection >words } ;
HELP: first-grapheme
{ $values { "str" string } { "i" "an index" } }
{ $description "Finds the index of the start of the last grapheme of the string. This can be used to traverse the graphemes of a string backwards." } ;
+HELP: first-grapheme-from
+{ $values { "start" "an index" } { "str" string } { "i" "an index" } }
+{ $description "Finds the length of the first grapheme of the string, starting from the given index. This can be used repeatedly to efficiently traverse the graphemes of the string, using slices." } ;
+
+HELP: last-grapheme-from
+{ $values { "end" "an index" } { "str" string } { "i" "an index" } }
+{ $description "Finds the index of the start of the last grapheme of the string, starting from the given index. This can be used to traverse the graphemes of a string backwards." } ;
+
HELP: >graphemes
{ $values { "str" string } { "graphemes" "an array of strings" } }
{ $description "Divides a string into a sequence of individual graphemes." } ;
HELP: first-word
{ $values { "str" string } { "i" "index" } }
-{ $description "Finds the length of the first word in the string." } ;
+{ $description "Finds the index of the end of the first word in the string." } ;
+
+HELP: last-word
+{ $values { "str" string } { "i" "index" } }
+{ $description "Finds the index of the beginning of the last word in the string." } ;
+
+HELP: first-word-from
+{ $values { "start" "index" } { "str" string } { "i" "index" } }
+{ $description "Finds the index of the end of the first word in the string, starting from the given index." } ;
+
+HELP: last-word-from
+{ $values { "end" "index" } { "str" string } { "i" "index" } }
+{ $description "Finds the index of the start of the word that the index is contained in." } ;
HELP: >words
{ $values { "str" string } { "words" "an array of strings" } }
[ 3 ] [ 2 "hello" first-grapheme-from ] unit-test
[ 1 ] [ 2 "hello" last-grapheme-from ] unit-test
+[ 4 ] [ 2 "what am I saying" first-word-from ] unit-test
+[ 0 ] [ 2 "what am I saying" last-word-from ] unit-test
+[ 16 ] [ 11 "what am I saying" first-word-from ] unit-test
+[ 10 ] [ 11 "what am I saying" last-word-from ] unit-test
+
: grapheme-break-test ( -- filename )
"vocab:unicode/breaks/GraphemeBreakTest.txt" ;
word-break-next nip
]
} 2|| ;
+
+: first-word-from ( start str -- i )
+ over tail-slice first-word + ;
+
+: last-word ( str -- i )
+ [ length ] keep '[ _ word-break-at? ] find-last drop 0 or ;
+
+: last-word-from ( end str -- i )
+ swap head-slice last-word ;
: push-utf8 ( ch -- )
1string utf8 encode
- [ CHAR: % , >hex 2 CHAR: 0 pad-head % ] each ;
+ [ CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ] each ;
PRIVATE>
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: functors sequences sequences.private growable
+kernel words classes math parser ;
+IN: vectors.functor
+
+FUNCTOR: define-vector ( V A <A> -- )
+
+<V> DEFINES <${V}>
+>V DEFINES >${V}
+
+WHERE
+
+TUPLE: V { underlying A } { length array-capacity } ;
+
+: <V> ( capacity -- vector ) <A> 0 V boa ; inline
+
+M: V like
+ drop dup V instance? [
+ dup A instance? [ dup length V boa ] [ >V ] if
+ ] unless ;
+
+M: V new-sequence drop [ <A> ] [ >fixnum ] bi V boa ;
+
+M: A new-resizable drop <V> ;
+
+M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
+
+: >V ( seq -- vector ) V new clone-like ; inline
+
+INSTANCE: V growable
+
+;FUNCTOR
: reset-cache ( -- )
root-cache get-global clear-assoc
\ vocab-file-contents reset-memoized
- \ all-vocabs-seq reset-memoized
+ \ all-vocabs-recursive reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;
"Loading vocabulary hierarchies:"\r
{ $subsection load }\r
{ $subsection load-all }\r
-"Getting all vocabularies on disk:"\r
+"Getting all vocabularies from disk:"\r
{ $subsection all-vocabs }\r
-{ $subsection all-vocabs-seq }\r
-"Getting " { $link "vocabs.metadata" } " for all vocabularies on disk:"\r
+{ $subsection all-vocabs-recursive }\r
+"Getting all vocabularies from disk whose names which match a string prefix:"\r
+{ $subsection child-vocabs }\r
+{ $subsection child-vocabs-recursive }\r
+"Words for modifying output:"\r
+{ $subsection no-roots }\r
+{ $subsection no-prefixes }\r
+"Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:"\r
{ $subsection all-tags }\r
{ $subsection all-authors } ;\r
\r
ABOUT: "vocabs.hierarchy"\r
\r
-HELP: all-vocabs\r
-{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }\r
-{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;\r
-\r
HELP: load\r
{ $values { "prefix" string } }\r
{ $description "Load all vocabularies that match the provided prefix." }\r
HELP: load-all\r
{ $description "Load all vocabularies in the source tree." } ;\r
\r
-HELP: all-vocabs-under\r
-{ $values { "prefix" string } { "vocabs" "a sequence of vocabularies" } }\r
-{ $description "Return a sequence of vocab or vocab-links for each vocab matching the provided prefix. Unlike " { $link all-child-vocabs } " this word will return both loaded and unloaded vocabularies." } ;\r
! Copyright (C) 2007, 2009 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: arrays assocs combinators.short-circuit fry\r
+USING: accessors arrays assocs combinators.short-circuit fry\r
io.directories io.files io.files.info io.pathnames kernel make\r
memoize namespaces sequences sorting splitting vocabs sets\r
vocabs.loader vocabs.metadata vocabs.errors ;\r
+RENAME: child-vocabs vocabs => vocabs:child-vocabs\r
IN: vocabs.hierarchy\r
\r
+TUPLE: vocab-prefix name ;\r
+\r
+C: <vocab-prefix> vocab-prefix\r
+\r
+M: vocab-prefix vocab-name name>> ;\r
+\r
<PRIVATE\r
\r
: vocab-subdirs ( dir -- dirs )\r
] filter\r
] with-directory-files natural-sort ;\r
\r
-: (all-child-vocabs) ( root name -- vocabs )\r
- [\r
- vocab-dir append-path dup exists?\r
- [ vocab-subdirs ] [ drop { } ] if\r
- ] keep\r
- [ '[ [ _ "." ] dip 3append ] map ] unless-empty ;\r
-\r
: vocab-dir? ( root name -- ? )\r
over\r
[ ".factor" vocab-dir+ append-path exists? ]\r
[ 2drop f ]\r
if ;\r
\r
-: vocabs-in-dir ( root name -- )\r
- dupd (all-child-vocabs) [\r
- 2dup vocab-dir? [ dup >vocab-link , ] when\r
- vocabs-in-dir\r
- ] with each ;\r
+: (child-vocabs) ( root prefix -- vocabs )\r
+ [ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ]\r
+ [ nip [ '[ [ _ "." ] dip 3append ] map ] unless-empty ]\r
+ [ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map ]\r
+ 2tri ;\r
\r
-PRIVATE>\r
+: ((child-vocabs-recursive)) ( root name -- )\r
+ dupd vocab-name (child-vocabs)\r
+ [ dup , ((child-vocabs-recursive)) ] with each ;\r
\r
-: all-vocabs ( -- assoc )\r
- vocab-roots get [\r
- dup [ "" vocabs-in-dir ] { } make\r
- ] { } map>assoc ;\r
-\r
-: all-vocabs-under ( prefix -- vocabs )\r
- [\r
- [ vocab-roots get ] dip '[ _ vocabs-in-dir ] each\r
- ] { } make ;\r
+: (child-vocabs-recursive) ( root name -- seq )\r
+ [ ((child-vocabs-recursive)) ] { } make ;\r
\r
-MEMO: all-vocabs-seq ( -- seq )\r
- "" all-vocabs-under ;\r
+: no-rooted ( seq -- seq' ) [ find-vocab-root not ] filter ;\r
\r
-<PRIVATE\r
+: one-level-only? ( name prefix -- ? )\r
+ ?head [ "." split1 nip not ] dip and ;\r
\r
: unrooted-child-vocabs ( prefix -- seq )\r
+ [ vocabs no-rooted ] dip\r
dup empty? [ CHAR: . suffix ] unless\r
- vocabs\r
- [ find-vocab-root not ] filter\r
- [\r
- vocab-name swap ?head CHAR: . rot member? not and\r
- ] with filter\r
- [ vocab ] map ;\r
+ '[ vocab-name _ one-level-only? ] filter ;\r
+\r
+: unrooted-child-vocabs-recursive ( prefix -- seq )\r
+ vocabs:child-vocabs no-rooted ;\r
\r
PRIVATE>\r
\r
-: all-child-vocabs ( prefix -- assoc )\r
- vocab-roots get [\r
- dup pick (all-child-vocabs) [ >vocab-link ] map\r
- ] { } map>assoc\r
- swap unrooted-child-vocabs f swap 2array suffix ;\r
+: no-prefixes ( seq -- seq' ) [ vocab-prefix? not ] filter ;\r
\r
-: all-child-vocabs-seq ( prefix -- assoc )\r
- vocab-roots get swap '[\r
- dup _ (all-child-vocabs)\r
- [ vocab-dir? ] with filter\r
- ] map concat ;\r
+: convert-prefixes ( seq -- seq' )\r
+ [ dup vocab-prefix? [ name>> vocab-link boa ] when ] map ;\r
+\r
+: remove-redundant-prefixes ( seq -- seq' )\r
+ #! Hack.\r
+ [ vocab-prefix? ] partition\r
+ [\r
+ [ vocab-name ] map unique\r
+ '[ name>> _ key? not ] filter\r
+ convert-prefixes\r
+ ] keep\r
+ append ;\r
+\r
+: no-roots ( assoc -- seq ) values concat ;\r
+\r
+: child-vocabs ( prefix -- assoc )\r
+ [ [ vocab-roots get ] dip '[ dup _ (child-vocabs) ] { } map>assoc ]\r
+ [ unrooted-child-vocabs [ vocab ] map f swap 2array ]\r
+ bi suffix ;\r
+\r
+: all-vocabs ( -- assoc )\r
+ "" child-vocabs ;\r
+\r
+: child-vocabs-recursive ( prefix -- assoc )\r
+ [ [ vocab-roots get ] dip '[ dup _ (child-vocabs-recursive) ] { } map>assoc ]\r
+ [ unrooted-child-vocabs-recursive [ vocab ] map f swap 2array ]\r
+ bi suffix ;\r
+\r
+MEMO: all-vocabs-recursive ( -- assoc )\r
+ "" child-vocabs-recursive ;\r
+\r
+: all-vocab-names ( -- seq )\r
+ all-vocabs-recursive no-roots no-prefixes [ vocab-name ] map ;\r
+\r
+: child-vocab-names ( prefix -- seq )\r
+ child-vocabs no-roots no-prefixes [ vocab-name ] map ;\r
\r
<PRIVATE\r
\r
: filter-unportable ( seq -- seq' )\r
[ vocab-name unportable? not ] filter ;\r
\r
+: collect-vocabs ( quot -- seq )\r
+ [ all-vocabs-recursive no-roots no-prefixes ] dip\r
+ gather natural-sort ; inline\r
+\r
PRIVATE>\r
\r
: (load) ( prefix -- failures )\r
- all-vocabs-under\r
+ child-vocabs-recursive no-roots no-prefixes\r
filter-unportable\r
require-all ;\r
\r
: load-all ( -- )\r
"" load ;\r
\r
-MEMO: all-tags ( -- seq )\r
- all-vocabs-seq [ vocab-tags ] gather natural-sort ;\r
+MEMO: all-tags ( -- seq ) [ vocab-tags ] collect-vocabs ;\r
\r
-MEMO: all-authors ( -- seq )\r
- all-vocabs-seq [ vocab-authors ] gather natural-sort ;
\ No newline at end of file
+MEMO: all-authors ( -- seq ) [ vocab-authors ] collect-vocabs ;\r
swap >>dim
swap >>bitmap
BGRX >>component-order
+ ubyte-components >>component-type
t >>upside-down? ;
: with-memory-dc ( quot: ( hDC -- ) -- )
:: make-bitmap-image ( dim dc quot -- image )
dim dc make-bitmap [ &DeleteObject drop ] dip
quot dip
- dim bitmap>image ; inline
\ No newline at end of file
+ dim bitmap>image ; inline
[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
[ "a b c d e f\ng h" ] [ "a b c d e f g h" 11 wrap-string ] unit-test
+
+[ "" ] [ "" 10 wrap-string ] unit-test
+[ "Hello" ] [ "\nHello\n" 10 wrap-string ] unit-test
--- /dev/null
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: wrap tools.test ;
+
+[ { } ] [ { } 10 10 wrap ] unit-test
[
line-ideal set
line-max set
- initialize
- [ wrap-step ] reduce
- min-cost
- post-process
+ [ { } ] [
+ initialize
+ [ wrap-step ] reduce
+ min-cost
+ post-process
+ ] if-empty
] with-scope ;
[ "( displaced alien )" ] [ 0 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
-[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
-
-[ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
-
SYMBOL: initialize-test
f initialize-test set-global
M: byte-vector equal?\r
over byte-vector? [ sequence= ] [ 2drop f ] if ;\r
\r
+M: byte-vector contract 2drop ;\r
+\r
M: byte-array like\r
#! If we have an byte-array, we're done.\r
#! If we have a byte-vector, and it's at full capacity,\r
: parse-long-slot-name ( -- spec )
[ scan , \ } parse-until % ] { } make ;
-: parse-slot-name ( string/f -- ? )
+: parse-slot-name-delim ( end-delim string/f -- ? )
#! This isn't meant to enforce any kind of policy, just
#! to check for mistakes of this form:
#!
{
{ [ dup not ] [ unexpected-eof ] }
{ [ dup { ":" "(" "<" "\"" "!" } member? ] [ invalid-slot-name ] }
- { [ dup ";" = ] [ drop f ] }
+ { [ 2dup = ] [ drop f ] }
[ dup "{" = [ drop parse-long-slot-name ] when , t ]
- } cond ;
+ } cond nip ;
+
+: parse-tuple-slots-delim ( end-delim -- )
+ dup scan parse-slot-name-delim [ parse-tuple-slots-delim ] [ drop ] if ;
+
+: parse-slot-name ( string/f -- ? )
+ ";" swap parse-slot-name-delim ;
: parse-tuple-slots ( -- )
- scan parse-slot-name [ parse-tuple-slots ] when ;
+ ";" parse-tuple-slots-delim ;
: parse-tuple-definition ( -- class superclass slots )
CREATE-CLASS
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private
sequences sequences.private ;
: expand ( len seq -- )
[ resize ] change-underlying drop ; inline
-: contract ( len seq -- )
+GENERIC: contract ( len seq -- )
+
+M: growable contract ( len seq -- )
[ length ] keep
[ [ 0 ] 2dip set-nth-unsafe ] curry
- (each-integer) ; inline
+ (each-integer) ;
: growable-check ( n seq -- n seq )
over 0 < [ bounds-error ] when ; inline
[ 1 ] [ "h" get assoc-size ] unit-test
[ 1 ] [ 2 "h" get at ] unit-test
+
+! Random test case
+[ "A" ] [ 100 [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 swap at ] unit-test
\ No newline at end of file
{ "newseq" sequence } }
{ $description "Calls the quotation for every element of the sequence in order. However, the element is not passed to the quotation -- it is dropped, and the quotation produces an element of its own that is collected into a sequence of the same class as the input sequence." }
{ $examples
- { $unchecked-example "USING: prettyprint kernel sequences ;"
+ { $unchecked-example "USING: kernel prettyprint random sequences ;"
"5 [ 100 random ] replicate ."
"{ 52 10 45 81 30 }"
}
PRIVATE>
: run-benchmark ( vocab -- )
- [ "=== " write vocab-name print flush ] [
+ [ "=== " write print flush ] [
[ [ require ] [ gc [ run ] benchmark ] [ ] tri timings ]
[ swap errors ]
recover get set-at
[
V{ } clone timings set
V{ } clone errors set
- "benchmark" all-child-vocabs-seq
+ "benchmark" child-vocab-names
[ run-benchmark ] each
timings get
errors get
--- /dev/null
+Slava Pestov
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs combinators kernel locals math
+math.ranges memoize sequences strings hashtables
+math.parser grouping ;
+IN: benchmark.hashtables
+
+MEMO: strings ( -- str )
+ 1 100 [a,b] 1 [ + ] accumulate nip [ number>string ] map ;
+
+:: add-delete-mix ( hash keys -- )
+ keys [| k |
+ 0 k hash set-at
+ k hash delete-at
+ ] each
+
+ keys [
+ 0 swap hash set-at
+ ] each
+
+ keys [
+ hash delete-at
+ ] each ;
+
+:: store-lookup-mix ( hash keys -- )
+ keys [
+ 0 swap hash set-at
+ ] each
+
+ keys [
+ hash at
+ ] map drop
+
+ keys [
+ hash [ 1 + ] change-at
+ ] each ;
+
+: string-mix ( hash -- )
+ strings
+ [ add-delete-mix ]
+ [ store-lookup-mix ]
+ 2bi ;
+
+TUPLE: collision value ;
+
+M: collision hashcode* value>> hashcode* 15 bitand ;
+
+: collision-mix ( hash -- )
+ strings 30 head [ collision boa ] map
+ [ add-delete-mix ]
+ [ store-lookup-mix ]
+ 2bi ;
+
+: small-mix ( hash -- )
+ strings 10 group [
+ [ add-delete-mix ]
+ [ store-lookup-mix ]
+ 2bi
+ ] with each ;
+
+: hashtable-benchmark ( -- )
+ H{ } clone
+ 10000 [
+ dup {
+ [ small-mix ]
+ [ clear-assoc ]
+ [ string-mix ]
+ [ clear-assoc ]
+ [ collision-mix ]
+ [ clear-assoc ]
+ } cleave
+ ] times
+ drop ;
+
+MAIN: hashtable-benchmark
\ No newline at end of file
-USING: accessors assocs bson.constants byte-arrays byte-vectors fry io
-io.binary io.encodings.string io.encodings.utf8 kernel math namespaces
-sequences serialize arrays calendar io.encodings ;
+USING: accessors assocs bson.constants calendar fry io io.binary
+io.encodings io.encodings.utf8 kernel math math.bitwise namespaces
+sequences serialize ;
FROM: kernel.private => declare ;
FROM: io.encodings.private => (read-until) ;
GENERIC: element-data-read ( type -- object )
GENERIC: element-binary-read ( length type -- object )
-: byte-array>number ( seq -- number )
- byte-array>bignum >integer ; inline
-
: get-state ( -- state )
state get ; inline
: read-int32 ( -- int32 )
- 4 read byte-array>number ; inline
+ 4 read signed-le> ; inline
: read-longlong ( -- longlong )
- 8 read byte-array>number ; inline
+ 8 read signed-le> ; inline
: read-double ( -- double )
- 8 read byte-array>number bits>double ; inline
+ 8 read le> bits>double ; inline
: read-byte-raw ( -- byte-raw )
1 read ; inline
: write-utf8-string ( string -- ) output-stream get '[ _ swap char>utf8 ] each ; inline
-: write-byte ( byte -- ) CHAR-SIZE >le write ; inline
: write-int32 ( int -- ) INT32-SIZE >le write ; inline
: write-double ( real -- ) double>bits INT64-SIZE >le write ; inline
-: write-cstring ( string -- ) write-utf8-string 0 write-byte ; inline
+: write-cstring ( string -- ) write-utf8-string 0 write1 ; inline
: write-longlong ( object -- ) INT64-SIZE >le write ; inline
-: write-eoo ( -- ) T_EOO write-byte ; inline
-: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
+: write-eoo ( -- ) T_EOO write1 ; inline
+: write-type ( obj -- obj ) [ bson-type? write1 ] keep ; inline
: write-pair ( name object -- ) write-type [ write-cstring ] dip bson-write ; inline
M: string bson-write ( obj -- )
'[ _ write-cstring ] with-length-prefix-excl ;
M: f bson-write ( f -- )
- drop 0 write-byte ;
+ drop 0 write1 ;
M: t bson-write ( t -- )
- drop 1 write-byte ;
+ drop 1 write1 ;
M: integer bson-write ( num -- )
write-int32 ;
M: byte-array bson-write ( binary -- )
[ length write-int32 ] keep
- T_Binary_Bytes write-byte
+ T_Binary_Bytes write1
write ;
M: oid bson-write ( oid -- )
: (serialize-code) ( code -- )
object>bytes [ length write-int32 ] keep
- T_Binary_Custom write-byte
+ T_Binary_Custom write1
write ;
M: quotation bson-write ( quotation -- )
framebuffer framebuffer-dim ;
: outlining-supported? ( -- ? )
- "2.0" {
+ "3.0" {
"GL_ARB_shader_objects"
"GL_ARB_draw_buffers"
"GL_ARB_multitexture"
- } has-gl-version-or-extensions? {
"GL_EXT_framebuffer_object"
"GL_ARB_texture_float"
- } has-gl-extensions? and ;
+ } has-gl-version-or-extensions? ;
: pass1-program ( -- program )
vertex-shader-source <vertex-shader> check-gl-shader
GL_TEXTURE_2D 0 iformat dim first2 0 xformat GL_UNSIGNED_BYTE f glTexImage2D ;
:: (attach-framebuffer-texture) ( texture attachment -- )
- GL_FRAMEBUFFER_EXT attachment GL_TEXTURE_2D texture 0 glFramebufferTexture2DEXT
+ GL_DRAW_FRAMEBUFFER attachment GL_TEXTURE_2D texture 0 glFramebufferTexture2D
gl-error ;
: (make-framebuffer) ( color-texture normal-texture depth-texture -- framebuffer )
3array gen-framebuffer dup [
- swap GL_COLOR_ATTACHMENT0_EXT
- GL_COLOR_ATTACHMENT1_EXT
- GL_DEPTH_ATTACHMENT_EXT 3array [ (attach-framebuffer-texture) ] 2each
+ swap GL_COLOR_ATTACHMENT0
+ GL_COLOR_ATTACHMENT1
+ GL_DEPTH_ATTACHMENT 3array [ (attach-framebuffer-texture) ] 2each
check-framebuffer
] with-framebuffer ;
: (make-framebuffer-textures) ( draw dim -- draw color normal depth )
{
[ drop ]
- [ GL_RGBA16F_ARB GL_RGBA [ >>color-texture ] (framebuffer-texture>>draw) ]
- [ GL_RGBA16F_ARB GL_RGBA [ >>normal-texture ] (framebuffer-texture>>draw) ]
+ [ GL_RGBA16F GL_RGBA [ >>color-texture ] (framebuffer-texture>>draw) ]
+ [ GL_RGBA16F GL_RGBA [ >>normal-texture ] (framebuffer-texture>>draw) ]
[
GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT
[ >>depth-texture ] (framebuffer-texture>>draw)
[ drop ] [ remake-framebuffer ] if ;
: clear-framebuffer ( -- )
- GL_COLOR_ATTACHMENT0_EXT glDrawBuffer
+ GL_COLOR_ATTACHMENT0 glDrawBuffer
0.15 0.15 0.15 1.0 glClearColor
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
- GL_COLOR_ATTACHMENT1_EXT glDrawBuffer
+ GL_COLOR_ATTACHMENT1 glDrawBuffer
0.0 0.0 0.0 0.0 glClearColor
GL_COLOR_BUFFER_BIT glClear ;
: (pass1) ( geom draw -- )
dup framebuffer>> [
clear-framebuffer
- { GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT } set-draw-buffers
+ { GL_COLOR_ATTACHMENT0 GL_COLOR_ATTACHMENT1 } set-draw-buffers
pass1-program>> (draw-cel-shaded-bunny)
] with-framebuffer ;
--- /dev/null
+Matthew Willis
--- /dev/null
+USING: central destructors help.markup help.syntax ;
+
+HELP: CENTRAL:
+{ $description
+ "This parsing word defines a pair of words useful for "
+ "implementing the \"central\" pattern: " { $snippet "symbol" } " and "
+ { $snippet "with-symbol" } ". This is a middle ground between excessive "
+ "stack manipulation and full-out locals, meant to solve the case where "
+ "one object is operated on by several related words."
+} ;
+
+HELP: DISPOSABLE-CENTRAL:
+{ $description
+ "Like " { $link POSTPONE: CENTRAL: } ", but generates " { $snippet "with-" }
+ " words that are wrapped in a " { $link with-disposal } "."
+} ;
\ No newline at end of file
--- /dev/null
+USING: accessors central destructors kernel math tools.test ;
+
+IN: scratchpad
+
+CENTRAL: test-central
+
+[ 3 ] [ 3 [ test-central ] with-test-central ] unit-test
+
+TUPLE: test-disp-cent value disposed ;
+
+! A phony destructor that adds 1 to the value so we can make sure it got called.
+M: test-disp-cent dispose* dup value>> 1+ >>value drop ;
+
+DISPOSABLE-CENTRAL: t-d-c
+
+: test-t-d-c ( -- n )
+ test-disp-cent new 3 >>value [ t-d-c ] with-t-d-c value>> ;
+
+[ 4 ] [ test-t-d-c ] unit-test
\ No newline at end of file
--- /dev/null
+USING: destructors kernel lexer namespaces parser sequences words ;
+
+IN: central
+
+: define-central-getter ( word -- )
+ dup [ get ] curry (( -- obj )) define-declared ;
+
+: define-centrals ( str -- getter setter )
+ [ create-in dup define-central-getter ]
+ [ "with-" prepend create-in dup make-inline ] bi ;
+
+: central-setter-def ( word with-word -- with-word quot )
+ [ with-variable ] with ;
+
+: disposable-setter-def ( word with-word -- with-word quot )
+ [ pick [ drop with-variable ] with-disposal ] with ;
+
+: declare-central ( with-word quot -- ) (( object quot -- )) define-declared ;
+
+: define-central ( word-name -- )
+ define-centrals central-setter-def declare-central ;
+
+: define-disposable-central ( word-name -- )
+ define-centrals disposable-setter-def declare-central ;
+
+SYNTAX: CENTRAL: ( -- ) scan define-central ;
+
+SYNTAX: DISPOSABLE-CENTRAL: ( -- ) scan define-disposable-central ;
\ No newline at end of file
--- /dev/null
+extensions
: changelog ( -- authors )
image parent-directory [
- "git log --pretty=format:%an" ascii <process-reader> stream-lines
+ "git log --
no-merges --pretty=format:%an" ascii <process-reader> stream-lines
] with-directory ;
: patch-counts ( authors -- assoc )
[ { 111 222 } ]
[ { 1 2 } { 10 20 } { 100 200 } [ + + ] 3map ] unit-test
+
+: test-3map ( -- seq )
+ { 1 2 } { 10 20 } { 100 200 } [ + + ] 3map ;
+
+[ { 111 222 } ] [ test-3map ] unit-test
! Copyright (C) 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays generalizations kernel math sequences
-sequences.private ;
+sequences.private fry ;
IN: cursors
GENERIC: cursor-done? ( cursor -- ? )
: 2map ( seq1 seq2 quot -- ) [ cursor-map2 ] transform2 ; inline
: find-done3? ( cursor1 cursor2 cursor3 quot -- ? )
- 3 nover 3array [ cursor-done? ] any?
- [ 4 ndrop t ] [ [ [ cursor-get-unsafe ] tri@ ] dip call ] if ; inline
+ [ 3 ndrop t ] swap '[ [ cursor-get-unsafe ] tri@ @ ]
+ [ 3 ndup 3 narray [ cursor-done? ] any? ] 2dip if ; inline
: cursor-until3 ( cursor cursor quot -- )
[ find-done3? not ]
- [ drop [ cursor-advance ] tri@ ] bi-curry bi-curry bi-curry bi-curry while ; inline
+ [ drop [ cursor-advance ] tri@ ]
+ bi-curry bi-curry bi-curry bi-curry while ; inline
: cursor-each3 ( cursor cursor quot -- )
[ f ] compose cursor-until3 ; inline
parser prettyprint sequences summary help.vocabs
vocabs vocabs.loader vocabs.hierarchy vocabs.metadata words see
listener ;
-
+FROM: vocabs.hierarchy => child-vocabs ;
IN: fuel.help
<PRIVATE
[ fuel-vocab-help-table ] bi*
[ 2array ] [ drop f ] if*
] if-empty
- ] { } assoc>map [ ] filter ;
+ ] { } assoc>map sift ;
: fuel-vocab-children-help ( name -- element )
- all-child-vocabs fuel-vocab-list ; inline
+ child-vocabs fuel-vocab-list ; inline
: fuel-vocab-describe-words ( name -- element )
[ words. ] with-string-writer \ describe-words swap 2array ; inline
: article-location ( name -- loc ) article loc>> get-loc ;
-: get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ;
+: get-vocabs ( -- seq ) all-vocab-names ;
: get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ;
[ -1.5 ] [ HEX: be00 bits>half ] unit-test
[ 1/0. ] [ HEX: 7c00 bits>half ] unit-test
[ -1/0. ] [ HEX: fc00 bits>half ] unit-test
+[ 3.0 ] [ HEX: 4200 bits>half ] unit-test
[ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test
C-STRUCT: halves
! Copyright (C) 2009 Doug Coleman.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel sequences assocs ;\r
+USING: kernel sequences assocs fry ;\r
IN: histogram\r
\r
<PRIVATE\r
\r
: histogram ( seq -- hashtable )\r
[ inc-at ] sequence>hashtable ;\r
+\r
+: collect-values ( seq quot: ( obj hashtable -- ) -- hash )\r
+ '[ [ dup @ ] dip push-at ] sequence>hashtable ; inline\r
[
"h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
"ol" "li" "form" "a" "p" "html" "head" "body" "title"
- "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
+ "b" "i" "ul" "table" "thead" "tfoot" "tbody" "tr" "td" "th" "pre" "textarea"
"script" "div" "span" "select" "option" "style" "input"
"strong"
] [ define-closed-html-word ] each
--- /dev/null
+Matthew Willis
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.libraries alien.syntax ;
+
+IN: llvm.core
+
+<<
+
+"LLVMSystem" "/usr/local/lib/libLLVMSystem.dylib" "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
+
+>>
+
+! llvm-c/Core.h
+
+LIBRARY: LLVMCore
+
+TYPEDEF: uint unsigned
+TYPEDEF: unsigned enum
+
+CONSTANT: LLVMZExtAttribute BIN: 1
+CONSTANT: LLVMSExtAttribute BIN: 10
+CONSTANT: LLVMNoReturnAttribute BIN: 100
+CONSTANT: LLVMInRegAttribute BIN: 1000
+CONSTANT: LLVMStructRetAttribute BIN: 10000
+CONSTANT: LLVMNoUnwindAttribute BIN: 100000
+CONSTANT: LLVMNoAliasAttribute BIN: 1000000
+CONSTANT: LLVMByValAttribute BIN: 10000000
+CONSTANT: LLVMNestAttribute BIN: 100000000
+CONSTANT: LLVMReadNoneAttribute BIN: 1000000000
+CONSTANT: LLVMReadOnlyAttribute BIN: 10000000000
+TYPEDEF: enum LLVMAttribute;
+
+C-ENUM:
+ LLVMVoidTypeKind
+ LLVMFloatTypeKind
+ LLVMDoubleTypeKind
+ LLVMX86_FP80TypeKind
+ LLVMFP128TypeKind
+ LLVMPPC_FP128TypeKind
+ LLVMLabelTypeKind
+ LLVMMetadataTypeKind
+ LLVMIntegerTypeKind
+ LLVMFunctionTypeKind
+ LLVMStructTypeKind
+ LLVMArrayTypeKind
+ LLVMPointerTypeKind
+ LLVMOpaqueTypeKind
+ LLVMVectorTypeKind ;
+TYPEDEF: enum LLVMTypeKind
+
+C-ENUM:
+ LLVMExternalLinkage
+ LLVMLinkOnceLinkage
+ LLVMWeakLinkage
+ LLVMAppendingLinkage
+ LLVMInternalLinkage
+ LLVMDLLImportLinkage
+ LLVMDLLExportLinkage
+ LLVMExternalWeakLinkage
+ LLVMGhostLinkage ;
+TYPEDEF: enum LLVMLinkage
+
+C-ENUM:
+ LLVMDefaultVisibility
+ LLVMHiddenVisibility
+ LLVMProtectedVisibility ;
+TYPEDEF: enum LLVMVisibility
+
+CONSTANT: LLVMCCallConv 0
+CONSTANT: LLVMFastCallConv 8
+CONSTANT: LLVMColdCallConv 9
+CONSTANT: LLVMX86StdcallCallConv 64
+CONSTANT: LLVMX86FastcallCallConv 65
+TYPEDEF: enum LLVMCallConv
+
+CONSTANT: LLVMIntEQ 32
+CONSTANT: LLVMIntNE 33
+CONSTANT: LLVMIntUGT 34
+CONSTANT: LLVMIntUGE 35
+CONSTANT: LLVMIntULT 36
+CONSTANT: LLVMIntULE 37
+CONSTANT: LLVMIntSGT 38
+CONSTANT: LLVMIntSGE 39
+CONSTANT: LLVMIntSLT 40
+CONSTANT: LLVMIntSLE 41
+TYPEDEF: enum LLVMIntPredicate
+
+C-ENUM:
+ LLVMRealPredicateFalse
+ LLVMRealOEQ
+ LLVMRealOGT
+ LLVMRealOGE
+ LLVMRealOLT
+ LLVMRealOLE
+ LLVMRealONE
+ LLVMRealORD
+ LLVMRealUNO
+ LLVMRealUEQ
+ LLVMRealUGT
+ LLVMRealUGE
+ LLVMRealULT
+ LLVMRealULE
+ LLVMRealUNE
+ LLVMRealPredicateTrue ;
+TYPEDEF: enum LLVMRealPredicate
+
+! Opaque Types
+
+TYPEDEF: void* LLVMModuleRef
+
+TYPEDEF: void* LLVMPassManagerRef
+
+TYPEDEF: void* LLVMModuleProviderRef
+
+TYPEDEF: void* LLVMTypeRef
+
+TYPEDEF: void* LLVMTypeHandleRef
+
+TYPEDEF: void* LLVMValueRef
+
+TYPEDEF: void* LLVMBasicBlockRef
+
+TYPEDEF: void* LLVMBuilderRef
+
+TYPEDEF: void* LLVMMemoryBufferRef
+
+! Functions
+
+FUNCTION: void LLVMDisposeMessage ( char* Message ) ;
+
+FUNCTION: LLVMModuleRef LLVMModuleCreateWithName ( char* ModuleID ) ;
+
+FUNCTION: int LLVMAddTypeName ( LLVMModuleRef M, char* Name, LLVMTypeRef Ty ) ;
+
+FUNCTION: void LLVMDisposeModule ( LLVMModuleRef M ) ;
+
+FUNCTION: void LLVMDumpModule ( LLVMModuleRef M ) ;
+
+FUNCTION: LLVMModuleProviderRef
+LLVMCreateModuleProviderForExistingModule ( LLVMModuleRef M ) ;
+
+FUNCTION: void LLVMDisposeModuleProvider ( LLVMModuleProviderRef MP ) ;
+
+! Types
+
+! LLVM types conform to the following hierarchy:
+!
+! types:
+! integer type
+! real type
+! function type
+! sequence types:
+! array type
+! pointer type
+! vector type
+! void type
+! label type
+! opaque type
+
+! See llvm::LLVMTypeKind::getTypeID.
+FUNCTION: LLVMTypeKind LLVMGetTypeKind ( LLVMTypeRef Ty ) ;
+
+! Operations on integer types
+FUNCTION: LLVMTypeRef LLVMInt1Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMInt8Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMInt16Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMInt32Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMInt64Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMIntType ( unsigned NumBits ) ;
+FUNCTION: unsigned LLVMGetIntTypeWidth ( LLVMTypeRef IntegerTy ) ;
+
+! Operations on real types
+FUNCTION: LLVMTypeRef LLVMFloatType ( ) ;
+FUNCTION: LLVMTypeRef LLVMDoubleType ( ) ;
+FUNCTION: LLVMTypeRef LLVMX86FP80Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMFP128Type ( ) ;
+FUNCTION: LLVMTypeRef LLVMPPCFP128Type ( ) ;
+
+! Operations on function types
+FUNCTION: LLVMTypeRef
+LLVMFunctionType ( LLVMTypeRef ReturnType, LLVMTypeRef* ParamTypes, unsigned ParamCount, int IsVarArg ) ;
+FUNCTION: int LLVMIsFunctionVarArg ( LLVMTypeRef FunctionTy ) ;
+FUNCTION: LLVMTypeRef LLVMGetReturnType ( LLVMTypeRef FunctionTy ) ;
+FUNCTION: unsigned LLVMCountParamTypes ( LLVMTypeRef FunctionTy ) ;
+FUNCTION: void LLVMGetParamTypes ( LLVMTypeRef FunctionTy, LLVMTypeRef* Dest ) ;
+
+! Operations on struct types
+FUNCTION: LLVMTypeRef
+LLVMStructType ( LLVMTypeRef* ElementTypes, unsigned ElementCount, int Packed ) ;
+FUNCTION: unsigned LLVMCountStructElementTypes ( LLVMTypeRef StructTy ) ;
+FUNCTION: void LLVMGetStructElementTypes ( LLVMTypeRef StructTy, LLVMTypeRef* Dest ) ;
+FUNCTION: int LLVMIsPackedStruct ( LLVMTypeRef StructTy ) ;
+
+! Operations on array, pointer, and vector types (sequence types)
+FUNCTION: LLVMTypeRef LLVMArrayType ( LLVMTypeRef ElementType, unsigned ElementCount ) ;
+FUNCTION: LLVMTypeRef LLVMPointerType ( LLVMTypeRef ElementType, unsigned AddressSpace ) ;
+FUNCTION: LLVMTypeRef LLVMVectorType ( LLVMTypeRef ElementType, unsigned ElementCount ) ;
+
+FUNCTION: LLVMTypeRef LLVMGetElementType ( LLVMTypeRef Ty ) ;
+FUNCTION: unsigned LLVMGetArrayLength ( LLVMTypeRef ArrayTy ) ;
+FUNCTION: unsigned LLVMGetPointerAddressSpace ( LLVMTypeRef PointerTy ) ;
+FUNCTION: unsigned LLVMGetVectorSize ( LLVMTypeRef VectorTy ) ;
+
+! Operations on other types
+FUNCTION: LLVMTypeRef LLVMVoidType ( ) ;
+FUNCTION: LLVMTypeRef LLVMLabelType ( ) ;
+FUNCTION: LLVMTypeRef LLVMOpaqueType ( ) ;
+
+! Operations on type handles
+FUNCTION: LLVMTypeHandleRef LLVMCreateTypeHandle ( LLVMTypeRef PotentiallyAbstractTy ) ;
+FUNCTION: void LLVMRefineType ( LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy ) ;
+FUNCTION: LLVMTypeRef LLVMResolveTypeHandle ( LLVMTypeHandleRef TypeHandle ) ;
+FUNCTION: void LLVMDisposeTypeHandle ( LLVMTypeHandleRef TypeHandle ) ;
+
+! Types end
+
+FUNCTION: unsigned LLVMCountParams ( LLVMValueRef Fn ) ;
+
+FUNCTION: void LLVMGetParams ( LLVMValueRef Fn, LLVMValueRef* Params ) ;
+
+FUNCTION: LLVMValueRef
+LLVMAddFunction ( LLVMModuleRef M, char* Name, LLVMTypeRef FunctionTy ) ;
+
+FUNCTION: LLVMValueRef LLVMGetFirstFunction ( LLVMModuleRef M ) ;
+
+FUNCTION: LLVMValueRef LLVMGetNextFunction ( LLVMValueRef Fn ) ;
+
+FUNCTION: unsigned LLVMGetFunctionCallConv ( LLVMValueRef Fn ) ;
+
+FUNCTION: void LLVMSetFunctionCallConv ( LLVMValueRef Fn, unsigned CC ) ;
+
+FUNCTION: LLVMBasicBlockRef
+LLVMAppendBasicBlock ( LLVMValueRef Fn, char* Name ) ;
+
+FUNCTION: LLVMValueRef LLVMGetBasicBlockParent ( LLVMBasicBlockRef BB ) ;
+
+! Values
+
+FUNCTION: LLVMTypeRef LLVMTypeOf ( LLVMValueRef Val ) ;
+FUNCTION: char* LLVMGetValueName ( LLVMValueRef Val ) ;
+FUNCTION: void LLVMSetValueName ( LLVMValueRef Val, char* Name ) ;
+FUNCTION: void LLVMDumpValue ( LLVMValueRef Val ) ;
+
+! Instruction Builders
+
+FUNCTION: LLVMBuilderRef LLVMCreateBuilder ( ) ;
+FUNCTION: void LLVMPositionBuilder
+( LLVMBuilderRef Builder, LLVMBasicBlockRef Block, LLVMValueRef Instr ) ;
+FUNCTION: void LLVMPositionBuilderBefore
+( LLVMBuilderRef Builder, LLVMValueRef Instr ) ;
+FUNCTION: void LLVMPositionBuilderAtEnd
+( LLVMBuilderRef Builder, LLVMBasicBlockRef Block ) ;
+FUNCTION: LLVMBasicBlockRef LLVMGetInsertBlock
+( LLVMBuilderRef Builder ) ;
+FUNCTION: void LLVMClearInsertionPosition
+( LLVMBuilderRef Builder ) ;
+FUNCTION: void LLVMInsertIntoBuilder
+( LLVMBuilderRef Builder, LLVMValueRef Instr ) ;
+FUNCTION: void LLVMDisposeBuilder
+( LLVMBuilderRef Builder ) ;
+
+! IB Terminators
+
+FUNCTION: LLVMValueRef LLVMBuildRetVoid
+( LLVMBuilderRef Builder ) ;
+FUNCTION: LLVMValueRef LLVMBuildRet
+( LLVMBuilderRef Builder, LLVMValueRef V ) ;
+FUNCTION: LLVMValueRef LLVMBuildBr
+( LLVMBuilderRef Builder, LLVMBasicBlockRef Dest ) ;
+FUNCTION: LLVMValueRef LLVMBuildCondBr
+( LLVMBuilderRef Builder, LLVMValueRef If, LLVMBasicBlockRef Then, LLVMBasicBlockRef Else ) ;
+FUNCTION: LLVMValueRef LLVMBuildSwitch
+( LLVMBuilderRef Builder, LLVMValueRef V, LLVMBasicBlockRef Else, unsigned NumCases ) ;
+FUNCTION: LLVMValueRef LLVMBuildInvoke
+( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs,
+ LLVMBasicBlockRef Then, LLVMBasicBlockRef Catch, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildUnwind
+( LLVMBuilderRef Builder ) ;
+FUNCTION: LLVMValueRef LLVMBuildUnreachable
+( LLVMBuilderRef Builder ) ;
+
+! IB Add Case to Switch
+
+FUNCTION: void LLVMAddCase
+( LLVMValueRef Switch, LLVMValueRef OnVal, LLVMBasicBlockRef Dest ) ;
+
+! IB Arithmetic
+
+FUNCTION: LLVMValueRef LLVMBuildAdd
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildSub
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildMul
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildUDiv
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildSDiv
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFDiv
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildURem
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildSRem
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFRem
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildShl
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildLShr
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildAShr
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildAnd
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildOr
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildXor
+( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildNeg
+( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildNot
+( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ;
+
+! IB Memory
+
+FUNCTION: LLVMValueRef LLVMBuildMalloc
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildArrayMalloc
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildAlloca
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildArrayAlloca
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFree
+( LLVMBuilderRef Builder, LLVMValueRef PointerVal ) ;
+FUNCTION: LLVMValueRef LLVMBuildLoad
+( LLVMBuilderRef Builder, LLVMValueRef PointerVal, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildStore
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMValueRef Ptr ) ;
+FUNCTION: LLVMValueRef LLVMBuildGEP
+( LLVMBuilderRef B, LLVMValueRef Pointer, LLVMValueRef* Indices,
+ unsigned NumIndices, char* Name ) ;
+
+! IB Casts
+
+FUNCTION: LLVMValueRef LLVMBuildTrunc
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildZExt
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildSExt
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFPToUI
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFPToSI
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildUIToFP
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildSIToFP
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFPTrunc
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFPExt
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildPtrToInt
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildIntToPtr
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildBitCast
+( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
+
+! IB Comparisons
+
+FUNCTION: LLVMValueRef LLVMBuildICmp
+( LLVMBuilderRef Builder, LLVMIntPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildFCmp
+( LLVMBuilderRef Builder, LLVMRealPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
+
+! IB Misc Instructions
+
+FUNCTION: LLVMValueRef LLVMBuildPhi
+( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildCall
+( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildSelect
+( LLVMBuilderRef Builder, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildVAArg
+( LLVMBuilderRef Builder, LLVMValueRef List, LLVMTypeRef Ty, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildExtractElement
+( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef Index, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildInsertElement
+( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef EltVal, LLVMValueRef Index, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildShuffleVector
+( LLVMBuilderRef Builder, LLVMValueRef V1, LLVMValueRef V2, LLVMValueRef Mask, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildExtractValue
+( LLVMBuilderRef Builder, LLVMValueRef AggVal, unsigned Index, char* Name ) ;
+FUNCTION: LLVMValueRef LLVMBuildInsertValue
+( LLVMBuilderRef Builder, LLVMValueRef AggVal, LLVMValueRef EltVal, unsigned Index, char* Name ) ;
+
+! Memory Buffers/Bit Reader
+
+FUNCTION: int LLVMCreateMemoryBufferWithContentsOfFile
+( char* Path, LLVMMemoryBufferRef* OutMemBuf, char** OutMessage ) ;
+
+FUNCTION: void LLVMDisposeMemoryBuffer ( LLVMMemoryBufferRef MemBuf ) ;
+
+LIBRARY: LLVMBitReader
+
+FUNCTION: int LLVMParseBitcode
+( LLVMMemoryBufferRef MemBuf, LLVMModuleRef* OutModule, char** OutMessage ) ;
+
+FUNCTION: int LLVMGetBitcodeModuleProvider
+( LLVMMemoryBufferRef MemBuf, LLVMModuleProviderRef* OutMP, char** OutMessage ) ;
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.libraries alien.syntax llvm.core ;
+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
+
+>>
+
+! llvm-c/ExecutionEngine.h
+
+LIBRARY: LLVMExecutionEngine
+
+TYPEDEF: void* LLVMGenericValueRef
+TYPEDEF: void* LLVMExecutionEngineRef
+
+FUNCTION: LLVMGenericValueRef LLVMCreateGenericValueOfInt
+( LLVMTypeRef Ty, ulonglong N, int IsSigned ) ;
+
+FUNCTION: ulonglong LLVMGenericValueToInt
+( LLVMGenericValueRef GenVal, int IsSigned ) ;
+
+FUNCTION: int LLVMCreateExecutionEngine
+( LLVMExecutionEngineRef *OutEE, LLVMModuleProviderRef MP, char** OutError ) ;
+
+FUNCTION: int LLVMCreateJITCompiler
+( LLVMExecutionEngineRef* OutJIT, LLVMModuleProviderRef MP, unsigned OptLevel, char** OutError ) ;
+
+FUNCTION: void LLVMDisposeExecutionEngine ( LLVMExecutionEngineRef EE ) ;
+
+FUNCTION: void LLVMFreeMachineCodeForFunction ( LLVMExecutionEngineRef EE, LLVMValueRef F ) ;
+
+FUNCTION: void LLVMAddModuleProvider ( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP ) ;
+
+FUNCTION: int LLVMRemoveModuleProvider
+( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP, LLVMModuleRef* OutMod, char** OutError ) ;
+
+FUNCTION: int LLVMFindFunction
+( LLVMExecutionEngineRef EE, char* Name, LLVMValueRef* OutFn ) ;
+
+FUNCTION: void* LLVMGetPointerToGlobal ( LLVMExecutionEngineRef EE, LLVMValueRef Global ) ;
+
+FUNCTION: LLVMGenericValueRef LLVMRunFunction
+( LLVMExecutionEngineRef EE, LLVMValueRef F, unsigned NumArgs, LLVMGenericValueRef* Args ) ;
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.llvm io.pathnames llvm.invoker llvm.reader tools.test ;
+
+[ 3 ] [
+ << "resource:extra/llvm/reader/add.bc" install-bc >> 1 2 add
+] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien arrays assocs compiler.units effects
+io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
+llvm.types make namespaces sequences specialized-arrays.alien
+vocabs words ;
+
+IN: llvm.invoker
+
+! get function name, ret type, param types and names
+
+! load module
+! iterate through functions in a module
+
+TUPLE: function name alien return params ;
+
+: params ( llvm-function -- param-list )
+ dup LLVMCountParams <void*-array>
+ [ LLVMGetParams ] keep >array
+ [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
+
+: <function> ( LLVMValueRef -- function )
+ function new
+ over LLVMGetValueName >>name
+ over LLVMTypeOf tref> type>> return>> >>return
+ swap params >>params ;
+
+: (functions) ( llvm-function -- )
+ [ dup , LLVMGetNextFunction (functions) ] when* ;
+
+: functions ( llvm-module -- functions )
+ LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
+
+: function-effect ( function -- effect )
+ [ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi <effect> ;
+
+: install-function ( function -- )
+ dup name>> "alien.llvm" create-vocab drop
+ "alien.llvm" create swap
+ [
+ dup name>> function-pointer ,
+ dup return>> c-type ,
+ dup params>> [ second c-type ] map ,
+ "cdecl" , \ alien-indirect ,
+ ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
+
+: install-module ( name -- )
+ thejit get mps>> at [
+ module>> functions [ install-function ] each
+ ] [ "no such module" throw ] if* ;
+
+: install-bc ( path -- )
+ [ normalize-path ] [ file-name ] bi
+ [ load-into-jit ] keep install-module ;
+
+<< "alien.llvm" create-vocab drop >>
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: destructors llvm.jit llvm.wrappers tools.test ;
+
+[ ] [ "test" <module> "test" add-module "test" remove-module ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.syntax assocs destructors
+kernel llvm.core llvm.engine llvm.wrappers namespaces ;
+
+IN: llvm.jit
+
+SYMBOL: thejit
+
+TUPLE: jit ee mps ;
+
+: empty-engine ( -- engine )
+ "initial-module" <module> <provider> <engine> ;
+
+: <jit> ( -- jit )
+ jit new empty-engine >>ee H{ } clone >>mps ;
+
+: (remove-functions) ( function -- )
+ thejit get ee>> value>> over LLVMFreeMachineCodeForFunction
+ LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
+
+: remove-functions ( module -- )
+ ! free machine code for each function in module
+ LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
+
+: remove-provider ( provider -- )
+ thejit get ee>> value>> swap value>> f <void*> f <void*>
+ [ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
+ *void* module new swap >>value
+ [ value>> remove-functions ] with-disposal ;
+
+: remove-module ( name -- )
+ dup thejit get mps>> at [
+ remove-provider
+ thejit get mps>> delete-at
+ ] [ drop ] if* ;
+
+: add-module ( module name -- )
+ [ <provider> ] dip [ remove-module ] keep
+ thejit get ee>> value>> pick
+ [ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
+ thejit get mps>> set-at ;
+
+: function-pointer ( name -- alien )
+ thejit get ee>> value>> dup
+ rot f <void*> [ LLVMFindFunction drop ] keep
+ *void* LLVMGetPointerToGlobal ;
+
+thejit [ <jit> ] initialize
\ No newline at end of file
--- /dev/null
+define i32 @add(i32 %x, i32 %y) {
+entry:
+ %sum = add i32 %x, %y
+ ret i32 %sum
+}
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.syntax destructors kernel
+llvm.core llvm.engine llvm.jit llvm.wrappers ;
+
+IN: llvm.reader
+
+: buffer>module ( buffer -- module )
+ [
+ value>> f <void*> f <void*>
+ [ LLVMParseBitcode drop ] 2keep
+ *void* [ llvm-throw ] when* *void*
+ module new swap >>value
+ ] with-disposal ;
+
+: load-module ( path -- module )
+ <buffer> buffer>module ;
+
+: load-into-jit ( path name -- )
+ [ load-module ] dip add-module ;
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel llvm.types sequences tools.test ;
+
+[ T{ integer f 32 } ] [ " i32 " parse-type ] unit-test
+[ float ] [ " float " parse-type ] unit-test
+[ T{ pointer f f x86_fp80 } ] [ " x86_fp80 * " parse-type ] unit-test
+[ T{ vector f f 4 T{ integer f 32 } } ] [ " < 4 x i32 > " parse-type ] unit-test
+[ T{ struct f f { float double } f } ] [ TYPE: { float , double } ; ] unit-test
+[ T{ array f f 0 float } ] [ TYPE: [ 0 x float ] ; ] unit-test
+
+[ label void metadata ]
+[ [ " label " " void " " metadata " ] [ parse-type ] each ] unit-test
+
+[ T{ function f f float { float float } t } ]
+[ TYPE: float ( float , float , ... ) ; ] unit-test
+
+[ T{ struct f f { float TYPE: i32 (i32)* ; } t } ]
+[ TYPE: < { float, i32 (i32)* } > ; ] unit-test
+
+[ t ] [ TYPE: i32 ; TYPE: i32 ; [ >tref ] bi@ = ] unit-test
+[ t ] [ TYPE: i32 * ; TYPE: i32 * ; [ >tref ] bi@ = ] unit-test
+
+[ TYPE: i32 ; ] [ TYPE: i32 ; >tref tref> ] unit-test
+[ TYPE: float ; ] [ TYPE: float ; >tref tref> ] unit-test
+[ TYPE: double ; ] [ TYPE: double ; >tref tref> ] unit-test
+[ TYPE: x86_fp80 ; ] [ TYPE: x86_fp80 ; >tref tref> ] unit-test
+[ TYPE: fp128 ; ] [ TYPE: fp128 ; >tref tref> ] unit-test
+[ TYPE: ppc_fp128 ; ] [ TYPE: ppc_fp128 ; >tref tref> ] unit-test
+[ TYPE: opaque ; ] [ TYPE: opaque ; >tref tref> ] unit-test
+[ TYPE: label ; ] [ TYPE: label ; >tref tref> ] unit-test
+[ TYPE: void ; ] [ TYPE: void ; >tref tref> ] unit-test
+[ TYPE: i32* ; ] [ TYPE: i32* ; >tref tref> ] unit-test
+[ TYPE: < 2 x i32 > ; ] [ TYPE: < 2 x i32 > ; >tref tref> ] unit-test
+[ TYPE: [ 0 x i32 ] ; ] [ TYPE: [ 0 x i32 ] ; >tref tref> ] unit-test
+[ TYPE: { i32, i32 } ; ] [ TYPE: { i32, i32 } ; >tref tref> ] unit-test
+[ TYPE: < { i32, i32 } > ; ] [ TYPE: < { i32, i32 } > ; >tref tref> ] unit-test
+[ TYPE: i32 ( i32 ) ; ] [ TYPE: i32 ( i32 ) ; >tref tref> ] unit-test
+[ TYPE: \1* ; ] [ TYPE: \1* ; >tref tref> ] unit-test
+[ TYPE: { i32, \2* } ; ] [ TYPE: { i32, \2* } ; >tref tref> ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators kernel llvm.core
+locals math.parser math multiline
+namespaces parser peg.ebnf sequences
+sequences.deep specialized-arrays.alien strings vocabs words ;
+
+IN: llvm.types
+
+! Type resolution strategy:
+! pass 1:
+! create the type with uprefs mapped to opaque types
+! cache typerefs in enclosing types for pass 2
+! if our type is concrete, then we are done
+!
+! pass 2:
+! wrap our abstract type in a type handle
+! create a second type, using the cached enclosing type info
+! resolve the first type to the second
+!
+GENERIC: (>tref) ( type -- LLVMTypeRef )
+GENERIC: ((tref>)) ( LLVMTypeRef type -- type )
+GENERIC: c-type ( type -- str )
+
+! default implementation for simple types
+M: object ((tref>)) nip ;
+: unsupported-type ( -- )
+ "cannot generate c-type: unsupported llvm type" throw ;
+M: object c-type unsupported-type ;
+
+TUPLE: integer size ;
+C: <integer> integer
+
+M: integer (>tref) size>> LLVMIntType ;
+M: integer ((tref>)) swap LLVMGetIntTypeWidth >>size ;
+M: integer c-type size>> {
+ { 64 [ "longlong" ] }
+ { 32 [ "int" ] }
+ { 16 [ "short" ] }
+ { 8 [ "char" ] }
+ [ unsupported-type ]
+} case ;
+
+SINGLETONS: float double x86_fp80 fp128 ppc_fp128 ;
+
+M: float (>tref) drop LLVMFloatType ;
+M: double (>tref) drop LLVMDoubleType ;
+M: double c-type drop "double" ;
+M: x86_fp80 (>tref) drop LLVMX86FP80Type ;
+M: fp128 (>tref) drop LLVMFP128Type ;
+M: ppc_fp128 (>tref) drop LLVMPPCFP128Type ;
+
+SINGLETONS: opaque label void metadata ;
+
+M: opaque (>tref) drop LLVMOpaqueType ;
+M: label (>tref) drop LLVMLabelType ;
+M: void (>tref) drop LLVMVoidType ;
+M: void c-type drop "void" ;
+M: metadata (>tref) drop
+ "metadata types unsupported by llvm c bindings" throw ;
+
+! enclosing types cache their llvm refs during
+! the first pass, used in the second pass to
+! resolve uprefs
+TUPLE: enclosing cached ;
+
+GENERIC: clean ( type -- )
+GENERIC: clean* ( type -- )
+M: object clean drop ;
+M: enclosing clean f >>cached clean* ;
+
+! builds the stack of types that uprefs need to refer to
+SYMBOL: types
+:: push-type ( type quot: ( type -- LLVMTypeRef ) -- LLVMTypeRef )
+ type types get push
+ type quot call( type -- LLVMTypeRef )
+ types get pop over >>cached drop ;
+
+DEFER: <up-ref>
+:: push-ref ( ref quot: ( LLVMTypeRef -- type ) -- type )
+ ref types get index
+ [ types get length swap - <up-ref> ] [
+ ref types get push
+ ref quot call( LLVMTypeRef -- type )
+ types get pop drop
+ ] if* ;
+
+GENERIC: (>tref)* ( type -- LLVMTypeRef )
+M: enclosing (>tref) [ (>tref)* ] push-type ;
+
+DEFER: type-kind
+GENERIC: (tref>)* ( LLVMTypeRef type -- type )
+M: enclosing ((tref>)) [ (tref>)* ] curry push-ref ;
+
+: (tref>) ( LLVMTypeRef -- type ) dup type-kind ((tref>)) ;
+
+TUPLE: pointer < enclosing type ;
+: <pointer> ( t -- o ) pointer new swap >>type ;
+
+M: pointer (>tref)* type>> (>tref) 0 LLVMPointerType ;
+M: pointer clean* type>> clean ;
+M: pointer (tref>)* swap LLVMGetElementType (tref>) >>type ;
+M: pointer c-type type>> 8 <integer> = "char*" "void*" ? ;
+
+TUPLE: vector < enclosing size type ;
+: <vector> ( s t -- o )
+ vector new
+ swap >>type swap >>size ;
+
+M: vector (>tref)* [ type>> (>tref) ] [ size>> ] bi LLVMVectorType ;
+M: vector clean* type>> clean ;
+M: vector (tref>)*
+ over LLVMGetElementType (tref>) >>type
+ swap LLVMGetVectorSize >>size ;
+
+TUPLE: struct < enclosing types packed? ;
+: <struct> ( ts p? -- o )
+ struct new
+ swap >>packed? swap >>types ;
+
+M: struct (>tref)*
+ [ types>> [ (>tref) ] map >void*-array ]
+ [ types>> length ]
+ [ packed?>> 1 0 ? ] tri LLVMStructType ;
+M: struct clean* types>> [ clean ] each ;
+M: struct (tref>)*
+ over LLVMIsPackedStruct 0 = not >>packed?
+ swap dup LLVMCountStructElementTypes <void*-array>
+ [ LLVMGetStructElementTypes ] keep >array
+ [ (tref>) ] map >>types ;
+
+TUPLE: array < enclosing size type ;
+: <array> ( s t -- o )
+ array new
+ swap >>type swap >>size ;
+
+M: array (>tref)* [ type>> (>tref) ] [ size>> ] bi LLVMArrayType ;
+M: array clean* type>> clean ;
+M: array (tref>)*
+ over LLVMGetElementType (tref>) >>type
+ swap LLVMGetArrayLength >>size ;
+
+SYMBOL: ...
+TUPLE: function < enclosing return params vararg? ;
+: <function> ( ret params var? -- o )
+ function new
+ swap >>vararg? swap >>params swap >>return ;
+
+M: function (>tref)* {
+ [ return>> (>tref) ]
+ [ params>> [ (>tref) ] map >void*-array ]
+ [ params>> length ]
+ [ vararg?>> 1 0 ? ]
+} cleave LLVMFunctionType ;
+M: function clean* [ return>> clean ] [ params>> [ clean ] each ] bi ;
+M: function (tref>)*
+ over LLVMIsFunctionVarArg 0 = not >>vararg?
+ over LLVMGetReturnType (tref>) >>return
+ swap dup LLVMCountParamTypes <void*-array>
+ [ LLVMGetParamTypes ] keep >array
+ [ (tref>) ] map >>params ;
+
+: type-kind ( LLVMTypeRef -- class )
+ LLVMGetTypeKind {
+ { LLVMVoidTypeKind [ void ] }
+ { LLVMFloatTypeKind [ float ] }
+ { LLVMDoubleTypeKind [ double ] }
+ { LLVMX86_FP80TypeKind [ x86_fp80 ] }
+ { LLVMFP128TypeKind [ fp128 ] }
+ { LLVMPPC_FP128TypeKind [ ppc_fp128 ] }
+ { LLVMLabelTypeKind [ label ] }
+ { LLVMIntegerTypeKind [ integer new ] }
+ { LLVMFunctionTypeKind [ function new ] }
+ { LLVMStructTypeKind [ struct new ] }
+ { LLVMArrayTypeKind [ array new ] }
+ { LLVMPointerTypeKind [ pointer new ] }
+ { LLVMOpaqueTypeKind [ opaque ] }
+ { LLVMVectorTypeKind [ vector new ] }
+ } case ;
+
+TUPLE: up-ref height ;
+C: <up-ref> up-ref
+
+M: up-ref (>tref)
+ types get length swap height>> - types get nth
+ cached>> [ LLVMOpaqueType ] unless* ;
+
+: resolve-types ( typeref typeref -- typeref )
+ over LLVMCreateTypeHandle [ LLVMRefineType ] dip
+ [ LLVMResolveTypeHandle ] keep LLVMDisposeTypeHandle ;
+
+: >tref-caching ( type -- LLVMTypeRef )
+ V{ } clone types [ (>tref) ] with-variable ;
+
+: >tref ( type -- LLVMTypeRef )
+ [ >tref-caching ] [ >tref-caching ] [ clean ] tri
+ 2dup = [ drop ] [ resolve-types ] if ;
+
+: tref> ( LLVMTypeRef -- type )
+ V{ } clone types [ (tref>) ] with-variable ;
+
+: t. ( type -- )
+ >tref
+ "type-info" LLVMModuleCreateWithName
+ [ "t" rot LLVMAddTypeName drop ]
+ [ LLVMDumpModule ]
+ [ LLVMDisposeModule ] tri ;
+
+EBNF: parse-type
+
+WhiteSpace = " "*
+
+Zero = "0" => [[ drop 0 ]]
+LeadingDigit = [1-9]
+DecimalDigit = [0-9]
+Number = LeadingDigit:d (DecimalDigit)*:ds => [[ ds d prefix string>number ]]
+WhiteNumberSpace = WhiteSpace Number:n WhiteSpace => [[ n ]]
+WhiteZeroSpace = WhiteSpace (Zero | Number):n WhiteSpace => [[ n ]]
+
+Integer = "i" Number:n => [[ n <integer> ]]
+FloatingPoint = ( "float" | "double" | "x86_fp80" | "fp128" | "ppc_fp128" ) => [[ "llvm.types" vocab lookup ]]
+LabelVoidMetadata = ( "label" | "void" | "metadata" | "opaque" ) => [[ "llvm.types" vocab lookup ]]
+Primitive = LabelVoidMetadata | FloatingPoint
+Pointer = T:t WhiteSpace "*" => [[ t <pointer> ]]
+Vector = "<" WhiteNumberSpace:n "x" Type:t ">" => [[ n t <vector> ]]
+StructureTypesList = "," Type:t => [[ t ]]
+Structure = "{" Type:t (StructureTypesList)*:ts "}" => [[ ts t prefix >array f <struct> ]]
+Array = "[" WhiteZeroSpace:n "x" Type:t "]" => [[ n t <array> ]]
+NoFunctionParams = "(" WhiteSpace ")" => [[ drop { } ]]
+VarArgs = WhiteSpace "..." WhiteSpace => [[ drop ... ]]
+ParamListContinued = "," (Type | VarArgs):t => [[ t ]]
+ParamList = "(" Type:t (ParamListContinued*):ts ")" => [[ ts t prefix ]]
+Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts delete ] when t ts >array rot <function> ]]
+PackedStructure = "<" WhiteSpace "{" Type:ty (StructureTypesList)*:ts "}" WhiteSpace ">" => [[ ts ty prefix >array t <struct> ]]
+UpReference = "\\" Number:n => [[ n <up-ref> ]]
+Name = '%' ([a-zA-Z][a-zA-Z0-9]*):id => [[ id flatten >string ]]
+
+T = Pointer | Function | Primitive | Integer | Vector | Structure | PackedStructure | Array | UpReference | Name
+
+Type = WhiteSpace T:t WhiteSpace => [[ t ]]
+
+Program = Type
+
+;EBNF
+
+SYNTAX: TYPE: ";" parse-multiline-string parse-type parsed ;
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: destructors kernel llvm.wrappers sequences tools.test vocabs ;
+
+[ ] [ "test" <module> dispose ] unit-test
+[ ] [ "test" <module> <provider> dispose ] unit-test
+[ ] [ "llvm.jit" vocabs member? [ "test" <module> <provider> <engine> dispose ] unless ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.strings
+io.encodings.utf8 destructors kernel
+llvm.core llvm.engine ;
+
+IN: llvm.wrappers
+
+: llvm-throw ( char* -- )
+ [ utf8 alien>string ] [ LLVMDisposeMessage ] bi throw ;
+
+: <dispose> ( alien class -- disposable ) new swap >>value ;
+
+TUPLE: module value disposed ;
+M: module dispose* value>> LLVMDisposeModule ;
+
+: <module> ( name -- module )
+ LLVMModuleCreateWithName module <dispose> ;
+
+TUPLE: provider value module disposed ;
+M: provider dispose* value>> LLVMDisposeModuleProvider ;
+
+: (provider) ( module -- provider )
+ [ value>> LLVMCreateModuleProviderForExistingModule provider <dispose> ]
+ [ t >>disposed value>> ] bi
+ >>module ;
+
+: <provider> ( module -- provider )
+ [ (provider) ] with-disposal ;
+
+TUPLE: engine value disposed ;
+M: engine dispose* value>> LLVMDisposeExecutionEngine ;
+
+: (engine) ( provider -- engine )
+ [
+ value>> f <void*> f <void*>
+ [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep
+ *void* [ llvm-throw ] when* *void*
+ ]
+ [ t >>disposed drop ] bi
+ engine <dispose> ;
+
+: <engine> ( provider -- engine )
+ [ (engine) ] with-disposal ;
+
+: (add-block) ( name -- basic-block )
+ "function" swap LLVMAppendBasicBlock ;
+
+TUPLE: builder value disposed ;
+M: builder dispose* value>> LLVMDisposeBuilder ;
+
+: <builder> ( name -- builder )
+ (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
+ builder <dispose> ;
+
+TUPLE: buffer value disposed ;
+M: buffer dispose* value>> LLVMDisposeMemoryBuffer ;
+
+: <buffer> ( path -- module )
+ f <void*> f <void*>
+ [ LLVMCreateMemoryBufferWithContentsOfFile drop ] 2keep
+ *void* [ llvm-throw ] when* *void* buffer <dispose> ;
\ No newline at end of file
[ create-collection ] keep ;
: prepare-index ( collection -- )
- "_x_idx" [ "x" asc ] key-spec <index-spec> unique-index ensure-index ;
+ "_x_idx" [ "x" asc ] key-spec <index-spec> t >>unique? ensure-index ;
: insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
prepare-collection
USING: accessors assocs fry io.encodings.binary io.sockets kernel math
math.parser mongodb.msg mongodb.operations namespaces destructors
-constructors sequences splitting checksums checksums.md5 formatting
+constructors sequences splitting checksums checksums.md5
io.streams.duplex io.encodings.utf8 io.encodings.string combinators.smart
arrays hashtables sequences.deep vectors locals ;
mdb-connection get instance>> ; inline
: index-collection ( -- ns )
- mdb-instance name>> "%s.system.indexes" sprintf ; inline
+ mdb-instance name>> "system.indexes" "." glue ; inline
: namespaces-collection ( -- ns )
- mdb-instance name>> "%s.system.namespaces" sprintf ; inline
+ mdb-instance name>> "system.namespaces" "." glue ; inline
: cmd-collection ( -- ns )
- mdb-instance name>> "%s.$cmd" sprintf ; inline
+ mdb-instance name>> "$cmd" "." glue ; inline
: index-ns ( colname -- index-ns )
- [ mdb-instance name>> ] dip "%s.%s" sprintf ; inline
+ [ mdb-instance name>> ] dip "." glue ; inline
: send-message ( message -- )
[ mdb-connection get handle>> ] dip '[ _ write-message ] with-stream* ;
"\"db\" \"127.0.0.1\" 27017 <mdb>"
"[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> ensure-index ] with-db" "" }
{ $unchecked-example "USING: mongodb.driver ;"
- "\"db\" \"127.0.0.1\" 27017 <mdb>" "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> unique-index ensure-index ] with-db" "" } } ;
+ "\"db\" \"127.0.0.1\" 27017 <mdb>" "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> t >>unique? ensure-index ] with-db" "" } } ;
HELP: explain.
{ $values
-USING: accessors assocs bson.constants bson.writer combinators combinators.smart
-constructors continuations destructors formatting fry io io.pools
-io.encodings.binary io.sockets io.streams.duplex kernel linked-assocs hashtables
-namespaces parser prettyprint sequences sets splitting strings uuid arrays
-math math.parser memoize mongodb.connection mongodb.msg mongodb.operations ;
+USING: accessors arrays assocs bson.constants combinators
+combinators.smart constructors destructors formatting fry hashtables
+io io.pools io.sockets kernel linked-assocs math mongodb.connection
+mongodb.msg parser prettyprint sequences sets splitting strings
+tools.continuations uuid memoize locals ;
IN: mongodb.driver
CONSTRUCTOR: index-spec ( ns name key -- index-spec ) ;
-: unique-index ( index-spec -- index-spec )
- t >>unique? ;
-
M: mdb-pool make-connection
mdb>> mdb-open ;
[ make-cursor ] 2tri
swap objects>> ;
+: make-collection-assoc ( collection assoc -- )
+ [ [ name>> "create" ] dip set-at ]
+ [ [ [ capped>> ] keep ] dip
+ '[ _ _
+ [ [ drop t "capped" ] dip set-at ]
+ [ [ size>> "size" ] dip set-at ]
+ [ [ max>> "max" ] dip set-at ] 2tri ] when
+ ] 2bi ;
+
PRIVATE>
SYNTAX: r/ ( token -- mdbregexp )
H{ } clone [ set-at ] keep <mdb-db>
[ verify-nodes ] keep ;
-GENERIC: create-collection ( name -- )
+GENERIC: create-collection ( name/collection -- )
M: string create-collection
<mdb-collection> create-collection ;
M: mdb-collection create-collection
- [ cmd-collection ] dip
- <linked-hash> [
- [ [ name>> "create" ] dip set-at ]
- [ [ [ capped>> ] keep ] dip
- '[ _ _
- [ [ drop t "capped" ] dip set-at ]
- [ [ size>> "size" ] dip set-at ]
- [ [ max>> "max" ] dip set-at ] 2tri ] when
- ] 2bi
- ] keep <mdb-query-msg> 1 >>return# send-query-plain drop ;
-
+ [ [ cmd-collection ] dip
+ <linked-hash> [ make-collection-assoc ] keep
+ <mdb-query-msg> 1 >>return# send-query-plain drop ] keep
+ [ ] [ name>> ] bi mdb-instance collections>> set-at ;
+
: load-collection-list ( -- collection-list )
namespaces-collection
H{ } clone <mdb-query-msg> send-query-plain objects>> ;
: ensure-valid-collection-name ( collection -- )
[ ";$." intersect length 0 > ] keep
- '[ _ "%s contains invalid characters ( . $ ; )" sprintf throw ] when ; inline
-
-: (ensure-collection) ( collection -- )
- mdb-instance collections>> dup keys length 0 =
- [ load-collection-list
- [ [ "options" ] dip key? ] filter
- [ [ "name" ] dip at "." split second <mdb-collection> ] map
- over '[ [ ] [ name>> ] bi _ set-at ] each ] [ ] if
- [ dup ] dip key? [ drop ]
- [ [ ensure-valid-collection-name ] keep create-collection ] if ;
-
+ '[ _ "contains invalid characters ( . $ ; )" "." glue throw ] when ; inline
+
+: build-collection-map ( -- assoc )
+ H{ } clone load-collection-list
+ [ [ "name" ] dip at "." split second <mdb-collection> ] map
+ over '[ [ ] [ name>> ] bi _ set-at ] each ;
+
+: ensure-collection-map ( mdb-instance -- assoc )
+ dup collections>> dup keys length 0 =
+ [ drop build-collection-map [ >>collections drop ] keep ]
+ [ nip ] if ;
+
+: (ensure-collection) ( collection mdb-instance -- collection )
+ ensure-collection-map [ dup ] dip key?
+ [ ] [ [ ensure-valid-collection-name ]
+ [ create-collection ]
+ [ ] tri ] if ;
+
: reserved-namespace? ( name -- ? )
[ "$cmd" = ] [ "system" head? ] bi or ;
: check-collection ( collection -- fq-collection )
- dup mdb-collection? [ name>> ] when
- "." split1 over mdb-instance name>> =
- [ nip ] [ drop ] if
- [ ] [ reserved-namespace? ] bi
- [ [ (ensure-collection) ] keep ] unless
- [ mdb-instance name>> ] dip "%s.%s" sprintf ;
+ [let* | instance [ mdb-instance ]
+ instance-name [ instance name>> ] |
+ dup mdb-collection? [ name>> ] when
+ "." split1 over instance-name =
+ [ nip ] [ drop ] if
+ [ ] [ reserved-namespace? ] bi
+ [ instance (ensure-collection) ] unless
+ [ instance-name ] dip "." glue ] ;
: fix-query-collection ( mdb-query -- mdb-query )
[ check-collection ] change-collection ; inline
: user-defined-key-index ( class -- assoc )
mdb-slot-map user-defined-key
[ drop [ "user-defined-key-index" 1 ] dip
- H{ } clone [ set-at ] keep <tuple-index> unique-index
+ H{ } clone [ set-at ] keep <tuple-index> t >>unique?
[ ] [ name>> ] bi H{ } clone [ set-at ] keep
] [ 2drop H{ } clone ] if ;
: (make-reflection-depthbuffer) ( -- depthbuffer )
gen-renderbuffer [
- GL_RENDERBUFFER_EXT swap glBindRenderbufferEXT
- GL_RENDERBUFFER_EXT GL_DEPTH_COMPONENT32 (reflection-dim) glRenderbufferStorageEXT
+ GL_RENDERBUFFER swap glBindRenderbuffer
+ GL_RENDERBUFFER GL_DEPTH_COMPONENT32 (reflection-dim) glRenderbufferStorage
] keep ;
: (make-reflection-framebuffer) ( depthbuffer -- framebuffer )
gen-framebuffer dup [
- swap [ GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT GL_RENDERBUFFER_EXT ] dip
- glFramebufferRenderbufferEXT
+ swap [ GL_DRAW_FRAMEBUFFER GL_DEPTH_ATTACHMENT GL_RENDERBUFFER ] dip
+ glFramebufferRenderbuffer
] with-framebuffer ;
: (plane-program) ( -- program )
: (reflection-face) ( gadget face -- )
swap reflection-texture>> [
- GL_FRAMEBUFFER_EXT
- GL_COLOR_ATTACHMENT0_EXT
- ] 2dip 0 glFramebufferTexture2DEXT
+ GL_DRAW_FRAMEBUFFER
+ GL_COLOR_ATTACHMENT0
+ ] 2dip 0 glFramebufferTexture2D
check-framebuffer ;
: (draw-reflection-texture) ( gadget -- )
f swap open-window* ;
: into-window ( world quot -- world )
- [ dup handle>> ] dip with-gl-context ; inline
+ [ dup ] dip with-gl-context ; inline
--- /dev/null
+Syntax and combinators for manipulating algebraic data types
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: arrays classes classes.singleton classes.tuple help.markup
+help.syntax kernel multiline slots quotations ;
+IN: variants
+
+HELP: VARIANT:
+{ $syntax <"
+VARIANT: class-name
+ singleton
+ singleton
+ tuple: { slot slot slot ... }
+ .
+ .
+ .
+ ; "> }
+{ $description "Defines " { $snippet "class-name" } " as a union of the following " { $link singleton-class } " and " { $link tuple-class } " definitions. Each " { $snippet "singleton" } " word is defined as a " { $snippet "singleton-class" } ", and each " { $snippet "tuple" } " word is defined aas a " { $snippet "tuple-class" } " with the given set of " { $snippet "slot" } "s, using the same syntax for slot specifiers as " { $link POSTPONE: TUPLE: } ". Typed tuple slots can recursively reference the variant " { $snippet "class-name" } " being defined. For " { $snippet "tuple" } " types, a " { $link boa } " constructor word " { $snippet "<tuple>" } " is defined as well." }
+{ $examples { $code <"
+USING: kernel variants ;
+IN: scratchpad
+
+VARIANT: list
+ nil
+ cons: { { first object } { rest list } }
+ ;
+"> } } ;
+
+HELP: match
+{ $values { "branches" array } }
+{ $description "Dispatches on the type of the value on the top of the stack. If the type is a " { $link singleton-class } ", the corresponding quotation is called with the underlying stack unchanged. If the type is a " { $link tuple-class } ", the tuple slots are pushed onto the stack by order of arguments." }
+{ $examples { $example <"
+USING: kernel math prettyprint variants ;
+IN: scratchpad
+
+VARIANT: list
+ nil
+ cons: { { first object } { rest list } }
+ ;
+
+: list-length ( list -- length )
+ {
+ { nil [ 0 ] }
+ { cons [ nip list-length 1 + ] }
+ } match ;
+
+1 2 3 4 nil <cons> <cons> <cons> <cons> list-length .
+"> "4" } } ;
+
+HELP: unboa
+{ $values { "class" class } }
+{ $description "Decomposes a tuple of type " { $snippet "class" } " into its component slot values by order of arguments. The inverse of " { $link boa } "." } ;
+
+HELP: variant-class
+{ $class-description "This class comprises class names that have been defined with " { $link POSTPONE: VARIANT: } ". When a " { $snippet "variant-class" } " is used as the type of a specialized " { $link tuple } " slot, the variant's first member type is used as the default " { $link initial-value } "." } ;
+
+{ POSTPONE: VARIANT: variant-class match } related-words
+
+ARTICLE: "variants" "Algebraic data types"
+"The " { $vocab-link "variants" } " vocabulary provides syntax and combinators for defining and manipulating algebraic data types."
+{ $subsection POSTPONE: VARIANT: }
+{ $subsection variant-class }
+{ $subsection match } ;
+
+ABOUT: "variants"
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: kernel math tools.test variants ;
+IN: variants.tests
+
+VARIANT: list
+ nil
+ cons: { { first object } { rest list } }
+ ;
+
+[ t ] [ nil list? ] unit-test
+[ t ] [ 1 nil <cons> list? ] unit-test
+[ f ] [ 1 list? ] unit-test
+
+: list-length ( list -- length )
+ {
+ { nil [ 0 ] }
+ { cons [ nip list-length 1 + ] }
+ } match ;
+
+[ 4 ]
+[ 5 6 7 8 nil <cons> <cons> <cons> <cons> list-length ] unit-test
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: accessors arrays classes classes.mixin classes.parser
+classes.singleton classes.tuple classes.tuple.parser
+classes.union combinators inverse kernel lexer macros make
+parser quotations sequences slots splitting words ;
+IN: variants
+
+PREDICATE: variant-class < mixin-class "variant" word-prop ;
+
+M: variant-class initial-value*
+ dup members [ no-initial-value ]
+ [ nip first dup word? [ initial-value* ] unless ] if-empty ;
+
+: define-tuple-class-and-boa-word ( class superclass slots -- )
+ pick [ define-tuple-class ] dip
+ dup name>> "<" ">" surround create-in swap define-boa-word ;
+
+: define-variant-member ( member -- class )
+ dup array? [ first3 pick [ define-tuple-class-and-boa-word ] dip ] [ dup define-singleton-class ] if ;
+
+: define-variant-class ( class members -- )
+ [ [ define-mixin-class ] [ t "variant" set-word-prop ] [ ] tri ] dip
+ [ define-variant-member swap add-mixin-instance ] with each ;
+
+: parse-variant-tuple-member ( name -- member )
+ create-class-in tuple
+ "{" expect
+ [ "}" parse-tuple-slots-delim ] { } make
+ 3array ;
+
+: parse-variant-member ( name -- member )
+ ":" ?tail [ parse-variant-tuple-member ] [ create-class-in ] if ;
+
+: parse-variant-members ( -- members )
+ [ scan dup ";" = not ]
+ [ parse-variant-member ] produce nip ;
+
+SYNTAX: VARIANT:
+ CREATE-CLASS
+ parse-variant-members
+ define-variant-class ;
+
+MACRO: unboa ( class -- )
+ <wrapper> \ boa [ ] 2sequence [undo] ;
+
+GENERIC# (match-branch) 1 ( class quot -- class quot' )
+
+M: singleton-class (match-branch)
+ \ drop prefix ;
+M: object (match-branch)
+ over \ unboa [ ] 2sequence prepend ;
+
+: ?class ( object -- class )
+ dup word? [ class ] unless ;
+
+MACRO: match ( branches -- )
+ [ dup callable? [ first2 (match-branch) 2array ] unless ] map
+ [ \ dup \ ?class ] dip \ case [ ] 4sequence ;
+
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel furnace.actions html.forms
-http.server.dispatchers db db.tuples db.types urls
-furnace.redirection multiline http namespaces ;
+USING: accessors furnace.actions furnace.redirection
+html.forms http http.server http.server.dispatchers
+io.directories io.encodings.utf8 io.files io.pathnames
+kernel math.parser multiline namespaces sequences urls ;
IN: webapps.imagebin
-TUPLE: imagebin < dispatcher ;
-
-TUPLE: image id path ;
-
-image "IMAGE" {
- { "id" "ID" INTEGER +db-assigned-id+ }
- { "path" "PATH" { VARCHAR 256 } +not-null+ }
-} define-persistent
+TUPLE: imagebin < dispatcher path n ;
: <uploaded-image-action> ( -- action )
<page-action>
{ imagebin "uploaded-image" } >>template ;
-SYMBOL: my-post-data
+: next-image-path ( -- path )
+ imagebin get
+ [ path>> ] [ n>> number>string ] bi append-path ;
+
+M: imagebin call-responder*
+ [ imagebin set ] [ call-next-method ] bi ;
+
+: move-image ( mime-file -- )
+ next-image-path
+ [ [ temporary-path>> ] dip move-file ]
+ [ [ filename>> ] dip ".txt" append utf8 set-file-contents ] 2bi ;
+
: <upload-image-action> ( -- action )
<page-action>
{ imagebin "upload-image" } >>template
[
-
- ! request get post-data>> my-post-data set-global
- ! image new
- ! "file" value
- ! insert-tuple
+ "file1" param [ move-image ] when*
+ "file2" param [ move-image ] when*
+ "file3" param [ move-image ] when*
"uploaded-image" <redirect>
] >>submit ;
-: <imagebin> ( -- responder )
+: <imagebin> ( image-directory -- responder )
imagebin new-dispatcher
+ swap [ make-directories ] [ >>path ] bi
+ 0 >>n
<upload-image-action> "" add-responder
<upload-image-action> "upload-image" add-responder
<uploaded-image-action> "uploaded-image" add-responder ;
+"resource:images" <imagebin> main-responder set-global
<html>
<head><title>Uploaded</title></head>
<body>
-hi from uploaded-image
+You uploaded something!
</body>
</html>
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel
-cocoa
-cocoa.application
-cocoa.types
-cocoa.classes
-cocoa.windows
-core-graphics.types ;
+USING: cocoa cocoa.application cocoa.types cocoa.classes cocoa.windows
+core-graphics.types kernel math.bitwise ;
IN: webkit-demo
FRAMEWORK: /System/Library/Frameworks/WebKit.framework
WebView -> alloc
rect f f -> initWithFrame:frameName:groupName: ;
+: window-style ( -- n )
+ {
+ NSClosableWindowMask
+ NSMiniaturizableWindowMask
+ NSResizableWindowMask
+ NSTitledWindowMask
+ } flags ;
+
: <WebWindow> ( -- id )
- <WebView> rect <ViewWindow> ;
+ <WebView> rect window-style <ViewWindow> ;
: load-url ( window url -- )
[ -> contentView ] [ <NSString> ] bi* -> setMainFrameURL: ;
syn cluster factorDefnContents contains=@factorCluster,factorStackEffect,factorArray0,factorQuotation0
-syn region factorDefn matchgroup=factorDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
+syn region factorDefn matchgroup=factorDefnDelims start=/\<\(MACRO\|MACRO::\|MEMO:\|MEMO::\|:\|::\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
syn region factorMethod matchgroup=factorMethodDelims start=/\<M:\s\+\S\+\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
syn region factorGeneric matchgroup=factorGenericDelims start=/\<GENERIC:\s\+\S\+\>/ end=/$/ contains=factorStackEffect
syn region factorGenericN matchgroup=factorGenericNDelims start=/\<GENERIC#\s\+\S\+\s\+\d\+\>/ end=/$/ contains=factorStackEffect
-syn region factorPrivateDefn matchgroup=factorPrivateDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
+syn region factorPrivateDefn matchgroup=factorPrivateDefnDelims start=/\<\(MACRO\|MACRO::\|MEMO:\|MEMO::\|:\|::\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
syn region factorPrivateMethod matchgroup=factorPrivateMethodDelims start=/\<M:\s\+\S\+\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
syn region factorPGeneric matchgroup=factorPGenericDelims start=/\<GENERIC:\s\+\S\+\>/ end=/$/ contains=factorStackEffect contained
syn region factorPGenericN matchgroup=factorPGenericNDelims start=/\<GENERIC#\s\+\S\+\s\+\d\+\>/ end=/$/ contains=factorStackEffect
"HELP:" "HEX:" "HOOK:"
"IN:" "initial:" "INSTANCE:" "INTERSECTION:"
"LIBRARY:"
- "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
+ "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"
+ "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
"OCT:"
"POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
"QUALIFIED-WITH:" "QUALIFIED:"
(format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
(defconst fuel-syntax--method-definition-regex
- "^M: +\\([^ ]+\\) +\\([^ ]+\\)")
+ "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")
(defconst fuel-syntax--integer-regex
"\\_<-?[0-9]+\\_>")
"C-ENUM" "C-STRUCT" "C-UNION"
"FROM" "FUNCTION:"
"INTERSECTION:"
- "M" "MACRO" "MACRO:"
+ "M" "M:" "MACRO" "MACRO:"
"MEMO" "MEMO:" "METHOD"
"SYNTAX"
"PREDICATE" "PRIMITIVE"
(format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))
(defconst fuel-syntax--defun-signature-regex
- (format "\\(%s\\|%s\\)" fuel-syntax--word-signature-regex "M[^:]*: [^ ]+ [^ ]+"))
+ (format "\\(%s\\|%s\\)"
+ fuel-syntax--word-signature-regex
+ "M[^:]*: [^ ]+ [^ ]+"))
(defconst fuel-syntax--constructor-decl-regex
"\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
box_alien(ffi_dlsym(NULL,sym));
else
{
- tagged<dll> d = library.as<dll>();
- d.untag_check();
+ dll *d = untag_check<dll>(library.value());
if(d->dll == NULL)
dpush(F);
else
- box_alien(ffi_dlsym(d.untagged(),sym));
+ box_alien(ffi_dlsym(d,sym));
}
}
/* close a native library handle */
PRIMITIVE(dlclose)
{
- ffi_dlclose(untag_check<dll>(dpop()));
+ dll *d = untag_check<dll>(dpop());
+ if(d->dll != NULL)
+ ffi_dlclose(d);
}
PRIMITIVE(dll_validp)
if(library == F)
dpush(T);
else
- dpush(
tagged<dll>(library)->dll == NULL ? F : T);
+ dpush(
untag_check<dll>(library)->dll == NULL ? F : T);
}
/* gets the address of an object representing a C pointer */
projects / factor.git / commitdiff