Function BlbckSize(Size: pointer): Longint;

    {Функция  преобразует ненормализованную  длину свободного блока в байты}

    type

    PtrRec = record

    Lo, Hi : word

    end; 

    var

    LengthBlock: Longint; 

    begin

    BlockSize := Longint(PtrRec(Size).Hi)*16 + PtrRec(Size).Lo 

    end;

    Сразу после загрузки программы указатели HEAPPTR и FREELIST содержат один и тот же адрес, который совпадает с началом  кучи (этот адрес содержится в указателе HEAPORG). При этом в первых 8 байтах кучи хранится запись, соответствующая типу TFREEREC (поле NEXT содержит адрес, совпадающий со значением HEAPEND, a поле SIZE - ноль, что служит дополнительным признаком отсутствия «ячеек» в динамической памяти). При работе с кучей указатели HEAPPTR и FREELIST будут иметь одинаковые значения до тех пор, пока в куче не образуется хотя бы один свободный блок ниже границы, содержащейся в указателе HEAPPTR. Как только это произойдет, указатель FREELIST станет ссылаться на начало этого блока, а в первых 8 байтах освобожденного участка памяти будет размещена запись TFREEREC. Используя FREELIST как начало списка, программа пользователя всегда сможет просмотреть весь список свободных блоков и при необходимости модифицировать его.

    Описанный механизм вскрывает один не очень  существенный недостаток, связанный с работой администратора кучи, а именно: в любой освободившийся блок администратор должен поместить описатель этого блока, а это означает, что длина блока не может быть меньше 8 байтов. Администратор кучи всегда выделяет память блоками, размер которых кратен размеру записи TFREEREC, т.е. кратен 8 байтам. Даже если программа запросит 1 байт, администратор выделит ей фактически 8 байт. Те же 8 байт будут выделены при запросе 2, 3 ,..., 8 байт; при запросе 9 байт будет выделен блок в 16 байт и т.д.

    Если  при очередном обращении к  функции NEW или GETMEM администратор не может найти в куче нужный свободный  блок, он обращается к функции, адрес  которой содержит переменная HEAPERROR. Эта функция соответствует следующему процедурному типу:

    type

    HeapErrorFun = function (Size:word): Integer;

    Здесь SIZE - размер той переменной, для которой  нет свободной динамической памяти. Стандартная функция, адрес которой  при запуске программы содержит переменная HEAPERROR, возвращает 0, что  приводит к останову программы по ошибке периода счета с кодом 203. Можно переопределить эту функцию и таким образом блокировать останов программы. Для этого необходимо написать собственную функцию и поместить ее адрес в указатель HEAPERROR. Например:

    Function HeapFunc(Size: Word): Integer; far; 

    begin

    HeapFunc := 1 end; 

    begin {Основная программа}

    HeapError := @HeapFunc;

    .......

    end.

    Функция типа HEAPERRORFUN вызывается только в том случае, когда обращение с требованием выделения динамической памяти было неуспешным. Она может возвращать одно из трех значений:

    0 - прекратить работу программы;

    1 - присвоить соответствующему указателю  значение NIL и продолжить работу  программы;

    2 - повторить выделение памяти; разумеется, в этом случае внутри функции  типа HEAPERRORFUN необходимо освободить память нужного размера.

3. Контроль за динамической памятью.

 

    Как правило, объекты в Turbo Vision размещаются  в куче. Это отвечает специфике  диалоговых программ: на этапе разработки программист обычно не может учесть все возможные действия пользователя программы. Чтобы не накладывать неестественные ограничения на те или иные ее возможности, не следует злоупотреблять статическими определениями объектов, так как в этом случае программа не сможет гибко учитывать специфические требования пользователя.

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

    В Turbo Vision имеются средства, упрощающие этот контроль: глобальная функция LowMemory будет возвращать True, если размер свободного участка кучи стал слишком мал (по умолчанию меньше 4 Кбайт). Таким образом, вместо того, чтобы контролировать кучу перед каждым обращением к New, можно обратиться к функции LowMemory перед началом размещения динамического объекта или сразу после того, как объект размещен в куче. Если LowMemory возвращает True, дальнейшая работа с кучей возможна только после ее очистки. Резервный участок кучи длиной в 4 Кбайт называется пулом надежности. Предполагается, что его размеры достаточны для размещения любого объекта Turbo Vision, поэтому обычно контроль с помощью LowMemory осуществляется сразу после процедуры динамического размещения нового видимого элемента.

    В следующем примере создается  простое диалоговое окно:

    Uses Memory,...;{Функция LowMemory определена  в модуле Memory}

    .....

    R.Assign(20,3,60,10);

    D := New(Dialog, Init(R, 'Диалоговое окно')); 

    with D do 

    begin

    R.Assign(2,2,32,3);

    Insert(New(PStaticText, Init(R, 'Сообщение-вопрос'))); 

    R.Assign(5,5,14,7);

    Insert(New(PButton, Init(R, '~Y~es (Да)', cmYes))); 

    RAssign(16,5,25,7);

    Insert(New(PButton, Init(R, ' ~N~o (Нет)', cmNO))) 

    end;

    if LowMemory then 

    begin

    Dispose(D,Done); {Нет памяти: удаляем распределение} 

    OutOfMemory; {Сообщаем об этом} 

    DoIt := False {Признак ошибки} 

    end 

    else

    Dolt := DeskTop.ExecView(D)=cmYes;

    Если  используется вызов LowMemory сразу после динамического размещения объекта, то в ходе самого размещения не должен произойти аварийный останов, связанный с нехваткой памяти. Таким образом, размер пула надежности должен быть достаточным для размещения всего объекта. Переменная LowMemSize задает размер пула надежности в параграфах (участках, длиной по 16 байт). По умолчанию она имеет значение 4096 div 16 = 256, т.е. размер пула надежности составляет 4 Кбайт.

    На  практике вместо прямого обращения  к LowMemory чаще используется вызов метода TProgram.ValidView (P: Pointer): Pointer. Этот метод получает в качестве параметра обращения указатель Р на динамический объект и осуществляет следующие действия:

• если Р = NIL, метод возвращает NIL;
• если LowMemory = True, метод освобождает память, связанную с Р, вызывает метод TProgram.OutOfMemory и возвращает NIL;
• если обращение к методу TView. Valid (cm Valid) дает False (см. ниже), объект Р удаляется из кучи и метод ValidView возвращает NIL;
• в противном случае считается, что размещение осуществлено успешно, и метод возвращает значение указателя Р.

    Метод TProgram.ValidView осуществляет стандартные  действия по контролю надежности использования  кучи. Обычно его используют перед  тем, как поместить новый видимый  элемент в группу, например:

    DeskTop.Insert(ValidView(New(TMyWindow, Init(...))));

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

    В ряде случаев может оказаться  полезной глобальная функция Function MemAlloc (Size: Word): Pointer, которая осуществляет те же действия, что и New или GetMem, но в  отличие от них не распределяет пул надежности. Функция возвращает указатель на выделенную область кучи или NIL, если в куче нет свободного блока нужного размера. Аналогичные действия осуществляет функция MemAllocSeg, отличающаяся от MemAlloc только тем, что выделяет память, выровненную на границу параграфа (на границу сегмента).

 

     4. Пример программы с указателем и динамической памятью.

 
    

    

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

    Прямоугольники  на этой схеме – динамические переменные типа запись, Data – поле (или поля), содержащие полезную информацию (например фамилии и номера телефонов), поле, которое изображено ниже Data – это указатель на следующую запись. Переменная List также является указателем на запись. Жирная точка в поле «следующий элемент» в самой последней записи означает, что там лежит значение nil, чтобы показать, что эта запись – последняя в списке.

    Для описания списка на Паскале достаточно описать тип указателя на запись и тип самой записи. Выглядит всё это так:

    type tItemPtr = ^tItem; {указатель на элемент}

         tItem = record

            Data: tData;    {полезные данные}

            Next: tItemPtr; {указатель на следующий элемент списка}

         end;

    В первой строке этого объявления бросается  в глаза использование неопределённого  типа tItem. Такое исключение из правил в Турбо Паскале сделано умышленно, в противном случае не было бы возможности  строить списки и другие связанные структуры из динамических переменных.

    Объявить  сам список можно как указатель  на элемент: var List : tItemPtr; пока наш список пуст, в List следует положить значение nil. При создании первого элемента будем выполнять действия New(List); List^.Next:=nil.

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

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

    unit Lists;

    interface

    type  tData = record

             Name: string[50];

             Phone: longint;

          end;

          tItemPtr = ^tItem;

          tItem = record

            Data: tData;

            Next: tItemPtr;

          end;

    procedure InitList(var l: tItemPtr);

    procedure AddItemToHead(var l: tItemPtr; d: tData);

    function  DeleteItemAfter(var l: tItemPtr; num: word): boolean;

    function  Count(l: tItemPtr): word;

    function  GetItem(l: tItemPtr; num: word; var d: tData): boolean;

    procedure ClearList(var l: tItemPtr);

    {---------------------------------------------------------------}

    implementation

    procedure InitList(var l: tItemPtr);

    begin l:=nil end;

    procedure AddItemToHead(var l: tItemPtr; d: tData);

    var p: tItemPtr;

    begin

      new(p);

      p^.data:=d;

      p^.next:=l;

      l:=p;

    end; 

    function DeleteItemAfter(var l: tItemPtr; num: word): boolean;

    var p,q: tItemPtr;

        i: word;