"{ Package: 'cvut:fel/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:'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;
            tab; 
                nextPutAll: 'OperatingSystem isUNIXlike ifTrue:[^';
                nextPutAll: unixLibraryName storeString;
                nextPutAll: '].';
                cr; cr;
            tab; 
                nextPutAll: 'OperatingSystem isMSWINDOWSlike ifTrue:[^';
                nextPutAll: win32LibraryName storeString;
                nextPutAll: '].';
                cr; cr;
            tab;
                nextPutAll:'self error:''Library name for host OS is not known'''.

        ]

    "Created: / 10-07-2008 / 09:04:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

sourceForPrimitive:functionNode 
    ^ (String 
        streamContents:[:s | 
            s nextPutAll:functionNode 
                        smalltalkPrimitiveSelectorIterlacedWithArgumentNames.
            s
                cr;
                cr;
                tab;
                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;
                tab.
            s nextPutAll:'self primitiveFailed'.
        ])

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

visitCEnumNode: cEnumNode

    cEnumNode shouldBeIgnored ifTrue:[^self].

    (changeset add: ClassDefinitionChange new)
        superClassName: 
            SharedPool fullName;
        nameSpaceName: 
            cEnumNode smalltalkNamespace;
        className: 
            cEnumNode smalltalkClassName;
        classVariableNames:
            (String streamContents:
                [:s|
                cEnumNode values do:
                    [:cEnumValueNode|
                    s nextPutAll: cEnumValueNode smalltalkName; space]]);
        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 
                        tab; 
                        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 tab; 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>"
!

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 |

    cStructNode shouldBeIgnored ifTrue:[^self].

    smalltalkClass := Smalltalk at: cStructNode smalltalkClassNameWithNamespace ifAbsent:[nil].
    smalltalkClass 
        ifNil:
            [(changeset add: ClassDefinitionChange new)
                superClassName: 
                    ExternalStructure fullName;
                nameSpaceName: 
                    cStructNode smalltalkNamespace;
                className: 
                    cStructNode smalltalkClassName;
                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') 
                    asSymbol;
        category:'accessing';
        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: / 22-02-2009 / 15:05:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
!

visitCTypedefNode: typedefNode

    "Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.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
    ^ '$Header: /opt/data/cvs/cvut-fel/cface/Cface__SmalltalkXGenerator.st,v 1.1 2008/02/26 18:25:12 vranyj1 Exp $'
!

version_SVN
    ^ '$Id$'
! !