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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 18 00:04:23 UTC 2011


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

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

Name: VMMaker.oscog-eem.138
Author: eem
Time: 17 November 2011, 4:02:46.915 pm
UUID: f9a63bdf-7bbc-4ae5-9634-ecd6fd814c9d
Ancestors: VMMaker.oscog-eem.137

Fix frameless foo: arg instVar := instVar code gen bug (failure to pop
spills on frameless return).
Correct receivers of noAssertMethodClassAssociationOf: for
simulation (starting up a Newspeak image).
Bring CurrentImageCoInterpreterFacade up to date for simulation.
Bring NewCoObjectMemorySimulator up to date for simulation.
Make Alien plugins simulate data manipulation calls.
Use more hex printing in frame/oop printing.
Log time without milliseconds.

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

Item was changed:
  ----- Method: CogMethodZone>>compactCompiledCode: (in category 'compaction') -----
  compactCompiledCode: objectHeaderValue
  	| source dest bytes |
  	<var: #source type: #'CogMethod *'>
  	<var: #dest type: #'CogMethod *'>
  	source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
  	openPICList := nil.
  	[source < self limitZony
  	 and: [source cmType ~= CMFree]] whileTrue:
  		[self assert: (cogit cogMethodDoesntLookKosher: source) = 0.
  		 source objectHeader: objectHeaderValue.
  		 source cmUsageCount > 0 ifTrue:
  			[source cmUsageCount: source cmUsageCount // 2].
  		 source cmType = CMOpenPIC ifTrue:
  			[source nextOpenPIC: openPICList asUnsignedInteger.
  			 openPICList := source].
  		 source := self methodAfter: source].
  	source >= self limitZony ifTrue:
  		[^self halt: 'no free methods; cannot compact.'].
  	dest := source.
  	[source < self limitZony] whileTrue:
  		[self assert: (cogit maybeFreeCogMethodDoesntLookKosher: source) = 0.
  		 bytes := source blockSize.
  		 source cmType ~= CMFree ifTrue:
  			[self mem: dest mo: source ve: bytes.
  			 dest objectHeader: objectHeaderValue.
  			 dest cmType = CMMethod
  				ifTrue:
  					["For non-Newspeak there should ne a one-to-one mapping metween bytecoded and
  					  cog methods. For Newspeak not necessarily, but only for anonymous accessors."
  					 self assert: ((coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
+ 								or: [(cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject]).
- 								or: [(coInterpreter noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject]).
  					"Only update the original method's header if it is referring to this CogMethod."
  					 (coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger ifTrue:
  						[coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]]
  				ifFalse:
  					[dest cmType = CMOpenPIC ifTrue:
  						[dest nextOpenPIC: openPICList asUnsignedInteger.
  						 openPICList := dest]].
  			 dest cmUsageCount > 0 ifTrue:
  				[dest cmUsageCount: dest cmUsageCount // 2].
  			 dest := coInterpreter
  								cCoerceSimple: dest asInteger + bytes
  								to: #'CogMethod *'].
  		 source := coInterpreter
  							cCoerceSimple: source asInteger + bytes
  							to: #'CogMethod *'].
  	mzFreeStart := dest asInteger.
  	methodBytesFreedSinceLastCompaction := 0!

Item was removed:
- ----- Method: CogVMSimulator>>printCallStackOf: (in category 'debug printing') -----
- printCallStackOf: aContext
- 	self printCallStackOf: aContext currentFP: localFP!

Item was changed:
  ----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
  cog: aMethodObj selector: aSelectorOop
  	"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>
  	<returnTypeC: #'CogMethod *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not
+ 				or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
- 				or: [(coInterpreter noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
  	"coInterpreter stringOf: aSelectorOop"
  	coInterpreter
  		compilationBreak: aSelectorOop
  		point: (objectMemory lengthOf: aSelectorOop).
  	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
  	self cppIf: NewspeakVM
  		ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
  				cogMethod ifNotNil:
  					[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
  						[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
  						 cogMethod methodObject: aMethodObj.
  						 coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
  					^cogMethod]].
  	methodObj := aMethodObj.
  	cogMethod := self compileCogMethod: aSelectorOop.
  	(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  		[cogMethod asInteger >= MaxUnreportableError
  			ifTrue:
  				[cogMethod asInteger = InsufficientCodeSpace ifTrue:
  					[coInterpreter callForCogCompiledCodeCompaction]]
  			ifFalse:
  				[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>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForBecome
  	"Update all references to objects in machine code for a become.
  	 Unlike incrementalGC or fullGC a method that does not refer to young
  	 may refer to young as a result of the become operation."
  	| cogMethod hasYoungObj hasYoungObjPtr freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	hasYoungObj := false.
  	hasYoungObjPtr := self cCode: [(self addressOf: hasYoungObj) asInteger]
  							inSmalltalk: [CPluggableAccessor new
  											setObject: nil;
  											atBlock: [:obj :idx| hasYoungObj]
  											atPutBlock: [:obj :idx :val| hasYoungObj := val]].
  	codeModified := freedPIC := false.
  	self mapObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[self assert: hasYoungObj not.
  		 cogMethod cmType ~= CMFree ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 cogMethod selector: (objectRepresentation remapOop: cogMethod selector)..
  			 cogMethod cmType = CMClosedPIC
  				ifTrue:
  					[((objectMemory isYoung: cogMethod selector)
  					   or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
  						[freedPIC := true.
  						 methodZone freeMethod: cogMethod]]
  				ifFalse:
  					[(objectMemory isYoung: cogMethod selector) ifTrue:
  						[hasYoungObj := true].
  					 cogMethod cmType = CMMethod ifTrue:
  						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
  						 self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
+ 									or: [(self noAssertMethodClassAssociationOf: cogMethod methodObject)
- 									or: [(coInterpreter noAssertMethodClassAssociationOf: cogMethod methodObject)
  											= objectMemory nilObject]).
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: (self cppIf: NewspeakVM
  											ifTrue: [#remapNSIfObjectRef:pc:hasYoung: asSymbol]
  											ifFalse: [#remapIfObjectRef:pc:hasYoung: asSymbol])
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue:
  							[cogMethod cmRefersToYoung ifFalse:
  								[cogMethod cmRefersToYoung: true.
  								 methodZone addToYoungReferrers: cogMethod].
  							hasYoungObj := false]
  						ifFalse: [cogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	methodZone pruneYoungReferrers.
  	freedPIC ifTrue:
  		[self unlinkSendsToFree.
  		 codeModified := true].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
  		[processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>interpretAddress (in category 'accessing') -----
+ interpretAddress
+ 	^self addressForLabel: #interpret!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>primitiveFailAddress (in category 'accessing') -----
+ primitiveFailAddress
+ 	^self addressForLabel: #primitiveFail!

Item was changed:
  ----- Method: IA32ABIPlugin class>>simulatorClass (in category 'simulation only') -----
  simulatorClass
+ 	^NewspeakVM ifFalse: [IA32ABIPluginSimulator]!
- 	^IA32ABIPluginSimulator!

Item was added:
+ ----- Method: IA32ABIPluginSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	^interpreterProxy longAt: byteAddress!

Item was added:
+ ----- Method: IA32ABIPluginSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ 	^interpreterProxy longAt: byteAddress put: a32BitValue!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator class>>vmProxyMajorVersion (in category 'simulation only') -----
+ vmProxyMajorVersion
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^CoInterpreter vmProxyMajorVersion!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator class>>vmProxyMinorVersion (in category 'simulation only') -----
+ vmProxyMinorVersion
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^CoInterpreter vmProxyMinorVersion!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>internalIsImmutable: (in category 'simulation only') -----
+ internalIsImmutable: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter internalIsImmutable: oop!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>methodReturnValue: (in category 'simulation only') -----
+ methodReturnValue: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter methodReturnValue: oop!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>signed32BitIntegerFor: (in category 'simulation only') -----
+ signed32BitIntegerFor: integerValue
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter signed32BitIntegerFor: integerValue!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>signed32BitValueOf: (in category 'simulation only') -----
+ signed32BitValueOf: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter signed32BitValueOf: oop!

Item was changed:
  ----- Method: NewspeakInterpreter>>shortPrintOop: (in category 'debug printing') -----
  shortPrintOop: oop
  	<inline: false>
+ 	self printHex: oop.
- 	self printNum: oop.
  	(self isIntegerObject: oop) ifTrue:
  		[^self cCode: 'printf("=%ld\n", integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]].
  	(oop between: self startOfMemory and: freeBlock) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'; cr.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'; cr.
  		 ^nil].
  	self print: ': a(n) '.
  	self printNameOfClass: (self fetchClassOf: oop) count: 5.
  	self cr!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin class>>simulatorClass (in category 'simulation only') -----
  simulatorClass
+ 	^NewspeakVM ifTrue: [NewsqueakIA32ABIPluginSimulator]!
- 	^NewsqueakIA32ABIPluginSimulator!

Item was changed:
+ NewsqueakIA32ABIPlugin subclass: #NewsqueakIA32ABIPluginSimulator
- IA32ABIPlugin subclass: #NewsqueakIA32ABIPluginSimulator
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins-Alien'!

Item was added:
+ ----- Method: NewsqueakIA32ABIPluginSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	^interpreterProxy longAt: byteAddress!

Item was added:
+ ----- Method: NewsqueakIA32ABIPluginSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ 	^interpreterProxy longAt: byteAddress put: a32BitValue!

Item was changed:
  ----- Method: StackInterpreter>>activeProcess (in category 'process primitive support') -----
  activeProcess
  	"Answer the current activeProcess."
+ 	<api> "useful for VM debugging"
  	^objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer!

Item was added:
+ ----- Method: StackInterpreter>>internalIsImmutable: (in category 'object format') -----
+ internalIsImmutable: oop
+ 	<option: #NewspeakVM>
+ 	<inline: true>
+ 	<export: true>
+ 	^((objectMemory baseHeader: oop) bitAnd: ImmutabilityBit) ~= 0!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| fmt lastIndex startIP bytecodesPerLine |
  	((objectMemory isIntegerObject: oop)
  	 or: [(oop between: objectMemory startOfMemory and: objectMemory freeStart) not
  	 or: [(oop bitAnd: (BytesPerWord - 1)) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [(fmt := objectMemory formatOf: oop) between: 5 and: 11]]]]) ifTrue:
  		[^self printOop: oop].
  	self printHex: oop;
  		print: ': a(n) ';
  		printNameOfClass: (objectMemory fetchClassOfNonInt: oop) count: 5.
  	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteSizeOf: oop)].
  	self cr.
  	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index| | fieldOop |
  			fieldOop := objectMemory fetchPointer: index - 1 ofObject: oop.
  			self space; printHex: fieldOop; space; printOopShort: fieldOop; cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
+ 			 lastIndex - startIP > 104 ifTrue:
+ 				[lastIndex := startIP + 103].
- 			 lastIndex - startIP > 100 ifTrue:
- 				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
+ 				(index = lastIndex and: [(objectMemory lengthOf: oop) > index]) ifTrue:
+ 					[self print: '...'].
  				((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
  					[self cr]].
  			((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>printContext: (in category 'debug printing') -----
  printContext: aContext
  	| sender ip sp |
  	<inline: false>
  	self shortPrintContext: aContext.
  	sender := objectMemory fetchPointer: SenderIndex ofObject: aContext.
  	ip := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  	(objectMemory isIntegerObject: sender)
  		ifTrue:
  			[(self checkIsStillMarriedContext: aContext currentFP: framePointer)
  				ifTrue: [self print: 'married (assuming framePointer valid)'; cr]
  				ifFalse: [self print: 'widdowed (assuming framePointer valid)'; cr].
  			self print: 'sender   '; printNum: sender; print: ' (';
  				printHexPtr: (self withoutSmallIntegerTags: sender); printChar: $); cr.
  			 self print: 'ip       '; printNum: ip; print: ' (';
  				printHexPtr: (self withoutSmallIntegerTags: ip); printChar: $); cr]
  		ifFalse:
  			[self print: 'sender   '; shortPrintOop: sender.
+ 			 self print: 'ip       '.
+ 			 ip = objectMemory nilObject
+ 				ifTrue: [self shortPrintOop: ip]
+ 				ifFalse: [self printNum: ip; print: ' ('; printNum: (objectMemory integerValueOf: ip); space; printHex: (objectMemory integerValueOf: ip); printChar: $); cr]].
- 			 self print: 'ip       '; printNum: ip; print: ' ('; printNum: (objectMemory integerValueOf: ip); space; printHex: (objectMemory integerValueOf: ip); printChar: $); cr].
  	sp := objectMemory fetchPointer: StackPointerIndex ofObject: aContext.
  	sp := sp min: (objectMemory lengthOf: aContext) - ReceiverIndex.
  	self print: 'sp       '; printNum: sp; print: ' ('; printNum: (objectMemory integerValueOf: sp); printChar: $); cr.
  	self print: 'method   '; shortPrintOop: (objectMemory fetchPointer: MethodIndex ofObject: aContext).
  	self print: 'closure  '; shortPrintOop: (objectMemory fetchPointer: ClosureIndex ofObject: aContext).
  	self print: 'receiver '; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext).
  	sp := objectMemory integerValueOf: sp.
  	1 to: sp do:
  		[:i|
  		self print: '       '; printNum: i; space; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)]!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintContext: (in category 'debug printing') -----
  shortPrintContext: aContext
+ 	| home theFP |
- 	| home |
  	<inline: false>
+ 	<var: #theFP type: #'char *'>
  	(self isContext: aContext) ifFalse:
  		[self printHex: aContext; print: ' is not a context'; cr.
  		^nil].
  	home := self findHomeForContext: aContext.
+ 	self printHex: aContext.
- 	self printNum: aContext.
  	(self isMarriedOrWidowedContext: aContext)
+ 		ifTrue: [(self checkIsStillMarriedContext: aContext currentFP: framePointer)
+ 					ifTrue:
+ 						[(self isMachineCodeFrame: (theFP := self frameOfMarriedContext: aContext))
+ 							ifTrue: [self print: ' M (']
+ 							ifFalse: [self print: ' I ('].
+ 						 self printHex: theFP; print: ') ']
+ 					ifFalse:
+ 						[self print: ' w ']]
- 		ifTrue: [((self checkIsStillMarriedContext: aContext currentFP: framePointer)
- 				and: [self isMachineCodeFrame: (self frameOfMarriedContext: aContext)])
- 					ifTrue: [self print: ' m ']
- 					ifFalse: [self print: ' i ']]
  		ifFalse: [self print: ' s '].
  	self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: home)
  		receiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home)
  		isBlock: home ~= aContext
  		firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home).
  	self cr!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintFrame: (in category 'debug printing') -----
  shortPrintFrame: theFP
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	| rcvr |
+ 	(stackPages couldBeFramePointer: theFP) ifFalse:
+ 		[self print: 'invalid frame pointer'; cr.
- 	theFP = 0 ifTrue:
- 		[self print: 'null fp'; cr.
  		 ^nil].
  	rcvr := self frameReceiver: theFP.
  	self printHexPtr: theFP.
  	self space.
  	self printActivationNameFor: (self frameMethod: theFP)
  		receiver: rcvr
  		isBlock: (self frameIsBlockActivation: theFP)
  		firstTemporary: (self temporary: 0 in: theFP).
  	self space.
  	self shortPrintOop: rcvr "shortPrintOop: adds a cr"!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintFrame:AndNCallers: (in category 'debug printing') -----
  shortPrintFrame: theFP AndNCallers: n
  	<api>
  	<inline: false>
  	<var: #theFP type: #'char *'>
+ 	(n ~= 0 and: [stackPages couldBeFramePointer: theFP]) ifTrue:
- 	(n > 0 and: [stackPages couldBeFramePointer: theFP]) ifTrue:
  		[self shortPrintFrame: theFP.
  		 self shortPrintFrame: (self frameCallerFP: theFP) AndNCallers: n - 1]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printCallStackOf: (in category 'debug printing') -----
- printCallStackOf: aContext
- 	self printCallStackOf: aContext currentFP: localFP!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUpArrowReturn (in category 'bytecode generators') -----
  genUpArrowReturn
  	"Generate a method return from within a method or a block.
  	 Frameless method activation looks like
  				receiver
  				args
  		sp->	ret pc.
  	 Return pops receiver and arguments off the stack.  Callee pushes the result."
  	inBlock ifTrue:
  		[self assert: needsFrame.
  		 self annotateBytecode: (self CallRT: ceNonLocalReturnTrampoline).
  		 ^0].
  	needsFrame
  		ifTrue:
  			[self MoveR: FPReg R: SPReg.
  			 self PopR: FPReg.
  			 self RetN: methodOrBlockNumArgs + 1 * BytesPerWord]
  		ifFalse:
+ 			[self ssPopSpillsFrom: methodOrBlockNumArgs - 1.
+ 			 self RetN: ((methodOrBlockNumArgs > self numRegArgs
- 			[self RetN: ((methodOrBlockNumArgs > self numRegArgs
  						"A method with an interpreter prim will push its register args for the prim.  If the failure
  						 body is frameless the args must still be popped, see e.g. Behavior>>nextInstance."
  						or: [regArgsHaveBeenPushed])
  							ifTrue: [methodOrBlockNumArgs + 1 * BytesPerWord]
  							ifFalse: [0])].
  	^0!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>isValidFramelessRegister: (in category 'testing') -----
+ isValidFramelessRegister: reg
+ 	"Answer if the receiver is valid in a frameless method."
+ 	^reg = ReceiverResultReg or: [reg = Arg0Reg]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushTo: (in category 'simulation stack') -----
  ssFlushTo: index
  	methodOrBlockNumTemps to: simSpillBase - 1 do:
  		[:i| self assert: (self simStackAt: i) spilled].
  	simSpillBase <= index ifTrue:
  		[(simSpillBase max: 0) to: index do:
  			[:i|
+ 			self assert: (needsFrame
+ 						or: [((self simStackAt: i) type = SSBaseOffset
+ 							or: [(self simStackAt: i) type = SSRegister])
+ 							and: [self isValidFramelessRegister: (self simStackAt: i) register]]).
- 			self assert: needsFrame.
  			(self simStackAt: i)
  				ensureSpilledAt: (self frameOffsetOfTemporary: i)
  				from: FPReg].
  		 simSpillBase := index + 1]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>ssPopSpillsFrom: (in category 'simulation stack') -----
+ ssPopSpillsFrom: index
+ 	"Pop any spilled items on the sim stack from index, used to balance the stack on return."
+ 	index to: simStackPtr do:
+ 		[:i|
+ 		(self simStackAt: i) spilled ifTrue:
+ 			[self ssTop popToReg: TempReg]]!

Item was changed:
  ----- Method: VMMaker>>logDateAndTime (in category 'UI access') -----
  logDateAndTime
+ 	| now |
+ 	"do it this way since Time now includes milliseconds in some versions."
+ 	now := Time dateAndTimeNow.
+ 	logger print: now first; space; print: now last; cr; flush!
- 	logger print: Date today; space; print: Time now; cr; flush.!



More information about the Vm-dev mailing list