Merge pull request #844 from tesonep/adding-option-for-pin-behaviour

Adding option for pin behaviour

Author: tesonep

include/pharovm/parameters/parameters.h

@@ -130,6 +130,12 @@ typedef struct VMParameters_
 	// FIXME: Passing this environment vector seems hackish. getenv should be used instead.
 	const char** environmentVector;
 
+	// When pinning young objects, the objects are clonned into the old space.
+	// Trying to allocate it in a segment with already pinned objects
+	// Does the clonning process avoid this search and allocate the clonned object anywhere?
+	// DEFAULT: false
+	bool avoidSearchingSegmentsWithPinnedObjects;
+
 	VMParameterVector vmParameters;
 	VMParameterVector imageParameters;
 } VMParameters;

smalltalksrc/VMMaker/SpurMemoryManager.class.st

@@ -618,7 +618,8 @@ Class {
 		'permSpaceFreeStart',
 		'fromOldSpaceRememberedSet',
 		'fromPermToOldSpaceRememberedSet',
-		'fromPermToNewSpaceRememberedSet'
+		'fromPermToNewSpaceRememberedSet',
+		'avoidSearchingSegmentsWithPinnedObjects'
 	],
 	#classVars : [
 		'BitsPerByte',
@@ -2403,14 +2404,20 @@ SpurMemoryManager >> allocateSlots: numSlots format: formatField classIndex: cla
 
 { #category : 'allocation' }
 SpurMemoryManager >> allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex [
-	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  Try and
-	 allocate in a segment that already includes pinned objects.  The header of the
-	 result will have been filled-in but not the contents."
+	"Answer the oop of a chunk of space in oldSpace with numSlots slots. 
+	Try and allocate in a segment that already includes pinned objects.
+	If the option #avoidSearchingSegmentsWithPinnedObjects is true, we don't do the search.
+	For some users this can have a good impact when having many pinned objects used in FFI calls.
+	The header of the result will have been filled-in but not the contents."
 	<var: #totalBytes type: #usqInt>
 	<inline: false>
 	| chunk newOop |
-	chunk := self allocateOldSpaceChunkOfBytes: totalBytes
-				   suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
+
+	chunk := avoidSearchingSegmentsWithPinnedObjects 
+		ifTrue: [ nil ]
+		ifFalse: [self allocateOldSpaceChunkOfBytes: totalBytes
+				   suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned]].
+			
 	chunk ifNil:
 		[chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
 		 chunk ifNil: [^nil].
@@ -5947,6 +5954,14 @@ SpurMemoryManager >> gcStartUsecs [
 	^gcStartUsecs
 ]
 
+{ #category : 'accessing' }
+SpurMemoryManager >> getAvoidSearchingSegmentsWithPinnedObjects [
+
+	<api>
+
+	^ avoidSearchingSegmentsWithPinnedObjects
+]
+
 { #category : 'accessing' }
 SpurMemoryManager >> getFromOldSpaceRememberedSet [
 
@@ -6637,6 +6652,8 @@ SpurMemoryManager >> initialize [
 	maxOldSpaceSize := self class initializationOptions
 							ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]
 							ifNil: [0].
+	
+	avoidSearchingSegmentsWithPinnedObjects := false.
 
 ]
 
@@ -11692,6 +11709,15 @@ SpurMemoryManager >> set: objOop classIndexTo: classIndex formatTo: format [
 	self subclassResponsibility
 ]
 
+{ #category : 'accessing' }
+SpurMemoryManager >> setAvoidSearchingSegmentsWithPinnedObjects: aValue [
+
+	<api>
+	<var: #aValue type: #sqInt>
+
+	avoidSearchingSegmentsWithPinnedObjects := aValue
+]
+
 { #category : 'spur bootstrap' }
 SpurMemoryManager >> setCheckForLeaks: integerFlags [
 	" 0 = do nothing.

smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st

@@ -1697,7 +1697,8 @@ StackInterpreterPrimitives >> primitiveGetVMParameter: index [
 			[84] ->  [^objectMemory integerObjectOf: 
 								objectMemory getFromPermToNewSpaceRememberedSet rememberedSetSize].
 			[85] ->  [^objectMemory integerObjectOf: 
-								objectMemory getFromPermToNewSpaceRememberedSet rememberedSetLimit]}
+								objectMemory getFromPermToNewSpaceRememberedSet rememberedSetLimit].
+			[86] ->  [^ objectMemory getAvoidSearchingSegmentsWithPinnedObjects ifTrue: [ objectMemory trueObject ] ifFalse: [objectMemory falseObject]]}
 		otherwise: [^nil]
 ]
 
@@ -2707,15 +2708,26 @@ StackInterpreterPrimitives >> primitiveSetVMParameter: index arg: argOop [
 	| arg result |
 
 	"argOop read & checks; in most cases this is an integer parameter.  In some it is either an integer or a Float"
-	(index = 17 or: [index = 55 or: [index = 68]])
-		ifTrue:
-			[((objectMemory isFloatInstance: argOop)
+	index 
+		caseOf: {  
+			[17] -> [((objectMemory isFloatInstance: argOop)
 			  or: [objectMemory isIntegerObject: argOop]) ifFalse:
-				[^self primitiveFailFor: PrimErrBadArgument]]
-		ifFalse:
-			[(objectMemory isIntegerObject: argOop) ifFalse:
+				[^self primitiveFailFor: PrimErrBadArgument]].
+			[55] -> [((objectMemory isFloatInstance: argOop)
+			  or: [objectMemory isIntegerObject: argOop]) ifFalse:
+				[^self primitiveFailFor: PrimErrBadArgument]].
+			[68] -> [((objectMemory isFloatInstance: argOop)
+			  or: [objectMemory isIntegerObject: argOop]) ifFalse:
+				[^self primitiveFailFor: PrimErrBadArgument]].
+			[86] -> [ 
+			(objectMemory isBooleanObject: argOop) ifFalse:
+				[^self primitiveFailFor: PrimErrBadArgument].
+			 arg := objectMemory booleanValueOf: argOop 
+			 ]}
+		otherwise: [ 
+			(objectMemory isIntegerObject: argOop) ifFalse:
 				[^self primitiveFailFor: PrimErrBadArgument].
-			 arg := objectMemory integerValueOf: argOop].
+			 arg := objectMemory integerValueOf: argOop ].
 
 	"assume failure, then set success for handled indices"
 	self primitiveFailFor: PrimErrBadArgument.
@@ -2792,7 +2804,14 @@ StackInterpreterPrimitives >> primitiveSetVMParameter: index arg: argOop [
 		[79] -> [ (arg between: 0 and: 65535) ifTrue:
 					[result := objectMemory integerObjectOf: self getImageVersion.
 					 self setImageVersion: arg.
-					 self initPrimCall] ] }
+					 self initPrimCall] ].
+		[86] -> [ 
+			result := objectMemory getAvoidSearchingSegmentsWithPinnedObjects 
+				ifTrue: [objectMemory trueObject] 
+				ifFalse: [objectMemory falseObject].
+				
+			objectMemory setAvoidSearchingSegmentsWithPinnedObjects: arg.
+			self initPrimCall ]}
 		otherwise: [].
 
 	self successful
@@ -3984,7 +4003,7 @@ StackInterpreterPrimitives >> primitiveVMParameter [
 	Otherwise the *real* list is in the code: `StackInterpreterPrimitives>>#primitiveGetVMParameter:`"
 
 	| paramsArraySize index |
-	paramsArraySize := 85.
+	paramsArraySize := 86.
 	argumentCount = 0 ifTrue: [^self primitiveAllVMParameters: paramsArraySize].
 	argumentCount > 2 ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs].
 

smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st

@@ -5459,10 +5459,10 @@ VMPrimitiveTest >> testPrimitiveVMParameterReturnsArrayOfOops [
 	interpreter preemptionYields: true.
 	interpreter primitiveVMParameter.
 
-	"Check this is an array that has 85 OOP entries"
+	"Check this is an array that has 86 OOP entries"
 	self assert: (memory isArray: interpreter stackTop).
 	slots := memory numSlotsOf: interpreter stackTop.
-	self assert: slots equals: 85.
+	self assert: slots equals: 86.
 
 	0 to: slots - 1 do: [ :i |
 		memory okayOop: (memory fetchPointer: i ofObject: interpreter stackTop) ]

src/client.c

@@ -9,6 +9,7 @@ extern sqInt setMaxOldSpaceSize(usqInt limit);
 extern void setDesiredCogCodeSize(sqInt anInteger);
 extern sqInt setDesiredEdenBytes(usqLong bytes);
 extern void setMinimalPermSpaceSize(sqInt min);
+extern void setAvoidSearchingSegmentsWithPinnedObjects(sqInt aValue);
 
 #if defined(__GNUC__) && ( defined(i386) || defined(__i386) || defined(__i386__)  \
 			|| defined(i486) || defined(__i486) || defined (__i486__) \
@@ -70,6 +71,8 @@ EXPORT(int) vm_init(VMParameters* parameters)
 	setDesiredEdenBytes(parameters->edenSize);
 	setMinimalPermSpaceSize(parameters->minPermSpaceSize);
 
+	setAvoidSearchingSegmentsWithPinnedObjects(parameters->avoidSearchingSegmentsWithPinnedObjects);
+
 	if(parameters->maxCodeSize > 0) {
 #ifndef COGVM
 		logError("StackVM does not accept maxCodeSize");

src/parameters/parameters.c

@@ -76,6 +76,7 @@ static VMErrorCode processMaxCodeSpaceSizeOption(const char *argument, VMParamet
 static VMErrorCode processEdenSizeOption(const char *argument, VMParameters * params);
 static VMErrorCode processWorkerOption(const char *argument, VMParameters * params);
 static VMErrorCode processMinPermSpaceSizeOption(const char *argument, VMParameters * params);
+static VMErrorCode processAvoidSearchingSegmentsWithPinnedObjects(const char *argument, VMParameters * params);
 
 static const VMParameterSpec vm_parameters_spec[] =
 {
@@ -94,6 +95,8 @@ static const VMParameterSpec vm_parameters_spec[] =
   {.name = "codeSize", .hasArgument = true, .function = processMaxCodeSpaceSizeOption},
   {.name = "edenSize", .hasArgument = true, .function = processEdenSizeOption},
   {.name = "minPermSpaceSize", .hasArgument = true, .function = processMinPermSpaceSizeOption},
+
+  {.name = "avoidSearchingSegmentsWithPinnedObjects", .hasArgument = false, .function = processAvoidSearchingSegmentsWithPinnedObjects},
 #ifdef __APPLE__
   // This parameter is passed by the XCode debugger.
   {.name = "NSDocumentRevisionsDebugMode", .hasArgument = false, .function = NULL},
@@ -437,6 +440,12 @@ vm_printUsageTo(FILE *out)
 "  --minPermSpaceSize=<size>[mk]        Sets the size of eden\n"
 "                                       It is possible to use k(kB), M(MB) and G(GB).\n"
 "\n"
+"  --avoidSearchingSegmentsWithPinnedObjects\n"
+"                                       When pinning young objects, the objects are clonned into the old space.\n"
+"                                       It tries to allocate the object in a segment with already pinned objects.\n"
+"	                                    Avoid the clonning process avoid this search and allocate the clonned object anywhere?\n"
+"\n"
+"\n"
 "Notes:\n"
 "\n"
 "  <imageName> defaults to `Pharo.image'.\n"
@@ -573,6 +582,13 @@ processPrintVersionOption(const char* argument, VMParameters * params)
 	return VM_ERROR_EXIT_WITH_SUCCESS;
 }
 
+static VMErrorCode
+processAvoidSearchingSegmentsWithPinnedObjects(const char* argument, VMParameters * params)
+{
+	params->avoidSearchingSegmentsWithPinnedObjects = true;
+	return VM_SUCCESS;
+}
+
 static VMErrorCode
 processVMOptions(VMParameters* parameters)
 {
@@ -723,6 +739,7 @@ vm_parameters_init(VMParameters *parameters){
 	parameters->isDefaultImage = false;
 	parameters->defaultImageFound = false;
 	parameters->isInteractiveSession = false;
+	parameters->avoidSearchingSegmentsWithPinnedObjects = false;
 
 	parameters->isWorker = false;