{
    This file is part of chepersy
    Copyright (c) 2004-2008 by Anton Rzheshevski (chebmaster@mail.ru),

    See the file COPYING.CPS, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}




var
   _grp_ind: integer;
   HeaderVersion: integer;
   
  procedure SkipPersistent;
  var o: TManagedObject;
  begin
    ReadPersistent(o);
    GarbageCollector.Add(o);
  end;

  procedure ReadPersistent(var o: TManagedObject); register;
  //due to recursion, it should put as little on the stack as possible.
  //So no local variables.
  begin
    _grp_ind:=ReadInt();
    {$ifdef support08x}
     if DH.StreamVersion = 0 then begin
//addlog('_grp_ind %0', [_grp_ind]);
       {$ifdef safeloading}
        if (_grp_ind > Obj.High)
          then DieInvalidContainer(RuEn(
             'Данные запороты: индекс объекта - за пределами!'
            ,'Data corrupt: object index out of bounds!')
            +' (' + IntToStr(_grp_ind) + '/' + IntToStr(Obj.High) + ')');
       {$endif}
        if _grp_ind = 0 then begin
          //index 0 means there is really written a class instance.
          _grp_ind:=ReadInt(); // now it's a class index.
//addlog('_grp_ind %0  %1', [_grp_ind, B_NameSpace[CNames[_grp_ind]]]);
         {$ifdef safeloading}
          if _grp_ind >= Length(DH.Cnums) then DieInvalidContainer(RuEn('Данные запороты: индекс класса - за пределами!','Data corrupt: class index out of bounds!'));
         {$endif}
          o:=DH.B_Classes[_grp_ind].Generate;
          Obj.Add(o); // *before* the fields are loaded - the nested objects can contain the one we are currently loading
          LoadRecord(pointer(o), fio_Load, _grp_ind);
        end
        else begin
          if _grp_ind < 0
            then o:=nil // index -1 represents NIL
            else o:=Obj[_grp_ind]; //index > 0 represents an already loaded object
        end;
     end
     else begin
    {$endif  support08x}
     {$ifdef safeloading}
      if (_grp_ind > Obj.High) or (_grp_ind <= - Length(DH.Cnums))
        then DieInvalidContainer(RuEn(
           'Данные запороты: индекс за пределами!'
          ,'Data corrupt: index out of bounds!')
          +' (' + IntToStr(_grp_ind) + '/' + IntToStr(- Length(DH.Cnums) + 1) + '...' + IntToStr(Obj.High)+')');
     {$endif}
      if _grp_ind > 0
        then o:=Obj[_grp_ind]
        else
          if _grp_ind = 0
            then o:=nil // index 0 represents NIL
            else begin //index < 0 is a negative class index
              o:=DH.B_Classes[-_grp_ind].Generate; //create the instance:
              Obj.Add(o); // *before* the fields are loaded - the nested objects can contain the one we are currently loading
              LoadRecord(pointer(o), fio_Load, -_grp_ind);        //load the fields:
            end
    {$ifdef support08x}
    end;
    {$endif}
  end;

  function ReadDyna(): TDyna;
  var
    cn, ind: integer;
    od: TDyna;
    cd: CDyna;
  begin
    ind:=ReadInt(); // now it's a class index.
    if ind < 0 then begin
      Result:=nil;
      Exit;
    end;
   {$ifdef safeloading}
    if ind >= Length(DH.Cnums) then DieInvalidContainer(RuEn('Данные запороты: индекс класса за пределами!','Data corrupt: class index out of bounds!'));
   {$endif}
    cn:=DH.Cnums[ind];
    cd:=CDyna(Types[cn]._class);
    od:=cd.Create;
    od.Load(ReadInt());
    Result:=od;
  end;

var onum: integer = 0;


  procedure WritePersistent(o: TManagedObject);
  var
    c: integer;
  {$ifdef safeloading}
    bi: integer;
    eoc, em: string;
  {$endif}
  begin
   if not Assigned(o) or (((o.CpsMask xor mXorMask) and mAndMask) = 0)
   then begin
      {$ifdef fpc} CpsStream.{$endif} WriteDword(0);
      Exit
    end;
   {$ifdef safeloading}
    if not (o is TManagedObject)
      then Die(MI_ERROR_PROGRAMMER_NO_BAKA
       , ['WritePersistent(): '+RuEn(
           'класс не является потомком TManagedObject.'#10#13'  Тип сего злосчастного экземпляра - "'
          ,'the class is not TManagedObject descendant.'#10#13'  The type of this hapless instance is "')
          + AnsiString(o.ClassName) + '"']);
   {$endif}
    if o.CpsIndex > 0 then begin
      WriteInt(o.CpsIndex);
      Exit;
    end;
   inc(onum);
  {$ifdef safeloading}
   try
  {$endif}
    {$ifdef delphiworkaround}
      c:=GetClassIndex(o.ClassType());
    {$else}
      c:=o.ClassIndex;
    {$endif}
   {$ifdef safeloading}
    if c = 0 then Die(MI_ERROR_PROGRAMMER_NO_BAKA
     , [RuEn('Класс "','Class "') + AnsiString(o.ClassName) + RuEn('" не зарегистрирован!','" not registered!')]);
   {$endif}
    WriteInt(-c); //class index
    inc(CurrentInd);
    o.CpsIndex:= CurrentInd;
    Obj.Add(o);
    {$ifdef safeloading}
    try
    {$endif}
      o.BeforeSaving;
    {$ifdef safeloading}
     except
       Die(RuEn('в','in') + ' %0.BeforeSaving()', [string(o.ClassName)])
     end;
    {$endif}
    SaveRecord(pointer(o), c);
  {$ifdef safeloading}
   except
     {$ifndef cge}
       em:=(ExceptObject as Exception).Message;
     {$endif}
     Try
       eoc:=o.ClassName;
       bi:=o.CpsIndex;
     Except
       eoc:='<' + (ExceptObject as Exception).ClassName +'>';
     End;
     Die(RuEn('Крах при записи в лукошко объекта №','Crashed writing to basket the object #')
       +'%0 (%1)' {$ifndef cge} + #10#13'(%2)'{$endif}, [bi, eoc{$ifndef cge}, em{$endif}]);
   end;
  {$endif}
  end;
  
  procedure WalkPersistent(o: TManagedObject);
  var
    c, i: longint;
  begin
    if not Assigned(o) then exit;
    {$ifdef delphiworkaround}
      c:=GetClassIndex(o.ClassType());
    {$else}
      c:=o.ClassIndex;
    {$endif}
   {$ifdef safeloading}
    if c = 0 then Die(MI_ERROR_PROGRAMMER_NO_BAKA
     , [RuEn('Класс "','Class "') + AnsiString(o.ClassName) + RuEn('" не зарегистрирован!','" not registered!')]);
   {$endif}
//addlog(' --- onum %0  %1', [o.CpsIndex.Onum, CpsWalkMarkVal]);
    if o.CpsIndex <> CpsWalkMarkVal then begin
      o.CpsIndex:= CpsWalkMarkVal;
      CurrentWalkProc(o);
      WalkRecord(pointer(o), c);
    end;
  end;
  
  procedure WriteDyna(o: TDyna);
  begin
    if Assigned(o)
      then begin
       {$ifdef safeloading}
        if not (o is TDyna)
          then Die(MI_ERROR_PROGRAMMER_NO_BAKA
           , ['WriteDyna(): '+RuEn(
              'класс не является потомком TDyna.'#10#13'  Тип сего злосчастного экземпляра - "'
             ,'the class is not a TDyna descendant.'#10#13'  The type of this hapless instance is "')
            + AnsiString(o.ClassName) + '"']);
       {$endif}
        WriteInt(ClassIndex(o.ClassType));
        o.Save()
      end
      else WriteNil;
  end;
  
  procedure WalkDyna(o: TDyna);
  var i: integer;
  begin
    if not Assigned(o) then Exit;
    if o is TAOMO
    then
      for i:=0 to o.High
        do WalkPersistent(TManagedObject(TAOMO(o)[i]))
    else
      if o is TArrayOfDyna then
        for i:=0 to o.High
          do RP_Dyna(pointer(cardinal(o.DPTR) + i * sizeof(pointer)), fio_Walk, 0)
      else
        Die(MI_ERROR_PROGRAMMER_NO_BAKA
       , ['WalkDyna(): '+ AnsiString(o.ClassName) + RuEn(
          ' не является ни TAOMO ни TArrayOfDyna.'
         ,' is not TAOPTP nor TArrayOfDyna.')]);
  end;
  
  procedure DieInvalidContainer(nng: string);
  //Error that should not happen, so only the English technical messages.
  begin
    if nng > '' then nng:=#10#13 + nng;
    Die(MI_BASKET_FAIL_LOAD, [nng]);
  end;

  procedure DieDataCorrupt(em: string);
  begin
    DieInvalidContainer(RuEn('Файл запорот: ', 'Data corrupt: ') + em);
  end;

  procedure DieIncompatible(M: TMessageId; Param: array of const);
  //Error that *could* happen (quite likely, at that),
  //  so we need to explain it in an civilized manner. Russian fully supported.
  var w: WideString;
  begin
    w:=MsgFormat(M, Param) + #10#13
      + MsgFormat(MI_BASKET_EXPLAIN_UNKNOWN, []);
    Die(MI_BASKET_FAIL_LOAD, [w]);
  end;

  function ChCn(n1: integer): integer; //converts class name from the local to global name space
  begin
    if (n1 < 0) or (n1 > DH.NameTT.High) then DieDataCorrupt(RuEn('Индекс имени за пределами.','Name index out of bounds.'));
    Result:=DH.NameTT[n1];
  end;

  function FindKnownClassAncestor(i: integer): integer;
  var
    c, r, j: integer;
  begin
    //in: local class index
    //out: global class index
    Try
      r:=0;
      c:=-1;
      if DH.CAncestorNames[i].Length > 0 then
        repeat
          c:=ChCn(DH.CAncestorNames[i][r]);
          inc(r);
        until (c >= 0) or (r > DH.CAncestorNames[i].High);
      if c < 0 then c:=Types[Records[0]].name; //TManagedObject
      For j:=0 to Records.High do
        if c = Types[Records[j]].Name then begin
          Result:=j;
          DH.TypeChanged[Records[j]]:=Yes;
          Break;
        end;
    Except
      Die(RuEn('Крах при парсинге таблицы предков класса.', 'Crashed while parsing class'' ancestors table.'));
    End;
  end;

  // **************************************************************************

  procedure TChepersyDatabaseHeader.Parse();
  var
    i, j, k, l, g, cc, f, v, gt, oi: integer;
    b: boolean;
    FI: TFieldInfo;
    Ki: TFieldKind;
    procedure PolarFoxApproaches(N: integer);
    begin
      //"polar fox" in Russian is an euphemism for "f***ng end of everything" :)
      BasketWarningsAdd(PervertedFormat(RuEn(
        'ОПАСНОСТЬ! Неизвестный тип "%0", любой наличествующий экземпляр сорвёт чтение!',
        'DANGER! Unknown type "%0", any instance present would abort the loading!'
        ),[B_NameSpace[Tnames[N]]]));
    //Treat it as "pointer". Attempt to load causes dying with a
    //  corresponding error message.
      TNames[N]:=TNames[StdTindPointer];
    end;

  begin
    {$ifdef support08x}
      if (StreamVersion = 0) then BasketWarningsAdd(RuEn(
        'Устаревший формат потока (от Chepersy 0.8.2 или ниже)',
        'Obsolete stream format (from Chepersy 0.8.2 or below)'));
    {$endif}
    if B_Fields.Length <> CNames.Length then DieDataCorrupt('B_Fields.Length != CNames.Length');
    if TNames.Length <> TSizes.Length then DieDataCorrupt('TNames.Length != TSizes.Length');
    // Checking if all classes are known
    SetLength(CNums, CNames.Length);
    SetLength(B_RecKinds, CNames.Length);
    SetLength(TypeChanged, Types.Length);
    FillChar(TypeChanged[0], SizeOf(TypeChanged[0]) * Types.Length, 0);
    For i:=0 to CNames.High do begin

      {$ifdef support08x}
      if (StreamVersion = 0)
        then B_RecKinds[i]:= fk_class
        else
     {$endif}
          B_RecKinds[i]:= TFieldKind(TKinds[B_RecBTinds[i]]);
      cc:=ChCn(Cnames[i]);
//addlog('CNames[%0] = %1 (%3), cc = %2 (%4)', [i, Cnames[i], cc, B_NameSpace[Cnames[i]], NameSpace[cc]]);
      if cc < 0 then begin
        //find the class' ancestor
        case B_RecKinds[i] of
          fk_class: CNums[i]:=FindKnownClassAncestor(i);
          fk_09_custom_class: PolarFoxApproaches(B_RecBTinds[i]);
        else
          CNums[i]:= 1; //unknown record.
        end;
        if B_RecKinds[i] <> fk_09_custom_class then
          BasketWarningsAdd(MsgFormat(MI_BASKET_CLASS_SUBSTITUTED, [
                                     B_NameSpace[Cnames[i]],
                                     NameSpace[Types[Records[Cnums[i]]].name],
                                     FieldKindToStr(B_RecKinds[i])]));
      end
      //also match the local class indices with the registerator lists
      else
        For j:=0 to Records.High do
          if cc = Types[Records[j]].Name then begin
            CNums[i]:=j; //
            Break;
          end;
    end;

    // Checking if all types are known
    For i:=0 to TNames.High do
      if ChCn(Tnames[i]) < 0 then begin
        Ki:=TFieldKind(TKinds[i]);
        oi:=Tnames[i];
        Case Ki of
          fk_Class, fk_record, fk_packed_record, fk_enumInd_Array:
            Continue;
          fk_Enum:
            TNames[i]:=TNames[StdTindDword];
          fk_set:
            TNames[i]:=TNames[StdTindUnknownSet];
          fk_dynamic_array: begin
            Case TFieldKind(TKinds[B_TbaseInds[i]]) of
              fk_class: TNames[i]:=TNames[StdTindArrayOfTManagedObject];
              fk_enum: TNames[i]:=TNames[StdTindArrayOfDword];
              fk_Set: TNames[i]:= Tnames[StdTindArrayOfUnknownSet];
              fk_record, fk_packed_record, fk_enumInd_Array:
                     TNames[i]:= TNames[StdTindArrayOfUnknownRecord];
              fk_dynamic_array:
                Case TFieldKind(TKinds[B_TBaseInds[B_TBaseInds[i]]]) of
                  fk_class: TNames[i]:=TNames[StdTind2dArrayOfTManagedObject];
                  fk_enum: TNames[i]:=TNames[StdTind2dArrayOfDword];
                  fk_set: TNames[i]:= Tnames[StdTind2dArrayOfUnknownSet];
                  fk_record, fk_packed_record, fk_enumInd_Array:
                    TNames[i]:= TNames[StdTindArrayOfUnknownRecord];
                else
                  PolarFoxApproaches(i);
                end;
            else
              PolarFoxApproaches(i);
            end;
          end;
        else
          PolarFoxApproaches(i);
        end;
        BasketWarningsAdd(PervertedFormat(RuEn(
          'Неизвестный тип "%0" (%2). Приведён к "%1".',
          'Unknown type "%0" (%2). Treated as "%1".'
            ),[B_NameSpace[oi], B_NameSpace[Tnames[i]], FieldKindToStr(Ki)]));
      end;

    //Building the local name to registrator type index translation table
    NaToT:=TAOI.Create;
    NaToT.Length:=B_NameSpace.Length;
    For i:=0 to NaToT.High do begin
      For j:=0 to Types.High do
        if NameTT[i] = Types[j].Name then begin
          NaToT[i]:=j;
        end;
    end;
    
    // Checking if all type sizes match
    For i:=0 to TSizes.High do
      if (TSizes[i] <> Types[NaToT[Tnames[i]]].Size)
//      and not ((TSizes[i] <= 4) and (Types[NaToT[Tnames[i]]].Size <= 4))
//      and not (TKinds[i] in [fk_enumind_array, fk_record, fk_packed_record, fk_set])
      then begin
        Case TFieldKind(TKinds[i]) of
          fk_enumind_array, fk_set: ; //do nothing
          fk_record, fk_packed_record: ;// do nothing
{            BasketWarningsAdd(PervertedFormat(RuEn(
            'Размер типа-записи "%0" изменился с %2 на %1.'
           ,'Record type "%0" size changed from %2 to %1.')
           ,[B_NameSpace[Tnames[i]]
            ,Types[NaToT[Tnames[i]]].Size
            ,TSizes[i]]));}
        else
          DieIncompatible (MI_BASKET_TYPE_SIZE_MISMATCH,
            [B_NameSpace[Tnames[i]]
            ,Types[NaToT[Tnames[i]]].Size
            ,TSizes[i]]);
        end;
      end;
      
    //building the local <-> global tind translation tables
    SetLength(B_ToGtind, Tnames.Length);
    SetLength(B_FromGtind, Types.Length);
    for i:=0 to Types.High do B_FromGtind[i]:= -1;
    for i:=0 to TNames.High do begin
      B_toGTind[i]:= NaToT[TNames[i]];
      B_FromGtind[B_toGTind[i]]:= i;
    end;
    
    //building the local tind to local record index translation table
    SetLength(B_Lrecind, Tnames.Length);
    for i:=0 to high(B_Lrecind) do
      B_Lrecind[i]:= -1;
    {$ifdef support08x}
      if (DH.StreamVersion > 0) then begin
    {$endif}
        for i:=0 to B_RecBTinds.High do
          B_Lrecind[B_RecBTinds[i]]:= i;
    {$ifdef support08x}
      end
      else begin
        for i:=0 to TNames.High do begin
          B_Lrecind[i]:= -1;
          for j:=0 to CNames.High do
            if TNames[i] = CNames[j] then begin
//addlog(' --- %0  --> %1 %2',[i, j, B_NameSpace[Tnames[i]]]);
              B_Lrecind[i]:= j;
              break;
            end;
        end;
      end;
    {$endif}
    // Checking for unknown fields, fields of wrong types, etc.
    For j:=0 to B_Fields.High do begin
      //for each record (class, record or enum-ind array)
      cc:=CNums[j];

      //Matching the list and checking for extra/wrong type fields
      For l :=0 to B_Fields[j].High do begin
        f:=-1;
        FI:=B_Fields[j][l];
        FI.NewTind:=0;//clear it -- just in case.

        //finding the field with the same name in the registrator list:
        For g:=0 to Fields[cc].High do
          if NameTT[FI.Name] = Fields[cc][g].Name
          then begin
            f:=g;
            Break;
          end;
//addlog('-- rfind %0', [f]);
        FI.RFind:=f; //where -1 means there is no such field.

        //Translating type index:
        //v0.9: do not translate.
(*        For i:=0 to Types.High do
          if Types[i].Name = NameTT[TNames[FI.Tind]] then begin//TNames[FI.Tind]] then begin
            FI.Tind:=i;
            Break;
          end;*)
//addlog('-- tind %0', [fi.tind]);
        if (f >= 0) and (Fields[cc][f].Tind <> B_ToGtind[FI.Tind])
        //type has changed
        then begin
          if Assigned(GetConverterProc(B_ToGtind[FI.Tind], Fields[cc][f].Tind))
          then begin
            Fi.NewTind:=Fields[cc][f].Tind;
            BasketWarningsAdd(MsgFormat(MI_BASKET_FIELD_TYPE_CHANGED,
              [B_NameSpace[CNames[j]]//ClassNameSpace[cc]
              ,B_NameSpace[FI.Name]
              ,NameSpace[Types[Fields[cc][f].Tind].Name]
              ,B_NameSpace[TNames[FI.TInd]]
              ,FieldKindToCapStr(B_RecKinds[j])]));
          end
          else begin
            FI.RFind:=-1; //skip: types mismatch.
// ****************************************************************************
//ToDo: allow replacing object fields with descendant types for backward compatibility.
//    (hackaround: currently there is *no* class type checking at all!)

  {        if (Types[FI.Tind].Kind = fk_Class)
            then //Die(MI_BASKET_UNKNOWN_OBJECT_FIELD,  //песец. поле было объектным.
              BasketWarnings.Add(PervertedFormat('Class "%0", field "%1:%2" type changed. IGNORED.',
              [B_NameSpace[CNames[j]]//ClassNameSpace[c]
              ,B_NameSpace[FI.Name]
              ,NameSpace[Types[FI.Tind].Name]]))
            else}
            BasketWarningsAdd(MsgFormat(MI_BASKET_WRONG_FIELD_TYPE,
              [B_NameSpace[CNames[j]]//ClassNameSpace[c]
              ,B_NameSpace[FI.Name]
              ,NameSpace[Types[Fields[cc][f].Tind].Name]
              ,B_NameSpace[Tnames[FI.TInd]]
              ,FieldKindToCapStr(B_RecKinds[j])]));
          end;
        end
        else
          if f < 0 then
           BasketWarningsAdd(MsgFormat(MI_BASKET_UNKNOWN_FIELD,
            [B_NameSpace[CNames[j]],//ClassNameSpace[c]
             B_NameSpace[FI.Name],
             B_NameSpace[Tnames[FI.Tind]],
             FieldKindToCapStr(B_RecKinds[j])
             ]));
        B_Fields[j][l]:=FI;
      end;

      //Checking for missing fields (warning only):
      For g:=0 to Fields[cc].High do begin
        if Fields[cc][g].Skip then Continue;
        //Note: if the field status was changed to skipped
        //  but it is stored in the savegame, it will be
        //  loaded anyway. the "Skipped" flag affects only the saving process.

        //Otherwise, if the field was changed from skipped to non-skipped,
        //  the parser will give a warning about a missing field.
        b:=No;
        For l :=0 to B_Fields[j].High do begin
          if Fields[cc][g].Name = NameTT[B_Fields[j][l].Name] then begin
            if not B_Fields[j][l].Skip then b:=Yes;
            Break;
          end;
        end;
        if not b then BasketWarningsAdd(MsgFormat(MI_BASKET_MISSING_FIELD,
          [B_NameSpace[CNames[j]]//ClassNameSpace[c]
          ,NameSpace[Fields[cc][g].Name]
          ,NameSpace[Types[Fields[cc][g].Tind].Name]
          ,FieldKindToCapStr(B_RecKinds[j])]));
      end;
    end;

    //Building the enumerated types conversion table (again, warnings only)
    //Initially Enum[][] contains the names (in local space) by ordinals.
    //We need it to contain new ordinals by old ordinals.

    //*ADDED: also check if the types are identic
    if Length(EnumIdentic) <> Types.Length
      then SetLength(EnumIdentic, Types.Length);

    EnumConvTable:=T2DAOI.Create;
    EnumConvTable.Length:=Types.Length;

    For i:=0 to TNames.High do begin
      gt:=NaToT[TNames[i]];
      if Types[gt].Kind <> fk_enum then Continue;
      if B_Enums.High < i then
        DieDataCorrupt(RuEn('Таблица перечислимых типов слишком короткая.',
                            'Enumerated types table is too short.'));
      EnumIdentic[gt]:=(Enums[gt].High = B_Enums[i].High);
      EnumConvTable[gt].Length:=B_Enums[i].Length;
      With B_Enums[i] do begin
        For j:=0 to High do begin
          v:= -1;
          For k:=0 to Enums[gt].High do
            if NameTT[D[j]] = Enums[gt][k] then begin
              v:=k;
              Break;
            end;
          if v < 0 then begin
            v:=0;
            BasketWarningsAdd(MsgFormat(MI_BASKET_UNKNOWN_ENUM,
              [NameSpace[Types[gt].Name]
              ,B_NameSpace[D[j]]
              ,NameSpace[Enums[gt][0]]]));
          end;
          EnumConvTable[gt][j]:= v;
          EnumIdentic[gt]:=EnumIdentic[gt] and (v = j);
        End;
      end;
      if not EnumIdentic[gt]
        then BasketWarningsAdd(
               MsgFormat(MI_BASKET_ENUM_CHANGED, [NameSpace[Types[gt].Name]]));
      TypeChanged[gt]:= not EnumIdentic[gt];
    end;

    //Checking for the sets needing conversion due their base enum has changed:
    for i:=0 to Types.High do
      if (Types[i].kind = fk_set) and (TypeChanged[Types[i].BaseTypeInd])
        then TypeChanged[i]:=Yes;
  end;


  procedure LogWarnings();
  var
    i: integer;
    w: WideString;
  begin
    w:='';
    For i:=0 to CpsParserWarnings.Count - 1 do begin
      w:=w + {$ifdef fpc}Utf8Decode{$endif}(CpsParserWarnings[i]);
      if i < CpsParserWarnings.Count - 1
        then w:=w + #10#13
    end;
    AddLog(MI_BASKET_NOT_EVERYTHING_IS_FINE_AND_DANDY, [w]);
  end;





  constructor TChepersyDatabaseHeader.CreateDefaultInstance;
  var
    s: TMemoryStream;
    b: array of byte;
  begin
    CpsStream:= TMemoryStream.Create;
    //to get the checksum we use the dumbest (and surest) way possible:
    // we write the header into a temporary stream, then calculate md5 of it.
    WriteHeader;

    StreamVersion:= 2;

    SetLength(b, CpsStream.Size);
    CpsStream.Seek(0, soBeginning);
    CpsStream.ReadBuffer(b[0], CpsStream.Size);
    Checksum:= MD5Buffer(b[0], CpsStream.Size);
    CurrentVersionChecksum:= Checksum;
    CurrentVersionHeaderSize:= CpsStream.Size;
    HeaderSize:= CpsStream.Size;

    CpsStream.Seek(0, soBeginning);

    DH:= Self;

    ReadHeader(); //to initialize whatever needs to

    pointer(DH):= nil;

    CpsStream.Free;
    pointer(CpsStream):= nil;
  end;

  constructor TChepersyDatabaseHeader.CreateForLoad; // only for use by class function GetInstance
  var ps: integer;
  begin
    inherited Create;

    //this assumes class function ReadSignatureFromStream had been called,
    // so signature and checksum are already read from stream into class vars!
    Checksum:= ReadChecksum;
    HeaderSize:= ReadHeaderSize;

    DH:= Self; //Set the global variable NOW! ReadHeader depends on it.

    ReadHeader;  //also parse, create loading scenarios etc.
  end;

  procedure TChepersyDatabaseHeader.SkipHeader;
  var
    i, j: integer;
    buf: array[0..256] of byte;
  begin
    if MotherState^.VerboseLog then AddLog('Skipping header...');
    i:= 0;
    while i < HeaderSize do begin
      j:= min(256, HeaderSize - i);
      CpsStream.ReadBuffer(buf, j);
      i+= j;
    end;
    if MotherState^.VerboseLog then AddLog('   %0 bytes', [i]);
  end;

  procedure TChepersyDatabaseHeader.ReadHeader;
  var
    w: WideString;
    j: integer;
  begin
    Try
  // 1 Header version (added since v 0.7.0) (removed since v0.9.0)
     {$ifdef support08x}
      if (StreamVersion = 0) then begin
        HeaderVersion:= ReadInt;
        if HeaderVersion >= 0
        then Die(RuEn(
          'Устаревший формат данных,'#10#13'  Chepersy начиная с версии 0.8.3 не поддерживает'#10#13'  файлы, созданнные версиями ниже 0.7.0.',
          'Obsolete data format,'#10#13'  Chepersy 0.8.3 and up doesn''t support the data files'#10#13'  created by its versions below the 0.7.0 anymore.'));
      end;
     {$else}
     if HeaderVersion < 1
      then Die(RuEn(
        'Устаревший формат данных,'#10#13'  Данная сборка Chepersy не поддерживает'#10#13'  файлы, созданнные версиями ниже 0.9.0.',
        'Obsolete data format,'#10#13'  This version of Chepersy is compiled without the support for data files'#10#13'  created by its versions below 0.9.0.'));
     {$endif}
  // 2 Signature (wide string)
      w:=ReadWideString();
      if {$ifdef support08x}(StreamVersion > 0) and{$endif} (w <> SignatureString)
         then Die(RuEn('Не совпадает сигнатура.', 'Signature mismatch.'));
  // 3 Enumerated types (does not necessarily have the same length as the types array!)
      B_Enums:=T2DAOI.Create;
      B_Enums.Load(ReadInt());
  // 4 Type names - for type sizes check
      TNames:=TAOI.Create;
      TNames.Load(ReadInt());
  // 5 Type sizes - see above
      TSizes:=TAOI.Create;
      TSizes.Load(ReadInt());
  // 6 Type kinds (added since v0.7)
      TKinds:=TAOI.Create;
      TKinds.Load(ReadInt());
  // 7 Base type indices (added since v0.7)
      B_TBaseInds:=TAOI.Create;
      B_TBaseInds.Load(ReadInt());
  // 8 Index type indices (added since v0.7)
      B_TIndInds:=TAOI.Create;
      B_TIndInds.Load(ReadInt());
  // 9 Class names
      CNames:=TAOI.Create;
      CNames.Load(ReadInt());

      B_StaticLow:= TAOI.Create;
      B_RecBTinds:= TAOI.Create;
    {$ifdef support08x}
      if (StreamVersion > 0) then begin
    {$endif}
    // 10 Record type indices
        B_RecBTinds.Load(ReadInt());
    // 11 static array min indices
        B_StaticLow.Load(ReadInt());
    {$ifdef support08x}
      end
      else begin
        B_StaticLow.Length:= TNames.Length;
        for j:=0 to B_StaticLow.High do B_StaticLow[j]:= 0;
        B_RecBTinds.Length:= TNames.Length;
        for j:=0 to B_RecBTinds.High do B_RecBTinds[j]:= 0;
      end;
    {$endif}

  // 12 Ancestor names list (added since v0.7)
      CAncestorNames:=T2DAOI.Create;
      CAncestorNames.Load(ReadInt());
  // 13 Field lists
      B_Fields:= TFieldInfos.Create;
      B_Fields.Load(ReadInt());
  // 14 Name space
      B_NameSpace:=TNameSpace.Create;
      B_NameSpace.Load(ReadInt());
      NameTT:=B_NameSpace.Translate(NameSpace);

  // 15 a zero
      if ReadInt() <> 0 then Die(RuEn(
        'Неподдерживаемый формат потока данных',
        'Unsupported data stream format'));

      Parse;

  //for j:=0 to Types.High do WriteLn(NameSpace[Types[j].name], ' - ', TypeChanged[j]);
      if MotherState^.VerboseLog then AddLog(RuEn('Парсинг OK.','Parsing OK.'));

      //Filling the required per-class forms
      //  for all the classes known to basket:
      SetLength(B_Classes, Length(Cnums));
      SetLength(B_ScenarioIndex, Length(B_Classes));
      For j:=0 to Length(Cnums) - 1 do begin
        CpsFindLoadingScenario(Cnums[j], j);
        B_Classes[j]:=Types[Records[Cnums[j]]]._class
      end;
      if MotherState^.VerboseLog then AddLog(RuEn('Сценарии загрузки подобраны.','Loading scenarios matched.'));
     {$ifdef cge}
      if CpsParserWarnings.Count > 0 then LogWarnings();
     {$endif}

    Except
      Die(
         RuEn('Крах при подготовке данных к чтению.',
              'Crashed while preparing data for loading.'));
    End;
  end;



  procedure TChepersyDatabaseHeader.WriteHeader;
  var i,j: integer;
  begin
    Try
    // 1 Header version (added since v 7.0) (removed since v 9.0)
//      WriteInt(-1);
    // 2 Signature (wide string)
      WriteWideString(SignatureString);
    // 3 Enumerated type infos
      Enums.Save();
    // 4 Type names - for type sizes check
      With Types do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(D[i].name);
      end;
    // 5 Type sizes - see above
      With Types do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(D[i].Size);
      end;
    // 6 Type kinds (added since v0.7)
      With Types do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(ord(D[i].kind));
      end;
    // 7 Base type indices (added since v0.7)
      With Types do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(ord(D[i].BaseTypeInd));
      end;
    // 8 Index type indices (added since v0.7)
      With Types do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(ord(D[i].IndEnumInd));
      end;
    // 9 Record names
      With Records do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(Types[D[i]].Name);
      end;
    // 10 Record type indices (added since v0.9)
      With Records do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(D[i]);
      end;
    // 11 static array low values (added since v0.9)
      With Types do begin
        WriteInt(Length);
        For i:=0 to High do WriteInt(D[i].StaticLow);
      end;
    // 12 Ancestor names list (added since v0.7)
      With Records do begin
        WriteInt(Length);
        For i:=0 to High do
          With ClassAncestors[i] do begin
            WriteInt(Length);
            For j:=0 to High do WriteInt(D[j]);
          end;
      end;
    // 13 Field lists (per class)
      Fields.Save;
    // 14 Name space
      NameSpace.Save();

    // 15 a zero (for future extensions)
      WriteInt(0);


      if MotherState^.VerboseLog then AddLog(RuEn('Информация о типах записана.','Types information had been written.'));
    Except
      Die(
         RuEn('Крах при подготовке данных к записи'
            , 'Crashed while preparing data for saving.'));
    End;

  end;




  class function TChepersyDatabaseHeader.GetInstance: TChepersyDatabaseHeader;
  var i: integer;
    function ChecksumToHex(var D: TMd5Digest): Ansistring;
    var j: integer;
    begin
      For j:= High(D) downto 0 do Result+= IntToHex(D[j], 2);
    end;

  begin
    if MotherState^.VerboseLog then AddLog(RuEn(
      'Определяем заголовок потока..',
      'Detecting stream header..'));

    ReadSignatureFromStream(VersionOfLoadedFile);

    //with old versions, checksum is not stored.
    // A new instance of header is load each time, and it is not added to the array;
    if StreamVersion <= 1 then begin
      if MotherState^.VerboseLog then AddLog(RuEn(
        '  ..устаревший тип потока (%0), нет контрольной суммы. Парсим заголовок.',
        '  ..legacy stream type (%0), no checksum found. Parsing header.'),
        [StreamVersion]);

      Result:= TChepersyDatabaseHeader.CreateForLoad
    end
    else begin
      if MotherState^.VerboseLog then AddLog(RuEn(
        '  ..тип %1, контрольная сумма %0',
        '  ..type %1, checksum %0'),
        [ChecksumToHex(ReadChecksum), StreamVersion]);

      //check if a similar one already exists
      for i:= 0 to High(CpsDatabaseHeaders) do
        if ReadChecksum = CpsDatabaseHeaders[i].Checksum then begin
          if MotherState^.VerboseLog then AddLog(RuEn(
            '  ..уже есть в кеше под номером %0. Пропускаю заголовок потока.',
            '  ..already in the cache, number %0. Skipping the stream header.'),
            [i]);
          CpsDatabaseHeaders[i].SkipHeader;
          Exit(CpsDatabaseHeaders[i]);
        end;
      if MotherState^.VerboseLog then AddLog(RuEn(
        '  ..нет в кеше. Парсим заголовок и добавляем в кеш под номером %0.',
        '  ..not in the cache. Parsing the header to add as number %0.'),
        [Length(CpsDatabaseHeaders)]);
      Result:= TChepersyDatabaseHeader.CreateForLoad;
      SetLength(CpsDatabaseHeaders, Length(CpsDatabaseHeaders) + 1);
      CpsDatabaseHeaders[High(CpsDatabaseHeaders)]:= Result;
    end;
  end;

  procedure PrepareToSave(Target: TStream);
  var
    i, j: integer;
  begin
    CpsError.Clear;
    if not CpsFinalized then ClassesRegistrationEnd;
    NowSaving:=Yes;
    Obj:=TAOMO.Create;
    CurrentInd:=0;
    if Target is TFileStream
      then ContName:=(Target as TFileStream).FileName
      else Contname:=Target.ClassName;

    CpsStream:= Target;
  end;


  procedure PrepareToLoad(Source: TStream);
  var
    j: integer;
    CL: CManagedObject;
  begin
    CpsError.Clear;
    CpsParserWarnings.Clear;
    if not CpsFinalized then ClassesRegistrationEnd;
    NowLoading:=Yes;

    Obj:=TAOMO.Create;
    Obj.Length:=1;
    

    CpsStream:= Source;

    if Source is TFileStream
      then ContName:=(Source as TFileStream).FileName
      else Contname:=Source.ClassName;
    CpsParserWarnings.Clear;
//Die('AAARGH!');
  end;


  procedure DoneSaving(FreeTheStream: boolean);
  var
    i: integer;
  begin
    Try
      CloseCgeFile(FreeTheStream);

      //Cleanup indices
      For i:=0 to Obj.High do Obj[i].CpsIndex:=0;
      Obj.Container:=No;
      Obj.Free;
      NowSaving:=No;
    Except
      Die(RuEn('Сбой при финализации файла.','Crashed finalizing the file.'));
    End;
  end;
  
  procedure DoneLoading(FreeTheStream: boolean; var OutputList: TArrayOfManagedObjects);
  var
    i: integer;
  begin
    CloseCgeFile(FreeTheStream);

    pointer(DH):= nil;

//    SetLength(B_RecKinds, 0);
//    SetLength(CNums, 0);
//    Cnames.Free;
//    CAncestorNames.Free;
//    TNames.Free;
//    TKinds.Free;
//    B_TBaseInds.Free;
//    B_TIndInds.Free;
//    B_Fields.Free;
//    TSizes.Free;
//    B_NameSpace.Free;
//    NameTT.Free;
//    NaToT.Free;
//    B_Enums.Free;
//    EnumConvTable.Free;
//    B_StaticLow.Free;
//    SetLength(TypeChanged, 0);
//    SetLength(B_ToGtind, 0);
//    SetLength(B_Lrecind, 0);
//    SetLength(B_ScenarioIndex, 0);
    
    NowLoading:=No;
//{$include un_bottleneck_start.inc}
   //Notify objects that they were loaded

//04%
//AddLog('CpsLoad(): Obj.High = %0', [Obj.High]);
//{$include un_bottleneck_begin.inc}
   if Assigned(OutputList) then begin
      SetLength(OutputList, Obj.High);
      For i:=Obj.High downto 1 do OutputList[Obj.High - i]:= Obj[i];
    end
    else begin
      {$ifdef safeloading}
      Try

      {$endif}
        For i:=Obj.High downto 1 do Obj[i].AfterLoading;

      {$ifdef safeloading}
      Except
        Die(RuEn('При вызове %0.AfterLoading','During %0.Afterloading call'), [string(Obj[i].ClassName)]);
      End;
      {$endif}
    end;
//{$include un_bottleneck_end.inc}
//{$include un_bottleneck_stop.inc}
//AddLog('DoneLoading(): high(OutputList) = %0 ', [high(OutputList)]);
//For i:=Obj.High downto 1 do AddLog(AnsiString(Obj[i].Classname));

    Obj.Container:= No;
    Obj.Free;
  end;
  
  function NumObjects: integer;
  begin
    Result:=Obj.High;
  end;
  

  procedure LoadEnum(tyi: integer; p: pointer);
  begin
    dword(p^):= DH.EnumConvTable[tyi][ReadInt()];
  end;

