extra/llvm/invoker/invoker.factor

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