move alien.inline, alien.cxx, alien.marshall to unmaintained; nuke alien.structs
Joe Groff
parent
653a74a314
commit
2cf0f3e5d3
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,45 +0,0 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays kernel kernel.private math namespaces
|
||||
make sequences strings words effects combinators alien.c-types ;
|
||||
IN: alien.structs.fields
|
||||
|
||||
TUPLE: field-spec name offset type reader writer ;
|
||||
|
||||
: reader-word ( class name vocab -- word )
|
||||
[ "-" glue ] dip create dup make-deprecated ;
|
||||
|
||||
: writer-word ( class name vocab -- word )
|
||||
[ [ swap "set-" % % "-" % % ] "" make ] dip create dup make-deprecated ;
|
||||
|
||||
: <field-spec> ( struct-name vocab type field-name -- spec )
|
||||
field-spec new
|
||||
0 >>offset
|
||||
swap >>name
|
||||
swap >>type
|
||||
3dup name>> swap reader-word >>reader
|
||||
3dup name>> swap writer-word >>writer
|
||||
2nip ;
|
||||
|
||||
: align-offset ( offset type -- offset )
|
||||
c-type-align align ;
|
||||
|
||||
: struct-offsets ( specs -- size )
|
||||
0 [
|
||||
[ type>> align-offset ] keep
|
||||
[ (>>offset) ] [ type>> heap-size + ] 2bi
|
||||
] reduce ;
|
||||
|
||||
: define-struct-slot-word ( word quot spec effect -- )
|
||||
[ offset>> prefix ] dip define-inline ;
|
||||
|
||||
: define-getter ( spec -- )
|
||||
[ reader>> ] [ type>> c-type-getter-boxer ] [ ] tri
|
||||
(( c-ptr -- value )) define-struct-slot-word ;
|
||||
|
||||
: define-setter ( spec -- )
|
||||
[ writer>> ] [ type>> c-setter ] [ ] tri
|
||||
(( value c-ptr -- )) define-struct-slot-word ;
|
||||
|
||||
: define-field ( spec -- )
|
||||
[ define-getter ] [ define-setter ] bi ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Struct field implementation and reflection support
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
USING: alien.c-types alien.data strings help.markup help.syntax alien.syntax
|
||||
sequences io arrays kernel words assocs namespaces ;
|
||||
IN: alien.structs
|
||||
|
||||
ARTICLE: "c-structs" "C structure types"
|
||||
"A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset from the start of the block. The C library interface provides some utilities to define words which read and write structure fields given a base address."
|
||||
{ $subsection POSTPONE: C-STRUCT: }
|
||||
"Great care must be taken when working with C structures since no type or bounds checking is possible."
|
||||
$nl
|
||||
"An example:"
|
||||
{ $code
|
||||
"C-STRUCT: XVisualInfo"
|
||||
" { \"Visual*\" \"visual\" }"
|
||||
" { \"VisualID\" \"visualid\" }"
|
||||
" { \"int\" \"screen\" }"
|
||||
" { \"uint\" \"depth\" }"
|
||||
" { \"int\" \"class\" }"
|
||||
" { \"ulong\" \"red_mask\" }"
|
||||
" { \"ulong\" \"green_mask\" }"
|
||||
" { \"ulong\" \"blue_mask\" }"
|
||||
" { \"int\" \"colormap_size\" }"
|
||||
" { \"int\" \"bits_per_rgb\" } ;"
|
||||
}
|
||||
"C structure objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
|
||||
$nl
|
||||
"Arrays of C structures can be created with the " { $vocab-link "specialized-arrays" } " vocabulary." ;
|
||||
|
||||
ARTICLE: "c-unions" "C unions"
|
||||
"A " { $snippet "union" } " in C defines a type large enough to hold its largest member. This is usually used to allocate a block of memory which can hold one of several types of values."
|
||||
{ $subsection POSTPONE: C-UNION: }
|
||||
"C union objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
|
||||
$nl
|
||||
"Arrays of C unions can be created with the " { $vocab-link "specialized-arrays" } " vocabulary." ;
|
||||
|
|
@ -1,59 +0,0 @@
|
|||
USING: alien alien.syntax alien.c-types alien.data kernel tools.test
|
||||
sequences system libc words vocabs namespaces layouts ;
|
||||
IN: alien.structs.tests
|
||||
|
||||
C-STRUCT: bar
|
||||
{ "int" "x" }
|
||||
{ { "int" 8 } "y" } ;
|
||||
|
||||
[ 36 ] [ "bar" heap-size ] unit-test
|
||||
[ t ] [ \ <displaced-alien> "bar" c-type-getter memq? ] unit-test
|
||||
|
||||
C-STRUCT: align-test
|
||||
{ "int" "x" }
|
||||
{ "double" "y" } ;
|
||||
|
||||
os winnt? cpu x86? and [
|
||||
[ 16 ] [ "align-test" heap-size ] unit-test
|
||||
|
||||
cell 4 = [
|
||||
C-STRUCT: one
|
||||
{ "long" "a" } { "double" "b" } { "int" "c" } ;
|
||||
|
||||
[ 24 ] [ "one" heap-size ] unit-test
|
||||
] when
|
||||
] when
|
||||
|
||||
CONSTANT: MAX_FOOS 30
|
||||
|
||||
C-STRUCT: foox
|
||||
{ { "int" MAX_FOOS } "x" } ;
|
||||
|
||||
[ 120 ] [ "foox" heap-size ] unit-test
|
||||
|
||||
C-UNION: barx
|
||||
{ "int" MAX_FOOS }
|
||||
"float" ;
|
||||
|
||||
[ 120 ] [ "barx" heap-size ] unit-test
|
||||
|
||||
"help" vocab [
|
||||
"print-topic" "help" lookup "help" set
|
||||
[ ] [ \ foox-x "help" get execute ] unit-test
|
||||
[ ] [ \ set-foox-x "help" get execute ] unit-test
|
||||
] when
|
||||
|
||||
C-STRUCT: nested
|
||||
{ "int" "x" } ;
|
||||
|
||||
C-STRUCT: nested-2
|
||||
{ "nested" "y" } ;
|
||||
|
||||
[ 4 ] [
|
||||
"nested-2" <c-object>
|
||||
"nested" <c-object>
|
||||
4 over set-nested-x
|
||||
over set-nested-2-y
|
||||
nested-2-y
|
||||
nested-x
|
||||
] unit-test
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs generic hashtables kernel kernel.private
|
||||
math namespaces parser sequences strings words libc fry
|
||||
alien.c-types alien.structs.fields cpu.architecture math.order
|
||||
quotations byte-arrays ;
|
||||
IN: alien.structs
|
||||
|
||||
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
||||
|
||||
INSTANCE: struct-type value-type
|
||||
|
||||
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
|
||||
|
||||
M: struct-type unbox-parameter
|
||||
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
|
||||
|
||||
M: struct-type box-parameter
|
||||
[ %box-large-struct ] [ box-parameter ] if-value-struct ;
|
||||
|
||||
: if-small-struct ( c-type true false -- ? )
|
||||
[ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
|
||||
|
||||
M: struct-type unbox-return
|
||||
[ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
|
||||
|
||||
M: struct-type box-return
|
||||
[ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
|
||||
|
||||
M: struct-type stack-size
|
||||
[ heap-size ] [ stack-size ] if-value-struct ;
|
||||
|
||||
M: struct-type c-struct? drop t ;
|
||||
|
||||
: (define-struct) ( name size align fields class -- )
|
||||
[ [ align ] keep ] 2dip new
|
||||
byte-array >>class
|
||||
byte-array >>boxed-class
|
||||
swap >>fields
|
||||
swap >>align
|
||||
swap >>size
|
||||
swap typedef ;
|
||||
|
||||
: make-fields ( name vocab fields -- fields )
|
||||
[ first2 <field-spec> ] with with map ;
|
||||
|
||||
: compute-struct-align ( types -- n )
|
||||
[ c-type-align ] [ max ] map-reduce ;
|
||||
|
||||
: define-struct ( name vocab fields -- )
|
||||
[ 2drop ] [ make-fields ] 3bi
|
||||
[ struct-offsets ] keep
|
||||
[ [ type>> ] map compute-struct-align ] keep
|
||||
[ struct-type (define-struct) ] keep
|
||||
[ define-field ] each ; deprecated
|
||||
|
||||
: define-union ( name members -- )
|
||||
[ [ heap-size ] [ max ] map-reduce ] keep
|
||||
compute-struct-align f struct-type (define-struct) ; deprecated
|
||||
|
||||
: offset-of ( field struct -- offset )
|
||||
c-types get at fields>>
|
||||
[ name>> = ] with find nip offset>> ;
|
||||
|
||||
USE: vocabs.loader
|
||||
"specialized-arrays" require
|
||||
|
|
@ -1 +0,0 @@
|
|||
C structure support
|
||||
|
|
@ -1,6 +1,5 @@
|
|||
IN: alien.syntax
|
||||
USING: alien alien.c-types alien.parser alien.structs
|
||||
classes.struct help.markup help.syntax ;
|
||||
USING: alien alien.c-types alien.parser classes.struct help.markup help.syntax ;
|
||||
|
||||
HELP: DLL"
|
||||
{ $syntax "DLL\" path\"" }
|
||||
|
|
@ -54,21 +53,6 @@ HELP: TYPEDEF:
|
|||
{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if ." }
|
||||
{ $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
|
||||
|
||||
HELP: C-STRUCT:
|
||||
{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: STRUCT: } " word." }
|
||||
{ $syntax "C-STRUCT: name pairs... ;" }
|
||||
{ $values { "name" "a new C type name" } { "pairs" "C type / field name string pairs" } }
|
||||
{ $description "Defines a C struct layout and accessor words." }
|
||||
{ $notes "C type names are documented in " { $link "c-types-specs" } "." } ;
|
||||
|
||||
HELP: C-UNION:
|
||||
{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: UNION-STRUCT: } " word." }
|
||||
{ $syntax "C-UNION: name members... ;" }
|
||||
{ $values { "name" "a new C type name" } { "members" "a sequence of C types" } }
|
||||
{ $description "Defines a new C type sized to fit its largest member." }
|
||||
{ $notes "C type names are documented in " { $link "c-types-specs" } "." }
|
||||
{ $examples { $code "C-UNION: event \"active-event\" \"keyboard-event\" \"mouse-event\" ;" } } ;
|
||||
|
||||
HELP: C-ENUM:
|
||||
{ $syntax "C-ENUM: words... ;" }
|
||||
{ $values { "words" "a sequence of word names" } }
|
||||
|
|
@ -131,7 +115,7 @@ HELP: typedef
|
|||
|
||||
HELP: c-struct?
|
||||
{ $values { "type" "a string" } { "?" "a boolean" } }
|
||||
{ $description "Tests if a C type is a structure defined by " { $link POSTPONE: C-STRUCT: } "." } ;
|
||||
{ $description "Tests if a C type is a structure defined by " { $link POSTPONE: STRUCT: } "." } ;
|
||||
|
||||
HELP: define-function
|
||||
{ $values { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov, Alex Chapman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays alien alien.c-types alien.structs
|
||||
USING: accessors arrays alien alien.c-types
|
||||
alien.arrays alien.strings kernel math namespaces parser
|
||||
sequences words quotations math.parser splitting grouping
|
||||
effects assocs combinators lexer strings.parser alien.parser
|
||||
|
|
@ -27,12 +27,6 @@ SYNTAX: STDCALL-CALLBACK:
|
|||
SYNTAX: TYPEDEF:
|
||||
scan-c-type CREATE-C-TYPE typedef ;
|
||||
|
||||
SYNTAX: C-STRUCT:
|
||||
scan current-vocab parse-definition define-struct ; deprecated
|
||||
|
||||
SYNTAX: C-UNION:
|
||||
scan parse-definition define-union ; deprecated
|
||||
|
||||
SYNTAX: C-ENUM:
|
||||
";" parse-tokens
|
||||
[ [ create-in ] dip define-constant ] each-index ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: namespaces make math math.order math.parser sequences accessors
|
|||
kernel kernel.private layouts assocs words summary arrays
|
||||
combinators classes.algebra alien alien.c-types
|
||||
alien.strings alien.arrays alien.complex alien.libraries sets libc
|
||||
continuations.private fry cpu.architecture classes locals
|
||||
continuations.private fry cpu.architecture classes classes.struct locals
|
||||
source-files.errors slots parser generic.parser
|
||||
compiler.errors
|
||||
compiler.alien
|
||||
|
|
@ -16,8 +16,6 @@ compiler.cfg.registers
|
|||
compiler.cfg.builder
|
||||
compiler.codegen.fixup
|
||||
compiler.utilities ;
|
||||
QUALIFIED: classes.struct
|
||||
QUALIFIED: alien.structs
|
||||
IN: compiler.codegen
|
||||
|
||||
SYMBOL: insn-counts
|
||||
|
|
@ -331,10 +329,7 @@ GENERIC: flatten-value-type ( type -- types )
|
|||
|
||||
M: object flatten-value-type 1array ;
|
||||
|
||||
M: alien.structs:struct-type flatten-value-type ( type -- types )
|
||||
stack-size cell align (flatten-int-type) ;
|
||||
|
||||
M: classes.struct:struct-c-type flatten-value-type ( type -- types )
|
||||
M: struct-c-type flatten-value-type ( type -- types )
|
||||
stack-size cell align (flatten-int-type) ;
|
||||
|
||||
M: long-long-type flatten-value-type ( type -- types )
|
||||
|
|
|
|||
|
|
@ -1,11 +1,9 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays sequences math splitting make assocs kernel
|
||||
layouts system alien.c-types cpu.architecture
|
||||
layouts system alien.c-types classes.struct cpu.architecture
|
||||
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
|
||||
compiler.cfg.registers ;
|
||||
QUALIFIED: alien.structs
|
||||
QUALIFIED: classes.struct
|
||||
IN: cpu.x86.64.unix
|
||||
|
||||
M: int-regs param-regs
|
||||
|
|
@ -48,9 +46,7 @@ stack-params \ (stack-value) c-type (>>rep) >>
|
|||
flatten-small-struct
|
||||
] if ;
|
||||
|
||||
M: alien.structs:struct-type flatten-value-type ( type -- seq )
|
||||
flatten-struct ;
|
||||
M: classes.struct:struct-c-type flatten-value-type ( type -- seq )
|
||||
M: struct-c-type flatten-value-type ( type -- seq )
|
||||
flatten-struct ;
|
||||
|
||||
M: x86.64 return-struct-in-registers? ( c-type -- ? )
|
||||
|
|
|
|||
Loading…
Reference in New Issue