!=========================================================================
! Copyright (C) VMware, Inc. 1991-2011.  All Rights Reserved
!
! $Id: gsclonelist.gs,v 1.5 2008-01-09 22:50:11 stever Exp $
!
! Superclass Hierarchy:
!   GsCloneList, Array, SequenceableCollection, Collection, Object.
!
!=========================================================================

expectvalue %String
run
^ Array _newKernelSubclass: 'GsCloneList'
  instVarNames: #()
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 887
%

! remove existing behavior from GsCloneList
removeallmethods GsCloneList
removeallclassmethods GsCloneList

category: 'For Documentation Installation only'
classmethod: GsCloneList
installDocumentation

| doc |
doc := GsClassDocumentation _newForObsoletePrivateGsClass: self
                            asOfGsVersion: '5.0'.

doc documentClassWith: (GsDocText new).

self description: doc.
%

! ------------------- Class methods for GsCloneList
category: 'Instance Creation'
classmethod: GsCloneList
create

"Provided for backward compatibility with C-based clone list implementation."

^self new
%

category: 'Instance Creation'
classmethod: GsCloneList
new

"Returns a new initialized instance."

^self basicNew initialize
%

! ------------------- Instance methods for GsCloneList

category: 'Updating'
method: GsCloneList
_at: aKey putIfAbsent: aValue

"Private.  Same as at:putIfAbsent: but without nil or SmallInteger checks.
 This supports object passivation.  Others use at their own risk."

| alias ex |

alias := aKey _alias.
self size < alias ifTrue: [
  self size: alias + 100.
  self privat: alias put: aValue.
  ^aValue
].
ex := self privat: alias.
ex == nil ifTrue: [
  self privat: alias put: aValue.
  ^aValue
].
^ex
%

category: 'Accessing'
method: GsCloneList
at: aKey

""

| alias sz ex |
alias := aKey _alias.
alias < 0 ifTrue: [ 
  ^self _halt: 'Attempt to use a SmallInteger key in a Clone List' 
  ].
sz := self size.
sz < alias ifTrue: [
  ^self _errorNotFound: aKey
].
ex := self privat: alias.
^ex = self nilValue ifTrue: [ nil ] ifFalse: [ ex ]
%

category: 'Accessing'
method: GsCloneList
at: aKey ifAbsent: failBlock

""

| alias sz ex |
alias := aKey _alias.
alias < 0 ifTrue: [ 
  ^self _halt: 'Attempt to use a SmallInteger key in a Clone List' 
  ].
sz := self size.
sz < alias ifTrue: [
  ^failBlock value
].
ex := self privat: alias.
^ex = self nilValue ifTrue: [ nil ] ifFalse: [ ex ]
%

category: 'Accessing'
method: GsCloneList
at: aKey otherwise: alternateValue

""

| alias sz ex |
alias := aKey _alias.
alias < 0 ifTrue: [
  ^self _halt: 'Attempt to use a SmallInteger key in a Clone List' 
  ].
sz := self size.
sz < alias ifTrue: [
  ^alternateValue
].
ex := self privat: alias.
^ex = self nilValue ifTrue: [ nil ] ifFalse: [ ex ]
%

category: 'Updating'
method: GsCloneList
at: aKey put: aValue

""

| alias val sz ex |
alias := aKey _alias.
alias < 0 ifTrue: [ 
  ^self _halt: 'Attempt to use a SmallInteger key in a Clone List' 
  ].
val := aValue == nil ifTrue: [ self nilValue ] ifFalse: [ aValue ].
sz := self size.
sz < alias ifTrue: [
  self size: alias.
  self privat: alias put: val.
  ^aValue
].
ex := self privat: alias.
^ex = self nilValue ifTrue: [ nil ] ifFalse: [ ex ]
%

category: 'Updating'
method: GsCloneList
at: aKey putIfAbsent: aValue

"If there is no Association for the given key in the receiver, the given
 value is associated with it.  Returns the value associated with the
 key when the operation is finished."

| alias val sz ex |

alias := aKey _alias.
alias < 0 ifTrue: [ 
  ^self _halt: 'Attempt to use a SmallInteger key in a Clone List' 
  ].
val := aValue == nil ifTrue: [ self nilValue ] ifFalse: [ aValue ].
sz := self size.
sz < alias ifTrue: [
  self size: alias.
  self privat: alias put: val.
  ^aValue
].
ex := self privat: alias.
ex == nil ifTrue: [
  self privat: alias put: val.
  ^aValue
].
^ex = self nilValue ifTrue: [ nil ] ifFalse: [ ex ]
%

category: 'Backward Compatibility'
method: GsCloneList
destroy

"Provided for backward compatibility with C-based clone lists."

self size: 0
%

category: 'Backward Compatibility'
method: GsCloneList
free

"Provided for backward compatibility with C-based clone lists."

self size: 0
%

category: 'Initializing'
method: GsCloneList
initialize

""

self size: 0
%

category: 'Private'
method: GsCloneList
nilValue

""

^'nil'
%

category: 'Private'
method: GsCloneList
privat: anIndex

"Returns the value of an indexable element in the receiver.  The argument
 anIndex must not be larger than the size of the receiver, and must not be less
 than 1.

 Generates an error if anIndex is not a SmallInteger or is out of bounds, or if
 the receiver is not indexable."

<primitive: 32>

(self class isIndexable)     "not an indexable object"
  ifFalse: [self _errorNotIndexable].
(anIndex _isSmallInteger)
  ifTrue: [self _errorIndexOutOfRange: anIndex]
  ifFalse: [self _errorNonIntegerIndex: anIndex].
self _primitiveFailed: #at:
%

category: 'Private'
method: GsCloneList
privat: anIndex put: aValue

"Stores the argument aValue in the indexable element of the receiver indicated
 by anIndex. The argument anIndex must not be larger than 1 + the size of the
 receiver, and must not be less than 1.

 Generates an error if anIndex is not a SmallInteger or is out of bounds, if the
 receiver is not indexable, or if the receiver is not of the right class to
 store the given value.  Returns the receiver."

"The primitive is equivalent to GciStoreIdxOop or GciStoreByte, depending on
 implementation of the receiver."

<primitive: 268>

(anIndex _isSmallInteger)
  ifFalse: [self _errorNonIntegerIndex: anIndex].
(self class isIndexable)  "not an indexable object"
  ifFalse: [self _errorNotIndexable].
((anIndex < 1) | (anIndex > (self size + 1)))  "out of bounds"
  ifTrue: [self _errorIndexOutOfRange: anIndex].
(self class isBytes)
ifTrue:
  [ ((aValue class ~~ SmallInteger) _or: [ (aValue < 0) | (aValue > 255) ])
    ifTrue: [aValue _error: #rtErrExpectedByteValue].
  ].

self _primitiveFailed: #at:put:
%

