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

commits at source.squeak.org commits at source.squeak.org
Sat Apr 5 20:00:45 UTC 2014


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

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

Name: VMMaker.oscog-eem.667
Author: eem
Time: 5 April 2014, 12:57:23.437 pm
UUID: 1a6d90d7-74e1-4519-9da1-d39c12321b2e
Ancestors: VMMaker.oscog-eem.666

Add Spur support for Sista (shorten:toIndexableSize: et al).
Implement instantiation in picDataFor:into: in terms of
eeInstantiateClassIndex:format:numSlots:.

Slang:
Allow methods that are functional apart from an initial flag: send to
be inlined.  This allows e.g. rawSlotsOf: et al to be inlined in Spur.

Add a Spur Sista configuration.

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

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>classForInlineCacheTag: (in category 'in-line cacheing') -----
+ classForInlineCacheTag: classIndex
+ 	^objectMemory classOrNilAtIndex: classIndex!

Item was changed:
  ----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
  shorten: obj toIndexableSize: nSlots
+ 	"Reduce the number of indexable fields in obj, a pointer object, to nSlots. Convert the
- 	"Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
  	unused residual to a free chunk. Word and byte indexable objects are not changed.
  	Answer the number of bytes returned to free memory, which may be zero if no change
  	was possible."
  	| deltaBytes desiredLength fixedFields fmt hdr totalLength
  	 indexableFields |
  	(self isPointersNonImm: obj) ifFalse: [^0].
  	nSlots >  0
  		ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
  	hdr := self baseHeader: obj.
  	fmt := self formatOfHeader: hdr.
  	totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
  	fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
  	indexableFields := totalLength - fixedFields.
  	nSlots >= indexableFields
  		ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
  	desiredLength := fixedFields + nSlots.		
  	deltaBytes := (totalLength - desiredLength) * BytesPerWord.
  	obj + BaseHeaderSize + (totalLength * BytesPerWord) = freeStart
  		ifTrue: "Shortening the last object.  Need to reduce freeStart."
  			[self maybeFillWithAllocationCheckFillerFrom: obj + BaseHeaderSize + (desiredLength * BytesPerWord) to: freeStart.
  			freeStart := obj + BaseHeaderSize + (desiredLength * BytesPerWord)]
  		ifFalse: "Shortening some interior object.  Need to create a free block."
  			[self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord)
  				to: deltaBytes].
  	(self headerType: obj) caseOf:	{
  		[HeaderTypeSizeAndClass] ->
  			[self longAt: (obj - (BaseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
  		[HeaderTypeClass] ->
  			[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)].
  		[HeaderTypeShort] ->
  			[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }.
  	^deltaBytes!

Item was changed:
  ----- Method: ObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
  shorten: obj toIndexableSize: nSlots
+ 	"Reduce the number of indexable fields in obj, a pointer object, to nSlots. Convert the
- 	"Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
  	unused residual to a free chunk. Word and byte indexable objects are not changed.
  	Answer the number of bytes returned to free memory, which may be zero if no change
  	was possible."
  	| deltaBytes desiredLength fixedFields fmt hdr totalLength
  	 indexableFields |
  	(self isPointersNonImm: obj) ifFalse: [^0].
  	nSlots >  0
  		ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
  	hdr := self baseHeader: obj.
  	fmt := self formatOfHeader: hdr.
  	totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
  	fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
  	indexableFields := totalLength - fixedFields.
  	nSlots >= indexableFields
  		ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
  	desiredLength := fixedFields + nSlots.		
  	deltaBytes := (totalLength - desiredLength) * BytesPerWord.
  	self setSizeOfFree: obj + BaseHeaderSize + (desiredLength * BytesPerWord)
  		to: deltaBytes.
  	(self headerType: obj) caseOf:	{
  		[HeaderTypeSizeAndClass] ->
  			[self longAt: (obj - (BaseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
  		[HeaderTypeClass] ->
  			[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)].
  		[HeaderTypeShort] ->
  			[self longAt: obj put: ((hdr bitClear: SizeMask) bitOr: (hdr bitAnd: SizeMask) - deltaBytes)] }.
  	^deltaBytes!

Item was changed:
  StackToRegisterMappingCogit subclass: #SistaStackToRegisterMappingCogit
  	instanceVariableNames: 'picDataIndex picData numCounters counters counterIndex initialCounterValue counterMethodCache prevMapAbsPCMcpc'
  	classVariableNames: 'CounterBytes MaxCounterValue'
+ 	poolDictionaries: 'VMSqueakClassIndices'
- 	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !SistaStackToRegisterMappingCogit commentStamp: 'eem 4/4/2014 12:39' prior: 0!
  A SistaStackToRegisterMappingCogit is a refinement of StackToRegisterMappingCogit that generates code suitable for dynamic optimization by Sista, the Speculative Inlining Smalltalk Architecture, a project by Clément Bera and Eliot Miranda.  Sista is an optimizer that exists in the Smalltalk image, /not/ in the VM,  and optimizes by substituting normal bytecoded methods by optimized bytecoded methods that may use special bytecodes for which the Cogit can generate faster code.  These bytecodes eliminate overheads such as bounds checks or polymorphic code (indexing Array, ByteArray, String etc).  But the bulk of the optimization performed is in inlining blocks and sends for the common path.
  
  The basic scheme is that SistaStackToRegisterMappingCogit generates code containing performance counters.  When these counters trip, a callback into the image is performed, at which point Sista analyses some portion of the stack, looking at performance data for the methods on the stack, and optimises based on teh stack and performance data.  Execution then resumes in the optimized code.
  
  SistaStackToRegisterMappingCogit adds counters to conditional branches.  Each branch has an executed and a taken count, implemented at the two 16-bit halves of a single 32-bit word.  Each counter pair is initialized with initialCounterValue.  On entry to the branch the executed count is decremented and if the count goes below zero the ceMustBeBooleanAdd[True|False] trampoline called.  The trampoline distinguishes between true mustBeBoolean and counter trips because in the former the register temporarily holding the counter value will contain zero.  Then the condition is tested, and if the branch is taken the taken count is decremented.  The two counter values allow an optimizer to collect basic block execution paths and to know what are the "hot" paths through execution that are worth agressively optimizing.  Since conditional branches are about 1/6 as frequent as sends, and since they can be used to determine the hot path throguh code, they are a better choice to count than, for example, method or block entry.
  
  SistaStackToRegisterMappingCogit implements picDataFor:into: that fills an Array with the state of the counters in a method and the state of each linked send in a method.  This is used to implement a primitive used by the optimizer to answer the branch and send data for a method as an Array.
  
  Instance Variables
  	counterIndex:			<Integer>
  	counterMethodCache:	<CogMethod>
  	counters:				<Array of AbstractInstruction>
  	initialCounterValue:		<Integer>
  	numCounters:			<Integer>
  	picData:				<Integer Oop>
  	picDataIndex:			<Integer>
  	prevMapAbsPCMcpc:	<Integer>
  
  counterIndex
  	- xxxxx
  
  counterMethodCache
  	- xxxxx
  
  counters
  	- xxxxx
  
  initialCounterValue
  	- xxxxx
  
  numCounters
  	- xxxxx
  
  picData
  	- xxxxx
  
  picDataIndex
  	- xxxxx
  
  prevMapAbsPCMcpc
  	- xxxxx
  !

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>picDataFor:Mcpc:Bcpc:Method: (in category 'method introspection') -----
  picDataFor: descriptor Mcpc: mcpc Bcpc: bcpc Method: cogMethodArg
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #mcpc type: #'char *'>
  	<var: #cogMethodArg type: #'void *'>
  	| entryPoint tuple |
  	descriptor isNil ifTrue:
  		[^0].
+ 	descriptor isBranch ifTrue:
+ 		["it's a branch; conditional?"
+ 		 (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
+ 			[tuple := self picDataForConditionalBranch: prevMapAbsPCMcpc at: bcpc.
+ 			 tuple = 0 ifTrue: [^PrimErrNoMemory].
+ 			 objectMemory storePointer: picDataIndex ofObject: picData withValue: tuple.
+ 			 picDataIndex := picDataIndex + 1].
- 	descriptor isBranch ifFalse: "infer it's a send"
- 		[self assert: (backEnd isCallPreceedingReturnPC: mcpc asUnsignedInteger).
- 		 entryPoint := backEnd callTargetFromReturnAddress: mcpc asUnsignedInteger.
- 		 entryPoint <= methodZoneBase ifTrue: "send is not linked"
- 			[^0].
- 		 self targetMethodAndSendTableFor: entryPoint into: "It's a linked send; find which kind."
- 			[:targetMethod :sendTable|
- 			 tuple := self picDataForSendTo: targetMethod at: mcpc bcpc: bcpc + 1 - descriptor numBytes].
- 		 tuple = 0 ifTrue: [^PrimErrNoMemory].
- 		 objectMemory storePointer: picDataIndex ofObject: picData withValue: tuple.
- 		 picDataIndex := picDataIndex + 1.
  		 ^0].
+ 	"infer it's a send"
+ 	self assert: (backEnd isCallPreceedingReturnPC: mcpc asUnsignedInteger).
+ 	entryPoint := backEnd callTargetFromReturnAddress: mcpc asUnsignedInteger.
+ 	entryPoint <= methodZoneBase ifTrue: "send is not linked"
+ 		[^0].
+ 	self targetMethodAndSendTableFor: entryPoint into: "It's a linked send; find which kind."
+ 		[:targetMethod :sendTable|
+ 		 tuple := self picDataForSendTo: targetMethod
+ 					methodClassIfSuper: (sendTable = superSendTrampolines ifTrue:
+ 												[coInterpreter methodClassOf:
+ 													(self cCoerceSimple: cogMethodArg to: #'CogMethod *') methodObject])
+ 					at: mcpc
+ 					bcpc: bcpc + 1 - descriptor numBytes].
+ 	tuple = 0 ifTrue: [^PrimErrNoMemory].
+ 	objectMemory storePointer: picDataIndex ofObject: picData withValue: tuple.
+ 	picDataIndex := picDataIndex + 1.
- 	"it's a branch; conditional?"
- 	(descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
- 		[tuple := self picDataForConditionalBranch: prevMapAbsPCMcpc at: bcpc.
- 		 tuple = 0 ifTrue: [^PrimErrNoMemory].
- 		 objectMemory storePointer: picDataIndex ofObject: picData withValue: tuple.
- 		 picDataIndex := picDataIndex + 1.
- 		 ^0].
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>picDataForConditionalBranch:at: (in category 'method introspection') -----
  picDataForConditionalBranch: counterReferenceMcpc at: bcpc
  	| address counter executedCount tuple untakenCount |
  	<var: #counter type: #'unsigned long'>
  	tuple := objectMemory
+ 				eeInstantiateClassIndex: ClassArrayCompactIndex
+ 				format: objectMemory arrayFormat
+ 				numSlots: 3.
- 				instantiateClass: (objectMemory splObj: ClassArray)
- 				indexableSize: 3.
  	tuple = 0 ifTrue:
  		[^0].
  	self assert: CounterBytes = 4.
  	address := backEnd counterTargetFromFollowingAddress: counterReferenceMcpc.
  	counter := objectMemory longAt: address.
  	executedCount := initialCounterValue - (counter >> 16).
  	untakenCount := initialCounterValue - (counter bitAnd: 16rFFFF).
  	objectMemory
  		storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: bcpc);
  		storePointerUnchecked: 1 ofObject: tuple withValue: (objectMemory integerObjectOf: executedCount);
  		storePointerUnchecked: 2 ofObject: tuple withValue: (objectMemory integerObjectOf: untakenCount).
  	^tuple!

Item was removed:
- ----- Method: SistaStackToRegisterMappingCogit>>picDataForSendTo:at:bcpc: (in category 'method introspection') -----
- picDataForSendTo: cogMethod at: sendMcpc bcpc: sendBcpc
- 	"Answer a tuple with the send data for a linked send to cogMethod.
- 	 If the target is a CogMethod (monomorphic send) answer
- 		{ bytecode pc, inline cache class, target method }
- 	 If the target is an open PIC (megamorphic send) answer
- 		{ bytecode pc, nil, send selector }
- 	If the target is a closed PIC (polymorphic send) answer
- 		{ bytecode pc, first class, target method, second class, second target method, ... }"
- 	<var: #cogMethod type: #'CogMethod *'>
- 	<var: #sendMcpc type: #'char *'>
- 	| tuple |
- 	cogMethod cmType = CMMethod ifTrue:
- 		[tuple := objectMemory
- 					eeInstantiateClass: (objectMemory splObj: ClassArray)
- 					indexableSize: 3.
- 		tuple = 0 ifTrue:
- 			[^0].
- 		objectMemory
- 			storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc);
- 			storePointer: 1
- 				ofObject: tuple
- 					withValue: (objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger));
- 			storePointer: 2 ofObject: tuple withValue: cogMethod methodObject.
- 		^tuple].
- 	cogMethod cmType = CMClosedPIC ifTrue:
- 		[tuple := objectMemory
- 					eeInstantiateClass: (objectMemory splObj: ClassArray)
- 					indexableSize: 2 * cogMethod cPICNumCases + 1.
- 		tuple = 0 ifTrue:
- 			[^0].
- 		objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc).
- 		self populate: tuple withPICInfoFor: cogMethod firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger).
- 		^tuple].
- 	cogMethod cmType = CMOpenPIC ifTrue:
- 		[tuple := objectMemory
- 					eeInstantiateClass: (objectMemory splObj: ClassArray)
- 					indexableSize: 3.
- 		tuple = 0 ifTrue:
- 			[^0].
- 		objectMemory
- 			storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc);
- 			storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject;
- 			storePointer: 2 ofObject: tuple withValue: cogMethod selector.
- 		^tuple].
- 	self error: 'invalid method type'.
- 	^0 "to get Slang to type this method as answering sqInt"!

Item was added:
+ ----- Method: SistaStackToRegisterMappingCogit>>picDataForSendTo:methodClassIfSuper:at:bcpc: (in category 'method introspection') -----
+ picDataForSendTo: cogMethod methodClassIfSuper: methodClassOrNil at: sendMcpc bcpc: sendBcpc
+ 	"Answer a tuple with the send data for a linked send to cogMethod.
+ 	 If the target is a CogMethod (monomorphic send) answer
+ 		{ bytecode pc, inline cache class, target method }
+ 	 If the target is an open PIC (megamorphic send) answer
+ 		{ bytecode pc, nil, send selector }
+ 	If the target is a closed PIC (polymorphic send) answer
+ 		{ bytecode pc, first class, target method, second class, second target method, ... }"
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	<var: #sendMcpc type: #'char *'>
+ 	| tuple |
+ 	tuple := objectMemory
+ 					eeInstantiateClassIndex: ClassArrayCompactIndex
+ 					format: objectMemory arrayFormat
+ 					numSlots: (cogMethod cmType = CMClosedPIC
+ 								ifTrue: [2 * cogMethod cPICNumCases + 1]
+ 								ifFalse: [3]).
+ 	tuple = 0 ifTrue:
+ 		[^0].
+ 	objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc).
+ 	cogMethod cmType = CMMethod ifTrue:
+ 		[objectMemory
+ 			storePointer: 1
+ 				ofObject: tuple
+ 					withValue: (methodClassOrNil ifNil:
+ 								[objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)]);
+ 			storePointer: 2 ofObject: tuple withValue: cogMethod methodObject.
+ 		^tuple].
+ 	cogMethod cmType = CMClosedPIC ifTrue:
+ 		[self populate: tuple withPICInfoFor: cogMethod firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger).
+ 		^tuple].
+ 	cogMethod cmType = CMOpenPIC ifTrue:
+ 		[objectMemory
+ 			storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject;
+ 			storePointer: 2 ofObject: tuple withValue: cogMethod selector.
+ 		^tuple].
+ 	self error: 'invalid method type'.
+ 	^0 "to get Slang to type this method as answering sqInt"!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>oldRawNumSlotsOf: (in category 'object access') -----
+ oldRawNumSlotsOf: objOop
+ 	<returnTypeC: #usqInt>
+ 	<inline: true>
+ 	self flag: #endianness.
+ 	^(self longAt: objOop + 4) asUnsignedInteger >> self numSlotsHalfShift!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
- rawNumSlotsOf: objOop
- 	<returnTypeC: #usqInt>
- 	<inline: true>
- 	self flag: #endianness.
- 	^(self longAt: objOop + 4) asUnsignedInteger >> self numSlotsHalfShift!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>rawOverflowSlotsOf:put: (in category 'object access') -----
+ rawOverflowSlotsOf: objOop put: numSlots
+ 	<returnTypeC: #usqInt>
+ 	<inline: true>
+ 	self flag: #endianness.
+ 	^self longAt: objOop - self baseHeaderSize put: numSlots!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>oldRawNumSlotsOf: (in category 'object access') -----
+ oldRawNumSlotsOf: objOop
+ 	<returnTypeC: #usqInt>
+ 	<inline: true>
+ 	^(self longAt: objOop) asUnsignedLong >> self numSlotsFullShift!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
- rawNumSlotsOf: objOop
- 	<returnTypeC: #usqInt>
- 	<inline: true>
- 	^(self longAt: objOop) asUnsignedLong >> self numSlotsFullShift!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>rawOverflowSlotsOf:put: (in category 'object access') -----
+ rawOverflowSlotsOf: objOop put: numSlots
+ 	<returnTypeC: #usqLong>
+ 	<inline: true>
+ 	self flag: #endianness.
+ 	self longAt: objOop - self baseHeaderSize
+ 		put: (self byteAt: objOop - 1) << 56 + numSlots.
+ 	^numSlots!

Item was changed:
  ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'instantiation') -----
  eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots
  	"Instantiate an instance of a compact class.  ee stands for execution engine and
  	 implies that this allocation will *NOT* cause a GC.  N.B. the instantiated object
  	 IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
  	 call is used in routines that do just that we are safe.  Break this rule and die in GC.
  	 Result is guaranteed to be young."
+ 	<api>
  	<inline: true>
  	self assert: (numSlots >= 0 and: [knownClassIndex ~= 0]).
  	self assert: (objFormat < self firstByteFormat
  					ifTrue: [objFormat]
  					ifFalse: [objFormat bitAnd: self byteFormatMask])
  				= (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
  	^self allocateNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex!

Item was added:
+ ----- Method: SpurMemoryManager>>minSlotsForShortening (in category 'allocation') -----
+ minSlotsForShortening
+ 	"Answer the minimum number of additional slots to allocate in an object to always be able to shorten it.
+ 	 This is enough slots to allocate a minimum-sized object."
+ 	^self allocationUnit * 2 / self bytesPerSlot!

Item was added:
+ ----- Method: SpurMemoryManager>>oldRawNumSlotsOf: (in category 'object access') -----
+ oldRawNumSlotsOf: objOop
+ 	<returnTypeC: #usqInt>
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
  rawNumSlotsOf: objOop
  	<returnTypeC: #usqInt>
+ 	<inline: true>
+ 	self flag: #endian.
+ 	^self byteAt: objOop + 7!
- 	^self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>rawNumSlotsOf:put: (in category 'object access') -----
+ rawNumSlotsOf: objOop put: aByte
+ 	<returnTypeC: #usqInt>
+ 	<inline: true>
+ 	self flag: #endian.
+ 	^self byteAt: objOop + 7 put: aByte!

Item was added:
+ ----- Method: SpurMemoryManager>>rawOverflowSlotsOf:put: (in category 'object access') -----
+ rawOverflowSlotsOf: objOop put: numSlots
+ 	<returnTypeC: #usqInt>
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>shorten:toIndexableSize: (in category 'allocation') -----
+ shorten: objOop toIndexableSize: indexableSize
+ 	"Reduce the number of indexable fields in objOop, a pointer object, to nSlots. Convert the
+ 	 unused residual to a free chunk. Word and byte indexable objects are not changed.
+ 	 Answer the number of bytes returned to free memory, which may be zero if no change
+ 	 was possible."
+ 	<inline: false>
+ 	| numSlots bytesBefore bytesAfter |
+ 	(self formatOf: objOop) caseOf:
+ 		{ [self arrayFormat]	->	[numSlots := indexableSize] }.
+ 	bytesBefore := self bytesInObject: objOop.
+ 	(self hasOverflowHeader: objOop)
+ 		ifTrue: [self rawOverflowSlotsOf: objOop put: numSlots]
+ 		ifFalse:
+ 			[self assert: numSlots < self numSlotsMask.
+ 			 self rawNumSlotsOf: objOop put: numSlots].
+ 	bytesAfter := self bytesInObject: objOop.
+ 	self freeChunkWithBytes: bytesAfter - bytesBefore at: (self addressAfter: objOop).
+ 	^bytesAfter - bytesBefore!

Item was changed:
  ----- Method: StackInterpreter>>methodClassOf: (in category 'compiled methods') -----
  methodClassOf: methodPointer
+ 	<api>
- 
  	^self cppIf: NewspeakVM
  		ifTrue:
  			[| literal |
  			 literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
  			 self assert: (objectMemory isForwarded: literal) not.
  			 literal = objectMemory nilObject
  				ifTrue: [literal]
  				ifFalse: [objectMemory fetchPointer: ValueIndex ofObject: literal]]
  		ifFalse:
  			[| literal |
  			 literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
  			 self assert: (objectMemory isForwarded: literal) not.
  			 objectMemory fetchPointer: ValueIndex ofObject: literal]!

Item was changed:
  ----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') -----
  inlineFunctionCall: aSendNode in: aCodeGen
  	"Answer the body of the called function, substituting the actual
  	 parameters for the formal argument variables in the method body.
  	 Assume caller has established that:
  		1. the method arguments are all substitutable nodes, and
  		2. the method to be inlined contains no additional embedded returns."
  
  	| sel meth doNotRename argsForInlining substitutionDict |
  	sel := aSendNode selector.
  	meth := (aCodeGen methodNamed: sel) copy.
  	doNotRename := Set withAll: args.
  	argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen.
  	meth args with: argsForInlining do:
  		[ :argName :exprNode |
  		exprNode isLeaf ifTrue:
  			[doNotRename add: argName]].
+ 	(meth statements size = 2
+ 	and: [meth statements first isSend
+ 	and: [meth statements first selector == #flag:]]) ifTrue:
+ 		[meth statements removeFirst].
  	meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen.
  	meth renameLabelsForInliningInto: self.
  	self addVarsDeclarationsAndLabelsOf: meth except: doNotRename.
  	substitutionDict := Dictionary new: meth args size * 2.
  	meth args with: argsForInlining do:
  		[ :argName :exprNode |
  		substitutionDict at: argName put: exprNode.
  		(doNotRename includes: argName) ifFalse:
  			[locals remove: argName]].
  	meth parseTree bindVariablesIn: substitutionDict.
  	^meth statements first expression!

Item was changed:
  ----- Method: TMethod>>isFunctional (in category 'inlining') -----
  isFunctional
  	"Answer true if the receiver is a functional method. That is, if it
  	 consists of a single return statement of an expression that contains
  	 no other returns.
  
  	 Answer false for methods with return types other than the simple
  	 integer types to work around bugs in the inliner."
  
+ 	parseTree statements isEmpty ifTrue:
+ 		[^false].
+ 	parseTree statements last isReturn ifFalse:
+ 		[^false].
+ 	parseTree statements size = 1 ifFalse:
+ 		[(parseTree statements size = 2
+ 		  and: [parseTree statements first isSend
+ 		  and: [parseTree statements first selector == #flag:]]) ifFalse:
+ 			[^false]].
+ 	parseTree statements last expression nodesDo:
+ 		[ :n | n isReturn ifTrue: [^false]].
- 	(parseTree statements size = 1
- 	 and: [parseTree statements last isReturn]) ifFalse: [ ^false ].
- 	parseTree statements last expression nodesDo: [ :n | n isReturn ifTrue: [ ^false ]].
  	^#(sqInt usqInt sqLong usqLong #'sqInt *' #'CogMethod *') includes: returnType!

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



More information about the Vm-dev mailing list