Skip to content
Permalink
Browse files

new NextGrow() function to optimize arrays growing strategy - see #187

  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Apr 15, 2019
1 parent c8620f6 commit a84dfa7e5178a54e7795fc89e35f6e507ddf7e12
Showing with 64 additions and 55 deletions.
  1. +5 −5 SQLite3/mORMot.pas
  2. +43 −32 SynCommons.pas
  3. +3 −3 SynDB.pas
  4. +4 −4 SynLog.pas
  5. +5 −7 SynMongoDB.pas
  6. +1 −1 SynMustache.pas
  7. +2 −2 SynTable.pas
  8. +1 −1 SynopseCommit.inc
// add to the internal list
result := fCount;
if result>=length(fList) then
SetLength(fList,result+result shr 3+32);
SetLength(fList,NextGrow(result));
inc(fCount);
fList[result] := aItem;
fOrderedByName := nil; // force recompute sorted name array
P := GotoNextJSONItem(P); // ignore field name for later rows
// warning: field order if not checked, and should be as expected
if max>=resmax then begin // check space inside loop for GPF security
inc(resmax,resmax shr 3+nfield shl 8);
SetLength(fJSONResults,resmax); // enough space for 256 more rows
resmax := NextGrow(resmax);
SetLength(fJSONResults,resmax); // enough space for more rows
end;
if P=nil then break; // normal end: no more field name
fJSONResults[max] := GetJSONFieldOrObjectOrArray(P,@wasString,@EndOfObject,true);
procedure AddID(var Values: TIDDynArray; var ValuesCount: integer; Value: TID);
begin
if ValuesCount=length(Values) then
SetLength(Values,ValuesCount+256+ValuesCount shr 3);
SetLength(Values,NextGrow(ValuesCount));
Values[ValuesCount] := Value;
inc(ValuesCount);
end;
RunningBatchURIMethod := URIMethod;
end;
if Count>=length(Results) then
SetLength(Results,Count+256+Count shr 3);
SetLength(Results,NextGrow(Count));
end;
// process CRUD method operation
OK := false;
@@ -957,6 +957,11 @@ {$ifdef FPC_OR_UNICODE}TSynTempWriter = record private
/// can be used to avoid a memory allocation for res := 'null'
NULL_STR_VAR: RawUTF8;

/// compute the new capacity when expanding an array of items
// - handle small, medium and large sizes properly to reduce memory usage and
// maximize performance
function NextGrow(capacity: integer): integer;

/// equivalence to SetString(s,nil,len) function
// - faster especially under FPC
procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);
@@ -29967,15 +29972,27 @@ function AddRawUTF8(var Values: TRawUTF8DynArray; const Value: RawUTF8;
result := true;
end;

function NextGrow(capacity: integer): integer;
begin // similar to TFPList.Expand for the ranges algorithm
result := capacity;
if result<128 shl 20 then
if result<8 shl 20 then
if result<=128 then
if result>8 then
inc(result,16) else
inc(result,4) else
inc(result,result shr 2) else
inc(result,result shr 3) else
inc(result,16 shl 20);
end;

procedure AddRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
const Value: RawUTF8);
var capacity: integer;
begin
capacity := Length(Values);
if ValuesCount=capacity then begin
inc(capacity,32+capacity shr 3);
SetLength(Values,capacity);
end;
if ValuesCount=capacity then
SetLength(Values,NextGrow(capacity));
Values[ValuesCount] := Value;
inc(ValuesCount);
end;
@@ -31055,7 +31072,7 @@ function FindFiles(const Directory,Mask,IgnoreFileName: TFileName;
if SearchRecValidFile(F) and ((IgnoreFileName='') or
(AnsiCompareFileName(F.Name,IgnoreFileName)<>0)) then begin
if n=length(result) then
SetLength(result,n+n shr 3+8);
SetLength(result,NextGrow(n));
if IncludesDir then
result[n].FromSearchRec(Dir,F) else
result[n].FromSearchRec('',F);
@@ -31331,7 +31348,7 @@ procedure AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
Value: integer);
begin
if ValuesCount=length(Values) then
SetLength(Values,ValuesCount+256+ValuesCount shr 3);
SetLength(Values,NextGrow(ValuesCount));
Values[ValuesCount] := Value;
inc(ValuesCount);
end;
@@ -31344,10 +31361,10 @@ function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
exit;
end;
if ValuesCount=length(Values) then
SetLength(Values,ValuesCount+256+ValuesCount shr 3);
SetLength(Values,NextGrow(ValuesCount));
Values[ValuesCount] := Value;
inc(ValuesCount);
result := true
result := true;
end;

function AddInteger(var Values: TIntegerDynArray; const Another: TIntegerDynArray): PtrInt;
@@ -31366,7 +31383,7 @@ function AddWord(var Values: TWordDynArray; var ValuesCount: integer; Value: Wor
begin
result := ValuesCount;
if result=length(Values) then
SetLength(Values,result+32+result shr 3);
SetLength(Values,NextGrow(result));
Values[result] := Value;
inc(ValuesCount);
end;
@@ -31375,7 +31392,7 @@ function AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: I
begin
result := ValuesCount;
if result=length(Values) then
SetLength(Values,result+256+result shr 3);
SetLength(Values,NextGrow(result));
Values[result] := Value;
inc(ValuesCount);
end;
@@ -32440,7 +32457,7 @@ function InsertInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
result := Index;
n := Length(Values);
if ValuesCount=n then begin
inc(n,256+n shr 3);
n := NextGrow(n);
SetLength(Values,n);
if CoValues<>nil then
SetLength(CoValues^,n);
@@ -39331,7 +39348,7 @@ function AddSortedRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer
end;
n := Length(Values);
if ValuesCount=n then begin
inc(n,256+n shr 3);
n := NextGrow(n);
SetLength(Values,n);
if CoValues<>nil then
SetLength(CoValues^,n);
@@ -43777,7 +43794,7 @@ function TJSONCustomParserRTTI.ReadOneLevel(var P: PUTF8Char; var Data: PByte;
repeat
inc(n);
if (ArrayLen<0) and (n>ArrayCapacity) then begin
inc(ArrayCapacity,512+ArrayCapacity shr 3);
ArrayCapacity := NextGrow(ArrayCapacity);
Prop.ReAllocateNestedArray(PPtrUInt(Data)^,ArrayCapacity);
DynArray := PPointer(Data)^;
inc(DynArray,pred(n)*Prop.fNestedDataSize);
@@ -46319,7 +46336,7 @@ function TDocVariantData.InternalAdd(const aName: RawUTF8): integer;
if VValue=nil then
SetLength(VValue,16) else
if VCount>=length(VValue) then
SetLength(VValue,VCount+VCount shr 3+32);
SetLength(VValue,NextGrow(VCount));
if aName<>'' then begin
len := length(VValue);
if Length(VName)<>len then
@@ -50085,7 +50102,7 @@ procedure TDynArray.CreateOrderedIndexAfterAdd(var aIndex: TIntegerDynArray;
exit;
if aIndex<>nil then begin // whole FillIncreasing(aIndex[]) for first time
if ndx>=length(aIndex) then
SetLength(aIndex,ndx+ndx shr 3+64); // grow aIndex[] if needed
SetLength(aIndex,NextGrow(ndx)); // grow aIndex[] if needed
aIndex[ndx] := ndx;
end;
CreateOrderedIndex(aIndex,aCompare);
@@ -51404,12 +51421,8 @@ function TObjectDynArrayWrapper.Add(Instance: TObject): integer;
var cap: integer;
begin
cap := length(TObjectDynArray(fValue^));
if cap<=fCount then begin
if cap<256 then
inc(cap,64) else
inc(cap,256+cap shr 3);
SetLength(TObjectDynArray(fValue^),cap);
end;
if cap<=fCount then
SetLength(TObjectDynArray(fValue^),NextGrow(cap));
result := fCount;
TObjectDynArray(fValue^)[result] := Instance;
inc(fCount);
@@ -51538,7 +51551,7 @@ function ObjArrayAddCount(var aObjArray; aItem: TObject; var aObjArrayCount: int
begin
result := aObjArrayCount;
if result=length(a) then
SetLength(a,result+result shr 3+16);
SetLength(a,NextGrow(result));
a[result] := aItem;
inc(aObjArrayCount);
end;
@@ -52711,7 +52724,7 @@ procedure TObjectListSorted.InsertNew(Item: TSynPersistentLock;
Index: integer);
begin
if fCount=length(fObjArray) then
SetLength(fObjArray,fCount+256+fCount shr 3);
SetLength(fObjArray,NextGrow(fCount));
if cardinal(Index)<cardinal(fCount) then
{$ifdef FPC}Move{$else}MoveFast{$endif}(
fObjArray[Index],fObjArray[Index+1],(fCount-Index)*SizeOf(TObject)) else
@@ -56539,7 +56552,7 @@ function JSONArrayDecode(P: PUTF8Char; out Values: TPUTF8CharDynArray): boolean;
if P^<>']' then
repeat
if max=n then begin
inc(max,max shr 3+16);
max := NextGrow(max);
SetLength(Values,max);
end;
Values[n] := P;
@@ -59358,10 +59371,8 @@ function TRawUTF8List.Add(const aText: RawUTF8): PtrInt;
if fObjects=nil then begin
capacity := length(fList);
result := fCount;
if result>=capacity then begin
inc(capacity,256+fCount shr 3);
SetLength(fList,capacity);
end;
if result>=capacity then
SetLength(fList,NextGrow(capacity));
fList[result] := aText;
inc(fCount);
Changed;
@@ -59404,13 +59415,13 @@ function TRawUTF8List.AddObject(const aText: RawUTF8; aObject: TObject): PtrInt;
capacity := length(fList);
result := fCount;
if result>=capacity then begin
inc(capacity,256+fCount shr 3);
capacity := NextGrow(capacity);
SetLength(fList,capacity);
if (fObjects<>nil) or (aObject<>nil) then
SetLength(fObjects,capacity);
end else
if (aObject<>nil) and (fObjects=nil) then
SetLength(fObjects,capacity);
SetLength(fObjects,capacity); // first time we got aObject<>nil
fList[result] := aText;
if aObject<>nil then
fObjects[result] := aObject;
@@ -64470,8 +64481,8 @@ function TMemoryMapText.LineSizeSmallerThan(aIndex, aMinimalCount: integer): boo
procedure TMemoryMapText.ProcessOneLine(LineBeg, LineEnd: PUTF8Char);
begin
if fCount=fLinesMax then begin
inc(fLinesMax,256+fLinesMax shr 3);
Reallocmem(fLines,fLinesMax*SizeOf(pointer));
fLinesMax := NextGrow(fLinesMax);
ReallocMem(fLines,fLinesMax*SizeOf(pointer));
end;
fLines[fCount] := LineBeg;
inc(fCount);
@@ -7201,7 +7201,7 @@ function TSQLDBStatement.FetchAllToBinary(Dest: TStream; MaxRowCount: cardinal;
// save row position in DataRowPosition[] (if any)
if DataRowPosition<>nil then begin
if Length(DataRowPosition^)<=integer(result) then
SetLength(DataRowPosition^,result+result shr 3+256);
SetLength(DataRowPosition^,NextGrow(result));
DataRowPosition^[result] := W.TotalWritten-StartPos;
end;
// first write null columns flags
@@ -7876,7 +7876,7 @@ procedure TSQLDBStatementWithParams.BindArrayRow(const aValues: array of const);
for i := 0 to high(aValues) do
with fParams[i] do begin
if length(VArray)<=fParamsArrayCount then
SetLength(VArray,fParamsArrayCount+fParamsArrayCount shr 3+64);
SetLength(VArray,NextGrow(fParamsArrayCount));
VInt64 := fParamsArrayCount;
if (VType=ftDate) and (aValues[i].VType=vtExtended) then
VArray[fParamsArrayCount] := // direct binding of TDateTime value
@@ -7906,7 +7906,7 @@ procedure TSQLDBStatementWithParams.BindFromRows(Rows: TSQLDBStatement);
for F := 0 to fParamCount-1 do
with fParams[F] do begin
if length(VArray)<=fParamsArrayCount then
SetLength(VArray,fParamsArrayCount+fParamsArrayCount shr 3+64);
SetLength(VArray,NextGrow(fParamsArrayCount));
if Rows.ColumnNull(F) then
VArray[fParamsArrayCount] := 'null' else
case Rows.ColumnType(F) of
@@ -1862,7 +1862,7 @@ constructor TSynMapFile.Create(const aExeName: TFileName=''; MabCreate: boolean=
while (P<PEnd) and (P^=' ') do inc(P);
repeat
if Count=n then begin
n := Count+Count shr 3+256;
n := NextGrow(n);
SetLength(U^.Line,n);
SetLength(U^.Addr,n);
end;
@@ -3977,7 +3977,7 @@ class function TSynLog.Enter(aInstance: TObject; aMethodName: PUTF8Char;
with aSynLog.fThreadContext^ do
try
if RecursionCount=RecursionCapacity then begin
inc(RecursionCapacity,4+RecursionCapacity shr 3);
RecursionCapacity := NextGrow(RecursionCapacity);
SetLength(Recursion,RecursionCapacity);
end;
{$ifdef CPU64}
@@ -4032,7 +4032,7 @@ class function TSynLog.Enter(const TextFmt: RawUTF8; const TextArgs: array of co
with aSynLog.fThreadContext^ do
try
if RecursionCount=RecursionCapacity then begin
inc(RecursionCapacity,4+RecursionCapacity shr 3);
RecursionCapacity := NextGrow(RecursionCapacity);
SetLength(Recursion,RecursionCapacity);
end;
with Recursion[RecursionCount] do begin
@@ -5971,7 +5971,7 @@ function TSynLogFileView.Select(aRow: integer): integer;
search := maxInt;
end;
if fSelectedCount=length(fSelected) then
SetLength(fSelected,fSelectedCount+256+fSelectedCount shr 3);
SetLength(fSelected,NextGrow(fSelectedCount));
fSelected[fSelectedCount] := i;
inc(fSelectedCount);
end;
@@ -2667,10 +2667,8 @@ procedure BSONItemsToDocVariant(Kind: TBSONElementType; BSON: PByte;
if n=0 then
break;
inc(cap,n); // pre-allocate Doc.Names[]/Values[]
if cap<512 then
Doc.Capacity := cap else
if Doc.Capacity<cap then
Doc.Capacity := cap+cap shr 3; // faster for huge arrays
if Doc.Capacity<cap then
Doc.Capacity := NextGrow(cap); // faster for huge arrays
for i := 0 to n-1 do begin
if Kind=betDoc then
if intnames<>nil then
@@ -3443,7 +3441,7 @@ procedure TBSONWriter.BSONWriteArray(const kind: TBSONElementType);
procedure TBSONWriter.BSONDocumentBegin;
begin
if fDocumentStack>=Length(fDocumentStackOffset) then
SetLength(fDocumentStackOffset,fDocumentStack+fDocumentStack shr 3+16);
SetLength(fDocumentStackOffset,NextGrow(fDocumentStack));
fDocumentStackOffset[fDocumentStack] := TotalWritten;
inc(fDocumentStack);
Write4(0);
@@ -3474,7 +3472,7 @@ procedure TBSONWriter.BSONDocumentEnd(CloseNumber: integer; WriteEndingZero: boo
raise EBSONException.CreateUTF8('Unexpected %.BSONDocumentEnd',[self]);
dec(fDocumentStack);
if fDocumentCount>=Length(fDocument) then
SetLength(fDocument,fDocumentCount+fDocumentCount shr 3+16);
SetLength(fDocument,NextGrow(fDocumentCount));
with fDocument[fDocumentCount] do begin
Offset := fDocumentStackOffset[fDocumentStack];
Length := TotalWritten-Offset;
@@ -4577,7 +4575,7 @@ function JSONBufferToBSONArray(JSON: PUTF8Char; out docs: TBSONDocumentDynArray;
exit;
W.ToBSONDocument(doc);
if n>=length(docs) then
SetLength(docs,n+64+length(docs) shr 3);
SetLength(docs,NextGrow(n));
docs[n] := doc;
inc(n);
W.CancelAll;
@@ -493,7 +493,7 @@ procedure TSynMustacheParser.AddTag(aKind: TSynMustacheTagKind;
if aEnd<=aStart then
exit;
if fTagCount>=length(fTemplate.fTags) then
SetLength(fTemplate.fTags,fTagCount+fTagCount shr 3+32);
SetLength(fTemplate.fTags,NextGrow(fTagCount));
with fTemplate.fTags[fTagCount] do begin
Kind := aKind;
SectionOppositeIndex := -1;
@@ -4577,7 +4577,7 @@ function GetWhereValues(var Where: TSynTableStatementWhere): boolean;
try
repeat
if n=length(v) then
SetLength(v,n+n shr 3+8);
SetLength(v,NextGrow(n));
if not GetWhereValue(v[n]) then
exit;
inc(n);
@@ -7438,7 +7438,7 @@ procedure TRawByteStringGroup.Add(const aItem: RawByteString);
if Values=nil then
Clear; // ensure all fields are initialized, even if on stack
if Count=Length(Values) then
SetLength(Values,Count+128+Count shr 3);
SetLength(Values,NextGrow(Count));
with Values[Count] do begin
Position := self.Position;
Value := aItem;
@@ -1 +1 @@
'1.18.5177'
'1.18.5178'

0 comments on commit a84dfa7

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