The Inbox: Compiler-mt.436.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

The Inbox: Compiler-mt.436.mcz

commits-2
A new version of Compiler was added to project The Inbox:
http://source.squeak.org/inbox/Compiler-mt.436.mcz

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

Name: Compiler-mt.436
Author: mt
Time: 12 June 2020, 9:44:51.105703 am
UUID: 2f141bd8-8dd0-0d4a-a053-e9e006c7dde7
Ancestors: Compiler-mt.435

Adds a (extension) method-based hook to install custom pragma-parsing methods. Use it to move FFI-specific pragma-parsing, i.e. <apicall: ...> and <cdecl: ...>, into FFI packages.

Redirects parsing of <primitive: ...> to document the hook.

=============== 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 parserMethod |
- | selector arguments words index keyword |
  (hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ])
  ifFalse: [  ^ self expected: 'pragma declaration' ].
 
+ (self class includesSelector: (parserSelector := here asSimpleGetter)) ifTrue: [
+ ((parserMethod := self class compiledMethodAt: parserSelector) pragmas
+ anySatisfy: [:pragma | pragma keyword == #pragmaParser])
+ ifTrue: [^ self executeMethod: parserMethod]].
- " 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 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!


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Compiler-mt.436.mcz

marcel.taeumel
Hi all!

If nobody speaks up until tomorrow, I would like to move this to Trunk. ^___^ Sorry for the short notice.

Even if you agree with the basic mechanism, please feel free to suggest names for the pragma in the methods that direct pragma parsing. I chose <pragmaParser> for now.

Best,
Marcel

Am 12.06.2020 09:45:02 schrieb [hidden email] <[hidden email]>:

A new version of Compiler was added to project The Inbox:
http://source.squeak.org/inbox/Compiler-mt.436.mcz

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

Name: Compiler-mt.436
Author: mt
Time: 12 June 2020, 9:44:51.105703 am
UUID: 2f141bd8-8dd0-0d4a-a053-e9e006c7dde7
Ancestors: Compiler-mt.435

Adds a (extension) method-based hook to install custom pragma-parsing methods. Use it to move FFI-specific pragma-parsing, i.e. and , into FFI packages.

Redirects parsing of to document the hook.

=============== 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: 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., matches #apicall or matches #primitive
+ (2) method must declare to be called.
+ This is for the protection of the parser's (message) namespace."
+
+ | parserSelector parserMethod |
- | selector arguments words index keyword |
(hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ])
ifFalse: [ ^ self expected: 'pragma declaration' ].

+ (self class includesSelector: (parserSelector := here asSimpleGetter)) ifTrue: [
+ ((parserMethod := self class compiledMethodAt: parserSelector) pragmas
+ anySatisfy: [:pragma | pragma keyword == #pragmaParser])
+ ifTrue: [^ self executeMethod: parserMethod]].
- " 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 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: 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:
+
+
+ "
+
+
+ ^ self pragmaStatementKeywords!




Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Compiler-mt.436.mcz

K K Subbu
In reply to this post by commits-2
On 12/06/20 7:44 am, [hidden email] wrote:

> + ----- 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>
Marcel,

Why should the parser treat primitive keywords differently from other
keywords? Why not let primitives also be handled like any other pragma
and have the handler return a flag to let the parser treat the pragma as
a primitive/nonprimitive?

It just occurred to me (strawman alert!) that the parser could parse
    <primitive: 42>
as
    <primitive: 'prim42' module: 'primitivePlugin'>

It will allow us to switch primitive tables at run time without
recompiling the VM.

Regards .. Subbu

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Compiler-mt.436.mcz

marcel.taeumel
Hi Subbu.

> Why should the parser treat primitive keywords differently from other
> keywords? Why not let primitives also be handled like any other pragma
> and have the handler return a flag to let the parser treat the pragma as
> a primitive/nonprimitive?

From this point in #primitive, you can emit whatever you like while parsing the pragma that started with <primitive...>. If you parse <primitive: 42> as <primitive: 'prim42' module: 'primitivePlugin'>, then the callback will go to #primitive:module:. :-)

> It will allow us to switch primitive tables at run time without recompiling the VM.

That's unrelated. You can point to another primitive just by recompiling methods. No need to recompile the VM. ;-)

Best,
Marcel

Am 12.06.2020 13:23:05 schrieb K K Subbu <[hidden email]>:

On 12/06/20 7:44 am, [hidden email] wrote:

> + ----- 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:
> +
> +
> + "
> +
> +
Marcel,

Why should the parser treat primitive keywords differently from other
keywords? Why not let primitives also be handled like any other pragma
and have the handler return a flag to let the parser treat the pragma as
a primitive/nonprimitive?

It just occurred to me (strawman alert!) that the parser could parse

as


It will allow us to switch primitive tables at run time without
recompiling the VM.

Regards .. Subbu