unmaintained/llvm/jit/jit.factor

   1 ! Copyright (C) 2009 Matthew Willis.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data alien.syntax assocs
   4 destructors kernel llvm.core llvm.engine llvm.wrappers
   5 namespaces ;
   6
   7 IN: llvm.jit
   8
   9 TUPLE: jit ee mps ;
  10
  11 : empty-engine ( -- engine )
  12     "initial-module" <module> <provider> <engine> ;
  13
  14 : <jit> ( -- jit )
  15     jit new empty-engine >>ee H{ } clone >>mps ;
  16
  17 : current-jit ( -- jit )
  18     \ current-jit global [ drop <jit> ] cache ;
  19
  20 : (remove-functions) ( function -- )
  21     current-jit ee>> value>> over LLVMFreeMachineCodeForFunction
  22     LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
  23
  24 : remove-functions ( module -- )
  25     ! free machine code for each function in module
  26     LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
  27
  28 : remove-provider ( provider -- )
  29     current-jit ee>> value>> swap value>> f void* <ref> f void* <ref>
  30     [ LLVMRemoveModuleProvider drop ] 2keep void* deref [ llvm-throw ] when*
  31     void* deref module new swap >>value
  32     [ value>> remove-functions ] with-disposal ;
  33
  34 : remove-module ( name -- )
  35     dup current-jit mps>> at [
  36         remove-provider
  37         current-jit mps>> delete-at
  38     ] [ drop ] if* ;
  39
  40 : add-module ( module name -- )
  41     [ <provider> ] dip [ remove-module ] keep
  42     current-jit ee>> value>> pick
  43     [ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
  44     current-jit mps>> set-at ;
  45
  46 : function-pointer ( name -- alien )
  47     current-jit ee>> value>> dup
  48     rot f void* <ref> [ LLVMFindFunction drop ] keep
  49     void* deref LLVMGetPointerToGlobal ;