From: Василий Сергеевич Рабец <rabets@icph20.sherna.msk.su>
Subj: Простейший способ вызова процедуры по ее адресу в Turbo Pascal'е.
Date: 11.03.93
                      (C) V.S.Rabets, 1993.
        Простейший способ вызова процедуры по ее адресу
                       в Turbo Pascal'е.
В Turbo Pascal'е нередко встречается такая ситуация:
    указатель P содержит адрес некоторой процедуры без параметров;
    нужно вызвать эту процедуру.
Обычно в таком случае используется оператор asm (начиная с TP 6.0):
           asm
               call dword ptr P
           end
или inline:
           inline ($FF/$1E/>P);   {call dword ptr [>P]}
К сожалению, вызвать процедуру, приведя тип pointer к типу procedure
           procedure (P)
не удастся - компилятор воспримет такую конструкцию как ошибку.
Однако можно (и это самый простой путь) объявить, например, тип
           type ExecPtr = procedure;
и вызвать процедуру
           ExecPtr (P);
что короче и проще, чем asm и inline, и не требует знакомства с
ассемблером.
*** КОНЕЦ основного текста. Дальше идут примеры и комментарии ***
    (* Вообще не совсем понятно, почему для хранения адреса
       процедуры обычно используется переменная типа pointer, а не
       procedure. Единственный недостаток procedure - некоторые
       сложности с созданием типизированных констант (2 строки
       вместо одной):
           const NilPtr: pointer = nil;
           var P: procedure absolute NilPtr;
       Преимущество procedure - компилятор следит за соответствием
       типов (например, в нашем примере - чтобы переменной P при-
       сваивалось значение только процедуры типа far без парамет-
       ров); для переменной типа pointer никакого контроля нет.
    *)
===================================================================
Ниже приведены примеры программ с использованием всех вышеупомяну-
тых способов вызова процедуры по ее адресу. Каждый пример содержит
  создание типизированной константы с нулевым значением;
  присвоение ей некоторого значения, в т.ч. нулевого;
  проверку, не является ли значение переменной нулевым;
  вызов процедуры по адресу, сохраненному в переменной.
Exe - файлы во всех случаях получаются совершенно одинаковыми;
исходный текст проще в примере с использованием типа ExecPtr.
--------------------------------------------------
program _Asm; { Пример вызова процедуры по адресу, сохраненному в
                переменной типа pointer, оператором asm. }
uses CRT;
const P: pointer = nil;
procedure Proc1; far;    begin writeln(#7)   end;
procedure Proc2; far;    begin writeln(#7#7) end;
begin
  writeln ('1 or 2 ?');
  case ReadKey of
       '1': P:=@Proc1;
       '2': P:=@Proc2;
       else P:=nil
  end; {of case}
  if P<>nil then
     asm
         call dword ptr P
     end;
end.
--------------------------------------------------
program _Inline; { Пример вызова процедуры по адресу, сохраненному в
                   переменной типа pointer, оператором inline. }
uses CRT;
const P: pointer = nil;
{$F+}
procedure Proc1;    begin writeln(#7)   end;
procedure Proc2;    begin writeln(#7#7) end;
{$F-}
begin
  writeln ('1 or 2 ?');
  case ReadKey of
       '1': P:=@Proc1;
       '2': P:=@Proc2;
       else P:=nil
  end; {of case}
  if P<>nil then inline ($FF/$1E/>P);   {call dword ptr [>P]}
end.
--------------------------------------------------
program _ExecPtr; { Пример вызова процедуры по адресу, сохраненному в
                    переменной типа pointer, приведением к типу ExecPtr. }
uses CRT;
type ExecPtr = procedure;
const P: pointer = nil;
{$F+}
procedure Proc1;    begin writeln(#7)   end;
procedure Proc2;    begin writeln(#7#7) end;
{$F-}
begin
  writeln ('1 or 2 ?');
  case ReadKey of
       '1': P:=@Proc1;
       '2': P:=@Proc2;
       else P:=nil
  end; {of case}
  if P<>nil then ExecPtr (P);
end.
--------------------------------------------------
program _Procedure; { Пример вызова процедуры по адресу, сохраненному в
                      переменной типа procedure. }
uses CRT;
const NilPtr: pointer = nil;
var P: procedure absolute NilPtr;
{$F+}
procedure Proc1;    begin writeln(#7)   end;
procedure Proc2;    begin writeln(#7#7) end;
{$F-}
begin
  writeln ('1 or 2 ?');
  case ReadKey of
       '1': P:=Proc1;
       '2': P:=Proc2;
       else @P:=nil
  end; {of case}
  if @P<>nil then P;
end.
---------------------------------------------------------------
        11-03-93                     В.С. Рабец
                           e-mail:   rabets@icph20.sherna.msk.su
                            Адрес:   142 432
                                     Московская обл.
                                     Ногинский р-н
                                     п. Черноголовка
                                     Школьный б-р, 18, кв. 241
                                     Рабцу В.С.  
 |