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*
11 ! get function name, ret type, param types and names
14 ! iterate through functions in a module
16 TUPLE: function name alien return params ;
18 : params ( llvm-function -- param-list )
19 dup LLVMCountParams c:void* <c-array>
20 [ LLVMGetParams ] keep >array
21 [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
23 : <function> ( LLVMValueRef -- function )
25 over LLVMGetValueName >>name
26 over LLVMTypeOf tref> type>> return>> >>return
27 swap params >>params ;
29 : (functions) ( llvm-function -- )
30 [ dup , LLVMGetNextFunction (functions) ] when* ;
32 : functions ( llvm-module -- functions )
33 LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
35 : function-effect ( function -- effect )
36 [ params>> keys ] [ return>> void? 0 1 ? ] bi <effect> ;
38 : install-function ( function -- )
39 dup name>> "alien.llvm" create-vocab drop
40 "alien.llvm" create swap
42 dup name>> function-pointer ,
44 dup params>> [ second c-type ] map ,
45 cdecl , \ alien-indirect ,
46 ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
48 : install-module ( name -- )
49 current-jit mps>> at [
50 module>> functions [ install-function ] each
51 ] [ "no such module" throw ] if* ;
53 : install-bc ( path -- )
54 [ normalize-path ] [ file-name ] bi
55 [ load-into-jit ] keep install-module ;
57 << "alien.llvm" create-vocab drop >>