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]!