addStructureNamed: #ObjectHeap.
ObjectHeap export.
ObjectHeap addElementNamed: #memory type: UnsignedLongInt pointer.
ObjectHeap addElementNamed: #memoryEnd type: UnsignedLongInt.
ObjectHeap addElementNamed: #memoryLimit.

ObjectHeap addElementNamed: #totalObjectCount type: UnsignedLongInt.
ObjectHeap addElementNamed: #signalLowSpace type: UnsignedLongInt.
ObjectHeap addElementNamed: #lowSpaceThreshold.
ObjectHeap addElementNamed: #shrinkThreshold.
ObjectHeap addElementNamed: #growthHeadroom.

ObjectHeap addElementNamed: #lastHash.

"The following are statically-defined indices for the slots of the
specialObjectsOop array at which ObjectPointers to the various objects
needing primitive methods are stored."
"Any Object playing dispatch roles in VM-primitive methods must be here:"
{
#LobbyObject.
#NoRoleObject. #NilObject. #TrueObject. #FalseObject.
#ArrayProto.
#MapProto. #MethodDefinitionProto.
#SmallIntegerProto. #FloatProto.
#CompiledMethodTraits. #PrimitiveMethodTraits.
#LexicalContextProto. #InterpreterObject.
#NotFoundOnSymbol. #NotFoundOnAfterSymbol. #WrongInputsToSymbol. #MayNotReturnToSymbol. #SlotNotFoundSymbol. #KeyNotFoundSymbol.
#BitShiftOverflowSymbol. #AddOverflowSymbol. #SubtractOverflowSymbol. #MultiplyOverflowSymbol. #DivideByZeroSymbol
} doWithIndex: [| :each :index | (addConstantNamed: each valued: index) export].

addGlobalNamed: #CurrentMemory type: ObjectHeap pointer.
CurrentMemory export.
"A pseudo-variable for referring to the heap; potentially there could be
multiple heaps."

ObjectHeap addElementNamed: #TrueObject type: ObjectPointer.
ObjectHeap addElementNamed: #FalseObject type: ObjectPointer.
ObjectHeap addElementNamed: #NilObject type: ObjectPointer.
ObjectHeap addElementNamed: #specialObjectsOop type: ObjectPointer.
"The object into which all the preceding objects are stored. The values of
those slots / constants become the indices where the image/VM agree to place
those objects. This is in the heap, so all references get updated properly."

h@(ObjectHeap pointer) specialAt: index
"Answer the SpecialObjectsArray element (oop) at the given index."
[
  h specialObjectsOop pointer arrayElements at: index
]!ObjectPointer.

h@(ObjectHeap pointer) adjustFieldsOf: oop by: shiftAmountInBytes
[| oop!ObjectPointer ptr!(Object pointer) shiftAmountInBytes!LongInt fieldOop!ObjectPointer |
  ptr: oop pointer.
  assert: (h includes: ptr).
  ptr map: (ptr map!(Byte pointer) cast + shiftAmountInBytes)!(Map pointer) cast.
  ptr firstSlotOffset
    to: ptr lastOopOffset
    by: #[ObjectPointer byteSize] 
    do: [| :offset |
     fieldOop: (ptr slotValueAtOffset: offset).
     fieldOop isObject
       ifTrue: [ptr slotValueAtOffset: offset put: fieldOop + shiftAmountInBytes]].
].

h@(ObjectHeap pointer) adjustAllOopsBy: shiftAmountInBytes
"Adjust all oop references by the given number of bytes. This is done just
after reading in an image when the new base address of the ObjectHeap is
different from the base address in the image. Answers the number of objects
found or 0 with no shift."
[| shiftAmountInBytes oop!ObjectPointer total |
  shiftAmountInBytes = 0 ifTrue: [^ 0].
  total: 0.
  oop: h firstObject.
  [oop < h memoryEnd]
    whileTrue:
      [(h isFree: oop)
	 ifFalse: [total: total + 1.
		   h adjustFieldsOf: oop by: shiftAmountInBytes].
       oop: (h objectAfter: oop)].
  total
]!UnsignedLongInt.

h@(ObjectHeap pointer) initializeWithShift: shiftAmountInBytes
"Initialize ObjectHeap variables at startup time.
ASSUME: memoryEnd is initially set (by the image-reading code) to the end
of the last object in the image."
"ASSUME: image reader initializes the following variables: 
memory, memoryEnd, memoryLimit, specialObjectsOop, lastHash."
[
  "Adjust Oops for the possibility that the image is at a different address."
  h initializeCollector.
  h totalObjectCount: (h adjustAllOopsBy: shiftAmountInBytes).
  h specialObjectsOop: h specialObjectsOop + shiftAmountInBytes.
  h rootStackPush: h specialObjectsOop address.
  "Heavily-used special objects."
  h NilObject: (h specialAt: NilObject).
  h rootStackPush: h NilObject address.
  h TrueObject: (h specialAt: TrueObject).
  h rootStackPush: h TrueObject address.
  h FalseObject: (h specialAt: FalseObject).
  h rootStackPush: h FalseObject address.
  h signalLowSpace: False.
  h growthHeadroom: 4 << 20.
  "4 MB of headroom when growing."
  h shrinkThreshold: 8 << 20.
  "8 MB of free space before shrinking."
] export.

"Object Enumeration"

h@(ObjectHeap pointer) memoryStart
"Answer the start of the ObjectHeap."
[
  h memory!UnsignedLongInt cast
]!UnsignedLongInt export.

h@(ObjectHeap pointer) includes: address
"Answer whether the given address is in ObjectHeap object memory."
[
  address >= h memoryStart /\ (address < h memoryEnd)
]!Bool export.

h@(ObjectHeap pointer) checkValid: address
"Raise an error if the address is invalid somehow; useful for debugging."
[| address |
  address < h memoryStart
    ifTrue: [error: 'Bad address: too low.'].
  address >= h memoryLimit
    ifTrue: [error: 'Bad address: past the end of the heap.'].
] export.

h@(ObjectHeap pointer) firstObject
"Answer the first object or free chunk in the ObjectHeap."
[
  h memoryStart
]!ObjectPointer.

h@(ObjectHeap pointer) firstAccessibleObject
"Answer the first accessible object in the ObjectHeap."
[| obj!ObjectPointer |
  obj: h firstObject.
  [obj < h memoryEnd]
    whileTrue:
      [(h isFree: obj) ifFalse: [^ obj].
       obj: (h objectAfter: obj)].
  error: 'The heap is empty'.
  0
]!ObjectPointer.

h@(ObjectHeap pointer) accessibleObjectAfter: oop
"Answer the accessible object following the given object or free chunk in the
ObjectHeap. Answer 0 when the ObjectHeap is exhausted."
[| oop!ObjectPointer obj!ObjectPointer |
  assert: (h includes: oop pointer).
  obj: (h objectAfter: oop).
  assert: (h includes: obj pointer).
  [obj < h memoryEnd]
    whileTrue:
      [assert: (h includes: obj).
       (h isFree: obj) ifFalse: [^ obj].
       obj: (h objectAfter: obj)].
  0
]!ObjectPointer.

h@(ObjectHeap pointer) initialInstanceOfMap: map
"Answer the first object which uses the given map,
or answer 0 (its oop) if none does."
[| map!(Map pointer) thisObj!ObjectPointer |
  assert: (h includes: map).
  thisObj: h firstAccessibleObject.
  [thisObj = 0]
    whileFalse:
      [assert: (h includes: thisObj pointer).
       thisObj pointer map = map ifTrue: [^ thisObj].
       thisObj: (h accessibleObjectAfter: thisObj)].
  0
]!ObjectPointer.

h@(ObjectHeap pointer) nextInstanceOfMap: map after: oop
"Answer the next object which uses the given map directly,
or answer 0 (its oop) if none does."
[| map!(Map pointer) oop!ObjectPointer thisObj!ObjectPointer |
  assert: (h includes: map).
  thisObj: (h accessibleObjectAfter: oop).
  [thisObj = 0]
    whileFalse:
      [assert: (h includes: thisObj pointer).
       thisObj pointer map = map ifTrue: [^ thisObj].
       thisObj: (h accessibleObjectAfter: oop)].
  0
]!ObjectPointer.

h@(ObjectHeap pointer) initialDelegateTo: parentOop
"Answer the first object which delegates to the given object directly, or
answer 0 (its oop) if none does."
[| parentOop!ObjectPointer thisObj!ObjectPointer thisParent!ObjectPointer numDelegates |
  assert: (h includes: parentOop pointer).
  thisObj: h firstAccessibleObject.
  [thisObj = 0]
    whileFalse:
      [numDelegates: thisObj pointer map numDelegates asSmallInt.
       0 below: numDelegates do:
	 [| :index |
	  thisParent: (thisObj pointer slotValueAt: index).
	  thisParent = parentOop ifTrue: [^ thisObj]].
       thisObj: (h accessibleObjectAfter: thisObj)].
  0
]!ObjectPointer.

h@(ObjectHeap pointer) nextDelegateTo: parentOop after: oop
"Answer the next object which delegates to the given parent object directly,
or answer 0 (its oop) if none does."
[| parentOop!ObjectPointer oop!ObjectPointer thisObj!ObjectPointer thisParent!ObjectPointer numDelegates |
  assert: (h includes: parentOop pointer).
  assert: (h includes: oop pointer).
  thisObj: (h accessibleObjectAfter: oop).
  [thisObj = 0]
    whileFalse:
      [numDelegates: thisObj pointer map numDelegates asSmallInt.
       0 below: numDelegates do:
	 [| :index |
	  thisParent: (thisObj pointer slotValueAt: index).
	  assert: (h includes: thisParent pointer).
	  thisParent = parentOop ifTrue: [^ thisObj]].
       thisObj: (h accessibleObjectAfter: oop)].
  0
]!ObjectPointer.

"Allocation."

h@(ObjectHeap pointer) newIdentityHash
"Answer a new pseudo-random number fitting into the idHash slot of the
object header.
ASSUME: 22-bit idHash bit-field."
"FIX: the two pseudo-randomizing numbers here."
[
  h lastHash: 13849 + (27181 * h lastHash)
]!UnsignedLongInt.

h@(ObjectHeap pointer) memorySize
"Answer the numeric difference between the start and end of memory addreses."
[
  h memoryEnd!UnsignedLongInt cast - h memory!UnsignedLongInt cast
]!UnsignedLongInt inline export.

h@(ObjectHeap pointer) growBy: delta
"Attempt to grow the heap by the given amount."
[| oldEnd |
  assert: delta > 0.
  oldEnd: h memoryEnd.
  'growMemoryBy(h, delta)' directly.
  oldEnd = h memoryEnd ifFalse:
    [h initializeWithFirstFreeAt: oldEnd].
] export.

h@(ObjectHeap pointer) shrinkBy: delta
"Attempt to shrink the heap by the given amount."
[
  assert: delta > 0.
  'shrinkMemoryBy(h, delta)' directly.
  h memoryEnd = h memoryLimit ifFalse:
    [h initializeWithFirstFreeAt: h memoryEnd].
] export.

"Raw data-pushing:"

src@(Word pointer) copyWords: n into: dst
[| dst!(Word pointer) |
  [n > 0]
    whileTrue:
      [dst store: src load.
        dst: dst + 1.
        src: src + 1.
        n: n - 1].
] inline.

src@(Byte pointer) copyBytes: n into: dst
[| dst!(Byte pointer) |
  [n > 0]
    whileTrue:
      [dst store: src load.
        dst: dst + 1.
        src: src + 1.
        n: n - 1].
] inline.

dst@(Word pointer) fillWords: n with: value
[| value!Word |
  [n > 0]
    whileTrue:
      [dst store: value.
        dst: dst + 1.
        n: n - 1].
] inline.

dst@(Byte pointer) fillBytes: n with: value
[| value!Byte |
  [n > 0]
    whileTrue:
      [dst store: value.
        dst: dst + 1.
        n: n - 1].
] inline.