From ac4141695381147d5aef180e9841a5dba6340120 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 15:18:54 -0500 Subject: [PATCH 01/32] create words for c-types --- basis/alien/arrays/arrays.factor | 38 ++--- basis/alien/c-types/c-types.factor | 159 +++++++++++++-------- basis/alien/parser/parser.factor | 8 +- basis/alien/prettyprint/prettyprint.factor | 16 ++- basis/alien/structs/structs.factor | 2 +- basis/alien/syntax/syntax.factor | 9 +- 6 files changed, 146 insertions(+), 86 deletions(-) diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index 64827ec139..86d6c2d49b 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -22,15 +22,15 @@ M: array c-type-align first c-type-align ; M: array c-type-stack-align? drop f ; -M: array unbox-parameter drop "void*" unbox-parameter ; +M: array unbox-parameter drop void* unbox-parameter ; -M: array unbox-return drop "void*" unbox-return ; +M: array unbox-return drop void* unbox-return ; -M: array box-parameter drop "void*" box-parameter ; +M: array box-parameter drop void* box-parameter ; -M: array box-return drop "void*" box-return ; +M: array box-return drop void* box-return ; -M: array stack-size drop "void*" stack-size ; +M: array stack-size drop void* stack-size ; M: array c-type-boxer-quot unclip @@ -50,7 +50,7 @@ M: value-type c-type-setter ( type -- quot ) '[ @ swap @ _ memcpy ] ; PREDICATE: string-type < pair - first2 [ "char*" = ] [ word? ] bi* and ; + first2 [ char* = ] [ word? ] bi* and ; M: string-type c-type ; @@ -59,37 +59,37 @@ M: string-type c-type-class drop object ; M: string-type c-type-boxed-class drop object ; M: string-type heap-size - drop "void*" heap-size ; + drop void* heap-size ; M: string-type c-type-align - drop "void*" c-type-align ; + drop void* c-type-align ; M: string-type c-type-stack-align? - drop "void*" c-type-stack-align? ; + drop void* c-type-stack-align? ; M: string-type unbox-parameter - drop "void*" unbox-parameter ; + drop void* unbox-parameter ; M: string-type unbox-return - drop "void*" unbox-return ; + drop void* unbox-return ; M: string-type box-parameter - drop "void*" box-parameter ; + drop void* box-parameter ; M: string-type box-return - drop "void*" box-return ; + drop void* box-return ; M: string-type stack-size - drop "void*" stack-size ; + drop void* stack-size ; M: string-type c-type-rep drop int-rep ; M: string-type c-type-boxer - drop "void*" c-type-boxer ; + drop void* c-type-boxer ; M: string-type c-type-unboxer - drop "void*" c-type-unboxer ; + drop void* c-type-unboxer ; M: string-type c-type-boxer-quot second '[ _ alien>string ] ; @@ -103,6 +103,8 @@ M: string-type c-type-getter M: string-type c-type-setter drop [ set-alien-cell ] ; -{ "char*" utf8 } "char*" typedef -"char*" "uchar*" typedef +{ char* utf8 } char* typedef +char* uchar* typedef +char char* "pointer-c-type" set-word-prop +uchar uchar* "pointer-c-type" set-word-prop diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index b177ab35d4..2d53e01f0f 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -5,7 +5,7 @@ namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary io.streams.memory accessors combinators effects continuations fry -classes vocabs vocabs.loader ; +classes vocabs vocabs.loader vocabs.parser ; IN: alien.c-types DEFER: @@ -40,6 +40,11 @@ global [ ERROR: no-c-type name ; +PREDICATE: c-type-word < word + "c-type" word-prop ; + +UNION: c-type-name string c-type-word ; + : (c-type) ( name -- type/f ) c-types get-global at dup [ dup string? [ (c-type) ] when @@ -48,35 +53,48 @@ ERROR: no-c-type name ; ! C type protocol GENERIC: c-type ( name -- type ) foldable -: resolve-pointer-type ( name -- name ) +: parse-c-type-name ( name -- word/string ) + [ search ] keep or ; + +GENERIC: resolve-pointer-type ( name -- c-type ) + +M: word resolve-pointer-type + dup "pointer-c-type" word-prop + [ ] [ drop void* ] ?if c-type ; +M: string resolve-pointer-type c-types get at dup string? - [ "*" append ] [ drop "void*" ] if + [ "*" append ] [ drop void* ] if c-type ; : resolve-typedef ( name -- type ) - dup string? [ c-type ] when ; + dup c-type-name? [ c-type ] when ; : parse-array-type ( name -- array ) "[" split unclip - [ [ "]" ?tail drop string>number ] map ] dip prefix ; + [ [ "]" ?tail drop string>number ] map ] dip + parse-c-type-name prefix ; + +: parse-c-type ( string -- array ) + { + { [ CHAR: ] over member? ] [ parse-array-type ] } + { [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] } + { [ dup c-types get at ] [ dup c-types get at resolve-typedef ] } + { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] } + [ no-c-type ] + } cond ; M: string c-type ( name -- type ) - CHAR: ] over member? [ - parse-array-type - ] [ - dup c-types get at [ - resolve-typedef - ] [ - "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if - ] ?if - ] if ; + parse-c-type ; + +M: word c-type + "c-type" word-prop resolve-typedef ; ! These words being foldable means that words need to be ! recompiled if a C type is redefined. Even so, folding the ! size facilitates some optimizations. GENERIC: heap-size ( type -- size ) foldable -M: string heap-size c-type heap-size ; +M: c-type-name heap-size c-type heap-size ; M: abstract-c-type heap-size size>> ; @@ -92,7 +110,7 @@ GENERIC: c-direct-array-constructor ( c-type -- word ) GENERIC: ( len c-type -- array ) -M: string +M: c-type-name c-array-constructor execute( len -- array ) ; inline GENERIC: (c-array) ( len c-type -- array ) @@ -102,7 +120,7 @@ M: string (c-array) GENERIC: ( alien len c-type -- array ) -M: string +M: c-type-name c-direct-array-constructor execute( alien len -- array ) ; inline : malloc-array ( n type -- alien ) @@ -115,67 +133,67 @@ GENERIC: c-type-class ( name -- class ) M: abstract-c-type c-type-class class>> ; -M: string c-type-class c-type c-type-class ; +M: c-type-name c-type-class c-type c-type-class ; GENERIC: c-type-boxed-class ( name -- class ) M: abstract-c-type c-type-boxed-class boxed-class>> ; -M: string c-type-boxed-class c-type c-type-boxed-class ; +M: c-type-name c-type-boxed-class c-type c-type-boxed-class ; GENERIC: c-type-boxer ( name -- boxer ) M: c-type c-type-boxer boxer>> ; -M: string c-type-boxer c-type c-type-boxer ; +M: c-type-name c-type-boxer c-type c-type-boxer ; GENERIC: c-type-boxer-quot ( name -- quot ) M: abstract-c-type c-type-boxer-quot boxer-quot>> ; -M: string c-type-boxer-quot c-type c-type-boxer-quot ; +M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ; GENERIC: c-type-unboxer ( name -- boxer ) M: c-type c-type-unboxer unboxer>> ; -M: string c-type-unboxer c-type c-type-unboxer ; +M: c-type-name c-type-unboxer c-type c-type-unboxer ; GENERIC: c-type-unboxer-quot ( name -- quot ) M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ; -M: string c-type-unboxer-quot c-type c-type-unboxer-quot ; +M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ; GENERIC: c-type-rep ( name -- rep ) M: c-type c-type-rep rep>> ; -M: string c-type-rep c-type c-type-rep ; +M: c-type-name c-type-rep c-type c-type-rep ; GENERIC: c-type-getter ( name -- quot ) M: c-type c-type-getter getter>> ; -M: string c-type-getter c-type c-type-getter ; +M: c-type-name c-type-getter c-type c-type-getter ; GENERIC: c-type-setter ( name -- quot ) M: c-type c-type-setter setter>> ; -M: string c-type-setter c-type c-type-setter ; +M: c-type-name c-type-setter c-type c-type-setter ; GENERIC: c-type-align ( name -- n ) M: abstract-c-type c-type-align align>> ; -M: string c-type-align c-type c-type-align ; +M: c-type-name c-type-align c-type c-type-align ; GENERIC: c-type-stack-align? ( name -- ? ) M: c-type c-type-stack-align? stack-align?>> ; -M: string c-type-stack-align? c-type c-type-stack-align? ; +M: c-type-name c-type-stack-align? c-type c-type-stack-align? ; : c-type-box ( n type -- ) [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi @@ -189,29 +207,29 @@ GENERIC: box-parameter ( n ctype -- ) M: c-type box-parameter c-type-box ; -M: string box-parameter c-type box-parameter ; +M: c-type-name box-parameter c-type box-parameter ; GENERIC: box-return ( ctype -- ) M: c-type box-return f swap c-type-box ; -M: string box-return c-type box-return ; +M: c-type-name box-return c-type box-return ; GENERIC: unbox-parameter ( n ctype -- ) M: c-type unbox-parameter c-type-unbox ; -M: string unbox-parameter c-type unbox-parameter ; +M: c-type-name unbox-parameter c-type unbox-parameter ; GENERIC: unbox-return ( ctype -- ) M: c-type unbox-return f swap c-type-unbox ; -M: string unbox-return c-type unbox-return ; +M: c-type-name unbox-return c-type unbox-return ; GENERIC: stack-size ( type -- size ) foldable -M: string stack-size c-type stack-size ; +M: c-type-name stack-size c-type stack-size ; M: c-type stack-size size>> cell align ; @@ -269,7 +287,15 @@ M: memory-stream stream-read \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi* ] [ ] make ; -: typedef ( old new -- ) c-types get set-at ; +GENERIC: typedef ( old new -- ) + +PREDICATE: typedef-word < c-type-word + "c-type" word-prop c-type-name? ; + +M: string typedef ( old new -- ) c-types get set-at ; +M: word typedef ( old new -- ) + [ name>> typedef ] + [ swap "c-type" set-word-prop ] 2bi ; TUPLE: long-long-type < c-type ; @@ -303,8 +329,8 @@ M: long-long-type box-return ( type -- ) : define-primitive-type ( type name -- ) [ typedef ] - [ define-deref ] - [ define-out ] + [ name>> define-deref ] + [ name>> define-out ] tri ; : malloc-file-contents ( path -- alien len ) @@ -313,17 +339,30 @@ M: long-long-type box-return ( type -- ) : if-void ( type true false -- ) pick "void" = [ drop nip call ] [ nip call ] if ; inline +SYMBOLS: + char uchar + short ushort + int uint + long ulong + longlong ulonglong + float double + void* bool ; + CONSTANT: primitive-types { - "char" "uchar" - "short" "ushort" - "int" "uint" - "long" "ulong" - "longlong" "ulonglong" - "float" "double" - "void*" "bool" + char uchar + short ushort + int uint + long ulong + longlong ulonglong + float double + void* bool } +SYMBOLS: + ptrdiff_t intptr_t size_t + char* uchar* ; + [ c-ptr >>class @@ -335,7 +374,7 @@ CONSTANT: primitive-types [ >c-ptr ] >>unboxer-quot "box_alien" >>boxer "alien_offset" >>unboxer - "void*" define-primitive-type + \ void* define-primitive-type integer >>class @@ -346,7 +385,7 @@ CONSTANT: primitive-types 8 >>align "box_signed_8" >>boxer "to_signed_8" >>unboxer - "longlong" define-primitive-type + \ longlong define-primitive-type integer >>class @@ -357,7 +396,7 @@ CONSTANT: primitive-types 8 >>align "box_unsigned_8" >>boxer "to_unsigned_8" >>unboxer - "ulonglong" define-primitive-type + \ ulonglong define-primitive-type integer >>class @@ -368,7 +407,7 @@ CONSTANT: primitive-types bootstrap-cell >>align "box_signed_cell" >>boxer "to_fixnum" >>unboxer - "long" define-primitive-type + \ long define-primitive-type integer >>class @@ -379,7 +418,7 @@ CONSTANT: primitive-types bootstrap-cell >>align "box_unsigned_cell" >>boxer "to_cell" >>unboxer - "ulong" define-primitive-type + \ ulong define-primitive-type integer >>class @@ -390,7 +429,7 @@ CONSTANT: primitive-types 4 >>align "box_signed_4" >>boxer "to_fixnum" >>unboxer - "int" define-primitive-type + \ int define-primitive-type integer >>class @@ -401,7 +440,7 @@ CONSTANT: primitive-types 4 >>align "box_unsigned_4" >>boxer "to_cell" >>unboxer - "uint" define-primitive-type + \ uint define-primitive-type fixnum >>class @@ -412,7 +451,7 @@ CONSTANT: primitive-types 2 >>align "box_signed_2" >>boxer "to_fixnum" >>unboxer - "short" define-primitive-type + \ short define-primitive-type fixnum >>class @@ -423,7 +462,7 @@ CONSTANT: primitive-types 2 >>align "box_unsigned_2" >>boxer "to_cell" >>unboxer - "ushort" define-primitive-type + \ ushort define-primitive-type fixnum >>class @@ -434,7 +473,7 @@ CONSTANT: primitive-types 1 >>align "box_signed_1" >>boxer "to_fixnum" >>unboxer - "char" define-primitive-type + \ char define-primitive-type fixnum >>class @@ -445,7 +484,7 @@ CONSTANT: primitive-types 1 >>align "box_unsigned_1" >>boxer "to_cell" >>unboxer - "uchar" define-primitive-type + \ uchar define-primitive-type [ alien-unsigned-1 c-bool> ] >>getter @@ -454,7 +493,7 @@ CONSTANT: primitive-types 1 >>align "box_boolean" >>boxer "to_boolean" >>unboxer - "bool" define-primitive-type + \ bool define-primitive-type float >>class @@ -467,7 +506,7 @@ CONSTANT: primitive-types "to_float" >>unboxer float-rep >>rep [ >float ] >>unboxer-quot - "float" define-primitive-type + \ float define-primitive-type float >>class @@ -480,10 +519,10 @@ CONSTANT: primitive-types "to_double" >>unboxer double-rep >>rep [ >float ] >>unboxer-quot - "double" define-primitive-type + \ double define-primitive-type - "long" "ptrdiff_t" typedef - "long" "intptr_t" typedef - "ulong" "size_t" typedef + \ long \ ptrdiff_t typedef + \ long \ intptr_t typedef + \ ulong \ size_t typedef ] with-compilation-unit diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 19ab08c03c..f855378890 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -5,12 +5,18 @@ parser sequences splitting words fry locals lexer namespaces summary math ; IN: alien.parser +: scan-c-type ( -- c-type ) + scan dup "{" = + [ drop \ } parse-until >array ] + [ parse-c-type ] if ; + : normalize-c-arg ( type name -- type' name' ) [ length ] [ [ CHAR: * = ] trim-head [ length - CHAR: * append ] keep - ] bi ; + ] bi + [ parse-c-type ] dip ; : parse-arglist ( parameters return -- types effect ) [ diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 0ffd5023a7..6201f1e245 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators alien alien.strings alien.syntax -math.parser prettyprint.backend prettyprint.custom -prettyprint.sections ; +USING: kernel combinators alien alien.strings alien.c-types +alien.syntax math.parser prettyprint.backend prettyprint.custom +prettyprint.sections definitions see see.private ; IN: alien.prettyprint M: alien pprint* @@ -13,3 +13,13 @@ M: alien pprint* } cond ; M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ; + +M: c-type-word definer drop \ C-TYPE: f ; +M: c-type-word definition drop f ; + +M: typedef-word see-class* + ; diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index a80adf5137..1558748164 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -13,7 +13,7 @@ M: struct-type c-type ; M: struct-type c-type-stack-align? drop f ; : if-value-struct ( ctype true false -- ) - [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline + [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline M: struct-type unbox-parameter [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index e8206c6968..040c6b0787 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -19,18 +19,21 @@ SYNTAX: FUNCTION: (FUNCTION:) define-declared ; SYNTAX: TYPEDEF: - scan scan typedef ; + scan-c-type CREATE typedef ; SYNTAX: C-STRUCT: - scan current-vocab parse-definition define-struct ; deprecated + CREATE current-vocab parse-definition define-struct ; deprecated SYNTAX: C-UNION: - scan parse-definition define-union ; deprecated + CREATE parse-definition define-union ; deprecated SYNTAX: C-ENUM: ";" parse-tokens [ [ create-in ] dip define-constant ] each-index ; +SYNTAX: C-TYPE: + "Primitive C type definition not supported" throw ; + ERROR: no-such-symbol name library ; : address-of ( name library -- value ) From 35b76b83afd7f353d22a9ac7dcbe86caca9e276f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 16:08:42 -0500 Subject: [PATCH 02/32] convert compiler cpu backends to use c-type words --- basis/alien/c-types/c-types.factor | 34 ++++++++++++---------- basis/alien/prettyprint/prettyprint.factor | 12 ++++++-- basis/cpu/ppc/ppc.factor | 2 +- basis/cpu/x86/64/unix/unix.factor | 9 +++--- basis/cpu/x86/64/winnt/winnt.factor | 8 ++--- basis/cpu/x86/x86.factor | 1 + 6 files changed, 38 insertions(+), 28 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 2d53e01f0f..553ff26443 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -5,9 +5,19 @@ namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary io.streams.memory accessors combinators effects continuations fry -classes vocabs vocabs.loader vocabs.parser ; +classes vocabs vocabs.loader vocabs.parser words.symbol ; +QUALIFIED: math IN: alien.c-types +SYMBOLS: + char uchar + short ushort + int uint + long ulong + longlong ulonglong + float double + void* bool ; + DEFER: DEFER: *char @@ -78,7 +88,7 @@ M: string resolve-pointer-type { { [ CHAR: ] over member? ] [ parse-array-type ] } { [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] } - { [ dup c-types get at ] [ dup c-types get at resolve-typedef ] } + { [ dup c-types get at ] [ c-types get at resolve-typedef ] } { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] } [ no-c-type ] } cond ; @@ -294,8 +304,9 @@ PREDICATE: typedef-word < c-type-word M: string typedef ( old new -- ) c-types get set-at ; M: word typedef ( old new -- ) + [ nip define-symbol ] [ name>> typedef ] - [ swap "c-type" set-word-prop ] 2bi ; + [ swap "c-type" set-word-prop ] 2tri ; TUPLE: long-long-type < c-type ; @@ -339,15 +350,6 @@ M: long-long-type box-return ( type -- ) : if-void ( type true false -- ) pick "void" = [ drop nip call ] [ nip call ] if ; inline -SYMBOLS: - char uchar - short ushort - int uint - long ulong - longlong ulonglong - float double - void* bool ; - CONSTANT: primitive-types { char uchar @@ -496,8 +498,8 @@ SYMBOLS: \ bool define-primitive-type - float >>class - float >>boxed-class + math:float >>class + math:float >>boxed-class [ alien-float ] >>getter [ [ >float ] 2dip set-alien-float ] >>setter 4 >>size @@ -509,8 +511,8 @@ SYMBOLS: \ float define-primitive-type - float >>class - float >>boxed-class + math:float >>class + math:float >>boxed-class [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 6201f1e245..54bb3812a4 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel combinators alien alien.strings alien.c-types -alien.syntax math.parser prettyprint.backend prettyprint.custom -prettyprint.sections definitions see see.private ; +alien.syntax arrays math.parser prettyprint.backend +prettyprint.custom prettyprint.sections definitions see see.private +strings words ; IN: alien.prettyprint M: alien pprint* @@ -17,9 +18,14 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ; M: c-type-word definer drop \ C-TYPE: f ; M: c-type-word definition drop f ; +GENERIC: pprint-c-type ( c-type -- ) +M: word pprint-c-type pprint-word ; +M: string pprint-c-type text ; +M: array pprint-c-type pprint* ; + M: typedef-word see-class* ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 9c829bc390..f881ff5f91 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -770,5 +770,5 @@ USE: vocabs.loader 4 >>align "box_boolean" >>boxer "to_boolean" >>unboxer - "bool" define-primitive-type + bool define-primitive-type ] with-compilation-unit diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index e06c026d39..1088f20175 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -14,9 +14,10 @@ M: float-regs param-regs M: x86.64 reserved-area-size 0 ; -! The ABI for passing structs by value is pretty messed up -<< "void*" c-type clone "__stack_value" define-primitive-type -stack-params "__stack_value" c-type (>>rep) >> +SYMBOL: (stack-value) +! The ABI for passing structs by value is pretty great +<< void* c-type clone \ (stack-value) define-primitive-type +stack-params \ (stack-value) c-type (>>rep) >> : struct-types&offset ( struct-type -- pairs ) fields>> [ @@ -36,7 +37,7 @@ stack-params "__stack_value" c-type (>>rep) >> : flatten-large-struct ( c-type -- seq ) heap-size cell align - cell /i "__stack_value" c-type ; + cell /i \ (stack-value) c-type ; M: struct-type flatten-value-type ( type -- seq ) dup heap-size 16 > [ diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index d9f83612e6..bbe943e06b 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -25,8 +25,8 @@ M: x86.64 dummy-fp-params? t ; M: x86.64 temp-reg RAX ; << -"longlong" "ptrdiff_t" typedef -"longlong" "intptr_t" typedef -"int" c-type "long" define-primitive-type -"uint" c-type "ulong" define-primitive-type +longlong ptrdiff_t typedef +longlong intptr_t typedef +int c-type long define-primitive-type +uint c-type ulong define-primitive-type >> diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 27b6667c05..04b5308836 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -12,6 +12,7 @@ compiler.cfg.comparisons compiler.cfg.stack-frame compiler.codegen compiler.codegen.fixup ; +FROM: math => float ; IN: cpu.x86 << enable-fixnum-log2 >> From 3b4330fcf64b2b76fa08c646f3b5d6db6fd51166 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 21:43:18 -0500 Subject: [PATCH 03/32] get things to a point where they bootstrap again --- basis/alien/c-types/c-types.factor | 49 ++++++++----------- basis/alien/parser/parser.factor | 19 +++++-- basis/alien/syntax/syntax.factor | 4 +- basis/classes/struct/struct-tests.factor | 20 ++++---- basis/classes/struct/struct.factor | 27 ++-------- basis/compiler/codegen/codegen.factor | 2 +- basis/core-foundation/numbers/numbers.factor | 1 + basis/cpu/x86/features/features.factor | 4 +- basis/functors/functors-tests.factor | 15 +++--- basis/math/libm/libm.factor | 40 +++++++-------- .../specialized-arrays.factor | 28 +++++++---- basis/stack-checker/alien/alien.factor | 2 +- basis/windows/com/syntax/syntax.factor | 2 +- 13 files changed, 107 insertions(+), 106 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 71073ddc91..123abb5298 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -5,7 +5,7 @@ namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary io.streams.memory accessors combinators effects continuations fry -classes vocabs vocabs.loader vocabs.parser words.symbol ; +classes vocabs vocabs.loader words.symbol ; QUALIFIED: math IN: alien.c-types @@ -16,7 +16,8 @@ SYMBOLS: long ulong longlong ulonglong float double - void* bool ; + void* bool + void ; DEFER: DEFER: *char @@ -55,56 +56,48 @@ PREDICATE: c-type-word < word UNION: c-type-name string c-type-word ; -: (c-type) ( name -- type/f ) - c-types get-global at dup [ - dup string? [ (c-type) ] when - ] when ; - ! C type protocol GENERIC: c-type ( name -- type ) foldable -: parse-c-type-name ( name -- word/string ) - [ search ] keep or ; - GENERIC: resolve-pointer-type ( name -- c-type ) M: word resolve-pointer-type dup "pointer-c-type" word-prop - [ ] [ drop void* ] ?if c-type ; + [ ] [ drop void* ] ?if ; M: string resolve-pointer-type c-types get at dup string? - [ "*" append ] [ drop void* ] if - c-type ; + [ "*" append ] [ drop void* ] if ; : resolve-typedef ( name -- type ) dup c-type-name? [ c-type ] when ; -: parse-array-type ( name -- array ) +: parse-array-type ( name -- dims type ) "[" split unclip - [ [ "]" ?tail drop string>number ] map ] dip - parse-c-type-name prefix ; - -: parse-c-type ( string -- array ) - { - { [ CHAR: ] over member? ] [ parse-array-type ] } - { [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] } - { [ dup c-types get at ] [ c-types get at resolve-typedef ] } - { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] } - [ no-c-type ] - } cond ; + [ [ "]" ?tail drop string>number ] map ] dip ; M: string c-type ( name -- type ) - parse-c-type ; + CHAR: ] over member? [ + parse-array-type prefix + ] [ + dup c-types get at [ + resolve-typedef + ] [ + "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if + ] ?if + ] if ; M: word c-type "c-type" word-prop resolve-typedef ; +: void? ( c-type -- ? ) + { void "void" } member? ; + GENERIC: c-struct? ( type -- ? ) M: object c-struct? drop f ; M: string c-struct? - dup "void" = [ drop f ] [ c-type c-struct? ] if ; + dup void? [ drop f ] [ c-type c-struct? ] if ; ! These words being foldable means that words need to be ! recompiled if a C type is redefined. Even so, folding the @@ -366,7 +359,7 @@ M: long-long-type box-return ( type -- ) binary file-contents [ malloc-byte-array ] [ length ] bi ; : if-void ( type true false -- ) - pick "void" = [ drop nip call ] [ nip call ] if ; inline + pick void? [ drop nip call ] [ nip call ] if ; inline CONSTANT: primitive-types { diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index f855378890..bca7c93802 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -1,10 +1,23 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays assocs effects grouping kernel -parser sequences splitting words fry locals lexer namespaces -summary math ; +USING: alien alien.c-types arrays assocs combinators effects +grouping kernel parser sequences splitting words fry locals +lexer namespaces summary math vocabs.parser ; IN: alien.parser +: parse-c-type-name ( name -- word/string ) + [ search ] keep or ; + +: parse-c-type ( string -- array ) + { + { [ dup "void" = ] [ drop void ] } + { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] } + { [ dup search c-type-word? ] [ parse-c-type-name ] } + { [ dup c-types get at ] [ ] } + { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] } + [ no-c-type ] + } cond ; + : scan-c-type ( -- c-type ) scan dup "{" = [ drop \ } parse-until >array ] diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 040c6b0787..fac45176a3 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -22,10 +22,10 @@ SYNTAX: TYPEDEF: scan-c-type CREATE typedef ; SYNTAX: C-STRUCT: - CREATE current-vocab parse-definition define-struct ; deprecated + scan current-vocab parse-definition define-struct ; deprecated SYNTAX: C-UNION: - CREATE parse-definition define-union ; deprecated + scan parse-definition define-union ; deprecated SYNTAX: C-ENUM: ";" parse-tokens diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index bbbaf4f1d5..3be0be8ef1 100755 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -6,6 +6,8 @@ io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math mirrors multiline namespaces prettyprint prettyprint.config see sequences specialized-arrays system tools.test parser lexer eval layouts ; +FROM: math => float +QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: ushort @@ -128,7 +130,7 @@ STRUCT: struct-test-bar ] unit-test UNION-STRUCT: struct-test-float-and-bits - { f float } + { f c:float } { bits uint } ; [ 1.0 ] [ struct-test-float-and-bits 1.0 float>bits >>bits f>> ] unit-test @@ -181,14 +183,14 @@ STRUCT: struct-test-string-ptr ] with-scope ] unit-test -[ <" USING: classes.struct ; +[ <" USING: alien.c-types classes.struct ; IN: classes.struct.tests STRUCT: struct-test-foo { x char initial: 0 } { y int initial: 123 } { z bool } ; "> ] [ [ struct-test-foo see ] with-string-writer ] unit-test -[ <" USING: classes.struct ; +[ <" USING: alien.c-types classes.struct ; IN: classes.struct.tests UNION-STRUCT: struct-test-float-and-bits { f float initial: 0.0 } { bits uint initial: 0 } ; @@ -201,20 +203,20 @@ UNION-STRUCT: struct-test-float-and-bits { offset 0 } { initial 0 } { class fixnum } - { type "char" } + { type char } } T{ struct-slot-spec { name "y" } { offset 4 } { initial 123 } { class integer } - { type "int" } + { type int } } T{ struct-slot-spec { name "z" } { offset 8 } { initial f } - { type "bool" } + { type bool } { class object } } } ] [ "struct-test-foo" c-type fields>> ] unit-test @@ -223,14 +225,14 @@ UNION-STRUCT: struct-test-float-and-bits T{ struct-slot-spec { name "f" } { offset 0 } - { type "float" } + { type c:float } { class float } { initial 0.0 } } T{ struct-slot-spec { name "bits" } { offset 0 } - { type "uint" } + { type uint } { class integer } { initial 0 } } @@ -277,7 +279,7 @@ STRUCT: struct-test-array-slots ] unit-test STRUCT: struct-test-optimization - { x { "int" 3 } } { y int } ; + { x { int 3 } } { y int } ; SPECIALIZED-ARRAY: struct-test-optimization diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 1de221d2aa..a96a74d2ac 100755 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -1,12 +1,12 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types arrays byte-arrays classes -classes.parser classes.tuple classes.tuple.parser +USING: accessors alien alien.c-types alien.parser arrays +byte-arrays classes classes.parser classes.tuple classes.tuple.parser classes.tuple.private combinators combinators.short-circuit combinators.smart cpu.architecture definitions functors.backend fry generalizations generic.parser kernel kernel.private lexer libc locals macros make math math.order parser quotations sequences slots slots.private specialized-arrays vectors words -summary namespaces assocs ; +summary namespaces assocs vocabs.parser ; IN: classes.struct SPECIALIZED-ARRAY: uchar @@ -197,20 +197,6 @@ M: struct-c-type c-struct? drop t ; [ type>> c-type-align ] [ max ] map-reduce ; PRIVATE> -M: struct-class c-type name>> c-type ; - -M: struct-class c-type-align c-type c-type-align ; - -M: struct-class c-type-getter c-type c-type-getter ; - -M: struct-class c-type-setter c-type c-type-setter ; - -M: struct-class c-type-boxer-quot c-type c-type-boxer-quot ; - -M: struct-class c-type-unboxer-quot c-type c-type-boxer-quot ; - -M: struct-class heap-size c-type heap-size ; - M: struct byte-length class "struct-size" word-prop ; foldable ! class definition @@ -259,7 +245,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri (struct-word-props) ] - [ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline + [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline PRIVATE> : define-struct-class ( class slots -- ) @@ -284,9 +270,6 @@ ERROR: invalid-struct-slot token ; [ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ; array ] when ; - : parse-struct-slot ( -- slot ) scan scan-c-type \ } parse-until ; @@ -317,7 +300,7 @@ SYNTAX: S@ array ] [ >string-param ] if ; + scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ; : parse-struct-slot` ( accum -- accum ) scan-string-param scan-c-type` \ } parse-until diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 0456ff485f..ddf5aa0e02 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -456,7 +456,7 @@ TUPLE: callback-context ; : callback-return-quot ( ctype -- quot ) return>> { - { [ dup "void" = ] [ drop [ ] ] } + { [ dup void? ] [ drop [ ] ] } { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] } [ c-type c-type-unboxer-quot ] } cond ; diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor index f01f522d61..ae061cb4eb 100644 --- a/basis/core-foundation/numbers/numbers.factor +++ b/basis/core-foundation/numbers/numbers.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax kernel math core-foundation ; +FROM: math => float ; IN: core-foundation.numbers TYPEDEF: void* CFNumberRef diff --git a/basis/cpu/x86/features/features.factor b/basis/cpu/x86/features/features.factor index 02235bb62e..c5cf2d470a 100644 --- a/basis/cpu/x86/features/features.factor +++ b/basis/cpu/x86/features/features.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: system kernel math math.order math.parser namespaces -alien.syntax combinators locals init io cpu.x86 compiler -compiler.units accessors ; +alien.c-types alien.syntax combinators locals init io cpu.x86 +compiler compiler.units accessors ; IN: cpu.x86.features > ] when ; + : specialized-array-vocab ( c-type -- vocab ) "specialized-arrays.instances." prepend ; @@ -125,26 +133,26 @@ PRIVATE> ] ?if ; inline : define-array-vocab ( type -- vocab ) - underlying-type + underlying-type-name [ specialized-array-vocab ] [ '[ _ define-array ] ] bi generate-vocab ; -M: string require-c-array define-array-vocab drop ; +M: c-type-name require-c-array define-array-vocab drop ; ERROR: specialized-array-vocab-not-loaded c-type ; -M: string c-array-constructor - underlying-type +M: c-type-name c-array-constructor + underlying-type-name dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable -M: string c-(array)-constructor - underlying-type +M: c-type-name c-(array)-constructor + underlying-type-name dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable -M: string c-direct-array-constructor - underlying-type +M: c-type-name c-direct-array-constructor + underlying-type-name dup [ "" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index da559abd78..3d150adf91 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -19,7 +19,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; : alien-stack ( params extra -- ) over parameters>> length + consume-d >>in-d - dup return>> "void" = 0 1 ? produce-d >>out-d + dup return>> void? 0 1 ? produce-d >>out-d drop ; : return-prep-quot ( node -- quot ) diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 2100d6a215..3cf8b55e39 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -67,7 +67,7 @@ unless : (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect ) swap [ [ second ] map ] - [ dup "void" = [ drop { } ] [ 1array ] if ] bi* + [ dup void? [ drop { } ] [ 1array ] if ] bi* ; : (define-word-for-function) ( function interface n -- ) From 26026ff6de7d5d1a0dd985a198c75dcc449d50f2 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 22:10:16 -0500 Subject: [PATCH 04/32] fix bug in pointer type parsing --- basis/alien/c-types/c-types.factor | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 123abb5298..02ab2dcafa 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -79,11 +79,9 @@ M: string c-type ( name -- type ) CHAR: ] over member? [ parse-array-type prefix ] [ - dup c-types get at [ - resolve-typedef - ] [ + dup c-types get at [ ] [ "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if - ] ?if + ] ?if resolve-typedef ] if ; M: word c-type From b629391477ccaa8fb97a63bfea70ff35d8e67045 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 22:10:41 -0500 Subject: [PATCH 05/32] fix typedef prettyprinting --- basis/alien/prettyprint/prettyprint.factor | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 54bb3812a4..4b53f36c3b 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -17,15 +17,20 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ; M: c-type-word definer drop \ C-TYPE: f ; M: c-type-word definition drop f ; +M: typedef-word declarations. drop ; GENERIC: pprint-c-type ( c-type -- ) M: word pprint-c-type pprint-word ; M: string pprint-c-type text ; M: array pprint-c-type pprint* ; -M: typedef-word see-class* +M: typedef-word definer drop \ TYPEDEF: f ; + +M: typedef-word synopsis* ; + + From 2bbd29a5613d1887d3e7522faa07212f19a6734a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 22:39:25 -0500 Subject: [PATCH 06/32] prettyprinting for FUNCTION: definitions --- basis/alien/parser/parser.factor | 10 +++++--- basis/alien/prettyprint/prettyprint.factor | 28 ++++++++++++++++------ 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index bca7c93802..662139810e 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays assocs combinators effects -grouping kernel parser sequences splitting words fry locals -lexer namespaces summary math vocabs.parser ; +USING: accessors alien alien.c-types arrays assocs +combinators effects grouping kernel parser sequences +splitting words fry locals lexer namespaces summary +math vocabs.parser ; IN: alien.parser : parse-c-type-name ( name -- word/string ) @@ -55,3 +56,6 @@ IN: alien.parser : define-function ( return library function parameters -- ) make-function define-declared ; + +PREDICATE: alien-function-word < word + def>> [ length 5 = ] [ last \ alien-invoke eq? ] bi and ; diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 4b53f36c3b..096a5547c5 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators alien alien.strings alien.c-types -alien.syntax arrays math.parser prettyprint.backend -prettyprint.custom prettyprint.sections definitions see see.private -strings words ; +USING: accessors kernel combinators alien alien.strings alien.c-types +alien.parser alien.syntax arrays assocs effects math.parser +prettyprint.backend prettyprint.custom prettyprint.sections +definitions see see.private sequences strings words ; IN: alien.prettyprint M: alien pprint* @@ -21,16 +21,30 @@ M: typedef-word declarations. drop ; GENERIC: pprint-c-type ( c-type -- ) M: word pprint-c-type pprint-word ; +M: wrapper pprint-c-type wrapped>> pprint-word ; M: string pprint-c-type text ; M: array pprint-c-type pprint* ; M: typedef-word definer drop \ TYPEDEF: f ; M: typedef-word synopsis* - ; + pprint-word ; +: pprint-function-arg ( type name -- ) + [ pprint-c-type ] [ text ] bi* ; +: pprint-function-args ( word -- ) + [ def>> fourth ] [ stack-effect in>> ] bi zip unclip-last + [ [ first2 "," append pprint-function-arg ] each ] dip + first2 pprint-function-arg ; + +M: alien-function-word definer + drop \ FUNCTION: \ ; ; +M: alien-function-word definition drop f ; +M: alien-function-word synopsis* + \ FUNCTION: pprint-word + [ def>> first pprint-c-type ] + [ pprint-word ] + [ ] tri ; From 93b12d3ef414041c9c62a01c469f6e0888816099 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 22:43:11 -0500 Subject: [PATCH 07/32] update classes.struct tests to use word c-types --- basis/classes/struct/struct-tests.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 3be0be8ef1..e9e45487f9 100755 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -6,7 +6,7 @@ io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math mirrors multiline namespaces prettyprint prettyprint.config see sequences specialized-arrays system tools.test parser lexer eval layouts ; -FROM: math => float +FROM: math => float ; QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: int @@ -48,9 +48,9 @@ STRUCT: struct-test-bar [ { { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } } - { { "x" "char" } 98 } - { { "y" "int" } HEX: 7F00007F } - { { "z" "bool" } f } + { { "x" char } 98 } + { { "y" int } HEX: 7F00007F } + { { "z" bool } f } } ] [ B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct make-mirror >alist From 6dc6886bd92c93b94c8ba74db0360a4afb612e5f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 22:58:07 -0500 Subject: [PATCH 08/32] typedefs share their original type's pointer definition --- basis/alien/c-types/c-types-tests.factor | 2 +- basis/alien/c-types/c-types.factor | 18 +++++++++++++----- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index bfeff5f1de..792e7d416a 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray TYPEDEF: uchar* MyLPBYTE -[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test +[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test [ 0 B{ 1 2 3 4 } diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 02ab2dcafa..7dc00333b8 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -65,8 +65,8 @@ M: word resolve-pointer-type dup "pointer-c-type" word-prop [ ] [ drop void* ] ?if ; M: string resolve-pointer-type - c-types get at dup string? - [ "*" append ] [ drop void* ] if ; + c-types get at dup c-type-name? + [ resolve-pointer-type ] [ drop void* ] if ; : resolve-typedef ( name -- type ) dup c-type-name? [ c-type ] when ; @@ -313,9 +313,17 @@ PREDICATE: typedef-word < c-type-word M: string typedef ( old new -- ) c-types get set-at ; M: word typedef ( old new -- ) - [ nip define-symbol ] - [ name>> typedef ] - [ swap "c-type" set-word-prop ] 2tri ; + { + [ nip define-symbol ] + [ name>> typedef ] + [ swap "c-type" set-word-prop ] + [ + swap dup word? [ + "pointer-c-type" word-prop + "pointer-c-type" set-word-prop + ] [ 2drop ] if + ] + } 2cleave ; TUPLE: long-long-type < c-type ; From 01d2ef415ac71210614ea6fff0d032edef67d59b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 09:20:47 -0500 Subject: [PATCH 09/32] get compiler tests loading --- basis/classes/struct/struct.factor | 2 +- basis/compiler/tests/alien.factor | 1 + basis/compiler/tests/codegen.factor | 3 ++- basis/compiler/tests/intrinsics.factor | 1 + basis/compiler/tree/cleanup/cleanup-tests.factor | 1 + basis/compiler/tree/propagation/propagation-tests.factor | 1 + basis/cpu/x86/64/unix/unix.factor | 2 +- 7 files changed, 8 insertions(+), 3 deletions(-) diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index a96a74d2ac..dabdead10c 100755 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -126,7 +126,7 @@ M: struct-c-type c-type ; M: struct-c-type c-type-stack-align? drop f ; : if-value-struct ( ctype true false -- ) - [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline + [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline M: struct-c-type unbox-parameter [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 484b1f4f2f..e21e13dc13 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -5,6 +5,7 @@ io.streams.string kernel math memory namespaces namespaces.private parser quotations sequences specialized-arrays stack-checker stack-checker.errors system threads tools.test words ; +FROM: alien.c-types => float short ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: char IN: compiler.tests.alien diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index fcbac30444..56e368e320 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -4,6 +4,7 @@ namespaces.private slots.private sequences.private byte-arrays alien alien.accessors layouts words definitions compiler.units io combinators vectors grouping make alien.c-types combinators.short-circuit math.order math.libm math.parser ; +FROM: math => float ; QUALIFIED: namespaces.private IN: compiler.tests.codegen @@ -414,4 +415,4 @@ cell 4 = [ [ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test [ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test -[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test \ No newline at end of file +[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index ad2d2c8be5..dc2f5d9257 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -5,6 +5,7 @@ hashtables.private byte-arrays system random layouts vectors sbufs strings.private slots.private alien math.order alien.accessors alien.c-types alien.syntax alien.strings namespaces libc io.encodings.ascii classes compiler ; +FROM: math => float ; IN: compiler.tests.intrinsics ! Make sure that intrinsic ops compile to correct code. diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index faf6968670..02e7409c24 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -16,6 +16,7 @@ compiler.tree.propagation compiler.tree.propagation.info compiler.tree.checker compiler.tree.debugger ; +FROM: math => float ; IN: compiler.tree.cleanup.tests [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 0c220542ca..0da234791b 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -10,6 +10,7 @@ compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals specialized-arrays system sorting math.libm math.intervals quotations effects alien ; +FROM: math => float ; SPECIALIZED-ARRAY: double IN: compiler.tree.propagation.tests diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index 2f8a01f0fe..13e91a87a4 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -34,7 +34,7 @@ stack-params \ (stack-value) c-type (>>rep) >> : flatten-small-struct ( c-type -- seq ) struct-types&offset split-struct [ [ c-type c-type-rep reg-class-of ] map - int-regs swap member? "void*" "double" ? c-type + int-regs swap member? void* double ? c-type ] map ; : flatten-large-struct ( c-type -- seq ) From 21c09ab97ad2b4cf5c18e3c29eef6f4e3fe76605 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 09:56:07 -0500 Subject: [PATCH 10/32] fix struct class see --- basis/classes/struct/prettyprint/prettyprint.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor index 2c969531e8..7f57e8568a 100644 --- a/basis/classes/struct/prettyprint/prettyprint.factor +++ b/basis/classes/struct/prettyprint/prettyprint.factor @@ -1,9 +1,9 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types arrays assocs classes -classes.struct combinators combinators.short-circuit continuations -fry kernel libc make math math.parser mirrors prettyprint.backend -prettyprint.custom prettyprint.sections see.private sequences -slots strings summary words ; +USING: accessors alien alien.c-types alien.prettyprint arrays +assocs classes classes.struct combinators combinators.short-circuit +continuations fry kernel libc make math math.parser mirrors +prettyprint.backend prettyprint.custom prettyprint.sections +see.private sequences slots strings summary words ; IN: classes.struct.prettyprint > text ] - [ type>> dup string? [ text ] [ pprint* ] if ] + [ type>> pprint-c-type ] [ read-only>> [ \ read-only pprint-word ] when ] [ initial>> [ \ initial: pprint-word pprint* ] when* ] } cleave block> From b403ba5c1755dda9682d3ba7d696cd4d9879a6c0 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 10:24:03 -0500 Subject: [PATCH 11/32] fix FUNCTION: prettyprint when function has no arguments --- basis/alien/prettyprint/prettyprint.factor | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 096a5547c5..4586c08542 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -36,9 +36,11 @@ M: typedef-word synopsis* [ pprint-c-type ] [ text ] bi* ; : pprint-function-args ( word -- ) - [ def>> fourth ] [ stack-effect in>> ] bi zip unclip-last - [ [ first2 "," append pprint-function-arg ] each ] dip - first2 pprint-function-arg ; + [ def>> fourth ] [ stack-effect in>> ] bi zip [ ] [ + unclip-last + [ [ first2 "," append pprint-function-arg ] each ] dip + first2 pprint-function-arg + ] if-empty ; M: alien-function-word definer drop \ FUNCTION: \ ; ; From fc5500a0dcfad986222f41085f151f92802763c5 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 13:11:53 -0500 Subject: [PATCH 12/32] oops... word c-types can be structs too --- basis/alien/c-types/c-types.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 7dc00333b8..f147810cd2 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -94,7 +94,7 @@ GENERIC: c-struct? ( type -- ? ) M: object c-struct? drop f ; -M: string c-struct? +M: c-type-name c-struct? dup void? [ drop f ] [ c-type c-struct? ] if ; ! These words being foldable means that words need to be @@ -123,7 +123,7 @@ M: c-type-name GENERIC: (c-array) ( len c-type -- array ) -M: string (c-array) +M: c-type-name (c-array) c-(array)-constructor execute( len -- array ) ; inline GENERIC: ( alien len c-type -- array ) From e70c063e61a65be2e208ed2db7d313cbb6201bd8 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 14:17:13 -0500 Subject: [PATCH 13/32] fix alien-function-word predicate --- basis/alien/parser/parser.factor | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 662139810e..ab09383d7c 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types arrays assocs -combinators effects grouping kernel parser sequences -splitting words fry locals lexer namespaces summary -math vocabs.parser ; +combinators combinators.short-circuit effects grouping +kernel parser sequences splitting words fry locals lexer +namespaces summary math vocabs.parser ; IN: alien.parser : parse-c-type-name ( name -- word/string ) @@ -58,4 +58,7 @@ IN: alien.parser make-function define-declared ; PREDICATE: alien-function-word < word - def>> [ length 5 = ] [ last \ alien-invoke eq? ] bi and ; + def>> { + [ length 5 = ] + [ last \ alien-invoke eq? ] + } 1&& ; From c880d3fff3af76ecfb1da228cf1f8cba611e90b3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 15:41:38 -0500 Subject: [PATCH 14/32] update functors tests --- basis/functors/functors-tests.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 5f2e32ad71..58da96aa17 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -161,15 +161,15 @@ T-class DEFINES-CLASS ${T} WHERE STRUCT: T-class - { NAME int } + { NAME c:int } { x { TYPE 4 } } - { y { short N } } + { y { c:short N } } { z TYPE initial: 5 } { float { c:float 2 } } ; ;FUNCTOR -"a-struct" "nemo" "char" 2 define-a-struct +"a-struct" "nemo" c:char 2 define-a-struct >> @@ -180,35 +180,35 @@ STRUCT: T-class { offset 0 } { class integer } { initial 0 } - { c-type int } + { type c:int } } T{ struct-slot-spec { name "x" } { offset 4 } { class object } { initial f } - { c-type { char 4 } } + { type { c:char 4 } } } T{ struct-slot-spec { name "y" } { offset 8 } { class object } { initial f } - { c-type { short 2 } } + { type { c:short 2 } } } T{ struct-slot-spec { name "z" } { offset 12 } { class fixnum } { initial 5 } - { c-type char } + { type c:char } } T{ struct-slot-spec { name "float" } { offset 16 } { class object } { initial f } - { c-type { c:float 2 } } + { type { c:float 2 } } } } ] [ a-struct struct-slots ] unit-test From 40620d470fc50175aa709687c8633bff09b1810b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 17:18:19 -0500 Subject: [PATCH 15/32] allow word c-types and definitions to coexist --- basis/alien/parser/parser.factor | 6 ++++++ basis/alien/syntax/syntax.factor | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index ab09383d7c..9a24f7cd4d 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -24,6 +24,12 @@ IN: alien.parser [ drop \ } parse-until >array ] [ parse-c-type ] if ; +: reset-c-type ( word -- ) + { "c-type" "pointer-c-type" } reset-props ; + +: CREATE-C-TYPE ( -- word ) + scan current-vocab create dup reset-c-type ; + : normalize-c-arg ( type name -- type' name' ) [ length ] [ diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index fac45176a3..0e3b569fff 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -19,7 +19,7 @@ SYNTAX: FUNCTION: (FUNCTION:) define-declared ; SYNTAX: TYPEDEF: - scan-c-type CREATE typedef ; + scan-c-type CREATE-C-TYPE typedef ; SYNTAX: C-STRUCT: scan current-vocab parse-definition define-struct ; deprecated From 58756c27c53029af3b810247cc003f8cee53c745 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 17:36:50 -0500 Subject: [PATCH 16/32] have typedefs take on the old type's pointer type even when the new type is a word and the old a string --- basis/alien/c-types/c-types.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index f147810cd2..ecdc926b62 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -318,8 +318,8 @@ M: word typedef ( old new -- ) [ name>> typedef ] [ swap "c-type" set-word-prop ] [ - swap dup word? [ - "pointer-c-type" word-prop + swap dup c-type-name? [ + resolve-pointer-type "pointer-c-type" set-word-prop ] [ 2drop ] if ] From 9479fb4099f4404978e8ed6f709d9dbdc32b02b2 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 20:54:22 -0500 Subject: [PATCH 17/32] have SPECIALIZED-ARRAY: scan in a c-type rather than a string --- basis/specialized-arrays/specialized-arrays.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index bca85a25db..0490ede304 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types assocs byte-arrays classes -compiler.units functors kernel lexer libc math +USING: accessors alien alien.c-types alien.parser assocs +byte-arrays classes compiler.units functors kernel lexer libc math math.vectors.specialization namespaces parser prettyprint.custom sequences sequences.private strings summary vocabs vocabs.loader vocabs.parser words fry combinators ; @@ -157,7 +157,7 @@ M: c-type-name c-direct-array-constructor [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable SYNTAX: SPECIALIZED-ARRAY: - scan define-array-vocab use-vocab ; + scan-c-type define-array-vocab use-vocab ; "prettyprint" vocab [ "specialized-arrays.prettyprint" require From 263ce45932f6926a9654d21f9cf2296d1a82cd1c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 20:54:57 -0500 Subject: [PATCH 18/32] fix resolve-pointer-type --- basis/alien/c-types/c-types.factor | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index ecdc926b62..6d63987265 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -65,8 +65,12 @@ M: word resolve-pointer-type dup "pointer-c-type" word-prop [ ] [ drop void* ] ?if ; M: string resolve-pointer-type - c-types get at dup c-type-name? - [ resolve-pointer-type ] [ drop void* ] if ; + dup "*" append dup c-types get at + [ nip ] [ + drop + c-types get at dup c-type-name? + [ resolve-pointer-type ] [ drop void* ] if + ] if ; : resolve-typedef ( name -- type ) dup c-type-name? [ c-type ] when ; From 31264538e3f9dfcbf77329d92dae7b8869b9fe34 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 20:55:14 -0500 Subject: [PATCH 19/32] get gpu vocabs to load with c-type changes --- extra/gpu/demos/bunny/bunny.factor | 1 + extra/gpu/render/render.factor | 4 +++- extra/gpu/state/state.factor | 4 +++- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor index 10e49984a1..d6c7456d63 100755 --- a/extra/gpu/demos/bunny/bunny.factor +++ b/extra/gpu/demos/bunny/bunny.factor @@ -7,6 +7,7 @@ io io.encodings.ascii io.files io.files.temp kernel math math.matrices math.parser math.vectors method-chains sequences splitting threads ui ui.gadgets ui.gadgets.worlds ui.pixel-formats specialized-arrays specialized-vectors ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-VECTOR: uint IN: gpu.demos.bunny diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 0ee9ab78c5..9d8c15ab7a 100644 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -9,7 +9,9 @@ lexer locals math math.order math.parser namespaces opengl opengl.gl parser quotations sequences slots sorting specialized-arrays strings ui.gadgets.worlds variants vocabs.parser words ; -SPECIALIZED-ARRAY: float +FROM: math => float ; +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAY: c:float SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: void* diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor index 02d6046722..2bca8f72fc 100755 --- a/extra/gpu/state/state.factor +++ b/extra/gpu/state/state.factor @@ -2,8 +2,10 @@ USING: accessors alien.c-types arrays byte-arrays combinators gpu kernel literals math math.rectangles opengl opengl.gl sequences variants specialized-arrays ; +QUALIFIED-WITH: alien.c-types c +FROM: math => float ; SPECIALIZED-ARRAY: int -SPECIALIZED-ARRAY: float +SPECIALIZED-ARRAY: c:float IN: gpu.state UNION: ?rect rect POSTPONE: f ; From 8f336b4ec00bfd1dd08cb798d5dcae8cf8f7da6f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 21:24:10 -0500 Subject: [PATCH 20/32] alien.fortran can't piggyback the alien.parser arg parser anymore --- basis/alien/fortran/fortran.factor | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 52d69fd193..3670a376e1 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -1,5 +1,5 @@ ! (c) 2009 Joe Groff, see BSD license -USING: accessors alien alien.c-types alien.complex alien.parser +USING: accessors alien alien.c-types alien.complex grouping alien.strings alien.syntax arrays ascii assocs byte-arrays combinators combinators.short-circuit fry generalizations kernel lexer macros math math.parser namespaces parser sequences @@ -429,6 +429,11 @@ PRIVATE> MACRO: fortran-invoke ( return library function parameters -- ) { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ; +: parse-arglist ( parameters return -- types effect ) + [ 2 group unzip [ "," ?tail drop ] map ] + [ [ { } ] [ 1array ] if-void ] + bi* ; + :: define-fortran-function ( return library function parameters -- ) function create-in dup reset-generic return library function parameters return [ "void" ] unless* parse-arglist From fa60d96ae47006a7071f2c8599f2656e56c98843 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 16 Sep 2009 21:25:46 -0500 Subject: [PATCH 21/32] fix "float" ambiguities in math.blas, opengl vocabs --- basis/math/blas/matrices/matrices.factor | 1 + basis/math/blas/vectors/vectors.factor | 1 + basis/opengl/opengl.factor | 1 + 3 files changed, 3 insertions(+) diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor index a051fb250d..4212f32b2d 100755 --- a/basis/math/blas/matrices/matrices.factor +++ b/basis/math/blas/matrices/matrices.factor @@ -5,6 +5,7 @@ math.complex math.functions math.order functors words sequences sequences.merged sequences.private shuffle parser prettyprint.backend prettyprint.custom ascii specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: complex-float diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor index c08fdb6120..20ee7925b0 100755 --- a/basis/math/blas/vectors/vectors.factor +++ b/basis/math/blas/vectors/vectors.factor @@ -3,6 +3,7 @@ combinators.short-circuit fry kernel math math.blas.ffi math.complex math.functions math.order sequences sequences.private functors words locals parser prettyprint.backend prettyprint.custom specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: complex-float diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 75f327664d..cdf68cebd3 100755 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -8,6 +8,7 @@ math.parser opengl.gl combinators combinators.smart arrays sequences splitting words byte-arrays assocs vocabs colors colors.constants accessors generalizations locals fry specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: uint IN: opengl From 1f04ed01feda73e467055fe58e842ea267d90ad6 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 09:29:23 -0500 Subject: [PATCH 22/32] fix more ambiguities --- basis/math/vectors/simd/functor/functor.factor | 12 ++++++++---- basis/math/vectors/simd/simd.factor | 14 ++++++++------ .../specialized-arrays-tests.factor | 1 + basis/x11/xlib/xlib.factor | 1 + extra/alien/marshall/marshall.factor | 1 + extra/bunny/model/model.factor | 5 +++-- extra/gpu/textures/textures.factor | 1 + extra/openal/openal.factor | 1 + 8 files changed, 24 insertions(+), 12 deletions(-) diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index cabb731fef..641585a5d7 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -9,14 +9,16 @@ ERROR: bad-length got expected ; FUNCTOR: define-simd-128 ( T -- ) -N [ 16 T heap-size /i ] +T-TYPE IS ${T} + +N [ 16 T-TYPE heap-size /i ] A DEFINES-CLASS ${T}-${N} >A DEFINES >${A} A{ DEFINES ${A}{ -NTH [ T dup c-type-getter-boxer array-accessor ] -SET-NTH [ T dup c-setter array-accessor ] +NTH [ T-TYPE dup c-type-getter-boxer array-accessor ] +SET-NTH [ T-TYPE dup c-setter array-accessor ] A-rep IS ${A}-rep A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op @@ -74,7 +76,9 @@ PRIVATE> ! Synthesize 256-bit vectors from a pair of 128-bit vectors FUNCTOR: define-simd-256 ( T -- ) -N [ 32 T heap-size /i ] +T-TYPE IS ${T} + +N [ 32 T-TYPE heap-size /i ] N/2 [ N 2 / ] A/2 IS ${T}-${N/2} diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index 7df9b2d8d2..a3c99ae217 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -5,6 +5,8 @@ kernel math math.functions math.vectors math.vectors.simd.functor math.vectors.simd.intrinsics math.vectors.specialization parser prettyprint.custom sequences sequences.private locals assocs words fry ; +FROM: alien.c-types => float ; +QUALIFIED-WITH: math m IN: math.vectors.simd << @@ -15,9 +17,9 @@ DEFER: float-8 DEFER: double-4 "double" define-simd-128 -"float" define-simd-128 +"float" define-simd-128 "double" define-simd-256 -"float" define-simd-256 +"float" define-simd-256 >> @@ -136,7 +138,7 @@ DEFER: double-4 PRIVATE> -\ float-4 \ float-4-with float H{ +\ float-4 \ float-4-with m:float H{ { v+ [ [ (simd-v+) ] float-4-vv->v-op ] } { v- [ [ (simd-v-) ] float-4-vv->v-op ] } { v* [ [ (simd-v*) ] float-4-vv->v-op ] } @@ -146,7 +148,7 @@ PRIVATE> { sum [ [ (simd-sum) ] float-4-v->n-op ] } } simd-vector-words -\ double-2 \ double-2-with float H{ +\ double-2 \ double-2-with m:float H{ { v+ [ [ (simd-v+) ] double-2-vv->v-op ] } { v- [ [ (simd-v-) ] double-2-vv->v-op ] } { v* [ [ (simd-v*) ] double-2-vv->v-op ] } @@ -156,7 +158,7 @@ PRIVATE> { sum [ [ (simd-sum) ] double-2-v->n-op ] } } simd-vector-words -\ float-8 \ float-8-with float H{ +\ float-8 \ float-8-with m:float H{ { v+ [ [ (simd-v+) ] float-8-vv->v-op ] } { v- [ [ (simd-v-) ] float-8-vv->v-op ] } { v* [ [ (simd-v*) ] float-8-vv->v-op ] } @@ -166,7 +168,7 @@ PRIVATE> { sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] } } simd-vector-words -\ double-4 \ double-4-with float H{ +\ double-4 \ double-4-with m:float H{ { v+ [ [ (simd-v+) ] double-4-vv->v-op ] } { v- [ [ (simd-v-) ] double-4-vv->v-op ] } { v* [ [ (simd-v*) ] double-4-vv->v-op ] } diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 2698149bac..e289efb077 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -5,6 +5,7 @@ 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 ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: bool diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index 48d556de1d..98305e8304 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -13,6 +13,7 @@ USING: accessors kernel arrays alien alien.c-types alien.strings alien.syntax classes.struct math math.bitwise words sequences namespaces continuations io io.encodings.ascii x11.syntax ; +FROM: alien.c-types => short ; IN: x11.xlib LIBRARY: xlib diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor index 2cae122641..e8ea0d3754 100644 --- a/extra/alien/marshall/marshall.factor +++ b/extra/alien/marshall/marshall.factor @@ -6,6 +6,7 @@ combinators combinators.short-circuit destructors fry io.encodings.utf8 kernel libc sequences specialized-arrays strings unix.utilities vocabs.parser words libc.private locals generalizations math ; +FROM: alien.c-types => float short ; SPECIALIZED-ARRAY: bool SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: double diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index dd6730b57f..d80f3aa98a 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -3,8 +3,9 @@ http.client io io.encodings.ascii io.files io.files.temp kernel math math.matrices math.parser math.vectors opengl opengl.capabilities opengl.gl opengl.demo-support sequences splitting vectors words specialized-arrays ; -SPECIALIZED-ARRAY: float -SPECIALIZED-ARRAY: uint +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAY: c:float +SPECIALIZED-ARRAY: c:uint IN: bunny.model : numbers ( str -- seq ) diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor index 8015ff9a9b..2649f7c586 100644 --- a/extra/gpu/textures/textures.factor +++ b/extra/gpu/textures/textures.factor @@ -3,6 +3,7 @@ USING: accessors alien.c-types arrays byte-arrays combinators destructors fry gpu gpu.buffers images kernel locals math opengl opengl.gl opengl.textures sequences specialized-arrays ui.gadgets.worlds variants ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float IN: gpu.textures diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor index 81a6621eff..bccdec1420 100644 --- a/extra/openal/openal.factor +++ b/extra/openal/openal.factor @@ -4,6 +4,7 @@ USING: kernel accessors arrays alien system combinators alien.syntax namespaces alien.c-types sequences vocabs.loader shuffle openal.backend alien.libraries generalizations specialized-arrays ; +FROM: alien.c-types => float short ; SPECIALIZED-ARRAY: uint IN: openal From e02d480b43ad6dc0a99d307351c6ed0584734063 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 09:40:37 -0500 Subject: [PATCH 23/32] fix alien.inline tests --- extra/alien/inline/types/types.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor index 070febc324..ac7f6ae17f 100644 --- a/extra/alien/inline/types/types.factor +++ b/extra/alien/inline/types/types.factor @@ -2,10 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types assocs combinators.short-circuit continuations effects fry kernel math memoize sequences -splitting strings peg.ebnf make ; +splitting strings peg.ebnf make words ; IN: alien.inline.types : cify-type ( str -- str' ) + dup word? [ name>> ] when { { CHAR: - CHAR: space } } substitute ; : factorize-type ( str -- str' ) From c3f0688164f2cf18b08c3c830fe533ff6c88003b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 09:55:09 -0500 Subject: [PATCH 24/32] more loading fixes --- extra/alien/marshall/marshall.factor | 2 +- extra/freetype/freetype.factor | 2 +- extra/jamshred/gl/gl.factor | 1 + extra/synth/buffers/buffers.factor | 1 + 4 files changed, 4 insertions(+), 2 deletions(-) diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor index e8ea0d3754..d343da0fe0 100644 --- a/extra/alien/marshall/marshall.factor +++ b/extra/alien/marshall/marshall.factor @@ -23,7 +23,7 @@ SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: void* IN: alien.marshall -<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ] +<< primitive-types [ [ void* = ] [ bool = ] bi or not ] filter [ define-primitive-marshallers ] each >> TUPLE: alien-wrapper { underlying alien } ; diff --git a/extra/freetype/freetype.factor b/extra/freetype/freetype.factor index c45475cefa..0bfaae9853 100644 --- a/extra/freetype/freetype.factor +++ b/extra/freetype/freetype.factor @@ -23,7 +23,7 @@ TYPEDEF: ushort FT_UShort TYPEDEF: long FT_Long TYPEDEF: ulong FT_ULong TYPEDEF: uchar FT_Bool -TYPEDEF: cell FT_Offset +TYPEDEF: ulong FT_Offset TYPEDEF: int FT_PtrDist TYPEDEF: char FT_String TYPEDEF: int FT_Tag diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index 1a03a2c941..60e9e39d9f 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -4,6 +4,7 @@ USING: accessors alien.c-types jamshred.game jamshred.oint jamshred.player jamshred.tunnel kernel math math.constants math.functions math.vectors opengl opengl.gl opengl.glu opengl.demo-support sequences specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float IN: jamshred.gl diff --git a/extra/synth/buffers/buffers.factor b/extra/synth/buffers/buffers.factor index 71b05ac642..978fb32d42 100644 --- a/extra/synth/buffers/buffers.factor +++ b/extra/synth/buffers/buffers.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged specialized-arrays ; +FROM: alien.c-types => short ; SPECIALIZED-ARRAY: uchar SPECIALIZED-ARRAY: short IN: synth.buffers From d9c6230f43bad0d3db82d761f2c81026726b418e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 11:10:06 -0500 Subject: [PATCH 25/32] fix more alien.inline tests --- extra/alien/inline/inline.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/extra/alien/inline/inline.factor b/extra/alien/inline/inline.factor index 84c3450102..ee69d954ea 100644 --- a/extra/alien/inline/inline.factor +++ b/extra/alien/inline/inline.factor @@ -41,6 +41,11 @@ SYMBOL: c-strings [ current-vocab name>> % "_" % % ] "" make ; PRIVATE> +: parse-arglist ( parameters return -- types effect ) + [ 2 group unzip [ "," ?tail drop ] map ] + [ [ { } ] [ 1array ] if-void ] + bi* ; + : append-function-body ( prototype-str body -- str ) [ swap % " {\n" % % "\n}\n" % ] "" make ; From eeebf6c7514768e65d3e8c6d32aa7b633dba5fc0 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 14:01:41 -0500 Subject: [PATCH 26/32] fix loading issues in windows vocabs --- basis/windows/dinput/constants/constants.factor | 9 +++++++-- basis/windows/types/types.factor | 4 +++- basis/windows/winsock/winsock.factor | 1 + 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index b67b5fa08f..270c2fa3dd 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces combinators sequences fry math accessors macros words quotations libc continuations generalizations splitting locals assocs init -specialized-arrays memoize classes.struct ; +specialized-arrays memoize classes.struct strings arrays ; SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT IN: windows.dinput.constants @@ -22,12 +22,17 @@ SYMBOLS: MEMO: c-type* ( name -- c-type ) c-type ; MEMO: heap-size* ( c-type -- n ) heap-size ; +GENERIC: array-base-type ( c-type -- c-type' ) +M: object array-base-type ; +M: string array-base-type "[" split1 drop ; +M: array array-base-type first ; + : (field-spec-of) ( field struct -- field-spec ) c-type* fields>> [ name>> = ] with find nip ; : (offsetof) ( field struct -- offset ) [ (field-spec-of) offset>> ] [ drop 0 ] if* ; : (sizeof) ( field struct -- size ) - [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ; + [ (field-spec-of) type>> array-base-type heap-size* ] [ drop 1 ] if* ; : (flag) ( thing -- integer ) { diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index c882ba2e7f..544abb69a8 100755 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -3,6 +3,7 @@ USING: alien alien.c-types alien.syntax namespaces kernel words sequences math math.bitwise math.vectors colors io.encodings.utf16n classes.struct accessors ; +FROM: alien.c-types => float short ; IN: windows.types TYPEDEF: char CHAR @@ -69,7 +70,8 @@ TYPEDEF: ulonglong ULARGE_INTEGER TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER -<< { "char*" utf16n } "wchar_t*" typedef >> +SYMBOL: wchar_t* +<< { char* utf16n } \ wchar_t* typedef >> TYPEDEF: wchar_t* LPCSTR TYPEDEF: wchar_t* LPWSTR diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 87b8970b02..e29eb3e090 100755 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -4,6 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax arrays byte-arrays kernel literals math sequences windows.types windows.kernel32 windows.errors math.bitwise io.encodings.utf16n classes.struct windows.com.syntax init ; +FROM: alien.c-types => short ; IN: windows.winsock TYPEDEF: void* SOCKET From 4758cca22319f5c84a2ef623dde3e797fafd1a8b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 14:22:49 -0500 Subject: [PATCH 27/32] fix dinput device hotplug support --- basis/game-input/dinput/dinput.factor | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor index ea3100f95f..a7489f26a2 100755 --- a/basis/game-input/dinput/dinput.factor +++ b/basis/game-input/dinput/dinput.factor @@ -160,19 +160,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+ [ device-attached? not ] filter [ remove-controller ] each ; -: device-interface? ( dbt-broadcast-hdr -- ? ) - dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ; +: ?device-interface ( dbt-broadcast-hdr -- ? ) + dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = + [ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ] + [ drop f ] if ; inline : device-arrived ( dbt-broadcast-hdr -- ) - device-interface? [ find-controllers ] when ; + ?device-interface [ find-controllers ] when ; inline : device-removed ( dbt-broadcast-hdr -- ) - device-interface? [ find-and-remove-detached-devices ] when ; + ?device-interface [ find-and-remove-detached-devices ] when ; inline + +: ( wParam -- struct ) + DEV_BROADCAST_HDR memory>struct ; : handle-wm-devicechange ( hWnd uMsg wParam lParam -- ) [ 2drop ] 2dip swap { - { [ dup DBT_DEVICEARRIVAL = ] [ drop device-arrived ] } - { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop device-removed ] } + { [ dup DBT_DEVICEARRIVAL = ] [ drop device-arrived ] } + { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop device-removed ] } [ 2drop ] } cond ; From aa1edad0788d91f89965e3c82b51c1d8f6fbf698 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 19:10:40 -0500 Subject: [PATCH 28/32] disambiguate math:float in cpu.ppc --- basis/cpu/ppc/ppc.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index f881ff5f91..063f3b37b1 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -9,6 +9,7 @@ compiler.codegen.fixup compiler.cfg.intrinsics compiler.cfg.stack-frame compiler.cfg.build-stack-frame compiler.units compiler.constants compiler.codegen ; FROM: cpu.ppc.assembler => B ; +FROM: math => float ; IN: cpu.ppc ! PowerPC register assignments: From 076ab42dc37caaa946769ec79faee57af0865bb3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 17 Sep 2009 22:07:21 -0500 Subject: [PATCH 29/32] move some allocation words that don't really have much to do with c types out of alien.c-types into a new alien.data vocab --- basis/alien/arrays/arrays-docs.factor | 2 +- basis/alien/arrays/arrays.factor | 4 +- basis/alien/c-types/c-types-docs.factor | 181 ++---------------- basis/alien/c-types/c-types.factor | 105 ++-------- basis/alien/data/authors.txt | 1 + basis/alien/data/data-docs.factor | 148 ++++++++++++++ basis/alien/data/data.factor | 83 ++++++++ basis/alien/data/summary.txt | 1 + basis/alien/fortran/fortran-tests.factor | 4 +- basis/alien/fortran/fortran.factor | 2 +- .../remote-control/remote-control.factor | 2 +- basis/alien/structs/structs-docs.factor | 2 +- basis/alien/structs/structs-tests.factor | 2 +- basis/bit-arrays/bit-arrays.factor | 2 +- basis/checksums/openssl/openssl.factor | 6 +- .../struct/prettyprint/prettyprint.factor | 2 +- basis/classes/struct/struct-tests.factor | 2 +- basis/classes/struct/struct.factor | 2 +- basis/cocoa/enumeration/enumeration.factor | 11 +- basis/cocoa/plists/plists.factor | 4 +- basis/compiler/tests/intrinsics.factor | 2 +- basis/cpu/ppc/ppc.factor | 2 +- basis/db/postgresql/lib/lib.factor | 10 +- basis/db/sqlite/lib/lib.factor | 2 +- basis/environment/unix/unix.factor | 7 +- basis/environment/winnt/winnt.factor | 11 +- basis/game-input/dinput/dinput.factor | 2 +- .../dinput/keys-array/keys-array.factor | 4 +- basis/game-input/iokit/iokit.factor | 3 +- basis/images/memory/memory.factor | 6 +- .../windows/nt/privileges/privileges.factor | 2 +- basis/io/buffers/buffers-tests.factor | 6 +- basis/io/buffers/buffers.factor | 4 +- basis/io/files/info/windows/windows.factor | 2 +- basis/io/files/windows/windows.factor | 2 +- basis/io/mmap/mmap.factor | 2 +- basis/io/monitors/windows/nt/nt.factor | 4 +- .../io/sockets/secure/openssl/openssl.factor | 8 +- basis/io/sockets/sockets.factor | 2 +- basis/io/sockets/unix/unix.factor | 2 +- basis/io/sockets/windows/nt/nt.factor | 2 +- basis/libc/libc.factor | 20 +- basis/math/blas/matrices/matrices.factor | 14 +- .../vectors/simd/intrinsics/intrinsics.factor | 2 +- basis/opengl/shaders/shaders.factor | 2 +- basis/random/windows/windows.factor | 2 +- .../specialized-arrays-tests.factor | 2 +- .../specialized-arrays.factor | 2 +- basis/tools/deploy/config/config-docs.factor | 2 +- basis/tools/disassembler/disassembler.factor | 2 +- basis/tools/disassembler/udis/udis.factor | 2 +- basis/ui/backend/cocoa/views/views.factor | 10 +- basis/ui/backend/windows/windows.factor | 2 +- basis/unix/process/process.factor | 6 +- basis/unix/utilities/utilities.factor | 2 +- basis/unix/utmpx/utmpx.factor | 8 +- basis/windows/com/com.factor | 2 +- basis/windows/com/wrapper/wrapper.factor | 12 +- .../windows/dinput/constants/constants.factor | 9 +- .../dragdrop-listener.factor | 9 +- basis/windows/errors/errors.factor | 11 +- basis/windows/offscreen/offscreen.factor | 6 +- basis/windows/ole32/ole32.factor | 4 +- basis/x11/xlib/xlib.factor | 6 +- core/alien/strings/strings-tests.factor | 2 +- extra/alien/inline/syntax/syntax-tests.factor | 2 +- extra/alien/marshall/marshall-docs.factor | 2 +- extra/alien/marshall/marshall.factor | 2 +- extra/alien/marshall/private/private.factor | 2 +- extra/alien/marshall/structs/structs.factor | 2 +- extra/audio/wav/wav.factor | 2 +- extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor | 2 +- extra/ecdsa/ecdsa.factor | 2 +- extra/gpu/render/render.factor | 2 +- extra/gpu/shaders/shaders.factor | 14 +- extra/gpu/state/state.factor | 6 +- extra/half-floats/half-floats-tests.factor | 2 +- extra/half-floats/half-floats.factor | 2 +- extra/io/serial/unix/unix.factor | 7 +- extra/memory/piles/piles.factor | 2 +- extra/system-info/windows/ce/ce.factor | 2 +- 81 files changed, 427 insertions(+), 416 deletions(-) create mode 100644 basis/alien/data/authors.txt create mode 100644 basis/alien/data/data-docs.factor create mode 100644 basis/alien/data/data.factor create mode 100644 basis/alien/data/summary.txt diff --git a/basis/alien/arrays/arrays-docs.factor b/basis/alien/arrays/arrays-docs.factor index db4a7bf595..74174485fe 100755 --- a/basis/alien/arrays/arrays-docs.factor +++ b/basis/alien/arrays/arrays-docs.factor @@ -1,5 +1,5 @@ +USING: help.syntax help.markup byte-arrays alien.c-types alien.data ; IN: alien.arrays -USING: help.syntax help.markup byte-arrays alien.c-types ; ARTICLE: "c-arrays" "C arrays" "C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "." diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index 52c6afa4df..ee75d22c2c 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.strings alien.c-types alien.accessors -arrays words sequences math kernel namespaces fry libc cpu.architecture +USING: alien alien.strings alien.c-types alien.data alien.accessors +arrays words sequences math kernel namespaces fry cpu.architecture io.encodings.utf8 accessors ; IN: alien.arrays diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index d9e1f7124a..a9613d2c9f 100755 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -1,7 +1,25 @@ -IN: alien.c-types USING: alien help.syntax help.markup libc kernel.private byte-arrays math strings hashtables alien.syntax alien.strings sequences io.encodings.string debugger destructors vocabs.loader ; +IN: alien.c-types + +HELP: byte-length +{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } } +{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ; + +HELP: heap-size +{ $values { "type" string } { "size" integer } } +{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." } +{ $examples + "On a 32-bit system, you will get the following output:" + { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" } +} +{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; + +HELP: stack-size +{ $values { "type" string } { "size" integer } } +{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." } +{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; HELP: { $values { "type" hashtable } } @@ -20,24 +38,6 @@ HELP: c-type { $description "Looks up a C type by name." } { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; -HELP: heap-size -{ $values { "type" string } { "size" integer } } -{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." } -{ $examples - "On a 32-bit system, you will get the following output:" - { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" } -} -{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; - -HELP: stack-size -{ $values { "type" string } { "size" integer } } -{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." } -{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; - -HELP: byte-length -{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } } -{ $contract "Outputs the size of the byte array or float array data in bytes as presented to the C library interface." } ; - HELP: c-getter { $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } } { $description "Outputs a quotation which reads values of this C type from a C structure." } @@ -48,49 +48,6 @@ HELP: c-setter { $description "Outputs a quotation which writes values of this C type to a C structure." } { $errors "Throws an error if the type does not exist." } ; -HELP: -{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } } -{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." } -{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } -{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ; - -HELP: -{ $values { "type" "a C type" } { "array" byte-array } } -{ $description "Creates a byte array suitable for holding a value with the given C type." } -{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ; - -{ malloc-object } related-words - -HELP: memory>byte-array -{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } } -{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ; - -HELP: byte-array>memory -{ $values { "byte-array" byte-array } { "base" c-ptr } } -{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." } -{ $warning "This word is unsafe. Improper use can corrupt memory." } ; - -HELP: malloc-array -{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } } -{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link } "." } -{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } -{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ; - -HELP: malloc-object -{ $values { "type" "a C type" } { "alien" alien } } -{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." } -{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ; - -HELP: malloc-byte-array -{ $values { "byte-array" byte-array } { "alien" alien } } -{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." } -{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if memory allocation fails." } ; - -{ malloc-array } related-words - HELP: box-parameter { $values { "n" integer } { "ctype" string } } { $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." } @@ -116,48 +73,6 @@ HELP: define-out { $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." } { $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ; -{ string>alien alien>string malloc-string } related-words - -HELP: malloc-string -{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } } -{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." } -{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if one of the following conditions occurs:" - { $list - "the string contains null code points" - "the string contains characters not representable using the encoding specified" - "memory allocation fails" - } -} ; - -HELP: require-c-array -{ $values { "c-type" "a C type" } } -{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link } " or " { $link } " vocabularies." } -{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ; - -HELP: -{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } } -{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." } -{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ; - -ARTICLE: "c-strings" "C strings" -"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors." -$nl -"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function." -$nl -"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown." -$nl -"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array." -$nl -"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:" -{ $subsection string>alien } -{ $subsection malloc-string } -"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches." -$nl -"A word to read strings from arbitrary addresses:" -{ $subsection alien>string } -"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ; - ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector" "The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data." $nl @@ -234,61 +149,3 @@ $nl "Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation." $nl "Structure and union types are specified by the name of the structure or union." ; - -ARTICLE: "c-byte-arrays" "Passing data in byte arrays" -"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array." -$nl -"Byte arrays can be allocated directly with a byte count using the " { $link } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:" -{ $subsection } -{ $subsection } -{ $warning -"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." } -{ $see-also "c-arrays" } ; - -ARTICLE: "malloc" "Manual memory management" -"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case." -$nl -"Allocating a C datum with a fixed address:" -{ $subsection malloc-object } -{ $subsection malloc-array } -{ $subsection malloc-byte-array } -"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:" -{ $subsection malloc } -{ $subsection calloc } -{ $subsection realloc } -"You must always free pointers returned by any of the above words when the block of memory is no longer in use:" -{ $subsection free } -"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":" -{ $subsection &free } -{ $subsection |free } -"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "." -$nl -"You can unsafely copy a range of bytes from one memory location to another:" -{ $subsection memcpy } -"You can copy a range of bytes from memory into a byte array:" -{ $subsection memory>byte-array } -"You can copy a byte array to memory unsafely:" -{ $subsection byte-array>memory } ; - -ARTICLE: "c-data" "Passing data between Factor and C" -"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers." -$nl -"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "." -{ $subsection "c-types-specs" } -{ $subsection "c-byte-arrays" } -{ $subsection "malloc" } -{ $subsection "c-strings" } -{ $subsection "c-arrays" } -{ $subsection "c-out-params" } -"Important guidelines for passing data in byte arrays:" -{ $subsection "byte-arrays-gc" } -"C-style enumerated types are supported:" -{ $subsection POSTPONE: C-ENUM: } -"C types can be aliased for convenience and consitency with native library documentation:" -{ $subsection POSTPONE: TYPEDEF: } -"New C types can be defined:" -{ $subsection "c-structs" } -{ $subsection "c-unions" } -"A utility for defining " { $link "destructors" } " for deallocating memory:" -{ $subsection "alien.destructors" } -{ $see-also "aliens" } ; diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 6d63987265..fa27e29c04 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays arrays assocs kernel kernel.private libc math +USING: byte-arrays arrays assocs kernel kernel.private math namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary @@ -22,8 +22,6 @@ SYMBOLS: DEFER: DEFER: *char -: little-endian? ( -- ? ) 1 *char 1 = ; foldable - TUPLE: abstract-c-type { class class initial: object } { boxed-class class initial: object } @@ -104,43 +102,6 @@ M: c-type-name c-struct? ! These words being foldable means that words need to be ! recompiled if a C type is redefined. Even so, folding the ! size facilitates some optimizations. -GENERIC: heap-size ( type -- size ) foldable - -M: c-type-name heap-size c-type heap-size ; - -M: abstract-c-type heap-size size>> ; - -GENERIC: require-c-array ( c-type -- ) - -M: array require-c-array first require-c-array ; - -GENERIC: c-array-constructor ( c-type -- word ) - -GENERIC: c-(array)-constructor ( c-type -- word ) - -GENERIC: c-direct-array-constructor ( c-type -- word ) - -GENERIC: ( len c-type -- array ) - -M: c-type-name - c-array-constructor execute( len -- array ) ; inline - -GENERIC: (c-array) ( len c-type -- array ) - -M: c-type-name (c-array) - c-(array)-constructor execute( len -- array ) ; inline - -GENERIC: ( alien len c-type -- array ) - -M: c-type-name - c-direct-array-constructor execute( alien len -- array ) ; inline - -: malloc-array ( n type -- alien ) - [ heap-size calloc ] [ ] 2bi ; inline - -: (malloc-array) ( n type -- alien ) - [ heap-size * malloc ] [ ] 2bi ; inline - GENERIC: c-type-class ( name -- class ) M: abstract-c-type c-type-class class>> ; @@ -239,29 +200,28 @@ M: c-type unbox-return f swap c-type-unbox ; M: c-type-name unbox-return c-type unbox-return ; +: little-endian? ( -- ? ) 1 *char 1 = ; foldable + +GENERIC: heap-size ( type -- size ) foldable + +M: c-type-name heap-size c-type heap-size ; + +M: abstract-c-type heap-size size>> ; + GENERIC: stack-size ( type -- size ) foldable M: c-type-name stack-size c-type stack-size ; M: c-type stack-size size>> cell align ; -MIXIN: value-type - -M: value-type c-type-rep drop int-rep ; - -M: value-type c-type-getter - drop [ swap ] ; - -M: value-type c-type-setter ( type -- quot ) - [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri - '[ @ swap @ _ memcpy ] ; - GENERIC: byte-length ( seq -- n ) flushable M: byte-array byte-length length ; inline M: f byte-length drop 0 ; inline +MIXIN: value-type + : c-getter ( name -- quot ) c-type-getter [ [ "Cannot read struct fields with this type" throw ] @@ -275,36 +235,6 @@ M: f byte-length drop 0 ; inline [ "Cannot write struct fields with this type" throw ] ] unless* ; -: ( type -- array ) - heap-size ; inline - -: (c-object) ( type -- array ) - heap-size (byte-array) ; inline - -: malloc-object ( type -- alien ) - 1 swap heap-size calloc ; inline - -: (malloc-object) ( type -- alien ) - heap-size malloc ; inline - -: malloc-byte-array ( byte-array -- alien ) - dup byte-length [ nip malloc dup ] 2keep memcpy ; - -: memory>byte-array ( alien len -- byte-array ) - [ nip (byte-array) dup ] 2keep memcpy ; - -: malloc-string ( string encoding -- alien ) - string>alien malloc-byte-array ; - -M: memory-stream stream-read - [ - [ index>> ] [ alien>> ] bi - swap memory>byte-array - ] [ [ + ] change-index drop ] 2bi ; - -: byte-array>memory ( byte-array base -- ) - swap dup byte-length memcpy ; inline - : array-accessor ( type quot -- def ) [ \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi* @@ -352,22 +282,15 @@ M: long-long-type box-return ( type -- ) : define-out ( name -- ) [ "alien.c-types" constructor-word ] - [ dup c-setter '[ _ [ 0 @ ] keep ] ] bi + [ dup c-setter '[ _ heap-size [ 0 @ ] keep ] ] bi (( value -- c-ptr )) define-inline ; -: >c-bool ( ? -- int ) 1 0 ? ; inline - -: c-bool> ( int -- ? ) 0 = not ; inline - : define-primitive-type ( type name -- ) [ typedef ] [ name>> define-deref ] [ name>> define-out ] tri ; -: malloc-file-contents ( path -- alien len ) - binary file-contents [ malloc-byte-array ] [ length ] bi ; - : if-void ( type true false -- ) pick void? [ drop nip call ] [ nip call ] if ; inline @@ -510,8 +433,8 @@ SYMBOLS: \ uchar define-primitive-type - [ alien-unsigned-1 c-bool> ] >>getter - [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter + [ alien-unsigned-1 0 = not ] >>getter + [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter 1 >>size 1 >>align "box_boolean" >>boxer diff --git a/basis/alien/data/authors.txt b/basis/alien/data/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/alien/data/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor new file mode 100644 index 0000000000..19bfaaa8ce --- /dev/null +++ b/basis/alien/data/data-docs.factor @@ -0,0 +1,148 @@ +USING: alien alien.c-types help.syntax help.markup libc kernel.private +byte-arrays math strings hashtables alien.syntax alien.strings sequences +io.encodings.string debugger destructors vocabs.loader ; +IN: alien.data + +HELP: +{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } } +{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." } +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } +{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ; + +HELP: +{ $values { "type" "a C type" } { "array" byte-array } } +{ $description "Creates a byte array suitable for holding a value with the given C type." } +{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ; + +{ malloc-object } related-words + +HELP: memory>byte-array +{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } } +{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ; + +HELP: byte-array>memory +{ $values { "byte-array" byte-array } { "base" c-ptr } } +{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." } +{ $warning "This word is unsafe. Improper use can corrupt memory." } ; + +HELP: malloc-array +{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } } +{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link } "." } +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } +{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } +{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ; + +HELP: malloc-object +{ $values { "type" "a C type" } { "alien" alien } } +{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." } +{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } +{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ; + +HELP: malloc-byte-array +{ $values { "byte-array" byte-array } { "alien" alien } } +{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." } +{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } +{ $errors "Throws an error if memory allocation fails." } ; + +{ malloc-array } related-words + +{ string>alien alien>string malloc-string } related-words + +ARTICLE: "malloc" "Manual memory management" +"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case." +$nl +"Allocating a C datum with a fixed address:" +{ $subsection malloc-object } +{ $subsection malloc-array } +{ $subsection malloc-byte-array } +"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:" +{ $subsection malloc } +{ $subsection calloc } +{ $subsection realloc } +"You must always free pointers returned by any of the above words when the block of memory is no longer in use:" +{ $subsection free } +"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":" +{ $subsection &free } +{ $subsection |free } +"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "." +$nl +"You can unsafely copy a range of bytes from one memory location to another:" +{ $subsection memcpy } +"You can copy a range of bytes from memory into a byte array:" +{ $subsection memory>byte-array } +"You can copy a byte array to memory unsafely:" +{ $subsection byte-array>memory } ; + + +ARTICLE: "c-byte-arrays" "Passing data in byte arrays" +"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array." +$nl +"Byte arrays can be allocated directly with a byte count using the " { $link } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:" +{ $subsection } +{ $subsection } +{ $warning +"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." } +{ $see-also "c-arrays" } ; + +ARTICLE: "c-data" "Passing data between Factor and C" +"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers." +$nl +"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "." +{ $subsection "c-types-specs" } +{ $subsection "c-byte-arrays" } +{ $subsection "malloc" } +{ $subsection "c-strings" } +{ $subsection "c-arrays" } +{ $subsection "c-out-params" } +"Important guidelines for passing data in byte arrays:" +{ $subsection "byte-arrays-gc" } +"C-style enumerated types are supported:" +{ $subsection POSTPONE: C-ENUM: } +"C types can be aliased for convenience and consitency with native library documentation:" +{ $subsection POSTPONE: TYPEDEF: } +"New C types can be defined:" +{ $subsection "c-structs" } +{ $subsection "c-unions" } +"A utility for defining " { $link "destructors" } " for deallocating memory:" +{ $subsection "alien.destructors" } +{ $see-also "aliens" } ; +HELP: malloc-string +{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } } +{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." } +{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } +{ $errors "Throws an error if one of the following conditions occurs:" + { $list + "the string contains null code points" + "the string contains characters not representable using the encoding specified" + "memory allocation fails" + } +} ; + +HELP: require-c-array +{ $values { "c-type" "a C type" } } +{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link } " or " { $link } " vocabularies." } +{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ; + +HELP: +{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } } +{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." } +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ; + +ARTICLE: "c-strings" "C strings" +"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors." +$nl +"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function." +$nl +"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown." +$nl +"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array." +$nl +"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:" +{ $subsection string>alien } +{ $subsection malloc-string } +"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches." +$nl +"A word to read strings from arbitrary addresses:" +{ $subsection alien>string } +"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ; + diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor new file mode 100644 index 0000000000..1f2c5160e1 --- /dev/null +++ b/basis/alien/data/data.factor @@ -0,0 +1,83 @@ +! (c)2009 Slava Pestov, Joe Groff bsd license +USING: accessors alien alien.c-types alien.strings arrays +byte-arrays cpu.architecture fry io io.encodings.binary +io.files io.streams.memory kernel libc math sequences ; +IN: alien.data + +GENERIC: require-c-array ( c-type -- ) + +M: array require-c-array first require-c-array ; + +GENERIC: c-array-constructor ( c-type -- word ) + +GENERIC: c-(array)-constructor ( c-type -- word ) + +GENERIC: c-direct-array-constructor ( c-type -- word ) + +GENERIC: ( len c-type -- array ) + +M: c-type-name + c-array-constructor execute( len -- array ) ; inline + +GENERIC: (c-array) ( len c-type -- array ) + +M: c-type-name (c-array) + c-(array)-constructor execute( len -- array ) ; inline + +GENERIC: ( alien len c-type -- array ) + +M: c-type-name + c-direct-array-constructor execute( alien len -- array ) ; inline + +: malloc-array ( n type -- alien ) + [ heap-size calloc ] [ ] 2bi ; inline + +: (malloc-array) ( n type -- alien ) + [ heap-size * malloc ] [ ] 2bi ; inline + +: ( type -- array ) + heap-size ; inline + +: (c-object) ( type -- array ) + heap-size (byte-array) ; inline + +: malloc-object ( type -- alien ) + 1 swap heap-size calloc ; inline + +: (malloc-object) ( type -- alien ) + heap-size malloc ; inline + +: malloc-byte-array ( byte-array -- alien ) + dup byte-length [ nip malloc dup ] 2keep memcpy ; + +: memory>byte-array ( alien len -- byte-array ) + [ nip (byte-array) dup ] 2keep memcpy ; + +: malloc-string ( string encoding -- alien ) + string>alien malloc-byte-array ; + +: malloc-file-contents ( path -- alien len ) + binary file-contents [ malloc-byte-array ] [ length ] bi ; + +M: memory-stream stream-read + [ + [ index>> ] [ alien>> ] bi + swap memory>byte-array + ] [ [ + ] change-index drop ] 2bi ; + +: byte-array>memory ( byte-array base -- ) + swap dup byte-length memcpy ; inline + +: >c-bool ( ? -- int ) 1 0 ? ; inline + +: c-bool> ( int -- ? ) 0 = not ; inline + +M: value-type c-type-rep drop int-rep ; + +M: value-type c-type-getter + drop [ swap ] ; + +M: value-type c-type-setter ( type -- quot ) + [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri + '[ @ swap @ _ memcpy ] ; + diff --git a/basis/alien/data/summary.txt b/basis/alien/data/summary.txt new file mode 100644 index 0000000000..addddb2da4 --- /dev/null +++ b/basis/alien/data/summary.txt @@ -0,0 +1 @@ +Words for allocating objects and arrays of C types diff --git a/basis/alien/fortran/fortran-tests.factor b/basis/alien/fortran/fortran-tests.factor index 9d893b95c4..238207f192 100644 --- a/basis/alien/fortran/fortran-tests.factor +++ b/basis/alien/fortran/fortran-tests.factor @@ -1,7 +1,7 @@ ! (c) 2009 Joe Groff, see BSD license USING: accessors alien alien.c-types alien.complex -alien.fortran alien.fortran.private alien.strings classes.struct -arrays assocs byte-arrays combinators fry +alien.data alien.fortran alien.fortran.private alien.strings +classes.struct arrays assocs byte-arrays combinators fry generalizations io.encodings.ascii kernel macros macros.expander namespaces sequences shuffle tools.test ; IN: alien.fortran.tests diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 3670a376e1..bf8721b549 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -1,5 +1,5 @@ ! (c) 2009 Joe Groff, see BSD license -USING: accessors alien alien.c-types alien.complex grouping +USING: accessors alien alien.c-types alien.complex alien.data grouping alien.strings alien.syntax arrays ascii assocs byte-arrays combinators combinators.short-circuit fry generalizations kernel lexer macros math math.parser namespaces parser sequences diff --git a/basis/alien/remote-control/remote-control.factor b/basis/alien/remote-control/remote-control.factor index b72c79e478..4ccd0e7488 100644 --- a/basis/alien/remote-control/remote-control.factor +++ b/basis/alien/remote-control/remote-control.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings parser +USING: accessors alien alien.data alien.strings parser threads words kernel.private kernel io.encodings.utf8 eval ; IN: alien.remote-control diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor index 62a3817fec..d0485ae4ba 100644 --- a/basis/alien/structs/structs-docs.factor +++ b/basis/alien/structs/structs-docs.factor @@ -1,4 +1,4 @@ -USING: alien.c-types strings help.markup help.syntax alien.syntax +USING: alien.c-types alien.data strings help.markup help.syntax alien.syntax sequences io arrays kernel words assocs namespaces ; IN: alien.structs diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor index 3f84377d5c..d22aa5ee45 100755 --- a/basis/alien/structs/structs-tests.factor +++ b/basis/alien/structs/structs-tests.factor @@ -1,4 +1,4 @@ -USING: alien alien.syntax alien.c-types kernel tools.test +USING: alien alien.syntax alien.c-types alien.data kernel tools.test sequences system libc words vocabs namespaces layouts ; IN: alien.structs.tests diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 0f87cf4cb6..f5613da6b5 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types accessors math alien.accessors kernel +USING: alien.c-types alien.data accessors math alien.accessors kernel kernel.private sequences sequences.private byte-arrays parser prettyprint.custom fry ; IN: bit-arrays diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor index 6f21d96e86..673500b62a 100644 --- a/basis/checksums/openssl/openssl.factor +++ b/basis/checksums/openssl/openssl.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors byte-arrays alien.c-types kernel continuations -destructors sequences io openssl openssl.libcrypto checksums -checksums.stream ; +USING: accessors byte-arrays alien.c-types alien.data kernel +continuations destructors sequences io openssl openssl.libcrypto +checksums checksums.stream ; IN: checksums.openssl ERROR: unknown-digest name ; diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor index 7f57e8568a..43d24e5716 100644 --- a/basis/classes/struct/prettyprint/prettyprint.factor +++ b/basis/classes/struct/prettyprint/prettyprint.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types alien.prettyprint arrays +USING: accessors alien alien.c-types alien.data alien.prettyprint arrays assocs classes classes.struct combinators combinators.short-circuit continuations fry kernel libc make math math.parser mirrors prettyprint.backend prettyprint.custom prettyprint.sections diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index e9e45487f9..b60bfa375b 100755 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types ascii +USING: accessors alien alien.c-types alien.data ascii assocs byte-arrays classes.struct classes.tuple.private combinators compiler.tree.debugger compiler.units destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index dabdead10c..7e99328652 100755 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types alien.parser arrays +USING: accessors alien alien.c-types alien.data alien.parser arrays byte-arrays classes classes.parser classes.tuple classes.tuple.parser classes.tuple.private combinators combinators.short-circuit combinators.smart cpu.architecture definitions functors.backend diff --git a/basis/cocoa/enumeration/enumeration.factor b/basis/cocoa/enumeration/enumeration.factor index caa83331ab..c7bdf625d9 100755 --- a/basis/cocoa/enumeration/enumeration.factor +++ b/basis/cocoa/enumeration/enumeration.factor @@ -1,17 +1,16 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types -locals math sequences vectors fry libc destructors ; +USING: accessors kernel classes.struct cocoa cocoa.runtime cocoa.types alien.data +locals math sequences vectors fry libc destructors specialized-arrays ; +SPECIALIZED-ARRAY: id IN: cocoa.enumeration -<< "id" require-c-array >> - CONSTANT: NS-EACH-BUFFER-SIZE 16 : with-enumeration-buffers ( quot -- ) '[ NSFastEnumerationState malloc-struct &free - NS-EACH-BUFFER-SIZE "id" malloc-array &free + NS-EACH-BUFFER-SIZE id malloc-array &free NS-EACH-BUFFER-SIZE @ ] with-destructors ; inline @@ -19,7 +18,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16 :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- ) object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count items-count 0 = [ - state itemsPtr>> [ items-count "id" ] [ stackbuf ] if* :> items + state itemsPtr>> [ items-count id ] [ stackbuf ] if* :> items items-count iota [ items nth quot call ] each object quot state stackbuf count (NSFastEnumeration-each) ] unless ; inline recursive diff --git a/basis/cocoa/plists/plists.factor b/basis/cocoa/plists/plists.factor index ceb097bb3a..86b13b2ddc 100644 --- a/basis/cocoa/plists/plists.factor +++ b/basis/cocoa/plists/plists.factor @@ -4,8 +4,8 @@ USING: strings arrays hashtables assocs sequences fry macros cocoa.messages cocoa.classes cocoa.application cocoa kernel namespaces io.backend math cocoa.enumeration byte-arrays -combinators alien.c-types words core-foundation quotations -core-foundation.data core-foundation.utilities ; +combinators alien.c-types alien.data words core-foundation +quotations core-foundation.data core-foundation.utilities ; IN: cocoa.plists : >plist ( value -- plist ) >cf -> autorelease ; diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index dc2f5d9257..24114e0ccb 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -3,7 +3,7 @@ math math.constants math.private math.integers.private sequences strings tools.test words continuations sequences.private hashtables.private byte-arrays system random layouts vectors sbufs strings.private slots.private alien math.order -alien.accessors alien.c-types alien.syntax alien.strings +alien.accessors alien.c-types alien.data alien.syntax alien.strings namespaces libc io.encodings.ascii classes compiler ; FROM: math => float ; IN: compiler.tests.intrinsics diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 063f3b37b1..72ad543307 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs sequences kernel combinators make math math.order math.ranges system namespaces locals layouts words -alien alien.accessors alien.c-types literals cpu.architecture +alien alien.accessors alien.c-types alien.data literals cpu.architecture cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers compiler.cfg.instructions compiler.cfg.comparisons compiler.codegen.fixup compiler.cfg.intrinsics diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 2278afe4ed..5398e669ed 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -2,11 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays continuations db io kernel math namespaces quotations sequences db.postgresql.ffi alien alien.c-types -db.types tools.walker ascii splitting math.parser combinators -libc calendar.format byte-arrays destructors prettyprint -accessors strings serialize io.encodings.binary io.encodings.utf8 -alien.strings io.streams.byte-array summary present urls -specialized-arrays db.private ; +alien.data db.types tools.walker ascii splitting math.parser +combinators libc calendar.format byte-arrays destructors +prettyprint accessors strings serialize io.encodings.binary +io.encodings.utf8 alien.strings io.streams.byte-array summary +present urls specialized-arrays db.private ; SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: void* IN: db.postgresql.lib diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 3565b09856..163026f5ff 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types arrays assocs kernel math math.parser +USING: alien.c-types alien.data arrays assocs kernel math math.parser namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor index 84dfbbd43e..3fc8c2f79b 100644 --- a/basis/environment/unix/unix.factor +++ b/basis/environment/unix/unix.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings alien.syntax kernel -layouts sequences system unix environment io.encodings.utf8 -unix.utilities vocabs.loader combinators alien.accessors ; +USING: alien alien.c-types alien.data alien.strings +alien.syntax kernel layouts sequences system unix +environment io.encodings.utf8 unix.utilities vocabs.loader +combinators alien.accessors ; IN: environment.unix HOOK: environ os ( -- void* ) diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor index 518a7d5d7a..cba92a0e3c 100755 --- a/basis/environment/winnt/winnt.factor +++ b/basis/environment/winnt/winnt.factor @@ -1,15 +1,14 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.strings fry io.encodings.utf16n kernel -splitting windows windows.kernel32 system environment -alien.c-types sequences windows.errors io.streams.memory -io.encodings io ; +splitting windows windows.kernel32 windows.types system +environment alien.data sequences windows.errors +io.streams.memory io.encodings io ; +SPECIALIZED-ARRAY: TCHAR IN: environment.winnt -<< "TCHAR" require-c-array >> - M: winnt os-env ( key -- value ) - MAX_UNICODE_PATH "TCHAR" + MAX_UNICODE_PATH TCHAR [ dup length GetEnvironmentVariable ] keep over 0 = [ 2drop f ] [ diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor index a7489f26a2..16bea60ea5 100755 --- a/basis/game-input/dinput/dinput.factor +++ b/basis/game-input/dinput/dinput.factor @@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle specialized-arrays ui.backend.windows vectors windows.com windows.dinput windows.dinput.constants windows.errors windows.kernel32 windows.messages windows.ole32 -windows.user32 classes.struct ; +windows.user32 classes.struct alien.data ; SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA IN: game-input.dinput diff --git a/basis/game-input/dinput/keys-array/keys-array.factor b/basis/game-input/dinput/keys-array/keys-array.factor index 9a84747dd8..a8813b0397 100755 --- a/basis/game-input/dinput/keys-array/keys-array.factor +++ b/basis/game-input/dinput/keys-array/keys-array.factor @@ -1,5 +1,5 @@ -USING: sequences sequences.private math alien.c-types -accessors ; +USING: sequences sequences.private math +accessors alien.data ; IN: game-input.dinput.keys-array TUPLE: keys-array diff --git a/basis/game-input/iokit/iokit.factor b/basis/game-input/iokit/iokit.factor index 71d547ad29..85f058f283 100755 --- a/basis/game-input/iokit/iokit.factor +++ b/basis/game-input/iokit/iokit.factor @@ -3,7 +3,8 @@ kernel cocoa.enumeration destructors math.parser cocoa.application sequences locals combinators.short-circuit threads namespaces assocs arrays combinators hints alien core-foundation.run-loop accessors sequences.private -alien.c-types math parser game-input vectors bit-arrays ; +alien.c-types alien.data math parser game-input vectors +bit-arrays ; IN: game-input.iokit SINGLETON: iokit-game-input-backend diff --git a/basis/images/memory/memory.factor b/basis/images/memory/memory.factor index 1a977b604e..ccf891d770 100644 --- a/basis/images/memory/memory.factor +++ b/basis/images/memory/memory.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types destructors fry images kernel -libc math sequences ; +USING: accessors alien.c-types alien.data destructors fry images +kernel libc math sequences ; IN: images.memory ! Some code shared by core-graphics and cairo for constructing @@ -27,4 +27,4 @@ PRIVATE> : make-memory-bitmap ( dim quot -- image ) '[ [ malloc-bitmap-data ] keep _ [ ] 2bi - ] with-destructors ; inline \ No newline at end of file + ] with-destructors ; inline diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor index 57878ba75b..bb9e0edc33 100755 --- a/basis/io/backend/windows/nt/privileges/privileges.factor +++ b/basis/io/backend/windows/nt/privileges/privileges.factor @@ -1,4 +1,4 @@ -USING: alien alien.c-types alien.syntax arrays continuations +USING: alien alien.c-types alien.data alien.syntax arrays continuations destructors generic io.mmap io.ports io.backend.windows io.files.windows kernel libc math math.bitwise namespaces quotations sequences windows windows.advapi32 windows.kernel32 io.backend system accessors diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor index 4425e08106..d366df7c54 100644 --- a/basis/io/buffers/buffers-tests.factor +++ b/basis/io/buffers/buffers-tests.factor @@ -1,7 +1,7 @@ IN: io.buffers.tests -USING: alien alien.c-types io.buffers kernel kernel.private libc -sequences tools.test namespaces byte-arrays strings accessors -destructors ; +USING: alien alien.c-types alien.data io.buffers kernel +kernel.private libc sequences tools.test namespaces byte-arrays +strings accessors destructors ; : buffer-set ( string buffer -- ) over >byte-array over ptr>> byte-array>memory diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index 82c5326b1d..aa9cedf340 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -2,8 +2,8 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.accessors alien.c-types -alien.syntax kernel libc math sequences byte-arrays strings -hints math.order destructors combinators ; +alien.data alien.syntax kernel libc math sequences byte-arrays +strings hints math.order destructors combinators ; IN: io.buffers TUPLE: buffer diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index bb3a412669..5ae21fcfee 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -6,7 +6,7 @@ windows.time windows accessors alien.c-types combinators generalizations system alien.strings io.encodings.utf16n sequences splitting windows.errors fry continuations destructors calendar ascii combinators.short-circuit locals classes.struct -specialized-arrays ; +specialized-arrays alien.data ; SPECIALIZED-ARRAY: ushort IN: io.files.info.windows diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 43463bd3f1..ca5c9b3c4a 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -6,7 +6,7 @@ io.backend.windows kernel math splitting fry alien.strings windows windows.kernel32 windows.time calendar combinators math.functions sequences namespaces make words system destructors accessors math.bitwise continuations windows.errors -arrays byte-arrays generalizations ; +arrays byte-arrays generalizations alien.data ; IN: io.files.windows : open-file ( path access-mode create-mode flags -- handle ) diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor index 704a585dd4..a866232760 100644 --- a/basis/io/mmap/mmap.factor +++ b/basis/io/mmap/mmap.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors io.files io.files.info io.backend kernel quotations system alien alien.accessors -accessors vocabs.loader combinators alien.c-types +accessors vocabs.loader combinators alien.c-types alien.data math ; IN: io.mmap diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/nt/nt.factor index 3d837d79d8..9cd8bc4df8 100755 --- a/basis/io/monitors/windows/nt/nt.factor +++ b/basis/io/monitors/windows/nt/nt.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings libc destructors locals -kernel math assocs namespaces make continuations sequences +USING: alien alien.c-types alien.data alien.strings libc destructors +locals kernel math assocs namespaces make continuations sequences hashtables sorting arrays combinators math.bitwise strings system accessors threads splitting io.backend io.backend.windows io.backend.windows.nt io.files.windows.nt io.monitors io.ports diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index 8f596da0bd..6d01a66cf0 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/basis/io/sockets/secure/openssl/openssl.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! See http://factorcode.org/license.txt for BSD license. USING: accessors byte-arrays kernel sequences namespaces math -math.order combinators init alien alien.c-types alien.strings -libc continuations destructors summary splitting assocs random -math.parser locals unicode.case openssl openssl.libcrypto -openssl.libssl io.backend io.ports io.pathnames +math.order combinators init alien alien.c-types alien.data +alien.strings libc continuations destructors summary splitting +assocs random math.parser locals unicode.case openssl +openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames io.encodings.8-bit io.timeouts io.sockets.secure ; IN: io.sockets.secure.openssl diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 601d269d5c..a542575446 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -6,7 +6,7 @@ arrays io.encodings io.ports io.streams.duplex io.encodings.ascii alien.strings io.binary accessors destructors classes byte-arrays parser alien.c-types math.parser splitting grouping math assocs summary system vocabs.loader combinators present fry vocabs.parser -classes.struct ; +classes.struct alien.data ; IN: io.sockets << { diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index e892c6a7ef..fa46a71ca0 100755 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix io.streams.duplex io.backend io.pathnames io.sockets.private io.files.private io.encodings.utf8 math.parser continuations libc combinators system accessors destructors unix locals init -classes.struct ; +classes.struct alien.data ; EXCLUDE: namespaces => bind ; EXCLUDE: io => read write ; diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor index f423a42b65..7cc21c9611 100755 --- a/basis/io/sockets/windows/nt/nt.factor +++ b/basis/io/sockets/windows/nt/nt.factor @@ -1,4 +1,4 @@ -USING: alien alien.accessors alien.c-types byte-arrays +USING: alien alien.accessors alien.c-types alien.data byte-arrays continuations destructors io.ports io.timeouts io.sockets io.sockets.private io namespaces io.streams.duplex io.backend.windows io.sockets.windows io.backend.windows.nt diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index 4142e40c68..fe56c83516 100644 --- a/basis/libc/libc.factor +++ b/basis/libc/libc.factor @@ -2,29 +2,29 @@ ! Copyright (C) 2007, 2009 Slava Pestov ! Copyright (C) 2007, 2008 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. -USING: alien assocs continuations alien.destructors kernel +USING: alien alien.c-types assocs continuations alien.destructors kernel namespaces accessors sets summary destructors destructors.private ; IN: libc : errno ( -- int ) - "int" "factor" "err_no" { } alien-invoke ; + int "factor" "err_no" { } alien-invoke ; : clear-errno ( -- ) - "void" "factor" "clear_err_no" { } alien-invoke ; + void "factor" "clear_err_no" { } alien-invoke ; >c-ptr [ delete-malloc ] [ (free) ] bi ; : memcpy ( dst src size -- ) - "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ; + void "libc" "memcpy" { void* void* ulong } alien-invoke ; : memcmp ( a b size -- cmp ) - "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ; + int "libc" "memcmp" { void* void* ulong } alien-invoke ; : memory= ( a b size -- ? ) memcmp 0 = ; : strlen ( alien -- len ) - "size_t" "libc" "strlen" { "char*" } alien-invoke ; + size_t "libc" "strlen" { char* } alien-invoke ; DESTRUCTOR: free diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor index 4212f32b2d..aa9681bb2e 100755 --- a/basis/math/blas/matrices/matrices.factor +++ b/basis/math/blas/matrices/matrices.factor @@ -1,10 +1,10 @@ -USING: accessors alien alien.c-types arrays byte-arrays combinators -combinators.short-circuit fry kernel locals macros -math math.blas.ffi math.blas.vectors math.blas.vectors.private -math.complex math.functions math.order functors words -sequences sequences.merged sequences.private shuffle -parser prettyprint.backend prettyprint.custom ascii -specialized-arrays ; +USING: accessors alien alien.c-types alien.data arrays +byte-arrays combinators combinators.short-circuit fry +kernel locals macros math math.blas.ffi math.blas.vectors +math.blas.vectors.private math.complex math.functions +math.order functors words sequences sequences.merged +sequences.private shuffle parser prettyprint.backend +prettyprint.custom ascii specialized-arrays ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: double diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 28547f8cf9..914d1ef169 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien alien.c-types cpu.architecture libc ; +USING: kernel alien alien.data cpu.architecture libc ; IN: math.vectors.simd.intrinsics ERROR: bad-simd-call ; diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 26ffd0cf88..562cbc91ce 100755 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: kernel opengl.gl alien.c-types continuations namespaces -assocs alien alien.strings libc opengl math sequences combinators +assocs alien alien.data alien.strings libc opengl math sequences combinators macros arrays io.encodings.ascii fry specialized-arrays destructors accessors ; SPECIALIZED-ARRAY: uint diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 83b1fab0d0..d959b191c9 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -1,4 +1,4 @@ -USING: accessors alien.c-types byte-arrays +USING: accessors alien.c-types alien.data byte-arrays combinators.short-circuit continuations destructors init kernel locals namespaces random windows.advapi32 windows.errors windows.kernel32 math.bitwise ; diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index e289efb077..5d88f42d50 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -4,7 +4,7 @@ specialized-arrays.private sequences alien.c-types 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 ; +assocs prettyprint alien.data ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: int diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 0490ede304..6931c83677 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.parser assocs +USING: accessors alien alien.c-types alien.data alien.parser assocs byte-arrays classes compiler.units functors kernel lexer libc math math.vectors.specialization namespaces parser prettyprint.custom sequences sequences.private strings summary vocabs vocabs.loader diff --git a/basis/tools/deploy/config/config-docs.factor b/basis/tools/deploy/config/config-docs.factor index bd612c644a..12016168fb 100644 --- a/basis/tools/deploy/config/config-docs.factor +++ b/basis/tools/deploy/config/config-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax words alien.c-types assocs +USING: help.markup help.syntax words alien.c-types alien.data assocs kernel math ; IN: tools.deploy.config diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor index 0a8ab0b116..16408c0eb8 100755 --- a/basis/tools/disassembler/disassembler.factor +++ b/basis/tools/disassembler/disassembler.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays byte-arrays combinators destructors generic io kernel libc math sequences system tr -vocabs.loader words ; +vocabs.loader words alien.data ; IN: tools.disassembler GENERIC: disassemble ( obj -- ) diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index 2f0456ab62..aaa54ae527 100755 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -4,7 +4,7 @@ USING: tools.disassembler namespaces combinators alien alien.syntax alien.c-types lexer parser kernel sequences layouts math math.order alien.libraries math.parser system make fry arrays libc destructors -tools.disassembler.utils splitting ; +tools.disassembler.utils splitting alien.data ; IN: tools.disassembler.udis << diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 6ae56af030..a49d22735d 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings arrays assocs -cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes -cocoa.views cocoa.application cocoa.pasteboard cocoa.types -cocoa.windows sequences io.encodings.utf8 ui ui.private ui.gadgets -ui.gadgets.private ui.gadgets.worlds ui.gestures +USING: accessors alien alien.c-types alien.data alien.strings +arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing +cocoa.classes cocoa.views cocoa.application cocoa.pasteboard +cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private +ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures core-foundation.strings core-graphics core-graphics.types threads combinators math.rectangles ; IN: ui.backend.cocoa.views diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 2be6e70df8..5e2c25ea30 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -13,7 +13,7 @@ opengl ui.render math.bitwise locals accessors math.rectangles math.order calendar ascii sets io.encodings.utf16n windows.errors literals ui.pixel-formats ui.pixel-formats.private memoize classes -specialized-arrays classes.struct ; +specialized-arrays classes.struct alien.data ; SPECIALIZED-ARRAY: POINT IN: ui.backend.windows diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index 131d8dda5d..2912f8b744 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -1,6 +1,6 @@ -USING: kernel alien.c-types alien.strings sequences math alien.syntax -unix namespaces continuations threads assocs io.backend.unix -io.encodings.utf8 unix.utilities fry ; +USING: kernel alien.c-types alien.data alien.strings sequences +math alien.syntax unix namespaces continuations threads assocs +io.backend.unix io.encodings.utf8 unix.utilities fry ; IN: unix.process ! Low-level Unix process launching utilities. These are used diff --git a/basis/unix/utilities/utilities.factor b/basis/unix/utilities/utilities.factor index 8d141ccb24..919b2ae8a2 100644 --- a/basis/unix/utilities/utilities.factor +++ b/basis/unix/utilities/utilities.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings +USING: alien alien.c-types alien.data alien.strings combinators.short-circuit fry kernel layouts sequences accessors specialized-arrays ; IN: unix.utilities diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor index 6e72f7d114..f6ccf6858b 100644 --- a/basis/unix/utmpx/utmpx.factor +++ b/basis/unix/utmpx/utmpx.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax combinators continuations -io.encodings.string io.encodings.utf8 kernel sequences strings -unix calendar system accessors unix.time calendar.unix -vocabs.loader ; +USING: alien.c-types alien.data alien.syntax combinators +continuations io.encodings.string io.encodings.utf8 kernel +sequences strings unix calendar system accessors unix.time +calendar.unix vocabs.loader ; IN: unix.utmpx CONSTANT: EMPTY 0 diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor index d485692a91..e06f5b6071 100644 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -1,6 +1,6 @@ USING: alien alien.c-types alien.destructors windows.com.syntax windows.ole32 windows.types continuations kernel alien.syntax -libc destructors accessors ; +libc destructors accessors alien.data ; IN: windows.com LIBRARY: ole32 diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index e69fc5b820..e4f0ef0654 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -1,9 +1,9 @@ -USING: alien alien.c-types alien.accessors windows.com.syntax -init windows.com.syntax.private windows.com continuations kernel -namespaces windows.ole32 libc vocabs assocs accessors arrays -sequences quotations combinators math words compiler.units -destructors fry math.parser generalizations sets -specialized-arrays windows.kernel32 classes.struct ; +USING: alien alien.c-types alien.data alien.accessors +windows.com.syntax init windows.com.syntax.private windows.com +continuations kernel namespaces windows.ole32 libc vocabs +assocs accessors arrays sequences quotations combinators math +words compiler.units destructors fry math.parser generalizations +sets specialized-arrays windows.kernel32 classes.struct ; SPECIALIZED-ARRAY: void* IN: windows.com.wrapper diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index 270c2fa3dd..3c0509c49d 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -1,8 +1,9 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com -windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces -combinators sequences fry math accessors macros words quotations -libc continuations generalizations splitting locals assocs init -specialized-arrays memoize classes.struct strings arrays ; +windows.com.syntax alien alien.c-types alien.data alien.syntax +kernel system namespaces combinators sequences fry math accessors +macros words quotations libc continuations generalizations +splitting locals assocs init specialized-arrays memoize +classes.struct strings arrays ; SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT IN: windows.dinput.constants diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index bd6512341f..bb8e60cdf5 100755 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -1,17 +1,16 @@ USING: alien.strings io.encodings.utf16n windows.com windows.com.wrapper combinators windows.kernel32 windows.ole32 -windows.shell32 kernel accessors +windows.shell32 kernel accessors windows.types prettyprint namespaces ui.tools.listener ui.tools.workspace -alien.c-types alien sequences math ; +alien.data alien sequences math ; +SPECIALIZED-ARRAY: WCHAR IN: windows.dragdrop-listener -<< "WCHAR" require-c-array >> - : filenames-from-hdrop ( hdrop -- filenames ) dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files [ 2dup f 0 DragQueryFile 1 + ! get size of filename buffer - dup "WCHAR" + dup WCHAR [ swap DragQueryFile drop ] keep utf16n alien>string ] with map ; diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index d2ee337726..483494ba0c 100755 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -1,11 +1,10 @@ -USING: alien.c-types kernel locals math math.bitwise +USING: alien.data kernel locals math math.bitwise windows.kernel32 sequences byte-arrays unicode.categories io.encodings.string io.encodings.utf16n alien.strings -arrays literals ; +arrays literals windows.types ; +SPECIALIZED-ARRAY: TCHAR IN: windows.errors -<< "TCHAR" require-c-array >> - CONSTANT: ERROR_SUCCESS 0 CONSTANT: ERROR_INVALID_FUNCTION 1 CONSTANT: ERROR_FILE_NOT_FOUND 2 @@ -698,8 +697,6 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF : make-lang-id ( lang1 lang2 -- n ) 10 shift bitor ; inline -<< "TCHAR" require-c-array >> - ERROR: error-message-failed id ; :: n>win32-error-string ( id -- string ) { @@ -709,7 +706,7 @@ ERROR: error-message-failed id ; f id LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id - 32768 [ "TCHAR" ] [ ] bi + 32768 [ TCHAR ] [ ] bi f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip utf16n alien>string [ blank? ] trim ; diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor index 63cfd92ba1..e38477c98c 100755 --- a/basis/windows/offscreen/offscreen.factor +++ b/basis/windows/offscreen/offscreen.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Joe Groff, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel combinators sequences -math windows.gdi32 windows.types images destructors -accessors fry locals classes.struct ; +USING: alien.c-types alien.data kernel combinators +sequences math windows.gdi32 windows.types images +destructors accessors fry locals classes.struct ; IN: windows.offscreen : (bitmap-info) ( dim -- BITMAPINFO ) diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 9e117c8522..fe47a7f923 100755 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -1,5 +1,5 @@ -USING: alien alien.syntax alien.c-types alien.strings math -kernel sequences windows.errors windows.types io accessors +USING: alien alien.syntax alien.c-types alien.data alien.strings +math kernel sequences windows.errors windows.types io accessors math.order namespaces make math.parser windows.kernel32 combinators locals specialized-arrays literals splitting grouping classes.struct combinators.smart ; diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index 98305e8304..0cd7704cf8 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -10,9 +10,9 @@ ! add to this library and are wondering what part of the file to ! modify, just find the function or data structure in the manual ! and note the section. -USING: accessors kernel arrays alien alien.c-types alien.strings -alien.syntax classes.struct math math.bitwise words sequences -namespaces continuations io io.encodings.ascii x11.syntax ; +USING: accessors kernel arrays alien alien.c-types alien.data +alien.strings alien.syntax classes.struct math math.bitwise words +sequences namespaces continuations io io.encodings.ascii x11.syntax ; FROM: alien.c-types => short ; IN: x11.xlib diff --git a/core/alien/strings/strings-tests.factor b/core/alien/strings/strings-tests.factor index 6a0a42253b..c1b5a9e159 100644 --- a/core/alien/strings/strings-tests.factor +++ b/core/alien/strings/strings-tests.factor @@ -1,4 +1,4 @@ -USING: alien.strings alien.c-types tools.test kernel libc +USING: alien.strings alien.c-types alien.data tools.test kernel libc io.encodings.8-bit io.encodings.utf8 io.encodings.utf16 io.encodings.utf16n io.encodings.ascii alien io.encodings.string ; IN: alien.strings.tests diff --git a/extra/alien/inline/syntax/syntax-tests.factor b/extra/alien/inline/syntax/syntax-tests.factor index e6a0b8b7d8..c49b2b5aae 100644 --- a/extra/alien/inline/syntax/syntax-tests.factor +++ b/extra/alien/inline/syntax/syntax-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Jeremy Hughes. ! See http://factorcode.org/license.txt for BSD license. USING: alien.inline alien.inline.syntax io.directories io.files -kernel namespaces tools.test alien.c-types alien.structs ; +kernel namespaces tools.test alien.c-types alien.data alien.structs ; IN: alien.inline.syntax.tests DELETE-C-LIBRARY: test diff --git a/extra/alien/marshall/marshall-docs.factor b/extra/alien/marshall/marshall-docs.factor index 361753a0d3..5d6ec29912 100644 --- a/extra/alien/marshall/marshall-docs.factor +++ b/extra/alien/marshall/marshall-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Jeremy Hughes. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel quotations sequences -strings alien alien.c-types math byte-arrays ; +strings alien alien.c-types alien.data math byte-arrays ; IN: alien.marshall float short ; diff --git a/extra/alien/marshall/private/private.factor b/extra/alien/marshall/private/private.factor index c85b722d11..d138282ff3 100644 --- a/extra/alien/marshall/private/private.factor +++ b/extra/alien/marshall/private/private.factor @@ -3,7 +3,7 @@ USING: accessors alien alien.c-types alien.inline arrays combinators fry functors kernel lexer libc macros math sequences specialized-arrays libc.private -combinators.short-circuit ; +combinators.short-circuit alien.data ; SPECIALIZED-ARRAY: void* IN: alien.marshall.private diff --git a/extra/alien/marshall/structs/structs.factor b/extra/alien/marshall/structs/structs.factor index 54bcab45f2..3f9c8e3a7e 100644 --- a/extra/alien/marshall/structs/structs.factor +++ b/extra/alien/marshall/structs/structs.factor @@ -3,7 +3,7 @@ USING: accessors alien.c-types alien.marshall arrays assocs classes.tuple combinators destructors generalizations generic kernel libc locals parser quotations sequences slots words -alien.structs lexer vocabs.parser fry effects ; +alien.structs lexer vocabs.parser fry effects alien.data ; IN: alien.marshall.structs float ; SPECIALIZED-ARRAY: int diff --git a/extra/half-floats/half-floats-tests.factor b/extra/half-floats/half-floats-tests.factor index cf3d7d3690..ad3d156bc4 100644 --- a/extra/half-floats/half-floats-tests.factor +++ b/extra/half-floats/half-floats-tests.factor @@ -1,5 +1,5 @@ USING: alien.c-types alien.syntax half-floats kernel math tools.test -specialized-arrays ; +specialized-arrays alien.data ; SPECIALIZED-ARRAY: half IN: half-floats.tests diff --git a/extra/half-floats/half-floats.factor b/extra/half-floats/half-floats.factor index 2c089e4330..4d78068c03 100755 --- a/extra/half-floats/half-floats.factor +++ b/extra/half-floats/half-floats.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien.c-types alien.syntax kernel math math.order ; +USING: accessors alien.c-types alien.data alien.syntax kernel math math.order ; IN: half-floats : half>bits ( float -- bits ) diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor index 1ba8031dfc..57c30dde15 100644 --- a/extra/io/serial/unix/unix.factor +++ b/extra/io/serial/unix/unix.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.syntax combinators io.ports -io.streams.duplex system kernel math math.bitwise -vocabs.loader unix io.serial io.serial.unix.termios io.backend.unix ; +USING: accessors alien.c-types alien.syntax alien.data +combinators io.ports io.streams.duplex system kernel +math math.bitwise vocabs.loader unix io.serial +io.serial.unix.termios io.backend.unix ; IN: io.serial.unix << { diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor index 46729c42be..a5602273d2 100644 --- a/extra/memory/piles/piles.factor +++ b/extra/memory/piles/piles.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien alien.c-types destructors kernel libc math ; +USING: accessors alien alien.c-types alien.data destructors kernel libc math ; IN: memory.piles TUPLE: pile diff --git a/extra/system-info/windows/ce/ce.factor b/extra/system-info/windows/ce/ce.factor index 13c7cb9433..8c4f81a117 100755 --- a/extra/system-info/windows/ce/ce.factor +++ b/extra/system-info/windows/ce/ce.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types system-info kernel math namespaces +USING: alien.c-types alien.data system-info kernel math namespaces windows windows.kernel32 system-info.backend system ; IN: system-info.windows.ce From b48beb48f4d74f97e566363b54d67dce017968ac Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 18 Sep 2009 10:01:38 -0500 Subject: [PATCH 30/32] fix loading problems on windows --- basis/environment/winnt/winnt.factor | 2 +- basis/windows/errors/errors.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor index cba92a0e3c..894415ace8 100755 --- a/basis/environment/winnt/winnt.factor +++ b/basis/environment/winnt/winnt.factor @@ -3,7 +3,7 @@ USING: alien.strings fry io.encodings.utf16n kernel splitting windows windows.kernel32 windows.types system environment alien.data sequences windows.errors -io.streams.memory io.encodings io ; +io.streams.memory io.encodings io specialized-arrays ; SPECIALIZED-ARRAY: TCHAR IN: environment.winnt diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 483494ba0c..a7a41433f7 100755 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -1,7 +1,7 @@ USING: alien.data kernel locals math math.bitwise windows.kernel32 sequences byte-arrays unicode.categories io.encodings.string io.encodings.utf16n alien.strings -arrays literals windows.types ; +arrays literals windows.types specialized-arrays ; SPECIALIZED-ARRAY: TCHAR IN: windows.errors From ceff1b40bec2b63dfc93c3b25e433aeda72cd344 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 18 Sep 2009 13:41:55 -0500 Subject: [PATCH 31/32] helper words for qtkit --- extra/qtkit/qtkit.factor | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/extra/qtkit/qtkit.factor b/extra/qtkit/qtkit.factor index d0567bdd48..b573cd51ab 100644 --- a/extra/qtkit/qtkit.factor +++ b/extra/qtkit/qtkit.factor @@ -1,4 +1,5 @@ -USING: classes.struct cocoa core-foundation.strings ; +USING: classes.struct cocoa cocoa.application cocoa.classes +cocoa.enumeration cocoa.plists core-foundation.strings kernel ; IN: qtkit STRUCT: QTTime @@ -74,3 +75,19 @@ IMPORT: QTMovieView IMPORT: QTSampleBuffer IMPORT: QTTrack +: ( filename -- movie ) + QTMovie swap f -> movieWithFile:error: -> retain ; + +: movie-attributes ( movie -- attributes ) + -> movieAttributes plist> ; + +: play ( movie -- ) + -> play ; +: stop ( movie -- ) + -> stop ; + +: movie-tracks ( movie -- tracks ) + -> tracks NSFastEnumeration>vector ; + +: track-attributes ( track -- attributes ) + -> trackAttributes plist> ; From 238f600da28e01cd4f999149f646a079e3db70f8 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 18 Sep 2009 15:11:01 -0500 Subject: [PATCH 32/32] document number-base prettyprinter variable. add more docs about hex float syntax --- basis/prettyprint/config/config-docs.factor | 3 +++ basis/prettyprint/prettyprint-docs.factor | 5 +++-- core/math/parser/parser-docs.factor | 6 +++--- core/syntax/syntax-docs.factor | 11 +++++++---- 4 files changed, 16 insertions(+), 9 deletions(-) diff --git a/basis/prettyprint/config/config-docs.factor b/basis/prettyprint/config/config-docs.factor index 1dcb1b5617..ccc63c61cb 100644 --- a/basis/prettyprint/config/config-docs.factor +++ b/basis/prettyprint/config/config-docs.factor @@ -19,6 +19,9 @@ HELP: length-limit HELP: line-limit { $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ; +HELP: number-base +{ $var-description "The number base in which the prettyprinter will output numeric literals. A value of " { $snippet "2" } " will print integers and ratios in binary with " { $link POSTPONE: BIN: } ", and " { $snippet "8" } " will print them in octal with " { $link POSTPONE: OCT: } ". A value of " { $snippet "16" } " will print all integers, ratios, and floating-point values in hexadecimal with " { $link POSTPONE: HEX: } ". Other values of " { $snippet "number-base" } " will print numbers in decimal, which is the default." } ; + HELP: string-limit? { $var-description "Toggles whether printed strings are truncated to the margin." } ; diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 7c114f2e22..1560b208ab 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -28,6 +28,7 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables" { $subsection nesting-limit } { $subsection length-limit } { $subsection line-limit } +{ $subsection number-base } { $subsection string-limit? } { $subsection boa-tuples? } { $subsection c-object-pointers? } @@ -202,8 +203,8 @@ HELP: .o { $description "Outputs an integer in octal." } ; HELP: .h -{ $values { "n" "an integer" } } -{ $description "Outputs an integer in hexadecimal." } ; +{ $values { "n" "an integer or floating-point value" } } +{ $description "Outputs an integer or floating-point value in hexadecimal." } ; HELP: stack. { $values { "seq" "a sequence" } } diff --git a/core/math/parser/parser-docs.factor b/core/math/parser/parser-docs.factor index ebb9c8aa5e..c3ee350099 100644 --- a/core/math/parser/parser-docs.factor +++ b/core/math/parser/parser-docs.factor @@ -61,7 +61,7 @@ HELP: bin> $nl "Outputs " { $link f } " if the string does not represent a number." } ; -{ bin> POSTPONE: BIN: bin> .b } related-words +{ >bin POSTPONE: BIN: bin> .b } related-words HELP: oct> { $values { "str" string } { "n/f" "a real number or " { $link f } } } @@ -69,7 +69,7 @@ HELP: oct> $nl "Outputs " { $link f } " if the string does not represent a number." } ; -{ oct> POSTPONE: OCT: oct> .o } related-words +{ >oct POSTPONE: OCT: oct> .o } related-words HELP: hex> { $values { "str" string } { "n/f" "a real number or " { $link f } } } @@ -77,7 +77,7 @@ HELP: hex> $nl "Outputs " { $link f } " if the string does not represent a number." } ; -{ hex> POSTPONE: HEX: hex> .h } related-words +{ >hex POSTPONE: HEX: hex> .h } related-words HELP: >base { $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } } diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index e34fb0957f..394ae3f67c 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -593,10 +593,13 @@ HELP: #! { $description "Discards all input until the end of the line." } ; HELP: HEX: -{ $syntax "HEX: integer" } -{ $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } } -{ $description "Adds an integer read from a hexadecimal literal to the parse tree." } -{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ; +{ $syntax "HEX: NNN" "HEX: NNN.NNNpEEE" } +{ $values { "N" "hexadecimal digit (0-9, a-f, A-F)" } { "pEEE" "decimal exponent value" } } +{ $description "Adds an integer or floating-point value read from a hexadecimal literal to the parse tree." } +{ $examples + { $example "USE: prettyprint" "HEX: ff ." "255" } + { $example "USE: prettyprint" "HEX: 1.8p5 ." "48.0" } +} ; HELP: OCT: { $syntax "OCT: integer" }