paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 00:59:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* leb128 support for binary writers

Browse Source 
git-svn-id: trunk@3049 -
This commit is contained in:
peter 2006-03-26 21:12:33 +00:00
parent 8a71767125
commit e7a419cbff
5 changed files with 106 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
compiler/aasmbase.pas
View File

@ -109,6 +109,8 @@ interface
function LengthUleb128(a: aword) : byte;
function LengthSleb128(a: aint) : byte;
function EncodeUleb128(a: aword;out buf) : byte;
function EncodeSleb128(a: aint;out buf) : byte;
implementation
@ -133,15 +135,10 @@ implementation
function LengthUleb128(a: aword) : byte;
var
b: byte;
begin
result:=0;
repeat
b := a and $7f;
a := a shr 7;
if a<>0 then
b := b or $80;
inc(result);
if a=0 then
break;
@ -152,6 +149,7 @@ implementation
function LengthSleb128(a: aint) : byte;
var
b, size: byte;
asign : aint;
neg, more: boolean;
begin
more := true;
@ -162,7 +160,67 @@ implementation
b := a and $7f;
a := a shr 7;
if neg then
a := a or -(1 shl (size - 7));
begin
{ Use a variable to be sure that the correct or mask is generated }
asign:=1;
asign:=asign shl (size - 7);
a := a or -asign;
end;
if (((a = 0) and
(b and $40 = 0)) or
((a = -1) and
(b and $40 <> 0))) then
more := false;
inc(result);
if not(more) then
break;
until false;
end;
function EncodeUleb128(a: aword;out buf) : byte;
var
b: byte;
pbuf : pbyte;
begin
result:=0;
pbuf:=@buf;
repeat
b := a and $7f;
a := a shr 7;
if a<>0 then
b := b or $80;
pbuf^:=b;
inc(pbuf);
inc(result);
if a=0 then
break;
until false;
end;
function EncodeSleb128(a: aint;out buf) : byte;
var
b, size: byte;
asign : aint;
neg, more: boolean;
pbuf : pbyte;
begin
more := true;
neg := a < 0;
size := sizeof(a)*8;
result:=0;
pbuf:=@buf;
repeat
b := a and $7f;
a := a shr 7;
if neg then
begin
{ Use a variable to be sure that the correct or mask is generated }
asign:=1;
asign:=asign shl (size - 7);
a := a or -asign;
end;
if (((a = 0) and
(b and $40 = 0)) or
((a = -1) and
@ -170,6 +228,7 @@ implementation
more := false
else
b := b or $80;
pbuf^:=b;
inc(result);
if not(more) then
break;

6
compiler/aasmtai.pas
View File

@ -1306,6 +1306,12 @@ implementation
aitconst_indirect_symbol,
aitconst_rva_symbol :
result:=sizeof(aint);
aitconst_uleb128bit :
result:=LengthUleb128(value);
aitconst_sleb128bit :
result:=LengthSleb128(value);
else
internalerror(200603253);
end;
end;

53
compiler/aggas.pas
View File

@ -328,48 +328,31 @@ implementation
procedure TGNUAssembler.WriteDecodedUleb128(a: aword);
var
b: byte;
i,len : longint;
buf : array[0..63] of byte;
begin
repeat
b := a and $7f;
a := a shr 7;
if (a <> 0) then
b := b or $80;
AsmWrite(tostr(b));
if (a <> 0) then
AsmWrite(',')
else
break;
until false;
len:=EncodeUleb128(a,buf);
for i:=0 to len-1 do
begin
if (i > 0) then
AsmWrite(',');
AsmWrite(tostr(buf[i]));
end;
end;
procedure TGNUAssembler.WriteDecodedSleb128(a: aint);
var
b, size: byte;
neg, more: boolean;
i,len : longint;
buf : array[0..255] of byte;
begin
more := true;
neg := a < 0;
size := sizeof(a)*8;
repeat
b := a and $7f;
a := a shr 7;
if (neg) then
a := a or -(1 shl (size - 7));
if (((a = 0) and
(b and $40 = 0)) or
((a = -1) and
(b and $40 <> 0))) then
more := false
else
b := b or $80;
AsmWrite(tostr(b));
if (more) then
AsmWrite(',')
else
break;
until false;
len:=EncodeSleb128(a,buf);
for i:=0 to len-1 do
begin
if (i > 0) then
AsmWrite(',');
AsmWrite(tostr(buf[i]));
end;
end;

16
compiler/assemble.pas
View File

@ -1053,6 +1053,8 @@ Implementation
{$endif x86}
objsym,
objsymend : TObjSymbol;
leblen : byte;
lebbuf : array[0..63] of byte;
begin
inlinelevel:=0;
{ main loop }
@ -1123,6 +1125,18 @@ Implementation
end;
aitconst_rva_symbol :
ObjData.writereloc(Tai_const(hp).value,sizeof(aint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
aitconst_uleb128bit :
begin
leblen:=EncodeUleb128(Tai_const(hp).value,lebbuf);
ObjData.writebytes(lebbuf,leblen);
end;
aitconst_sleb128bit :
begin
leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
ObjData.writebytes(lebbuf,leblen);
end;
else
internalerror(200603254);
end;
end;
ait_label :
@ -1354,8 +1368,6 @@ Implementation
to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
if usedeffileforexports then
exclude(to_do,al_exports);
{$warning TODO internal writer support for dwarf}
exclude(to_do,al_dwarf);
if not(tf_section_threadvars in target_info.flags) then
exclude(to_do,al_threadvars);
for i:=low(TasmlistType) to high(TasmlistType) do

6
compiler/ogelf.pas
View File

@ -1181,7 +1181,7 @@ implementation
asmbin : '';
asmcmd : '';
supported_target : system_any; //target_i386_linux;
flags : [af_outputbinary,af_smartlink_sections];
flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
labelprefix : '.L';
comment : '';
);
@ -1195,7 +1195,7 @@ implementation
asmbin : '';
asmcmd : '';
supported_target : system_any; //target_i386_linux;
flags : [af_outputbinary,af_smartlink_sections];
flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
labelprefix : '.L';
comment : '';
);
@ -1210,7 +1210,7 @@ implementation
asmcmd : '';
supported_target : system_any; //target_i386_linux;
// flags : [af_outputbinary,af_smartlink_sections];
flags : [af_outputbinary];
flags : [af_outputbinary,af_supports_dwarf];
labelprefix : '.L';
comment : '';
);