llvm: fix load errors
parent
7524007110
commit
f6908f513f
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Matthew Willis.
|
! Copyright (C) 2009 Matthew Willis.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.libraries alien.syntax system sequences combinators kernel alien.c-types ;
|
USING: alien alien.libraries alien.syntax system sequences combinators kernel alien.c-types ;
|
||||||
|
|
||||||
IN: llvm.core
|
IN: llvm.core
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Matthew Willis.
|
! Copyright (C) 2009 Matthew Willis.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.libraries alien.syntax llvm.core ;
|
USING: alien.c-types alien.libraries alien.syntax llvm.core ;
|
||||||
IN: llvm.engine
|
IN: llvm.engine
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
|
|
@ -45,7 +45,7 @@ TUPLE: function name alien return params ;
|
||||||
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
|
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
|
||||||
|
|
||||||
: install-module ( name -- )
|
: install-module ( name -- )
|
||||||
thejit get mps>> at [
|
current-jit mps>> at [
|
||||||
module>> functions [ install-function ] each
|
module>> functions [ install-function ] each
|
||||||
] [ "no such module" throw ] if* ;
|
] [ "no such module" throw ] if* ;
|
||||||
|
|
||||||
|
|
|
@ -5,8 +5,6 @@ kernel llvm.core llvm.engine llvm.wrappers namespaces ;
|
||||||
|
|
||||||
IN: llvm.jit
|
IN: llvm.jit
|
||||||
|
|
||||||
SYMBOL: thejit
|
|
||||||
|
|
||||||
TUPLE: jit ee mps ;
|
TUPLE: jit ee mps ;
|
||||||
|
|
||||||
: empty-engine ( -- engine )
|
: empty-engine ( -- engine )
|
||||||
|
@ -15,8 +13,11 @@ TUPLE: jit ee mps ;
|
||||||
: <jit> ( -- jit )
|
: <jit> ( -- jit )
|
||||||
jit new empty-engine >>ee H{ } clone >>mps ;
|
jit new empty-engine >>ee H{ } clone >>mps ;
|
||||||
|
|
||||||
|
: current-jit ( -- jit )
|
||||||
|
\ current-jit global [ drop <jit> ] cache ;
|
||||||
|
|
||||||
: (remove-functions) ( function -- )
|
: (remove-functions) ( function -- )
|
||||||
thejit get ee>> value>> over LLVMFreeMachineCodeForFunction
|
current-jit ee>> value>> over LLVMFreeMachineCodeForFunction
|
||||||
LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
|
LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
|
||||||
|
|
||||||
: remove-functions ( module -- )
|
: remove-functions ( module -- )
|
||||||
|
@ -24,26 +25,24 @@ TUPLE: jit ee mps ;
|
||||||
LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
|
LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
|
||||||
|
|
||||||
: remove-provider ( provider -- )
|
: remove-provider ( provider -- )
|
||||||
thejit get ee>> value>> swap value>> f <void*> f <void*>
|
current-jit ee>> value>> swap value>> f <void*> f <void*>
|
||||||
[ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
|
[ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
|
||||||
*void* module new swap >>value
|
*void* module new swap >>value
|
||||||
[ value>> remove-functions ] with-disposal ;
|
[ value>> remove-functions ] with-disposal ;
|
||||||
|
|
||||||
: remove-module ( name -- )
|
: remove-module ( name -- )
|
||||||
dup thejit get mps>> at [
|
dup current-jit mps>> at [
|
||||||
remove-provider
|
remove-provider
|
||||||
thejit get mps>> delete-at
|
current-jit mps>> delete-at
|
||||||
] [ drop ] if* ;
|
] [ drop ] if* ;
|
||||||
|
|
||||||
: add-module ( module name -- )
|
: add-module ( module name -- )
|
||||||
[ <provider> ] dip [ remove-module ] keep
|
[ <provider> ] dip [ remove-module ] keep
|
||||||
thejit get ee>> value>> pick
|
current-jit ee>> value>> pick
|
||||||
[ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
|
[ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
|
||||||
thejit get mps>> set-at ;
|
current-jit mps>> set-at ;
|
||||||
|
|
||||||
: function-pointer ( name -- alien )
|
: function-pointer ( name -- alien )
|
||||||
thejit get ee>> value>> dup
|
current-jit ee>> value>> dup
|
||||||
rot f <void*> [ LLVMFindFunction drop ] keep
|
rot f <void*> [ LLVMFindFunction drop ] keep
|
||||||
*void* LLVMGetPointerToGlobal ;
|
*void* LLVMGetPointerToGlobal ;
|
||||||
|
|
||||||
thejit [ <jit> ] initialize
|
|
|
@ -229,7 +229,7 @@ NoFunctionParams = "(" WhiteSpace ")" => [[ drop { } ]]
|
||||||
VarArgs = WhiteSpace "..." WhiteSpace => [[ drop ... ]]
|
VarArgs = WhiteSpace "..." WhiteSpace => [[ drop ... ]]
|
||||||
ParamListContinued = "," (Type | VarArgs):t => [[ t ]]
|
ParamListContinued = "," (Type | VarArgs):t => [[ t ]]
|
||||||
ParamList = "(" Type:t (ParamListContinued*):ts ")" => [[ ts t prefix ]]
|
ParamList = "(" Type:t (ParamListContinued*):ts ")" => [[ ts t prefix ]]
|
||||||
Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts delete ] when t ts >array rot <function> ]]
|
Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts remove! drop ] when t ts >array rot <function> ]]
|
||||||
PackedStructure = "<" WhiteSpace "{" Type:ty (StructureTypesList)*:ts "}" WhiteSpace ">" => [[ ts ty prefix >array t <struct> ]]
|
PackedStructure = "<" WhiteSpace "{" Type:ty (StructureTypesList)*:ts "}" WhiteSpace ">" => [[ ts ty prefix >array t <struct> ]]
|
||||||
UpReference = "\\" Number:n => [[ n <up-ref> ]]
|
UpReference = "\\" Number:n => [[ n <up-ref> ]]
|
||||||
Name = '%' ([a-zA-Z][a-zA-Z0-9]*):id => [[ id flatten >string ]]
|
Name = '%' ([a-zA-Z][a-zA-Z0-9]*):id => [[ id flatten >string ]]
|
||||||
|
|
Loading…
Reference in New Issue