]> gitweb.factorcode.org Git - factor.git/blob - extra/llvm/jit/jit.factor
install functions from llvm bytecode, with test
[factor.git] / extra / llvm / jit / jit.factor
1 USING: accessors alien.c-types alien.syntax assocs destructors
2 kernel llvm.core llvm.engine llvm.wrappers namespaces ;
3
4 IN: llvm.jit
5
6 SYMBOL: thejit
7
8 TUPLE: jit ee mps ;
9
10 : empty-engine ( -- engine )
11     "initial-module" <module> <provider> <engine> ;
12
13 : <jit> ( -- jit )
14     jit new empty-engine >>ee H{ } clone >>mps ;
15
16 : (remove-functions) ( function -- )
17     thejit get ee>> value>> over LLVMFreeMachineCodeForFunction
18     LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
19
20 : remove-functions ( module -- )
21     ! free machine code for each function in module
22     LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
23
24 : remove-provider ( provider -- )
25     thejit get ee>> value>> swap value>> f <void*> f <void*>
26     [ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
27     *void* module new swap >>value
28     [ value>> remove-functions ] with-disposal ;
29
30 : remove-module ( name -- )
31     dup thejit get mps>> at [
32         remove-provider
33         thejit get mps>> delete-at
34     ] [ drop ] if* ;
35
36 : add-module ( module name -- )
37     [ <provider> ] dip [ remove-module ] keep
38     thejit get ee>> value>> pick
39     [ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
40     thejit get mps>> set-at ;
41
42 : function-pointer ( name -- alien )
43     thejit get ee>> value>> dup
44     rot f <void*> [ LLVMFindFunction drop ] keep
45     *void* LLVMGetPointerToGlobal ;
46
47 thejit [ <jit> ] initialize