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

commits at source.squeak.org commits at source.squeak.org
Fri Apr 8 00:38:38 UTC 2016


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

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

Name: VMMaker.oscog-eem.1781
Author: eem
Time: 7 April 2016, 5:34:13.587756 pm
UUID: 8db183ba-c100-4a9c-a562-3fe72dd965f6
Ancestors: VMMaker.oscog-eem.1780

First half of CoInterpreter support for CompiledBlock.
Implement genPrimitiveFullClosureValue.
Use just 3 primitive numbers for the flull closure value prims (the current situation with BlockClosure is a blunder which we can fix by switching to CompiledBlock)..
Oull the assignment to isBlock out of scanMethod into the caller so that scanMethod can serve for CompiledMethod and CompiledBlock.

[Perhaps still to do is to make the CompiledBlock support conditional on bytecode set when generating C].

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

Item was added:
+ ----- Method: CoInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
+ activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
+ 	"Similar to activateNewMethod but for Closure and newMethod."
+ 	| numCopied outerContext theMethod methodHeader numTemps |
+ 	<inline: true>
+ 	self break.
+ 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ 	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:
+ 			[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 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)"
+ 	stackPointer < stackLimit ifTrue:
+ 		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was added:
+ ----- Method: CoInterpreter>>executeFullCogBlock:closure:mayContextSwitch: (in category 'enilopmarts') -----
+ executeFullCogBlock: cogMethod closure: closure mayContextSwitch: mayContextSwitch
+ 	"Execute a FullBlockClosure with a CogMethod.  The caller has already pushed the block and
+ 	 any arguments and the return pc.  First push the return-to-interpreter trampoline,
+ 	 then the entry-point and finally the receiver.  We /do not/ push any register
+ 	 argument(s) to reduce complications in block dispatch; effectively there are no
+ 	 register arguments to blocks. Instead, the machine code block value primitives
+ 	 push the reg args if necessary before dispatching to the block.  Hence here, only
+ 	 the receiver gets pushed. See genPrimitiveClosureValue"
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	cogit assertCStackWellAligned.
+ 	self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
+ 	self ensurePushedInstructionPointer.
+ 	self push: cogMethod asInteger 
+ 		+ (mayContextSwitch
+ 				ifTrue: [cogit fullBlockEntryOffset]
+ 				ifFalse: [cogit fullBlockNoContextSwitchEntryOffset]).
+ 	self push: closure.
+ 	cogit ceCallCogCodePopReceiverReg
+ 	"NOTREACHED"!

Item was added:
+ ----- Method: CogObjectRepresentation>>genPrimitiveFullClosureValue (in category 'primitive generators') -----
+ genPrimitiveFullClosureValue
+ 	"Defer to the cogit for this one, to match the split for genPrimitiveClosureValue."
+ 	<doNotGenerate>
+ 	^cogit genPrimitiveFullClosureValue!

Item was changed:
  CogClass subclass: #Cogit
+ 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager callerSavedRegMask postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockStackOverflowCall fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCaptureCStackPointers ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases debugBytecodePointers debugOpcodeIndices disassemblingMethod'
- 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager callerSavedRegMask postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCaptureCStackPointers ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases debugBytecodePointers debugOpcodeIndices disassemblingMethod'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AltNumSpecialSelectors AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NumObjRefsInRuntime NumOopsPerNSC NumSpecialSelectors NumTrampolines ProcessorClass'
  	poolDictionaries: 'CogAbstractRegisters CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMBytecodeConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
  !Cogit commentStamp: 'eem 4/6/2015 15:56' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
  
  	StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
  
  I have concrete subclasses that implement different levels of optimization:
  	SimpleStackBasedCogit is the simplest code generator.
  
  	StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  	to the stack until necessary and implements a register-based calling convention for low-arity sends.
  
  	StackToRegisterMappingCogit is an experimental code generator with support for counting
  	conditional branches, intended to support adaptive optimization.
  
  coInterpreter <CoInterpreterSimulator>
  	the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  	the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  	the object used to generate object accesses
  processor <BochsIA32Alien|?>
  	the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  	flags controlling debug printing and code simulation
  breakPC <Integer>
  	machine code pc breakpoint
  cFramePointer cStackPointer <Integer>
  	the variables representing the C stack & frame pointers, which must change on FFI callback and return
  selectorOop <sqInt>
  	the oop of the methodObj being compiled
  methodObj <sqInt>
  	the bytecode method being compiled
  initialPC endPC <Integer>
  	the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  	argument count of current method or block being compiled
  needsFrame <Boolean>
  	whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  	primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  	label for the method header
  blockEntryLabel <CogAbstractOpcode>
  	label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  	label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  	label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  	offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  	label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  	offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  	label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
  	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixup shas one element per byte in methodObj's bytecode
  abstractOpcodes <Array of <AbstractOpcode>>
  	the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  	individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  	bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  	the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  	the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  	the starts of blocks in the current method
  blockCount
  	the index into blockStarts as they are being noted, and hence eventually the total number of blocks in the current method
  labelCounter <Integer>
  	a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  	the various trampolines (system-call-like jumps from machine code to the run-time).
  	See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  	routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  	the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  			'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  			'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetFP
  			declareC: 'unsigned long (*ceGetFP)(void)';
  		var: #ceGetSP
  			declareC: 'unsigned long (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #ceFlushICache
  			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
  			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
  			declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
  		var: #ceUnlockVMOwner
  			declareC: 'void (*ceUnlockVMOwner)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *'.
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss
  					entry noCheckEntry selfSendEntry dynSuperEntry
+ 					fullBlockStackOverflowCall fullBlockNoContextSwitchEntry fullBlockEntry
  					picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *'.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
  		var: #directedSuperSendTrampolines
  			declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  		var: #selfSendTrampolines
  			declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  		var: #dynamicSuperSendTrampolines
  			declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  		var: #implicitReceiverSendTrampolines
  			declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  		var: #outerSendTrampolines
  			declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]';
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #CFramePointer type: #'void *';
  		declareVar: #CStackPointer type: #'void *';
  		declareVar: #minValidCallAddress type: #'unsigned long';
  		declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

Item was added:
+ ----- Method: Cogit>>cogFullBlockMethod:numCopied: (in category 'jit - api') -----
+ cogFullBlockMethod: aMethodObj numCopied: numCopied
+ 	"Attempt to produce a machine code method for the bytecode method
+ 	 object aMethodObj.  N.B. If there is no code memory available do *NOT*
+ 	 attempt to reclaim the method zone.  Certain clients (e.g. ceSICMiss:)
+ 	 depend on the zone remaining constant across method generation."
+ 	<api>
+ 	<returnTypeC: #'CogMethod *'>
+ 	| cogMethod |
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	self cCode: [] inSmalltalk: "for debugging, allow excluding methods based on selector or methodClass"
+ 		[self halt class initializationOptions
+ 			at: #DoNotJIT
+ 			ifPresent:
+ 				[:excluded| 
+ 				(excluded anySatisfy: [:exclude| aMethodObj = exclude]) ifTrue:
+ 					[coInterpreter transcript nextPutAll: 'EXCLUDING '; nextPutAll: aMethodObj; nextPutAll: ' (compiled block)'; cr; flush.
+ 					 ^nil]]].
+ 	self deny: (coInterpreter methodHasCogMethod: aMethodObj).
+ 	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
+ 	"If the generators for the alternate bytecode set are missing then interpret."
+ 	(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
+ 		ifTrue:
+ 			[(self numElementsIn: generatorTable) <= 256 ifTrue:
+ 				[^nil].
+ 			 bytecodeSetOffset := 256]
+ 		ifFalse:
+ 			[bytecodeSetOffset := 0].
+ 	objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
+ 	methodObj := aMethodObj.
+ 	methodHeader := objectMemory methodHeaderOf: aMethodObj.
+ 	cogMethod := self compileCogFullBlockMethod.
+ 	(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
+ 		[cogMethod asInteger = InsufficientCodeSpace ifTrue:
+ 			[coInterpreter callForCogCompiledCodeCompaction].
+ 		 self maybeFreeCounters.
+ 		 "Right now no errors should be reported, so nothing more to do."
+ 		 "self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
+ 		 ^nil].
+ 	"self cCode: ''
+ 		inSmalltalk:
+ 			[coInterpreter printCogMethod: cogMethod.
+ 			 ""coInterpreter symbolicMethod: aMethodObj.""
+ 			 self assertValidMethodMap: cogMethod."
+ 			 "self disassembleMethod: cogMethod."
+ 			 "printInstructions := clickConfirm := true""]."
+ 	^cogMethod!

Item was added:
+ ----- Method: Cogit>>compileCogFullBlockMethod (in category 'compile abstract instructions') -----
+ compileCogFullBlockMethod
+ 	<returnTypeC: #'CogMethod *'>
+ 	| numBytecodes numBlocks numCleanBlocks result |
+ 	hasYoungReferent := (objectMemory isYoungObject: methodObj).
+ 	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
+ 	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.
+ 	self allocateOpcodes: (numBytecodes + 10) * self estimateOfAbstractOpcodesPerBytecodes
+ 		bytecodes: numBytecodes
+ 		ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
+ 	(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) < 0 ifTrue:
+ 		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
+ 	^self generateCogFullBlock!

Item was added:
+ ----- Method: Cogit>>compileEntireFullBlockMethod (in category 'compile abstract instructions') -----
+ compileEntireFullBlockMethod
+ 	"Compile the abstract instructions for the entire method, including blocks."
+ 	| result |	
+ 	self compileFullBlockEntry.
+ 
+ 	"Frame build"
+ 	self compileFullBlockMethodFrameBuild.
+ 	"Method body"
+ 	(result := self compileMethodBody) < 0 ifTrue:
+ 		[^result].
+ 	self assert: blockCount = 0.
+ 	^0!

Item was added:
+ ----- Method: Cogit>>compileFullBlockEntry (in category 'compile abstract instructions') -----
+ compileFullBlockEntry
+ 	"Compile the abstract instructions for the entire method, including blocks."
+ 	| jumpNoContextSwitch |
+ 
+ 	"Abort for stack overflow on full block activation (no inline cache miss possible).
+ 	 The flag is SendNumArgsReg."
+ 	fullBlockStackOverflowCall := self MoveCq: 0 R: ReceiverResultReg.
+ 	backEnd hasLinkRegister ifTrue: [self PushR: LinkReg].
+ 	"Since the only case in which this is called is the
+ 	 stack overflow case we can reuse the trampoline."
+ 	self Call: (self methodAbortTrampolineFor: methodOrBlockNumArgs).
+ 
+ 	"Entries"
+ 	"No context switch entry"
+ 	fullBlockNoContextSwitchEntry := self MoveCq: 0 R: SendNumArgsReg.
+ 	jumpNoContextSwitch := self Jump: 0.
+ 
+ 	self AlignmentNops: (objectMemory wordSize max: 8).
+ 	"Context switch entry (use ReceiverResultReg as a non-zero value; it's shorter)."
+ 	fullBlockEntry := self MoveR: ReceiverResultReg R: SendNumArgsReg.
+ 	jumpNoContextSwitch jmpTarget: self Label.
+ 
+ 	^0!

Item was added:
+ ----- Method: Cogit>>computeFullBlockEntryOffsets (in category 'initialization') -----
+ computeFullBlockEntryOffsets
+ 	"Generate the entry code for a method to determine cmEntryOffset and cmNoCheckEntryOffset.  We
+ 	 need cmNoCheckEntryOffset up front to be able to generate the map starting from cmNoCheckEntryOffset"
+ 	"stack allocate the various collections so that they
+ 	 are effectively garbage collected on return."
+ 	<var: 'sendMissCall' type: #'AbstractInstruction *'>
+ 	self allocateOpcodes: 24 bytecodes: 0.
+ 	methodOrBlockNumArgs := 0.
+ 	self compileFullBlockEntry.
+ 	self computeMaximumSizes.
+ 	self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod).
+ 	cbEntryOffset := fullBlockEntry address - methodZoneBase.
+ 	cbNoSwitchEntryOffset := fullBlockNoContextSwitchEntry address - methodZoneBase!

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: [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>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  		- if it contans an unknown bytecode
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
- 	inBlock := false.
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := extB := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  				[^EncounteredUnknownBytecode].
  			 self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse: [latestContinuation := latestContinuation max: targetPC]].
  		 descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
  		 self cppIf: NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0]].
  	^numBlocks!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForSqueak (in category 'class initialization') -----
  initializePrimitiveTableForSqueak
  	"Initialize the table of primitive generators.  This does not include normal primitives implemented in the coInterpreter.
  	 N.B. primitives that don't have an explicit arg count (the integer following the generator) may be variadic."
  	"SimpleStackBasedCogit initializePrimitiveTableForSqueak"
  	MaxCompiledPrimitiveIndex := self objectRepresentationClass wordSize = 8
  										ifTrue: [555]
  										ifFalse: [222].
  	primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1).
  	self table: primitiveTable from: 
  	#(	"Integer Primitives (0-19)"
  		(1 genPrimitiveAdd				1)
  		(2 genPrimitiveSubtract			1)
  		(3 genPrimitiveLessThan		1)
  		(4 genPrimitiveGreaterThan		1)
  		(5 genPrimitiveLessOrEqual		1)
  		(6 genPrimitiveGreaterOrEqual	1)
  		(7 genPrimitiveEqual			1)
  		(8 genPrimitiveNotEqual		1)
  		(9 genPrimitiveMultiply			1)
  		(10 genPrimitiveDivide			1)
  		(11 genPrimitiveMod			1)
  		(12 genPrimitiveDiv				1)
  		(13 genPrimitiveQuo			1)
  		(14 genPrimitiveBitAnd			1)
  		(15 genPrimitiveBitOr			1)
  		(16 genPrimitiveBitXor			1)
  		(17 genPrimitiveBitShift			1)
  		"(18 primitiveMakePoint)"
  		"(19 primitiveFail)"					"Guard primitive for simulation -- *must* fail"
  
  		"LargeInteger Primitives (20-39)"
  		"(20 primitiveFail)"
  		"(21 primitiveAddLargeIntegers)"
  		"(22 primitiveSubtractLargeIntegers)"
  		"(23 primitiveLessThanLargeIntegers)"
  		"(24 primitiveGreaterThanLargeIntegers)"
  		"(25 primitiveLessOrEqualLargeIntegers)"
  		"(26 primitiveGreaterOrEqualLargeIntegers)"
  		"(27 primitiveEqualLargeIntegers)"
  		"(28 primitiveNotEqualLargeIntegers)"
  		"(29 primitiveMultiplyLargeIntegers)"
  		"(30 primitiveDivideLargeIntegers)"
  		"(31 primitiveModLargeIntegers)"
  		"(32 primitiveDivLargeIntegers)"
  		"(33 primitiveQuoLargeIntegers)"
  		"(34 primitiveBitAndLargeIntegers)"
  		"(35 primitiveBitOrLargeIntegers)"
  		"(36 primitiveBitXorLargeIntegers)"
  		"(37 primitiveBitShiftLargeIntegers)"
  
  		"Float Primitives (38-59)"
  		"(38 genPrimitiveFloatAt)"
  		"(39 genPrimitiveFloatAtPut)"
  		(40 genPrimitiveAsFloat					0)
  		(41 genPrimitiveFloatAdd				1)
  		(42 genPrimitiveFloatSubtract			1)
  		(43 genPrimitiveFloatLessThan			1)
  		(44 genPrimitiveFloatGreaterThan		1)
  		(45 genPrimitiveFloatLessOrEqual		1)
  		(46 genPrimitiveFloatGreaterOrEqual	1)
  		(47 genPrimitiveFloatEqual				1)
  		(48 genPrimitiveFloatNotEqual			1)
  		(49 genPrimitiveFloatMultiply			1)
  		(50 genPrimitiveFloatDivide				1)
  		"(51 genPrimitiveTruncated)"
  		"(52 genPrimitiveFractionalPart)"
  		"(53 genPrimitiveExponent)"
  		"(54 genPrimitiveTimesTwoPower)"
  		(55 genPrimitiveFloatSquareRoot		0)
  		"(56 genPrimitiveSine)"
  		"(57 genPrimitiveArctan)"
  		"(58 genPrimitiveLogN)"
  		"(59 genPrimitiveExp)"
  
  		"Subscript and Stream Primitives (60-67)"
  		(60 genPrimitiveAt				1)
  		(61 genPrimitiveAtPut			2)
  		(62 genPrimitiveSize			0)
  		(63 genPrimitiveStringAt		1)
  		(64 genPrimitiveStringAtPut		2)
  		"The stream primitives no longer pay their way; normal Smalltalk code is faster."
  		(65 genFastPrimFail)"was primitiveNext"
  		(66 genFastPrimFail) "was primitiveNextPut"
  		(67 genFastPrimFail) "was primitiveAtEnd"
  
  		"StorageManagement Primitives (68-79)"
  		(68 genPrimitiveObjectAt			1)	"Good for debugger/InstructionStream performance"
  		"(69 primitiveObjectAtPut)"
  		(70 genPrimitiveNew			0)
  		(71 genPrimitiveNewWithArg	1)
  		"(72 primitiveArrayBecomeOneWay)"		"Blue Book: primitiveBecome"
  		"(73 primitiveInstVarAt)"
  		"(74 primitiveInstVarAtPut)"
  		(75 genPrimitiveIdentityHash	0)
  		"(76 primitiveStoreStackp)"					"Blue Book: primitiveAsObject"
  		"(77 primitiveSomeInstance)"
  		"(78 primitiveNextInstance)"
  		(79 genPrimitiveNewMethod	2)
  
  		"Control Primitives (80-89)"
  		"(80 primitiveFail)"							"Blue Book: primitiveBlockCopy"
  		"(81 primitiveFail)"							"Blue Book: primitiveValue"
  		"(82 primitiveFail)"							"Blue Book: primitiveValueWithArgs"
  		(83 genPrimitivePerform)
  		"(84 primitivePerformWithArgs)"
  		"(85 primitiveSignal)"
  		"(86 primitiveWait)"
  		"(87 primitiveResume)"
  		"(88 primitiveSuspend)"
  		"(89 primitiveFlushCache)"
  
  		"System Primitives (110-119)"
  		(110 genPrimitiveIdentical 1)
  		(111 genPrimitiveClass)				"Support both class and Context>>objectClass:"
  		"(112 primitiveBytesLeft)"
  		"(113 primitiveQuit)"
  		"(114 primitiveExitToDebugger)"
  		"(115 primitiveChangeClass)"					"Blue Book: primitiveOopsLeft"
  		"(116 primitiveFlushCacheByMethod)"
  		"(117 primitiveExternalCall)"
  		"(118 primitiveDoPrimitiveWithArgs)"
  		"(119 primitiveFlushCacheSelective)"
  
  		(169 genPrimitiveNotIdentical 1)
  
  		(170 genPrimitiveAsCharacter)				"SmallInteger>>asCharacter, Character class>>value:"
  		(171 genPrimitiveImmediateAsInteger 0)	"Character>>value SmallFloat64>>asInteger"
  			
  		"(173 primitiveSlotAt 1)"
  		"(174 primitiveSlotAtPut 2)"
  		(175 genPrimitiveIdentityHash	0)		"Behavior>>identityHash"
  
  		"Old closure primitives"
  		"(186 primitiveFail)" "was primitiveClosureValue"
  		"(187 primitiveFail)" "was primitiveClosureValueWithArgs"
  
  		"Perform method directly"
  		"(188 primitiveExecuteMethodArgsArray)"
  		"(189 primitiveExecuteMethod)"
  
  		"Unwind primitives"
  		"(195 primitiveFindNextUnwindContext)"
  		"(196 primitiveTerminateTo)"
  		"(197 primitiveFindHandlerContext)"
  		(198 genFastPrimFail "primitiveMarkUnwindMethod")
  		(199 genFastPrimFail "primitiveMarkHandlerMethod")
  
  		"new closure primitives"
  		"(200 primitiveClosureCopyWithCopiedValues)"
  		(201 genPrimitiveClosureValue	0) "value"
  		(202 genPrimitiveClosureValue	1) "value:"
  		(203 genPrimitiveClosureValue	2) "value:value:"
  		(204 genPrimitiveClosureValue	3) "value:value:value:"
  		(205 genPrimitiveClosureValue	4) "value:value:value:value:"
  		"(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:"
  
+ 		(207 genPrimitiveFullClosureValue) "value[:value:value:value:] et al"
+ 		"(208 genPrimitiveFullClosureValueWithArgs)" "valueWithArguments:"
+ 		(209 genPrimitiveFullClosureValueNoContextSwitch) "valueNoContextSwitch[:value:] et al"
+ 
  		"(210 primitiveContextAt)"
  		"(211 primitiveContextAtPut)"
  		"(212 primitiveContextSize)"
  
  		"(218 primitiveDoNamedPrimitiveWithArgs)"
  		"(219 primitiveFail)"	"reserved for Cog primitives"
  
  		"(220 primitiveFail)"		"reserved for Cog primitives"
  
  		(221 genPrimitiveClosureValue	0) "valueNoContextSwitch"
  		(222 genPrimitiveClosureValue	1) "valueNoContextSwitch:"
  
  		"SmallFloat primitives (540-559)"
  		(541 genPrimitiveSmallFloatAdd				1)
  		(542 genPrimitiveSmallFloatSubtract			1)
  		(543 genPrimitiveSmallFloatLessThan			1)
  		(544 genPrimitiveSmallFloatGreaterThan		1)
  		(545 genPrimitiveSmallFloatLessOrEqual		1)
  		(546 genPrimitiveSmallFloatGreaterOrEqual		1)
  		(547 genPrimitiveSmallFloatEqual				1)
  		(548 genPrimitiveSmallFloatNotEqual			1)
  		(549 genPrimitiveSmallFloatMultiply				1)
  		(550 genPrimitiveSmallFloatDivide				1)
  		"(551 genPrimitiveSmallFloatTruncated			0)"
  		"(552 genPrimitiveSmallFloatFractionalPart		0)"
  		"(553 genPrimitiveSmallFloatExponent			0)"
  		"(554 genPrimitiveSmallFloatTimesTwoPower	1)"
  		(555 genPrimitiveSmallFloatSquareRoot			0)
  		"(556 genPrimitiveSmallFloatSine				0)"
  		"(557 genPrimitiveSmallFloatArctan				0)"
  		"(558 genPrimitiveSmallFloatLogN				0)"
  		"(559 genPrimitiveSmallFloatExp				0)"
  	)!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>compileFullBlockMethodFrameBuild (in category 'compile abstract instructions') -----
+ compileFullBlockMethodFrameBuild
+ 	"Build a frame for a block activation.  See CoInterpreter class>>initializeFrameIndices.
+ 	 		closure (in ReceiverResultReg)
+ 			arg0
+ 			...
+ 			argN
+ 			caller's saved ip/this stackPage (for a base frame)
+ 	fp->	saved fp
+ 			method
+ 			context (uninitialized?)
+ 			receiver
+ 			first temp
+ 			...
+ 	sp->	Nth temp
+ 	Avoid use of SendNumArgsReg which is the flag determining whether
+ 	context switch is allowed on stack-overflow."
+ 	<inline: false>
+ 	needsFrame ifFalse: [^self].
+ 	backEnd hasLinkRegister ifTrue:
+ 		[self PushR: LinkReg].
+ 	self PushR: FPReg.
+ 	self MoveR: SPReg R: FPReg.
+ 	"Think of ClassReg as ClosureReg"
+ 	self MoveR: ReceiverResultReg R: ClassReg.
+ 	"The block method field must have its MFMethodFlagIsBlockFlag bit set.
+ 	 We arrange this using a labelOffset.  A hack, but it works."
+ 	methodLabel addDependent: (self annotateAbsolutePCRef:
+ 			(self PushCw: methodLabel asInteger)). "method"
+ 	self annotate: (self PushCw: objectMemory nilObject) "context"
+ 		objRef: objectMemory nilObject.
+ 	"Fetch home receiver from outer context. closure is on stack and initially in ReceiverResultReg.
+ 	 It is safe to use Arg0Reg because reg args are pushed by the value primitives if there are any.".
+ 	
+ 	self flag: 'we could do the following only if the block has inst var ref'.
+ 	"Use ReceiverResultReg for Context to agree with store check trampoline"
+ 	objectRepresentation
+ 		genLoadSlot: FullClosureReceiverIndex
+ 			sourceReg: ClassReg
+ 				destReg: Arg0Reg.
+ 	objectRepresentation
+ 		genEnsureOopInRegNotForwarded: Arg0Reg scratchReg: TempReg updatingSlot: FullClosureReceiverIndex in: ReceiverResultReg.
+ 	self MoveR: Arg0Reg R: ReceiverResultReg.
+ 	self PushR: ReceiverResultReg. "closure receiver"
+ 	"Push copied values; bytecode initializes temporaries"
+ 	self flag: 'numCopied needs to be passed as parameter'.
+ 	0 to: self numCopied - 1 do:
+ 		[:i|
+ 		objectRepresentation
+ 			genLoadSlot: i + FullClosureFirstCopiedValueIndex
+ 			sourceReg: ClassReg
+ 			destReg: TempReg.
+ 		self PushR: TempReg].
+ 	self MoveAw: coInterpreter stackLimitAddress R: TempReg.
+ 	self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
+ 	self JumpBelow: stackOverflowCall.
+ 	stackCheckLabel := (self annotateBytecode: self Label)!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>fullBlockEntryOffset (in category 'accessing') -----
+ fullBlockEntryOffset
+ 	<api>
+ 	<cmacro>
+ 	^cbEntryOffset!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>fullBlockNoContextSwitchEntryOffset (in category 'accessing') -----
+ fullBlockNoContextSwitchEntryOffset
+ 	<api>
+ 	<cmacro>
+ 	^cbNoSwitchEntryOffset!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPrimitiveFullClosureValue (in category 'primitive generators') -----
+ genPrimitiveFullClosureValue
+ 	"Check the argument count.  Fail if wrong.
+ 	 Get the method from the outerContext and see if it is cogged.  If so, jump to the
+ 	 block entry or the no-context-switch entry, as appropriate, and we're done.  If not,
+ 	 invoke the interpreter primitive."
+ 	| jumpFailNArgs jumpFail3 jumpFail4 jumpBCMethod primitiveRoutine result |
+ 	<var: #jumpFail3 type: #'AbstractInstruction *'>
+ 	<var: #jumpFail4 type: #'AbstractInstruction *'>
+ 	<var: #jumpFailNArgs type: #'AbstractInstruction *'>
+ 	<var: #jumpBCMethod type: #'AbstractInstruction *'>
+ 	<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)()'>
+ 	objectRepresentation genLoadSlot: ClosureNumArgsIndex sourceReg: ReceiverResultReg destReg: TempReg.
+ 	self CmpCq: (objectMemory integerObjectOf: methodOrBlockNumArgs) R: TempReg.
+ 	jumpFailNArgs := self JumpNonZero: 0.
+ 
+ 	"We defer unforwarding the receiver to the prologue; scanning blocks
+ 	 for inst var refs and only unforwarding if the block refers to inst vars."
+ 	(false
+ 	 and: [objectRepresentation hasSpurMemoryManagerAPI]) ifTrue:
+ 		[objectRepresentation
+ 			genLoadSlot: FullClosureReceiverIndex sourceReg: ReceiverResultReg destReg: SendNumArgsReg;
+ 			genEnsureOopInRegNotForwarded: SendNumArgsReg
+ 			scratchReg: TempReg
+ 			updatingSlot: FullClosureReceiverIndex
+ 			in: ReceiverResultReg].
+ 	objectRepresentation genLoadSlot: FullClosureCompiledBlockIndex sourceReg: ReceiverResultReg destReg: SendNumArgsReg.
+ 	jumpFail3 := objectRepresentation genJumpImmediate: SendNumArgsReg.
+ 	objectRepresentation genGetFormatOf: SendNumArgsReg into: TempReg.
+ 	self CmpCq: objectMemory firstCompiledMethodFormat R: TempReg.
+ 	jumpFail4 := self JumpLess: 0.
+ 	objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
+ 	jumpBCMethod := objectRepresentation genJumpImmediate: ClassReg.
+ 
+ 	primitiveRoutine := coInterpreter
+ 							functionPointerForCompiledMethod: methodObj
+ 							primitiveIndex: primitiveIndex.
+ 	self AddCq: (primitiveRoutine = #primitiveFullClosureValueNoContextSwitch
+ 					ifTrue: [self fullBlockNoContextSwitchEntryOffset]
+ 					ifFalse: [self fullBlockEntryOffset])
+ 		 R: ClassReg.
+ 	self JumpR: TempReg.
+ 	jumpBCMethod jmpTarget: (jumpFail3 jmpTarget: (jumpFail4 jmpTarget: self Label)).
+ 	(result := self compileInterpreterPrimitive: primitiveRoutine) < 0 ifTrue:
+ 		[^result].
+ 	jumpFailNArgs jmpTarget: self Label.
+ 	^CompletePrimitive!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  		- how many counters it needs/conditional branches it contains
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
- 	inBlock := false.
  	prevBCDescriptor := nil.
  	numCounters := 0.
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := extB := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  				[^EncounteredUnknownBytecode].
  			 self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse:
  					[latestContinuation := latestContinuation max: targetPC.
  					 (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
  						[numCounters := numCounters + 1]]].
  		 descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
- 	inBlock := false.
  	prevBCDescriptor := nil.
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := extB := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  				[^EncounteredUnknownBytecode].
  			 self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse: [latestContinuation := latestContinuation max: targetPC]].
  		 descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!



More information about the Vm-dev mailing list