Added support for intrinsics.
As access to intrinsics is not exposed by LLVM-C API, a custom C++ library
exposing those hase been added - llvm_c_ext. Smalltalk binds to this library
in addition to LLVM's.
In a future this library will expose whatever C++ API will be needed
in scope of this project. However, it's designed to usable standalone, i.e.,
it contains no Smalltalk-specic code.
"
Copyright (C) 2015-now Jan Vrany
This code is not an open-source (yet). You may use this code
for your own experiments and projects, given that:
* all modification to the code will be sent to the
original author for inclusion in future releases
* this is not used in any commercial software
This license is provisional and may (will) change in
a future.
"
"{ Package: 'jv:llvm_s' }"
"{ NameSpace: Smalltalk }"
LLVMDisposableObject subclass:#LLVMModule
instanceVariableNames:''
classVariableNames:''
poolDictionaries:'LLVMTypeKind'
category:'LLVM-S-Core'
!
!LLVMModule class methodsFor:'documentation'!
copyright
"
Copyright (C) 2015-now Jan Vrany
This code is not an open-source (yet). You may use this code
for your own experiments and projects, given that:
* all modification to the code will be sent to the
original author for inclusion in future releases
* this is not used in any commercial software
This license is provisional and may (will) change in
a future.
"
! !
!LLVMModule class methodsFor:'instance creation'!
newWithName: name
^ LLVM ModuleCreateWithName: name
"Created: / 07-07-2015 / 20:22:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'accessing'!
dataLayoutString
^ LLVM GetDataLayout: self.
"Created: / 11-07-2015 / 06:57:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'adding & removing'!
addFunctionNamed: name type: type
self assertIsString: name.
self assert: type kind == LLVMFunctionTypeKind.
^ LLVM AddFunction: self _: name _: type.
"Created: / 07-07-2015 / 21:59:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-08-2015 / 17:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addGlobalNamed: name type: type value: value
| global |
self assertIsString: name.
self assertIsType: type.
self assertIsValue: value ofType: type.
global := LLVM AddGlobal: self _: type _: name.
LLVM SetInitializer: global _: value.
^ global
"Created: / 03-08-2015 / 16:41:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-08-2015 / 17:07:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addGlobalNamed: name value: value
^ self addGlobalNamed: name type: value type value: value
"Created: / 03-08-2015 / 16:57:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addMethodForClass: class selector: selector
| name type typeObj typeIlcPtr argTypes|
name := LLVMStXMethod llvmFunctionNameForClass: class selector: selector.
typeObj := LLVMType intptr.
typeIlcPtr := LLVMType intptr.
argTypes := LLVMObjectArray new: 4"receiver, selector, clsOrNil, pIlc" + selector numArgs.
1 to: argTypes size do:[:i |
argTypes at: i put: typeObj.
].
argTypes at: 4 put: typeIlcPtr.
type := LLVMType function: argTypes returning: typeObj.
^ LLVM AddMethod: self _: name _: type.
"Created: / 11-07-2015 / 09:37:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
getIntrinsicNamed: name types: types
self assertIsString: name.
self assertIsTypeArray: types.
^ LLVMCEXT GetIntrinsicByName: self _: name _: types size _: types asLLVMObjectArray.
"Created: / 10-08-2015 / 17:06:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'debugging'!
inspectorExtraAttributes
| d |
d := super inspectorExtraAttributes.
d add: '-llvm ir' -> [ self dumpString ].
d add: '-assembly' -> [ String streamContents:[:s | self writeAssemblyOn: s] ].
^ d
"Created: / 10-07-2015 / 14:37:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-08-2015 / 23:47:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'debugging-dumping'!
dumpOn: aStream
aStream nextPutAll: self dumpString
"Created: / 10-07-2015 / 14:32:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
dumpString
| cstr str|
cstr := LLVM PrintModuleToString: self.
str := cstr copyCStringFromHeap.
LLVM DisposeMessage: cstr.
^ str
"Created: / 10-07-2015 / 14:31:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'initialization & release'!
dispose
^ LLVM DisposeModule: self
"Modified: / 08-07-2015 / 22:40:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'inspecting'!
inspector2TabASM
<inspector2Tab>
^ (self newInspector2Tab)
label:'Assembly';
priority:49;
text: [ String streamContents:[:s | self writeAssemblyOn: s] ];
yourself
"Created: / 05-08-2015 / 23:47:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-08-2015 / 17:49:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
inspector2TabIR
<inspector2Tab>
^ (self newInspector2Tab)
label:'LLVM IR';
priority:50;
text: [ self dumpString ];
yourself
"Created: / 05-08-2015 / 23:29:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'writing-assembly'!
writeAssemblyOn: aStream
| bitcode assembly |
bitcode := Filename newTemporary.
self writeBitcodeToFile: bitcode.
assembly := bitcode withSuffix:'s'.
[
(OperatingSystem executeCommand: (LLVMConfig bindir , Filename separator , 'llc ' , bitcode pathName)) ifFalse:[
self error: 'Failed to generate assembly'.
].
aStream nextPutAll: assembly contents asString.
] ensure:[
bitcode remove.
assembly remove.
].
"Created: / 05-08-2015 / 23:46:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-08-2015 / 14:09:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule methodsFor:'writing-bitcode'!
writeBitcodeToFile: aStringOrFilename
| file path |
file := aStringOrFilename asFilename.
path := file pathName.
file exists ifTrue:[
file isWritable ifFalse:[
self error: 'File not writable (', file pathName , ')'.
^ self.
].
] ifFalse:[
| dir |
dir := file directory.
dir exists ifFalse:[
self error: 'Directory does not exists (', dir pathName , ')'.
^ self.
].
dir isWritable ifFalse:[
self error: 'Directory not writable (', dir pathName , ')'.
^ self.
]
].
LLVM WriteBitcodeToFile: self _: path.
"Created: / 05-08-2015 / 22:10:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LLVMModule class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !