basis/alien/data/data.factor

   1 ! (c)2009 Slava Pestov, Joe Groff bsd license
   2 USING: accessors alien alien.c-types alien.strings arrays
   3 byte-arrays cpu.architecture fry io io.encodings.binary
   4 io.files io.streams.memory kernel libc math sequences words ;
   5 IN: alien.data
   6
   7 GENERIC: require-c-array ( c-type -- )
   8
   9 M: array require-c-array first require-c-array ;
  10
  11 GENERIC: c-array-constructor ( c-type -- word ) foldable
  12
  13 GENERIC: c-(array)-constructor ( c-type -- word ) foldable
  14
  15 GENERIC: c-direct-array-constructor ( c-type -- word ) foldable
  16
  17 GENERIC: <c-array> ( len c-type -- array )
  18
  19 M: word <c-array>
  20     c-array-constructor execute( len -- array ) ; inline
  21
  22 GENERIC: (c-array) ( len c-type -- array )
  23
  24 M: word (c-array)
  25     c-(array)-constructor execute( len -- array ) ; inline
  26
  27 GENERIC: <c-direct-array> ( alien len c-type -- array )
  28
  29 M: word <c-direct-array>
  30     c-direct-array-constructor execute( alien len -- array ) ; inline
  31
  32 : malloc-array ( n type -- array )
  33     [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
  34
  35 : (malloc-array) ( n type -- alien )
  36     [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
  37
  38 : <c-object> ( type -- array )
  39     heap-size <byte-array> ; inline
  40
  41 : (c-object) ( type -- array )
  42     heap-size (byte-array) ; inline
  43
  44 : malloc-object ( type -- alien )
  45     1 swap heap-size calloc ; inline
  46
  47 : (malloc-object) ( type -- alien )
  48     heap-size malloc ; inline
  49
  50 : malloc-byte-array ( byte-array -- alien )
  51     dup byte-length [ nip malloc dup ] 2keep memcpy ;
  52
  53 : memory>byte-array ( alien len -- byte-array )
  54     [ nip (byte-array) dup ] 2keep memcpy ;
  55
  56 : malloc-string ( string encoding -- alien )
  57     string>alien malloc-byte-array ;
  58
  59 M: memory-stream stream-read
  60     [
  61         [ index>> ] [ alien>> ] bi <displaced-alien>
  62         swap memory>byte-array
  63     ] [ [ + ] change-index drop ] 2bi ;
  64
  65 : byte-array>memory ( byte-array base -- )
  66     swap dup byte-length memcpy ; inline
  67
  68 M: value-type c-type-rep drop int-rep ;
  69
  70 M: value-type c-type-getter
  71     drop [ swap <displaced-alien> ] ;
  72
  73 M: value-type c-type-setter ( type -- quot )
  74     [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
  75     '[ @ swap @ _ memcpy ] ;