[Back to NUMBERS SWAG index] [Back to Main SWAG index] [Original]

    (*
    Date:   02-05-95
    From:   DON PAULSEN

            This unit provides routines to manipulate individual bits
            in memory, including test, set, clear, and toggle.  You may
            also count the number of bits set with NumFlagsSet, and get
            a "picture" of them with the function FlagString.

            All the routines are in the interface section to provide
            complete low-level control of your own data space used for
            flags.  Usually the oFlags object will be most convenient.
            Just initialize the object with the number of flags required,
            and it will allocate sufficient memory on the heap and clear
            them to zero.
    *)

    UNIT DpFlags;

    {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
    {$IFDEF VER70} {$P-,Q-,T-,Y-} {$ENDIF}

    (*
        File(s)         DPFLAGS.PAS
        Unit(s)         None
        Compiler        Turbo Pascal v6.0+
        Author          Don Paulsen
        v1.00 Date       7-01-92
        Last Change     11-12-93
        Version         1.11
    *)

    { Flags are numbered from left to right (low memory to high memory),
      starting with 0, to a maximum of 65520.  If the flags object isn't used,
      use the System.FillChar routine to set or clear all the flags at once.
      The memory for storing the flags can be allocated in the data segment
      or on the heap.

      Here are two methods for declaring an array for the flags (not needed if
      the oFlags object is used):

        CONST
           cMaxFlagNumber = 50;
           cNumberOfFlags = 51;

        VAR
           flags_A : array [0..(cMaxFlagNumber div 8)] of byte;
           flags_B : array [0..(cNumberOfFlags - 1) div 8] of byte;

      Note that since the first flag is flag 0, cNumberOfFlags is always 1 greater
      than cMaxFlagNumber. }

    INTERFACE

    PROCEDURE SetFlag     (var flags; flagNum : word);
    PROCEDURE ClearFlag   (var flags; flagNum : word);
    PROCEDURE ToggleFlag  (var flags; flagNum : word);
    FUNCTION  FlagIsSet   (var flags; flagNum : word): boolean;
    FUNCTION  NumFlagsSet (var flags; numFlags: word): word;
    FUNCTION  FlagString  (var flags; numFlags: word): string;

    TYPE
        tFlags = ^oFlags;
        oFlags = OBJECT
                   CONSTRUCTOR Init (numberOfFlags: word);
                   PROCEDURE   ClearAllFlags;
                   PROCEDURE   SetAllFlags;
                   PROCEDURE   SetFlag    (flagNum: word);
                   PROCEDURE   ClearFlag  (flagNum: word);
                   PROCEDURE   ToggleFlag (flagNum: word);
                   FUNCTION    FlagIsSet  (flagNum: word): boolean;
                   FUNCTION    NumFlagsSet : word;
                   FUNCTION    FlagString  : string;
                   DESTRUCTOR  Done;
                 PRIVATE
                    flags    : pointer;
                    numFlags : word;
                 END;

    IMPLEMENTATION

    {=======================================================}
    PROCEDURE SetFlag (var flags; flagNum: word); assembler;

    ASM
        les     di, flags
        mov     cx, flagNum
        mov     bx, cx
        shr     bx, 1
        shr     bx, 1
        shr     bx, 1
        and     cl, 7
        mov     al, 80h
        shr     al, cl
        or      es:[di][bx], al
    END;

    {=========================================================}
    PROCEDURE ClearFlag (var flags; flagNum: word); assembler;

    ASM
        les     di, flags
        mov     cx, flagNum
        mov     bx, cx
        shr     bx, 1
        shr     bx, 1
        shr     bx, 1
        and     cl, 7
        mov     al, 7Fh
        ror     al, cl
        and     es:[di][bx], al
    END;

    {==========================================================}
    PROCEDURE ToggleFlag (var flags; flagNum: word); assembler;

    ASM
        les     di, flags
        mov     cx, flagNum
        mov     bx, cx
        shr     bx, 1
        shr     bx, 1
        shr     bx, 1
        and     cl, 7
        mov     al, 80h
        shr     al, cl
        xor     es:[di][bx], al
    END;

    {=================================================================}
    FUNCTION FlagIsSet (var flags; flagNum: word): boolean; assembler;

    ASM
        les     di, flags
        mov     cx, flagNum
        mov     bx, cx
        shr     bx, 1
        shr     bx, 1
        shr     bx, 1
        and     cl, 7
        inc     cx
        mov     al, es:[di][bx]
        rol     al, cl
        and     al, 1
    @done:
    END;

    {=================================================================}
    FUNCTION NumFlagsSet (var flags; numFlags: word): word; assembler;

    ASM
        push    ds
        cld
        lds     si, flags
        xor     bx, bx
        mov     cx, numFlags
        mov     dx, cx
        xor     di, di
        shr     cx, 1
        shr     cx, 1
        shr     cx, 1
        jcxz    @remainder
    @byte8:
        lodsb
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        shl     al, 1;  adc     bx, di
        loop    @byte8
    @remainder:
        mov     cx, dx
        and     cx, 7
        jz      @done
        lodsb
    @bit:
        shl     al, 1
        adc     bx, di
        loop    @bit
    @done:
        mov     ax, bx
        pop     ds
    END;

    {==================================================================}
    FUNCTION FlagString (var flags; numFlags: word): string; assembler;

    { Returns a string of 0's & 1's showing the flags.  Note that at most 255
      flags can shown in a string.  Returns nul if numFlags is 0 or greater
      than 255. }

    ASM
        push    ds
        cld
        lds     si, flags
        les     di, @result
        mov     cx, numflags
        or      ch, ch
        jz      @ok
        xor     cx, cx
    @ok:
        mov     al, cl
        stosb                   { length of string }
        jcxz    @done
        mov     dx, cx
        push    dx              { save number of flags }
        mov     ah, '0'
        shr     dl, 1
        shr     dl, 1
        shr     dl, 1
        jz      @remainder
    @byte8:                     { do 8 bits at a time }
        lodsb
        mov     bl, al
        mov     cl, 8
    @bit8:
        mov     al, ah          { ah = '0' }
        shl     bl, 1
        adc     al, dh          { dh = 0 }
        stosb
        loop    @bit8
        dec     dl
        jnz     @byte8

    @remainder:                 { do remaining (numFlags mod 8) bits }
        pop     dx
        mov     cx, dx
        and     cl, 7           { 0 <= cx <= 7 (number of flags in partial byte) }
        jz      @done
        lodsb                   { last byte containing flags  }
        mov     bl, al
    @bit:
        mov     al, ah          { ah = '0' }
        shl     bl, 1
        adc     al, dh          { dh = 0 }
        stosb
        loop    @bit
    @done:
        pop     ds
    END;

    {=============================================}
    CONSTRUCTOR oFlags.Init (numberOfFlags: word);

    BEGIN
        if numberOfFlags > 65520 then FAIL;
        numFlags:= numberOfFlags;
        GetMem (flags, (numFlags + 7) div 8);
        if flags = nil then FAIL;
    END;

    {==============================}
    PROCEDURE oFlags.ClearAllFlags;

    BEGIN
        FillChar (flags^, (numFlags + 7) div 8, #0);
    END;

    {============================}
    PROCEDURE oFlags.SetAllFlags;

    BEGIN
        FillChar (flags^, (numFlags + 7) div 8, #1);
    END;

    {========================================}
    PROCEDURE oFlags.SetFlag (flagNum: word);

    BEGIN
        DpFlags.SetFlag (flags^, flagNum);
    END;

    {==========================================}
    PROCEDURE oFlags.ClearFlag (flagNum: word);

    BEGIN
        DpFlags.ClearFlag (flags^, flagNum);
    END;

    {===========================================}
    PROCEDURE oFlags.ToggleFlag (flagNum: word);

    BEGIN
        DpFlags.ToggleFlag (flags^, flagNum);
    END;

    {==================================================}
    FUNCTION oFlags.FlagIsSet (flagNum: word): boolean;

    BEGIN
        FlagIsSet:= DpFlags.FlagIsSet (flags^, flagNum);
    END;

    {=================================}
    FUNCTION oFlags.NumFlagsSet: word;

    BEGIN
        NumFlagsSet:= DpFlags.NumFlagsSet (flags^, numFlags);
    END;

    {==================================}
    FUNCTION oFlags.FlagString: string;

    VAR
        w : word;

    BEGIN
        w:= numFlags;
        if w > 255 then w:= 255;
        FlagString:= DpFlags.FlagString (flags^, w);
    END;

    {======================}
    DESTRUCTOR oFlags.Done;

    BEGIN
        if flags <> nil then FreeMem (flags, (numFlags + 7) div 8);
    END;

    END.        { Unit DpFlags }

[Back to NUMBERS SWAG index] [Back to Main SWAG index] [Original]