diff --git a/packages/fcl-res/src/coffconsts.pp b/packages/fcl-res/src/coffconsts.pp index d5fad0e6a2..6b7ad527f3 100644 --- a/packages/fcl-res/src/coffconsts.pp +++ b/packages/fcl-res/src/coffconsts.pp @@ -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 diff --git a/packages/fcl-res/src/cofftypes.pp b/packages/fcl-res/src/cofftypes.pp index 4706891675..cbb7f51153 100644 --- a/packages/fcl-res/src/cofftypes.pp +++ b/packages/fcl-res/src/cofftypes.pp @@ -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; diff --git a/packages/fcl-res/src/coffwriter.pp b/packages/fcl-res/src/coffwriter.pp index 53b471324e..9a59e0014b 100644 --- a/packages/fcl-res/src/coffwriter.pp +++ b/packages/fcl-res/src/coffwriter.pp @@ -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; diff --git a/packages/fcl-xml/src/sax_xml.pp b/packages/fcl-xml/src/sax_xml.pp index 29ddff1be2..de7bf0b5df 100644 --- a/packages/fcl-xml/src/sax_xml.pp +++ b/packages/fcl-xml/src/sax_xml.pp @@ -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); diff --git a/packages/rtl-objpas/src/inc/strutils.pp b/packages/rtl-objpas/src/inc/strutils.pp index 9563ec23fe..a84075f9b7 100644 --- a/packages/rtl-objpas/src/inc/strutils.pp +++ b/packages/rtl-objpas/src/inc/strutils.pp @@ -355,7 +355,7 @@ type i: SizeInt; begin i:=0; - while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin + while (i128; +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. diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc index aa4b9c492a..290c043109 100644 --- a/rtl/objpas/classes/stringl.inc +++ b/rtl/objpas/classes/stringl.inc @@ -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; diff --git a/rtl/objpas/sysconst.pp b/rtl/objpas/sysconst.pp index 908572516b..2aa466adf6 100644 --- a/rtl/objpas/sysconst.pp +++ b/rtl/objpas/sysconst.pp @@ -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'; diff --git a/rtl/objpas/sysutils/stre.inc b/rtl/objpas/sysutils/stre.inc index fbd03982d5..4fdc01d17f 100644 --- a/rtl/objpas/sysutils/stre.inc +++ b/rtl/objpas/sysutils/stre.inc @@ -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'; diff --git a/rtl/objpas/sysutils/syssb.inc b/rtl/objpas/sysutils/syssb.inc index ae200cda88..59a4095df4 100644 --- a/rtl/objpas/sysutils/syssb.inc +++ b/rtl/objpas/sysutils/syssb.inc @@ -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; diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc index d52b4c9983..fcd9b43817 100644 --- a/rtl/objpas/sysutils/sysstr.inc +++ b/rtl/objpas/sysutils/sysstr.inc @@ -1913,7 +1913,7 @@ end; Function FloatToDateTime (Const Value : Extended) : TDateTime; begin If (ValueMaxDateTime) then - Raise EConvertError.CreateFmt (SInvalidDateTime,[Value]); + Raise EConvertError.CreateFmt (SInvalidDateTimeFloat,[Value]); Result:=Value; end; diff --git a/rtl/objpas/sysutils/sysutils.inc b/rtl/objpas/sysutils/sysutils.inc index c0910a4791..0116ff6858 100644 --- a/rtl/objpas/sysutils/sysutils.inc +++ b/rtl/objpas/sysutils/sysutils.inc @@ -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(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} \ No newline at end of file diff --git a/utils/fpcres/fpcres.pas b/utils/fpcres/fpcres.pas index 65fab5d2ec..1a27eb3512 100644 --- a/utils/fpcres/fpcres.pas +++ b/utils/fpcres/fpcres.pas @@ -271,6 +271,7 @@ begin mti386 : Result.MachineType:=cmti386; mtarm : Result.MachineType:=cmtarm; mtx86_64 : Result.MachineType:=cmtx8664; + mtaarch64 : Result.MachineType:=cmtaarch64; end; end; diff --git a/utils/fpcres/target.pas b/utils/fpcres/target.pas index 587d5a2418..ed908e89b1 100644 --- a/utils/fpcres/target.pas +++ b/utils/fpcres/target.pas @@ -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]),