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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 5 13:05:36 UTC 2016


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

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

Name: VMMaker.oscog-eem.1937
Author: eem
Time: 5 September 2016, 3:02:50.857506 pm
UUID: 008acbc6-1023-4f2c-a97a-5449ff1acfbb
Ancestors: VMMaker.oscog-cb.1936

More full block support.

Find the home of a full block for context printing. Fix opc mapping for full block closures (mustMapMachineCodePC:context:).

In the Cogit change inBlock to be an integer value, 0 for methods, 1 for vannilla blocks and 2 for full blocks (to reuce the amount of refactoring now and when removing vanilla block support some time in the future).

Add trampolines for creating small and large full block contexts in the Spur object representation.

Get frameless full block prolog generation more correct than it was ;-)

=============== Diff against VMMaker.oscog-cb.1936 ===============

Item was changed:
  ----- Method: CoInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  	"Similar to activateNewMethod but for Closure and newMethod."
  	| numCopied theMethod methodHeader numTemps inInterpreter switched |
  	<inline: true>
  	numCopied := self copiedValueCountOfFullClosure: blockClosure.
  	theMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
  	self assert: (objectMemory isOopCompiledMethod: theMethod).
  	methodHeader := self rawHeaderOf: theMethod.
  	(self isCogMethodReference: methodHeader) ifTrue:
  		[^self
  			executeFullCogBlock: (self cogMethodOf: theMethod)
  			closure: blockClosure
  			mayContextSwitch: mayContextSwitch].
  	"How do we know when to compile a block method?
  	 One simple criterion is to check if the block is running within its inner context,
  	 i.e. if the outerContext is married.
  	 Even simpler is to remember the previous block entered via the interpreter and
  	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
  	 method unless we try and remember which ones can't be cogged.  So also record
  	 the last block method we failed to compile and avoid recompiling it."
  	(self methodWithHeaderShouldBeCogged: methodHeader)
  		ifTrue:
+ 			[(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
+ 			  or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
- 			[theMethod = lastCoggableInterpretedBlockMethod
  				ifTrue:
  					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
  						[cogit cogFullBlockMethod: theMethod numCopied: numCopied.
  						 (self methodHasCogMethod: theMethod) ifTrue:
  							[^self executeFullCogBlock: (self cogMethodOf: theMethod)
  								closure: blockClosure
  								mayContextSwitch: mayContextSwitch].
  						 cogCompiledCodeCompactionCalledFor ifFalse:
  							[lastUncoggableInterpretedBlockMethod := theMethod]]]
  				ifFalse:
  					[lastCoggableInterpretedBlockMethod := theMethod]]
  		ifFalse:
  			[self maybeFlagMethodAsInterpreted: theMethod].
  
  	self assert: (self methodHasCogMethod: theMethod) not.
  	"Because this is an uncogged method we need to continue via the interpreter.
  	 We could have been reached either from the interpreter, in which case we
  	 should simply return, or from a machine code frame or from a compiled
  	 primitive.  In these latter two cases we must longjmp back to the interpreter.
  	 The instructionPointer tells us which path we took.
  	 If the sender was an interpreter frame but called through a (failing) primitive
  	 then make sure we restore the saved instruction pointer and avoid pushing
  	 ceReturnToInterpreterPC which is only valid between an interpreter caller
  	 frame and a machine code callee frame."
  	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
  		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  			[instructionPointer := self iframeSavedIP: framePointer]].
  
  	self push: instructionPointer.
  	self push: framePointer.
  	framePointer := stackPointer.
  	self push: theMethod.
  	self push: objectMemory nilObject. "FxThisContext field"
  	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  	self push: 0. "FoxIFSavedIP"
  	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
  	self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
  
  	"Copy the copied values..."
  	0 to: numCopied - 1 do:
  		[:i|
  		self push: (objectMemory
  					fetchPointer: i + FullClosureFirstCopiedValueIndex
  					ofObject: blockClosure)].
  
  	self assert: (self frameIsBlockActivation: framePointer).
  	self assert: (self frameHasContext: framePointer) not.
  
  	methodHeader := objectMemory methodHeaderOf: theMethod.
  	numTemps := self temporaryCountOfMethodHeader: methodHeader.
  
  	numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
  
  	instructionPointer := (self initialPCForHeader: methodHeader method: theMethod) - 1.
  	
  	self setMethod: theMethod.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  	switched := false.
  	stackPointer < stackLimit ifTrue:
  		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
  	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was changed:
  ----- Method: CoInterpreter>>mustMapMachineCodePC:context: (in category 'frame access') -----
  mustMapMachineCodePC: theIP context: aOnceMarriedContext
  	"Map the native pc theIP into a bytecode pc integer object and answer it.
  	 See contextInstructionPointer:frame: for the explanation."
  	| maybeClosure methodObj cogMethod startBcpc bcpc |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	theIP = HasBeenReturnedFromMCPC ifTrue:
  		[^objectMemory nilObject].
  	maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aOnceMarriedContext.
  	methodObj := objectMemory fetchPointer: MethodIndex ofObject: aOnceMarriedContext.
+ 	(maybeClosure ~= objectMemory nilObject
+ 	and: [self isVanillaBlockClosure: maybeClosure])
- 	maybeClosure ~= objectMemory nilObject
  		ifTrue: [self assert: (theIP signedBitShift: -16) < -1.
  				startBcpc := self startPCOfClosure: maybeClosure]
  		ifFalse: [self assert: (theIP signedBitShift: -16) = -1.
  				startBcpc := self startPCOfMethod: methodObj].
  	cogMethod := self ensureMethodIsCogged: methodObj.
  	bcpc := self bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc.
  	self assert: bcpc >= (self startPCOfMethod: methodObj).
  	"If there's a CallPrimitive we need to skip it."
  	(bcpc = startBcpc
  	 and: [maybeClosure = objectMemory nilObject
  	 and: [self methodHeaderHasPrimitive: cogMethod methodHeader]]) ifTrue:
  		[bcpc := bcpc + (self sizeOfCallPrimitiveBytecode: cogMethod methodHeader)].
  	^objectMemory integerObjectOf: bcpc + 1!

Item was changed:
  SharedPool subclass: #CogCompilationConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BadRegisterSet CogCompilerClass InFullBlock InVanillaBlock NumSendTrampolines SSBaseOffset SSConstant SSIllegal SSRegister SSSpill UnimplementedOperation'
- 	classVariableNames: 'BadRegisterSet CogCompilerClass NumSendTrampolines SSBaseOffset SSConstant SSIllegal SSRegister SSSpill UnimplementedOperation'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was changed:
  CogObjectRepresentation subclass: #CogObjectRepresentationForSpur
+ 	instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceSmallActiveContextInFullBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline ceLargeActiveContextInFullBlockTrampoline ceStoreCheckContextReceiverTrampoline ceStoreTrampolines'
- 	instanceVariableNames: 'ceScheduleScavengeTrampoline ceSmallActiveContextInMethodTrampoline ceSmallActiveContextInBlockTrampoline ceLargeActiveContextInMethodTrampoline ceLargeActiveContextInBlockTrampoline ceStoreCheckContextReceiverTrampoline ceStoreTrampolines'
  	classVariableNames: 'CheckRememberedInTrampoline NumStoreTrampolines'
  	poolDictionaries: 'VMBytecodeConstants VMSqueakClassIndices'
  	category: 'VMMaker-JIT'!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in category 'accessing') -----
  numTrampolines
  	^super numTrampolines
+ 	 + (SistaV1BytecodeSet
+ 		ifTrue: [8] "(small,large)x(method,block,fullBlock) context creation,
+ 					 ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline"
+ 		ifFalse: [6] "(small,large)x(method,block) context creation,
+ 					 ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline")
- 	 + 6 "(small,large)x(method,block) context creation, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline"
  	 + ((initializationOptions at: #IMMUTABILITY ifAbsent: [false])
  		ifTrue: [NumStoreTrampolines]
  		ifFalse: [0])!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetActiveContextLarge:inBlock: (in category 'initialization') -----
  genGetActiveContextLarge: isLarge inBlock: isInBlock
  	"Create a trampoline to answer the active context that will
  	 answer it if a frame is already married, and create it otherwise.
  	 Assume numArgs is in SendNumArgsReg and ClassReg is free."
  	| header slotSize jumpSingle loopHead jumpNeedScavenge continuation exit |
  	<var: #jumpNeedScavenge type: #'AbstractInstruction *'>
  	<var: #continuation type: #'AbstractInstruction *'>
  	<var: #jumpSingle type: #'AbstractInstruction *'>
  	<var: #loopHead type: #'AbstractInstruction *'>
  	<var: #exit type: #'AbstractInstruction *'>
  	cogit "load the flag; stash it in both TempReg & ClassReg; do the compare (a prime candidated for use of AndCq:R:R:)"
  		MoveMw: FoxMethod r: FPReg R: ClassReg;
  		AndCq: MFMethodFlagHasContextFlag R: ClassReg R: TempReg.
  	jumpSingle := cogit JumpZero: 0. "jump if flag bit not set"
  	cogit "since the flag bit was set, get the context in the receiver reg and return"
  		MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg;
  		RetN: 0.
  	jumpSingle jmpTarget: cogit Label.
  
  	"OK, it doesn't exist; instantiate and initialize it"
  	"set the hasContext flag; See CoInterpreter class>>initializeFrameIndices"
  	cogit
  		OrCq: MFMethodFlagHasContextFlag R: ClassReg;
  		MoveR: ClassReg Mw: FoxMethod r: FPReg.
  	"now get the home CogMethod into ClassReg and save for post-instantiation."
+ 	isInBlock caseOf: {
+ 	[InFullBlock]	-> [cogit SubCq: 3 R: ClassReg]. "-3 is -(hasContext+isBlock) flags"
+ 	[InVanillaBlock]	-> [cogit
+ 							SubCq: 3 R: ClassReg; "-3 is -(hasContext+isBlock) flags"
+ 							MoveM16: 0 r: ClassReg R: TempReg;
+ 							SubR: TempReg R: ClassReg].
+ 	[0]				-> [cogit SubCq: 1 R: ClassReg]. "-1 is hasContext flag" }.
- 	isInBlock
- 		ifTrue:
- 			[cogit
- 				SubCq: 3 R: ClassReg; "-3 is -(hasContext+isBlock) flags"
- 				MoveM16: 0 r: ClassReg R: TempReg;
- 				SubR: TempReg R: ClassReg]
- 		ifFalse:
- 			[cogit SubCq: 1 R: ClassReg]. "-1 is hasContext flag"
  
  	"instantiate the context..."
  	slotSize := isLarge ifTrue: [LargeContextSlots] ifFalse: [SmallContextSlots].
  	header := objectMemory
  					headerForSlots: slotSize
  					format: objectMemory indexablePointersFormat
  					classIndex: ClassMethodContextCompactIndex.
  	self flag: #endianness.
  	cogit MoveAw: objectMemory freeStartAddress R: ReceiverResultReg.
  	self genStoreHeader: header intoNewInstance: ReceiverResultReg using: TempReg.
  	cogit
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	jumpNeedScavenge := cogit JumpAboveOrEqual: 0.
  
  	"Now initialize the fields of the context.  See CoInterpreter>>marryFrame:SP:copyTemps:"
  	"sender gets frame pointer as a SmallInteger"
  	continuation :=
  	cogit MoveR: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (SenderIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"pc gets frame caller as a SmallInteger"
  	cogit MoveMw: FoxSavedFP r: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (InstructionPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the method field, freeing up ClassReg again, and frame's context field,"
  	cogit
  		MoveMw: (cogit offset: CogMethod of: #methodObject) r: ClassReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (MethodIndex * objectMemory wordSize) r: ReceiverResultReg;
  		MoveR: ReceiverResultReg Mw: FoxThisContext r: FPReg.
  
  	"Now compute stack pointer; this is stackPointer (- 1 for return pc if a CISC) - framePointer - wordSize (1 each for saved pc, method, context, receiver) + 1 (1-relative) + numArgs"
  	"TPR note - the code here is actually doing
  	context stackPointer := ((((fp - sp) / wordSize) - [3|4]) + num args) asSmallInteger"
  	cogit
  		MoveR: FPReg R: TempReg;
  		SubR: SPReg R: TempReg;
  		LogicalShiftRightCq: self log2BytesPerWord R: TempReg;
  		SubCq: (cogit backEnd hasLinkRegister ifTrue: [3] ifFalse: [4]) R: TempReg;
  		AddR: SendNumArgsReg R: TempReg.
  	self genConvertIntegerToSmallIntegerInReg: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (StackPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set closureOrNil to either the stacked receiver or nil"
+ 	isInBlock > 0
- 	isInBlock
  		ifTrue:
  			[cogit
  				MoveR: SendNumArgsReg R: TempReg;
  				AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  				MoveXwr: TempReg R: FPReg R: TempReg]
  		ifFalse:
  			[cogit genMoveNilR: TempReg].
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (ClosureIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the receiver"
  	cogit
  		MoveMw: FoxMFReceiver r: FPReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (ReceiverIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Now copy the arguments.  This is tricky because of the shortage of registers,.  ClassReg ranges
  	 from 1 to numArgs (SendNumArgsReg), and from ReceiverIndex + 1 to ReceiverIndex + numArgs.
  	 1 to: numArgs do:
  		[:i|
  		temp := longAt(FPReg + ((SendNumArgs - i + 2) * wordSize)). +2 for saved pc and savedfp
  		longAtput(FPReg + FoxMFReceiver + (i * wordSize), temp)]"
  	"TPR note: this is a prime candidate for passing off to the backend to do at least faintly optimal code"
  	cogit MoveCq: 1 R: ClassReg.
  	loopHead := cogit CmpR: SendNumArgsReg R: ClassReg.
  	exit := cogit JumpGreater: 0.
  	cogit
  		MoveR: SendNumArgsReg R: TempReg;
  		SubR: ClassReg R: TempReg;
  		AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  		MoveXwr: TempReg R: FPReg R: TempReg;
  		AddCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) R: ClassReg; "Now convert ClassReg from frame index to context index"
  		MoveR: TempReg Xwr: ClassReg R: ReceiverResultReg;
  		SubCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) - 1 R: ClassReg; "convert back adding 1 ;-)"
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	"Finally nil or copy the non-argument temps.
  	 ClassReg := FPReg + FoxMFReceiver.
  	 SendNumArgsReg := SendNumArgsReg+ReceiverIndex.
  	 [ClassReg := ClassReg - wordSize.
  	  backEnd hasLinkRegister
  			ifTrue: [ClassReg > SPReg]
  			ifFalse: [ClassReg >= SPReg]] whileTrue:
  		[receiver[SendNumArgsReg] := *ClassReg.
  		 SendNumArgsReg := SendNumArgsReg + 1]]"
  	coInterpreter marryFrameCopiesTemps ifFalse:
  		[cogit MoveCq: objectMemory nilObject R: TempReg].
  	cogit
  		MoveR: FPReg R: ClassReg;
  		AddCq: FoxMFReceiver R: ClassReg;
  		AddCq: ReceiverIndex + 1 + (objectMemory baseHeaderSize / objectMemory wordSize) R: SendNumArgsReg.
  	loopHead :=
  	cogit SubCq: objectMemory wordSize R: ClassReg.
  	cogit CmpR: SPReg R: ClassReg.
  	"If on a CISC there's a retpc for the trampoline call on top of stack; if on a RISC there isn't."
  	exit := cogit backEnd hasLinkRegister
  				ifTrue: [cogit JumpBelow: 0]
  				ifFalse: [cogit JumpBelowOrEqual: 0].
  	coInterpreter marryFrameCopiesTemps ifTrue:
  		[cogit MoveMw: 0 r: ClassReg R: TempReg].
  	cogit
  		MoveR: TempReg Xwr: SendNumArgsReg R: ReceiverResultReg;
  		AddCq: 1 R: SendNumArgsReg;
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	cogit RetN: 0.
  	
  	jumpNeedScavenge jmpTarget: cogit Label.
  	cogit backEnd saveAndRestoreLinkRegAround:
  		[cogit
  			CallRT: ceScheduleScavengeTrampoline
  			registersToBeSavedMask: (cogit registerMaskFor: ReceiverResultReg and: SendNumArgsReg and: ClassReg)].
  	cogit Jump: continuation.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetActiveContextNumArgs:large:inBlock: (in category 'bytecode generator support') -----
  genGetActiveContextNumArgs: numArgs large: isLargeContext inBlock: isInBlock
  	"Get the active context into ReceiverResultReg, creating it if necessary."
  	| routine |
  	routine := isLargeContext
+ 				ifFalse: [isInBlock caseOf: {
+ 						[0]				-> [ceSmallActiveContextInMethodTrampoline].
+ 						[InVanillaBlock]	-> [ceSmallActiveContextInBlockTrampoline].
+ 						[InFullBlock]	-> [ceSmallActiveContextInFullBlockTrampoline] }]
+ 				ifTrue: [isInBlock caseOf: {
+ 						[0]				-> [ceLargeActiveContextInMethodTrampoline].
+ 						[InVanillaBlock]	-> [ceLargeActiveContextInBlockTrampoline].
+ 						[InFullBlock]	-> [ceLargeActiveContextInFullBlockTrampoline] }].
- 				ifFalse: [isInBlock
- 							ifFalse: [ceSmallActiveContextInMethodTrampoline]
- 							ifTrue: [ceSmallActiveContextInBlockTrampoline]]
- 				ifTrue: [isInBlock
- 							ifFalse: [ceLargeActiveContextInMethodTrampoline]
- 							ifTrue: [ceLargeActiveContextInBlockTrampoline]].
  	cogit
  		MoveCq: numArgs R: SendNumArgsReg;
  		CallRT: routine.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	 it allows the code generator to reload ReceiverResultReg cheaply.
  	 In Spur the only thing we leave to the run-time is adding the receiver to the
  	 remembered set and setting its isRemembered bit."
  	self 
  		cppIf: IMMUTABILITY
  		ifTrue: 
  			[self cCode: [] inSmalltalk:
  				[ceStoreTrampolines := CArrayAccessor on: (Array new: NumStoreTrampolines)].
  			 0 to: NumStoreTrampolines - 1 do:
  				[:instVarIndex |
  				 ceStoreTrampolines
  					at: instVarIndex
  					put: (self 
  							genStoreTrampolineCalled: (cogit 
  															trampolineName: 'ceStoreTrampoline' 
  															numArgs: instVarIndex 
  															limit: NumStoreTrampolines - 2) 
  							instVarIndex: instVarIndex)]].
  	ceStoreCheckTrampoline := self genStoreCheckTrampoline.
  	ceStoreCheckContextReceiverTrampoline := self genStoreCheckContextReceiverTrampoline.
  	ceScheduleScavengeTrampoline := cogit
  											genTrampolineFor: #ceScheduleScavenge
  											called: 'ceScheduleScavengeTrampoline'
  											regsToSave: CallerSavedRegisterMask.
+ 	ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: 0 called: 'ceSmallMethodContext'.
+ 	ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InVanillaBlock called: 'ceSmallBlockContext'.
+ 	SistaV1BytecodeSet ifTrue:
+ 		[ceSmallActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InFullBlock called: 'ceSmallFullBlockContext'].
+ 	ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: 0 called: 'ceLargeMethodContext'.
+ 	ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InVanillaBlock called: 'ceLargeBlockContext'.
+ 	SistaV1BytecodeSet ifTrue:
+ 		[ceLargeActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InFullBlock called: 'ceLargeFullBlockContext']!
- 	ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: false called: 'ceSmallMethodContext'.
- 	ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: true called: 'ceSmallBlockContext'.
- 	ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: false called: 'ceLargeMethodContext'.
- 	ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: true called: 'ceLargeBlockContext'!

Item was changed:
  ----- Method: Cogit class>>initializeMiscConstants (in category 'class initialization') -----
  initializeMiscConstants
  	super initializeMiscConstants.
  	Debug := initializationOptions at: #Debug ifAbsent: [false].
  	(initializationOptions includesKey: #EagerInstructionDecoration)
  		ifTrue:
  			[EagerInstructionDecoration := initializationOptions at: #EagerInstructionDecoration]
  		ifFalse:
  			[EagerInstructionDecoration ifNil:
  				[EagerInstructionDecoration := false]]. "speeds up single stepping but could lose fidelity"
  
  	ProcessorClass := (initializationOptions at: #ISA ifAbsentPut: [self objectMemoryClass defaultISA]) caseOf: {
  							[#X64] 		->	[BochsX64Alien].
  							[#IA32] 	->	[BochsIA32Alien].
  							[#ARMv5]	->	[GdbARMAlien].
  							[#MIPSEL]	->	[MIPSELSimulator] }.
  	CogCompilerClass := self activeCompilerClass.
  	(CogCompilerClass withAllSuperclasses copyUpTo: CogAbstractInstruction) reverseDo:
  		[:compilerClass| compilerClass initialize; initializeAbstractRegisters].
  	self objectMemoryClass objectRepresentationClass initializeMiscConstants.
  	"Our criterion for which methods to JIT is literal count.  The default value is 60 literals or less."
  	MaxLiteralCountForCompile := initializationOptions at: #MaxLiteralCountForCompile ifAbsent: [60].
  	"we special-case 0, 1 & 2 argument sends, N is numArgs >= 3"
  	NumSendTrampolines := 4.
  	"Currently not even the ceImplicitReceiverTrampoline contains object references."
  	NumObjRefsInRuntime := 0.
  	"6 is a fine number for the max number of PCI entries.  8 is too large."
  	MaxCPICCases := 6.
  
+ 	"One variable defines whether in a block and whether in a vanilla or full block."
+ 	InVanillaBlock := 1.
+ 	InFullBlock := 2.
+ 
  	NSCSelectorIndex := (NSSendCache instVarNames indexOf: #selector) - 1.
  	NSCNumArgsIndex := (NSSendCache instVarNames indexOf: #numArgs) - 1.
  	NSCClassTagIndex := (NSSendCache instVarNames indexOf: #classTag) - 1.
  	NSCEnclosingObjectIndex := (NSSendCache instVarNames indexOf: #enclosingObject) - 1.
  	NSCTargetIndex := (NSSendCache instVarNames indexOf: #target) - 1.
  	NumOopsPerNSC := NSSendCache instVarNames size.
  
  	"Max size to alloca when compiling.
  	 Mac OS X 10.6.8 segfaults approaching 8Mb.
  	 Linux 2.6.9 segfaults above 11Mb.
  	 WIndows XP segfaults approaching 2Mb."
  	MaxStackAllocSize := 1024 * 1024 * 3 / 2 !

Item was changed:
  ----- Method: Cogit>>compileCogFullBlockMethod: (in category 'compile abstract instructions') -----
  compileCogFullBlockMethod: numCopied
  	<returnTypeC: #'CogMethod *'>
  	<option: #SistaV1BytecodeSet>
  	| numBytecodes numBlocks numCleanBlocks result |
  	hasYoungReferent := (objectMemory isYoungObject: methodObj).
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
+ 	inBlock := InFullBlock.
- 	inBlock := true.
  	postCompileHook := nil.
  	maxLitIndex := -1.
  	self assert: (coInterpreter primitiveIndexOf: methodObj) = 0.
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := objectMemory numBytesOf: methodObj.
  	numBytecodes := endPC - initialPC + 1.
  	primitiveIndex := 0.
  	self allocateOpcodes: (numBytecodes + 10) * self estimateOfAbstractOpcodesPerBytecodes
  		bytecodes: numBytecodes
  		ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	self flag: #TODO. "currently copiedValue access implies frameful method, this is suboptimal"
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	self assert: numBlocks = 0. "blocks in full blocks are full blocks, they are not inlined."
  	numCleanBlocks := self scanForCleanBlocks.
  	self assert: numCleanBlocks = 0. "blocks in full blocks are full blocks, they are not inlined."
  	self allocateBlockStarts: numBlocks + numCleanBlocks.
  	blockCount := 0.
  	numCleanBlocks > 0 ifTrue:
  		[self addCleanBlockStarts].
  	(self maybeAllocAndInitCounters
  	 and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do.  This will likely never fail."
  		[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireFullBlockMethod: numCopied) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogFullBlock!

Item was changed:
  ----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
  compileCogMethod: selector
  	<returnTypeC: #'CogMethod *'>
  	| numBytecodes numBlocks numCleanBlocks result extra |
  	hasYoungReferent := (objectMemory isYoungObject: methodObj)
  						  or: [objectMemory isYoung: selector].
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
+ 	inBlock := 0.
- 	inBlock := false.
  	postCompileHook := nil.
  	maxLitIndex := -1.
  	extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
  			and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
  				ifTrue: [30]
  				ifFalse: [10].
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
  					ifTrue: [initialPC - 1]
  					ifFalse: [objectMemory numBytesOf: methodObj].
  	numBytecodes := endPC - initialPC + 1.
  	self allocateOpcodes: (numBytecodes + extra) * self estimateOfAbstractOpcodesPerBytecodes
  		bytecodes: numBytecodes
  		ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	numCleanBlocks := self scanForCleanBlocks.
  	self allocateBlockStarts: numBlocks + numCleanBlocks.
  	blockCount := 0.
  	numCleanBlocks > 0 ifTrue:
  		[self addCleanBlockStarts].
  	(self maybeAllocAndInitCounters
  	 and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do.  This will likely never fail."
  		[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogMethod: selector!

Item was changed:
  ----- Method: Cogit>>needsFrameIfInBlock: (in category 'compile abstract instructions') -----
  needsFrameIfInBlock: stackDelta
+ 	^inBlock > 0!
- 	^inBlock!

Item was changed:
  ----- Method: Cogit>>scanBlock: (in category 'compile abstract instructions') -----
  scanBlock: blockStart
  	"Scan the block to determine if the block needs a frame or not"
  	| descriptor pc end framelessStackDelta nExts |
  	<var: #blockStart type: #'BlockStart *'>
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	methodOrBlockNumArgs := blockStart numArgs.
+ 	inBlock := InVanillaBlock.
- 	inBlock := true.
  	pc := blockStart startpc.
  	end := blockStart startpc + blockStart span.
  	framelessStackDelta := nExts := extA := extB := 0.
  	[pc < end] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 objectRepresentation maybeNoteDescriptor: descriptor blockStart: blockStart.
  		 pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0]].
  	needsFrame ifFalse:
  		[framelessStackDelta < 0 ifTrue:
  			[self error: 'negative stack delta in block; block contains bogus code or internal error'].
  		 [framelessStackDelta > 0] whileTrue:
  			[descriptor := self generatorAt: (objectMemory fetchByte: blockStart startpc ofObject: methodObj) + bytecodeSetOffset.
  			 descriptor generator ~~ #genPushConstantNilBytecode ifTrue:
  				[self error: 'frameless block doesn''t start with enough pushNils'].
  			 blockStart
  				startpc: blockStart startpc + descriptor numBytes;
  				span: blockStart span - descriptor numBytes.
  			 framelessStackDelta := framelessStackDelta - 1]].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
+ 	inBlock := InVanillaBlock.
- 	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		 self scanBlock: blockStart.
  		 self compileBlockEntry: blockStart.
  		 (result := self compileAbstractInstructionsFrom: blockStart startpc
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		 compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileBlockFramelessEntry: (in category 'compile abstract instructions') -----
  compileBlockFramelessEntry: blockStart
  	"Make sure ReceiverResultReg holds the receiver, loaded from the closure,
  	 which is what is initially in ReceiverResultReg.  We must annotate the first
+ 	 instruction in vanilla blocks so that findMethodForStartBcpc:inHomeMethod:
+ 	 can function. We need two annotations because the first is a fiducial."
- 	 instruction so that findMethodForStartBcpc:inHomeMethod: can function.
- 	 We need two annotations because the first is a fiducial."
  	<var: #blockStart type: #'BlockStart *'>
+ 	self deny: blockStart hasInstVarRef. "Else we would need to unforward the receiver in Spur"
+ 	blockStart entryLabel ifNotNil:
+ 		[self annotateBytecode: blockStart entryLabel.
+ 		 self annotateBytecode: blockStart entryLabel].
- 	self deny: blockStart hasInstVarRef. "Else we would need to unforward the receiver"
- 	self annotateBytecode: blockStart entryLabel.
- 	self annotateBytecode: blockStart entryLabel.
  	objectRepresentation
  		genLoadSlot: ClosureOuterContextIndex
  			sourceReg: ReceiverResultReg
  				destReg: TempReg;
  		genLoadSlot: ReceiverIndex
  			sourceReg: TempReg
  				destReg: ReceiverResultReg!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genReturnNilFromBlock (in category 'bytecode generators') -----
  genReturnNilFromBlock
+ 	self assert: inBlock > 0.
- 	self assert: inBlock.
  	self genMoveNilR: ReceiverResultReg.
  	^self genBlockReturn!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
  genReturnTopFromBlock
+ 	self assert: inBlock > 0.
- 	self assert: inBlock.
  	self PopR: ReceiverResultReg.
  	^self genBlockReturn!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genUpArrowReturn (in category 'bytecode generators') -----
  genUpArrowReturn
  	"Generate a method return from within a method or a block.
  	 Frameless method activation looks like
  				receiver
  				args
  		sp->	ret pc.
  	 Return pops receiver and arguments off the stack.  Callee pushes the result."
+ 	inBlock > 0 ifTrue:
- 	inBlock ifTrue:
  		[self assert: needsFrame.
  		 self CallRT: ceNonLocalReturnTrampoline.
  		 self annotateBytecode: self Label.
  		 ^0].
  	needsFrame ifTrue:
  		[self MoveR: FPReg R: SPReg.
  		 self PopR: FPReg.
  		 backEnd hasLinkRegister ifTrue:
  			[self PopR: LinkReg]].
  	self RetN: methodOrBlockNumArgs + 1 * objectMemory wordSize.
  	^0!

Item was changed:
  ----- Method: SistaCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	"override to maintain counterIndex when recompiling blocks; sigh."
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
  	  initialStackPtr initialOpcodeIndex initialCounterIndex initialIndexOfIRC |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
+ 	inBlock := InVanillaBlock.
- 	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		 (result := self scanBlock: blockStart) < 0 ifTrue: [^result].
  		 initialOpcodeIndex := opcodeIndex.
  		 initialCounterIndex := counterIndex.
  		 NewspeakVM ifTrue:
  			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body.
  		   N.B.  No need to reinitialize the literalsManager because it answers existing literals."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
  									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
  				 counterIndex := initialCounterIndex.
  				 NewspeakVM ifTrue:
  					[indexOfIRC := initialIndexOfIRC]].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>findHomeForContext: (in category 'debug printing') -----
  findHomeForContext: aContext
  	| closureOrNil |
  	<inline: false>
  	(objectMemory isContext: aContext) ifFalse:
  		[^nil].
  	closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  	closureOrNil = objectMemory nilObject ifTrue:
  		[^aContext].
+ 	ClassBlockClosureCompactIndex ~= 0
+ 		ifTrue:
+ 			[((objectMemory compactClassIndexOf: closureOrNil) ~= ClassBlockClosureCompactIndex
+ 			  and: [(objectMemory compactClassIndexOf: closureOrNil) ~= ClassFullBlockClosureCompactIndex]) ifTrue:
+ 				[^nil]]
+ 		ifFalse:
+ 			[(objectMemory fetchClassOf: closureOrNil) ~= (objectMemory splObj: ClassBlockClosure) ifTrue:
+ 				[(ClassFullBlockClosureCompactIndex ~= 0
+ 				  and: [(objectMemory fetchClassOf: closureOrNil) = (objectMemory splObj: ClassFullBlockClosure)]) ifFalse:
+ 					[^nil]]].
- 	(objectMemory fetchClassOf: closureOrNil) ~= (objectMemory splObj: ClassBlockClosure) ifTrue:
- 		[^nil].
  	^self findHomeForContext: (objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closureOrNil)!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintContext: (in category 'debug printing') -----
  shortPrintContext: aContext
  	| theFP |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	(objectMemory isContext: aContext) ifFalse:
  		[self printHex: aContext; print: ' is not a context'; cr.
  		^nil].
  	self printHex: aContext.
  	(self isMarriedOrWidowedContext: aContext)
  		ifTrue: [(self checkIsStillMarriedContext: aContext currentFP: framePointer)
  					ifTrue:
  						[(self isMachineCodeFrame: (theFP := self frameOfMarriedContext: aContext))
  							ifTrue: [self print: ' M (']
  							ifFalse: [self print: ' I ('].
  						 self printHex: theFP asUnsignedInteger; print: ') ']
  					ifFalse:
  						[self print: ' w ']]
  		ifFalse: [self print: ' s '].
  	(self findHomeForContext: aContext)
  		ifNil: [self print: ' BOGUS CONTEXT (can''t determine home)']
  		ifNotNil:
  			[:home|
+ 			 self printActivationNameFor: (objectMemory
+ 											fetchPointer: MethodIndex
+ 											ofObject: (home ifNil: [aContext]))
+ 				receiver: (home
+ 							ifNil: [objectMemory nilObject]
+ 							ifNotNil: [objectMemory fetchPointer: ReceiverIndex ofObject: home])
+ 				isBlock: home ~= aContext
+ 				firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home)].
- 			self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: aContext)
- 		receiver: (home isNil
- 					ifTrue: [objectMemory nilObject]
- 					ifFalse: [objectMemory fetchPointer: ReceiverIndex ofObject: home])
- 		isBlock: home ~= aContext
- 		firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home)].
  	self cr!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
  	  initialStackPtr initialOpcodeIndex initialIndexOfIRC |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
+ 	inBlock := InVanillaBlock.
- 	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		  (result := self scanBlock: blockStart) < 0 ifTrue: [^result].
  		 initialOpcodeIndex := opcodeIndex.
  		 literalsManager saveForBlockCompile.
  		 NewspeakVM ifTrue:
  			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body.
  		   N.B.  No need to reinitialize the literalsManager because it answers existing literals."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
  									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
  				 literalsManager resetForBlockCompile.
  				 NewspeakVM ifTrue:
  					[indexOfIRC := initialIndexOfIRC]].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileFullBlockMethodFrameBuild: (in category 'compile abstract instructions') -----
  compileFullBlockMethodFrameBuild: numCopied
  	<option: #SistaV1BytecodeSet>
+ 	| blockStart |
+ 	<var: 'blockStart' type: #CogBlockStart>
  	needsFrame ifFalse:
+ 		[self cCode: [] inSmalltalk: [blockStart := CogBlockStart new].
+ 		 blockStart
+ 			startpc: initialPC;
+ 			numArgs: methodOrBlockNumArgs;
+ 			numCopied: numCopied;
+ 			numInitialNils: 0.
+ 		 self compileBlockFramelessEntry: blockStart.
- 		[ self assert: methodOrBlockNumArgs = 0. "Else calling convention would have put args in regs while block activation expects them on stack"
- 		 self initSimStackForFramelessMethod: initialPC.
  		 ^self].
  	super compileFullBlockMethodFrameBuild: numCopied.
  	self initSimStackForFramefulMethod: initialPC!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushTemporaryVariable: (in category 'bytecode generator support') -----
  genPushTemporaryVariable: index
  	"If a frameless method (not a block), only argument temps can be accessed.
  	 This is assured by the use of needsFrameIfMod16GENumArgs: in pushTemp."
+ 	self assert: (inBlock > 0 or: [needsFrame or: [index < methodOrBlockNumArgs]]).
- 	self assert: (inBlock or: [needsFrame or: [index < methodOrBlockNumArgs]]).
  	^self ssPushDesc: (simStack at: index)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genReturnTopFromBlock (in category 'bytecode generators') -----
  genReturnTopFromBlock
+ 	self assert: inBlock > 0.
- 	self assert: inBlock.
  	self ssTop popToReg: ReceiverResultReg.
  	self ssPop: 1.
  	^self genBlockReturn!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUpArrowReturn (in category 'bytecode generators') -----
  genUpArrowReturn
  	"Generate a method return from within a method or a block.
  	 Frameless method activation looks like
  	 CISCs (x86):
  				receiver
  				args
  		sp->	ret pc.
  	 RISCs (ARM):
  				receiver
  				args
  				ret pc in LR.
  	 A fully framed activation is described in CoInterpreter class>initializeFrameIndices.
  	 Return pops receiver and arguments off the stack.  Callee pushes the result."
  	| framelessReturn |
  	deadCode := true. "can't fall through"
+ 	inBlock > 0 ifTrue:
- 	inBlock ifTrue:
  		[self assert: needsFrame. 
  		 self CallRT: ceNonLocalReturnTrampoline.
  		 self annotateBytecode: self Label.
  		 ^0].
  	self 
  		cppIf: IMMUTABILITY
  		ifTrue: [framelessReturn := needsFrame and: [useTwoPaths not]]
  		ifFalse: [framelessReturn := needsFrame].
  	framelessReturn
  		ifTrue:
  			[self MoveR: FPReg R: SPReg.
  			 self PopR: FPReg.
  			 backEnd hasLinkRegister ifTrue:
  				[self PopR: LinkReg].
  			 self RetN: methodOrBlockNumArgs + 1 * objectMemory wordSize]
  		ifFalse:
  			[self RetN: ((methodOrBlockNumArgs > self numRegArgs
  						"A method with an interpreter prim will push its register args for the prim.  If the failure
  						 body is frameless the args must still be popped, see e.g. Behavior>>nextInstance."
  						or: [regArgsHaveBeenPushed])
  							ifTrue: [methodOrBlockNumArgs + 1 * objectMemory wordSize]
  							ifFalse: [0])].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>mapDeadDescriptorIfNeeded: (in category 'compile abstract instructions') -----
  mapDeadDescriptorIfNeeded: descriptor 
  	"insert nops for dead code that is mapped so that bc 
  	 to mc mapping is not many to one"
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	self flag: #annotateInstruction .
  	(descriptor isMapped
+ 		or: [inBlock > 0 and: [descriptor isMappedInBlock]]) 
- 		or: [inBlock and: [descriptor isMappedInBlock]]) 
  		ifTrue: [self annotateBytecode: self Nop].
  	^ 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanBlock: (in category 'compile abstract instructions') -----
  scanBlock: blockStart
  	"Scan the block to determine if the block needs a frame or not"
  	| descriptor pc end framelessStackDelta nExts pushingNils numPushNils |
  	<var: #blockStart type: #'BlockStart *'>
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	prevBCDescriptor := nil.
  	methodOrBlockNumArgs := blockStart numArgs.
+ 	inBlock := InVanillaBlock.
- 	inBlock := true.
  	pc := blockStart startpc.
  	end := blockStart startpc + blockStart span.
  	framelessStackDelta := nExts := extA := extB := 0.
  	pushingNils := true.
  	[pc < end] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 objectRepresentation maybeNoteDescriptor: descriptor blockStart: blockStart.
  		 (pushingNils
  		  and: [descriptor isExtension not]) ifTrue:
  			["Count the initial number of pushed nils acting as temp initializers.  We can't tell
  			  whether an initial pushNil is an operand reference or a temp initializer, except
  			  when the pushNil is a jump target (has a fixup), which never happens:
  					self systemNavigation browseAllSelect:
  						[:m| | ebc |
  						(ebc := m embeddedBlockClosures
  									select: [:ea| ea decompile statements first isMessage]
  									thenCollect: [:ea| ea decompile statements first selector]) notEmpty
  						and: [(#(whileTrue whileFalse whileTrue: whileFalse:) intersection: ebc) notEmpty]]
  			  or if the bytecode set has a push multiple nils bytecode.  We simply count initial nils.
  			  Rarely we may end up over-estimating.  We will correct by checking the stack depth
  			  at the end of the block in compileBlockBodies."
  			 (numPushNils := self numPushNils: descriptor pc: pc nExts: nExts method: methodObj) > 0
  				ifTrue:
  					[self assert: (descriptor numBytes = 1
  									or: [descriptor generator == #genPushClosureTempsBytecode]).
  					 blockStart numInitialNils: blockStart numInitialNils + numPushNils]
  				ifFalse:
  					[pushingNils := false]].
  		 pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0].
  		 prevBCDescriptor := descriptor].
  	"It would be nice of this wasn't necessary but alas we need to do the eager
  	 scan for frameless methods so that we don't end up popping too much off
  	 the simulated stack, e.g. for pushNil; returnTopFromBlock methods."
  	needsFrame ifFalse:
  		[self assert: (framelessStackDelta >= 0 and: [blockStart numInitialNils >= framelessStackDelta]).
  		 blockStart numInitialNils: blockStart numInitialNils - framelessStackDelta].
  	^0!



More information about the Vm-dev mailing list