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

commits at source.squeak.org commits at source.squeak.org
Sun Jun 1 17:08:46 UTC 2014


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

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

Name: VMMaker.oscog-eem.743
Author: eem
Time: 1 June 2014, 10:05:56.461 am
UUID: 92a02694-b094-4525-b2e2-c166faf67785
Ancestors: VMMaker.oscog-eem.742

Refactor closure creation in the Cogit to move it into the
object representations.  In Spur allocate and initialize the
closure inline.

In Spur make sure to always use unsigned comparisons for
allocation against scavenge threshold.

Fix bugs in Spur object representation's context creation
trampolines. Source and destination offsets for args were
wrong. Destination offset for temps was wrong.  Loop
comparisons were wrong way round (CmpR:R: is weird).

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

Item was added:
+ ----- Method: CogObjectRepresentation>>genCreateClosureAt:numArgs:numCopied:contextNumArgs:large:inBlock: (in category 'bytecode generator support') -----
+ genCreateClosureAt: bcpc numArgs: numArgs numCopied: numCopied contextNumArgs: ctxtNumArgs large: isLargeCtxt inBlock: isInBlock
+ 	"Create a closure with the given startpc, numArgs and numCopied
+ 	 within a context with ctxtNumArgs, large if isLargeCtxt that is in a
+ 	 block if isInBlock.  If numCopied > 0 pop those values off the stack."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genCreateClosureAt:numArgs:numCopied:contextNumArgs:large:inBlock: (in category 'bytecode generator support') -----
+ genCreateClosureAt: bcpc numArgs: numArgs numCopied: numCopied contextNumArgs: ctxtNumArgs large: isLargeCtxt inBlock: isInBlock
+ 	"Create a closure with the given startpc, numArgs and numCopied
+ 	 within a context with ctxtNumArgs, large if isLargeCtxt that is in a
+ 	 block if isInBlock.  If numCopied > 0 pop those values off the stack."
+ 	| slotSize header skip |
+ 	<var: #skip type: #'AbstractInstruction *'>
+ 
+ 	"First get thisContext into ReceiverResultRega and thence in ClassReg."
+ 	self genGetActiveContextNumArgs: ctxtNumArgs large: isLargeCtxt inBlock: isInBlock.
+ 	cogit MoveR: ReceiverResultReg R: ClassReg.
+ 
+ 	slotSize := ClosureFirstCopiedValueIndex + numCopied.
+ 	header := objectMemory
+ 					headerForSlots: slotSize
+ 					format: objectMemory indexablePointersFormat
+ 					classIndex: ClassBlockClosureCompactIndex.
+ 	cogit
+ 		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
+ 		MoveCq: (self cCoerceSimple: header to: #usqInt) R: TempReg;
+ 		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
+ 		MoveCq: header >> 32 R: TempReg;
+ 		MoveR: TempReg Mw: 4 r: ReceiverResultReg;
+ 		MoveR: ReceiverResultReg R: TempReg;
+ 		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
+ 		MoveR: TempReg Aw: objectMemory freeStartAddress;
+ 		CmpCq: objectMemory getScavengeThreshold R: TempReg.
+ 	skip := cogit JumpBelow: 0.
+ 	cogit CallRT: ceSheduleScavengeTrampoline.
+ 	skip jmpTarget: cogit Label.
+ 
+ 	cogit
+ 		MoveR: ClassReg Mw: ClosureOuterContextIndex * BytesPerOop + BaseHeaderSize r: ReceiverResultReg;
+ 		MoveCq: (objectMemory integerObjectOf: bcpc) R: TempReg;
+ 		MoveR: TempReg Mw: ClosureStartPCIndex * BytesPerOop + BaseHeaderSize r: ReceiverResultReg;
+ 		MoveCq: (objectMemory integerObjectOf: numArgs) R: TempReg;
+ 		MoveR: TempReg Mw: ClosureNumArgsIndex * BytesPerOop + BaseHeaderSize r: ReceiverResultReg.
+ 	1 to: numCopied do:
+ 		[:i|
+ 		cogit
+ 			PopR: TempReg;
+ 			MoveR: TempReg
+ 				Mw: numCopied - i + ClosureFirstCopiedValueIndex * BytesPerOop + BaseHeaderSize
+ 					r: ReceiverResultReg].
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>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
  		MoveMw: FoxMethod r: FPReg R: TempReg;
  		MoveR: TempReg R: ClassReg;
  		AndCq: MFMethodFlagHasContextFlag R: TempReg.
  	jumpSingle := cogit JumpZero: 0.
  	cogit
  		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
  		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;
  		MoveCq: (self cCoerceSimple: header to: #usqInt) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg;
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
+ 	jumpNeedScavenge := cogit JumpAboveOrEqual: 0.
- 	jumpNeedScavenge := cogit JumpGreaterOrEqual: 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: BaseHeaderSize + (SenderIndex * BytesPerOop) r: ReceiverResultReg.
+ 
  	"pc gets frame caller as a SmallInteger"
  	cogit MoveMw: FoxSavedFP r: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: BaseHeaderSize + (InstructionPointerIndex * 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: BaseHeaderSize + (MethodIndex * BytesPerWord) r: ReceiverResultReg;
  		MoveR: ReceiverResultReg Mw: FoxThisContext r: FPReg.
+ 
  	"Now compute stack pointer; this is stackPointer (- 1 for return pc if a CISC) - framePointer - 4 (1 each for saved pc, method, context, receiver) + 1 (1-relative)"
  	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: BaseHeaderSize + (StackPointerIndex * BytesPerOop) r: ReceiverResultReg.
  
+ 	"Set closureOrNil to either the stacked receiver or nil"
- 	"now initialize the fields of the new context, initializing stack with the current stack contents.
- 	 See CoInterpreter>>marryFrame:SP:copyTemps:"
- 	"Receiver[ClosureOrNil] := inBlock ifTrue: [longAt(FPReg + (SendNumArgs * BytesPerWord)] ifFalse: [nilObject].
- 	 0 to: numArgs - 1 do:
- 		[:i|
- 		temp := longAt(FPReg + ((SendNumArgs - i) * BytesPerWord)).
- 		longAtput(FPReg + FoxMFReceiver + (i * BytesPerWord), temp)]"
- 	cogit MoveCq: 0 R: ClassReg.
  	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 MoveCw: objectMemory nilObject R: TempReg].
+ 	cogit MoveR: TempReg Mw: BaseHeaderSize + (ClosureIndex * BytesPerOop) r: ReceiverResultReg.
+ 
+ 	"Set the receiver"
- 	cogit MoveR: TempReg Mw: BaseHeaderSize + (ClosureIndex * BytesPerWord) r: ReceiverResultReg.
- 	loopHead := cogit CmpR: ClassReg R: SendNumArgsReg.
- 	exit := cogit JumpGreaterOrEqual: 0.
  	cogit
+ 		MoveMw: FoxMFReceiver r: FPReg R: TempReg;
+ 		MoveR: TempReg Mw: BaseHeaderSize + (ReceiverIndex * 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) * BytesPerWord)). +2 for saved pc and savedfp
+ 		longAtput(FPReg + FoxMFReceiver + (i * BytesPerWord), temp)]"
+ 	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 + (BaseHeaderSize / BytesPerWord) R: ClassReg; "Now convert ClassReg from frame index to context index"
- 		AddCq: ReceiverIndex R: ClassReg;
  		MoveR: TempReg Xwr: ClassReg R: ReceiverResultReg;
+ 		SubCq: ReceiverIndex + (BaseHeaderSize / BytesPerWord) - 1 R: ClassReg; "convert back adding 1 ;-)"
- 		SubCq: ReceiverIndex - 1 R: ClassReg; "add 1 ;-)"
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
+ 	"Finally copy the temps.
- 	"Initialize the receiver and the temps.  SendNumArgsReg is now free.
  	 ClassReg := FPReg + FoxMFReceiver.
- 	 receiver[ReceiverIndex] := *ClassReg.
  	 SendNumArgsReg := SendNumArgsReg+ReceiverIndex.
+ 	 [ClassReg := ClassReg - 4.
+ 	  backEnd hasLinkRegister
+ 			ifTrue: [ClassReg > SPReg]
+ 			ifFalse: [ClassReg >= SPReg]] whileTrue:
+ 		[receiver[SendNumArgsReg] := *ClassReg.
+ 		 SendNumArgsReg := SendNumArgsReg + 1]]"
- 	 backEnd hasLinkRegister
- 		ifTrue: [[ClassReg > SPReg] whileTrue: [receiver[SendNumArgsReg] := *ClassReg. ClassReg := ClassReg - 4. SendNumArgsReg := SendNumArgsReg + 1]]
- 		ifFalse: [[ClassReg >= SPReg] whileTrue: [receiver[SendNumArgsReg] := *ClassReg. ClassReg := ClassReg - 4. SendNumArgsReg := SendNumArgsReg + 1]]"
  	cogit
  		MoveR: FPReg R: ClassReg;
  		AddCq: FoxMFReceiver R: ClassReg;
+ 		AddCq: ReceiverIndex + 1 + (BaseHeaderSize / BytesPerWord) R: SendNumArgsReg.
- 		MoveMw: 0 r: ClassReg R: TempReg;
- 		MoveR: TempReg Mw: BaseHeaderSize + (ReceiverIndex * BytesPerOop) r: ReceiverResultReg;
- 		AddCq: ReceiverIndex + (BaseHeaderSize / BytesPerWord) + 1 R: SendNumArgsReg.
  	loopHead :=
  	cogit SubCq: BytesPerWord R: ClassReg.
+ 	cogit CmpR: SPReg R: ClassReg.
- 	cogit CmpR: SPReg R: ClassReg. "cogit CmpR: ClassReg R: SPReg."
  	exit := cogit backEnd hasLinkRegister
+ 				ifTrue: [cogit JumpBelowOrEqual: 0]
+ 				ifFalse: [cogit JumpBelow: 0].
- 				ifTrue: [cogit JumpLessOrEqual: 0]
- 				ifFalse: [cogit JumpLess: 0].
  	cogit
  		MoveMw: 0 r: ClassReg R: TempReg;
  		MoveR: TempReg Xwr: SendNumArgsReg R: ReceiverResultReg;
  		AddCq: 1 R: SendNumArgsReg;
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
+ 
  	cogit RetN: 0.
  	
  	jumpNeedScavenge jmpTarget:
  		(cogit CallRT: ceSheduleScavengeTrampoline).
  	cogit Jump: continuation.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genNewArrayOfSize:initialized: (in category 'bytecode generator support') -----
  genNewArrayOfSize: size initialized: initialized
  	"Generate a call to code that allocates a new Array of size.
  	 The Array should be initialized with nils iff initialized is true.
  	 The size arg is passed in SendNumArgsReg, the result
  	 must come back in ReceiverResultReg."
  	| header skip |
  	<var: #skip type: #'AbstractInstruction *'>
  	self assert: size < objectMemory numSlotsMask.
  	header := objectMemory
  					headerForSlots: size
  					format: objectMemory arrayFormat
  					classIndex: ClassArrayCompactIndex.
  	self flag: #endianness.
  	cogit
  		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
  		MoveCq: (self cCoerceSimple: header to: #usqInt) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg.
  	(initialized and: [size > 0]) ifTrue:
  		[cogit MoveCw: objectMemory nilObject R: TempReg.
  		 1 to: size do:
  			[:i| cogit MoveR: TempReg Mw: i * 4 + 4 r: ReceiverResultReg]].
  	cogit
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: size) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
+ 	skip := cogit JumpBelow: 0.
- 	skip := cogit JumpLess: 0.
  	cogit CallRT: ceSheduleScavengeTrampoline.
  	skip jmpTarget: cogit Label.
  	^0!

Item was changed:
  CogObjectRepresentation subclass: #CogObjectRepresentationForSqueakV3
+ 	instanceVariableNames: 'ceCreateNewArrayTrampoline cePositive32BitIntegerTrampoline ceActiveContextTrampoline ceClosureCopyTrampoline'
- 	instanceVariableNames: 'ceCreateNewArrayTrampoline cePositive32BitIntegerTrampoline ceActiveContextTrampoline'
  	classVariableNames: 'RootBitDigitLength'
  	poolDictionaries: 'VMSqueakClassIndices VMSqueakV3ObjectRepresentationConstants'
  	category: 'VMMaker-JIT'!
  
  !CogObjectRepresentationForSqueakV3 commentStamp: '<historical>' prior: 0!
  Read my superclass' class comment.  I am a CogObjectRepresentation for the Squeak V3 object representation.!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genCreateClosureAt:numArgs:numCopied:contextNumArgs:large:inBlock: (in category 'bytecode generator support') -----
+ genCreateClosureAt: bcpc numArgs: numArgs numCopied: numCopied contextNumArgs: ctxtNumArgs large: isLargeCtxt inBlock: isInBlock
+ 	"Create a closure with the given startpc, numArgs and numCopied
+ 	 within a context with ctxtNumArgs, large if isLargeCtxt that is in a
+ 	 block if isInBlock.  If numCopied > 0 pop those values off the stack."
+ 	
+ 	"see ceClosureCopyDescriptor:"
+ 	cogit MoveCq: numArgs + (numCopied << 6) + (bcpc << 12) R: SendNumArgsReg.
+ 	cogit CallRT: ceClosureCopyTrampoline.
+ 	numCopied > 0 ifTrue:
+ 		[cogit AddCq: numCopied * BytesPerWord R: SPReg].
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	super generateObjectRepresentationTrampolines.
  	ceCreateNewArrayTrampoline := cogit genTrampolineFor: #ceNewArraySlotSize:
  											called: 'ceCreateNewArrayTrampoline'
  											arg: SendNumArgsReg
  											result: ReceiverResultReg.
  	cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #cePositive32BitIntegerFor:
+ 												called: 'cePositive32BitIntegerTrampoline'
+ 												arg: ReceiverResultReg
+ 												result: TempReg.
+ 	ceActiveContextTrampoline := self genActiveContextTrampoline.
+ 	ceClosureCopyTrampoline := cogit genTrampolineFor: #ceClosureCopyDescriptor:
+ 										called: 'ceClosureCopyTrampoline'
+ 										arg: SendNumArgsReg
+ 										result: ReceiverResultReg!
- 											called: 'cePositive32BitIntegerTrampoline'
- 											arg: ReceiverResultReg
- 											result: TempReg.
- 	ceActiveContextTrampoline := self genActiveContextTrampoline!

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 initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent usesMethodClass primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
- 	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 initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent usesMethodClass primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass UnimplementedPrimitive YoungSelectorInPIC'
  	poolDictionaries: 'CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
  !Cogit commentStamp: 'eem 2/13/2013 15:37' 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 eventuakly teh 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>>generateRunTimeTrampolines (in category 'initialization') -----
  generateRunTimeTrampolines
  	"Generate the run-time entries at the base of the native code zone and update the base."
  	
  	ceSendMustBeBooleanAddFalseTrampoline := self genMustBeBooleanTrampolineFor: objectMemory falseObject
  														called: 'ceSendMustBeBooleanAddFalseTrampoline'.
  	ceSendMustBeBooleanAddTrueTrampoline := self genMustBeBooleanTrampolineFor: objectMemory trueObject
  														called: 'ceSendMustBeBooleanAddTrueTrampoline'.
- 	ceClosureCopyTrampoline := self genTrampolineFor: #ceClosureCopyDescriptor:
- 									called: 'ceClosureCopyTrampoline'
- 									arg: SendNumArgsReg
- 									result: ReceiverResultReg.
  	ceNonLocalReturnTrampoline := self genNonLocalReturnTrampoline.
  	ceBaseFrameReturnTrampoline := self genTrampolineFor: #ceBaseFrameReturn:
  										called: 'ceBaseFrameReturnTrampoline'
  										arg: ReceiverResultReg.
  	ceCheckForInterruptTrampoline := self genCheckForInterruptsTrampoline.
  	ceFetchContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:
  											called: 'ceFetchContextInstVarTrampoline'
  											arg: ReceiverResultReg
  											arg: SendNumArgsReg
  											result: SendNumArgsReg.
  	ceStoreContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:value:
  											called: 'ceStoreContextInstVarTrampoline'
  											arg: ReceiverResultReg
  											arg: SendNumArgsReg
  											arg: ClassReg
  											result: ReceiverResultReg. "to keep ReceiverResultReg live."
  	ceReturnToInterpreterTrampoline := self genTrampolineFor: #ceReturnToInterpreter:
  											called: 'ceReturnToInterpreterTrampoline'
  											arg: ReceiverResultReg.
  	ceCannotResumeTrampoline := self genTrampolineFor: #ceCannotResume
  											called: 'ceCannotResumeTrampoline'!

Item was changed:
  ----- Method: Cogit>>generateTrampolines (in category 'initialization') -----
  generateTrampolines
  	"Generate the run-time entries and exits at the base of the native code zone and update the base.
  	 Read the class-side method trampolines for documentation on the various trampolines"
  	| methodZoneStart |
  	methodZoneStart := methodZoneBase.
+ 	self allocateOpcodes: 80 bytecodes: 0.
- 	self allocateOpcodes: 72 bytecodes: 0.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	hasYoungReferent := false.
  	self generateSendTrampolines.
  	self generateMissAbortTrampolines.
  	objectRepresentation generateObjectRepresentationTrampolines.
  	self generateRunTimeTrampolines.
  	self cppIf: NewspeakVM ifTrue: 	[self generateNewspeakRuntime].
  	self generateEnilopmarts.
  	self generateTracingTrampolines.
  
  	"finish up"
  	self recordGeneratedRunTime: 'methodZoneBase' address: methodZoneBase.
  	processor flushICacheFrom: methodZoneStart to: methodZoneBase.
  	self cCode: ''
  		inSmalltalk:
  			[simulatedTrampolines keysAndValuesDo:
  				[:addr :selector|
  				simulatedTrampolines
  					at: addr
  					put: (MessageSend
  							receiver: ((self respondsTo: selector)
  										ifTrue: [self]
  										ifFalse: [(coInterpreter respondsTo: selector)
  													ifTrue: [coInterpreter]
  													ifFalse: [(objectMemory respondsTo: selector)
  														ifTrue: [objectMemory]
  														ifFalse: [self notify: 'cannot find receiver for ', selector]]])
  							selector: selector
  							arguments: (1 to: selector numArgs) asArray)]]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genExtPushClosureBytecode (in category 'bytecode generators') -----
  genExtPushClosureBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
  	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"253		11111101 eei i i kkk	jjjjjjjj		Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
  	| numArgs numCopied |
  	self assert: needsFrame.
  	self addBlockStartAt: bytecodePC + 3 "0 relative"
  		numArgs: (numArgs := (byte1 bitAnd: 16r7) + (extA \\ 16 * 8))
  		numCopied: (numCopied := ((byte1 >> 3) bitAnd: 7) + (extA // 16 * 8))
  		span: byte2 + (extB << 8).
  	extA := extB := 0.
+ 	objectRepresentation
+ 		genCreateClosureAt: bytecodePC + 4 "1 relative"
+ 		numArgs: numArgs
+ 		numCopied: numCopied
+ 		contextNumArgs: methodOrBlockNumArgs
+ 		large: (coInterpreter methodNeedsLargeContext: methodObj)
+ 		inBlock: inBlock.
+ 	self PushR: ReceiverResultReg.
- 	"see ceClosureCopyDescriptor:"
- 	self MoveCq: numArgs + (numCopied << 6) + (bytecodePC + 4 "1 relative" << 12) R: SendNumArgsReg.
- 	self CallRT: ceClosureCopyTrampoline.
- 	numCopied > 0
- 		ifTrue:
- 			[numCopied > 1 ifTrue:
- 				[self AddCq: (numCopied - 1) * BytesPerWord R: SPReg].
- 			 self MoveR: ReceiverResultReg Mw: 0 r: SPReg]
- 		ifFalse:
- 			[self PushR: ReceiverResultReg].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPushClosureCopyCopiedValuesBytecode (in category 'bytecode generators') -----
  genPushClosureCopyCopiedValuesBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
  	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"143   10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii"
  	| numArgs numCopied |
  	self assert: needsFrame.
  	self addBlockStartAt: bytecodePC + 4 "0 relative"
  		numArgs: (numArgs := byte1 bitAnd: 16rF)
  		numCopied: (numCopied := byte1 >> 4)
  		span: (byte2 << 8) + byte3.
+ 	objectRepresentation
+ 		genCreateClosureAt: bytecodePC + 5 "1 relative"
+ 		numArgs: numArgs
+ 		numCopied: numCopied
+ 		contextNumArgs: methodOrBlockNumArgs
+ 		large: (coInterpreter methodNeedsLargeContext: methodObj)
+ 		inBlock: inBlock.
+ 	self PushR: ReceiverResultReg.
- 	"see ceClosureCopyDescriptor:"
- 	self MoveCq: numArgs + (numCopied << 6) + (bytecodePC + 5 "1 relative" << 12) R: SendNumArgsReg.
- 	self CallRT: ceClosureCopyTrampoline.
- 	numCopied > 0
- 		ifTrue:
- 			[numCopied > 1 ifTrue:
- 				[self AddCq: (numCopied - 1) * BytesPerWord R: SPReg].
- 			 self MoveR: ReceiverResultReg Mw: 0 r: SPReg]
- 		ifFalse:
- 			[self PushR: ReceiverResultReg].
  	^0!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>freeStart (in category 'accessing') -----
  freeStart
+ 	"freeStart = 16r1163E0 ifTrue: [self halt]."
- 	"freeStart = 16r1BDFF8 ifTrue: [self halt]."
  	^super freeStart!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genExtPushClosureBytecode (in category 'bytecode generators') -----
  genExtPushClosureBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
  	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"253		11111101 eei i i kkk	jjjjjjjj		Push Closure Num Copied iii (+ Ext A // 16 * 8) Num Args kkk (+ Ext A \\ 16 * 8) BlockSize jjjjjjjj (+ Ext B * 256). ee = num extensions"
  	| numArgs numCopied |
  	self assert: needsFrame.
  	self addBlockStartAt: bytecodePC + 3 "0 relative"
  		numArgs: (numArgs := (byte1 bitAnd: 16r7) + (extA \\ 16 * 8))
  		numCopied: (numCopied := ((byte1 >> 3) bitAnd: 7) + (extA // 16 * 8))
  		span: byte2 + (extB << 8).
  	extA := extB := 0.
  	numCopied > 0 ifTrue:
  		[self ssFlushTo: simStackPtr].
  	optStatus isReceiverResultRegLive: false.
+ 	objectRepresentation getActiveContextAllocatesInMachineCode
+ 		ifTrue: [self ssAllocateCallReg: ReceiverResultReg
+ 					and: SendNumArgsReg
+ 					and: ClassReg]
+ 		ifFalse: [self ssAllocateCallReg: SendNumArgsReg
+ 					and: ReceiverResultReg].
+ 	objectRepresentation
+ 		genCreateClosureAt: bytecodePC + 4 "1 relative"
+ 		numArgs: numArgs
+ 		numCopied: numCopied
+ 		contextNumArgs: methodOrBlockNumArgs
+ 		large: (coInterpreter methodNeedsLargeContext: methodObj)
+ 		inBlock: inBlock.
- 	self ssAllocateCallReg: SendNumArgsReg and: ReceiverResultReg.
- 	"see ceClosureCopyDescriptor:"
- 	self MoveCq: numArgs + (numCopied << 6) + (bytecodePC + 4 "1 relative" << 12) R: SendNumArgsReg.
- 	self CallRT: ceClosureCopyTrampoline.
  	numCopied > 0 ifTrue:
+ 		[self ssPop: numCopied].
- 		[self AddCq: numCopied * BytesPerWord R: SPReg.
- 		 self ssPop: numCopied].
  	^self ssPushRegister: ReceiverResultReg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushClosureCopyCopiedValuesBytecode (in category 'bytecode generators') -----
  genPushClosureCopyCopiedValuesBytecode
  	"Block compilation.  At this point in the method create the block.  Note its start
  	 and defer generating code for it until after the method and any other preceeding
  	 blocks.  The block's actual code will be compiled later."
  	"143   10001111 llllkkkk jjjjjjjj iiiiiiii	Push Closure Num Copied llll Num Args kkkk BlockSize jjjjjjjjiiiiiiii"
  	| numArgs numCopied |
  	self assert: needsFrame.
  	self addBlockStartAt: bytecodePC + 4 "0 relative"
  		numArgs: (numArgs := byte1 bitAnd: 16rF)
  		numCopied: (numCopied := byte1 >> 4)
  		span: (byte2 << 8) + byte3.
  	numCopied > 0 ifTrue:
  		[self ssFlushTo: simStackPtr].
  	optStatus isReceiverResultRegLive: false.
+ 	objectRepresentation getActiveContextAllocatesInMachineCode
+ 		ifTrue: [self ssAllocateCallReg: ReceiverResultReg
+ 					and: SendNumArgsReg
+ 					and: ClassReg]
+ 		ifFalse: [self ssAllocateCallReg: SendNumArgsReg
+ 					and: ReceiverResultReg].
+ 	objectRepresentation
+ 		genCreateClosureAt: bytecodePC + 5 "1 relative"
+ 		numArgs: numArgs
+ 		numCopied: numCopied
+ 		contextNumArgs: methodOrBlockNumArgs
+ 		large: (coInterpreter methodNeedsLargeContext: methodObj)
+ 		inBlock: inBlock.
- 	self ssAllocateCallReg: SendNumArgsReg and: ReceiverResultReg.
- 	"see ceClosureCopyDescriptor:"
- 	self MoveCq: numArgs + (numCopied << 6) + (bytecodePC + 5 "1 relative" << 12) R: SendNumArgsReg.
- 	self CallRT: ceClosureCopyTrampoline.
  	numCopied > 0 ifTrue:
+ 		[self ssPop: numCopied].
- 		[self AddCq: numCopied * BytesPerWord R: SPReg.
- 		 self ssPop: numCopied].
  	^self ssPushRegister: ReceiverResultReg!



More information about the Vm-dev mailing list