[squeak-dev] The Trunk: Compiler-mt.437.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jun 14 06:04:26 UTC 2020


Marcel Taeumel uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-mt.437.mcz

==================== Summary ====================

Name: Compiler-mt.437
Author: mt
Time: 13 June 2020, 11:01:44.448351 am
UUID: ca2e1da8-da26-a840-ae3e-1822ce8ba67d
Ancestors: Compiler-mt.436

Speed-up method-based hook for custom pragma-parsing methods. Like in ShoutCore-mt.79

=============== Diff against Compiler-mt.435 ===============

Item was removed:
- ----- Method: Parser>>externalFunctionDeclaration (in category 'primitives') -----
- externalFunctionDeclaration
- 	"Parse the function declaration for a call to an external library."
- 	| descriptorClass callType modifier retType externalName args argType module fn |
- 	descriptorClass := cue environment
- 		valueOf: #ExternalFunction 
- 		ifAbsent: [^ false].
- 	callType := descriptorClass callingConventionFor: here.
- 	callType == nil ifTrue:[^false].
- 	[modifier := descriptorClass callingConventionModifierFor: token.
- 	 modifier notNil] whileTrue:
- 		[self advance.
- 		 callType := callType bitOr: modifier].
- 	"Parse return type"
- 	self advance.
- 	retType := self externalType: descriptorClass.
- 	retType == nil ifTrue:[^self expected:'return type'].
- 	"Parse function name or index"
- 	externalName := here.
- 	(self match: #string) 
- 		ifTrue:[externalName := externalName asSymbol]
- 		ifFalse:[(self match:#number) ifFalse:[^self expected:'function name or index']].
- 	(self match: #leftParenthesis) ifFalse:[^self expected:'argument list'].
- 	args := WriteStream on: Array new.
- 	[self match: #rightParenthesis] whileFalse:[
- 		argType := self externalType: descriptorClass.
- 		argType == nil ifTrue:[^self expected:'argument'].
- 		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]].
- 	(self matchToken: 'module:') ifTrue:[
- 		module := here.
- 		(self match: #string) ifFalse:[^self expected: 'String'].
- 		module := module asSymbol].
- 	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn|
- 		fn := xfn name: externalName 
- 				module: module 
- 				callType: callType
- 				returnType: retType
- 				argumentTypes: args contents.
- 		encoder litIndex: fn.
- 		fn beWritableObject. "Undo the read-only setting in litIndex:"].
- 	(self matchToken: 'error:')
- 		ifTrue:
- 			[| errorCodeVariable |
- 			 errorCodeVariable := here.
- 			(hereType == #string
- 			 or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)'].
- 			 self advance.
- 			 self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)).
- 			 fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]]
- 		ifFalse:
- 			[self addPragma: (Pragma keyword: #primitive: arguments: #(120))].
- 	^true!

Item was removed:
- ----- Method: Parser>>externalType: (in category 'primitives') -----
- externalType: descriptorClass
- 	"Parse and return an external type"
- 	| xType typeName |
- 	typeName := here. "Note that pointer token is not yet parsed!!"
- 	(xType := descriptorClass typeNamed: typeName)
- 		ifNil: [
- 			"Raise an error if user is there"
- 			self interactive ifTrue: [^nil].
- 			"otherwise go over it silently -- use an unknown struct type"
- 			xType := descriptorClass newTypeNamed: here].
- 	self advance.
- 	^ (self matchToken: #*)
- 		ifTrue:[xType asPointerType]
- 		ifFalse:[(self matchToken: #**)
- 			ifTrue: [xType asPointerToPointerType]
- 			ifFalse: [xType]]!

Item was changed:
  ----- Method: Parser>>pragmaStatement (in category 'pragmas') -----
  pragmaStatement
+ 	"Read a single pragma statement. Dispatch to the first available pragma parser using the current token as a simple getter to be called on self. If no pragma parser can be found, parse it as usual in the keywords form.
- 	"Read a single pragma statement. Parse all generic pragmas in the form of: <key1: val1 key2: val2 ...> and remember them, including primitives."
  	
+ 	Note that custom pragma parsers need to fulfill two requirements:
+ 		(1) method selector must match the current token as simple getter,
+ 				e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive
+ 		(2) method must declare <pragmaParser> to be called.
+ 	This is for the protection of the parser's (message) namespace."
+ 	
+ 	| parserSelector |
- 	| selector arguments words index keyword |
  	(hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ])
  		ifFalse: [  ^ self expected: 'pragma declaration' ].
  
+ 	(here last == $:
+ 		and: [(parserSelector := Symbol lookup: here allButLast) notNil])
+ 			ifFalse: ["Quick exit to not break one-word pragmas such as <primitive> and <foobar>; also avoid interning new symbols for made-up pragmas such as for <my: 1 new: 2 pragma: 3> not interning #my."
+ 				^ self pragmaStatementKeywords].
- 	" This is a ugly hack into the compiler of the FFI package. FFI should be changed to use propre pragmas that can be parsed with the code here. "
- 	(here = #apicall: or: [ here = #cdecl: ])
- 		ifTrue: [ ^ self externalFunctionDeclaration ].
  
+ 	self class methodDict
+ 		at: parserSelector
+ 		ifPresent: [:parserMethod |
+ 			(parserMethod pragmas
+ 				anySatisfy: [:pragma | pragma keyword == #pragmaParser])
+ 					ifTrue: [^ self executeMethod: parserMethod]].
+ 
+ 	^ self pragmaStatementKeywords!
- 	selector := String new.
- 	arguments := OrderedCollection new.
- 	words := OrderedCollection new.
- 	[ hereType = #keyword or: [ (hereType = #word or: [ hereType = #binary ]) and: [ selector isEmpty ] ] ] whileTrue: [
- 		index := self startOfNextToken + requestorOffset.
- 		selector := selector , self advance.
- 		words add: (index to: self endOfLastToken + requestorOffset).
- 		(selector last = $: or: [ selector first isLetter not ])
- 			ifTrue: [ arguments add: (self pragmaLiteral: selector) ] ].
- 	selector numArgs ~= arguments size
- 		ifTrue: [ ^ self expected: 'pragma argument' ].
- 	(Symbol hasInterned: selector 
- 		ifTrue: [ :value | keyword := value]) 
- 		ifFalse: [ 
- 			keyword := self 
- 				correctSelector: selector wordIntervals: words
- 				exprInterval: (words first first to: words last last)
- 				ifAbort: [ ^ self fail ] ].
- 	self addPragma: (Pragma keyword: keyword arguments: arguments asArray).
- 	^ true!

Item was added:
+ ----- Method: Parser>>pragmaStatementKeywords (in category 'pragmas') -----
+ pragmaStatementKeywords
+ 	"Read a single pragma statement. Parse all generic pragmas in the form of: <key1: val1 key2: val2 ...> and remember them, including primitives."
+ 	
+ 	| selector arguments words index keyword |
+ 	selector := String new.
+ 	arguments := OrderedCollection new.
+ 	words := OrderedCollection new.
+ 	[ hereType = #keyword or: [ (hereType = #word or: [ hereType = #binary ]) and: [ selector isEmpty ] ] ] whileTrue: [
+ 		index := self startOfNextToken + requestorOffset.
+ 		selector := selector , self advance.
+ 		words add: (index to: self endOfLastToken + requestorOffset).
+ 		(selector last = $: or: [ selector first isLetter not ])
+ 			ifTrue: [ arguments add: (self pragmaLiteral: selector) ] ].
+ 	selector numArgs ~= arguments size
+ 		ifTrue: [ ^ self expected: 'pragma argument' ].
+ 	(Symbol hasInterned: selector 
+ 		ifTrue: [ :value | keyword := value]) 
+ 		ifFalse: [ 
+ 			keyword := self 
+ 				correctSelector: selector wordIntervals: words
+ 				exprInterval: (words first first to: words last last)
+ 				ifAbort: [ ^ self fail ] ].
+ 	self addPragma: (Pragma keyword: keyword arguments: arguments asArray).
+ 	^ true!

Item was added:
+ ----- Method: Parser>>primitive (in category 'primitives') -----
+ primitive
+ 	"Pragmas that encode primitive calls are parsed as normal keyword pragmas. This hook exists so that packages do not break primitive-pragma parsing by accident. Instead, this method needs to be replaced intentionally.
+ 	
+ 	Note that primitive pragmas are special because they will be called back from the parser into the parser. See #pragmaPrimitives.
+ 	
+ 	Examples:
+ 		<primitive: 42>
+ 		<primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'>
+ 		<primitive: 'primitiveRegisterExternalFill' module: 'B2DPlugin' error: errorCode>"
+ 
+ 	<pragmaParser>
+ 	^ self pragmaStatementKeywords!



More information about the Squeak-dev mailing list