Динамический массив любого типа

[Sergei I. Gorelkin]

Вряд ли это был баг, исправленный в транке: case-выражения с перечисляемым типом используются в самом компиляторе, поэтому при наличии подобного бага было бы невозможно собрать релиз.

[debi12345]

Значит, какая-то опция копилятора ? Но какая ?

Добавлено спустя 4 минуты 33 секунды:

зато плюсы ООП налицо:

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

  for i:= high(arr1) downto low(arr1) do
  arr1[i].WriteDataWithType;

Хм, это работае только для WRITELN с ее безразличием к типу. В прочих случаях для работы со значениями придется проверять на тип :

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

if arr1[i] is  INTObj then
else if arr1[i] is  TEXTObj then

Добавлено спустя 14 минут 27 секунд:
Тестирование на одноядерном П4:
1) вариантс указателями - 6 секунд, макс. память 107вирт/90физ МБайт
2) вариантс объектами - 3..4 секунды, макс. память 180вирт/110физ МБайт

[Sergei I. Gorelkin]

Значит, какая-то опция копилятора ? Но какая ?

Нет там никаких опций.
Лучше напиши, какая ошибка.

[debi12345]

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

  
{$mode objfpc}{$h+}

chmorec = packed record
    int_val: integer;
    str_val: pchar;
  end;
  pchmorec = ^chmorec;

  ANYTYPE = (INT_T,TEXT_T,REAL_T,CHMO_T);

  anydatarecty = packed record
    case data_type:ANYTYPE of
      INT_T:  (ival: integer);
      TEXT_T: (tval: pchar);
      REAL_T: (rval: double);
      CHMO_T: (chmoval: chmorec);
  end;
  anydatarecarty = array of anydatarecty;


procedure addelem(var arr: anydatarecarty; atype:ANYTYPE; adataptr: pointer); 
begin
  setlength(arr,length(arr)+1);
  arr[high(arr)].data_type:= atype;

//  case integer(atype) of
//    integer(INT_T): arr[high(arr)].ival:= integer(adataptr^);
//    integer(TEXT_T): arr[high(arr)].tval:= strnew(pchar(adataptr));
//    integer(REAL_T): arr[high(arr)].rval:= double(adataptr^);
//    integer(CHMO_T): begin
//      with arr[high(arr)].chmoval do begin
//        int_val:= (chmorec(adataptr^)).int_val;
//        str_val:= strnew((chmorec(adataptr^)).str_val);
//      end;
//    end;
//  end;

  case atype of
    INT_T: arr[high(arr)].ival:= integer(adataptr^);
    TEXT_T: arr[high(arr)].tval:= strnew(pchar(adataptr));
    REAL_T: arr[high(arr)].rval:= double(adataptr^);
    CHMO_T: begin
      with arr[high(arr)].chmoval do begin
        int_val:= (chmorec(adataptr^)).int_val;
        str_val:= strnew((chmorec(adataptr^)).str_val);
      end;
    end;
  end;
end;

Error: Constant and CASE types do not match

[Sergei I. Gorelkin]

Такое может быть при наличии другого определения "anytype" или INT_T,TEXT_T,... в одном из используемых модулей.

Если ветку case с ошибкой закомментировать - в остальных ветках ошибка остается?

[debi12345]

Спасает толк приведение типа во ВСЕХ частях CASE. Вот вся программка, ребочий код закоментирован6

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

program test;
{$mode objfpc}{$h+}

uses
  sysutils,strings;

const
  TEST_CNT = 300000;

type

  chmorec = packed record
    int_val: integer;
    str_val: pchar;
  end;
  pchmorec = ^chmorec;

  ANYTYPE = (INT_T,TEXT_T,REAL_T,CHMO_T);

  anydatarecty = packed record
    case data_type:ANYTYPE of
      INT_T:  (ival: integer);
      TEXT_T: (tval: pchar);
      REAL_T: (rval: double);
      CHMO_T: (chmoval: chmorec);
  end;
  anydatarecarty = array of anydatarecty;


procedure addelem(var arr: anydatarecarty; atype:ANYTYPE; adataptr: pointer); 
begin
  setlength(arr,length(arr)+1);
  arr[high(arr)].data_type:= atype;

//  case integer(atype) of
//    integer(INT_T): arr[high(arr)].ival:= integer(adataptr^);
//    integer(TEXT_T): arr[high(arr)].tval:= strnew(pchar(adataptr));
//    integer(REAL_T): arr[high(arr)].rval:= double(adataptr^);
//    integer(CHMO_T): begin
//      with arr[high(arr)].chmoval do begin
//        int_val:= (chmorec(adataptr^)).int_val;
//        str_val:= strnew((chmorec(adataptr^)).str_val);
//      end;
//    end;
//  end;


  case atype of
    INT_T: arr[high(arr)].ival:= integer(adataptr^);
    TEXT_T: arr[high(arr)].tval:= strnew(pchar(adataptr));
    REAL_T: arr[high(arr)].rval:= double(adataptr^);
    CHMO_T: begin
      with arr[high(arr)].chmoval do begin
        int_val:= (chmorec(adataptr^)).int_val;
        str_val:= strnew((chmorec(adataptr^)).str_val);
      end;
    end;
  end;


end;


var
 arr1: anydatarecarty;
 i1: integer;
 pch1: pchar;
 r1: double;
 chmo1: chmorec;
 i: integer;

begin

  for i:= 0 to TEST_CNT do begin
    i1:= i;
    addelem(arr1,INT_T,@i1); 

    r1:= double(i);
    addelem(arr1,REAL_T,@r1); 

    pch1:= pchar(inttostr(i) + ' as text');
    addelem(arr1,TEXT_T,pch1); 

    chmo1.int_val:= i;
    chmo1.str_val:= pchar(inttostr(i) +' as text in CHMOREC');
    addelem(arr1,CHMO_T,@chmo1); 
  end;


  for i:= high(arr1) downto low(arr1) do begin
    case integer(arr1[i].data_type) of
//    integer(INT_T):  writeln('int val = ',  arr1[i].ival);
      integer(TEXT_T): begin
//        writeln('text val = ', arr1[i].tval);
        dispose(arr1[i].tval);
      end;
//      integer(REAL_T): writeln('real val = ', arr1[i].rval);
      integer(CHMO_T): begin
//        writeln('chmo rec = {', arr1[i].chmoval.int_val,',',arr1[i].chmoval.str_val, '}');
        dispose(arr1[i].chmoval.str_val);
      end;
    end;
  end;


end.

[Sergei I. Gorelkin]

Сейчас специально выкачал 2.6.2 и проверил с ним - ошибка не воспроизводится.
Право слово, не знаю, что там у тебя происходит...

[debi12345]

У меня 2.6.1 (вынь-32). Проверю на 2.6.2.

[zub]

>>Хм, это работае только для WRITELN с ее безразличием к типу. В прочих случаях для работы со значениями придется проверять на тип :
проверка типа производится автоматом при вызове виртуального метода - т.е. для разных типов будут вызваны методы разных обжектов. Внутри метода тип нужно привести руками при надобности, т.е. разные ветки case упаковываются в методы объектов, а сам case выполняется компилятором путем взятия адреса нужного метода из VMT. В результате более многострочная и более читаемая (имхо) программа, чем постоянные "ручные" case

Попробуйте более быстрый вариант - всё упаковано в жирный data

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

program project1;
{$mode objfpc}{$h+}

uses
  sysutils,strings;

const
  TEST_CNT = 300000;

type

  chmorec = packed record
    int_val: integer;
    str_val: pchar;
  end;
  pchmorec = ^chmorec;

  tdatasized=packed array [1..sizeof(chmorec)] of byte;

  baseObj = packed object
    data:tdatasized{pointer};
    procedure WriteDataWithType;virtual;abstract;
    destructor done;virtual;
  end;

  INTObj = packed object(baseObj)
    procedure WriteDataWithType;virtual;
    constructor init(adataptr: pointer);
  end;
  TEXTObj = packed object(baseObj)
    procedure WriteDataWithType;virtual;
    constructor init(adataptr: pointer);
    destructor done;virtual;
  end;
  REALObj = packed object(baseObj)
    procedure WriteDataWithType;virtual;
    constructor init(adataptr: pointer);
    destructor done;virtual;
  end;
  CHMOObj = packed object(baseObj)
    procedure WriteDataWithType;virtual;
    constructor init(adataptr: pointer);
    destructor done;virtual;
  end;

  anyObjarty = array of baseObj;


  ANYTYPE = (INT_T,TEXT_T,REAL_T,CHMO_T);

destructor baseObj.done;
begin
end;
procedure INTObj.WriteDataWithType;
begin
     writeln('int val = ', pinteger(@data)^);
end;
constructor INTObj.init(adataptr: pointer);
begin
     pinteger(@data)^:=pinteger(adataptr)^;
end;
procedure TEXTObj.WriteDataWithType;
begin
     writeln('text val = ', ppchar(@data)^);
end;
constructor TEXTObj.init(adataptr: pointer);
begin
     ppchar(@data)^:=strnew(pchar(adataptr));
end;
destructor TEXTObj.done;
begin
     strdispose(ppchar(@data)^);
end;
procedure REALObj.WriteDataWithType;
begin
     writeln('real val = ', pdouble(@data)^);
end;
constructor REALObj.init(adataptr: pointer);
begin
     //new(pdouble(data));
     pdouble(@data)^:=pdouble(adataptr)^;
end;
destructor REALObj.done;
begin
     //dispose(pdouble(data));
end;
procedure CHMOObj.WriteDataWithType;
begin
     writeln('chmo rec = {', inttostr(pchmorec(@data)^.int_val)+',',pchmorec(@data)^.str_val,'}');
end;
constructor CHMOObj.init(adataptr: pointer);
begin
     //new(pchmorec(data));
     pchmorec(@data)^.int_val:=pchmorec(adataptr)^.int_val;
     pchmorec(@data)^.str_val:=strnew(pchmorec(adataptr)^.str_val);
end;
destructor CHMOObj.done;
begin
     strdispose(pchmorec(@data)^.str_val);
     //dispose(pchmorec(@data));
end;


procedure addelem(var arr: anyObjarty; atype:ANYTYPE; adataptr: pointer);
begin
  setlength(arr,length(arr)+1);
  case atype of
    INT_T: INTObj(arr[high(arr)]).init(adataptr);
    TEXT_T:TEXTObj(arr[high(arr)]).init(adataptr);
    REAL_T:REALObj(arr[high(arr)]).init(adataptr);
    CHMO_T:CHMOObj(arr[high(arr)]).init(adataptr);
  end;
end;


var
 arr1: anyObjarty;
 i1: integer;
 pch1: pchar;
 r1: double;
 chmo1: chmorec;
 i: integer;

begin
  for i:= 0 to TEST_CNT do begin
  i1:= 1;
  addelem(arr1,INT_T,@i1);

  r1:= 1.234;
  addelem(arr1,REAL_T,@r1);

  pch1:= 'one';
  addelem(arr1,TEXT_T,pch1);

  chmo1.int_val:= 100;
  chmo1.str_val:= 'hundred';
  addelem(arr1,CHMO_T,@chmo1);
  end;

  for i:= high(arr1) downto low(arr1) do
  begin
    arr1[i].WriteDataWithType;
    arr1[i].done;
  end;
end.

[debi12345]

Новый вариант : 6 секунд, 110/70. Практически не оличается от варианта с указателями.

Объекты, в отличие от юнионов - позволяют хранить AnsiString (и прочие рефкаунтед-типы), вместо возни с динамической памятью (Pchar,..). Оптимизировать можно попытаться на этом.

Добавлено спустя 10 минут 44 секунды:

проверка типа производится автоматом при вызове виртуального метода - т.е. для разных типов будут вызваны методы разных обжектов.

Полиморфизм ? Но он касается унаследованых базовых типов, а не содержащихся во внутренних переменных (как в нашем случае).
Ну, например в цикле перебора объектов нужно переключать - какого тип перменой присваивать значение элемента массива, точнее - нужно определять что например текущий элемент - TEXTobj и поэтоу присваивать его значение INTEGER-типу не следует.
Классы и оюъекты хороши тогда, когда из них не читают занчения , а когда дают им команду что-то сделать своими методами. Но 1-й вариант с объектами и по скорости удивительно хорош.

Добавлено спустя 44 минуты 36 секунд:
Кстати, последний вариант (с запихиванием в байтовый массив) по сути аналогичен запихиванию в такой же байтовый кусок в VARIANT

Добавлено спустя 11 часов 6 минут 49 секунд:
Хм... ФПЦ 2.6.2 перечислимый "кэйс" скушал А "сидел" я оказывается вообще на 2.6.0.

[zub]

>>Полиморфизм ?
в данном примере всё прекрасно унифицируется. присвоение - через указатель, получение значения - просто writeln, а не возврат типизированного значения. Конечно в реальной программе всё не так, но большинство развесистых case можно будет переложить на компилятор, оставив их только там где они реально нужны
>>Классы и оюъекты хороши тогда, когда из них не читают занчения
если из них нужно получить типизированное значение они становятся почти вариантным record`ом, не лучше не хуже, но с некоторыми дополнительными расходами памяти
>>о 1-й вариант с объектами и по скорости удивительно хорош
Удивительно что второй вариант оказался хуже, для меня полная неожиданность - убрана куча мелких выделений памяти но размер массива увеличен - в остальном всё тоже, вообще недогоняю откуда замедление

[debi12345]

На Вашем компе тоже замедление ?
Не хотите пропробовать TObject и AnsiString вместо PChar(возня с динамической памятью) ? Задача реально акутальна - поэтому хотелось бы иметь вылизаный солюшен

Добавлено спустя 3 минуты 25 секунд:

убрана куча мелких выделений памяти но размер массива увеличен -

Может при этом уменьшился процента пападания в кэши проца ? У меня на работе - "старичок" P4 с маленькими кэшами.

[zub]

да, у меня на i5-2400 x86-64 последний вариант самый медленный. вывод на экран закоментирован, только заполнение и освобождение

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

setlength(arr,length(arr)+1);

всяко не попадает под вылизанное решение))

Добавлено спустя 17 минут 25 секунд:
да, размер элемента массива влияет на скорость, видимо чем он меньше - тем больше элементов по одному можно добавить в массив без перераспределения памяти. мы мереем скорость setlength, а не обжектов-рекордов))

Добавлено спустя 18 минут 7 секунд:
с уходом от setlength на каждый элемент результаты следующие:

zamtmn@zamtmn-desktop:/mnt/wind/array$ time ./v1

real 0m0.201s
user 0m0.196s
sys 0m0.004s
zamtmn@zamtmn-desktop:/mnt/wind/array$ time ./v2

real 0m0.127s
user 0m0.096s
sys 0m0.028s
zamtmn@zamtmn-desktop:/mnt/wind/array$ time ./v3

real 0m0.095s
user 0m0.080s
sys 0m0.016s

v1 - ваш вариант, v2 (с data:pointer) и v3 (с широким data, в которое "всё влазит") - мои варианты,

[debi12345]

всяко не попадает под вылизанное решение

Я опасался за StrNew(выделение новой памяти + копирование в нее).

с уходом от setlength

А как удалось от него уйти ? Вообще отказаться от динамического массива ?

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

мы мереем скорость setlength,

Она по идее не дожнаа тормозить - все таки это просто довыделение памяти в конец, а не перетасовока данных после удаления и т.п.

[zub]

>>А как удалось от него уйти ? Вообще отказаться от динамического массива ?
по сути да - сделав один раз setlength сразу на нужное количество элементов. А в жизни придется выделять с запасом и хранить индекс последнего заполненного элемента - т.е. сделать обертку над массивом.
tvector из fpc-stl насколько помню каждый раз когда кончается свободное место в массиве увеличивает его вдвое. Память нынче дешевая))

Добавлено спустя 2 минуты 18 секунд:
>>Она по идее не дожнаа тормозить - все таки это просто довыделение памяти в конец, а не перетасовока данных после удаления и т.п.
вот и получается - сколькото довыделений и сколькото полноценных выделений с перемещением