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

commits at source.squeak.org commits at source.squeak.org
Tue Nov 19 21:39:01 UTC 2013


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

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

Name: VMMaker.oscog-eem.516
Author: eem
Time: 19 November 2013, 1:35:54.135 pm
UUID: dc21e654-f5d1-4272-9ab9-548f244fdecc
Ancestors: VMMaker.oscog-eem.515

Collapse mapObjectReferencesInMachineCodeForIncrementalGC/Scavenge
onto mapObjectReferencesInMachineCodeForYoungGC.

Provide a nice abstraction for simulating addressOf: (addressOf:put:).

Fix absent super call in Spur32BitCoMemoryManager>>assimilateNewSegment:.
Hence check free space after adding a segment.

Include the mark bit in SpurCoMemMgr>>nullHeaderForMachineCodeMethod.

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

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:			#generateBitAnd:on:indent:
  	#bitOr:				#generateBitOr:on:indent:
  	#bitXor:			#generateBitXor:on:indent:
  	#bitShift:			#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert32:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  	#truncateTo:		#generateTruncateTo:on:indent:
  	#rounded			#generateRounded:on:indent:
  
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 	#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#ifNotNil:		#generateIfNotNil:on:indent:
  	#ifNil:			#generateIfNil:on:indent:
  	#ifNotNil:ifNil:	#generateIfNotNilIfNil:on:indent:
  	#ifNil:ifNotNil:	#generateIfNilIfNotNil:on:indent:
  
  	#at:				#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#cppIf:ifTrue:ifFalse:		#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:				#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
+ 	#addressOf:put:			#generateAddressOf:on:indent:
  	#signedIntFromLong		#generateSignedIntFromLong:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement			#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger		#generateAsUnsignedInteger:on:indent:
  	#asLong					#generateAsLong:on:indent:
  	#asUnsignedLong			#generateAsUnsignedLong:on:indent:
  	#asVoidPointer				#generateAsVoidPointer:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#flag:						#generateFlag:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#noMask:					#generateNoMask:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  
  	#bytesPerWord 			#generateBytesPerWord:on:indent:
  	#wordSize		 			#generateBytesPerWord:on:indent:
  	#baseHeaderSize			#generateBaseHeaderSize:on:indent:
  	
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#value								#generateValue:on:indent:
  	#value:								#generateValue:on:indent:
  	#value:value:						#generateValue:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented			#generateSmalltalkMetaError:on:indent:
  	#subclassResponsibility			#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:					#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:				#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:			#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:			#generateIfFalseIfTrueAsArgument:on:indent:
  	#ifNotNil:				#generateIfNotNilAsArgument:on:indent:	
  	#ifNil:					#generateIfNilAsArgument:on:indent:
  	#ifNotNil:ifNil:			#generateIfNotNilIfNilAsArgument:on:indent:
  	#ifNil:ifNotNil:			#generateIfNilIfNotNilAsArgument:on:indent:
  	#cCode:				#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:		#generateInlineCCodeAsArgument:on:indent:
  	#cppIf:ifTrue:ifFalse:	#generateInlineCppIfElseAsArgument:on:indent:
  	#cppIf:ifTrue:			#generateInlineCppIfElseAsArgument:on:indent:
  
  	#value					#generateValueAsArgument:on:indent:
  	#value:					#generateValueAsArgument:on:indent:
  	#value:value:			#generateValueAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was added:
+ ----- Method: CPluggableAccessor>>asInteger (in category 'coercion') -----
+ asInteger
+ 	^self!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCode: (in category 'jit - api') -----
  mapObjectReferencesInMachineCode: gcMode
  	<api>
  	"Update all references to objects in machine code."
  	gcMode caseOf: {
+ 		[GCModeScavenge]	-> [self mapObjectReferencesInMachineCodeForYoungGC].
+ 		[GCModeIncr]			-> [self mapObjectReferencesInMachineCodeForYoungGC].
- 		[GCModeScavenge]	-> [self mapObjectReferencesInMachineCodeForScavenge].
- 		[GCModeIncr]			-> [self mapObjectReferencesInMachineCodeForIncrementalGC].
  		[GCModeFull]			-> [self mapObjectReferencesInMachineCodeForFullGC].
  		[GCModeBecome]		-> [self mapObjectReferencesInMachineCodeForBecome] }.
  
  	(self asserta: methodZone freeStart <= methodZone youngReferrers) ifFalse:
  		[self error: 'youngReferrers list overflowed']!

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.  Unlike incrementalGC
  	 or fullGC the reference from a Cog method to its methodObject *must not*
  	 change since the two are two halves of the same object."
  	| cogMethod hasYoungObj hasYoungObjPtr freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	hasYoungObj := false.
+ 	hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
- 	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:
  						[| remappedMethod |
  						 self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 remappedMethod := objectRepresentation remapOop: cogMethod methodObject.
  						 remappedMethod ~= cogMethod methodObject ifTrue:
  							[(coInterpreter methodHasCogMethod: remappedMethod) ifTrue:
  								[self error: 'attempt to become two cogged methods'].
  							 (objectMemory
  									withoutForwardingOn: cogMethod methodObject
  									and: remappedMethod
  									with: cogMethod cmUsesPenultimateLit
  									sendToCogit: #method:hasSameCodeAs:checkPenultimate:) ifFalse:
  								[self error: 'attempt to become cogged method into different method'].
  							 "For non-Newspeak there should ne a one-to-one mapping between bytecoded and
  							  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  							 "Only reset the method object's header if it is referring to this CogMethod."
  							 (coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
  								ifTrue:
  									[coInterpreter
  										rawHeaderOf: cogMethod methodObject
  										put: cogMethod methodHeader.
  									 cogMethod
  										methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
  										methodObject: remappedMethod.
  									 coInterpreter
  										rawHeaderOf: remappedMethod
  										put: cogMethod asInteger]
  								ifFalse:
  									[ self assert: (self noAssertMethodClassAssociationOf: cogMethod methodObject)
  													= objectMemory nilObject.
  									 cogMethod
  										methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
  										methodObject: remappedMethod]].
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: (self cppIf: NewspeakVM
  											ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
  											ifFalse: [#remapIfObjectRef:pc:hasYoung:])
  						 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 removed:
- ----- Method: Cogit>>mapObjectReferencesInMachineCodeForIncrementalGC (in category 'garbage collection') -----
- mapObjectReferencesInMachineCodeForIncrementalGC
- 	"Update all references to objects in machine code for an incremental gc.
- 	 Avoid scanning all code by using the youngReferrers list.  In an incremental
- 	 GC a method referring to young may no longer refer to young, but a method
- 	 not referring to young cannot and will not refer to young afterwards."
- 	| pointer cogMethod hasYoungObj hasYoungObjPtr |
- 	<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 := false.
- 	pointer := methodZone youngReferrers.
- 	[pointer < methodZone zoneEnd] whileTrue:
- 		[self assert: hasYoungObj not.
- 		 cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
- 		 cogMethod cmType = CMFree
- 			ifTrue: [self assert: cogMethod cmRefersToYoung not]
- 			ifFalse:
- 				[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
- 				 cogMethod cmRefersToYoung ifTrue:
- 					[self assert: (cogMethod cmType = CMMethod
- 								or: [cogMethod cmType = CMOpenPIC]).
- 					 cogMethod selector: (objectRepresentation remapOop: cogMethod selector).
- 					 (objectMemory isYoung: cogMethod selector) ifTrue:
- 						[hasYoungObj := true].
- 					 cogMethod cmType = CMMethod ifTrue:
- 						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
- 						 cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
- 						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
- 							[hasYoungObj := true]].
- 					 self mapFor: cogMethod
- 						 performUntil: (self cppIf: NewspeakVM
- 											ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
- 											ifFalse: [#remapIfObjectRef:pc:hasYoung:])
- 						 arg: hasYoungObjPtr.
- 					 hasYoungObj
- 						ifTrue: [hasYoungObj := false]
- 						ifFalse: [cogMethod cmRefersToYoung: false]]].
- 		 pointer := pointer + BytesPerWord].
- 	methodZone pruneYoungReferrers.
- 	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
- 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was removed:
- ----- Method: Cogit>>mapObjectReferencesInMachineCodeForScavenge (in category 'garbage collection') -----
- mapObjectReferencesInMachineCodeForScavenge
- 	self shouldBeImplemented!

Item was added:
+ ----- Method: Cogit>>mapObjectReferencesInMachineCodeForYoungGC (in category 'garbage collection') -----
+ mapObjectReferencesInMachineCodeForYoungGC
+ 	"Update all references to objects in machine code for either a Spur scavenging gc
+ 	 or a Squeak V3 incremental GC.  Avoid scanning all code by using the youngReferrers
+ 	 list.  In a young gc a method referring to young may no longer refer to young, but a
+ 	 method not referring to young cannot and will not refer to young afterwards."
+ 	| pointer cogMethod hasYoungObj hasYoungObjPtr |
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	hasYoungObj := false.
+ 	hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
+ 	codeModified := false.
+ 	pointer := methodZone youngReferrers.
+ 	[pointer < methodZone zoneEnd] whileTrue:
+ 		[self assert: hasYoungObj not.
+ 		 cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
+ 		 cogMethod cmType = CMFree
+ 			ifTrue: [self assert: cogMethod cmRefersToYoung not]
+ 			ifFalse:
+ 				[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
+ 				 cogMethod cmRefersToYoung ifTrue:
+ 					[self assert: (cogMethod cmType = CMMethod
+ 								or: [cogMethod cmType = CMOpenPIC]).
+ 					 cogMethod selector: (objectRepresentation remapOop: cogMethod selector).
+ 					 (objectMemory isYoung: cogMethod selector) ifTrue:
+ 						[hasYoungObj := true].
+ 					 cogMethod cmType = CMMethod ifTrue:
+ 						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
+ 						 cogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
+ 						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
+ 							[hasYoungObj := true]].
+ 					 self mapFor: cogMethod
+ 						 performUntil: (self cppIf: NewspeakVM
+ 											ifTrue: [#remapNSIfObjectRef:pc:hasYoung:]
+ 											ifFalse: [#remapIfObjectRef:pc:hasYoung:])
+ 						 arg: hasYoungObjPtr.
+ 					 hasYoungObj
+ 						ifTrue: [hasYoungObj := false]
+ 						ifFalse: [cogMethod cmRefersToYoung: false]]].
+ 		 pointer := pointer + BytesPerWord].
+ 	methodZone pruneYoungReferrers.
+ 	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
  assimilateNewSegment: segInfo
  	"Update after adding a segment.
  	 Here we make sure the new segment is not executable."
  	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	super assimilateNewSegment: segInfo.
  	coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit!

Item was changed:
  ----- Method: Spur32BitCoMemoryManager>>nullHeaderForMachineCodeMethod (in category 'garbage collection') -----
  nullHeaderForMachineCodeMethod
  	<api>
+ 	<returnTypeC: #sqLong>
+ 	^(self firstLongFormat << self formatShift)
+ 	+ (1 << self markedBitFullShift)
+ 	+ ClassBitmapCompactIndex!
- 	^self firstLongFormat << self formatShift + ClassBitmapCompactIndex!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	| sel |
  	sel := thisContext sender method selector.
  	(#(	DoIt
  		DoItIn:
  		on:do: "from the debugger"
  		makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		objCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		bytecodePrimAtPut
  		commonAt:
  		commonAtPut:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
  		fetchStackPointerOf:
  		primitiveContextAt
  		primitiveContextAtPut
  		subscript:with:storing:format:
  		printContext:
  		compare31or32Bits:equal:
  		signed64BitValueOf:
  		primDigitMultiply:negative:
  		digitLength:
  		isNegativeIntegerValueOf:
  		magnitude64BitValueOf:
  		primitiveMakePoint
  		primitiveAsCharacter
  		primitiveInputSemaphore
  		baseFrameReturn
  		primitiveExternalCall
  		primDigitCompare:
  		isLiveContext:
  		numPointerSlotsOf:
  		fileValueOf:
  		loadBitBltDestForm
  		fetchIntOrFloat:ofObject:ifNil:
  		fetchIntOrFloat:ofObject:
  		loadBitBltSourceForm
  		loadPoint:from:
  		primDigitAdd:
  		primDigitSubtract:
  		positive64BitValueOf:
  		digitBitLogic:with:opIndex:
  		signed32BitValueOf:
  		isNormalized:
  		primDigitDiv:negative:
  		bytesOrInt:growTo:
  		primitiveNewMethod
  		isCogMethodReference:
  		functionForPrimitiveExternalCall:
  		genSpecialSelectorArithmetic
  		genSpecialSelectorComparison
  		ensureContextHasBytecodePC:
  		instVar:ofContext:
  		ceBaseFrameReturn:
  		inlineCacheTagForInstance:
  		primitiveObjectAtPut
  		commonVariable:at:put:cacheIndex:
  		primDigitBitShiftMagnitude:
  		externalInstVar:ofContext:
  		primitiveGrowMemoryByAtLeast
+ 		primitiveFileSetPosition
+ 		cogMethodDoesntLookKosher:) includes: sel) ifFalse:
- 		primitiveFileSetPosition) includes: sel) ifFalse:
  		[self halt].
  	^super isIntegerObject: oop!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
  longAt: byteAddress put: a32BitValue
  	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 	"(byteAddress = 16r15FF7A8 and: [a32BitValue = 16r19D09D0]) ifTrue:
- 	"(byteAddress = 16r1614CB8 and: [a32BitValue = 16rA000035]) ifTrue:
  		[self halt]."
  	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
  	^memory at: byteAddress // 4 + 1 put: a32BitValue!

Item was changed:
  ----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
  growOldSpaceByAtLeast: minAmmount
  	"Attempt to grow memory by at least minAmmount.
  	 Answer the size of the new segment, or nil if the attempt failed."
  	| ammount |
  	<var: #segInfo type: #'SpurSegmentInfo *'>
  	"statGrowMemory counts attempts, not successes."
  	statGrowMemory := statGrowMemory + 1.
  	"we need to include overhead for a new object header plus the segment bridge."
  	ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize).
  	"round up to the nearest power of two."
  	ammount := 1 << (ammount - 1) highBit.
  	"and grow by at least growHeadroom."
  	ammount := ammount max: growHeadroom.
  	^(segmentManager addSegmentOfSize: ammount) ifNotNil:
  		[:segInfo|
  		 self assimilateNewSegment: segInfo.
+ 		 self checkFreeSpace.
  		 segInfo segSize]!

Item was added:
+ ----- Method: VMClass>>addressOf:put: (in category 'translation support') -----
+ addressOf: anObject put: aBlock
+ 	<doNotGenerate>
+ 	"Simulate a C pointer.  Translates into &anObject in C. Provides something
+ 	 that evaluates aBlock with the new value in response to at:put:"
+ 	| thing |
+ 	thing := anObject.
+ 	^CPluggableAccessor new
+ 		setObject: nil;
+ 		atBlock: [:obj :idx| thing]
+ 		atPutBlock: [:obj :idx :val| aBlock value: (thing := val)]!



More information about the Vm-dev mailing list