# revisions: 46531,46744,46747,47288,47327,47366,47392,47393,47414

git-svn-id: branches/fixes_3_2@47725 -
This commit is contained in:
marco 2020-12-08 20:32:00 +00:00
parent 23eb698f81
commit 0feee25b1e
14 changed files with 250 additions and 111 deletions

View File

@ -56,6 +56,7 @@ const
IMAGE_FILE_MACHINE_EBC = $0EBC; // EFI Byte Code
}
IMAGE_FILE_MACHINE_AMD64 = $8664; // AMD64 (K8)
IMAGE_FILE_MACHINE_ARM64 = $aa64; // ARM64 little endian
{
IMAGE_FILE_MACHINE_M32R = $9041; // M32R little-endian
IMAGE_FILE_MACHINE_CEE = $C0EE;
@ -159,6 +160,27 @@ const
IMAGE_REL_AMD64_PAIR = $000F;
IMAGE_REL_AMD64_SSPAN32 = $0010; // 32 bit signed span-dependent value applied at link time
// aarch64 relocation types
IMAGE_REL_ARM64_ABSOLUTE = $0000; // The relocation is ignored.
IMAGE_REL_ARM64_ADDR32 = $0001; // The 32-bit VA of the target.
IMAGE_REL_ARM64_ADDR32NB = $0002; // The 32-bit RVA of the target.
IMAGE_REL_ARM64_BRANCH26 = $0003; // The 26-bit relative displacement to the target, for B and BL instructions.
IMAGE_REL_ARM64_PAGEBASE_REL21= $0004; // The page base of the target, for ADRP instruction.
IMAGE_REL_ARM64_REL21 = $0005; // The 12-bit relative displacement to the target, for instruction ADR
IMAGE_REL_ARM64_PAGEOFFSET_12A= $0006; // The 12-bit page offset of the target, for instructions ADD/ADDS (immediate) with zero shift.
IMAGE_REL_ARM64_PAGEOFFSET_12L= $0007; // The 12-bit page offset of the target, for instruction LDR (indexed, unsigned immediate).
IMAGE_REL_ARM64_SECREL = $0008; // The 32-bit offset of the target from the beginning of its section. This is used to support debugging information and static thread local storage.
IMAGE_REL_ARM64_SECREL_LOW12A = $0009; // Bit 0:11 of section offset of the target, for instructions ADD/ADDS (immediate) with zero shift.
IMAGE_REL_ARM64_SECREL_HIGH12A= $000A; // Bit 12:23 of section offset of the target, for instructions ADD/ADDS (immediate) with zero shift.
IMAGE_REL_ARM64_SECREL_LOW12L = $000B; // Bit 0:11 of section offset of the target, for instruction LDR (indexed, unsigned immediate).
IMAGE_REL_ARM64_TOKEN = $000C; // CLR token.
IMAGE_REL_ARM64_SECTION = $000D; // The 16-bit section index of the section that contains the target. This is used to support debugging information.
IMAGE_REL_ARM64_ADDR64 = $000E; // The 64-bit VA of the relocation target.
IMAGE_REL_ARM64_BRANCH19 = $000F; // The 19-bit offset to the relocation target, for conditional B instruction.
IMAGE_REL_ARM64_BRANCH14 = $0010; // The 14-bit offset to the relocation target, for instructions TBZ and TBNZ.
IMAGE_REL_ARM64_REL32 = $0011; // The 32-bit relative address from the byte following the relocation.
// AIX PPC32/PPC64 relocation types.
IMAGE_REL_PPC_POS = $1F00; // A(sym) Positive Relocation

View File

@ -20,7 +20,7 @@ unit cofftypes;
interface
type
TCoffMachineType = (cmti386, cmtarm, cmtx8664, cmtppc32aix, cmtppc64aix);
TCoffMachineType = (cmti386, cmtarm, cmtx8664, cmtppc32aix, cmtppc64aix, cmtaarch64);
type
TSectionName = array [0..7] of char;

View File

@ -452,6 +452,7 @@ begin
cmti386 : Result.machine:=IMAGE_FILE_MACHINE_I386;
cmtarm : Result.machine:=IMAGE_FILE_MACHINE_ARM;
cmtx8664 : Result.machine:=IMAGE_FILE_MACHINE_AMD64;
cmtaarch64 : Result.machine:=IMAGE_FILE_MACHINE_ARM64;
cmtppc32aix : Result.machine:=IMAGE_FILE_MACHINE_POWERPC32_AIX;
cmtppc64aix : Result.machine:=IMAGE_FILE_MACHINE_POWERPC64_AIX;
end;
@ -527,7 +528,7 @@ procedure TCoffResourceWriter.SetMachineType(AValue: TCoffMachineType);
begin
fMachineType:=AValue;
{$IFDEF ENDIAN_BIG}
if fMachineType in [cmti386,cmtx8664,cmtarm] then
if fMachineType in [cmti386,cmtx8664,cmtarm,cmtaarch64] then
fOppositeEndianess:=true;
{$ELSE}
if fMachineType in [cmtppc32aix,cmtppc64aix] then
@ -536,7 +537,8 @@ begin
case fMachineType of
cmti386,
cmtx8664,
cmtarm:
cmtarm,
cmtaarch64:
fSymStorageClass:=IMAGE_SYM_CLASS_STATIC;
cmtppc32aix,
cmtppc64aix:
@ -737,6 +739,7 @@ begin
cmti386 : reloctype:=IMAGE_REL_I386_DIR32NB;
cmtarm : reloctype:=IMAGE_REL_ARM_ADDR32NB;
cmtx8664 : reloctype:=IMAGE_REL_AMD64_ADDR32NB;
cmtaarch64 : reloctype:=IMAGE_REL_ARM64_ADDR32NB;
cmtppc32aix : reloctype:=IMAGE_REL_PPC_POS;
cmtppc64aix : reloctype:=IMAGE_REL_PPC_POS;
end;

View File

@ -175,17 +175,6 @@ begin
'<':
begin
Inc(BufferPos);
if (Buffer[BufferPos]='!') and (Buffer[BufferPos + 1]='[') then
begin
Inc(BufferPos, 8);
EnterNewScannerContext(scCData);
end
else if (Buffer[BufferPos]='!') and (Buffer[BufferPos + 1]='-') then
begin
Inc(BufferPos, 3);
EnterNewScannerContext(scComment);
end
else
EnterNewScannerContext(scTag);
end;
else
@ -206,17 +195,6 @@ begin
'<':
begin
Inc(BufferPos);
if (Buffer[BufferPos]='!') and (Buffer[BufferPos + 1]='[') then
begin
Inc(BufferPos, 8);
EnterNewScannerContext(scCData);
end
else if (Buffer[BufferPos]='!') and (Buffer[BufferPos + 1]='-') then
begin
Inc(BufferPos, 3);
EnterNewScannerContext(scComment);
end
else
EnterNewScannerContext(scTag);
end;
else
@ -232,17 +210,6 @@ begin
'<':
begin
Inc(BufferPos);
if (Buffer[BufferPos]='!') and (Buffer[BufferPos + 1]='[') then
begin
Inc(BufferPos, 8);
EnterNewScannerContext(scCData);
end
else if (Buffer[BufferPos]='!') and (Buffer[BufferPos + 1]='-') then
begin
Inc(BufferPos, 3);
EnterNewScannerContext(scComment);
end
else
EnterNewScannerContext(scTag);
end;
else
@ -252,9 +219,15 @@ begin
end;
end;
scCData:
if (Buffer[BufferPos] = ']') and (Buffer[BufferPos + 1]=']') and (Buffer[BufferPos + 2]='>') then
if (Length(FRawTokenText) = 0) and (Buffer[BufferPos] = '-') then
begin
Inc(BufferPos, 3);
Inc(BufferPos);
EnterNewScannerContext(scComment);
end
else if (Buffer[BufferPos] = '>') and (RightStr(FRawTokenText, 2) = ']]') then
begin
FRawTokenText := Copy(FRawTokenText, 8, Length(FRawTokenText)-9); //delete '[CDATA[' and ']]' from text
Inc(BufferPos);
EnterNewScannerContext(scUnknown);
end
else
@ -263,9 +236,10 @@ begin
Inc(BufferPos);
end;
scComment:
if (Buffer[BufferPos] = '-') and (Buffer[BufferPos + 1]='-') and (Buffer[BufferPos + 2]='>') then
if (Buffer[BufferPos] = '>') and (RightStr(FRawTokenText, 2) = '--') then
begin
Inc(BufferPos, 3);
FRawTokenText := Copy(FRawTokenText, 2, Length(FRawTokenText)-3); //delete '-' and '--' from text
Inc(BufferPos);
EnterNewScannerContext(scUnknown);
end
else
@ -309,6 +283,11 @@ begin
FRawTokenText := FRawTokenText + Buffer[BufferPos];
Inc(BufferPos);
end;
'!':
begin
Inc(BufferPos);
EnterNewScannerContext(scCData);
end;
'>':
begin
Inc(BufferPos);

View File

@ -355,7 +355,7 @@ type
i: SizeInt;
begin
i:=0;
while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin
while (i<aPos) and (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) do begin
inc(i);
end;
Result:=i;
@ -493,7 +493,7 @@ type
i: SizeInt;
begin
i:=0;
while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin
while (i<aPos) and (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) do begin
inc(i);
end;
Result:=i;

View File

@ -1,4 +1,18 @@
unit WideStrUtils;
{
Delphi/Kylix compatibility unit: String handling routines.
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2005 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit widestrutils;
{$mode objfpc}
{$H+}
@ -7,7 +21,7 @@ unit WideStrUtils;
interface
uses
SysUtils;
SysUtils, Classes;
function WideStringReplace(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString;
function WideReplaceStr(const AText, AFromText, AToText: WideString): WideString; inline;
@ -17,9 +31,87 @@ function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString; Fl
function UnicodeReplaceStr(const AText, AFromText, AToText: UnicodeString): UnicodeString; inline;
function UnicodeReplaceText(const AText, AFromText, AToText: UnicodeString): UnicodeString; inline;
type
TEncodeType = (etUSASCII, etUTF8, etANSI);
const
sUTF8BOMString: array[1..3] of char = (#$EF, #$BB, #$BF);
function HasUTF8BOM(S: TStream): boolean; overload;
function HasUTF8BOM(const S: RawByteString): boolean; overload;
function HasExtendCharacter(const S: RawByteString): boolean;
function DetectUTF8Encoding(const S: RawByteString): TEncodeType;
function IsUTF8String(const S: RawByteString): boolean;
type
TBufferUTF8State = (u8sUnknown, u8sYes, u8sNo);
//PartialAllowed must be set to true if the buffer is smaller than the file.
function IsBufferUTF8(buf: PAnsiChar; bufSize: SizeInt; PartialAllowed: boolean): TBufferUTF8State;
implementation
{
The IsBufferUtf8 function code was created by Christian Ghisler (ghisler.com)
Christian gave code to open-source at Total Commander public forum
}
const bytesFromUTF8:array[AnsiChar] of byte = (
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 32
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 64
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 96
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, //128
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, //160
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, //192
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, //224
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5); //256
function IsFirstUTF8Char(thechar:AnsiChar):boolean; inline;
{The remaining bytes in a multi-byte sequence have 10 as their two most significant bits.}
begin
result:=(byte(thechar) and (128+64))<>128;
end;
function IsSecondaryUTF8Char(thechar:AnsiChar):boolean; inline;
{The remaining bytes in a multi-byte sequence have 10 as their two most significant bits.}
begin
result:=(byte(thechar) and (128+64))=128;
end;
function IsBufferUTF8(buf: PAnsiChar; bufSize: SizeInt; PartialAllowed: boolean): TBufferUTF8State;
{Buffer contains only valid UTF-8 characters, no secondary alone,
no primary without the correct nr of secondary}
var
p: PAnsiChar;
i: SizeInt;
utf8bytes: integer;
hadutf8bytes: boolean;
begin
p:=buf;
hadutf8bytes:=false;
result:=u8sUnknown;
utf8bytes:=0;
for i:= 1 to bufSize do
begin
if utf8bytes>0 then
begin {Expecting secondary AnsiChar}
hadutf8bytes:=true;
if not IsSecondaryUTF8Char(p^) then exit(u8sNo); {Fail!}
dec(utf8bytes);
end
else
if IsFirstUTF8Char(p^) then
utf8bytes:=bytesFromUTF8[p^]
else
if IsSecondaryUTF8Char(p^) then
exit(u8sNo); {Fail!}
inc(p);
end;
if hadutf8bytes and (PartialAllowed or (utf8bytes=0)) then
result:=u8sYes;
end;
function WideReplaceStr(const AText, AFromText, AToText: WideString): WideString; inline;
begin
Result := WideStringReplace(AText, AFromText, AToText, [rfReplaceAll]);
@ -52,5 +144,74 @@ begin
Result:= sysutils.UnicodeStringReplace(S,OldPattern,NewPattern,Flags);
end;
function HasUTF8BOM(S: TStream): boolean;
var
OldPos: Int64;
Buf: array[1..3] of char;
begin
Result := false;
if S.Size<3 then exit;
FillChar(Buf, SizeOf(Buf), 0);
try
OldPos := S.Position;
S.Position := 0;
if S.Read(Buf, 3)<>3 then exit;
Result :=
(Buf[1]=sUTF8BOMString[1]) and
(Buf[2]=sUTF8BOMString[2]) and
(Buf[3]=sUTF8BOMString[3]);
finally
S.Position := OldPos;
end;
end;
function HasUTF8BOM(const S: RawByteString): boolean;
begin
Result := (Length(S)>=3) and
(S[1]=sUTF8BOMString[1]) and
(S[2]=sUTF8BOMString[2]) and
(S[3]=sUTF8BOMString[3]);
end;
function HasExtendCharacter(const S: RawByteString): boolean;
var
i: integer;
begin
for i := 1 to Length(S) do
if Ord(S[i])>=$80 then
begin
Result := true;
exit;
end;
Result := false;
end;
function DetectUTF8Encoding(const S: RawByteString): TEncodeType;
var
FirstExtChar, i: integer;
begin
FirstExtChar := 0;
for i := 1 to Length(S) do
if Ord(S[i])>=$80 then
begin
FirstExtChar := i;
Break;
end;
if FirstExtChar=0 then
Result := etUSASCII
else
if IsBufferUtf8(@S[FirstExtChar], Length(S)-FirstExtChar+1, false)=u8sYes then
Result := etUTF8
else
Result := etANSI;
end;
function IsUTF8String(const S: RawByteString): boolean;
begin
Result := DetectUTF8Encoding(S) = etUTF8;
end;
end.

View File

@ -547,6 +547,11 @@ var
end;
Function CheckQuoted : Boolean;
{ Paraphrased from Delphi XE2 help:
Strings must be separated by Delimiter characters or spaces.
They may be enclosed in QuoteChars.
QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
}
begin
Result:=(AValue[i]=aQuoteChar) and (aQuoteChar<>#0);
@ -567,60 +572,29 @@ var
i:=j+1;
end;
Procedure MaybeSkipSpaces; inline;
begin
if Not aStrictDelimiter then
while (i<=len) and (Ord(AValue[i])<=Ord(' ')) do
inc(i);
end;
begin
BeginUpdate;
i:=1;
j:=1;
aNotFirst:=false;
{ Paraphrased from Delphi XE2 help:
Strings must be separated by Delimiter characters or spaces.
They may be enclosed in QuoteChars.
QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
}
try
if DoClear then
Clear;
len:=length(AValue);
If aStrictDelimiter then
begin
BeginUpdate;
i:=1;
j:=1;
aNotFirst:=false;
try
if DoClear then
Clear;
len:=length(AValue);
while i<=len do
begin
// skip delimiter
if aNotFirst and (i<=len) and (AValue[i]=aDelimiter) then
inc(i);
// read next string
if i>len then
begin
if aNotFirst then Add('');
end
else
begin
If not CheckQuoted then
begin
// next string is not quoted; read until delimiter
j:=i;
while (j<=len) and
(AValue[j]<>aDelimiter) do inc(j);
Add( Copy(AValue,i,j-i));
i:=j;
end;
end;
aNotFirst:=true;
end;
end
else
begin
while i<=len do
begin
// skip delimiter
if aNotFirst and (i<=len) and (AValue[i]=aDelimiter) then
inc(i);
// skip spaces
while (i<=len) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
MaybeSkipSpaces;
// read next string
if i>len then
begin
@ -634,19 +608,16 @@ begin
// next string is not quoted; read until control character/space/delimiter
j:=i;
while (j<=len) and
(Ord(AValue[j])>Ord(' ')) and
(aStrictDelimiter or (Ord(AValue[j])>Ord(' '))) and
(AValue[j]<>aDelimiter) do
inc(j);
Add( Copy(AValue,i,j-i));
i:=j;
end;
end;
// skip spaces
while (i<=len) and (Ord(AValue[i])<=Ord(' ')) do
inc(i);
MaybeSkipSpaces;
aNotFirst:=true;
end; // While I<=Len
end; // If StrictDelimiter
finally
EndUpdate;
end;

View File

@ -68,7 +68,8 @@ const
SInvalidBoolean = '"%s" is not a valid boolean.';
SInvalidCast = 'Invalid type cast';
SinvalidCurrency = 'Invalid currency: "%s"';
SInvalidDateTime = '%f is not a valid date/time value.';
SInvalidDateTime = '"%s" is not a valid date/time value.';
SInvalidDateTimeFloat = '%f is not a valid date/time value.';
SInvalidDrive = 'Invalid drive specified';
SInvalidFileHandle = 'Invalid file handle';
SInvalidFloat = '"%s" is an invalid float';

View File

@ -48,7 +48,8 @@ Const
SInvalidArgIndex = 'Invalid argument index in format "%s"';
SInvalidBoolean = '"%s" is not a valid boolean.';
SInvalidCast = 'Invalid type cast';
SInvalidDateTime = '%f is not a valid date/time value.';
SInvalidDateTime = '"%s" is not a valid date/time value.';
SInvalidDateTimeFloat = '%f is not a valid date/time value.';
SInvalidDrive = 'Invalid drive specified';
SInvalidFileHandle = 'Invalid file handle';
SInvalidFloat = '"%s" is an invalid float';

View File

@ -532,7 +532,7 @@ begin
CheckNegative(RemLength,'RemLength');
CheckRange(StartIndex,0,Length);
MoveIndex:=StartIndex+RemLength;
CheckRange(MoveIndex,0,Length-1);
CheckRange(MoveIndex,0,Length);
if (Length-Moveindex)>0 then
Move(FData[MoveIndex],FData[StartIndex],(Length-MoveIndex)*SizeOf(SBChar));
Length:=Length-RemLength;

View File

@ -1913,7 +1913,7 @@ end;
Function FloatToDateTime (Const Value : Extended) : TDateTime;
begin
If (Value<MinDateTime) or (Value>MaxDateTime) then
Raise EConvertError.CreateFmt (SInvalidDateTime,[Value]);
Raise EConvertError.CreateFmt (SInvalidDateTimeFloat,[Value]);
Result:=Value;
end;

View File

@ -39,7 +39,7 @@
{ variant error codes }
{$i varerror.inc}
{ Type helpers}
{$i syshelp.inc}
@ -144,7 +144,7 @@ end;
{$i sysuni.inc}
{$i sysencoding.inc}
{$endif FPC_HAS_UNICODESTRING}
{ threading stuff }
{$i sysuthrd.inc}
@ -161,7 +161,7 @@ end;
end;
procedure FreeMemAndNil(var p);
var
temp:Pointer;
begin
@ -169,7 +169,7 @@ end;
Pointer(P):=nil;
FreeMem(temp);
end;
{ Interfaces support }
{$i sysuintf.inc}
@ -300,7 +300,7 @@ Procedure CatchUnhandledException (Obj : TObject; Addr: CodePointer; FrameCount:
Var
i : longint;
hstdout : ^text;
begin
if WriteErrorsToStdErr then
hstdout:=@stderr
@ -802,7 +802,7 @@ begin
end;
function ExecuteProcess(Const Path: UnicodeString; Const ComLine: Array of UnicodeString;Flags:TExecuteFlags=[]):integer;
var
var
ComLineA : array of RawByteString;
I : Integer;
begin
@ -818,9 +818,9 @@ end;
{$IFNDEF VER3_0}
generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;
begin
if val then
if val then
Result := ifTrue
else
Result:=ifFalse;
Result:=ifFalse;
end;
{$ENDIF}

View File

@ -271,6 +271,7 @@ begin
mti386 : Result.MachineType:=cmti386;
mtarm : Result.MachineType:=cmtarm;
mtx86_64 : Result.MachineType:=cmtx8664;
mtaarch64 : Result.MachineType:=cmtaarch64;
end;
end;

View File

@ -83,7 +83,7 @@ var
(name : 'ia64'; formats : [ofElf]), //mtia64
(name : 'mips'; formats : [ofElf]; alias : 'mipseb'), //mtmips
(name : 'mipsel'; formats : [ofElf]), //mtmipsel
(name : 'aarch64'; formats : [ofElf, ofMachO]), //mtaarch64
(name : 'aarch64'; formats : [ofElf, ofCoff, ofMachO]), //mtaarch64
(name : 'powerpc64le'; formats : [ofElf]), //mtppc64le
(name : 'bigendian'; formats : [ofExt]), //mtBigEndian
(name : 'littleendian'; formats : [ofExt]) //mtLittleEndian
@ -104,7 +104,7 @@ var
mtia64,mtmips,mtmipsel,
mtppc64le,mtaarch64]),
(name : 'coff'; ext : '.o'; machines : [mti386,mtx86_64,mtarm,
mtppc,mtppc64]),
mtaarch64,mtppc,mtppc64]),
(name : 'xcoff'; ext : '.o'; machines : [mtppc{,mtppc64}]),
(name : 'mach-o'; ext : '.or'; machines : [mti386,mtx86_64,mtppc,
mtppc64,mtarm,mtaarch64]),