Autor Beitrag
Jakob Schöttl
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 929
Erhaltene Danke: 1


Delphi 7 Professional
BeitragVerfasst: Fr 30.06.06 16:58 
Hallo,

Ich hab hier eine Unit programmiert, die einige BitOperations zur Verfügung stellt.
Vielleicht gibt es hier jemanden, der sie mal brauchen kann.

Funktionen:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
//Significance = Wertigkeit
function Significance(DigitNr: Byte; Base: Byte): integer; overload;            //DigitNr: Index der Stelle von rechts, angefangen mit 0
function Significance(BitNr: Byte): integer; overload;                          //BitNr: Index des Bits von rechts, angefangen mit 0
procedure SetBit(var Value: longint; BitNr: Byte; NewBit: TBit);                //BitNr: Index des Bits von rechts, angefangen mit 0; NewBit: Neuer Wert des Bits, das verändert werden soll 
function GetBit(Value: longint; BitNr: Byte): TBit;                             //BitNr: Index des Bits von rechts, angefangen mit 0
function Max(nBits: Byte): LongInt;                                             //Gibt den maximalen Wert zurück, der mit nBits dargestellt werden kann
function CharToBit(chr: Char): TBit;
function BitToChar(Bit: TBit): Char;
function BitToBool(Bit: TBit): Boolean;
function BoolToBit(Bool: Boolean): TBit;
function BitToStr(Bit: TBit; ReturnBoolStr: Boolean = False): string;           //ReturnBoolStr: Gibt an, ob in dem String ('True' or 'False') oder ('1' or '0') stehen soll
function InvertBit(Bit: TBit): TBit;                                            //Invertiert das Bit


Ein Anwendungsbeispiel für die Funktion GetBit:
Dateiattribute sind in einem einem Word oder Byte (weiß nicht mehr) gespeichert. Jedes Bit representiert ein Attribut. Das erste Bit von links steht für faReadOnly, das zweite für faHidden, ...

Meine Funktionen sind zwar nicht sehr komplex, aber vereinfachen doch solche Bit-Operationen.

Wenn jemand noch zusätzliche Ideen hat, dafür bin ich offen!
Einloggen, um Attachments anzusehen!
aladin60
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 20



BeitragVerfasst: Di 23.10.07 18:47 
Ich habe diese Unit heute mal gebraucht, schön, dass sie fertig war.
Dankeschön für Deine Mühe.

Bernd.
BenBE
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 8721
Erhaltene Danke: 191

Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
BeitragVerfasst: Sa 27.10.07 12:15 
Hab das mal kurz etwas optimiert:

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
Unit BitOperations;

Interface

Uses
    Math;

Type
    TBit = 0..1;

Type
    TBitNr = 0..31;
    TDigitNr = Type TBitNr;

Function Significance(DigitNr: TDigitNr; Base: Byte): Cardinal; overload//DigitNr: Index der Stelle von rechts, angefangen mit 0
Function Significance(BitNr: TBitNr): Cardinal; overload//BitNr: Index des Bits von rechts, angefangen mit 0

Procedure SetBit(Var Value: Cardinal; BitNr: TBitNr; NewBit: TBit = 1); //BitNr: Index des Bits von rechts, angefangen mit 0; NewBit: Neuer Wert des Bits, das verändert werden soll
Procedure SetBit(Var Value: Cardinal; BitNr: TBitNr); //BitNr: Index des Bits von rechts, angefangen mit 0
Procedure ClearBit(Var Value: Cardinal; BitNr: TBitNr); //BitNr: Index des Bits von rechts, angefangen mit 0; NewBit: Neuer Wert des Bits, das verändert werden soll
Procedure InvertBit(var Value: Cardinal; BitNr: TBitNr);
Function InvertBit(Bit: TBit): TBit; //Invertiert das Bit

Function GetBit(Value: Cardinal; BitNr: TBitNr): TBit; //BitNr: Index des Bits von rechts, angefangen mit 0

Function Max(nBits: Byte): Cardinal; //Gibt den maximalen Wert zurück, der mit nBits dargestellt werden kann

Function CharToBit(chr: Char): TBit;
Function BitToChar(Bit: TBit): Char;

Function BitToBool(Bit: TBit): Boolean;
Function BoolToBit(Bool: Boolean): TBit;

Function BitToStr(Bit: TBit; ReturnBoolStr: Boolean = False): String//ReturnBoolStr: Gibt an, ob in dem String ('True' or 'False') oder ('1' or '0') stehen soll

Implementation

Function Significance(DigitNr: Byte; Base: Byte): Cardinal;
Begin
    result := Round(Power(Base, DigitNr));
End;

Function Significance(BitNr: Byte): Cardinal;
asm
    MOV     EDX, 1
    SHL     EDX, EAX
    XCHG    EDX, EAX
End;

Procedure SetBit(Var Value: Cardinal; BitNr: Byte; NewBit: TBit);
Begin
    Case NewBit Of
        0: Value := Value And (Not Significance(BitNr)) {111101111};
        1: Value := Value Or Significance(BitNr) {000010000};
    End;
End;

Procedure SetBit(Var Value: Cardinal; BitNr: Byte);
ASM
    MOV     ECX, 1
    SHL     ECX, EDX
    OR      EAX, ECX
End;

Procedure ClearBit(Var Value: Cardinal; BitNr: Byte);
ASM
    MOV     ECX, 1
    SHL     ECX, EDX
    NOT     ECX
    AND     EAX, ECX
End;

Procedure InvertBit(var Value: Cardinal; BitNr: TBitNr);
Asm
    MOV     ECX, 1
    SHL     ECX, EDX
    XOR     EAX, ECX
End;

Function InvertBit(Bit: TBit): TBit;
Asm
    XOR     EAX, 1
    AND     EAX, 1
End;

Function GetBit(Value: Cardinal; BitNr: Byte): TBit;
Asm
    PUSH    EAX
    MOV     EAX, 1
    SHL     EAX, EDX
    POP     EDX
    AND     EAX, EDX
    SETNZ   AL
    MOVZX   EAX, AL
End;

Function Max(nBits: Byte): Cardinal;
Asm
    MOV     EDX, 1
    XCHG    EAX, EDX
    SHL     EAX, EDX
    DEC     EAX
End;

Function CharToBit(chr: Char): TBit;
Asm
    CMP     EAX, '1'
    SETZ    AL
    MOVZX   EAX, AL
End;

Function BitToChar(Bit: TBit): Char;
Asm
    AND     EAX, 1
    ADD     EAX, '0'
End;

Function BitToBool(Bit: TBit): Boolean;
asm
    AND     EAX, 1 //Theoretically not even needed ...
End;

Function BoolToBit(Bool: Boolean): TBit;
asm
    AND     EAX, 1 //Theoretically not even needed ...
End;

Function BitToStr(Bit: TBit; ReturnBoolStr: Boolean = False): String;
const
    S: array[Boolean, TBit] of string = 
        (('0''1'), ('False''True'));
Begin
    Result := S[ReturnBoolStr, Bit];
End;

End.


Hoff mal, dass ich mich nirgends vertan hab; ansonsten kurz bescheid geben ...

_________________
Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
OlafSt
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 486
Erhaltene Danke: 99

Win7, Win81, Win10
Tokyo, VS2017
BeitragVerfasst: Di 30.10.07 14:33 
Wie wäre es mit ein paar
ausblenden Delphi-Quelltext
1:
inline;					


? Ich weiß, kann nicht jeder Compiler, aber dafür gibt es ja {$IFDEF VER180} usw...

_________________
Lies, was da steht. Denk dann drüber nach. Dann erst fragen.
BenBE
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 8721
Erhaltene Danke: 191

Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
BeitragVerfasst: Di 30.10.07 18:14 
Bringt zumindest für BDS und TD nix, da dort Inlining von Funktionen mit ASM nicht unterstützt wird (erlaubt ist). Wie's bei'm FPC aussieht, weiß ich grad nicht.

Für die Nutzung in C würd ich Dir aber in jedem Fall Recht geben: Dort gehört Inline einfach in Line :P

Aber ansonsten erstmal alles fehlerfrei?

_________________
Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
Zyklame
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 41
Erhaltene Danke: 1

Win 7 Professional
Delphi XE, Visual Studio 2010
BeitragVerfasst: Mi 21.11.07 16:11 
user profile iconBenBE hat folgendes geschrieben:
Aber ansonsten erstmal alles fehlerfrei?


so ich hab das Interface mal an die geänderten Aufrufe angepast

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
Unit BitOperations;

Interface

uses
  Math;

type
  TBit = 0..1;
  TBitNr = 0..31;
  TDigitNr = Type TBitNr;

  function  Significance (DigitNr: Byte; Base: Byte): Cardinal;            overload;
  function  Significance (BitNr: Byte): Cardinal;                          overload;

  procedure SetBit       (Var Value: Cardinal; BitNr: Byte; NewBit: TBit); overload;
  procedure SetBit       (Var Value: Cardinal; BitNr: Byte);               overload;

  procedure ClearBit     (Var Value: Cardinal; BitNr: Byte);

  procedure InvertBit    (var Value: Cardinal; BitNr: TBitNr);             overload;
  function  InvertBit    (Bit: TBit): TBit;                                overload;

  function  GetBit       (Value: Cardinal; BitNr: Byte): TBit;
  function  Max          (nBits: Byte): Cardinal;

  function  CharToBit    (chr: Char): TBit;
  function  BitToChar    (Bit: TBit): Char;
  function  BitToBool    (Bit: TBit): Boolean;
  function  BoolToBit    (Bool: Boolean): TBit;
  function  BitToStr     (Bit: TBit; ReturnBoolStr: Boolean = False): String;

Implementation

function Significance(DigitNr: Byte; Base: Byte): Cardinal;
begin
  result := Round(Power(Base, DigitNr));
end;

function Significance(BitNr: Byte): Cardinal;
asm
  MOV     EDX, 1
  SHL     EDX, EAX
  XCHG    EDX, EAX
end;

procedure SetBit(Var Value: Cardinal; BitNr: Byte; NewBit: TBit);
begin
  Case NewBit Of
    0: Value := Value And (Not Significance(BitNr)) {111101111};
    1: Value := Value Or Significance(BitNr) {000010000};
  end;
end;

procedure SetBit(Var Value: Cardinal; BitNr: Byte);
asm
  MOV     ECX, 1
  SHL     ECX, EDX
  OR      EAX, ECX
end;

procedure ClearBit(Var Value: Cardinal; BitNr: Byte);
asm
  MOV     ECX, 1
  SHL     ECX, EDX
  NOT     ECX
  AND     EAX, ECX
end;

procedure InvertBit(var Value: Cardinal; BitNr: TBitNr);
asm
  MOV     ECX, 1
  SHL     ECX, EDX
  XOR     EAX, ECX
end;

function InvertBit(Bit: TBit): TBit;
asm
  XOR     EAX, 1
  AND     EAX, 1
end;

function GetBit(Value: Cardinal; BitNr: Byte): TBit;
asm
  PUSH    EAX
  MOV     EAX, 1
  SHL     EAX, EDX
  POP     EDX
  AND     EAX, EDX
  SETNZ   AL
  MOVZX   EAX, AL
end;

function Max(nBits: Byte): Cardinal;
asm
  MOV     EDX, 1
  XCHG    EAX, EDX
  SHL     EAX, EDX
  DEC     EAX
end;

function CharToBit(chr: Char): TBit;
asm
  CMP     EAX, '1'
  SETZ    AL
  MOVZX   EAX, AL
end;

function BitToChar(Bit: TBit): Char;
asm
  AND     EAX, 1
  ADD     EAX, '0'
end;

function BitToBool(Bit: TBit): Boolean;
asm
  AND     EAX, 1 //Theoretically not even needed ...
end;

function BoolToBit(Bool: Boolean): TBit;
asm
  AND     EAX, 1 //Theoretically not even needed ...
end;

function BitToStr(Bit: TBit; ReturnBoolStr: Boolean = False): String;
const
    S: array[Boolean, TBit] of string = 
        (('0''1'), ('False''True'));
begin
  Result := S[ReturnBoolStr, Bit];
end;

end.


aber ich bekomme immer eine Fehlermeldung bei dem shl Befehl (an allen Stellen, mit "Delphi 7" und "Turbo Delphi 2006")

Turbo Delphi 2006 hat folgendes geschrieben:
[Pascal Error] BitOperations.pas(43): E2116 Invalid combination of opcode and operands
Allesquarks
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 510

Win XP Prof
Delphi 7 E
BeitragVerfasst: Mi 21.11.07 17:02 
Schiebebefehle gehen in Assembler meist nur mit cl also dem niedrigsten Byte des Counter-Registers.
BenBE
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 8721
Erhaltene Danke: 191

Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
BeitragVerfasst: Do 22.11.07 12:44 
oops, Komplett übersehen ^^ Änder ich bei Gelegenheit ^^

_________________
Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
Zyklame
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 41
Erhaltene Danke: 1

Win 7 Professional
Delphi XE, Visual Studio 2010
BeitragVerfasst: Mo 20.10.08 22:11 
user profile iconBenBE hat folgendes geschrieben Zum zitierten Posting springen:
oops, Komplett übersehen ^^ Änder ich bei Gelegenheit ^^


Da du es bis jetzt nicht geschaft hast und ich die Unit brauchte hab ich mich mal selbst hingesetzt.

Meine Assembler Fähigkeiten unter Delphi sind nur begrenzt, aber das ist dabei Rausgekommen:

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
Unit AsmBitOperations;

Interface

uses
  Math;

type
  TBit = 0..1;
  TBitNr = 0..31;
  TDigitNr = Type TBitNr;

  function  Significance (DigitNr: Byte; Base: Byte): Cardinal;            overload;
  function  Significance (BitNr: Byte): Cardinal;                          overload;

  procedure SetBit       (Var Value: Cardinal; BitNr: Byte; NewBit: TBit); overload;
  procedure SetBit       (Var Value: Cardinal; BitNr: Byte);               overload;

  procedure ClearBit     (Var Value: Cardinal; BitNr: Byte);

  procedure InvertBit    (var Value: Cardinal; BitNr: TBitNr);             overload;
  function  InvertBit    (Bit: TBit): TBit;                                overload;

  function  GetBit       (Value: Cardinal; BitNr: Byte): TBit;
  function  MaxBit       (nBits: Byte): Cardinal;

  function  CharToBit    (chr: Char): TBit;
  function  BitToChar    (Bit: TBit): Char;
  function  BitToBool    (Bit: TBit): Boolean;
  function  BoolToBit    (Bool: Boolean): TBit;
  function  BitToStr     (Bit: TBit; ReturnBoolStr: Boolean = False): String;

Implementation

function Significance(DigitNr: Byte; Base: Byte): Cardinal;
begin
  result := Round(Power(Base, DigitNr));
end;

function Significance(BitNr: Byte): Cardinal;
asm
  MOV     EDX, 1

// SHL EDX, EAX
  PUSH    EAX
@s:
  CMP     EAX, 0
  JZ      @f
  SHL     EDX, 1
  DEC     EAX
  JMP     @s
@f:
  POP     EAX
// SHL EDX, EAX

  XCHG    EDX, EAX
end;

procedure SetBit(Var Value: Cardinal; BitNr: Byte; NewBit: TBit);
begin
  Case NewBit Of
    0: Value := Value And (Not Significance(BitNr)) {111101111};
    1: Value := Value Or Significance(BitNr) {000010000};
  end;
end;

procedure SetBit(Var Value: Cardinal; BitNr: Byte);
asm
  MOV     ECX, 1

//  SHL     ECX, EDX
  PUSH    EDX
@s:
  CMP     EDX, 0
  JZ      @f
  SHL     ECX, 1
  DEC     EDX
  JMP     @s
@f:
  POP     EDX
//  SHL     ECX, EDX

  // EAX ist nur ein Pointer auf Value (var)
  OR      [EAX],  ECX

end;

procedure ClearBit(Var Value: Cardinal; BitNr: Byte);
asm
  MOV     ECX, 1

//  SHL     ECX, EDX
  PUSH    EDX
@s:
  CMP     EDX, 0
  JZ      @f
  SHL     ECX, 1
  DEC     EDX
  JMP     @s
@f:
  POP     EDX
//  SHL     ECX, EDX

  NOT     ECX
  AND     [EAX], ECX // EAX ist Pointer
end;

procedure InvertBit(var Value: Cardinal; BitNr: TBitNr);
asm
  MOV     ECX, 1

//  SHL     ECX, EDX
  PUSH    EDX
@s:
  CMP     EDX, 0
  JZ      @f
  SHL     ECX, 1
  DEC     EDX
  JMP     @s
@f:
  POP     EDX
//  SHL     ECX, EDX

  XOR     [EAX], ECX // EAX ist Pointer
end;

function InvertBit(Bit: TBit): TBit;
asm
  XOR     EAX, 1
  AND     EAX, 1
end;

function GetBit(Value: Cardinal; BitNr: Byte): TBit;
asm
  PUSH    EAX
  MOV     EAX, 1

//  SHL     EAX, EDX
  PUSH    EDX
@s:
  CMP     EDX, 0
  JZ      @f
  SHL     EAX, 1
  DEC     EDX
  JMP     @s
@f:
  POP     EDX
//  SHL     EAX, EDX

  POP     EDX
  AND     EAX, EDX
  SETNZ   AL
  MOVZX   EAX, AL
end;

function MaxBit(nBits: Byte): Cardinal;
asm
  MOV     EDX, 1
  XCHG    EAX, EDX
  
//  SHL     EAX, EDX
  PUSH    EDX
@s:
  CMP     EDX, 0
  JZ      @f
  SHL     EAX, 1
  DEC     EDX
  JMP     @s
@f:
  POP     EDX
//  SHL     EAX, EDX

  DEC     EAX
end;

function CharToBit(chr: Char): TBit;
asm
  CMP     EAX, '1'
  SETZ    AL
  MOVZX   EAX, AL
end;

function BitToChar(Bit: TBit): Char;
asm
  AND     EAX, 1
  ADD     EAX, '0'
end;

function BitToBool(Bit: TBit): Boolean;
asm
  AND     EAX, 1 //Theoretically not even needed ...
end;

function BoolToBit(Bool: Boolean): TBit;
asm
  AND     EAX, 1 //Theoretically not even needed ...
end;

function BitToStr(Bit: TBit; ReturnBoolStr: Boolean = False): String;
const
    S: array[Boolean, TBit] of string = 
        (('0''1'), ('False''True'));
begin
  Result := S[ReturnBoolStr, Bit];
end;

end.


Wenn jemand Fehler findet oder den Code Optimieren kann bitte Melden
Boldar
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 1555
Erhaltene Danke: 70

Win7 Enterprise 64bit, Win XP SP2
Turbo Delphi
BeitragVerfasst: Mo 20.10.08 22:13 
müsste man die Funktionen in Delphi nicht am besten z.B.so schreiben:
ausblenden Delphi-Quelltext
1:
function Max(nBits: Byte): LongInt;assembler;					

??
BenBE
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 8721
Erhaltene Danke: 191

Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
BeitragVerfasst: Mo 20.10.08 22:29 
Assembler ist ein Flag, was bei neueren Delphi-Versionen eh ignoriert wird.

_________________
Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1652
Erhaltene Danke: 243

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: Di 21.10.08 14:23 
Hallo,

Ich habe es jetzt etwas umgepinselt (EDIT in Freepascal 2.2.2 , das lädt nicht so elend lange ... )
math habe ich auskommentiert
significance result := Round(Power(Base, DigitNr)); wird wohl kaum jemand nutzen;

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
Unit BitOperations;

Interface

{
uses
  Math;
}

type
  TBit = 0..1;
  TBitNr = 0..31;
  TDigitNr = Type TBitNr;


//  function  Significance (DigitNr: Byte; Base: Byte): Cardinal;            overload;
  function  Significance (BitNr: Byte): Cardinal;                          overload;


  procedure SetBit       (Var Value: Cardinal; BitNr: Byte; NewBit: TBit); overload;
  procedure SetBit       (Var Value: Cardinal; BitNr: Byte);               overload;


  procedure ClearBit     (Var Value: Cardinal; BitNr: Byte);


  procedure InvertBit    (var Value: Cardinal; BitNr: TBitNr);             overload;
  function  InvertBit    (Bit: TBit): TBit;                                overload;


  function  GetBit       (Value: Cardinal; BitNr: Byte): TBit;
  function  Max          (nBits: Byte): Cardinal;


  function  CharToBit    (chr: Char): TBit;
  function  BitToChar    (Bit: TBit): Char;
  function  BitToBool    (Bit: TBit): Boolean;
  function  BoolToBit    (Bool: Boolean): TBit;
  function  BitToStr     (Bit: TBit; ReturnBoolStr: Boolean = False): String;


Implementation

{
function Significance(DigitNr: Byte; Base: Byte): Cardinal;
begin
  result := Round(Power(Base, DigitNr));
end;}



function Significance(BitNr: Byte): Cardinal;assembler;
asm
  XCHG    ECX, EAX
  MOV     EAX, 1
  SHL     EAX, CL
end;


procedure SetBit(Var Value: Cardinal; BitNr: Byte; NewBit: TBit);
begin
  Case NewBit Of
    0: CLearBit(Value,BitNr) {111101111};
    1: SetBit(Value,BitNr) {000010000};
  end;
end;


procedure SetBit(Var Value: Cardinal; BitNr: Byte);assembler;
asm
  XCHG    ECX, EDX
  MOV     EDX, 1
  SHL     EDX, CL
  OR      Dword PTR [EAX], EDX ;// Bei Var muss man ja den Wert an der gezeigten Stelle in EAX ändern)
end;


procedure ClearBit(Var Value: Cardinal; BitNr: Byte);assembler;
asm
  XCHG    ECX, EDX
  MOV     EDX, 1
  SHL     EDX, CL
  NOT     EDX
  AND     Dword PTR [EAX], EDX
end;


procedure InvertBit(var Value: Cardinal; BitNr: TBitNr);assembler;
asm
  XCHG    ECX, EDX
  MOV     EDX, 1
  SHL     EDX, CL
  XOR     DWORD Ptr[EAX], EDX
end;


function InvertBit(Bit: TBit): TBit;assembler;
asm
  XOR     EAX, 1
  AND     EAX, 1
end;


function GetBit(Value: Cardinal; BitNr: Byte): TBit;assembler;
asm
  XCHG    ECX,EDX
  MOV     EDX, 1
  SHL     EDX, CL
  AND     EAX, EDX
  SETNZ   AL
  MOVZX   EAX, AL
end;

function Max(nBits: Byte): Cardinal;assembler;
asm
  XCHG    ECX, EAX
  MOV     EAX, 1
  SHL     EAX, CL
  DEC     EAX
end;


function CharToBit(chr: Char): TBit;assembler;
asm
  CMP     EAX, '1'
  SETZ    AL
  MOVZX   EAX, AL
end;


function BitToChar(Bit: TBit): Char;assembler;
asm
  AND     EAX, 1
  ADD     EAX, '0'
end;


function BitToBool(Bit: TBit): Boolean;assembler;
asm
  AND     EAX, 1 //Theoretically not even needed ...
end;


function BoolToBit(Bool: Boolean): TBit;assembler;
asm
  AND     EAX, 1 //Theoretically not even needed ...
end;



function BitToStr(Bit: TBit; ReturnBoolStr: Boolean = False): String;
const
    S: array[Boolean, TBit] of string =
        (('0''1'), ('False''True'));
begin
  Result := S[ReturnBoolStr, Bit];
end;

end.


ein kleiner nicht umfassender Test:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
program TestBit;

uses
  BitOperations;
var
  i,j : TBitNr;
  Wert : Dword;

begin
  Wert := 0;
  //Alle Bits von hinten nach vorne setzen
  For i:= 0 to 31 do
    begin
    SetBit(Wert,i);
    write(Wert:12,'  ');
    For j := 31 downto 0 do
      write(BitToChar(Getbit(Wert,j)));
    writeln;
    end;


  //Alle Bits von hinten nach vorne wieder löschen
  For i:= 0 to 31 do
    begin
    ClearBit(Wert,i);
    write(Wert:12,'  ');
    For j := 31 downto 0 do
      write(BitToChar(Getbit(Wert,j)));
    writeln;
    end;

end.


user profile iconZyklame kann es ja mal richtig testen

Gruß Horst
EDIT2:
So richtig begeistern kann die Performance nicht, es ist einfach zuwenig Code aber dafür ein call
Es sind ja nur 3 CPU Takte
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
program TestBit;

uses
  BitOperations,sysutils;
const
  RUNDEN = 10000000;// ergibt 3.2e8 setbit/clearBit 
var
  i : TBitNr;
  k : integer;
  Wert : Dword;
  t0,t1 : tDateTime;

begin
  Wert := 0;
  t0 := time;
  For k := 1 to RUNDEN do
    For i:= 0 to 31 do
      begin
      Wert:= Wert OR (1 shl i);
      end;
  t1 := time;
  Writeln('In Pascal ',FormatDateTime(' hh:mm:ss.zzz ',t1-t0));
  t0:= t1;
  For k := 1 to RUNDEN do
    For i:= 0 to 31 do
      begin
      SetBit(Wert,i);
      end;
  t1 := time;
  Writeln('In Assembler ',FormatDateTime(' hh:mm:ss.zzz ',t1-t0));

  t0 := time;
  For k := 1 to RUNDEN do
    For i:= 0 to 31 do
      begin
      Wert:= Wert AND (NOT (1 shl i));
      end;

  t1 := time;
  Writeln('In Pascal ',FormatDateTime(' hh:mm:ss.zzz ',t1-t0));
  t0:= time;
  For k := 1 to RUNDEN do
    For i:= 0 to 31 do
      begin
      ClearBit(Wert,i);
      end;
  t1 := time;
  Writeln('In Assembler ',FormatDateTime(' hh:mm:ss.zzz ',t1-t0));

  t0:= time;
  For k := 1 to RUNDEN do
    For i:= 0 to 31 do
      begin
      wert := k;
      end;
  t1 := time;

  Writeln('Leer ',FormatDateTime(' hh:mm:ss.zzz ',t1-t0));

end.
{
Laufzeit:
setbit
In Pascal  00:00:00.969
In Assembler  00:00:00.968

clearBit
In Pascal  00:00:00.907
In Assembler  00:00:00.968

Leer  00:00:00.454


Moderiert von user profile iconmatze: Delphi-Tags hinzugefügt
Lossy eX
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1048
Erhaltene Danke: 4



BeitragVerfasst: Mi 22.10.08 11:54 
Zitat:
So richtig begeistern kann die Performance nicht, es ist einfach zuwenig Code aber dafür ein call

Also ich sehe das ähnlich. Mir persönlich stellt sich da ein bisschen die Frage warum es Assembler sein muss? Denn durch Assembler kann man zu mindest auf TurboDelphi+ wunderbar das Inline aushebeln. Dadurch, dass die Operationen nun wirklich super klein sind entsteht durch die echten Funktionsaufrufe ein recht großer Overhead. Zu mal der Kompiler bei Assemblerfunktionen die Parameter über die Register übergeben muss und die eventuell freigeräumt bzw wiederhergestellt werden müssen.

Mit Inline lässt man in diesem Fall dem Kompiler die Wahl wie er es optimieren möchte. Das könnte zum Beispiel so aussehen.
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
procedure SetBit(var Val: Cardinal; Bit: Byte); inline;
begin
  Val := Val or (1 shl Bit);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Temp: Cardinal;
begin
  Temp := 13;

  SetBit(Temp, 6);
end;

In dem Beispiel geht der Kompiler sogar her und erzeugt aus dem Aufruf "SetBit(Temp, 6);" sogar nur einen einzigen Assemblerbefehl. Und zwar, weil der zweite Parameter eine Konstante ist. Dadurch optimiert der Kompiler von sich aus (1 shl 6) zu $40. Schneller kanns nicht mehr gehen. Aber selbst wenn der Kompiler inline nicht kann sollte er die Parameter über die Register übergeben und dann wäre das Ergebniss dem der Assemblerversion sehr ähnlich. Nur mit dem Unterschied, dass es immer noch pascal ist. Damit sollte es auch mit fpc auf Anhieb klappen.

Ob es eine Procedure mit Var Parameter oder eine Funktion, dessen Ergebniss wieder auf Temp zugewiesen wird, ist dem Kompiler egal. Er sieht, dass es sich beides mal um die selbe Variable handelt und macht keinen unnützen Code rein. Also Geschmackssache bzw abhängig von Einsatz.

PS: Zyklame beim Assemblerbefehl SHL muss der zweite Parameter ein 8 Bit großes Register sein (evtl sogar direkt CL. Weiß gerade nicht genau). Das war alles was die Fehlermeldung ausgedrückt hat.

_________________
Nur die Menschheit ist arrogant genug, um zu glauben sie sei die einzige intelligente Lebensform im All. Wo nicht mal das nachhaltig bewiesen wurde.