--- a/Cface__SmalltalkXGenerator.st Tue Sep 09 15:15:50 2008 +0000
+++ b/Cface__SmalltalkXGenerator.st Tue Sep 09 21:17:04 2008 +0000
@@ -123,6 +123,65 @@
])
"Created: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+sourceForStructFieldGetter:field
+ ^ (String
+ streamContents:[:s |
+ s
+ nextPutAll:(field smalltalkName);
+ cr;
+ cr;
+ tab;
+ 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>"
+!
+
+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;
+ tab;
+ 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>"
+!
+
+sourceForStructSize: size
+
+ ^String streamContents:
+ [:s|
+ s
+ nextPutAll: 'structSize'; cr; cr;
+ tab;
+ nextPutAll: '^';
+ nextPutAll: size printString
+ ]
+
+ "Created: / 09-09-2008 / 17:12:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!SmalltalkXGenerator methodsFor:'visiting'!
@@ -198,39 +257,19 @@
"Modified: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-visitCStructFieldNode:field
-
- (changeset add: MethodDefinitionChange new)
- className: (field owner smalltalkClassNameWithNamespace) asSymbol;
- category: 'accessing - primitives';
- selector: ('prim' , field smalltalkName capitalized);
- source:
- (String streamContents:
- [:s|
- s
- nextPutAll:('prim' , field smalltalkName capitalized); cr; cr;
- tab; nextPutAll: 'self'; space;
- nextPutAll: field smalltalkxValueExtractionSelector;
- nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString]).
+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)
- (changeset add: MethodDefinitionChange new)
- className: (field owner smalltalkClassNameWithNamespace) asSymbol;
- category: 'accessing - primitives';
- selector: ('prim' , field smalltalkName capitalized, ':') asSymbol;
- source:
- (String streamContents:
- [:s|
- s
- nextPutAll:('prim' , field smalltalkName capitalized, ':') asSymbol;
- space; nextPutAll: 'value'; cr; cr;
- tab; nextPutAll: 'self'; space;
- nextPutAll: field smalltalkxValueSettingSelector keywords first;
- nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString; space;
- nextPutAll: field smalltalkxValueSettingSelector keywords second;
- nextPutAll: 'value'])
-
- "Created: / 09-07-2008 / 21:32:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 10-07-2008 / 07:43:54 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 09-09-2008 / 21:39:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
visitCStructNode: cStructNode
@@ -243,19 +282,28 @@
visitCStructuredNode: cStructNode
+ | smalltalkClass |
+
cStructNode foreign ifTrue:[^self].
cStructNode isAnonymous ifTrue:[^self].
- (changeset add: ClassDefinitionChange new)
- superClassName:
- ExternalStructure fullName;
- className:
- cStructNode smalltalkClassNameWithNamespace;
- category:
- cStructNode smalltalkCategory;
- package:
- cStructNode smalltalkPackage.
+ smalltalkClass := Smalltalk at: cStructNode smalltalkClassNameWithNamespace ifAbsent:[nil].
+ smalltalkClass
+ ifNil:
+ [(changeset add: ClassDefinitionChange new)
+ superClassName:
+ ExternalStructure fullName;
+ className:
+ cStructNode smalltalkClassNameWithNamespace;
+ category:
+ cStructNode smalltalkCategory;
+ package:
+ cStructNode smalltalkPackage]
+ ifNotNil:
+ [(smalltalkClass inheritsFrom: ExternalStructure)
+ ifFalse:
+ [self error:'Class ',smalltalkClass fullName,' should inherit from ExternalStructure']].
(changeset add:MethodDefinitionChange new)
className:(cStructNode smalltalkClassNameWithNamespace , ' class')
@@ -264,10 +312,18 @@
selector:#libraryName;
source:(self sourceForLibraryName).
+ (changeset add:MethodDefinitionChange new)
+ className:(cStructNode smalltalkClassNameWithNamespace , ' class')
+ asSymbol;
+ category:'accessing';
+ selector:#structSize;
+ source:(self sourceForStructSize: cStructNode cByteSize).
+
cStructNode fields do:
[:fieldNode|self visit: fieldNode]
"Created: / 10-07-2008 / 08:46:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 09-09-2008 / 20:12:35 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
visitCTypedefNode: typedefNode