1 | unit UInterfacedBits;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, RTLConsts;
|
---|
7 |
|
---|
8 | type
|
---|
9 | TInterfacedBits = class(TInterfacedObject)
|
---|
10 | private
|
---|
11 | FSize: Integer;
|
---|
12 | FBits: Pointer;
|
---|
13 | procedure Error;
|
---|
14 | procedure SetSize(Value: Integer);
|
---|
15 | procedure SetBit(Index: Integer; Value: Boolean);
|
---|
16 | function GetBit(Index: Integer): Boolean;
|
---|
17 | public
|
---|
18 | procedure BeforeDestruction; override;
|
---|
19 | function OpenBit: Integer;
|
---|
20 | property Bits[Index: Integer]: Boolean read GetBit write SetBit; default;
|
---|
21 | property Size: Integer read FSize write SetSize;
|
---|
22 | end;
|
---|
23 |
|
---|
24 | implementation
|
---|
25 |
|
---|
26 | { TInterfacedBits }
|
---|
27 |
|
---|
28 | const
|
---|
29 | BitsPerInt = SizeOf(Integer) * 8;
|
---|
30 |
|
---|
31 | type
|
---|
32 | TBitEnum = 0..BitsPerInt - 1;
|
---|
33 | TBitSet = set of TBitEnum;
|
---|
34 | PBitArray = ^TBitArray;
|
---|
35 | TBitArray = array[0..4096] of TBitSet;
|
---|
36 |
|
---|
37 | procedure TInterfacedBits.BeforeDestruction;
|
---|
38 | begin
|
---|
39 | SetSize(0);
|
---|
40 | inherited;
|
---|
41 | end;
|
---|
42 |
|
---|
43 | procedure TInterfacedBits.Error;
|
---|
44 | begin
|
---|
45 | raise EBitsError.CreateRes(@SBitsIndexError);
|
---|
46 | end;
|
---|
47 |
|
---|
48 | function TInterfacedBits.GetBit(Index: Integer): Boolean;
|
---|
49 | asm
|
---|
50 | CMP Index,[EAX].FSize
|
---|
51 | JAE TBits.Error
|
---|
52 | MOV EAX,[EAX].FBits
|
---|
53 | BT [EAX],Index
|
---|
54 | SBB EAX,EAX
|
---|
55 | AND EAX,1
|
---|
56 | end;
|
---|
57 |
|
---|
58 | function TInterfacedBits.OpenBit: Integer;
|
---|
59 | var
|
---|
60 | I: Integer;
|
---|
61 | B: TBitSet;
|
---|
62 | J: TBitEnum;
|
---|
63 | E: Integer;
|
---|
64 | begin
|
---|
65 | E := (Size + BitsPerInt - 1) div BitsPerInt - 1;
|
---|
66 | for I := 0 to E do
|
---|
67 | if PBitArray(FBits)^[I] <> [0..BitsPerInt - 1] then
|
---|
68 | begin
|
---|
69 | B := PBitArray(FBits)^[I];
|
---|
70 | for J := Low(J) to High(J) do
|
---|
71 | begin
|
---|
72 | if not (J in B) then
|
---|
73 | begin
|
---|
74 | Result := I * BitsPerInt + J;
|
---|
75 | if Result >= Size then Result := Size;
|
---|
76 | Exit;
|
---|
77 | end;
|
---|
78 | end;
|
---|
79 | end;
|
---|
80 | Result := Size;
|
---|
81 | end;
|
---|
82 |
|
---|
83 | procedure TInterfacedBits.SetBit(Index: Integer; Value: Boolean);
|
---|
84 | asm
|
---|
85 | CMP Index,[EAX].FSize
|
---|
86 | JAE @@Size
|
---|
87 |
|
---|
88 | @@1: MOV EAX,[EAX].FBits
|
---|
89 | OR Value,Value
|
---|
90 | JZ @@2
|
---|
91 | BTS [EAX],Index
|
---|
92 | RET
|
---|
93 |
|
---|
94 | @@2: BTR [EAX],Index
|
---|
95 | RET
|
---|
96 |
|
---|
97 | @@Size: CMP Index,0
|
---|
98 | JL TBits.Error
|
---|
99 | PUSH Self
|
---|
100 | PUSH Index
|
---|
101 | PUSH ECX {Value}
|
---|
102 | INC Index
|
---|
103 | CALL TBits.SetSize
|
---|
104 | POP ECX {Value}
|
---|
105 | POP Index
|
---|
106 | POP Self
|
---|
107 | JMP @@1
|
---|
108 | end;
|
---|
109 |
|
---|
110 | procedure TInterfacedBits.SetSize(Value: Integer);
|
---|
111 | var
|
---|
112 | NewMem: Pointer;
|
---|
113 | NewMemSize: Integer;
|
---|
114 | OldMemSize: Integer;
|
---|
115 |
|
---|
116 | function Min(X, Y: Integer): Integer;
|
---|
117 | begin
|
---|
118 | Result := X;
|
---|
119 | if X > Y then Result := Y;
|
---|
120 | end;
|
---|
121 |
|
---|
122 | begin
|
---|
123 | if Value <> Size then
|
---|
124 | begin
|
---|
125 | if Value < 0 then Error;
|
---|
126 | NewMemSize := ((Value + BitsPerInt - 1) div BitsPerInt) * SizeOf(Integer);
|
---|
127 | OldMemSize := ((Size + BitsPerInt - 1) div BitsPerInt) * SizeOf(Integer);
|
---|
128 | if NewMemSize <> OldMemSize then
|
---|
129 | begin
|
---|
130 | NewMem := nil;
|
---|
131 | if NewMemSize <> 0 then
|
---|
132 | begin
|
---|
133 | GetMem(NewMem, NewMemSize);
|
---|
134 | FillChar(NewMem^, NewMemSize, 0);
|
---|
135 | end;
|
---|
136 | if OldMemSize <> 0 then
|
---|
137 | begin
|
---|
138 | if NewMem <> nil then
|
---|
139 | Move(FBits^, NewMem^, Min(OldMemSize, NewMemSize));
|
---|
140 | FreeMem(FBits, OldMemSize);
|
---|
141 | end;
|
---|
142 | FBits := NewMem;
|
---|
143 | end;
|
---|
144 | FSize := Value;
|
---|
145 | end;
|
---|
146 | end;
|
---|
147 |
|
---|
148 | end.
|
---|