[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