Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Manage Large Numbers (millions!) of Bit Flags.

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

  • PBWin/PBCC Manage Large Numbers (millions!) of Bit Flags.

    '
    Code:
    '================================
    ' Program to keep track of millions of "bit flags"
    ' - Set and Clear flags
    ' - Locate first available flag - about 1 million Tix to search through 10 million flags
    ' - increase/decrease total number of flags
    ' Stuart McLachlan, 2020
    ' Released to the Public Domain.
    '=================================
    #COMPILE EXE 'Works with PBWin8-10 / PBCC4-6.
    #DIM ALL
    
    FUNCTION PBMAIN () AS LONG
    LOCAL sFlags AS STRING   'String storing the bit flags
    LOCAL pFlags AS QUAD PTR 'Pointer to  block of 64 flags
    LOCAL FlagNo,x AS LONG
    LOCAL Flagcount,FlagsToAdd AS LONG
    
    
    'Initialise everything
    Flagcount = 10000000 'will be rounded up to nearest multiple of 64
    Flagcount = Flagcount + (63 - (Flagcount -1) MOD 64)
    sFlags = NUL$(Flagcount \ 8)
    pFlags = STRPTR(sFlags)
    DIM bFlags(1 TO LEN(sFlags)) AS BYTE AT pFlags
    
    GOSUB Demonstration
    
    EXIT FUNCTION
    '=========== Flag SUBS =================
    GetFlag:
    FOR x = 0 TO (LEN(sFlags)\8)-1
        IF @pFlags[x] <> &HFFFFFFFFFFFFFFFF THEN
            FlagNo = x * 64 + 65 - INSTR(-1,BIN$(@pFlags[x],64),"0")
            RETURN
        END IF
    NEXT
    FlagNo = 0
    RETURN
    
    SetFlag:
    BIT SET bFlags(1),FlagNo-1
    RETURN
    
    ClearFlag:
    BIT RESET bFlags(1),FlagNo-1
    RETURN
    
    AddFlags:
    'Add or remove  Flags based on sign of FlagsToAdd
    ''FlagsToAdd is rounded away from 0 to a multiple of 64 bits
    'Caution, that means that if FlagToAdd = -1,  8 bytes/64 Flags will be removed!
       SELECT CASE FlagsToAdd
           CASE > 0
              FlagsToAdd =FlagsToAdd +  63 - (FlagsToAdd-1) MOD 64
              sFlags = sFlags + STRING$(FlagsToAdd/8, CHR$(0))
           CASE < 0
              FlagsToAdd = FLagsToAdd - 63 - ABS(FlagsToAdd+1) MOD 64
              sFlags = LEFT$(sFlags,FlagsToAdd/8)
           CASE ELSE '0
              RETURN
       END SELECT
       pFlags = STRPTR(sFlags)
       REDIM bFlags(1 TO LEN(sFlags)) AT pFlags
       RETURN
    
    '==========   DEMONSTRATION  ============================
    Demonstration:
       ? "Current number of Flags : " & STR$(LEN(sFlags) * 8)
       'set most of the Flags to used
       FOR x = 1 TO Flagcount - 20
           FlagNo = x
           GOSUB SetFlag
       NEXT
      'Get first available Flag
      LOCAL q AS QUAD
      TIX Q
      GOSUB getFlag
      TIX END q
      ? "First Available Flag after setting all but last 20 " & STR$(FlagNo) & " took " & STR$(q) & " tix"
    
      'Release a Flag
      FlagNo = 23
      GOSUB clearFlag
      'Get first avaiable Flag again
      GOSUB getFlag
      ? "First Available Flag after clearing 23: " & STR$(FlagNo)
    
      'use all of the Flags
       FOR x = 1 TO LEN(sFlags)*8
           FlagNo = x
           GOSUB SetFlag
       NEXT
       GOSUB getFlag
      ? "First available Flag after all set: " & STR$(FlagNo)
    
      'add some Flags
      FlagsToAdd = 50 ' Number of additional Flags, will be rounded up to multiple of 64
      GOSUB AddFlags
      ? "No of Flags after adding" & STR$(FlagsToAdd)  & ": " & STR$(LEN(sFlags) * 8)
    
       GOSUB getFlag
      ? "First available Flag after adding: " & STR$(FlagNo)
      #IF %DEF(%PB_CC32)
       WAITKEY$
      #ENDIF
       RETURN
    END FUNCTION
    '

  • #2
    Version using a global flag buffer and FASTPROCs to make it "plug and play" into another applications:

    Added FlagIsSet test (how did I miss that one first time round? )

    N.B. Requires PBWin10/PBCC6

    '
    Code:
    '================================
    ' Program to manage millions of "bit flags"
    ' Stuart McLachlan, 2020
    ' Released to the Public Domain.
    '=================================
    #COMPILE EXE 'Works with PB10 / PBCC6.
    #DIM ALL
    
    'Flag Global Variables
    GLOBAL sFlags AS STRING   'String storing the bit flags
    GLOBAL pFlags AS QUAD PTR 'Pointer to  blocks of 64 flags
    GLOBAL bFlags() AS BYTE 'Overlay of sFlags for bit manipulation
    
    
    FUNCTION PBMAIN () AS LONG
    LOCAL Flagcount AS LONG
    
    'Initialise everything
    Flagcount = 1000000 'will be rounded up to nearest multiple of 64
    Flagcount = Flagcount + (63 - (Flagcount -1) MOD 64)
    sFlags = NUL$(Flagcount \ 8)
    pFlags = STRPTR(sFlags)
    DIM bFlags(1 TO LEN(sFlags)) AT pFlags
    
    CALL Demonstration
    
    END FUNCTION
    
    '=========== Flag FASTPROCS =================
    FASTPROC GetFirstFreeFlag() AS LONG
    STATIC x AS LONG
    STATIC Flag AS LONG
    Flag = 0
    FOR x = 0 TO (LEN(sFlags)\8)-1
        IF @pFlags[x] <> &HFFFFFFFFFFFFFFFF THEN
            Flag = x * 64 + 65 - INSTR(-1,BIN$(@pFlags[x],64),"0")
            EXIT FOR
        END IF
    NEXT
    END FASTPROC = Flag
    
    FASTPROC FlagIsSet(BYVAL FlagNo  AS LONG) AS LONG
       STATIC IsSet AS LONG
       ISSet =  BIT(bFlags(1),FlagNo-1)
    END FASTPROC  = IsSet
    
    FASTPROC SetFlag(BYVAL x  AS LONG)
        BIT SET bFlags(1),x-1
    END FASTPROC
    
    FASTPROC ClearFlag(BYVAL FlagNo  AS LONG)
    BIT RESET bFlags(1),FlagNo-1
    END FASTPROC
    
    FASTPROC SetAllFlags
    STATIC x AS LONG
    FOR x = 0 TO (LEN(sFlags)*8)-1
       BIT SET bFlags(1), x
    NEXT
    END FASTPROC
    
    FASTPROC ClearAllFlags
    STATIC x AS LONG
    FOR x = 0 TO (LEN(sFlags)*8)-1
       BIT RESET bFlags(1), x
    NEXT
    END FASTPROC
    
    FASTPROC FreeFlags() AS LONG
    STATIC x AS LONG
    STATIC fflags AS LONG
    fflags = 0
    FOR x = 0 TO (LEN(sFlags)*8)-1
       fflags += BIT(bFlags(1), x)
    NEXT
    fflags = LEN(sFlags) * 8 - fflags
    END FASTPROC = fflags
    
    
    FASTPROC AddFlags (BYVAL FlagsToAdd  AS LONG)
    'Add or remove  Flags based on sign of FlagsToAdd
    ''FlagsToAdd is rounded away from 0 to a multiple of 64 bits
    'Caution, that means that if FlagToAdd = -1,  8 bytes/64 Flags will be removed!
       SELECT CASE FlagsToAdd
           CASE > 0
              FlagsToAdd =FlagsToAdd +  63 - (FlagsToAdd-1) MOD 64
              sFlags = sFlags + STRING$(FlagsToAdd/8, CHR$(0))
           CASE < 0
              FlagsToAdd = FLagsToAdd - 63 - ABS(FlagsToAdd+1) MOD 64
              sFlags = LEFT$(sFlags,FlagsToAdd/8)
           CASE ELSE '0
              EXIT FASTPROC
       END SELECT
       pFlags = STRPTR(sFlags)
       REDIM bFlags(1 TO LEN(sFlags)) AT pFlags
    END FASTPROC
    
    '==========   DEMONSTRATION  ============================
    SUB Demonstration()
       LOCAL x AS LONG
       LOCAL FlagNo AS LONG
       LOCAL totflags AS LONG
       totflags = LEN(sFlags) * 8
       ? "Current number of Flags : " & FORMAT$(TotFlags,"0,")
       'set most of the Flags to used
       SetAllFlags
       FOR x = TotFlags - 19 TO TotFlags
           ClearFlag x
       NEXT
       'Get first available Flag
      LOCAL q AS QUAD
      TIX q
      FlagNo = GetFirstFreeFlag
      TIX END q
      ? "First Available Flag after setting all but last 20: " & STR$(FlagNo) & "  - took " & FORMAT$(q,"0,") & " tix"
      ? "There are " & STR$(freeflags) & " free"
      'Release a Flag
      x = 12345
      clearFlag x
      'Get first available Flag again
      FlagNo = GetFirstFreeFlag
      ? "First Available Flag after clearing flag " & STR$(x) & ": " & STR$(FlagNo)
      IF FlagIsSet(x) THEN
          ? "Flag " &  STR$(x) & " is set"
      ELSE
          ? "Flag " &  STR$(x) & " is not set"
      END IF
      IF FlagIsSet(x-1) THEN
          ? "Flag " &  STR$(x-1) & " is set"
      ELSE
          ? "Flag " &  STR$(x-1) & " is not set"
      END IF
    
    
      'Set all of the Flags
       TIX q
        SetAllFlags
       TIX END q
      FlagNo = GetFirstFreeFlag
      ? "Setting all " & FORMAT$(TotFlags,"0,") & " flags took " & FORMAT$(q,"0,") & " tixs"
      ? "First available Flag after setting all flags: " & STR$(FlagNo)
      ? "No of free flags: " & STR$(freeflags)
      'add some Flags
      ' Number of additional Flags, will be rounded up to multiple of 64
      x = 50
      AddFlags  x
      ? "No of Flags after adding" & STR$(x)  & ": " & STR$(LEN(sFlags) * 8)
      FlagNo = GetFirstFreeFlag
      ? "First available Flag after adding " & STR$(x) & " flags: " & STR$(FlagNo)
      #IF %DEF(%PB_CC32)
       WAITKEY$
      #ENDIF
    END SUB
    '

    Comment


    • #3
      Major speed increase

      Use of macros allows FASTPROCs to use Register variables instead of much slower Statics .

      Edit:
      This was V1.2.
      Code deleted, see next post for V1.3
      Last edited by Stuart McLachlan; 28 Jun 2020, 12:46 AM.

      Comment


      • #4
        Added Set/ClearBlock(lStart,lSTop) procedures.
        '
        Code:
        '================================
        ' Program to manage millions of "bit flags"
        ' Stuart McLachlan, 2020
        ' Released to the Public Domain.
        ' Version 1.3
        '=================================
        #COMPILE EXE "FlagManagementDemo" 'Requires PB10 / PBCC6 - uses FASTPROCs
        #DIM ALL
        #INCLUDE "WIN32API.inc"
        
        %NoOfFlags = 1000000 ' will be rounded up to a multiple of 64!
        %ReportBuildTime = 1 'Comment out to not display Initialisation Time
        #INCLUDE "FlagManagement.inc"
        
        FUNCTION PBMAIN () AS LONG
            InitFlags %NoOfFlags
            CALL Demonstration
        END FUNCTION
        
        '========== DEMONSTRATION ============================
        SUB Demonstration()
        LOCAL x,y AS LONG
        LOCAL FlagNo AS LONG
        LOCAL totflags AS LONG
        
        LOCAL qFreq, qStart, qStop AS QUAD
            QueryPerformanceFrequency qFreq
        
            totflags = LEN(sFlags) * 8
            ? "Current number of Flags : " & FORMAT$(TotFlags,"0,")
            'set most of the Flags to used
            SetAllFlags
            ClearBlock TotFlags - 19, TotFlags
            'Get first available Flag
            QueryPerformanceCounter qstart
            FlagNo = GetFirstFreeFlag
            QueryPerformanceCounter qStop
           ? "First Available Flag after setting all but last 20: " & STR$(FlagNo) & " - find took " & FORMAT$((qStop-qStart)*1000/qFreq, "####.##")+"ms"
        
            QueryPerformanceCounter qstart
            x = freeflags
            QueryPerformanceCounter qStop
            ? "There are " & STR$(x) & " free" & " - count took " & FORMAT$((qStop-qStart)*1000/qFreq, "####.##")+"ms"
        
            'Clear a Flag
            x = 12345
            clearFlag x
            ? "After clearing flag 12345, there are now " & STR$(freeflags) & " free"
            'Get first available Flag again
            FlagNo = GetFirstFreeFlag
            ? "First Available Flag after clearing flag " & STR$(x) & ": " & STR$(FlagNo)
            IF FlagIsSet(x) THEN
                ? "Flag " & STR$(x) & " is set"
            ELSE
                ? "Flag " & STR$(x) & " is clear but is about to be reset before next test"
                SetFlag x
            END IF
        
            'Clear block of flags
            QueryPerformanceCounter qstart
            x = 1001 :y = 1000 'Start, number to clear
            ClearBlock x,x+y -1
            QueryPerformanceCounter qStop
            ? "Clearing" & STR$(y) & " flags starting from " & FORMAT$(x,"0,") & " took " & FORMAT$((qStop-qStart)*1000/qFreq, "####.##")+"ms"
            FlagNo = GetFirstFreeFlag
            ? "First available Flag after clearing block : " & STR$(FlagNo)
            ? "Free flags now: " & STR$(freeflags)
        
            'Set all of the Flags
            QueryPerformanceCounter qstart
            SetAllFlags
            QueryPerformanceCounter qStop
            ? "Setting all " & FORMAT$(TotFlags,"0,") & " flags took " & FORMAT$((qStop-qStart)*1000/qFreq, "####.##")+"ms"
            FlagNo = GetFirstFreeFlag
            ? "First available Flag after setting all flags: " & STR$(FlagNo)
            ? "No of free flags now: " & STR$(freeflags)
        
            'add some Flags
            x = 100 'Number of additional Flags, will be rounded  away from zero to a multiple of 64
            y = LEN(sFlags) * 8
            AddFlags x
            ? "No of Flags after adding requested " & STR$(x) & " (" & STR$((LEN(sFlags) * 8-y)) & " after rounding): " & STR$(LEN(sFlags) * 8)
            FlagNo = GetFirstFreeFlag
            ? "First available Flag after adding flags: " & STR$(FlagNo)
        
            #IF %DEF(%PB_CC32)
                WAITKEY$
            #ENDIF
        END SUB
        '
        '
        Code:
        '================================
        'FileName: FlagManagement.inc
        '
        ' Include file to manage millions of "bit flags"
        ' Stuart McLachlan, 2020
        ' Released to the Public Domain.
        ' Version 1.3
        '
        'Requires PBWin10 /CC6 (uses FASTPROCs)
        '=================================
        
        'Flag Global Variables
        GLOBAL sFlags AS STRING 'String storing the bit flags
        GLOBAL pFlags AS QUAD PTR 'Pointer to blocks of 64 flags
        GLOBAL bFlags() AS BYTE 'Overlay of sFlags for bit manipulation
        
        FUNCTION InitFlags(NoOfFags AS LONG) AS LONG
        LOCAL Flagcount AS LONG
        
        #IF %DEF(%ReportBuildTime)
            LOCAL qFreq, qStart, qStop AS QUAD
            QueryPerformanceFrequency qFreq
            QueryPerformanceCounter qstart
        #ENDIF
        
             'Initialise everything
            Flagcount = %NoOfFlags + (63 - (%NoOfFlags -1) MOD 64)
            sFlags = NUL$(Flagcount \ 8)
            pFlags = STRPTR(sFlags)
            DIM bFlags(1 TO LEN(sFlags)) AT pFlags
        
        #IF %DEF(%ReportBuildTime)
            QueryPerformanceCounter qstop
            ? "Setting up initial " & FORMAT$(Flagcount, "0,") & " flags took " & FORMAT$((qStop-qStart)*1000/qFreq, "####.##")+"ms"
        #ENDIF
        END FUNCTION
        
        '=========== Flag FASTPROCS =================
        'Macros enable the use of FASTPROCS Register variables rather than slower Statics
        
        MACRO GetFirstFreeFlag= GetFirstFreeFlag1(0,0)
        FASTPROC GetFirstFreeFlag1(BYVAL X AS LONG, BYVAL FLAG AS LONG) AS LONG
            FOR x = 0 TO (LEN(sFlags)\8)-1
                IF @pFlags[x] THEN
                     Flag = x * 64 + 65 - INSTR(-1,BIN$(@pFlags[x],64),"1")
                     EXIT FOR
                END IF
            NEXT
        END FASTPROC = Flag
        
        MACRO FlagIsSet(x)= FlagIsSet1(0,x)
        FASTPROC FlagIsSet1(BYVAL IsSet AS LONG, BYVAL FlagNo AS LONG) AS LONG
            ISSet = ISFALSE(BIT(bFlags(1),FlagNo-1))
        END FASTPROC = IsSet
        
        FASTPROC SetFlag(BYVAL x AS LONG)
            BIT RESET bFlags(1),x-1
        END FASTPROC
        
        FASTPROC ClearFlag(BYVAL FlagNo AS LONG)
            BIT SET bFlags(1),FlagNo-1
        END FASTPROC
        
        FASTPROC ToggleFlag(BYVAL FlagNo AS LONG)
            BIT TOGGLE bFlags(1),FlagNo-1
        END FASTPROC
        
        MACRO SetAllFlags = SetAllFlags1(0)
        FASTPROC SetAllFlags1(BYVAL x AS LONG)
            FOR x = 0 TO (LEN(sFlags)*8)-1
                BIT RESET bFlags(1), x
            NEXT
        END FASTPROC
        
        MACRO ClearAllFlags = ClearAllFlags1(0)
        FASTPROC ClearAllFlags1(BYVAL x AS LONG)
            FOR x = 0 TO (LEN(sFlags)*8)-1
                BIT SET bFlags(1), x
            NEXT
        END FASTPROC
        
        FASTPROC SetBlock(BYVAL lStart AS LONG, BYVAL lStop AS LONG)
            FOR lStart = lStart -1 TO lStop -1
                BIT RESET bFlags(1), lStart
            NEXT
        END FASTPROC
        
        FASTPROC ClearBlock(BYVAL lStart AS LONG, BYVAL lStop AS LONG)
            FOR lStart = lStart -1 TO lStop -1
                BIT SET bFlags(1), lStart
            NEXT
        END FASTPROC
        
        MACRO FreeFlags = FreeFlags1(0,0)
        FASTPROC FreeFlags1(BYVAL X AS LONG, BYVAL fflags AS LONG) AS LONG
            FOR x = 0 TO (LEN(sFlags)*8)-1
               fflags += BIT(bFlags(1), x)
            NEXT
        END FASTPROC = fflags
        
        FASTPROC AddFlags (BYVAL FlagsToAdd AS LONG)
        'Add or remove Flags based on sign of FlagsToAdd
        ''FlagsToAdd is rounded away from 0 to a multiple of 64 bits
        'Caution, that means that if FlagToAdd = -1, 8 bytes/64 Flags will be removed!
            SELECT CASE FlagsToAdd
                CASE > 0
                    FlagsToAdd =FlagsToAdd + 63 - (FlagsToAdd-1) MOD 64
                    sFlags = sFlags + STRING$(FlagsToAdd/8, CHR$(1))
             CASE < 0
                FlagsToAdd = FLagsToAdd - 63 + ABS(FlagsToAdd+1) MOD 64
                sFlags = LEFT$(sFlags,FlagsToAdd/8)
             CASE ELSE '0
                EXIT FASTPROC
            END SELECT
            pFlags = STRPTR(sFlags)
            REDIM bFlags(1 TO LEN(sFlags)) AT pFlags
        END FASTPROC
        '
        Last edited by Stuart McLachlan; 28 Jun 2020, 06:45 AM.

        Comment

        Working...
        X