Merge branch 'master' of git://github.com/slavapestov/factor

basis/alien/fortran/fortran.factor

@@ -434,15 +434,15 @@ MACRO: fortran-invoke ( return library function parameters -- )
     [ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
 
 SYNTAX: SUBROUTINE: 
-    f "c-library" get scan ";" parse-tokens
+    f current-library get scan ";" parse-tokens
     [ "()" subseq? not ] filter define-fortran-function ;
 
 SYNTAX: FUNCTION:
-    scan "c-library" get scan ";" parse-tokens
+    scan current-library get scan ";" parse-tokens
     [ "()" subseq? not ] filter define-fortran-function ;
 
 SYNTAX: LIBRARY:
     scan
-    [ "c-library" set ]
+    [ current-library set ]
     [ set-fortran-abi ] bi ;
 

basis/alien/libraries/libraries.factor

@@ -38,6 +38,11 @@ M: library dispose dll>> [ dispose ] when* ;
 : library-abi ( library -- abi )
     library [ abi>> ] [ cdecl ] if* ;
 
+ERROR: no-such-symbol name library ;
+
+: address-of ( name library -- value )
+    2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
+
 SYMBOL: deploy-libraries
 
 deploy-libraries [ V{ } clone ] initialize

basis/alien/parser/parser.factor

@@ -7,6 +7,8 @@ splitting words fry locals lexer namespaces summary math
 vocabs.parser words.constant ;
 IN: alien.parser
 
+SYMBOL: current-library
+
 : parse-c-type-name ( name -- word )
     dup search [ ] [ no-word ] ?if ;
 
@@ -117,7 +119,7 @@ PRIVATE>
     names return function-effect ;
 
 : (FUNCTION:) ( -- word quot effect )
-    scan-function-name "c-library" get ";" scan-c-args make-function ;
+    scan-function-name current-library get ";" scan-c-args make-function ;
 
 : callback-quot ( return types abi -- quot )
     '[ [ _ _ _ ] dip alien-callback ] ;
@@ -131,7 +133,7 @@ PRIVATE>
     type-word return types lib library-abi callback-quot (( quot -- alien )) ;
 
 : (CALLBACK:) ( -- word quot effect )
-    "c-library" get
+    current-library get
     scan-function-name ";" scan-c-args make-callback-type ;
 
 PREDICATE: alien-function-word < word
@@ -142,3 +144,10 @@ PREDICATE: alien-function-word < word
 
 PREDICATE: alien-callback-type-word < typedef-word
     "callback-effect" word-prop ;
+
+: global-quot ( type word -- quot )
+    name>> current-library get '[ _ _ address-of 0 ]
+    swap c-type-getter-boxer append ;
+
+: define-global ( type word -- )
+    [ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;

basis/alien/syntax/syntax.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays alien alien.c-types
+USING: accessors arrays alien alien.c-types alien.arrays
-alien.arrays alien.strings kernel math namespaces parser
+alien.strings kernel math namespaces parser sequences words
-sequences words quotations math.parser splitting grouping
+quotations math.parser splitting grouping effects assocs
-effects assocs combinators lexer strings.parser alien.parser 
+combinators lexer strings.parser alien.parser fry vocabs.parser
-fry vocabs.parser words.constant alien.libraries ;
+words.constant alien.libraries ;
 IN: alien.syntax
 
 SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ;
@@ -13,7 +13,7 @@ SYNTAX: ALIEN: 16 scan-base <alien> suffix! ;
 
 SYNTAX: BAD-ALIEN <bad-alien> suffix! ;
 
-SYNTAX: LIBRARY: scan "c-library" set ;
+SYNTAX: LIBRARY: scan current-library set ;
 
 SYNTAX: FUNCTION:
     (FUNCTION:) define-declared ;
@@ -33,20 +33,8 @@ SYNTAX: C-ENUM:
 SYNTAX: C-TYPE:
     void CREATE-C-TYPE typedef ;
 
-ERROR: no-such-symbol name library ;
-
-: address-of ( name library -- value )
-    2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
-
 SYNTAX: &:
-    scan "c-library" get '[ _ _ address-of ] append! ;
+    scan current-library get '[ _ _ address-of ] append! ;
-
-: global-quot ( type word -- quot )
-    name>> "c-library" get '[ _ _ address-of 0 ]
-    swap c-type-getter-boxer append ;
-
-: define-global ( type word -- )
-    [ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
 
 SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ;
 

basis/classes/struct/struct-tests.factor

@@ -4,9 +4,11 @@ assocs byte-arrays classes.struct classes.tuple.parser
 classes.tuple.private classes.tuple combinators compiler.tree.debugger
 compiler.units destructors io.encodings.utf8 io.pathnames
 io.streams.string kernel libc literals math mirrors namespaces
-prettyprint prettyprint.config see sequences specialized-arrays system
+prettyprint prettyprint.config see sequences specialized-arrays
-tools.test parser lexer eval layouts generic.single classes ;
+system tools.test parser lexer eval layouts generic.single classes
+vocabs ;
 FROM: math => float ;
+FROM: specialized-arrays.private => specialized-array-vocab ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: char
 SPECIALIZED-ARRAY: int
@@ -303,6 +305,12 @@ SPECIALIZED-ARRAY: struct-test-optimization
     { x>> } inlined?
 ] unit-test
 
+[ ] [
+    [
+        struct-test-optimization specialized-array-vocab forget-vocab
+    ] with-compilation-unit
+] unit-test
+
 ! Test cloning structs
 STRUCT: clone-test-struct { x int } { y char[3] } ;
 

basis/compiler/codegen/codegen.factor

@@ -18,6 +18,7 @@ compiler.cfg.builder
 compiler.codegen.fixup
 compiler.utilities ;
 FROM: namespaces => set ;
+FROM: compiler.errors => no-such-symbol ;
 IN: compiler.codegen
 
 SYMBOL: insn-counts
@@ -415,13 +416,18 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
         dll-path compiling-word get no-such-library drop
     ] if ;
 
-: stdcall-mangle ( params -- symbols )
+: decorated-symbol ( params -- symbols )
     [ function>> ] [ parameters>> parameter-offsets drop number>string ] bi
-    [ drop ] [ "@" glue ] [ "@" glue "_" prepend ] 2tri
+    {
-    3array ;
+        [ drop ]
+        [ "@" glue ]
+        [ "@" glue "_" prepend ]
+        [ "@" glue "@" prepend ]
+    } 2cleave
+    4array ;
 
 : alien-invoke-dlsym ( params -- symbols dll )
-    [ dup abi>> stdcall = [ stdcall-mangle ] [ function>> ] if ]
+    [ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
     [ library>> load-library ]
     bi 2dup check-dlsym ;
 

basis/compiler/constants/constants.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel layouts system strings words quotations byte-arrays
-alien arrays literals sequences ;
+alien alien.syntax arrays literals sequences ;
 IN: compiler.constants
 
 ! These constants must match vm/memory.h
@@ -40,32 +40,41 @@ CONSTANT: deck-bits 18
 : segment-end-offset ( -- n ) 2 bootstrap-cells ; inline
 
 ! Relocation classes
-CONSTANT: rc-absolute-cell 0
+C-ENUM: f
-CONSTANT: rc-absolute 1
+    rc-absolute-cell
-CONSTANT: rc-relative 2
+    rc-absolute
-CONSTANT: rc-absolute-ppc-2/2 3
+    rc-relative
-CONSTANT: rc-absolute-ppc-2 4
+    rc-absolute-ppc-2/2
-CONSTANT: rc-relative-ppc-2 5
+    rc-absolute-ppc-2
-CONSTANT: rc-relative-ppc-3 6
+    rc-relative-ppc-2
-CONSTANT: rc-relative-arm-3 7
+    rc-relative-ppc-3
-CONSTANT: rc-indirect-arm 8
+    rc-relative-arm-3
-CONSTANT: rc-indirect-arm-pc 9
+    rc-indirect-arm
-CONSTANT: rc-absolute-2 10
+    rc-indirect-arm-pc
+    rc-absolute-2
+    rc-absolute-1 ;
 
 ! Relocation types
-CONSTANT: rt-dlsym 0
+C-ENUM: f
-CONSTANT: rt-entry-point 1
+    rt-dlsym
-CONSTANT: rt-entry-point-pic 2
+    rt-entry-point
-CONSTANT: rt-entry-point-pic-tail 3
+    rt-entry-point-pic
-CONSTANT: rt-here 4
+    rt-entry-point-pic-tail
-CONSTANT: rt-this 5
+    rt-here
-CONSTANT: rt-literal 6
+    rt-this
-CONSTANT: rt-untagged 7
+    rt-literal
-CONSTANT: rt-megamorphic-cache-hits 8
+    rt-untagged
-CONSTANT: rt-vm 9
+    rt-megamorphic-cache-hits
-CONSTANT: rt-cards-offset 10
+    rt-vm
-CONSTANT: rt-decks-offset 11
+    rt-cards-offset
-CONSTANT: rt-exception-handler 12
+    rt-decks-offset
+    rt-exception-handler ;
 
 : rc-absolute? ( n -- ? )
-    ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
+    ${
+        rc-absolute-ppc-2/2
+        rc-absolute-cell
+        rc-absolute
+        rc-absolute-2
+        rc-absolute-1
+    } member? ;

basis/compiler/tests/alien.factor

@@ -20,7 +20,9 @@ IN: compiler.tests.alien
         { [ os unix?  ]  [ "libfactor-ffi-test.so" ] }
     } cond append-path ;
 
-"f-cdecl" libfactor-ffi-tests-path cdecl add-library
+: mingw? ( -- ? ) os windows? vm-compiler "GCC" head? and ;
+
+"f-cdecl" libfactor-ffi-tests-path mingw? mingw cdecl ? add-library
 
 "f-stdcall" libfactor-ffi-tests-path stdcall add-library
 
@@ -653,55 +655,105 @@ FUNCTION: void this_does_not_exist ( ) ;
     test-struct-11 "f-fastcall" "ffi_test_58" { int int int }
     alien-invoke gc ;
 
-[ 13 ] [ 3 4.0 5 ffi_test_52 ] unit-test
+! GCC bugs
-[ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
+mingw? [
+    [ 13 ] [ 3 4.0 5 ffi_test_52 ] unit-test
+
+    [ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
+] unless
+
 [ S{ test-struct-11 f 7 -1 } ] [ 3 4 ffi_test_57 ] unit-test
+
 [ S{ test-struct-11 f 7 -3 } ] [ 3 4 7 ffi_test_58 ] unit-test
 
 : fastcall-ii-indirect ( x y ptr -- result )
     int { int int } fastcall alien-indirect ;
+
 : fastcall-iii-indirect ( x y z ptr -- result )
     int { int int int } fastcall alien-indirect ;
+
 : fastcall-ifi-indirect ( x y z ptr -- result )
     int { int float int } fastcall alien-indirect ;
+
 : fastcall-ifii-indirect ( x y z w ptr -- result )
     int { int float int int } fastcall alien-indirect ;
+
 : fastcall-struct-return-ii-indirect ( x y ptr -- result )
     test-struct-11 { int int } fastcall alien-indirect ;
+
 : fastcall-struct-return-iii-indirect ( x y z ptr -- result )
     test-struct-11 { int int int } fastcall alien-indirect ;
 
-[ 8 ] [ 3 4 &: ffi_test_50 fastcall-ii-indirect ] unit-test
+: win32? ( -- ? ) os windows? cpu x86.32? and ;
-[ 13 ] [ 3 4 5 &: ffi_test_51 fastcall-iii-indirect ] unit-test
+
-[ 13 ] [ 3 4.0 5 &: ffi_test_52 fastcall-ifi-indirect ] unit-test
+[ 8 ] [
-[ 19 ] [ 3 4.0 5 6 &: ffi_test_53 fastcall-ifii-indirect ] unit-test
+    3 4
+    win32? [ &: @ffi_test_50@8 ] [ &: ffi_test_50 ] if
+    fastcall-ii-indirect
+] unit-test
+
+[ 13 ] [
+    3 4 5
+    win32? [ &: @ffi_test_51@12 ] [ &: ffi_test_51 ] if
+    fastcall-iii-indirect
+] unit-test
+
+mingw? [
+    [ 13 ] [
+        3 4.0 5
+        win32? [ &: @ffi_test_52@12 ] [ &: ffi_test_52 ] if
+        fastcall-ifi-indirect
+    ] unit-test
+
+    [ 19 ] [
+        3 4.0 5 6
+        win32? [ &: @ffi_test_53@16 ] [ &: ffi_test_53 ] if
+        fastcall-ifii-indirect
+    ] unit-test
+] unless
 
 [ S{ test-struct-11 f 7 -1 } ]
-[ 3 4 &: ffi_test_57 fastcall-struct-return-ii-indirect ] unit-test
+[
+    3 4
+    win32? [ &: @ffi_test_57@8 ] [ &: ffi_test_57 ] if
+    fastcall-struct-return-ii-indirect
+] unit-test
 
 [ S{ test-struct-11 f 7 -3 } ]
-[ 3 4 7 &: ffi_test_58 fastcall-struct-return-iii-indirect ] unit-test
+[
+    3 4 7
+    win32? [ &: @ffi_test_58@12 ] [ &: ffi_test_58 ] if
+    fastcall-struct-return-iii-indirect
+] unit-test
 
 : fastcall-ii-callback ( -- ptr )
     int { int int } fastcall [ + 1 + ] alien-callback ;
+
 : fastcall-iii-callback ( -- ptr )
     int { int int int } fastcall [ + + 1 + ] alien-callback ;
+
 : fastcall-ifi-callback ( -- ptr )
     int { int float int } fastcall
     [ [ >integer ] dip + + 1 + ] alien-callback ;
+
 : fastcall-ifii-callback ( -- ptr )
     int { int float int int } fastcall
     [ [ >integer ] 2dip + + + 1 + ] alien-callback ;
+
 : fastcall-struct-return-ii-callback ( -- ptr )
     test-struct-11 { int int } fastcall
     [ [ + ] [ - ] 2bi test-struct-11 <struct-boa> ] alien-callback ;
+
 : fastcall-struct-return-iii-callback ( -- ptr )
     test-struct-11 { int int int } fastcall
     [ [ drop + ] [ - nip ] 3bi test-struct-11 <struct-boa> ] alien-callback ;
 
 [ 8 ] [ 3 4 fastcall-ii-callback fastcall-ii-indirect ] unit-test
+
 [ 13 ] [ 3 4 5 fastcall-iii-callback fastcall-iii-indirect ] unit-test
+
 [ 13 ] [ 3 4.0 5 fastcall-ifi-callback fastcall-ifi-indirect ] unit-test
+
 [ 19 ] [ 3 4.0 5 6 fastcall-ifii-callback fastcall-ifii-indirect ] unit-test
 
 [ S{ test-struct-11 f 7 -1 } ]

basis/cpu/ppc/bootstrap.factor

@@ -286,25 +286,19 @@ CONSTANT: nv-reg 17
     4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel
 ] pic-load jit-define
 
-! Tag
+[ 4 4 tag-mask get ANDI ] pic-tag jit-define
-: load-tag ( -- )
-    4 4 tag-mask get ANDI
-    4 4 tag-bits get SLWI ;
 
-[ load-tag ] pic-tag jit-define
-
-! Tuple
 [
     3 4 MR
-    load-tag
+    4 4 tag-mask get ANDI
-    0 4 tuple type-number tag-fixnum CMPI
+    0 4 tuple type-number CMPI
     [ BNE ]
-    [ 4 3 tuple type-number neg 4 + LWZ ]
+    [ 4 3 tuple-class-offset LWZ ]
     jit-conditional*
 ] pic-tuple jit-define
 
 [
-    0 4 0 CMPI rc-absolute-ppc-2 rt-literal jit-rel
+    0 4 0 CMPI rc-absolute-ppc-2 rt-untagged jit-rel
 ] pic-check-tag jit-define
 
 [
@@ -342,6 +336,14 @@ CONSTANT: nv-reg 17
 ! ! ! Megamorphic caches
 
 [
+    ! class = ...
+    3 4 MR
+    4 4 tag-mask get ANDI
+    4 4 tag-bits get SLWI
+    0 4 tuple type-number tag-fixnum CMPI
+    [ BNE ]
+    [ 4 3 tuple-class-offset LWZ ]
+    jit-conditional*
     ! cache = ...
     0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
     ! key = hashcode(class)

basis/cpu/x86/32/32.factor

@@ -315,9 +315,6 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
     [ abi>> mingw = os windows? not or ]
     bi and ;
 
-: callee-cleanup? ( abi -- ? )
-    { stdcall fastcall thiscall } member? ;
-
 : stack-arg-size ( params -- n )
     dup abi>> '[
         alien-parameters flatten-value-types
@@ -359,6 +356,7 @@ M: long-long-type flatten-value-type (flatten-stack-type) ;
 M: c-type flatten-value-type
     dup rep>> int-rep? [ (flatten-int-type) ] [ (flatten-stack-type) ] if ;
 
-M: x86.32 struct-return-pointer-type (stack-value) ;
+M: x86.32 struct-return-pointer-type
+    os linux? void* (stack-value) ? ;
 
 check-sse

basis/cpu/x86/32/bootstrap.factor

@@ -176,6 +176,10 @@ IN: bootstrap.x86
 [ jit-jump-quot ]
 \ lazy-jit-compile define-combinator-primitive
 
+[
+    temp1 HEX: ffffffff CMP rc-absolute-cell rt-literal jit-rel
+] pic-check-tuple jit-define
+
 ! Inline cache miss entry points
 : jit-load-return-address ( -- )
     pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;

basis/cpu/x86/64/bootstrap.factor

@@ -160,6 +160,11 @@ IN: bootstrap.x86
 [ jit-jump-quot ]
 \ lazy-jit-compile define-combinator-primitive
 
+[
+    temp2 HEX: ffffffff MOV rc-absolute-cell rt-literal jit-rel
+    temp1 temp2 CMP
+] pic-check-tuple jit-define
+
 ! Inline cache miss entry points
 : jit-load-return-address ( -- )
     RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;

basis/cpu/x86/bootstrap.factor

@@ -206,43 +206,37 @@ big-endian off
 
 ! Load a value from a stack position
 [
-    temp1 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel
+    temp1 ds-reg HEX: 7f [+] MOV rc-absolute-1 rt-untagged jit-rel
 ] pic-load jit-define
 
-! Tag
+[ temp1 tag-mask get AND ] pic-tag jit-define
-: load-tag ( -- )
-    temp1 tag-mask get AND
-    temp1 tag-bits get SHL ;
 
-[ load-tag ] pic-tag jit-define
-
-! The 'make' trick lets us compute the jump distance for the
-! conditional branches there
-
-! Tuple
 [
     temp0 temp1 MOV
-    load-tag
+    temp1 tag-mask get AND
-    temp1 tuple type-number tag-fixnum CMP
+    temp1 tuple type-number CMP
     [ JNE ]
-    [ temp1 temp0 tuple type-number neg bootstrap-cell + [+] MOV ]
+    [ temp1 temp0 tuple-class-offset [+] MOV ]
     jit-conditional
 ] pic-tuple jit-define
 
 [
-    temp1 HEX: ffffffff CMP rc-absolute rt-literal jit-rel
+    temp1 HEX: 7f CMP rc-absolute-1 rt-untagged jit-rel
 ] pic-check-tag jit-define
 
-[
-    temp2 HEX: ffffffff MOV rc-absolute-cell rt-literal jit-rel
-    temp1 temp2 CMP
-] pic-check-tuple jit-define
-
 [ 0 JE rc-relative rt-entry-point jit-rel ] pic-hit jit-define
 
 ! ! ! Megamorphic caches
 
 [
+    ! class = ...
+    temp0 temp1 MOV
+    temp1 tag-mask get AND
+    temp1 tag-bits get SHL
+    temp1 tuple type-number tag-fixnum CMP
+    [ JNE ]
+    [ temp1 temp0 tuple-class-offset [+] MOV ]
+    jit-conditional
     ! cache = ...
     temp0 0 MOV rc-absolute-cell rt-literal jit-rel
     ! key = hashcode(class)
@@ -256,14 +250,16 @@ big-endian off
     temp0 temp2 ADD
     ! if(get(cache) == class)
     temp0 [] temp1 CMP
-    bootstrap-cell 4 = 14 22 ? JNE ! Yuck!
+    [ JNE ]
-    ! megamorphic_cache_hits++
+    [
-    temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel
+        ! megamorphic_cache_hits++
-    temp1 [] 1 ADD
+        temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel
-    ! goto get(cache + bootstrap-cell)
+        temp1 [] 1 ADD
-    temp0 temp0 bootstrap-cell [+] MOV
+        ! goto get(cache + bootstrap-cell)
-    temp0 word-entry-point-offset [+] JMP
+        temp0 temp0 bootstrap-cell [+] MOV
-    ! fall-through on miss
+        temp0 word-entry-point-offset [+] JMP
+        ! fall-through on miss
+    ] jit-conditional
 ] mega-lookup jit-define
 
 ! ! ! Sub-primitives

basis/furnace/actions/actions-docs.factor

@@ -31,7 +31,7 @@ HELP: new-action
 { $description "Constructs a subclass of " { $link action } "." } ;
 
 HELP: page-action
-{ $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ;
+{ $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "template" } " slot. The " { $slot "template" } " slot contains a pair with shape " { $snippet "{ responder name }" } "." } ;
 
 HELP: validate-integer-id
 { $description "A utility word which validates an integer parameter named " { $snippet "id" } "." }

basis/game/input/x11/x11.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2010 Erik Charlebois, William Schlieper.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel game.input namespaces
+USING: accessors alien.c-types arrays kernel game.input namespaces math
 classes bit-arrays system sequences vectors x11 x11.xlib ;
 IN: game.input.x11
 
@@ -84,9 +84,24 @@ M: linux x>hid-bit-order
 M: x11-game-input-backend read-keyboard
     dpy get 256 <bit-array> [ XQueryKeymap drop ] keep
     x-bits>hid-bits keyboard-state boa ;
+
+: query-pointer ( -- x y buttons )
+    dpy get dup XDefaultRootWindow
+    0 <int> 0 <int> 0 <int> 0 <int> 0 <int> 0 <int> 0 <int>
+    [ XQueryPointer drop ] 3keep
+    [ *int ] tri@ ;
+
+SYMBOL: mouse-reset?
      
 M: x11-game-input-backend read-mouse
-    0 0 0 0 2 <vector> mouse-state boa ;
+    mouse-reset? get [ reset-mouse ] unless
+    query-pointer
+    mouse-state new
+    swap 256 /i >>buttons
+    swap 400 - >>dy
+    swap 400 - >>dx
+    0 >>scroll-dy 0 >>scroll-dx ;
      
 M: x11-game-input-backend reset-mouse
-    ;
+    dpy get dup XDefaultRootWindow dup
+    0 0 0 0 400 400 XWarpPointer drop t mouse-reset? set-global ;

basis/html/components/components-docs.factor

@@ -29,7 +29,7 @@ HELP: textarea
 { $class-description "Text area components display a multi-line editor for a string value. The " { $slot "rows" } " and " { $slot "cols" } " properties determine the size of the text area." } ;
 
 HELP: link
-{ $description "Link components render a link to an object stored at a value, with the link title and URL determined by the " { $link link-title } " and " { $link link-href } " generic words. The optional " { $slot "target" } " slot is a target frame to open the link in." } ;
+{ $description "Link components render a value responding to the " { $link link-title } " and " { $link link-href } " generic words. The optional " { $slot "target" } " slot is a target frame to open the link in." } ;
 
 HELP: link-title
 { $values { "obj" object } { "string" string } }

basis/html/components/components.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg
+! Copyright (C) 2008, 2010 Slava Pestov, Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces io math.parser assocs classes
 classes.tuple words arrays sequences splitting mirrors
@@ -117,6 +117,13 @@ M: string link-href ;
 M: url link-title ;
 M: url link-href ;
 
+TUPLE: simple-link title href ;
+
+C: <simple-link> simple-link
+
+M: simple-link link-title title>> ;
+M: simple-link link-href href>> ;
+
 TUPLE: link target ;
 
 M: link render*

basis/html/templates/chloe/chloe-docs.factor

@@ -60,7 +60,7 @@ HELP: compile-with-scope
 { $description "Calls the quotation and wraps any output it compiles in a " { $link with-scope } " form." } ;
 
 ARTICLE: "html.templates.chloe.tags.component" "Component Chloe tags"
-"The following Chloe tags correspond exactly to " { $link "html.components" } ". Singleton component tags do not allow any attributes. Attributes of tuple component tags are mapped to tuple slot values of the component instance."
+"The following Chloe tags correspond exactly to " { $link "html.components" } ". The " { $snippet "name" } " attribute should be the name of a form value (see " { $link "html.forms.values" } "). Singleton component tags do not allow any other attributes. Tuple component tags map all other attributes to tuple slot values of the component instance."
 { $table
     { "Tag" "Component class" }
     { { $snippet "t:checkbox" }   { $link checkbox } }

basis/specialized-arrays/specialized-arrays-tests.factor

@@ -1,13 +1,13 @@
-IN: specialized-arrays.tests
+USING: tools.test alien.syntax specialized-arrays sequences
-USING: tools.test alien.syntax specialized-arrays
+alien accessors kernel arrays combinators compiler
-specialized-arrays.private sequences alien accessors
+compiler.units classes.struct combinators.smart
-kernel arrays combinators compiler compiler.units classes.struct
+compiler.tree.debugger math libc destructors sequences.private
-combinators.smart compiler.tree.debugger math libc destructors
+multiline eval words vocabs namespaces assocs prettyprint
-sequences.private multiline eval words vocabs namespaces
+alien.data math.vectors definitions compiler.test ;
-assocs prettyprint alien.data math.vectors definitions
+FROM: specialized-arrays.private => specialized-array-vocab ;
-compiler.test ;
 FROM: alien.c-types => int float bool char float ulonglong ushort uint
 heap-size little-endian? ;
+IN: specialized-arrays.tests
 
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
@@ -101,6 +101,12 @@ SPECIALIZED-ARRAY: test-struct
     } second
 ] unit-test
 
+[ ] [
+    [
+        test-struct specialized-array-vocab forget-vocab
+    ] with-compilation-unit
+] unit-test
+
 ! Regression
 STRUCT: fixed-string { text char[64] } ;
 
@@ -115,6 +121,12 @@ SPECIALIZED-ARRAY: fixed-string
     ALIEN: 123 100 <direct-int-array> byte-length
 ] unit-test
 
+[ ] [
+    [
+        fixed-string specialized-array-vocab forget-vocab
+    ] with-compilation-unit
+] unit-test
+
 ! Test prettyprinting
 [ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
 [ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
@@ -172,3 +184,9 @@ SPECIALIZED-ARRAY: struct-resize-test
 [ 80 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
 
 [ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
+
+[ ] [
+    [
+        struct-resize-test specialized-array-vocab forget-vocab
+    ] with-compilation-unit
+] unit-test

basis/tools/test/test.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2003, 2009 Slava Pestov.
+! Copyright (C) 2003, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators compiler.units
 continuations debugger effects fry generalizations io io.files
@@ -118,12 +118,21 @@ PRIVATE>
         '[ _ run-file ] [ file-failure ] recover
     ] with-variable ;
 
+SYMBOL: forget-tests?
+
 <PRIVATE
 
+: forget-tests ( files -- )
+    forget-tests? get
+    [ [ [ forget-source ] each ] with-compilation-unit ] [ drop ] if ;
+
 : run-vocab-tests ( vocab -- )
     vocab dup [
         dup source-loaded?>> [
-            vocab-tests [ run-test-file ] each
+            vocab-tests
+            [ [ run-test-file ] each ]
+            [ forget-tests ]
+            bi
         ] [ drop ] if
     ] [ drop ] if ;
 

core/alien/alien.factor

@@ -68,6 +68,9 @@ SINGLETONS: stdcall thiscall fastcall cdecl mingw ;
 
 UNION: abi stdcall thiscall fastcall cdecl mingw ;
 
+: callee-cleanup? ( abi -- ? )
+    { stdcall fastcall thiscall } member? ;
+
 ERROR: alien-callback-error ;
 
 : alien-callback ( return parameters abi quot -- alien )

extra/bit/ly/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/bit/ly/ly.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs http.client json.reader kernel namespaces urls ;
+IN: bit.ly
+
+SYMBOLS: login api-key ;
+
+<PRIVATE
+
+: make-request ( long-url -- request )
+    "http://api.bit.ly/v3/shorten" >url
+        login get "login" set-query-param
+        api-key get "apiKey" set-query-param
+        "json" "format" set-query-param
+        swap "longUrl" set-query-param ;
+
+: parse-response ( response data -- short-url )
+    nip json> "data" swap at "url" swap at ;
+
+PRIVATE>
+
+: shorten-url ( long-url -- short-url )
+    make-request http-get parse-response ;

extra/bit/ly/summary.txt

@@ -0,0 +1 @@
+Wrapper for bit.ly URL shortening web service

extra/bit/ly/tags.txt

@@ -0,0 +1 @@
+web services

extra/cuda/ffi/ffi.factor

@@ -0,0 +1,441 @@
+! (c)2010 Joe Groff bsd license
+USING: alien alien.c-types alien.libraries alien.syntax
+classes.struct combinators system ;
+IN: cuda.ffi
+
+<<
+"cuda" {
+    { [ os windows? ] [ "nvcuda.dll" stdcall ] }
+    { [ os macosx? ] [ "/usr/local/cuda/lib/libcuda.dylib" cdecl ] }
+    { [ os unix? ] [ "libcuda.so" cdecl ] }
+} cond add-library
+>>
+
+LIBRARY: cuda
+
+TYPEDEF: uint CUdeviceptr
+TYPEDEF: int CUdevice
+TYPEDEF: void* CUcontext
+TYPEDEF: void* CUmodule
+TYPEDEF: void* CUfunction
+TYPEDEF: void* CUarray
+TYPEDEF: void* CUtexref
+TYPEDEF: void* CUevent
+TYPEDEF: void* CUstream
+TYPEDEF: void* CUgraphicsResource
+
+STRUCT: CUuuid
+    { bytes char[16] } ;
+
+C-ENUM: CUctx_flags
+    { CU_CTX_SCHED_AUTO  0 }
+    { CU_CTX_SCHED_SPIN  1 }
+    { CU_CTX_SCHED_YIELD 2 }
+    { CU_CTX_SCHED_MASK  3 }
+    { CU_CTX_BLOCKING_SYNC 4 }
+    { CU_CTX_MAP_HOST      8 }
+    { CU_CTX_LMEM_RESIZE_TO_MAX 16 }
+    { CU_CTX_FLAGS_MASK  HEX: 1f } ;
+
+C-ENUM: CUevent_flags
+    { CU_EVENT_DEFAULT       0 }
+    { CU_EVENT_BLOCKING_SYNC 1 } ;
+
+C-ENUM: CUarray_format
+    { CU_AD_FORMAT_UNSIGNED_INT8  HEX: 01 }
+    { CU_AD_FORMAT_UNSIGNED_INT16 HEX: 02 }
+    { CU_AD_FORMAT_UNSIGNED_INT32 HEX: 03 }
+    { CU_AD_FORMAT_SIGNED_INT8    HEX: 08 }
+    { CU_AD_FORMAT_SIGNED_INT16   HEX: 09 }
+    { CU_AD_FORMAT_SIGNED_INT32   HEX: 0a }
+    { CU_AD_FORMAT_HALF           HEX: 10 }
+    { CU_AD_FORMAT_FLOAT          HEX: 20 } ;
+
+C-ENUM: CUaddress_mode
+    { CU_TR_ADDRESS_MODE_WRAP   0 }
+    { CU_TR_ADDRESS_MODE_CLAMP  1 }
+    { CU_TR_ADDRESS_MODE_MIRROR 2 } ;
+
+C-ENUM: CUfilter_mode
+    { CU_TR_FILTER_MODE_POINT  0 }
+    { CU_TR_FILTER_MODE_LINEAR 1 } ;
+
+C-ENUM: CUdevice_attribute
+    { CU_DEVICE_ATTRIBUTE_MAX_THREADS_PER_BLOCK 1 }
+    { CU_DEVICE_ATTRIBUTE_MAX_BLOCK_DIM_X 2 }
+    { CU_DEVICE_ATTRIBUTE_MAX_BLOCK_DIM_Y 3 }
+    { CU_DEVICE_ATTRIBUTE_MAX_BLOCK_DIM_Z 4 }
+    { CU_DEVICE_ATTRIBUTE_MAX_GRID_DIM_X 5 }
+    { CU_DEVICE_ATTRIBUTE_MAX_GRID_DIM_Y 6 }
+    { CU_DEVICE_ATTRIBUTE_MAX_GRID_DIM_Z 7 }
+    { CU_DEVICE_ATTRIBUTE_MAX_SHARED_MEMORY_PER_BLOCK 8 }
+    { CU_DEVICE_ATTRIBUTE_SHARED_MEMORY_PER_BLOCK 8 }
+    { CU_DEVICE_ATTRIBUTE_TOTAL_CONSTANT_MEMORY 9 }
+    { CU_DEVICE_ATTRIBUTE_WARP_SIZE 10 }
+    { CU_DEVICE_ATTRIBUTE_MAX_PITCH 11 }
+    { CU_DEVICE_ATTRIBUTE_MAX_REGISTERS_PER_BLOCK 12 }
+    { CU_DEVICE_ATTRIBUTE_REGISTERS_PER_BLOCK 12 }
+    { CU_DEVICE_ATTRIBUTE_CLOCK_RATE 13 }
+    { CU_DEVICE_ATTRIBUTE_TEXTURE_ALIGNMENT 14 }
+
+    { CU_DEVICE_ATTRIBUTE_GPU_OVERLAP 15 }
+    { CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT 16 }
+    { CU_DEVICE_ATTRIBUTE_KERNEL_EXEC_TIMEOUT 17 }
+    { CU_DEVICE_ATTRIBUTE_INTEGRATED 18 }
+    { CU_DEVICE_ATTRIBUTE_CAN_MAP_HOST_MEMORY 19 }
+    { CU_DEVICE_ATTRIBUTE_COMPUTE_MODE 20 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE1D_WIDTH 21 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE2D_WIDTH 22 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE2D_HEIGHT 23 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE3D_WIDTH 24 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE3D_HEIGHT 25 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE3D_DEPTH 26 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE2D_ARRAY_WIDTH 27 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE2D_ARRAY_HEIGHT 28 }
+    { CU_DEVICE_ATTRIBUTE_MAXIMUM_TEXTURE2D_ARRAY_NUMSLICES 29 }
+    { CU_DEVICE_ATTRIBUTE_SURFACE_ALIGNMENT 30 }
+    { CU_DEVICE_ATTRIBUTE_CONCURRENT_KERNELS 31 }
+    { CU_DEVICE_ATTRIBUTE_ECC_ENABLED 32 } ;
+
+STRUCT: CUdevprop
+    { maxThreadsPerBlock int }
+    { maxThreadsDim int[3] }
+    { maxGridSize int[3] }
+    { sharedMemPerBlock int }
+    { totalConstantMemory int }
+    { SIMDWidth int }
+    { memPitch int }
+    { regsPerBlock int }
+    { clockRate int }
+    { textureAlign int } ;
+
+C-ENUM: CUfunction_attribute
+    { CU_FUNC_ATTRIBUTE_MAX_THREADS_PER_BLOCK 0 }
+    { CU_FUNC_ATTRIBUTE_SHARED_SIZE_BYTES 1     }
+    { CU_FUNC_ATTRIBUTE_CONST_SIZE_BYTES 2      }
+    { CU_FUNC_ATTRIBUTE_LOCAL_SIZE_BYTES 3      }
+    { CU_FUNC_ATTRIBUTE_NUM_REGS 4              }
+    { CU_FUNC_ATTRIBUTE_PTX_VERSION 5           }
+    { CU_FUNC_ATTRIBUTE_BINARY_VERSION 6        }
+    CU_FUNC_ATTRIBUTE_MAX ;
+
+C-ENUM: CUfunc_cache
+    { CU_FUNC_CACHE_PREFER_NONE   HEX: 00 }
+    { CU_FUNC_CACHE_PREFER_SHARED HEX: 01 }
+    { CU_FUNC_CACHE_PREFER_L1     HEX: 02 } ;
+
+C-ENUM: CUmemorytype
+    { CU_MEMORYTYPE_HOST   HEX: 01 }
+    { CU_MEMORYTYPE_DEVICE HEX: 02 }
+    { CU_MEMORYTYPE_ARRAY  HEX: 03 } ;
+
+C-ENUM: CUcomputemode
+    { CU_COMPUTEMODE_DEFAULT    0 }
+    { CU_COMPUTEMODE_EXCLUSIVE  1 }
+    { CU_COMPUTEMODE_PROHIBITED 2 } ;
+
+C-ENUM: CUjit_option
+    { CU_JIT_MAX_REGISTERS 0 }
+    CU_JIT_THREADS_PER_BLOCK
+    CU_JIT_WALL_TIME
+    CU_JIT_INFO_LOG_BUFFER
+    CU_JIT_INFO_LOG_BUFFER_SIZE_BYTES
+    CU_JIT_ERROR_LOG_BUFFER
+    CU_JIT_ERROR_LOG_BUFFER_SIZE_BYTES
+    CU_JIT_OPTIMIZATION_LEVEL
+    CU_JIT_TARGET_FROM_CUCONTEXT
+    CU_JIT_TARGET
+    CU_JIT_FALLBACK_STRATEGY ;
+
+C-ENUM: CUjit_target
+    { CU_TARGET_COMPUTE_10 0 }
+    CU_TARGET_COMPUTE_11
+    CU_TARGET_COMPUTE_12
+    CU_TARGET_COMPUTE_13
+    CU_TARGET_COMPUTE_20 ;
+
+C-ENUM: CUjit_fallback
+    { CU_PREFER_PTX 0 }
+    CU_PREFER_BINARY ;
+
+C-ENUM: CUgraphicsRegisterFlags
+    { CU_GRAPHICS_REGISTER_FLAGS_NONE 0 } ;
+
+C-ENUM: CUgraphicsMapResourceFlags
+    { CU_GRAPHICS_MAP_RESOURCE_FLAGS_NONE          HEX: 00 }
+    { CU_GRAPHICS_MAP_RESOURCE_FLAGS_READ_ONLY     HEX: 01 }
+    { CU_GRAPHICS_MAP_RESOURCE_FLAGS_WRITE_DISCARD HEX: 02 } ;
+
+C-ENUM: CUarray_cubemap_face
+    { CU_CUBEMAP_FACE_POSITIVE_X  HEX: 00 }
+    { CU_CUBEMAP_FACE_NEGATIVE_X  HEX: 01 }
+    { CU_CUBEMAP_FACE_POSITIVE_Y  HEX: 02 }
+    { CU_CUBEMAP_FACE_NEGATIVE_Y  HEX: 03 }
+    { CU_CUBEMAP_FACE_POSITIVE_Z  HEX: 04 }
+    { CU_CUBEMAP_FACE_NEGATIVE_Z  HEX: 05 } ;
+
+C-ENUM: CUresult
+    { CUDA_SUCCESS                    0 }
+    { CUDA_ERROR_INVALID_VALUE        1 }
+    { CUDA_ERROR_OUT_OF_MEMORY        2 }
+    { CUDA_ERROR_NOT_INITIALIZED      3 }
+    { CUDA_ERROR_DEINITIALIZED        4 }
+
+    { CUDA_ERROR_NO_DEVICE            100 }
+    { CUDA_ERROR_INVALID_DEVICE       101 }
+
+    { CUDA_ERROR_INVALID_IMAGE        200 }
+    { CUDA_ERROR_INVALID_CONTEXT      201 }
+    { CUDA_ERROR_CONTEXT_ALREADY_CURRENT 202 }
+    { CUDA_ERROR_MAP_FAILED           205 }
+    { CUDA_ERROR_UNMAP_FAILED         206 }
+    { CUDA_ERROR_ARRAY_IS_MAPPED      207 }
+    { CUDA_ERROR_ALREADY_MAPPED       208 }
+    { CUDA_ERROR_NO_BINARY_FOR_GPU    209 }
+    { CUDA_ERROR_ALREADY_ACQUIRED     210 }
+    { CUDA_ERROR_NOT_MAPPED           211 }
+    { CUDA_ERROR_NOT_MAPPED_AS_ARRAY  212 }
+    { CUDA_ERROR_NOT_MAPPED_AS_POINTER 213 }
+    { CUDA_ERROR_ECC_UNCORRECTABLE    214 }
+
+    { CUDA_ERROR_INVALID_SOURCE       300 }
+    { CUDA_ERROR_FILE_NOT_FOUND       301 }
+
+    { CUDA_ERROR_INVALID_HANDLE       400 }
+
+    { CUDA_ERROR_NOT_FOUND            500 }
+
+    { CUDA_ERROR_NOT_READY            600 }
+
+    { CUDA_ERROR_LAUNCH_FAILED        700 }
+    { CUDA_ERROR_LAUNCH_OUT_OF_RESOURCES 701 }
+    { CUDA_ERROR_LAUNCH_TIMEOUT       702 }
+    { CUDA_ERROR_LAUNCH_INCOMPATIBLE_TEXTURING 703 }
+
+    { CUDA_ERROR_POINTER_IS_64BIT     800 }
+    { CUDA_ERROR_SIZE_IS_64BIT        801 }
+
+    { CUDA_ERROR_UNKNOWN              999 } ;
+
+CONSTANT: CU_MEMHOSTALLOC_PORTABLE        HEX: 01
+CONSTANT: CU_MEMHOSTALLOC_DEVICEMAP       HEX: 02
+CONSTANT: CU_MEMHOSTALLOC_WRITECOMBINED   HEX: 04
+
+STRUCT: CUDA_MEMCPY2D
+    { srcXInBytes uint }
+    { srcY        uint }
+    { srcMemoryType CUmemorytype }
+    { srcHost void* }
+    { srcDevice CUdeviceptr }
+    { srcArray CUarray }
+    { srcPitch uint }
+    { dstXInBytes uint }
+    { dstY uint }
+    { dstMemoryType CUmemorytype }
+    { dstHost void* }
+    { dstDevice CUdeviceptr }
+    { dstArray CUarray }
+    { dstPitch uint }
+    { WidthInBytes uint }
+    { Height uint } ;
+
+STRUCT: CUDA_MEMCPY3D
+    { srcXInBytes uint }
+    { srcY        uint }
+    { srcZ        uint }
+    { srcLOD      uint }
+    { srcMemoryType CUmemorytype }
+    { srcHost void* }
+    { srcDevice CUdeviceptr }
+    { srcArray CUarray }
+    { reserved0 void* }
+    { srcPitch uint }
+    { srcHeight uint }
+    { dstXInBytes uint }
+    { dstY uint }
+    { dstZ uint }
+    { dstLOD uint }
+    { dstMemoryType CUmemorytype }
+    { dstHost void* }
+    { dstDevice CUdeviceptr }
+    { dstArray CUarray }
+    { reserved1 void* }
+    { dstPitch uint }
+    { dstHeight uint }
+    { WidthInBytes uint }
+    { Height uint }
+    { Depth uint } ;
+
+STRUCT: CUDA_ARRAY_DESCRIPTOR
+    { Width uint }
+    { Height uint }
+    { Format CUarray_format }
+    { NumChannels uint } ;
+
+STRUCT: CUDA_ARRAY3D_DESCRIPTOR
+    { Width uint }
+    { Height uint }
+    { Depth uint }
+    { Format CUarray_format }
+    { NumChannels uint }
+    { Flags uint } ;
+
+CONSTANT: CUDA_ARRAY3D_2DARRAY    HEX: 01
+CONSTANT: CU_TRSA_OVERRIDE_FORMAT HEX: 01
+CONSTANT: CU_TRSF_READ_AS_INTEGER         HEX: 01
+CONSTANT: CU_TRSF_NORMALIZED_COORDINATES  HEX: 02
+CONSTANT: CU_PARAM_TR_DEFAULT -1
+
+FUNCTION: CUresult cuInit ( uint Flags ) ;
+
+FUNCTION: CUresult cuDriverGetVersion ( int* driverVersion ) ;
+
+FUNCTION: CUresult cuDeviceGet ( CUdevice* device, int ordinal ) ;
+FUNCTION: CUresult cuDeviceGetCount ( int* count ) ;
+FUNCTION: CUresult cuDeviceGetName ( char* name, int len, CUdevice dev ) ;
+FUNCTION: CUresult cuDeviceComputeCapability ( int* major, int* minor, CUdevice dev ) ;
+FUNCTION: CUresult cuDeviceTotalMem ( uint* bytes, CUdevice dev ) ;
+FUNCTION: CUresult cuDeviceGetProperties ( CUdevprop* prop, CUdevice dev ) ;
+FUNCTION: CUresult cuDeviceGetAttribute ( int* pi, CUdevice_attribute attrib, CUdevice dev ) ;
+        
+FUNCTION: CUresult cuCtxCreate ( CUcontext* pctx, uint flags, CUdevice dev ) ;
+FUNCTION: CUresult cuCtxDestroy ( CUcontext ctx ) ;
+FUNCTION: CUresult cuCtxAttach ( CUcontext* pctx, uint flags ) ;
+FUNCTION: CUresult cuCtxDetach ( CUcontext ctx ) ;
+FUNCTION: CUresult cuCtxPushCurrent ( CUcontext ctx ) ;
+FUNCTION: CUresult cuCtxPopCurrent ( CUcontext* pctx ) ;
+FUNCTION: CUresult cuCtxGetDevice ( CUdevice* device ) ;
+FUNCTION: CUresult cuCtxSynchronize ( ) ;
+
+FUNCTION: CUresult cuModuleLoad ( CUmodule* module, char* fname ) ;
+FUNCTION: CUresult cuModuleLoadData ( CUmodule* module, void* image ) ;
+FUNCTION: CUresult cuModuleLoadDataEx ( CUmodule* module, void* image, uint numOptions, CUjit_option* options, void** optionValues ) ;
+FUNCTION: CUresult cuModuleLoadFatBinary ( CUmodule* module, void* fatCubin ) ;
+FUNCTION: CUresult cuModuleUnload ( CUmodule hmod ) ;
+FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, char* name ) ;
+FUNCTION: CUresult cuModuleGetGlobal ( CUdeviceptr* dptr, uint* bytes, CUmodule hmod, char* name ) ;
+FUNCTION: CUresult cuModuleGetTexRef ( CUtexref* pTexRef, CUmodule hmod, char* name ) ;
+    
+FUNCTION: CUresult cuMemGetInfo ( uint* free, uint* total ) ;
+
+FUNCTION: CUresult cuMemAlloc ( CUdeviceptr* dptr, uint bytesize ) ;
+FUNCTION: CUresult cuMemAllocPitch ( CUdeviceptr* dptr, 
+                                      uint* pPitch,
+                                      uint WidthInBytes, 
+                                      uint Height, 
+                                      uint ElementSizeBytes
+                                     ) ;
+FUNCTION: CUresult cuMemFree ( CUdeviceptr dptr ) ;
+FUNCTION: CUresult cuMemGetAddressRange ( CUdeviceptr* pbase, uint* psize, CUdeviceptr dptr ) ;
+
+FUNCTION: CUresult cuMemAllocHost ( void** pp, uint bytesize ) ;
+FUNCTION: CUresult cuMemFreeHost ( void* p ) ;
+
+FUNCTION: CUresult cuMemHostAlloc ( void** pp, size_t bytesize, uint Flags ) ;
+ 
+FUNCTION: CUresult cuMemHostGetDevicePointer ( CUdeviceptr* pdptr, void* p, uint Flags ) ;
+FUNCTION: CUresult cuMemHostGetFlags ( uint* pFlags, void* p ) ;
+
+FUNCTION: CUresult  cuMemcpyHtoD ( CUdeviceptr dstDevice, void* srcHost, uint ByteCount ) ;
+FUNCTION: CUresult  cuMemcpyDtoH ( void* dstHost, CUdeviceptr srcDevice, uint ByteCount ) ;
+
+FUNCTION: CUresult  cuMemcpyDtoD ( CUdeviceptr dstDevice, CUdeviceptr srcDevice, uint ByteCount ) ;
+
+FUNCTION: CUresult  cuMemcpyDtoA ( CUarray dstArray, uint dstIndex, CUdeviceptr srcDevice, uint ByteCount ) ;
+FUNCTION: CUresult  cuMemcpyAtoD ( CUdeviceptr dstDevice, CUarray hSrc, uint SrcIndex, uint ByteCount ) ;
+
+FUNCTION: CUresult  cuMemcpyHtoA ( CUarray dstArray, uint dstIndex, void* pSrc, uint ByteCount ) ;
+FUNCTION: CUresult  cuMemcpyAtoH ( void* dstHost, CUarray srcArray, uint srcIndex, uint ByteCount ) ;
+
+FUNCTION: CUresult  cuMemcpyAtoA ( CUarray dstArray, uint dstIndex, CUarray srcArray, uint srcIndex, uint ByteCount ) ;
+
+FUNCTION: CUresult  cuMemcpy2D ( CUDA_MEMCPY2D* pCopy ) ;
+FUNCTION: CUresult  cuMemcpy2DUnaligned ( CUDA_MEMCPY2D* pCopy ) ;
+
+FUNCTION: CUresult  cuMemcpy3D ( CUDA_MEMCPY3D* pCopy ) ;
+
+FUNCTION: CUresult  cuMemcpyHtoDAsync ( CUdeviceptr dstDevice, 
+            void* srcHost, uint ByteCount, CUstream hStream ) ;
+FUNCTION: CUresult  cuMemcpyDtoHAsync ( void* dstHost, 
+            CUdeviceptr srcDevice, uint ByteCount, CUstream hStream ) ;
+
+FUNCTION: CUresult cuMemcpyDtoDAsync ( CUdeviceptr dstDevice,
+            CUdeviceptr srcDevice, uint ByteCount, CUstream hStream ) ;
+
+FUNCTION: CUresult  cuMemcpyHtoAAsync ( CUarray dstArray, uint dstIndex, 
+            void* pSrc, uint ByteCount, CUstream hStream ) ;
+FUNCTION: CUresult  cuMemcpyAtoHAsync ( void* dstHost, CUarray srcArray, uint srcIndex, 
+            uint ByteCount, CUstream hStream ) ;
+
+FUNCTION: CUresult  cuMemcpy2DAsync ( CUDA_MEMCPY2D* pCopy, CUstream hStream ) ;
+FUNCTION: CUresult  cuMemcpy3DAsync ( CUDA_MEMCPY3D* pCopy, CUstream hStream ) ;
+
+FUNCTION: CUresult  cuMemsetD8 ( CUdeviceptr dstDevice, uchar uc, uint N ) ;
+FUNCTION: CUresult  cuMemsetD16 ( CUdeviceptr dstDevice, ushort us, uint N ) ;
+FUNCTION: CUresult  cuMemsetD32 ( CUdeviceptr dstDevice, uint ui, uint N ) ;
+
+FUNCTION: CUresult  cuMemsetD2D8 ( CUdeviceptr dstDevice, uint dstPitch, uchar uc, uint Width, uint Height ) ;
+FUNCTION: CUresult  cuMemsetD2D16 ( CUdeviceptr dstDevice, uint dstPitch, ushort us, uint Width, uint Height ) ;
+FUNCTION: CUresult  cuMemsetD2D32 ( CUdeviceptr dstDevice, uint dstPitch, uint ui, uint Width, uint Height ) ;
+
+FUNCTION: CUresult cuFuncSetBlockShape ( CUfunction hfunc, int x, int y, int z ) ;
+FUNCTION: CUresult cuFuncSetSharedSize ( CUfunction hfunc, uint bytes ) ;
+FUNCTION: CUresult cuFuncGetAttribute ( int* pi, CUfunction_attribute attrib, CUfunction hfunc ) ;
+FUNCTION: CUresult cuFuncSetCacheConfig ( CUfunction hfunc, CUfunc_cache config ) ;
+
+FUNCTION: CUresult  cuArrayCreate ( CUarray* pHandle, CUDA_ARRAY_DESCRIPTOR* pAllocateArray ) ;
+FUNCTION: CUresult  cuArrayGetDescriptor ( CUDA_ARRAY_DESCRIPTOR* pArrayDescriptor, CUarray hArray ) ;
+FUNCTION: CUresult  cuArrayDestroy ( CUarray hArray ) ;
+
+FUNCTION: CUresult  cuArray3DCreate ( CUarray* pHandle, CUDA_ARRAY3D_DESCRIPTOR* pAllocateArray ) ;
+FUNCTION: CUresult  cuArray3DGetDescriptor ( CUDA_ARRAY3D_DESCRIPTOR* pArrayDescriptor, CUarray hArray ) ;
+
+FUNCTION: CUresult  cuTexRefCreate ( CUtexref* pTexRef ) ;
+FUNCTION: CUresult  cuTexRefDestroy ( CUtexref hTexRef ) ;
+    
+FUNCTION: CUresult  cuTexRefSetArray ( CUtexref hTexRef, CUarray hArray, uint Flags ) ;
+FUNCTION: CUresult  cuTexRefSetAddress ( uint* ByteOffset, CUtexref hTexRef, CUdeviceptr dptr, uint bytes ) ;
+FUNCTION: CUresult  cuTexRefSetAddress2D ( CUtexref hTexRef, CUDA_ARRAY_DESCRIPTOR* desc, CUdeviceptr dptr, uint Pitch ) ;
+FUNCTION: CUresult  cuTexRefSetFormat ( CUtexref hTexRef, CUarray_format fmt, int NumPackedComponents ) ;
+FUNCTION: CUresult  cuTexRefSetAddressMode ( CUtexref hTexRef, int dim, CUaddress_mode am ) ;
+FUNCTION: CUresult  cuTexRefSetFilterMode ( CUtexref hTexRef, CUfilter_mode fm ) ;
+FUNCTION: CUresult  cuTexRefSetFlags ( CUtexref hTexRef, uint Flags ) ;
+
+FUNCTION: CUresult  cuTexRefGetAddress ( CUdeviceptr* pdptr, CUtexref hTexRef ) ;
+FUNCTION: CUresult  cuTexRefGetArray ( CUarray* phArray, CUtexref hTexRef ) ;
+FUNCTION: CUresult  cuTexRefGetAddressMode ( CUaddress_mode* pam, CUtexref hTexRef, int dim ) ;
+FUNCTION: CUresult  cuTexRefGetFilterMode ( CUfilter_mode* pfm, CUtexref hTexRef ) ;
+FUNCTION: CUresult  cuTexRefGetFormat ( CUarray_format* pFormat, int* pNumChannels, CUtexref hTexRef ) ;
+FUNCTION: CUresult  cuTexRefGetFlags ( uint* pFlags, CUtexref hTexRef ) ;
+
+FUNCTION: CUresult  cuParamSetSize ( CUfunction hfunc, uint numbytes ) ;
+FUNCTION: CUresult  cuParamSeti    ( CUfunction hfunc, int offset, uint value ) ;
+FUNCTION: CUresult  cuParamSetf    ( CUfunction hfunc, int offset, float value ) ;
+FUNCTION: CUresult  cuParamSetv    ( CUfunction hfunc, int offset, void* ptr, uint numbytes ) ;
+FUNCTION: CUresult  cuParamSetTexRef ( CUfunction hfunc, int texunit, CUtexref hTexRef ) ;
+
+FUNCTION: CUresult cuLaunch ( CUfunction f ) ;
+FUNCTION: CUresult cuLaunchGrid ( CUfunction f, int grid_width, int grid_height ) ;
+FUNCTION: CUresult cuLaunchGridAsync ( CUfunction f, int grid_width, int grid_height, CUstream hStream ) ;
+
+FUNCTION: CUresult cuEventCreate ( CUevent* phEvent, uint Flags ) ;
+FUNCTION: CUresult cuEventRecord ( CUevent hEvent, CUstream hStream ) ;
+FUNCTION: CUresult cuEventQuery ( CUevent hEvent ) ;
+FUNCTION: CUresult cuEventSynchronize ( CUevent hEvent ) ;
+FUNCTION: CUresult cuEventDestroy ( CUevent hEvent ) ;
+FUNCTION: CUresult cuEventElapsedTime ( float* pMilliseconds, CUevent hStart, CUevent hEnd ) ;
+
+FUNCTION: CUresult  cuStreamCreate ( CUstream* phStream, uint Flags ) ;
+FUNCTION: CUresult  cuStreamQuery ( CUstream hStream ) ;
+FUNCTION: CUresult  cuStreamSynchronize ( CUstream hStream ) ;
+FUNCTION: CUresult  cuStreamDestroy ( CUstream hStream ) ;
+
+FUNCTION: CUresult cuGraphicsUnregisterResource ( CUgraphicsResource resource ) ;
+FUNCTION: CUresult cuGraphicsSubResourceGetMappedArray ( CUarray* pArray, CUgraphicsResource resource, uint arrayIndex, uint mipLevel ) ;
+FUNCTION: CUresult cuGraphicsResourceGetMappedPointer ( CUdeviceptr* pDevPtr, uint* pSize, CUgraphicsResource resource ) ;
+FUNCTION: CUresult cuGraphicsResourceSetMapFlags ( CUgraphicsResource resource, uint flags ) ; 
+FUNCTION: CUresult cuGraphicsMapResources ( uint count, CUgraphicsResource* resources, CUstream hStream ) ;
+FUNCTION: CUresult cuGraphicsUnmapResources ( uint count, CUgraphicsResource* resources, CUstream hStream ) ;
+
+FUNCTION: CUresult cuGetExportTable ( void** ppExportTable, CUuuid* pExportTableId ) ;
+

extra/gpu/shaders/shaders.factor

@@ -301,13 +301,11 @@ M: f (verify-feedback-format)
     dup 1 = [ drop ] [ 2array ] if ;
 
 SYMBOL: padding-no
-padding-no [ 0 ] initialize
 
 : padding-name ( -- name )
     "padding-"
-    padding-no get number>string append
+    padding-no counter number>string append
-    "(" ")" surround
+    "(" ")" surround ;
-    padding-no inc ;
 
 : vertex-attribute>struct-slot ( vertex-attribute -- struct-slot-spec )
     [ name>> [ padding-name ] unless* ]

extra/mason/test/test.factor

@@ -1,12 +1,11 @@
 ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs benchmark bootstrap.stage2
-compiler.errors source-files.errors generic help.html help.lint
+compiler.errors generic help.html help.lint io io.directories
-io.directories io.encodings.utf8 io.files kernel mason.common
+io.encodings.utf8 io.files kernel locals mason.common
-math namespaces prettyprint sequences sets sorting tools.test
+namespaces sequences sets sorting source-files.errors system
-tools.time words system io tools.errors vocabs vocabs.files
+tools.errors tools.test tools.time vocabs.errors
-vocabs.hierarchy vocabs.errors vocabs.refresh locals
+vocabs.hierarchy vocabs.refresh words ;
-source-files compiler.units ;
 IN: mason.test
 
 : do-load ( -- )
@@ -28,17 +27,12 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
     errors details-file utf8 [ errors. ] with-file-writer ;
 
 : do-tests ( -- )
+    forget-tests? on
     test-all test-failures get
     test-all-vocabs-file
     test-all-errors-file
     do-step ;
 
-: cleanup-tests ( -- )
-    ! Free up some code heap space
-    [
-        vocabs [ vocab-tests [ forget-source ] each ] each
-    ] with-compilation-unit ;
-
 : do-help-lint ( -- )
     help-lint-all lint-failures get values
     help-lint-vocabs-file
@@ -76,7 +70,6 @@ M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
         [ do-load ] benchmark load-time-file to-file
         [ generate-help ] benchmark html-help-time-file to-file
         [ do-tests ] benchmark test-time-file to-file
-        cleanup-tests
         [ do-help-lint ] benchmark help-lint-time-file to-file
         [ do-benchmarks ] benchmark benchmark-time-file to-file
         do-compile-errors

extra/opencl/ffi/ffi.factor

@@ -5,10 +5,10 @@ combinators system alien.accessors byte-arrays kernel ;
 IN: opencl.ffi
 
 << "opencl" {
-        { [ os windows? ] [ "OpenCL.dll" ] }
+        { [ os windows? ] [ "OpenCL.dll" stdcall ] }
-        { [ os macosx? ] [ "/System/Library/Frameworks/OpenCL.framework/OpenCL" ] }
+        { [ os macosx? ] [ "/System/Library/Frameworks/OpenCL.framework/OpenCL" cdecl ] }
-        { [ os unix? ] [ "libOpenCL.so" ] }
+        { [ os unix? ] [ "libOpenCL.so" cdecl ] }
-    } cond stdcall add-library >>
+    } cond add-library >>
 LIBRARY: opencl
 
 ! cl_platform.h

extra/twitter/summary.txt

@@ -0,0 +1 @@
+Wrapper for Twitter web service

extra/twitter/tags.txt

@@ -0,0 +1 @@
+web services

vm/dispatch.cpp

@@ -148,8 +148,8 @@ void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cac
 	data_root<array> methods(methods_,parent);
 	data_root<array> cache(cache_,parent);
 
-	/* Generate machine code to determine the object's class. */
+	/* Load the object from the datastack. */
-	emit_class_lookup(index,PIC_TUPLE);
+	emit_with_literal(parent->special_objects[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
 
 	/* Do a cache lookup. */
 	emit_with_literal(parent->special_objects[MEGA_LOOKUP],cache.value());

vm/ffi_test.c

@@ -56,7 +56,7 @@ int ffi_test_9(int a, int b, int c, int d, int e, int f, int g)
 
 int ffi_test_10(int a, int b, double c, int d, float e, int f, int g, int h)
 {
-	return a - b - c - d - e - f - g - h;
+	return (int)(a - b - c - d - e - f - g - h);
 }
 
 int ffi_test_11(int a, struct foo b, int c)
@@ -66,7 +66,7 @@ int ffi_test_11(int a, struct foo b, int c)
 
 int ffi_test_12(int a, int b, struct rect c, int d, int e, int f)
 {
-	return a + b + c.x + c.y + c.w + c.h + d + e + f;
+	return (int)(a + b + c.x + c.y + c.w + c.h + d + e + f);
 }
 
 int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k)
@@ -128,7 +128,7 @@ long long ffi_test_21(long x, long y)
 
 long ffi_test_22(long x, long long y, long long z)
 {
-	return x + y / z;
+	return (long)(x + y / z);
 }
 
 float ffi_test_23(float x[3], float y[3])
@@ -262,7 +262,7 @@ unsigned long long ffi_test_38(unsigned long long x, unsigned long long y)
 int ffi_test_39(long a, long b, struct test_struct_13 s)
 {
 	assert(a == b);
-	return s.x1 + s.x2 + s.x3 + s.x4 + s.x5 + s.x6;
+	return (int)(s.x1 + s.x2 + s.x3 + s.x4 + s.x5 + s.x6);
 }
 
 struct test_struct_14 ffi_test_40(double x1, double x2)
@@ -330,13 +330,29 @@ short ffi_test_48(struct bool_field_test x)
 
 #endif
 
-FACTOR_FASTCALL(int) ffi_test_49(int x) { return x + 1; }
+FACTOR_FASTCALL(int) ffi_test_49(int x)
-FACTOR_FASTCALL(int) ffi_test_50(int x, int y) { return x + y + 1; }
+{
-FACTOR_FASTCALL(int) ffi_test_51(int x, int y, int z) { return x + y + z + 1; }
+	return x + 1;
-FACTOR_FASTCALL(int) ffi_test_52(int x, float y, int z) { return x + y + z + 1; }
+}
+
+FACTOR_FASTCALL(int) ffi_test_50(int x, int y)
+{
+	return x + y + 1;
+}
+
+FACTOR_FASTCALL(int) ffi_test_51(int x, int y, int z)
+{
+	return x + y + z + 1;
+}
+
+FACTOR_FASTCALL(int) ffi_test_52(int x, float y, int z)
+{
+	return (int)(x + y + z + 1);
+}
+
 FACTOR_FASTCALL(int) ffi_test_53(int x, float y, int z, int w)
 {
-	return x + y + z + w + 1;
+	return (int)(x + y + z + w + 1);
 }
 
 FACTOR_FASTCALL(int) ffi_test_54(struct test_struct_11 x, int y)

vm/inline_cache.cpp

@@ -89,7 +89,8 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
 	parent->update_pic_count(inline_cache_type);
 
 	/* Generate machine code to determine the object's class. */
-	emit_class_lookup(index,inline_cache_type);
+	emit_with_literal(parent->special_objects[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
+	emit(parent->special_objects[inline_cache_type]);
 
 	/* Generate machine code to check, in turn, if the class is one of the cached entries. */
 	cell i;

vm/instruction_operands.cpp

@@ -49,6 +49,8 @@ fixnum instruction_operand::load_value(cell relative_to)
 		return load_value_masked(rel_indirect_arm_mask,20,0) + relative_to + sizeof(cell);
 	case RC_ABSOLUTE_2:
 		return *(u16 *)(pointer - sizeof(u16));
+	case RC_ABSOLUTE_1:
+		return *(u8 *)(pointer - sizeof(u8));
 	default:
 		critical_error("Bad rel class",rel.rel_class());
 		return 0;
@@ -124,6 +126,9 @@ void instruction_operand::store_value(fixnum absolute_value)
 	case RC_ABSOLUTE_2:
 		*(u16 *)(pointer - sizeof(u16)) = (u16)absolute_value;
 		break;
+	case RC_ABSOLUTE_1:
+		*(u8 *)(pointer - sizeof(u8)) = (u8)absolute_value;
+		break;
 	default:
 		critical_error("Bad rel class",rel.rel_class());
 		break;

vm/instruction_operands.hpp

@@ -33,11 +33,11 @@ enum relocation_type {
 };
 
 enum relocation_class {
-	/* absolute address in a 64-bit location */
+	/* absolute address in a pointer-width location */
 	RC_ABSOLUTE_CELL,
-	/* absolute address in a 32-bit location */
+	/* absolute address in a 4 byte location */
 	RC_ABSOLUTE,
-	/* relative address in a 32-bit location */
+	/* relative address in a 4 byte location */
 	RC_RELATIVE,
 	/* absolute address in a PowerPC LIS/ORI sequence */
 	RC_ABSOLUTE_PPC_2_2,
@@ -53,8 +53,10 @@ enum relocation_class {
 	RC_INDIRECT_ARM,
 	/* pointer to address in an ARM LDR/STR instruction offset by 8 bytes */
 	RC_INDIRECT_ARM_PC,
-	/* absolute address in a 16-bit location */
+	/* absolute address in a 2 byte location */
-	RC_ABSOLUTE_2
+	RC_ABSOLUTE_2,
+	/* absolute address in a 1 byte location */
+	RC_ABSOLUTE_1,
 };
 
 static const cell rel_absolute_ppc_2_mask = 0xffff;

vm/jit.cpp

@@ -103,12 +103,6 @@ bool jit::emit_subprimitive(cell word_, bool tail_call_p, bool stack_frame_p)
 	return false;
 }
 	
-void jit::emit_class_lookup(fixnum index, cell type)
-{
-	emit_with_literal(parent->special_objects[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
-	emit(parent->special_objects[type]);
-}
-
 /* Facility to convert compiled code offsets to quotation offsets.
 Call jit_compute_offset() with the compiled code offset, then emit
 code, and at the end jit->position is the quotation position. */

vm/jit.hpp

@@ -47,8 +47,6 @@ struct jit {
 
 	bool emit_subprimitive(cell word_, bool tail_call_p, bool stack_frame_p);
 
-	void emit_class_lookup(fixnum index, cell type);
-
 	fixnum get_position()
 	{
 		if(computing_offset_p)