Announcement

Collapse
No announcement yet.

Discussion for StringBag Pointer

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Discussion for StringBag Pointer

    This is for any discussion or bug submissions. Source code here.

    Uses dynamically allocated strings. As with other versions this version maintains stable index values (at least until you delete an entry), so can be used to map.

    My primary focus was being able to test existence as fast as possible. Find clocks in at almost 29million tests per second on the test data.

    Behind that secondary uses are mapping and IndexOf clocks in 23million checks per second.

    Next I wanted Add to be fairly snappy as well, it's a bit slower at 7.7million entries per second but seems acceptable. Since typical use would be populate and run repeated existence checks.

    RemoveAt is particularly snappy.
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream

  • #2
    Enlighten me, please, what is this used for?
    "Show me a young Conservative and I'll show you someone with no heart. Show me an old Liberal and I'll show you someone with no brains." ― Winston Churchill
    "Socialism is the philosophy of failure, the creed of ignorance and the gospel of envy." ― Winston Churchill

    Comment


    • #3
      Tends to have tons of uses, but a few might be:
      Testing for existence in a set like is this a keyword
      Counting words
      Find record by key
      Translating one word to another.
      Have I processed this item before?
      etc

      Basically places you might use a binary lookup or array scan.
      LarryC
      Website
      Sometimes life's a dream, sometimes it's a scream

      Comment


      • #4
        Here's some reference data:

        Code:
        Operation            Tix   Tix/Op        Ops/Sec
        Compare      106,639,077   106.64     30,117,648 
        Loop          19,376,109     1.94  1,666,666,667
        Compare shows how fast a simple compare is. Loop shows how fast an empty loop is. I'd guess the StringBag is currently running at about 1/2 to 1/4 the speed it could.

        Another way to think of a hashtable is: it's a bit like a magic trick. Imagine you had a pile of a million things. Imagine you could reach into that pile an pull a rabbit out of the pile 100% of the time as fast as the average person could pull one random item.
        LarryC
        Website
        Sometimes life's a dream, sometimes it's a scream

        Comment


        • #5
          for further speed you could implement a hash table lookup algorithm such as Murmur, FNV, Pearsons, etc etc
          -

          Comment


          • #6
            I think the next area for improvement might be the string compare. Hashes are running 31 clock cycles per hash. Compares are running 150. On the sample data. I'd like to see compare hit 40 cycles or less. Off to work on that
            LarryC
            Website
            Sometimes life's a dream, sometimes it's a scream

            Comment


            • #7
              Updated the code a bit. It's a bit faster. I'd be interested in any bugs that are found or suggestions for improvement.
              LarryC
              Website
              Sometimes life's a dream, sometimes it's a scream

              Comment


              • #8
                Added a fixed string stringbag version.

                Adding entries and clearing the bag is faster.
                Retrieving an item from the bag is slower but seems like an uncommon operation.

                The rest of the routines are about a wash. The fixed string version had some optimizations removed that I believe account for the other differences.
                LarryC
                Website
                Sometimes life's a dream, sometimes it's a scream

                Comment


                • #9
                  > think the next area for improvement might be the string compare.

                  1. This is for fixed strings but the idea is easily extensible
                  Code:
                  ' compare two varibles byte by byte for length iLen
                  ' returns:  -1   A1 is less than A2
                  '           +1   A1 is greater then A2
                  '            0   A1 = A2
                  MACRO FUNCTION m_CompareFixedStringAbsolute (a1, A2, iLen)
                  
                    MACROTEMP iChar, iRet, p1, p2
                    DIM iChar AS LONG, iRet AS LONG, p1 AS BYTE PTR, p2 AS BYTE PTR
                  
                    p1      = VARPTR(A1)
                    p2      = VARPTR(A2)
                    iRet    =  %FALSE       ' default = equal, we set when > or < condition actually occurs
                  
                    FOR ichar = 1& TO ilen
                      IF @p2 < @p1  THEN      ' this character is less, so string cannot be greater
                          iRet =  1&          ' a1 is greater than A2
                          EXIT FOR             ' with iRet = %FALSE
                      ELSEIF @p2 > @p1 THEN    ' as soon as any character in 2 is greater than corresponding char in one
                        iRet = -1&             ' A1 is less than A2
                        EXIT FOR
                      ELSE                    ' must be eqaul, so we have to keep on going.
                        INCR p1
                        INCR p2
                      END IF
                    NEXT
                    ' if no greater or less condition was found, must be equal which
                    ' means iRet was already set to correct result of zero.
                  END MACRO = iRet
                  2. Consider sorting the strings and using a binary search..
                  Binary Search of an array February 14 2000, July 15 2003


                  MCM

                  Comment


                  • #10
                    Thanks MCM, keep em coming.

                    1) The fixed string version does essentially that. The dynamic string version extends it a bit by comparing 4 bytes at a time. They're just using assembler to speed up the process. Turns out fixed strings and dynamic strings work identically other than getting that initial pointer.

                    2) Binary searches tend to be orders of magnitude slower. With hashtables you reach in the pile once an pull out what you want (see the reference to the magic trick ). With binary searches you have to look at the square root of entries in general, possibly a few less if you get lucky. Also with a hashtable in the event there's a collision, the loops to find your match or orders of magnitude quicker because you only rarely have to actually compare a string due to the hashcodes. The other cool thing about hashtables is there's no need to sort (not that you can't, you just don't need to). That lends a second cool feature in that the added indexes are stable so you can use it as an index directly into other data.
                    LarryC
                    Website
                    Sometimes life's a dream, sometimes it's a scream

                    Comment


                    • #11
                      Turns out fixed strings and dynamic strings work identically other than getting that initial pointer.
                      Um, not quite if you are coding using native PowerBASIC syntax.

                      In my mapping engine I needed to do "many" (can be literally millions although typically it's only thousands) of comparisons of fixed-string UDT members, in real time. It turns out that the code..
                      Code:
                        IF udt1.member  = udt2.member THEN 
                         ...
                      .. is implemented in PB by creating and destroying a couple of dynamic strings which are then compared using standard PB rtl functions. (I got this from pb support when I asked. I never found it in the help).

                      That's why I wrote the MACRO FUNCTIONs... to eliminate that create/destroy overhead.

                      In version two of the mapping engine I did the same thing you did, ensuring all my string keys were multiples of four bytes so I could compare in pieces as integers ("LONG PTR").

                      MCM

                      Comment


                      • #12
                        How does performance compare with Collections, using the key attribute to contain the string? ISTR that Collections use a hash table.

                        Comment


                        • #13
                          If you're asking about the speed difference between StringBag and iPowerCollection, it's a bit hard to compare. If you're collection is small <10,000 items the non-optimized StringBag is between 30 - 40 times faster. If you collection grows the difference grows, at 100,000 items it's maybe 450x faster or so. There's clearly some differences between the collections, but here's the tests I ran if you want to compare them or try something different.

                          PowerCollection.bas
                          Code:
                          #Compiler PBCC 6, PBWin 10
                          #Compile Exe
                          #Dim All
                          #Optimize Speed
                          #If %Def( %PB_CC32 )
                          #Console Off
                          #EndIf
                           
                          #Include "win32api.inc"
                           
                          %COUNT = 100000
                           
                          Function PBMain () As Long
                            ConInit
                            ConCls 9, 15
                            Local a As IPowerCollection
                            a = Class "PowerCollection"
                            Test a
                            ConWrite "Finished"
                            ConClose
                          End Function
                           
                          Sub Test( b As IPowerCollection )
                            Local i, c As Long
                            Local hWin As Dword
                            Local vr As Variant
                            Local ws As WString
                            Local qe, q1, q2, q3, q4, q5, q6, q7, q8, q9, q10, q11, q12, tot As Quad
                            Local s, e As Single
                            Local v(), u As WString
                            ReDim v(%COUNT)
                           
                            ConWriteln "Running test..."
                            ConWriteln "Formatting..."
                            Tix q1
                            For i=1 To %COUNT
                              v(i) = Format$(i)
                            Next
                            Tix End q1
                           
                            Tix tot
                            s = Timer
                           
                            ConWriteln "Adding..."
                            Tix q2
                            For i=1 To %COUNT
                              b.Add v(i), v(i)
                            Next
                            Tix End q2
                           
                            ConWriteln "Entry..."
                            Tix q3
                            For i=1 To %COUNT
                              b.Entry( i, ws, vr )
                              If ws<>v(i) Then ConWriteln Using$( "Item # is &", i, u )
                            Next
                            Tix End q3
                           
                            ' No equivalent
                            ConWriteln "IndexOf..."
                            Tix q4
                            For i=1 To %COUNT
                              If b.Contains( v(i) )<>i Then
                                ConWriteln Using$( "Contains & = #, not #,", v(i), b.Contains( v(i) ), i )
                              End If
                            Next
                            Tix End q4
                           
                            ConWriteln "Contains..."
                            Tix q5
                            For i=1 To %COUNT
                              If IsFalse( b.Contains( v(i) ) )  Then ConWriteln "Find missed '" + Format$(i) + "'"
                            Next
                            Tix End q5
                           
                            ConWriteln "Count..."
                            Tix q6
                            For i=0 To %COUNT-1
                              c = b.Count()
                            Next
                            Tix End q6
                           
                           
                            ConWriteln "Adding..."
                            Tix q7
                            For i=1 To %COUNT
                              b.Add( v(i), v(i) )
                            Next
                            Tix End q7
                           
                            ConWriteln "Clear..."
                            Tix q8
                            b.Clear()
                            Tix End q8
                           
                            ConWriteln "Adding..."
                            Tix q9
                            For i=1 To %COUNT
                              b.Add( v(i), v(i) )
                            Next
                            Tix End q9
                           
                            ConWriteln "Iterate...."
                            Tix q10
                            b.First()
                            While ObjResult=%S_Ok
                              b.Next()
                            Wend
                            Tix End q10
                           
                            ConWriteln "Remove..."
                            Tix q11
                            For i=1 To %COUNT
                              ws = v(i)
                              b.Remove( ws )
                            Next
                            Tix End q11
                           
                            ConWriteln "Clear..."
                            Tix q12
                            b.Clear()
                            Tix End q12
                           
                            Tix End tot
                           
                            e = Timer
                           
                            Local tixPerSec As Single
                            Local tests As Long
                            tests = 11
                            tixPerSec = (tot) / (e-s)
                            Open "PowerColl.txt" For Output As #1
                            Print #1,  "Finished";    $Tab; %COUNT; $Tab; "Tix/Op"; $Tab; "Ops/Sec"
                            Print #1,  "Format";      $Tab; q1;   $Tab; q1/%COUNT;  $Tab; tixPerSec/q1*%COUNT
                            Print #1,  "Add";         $Tab; q2;   $Tab; q2/%COUNT;  $Tab; tixPerSec/q2*%COUNT
                            Print #1,  "Entry";       $Tab; q3;   $Tab; q3/%COUNT;  $Tab; tixPerSec/q3*%COUNT
                            Print #1,  "IndexOf";     $Tab; q4;   $Tab; q4/%COUNT;  $Tab; tixPerSec/q4*%COUNT
                            Print #1,  "Contains";    $Tab; q5;   $Tab; q5/%COUNT;  $Tab; tixPerSec/q5*%COUNT
                            Print #1,  "Count";       $Tab; q6;   $Tab; q6/%COUNT;  $Tab; tixPerSec/q6*%COUNT
                            Print #1,  "Add";         $Tab; q7;   $Tab; q7/%COUNT;  $Tab; tixPerSec/q7*%COUNT
                            Print #1,  "Clear";       $Tab; q8;   $Tab; q8/%COUNT;  $Tab; tixPerSec/q8*%COUNT
                            Print #1,  "Add";         $Tab; q9;   $Tab; q9/%COUNT;  $Tab; tixPerSec/q9*%COUNT
                            Print #1,  "Iterate";     $Tab; q10;  $Tab;q10/%COUNT;  $Tab; tixPerSec/q10*%COUNT
                            Print #1,  "Remove";      $Tab; q11;  $Tab; q11/%COUNT; $Tab; tixPerSec/q11*%COUNT
                            Print #1,  "Clear";       $Tab; q12;  $Tab; q12/%COUNT; $Tab; tixPerSec/q12*%COUNT
                            Print #1,  "Total";       $Tab; tot
                            Print #1,  "Elapsed";     $Tab; e-s
                            Print #1,  "Tix/Sec";     $Tab; (tot) / (e-s)
                            Print #1,  "Tests";       $Tab; tests
                            Print #1,  "Ops/Sec";     $Tab; (%COUNT*tests) / (e-s)
                            Close #1
                          End Sub
                           
                           
                          '==============================================
                          ' Super simple console routines
                          '==============================================
                          Global constdout As Dword
                          Global constdin As Dword
                          Global conattached As Long
                           
                          Sub ConInit()
                            If AttachConsole( %ATTACH_PARENT_PROCESS ) = 0 Then
                              AllocConsole()
                            Else
                              conattached = 1
                            End If
                            ConStdOut = GetStdHandle(%STD_OUTPUT_HANDLE)
                            ConStdIn = GetStdHandle(%STD_INPUT_HANDLE)
                            If conattached Then ConWriteln ""
                          End Sub
                           
                          Sub ConClose()
                            Local e As INPUT_RECORD
                            Local r As Long
                           
                            If conattached Then
                              e.EventType = %KEY_EVENT
                              e.KeyEvent.bKeyDown = 1
                              e.KeyEvent.wRepeatCount = 1
                              e.KeyEvent.wVirtualKeyCode = %VK_RETURN
                              e.KeyEvent.wVirtualScanCode = VkKeyScan(%VK_RETURN)
                              e.KeyEvent.AsciiChar = Chr$(13)
                              WriteConsoleInput( ConStdIn, ByRef e, 1, r )
                           
                              e.KeyEvent.bKeyDown = 0
                              WriteConsoleInput( ConStdIn, ByRef e, 1, r )
                              FreeConsole
                            End If
                          End Sub
                           
                          Function ConGetch() As Byte
                            Local r As Long
                            Local buf As AsciiZ*2
                            While r=0
                              ReadConsole( ConStdIn, buf, 1, r, ByVal 0 )
                              If r=0 Then Sleep 50
                            Wend
                            Function = Asc( buf )
                          End Function
                           
                          Function ConLineInput() As String
                            Local ch As Byte
                            Local v As String
                            Do
                              ch = conGetch()
                              Select Case Const ch
                                Case 13: Exit Loop
                                Case 8: If v<>"" Then v=Left$( v, Len(v)-1 )
                                Case Else
                                  If ch>=32 And ch<128 Then v += Chr$( ch )
                              End Select
                            Loop
                            Function = v
                          End Function
                           
                          Sub ConWrite( msg As String )
                            Local w As Long
                            WriteConsole( ConStdOut, ByVal StrPtr( msg ), Len(msg ), w, 0 )
                          End Sub
                           
                          Sub ConWriteln( msg As String )
                            ConWrite( msg )
                            ConWrite( $CrLf )
                          End Sub
                           
                          Sub ConGetCell( r As Long, c As Long )
                            Local v As CONSOLE_SCREEN_BUFFER_INFO
                            GetConsoleScreenBufferInfo ConStdOut, v
                            c = v.dwCursorPosition.x
                            r = v.dwCursorPosition.y
                          End Sub
                           
                          Sub ConSetCell( ByVal r As Long, ByVal c As Long )
                            SetConsoleCursorPosition ConStdOut, Mak(Dword, c, r )
                          End Sub
                           
                          Sub ConColor( ByVal fg As Long, ByVal bg As Long )
                            Shift Left bg, 4
                            fg Or= bg
                            SetConsoleTextAttribute ConStdOut, fg
                          End Sub
                           
                          Function ConWidth() As Long
                              Local buf As CONSOLE_SCREEN_BUFFER_INFO
                              GetConsoleScreenBufferInfo ConStdOut, buf
                              Function = buf.dwSize.X
                          End Function
                           
                          Sub ConCls( ByVal fg As Long, ByVal bg As Long )
                              Local buf As CONSOLE_SCREEN_BUFFER_INFO
                              Local conSize, written As Dword
                              Local p As Dword
                           
                              GetConsoleScreenBufferInfo ConStdOut, buf
                              conSize = buf.dwSize.X * buf.dwSize.Y
                           
                              FillConsoleOutputCharacter ConStdOut, 32, conSize, p, written
                           
                              Shift Left bg, 4
                              fg Or= bg
                              SetConsoleTextAttribute ConStdOut, fg
                           
                              FillConsoleOutputAttribute ConStdOut, fg, conSize, p, written
                           
                              ConSetCell 0, 0
                          End Sub
                           
                          '==============================================

                          StringBagDynamic.inc
                          Code:
                          #Include This Once
                           
                          #Include Once "windows.inc"
                           
                          Type tStringEntry
                            hashcode_ As Long               ' Hashcode for entry (0=Deleted)
                            next_ As tStringEntry Ptr       ' next entries_
                            key_ As Long                    ' String (Stolen from PB)
                          End Type
                           
                          Type tStringBag
                            table_ As Long Ptr              ' Array of Pointers to entries_
                            entries_ As tStringEntry Ptr    ' Array of bagEntries
                            highwater_ As Long              ' # of items in entries_
                            tableCount_ As Long             ' total # of slots in table_
                            entryCount_ As Long             ' total # of slots in entries_
                            freeCount_ As Long              ' Shouldn't really count these...
                            free_ As Long                   ' first free entries_ offset (+1)
                            compare_ As Long                ' FastProc compare routine
                            hash_ As Long                   ' FastProc Hash routine
                           
                          End Type
                           
                          AsmData StringRndBlock
                          DD &hA39C, &h455F, &h780A, &h3CF8, &h2B21, &h6B59, &hD08E, &h786E, &h43A6, &hA7C5, &h348F, &h99C7, &h6BBF, &h10BE, &hE490, &hBD3A
                          DD &h30E5, &h2BC8, &h0710, &h19F6, &hB87A, &hCB09, &hEABB, &hFD04, &h161E, &hECC5, &h53D3, &hFC63, &hBB32, &h1919, &h40DE, &h7E5E
                          DD &h8BAC, &hF9FA, &hD292, &hF132, &h641B, &h296E, &h42FF, &h4EDF, &h1CFA, &h720A, &h17FC, &hC94B, &h573B, &hFDAC, &hFCD5, &hBA9F
                          DD &h9E0C, &h2E7B, &hEF34, &h35DB, &hA9ED, &h1E1E, &hAB4E, &hD3BC, &hD0F6, &hFF3A, &h834F, &h97D1, &hF063, &hDD2F, &h0E08, &h09D9
                          DD &h5B61, &h7614, &h58D8, &hDF61, &h9B1D, &h2AF1, &h88D9, &hD19C, &h0C0B, &h423C, &h174E, &h7B82, &hA475, &hF898, &h154A, &h5C2E
                          DD &h7046, &h1BCA, &h22A2, &h5972, &h8E16, &h2BFD, &h0415, &h5EBC, &hB976, &h3F38, &h04BB, &hF42F, &hAE7E, &h231E, &h8EAD, &hE9FA
                          DD &hF295, &h78E6, &hA6F4, &h73FD, &hCE81, &hC79A, &h38B5, &h519D, &h85B1, &hC095, &h5B9B, &hDDE5, &h16C7, &h3238, &h0185, &h23DE
                          DD &h116A, &h64ED, &hB771, &h5331, &h4D4B, &hDE5F, &h65AA, &h30FD, &h8E77, &hC6F8, &h3B2F, &h60F3, &h62DD, &h6D9D, &h3064, &hA2B9
                          DD &hC520, &hA5A7, &hCCFD, &h5F7E, &h509F, &hFB22, &h1D28, &h23DA, &h12C3, &hF94B, &h01FB, &hE1EA, &h4589, &hFF44, &h491F, &h17A9
                          DD &h7F51, &h5F1B, &h37BB, &h3592, &h23E6, &hC2FB, &h74A3, &hE175, &h22CF, &h14B2, &h7DC3, &hF197, &h4ED7, &h6365, &h14C7, &h3C0E
                          DD &hDAD8, &h8390, &h4F0D, &h965C, &hC7CD, &h6541, &h34CD, &hA14B, &h5018, &h5C96, &h1B88, &h3D0A, &h9C12, &hD875, &h27AF, &hC187
                          DD &h4BD1, &h438C, &hA196, &h570C, &hA23F, &h0B8A, &h0999, &h0B1D, &h5D59, &h0A9D, &h178E, &h7D92, &h87C4, &hCF2D, &h116C, &h41F1
                          DD &hCF97, &h7DD8, &h253A, &h5110, &h2E65, &h49AE, &hB23B, &h26E9, &hEE8B, &hBEAF, &hAD58, &h68BD, &h59BA, &h5A83, &h8CCF, &h2F6E
                          DD &h9CC5, &h2F79, &h671B, &h5217, &hACAC, &h8DC4, &h3124, &h4CEE, &h38EA, &hEEF2, &h47A9, &hA05C, &hF6FD, &h9FAE, &hAFEC, &hC45A
                          DD &hD335, &hE3B8, &hBB9D, &h0C10, &hD2BF, &h9022, &hFC09, &h15AA, &hB2F1, &h57CD, &hB084, &hA27C, &h91D9, &h4625, &h1C15, &hF357
                          DD &h2C02, &h241A, &h6E62, &h052B, &h7B87, &hC360, &h2BDC, &h49DE, &hC45C, &h6BE8, &h412C, &hB96D, &h59D9, &hE79F, &h2DDE, &h5742
                          End AsmData
                           
                          Macro StringBag_HashCode(hc,value)
                            MacroTemp i
                            Local i As Long
                            hc =  2477664281
                            For i=1 To Len(value)
                              hc *= 1647726497
                              hc += Asc( value, i )
                            Next
                            hc And= &h7fffffff
                          End Macro
                           
                           
                          'Macro StringBag_HashCode(hc,value)
                          '  macrotemp p, i
                          '  local p as dword ptr
                          '  local i as long
                          '  p = codeptr( StringRndBlock )
                          '  hc =  2477664281
                          '  for i=1 to len(value)
                          '    hc = hc xor @p[ hc And &hff ] + asc( value, i )
                          '  Next
                          '  hc and= &h7fffffff
                          '  Prefix "!"
                          '  mov eax, hc
                          '  End Prefix
                          'End Macro
                           
                          ' Modified Pearson, sample from Wayne Diamond (http://web.archive.org/web/200803281...m/pbcrypto.php)
                          'Macro StringBag_HashCode(hc,value)
                          '  MacroTemp StrHash_Loop
                          '  Prefix "!"
                          '  mov   esi, value
                          '  mov   eax, 0                  ; set to 0 for FNV-0, or 2166136261 for FNV-1
                          '  mov   esi, [esi]              ; esi = StrPtr( value )
                          '  ;mov   edi, &h01000193         ; FNV_32_PRIME = 16777619
                          '  mov   edi, 1647726497         ; FNV_32_PRIME = 16777619
                          '  mov   ecx, [esi-4]            ; edi = StrLen(value)
                          '  xor   ebx, ebx
                          'StrHash_Loop:
                          '  movzx ebx,  byte ptr [esi]     ; bl = byte from esi
                          '  inc   esi
                          '  mul   edi                     ; eax = eax * FNV_32_PRIME
                          '  xor   eax, ebx                ; al = al xor bl
                          '  sub   ecx, 1
                          '  jnz   StrHash_Loop            ; if ecx is 0, jmp to NextByte
                          'StrHash_Loop4:
                          '  and   eax, &h7fffffff
                          '  mov   hc, eax
                          '  End Prefix
                          'End Macro
                           
                          ' Modified Pearson, sample from Wayne Diamond (http://web.archive.org/web/200803281...m/pbcrypto.php)
                          'Macro StringBag_HashCode(hc,value)
                          '  MacroTemp StrHash_Loop
                          '  Prefix "!"
                          '  mov   esi, value
                          '  mov   eax, 2166136261         ; set to 0 for FNV-0, or 2166136261 for FNV-1
                          '  mov   esi, [esi]              ; esi = StrPtr( value )
                          '  mov   edi, &h01000193         ; FNV_32_PRIME = 16777619
                          '  mov   ecx, [esi-4]            ; edi = StrLen(value)
                          '  shr   ecx, 2                  ; DWORDS
                          '  jz    StrHash_Loop2
                          'StrHash_Loop:
                          '  mov   ebx,  [esi]             ; bl = byte from esi
                          '  add   esi, 4                  ; next dword
                          '  mul   edi                     ; eax = eax * FNV_32_PRIME
                          '  xor   eax, ebx                ; al = al xor bl
                          '  sub   ecx, 1
                          '  jnz   StrHash_Loop            ; if ecx is 0, jmp to NextByte
                          'StrHash_Loop2:                  ; tail bytes
                          '  mov   ecx, value
                          '  mov   ecx, [ecx]              ; ecx = StrPtr( value )
                          '  mov   ecx, [ecx-4]            ; ecx = Len( value )
                          '  and   ecx, 3
                          '  jz    StrHash_Loop4
                          'StrHash_Loop3:
                          '  movzx ebx, byte ptr [esi+0]   ; bl = byte from esi
                          '  mul   edi                     ; eax = eax * FNV_32_PRIME
                          '  xor   eax, ebx                ; al = al xor bl
                          '  sub   ecx, 1
                          '  jz   StrHash_Loop4            ; if ecx is 0, jmp to NextByte
                          '  movzx ebx, byte ptr [esi+1]   ; bl = byte from esi
                          '  mul   edi                     ; eax = eax * FNV_32_PRIME
                          '  xor   eax, ebx                ; al = al xor bl
                          '  sub   ecx, 1
                          '  jz   StrHash_Loop4            ; if ecx is 0, jmp to NextByte
                          '  movzx ebx, byte ptr [esi+2]   ; bl = byte from esi
                          '  mul   edi                     ; eax = eax * FNV_32_PRIME
                          '  xor   eax, ebx                ; al = al xor bl
                          'StrHash_Loop4:
                          '  and   eax, &h7fffffff
                          '  mov   hc, eax
                          '  End Prefix
                          'End Macro
                           
                          'Macro StringBag_HashCode(hc,value)
                          '  MacroTemp StrHash_Loop, StrHash_Remainder, StrHash_Loop2, StrHash_End
                          '  Prefix "!"
                          '  mov   esi, value
                          '  mov   eax, 1647726497         ; eax = 1
                          '  mov   esi, [esi]              ; esi = StrPtr( value )
                          '  mov   edi, [esi-4]            ; edi = StrLen(value)
                          '  shr   edi, 2                  ; len( value ) / 4
                          '  jz    StrHash_Remainder       ; if edi=0 No full dwords (<4 bytes)
                          '  align 4
                          'StrHash_Loop:
                          '  mov   ebx, [esi]              ; Load word
                          '  add   esi, 4                  ; esi += 4
                          '  mov   ecx, eax
                          '  rol   eax, 7
                          '  xor   eax, ecx
                          '  add   eax, ebx                ; eax += @pValue[ i ]
                          '  sub   edi, 1
                          '  jnz   StrHash_Loop
                          'StrHash_Remainder:
                          '  mov   edi, value
                          '  mov   edi, [edi]              ; edi = StrPtr( value )
                          '  mov   edi, [edi-4]            ; edi = Len( value )
                          '  and   edi, 3                  ; StrLen( value ) Mod 4
                          '  jz    StrHash_End             ; No remainder!
                          'StrHash_Loop2:
                          '  movzx ebx, byte ptr [esi]
                          '  mov   ecx, eax
                          '  rol   eax, 7
                          '  xor   eax, ecx
                          '  add   eax, ebx                ; eax += @pValue[ i ]
                          '  sub   edi, 1
                          '  jz   StrHash_End
                          '  movzx ebx, byte ptr [esi+1]
                          '  mov   ecx, eax
                          '  rol   eax, 7
                          '  xor   eax, ecx
                          '  add   eax, ebx                ; eax += @pValue[ i ]
                          '  sub   edi, 1
                          '  jz   StrHash_End
                          '  movzx ebx, byte ptr [esi+2]
                          '  mov   ecx, eax
                          '  rol   eax, 7
                          '  xor   eax, ecx
                          '  add   eax, ebx                ; eax += @pValue[ i ]
                          'StrHash_End:
                          '  and   eax, &H7fffffff         ; eax = Abs( eax )
                          '  mov   hc, eax                 ; hc = hash
                          '  End Prefix
                          'End Macro
                           
                          Sub StringBag_Alloc( obj As Dword )
                          #Register None
                            Static heap As Long
                            If IsFalse(heap) Then heap = GetProcessHeap()
                            obj = HeapAlloc( heap, %HEAP_ZERO_MEMORY, SizeOf( tStringBag ) )
                            StringBag_Init ByVal obj
                          End Sub
                           
                          Sub StringBag_Free( obj As Dword )
                          #Register None
                            Local o As tStringBag Ptr
                            Static heap As Long
                           
                            If IsFalse(heap) Then heap = GetProcessHeap()
                            o = obj
                            StringBag_Release @o
                            If obj Then HeapFree heap, 0, obj
                            obj = 0
                          End Sub
                           
                          Sub StringBag_Init( obj As tStringBag, Optional ByVal requestedSize As Long )
                          #Register None
                            If obj.entries_ Then StringBag_Release obj
                            StringBag_Expand obj, requestedSize
                          End Sub
                           
                          Sub StringBag_Expand( obj As tStringBag, Optional ByVal requestedSize As Long )
                          #Register None
                            Local i As Long
                            Local e As tStringEntry Ptr
                            Local index As Long
                            Local entryCount, tableCount, memSize, entrySize, tableSize As Long
                            Static heap As Long
                           
                            If requestedSize=0 Then requestedSize=obj.tableCount_
                            If IsFalse(heap) Then heap = GetProcessHeap()
                            tableCount = BagGetNextCollectionSize( requestedSize )
                            entryCount = CLng( tableCount * .75! )
                            'Use the following if you make small increases to the tableCount
                            'If entryCount<=obj.highwater_ Then entryCount = obj.highwater_+1
                            tableSize = tableCount * SizeOf( entrySize )
                            entrySize = entryCount * SizeOf( tStringEntry )
                            memSize = tableSize + entrySize
                           
                            ' Single allocation: Layout Entries followed by hashtable
                            ' Reason: Existing entries need to be retained while new values and the hashtable need to be zero'ed.
                            If obj.entries_ Then
                              obj.entries_ = HeapReAlloc( heap, 0, obj.entries_, memSize )
                              If IsFalse( obj.entries_ ) Then
                                ? "Failed allocation"
                                End
                              End If
                              ' Zero bag entries after active ones and all of hashtable
                              Local sz, ofs As Long
                              sz = (entryCount-obj.highwater_) * SizeOf( tStringEntry )
                              ofs = obj.highwater_ * SizeOf( tStringEntry )
                              If sz<0 Then
                                ofs = entrySize
                                sz = 0
                              End If
                           
                              Memory Fill obj.entries_+ofs, tableSize+sz, Byte 0
                            Else
                              obj.entries_ = HeapAlloc( heap, %HEAP_ZERO_MEMORY, memSize )
                              If IsFalse( obj.entries_ ) Then
                                ? "Failed allocation"
                                End
                              End If
                            End If
                            obj.table_ = obj.entries_ + entrySize
                           
                            ' Redistribute hashes
                            e = obj.entries_
                            For i = 0 To obj.highwater_ - 1
                              If @e.hashCode_ Then
                                index = @e.hashCode_ Mod tableCount
                                @e.next_ = obj.@table_[ index ]
                                obj.@table_[ index ] = e
                              End If
                              e += SizeOf( tStringEntry )
                            Next
                            obj.tableCount_ = tableCount
                            obj.entryCount_ = entryCount
                          End Sub
                           
                          Function StringBag_Contains ( obj As tStringBag, value As String ) As Long
                          #Register None
                            Local hc As Long
                            Local e As tStringEntry Ptr
                            Local sp As String Ptr
                           
                             StringBag_HashCode(hc,value)
                           
                             If IsFalse( obj.table_ ) Then Exit Function
                           
                             e = obj.@table_[ hc Mod obj.tableCount_ ]
                             While e
                               If @e.hashCode_ = hc Then
                                 sp = VarPtr( @e.key_ )
                                 If @sp = value Then
                                   Function = -1
                                   Exit Function
                                 End If
                               End If
                               e = @e.next_
                             Wend
                          End Function
                           
                          Function StringBag_Add( obj As tStringBag, value As String ) As Long
                          #Register None
                            Local index, hc As Long
                            Local e As tStringEntry Ptr
                            Local sp As String Ptr
                           
                           
                            StringBag_HashCode(hc,value)
                           
                            If obj.table_ Then
                              index = hc Mod obj.tableCount_
                              e = obj.@table_[ index ]
                              While e
                                If @e.hashCode_ = hc Then
                                  sp = VarPtr( @e.key_ )
                                  If @sp = value Then
                                    Function = 0
                                    Exit Function
                                  End If
                                End If
                                e = @e.next_
                              Wend
                            End If
                           
                            If obj.free_ Then
                              ' Use freed items first
                              e = obj.free_
                              obj.free_ = @e.next_
                              Decr obj.freeCount_
                            Else
                              If obj.highwater_ >= obj.entryCount_ Then
                                StringBag_Expand obj
                                index = hc Mod obj.tableCount_
                              End If
                              If IsFalse( obj.table_ ) Or IsFalse( obj.entries_ ) Then
                                ? "Alloc failed"
                                End
                              End If
                              e = VarPtr( obj.@entries_[ obj.highwater_ ] )
                              Incr obj.highwater_
                            End If
                           
                            'StringEntry_Init
                            sp = VarPtr( @e.key_ )
                            @sp = value
                            @e.hashCode_ = hc
                           
                            @e.next_ = obj.@table_[ index ]   ' 1-n, or 0 if no next
                            obj.@table_[ index ] = e
                           
                            Function = -1
                          End Function
                           
                          ' Empty the bag
                          Sub StringBag_Release( obj As tStringBag, Optional ByVal requestedSize As Long )
                          #Register None
                            Register i As Long
                            Static heap As Long
                            Local sp As String Ptr
                           
                            If obj.entries_ Then
                              If IsFalse(heap) Then heap = GetProcessHeap()
                              For i=0 To obj.highwater_- 1
                                sp = VarPtr( obj.@entries_[i].key_ )
                                @sp = ""
                              Next
                              HeapFree heap, 0, obj.entries_
                              Reset obj
                            End If
                            If requestedSize>0 Then
                              StringBag_Expand obj, requestedSize
                            End If
                          End Sub
                           
                          Function StringBag_IndexOf( obj As tStringBag, value As String ) As Long
                          #Register None
                            Local hc As Long
                            Local e As tStringEntry Ptr
                            Local sp As String Ptr
                           
                            If obj.table_  Then
                              StringBag_HashCode(hc,value)
                              e = obj.@table_[ hc Mod obj.tableCount_ ]
                              While e
                                If @e.hashCode_ = hc Then
                                  sp = VarPtr( @e.key_ )
                                  If @sp = value Then
                                    Function = (e-obj.entries_) \ SizeOf( tStringEntry )
                                    Exit Function
                                  End If
                                End If
                                e = @e.next_
                              Wend
                            End If
                            Function = -1
                          End Function
                           
                          ' Number of items in the bag
                          Function StringBag_Count( obj As tStringBag ) As Long
                            Function = obj.highwater_ - obj.freeCount_
                          End Function
                           
                          ' Max Index # can go
                          Function StringBag_HighWater( obj As tStringBag ) As Long
                            Function = obj.highwater_
                          End Function
                           
                          Function StringBag_Remove ( obj As tStringBag, value As String ) As Long
                            Function = StringBag_RemoveAt( obj, StringBag_IndexOf( obj, value ) )
                          End Function
                           
                          Function StringBag_RemoveAt ( obj As tStringBag, ByVal i As Long ) As Long
                          #Register None
                            Register index As Long
                            Register j As Long
                            Local e, f As tStringEntry Ptr
                           
                           
                            If i<0 Or i>=obj.highwater_ Then  Exit Function   ' Out of bounds
                            e = VarPtr( obj.@entries_[i] )
                            If IsFalse( @e.hashCode_ ) Then Exit Function ' Already deleted
                           
                            index = @e.hashCode_ Mod obj.tableCount_
                           
                            If obj.@table_[ index ] = e Then
                              obj.@table_[ index ] = @e.next_: ' First item in list
                            Else
                              ' Have prior entry's next point past the entry to remove
                              f = obj.@table_[ index ]
                              Do While f
                                If @f.next_ = e Then
                                  @f.next_ = @e.next_
                                  Exit Loop
                                End If
                                f = @f.next_
                              Loop
                            End If
                            ' Reuse the free entries (Leaving string alone, we'll free it when reusing or clearing)
                            @e.hashCode_ = 0
                            @e.next_ = obj.free_
                            obj.free_ = e
                            Incr obj.freeCount_
                            Function =-1
                          End Function
                           
                          Sub StringBag_Clear( obj As tStringBag )
                            Local i As Long
                            Local e, n As tStringEntry Ptr
                           
                            If IsFalse( obj.highwater_ ) Then Exit Sub
                            e = obj.entries_
                            obj.free_ = e
                            For i=0 To obj.highwater_-2
                              @e.next_ = e + SizeOf( tStringEntry )
                              @e.hashCode_ = 0
                              e = @e.next_
                            Next
                            @e.next_ = 0
                            @e.hashCode_ = 0
                            obj.freeCount_ = obj.highWater_
                            If obj.tableCount_ Then Memory Fill obj.table_, obj.tableCount_*SizeOf(i), Byte 0
                          End Sub
                           
                          Sub StringBag_RemoveAll( obj As tStringBag )
                            Local i As Long
                            Local e, n As tStringEntry Ptr
                           
                            If IsFalse( obj.highwater_ ) Then Exit Sub
                            e = obj.entries_
                            obj.free_ = e
                            For i=0 To obj.highwater_-2
                              @e.next_ = e + SizeOf( tStringEntry )
                              @e.hashCode_ = 0
                              e = @e.next_
                            Next
                            @e.next_ = 0
                            @e.hashCode_ = 0
                            obj.freeCount_ = obj.highWater_
                            If obj.tableCount_ Then Memory Fill obj.table_, obj.tableCount_*SizeOf(i), Byte 0
                          End Sub
                           ' Get an item by index, returns empty string if out of bounds
                          Sub StringBag_Item( obj As tStringBag, ByVal index As Long, v As String )
                            Local sp As String Ptr
                            If index>=0 And index<obj.highwater_ And obj.@entries_[ index ].hashCode_ Then
                              sp = VarPtr( obj.@entries_[ index ].key_ )
                              v = @sp
                            Else
                              v = ""
                            End If
                          End Sub
                           
                          Function BagGetNextCollectionSize( ByVal tableCount As Long ) Common As Long
                            Static vPrimes() As Long
                            Static vInit As Long
                            Local i As Long
                           
                            If Not vInit Then
                              ReDim vPrimes(25)
                              Array Assign vPrimes() = _
                                      53, 97, 193, 389, 769, 1543, 3079, 6151, 12289 _
                                      , 24593, 49157, 98317, 196613, 393241, 786433 _
                                      , 1572869, 3145739, 6291469, 12582917, 25165843 _
                                      , 50331653, 100663319, 201326611, 402653189 _
                                      , 805306457, 1610612741
                              vInit = -1
                            End If
                           
                            Incr tableCount
                            For i=0 To 24
                              If vPrimes(i)>=tableCount Then
                                Function = vPrimes(i)
                                Exit Function
                              End If
                            Next
                           
                            Function = vPrimes(25)
                          End Function
                          TestCmpPowCol.bas
                          Code:
                          #Compiler PBCC 6, PBWin 10
                          #Compile Exe
                          #Dim All
                          #Optimize Speed
                          #If %Def( %PB_CC32 )
                          #Console Off
                          #EndIf
                           
                          #Include "StringBagDynamic.inc"
                           
                          %COUNT = 100000
                          ' Comment out the line below to use a local (stack based) stringbag variable
                          ' With it uncommented, it will use a dynamically allocated stringbag
                          %DYNAMIC = 1
                           
                          Function PBMain () As Long
                            ConInit
                            ConCls 9, 15
                          #If %Def( %DYNAMIC )
                            Local a As tStringBag Ptr
                            StringBag_Alloc a
                            Test @a
                            StringBag_Free a
                          #Else
                            Local a As tStringBag
                            Test a
                          #EndIf
                            ConWrite "Finished"
                            ConClose
                          End Function
                           
                          Sub Test( b As tStringBag )
                            Local i, c As Long
                            Local hWin As Dword
                            Local qe, q1, q2, q3, q4, q5, q6, q7, q8, q9, q10, q11, q12, tot As Quad
                            Local s, e As Single
                            Local v(), u As String
                            ReDim v(%COUNT)
                           
                            ConWrite "Running "
                          #If %Def( %DYNAMIC )
                            ConWrite "dynamic "
                          #Else
                            ConWrite "local "
                          #EndIf
                            ConWriteln "test..."
                            ConWriteln "Formatting..."
                            Tix q1
                            For i=1 To %COUNT
                              v(i) = Format$(i)
                            Next
                            Tix End q1
                           
                            Tix tot
                            s = Timer
                           
                            ConWriteln "Initing..."
                            StringBag_Init b, %COUNT
                           
                            ConWriteln "Adding..."
                            Tix q2
                            For i=1 To %COUNT
                              StringBag_Add b, v(i)
                            Next
                            Tix End q2
                           
                            ConWriteln "Entry..."
                            Tix q3
                            For i=0 To StringBag_Count(b)-1
                              StringBag_Item( b, i, u )
                              If u<>v(i+1) Then ConWriteln Using$( "Item # is &", i, u )
                            Next
                            Tix End q3
                           
                            ConWriteln "IndexOf..."
                            Tix q4
                            For i=1 To %COUNT
                              If StringBag_IndexOf( b, v(i) )<>i-1 Then
                                ConWriteln Using$( "IndexOf & = #, not #,", v(i), StringBag_IndexOf( b, v(i) ), i-1 )
                              End If
                            Next
                            Tix End q4
                           
                            ConWriteln "Contains..."
                            Tix q5
                            For i=1 To %COUNT
                              If IsFalse( StringBag_Contains( b, v(i) ) ) Then ConWriteln "Find missed '" + Format$(i) + "'"
                            Next
                            Tix End q5
                           
                            ConWriteln "Count..."
                            Tix q6
                            For i=0 To %COUNT-1
                              c = StringBag_Count( b )
                            Next
                            Tix End q6
                           
                           
                            ConWriteln "Adding..."
                            Tix q7
                            For i=1 To %COUNT
                              StringBag_Add b, v(i)
                            Next
                            Tix End q7
                           
                            ConWriteln "RemoveAll..."
                            Tix q8
                            StringBag_RemoveAll b
                            Tix End q8
                           
                            ConWriteln "Adding..."
                            Tix q9
                            For i=1 To %COUNT
                              StringBag_Add b, v(i)
                            Next
                            Tix End q9
                           
                            ConWriteln "Iterate..."
                            Tix q10
                            For i = 1 To %COUNT
                              StringBag_Item b, i, u
                            Next
                            Tix End q10
                           
                           
                            ConWriteln "Remove..."
                            Tix q11
                            For i=0 To %COUNT-1
                              StringBag_Remove( b, v(i+1) )
                            Next
                            Tix End q11
                           
                            ConWriteln "Clear..."
                            Tix q12
                            StringBag_Release b
                            Tix End q12
                           
                            Tix End tot
                           
                            e = Timer
                            Local tixPerSec As Single
                            Local tests As Long
                            tests = 11
                            tixPerSec = (tot) / (e-s)
                            Open "Time.txt" For Output As #1
                            Print #1,  "Finished";    $Tab; %COUNT; $Tab; "Tix/Op"; $Tab; "Ops/Sec"
                            Print #1,  "Format";      $Tab; q1;   $Tab; q1/%COUNT;  $Tab; tixPerSec/q1*%COUNT
                            Print #1,  "Add";         $Tab; q2;   $Tab; q2/%COUNT;  $Tab; tixPerSec/q2*%COUNT
                            Print #1,  "Entry";       $Tab; q3;   $Tab; q3/%COUNT;  $Tab; tixPerSec/q3*%COUNT
                            Print #1,  "IndexOf";     $Tab; q4;   $Tab; q4/%COUNT;  $Tab; tixPerSec/q4*%COUNT
                            Print #1,  "Contains";    $Tab; q5;   $Tab; q5/%COUNT;  $Tab; tixPerSec/q5*%COUNT
                            Print #1,  "Count";       $Tab; q6;   $Tab; q6/%COUNT;  $Tab; tixPerSec/q6*%COUNT
                            Print #1,  "Add";         $Tab; q7;   $Tab; q7/%COUNT;  $Tab; tixPerSec/q7*%COUNT
                            Print #1,  "Clear";       $Tab; q8;   $Tab; q8/%COUNT;  $Tab; tixPerSec/q8*%COUNT
                            Print #1,  "Add";         $Tab; q9;   $Tab; q9/%COUNT;  $Tab; tixPerSec/q9*%COUNT
                            Print #1,  "Iterate";     $Tab; q10;  $Tab;q10/%COUNT;  $Tab; tixPerSec/q10*%COUNT
                            Print #1,  "Remove";      $Tab; q11;  $Tab; q11/%COUNT; $Tab; tixPerSec/q11*%COUNT
                            Print #1,  "Clear";       $Tab; q12;  $Tab; q12/%COUNT; $Tab; tixPerSec/q12*%COUNT
                            Print #1,  "Total";       $Tab; tot
                            Print #1,  "Elapsed";     $Tab; e-s
                            Print #1,  "Tix/Sec";     $Tab; (tot) / (e-s)
                            Print #1,  "Tests";       $Tab; tests
                            Print #1,  "Ops/Sec";     $Tab; (%COUNT*tests) / (e-s)
                            Close #1
                          End Sub
                           
                           
                          '==============================================
                          ' Super simple console routines
                          '==============================================
                          Global constdout As Dword
                          Global constdin As Dword
                          Global conattached As Long
                           
                          Sub ConInit()
                            If AttachConsole( %ATTACH_PARENT_PROCESS ) = 0 Then
                              AllocConsole()
                            Else
                              conattached = 1
                            End If
                            ConStdOut = GetStdHandle(%STD_OUTPUT_HANDLE)
                            ConStdIn = GetStdHandle(%STD_INPUT_HANDLE)
                            If conattached Then ConWriteln ""
                          End Sub
                           
                          Sub ConClose()
                            Local e As INPUT_RECORD
                            Local r As Long
                           
                            If conattached Then
                              e.EventType = %KEY_EVENT
                              e.KeyEvent.bKeyDown = 1
                              e.KeyEvent.wRepeatCount = 1
                              e.KeyEvent.wVirtualKeyCode = %VK_RETURN
                              e.KeyEvent.wVirtualScanCode = VkKeyScan(%VK_RETURN)
                              e.KeyEvent.AsciiChar = Chr$(13)
                              WriteConsoleInput( ConStdIn, ByRef e, 1, r )
                           
                              e.KeyEvent.bKeyDown = 0
                              WriteConsoleInput( ConStdIn, ByRef e, 1, r )
                              FreeConsole
                            End If
                          End Sub
                           
                          Function ConGetch() As Byte
                            Local r As Long
                            Local buf As AsciiZ*2
                            While r=0
                              ReadConsole( ConStdIn, buf, 1, r, ByVal 0 )
                              If r=0 Then Sleep 50
                            Wend
                            Function = Asc( buf )
                          End Function
                           
                          Function ConLineInput() As String
                            Local ch As Byte
                            Local v As String
                            Do
                              ch = conGetch()
                              Select Case Const ch
                                Case 13: Exit Loop
                                Case 8: If v<>"" Then v=Left$( v, Len(v)-1 )
                                Case Else
                                  If ch>=32 And ch<128 Then v += Chr$( ch )
                              End Select
                            Loop
                            Function = v
                          End Function
                           
                          Sub ConWrite( msg As String )
                            Local w As Long
                            WriteConsole( ConStdOut, ByVal StrPtr( msg ), Len(msg ), w, 0 )
                          End Sub
                           
                          Sub ConWriteln( msg As String )
                            ConWrite( msg )
                            ConWrite( $CrLf )
                          End Sub
                           
                          Sub ConGetCell( r As Long, c As Long )
                            Local v As CONSOLE_SCREEN_BUFFER_INFO
                            GetConsoleScreenBufferInfo ConStdOut, v
                            c = v.dwCursorPosition.x
                            r = v.dwCursorPosition.y
                          End Sub
                           
                          Sub ConSetCell( ByVal r As Long, ByVal c As Long )
                            SetConsoleCursorPosition ConStdOut, Mak(Dword, c, r )
                          End Sub
                           
                          Sub ConColor( ByVal fg As Long, ByVal bg As Long )
                            Shift Left bg, 4
                            fg Or= bg
                            SetConsoleTextAttribute ConStdOut, fg
                          End Sub
                           
                          Function ConWidth() As Long
                              Local buf As CONSOLE_SCREEN_BUFFER_INFO
                              GetConsoleScreenBufferInfo ConStdOut, buf
                              Function = buf.dwSize.X
                          End Function
                           
                          Sub ConCls( ByVal fg As Long, ByVal bg As Long )
                              Local buf As CONSOLE_SCREEN_BUFFER_INFO
                              Local conSize, written As Dword
                              Local p As Dword
                           
                              GetConsoleScreenBufferInfo ConStdOut, buf
                              conSize = buf.dwSize.X * buf.dwSize.Y
                           
                              FillConsoleOutputCharacter ConStdOut, 32, conSize, p, written
                           
                              Shift Left bg, 4
                              fg Or= bg
                              SetConsoleTextAttribute ConStdOut, fg
                           
                              FillConsoleOutputAttribute ConStdOut, fg, conSize, p, written
                           
                              ConSetCell 0, 0
                          End Sub
                           
                          '==============================================
                          Last edited by Larry Charlton; 4 Mar 2015, 08:03 PM.
                          LarryC
                          Website
                          Sometimes life's a dream, sometimes it's a scream

                          Comment


                          • #14
                            Looks as if you are halfway towards a faster Collection class!

                            Comment


                            • #15
                              You can do collections as is. Here's a small sample, your collection can be any type you can stick in an array. this works because the indexes of items are stable, at least until you remove them. Removing an item won't affect the stability of the other items.

                              Collection.bas
                              Code:
                              #Compiler PBCC 6, PBWin 10
                              #Compile Exe
                              #Dim All
                              #Optimize Speed
                              #If %Def( %PB_CC32 )
                              #Console Off
                              #EndIf
                               
                              #Include "StringBagDynamic.inc"
                               
                              %COUNT = 1000
                              Function PBMain () As Long
                                Local i As Long
                                Local v As String
                                ConInit
                                ConCls 9, 15
                               
                                Randomize
                               
                                For i=1 To %COUNT
                                  MapAdd Format$(i), "My test value is " + Format$(i+1000)
                                Next
                               
                                Local msg As String
                                For i = 1 To 20
                                  v = Format$( Rnd(1,%COUNT) )
                                  msg += v + "=" + MapItem(v) + $CrLf
                                Next
                                ? msg
                                ConWrite "Finished"
                                ConClose
                              End Function
                               
                              Global values() As String
                              Global bag As tStringBag
                               
                              Sub MapAdd( key As String, value As String )
                                Local index As Long
                                StringBag_Add bag, key
                                index = StringBag_IndexOf( bag, key )
                                If bag.entryCount_ > UBound(values())+1 Then
                                  ReDim Preserve values( bag.entryCount_-1 )
                                End If
                                values( index ) = value
                              End Sub
                               
                              Function MapItem( key As String ) As String
                                Local index As Long
                                index = StringBag_IndexOf( bag, key )
                                If index>-1 Then Function = values(index)
                              End Function
                               
                              '==============================================
                              ' Super simple console routines
                              '==============================================
                              Global constdout As Dword
                              Global constdin As Dword
                              Global conattached As Long
                               
                              Sub ConInit()
                                If AttachConsole( %ATTACH_PARENT_PROCESS ) = 0 Then
                                  AllocConsole()
                                Else
                                  conattached = 1
                                End If
                                ConStdOut = GetStdHandle(%STD_OUTPUT_HANDLE)
                                ConStdIn = GetStdHandle(%STD_INPUT_HANDLE)
                                If conattached Then ConWriteln ""
                              End Sub
                               
                              Sub ConClose()
                                Local e As INPUT_RECORD
                                Local r As Long
                               
                                If conattached Then
                                  e.EventType = %KEY_EVENT
                                  e.KeyEvent.bKeyDown = 1
                                  e.KeyEvent.wRepeatCount = 1
                                  e.KeyEvent.wVirtualKeyCode = %VK_RETURN
                                  e.KeyEvent.wVirtualScanCode = VkKeyScan(%VK_RETURN)
                                  e.KeyEvent.AsciiChar = Chr$(13)
                                  WriteConsoleInput( ConStdIn, ByRef e, 1, r )
                               
                                  e.KeyEvent.bKeyDown = 0
                                  WriteConsoleInput( ConStdIn, ByRef e, 1, r )
                                  FreeConsole
                                End If
                              End Sub
                               
                              Function ConGetch() As Byte
                                Local r As Long
                                Local buf As AsciiZ*2
                                While r=0
                                  ReadConsole( ConStdIn, buf, 1, r, ByVal 0 )
                                  If r=0 Then Sleep 50
                                Wend
                                Function = Asc( buf )
                              End Function
                               
                              Function ConLineInput() As String
                                Local ch As Byte
                                Local v As String
                                Do
                                  ch = conGetch()
                                  Select Case Const ch
                                    Case 13: Exit Loop
                                    Case 8: If v<>"" Then v=Left$( v, Len(v)-1 )
                                    Case Else
                                      If ch>=32 And ch<128 Then v += Chr$( ch )
                                  End Select
                                Loop
                                Function = v
                              End Function
                               
                              Sub ConWrite( msg As String )
                                Local w As Long
                                WriteConsole( ConStdOut, ByVal StrPtr( msg ), Len(msg ), w, 0 )
                              End Sub
                               
                              Sub ConWriteln( msg As String )
                                ConWrite( msg )
                                ConWrite( $CrLf )
                              End Sub
                               
                              Sub ConGetCell( r As Long, c As Long )
                                Local v As CONSOLE_SCREEN_BUFFER_INFO
                                GetConsoleScreenBufferInfo ConStdOut, v
                                c = v.dwCursorPosition.x
                                r = v.dwCursorPosition.y
                              End Sub
                               
                              Sub ConSetCell( ByVal r As Long, ByVal c As Long )
                                SetConsoleCursorPosition ConStdOut, Mak(Dword, c, r )
                              End Sub
                               
                              Sub ConColor( ByVal fg As Long, ByVal bg As Long )
                                Shift Left bg, 4
                                fg Or= bg
                                SetConsoleTextAttribute ConStdOut, fg
                              End Sub
                               
                              Function ConWidth() As Long
                                  Local buf As CONSOLE_SCREEN_BUFFER_INFO
                                  GetConsoleScreenBufferInfo ConStdOut, buf
                                  Function = buf.dwSize.X
                              End Function
                               
                              Sub ConCls( ByVal fg As Long, ByVal bg As Long )
                                  Local buf As CONSOLE_SCREEN_BUFFER_INFO
                                  Local conSize, written As Dword
                                  Local p As Dword
                               
                                  GetConsoleScreenBufferInfo ConStdOut, buf
                                  conSize = buf.dwSize.X * buf.dwSize.Y
                               
                                  FillConsoleOutputCharacter ConStdOut, 32, conSize, p, written
                               
                                  Shift Left bg, 4
                                  fg Or= bg
                                  SetConsoleTextAttribute ConStdOut, fg
                               
                                  FillConsoleOutputAttribute ConStdOut, fg, conSize, p, written
                               
                                  ConSetCell 0, 0
                              End Sub
                               
                              '==============================================
                              LarryC
                              Website
                              Sometimes life's a dream, sometimes it's a scream

                              Comment


                              • #16
                                Yes that would work, but I would see it as a step on the road to a Collection which contained and managed the items itself. Not that the performance of PowerCollections (which I have used a lot) has ever held me back, but there is probably a speed freak or two around here...

                                Comment


                                • #17
                                  >..but there is probably a speed freak or two around here...

                                  Ya think?

                                  Comment


                                  • #18
                                    Added a bag that can store most of the PowerBASIC data types here.

                                    Each instance of a bag stores a single data type, but different bags can be created to store different types. The types that can be stored are:
                                    String, WString, StringZ, WStringZ, Long, DWord, Word, Quad, Integer, Byte, Extended, Double, Single, Currency, CurrencyX, UDT types.

                                    For bags containing strings you can make them either case sensitive or case insensitive with the provided collations. It uses binary collations and you can create your own custom collations as well.

                                    The case insensitive collation is folds the lower case letters lexigraphically into the upper case letters. From a comparison perspective all letters are treated as having ascii values in the range 65 to 90.
                                    LarryC
                                    Website
                                    Sometimes life's a dream, sometimes it's a scream

                                    Comment


                                    • #19
                                      Yes, I had wondered about putting code inside some of those strings too. Just for a laugh.

                                      Dont know where that smilie sprang from, but I'm sending this from a 3" screen, anything's possible.
                                      Last edited by Chris Holbrook; 12 Mar 2015, 04:52 AM.

                                      Comment


                                      • #20
                                        >Yes, I had wondered about putting code inside some of those strings too. Just for a laugh.

                                        You can do that. There is a demo here somewhere which shows how to execute a piece of code (machine code, not source code) stored in a block of memory. You need to allocate a block of memory with execute permission and call it by address (CALL DWORD), but it can be done.

                                        IIRC You can search here for 'VirtualAllocEx' because that what was used in the demo.

                                        No, I am not endorsing this as good programming practice.

                                        FWIW... you could also execute code stored in a string in MS-DOS GW-BASIC using the 'CALL ABSOLUTE' statement. This technique was often used to call MS-DOS interrupts, for which there is no native support in GW-BASIC.


                                        MCM

                                        Comment

                                        Working...
                                        X