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

commits at source.squeak.org commits at source.squeak.org
Mon Aug 9 20:36:54 UTC 2021


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

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

Name: VMMaker.oscog-eem.3033
Author: eem
Time: 9 August 2021, 1:36:42.474846 pm
UUID: f561c302-005c-4fa1-bff2-8d965409d563
Ancestors: VMMaker.oscog-eem.3032

Cogit/AndreasSystemProfiling: fix major slip in genCheckForProfileTimerTick:; only take a sample if nextProfileTick > 0. primitiveFlushExternalPrimitives. primitiveUnloadModule & primitiveProfileSemaphore can also endure code movement and need to be side-ways called.  Make sure ceActivateFailingPrimitiveMethod: gathers profile samples when profiling.  Nuke ceCheckProfileTick and replace it by ceTakeProfileSample: which interpeets null as attributing to newMethod.

Interpreter: abstract comparing a Smalltalk oop aganst a C string.
Slng: eliminate warnigns of liveRegisters shadowing, and of repeated removals of the memory variable.

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

Item was changed:
  ----- Method: CoInterpreter>>ceActivateFailingPrimitiveMethod: (in category 'enilopmarts') -----
  ceActivateFailingPrimitiveMethod: aPrimitiveMethod
  	"An external call or FFI primitive has failed.  Build the frame and
  	 activate as appropriate.  Enter either the interpreter or machine
  	 code depending on whether aPrimitiveMethod has been or is still
  	 cogged.  Note that we could always interpret but want the efficiency
  	 of executing machine code if it is available."
  	<api>
  	| methodHeader result |
  	self assert: primFailCode ~= 0.
  	self assert: newMethod = aPrimitiveMethod.
  	"If we're on Spur, retry the primitive, if appropriate,
  	 returning if successful after retry."
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[self retryPrimitiveOnFailure.
  		 self successful ifTrue:
+ 			[(profileSemaphore ~= objectMemory nilObject
+ 			  and: [self ioHighResClock >= nextProfileTick]) ifTrue:
+ 				[self ceTakeProfileSample: nil].
+ 			 result := self stackTop.
- 			[result := self stackTop.
  			 self stackTopPut: instructionPointer.
  			 self push: result.
  			 cogit ceEnterCogCodePopReceiverReg]].
  	methodHeader := self rawHeaderOf: aPrimitiveMethod.
  	(self isCogMethodReference: methodHeader)
  		ifTrue: [self activateNewCogMethod: (self cCoerceSimple: methodHeader to: #'CogMethod *') inInterpreter: false]
  		ifFalse: [self activateNewMethod]!

Item was removed:
- ----- Method: CoInterpreter>>ceCheckProfileTick (in category 'cog jit support') -----
- ceCheckProfileTick
- 	"Check if the profile timer has expired and if so take a sample.
- 	 If the primitive has failed sample the profileMethod as nil.
- 	 As a courtesy to compileInterpreterPrimitive: map NULL to nilObj."
- 	<api>
- 	newMethod ifNil: [newMethod := objectMemory nilObject].
- 	self cCode: [] inSmalltalk:
- 		[newMethod = 0 ifTrue: [newMethod := objectMemory nilObject].
- 		 "Get round the assert in checkProfileTick: when just testing."
- 		 nextProfileTick = 0 ifTrue:
- 			[self ifTestProfilingAdvanceNextProfileTick]].
- 	self checkProfileTick: newMethod.
- 	self cCode: [] inSmalltalk:
- 		[self ifTestProfilingAdvanceNextProfileTick]!

Item was changed:
  ----- Method: CoInterpreter>>ceTakeProfileSample: (in category 'cog jit support') -----
+ ceTakeProfileSample: aCogMethodOrNil
- ceTakeProfileSample: aCogMethod
  	"A primitive has succeeded and the nextProfileTick has been reached (all done in machine code).
+ 	 If aCogMethodOrNil is not nil then it is the cog method containing the primitive call.
+ 	 If aCogMethodOrNil is nil then this has been called from primReturnEnterCogCode and newMethod
  	 Now take a sample. c.f. checkProfileTick:"
  	<api>
+ 	<var: 'aCogMethodOrNil' type: #'CogMethod *'>
+ 	<inline: false> "Slang type inferrence can't deal with self ceTakeProfileSample: nil..."
- 	<var: 'aCogMethod' type: #'CogMethod *'>
  	self cCode: '' inSmalltalk:
+ 		[aCogMethodOrNil isInteger ifTrue:
+ 			[^self ceTakeProfileSample: (aCogMethodOrNil = 0 ifFalse:
+ 											[cogit cCoerceSimple: aCogMethodOrNil to: #'CogMethod *'])]].
- 		[aCogMethod isInteger ifTrue:
- 			[^self ceTakeProfileSample: (cogit cCoerceSimple: aCogMethod to: #'CogMethod *')]].
  	profileProcess := self activeProcess.
+ 	profileMethod := aCogMethodOrNil
+ 						ifNil: [newMethod]
+ 						ifNotNil: [aCogMethodOrNil methodObject].
- 	profileMethod := aCogMethod methodObject.
  	self forceInterruptCheck.
  	self zeroNextProfileTick!

Item was changed:
  ----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'cog jit support') -----
  functionPointerForCompiledMethod: methodObj primitiveIndex: primitiveIndex primitivePropertyFlagsInto: flagsPtr
  	<api>
  	<returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndexprimitivePropertyFlagsInto(sqInt methodObj, sqInt primitiveIndex, sqInt *flagsPtr))(void)'>
+ 	| functionPointer flags |
- 	| functionPointer |
  	<var: #functionPointer declareC: #'void (*functionPointer)(void)'>
  	flagsPtr ifNotNil:
+ 		[flagsPtr at: 0 put: (flags := self primitivePropertyFlags: primitiveIndex)].
- 		[flagsPtr at: 0 put: (self primitivePropertyFlags: primitiveIndex)].
  	functionPointer := self functionPointerFor: primitiveIndex inClass: nil.
  	functionPointer == #primitiveCalloutToFFI ifTrue:
  		[^self functionForPrimitiveCallout].
  	functionPointer == #primitiveExternalCall ifTrue:
  		[| lit |
  		 lit := self attemptToLinkExternalPrimitive: methodObj.
  		 "N.B. We only support the FastCPrimitiveFlag on Spur because Spur
  		  will *not* run a GC to satisfy an allocation in a primitive. The V3
  		  ObjectMemory will and hence the depth of stack needed in a V3
  		  primitive is probably too large to safely execute on a stack page."
  		  objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 			[| metadataFlags shiftedMetadataFlags |
+ 			 metadataFlags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
+ 		 	 (objectMemory isIntegerObject: metadataFlags) ifTrue:
+ 				[shiftedMetadataFlags := ((objectMemory integerValueOf: metadataFlags)
+ 											bitAnd: SpurPrimitiveFlagsMask)
+ 												bitShift: PrimitiveMetadataFlagsShift.
+ 				 shiftedMetadataFlags > 0 ifTrue:
+ 					["Intentionally clear all other flags if there are Spur metadata flags..."
+ 					 flags := shiftedMetadataFlags]]].
+ 		 (self object: (objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit)
+ 				equalsString: #primitiveProfileSemaphore) ifTrue:
+ 			[flags := flags bitOr: PrimCallMayEndureCodeCompaction].
+ 		 profileSemaphore ~= objectMemory nilObject ifTrue:
+ 			[flags := flags bitOr: PrimCallCollectsProfileSamples].
+ 		 flagsPtr at: 0 put: flags.
- 			[| flags shiftedMetadataFlags |
- 			 flags := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
- 		 	 (objectMemory isIntegerObject: flags) ifTrue:
- 				[shiftedMetadataFlags := ((objectMemory integerValueOf: flags) bitAnd: SpurPrimitiveFlagsMask) bitShift: PrimitiveMetadataFlagsShift.
- 				 profileSemaphore ~= objectMemory nilObject ifTrue:
- 					[shiftedMetadataFlags := shiftedMetadataFlags bitOr: PrimCallCollectsProfileSamples].
- 				 shiftedMetadataFlags ~= 0 ifTrue:
- 					[flagsPtr at: 0 put: shiftedMetadataFlags]]].
  		 ^self functionForPrimitiveExternalCall: methodObj].
  	^functionPointer!

Item was changed:
  ----- Method: CoInterpreter>>isCodeCompactingPrimitiveIndex: (in category 'primitive support') -----
  isCodeCompactingPrimitiveIndex: primIndex
  	"If instVarAt:, slotAt: or shallowCopy operate on a Context then they compute a
  	 bytecode pc and hence may provoke a code compaction. Hence primitive invocation
  	 from these primitives must use a static return address (cePrimReturnEnterCogCode:).
  	 Note that the process switch primitives may also provoke a code compaction, which
  	 happens when switching to a process whose top context has a machine code pc but
  	 the method is no longer in the code cache.  However, in this case they are switching
  	 process and don't go through the normal return. So we don't include them here."
  	<inline: true>
+ 	self cCode: [] inSmalltalk: [#primitiveClone. #primitiveInstVarAt. #primitiveSlotAt. #primitiveFlushExternalPrimitives. #primitiveUnloadModule]. "For senders..."
- 	self cCode: [] inSmalltalk: [#primitiveClone. #primitiveInstVarAt. #primitiveSlotAt]. "For senders..."
  	^primIndex = PrimNumberInstVarAt
  	or: [primIndex = PrimNumberShallowCopy
+ 	or: [primIndex = PrimNumberSlotAt
+ 	or: [primIndex = PrimNumberFlushExternalPrimitives
+ 	or: [primIndex = PrimNumberUnoadModule]]]]!
- 	or: [primIndex = PrimNumberSlotAt]]!

Item was changed:
  ----- Method: CoInterpreter>>methodHasPrimitiveInPrimTracePlugin: (in category 'compiled methods') -----
  methodHasPrimitiveInPrimTracePlugin: aMethodObj
  	<inline: #never>
+ 	| lit pluginName ok |
- 	| lit nameLength pluginName |
  	((self isExternalPrimitiveCall: aMethodObj)
  	 and: [(objectMemory literalCountOf: aMethodObj) > 0]) ifFalse:
  		[^false].
  	lit := self literal: 0 ofMethod: aMethodObj.
  	((objectMemory isArray: lit)
  	 and: [(objectMemory numSlotsOf: lit) = 4]) ifFalse:
  		[^false].
  	self assert: primTracePluginName notNil.
  	pluginName := objectMemory fetchPointer: 0 ofObject: lit.
  	(objectMemory isBytes: pluginName) ifFalse:
  		[^false].
+ 	ok := self object: pluginName equalsString: primTracePluginName.
+ 	^ok!
- 	nameLength := objectMemory numBytesOfBytes: pluginName.
- 	^(self strncmp: primTracePluginName
- 				_: (objectMemory firstIndexableField: pluginName)
- 				_: nameLength) = 0
- 	  and: [(self strlen: primTracePluginName) = nameLength]!

Item was changed:
  ----- Method: CoInterpreterMT class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ 	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator
  		addHeaderFile:'"sqAtomicOps.h"'. "For THRLOG"
  	aCCodeGenerator vmClass
  		declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: 'Cog MT'.
  	aCCodeGenerator
  		var: #disowningVMThread type: #'CogVMThread *'.
  	aCCodeGenerator var: #reenterThreadSchedulingLoop type: 'jmp_buf'.!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMovePerfCnt64RL (in category 'generate machine code - concretize') -----
  concretizeMovePerfCnt64RL
  	"Generate code for
  		0x0: 50					pushq	%rax
  		0x1: 52					pushq	%rdx
  		0x2: 0f 31				rdtsc
  		0x4: 48 c1 e2 20		shlq	$0x20, %rdx
  		0x8: 48 09 d0			orq		%rdx, %rax
  		0xb: 48 89 f8			movq	%rdi, %rax
  		0xe: 5a					popq	%rdx
  		0xf: 58					popq	%rax
  	 et al"
+ 	| reg liveRegisterMask offset |
- 	| reg liveRegisters offset |
  	reg := operands at: 0.
+ 	liveRegisterMask := operands at: 1.
- 	liveRegisters := operands at: 1.
  	offset := 0.
+ 	(liveRegisterMask anyMask: (cogit registerMaskFor: RAX)) ifTrue:
- 	(liveRegisters anyMask: (cogit registerMaskFor: RAX)) ifTrue:
  		[machineCode at: 0 put: 16r50. "push %eax"
  		 offset := offset + 1].
+ 	(liveRegisterMask anyMask: (cogit registerMaskFor: RDX)) ifTrue:
- 	(liveRegisters anyMask: (cogit registerMaskFor: RDX)) ifTrue:
  		[machineCode at: offset put: 16r52. "push %edx"
  		 offset := offset + 1].
  	"too lazy to define the swap cases for the moment..."
  	self deny: reg = RDX.
  	machineCode
  		at: offset		put: 16r0F;							"rdtsc"
  		at: offset + 1	put: 16r31;
  		at: offset + 2	put: (self rexR: 0 x: 0 b: RDX);					"shlq   $0x20, %rdx"
  		at: offset + 3	put: 16rC1;
  		at: offset + 4	put: (self mod: ModReg RM: RDX RO: 4);
  		at: offset + 5	put: 32;
  		at: offset + 6	put: (self rexR: RDX x: 0 b: RAX);				"orq 	%rax, %rdx"
  		at: offset + 7	put: 16r0B;
  		at: offset + 8	put: (self mod: ModReg RM: RAX RO: RDX).
  	offset := offset + 9.
  	reg ~= RAX ifTrue:
  		[machineCode
  			at: offset put: (self rexR: RAX x: 0 b: reg);				"movq	%rDEST, %rax"
  			at: offset + 1 put: 16r89;
  			at: offset + 2 put: (self mod: ModReg RM: reg RO: RAX).
  		 offset := offset + 3].
+ 	(liveRegisterMask anyMask: (cogit registerMaskFor: RDX)) ifTrue:
- 	(liveRegisters anyMask: (cogit registerMaskFor: RDX)) ifTrue:
  		[machineCode at: offset put: 16r5A. "pop %edx"
  		 offset := offset + 1].
+ 	(liveRegisterMask anyMask: (cogit registerMaskFor: RAX)) ifTrue:
- 	(liveRegisters anyMask: (cogit registerMaskFor: RAX)) ifTrue:
  		[machineCode at: offset put: 16r58. "pop %eax"
  		 offset := offset + 1].
  	^offset
  
  	"{	cogit processor disassembleInstructionAt: 0 In: machineCode object.
  		cogit processor disassembleInstructionAt: 2 In: machineCode object.
  		cogit processor disassembleInstructionAt: 6 In: machineCode object.
  		cogit processor disassembleInstructionAt: 9 In: machineCode object }"!

Item was changed:
  ----- Method: Cogit>>MovePerfCnt64R:L: (in category 'abstract instructions') -----
+ MovePerfCnt64R: destReg L: liveRegisterMask
- MovePerfCnt64R: destReg L: liveRegisters
  	<returnTypeC: #'AbstractInstruction *'>
  	self assert: (backEnd has64BitPerformanceCounter and: [objectMemory wordSize = 8]).
+ 	^self gen: MovePerfCnt64RL operand: destReg operand: liveRegisterMask!
- 	^self gen: MovePerfCnt64RL operand: destReg operand: liveRegisters!

Item was changed:
  ----- Method: Cogit>>MovePerfCnt64R:R:L: (in category 'abstract instructions') -----
+ MovePerfCnt64R: destRegLo R: destRegHi L: liveRegisterMask
- MovePerfCnt64R: destRegLo R: destRegHi L: liveRegisters
  	<returnTypeC: #'AbstractInstruction *'>
  	self assert: (backEnd has64BitPerformanceCounter and: [objectMemory wordSize = 4]).
+ 	^self gen: MovePerfCnt64RRL operand: destRegLo operand: destRegHi operand: liveRegisterMask!
- 	^self gen: MovePerfCnt64RRL operand: destRegLo operand: destRegHi operand: liveRegisters!

Item was changed:
  ----- Method: NewObjectMemory>>findString: (in category 'debug support') -----
  findString: aCString
  	"Print the oops of all string-like things that have the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
+ 	| aCStringStrlen obj sz |
+ 	aCStringStrlen := self strlen: aCString.
- 	| cssz obj sz |
- 	cssz := self strlen: aCString.
  	obj := self firstObject.
  	[self oop: obj isLessThan: freeStart] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
+ 				[(self object: obj equalsString: aCString ofSize: aCStringStrlen) ifTrue:
- 				[((self isBytesNonImm: obj)
- 				  and: [(self lengthOf: obj) = cssz
- 				  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
  					[coInterpreter printHex: obj; space; printOopShort: obj; cr].
  				 sz := self sizeBitsOf: obj].
  		 obj := self oopFromChunk: obj + sz]!

Item was changed:
  ----- Method: NewObjectMemory>>findStringBeginningWith: (in category 'debug support') -----
  findStringBeginningWith: aCString
  	"Print the oops of all string-like things that start with the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
+ 	| aCStringStrlen obj sz |
+ 	aCStringStrlen := self strlen: aCString.
- 	| cssz obj sz |
- 	cssz := self strlen: aCString.
  	obj := self firstObject.
  	[self oop: obj isLessThan: freeStart] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
+ 				[(self object: obj equalsString: aCString ofSize: aCStringStrlen) ifTrue:
- 				[((self isBytesNonImm: obj)
- 				  and: [(self lengthOf: obj) >= cssz
- 				  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
  					[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr].
  				 sz := self sizeBitsOf: obj].
  		 obj := self oopFromChunk: obj + sz]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genCheckForProfileTimerTick: (in category 'primitive generators') -----
+ genCheckForProfileTimerTick: liveRegisterMask
+ 	"Compare the performance counter against the nextProfileTick, if nextProfileTick
+ 	 and answer the jump taken if the performance counter has past nextProfileTick.
+ 	 So implement (nextProfileTick > 0 and: [self ioHighResClock > nextProfileTick]) ifTrue:"
- genCheckForProfileTimerTick: liveRegisters
  	<inline: #always>
  	objectMemory wordSize = 8
  		ifTrue:
+ 			[| reg skip jump |
- 			[| reg |
  			 reg := backEnd preferredRegisterForMovePerfCnt64RL = NoReg
  						ifTrue: [Arg0Reg]
  						ifFalse: [backEnd preferredRegisterForMovePerfCnt64RL].
- 			 self MovePerfCnt64R: reg L: liveRegisters.
  			 self MoveAw: coInterpreter nextProfileTickAddress R: Arg1Reg.
+ 			 self CmpCq: 0 R: Arg1Reg.
+ 			 skip := self JumpZero: 0.
+ 			 self MovePerfCnt64R: reg L: liveRegisterMask.
  			 self CmpR: Arg1Reg R: reg.
+ 			 jump := self JumpAboveOrEqual: 0.
+ 			 skip jmpTarget: self Label.
+ 			 ^jump]
- 			 ^self JumpAboveOrEqual: 0]
  		ifFalse:
+ 			[| effectiveLiveRegisters regLo regHi skip jump |
- 			[| effectiveLiveRegisters regLo regHi |
  			 self flag: #endianness.
+ 			 self deny: ((self registerMaskFor: ClassReg and: SendNumArgsReg) anyMask: liveRegisterMask).
+ 			 effectiveLiveRegisters := liveRegisterMask bitOr: (self registerMaskFor: ClassReg and: SendNumArgsReg).
- 			 self deny: ((self registerMaskFor: ClassReg and: SendNumArgsReg) anyMask: liveRegisters).
- 			 effectiveLiveRegisters := liveRegisters bitOr: (self registerMaskFor: ClassReg and: SendNumArgsReg).
  			 regLo := Arg0Reg. regHi := Arg1Reg.
  			 backEnd preferredRegisterPairForMovePerfCnt64RRLInto:
  				[:prefRegLo :prefRegHi|
+ 				(self register: prefRegLo isInMask: liveRegisterMask) ifFalse:
- 				(self register: prefRegLo isInMask: liveRegisters) ifFalse:
  					[regLo := prefRegLo].
+ 				(self register: prefRegHi isInMask: liveRegisterMask) ifFalse:
- 				(self register: prefRegHi isInMask: liveRegisters) ifFalse:
  					[regHi := prefRegHi]].
  			 self MoveAw: coInterpreter nextProfileTickAddress R: ClassReg.
  			 self MoveAw: coInterpreter nextProfileTickAddress + 4 R: SendNumArgsReg.
+ 			 self AddR: ClassReg R: SendNumArgsReg R: regLo.
+ 			 skip := self JumpZero: 0.
+ 			 self MovePerfCnt64R: regLo R: regHi L: liveRegisterMask.
- 			 self MovePerfCnt64R: regLo R: regHi L: liveRegisters.
  			 self SubR: ClassReg R: regLo.
  			 self SubbR: SendNumArgsReg R: regHi.
+ 			 jump := self JumpAboveOrEqual: 0.
+ 			 skip jmpTarget: self Label.
+ 			 ^jump]!
- 			 ^self JumpAboveOrEqual: 0]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
  genPrimReturnEnterCogCodeEnilopmart: profiling
  	"Generate the substitute return code for an external or FFI primitive call.
  	 On success simply return, extracting numArgs from newMethod.
  	 On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
  	| jmpSample continuePostSample jmpFail |
  	<var: #jmpSample type: #'AbstractInstruction *'>
  	<var: #continuePostSample type: #'AbstractInstruction *'>
  	<var: #jmpFail type: #'AbstractInstruction *'>
  	self zeroOpcodeIndex.
  	backEnd hasVarBaseRegister ifTrue:
  		[self MoveCq: self varBaseAddress R: VarBaseReg]. "Must happen sometime"
  
  	"Test primitive failure"
  	self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  	self flag: 'ask concrete code gen if move sets condition codes?'.
  	self CmpCq: 0 R: TempReg.
  	jmpFail := self JumpNonZero: 0.
  
  	(profiling and: [backEnd has64BitPerformanceCounter]) ifTrue:
  		[jmpSample := self genCheckForProfileTimerTick: (self registerMaskFor: NoReg).
  		continuePostSample := self Label].
  
  	"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  		success:	stackPointer	->	result (was receiver)
  										arg1
  										...
  										argN
  										return pc
  		failure:							receiver
  										arg1
  										...
  					stackPointer	->	argN
  										return pc
  	We push the instructionPointer to reestablish the return pc in the success case,
  	but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."
  
  	backEnd hasLinkRegister
  		ifTrue:
  			[backEnd genLoadStackPointers.											"Switch back to Smalltalk stack."
  			 backEnd hasPCRegister
  				ifTrue:
  					[self PopR: ReceiverResultReg.										"Pop result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: PCReg]	"Return"
  				ifFalse:
  					[self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: LinkReg.	"Get ret pc"
  					 self RetN: objectMemory wordSize]]								"Return, popping result from stack"
  		ifFalse:
  			[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.	"Get return pc"
  			 backEnd genLoadStackPointers.									"Switch back to Smalltalk stack."
  			 self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  			 self MoveR: ClassReg Mw: 0 r: SPReg.								"Restore return pc"
  			 self RetN: 0].														"Return, popping result from stack"
  
  	"Primitive failed.  Invoke C code to build the frame and continue."
  	jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
  	"Reload sp with CStackPointer; easier than popping args of checkProfileTick."
  	self MoveAw: self cStackPointerAddress R: SPReg.
  	self 
  		compileCallFor: #ceActivateFailingPrimitiveMethod:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: NoReg
  		regsToSave: self emptyRegisterMask.
  
  	"On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful.
  	 So continue by returning to the caller.
  	 Switch back to the Smalltalk stack.  Stack should be in this state:
  				success:	stackPointer ->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  	 We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  	self MoveAw: coInterpreter instructionPointerAddress
  		R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  	backEnd genLoadStackPointers.
  	backEnd hasLinkRegister
  		ifTrue:
+ 			[self MoveMw: 0 r: SPReg R: ReceiverResultReg]		"Fetch result from stack"
- 			[self MoveMw: 0 r: SPReg R: ReceiverResultReg]	"Fetch result from stack"
  		ifFalse:
  			[self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg.	"Fetch result from stack"
+ 			 self PushR: ClassReg].													"Restore return pc on CISCs"
- 			 self PushR: ClassReg].											"Restore return pc on CISCs"
  	self RetN: objectMemory wordSize.	"return to caller, popping receiver"
  
  	(profiling and: [backEnd has64BitPerformanceCounter]) ifTrue:
+ 		["Call ceTakeProfileSample: to record sample and then continue.  newMethod
- 		["Call ceCheckProfileTick to record sample and then continue.  newMethod
  		 should be up-to-date.  Need to save and restore the link reg around this call."
  		 jmpSample jmpTarget: self Label.
+ 		 backEnd genMarshallNArgs: 1 arg: 0 arg: 0 arg: 0 arg: 0.
+ 		 self CallFullRT: (self cCode: [#ceTakeProfileSample: asUnsignedInteger]
+ 							inSmalltalk: [self simulatedTrampolineFor: #ceTakeProfileSample:]).
+ 		 backEnd genRemoveNArgsFromStack: 1.
- 		 backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
- 		 self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedInteger]
- 							inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
- 		 backEnd genRemoveNArgsFromStack: 0.
  		 self Jump: continuePostSample]!

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ 	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator removeVariable: 'memory'. "memory is a simulation time thing only"
  	self declareCAsOop: #(	freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
  							lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory)
  		in: aCCodeGenerator.
  	self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #lastHash type: #usqInt;
  		var: #freeListsMask type: #usqInt;
  		var: #freeLists type: #'sqInt *';
  		var: #objStackInvalidBecause type: #'char *';
  		var: #unscannedEphemerons type: #SpurContiguousObjStack;
  		var: #heapGrowthToSizeGCRatio type: #float;
  		var: #heapSizeAtPreviousGC type: #usqInt;
  		var: #totalFreeOldSpace type: #usqInt;
  		var: #maxOldSpaceSize type: #usqInt.
  	aCCodeGenerator
  		var: #oldSpaceUsePriorToScavenge type: #sqLong.
  	aCCodeGenerator
  		var: #remapBuffer
  		declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #extraRoots
  		declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!

Item was changed:
  ----- Method: SpurMemoryManager>>findString: (in category 'debug support') -----
  findString: aCString
  	"Print the oops of all string-like things that have the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
+ 	| aCStringStrlen |
+ 	aCStringStrlen := self strlen: aCString.
- 	| cssz |
- 	cssz := self strlen: aCString.
  	self allObjectsDo:
  		[:obj|
+ 		 (self object: obj equalsString: aCString ofSize: aCStringStrlen) ifTrue:
- 		 ((self isBytesNonImm: obj)
- 		  and: [(self lengthOf: obj) = cssz
- 		  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
  			[coInterpreter printHex: obj; space; printOopShort: obj; cr]]!

Item was changed:
  ----- Method: SpurMemoryManager>>findStringBeginningWith: (in category 'debug support') -----
  findStringBeginningWith: aCString
  	"Print the oops of all string-like things that start with the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
+ 	| aCStringStrlen |
+ 	aCStringStrlen := self strlen: aCString.
- 	| cssz |
- 	cssz := self strlen: aCString.
  	self allObjectsDo:
  		[:obj|
+ 		 (self object: obj equalsString: aCString ofSize: aCStringStrlen) ifTrue:
+ 			[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr]]!
- 		 ((self isBytesNonImm: obj)
- 		  and: [(self lengthOf: obj) >= cssz
- 		  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
- 				[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr]]!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreter>>initializeExtraClassInstVarIndices (in category 'initialization') -----
  initializeExtraClassInstVarIndices
  	"Initialize metaclassNumSlots and thisClassIndex which are used in debug printing, and
  	 classNameIndex which is used not only for debug printing but for is:KindOf: & is:MemberOf:
  	 via classNameOf:is: (evil but a reality we have to accept)."
  	| classArrayObj classArrayClass |
  	classArrayObj := objectMemory splObj: ClassArray.
  	classArrayClass := objectMemory fetchClassOfNonImm: classArrayObj.
  	metaclassNumSlots := objectMemory numSlotsOf: classArrayClass.	"determine actual Metaclass instSize"
  	thisClassIndex := 5. "default"
+ 	InstanceSpecificationIndex + 1 to: (objectMemory numSlotsOf: classArrayClass) do:
- 	InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayClass) do:
  		[:i|
  		(objectMemory fetchPointer: i - 1 ofObject: classArrayClass) = classArrayObj ifTrue:
  			[thisClassIndex := i - 1]].
  	classNameIndex := 6. "default"
+ 	InstanceSpecificationIndex + 1 to: (objectMemory numSlotsOf: classArrayObj) do:
- 	InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayObj) do:
  		[:i| | oop |
  		oop := objectMemory fetchPointer: i - 1 ofObject: classArrayObj.
+ 		(self object: oop equalsString: 'Array') ifTrue:
- 		((objectMemory isBytes: oop)
- 		and: [(objectMemory lengthOf: oop) = 5
- 		and: [(objectMemory strncmp: 'Array' _: (objectMemory firstFixedField: oop) _: 5) = 0]]) ifTrue:
  			[classNameIndex := i - 1]]!

Item was added:
+ ----- Method: StackInterpreter>>object:equalsString: (in category 'utilities') -----
+ object: anOop equalsString: aCString
+ 	^self object: anOop equalsString: aCString ofSize: (self strlen: aCString)!

Item was added:
+ ----- Method: StackInterpreter>>object:equalsString:ofSize: (in category 'utilities') -----
+ object: anOop equalsString: aCString ofSize: aCStringStrlen
+ 	| size |
+ 	^(objectMemory isBytes: anOop)
+ 	 and: [(size := objectMemory numBytesOfBytes: anOop) = aCStringStrlen
+ 	 and: [(self strncmp: aCString _: (objectMemory firstIndexableField: anOop)  _: aCStringStrlen) = 0]]!

Item was changed:
  SharedPool subclass: #VMBytecodeConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BytecodeSetHasDirectedSuperSend CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots NewsqueakV4BytecodeSet PrimNumberDoExternalCall PrimNumberDoPrimitive PrimNumberExternalCall PrimNumberFFICall PrimNumberFlushExternalPrimitives PrimNumberInstVarAt PrimNumberShallowCopy PrimNumberSlotAt PrimNumberUnoadModule SistaV1BytecodeSet SmallContextSize SmallContextSlots SqueakV3PlusClosuresBytecodeSet'
- 	classVariableNames: 'BytecodeSetHasDirectedSuperSend CtxtTempFrameStart LargeContextBit LargeContextSize LargeContextSlots NewsqueakV4BytecodeSet PrimNumberDoExternalCall PrimNumberDoPrimitive PrimNumberExternalCall PrimNumberFFICall PrimNumberInstVarAt PrimNumberShallowCopy PrimNumberSlotAt SistaV1BytecodeSet SmallContextSize SmallContextSlots SqueakV3PlusClosuresBytecodeSet'
  	poolDictionaries: 'VMBasicConstants'
  	category: 'VMMaker-Interpreter'!
  
  !VMBytecodeConstants commentStamp: '<historical>' prior: 0!
  self ensureClassPool.
  #(CtxtTempFrameStart LargeContextBit LargeContextSize SmallContextSize) do:
  	[:k|
  	self classPool declare: k from: ObjectMemory classPool]!



More information about the Vm-dev mailing list