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

commits at source.squeak.org commits at source.squeak.org
Sat Oct 5 01:12:14 UTC 2013


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

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

Name: VMMaker.oscog-eem.438
Author: eem
Time: 4 October 2013, 6:09:10.357 pm
UUID: 19319f8f-986d-4563-b5ce-18b2f686fd0c
Ancestors: VMMaker.oscog-eem.437

Implement machine code primtiiveNewWithArg for Spur, arrayFormat,
byteFormat & longFormat.

Add comments to StackInterpreterSimulator>>primitiveNewWithArg
which, if uncommented, collect dynamic frequencies of classes and
class formats for basicNew: et al.

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

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveNewWithArg: (in category 'primitive generators') -----
+ genInnerPrimitiveNewWithArg: retNoffset
+ 	"Implement primitiveNewWithArg for convenient cases:
+ 	- the receiver has a hash
+ 	- the receiver is variable and not compiled method
+ 	- single word header/num slots < numSlotsMask
+ 	- the result fits in eden
+ 	See superclass method for dynamic frequencies of formats.
+ 	For the moment we implement only arrayFormat, firstByteFormat & firstLongFormat"
+ 
+ 	| halfHeaderReg instSpecReg maxSlots
+ 	  jumpArrayTooBig jumpByteTooBig jumpLongTooBig
+ 	  jumpArrayFormat jumpByteFormat jumpBytePrepDone jumpLongPrepDone
+ 	  jumpUnhashed jumpNElementsNonInt jumpFailCuzFixed jumpNoSpace jumpHasSlots fillLoop skip |
+ 	<var: 'skip' type: #'AbstractInstruction *'>
+ 	<var: 'fillLoop' type: #'AbstractInstruction *'>	
+ 	<var: 'jumpHasSlots' type: #'AbstractInstruction *'>
+ 	<var: 'jumpNoSpace' type: #'AbstractInstruction *'>
+ 	<var: 'jumpUnhashed' type: #'AbstractInstruction *'>
+ 	<var: 'jumpByteFormat' type: #'AbstractInstruction *'>
+ 	<var: 'jumpByteTooBig' type: #'AbstractInstruction *'>
+ 	<var: 'jumpLongTooBig' type: #'AbstractInstruction *'>
+ 	<var: 'jumpArrayFormat' type: #'AbstractInstruction *'>
+ 	<var: 'jumpArrayTooBig' type: #'AbstractInstruction *'>
+ 	<var: 'jumpFailCuzFixed' type: #'AbstractInstruction *'>
+ 	<var: 'jumpBytePrepDone' type: #'AbstractInstruction *'>
+ 	<var: 'jumpLongPrepDone' type: #'AbstractInstruction *'>
+ 	<var: 'jumpNElementsNonInt' type: #'AbstractInstruction *'>
+ 
+ 	"half header will contain classIndex (class's hash) and format, and eventually fill value"
+ 	halfHeaderReg := SendNumArgsReg.
+ 	"inst spec will hold class's instance specification and then byte size and finally numSlots half of header"
+ 	instSpecReg := ClassReg.
+ 	"The max slots we'll allocate here are those for a single header"
+ 	maxSlots := objectMemory numSlotsMask - 1.
+ 
+ 	"get freeStart as early as possible so as not to wait later..."
+ 	cogit MoveAw: objectMemory freeStartAddress R: Arg1Reg.
+ 	"get class's hash & fail if 0"
+ 	self genGetHashFieldNonImmOf: ReceiverResultReg into: halfHeaderReg.
+ 	jumpUnhashed := cogit JumpZero: 0.
+ 	"get index and fail if not a +ve integer"
+ 	cogit MoveR: Arg0Reg R: TempReg.
+ 	jumpNElementsNonInt := self genJumpNotSmallIntegerInScratchReg: TempReg.
+ 	"get class's format inst var for inst spec (format field)"
+ 	self genLoadSlot: InstanceSpecificationIndex sourceReg: ReceiverResultReg destReg: instSpecReg.
+ 	cogit LogicalShiftRightCq: objectMemory fixedFieldsFieldWidth + self numSmallIntegerTagBits R: instSpecReg.
+ 	cogit AndCq: objectMemory formatMask R: instSpecReg.
+ 	"Add format to classIndex/format half header now"
+ 	cogit MoveR: instSpecReg R: TempReg.
+ 	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
+ 	cogit AddR: TempReg R: halfHeaderReg.
+ 	"get integer value of num fields in TempReg now"
+ 	cogit MoveR: Arg0Reg R: TempReg.
+ 	self genConvertSmallIntegerToIntegerInScratchReg: TempReg.
+ 	"dispatch on format, failing if not variable or if compiled method"
+ 	cogit CmpCq: objectMemory arrayFormat R: instSpecReg.
+ 	jumpArrayFormat := cogit JumpZero: 0.
+ 	cogit CmpCq: objectMemory firstByteFormat R: instSpecReg.
+ 	jumpByteFormat := cogit JumpZero: 0.
+ 	cogit CmpCq: objectMemory firstLongFormat R: instSpecReg.
+ 	jumpFailCuzFixed := cogit JumpNonZero: 0.
+ 
+ 	cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg.
+ 	jumpLongTooBig := cogit JumpAbove: 0.
+ 	"save num elements/slot size to instSpecReg"
+ 	cogit MoveR: TempReg R: instSpecReg.
+ 	"push fill value"
+ 	cogit MoveCq: 0 R: TempReg.
+ 	cogit PushR: TempReg.
+ 	jumpLongPrepDone := cogit Jump: 0. "go allocate"
+ 
+ 	jumpByteFormat jmpTarget:
+ 	(cogit CmpCq: (objectMemory integerObjectOf: maxSlots * objectMemory wordSize) R: Arg0Reg).
+ 	jumpByteTooBig := cogit JumpAbove: 0.
+ 	"save num elements to instSpecReg"
+ 	cogit MoveR: TempReg R: instSpecReg.
+ 	"compute odd bits and add into halfHeaderReg; oddBits := 4 - nElements bitAnd: 3"
+ 	cogit MoveCq: objectMemory wordSize R: TempReg.
+ 	cogit SubR: instSpecReg R: TempReg.
+ 	cogit AndCq: objectMemory wordSize - 1 R: TempReg.
+ 	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
+ 	cogit AddR: TempReg R: halfHeaderReg.
+ 	"round up num elements to numSlots in instSpecReg"
+ 	cogit AddCq: objectMemory wordSize - 1 R: instSpecReg.
+ 	cogit LogicalShiftRightCq: objectMemory shiftForWord R: instSpecReg.
+ 	"push fill value"
+ 	cogit MoveCq: 0 R: TempReg.
+ 	cogit PushR: TempReg.
+ 	jumpBytePrepDone := cogit Jump: 0. "go allocate"
+ 
+ 	jumpArrayFormat jmpTarget:
+ 		(cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg).
+ 	jumpArrayTooBig := cogit JumpAbove: 0.
+ 	"save num elements/slot size to instSpecReg"
+ 	cogit MoveR: TempReg R: instSpecReg.
+ 	"push fill value"
+ 	cogit MoveCw: objectMemory nilObject R: TempReg.
+ 	cogit PushR: TempReg.
+ 	"fall through to allocate"
+ 
+ 	jumpBytePrepDone jmpTarget:
+ 	(jumpLongPrepDone jmpTarget: cogit Label).
+ 
+ 	"write half header now; it frees halfHeaderReg"
+ 	cogit MoveR: halfHeaderReg Mw: 0 r: Arg1Reg.
+ 	"save numSlots to halfHeaderReg"
+ 	cogit MoveR: instSpecReg R: halfHeaderReg.
+ 	"compute byte size; remember 0-sized objects still need 1 slot & allocation is
+ 	 rounded up to 8 bytes."
+ 	cogit CmpCq: 0 R: instSpecReg.
+ 	jumpHasSlots := cogit JumpNonZero: 0.
+ 	cogit MoveCq: objectMemory baseHeaderSize * 2 R: instSpecReg.
+ 	skip := cogit Jump: 0.
+ 	"round up to allocationUnit"
+ 	jumpHasSlots jmpTarget:
+ 	(cogit MoveR: instSpecReg R: TempReg).
+ 	cogit AndCq: 1 R: TempReg.
+ 	cogit AddR: TempReg R: instSpecReg.
+ 	cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: instSpecReg.
+ 	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: instSpecReg.
+ 	skip jmpTarget: "get scavengeThreshold (have freeStart already)"
+ 	(cogit MoveAw: objectMemory scavengeThresholdAddress R: TempReg).
+ 	"shift halfHeaderReg to put numSlots in correct place"
+ 	cogit LogicalShiftLeftCq: objectMemory numSlotsHalfShift R: halfHeaderReg.
+ 	"check if allocation fits"
+ 	cogit SubR: Arg1Reg R: TempReg.
+ 	cogit CmpR: TempReg R: instSpecReg.
+ 	jumpNoSpace := cogit JumpAbove: 0.
+ 	"get result, increment freeStart and write it back. Arg1Reg holds new freeStart, the limit of the object"
+ 	cogit MoveR: Arg1Reg R: ReceiverResultReg.
+ 	cogit AddR: instSpecReg R: Arg1Reg.
+ 	cogit MoveR: Arg1Reg Aw: objectMemory freeStartAddress.
+ 	"write other half of header (numSlots/0 identityHash)"
+ 	cogit MoveR: halfHeaderReg Mw: 4 r: ReceiverResultReg.
+ 	"now fill"
+ 	cogit PopR: halfHeaderReg.
+ 	cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: instSpecReg.
+ 	"at least two words; so can make this a [fill 2 words. reached limit?] whileFalse"
+ 	fillLoop := 
+ 	cogit MoveR: halfHeaderReg Mw: 0 r: instSpecReg.
+ 	cogit MoveR: halfHeaderReg Mw: 4 r: instSpecReg.
+ 	cogit AddCq: 8 R: instSpecReg.
+ 	cogit CmpR: Arg1Reg R: instSpecReg.
+ 	cogit JumpBelow: fillLoop.
+ 	cogit RetN: retNoffset.
+ 
+ 	"pop discarded fill value & fall through to failure"
+ 	jumpNoSpace jmpTarget: (cogit PopR: TempReg).
+ 
+ 	jumpUnhashed jmpTarget:
+ 	(jumpFailCuzFixed jmpTarget:
+ 	(jumpArrayTooBig jmpTarget:
+ 	(jumpByteTooBig jmpTarget:
+ 	(jumpLongTooBig jmpTarget:
+ 	(jumpNoSpace jmpTarget:
+ 	(jumpNElementsNonInt jmpTarget: cogit Label)))))).
+ 
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>numSmallIntegerTagBits (in category 'primitive generators') -----
+ numSmallIntegerTagBits
+ 	^1!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetClassObjectOfClassIndex:into:scratchReg: (in category 'compile abstract instructions') -----
  genGetClassObjectOfClassIndex: instReg into: destReg scratchReg: scratchReg
  	"Fetch the class object whose index is in instReg into destReg.
  	 It is non-obvious, but the Cogit assumes loading a class does not involve
  	 a runtime call, so do not call classAtIndex:"
  	self assert: instReg ~= destReg.
  	self assert: instReg ~= scratchReg.
  	self assert: destReg ~= scratchReg.
  	cogit
  		MoveR: instReg R: scratchReg;
  		LogicalShiftRightCq: objectMemory classTableMajorIndexShift R: scratchReg;
  		LogicalShiftLeftCq: objectMemory shiftForWord R: scratchReg.
  	self assert: (self shouldAnnotateObjectReference: objectMemory classTableRootObj) not.
  	cogit
  		MoveMw: objectMemory classTableRootObj + objectMemory baseHeaderSize r: scratchReg R: destReg;
  		MoveR: instReg R: scratchReg;
  		AndCq: objectMemory classTableMinorIndexMask R: scratchReg;
  		AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: scratchReg;
+ 		MoveXwr: scratchReg R: destReg R: destReg.
- 		MoveXwr: scratchReg R: destReg R: destReg..
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveNew: (in category 'primitive generators') -----
  genInnerPrimitiveNew: retNoffset
  	"Implement primitiveNew for convenient cases:
  	- the receiver has a hash
+ 	- the receiver is fixed size (excluding ephemerons to save instructions & miniscule time)
+ 	- single word header/num slots < numSlotsMask
- 	- the receiver is fixed size
  	- the result fits in eden"
  
  	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveNewWithArg: (in category 'primitive generators') -----
+ genInnerPrimitiveNewWithArg: retNoffset
+ 	"Implement primitiveNewWithArg for convenient cases:
+ 	- the receiver has a hash
+ 	- the receiver is variable and not compiled method
+ 	- single word header/num slots < numSlotsMask
+ 	- the result fits in eden
+ 
+ 	Here are some dynamic frequencies of class formats in the interpreter doing startUp
+ 	and recompiling ArrayedCollection in a Squeak4.1 image:
+ 		{3251->#arrayFormat.		(Array)
+ 		 1685->#firstByteFormat.	(ByteString, LargePositiveInteger, very few ByteArray)
+ 		 1533->#firstLongFormat.	(Bitmaps, Floats, MatrixTransform2x3, WordArray)
+ 		 110->#weakArrayFormat.	(WeakArray, WeakMessageSend)
+ 		 35->#indexablePointersFormat.	(MethodContext)
+ 		 5->#nonIndexablePointerFormat	(DirectoryEntry)}"
+ 
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>implementsNewWithArg (in category 'initialization') -----
+ implementsNewWithArg
+ 	^true!

Item was changed:
  ----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
  initialize
  	"Abstract opcodes are a compound of a one word operation specifier and zero or more operand type specifiers.
  	 e.g. MoveRR is the Move opcode with two register operand specifiers and defines a move register to
+ 	 register instruction from operand 0 to operand 1.  The word and register size is assumed to be either 32-bits on
+ 	 a 32-bit architecture or 64-bits on a 64-bit architecture.  
+ 	The operand specifiers are
+ 		R		- general purpose register
+ 		Rd		- double-precision floating-point register
+ 		Cq		- a quick constant that can be encoded in the minimum space possible.
+ 		Cw		- a constant with word size where word is the default operand size for the Smalltalk VM, 32-bits
+ 				  for a 32-bit VM, 64-bits for a 64-bit VM.  The generated constant must occupy the default number
+ 				  of bits.  This allows e.g. a garbage collector to update the value without invalidating the code.
+ 		C32	- a constant with 32 bit size.  The generated constant must occupy 32 bits.
+ 		C64	- a constant with 64 bit size.  The generated constant must occupy 64 bits.
+ 		Aw		- memory word with an absolute address
+ 		Ab		- memory byte with an absolute address
+ 		Mwr	- memory word whose address is at a constant offset from an address in a register
+ 		Mbr		- memory byte whose address is at a constant offset from an address in a register
+ 		M16r	- memory 16-bit halfword whose address is at a constant offset from an address in a register
+ 		M32r	- memory 32-bit halfword whose address is at a constant offset from an address in a register
+ 		M64r	- memory 64-bit doubleword whose address is at a constant offset from an address in a register
+ 		XbrR	- memory word whose address is r * byte size away from an address in a register
+ 		X16rR	- memory word whose address is r * (2 bytes size) away from an address in a register
+ 		XwrR	- memory word whose address is r * word size away from an address in a register
+ 		XowrR	- memory word whose address is (r * word size) + o away from an address in a register (scaled indexed)
- 	 register instruction from operand 0 to operand 1.  The operand specifiers are
- 		R - general purpose register
- 		Rd - double-precision floating-point register
- 		Cq  - a quick constant that can be encoded in the minimum space possible.
- 		Cw - a constant with word size where word is the default operand size for the Smalltalk VM, 32-bits
- 			 for a 32-bit VM, 64-bits for a 64-bit VM.  The generated constant must occupy the default number
- 			 of bits.  This allows e.g. a garbage collector to update the value without invalidating the code.
- 		C32 - a constant with 32 bit size.  The generated constant must occupy 32 bits.
- 		C64 - a constant with 64 bit size.  The generated constant must occupy 64 bits.
- 		Aw    - memory word with an absolute address
- 		Ab    - memory byte with an absolute address
- 		Mwr  - memory word whose address is at a constant offset from an address in a register
- 		Mbr  - memory byte whose address is at a constant offset from an address in a register
- 		M16r  - memory 16-bit halfword whose address is at a constant offset from an address in a register
- 		M64r  - memory 64-bit doubleword whose address is at a constant offset from an address in a register
- 		XbrR- memory word whose address is r * byte size away from an address in a register
- 		X16rR- memory word whose address is r * (2 bytes size) away from an address in a register
- 		XwrR- memory word whose address is r * word size away from an address in a register
  
  	An alternative would be to decouple opcodes from operands, e.g.
  		Move := 1. Add := 2. Sub := 3...
  		RegisterOperand := 1. ConstantQuickOperand := 2. ConstantWordOperand := 3...
  	But not all combinations make sense and even fewer are used so we stick with the simple compound approach.
  
+ 	The assumption is that comparison and arithmetic instructions set condition codes and that move instructions
- 	The assumption is that comparison and arithmetic instructions set condition codes and that move instrucions
  	leave the condition codes unaffected.  In particular LoadEffectiveAddressMwrR does not set condition codes
  	although it can be used to do arithmetic.
  
+ 	Not all of the definitions in opcodeDefinitions below are implemented.  In particular we do not implement the
+ 	 XowrR scaled index addressing mode since it requires 4 operands.
+ 
  	Note that there are no generic division instructions defined, but a processor may define some."
  
  	"CogRTLOpcodes initialize.
  	 CogAbstractInstruction allSubclasses do: [:sc| sc initialize]"
  
  	| opcodeNames refs |
  	FPReg := -1.
  	SPReg := -2.
  	ReceiverResultReg := GPRegMax := -3.
  	TempReg := -4.
  	ClassReg := -5.
  	SendNumArgsReg := -6.
  	Arg0Reg := -7.
  	Arg1Reg := GPRegMin := -8.
  
  	DPFPReg0 := -9.
  	DPFPReg1 := -10.
  	DPFPReg2 := -11.
  	DPFPReg3 := -12.
  	DPFPReg4 := -13.
  	DPFPReg5 := -14.
  	DPFPReg6 := -15.
  	DPFPReg7 := -16.
  	
  	LinkReg := -17.
  
  	opcodeNames := #("Noops & Pseudo Ops"
  						Label
  						AlignmentNops
  						FillBytesFrom	"output operand 0's worth of bytes from the address in operand 1"
  						Fill8				"output a byte's worth of bytes with operand 0"
  						Fill16			"output two byte's worth of bytes with operand 0"
  						Fill32			"output four byte's worth of bytes with operand 0"
  						FillFromWord	"output BytesPerWord's worth of bytes with operand 0 + operand 1"
  						Nop
  
  						"Control"
  						Call
  						RetN
  						JumpR				"Not a regular jump, i.e. not pc dependent."
  
  						"N.B.  Jumps are contiguous.  Long jumps are contigiuous within them.  See FirstJump et al below"
  						JumpLong
  						JumpLongZero		"a.k.a. JumpLongEqual"
  						JumpLongNonZero	"a.k.a. JumpLongNotEqual"
  						Jump
  						JumpZero			"a.k.a. JumpEqual"
  						JumpNonZero		"a.k.a. JumpNotEqual"
  						JumpNegative
  						JumpNonNegative
  						JumpOverflow
  						JumpNoOverflow
  						JumpCarry
  						JumpNoCarry
  						JumpLess			"signed"
  						JumpGreaterOrEqual
  						JumpGreater
  						JumpLessOrEqual
  						JumpBelow			"unsigned"
  						JumpAboveOrEqual
  						JumpAbove
  						JumpBelowOrEqual
  
  						JumpFPEqual
  						JumpFPNotEqual
  						JumpFPLess
  						JumpFPLessOrEqual
  						JumpFPGreater
  						JumpFPGreaterOrEqual
  						JumpFPOrdered
  						JumpFPUnordered
  
  						"Data Movement; destination is always last operand"
  						MoveRR
  						MoveAwR
  						MoveRAw
  						MoveAbR
+ 						MoveMwrR MoveRMwr MoveXwrRR MoveRXwrR MoveXowrR MoveRXowr
- 						MoveMwrR MoveRMwr MoveXwrRR MoveRXwrR
  						MoveM16rR MoveRM16r MoveX16rRR MoveRX16rR
+ 						MoveM32rR MoveRM32r MoveX32rRR MoveRX32rR
  						MoveMbrR MoveRMbr MoveXbrRR MoveRXbrR
  						MoveCqR MoveCwR MoveC32R MoveC64R
  						MoveRdRd MoveM64rRd MoveRdM64r
  						PopR PushR PushCw
  						PrefetchAw
  
  						"Arithmetic; destination is always last operand except Cmp; CmpXR is SubRX with no update of result"
+ 						LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR "Variants of add/multiply"
- 						LoadEffectiveAddressMwrR "A variant of add"
  						NegateR "2's complement negation"
  						ArithmeticShiftRightCqR ArithmeticShiftRightRR
  						LogicalShiftRightCqR LogicalShiftRightRR
  						LogicalShiftLeftCqR LogicalShiftLeftRR
  
  						CmpRR AddRR SubRR AndRR OrRR XorRR MulRR
  						CmpCqR AddCqR SubCqR AndCqR OrCqR XorCqR MulCqR
  						CmpCwR AddCwR SubCwR AndCwR OrCwR XorCwR MulCwR
  
  						CmpRdRd AddRdRd SubRdRd MulRdRd DivRdRd SqrtRd
  
  						"Conversion"
  						ConvertRRd
  
  						LastRTLCode).
  
+ 	"Magic auto declaration. Add to the classPool any new variables and nuke any obsolete ones, and assign values"
+ 	"Find the variables directly referenced by this method"
  	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
  				[:ea| ea key].
+ 	"Move to Undeclared any opcodes in classPool not in opcodes or this method."
  	(classPool keys reject: [:k| (opcodeNames includes: k) or: [refs includes: k]]) do:
  		[:k|
  		Undeclared declare: k from: classPool].
+ 	"Declare as class variables and number elements of opcodeArray above"
  	opcodeNames withIndexDo:
  		[:classVarName :value|
  		self classPool
  			declare: classVarName from: Undeclared;
  			at: classVarName put: value].
+ 
+ 	"For CogAbstractInstruction>>isJump etc..."
  	FirstJump := JumpLong.
  	LastJump := JumpFPUnordered.
  	FirstShortJump := Jump!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print all stacks' action: #printAllStacks;
+ 		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
+ 											self writeBackHeadFramePointers];
+ 		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
+ 											self writeBackHeadFramePointers];
  		addLine;
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPrimitiveNewWithArg (in category 'primitive generators') -----
+ genPrimitiveNewWithArg
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveNewWithArg: BytesPerWord) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveNewWithArg (in category 'debugging traps') -----
  primitiveNewWithArg
  	"(objectMemory hasSpurMemoryManagerAPI
  	 and: [self classNameOf: (self stackValue: 1) Is: 'MethodDictionary']) ifTrue:
  		[self halt]."
+ 	"| hash |
+ 	hash := objectMemory rawHashBitsOf: (self stackValue: 1)."
+ 	| format |
+ 	format := objectMemory instSpecOfClass: (self stackValue: 1).
+ 	super primitiveNewWithArg.
+ 	self successful ifTrue:
+ 		[(Smalltalk at: #Counts ifAbsentPut: [Bag new]) add: format].
+ 	"(self successful and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
+ 		[(Smalltalk at: #Counts ifAbsentPut: [Bag new]) add: hash]"
+ 	"Smalltalk removeKey: #Counts"
+ 	"Counts sortedCounts collect: [:assoc|
+ 		assoc key -> ((SpurMemoryManager organization listAtCategoryNamed: #'header formats') detect:
+ 										[:f| (SpurMemoryManager basicNew perform: f) = assoc value])]
+ 		{3251->#arrayFormat.
+ 		 1685->#firstByteFormat.
+ 		 1533->#firstLongFormat.
+ 		 110->#weakArrayFormat.
+ 		 35->#indexablePointersFormat.
+ 		 5->#nonIndexablePointerFormat}"
+ 	"Counts sortedCounts collect: [:assoc|
+ 		assoc value = 0
+ 			ifTrue: [assoc]
+ 			ifFalse: [assoc key -> {(self nameOfClass: (objectMemory classAtIndex: assoc value)).
+ 									(SpurMemoryManager organization listAtCategoryNamed: #'header formats') detect:
+ 										[:f| (objectMemory perform: f)
+ 											= (objectMemory instSpecOfClass: (objectMemory classAtIndex: assoc value))]}]]
+ 	{1062->#('Array' #arrayFormat).
+ 	 777->#('Bitmap' #firstLongFormat).
+ 	 395->#('Float' #firstLongFormat).
+ 	 345->#('ByteString' #firstByteFormat).
+ 	 237->#('MatrixTransform2x3' #firstLongFormat).
+ 	 233->#('LargePositiveInteger' #firstByteFormat).
+ 	 103->#('WordArray' #firstLongFormat).
+ 	 58->#('WeakArray' #weakArrayFormat).
+ 	 52->#('WeakMessageSend' #weakArrayFormat).
+ 	 9->#('MethodContext' #indexablePointersFormat).
+ 	 4->#('DirectoryEntry' #nonIndexablePointerFormat).
+ 	 3->#('BalloonBuffer' #firstLongFormat).
+ 	 1->#('ByteArray' #firstByteFormat).
+ 	 1->0}"!
- 	^super primitiveNewWithArg!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genPrimitiveNewWithArg (in category 'primitive generators') -----
+ genPrimitiveNewWithArg
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveNewWithArg: 0) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!



More information about the Vm-dev mailing list