extra/llvm/invoker/invoker.factor

   1 ! Copyright (C) 2009 Matthew Willis.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien arrays assocs compiler.units effects
   4 io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
   5 llvm.types make namespaces sequences specialized-arrays
   6 vocabs words ;
   7 SPECIALIZED-ARRAY: void*
   8 IN: llvm.invoker
   9
  10 ! get function name, ret type, param types and names
  11
  12 ! load module
  13 ! iterate through functions in a module
  14
  15 TUPLE: function name alien return params ;
  16
  17 : params ( llvm-function -- param-list )
  18     dup LLVMCountParams <void*-array>
  19     [ LLVMGetParams ] keep >array
  20     [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
  21
  22 : <function> ( LLVMValueRef -- function )
  23     function new
  24     over LLVMGetValueName >>name
  25     over LLVMTypeOf tref> type>> return>> >>return
  26     swap params >>params ;
  27
  28 : (functions) ( llvm-function -- )
  29     [ dup , LLVMGetNextFunction (functions) ] when* ;
  30
  31 : functions ( llvm-module -- functions )
  32     LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
  33
  34 : function-effect ( function -- effect )
  35     [ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi <effect> ;
  36
  37 : install-function ( function -- )
  38     dup name>> "alien.llvm" create-vocab drop
  39     "alien.llvm" create swap
  40     [
  41         dup name>> function-pointer ,
  42         dup return>> c-type ,
  43         dup params>> [ second c-type ] map ,
  44         "cdecl" , \ alien-indirect ,
  45     ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
  46
  47 : install-module ( name -- )
  48     thejit get mps>> at [
  49         module>> functions [ install-function ] each
  50     ] [ "no such module" throw ] if* ;
  51
  52 : install-bc ( path -- )
  53     [ normalize-path ] [ file-name ] bi
  54     [ load-into-jit ] keep install-module ;
  55
  56 << "alien.llvm" create-vocab drop >>