                     (C) V.S. Rabets 1993

                         TURBO PASCAL:
    ОБРАЩЕНИЕ СО СТРОКОВЫМИ КОНСТАНТАМИ КАК С ПЕРЕМЕННЫМИ.

                                       Программист и стар и мал
                                       Дружно скажет про Pascal:
                                          - В мире нет еще пока
                                            Совершенней языка!

  +--------------------------------------------------------+
  | В этом тексте Вы найдете:                              |
  |   как определить адрес строковой константы;            |
  |   как получить ассемблерный текст фрагмента программы  |
  |                                     на Turbo Pascal'е; |
  |   функцию StrAddr, [размещающую строку в хипе и]       |
  |                              возвращающую адрес строки |
  +--------------------------------------------------------+

    Рассмотрим пример, подталкивающий к мысли о полезности из-
лагаемого ниже материала:
          Предположим, у Вас есть некоторая система создания
      меню. Ряд ее процедур принимают в качестве параметра
      строку (имя пункта меню, строку подсказки и т.п.) и раз-
      мещают ее в хипе, после чего обращение к этой строке про-
      исходит по ее адресу. В результате в процессе работы
      программы в памяти находится по 2 копии каждой из этих
      строк: одна - в виде константы или переменной, которая
      была в исходном тексте, другая - в хипе. Непонятно, зачем
      нужно такое дублирование: на нем теряются килобайты памяти.
Как можно в подобных случаях избежать дублирования текстовых
строк в памяти?
    Можно, например, в процедурах, принимающих строку, объявить
параметр-строку как var и вместо констант использовать типизи-
рованные константы, что позволяет не заносить строку в хип:
  Было:   procedure NewItem (Name: string; ...               {1}
            begin NameAddress:=NewStr(Name);
                  {NewStr - функция, размещающая строку в хипе
                   и возвращающая указатель на нее}
          .....
          begin
            .....
            NewItem ('Files', ...
          ---------------------------------------------
  Стало:   const NameFiles: string[5]='Files';
           procedure NewItem (var Name: string; ...          {2}
            begin NameAddress:=@Name;
          .....
          begin
            .....
            NewItem (NameFiles, ...

Однако согласитесь, что писать
            NewItem ('Files', ...
гораздо удобнее, чем
           const NameFiles: string[5]='Files';
           NewItem (NameFiles, ...

Идеальным случаем было бы создать такую процедуру, которая бы
работала как процедура типа {2}, но к которой можно было бы об-
ращаться как к процедуре типа {1}, т.е. чтобы она могла прини-
мать строковую константу и определять ее адрес.
    Сделать такую процедуру можно.
Известно, что параметры-строки всегда передаются по ссылке,
т.е. обращение к процедурам
     procedure NewItem (Name: string)
  и  procedure NewItem (var Name: string)
будет совершенно одинаковым - в стек всегда помещается адрес
строки-параметра.
(Ассемблерный текст вызова этих процедур:
       mov     di,52h    ; занесение в di смещения строки
       push    ds        ; засылка в стек адреса параметра
       push    di        ; ----"----"----"----"----"----
       push    cs        ; засылка в стек сегмента возврата
                         ;             (если процедура - far)
       call    ...         вызов процедуры
- как его получить, смотри приложение А).
Т.о., мы можем записать, например,

   procedure RealGetAddr (var S: string); far;
     begin
       Address:=@S;
     end;
   const RealGetAddrPtr: pointer = @RealGetAddr;
   var GetAddr: procedure (S: string) absolute RealGetAddrPtr;

Здесь обращения как к RealGetAddr, так и к GetAddr будут вызы-
вать процедуру RealGetAddr, в которой мы можем определить адрес
передаваемой строки. В то же время при обращении к GetAddr мы
не получим сообщения об ошибке при любом типе передаваемой
строки - будь то переменная, константа или результат выражения.
    Т.о., при обращении к GetAddr со строковой константой или
переменной мы можем внутри RealGetAddr определить адрес строки
и в дальнейшем ссылаться на нее. А вот при обращении с резуль-
татом выражения или функции не можем, потому что результат вы-
ражения хранится во временной области памяти в стеке и в про-
цессе работы программы затрется. Поэтому предлагается
использовать такую функцию (назовем ее StrAddr):

                       ФУНКЦИЯ StrAddr,
               КОТОРАЯ ВОЗВРАЩАЕТ АДРЕС СТРОКИ,
                       ПРИ НЕОБХОДИМОСТИ
      (В ЗАВИСИМОСТИ ОТ ТИПА ПЕРЕДАВАЕМОГО ЕЙ ПАРАМЕТРА)
                      РАЗМЕЩАЯ ЕЕ В ХИПЕ.
Если к этой функции обратиться с константой (которая расположе-
на в сегменте кода) или с переменной или типизированной конс-
тантой (размещены в сегменте данных), то функция возвращает ад-
рес этой строки. При обращении к функции с выражением она раз-
мещает результат выражения в хипе и возвращает адрес строки
в хипе.
    Функция определяет сегментный адрес передаваемого ей пара-
метра: если он меньше SSeg - то параметр находится в сегментах
кода или данных (константа или переменная), иначе - в сегменте
стека (результат выражения) или в хипе. Для строки-параметра,
уже находящейся в хипе, в хипе размещается новая копия этой
строки (для определенности работы процедуры удаления строк из
хипа).
    Ниже приведены тексты функции StrAddr, а также процедуры
DisposeStr, освобождающей хип от строк, размещенных там функци-
ей StrAddr:

{-------------------------------------------------}
{ При распространении программного продукта в исходных кодах
  в случае использования процедур, функционально повторяющих
  StrAddr или DisposeStr, ССЫЛКА НА ДАННЫЙ МАТЕРИАЛ ОБЯЗАТЕЛЬНА }

function RealStrAddr (var S: string): pointer; far;
 { (C) V.S.Rabets 1993 }
var P: ^string;
begin
  if Seg(S)<SSeg then RealStrAddr:=@S else
  if S='' then RealStrAddr:=nil else
  begin
    GetMem (P, succ(word(length(S))));
    P^:=S;
    RealStrAddr:=P;
  end;
end;

procedure DisposeStr (P: pointer);
 { (C) V.S.Rabets 1993 }
begin
  if Seg(P^)>=Seg(HeapOrg^) then
  if P <> nil then FreeMem (P, succ(word(byte(P^))));
end;

const RealStrAddrPtr: pointer = @RealStrAddr;
var StrAddr: function (S: string): pointer absolute RealStrAddrPtr;
{-------------------------------------------------}

                 ПОТЕНЦИАЛЬНО ОПАСНЫЕ МОМЕНТЫ
    ОБРАЩЕНИЯ СО СТРОКОВЫМИ КОНСТАНТАМИ КАК С ПЕРЕМЕННЫМИ

1. Компилятор в целях оптимизации всегда создает только одну
копию одинаковых констант. В результате при выполнении программы

    procedure RealProc(var S: string); far;
    begin
      S:='ХА-ХА-ХА!';
    end;

    const P: pointer = @RealProc;
    var Proc: procedure (S: string) absolute P;

    begin
      Proc('123456789');
      writeln ('123456789');
    end.

после выполнения writeln вместо ожидаемого 123456789 Вы увидите
на экране ХА-ХА-ХА!

2. Нет контроля длины строки.
Если в вышеприведенной программе главную часть заменить на
    begin
      Proc ('12');
      writeln ('3456789');
    end.
то на экране получится ХА-ХА! и еще небольшая строка мусора,
потому что при выполнении Proc ('12') в кодовом сегменте была
затерта не только строка '12', но и следующая - '3456789'.
Впрочем, аналогичный результат получится и в программе
    {$V-}
    const  S1: string[2] = '12';
           S2: string[7] = '3456789';

    procedure Proc(var S: string);
    begin
      S:='ХА-ХА-ХА!';
    end;

    begin
      Proc (S1);
      writeln (S2);
    end.

3. Нужно быть осторожным в оверлеях.
4. Один и тот же физический адрес может быть представлен разны-
ми комбинациями сегмента и смещения. Для правильной работы
StrAddr и DisposeStr сочетание сегмент:смещение строки лучше не
менять.

                         ПРЕИМУЩЕСТВА
     ОБРАЩЕНИЯ СО СТРОКОВЫМИ КОНСТАНТАМИ КАК С ПЕРЕМЕННЫМИ

Из области экзотики:
    Помимо экономии хипа, данный метод экономит также прост-
ранство в сегменте данных (который, в отличие от сегментов ко-
да, может быть только один). Т.к. сегментов кода может быть
сколько угодно, то констант (нетипизированных) можно разместить
в программе неограниченное количество, при необходимости рас-
пределив их по разным модулям.

===============================================================
    Функции, аналогичные StrAddr и DisposeStr, использовались в
моей не объектно-ориентированной системе создания меню RvMenu,
которая, путем задания условий компиляции, позволяет компилиро-
вать из одного исходного текста программу для работы в тексто-
вом и/или графическом режимах, включать или нет в exe-файл опре-
деленные графические драйверы и русские экранные шрифты; просто
поддерживает двуязычие, создание macro и Demo; достаточно быст-
ро работает в графическом режиме даже на машинах типа Искра-1030;
уникальным образом поддерживает русские Alt-клавиши: например,
пункт меню "Файлы" вызывается нажатием Alt-Ф в состоянии "ки-
риллица" клавиатуры, НЕЗАВИСИМО от раскладки клавиатуры и спо-
соба поддержки русской клавиатуры - самим RvMenu, резидентным
драйвером или аппаратно. Координаты для справок в конце текста.
===============================================================

Приложение А.
ВЫДЕЛЕНИЕ ЧАСТИ ОБ`ЕКТНОГО КОДА ИЗ ПРОГРАММЫ НА Turbo Pascal'e.

    Если нужно выделить код какой-либо процедуры, то начальный
адрес выделяемого фрагмента задается адресом этой процедуры,
конечный - адресом следующей за ней процедуры. Для выделения
произвольного участка кода используются ассемблерные вставки.
    В приведенном здесь примере Cut в скобках (* *) закомменти-
ровано вырезание процедуры Reboot. Для получения файла с выре-
занным фрагментом нужно перенаправить вывод программы в файл:
  CUT > FileName
после чего фрагмент можно дизассемблировать, используя, напри-
мер, какой-либо из дизассемблеров, опубликованных в СофтПанораме
(например, СП 3a-C (декабрь 1991, вып.C), \DisAsm\id.com).

program Cut;

type CodeType = array [1..32*1024] of char;
var Code: ^CodeType;              { Указатель на вырезаемый фрагмент }
    Segment,                      { Сегмент вырезаемого фрагмента }
    StartOfs, FinishOfs: word;    { Смещения начала и (конец+1) фрагмента }
    FragmentLength,             { Длина вырезаемого фрагмента }
    Count: word;                { Индекс цикла }
var St: string;
{-------------------------------------------------------------}

procedure Reboot;                 { Вырезаемая процедура }
type ExecPtr = procedure;
const PostAddress: pointer = ptr($F000,$FFF0);
begin
     ExecPtr (PostAddress);
end;

procedure EndOfFragment;          { Процедура, задающая адрес конца }
begin end;                                   { вырезаемой процедуры }
{-------------------------------------------------------------}

procedure Proc    (S: string); far;
begin end;

procedure ProcVar (var S: string); far;
begin end;
{-------------------------------------------------------------}

begin
(*
  { Вырезание кода процедуры: }
  Segment:=Cseg;
  StartOfs:=ofs(Reboot);
  FinishOfs:=ofs(EndOfFragment);
  FragmentLength:=FinishOfs-StartOfs;
  Code:=ptr (Segment,StartOfs);
  for Count:=1 to FragmentLength do write (Code^[Count]);
*)

  { Вырезание произвольного фрагмента: }
  asm
       mov Segment, CS                   { Сегмент фрагмента }
       mov StartOfs, offset @StartLabel  { Смещение начала фрагмента }
       @StartLabel:                      { Начало фрагмента }
  end;

  Proc    (St);   { Вырезаемый }
  ProcVar (St);   {  фрагмент  }

  asm
       @FinishLabel:                       { Конец фрагмента }
       mov FinishOfs, offset @FinishLabel  { Смещение конца фрагмента + 1 }
  end;
  Code:=ptr (Segment,StartOfs);  { Адрес начала фрагмента }
  for Count:=1 to FinishOfs-StartOfs do write (Code^[Count]);
  { Для получения файла с фрагментом выполните CUT > FileName }
end.
===============================================================

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

        11-04-93                     В.С. Рабец

                            Адрес:   142 432
                                     Московская обл.
                                     Ногинский р-н
                                     п. Черноголовка
                                     Школьный б-р, 18, кв. 241
                                     Рабцу В.С.

