VPF::Добавить элемент в динамический массив

iff

Дата 25.5.2011, 16:28 (ссылка)

(нет голосов)

Загрузка ...

Администратор

Профиль
Группа: Участник
Сообщений: 949
Регистрация: 23.3.2007

Репутация: нет
Всего: 16

Пишу на Turbo Pascal.
Есть динамический одномерный массив. нужно добавить в его конец ещё один элемент.
если это делать так:

Код


type arrtype : array[1..1] of integer;
var myarr : ^arrtype; counter : byte;
begin
   counter := counter + 1;
   getmem(myarr, counter * sizeof(integer));
end.

то все ранее введненные элементы стираются. нужно что-то типа:

Код


type arrtype : array[1..1] of integer;
var myarr : ^arrtype; counter : byte;
begin
   getmem(myarr + counter * sizeof(integer), sizeof(integer));
   counter := counter + 1;
end.

но только, понятное дела, getmem(myarr + counter * sizeof(integer), sizeof(integer)); не работает. Если использовать getmem(myarr[counter], sizeof(integer));, то тоже не работает. Т.е. получается здесь нужно сложить адреса...

Добавлено через 32 секунды
Пока что только один вариант - не использовать getmem вообще.

--------------------

DOS... Синей пеленой экран заполнил чистый DOS
Мышь... Стала вдруг квадратной, потеряла форму мышь...
Я разбил окно, девяностопятое мастдайное окно,
И поставил DOS, и тогда увидел: Это счастье, — вот оно.

Snowy

Дата 25.5.2011, 17:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: нет
Всего: 484

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

Код

program zz;

type
  arrtype = array[1..1] of integer;
  Parrtype = ^arrtype;

procedure ResizeArray(var arr: Parrtype; oldSize, newSize: integer); // изменить размер массива
var
  a2: Parrtype; // временный указатель на старую память
  sz: integer; // размер содержимого, которое нужно перенести
begin
   a2 := arr; // запоминаем указатель на старую память
   sz := oldSize;
   if oldSize > newSize then sz := newSize; // если уменьшаем размер, то переносить не всё
   getmem(arr, newSize * sizeof(integer)); // выделяем новый блок памяти
   move(a2^, arr^, sz * sizeof(integer)); // переносим из старого блока
   FreeMem(a2, oldSize); // старый блок освобождаем!!!
end;

var
  myarr,arr2: Parrtype;
  counter: byte;
begin
   counter := 2;
   getmem(myarr, counter * sizeof(integer));
   myarr^[1] := 10;
   myarr^[counter] := 20;
   ResizeArray(myarr, counter, counter+1); // добавили
   counter := counter+1;
   myarr^[counter] := 30;
   WriteLn(myarr^[1]);
   WriteLn(myarr^[counter-1]);
   WriteLn(myarr^[counter]);
   FreeMem(myarr, counter);
   ReadLn;
end.

cemick

Дата 25.5.2011, 17:25 (ссылка)

(голосов:1)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: нет
Всего: 6

Зачем велосипеды придумывать??
Во первых у вас не динамический массив, динамический же будет
arrtype = array of integer;

Затем есть процедура перераспределения памяти существующего блока ReallocMem.
И вообще вся эта работа уже делается в динамическом массиве, когда вызывается метод из System:

Код


procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: Longint; lengthVec: PLongint);
var
  i: Integer;
  newLength, oldLength, minLength: Longint;
  elSize: Longint;
  neededSize: Longint;
  p, pp: Pointer;
begin
  p := a;

  // Fetch the new length of the array in this dimension, and the old length
  newLength := PLongint(lengthVec)^;
  if newLength <= 0 then
  begin
    if newLength < 0 then
      Error(reRangeError);
    DynArrayClear(a, typeInfo);
    exit;
  end;

  oldLength := 0;
  if p <> nil then
  begin
    Dec(PLongint(p));
    oldLength := PLongint(p)^;
    Dec(PLongint(p));
  end;

  // Calculate the needed size of the heap object
  Inc(PChar(typeInfo), Length(PDynArrayTypeInfo(typeInfo).name));
  elSize := PDynArrayTypeInfo(typeInfo).elSize;
  if PDynArrayTypeInfo(typeInfo).elType <> nil then
    typeInfo := PDynArrayTypeInfo(typeInfo).elType^
  else
    typeInfo := nil;
  neededSize := newLength*elSize;
  if neededSize div newLength <> elSize then
    Error(reRangeError);
  Inc(neededSize, Sizeof(Longint)*2);

  // If the heap object isn't shared (ref count = 1), just resize it. Otherwise, we make a copy
  if (p = nil) or (PLongint(p)^ = 1) then
  begin
    pp := p;
    if (newLength < oldLength) and (typeInfo <> nil) then
      FinalizeArray(PChar(p) + Sizeof(Longint)*2 + newLength*elSize, typeInfo, oldLength - newLength);
    ReallocMem(pp, neededSize);
    p := pp;
  end
  else
  begin
    Dec(PLongint(p)^);
    GetMem(p, neededSize);
    minLength := oldLength;
    if minLength > newLength then
      minLength := newLength;
    if typeInfo <> nil then
    begin
      FillChar((PChar(p) + Sizeof(Longint)*2)^, minLength*elSize, 0);
      CopyArray(PChar(p) + Sizeof(Longint)*2, a, typeInfo, minLength)
    end
    else
      Move(PChar(a)^, (PChar(p) + Sizeof(Longint)*2)^, minLength*elSize);
  end;

  // The heap object will now have a ref count of 1 and the new length
  PLongint(p)^ := 1;
  Inc(PLongint(p));
  PLongint(p)^ := newLength;
  Inc(PLongint(p));

  // Set the new memory to all zero bits
  FillChar((PChar(p) + elSize * oldLength)^, elSize * (newLength - oldLength), 0);

  // Take care of the inner dimensions, if any
  if dimCnt > 1 then
  begin
    Inc(lengthVec);
    Dec(dimCnt);
    for i := 0 to newLength-1 do
      DynArraySetLength(PPointerArray(p)[i], typeInfo, dimCnt, lengthVec);
  end;
  a := p;
end;

Проверка:

Код


    a2: array of integer;
    const c1 = 20000;
         c2 = 50000;
begin

     SetLength(a2, c1);
     for i := 0 to Length(a2)-1 do
       a2[i] := i + 1;

     SetLength(a2, c2);

     for i := 0 to c1-1 do
       if a2[i] <> i+1 then
          raise Exception.Create('Алярм');
end;

А-а-а, TURBO PASCAL smile

Извините не заметил, но думаю код то все равно можно взять из DynArraySetLength

Это сообщение отредактировал(а) cemick - 25.5.2011, 17:45

Snowy

Дата 25.5.2011, 18:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: нет
Всего: 484

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

iff

Дата 25.5.2011, 20:01 (ссылка)

(нет голосов)

Загрузка ...

Администратор

Профиль
Группа: Участник
Сообщений: 949
Регистрация: 23.3.2007

Репутация: нет
Всего: 16

Snowy, спасибо.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »