unit uheapmanager;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  SysUtils;

const
  CMaxUsedBlocks = 64;
  CMaxFreeBlocks = 64;
  //No aumentar el tamaño. Con 16 MB se tranca
  CMaxHeapSize = 100 * 1024 * 1024;//100MB
  //CMaxHeapSize = 80;

type
  TPosicionBloque = (AntesDeTodo_NoContiguo,
                     AntesDeTodo_ContiguoDer,
                     EnMedio_ContiguoIzq,
                     EnMedio_NoContiguo,
                     EnMedio_ContiguoDer,
                     EnMedio_ContiguoIzqDer,
                     DespuesDeTodo_ContiguoIzq,
                     DespuesDeTodoNoContiguo);

  // Descriptores de bloques de memoria.
  TBlock = record
    pos: cardinal;
    size: cardinal;
  end;
  PBlock = ^TBlock;
  TDAOfPBlock = array of PBlock;

  THeapRec = record
    nBloquesUsados: Integer;  // número de bloques ocupados
    kmax_used_block: integer; // maximo indice de block usado
    kmax_free_block: integer; // maximo indice de block libre
    cnt_bytesfree: cardinal;  // cantidad de bytes libres TOTAL (no necesariamente contiguos)
    total_bytes: cardinal;    // total de bytes del heap

    used_blocks: array[1..CMaxUsedBlocks] of TBlock;  // descriptores de bloques usados.
    free_blocks: array[1..CMaxFreeBlocks] of TBLock;  // descriptores de bloques libres. Ordenados por posición en forma creciente.

  //  free_block_ofmaxsize: integer; // indice del bloque de mayor tamano libre
  end;
  PHeapRec = ^THeapRec;

  THeapBuffer = packed array[0.. CMaxHeapSize - 1] of byte;
  PHeapBuffer = ^THeapBuffer;

(* Recibe un puntero y un cardinal indicando la cantidad de bytes a manejar
en ese puntero. El Manejador no se encarga ni de crear la memoria ni de liberarla.

Hay dos array de descriptores de bloques, de longitud fija que se usan para
llevar cuenta de los bloques libres y usados.

Para hacer más eficiente la busqueda en los array de descriptores se
llevan actualizadas las variables kmax_used_block y kmax_free_block

de forma que la busqueda se realiza entre 1 y esos valores en cada array de
descriptores.

Cuando se libera un bloque llamando al block_free , el manejador revisa
si ese bloque es contiguo a otro libre y si es asi actualiza el descriptor
del bloque libre. Si no es asi incrementa en 1 kmax_free_block y guarda los valores
en un nuevo descriptor.
Al liberar un bloque se buscara en todo el array de descriptores de bloques libres
por los vecinos derecho e izquierdo. Si solo tiene un vecino, se actualiza el
descriptor del vecino encontrado para reflejar el nuevo bloque formado uniendo
el liberado con su vecino. Si tiene dos vecinos necesariamente sera un derecho
y un izquierdo. Al unir el bloque liberado con los dos vecinos debemos eliminar
uno de los vecinos, dado que ahora quedan unidos los vecinos por el bloque liberado.
Se eligira siempre eliminar el descriptor de mayor indice y si el indice del
bloque liberado es kmax_free_block se decrementara esta variable.
*)
  THeapManager = class
    private
      function posicionBloqueLibre(const bloque: TBlock; var iVecinoIzquierdo, iVecinoDerecho: Integer): TPosicionBloque;
      function insertarBloqueUsado(const bloque: TBlock): Integer;
      procedure insertarBloqueLibre(posicion: Integer; const bloque: TBlock);
      function insertarBloqueLibreEnOrdenCrecienteDePos(const bloque: TBlock): Integer;

//      function indiceMayorBloqueLibre: Integer;

      procedure quitarBloqueUsado(kBloque: Integer);
      procedure quitarBloqueLibre(kBloque: Integer);

      //Retorna un arreglo de tamaño nBloquesUsados, de punteros a los bloques
      //usados ordenados por posición
      //NO REEMPLAZAR used_blocks, las aplicaciones deben seguir accediendo a su
      //bloque con el indice en el orden que se les dió
      function quickSortUsedBlocks: TDAOfPBlock;
    public
      pHeapRecord: PHeapRec;
      pbuff: PHeapBuffer; // puntero al area de memoria

      constructor create(heapRec: PHeapRec; xbuff: PHeapBuffer);

      // retorna el indice de descriptor de bloque usado. 0 Si no puede allocar
      function block_alloc( nbytes: cardinal ): integer;
      // retorna el indice de descriptor de bloque usado y copia buff^ en el bloque
      // allocado
      function block_alloc_and_set( buff: Pointer; nbytes: cardinal ): integer;

      // retorna @pbuff[used_blocks[kblock]]
      //Se debe utilizar solo si se es el único con acceso al heap, si no una
      //defragmentación puede dejar invalido el puntero
      function block_ptr( kblock: integer ): pointer;

      //Asigna memoria suficiente para almacenar el bloque kblock en dest, copia
      //sus contenidos en dest^ y retorna la cantidad de bytes
      function block_copy(kblock: Integer; var dest: Pointer): Integer;

      // libera el block
      procedure block_free( kblock: integer);

      // retorna el tamaño del mayor bloque libre
      function sizeOfBiggestFreeBlock: cardinal;

      // retorna el espacio libre
      function sizeOfFreeBlocks: cardinal;

      // defragmenta
      procedure defrag;

      //Para debug
      procedure printHeapRec;
{$IFDEF DEBUG}
      function iBloqueUsadoPorPosicion(pos: Integer): Integer;
      procedure Clear;
{$ENDIF}
  end;

procedure inicializarHeap(pheapRecord: PHeapRec);
{$IFDEF DEBUG}
procedure testBasico;
procedure testLiberacionesContiguas;
procedure testLlenarHeapYDefrag;
procedure testInsertarMasDeLoQueSePuede;
procedure testBorrarAlgoQueNoHay;
{$ENDIF}

function posBloqueToString(posBloque: TPosicionBloque) : String;

implementation

procedure inicializarHeap(pheapRecord: PHeapRec);
var
  i: Integer;
begin
  with pheapRecord^ do
  begin
    nBloquesUsados:= 0;
    kmax_used_block:= 0;
    kmax_free_block:= 1;
    free_blocks[1].pos:= 0;
    free_blocks[1].size:= CMaxHeapSize;
    cnt_bytesfree:= CMaxHeapSize;
    total_bytes:= CMaxHeapSize;
//    free_block_ofmaxsize:= 1;
    for i:= 1 to CMaxUsedBlocks do
    begin
      used_blocks[i].pos:= 0;
      used_blocks[i].size:= 0;
    end;
  end;
end;

function posBloqueToString(posBloque: TPosicionBloque) : String;
begin
  case posBloque of
    AntesDeTodo_NoContiguo    : result:= 'AntesDeTodo_NoContiguo';
    AntesDeTodo_ContiguoDer   : result:= 'AntesDeTodo_ContiguoDer';
    EnMedio_ContiguoIzq       : result:= 'EnMedio_ContiguoIzq';
    EnMedio_NoContiguo        : result:= 'EnMedio_NoContiguo';
    EnMedio_ContiguoDer       : result:= 'EnMedio_ContiguoDer';
    EnMedio_ContiguoIzqDer    : result:= 'EnMedio_ContiguoIzqDer';
    DespuesDeTodo_ContiguoIzq : result:= 'DespuesDeTodo_ContiguoIzq';
    DespuesDeTodoNoContiguo   : result:= 'DespuesDeTodoNoContiguo';
  end;
end;

constructor THeapManager.create(heapRec: PHeapRec; xbuff: PHeapBuffer);
begin
  inherited create;
  self.pHeapRecord:= heapRec;
  self.pbuff:= xbuff;
end;

// retorna el indice de descriptor de bloque usado
function THeapManager.block_alloc( nbytes: cardinal ): integer;
var
  i, iBloqueMinSizeMayorQueNBytes: Integer;
  minSizeMayorQueNBytes: Cardinal;
  bloqueAllocado: TBlock;
  pBloqueLibreEncontrado: PBlock;
begin
  if (pHeapRecord^.cnt_bytesfree >= nbytes) and
     (pHeapRecord^.nBloquesUsados < CMaxUsedBlocks) then
  begin
    iBloqueMinSizeMayorQueNBytes:= 0;
    minSizeMayorQueNBytes:= MaxInt;
    for i:= 1 to pHeapRecord^.kmax_free_block do
      if (pHeapRecord^.free_blocks[i].size >= nbytes) and
         (pHeapRecord^.free_blocks[i].size <= minSizeMayorQueNBytes) then//El igual es para que sea el ultimo posible de mínimo tamaño
      begin
        minSizeMayorQueNBytes:= pHeapRecord^.free_blocks[i].size;
        iBloqueMinSizeMayorQueNBytes:= i;
      end;
    if iBloqueMinSizeMayorQueNBytes = 0 then
    begin
      defrag;
      iBloqueMinSizeMayorQueNBytes:= 1;
    end;

    pBloqueLibreEncontrado:= @(pHeapRecord^.free_blocks[iBloqueMinSizeMayorQueNBytes]);

    //Manipular bloques libres y crear el bloque allocado
    if pBloqueLibreEncontrado^.size = nbytes then //Si ocupo todo el bloque lo remuevo de la lista
    begin
      bloqueAllocado.pos:= pBloqueLibreEncontrado^.pos;
      bloqueAllocado.size:= nbytes;

      for i:= iBloqueMinSizeMayorQueNBytes to pHeapRecord^.kmax_free_block - 1 do
        pHeapRecord^.free_blocks[i]:= pHeapRecord^.free_blocks[i + 1];
      pHeapRecord^.kmax_free_block:= pHeapRecord^.kmax_free_block - 1;
    end
    else //Si no achico el tamaño del bloque libre
    begin
      pBloqueLibreEncontrado^.size:= pBloqueLibreEncontrado^.size - nbytes;

      bloqueAllocado.pos:= pBloqueLibreEncontrado^.pos + pBloqueLibreEncontrado^.size;
      bloqueAllocado.size:= nbytes;
    end;

    pHeapRecord^.cnt_bytesfree:= pHeapRecord^.cnt_bytesfree - bloqueAllocado.size;
    //Manipular los bloques usados
    result:= insertarBloqueUsado(bloqueAllocado);
  end
  else
    result:= 0;
end;

function THeapManager.block_alloc_and_set( buff: Pointer; nbytes: cardinal ): integer;
var
  res: Integer;
  destino: PByte;
begin
  res:= block_alloc(nbytes);
  if res > 0 then
  begin
    destino:= @pbuff^[pHeapRecord^.used_blocks[res].pos];
    Move(buff^, destino^, nbytes);
  end
  else
    raise Exception.Create('THeapManager.block_alloc_and_set: No pude allocar un bloque de tamaño ' + IntToStr(nbytes));
  result:= res;
end;

// retorna @pbuff[used_blocks[kblock]]
function THeapManager.block_ptr( kblock: integer ): pointer;
begin
  result:= @pbuff^[pHeapRecord^.used_blocks[kblock].pos];
end;

function THeapManager.block_copy(kblock: Integer; var dest: Pointer): Integer;
var
  origen: PByte;
  nBytes: Integer;
begin
  origen:= @pbuff^[pHeapRecord^.used_blocks[kblock].pos];
  nBytes:= pHeapRecord^.used_blocks[kblock].size;
  GetMem(dest, nBytes);
  Move(origen^, dest^, pHeapRecord^.used_blocks[kblock].size);
  result:= nBytes;
end;

// libera el block
procedure THeapManager.block_free( kblock: integer);
var
  iVecinoIzquierdo, iVecinoDerecho: Integer;
  bloqueALiberar: TBlock;
  posBloque: TPosicionBloque;
begin
  Assert(kblock <= pHeapRecord^.kmax_used_block, 'THeapManager.block_free: pidieron liberar un bloque con kblock = ' + IntToStr(kblock) + ' y kmax_used_block = ' + IntToStr(pHeapRecord^.kmax_used_block));
  Assert(pHeapRecord^.used_blocks[kblock].size > 0, 'THeapManager.block_free: pidieron liberar un bloque con kblock = ' + IntToStr(kblock) + ' que no esta utilizado');

  bloqueALiberar:= pHeapRecord^.used_blocks[kblock];
  posBloque:= posicionBloqueLibre(bloqueALiberar, iVecinoIzquierdo, iVecinoDerecho);

  case posBloque of
    AntesDeTodo_NoContiguo    : insertarBloqueLibreEnOrdenCrecienteDePos(bloqueALiberar);
    AntesDeTodo_ContiguoDer   : begin
                                  pHeapRecord^.free_blocks[1].pos:= bloqueALiberar.pos;
                                  pHeapRecord^.free_blocks[1].size:= pHeapRecord^.free_blocks[1].size + bloqueALiberar.size;
                                end;
    EnMedio_ContiguoIzq       : pHeapRecord^.free_blocks[iVecinoIzquierdo].size:= pHeapRecord^.free_blocks[iVecinoIzquierdo].size + bloqueALiberar.size;
    EnMedio_NoContiguo        : insertarBloqueLibre(iVecinoDerecho, bloqueALiberar);
    EnMedio_ContiguoDer       : begin
                                  pHeapRecord^.free_blocks[iVecinoDerecho].pos:= bloqueALiberar.pos;
                                  pHeapRecord^.free_blocks[iVecinoDerecho].size:= pHeapRecord^.free_blocks[iVecinoDerecho].size + bloqueALiberar.size;
                                end;
    EnMedio_ContiguoIzqDer    : begin
                                  pHeapRecord^.free_blocks[iVecinoIzquierdo].size:= pHeapRecord^.free_blocks[iVecinoIzquierdo].size + bloqueALiberar.size + pHeapRecord^.free_blocks[iVecinoDerecho].size;
                                  quitarBloqueLibre(iVecinoDerecho);
                                end;
    DespuesDeTodo_ContiguoIzq : pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block].size:= pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block].size + bloqueALiberar.size;
    DespuesDeTodoNoContiguo   : begin
                                  pHeapRecord^.kmax_free_block:= pHeapRecord^.kmax_free_block + 1;
                                  pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block]:= bloqueALiberar;
                                end;
  end;
  pHeapRecord^.cnt_bytesfree:= pHeapRecord^.cnt_bytesfree + bloqueALiberar.size;
  quitarBloqueUsado(kblock);
end;

// retorna el tamaño del mayor bloque libre

function THeapManager.sizeOfBiggestFreeBlock: cardinal;
begin
  raise Exception.Create('THeapManager.sizeOfBiggestFreeBlock->Sin implementar');
  //Para sacar el warning en FPC
  result:= 0;
//  result:= pHeapRecord^.free_blocks[pHeapRecord.free_block_ofmaxsize].size;
end;

// retorna el espacio libre
function THeapManager.sizeOfFreeBlocks: cardinal;
begin
  result:= pHeapRecord^.cnt_bytesfree;
end;

// defragmenta
procedure THeapManager.defrag;
var
  i: integer;
  iPos: cardinal;
  bloquesOrdenados: TDAOfPBlock;
begin
  bloquesOrdenados:= quickSortUsedBlocks;

  iPos:= 0;
  for i:= 0 to High(bloquesOrdenados) do
  begin
    if bloquesOrdenados[i]^.pos <> iPos then
    begin
      Move( pbuff[bloquesOrdenados[i]^.pos], pbuff[iPos], bloquesOrdenados[i]^.size);
      bloquesOrdenados[i]^.pos:= iPos;
    end;
    iPos:= iPos + bloquesOrdenados[i]^.size;
  end;

  pHeapRecord^.kmax_free_block:= 1;
//  pHeapRecord^.free_block_ofmaxsize:= 1;
  pHeapRecord^.free_blocks[1].pos:= iPos;
  pHeapRecord^.free_blocks[1].size:= pHeapRecord^.total_bytes - iPos;

  setlength( bloquesOrdenados, 0 );
end;

procedure THeapManager.printHeapRec;
var
  i: Integer;
  bloque: TBlock;
begin
  writeln('kmax_used_block= ', pHeapRecord^.kmax_used_block);
  writeln('nBloquesUsados= ', pHeapRecord^.nBloquesUsados);
  write('used_blocks= ');
  if pHeapRecord^.kmax_used_block >= 1 then
  begin
    for i:= 1 to pHeapRecord^.kmax_used_block - 1 do
    begin
      bloque:= pHeapRecord^.used_blocks[i];
      if bloque.size > 0 then
        write('[', bloque.pos,  ':', bloque.size, '], ');
    end;

    bloque:= pHeapRecord^.used_blocks[pHeapRecord^.kmax_used_block];
    Writeln('[', bloque.pos,  ':', bloque.size, '];');
  end
  else
    writeln('[];');

  writeln('kmax_free_block= ', pHeapRecord^.kmax_free_block);
  write('free_blocks= ');  
  if pHeapRecord^.kmax_free_block >= 1 then
  begin
    for i:= 1 to pHeapRecord^.kmax_free_block - 1 do
      write('[', pHeapRecord^.free_blocks[i].pos,  ':', pHeapRecord^.free_blocks[i].size, '], ');
    Writeln('[', pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block].pos,  ':', pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block].size, '];');
  end
  else
    writeln('[];');

  Writeln('cnt_bytesfree= ', pHeapRecord^.cnt_bytesfree);
  Writeln('total_bytes= ', pHeapRecord^.total_bytes);

//  Writeln('free_block_ofmaxsize= ', pHeapRecord^.free_block_ofmaxsize);
end;

{$IFDEF DEBUG}
function THeapManager.iBloqueUsadoPorPosicion(pos: Integer): Integer;
var
  i, res: Integer;
begin
  res:= 0;
  for i:= 1 to pHeapRecord^.kmax_used_block do
    if pHeapRecord^.used_blocks[i].pos = pos then
    begin
      res:= i;
      break;
    end;
  result:= res;
end;

procedure THeapManager.Clear;
begin
  inicializarHeap(pHeapRecord);
end;
{$ENDIF}

function THeapManager.posicionBloqueLibre(const bloque: TBlock; var iVecinoIzquierdo, iVecinoDerecho: Integer): TPosicionBloque;
var
  i: Integer;
begin
  if pHeapRecord^.kmax_free_block = 0 then
    Result:= DespuesDeTodoNoContiguo
  else if bloque.pos < pHeapRecord^.free_blocks[1].pos then
  begin
    if bloque.pos + bloque.size = pHeapRecord^.free_blocks[1].pos then
    begin
      result:= AntesDeTodo_ContiguoDer;
    end
    else
      result:= AntesDeTodo_NoContiguo;
  end
  else
  begin
    i:= 2;
    while (i <= pHeapRecord^.kmax_free_block) and
          (pHeapRecord^.free_blocks[i].pos < bloque.pos) do
      i:= i + 1;

    //El bloque en la posición i es el primero con pos > bloque.pos
    if i <= pHeapRecord^.kmax_free_block then
    begin
      iVecinoIzquierdo:= i - 1;
      iVecinoDerecho:= i;

      //Contiguo izquierdo
      if pHeapRecord^.free_blocks[i - 1].pos + pHeapRecord^.free_blocks[i - 1].size = bloque.pos then
      begin
        //Contiguo derecho, contiguo izquierdo
        if bloque.pos + bloque.size = pHeapRecord^.free_blocks[i].pos then
        begin
          result:= EnMedio_ContiguoIzqDer;
        end
        else
          result:= EnMedio_ContiguoIzq;
      end //Contiguo derecho, no contiguo izquierdo
      else if bloque.pos + bloque.size = pHeapRecord^.free_blocks[i].pos then
      begin
        result:= EnMedio_ContiguoDer;
      end
      else
        result:= EnMedio_NoContiguo
    end
    else
    begin
      if pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block].pos + pHeapRecord^.free_blocks[pHeapRecord^.kmax_free_block].size = bloque.pos then
      begin
        result:= DespuesDeTodo_ContiguoIzq;
      end
      else
        result:= DespuesDeTodoNoContiguo;
    end;
  end;
end;

function THeapManager.insertarBloqueUsado(const bloque: TBlock): Integer;
var
  i, iBloque: Integer;
begin
  iBloque:= -1;
  for i:= 1 to pHeapRecord^.kmax_used_block do
  begin
    if pHeapRecord^.used_blocks[i].size = 0 then
    begin
      iBloque:= i;
      break;
    end;
  end;

  if iBloque = -1 then
  begin
    pHeapRecord^.kmax_used_block:= pHeapRecord^.kmax_used_block + 1;
    iBloque:= pHeapRecord^.kmax_used_block;
  end;
  pHeapRecord^.nBloquesUsados:= pHeapRecord^.nBloquesUsados + 1;
  pHeapRecord^.used_blocks[iBloque]:= bloque;
  result:= iBloque;
{  iBloque:= 1;
  for i:= 1 to pHeapRecord^.kmax_used_block do
  begin
    if bloque.pos < pHeapRecord^.used_blocks[i].pos then
    begin
      iBloque:= i;
      break;
    end;
  end;
  pHeapRecord^.kmax_used_block:= pHeapRecord^.kmax_used_block + 1;
  for i:= pHeapRecord^.kmax_used_block downto iBloque + 1 do
  begin
    pHeapRecord^.used_blocks[i]:= pHeapRecord^.used_blocks[i - 1];
  end;
  pHeapRecord^.used_blocks[iBloque]:= bloque;
  result:= pHeapRecord^.kmax_used_block;  }
end;

procedure THeapManager.insertarBloqueLibre(posicion: Integer; const bloque: TBlock);
var
  i: Integer;
begin
  pHeapRecord^.kmax_free_block:= pHeapRecord^.kmax_free_block + 1;
  for i:= pHeapRecord^.kmax_free_block downto posicion + 1 do
    pHeapRecord^.free_blocks[i]:= pHeapRecord^.free_blocks[i - 1];
  pHeapRecord^.free_blocks[posicion]:= bloque;
end;

function THeapManager.insertarBloqueLibreEnOrdenCrecienteDePos(const bloque: TBlock): Integer;
var
  i, res: Integer;
begin
  res:= pHeapRecord^.kmax_free_block;
  for i:= 1 to pHeapRecord^.kmax_free_block do
  begin
    if bloque.pos < pHeapRecord^.free_blocks[i].pos then
    begin
      res:= i;
      break;
    end;
  end;
  pHeapRecord^.kmax_free_block:= pHeapRecord^.kmax_free_block + 1;
  for i:= pHeapRecord^.kmax_free_block downto res + 1 do
    pHeapRecord^.free_blocks[i]:= pHeapRecord^.free_blocks[i - 1];
  pHeapRecord^.free_blocks[res]:= bloque;
  result:= res;
end;

(*
function THeapManager.indiceMayorBloqueLibre: Integer;
var
  i, res: Integer;
  maxSize: cardinal;
begin
  res:= 0;
  maxSize:= 0;
  for i:= 1 to pHeapRecord^.kmax_free_block do
    if pHeapRecord^.free_blocks[i].size >= maxSize then //Intentamos que sea el ultimo
    begin
      res:= i;
      maxSize:= pHeapRecord^.free_blocks[i].size;
    end;
  result:= res;
end;
*)

procedure THeapManager.quitarBloqueUsado(kBloque: Integer);
var
  i: Integer;
begin
  if kBloque = pHeapRecord^.kmax_used_block then
  begin
    i:= pHeapRecord^.kmax_used_block - 1;
    while (i >= 1) and (pHeapRecord^.used_blocks[i].size = 0) do
      i:= i - 1;
    pHeapRecord^.kmax_used_block:= i;
  end
  else
    pHeapRecord^.used_blocks[kBloque].size:= 0;

  pHeapRecord^.nBloquesUsados:= pHeapRecord^.nBloquesUsados - 1;

{  for i:= kBloque to pHeapRecord^.kmax_used_block - 1 do
  begin
    pHeapRecord^.used_blocks[i]:= pHeapRecord^.used_blocks[i + 1];
  end;
  pHeapRecord^.kmax_used_block:= pHeapRecord^.kmax_used_block - 1;}
end;

procedure THeapManager.quitarBloqueLibre(kBloque: Integer);
var
  i: Integer;
begin
  for i:= kBloque to pHeapRecord^.kmax_free_block - 1 do
    pHeapRecord^.free_blocks[i]:= pHeapRecord^.free_blocks[i + 1];
  pHeapRecord^.kmax_free_block:= pHeapRecord^.kmax_free_block - 1;
end;

procedure quickSortTDAOfPBlock(bloques: TDAOfPBlock; iLo, iHi: Integer);
var
  Lo, Hi, Mid: Integer;
  posBloquePivote: cardinal;
  swap: PBlock;
begin
  Lo := iLo;
  Hi := iHi;
  Mid:= (Lo + Hi) div 2;

  if bloques[Mid]^.pos < bloques[iLo]^.pos then
  begin
    swap:= bloques[Mid];
    bloques[Mid]:= bloques[iLo];
    bloques[iLo]:= swap;
  end;
  if bloques[iHi]^.pos < bloques[iLo]^.pos then
  begin
    swap:= bloques[iHi];
    bloques[iHi]:= bloques[Lo];
    bloques[Lo]:= swap;
  end;
  if bloques[iHi]^.pos < bloques[Mid]^.pos then
  begin
    swap:= bloques[Mid];
    bloques[Mid]:= bloques[iHi];
    bloques[iHi]:= swap;
  end;

  swap:= bloques[iHi];
  bloques[iHi]:= bloques[Mid];
  bloques[Mid]:= swap;

  posBloquePivote:= bloques[iHi]^.pos;
  repeat
    while bloques[Lo]^.pos < posBloquePivote do Inc(Lo);
    while bloques[Hi]^.pos > posBloquePivote do Dec(Hi);
    if Lo <= Hi then
    begin
      swap:= bloques[Lo];
      bloques[Lo] := bloques[Hi];
      bloques[Hi] := swap;
      Inc(Lo) ;
      Dec(Hi) ;
    end;
  until Lo > Hi;
  if Hi > iLo then quickSortTDAOfPBlock(bloques, iLo, Hi);
  if Lo < iHi then quickSortTDAOfPBlock(bloques, Lo, iHi);
end;

function THeapManager.quickSortUsedBlocks: TDAOfPBlock;
var
  i, iRes: Integer;
  res: TDAOfPBlock;
begin
  SetLength(res, pHeapRecord^.nBloquesUsados);
  iRes:= 0;
  for i:= 1 to pHeapRecord^.kmax_used_block do
    if pHeapRecord^.used_blocks[i].size > 0 then
    begin
      res[iRes]:= @pHeapRecord^.used_blocks[i];
      iRes:= iRes + 1;
    end;

  quickSortTDAOfPBlock(res, 0, high(res));
  result:= res;
end;

{$IFDEF DEBUG}
procedure testBasico;
var
  heap: THeapBuffer;
  heapRecord: THeapRec;
  heapManager: THeapManager;
  iBloque, tamBloque: Integer;
begin
  inicializarHeap(@heapRecord);

  heapManager:= THeapManager.create(@heapRecord, @heap);

  tamBloque:= 20;
  writeln('Agrego un bloque de tamaño ', tamBloque);
  iBloque:= heapManager.block_alloc(tamBloque);
  heapManager.printHeapRec;

  writeln;
  Writeln('Borro el bloque');
  heapManager.block_free(iBloque);
  heapManager.printHeapRec;

  tamBloque:= 20;
  writeln;
  writeln('Agrego 3 bloques de tamaño ', tamBloque);
  heapManager.block_alloc(tamBloque);
  iBloque:= heapManager.block_alloc(tamBloque);
  heapManager.block_alloc(tamBloque);
  heapManager.printHeapRec;

  writeln;
  Writeln('Borro el del medio');
  heapManager.block_free(iBloque);
  heapManager.printHeapRec;

  heapManager.Free;
end;

procedure testLiberacionesContiguas;
var
  heap: THeapBuffer;
  heapRecord: THeapRec;
  heapManager: THeapManager;
  tamBloque: Integer;
  i: Integer;
begin
  inicializarHeap(@heapRecord);

  heapManager:= THeapManager.create(@heapRecord, @heap);

  tamBloque:= 8;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Lleno el heap');
  heapManager.printHeapRec;

  Writeln;  
  Writeln('Libero el 3er bloque primero y el 1ero después. Caso antes de todo no contiguo');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((3 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((1 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 2do bloque primero y el 1ero después. Caso antes de todo contiguo derecha');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((2 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((1 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 2do y 5to bloque primero y el 3ero después. Caso en medio contiguo izquierda');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((2 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((5 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((3 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 2do y 6to bloque primero y el 4to después. Caso en medio no contiguo');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((2 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((6 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((4 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 2do y 5to bloque primero y el 4to después. Caso en medio contiguo derecha');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((2 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((5 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((4 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 2do y 4to bloque primero y el 3ero después. Caso en medio contiguo izquierda y derecha');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((2 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((4 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((3 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 7mo bloque primero y el 8vo después. Caso después de todo contiguo izquierda');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((7 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((8 - 1) * tamBloque));
  heapManager.printHeapRec;

  Writeln;
  Writeln('Lleno el heap');
  heapManager.Clear;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Libero el 6to bloque primero y el 8vo después. Caso después de todo no contiguo');
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((6 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((8 - 1) * tamBloque));
  heapManager.printHeapRec;

  heapManager.Free;
end;

procedure testLlenarHeapYDefrag;
var
  heap: PHeapBuffer;
  heapRecord: THeapRec;
  heapManager: THeapManager;
  tamBloque: Integer;
  i: Integer;
begin
  GetMem(heap, CMaxHeapSize);
  inicializarHeap(@heapRecord);

  heapManager:= THeapManager.create(@heapRecord, heap);

  tamBloque:= 8;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Lleno el heap');
  heapManager.printHeapRec;

  Writeln('Libero el 2do y 4to bloque y agrego un bloque de tamaño 10 para forzar la defragmentación');

  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((2 - 1) * tamBloque));
  heapManager.block_free(heapManager.iBloqueUsadoPorPosicion((4 - 1) * tamBloque));
  heapManager.block_alloc(10);
  heapManager.printHeapRec;

  heapManager.Free;
  FreeMem(heap, CMaxHeapSize);
end;

procedure testInsertarMasDeLoQueSePuede;
var
  heap: THeapBuffer;
  heapRecord: THeapRec;
  heapManager: THeapManager;
  tamBloque: Integer;
  i: Integer;
begin
  inicializarHeap(@heapRecord);
  heapManager:= THeapManager.create(@heapRecord, @heap);  
  tamBloque:= 8;
  for i:= 1 to 10 do
    heapManager.block_alloc(tamBloque);
  Writeln('Lleno el heap');
  heapManager.printHeapRec;

  Writeln;
  Writeln('Intento agregar un bloque mas');
  try
    heapManager.block_alloc(tamBloque)    
  finally
    heapManager.Free;
  end; 
end;

procedure testBorrarAlgoQueNoHay;
var
  heap: THeapBuffer;
  heapRecord: THeapRec;
  heapManager: THeapManager;
begin
  inicializarHeap(@heapRecord);
  heapManager:= THeapManager.create(@heapRecord, @heap);
  try
    heapManager.block_free(1);
  finally
    heapManager.Free;
  end;
end;
{$ENDIF}

end.
