diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor old mode 100644 new mode 100755 index 8c74aa102a..9f44dec80a --- a/basis/alien/fortran/fortran.factor +++ b/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 ; diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor old mode 100644 new mode 100755 index 5a042fd436..86249436aa --- a/basis/alien/libraries/libraries.factor +++ b/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 diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor old mode 100644 new mode 100755 index 0891caa04a..7b677c3581 --- a/basis/alien/parser/parser.factor +++ b/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 ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor old mode 100644 new mode 100755 index 00148a82d4..bc7e590cff --- a/basis/alien/syntax/syntax.factor +++ b/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 -alien.arrays alien.strings kernel math namespaces parser -sequences words quotations math.parser splitting grouping -effects assocs combinators lexer strings.parser alien.parser -fry vocabs.parser words.constant alien.libraries ; +USING: accessors arrays alien alien.c-types alien.arrays +alien.strings kernel math namespaces parser sequences words +quotations math.parser splitting grouping effects assocs +combinators lexer strings.parser alien.parser fry vocabs.parser +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 suffix! ; SYNTAX: 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! ; - -: 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 ; + scan current-library get '[ _ _ address-of ] append! ; SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ; diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index dafd31efde..13088e1469 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/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 -tools.test parser lexer eval layouts generic.single classes ; +prettyprint prettyprint.config see sequences specialized-arrays +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] } ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index ffccf9f118..b16f471d11 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/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 ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index ac0fcff0ff..2fec5ca190 100644 --- a/basis/compiler/constants/constants.factor +++ b/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 -CONSTANT: rc-absolute 1 -CONSTANT: rc-relative 2 -CONSTANT: rc-absolute-ppc-2/2 3 -CONSTANT: rc-absolute-ppc-2 4 -CONSTANT: rc-relative-ppc-2 5 -CONSTANT: rc-relative-ppc-3 6 -CONSTANT: rc-relative-arm-3 7 -CONSTANT: rc-indirect-arm 8 -CONSTANT: rc-indirect-arm-pc 9 -CONSTANT: rc-absolute-2 10 +C-ENUM: f + rc-absolute-cell + rc-absolute + rc-relative + rc-absolute-ppc-2/2 + rc-absolute-ppc-2 + rc-relative-ppc-2 + rc-relative-ppc-3 + rc-relative-arm-3 + rc-indirect-arm + rc-indirect-arm-pc + rc-absolute-2 + rc-absolute-1 ; ! Relocation types -CONSTANT: rt-dlsym 0 -CONSTANT: rt-entry-point 1 -CONSTANT: rt-entry-point-pic 2 -CONSTANT: rt-entry-point-pic-tail 3 -CONSTANT: rt-here 4 -CONSTANT: rt-this 5 -CONSTANT: rt-literal 6 -CONSTANT: rt-untagged 7 -CONSTANT: rt-megamorphic-cache-hits 8 -CONSTANT: rt-vm 9 -CONSTANT: rt-cards-offset 10 -CONSTANT: rt-decks-offset 11 -CONSTANT: rt-exception-handler 12 +C-ENUM: f + rt-dlsym + rt-entry-point + rt-entry-point-pic + rt-entry-point-pic-tail + rt-here + rt-this + rt-literal + rt-untagged + rt-megamorphic-cache-hits + rt-vm + rt-cards-offset + 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? ; diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 8735d7cae4..7bbc0a904f 100755 --- a/basis/compiler/tests/alien.factor +++ b/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 -[ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test +! GCC bugs +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 -[ 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 -[ 19 ] [ 3 4.0 5 6 &: ffi_test_53 fastcall-ifii-indirect ] unit-test +: win32? ( -- ? ) os windows? cpu x86.32? and ; + +[ 8 ] [ + 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 ] alien-callback ; + : fastcall-struct-return-iii-callback ( -- ptr ) test-struct-11 { int int int } fastcall [ [ drop + ] [ - nip ] 3bi test-struct-11 ] 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 } ] diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index f7a1917d0e..4df7a487d4 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/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 -: load-tag ( -- ) - 4 4 tag-mask get ANDI - 4 4 tag-bits get SLWI ; +[ 4 4 tag-mask get ANDI ] pic-tag jit-define -[ load-tag ] pic-tag jit-define - -! Tuple [ 3 4 MR - load-tag - 0 4 tuple type-number tag-fixnum CMPI + 4 4 tag-mask get ANDI + 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) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 0127d55997..05c627fb99 100755 --- a/basis/cpu/x86/32/32.factor +++ b/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 diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index 4eb8335b67..a52a3390ac 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/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 ; diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index 39046bce6a..393d1c9b8b 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/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 ; diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 7accc4b1cb..969c02c910 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/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 -: load-tag ( -- ) - temp1 tag-mask get AND - temp1 tag-bits get SHL ; +[ temp1 tag-mask get AND ] pic-tag jit-define -[ 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 tuple type-number tag-fixnum CMP + temp1 tag-mask get AND + 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! - ! megamorphic_cache_hits++ - temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel - temp1 [] 1 ADD - ! goto get(cache + bootstrap-cell) - temp0 temp0 bootstrap-cell [+] MOV - temp0 word-entry-point-offset [+] JMP - ! fall-through on miss + [ JNE ] + [ + ! megamorphic_cache_hits++ + temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel + temp1 [] 1 ADD + ! goto get(cache + bootstrap-cell) + temp0 temp0 bootstrap-cell [+] MOV + temp0 word-entry-point-offset [+] JMP + ! fall-through on miss + ] jit-conditional ] mega-lookup jit-define ! ! ! Sub-primitives diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor index a49d6d54b3..862bdead72 100644 --- a/basis/furnace/actions/actions-docs.factor +++ b/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" } "." } diff --git a/basis/game/input/x11/x11.factor b/basis/game/input/x11/x11.factor index 4e6f610531..1e103ad0fa 100644 --- a/basis/game/input/x11/x11.factor +++ b/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 [ XQueryKeymap drop ] keep x-bits>hid-bits keyboard-state boa ; + +: query-pointer ( -- x y buttons ) + dpy get dup XDefaultRootWindow + 0 0 0 0 0 0 0 + [ XQueryPointer drop ] 3keep + [ *int ] tri@ ; + +SYMBOL: mouse-reset? M: x11-game-input-backend read-mouse - 0 0 0 0 2 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 ; diff --git a/basis/html/components/components-docs.factor b/basis/html/components/components-docs.factor index c35237b403..3b4f1d6ae3 100644 --- a/basis/html/components/components-docs.factor +++ b/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 } } diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index 9dddb85619..5a2a55bfd0 100644 --- a/basis/html/components/components.factor +++ b/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 + +M: simple-link link-title title>> ; +M: simple-link link-href href>> ; + TUPLE: link target ; M: link render* diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor index 41653cb85a..a3032aba96 100644 --- a/basis/html/templates/chloe/chloe-docs.factor +++ b/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 } } diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 645606edc5..2dee88df88 100644 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -1,13 +1,13 @@ -IN: specialized-arrays.tests -USING: tools.test alien.syntax specialized-arrays -specialized-arrays.private sequences alien accessors -kernel arrays combinators compiler compiler.units classes.struct -combinators.smart compiler.tree.debugger math libc destructors -sequences.private multiline eval words vocabs namespaces -assocs prettyprint alien.data math.vectors definitions -compiler.test ; +USING: tools.test alien.syntax specialized-arrays sequences +alien accessors kernel arrays combinators compiler +compiler.units classes.struct combinators.smart +compiler.tree.debugger math libc destructors sequences.private +multiline eval words vocabs namespaces assocs prettyprint +alien.data math.vectors definitions compiler.test ; +FROM: specialized-arrays.private => specialized-array-vocab ; 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 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 unparse ] unit-test @@ -172,3 +184,9 @@ SPECIALIZED-ARRAY: struct-resize-test [ 80 ] [ 10 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 diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index 8dda4fe16c..f3f53e43b7 100644 --- a/basis/tools/test/test.factor +++ b/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? + > [ - vocab-tests [ run-test-file ] each + vocab-tests + [ [ run-test-file ] each ] + [ forget-tests ] + bi ] [ drop ] if ] [ drop ] if ; diff --git a/core/alien/alien.factor b/core/alien/alien.factor old mode 100644 new mode 100755 index 27e326a557..d67e0a12b9 --- a/core/alien/alien.factor +++ b/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 ) diff --git a/extra/bit/ly/authors.txt b/extra/bit/ly/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/bit/ly/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/bit/ly/ly.factor b/extra/bit/ly/ly.factor new file mode 100644 index 0000000000..32d40786f7 --- /dev/null +++ b/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 ; + +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 ; diff --git a/extra/bit/ly/summary.txt b/extra/bit/ly/summary.txt new file mode 100644 index 0000000000..29020a649b --- /dev/null +++ b/extra/bit/ly/summary.txt @@ -0,0 +1 @@ +Wrapper for bit.ly URL shortening web service diff --git a/extra/bit/ly/tags.txt b/extra/bit/ly/tags.txt new file mode 100644 index 0000000000..0a8d552b33 --- /dev/null +++ b/extra/bit/ly/tags.txt @@ -0,0 +1 @@ +web services diff --git a/extra/cuda/ffi/ffi.factor b/extra/cuda/ffi/ffi.factor new file mode 100644 index 0000000000..ce6f8cb8b8 --- /dev/null +++ b/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 ) ; + diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index 69f6ba2253..974f2f8070 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/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 - "(" ")" surround - padding-no inc ; + padding-no counter number>string append + "(" ")" surround ; : vertex-attribute>struct-slot ( vertex-attribute -- struct-slot-spec ) [ name>> [ padding-name ] unless* ] diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index e99f76c8c4..8e248e861b 100644 --- a/extra/mason/test/test.factor +++ b/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 -io.directories io.encodings.utf8 io.files kernel mason.common -math namespaces prettyprint sequences sets sorting tools.test -tools.time words system io tools.errors vocabs vocabs.files -vocabs.hierarchy vocabs.errors vocabs.refresh locals -source-files compiler.units ; +compiler.errors generic help.html help.lint io io.directories +io.encodings.utf8 io.files kernel locals mason.common +namespaces sequences sets sorting source-files.errors system +tools.errors tools.test tools.time vocabs.errors +vocabs.hierarchy vocabs.refresh words ; 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 diff --git a/extra/opencl/ffi/ffi.factor b/extra/opencl/ffi/ffi.factor index 9ee2135cb6..d3398f5c24 100644 --- a/extra/opencl/ffi/ffi.factor +++ b/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 macosx? ] [ "/System/Library/Frameworks/OpenCL.framework/OpenCL" ] } - { [ os unix? ] [ "libOpenCL.so" ] } - } cond stdcall add-library >> + { [ os windows? ] [ "OpenCL.dll" stdcall ] } + { [ os macosx? ] [ "/System/Library/Frameworks/OpenCL.framework/OpenCL" cdecl ] } + { [ os unix? ] [ "libOpenCL.so" cdecl ] } + } cond add-library >> LIBRARY: opencl ! cl_platform.h diff --git a/extra/twitter/summary.txt b/extra/twitter/summary.txt new file mode 100644 index 0000000000..ee9d6c703e --- /dev/null +++ b/extra/twitter/summary.txt @@ -0,0 +1 @@ +Wrapper for Twitter web service diff --git a/extra/twitter/tags.txt b/extra/twitter/tags.txt new file mode 100644 index 0000000000..0a8d552b33 --- /dev/null +++ b/extra/twitter/tags.txt @@ -0,0 +1 @@ +web services diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp index b0f9159da7..480da1fd03 100755 --- a/vm/dispatch.cpp +++ b/vm/dispatch.cpp @@ -148,8 +148,8 @@ void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cac data_root methods(methods_,parent); data_root cache(cache_,parent); - /* Generate machine code to determine the object's class. */ - emit_class_lookup(index,PIC_TUPLE); + /* Load the object from the datastack. */ + 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()); diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 993ca18fa3..7d9abe2f87 100755 --- a/vm/ffi_test.c +++ b/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_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 x + y + z + 1; } +FACTOR_FASTCALL(int) ffi_test_49(int x) +{ + return x + 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) diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index c8a1b22879..b7cd7630ac 100755 --- a/vm/inline_cache.cpp +++ b/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; diff --git a/vm/instruction_operands.cpp b/vm/instruction_operands.cpp index 59dbf1ef8e..b11db279a5 100644 --- a/vm/instruction_operands.cpp +++ b/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; diff --git a/vm/instruction_operands.hpp b/vm/instruction_operands.hpp index 66ffddc24e..5dda411c8b 100644 --- a/vm/instruction_operands.hpp +++ b/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 */ - RC_ABSOLUTE_2 + /* absolute address in a 2 byte location */ + RC_ABSOLUTE_2, + /* absolute address in a 1 byte location */ + RC_ABSOLUTE_1, }; static const cell rel_absolute_ppc_2_mask = 0xffff; diff --git a/vm/jit.cpp b/vm/jit.cpp index 8d2f5abb9a..3324cfb366 100644 --- a/vm/jit.cpp +++ b/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. */ diff --git a/vm/jit.hpp b/vm/jit.hpp index a9716cab79..963115d6ab 100644 --- a/vm/jit.hpp +++ b/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)