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.alien
10 ! get function name, ret type, param types and names
13 ! iterate through functions in a module
15 TUPLE: function name alien return params ;
17 : params ( llvm-function -- param-list )
18 dup LLVMCountParams <void*-array>
19 [ LLVMGetParams ] keep >array
20 [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
22 : <function> ( LLVMValueRef -- function )
24 over LLVMGetValueName >>name
25 over LLVMTypeOf tref> type>> return>> >>return
26 swap params >>params ;
28 : (functions) ( llvm-function -- )
29 [ dup , LLVMGetNextFunction (functions) ] when* ;
31 : functions ( llvm-module -- functions )
32 LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
34 : function-effect ( function -- effect )
35 [ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi <effect> ;
37 : install-function ( function -- )
38 dup name>> "alien.llvm" create-vocab drop
39 "alien.llvm" create swap
41 dup name>> function-pointer ,
43 dup params>> [ second c-type ] map ,
44 "cdecl" , \ alien-indirect ,
45 ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
47 : install-module ( name -- )
49 module>> functions [ install-function ] each
50 ] [ "no such module" throw ] if* ;
52 : install-bc ( path -- )
53 [ normalize-path ] [ file-name ] bi
54 [ load-into-jit ] keep install-module ;
56 << "alien.llvm" create-vocab drop >>