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

commits at source.squeak.org commits at source.squeak.org
Tue Nov 22 01:23:09 UTC 2016


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

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

Name: VMMaker.oscog-eem.2001
Author: eem
Time: 21 November 2016, 5:22:12.864973 pm
UUID: 2c3cb42e-09ea-444f-b1b4-84bfa0cdd9d9
Ancestors: VMMaker.oscog-nice.2000

RegisterAllocatingCogit
Get the 64-bit system as far as the isInMemory send in SmalltalkImage>>#send:toClassesNamedIn:with:.

Main change is to not merge following a return (there is no mergeSimStack at a fixup).

Fix several asserts checking the spill state of the stack.
Reorder the compilationTrace flags and add tracing of compilation in cog:selector: and cogFullBlockMethod:numCopied:.
Improve printing of constasnts in the sim stack entry classes.

=============== Diff against VMMaker.oscog-nice.2000 ===============

Item was changed:
  ----- Method: CogRegisterAllocatingSimStackEntry>>printStateOn: (in category 'printing') -----
  printStateOn: aStream
  	<doNotGenerate> "Smalltalk-side only"
  	type isInteger ifFalse: [^self].
  	aStream nextPut: $(.
  	type caseOf: {
  		[SSBaseOffset]	-> [aStream
  								nextPutAll: 'bo ';
  								nextPutAll: (cogit backEnd nameForRegister: register).
  							offset negative ifFalse: [aStream nextPut: $+].
  							aStream print: offset].
  		[SSConstant]	-> [aStream
  								nextPutAll: 'const ';
+ 								nextPutAll: (cogit coInterpreter shortPrint: constant)].
- 								print: constant].
  		[SSRegister]	-> [aStream
  								nextPutAll: 'reg ';
  								nextPutAll: (cogit backEnd nameForRegister: register)].
  		[SSSpill]		-> [aStream
  								nextPutAll: 'spill @ ';
  								nextPutAll: (cogit backEnd nameForRegister: register).
  							offset negative ifFalse: [aStream nextPut: $+].
  							aStream print: offset] }.
  	(spilled and: [type ~= SSSpill]) ifTrue:
  		[aStream nextPutAll: ' (spilled)'].
  	liveRegister ~= NoReg ifTrue:
  		[aStream nextPutAll: ' (live: '; nextPutAll: (cogit backEnd nameForRegister: liveRegister); nextPut: $)].
  	bcptr ifNotNil:
  		[aStream space; nextPut: ${; print: bcptr; nextPut: $}].
  	aStream nextPut: $)!

Item was changed:
  ----- Method: CogSimStackEntry>>printStateOn: (in category 'printing') -----
  printStateOn: aStream
  	<doNotGenerate> "Smalltalk-side only"
  	type isInteger ifFalse: [^self].
  	aStream nextPut: $(.
  	type caseOf: {
  		[SSBaseOffset]	-> [aStream
  								nextPutAll: 'bo ';
  								nextPutAll: (cogit backEnd nameForRegister: register).
  							offset negative ifFalse: [aStream nextPut: $+].
  							aStream print: offset].
  		[SSConstant]	-> [aStream
  								nextPutAll: 'const ';
+ 								nextPutAll: (cogit coInterpreter shortPrint: constant)].
- 								print: constant].
  		[SSRegister]	-> [aStream
  								nextPutAll: 'reg ';
  								nextPutAll: (cogit backEnd nameForRegister: register)].
  		[SSSpill]		-> [aStream
  								nextPutAll: 'spill @ ';
  								nextPutAll: (cogit backEnd nameForRegister: register).
  							offset negative ifFalse: [aStream nextPut: $+].
  							aStream print: offset] }.
  	(spilled and: [type ~= SSSpill]) ifTrue:
  		[aStream nextPutAll: ' (spilled)'].
  	bcptr ifNotNil:
  		[aStream space; nextPut: ${; print: bcptr; nextPut: $}].
  	aStream nextPut: $)!

Item was changed:
  ----- Method: Cogit>>cogFullBlockMethod:numCopied: (in category 'jit - api') -----
  cogFullBlockMethod: aMethodObj numCopied: numCopied
  	"Attempt to produce a machine code method for the bytecode method
  	 object aMethodObj.  N.B. If there is no code memory available do *NOT*
  	 attempt to reclaim the method zone.  Certain clients (e.g. ceSICMiss:)
  	 depend on the zone remaining constant across method generation."
  	<api>
  	<option: #SistaV1BytecodeSet>
  	<returnTypeC: #'CogMethod *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
+ 	(self exclude: aMethodObj) ifTrue:
+ 		[^nil].
- 	self cCode: [] inSmalltalk: "for debugging, allow excluding methods based on selector or methodClass"
- 		[self class initializationOptions
- 			at: #DoNotJIT
- 			ifPresent:
- 				[:excluded| 
- 				(excluded anySatisfy: [:exclude| aMethodObj = exclude]) ifTrue:
- 					[coInterpreter transcript nextPutAll: 'EXCLUDING '; nextPutAll: aMethodObj; nextPutAll: ' (compiled block)'; cr; flush.
- 					 ^nil]]].
  	self deny: (coInterpreter methodHasCogMethod: aMethodObj).
  	self assert: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
  	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
  	"If the generators for the alternate bytecode set are missing then interpret."
  	(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
  		ifTrue:
  			[(self numElementsIn: generatorTable) <= 256 ifTrue:
  				[^nil].
  			 bytecodeSetOffset := 256]
  		ifFalse:
  			[bytecodeSetOffset := 0].
  	objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
  	methodObj := aMethodObj.
  	methodHeader := objectMemory methodHeaderOf: aMethodObj.
  	cogMethod := self compileCogFullBlockMethod: numCopied.
  	(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  		[cogMethod asInteger = InsufficientCodeSpace ifTrue:
  			[coInterpreter callForCogCompiledCodeCompaction].
  		 self maybeFreeCounters.
  		 "Right now no errors should be reported, so nothing more to do."
  		 "self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
  		 ^nil].
  	"self cCode: ''
  		inSmalltalk:
  			[coInterpreter printCogMethod: cogMethod.
  			 ""coInterpreter symbolicMethod: aMethodObj.""
  			 self assertValidMethodMap: cogMethod."
  			 "self disassembleMethod: cogMethod."
  			 "printInstructions := clickConfirm := true""]."
  	^cogMethod!

Item was changed:
  ----- Method: Cogit>>compilationTrace: (in category 'simulation only') -----
  compilationTrace: anInteger
+ 	"1 = compilation
+ 	 2 = bytecode descriptor.
+ 	 4 = simStack.
+ 	 8 = spill
+ 	 16 = merge
+ 	32 = fixup"
  	compilationTrace := anInteger!

Item was added:
+ ----- Method: Cogit>>exclude: (in category 'simulation only') -----
+ exclude: aMethodObj
+ 	"For debugging, allow excluding methods based on selector or methodClass.  Answer if the mehtod should be excluded."
+ 	<inline: true>
+ 	self cCode: [] inSmalltalk: "for debugging, allow excluding methods based on selector or methodClass"
+ 		[self class initializationOptions
+ 			at: #DoNotJIT
+ 			ifPresent:
+ 				[:excluded| 
+ 				(excluded anySatisfy: [:exclude| aMethodObj = exclude]) ifTrue:
+ 					[coInterpreter transcript nextPutAll: 'EXCLUDING '; nextPutAll: aMethodObj; nextPutAll: ' (compiled block)'; cr; flush.
+ 					 ^true]].
+ 		 (compilationTrace anyMask: 1) ifTrue:
+ 			[| methodClass |
+ 			 methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
+ 			 coInterpreter transcript
+ 				nextPutAll: 'compiling compiled block in ';
+ 				nextPutAll: methodClass;
+ 				cr; flush]].
+ 	^false!

Item was changed:
  ----- Method: Cogit>>exclude:selector: (in category 'simulation only') -----
  exclude: aMethodObj selector: aSelectorOop
  	"For debugging, allow excluding methods based on selector or methodClass.  Answer if the mehtod should be excluded."
  	<inline: true>
+ 	self cCode: [] inSmalltalk:
+ 		[| methodClass selector |
+ 		 self class initializationOptions
+ 			at: #DoNotJIT
+ 			ifPresent:
+ 				[:excluded|
+ 				methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
+ 				selector := coInterpreter stringOf: aSelectorOop.
+ 				(excluded anySatisfy: [:exclude| selector = exclude or: [methodClass = exclude]]) ifTrue:
+ 					[coInterpreter transcript
+ 						nextPutAll: 'EXCLUDING ';
+ 						nextPutAll: methodClass;
+ 						nextPutAll: '>>#';
+ 						nextPutAll: selector;
+ 						cr; flush.
+ 					 ^true]].
+ 		 (compilationTrace anyMask: 1) ifTrue:
+ 			[methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
+ 			 selector := coInterpreter stringOf: aSelectorOop.
+ 			 selector isEmpty ifTrue:
+ 				[selector := coInterpreter stringOf: (coInterpreter maybeSelectorOfMethod: aMethodObj)].
+ 			 coInterpreter transcript
+ 				nextPutAll: 'compiling ';
+ 				nextPutAll: methodClass;
+ 				nextPutAll: '>>#';
+ 				nextPutAll: selector;
+ 				cr; flush]].
+ 	^false!
- 	^self
- 		cCode: [false]
- 		inSmalltalk:
- 			[self class initializationOptions
- 				at: #DoNotJIT
- 				ifPresent:
- 					[:excluded| | methodClass selector |
- 					methodClass := coInterpreter nameOfClass: (coInterpreter methodClassOf: aMethodObj).
- 					selector := coInterpreter stringOf: aSelectorOop.
- 					(excluded anySatisfy: [:exclude| selector = exclude or: [methodClass = exclude]]) ifTrue:
- 						[coInterpreter transcript nextPutAll: 'EXCLUDING '; nextPutAll: methodClass; nextPutAll: '>>#'; nextPutAll: selector; cr; flush.
- 						 ^true]].
- 			 ^false]!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>nameOfClass: (in category 'accessing') -----
+ nameOfClass: objOop
+ 	^(objectMap keyAtValue: objOop) name!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>primNumberExternalCall (in category 'accessing') -----
+ primNumberExternalCall
+ 	^coInterpreter primNumberExternalCall!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>shortPrint: (in category 'accessing') -----
+ shortPrint: oop
+ 	^(objectMemory isImmediate: oop)
+ 		ifTrue: [coInterpreter shortPrint: oop]
+ 		ifFalse: [(objectMap keyAtValue: oop) printString]!

Item was removed:
- ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForSend (in category 'bytecode generator support') -----
- flushLiveRegistersForSend
- 	<inline: true>
- 	0 to: simStackPtr do:
- 		[:i|
- 		 self assert: (self simStackAt: i) type = (i <= methodOrBlockNumTemps
- 													ifTrue: [SSBaseOffset]
- 													ifFalse: [SSSpill]).
- 		 (self simStackAt: i) liveRegister: NoReg]!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForSend: (in category 'bytecode generator support') -----
+ flushLiveRegistersForSend: numArgs
+ 	<inline: true>
+ 	simSelf liveRegister: NoReg.
+ 	0 to: simStackPtr - numArgs - 1 do:
+ 		[:i|
+ 		 self assert: (self simStackAt: i) type = (i < methodOrBlockNumTemps
+ 													ifTrue: [SSBaseOffset]
+ 													ifFalse: [SSSpill]).
+ 		 (self simStackAt: i) liveRegister: NoReg]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genMarshalledSend:numArgs:sendTable: (in category 'bytecode generator support') -----
  genMarshalledSend: selectorIndex numArgs: numArgs sendTable: sendTable
+ 	self flushLiveRegistersForSend: numArgs.
- 	self flushLiveRegistersForSend.
  	^super genMarshalledSend: selectorIndex numArgs: numArgs sendTable: sendTable!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>restoreSimStackAtMergePoint: (in category 'simulation stack') -----
  restoreSimStackAtMergePoint: fixup
  	<inline: true>
+ 	"All the execution paths reaching a merge point expect everything to be spilled
+ 	 on stack and the optStatus is unknown.  If the merge point follows a return, it
+ 	 isn't a merge, but a sdkip past a return.  If it is a real merge point then throw
+ 	 away all simStack and optStatus optimization state."
+ 	fixup mergeSimStack ifNotNil:
+ 		[simSpillBase := methodOrBlockNumTemps.
+ 		 optStatus isReceiverResultRegLive: false.
+ 		 0 to: simStackPtr do:
+ 			[:i|
+ 			self cCode: [simStack at: i put: (fixup mergeSimStack at: i)]
+ 				inSmalltalk: [(simStack at: i) copyFrom: (fixup mergeSimStack at: i)]]].
+ 	^0!
- 	"All the execution paths reaching a merge point expect everything to be
- 	spilled on stack and the optStatus is unknown. Throw away all simStack and 
- 	optStatus optimization state."
- 	simSpillBase := methodOrBlockNumTemps.
- 	optStatus isReceiverResultRegLive: false.
- 	0 to: simStackPtr do:
- 		[:i|
- 		self cCode: [simStack at: i put: (fixup mergeSimStack at: i)]
- 			inSmalltalk: [(simStack at: i) copyFrom: (fixup mergeSimStack at: i)]].
- 	^ 0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>setMergeSimStackOf: (in category 'bytecode generator support') -----
  setMergeSimStackOf: fixup
  	<var: #fixup type: #'BytecodeFixup *'>
+ 	self assert: nextFixup <= numFixups.
- 	self assert: nextFixup < numFixups.
  	self moveSimStackConstantsToRegisters.
  	self cCode: [fixup mergeSimStack: mergeSimStacksBase + (nextFixup * self simStackSlots * (self sizeof: CogSimStackEntry))].
  	nextFixup := nextFixup + 1.
  	self cCode: [self mem: fixup mergeSimStack cp: simStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [fixup mergeSimStack: self copySimStack]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceDescriptor: (in category 'simulation only') -----
  traceDescriptor: descriptor
  	<cmacro: '(ign) 0'>
  	(compilationTrace anyMask: 2) ifTrue:
  		[coInterpreter transcript cr; print: bytecodePC; space; nextPutAll: descriptor generator; flush]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceFixup: (in category 'simulation only') -----
  traceFixup: fixup
  	<cmacro: '(ign) 0'>
  	| index |
+ 	(compilationTrace anyMask: 32) ifTrue:
- 	(compilationTrace anyMask: 8) ifTrue:
  		[index := (fixups object identityIndexOf: fixup) - 1.
  		 coInterpreter transcript
  			ensureCr;
  			print: bytecodePC; nextPutAll: ' -> '; print: index; nextPut: $/; print: index + initialPC;
  			nextPut: $:; space.
  			fixup printStateOn: coInterpreter transcript.
  			coInterpreter transcript cr; flush]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceMerge: (in category 'simulation only') -----
  traceMerge: fixup
  	<cmacro: '(ign) 0'>
  	| index |
+ 	(compilationTrace anyMask: 16) ifTrue:
- 	(compilationTrace anyMask: 4) ifTrue:
  		[index := (fixups object identityIndexOf: fixup) - 1.
  		 coInterpreter transcript
  			ensureCr;
  			print: index; nextPut: $/; print: index + initialPC;
  			nextPut: $:; space.
  			fixup printStateOn: coInterpreter transcript.
  			coInterpreter transcript cr; flush]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceSimStack (in category 'simulation only') -----
  traceSimStack
  	<cmacro: '() 0'>
+ 	(compilationTrace anyMask: 4) ifTrue:
- 	(compilationTrace anyMask: 1) ifTrue:
  		[self printSimStack]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceSpill: (in category 'simulation only') -----
  traceSpill: simStackEntry
  	<cmacro: '(ign) 0'>
+ 	(compilationTrace anyMask: 8) ifTrue:
- 	(compilationTrace anyMask: 2) ifTrue:
  		[coInterpreter transcript cr; print: bytecodePC; space; print: simStackEntry; flush]!



More information about the Vm-dev mailing list