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

commits at source.squeak.org commits at source.squeak.org
Mon Jan 23 21:38:08 UTC 2017


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

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

Name: VMMaker.oscog-eem.2108
Author: eem
Time: 23 January 2017, 1:37:11.765916 pm
UUID: a67fd5c0-631d-44f6-8e28-a367845422e9
Ancestors: VMMaker.oscog-eem.2107

Sista:
Fix awful bug in disassembling Sista mewthods; the old code updated the global variable numCounters and used counters instead of the method's counters.

Add the initializers to check the surrogate accessrs for SistaCogMethod (consequently commit cosmetic changes to the surrogate counters accessors).

Simplify extJumpIfNotInstanceOfBehaviorsBytecode a bit.

Spur:
Have printEntity: print header flags for puns also.

Simulator:
Add click-step support to i=the interpreter (but the break-pointing facilities have yet to be harmonised).

Make sure the code below the guard page is ful of stop instructions.

Fix a simulation slip in printDecodeMethodHeaderOop:.

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

Item was changed:
  ----- Method: CogSistaMethodSurrogate32>>counters: (in category 'accessing') -----
  counters: aValue
  	^memory
+ 		unsignedLongAt: address + baseHeaderSize + 21
- 		unsignedLongAt: address + 21 + baseHeaderSize
  		put: aValue!

Item was changed:
  ----- Method: CogSistaMethodSurrogate64>>counters (in category 'accessing') -----
  counters
+ 	^memory unsignedLong64At: address + 33 + baseHeaderSize!
- 	^memory long64At: address + 33 + baseHeaderSize!

Item was changed:
  ----- Method: CogSistaMethodSurrogate64>>counters: (in category 'accessing') -----
  counters: aValue
  	^memory
+ 		unsignedLong64At: address + baseHeaderSize + 33
- 		long64At: address + 33 + baseHeaderSize
  		put: aValue!

Item was added:
+ ----- Method: CogVMSimulator>>atEachStepBlock (in category 'accessing') -----
+ atEachStepBlock
+ 	^atEachStepBlock!

Item was added:
+ ----- Method: CogVMSimulator>>atEachStepBlock: (in category 'accessing') -----
+ atEachStepBlock: aBlock
+ 	atEachStepBlock := aBlock!

Item was added:
+ ----- Method: CogVMSimulator>>localIP (in category 'accessing') -----
+ localIP
+ 	^localIP!

Item was changed:
+ ----- Method: Cogit>>generateCogFullBlock (in category 'generate machine code') -----
- ----- Method: Cogit>>generateCogFullBlock (in category 'compile abstract instructions') -----
  generateCogFullBlock
  	"We handle jump sizing simply.  First we make a pass that asks each
  	 instruction to compute its maximum size.  Then we make a pass that
  	 sizes jumps based on the maxmimum sizes.  Then we make a pass
  	 that fixes up jumps.  When fixing up a jump the jump is not allowed to
  	 choose a smaller offset but must stick to the size set in the second pass."
  	<returnTypeC: #'CogMethod *'>
  	<option: #SistaV1BytecodeSet>
  	| codeSize headerSize mapSize totalSize startAddress result method |
  	<var: #method type: #'CogMethod *'>
  	headerSize := self sizeof: CogMethod.
  	methodLabel address: methodZone freeStart.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: methodZone freeStart.
  	codeSize := self generateInstructionsAt: methodLabel address + headerSize.
  	mapSize := self generateMapAt: nil start: methodLabel address + cbNoSwitchEntryOffset.
  .
  	totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize.
  	totalSize > MaxMethodSize ifTrue:
  		[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	startAddress := methodZone allocate: totalSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	self assert: startAddress + cbEntryOffset = fullBlockEntry address.
  	self assert: startAddress + cbNoSwitchEntryOffset = fullBlockNoContextSwitchEntry address.
  	result := self outputInstructionsAt: startAddress + headerSize.
  	self assert: startAddress + headerSize + codeSize = result.
  	backEnd padIfPossibleWithStopsFrom: result to: startAddress + totalSize - mapSize - 1.
  	self generateMapAt: startAddress + totalSize - 1 start: startAddress + cbNoSwitchEntryOffset.
  	self flag: #TOCHECK. "It's not clear we want the same header than regular methods. 
  	It could be of the same size, but maybe the cmType could be different and the selector could be ignored." 
  	method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  					size: totalSize
  					selector: objectMemory nilObject.
  	method cpicHasMNUCaseOrCMIsFullBlock: true.
  	postCompileHook ifNotNil:
  		[self perform: postCompileHook with: method.
  		 postCompileHook := nil].
  	^method!

Item was changed:
  ----- Method: Cogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
  initializeCodeZoneFrom: startAddress upTo: endAddress
  	<api>
  	self initializeBackend.
  	backEnd stopsFrom: startAddress to: endAddress - 1.
  	self cCode: [self sqMakeMemoryExecutableFrom: startAddress To: endAddress]
+ 		inSmalltalk:
+ 			[startAddress = self class guardPageSize ifTrue:
+ 				[backEnd stopsFrom: 0 to: endAddress - 1].
+ 			 self initializeProcessor].
- 		inSmalltalk: [self initializeProcessor].
  	codeBase := methodZoneBase := startAddress.
  	minValidCallAddress := (codeBase min: coInterpreter interpretAddress)
  								min: coInterpreter primitiveFailAddress.
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	self maybeGenerateCheckFeatures.
  	self maybeGenerateICacheFlush.
  	self generateVMOwnerLockFunctions.
  	self genGetLeafCallStackPointer.
  	self generateStackPointerCapture.
  	self generateTrampolines.
  	self computeEntryOffsets.
  	self computeFullBlockEntryOffsets.
  	self generateClosedPICPrototype.
  	"repeat so that now the methodZone ignores the generated run-time"
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	"N.B. this is assumed to be the last thing done in initialization; see Cogit>>initialized"
  	self generateOpenPICPrototype!

Item was changed:
  ----- Method: Cogit>>setClickStepBreakBlock (in category 'simulation only') -----
  setClickStepBreakBlock
  	"Set the break block to present a confirmer, breaking if true, and restoring the previous break block.
  	 If an open debugger on the receiver can be found, proceed it."
  	<doNotGenerate>
+ 	| previousBreakBlock previousAtEachStepBlock previousBreakPC previousSingleStep previousClickConfirm |
- 	| previousBreakBlock previousBreakPC previousSingleStep previousClickConfirm |
  	(breakBlock isNil or: [breakBlock method ~~ thisContext method]) ifTrue:
  		[previousBreakBlock := breakBlock.
+ 		 previousAtEachStepBlock := coInterpreter atEachStepBlock.
  		 previousBreakPC := breakPC.
  		 previousSingleStep := singleStep.
  		 previousClickConfirm := clickConfirm.
  		 breakBlock := [:ign|
  						(processor pc ~= previousBreakPC
  						 and: [UIManager confirm: 'step?'])
  							ifTrue: [false]
  							ifFalse: [breakBlock := previousBreakBlock.
+ 									coInterpreter atEachStepBlock: previousAtEachStepBlock.
  									breakPC := previousBreakPC.
  									singleStep := previousSingleStep.
  									clickConfirm := previousClickConfirm.
  									true]].
+ 		 coInterpreter atEachStepBlock:
+ 								[previousAtEachStepBlock value.
+ 								 (coInterpreter localIP ~= previousBreakPC
+ 								  and: [UIManager confirm: 'step?']) ifFalse:
+ 									[breakBlock := previousBreakBlock.
+ 									coInterpreter atEachStepBlock: previousAtEachStepBlock.
+ 									breakPC := previousBreakPC.
+ 									singleStep := previousSingleStep.
+ 									clickConfirm := previousClickConfirm.
+ 									self halt]].
  		 singleStep := breakPC := clickConfirm := true].
  	(World submorphs
  		detect:
  			[:m|
  			 m model class == Debugger
  			 and: [(m model interruptedProcess suspendedContext findContextSuchThat:
  					[:ctxt|
+ 					(ctxt receiver == self
+ 					 and: [ctxt selector == #simulateCogCodeAt:])
+ 					or: [ctxt receiver == coInterpreter
+ 					 and: [ctxt selector == #interpret]]]) notNil]]
- 					ctxt receiver == self
- 					and: [ctxt selector == #simulateCogCodeAt:]]) notNil]]
  		ifNone: []) ifNotNil:
  			[:debuggerWindow|
  			 WorldState addDeferredUIMessage:
  				[debuggerWindow model proceed]]!

Item was added:
+ ----- Method: SistaCogMethod class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"self initialize"
+ 	(Smalltalk classNamed: #CogSistaMethodSurrogate32) ifNotNil:
+ 		[:cms32|
+ 		self checkGenerateSurrogate: cms32 bytesPerWord: 4].
+ 	(Smalltalk classNamed: #CogSistaMethodSurrogate64) ifNotNil:
+ 		[:cms64|
+ 		self checkGenerateSurrogate: cms64 bytesPerWord: 8]!

Item was changed:
  ----- Method: SistaCogit>>disassembleMethod:on: (in category 'disassembly') -----
  disassembleMethod: surrogateOrAddress on: aStream
  	<doNotGenerate>
  	| cogMethod |
  	cogMethod := super disassembleMethod: surrogateOrAddress on: aStream.
  	(cogMethod cmType = CMMethod
  	 and: [cogMethod counters ~= 0]) ifTrue:
  		[aStream nextPutAll: 'counters:'; cr.
+ 		 0 to: (objectRepresentation numCountersFor: cogMethod counters) - 1 do:
- 		 numCounters := objectRepresentation numCountersFor: counters.
- 		 0 to: numCounters - 1 do:
  			[:i| | addr |
  			 addr := i * CounterBytes + counters.
  			 addr printOn: aStream base: 16.
  			 aStream nextPut: $:; space.
  			 (objectMemory long32At: addr) printOn: aStream base: 16.
  			 aStream cr].
  		 aStream flush]!

Item was changed:
  ----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') -----
  printEntity: oop
  	<api>
+ 	| printFlags |
+ 	printFlags := false.
- 	| isObj |
- 	isObj := false.
  	coInterpreter printHex: oop; space.
  	(self addressCouldBeObj: oop) ifFalse:
  		[^coInterpreter print: ((self isImmediate: oop) ifTrue: ['immediate'] ifFalse: ['unknown'])].
  	coInterpreter
  		print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse:
  				[(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse:
  				[(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse:
+ 				[(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: [printFlags := true. 'pun/obj stack'] ifFalse:
+ 				[printFlags := true. 'object']]]]);
- 				[(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: ['pun/obj stack'] ifFalse:
- 				[isObj := true. 'object']]]]);
  		space; printHexnpnp: (self rawNumSlotsOf: oop); print: '/'; printHexnpnp: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop).
+ 	printFlags ifTrue:
- 	isObj ifTrue:
  		[coInterpreter
  			space;
  			print: ((self formatOf: oop) <= 16rF ifTrue: ['f:0'] ifFalse: ['f:']);
  			printHexnpnp: (self formatOf: oop);
  			print: ((self isGrey: oop) ifTrue: [' g'] ifFalse: [' .']);
  			print: ((self isImmutable: oop) ifTrue: ['i'] ifFalse: ['.']);
  			print: ((self isMarked: oop) ifTrue: ['m'] ifFalse: ['.']);
  			print: ((self isPinned: oop) ifTrue: ['p'] ifFalse: ['.']);
  			print: ((self isRemembered: oop) ifTrue: ['r'] ifFalse: ['.'])].
  	coInterpreter cr!

Item was changed:
  ----- Method: StackInterpreter>>extJumpIfNotInstanceOfBehaviorsBytecode (in category 'sista bytecodes') -----
  extJumpIfNotInstanceOfBehaviorsBytecode
  	"254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
  	| tosClassTag literal distance inverse |
  	SistaVM ifFalse: [^self respondToUnknownBytecode].
+ 	self assert: ((extB bitAnd: 128) = 0 or: [extB < 0]).
+ 	(inverse := extB < 0) ifTrue:
+ 		[extB := extB + 128].
- 	extB < 0 
- 		ifTrue: [extB := extB + 128. inverse := true]
- 		ifFalse: [inverse := false].
  	tosClassTag := objectMemory fetchClassTagOf: self internalPopStack.
  	literal := self literal: extA << 8 + self fetchByte.
  	distance := extB << 8 + self fetchByte.
+ 	extA := extB := numExtB := 0.
+ 
+ 	(objectMemory isArrayNonImm: literal) ifTrue:
+ 		[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do:
+ 			[:i |
+ 			 tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal)) ifTrue:
+ 				[inverse ifTrue: [ localIP := localIP + distance ].
+ 				 ^self fetchNextBytecode ] ].
+ 		 inverse ifFalse: [localIP := localIP + distance].
+ 		 ^self fetchNextBytecode].
+ 
+ 	tosClassTag = (objectMemory rawClassTagForClass: literal) = inverse ifTrue:
+ 		[localIP := localIP + distance].
- 	extA := 0.
- 	extB := 0.
- 	numExtB := 0.
- 	(objectMemory isArrayNonImm: literal)
- 		ifTrue:
- 			[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do: [:i |
- 				tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))
- 					ifTrue: [ 
- 						inverse ifTrue: [ localIP := localIP + distance ].
- 						^ self fetchNextBytecode ] ].
- 			 inverse ifFalse: [localIP := localIP + distance].
- 			 ^ self fetchNextBytecode]
- 		ifFalse:
- 			[tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
- 				[inverse ifFalse: [localIP := localIP + distance].
- 				^ self fetchNextBytecode]].
- 	inverse ifTrue: [localIP := localIP + distance].
  	self fetchNextBytecode!

Item was changed:
  ----- Method: StackInterpreter>>printDecodeMethodHeaderOop: (in category 'printing') -----
  printDecodeMethodHeaderOop: methodHeaderOop
  	self printOopShort: methodHeaderOop.
  	(self methodHeaderHasPrimitive: methodHeaderOop) ifTrue:
  		[self print: ' hasPrim'].
  	(self methodHeaderIndicatesLargeFrame: methodHeaderOop) ifTrue:
  		[self print: ' largeFrame'].
  	(SistaVM and: [self isOptimizedMethodHeader: methodHeaderOop]) ifTrue:
  		[self print: ' optimized'].
+ 	(MULTIPLEBYTECODESETS and: [objectMemory integerValueOf: methodHeaderOop]) < 0 ifTrue:
- 	(MULTIPLEBYTECODESETS and: [self integerValueOf: methodHeaderOop]) < 0 ifTrue:
  		[self print: ' altSet'].
  	NewspeakVM ifTrue:
  		[self print: ((self accessModifierOfMethodHeader: methodHeaderOop) caseOf: {
  						[0] -> [' public'].
  						[1] -> [' private'].
  						[2] -> [' protected'].
  						[3] -> [' access undefined'] })].
  	self print: ' nLits '; printNum: (objectMemory literalCountOfMethodHeader: methodHeaderOop);
  		print: ' nArgs '; printNum: (self argumentCountOfMethodHeader: methodHeaderOop);
  		print: ' nTemps '; printNum: (self temporaryCountOfMethodHeader: methodHeaderOop)!



More information about the Vm-dev mailing list