freepascal.ru

Очень извиняюсь, уже об этом спрашивал, но руки так и не дошли, и ответ потерялся.

Суть: моей системе сериализации приходится иметь процедуры типа "Создать динамический массив, размер элемента такой-то", где ей даётся указатель на поле класса, а тип может быть любой. Полез вспоминать, как это сделано в коде - и...

Код: Выделить всё

Procedure NewDynArray(parray: pointer; Len, BaseTypeInd: integer);
begin
  pointer(parray^):= nil;
  SetLength(TArrayOfByte(parray^), Len * Types[BaseTypeInd].Size);
  if Len > 0 then  //high value in FreePascal, length  in Delphi
  {$ifdef fpc}
    dword((pointer(parray^) - 4)^):= Len - 1;
  {$else}
    dword(pointer(cardinal(parray^) - 4)^):= Len;
  {$endif}
end;

function GetDynArrayLength(parray: pointer): integer;
begin
  Result:= longint(pointer(pointer(parray^) - 4)^) {$ifdef fpc} + 1{$endif}
              //the value at -4 contains Length() in Delphi
              //and High() (i.e. Length() -1 ) in FreePascal
end;

procedure IncRawByteStringRefCount(ps: pointer);
begin
  if Assigned(ps) then inc(longint(pointer(ptruint(ps) - 8)^));
end;

procedure IncUnicodeStringRefCount(ps: pointer);
begin
  if Assigned(ps) then inc(longint(pointer(ptruint(ps) - 8)^));
end;

procedure IncWideStringRefCount(ps: pointer);
begin
  if Assigned(ps) then inc(longint(pointer(ptruint(ps) - 8)^));
end;

так в чём вопрос-то?
Хотя можешь не задавать, ответ один - вместо того чтобы хакать динамический массив (стрельба в нижнее конечности), напиши обёртку вокруг него. Работать будет надёжно, кросс-платформенно, кросс-компиляторно

И совсем не нужны "мальчики кровавые в глазах".

Глянь тут. Возможно, там уже есть что нужно.
Обертка так точно есть.

А- ха- ха- ха- ха- хаки!

Сдаюсь.

Даже Synopse

Код: Выделить всё

result := PDynArrayRec(PtrUInt(fValue^)-SizeOf(TDynArrayRec))^.length;
//где
  TDynArrayRec =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    /// dynamic array reference count (basic garbage memory mechanism)
    {$ifdef FPC}
    refCnt: PtrInt;
    high: tdynarrayindex;
    function GetLength: sizeint; inline;
    procedure SetLength(len: sizeint); inline;
    property length: sizeint read GetLength write SetLength;
    {$else}
    {$ifdef CPUX64}
    _Padding: LongInt; // Delphi XE2+ expects 16 byte alignment
    {$endif}
    refCnt: Longint;
    /// length in element count
    // - size in bytes = length*ElemSize
    length: PtrInt;
    {$endif}
  end;
  PDynArrayRec = ^TDynArrayRec;


Даже собственная RTL Фри Паскаля.

Код: Выделить всё

realpsrc:= pdynarray(psrc-sizeof(tdynarray));
//где
    pdynarray = ^tdynarray;
   tdynarray = packed record
      refcount : ptrint;
      high : tdynarrayindex;
   end;


..по крайней мере, ужас от того, что я увидел такой же хак в исходниках Synopse, подвиг меня найти кусок RTL, где это всё реализовано

Код: Выделить всё

procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);


, а остальные - как всегда, придётся копипастить, поскольку они зарыты внутри модуля system:

Код: Выделить всё

function aligntoptr(p : pointer) : pointer;inline;
   begin
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
     result:=align(p,sizeof(p));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
     result:=p;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
   end;
Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
type
   { don't add new fields, the size is used }
   { to calculate memory requirements       }
   pdynarray = ^tdynarray;
   tdynarray = packed record
      refcount : ptrint;
      high : tdynarrayindex;
   end;
const
   tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,
                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];

function _dynarray_copy(psrc : pointer;ti : pointer;
    lowidx,count:tdynarrayindex) : pointer;
  var
    realpdest,
    realpsrc : pdynarray;
    cnt,
    i,size : longint;
    highidx : tdynarrayindex;
    elesize : sizeint;
    eletype : pdynarraytypeinfo;
    pdest : pointer;
  begin
     highidx:=lowidx+count-1;
     pdest:=nil;
     result:=pdest;
     if psrc=nil then
       exit;
     realpsrc:=pdynarray(psrc-sizeof(tdynarray));
     { skip kind and name }
     inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);

     ti:=aligntoptr(ti);

     elesize:=psizeint(ti)^;
     eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);

     { -1, -1 (highidx=lowidx-1-1=-3) is used to copy the whole array like a:=copy(b);, so
       update the lowidx and highidx with the values from psrc }
     if (lowidx=-1) and (highidx=-3) then
      begin
        lowidx:=0;
        highidx:=realpsrc^.high;
      end;
     { get number of elements and check for invalid values }
     if (lowidx<0) or (highidx<0) or (lowidx > realpsrc^.high) then
       HandleErrorFrame(201,get_frame);
     cnt:=highidx-lowidx+1;
     if (cnt > realpsrc^.high - lowidx + 1) then
       cnt := realpsrc^.high - lowidx + 1;
     { create new array }
     size:=elesize*cnt;
     getmem(realpdest,size+sizeof(tdynarray));
     pdest:=pointer(realpdest)+sizeof(tdynarray);
     { copy data }
     move(pointer(psrc+elesize*lowidx)^,pdest^,size);
     { fill new refcount }
     realpdest^.refcount:=1;
     realpdest^.high:=cnt-1;

     { increment ref. count of members? }
     if TTypeKind(PByte(eletype)^) in tkManagedTypes then
       for i:= 0 to cnt-1 do
         int_addref(pointer(pdest+elesize*i),eletype);

     result:=pdest;
  end;


И нет, путь Synopse и врапперы мне не годятся, мне надо выжать из сериализации/клонирования каждый грамм скорости.

Cheb писал(а):..., мне надо выжать из сериализации/клонирования каждый грамм скорости.

а я всё-равно не понимаю в чём вопрос.
тебе не нравится написанный код по стилю или по производительности?

У меня уже есть специализированный велосипед, заточенный под мой Хитрый План. В смысле, на переправе коней не меняют.
Просто хотелось бы слегка причесать, убрать откровенные ктулхаки.

У меня собственная информация о типах, расширяющая RTTI
Копаясь в исходниках RTL увидел, как можно многое упростить, потому что о многих фичах просто не знал, или делал когда фпц их ещё не имел.
Но отказаться от собственной информации о типах невозможно. У меня можно поля объектов и записей помечать как "игнорировать при записи, заполнить нулями при чтении", и это очень нужная фича.

Вопрос:
это правда, что RefCount массивам нужен *только* для деинициализации при выходе из зоны видимости (т.е. локальные переменные функций) путём обхода по всему дереву элементов и уменьшения RefCount'а им всем ?
Насколько я вижу, массивы, в отличие от строк, не имеют "Copy-On-Write".

Если это так, я могу серьёзно оптимизировать мультиплеерную модель, запилив собственный механизм копирования массивов с блекджеком и шлюхами.
То есть, вместо копирования просто увеличивать ему RefCount, а перед каждой записью в массив вставлять процедуру "ГарантироватьЧтоУникальный", которая копирует, но только когда это реально нужно.

Ещё вопрос:
если я, допустим, сознательно забиваю на многопоточность - достаточное ли это обоснование для ручного лазания к полю RefCount вместо вызова вещей типа

Код: Выделить всё

arrayrtti(data,typeinfo,@fpc_systemDecRef);

?

а это, в фпц аннотации еще не добавили?

Cheb писал(а):это правда, что RefCount массивам нужен *только* для деинициализации при выходе из зоны видимости (т.е. локальные переменные функций) путём обхода по всему дереву элементов и уменьшения RefCount'а им всем ?

Нет, RefCount не ограничен задачей деинициализации при выходе из зоны видимости.
Их вполне можно использовать как полноценный refCount объект, и вместо физического копирования будет увеличивать / уменьшать счётчик ссылок.

Добавлено спустя 11 минут 37 секунд:

Cheb писал(а):если я, допустим, сознательно забиваю на многопоточность - достаточное ли это обоснование для ручного лазания к полю RefCount вместо вызова вещей типа

а зачем лазать руками, когда достаточно присвоить значение?

Код: Выделить всё

{$mode delphi}
uses
  SysUtils;

type
  TArrayofByte = array of byte;

  TData = class(TObject)
    arr : TArrayOfByte;   
  end;

procedure Init(d: TData);
var
  p : TArrayofByte;
  i : integer;
begin
  SetLength(p, 5);
  for i:=0 to length(p)-1 do
    p[i]:=random(100);
  d.arr:=p; // refcount+1
end;

procedure Print(a: TData);
var
  i : integer;
begin
  for i:=0 to length(a.arr)-1 do
    write(a.arr[i],' ');
  writeln;
end;

var
  i : integer;
  a : array of TData;
begin 
  SetLength(a, random(10));
  for i:=0 to length(a)-1 do begin
    a[i]:=TData.Create;
    Init(a[i]);
  end;
  for i:=0 to length(a)- 1 do
    Print(a[i]);
  for i:=0 to length(a)-1 do  a[i].Free; // refcount-1
end.


а зачем лазать руками,

1. Не буду писать враппер для *каждого* массива. У меня будут множество массивов разных записей, все - поля одного объекта.
2. У меня универсальная процедура клонирования, например, экземпляра А, которая создаёт экземпляр Б прямым выделением памяти *без* вызова конструктора, потом копирует А в Б как бинарный блок при помощи MOVE, а потом уже проходит по менеджед полям Б подправляя счётчики ссылок.

Суть тут в том, что это *одна* процедура на все возможные классы, она умеет выколупывать из переданного экземпляра все нужные сведения для создания ейного клона.

не ограничен задачей деинициализации при выходе из зоны видимости.

То есть я таки могу это поэксплуатировать
Допустим, клонирую тысячу объектов, у каждого по десять массивов, при этом копируется только 1000 кусков памяти, а... Чёооорт Это всё равно не очень кеш-фриндли потому что перебаламутит 10 тысяч кусков памяти, увеличивая счётчики ссылок у 10000 массивов. Ну, хотя бы, лучше, чем копировать их содержимое полностью.

P.S.
Насколько я понимаю,

Код: Выделить всё

SetLength(a, Length(a));

- это официальный способ сделать массив уникальным, с счётчикомм ссылок = 1?
В исходниках fpc_dynarray_setlength() если RefCount не равен 1, то сразу идёт копирование, равенство длины даже не проверяетя.

P.S. А вообще, там халтура в коде. При изменении размера сначала *весь* новый кусок очищается fillchar(), а потом поверх него move() из старого массива. Т.е. при равном или близком размере память перезаписывается дважды. ( sourcertlincdynarr.inc строка 201 в 2.6.4 / строка 174 в 3.0.0 )

Добавлено спустя 18 минут 17 секунд:
З.Ы. Настучал в багтрекер.

Cheb писал(а):P.S. А вообще, там халтура в коде. При изменении размера сначала *весь* новый кусок очищается fillchar(), а потом поверх него move() из старого массива. Т.е. при равном или близком размере память перезаписывается дважды. ( source\rtl\inc\dynarr.inc строка 201 в 2.6.4 / строка 174 в 3.0.0 )

а ты патч забыл приложить
исправлено!

Эээ, я известен своей внезапной косорукостью, не хотелось бы предлагать нечто безответственно нетестированное (а собирать компилятор я не умею ибо лень, да)

Cheb писал(а):- это официальный способ сделать массив уникальным, с счётчикомм ссылок = 1?

Не думаю. Потенциально SetLength может быть оптимизирован: в том случае если запрашиваемая длинна и текущая длинна совпадают, то ничего не делай. Тогда об уникальности говорить не приходится.

Наиболее гаранатированный способ такой:

Код: Выделить всё

  b:=nil; // b - динамический массив
  SetLength(b, length(a)); // новый уникальный
  a:=b;  // +refcount
  b:=nil; // -refcount
  //  в итоге a - уникальный массив с refCount-ом 1


Наиболее гаранатированный способ такой:

Аргх.
Не подходит, у меня процедура, которая получает указатель на массив *любого* типа и typeInfo().
Придётся хаками.
Впрочем, запомню для более мирных применений.

Мне, скорее, нужно получить что-то вроде Copy-on-write для бедных, т.е. везде перед изменением - вызов процедуры Уникализировать(a), после чего он скопируется, но только если refcount был > 1, иначе останется нетронутым.

Добавлено спустя 5 минут 25 секунд:
З.Ы. Я всё равно уже умудрился дублировать в Чеперси все эти выкрутасы, так, что CleanupInstance срабатывает и ничего не падает -- а ведь при загрузке экземпляра класса из потока - никакого конструктора, никакой инициализации, всё ручками.

SetLength обеспечивает уникальность получившейся строки или дин.массива. Это поведение документировано и оптимизациям не подлежит.

Sergei I. Gorelkin писал(а):SetLength обеспечивает уникальность получившейся строки или дин.массива. Это поведение документировано и оптимизациям не подлежит.

хм. В документации не хватает дублирования. В SetLength о такой особенности не упоминается (а неплохо бы). Зато сказано в arrays

The SetLength call will make sure the reference count of the returned array is 1, that it, if 2 dynamic array variables were pointing to the same memory they will no longer do so after the setlength call

т.е. для ленивого SetLength-а придётся такой код писать

Код: Выделить всё

procedure SetLength(var a; newLen: integer); inline;
begin
  // приведение к TByteArray - это очевидный хак
  if Length(TByteArray(a)) = newLen then Exit
  else System.SetLength( TByteArray(a), newLen);
end;


всё-таки динамические массивы более низкоуровневые, чем я о них думал. Что и хорошо.

Добавлено спустя 5 часов 58 минут 17 секунд:

скалогрыз писал(а):т.е. для ленивого SetLength-а придётся такой код писать

не. фигня это. Ничего не нужно писать.
В тех случаях, когда refcount=1, всё работает работает вполне ожидаемо (т.е. память не перераспределяется)

Добавлено спустя 1 минуту 59 секунд:

Cheb писал(а):Эээ, я известен своей внезапной косорукостью, не хотелось бы предлагать нечто безответственно нетестированное

если посмотреть багтракер, то там видно, что я особой пряморукостью не отличаюсь