"The various primitives required for Slate to operate, in `pidgin' coding,
suitable for C-translation. Notably, all methods found in this file are
exported as primitive methods dispatched as described."

_@lobby quit
[
].

"Identity and cloning."

obj1@RootTraits == obj2@RootTraits
"Object identity by comparing pointers."
[
  obj1 = obj2 ifTrue: [obj1 heap TrueObject] ifFalse: [obj1 heap FalseObject]
].

obj@RootTraits identityHash
"This lazily initializes the object's identity-based hash value."
[| hash |
  hash: obj hash.
  hash = 0
    ifTrue: [hash: obj newIdentityHash.
	     obj hash: hash].
  hash
].

obj@RootTraits clone
"Allocate and answer a bit-wise identical copy of the argument. The
ObjectHeap performs clones and takes care of associated bookkeeping and
safety issues, returning a pointer to the new object."
[
  obj heap clone: obj
].

obj@OddballTraits clone
"An override of clone to provide Oddball identity behavior and still be able
to make new Oddballs easily."
"TODO: Must this be primitive now?"
[
  obj = OddballProto
    ifTrue: [resend]
    ifFalse: [obj]
].

"Slot methods"

obj@RootTraits atSlotIndex: n@SmallIntTraits
[
  obj longAt: (obj offsetForSlotIndex: n)
].

obj@RootTraits atSlotIndex: n@SmallIntTraits put: newValue@RootTraits
[
  obj longAt: (obj offsetForSlotIndex: n) put: newValue
].

obj@RootTraits atSlotNamed: name@SymbolTraits
[| map index |
  map: obj map.
  index: (map indexForName: name).
  index = -1 ifTrue: [obj interp raise: SlotNotFound].
  obj longAt: index + 2
].

obj@RootTraits atSlotNamed: name@SymbolTraits put: newValue@RootTraits
[| map index |
  map: obj map.
  index: (map indexForName: name).
  index = -1 ifTrue: [obj interp raise: SlotNotFound].
  obj longAt: index + 2 put: newValue
].

obj@RootTraits size
"The number of slots."
[| map |
  map: obj map.
  map numSlots
].

obj@RootTraits slotNames
"Answer an Array of the Symbols stored in the object\'s map slot hash table
which are actual slots (map to an index in the object\'s value vector)."
[| map result numSlots slotIndex slotTableIndex name |
  map: obj map.
  numSlots: map numSlots.
  result: (obj heap ArrayProto newSize: numSlots).
  slotIndex: 0.
  slotTableIndex: 0.
  [slotIndex < numSlots]
    whileTrue:
      [name: ((map slotEntryAt: slotTableIndex) longAt: 0).
       name = 0 ifFalse:
	 [result at: slotIndex put: name.
	  slotIndex: slotIndex + 1].
       slotTableIndex: slotTableIndex + 1].
  result
].

obj@RootTraits delegateNames
[| map result numSlots slotIndex slotTableIndex name |
  map: obj map.
  numSlots: map numDelegations.
  result: (obj heap ArrayProto newSize: numSlots).
  slotIndex: 0.
  slotTableIndex: 0.
  [slotIndex < numSlots]
    whileTrue:
      [name: ((map slotEntryAt: slotTableIndex) longAt: 0).
       name = 0 ifFalse:
	 [(map entryIsDelegateAt: slotTableIndex) ifTrue:
	   [result at: slotIndex put: name.
	    slotIndex: slotIndex + 1]].
       slotTableIndex: slotTableIndex + 1].
  result
].

obj@RootTraits addSlot: name@SymbolTraits valued: newValue@RootTraits
[| map newHashTableSize mapSizeChanged remappedOop newMap newOop |
  map: obj map.
  (map longAt: (map hashIndexForName: name) + 40) = 0
    ifTrue:
      [map shouldGrowForOneSlot
	 ifTrue: [newMap: (obj heap clone: map)]
	 ifFalse:
	   [newMap: (obj heap allocateMapCloneOf: map forAdditions: 1)]]
    ifFalse: "No slot addition needed. Maybe a map change."
      [newMap: (obj heap clone: map).
       ].
  newOop: .
  map representative: newOop.
  newOop
].

obj@RootTraits addDelegate: name@SymbolTraits valued: newValue@RootTraits
[| newMap |
  obj
].

obj@RootTraits addImmutableSlot: name@SymbolTraits valued: newValue@RootTraits
[| newMap |
  obj
].

obj@RootTraits addImmutableDelegate: name@SymbolTraits valued: newValue@RootTraits
[| newMap |
  obj
].

obj@RootTraits removeSlotNamed: name@SymbolTraits
[| newMap oldValue |
  oldValue
].

obj1@RootTraits addSlotsFrom: obj2@RootTraits
"TODO: add the loop, call to hash-table search, etc."
[| map2 slotNames2 slot index value |
  map2: obj2 map.
  slotNames2: map2 slotNames.
  index: ().
  value: (obj2 atSlotIndex: index).
  obj1 addSlotNamed: slotName valued: value properties: slot properties.
  obj1
].

obj1@RootTraits addRolesFrom: obj2@RootTraits
[
].

"Array-specifics"

obj@ArrayTraits size
"The number of elements: Object pointers."
[
  obj size
].

obj@ByteArrayTraits size
"The number of elements: Byte-values."
[
  obj size
].

obj@WordArrayTraits size
"The number of elements: Word-values."
[
  obj size
].

obj@StringTraits size
"The number of elements: Characters."
[
  obj size
].

obj@ArrayTraits at: n@SmallIntTraits
[
  obj longAt: 2 + n
].

obj@ByteArrayTraits at: n@SmallIntTraits
[
  obj byteAt: 8 + n
].

obj@WordArrayTraits at: n@SmallIntTraits
[
  obj longAt: 2 + n
].

obj@StringTraits at: n@SmallIntTraits
[
  obj byteAt: 8 + n
].

obj@ArrayTraits at: n@SmallIntTraits put: newValue@RootTraits
[
  obj longAt: 2 + n put: newValue@RootTraits
].

obj@ByteArrayTraits at: n@SmallIntTraits put: newValue@SmallIntTraits
[
  obj byteAt: 8 + n put: newValue
].

obj@WordArrayTraits at: n@SmallIntTraits put: newValue@RootTraits
[
  obj longAt: 2 + n put: newValue
].

obj@StringTraits at: n@SmallIntTraits put: newValue
[
  obj byteAt: 8 + n put: newValue
].

obj@ArrayTraits newSize: n@SmallIntTraits
[| newSize newOop |
  newSize: n + 2.
  newOop: ((obj heap allocateChunkSized: newSize)
		asPointerTo: VM Memory Object).
  newOop hash: 0.
  newOop size: n.
  newOop map: obj heap ArrayTraits.
  2 below: newSize do:
    [| :offset | newOop longAt: offset put: obj heap NilObject].
  newOop
].

obj@ByteArrayTraits newSize: n@SmallIntTraits
[| newSize newOop |
  newSize: n // 4 + 2. "Allocates in word units, so there's some extra space."
  newOop: ((obj heap allocateChunkSized: newSize)
		asPointerTo: VM Memory Object).
  newOop hash: 0.
  newOop size: n.
  newOop map: obj heap ByteArrayTraits.
  2 below: newSize do: [| :offset | newOop longAt: offset put: 0].
  newOop
].

obj@WordArrayTraits newSize: n@SmallIntTraits
[| newSize newOop |
  newSize: n + 2.
  newOop: ((obj heap allocateChunkSized: newSize)
		asPointerTo: VM Memory Object).
  newOop hash: 0.
  newOop size: n.
  newOop map: obj heap WordArrayTraits.
  2 below: newSize do: [| :offset | newOop longAt: offset put: 0].
  newOop
].

obj@StringTraits newSize: n@SmallIntTraits
[| newSize newOop |
  newSize: n // 4 + 2. "Allocates in word units, so there's some extra space."
  newOop: ((obj heap allocateChunkSized: newSize)
		asPointerTo: VM Memory Object).
  newOop hash: 0.
  newOop size: n.
  newOop map: obj heap StringTraits.
  2 below: newSize do: [| :offset | newOop longAt: offset put: 0].
  newOop
].

"Method core invocations."

method@MethodTraits value
[
].

method@MethodTraits value: arg
[
].

method@MethodTraits value: arg1 value: arg2
[
].

method@MethodTraits value: arg1 value: arg2 value: arg3
[
].

method@MethodTraits values: args@ArrayTraits
[
].

name@SymbolTraits sendTo: args@ArrayTraits &optionals: optionals
[
].

name@SymbolTraits sendTo: args@ArrayTraits through: dispatchers@ArrayTraits &optionals: optionals
[
].

name@SymbolTraits sendWith: arg
[
].

name@SymbolTraits sendWith: arg with: arg
[
].

name@SymbolTraits sendWith: arg with: arg with: arg
[
].

"Method searching."

obj@RootTraits methodNamesAt: index@SmallIntTraits
[| map |
  map: obj map.
  0 below: map slotTableSize do:
    [| :slotIndex |
     (map slotEntryAt: slotIndex) isNil
	ifTrue:
	  [0 below: (obj longAt: (obj offsetForSlotIndex: slotIndex) + 2)
	     do: [| :roleIndex | ]]].
  
].

obj@RootTraits methodNamed: name@SymbolTraits
[
].

obj@RootTraits methodNamed: name@SymbolTraits at: index@SmallIntTraits
[
].

"Method definition"

block@MethodTraits asMethod: name@SymbolTraits on: dispatchers@ArrayTraits
[| method |
  method: block clone.
  method atSlotNamed: #selector put: name.
  method addRolesForName: name to: dispatchers.
  method
].

method@MethodTraits removeFrom: dispatchers@ArrayTraits
[
].

"Arithmetics"

x@SmallIntTraits + y@SmallIntTraits
[| result |
  result: x + y
  heap isSmallInt: result
].

"Basic I/O facilities."

c@ConsoleObject read: n@SmallIntTraits from: handle
  startingAt: start@SmallIntTraits into: seq@ByteArrayTraits
[
].

c@ConsoleObject write: n@SmallIntTraits to: handle
  startingAt: start@SmallIntTraits from: seq@ByteArrayTraits
[
].

c@Console flushInput
[
].

c@Console flushOutput
[
].