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

commits at source.squeak.org commits at source.squeak.org
Thu Jul 8 22:15:49 UTC 2021


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

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

Name: VMMaker.oscog-eem.2983
Author: eem
Time: 8 July 2021, 3:15:40.038522 pm
UUID: 1e83ddc1-16fd-4d9b-a4cd-ec058aba9989
Ancestors: VMMaker.oscog-eem.2982

Revive simulation-time linked-send tracing hooking it off the handleABICallOrJumpSimulationTrap:evaluable: trap (used by ARM32 to invoke floating-point ABI calls).  Nuke the wantsNearAddressFor: mess which can't possibly work now.

Make sure the four functional processors all simulate with ensureExecutable/WritableCodeZone (i.e. fix detectFeatures on x86/x64).

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

Item was removed:
- ----- Method: CogARMCompiler>>wantsNearAddressFor: (in category 'simulation') -----
- wantsNearAddressFor: anObject
- 	"A hack hook to allow ARM to override the simulated address for the short-cut trampolines"
- 	<doNotGenerate>
- 	^anObject == #ceShortCutTraceLinkedSend:
- 	 or: [anObject == #ceShortCutTraceBlockActivation:
- 	 or: [anObject == #ceShortCutTraceStore:]]!

Item was removed:
- ----- Method: CogARMv8Compiler>>wantsNearAddressFor: (in category 'simulation') -----
- wantsNearAddressFor: anObject
- 	"A hack hook to allow ARM to override the simulated address for the short-cut trampolines"
- 	<doNotGenerate>
- 	^anObject == #ceShortCutTraceLinkedSend:
- 	 or: [anObject == #ceShortCutTraceBlockActivation:
- 	 or: [anObject == #ceShortCutTraceStore:]]!

Item was added:
+ ----- Method: CogAbstractInstruction>>callFullInstructionByteSize (in category 'accessing') -----
+ callFullInstructionByteSize
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction>>ceShortCutTraceBlockActivation: (in category 'simulation') -----
+ ceShortCutTraceBlockActivation: aProcessorSimulationTrap
+ 	<doNotGenerate>
+ 	self flag: 'just a placeholder; see handleABICallOrJumpSimulationTrap:evaluable: & simulatedTrampolineFor:'!

Item was added:
+ ----- Method: CogAbstractInstruction>>ceShortCutTraceLinkedSend: (in category 'simulation') -----
+ ceShortCutTraceLinkedSend: aProcessorSimulationTrap
+ 	<doNotGenerate>
+ 	self flag: 'just a placeholder; see handleABICallOrJumpSimulationTrap:evaluable: & simulatedTrampolineFor:'!

Item was added:
+ ----- Method: CogAbstractInstruction>>ceShortCutTraceStore: (in category 'simulation') -----
+ ceShortCutTraceStore: aProcessorSimulationTrap
+ 	<doNotGenerate>
+ 	self flag: 'just a placeholder; see handleABICallOrJumpSimulationTrap:evaluable: & simulatedTrampolineFor:'!

Item was removed:
- ----- Method: CogAbstractInstruction>>wantsNearAddressFor: (in category 'simulation') -----
- wantsNearAddressFor: anObject
- 	"A hack hook to allow ARM to override the simulated address for the short-cut trampolines,
- 	 and to allow x64 to address CStackPointer and CFramePointer relative to VarBaseReg."
- 	^false!

Item was added:
+ ----- Method: CogIA32Compiler>>callFullInstructionByteSize (in category 'accessing') -----
+ callFullInstructionByteSize
+ 	^5!

Item was changed:
  ----- Method: CogIA32Compiler>>detectFeatures (in category 'feature detection') -----
  detectFeatures
  	"Do a throw-away compilation to get at the cpuid info and initialize cpuidWord0 and cpuidWord1.
  	 N.B. All of MSVC, gcc & clang have intrinsics for this, so if you have the energy by all means
  	 reimplement as an #if _MSC_VER...#elif __GNUC__ #else ... saga."
  	| startAddress cpuid |
  	<var: 'cpuid' declareC: 'usqIntptr_t (*cpuid)(usqIntptr_t arg)'>
  	startAddress := cogit methodZoneBase.
  	cogit allocateOpcodes: 10 bytecodes: 0.
  	cpuid := cogit cCoerceSimple: cogit methodZoneBase to: #'usqIntptr_t (*)(usqIntptr_t)'.
  	cogit
  		PushR: EDX;
  		PushR: ECX;
  		PushR: EBX;
  		MoveMw: 16 "3 saved registers plus return pc" r: ESP R: EAX;
  		gen: CPUID;
  		MoveR: EDX R: EAX;
  		PopR: EBX;
  		PopR: ECX;
  		PopR: EDX;
  		RetN: 0.
  	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
  	cogit resetMethodZoneBase: startAddress.
+ 	cogit ensureExecutableCodeZone.
  	self setCpuidWord0: (self cCode: 'cpuid(1)' inSmalltalk: [self cpuid: 1]).
  	cogit zeroOpcodeIndexForNewOpcodes.
  	cogit
  		PushR: EDX;
  		PushR: ECX;
  		PushR: EBX;
  		MoveMw: 16 "3 saved registers plus return pc" r: ESP R: EAX;
  		gen: CPUID;
  		MoveR: ECX R: EAX;
  		PopR: EBX;
  		PopR: ECX;
  		PopR: EDX;
  		RetN: 0.
  	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
  	cogit resetMethodZoneBase: startAddress.
  	self setCpuidWord1: (self cCode: 'cpuid(0x80000001)' inSmalltalk: [self cpuid: 16r80000001])!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>callFullInstructionByteSize (in category 'accessing') -----
+ callFullInstructionByteSize
+ 	^12!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>callFullInstructionByteSize (in category 'accessing') -----
+ callFullInstructionByteSize
+ 	^8!

Item was added:
+ ----- Method: CogX64Compiler>>callFullInstructionByteSize (in category 'accessing') -----
+ callFullInstructionByteSize
+ 	^12!

Item was changed:
  ----- Method: CogX64Compiler>>detectFeatures (in category 'feature detection') -----
  detectFeatures
  	"Do a throw-away compilation to get at the cpuid info and initialize cpuidWord1
  	 N.B. All of MSVC, gcc & clang have intrinsics for this, so if you have the energy
  	 by all means reimplement as an #if _MSC_VER...#elif __GNUC__ #else ... saga."
  	| startAddress cpuid |
  	<var: 'cpuid' declareC: 'usqIntptr_t (*cpuid)(void)'>
  	startAddress := cogit methodZoneBase.
  	cogit allocateOpcodes: 10 bytecodes: 0.
  	cpuid := cogit cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
  	cogit
  		PushR: RDX;
  		PushR: RCX;
  		PushR: RBX;
  		MoveCq: 16r80000001 R: RAX;
  		gen: CPUID;
  		MoveR: RCX R: RAX;
  		PopR: RBX;
  		PopR: RCX;
  		PopR: RDX;
  		RetN: 0.
  	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
  	cogit resetMethodZoneBase: startAddress.
+ 	cogit ensureExecutableCodeZone.
  	self setCpuidWord1: (self cCode: 'cpuid()' inSmalltalk: [cogit simulateLeafCallOf: startAddress])!

Item was changed:
  CogClass subclass: #Cogit
(excessive size, no diff calculated)

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'
+ 		'codeZoneIsExecutableNotWritable' 'debugAPISelector' 'shortCutTrampolineBlocks') do:
- 		'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"
- 	aCCodeGenerator
- 		removeVariable: 'codeZoneIsExecutableNotWritable'; "these two are for simulation time assertion support"
- 		removeVariable: 'debugAPISelector';
- 		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:'"sqPlatformSpecific.h"'; "e.g. solaris overrides things for sqCogStackAlignment.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>>compileEntry (in category 'compile abstract instructions') -----
  compileEntry
  	"The entry code to a method checks that the class of the current receiver matches
  	 that in the inline cache.  Other non-obvious elements are that its alignment must be
  	 different from the alignment of the noCheckEntry so that the method map machinery
  	 can distinguish normal and super sends (super sends bind to the noCheckEntry)."
  
  	entry := objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: TempReg forEntry: true.
  	self CmpR: ClassReg R: TempReg.
  	self JumpNonZero: sendMiss.
  	noCheckEntry := self Label.
  	self compileSendTrace ifTrue:
  		[backEnd saveAndRestoreLinkRegAround:
+ 			[self CallFullRT: ceTraceLinkedSendTrampoline]]!
- 			[self CallRT: ceTraceLinkedSendTrampoline]]!

Item was changed:
  ----- Method: Cogit>>debugAPISelector (in category 'debugging') -----
  debugAPISelector
  	"Answer the selector theCoInterpereter called in on. Simulation only.
  	 Used to help the codeZoneIsExecutableNotWritable assert work."
  	<doNotGenerate>
+ 	^(thisContext findContextSuchThat: [:ctxt| ctxt sender notNil and: [ctxt sender receiver == coInterpreter]]) ifNotNil: [:ctxt| ctxt selector]!
- 	^(thisContext findContextSuchThat: [:ctxt| ctxt sender notNil and: [ctxt sender receiver == coInterpreter]]) selector!

Item was removed:
- ----- Method: Cogit>>fakeAddressFor:index: (in category 'initialization') -----
- fakeAddressFor: anObject index: index
- 	"Answer a fake address for some variable based on some index.
- 	 The index will usually be the size of simulatedAddresses, but
- 	 in determining the varBaseAddress we take a guess at the final
- 	 size of simulatedAddresses."
- 	<doNotGenerate>
- 	^index * objectMemory wordSize
- 	+ ((backEnd notNil
- 		and: [backEnd wantsNearAddressFor: anObject])
- 				ifTrue: [self addressSpaceMask - (1024 * 1024)]
- 				ifFalse: [self allButTopBitOfAddressSpaceMask])!

Item was changed:
  ----- Method: Cogit>>generateStackPointerCapture (in category 'initialization') -----
  generateStackPointerCapture
  	"Generate a routine ceCaptureCStackPointers that will capture the C stack pointer,
  	 and, if it is in use, the C frame pointer.  These are used in trampolines to call
  	 run-time routines in the interpreter from machine-code."
  
  	| oldMethodZoneBase oldTrampolineTableIndex |
  	cFramePointerInUse := false. "For the benefit of the following assert, assume the minimum at first."
  	self assertCStackWellAligned.
  	oldMethodZoneBase := methodZoneBase.
  	oldTrampolineTableIndex := trampolineTableIndex.
  	self generateCaptureCStackPointers: true.
  	self perform: #ceCaptureCStackPointers.
- 	self ensureWritableCodeZone.
  	(cFramePointerInUse := coInterpreter checkIfCFramePointerInUse) ifFalse:
  		[methodZoneBase := oldMethodZoneBase.
  		 trampolineTableIndex := oldTrampolineTableIndex.
+ 		 self generateCaptureCStackPointers: false].
+ 	self ensureWritableCodeZone.
- 		 self generateCaptureCStackPointers: false.
- 		 self ensureWritableCodeZone].
  	self assertCStackWellAligned!

Item was changed:
  ----- Method: Cogit>>handleABICallOrJumpSimulationTrap:evaluable: (in category 'simulation only') -----
+ handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: aMessage
- handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable
  	<doNotGenerate>
  
  	self assert: aProcessorSimulationTrap type = #call.
+ 	(shortCutTrampolineBlocks at: aMessage selector ifAbsent: nil) ifNotNil:
+ 		[:block| ^self shortcutTrampoline: aProcessorSimulationTrap to: block].
+ 
+ 	"more conventional abi call..."
  	processor
  		simulateLeafCallOf: aProcessorSimulationTrap address
  		nextpc: aProcessorSimulationTrap nextpc
  		memory: coInterpreter memory.
+ 	self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. aMessage selector. ')'}.
- 	self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. evaluable selector. ')'}.
  	clickConfirm ifTrue:
   		[(self confirm: 'skip run-time call?') ifFalse:
  			[clickConfirm := false. self halt]].
+ 	aMessage valueWithArguments: (processor
+ 										postCallArgumentsNumArgs: aMessage numArgs
- 	evaluable valueWithArguments: (processor
- 										postCallArgumentsNumArgs: evaluable numArgs
  										in: coInterpreter memory).
  	self recordInstruction: {'(simulated return to '. processor retpcIn: coInterpreter memory. ')'}.
  	processor
  		smashABICallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize;
  		simulateLeafReturnIn: coInterpreter memory!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc |
  	"Execution of a single instruction must be within the processorLock critical section to ensure
  	 simulation traps are executed atomically.  However, at this point control is leaving machine
  	 code and entering the run-time and hence the lock must be released."
  	processorLock primitiveExitCriticalSection.
  	"This is a hack fix before we revise the simulators.  When a jump call is made, the next
  	 pc is effectively the return address on the stack, not the instruction following the jump."
  	aProcessorSimulationTrap type == #jump ifTrue:
  		[processor hackFixNextPCOfJumpFor: aProcessorSimulationTrap using: objectMemory].
  
  	evaluable := simulatedTrampolines
  					at: aProcessorSimulationTrap address
  					ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  								in: simulatedTrampolines].
  	function := evaluable isBlock
  					ifTrue: ['aBlock; probably some plugin primitive']
  					ifFalse:
+ 						[evaluable receiver == backEnd ifTrue: "this is for invoking ARMv5 floating-point intrinsics, and for the short-cut tracing trampolines"
- 						[evaluable receiver == backEnd ifTrue: "this is for invoking ARMv5 floating-point intrinsics"
  							[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
  						 evaluable selector].
  	memory := coInterpreter memory.
  	function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret/ceReturnToInterpreterTrampoline and should discard all state back to enterSmalltalkExecutiveImplementation"
  		[self recordInstruction: {'(simulated jump call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  		 "self halt: evaluable selector."
  	   	 clickConfirm ifTrue:
  		 	[(self confirm: 'skip jump to interpret?') ifFalse:
  				[clickConfirm := false. self halt]].
  		 processor simulateJumpCallOf: aProcessorSimulationTrap address memory: memory.
  		 coInterpreter reenterInterpreter.
  		 "NOTREACHED"
  		 self halt].
  	function ~~ #ceBaseFrameReturn: ifTrue:
  		[coInterpreter assertValidExternalStackPointers].
- 	(backEnd wantsNearAddressFor: function) ifTrue:
- 		[^self perform: function with: aProcessorSimulationTrap].
  	processor
  		simulateCallOf: aProcessorSimulationTrap address
  		nextpc: aProcessorSimulationTrap nextpc
  		memory: memory.
  	retpc := processor retpcIn: memory.
  	self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  	savedFramePointer := coInterpreter framePointer.
  	savedStackPointer := coInterpreter stackPointer.
  	savedArgumentCount := coInterpreter argumentCount.
  	result := ["self halt: evaluable selector."
  		   	   clickConfirm ifTrue:
  			 	[(self confirm: 'skip run-time call?') ifFalse:
  					[clickConfirm := false. self halt]].
  			   evaluable valueWithArguments: (processor
  												postCallArgumentsNumArgs: evaluable numArgs
  												in: memory)]
  				on: ReenterMachineCode
  				do: [:ex| ex return: #continueNoReturn].
  			
  	coInterpreter assertValidExternalStackPointers.
  	"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
  	 not called something that has built a frame, such as closure value or evaluate method, or
  	 switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
  	(function beginsWith: 'primitive') ifTrue:
  		[coInterpreter primFailCode = 0
  			ifTrue: [(CogVMSimulator stackAlteringPrimitives includes: function) ifFalse:
  						["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
  						 (function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
  							[self assert: savedFramePointer = coInterpreter framePointer.
  							 self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
  									= coInterpreter stackPointer]]]
  			ifFalse:
  				[self assert: savedFramePointer = coInterpreter framePointer.
  				 self assert: savedStackPointer = coInterpreter stackPointer]].
  	result ~~ #continueNoReturn ifTrue:
  		[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
  		 processor simulateReturnIn: memory.
  		 self assert: processor pc = retpc.
  		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize].
  	self assert: (result isInteger "an oop result"
  			or: [result == coInterpreter
  			or: [result == objectMemory
  			or: [result == nil
  			or: [result == #continueNoReturn]]]]).
  	processor cResultRegister: (result
  								ifNil: [0]
  								ifNotNil: [result isInteger
  											ifTrue: [result]
  											ifFalse: [16rF00BA222]])!

Item was changed:
  ----- Method: Cogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	coInterpreter := aCoInterpreter.
  	objectMemory := aCoInterpreter objectMemory.
  	methodZone := self class methodZoneClass new.
  	objectRepresentation := objectMemory objectRepresentationClass
  								forCogit: self methodZone: methodZone.
  	methodZone setInterpreter: aCoInterpreter
  				objectRepresentation: objectRepresentation
  				cogit: self.
  	generatorTable := self class generatorTable.
  	processor := ProcessorClass new.
  	simulatedAddresses := Dictionary new.
  	coInterpreter class clusteredVariableNames do:
  		[:cvn| self simulatedAddressFor: (cvn first = $C ifTrue: ['get', cvn] ifFalse: [cvn]) asSymbol].
  	simulatedTrampolines := Dictionary new.
  	simulatedVariableGetters := Dictionary new.
  	simulatedVariableSetters := Dictionary new.
  	traceStores := 0.
+ 	traceFlags := (InitializationOptions at: #linkedSendTrace ifAbsent: [false])
+ 					ifTrue: [257]
+ 					ifFalse:
+ 						[(InitializationOptions at: #recordPrimTrace ifAbsent: [true])
+ 							ifTrue: [8] "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
+ 							ifFalse: [0]].
- 	traceFlags := (self class initializationOptions at: #recordPrimTrace ifAbsent: [true])
- 					ifTrue: [8] "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
- 					ifFalse: [0].
  	singleStep := printRegisters := printInstructions := clickConfirm := false.
  	backEnd := CogCompilerClass for: self.
  	methodLabel := CogCompilerClass for: self.
  	(literalsManager := backEnd class literalsManagerClass new) cogit: self.
  	ordinarySendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  	superSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  	BytecodeSetHasDirectedSuperSend ifTrue:
  		[directedSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		 directedSuperBindingSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		 directedSendUsesBinding := false].
  	NewspeakVM ifTrue:
  		[selfSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		dynamicSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		implicitReceiverSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		outerSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines)].
  	"debug metadata"
  	objectReferencesInRuntime := CArrayAccessor on: (Array new: NumObjRefsInRuntime).
  	runtimeObjectRefIndex := 0.
  	"debug metadata"
  	trampolineAddresses := CArrayAccessor on: (Array new: NumTrampolines * 2).
  	trampolineTableIndex := 0.
  
  	extA := numExtB := extB := 0.
  
  	compilationTrace ifNil: [compilationTrace := self class initializationOptions at: #compilationTrace ifAbsent: [0]].
  	debugOpcodeIndices := self class initializationOptions at: #debugOpcodeIndices ifAbsent: [Set new].
  	debugBytecodePointers := self class initializationOptions at: #debugBytecodePointers ifAbsent: [Set new].
  	self class initializationOptions at: #breakPC ifPresent: [:pc| breakPC := pc]!

Item was changed:
  ----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
  simulateCogCodeAt: address "<Integer>"
  	<doNotGenerate>
  	| stackZoneBase |
+ 	backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
+ 		[self assert: codeZoneIsExecutableNotWritable].
- 	self assert: codeZoneIsExecutableNotWritable.
  	stackZoneBase := coInterpreter stackZoneBase.
  	processor pc: address.
  	[[[singleStep
  		ifTrue:
  			[[processor sp < stackZoneBase ifTrue: [self halt].
  			  self recordProcessing.
  			  self maybeBreakAt: processor pc] value. "So that the Debugger's Over steps over all this"
  			  processorLock critical:
  				[processor
  					singleStepIn: coInterpreter memory
  					minimumAddress: guardPageSize
  					readOnlyBelow: methodZone zoneEnd]]
  		ifFalse:
  			[processorLock critical:
  				[processor
  					runInMemory: coInterpreter memory
  					minimumAddress: guardPageSize
  					readOnlyBelow: methodZone zoneEnd]].
  	   "((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
  	 	[(self confirm: 'continue?') ifFalse:
  			[clickConfirm := false. self halt]]."
  	   true] whileTrue]
  		on: ProcessorSimulationTrap
  		do: [:ex| ex applyTo: self].
  	 true] whileTrue!

Item was changed:
  ----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
  simulateLeafCallOf: someFunction
  	"Simulate execution of machine code that leaf-calls someFunction,
  	 answering the result returned by someFunction."
  	"CogProcessorAlienInspector openFor: coInterpreter"
  	<doNotGenerate>
  	| priorSP priorPC priorLR spOnEntry bogusRetPC |
+ 	backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
+ 		[self assert: codeZoneIsExecutableNotWritable].
- 	self assert: codeZoneIsExecutableNotWritable.
  	self recordRegisters.
  	priorSP := processor sp.
  	priorPC := processor pc.
  	priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
  	processor
  		simulateLeafCallOf: someFunction
  		nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
  		memory: coInterpreter memory.
  	spOnEntry := processor sp.
  	self recordInstruction: {'(simulated call of '. someFunction. ')'}.
  	^[[[processor pc between: self class guardPageSize and: methodZone zoneEnd] whileTrue:
  		[singleStep
  			ifTrue: [self recordProcessing.
  					self maybeBreakAt: processor pc.
  					processorLock critical:
  						[processor
  							singleStepIn: coInterpreter memory
  							minimumAddress: guardPageSize
  							readOnlyBelow: methodZone zoneEnd]]
  			ifFalse: [processorLock critical:
  						[processor
  							runInMemory: coInterpreter memory
  							minimumAddress: guardPageSize
  							readOnlyBelow: methodZone zoneEnd]]]]
  			on: ProcessorSimulationTrap, Error
  			do: [:ex|
  				"Again this is a hack for the processor simulators not properly simulating returns to bogus addresses.
  				 In this case BochsX64Alien doesn't do the right thing."
  				processor pc = bogusRetPC ifTrue:
  					[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
  					 ^processor cResultRegister].
  				ex isProcessorSimulationTrap ifFalse:
  					[ex pass].
  				ex applyTo: self.
  				ex type == #return ifTrue:
  					[^processor cResultRegister]].
  	processor pc = bogusRetPC ifTrue:
  		[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
  	processor cResultRegister]
  		ensure:
  			[processor sp: priorSP.
  			 processor pc: priorPC.
  			 priorLR ifNotNil: [:lr| processor lr: lr]]!

Item was changed:
  ----- Method: Cogit>>simulatedAddressFor: (in category 'initialization') -----
  simulatedAddressFor: anObject
+ 	"Answer a simulated address for a block or a symbol.  This is an address
+ 	 that can be called, read or written by generated machine code, and will
+ 	 be mapped into a Smalltalk message send or block evaluation. These
+ 	 addresses are at the top end of the bottom half of the address space to
+ 	 avoid having the sign bit set and so will not look like negative numbers."
- 	"Answer a simulated address for a block or a symbol.  This is an address that
- 	 can be called, read or written by generated machine code, and will be mapped
- 	 into a Smalltalk message send or block evaluation.
- 
- 	 N.B. These addresses are at the top end of the bottom half of the address space
- 	 so that they don't have the sign bit set and so will not look like negative numbers,
- 	 unless they're the short-cut routines on ARM, where we want to use a bl, not a blx."
  	<doNotGenerate>
  	^simulatedAddresses
  		at: anObject
+ 		ifAbsentPut: [simulatedAddresses size * objectMemory wordSize + self allButTopBitOfAddressSpaceMask]!
- 		ifAbsentPut: [self fakeAddressFor: anObject index: simulatedAddresses size]!

Item was changed:
  ----- Method: Cogit>>traceLinkedSendOffset (in category 'debugging') -----
  traceLinkedSendOffset
  	<api>
  	^cmNoCheckEntryOffset
+ 	 + backEnd callFullInstructionByteSize
- 	 + backEnd callInstructionByteSize
  	 + (backEnd hasLinkRegister
  		ifTrue: [backEnd pushLinkRegisterByteSize]
  		ifFalse: [0])!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>cogit: (in category 'initialize-release') -----
  cogit: aCogit
- 	| accessors |
  	cogit := aCogit.
  	cogit objectMemory ifNil:
  		[cogit instVarNamed: 'objectMemory' put: objectMemory].
  	coInterpreter cogit: aCogit.
  	(objectMemory respondsTo: #cogit:) ifTrue:
  		[objectMemory cogit: aCogit].
  	(objectMemory respondsTo: #coInterpreter:) ifTrue:
  		[objectMemory coInterpreter: coInterpreter].
  	coInterpreter setUpForUseByFacade: self.
  	objectMemory setUpForUseByFacade: self.
- 	accessors := CurrentImageCoInterpreterFacade organization listAtCategoryNamed: #accessing.
- 	coInterpreter class clusteredVariableNames do:
- 		[:var|
- 		(Symbol lookup: (var first = $C ifTrue: ['c', var allButFirst] ifFalse: [var]), 'Address') ifNotNil:
- 			[:accessor|
- 			(accessors includes: accessor) ifTrue:
- 				[[self perform: accessor]
- 					on: SubclassResponsibility
- 					do: [:ex| ex return]]]].
  	self initializeObjectMap!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>ceShortCutTraceBlockActivation: (in category 'simulation only') -----
- ceShortCutTraceBlockActivation: aProcessorSimulationTrap
- 	self shortcutTrampoline: aProcessorSimulationTrap
- 		to: [coInterpreter ceTraceBlockActivation]!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>ceShortCutTraceLinkedSend: (in category 'simulation only') -----
- ceShortCutTraceLinkedSend: aProcessorSimulationTrap
- 	self shortcutTrampoline: aProcessorSimulationTrap
- 		to: [coInterpreter ceTraceLinkedSend: (processor registerAt: ReceiverResultReg)]!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
- ceShortCutTraceStore: aProcessorSimulationTrap
- 	<doNotGenerate>
- 	self shortcutTrampoline: aProcessorSimulationTrap
- 		to: [coInterpreter
- 				ceTraceStoreOf: (processor registerAt: ClassReg)
- 				into: (processor registerAt: ReceiverResultReg)]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	super setInterpreter: aCoInterpreter.
  	primitiveGeneratorTable := self class primitiveTable.
  	externalPrimJumpOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2).
  	externalPrimCallOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2).
+ 	externalSetPrimOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2).
+ 	(shortCutTrampolineBlocks := IdentityDictionary new)
+ 		at: #ceShortCutTraceBlockActivation:
+ 			put: [coInterpreter ceTraceBlockActivation];
+ 		at: #ceShortCutTraceLinkedSend:
+ 			put: [coInterpreter ceTraceLinkedSend: (processor registerAt: ReceiverResultReg)];
+ 		at: #ceShortCutTraceStore:
+ 			put: [coInterpreter
+ 					ceTraceStoreOf: (processor registerAt: ClassReg)
+ 					into: (processor registerAt: ReceiverResultReg)]!
- 	externalSetPrimOffsets := CArrayAccessor on: (Array new: MaxNumArgs + 1 * 2)!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
- ceShortCutTraceStore: aProcessorSimulationTrap
- 	<doNotGenerate>
- 	self shortcutTrampoline: aProcessorSimulationTrap
- 		to: [coInterpreter
- 				ceTraceStoreOf: (processor registerAt: TempReg)
- 				into: (processor registerAt: ReceiverResultReg)]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	super setInterpreter: aCoInterpreter.
  
  	methodAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  	picAbortTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  	picMissTrampolines := CArrayAccessor on: (Array new: self numRegArgs + 2).
  
  	simStack := CArrayAccessor on: ((1 to: self class simStackSlots) collect: [:i| self simStackEntryClass new cogit: self]).
  	simNativeStack := CArrayAccessor on: ((1 to: self class simNativeStackSlots) collect: [:i| self simStackNativeEntryClass new cogit: self]).
  
  	debugFixupBreaks := self class initializationOptions at: #debugFixupBreaks ifAbsent: [Set new].
  
  	numPushNilsFunction := self class numPushNilsFunction.
+ 	pushNilSizeFunction := self class pushNilSizeFunction.
+ 
+ 	shortCutTrampolineBlocks
+ 		at: #ceShortCutTraceStore:
+ 			put: [coInterpreter
+ 					ceTraceStoreOf: (processor registerAt: TempReg)
+ 					into: (processor registerAt: ReceiverResultReg)]!
- 	pushNilSizeFunction := self class pushNilSizeFunction!



More information about the Vm-dev mailing list