LLVM bindings: allow to specify path to llvm-config
..by setting LLVM_CONFIG variable when generating definitions
for LLVM bindings. Example:
make LVM_CONFIG=~/Projects/LLVM/sources1/build/Debug+Asserts/bin/llvm-config
"{ Package: 'jv:cface' }"
"{ NameSpace: Cface }"
Generator subclass:#SmalltalkXGenerator
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Cface-Generators'
!
!SmalltalkXGenerator class methodsFor:'instance creation'!
new
^ self basicNew initialize.
"Created: / 08-02-2008 / 08:55:08 / janfrog"
! !
!SmalltalkXGenerator methodsFor:'private'!
generateClassForPointerType:cStructNode
| smalltalkClass |
smalltalkClass := Smalltalk at: cStructNode smalltalkClassNameWithNamespace ifAbsent:[nil].
smalltalkClass isNil ifTrue:[
(changeset add: ClassDefinitionChange new)
superClassName: ExternalAddress fullName;
nameSpaceName: cStructNode smalltalkNamespace;
className: cStructNode smalltalkClassName;
category: cStructNode smalltalkCategory;
package: cStructNode smalltalkPackage.
] ifFalse:[
(smalltalkClass inheritsFrom: ExternalAddress) ifFalse:
[self error:'Class ',smalltalkClass fullName,' should inherit from ExternalAddress']
].
"Modified: / 06-07-2015 / 18:04:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SmalltalkXGenerator methodsFor:'processing'!
process: node
super process: node.
^changeset
"Created: / 03-07-2008 / 21:01:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!SmalltalkXGenerator methodsFor:'sources'!
sourceForLibraryName
^String streamContents:
[:s|
s
nextPutAll: 'libraryName'; cr; cr;
tab4;
nextPutAll: 'OperatingSystem isUNIXlike ifTrue:[^';
nextPutAll: unixLibraryName storeString;
nextPutAll: '].';
cr; cr;
tab4;
nextPutAll: 'OperatingSystem isMSWINDOWSlike ifTrue:[^';
nextPutAll: win32LibraryName storeString;
nextPutAll: '].';
cr; cr;
tab4;
nextPutAll:'self error:''Library name for host OS is not known'''.
]
"Created: / 10-07-2008 / 09:04:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 05-09-2012 / 11:48:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourceForPrimitive:functionNode
^ (String
streamContents:[:s |
s nextPutAll: functionNode smalltalkPrimitiveSelectorIterlacedWithArgumentNames.
s cr; tab4.
s nextPut: $"; nextPutAll: functionNode comment; nextPut: $".
s
cr;
cr;
tab4;
nextPutAll:'<cdecl:';
space;
nextPutAll:functionNode return ffiTypeSymbol;
space;
nextPut:$";
nextPutAll:functionNode cName;
nextPut:$";
space;
nextPut:$(;
space.
functionNode arguments do:[:argument |
s
nextPutAll:argument type ffiTypeSymbol;
space
].
s
nextPut:$);
space.
s nextPut:$>.
s
cr;
tab4.
s nextPutAll:'self primitiveFailed'.
])
"Created: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 06-07-2015 / 07:35:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourceForSizeof: size
^String streamContents:
[:s|
s
nextPutAll: 'sizeof'; cr;
tab4; nextPutAll:'"Returns size of undelaying structure in bytes"'; cr;
cr;
tab4;
nextPutAll: '^';
nextPutAll: size printString
]
"Created: / 28-12-2014 / 21:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourceForStructFieldGetter:field
^ (String
streamContents:[:s |
s
nextPutAll:(field smalltalkName);
cr;
tab4; nextPutAll:'"Returns '; nextPutAll: field type printString; nextPutAll: '"';
cr;
cr;
tab4;
nextPutAll:'^self';
space;
nextPutAll:field stxStructFieldGetterSelector;
nextPutAll:'1 + ';
nextPutAll:(field offset / 8) printString
])
"Created: / 09-09-2008 / 21:25:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 05-09-2012 / 11:52:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourceForStructFieldSetter:field
field isCPointerToCStructure ifTrue:
[self halt: 'Finish creation of ExternalStructure here'].
^ (String
streamContents:[:s |
s
nextPutAll:(field smalltalkName , ':') asSymbol;
space;
nextPutAll:'value';
cr;
cr;
tab4;
nextPutAll:'self';
space;
nextPutAll:field stxStructFieldSetterSelector keywords first;
nextPutAll:'1 + ';
nextPutAll:(field offset / 8) printString;
space;
nextPutAll:field stxStructFieldSetterSelector keywords second;
nextPutAll:'value'
])
"Created: / 09-09-2008 / 21:26:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 05-09-2012 / 11:48:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SmalltalkXGenerator methodsFor:'visiting'!
visitCEnumNode: cEnumNode
| cdc |
cEnumNode shouldBeIgnored ifTrue:[^self].
(changeset add: (cdc := ClassDefinitionChange new))
superClassName:
SharedPool fullName;
nameSpaceName:
cEnumNode smalltalkNamespace;
className:
cEnumNode smalltalkClassName;
classVariableNames:
(cEnumNode values collect: [ :e | e smalltalkName ]);
category:
cEnumNode smalltalkCategory;
package:
cEnumNode smalltalkPackage.
(changeset add: MethodDefinitionChange new)
className:
cEnumNode smalltalkClassNameWithNamespace, ' class';
selector:
#initialize;
category:
#initialization;
source:
(String streamContents:
[:s|
s nextPutAll:'initialize' ; cr; cr.
cEnumNode values do:
[:cEnumValueNode|
s
tab4;
nextPutAll: cEnumValueNode smalltalkName;
nextPutAll: ' := ';
nextPutAll: cEnumValueNode intValue;
nextPut:$.; cr]]).
cEnumNode values do:
[:cEnumValueNode|
(changeset add: MethodDefinitionChange new)
className:
cEnumNode smalltalkClassNameWithNamespace, ' class';
selector:
cEnumValueNode cName asSymbol;
category:
#constants;
source:
(String streamContents:
[:s|
s nextPutAll: cEnumValueNode smalltalkName; cr; cr.
s tab4; nextPut:$^; nextPutAll: cEnumValueNode smalltalkName])]
"Created: / 03-07-2008 / 20:10:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-02-2009 / 15:03:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 30-06-2015 / 14:21:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitCFunctionNode:functionNode
functionNode shouldBeIgnored ifTrue:[^self].
(changeset add:MethodDefinitionChange new)
className:(functionNode smalltalkClassNameWithNamespace , ' class')
asSymbol;
category:'primitives';
selector:functionNode smalltalkPrimitiveSelector;
source:(self sourceForPrimitive:functionNode).
"Created: / 03-07-2008 / 21:26:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-02-2009 / 15:05:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
visitCStructFieldNode:field
(changeset add:MethodDefinitionChange new)
className:(field owner smalltalkClassNameWithNamespace) asSymbol;
category:'accessing';
selector:(field smalltalkName) asSymbol;
source:(self sourceForStructFieldGetter:field).
(changeset add:MethodDefinitionChange new)
className:(field owner smalltalkClassNameWithNamespace) asSymbol;
category:'accessing';
selector:(field smalltalkName , ':') asSymbol;
source:(self sourceForStructFieldSetter:field)
"Modified: / 09-09-2008 / 21:39:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
visitCStructNode: cStructNode
self visitCStructuredNode: cStructNode
"Created: / 03-07-2008 / 21:31:31 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-02-2009 / 22:04:31 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
visitCStructuredNode: cStructNode
| smalltalkClass cdc |
cStructNode shouldBeIgnored ifTrue:[^self].
smalltalkClass := Smalltalk at: cStructNode smalltalkClassNameWithNamespace ifAbsent:[nil].
smalltalkClass
ifNil:
[(changeset add: (cdc := ClassDefinitionChange new))
superClassName:
(cStructNode byteSize == 0
ifTrue:[ExternalAddress fullName]
ifFalse:[ExternalStructure fullName]);
nameSpaceName:
cStructNode smalltalkNamespace;
className:
cStructNode smalltalkClassName;
category:
cStructNode smalltalkCategory;
package:
cStructNode smalltalkPackage.]
ifNotNil:
[((smalltalkClass inheritsFrom: ExternalStructure) or:[(smalltalkClass inheritsFrom: ExternalAddress)])
ifFalse:
[self error:'Class ',smalltalkClass fullName,' should inherit from ExternalStructure or ExternalAddress']].
(changeset add:MethodDefinitionChange new)
className:(cStructNode smalltalkClassNameWithNamespace , ' class')
asSymbol;
category:'accessing';
selector:#libraryName;
source:(self sourceForLibraryName).
(changeset add:MethodDefinitionChange new)
className:(cStructNode smalltalkClassNameWithNamespace , ' class')
asSymbol;
category:'accessing';
selector:#sizeof;
source:(self sourceForSizeof: cStructNode cByteSize).
cStructNode fields do:
[:fieldNode|self visit: fieldNode]
"Created: / 10-07-2008 / 08:46:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-02-2009 / 15:05:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 28-12-2014 / 21:33:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitCTypedefNode: cTypedefNode
cTypedefNode type isCStructuredNode ifTrue:[
self visitCStructuredNode: cTypedefNode.
^ self
].
cTypedefNode type isCPointerNode ifTrue:[
self generateClassForPointerType: cTypedefNode.
].
"Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 06-07-2015 / 18:01:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitCUnionNode: cStructNode
self visitCStructuredNode: cStructNode
"Created: / 09-07-2008 / 22:30:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 10-07-2008 / 08:46:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!SmalltalkXGenerator class methodsFor:'documentation'!
version
^ '$Id$'
!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '$Id$'
! !