[Vm-dev] VM Maker: VMMaker.oscog-eem.160.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 5 22:36:27 UTC 2012


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.160.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.160
Author: eem
Time: 5 May 2012, 3:33:23.184 pm
UUID: c9667f5a-0f6f-464a-99a7-d4ef8e7821b0
Ancestors: VMMaker.oscog-eem.159

Avoid assigning to a block argument in inlineCaseStatement-
BranchesIn:localizingVars:
Fix a comment.

=============== Diff against VMMaker.oscog-eem.159 ===============

Item was changed:
  ----- Method: StackInterpreter>>marriedContext:pointsTo:stackDeltaForCurrentFrame: (in category 'frame access') -----
  marriedContext: spouseContext pointsTo: anOop stackDeltaForCurrentFrame: stackDeltaForCurrentFrame
+ 	"This is a helper for primitiveObjectPointsTo so it *does not* check the frameContext field because that is an implicit self-reference not present in the state ."
- 	"This is a helper for primitiveObjectPointsTo so it *does not* check the frameContext field because that is an implicit self-reference not present in the stale ."
  	| theFP thePage theSP rcvrOffset |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #rcvrOffset type: #'char *'>
  	theFP := self frameOfMarriedContext: spouseContext.
  	theFP = framePointer
  		ifTrue: [theSP := stackPointer + (stackDeltaForCurrentFrame * BytesPerWord)]
  		ifFalse:
  			[thePage := stackPages stackPageFor: theFP.
  			theSP := self findSPOf: theFP on: thePage].
  	(objectMemory isIntegerObject: anOop)
  		ifTrue: "Check stack and instruction pointer fields."
  			[(anOop = (objectMemory integerObjectOf: (self stackPointerIndexForFrame: theFP WithSP: theSP))
  			or: [anOop = (self externalInstVar: InstructionPointerIndex ofContext: spouseContext)]) ifTrue:
  				[^true]]
  		ifFalse: "Check method and sender fields, avoiding unnecessarily reifying sender context."
  			[anOop = (self frameMethodObject: theFP) ifTrue:
  				[^true].
  			 (self isBaseFrame: theFP)
  				ifTrue: [anOop = (self frameCallerContext: theFP) ifTrue:
  							[^true]]
  				ifFalse: [((self frameHasContext: (self frameCallerFP: theFP))
  						and: [anOop = (self frameContext: (self frameCallerFP: theFP))]) ifTrue:
  							[^true]]].
  	"Now check receiver, temps and stack contents"
  	rcvrOffset := self frameReceiverOffset: theFP.
  	 [theSP <= rcvrOffset] whileTrue:
  		[anOop = (stackPages longAt: theSP) ifTrue:
  			[^true].
  		 theSP := theSP + BytesPerWord].
  	"Finally check stacked receiver (closure field or duplicate of receiver) and arguments"
  	theSP := theFP + FoxCallerSavedIP + BytesPerWord.
  	rcvrOffset := theFP + (self frameStackedReceiverOffset: theFP).
  	 [theSP <= rcvrOffset] whileTrue:
  		[anOop = (stackPages longAt: theSP) ifTrue:
  			[^true].
  		 theSP := theSP + BytesPerWord].
  	^false!

Item was changed:
  ----- Method: TMethod>>inlineCaseStatementBranchesIn:localizingVars: (in category 'inlining') -----
+ inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList 
+ 	| maxTemp usedVars v exitLabel |
- inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList
- 
- 	| stmt sel newStatements maxTemp usedVars exitLabel v |
  	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].
- 	parseTree nodesDo: [ :n |
- 		n isCaseStmt ifTrue: [
- 			n cases do: [ :stmtNode |
- 				stmt := stmtNode statements first.
- 				stmt isSend ifTrue: [
- 					sel := stmt selector.
- 					(aCodeGen methodNamed: sel) ifNotNil:
- 						[:meth|
- 						(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].
- 							meth labels do: [ :label | labels add: label ].
- 							newStatements := stmtNode statements asOrderedCollection.
- 							newStatements removeFirst.
- 
- 							exitLabel ~= nil ifTrue: [
- 								newStatements addFirst:
- 									(TLabeledCommentNode new
- 										setLabel: exitLabel comment: 'end case').
- 							].
- 
- 							newStatements addFirst: meth asInlineNode.
- 							newStatements 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"
+ 	varsList do:
+ 		[:var |
+ 		(usedVars includes: var) ifFalse:
+ 			[locals addFirst: var asString]]!
- 	varsList do: [ :var |
- 		(usedVars includes: var) ifFalse: [ locals addFirst: var asString ].
- 	].!



More information about the Vm-dev mailing list