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

commits at source.squeak.org commits at source.squeak.org
Thu Jan 7 18:43:58 UTC 2021


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

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

Name: VMMaker.oscog-eem.2926
Author: eem
Time: 7 January 2021, 10:43:47.351813 am
UUID: 4f3cf7c5-7b78-41b7-8113-8e45970a4daf
Ancestors: VMMaker.oscog-eem.2925

Include some more include files in the Cogits that are included by sq.h.
Rename clone: to cloneObject: to avoid the clash with Unix pthread.h/sched.h's definition of clone, a variant of fork.

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

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| backEnd |
  	backEnd := CogCompilerClass basicNew.
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  			'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  			'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	"N.B. We *do not* include sq.h; it pulls in conflicting definitions now that sqVirtualMachine.h
  	 declares cointerp's functions, and declares some of them inaccurately for histrical reasons.
  	 We pull in CoInterpreter's api via cointerp.h which is accurate."
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
+ 		addHeaderFile:'<stdio.h>';
+ 		addHeaderFile:'<stdlib.h>';
+ 		addHeaderFile:'<string.h>';
  		addHeaderFile:'"sqConfig.h"';
  		addHeaderFile:'"sqMemoryAccess.h"';
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetFP
  			declareC: 'usqIntptr_t (*ceGetFP)(void)';
  		var: #ceGetSP
  			declareC: 'usqIntptr_t (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceInvokeInterpret
  			declareC: 'void (*ceInvokeInterpret)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *';
  		var: 'enumeratingCogMethod' type: #'CogMethod *'.
  	
  	aCCodeGenerator
  		var: #ceTryLockVMOwner
  		declareC: '#if COGMTVM\usqIntptr_t (*ceTryLockVMOwner)(usqIntptr_t)\#endif'.
  
  	backEnd numICacheFlushOpcodes > 0 ifTrue:
  		[aCCodeGenerator
  			var: #ceFlushICache
  				declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'].
  	aCCodeGenerator
  		var: #ceFlushDCache
  			declareC: '#if DUAL_MAPPED_CODE_ZONE\static void (*ceFlushDCache)(usqIntptr_t from, usqIntptr_t to)\#endif';
  		var: #codeToDataDelta
  			declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif'.
  
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss
  					entry noCheckEntry selfSendEntry dynSuperEntry
  					fullBlockNoContextSwitchEntry fullBlockEntry
  					picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #cPICPrototype type: #'CogMethod *';
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *';
  		declareVar: #methodZoneBase type: #usqInt.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'.
  	BytecodeSetHasDirectedSuperSend ifTrue:
  		[aCCodeGenerator
  			var: #directedSuperSendTrampolines
  				declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  			var: #directedSuperBindingSendTrampolines
  				declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]'].
  	NewspeakVM ifTrue:
  		[aCCodeGenerator
  			var: #selfSendTrampolines
  				declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  			var: #dynamicSuperSendTrampolines
  				declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  			var: #implicitReceiverSendTrampolines
  				declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  			var: #outerSendTrampolines
  				declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'].
  	aCCodeGenerator
  		addConstantForBinding: self bindingForNumTrampolines;
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #minValidCallAddress type: #'usqIntptr_t'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltalk generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'.
  	self declareFlagVarsAsByteIn: aCCodeGenerator!

Item was changed:
  ----- Method: Cogit>>handleCompareAndSwapSimulationTrap: (in category 'simulation only') -----
  handleCompareAndSwapSimulationTrap: aCompareAndSwapSimulationTrap
+ 	| variableValue |
- 	| variableValue accessor |
  	variableValue := (simulatedVariableGetters
  						at: aCompareAndSwapSimulationTrap address
  						ifAbsent: [self errorProcessingSimulationTrap: aCompareAndSwapSimulationTrap
  									in: simulatedVariableGetters])
  							value asInteger.
+ 	processor setFlagsForCompareAndSwap: variableValue = aCompareAndSwapSimulationTrap expectedValue.
  	variableValue = aCompareAndSwapSimulationTrap expectedValue ifTrue:
  		[(simulatedVariableSetters
  			at: aCompareAndSwapSimulationTrap address
  			ifAbsent: [self errorProcessingSimulationTrap: aCompareAndSwapSimulationTrap
  						in: simulatedVariableSetters]) value: aCompareAndSwapSimulationTrap storedValue].
- 	processor setFlagsForCompareAndSwap: variableValue = aCompareAndSwapSimulationTrap expectedValue.
- 	accessor := aCompareAndSwapSimulationTrap registerAccessor.
  	processor
+ 		perform: aCompareAndSwapSimulationTrap registerAccessor
- 		perform: accessor
  		with: (processor convertIntegerToInternal: variableValue).
  	processor pc: aCompareAndSwapSimulationTrap nextpc.
  	aCompareAndSwapSimulationTrap resume: processor!

Item was changed:
  ----- Method: CroquetPlugin>>primitiveOrthoNormInverseMatrix (in category 'transforms') -----
  primitiveOrthoNormInverseMatrix
  	| srcOop dstOop src dst x y z rx ry rz |
  	<export: true>
  	<var: #src type: #'float *'>
  	<var: #dst type: #'float *'>
  	<var: #x type: #double>
  	<var: #y type: #double>
  	<var: #z type: #double>
  	<var: #rx type: #double>
  	<var: #ry type: #double>
  	<var: #rz type: #double>
  
  	interpreterProxy methodArgumentCount = 0
  		ifFalse:[^interpreterProxy primitiveFail].
  	srcOop := interpreterProxy stackObjectValue: 0.
  	interpreterProxy failed ifTrue:[^nil].
  	((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16])
  		ifFalse:[^interpreterProxy primitiveFail].
+ 	dstOop := interpreterProxy cloneObject: srcOop.
- 	dstOop := interpreterProxy clone: srcOop.
  	"reload srcOop in case of GC"
  	srcOop := interpreterProxy stackObjectValue: 0.
  	src := interpreterProxy firstIndexableField: srcOop.
  	dst := interpreterProxy firstIndexableField: dstOop.
  
  	"Transpose upper 3x3 matrix"
  	"dst at: 0 put: (src at: 0)."	dst at: 1 put: (src at: 4). 	dst at: 2 put: (src at: 8). 
  	dst at: 4 put: (src at: 1). 	"dst at: 5 put: (src at: 5)."	dst at: 6 put: (src at: 9). 
  	dst at: 8 put: (src at: 2). 	dst at: 9 put: (src at: 6). 	"dst at: 10 put: (src at: 10)."
  
  	"Compute inverse translation vector"
  	x := src at: 3.
  	y := src at: 7.
  	z := src at: 11.
  	rx := (x * (dst at: 0)) + (y * (dst at: 1)) + (z * (dst at: 2)).
  	ry := (x * (dst at: 4)) + (y * (dst at: 5)) + (z * (dst at: 6)).
  	rz := (x * (dst at: 8)) + (y * (dst at: 9)) + (z * (dst at: 10)).
  
  	dst at: 3 put: (self cCoerce: 0.0-rx to: #float).
  	dst at: 7 put: (self cCoerce: 0.0-ry to: #float).
  	dst at: 11 put: (self cCoerce: 0.0-rz to: #float).
  
  	interpreterProxy pop: 1 thenPush: dstOop!

Item was changed:
  ----- Method: CroquetPlugin>>primitiveTransformDirection (in category 'transforms') -----
  primitiveTransformDirection
  	| x y z rx ry rz matrix vertex v3Oop |
  	<export: true>
  	<var: #vertex declareC:'float *vertex'>
  	<var: #matrix declareC:'float *matrix'>
  	<var: #x declareC:'double x'>
  	<var: #y declareC:'double y'>
  	<var: #z declareC:'double z'>
  	<var: #rx declareC:'double rx'>
  	<var: #ry declareC:'double ry'>
  	<var: #rz declareC:'double rz'>
  
  	interpreterProxy methodArgumentCount = 1
  		ifFalse:[^interpreterProxy primitiveFail].
  	v3Oop := interpreterProxy stackObjectValue: 0.
  	interpreterProxy failed ifTrue:[^nil].
  	((interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3])
  		ifFalse:[^interpreterProxy primitiveFail].
  	vertex := interpreterProxy firstIndexableField: v3Oop.
  	matrix := self stackMatrix: 1.
  	(matrix == nil) ifTrue:[^interpreterProxy primitiveFail].
  
  	x := vertex at: 0.
  	y := vertex at: 1.
  	z := vertex at: 2.
  
  	rx := (x * (matrix at: 0)) + (y * (matrix at: 1)) + (z * (matrix at: 2)).
  	ry := (x * (matrix at: 4)) + (y * (matrix at: 5)) + (z * (matrix at: 6)).
  	rz := (x * (matrix at: 8)) + (y * (matrix at: 9)) + (z * (matrix at: 10)).
  
+ 	v3Oop := interpreterProxy cloneObject: v3Oop.
- 	v3Oop := interpreterProxy clone: v3Oop.
  	vertex := interpreterProxy firstIndexableField: v3Oop.
  
  	vertex at: 0 put: (self cCoerce: rx to: 'float').
  	vertex at: 1 put: (self cCoerce: ry to:'float').
  	vertex at: 2 put: (self cCoerce: rz to: 'float').
  
  	interpreterProxy pop: 2.
  	^interpreterProxy push: v3Oop.
  !

Item was changed:
  ----- Method: CroquetPlugin>>primitiveTransformVector3 (in category 'transforms') -----
  primitiveTransformVector3
  	| x y z rx ry rz rw matrix vertex v3Oop |
  	<export: true>
  	<var: #vertex declareC:'float *vertex'>
  	<var: #matrix declareC:'float *matrix'>
  	<var: #x declareC:'double x'>
  	<var: #y declareC:'double y'>
  	<var: #z declareC:'double z'>
  	<var: #rx declareC:'double rx'>
  	<var: #ry declareC:'double ry'>
  	<var: #rz declareC:'double rz'>
  	<var: #rw declareC:'double rw'>
  
  	interpreterProxy methodArgumentCount = 1
  		ifFalse:[^interpreterProxy primitiveFail].
  	v3Oop := interpreterProxy stackObjectValue: 0.
  	interpreterProxy failed ifTrue:[^nil].
  	((interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3])
  		ifFalse:[^interpreterProxy primitiveFail].
  	vertex := interpreterProxy firstIndexableField: v3Oop.
  	matrix := self stackMatrix: 1.
  	(matrix == nil) ifTrue:[^interpreterProxy primitiveFail].
  
  	x := vertex at: 0.
  	y := vertex at: 1.
  	z := vertex at: 2.
  
  	rx := (x * (matrix at: 0)) + (y * (matrix at: 1)) + (z * (matrix at: 2)) + (matrix at: 3).
  	ry := (x * (matrix at: 4)) + (y * (matrix at: 5)) + (z * (matrix at: 6)) + (matrix at: 7).
  	rz := (x * (matrix at: 8)) + (y * (matrix at: 9)) + (z * (matrix at: 10)) + (matrix at: 11).
  	rw := (x * (matrix at: 12)) + (y * (matrix at: 13)) + (z * (matrix at: 14)) + (matrix at: 15).
  
+ 	v3Oop := interpreterProxy cloneObject: v3Oop.
- 	v3Oop := interpreterProxy clone: v3Oop.
  	vertex := interpreterProxy firstIndexableField: v3Oop.
  
  	rw = 1.0 ifTrue:[
  		vertex at: 0 put: (self cCoerce: rx to: 'float').
  		vertex at: 1 put: (self cCoerce: ry to:'float').
  		vertex at: 2 put: (self cCoerce: rz to: 'float').
  	] ifFalse:[
  		rw = 0.0 
  			ifTrue:[rw := 0.0]
  			ifFalse:[rw := 1.0 / rw].
  		vertex at: 0 put: (self cCoerce: rx*rw to:'float').
  		vertex at: 1 put: (self cCoerce: ry*rw to:'float').
  		vertex at: 2 put: (self cCoerce: rz*rw to: 'float').
  	].
  	interpreterProxy pop: 2.
  	^interpreterProxy push: v3Oop.
  !

Item was changed:
  ----- Method: CroquetPlugin>>primitiveTransposeMatrix (in category 'transforms') -----
  primitiveTransposeMatrix
  	| srcOop dstOop src dst |
  	<export: true>
  	<var: #src declareC:'float *src'>
  	<var: #dst declareC:'float *dst'>
  
  	interpreterProxy methodArgumentCount = 0
  		ifFalse:[^interpreterProxy primitiveFail].
  	srcOop := interpreterProxy stackObjectValue: 0.
  	interpreterProxy failed ifTrue:[^nil].
  	((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16])
  		ifFalse:[^interpreterProxy primitiveFail].
+ 	dstOop := interpreterProxy cloneObject: srcOop.
- 	dstOop := interpreterProxy clone: srcOop.
  	"reload srcOop in case of GC"
  	srcOop := interpreterProxy stackObjectValue: 0.
  	src := interpreterProxy firstIndexableField: srcOop.
  	dst := interpreterProxy firstIndexableField: dstOop.
  
  	"dst at: 0 put: (src at: 0)."
  	dst at: 1 put: (src at: 4). 
  	dst at: 2 put: (src at: 8). 
  	dst at: 3 put: (src at: 12).
  
  	dst at: 4 put: (src at: 1). 
  	"dst at: 5 put: (src at: 5)."
  	dst at: 6 put: (src at: 9). 
  	dst at: 7 put: (src at: 13).
  
  	dst at: 8 put: (src at: 2). 
  	dst at: 9 put: (src at: 6). 
  	"dst at: 10 put: (src at: 10)."
  	dst at: 11 put: (src at: 14).
  
  	dst at: 12 put: (src at: 3). 
  	dst at: 13 put: (src at: 7). 
  	dst at: 14 put: (src at: 11). 
  	"dst at: 15 put: (src at: 15)."
  
  	interpreterProxy pop: 1.
  	^interpreterProxy push: dstOop.
  !

Item was changed:
  ----- Method: Interpreter>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver."
  
  	| newCopy |
+ 	newCopy := self cloneObject: self stackTop.
- 	newCopy := self clone: self stackTop.
  	newCopy = 0 ifTrue: "not enough memory most likely"
  		[^self primitiveFail].
  	self pop: argumentCount + 1 thenPush: newCopy!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver."
  
  	| rcvr newCopy |
  	rcvr := self stackTop.
  	(objectMemory isImmediate: rcvr)
  		ifTrue:
  			[newCopy := rcvr]
  		ifFalse:
  			[(argumentCount = 0
  			  or: [(objectMemory isForwarded: rcvr) not])
+ 				ifTrue: [newCopy := objectMemory cloneObject: rcvr]
- 				ifTrue: [newCopy := objectMemory clone: rcvr]
  				ifFalse: [newCopy := 0].
  			 newCopy = 0 ifTrue: "not enough memory most likely"
  				[^self primitiveFail]].
  	self pop: argumentCount + 1 thenPush: newCopy!

Item was removed:
- ----- Method: InterpreterProxy>>clone: (in category 'instance creation') -----
- clone: oop
- 	^oop shallowCopy!

Item was added:
+ ----- Method: InterpreterProxy>>cloneObject: (in category 'instance creation') -----
+ cloneObject: oop
+ 	^oop shallowCopy!

Item was removed:
- ----- Method: NewObjectMemory>>clone: (in category 'allocation') -----
- clone: obj
- 	"Return a shallow copy of the given object. May cause GC.
- 	 Assume: Oop is a real object, not a small integer.
- 	 Override to assert it's not a married context and maybe fix cloned methods."
- 	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
- 	<inline: false>
- 	<var: #lastFrom type: #usqInt>
- 	<var: #fromIndex type: #usqInt>
- 	self assert: ((self isContext: obj) not
- 				or: [(coInterpreter isMarriedOrWidowedContext: obj) not]). 
- 
- 	self assert: (self isNonIntegerObject: obj).
- 	extraHdrBytes := self extraHeaderBytes: obj.
- 	bytes := self sizeBitsOf: obj.
- 	bytes := bytes + extraHdrBytes.
- 
- 	"allocate space for the copy, remapping obj in case of a GC"
- 	self pushRemappableOop: obj.
- 	"check it is safe to allocate this much memory. Return 0 if not"
- 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
- 	newChunk := self allocateChunk: bytes.
- 	remappedOop := self popRemappableOop.
- 
- 	"copy old to new including all header words"
- 	toIndex := newChunk - self wordSize.  "loop below uses pre-increment"
- 	fromIndex := (remappedOop - extraHdrBytes) - self wordSize.
- 	lastFrom := fromIndex + bytes.
- 	[fromIndex < lastFrom] whileTrue:
- 		[self longAt: (toIndex := toIndex + self wordSize)
- 			put: (self longAt: (fromIndex := fromIndex + self wordSize))].
- 	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
- 
- 	"fix base header: compute new hash and clear Mark and Root bits"
- 	hash := self newObjectHash.
- 	header := (self longAt: newOop) bitAnd: 16r1FFFF.
- 	"use old ccIndex, format, size, and header-type fields"
- 	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
- 	self longAt: newOop put: header.
- 	(self isCompiledMethodHeader: header) ifTrue:
- 		[coInterpreter maybeFixClonedCompiledMethod: newOop].
- 	^newOop
- !

Item was added:
+ ----- Method: NewObjectMemory>>cloneObject: (in category 'allocation') -----
+ cloneObject: obj
+ 	"Return a shallow copy of the given object. May cause GC.
+ 	 Assume: Oop is a real object, not a small integer.
+ 	 Override to assert it's not a married context and maybe fix cloned methods."
+ 	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
+ 	<inline: false>
+ 	<var: #lastFrom type: #usqInt>
+ 	<var: #fromIndex type: #usqInt>
+ 	self assert: ((self isContext: obj) not
+ 				or: [(coInterpreter isMarriedOrWidowedContext: obj) not]). 
+ 
+ 	self assert: (self isNonIntegerObject: obj).
+ 	extraHdrBytes := self extraHeaderBytes: obj.
+ 	bytes := self sizeBitsOf: obj.
+ 	bytes := bytes + extraHdrBytes.
+ 
+ 	"allocate space for the copy, remapping obj in case of a GC"
+ 	self pushRemappableOop: obj.
+ 	"check it is safe to allocate this much memory. Return 0 if not"
+ 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
+ 	newChunk := self allocateChunk: bytes.
+ 	remappedOop := self popRemappableOop.
+ 
+ 	"copy old to new including all header words"
+ 	toIndex := newChunk - self wordSize.  "loop below uses pre-increment"
+ 	fromIndex := (remappedOop - extraHdrBytes) - self wordSize.
+ 	lastFrom := fromIndex + bytes.
+ 	[fromIndex < lastFrom] whileTrue:
+ 		[self longAt: (toIndex := toIndex + self wordSize)
+ 			put: (self longAt: (fromIndex := fromIndex + self wordSize))].
+ 	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
+ 
+ 	"fix base header: compute new hash and clear Mark and Root bits"
+ 	hash := self newObjectHash.
+ 	header := (self longAt: newOop) bitAnd: 16r1FFFF.
+ 	"use old ccIndex, format, size, and header-type fields"
+ 	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
+ 	self longAt: newOop put: header.
+ 	(self isCompiledMethodHeader: header) ifTrue:
+ 		[coInterpreter maybeFixClonedCompiledMethod: newOop].
+ 	^newOop
+ !

Item was removed:
- ----- Method: ObjectMemory>>clone: (in category 'allocation') -----
- clone: obj
- 	"Return a shallow copy of the given object. May cause GC"
- 	"Assume: Oop is a real object, not a small integer."
- 
- 	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
- 	<inline: false>
- 	<var: #lastFrom type: #usqInt>
- 	<var: #fromIndex type: #usqInt>
- 	self assert: (self isNonIntegerObject: obj).
- 	extraHdrBytes := self extraHeaderBytes: obj.
- 	bytes := self sizeBitsOf: obj.
- 	bytes := bytes + extraHdrBytes.
- 
- 	"allocate space for the copy, remapping obj in case of a GC"
- 	self pushRemappableOop: obj.
- 	"check it is safe to allocate this much memory. Return 0 if not"
- 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
- 	newChunk := self allocateChunk: bytes.
- 	remappedOop := self popRemappableOop.
- 
- 	"copy old to new including all header words"
- 	toIndex := newChunk - self wordSize.  "loop below uses pre-increment"
- 	fromIndex := (remappedOop - extraHdrBytes) - self wordSize.
- 	lastFrom := fromIndex + bytes.
- 	[fromIndex < lastFrom] whileTrue:
- 		[self longAt: (toIndex := toIndex + self wordSize) put: (self longAt: (fromIndex := fromIndex + self wordSize))].
- 	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
- 
- 	"fix base header: compute new hash and clear Mark and Root bits"
- 	hash := self newObjectHash.
- 	header := (self longAt: newOop) bitAnd: 16r1FFFF.
- 	"use old ccIndex, format, size, and header-type fields"
- 	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
- 	self longAt: newOop put: header.
- 	^newOop
- !

Item was added:
+ ----- Method: ObjectMemory>>cloneObject: (in category 'allocation') -----
+ cloneObject: obj
+ 	"Return a shallow copy of the given object. May cause GC"
+ 	"Assume: Oop is a real object, not a small integer."
+ 
+ 	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
+ 	<inline: false>
+ 	<var: #lastFrom type: #usqInt>
+ 	<var: #fromIndex type: #usqInt>
+ 	self assert: (self isNonIntegerObject: obj).
+ 	extraHdrBytes := self extraHeaderBytes: obj.
+ 	bytes := self sizeBitsOf: obj.
+ 	bytes := bytes + extraHdrBytes.
+ 
+ 	"allocate space for the copy, remapping obj in case of a GC"
+ 	self pushRemappableOop: obj.
+ 	"check it is safe to allocate this much memory. Return 0 if not"
+ 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
+ 	newChunk := self allocateChunk: bytes.
+ 	remappedOop := self popRemappableOop.
+ 
+ 	"copy old to new including all header words"
+ 	toIndex := newChunk - self wordSize.  "loop below uses pre-increment"
+ 	fromIndex := (remappedOop - extraHdrBytes) - self wordSize.
+ 	lastFrom := fromIndex + bytes.
+ 	[fromIndex < lastFrom] whileTrue:
+ 		[self longAt: (toIndex := toIndex + self wordSize) put: (self longAt: (fromIndex := fromIndex + self wordSize))].
+ 	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
+ 
+ 	"fix base header: compute new hash and clear Mark and Root bits"
+ 	hash := self newObjectHash.
+ 	header := (self longAt: newOop) bitAnd: 16r1FFFF.
+ 	"use old ccIndex, format, size, and header-type fields"
+ 	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
+ 	self longAt: newOop put: header.
+ 	^newOop
+ !

Item was removed:
- ----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
- clone: objOop
- 	| numSlots fmt newObj |
- 	numSlots := self numSlotsOf: objOop.
- 	fmt := self formatOf: objOop.
- 	numSlots > self maxSlotsForNewSpaceAlloc
- 		ifTrue:
- 			[newObj := self allocateSlotsInOldSpace: numSlots
- 							format: fmt
- 							classIndex: (self classIndexOf: objOop)]
- 		ifFalse:
- 			[newObj := self allocateSlots: numSlots
- 							format: fmt
- 							classIndex: (self classIndexOf: objOop)].
- 	newObj ifNil:
- 		[^0].
- 	(self isPointersFormat: fmt)
- 		ifTrue:
- 			[| hasYoung |
- 			 hasYoung := false.
- 			 0 to: numSlots - 1 do:
- 				[:i| | oop |
- 				oop := self fetchPointer: i ofObject: objOop.
- 				(self isNonImmediate: oop) ifTrue:
- 					[(self isForwarded: oop) ifTrue:
- 						[oop := self followForwarded: oop].
- 					((self isNonImmediate: oop)
- 					 and: [self isYoungObject: oop]) ifTrue:
- 						[hasYoung := true]].
- 				self storePointerUnchecked: i
- 					ofObject: newObj
- 					withValue: oop].
- 			(hasYoung
- 			 and: [(self isYoungObject: newObj) not]) ifTrue:
- 				[scavenger remember: newObj]]
- 		ifFalse:
- 			[0 to: numSlots - 1 do:
- 				[:i|
- 				self storePointerUnchecked: i
- 					ofObject: newObj
- 					withValue: (self fetchPointer: i ofObject: objOop)].
- 			 fmt >= self firstCompiledMethodFormat ifTrue:
- 				[coInterpreter maybeFixClonedCompiledMethod: newObj.
- 				 ((self isOldObject: newObj)
- 				  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
- 					[scavenger remember: newObj]]].
- 	^newObj!

Item was added:
+ ----- Method: SpurMemoryManager>>cloneObject: (in category 'allocation') -----
+ cloneObject: objOop
+ 	| numSlots fmt newObj |
+ 	numSlots := self numSlotsOf: objOop.
+ 	fmt := self formatOf: objOop.
+ 	numSlots > self maxSlotsForNewSpaceAlloc
+ 		ifTrue:
+ 			[newObj := self allocateSlotsInOldSpace: numSlots
+ 							format: fmt
+ 							classIndex: (self classIndexOf: objOop)]
+ 		ifFalse:
+ 			[newObj := self allocateSlots: numSlots
+ 							format: fmt
+ 							classIndex: (self classIndexOf: objOop)].
+ 	newObj ifNil:
+ 		[^0].
+ 	(self isPointersFormat: fmt)
+ 		ifTrue:
+ 			[| hasYoung |
+ 			 hasYoung := false.
+ 			 0 to: numSlots - 1 do:
+ 				[:i| | oop |
+ 				oop := self fetchPointer: i ofObject: objOop.
+ 				(self isNonImmediate: oop) ifTrue:
+ 					[(self isForwarded: oop) ifTrue:
+ 						[oop := self followForwarded: oop].
+ 					((self isNonImmediate: oop)
+ 					 and: [self isYoungObject: oop]) ifTrue:
+ 						[hasYoung := true]].
+ 				self storePointerUnchecked: i
+ 					ofObject: newObj
+ 					withValue: oop].
+ 			(hasYoung
+ 			 and: [(self isYoungObject: newObj) not]) ifTrue:
+ 				[scavenger remember: newObj]]
+ 		ifFalse:
+ 			[0 to: numSlots - 1 do:
+ 				[:i|
+ 				self storePointerUnchecked: i
+ 					ofObject: newObj
+ 					withValue: (self fetchPointer: i ofObject: objOop)].
+ 			 fmt >= self firstCompiledMethodFormat ifTrue:
+ 				[coInterpreter maybeFixClonedCompiledMethod: newObj.
+ 				 ((self isOldObject: newObj)
+ 				  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
+ 					[scavenger remember: newObj]]].
+ 	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>outOfPlaceBecome:and:copyHashFlag: (in category 'become implementation') -----
  outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag
  	<inline: #never> "in an effort to fix a compiler bug with two-way become post r3427"
  	"Allocate two new objects, n1 & n2.  Copy the contents appropriately. Convert
  	 obj1 and obj2 into forwarding objects pointing to n2 and n1 respectively"
  	| clone1 clone2 |
  	clone1 := (self isContextNonImm: obj1)
  				ifTrue: [coInterpreter cloneContext: obj1]
+ 				ifFalse: [self cloneObject: obj1].
- 				ifFalse: [self clone: obj1].
  	clone2 := (self isContextNonImm: obj2)
  				ifTrue: [coInterpreter cloneContext: obj2]
+ 				ifFalse: [self cloneObject: obj2].
- 				ifFalse: [self clone: obj2].
  	(self isObjImmutable: obj1) ifTrue:
  		[self setIsImmutableOf: clone1 to: true].
  	(self isObjImmutable: obj2) ifTrue:
  		[self setIsImmutableOf: clone2 to: true].
  	copyHashFlag
  		ifTrue:
  			[self setHashBitsOf: clone1 to: (self rawHashBitsOf: obj1).
  			 self setHashBitsOf: clone2 to: (self rawHashBitsOf: obj2)]
  		ifFalse:
  			[self setHashBitsOf: clone1 to: (self rawHashBitsOf: obj2).
  			 self setHashBitsOf: clone2 to: (self rawHashBitsOf: obj1)].
  	self
  		forward: obj1 to: clone2;
  		forward: obj2 to: clone1.
  	((self isYoungObject: obj1) ~= (self isYoungObject: clone2)
  	 or: [(self isYoungObject: obj2) ~= (self isYoungObject: clone1)]) ifTrue:
  		[becomeEffectsFlags := becomeEffectsFlags bitOr: OldBecameNewFlag]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver.
  	 Special-case non-single contexts (because of context-to-stack mapping).
  	 Can't fail for contexts cuz of image context instantiation code (sigh)."
  
  	| rcvr newCopy |
  	rcvr := self stackTop.
  	(objectMemory isImmediate: rcvr)
  		ifTrue:
  			[newCopy := rcvr]
  		ifFalse:
  			[(objectMemory isContextNonImm: rcvr)
  				ifTrue:
  					[newCopy := self cloneContext: rcvr]
  				ifFalse:
  					[(argumentCount = 0
  					  or: [(objectMemory isForwarded: rcvr) not])
+ 						ifTrue: [newCopy := objectMemory cloneObject: rcvr]
- 						ifTrue: [newCopy := objectMemory clone: rcvr]
  						ifFalse: [newCopy := 0]].
  			newCopy = 0 ifTrue:
  				[^self primitiveFailFor: PrimErrNoMemory]].
  	self pop: argumentCount + 1 thenPush: newCopy!



More information about the Vm-dev mailing list