[Vm-dev] VM Maker: VMMaker.oscog-eem.1656.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jan 20 01:56:49 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1656.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1656
Author: eem
Time: 20 January 2016, 5:55:10.847536 pm
UUID: 02086cbf-8db3-4035-9f0d-f2671db50748
Ancestors: VMMaker.oscog-tpr.1655
ARM Cogit:
Fix slip in new 16-bit aware dispatchCOncretize.
Interpreter: Provide an error code for immediate replacement
Slang: Remember to remove the declaration for a local that is introduced for inlining where the inlining uses the parse tree, not the local. Otherwise, stale declarations can be left that will mistype subsequent inlines of a method with formals of the same name.
Use declatationAt:put:, not direct access to declarations, for debugging.
Don't transform the parse tree/collect new locals etc, when inlining withouty renaming, just to cut down on the garbage.
=============== Diff against VMMaker.oscog-tpr.1655 ===============
Item was changed:
----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
dispatchConcretize
"Attempt to generate concrete machine code for the instruction at address.
This is the inner dispatch of concretizeAt: actualAddress which exists only
to get around the branch size limits in the SqueakV3 (blue book derived)
bytecode set."
<returnTypeC: #void>
conditionOrNil ifNotNil:
[self concretizeConditionalInstruction.
^self].
opcode caseOf: {
"Noops & Pseudo Ops"
[Label] -> [^self concretizeLabel].
[Literal] -> [^self concretizeLiteral].
[AlignmentNops] -> [^self concretizeAlignmentNops].
[Fill32] -> [^self concretizeFill32].
[Nop] -> [^self concretizeNop].
"Control"
[Call] -> [^self concretizeCall]. "call code within code space"
[CallFull] -> [^self concretizeCallFull]. "call code anywhere in address space"
[JumpR] -> [^self concretizeJumpR].
[JumpFull] -> [^self concretizeJumpFull]."jump within address space"
[JumpLong] -> [^self concretizeConditionalJump: AL]."jumps witihn code space"
[JumpLongZero] -> [^self concretizeConditionalJump: EQ].
[JumpLongNonZero] -> [^self concretizeConditionalJump: NE].
[Jump] -> [^self concretizeConditionalJump: AL].
[JumpZero] -> [^self concretizeConditionalJump: EQ].
[JumpNonZero] -> [^self concretizeConditionalJump: NE].
[JumpNegative] -> [^self concretizeConditionalJump: MI].
[JumpNonNegative] -> [^self concretizeConditionalJump: PL].
[JumpOverflow] -> [^self concretizeConditionalJump: VS].
[JumpNoOverflow] -> [^self concretizeConditionalJump: VC].
[JumpCarry] -> [^self concretizeConditionalJump: CS].
[JumpNoCarry] -> [^self concretizeConditionalJump: CC].
[JumpLess] -> [^self concretizeConditionalJump: LT].
[JumpGreaterOrEqual] -> [^self concretizeConditionalJump: GE].
[JumpGreater] -> [^self concretizeConditionalJump: GT].
[JumpLessOrEqual] -> [^self concretizeConditionalJump: LE].
[JumpBelow] -> [^self concretizeConditionalJump: CC]. "unsigned lower"
[JumpAboveOrEqual] -> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
[JumpAbove] -> [^self concretizeConditionalJump: HI].
[JumpBelowOrEqual] -> [^self concretizeConditionalJump: LS].
[JumpFPEqual] -> [^self concretizeFPConditionalJump: EQ].
[JumpFPNotEqual] -> [^self concretizeFPConditionalJump: NE].
[JumpFPLess] -> [^self concretizeFPConditionalJump: LT].
[JumpFPGreaterOrEqual] -> [^self concretizeFPConditionalJump: GE].
[JumpFPGreater] -> [^self concretizeFPConditionalJump: GT].
[JumpFPLessOrEqual] -> [^self concretizeFPConditionalJump: LE].
[JumpFPOrdered] -> [^self concretizeFPConditionalJump: VC].
[JumpFPUnordered] -> [^self concretizeFPConditionalJump: VS].
[RetN] -> [^self concretizeRetN].
[Stop] -> [^self concretizeStop].
"Arithmetic"
[AddCqR] -> [^self concretizeNegateableDataOperationCqR: AddOpcode].
[AndCqR] -> [^self concretizeInvertibleDataOperationCqR: AndOpcode].
[AndCqRR] -> [^self concretizeAndCqRR].
[CmpCqR] -> [^self concretizeNegateableDataOperationCqR: CmpOpcode].
[OrCqR] -> [^self concretizeDataOperationCqR: OrOpcode].
[SubCqR] -> [^self concretizeSubCqR].
[TstCqR] -> [^self concretizeTstCqR].
[XorCqR] -> [^self concretizeInvertibleDataOperationCqR: XorOpcode].
[AddCwR] -> [^self concretizeDataOperationCwR: AddOpcode].
[AndCwR] -> [^self concretizeDataOperationCwR: AndOpcode].
[CmpCwR] -> [^self concretizeDataOperationCwR: CmpOpcode].
[OrCwR] -> [^self concretizeDataOperationCwR: OrOpcode].
[SubCwR] -> [^self concretizeDataOperationCwR: SubOpcode].
[XorCwR] -> [^self concretizeDataOperationCwR: XorOpcode].
[AddRR] -> [^self concretizeDataOperationRR: AddOpcode].
[AndRR] -> [^self concretizeDataOperationRR: AndOpcode].
[CmpRR] -> [^self concretizeDataOperationRR: CmpOpcode].
[OrRR] -> [^self concretizeDataOperationRR: OrOpcode].
[SubRR] -> [^self concretizeDataOperationRR: SubOpcode].
[XorRR] -> [^self concretizeDataOperationRR: XorOpcode].
[AddRdRd] -> [^self concretizeAddRdRd].
[CmpRdRd] -> [^self concretizeCmpRdRd].
[DivRdRd] -> [^self concretizeDivRdRd].
[MulRdRd] -> [^self concretizeMulRdRd].
[SubRdRd] -> [^self concretizeSubRdRd].
[SqrtRd] -> [^self concretizeSqrtRd].
[NegateR] -> [^self concretizeNegateR].
[LoadEffectiveAddressMwrR] -> [^self concretizeLoadEffectiveAddressMwrR].
[ArithmeticShiftRightCqR] -> [^self concretizeArithmeticShiftRightCqR].
[LogicalShiftRightCqR] -> [^self concretizeLogicalShiftRightCqR].
[LogicalShiftLeftCqR] -> [^self concretizeLogicalShiftLeftCqR].
[ArithmeticShiftRightRR] -> [^self concretizeArithmeticShiftRightRR].
[LogicalShiftLeftRR] -> [^self concretizeLogicalShiftLeftRR].
[LogicalShiftRightRR] -> [^self concretizeLogicalShiftRightRR].
"ARM Specific Arithmetic"
[SMULL] -> [^self concretizeSMULL] .
[CMPSMULL] -> [^self concretizeCMPSMULL].
[MSR] -> [^self concretizeMSR].
"Data Movement"
[MoveCqR] -> [^self concretizeMoveCqR].
[MoveCwR] -> [^self concretizeMoveCwR].
[MoveRR] -> [^self concretizeMoveRR].
[MoveAwR] -> [^self concretizeMoveAwR].
[MoveRAw] -> [^self concretizeMoveRAw].
[MoveAbR] -> [^self concretizeMoveAbR].
[MoveRAb] -> [^self concretizeMoveRAb].
[MoveMbrR] -> [^self concretizeMoveMbrR].
[MoveRMbr] -> [^self concretizeMoveRMbr].
+ [MoveRM16r] -> [^self concretizeMoveRM16r].
- [MoveRM16r] -> [^self concretizeMoveRMbr].
[MoveM16rR] -> [^self concretizeMoveM16rR].
[MoveM64rRd] -> [^self concretizeMoveM64rRd].
[MoveMwrR] -> [^self concretizeMoveMwrR].
[MoveXbrRR] -> [^self concretizeMoveXbrRR].
[MoveRXbrR] -> [^self concretizeMoveRXbrR].
[MoveXwrRR] -> [^self concretizeMoveXwrRR].
[MoveRXwrR] -> [^self concretizeMoveRXwrR].
[MoveRMwr] -> [^self concretizeMoveRMwr].
[MoveRdM64r] -> [^self concretizeMoveRdM64r].
[PopR] -> [^self concretizePopR].
[PushR] -> [^self concretizePushR].
[PushCq] -> [^self concretizePushCq].
[PushCw] -> [^self concretizePushCw].
[PrefetchAw] -> [^self concretizePrefetchAw].
"Conversion"
[ConvertRRd] -> [^self concretizeConvertRRd]}!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') -----
primitiveStringReplace
"
<array> primReplaceFrom: start to: stop with: replacement
startingAt: repStart
<primitive: 105>
"
| array start stop repl replStart hdr arrayFmt totalLength arrayInstSize replFmt replInstSize srcIndex |
array := self stackValue: 4.
start := self stackIntegerValue: 3.
stop := self stackIntegerValue: 2.
repl := self stackValue: 1.
replStart := self stackIntegerValue: 0.
self successful ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
(objectMemory isImmediate: repl) ifTrue: "can happen in LgInt copy"
+ [^self primitiveFailFor: PrimErrBadArgument].
- [^self primitiveFail].
self cppIf: IMMUTABILITY ifTrue:
[(objectMemory isImmutable: array) ifTrue:
[^self primitiveFailFor: PrimErrNoModification]].
hdr := objectMemory baseHeader: array.
arrayFmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: array baseHeader: hdr format: arrayFmt.
arrayInstSize := objectMemory fixedFieldsOf: array format: arrayFmt length: totalLength.
(start >= 1 and: [start - 1 <= stop and: [stop + arrayInstSize <= totalLength]]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
hdr := objectMemory baseHeader: repl.
replFmt := objectMemory formatOfHeader: hdr.
totalLength := objectMemory lengthOf: repl baseHeader: hdr format: replFmt.
replInstSize := objectMemory fixedFieldsOf: repl format: replFmt length: totalLength.
(replStart >= 1 and: [stop - start + replStart + replInstSize <= totalLength]) ifFalse:
[^self primitiveFailFor: PrimErrBadIndex].
"Still to do: rewrite the below to accomodate short & long access"
(objectMemory hasSpurMemoryManagerAPI
and: [(arrayFmt between: objectMemory firstShortFormat and: objectMemory firstLongFormat - 1)
or: [arrayFmt = objectMemory sixtyFourBitIndexableFormat]]) ifTrue:
[^self primitiveFailFor: PrimErrUnsupported].
"Array formats (without byteSize bits, if bytes array) must be the same"
arrayFmt < objectMemory firstByteFormat
ifTrue: [arrayFmt = replFmt ifFalse:
[^self primitiveFailFor: PrimErrInappropriate]]
ifFalse: [(arrayFmt bitAnd: objectMemory byteFormatMask) = (replFmt bitAnd: objectMemory byteFormatMask) ifFalse:
[^self primitiveFailFor: PrimErrInappropriate]].
srcIndex := replStart + replInstSize - 1.
"- 1 for 0-based access"
arrayFmt <= objectMemory lastPointerFormat
ifTrue:
[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
[:i |
objectMemory storePointer: i ofObject: array withValue: (objectMemory fetchPointer: srcIndex ofObject: repl).
srcIndex := srcIndex + 1]]
ifFalse:
[arrayFmt < objectMemory firstByteFormat
ifTrue: "32-bit-word type objects"
[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
[:i |
objectMemory storeLong32: i ofObject: array withValue: (objectMemory fetchLong32: srcIndex ofObject: repl).
srcIndex := srcIndex + 1]]
ifFalse: "byte-type objects"
[start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do:
[:i |
objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcIndex ofObject: repl).
srcIndex := srcIndex + 1]]].
"We might consider comparing stop - start to some value here and using forceInterruptCheck"
self pop: argumentCount "leave rcvr on stack"!
Item was changed:
----- Method: TMethod>>argAssignmentsFor:send:in: (in category 'inlining') -----
argAssignmentsFor: meth send: aSendNode in: aCodeGen
"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
| stmtList substitutionDict argList |
meth args size > (argList := aSendNode args) size ifTrue:
[self assert: (meth args first beginsWith: 'self_in_').
argList := {aSendNode receiver}, aSendNode args].
stmtList := OrderedCollection new: argList size.
substitutionDict := Dictionary new: argList size.
meth args with: argList do:
+ [:argName :exprNode |
- [ :argName :exprNode |
(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
ifTrue:
[substitutionDict
at: argName
put: (aCodeGen
node: exprNode
typeCompatibleWith: argName
inliningInto: meth
in: self).
+ locals remove: argName.
+ declarations removeKey: argName ifAbsent: nil]
- locals remove: argName]
ifFalse:
[stmtList addLast:
(TAssignmentNode new
setVariable: (TVariableNode new setName: argName)
expression: (aCodeGen
node: exprNode copy
typeCompatibleWith: argName
inliningInto: meth
in: self))]].
meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
^stmtList!
Item was changed:
----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
inferTypesForImplicitlyTypedVariablesIn: aCodeGen
"infer types for untyped variables from assignments and arithmetic uses.
For debugging answer a Dictionary from var to the nodes that determined types
This for debugging:
(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
| alreadyExplicitlyTyped effectiveNodes |
aCodeGen maybeBreakForTestToInline: selector in: self.
alreadyExplicitlyTyped := declarations keys asSet.
effectiveNodes := Dictionary new. "this for debugging"
parseTree nodesDo:
[:node| | type var |
"If there is something of the form i >= 0, then i should be signed, not unsigned."
(node isSend
and: [(locals includes: (var := node receiver variableNameOrNil))
and: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by inferred unsigned types"
and: [(#(<= < >= >) includes: node selector)
and: [node args first isConstant
and: [node args first value = 0
and: [(type := self typeFor: var in: aCodeGen) notNil
and: [type first == $u]]]]]]]) ifTrue:
+ [self declarationAt: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
- [declarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
effectiveNodes at: var put: { declarations at: var. node }].
"if an assignment to an untyped local of a known type, set the local's type to that type.
Only observe known sends (methods in the current set) and typed local variables."
(node isAssignment
and: [(locals includes: (var := node variable name))
and: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by previously inferred types"
and: [(type := node expression isSend
ifTrue: [aCodeGen returnTypeOrNilForSend: node expression in: self]
ifFalse: [self typeFor: node expression in: aCodeGen]) notNil
and: [aCodeGen isSimpleType: type]]]]) ifTrue:
[aCodeGen mergeTypeOf: var in: declarations with: type method: self.
effectiveNodes at: var put: { declarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]].
^effectiveNodes!
Item was changed:
----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') -----
inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen
"Answer a collection of statements to replace the given send. directReturn indicates
that the send is the expression in a return statement, so returns can be left in the
body of the inlined method. If exitVar is nil, the value returned by the send is not
used; thus, returns need not assign to the output variable.
Types are propagated to as-yet-untyped variables when inlining a send that is assigned,
otherwise the assignee variable type must match the return type of the inlinee. Return
types are not propagated."
| sel meth methArgs exitLabel inlineStmts label exitType |
sel := aSendNode selector.
meth := aCodeGen methodNamed: sel.
methArgs := meth args.
"convenient for debugging..."
aCodeGen maybeBreakForInlineOf: aSendNode in: self.
(methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue:
[methArgs := methArgs allButFirst].
methArgs size = aSendNode args size ifFalse:
[^nil].
meth := meth copy.
"Propagate the return type of an inlined method"
(directReturn or: [exitVar notNil]) ifTrue:
[exitType := directReturn
ifTrue: [returnType]
ifFalse: [(self typeFor: exitVar in: aCodeGen) ifNil: [#sqInt]].
(exitType = #void or: [exitType = meth returnType]) ifFalse:
[meth propagateReturnIn: aCodeGen]].
"Propagate any unusual argument types to untyped argument variables"
methArgs
with: aSendNode args
do: [:formal :actual|
(meth declarationAt: formal ifAbsent: nil) ifNil:
[(self typeFor: actual in: aCodeGen) ifNotNil:
[:type|
type ~= #sqInt ifTrue:
+ [meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
- [meth declarationAt: formal put: type, ' ', formal]]]].
meth renameVarsForInliningInto: self except: #() in: aCodeGen.
meth renameLabelsForInliningInto: self.
self addVarsDeclarationsAndLabelsOf: meth except: #().
meth hasReturn ifTrue:
[directReturn ifFalse:
[exitLabel := self unusedLabelForInliningInto: self.
(meth exitVar: exitVar label: exitLabel) "is label used?"
ifTrue: [ labels add: exitLabel ]
ifFalse: [ exitLabel := nil ]]].
(inlineStmts := OrderedCollection new: 100)
add: (label := TLabeledCommentNode new setComment: 'begin ', sel);
addAll: (self argAssignmentsFor: meth send: aSendNode in: aCodeGen);
addAll: meth statements. "method body"
(directReturn
and: [meth endsWithReturn not]) ifTrue:
[inlineStmts add:
(TReturnNode new setExpression: (TVariableNode new setName: 'nil'))].
exitLabel ~= nil ifTrue:
[inlineStmts add:
(TLabeledCommentNode new setLabel:
exitLabel comment: 'end ', meth selector)].
^inlineStmts!
Item was changed:
----- Method: TMethod>>newCascadeTempFor: (in category 'initialization') -----
newCascadeTempFor: aTParseNode
| varName varNode |
varName := self extraVariableName: 'cascade'.
varNode := TVariableNode new setName: varName.
aTParseNode isLeaf ifFalse:
+ [self
+ declarationAt: varName
- [declarations
- at: varName
put: [:tm :cg| | type |
type := tm determineTypeFor: aTParseNode in: cg.
(VMStructType structTargetKindForType: type) == #struct ifTrue:
["can't copy structs into cascade temps; the struct is not updated.
must change to a pointer."
type := type, ' *'.
parseTree nodesDo:
[:node|
(node isAssignment
and: [node variable name = varName]) ifTrue:
[node setExpression: (TSendNode new
setSelector: #addressOf:
receiver: (TVariableNode new setName: 'self')
arguments: {node expression})]]].
type]].
^varNode!
Item was changed:
----- Method: TMethod>>renameLabelsUsing: (in category 'inlining support') -----
renameLabelsUsing: aDictionary
"Rename all labels according to the old->new mappings of the given dictionary."
+ aDictionary isEmpty ifTrue:
+ [^self].
+ labels := labels collect: [ :label | aDictionary at: label ifAbsent: [label]].
- labels := labels collect: [ :label |
- (aDictionary includesKey: label) ifTrue: [ aDictionary at: label ] ifFalse: [ label ].
- ].
+ parseTree nodesDo:
+ [ :node |
+ (node isGoTo and: [aDictionary includesKey: node label]) ifTrue:
+ [node setLabel: (aDictionary at: node label)].
+ (node isLabel and: [aDictionary includesKey: node label]) ifTrue:
+ [node setLabel: (aDictionary at: node label)]]!
- parseTree nodesDo: [ :node |
- (node isGoTo and: [aDictionary includesKey: node label]) ifTrue: [
- node setLabel: (aDictionary at: node label).
- ].
- (node isLabel and: [aDictionary includesKey: node label]) ifTrue: [
- node setLabel: (aDictionary at: node label).
- ].
- ].!
Item was changed:
----- Method: TMethod>>renameVariablesUsing: (in category 'inlining support') -----
renameVariablesUsing: aDictionary
"Rename all variables according to old->new mappings of the given dictionary."
| newDecls newProperties |
+ aDictionary isEmpty ifTrue: [^self].
+
"map args and locals"
args := args collect: [ :arg | aDictionary at: arg ifAbsent: [ arg ]].
locals := locals collect: [ :v | aDictionary at: v ifAbsent: [ v ]].
"map declarations"
newDecls := declarations species new.
declarations keysAndValuesDo:
[:oldName :decl|
(aDictionary at: oldName ifAbsent: nil)
ifNotNil:
[:newName| | index |
index := decl indexOfWord: oldName.
newDecls
at: newName
put: (index ~= 0
ifTrue: [decl copyReplaceFrom: index to: index + oldName size - 1 with: newName]
ifFalse: [decl])]
ifNil: [newDecls at: oldName put: decl]].
self newDeclarations: newDecls.
newProperties := properties copy.
newProperties pragmas do:
[:pragma| | mappedArgs |
mappedArgs := pragma arguments collect: [:arg| arg isString ifTrue: [aDictionary at: arg ifAbsent: arg] ifFalse: [arg]].
mappedArgs ~= pragma arguments ifTrue:
[pragma setArguments: mappedArgs]].
self properties: newProperties.
"map variable names in parse tree"
parseTree nodesDo:
[ :node |
(node isVariable
and: [aDictionary includesKey: node name]) ifTrue:
[node setName: (aDictionary at: node name)].
(node isStmtList and: [node args size > 0]) ifTrue:
[node setArguments: (node args collect: [ :arg | aDictionary at: arg ifAbsent: [ arg ]])]]!
More information about the Vm-dev
mailing list