[Vm-dev] VM Maker: VMMaker.oscog-eem.279.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Apr 1 00:15:09 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.279.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.279
Author: eem
Time: 31 March 2013, 5:12:29.172 pm
UUID: 300e6a42-3856-465e-bd25-d3026399ab6c
Ancestors: VMMaker.oscog-eem.278
Slang:
Fix translation of to:by:do: loops so that the limit is not re-evaluated
on each iteration if it may have side-effects.
As part of this change make TMethod locals a Set, and sort only when
emitting locals. Alas this causes a number of methods to change.
=============== Diff against VMMaker.oscog-eem.278 ===============
Item was changed:
+ SmartSyntaxInterpreterPlugin subclass: #BitBltSimulation
- InterpreterPlugin subclass: #BitBltSimulation
instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight sourceWidth sourceHeight sourceDepth sourcePitch sourceBits sourcePPW sourceMSB destWidth destHeight destDepth destPitch destBits destPPW destMSB bitCount skew mask1 mask2 preload nWords destMask hDir vDir sourceIndex sourceDelta destIndex destDelta sx sy dx dy bbW bbH halftoneHeight noSource noHalftone halftoneBase sourceAlpha srcBitShift dstBitShift bitBltOop affectedL affectedR affectedT affectedB opTable maskTable ditherMatrix4x4 ditherThresholds16 ditherValues16 hasSurfaceLock warpSrcShift warpSrcMask warpAlignShift warpAlignMask warpBitShiftTable querySurfaceFn lockSurfaceFn unlockSurfaceFn isWarping cmFlags cmMask cmShiftTable cmMaskTable cmLookupTable cmBitsPerColor dither8Lookup componentAlphaModeColor componentAlphaModeAlpha ungammaLookupTable gammaLookupTable'
classVariableNames: 'AllOnes AlphaIndex BBClipHeightIndex BBClipWidthIndex BBClipXIndex BBClipYIndex BBColorMapIndex BBDestFormIndex BBDestXIndex BBDestYIndex BBHalftoneFormIndex BBHeightIndex BBLastIndex BBRuleIndex BBSourceFormIndex BBSourceXIndex BBSourceYIndex BBWarpBase BBWidthIndex BBXTableIndex BinaryPoint BlueIndex ColorMapFixedPart ColorMapIndexedPart ColorMapNewStyle ColorMapPresent CrossedX EndOfRun FixedPt1 FormBitsIndex FormDepthIndex FormHeightIndex FormWidthIndex GreenIndex JitBltHookSize OpTable OpTableSize RedIndex'
poolDictionaries: ''
category: 'VMMaker-Interpreter'!
+ !BitBltSimulation commentStamp: 'tpr 3/25/2013 16:50' prior: 0!
- !BitBltSimulation commentStamp: '<historical>' prior: 0!
This class implements BitBlt, much as specified in the Blue Book spec.
Performance has been enhanced through the use of pointer variables such as sourceIndex and destIndex, and by separating several special cases of the inner loop.
Operation has been extended to color, with support for 1, 2, 4, 8, 16, and 32-bit pixel sizes. Conversion between different pixel sizes is facilitated by accepting an optional color map.
In addition to the original 16 combination rules, this BitBlt supports
16 fail (for old paint mode)
17 fail (for old mask mode)
18 sourceWord + destinationWord
19 sourceWord - destinationWord
20 rgbAdd: sourceWord with: destinationWord
21 rgbSub: sourceWord with: destinationWord
22 OLDrgbDiff: sourceWord with: destinationWord
23 OLDtallyIntoMap: destinationWord -- old vers doesn't clip to bit boundary
24 alphaBlend: sourceWord with: destinationWord
25 pixPaint: sourceWord with: destinationWord
26 pixMask: sourceWord with: destinationWord
27 rgbMax: sourceWord with: destinationWord
28 rgbMin: sourceWord with: destinationWord
29 rgbMin: sourceWord bitInvert32 with: destinationWord
30 alphaBlendConst: sourceWord with: destinationWord -- alpha passed as an arg
31 alphaPaintConst: sourceWord with: destinationWord -- alpha passed as an arg
32 rgbDiff: sourceWord with: destinationWord
33 tallyIntoMap: destinationWord
34 alphaBlendScaled: sourceWord with: destinationWord
+ 35 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt"
+ 36 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt"
+ 37 rgbMul: sourceWord with: destinationWord
+ 38 pixSwap: sourceWord with: destinationWord
+ 39 pixClear: sourceWord with: destinationWord
+ 40 fixAlpha: sourceWord with: destinationWord
+ 41 rgbComponentAlpha: sourceWord with: destinationWord
This implementation has also been fitted with an experimental "warp drive" that allows abritrary scaling and rotation (and even limited affine deformations) with all BitBlt storage modes supported.
To add a new rule to BitBlt...
1. add the new rule method or methods in the category 'combination rules' of BBSim
2. describe it in the class comment of BBSim and in the class comment for BitBlt
3. add refs to initializeRuleTable in proper positions
4. add refs to initBBOpTable, following the pattern
!
Item was added:
+ ----- Method: BitBltSimulation>>primitivePixelValueAtX:y: (in category 'primitives') -----
+ primitivePixelValueAtX: xVal y: yVal
+ "returns the single pixel at x at y.
+ It does not handle LSB bitmaps right now.
+ If x or y are < 0, return 0 to indicate transparent (cf BitBlt>bitPeekerFromForm: usage).
+ Likewise if x>width or y>depth.
+ Fail if the rcvr doesn't seem to be a Form, or x|y seem wrong"
+ | rcvr bitmap depth ppW stride word mask shift pixel |
+ rcvr := self primitive: 'primitivePixelValueAt' parameters: #(SmallInteger SmallInteger) receiver: #Oop.
+
+ "possible quick exit if x or y is -ve"
+ (xVal < 0 or: [ yVal < 0 ] ) ifTrue:[^interpreterProxy integerObjectOf: 0].
+ "check that rcvr is plausibly a Form or subclass"
+ rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
+ ((interpreterProxy isPointers: rcvr) and: [(interpreterProxy slotSizeOf: rcvr) >= 4])
+ ifFalse: [^interpreterProxy primitiveFail].
+
+ "get the bits oop and width/height/depth"
+ bitmap := interpreterProxy fetchPointer: FormBitsIndex ofObject: rcvr.
+ width := interpreterProxy fetchInteger: FormWidthIndex ofObject: rcvr.
+ height := interpreterProxy fetchInteger: FormHeightIndex ofObject: rcvr.
+ depth := interpreterProxy fetchInteger: FormDepthIndex ofObject: rcvr.
+ "if width/height/depth are not integer, fail"
+ interpreterProxy failed ifTrue:[^nil].
+
+ "possible quick exit if x or y is >= extent of form. This also catches cases where the width/height are < 0"
+ (xVal >= width or: [ yVal >= height ] ) ifTrue:[^interpreterProxy integerObjectOf: 0].
+
+ "we don't handle LSB Forms yet"
+ depth < 0 ifTrue:[^interpreterProxy primitiveFail].
+
+ "OK so now we know we have a plausible Form, the width/height/depth/x/y are all reasonable and it's time to plunder the bitmap"
+ ppW := 32//depth. "pixels in each word"
+ stride := (width + (ppW -1)) // ppW. "how many words per rox of pixels"
+ word := interpreterProxy fetchLong32:(yVal * stride) + (xVal//ppW) ofObject: bitmap. "load the word that contains our target"
+ mask := 16rFFFFFFFF >> (32 - depth). "make a mask to isolate the pixel within that word"
+ shift := 32 - (((xVal bitAnd: ppW-1) + 1) * depth). "this is the tricky MSB part - we mask the xVal to find how far into the word we need, then add 1 for the pixel we're looking for, then * depth to get the bit shift"
+ pixel := (word >> shift) bitAnd: mask. "shift, mask and dim the lights"
+ ^ pixel asPositiveIntegerObj "pop the incoming and push our answer"
+ !
Item was changed:
----- Method: CCodeGenerator>>generateToByDo:on:indent: (in category 'C translation') -----
generateToByDo: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ "N.B. MessageNode>>asTranslatorNodeIn: adds the limit var as a hidden fourth argument."
+ | blockExpr iterationVar limitExpr mayHaveSideEffects limitVar step negative |
+ blockExpr := msgNode args third.
+ blockExpr args size = 1 ifFalse:
+ [self error: 'wrong number of block arguments'].
+ iterationVar := blockExpr args first.
+ limitExpr := msgNode args first.
-
- | iterationVar step negative |
- (msgNode args last args size = 1) ifFalse: [
- self error: 'wrong number of block arguments'.
- ].
- iterationVar := msgNode args last args first.
aStream nextPutAll: 'for (', iterationVar, ' = '.
self emitCExpression: msgNode receiver on: aStream.
+ mayHaveSideEffects := msgNode args size = 4. "See TMethod>>prepareMethodIn:"
+ mayHaveSideEffects ifTrue:
+ [limitVar := msgNode args last.
+ aStream nextPutAll: ', ', limitVar name, ' = '.
+ self emitCExpression: limitExpr on: aStream.
+ limitExpr := limitVar].
aStream nextPutAll: '; ', iterationVar.
negative := ((step := msgNode args at: 2) isConstant and: [step value < 0])
or: [step isSend and: [step selector == #negated
and: [step receiver isConstant and: [step receiver value >= 0]]]].
aStream nextPutAll: (negative ifTrue: [' >= '] ifFalse: [' <= ']).
+ self emitCExpression: limitExpr on: aStream.
- self emitCExpression: msgNode args first on: aStream.
aStream nextPutAll: '; ', iterationVar, ' += '.
self emitCExpression: step on: aStream.
aStream nextPutAll: ') {'; cr.
+ blockExpr emitCCodeOn: aStream level: level + 1 generator: self.
+ aStream tab: level.
+ aStream nextPut: $}!
- msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
- level timesRepeat: [ aStream tab ].
- aStream nextPutAll: '}'.!
Item was changed:
----- Method: CCodeGenerator>>removeMethodForSelector: (in category 'utilities') -----
removeMethodForSelector: aSelector
"Remove the given method from the code base"
+ (breakSrcInlineSelector == aSelector
+ or: [breakDestInlineSelector == aSelector]) ifTrue:
+ [self halt].
methods removeKey: aSelector ifAbsent: []!
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 := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
(rcvrOrNil notNil
and: [rcvrOrNil isVariable
and: [rcvrOrNil name = 'super']]) ifTrue:
[^aTMethod superExpansionNodeFor: selector key args: arguments].
sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key].
((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
+ or: [sel = #cCode:])
+ and: [arguments first isBlockNode]) ifTrue:
- or: [sel = #cCode:])
- 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 := {(arguments at: 7) value asTranslatorNodeIn: aTMethod.
+ args second.
+ args third. "add the limit var as a hidden extra argument; we may need it later"
+ TVariableNode new setName: arguments first key}].
+ ((sel = #ifFalse: or: [sel = #or:])
+ and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
+ ["Restore argument block that got moved by transformOr: or transformIfFalse:"
+ args at: 1 put: ((arguments at: 2) 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: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initializing') -----
setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
"Initialize this method using the given information."
selector := sel.
definingClass := class.
returnType := #sqInt. "assume return type is sqInt for now"
args := argList asOrderedCollection collect: [:arg | arg key].
+ locals := (localList collect: [:arg | arg key]) asSet.
- locals := localList asOrderedCollection collect: [:arg | arg key].
declarations := Dictionary new.
primitive := aNumber.
properties := methodProperties.
comment := aComment.
parseTree := aBlockNode asTranslatorNodeIn: self.
labels := OrderedCollection new.
complete := false. "set to true when all possible inlining has been done"
export := self extractExportDirective.
static := self extractStaticDirective.
canAsmLabel := self extractLabelDirective.
self extractSharedCase.
isPrimitive := false. "set to true only if you find a primtive direction."
suppressingFailureGuards := self extractSuppressFailureGuardDirective.
self recordDeclarations.
self extractPrimitiveDirectives.
!
Item was changed:
----- Method: TMethod>>addVarsDeclarationsAndLabelsOf:except: (in category 'inlining support') -----
addVarsDeclarationsAndLabelsOf: methodToBeInlined except: doNotRename
"Prepare to inline the body of the given method into the receiver by making the args and locals of the argument to the receiver be locals of the receiver. Record any type declarations for these variables. Record labels. Assumes that the variables have already be renamed to avoid name clashes."
+ locals
+ addAll: (methodToBeInlined args reject: [ :v | doNotRename includes: v]);
+ addAll: (methodToBeInlined locals reject: [ :v | doNotRename includes: v]).
- methodToBeInlined args, methodToBeInlined locals do:
- [ :v |
- ((doNotRename includes: v)
- or: [locals includes: v]) ifFalse:
- [locals addLast: v]].
-
methodToBeInlined declarations keysAndValuesDo:
[ :v :decl |
(doNotRename includes: v) ifFalse:
[self declarationAt: v put: decl]].
+ labels addAll: methodToBeInlined labels!
- methodToBeInlined labels do:
- [ :label |
- labels add: label]!
Item was changed:
----- Method: TMethod>>computePossibleSideEffectsInto:visited:in: (in category 'inlining support') -----
computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen
+ "Add all variables written to by this method and its callees to writtenToVars.
- "Add all variables written to by this mathod and its callees to writtenToVars.
Avoid circularity via visitedSelectors"
(visitedSelectors includes: selector) ifTrue:
[^self].
visitedSelectors add: selector.
writtenToGlobalVarsCache ifNotNil:
[writtenToVars addAll: writtenToGlobalVarsCache.
^self].
parseTree nodesDo:
[ :node |
(node isAssignment
and: [(locals includes: node variable name) not])
ifTrue:
[writtenToVars add: node variable name].
(node isSend
+ and: [node isBuiltinOperator not
+ and: [(node isStructSend: aCodeGen) not]]) ifTrue:
- and: [node isBuiltinOperator not]) ifTrue:
[(aCodeGen methodNamed: node selector) ifNotNil:
[:method|
method
computePossibleSideEffectsInto: writtenToVars
visited: visitedSelectors
in: aCodeGen]]].
writtenToGlobalVarsCache := writtenToVars copy!
Item was changed:
----- Method: TMethod>>emitInlineOn:level:generator: (in category 'C code generation') -----
emitInlineOn: aStream level: level generator: aCodeGen
"Emit C code for this method onto the given stream. All calls to inlined methods should already have been expanded."
self removeUnusedTemps.
sharedLabel ifNotNil:
[aStream crtab: level-1; nextPutAll: sharedLabel; nextPut: $:.
aStream crtab: level.
aStream nextPutAll: '/* '; nextPutAll: selector; nextPutAll: ' */'.
aStream crtab: level].
aStream nextPut: ${.
locals isEmpty ifFalse:
+ [(aCodeGen sortStrings: locals) do:
- [locals do:
[:var|
aStream
crtab: level+1;
nextPutAll: (self declarationAt: var);
nextPut: $;].
aStream cr].
aStream crtab: level+1.
aCodeGen outputAsmLabel: selector on: aStream.
aStream crtab: level+1.
aCodeGen
pushScope: declarations
while: [parseTree emitCCodeOn: aStream level: level+1 generator: aCodeGen].
aStream tab: level; nextPut: $}!
Item was changed:
----- Method: TMethod>>inlineCaseStatementBranchesIn:localizingVars: (in category 'inlining') -----
inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList
| maxTemp usedVars v exitLabel |
maxTemp := 0.
parseTree nodesDo:
[:n |
n isCaseStmt ifTrue:
[n cases do:
[:stmtNode | | newStatements stmt meth |
(stmt := stmtNode statements first) isSend ifTrue:
[(meth := (aCodeGen methodNamed: stmt selector)) isNil ifFalse:
[(meth hasUnrenamableCCode
or: [meth args notEmpty]) ifFalse:
[meth := meth copy.
meth hasReturn
ifTrue:
[exitLabel := meth unusedLabelForInliningInto: self.
meth exitVar: nil label: exitLabel.
labels add: exitLabel]
ifFalse: [exitLabel := nil].
meth renameLabelsForInliningInto: self.
labels addAll: meth labels.
newStatements := stmtNode statements asOrderedCollection allButFirst.
exitLabel ifNotNil:
[newStatements addFirst: (TLabeledCommentNode new
setLabel: exitLabel
comment: 'end case')].
newStatements
addFirst: meth asInlineNode;
addFirst: (TLabeledCommentNode new setComment: meth selector).
stmtNode setStatements: newStatements]]]]]].
usedVars := (locals , args) asSet.
1 to: maxTemp do:
[:i |
v := 't' , i printString.
(usedVars includes: v) ifTrue:
[self error: 'temp variable name conflicts with an existing local or arg'].
locals addLast: v].
"make local versions of the given globals"
+ locals addAll: (varsList reject: [:var | usedVars includes: var])!
- varsList do:
- [:var |
- (usedVars includes: var) ifFalse:
- [locals addFirst: var asString]]!
Item was removed:
- ----- Method: TMethod>>isLocal: (in category 'testing') -----
- isLocal: aVariableName
- ^locals includes: aVariableName!
Item was changed:
----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
prepareMethodIn: aCodeGen
"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:].
These must be top-level statements; they cannot appear in expressions.
As a hack also update the types of variables introduced to implement cascades correctly.
This has to be done at teh same time as this is done, so why not piggy back here?"
| replacements |.
cascadeVariableNumber ifNotNil:
[declarations keysAndValuesDo:
[:varName :decl|
decl isBlock ifTrue:
[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
locals add: varName.
self declarationAt: varName
put: (decl value: self value: aCodeGen), ' ', varName]]].
replacements := IdentityDictionary new.
+ aCodeGen
+ pushScope: declarations
+ while:
+ [parseTree nodesDo:
+ [:node|
+ node isSend ifTrue:
+ [(aCodeGen builtin: node selector)
+ ifTrue:
+ [node isBuiltinOperator: true.
+ "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
+ (node selector = #to:by:do:
+ and: [node args size = 4]) ifTrue:
+ [| limitExpr |
+ limitExpr := node args first.
+ (limitExpr anySatisfy:
+ [:subNode|
+ subNode isSend
+ and: [(aCodeGen builtin: subNode selector) not
+ and: [(subNode isStructSend: aCodeGen) not]]])
+ ifTrue: [locals add: node args last name]
+ ifFalse:
+ [node arguments: node args allButLast]]]
+ ifFalse:
+ [(CaseStatements includes: node selector) ifTrue:
+ [replacements at: node put: (self buildCaseStmt: node)].
+ (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
+ [replacements at: node put: (self buildSwitchStmt: node)]]].
+ ((node isAssignment or: [node isReturn])
+ and: [node expression isSwitch]) ifTrue:
+ [replacements at: node put: (self transformSwitchExpression: node)]]].
- parseTree nodesDo:
- [:node|
- node isSend ifTrue:
- [(aCodeGen builtin: node selector)
- ifTrue:
- [node isBuiltinOperator: true]
- ifFalse:
- [(CaseStatements includes: node selector) ifTrue:
- [replacements at: node put: (self buildCaseStmt: node)].
- (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
- [replacements at: node put: (self buildSwitchStmt: node)]]].
- ((node isAssignment or: [node isReturn])
- and: [node expression isSwitch]) ifTrue:
- [replacements at: node put: (self transformSwitchExpression: node)]].
replacements isEmpty ifFalse:
[parseTree := parseTree replaceNodesIn: replacements]!
Item was changed:
----- Method: TMethod>>renameVarsForInliningInto:except:in: (in category 'inlining support') -----
renameVarsForInliningInto: destMethod except: doNotRename in: aCodeGen
"Rename any variables that would clash with those of the destination method."
| destVars usedVars varMap newVarName |
destVars := aCodeGen globalsAsSet copy.
destVars addAll: destMethod locals.
destVars addAll: destMethod args.
usedVars := destVars copy. "keeps track of names in use"
usedVars addAll: args; addAll: locals.
varMap := Dictionary new: 100.
+ locals, args do:
+ [ :v |
- args, locals do: [ :v |
((doNotRename includes: v) not
+ and: [destVars includes: v]) ifTrue:
+ [newVarName := self unusedNamePrefixedBy: v avoiding: usedVars.
+ varMap at: v put: newVarName]].
+ self renameVariablesUsing: varMap!
- and: [destVars includes: v]) ifTrue: [
- newVarName := self unusedNamePrefixedBy: v avoiding: usedVars.
- varMap at: v put: newVarName.
- ].
- ].
- self renameVariablesUsing: varMap.!
Item was changed:
----- Method: TMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') -----
setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
"Initialize this method using the given information."
selector := sel.
definingClass := class.
returnType := #sqInt. "assume return type is long for now"
args := argList asOrderedCollection collect: [:arg | arg key].
+ locals := (localList collect: [:arg | arg key]) asSet.
- locals := (localList asSortedCollection: [:a :b| a key < b key]) collect: [:arg | arg key].
declarations := Dictionary new.
self addTypeForSelf.
primitive := aNumber.
properties := methodProperties.
comment := aComment.
parseTree := aBlockNode. "hack; allows nodes to find their parent, etc"
parseTree := aBlockNode asTranslatorNodeIn: self.
labels := OrderedCollection new.
complete := false. "set to true when all possible inlining has been done"
export := self extractExportDirective.
static := self extractStaticDirective.
canAsmLabel := self extractLabelDirective.
self extractSharedCase.
self removeFinalSelfReturn. "must preceed recordDeclarations because this may set returnType"
self recordDeclarations.
globalStructureBuildMethodHasFoo := 0!
Item was changed:
----- 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 locals intersection: self locals) notEmpty ifTrue:
[varMap := Dictionary new.
commonVars do:
[:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
superTMethod renameVariablesUsing: varMap].
self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]).
+ locals addAll: superTMethod locals.
- 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 added:
+ ----- Method: TParseNode>>anySatisfy: (in category 'enumerating') -----
+ anySatisfy: aBlock
+ self nodesDo: [:n| (aBlock value: n) ifTrue: [^true]].
+ ^false!
Item was added:
+ ----- Method: TParseNode>>noneSatisfy: (in category 'enumerating') -----
+ noneSatisfy: aBlock
+ self nodesDo: [:n| (aBlock value: n) ifTrue: [^false]].
+ ^true!
Item was changed:
----- Method: TSendNode>>printOn:level: (in category 'printing') -----
printOn: aStream level: level
| possiblyParenthesize |
possiblyParenthesize :=
[:node :newLevel|
(node isSend
and: [node selector precedence >= 3]) ifTrue:
[aStream nextPut: $(].
node printOn: aStream level: newLevel.
(node isSend
and: [node selector precedence >= 3]) ifTrue:
[aStream nextPut: $)]].
possiblyParenthesize value: receiver value: level.
arguments size = 0 ifTrue:
[aStream space; nextPutAll: selector.
^self].
+ selector keywords with: (arguments first: selector numArgs) do:
- selector keywords with: arguments do:
[:keyword :arg |
aStream space; nextPutAll: keyword; space.
possiblyParenthesize value: arg value: level + 1]!
More information about the Vm-dev
mailing list