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

commits at source.squeak.org commits at source.squeak.org
Wed Feb 20 23:49:30 UTC 2013


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

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

Name: VMMaker.oscog-eem.266
Author: eem
Time: 20 February 2013, 3:47:06.471 pm
UUID: ee4e0b6e-91a8-432c-847b-132d682bc79b
Ancestors: VMMaker.oscog-eem.265

Support one-way become on cogged methods that have the same
code, for e.g. Pharo's setSourcePosition:inFile:.  Add error checks for
two-way becomming cogged methods, becomming married contexts,
and for freeing any of these during become.
Refactor freeObject: and restoreHeaderOf: to allow subclasses to
add their error checks efficiently (i.e. avoiding fetching baseHeader
more than once).
Bring endPCOf: out of simulation-only land for code comparison.
Make assert in rawHeaderOf:put: accept forwarding.

Tiny speed-up in using byteLengthOf: instead of byteSizeOf: in cogit.

Add asLong to CCodeGenerator andthere-by  eliminate printf
warnings in reportMinimumUnusedHeadroom.  Eliminate warning
in instVar:ofContext:put:.

Add asserta: to functions not inlined to get neater printing of
asserta failures.

Nuke obsolete Cogit>>byteAt:put:.

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

Item was added:
+ ----- Method: CCodeGenerator>>generateAsLong:on:indent: (in category 'C translation') -----
+ generateAsLong: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPutAll:'((long)'.
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPut: $)!

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:
  
  	#<				#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:
  	#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:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#flag:						#generateFlag:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  
  	#bytesPerWord 			#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:
  	).
  
  	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:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was changed:
  ----- Method: CoInterpreter>>rawHeaderOf:put: (in category 'compiled methods') -----
  rawHeaderOf: methodOop put: cogMethodOrMethodHeader
  	<api>
+ 	"Since methods may be updated while forwarding during become, make the assert accomodate this."
+ 	self assert: (objectMemory isCompiledMethodHeader: (objectMemory headerWhileForwardingOf: methodOop)).
- 	self assert: (objectMemory isCompiledMethod: methodOop).
  	objectMemory
  		storePointerUnchecked: HeaderIndex
  		ofObject: methodOop
  		withValue: cogMethodOrMethodHeader!

Item was changed:
  ----- Method: CoInterpreter>>reportMinimumUnusedHeadroom (in category 'debug support') -----
  reportMinimumUnusedHeadroom
  	"Report the stack page size and minimum unused headroom to stdout."
  	<api>
  	self cCode:
  			[self pri: 'stack page bytes %ld available headroom %ld minimum unused headroom %ld\n'
+ 				n: self stackPageByteSize asLong
+ 				t: (self stackPageByteSize - self stackLimitBytes - self stackLimitOffset) asLong
+ 				f: self minimumUnusedHeadroom asLong]
- 				n: self stackPageByteSize
- 				t: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset
- 				f: self minimumUnusedHeadroom]
  		inSmalltalk:
  			["CogVMSimulator new initStackPagesForTests reportMinimumUnusedHeadroom"
  			 self print: 'stack page bytes '; printNum: self stackPageByteSize;
  				print: ' available headroom '; printNum: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset;
  				print: ' minimum unused headroom '; printNum: self minimumUnusedHeadroom;
  				cr]!

Item was changed:
  ----- Method: Cogit>>bcpcsAndDescriptorsFor:do: (in category 'tests-method map') -----
  bcpcsAndDescriptorsFor: aMethod do: trinaryBlock
  	<doNotGenerate>
  	| bsOffset nExts byte descriptor endpc latestContinuation pc primIdx |
  	((primIdx := coInterpreter primitiveIndexOf: aMethod) > 0
  	and: [coInterpreter isQuickPrimitiveIndex: primIdx]) ifTrue:
  		[^self].
  	latestContinuation := pc := coInterpreter startPCOfMethod: aMethod.
  	trinaryBlock value: pc value: nil value: nil. "stackCheck/entry pc"
  	bsOffset := self bytecodeSetOffsetFor: aMethod.
  	nExts := 0.
+ 	endpc := objectMemory byteLengthOf: aMethod.
- 	endpc := objectMemory byteSizeOf: aMethod.
  	[pc <= endpc] whileTrue:
  		[byte := objectMemory fetchByte: pc ofObject: aMethod.
  		descriptor := self generatorAt: byte + bsOffset.
  		trinaryBlock value: pc value: byte value: descriptor.
  		(descriptor isReturn
  		 and: [pc >= latestContinuation]) ifTrue:
  			[endpc := pc].
  		(descriptor isBranch
  		 or: [descriptor isBlockCreation]) ifTrue:
  			[| targetPC |
  			 descriptor isBlockCreation ifTrue:
  				[trinaryBlock value: pc + descriptor numBytes value: nil value: nil]. "stackCheck/entry pc"
  			 targetPC := self latestContinuationPCFor: descriptor at: pc exts: nExts in: aMethod.
  			 self assert: targetPC < endpc.
  			 latestContinuation := latestContinuation max: targetPC].
  		pc := pc + descriptor numBytes.
  		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]!

Item was changed:
  ----- Method: Cogit>>blockStartPcsIn: (in category 'disassembly') -----
  blockStartPcsIn: aMethod
  	"Answer the start bytecopde pcs in a method in compilation order, i.e. depth-first.
  	 Blocks must occur in pc/depth-first order for binary tree block dispatch to work."
  	| startpcs pc latestContinuation end descriptor byte bsOffset nExts |
  	<doNotGenerate>
  	startpcs := OrderedCollection new.
  	startpcs add: (pc := latestContinuation := coInterpreter startPCOfMethod: aMethod).
+ 	end := objectMemory byteLengthOf: aMethod.
- 	end := objectMemory byteSizeOf: aMethod.
  	bsOffset := self bytecodeSetOffsetFor: aMethod.
  	nExts := 0.
  	[pc <= end] whileTrue:
  		[byte := objectMemory fetchByte: pc ofObject: aMethod.
  		 descriptor := self generatorAt: byte + bsOffset.
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[end := pc].
  		 (descriptor isBranch
  		  or: [descriptor isBlockCreation]) ifTrue:
  			[| targetPC |
  			 targetPC := self latestContinuationPCFor: descriptor at: pc exts: nExts in: aMethod.
  			 latestContinuation := latestContinuation max: targetPC].
  		 pc := pc + descriptor numBytes.
  		 descriptor isBlockCreation ifTrue:
  			[startpcs add: pc].
  		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	^startpcs!

Item was removed:
- ----- Method: Cogit>>byteAt:put: (in category 'generate machine code') -----
- byteAt: anAddress put: aValue
- 	"Store a byte in memory.  In Smaltalk defer to the coInterpreter.
- 	 In C this will be replaced by a macro (byteAtPut)."
- 	<doNotGenerate> 
- 	objectMemory byteAt: anAddress put: aValue!

Item was changed:
  ----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
  compileCogMethod: selector
  	<returnTypeC: #'CogMethod *'>
  	| numBytecodes numBlocks result extra |
  	hasYoungReferent := (objectMemory isYoung: methodObj)
  						  or: [objectMemory isYoung: selector].
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
  	inBlock := false.
  	primInvokeLabel := nil.
  	postCompileHook := nil.
  	extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
  			and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
  				ifTrue: [30]
  				ifFalse: [10].
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
  					ifTrue: [initialPC - 1]
+ 					ifFalse: [objectMemory byteLengthOf: methodObj].
- 					ifFalse: [objectMemory byteSizeOf: methodObj].
  	numBytecodes := endPC - initialPC + 1.
  	self allocateOpcodes: (numBytecodes + extra) * 10 bytecodes: numBytecodes.
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	self allocateBlockStarts: numBlocks.
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogMethod: selector!

Item was changed:
+ ----- Method: Cogit>>endPCOf: (in category 'compiled methods') -----
- ----- Method: Cogit>>endPCOf: (in category 'simulation only') -----
  endPCOf: aMethod
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
  	| pc end latestContinuation descriptor prim distance targetPC byte bsOffset nExts |
  	pc := latestContinuation := coInterpreter startPCOfMethod: aMethod.
  	(prim := coInterpreter primitiveIndexOf: aMethod) > 0 ifTrue:
  		[(coInterpreter isQuickPrimitiveIndex: prim) ifTrue:
  			[^pc - 1]].
  	bsOffset := self bytecodeSetOffsetFor: aMethod.
  	nExts := 0.
+ 	end := objectMemory byteLengthOf: aMethod.
- 	end := objectMemory byteSizeOf: aMethod.
  	[pc <= end] whileTrue:
  		[byte := objectMemory fetchByte: pc ofObject: aMethod.
  		descriptor := self generatorAt: byte + bsOffset.
  		(descriptor isReturn
  		 and: [pc >= latestContinuation]) ifTrue:
  			[end := pc].
  		(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: aMethod.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC.
  			 descriptor isBlockCreation ifTrue:
  				[pc := pc + distance]].
  		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
  		pc := pc + descriptor numBytes].
  	^end!

Item was changed:
  ----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
  	"Machine-code <-> bytecode pc mapping support.  Evaluate functionSymbol
  	 for each mcpc, bcpc pair in the map until the function returns non-zero,
  	 answering that result, or 0 if it fails to.  This works only for frameful methods."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self assert: cogMethod stackCheckOffset > 0.
  	"In both CMMethod and CMBlock cases find the start of the map and
  	 skip forward to the bytecode pc map entry for the stack check."
  	cogMethod cmType = CMMethod
  		ifTrue:
  			[isInBlock := false.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
+ 			 endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
- 			 endbcpc := (objectMemory byteSizeOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
  		ifFalse:
  			[isInBlock := true.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
  			 [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  				[map := map - 1].
  			 map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
  			 aMethodObj := homeMethod methodObject.
  			 bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			 byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  			 descriptor := self generatorAt: byte.
  			 endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
  	bcpc := startbcpc.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	nExts := 0.
  	"The stack check maps to the start of the first bytecode,
  	 the first bytecode being effectively after frame build."
  	result := self perform: functionSymbol
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	"Now skip up through the bytecode pc map entry for the stack check." 
  	[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  		[map := map - 1].
  	map := map - 1.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[| annotation nextBcpc |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
  				(self isPCMappedAnnotation: annotation) ifTrue:
  					[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  					  descriptor := self generatorAt: byte.
  					  isInBlock
  						ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
  						ifFalse:
  							[(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0].
  							 (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  								[| targetPC |
  								 targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: ((descriptor isBranch
  										   and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj])
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc.
  					 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

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 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.
- 						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
  									or: [(self noAssertMethodClassAssociationOf: cogMethod methodObject)
  											= objectMemory nilObject]).
+ 						 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
+ 									sendToCogit: #method:hasSameCodeAs:) ifFalse:
+ 								[self error: 'attempt to become cogged method into different method'].
+ 							 coInterpreter
+ 								rawHeaderOf: cogMethod methodObject
+ 								put: cogMethod methodHeader.
+ 							 cogMethod
+ 								methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
+ 								methodObject: remappedMethod.
+ 							 coInterpreter
+ 								rawHeaderOf: remappedMethod
+ 								put: cogMethod asInteger].
  						 (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 added:
+ ----- Method: Cogit>>method:hasSameCodeAs: (in category 'garbage collection') -----
+ method: methodA hasSameCodeAs: methodB
+ 	"For the purposes of become: see if the two methods are similar, i.e. can be safely becommed.
+ 	 This is pretty strict.  All literals and bytecodes must be identical.  Only trailer bytes and header
+ 	  flags can differ."
+ 	<inline: false>
+ 	| headerA headerB numLitsA endPCA |
+ 	headerA := coInterpreter headerOf: methodA.
+ 	headerB := coInterpreter headerOf: methodB.
+ 	numLitsA := coInterpreter literalCountOfHeader: headerA.
+ 	endPCA := self endPCOf: methodA.
+ 	((coInterpreter argumentCountOfMethodHeader: headerA) ~= (coInterpreter argumentCountOfMethodHeader: headerB)
+ 	 or: [(coInterpreter temporaryCountOfMethodHeader: headerA) ~= (coInterpreter temporaryCountOfMethodHeader: headerB)
+ 	 or: [(coInterpreter primitiveIndexOfMethod: methodA header: headerA) ~= (coInterpreter primitiveIndexOfMethod: methodB header: headerB)
+ 	 or: [numLitsA ~= (coInterpreter literalCountOfHeader: headerB)
+ 	 or: [endPCA > (objectMemory byteLengthOf: methodB)]]]]) ifTrue:
+ 		[^false].
+ 	 1 to: numLitsA - 1 do:
+ 		[:li|
+ 		(objectMemory fetchPointer: li ofObject: methodA) ~= (objectMemory fetchPointer: li ofObject: methodB) ifTrue:
+ 			[^false]].
+ 	(coInterpreter startPCOfMethod: methodA) to: endPCA do:
+ 		[:bi|
+ 		(objectMemory fetchByte: bi ofObject: methodA) ~= (objectMemory fetchByte: bi ofObject: methodB) ifTrue:
+ 			[^false]].
+ 	^true!

Item was added:
+ ----- Method: Integer>>asLong (in category '*VMMaker-interpreter simulator') -----
+ asLong
+ 	^self!

Item was removed:
- ----- Method: NewCoObjectMemory>>freeObject: (in category 'become') -----
- freeObject: obj
- 	self assert: ((self isCompiledMethod: obj) not or: [(self methodHasCogMethod: obj) not]).
- 	super freeObject: obj!

Item was added:
+ ----- Method: NewCoObjectMemory>>freeObject:header: (in category 'become') -----
+ freeObject: obj header: objHeader
+ 	(self isCompiledMethodHeader: objHeader) ifTrue:
+ 		[(self asserta: (coInterpreter methodHasCogMethod: obj) not) ifFalse:
+ 			[self error: 'attempt to free cogged method']].
+ 	super freeObject: obj header: objHeader!

Item was added:
+ ----- Method: NewCoObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
+ restoreHeaderOf: obj to: objHeader
+ 	super restoreHeaderOf: obj to: objHeader.
+ 	(self isCompiledMethodHeader: objHeader) ifTrue:
+ 		[(self asserta: ((coInterpreter methodHasCogMethod: obj) not
+ 						or: [obj = (coInterpreter cogMethodOf: obj)])) ifFalse:
+ 			[self error: 'attempt to become cogged method']]!

Item was added:
+ ----- Method: NewCoObjectMemory>>withoutForwardingOn:and:sendToCogit: (in category 'cog jit support') -----
+ withoutForwardingOn: obj1 and: obj2 sendToCogit: selector
+ 	"For the purposes of become: send selector to the cogit with obj1 and obj2 and
+ 	 answer the result. Undo forwarding for the selector, but redo forwarding after since
+ 	 become:'s restoreHeadersAfter*Become* methods expect to be able to restore."
+ 	<api>
+ 	<var: #selector declareC: 'sqInt (*selector)(sqInt,sqInt)'>
+ 	| savedHeaderA savedHeaderB result |
+ 	savedHeaderA := self baseHeader: obj1.
+ 	self baseHeader: obj1 put: (self headerWhileForwardingOf: obj1).
+ 	savedHeaderB := self baseHeader: obj2.
+ 	self baseHeader: obj2 put: (self headerWhileForwardingOf: obj2).
+ 
+ 	result := cogit perform: selector with: obj1 with: obj2.
+ 
+ 	self baseHeader: obj1 put: savedHeaderA.
+ 	self baseHeader: obj2 put: savedHeaderB.
+ 	^result!

Item was added:
+ ----- Method: NewObjectMemory>>freeObject:header: (in category 'become') -----
+ freeObject: obj header: objHeader
+ 	(self isContextHeader: objHeader) ifTrue:
+ 		[(self asserta: ((coInterpreter isStillMarriedContext: obj) not)) ifFalse:
+ 			[self error: 'attempt to free married context']].
+ 	super freeObject: obj header: objHeader!

Item was changed:
  ----- Method: NewObjectMemory>>freeStart (in category 'accessing') -----
  freeStart
+ 	"This is a horribe hack and only works because C macros are generated after Interpreter variables."
+ 	<cmacro: '() freeStart'>
  	^freeStart!

Item was added:
+ ----- Method: NewObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
+ restoreHeaderOf: obj to: objHeader
+ 	super restoreHeaderOf: obj to: objHeader.
+ 	(self isContextHeader: objHeader) ifTrue:
+ 		[(self asserta: ((coInterpreter isStillMarriedContext: obj) not)) ifFalse:
+ 			[self error: 'attempt to become married context']]!

Item was changed:
  ----- Method: ObjectMemory>>byteLengthOf: (in category 'indexing primitive support') -----
+ byteLengthOf: obj
+ 	"Return the number of indexable bytes in the given object.
+ 	 This is basically a special copy of lengthOf: for BitBlt. But it is also
+ 	 whoorishly used for the Cogit."
+ 	<api>
- byteLengthOf: oop
- 	"Return the number of indexable bytes in the given object. This is basically a special copy of lengthOf: for BitBlt."
  	| header sz fmt |
+ 	header := self baseHeader: obj.
- 	header := self baseHeader: oop.
  	sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
+ 			ifTrue: [(self sizeHeader: obj) bitAnd: AllButTypeMask]
- 			ifTrue: [(self sizeHeader: oop) bitAnd: AllButTypeMask]
  			ifFalse: [header bitAnd: SizeMask].
  	fmt := self formatOfHeader: header.
  	^fmt < 8
  		ifTrue: [(sz - BaseHeaderSize)]  "words"
  		ifFalse: [(sz - BaseHeaderSize) - (fmt bitAnd: 3)]  "bytes"!

Item was changed:
  ----- Method: ObjectMemory>>freeObject: (in category 'become') -----
  freeObject: obj
+ 	| objHeader |
- 	| objHeader objHeaderBytes objHeaderType objSize |
  	objHeader := self baseHeader: obj.
+ 	self freeObject: obj header: objHeader!
- 	(self isYoungRootHeader: objHeader) ifTrue:
- 		[self removeYoungRoot: obj].
- 	objHeaderType := objHeader bitAnd: TypeMask.
- 	objHeaderBytes := headerTypeBytes at: objHeaderType.
- 	(objHeaderType bitAnd: 1) = 1 "HeaderTypeClass or HeaderTypeShort"
- 		ifTrue: [objSize := objHeader bitAnd: SizeMask]
- 		ifFalse:
- 			[objHeaderType = HeaderTypeFree
- 				ifTrue: [^nil]. "already free"
- 			objSize := (self sizeHeader: obj) bitAnd: LongSizeMask].
- 	self assert: (objSize + objHeaderBytes bitAnd: AllButTypeMask) = (objSize + objHeaderBytes).
- 	self longAt: obj - objHeaderBytes
- 		put: ((objSize + objHeaderBytes) bitOr: HeaderTypeFree)!

Item was added:
+ ----- Method: ObjectMemory>>freeObject:header: (in category 'become') -----
+ freeObject: obj header: objHeader
+ 	| objHeaderBytes objHeaderType objSize |
+ 	(self isYoungRootHeader: objHeader) ifTrue:
+ 		[self removeYoungRoot: obj].
+ 	objHeaderType := objHeader bitAnd: TypeMask.
+ 	objHeaderBytes := headerTypeBytes at: objHeaderType.
+ 	(objHeaderType bitAnd: 1) = 1 "HeaderTypeClass or HeaderTypeShort"
+ 		ifTrue: [objSize := objHeader bitAnd: SizeMask]
+ 		ifFalse:
+ 			[objHeaderType = HeaderTypeFree
+ 				ifTrue: [^nil]. "already free"
+ 			objSize := (self sizeHeader: obj) bitAnd: LongSizeMask].
+ 	self assert: (objSize + objHeaderBytes bitAnd: AllButTypeMask) = (objSize + objHeaderBytes).
+ 	self longAt: obj - objHeaderBytes
+ 		put: ((objSize + objHeaderBytes) bitOr: HeaderTypeFree)!

Item was changed:
  ----- Method: ObjectMemory>>restoreHeaderOf: (in category 'become') -----
+ restoreHeaderOf: obj
+ 	"Restore the original header of the given obj from its forwarding block."
+ 	<inline: true> "for subclasses"
+ 	| fwdHeader fwdBlock objHeader |
+ 	fwdHeader := self longAt: obj.
- restoreHeaderOf: oop 
- 	"Restore the original header of the given oop from its 
- 	forwarding block."
- 	| fwdHeader fwdBlock |
- 	fwdHeader := self longAt: oop.
  	fwdBlock := (fwdHeader bitAnd: AllButMarkBitAndTypeMask) << 1.
  	self assert: (fwdHeader bitAnd: MarkBit) ~= 0.
  	self assert: (self fwdBlockValid: fwdBlock).
+ 	objHeader := self longAt: fwdBlock + BytesPerWord.
+ 	self restoreHeaderOf: obj to: objHeader!
- 	self longAt: oop put: (self longAt: fwdBlock + BytesPerWord)!

Item was added:
+ ----- Method: ObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
+ restoreHeaderOf: obj to: objHeader
+ 	"helper for restoreHeaderOf: for subclasses to override"
+ 	<inline: true> "for subclasses"
+ 	self longAt: obj put: objHeader!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>compileCogMethod: (in category 'compile abstract instructions') -----
  compileCogMethod: selector
  	<returnTypeC: #'CogMethod *'>
  	| numBytecodes numBlocks result extra |
  	self cCode: '' inSmalltalk:
  		[debugStackPointers := coInterpreter debugStackPointersFor: methodObj].
  	hasYoungReferent := (objectMemory isYoung: methodObj)
  						  or: [objectMemory isYoung: selector].
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
  	methodOrBlockNumTemps := coInterpreter tempCountOf: methodObj.
  	inBlock := false.
  	primInvokeLabel := nil.
  	postCompileHook := nil.
  	extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
  			and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
  				ifTrue: [30]
  				ifFalse: [10].
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
  					ifTrue: [initialPC - 1]
+ 					ifFalse: [objectMemory byteLengthOf: methodObj].
- 					ifFalse: [objectMemory byteSizeOf: methodObj].
  	numBytecodes := endPC - initialPC + 1.
  	self allocateOpcodes: (numBytecodes + extra) * 10 bytecodes: numBytecodes.
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	self allocateBlockStarts: numBlocks.
  	self allocateCounters; initializeCounters.
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogMethod: selector!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
  	"Machine-code <-> bytecode pc mapping support.  Evaluate functionSymbol
  	 for each mcpc, bcpc pair in the map until the function returns non-zero,
  	 answering that result, or 0 if it fails to.  This works only for frameful methods.
  
  	 Override to add the descriptor as the first argument to function."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self assert: cogMethod stackCheckOffset > 0.
  	"In both CMMethod and CMBlock cases find the start of the map and
  	 skip forward to the bytecode pc map entry for the stack check."
  	cogMethod cmType = CMMethod
  		ifTrue:
  			[isInBlock := false.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
+ 			 endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
- 			 endbcpc := (objectMemory byteSizeOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
  		ifFalse:
  			[isInBlock := true.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
  			 [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  				[map := map - 1].
  			 map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
  			 aMethodObj := homeMethod methodObject.
  			 bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			 byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  			 descriptor := self generatorAt: byte.
  			 endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
  	bcpc := startbcpc.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	nExts := 0.
  	"as a hack for collecting counters, remember the prev mcpc in a static variable."
  	prevMapAbsPCMcpc := 0.
  	"The stack check maps to the start of the first bytecode,
  	 the first bytecode being effectively after frame build."
  	result := self perform: functionSymbol
  					with: nil
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	"Now skip up through the bytecode pc map entry for the stack check." 
  	[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  		[map := map - 1].
  	map := map - 1.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[| annotation nextBcpc |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
  				(self isPCMappedAnnotation: annotation) ifTrue:
  					[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  					  descriptor := self generatorAt: byte.
  					  isInBlock
  						ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
  						ifFalse:
  							[(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0].
  							 (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  								[| targetPC |
  								 targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: descriptor
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj)
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc].
  				annotation = IsAbsPCReference ifTrue:
  					[prevMapAbsPCMcpc := mcpc]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>instVar:ofContext:put: (in category 'frame access') -----
  instVar: index ofContext: aMarriedContext put: anOop
  	| theFP |
  	"Assign the field of a married context.  The important case to optimize is
  	 assigning the sender.  We could also consider optimizing assiging the IP but
  	 typically that is followed by an assignment to the stack pointer and we can't
  	 efficiently assign the stack pointer because it involves moving frames around."
  	<inline: true>
  	self assert: (self isMarriedOrWidowedContext: aMarriedContext).
  	self writeBackHeadFramePointers.
  	(self isStillMarriedContext: aMarriedContext) ifFalse:
  		[objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop.
  		 index = StackPointerIndex ifTrue:
  			[self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext].
  		 ^nil].
  	theFP := self frameOfMarriedContext: aMarriedContext.
  	index == SenderIndex ifTrue:
  		[| thePage onCurrentPage |
  		 thePage := stackPages stackPageFor: theFP.
  		 self assert: stackPage = stackPages mostRecentlyUsedPage.
  		 onCurrentPage := thePage = stackPage.
  		 self storeSenderOfFrame: theFP withValue: anOop.
  		 onCurrentPage
  			ifTrue:
  				[localFP := stackPage headFP.
  				 localSP := stackPage headSP]
  			ifFalse:
  				[stackPages markStackPageMostRecentlyUsed: stackPage].
  		 ^nil].
  	self externalizeIPandSP.
  	self externalDivorceFrame: theFP andContext: aMarriedContext.
  	objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop.
  	index = StackPointerIndex ifTrue:
  		[self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext].
  	self internalizeIPandSP.
  	"Assigning various fields can force a divorce which can change the stackPage."
  	stackPages markStackPageMostRecentlyUsed: stackPage.
+ 	self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: true!
- 	self assertValidExecutionPointe: localIP r: localFP s: localSP imbar: true!

Item was changed:
  ----- Method: StackInterpreter>>temporaryCountOfMethodHeader: (in category 'compiled methods') -----
  temporaryCountOfMethodHeader: header
+ 	<api>
  	<inline: true>
  	^(header >> 19) bitAnd: 16r3F!

Item was changed:
  ----- Method: TMethod>>checkForCompleteness:in: (in category 'inlining') -----
  checkForCompleteness: stmtLists in: aCodeGen
  	"Set the complete flag if none of the given statement list nodes contains further candidates for inlining."
  
  	complete := true.
  	stmtLists do:
  		[ :stmtList |
  		stmtList statements do:
  			[ :node |
  			[(self inlineableSend: node in: aCodeGen) ifTrue:
  				[complete := false.  "more inlining to do"
  				^self]]]].
  
  	parseTree
  		nodesDo:
  			[ :n |
  			(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
  				[complete := false.  "more inlining to do"
  				^self]]
  		unless:
+ 			[ :n | n isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: n selector]]!
- 			[ :n | n isSend and: [#(cCode:inSmalltalk: assert:) includes: n selector]]!

Item was changed:
  ----- Method: TMethod>>statementsListsForInlining (in category 'inlining') -----
  statementsListsForInlining
  	"Answer a collection of statement list nodes that are candidates for inlining.
  	 Currently, we cannot inline into the argument blocks of and: and or: messages.
  	 We do not want to inline code strings within cCode:inSmalltalk: blocks (those with a
  	 proper block for the cCode: argument are inlined in MessageNode>>asTranslatorNodeIn:).
  	 We do not want to inline code within assert: sends (because we want the assert to read nicely)."
  
  	| stmtLists |
  	stmtLists := OrderedCollection new: 10.
  	parseTree
  		nodesDo:
  			[ :node | 
  			node isStmtList ifTrue: [ stmtLists add: node ]]
  		unless:
  			[ :node |
+ 			node isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: node selector]].
- 			node isSend and: [#(cCode:inSmalltalk: assert:) includes: node selector]].
  	parseTree nodesDo:
  		[ :node | 
  		node isSend ifTrue:
  			[node selector = #cCode:inSmalltalk: ifTrue:
  				[node nodesDo:
  					[:inStNode| stmtLists remove: inStNode ifAbsent: []]].
  			 node selector = #cppIf:ifTrue:ifFalse: ifTrue:
  				[node args first nodesDo:
  					[:inCondNode| stmtLists remove: inCondNode ifAbsent: []]].
  			((node selector = #and:) or: [node selector = #or:]) ifTrue:
  				"Note: the PP 2.3 compiler produces two arg nodes for these selectors"
  				[stmtLists remove: node args first ifAbsent: [].
  				stmtLists remove: node args last ifAbsent: []].
  			(#(	#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:
  				#ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil: ) includes: node selector) ifTrue:
  				[stmtLists remove: node receiver ifAbsent: []].
  			(#(whileTrue whileTrue: whilefalse whileFalse:) includes: node selector) ifTrue:
  				"Allow inlining if it is a [...] whileTrue/whileFalse.
  				This is identified by having more than one statement in the 
  				receiver block in which case the C code wouldn't work anyways"
  				[node receiver statements size = 1 ifTrue:
  					[stmtLists remove: node receiver ifAbsent: []]].
  			(node selector = #to:do:) ifTrue:
  				[stmtLists remove: node receiver ifAbsent: [].
  				stmtLists remove: node args first ifAbsent: []].
  			(node selector = #to:by:do:) ifTrue:
  				[stmtLists remove: node receiver ifAbsent: [].
  				stmtLists remove: node args first ifAbsent: [].
  				stmtLists remove: node args second ifAbsent: []]].
  		node isCaseStmt ifTrue: "don't inline cases"
  			[node cases do: [: case | stmtLists remove: case ifAbsent: []]]].
  	^stmtLists!

Item was changed:
  ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') -----
  tryToInlineMethodsIn: aCodeGen
  	"Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined."
  
  	| stmtLists didSomething newStatements sendsToInline |
  	self definedAsMacro ifTrue:
  		[complete := true.
  		 ^false].
  	didSomething := false.
  	sendsToInline := Dictionary new: 100.
  	parseTree
  		nodesDo:
  			[ :n |
  			(self inlineableFunctionCall: n in: aCodeGen) ifTrue:
  				[sendsToInline at: n put: (self inlineFunctionCall: n in: aCodeGen)]]
  		unless: "Don't inline the arguments to asserts to keep the asserts readable"
+ 			[:n| n isSend and: [#(cCode:inSmalltalk: assert: asserta:) includes: n selector]].
- 			[:n| n isSend and: [#(cCode:inSmalltalk: assert:) includes: n selector]].
  
  	sendsToInline isEmpty ifFalse:
  		[didSomething := true.
  		parseTree := parseTree replaceNodesIn: sendsToInline].
  
  	didSomething ifTrue:
  		[writtenToGlobalVarsCache := nil.
  		^didSomething].
  
  	stmtLists := self statementsListsForInlining.
  	stmtLists do:
  		[ :stmtList | 
  		newStatements := OrderedCollection new: 100.
  		stmtList statements do:
  			[ :stmt |
  			(self inlineCodeOrNilForStatement: stmt in: aCodeGen)
  				ifNil: [newStatements addLast: stmt]
  				ifNotNil: [:inlinedStmts|
  					didSomething := true.
  					newStatements addAllLast: inlinedStmts]].
  		stmtList setStatements: newStatements asArray].
  
  	didSomething ifTrue:
  		[writtenToGlobalVarsCache := nil.
  		^didSomething].
  
  	complete ifFalse:
  		[self checkForCompleteness: stmtLists in: aCodeGen.
  		 complete ifTrue: [ didSomething := true ]].  "marking a method complete is progress"
  	^didSomething!



More information about the Vm-dev mailing list