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

commits at source.squeak.org commits at source.squeak.org
Wed Jun 8 18:02:55 UTC 2016


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

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

Name: VMMaker.oscog-eem.1886
Author: eem
Time: 8 June 2016, 11:00:38.901828 am
UUID: d413db9f-37cc-4c5d-bfc6-87b11203ee96
Ancestors: VMMaker.oscog-eem.1885

Slang:

Fix type inferrence for the 64-bit VM and some other cases after the bug fix in VMMaker.oscog-eem.1883 uncovers bugs in existing code.

Collapse returnTypeForSend:in: & returnTypeOrNilForSend:in: onto returnTypeForSend:in:ifNil:.

If a method ends with an explicit return of an expression then default its type to #sqInt, only defaulting to #void if the class defines it as the default return type and there is no explicit return of an expression (other thna ^self). Replace transformVoidReturns with transformReturns to handle both void returns (^expr => expr. ^self) and self returns in methods defaulted to sqInt (^self => ^0).

Eliminate some translation time warnings for plugins.

If possible, put a CurrentReadOnlySourceFiles cacheDuring: around parsing of methods to TMethods toi save cycles.

Simulator:
Add a mechanism to limit the number of open files for debugging in the FilePluginSimulator.


In 1886, Robert Louis Stevenson's novella Strange Case of Dr Jekyll and Mr Hyde is published, Karl Benz patents the first successful gasoline-driven automobile, the Benz Patent-Motorwagen (built in 1885), Wilhelm Steinitz becomes first recognized World Chess Champion, American pharmacist Dr. John Pemberton invents a carbonated beverage that will be named Coca-Cola, and Heinrich Hertz at the University of Karlsruhe verifies the existence of electromagnetic waves.

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

Item was changed:
  ----- Method: CCodeGenerator>>computeKernelReturnTypes (in category 'public') -----
  computeKernelReturnTypes
  	| dictionary |
  	dictionary := Dictionary newFromPairs:
  		#(oopAt: #sqInt oopAt:put: #sqInt
  			oopAtPointer: #sqInt oopAtPointer:put: #sqInt
  		 byteAt: #sqInt byteAt:put: #sqInt
  			byteAtPointer: #sqInt byteAtPointer:put: #sqInt
  		 shortAt: #sqInt shortAt:put: #sqInt
  			shortAtPointer: #sqInt shortAtPointer:put: #sqInt
  		 intAt: #sqInt intAt:put: #sqInt
  			intAtPointer: #sqInt intAtPointer:put: #sqInt
  		 longAt: #sqInt longAt:put: #sqInt
  			longAtPointer: #sqInt longAtPointer:put: #sqInt
  				long32At: #int long32At:put: #int
  					unalignedLongAt: #sqInt unalignedLongAt:put: #sqInt
  						unalignedLong32At: #int unalignedLong32At:put: #int
  
  		 long64At: #sqLong long64At:put: #sqLong
  		
  		 fetchFloatAt:into: #void storeFloatAt:from: #void
  			fetchFloatAtPointer:into: #void storeFloatAtPointer:from: #void
  		 fetchSingleFloatAt:into: #void storeSingleFloatAt:from: #void
  			fetchSingleFloatAtPointer:into: #void storeSingleFloatAtPointer:from: #void
  
+ 		 pointerForOop: #'char *' oopForPointer: #sqInt
+ 		 baseHeaderSize #sqInt wordSize #sqInt bytesPerOop #sqInt).
- 		 pointerForOop: #'char *' oopForPointer: #sqInt).
  	^dictionary!

Item was changed:
  ----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesAndMethods
  	"Infer the return tupe and the types of untyped variables.
  	 As far as variables go, for now we try only to infer variables
  	 assigned the result of #longLongAt:, but much more could be
  	 done here."
  
  	"Iterate over all methods, inferring #void return types, until we reach a fixed point."
  	| allMethods |
  	allMethods := apiMethods
  					ifNil: [methods]
  					ifNotNil: [(Set withAll: methods)
  								addAll: apiMethods;
  								yourself].
  	"Make an initial pass to assign the return types of all simple methods that return constants,
  	 or those that have explicit return types."						
  	allMethods do:
  		[:m|
  		m removeFinalSelfReturnIn: self. "must precede recordDeclarationsIn: because it may set returnType"
  		m recordDeclarationsIn: self.
  		(m returnType isNil
  		 and: [m isReturnConstant]) ifTrue:
  			[m inferReturnTypeIn: self]].
  
  	"now iterate until we reach a fixed point"
  	[| changedReturnType |
  	 changedReturnType := false.
  	 allMethods do:
  		[:m|
  		 m inferTypesForImplicitlyTypedVariablesIn: self.
  		 (m inferReturnTypeIn: self) ifTrue:
  			[changedReturnType := true]].
  	 changedReturnType] whileTrue.
  
  	"Type all as-yet-untyped methods as the default"
  	methods do:
  		[:m|
  		m returnType ifNil:
+ 			[m returnType: (m returnsExpression
+ 								ifTrue: [#sqInt]
+ 								ifFalse: [self implicitReturnTypeFor: m])].
+ 		m transformReturns].
- 			[m returnType: (self implicitReturnTypeFor: m selector)]].
  
  	"Make a final pass to type anything assigned from the default type"
  	allMethods do:
  		[:m|
  		 m inferTypesForImplicitlyTypedVariablesIn: self]!

Item was removed:
- ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') -----
- returnTypeForSend: sendNode in: aTMethod
- 	"Answer the return type for a send.  Absent sends default to #sqInt.
- 	 The inferred type should match as closely as possible the C type of
- 	 generated expessions so that inlining would not change the expression."
- 	| sel methodOrNil |
- 	methodOrNil := self anyMethodNamed: (sel := sendNode selector).
- 	(methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue:
- 		[^self baseTypeForType: methodOrNil returnType].
- 	^kernelReturnTypes
- 		at: sel
- 		ifAbsent:
- 			[sel
- 				caseOf: {
- 				[#integerValueOf:]		->	[#sqInt].
- 				[#isIntegerObject:]		->	[#int].
- 				[#negated]				->	[self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
- 				[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#//]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#\\]					->	[self typeForArithmetic: sendNode in: aTMethod].
- "				[#>>]					->	[self
- 												promoteArithmeticTypes: (self unsignedTypeForIntegralType: (self typeFor: sendNode receiver in: aTMethod))
- 												and: (self typeFor: sendNode args first in: aTMethod)].
- 				[#<<]					->	[self typeForArithmetic: sendNode in: aTMethod]."
- 				[#rem:]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#quo:]					->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#addressOf:]			->	[(self typeFor: sendNode receiver in: aTMethod)
- 												ifNil: [#sqInt]
- 												ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
- 				[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
- 				[#bitAnd:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#bitOr:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#bitXor:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#bitClear:]				->	[self typeForArithmetic: sendNode in: aTMethod].
- 				[#bitInvert32]			->	[#'unsigned int'].
- 				[#bitInvert64]			->	[self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
- 				[#byteSwap32]			->	[#'unsigned int'].
- 				[#byteSwap64]			->	[#'unsigned long long'].
- 				[#byteSwapped32IfBigEndian:]	->	[#'unsigned int'].
- 				[#byteSwapped64IfBigEndian:]	->	[#'unsigned long long'].
- 				[#=]					->	[#int].
- 				[#~=]					->	[#int].
- 				[#==]					->	[#int].
- 				[#~~]					->	[#int].
- 				[#<]					->	[#int].
- 				[#<=]					->	[#int].
- 				[#>]					->	[#int].
- 				[#>=]					->	[#int].
- 				[#between:and:]		->	[#int].
- 				[#anyMask:]				->	[#int].
- 				[#allMask:]				->	[#int].
- 				[#noMask:]				->	[#int].
- 				[#isNil]					->	[#int].
- 				[#notNil]				->	[#int].
- 				[#&]					->	[#int].
- 				[#|]						->	[#int].
- 				[#not]					->	[#int].
- 				[#asFloat]				->	[#double].
- 				[#atan]					->	[#double].
- 				[#exp]					->	[#double].
- 				[#log]					->	[#double].
- 				[#sin]					->	[#double].
- 				[#sqrt]					->	[#double].
- 				[#asLong]				->	[#long].
- 				[#asInteger]			->	[#sqInt].
- 				[#asUnsignedInteger]	->	[#usqInt].
- 				[#asUnsignedLong]		->	[#'unsigned long'].
- 				[#asVoidPointer]		->	[#'void *'].
- 				[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
- 				[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
- 				[#cCoerce:to:]			->	[sendNode args last value].
- 				[#cCoerceSimple:to:]	->	[sendNode args last value].
- 				[#sizeof:]				->	[#'unsigned long']. "Technically it's a size_t but it matches unsigned long on target architectures so far..."
- 				[#ifTrue:ifFalse:]		->	[self typeForConditional: sendNode in: aTMethod].
- 				[#ifFalse:ifTrue:]		->	[self typeForConditional: sendNode in: aTMethod].
- 				[#ifTrue:]				->	[self typeForConditional: sendNode in: aTMethod].
- 				[#ifFalse:]				->	[self typeForConditional: sendNode in: aTMethod] }
- 				otherwise: "If there /is/ a method for sel but its retrn type is as yet unknown we /mustn't/ default it.
- 							We can only default unbound selectors."
- 					[methodOrNil ifNotNil: [nil] ifNil: [#sqInt]]]!

Item was added:
+ ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') -----
+ returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil
+ 	"Answer the return type for a send.  Unbound sends default to typeIfNil.
+ 	 Methods with types as yet unknown have a type determined either by the
+ 	 kernelReturnTypes or the table below, or, if they are in neither set, then nil.
+ 	 The inferred type should match as closely as possible the C type of
+ 	 generated expessions so that inlining would not change the expression.
+ 	 If there is a method for sel but its return type is as yet unknown it mustn't
+ 	 be defaulted, since on a subsequent pass its type may be computable."
+ 	| sel methodOrNil |
+ 	methodOrNil := self anyMethodNamed: (sel := sendNode selector).
+ 	(methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue:
+ 		[^self baseTypeForType: methodOrNil returnType].
+ 	^kernelReturnTypes
+ 		at: sel
+ 		ifAbsent:
+ 			[sel
+ 				caseOf: {
+ 				[#integerValueOf:]		->	[#sqInt].
+ 				[#isIntegerObject:]		->	[#int].
+ 				[#negated]				->	[self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
+ 				[#+]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#-]						->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#*]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#/]						->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#//]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#\\]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#rem:]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#quo:]					->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				"C99 Sec Bitwise shift operators ... 3 Sematics ...
+ 				 The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..."
+ 				[#>>]					->	[self typeFor: sendNode receiver in: aTMethod].
+ 				[#<<]					->	[self typeFor: sendNode receiver in: aTMethod].
+ 				[#addressOf:]			->	[(self typeFor: sendNode receiver in: aTMethod)
+ 												ifNil: [#sqInt]
+ 												ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
+ 				[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
+ 				[#bitAnd:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#bitOr:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#bitXor:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#bitClear:]				->	[self typeForArithmetic: sendNode in: aTMethod].
+ 				[#bitInvert32]			->	[#'unsigned int'].
+ 				[#bitInvert64]			->	[self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int].
+ 				[#byteSwap32]			->	[#'unsigned int'].
+ 				[#byteSwap64]			->	[#'unsigned long long'].
+ 				[#byteSwapped32IfBigEndian:]	->	[#'unsigned int'].
+ 				[#byteSwapped64IfBigEndian:]	->	[#'unsigned long long'].
+ 				[#=]					->	[#int].
+ 				[#~=]					->	[#int].
+ 				[#==]					->	[#int].
+ 				[#~~]					->	[#int].
+ 				[#<]					->	[#int].
+ 				[#<=]					->	[#int].
+ 				[#>]					->	[#int].
+ 				[#>=]					->	[#int].
+ 				[#between:and:]		->	[#int].
+ 				[#anyMask:]				->	[#int].
+ 				[#allMask:]				->	[#int].
+ 				[#noMask:]				->	[#int].
+ 				[#isNil]					->	[#int].
+ 				[#notNil]				->	[#int].
+ 				[#&]					->	[#int].
+ 				[#|]						->	[#int].
+ 				[#not]					->	[#int].
+ 				[#asFloat]				->	[#double].
+ 				[#atan]					->	[#double].
+ 				[#exp]					->	[#double].
+ 				[#log]					->	[#double].
+ 				[#sin]					->	[#double].
+ 				[#sqrt]					->	[#double].
+ 				[#asLong]				->	[#long].
+ 				[#asInteger]			->	[#sqInt].
+ 				[#asUnsignedInteger]	->	[#usqInt].
+ 				[#asUnsignedLong]		->	[#'unsigned long'].
+ 				[#asVoidPointer]		->	[#'void *'].
+ 				[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
+ 				[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
+ 				[#cCoerce:to:]			->	[sendNode args last value].
+ 				[#cCoerceSimple:to:]	->	[sendNode args last value].
+ 				[#sizeof:]				->	[#'unsigned long']. "Technically it's a size_t but it matches unsigned long on target architectures so far..."
+ 				[#ifTrue:ifFalse:]		->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#ifFalse:ifTrue:]		->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#ifTrue:]				->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#ifFalse:]				->	[self typeForConditional: sendNode in: aTMethod].
+ 				[#and:]					->	[#sqInt].
+ 				[#or:]					->	[#sqInt] }
+ 				otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted,
+ 							since on a subsequent pass its type may be computable.  Only default unbound selectors."
+ 					[methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]!

Item was removed:
- ----- Method: CCodeGenerator>>returnTypeOrNilForSend:in: (in category 'type inference') -----
- returnTypeOrNilForSend: sendNode in: aTMethod
- 	"Answer the return type for a send.  Sends of known but as-yet-untyped methods answer nil."
- 	| sel |
- 	(self anyMethodNamed: (sel := sendNode selector)) ifNotNil:
- 		[:m|
- 		^m returnType ifNotNil: [:type| self baseTypeForType: type]].
- 	^self returnTypeForSend: sendNode in: aTMethod!

Item was changed:
  FilePlugin subclass: #FilePluginSimulator
+ 	instanceVariableNames: 'openFiles states maxOpenFiles'
- 	instanceVariableNames: 'openFiles states'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-InterpreterSimulation'!
  
  !FilePluginSimulator commentStamp: 'tpr 5/5/2003 12:02' prior: 0!
  File plugin simulation for the VM simulator!

Item was changed:
  ----- Method: FilePluginSimulator>>fileOpenName:size:write:secure: (in category 'file primitives') -----
  fileOpenName: nameIndex size: nameSize write: writeFlag secure: secureFlag
  	"Open the named file, possibly checking security. Answer the file oop."
  	| path f index |
+ 	openFiles size >= maxOpenFiles ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrLimitExceeded].
  	path := interpreterProxy interpreter asString: nameIndex size: nameSize.
  	f := writeFlag
  			ifTrue: [FileStream fileNamed: path]
  			ifFalse:
  				[(StandardFileStream isAFileNamed: path) ifTrue:
  					[FileStream readOnlyFileNamed: path]].
  	f ifNil: [^interpreterProxy primitiveFail].
  	f binary.
  	index := openFiles size + 1.
  	openFiles at: index put: f.
  	^interpreterProxy integerObjectOf: index!

Item was changed:
  ----- Method: FilePluginSimulator>>initialiseModule (in category 'initialize-release') -----
  initialiseModule
  	"See FilePluginSimulator>>sqFileStdioHandlesInto:"
  	(openFiles := Dictionary new)
  		at: 0 put: (FakeStdinStream for: interpreterProxy interpreter); "stdin"
  		at: 1 put: Transcript; "stdout"
  		at: 2 put: Transcript. "stderr"
  	states := IdentityDictionary new.
+ 	maxOpenFiles := VMClass initializationOptions at: #MaxFileDescriptors ifAbsent: [1024].
  	^super initialiseModule!

Item was changed:
  ----- Method: InterpreterPlugin class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	"Note: This method must be implemented by all subclasses to declare variables."
  
  	aCCodeGenerator 
  		var: #interpreterProxy type: #'struct VirtualMachine*';
+ 		removeVariable: 'translatedMethodCache' ifAbsent: nil.
+ 	self declareHeaderFilesIn: aCCodeGenerator!
- 		removeVariable: 'translatedMethodCache'.
- 	self declareHeaderFilesIn: aCCodeGenerator.!

Item was changed:
  ----- Method: InterpreterProxy>>characterObjectOf: (in category 'object access') -----
  characterObjectOf: characterCode
  	<option: #(atLeastVMProxyMajor:minor: 1 13)>
- 	<var: #cPtr type: #int>
  	^StackInterpreter objectMemoryClass characterObjectOf: characterCode!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  	| cls fmt lastIndex startIP bytecodesPerLine column |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^self shortPrintOop: oop].
  	self printHex: oop.
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [self whereIs: oop]); cr].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop).
  		 objectMemory hasSpurMemoryManagerAPI ifTrue:
  			[self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop).
  			 objectMemory printHeaderTypeOf: oop].
  		 ^self cr].
  	(objectMemory isForwarded: oop) ifTrue:
  		[self
  			print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
  			print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop).
  		 objectMemory printHeaderTypeOf: oop.
  		 ^self cr].
  	self print: ': a(n) '.
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
  	fmt := objectMemory formatOf: oop.
  	fmt > objectMemory lastPointerFormat ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
  	self cr.
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
+ 		 (objectMemory isWordsNonImm: oop) ifTrue:
- 		 (objectMemory isWords: oop) ifTrue:
  			[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^self].
  		^self printStringOf: oop; cr].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * objectMemory wordSize + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
  					[self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))'
  						inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: TAssignmentNode>>typeOrNilFrom:in: (in category 'type inference') -----
  typeOrNilFrom: aCodeGenerator in: aTMethod
  	"This is the default type in case of doubt"
+ 	^(variable typeOrNilFrom: aCodeGenerator in: aTMethod) ifNil:
+ 		[expression typeOrNilFrom: aCodeGenerator in: aTMethod]!
- 	^variable typeOrNilFrom: aCodeGenerator in: aTMethod!

Item was changed:
  ----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') -----
  addTypesFor: node to: typeSet in: aCodeGen
  	"Add the value types for the node to typeSet.
  	 Answer if any type was derived from an as-yet-untyped method, which allows us to abort
  	 inferReturnTypeFromReturnsIn: if the return type depends on a yet-to-be-typed method."
  	| expr |
  	expr := node.
  	[expr isAssignment or: [expr isStmtList]] whileTrue:
  		[expr isAssignment ifTrue:
  			[expr := expr variable].
  		 expr isStmtList ifTrue:
  			[expr := expr statements last]].
  	expr isSend ifTrue:
  		[(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) ifTrue:
  			[^expr args
  				inject: false
  				into: [:asYetUntyped :block|
  					asYetUntyped | (self addTypesFor: block to: typeSet in: aCodeGen)]].
+ 		(aCodeGen returnTypeForSend: expr in: self ifNil: nil)
- 		(aCodeGen returnTypeOrNilForSend: expr in: self)
  			ifNil: [^(aCodeGen methodNamed: expr selector) notNil and: [expr selector ~~ selector]]
  			ifNotNil:
  				[:type |
  				typeSet add: type.
  				^false].].
  	expr isVariable ifTrue:
  		[(aCodeGen typeOfVariable: expr name)
  			ifNotNil: [:type| typeSet add: type]
  			ifNil: [typeSet add: (expr name = 'self'
  										ifTrue: [#void]
  										ifFalse: [#sqInt])]].
  	expr isConstant ifTrue:
+ 		[(expr typeOrNilFrom: aCodeGen in: self) ifNotNil:
+ 			[:type | typeSet add: type]]..
- 		[(expr typeOrNilFrom: aCodeGen in: self)
- 			ifNotNil: [:type | typeSet add: type]]..
  	^false!

Item was changed:
  ----- Method: TMethod>>determineTypeFor:in: (in category 'C code generation') -----
  determineTypeFor: aNode in: aCodeGen
  	aNode isSend ifTrue:
+ 		[^aCodeGen returnTypeForSend: aNode in: self ifNil: #sqInt].
- 		[^(aCodeGen returnTypeForSend: aNode in: self) ifNil: [#sqInt]].
  	aNode isAssignment ifTrue:
  		[^self determineTypeFor: aNode expression in: aCodeGen].
  	self error: 'don''t know how to extract return type from this kind of node'!

Item was changed:
  ----- Method: TMethod>>emitCFunctionPrototype:generator:isPrototype: (in category 'C code generation') -----
  emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: isPrototype "<Boolean>"
  	"Emit a C function header for this method onto the given stream.
  	 Answer if the method has any compileTimeOptionPragmas"
  	| compileTimeOptionPragmas returnTypeIsFunctionPointer |
  	(compileTimeOptionPragmas := self compileTimeOptionPragmas) notEmpty ifTrue:
  		[self outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
+ 	returnTypeIsFunctionPointer := returnType notNil
+ 									and: [returnType last = $)
+ 									and: [returnType includesSubString: (aCodeGen cFunctionNameFor: selector)]].
- 	returnTypeIsFunctionPointer := returnType last = $)
- 									and: [returnType includesSubString: (aCodeGen cFunctionNameFor: selector)].
  	export 
  		ifTrue:
  			[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)]
  		ifFalse:
  			[self isStatic
  				ifTrue: [aStream nextPutAll: 'static ']
  				ifFalse:
  					[isPrototype ifTrue:
  						[aStream nextPutAll: 'extern ']].
  			 (isPrototype or: [inline ~~ #always]) ifFalse: [aStream nextPutAll: 'inline '].
+ 			 aStream nextPutAll: (returnType ifNil: [#sqInt])].
- 			 aStream nextPutAll: returnType].
  	(functionAttributes isNil or: [returnTypeIsFunctionPointer]) ifFalse:
  		[aStream space; nextPutAll: functionAttributes].
  	isPrototype ifTrue: [aStream space] ifFalse: [aStream cr].
  	returnTypeIsFunctionPointer ifFalse:
  		[aStream
  			nextPutAll: (aCodeGen cFunctionNameFor: selector);
  			nextPut: $(.
  		args isEmpty
  			ifTrue: [aStream nextPutAll: #void]
  			ifFalse:
  				[args
  					do: [:arg| aStream nextPutAll: (self declarationAt: arg)]
  					separatedBy: [aStream nextPutAll: ', ']].
  		aStream nextPut: $)].
  	isPrototype ifTrue:
  		[aStream nextPut: $;; cr.
  		 compileTimeOptionPragmas isEmpty ifFalse:
  			[aCodeGen maybeEmitPrimitiveFailureDefineFor: selector on: aStream.
  			 self terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream]].
  	^compileTimeOptionPragmas notEmpty!

Item was changed:
  ----- Method: TMethod>>inferReturnTypeIn: (in category 'type inference') -----
  inferReturnTypeIn: aCodeGen
  	"Attempt to infer the return type of the receiver and answer if it changed."
  
  	| existingReturnType |
  	existingReturnType := returnType.
  	self inferReturnTypeFromReturnsIn: aCodeGen.
- 
- 	"If the return type is now void, replace any and all ^expr with expr. ^self"
- 	(existingReturnType ~= returnType and: [returnType = #void]) ifTrue:
- 		[self transformVoidReturns].
- 
  	^existingReturnType ~= returnType!

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)"
  	| alreadyExplicitlyTypedOrNotToBeTyped effectiveNodes |
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	alreadyExplicitlyTypedOrNotToBeTyped := 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: [(alreadyExplicitlyTypedOrNotToBeTyped 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.
  			 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: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types"
  		 	[type := node expression isSend
+ 						ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil]
- 						ifTrue: [aCodeGen returnTypeOrNilForSend: node expression in: self]
  						ifFalse: [self typeFor: node expression in: aCodeGen].
  			 type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
  				ifNil: [alreadyExplicitlyTypedOrNotToBeTyped add: var] 
  				ifNotNil: "Merge simple types; complex types must be defined by the programmer."
  					[(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>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
  isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
  	"Answer if the given parameter node may be substituted directly into the body of
  	 the method during inlining, instead of being bound to the actual parameter variable.
  	 We allow a constant, a local variable, or a formal parameter, or simple expressions
  	 involving only these to to be directly substituted. Note that global variables cannot
  	 be subsituted into methods with possible side effects (i.e., methods that may assign
  	 to global variables) because the inlined method might depend on having the value of
  	 the global variable captured when it is passed in as an argument."
  
  	| madeNonTrivialCall count constantExpression usageCount |
  	aNode isConstant ifTrue: [^true].
  
  	aNode isVariable ifTrue:
  		[((locals includes: aNode name)
  		 or: [(args includes: aNode name)
  		 or: [#('self' 'true' 'false' 'nil') includes: aNode name]]) ifTrue: [^true].
  		"We can substitute any variable provided it is only read in the method being inlined,
  		 and if it is not read after any non-trivial call (which may update the variable)."
  		madeNonTrivialCall := false.
  		(targetMeth isComplete
  		 and: [targetMeth parseTree
  				noneSatisfy:
  					[:node|
  					 (node isSend
  					  and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
  						[madeNonTrivialCall := true].
  					 (madeNonTrivialCall and: [node isVariable and: [node name = argName]])
  					 or: [node isAssignment
  						  and: [node variable name = argName]]]
  				unless:
  					[:node|
  					node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue:
  			[^true].
  		^targetMeth maySubstituteGlobal: aNode name in: aCodeGen].
  
  	"don't much up asserts with complex expansions"
  	(targetMeth usesVariableUninlinably: argName in: aCodeGen) ifTrue:
  		[^false].
  
  	"For now allow literal blocks to be substituted.  They better be accessed only
  	 with value[:value:*] messages though!!"
  	aNode isStmtList ifTrue: [^true].
  
  	"Don't inline expressions unless type-compatible,"
  	aNode isSend ifTrue:
  		[(aCodeGen
+ 				isActualType: (aCodeGen returnTypeForSend: aNode in: self ifNil: #incompatible)
- 				isActualType: (aCodeGen returnTypeForSend: aNode in: self)
  				compatibleWithFormalType: (self typeFor: argName in: aCodeGen)) ifFalse:
  			[^false]].
  
  	count := 0.
  	constantExpression := true.
  	"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
  	aNode nodesDo:
  		[:node|
  		node isConstant
  			ifTrue: [] ifFalse:
  		[node isSend
  			ifTrue:
  				[((VMBasicConstants mostBasicConstantSelectors includes: node selector)
  				  or: [node isBuiltinOperator]) ifFalse: [^false].
  				 count := count + 1] ifFalse:
  		[node isVariable ifTrue:
  			[(aCodeGen isNonArgumentImplicitReceiverVariableName: node name) ifFalse:
  				[constantExpression := false.
  				((locals includes: node name)
  				 or: [(args includes: node name)
  				 or: [(#('self' 'true' 'false' 'nil') includes: node name)
  				 or: [targetMeth maySubstituteGlobal: node name in: aCodeGen]]]) ifFalse: [^false]]] ifFalse:
  		[^false]]]].
  	"inline constant expressions"
  	constantExpression ifNil: [^true].
  
  	"scan target to find usage count"
  	usageCount := 0.
  	targetMeth parseTree nodesDo:
  		[:node|
  		(node isVariable and: [node name = argName]) ifTrue:
  			[usageCount := usageCount + 1]].
  	"(usageCount > 1 and: [count <= usageCount]) ifTrue:
  		[[UsageCounts := Dictionary new.
  		  self removeClassVarName: #UsageCounts].
  		 (UsageCounts at: usageCount ifAbsentPut: [Set new]) add: ({targetMeth. argName. aNode})]."
  	"Now only inline expressions if they are used only once or are simple
  	 w.r.t. the usage count, and the usage count is not large; a heuristic that seems to work well enough."
  	^usageCount = 1 or: [usageCount <= 7 and: [count <= usageCount]]!

Item was changed:
  ----- Method: TMethod>>returnType: (in category 'accessing') -----
  returnType: aString
  	"Set the type of the values returned by this method.
  	 This string will be used in the C declaration of this function.
  	 If the type exists as a symbol, use that."
  
+ 	returnType := aString isSymbol
+ 					ifTrue: [aString]
+ 					ifFalse: [(Symbol findInterned: aString) ifNil: [aString]]!
- 	returnType := (Symbol findInterned: aString) ifNil: [aString]!

Item was added:
+ ----- Method: TMethod>>returnsExpression (in category 'testing') -----
+ returnsExpression
+ 	"Answer true if the last statement of this method is a return of some expression, not merely self or nil."
+ 
+ 	^parseTree returnsExpression!

Item was added:
+ ----- Method: TMethod>>transformReturns (in category 'type inference') -----
+ transformReturns
+ 	"Once the return type has been found or inferred, returns may bneed to be modified.
+ 	 If the return type is #void, any occurrences of ^expr must be replaced with expr. ^self.
+ 	 If the type is #sqInt any any occurrences of ^self are replaced with ^0."
+ 	(returnType == #void or: [returnType == #sqInt]) ifFalse:
+ 		[^self].
+ 	parseTree nodesWithParentsDo:
+ 		[:node :parent|
+ 		node isReturn ifTrue:
+ 			[(node expression isVariable and: [node expression name = 'self'])
+ 				ifTrue:
+ 					[returnType = #sqInt ifTrue:
+ 						[node setExpression: (TConstantNode new setValue: 0)]]
+ 				ifFalse:
+ 					[returnType = #void ifTrue:
+ 						[parent
+ 							replaceChild: node
+ 							with: (TStmtListNode new
+ 									setArguments: #()
+ 									statements: {node expression.
+ 												  TReturnNode new 
+ 													setExpression: (TVariableNode new setName: 'self')
+ 													yourself})]]]]!

Item was removed:
- ----- Method: TMethod>>transformVoidReturns (in category 'type inference') -----
- transformVoidReturns
- 	"Once the return type has been found or inferred to be #void,
- 	 any occurrences of ^expr must be replaced with expr. ^self."
- 	self assert: returnType == #void.
- 	parseTree nodesWithParentsDo:
- 		[:node :parent|
- 		(node isReturn
- 		 and: [node expression isVariable not
- 			or: [node expression name ~= 'self']]) ifTrue:
- 			[parent
- 				replaceChild: node
- 				with: (TStmtListNode new
- 						setArguments: #()
- 						statements: {node expression.
- 									  TReturnNode new 
- 										setExpression: (TVariableNode new setName: 'self')
- 										yourself})]]!

Item was changed:
  ----- Method: TSendNode>>typeOrNilFrom:in: (in category 'type inference') -----
  typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	^aCodeGenerator returnTypeForSend: self in: aTMethod ifNil: nil!
- 	^aCodeGenerator returnTypeOrNilForSend: self in: aTMethod!

Item was added:
+ ----- Method: TStmtListNode>>returnsExpression (in category 'testing') -----
+ returnsExpression
+ 	"Answer true if the last statement of this block is a return of some expression, not merely self or nil."
+ 
+ 	statements isEmpty ifTrue:
+ 		[^false].
+ 	statements last isReturn ifFalse:
+ 		[^false].
+ 	statements last isVariable ifFalse:
+ 		[^true].
+ 	^statements last variable ~= 'self'
+ 	  and: [statements last variable ~= 'nil']!

Item was changed:
  ----- Method: TStmtListNode>>typeOrNilFrom:in: (in category 'type inference') -----
  typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	^statements isEmpty ifFalse:
+ 		[statements last typeOrNilFrom: aCodeGenerator in: aTMethod]!
- 	statements isEmpty ifTrue: [^nil].
- 	^statements last typeOrNilFrom: aCodeGenerator in: aTMethod!

Item was changed:
  ----- Method: VMMaker>>buildCodeGeneratorForCogit (in category 'generate sources') -----
  buildCodeGeneratorForCogit
  	"Answer the code generator for translating the cogit."
  
+ 	^(Smalltalk classNamed: #CurrentReadOnlySourceFiles)
+ 		ifNil: [self
+ 				buildCodeGeneratorForCogit: self interpreterClass cogitClass
+ 				includeAPIMethods: true
+ 				initializeClasses: true]
+ 		ifNotNil:
+ 			[:crosf|
+ 			 crosf cacheDuring:
+ 				[self
+ 					buildCodeGeneratorForCogit: self interpreterClass cogitClass
+ 					includeAPIMethods: true
+ 					initializeClasses: true]]!
- 	^self
- 		buildCodeGeneratorForCogit: self interpreterClass cogitClass
- 		includeAPIMethods: true
- 		initializeClasses: true!

Item was changed:
  ----- Method: VMMaker>>buildCodeGeneratorForInterpreter (in category 'generate sources') -----
  buildCodeGeneratorForInterpreter
  	"Answer the code generator for translating the interpreter."
  
+ 	^(Smalltalk classNamed: #CurrentReadOnlySourceFiles)
+ 		ifNil: [self
+ 				buildCodeGeneratorForInterpreter: self interpreterClass
+ 				includeAPIMethods: true
+ 				initializeClasses: true]
+ 		ifNotNil:
+ 			[:crosf|
+ 			 crosf cacheDuring:
+ 				[self
+ 					buildCodeGeneratorForInterpreter: self interpreterClass
+ 					includeAPIMethods: true
+ 					initializeClasses: true]]!
- 	^self
- 		buildCodeGeneratorForInterpreter: self interpreterClass
- 		includeAPIMethods: true
- 		initializeClasses: true!



More information about the Vm-dev mailing list