[Delphi] Optimierung PAnsiChar->LowerCase-String

Flamefire · Verfasst: Mo 21.03.11 00:11 Verwendete Sprache: Delphi

Ich habe eine Umwandlung von einem Array[n] of Char (0-Terminiert bzw bis zur max. Länge ausgefüllt) zu einem String. Danach muss das ganze noch in Kleinbuchstaben umgewandelt werden.
1. Ansatz:

Delphi-Quelltext

markieren

1:	LowerCase(String(AnsiString(PAnsiChar(@sIn[1]))))

Das dauert aber auch etwas. Da es sehr oft gemacht werden muss, will ich das optimieren:

Delphi-Quelltext

markieren

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:

function SmallString2String(const sIn:TSmallString):String;
var pC:PAnsiChar;
    i{,l}:Integer;
    pC2:PChar;
begin
  SetLength(Result,Length(sIn));
  pC:=@sIn[1];
  pC2:=@Result[1];
  while(pC^<>#0) do begin
    if(pC^>='A') and (pC^<='Z') then pC2^:=Char(Ord(pC^)+$20)
    else pC2^:=Char(pC^);
    Inc(pC); Inc(pC2);
    if(Cardinal(pC)>Cardinal(@sIn[High(sIn)])) then break;
  end;
  //l:=Cardinal(pC)-Cardinal(@sIn[1]);
  SetLength(Result,Cardinal(pC)-Cardinal(@sIn[1]));
  {if(l>0) then begin
    pC:=@sIn[1];
    pC2:=@Result[1];
    for i := 1 to l do begin
      pC2^:=Char(pC^);
      Inc(pC); Inc(pC2);
    end;
  end;}
end;

So siehts bisher aus (sind 2 Versuche in einem, nehmen sich beide nix)
Damit ist das ganze ca. 10% schneller.
Hat da noch jemand Ideen für optimierungen?

alzaimar · Verfasst: Mo 21.03.11 06:18

Zeichenumwandungen würde ich über ein Array implementieren, dann spart man sich Vergleiche:

Delphi-Quelltext

markieren

1:
2:
3:

// LowerCaseLookup['A'] := 'a'; usw.

LowerCaseOfChar := LowerCaseLookup[MyChar];

_________________
Na denn, dann. Bis dann, denn.

Tryer · Beiträge: 226 Erhaltene Danke: 7

Einmal mit einer Vergleichstabelle (look-up table) gemacht brauchst du später nur daraus zu kopieren und auf #0 zu vergleichen.

[EDIT] zu langsam..[/EDIT]
Grüsse,
Dirk

jaenicke · Verfasst: Mo 21.03.11 06:38

Am meisten Zeit kostet hier zusätzlich die if-Abfrage innerhalb der Schleife (ca. 10%). Die kann man sich auch komplett sparen. Kombiniert mit der bereits genannten Lookuptabelle, die ca. 20% bringt, sieht das dann so aus:

Delphi-Quelltext

markieren

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:

const
  CharTable: array [0 .. 255] of Char = (#0, #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, #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, #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, #208, #209, #210, #211, #212, #213, #214,
    #215, #216, #217, #218, #219, #220, #221, #222, #223, #224, #225, #226,
    #227, #228, #229, #230, #231, #232, #233, #234, #235, #236, #237, #238,
    #239, #240, #241, #242, #243, #244, #245, #246, #247, #248, #249, #250,
    #251, #252, #253, #254, #255);

function SmallString2String(const Value: TSmallString): String;
var
  CurSource, EndChar: PAnsiChar;
  CurDest: PChar;
begin
  SetLength(Result, Length(Value));
  CurSource := @Value[Low(Value)];
  EndChar := CurSource + Length(Value);
  CurDest := @Result[1];
  while (CurSource < EndChar) do
  begin
    CurDest^ := CharTable[Ord(CurSource^)];
    Inc(CurSource);
    Inc(CurDest);
  end;
end;

Das SetLength am Ende kannst du dir ebenfalls sparen, denn die Zeichenanzahl kann sich ja wohl schlecht verändern. :gruebel:

// EDIT:
Wow, der generierte Assemblercode ist ja... suboptimal um es vorsichtig auszudrücken...
Dieser Code braucht noch ca. ein Sechstel der optimierten Variante und ein Neuntel der ursprünglichen Version... (sollte funktionieren mit Delphi 2009+)

Delphi-Quelltext

markieren

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:

function SmallString2String(const Value: TSmallString): String;
// define PUREPASCAL to prevent usage of the assembler version
var
  CurSource, EndChar: PAnsiChar;
  CurDest: PChar;
begin
  SetLength(Result, Length(Value));
  CurSource := @Value[Low(Value)];
  EndChar := CurSource + Length(Value);
  CurDest := @Result[1];
{$ifndef UNICODE}
{$define INT_PUREPASCAL}
{$endif}
{$ifdef PUREPASCAL}
{$define INT_PUREPASCAL}
{$endif}
{$ifdef INT_PUREPASCAL}
  while (CurSource < EndChar) do
  begin
    CurDest^ := CharTable[Ord(CurSource^)];
    Inc(CurSource);
    Inc(CurDest);
  end;
{$else}
  asm
    push eax // --> calculate from lookup
    push ecx // --> pointer to current source
    push edx // --> pointer to current destination
    mov edx,CurDest
    mov ecx,CurSource
    cmp ecx,EndChar
    jnb @@end
    @@start:
    movzx eax,[ecx]
    mov ax,[eax*2+CharTable]
    mov [edx],ax
    inc dword ptr ecx
    add dword ptr edx,$02
    cmp ecx,EndChar
    jb @@start
    @@end:
    pop edx
    pop ecx
    pop eax
  end;
{$endif}
end;

Wobei Assemblercode natürlich ein Problem bei der Umstellung auf 64-Bit ab XE 2 ist, deshalb das ifdef.

// EDIT2:
Übrigens ist bei Delphi 2006 der generierte Assemblercode noch sehr gut, der ist kaum langsamer als die selbst in Assembler geschriebene Version in XE (die ist dabei nur ca. 30% schneller, aber damit braucht die Pascal-D2006-Version von Hause aus ca. 25% der Pascal-XE-Version). Dementsprechend geändert, so läuft es jetzt erstens überall und zweitens überall schnell.

Horst_H · Verfasst: Mo 21.03.11 09:25

Hallo,

Zitat:

Ich habe eine Umwandlung von einem Array[n] of Char (0-Terminiert bzw bis zur max. Länge ausgefüllt) zu einem String. Danach muss das ganze noch in Kleinbuchstaben umgewandelt werden.

Heisst das, dass die Strings wegen mir eine maximal Länge von k Zeichen haben und nur dann Nullterminiert sind, wenn sie kürzer als k sind?
Dann wären es keine echten pChar-Strings, da ist Ärger vorprogrammiert oder ist die Funktion length überladen für den Typ sIn:TSmallstring ?

Delphi-Quelltext

markieren

1:	SetLength(Result,Length(sIn));

Liegen die Ausgangsstrings in einem derartigem Array?

Delphi-Quelltext

markieren

1:
2:
3:
4:
5:

const 
 MAXLAENGE = 15;
type
  tSmallString = array[0..MAXLAENGE-1] of char;
  tAlleStrings = array of tSmallString;

Gruß Horst

Flamefire · Verfasst: Mo 21.03.11 11:43

Ja ist richtig. Das Array hat eine feste Länge (darum auch die Bedingung in der Schleife so, ist damit eine Konstante und so genau das gleiche wie wenn man die vorher festlegt)
Damit kann sich die Zeichenzahl ändern und ich brauche das SetLength und die überprüfung auf 0 in der Schleife.
Habe das jetzt mit der LookupTabelle gemacht, ist aber nicht wirklich schneller als ohne.

jaenicke · Verfasst: Mo 21.03.11 13:20

Du solltest vielleicht das Konzept überdenken... mal mit und mal ohne Endzeichen und dann noch feste Arrays, aua... Nun gut, du kannst es einmal so testen:

Delphi-Quelltext

markieren

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:

function SmallString2String(const Value: TSmallString): String;
// define PUREPASCAL to prevent usage of the assembler version
var
  CurSource, EndChar: PAnsiChar;
  CurDest: PChar;
begin
  SetLength(Result, Length(Value));
  CurSource := @Value[Low(Value)];
  EndChar := CurSource + Length(CurSource);
  CurDest := @Result[1];
{$ifndef UNICODE}
{$define INT_PUREPASCAL}
{$endif}
{$ifdef PUREPASCAL}
{$define INT_PUREPASCAL}
{$endif}
{$ifdef INT_PUREPASCAL}
  while (CurSource < EndChar) do
  begin
    CurDest^ := CharTable[Ord(CurSource^)];
    Inc(CurSource);
    Inc(CurDest);
  end;
{$else}
  asm
    push eax // --> calculate from lookup
    push ecx // --> pointer to current source
    push edx // --> pointer to current destination
    mov edx,CurDest
    mov ecx,CurSource
    cmp ecx,EndChar
    jnb @@end
    @@start:
    movzx eax,[ecx]
    mov ax,[eax*2+CharTable]
    mov [edx],ax
    inc dword ptr ecx
    add dword ptr edx,$02
    cmp ecx,EndChar
    jb @@start
    @@end:
    pop edx
    pop ecx
    pop eax
  end;
{$endif}
end;

Ich bin gerade bei der Arbeit, deshalb kann ich gerade nicht nach der Assemblervariante schauen, aber die wäre selbst mit der Prüfung deutlich schneller.

Horst_H · Verfasst: Mo 21.03.11 14:13

Hallo,

anbei mal ein Versuch mit 10 Millionen Strings der Länge 50 ;-)

Delphi-Quelltext

markieren

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:

program Project1;
// Delphi 7
{$APPTYPE CONSOLE}

uses
  SysUtils;
const
  MAXLAENGE = 50;
  N = 10000000;
type
  tSmallString = array[1..MAXLAENGE] of AnsiChar;

var
  EingabeFeld : array of tSmallString;
  AusgabeStrings : array of String;
  TestString : tSmallString;

  i : integer;
  T1,T0 : TDateTime;

procedure ToLower;
var
   p0 : pAnsiChar;
   pOut  :pWideChar;
   i,le: integer;
begin
  p0 := @EingabeFeld[0][1];
for i := 0 to N-1 do
  begin
  // Laenge bestimmen und to Lower case
  le := 0;
  repeat  // MAXLAENGE > 0 oder nicht?
    IF p0[le] = #0 then
      break;
    // To Lower 
    IF p0[le] in ['A'..'Z'] then
      p0[le] := CHR(ORD(p0[le]) OR BYTE(32) );
    inc(le);
  until le= MAXLAENGE;
  // Kopieren
  IF le > 0 then
    begin
    setlength(AusgabeStrings[i],2*le);
    pOut := @AusgabeStrings[i][1];
    repeat
      dec(le);
      pOut[le] := widechar(p0[le]);
    until Le <= 0 ;
    end;
  inc(p0,MAXLAENGE);
  end;
end;

begin
setlength(EingabeFeld,N);
setlength(AusgabeStrings,N);

// TestString maximaler Laenge
For i := Low(TestString) to high(TestString) do
  Teststring[i] := CHR(ORD('A')+i-Low(TestString));
// Eine Begrenzung einfuegen
//Teststring[8 {high(TestString)}] := #0;

T0 := time;
For i := 0 to N-1 do
  EingabeFeld[i] := TestString;
T1 := time;
writeln(EingabeFeld[0]);
Writeln(' Init    ',FormatDateTime(' HH:NN:SS.ZZZ',T1-T0));

T0 := time;
ToLower;
T1 := time;
Writeln(' toLower ',FormatDateTime(' HH:NN:SS.ZZZ',T1-T0));
writeln(EingabeFeld[0]);
writeln(AusgabeStrings[0]);
writeln(EingabeFeld[high(EingabeFeld)]);
writeln(AusgabeStrings[High(EingabeFeld)]);

readln;

end.
{Ausgabe:
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqr
 Init     00:00:00.277
 toLower  00:00:02.299
abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqr
a b c d e f g h i j k l m n o p q r s t u v w x y z [ \ ] ^ _ ` a b c d e f g h
i j k l m n o p q r
abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqr
a b c d e f g h i j k l m n o p q r s t u v w x y z [ \ ] ^ _ ` a b c d e f g h
i j k l m n o p q r
}

Ich habe keinen Ahnung, wie hoch die Ausgangsgeschwindigkeit war.
500 Mb werden zu 1 Gb umgewandelt in 2,3 Sekunden. bei 2,9 Ghz sind das 667 Takte pro String , wer weiss wie lange setlength braucht?

Gruß Horst
EDIT:
Setlenght auf 2*MAXLAENGE dauerte 1,078 Sekunden ...also 1,078*2,9e9/ 10e6 ~ 313 Takte, also fast die Hälfte der Zeit.
Man sollte mal random Strings nehmen 26 mal umwandeln gefolgt von 24 mal nicht umwandeln verbessert die Sprungvorhersage.
So sind es 7 Takte pro Zeichen.

Flamefire · Verfasst: Mo 21.03.11 14:21

@jaenicke: kann nix dafür. Ich lese aus einem Archiv, und dessen Format ist fest...

jaenicke · Verfasst: Mo 21.03.11 15:08

Schlag den Urheber des Formats. :mrgreen:

Ok, versuchs einmal so, nur schnell im Editor hier geschrieben und ungetestet:

Delphi-Quelltext

markieren

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:

function SmallString2String(const Value: TSmallString): String;
// define PUREPASCAL to prevent usage of the assembler version
var
  CurSource, EndChar: PAnsiChar;
  CurDest: PChar;
  SourceLen: Integer;
begin
  CurSource := @Value[Low(Value)];
  SourceLen := StrLen(CurSource);
  if (SourceLen < 0) or (SourceLen > High(Value)) then
    SourceLen := High(Value) + 1;
  SetLength(Result, SourceLen);
  EndChar := CurSource + SourceLen;
  CurDest := @Result[1];
{$ifndef UNICODE}
{$define INT_PUREPASCAL}
{$endif}
{$ifdef PUREPASCAL}
{$define INT_PUREPASCAL}
{$endif}
{$ifdef INT_PUREPASCAL}
  while (CurSource < EndChar) do
  begin
    CurDest^ := CharTable[Ord(CurSource^)];
    Inc(CurSource);
    Inc(CurDest);
  end;
{$else}
  asm
    push eax // --> calculate from lookup
    push ecx // --> pointer to current source
    push edx // --> pointer to current destination
    mov edx,CurDest
    mov ecx,CurSource
    cmp ecx,EndChar
    jnb @@end
    @@start:
    movzx eax,[ecx]
    jz @@end
    mov ax,[eax*2+CharTable]
    mov [edx],ax
    inc dword ptr ecx
    add dword ptr edx,$02
    cmp ecx,EndChar
    jb @@start
    @@end:
    mov CurSource,ecx
    pop edx
    pop ecx
    pop eax
  end;
{$endif}
  SetLength(Result, CurSource - @Value[Low(Value)]);
end;

Sonst warte bis heute Abend, dann schreibe ich das noch einmal richtig hin...

Horst_H · Verfasst: Di 22.03.11 00:36

Hallo,
eine andere Variante von SmallString2String.
Delphi7 "versteht" kein UniCode. Widestring dauert ewig 26 Sekunden.
Aber testweise in Freepascal ist es doch mit 2,3 Sekunden schnell genug, oder nicht?
Etwas ist aegerlich

Delphi-Quelltext

markieren

1:
2:
3:

// Ersetzt asm   call    fpc_char_to_uchar
//    pOut[le] := WideChar(p0[le])
      pOut[le] := WideChar(Ord(p0[le]) OR $00);

fpc_char_to_uchar braucht kleine Ewigkeiten.
pOut[le] := WideChar(Ord(p0[le]) OR $00)
wird zu

Delphi-Quelltext

markieren

1:
2:
3:

asm
  movzbl  (%esi,%edx,1),%eax
  movw  %ax,(%ebx,%edx,2)

Delphi-Quelltext

markieren

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:

program Project2;
{$APPTYPE CONSOLE}
{$IFDEF FPC}
  {$MODE Delphi}
  {$OPTIMIZATION ON}
  {$OPTIMIZATION REGVAR}
  {$OPTIMIZATION PEEPHOLE}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
{$ENDIF}
uses
  SysUtils;

const

  CharTable: array [0 .. 255] of WideChar = (#0, #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, #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, #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, #208, #209, #210, #211, #212, #213, #214,
    #215, #216, #217, #218, #219, #220, #221, #222, #223, #224, #225, #226,
    #227, #228, #229, #230, #231, #232, #233, #234, #235, #236, #237, #238,
    #239, #240, #241, #242, #243, #244, #245, #246, #247, #248, #249, #250,
    #251, #252, #253, #254, #255);

  MAXLAENGE = 50;
  N = 10000000;

type
  tSmallString = array[1..MAXLAENGE] of AnsiChar;

var
  EingabeFeld : array of tSmallString;
  AusgabeStrings : array of UniCodeString;
  TestString : tSmallString;

  i : integer;
  T1,T0 : TDateTime;

function SmallString2String(const sIn:TSmallString):UniCodeString;
var
  Scratch : array[0..MAXLAENGE-1] of widechar;
  pC :PAnsiChar;
  PD :pWideChar;
  i:Integer;
begin
  pC:=@sIn[1];
  pD := @Scratch[0];
  fillChar(Scratch[0],SizeOf(Scratch),0);
  i := 0;
  while(pC[i]<>#0) AND (i < MAXLAENGE) do
    begin
    pD[i] := CharTable[ord(pC[i])];
    Inc(i);
    end;
  setlength(Result,i);
  MOVE(scratch[0],Result[1],2*i);
end;

{ Assemblerausgabe
P$PROJECT2_SMALLSTRING2STRING$TSMALLSTRING$$UNICODESTRING:
# Temps allocated between esp+104 and esp+112
# [Project3.dpr]
# [58] begin
  subl  $112,%esp
# Var sIn located in register eax
# Var pC located in register esi
# Var PD located in register ebx
# Var i located in register ebx
  movl  %ebx,104(%esp)
  movl  %esi,108(%esp)
# Var $result located at esp+0
# Var Scratch located at esp+4
  movl  %edx,(%esp)
# [59] pC:=@sIn[1];
  movl  %eax,%esi
# [60] pD := @Scratch[0];
  leal  4(%esp),%ebx
# [61] fillChar(Scratch[0],SizeOf(Scratch),0);
  movl  %ebx,%eax
  movb  $0,%cl
  movl  $100,%edx
  call  SYSTEM_FILLCHAR$formal$LONGINT$BYTE
# [62] i := 0;
  movl  $0,%edx
# [63] while(pC[i]<>#0) AND (i < MAXLAENGE) do
  jmp  .Lj18
  .balign 4,0x90
.Lj17:
# [65] pD[i] := CharTable[ord(pC[i])];
  movzbl  (%esi,%edx,1),%eax
  movw  TC_P$PROJECT2_CHARTABLE(,%eax,2),%ax
  movw  %ax,(%ebx,%edx,2)
# [66] Inc(i);
  incl  %edx
.Lj18:
  movb  (%esi,%edx,1),%al
  testb  %al,%al
  je  .Lj19
  cmpl  $50,%edx
  jl  .Lj17
.Lj19:
# [68] setlength(Result,i);
  movl  %edx,%ebx
  movl  (%esp),%eax
  call  fpc_unicodestr_setlength
# [69] MOVE(scratch[0],Result[1],2*i);
  movl  (%esp),%eax
  call  fpc_unicodestr_unique
  movl  %eax,%edx
  movl  %ebx,%ecx
  shll  $1,%ecx
  leal  4(%esp),%eax
  call  SYSTEM_MOVE$formal$formal$LONGINT
# [70] end;
  movl  104(%esp),%ebx
  movl  108(%esp),%esi
  addl  $112,%esp
  ret

}

begin
setlength(EingabeFeld,N);
setlength(AusgabeStrings,N);

// TestString maximaler Laenge
For i := Low(TestString) to high(TestString) do
  Teststring[i] := CHR(ORD('A')+i-Low(TestString));
// Eine Begrenzung einfuegen
//Teststring[high(TestString)] := #0;

T0 := time;
For i := 0 to N-1 do
  EingabeFeld[i] := TestString;
T1 := time;
writeln(EingabeFeld[0]);
Writeln(' Init        ',FormatDateTime(' HH:NN:SS.ZZZ',T1-T0));

For i := 0 to N-1 do
  EingabeFeld[i] := TestString;

T0 := time;
For i := 0 to N-1 do
  AusgabeStrings[i] := SmallString2String(EingabeFeld[i]);
T1 := time;

Writeln(' toLowString ',FormatDateTime(' HH:NN:SS.ZZZ',T1-T0));
writeln(EingabeFeld[0]);
writeln(AusgabeStrings[0]);
writeln(EingabeFeld[high(EingabeFeld)]);
writeln(AusgabeStrings[High(EingabeFeld)]);
writeln('Fertig');
readln;

end.
{Freepascal 2.4.2
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqr
 Init         00:00:00.235
 toLowString  00:00:02.330
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqr
abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqr
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqr
abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqr
Fertig}

Gruß Horst

Horst_H · Verfasst: Di 22.03.11 09:06

Hallo,

durch die Umstellung auf die Tabelle fiel ja einiges weg und fillchar wird nicht mehr benötigt.
Das spart aber nur 6% . 2,17 war das schnellste statt 2,3 Sekunden.

Delphi-Quelltext

markieren

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

function SmallString2String(const sIn:TSmallString):UniCodeString;
var
  Scratch : array[0..MAXLAENGE-1] of widechar;
  pC :PAnsiChar;
  PD :pWideChar;
  i:Integer;
begin
  pC:=@sIn[1];
  pD := @Scratch[0];
  i := 0;
  while(pC[i]<>#0) AND (i < MAXLAENGE) do
    begin
    pD[i] := CharTable[ord(pC[i])];
    Inc(i);
    end;
  setlength(Result,i);
  MOVE(scratch[0],Result[1],2*i);
end;

Gruß Horst

EDIT:
Jetzt weiß ich, warum Delhi7 bei der Verwendung von widestrings so lange braucht.

Delphi-Quelltext

markieren

1:	AusgabeStrings[i] := SmallString2String(EingabeFeld[i]);

Bei der Zuweisung wandert Delphi durch RTL-critical section und sonstwo noch lang. ( callWStrAsg ...)
Es dauert dann die besagten 26 bzw jetzt 20 Sekunden.
Der Aufruf ohne Zuweisung

Delphi-Quelltext

markieren

1:	SmallString2String(EingabeFeld[i]);

dauert nur 3 Sekunden.

jaenicke · Verfasst: Di 22.03.11 09:33

Es geht ja wohl ohnehin nicht um Delphi 7, sondern um Delphi 2009.

Der Grund ist, dass WideStrings von Windows via COM verwaltet werden. Das ist natürlich langsamer als eine native Lösung wie ab Delphi 2009.

Horst_H · Verfasst: Di 22.03.11 12:52

Hallo,

da muss Flamefire wissen, was er will.
Mit Freepascal ist diese Version bei mir am schnellsten.Auch damit ist UniCode schneller als widestring.

Delphi-Quelltext

markieren

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:

function SmallString2StringII(const sIn:TSmallString):UniCodeString;
var
  pC :PAnsiChar;
  PD :pUniCodeChar;
  i  :Integer;
begin
  pC:=@sIn[1];
  i := 0;
  repeat
    IF pC[i] = #0 then
      break;
    inc(i);
  until i = MAXLAENGE;
  
  IF i >0 then
    begin
    setlength(result,i);      
    pD := @result[1];  
    dec(i);
    repeat
      pD[i] := CharTable[ord(pC[i])];
      dec(i);
    until i< 0;
  end;
end;
Asm // sieht dann so aus.
P$PROJECT2_SMALLSTRING2STRINGII$TSMALLSTRING$$UNICODESTRING:
# Temps allocated between esp+4 and esp+12
# [120] begin
  subl  $12,%esp
# Var sIn located in register ebx
# Var pC located in register ebx
# Var PD located in register eax
# Var i located in register esi
  movl  %ebx,4(%esp)
  movl  %esi,8(%esp)
# Var $result located at esp+0
  movl  %eax,%ebx
  movl  %edx,(%esp)
# [122] i := 0;
  movl  $0,%esi
  .balign 4,0x90
.Lj35:
# [124] IF pC[i] = #0 then
  movb  (%ebx,%esi,1),%al
  testb  %al,%al
  je  .Lj37
# [126] inc(i);
  incl  %esi
# [127] until i = MAXLAENGE;
  cmpl  $50,%esi
  jne  .Lj35
.Lj37:
# [129] IF i >0 then
  testl  %esi,%esi
  jng  .Lj41
# [131] setlength(result,i);
  movl  %esi,%edx
  movl  (%esp),%eax
  call  fpc_unicodestr_setlength
# [132] pD := @result[1];
  movl  (%esp),%eax
  movl  (%eax),%eax
# [133] dec(i);
  decl  %esi
  .balign 4,0x90
.Lj48:
# [135] pD[i] := CharTable[ord(pC[i])];
  movzbl  (%ebx,%esi,1),%edx
  movw  TC_P$PROJECT2_CHARTABLE(,%edx,2),%dx
  movw  %dx,(%eax,%esi,2)
# [136] dec(i);
  decl  %esi
# [137] until i< 0;
  testl  %esi,%esi
  jnl  .Lj48
.Lj41:
# [139] end;
  movl  4(%esp),%ebx
  movl  8(%esp),%esi
  addl  $12,%esp
  ret

Jaenicke's Version ist minimal schneller mit strlen, aber wenn sehr viele Eingangsstrings die Länge voll ausschöpfen sucht er ja ewig die erste #0, das erscheint mir nicht koscher

Gruß Horst

Flamefire · Verfasst: Di 22.03.11 13:16

Da es unwahrscheinlich ist, dass die Namen die volle Länge nutzen ist die Variante von jaenicke die schnellste. Ok danke.
Einziger Punkt noch: Was ist wenn er doch mal die volle Länge nutzt und dahinter erst viel später eine 0 kommt? Kann es da zu Problemen kommen?

jaenicke · Verfasst: Di 22.03.11 14:43

Das ist eigentlich nur ein weiterer Vergleich, ich bin gestern Abend nur nicht dazu gekommen. Ich wollte das noch komplett als Assembler umsetzen, dann geht es ohnehin am schnellsten.

Die Variante mit StrLen sollte immer gehen, ist aber auch wohl langsamer. Hier bietet sich stattdessen repne scasb in Assembler an.


Delphi-Forum.de	Delphi-Library.de
C-Sharp-Forum.de	C-Sharp-Library.de