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

commits at source.squeak.org commits at source.squeak.org
Mon Nov 26 23:33:27 UTC 2012


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

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

Name: VMMaker.oscog-eem.220
Author: eem
Time: 26 November 2012, 3:30:47.084 pm
UUID: 47ddca03-a770-4fe1-8ac8-ca9ecff907d3
Ancestors: VMMaker.oscog-eem.219

Slang:
Deal with ^self's when inlining e.g. ADPCMCodec>>nextBits:put:.

Don't coerce results if return type is void.

Make CCodeGenerator>>addMethodsForPrimitives: use
compileToTMethodSelector:in: for creating TMethods.

Fix a bug in shift generation when casting a type that doesn't include
a variable name.

Add support for asUnsignedLong cast (longs being guaranteed to
be large enough to contain a pointer).

Make external plugin generation log only when pliugin is generated.

Do not elide final ^self if it is explicit.

Plugins:
Fix some warnings.

Cogit:
Rename jumpTargetAt: to the more accurate jumpTargetPCAt:.

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

Item was changed:
  ----- Method: CCodeGenerator>>addMethodsForPrimitives: (in category 'public') -----
  addMethodsForPrimitives: classAndSelectorList 
  	| verbose |
+ 	verbose := false.
+ 	classAndSelectorList do:
+ 		[:classAndSelector | | aClass selector meth |
+ 		aClass := Smalltalk at: classAndSelector first.
+ 		selector := classAndSelector last.
- 	classAndSelectorList do: 
- 		[:classAndSelector | | aClass sel meth source |
- 		aClass := Smalltalk at: (classAndSelector at: 1).
  		self addAllClassVarsFor: aClass.
  "TPR - should pool vars also be added here?"
  
+ 		"compile the method source and convert to a suitable translation method.
+ 		 find the method in either the class or the metaclass"
+ 		meth := self
+ 					compileToTMethodSelector: selector
+ 					in: ((aClass includesSelector: selector)
+ 							ifTrue: [aClass]
+ 							ifFalse: [aClass class]).
- 		"find the method in either the class or the metaclass"
- 		sel := classAndSelector at: 2.
- 		source := (aClass includesSelector: sel)
- 					ifTrue: [aClass sourceCodeAt: sel]
- 					ifFalse: [aClass class sourceCodeAt: sel].
- 
- 		"compile the method source and convert to a suitable translation 
- 		method "
- 		meth := (Compiler new
- 					parse: source
- 					in: aClass
- 					notifying: nil)
- 					asTranslationMethodOfClass: self translationMethodClass.
- 
- 		(aClass includesSelector: sel)
- 			ifTrue: [meth definingClass: aClass]
- 			ifFalse: [meth definingClass: aClass class].
  		meth primitive > 0 ifTrue:[meth preparePrimitiveName].
  		"for old-style array accessing: 
  		meth covertToZeroBasedArrayReferences."
  		meth replaceSizeMessages.
  		self addMethod: meth].
  
- 	"method preparation"
- 	verbose := false.
  	self prepareMethods.
  	verbose
  		ifTrue: 
  			[self printUnboundCallWarnings.
  			self printUnboundVariableReferenceWarnings.
  			logger cr].
  
  	"code generation"
  	self doInlining: true.
  
  	methods do:[:m|
  		"if this method is supposed to be a primitive (rather than a helper 
  		routine), add assorted prolog and epilog items"
  		m primitive > 0 ifTrue: [m preparePrimitivePrologue]].!

Item was changed:
  ----- Method: CCodeGenerator>>emitCConstantsOn: (in category 'C code generator') -----
  emitCConstantsOn: aStream 
  	"Store the global variable declarations on the given stream."
  	| unused constList |
  	unused := constants keys asSet.
+ 	"Don't generate any defines for the externally defined constants,
+ 	 STACKVM, COGVM, COGMTVM et al, unless they're actuaslly used."
+ 	(VMClass class>>#initializeMiscConstantsWith:) literalsDo:
+ 		[:lit|
+ 		(lit isVariableBinding and: [lit key isString]) ifTrue:
+ 			[unused add: lit key]].
  	methods do:
  		[:meth|
  		meth parseTree nodesDo:
  			[:n| n isConstant ifTrue: [unused remove: n name ifAbsent: []]]].
  	unused copy do:
  		[:const|
  		(variableDeclarations anySatisfy: [:value| value includesSubString: const]) ifTrue:
  			[unused remove: const ifAbsent: []]].
- 	"Don't generate any defines for the externally defined constants, STACKVM, COGVM, COGMTVM et al."
- 	(VMClass class>>#initializeMiscConstantsWith:) literalsDo:
- 		[:lit|
- 		lit isVariableBinding ifTrue:
- 			[unused add: lit key]].
  	unused remove: #BytesPerWord ifAbsent: []. "force inclusion of BytesPerWord declaration"
+ 	constList := constants keys reject: [:any| unused includes: any].
- 	constList := constants keys reject:[:any| unused includes: any].
  	aStream cr; nextPutAll: '/*** Constants ***/'; cr.
  	(self sortStrings: constList) do:
  		[:varName| | node default value |
  		node := constants at: varName.
  		node name isEmpty ifFalse:
  			["Allow the class to provide an alternative definition, either of just the value or the whole shebang"
  			default := self cLiteralFor: node value name: varName.
  			value := vmClass
  						ifNotNil:
  							[(vmClass specialValueForConstant: node name default: default)
  								ifNotNil: [:specialDef| specialDef]
  								ifNil: [default]]
  						ifNil: [default].
  			value first ~= $# ifTrue:
  				[aStream nextPutAll: '#define '; nextPutAll: node name; space].
  			aStream nextPutAll: value; cr]].
  	aStream cr!

Item was added:
+ ----- Method: CCodeGenerator>>generateAsUnsignedLong:on:indent: (in category 'C translation') -----
+ generateAsUnsignedLong: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPutAll:'((unsigned long)'.
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPut: $)!

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
  generateShiftRight: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
  	| decl |
  	"If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
  	(msgNode receiver isVariable
  	 and: [(decl := self typeOfVariable: msgNode receiver name) notNil
  	 and: [#('usqLong' 'sqLong' 'unsigned long long' 'long long' 'unsigned __int64' '__int64')
  			anySatisfy: [:type| decl beginsWith: type]]])
  		ifTrue:
  			["If not unsigned cast it to unsigned."
  			 (decl first = $u) ifFalse:
  				[aStream
  					nextPutAll: '((unsigned ';
+ 					nextPutAll: ((decl endsWith: msgNode receiver name)
+ 									ifTrue: [decl allButLast: msgNode receiver name size]
+ 									ifFalse: [decl]);
- 					nextPutAll: (decl allButLast: msgNode receiver name size);
  					nextPut: $)].
  			 self emitCExpression: msgNode receiver on: aStream.
  			 (decl first = $u) ifFalse:
  				[aStream nextPut: $)]]
  		ifFalse:
  			[aStream nextPutAll: '((usqInt) '.
  			 self emitCExpression: msgNode receiver on: aStream.
  			 aStream nextPut: $)].
  	aStream nextPutAll: ' >> '.
  	self emitCExpression: msgNode args first on: aStream!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:			#generateBitAnd:on:indent:
  	#bitOr:				#generateBitOr:on:indent:
  	#bitXor:			#generateBitXor:on:indent:
  	#bitShift:			#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert32:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 	#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#ifNotNil:		#generateIfNotNil:on:indent:
  	#ifNil:			#generateIfNil:on:indent:
  	#ifNotNil:ifNil:	#generateIfNotNilIfNil:on:indent:
  	#ifNil:ifNotNil:	#generateIfNilIfNotNil:on:indent:
  
  	#at:				#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#cppIf:ifTrue:ifFalse:		#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:				#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#signedIntFromLong		#generateSignedIntFromLong:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement			#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger		#generateAsUnsignedInteger:on:indent:
+ 	#asUnsignedLong			#generateAsUnsignedLong:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  
  	#bytesPerWord 			#generateBytesPerWord:on:indent:
  	#baseHeaderSize			#generateBaseHeaderSize:on:indent:
  	
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#value								#generateValue:on:indent:
  	#value:								#generateValue:on:indent:
  	#value:value:						#generateValue:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented			#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:					#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:				#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:			#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:			#generateIfFalseIfTrueAsArgument:on:indent:
  	#ifNotNil:				#generateIfNotNilAsArgument:on:indent:	
  	#ifNil:					#generateIfNilAsArgument:on:indent:
  	#ifNotNil:ifNil:			#generateIfNotNilIfNilAsArgument:on:indent:
  	#ifNil:ifNotNil:			#generateIfNilIfNotNilAsArgument:on:indent:
  	#cCode:				#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:		#generateInlineCCodeAsArgument:on:indent:
  	#cppIf:ifTrue:ifFalse:	#generateInlineCppIfElseAsArgument:on:indent:
  	#cppIf:ifTrue:			#generateInlineCppIfElseAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was removed:
- ----- Method: CogIA32Compiler>>jumpTargetAt: (in category 'disassembly') -----
- jumpTargetAt: pc 
- 	| size byte offset |
- 	size := self instructionSizeAt: pc.
- 	size = 2
- 		ifTrue:
- 			[byte := objectMemory byteAt: pc + 1.
- 			 offset := (byte bitAnd: 16r80) = 0 ifTrue: [byte] ifFalse: [byte - 256]]
- 		ifFalse:
- 			[byte := objectMemory byteAt: pc + size - 1.
- 			 offset := (byte bitAnd: 16r80) = 0 ifTrue: [byte] ifFalse: [byte - 256].
- 			 offset := offset << 8 + (objectMemory byteAt: pc + size - 2).
- 			 offset := offset << 8 + (objectMemory byteAt: pc + size - 3).
- 			 offset := offset << 8 + (objectMemory byteAt: pc + size - 4)].
- 	^pc + size + offset!

Item was added:
+ ----- Method: CogIA32Compiler>>jumpTargetPCAt: (in category 'disassembly') -----
+ jumpTargetPCAt: pc
+ 	<returnTypeC: #sqInt>
+ 	| size byte offset |
+ 	size := self instructionSizeAt: pc.
+ 	size = 2
+ 		ifTrue:
+ 			[byte := objectMemory byteAt: pc + 1.
+ 			 offset := (byte bitAnd: 16r80) = 0 ifTrue: [byte] ifFalse: [byte - 256]]
+ 		ifFalse:
+ 			[byte := objectMemory byteAt: pc + size - 1.
+ 			 offset := (byte bitAnd: 16r80) = 0 ifTrue: [byte] ifFalse: [byte - 256].
+ 			 offset := offset << 8 + (objectMemory byteAt: pc + size - 2).
+ 			 offset := offset << 8 + (objectMemory byteAt: pc + size - 3).
+ 			 offset := offset << 8 + (objectMemory byteAt: pc + size - 4)].
+ 	^pc + size + offset!

Item was changed:
  ----- Method: Cogit>>blockDispatchFor:perform:arg: (in category 'disassembly') -----
  blockDispatchFor: cogMethod perform: quaternaryFunction arg: arg
  	"Evaluate quaternaryFunction with the block start mcpc, prev pc in block
  	 dispatch, current pc in block dispatch and the supplied arg for each entry
  	 in the block dispatch.  If the function answers non-zero answer the value
  	 it answered. Used for disassembling blockDispatch."
  	<doNotGenerate>
  	| pc prevpc blockEntry end targetpc result |
  	cogMethod blockEntryOffset = 0 ifTrue:
  		[^nil].
  	blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
  	prevpc := pc := blockEntry.
  	end := (self mapEndFor: cogMethod) - 1.
  	[pc < end] whileTrue:
  		[(backEnd isJumpAt: pc)
  			ifTrue:
+ 				[targetpc := backEnd jumpTargetPCAt: pc.
- 				[targetpc := backEnd jumpTargetAt: pc.
  				 pc := pc + (backEnd instructionSizeAt: pc).
  				 targetpc < blockEntry ifTrue:
  					[result := self perform: quaternaryFunction
  								with: targetpc
  								with: prevpc
  								with: pc
  								with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 prevpc := pc]]
  			ifFalse:
  				[pc := pc + (backEnd instructionSizeAt: pc)]].
  	^0!

Item was changed:
  ----- Method: Cogit>>blockDispatchTargetsFor:perform:arg: (in category 'method map') -----
  blockDispatchTargetsFor: cogMethod perform: binaryFunction arg: arg
  	"Evaluate binaryFunction with the block start mcpc and supplied arg for each
  	 entry in the block dispatch.  If the function answers non-zero answer the value
  	 it answered.  Used to update back-references to the home method in compaction."
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #binaryFunction declareC: 'usqInt (*binaryFunction)(sqInt mcpc, sqInt arg)'>
  	| pc blockEntry end targetpc result |
  	cogMethod blockEntryOffset = 0 ifTrue:
  		[^nil].
  	blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
  	pc := blockEntry.
  	end := (self mapEndFor: cogMethod) - 1.
  	[pc < end] whileTrue:
  		[(backEnd isJumpAt: pc) ifTrue:
+ 			[targetpc := backEnd jumpTargetPCAt: pc.
- 			[targetpc := backEnd jumpTargetAt: pc.
  			 targetpc < blockEntry ifTrue:
  				[result := self perform: binaryFunction
  							with: targetpc
  							with: arg.
  				 result ~= 0 ifTrue:
  					[^result]]].
  		pc := pc + (backEnd instructionSizeAt: pc)].
  	^0!

Item was changed:
  ----- Method: Cogit>>codeRangesFor: (in category 'disassembly') -----
  codeRangesFor: cogMethod
  	"Answer a sequence of ranges of code for the main method and all of the blocks in a CogMethod.
  	 N.B.  These are in order of block dispatch, _not_ necessarily address order in the method."
  	<doNotGenerate>
  	| pc end blockEntry starts |
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[end := (self addressOfEndOfCase: cogMethod cPICNumCases - 1 inCPIC: cogMethod) + cPICEndSize.
  		 ^{ CogCodeRange
  				from: cogMethod asInteger + (self sizeof: CogMethod)
  				to: end
  				cogMethod: cogMethod
  				startpc: nil }].
  	end := (self mapEndFor: cogMethod) - 1.
  	cogMethod blockEntryOffset = 0 ifTrue:
  		[^{ CogCodeRange
  				from: cogMethod asInteger + (self sizeof: CogMethod)
  				to: end
  				cogMethod: cogMethod
  				startpc: (coInterpreter startPCOfMethodHeader: cogMethod methodHeader) }].
  	pc := blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
  	starts := OrderedCollection with: cogMethod.
  	[pc < end] whileTrue:
  		[| targetpc |
  		 targetpc := blockEntry.
  		 (backEnd isJumpAt: pc) ifTrue:
+ 			[targetpc := backEnd jumpTargetPCAt: pc.
- 			[targetpc := backEnd jumpTargetAt: pc.
  			 targetpc < blockEntry ifTrue:
  				[starts add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]].
  		 pc := pc + (backEnd instructionSizeAt: pc)].
  	starts := starts asSortedCollection.
  	^(1 to: starts size + 1) collect:
  		[:i| | cogSubMethod nextpc |
  		i <= starts size
  			ifTrue:
  				[cogSubMethod := starts at: i.
  				 nextpc := i < starts size ifTrue: [(starts at: i + 1) address] ifFalse: [end].
  				 CogCodeRange
  					from: cogSubMethod address + (self sizeof: cogSubMethod)
  					to: nextpc - 1
  					cogMethod: cogSubMethod
  					startpc: (i = 1
  								ifTrue: [coInterpreter startPCOfMethodHeader: cogMethod methodHeader]
  								ifFalse: [cogSubMethod startpc])]
  			ifFalse:
  				[CogCodeRange
  					from: blockEntry
  					to: end]]!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileStdioHandles (in category 'file primitives') -----
  primitiveFileStdioHandles
  	"Answer an Array of file handles for standard in, standard out and standard error,
  	 with nil in entries that are unvailable, e.g. because the platform does not provide
  	 standard error, etc.  Fail if there are no standard i/o facilities on the platform or
  	 if the security plugin denies access or if memory runs out."
  	| fileRecords result validMask |
  	<export: true>
  	<var: 'fileRecords' declareC: 'SQFile fileRecords[3]'>
  	sHFAfn ~= 0 ifTrue:
  		[(self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]) ifFalse:
  			[^interpreterProxy primitiveFailFor: PrimErrUnsupported]].
  	self cCode: '' inSmalltalk: [fileRecords := Array new: 3].
+ 	validMask := self sqFileStdioHandlesInto: fileRecords.
- 	validMask := self sqFileStdioHandlesInto: (self addressOf: fileRecords).
  	validMask = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrUnsupported].
  	result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
  	result = nil ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	interpreterProxy pushRemappableOop: result.
  	0 to: 2 do:
  		[:index|
  		(validMask bitAnd: (1 << index)) ~= 0 ifTrue:
  			[result := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize.
  			 result = nil ifTrue:
  				[interpreterProxy popRemappableOop.
  				^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  			 interpreterProxy storePointer: index ofObject: interpreterProxy topRemappableOop withValue: result.
  			 self
  				cCode:
  					[self mem: (interpreterProxy firstIndexableField: result)
  						cp: (self addressOf: (fileRecords at: index))
  						y: self fileRecordSize]
  				inSmalltalk:
  					[(interpreterProxy firstIndexableField: result)
  						unitSize: BytesPerWord;
  						at: 0 put: (fileRecords at: index + 1)]]].
  	 "In the threaded VM ensure the handles are old, so that sqFileReadIntoAt is unaffected
  	  by incremental GCs.  See platforms/Cross/plugins/FilePlugin/sqFilePluginBasicPrims.c."
  	self cppIf: COGMTVM
  		ifTrue: [interpreterProxy fullGC].
  	result := interpreterProxy popRemappableOop.
  	interpreterProxy pop: 1 thenPush: result!

Item was changed:
  ----- Method: TMethod>>exitVar:label: (in category 'inlining') -----
  exitVar: exitVar label: exitLabel
  	"Replace each return statement in this method with an assignment to the
  	 exit variable followed by either a return or a goto to the given label.
  	 Answer if a goto was generated."
  	"Optimization: If exitVar is nil, the return value of the inlined method is not being used, so don't add the assignment statement."
  
+ 	| labelUsed map eliminateReturnSelfs |
- 	| labelUsed map |
  	labelUsed := false.
  	map := Dictionary new.
+ 	"Conceivably one might ^self from a struct class and mean it.  In most cases though
+ 	 ^self means `get me outta here, fast'.  So unless this method is from a VMStruct class,
+ 	 elide any ^self's"
+ 	eliminateReturnSelfs := ((definingClass inheritsFrom: VMClass) and: [definingClass isStructClass]) not
+ 							  and: [returnType = #void or: [returnType = #sqInt]].
  	parseTree nodesDo:
  		[:node | | replacement |
  		node isReturn ifTrue:
+ 			[replacement := (node expression isVariable "Eliminate ^self's"
+ 							   and: [node expression name = 'self'
+ 							   and: [eliminateReturnSelfs]])
+ 								ifTrue: [nil]
+ 								ifFalse:
+ 									[exitVar
+ 										ifNil: [node expression]
+ 										ifNotNil: [TAssignmentNode new
+ 													setVariable: (TVariableNode new setName: exitVar)
+ 													expression: node expression]].
- 			[replacement := exitVar
- 								ifNil: [node expression]
- 								ifNotNil: [TAssignmentNode new
- 											setVariable: (TVariableNode new setName: exitVar)
- 											expression: node expression].
  			 node ~~ parseTree statements last ifTrue:
+ 				[replacement := replacement
+ 									ifNil: [TGoToNode new setLabel: exitLabel; yourself]
+ 									ifNotNil:
+ 										[TStmtListNode new
+ 											setArguments: #()
+ 											statements: {replacement.
+ 														  TGoToNode new setLabel: exitLabel; yourself};
+ 											yourself].
- 				[replacement := TStmtListNode new
- 									setArguments: #()
- 									statements: {replacement.
- 												  TGoToNode new setLabel: exitLabel; yourself};
- 									yourself.
  				 labelUsed := true].
+ 			map
+ 				at: node
+ 				put: (replacement ifNil:
+ 						[TLabeledCommentNode new setComment: 'return ', node expression printString])]].
- 			map at: node put: replacement]].
  	parseTree replaceNodesIn: map.
  	"Now flatten any new statement lists..."
  	parseTree nodesDo:
  		[:node| | list |
  		(node isStmtList and: [node statements last isStmtList]) ifTrue:
  			[list := node statements last statements.
  			 node statements removeLast; addAllLast: list]].
  	^labelUsed!

Item was changed:
  ----- Method: TMethod>>propagateReturnIn: (in category 'inlining support') -----
  propagateReturnIn: aCodeGen
  	"Propagate the return type to all return nodes"
+ 	| map coercionType |
+ 	returnType = #void ifTrue:
+ 		[^self].
+ 	"The following is necessary for functions returning functions, which have problematic syntax"
+ 	coercionType := aCodeGen
+ 							extractTypeFor: (aCodeGen cFunctionNameFor: self selector)
+ 							fromDeclaration: returnType.
- 	| map |
  	map := IdentityDictionary new.
  	parseTree nodesDo:[:node|
  		node isReturn ifTrue:[
  			map at: node expression put: (TSendNode new
  				setSelector: #cCoerce:to:
  				receiver: (TVariableNode new setName: 'self')
  				arguments: {node expression.
+ 							TConstantNode new setValue: coercionType})]].
- 							TConstantNode new "The following is necessary for functions returning functions, which have problematic syntax"
- 								setValue: (aCodeGen
- 											extractTypeFor: (aCodeGen cFunctionNameFor: self selector)
- 											fromDeclaration: returnType) })]].
  	self replaceNodesIn: map!

Item was changed:
  ----- Method: TMethod>>removeFinalSelfReturn (in category 'transformations') -----
  removeFinalSelfReturn
  	"The Smalltalk parser automatically adds the statement '^self' to the end of methods
+ 	 without explicit returns.  This method removes such statements, since in most VMMaker
+ 	 classes (except struct classes) the generated code has no notion of 'self' anyway.
+ 	 If the statement is removed and no return type has yet been specified asnd the class
+ 	 specifies a default return type (e.g. #void) for methods that don't return, then set the
+ 	 return type accordingly."
- 	 without explicit returns.  This method removes such statements, since the generated
- 	 code has no notion of 'self' anyway.  THis is a hack because it doesn't distinguish
- 	 methods with an explicit return self."
  
+ 	| lastStmt |
+ 	((lastStmt := parseTree statements last) isReturn
- 	| stmtList lastStmt |
- 	stmtList := parseTree statements asOrderedCollection.
- 	lastStmt := stmtList last.
- 
- 	(lastStmt isReturn
  	 and: [lastStmt expression isVariable
  	 and: ['self' = lastStmt expression name]]) ifTrue:
+ 		[| tokens |
+ 		tokens := Scanner new scanTokens: (definingClass sourceCodeAt: selector ifAbsent: ['']).
+ 		(tokens size < 2
+ 		 or: [(tokens last: 2) ~= #(#^ 'self')]) ifTrue:
+ 			[parseTree setStatements: parseTree statements allButLast.
+ 			 returnType = #sqInt ifTrue:
+ 				[([definingClass implicitReturnTypeFor: selector]
+ 					on: MessageNotUnderstood
+ 					do: [:ex| nil]) ifNotNil:
+ 						[:defaultReturnType|
+ 						returnType := defaultReturnType]]]]!
- 		[stmtList removeLast.
- 		parseTree setStatements: stmtList.
- 		returnType = #sqInt ifTrue:
- 			[([definingClass implicitReturnTypeFor: selector]
- 				on: MessageNotUnderstood
- 				do: [:ex| nil]) ifNotNil:
- 				[:defaultReturnType|
- 				returnType := defaultReturnType]]]!

Item was added:
+ ----- Method: VMClass class>>isStructClass (in category 'translation') -----
+ isStructClass
+ 	"The various VMStructType classes override this."
+ 	^false!

Item was changed:
  ----- Method: VMMaker>>generateExternalPlugin: (in category 'generate sources') -----
  generateExternalPlugin: pluginName 
  	"generate the named external plugin"
  	| exports plugin |
  
  	"Refuse to translate this plugin if it requires platform specific files and they are not present."
+ 	[plugin := self validateExternalPlugin: pluginName]
+ 		on: VMMakerException
+ 		do: [:ex|
+ 			logger show: 'external plugin ' , plugin name , ' failed to validate: ' , ex messageText; cr.
+ 			^self].
- 	[plugin := self validateExternalPlugin: pluginName] on: VMMakerException do:[^self].
  
  	[exports := plugin
+ 					translateInDirectory: (self externalPluginsDirectoryFor: plugin)
+ 					doInlining: inline]
- 				translateInDirectory: (self externalPluginsDirectoryFor: plugin)
- 				doInlining: inline]
  		on:  ProvideAnswerNotification
  		do: [:ex|
  			ex tag == #logger
  				ifTrue: [ex resume: logger]
  				ifFalse: [ex pass]].
+ 	exports ifNotNil: "if exp is nil we skip this since the plugin was already up to date"
+ 		[logger show: 'external plugin ' , plugin name , ' generated as ' , plugin moduleName; cr.
+ 		 self export: exports forExternalPlugin: plugin.
+ 		 self processFilesForExternalPlugin: plugin]!
- 	logger show: 'external plugin ' , plugin name , ' generated as ' , plugin moduleName; cr.
- 	exports ifNotNil: ["if exp is nil we skip this since the plugin was already up to date"
- 			self export: exports forExternalPlugin: plugin].
- 	self processFilesForExternalPlugin: plugin!

Item was changed:
  ----- Method: VMProfileMacSupportPlugin>>primitiveDLSym (in category 'primitives') -----
  primitiveDLSym
  	"Answer the address of the argument in the current process or nil if none."
  	| nameObj name namePtr sz addr |
  	<export: true>
  	<var: #name type: #'char *'>
  	<var: #namePtr type: #'char *'>
  	<var: #addr type: #'void *'>
  	nameObj := interpreterProxy stackValue: 0.
  	(interpreterProxy isBytes: nameObj) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	sz := interpreterProxy byteSizeOf: nameObj.
  	name := self malloc: sz+1.
  	namePtr := interpreterProxy firstIndexableField: nameObj.
  	0 to: sz-1 do:[:i| name at: i put: (namePtr at: i)].
  	name at: sz put: 0.
  	addr := self cCode: 'dlsym(RTLD_SELF,name)' inSmalltalk: [0].
  	self free: name.
  	^interpreterProxy methodReturnValue: (addr = 0
  												ifTrue: [interpreterProxy nilObject]
+ 												ifFalse: [interpreterProxy positive32BitIntegerFor: addr asUnsignedLong])!
- 												ifFalse: [interpreterProxy positive32BitIntegerFor: addr])!

Item was added:
+ ----- Method: VMStructType class>>isStructClass (in category 'translation') -----
+ isStructClass
+ 	^true!



More information about the Vm-dev mailing list