`Grid.forEachInAABB()`: no more callbacks

diff --git a/src/game/g_game.pas b/src/game/g_game.pas
index 12e8798431cbbeb7810b3218322a800d75a09c8f..6cbd3e4eddfab3d676657a20e6e71619ce551f12 100644 (file)
--- a/src/game/g_game.pas
+++ b/src/game/g_game.pas
@@ -22,7 +22,7 @@ uses
   SysUtils, Classes,
   MAPDEF,
   g_basic, g_player, e_graphics, g_res_downloader,
-  g_sound, g_gui, utils, md5, xprofiler;
+  g_sound, g_gui, utils, md5, mempool, xprofiler;
 
 type
   TGameSettings = record
@@ -1541,6 +1541,8 @@ var
   reliableUpdate: Boolean;
 begin
   g_ResetDynlights();
+  framePool.reset();
+
 // Ïîðà âûêëþ÷àòü èãðó:
   if gExit = EXIT_QUIT then
     Exit;

diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas
index 4c3b82643e593b51df955446367e982c7b2a2e87..41f03adea7bcf5fbd0bd7f3f6b402e840c4b955d 100644 (file)
--- a/src/game/g_grid.pas
+++ b/src/game/g_grid.pas
@@ -48,6 +48,8 @@ type
 
   generic TBodyGridBase<ITP> = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
   public
+    type PITP = ^ITP;
+
     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
     type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
     type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
@@ -191,7 +193,9 @@ type
     //WARNING: don't modify grid while any query is in progress (no checks are made!)
     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
     // no callback: return `true` on the first hit
-    function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
+    //function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
+    // return number of ITP thingys put into frame pool
+    function forEachInAABB (x, y, w, h: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Integer;
 
     //WARNING: don't modify grid while any query is in progress (no checks are made!)
     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
@@ -1429,7 +1433,8 @@ end;
 
 // ////////////////////////////////////////////////////////////////////////// //
 // no callback: return `true` on the first hit
-function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
+// return number of ITP thingys put into frame pool
+function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Integer;
 var
   idx: Integer;
   gx, gy: Integer;
@@ -1442,8 +1447,9 @@ var
   gw, gh: Integer;
   x0, y0: Integer;
   ptag: Integer;
+  presobj: PITP;
 begin
-  result := Default(ITP);
+  result := 0;
   if (w < 1) or (h < 1) then exit;
   tagmask := tagmask and TagFullMask;
   if (tagmask = 0) then exit;
@@ -1510,6 +1516,11 @@ begin
           if ((ptag and tagmask) = 0) then continue;
           if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
           if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
+          presobj := PITP(framePool.alloc(sizeof(ITP)));
+          Move(px.mObj, presobj^, sizeof(ITP));
+          Inc(result);
+          if (firstHit) then begin mInQuery := false; exit; end;
+          (*
           if assigned(cb) then
           begin
             if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
@@ -1520,6 +1531,7 @@ begin
             mInQuery := false;
             exit;
           end;
+          *)
         end;
         curci := cc.next;
       end;

diff --git a/src/game/g_map.pas b/src/game/g_map.pas
index 8b41389dd9d0800aedae01db5b15718eb52cce86..8e1068263bf2267005b9ab8f3f8adca6e0398eb4 100644 (file)
--- a/src/game/g_map.pas
+++ b/src/game/g_map.pas
@@ -20,7 +20,7 @@ unit g_map;
 interface
 
 uses
-  SysUtils, Classes,
+  SysUtils, Classes, mempool,
   e_graphics, g_basic, MAPDEF, g_textures,
   g_phys, utils, g_panel, g_grid, md5, binheap, xprofiler, xparser, xdynrec;
 
@@ -2615,32 +2615,68 @@ end;
 
 // new algo
 procedure g_Map_CollectDrawPanels (x0, y0, wdt, hgt: Integer);
-
+  (*
   function checker (pan: TPanel; tag: Integer): Boolean;
   begin
     result := false; // don't stop, ever
     if ((tag and GridTagDoor) <> 0) <> pan.Door then exit;
     gDrawPanelList.insert(pan);
   end;
-
+  *)
+var
+  pmark: PoolMark;
+  phit: PPanel;
+  hitcount: Integer;
 begin
   dplClear();
   //tagmask := panelTypeToTag(PanelType);
-  mapGrid.forEachInAABB(x0, y0, wdt, hgt, checker, GridDrawableMask);
+  //mapGrid.forEachInAABB(x0, y0, wdt, hgt, checker, GridDrawableMask);
+  pmark := framePool.mark();
+  hitcount := mapGrid.forEachInAABB(x0, y0, wdt, hgt, GridDrawableMask);
+  if (hitcount = 0) then exit;
+  phit := PPanel(framePool.getPtr(pmark));
+  while (hitcount > 0) do
+  begin
+    if ((phit^.tag and GridTagDoor) <> 0) <> phit^.Door then
+    begin
+    end
+    else
+    begin
+      gDrawPanelList.insert(phit^);
+    end;
+    Inc(phit);
+    Dec(hitcount);
+  end;
+  framePool.release(pmark);
   // list will be rendered in `g_game.DrawPlayer()`
 end;
 
 
-procedure g_Map_DrawPanelShadowVolumes(lightX: Integer; lightY: Integer; radius: Integer);
-
+procedure g_Map_DrawPanelShadowVolumes (lightX: Integer; lightY: Integer; radius: Integer);
+  (*
   function checker (pan: TPanel; tag: Integer): Boolean;
   begin
     result := false; // don't stop, ever
     pan.DrawShadowVolume(lightX, lightY, radius);
   end;
-
+  *)
+var
+  pmark: PoolMark;
+  phit: PPanel;
+  hitcount: Integer;
 begin
-  mapGrid.forEachInAABB(lightX-radius, lightY-radius, radius*2, radius*2, checker, (GridTagWall or GridTagDoor));
+  //mapGrid.forEachInAABB(lightX-radius, lightY-radius, radius*2, radius*2, checker, (GridTagWall or GridTagDoor));
+  pmark := framePool.mark();
+  hitcount := mapGrid.forEachInAABB(lightX-radius, lightY-radius, radius*2, radius*2, (GridTagWall or GridTagDoor));
+  if (hitcount = 0) then exit;
+  phit := PPanel(framePool.getPtr(pmark));
+  while (hitcount > 0) do
+  begin
+    phit^.DrawShadowVolume(lightX, lightY, radius);
+    Inc(phit);
+    Dec(hitcount);
+  end;
+  framePool.release(pmark);
 end;
 
 
@@ -2806,6 +2842,7 @@ end;
 function g_Map_CollidePanel(X, Y: Integer; Width, Height: Word; PanelType: Word; b1x3: Boolean): Boolean;
 const
   SlowMask = GridTagLift or GridTagBlockMon;
+
   function checker (pan: TPanel; tag: Integer): Boolean;
   begin
     {
@@ -2840,7 +2877,12 @@ const
 
 var
   tagmask: Integer = 0;
+  pmark: PoolMark;
+  phit: PPanel;
+  hitcount: Integer;
+  pan: TPanel;
 begin
+  result := false;
   if WordBool(PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR)) then tagmask := tagmask or (GridTagWall or GridTagDoor);
   if WordBool(PanelType and PANEL_WATER) then tagmask := tagmask or GridTagWater;
   if WordBool(PanelType and PANEL_ACID1) then tagmask := tagmask or GridTagAcid1;
@@ -2849,12 +2891,12 @@ begin
   if WordBool(PanelType and (PANEL_LIFTUP or PANEL_LIFTDOWN or PANEL_LIFTLEFT or PANEL_LIFTRIGHT)) then tagmask := tagmask or GridTagLift;
   if WordBool(PanelType and PANEL_BLOCKMON) then tagmask := tagmask or GridTagBlockMon;
 
-  if (tagmask = 0) then begin result := false; exit; end; // just in case
+  if (tagmask = 0) then exit; // just in case
 
   if (profMapCollision <> nil) then profMapCollision.sectionBeginAccum('*solids');
   if gdbg_map_use_accel_coldet then
   begin
-    if (Width = 1) and (Height = 1) then
+    {if (Width = 1) and (Height = 1) then
     begin
       if ((tagmask and SlowMask) <> 0) then
       begin
@@ -2867,18 +2909,50 @@ begin
         result := (mapGrid.forEachAtPoint(X, Y, nil, tagmask) <> nil);
       end;
     end
-    else
+    else}
     begin
+      pmark := framePool.mark();
       if ((tagmask and SlowMask) <> 0) then
       begin
         // slow
-        result := (mapGrid.forEachInAABB(X, Y, Width, Height, checker, tagmask) <> nil);
+        //result := (mapGrid.forEachInAABB(X, Y, Width, Height, checker, tagmask) <> nil);
+        hitcount := mapGrid.forEachInAABB(X, Y, Width, Height, tagmask);
+        //if (hitcount = 0) then exit;
+        phit := PPanel(framePool.getPtr(pmark));
+        while (hitcount > 0) do
+        begin
+          pan := phit^;
+          if ((pan.tag and GridTagLift) <> 0) then
+          begin
+            result :=
+              ((WordBool(PanelType and PANEL_LIFTUP) and (pan.LiftType = 0)) or
+               (WordBool(PanelType and PANEL_LIFTDOWN) and (pan.LiftType = 1)) or
+               (WordBool(PanelType and PANEL_LIFTLEFT) and (pan.LiftType = 2)) or
+               (WordBool(PanelType and PANEL_LIFTRIGHT) and (pan.LiftType = 3))) {and
+               g_Collide(X, Y, Width, Height, pan.X, pan.Y, pan.Width, pan.Height)};
+          end
+          else if ((pan.tag and GridTagBlockMon) <> 0) then
+          begin
+            result := ((not b1x3) or (pan.Width+pan.Height >= 64)); //and g_Collide(X, Y, Width, Height, pan.X, pan.Y, pan.Width, pan.Height);
+          end
+          else
+          begin
+            // other shit
+            result := true; // i found her!
+          end;
+          if (result) then break;
+          Inc(phit);
+          Dec(hitcount);
+        end;
       end
       else
       begin
         // fast
-        result := (mapGrid.forEachInAABB(X, Y, Width, Height, nil, tagmask) <> nil);
+        //result := (mapGrid.forEachInAABB(X, Y, Width, Height, nil, tagmask) <> nil);
+        hitcount := mapGrid.forEachInAABB(X, Y, Width, Height, tagmask, false, true); // return first hit
+        result := (hitcount > 0);
       end;
+      framePool.release(pmark);
     end;
   end
   else
@@ -2889,11 +2963,35 @@ begin
 end;
 
 
+// returns `true` if we need to stop
+function liquidChecker (pan: TPanel; var texid: DWORD; var cctype: Integer): Boolean; inline;
+begin
+  result := false;
+  //if ((tag and (GridTagWater or GridTagAcid1 or GridTagAcid2)) = 0) then exit;
+  // check priorities
+  case cctype of
+    0: if ((pan.tag and GridTagWater) = 0) then exit; // allowed: water
+    1: if ((pan.tag and (GridTagWater or GridTagAcid1)) = 0) then exit; // allowed: water, acid1
+    //2: if ((tag and (GridTagWater or GridTagAcid1 or GridTagAcid2) = 0) then exit; // allowed: water, acid1, acid2
+  end;
+  // collision?
+  //if not g_Collide(X, Y, Width, Height, pan.X, pan.Y, pan.Width, pan.Height) then exit;
+  // yeah
+  texid := pan.GetTextureID();
+  // water? water has the highest priority, so stop right here
+  if ((pan.tag and GridTagWater) <> 0) then begin cctype := 0; result := true; exit; end;
+  // acid2?
+  if ((pan.tag and GridTagAcid2) <> 0) then cctype := 2;
+  // acid1?
+  if ((pan.tag and GridTagAcid1) <> 0) then cctype := 1;
+end;
+
 function g_Map_CollideLiquid_Texture(X, Y: Integer; Width, Height: Word): DWORD;
 var
   cctype: Integer = 3; // priority: 0: water was hit, 1: acid1 was hit, 2: acid2 was hit; 3: nothing was hit
-  texid: DWORD;
+  //texid: DWORD;
 
+  (*
   // slightly different from the old code, but meh...
   function checker (pan: TPanel; tag: Integer): Boolean;
   begin
@@ -2916,12 +3014,18 @@ var
     // acid1?
     if ((tag and GridTagAcid1) <> 0) then cctype := 1;
   end;
-
+  *)
+var
+  pmark: PoolMark;
+  phit: PPanel;
+  hitcount: Integer;
+  pan: TPanel;
 begin
   if (profMapCollision <> nil) then profMapCollision.sectionBeginAccum('liquids');
   if gdbg_map_use_accel_coldet then
   begin
-    texid := LongWord(TEXTURE_NONE);
+    {texid}result := LongWord(TEXTURE_NONE);
+    {
     if (Width = 1) and (Height = 1) then
     begin
       mapGrid.forEachAtPoint(X, Y, checker, (GridTagWater or GridTagAcid1 or GridTagAcid2));
@@ -2930,7 +3034,20 @@ begin
     begin
       mapGrid.forEachInAABB(X, Y, Width, Height, checker, (GridTagWater or GridTagAcid1 or GridTagAcid2));
     end;
-    result := texid;
+    }
+    pmark := framePool.mark();
+    hitcount := mapGrid.forEachInAABB(X, Y, Width, Height, (GridTagWater or GridTagAcid1 or GridTagAcid2));
+    if (hitcount = 0) then exit;
+    phit := PPanel(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      pan := phit^;
+      Inc(phit);
+      Dec(hitcount);
+      if (liquidChecker(pan, result, cctype)) then break;
+    end;
+    framePool.release(pmark);
+    //result := texid;
   end
   else
   begin

diff --git a/src/game/g_monsters.pas b/src/game/g_monsters.pas
index bd4cd36be433fe2a7ec766052adb2dda140f19c2..e2f04a636d7408c7dfaca723cc15f02608451930 100644 (file)
--- a/src/game/g_monsters.pas
+++ b/src/game/g_monsters.pas
@@ -22,7 +22,7 @@ interface
 
 uses
   SysUtils, Classes,
-  {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
+  mempool,
   g_basic, e_graphics, g_phys, g_textures, g_grid,
   g_saveload, g_panel, xprofiler;
 
@@ -50,6 +50,7 @@ const
 }
 
 type
+  PMonster = ^TMonster;
   TMonster = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
   private
     FMonsterType: Byte;
@@ -757,6 +758,7 @@ end;
 
 function isCorpse (o: PObj; immediately: Boolean): Integer;
 
+  (*
   function monsCollCheck (mon: TMonster; atag: Integer): Boolean;
   begin
     atag := atag; // shut up, fpc!
@@ -771,10 +773,14 @@ function isCorpse (o: PObj; immediately: Boolean): Integer;
       result := true;
     end;
   end;
+  *)
 
 var
   a: Integer;
-  mon: TMonster;
+  mon: TMonster = nil;
+  pmark: PoolMark;
+  phit: PMonster;
+  hitcount: Integer;
 begin
   result := -1;
 
@@ -784,7 +790,25 @@ begin
   // Èùåì ìåðòâûõ ìîíñòðîâ ïîáëèçîñòè
   if gmon_debug_use_sqaccel then
   begin
-    mon := monsGrid.forEachInAABB(o.X+o.Rect.X, o.Y+o.Rect.Y, o.Rect.Width, o.Rect.Height, monsCollCheck);
+    //mon := monsGrid.forEachInAABB(o.X+o.Rect.X, o.Y+o.Rect.Y, o.Rect.Width, o.Rect.Height, monsCollCheck);
+    //if (mon <> nil) then result := mon.mArrIdx;
+    pmark := framePool.mark();
+    hitcount := monsGrid.forEachInAABB(o.X+o.Rect.X, o.Y+o.Rect.Y, o.Rect.Width, o.Rect.Height);
+    if (hitcount = 0) then exit;
+    phit := PMonster(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      mon := phit^;
+      Inc(phit);
+      Dec(hitcount);
+      case mon.FMonsterType of // Íå âîñêðåñèòü:
+        MONSTER_SOUL, MONSTER_PAIN, MONSTER_CYBER, MONSTER_SPIDER,
+        MONSTER_VILE, MONSTER_BARREL, MONSTER_ROBO: mon := nil;
+        // Îñòàëüíûõ ìîæíî âîñêðåñèòü
+      end;
+      if (mon <> nil) then break;
+    end;
+    framePool.release(pmark);
     if (mon <> nil) then result := mon.mArrIdx;
   end
   else
@@ -4688,21 +4712,36 @@ end;
 
 
 function g_Mons_IsAnyAliveAt (x, y: Integer; width, height: Integer): Boolean;
-
+  (*
   function monsCollCheck (mon: TMonster; atag: Integer): Boolean;
   begin
     result := mon.alive;// and g_Obj_Collide(x, y, width, height, @mon.Obj));
   end;
-
+  *)
 var
   idx: Integer;
   mon: TMonster;
+  pmark: PoolMark;
+  phit: PMonster;
+  hitcount: Integer;
 begin
   result := false;
   if (width < 1) or (height < 1) then exit;
   if gmon_debug_use_sqaccel then
   begin
-    result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil);
+    //result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil);
+    pmark := framePool.mark();
+    hitcount := monsGrid.forEachInAABB(x, y, width, height);
+    if (hitcount = 0) then exit;
+    phit := PMonster(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      mon := phit^;
+      Inc(phit);
+      Dec(hitcount);
+      if (mon.alive) then begin result := true; break; end;
+    end;
+    framePool.release(pmark);
   end
   else
   begin
@@ -4723,21 +4762,36 @@ end;
 
 
 function g_Mons_ForEachAt (x, y: Integer; width, height: Integer; cb: TEachMonsterCB): Boolean;
-
+  (*
   function monsCollCheck (mon: TMonster; atag: Integer): Boolean;
   begin
     result := cb(mon);
   end;
-
+  *)
 var
   idx: Integer;
   mon: TMonster;
+  pmark: PoolMark;
+  phit: PMonster;
+  hitcount: Integer;
 begin
   result := false;
   if (width < 1) or (height < 1) then exit;
   if gmon_debug_use_sqaccel then
   begin
-    result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil);
+    //result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil);
+    pmark := framePool.mark();
+    hitcount := monsGrid.forEachInAABB(x, y, width, height);
+    if (hitcount = 0) then exit;
+    phit := PMonster(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      mon := phit^;
+      Inc(phit);
+      Dec(hitcount);
+      if (cb(mon)) then begin result := true; break; end;
+    end;
+    framePool.release(pmark);
   end
   else
   begin
@@ -4758,22 +4812,26 @@ end;
 
 
 function g_Mons_ForEachAliveAt (x, y: Integer; width, height: Integer; cb: TEachMonsterCB): Boolean;
-
+  (*
   function monsCollCheck (mon: TMonster; atag: Integer): Boolean;
   begin
     //result := false;
     //if mon.alive and g_Obj_Collide(x, y, width, height, @mon.Obj) then result := cb(mon);
     if mon.alive then result := cb(mon) else result := false;
   end;
-
+  *)
 var
   idx: Integer;
   mon: TMonster;
+  pmark: PoolMark;
+  phit: PMonster;
+  hitcount: Integer;
 begin
   result := false;
   if (width < 1) or (height < 1) then exit;
   if gmon_debug_use_sqaccel then
   begin
+    {
     if (width = 1) and (height = 1) then
     begin
       result := (monsGrid.forEachAtPoint(x, y, monsCollCheck) <> nil);
@@ -4782,6 +4840,22 @@ begin
     begin
       result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil);
     end;
+    }
+    pmark := framePool.mark();
+    hitcount := monsGrid.forEachInAABB(x, y, width, height);
+    if (hitcount = 0) then exit;
+    phit := PMonster(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      mon := phit^;
+      Inc(phit);
+      Dec(hitcount);
+      if (mon.alive) then
+      begin
+        if (cb(mon)) then begin result := true; break; end;
+      end;
+    end;
+    framePool.release(pmark);
   end
   else
   begin

diff --git a/src/game/g_panel.pas b/src/game/g_panel.pas
index 3969cba96bf4fbc02499c462835caa8a69e4394f..abd27c93f72b23dbaad383e7f0b8b3dbde0aa44c 100644 (file)
--- a/src/game/g_panel.pas
+++ b/src/game/g_panel.pas
@@ -30,6 +30,7 @@ type
       Anim: Boolean;
     end;
 
+  PPanel = ^TPanel;
   TPanel = Class (TObject)
   private
     const

diff --git a/src/shared/mempool.pas b/src/shared/mempool.pas
index 7d30a9bc92e12f5fb02e90fd2cb10fe1584f884c..1604055c028f6620f115998343a90966a458eb5d 100644 (file)
--- a/src/shared/mempool.pas
+++ b/src/shared/mempool.pas
@@ -59,8 +59,141 @@ type
   end;
 {$ENDIF}
 
+(* Simple "mark/release" allocator *)
+type
+  PoolMark = Integer;
+
+  TPoolMarkRelease = record
+  private
+    mMemory: Pointer;
+    mSize: Integer;
+    mUsed: Integer;
+
+  public
+    constructor Create (aInitSize: Integer);
+
+    // free all allocated memory
+    procedure kill ();
+
+    // forget everything
+    procedure reset ();
+
+    // mark current position
+    function mark (): PoolMark; inline;
+    // forget everything from the given mark
+    procedure release (amark: PoolMark); inline;
+
+    // allocate some memory
+    // WARNING! pool can realloc it's internal storage and invalidate all previous pointers!
+    function alloc (size: Integer): Pointer; inline;
+
+    // get pointer for the given mark
+    // WARNING! pointer can become invalid after next call to `alloc()`!
+    function getPtr (amark: PoolMark): Pointer; inline;
+  end;
+
+
+var
+  framePool: TPoolMarkRelease; // temporary per-frame allocation pool
+
+
 implementation
 
+uses
+  SysUtils
+{$IFDEF USE_MEMPOOL}
+  , hashtable
+{$ENDIF}
+  ;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TPoolMarkRelease.Create (aInitSize: Integer);
+begin
+  if (aInitSize > 0) then
+  begin
+    mSize := aInitSize;
+    GetMem(mMemory, mSize);
+  end
+  else
+  begin
+    mMemory := nil;
+    mSize := 0;
+  end;
+  mUsed := 0;
+end;
+
+
+// free all allocated memory
+procedure TPoolMarkRelease.kill ();
+begin
+  if (mMemory <> nil) then FreeMem(mMemory);
+  mMemory := nil;
+  mSize := 0;
+  mUsed := 0;
+end;
+
+
+// forget everything
+procedure TPoolMarkRelease.reset ();
+begin
+  mUsed := 0;
+end;
+
+
+// mark current position
+function TPoolMarkRelease.mark (): PoolMark; inline;
+begin
+  result := mUsed;
+end;
+
+
+// forget everything from the given mark
+procedure TPoolMarkRelease.release (amark: PoolMark); inline;
+begin
+  if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (release)');
+  mUsed := amark;
+end;
+
+
+// allocate some memory
+// WARNING! pool can realloc it's internal storage and invalidate all previous pointers!
+function TPoolMarkRelease.alloc (size: Integer): Pointer; inline;
+begin
+  if (size < 0) then raise Exception.Create('MarkReleasePool: cannot allocate negative amount of bytes');
+  if (size > 1024*1024) then raise Exception.Create('MarkReleasePool: why do you need to allocate more than 1MB?');
+  // do we need to get more memory?
+  if (mUsed+size > mSize) then
+  begin
+    if (mUsed+size > 1024*1024*64) then raise Exception.Create('MarkReleasePool: more than 64MB in MarkReleasePool is insanity!');
+    while (mUsed+size > mSize) do
+    begin
+      // less than 256KB: 64KB steps
+      if (mSize < 256*1024) then mSize += 64*1024
+      // less than 1MB: 128KB steps
+      else if (mSize < 1024*1024) then mSize += 128*1024
+      // otherwise, 1MB steps
+      else mSize += 1024*1024;
+    end;
+    ReallocMem(mMemory, mSize);
+    if (mMemory = nil) then raise Exception.Create('MarkReleasePool: out of memory!');
+  end;
+  result := Pointer(PAnsiChar(mMemory)+mUsed);
+  mUsed += size;
+  assert(mUsed <= mSize);
+end;
+
+
+// get pointer for the given mark
+// WARNING! pointer can become invalid after next call to `alloc()`!
+function TPoolMarkRelease.getPtr (amark: PoolMark): Pointer; inline;
+begin
+  if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (getPtr)');
+  result := Pointer(PAnsiChar(mMemory)+amark);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
 {$IFDEF USE_MEMPOOL}
 uses
   hashtable;
@@ -187,6 +320,7 @@ end;
 
 initialization
   //mpoolMap := TMemPool.Create('textmap', 64);
+  framePool := TPoolMarkRelease.Create(65536);
 finalization
   {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
   dumpPools();

diff --git a/src/shared/xprofiler.pas b/src/shared/xprofiler.pas
index 9584fe63aac03b7473ec5983cc380dc4c376d325..efca52fcafad7736e72f30afe8dce85aa6352398 100644 (file)
--- a/src/shared/xprofiler.pas
+++ b/src/shared/xprofiler.pas
@@ -468,8 +468,8 @@ begin
     begin
       if (xpsecs[idx].name = aName) then
       begin
-        if (idx = xpscur) then raise Exception.Create('profiler error(0): dobule resume: "'+aName+'"');
-        if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): dobule resume: "'+aName+'"');
+        if (idx = xpscur) then raise Exception.Create('profiler error(0): double resume: "'+aName+'"');
+        if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): double resume: "'+aName+'"');
         xpsecs[idx].prevAct := xpscur;
         xpscur := idx;
         xpsecs[idx].timer.resume();