unmaintained/llvm/invoker/invoker.factor

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