"{ 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 isForeign ifTrue:[^self].

    (changeset add: ClassDefinitionChange new)

        superClassName: 

            SharedPool fullName;

        className: 

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

!

visitCFunctionNode:functionNode 

    (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: / 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';

        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: / 10-07-2008 / 08:46:29 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

visitCStructuredNode: cStructNode

    | smalltalkClass |

    cStructNode foreign ifTrue:[^self].

    cStructNode isAnonymous ifTrue:[^self].

    smalltalkClass := Smalltalk at: cStructNode smalltalkClassNameWithNamespace ifAbsent:[nil].

    smalltalkClass 

        ifNil:

            [(changeset add: ClassDefinitionChange new)

                superClassName: 

                    ExternalStructure fullName;

                className: 

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

!

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

! !