Parser.st
changeset 1780 572da5701f89
parent 1779 4cb48fc7fb17
child 1782 5f85d95bd090
--- a/Parser.st	Tue Jul 18 08:56:49 2006 +0200
+++ b/Parser.st	Tue Aug 01 16:34:20 2006 +0200
@@ -53,6 +53,13 @@
 	privateIn:Parser
 !
 
+Parser subclass:#PrimitiveSpecParser
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:Parser
+!
+
 Parser::ParseError subclass:#UndefinedSuperclassError
 	instanceVariableNames:''
 	classVariableNames:''
@@ -6991,15 +6998,17 @@
     ]
 !
 
-generateCallToExternalFunction:fn lineNr:lineNr virtualCPP:virtualCPP nonVirtualCPP:nonVirtualCPP
+generateCallToExternalFunction:fn lineNr:lineNr
     |args sel node|
 
-    fn argumentTypes size ~~ (methodArgNames size + (nonVirtualCPP ifTrue:1 ifFalse:0)) ifTrue:[
-        self ignorableParseError:'number of method args does not match function arg list'.
+    fn argumentTypes size ~~ (methodArgNames size + (fn isVirtualCPP ifTrue:1 ifFalse:0)) ifTrue:[
+        self 
+            ignorableParseError:('number of method args (%1) does not match function arg list'
+                                bindWith: methodArgNames size).
     ].
 
     args := (methodArgNames ? #()) collect:[:eachArgName | self nodeForMethodArg:eachArgName].
-    virtualCPP ifTrue:[
+    fn isVirtualCPP ifTrue:[
         sel := #(       
               invokeCPPVirtualOn: 
               invokeCPPVirtualOn:with:
@@ -7013,7 +7022,7 @@
             args := (Array with:(self selfNode)) , args.
         ].
     ] ifFalse:[
-        nonVirtualCPP ifTrue:[ 
+        fn isNonVirtualCPP ifTrue:[ 
             args := (Array with:(self selfNode)) , args
         ].
         sel := #(       
@@ -7036,6 +7045,9 @@
     node lineNumber:lineNr.
     tree := ReturnNode new expression:node.
     tree lineNumber:lineNr.
+
+    "Created: / 01-08-2006 / 13:47:44 / cg"
+    "Modified: / 01-08-2006 / 15:29:14 / cg"
 !
 
 generateReturnOfType:aType
@@ -7300,269 +7312,48 @@
 parseSTVExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
     "parses ST/V function declarations of the forms 
         '<api: functionName argType1 .. argTypeN returnType>' 
-        '<ole: functionName argType1 .. argTypeN returnType>'
-    "
-
-    |cParser callType returnType functionName argTypes moduleName type 
-     function typeFromSTVTypeSpec virtualFunctionIndex|
-
-    typeFromSTVTypeSpec := [:tok | |e|
-            e := #(
-                (short           short          )
-                (long            long           )
-                (boolean         bool           )
-                (ushort          unsignedShort  )
-                (ulong           unsignedLong   )
-                (double          double         )
-                (ulongReturn     unsignedLong   )
-                (hresult         unsignedLong   )
-                (none            void           )
-                (struct          voidPointer    )
-                (structIn        voidPointer    )
-                (structOut       voidPointer    )
-                (handle          voidPointer    )
-                ) detect:[:p | p first = tok] ifNone:nil.
-            e isNil ifTrue:[
-                self parseError:'ulong, ushort, or another valid ST/V type identifier expected (got ' , tok printString , ')'.
-                nil
-            ] ifFalse:[
-                CType perform:e second
-            ].
-    ].
-
-    cParser := CParser new.
-    cParser knownDefinitions:dictionaryOfTypesOrNil.
-    cParser allowRedefinitions:true.
-    cParser source:aStream scannerClass:CDeclScanner.
-    cParser nextToken.
-
-    (definitionType = 'api:') ifTrue:[
-        callType := ExternalLibraryFunction callTypeAPI.
-        (cParser tokenType == #Identifier) ifFalse:[
-            self parseError:'function identifier expected (got ' , cParser token printString , ')'.
-        ].
-        functionName := cParser token asSymbol.
-        cParser nextToken.
-    ] ifFalse:[ 
-        (definitionType = 'ole:') ifTrue:[
-            callType := ExternalLibraryFunction callTypeOLE.
-            (cParser tokenType == #Integer) ifFalse:[
-                self parseError:'virtual function number expected (got ' , cParser token printString , ')'.
-            ].
-            virtualFunctionIndex := cParser token.
-            cParser nextToken.
-        ] ifFalse:[ 
-            self parseError:'oops - unhandled type'.
-        ].
-    ].
-
-    argTypes := OrderedCollection new.
-    [ cParser token notNil and:[ cParser token ~~ $>] ] whileTrue:[
-        argTypes add:(typeFromSTVTypeSpec value:cParser token).
-        cParser nextToken.
-    ].
-    returnType := argTypes last.
-    argTypes := argTypes copyWithoutLast:1.
-
-    moduleName isNil ifTrue:[
-        moduleName := classToCompileFor theNonMetaclass libraryName asSymbol.
-    ].
-
-    function := ExternalLibraryFunction 
-            name:(functionName ? virtualFunctionIndex)
-            module:moduleName 
-            callType:callType
-            returnType:returnType
-            argumentTypes:argTypes asArray.
-
-    self generateCallToExternalFunction:function lineNr:lineNr virtualCPP:false nonVirtualCPP:false.
-
-    "Modified: / 21-06-2006 / 10:06:22 / cg"
+        '<ole: vFunctionIndex argType1 .. argTypeN returnType>'
+    "
+
+    |primParser function|
+
+    primParser := PrimitiveSpecParser new.
+    function := primParser 
+        parseSTVExternalFunctionDeclarationFrom:aStream 
+        definitionType:definitionType 
+        lineNr:lineNr
+        for:self.
+
+    function owningClass:classToCompileFor.
+    self generateCallToExternalFunction:function lineNr:lineNr.
+
+    "Modified: / 01-08-2006 / 16:16:53 / cg"
 !
 
 parseSqueakOrDolphinExternalFunctionDeclarationFrom:aStream definitionType:definitionType 
     knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
+
     "parses squeak/dolphin function declarations of the forms 
-        '<stdcall: [virtual] returnType functionNameOrIndex argType1..argTypeN>'
-        '<cdecl:   [virtual] returnType functionNameOrIndex argType1..argTypeN>' 
-
-        '<cdecl:   [async] [virtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >' 
-        '<apicall: [async] [virtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
-    "
-
-    |cParser callType 
-    isVirtualCall isNonVirtualCall isAsyncCall returnType functionName virtualFunctionIndex argTypes moduleName type function 
-    typeFromSqueakTypeSpec parentized thisType|
-
-    typeFromSqueakTypeSpec := [:tok | |e cls cType|
-            e := #(
-                (short           short          )
-                (long            long           )
-                (int             int            )
-                (ushort          unsignedShort  )
-                (ulong           unsignedLong   )
-                (double          double         )
-                (float           float          )
-                (char            char           )
-                (void            void           )
-                (bool            unsignedChar   )
-                (byte            unsignedChar   )
-                (dword           ulong          )
-                (sdword          long           )
-                (word            ushort         )
-                (sword           short          )
-                (handle          voidPointer    )
-                (lpstr           charPointer    )
-                (hresult         unsignedLong   )
-                ) detect:[:p | p first = tok] ifNone:nil.
-            e isNil ifTrue:[
-                cls := classToCompileFor nameSpace classNamed:tok.
-                cls isNil ifTrue:[
-                    cls := Smalltalk classNamed:tok.
-                ].
-                (cls notNil and:[cls isSubclassOf:ExternalStructure]) ifTrue:[
-                    (cType := cls cType) isNil ifTrue:[ 
-                        "/ self warning:'missing CType definition in ' , tok printString.
-                        cType := CType newStructType.
-                        cType name:cls name.
-                    ].
-                    cType
-                ] ifFalse:[
-                    self parseError:'ulong, ushort, or another valid Squeak type identifier expected (got ' , tok printString , ')'.
-                    nil
-                ]
-            ] ifFalse:[
-                CType perform:e second
-            ].
-    ].
-
-    (definitionType = 'apicall:') ifTrue:[
-        callType := ExternalLibraryFunction callTypeAPI.
-    ] ifFalse:[ 
-        callType := ExternalLibraryFunction callTypeCDecl.
-    ].
-    isVirtualCall := isNonVirtualCall := isAsyncCall := false.
-
-    cParser := CParser new.
-    cParser knownDefinitions:dictionaryOfTypesOrNil.
-    cParser allowRedefinitions:true.
-    cParser source:aStream scannerClass:CDeclScanner.
-    cParser nextToken.
-
-    (cParser tokenType == #Identifier) ifTrue:[
-        (cParser token = 'async') ifTrue:[
-            cParser nextToken.
-            isAsyncCall := true.
-            callType := (callType == ExternalLibraryFunction callTypeAPI) 
-                                ifTrue:[ callType := ExternalLibraryFunction callTypeAPIAsync ] 
-                                ifFalse:[ callType := ExternalLibraryFunction callTypeCDeclAsync ].
-        ]
-    ].
-    (cParser tokenType == #Identifier) ifTrue:[
-        (cParser token = 'virtual') ifTrue:[
-            cParser nextToken.
-            isVirtualCall := true.
-        ] ifFalse:[
-            (cParser token = 'nonVirtual') ifTrue:[
-                cParser nextToken.
-                isNonVirtualCall := true.
-            ]
-        ]
-    ].
-
-    returnType := (typeFromSqueakTypeSpec value:cParser token).
-    cParser nextToken.
-    cParser tokenType = $* ifTrue:[
-        returnType := CType pointerTypeClass new baseType:returnType.
-        cParser nextToken.
-    ].
-
-    isVirtualCall ifTrue:[
-        cParser tokenType ~~ #Integer ifTrue:[
-            self ignorableParseError:'invalid cdecl - virtual function index expected'. 
-            ^ nil
-        ].
-        virtualFunctionIndex := cParser token.
-        cParser nextToken.
-    ] ifFalse:[
-        cParser tokenType ~~ #String ifTrue:[
-            self ignorableParseError:'invalid cdecl - functionName expected'. 
-            ^ nil
-        ].
-        functionName := cParser token asSymbol.
-        cParser nextToken.
-    ].
-
-    cParser tokenType = $( ifTrue:[
-        parentized := true.
-        cParser nextToken.
-    ] ifFalse:[
-        parentized := false.
-    ].
-
-    argTypes := OrderedCollection new.
-    [ cParser tokenType == #EOF
-      or:[ parentized and:[cParser tokenType = $) ]] ] whileFalse:[
-        type := typeFromSqueakTypeSpec value:cParser token.
-        cParser nextToken.
-        cParser tokenType = $* ifTrue:[
-            type := CType pointerTypeClass new baseType:type.
-            cParser nextToken.
-        ].
-
-        argTypes add:type.
-        tokenType = $, ifTrue:[
-            self nextToken
-        ]
-    ].
-    cParser tokenType = $) ifTrue:[
-        cParser nextToken.
-    ].
-
-    (cParser tokenType == #Identifier 
-    and:[cParser token = 'module' or:[cParser token = 'module:']]) ifTrue:[
-        cParser nextToken.
-        cParser tokenType ~~ $: ifTrue:[
-            self ignorableParseError:'Colon expected'.
-            ^ nil
-        ].
-        cParser nextToken.
-
-        cParser tokenType ~~ #String ifTrue:[
-            self ignorableParseError:'Invalid declaration - moduleName expected'.
-            ^ nil
-        ].
-        moduleName := cParser token asSymbol.
-    ].
-    (argTypes size == 1 and:[argTypes first isCVoid]) ifTrue:[
-        argTypes := #()
-    ].
-
-    isNonVirtualCall ifTrue:[
-        (classToCompileFor isSubclassOf:ExternalStructure) ifTrue:[
-            (thisType := classToCompileFor cType) isNil ifTrue:[ 
-                "/ self warning:'missing CType definition in ' , tok printString.
-                thisType := CType newStructType.
-                thisType name:(classToCompileFor nameWithoutPrefix).
-                thisType := CType pointerTypeClass new baseType:thisType.
-            ].
-        ].
-        thisType := thisType ? #pointer.
-        argTypes := (Array with:thisType) , argTypes.
-    ].
-
-    moduleName isNil ifTrue:[
-        moduleName := classToCompileFor theNonMetaclass libraryName asSymbol.
-    ].
-
-    function := ExternalLibraryFunction 
-            name:(functionName ? virtualFunctionIndex)
-            module:moduleName 
-            callType:callType
-            returnType:returnType
-            argumentTypes:argTypes asArray.
-
-    self generateCallToExternalFunction:function lineNr:lineNr virtualCPP:isVirtualCall nonVirtualCPP:isNonVirtualCall.
+        '<stdcall: [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>'
+        '<cdecl:   [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>' 
+
+        '<cdecl:   [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >' 
+        '<apicall: [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
+    "
+
+    |primParser function|
+
+    primParser := PrimitiveSpecParser new.
+    function := primParser 
+        parseSqueakOrDolphinExternalFunctionDeclarationFrom:aStream 
+        definitionType:definitionType 
+        lineNr:lineNr
+        for:self.
+
+    function owningClass:classToCompileFor.
+    self generateCallToExternalFunction:function lineNr:lineNr.
+
+    "Modified: / 01-08-2006 / 16:16:57 / cg"
 !
 
 parseTraditionalPrimitive
@@ -7625,61 +7416,28 @@
     "parses visualWorks type/function declarations of the form: 
         '<c: ...>'"
 
-    |cParser callType returnType functionName argTypes moduleName type 
-     nameAndFunctionOrType functionOrType function |
+    |cParser functionOrType |
 
     CParser isNil ifTrue:[
         self generateTrapCodeForUnavailableCParser.
         ^ self.
     ].
-
-    cParser := CParser new.
-    cParser knownDefinitions:dictionaryOfTypesOrNil.
-    cParser allowRedefinitions:true.
-    cParser source:aStream scannerClass:CDeclScanner.
-    cParser nextToken.
-
-    callType := ExternalLibraryFunction callTypeC.
-    cParser tokenType == #struct ifTrue:[
-        type := cParser type.
-    ] ifFalse:[
-        cParser tokenType == #typedef ifTrue:[
-            type := cParser typedef.
-        ] ifFalse:[
-            nameAndFunctionOrType := cParser typeOrFunctionDeclaration.
-            functionOrType := nameAndFunctionOrType second.
-            functionOrType isCFunction ifFalse:[
-                type := functionOrType.
-                function := nil.
-            ] ifTrue:[
-                function := functionOrType.
-                type := nil.
-            ].
-        ]
-    ].
-    cParser token notNil ifTrue:[
-        self ignorableParseError:'invalid cdecl - nothing more expected'.
-        ^ nil.
-    ].
-    type notNil ifTrue:[
-        self generateReturnOfType:type.
+    functionOrType := PrimitiveSpecParser new
+        parseVWTypeOrExternalFunctionDeclarationFrom:aStream 
+        definitionType:definitionType 
+        knownDefinitions:dictionaryOfTypesOrNil 
+        lineNr:lineNr
+        for: self.
+
+    (functionOrType isKindOf:ExternalLibraryFunction) ifTrue:[
+        self generateReturnOfType:functionOrType.
         ^ self
     ].
 
-    moduleName isNil ifTrue:[
-        moduleName := classToCompileFor theNonMetaclass libraryName asSymbol.
-    ].
-
-    function := ExternalLibraryFunction 
-            name:function name 
-            module:moduleName 
-            callType:callType
-            returnType:function returnType
-            argumentTypes:function argumentTypes asArray.
-
-    self generateCallToExternalFunction:function lineNr:lineNr virtualCPP:false nonVirtualCPP:false.
-
-    "Modified: / 21-06-2006 / 09:59:32 / cg"
+    functionOrType owningClass:classToCompileFor.
+    self generateCallToExternalFunction:functionOrType lineNr:lineNr.
+
+    "Modified: / 01-08-2006 / 16:21:36 / cg"
 !
 
 primitiveNumberFromName:aPrimitiveName
@@ -8629,6 +8387,387 @@
     ^ startPosition
 ! !
 
+!Parser::PrimitiveSpecParser methodsFor:'initialization'!
+
+initialize
+    super initialize.
+
+    actionArray := actionArray copy.
+    actionArray at:$" codePoint put:(actionArray at:$' codePoint).
+
+    "Created: / 01-08-2006 / 14:39:24 / cg"
+! !
+
+!Parser::PrimitiveSpecParser methodsFor:'parsing'!
+
+parseSTVExternalFunctionDeclarationFrom:aStream definitionType:definitionType lineNr:lineNr for:aParserOrNil
+    "parses ST/V function declarations of the forms 
+        '<api: functionName argType1 .. argTypeN returnType>' 
+        '<ccall: functionName argType1 .. argTypeN returnType>' 
+        '<ole: vFunctionIndex argType1 .. argTypeN returnType>'
+    "
+
+    |returnType functionName argTypes type 
+     function typeFromSTVTypeSpec virtualFunctionIndex|
+
+    self source:aStream.
+    self nextToken.
+
+    (definitionType = 'ole:') ifTrue:[
+        (tokenType == #Integer) ifFalse:[
+            self parseError:'virtual function number expected (got ' , token printString , ')'.
+        ].
+        virtualFunctionIndex := token.
+        self nextToken.
+    ] ifFalse:[ 
+        (tokenType == #Identifier) ifFalse:[
+            self parseError:'function identifier expected (got ' , token printString , ')'.
+        ].
+        functionName := token asSymbol.
+        self nextToken.
+    ].
+
+    argTypes := OrderedCollection new.
+    [ token notNil and:[ token ~= '>'] ] whileTrue:[
+        argTypes add:(self typeMappingFor:token).
+        self nextToken.
+    ].
+    returnType := argTypes last.
+    argTypes := argTypes copyWithoutLast:1.
+
+    function := ExternalLibraryFunction 
+            name:(functionName ? virtualFunctionIndex)
+            module:nil 
+            returnType:returnType
+            argumentTypes:argTypes asArray.
+
+    (definitionType = 'api:') ifTrue:[
+        function beCallTypeAPI
+    ] ifFalse:[ 
+        (definitionType = 'ole:') ifTrue:[
+            function beCallTypeOLE
+        ] ifFalse:[
+            function beCallTypeC
+        ]
+    ].
+    virtualFunctionIndex notNil ifTrue:[
+        function beVirtual.
+    ].
+    ^ function
+
+    "Created: / 01-08-2006 / 16:11:24 / cg"
+!
+
+parseSqueakOrDolphinExternalFunctionDeclarationFrom:aStream definitionType:definitionType lineNr:lineNrArg for: aParserOrNil
+
+    "parses squeak/dolphin function declarations of the forms 
+        '<stdcall: [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>'
+        '<cdecl:   [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>' 
+
+        '<cdecl:   [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >' 
+        '<apicall: [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
+    "
+
+    |cParser  
+    isVirtualCall isNonVirtualCall isAsyncCall isUnlimitedStack scanningCallModifiers
+    returnType functionName virtualFunctionIndex argTypes moduleName type function 
+    parentized thisType t|
+
+    isVirtualCall := isNonVirtualCall := isAsyncCall := isUnlimitedStack := false.
+
+    "/ self knownDefinitions:dictionaryOfTypesOrNil.
+    self source:aStream.
+    lineNr := lineNrArg.
+
+    self nextToken.
+
+    scanningCallModifiers := true.    
+    [scanningCallModifiers] whileTrue:[    
+        scanningCallModifiers := false.
+        (tokenType == #Identifier) ifTrue:[
+            (token = 'async') ifTrue:[
+                self nextToken.
+                isAsyncCall := true.
+                scanningCallModifiers := true.
+            ] ifFalse:[ (token = 'virtual') ifTrue:[
+                self nextToken.
+                isVirtualCall := true.
+                scanningCallModifiers := true.
+            ] ifFalse:[  (token = 'nonVirtual') ifTrue:[
+                self nextToken.
+                isNonVirtualCall := true.
+                scanningCallModifiers := true.
+            ] ifFalse:[  (token = 'unlimitedStack') ifTrue:[
+                self nextToken.
+                isUnlimitedStack := true.
+                scanningCallModifiers := true.
+            ]]]]
+        ]
+    ].
+
+    returnType := self typeMappingFor:token.
+    self nextToken.
+    tokenType = $* ifTrue:[
+        returnType := self pointerTypeMappingFor:returnType.
+        self nextToken.
+    ].
+
+    isVirtualCall ifTrue:[
+        tokenType ~~ #Integer ifTrue:[
+            (aParserOrNil ? self) ignorableParseError:'invalid cdecl - virtual function index expected'. 
+            ^ nil
+        ].
+        virtualFunctionIndex := token.
+        self nextToken.
+    ] ifFalse:[
+        tokenType ~~ #String ifTrue:[
+            (aParserOrNil ? self) ignorableParseError:'invalid cdecl - functionName expected'. 
+            ^ nil
+        ].
+        functionName := token asSymbol.
+        self nextToken.
+    ].
+
+    tokenType = $( ifTrue:[
+        parentized := true.
+        self nextToken.
+    ] ifFalse:[
+        parentized := false.
+    ].
+
+    argTypes := OrderedCollection new.
+    [ tokenType == #EOF
+      or:[ parentized and:[tokenType = $) ]] ] whileFalse:[
+        type := self typeMappingFor:token.
+        self nextToken.
+        tokenType = $* ifTrue:[
+            type := self pointerTypeMappingFor:type.
+            self nextToken.
+        ].
+
+        argTypes add:type.
+        (tokenType = $, 
+        or:[ tokenType == #BinaryOperator and:[token = ','] ]) ifTrue:[
+            self nextToken
+        ]
+    ].
+    tokenType = $) ifTrue:[
+        self nextToken.
+    ].
+
+    ((tokenType == #Identifier and:[token = 'module'])
+    or:[tokenType == #Keyword and:[ token = 'module:']]) ifTrue:[
+        self nextToken.
+        tokenType == $: ifTrue:[
+            self nextToken.
+        ].
+
+        tokenType ~~ #String ifTrue:[
+            (aParserOrNil ? self) ignorableParseError:'Invalid declaration - moduleName expected'.
+            ^ nil
+        ].
+        moduleName := token asSymbol.
+    ].
+    (argTypes size == 1 and:[argTypes first isCVoid]) ifTrue:[
+        argTypes := #()
+    ].
+
+    isNonVirtualCall ifTrue:[
+        (classToCompileFor isSubclassOf:ExternalStructure) ifTrue:[
+            (thisType := classToCompileFor cType) isNil ifTrue:[ 
+                "/ self warning:'missing CType definition in ' , tok printString.
+                thisType := CType newStructType.
+                thisType name:(classToCompileFor nameWithoutPrefix).
+                thisType := CType pointerTypeClass new baseType:thisType.
+            ].
+        ].
+        thisType := thisType ? #pointer.
+        argTypes := (Array with:thisType) , argTypes.
+    ].
+
+    function := ExternalLibraryFunction 
+            name:(functionName ? virtualFunctionIndex)
+            module:moduleName 
+            returnType:returnType
+            argumentTypes:argTypes asArray.
+
+    (definitionType = 'apicall:') ifTrue:[
+        function beCallTypeAPI
+    ] ifFalse:[ 
+        function beCallTypeC
+    ].
+    isVirtualCall ifTrue:[
+        function beVirtualCPP
+    ].
+    isNonVirtualCall ifTrue:[
+        function beNonVirtualCPP
+    ].
+    isAsyncCall ifTrue:[
+        function beAsync
+    ].
+    isUnlimitedStack ifTrue:[
+        function beUnlimitedStack
+    ].
+    ^ function
+
+    "Created: / 01-08-2006 / 15:02:45 / cg"
+!
+
+parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr for:aParser
+    "parses visualWorks type/function declarations of the form: 
+        '<c: ...>'"
+
+    |cParser returnType functionName argTypes moduleName type 
+     nameAndFunctionOrType functionOrType function |
+
+    CParser isNil ifTrue:[
+        self generateTrapCodeForUnavailableCParser.
+        ^ self.
+    ].
+
+    cParser := CParser new.
+    cParser knownDefinitions:dictionaryOfTypesOrNil.
+    cParser allowRedefinitions:true.
+    cParser source:aStream scannerClass:CDeclScanner.
+    cParser nextToken.
+
+    cParser tokenType == #struct ifTrue:[
+        type := cParser type.
+    ] ifFalse:[
+        cParser tokenType == #typedef ifTrue:[
+            type := cParser typedef.
+        ] ifFalse:[
+            nameAndFunctionOrType := cParser typeOrFunctionDeclaration.
+            functionOrType := nameAndFunctionOrType second.
+            functionOrType isCFunction ifFalse:[
+                type := functionOrType.
+                function := nil.
+            ] ifTrue:[
+                function := functionOrType.
+                type := nil.
+            ].
+        ]
+    ].
+    cParser token notNil ifTrue:[
+        (aParser ? self) ignorableParseError:'invalid cdecl - nothing more expected'.
+        ^ nil.
+    ].
+    type notNil ifTrue:[
+        ^ type.
+    ].
+
+    moduleName isNil ifTrue:[
+        moduleName := classToCompileFor theNonMetaclass libraryName asSymbol.
+    ].
+
+    function := ExternalLibraryFunction 
+            name:function name 
+            module:moduleName 
+            returnType:function returnType
+            argumentTypes:function argumentTypes asArray.
+
+    function beCallTypeC.    
+    ^ function
+
+    "Created: / 01-08-2006 / 16:18:05 / cg"
+! !
+
+!Parser::PrimitiveSpecParser methodsFor:'parsing-primitives & pragmas'!
+
+pointerTypeMappingFor: aTypeSymbol
+    |e|
+
+    e := #(
+        (char            charPointer    )
+        (void            voidPointer    )
+    ) detect:[:p | p first = aTypeSymbol] ifNone:nil.
+    e notNil ifTrue:[
+        ^ e second
+    ].
+    ^ aTypeSymbol asSymbol
+
+    "Created: / 01-08-2006 / 15:33:53 / cg"
+!
+
+typeMappingFor:aTypeSymbol
+    |e|
+
+    e := #(
+        (short           int16          )
+        (long            int32          )
+        (int             int32          )
+        (ushort          uint16         )
+        (unsignedShort   uint16         )
+        (ulong           uint32         )
+        (unsignedLong    uint32         )
+        (double          double         )
+        (float           float          )
+        (char            char           )
+        (uchar           uint8          )
+        (unsignedChar    uint8          )
+        (void            void           )
+        (bool            bool           )
+        (byte            uint8          )
+        (dword           uint32         )
+        (sdword          int32          )
+        (word            uint16         )
+        (sword           int16          )
+        (handle          voidPointer    )
+        (lpstr           charPointer    )
+        (hresult         uint32         )
+        (boolean         bool           )
+        (ulongReturn     uint32         )
+        (none            void           )
+        (struct          voidPointer    )
+        (structIn        voidPointer    )
+        (structOut       voidPointer    )
+    ) detect:[:p | p first = aTypeSymbol] ifNone:nil.
+
+    e notNil ifTrue:[ ^ e second ].
+
+"/ the following is now done in ExternalFunction (if at all), as the ctype is not required to
+"/ be present right now, and also to allow for stc-compilation, where no
+"/ ctypes are avaliable at all.
+
+"/            e isNil ifTrue:[
+"/                cls := classToCompileFor nameSpace classNamed:tok.
+"/                cls isNil ifTrue:[
+"/                    cls := Smalltalk classNamed:tok.
+"/                ].
+"/                cls notNil ifTrue:[
+"/                    (cls isSubclassOf:ExternalStructure) ifTrue:[
+"/                        (cType := cls cType) isNil ifTrue:[ 
+"/                            "/ self warning:'missing CType definition in ' , tok printString.
+"/                            cType := CType newStructType.
+"/                            cType name:cls name.
+"/                        ].
+"/                        cType
+"/                    ] ifFalse:[
+"/                        cls
+"/                    ].
+"/                ] ifFalse:[
+"/                    self parseError:'ulong, ushort, or another valid Squeak type identifier expected (got ' , tok printString , ')'.
+"/                    nil
+"/                ]
+"/            ] ifFalse:[
+"/                e second
+"/            ].
+
+    ^ aTypeSymbol asSymbol
+
+    "Created: / 01-08-2006 / 15:35:52 / cg"
+! !
+
+!Parser::PrimitiveSpecParser methodsFor:'reading next token'!
+
+isCommentCharacter:ch
+    "no comments"
+
+    ^ false
+
+    "Created: / 01-08-2006 / 14:54:48 / cg"
+! !
+
 !Parser::UndefinedVariableNotification methodsFor:'accessing'!
 
 description
@@ -8654,7 +8793,7 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.509 2006-07-18 06:56:49 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.510 2006-08-01 14:34:20 cg Exp $'
 ! !
 
 Parser initialize!