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
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    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
'
    Tags: None
  • #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

        Previous template Next
        Working...
        X

        We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

        By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

        I Agree