steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

new accessors

db4
Doug Coleman 2008-08-29 10:29:11 -05:00
parent f85493e980
commit c6b28c0b3f
2 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
basis/alien/c-types/c-types.factor
View File

@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces parser sequences strings words assocs splitting namespaces parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations math.parser cpu.architecture alien alien.accessors quotations
layouts system compiler.units io.files io.encodings.binary layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations ; accessors combinators effects continuations summary ;
IN: alien.c-types IN: alien.c-types
DEFER: <int> DEFER: <int>
@ -62,17 +62,19 @@ M: string c-type ( name -- type )
] ?if ] ?if
] if ; ] if ;
ERROR: no-boxer ;
M: no-boxer summary drop "No boxer" ;
: c-type-box ( n type -- ) : c-type-box ( n type -- )
dup c-type-reg-class [ reg-class>> ]
swap c-type-boxer [ "No boxer" throw ] unless* [ boxer>> [ no-boxer ] unless* ] bi %box ;
%box ;
ERROR: no-unboxer ;
M: no-unboxer summary drop "No unboxer" ;
: c-type-unbox ( n ctype -- ) : c-type-unbox ( n ctype -- )
dup c-type-reg-class [ reg-class>> ]
swap c-type-unboxer [ "No unboxer" throw ] unless* [ unboxer>> [ no-unboxer ] unless* ] bi %unbox ;
%unbox ;
M: string c-type-align c-type c-type-align ; M: string c-type-align c-type align>> ;
M: string c-type-stack-align? c-type c-type-stack-align? ; M: string c-type-stack-align? c-type c-type-stack-align? ;
@ -107,27 +109,33 @@ GENERIC: heap-size ( type -- size ) foldable
M: string heap-size c-type heap-size ; M: string heap-size c-type heap-size ;
M: c-type heap-size c-type-size ; M: c-type heap-size size>> ;
GENERIC: stack-size ( type -- size ) foldable GENERIC: stack-size ( type -- size ) foldable
M: string stack-size c-type stack-size ; M: string stack-size c-type stack-size ;
M: c-type stack-size c-type-size ; M: c-type stack-size size>> ;
GENERIC: byte-length ( seq -- n ) flushable GENERIC: byte-length ( seq -- n ) flushable
M: byte-array byte-length length ; M: byte-array byte-length length ;
ERROR: c-struct-reader ;
M: c-struct-reader summary
drop "Cannot read struct fields with type" ;
: c-getter ( name -- quot ) : c-getter ( name -- quot )
c-type c-type-getter [ c-type c-type-getter [ c-struct-reader ] unless* ;
[ "Cannot read struct fields with type" throw ]
] unless* ; ERROR: c-struct-writer ;
M: c-struct-writer summary
drop "Cannot write struct fields with type" ;
: c-setter ( name -- quot ) : c-setter ( name -- quot )
c-type c-type-setter [ c-type c-type-setter [ c-struct-writer ] unless* ;
[ "Cannot write struct fields with type" throw ]
] unless* ;
: <c-array> ( n type -- array ) : <c-array> ( n type -- array )
heap-size * <byte-array> ; inline heap-size * <byte-array> ; inline
@ -178,13 +186,13 @@ TUPLE: long-long-type < c-type ;
long-long-type new-c-type ; long-long-type new-c-type ;
M: long-long-type unbox-parameter ( n type -- ) M: long-long-type unbox-parameter ( n type -- )
c-type-unboxer %unbox-long-long ; unboxer>> %unbox-long-long ;
M: long-long-type unbox-return ( type -- ) M: long-long-type unbox-return ( type -- )
f swap unbox-parameter ; f swap unbox-parameter ;
M: long-long-type box-parameter ( n type -- ) M: long-long-type box-parameter ( n type -- )
c-type-boxer %box-long-long ; boxer>> %box-long-long ;
M: long-long-type box-return ( type -- ) M: long-long-type box-return ( type -- )
f swap box-parameter ; f swap box-parameter ;

6
basis/alien/strings/strings.factor
View File

@ -44,7 +44,7 @@ M: string-type heap-size
drop "void*" heap-size ; drop "void*" heap-size ;
M: string-type c-type-align M: string-type c-type-align
drop "void*" c-type-align ; drop "void*" align>> ;
M: string-type c-type-stack-align? M: string-type c-type-stack-align?
drop "void*" c-type-stack-align? ; drop "void*" c-type-stack-align? ;
@ -68,10 +68,10 @@ M: string-type c-type-reg-class
drop int-regs ; drop int-regs ;
M: string-type c-type-boxer M: string-type c-type-boxer
drop "void*" c-type-boxer ; drop "void*" boxer>> ;
M: string-type c-type-unboxer M: string-type c-type-unboxer
drop "void*" c-type-unboxer ; drop "void*" unboxer>> ;
M: string-type c-type-boxer-quot M: string-type c-type-boxer-quot
second [ alien>string ] curry [ ] like ; second [ alien>string ] curry [ ] like ;