Fonctions asm internes dans les fonctions standards

Version imprimable

Il est possible pour utiliser les fonctions asm pour creer des fonctions Delphi
si on veut _DynArrayLength doit être appeler explicitement

Code:

System.@DynArrayLength

Freemem

Code:

System.@Freemem

Petite collection:

Code:

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
function DynAddRef_V1(const AInp:string):Pointer;
asm
   JMP System.@LStrAddRef
end;
 
procedure DynRelease_V1(var P: Pointer);
asm
  JMP System.@LStrClr
end;
 
function DynLength(source:pointer):Longint;
asm
    jmp System.@DynArrayLength
end;
 
function DynCopy(a: Pointer; typeInfo: Pointer): Pointer;
asm
 {B:=Copy(A);}
 LEA  ECX,Result
 call System.@DynArrayCopy
end;
 
procedure DynClear(a: Pointer; typeInfo: Pointer);
asm
 {tab := nil }
 jmp System.@DynArrayClear
end;

petite démonstration pour copier les tableaux dynamiques

Code:

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
 
function DynCopy(a: Pointer; typeInfo: Pointer): Pointer;
asm
 {B:=Copy(A);}
 LEA  ECX,Result
 call System.@DynArrayCopy
end;
 
procedure DynClear(a: Pointer; typeInfo: Pointer);
asm
 {tab := nil }
 jmp System.@DynArrayClear
end;
 
procedure CopyArrayRec(var Dest;Source:Pointer;typeinfo:PDynArrayTypeInfo);
var
 i,Len:integer;
 Ar:array of Pointer;
begin
   if Assigned(Source)
      and Assigned(typeinfo)
        and  (typeinfo.kind = 17) then
   begin
       DynClear(@Dest,typeinfo);
       if Assigned(typeinfo.elType) then
       begin 
         Inc(PChar(typeinfo), Length(typeinfo.name));
         Len:= Pinteger(Integer(Source)-4)^ ;
         Setlength(Ar,Len);
         for i := 0 to Len-1 do
           CopyArrayRec(Ar[i],PPointerArray(Source)[i],typeinfo.elType^);
 
         Pointer(Dest):= Pointer(Ar);
         Pointer(Ar):=nil;
       end
        else
          Pointer(Dest):= DynCopy(Source,typeinfo);
  end;
end;

Utilisation

Code:

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
procedure TForm1.Button1Click(Sender: TObject);
type TNewtype= array of array of array of Word;
var
 h,k     :TNewtype;
 i,C     :integer;
 x,y,z   :integer;
 ix,iy,iz:integer;
begin
   k:=nil;
   i:=0;
   x:=2;
   y:=2;
   z:=2;
   SetLength(h,x,y,z);
   for ix := 0 to x-1 do
     for iy := 0 to y-1 do
       for iz := 0 to z-1 do
       begin
            h[ix,iy,iz]:=i;
            inc(i);
       end;
    C:=AllocMemSize;
    {Rien se passe lorsque on active cette ligne puisque }
    {le tableau est effacé avant d'etre reutiliser.}
 
    //SetLength(k,x,y,z);
    CopyArrayRec(k,H,TypeInfo(TNewtype));
 
    Showmessagefmt('Taille allouée : %d',[AllocMemSize-C]);
 
    k[1,1,1]:=133;
 
    for ix := 0 to x-1 do
     for iy := 0 to y-1 do
       for iz := 0 to z-1 do
       begin
        Showmessagefmt('%p -> %d'#10'%p -> %d',[
          @k[ix,iy,iz],k[ix,iy,iz],
          @h[ix,iy,iz],h[ix,iy,iz]
        ]);
       end;
 
end;

04/12/2009, 00h29
Nono40

Très intéressant. C'est possible à partir de quelle version de Delphi ?
Est-ce que c'est aussi possible pour les fonctions de gestion des chaines longues ?

On peut parfois gagner beaucoup sur un traitement asm sur une chaine, plutôt que le faire en Pascal.

Citation:

partir de quelle version de Delphi

désolé je ne peux rependre a cette question dans mon cas je suis sous Delphi7

Citation:

Est-ce que c'est aussi possible pour les fonctions de gestion des chaines longues ?

toute ces sont fonctions sont accessibles et plein d'autres

Code:

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
procedure _LStrClr(var S);
procedure _LStrArrayClr(var StrArray; cnt: longint);
procedure _LStrAsg(var dest; const source);
procedure _LStrLAsg(var dest; const source);
procedure _LStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
procedure _LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
procedure _LStrFromChar(var Dest: AnsiString; Source: AnsiChar);
procedure _LStrFromWChar(var Dest: AnsiString; Source: WideChar);
procedure _LStrFromPChar(var Dest: AnsiString; Source: PAnsiChar);
procedure _LStrFromPWChar(var Dest: AnsiString; Source: PWideChar);
procedure _LStrFromString(var Dest: AnsiString; const Source: ShortString);
procedure _LStrFromArray(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
procedure _LStrFromWArray(var Dest: AnsiString; Source: PWideChar; Length: Integer);
procedure _LStrFromWStr(var Dest: AnsiString; const Source: WideString);
procedure _LStrToString{(var Dest: ShortString; const Source: AnsiString; MaxLen: Integer)};
function _LStrLen(const s: AnsiString): Longint;
procedure _LStrCat{var dest: AnsiString; source: AnsiString};
procedure _LStrCat3{var dest:AnsiString; source1: AnsiString; source2: AnsiString};
procedure _LStrCatN{var dest:AnsiString; argCnt: Integer; ...};
procedure _LStrCmp{left: AnsiString; right: AnsiString};
function _LStrAddRef(var str): Pointer;
function _LStrToPChar(const s: AnsiString): PChar;
procedure _Copy{ s : ShortString; index, count : Integer ) : ShortString};
procedure _Delete{ var s : openstring; index, count : Integer };
procedure _Insert{ source : ShortString; var s : openstring; index : Integer };
procedure _Pos{ substr : ShortString; s : ShortString ) : Integer};
procedure _SetLength(s: PShortString; newLength: Byte);
procedure _SetString(s: PShortString; buffer: PChar; len: Byte);
 
 
procedure _UniqueStringA(var str: AnsiString);
procedure _UniqueStringW(var str: WideString);
 
 
procedure _LStrCopy  { const s : AnsiString; index, count : Integer) : AnsiString};
procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
procedure _LStrInsert{ const source : AnsiString; var s : AnsiString; index : Integer };
procedure _LStrPos{ const substr : AnsiString; const s : AnsiString ) : Integer};
procedure _LStrSetLength{ var str: AnsiString; newLength: Integer};
procedure _LStrOfChar{ c: Char; count: Integer): AnsiString };
function _NewAnsiString(length: Longint): Pointer;      { for debugger purposes only }
function _NewWideString(CharLength: Longint): Pointer;
 
procedure _WStrClr(var S);
procedure _WStrArrayClr(var StrArray; Count: Integer);
procedure _WStrAsg(var Dest: WideString; const Source: WideString);
procedure _WStrLAsg(var Dest: WideString; const Source: WideString);
function _WStrToPWChar(const S: WideString): PWideChar;
function _WStrLen(const S: WideString): Integer;
procedure _WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
procedure _WStrFromPWCharLen(var Dest: WideString; Source: PWideChar; CharLength: Integer);
procedure _WStrFromChar(var Dest: WideString; Source: AnsiChar);
procedure _WStrFromWChar(var Dest: WideString; Source: WideChar);
procedure _WStrFromPChar(var Dest: WideString; Source: PAnsiChar);
procedure _WStrFromPWChar(var Dest: WideString; Source: PWideChar);
procedure _WStrFromString(var Dest: WideString; const Source: ShortString);
procedure _WStrFromArray(var Dest: WideString; Source: PAnsiChar; Length: Integer);
procedure _WStrFromWArray(var Dest: WideString; Source: PWideChar; Length: Integer);
procedure _WStrFromLStr(var Dest: WideString; const Source: AnsiString);
procedure _WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
procedure _WStrCat(var Dest: WideString; const Source: WideString);
procedure _WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
procedure _WStrCatN{var dest:WideString; argCnt: Integer; ...};
procedure _WStrCmp{left: WideString; right: WideString};
function _WStrCopy(const S: WideString; Index, Count: Integer): WideString;
procedure _WStrDelete(var S: WideString; Index, Count: Integer);
procedure _WStrInsert(const Source: WideString; var Dest: WideString; Index: Integer);
procedure _WStrPos{ const substr : WideString; const s : WideString ) : Integer};
procedure _WStrSetLength(var S: WideString; NewLength: Integer);
function _WStrOfWChar(Ch: WideChar; Count: Integer): WideString;
function _WStrAddRef(var str: WideString): Pointer;
 
.....

j'avoue qu'il est difficile de travailler avec des pointeurs non typés, libérer des pointeurs par soit meme...

13/12/2009, 11h54
sjrd

Ceci existe depuis toujours (enfin Delphi 4 pour les tableaux dynamiques). J'utilise déjà ce type de techniques de manière abondante dans Sepi.

D'ailleurs j'en ai une collection un peu plus élargie ici : ScCompilerMagic.pas
J'ai aussi des routines de copies en profondeur là : ScTypInfo.pas

Les variantes pour string/PChar/etc. n'ont cependant pas d'utilité à être rendues accessibles au code Delphi. En effet, elles ne travaillent que sur un type de données, alors que les variantes pour tableaux travaillent sur une infinité de types, qu'ils discriment via le paramètre TypeInfo.
13/12/2009, 12h04
sjrd

Citation:

Envoyé par Nono40

On peut parfois gagner beaucoup sur un traitement asm sur une chaine, plutôt que le faire en Pascal.

Attention à cela. Je suppose que tu parles d'expérience, aussi je ne te contredirai pas.

Mais je ne soutiens pas du tout l'utilisation d'assembleur pour optimiser. Généralement, les goulots d'étranglements ne sont pas dans le traitement, et en plus le compilateur Delphi est un très bon compilateur, qui optimise déjà beaucoup.

Je n'utilise l'assembleur que pour faire des choses qui sont impossibles à faire avec du Delphi classique.
La seule fois où j'ai utilisé de l'assembleur pour optimiser, c'était pour profiter des instructions BT, BTS, BTC qui sont en O(1) alors que leur équivalent Delphi est O(n). Là, avec le changement de complexité, c'était vraiment utile (d'ailleurs les tests de performances étaient sans appel).
13/12/2009, 17h30
Nono40

Citation:

Envoyé par sjrd

Mais je ne soutiens pas du tout l'utilisation d'assembleur pour optimiser. Généralement, les goulots d'étranglements ne sont pas dans le traitement, et en plus le compilateur Delphi est un très bon compilateur, qui optimise déjà beaucoup.

Si tu fais une recherche sur mes messages tu veras que c'est ce que je dis tout le temps : l'asm doit toujours être la dernière étape quand on à fait tout le reste.

C'est très rare que je passe par l'assembleur pour optimiser, sauf :
- Quand je veux aller chercher les derniers cycle CPU. Delphi ne 'joue' pas avec les registres et surtout il ne joue pas avec les huit registres FPU
- Pour le faire plaisir, car j'aime bien l'asm :mrgreen:

Exemple de cas particulier ou l'asm pulvérise le Pascal :

Code:

Chaine:=StringReplace(Chaine,#13,'')

Sur un fichier d'un Mo ça prend cinq secondes.

Ca c'est instantanné :

Citation:

Function SupprimeCR(Var Debut;Longueur:Integer):Integer;Register;
// EAX : Debut
// EDX : Longueur
Asm
PUSH ESI
PUSH EDI

MOV ESI,DEBUT
MOV EDI,DEBUT
MOV ECX,EDX

XOR EDX,EDX

TEST ECX,ECX
JZ @Fin

@Retour:
LODSB
CMP AL,13
JZ @Suite
INC EDX
STOSB
@Suite:
LOOP @Retour

@Fin:
MOV EAX,EDX
POP EDI
POP ESI
End;

// Appel :

UniqueString(S);
SetLength(S,SupprimeCR(S[1],Length(S)));

Les deux lignes en Pascal je les aurait faites en Assembleur si j'avais su que c'était possible. ;)
13/12/2009, 19h42
Montor

tu fais ça pour le plaisir :calim2:

Citation:

Sur un fichier d'un Mo ça prend cinq secondes

c'est un peu lent non
tu utilise LODSB,scanb,cmpb, surtout loop qui n'a jamais était performante
14/12/2009, 08h29
Nono40

Citation:

Envoyé par Montor

tu fais ça pour le plaisir :calim2:

Pourquoi pas ?

Citation:

Envoyé par Montor

tu utilise LODSB,scanb,cmpb, surtout loop qui n'a jamais était performante

Oui, mais là ça allait assez vite, je aussi un peut feignant, donc loop est plus rapide à écrire que DEC ECX, JNZ . LOOP était déjà lent du temps du 8086, mais par contre LODSB etS STOSB étaient beaucoups plus performants que MOV AL,[ESI] INC ESI et MOV[EDI],AL INC EDI.