                             ГЛАВА 17.

                    ВНУТРЕННИЙ ФОРМАТ ОБЪЕКТОВ.

     Внутренний формат  объекта  похож  на  запись.  Поля   объекта
запоминаются     в     порядке    объявления,    как    непрерывная
последовательность переменных.  Любые поля,  унаследованные от типа
предка  запоминаются  до  новых  полей,  определенных в порожденном
типе.
     Если объектный тип определяет виртуальные методы, констракторы
или дестракторы,    компилятор  распределяет  дополнительное поле в
объектном типе.  Это 16-ти битовое поле,  называемое полем  таблицы
виртуального метода  (VMT)  и используется для запоминания смещения
VMT этого объектного типа в  сегменте  данных.   Поле  VMT  следует
непосредственно после   обычных  полей  в  объектном  типе.   Когда
объектный тип   наследует  виртуальные  методы,   констракторы  или
дестракторы, он  так же наследует поле VMT, при этом дополнительное
поле не распределяется.
     Инициализация поля VMT экземпляра  производится  констрактором
объектного  типа.  Программа  никогда  явно  не инициализирует и не
обращается к полю VMT.
     Следующие примеры  иллюстрируют  внутренний  формат  объектных
типов.

     type
       LocationPtr = ^Location;
       Location = object
         X, Y: Integer;
         procedure Init(PX, PY: Integer);
         function GetX: Integer;
         function GetY: Integer;
       end;

       PointPtr = ^Point;
       Point    = object(Location)
         Color: Integer;
         constructor Init(PX, PY, PColor: Integer);
         destructor Done; virtual;
         procedure Show; virtual;
         procedure Hide; virtual;
         procedure MoveTo(PX, PY: Integer);
       end;

       CirclePtr = ^Circle;
       Circle = object(Point)
         Radius: Integer;
         constructor Init(PX, PY: Integer;
                          PColor, PRadius: Integer);
         procedure Show; virtual;
         procedure Hide; virtual;
         procedure Fill; virtual;
       end;

     Рис. 17.1   показывает  слои  экземпляров  Location,  Point  и
Circle; каждый прямоугольник соответствует одному слову памяти.

       Рис. 17.1 Слои экземпляров Location, Point и Circle.


           Location           Point            Circle
         +——————————+     +———————————+     +———————————+
         | X        |     | X         |     | X         |
         +——————————+     +———————————+     +———————————+
         | Y        |     | Y         |     | Y         |
         +——————————+     +———————————+     +———————————+
                          | Color     |     | Color     |
                          +———————————+     +———————————+
                          | VMT       |     | VMT       |
                          +———————————+     +———————————+
                                            | Radius    |
                                            +———————————+


     Поскольку Point является  первым  типом  в  иерархии,  который
вводит  виртуальные  методы,  поле  VMT  распределяется  после поля
Color.

                     Таблицы виртуальных методов.

     Каждый объектный  тип,    который   содержит   или   наследует
виртуальные методы,     констракторы    или   дестракторы,    имеет
соответствующую ему VMT,   которая  хранится  в  инициализированной
части сегмента  данных  программы.   Существует только одна VMT для
объектного типа (а не для экземпляра),  но два различных  объектных
типа никогда  не  разделяют  VMT,   как бы похожи они не были.  VMT
строится компилятором   автоматически   и    никогда    прямо    не
обрабатывается программой.    Кроме   того,    указатели   на   VMT
автоматически запоминаются    в    экземпляре    объектного    типа
констрактором этого  объектного  типа  и  никогда не обрабатываются
программой.
     Первое слово VMT содержит размер экземпляров,  ассоциированных
с объектным типом; эта  информация  используется  констракторами  и
дестракторами для  определения  сколько байт нужно распределить или
освободить, используя расширенный синтаксис New и Dispose.
     Второе слово  VMT  содержит  отрицательный размер экземпляров,
связанных с объектным типом; эта информация используется механизмом
верификации вызовов       виртуальных   методов   для   определения
неинициализированных объектов (экземпляров,  для  которых  не  было
вызова констрактора) и для проверки целостности VMT. Когда механизм
верификации виртуальных  вызовов   включен   (используя   директиву
компилятора   {$R+},   которая  расширена  для  включения  проверки
виртуальных  методов),  компилятор   генерирует   вызов   программы
верификации   VMT   перед  каждым  виртуальным  вызовом.  Программа
верификации VMT проверяет,  что первое слово VMT не равно 0  и  что
сумма  первого  и  второго  слов = 0.  Если какая-то из проверок не
проходит, генерируется ошибка времени выполнения 210.

     Примечание: Включение  проверки  на  диапазон  и   верификации
вызовов  виртуальных  методов  замедляет Вашу программу и делает ее
значительно больше,  поэтому используйте состояние {$R+} только  во
время  отладки  и  переходите  в  состояние {$R-} для окончательной
версии программы.

     И наконец,   начиная со смещения 4 в VMT находится список 32-х
битных указателей на метод,   по  одному  на  виртуальный  метод  в
объектном типе,   в порядке объявления.  Каждое поле содержит адрес
точки входа соответствующего виртуального метода.
     Рис.17.2 показывает слои VMT для типов  Point  и  Circle  (Тип
Location  не  имеет  VMT  так  как не содержит виртуальных методов,
констракторов  и  дестракторов);  каждый  маленький   прямоугольник
соответствует одному слову памяти, а каждый большой - двум.

               Рис.17.2 Слои VMT для Point и Circle.

              Point VMT                 Circle VMT
          +———————————————+         +————————————————+
          | $0008         |         | $000A          |
          +———————————————+         +————————————————+
          | $FFF8         |         | $FFF6          |
          +———————————————+         +————————————————+
          | @Point.Done   |         | @Point.Done    |
          +———————————————+         +————————————————+
          | @Point.Show   |         | @Circle.Show   |
          +———————————————+         +————————————————+
          | @Point.Hide   |         | @Circle.Hide   |
          +———————————————+         +————————————————+
          | @Point.MoveTo |         | @Point.MoveTo  |
          +———————————————+         +————————————————+
                                    | @Circle.Fill   |
                                    +————————————————+


     Заметьте, как Circle наследует методы MoveTo и Down из Point и
как он перекрывает методы Show и Hide.
     Как упомянуто  ранее,  констрактор  объектного  типа  содержит
специальный код,  который сохраняет смещение VMT объектного типа  в
инициализируемом экземпляре.  Например:  пусть дан экземпляр Р типа
Point  и  экземпляр  C  типа  Circle,  тогда  вызов  P.Init   будет
автоматически   сохранять   смещение  VMT  для  Point  в  поле  VMT
экземпляра P и вызов C.Init будет сохранять смещение VMT для Circle
в поле VMT экземпляра C.  Эта автоматическая инициализация является
частью входного кода констрактора так,  что  в  тот  момент,  когда
управление  достигает  оператора begin констрактора,  поле Self VMT
уже установлено.  Поэтому, если возникла необходимость, констрактор
может сделать вызов виртуального метода.


                    Стандартная функция SizeOf.

     Когда стандартная  функция  SizeOf  применяется  к  экземпляру
объектного типа,  имеющего VMT, она возвращает размер, хранящийся в
этой VMT.  Поэтому, для объектных типов, имеющих VMT, SizeOf всегда
возвращает не объявленный, а действительный размер экземпляра.


                    Стандартная функция TypeOf.

     Turbo Pascal  добавляет  новую  стандартную  функцию   TypeOf,
которая  возвращает указатель на VMT объектного типа.  TypeOf имеет
единственный параметр,  который  может  быть  либо  идентификатором
объектного типа,  либо экземпляром объектного типа. В обоих случаях
результат типа  Pointer является указателем на VMT объектного типа.
TypeOf может быть применен только к объектным типам,  имеющим VMT -
для всех других типов это будет ошибкой.
     Функция TypeOf    может   быть   использована   для   проверки
действительного типа экземпляра. Например:

     if TypeOf(Self) = ТypeOf(Point) then ...


                    Вызовы виртуальных методов.

     Чтобы вызвать  виртуальный  метод,  компилятор генерирует код,
который указывает на адрес VMT из  поля  VMT  в  объекте,  и  затем
вызывает  через  поле,  связанное  с  этим методом.  Например:  для
переменной PP типа PointPtr  вызов  PP^.Show  генерирует  следующий
код:

     les    di,PP              ; Загрузить PP в ES:DI
     push   es                 ; передать как Self параметр
     push   di
     mov    di,es:[di + 6]     ; отметить смещение VMT из поля VMT
     call   DWORD PTR [di+8]   ; вызвать точку входа в VMT для Show


     Правило совместимости   для   объектных   типов  позволяет  PP
указывать на Point или Circle, или на любой другой тип, порожденный
от Point.  И если Вы проверите VMT,  показанную здесь,  Вы увидите,
что для Point точка в VMT со смещением 8 указывает на Point.Show, в
то  время,  как  для  Circle  она  указывает на Circle.Show.  Таким
образом, в зависимости от актуального (времени выполнения) типа PP,
инструкция CALL вызывает Point.Show или Circle.Show, или метод Show
любого другого типа, порожденного от Point.
     Если Show  -  статический метод,  то для вызова PP^.Show будет
генерироваться код:

     les      di,PP               ; Загрузить PP в ES:DI
     push     es                  ; передать как Self параметр
     push     di
     call     Point.Show          ; прямой вызов Point.Show

     Здесь вне зависимости от того,  на что указывает PP, код будет
всегда будет вызывать метод Point.Show.


                   Соглашение о вызовах методов.

     Методы используют такие же соглашения о вызовах,  как  обычные
процедуры и  функции,  за исключением того,  что каждый метод имеет
дополнительный неявный   параметр,    называемый   Self,    который
соответствует var  -  параметру  того  же  типа,  как объектный тип
метода. Параметр Self всегда передается как  последний  параметр  и
всегда имеет  форму  32-х  битового  указателя на экземпляр,  через
который метод  вызывается.   Например,   для  переменной  PP   типа
PointPtr, определенный ранее, вызов PP^.MoveTo(10, 20) кодируется:

     Mov     ax,10             ; загрузить 10 в AX
     Push    ax                ; передать РX как параметр
     Mov     ax,20             ; загрузить 20 в AX
     Push    ax                ; передать РY как параметр
     les     di, pp            ; Загрузить PP в ES:DI
     push    es                ; передать как Self параметр
     push    di
     mov     di,es:[di+6]      ; отметить смещение VMT из поля VMT
     call    DWORD PTR [di+16] ; вызвать точку входа в VMT для
                               ; MoveTo

     До возврата  метод  должен  удалить параметр Self из стека так
же, как он должен удалить любые обычные параметры.
     Метод всегда  использует  дальнюю модель вызова (FAR CALL) вне
зависимости от установления директивы компилятора $F.


                    Констракторы и дестракторы.

     Констракторы и  дестракторы  используют  те  же  соглашения  о
вызовах, что  и  обычные  методы,   за   исключением   того,    что
дополнительный параметр,     размером    в    слово,     называемый
VMT-параметром, передается в стек перед параметром Self.
     Для констракторов   параметр   VMT   содержит   смещение  VMT,
принадлежащее Self, для того, чтобы инициализировать этот Self.
     Когда констрактор  вызывается  для  распределения динамических
объектов, используя  расширенный  синтаксис  New,   указатель   nil
передается в    параметре   Self.    Это   заставляет   констрактор
распределять новый динамический объект,  адрес которого  передается
назад в  DX:AX  при  возврате из констрактора.  Если констрактор не
может распределить объект,  указатель nil возвращается в DX:AX (см.
"Восстановление ошибок констрактора" в следующем разделе).
     Наконец, когда     констрактор     вызывается,       используя
уточненный идентификатор   метода  (т.е.  идентификатор  объектного
типа), с последующей точкой и идентификатором метода, значение ноль
передается в параметре VMT.  Это указывает констрактору,  что он не
должен инициализировать поле VMT для Self.
     Для дестрактора  ноль  в  параметре VMT указывает о нормальном
вызове, и ненулевое значение указывает,  что дестрактор был вызван,
используя расширенный синтаксис Dispose.  Это заставляет дестрактор
освобождать Self сразу перед возвратом  (размер  Self  определяется
просмотром первого слова VMT для этого Self).


                   Расширения для New и Dispose.

     Стандартные процедуры   New   и    Dispose    расширены    для
использования  вызова  констрактора  или  дестрактора  как  второго
параметра,  для   распределения   или   освобождения   динамических
переменных объектного типа. Синтаксис:

     New(P, Construct);

     и

     Dispose(P, Destruct);

     где P - переменная указатель,  указывающий на объектный тип, а
Construct и Destruct вызывают констракторы и дестракторы  для этого
объектного типа.   Для   New   действие   расширенного   синтаксиса
равносильно выполнению

     New(P);
     P^.Construct;

     и для Dispose

     P^.Destruct;
     Dispose(P);

     Без расширенного синтаксиса появление таких пар вызова  New  с
последующим вызовом констрактора и вызова дестрактора с последующим
вызовом  Dispose  будут  слишком  частыми.  Расширенный   синтаксис
улучшает  читабельность,  а  так  же  генерирует  более  короткий и
эффективный код.  Следующее иллюстрирует использование расширенного
синтаксиса New и Dispose.

     var
        SP: StrFieldPtr;
        ZP: ZipFieldPtr;
     begin
        New(SP, Init(1, 1, 25, 'FirstName'));
        New(ZP, Init(1, 2, 5, 'Zip Code', 0, 99999));
        SP^.Edit;
        ZP^.Edit;
        ...
        Dispose(ZP, Down);
        Dispose(SP, Down);
     end;

     Дополнительное расширение  позволяет  использовать   New   как
функцию,  которая  распределят и возвращает динамическую переменную
указанного типа. Синтаксис :

     New(T);

     или

     New(T, Construct);

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

     Пример :

     var
        F1, F2: FieldPtr;
     begin
        F1 := New(StrFieldPtr, Init(1, 1, 25, 'FirstName'));
        F2 := New(ZipFieldPtr, Init(1, 2, 5, 'Zip Code', 0, 99999));
        ...
        Writeln(F1^.GetStr);  {вызов StrField.GetStr}
        Writeln(F2^.GetStr);  {вызов ZipField.GetStr}
        ...
        Dispose(F2, Down);    {вызов Field.Down}
        Dispose(F1, Down);    {вызов StrField.Down}
     end;

     Заметим, что даже,  хотя F1 и F2  типа  FieldPtr,  расширенные
правила  совместимости по присваиванию указателей позволяют F1 и F2
присваивать  указатели  на  любой  порожденный  тип  от  Field;   и
поскольку  GetStr  и Down являются виртуальными методами,  механизм
диспетчеризации  виртуальных  методов  будет   корректно   вызывать
StrField.GetStr, ZipField.GetStr,    Field.Down   и   StrField.Down
соответственно.


                       Методы на ассемблере.

     Методы, реализованные  на языке ассемблера могут быть включены
в программу на Turbo Pascal,  используя директиву компилятора $L  и
ключевое  слово  External.  Объявление  внешнего метода в объектном
типе не отличается от обычного метода;  однако,  реализация  метода
состоит  только из заголовка метода с последующим зарезервированным
словом External.
     В исходном   тексте   на  ассемблере,  @  используется  вместо
точки при написании уточненного идентификатора  (т.к.  точка  имеет
другое   значение   в   ассемблере   и   не   может   быть   частью
идентификатора).  Например, идентификатор Паскаля Rect.Init пишется
в  ассемблере  как Rect@Init.  Синтаксис с @ может быть использован
для объявления и PUBLIC и EXTRN идентификаторов.
     В качестве  примера  метода на ассемблере мы реализуем простой
объект Rect.

     Type
        Rect = Object
          X1, X2, Y1, Y2: Integer;
          procedure Init(XA, YA, XB, YB: Integer);
          procedure Union(var R: Rect);
          function Contains(X, Y: Integer): Boolean;
        end;

     Rect представляет   прямоугольник,    ограниченный    четырьмя
координатами X1,   Y1,  X2,  Y2.  Верхний левый угол прямоугольника
определяется X1,  Y1  и  нижний  правый  -  X2,   Y2.   Метод  Init
присваивает значение   координатам   прямоугольника;   метод  Union
вычисляет наименьший  прямоугольник,   который  содержит   и   этот
прямоугольник, и  другой  прямоугольник;  метод Contains возвращает
True, если данная точка лежит внутри прямоугольника, и False - если
нет. Другие   методы,   такие  как  перемещение,   масштабирование,
вычисление пересечений и тестирование на равенство могут быть легко
реализованы, чтобы сделать Rect более полезным объектом.
     Реализация методов для  Rect  на  Паскале  только  перечисляет
заголовки этих методов с ключевым словом External.

     {$L Rect}
     procedure Rect.Init(XA, YA, XB, YB : Integer); External;
     procedure Rect.Union(var R : Rect); External;
     function Rect.Contains(X, Y : Integer) : Boolean; External;

     Разумеется, нет никаких  требований,  чтобы  все  методы  были
реализованы как внешние.  Любой метод может быть реализован либо на
Паскале, либо на Ассемблере, по необходимости.
     Исходный текст   программы  на  ассемблере  Rect.Asm,  который
реализует эти три внешних метода:

     TITLE   Rect
     LOCALS  @@

     ; Rect Structure

     Rect     STRUC
     X1       DW        ?
     Y1       DW        ?
     X2       DW        ?
     Y2       DW        ?
     Rect     ENDS

     code     SEGMENT   BYTE PUBLIC

              ASSUME    cs:code

     ; procedure Rect.Init(XA, YA, XB, YB: Integer)

              PUBLIC    Rect@Init

     Rect@Init          PROC       FAR

     @XA                EQU        (WORD PTR[bp+16])
     @YA                EQU        (WORD PTR[bp+14])
     @XB                EQU        (WORD PTR[bp+12])
     @YB                EQU        (WORD PTR[bp+10])
     @Self              EQU        (DWORD PTR[bp+6])

              Push      bp         ; сохранить bp
              Mov       bp,sp      ; установить размер стека
              les       di,@Self   ; загрузить Self в ES:DI
              cld                  ; сдвинуть вперед
              mov       ax,@XA     ; X1 := XA
              stosw
              mov       ax,@YA     ; Y1 := YA
              stosw
              mov       ax,@XB     ; X2 := XB
              stosw
              mov       ax,@YB     ; Y2 := YB
              stosw
              pop       bp         ; восстановить bp
              ret       12         ; выгрузить параметры и возврат

     Rect@Init          ENDP

     ; procedure Rect.Union(var R: Rect)

              PUBLIC    Rect@Union

     Rect@Union         PROC       FAR

     @R                 EQU        (DWORD PTR [bp+10])
     @Sef               EQU        (DWORD PTR [bp+6])

              push      bp         ; сохранить bp
              mov       bp,sp      ; установить размер стека
              push      ds         ; сохранить ds
              lds       si,@R      ; загрузить R в DS:SI
              les       di,@Self   ; загрузить Self в DS:SI
              cld                  ; передвинуть вперед
              lodsw                ; if R.X1 >= X1 goto @@1
              scasw
              jge       @@1
              dec       di         ; X1 := R.X1
              dec       di
              stosw
     @@1:     lodsw                ; if R.Y1 >= Y1 goto @@2
              scasw
              jge       @@2
              dec       di         ; Y1 := R.Y1
              dec       di
              stosw
     @@2:     lodsw                ; if R.X2 <= X2 goto @@3
              scasw
              jle       @@3
              dec       di         ; X2 := R.X2
              dec       di
              stosw
     @@3:     lodsw                ; if R.Y2 <= Y2 goto @@4
              scasw
              jle       @@4
              dec       di         ; Y2 := R.Y2
              dec       di
              stosw
     @@4      pop       ds         ; восстановить ds
              pop       bp         ; восстановить bp
              ret       8          ; выгрузить параметры и возврат

     Rect@Union         ENDP

     ; function Rect.Contains(X, Y: Integer): Boolean

              PUBLIC    Rect@Contains

     Rect@Contains      PROC        FAR

     @X                 EQU         (WORD PTR[BP+12])
     @Y                 EQU         (WORD PTR[BP+10])
     @Self              EQU         (DWORD PTR[BP+6])

               push     bp          ; сохранить bp
               mov      bp,sp       ; установить размер стека
               les      di,@Self    ; загрузить Self в ES:DI
               mov      al,0        ; возвращает false
               mov      dx,@X       ; if (X<X1) or (X>X2) goto @@1
               cmp      dx,es:[di].X1
               jl       @@1
               cmp      dx,es:[di].X2
               jg       @@1
               mov      dx,@Y       ; if (Y<Y1) or (Y>Y2) goto @@2
               cmp      dx,es:[di].Y1
               jl       @@1
               cmp      dx,es:[di].Y2
               jg       @@1
               inc      ax          ; возвращает true
     @@1:      pop      bp          ; восстановить bp
               ret      8           ; выгрузить параметры и возврат

     Rect@Contains      ENDP

     code      ENDS

               END



                Восстановление ошибок констрактора.

     Как описано  в  главе   16,   Turbo   Pascal   позволяет   Вам
устанавливать   функции  обработки  ошибок  кучи  через  переменную
HeapError,   объявленную   в   модуле   System.   Эта   возможность
поддерживается так  же  в Turbo Pascal,  но дополнительно позволяет
воздействовать на работу констракторов объектных типов.
     По умолчанию,   когда  нет достаточно памяти для распределения
динамического экземпляра   объектного  типа,   вызов  констрактора,
использующий расширенный     синтаксис   New,    генерирует  ошибку
времени выполнения 203.  Если Вы устанавливаете  функцию  обработки
ошибок  кучи,  которая  возвращает  1  (в  отличие  от стандартного
результата  функции  -  0),  вызов  констрактора  через  New  будет
возвращать  nil (вместо аварийного завершения программы) если он не
может полностью обработать запрос на выделение памяти.
     Код, который производит распределение и инициализацию поля VMT
динамического экземпляра является частью входной последовательности
констрактора: когда    управление    достигает    оператора   begin
констрактора, экземпляр уже распределен  и  инициализирован.   Если
распределение неуспешно  и функция обработки ошибок кучи возвратила
1, констрактор пропускает выполнение операторной части и возвращает
указатель nil;  указатель,   заданный  в процедуре New,  вызывающей
констрактор, установится в nil.

     Примечание: Введена новая стандартная процедура Fail.

     Когда управление  достигает  оператора   begin   констрактора,
гарантируется, что  экземпляр  объектного  типа  был  распределен и
инициализирован успешно.  Однако констрактор сам может распределять
динамические переменные  для  того,   чтобы  инициализировать  поля
указателей в  экземпляре  и  эти  распределения  могут  завершиться
неуспешно. Если  это случится,  правильно разработанный констрактор
должен сделать  "откат"  всех  успешных  распределений  и  в  конце
освободить экземпляр   объектного  типа  так,   чтобы  возвращаемый
результат получил  указатель  nil.   Чтобы  сделать   такой   откат
возможным, Turbo  Pascal  реализует  новую  стандартную  процедуру,
называемую Fail,  которая не имеет параметров и которая может  быть
вызвана  только из констрактора.  Вызов Fail заставляет констрактор
освобождать динамический экземпляр,  который  был  распределен  при
входе  в  констрактор  и  при  этом  возвращать  указатель  nil для
индикации ошибки.
     Когда динамический  экземпляр  распределен  через  расширенный
синтаксис New,  значение nil  в  заданном  указателе  говорит,  что
операция закончилась с ошибкой. К сожалению нет такого указателя, с
помощью  которого  можно  было  бы  проверить   операцию   создания
статического  экземпляра,  или  вызов унаследованного констрактора.
Вместо этого Turbo  Pascal  позволяет  использовать  констрактор  в
выражении как булевскую функцию:  возврат True говорит об успехе, а
возврат False говорит  об  ошибке  (благодаря  вызову  Fail  внутри
констрактора).
     Следующая программа  реализует  два  простых  объектных  типа,
содержащих   указатели.   Первая   версия  программы  не  реализует
восстановление ошибок констрактора.

     type
        LinePtr = ^Line;
        Line = String[79];
        BasePtr = ^Base;
        Base = Object
          L1, L2: LinePtr;
          Constructor Init(S1, S2: Line);
          Destructor Done; virtual;
          procedure Dump; virtual;
        end;

        DerivedPtr = ^Derived;
        Derived = object(Base)
          L3, L4: LinePtr;
          Constructor Init(S1, S2, S3, S4: Line);
          Destructor Done; virtual;
          procedure Dump; virtual;
        end;

     var
        BP: BasePtr;
        DP: DerivedPtr;

     Constructor Base.Init(S1, S2: Line);
     begin
        New(L1);
        New(L2);
        L1^ := S1;
        L2^ := S2;
     end;

     Destructor Base.Done;
     begin
        Dispose(L2);
        Dispose(L1);
     end;

     procedure Base.Dump;
     begin
        Writeln('B: ', L1^, ',', L2^, '.');
     end;

     Constructor Derived.Init(S1, S2, S3, S4: Line);
     begin
        Base.Init(S1, S2);
        New(L3);
        New(L4);
        L3^ := S3;
        L4^ := S4;
     end;

     Destructor Derived.Done;
     begin
       Dispose(L4);
       Dispose(L3);
       Base.Done;
     end;

     procedure Derived.Dump;
     begin
        Writeln('D: ', L1^, ',', L2^, ',', L3^, ',', L4^, '.');
     end;

     begin
        New(BP, Init('Turbo', 'Pascal'));
        New(DP, Init('North', 'East', 'South', 'West'));
        BP^.Dump;
        DP^.Dump;
        Dispose(DP, Done);
        Dispose(BP, Done);
     end.


         Следующий пример  демонстрирует  как предыдущий может быть
переписан с использование восстановления ошибок. Объявления типов и
переменных не повторяются, т.к. они остаются такими же.


     Constructor Base.Init(S1, S2: Line);
     begin
        New(L1);
        New(L2);
        if (L1 = nil) or (L2 = nil) then
        begin
           Base.Done;
           Fail;
        end;
        L1^ := S1;
        L2^ := S2;
     end;

     Destructor Base.Done;
     begin
        if L2 <> nil then Dispose(L2);
        if L1 <> nil then Dispose(L1);
     end;

     Constructor Derived.Init(S1, S2, S3, S4: Line);
     begin
        if not Base.Init(S1, S2) then Fail;
        New(L3);
        New(L4);
        if (L3 = nil) or (L4 = nil) then
        begin
           Derived.Done;
           Fail;
        end;
        L3^ := S3;
        L4^ := S4;
     end;

     Destructor Derived.Done;
     begin
       if L4 <> nil then Dispose(L4);
       if L3 <> nil then Dispose(L3);
       Base.Done;
     end;

     {$F+}
     function HeapFunc(Size: Word): Integer;
     begin
        HeapFunc := 1;
     end;
     {$F-}

     begin
        HeapError := @HeapFunc;  {установка управления ошибками
                                  кучи}
        New(BP, Init('Turbo', 'Pascal'));
        New(DP, Init('North', 'East', 'South', 'West'));
        if (BP = nil) or (DP = nil) then
          Writeln('Oшибка распределения')
        else
        begin
          BP^.Dump;
          DP^.Dump;
        end;
        if DP <> nil then Dispose(DP, Done);
        if BP <> nil then Dispose(BP, Done);
     end.

     Заметьте как  соответствующие  дестракторы   в   Base.Init   и
Derived.Init используются    для   отката   после   всех   успешных
распределений перед вызовом Fail.  Заметьте так же,  как вызывается
Base.Init  в Derived.Init для того,  чтобы проверить успешный вызов
унаследованного констрактора.
