basis/alien/arrays/arrays.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.strings alien.c-types alien.accessors alien.structs
   4 arrays words sequences math kernel namespaces fry libc cpu.architecture
   5 io.encodings.utf8 io.encodings.utf16n ;
   6 IN: alien.arrays
   7
   8 UNION: value-type array struct-type ;
   9
  10 M: array c-type ;
  11
  12 M: array c-type-class drop object ;
  13
  14 M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
  15
  16 M: array c-type-align first c-type-align ;
  17
  18 M: array c-type-stack-align? drop f ;
  19
  20 M: array unbox-parameter drop "void*" unbox-parameter ;
  21
  22 M: array unbox-return drop "void*" unbox-return ;
  23
  24 M: array box-parameter drop "void*" box-parameter ;
  25
  26 M: array box-return drop "void*" box-return ;
  27
  28 M: array stack-size drop "void*" stack-size ;
  29
  30 M: array c-type-boxer-quot drop [ ] ;
  31
  32 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
  33
  34 M: value-type c-type-reg-class drop int-regs ;
  35
  36 M: value-type c-type-getter
  37     drop [ swap <displaced-alien> ] ;
  38
  39 M: value-type c-type-setter ( type -- quot )
  40     [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
  41     '[ @ swap @ _ memcpy ] ;
  42
  43 PREDICATE: string-type < pair
  44     first2 [ "char*" = ] [ word? ] bi* and ;
  45
  46 M: string-type c-type ;
  47
  48 M: string-type c-type-class
  49     drop object ;
  50
  51 M: string-type heap-size
  52     drop "void*" heap-size ;
  53
  54 M: string-type c-type-align
  55     drop "void*" c-type-align ;
  56
  57 M: string-type c-type-stack-align?
  58     drop "void*" c-type-stack-align? ;
  59
  60 M: string-type unbox-parameter
  61     drop "void*" unbox-parameter ;
  62
  63 M: string-type unbox-return
  64     drop "void*" unbox-return ;
  65
  66 M: string-type box-parameter
  67     drop "void*" box-parameter ;
  68
  69 M: string-type box-return
  70     drop "void*" box-return ;
  71
  72 M: string-type stack-size
  73     drop "void*" stack-size ;
  74
  75 M: string-type c-type-reg-class
  76     drop int-regs ;
  77
  78 M: string-type c-type-boxer
  79     drop "void*" c-type-boxer ;
  80
  81 M: string-type c-type-unboxer
  82     drop "void*" c-type-unboxer ;
  83
  84 M: string-type c-type-boxer-quot
  85     second '[ _ alien>string ] ;
  86
  87 M: string-type c-type-unboxer-quot
  88     second '[ _ string>alien ] ;
  89
  90 M: string-type c-type-getter
  91     drop [ alien-cell ] ;
  92
  93 M: string-type c-type-setter
  94     drop [ set-alien-cell ] ;
  95
  96 { "char*" utf8 } "char*" typedef
  97 "char*" "uchar*" typedef
  98 { "char*" utf16n } "wchar_t*" typedef
  99