unit uvectorpaginado;

{$mode delphi}

interface

uses
  Classes, SysUtils, syncobjs, Math, xmatdefs;

const
  C_VERSION_VECTOR_PAGINADO = 1;

type
  // crea un Cursor de acceso a un VectorPaginado donde cada elemento es una fila
  // de la matriz.

  TModoCursor = ( CMC_ReadWrite, CMC_Read, CMC_Write );


  TCatalogoPaginador = class;
  TElementoPaginado = class;

  { TVectorPaginado }

  TVectorPaginado = class
    Nombre: string;
    DimElemento: QWord;
    Count: QWord;
    fpos_encab: QWord;
    fpos_datos: QWord;

    Catalogo: TCatalogoPaginador;

    constructor Create(Nombre: string; DimElemento, Count: QWord );
    constructor CreateReadFromFile( Catalogo: TCatalogoPaginador );


    procedure ReadEncabFromStream( f: TStream ); virtual;

    procedure WriteEncabToStream( f: TStream ); virtual;
    procedure InicializarDatosStream( f: TStream ); virtual;

    // si el elemento no está en memoria lo levanta. Si no tiene suficiente memoria, baja los elementos
    // que hace más tiempo no se usan.
    function elemento(k: QWord): TElementoPaginado;

    // posiciona el catálogo al inicio del bloque de datos del elemento k
    procedure seek_inicio_elemento(k: QWord);


    // retorna la posición del inicio del siguiente vector en el catálogo
    function fpos_next: QWord; virtual;

    procedure MoverEnArchivoCatalago( nueva_fpos_encab: QWord ); virtual;

  end;

  { TElementoPaginado }

  TElementoPaginado = class( TCriticalSection )
    dt: TDateTime; // ultimo acceso
    vector: TVectorPaginado;
    k: QWord; // 0 ... count-1
    modificado: boolean; // indica si fue modificado y debe guardarse a disco.
    pdata: pointer;
    refCount: integer;

    procedure Enter;
    procedure Leave;

    procedure marcar_modificado;

    // si está marcado como modificado escribe el elemento a disco y lo desmarca
    function flush: boolean;

    procedure set_dt; // hace dt = now()
    constructor Create_read(vector: TVectorPaginado; k: QWord);
    destructor Destroy; override;
  end;




  { TMatOfNRealPaginado }

  TMatOfNRealPaginado = class(TVectorPaginado)
    constructor Create(Nombre: string; nFilas, nColumnas: QWord);
  end;


  { TCursorMatOfPaginado }

  TCursorMatOfPaginado = class
  public
    vector: TVectorPaginado;
    elemento: TElementoPaginado;
    Modo: TModoCursor;

    constructor Create(vector: TVectorPaginado; Modo: TModoCursor );
    destructor Destroy; override;

    function Enter(k: integer): TElementoPaginado;

    procedure Leave;
    procedure LeaveModificado;


  end;


  { TCatalogoPaginador }

  TCatalogoPaginador = class( TCriticalSection )
    DimPaginado_Max: QWord;
    // tamaño en bytes, máximo del conjunto de páginas en memoria
    DimPaginado_Usado: QWord; // tamaño usado.

    archi: string; // camino completo al archivo
    f: TFileStream;
    vectores: TList;
    elementos: TList; // lista de elementos en memoria

    // Si el archivo existe lo abre,
    // fm  es la suma de algunas de las siguientes constantes:
    // fmOpenRead, fmOpenWrite, fmOpenReadWrite
    // fmShareCompat, fmShareExclusive, fmShareDenyWrite, fmShareDenyRead, fmShareDenyNone
    // Para crear un archivo nuevo utilice fm = fmCreate
    constructor CreateFromFile(archi: string; fm: word; DimPaginado_Max: QWord);

    // agrega un vector y hace el lugar correspondiente en el archivo de paginas.
    procedure add_vector(vector: TVectorPaginado);

    // obtiene referencia al vector;
    function get_vector(Nombre: string): TVectorPaginado;

    // Elimina el Vector del catálogo. (libera los elementos y mueve todos lo necesario del archivo)
    procedure del_vector(Nombre: string);

    // Livera los elementos paginados del vector y retorna la cantidad de elementos liberados
    function liberarElementosPaginados(vector: TVectorPaginado): integer;

    // busca si el elemento está en memoria, si no es así, lo sube, si es necesario baja los más
    // antiguos para hacer lugar.
    function getElemento(vector: TVectorPaginado;
      kElemento: QWord): TElementoPaginado;

    // guarda a disco los elementos paginados que estén marcados como modificados.
    procedure flush_all;

    destructor Destroy; override;

    procedure dump_debug_elementos;
  end;

implementation

const
  MicroSegundosPorDia = 24 * 3600 * 1000 * 1000;

{ TCursorMatoOfPaginado }





constructor TCursorMatOfPaginado.Create(vector: TVectorPaginado;
  Modo: TModoCursor);
begin
  self.vector := vector;
  self.Modo:= Modo;
end;

destructor TCursorMatOfPaginado.Destroy;
begin
  inherited Destroy;
end;

function TCursorMatOfPaginado.Enter(k: integer): TElementoPaginado;
begin
  if (elemento = nil) or (elemento.k <> k) then
  begin
    if elemento <> nil then
    begin
      elemento.set_dt;
      elemento.Leave;
    end;
    elemento := vector.elemento(k);
    elemento.enter;
  end;
  Result := elemento;
end;

procedure TCursorMatOfPaginado.Leave;
begin
  elemento.set_dt;
  elemento.Leave;
  elemento:= nil;
end;

procedure TCursorMatOfPaginado.LeaveModificado;
begin
  elemento.marcar_modificado;
  Leave;
end;




{ TMatOfNRealPaginado }

constructor TMatOfNRealPaginado.Create(Nombre: string; nFilas, nColumnas: QWord);
begin
  inherited Create( Nombre, nColumnas * sizeOf( NReal ), nFilas );
end;

{ TVectorPaginado }

constructor TVectorPaginado.Create(Nombre: string; DimElemento, Count: QWord
  );
begin
  self.Nombre := nombre;
  self.DimElemento := DimElemento;
  self.Count := Count;
  fpos_encab:= 0;
  fpos_datos:= 0;
  Catalogo:= nil;
end;

constructor TVectorPaginado.CreateReadFromFile(Catalogo: TCatalogoPaginador);
var
  f: TFileStream;
begin
  f := Catalogo.f;
  self.fpos_encab := f.position;
  self.ReadEncabFromStream( f );
  self.fpos_datos:= f.position;
  f.Seek(Count * DimElemento, soFromCurrent);
end;


procedure TVectorPaginado.ReadEncabFromStream(f: TStream);
var
  n: integer;
begin
  f.Read(n, sizeOf(n));
  setlength(nombre, n);
  f.Read(nombre[1], n * sizeOf(char));
  f.Read(DimElemento, sizeOf(DimElemento));
  f.Read(Count, sizeOf(Count));
end;

procedure TVectorPaginado.WriteEncabToStream( f: TStream);
var
  n: integer;
begin
  n := length( nombre);
  f.Write( n, sizeof(n));
  f.Write( nombre[1], n * sizeOf(char));
  f.Write( DimElemento, sizeOf( DimElemento ));
  f.Write( Count, sizeOf( Count ));
end;

procedure TVectorPaginado.InicializarDatosStream(f: TStream);
var
  buff: array of byte;
  k: integer;
begin
  setlength(buff, DimElemento);
  for k := 0 to Count - 1 do
    f.Write(buff, DimElemento);
  setlength(buff, 0);
end;

function TVectorPaginado.elemento(k: QWord): TElementoPaginado;
begin
  Result := Catalogo.getElemento(self, k);
end;

procedure TVectorPaginado.seek_inicio_elemento(k: QWord);
var
  fpose: QWord;
begin
  fpose := fpos_datos + k * DimElemento;
  Catalogo.f.Seek(fpose, soFromBeginning);
end;

function TVectorPaginado.fpos_next: QWord;
begin
  result:= fpos_datos + Count * DimElemento;
end;


procedure TVectorPaginado.MoverEnArchivoCatalago( nueva_fpos_encab: QWord );
var
  NBytesToMove: QWord;
  buffer: array of byte;
  dimbuffer: QWord;
  f: TFileStream;
  n, ntr: QWord;
  fpos_r, fpos_w: QWord;
begin
  if nueva_fpos_encab > fpos_encab then
    raise Exception.Create( 'TVectorPaginado.MoverEnArchivoCatalogo  nueva_pos_encab > pos_encab ' );

  NBytesToMove:= fpos_next - fpos_encab;

  dimbuffer:= 1024 * 1024 * 10; // 10M
  setlength( buffer, dimbuffer );
  fpos_w:= nueva_fpos_encab;
  fpos_r:= fpos_encab;

  f:= Catalogo.f;
  while NBytesToMove > 0 do
  begin
    f.Seek( fpos_r, soFromBeginning );
    if NBytesToMove < dimbuffer then
      ntr:= NBytesToMove
    else
      ntr:= dimbuffer;

    n:= f.Read( buffer, ntr );
    if n <> ntr then
       raise Exception.Create( 'TVectorPaginado.MoverEnArchivoCatalgo, error de lectura.' );

    f.Seek( fpos_w, soFromBeginning );
    n := f.Write( buffer, ntr );
    if n <> ntr then
        raise Exception.Create( 'TVectorPaginado.MoverEnArchivoCatalgo, error de escritura.' );


    NBytesToMove:= NBytesToMove - n;
    fpos_r:= fpos_r + n;
    fpos_w:= fpos_w + n;
  end;

  setlength( buffer, 0 );

  fpos_datos:= fpos_datos - fpos_encab + nueva_fpos_encab;
  fpos_encab:= nueva_fpos_encab;

end;

{ TElementoPaginado }

procedure TElementoPaginado.Enter;
begin
  inherited Enter;
  inc( refCount );
end;

procedure TElementoPaginado.Leave;
begin
  dec( refCount );
  inherited Leave;
end;

procedure TElementoPaginado.marcar_modificado;
begin
  self.set_dt;
  self.modificado := True;
end;

function TElementoPaginado.flush: boolean;
begin
  result:= modificado;
  if modificado then
  begin
    vector.seek_inicio_elemento( k );
    vector.Catalogo.f.Write( pdata^, vector.DimElemento );
    modificado:= false;
  end;
end;

procedure TElementoPaginado.set_dt;
begin
  dt := now;
end;

constructor TElementoPaginado.Create_read(vector: TVectorPaginado; k: QWord);
begin
  dt := now;
  self.vector := vector;
  self.k := k;
  self.modificado := False;
  vector.seek_inicio_elemento(k);
  getmem(pdata, vector.DimElemento);
  vector.Catalogo.f.Read(pdata^, vector.DimElemento);
end;

destructor TElementoPaginado.Destroy;
begin
  freemem(pdata, vector.DimElemento);
  inherited Destroy;
end;

{ TCatalogoPaginador }

constructor TCatalogoPaginador.CreateFromFile(archi: string; fm: word;
  DimPaginado_Max: QWord);
var
  version: integer;
  nvectores: QWord;
  kVector: integer;
  aVectorP: TVectorPaginado;
  Max_DimElemento: QWord;

begin
  inherited Create;

  Enter;

  self.f := TFileStream.Create(archi, fm);
  self.archi := archi;
  self.vectores := TList.Create;
  self.elementos := TList.Create;

  self.DimPaginado_Max:= DimPaginado_Max;
  self.DimPaginado_Usado:= 0;

  Max_DimElemento := 0;
  if (fm and fmCreate) = 0 then
  begin
    f.Read(version, sizeOf(version));
    f.Read(nvectores, sizeOF(nvectores));
    for kvector := 0 to nVectores - 1 do
    begin
      aVectorP := TVectorPaginado.CreateReadFromFile(self);
      vectores.add(aVectorP);
      if aVectorP.DimElemento > max_DimElemento then
        max_DimElemento := aVectorP.DimElemento;
    end;
  end
  else
  begin
    version:= C_VERSION_VECTOR_PAGINADO;
  end;

  Leave;
end;

procedure TCatalogoPaginador.add_vector(  vector: TVectorPaginado );
var
  res: TVectorPaginado;

begin
  Enter;

  res:= Self.get_vector( vector.Nombre );
  if res <> nil then
    raise Exception.Create( 'El vector: '+vector.Nombre+' ya esta en el catálogo.' );

  vector.Catalogo := self;

  f.Seek(0, soFromEnd);
  vector.fpos_encab:= f.Position;
  vector.WriteEncabToStream( f );
  vector.fpos_datos:= f.Position;
  vector.InicializarDatosStream( f );
  vectores.add( vector );

  Leave;
end;

function TCatalogoPaginador.get_vector(Nombre: string): TVectorPaginado;
var
  k: integer;
  av: TVectorPaginado;
  buscando: boolean;
begin
  Enter;

  buscando:= true;
  for k:= 0 to vectores.count -1 do
  begin
    av:= vectores[k];
    if av.Nombre = Nombre then
    begin
      buscando:= false;
      break;
    end;
  end;

  if not buscando then
    result:= av
  else
    result:= nil;

  Leave;
end;

procedure TCatalogoPaginador.del_vector(Nombre: string);
var
  av: TVectorPaginado;
  i, ipos: integer;
  fpos: QWord;
begin
  av:= get_vector( Nombre );
  if av = nil then
    raise Exception.Create('del_vector, Nombre: '+Nombre+' no está en el catálogo.' );

  ipos:= vectores.Remove( av );
  fpos:= av.fpos_encab;
  liberarElementosPaginados( av );
  av.free;
  for i:= ipos to vectores.Count-1 do
  begin
    av:= vectores[i];
    av.MoverEnArchivoCatalago( fpos );
    fpos:= f.position;
  end;
  f.Size:= f.position; // truncate

end;

function TCatalogoPaginador.liberarElementosPaginados(vector: TVectorPaginado
  ): integer;
var
  k: integer;
  a: TElementoPaginado;
  cnt: integer;
begin
  Enter;

  cnt:= 0;
  k:= 0;
  while k < elementos.Count do
  begin
    a:= elementos[k];
    if a.vector = vector then
    begin
      elementos.Delete( k );

      a.Free;
      inc( cnt );
    end
    else
      inc( k );
  end;

  result:= cnt;
  Leave;
end;



function refCount_dec_dt_dec_elementos_sort(a, b: pointer): integer;
var
  d: double;
  epa, epb: TElementoPaginado;
  res: integer;
begin
  epa:= TElementoPaginado( a );
  epb:= TElementoPaginado( b );

  // primero veo el contador de refencias
  if epa.refCount > epb.refCount then
   res:= 1
  else if epa.refCount < epb.refCount then
   res:= -1
  else
  begin
    if epa.refCount = 0 then
       res:= 0
    else
    begin
      // si los contadores de referencia son iguales e igual a CERO
      // los ordeno por fecha
      d :=  epa.dt - epb.dt;
      if d > 0 then
        Res:= 1
      else if d < 0 then
        Res:= -1
      else
        Res:= 0;

    end;
  end;
  // Le cambio el signo para dejar al final las de refcount = 0
  result:= -res;
end;

function TCatalogoPaginador.getElemento(vector: TVectorPaginado;
  kElemento: QWord): TElementoPaginado;
var
  buscando: boolean;
  k: integer;
  ae: TElementoPaginado;
begin
  Enter;

  buscando := True;
  for k := 0 to elementos.Count - 1 do
  begin
    ae := elementos[k];
    if (ae.vector = vector) and (ae.k = kElemento) then
    begin
      buscando := False;
      break;
    end;
  end;

  if not buscando then
  begin
    Result := ae;
    Leave;
    exit;
  end;

  elementos.Sort( refCount_dec_dt_dec_elementos_sort );

  if ( vector.DimElemento > (DimPaginado_Max - DimPaginado_Usado) ) and (elementos.count > 0 ) then
  begin
 //   dump_debug_elementos;

    repeat
      // tengo que hacer espacio;
      ae:= elementos[ elementos.count - 1 ];
      if ae.refCount <> 0 then
        raise Exception.Create( 'No es posible liberar espacio en paginador de vectores' );
      DimPaginado_Usado:= DimPaginado_Usado - vector.DimElemento;
      ae.Free;
      elementos.Delete( elementos.count- 1 );

    until ( vector.DimElemento <= (DimPaginado_Max - DimPaginado_Usado) ) or (elementos.count = 0 );
  end;

  if ( vector.DimElemento > (DimPaginado_Max - DimPaginado_Usado) ) then
    raise Exception.Create( 'Imposible asignar un elmento DimElemento >DimPaginado_Max ' );

  // Si llegamos hasta aquí, hay que cargar el elmento
  ae := TElementoPaginado.Create_read(vector, kElemento);
  elementos.Add( ae );
  DimPaginado_Usado:= DimPaginado_Usado + vector.DimElemento;
  result:= ae;
  Leave;
end;

procedure TCatalogoPaginador.flush_all;
var
  ae: TElementoPaginado;
  k: integer;
begin
  Enter;
  for k:= 0 to elementos.count -1 do
  begin
    ae:= elementos[k];
    ae.Enter;
    ae.Flush;
    ae.Leave;
  end;
  Leave;
end;

destructor TCatalogoPaginador.Destroy;
var
  k: integer;
begin
  Enter;

  flush_all;
  f.Free;

  for k:= 0 to elementos.count -1 do
    TElementoPaginado( elementos[k] ).Free;
  elementos.Free;

  for k:= 0 to vectores.count - 1 do
    TVectorPaginado( vectores[k] ).Free;
  vectores.Free;

  Leave;
  inherited Destroy;
end;

procedure TCatalogoPaginador.dump_debug_elementos;
var
  k: integer;
  ae: TElementoPaginado;
begin
  for k:= 0 to elementos.count-1 do
  begin
    ae:= elementos[k];
    writeln( 'Vecor: ',ae.vector.Nombre, ', refCount: ', ae.refCount, ', dt: ', DateTimeToStr( ae.dt  ));
  end;
end;

end.
