[Vm-dev] VM Maker: VMMaker.oscog-eem.530.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Dec 4 23:10:19 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.530.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.530
Author: eem
Time: 4 December 2013, 3:07:26.276 pm
UUID: cb1992ae-2118-40a3-9cee-8c9c89fcc30a
Ancestors: VMMaker.oscog-eem.529
Fix bad bugs in Spur machine-code instantiation prims and access
scavengeThreshold as a constant. Rename the accessor to
getScavengeThreshold for slang.
Indicate ceReturnToInterpreterPC in CoInterpreter frame printing.
Make CogMethodZone>>freeStart a macro to give unfettered
access to the memory manager's freeStart in gdb.
Add printInstancesOf: to SpurMemMgr.
Make printMethodCache translate so as to include it in the real VM.
Simulation:
Provide a simulation-only register map print for making sense of
machine code.
Fix printing of characters, avoiding printing wide characters to avoid
filling the transcript with ?'s.
Fix instruction printing regression.
=============== Diff against VMMaker.oscog-eem.529 ===============
Item was changed:
----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
<api>
| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
<var: #rcvrAddress type: #'char *'>
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #homeMethod type: #'CogMethod *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
(self isMachineCodeFrame: theFP)
ifTrue:
[| cogMethod homeMethod |
cogMethod := self mframeCogMethod: theFP.
homeMethod := self mframeHomeMethod: theFP.
theMethod := homeMethod asInteger.
theMethodEnd := homeMethod asInteger + homeMethod blockSize.
numArgs := cogMethod cmNumArgs.
numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
ifFalse:
[theMethod := self frameMethodObject: theFP.
theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
numArgs := self iframeNumArgs: theFP.
numTemps := self tempCountOf: theMethod].
(self frameIsBlockActivation: theFP) ifTrue:
[| rcvrOrClosure |
rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
((objectMemory isNonImmediate: rcvrOrClosure)
and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
ifFalse: [numTemps := 0]].
self shortPrintFrame: theFP.
(self isBaseFrame: theFP) ifTrue:
[self printFrameOop: '(caller ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * BytesPerWord).
self printFrameOop: '(saved ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * BytesPerWord)].
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * BytesPerWord).
numArgs to: 1 by: -1 do:
[:i|
self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * BytesPerWord)].
+ self printFrameThing: 'caller ip'
+ at: theFP + FoxCallerSavedIP
+ extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue:
+ ['ceReturnToInterptreter']).
- self printFrameThing: 'caller ip' at: theFP + FoxCallerSavedIP.
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameMethodFor: theFP.
(self isMachineCodeFrame: theFP) ifFalse:
[self printFrameFlagsForFP: theFP].
self printFrameOop: 'context' at: theFP + FoxThisContext.
(self isMachineCodeFrame: theFP) ifTrue:
[self printFrameFlagsForFP: theFP].
(self isMachineCodeFrame: theFP)
ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
ifFalse:
[self printFrameThing: 'saved ip'
at: theFP + FoxIFSavedIP
extra: ((self iframeSavedIP: theFP) = 0
ifTrue: [0]
ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - BaseHeaderSize]).
rcvrAddress := theFP + FoxIFReceiver].
self printFrameOop: 'receiver' at: rcvrAddress.
topThing := stackPages longAt: theSP.
(topThing between: theMethod and: theMethodEnd)
ifTrue:
[rcvrAddress - BytesPerWord to: theSP + BytesPerWord by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: 'stck' at: addr]].
self printFrameThing: 'frame ip'
at: theSP
extra: ((self isMachineCodeFrame: theFP)
ifTrue: [topThing - theMethod]
ifFalse: [topThing - theMethod + 2 - BaseHeaderSize])]
ifFalse:
[rcvrAddress - BytesPerWord to: theSP by: BytesPerWord negated do:
[:addr| | index |
index := rcvrAddress - addr / BytesPerWord + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: 'stck' at: addr]]]!
Item was added:
+ ----- Method: CoInterpreter>>printFrameThing:at:extraString: (in category 'debug printing') -----
+ printFrameThing: name at: address extraString: extraStringOrNil
+ | it len |
+ <inline: false>
+ <var: #name type: #'char *'>
+ <var: #address type: #'char *'>
+ <var: #extraStringOrNil type: #'char *'>
+ it := stackPages longAt: address.
+ self printHexPtr: address;
+ printChar: $:.
+ len := self strlen: name.
+ 1 to: 12 - len do: [:i| self space].
+ self print: name;
+ print: ': ';
+ printHex: it.
+ it ~= 0 ifTrue:
+ [self printChar: $=.
+ it = objectMemory nilObject
+ ifTrue: [self print: 'nil']
+ ifFalse:
+ [self printNum: it]].
+ extraStringOrNil ifNotNil: [self space; print: extraStringOrNil].
+ self cr!
Item was added:
+ ----- Method: CogARMCompiler>>generalPurposeRegisterMap (in category 'disassembly') -----
+ generalPurposeRegisterMap
+ <doNotGenerate>
+ "Answer a Dictionary from register getter to register index."
+ ^Dictionary newFromPairs:
+ { #r4. R4.
+ #r5. R5.
+ #r6. R6.
+ #r7. R7.
+ #r8. R8.
+ #r9. R9 }!
Item was added:
+ ----- Method: CogIA32Compiler>>generalPurposeRegisterMap (in category 'disassembly') -----
+ generalPurposeRegisterMap
+ <doNotGenerate>
+ "Answer a Dictionary from register getter to register index."
+ ^Dictionary newFromPairs:
+ { #eax. EAX.
+ #ecx. ECX.
+ #edx. EDX.
+ #ebx. EBX.
+ #esi. ESI.
+ #edi. EDI }!
Item was changed:
----- Method: CogMethodZone>>freeStart (in category 'accessing') -----
freeStart
+ "declared as a macro so as not to conflict with the memory manager's freeStart."
+ <cmacro: '() mzFreeStart'>
- <inline: true>
- <returnTypeC: #usqInt>
^mzFreeStart!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>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 result fits in eden (actually below scavengeThreshold)"
- - the result fits in eden"
+ | halfHeaderReg fillReg instSpecReg byteSizeReg
+ jumpUnhashed jumpVariableOrEphemeron jumpNoSpace jumpTooBig jumpHasSlots
+ fillLoop skip |
- | halfHeaderReg instSpecReg
- jumpUnhashed jumpVariableOrEphemeron jumpNoSpace jumpTooBig jumpHasSlots fillLoop skip |
<var: 'skip' type: #'AbstractInstruction *'>
<var: 'fillLoop' type: #'AbstractInstruction *'>
<var: 'jumpTooBig' type: #'AbstractInstruction *'>
<var: 'jumpHasSlots' type: #'AbstractInstruction *'>
<var: 'jumpNoSpace' type: #'AbstractInstruction *'>
<var: 'jumpUnhashed' type: #'AbstractInstruction *'>
<var: 'jumpVariableOrEphemeron' type: #'AbstractInstruction *'>
+ "half header will contain 1st half of header (classIndex/class's hash & format),
+ then 2nd half of header (numSlots/fixed size) and finally fill value (nilObject)."
+ halfHeaderReg := fillReg := SendNumArgsReg.
+ "inst spec will hold class's instance specification, then byte size and finally end of new object."
+ instSpecReg := byteSizeReg := ClassReg.
- "half header will contain classIndex (class's hash) and format, then fixed size and eventually nilObject"
- halfHeaderReg := SendNumArgsReg.
- "inst spec will hold class's instance specification and then byte size and finally numSlots half of header"
- instSpecReg := ClassReg.
"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 class's format inst var for both inst spec (format field) and num fixed fields"
self genLoadSlot: InstanceSpecificationIndex sourceReg: ReceiverResultReg destReg: TempReg.
self genConvertSmallIntegerToIntegerInScratchReg: TempReg.
cogit MoveR: TempReg R: instSpecReg.
cogit LogicalShiftRightCq: objectMemory fixedFieldsFieldWidth R: TempReg.
cogit AndCq: objectMemory formatMask R: TempReg.
cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: instSpecReg.
"fail if not fixed or if ephemeron (rare beasts so save the cycles)"
cogit CmpCq: objectMemory nonIndexablePointerFormat R: TempReg.
jumpVariableOrEphemeron := cogit JumpAbove: 0.
cogit CmpCq: objectMemory numSlotsMask R: instSpecReg.
jumpTooBig := cogit JumpAboveOrEqual: 0.
"Add format to classIndex/format half header; other word contains numSlots"
cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
cogit AddR: TempReg R: halfHeaderReg.
"write half header now; it frees halfHeaderReg"
cogit MoveR: halfHeaderReg Mw: 0 r: Arg1Reg.
"save unrounded numSlots for header"
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: byteSizeReg. "a.k.a. instSpecReg"
- cogit CmpCq: 0 R: instSpecReg.
jumpHasSlots := cogit JumpNonZero: 0.
+ cogit MoveCq: objectMemory baseHeaderSize * 2 R: byteSizeReg.
- cogit MoveCq: objectMemory baseHeaderSize * 2 R: instSpecReg.
skip := cogit Jump: 0.
"round up to allocationUnit"
jumpHasSlots jmpTarget:
+ (cogit MoveR: byteSizeReg R: TempReg).
- (cogit MoveR: instSpecReg R: TempReg).
cogit AndCq: 1 R: TempReg.
+ cogit AddR: TempReg R: byteSizeReg.
+ cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord R: byteSizeReg.
+ skip jmpTarget:
- 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 (freeSize + byteSize < scavengeThreshold); scavengeThreshold is constant."
+ cogit AddR: Arg1Reg R: byteSizeReg.
+ cogit CmpCq: objectMemory getScavengeThreshold R: byteSizeReg.
+ jumpNoSpace := cogit JumpAboveOrEqual: 0.
+ "write back new freeStart; get result. byteSizeReg holds new freeStart, the limit of the object"
+ cogit MoveR: byteSizeReg Aw: objectMemory freeStartAddress.
- 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/identityHash)"
+ cogit MoveR: halfHeaderReg Mw: 4 r: Arg1Reg.
- cogit MoveR: halfHeaderReg Mw: 4 r: ReceiverResultReg.
"now fill"
+ cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: Arg1Reg.
+ cogit MoveCq: objectMemory nilObject R: fillReg.
- cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: instSpecReg.
- cogit MoveCq: objectMemory nilObject R: halfHeaderReg.
"at least two words; so can make this a [fill 2 words. reached limit?] whileFalse"
fillLoop :=
+ cogit MoveR: fillReg Mw: 0 r: Arg1Reg.
+ cogit MoveR: fillReg Mw: 4 r: Arg1Reg.
+ cogit AddCq: 8 R: Arg1Reg.
+ cogit CmpR: Arg1Reg R: byteSizeReg.
+ cogit JumpAbove: 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.
jumpUnhashed jmpTarget:
(jumpVariableOrEphemeron jmpTarget:
(jumpTooBig jmpTarget:
(jumpNoSpace jmpTarget: cogit Label))).
^0!
Item was changed:
----- 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 fillReg instSpecReg byteSizeReg maxSlots
- | 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 1st half of header (classIndex/class's hash & format),
+ then 2nd half of header (numSlots) and finally fill value (nilObject)."
+ halfHeaderReg := fillReg := SendNumArgsReg.
- "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 := byteSizeReg := ClassReg.
- 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: byteSizeReg. "a.k.a. instSpecReg"
- cogit CmpCq: 0 R: instSpecReg.
jumpHasSlots := cogit JumpNonZero: 0.
+ cogit MoveCq: objectMemory baseHeaderSize * 2 R: byteSizeReg.
- cogit MoveCq: objectMemory baseHeaderSize * 2 R: instSpecReg.
skip := cogit Jump: 0.
"round up to allocationUnit"
jumpHasSlots jmpTarget:
+ (cogit MoveR: byteSizeReg R: TempReg).
- (cogit MoveR: instSpecReg R: TempReg).
cogit AndCq: 1 R: TempReg.
+ cogit AddR: TempReg R: byteSizeReg.
+ cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg.
+ cogit LogicalShiftLeftCq: objectMemory shiftForWord R: byteSizeReg.
+ skip jmpTarget:
- 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).
- cogit LogicalShiftLeftCq: objectMemory numSlotsHalfShift R: halfHeaderReg.
"check if allocation fits"
+ cogit AddR: Arg1Reg R: byteSizeReg.
+ cogit CmpCq: objectMemory getScavengeThreshold R: byteSizeReg.
+ jumpNoSpace := cogit JumpAboveOrEqual: 0.
- 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 MoveR: byteSizeReg Aw: objectMemory freeStartAddress.
- 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: fillReg.
+ cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: Arg1Reg.
- 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: fillReg Mw: 0 r: Arg1Reg.
+ cogit MoveR: fillReg Mw: 4 r: Arg1Reg.
+ cogit AddCq: 8 R: Arg1Reg.
+ cogit CmpR: Arg1Reg R: byteSizeReg.
+ cogit JumpAbove: 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:
+ (jumpNElementsNonInt jmpTarget: cogit Label))))).
- (jumpNoSpace jmpTarget:
- (jumpNElementsNonInt jmpTarget: cogit Label)))))).
^0!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>genAllocFloatValue:into:scratchReg:scratchReg: (in category 'primitive generators') -----
genAllocFloatValue: dpreg into: resultReg scratchReg: scratch1 scratchReg: scratch2
<returnTypeC: #'AbstractInstruction *'>
| allocSize newFloatHeader jumpFail |
<var: #jumpFail type: #'AbstractInstruction *'>
allocSize := objectMemory baseHeaderSize + (objectMemory sizeof: #double).
newFloatHeader := objectMemory
headerForSlots: (self sizeof: #double) / objectMemory wordSize
format: objectMemory firstLongFormat
classIndex: objectMemory classFloatCompactIndex.
cogit MoveAw: objectMemory freeStartAddress R: resultReg.
- cogit MoveAw: objectMemory scavengeThresholdAddress R: scratch2.
cogit LoadEffectiveAddressMw: allocSize r: resultReg R: scratch1.
+ cogit CmpCq: objectMemory getScavengeThreshold R: scratch1.
- cogit CmpR: scratch2 R: scratch1.
jumpFail := cogit JumpAboveOrEqual: 0.
cogit MoveR: scratch1 Aw: objectMemory freeStartAddress.
cogit MoveCq: newFloatHeader R: scratch2.
objectMemory wordSize = objectMemory baseHeaderSize
ifTrue: [cogit MoveR: scratch2 Mw: 0 r: resultReg]
ifFalse:
[self flag: #endianness.
+ cogit MoveCq: newFloatHeader >> 32 R: scratch1.
- cogit MoveCq: 0 R: scratch1.
cogit MoveR: scratch2 Mw: 0 r: resultReg.
+ cogit MoveR: scratch1 Mw: objectMemory wordSize r: resultReg].
- cogit MoveR: scratch1 Mw: objectMemory wordSize r: resultReg.].
cogit MoveRd: dpreg M64: objectMemory baseHeaderSize r: resultReg.
^jumpFail!
Item was removed:
- ----- Method: CogRTLOpcodes class>>nameForAbstractRegister: (in category 'debug printing') -----
- nameForAbstractRegister: reg "<Integer>"
- ^#(Arg0Reg Arg1Reg ClassReg FPReg ReceiverResultReg SPReg SendNumArgsReg TempReg
- DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 LinkReg)
- detect: [:sym| (classPool at: sym) = reg]!
Item was changed:
----- Method: CogVMSimulator>>printFrameThing:andFrame:at: (in category 'debug printing') -----
printFrameThing: name andFrame: theFP at: address
<var: #theFP type: #'char *'>
| it |
<inline: false>
<var: #name type: #'char *'>
<var: #address type: #'char *'>
it := stackPages longAt: address.
self printHex: address;
printChar: $:.
1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
self print: name;
print: ': ';
printHex: it.
it ~= 0 ifTrue:
[self printChar: $=; printNum: it.
+ (objectMemory isInMemory: it) ifFalse:
- (it between: objectMemory startOfMemory and: objectMemory endOfMemory) ifFalse:
[(cogit lookupAddress: it) ifNotNil:
[:label| self space; printChar: $(; print: label; printChar: $)]]].
self print: ' frame: '; printHex: theFP; cr!
Item was changed:
----- Method: CogVMSimulator>>printFrameThing:at: (in category 'debug printing') -----
printFrameThing: name at: address
| it |
<inline: false>
<var: #name type: #'char *'>
<var: #address type: #'char *'>
it := stackPages longAt: address.
self printHex: address;
printChar: $:.
1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
self print: name;
print: ': ';
printHex: it.
it ~= 0 ifTrue:
[self printChar: $=; printNum: it.
+ (objectMemory isInMemory: it) ifFalse:
- (it between: objectMemory startOfMemory and: objectMemory endOfMemory) ifFalse:
[(cogit lookupAddress: it) ifNotNil:
[:label| self space; printChar: $(; print: label; printChar: $)]]].
self cr!
Item was changed:
----- Method: CogVMSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
+ [^(objectMemory characterValueOf: oop) < 256
+ ifTrue:
+ ['=$' , (objectMemory characterValueOf: oop) printString ,
+ ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
+ ifFalse:
+ ['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
- [^ '=$' , (objectMemory characterValueOf: oop) printString ,
- ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')'].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
Item was changed:
----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
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: 'print register map' action: [cogit printRegisterMapOn: 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 block'.
- 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: Cogit>>printRegisterMapOn: (in category 'disassembly') -----
+ printRegisterMapOn: aStream
+ <doNotGenerate>
+ | map n |
+ map := backEnd generalPurposeRegisterMap.
+ n := 0.
+ map keys sort
+ do: [:regName| | abstractName |
+ abstractName := CogRTLOpcodes nameForRegister: (backEnd abstractRegisterForConcreteRegister: (map at: regName)).
+ aStream nextPutAll: abstractName; nextPutAll: ' => '; nextPutAll: regName]
+ separatedBy: [(n := n + 1) \\ 4 = 0 ifTrue: [aStream cr] ifFalse: [aStream tab]].
+ aStream cr; flush!
Item was changed:
----- Method: Cogit>>recordInstruction: (in category 'simulation only') -----
recordInstruction: thing
<doNotGenerate>
lastNInstructions addLast: thing.
[lastNInstructions size > 160"80"] whileTrue:
[lastNInstructions removeFirst.
lastNInstructions size * 2 > lastNInstructions capacity ifTrue:
+ [lastNInstructions makeRoomAtLast]].
+ ^thing!
- [lastNInstructions makeRoomAtLast]]!
Item was changed:
----- Method: Cogit>>recordLastInstruction (in category 'simulation only') -----
recordLastInstruction
<doNotGenerate>
+ ^self recordInstruction: (processor
- self recordInstruction: (processor
disassembleNextInstructionIn: coInterpreter memory
for: (EagerInstructionDecoration ifTrue: [self]))!
Item was changed:
----- Method: Cogit>>recordProcessing (in category 'simulation only') -----
recordProcessing
+ | inst |
self recordRegisters.
+ inst := self recordLastInstruction.
printRegisters ifTrue:
[processor printRegistersOn: coInterpreter transcript].
+ printInstructions ifTrue:
+ [printRegisters ifTrue:
+ [coInterpreter transcript cr].
+ coInterpreter transcript nextPutAll: inst; cr; flush]!
- self recordLastInstruction!
Item was changed:
----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
simulateCogCodeAt: address "<Integer>"
<doNotGenerate>
| stackZoneBase |
stackZoneBase := coInterpreter stackZoneBase.
processor pc: address.
[[[singleStep ifTrue:
[[processor sp < stackZoneBase ifTrue: [self halt].
self recordProcessing.
(breakPC isInteger
ifTrue:
[processor pc = breakPC
and: [breakBlock value: self]]
ifFalse:
[breakBlock value: self]) ifTrue:
["printRegisters := printInstructions := true"
"self reportLastNInstructions"
"coInterpreter printExternalHeadFrame"
"coInterpreter printFrameAndCallers: coInterpreter framePointer SP: coInterpreter stackPointer"
"coInterpreter shortPrintFrameAndCallers: coInterpreter framePointer"
"coInterpreter printFrame: processor fp WithSP: processor sp"
"coInterpreter printFrameAndCallers: processor fp SP: processor sp"
"coInterpreter shortPrintFrameAndCallers: processor fp"
"self disassembleMethodFor: processor pc"
coInterpreter changed: #byteCountText.
+ self halt: 'machine code breakpoint at ', processor pc hex]] value]. "So that the Debugger's Over steps over all this"
- self halt: 'machine code breakpoint at ',
- (breakPC isInteger
- ifTrue: [breakPC hex]
- ifFalse: [String streamContents: [:s| breakBlock decompile printOn: s indent: 0]])]] value]. "So that the Debugger's Over steps over all this"
singleStep
ifTrue: [processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]
ifFalse: [processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd].
((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
[(self confirm: 'continue?') ifFalse:
[self halt]].
true] whileTrue]
on: ProcessorSimulationTrap
do: [:ex| self handleSimulationTrap: ex].
true] whileTrue!
Item was changed:
----- Method: Spur32BitCoMemoryManager>>freeStart: (in category 'cog jit support') -----
freeStart: aValue
+ self assert: (aValue >= scavenger eden start and: [aValue < scavengeThreshold]).
+ self assert: scavengeThreshold + coInterpreter interpreterAllocationReserveBytes <= scavenger eden limit.
^freeStart := aValue!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>getScavengeThreshold (in category 'cog jit support') -----
+ getScavengeThreshold
+ <api>
+ <returnTypeC: #usqInt>
+ ^scavengeThreshold!
Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>scavengeThreshold (in category 'cog jit support') -----
- scavengeThreshold
- ^scavengeThreshold!
Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>scavengeThresholdAddress (in category 'trampoline support') -----
- scavengeThresholdAddress
- <api>
- <returnTypeC: #usqInt>
- ^self cCode: [(self addressOf: scavengeThreshold) asUnsignedInteger]
- inSmalltalk: [cogit simulatedReadWriteVariableAddress: #scavengeThreshold in: self]!
Item was changed:
----- Method: SpurMemoryManager>>lookupAddress: (in category 'simulation only') -----
lookupAddress: address
"If address appears to be that of a Symbol or a few well-known objects (such as classes) answer it, otherwise answer nil.
For code disassembly"
<doNotGenerate>
| fmt size string class classSize maybeThisClass classNameIndex thisClassIndex |
(self addressCouldBeObj: address) ifFalse:
+ [^address = scavengeThreshold ifTrue:
+ ['scavengeThreshold']].
- [^nil].
address - self baseHeaderSize = hiddenRootsObj ifTrue:
[^'(hiddenRootsObj+baseHeaderSize)'].
fmt := self formatOf: address.
size := self lengthOf: address baseHeader: (self baseHeader: address) format: fmt.
size = 0 ifTrue:
[^address caseOf: { [nilObj] -> ['nil']. [trueObj] -> ['true']. [falseObj] -> ['false'] } otherwise: []].
((fmt between: self firstByteFormat and: self firstCompiledMethodFormat - 1) "indexable byte fields"
and: [(size between: 1 and: 64)
and: [Scanner isLiteralSymbol: (string := (0 to: size - 1) collect: [:i| Character value: (self fetchByte: i ofObject: address)])]]) ifTrue:
[^'#', (ByteString withAll: string)].
class := self fetchClassOfNonImm: address.
(class isNil or: [class = nilObj]) ifTrue:
[^nil].
"address is either a class or a metaclass, or an instance of a class or invalid. determine which."
classNameIndex := coInterpreter classNameIndex.
thisClassIndex := coInterpreter thisClassIndex.
((classSize := self numSlotsOf: class) <= (classNameIndex max: thisClassIndex)
or: [classSize > 255]) ifTrue:
[^nil].
"Address could be a class or a metaclass"
(fmt = 1 and: [size >= classNameIndex]) ifTrue:
["Is address a class? If so class's thisClass is address."
(self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNil:
[:maybeClassName|
(self fetchPointer: thisClassIndex ofObject: class) = address ifTrue:
[^maybeClassName allButFirst]].
"Is address a Metaclass? If so class's name is Metaclass and address's thisClass holds the class name"
((self isBytes: (self fetchPointer: classNameIndex ofObject: class))
and: [(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) = '#Metaclass'
and: [size >= thisClassIndex]]) ifTrue:
[maybeThisClass := self fetchPointer: thisClassIndex ofObject: address.
(self lookupAddress: (self fetchPointer: classNameIndex ofObject: maybeThisClass)) ifNotNil:
[:maybeThisClassName| ^maybeThisClassName allButFirst, ' class']]].
^(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) ifNotNil:
[:maybeClassName| 'a(n) ', maybeClassName allButFirst]!
Item was added:
+ ----- Method: SpurMemoryManager>>printInstancesOf: (in category 'debug printing') -----
+ printInstancesOf: aClassOop
+ "Scan the heap printing the oops of any and all objects that are instances of aClassOop"
+ <api>
+ self printInstancesWithClassIndex: (self rawHashBitsOf: aClassOop)!
Item was added:
+ ----- Method: SpurMemoryManager>>printInstancesWithClassIndex: (in category 'debug printing') -----
+ printInstancesWithClassIndex: classIndex
+ "Scan the heap printing the oops of any and all objects whose classIndex equals the argument."
+ <api>
+ <inline: false>
+ self allHeapEntitiesDo:
+ [:obj|
+ (self classIndexOf: obj) = classIndex ifTrue:
+ [self printHex: obj; cr]]!
Item was changed:
----- Method: SpurMemoryManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
shrinkObjectMemory: delta
"Attempt to shrink the object memory by the given delta amount."
+ self cCode: [self print: 'shrinkObjectMemory: shouldBeImplemented'; cr]
+ inSmalltalk: [self shouldBeImplemented]!
- self shouldBeImplemented!
Item was changed:
----- Method: StackInterpreter>>printMethodCache (in category 'debug printing') -----
printMethodCache
+ <api>
+ self printMethodCacheFor: -1!
- 0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
- [:i | | s c m p |
- s := methodCache at: i + MethodCacheSelector.
- c := methodCache at: i + MethodCacheClass.
- m := methodCache at: i + MethodCacheMethod.
- p := methodCache at: i + MethodCachePrimFunction.
- ((objectMemory addressCouldBeOop: s)
- and: [c ~= 0
- and: [(self addressCouldBeClassObj: c)
- or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]) ifTrue:
- [self transcript ensureCr.
- self print: i; cr; tab.
- (objectMemory isBytesNonImm: s)
- ifTrue: [self printHex: s; space; print: (self stringOf: s); cr]
- ifFalse: [self shortPrintOop: s].
- self tab.
- (self addressCouldBeClassObj: c)
- ifTrue: [self shortPrintOop: c]
- ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
- self tab; shortPrintOop: m; tab.
- p isSymbol
- ifTrue: [self print: p]
- ifFalse: [self printNum: p].
- self cr]]!
Item was added:
+ ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
+ printMethodCacheFor: thing
+ <api>
+ 0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
+ [:i | | s c m p |
+ s := methodCache at: i + MethodCacheSelector.
+ c := methodCache at: i + MethodCacheClass.
+ m := methodCache at: i + MethodCacheMethod.
+ p := methodCache at: i + MethodCachePrimFunction.
+ ((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
+ or: [(objectMemory addressCouldBeObj: m)
+ and: [(self maybeMethodHasCogMethod: m)
+ and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
+ and: [(objectMemory addressCouldBeOop: s)
+ and: [c ~= 0
+ and: [(self addressCouldBeClassObj: c)
+ or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
+ [self cCode: [] inSmalltalk: [self transcript ensureCr].
+ self printNum: i; cr; tab.
+ (objectMemory isBytesNonImm: s)
+ ifTrue: [self cCode: 'printf("%x %.*s\n", s, byteLengthOf(s), (char *)firstIndexableField(s))'
+ inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
+ ifFalse: [self shortPrintOop: s].
+ self tab.
+ (self addressCouldBeClassObj: c)
+ ifTrue: [self shortPrintOop: c]
+ ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
+ self tab; shortPrintOop: m; tab.
+ self cCode:
+ [p > 1024
+ ifTrue: [self printHexnp: p]
+ ifFalse: [self printNum: p]]
+ inSmalltalk:
+ [p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
+ self cr]]!
Item was changed:
----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
+ [^(objectMemory characterValueOf: oop) < 256
+ ifTrue:
+ ['=$' , (objectMemory characterValueOf: oop) printString ,
+ ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')']
+ ifFalse:
+ ['=$' , (objectMemory characterValueOf: oop) printString, '(???)']].
- [^ '=$' , (objectMemory characterValueOf: oop) printString ,
- ' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')'].
(objectMemory isIntegerObject: oop) ifTrue:
[^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']].
(objectMemory isFreeObject: oop) ifTrue:
[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
(objectMemory isForwarded: oop) ifTrue:
[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
classOop ifNil: [^' has a nil class!!!!'].
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
[^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!
More information about the Vm-dev
mailing list