      *>----------------------------------------------------------------
      *> An IdentityDictionary stores key/data pairs or associations.
      *> Send the message "ofAssociations" to create a dictionary which
      *> stores instances of Association. Send the message "ofValues"
      *> to create a dictionary which stores key/data pairs.
      *>
      *> An IdentityDictionary is more specific than a Dictionary as
      *> it compares object references instead of values. For example,
      *> if you asked it to find the key myKey it would only find it if
      *> the dictionary contained the same object reference as myKey -
      *> it would not compare the value of myKey against keys in the
      *> dictionary.
      *>
      *>#See the section Using Dictionaries.
      *>#See class "dictinry".
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set mfoo
       class-id. identitydictionary data is protected
                     inherits from dictionary with data.


        object section.
        class-control.
           dictionary is class "dictinry"
           identitydictionary is class "idictnry".

       class-object.
       object-storage section.
       end class-object.


       Object.

       object-storage section.

      *>---------------------------------------------------------------
      *> PRIVATE. Returns true if the association (anElement) is at a
      *> real integer index (anIndex)
      *>---------------------------------------------------------------
       method-id. "isat".
       local-storage section.
       01 lsBuffer1        pic x(bufferSize).
       01 lsBuffer2        pic x(bufferSize).
       01 lsBuffer3        pic x(bufferSize).

       01 aptr             pointer.
       01 keyptr1          pointer.
       01 keyptr2          pointer.

       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 anelement            COLLECTABLE.
       01 lnkbool                 pic x comp-5.
           88 lnkistrue           value 1.
           88 lnkisfalse          value 0.
       01 anelement2            COLLECTABLE.
       01 key1                  KEYITEM.
       01 key2                  KEYITEM.

       procedure division using anelement anindex
                          returning lnkbool.
           invoke self "isOccuppiedAt" using anindex
                                        returning lnkbool
           if lnkistrue
               if collectionStride > bufferSize
                   invoke self "allocateElement" returning aptr
                   set address of anelement2 to aptr
               else
                   set address of anElement2 to address of lsBuffer1
               end-if

               if keySize > bufferSize
                   invoke self "malloc" using keySize returning keyptr1
                   invoke self "malloc" using keySize returning keyptr2
                   set address of key1 to keyptr1
                   set address of key2 to keyptr2
               else
                   set address of key1 to address of lsBuffer2
                   set address of key2 to address of lsBuffer3
               end-if

               invoke self "BasicAtNoGC" using anindex
                                returning anElement2
               if associationtemplate equal to null
                   invoke anelement2 as object "getKey" returning key1
                   invoke anelement as object "getKey" returning key2
               else
                   move anElement(1:keySize) to key1(1:keysize)
                   move anElement2(1:keySize) to key2(1:keysize)
               end-if
               if key1(1:keysize) = key2(1:keysize)
                   set lnkistrue to true
               else
                   set lnkisfalse to true
               end-if
               if collectionStride > bufferSize
                   invoke self "dealloc" using aptr
               end-if
               if keySize > bufferSize
                   invoke self "dealloc" using keyptr1
                   invoke self "dealloc" using keyptr2
               end-if
           end-if
           exit method.
       end method "isat".

      *>--------------------------------------------------------------
      *>PRIVATE. Returns the real index of the key aKey.
      *>--------------------------------------------------------------
       method-id. "findKey".
       local-storage section.
       01 lsBuffer         pic x(bufferSize).


       01 temp             pic x(4) comp-5.
       01 asize            pic s9(9) comp-5.
       01 aptr             pointer.

       01 hashvalue        pic s9(9) comp-5.
       01 i                pic x(4) comp-5.
       01 bool             pic x comp-5.
           88  istrue      value 1.
           88  isfalse     value 0.
       01 emptystatus      pic x comp-5.
           88 isoccuppied  value 1.
           88 isempty      value 0.
        01 aChar    pic x.
        01 aNumber  pic x comp-5 redefines aChar.

       linkage section.
       01 lnkbool                 pic x comp-5.
           88 lnkistrue           value 1.
           88 lnkisfalse          value 0.
       01 anindex              pic s9(9) comp-5.

       01 akey                 KEYITEM.
       01 lnkKey               KEYITEM.

       procedure division using akey lnkbool returning anindex.
           move capacity to asize
           if keytemplate equal to null
               move akey(1:objectreferencesize) to
                    hashvalue(1:objectreferencesize)
           else
               move zero to hashValue
               perform varying i from 1 by 1 until i > keySize
                   move aKey(i:1) to aChar
                   multiply 47 by hashValue
                   add aNumber to hashValue
               end-perform
               if hashValue < 0
                   multiply -1 by hashValue
               end-if
           end-if
           move hashvalue to anindex
           set isfalse to true
           set isoccuppied to true
           if keySize > bufferSize
               invoke self "malloc" using keySize returning aptr
               set address of lnkKey to aptr
           else
               move low-values to lsBuffer
               set address of lnkKey to address of lsBuffer
           end-if
           perform with test after until istrue
               divide anindex by asize giving temp
                                      remainder anindex
               add 1 to anindex
               invoke self "isEmptyAt" using anindex returning bool
               if isfalse
                   invoke self "basicKeyAt" using anindex
                                     returning lnkKey
                   if akey(1:keysize) = lnkKey(1:keysize)
                       set istrue to true
                   else
                       set isfalse to true
                   end-if
               else
                   set isempty to true
               end-if
           end-perform
      $if gc defined
           if keytemplate = null
                call "oopsrelease" using by value 1
                                by value lnkKey(1:objectreferencesize)
           end-if
      $end

           if keySize > bufferSize
               invoke self "dealloc" using aptr
           end-if
           move emptystatus to lnkbool
           exit method.
       end method "findKey".

      *>--------------------------------------------------------------
      *>PRIVATE. Returns the real index of the association anElement.
      *>--------------------------------------------------------------
       method-id. "findElement".
       local-storage section.
       01 lsBuffer            pic x(bufferSize).
       01 temp                pic s9(9) comp-5.
       01 hashvalue           pic s9(9) comp-5.
       01 i                   pic s9(9) comp-5.
       01 asize               pic s9(9) comp-5.
       01 aptr                usage pointer.
       01 bool                pic x comp-5.
           88 istrue           value 1.
           88 isfalse          value 0.
        01 aChar    pic x.
        01 aNumber  pic x comp-5 redefines aChar.

       linkage section.
       01 anindex              pic s9(9) comp-5.
       01 anelement            COLLECTABLE.

       01 aKey                 KEYITEM.


       procedure division using anelement returning anindex.
           move capacity to asize
           if associationtemplate equal to null
               if keytemplate equal to null
                   invoke anElement as object "getKey"
                               returning hashValue
               else
                   if keySize > bufferSize
                       invoke self "malloc" using keySize returning aptr
                       set address of akey to aptr
                   else
                       set address of akey to address of lsBuffer
                   end-if

                   invoke anElement as object "getKey"
                               returning aKey

                   move zero to hashValue
                   perform varying i from 1 by 1 until i > keySize
                       move aKey(i:1) to aChar
                       multiply 47 by hashValue
                       add aNumber to hashValue
                   end-perform
                   if hashValue < 0
                       multiply -1 by hashValue
                   end-if
                   if keySize > bufferSize
                       invoke self "dealloc" using aptr
                   end-if
               end-if
           else
               if keytemplate equal to null  *>> Keysize must be 4
                   move anElement(1:objectreferencesize) to
                        hashValue(1:objectreferencesize)
               else
                   move zero to hashValue
                   perform varying i from 1 by 1 until i > keySize
                       move anElement(i:1) to aChar
                       multiply 47 by hashValue
                       add aNumber to hashValue
                   end-perform
                   if hashValue < 0
                       multiply -1 by hashValue
                   end-if
               end-if
           end-if
           move hashvalue to anindex
           set isfalse to true
           perform with test after until istrue
               divide anindex by asize giving temp
                                      remainder anindex
               add 1 to anindex
               invoke self "isEmptyAt" using anindex returning bool
               if isfalse
                   invoke self "isAt" using anelement anindex
                                   returning bool
               end-if
           end-perform
           exit method.
       end method "findElement".

       end object.
       end class identitydictionary.
