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

new
    ^ self newWithName: 'm'

    "Created: / 03-09-2015 / 06:41:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

newWithName: aString
    
    self assertIsString: aString.
    ^ LLVM ModuleCreateWithName: aString

    "Created: / 07-07-2015 / 20:22:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 14-09-2015 / 10:39:38 / 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>"
!

debugInfoBuilder
    ^ LLVMDIBuilder newForModule: self

    "Created: / 13-08-2015 / 06:35:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

getFunctionNamed: name 
    self assertIsString: name. 

    ^ LLVM GetNamedFunction: self  _: name.

    "Created: / 02-09-2015 / 22:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 18-09-2015 / 06:15:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

getIntrinsicNamed: name 
    ^ self getIntrinsicNamed: name types: #().

    "Created: / 14-08-2015 / 14:10:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-09-2015 / 06:35:26 / 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>"
    "Modified (format): / 18-09-2015 / 06:15:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!LLVMModule methodsFor:'adding & removing'!

addFlag: key value: value behavior: behavior
    self assertIsString: key.
    self assertIsMetadata: value.
    self assertIsIntegerUnsigned: behavior.

    LLVMCEXT ModuleAddModuleFlag: self _: behavior _: key _: value

    "Created: / 15-08-2015 / 06:58:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 15-08-2015 / 22:06:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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: / 18-09-2015 / 06:15:29 / 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>"
! !

!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'.  
    [ 
        | errorOutput |

        errorOutput := String new writeStream.
        (OperatingSystem executeCommand: (LLVMConfig bindir , Filename separator , 'llc ' , bitcode pathName) errorTo: errorOutput) ifTrue:[
            aStream nextPutAll: assembly contents asString.
        ] ifFalse:[ 
            aStream nextPutAll: 'Failed to generate assembly:'; cr; cr.
            aStream nextPutAll: errorOutput contents
        ].
    ] ensure:[ 
        bitcode remove.
        assembly remove.
    ].

    "Created: / 05-08-2015 / 23:46:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-09-2015 / 18:21:59 / 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> $'
! !