VM Maker: VMMaker.oscog-eem.530.mcz

 
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!