57 lines
1.7 KiB
Factor
57 lines
1.7 KiB
Factor
! Copyright (C) 2009 Matthew Willis.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors alien arrays assocs compiler.units effects
|
|
io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
|
|
llvm.types make namespaces sequences specialized-arrays
|
|
vocabs words ;
|
|
SPECIALIZED-ARRAY: void*
|
|
IN: llvm.invoker
|
|
|
|
! get function name, ret type, param types and names
|
|
|
|
! load module
|
|
! iterate through functions in a module
|
|
|
|
TUPLE: function name alien return params ;
|
|
|
|
: params ( llvm-function -- param-list )
|
|
dup LLVMCountParams <void*-array>
|
|
[ LLVMGetParams ] keep >array
|
|
[ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
|
|
|
|
: <function> ( LLVMValueRef -- function )
|
|
function new
|
|
over LLVMGetValueName >>name
|
|
over LLVMTypeOf tref> type>> return>> >>return
|
|
swap params >>params ;
|
|
|
|
: (functions) ( llvm-function -- )
|
|
[ dup , LLVMGetNextFunction (functions) ] when* ;
|
|
|
|
: functions ( llvm-module -- functions )
|
|
LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
|
|
|
|
: function-effect ( function -- effect )
|
|
[ params>> keys ] [ return>> void? 0 1 ? ] bi <effect> ;
|
|
|
|
: install-function ( function -- )
|
|
dup name>> "alien.llvm" create-vocab drop
|
|
"alien.llvm" create swap
|
|
[
|
|
dup name>> function-pointer ,
|
|
dup return>> c-type ,
|
|
dup params>> [ second c-type ] map ,
|
|
cdecl , \ alien-indirect ,
|
|
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
|
|
|
|
: install-module ( name -- )
|
|
current-jit mps>> at [
|
|
module>> functions [ install-function ] each
|
|
] [ "no such module" throw ] if* ;
|
|
|
|
: install-bc ( path -- )
|
|
[ normalize-path ] [ file-name ] bi
|
|
[ load-into-jit ] keep install-module ;
|
|
|
|
<< "alien.llvm" create-vocab drop >>
|