addStructureNamed: #MethodDefinition basedOn: Root.
MethodDefinition export.
MethodDefinition addElementNamed: #method type: ObjectPointer.
MethodDefinition addElementNamed: #slotAccessor type: ObjectPointer.
MethodDefinition addElementNamed: #dispatchPositions type: UnsignedLongInt.
MethodDefinition addElementNamed: #dispatchID type: UnsignedLongLongInt.
MethodDefinition addElementNamed: #foundPositions type: UnsignedLongInt.
MethodDefinition addElementNamed: #dispatchRank type: UnsignedLongInt.

addStructureNamed: #RoleEntry.
RoleEntry export.
RoleEntry addElementNamed: #name type: ObjectPointer. 
"The message name the role corresponds to."
RoleEntry addElementNamed: #rolePositions type: ObjectPointer.
"The argument positions the role corresponds to."
RoleEntry addElementNamed: #methodDefinition type: MethodDefinition pointer.
"The method definition corresponding to this role."
RoleEntry addElementNamed: #nextRole type: ObjectPointer.
"The next role entry with the same name."


addStructureNamed: #RoleTable basedOn: Root.
RoleTable export.
RoleTable addElementNamed: #roles type: (Array of: RoleEntry size: 0).

roles@(RoleTable pointer) capacity
[
  roles arraySize // #[RoleEntry wordSize]
]!UnsignedLongInt inline.

roles@(RoleTable pointer) emptySpace
"Answer the number of hash table entries left to fill for role entries."
[| space |
  space: 0.
  0 below: roles capacity
    do:
      [| :index |
        (roles roles at: index) name = CurrentMemory NilObject
          ifTrue: [space: space + 1]
      ].
  space
]!UnsignedLongInt.

roles@(RoleTable pointer) minimumCapacityAccommodating: n
"The least power of 2 large enough to fit n new role entries."
[| n!LongInt tableSize requested |
  tableSize: roles capacity.
  assert: tableSize + n >= 0.
  requested: tableSize + n.
  [tableSize > requested] whileTrue: [tableSize: tableSize >> 1].
  tableSize = 0 /\ requested > 0
    ifTrue: [tableSize: 1].
  [tableSize < requested] whileTrue: [tableSize: tableSize << 1].
  tableSize
]!UnsignedLongInt.

roles@(RoleTable pointer) hashEntryForName: name
"Answer the index at which the role entry with the given name is actually
found, or Nil if none is found (there is no corresponding
role entry)."
[| name!ObjectPointer tableSize hash role!(RoleEntry pointer) |
  tableSize: roles capacity.
  hash: (name pointer header idHash bitAnd: tableSize - 1).
  hash below: tableSize
    do:
      [| :index |
        role: (roles roles at: index) address.
        role name = name
          ifTrue: [^ role]].
  tableSize = 0
    ifTrue: [^ Nil].
  0 below: hash
    do:
      [| :index |
        role: (roles roles at: index) address.
        role name = name
          ifTrue: [^ role]].
  Nil
]!(RoleEntry pointer).

roles@(RoleTable pointer) hashEntryForInsertingName: name
"Answer the index at which the first empty role entry found after the hash entry for
the name. Return Nil if none is found (there is no corresponding role entry)."
[| name!ObjectPointer tableSize hash role!(RoleEntry pointer) |
  tableSize: roles capacity.
  hash: (name pointer header idHash bitAnd: tableSize - 1).
  hash below: tableSize
    do:
      [| :index |
        role: (roles roles at: index) address.
        role name = CurrentMemory NilObject
          ifTrue: [^ role]].
  tableSize = 0
    ifTrue: [^ Nil].
  0 below: hash
    do:
      [| :index |
        role: (roles roles at: index) address.
        role name = CurrentMemory NilObject
          ifTrue: [^ role]].
  Nil
]!(RoleEntry pointer).

roles@(RoleTable pointer) growBy: n excluding: method
"Answer a role table with enough new role entries to accommodate N role additions.
or N removals if negative. The rule of thumb implemented is that the
remaining space should always exceed 25% of the total size."
[| n!LongInt method!(MethodDefinition pointer) newRoles!(RoleTable pointer) oldSize newSize |
  oldSize: roles capacity.
  newSize:
    (roles
      minimumCapacityAccommodating:
        (oldSize // 4)!LongInt cast - roles emptySpace + n).
  newRoles: (CurrentMemory newOopArray: ArrayProto sized: newSize * #[RoleEntry wordSize])!(RoleTable pointer) cast.
  0 below: oldSize
    do:
      [| :index roleName!ObjectPointer |
        roleName: (roles roles at: index) name.
        roleName = CurrentMemory NilObject
          \/ ((roles roles at: index) methodDefinition = method)
          ifFalse:
            [| chain!(RoleEntry pointer) role!(RoleEntry pointer) |
              role: (newRoles hashEntryForInsertingName: roleName).
              chain: (newRoles hashEntryForName: roleName).
              chain
                ifNotNil:
                  [
                    [chain nextRole = CurrentMemory NilObject]
                      whileFalse:
                        [chain: (newRoles roles at: chain nextRole asSmallInt) address].
                    chain nextRole: (role - newRoles roles) asObject
                  ].
              role store: (roles roles at: index).
              role nextRole: CurrentMemory NilObject
            ]
      ].
  newRoles
]!(RoleTable pointer).

addStructureNamed: #SlotEntry.
SlotEntry export.
SlotEntry addElementNamed: #name type: ObjectPointer.
"The interned-string Symbol name object for the slot."
SlotEntry addElementNamed: #offset type: ObjectPointer.
"The numeric offset within the actual object where the slot value is kept."

addStructureNamed: #SlotTable basedOn: Root.
SlotTable export.
SlotTable addElementNamed: #slots type: (Array of: SlotEntry size: 0).

slots@(SlotTable pointer) capacity
[
  slots arraySize // #[SlotEntry wordSize]
]!UnsignedLongInt inline.

slots@(SlotTable pointer) emptySpace
"Answer the number of hash table entries left to fill for slot entries."
[| space |
  space: 0.
  0 below: slots capacity
    do:
      [| :index |
        (slots slots at: index) name = CurrentMemory NilObject
          ifTrue: [space: space + 1]
      ].
  space
]!UnsignedLongInt.

slots@(SlotTable pointer) hashEntryForName: name
"Answer the index at which the slot entry with the given name is actually
found, or Nil if none is found (there is no corresponding
slot entry)."
[| name!ObjectPointer tableSize hash slot!(SlotEntry pointer) |
  tableSize: slots capacity.
  hash: (name pointer header idHash bitAnd: tableSize - 1).
  hash below: tableSize
    do:
      [| :index |
        slot: (slots slots at: index) address.
        slot name = name
          ifTrue: [^ slot]].
  tableSize = 0
    ifTrue: [^ Nil].
  0 below: hash
    do:
      [| :index |
        slot: (slots slots at: index) address.
        slot name = name
          ifTrue: [^ slot]].
  Nil
]!(SlotEntry pointer).

slots@(SlotTable pointer) hashEntryForInsertingName: name
"Answer the index at which the first empty role entry found after the hash entry for
the name. Return Nil if none is found (there is no corresponding role entry)."
[| name!ObjectPointer tableSize hash slot!(SlotEntry pointer) |
  tableSize: slots capacity.
  hash: (name pointer header idHash bitAnd: tableSize - 1).
  hash below: tableSize
    do:
      [| :index |
        slot: (slots slots at: index) address.
        slot name = CurrentMemory NilObject
          ifTrue: [^ slot]].
  tableSize = 0
    ifTrue: [^ Nil].
  0 below: hash
    do:
      [| :index |
        slot: (slots slots at: index) address.
        slot name = CurrentMemory NilObject
          ifTrue: [^ slot]].
  Nil
]!(SlotEntry pointer).

slots@(SlotTable pointer) minimumCapacityAccommodating: n
"The least power of 2 large enough to fit n new slot entries."
[| n!LongInt tableSize requested |
  tableSize: slots capacity.
  assert: tableSize + n >= 0.
  requested: tableSize + n.
  [tableSize > requested] whileTrue: [tableSize: tableSize >> 1].
  tableSize = 0 /\ requested > 0
    ifTrue: [tableSize: 1].
  [tableSize < requested] whileTrue: [tableSize: tableSize << 1].
  tableSize
]!UnsignedLongInt.

slots@(SlotTable pointer) growBy: n excluding: name
"Answer a slow table with enough new slot entries to accommodate N slot additions.
or N removals if negative. The rule of thumb implemented is that the
remaining space should always exceed 25% of the total size."
[| n!LongInt name!ObjectPointer newSlots!(SlotTable pointer) oldSize newSize |
  oldSize: slots capacity.
  newSize: 
    (slots
      minimumCapacityAccommodating: 
        (oldSize // 4)!LongInt cast - slots emptySpace + n).
  newSlots: (CurrentMemory newOopArray: ArrayProto sized: newSize * #[SlotEntry wordSize])!(SlotTable pointer) cast.
  0 below: oldSize
    do:
      [| :index slotName!ObjectPointer |
        slotName: (slots slots at: index) name.
        slotName = CurrentMemory NilObject
          \/ (slotName = name)
          ifFalse:
            [| slot!(SlotEntry pointer) |
              slot: (newSlots hashEntryForInsertingName: slotName).
              slot store: (slots slots at: index)
            ]
      ].
  newSlots
]!(SlotTable pointer).

slots@(SlotTable pointer) relocate: offset by: amount
[| amount!LongInt |
  0 below: slots capacity
    do: [| :index oldOffset |
          oldOffset: (slots slots at: index) offset asSmallInt.
          oldOffset >= offset
            ifTrue:
              [(slots slots at: index) offset: (oldOffset + amount) asObject]
        ]
].

Map addElementNamed: #header type: ObjectHeader.
Map addElementNamed: #map type: Map pointer.
Map addElementNamed: #traits type: ObjectPointer.
Map addElementNamed: #representative type: ObjectPointer.
Map addElementNamed: #numDelegates type: ObjectPointer.
"The number of delegation slots."
Map addElementNamed: #numSlots type: ObjectPointer.
"The number data slots."
Map addElementNamed: #slotTable type: SlotTable pointer.
Map addElementNamed: #roleTable type: RoleTable pointer.
Map addElementNamed: #dispatchID type: UnsignedLongLongInt.
"A serial assigned; double-long."
Map addElementNamed: #visitedPositions type: UnsignedLongInt.
"The mask of argument positions this map has been visited in by a dispatch."

h@(ObjectHeap pointer) cloneMap: map
"Answer a clone of the given map."
[| map!(Map pointer) |
  (h clone: map!(Object pointer) cast)!(Map pointer) cast
]!(Map pointer) inline.

obj@(Object pointer) changeMapTo: map
[| map!(Map pointer) |
  obj map representative = obj asObject
    ifTrue: [obj map representative: CurrentMemory NilObject].
  obj map: map
]!(Map pointer) inline.

obj@(Object pointer) makeRepresentativeOf: map
[| map!(Map pointer) |
  obj changeMapTo: map.
  map representative: obj asObject.
  map
]!(Map pointer) inline.

obj@(Object pointer) addSlotNamed: name valued: value at: offset
[| name!ObjectPointer value!ObjectPointer map!(Map pointer) newObj!(Object pointer) entry!(SlotEntry pointer) |
  entry: (obj map slotTable hashEntryForName: name).
  entry isNotNil
    ifTrue: [^ Nil].
  map: (CurrentMemory cloneMap: obj map).
  CurrentMemory rootStackPush: map address.
  map slotTable: (map slotTable growBy: 1 excluding: CurrentMemory NilObject).
  map slotTable relocate: offset by: #[ObjectPointer byteSize].
  entry: (map slotTable hashEntryForInsertingName: name).
  entry name: name.
  entry offset: offset asObject.
  obj header objectSize = ObjectSizeMask
    ifTrue:
      [newObj:
        (CurrentMemory allocateChunkSized: ObjectSizeMask
          withPayload:
            (obj header objectFormat = FormatObject
              ifTrue: [#[ObjectPointer byteSize]]
              ifFalse: [obj payloadSize + #[ObjectPointer byteSize]])).
        newObj header objectFormat: FormatOopArray]
    ifFalse:
      [obj header objectFormat = FormatObject
        ifTrue:
          [newObj: (CurrentMemory allocateChunkSized: obj header objectSize + 1)]
        ifFalse:
          [newObj: 
            (CurrentMemory allocateChunkSized: obj header objectSize + 1
              withPayload: obj payloadSize)].
        newObj header objectFormat: obj header objectFormat].
  CurrentMemory rootStackPop: 1.
  newObj header idHash: CurrentMemory newIdentityHash.
  obj!(Byte pointer) cast + obj firstSlotOffset
    copyBytes: offset - obj firstSlotOffset
    into: newObj!(Byte pointer) cast + newObj firstSlotOffset.
  newObj slotValueAtOffset: offset put: value.
  obj!(Byte pointer) cast + offset
    copyBytes: obj totalSize - offset
    into: newObj!(Byte pointer) cast + offset + #[ObjectPointer byteSize].
  newObj map: map.
  map representative: newObj asObject.
  newObj
]!(Object pointer).

obj@(Object pointer) addSlotNamed: name valued: value
[| name!ObjectPointer value!ObjectPointer newObj!(Object pointer) |
  newObj: 
    (obj 
      addSlotNamed: name 
      valued: value 
      at: obj firstSlotOffset + ((obj map numDelegates asSmallInt + obj map numSlots asSmallInt) * #[ObjectPointer byteSize])).
  newObj 
    ifNil: [^ obj].
  newObj map numSlots: (newObj map numSlots asSmallInt + 1) asObject.
  newObj
]!(Object pointer) export.

obj@(Object pointer) addDelegateNamed: name valued: value
[| name!ObjectPointer value!ObjectPointer newObj!(Object pointer) |
  newObj: 
    (obj 
      addSlotNamed: name 
      valued: value 
      at: obj firstSlotOffset + (obj map numDelegates asSmallInt * #[ObjectPointer byteSize])).
  newObj
    ifNil: [^ obj].
  newObj map numDelegates: (newObj map numDelegates asSmallInt + 1) asObject.
  newObj
]!(Object pointer) export.

obj@(Object pointer) removeSlotNamed: name
[| name!ObjectPointer value!ObjectPointer map!(Map pointer) newObj!(Object pointer) offset entry!(SlotEntry pointer) |
  entry: (obj map slotTable hashEntryForName: name).
  entry
    ifNil: [^ obj].
  offset: entry offset asSmallInt.
  value: (obj slotValueAt: offset).
  map: (CurrentMemory cloneMap: obj map). 
  offset < (obj firstSlotOffset + (map numDelegates asSmallInt * #[ObjectPointer byteSize]))
    ifTrue: [map numDelegates: (map numDelegates asSmallInt - 1) asObject]
    ifFalse: [map numSlots: (map numSlots asSmallInt - 1) asObject].
  CurrentMemory rootStackPush: map address.
  map slotTable: (map slotTable growBy: -1 excluding: name).
  map slotTable relocate: offset by: #[ObjectPointer byteSize negated].
  obj header objectFormat = FormatObject
    ifTrue:
      [newObj: (CurrentMemory allocateChunkSized: obj header objectSize - 1).
        newObj header objectFormat: obj header objectFormat]
    ifFalse:
      [obj header objectSize = ObjectSizeMask
        ifTrue:
          [obj payloadSize = #[ObjectPointer byteSize]
            ifTrue: 
              [newObj: (CurrentMemory allocateChunkSized: ObjectSizeMask).
                newObj header objectFormat: FormatObject]
            ifFalse: 
              [newObj:
                (CurrentMemory allocateChunkSized: ObjectSizeMask 
                  withPayload: obj payloadSize - #[ObjectPointer byteSize]).
                newObj header objectFormat: FormatOopArray]]
        ifFalse:
          [newObj:
            (CurrentMemory allocateChunkSized: obj header objectSize - 1
              withPayload: obj payloadSize).
            newObj header objectFormat: obj header objectFormat]].
  CurrentMemory rootStackPop: 1.
  newObj header objectFormat: obj header objectFormat.
  newObj header idHash: CurrentMemory newIdentityHash.
  obj!(Byte pointer) cast + obj firstSlotOffset
    copyBytes: offset - obj firstSlotOffset
    into: newObj!(Byte pointer) cast + newObj firstSlotOffset.
  obj!(Byte pointer) cast + offset + #[ObjectPointer byteSize]
    copyBytes: obj totalSize - offset - #[ObjectPointer byteSize]
    into: newObj!(Byte pointer) cast + offset.
  newObj map: map.
  map representative: newObj asObject.
  newObj
]!(Object pointer) export.

obj@(Object pointer) addRoleNamed: name at: position dispatching: method
[| name!ObjectPointer method!(MethodDefinition pointer) map!(Map pointer) chain!(RoleEntry pointer) entry!(RoleEntry pointer) |
  map: (CurrentMemory cloneMap: obj map).
  chain: (obj map roleTable hashEntryForName: name).
  obj makeRepresentativeOf: map.
  [chain isNil]
    whileFalse:
      [
        chain methodDefinition = method
          ifTrue:
            [
              map roleTable: (map roleTable growBy: 0 excluding: Nil).
              entry: (map roleTable hashEntryForName: name).
              [entry isNil]
                whileFalse:
                  [entry methodDefinition = method
                    ifTrue:
                      [entry rolePositions: (entry rolePositions asSmallInt bitOr: position) asObject.
                        ^ False].
                    entry nextRole = CurrentMemory NilObject
                      ifTrue: [entry: Nil]
                      ifFalse: [entry: (map roleTable roles at: entry nextRole asSmallInt) address]]
            ].
        chain nextRole = CurrentMemory NilObject
          ifTrue: [chain: Nil]
          ifFalse: [chain: (map roleTable roles at: chain nextRole asSmallInt) address]
      ].
  map roleTable: (map roleTable growBy: 1 excluding: Nil).
  entry: (map roleTable hashEntryForInsertingName: name).
  chain: (map roleTable hashEntryForName: name).
  chain
    ifNotNil:
      [
        [chain nextRole = CurrentMemory NilObject]
          whileFalse:
            [chain: (map roleTable roles at: chain nextRole asSmallInt) address].
        chain nextRole: (entry - map roleTable roles) asObject
      ].
  entry name: name.
  entry nextRole: CurrentMemory NilObject.
  entry rolePositions: position asObject.
  entry methodDefinition: method.
  True
]!Bool export.

obj@(Object pointer) removeRoleNamed: name dispatching: method
[| name!ObjectPointer method!(MethodDefinition pointer) map!(Map pointer) roles!(RoleTable pointer) n |
  n: 0.
  roles: obj map roleTable.
  0 below: roles capacity
    do: [| :index |
          (roles roles at: index) methodDefinition = method
            ifTrue: [n: n + 1]
        ].
  n = 0
    ifTrue: [^ False].
  map: (CurrentMemory cloneMap: obj map).
  map roleTable: (roles growBy: n excluding: method).
  obj makeRepresentativeOf: map.
  True
]!Bool export. 

obj@(Object pointer) hasRoleNamed: selector at: positions dispatching: method
[| method!ObjectPointer map!(Map pointer) |
  map: obj map.
  0 below: map roleTable capacity
    do: [| :index role!(RoleEntry pointer) |
      role: (map roleTable roles at: index) address.
      role name = selector
        /\ ((role rolePositions asSmallInt bitAnd: positions) = positions)
        /\ (role methodDefinition method = method)
        ifTrue:
          [^ role methodDefinition]].
  Nil
]!(MethodDefinition pointer) export.

method@ObjectPointer isMethod: selector on: args arity: n
[| selector!ObjectPointer args!(ObjectPointer pointer) positions def!(MethodDefinition pointer) |
  positions: 0.
  def: Nil.
  0 below: n
    do: [| :index role!ObjectPointer roleDef!(MethodDefinition pointer) |
      role: (args at: index).
      role isSmallInt
        ifFalse:
          [| obj!(Object pointer) |
            obj: role pointer.
            [obj header isForwarded]
              whileTrue: [obj: obj!(ForwardedObject pointer) cast target].
            roleDef: (obj hasRoleNamed: selector at: 1 << index dispatching: method).
            roleDef
              ifNotNil:
                [positions: (positions bitOr: 1 << index).
                  def: roleDef]]].
  def isNotNil /\ (positions = def dispatchPositions)
    ifTrue: [def]
    ifFalse: [Nil]
]!(MethodDefinition pointer) export.

method@ObjectPointer asMethod: selector on: args arity: n
[| selector!ObjectPointer args!(ObjectPointer pointer) positions oldDef!(MethodDefinition pointer) def!(MethodDefinition pointer) argBuffer!(Array of: ObjectPointer size: 16) |
  positions: 0.
  0 below: n
    do: [| :index role!ObjectPointer |
      role: (args at: index).
      role isSmallInt \/ (role = (CurrentMemory specialAt: NoRoleObject))
        ifFalse:
          [positions: (positions bitOr: 1 << index)]].
  args!(Word pointer) cast
    copyWords: n
    into: argBuffer!(Word pointer) cast.
  oldDef: (selector dispatchTo: argBuffer arity: n above: 0).
  oldDef isNotNil 
    /\ (oldDef dispatchPositions = positions)
    /\ (oldDef = (oldDef method isMethod: selector on: args arity: n))
    ifFalse: 
      [oldDef: Nil].
  def: (CurrentMemory cloneSpecial: MethodDefinitionProto)!(MethodDefinition pointer) cast.
  CurrentMemory rootStackPush: def address.
  def method: method.
  def dispatchPositions: positions.
  0 below: n
    do: [| :index role!ObjectPointer |
      role: (args at: index).
      role isSmallInt \/ (role = (CurrentMemory specialAt: NoRoleObject))
        ifFalse:
          [| obj!(Object pointer) |
            obj: role pointer.
            [obj header isForwarded]
              whileTrue: [obj: obj!(ForwardedObject pointer) cast target].
            oldDef
              ifNotNil: [obj removeRoleNamed: selector dispatching: oldDef].
            obj addRoleNamed: selector at: 1 << index dispatching: def]].
  CurrentMemory rootStackPop: 1.
  def
]!(MethodDefinition pointer) export.