"

    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 assert: name isSingleByteString.

    self assert: type kind == LLVMFunctionTypeKind.

    ^ LLVM AddFunction: self _: name _: type.

    "Created: / 07-07-2015 / 21:59:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

addGlobalNamed: name type: type value: value

    | global |

    self assert: name isSingleByteString.

    self assert:(type isKindOf: LLVMType).

    self assert:(value isKindOf: LLVMValue).

    self assert:(value type kind == type kind).

    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>"

!

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>"

! !

!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:50;

        text: [ String streamContents:[:s | self writeAssemblyOn: s] ];

        yourself

    "Created: / 05-08-2015 / 23:47:17 / 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> $'

! !