[Vm-dev] VM Maker: VMMakerCompatibilityForPharo6-GuillermoPolito.13.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed May 22 09:39:18 UTC 2019
Guillermo Polito uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-GuillermoPolito.13.mcz
==================== Summary ====================
Name: VMMakerCompatibilityForPharo6-GuillermoPolito.13
Author: GuillermoPolito
Time: 22 May 2019, 11:39:09.839878 am
UUID: 5f786f79-d845-0d00-bb5a-a63503d93aea
Ancestors: VMMakerCompatibilityForPharo6-GuillermoPolito.12
Introduce Scanner and Project compatibility classes
=============== Diff against VMMakerCompatibilityForPharo6-GuillermoPolito.12 ===============
Item was changed:
----- Method: MethodReference>>setStandardClass:methodSymbol:environment: (in category 'initialize-release') -----
setStandardClass: aClass methodSymbol: aSelector environment: anEnvironment
+ classSymbol := aClass instanceSide name.
- classSymbol := aClass theNonMetaClass name.
classIsMeta := aClass isMeta.
methodSymbol := aSelector.
environment := anEnvironment.
+ stringVersion := nil!
- stringVersion := nil.!
Item was added:
+ Object subclass: #Project
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-System'!
Item was added:
+ ----- Method: Project class>>current (in category 'accessing') -----
+ current
+
+ ^ self!
Item was added:
+ ----- Method: Project class>>restore (in category 'accessing') -----
+ restore
+
+ UIManager default restoreDisplay!
Item was added:
+ ----- Method: Project class>>uiProcess (in category 'accessing') -----
+ uiProcess
+
+ ^ UIManager default uiProcess!
Item was changed:
----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of me"
"selector is sometimes a Symbol, sometimes a SelectorNode!!
On top of this, numArgs is needed due to the (truly grody) use of
arguments as a place to store the extra expressions needed to generate
code for in-line to:by:do:, etc. see below, where it is used.
Expand super nodes in place. Elide sends of halt so that halts can be
sprinkled through the simulator but will be eliminated from the generated C."
| usedSelector rcvrOrNil args |
usedSelector := selector.
rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
(rcvrOrNil notNil
and: [rcvrOrNil isVariable
and: [rcvrOrNil name = 'super']]) ifTrue:
[^aTMethod superExpansionNodeFor: usedSelector args: arguments].
usedSelector == #halt ifTrue: [^rcvrOrNil].
(usedSelector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
or: [usedSelector == #cCode:]) ifTrue:
[arguments first isBlockNode ifTrue:
[| block |
^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
ifTrue: [block statements first]
ifFalse: [block]].
(arguments first isLiteralNode
and: [arguments first value isString
and: [arguments first value isEmpty]]) ifTrue:
[^arguments first asTranslatorNodeIn: aTMethod]].
args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod].
(usedSelector == #to:do:) ifTrue: [ | block |
usedSelector := #to:by:do:.
block := args second.
+ arguments first isLiteralNode ifTrue: [
+ args := OrderedCollection
+ with: args first
+ with: (TConstantNode new setValue: 1)
+ with: args second
+ with: (TAssignmentNode new
+ setVariable: (arguments first asTranslatorNodeIn: aTMethod)
+ expression: (TConstantNode new setValue: 1);
- args := OrderedCollection
- with: args first
- with: (TConstantNode new setValue: 1)
- with: args second
- with: (TAssignmentNode new
- setVariable: (arguments first asTranslatorNodeIn: aTMethod)
- expression: (TConstantNode new setValue: 1);
- yourself)
- with: (TSendNode new
- setSelector: #<=
- receiver: (TVariableNode new setName: block args first)
- arguments: { receiver asTranslatorNodeIn: aTMethod })
- with: (TAssignmentNode new
- setVariable: (TVariableNode new setName: block args first)
- expression: (TSendNode new
- setSelector: #+
- receiver: (TVariableNode new setName: block args first)
- arguments: { TConstantNode new setValue: 1 });
yourself)
+ with: (TSendNode new
+ setSelector: #<=
+ receiver: (TVariableNode new setName: block args first)
+ arguments: { receiver asTranslatorNodeIn: aTMethod })
+ with: (TAssignmentNode new
+ setVariable: (TVariableNode new setName: block args first)
+ expression: (TSendNode new
+ setSelector: #+
+ receiver: (TVariableNode new setName: block args first)
+ arguments: { TConstantNode new setValue: 1 });
+ yourself)
+ ] ifFalse: [
+ args := OrderedCollection
+ with: args first
+ with: (TConstantNode new setValue: 1)
+ with: args second
+ with: (TVariableNode new setName: 'iLimiT')
+ ]
].
"If in the form of ifNil: [ :obj | ], replace that by an assignment and an ifFalse"
((usedSelector == #ifNotNil:) and: [ args first args notEmpty ]) ifTrue: [
^ TStmtListNode new
setArguments: #();
setStatements: {
TAssignmentNode new
setVariable: (TVariableNode new setName: args first args first)
expression: rcvrOrNil.
TSendNode new
setSelector: #ifFalse:
receiver: (TSendNode new
setSelector: #==
receiver: (TVariableNode new setName: args first args first)
arguments: {(TVariableNode new setName: 'nil')};
yourself)
arguments: {args first}
};
yourself ].
(#(#ifNotNil:ifNil: #ifNil:ifNotNil:) includes: usedSelector) ifTrue: [ | comparand expression blockWithPossibleArgument |
"We turn it always to an ifTrueIfFalse"
usedSelector = #ifNotNil:ifNil:
ifTrue: [ args := args reversed ].
blockWithPossibleArgument := args second.
expression := rcvrOrNil.
comparand := blockWithPossibleArgument args
ifEmpty: [ expression ]
ifNotEmpty: [ (TVariableNode new setName: blockWithPossibleArgument args first) ].
usedSelector := #ifTrue:ifFalse:.
rcvrOrNil := TSendNode new
setSelector: #==
receiver: comparand
arguments: { TVariableNode new setName: 'nil' }.
"If there is a variable we should epand the message as a statement"
blockWithPossibleArgument args notEmpty ifTrue: [
^ TStmtListNode new
setArguments: #();
setStatements: {
TAssignmentNode new
setVariable: (TVariableNode new setName: blockWithPossibleArgument args first)
expression: expression.
TSendNode new
setSelector: usedSelector
receiver: rcvrOrNil
arguments: args
};
yourself
] ].
(usedSelector == #ifNil:ifNotNil:) ifTrue: [
usedSelector := #ifTrue:ifFalse:.
rcvrOrNil := TSendNode new
setSelector: #==
receiver: rcvrOrNil
arguments: { TVariableNode new setName: 'nil' } ].
(usedSelector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue:
[usedSelector := #ifFalse:. args := {args last}].
(usedSelector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue:
[usedSelector := #ifTrue:. args := {args first}].
(usedSelector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue:
[usedSelector := #ifTrue:. args := {args last}].
(usedSelector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue:
[usedSelector := #ifTrue:. args := {args first}].
((usedSelector == #ifFalse: or: [usedSelector == #or:])
and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
["Restore argument block that got moved by transformOr: or transformIfFalse:"
args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}].
(args size > usedSelector numArgs and: [usedSelector ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg"
["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:"
self assert: args size - usedSelector numArgs = 1.
self assert: (args last isStmtList
and: [args last statements size = 1
and: [(args last statements first isVariable
or: [args last statements first isConstant])
and: [#('nil' true false) includes: args last statements first nameOrValue]]]).
args := args first: usedSelector numArgs].
((CCodeGenerator isVarargsSelector: usedSelector)
and: [args last isCollection
and: [args last isSequenceable]]) ifTrue:
[args := args allButLast, args last].
^TSendNode new
setSelector: usedSelector
receiver: rcvrOrNil
arguments: args!
Item was added:
+ Object subclass: #Scanner
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-System'!
Item was added:
+ ----- Method: Scanner>>scanTokens: (in category 'scanning') -----
+ scanTokens: aString
+
+ ^ (RBScanner on: aString readStream) contents!
Item was changed:
+ ----- Method: Scanner>>typedScanTokens: (in category 'accessing') -----
- ----- Method: Scanner>>typedScanTokens: (in category '*VMMakerCompatibilityForPharo6') -----
typedScanTokens: textOrString
"Answer an Array that has been tokenized with literals mapped to literals,
special characters mapped to symbols and variable names and keywords
to strings. This methiod accepts _ (underscore) as an assignment token
irrespective of whether the system prefers := as the assignment token."
- | s |
- self initScannerForTokenization.
- self scan: (ReadStream on: textOrString asString).
- s := WriteStream on: (Array new: 16).
- [tokenType == #doIt] whileFalse:
- [(token == #-
- and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue:
- [self scanToken.
- token := token negated].
- s nextPut: token.
- self scanToken].
- ^s contents
+ ^ (self scanTokens: textOrString)
+ collect: [ :e | | value |
+ value := e value.
+ e isSpecial ifTrue: [ value := value asSymbol ].
+ value ]!
- "Scanner new typedScanTokens: (Scanner sourceCodeAt: #typedScanTokens:)"!
Item was removed:
- ----- Method: ShortRunArray>>bytesPerElement (in category '*VMMakerCompatibilityForPharo6-accessing') -----
- bytesPerElement
-
- ^ 4!
Item was removed:
- ----- Method: TParseNode>>name (in category '*VMMakerCompatibilityForPharo6') -----
- name
-
- ^ self printString!
Item was added:
+ ----- Method: VMMASTTranslationTest>>methodWithExpressionInLoopCondition (in category 'generation-targets') -----
+ methodWithExpressionInLoopCondition
+
+ 1 to: self something - 10 do: [ :i | self foo: i ]!
Item was added:
+ ----- Method: VMMASTTranslationTest>>testMethodWithConditionInLoopLimitHasLimitVariable (in category 'tests') -----
+ testMethodWithConditionInLoopLimitHasLimitVariable
+
+ | translation method loop |
+ method := self class >> #methodWithExpressionInLoopCondition.
+ translation := method asTranslationMethodOfClass: TMethod.
+
+ loop := translation statements first.
+ self assert: loop args size equals: 4!
Item was added:
+ ----- Method: VMMASTTranslationTest>>testMethodWithConstantConditionInLoopHasNoLimitVariable (in category 'tests') -----
+ testMethodWithConstantConditionInLoopHasNoLimitVariable
+
+ | translation method loop |
+ method := self class >> #methodWithLoop.
+ translation := method asTranslationMethodOfClass: TMethod.
+
+ loop := translation statements first.
+ self assert: loop args size equals: 6!
More information about the Vm-dev
mailing list