"

    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 LLVMVerifierFailureAction'

	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:'utilities'!

verify

    "Verifies that a module is valid. If yes, this method is no-op.

     If false, throws LLVMModuleVerificationError."

    | msgPtr msg |

    msgPtr := ExternalBytes new: ExternalBytes sizeofPointer.

    (LLVM VerifyModule: self _: LLVMReturnStatusAction _: msgPtr) ifTrue:[

        msg := (msgPtr pointerAt: 1) copyCStringFromHeap.

        LLVM DisposeMessage: (msgPtr pointerAt: 1).

        LLVMModuleVerificationError signal: msg.  

    ].

    "Created: / 18-06-2016 / 15:48:28 / 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> $'

! !