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

commits at source.squeak.org commits at source.squeak.org
Tue Mar 17 15:27:52 UTC 2015


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

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

Name: VMMaker.oscog-eem.1093
Author: eem
Time: 17 March 2015, 8:25:59.874 am
UUID: ac934d6c-fe5e-4bcf-8c3e-e042e66f15c8
Ancestors: VMMaker.oscog-tpr.1092

Make the translated primitive simulation machinery
keep up-to-date with methiod changes.

Fix a spelling error with the schedule scavenge trampoline.

Revert the alas bogus change to
genGetInlineCacheClassTagFrom:into:forEntry:
and fix a method timestamp.

=============== Diff against VMMaker.oscog-tpr.1092 ===============

Item was changed:
  ----- Method: CogAbstractInstruction>>genAlignCStackSavingRegisters:numArgs:wordAlignment: (in category 'abi') -----
  genAlignCStackSavingRegisters: saveRegs numArgs: numArgs wordAlignment: alignment 
  	| wordsPushedModAlignment delta |
  	wordsPushedModAlignment := ((saveRegs ifTrue: [self numberOfSaveableRegisters] ifFalse: [0])
  									+ numArgs)
  									\\ alignment.
  	wordsPushedModAlignment ~= 0 ifTrue:
  		[delta := alignment - wordsPushedModAlignment.
  		 cogit SubCq: delta * 4 R: SPReg].
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetActiveContextLarge:inBlock: (in category 'initialization') -----
  genGetActiveContextLarge: isLarge inBlock: isInBlock
  	"Create a trampoline to answer the active context that will
  	 answer it if a frame is already married, and create it otherwise.
  	 Assume numArgs is in SendNumArgsReg and ClassReg is free."
  	| header slotSize jumpSingle loopHead jumpNeedScavenge continuation exit |
  	<var: #jumpNeedScavenge type: #'AbstractInstruction *'>
  	<var: #continuation type: #'AbstractInstruction *'>
  	<var: #jumpSingle type: #'AbstractInstruction *'>
  	<var: #loopHead type: #'AbstractInstruction *'>
  	<var: #exit type: #'AbstractInstruction *'>
  	cogit
  		MoveMw: FoxMethod r: FPReg R: TempReg;
  		MoveR: TempReg R: ClassReg;
  		AndCq: MFMethodFlagHasContextFlag R: TempReg.
  	jumpSingle := cogit JumpZero: 0.
  	cogit
  		MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg;
  		RetN: 0.
  	jumpSingle jmpTarget: cogit Label.
  
  	"OK, it doesn't exist; instantiate and initialize it"
  	"set the hasContext flag; See CoInterpreter class>>initializeFrameIndices"
  	cogit
  		OrCq: MFMethodFlagHasContextFlag R: ClassReg;
  		MoveR: ClassReg Mw: FoxMethod r: FPReg.
  	"now get the home CogMethod into ClassReg and save for post-instantiation."
  	isInBlock
  		ifTrue:
  			[cogit
  				SubCq: 3 R: ClassReg; "-3 is -(hasContext+isBlock) flags"
  				MoveM16: 0 r: ClassReg R: TempReg;
  				SubR: TempReg R: ClassReg]
  		ifFalse:
  			[cogit SubCq: 1 R: ClassReg]. "-1 is hasContext flag"
  
  	"instantiate the context..."
  	slotSize := isLarge ifTrue: [LargeContextSlots] ifFalse: [SmallContextSlots].
  	header := objectMemory
  					headerForSlots: slotSize
  					format: objectMemory indexablePointersFormat
  					classIndex: ClassMethodContextCompactIndex.
  	self flag: #endianness.
  	cogit
  		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
  		MoveCq: (self cCoerceSimple: header to: #usqInt) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg;
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	jumpNeedScavenge := cogit JumpAboveOrEqual: 0.
  
  	"Now initialize the fields of the context.  See CoInterpreter>>marryFrame:SP:copyTemps:"
  	"sender gets frame pointer as a SmallInteger"
  	continuation :=
  	cogit MoveR: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (SenderIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"pc gets frame caller as a SmallInteger"
  	cogit MoveMw: FoxSavedFP r: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (InstructionPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the method field, freeing up ClassReg again, and frame's context field,"
  	cogit
  		MoveMw: (cogit offset: CogMethod of: #methodObject) r: ClassReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (MethodIndex * objectMemory wordSize) r: ReceiverResultReg;
  		MoveR: ReceiverResultReg Mw: FoxThisContext r: FPReg.
  
  	"Now compute stack pointer; this is stackPointer (- 1 for return pc if a CISC) - framePointer - 4 (1 each for saved pc, method, context, receiver) + 1 (1-relative)"
  	cogit
  		MoveR: FPReg R: TempReg;
  		SubR: SPReg R: TempReg;
  		LogicalShiftRightCq: self log2BytesPerWord R: TempReg;
  		SubCq: (cogit backEnd hasLinkRegister ifTrue: [3] ifFalse: [4]) R: TempReg;
  		AddR: SendNumArgsReg R: TempReg.
  	self genConvertIntegerToSmallIntegerInReg: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (StackPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set closureOrNil to either the stacked receiver or nil"
  	isInBlock
  		ifTrue:
  			[cogit
  				MoveR: SendNumArgsReg R: TempReg;
  				AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  				MoveXwr: TempReg R: FPReg R: TempReg]
  		ifFalse:
  			[cogit MoveCw: objectMemory nilObject R: TempReg].
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (ClosureIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the receiver"
  	cogit
  		MoveMw: FoxMFReceiver r: FPReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (ReceiverIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Now copy the arguments.  This is tricky because of the shortage of registers,.  ClassReg ranges
  	 from 1 to numArgs (SendNumArgsReg), and from ReceiverIndex + 1 to ReceiverIndex + numArgs.
  	 1 to: numArgs do:
  		[:i|
  		temp := longAt(FPReg + ((SendNumArgs - i + 2) * BytesPerWord)). +2 for saved pc and savedfp
  		longAtput(FPReg + FoxMFReceiver + (i * BytesPerWord), temp)]"
  	cogit MoveCq: 1 R: ClassReg.
  	loopHead := cogit CmpR: SendNumArgsReg R: ClassReg.
  	exit := cogit JumpGreater: 0.
  	cogit
  		MoveR: SendNumArgsReg R: TempReg;
  		SubR: ClassReg R: TempReg;
  		AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  		MoveXwr: TempReg R: FPReg R: TempReg;
  		AddCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) R: ClassReg; "Now convert ClassReg from frame index to context index"
  		MoveR: TempReg Xwr: ClassReg R: ReceiverResultReg;
  		SubCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) - 1 R: ClassReg; "convert back adding 1 ;-)"
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	"Finally copy the temps.
  	 ClassReg := FPReg + FoxMFReceiver.
  	 SendNumArgsReg := SendNumArgsReg+ReceiverIndex.
  	 [ClassReg := ClassReg - 4.
  	  backEnd hasLinkRegister
  			ifTrue: [ClassReg > SPReg]
  			ifFalse: [ClassReg >= SPReg]] whileTrue:
  		[receiver[SendNumArgsReg] := *ClassReg.
  		 SendNumArgsReg := SendNumArgsReg + 1]]"
  	cogit
  		MoveR: FPReg R: ClassReg;
  		AddCq: FoxMFReceiver R: ClassReg;
  		AddCq: ReceiverIndex + 1 + (objectMemory baseHeaderSize / objectMemory wordSize) R: SendNumArgsReg.
  	loopHead :=
  	cogit SubCq: objectMemory wordSize R: ClassReg.
  	cogit CmpR: SPReg R: ClassReg.
  	exit := cogit backEnd hasLinkRegister
  				ifTrue: [cogit JumpBelowOrEqual: 0]
  				ifFalse: [cogit JumpBelow: 0].
  	cogit
  		MoveMw: 0 r: ClassReg R: TempReg;
  		MoveR: TempReg Xwr: SendNumArgsReg R: ReceiverResultReg;
  		AddCq: 1 R: SendNumArgsReg;
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	cogit RetN: 0.
  	
  	jumpNeedScavenge jmpTarget:
+ 		(cogit CallRT: ceScheduleScavengeTrampoline).
- 		(cogit CallRT: ceSheduleScavengeTrampoline).
  	cogit Jump: continuation.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genNewArrayOfSize:initialized: (in category 'bytecode generator support') -----
  genNewArrayOfSize: size initialized: initialized
  	"Generate a call to code that allocates a new Array of size.
  	 The Array should be initialized with nils iff initialized is true.
  	 The size arg is passed in SendNumArgsReg, the result
  	 must come back in ReceiverResultReg."
  	| header skip |
  	<var: #skip type: #'AbstractInstruction *'>
  	self assert: size < objectMemory numSlotsMask.
  	header := objectMemory
  					headerForSlots: size
  					format: objectMemory arrayFormat
  					classIndex: ClassArrayCompactIndex.
  	self flag: #endianness.
  	cogit
  		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
  		MoveCq: (self cCoerceSimple: header to: #usqInt) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg.
  	(initialized and: [size > 0]) ifTrue:
  		[cogit MoveCw: objectMemory nilObject R: TempReg.
  		 1 to: size do:
  			[:i| cogit MoveR: TempReg Mw: i * 4 + 4 r: ReceiverResultReg]].
  	cogit
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: size) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	skip := cogit JumpBelow: 0.
+ 	cogit CallRT: ceScheduleScavengeTrampoline.
- 	cogit CallRT: ceSheduleScavengeTrampoline.
  	skip jmpTarget: cogit Label.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genNoPopCreateClosureAt:numArgs:numCopied:contextNumArgs:large:inBlock: (in category 'bytecode generator support') -----
  genNoPopCreateClosureAt: bcpc numArgs: numArgs numCopied: numCopied contextNumArgs: ctxtNumArgs large: isLargeCtxt inBlock: isInBlock
  	"Create a closure with the given startpc, numArgs and numCopied
  	 within a context with ctxtNumArgs, large if isLargeCtxt that is in a
  	 block if isInBlock.  Do /not/ initialize the copied values."
  	| slotSize header skip |
  	<var: #skip type: #'AbstractInstruction *'>
  
  	"First get thisContext into ReceiverResultRega and thence in ClassReg."
  	self genGetActiveContextNumArgs: ctxtNumArgs large: isLargeCtxt inBlock: isInBlock.
  	cogit MoveR: ReceiverResultReg R: ClassReg.
  
  	slotSize := ClosureFirstCopiedValueIndex + numCopied.
  	header := objectMemory
  					headerForSlots: slotSize
  					format: objectMemory indexablePointersFormat
  					classIndex: ClassBlockClosureCompactIndex.
  	cogit
  		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
  		MoveCq: (self cCoerceSimple: header to: #usqInt) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg;
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	skip := cogit JumpBelow: 0.
+ 	cogit CallRT: ceScheduleScavengeTrampoline.
- 	cogit CallRT: ceSheduleScavengeTrampoline.
  	skip jmpTarget: cogit Label.
  
  	cogit
  		MoveR: ClassReg Mw: ClosureOuterContextIndex * objectMemory bytesPerOop + objectMemory baseHeaderSize r: ReceiverResultReg;
  		MoveCq: (objectMemory integerObjectOf: bcpc) R: TempReg;
  		MoveR: TempReg Mw: ClosureStartPCIndex * objectMemory bytesPerOop + objectMemory baseHeaderSize r: ReceiverResultReg;
  		MoveCq: (objectMemory integerObjectOf: numArgs) R: TempReg;
  		MoveR: TempReg Mw: ClosureNumArgsIndex * objectMemory bytesPerOop + objectMemory baseHeaderSize r: ReceiverResultReg.
  	^0!

Item was changed:
  CogObjectRepresentation subclass: #CogObjectRepresentationForSpur
+ 	instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline'
- 	instanceVariableNames: 'ceSheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline'
  	classVariableNames: ''
  	poolDictionaries: 'CogCompilationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants'
  	category: 'VMMaker-JIT'!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	 it allows the code generator to reload ReceiverResultReg cheaply.
  	 In Spur the only thing we leave to the run-time is adding the receiver to the
  	 remembered set and setting its isRemembered bit."
  	ceStoreCheckTrampoline := cogit
  									genTrampolineFor: #remember:
  									called: 'ceStoreCheckTrampoline'
  									arg: ReceiverResultReg
  									result: cogit returnRegForStoreCheck.
+ 	ceScheduleScavengeTrampoline := cogit
+ 											genTrampolineFor: #ceScheduleScavenge
+ 											called: 'ceScheduleScavengeTrampoline'.
- 	ceSheduleScavengeTrampoline := cogit
- 											genSafeTrampolineFor: #ceSheduleScavenge
- 											called: 'ceSheduleScavengeTrampoline'.
  	ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: false called: 'ceSmallMethodContext'.
  	ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: true called: 'ceSmallBlockContext'.
  	ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: false called: 'ceLargeMethodContext'.
  	ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: true called: 'ceLargeBlockContext'!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genGetInlineCacheClassTagFrom:into:forEntry: (in category 'compile abstract instructions') -----
  genGetInlineCacheClassTagFrom: sourceReg into: destReg forEntry: forEntry
  	"Extract the inline cache tag for the object in sourceReg into destReg. The inline cache tag
  	 for a given object is the value loaded in inline caches to distinguish objects of different
  	 classes.  In Spur this is either the tags for immediates, or the receiver's classIndex.
  	 The inline cache tag for a given object is the value loaded in inline caches to distinguish
  	 objects of different classes.  In SqueakV3 the tag is the integer tag bit for SmallIntegers (1),
  	 the compact class index shifted by log: 2 word size for objects with compact classes
  	 (1 * 4 to: 31 * 4 by: 4), or the class.  These ranges cannot overlap because the heap
  	 (and hence the lowest class object) is beyond the machine code zone.
  	 If forEntry is true answer the entry label at which control is to enter (cmEntryOffset).
  	 If forEntry is false, control enters at the start."
  	| entryLabel jumpIsInt jumpCompact |
  	<var: #entryLabel type: #'AbstractInstruction *'>
  	<var: #jumpIsInt type: #'AbstractInstruction *'>
  	<var: #jumpCompact type: #'AbstractInstruction *'>
  	cogit AlignmentNops: (objectMemory wordSize max: 8).
  	entryLabel := cogit Label.
+ 	cogit MoveR: sourceReg R: destReg.
+ 	cogit AndCq: 1 R: destReg.
- 	cogit backEnd hasLinkRegister
- 		ifFalse:[ cogit MoveR: sourceReg R: destReg.
- 				cogit AndCq: 1 R: destReg]
- 		ifTrue:[cogit TstCq: 1 R: sourceReg]. "<---- this works for ARM but is not yet implemented for x86"
  	jumpIsInt := cogit JumpNonZero: 0.
  	"Get header word in destReg"
  	cogit MoveMw: 0 r: sourceReg R: destReg.
  	"Extract the compact class field, and if non-zero use it as the tag.."
  	self assert: self compactClassFieldMask << objectMemory compactClassFieldLSB < objectMemory nilObject asUnsignedInteger.
  	cogit AndCq: self compactClassFieldMask << objectMemory compactClassFieldLSB R: destReg.
  	jumpCompact := cogit JumpNonZero: 0.
  	cogit MoveMw: objectMemory classFieldOffset r: sourceReg R: destReg.
  	"The use of signedIntFromLong is a hack to get round short addressing mode computations.
  	 Much easier if offsets are signed and the arithmetic machinery we have makes it difficult to
  	 mix signed and unsigned offsets."
  	cogit AndCq: AllButTypeMask signedIntFromLong R: destReg.
  	jumpCompact jmpTarget: (jumpIsInt jmpTarget: cogit Label).
  	^entryLabel!

Item was changed:
  ----- Method: InterpreterPlugin>>doesNotUnderstand: (in category 'simulation support') -----
  doesNotUnderstand: aMessage
  	<doNotGenerate>
  	"Override doesNotUnderstand: to iuntercept sends of translated primitive selectors.
  	 The translated primitives are primitives derived from the primitive methods themselves
  	 translating their failure code/method body into Slang code."
  	(self methodAndTypesOrNilForTranslatedPrimitiveSelector: aMessage selector)
  		ifNil: [^super doesNotUnderstand: aMessage]
  		ifNotNil:
  			[:tuple| | method |
+ 			 "First check the cache for validity; if the ast element of the tuple is the actual method
+ 			 then the cache is up-to-date.  if it is not, the method has changed and should be regenerated."
+ 			 method := tuple last.
+ 			 method == (method methodClass >> method selector) ifFalse:
+ 				[translatedMethodCache removeKey: aMessage selector.
+ 				 ^self doesNotUnderstand: aMessage].
  			 method := tuple first.
  			 tuple second
  				ifNil: [interpreterProxy primitiveFail]
  				ifNotNil:
  					[:types|
  					 self tryToRunTranslatedPrimitive: method types: types subsidiaries: tuple third].
  			(#(	compare:with:collated:
  				findFirstInString:inSet:startingAt:
  				findSubstring:in:startingAt:matchTable:
  				hashBytes:startingWith:
  				indexOfAscii:inString:startingAt:
  				translate:from:to:table:
  				compress:toByteArray:
  				decompress:fromByteArray:at:)
  					includes: method selector) ifFalse:
  				[interpreterProxy transcript print: method; cr.
  				 interpreterProxy coInterpreter printExternalHeadFrame].
  			 interpreterProxy failed ifTrue:
  				[interpreterProxy transcript
  					nextPutAll: 'WARNING!! Failing translated primitive ';
  					nextPutAll: aMessage selector;
  					nextPutAll: ' implemented by ';
  					nextPutAll: method methodClass name;
  					nextPutAll: '>>';
  					nextPutAll: method selector;
  					cr;
  					flush]]!

Item was changed:
  ----- Method: InterpreterPlugin>>tupleOrNilForTranslatedPrimitiveSelector: (in category 'simulation') -----
  tupleOrNilForTranslatedPrimitiveSelector: selector
+ 	"Answer a tuple of {simulation method, types, subsidiary methods, original method}
+ 	 for the selector of a translated primitive.  If the method cannot be simulated, for
+ 	 example if it accesses instance variables, answer a tuple whose types element is nil."
- 	"Answer a tuple of method, types, subsidiary methods, for the selector of a translated
- 	 primitive.  If the method cannot be simulated, for example if it accesses instance
- 	 variables, answer a tuple whose types element is nil."
  	<doNotGenerate>
  	^(self class methodOrNilForTranslatedPrimitiveSelector: selector) ifNotNil:
  		[:method| | argNames argPragmas cg types subsidiaryMethods |
  		"Since the plugin itself runs the method, and the method is on some
  		 distant class, if the method accesses inst vars, the mechanism can't work."
+ 		method hasInstVarRef ifTrue: [^{method. nil. nil. method}].
+ 		argNames := [method methodClass newParser parseParameterNames: method getSource]
- 		method hasInstVarRef ifTrue: [^{method. nil. nil}].
- 		argNames := [method methodClass newParser parseParameterNames: method getSourceFromFile]
  						on: Error
  						do: [:ex|
+ 							^{method. nil. nil. method}].
- 							^{method. nil. nil}].
  		argPragmas := method pragmas select:
  							[:p|
  							(p keyword beginsWith: 'var:')
  							and: [argNames includes: p arguments first]].
  		cg := translatedMethodCache at: #CCodeGenerator.
  		types := (1 to: method numArgs) collect:
  					[:i|
  					(argPragmas detect: [:p| p arguments first = (argNames at: i)] ifNone: [])
  						ifNil: [#sqInt]
  						ifNotNil:
  							[:pragma|
  							cg extractTypeFor: (argNames at: i) fromDeclaration: pragma arguments second]].
  		 "Subsidiary methods are typically implemented for the primitive method only."
  		 subsidiaryMethods :=
  			method messages
  				select:
  					[:subsidiary|
  					 (method methodClass includesSelector: subsidiary)
  					 and: [(Object includesSelector: subsidiary) not]]
  				thenCollect:
  					[:subsidiary| | subsidiaryMethod |
  					subsidiaryMethod := method methodClass >> subsidiary.
  					subsidiaryMethod hasInstVarRef ifTrue:
+ 						[^{method. nil. nil. method}].
- 						[^{method. nil. nil}].
  					subsidiaryMethod].
  		 { self methodWithoutPrimitive: method.
  		   types.
  		   Dictionary withAll:
  			(subsidiaryMethods collect:
+ 				[:m| m selector -> (self methodWithoutPrimitive: m)]).
+ 		   method}]!
- 				[:m| m selector -> (self methodWithoutPrimitive: m)])}]!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>ceScheduleScavenge (in category 'trampolines') -----
+ ceScheduleScavenge
+ 	<api>
+ 	self assert: freeStart >= scavengeThreshold.
+ 	self scheduleScavenge!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>ceSheduleScavenge (in category 'trampolines') -----
- ceSheduleScavenge
- 	<api>
- 	self assert: freeStart >= scavengeThreshold.
- 	self scheduleScavenge!

Item was added:
+ ----- Method: Spur64BitCoMemoryManager>>ceScheduleScavenge (in category 'trampolines') -----
+ ceScheduleScavenge
+ 	<api>
+ 	self assert: freeStart >= scavengeThreshold.
+ 	self scheduleScavenge!

Item was removed:
- ----- Method: Spur64BitCoMemoryManager>>ceSheduleScavenge (in category 'trampolines') -----
- ceSheduleScavenge
- 	<api>
- 	self assert: freeStart >= scavengeThreshold.
- 	self scheduleScavenge!



More information about the Vm-dev mailing list