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

commits at source.squeak.org commits at source.squeak.org
Tue Apr 19 01:18:42 UTC 2016


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

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

Name: VMMaker.oscog-eem.1815
Author: eem
Time: 18 April 2016, 6:17:02.429069 pm
UUID: db6eac8d-fe14-43c5-9fe8-a948bfb6ff4e
Ancestors: VMMaker.oscog-cb.1814

Slang changes to get the RegisterAllocatingCogit to compile.  The struct classes must be generated in the order specified in the Cogit's ancilliaryClasses since the structs referent each other and the first must precede the referers.  CogSimStackEntry nd subclasses get SimStackEntry as their struct name.  The ancilliary classes must include the most specific fixup and simstackentry classes only.  Remove some halts and fix a macro definition.

Nuke the unused SpurCircularBuffser (a holdover from the first awful Spur compaction algorithm).

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

Item was changed:
  ----- Method: CCodeGenerator>>addStructClasses: (in category 'accessing') -----
  addStructClasses: classes
  	"Add the struct classes and save them for emitCTypesOn: later."
  	structClasses := classes.
  	structClasses do:
+ 		[:structClass|
+ 		 (structClass withAllSuperclasses copyUpTo: VMStructType) do:
+ 			[:structClassOrSuperclass|
+ 			 self addStructClass: structClassOrSuperclass]]!
- 		[:structClass| self addStructClass: structClass]!

Item was changed:
  ----- Method: CCodeGenerator>>addStructMethodFor:selector: (in category 'utilities') -----
  addStructMethodFor: aClass selector: selector 
  	"Add the given struct method to the code base and answer its translation
  	 or nil if it shouldn't be translated."
+ 	(self methodNamed: selector) ifNotNil:
+ 		[:tmethod|
+ 		 "If we're repeating an attempt to add the same thing, or
+ 		  if the existing method overrides this one,don't complain."
+ 		 (tmethod definingClass includesBehavior: aClass) ifTrue:
+ 			[^self].
+ 		 "If the methods are both simple accessors, don't complain."
+ 		 ((tmethod definingClass isAccessor: selector)
+ 		 and: [aClass isAccessor: selector]) ifTrue:
+ 			[^self].
+ 		 "If the method is overriding a method in a superclass, don't complain"
+ 		 (aClass inheritsFrom: tmethod definingClass)
+ 			ifTrue: [methods removeKey: selector]
+ 			ifFalse: [self error: 'conflicting implementations for ', selector storeString]].
  	^(self addMethodFor: aClass selector: selector) ifNotNil:
  		[:tmethod|
  		tmethod transformToStructClassMethodFor: self.
  		tmethod]!

Item was removed:
- ----- Method: CogRASSBytecodeFixup>>printMergeSimStack (in category 'debug printing') -----
- printMergeSimStack
- 	<doNotGenerate>
- 	self notAFixup ifFalse:
- 		[cogit printSimStack: mergeSimStack toDepth: simStackPtr spillBase: -1]!

Item was added:
+ ----- Method: CogRASSBytecodeFixup>>printSimStack (in category 'debug printing') -----
+ printSimStack
+ 	<doNotGenerate>
+ 	self notAFixup ifFalse:
+ 		[cogit printSimStack: mergeSimStack toDepth: simStackPtr spillBase: -1]!

Item was added:
+ ----- Method: CogSimStackEntry class>>structTypeName (in category 'translation') -----
+ structTypeName
+ 	^'SimStackEntry'!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>mergeCurrentSimStackWith: (in category 'bytecode generator support') -----
  mergeCurrentSimStackWith: mergeSimStack
  	<var: #mergeSimStack type: #'SimStackEntry *'>
  	<var: #currentSSEntry type: #'SimStackEntry *'>
  	<var: #expectedSSEntry type: #'SimStackEntry *'>
  	"At merge point the cogit expects the stack to be in the same state as mergeSimStack.
  	The logic is very naive, we align the existing state from the current stack to the merge stack
  	from simStackPtr to methodOrBlockNumTemps, and if a conflict happen, we flush what remains
  	to be merged."
  	self flag: #TODO. "we could have a better algorithm with the current set of live registers to avoid flushing"
- 	1halt.
  	simStackPtr to: methodOrBlockNumTemps by: -1 do:
  		[:i|
  			| currentSSEntry expectedSSEntry |
  			currentSSEntry := self simStackAt: i.
  			expectedSSEntry := self simStack: mergeSimStack at: i.
  			expectedSSEntry type
  				caseOf: {
  					[SSBaseOffset]	-> [ self assert: (expectedSSEntry register = ReceiverResultReg or: [ expectedSSEntry register = FPReg ]).
  										(expectedSSEntry register = ReceiverResultReg and: [needsFrame]) ifTrue: 
  											[optStatus isReceiverResultRegLive ifFalse: 
  												[self ssFlushFrom: i - 1 upThroughRegister: ReceiverResultReg.
  											 	 self putSelfInReceiverResultReg ].
  											 optStatus isReceiverResultRegLive: true].  ].
  					[SSSpill]		-> [currentSSEntry ensureSpilledAt: (self frameOffsetOfTemporary: i) from: FPReg].
  					[SSConstant]	-> [self assert: expectedSSEntry liveRegister notNil. 
  										currentSSEntry storeToReg: expectedSSEntry liveRegister ].
  					[SSRegister]	-> [(currentSSEntry type = SSRegister and: [currentSSEntry register = expectedSSEntry register])
  											ifFalse: 
  												[ self ssFlushFrom: i - 1 upThroughRegister: expectedSSEntry register.
  												currentSSEntry storeToReg: expectedSSEntry register ] ]}.
  			 ]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>mergeWithFixupIfRequired: (in category 'simulation stack') -----
  mergeWithFixupIfRequired: fixup
  	"If this bytecode has a fixup, some kind of merge needs to be done. There are 4 cases:
  		1) the bytecode has no fixup (fixup isNotAFixup)
  			do nothing
  		2) the bytecode has a non merge fixup
  			the fixup has needsNonMergeFixup.
  			The code generating non merge fixup (currently only special selector code) is responsible
  				for the merge so no need to do it.
  			We set deadCode to false as the instruction can be reached from jumps.
  		3) the bytecode has a merge fixup, but execution flow *cannot* fall through to the merge point.
  			the fixup has needsMergeFixup and deadCode = true.
  			ignores the current simStack as it does not mean anything 
  			restores the simStack to the state the jumps to the merge point expects it to be.
  		4) the bytecode has a merge fixup and execution flow *can* fall through to the merge point.
  			the fixup has needsMergeFixup and deadCode = false.
  			flushes the stack to the stack pointer so the fall through execution path simStack is 
  				in the state the merge point expects it to be. 
  			restores the simStack to the state the jumps to the merge point expects it to be.
  			
  	In addition, if this is a backjump merge point, we patch the fixup to hold the current simStackPtr 
  	for later assertions."
  	
  	<var: #fixup type: #'BytecodeFixup *'>
  	"case 1"
  	fixup notAFixup ifTrue: [^ 0].
  
  	"case 2"
  	fixup isNonMergeFixup ifTrue: [deadCode := false. ^ 0 ].
  
  	"cases 3 and 4"
- 	1halt.
  	self assert: fixup isMergeFixup.
  	self traceMerge: fixup.
  	deadCode 
  		ifTrue: [simStackPtr := fixup simStackPtr] "case 3"
  		ifFalse: [self mergeCurrentSimStackWith: fixup mergeSimStack]. "case 4"
  	"cases 3 and 4"
  	deadCode := false.
  	fixup isBackwardBranchFixup ifTrue: [fixup simStackPtr: simStackPtr].
  	fixup targetInstruction: self Label.
  	self assert: simStackPtr = fixup simStackPtr.
  	self cCode: '' inSmalltalk:
  		[self assert: fixup simStackPtr = (self debugStackPointerFor: bytecodePC)].
  	self restoreSimStackAtMergePoint: fixup.
  	
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>simStack:at: (in category 'simulation stack') -----
  simStack: stack at: index
+ 	<cmacro: '(stack,index) ((stack) + (index))'>
- 	<cmacro: '(index) (stack + (index))'>
  	<returnTypeC: #'CogSimStackEntry *'>
  	^self addressOf: (stack at: index)!

Item was removed:
- SpurNewSpaceSpace subclass: #SpurCircularBuffer
- 	instanceVariableNames: 'manager first last'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'VMMaker-SpurMemoryManager'!
- 
- !SpurCircularBuffer commentStamp: 'eem 10/23/2013 10:01' prior: 0!
- A SpurCircularBuffer is a region of memory being used as a circular buffer.  The buffer is empty when last < start.  The buffer is full when first = (last + wordSize > limit ifTrue: [start] ifFalse: [last + wordSize]).
- 
- Instance Variables
- 	first:		<Integer address>
- 	last:		<Integer address>
- 
- first
- 	- pointer to the first element in the buffer
- 
- last
- 	- pointer to the last element in the buffer
- !

Item was removed:
- ----- Method: SpurCircularBuffer>>addLast: (in category 'accessing') -----
- addLast: element
- 	| newLast |
- 	newLast := last + manager wordSize.
- 	newLast >= limit ifTrue:
- 		[newLast := start].
- 	(newLast = first and: [last >= start]) ifTrue: "wrapped; bump first"
- 		[(first := newLast + manager wordSize) >= limit ifTrue:
- 			[first := start]].
- 	last := newLast.
- 	self assert: (first >= start and: [first < limit]).
- 	self assert: (last >= start and: [last < limit]).
- 	manager longAt: newLast put: element!

Item was removed:
- ----- Method: SpurCircularBuffer>>first (in category 'accessing') -----
- first
- 	"Answer the value of first"
- 
- 	^ first!

Item was removed:
- ----- Method: SpurCircularBuffer>>first: (in category 'accessing') -----
- first: anObject
- 	"Set the value of first"
- 
- 	^first := anObject!

Item was removed:
- ----- Method: SpurCircularBuffer>>from:reverseDo: (in category 'enumerating') -----
- from: initialPtr reverseDo: aBlock
- 	<inline: true>
- 	| ptr |
- 	last >= start ifTrue:
- 		[ptr := initialPtr.
- 		 first <= last
- 			ifTrue: "enum in first to last range, last to first"
- 				[ptr >= first ifTrue:
- 					[[aBlock value: (manager longAt: ptr).
- 					  (ptr := ptr - manager wordSize) < first ifTrue:
- 						[^nil]] repeat]]
- 			ifFalse: "enum in start to last range, last to start"
- 				[ptr <= last ifTrue:
- 					[[ptr >= start] whileTrue:
- 						[aBlock value: (manager longAt: ptr).
- 						 ptr := ptr - manager wordSize].
- 					 ptr := limit].
- 				 "now enum in first to limit range, limit to first"
- 				 [ptr >= first] whileTrue:
- 					[aBlock value: (manager longAt: ptr).
- 					 ptr := ptr - manager wordSize]]].
- 	^nil!

Item was removed:
- ----- Method: SpurCircularBuffer>>initializeStart:limit: (in category 'initialization') -----
- initializeStart: aStart limit: aLimit
- 	self start: aStart;
- 		limit: aLimit;
- 		first: aStart;
- 		last: aStart - manager wordSize!

Item was removed:
- ----- Method: SpurCircularBuffer>>isEmpty (in category 'testing') -----
- isEmpty
- 	^last < start!

Item was removed:
- ----- Method: SpurCircularBuffer>>last (in category 'accessing') -----
- last
- 	"Answer the value of last"
- 
- 	^ last!

Item was removed:
- ----- Method: SpurCircularBuffer>>last: (in category 'accessing') -----
- last: anObject
- 	"Set the value of last"
- 
- 	^last := anObject!

Item was removed:
- ----- Method: SpurCircularBuffer>>manager (in category 'accessing') -----
- manager
- 	"Answer the value of manager"
- 
- 	^ manager!

Item was removed:
- ----- Method: SpurCircularBuffer>>manager: (in category 'accessing') -----
- manager: anObject
- 	"Set the value of manager"
- 	<doNotGenerate>
- 	^manager := anObject!

Item was removed:
- ----- Method: SpurCircularBuffer>>printOn: (in category 'printing') -----
- printOn: aStream
- 	<doNotGenerate>
- 	super printOn: aStream.
- 	first ifNotNil:
- 		[aStream nextPutAll: ' first: '; nextPutAll: first hex].
- 	last ifNotNil:
- 		[aStream nextPutAll: ' last: '; nextPutAll: last hex]!

Item was removed:
- ----- Method: SpurCircularBuffer>>resetAsEmpty (in category 'accessing') -----
- resetAsEmpty
- 	first := start.
- 	last := start - manager wordSize!

Item was removed:
- ----- Method: SpurCircularBuffer>>reverseDo: (in category 'enumerating') -----
- reverseDo: aBlock
- 	| ptr |
- 	last >= start ifTrue:
- 		[ptr := last.
- 		 [self assert: (first <= last
- 						ifTrue: [first <= ptr and: [ptr <= last]]
- 						ifFalse: [(start <= ptr and: [ptr <= last]) or: [first <= ptr and: [ptr <= limit]]]).
- 		  aBlock value: (manager longAt: ptr).
- 		  ptr = first ifTrue: [^nil].
- 		  (ptr := ptr - manager wordSize) < start ifTrue:
- 			[ptr := limit]] repeat].
- 	^nil!

Item was removed:
- ----- Method: SpurCircularBuffer>>usedSize (in category 'accessing') -----
- usedSize
- 	^last < start
- 		ifTrue: [0]
- 		ifFalse:
- 			[last >= first
- 				ifTrue: [last - first / manager wordSize + 1]
- 				ifFalse: [limit - start - (first - last) / manager wordSize - 1]]!

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	self declareCAsOop: #(	memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
  							lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory firstFreeChunk lastFreeChunk)
  		in: aCCodeGenerator.
  	self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #freeListsMask type: #usqInt;
  		var: #freeLists type: #'sqInt *';
  		var: #objStackInvalidBecause type: #'char *';
- 		var: #highestObjects type: #SpurCircularBuffer;
  		var: #unscannedEphemerons type: #SpurContiguousObjStack;
  		var: #heapGrowthToSizeGCRatio type: #float;
  		var: #heapSizeAtPreviousGC type: #usqInt;
  		var: #totalFreeOldSpace type: #usqInt;
  		var: #maxOldSpaceSize type: #'unsigned long'.
  	aCCodeGenerator
  		var: #remapBuffer
  		declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #extraRoots
  		declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>ancilliaryClasses: (in category 'translation') -----
  ancilliaryClasses: options
  	^(super ancilliaryClasses: options),
+ 	  { self basicNew simStackEntryClass. self basicNew bytecodeFixupClass. CogSSOptStatus }!
- 	  { self basicNew bytecodeFixupClass. self basicNew simStackEntryClass. CogSSOptStatus }!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCodeGen
  	aCodeGen
  		var: #methodAbortTrampolines
  			declareC: 'sqInt methodAbortTrampolines[4]';
  		var: #picAbortTrampolines
  			declareC: 'sqInt picAbortTrampolines[4]';
  		var: #picMissTrampolines
  			declareC: 'sqInt picMissTrampolines[4]';
  		var: 'ceCall0ArgsPIC'
  			declareC: 'void (*ceCall0ArgsPIC)(void)';
  		var: 'ceCall1ArgsPIC'
  			declareC: 'void (*ceCall1ArgsPIC)(void)';
  		var: 'ceCall2ArgsPIC'
  			declareC: 'void (*ceCall2ArgsPIC)(void)';
  		var: #ceCallCogCodePopReceiverArg0Regs
  			declareC: 'void (*ceCallCogCodePopReceiverArg0Regs)(void)';
  		var: #realCECallCogCodePopReceiverArg0Regs
  			declareC: 'void (*realCECallCogCodePopReceiverArg0Regs)(void)';
  		var: #ceCallCogCodePopReceiverArg1Arg0Regs
  			declareC: 'void (*ceCallCogCodePopReceiverArg1Arg0Regs)(void)';
  		var: #realCECallCogCodePopReceiverArg1Arg0Regs
  			declareC: 'void (*realCECallCogCodePopReceiverArg1Arg0Regs)(void)';
  		var: 'simStack'
+ 			declareC: 'SimStackEntry simStack[', self simStackSlots asString, ']';
- 			declareC: 'CogSimStackEntry simStack[', self simStackSlots asString, ']';
  		var: 'simSelf'
  			type: #CogSimStackEntry;
  		var: #optStatus
  			type: #CogSSOptStatus;
  		var: 'prevBCDescriptor'
  			type: #'BytecodeDescriptor *'.
  
  	self numPushNilsFunction ifNotNil:
  		[aCodeGen
  			var: 'numPushNilsFunction'
  				declareC: 'sqInt (* const numPushNilsFunction)(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self numPushNilsFunction);
  			var: 'pushNilSizeFunction'
  				declareC: 'sqInt (* const pushNilSizeFunction)(sqInt,sqInt) = ', (aCodeGen cFunctionNameFor: self pushNilSizeFunction)].
  
  	aCodeGen
  		addSelectorTranslation: #register to: (aCodeGen cFunctionNameFor: 'registerr');
  		addSelectorTranslation: #register: to: (aCodeGen cFunctionNameFor: 'registerr:')!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>isAcceptableAncilliaryClass: (in category 'translation') -----
  isAcceptableAncilliaryClass: aClass
+ 	^(aClass includesBehavior: CogBytecodeFixup)
+ 		ifTrue: [aClass == self basicNew bytecodeFixupClass]
+ 		ifFalse:
+ 			[(aClass includesBehavior: CogSimStackEntry)
+ 				ifTrue: [aClass == self basicNew simStackEntryClass]
+ 				ifFalse: [true]]!
- 	^true!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>duplicateTopBytecode (in category 'bytecode generators') -----
  duplicateTopBytecode
  	| desc |
+ 	<var: #desc type: #SimStackEntry>
- 	<var: #desc type: #CogSimStackEntry>
  	desc := self ssTopDescriptor.
  	^self ssPushDesc: desc!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssPushDesc: (in category 'simulation stack') -----
  ssPushDesc: simStackEntry
+ 	<var: #simStackEntry type: #SimStackEntry>
- 	<var: #simStackEntry type: #CogSimStackEntry>
  	self cCode:
  			[simStackEntry type = SSSpill ifTrue:
  				[simStackEntry type: SSBaseOffset].
  			simStackEntry
  				spilled: false;
  				annotateUse: false;
  				bcptr: bytecodePC.
  			 simStack
  				at: (simStackPtr := simStackPtr + 1)
  				put: simStackEntry]
  		inSmalltalk:
  			[(simStack at: (simStackPtr := simStackPtr + 1))
  				copyFrom: simStackEntry;
  				type: (simStackEntry type = SSSpill
  						ifTrue: [SSBaseOffset]
  						ifFalse: [simStackEntry type]);
  				spilled: false;
  				annotateUse: false;
  				bcptr: bytecodePC].
  	self updateSimSpillBase.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssTopDescriptor (in category 'simulation stack') -----
  ssTopDescriptor
+ 	<returnTypeC: #SimStackEntry>
- 	<returnTypeC: #CogSimStackEntry>
  	^simStack at: simStackPtr!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurRegisterCogVM (in category 'configurations') -----
+ generateSqueakSpurRegisterCogVM
+ 	"No primitives since we can use those for the Cog VM"
+ 	^VMMaker
+ 		generate: CoInterpreter
+ 		and: RegisterAllocatingCogit
+ 		with: #(ObjectMemory Spur32BitCoMemoryManager)
+ 		to: (FileDirectory default pathFromURI: self sourceTree, '/spurregsrc')
+ 		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
+ 		including:#()!

Item was changed:
  ----- Method: VMMaker>>buildCodeGeneratorForCogit:includeAPIMethods:initializeClasses: (in category 'generate sources') -----
  buildCodeGeneratorForCogit: cogitClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses
  	"Answer the code generator for translating the cogit."
  
  	| cg cogitClasses |
  	cg := self createCogitCodeGenerator.
  
  	cg vmClass: cogitClass.
  	initializeClasses ifTrue:
  		[{ cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do:
  			[:cgc|
  			(cgc respondsTo: #initializeWithOptions:)
  				ifTrue: [cgc initializeWithOptions: optionsDictionary]
  				ifFalse: [cgc initialize]]].
  
  	cogitClasses := OrderedCollection withAll: (cogitClass withAllSuperclasses copyUpThrough: VMClass) reverse.
  	cogitClasses addAllLast: ((cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]).
  	cogitClasses do: [:cgc| cg addClass: cgc].
+ 	"Now make sure to add struct classes that the most specific subclasses specify.
+ 	 This makes sure that struct classes are ordered as the most specific cogitClass desires.
+ 	 This must happen for references between the struct classes to be resolved in a specific order."
+ 	cogitClasses := OrderedCollection with: cogitClass with: cogitClass objectRepresentationClass.
+ 	cogitClasses addAll: ((cogitClass ancilliaryClasses: optionsDictionary) reject:
+ 							[:class|
+ 							 class isStructClass
+ 							 or: [cogitClass objectRepresentationClass includesBehavior: class]]).
  	cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses).
  
  	getAPIMethods ifTrue:
  		[cg includeAPIFrom: (self
  								buildCodeGeneratorForInterpreter: self interpreterClass
  								includeAPIMethods: false
  								initializeClasses: false)].
  
  	^cg!



More information about the Vm-dev mailing list