[Vm-dev] VM Maker: VMMaker.oscogSPC-eem.2109.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jan 24 22:23:35 UTC 2017


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

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

Name: VMMaker.oscogSPC-eem.2109
Author: eem
Time: 24 January 2017, 2:22:50.346862 pm
UUID: 7f7cf738-f55b-4698-a90a-22aed4aa8fd8
Ancestors: VMMaker.oscogSPC-cb.2105, VMMaker.oscog-nice.2109, VMMaker.oscog-eem.2109

Temporary branch for SpurPlanningCompactor as default compactor.  Otherwise the same as merge of VMMaker.oscog-eem.2109 & VMMaker.oscog-nice.2109

FFI Plugin:
Fix FFI in 64bits. The moduleHandle (a pointer) was incorrectly truncated to an int (32bits).

This can eventually work (by luck), but for large libraries like lapack, addresses get higher and luck seems unlikely...

Spur:
Have printEntity: print header flags for puns also.

SistaCogit:
Fix coging optimized methods with lots of literals.

Decode a method header when doing longPrintOop:.

Fix the ssFlushTo: call in genExtJumpIfNotInstanceOfBehaviorsBytecode

Use Spur's single-bit tests for immediates in the CogObjectRepresetationFor??BitSpur's branchIf:has[Not]ImmediateTag:target:

Remember to preserve BytecodeSetHasExtensions when constructing the Cogit hybrid bytecode tables (otherwise initExts dies in the Simulator, but not in C cuz nil = 0).

Fix conditional branches following inline primitive comparisons given the branch following logic.  The unconditional branch following can only be elided if jumping to the bytecode following the conditional branch, which mnay no longer be the case with branch following.  To this end refactor nextDescriptorAndExtensionsInto: into nextDescriptorExtensionsAndNextPCInto:.

SistaCogit Simulation:
Fix awful bug in disassembling Sista methods; the old code updated the global variable numCounters and used counters instead of the method's counters.

Add the initializers to check the surrogate accessrs for SistaCogMethod (consequently commit cosmetic changes to the surrogate counters accessors).

Simplify extJumpIfNotInstanceOfBehaviorsBytecode a bit.

Fix stack depth calculations for trap bytecodes and non-local returns in full blocks.

Fix frame pointer checking in handleCallOrJumpSimulationTrap: for primitiveSlotAtPut sent to a Context.

Neaten [detailed]symbolicMethod: eliding the VMProxy noise.

Fix Character printing in shortPrint: to add the $ in front of the character, not just the code.

Make debugBytecodePCs and debugOpcodeIndices specific to breakMethod if it is set.

Send Label to the right dude in noneImmediateBranchIf:notInstanceOfBehaviors:target:.

Hack around Pharo's String class>>findSubstringViaPrimitive:in:startingAt:matchTable: in the simulator.

Simulator:
Add click-step support to the interpreter (but the break-pointing facilities have yet to be harmonised).

Make sure the code below the guard page is ful of stop instructions.

Fix a simulation slip in printDecodeMethodHeaderOop:.


Can now simulate Clément's Scorch image enough to see the UI (FFI calls are not simulated so no getenv: hence no sources.  And a createDirectory: causes a primitive failed which shows up in the debugger in the simulation.)

=============== Diff against VMMaker.oscogSPC-cb.2105 ===============

Item was changed:
  ----- Method: CCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') -----
  compileToTMethodSelector: selector in: aClass
  	"Compile a method to a TMethod"
+ 	| implementingClass |
+ 	implementingClass := aClass.
- 
  	^(Compiler new
+ 		parse: ([aClass sourceCodeAt: selector]
+ 					on: KeyNotFound
+ 					do: [:ex| "Quick hack for simulating Pharo images..."
+ 						(PharoVM and: [aClass == String class and: [selector == #findSubstringViaPrimitive:in:startingAt:matchTable:]]) ifFalse:
+ 							[ex pass].
+ 						(implementingClass :=  ByteString) sourceCodeAt: #findSubstring:in:startingAt:matchTable:])
+ 		in: implementingClass
- 		parse: (aClass sourceCodeAt: selector)
- 		in: aClass
  		notifying: nil)
  			asTranslationMethodOfClass: self translationMethodClass!

Item was changed:
  ----- Method: CoInterpreter>>methodWithHeaderShouldBeCogged: (in category 'compiled methods') -----
  methodWithHeaderShouldBeCogged: methodHeader
  	"At the moment jit any method with less than N literals, where N defaults to 60.
  	 See e.g. SimpleStackBasedCogit class>>initialize.
  	 In my dev image eem 2/22/2009 13:39
  		(30 to: 100 by: 5) collect:
  			[:n| n -> (SystemNavigation default allSelect: [:m| m numLiterals > n]) size]
  		#(30->1681 35->1150 40->765 45->523 50->389 55->289 60->206
  		    65->151 70->124 75->99 80->73 85->63 90->54 95->42 100->38).
  	 And running the CogVMSimulator with flagging of interpreted methods turned on reveals
  	 the following sizes of interpreted methods.
  		| sizes |
  		sizes := Bag new.
  		SystemNavigation default allSelect: [:m| m flag ifTrue: [sizes add: m numLiterals]. false].
  		sizes sortedElements asArray
  			#(	40->4 41->1 42->2 44->1 45->3 46->1 47->2 48->1
  				50->2 51->1 53->1 55->1 56->1
  				87->1 108->1 171->1)
  	 literalCountOfHeader: does not include the header word."
+ 	^SistaVM
+ 		ifTrue: [(self isOptimizedMethodHeader: methodHeader)
+ 				or: [(objectMemory literalCountOfMethodHeader: methodHeader) <= maxLiteralCountForCompile]]
+ 		ifFalse: [(objectMemory literalCountOfMethodHeader: methodHeader) <= maxLiteralCountForCompile]!
- 	^(objectMemory literalCountOfMethodHeader: methodHeader) <= maxLiteralCountForCompile!

Item was changed:
  ----- Method: CoInterpreter>>printMethodHeaderOop: (in category 'debug printing') -----
  printMethodHeaderOop: anOop
  	"Print the CogMethod and its header if this is a CogMethod reference."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	(self isCogMethodReference: anOop) ifTrue:
  		[cogMethod := cogMethodZone methodFor: (self pointerForOop: anOop).
  		 cogMethod ~= 0 ifTrue:
+ 			[^self printHex: anOop; space; printDecodeMethodHeaderOop: cogMethod methodHeader]].
+ 	^self printDecodeMethodHeaderOop: anOop!
- 			[^self printHex: anOop; space; printOopShort: cogMethod methodHeader]].
- 	^self printOopShort: anOop!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>branchIf:hasImmediateTag:target: (in category 'sista support') -----
  branchIf: reg hasImmediateTag: classIndex target: targetFixUp
  	<var: #targetFixUp type: #'AbstractInstruction *'>
  	| jmpImmediate|
  	<inline: true>
- 	cogit MoveR: reg R: TempReg.
  	classIndex = objectMemory smallIntegerTag ifTrue:
+ 		[jmpImmediate := self genJumpSmallInteger: reg].
- 		[jmpImmediate := self genJumpSmallIntegerInScratchReg: TempReg].
  	classIndex = objectMemory characterTag ifTrue:
+ 		[cogit MoveR: reg R: TempReg.
+ 		 jmpImmediate := self genJumpCharacterInScratchReg: reg].
- 		[jmpImmediate := self genJumpCharacterInScratchReg: TempReg].
  	jmpImmediate jmpTarget: targetFixUp!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>branchIf:hasNotImmediateTag:target: (in category 'sista support') -----
  branchIf: reg hasNotImmediateTag: classIndex target: targetFixUp
  	<var: #targetFixUp type: #'AbstractInstruction *'>
+ 	| jmpImmediate |
- 	| jmpImmediate|
  	<inline: true>
- 	cogit MoveR: reg R: TempReg.
  	classIndex = objectMemory smallIntegerTag ifTrue:
+ 		[jmpImmediate := self genJumpNotSmallInteger: reg].
- 		[jmpImmediate := self genJumpNotSmallIntegerInScratchReg: TempReg].
  	classIndex = objectMemory characterTag ifTrue:
+ 		[cogit MoveR: reg R: TempReg.
+ 		 jmpImmediate := self genJumpNotCharacterInScratchReg: reg].
- 		[jmpImmediate := self genJumpNotCharacterInScratchReg: TempReg].
  	jmpImmediate jmpTarget: targetFixUp!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>branchIf:hasImmediateTag:target: (in category 'sista support') -----
  branchIf: reg hasImmediateTag: classIndex target: targetFixUp
  	<var: #targetFixUp type: #'AbstractInstruction *'>
+ 	| jmpImmediate |
- 	| jmpImmediate|
  	<inline: true>
- 	cogit MoveR: reg R: TempReg.
  	classIndex = objectMemory smallIntegerTag ifTrue:
+ 		[jmpImmediate := self genJumpSmallInteger: reg].
- 		[jmpImmediate := self genJumpSmallIntegerInScratchReg: TempReg].
  	classIndex = objectMemory characterTag ifTrue:
+ 		[jmpImmediate := self genJumpCharacter: reg].
- 		[jmpImmediate := self genJumpCharacterInScratchReg: TempReg].
  	classIndex = objectMemory smallFloatTag ifTrue:
+ 		[jmpImmediate := self genJumpSmallFloat: reg].
- 		[jmpImmediate := self genJumpSmallFloatInScratchReg: TempReg].
  	jmpImmediate jmpTarget: targetFixUp!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>branchIf:hasNotImmediateTag:target: (in category 'sista support') -----
  branchIf: reg hasNotImmediateTag: classIndex target: targetFixUp
  	<var: #targetFixUp type: #'AbstractInstruction *'>
+ 	| jmpImmediate |
- 	| jmpImmediate|
  	<inline: true>
- 	cogit MoveR: reg R: TempReg.
  	classIndex = objectMemory smallIntegerTag ifTrue:
+ 		[jmpImmediate := self genJumpNotSmallInteger: reg].
- 		[jmpImmediate := self genJumpNotSmallIntegerInScratchReg: TempReg].
  	classIndex = objectMemory characterTag ifTrue:
+ 		[jmpImmediate := self genJumpNotCharacter: reg].
- 		[jmpImmediate := self genJumpNotCharacterInScratchReg: TempReg].
  	classIndex = objectMemory smallFloatTag ifTrue:
+ 		[jmpImmediate := self genJumpNotSmallFloat: reg].
- 		[jmpImmediate := self genJumpNotSmallFloatInScratchReg: TempReg].
  	jmpImmediate jmpTarget: targetFixUp!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>noneImmediateBranchIf:notInstanceOfBehaviors:target: (in category 'sista support') -----
  noneImmediateBranchIf: reg notInstanceOfBehaviors: arrayObj target: targetFixUp
  	"All classes in arrayObj are not immediate"
  	| label numJumps jumps classObj |
- 	<var: #targetFixUp type: #'AbstractInstruction *'>
  	<var: #label type: #'AbstractInstruction *'>
  	<var: #jumps type: #'AbstractInstruction **'>
+ 	<var: #targetFixUp type: #'AbstractInstruction *'>
  	jumps := self alloca: (objectMemory numSlotsOf: arrayObj) type: (self cCode: [#'AbstractInstruction *'] inSmalltalk: [cogit backEnd class]).
  	(self genJumpImmediate: reg) jmpTarget: targetFixUp.
  	self genGetClassIndexOfNonImm: reg into: TempReg.
  	0 to: (numJumps := objectMemory numSlotsOf: arrayObj) - 1 do:
  		[:i|
  		 classObj := objectMemory fetchPointer: i ofObject: arrayObj.
  		 self genCmpClassIndex: (objectMemory classTagForClass: classObj) R: TempReg.
  		jumps at: i put: (cogit JumpZero: 0) ].
  	cogit Jump: targetFixUp.
+ 	label := cogit Label.
- 	label := self Label.
  	0 to: numJumps - 1 do: [:i |
  		(jumps at: i) jmpTarget: label ].
  	^0!

Item was changed:
  ----- Method: CogSistaMethodSurrogate32>>counters: (in category 'accessing') -----
  counters: aValue
  	^memory
+ 		unsignedLongAt: address + baseHeaderSize + 21
- 		unsignedLongAt: address + 21 + baseHeaderSize
  		put: aValue!

Item was changed:
  ----- Method: CogSistaMethodSurrogate64>>counters (in category 'accessing') -----
  counters
+ 	^memory unsignedLong64At: address + 33 + baseHeaderSize!
- 	^memory long64At: address + 33 + baseHeaderSize!

Item was changed:
  ----- Method: CogSistaMethodSurrogate64>>counters: (in category 'accessing') -----
  counters: aValue
  	^memory
+ 		unsignedLong64At: address + baseHeaderSize + 33
- 		long64At: address + 33 + baseHeaderSize
  		put: aValue!

Item was added:
+ ----- Method: CogVMSimulator>>atEachStepBlock (in category 'accessing') -----
+ atEachStepBlock
+ 	^atEachStepBlock!

Item was added:
+ ----- Method: CogVMSimulator>>atEachStepBlock: (in category 'accessing') -----
+ atEachStepBlock: aBlock
+ 	atEachStepBlock := aBlock!

Item was added:
+ ----- Method: CogVMSimulator>>localIP (in category 'accessing') -----
+ localIP
+ 	^localIP!

Item was changed:
  ----- Method: CogVMSimulator>>maybeCheckStackDepth:sp:pc: (in category 'debug support') -----
  maybeCheckStackDepth: delta sp: sp pc: mcpc
  	| asp bcpc startbcpc cogHomeMethod cogBlockMethod csp debugStackPointers |
  	debugStackDepthDictionary ifNil: [^self].
  	(self isMachineCodeFrame: framePointer) ifFalse: [^self].
  	cogBlockMethod := self mframeCogMethod: framePointer.
  	cogHomeMethod := self asCogHomeMethod: cogBlockMethod.
  	debugStackPointers := debugStackDepthDictionary
  								at: cogHomeMethod methodObject
  								ifAbsentPut: [self debugStackPointersFor: cogHomeMethod methodObject].
  	startbcpc := cogHomeMethod = cogBlockMethod
  					ifTrue: [self startPCOfMethod: cogHomeMethod methodObject]
  					ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)].
  	bcpc := cogit bytecodePCFor: mcpc startBcpc: startbcpc in: cogBlockMethod.
  	self assert: bcpc ~= 0.
+ 	((cogBlockMethod ~= cogHomeMethod or: [cogBlockMethod cmIsFullBlock])
- 	(cogBlockMethod ~= cogHomeMethod
  	 and: [cogit isNonLocalReturnPC: mcpc]) ifTrue:
  		[| lastbcpc |
  		 "Method returns within a block (within an unwind-protect) must check the stack depth at the
  		  return, not the bytecode following, but the pc mapping maps to the bytecode following the
  		  return. lastBytecodePCForBlockAt:in: catches method returns at the end of a block, modifying
  		  the bcpc to that of the return.  isNonLocalReturnPC: catches method returns not at the end.
  		  Assumes method return bytecodes are 1 bytecode long;a  dodgy assumption, but good enough."
+ 		 lastbcpc := cogBlockMethod cmIsFullBlock
+ 						ifTrue: [cogit endPCOf: cogHomeMethod methodObject]
+ 						ifFalse: [cogit lastBytecodePCForBlockAt: startbcpc in: cogHomeMethod methodObject].
- 		 lastbcpc := cogit lastBytecodePCForBlockAt: startbcpc in: cogHomeMethod methodObject.
  		 bcpc := bcpc > lastbcpc ifTrue: [lastbcpc] ifFalse: [bcpc - 1]].
  	asp := self stackPointerIndexForFrame: framePointer WithSP: sp + objectMemory wordSize.
  	csp := debugStackPointers at: bcpc ifAbsent: [-1].
+ 	"Compensate for some edge cases"
+ 	asp - delta = csp ifTrue:
+ 		["Compensate for the implicit context receiver push in a trap bytecode with the absence of a contnuation.
+ 		  Assumes trap bytecodes are 1 byte bytecodes."
+ 		 (SistaVM
+ 		  and: [cogit isTrapAt: mcpc]) ifTrue:
+ 			[csp := csp + 1].
+ 		"Compensate lazily for absent receiver sends (cuz mapping is slow, even though incrememting csp is a dodgy idea)."
+ 		(NewspeakVM
+ 		 and: [cogit isAbsentReceiverSendAt: mcpc in: cogHomeMethod]) ifTrue:
+ 			[csp := debugStackPointers at: bcpc put: csp + 1]].
- 	"Compensate lazily for absent receiver sends."
- 	(NewspeakVM
- 	 and: [asp - delta = csp
- 	 and: [cogit isAbsentReceiverSendAt: mcpc in: cogHomeMethod]]) ifTrue:
- 		[csp := debugStackPointers at: bcpc put: csp + 1].
  	self assert: asp - delta + 1 = csp!

Item was changed:
  ----- Method: Cogit class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid
  	"SimpleStackBasedCogit initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
  	"StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
  
  	| v3Table v4Table |
  	"N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize et al correctly."
  	self initializeBytecodeTableForNewspeakV4.
  	v4Table := generatorTable.
  	AltBlockCreationBytecodeSize := BlockCreationBytecodeSize.
  	AltNSSendIsPCAnnotated := NSSendIsPCAnnotated.
  	AltFirstSpecialSelector := FirstSpecialSelector.
  	AltNumSpecialSelectors := NumSpecialSelectors.
  	self initializeBytecodeTableForSqueakV3PlusClosures.
+ 	BytecodeSetHasExtensions := true.
  	v3Table := generatorTable.
  	generatorTable := CArrayAccessor on: v3Table object, v4Table object!

Item was changed:
  ----- Method: Cogit class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in category 'class initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
  	"SimpleStackBasedCogit initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
  	"StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
  
  	| v3Table v1Table |
  	"N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize et al correctly."
  	self initializeBytecodeTableForSistaV1.
  	v1Table := generatorTable.
  	AltBlockCreationBytecodeSize := BlockCreationBytecodeSize.
  	AltFirstSpecialSelector := FirstSpecialSelector.
  	AltNumSpecialSelectors := NumSpecialSelectors.
  	self initializeBytecodeTableForSqueakV3PlusClosures.
+ 	BytecodeSetHasExtensions := true.
  	v3Table := generatorTable.
  	generatorTable := CArrayAccessor on: v3Table object, v1Table object!

Item was changed:
  ----- Method: Cogit>>abstractInstructionAt: (in category 'compile abstract instructions') -----
  abstractInstructionAt: index
  	<cmacro: '(index) (&abstractOpcodes[index])'>
+ 	((debugOpcodeIndices includes: index)
+ 	 and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
+ 		[self halt].
- 	(debugOpcodeIndices includes: index) ifTrue: [self halt].
  	^abstractOpcodes at: index!

Item was changed:
+ ----- Method: Cogit>>generateCogFullBlock (in category 'generate machine code') -----
- ----- Method: Cogit>>generateCogFullBlock (in category 'compile abstract instructions') -----
  generateCogFullBlock
  	"We handle jump sizing simply.  First we make a pass that asks each
  	 instruction to compute its maximum size.  Then we make a pass that
  	 sizes jumps based on the maxmimum sizes.  Then we make a pass
  	 that fixes up jumps.  When fixing up a jump the jump is not allowed to
  	 choose a smaller offset but must stick to the size set in the second pass."
  	<returnTypeC: #'CogMethod *'>
  	<option: #SistaV1BytecodeSet>
  	| codeSize headerSize mapSize totalSize startAddress result method |
  	<var: #method type: #'CogMethod *'>
  	headerSize := self sizeof: CogMethod.
  	methodLabel address: methodZone freeStart.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: methodZone freeStart.
  	codeSize := self generateInstructionsAt: methodLabel address + headerSize.
  	mapSize := self generateMapAt: nil start: methodLabel address + cbNoSwitchEntryOffset.
  .
  	totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize.
  	totalSize > MaxMethodSize ifTrue:
  		[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	startAddress := methodZone allocate: totalSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	self assert: startAddress + cbEntryOffset = fullBlockEntry address.
  	self assert: startAddress + cbNoSwitchEntryOffset = fullBlockNoContextSwitchEntry address.
  	result := self outputInstructionsAt: startAddress + headerSize.
  	self assert: startAddress + headerSize + codeSize = result.
  	backEnd padIfPossibleWithStopsFrom: result to: startAddress + totalSize - mapSize - 1.
  	self generateMapAt: startAddress + totalSize - 1 start: startAddress + cbNoSwitchEntryOffset.
  	self flag: #TOCHECK. "It's not clear we want the same header than regular methods. 
  	It could be of the same size, but maybe the cmType could be different and the selector could be ignored." 
  	method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  					size: totalSize
  					selector: objectMemory nilObject.
  	method cpicHasMNUCaseOrCMIsFullBlock: true.
  	postCompileHook ifNotNil:
  		[self perform: postCompileHook with: method.
  		 postCompileHook := nil].
  	^method!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function result savedFramePointer savedStackPointer savedArgumentCount rpc |
  	evaluable := simulatedTrampolines at: aProcessorSimulationTrap address.
  	function := evaluable isBlock
  					ifTrue: ['aBlock; probably some plugin primitive']
  					ifFalse:
  						[evaluable receiver == backEnd ifTrue:
  							[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
  						 evaluable selector].
  	function ~~ #ceBaseFrameReturn: ifTrue:
  		[coInterpreter assertValidExternalStackPointers].
  	(function beginsWith: 'ceShort') ifTrue:
  		[^self perform: function with: aProcessorSimulationTrap].
  	aProcessorSimulationTrap type = #call
  		ifTrue:
  			[processor
  				simulateCallOf: aProcessorSimulationTrap address
  				nextpc: aProcessorSimulationTrap nextpc
  				memory: coInterpreter memory.
  			self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
  		ifFalse:
  			[processor
  				simulateJumpCallOf: aProcessorSimulationTrap address
  				memory: coInterpreter memory.
  			 self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
  	savedFramePointer := coInterpreter framePointer.
  	savedStackPointer := coInterpreter stackPointer.
  	savedArgumentCount := coInterpreter argumentCount.
  	result := ["self halt: evaluable selector."
  		   	   ((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
  			 	[(self confirm: 'skip run-time call?') ifFalse:
  					[clickConfirm := false. self halt]].
  			   evaluable valueWithArguments: (processor
  												postCallArgumentsNumArgs: evaluable numArgs
  												in: coInterpreter memory)]
  				on: ReenterMachineCode
  				do: [:ex| ex return: ex returnValue].
  			
  	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 checkForLastObjectOverwrite.
  		 coInterpreter primFailCode = 0
  			ifTrue: [(#(	primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
  						primitiveFullClosureValue primitiveFullClosureValueWithArgs primitiveFullClosureValueNoContextSwitch
  						primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
  						primitiveExecuteMethodArgsArray primitiveExecuteMethod
  						primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
  						primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
  							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]]]
- 						[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: coInterpreter memory. ')'}.
  		 rpc := processor retpcIn: coInterpreter memory.
  		 self assert: (rpc >= codeBase and: [rpc < methodZone freeStart]).
  		 processor
  			smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize;
  			simulateReturnIn: coInterpreter memory].
  	self assert: (result isInteger "an oop result"
  			or: [result == coInterpreter
  			or: [result == objectMemory
  			or: [#(nil continue continueNoReturn) includes: result]]]).
  	processor cResultRegister: (result
  							ifNil: [0]
  							ifNotNil: [result isInteger
  										ifTrue: [result]
  										ifFalse: [16rF00BA222]])
  
  	"coInterpreter cr.
  	 processor sp + 32 to: processor sp - 32 by: -4 do:
  		[:sp|
  		 sp = processor sp
  			ifTrue: [coInterpreter print: 'sp->'; tab]
  			ifFalse: [coInterpreter printHex: sp].
  		 coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!

Item was changed:
  ----- Method: Cogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
  initializeCodeZoneFrom: startAddress upTo: endAddress
  	<api>
  	self initializeBackend.
  	backEnd stopsFrom: startAddress to: endAddress - 1.
  	self cCode: [self sqMakeMemoryExecutableFrom: startAddress To: endAddress]
+ 		inSmalltalk:
+ 			[startAddress = self class guardPageSize ifTrue:
+ 				[backEnd stopsFrom: 0 to: endAddress - 1].
+ 			 self initializeProcessor].
- 		inSmalltalk: [self initializeProcessor].
  	codeBase := methodZoneBase := startAddress.
  	minValidCallAddress := (codeBase min: coInterpreter interpretAddress)
  								min: coInterpreter primitiveFailAddress.
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	self maybeGenerateCheckFeatures.
  	self maybeGenerateICacheFlush.
  	self generateVMOwnerLockFunctions.
  	self genGetLeafCallStackPointer.
  	self generateStackPointerCapture.
  	self generateTrampolines.
  	self computeEntryOffsets.
  	self computeFullBlockEntryOffsets.
  	self generateClosedPICPrototype.
  	"repeat so that now the methodZone ignores the generated run-time"
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	"N.B. this is assumed to be the last thing done in initialization; see Cogit>>initialized"
  	self generateOpenPICPrototype!

Item was changed:
  ----- Method: Cogit>>isNonLocalReturnPC: (in category 'jit - api') -----
  isNonLocalReturnPC: retpc
  	<doNotGenerate>
  	"Answer if the instruction preceding retpc is a call instruction."
+ 	^(backEnd isCallPrecedingReturnPC: retpc)
+ 	 and: [(backEnd callTargetFromReturnAddress: retpc) = ceNonLocalReturnTrampoline]!
- 	(backEnd isCallPrecedingReturnPC: retpc) ifFalse:
- 		[^false].
- 	^(backEnd callTargetFromReturnAddress: retpc) = ceNonLocalReturnTrampoline!

Item was changed:
  ----- Method: Cogit>>maybeHaltIfDebugPC (in category 'compile abstract instructions') -----
  maybeHaltIfDebugPC 
  	<cmacro: '() 0'> "Simulation only; void in C"
+ 	((debugBytecodePointers includes: bytecodePC)
+ 	 and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
- 	(debugBytecodePointers includes: bytecodePC) ifTrue:
  		[self halt]!

Item was removed:
- ----- Method: Cogit>>nextDescriptorAndExtensionsInto: (in category 'bytecode generator support') -----
- nextDescriptorAndExtensionsInto: aTrinaryBlock
- 	"Peek ahead and deliver the next descriptor plus extension bytes."
- 	<inline: true>
- 	| savedB0 savedB1 savedB2 savedB3 savedEA savedEB savedNEB descriptor bcpc |
- 	<var: #descriptor type: #'BytecodeDescriptor *'>
- 	descriptor := self generatorAt: byte0.
- 	savedB0 := byte0. savedB1 := byte1. savedB2 := byte2. savedB3 := byte3.
- 	savedEA := extA. savedEB := extB. savedNEB := numExtB.
- 	bcpc := bytecodePC + descriptor numBytes.
- 	[bcpc > endPC ifTrue:
- 		[^aTrinaryBlock value: nil value: 0 value: 0].
- 	 byte0 := (objectMemory fetchByte: bcpc ofObject: methodObj)  + bytecodeSetOffset.
- 	 descriptor := self generatorAt: byte0.
- 	 self loadSubsequentBytesForDescriptor: descriptor at: bcpc.
- 	 descriptor isExtension ifFalse:
- 		[| eA eB |
- 		 eA := extA. eB := extB.
- 		 extA := savedEA. extB := savedEB. numExtB := savedNEB.
- 		 byte0 := savedB0. byte1 := savedB1. byte2 := savedB2. byte3 := savedB3.
- 	 	 ^aTrinaryBlock value: descriptor value: eA value: eB].
- 	 self perform: descriptor generator.
- 	 bcpc := bcpc + descriptor numBytes.
- 	 true] whileTrue!

Item was added:
+ ----- Method: Cogit>>nextDescriptorExtensionsAndNextPCInto: (in category 'bytecode generator support') -----
+ nextDescriptorExtensionsAndNextPCInto: aQuaternaryBlock
+ 	"Peek ahead and deliver the next descriptor, extension bytes and next pc."
+ 	<inline: true>
+ 	| savedB0 savedB1 savedB2 savedB3 savedEA savedEB savedNEB descriptor bcpc |
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	descriptor := self generatorAt: byte0.
+ 	savedB0 := byte0. savedB1 := byte1. savedB2 := byte2. savedB3 := byte3.
+ 	savedEA := extA. savedEB := extB. savedNEB := numExtB.
+ 	bcpc := bytecodePC + descriptor numBytes.
+ 	[bcpc > endPC ifTrue:
+ 		[^aQuaternaryBlock value: nil value: 0 value: 0 value: 0].
+ 	 byte0 := (objectMemory fetchByte: bcpc ofObject: methodObj)  + bytecodeSetOffset.
+ 	 descriptor := self generatorAt: byte0.
+ 	 self loadSubsequentBytesForDescriptor: descriptor at: bcpc.
+ 	 descriptor isExtension ifFalse:
+ 		[| eA eB |
+ 		 eA := extA. eB := extB.
+ 		 extA := savedEA. extB := savedEB. numExtB := savedNEB.
+ 		 byte0 := savedB0. byte1 := savedB1. byte2 := savedB2. byte3 := savedB3.
+ 	 	 ^aQuaternaryBlock value: descriptor value: eA value: eB value: bcpc].
+ 	 self perform: descriptor generator.
+ 	 bcpc := bcpc + descriptor numBytes.
+ 	 true] whileTrue!

Item was changed:
  ----- Method: Cogit>>setClickStepBreakBlock (in category 'simulation only') -----
  setClickStepBreakBlock
  	"Set the break block to present a confirmer, breaking if true, and restoring the previous break block.
  	 If an open debugger on the receiver can be found, proceed it."
  	<doNotGenerate>
+ 	| previousBreakBlock previousAtEachStepBlock previousBreakPC previousSingleStep previousClickConfirm |
- 	| previousBreakBlock previousBreakPC previousSingleStep previousClickConfirm |
  	(breakBlock isNil or: [breakBlock method ~~ thisContext method]) ifTrue:
  		[previousBreakBlock := breakBlock.
+ 		 previousAtEachStepBlock := coInterpreter atEachStepBlock.
  		 previousBreakPC := breakPC.
  		 previousSingleStep := singleStep.
  		 previousClickConfirm := clickConfirm.
  		 breakBlock := [:ign|
  						(processor pc ~= previousBreakPC
  						 and: [UIManager confirm: 'step?'])
  							ifTrue: [false]
  							ifFalse: [breakBlock := previousBreakBlock.
+ 									coInterpreter atEachStepBlock: previousAtEachStepBlock.
  									breakPC := previousBreakPC.
  									singleStep := previousSingleStep.
  									clickConfirm := previousClickConfirm.
  									true]].
+ 		 coInterpreter atEachStepBlock:
+ 								[previousAtEachStepBlock value.
+ 								 (coInterpreter localIP ~= previousBreakPC
+ 								  and: [UIManager confirm: 'step?']) ifFalse:
+ 									[breakBlock := previousBreakBlock.
+ 									coInterpreter atEachStepBlock: previousAtEachStepBlock.
+ 									breakPC := previousBreakPC.
+ 									singleStep := previousSingleStep.
+ 									clickConfirm := previousClickConfirm.
+ 									self halt]].
  		 singleStep := breakPC := clickConfirm := true].
  	(World submorphs
  		detect:
  			[:m|
  			 m model class == Debugger
  			 and: [(m model interruptedProcess suspendedContext findContextSuchThat:
  					[:ctxt|
+ 					(ctxt receiver == self
+ 					 and: [ctxt selector == #simulateCogCodeAt:])
+ 					or: [ctxt receiver == coInterpreter
+ 					 and: [ctxt selector == #interpret]]]) notNil]]
- 					ctxt receiver == self
- 					and: [ctxt selector == #simulateCogCodeAt:]]) notNil]]
  		ifNone: []) ifNotNil:
  			[:debuggerWindow|
  			 WorldState addDeferredUIMessage:
  				[debuggerWindow model proceed]]!

Item was changed:
  ----- Method: InterpreterPlugin class>>methodForTranslatedPrimitiveTuple: (in category 'translated primitives') -----
  methodForTranslatedPrimitiveTuple: tuple
  	| class |
  	class := Smalltalk classNamed: tuple first.
  	^class
  		compiledMethodAt: tuple last
+ 		ifAbsent:
+ 			[class class
+ 				compiledMethodAt: tuple last
+ 				ifAbsent: [tuple = #(String findSubstringViaPrimitive:in:startingAt:matchTable:) ifTrue:
+ 							[ByteString compiledMethodAt: #findSubstring:in:startingAt:matchTable:]]]!
- 		ifAbsent: [class class compiledMethodAt: tuple last]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPushLiteralVariableGivenDirectedSuper: (in category 'bytecode generator support') -----
  genPushLiteralVariableGivenDirectedSuper: literalIndex
  	"This is a version of genPushLiteralVariable: that looks ahead for a directed super send bytecode
  	 and does not generate any code for the dereference yet if followed by a directed super send."
  	<inline: false>
+ 	self nextDescriptorExtensionsAndNextPCInto:
+ 		[:descriptor :exta :extb :followingPC|
- 	self nextDescriptorAndExtensionsInto:
- 		[:descriptor :exta :extb|
  		(self isDirectedSuper: descriptor extA: exta extB: extb) ifTrue:
  			[tempOop := self getLiteral: literalIndex.
  			 ^0]].
  	^self genPushLiteralVariable: literalIndex!

Item was added:
+ ----- Method: SistaCogMethod class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"self initialize"
+ 	(Smalltalk classNamed: #CogSistaMethodSurrogate32) ifNotNil:
+ 		[:cms32|
+ 		self checkGenerateSurrogate: cms32 bytesPerWord: 4].
+ 	(Smalltalk classNamed: #CogSistaMethodSurrogate64) ifNotNil:
+ 		[:cms64|
+ 		self checkGenerateSurrogate: cms64 bytesPerWord: 8]!

Item was changed:
  ----- Method: SistaCogit>>disassembleMethod:on: (in category 'disassembly') -----
  disassembleMethod: surrogateOrAddress on: aStream
  	<doNotGenerate>
  	| cogMethod |
  	cogMethod := super disassembleMethod: surrogateOrAddress on: aStream.
  	(cogMethod cmType = CMMethod
  	 and: [cogMethod counters ~= 0]) ifTrue:
  		[aStream nextPutAll: 'counters:'; cr.
+ 		 0 to: (objectRepresentation numCountersFor: cogMethod counters) - 1 do:
- 		 numCounters := objectRepresentation numCountersFor: counters.
- 		 0 to: numCounters - 1 do:
  			[:i| | addr |
  			 addr := i * CounterBytes + counters.
  			 addr printOn: aStream base: 16.
  			 aStream nextPut: $:; space.
  			 (objectMemory long32At: addr) printOn: aStream base: 16.
  			 aStream cr].
  		 aStream flush]!

Item was changed:
  ----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
  genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
  	"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	| nextPC branchDescriptor targetBytecodePC postBranchPC |	
  		
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
+ 
- 	
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
  		ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
  			[ (self fixupAt: nextPC - initialPC) notAFixup
  				ifTrue: "The next instruction is dead.  we can skip it."
  					[deadCode := true.
  				 	 self ensureFixupAt: targetBytecodePC - initialPC.
  					 self ensureFixupAt: postBranchPC - initialPC ]
  				ifFalse:
  					[self ssPushConstant: objectMemory trueObject]. "dummy value"
  			self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
+ 				operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
+ 			"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
+ 			 Branch following means it may not be."
+ 			self nextDescriptorExtensionsAndNextPCInto:
+ 				[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
+ 			(deadCode and: [nextPC = postBranchPC]) ifFalse:
+ 				[ self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC) ] ]
- 				operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger. 
- 			deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC) ] ]
  		ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
  			[| condJump jump |
  			condJump := self genConditionalBranch: opTrue operand: 0.
  			self genMoveFalseR: destReg.
  	 		jump := self Jump: 0.
  			condJump jmpTarget: (self genMoveTrueR: destReg).
  			jump jmpTarget: self Label].
  	^ 0!

Item was changed:
  ----- Method: SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
  genExtJumpIfNotInstanceOfBehaviorsBytecode
  	"SistaV1: *	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
  	| reg literal distance targetFixUp inverse |
  
  	"We lose the information of in which register is stack top 
  	 when jitting the branch target so we need to flush everything. 
  	 We could use a fixed register here...."
  	reg := self allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: reg.
- 	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
  	self ssPop: 1.
+ 	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
  
  	literal := self getLiteral: (extA * 256 + byte1).
  	(inverse := extB < 0) ifTrue:
  		[extB := extB + 128].
  	distance := extB * 256 + byte2.
  	extA := extB := numExtB := 0.
  
  	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
  	inverse
  		ifFalse: 
  			[(objectMemory isArrayNonImm: literal)
  				ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
  				ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
  		ifTrue:
  			[(objectMemory isArrayNonImm: literal)
  				ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
  				ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
  
  	^0!

Item was added:
+ ----- Method: SistaCogit>>isTrapAt: (in category 'simulation only') -----
+ isTrapAt: retpc
+ 	"For stack depth checking."
+ 	<doNotGenerate>
+ 	^(backEnd isCallPrecedingReturnPC: retpc)
+ 	 and: [(backEnd callTargetFromReturnAddress: retpc) = ceTrapTrampoline]!

Item was changed:
  ----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') -----
  printEntity: oop
  	<api>
+ 	| printFlags |
+ 	printFlags := false.
- 	| isObj |
- 	isObj := false.
  	coInterpreter printHex: oop; space.
  	(self addressCouldBeObj: oop) ifFalse:
  		[^coInterpreter print: ((self isImmediate: oop) ifTrue: ['immediate'] ifFalse: ['unknown'])].
  	coInterpreter
  		print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse:
  				[(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse:
  				[(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse:
+ 				[(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: [printFlags := true. 'pun/obj stack'] ifFalse:
+ 				[printFlags := true. 'object']]]]);
- 				[(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: ['pun/obj stack'] ifFalse:
- 				[isObj := true. 'object']]]]);
  		space; printHexnpnp: (self rawNumSlotsOf: oop); print: '/'; printHexnpnp: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop).
+ 	printFlags ifTrue:
- 	isObj ifTrue:
  		[coInterpreter
  			space;
  			print: ((self formatOf: oop) <= 16rF ifTrue: ['f:0'] ifFalse: ['f:']);
  			printHexnpnp: (self formatOf: oop);
  			print: ((self isGrey: oop) ifTrue: [' g'] ifFalse: [' .']);
  			print: ((self isImmutable: oop) ifTrue: ['i'] ifFalse: ['.']);
  			print: ((self isMarked: oop) ifTrue: ['m'] ifFalse: ['.']);
  			print: ((self isPinned: oop) ifTrue: ['p'] ifFalse: ['.']);
  			print: ((self isRemembered: oop) ifTrue: ['r'] ifFalse: ['.'])].
  	coInterpreter cr!

Item was added:
+ ----- Method: StackDepthFinder>>branchIfInstanceOf:distance: (in category 'instruction decoding') -----
+ branchIfInstanceOf: behaviorOrArrayOfBehavior distance: delta
+ 	self drop.
+ 	self doJump: delta!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid
  	"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
  
  	| v3Table v4Table |
  	self initializeBytecodeTableForNewspeakV4.
  	v4Table := BytecodeTable.
  	AltBytecodeEncoderClassName := BytecodeEncoderClassName.
  	AltLongStoreBytecode := LongStoreBytecode.
  	self initializeBytecodeTableForSqueakV3PlusClosures.
+ 	BytecodeSetHasExtensions := true.
  	v3Table := BytecodeTable.
  	BytecodeTable := v3Table, v4Table!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in category 'initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
  	"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
  
  	| v3Table v1Table |
  	self initializeBytecodeTableForSistaV1.
  	v1Table := BytecodeTable.
  	AltBytecodeEncoderClassName := BytecodeEncoderClassName.
  	AltLongStoreBytecode := LongStoreBytecode.
  	self initializeBytecodeTableForSqueakV3PlusClosures.
+ 	BytecodeSetHasExtensions := true.
  	v3Table := BytecodeTable.
  	BytecodeTable := v3Table, v1Table!

Item was changed:
  ----- Method: StackInterpreter>>detailedSymbolicMethod: (in category 'debug support') -----
  detailedSymbolicMethod: aMethod
  	<doNotGenerate>
+ 	 self transcript
+ 		ensureCr;
+ 		nextPutAll:
+ 			((String streamContents:
+ 				[:ts| | prim proxy |
+ 				(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
+ 					[ts nextPutAll: '<primitive: '; print: prim; nextPut: $>.
+ 					(self isQuickPrimitiveIndex: prim) ifTrue:
+ 						[ts nextPutAll: ' quick method'; cr; flush.
+ 						 ^self].
+ 					ts cr].
+ 				proxy := VMCompiledMethodProxy new
+ 								for: aMethod
+ 								coInterpreter: self
+ 								objectMemory: objectMemory.
+ 				(DetailedInstructionPrinter on: proxy)
+ 					stackHeightComputer: (StackDepthFinder on: proxy);
+ 					indent: 0;
+ 					printInstructionsOn: ts]) copyReplaceAll: 'a VMObjectProxy for ' with: '');
+ 		flush!
- 	| ts prim proxy |
- 	(ts := self transcript) ensureCr.
- 	(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
- 		[ts nextPutAll: '<primitive: '; print: prim; nextPut: $>.
- 		(self isQuickPrimitiveIndex: prim) ifTrue:
- 			[ts nextPutAll: ' quick method'; cr; flush.
- 			 ^self].
- 		ts cr].
- 	proxy := VMCompiledMethodProxy new
- 					for: aMethod
- 					coInterpreter: self
- 					objectMemory: objectMemory.
- 	(DetailedInstructionPrinter on: proxy)
- 		stackHeightComputer: (StackDepthFinder on: proxy);
- 		indent: 0;
- 		printInstructionsOn: ts.
- 	ts flush!

Item was changed:
  ----- Method: StackInterpreter>>extJumpIfNotInstanceOfBehaviorsBytecode (in category 'sista bytecodes') -----
  extJumpIfNotInstanceOfBehaviorsBytecode
  	"254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
  	| tosClassTag literal distance inverse |
  	SistaVM ifFalse: [^self respondToUnknownBytecode].
+ 	self assert: ((extB bitAnd: 128) = 0 or: [extB < 0]).
+ 	(inverse := extB < 0) ifTrue:
+ 		[extB := extB + 128].
- 	extB < 0 
- 		ifTrue: [extB := extB + 128. inverse := true]
- 		ifFalse: [inverse := false].
  	tosClassTag := objectMemory fetchClassTagOf: self internalPopStack.
  	literal := self literal: extA << 8 + self fetchByte.
  	distance := extB << 8 + self fetchByte.
+ 	extA := extB := numExtB := 0.
+ 
+ 	(objectMemory isArrayNonImm: literal) ifTrue:
+ 		[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do:
+ 			[:i |
+ 			 tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal)) ifTrue:
+ 				[inverse ifTrue: [ localIP := localIP + distance ].
+ 				 ^self fetchNextBytecode ] ].
+ 		 inverse ifFalse: [localIP := localIP + distance].
+ 		 ^self fetchNextBytecode].
+ 
+ 	tosClassTag = (objectMemory rawClassTagForClass: literal) = inverse ifTrue:
+ 		[localIP := localIP + distance].
- 	extA := 0.
- 	extB := 0.
- 	numExtB := 0.
- 	(objectMemory isArrayNonImm: literal)
- 		ifTrue:
- 			[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do: [:i |
- 				tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))
- 					ifTrue: [ 
- 						inverse ifTrue: [ localIP := localIP + distance ].
- 						^ self fetchNextBytecode ] ].
- 			 inverse ifFalse: [localIP := localIP + distance].
- 			 ^ self fetchNextBytecode]
- 		ifFalse:
- 			[tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
- 				[inverse ifFalse: [localIP := localIP + distance].
- 				^ self fetchNextBytecode]].
- 	inverse ifTrue: [localIP := localIP + distance].
  	self fetchNextBytecode!

Item was added:
+ ----- Method: StackInterpreter>>printDecodeMethodHeaderOop: (in category 'printing') -----
+ printDecodeMethodHeaderOop: methodHeaderOop
+ 	self printOopShort: methodHeaderOop.
+ 	(self methodHeaderHasPrimitive: methodHeaderOop) ifTrue:
+ 		[self print: ' hasPrim'].
+ 	(self methodHeaderIndicatesLargeFrame: methodHeaderOop) ifTrue:
+ 		[self print: ' largeFrame'].
+ 	(SistaVM and: [self isOptimizedMethodHeader: methodHeaderOop]) ifTrue:
+ 		[self print: ' optimized'].
+ 	(MULTIPLEBYTECODESETS and: [objectMemory integerValueOf: methodHeaderOop]) < 0 ifTrue:
+ 		[self print: ' altSet'].
+ 	NewspeakVM ifTrue:
+ 		[self print: ((self accessModifierOfMethodHeader: methodHeaderOop) caseOf: {
+ 						[0] -> [' public'].
+ 						[1] -> [' private'].
+ 						[2] -> [' protected'].
+ 						[3] -> [' access undefined'] })].
+ 	self print: ' nLits '; printNum: (objectMemory literalCountOfMethodHeader: methodHeaderOop);
+ 		print: ' nArgs '; printNum: (self argumentCountOfMethodHeader: methodHeaderOop);
+ 		print: ' nTemps '; printNum: (self temporaryCountOfMethodHeader: methodHeaderOop)!

Item was changed:
  ----- Method: StackInterpreter>>printMethodHeaderOop: (in category 'debug printing') -----
  printMethodHeaderOop: anOop
  	"Override hook for CoInterpreter"
  	<inline: true>
+ 	^self printDecodeMethodHeaderOop: anOop!
- 	^self printOopShort: anOop!

Item was changed:
  ----- Method: StackInterpreter>>shortPrint: (in category 'simulation') -----
  shortPrint: oop
  	<doNotGenerate>
  	| name classOop |
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^(objectMemory characterValueOf: oop) < 256
  				ifTrue:
  					['=$', (objectMemory characterValueOf: oop) printString,
+ 					' ($', (String with: (Character value: (objectMemory characterValueOf: oop))), ')']
- 					' (', (String with: (Character value: (objectMemory characterValueOf: oop))), ')']
  				ifFalse:
+ 					['=$', (objectMemory characterValueOf: oop) printString, '($???)']].
- 					['=$', (objectMemory characterValueOf: oop) printString, '(???)']].
  		(objectMemory isIntegerObject: oop) ifTrue:
  			[^'=', (objectMemory integerValueOf: oop) printString,
  			' (', (objectMemory integerValueOf: oop) hex, ')'].
  		(objectMemory isImmediateFloat: oop) ifTrue:
  			[^ '=', (objectMemory floatValueOf: oop) printString, ' (', oop hex, ')'].
  		^'= UNKNOWN IMMEDIATE', ' (', (objectMemory integerValueOf: oop) hex, ')'].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  			ifTrue: [' is misaligned']
  			ifFalse: [self whereIs: oop]].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString,
  			(objectMemory hasSpurMemoryManagerAPI
  				ifTrue: [' 0th: ', (objectMemory fetchPointer: 0 ofFreeChunk: oop) hex]
  				ifFalse: [''])].
  	(objectMemory isForwarded: oop) ifTrue:
  		[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
  			' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
  	(objectMemory isFloatInstance: oop) ifTrue:
  		[^'=', (objectMemory dbgFloatValueOf: oop) printString].
  	oop = objectMemory nilObject ifTrue:
  		[^'nil'].
  	oop = objectMemory falseObject ifTrue:
  		[^'false'].
  	oop = objectMemory trueObject ifTrue:
  		[^'true'].
  
  	classOop := objectMemory fetchClassOfNonImm: oop.
  	((self objCouldBeClassObj: oop)
  	 and: [(objectMemory numSlotsOf: classOop) = metaclassNumSlots]) ifTrue:
  		[^'class ', (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	(#('String'  'ByteString') includes: name) ifTrue:
  		[^(self stringOf: oop) printString].
  	(#('Symbol'  'ByteSymbol') includes: name) ifTrue:
  		[^'#', (self stringOf: oop)].
  	name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters (see above); ObjectMemory does not"
  		[^'=', (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory isPointersNonImm: oop)
  	 and: [classOop ~= objectMemory nilObject
  	 and: [((objectMemory instanceSizeOf: classOop) between: ValueIndex + 1 and: ValueIndex + 2)
  	 and: [(objectMemory addressCouldBeObj: (objectMemory fetchPointer: KeyIndex ofObject: oop))]
  	 and: [(objectMemory isBytesNonImm: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]]) ifTrue:
  		[| classLookupKey |
  		 classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
  		 [classLookupKey = objectMemory nilObject ifTrue:
  			[^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name].
  		  (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
  			[classLookupKey := self superclassOf: classLookupKey].
  		 (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
  			[^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name,
  				' ', (self shortPrint: (objectMemory fetchPointer: KeyIndex ofObject: oop)),
  				' -> ',
  				(objectMemory fetchPointer: ValueIndex ofObject: oop) hex8]].
  
  	^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!

Item was changed:
  ----- Method: StackInterpreter>>symbolicMethod: (in category 'debug support') -----
  symbolicMethod: aMethod
  	<doNotGenerate>
+ 	 self transcript
+ 		ensureCr;
+ 		nextPutAll:
+ 			((String streamContents:
+ 				[:ts| | prim |
+ 				(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
+ 					[ts nextPutAll: '<primitive: '; print: prim; nextPut: $>.
+ 					(self isQuickPrimitiveIndex: prim) ifTrue:
+ 						[ts nextPutAll: ' quick method'; cr; flush.
+ 						 ^self].
+ 					ts cr].
+ 				(InstructionPrinter
+ 						on: (VMCompiledMethodProxy new
+ 								for: aMethod
+ 								coInterpreter: self
+ 								objectMemory: objectMemory))
+ 					indent: 0;
+ 					printInstructionsOn: ts]) copyReplaceAll: 'a VMObjectProxy for ' with: '');
+ 		flush!
- 	| ts prim |
- 	(ts := self transcript) ensureCr.
- 	(prim := self primitiveIndexOf: aMethod) > 0 ifTrue:
- 		[ts nextPutAll: '<primitive: '; print: prim; nextPut: $>.
- 		(self isQuickPrimitiveIndex: prim) ifTrue:
- 			[ts nextPutAll: ' quick method'; cr; flush.
- 			 ^self].
- 		ts cr].
- 	(InstructionPrinter
- 			on: (VMCompiledMethodProxy new
- 					for: aMethod
- 					coInterpreter: self
- 					objectMemory: objectMemory))
- 		indent: 0;
- 		printInstructionsOn: ts.
- 	ts flush!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>fixupAt: (in category 'compile abstract instructions') -----
  fixupAt: index
  	<cmacro: '(index) (&fixups[index])'>
  	<returnTypeC: #'BytecodeFixup *'>
+ 	((debugFixupBreaks includes: index)
+ 	 and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
- 	(debugFixupBreaks includes: index) ifTrue:
  		[self halt].
  	^self addressOf: (fixups at: index)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushLiteralVariableGivenDirectedSuper: (in category 'bytecode generator support') -----
  genPushLiteralVariableGivenDirectedSuper: literalIndex
  	"This is a version of genPushLiteralVariable: that looks ahead for a directed super send bytecode
  	 and does not generate any code for the dereference yet if followed by a directed super send."
  	<inline: false>
+ 	self nextDescriptorExtensionsAndNextPCInto:
+ 		[:descriptor :exta :extb :followingPC|
- 	self nextDescriptorAndExtensionsInto:
- 		[:descriptor :exta :extb|
  		(self isDirectedSuper: descriptor extA: exta extB: extb) ifTrue:
  			[self ssPushConstant: (self getLiteral: literalIndex).
  			 ^0]].
  	^self genPushLiteralVariable: literalIndex!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiLoadCalloutModule: (in category 'symbol loading') -----
  ffiLoadCalloutModule: module
  	"Load the given module and return its handle"
  	| moduleHandlePtr moduleHandle ffiModuleName moduleLength rcvr ptr |
+ 	<var: #ptr type:'sqInt *'>
- 	<var: #ptr type:'int *'>
  	(interpreterProxy isBytes: module) ifTrue:[
  		"plain module name"
  		ffiModuleName := module.
  		moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
  		moduleHandle := (interpreterProxy
  							ioLoadModule: (interpreterProxy firstIndexableField: ffiModuleName) asInteger
  							OfLength: moduleLength) asInteger.
  		(interpreterProxy failed
  		 or: [moduleHandle = 0]) ifTrue:
  			[^self ffiFail: FFIErrorModuleNotFound]. "failed"
  		^moduleHandle].
  	"Check if the external method is defined in an external library"
  	rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
  	(interpreterProxy is: rcvr KindOfClass: interpreterProxy classExternalLibrary) ifFalse:
  		[^self ffiFail: FFIErrorNoModule].
  	"external library"
  	moduleHandlePtr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
  	moduleHandle := self ffiContentsOfHandle: moduleHandlePtr errCode: FFIErrorBadExternalLibrary.
  	interpreterProxy failed ifTrue:[^0].
  	moduleHandle = 0 ifTrue:["need to reload module"
  		ffiModuleName := interpreterProxy fetchPointer: 1 ofObject: rcvr.
  		(interpreterProxy isBytes: ffiModuleName) ifFalse:[^self ffiFail: FFIErrorBadExternalLibrary].
  		moduleLength := interpreterProxy byteSizeOf: ffiModuleName.
  		moduleHandle := (interpreterProxy
  								ioLoadModule: (interpreterProxy firstIndexableField: ffiModuleName) asInteger
  								OfLength: moduleLength) asInteger.
  		(interpreterProxy failed
  		 or: [moduleHandle = 0]) ifTrue:
  			[^self ffiFail: FFIErrorModuleNotFound]. "failed"
  		"and store back"
  		ptr := interpreterProxy firstIndexableField: moduleHandlePtr.
  		ptr at: 0 put: moduleHandle].
  	^moduleHandle!



More information about the Vm-dev mailing list