Skip to content
Permalink
Browse files

deep refactoring to avoid most FPC warnings

  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Jul 10, 2019
1 parent c7dd015 commit 3b8004a98ed60c3ec7b92c8e07d79fe4ba8039c9
Showing with 236 additions and 255 deletions.
  1. +135 −157 SQLite3/mORMot.pas
  2. +1 −1 SQLite3/mORMotService.pas
  3. +56 −51 SynCommons.pas
  4. +6 −6 SynCrtSock.pas
  5. +4 −4 SynDB.pas
  6. +5 −5 SynDBOracle.pas
  7. +6 −6 SynLog.pas
  8. +5 −5 SynMongoDB.pas
  9. +1 −1 SynOleDB.pas
  10. +0 −2 SynProtoRTSPHTTP.pas
  11. +10 −9 SynSelfTests.pas
  12. +1 −1 SynTable.pas
  13. +5 −6 SynZip.pas
  14. +1 −1 SynopseCommit.inc

Large diffs are not rendered by default.

@@ -1146,7 +1146,7 @@ function TService.GetControlHandler: TServiceControlHandler;
raise EServiceException.CreateUTF8('Cannot allocate memory for service jump gate: %',
[fSName]);
AfterCallAddr := Pointer(PtrUInt(fJumper)+5);
Offset := PtrInt(@JumpToService)-PtrInt(AfterCallAddr);
Offset := PtrUInt(@JumpToService)-PtrUInt(AfterCallAddr);
fJumper[0] := $E8; // call opcode
PInteger(@fJumper[1])^ := Offset; // points to JumpToService
PPtrUInt(@fJumper[5])^ := PtrUInt(self); // will be set as EAX=self
@@ -1384,10 +1384,12 @@ function ToUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUI
/// TVariantCompare-compatible case-sensitive comparison function
// - just a wrapper around SortDynArrayVariantComp(caseInsensitive=false)
function VariantCompare(const V1,V2: variant): PtrInt;
{$ifdef HASINLINE}inline;{$endif}

/// TVariantCompare-compatible case-insensitive comparison function
// - just a wrapper around SortDynArrayVariantComp(caseInsensitive=true)
function VariantCompareI(const V1,V2: variant): PtrInt;
{$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
result := false;
inc(sourcelen,PtrInt(source));
if source<>nil then
while PtrInt(source)<sourcelen do begin
while PtrInt(PtrUInt(source))<sourcelen do begin
c := byte(source^);
inc(source);
if c=0 then exit else
if c and $80<>0 then begin
extra := UTF8_EXTRABYTES[c];
if extra=0 then exit else // invalid leading byte
for i := 1 to extra do
if (PtrInt(source)>=sourcelen) or (byte(source^) and $c0<>$80) then
if (PtrInt(PtrUInt(source))>=sourcelen) or (byte(source^) and $c0<>$80) then
exit else
inc(source); // check valid UTF-8 content
end;
inc(DestLen,PtrInt(Dest));
if (Source<>nil) and (Dest<>nil) then begin
// first handle 7 bit ASCII WideChars, by pairs (Sha optimization)
SourceLen := SourceLen*2+PtrInt(Source);
SourceLen := SourceLen*2+PtrInt(PtrUInt(Source));
Tail := PWideChar(SourceLen)-2;
if (PtrInt(Dest)<DestLen) and (Source<=Tail) then
if (PtrInt(PtrUInt(Dest))<DestLen) and (Source<=Tail) then
repeat
c := PCardinal(Source)^;
if c and $ff80ff80<>0 then
c := c shr 8 or c;
PWord(Dest)^ := c;
inc(Dest,2);
until (Source>Tail) or (PtrInt(Dest)>=DestLen);
until (Source>Tail) or (PtrInt(PtrUInt(Dest))>=DestLen);
// generic loop, handling one UCS4 char per iteration
if (PtrInt(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then
if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
repeat
// inlined UTF16CharToUtf8() with bufferoverlow check and $FFFD on unmatch
c := cardinal(Source^);
0..$7f: begin
Dest^ := AnsiChar(c);
inc(Dest);
if (PtrInt(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then continue else break;
if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
continue else break;
end;
UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX:
if (PtrInt(Source)>=SourceLen) or
if (PtrInt(PtrUInt(Source))>=SourceLen) or
((cardinal(Source^)<UTF16_LOSURROGATE_MIN) or (cardinal(Source^)>UTF16_LOSURROGATE_MAX)) then begin
unmatch: if (PtrInt(@Dest[3])>DestLen) or
unmatch: if (PtrInt(PtrUInt(@Dest[3]))>DestLen) or
not (ccfReplacementCharacterForUnmatchedSurrogate in Flags) then
break;
PWord(Dest)^ := $BFEF;
Dest[2] := AnsiChar($BD);
inc(Dest,3);
if (PtrInt(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then continue else break;
if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
continue else break;
end else begin
c := ((c-$D7C0)shl 10)+(cardinal(Source^) xor UTF16_LOSURROGATE_MIN);
inc(Source);
end;
UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX:
if (PtrInt(Source)>=SourceLen) or
if (PtrInt(PtrUInt(Source))>=SourceLen) or
((cardinal(Source^)<UTF16_HISURROGATE_MIN) or (cardinal(Source^)>UTF16_HISURROGATE_MAX)) then
goto unmatch else begin
c := ((cardinal(Source^)-$D7C0)shl 10)+(c xor UTF16_LOSURROGATE_MIN);
$200000..$3FFFFFF: i := 5;
else i := 6;
end;
if PtrInt(Dest)+i>DestLen then
if PtrInt(PtrUInt(Dest))+i>DestLen then
break;
for j := i-1 downto 1 do begin
Dest[j] := AnsiChar((c and $3f)+$80);
c := c shr 6;
end;
Dest^ := AnsiChar(Byte(c) or UTF8_FIRSTBYTE[i]);
inc(Dest,i);
if (PtrInt(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then continue else break;
if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
continue else break;
until false;
if not (ccfNoTrailingZero in Flags) then
Dest^ := #0;
end;
result := PtrInt(Dest)-result;
result := PtrInt(PtrUInt(Dest))-result;
end;

procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
end;
vtClass: begin
if V.VClass<>nil then begin
Res.Text := PPUTF8Char(PtrInt(V.VClass)+vmtClassName)^+1;
Res.Text := PPUTF8Char(PtrInt(PtrUInt(V.VClass))+vmtClassName)^+1;
Res.Len := ord(Res.Text[-1]);
end else
Res.Len := 0;
if p=nil then
exit;
if up<>nil then begin
dec(PtrInt(p),PtrInt(up));
dec(PtrUInt(p),PtrUInt(up));
table := @NormToUpperAnsi7;
repeat
u := up^;
if u=#0 then
break;
if u<>table^[up[PtrInt(p)]] then
if u<>table^[up[PtrUInt(p)]] then
exit;
inc(up);
until false;
function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;
label zero;
begin // this code compiles well under FPC and Delphi on both 32-bit and 64-bit
inc(Length,PtrInt(P1)-SizeOf(PtrInt)*2);
if Length>=PtrInt(P1) then begin
if PPtrInt(P1)^<>PPtrInt(P2)^ then
inc(Length,PtrInt(PtrUInt(P1))-SizeOf(PtrInt)*2);
if Length>=PtrInt(PtrUInt(P1)) then begin
if PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^ then
goto zero;
inc(PtrInt(P1),SizeOf(PtrInt));
inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt));
inc(PtrInt(P2),SizeOf(PtrInt));
dec(PtrInt(P2),PtrInt(P1));
PtrInt(P1) := PtrInt(P1) and -SizeOf(PtrInt);
inc(PtrInt(P2),PtrInt(P1));
if Length>=PtrInt(P1) then
dec(PtrInt(P2),PtrInt(PtrUInt(P1)));
PtrInt(PtrUInt(P1)) := PtrInt(PtrUInt(P1)) and -SizeOf(PtrInt);
inc(PtrInt(P2),PtrInt(PtrUInt(P1)));
if Length>=PtrInt(PtrUInt(P1)) then
repeat // compare 4 aligned PtrInt per loop
if (PPtrInt(P1)^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
if (PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
goto zero;
inc(PtrInt(P1),SizeOf(PtrInt)*2);
inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt)*2);
inc(PtrInt(P2),SizeOf(PtrInt)*2);
if Length<PtrInt(P1) then
if Length<PtrInt(PtrUInt(P1)) then
break;
if (PPtrInt(P1)^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
if (PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
goto zero;
inc(PtrInt(P1),SizeOf(PtrInt)*2);
inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt)*2);
inc(PtrInt(P2),SizeOf(PtrInt)*2);
until Length<PtrInt(P1);
until Length<PtrInt(PtrUInt(P1));
end;
inc(Length,SizeOf(PtrInt)*2-PtrInt(P1));
inc(Length,SizeOf(PtrInt)*2-PtrInt(PtrUInt(P1)));
if Length>=SizeOf(PtrInt) then begin
if PPtrInt(P1)^<>PPtrInt(P2)^ then
if PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^ then
goto zero;
inc(PtrInt(P1),SizeOf(PtrInt));
inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt));
inc(PtrInt(P2),SizeOf(PtrInt));
dec(Length,SizeOf(PtrInt));
end;
{$ifdef CPU64}
if Length>=4 then begin
if PCardinal(P1)^<>PCardinal(P2)^ then
goto zero;
inc(PtrInt(P1),4);
inc(PtrInt(PtrUInt(P1)),4);
inc(PtrInt(P2),4);
dec(Length,4);
end;
{$endif}
if Length>=2 then begin
if PWord(P1)^<>PWord(P2)^ then
goto zero;
inc(PtrInt(P1),2);
inc(PtrInt(PtrUInt(P1)),2);
inc(PtrInt(P2),2);
dec(Length,2);
end;
var C1,C2: PtrInt;
lookupper: PByteArray; // better x86-64 / PIC asm generation
begin
result := PtrInt(Str2)-PtrInt(Str1);
result := PtrInt(PtrUInt(Str2))-PtrInt(PtrUInt(Str1));
if result<>0 then
if Str1<>nil then
if Str2<>nil then begin
if p1<>p2 then
if p1<>nil then
if p2<>nil then begin
l1 := PStrRec(Pointer(PtrInt(p1)-STRRECSIZE))^.length;
l2 := PStrRec(Pointer(PtrInt(p2)-STRRECSIZE))^.length;
l1 := PStrRec(Pointer(PtrUInt(p1)-STRRECSIZE))^.length;
l2 := PStrRec(Pointer(PtrUInt(p2)-STRRECSIZE))^.length;
l := l1;
if l2<l1 then
l := l2;
UTF8ToSynUnicode(PUTF8Char(Map.Buffer),Map.Size,Result) else
case TextFileKind(Map) of
isUnicode:
SetString(result,PWideChar(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1);
SetString(result,PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
isUTF8:
UTF8ToSynUnicode(PUTF8Char(pointer(PtrInt(Map.Buffer)+3)),Map.Size-3,Result);
UTF8ToSynUnicode(PUTF8Char(pointer(PtrUInt(Map.Buffer)+3)),Map.Size-3,Result);
isAnsi:
result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer, Map.Size);
end;
try
case TextFileKind(Map) of
isUnicode:
RawUnicodeToUtf8(PWideChar(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1,Result);
RawUnicodeToUtf8(PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1,Result);
isUTF8:
FastSetString(result,pointer(PtrInt(Map.Buffer)+3),Map.Size-3);
FastSetString(result,pointer(PtrUInt(Map.Buffer)+3),Map.Size-3);
isAnsi:
if AssumeUTF8IfNoBOM then
FastSetString(result,Map.Buffer,Map.Size) else
case TextFileKind(Map) of
{$ifdef UNICODE}
isUnicode:
SetString(result,PWideChar(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1);
SetString(result,PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
isUTF8:
UTF8DecodeToString(pointer(PtrInt(Map.Buffer)+3),Map.Size-3,result);
UTF8DecodeToString(pointer(PtrUInt(Map.Buffer)+3),Map.Size-3,result);
isAnsi:
result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer,Map.Size);
{$else}
isUnicode:
result := CurrentAnsiConvert.UnicodeBufferToAnsi(PWideChar(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1);
result := CurrentAnsiConvert.UnicodeBufferToAnsi(PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
isUTF8:
result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(PtrInt(Map.Buffer)+3),Map.Size-3);
result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(PtrUInt(Map.Buffer)+3),Map.Size-3);
isAnsi:
SetString(result,PAnsiChar(Map.Buffer),Map.Size);
{$endif}
sourceLen := 248; // avoid buffer overflow
// we allow to copy up to 3/7 more chars in Dest^ since its size is 255
{$ifdef CPU64} // unbranched uppercase conversion of 8 chars blocks
_80 := $8080808080808080; // use registers for constants
_80 := PtrUInt($8080808080808080); // use registers for constants
_61 := $6161616161616161;
_7b := $7b7b7b7b7b7b7b7b;
for i := 0 to sourceLen shr 3 do begin
c := ord(Text[result]);
if c>13 then begin
inc(result);
if result>=PtrInt(TextEnd) then
if result>=PtrInt(PtrUInt(TextEnd)) then
break;
continue;
end;
if (c=10) or (c=13) then
break;
inc(result);
if result>=PtrInt(TextEnd) then
if result>=PtrInt(PtrUInt(TextEnd)) then
break;
until false;
end;
begin
repeat
QueryPerformanceCounter(time.Lo);
time.Hi := UnixMSTimeUTC xor Int64(GetCurrentThreadID);
time.Hi := UnixMSTimeUTC xor PtrUInt(GetCurrentThreadID);
crcblock(@crc.b,@time.b);
crcblock(@crc.b,@ExeVersion.Hash.b);
if entropy<>nil then
@@ -6082,7 +6082,7 @@ procedure THttpServer.Execute;
{$else}
if Assigned(fThreadPool) then begin
// use thread pool to process the request header, and probably its body
if not fThreadPool.Push(pointer(ClientSock)) then begin
if not fThreadPool.Push(pointer(PtrUInt(ClientSock))) then begin
// returned false if there is no idle thread in the pool, and queue is full
{$ifndef USE_WINIOCP}
if fThreadPool.QueueIsFull then begin // too many connection limit reached?
@@ -6102,7 +6102,7 @@ procedure THttpServer.Execute;
tix := GetTick64;
if Terminated then
break;
if fThreadPool.Push(pointer(ClientSock)) then begin
if fThreadPool.Push(pointer(PtrUInt(ClientSock))) then begin
endtix := 0; // thread pool acquired the client sock
break;
end;
@@ -7174,7 +7174,7 @@ procedure TSynThreadPoolTHttpServer.Task(aCaller: TSynThread; aContext: Pointer)
exit;
ServerSock := THttpServerSocket.Create(fServer);
try
ServerSock.InitRequest(TSocket(aContext));
ServerSock.InitRequest(TSocket(PtrUInt(aContext)));
// get Header of incoming request in the thread pool
headertix := fServer.HeaderRetrieveAbortDelay;
if headertix>0 then
@@ -7209,7 +7209,7 @@ procedure TSynThreadPoolTHttpServer.Task(aCaller: TSynThread; aContext: Pointer)

procedure TSynThreadPoolTHttpServer.TaskAbort(aContext: Pointer);
begin
DirectShutdown(TSocket(aContext));
DirectShutdown(TSocket(PtrUInt(aContext)));
end;


@@ -12936,9 +12936,9 @@ procedure Initialize;
if not Assigned(GetTick64) then // fallback before Vista
GetTick64 := @GetTick64ForXP;
{$endif MSWINDOWS}
FillChar(WsaDataOnce,sizeof(WsaDataOnce),0);
if InitSocketInterface then
WSAStartup(WinsockLevel, WsaDataOnce) else
fillchar(WsaDataOnce,sizeof(WsaDataOnce),0);
WSAStartup(WinsockLevel, WsaDataOnce);
end;

initialization
@@ -3648,9 +3648,9 @@ function TQueryValue.GetString: string;
varDate: result := Ansi7ToString(DateTimeToIso8601Text(VDate,' '));
varString: result := UTF8ToString(RawUTF8(VAny));
{$ifdef HASVARUSTRING}
varUString: result := UnicodeString(VAny);
{$endif}
varOleStr: result := WideString(VAny);
varUString: result := string(UnicodeString(VAny));
{$endif HASVARUSTRING}
varOleStr: result := string(WideString(VAny));
else result := fValue;
end;
end;
@@ -8300,7 +8300,7 @@ procedure TSQLDBProxyStatementAbstract.IntHeaderProcess(Data: PByte; DataLen: in
repeat
if DataLen<=5 then
break; // to raise ESQLDBException
fDataRowCount := PInteger(PtrInt(Data)+DataLen-sizeof(Integer))^;
fDataRowCount := PInteger(PtrUInt(Data)+PtrUInt(DataLen)-sizeof(Integer))^;
Magic := FromVarUInt32(Data);
if Magic<>FETCHALLTOBINARY_MAGIC then
break; // corrupted

0 comments on commit 3b8004a

Please sign in to comment.
You can’t perform that action at this time.