--- a/Parser.st Tue Apr 18 11:28:49 2006 +0200
+++ b/Parser.st Mon Apr 24 10:51:48 2006 +0200
@@ -7104,81 +7104,107 @@
]
!
+generateCallToExternalFunction:fn lineNr:lineNr
+ |args sel node|
+
+ fn argumentTypes size ~~ methodArgNames size ifTrue:[
+ self ignorableParseError:'number of method args does not match function arg list'.
+ ].
+
+ args := (methodArgNames ? #()) collect:[:eachArgName | self nodeForMethodArg:eachArgName].
+ sel := #(
+ invoke
+ invokeWith:
+ invokeWith:with:
+ invokeWith:with:with:
+"/ invokeWith:with:with:with:
+"/ invokeWith:with:with:with:with:
+"/ invokeWith:with:with:with:with:with:
+"/ invokeWith:with:with:with:with:with:with:
+ ) at:args size+1 ifAbsent:nil.
+ sel isNil ifTrue:[
+ args := Array with:(self genMakeArrayWith:args).
+ sel := #invokeWithArguments:.
+ ].
+
+ node := MessageNode receiver:(ConstantNode type:nil value:fn) selector:sel args:args fold:false.
+ node lineNumber:lineNr.
+ tree := ReturnNode new expression:node.
+ tree lineNumber:lineNr.
+!
+
+generateReturnOfType:aType
+ |node|
+
+ node := ConstantNode type:nil value:aType.
+ node lineNumber:tokenLineNr.
+ tree := ReturnNode new expression:node.
+!
+
parseExternalFunctionCallDeclaration
- |callType cString cStream cParser returnType
- functionName argTypes moduleName fn node args sel|
-
- "callType is one of C: / cdecl: / api: / apicall:"
- callType := tokenName asSymbol.
-
+ |callType cString cStream returnType
+ functionName argTypes moduleName fn node args sel
+ type dictionaryOfKnownTypes function functionOrType lineNr|
+
+ "callType is one of c: / cdecl: / api: / apicall: ..."
+ callType := tokenName asLowercase.
+
+ lineNr := tokenLineNr.
cString := source upTo:$>.
self nextToken.
- cStream := cString readStream.
-
+
+ parseForCode ifFalse:[^ -1].
CParser isNil ifTrue:[
- self ignorableParseError:'no parser for cdecl'.
+ self ignorableParseError:'No parser for cdecl'.
+
+ args := Array with:(ConstantNode type:nil value:'External function call error - no parser for cdecl.').
+ node := MessageNode receiver:(self selfNode) selector:#error: args:args fold:false.
+ node lineNumber:lineNr.
+ tree := ReturnNode new expression:node.
+ tree lineNumber:lineNr.
^ -1
].
- callType = #'cdecl:' ifTrue:[
- cParser := CParser new.
- cParser source:cStream scannerClass:CDeclScanner.
- cParser nextToken.
- returnType := cParser type.
-
- cParser tokenType ~~ #String ifTrue:[
- self ignorableParseError:'invalid cdecl - functionName expected'.
- ^ -1
- ].
- functionName := cParser token asSymbol.
- cParser nextToken.
- argTypes := cParser parseFunctionArgumentSpec.
-
- (cParser tokenType == #Identifier and:[cParser token = #module]) ifTrue:[
- cParser nextToken.
- cParser tokenType ~~ $: ifTrue:[
- self ignorableParseError:'colon expected'.
- ^ -1
- ].
- cParser nextToken.
- cParser tokenType ~~ #String ifTrue:[
- self ignorableParseError:'invalid cdecl - moduleName expected'.
- ^ -1
+ "/ collect existing types...
+ dictionaryOfKnownTypes := Dictionary new.
+ classToCompileFor methodsDo:[:m |
+ m literalsDo:[:lit |
+ (lit isKindOf:CType) ifTrue:[
+ self assert:lit name notNil.
+ dictionaryOfKnownTypes at:lit name put:lit.
].
- moduleName := cParser token asSymbol.
- ].
- (argTypes size == 1 and:[argTypes first isCVoid]) ifTrue:[
- argTypes := #()
- ].
- argTypes size ~~ methodArgNames size ifTrue:[
- self ignorableParseError:'number of method args does not match function arg list'.
- ].
- fn := ExternalLibraryFunction
- name:functionName
- module:moduleName
- callType:callType
- returnType:returnType
- argumentTypes:argTypes asArray.
-
- args := (methodArgNames ? #()) collect:[:eachArgName | node := self nodeForMethodArg:eachArgName].
- sel := #(
- invoke
- invokeWith:
- invokeWith:with:
- invokeWith:with:with:
- invokeWith:with:with:with:
- invokeWith:with:with:with:with:
- invokeWith:with:with:with:with:with:
- invokeWith:with:with:with:with:with:with:
- ) at:args size+1 ifAbsent:nil.
- sel isNil ifTrue:[
- sel := #invokeWithArguments:.
- self halt.
-
- ].
- node := MessageNode receiver:(ConstantNode type:nil value:fn) selector:sel args:args fold:false.
- tree := ReturnNode new expression:node.
-"/ self isSyntaxHighlighter ifFalse:[ self halt ].
+ ].
+ ].
+
+ cStream := cString readStream.
+
+ (callType = 'apicall:' or:[ callType = 'cdecl:' ]) ifTrue:[
+ "/ squeak external function definition
+ self
+ parseSqueakExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
+ ].
+
+ callType = 'c:' ifTrue:[
+ "/ VW external function definition
+ self
+ parseVWTypeOrExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
+ ].
+
+ (callType = 'api:' or:[ callType = 'ole:' ]) ifTrue:[
+ "/ ST/V external function definition
+ self
+ parseSTVExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
^ -1
].
@@ -7200,8 +7226,7 @@
or a V'Age-style primitive, as '< primitive: identifier >';
(return primitive name or #Error)
- Also, ST-80 style resource specs are parsed; the result is
- left (as side effect) in primitiveResource.
+ Also, resource specs are parsed; the result is left (as side effect) in primitiveResource.
It is used to flag methods, for faster finding of used keyboard accelerators,
and to mark resource methods (image, menu or canvas resources).
@@ -7223,6 +7248,8 @@
| 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
"
+ |lcTokenName|
+
(tokenType == #Keyword or:[tokenType == #Identifier]) ifFalse:[
self parseError:'bad primitive definition (keyword expected)'.
^ #Error
@@ -7252,26 +7279,17 @@
self checkForClosingAngle.
^ nil "/ no primitive number
].
- (tokenName = 'C:') ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil "/ no primitive number
- ].
- (tokenName = 'api:') ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil "/ no primitive number
- ].
- (tokenName = 'apicall:') ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil "/ no primitive number
- ].
- (tokenName = 'cdecl:') ifTrue:[
+
+ lcTokenName := tokenName asLowercase.
+ ((lcTokenName = 'c:') "/ vw external function definition
+ or:[ lcTokenName = 'api:' "/ st/v external function definition
+ or:[ lcTokenName = 'ole:' "/ st/v external function definition
+ or:[ lcTokenName = 'apicall:' "/ squeak external function definition
+ or:[ lcTokenName = 'cdecl:' "/ squeak external function definition
+ ]]]]) ifTrue:[
self parseExternalFunctionCallDeclaration.
^ nil "/ no primitive number
].
- (tokenName = 'ole:') ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil "/ no primitive number
- ].
self ignorableParseError:'unrecognized pragma: ' , tokenName.
@@ -7364,6 +7382,174 @@
self checkForClosingAngle.
!
+parseSTVExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
+ "parses ST/V function declarations of the forms
+ '<api: ...>' and '<ole: ...>'"
+
+ |cParser callType returnType functionName argTypes moduleName type
+ function typeFromSTVTypeSpec|
+
+ 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.
+ ] ifFalse:[
+ (definitionType = 'ole:') ifTrue:[
+ callType := ExternalLibraryFunction callTypeOLE.
+ ].
+ ].
+
+ functionName := cParser token asSymbol.
+ cParser nextToken.
+
+ 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.
+
+ function := ExternalLibraryFunction
+ name:functionName
+ module:moduleName
+ callType:callType
+ returnType:returnType
+ argumentTypes:argTypes asArray.
+
+ self generateCallToExternalFunction:function lineNr:lineNr.
+!
+
+parseSqueakExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
+ "parses squeak function declarations of the forms
+ '<cdecl: ...>' and '<apicall: ...>'"
+
+ |cParser callType returnType functionName argTypes moduleName type function typeFromSqueakTypeSpec|
+
+ typeFromSqueakTypeSpec := [:tok | |e|
+ e := #(
+ (short short )
+ (long long )
+ (ushort unsignedShort )
+ (ulong unsignedLong )
+ (double double )
+ (float float )
+ (char char )
+ (void void )
+ (bool unsignedChar )
+ (byte unsignedChar )
+ ) detect:[:p | p first = tok] ifNone:nil.
+ e isNil ifTrue:[
+self halt.
+ self parseError:'ulong, ushort, or another valid Squak 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 = 'apicall:') ifTrue:[
+ callType := ExternalLibraryFunction callTypeAPI.
+ ] ifFalse:[
+ callType := ExternalLibraryFunction callTypeCDecl.
+ ].
+
+ returnType := (typeFromSqueakTypeSpec value:cParser token).
+ cParser nextToken.
+ cParser tokenType = $* ifTrue:[
+ type := CType pointerType new baseType:type.
+ cParser nextToken.
+ ].
+
+ cParser tokenType ~~ #String ifTrue:[
+ self ignorableParseError:'invalid cdecl - functionName expected'.
+ ^ nil
+ ].
+
+ functionName := cParser token asSymbol.
+ cParser nextToken.
+ cParser tokenType = $( ifFalse:[
+ self ignorableParseError:'''('' expected'.
+ ^ nil
+ ].
+ cParser nextToken.
+
+ argTypes := OrderedCollection new.
+ [cParser tokenType = $) ] whileFalse:[
+ type := typeFromSqueakTypeSpec value:cParser token.
+ cParser nextToken.
+ cParser tokenType = $* ifTrue:[
+ type := CType pointerType new baseType:type.
+ cParser nextToken.
+ ].
+
+ argTypes add:type.
+ tokenType = $, ifTrue:[
+ self nextToken
+ ]
+ ].
+
+ (cParser tokenType == #Identifier and:[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 := #()
+ ].
+
+ function := ExternalLibraryFunction
+ name:functionName
+ module:moduleName
+ callType:callType
+ returnType:returnType
+ argumentTypes:argTypes asArray.
+
+ self generateCallToExternalFunction:function lineNr:lineNr.
+!
+
parseTraditionalPrimitive
"parse everything after the initial '<primitive:'"
@@ -7405,13 +7591,15 @@
self error:'not yet implemented'.
]
].
- (tokenName = 'module:') ifTrue:[
- self nextToken.
- (tokenType == #String) ifTrue:[
+ parserFlags allowSqueakPrimitives ifTrue:[
+ (tokenName = 'module:') ifTrue:[
self nextToken.
- ] ifFalse:[
- self error:'not yet implemented'.
- ]
+ (tokenType == #String) ifTrue:[
+ self nextToken.
+ ] ifFalse:[
+ self error:'not yet implemented'.
+ ]
+ ].
].
].
@@ -7419,6 +7607,54 @@
^ primNumber
!
+parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
+ "parses visualWorks type/function declarations of the form:
+ '<c: ...>'"
+
+ |cParser callType returnType functionName argTypes moduleName type functionOrType function|
+
+ 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:[
+ functionOrType := cParser typeOrFunctionDeclaration.
+ (functionOrType isKindOf:CType) ifTrue:[
+ type := functionOrType.
+ function := nil.
+ ] ifFalse:[
+ function := functionOrType.
+ type := nil.
+ ].
+ ]
+ ].
+ cParser token notNil ifTrue:[
+ self ignorableParseError:'invalid cdecl - nothing more expected'.
+ ^ nil.
+ ].
+ type notNil ifTrue:[
+ self generateReturnOfType:type.
+ ^ self
+ ].
+
+ function := ExternalLibraryFunction
+ name:function name
+ module:nil
+ callType:callType
+ returnType:function returnType
+ argumentTypes:function argumentTypes asArray.
+
+ self generateCallToExternalFunction:function lineNr:lineNr.
+!
+
primitiveNumberFromName:aPrimitiveName
"for future compatibility with Squeak ..."
@@ -8270,7 +8506,7 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.490 2006-04-18 09:28:39 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.491 2006-04-24 08:51:48 cg Exp $'
! !
Parser initialize!