[Vm-dev] VM Maker: VMMaker.oscog-eem.170.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jun 25 21:12:43 UTC 2012
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.170.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.170
Author: eem
Time: 25 June 2012, 2:10:13.946 pm
UUID: e776e9dc-4b1c-4857-b356-91910024d9c8
Ancestors: VMMaker.oscog-eem.169
Fix super expansions of the form e.g.
ok := super foo.
...
^ok
Parameterise primitive table generastion (for multiple primitive tables).
Fix a send of remapOop:in: in the LargeIntegersPlugin.
=============== Diff against VMMaker.oscog-eem.169 ===============
Item was changed:
----- Method: AssignmentNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator equivalent of me"
+ | varNode valueNode |
+ varNode := variable asTranslatorNodeIn: aTMethod.
+ valueNode := value asTranslatorNodeIn: aTMethod.
+ valueNode isStmtList ifFalse:
+ [^TAssignmentNode new
+ setVariable: varNode
+ expression: valueNode;
+ comment: comment].
+ ^TStmtListNode new
+ setStatements: valueNode statements allButLast,
+ { TAssignmentNode new
+ setVariable: varNode
+ expression: valueNode statements last;
+ comment: comment };
+ yourself!
- ^TAssignmentNode new
- setVariable: (variable asTranslatorNodeIn: aTMethod)
- expression: (value asTranslatorNodeIn: aTMethod);
- comment: comment!
Item was changed:
----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') -----
digitAddLarge: firstInteger with: secondInteger
"Does not need to normalize!!"
| over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass |
<var: #over type: 'unsigned char '>
firstLen := self byteSizeOfBytes: firstInteger.
secondLen := self byteSizeOfBytes: secondInteger.
resClass := interpreterProxy fetchClassOf: firstInteger.
firstLen <= secondLen
ifTrue:
[shortInt := firstInteger.
shortLen := firstLen.
longInt := secondInteger.
longLen := secondLen]
ifFalse:
[shortInt := secondInteger.
shortLen := secondLen.
longInt := firstInteger.
longLen := firstLen].
" sum := Integer new: len neg: firstInteger negative."
self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen].
over := self
cDigitAdd: (interpreterProxy firstIndexableField: shortInt)
len: shortLen
with: (interpreterProxy firstIndexableField: longInt)
len: longLen
into: (interpreterProxy firstIndexableField: sum).
over > 0
ifTrue:
["sum := sum growby: 1."
+ self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1].
- interpreterProxy remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1].
self
cBytesCopyFrom: (interpreterProxy firstIndexableField: sum)
to: (interpreterProxy firstIndexableField: newSum)
len: longLen.
sum := newSum.
"C index!!"
(self cCoerce: (interpreterProxy firstIndexableField: sum)
to: 'unsigned char *')
at: longLen put: over].
^ sum!
Item was changed:
----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator 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."
+ | rcvrOrNil sel args |
- | rcvrOrNil isReturned sel args |
rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
(rcvrOrNil notNil
and: [rcvrOrNil isVariable
and: [rcvrOrNil name = 'super']]) ifTrue:
+ [^aTMethod superExpansionNodeFor: selector key args: arguments].
- ["hack, hack, hack. should implement parent but that belongs in Compiler-ParseNodes not here"
- isReturned := false.
- aTMethod parseTree accept:
- (ParseNodeEnumerator ofBlock:
- [:node|
- (node isReturn and: [node expr = self]) ifTrue:
- [isReturned := true]]).
- ^aTMethod
- superExpansionNodeFor: selector key
- args: arguments
- isReturned: isReturned].
sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key].
(sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
and: [arguments first isBlockNode]) ifTrue:
[| block |
^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
ifTrue: [block statements first]
ifFalse: [block]].
args := (1 to: sel numArgs) collect:
[:i | (arguments at: i) asTranslatorNodeIn: aTMethod].
(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]])
ifTrue: ["Restore limit expr that got moved by transformToDo:"
args at: 1 put: ((arguments at: 7) value asTranslatorNodeIn: aTMethod)].
(sel = #or: and: [arguments size = 2 and: [(arguments at: 2) notNil]])
ifTrue: ["Restore argument block that got moved by transformOr:"
args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
(sel = #ifFalse: and: [arguments size = 2 and: [(arguments at: 2) notNil]])
ifTrue: ["Restore argument block that got moved by transformIfFalse:"
args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
^TSendNode new
setSelector: sel
receiver: rcvrOrNil
arguments: args!
Item was changed:
----- Method: StackInterpreter class>>primitiveTableString (in category 'initialization') -----
primitiveTableString
"StackInterpreter initializePrimitiveTable primitiveTableString"
+ ^self primitiveTableStringFor: self primitiveTable!
- ^String streamContents:
- [:s |
- s nextPut: ${.
- self primitiveTable withIndexDo:
- [:primSpec :index |
- s
- crtab;
- nextPutAll: '/* ';
- print: index - 1;
- nextPutAll: ' */ ';
- nextPutAll: (primSpec isString
- ifTrue: [primSpec == #primitiveFail
- ifTrue: ['(void (*)(void))0']
- ifFalse: [primSpec]]
- ifFalse: ['(void (*)(void))', primSpec printString]);
- nextPut: $,].
- s cr; nextPutAll: ' 0 }']!
Item was added:
+ ----- Method: StackInterpreter class>>primitiveTableStringFor: (in category 'initialization') -----
+ primitiveTableStringFor: table
+ "StackInterpreter initializePrimitiveTable primitiveTableString"
+ ^String streamContents:
+ [:s |
+ s nextPut: ${.
+ table withIndexDo:
+ [:primSpec :index |
+ s
+ crtab;
+ nextPutAll: '/* ';
+ print: index - 1;
+ nextPutAll: ' */ ';
+ nextPutAll: (primSpec isString
+ ifTrue: [primSpec == #primitiveFail
+ ifTrue: ['(void (*)(void))0']
+ ifFalse: [primSpec]]
+ ifFalse: ['(void (*)(void))', primSpec printString]);
+ nextPut: $,].
+ s cr; nextPutAll: ' 0 }']!
Item was changed:
----- Method: TMethod>>elideAnyFinalReturn (in category 'transformations') -----
elideAnyFinalReturn
+ "For super expansions we need to eliminate any final return to prevent premature exit.
- "For super exoansions we need to eliminate any final return to prevent premature exit.
Anything meaningful in the returned expression must be retained."
| stmtList lastStmt |
stmtList := parseTree statements asOrderedCollection.
(lastStmt := stmtList last) isReturn ifTrue:
+ [stmtList at: stmtList size put: lastStmt expression.
- [lastStmt expression isLeaf
- ifTrue:
- [stmtList removeLast]
- ifFalse:
- [stmtList at: stmtList size put: lastStmt expression].
parseTree setStatements: stmtList]!
Item was added:
+ ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') -----
+ superExpansionNodeFor: aSelector args: argumentNodes
+ "Answer the expansion of a super send. Merge the super expansion's
+ locals, properties and comment into this method's properties."
+ (definingClass superclass lookupSelector: aSelector)
+ ifNil: [self error: 'superclass does not define super method']
+ ifNotNil:
+ [:superMethod| | superTMethod commonVars varMap |
+ superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
+ ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode])
+ and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse:
+ [self error: definingClass name, '>>',selector, ' args ~= ',
+ superTMethod definingClass name, '>>', aSelector,
+ (String with: $. with: Character cr),
+ 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.'].
+ self mergePropertiesOfSuperMethod: superTMethod.
+ (commonVars := superTMethod allLocals intersection: self allLocals) notEmpty ifTrue:
+ [varMap := Dictionary new.
+ commonVars do:
+ [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
+ superTMethod renameVariablesUsing: varMap].
+ self assert: (superTMethod allLocals allSatisfy: [:var| (self allLocals includes: var) not]).
+ locals addAllFirst: superTMethod locals.
+ superTMethod declarations keysAndValuesDo:
+ [:var :decl|
+ self declarationAt: var put: decl].
+ superTMethod comment ifNotNil:
+ [:superComment|
+ comment := comment
+ ifNil: [superComment]
+ ifNotNil: [superComment, comment]].
+ superTMethod cascadeVariableNumber ifNotNil:
+ [:scvn|
+ cascadeVariableNumber := cascadeVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]].
+ superTMethod elideAnyFinalReturn.
+ ^superTMethod parseTree]!
Item was removed:
- ----- Method: TMethod>>superExpansionNodeFor:args:isReturned: (in category 'inlining') -----
- superExpansionNodeFor: aSelector args: argumentNodes isReturned: isReturned
- "Answer the expansion of a super send. Merge the super expansion's
- locals, properties and comment into this method's properties."
- (definingClass superclass lookupSelector: aSelector)
- ifNil: [self error: 'superclass does not define super method']
- ifNotNil:
- [:superMethod| | superTMethod commonVars varMap |
- superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
- ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode])
- and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse:
- [self error: definingClass name, '>>',selector, ' args ~= ',
- superTMethod definingClass name, '>>', aSelector,
- (String with: $. with: Character cr),
- 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.'].
- self mergePropertiesOfSuperMethod: superTMethod.
- (commonVars := superTMethod allLocals intersection: self allLocals) notEmpty ifTrue:
- [varMap := Dictionary new.
- commonVars do:
- [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
- superTMethod renameVariablesUsing: varMap].
- self assert: (superTMethod allLocals allSatisfy: [:var| (self allLocals includes: var) not]).
- locals addAllFirst: superTMethod locals.
- superTMethod declarations keysAndValuesDo:
- [:var :decl|
- self declarationAt: var put: decl].
- superTMethod comment ifNotNil:
- [:superComment|
- comment := comment
- ifNil: [superComment]
- ifNotNil: [superComment, comment]].
- superTMethod cascadeVariableNumber ifNotNil:
- [:scvn|
- cascadeVariableNumber := cascadeVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]].
- isReturned ifFalse: [superTMethod elideAnyFinalReturn].
- ^superTMethod parseTree]!
More information about the Vm-dev
mailing list