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

commits at source.squeak.org commits at source.squeak.org
Sat Mar 10 02:39:35 UTC 2018


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

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

Name: VMMaker.oscog-eem.2352
Author: eem
Time: 9 March 2018, 6:39:15.822668 pm
UUID: 2e4fad65-5a55-44a7-9495-236e35b019af
Ancestors: VMMaker.oscog-cb.2351

Cogits:
Fix slip in ssFlushTo:.
Fix off-by-one in updateSpillBase.
Better to inline ssAllocateRequiredRegMask:upThrough:.

Fixes for in-image compilation (for the pc mappng tests that we need to fix the recent pc mapping regression in SistaV1).

=============== Diff against VMMaker.oscog-cb.2351 ===============

Item was changed:
  ----- Method: Cogit class>>attemptToComputeTempNamesFor: (in category 'in-image compilation support') -----
  attemptToComputeTempNamesFor: aCompiledMethod
  	(aCompiledMethod respondsTo: #tempNames) ifTrue:
+ 		[| schematicTemps blocks |
+ 		 schematicTemps := aCompiledMethod methodNode schematicTempNamesString.
- 		[| blocks |
  		 blocks := aCompiledMethod embeddedBlockClosures.
  		 initializationOptions
  			at: #tempNames
+ 			put: (Dictionary withAll: {aCompiledMethod initialPC -> (self decomposeSchematicTemps: (schematicTemps copyUpTo: $[))},
- 			put: (Dictionary withAll: {aCompiledMethod initialPC -> ([aCompiledMethod tempNames]
- 																		on: MessageNotUnderstood
- 																		do: [:ex|
- 																			(self isSistaMessage: ex message unimplementedIn: Decompiler) ifTrue:
- 																				[^self].
- 																			 (Smalltalk classNamed: #AssemblerAbsentClassImport) ifNotNil:
- 																				[:aaciClass|
- 																				 (ex receiver isKindOf: aaciClass) ifTrue:
- 																					[^self]].
- 																			 ex pass])},
  				(blocks
  					ifEmpty: [#()]
  					ifNotEmpty:
  						[aCompiledMethod embeddedBlockClosures
+ 							with: (schematicTemps piecesCutWhere: [:a :b| b = $[]) allButFirst
+ 							collect: [:c :s| c startpc -> (self decomposeSchematicTemps: (s copyWithoutAll: '[]'))]]))]!
- 							with: ((aCompiledMethod methodNode schematicTempNamesString allButFirst:
- 									(aCompiledMethod methodNode schematicTempNamesString indexOf: $[)) piecesCutWhere: [:a :b| b = $[])
- 							collect: [:c :s| c startpc -> (s substrings collect: [:ea| ea copyWithout: $] ])]]))]!

Item was added:
+ ----- Method: Cogit class>>decomposeSchematicTemps: (in category 'in-image compilation support') -----
+ decomposeSchematicTemps: aString
+ 	^Array streamContents:
+ 		[:ws| | rs |
+ 		rs := aString readStream.
+ 		[rs atEnd] whileFalse:
+ 			[ws nextPut: (rs peek = $(
+ 						ifTrue: [[rs upThrough: $)]
+ 									on: MessageNotUnderstood
+ 									do: [:ex| (rs upTo: $)), ')']]
+ 						ifFalse: [rs upTo: Character space])]]!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>literal:ofMethod: (in category 'accessing') -----
  literal: index ofMethod: anOop
  	| lit |
+ 	lit := (anOop isInteger ifTrue: [self objectForOop: anOop] ifFalse: [anOop]) literalAt: index + 1.
- 	lit := (self objectForOop: anOop) literalAt: index + 1.
  	^lit class == SmallInteger
  		ifTrue: [objectMemory integerObjectOf: lit]
  		ifFalse: [self oopForObject: lit]!

Item was changed:
  ----- Method: StackInterpreter>>encoderClassForHeader: (in category 'simulation') -----
  encoderClassForHeader: headerInteger
+ 	<doNotGenerate>
+ 	^Smalltalk classNamed: ((headerInteger < 0 or: [objectMemory headerIndicatesAlternateBytecodeSet: headerInteger])
- 	^Smalltalk classNamed: ((objectMemory headerIndicatesAlternateBytecodeSet: headerInteger)
  								ifTrue: [AltBytecodeEncoderClassName]
  								ifFalse: [BytecodeEncoderClassName])!

Item was changed:
  ----- Method: StackInterpreter>>internalStackTop (in category 'internal interpreter access') -----
  internalStackTop
+ 
  	^stackPages longAtPointer: localSP!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateRequiredRegMask:upThrough: (in category 'simulation stack') -----
  ssAllocateRequiredRegMask: requiredRegsMask upThrough: stackPtr
+ 	<inline: true>
  	self ssAllocateRequiredRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: simNativeStackPtr.
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushTo: (in category 'simulation stack') -----
  ssFlushTo: index
  	<inline: true>
  	self assert: self tempsValidAndVolatileEntriesSpilled.
  	LowcodeVM ifTrue:
  		[self ssNativeFlushTo: simNativeStackPtr].
  	simSpillBase <= index ifTrue:
+ 		[(((simSpillBase max: methodOrBlockNumTemps + 1) min: simStackPtr) min: index) to: index do:
- 		[((simSpillBase max: methodOrBlockNumTemps + 1) min: simStackPtr) to: index do:
  			[:i|
  			self assert: needsFrame.
  			(self simStackAt: i)
  				ensureSpilledAt: (self frameOffsetOfTemporary: i - 1) "frameOffsetOfTemporary: is 0-relative"
  				from: FPReg].
  		 simSpillBase := index + 1]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>updateSimSpillBase (in category 'simulation stack') -----
  updateSimSpillBase
  	"Something volatile has been pushed on the stack; update simSpillBase accordingly."
  	<inline: true>
  	self assert: ((simSpillBase > methodOrBlockNumTemps
  				and: [simStackPtr >= methodOrBlockNumTemps])
  				or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil]).
  	simSpillBase > simStackPtr
  		ifTrue:
  			[simSpillBase := simStackPtr + 1.
+ 			 [simSpillBase > methodOrBlockNumTemps
- 			 [simSpillBase - 1 > methodOrBlockNumTemps
  			   and: [(self simStackAt: simSpillBase - 1) spilled not]] whileTrue:
  				[simSpillBase := simSpillBase - 1]]
  		ifFalse:
  			[[(self simStackAt: simSpillBase) spilled
  			   and: [simSpillBase <= simStackPtr]] whileTrue:
  				[simSpillBase := simSpillBase + 1]].
  	methodOrBlockNumTemps + 1 to: (simSpillBase - 1 min: simStackPtr) do:
  		[:i|
  		self assert: (self simStackAt: i) spilled == true]!



More information about the Vm-dev mailing list