diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index 4ce1572fa2..bf60d3587b 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -653,6 +653,9 @@ interface symofs, value : int64; consttype : taiconst_type; + { sleb128 and uleb128 values have a varying length, by calling FixSize their size can be fixed + to avoid that other offsets need to be changed. The value to write is stored in fixed_size } + fixed_size : byte; { we use for the 128bit int64/qword for now because I can't imagine a case where we need 128 bit now (FK) } constructor Create(_typ:taiconst_type;_value : int64); @@ -707,6 +710,9 @@ interface procedure derefimpl;override; function getcopy:tlinkedlistitem;override; function size:longint; + { sleb128 and uleb128 values have a varying length, by calling FixSize their size can be fixed + to avoid that other offsets need to be changed. The value to write is stored in fixed_size } + Procedure FixSize; end; { floating point const } @@ -2002,9 +2008,31 @@ implementation else result:=sizeof(pint); aitconst_uleb128bit : - result:=LengthUleb128(qword(value)); + begin + if fixed_size>0 then + result:=fixed_size + else if sym=nil then + begin + FixSize; + result:=fixed_size; + end + else + { worst case } + result:=sizeof(pint)+2; + end; aitconst_sleb128bit : - result:=LengthSleb128(value); + begin + if fixed_size>0 then + result:=fixed_size + else if sym=nil then + begin + FixSize; + result:=fixed_size; + end + else + { worst case } + result:=sizeof(pint)+2; + end; aitconst_half16bit, aitconst_gs: result:=2; @@ -2024,6 +2052,19 @@ implementation end; + procedure tai_const.FixSize; + begin + case consttype of + aitconst_uleb128bit: + fixed_size:=LengthUleb128(qword(value)); + aitconst_sleb128bit: + fixed_size:=LengthSleb128(value); + else + Internalerror(2019030301); + end; + end; + + {**************************************************************************** TAI_realconst ****************************************************************************} diff --git a/compiler/aggas.pas b/compiler/aggas.pas index 2cdc826645..8b0cd7579e 100644 --- a/compiler/aggas.pas +++ b/compiler/aggas.pas @@ -1,4 +1,4 @@ -{ + { Copyright (c) 1998-2006 by the Free Pascal team This unit implements the generic part of the GNU assembler @@ -586,7 +586,7 @@ implementation i,len : longint; buf : array[0..63] of byte; begin - len:=EncodeUleb128(a,buf); + len:=EncodeUleb128(a,buf,0); for i:=0 to len-1 do begin if (i > 0) then @@ -634,7 +634,7 @@ implementation i,len : longint; buf : array[0..255] of byte; begin - len:=EncodeSleb128(a,buf); + len:=EncodeSleb128(a,buf,0); for i:=0 to len-1 do begin if (i > 0) then diff --git a/compiler/assemble.pas b/compiler/assemble.pas index 1d5a7320a7..892c38e4a1 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -1767,6 +1767,8 @@ Implementation else Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; end; + if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then + Tai_const(hp).fixsize; ObjData.alloc(tai_const(hp).size); end; ait_section: @@ -2035,11 +2037,13 @@ Implementation aitconst_uleb128bit, aitconst_sleb128bit : begin + if Tai_const(hp).fixed_size=0 then + Internalerror(2019030302); if tai_const(hp).consttype=aitconst_uleb128bit then - leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf) + leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf,Tai_const(hp).fixed_size) else - leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf); - if leblen<>tai_const(hp).size then + leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf,Tai_const(hp).fixed_size); + if leblen<>tai_const(hp).fixed_size then internalerror(200709271); ObjData.writebytes(lebbuf,leblen); end; diff --git a/compiler/cutils.pas b/compiler/cutils.pas index 5978828aca..415dd3e867 100644 --- a/compiler/cutils.pas +++ b/compiler/cutils.pas @@ -182,8 +182,8 @@ interface function LengthUleb128(a: qword) : byte; function LengthSleb128(a: int64) : byte; - function EncodeUleb128(a: qword;out buf) : byte; - function EncodeSleb128(a: int64;out buf) : byte; + function EncodeUleb128(a: qword;out buf;len: byte) : byte; + function EncodeSleb128(a: int64;out buf;len: byte) : byte; { hide Sysutils.ExecuteProcess in units using this one after SysUtils} const @@ -1672,7 +1672,7 @@ implementation end; - function EncodeUleb128(a: qword;out buf) : byte; + function EncodeUleb128(a: qword;out buf;len : byte) : byte; var b: byte; pbuf : pbyte; @@ -1687,13 +1687,13 @@ implementation pbuf^:=b; inc(pbuf); inc(result); - if a=0 then + if (a=0) and (result>=len) then break; until false; end; - function EncodeSleb128(a: int64;out buf) : byte; + function EncodeSleb128(a: int64;out buf;len : byte) : byte; var b, size: byte; more: boolean; @@ -1707,7 +1707,7 @@ implementation b := a and $7f; a := SarInt64(a, 7); - if ( + if (result+1>=len) and ( ((a = 0) and (b and $40 = 0)) or ((a = -1) and (b and $40 <> 0)) ) then