                        3. Интерфейс РЕФАЛа и Си

                                Введение

     Здесь описаны средства,  позволяющие вызывать из программ, написан-
ных на Си, программы, написанные на РЕФАЛе и наоборот.
     Интерфейс между РЕФАЛом и Си основан на понятии процесса. Процессом
называется совокупность поля зрения и копилки.
     В каждый  момент  времени  работает  либо  Си-программа,  либо  РЕ-
ФАЛ-программа.  Когда управление принадлежит Си-программе,  все процессы
приостановлены.  Когда работает РЕФАЛ-программа,  работает ровно один из
процессов.
     Си-программа может создавать и уничтожать процессы,  запускать их и
исследовать причины их остановки. При обращении из Си к РЕФАЛу вызывает-
ся не РЕФАЛ-функция, а процесс, т.е. поле зрения, в котором уже находят-
ся обращения к РЕФАЛ-функциям. Таким образом, содержимое поля зрения оп-
ределяет, какие именно функции будут вызваны.
     Си-программа обязана сформировать начальное поле зрения перед обра-
щением к РЕФАЛу, а затем, когда РЕФАЛ вернет ей управление, извлечь нуж-
ную информацию из поля зрения.
     Если же РЕФАЛ-программа обращается к Си-программе,  то Си-программа
должна  сама извлечь нужную информацию из ведущего функционального терма
и перед возвратом управления РЕФАЛ-программе сформировать результат  за-
мены.

                         3.1. Обработка ошибок

     Во многих случаях РЕФАЛ-система обнаруживает фатальные ошибки,  ко-
торые делают бессмысленным продолжение ее работы. В этих случаях печата-
ется  диагностическое  сообщение и работа программы на этом завершается.
Для выполнения вышеописанных действий используется  следующая программа.

     Подпрограмма  rfabe.
НАЗНАЧЕНИЕ:
     Печатает сообщение и завершает работу программы.
ОБРАЩЕНИЕ:  rfabe (text);
ПАРАМЕТРЫ:  text - текст сообщения.
ИСПОЛЬЗОВАНИЕ:
     Начиная с первой позиции печатается текст "*** refal-abend  ***", а
вслед за ним - текст сообщения.
ИСХОДНЫЙ ТЕКСТ:
     rfabe (char *text) {
        printf ("\n *** refal-abend *** %s",text); exit(0);
     }

              3.2. Представление выражений в памяти машины

     Во время работы РЕФАЛ-программы поле зрения, копилка и ящики предс-
тавлены в виде списков.  Минимальной нерасчленимой единицей данных явля-
ется звено.  Размер памяти, занимаемой звеном, зависит от типа компьюте-
ра.
     Звено состоит из следующих полей:
     ----------------------------
     |  prev  |  next  |  code  |
     ----------------------------
     Поля prev  и  next  используются  для связывания звеньев в линейную
последовательность.  Поле next всегда содержит адрес следующего звена, а
поле  prev  - адрес предыдущего звена.  Поля prev и next занимают по два
слова.
     Поле code состоит из двух подполей: tag и info.
     ----------------------------
     |  tag  |      info        |
     ----------------------------
     Значения этих  полей  зависят от того,  какому объекту РЕФАЛа соот-
ветствует данное звено.
     Если звено принадлежит полю зрения,  копилке или содержимому ящика,
оно может изображать один из  следующих  объектов:  символ,  структурную
скобку или функциональную скобку.
     Поле tag содержит признак типа звена.  Если его пять старших разря-
дов нулевые,  звено называется стандартным, если же хотя бы один из пяти
старших разрядов поля tag отличен от нуля,  звено именуется  нестандарт-
ным.
     Если звено стандартное,  то поле tag имеет следующие  значения  для
объектов различных типов:
     0 - символ-литера (объектный знак),
     2 - символ-метка (имя функции),
     4 - символ-число (макроцифра),
     6 - символ-ссылка,
     1 - левая структурная скобка "(",
     3 - правая структурная скобка ")",
     5 - левая функциональная скобка "<" или "k",
     7 - правая функциональная скобка ">" или ".".
     Нуль в младшем разряде поля tag означает,  что звено содержит  сим-
вол, а единица - что звено содержит скобку.
     С помощью первичных функций, написанных на Си или языке ассемблера,
можно  создавать  нестандартные звенья,  у которых старшие пять разрядов
поля tag имеют ненулевое значение.  Если при этом младший бит  поля  tag
равен нулю,  РЕФАЛ-система рассматривает такие звенья как некоторые сос-
тавные символы,  отличные от  символов-меток,  символов-чисел  и  симво-
лов-ссылок.  Поле info таких звеньев может содержать произвольную комби-
нацию из тридцати двух битов. при выводе выражений на печать эти символы
изображаются в виде
     /tt%hhhhhhhh/
где tt - значение поля tag,  а hhhhhhhh - значение поля info, выраженные
в шестнадцатеричной системе счисления.
     Таким образом, помимо четырех стандартных типов символов, существу-
ет еще множество "нестандартных" типа  символов.  Нестандартные  символы
невозможно  изобразить  в виде констант в РЕФАЛ-программах.  Кроме того,
они являются специфической особенностью только некоторых реализаций, по-
этому их не стоит использовать при создании мобильных РЕФАЛ-программ.
     Значение поля info зависит от типа звена:
   - для  структурной скобки поле info содержит адрес парной к ней скоб-
     ки;
   - для символа-литеры поле info в младшем байте содержит код соответс-
     твующей литеры в коде ASCII,  а старшие байты должны быть равны ну-
     лю;
   - для символа-метки поле info содержит адрес точки входа в  соответс-
     твующую функцию, написанную на РЕФАЛе или Си;
   - для символа-числа поле info содержит целое  неотрицательное  число,
     соответствующее телу этого символа-числа;
   - для символа-ссылки поле info содержит адрес головы соответствующего
     ящика;
   - для символа нестандартного типа поле info содержит  произвольную (с
     точки  зрения  РЕФАЛ-системы) информацию.  О функциональных скобках
     будет сказано ниже.

              3.3. Доступ к полям звена из программы на Си

     Для того,  чтобы извлекать или изменять содержимое звеньев в  прог-
раммах,  написанных на Си, следует воспользоваться указателями и базиро-
ванными структурами.
     Структура звена описывается следующим образом:
     struct linkcb_  {
        struct linkcb_ *prev;
        struct linkcb_ *next;
        unsigned int tag;
        union  {
           char infoc;
           long coden;
           struct linkcb_ *codep;
           char *codef;
        } info;
     };
     typedef struct linkcb_ linkcb;
     Эти описания следует либо непосредственно вставить в текст програм-
мы на Си, либо включить их в программу с помощью предложения
     #include "refal.def"
     Все последующие определения структур и макро-переменных также нахо-
дятся в файле "refal.def".
     Для повышения  наглядности программ рекомендуется использовать сим-
волические имена для признаков типов,  например, вместо 5 - писать TAGK.
Имена признаков описываются следующим образом:
     #define TAGO  0
     #define TAGF  2
     #define TAGN  4
     #define TAGR  6
     #define TAGLB 1
     #define TAGRB 3
     #define TAGK  5
     #define TAGD  7
     Пример 1.
     Опишем подпрограмму,  которая  просматривает  некоторое выражение и
заменяет в нем все вхождения символа-литеры '+' на символ-литеру '-'.
     Обращение к подпрограмме должно иметь вид:
     chpm (p, q);
где p - указатель на звено,предшествующее выражению,  а q - указатель на
звено,следующее за выражением.
     Подпрограмма может быть описана следующим образом:
     #include "refal.def"
     chpm (p, q)  linkcb *p, *q;  {
      linkcb *r;
        r = p ->next;
        while (r != q) {
           if( r->tag == TAGO && r->info.infoc == '+')
              r->info.infoc = '-';
           r = r->next;
        }
     }
     Пример 2.
     Опишем подпрограмму bmatch, обращение к которой имеет вид:
     bmatch (p, q);
     Эта подпрограмма просматривает выражение,  заключенное между звень-
ями, на которые указывают p и q, и все символы-литеры '(' и ')' заменяет
на  структурные скобки ( и ).  Предполагается,  что в исходном выражении
символы-литеры '(' и ')' образуют правильную скобочную структуру.
     #include "refal.def"
     bmatch (p, q)  linkcb *p, *q;  {
      linkcb *r, *r1, *lastb;
        lastb = NULL;
        r = p->next;
        while (r != q) {
           if (r->tag == TAGO && r->info.infoc == '(') {
              r->info.codep = lastb;
              lastb = r;
           }
           else if (r->tag == TAGO && r->info.infoc == ')') {
               r->info.codep = lastb;
               r->tag = TAGRB;
               r1 = lastb->info.codep;
               lastb->info.codep = r;
               lastb->tag = TAGLB;
               lastb = r1;
           }
           r = r->next;
        }
     }
     Для работы с фрагментами поля  зрения  в  библиотеке  РЕФАЛ-системы
имеются первичные функции rftpl и lldupl.

     Подпрограмма rftpl.
НАЗНАЧЕНИЕ:
     Переставляет указанную часть списка (трансплантат) в другое место.
ОБРАЩЕНИЕ:  rftpl (r, p, q);
ПАРАМЕТРЫ:
     r - указатель на звено, после которого вставляется трансплантат;
     p - указатель на звено, предшествующее трансплантату;
     q - указатель на звено, следующее за трансплантатом.
ИСПОЛЬЗОВАНИЕ:
     Участок списка,  заключенный между p и q,  исключается  из  списка,
звенья  p и q сшиваются.  Далее вынутый участок списка вставляется после
звена r.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     rftpl(r,p,q)  linkcb *p, *r, *q;  {
      linkcb *r1, *q1, *p1;
        p1 = p->next;
        if ( p1 == q ) return;
        r1 = r->next;
        q1 = q->prev;
        p->next = q;
        q->prev = p;
        q1->next = r1;
        r1->prev = q1;
        r->next = p1;
        p1->prev = r;
     }

     Функция lldupl.
НАЗНАЧЕНИЕ:
     Позволяет отделить  от  указанного  выражения с левого конца часть,
совпадающую с другим указанным выражением.
ОБЪЯВЛЕНИЕ:  linkcb *lldupl();
ОБРАЩЕНИЕ:   lldupl(p,q,u);
ПАРАМЕТРЫ:
     p - указатель на звено, предшествующее выражению-оригиналу;
     q - указатель на звено, следующее за выражением-оригиналом;
     u - указатель на звено,  предшествующее выражению, от которого дол-
         жен быть отделен дубликат. Возвращаемое значение - указатель на
         звено, следующее за выражением-дубликатом.
ИСПОЛЬЗОВАНИЕ:
     Пусть между p и q заключено выражение ex (именуемое  оригиналом), а
после u начинается некоторое выражение Ey. Если Ey начинается с Ex, т.е.
его можно представить в виде ExEz, то lldupl вырабатывает ненулевое зна-
чение указателя на звено,  следущее за Ex, т.е. на звено, с которого на-
чинается Ez.  Если же Ey невозможно представить в виде ExEz,  то  lldupl
вырабатывает значение NULL,  а и остается без изменения.
ИСХОДНЫЙ ТЕКСТ:
     #include  "refal.def"
     linkcb *lldupl(p,q,u) linkcb *p,*q,*u; {
      linkcb *x,*y;
        x = p->next;
        y = u->next;
        while ( x != q)  {
           if (x->tag !=  y->tag)  return(NULL);
           if (x->info.codef != y->info.codef)
             if ((x->tag != TAGLB) && (x->tag != TAGRB)) return(NULL);
           x = x->next;
           y = y->next;
        }
        return (y);
     }

      3.4. Представление функциональных скобок в списковой памяти

     Функциональные скобки занимают по одному звену каждая.  имя функции
хранится в виде символа-метки,  сразу же вслед за знаком "<", и занимает
отдельное звено.
     Звено, соответствующее знаку "<", содержит в поле tag признак TAGK.
Звено, соответствующее знаку ">",содержит в поле tag признак TAGD.
     Знак ">"  в поле info содержит адрес первого к нему знака "<". Знак
"<" в поле info содержит адрес ">", который станет ведущим, после полно-
го  вычисления данного функционального терма.  Если же такого ">" не су-
ществует, знак "<" в поле info содержит нуль.
     Таким образом,  знаки  "<" и ">" связаны в список в том порядке,  в
котором они будут становиться ведущими.

              3.5. Представление ящиков в списковой памяти

     Каждому ящику (как статическому, так и динамическому) соответствует
звено,  именуемое головой ящика.  Это звено, как и всякое другое, обяза-
тельно выравнено по границе слова.
     Если ящик динамический,  то его именем является символ-ссылка. Сим-
вол-ссылка в поле tag всегда содержит признак TAGR,  а в поле info - ад-
рес головы соответствующего ящика.
     Если ящик статический, то его именем является символ-метка, который
в поле tag содержит признак TAGF, а в поле info - адрес байта, предшест-
вующего голове соответствующего ящика.
     Байт, предшествующий голове статического ящика,  обязательно содер-
жит константу 0x8E,  что дает возможность проверить,  является  ли  сим-
вол-метка именем статического ящика.
     Если к статическому ящику не было ни одного обращения,  его  голова
содержит нуль.  При первой же попытке что-либо прочитать из статического
ящика или записать в него,  голова инициализируется:  в поля prev и next
заносится адрес самой головы,  что равносильно записи в ящик пустого вы-
ражения. Только после этого выполняется операция над ящиком.
     Содержимым ящика является некоторое выражение. Начало и конец этого
выражения присоединены к голове ящика,  т.е.  поле next головы ящика со-
держит адрес первого звена,  а поле prev - адрес последнего звена содер-
жимого ящика.  В то же время, первое звено содержимого ящика в поле prev
и  последнее  звено  содержимого ящика в поле next содержит адрес головы
ящика.  Таким образом, голова ящика вместе с его содержимым представляют
собой двухсвязный циклический список.
     Если содержимое ящика пустое,  то голова ящика в полях prev и  next
содержит свой собственный адрес.
     В поле tag головы ящика содержится 0x00.  Это поле используется  во
время сборки мусора (см.п.15), чтобы помечать ящики, которые нельзя выб-
расывать.
     Для сборки  мусора  необходимо иметь возможность просмотреть головы
всех ящиков.  Поэтому поля info в головах ящиков используются для  того,
чтобы связать все головы в односвязный список в порядке, обратном поряд-
ке их порождения. Каждая голова в поле info содержит адрес следующей го-
ловы.  Если  голова  -  последняя в списке,  то в поле info она содержит
нуль.
     Головы статических  и  головы динамических ящиков связаны в два от-
дельных односвязных списка. Ссылки на эти списки содержатся в общем бло-
ке REFAL (см.п.8). Динамические ящики заносятся в список в момент созда-
ния, статические - в момент инициализации их головы.

                         3.6. Печать выражений

     Подпрограмма rfpexm.
НАЗНАЧЕНИЕ:
     Печатает выражение в метакоде-Б.
ОБРАЩЕНИЕ:  rfpexm (text, p, q);
ПАРАМЕТРЫ:
     text - текст, который печатается слева от выражения;
     p - указатель на звено, предшествующее печатаемому выражению;
     q - указатель на звено, следущее за печатаемым выражением.
ИСПОЛЬЗОВАНИЕ:
     Пусть L  - длина текста text.  Тогда в первых L позициях печатается
текст text,  а вслед за ним участок списка,  заключенный между p и q,  в
метакоде-Б.  Если выражение не поместилось на одной строке,  оно перено-
сится на следующие строки.

     Подпрограмма rfpex.
НАЗНАЧЕНИЕ:
     Печатает выражение.
ОБРАЩЕНИЕ:  rfpex (text, p, q);
ПАРАМЕТРЫ:
     Те же, что и для подпрограммы rfpexm.
ИСПОЛЬЗОВАНИЕ:
     Аналогично подпрограмме rfpexm.  Разница состоит только в форме,  в
которой печатаются выражения.  В отличие от rfpexm,  rfpex не  обрамляет
цепочки символов-литер апострофами, а составные символы обрамляет апост-
рофами вместо знаков "/".

                             3.7. Процессы

     Данная реализация РЕФАЛа позволяет создавать  программы,  различные
части  которых написаны на РЕФАЛе и Си,  и которые тесно взаимодействуют
друг с другом.
     Программа на Си может вызывать программы на РЕФАЛе, которые, в свою
очередь, могут вызывать программы на Си и т.д.
     В каждый момент времени могут существовать несколько полей зрения и
копилок.  При этом каждому полю зрения соответствует одна копилка и нао-
борот.
     Совокупность из поля зрения и связанной с ним копилки  в дальнейшем
именуется процессом.
     Программы на Си могут создавать и уничтожать процессы, запускать их
и исследовать причины их остановки.  Программы,написанные на РЕФАЛе,  не
могут управлять процессами непосредственно,  но могут делать это вызывая
программы на Си.
     Существует возможность запускать процесс на заданное  число  шагов.
Запуская  процесс каждый раз только на один шаг вперед,  программа на Си
может полностью контролировать его работу.
     Для управления   РЕФАЛ-процессами  предоставляется  набор  процедур
(подпрограмм и функций),  вызываемых из программ на  Си.  Эти  процедуры
хранят  глобальную информацию в общем блоке REFAL.  Для каждого процесса
имеется таблица состояния процесса, в которой содержится вся необходимая
информация о процессе.

                         3.8. Общий блок REFAL

     Программы на Си,  взаимодействующие с РЕФАЛ-программами, используют
общий блок REFAL, который должен быть описан следующим образом.
     struct refal_  {
        st *crprev;
        st *crnext;
        int upshot;
        linkcb *preva;
        linkcb *nexta;
        linkcb *prevr;
        linkcb *nextr;
        st *currst;
        linkcb *flhead;
        linkcb *svar;
        linkcb *dvar;
        int stmnmb;
        int nostm;
        int tmmode;
        int tmintv;
     };
     typedef struct refal_ REFAL;
     Это описание может быть включено в программу на Си непосредственно,
либо с помощью макро-предложения
     #include "refal.def"
     Первоначальное заполнение общего блока REFAL происходит  при вызове
подпрограммы rfinit, либо в момент создания первого процесса, либо в мо-
мент первого выделения пространства под списковую память.
     Отдельные слова общего блока REFAL имеют следующее содержимое.
   . crprev - адрес последней таблицы состояния.
   . crnext - адрес первой таблицы состояния.
   . upshot - результат вызова из РЕФАЛа программы,  написанной  на  Си.
     Может принимать целые значения 1, 2 и 3:
     1 - вычисление окончено;
     2 - отождествление невозможно;
     3 - свободная память исчерпана.
   . preva - адрес звена, предшествующего аргументу функции, т.е. звена,
     содержащего имя функции.
   . nexta - адрес звена, следующего за аргументом, т.е. звена, содержа-
     щего знак ">".
   . prevr - адрес звена, предшествующего результату замены. Этим звеном
     является звено, предшествующее знаку "<" перед началом шага.
   . nextr - адрес звена,  следующего за результатом замены. Этим звеном
     является звено, содержащее знак "<".
   . currst  - адрес текущей таблицы состояния,  т.е.  таблицы состояния
     того РЕФАЛ-процесса,  который вызвал  работающую  в  данный  момент
     программу на Си.  Если же программа на Си вызвана не из рефал-прог-
     раммы, то currst = NULL.
   . flhead - адрес звена, являющегося головой списка свободных звеньев.
   . svar - ссылка на первый  элемент  односвязного  списка  статических
     ящиков.  Ящики заносятся в этот список в момент первого обращения и
     расположены в порядке,  обратном к тому, в котором происходили пер-
     вые обращения.  Если не было ни одного обращения к статическим ящи-
     кам, svar = NULL.
   . dvar  -  ссылка  на первый элемент односвязного списка динамических
     ящиков.  Ящики заносятся в этот список в момент создания и располо-
     жены в порядке,  обратном к тому,  в котором они создавались.  Если
     нет ни одного динамического ящика, dvar = NULL.
   . stmnmb - номер РЕФАЛ-предложения, которое было применено при выпол-
     нении шага РЕФАЛ-машины.  Предложения в каждой функции нумеруются с
     1.
   . nostm - общее количество предложений в той  РЕФАЛ-функции,  которая
     была вызвана при выполнении шага РЕФАЛ-машины.
   . tmmode - признак того, что следует измерить время центрального про-
     цессора, израсходованное между запуском и остановкой интерпретатора
     языка сборки. Может принимать целые значения 0 и 1.
     0 - время измерять не нужно;
     1 - время измерять нужно.
   . tmintv  - время центрального процессора,  израсходованное между за-
     пуском и остановкой интерпретатора языка сборки,  выраженное в мик-
     росекундах.  Устанавливается только если tmmode=1.
     Назначение и использование различных полей общего блока REFAL более
подробно объясняется в следующих разделах.

             3.9. Инициализация и терминация  РЕФАЛ-системы

    В начале  работы РЕФАЛ-системы ее необходимо инициализировать,  т.е.
привести в рабочее состояние,  а в конце работы  -  терминировать,  т.е.
привести  в  нерабочее состояние и подготовить к последующей инициализа-
ции.  Для выполнения этих действий предназначены подпрограммы  rfintf  и
rfterm.

     Подпрограмма rfinit.
НАЗНАЧЕНИЕ:
     Инициализирует РЕФАЛ-систему.
ОБРАЩЕНИЕ:  rfinit ();
ИСПОЛЬЗОВАНИЕ:
    Заносятся начальные значения в общий блок REFAL и  создается  пустой
список свободной памяти.
ИСХОДНЫЙ ТЕКСТ:
     #include  "refal.def"
        linkcb  hd;
        int rf_init = 1;
        REFAL refal;
     rfinit () {
      REFAL *p;
      linkcb  *phd;
        rf_init  =  0;
        p  = &refal;
        p->crprev = &refal;
        p->crnext = &refal;
        p->upshot = 1;
        p->currst = NULL;
        p->svar   = NULL;
        p->dvar   = NULL;
        p->flhead = &hd;
        phd       = &hd;
        phd->prev = phd;
        phd->next = phd;
        phd->tag  = 0;
        phd->info.coden = 0;
        p->nostm  = 0;
        p->stmnmb = 0;
        p->tmmode = 0;
        p->tmintv = 0;
     }

     Подпрограмма rfterm.
НАЗНАЧЕНИЕ:
     Терминирует РЕФАЛ-систему.
ОБРАЩЕНИЕ:  rfterm ();
ИСПОЛЬЗОВАНИЕ:
    РЕФАЛ-система подготавливается к последующей инициализации.
ИСХОДНЫЙ ТЕКСТ:
     rfterm() {
        rf_init = 1;
     }

     3.10. Пространство списковой памяти и список свободных звеньев

     Под список  выделяются один или несколько связных участков памяти с
помощью подпрограммы rflist.
     При этом все неиспользованные звенья связаны с помощью полей prev и
next в двусвязный циклический список (список свободной памяти).  В общем
блоке  REFAL  в  поле  flhead  содержится ссылка на звено - голову этого
списка.
     При отведении под список нового участка памяти, новые звенья связы-
ваются в список и вставляются в конец списка свободной памяти.

     Подпрограмма rflist.
НАЗНАЧЕНИЕ:
     Отдает под список новый связный участок памяти.
ОБРАЩЕНИЕ:  rflist(array, n);
ПАРАМЕТРЫ:
    array - массив слов, отдаваемый под списковую память.
    n - количество звеньев,  которое необходимо получить из этого масси-
ва.
ИСПОЛЬЗОВАНИЕ:
    Слова, составляющие  массив array,  разбиваются на группы по размеру
звена,  и из каждой такой группы создается звено,  которое включается  в
список свободной памяти.
ЗАМЕЧАНИЕ: если при обращении к rflist общий блок REFAL еще не инициали-
зирован, производится его инициализация.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
        extern REFAL refal;
     rflist(array,n)  linkcb *array;  int n;  {
      extern int rf_init;
      linkcb *p, *q;
      int k;
        if (rf_init != 0) rfinit();
        q = array;
        p = refal.flhead->prev;
        for (k = 1; k<=n; k++) {
           p->next = q;
           q->prev = p;
           q->tag = 0;
           q->info.codep = NULL;
           p = q++;
        }
        p->next = refal.flhead;
        refal.flhead->prev = p;
     }

     Функция lrqlk.
НАЗНАЧЕНИЕ:
    Проверяет, содержит ли список свободных звеньев указанное количество
звеньев.
ОБРАЩЕНИЕ:  lrqlk (n);
ПАРАМЕТРЫ:
     n - количество запрашиваемых звеньев.
ИСПОЛЬЗОВАНИЕ:
     Если список свободных звеньев содержит не меньше, чем n звеньев (не
считая головы),  функция вырабатывает значение 1,  в противном случае  -
значение 0.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     lrqlk (l) int l; {
      extern REFAL refal;
      linkcb *p;
      int n;
        p = refal.flhead;
        for (n = 1; n<=l; n++) {
           p = p->next;
           if ( p == refal.flhead) return (0);
        }
        return (1);
     }

     Подпрограмма rfdel.
НАЗНАЧЕНИЕ:
     Удаляет указанную часть списка и  заносит  ее  в  список  свободных
звеньев.
ОБРАЩЕНИЕ:  rfdel (p, q);
ПАРАМЕТРЫ:
     p - указатель на звено, предшествующее удаляемой части списка;
     q - указатель на звено, следующее за удаляемой частью списка.
ИСПОЛЬЗОВАНИЕ:
    Участок списка,  заключенный  между  звеньями p и q,  исключаются из
списка, звенья p и q сшиваются, после чего вынутый участок списка встав-
ляется в конец списка свободной памяти.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     rfdel (p,q) linkcb *p,*q; {
      extern REFAL refal;
      linkcb *p1,*q1,*r;
        p1 = p->next;
        if (p1 == q) return;
        q1 = q->prev;
        r = refal.flhead->prev;
        p->next = q;
        q->prev = p;
        q1->next = refal.flhead;
        refal.flhead->prev = q1;
        r->next = p1;
        p1->prev = r;
     }

     Функция lcopy.
НАЗНАЧЕНИЕ:
     Копирует указанное выражение и вставляет копию в указанное место.
ОБРАЩЕНИЕ:  lcopy (r,p,q);
ПАРАМЕТРЫ:
     r - указатель на звено, после которого вставляется копия;
     p - указатель на звено, предшествующее копируемому выражению;
     q - указатель на звено, следующее за копируемым выражением.
ИСПОЛЬЗОВАНИЕ:
    Если список свободной памяти содержит достаточное количество  звень-
ев,  выражение,  заключенное между p и q, копируется и вставляется после
r.  При этом функция вырабатывает значение 1. В противном случае функция
ничего не делает и вырабатывает значение 0.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     lcopy (r,p,q)  linkcb *r,*p,*q;  {
      extern REFAL refal;
      linkcb *r1,*f,*f0,*f1,*lastb;
        f = refal.flhead;
        f0 =  p->next;
        while (f0 != q) {
           f = f->next;
           if (f == refal.flhead) return(0);
           switch (f0->tag) {
              case TAGLB:
                 f->info.codep = lastb;
                 lastb = f;
                 break;
              case TAGRB:
                 f->info.codep = lastb;
                 f->tag = TAGRB;
                 f1 = lastb->info.codep;
                 lastb->info.codep = f;
                 lastb->tag = TAGLB;
                 lastb = f1;
                 break;
              default:
                 f->tag = f0->tag;
                 f->info.codep = f0->info.codep;
           }
           f0 = f0->next;
        }
        if (refal.flhead == f) return(1);
        f0 = refal.flhead->next;
        f1 = f->next;
        refal.flhead->next = f1;
        f1->prev = refal.flhead;
        r1 = r->next;
        f->next = r1;
        r1->prev = f;
        r->next = f0;
        f0->prev = r;
        return(1);
     }

     Функция lins.
НАЗНАЧЕНИЕ:
     Вставляет указанное число звеньев из списка свободной  памяти после
указанного звена.
ОБРАЩЕНИЕ:  lins (p,n);
ПАРАМЕТРЫ:
     p - указатель на звено, после которого вставляются звенья;
     n - количество вставляемых звеньев.
ИСПОЛЬЗОВАНИЕ:
    Если в  списке  свободных звеньев имеется не менее чем n звеньев (не
считая головы списка), функция вставляет n звеньев после звена, на кото-
рое указывает p.  В этом случае значением lins является 1,  а все встав-
ленные звенья содержат NULL.  Если в списке свободных звеньев не набира-
ется n звеньев, функция ничего не делает и вырабатывает значение 0.
ЗАМЕЧАНИЯ:
    1) в результате работы lins ни p, ни n не меняются;
    2) если n < 1, lins ничего не делает и вырабатывает значение 1;
    3) поля code во всех вставленных звеньях содержат значение NULL.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     lins (p,l)  linkcb *p;  int l;  {
      extern REFAL refal;
      int n;
      linkcb *p1,*q,*q1,*r;
        if (l<1) return (1);
        q1 = refal.flhead;
        for (n=1; n<=l; n++) {
           q1 = q1->next;
           if (q1 == refal.flhead) return (0);
           q1->tag = TAGO;
           q1->info.codep = NULL;
        }
        r = q1->next;
        q = refal.flhead->next;
        refal.flhead->next = r;
        r->prev = refal.flhead;
        p1 = p->next;
        q1->next = p1;
        p1->prev = q1;
        p->next = q;
        q->prev = p;
        return (1);
     }

                    3.11. Таблица состояния процесса

     Каждому процессу соответствует таблица состояния  процесса  (STATUS
TABLE), которая должна быть описана следующим образом (находится также в
файле refal.def).
     struct  st_  {
       struct  st_ *stprev;
       struct st_ *stnext;
       int state;
       linkcb *dot;
       long step;
       long stop;
       linkcb  *view;
       linkcb *store;
     };
     typedef struct st_ st;
     Отдельные поля таблицы состояния имеют следущее содержимое.
   . stprev - адрес предыдущей таблицы состояния.
   . stnext - адрес следующей таблицы состояния.
   . state - состояние процесса - одно из целых чисел 1,  2, 3, 4, имею-
щих следующий смысл:
     1 - процесс остановился в результате того, что в поле зрения не ос-
         талось ни одного знака "<" или из-за того,  что  перед  началом
         шага оказалось выполнено условие st.step = st.stop.
     2 - процесс остановился из-за того,  что отождествление невозможно.
     3 - процесс остановился из-за того, что список свободной памяти со-
         держит слишком мало звеньев, вследствие чего невозможно сформи-
         ровать результат замены ведущего функционального терма.
     4 - процесс находится в активном состоянии,  т.е. в середине выпол-
         нения шага.  В частности это может означать, что процесс вызвал
         программу на Си и ожидает,  когда эта программа вернет управле-
         ние.
   . dot - адрес ведущей точки.
     - в состоянии 1 содержит адрес ведущей точки, если она есть, а если
       в поле зрения нет ни одного знака ">", dot = NULL.
     - в состоянии 2 или 3 содержит адрес ведущей точки.
     - в состоянии 4 значение dot не определено.
   . step  - счетчик числа шагов.  Показывает количество уже завершенных
шагов.
   . stop - предельный номер шага. Если перед началом выполнения очеред-
ного шага оказывается,  что step = stop, то очередной шаг выполняться не
будет, а процесс остановится в состоянии 1.
   . view - адрес головы поля зрения.
   . store - адрес головы копилки.
     Все таблицы состояния связаны в двусвязный циклический список,  го-
ловой  которого  является общий блок REFAL.  Для этого используются поля
crprev и crnext общего блока REFAL и поля strev и stnext таблиц  состоя-
ния процессов.
     Поле зрения представляет собой двусвязный циклический список. Голо-
вой этого списка является звено, которое в поле next содержит адрес пер-
вого звена поля зрения, а в поле prev - адрес последнего звена поля зре-
ния. Точно так же устроена и копилка.

     Функция lexist.
НАЗНАЧЕНИЕ:
     Позволяет узнать, является ли ее параметр таблицей состояния какого
-нибудь из процессов.
ОБРАЩЕНИЕ:  lexist (&st);
ПАРАМЕТРЫ:
     st - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
     Функция просматривает список таблиц состояния, головой которого яв-
ляется общий блок REFAL,  и вырабатывает значение 1,  если найдет  st  в
этом списке. В противном случае вырабатывается значение 0.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     lexist (ast)  st *ast;  {
      extern REFAL refal;
      REFAL *p;
        p = &refal;
        do {
           p =p->crnext;
           if (p == ast) return (1);
        } while (p != &refal);
        return(0);
     }

                 3.12. Создание и уничтожение процессов

     Функция lcre.
НАЗНАЧЕНИЕ:
     Создает процесс.
ОБРАЩЕНИЕ:  lcre (&st);
ПАРАМЕТРЫ:
     st - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
     Если список  свободных  звеньев  содержит  достаточное   количество
звеньев, lcre создает новый процесс и вырабатывает значение 1, в против-
ном случае - ничего не делает и вырабатывает значение 0.
ЗАМЕЧАНИЯ:
     1) если до обращения к lcre общий блок REFAL не  был  инициализиро-
ван, lcre предварительно инициализирует его;
     2) у только что созданного процесса поле зрения и копилка - пустые.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     lcre (ast)  st *ast;  {
      extern REFAL refal;
      extern int rf_init;
      st *q;
      linkcb *flhead1;
        if (rf_init ==1) rfinit();
        if (lexist(ast)==1) rfabe ("rfabe: process already exists");
        ast->view = refal.flhead->next;
        if (ast->view == refal.flhead) return(0);
        ast->store = ast->view->next;
        if (ast->store == refal.flhead) return (0);
        flhead1 = ast->store->next;
        refal.flhead->next = flhead1;
        flhead1->prev = refal.flhead;
        (ast->view->next) = (ast->view);
        (ast->view->prev) = (ast->view);
        (ast->store->next) =(ast->store);
        (ast->store->prev) = (ast->store);
        q = refal.crprev;
        ast->stnext = &refal;
        refal.crprev = ast;
        q->stnext = ast;
        ast->stprev = q;
        ast->state = 1;
        ast->dot = NULL;
        ast->step = 0L;
        ast->stop = -1L;
        return (1);
     }

     Подпрограмма rfcanc.
НАЗНАЧЕНИЕ:
     Уничтожает процесс.
ОБРАЩЕНИЕ:  rfcanc (&st);
ПАРАМЕТРЫ:
     st - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
     В результате обращения к rfcanc, процесс, имеющий таблицу состояния
st, уничтожается. При этом память, которая была занята под поле зрения и
копилку,  освобождается.  Освободившиеся звенья присоединяются  в  конец
списка свободных звеньев.
ЗАМЕЧАНИЯ:
     1) можно  уничтожать процесс,  только если он находится в состоянии
1, 2 или 3. Процесс, находящийся в состоянии 4 уничтожать нельзя.
     2) если при обращении к rfcanc, общий блок REFAL еще не инициализи-
рован, производится его инициализация.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     rfcanc (ast)  st *ast;  {
      extern REFAL refal;
      extern int rf_init;
      linkcb *flhead1,*view1,*store1;
        if (rf_init) rfinit ();
        if (!lexist(ast))   rfabe (" rfcanc: process doesn't exist");
        if (ast->state==4)  rfabe (" rfcanc: process is in job yet");
        ast->stprev->stnext = ast->stnext;
        ast->stnext->stprev = ast->stprev;
        flhead1 = refal.flhead->prev;
        view1 = ast->view->prev;
        store1 = ast->store->prev;
        flhead1->next = ast->view;
        ast->view->prev = flhead1;
        view1->next = ast->store;
        ast->store->prev = view1;
        store1->next = refal.flhead;
        refal.flhead->prev = store1;
     }

                         3.13. Запуск процессов

     Подпрограмма rfrun.
НАЗНАЧЕНИЕ:
     Запускает процесс и ждет пока он остановится.
ОБРАЩЕНИЕ:  rfrun (&st);
ПАРАМЕТРЫ:
     st - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
     Подпрограмма служит для того, чтобы запустить процесс, имеющий таб-
лицу  состояния  st.  После обращения к rfrun процесс начинает работать,
пока либо в поле зрения не останется знаков "<",  либо будет  невозможно
выполнить  синтаксическое отождествление,  либо окажется,  что st.step =
st.stop, либо в списке свободной памяти окажется недостаточное количест-
во звеньев для формирования результата замены.
ЗАМЕЧАНИЯ:
     1) после останова процесса выполняется оператор, следующий за вызо-
вом подпрограммы rfrun.
     2) если при обращении к rfrun st.dot=null,т.е. в поле зрения нет ни
одного знака "<", то после обращения к rfrun все остается без изменения,
за исключением того, что процесс переходит в состоянии 1.
     3) к rfrun можно обращаться рекурсивно.
     4) если при обращении к rfrun, st.state=4, то rfrun ничего не дела-
ет и после возврата из rfrun процесс остается в состоянии 4.

     Функция linskd.
НАЗНАЧЕНИЕ:
     Вставляет в поле зрения "<", ">" и имя функции.
ОБРАЩЕНИЕ:  linskd (&st, &f);
ПАРАМЕТРЫ:
     st - таблица состояния процесса;
     f  - имя функции.
ИСПОЛЬЗОВАНИЕ:
    Функция проверяет,  что st.dot = NULL, т.е. что в поле зрения нет ни
одного знака ">".  Затем, если в списке свободной памяти содержится дос-
таточное количество звеньев,  она вставляет перед содержимым поля зрения
"<f ",  а после содержимого поля зрения - ">".  Таким образом, если поле
зрения содержало выражение Ex, оно приобретает вид "<f Ex>". После этого
linskd завершает работу, причем ее значением является 1. Если же звеньев
в списке свободных звеньев недостаточно, linskd ничего не делает и выра-
батывает значение 0.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     linskd (ast,f)  st *ast;  char *f; {
      linkcb *p,*q,*r;
      extern REFAL refal;
        if (lexist(ast) == 0)  rfabe ("linskd: process not found");
        if (ast->dot!=NULL)
           rfabe ("linskd: there are 'k'-signes in view field");
        if (lrqlk(3) == 0) return (0);
        lins (ast->view,3);
        p= ast->view->next;
        r = p->next;
        q = ast->view->prev;
        p->tag = TAGK;
        q->tag = TAGD;
        q->info.codep = p;
        r->tag = TAGF;
        r->info.codep = f;
        ast->dot = q;
        return (1);
     }

                  3.14. Примеры управления процессами

     Следующая программа создает процесс, запускает его, а затем печата-
ет причину его остановки. Затем печатаются поле зрения и копилка в мета-
коде-Б и процесс уничтожается.
     Перед началом каждого шага печатается номер шага и ведущий функцио-
нальный терм.  В конце каждого шага печатается результат замены ведущего
функционального терма.  Все это достигается тем, что программа на Си за-
пускает РЕФАЛ-процесс каждый раз только на один шаг.
     #include "refal.def"
        extern char job;
     main()  {
      st st1;
      linkcb *prevk, *nextd, *pk;
      linkcb arr[1000];
        rfinit();
        rflist (arr, 1000);
        if (lcre (&st1)) goto LACK;
        if (linskd (&st1, &job) {
           rfcanc(&st1);
           goto LACK;
        }
        while (st1.state == 1 && st1.dot != NULL) {
           st1.stop = st1.step + 1;
           pk = st1.dot->info.codep;
           prevk = pk->prev;
           nextd = st1.dot->next;
           printf ("\n step: %d", st1.stop);
           rfpexm (" Term: ", prevk, nextd);
           rfrun (&st1);
           if (st1.state == 1)  rfpexm (" Result: ", prevk, nextd);
        }
        switch (st1.state) {
           case 1:
              printf ("\n computation ended");
              break;
           case 2:
              printf ("\n recognition impossible");
              break;
           case 3:
              printf ("\n free memory exhausted");
        }
        rfpexm ("view field: ", st1.view, st1.view);
        rfpexm ("burried: ", st1.store, st1.store);
        rfcanc (&st1);
        rfterm();
        return;
     LACK:
        printf ("\n no memory for initialization");
        rfterm();
     }
     Предполагается, что  существует РЕФАЛ-модуль,  в котором определена
как входная точка метка job.  Сборка мусора не предусмотрена. Память под
список выделяется в массиве arr.
     Теперь рассмотрим программу,  которая создает два одновременно  су-
ществующих  процесса и заставляет их работать одновременно,  т.е.  делая
шаги поочередно. Таким образом, первый процесс делает шаг и останавлива-
ется, затем второй процесс делает шаг и останавливается и т.д.
     Если один из процессов заканчивается раньше другого,  он дожидается
окончания второго процесса.  Это достигается за счет того, что rfrun ни-
чего не делает, если st.dot=NULL.
     #include "refal.def"
        extern char func1, func2;
     main()  {
      st st1, st2;
      linkcb *prevk, *nextd, *pk;
      linkcb arr[1000];
        rfinit();
        rflist (arr, 1000);
        lcre (&st1);
        lcre (&st2);
        linskd (&st1, &func1);
        linskd (&st2, &func2);
        while (st1.dot != NULL || st2.dot != NULL) {
           st1.stop = st1.step + 1;
           st2.stop = st2.step + 1;
           rfrun (&st1;
           rfrun (&st2);
        }
        rfcanc (&st1);
        rfcanc (&st2);
        rfterm();
     }
     В этой программе предполагается, что список свободной памяти доста-
точно велик,  и что ни один из процессов не может остановиться в состоя-
нии  2 или 3.  При желании в программу нетрудно добавить соответствующие
проверки.

                          3.15. Сборка мусора

     В тех случаях,  когда РЕФАЛ-программа использует динамические ящики
и  символы-ссылки,  причем  некоторые ящики могут становиться ненужными,
следует предусмотреть сборку мусора в те  моменты,  когда  исчерпывается
список свободных звеньев.

     Функция lgcl.
НАЗНАЧЕНИЕ:
     Производит сборку мусора.
ОБРАЩЕНИЕ:  lgcl();
ИСПОЛЬЗОВАНИЕ:
     В результате обращения производится сборка мусора.  Сначала помеча-
ются головы всех динамических ящиков,  до которых можно добраться из ка-
кого-нибудь поля зрения,  копилки или статического ящика. Затем все ящи-
ки,  оставшиеся  непомеченными,  уничтожаются,  а  освободившиеся звенья
присоединяются к началу списка свободных звеньев.
     Если в  результате  сборки  мусора  высвободилось  хоть одно звено,
функция вырабатывает значение 1, в противном случае - значение 0.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
     lgcl()  {
      extern REFAL refal;
      st *p;
      int was_coll;
      linkcb *pzero;
      linkcb *q,*r,*flhead1,*p1;
      linkcb hdvar, *hd;
        hd = &hdvar;
        if(refal.dvar == NULL) return(0);
        /* mark boxes achieved from view field & burriage */
        was_coll = 0;
        pzero = NULL;
        p = refal.crnext;
        while (p != &refal) {
           mark(p->view);
           mark(p->store);
           p = p->stnext;
        }
        /* mark boxes achieved from static boxes */
        if (refal.svar != NULL) {
           r = refal.svar;
           do {
              mark(r);
              r = r->info.codep;
           } while(r != pzero);
           /*   remove garbage   */
           hd->info.codep = refal.dvar;
           p1 = hd;
           q = refal.dvar;
           do {
              if(q->tag != 0) {   /* box isn't removed */
                 q->tag = 0;
                 p1 = q;      }
              else {              /* remove box  */
                 was_coll = 1;
                 p1->info.codep = q->info.codep;
                 p1->tag = q->tag;
                 r = q->prev;
                 flhead1 = refal.flhead->next;
                 r->next = flhead1;
                 flhead1->prev = r;
                 refal.flhead->next = q;
                 q->prev = refal.flhead;
              }
              q = p1->info.codep;
           } while (q != pzero);
           if (hd->info.codep == pzero)  refal.dvar = NULL;
           else                refal.dvar = hd->info.codep;
           return(was_coll);
        }
     }
     static mark(root)  linkcb *root;  {
      linkcb *h,*p,*q,*r;
        h = p = root;
     MRK:
        if(p->next == h) goto UP;
        p = p->next;
        if (p->tag != TAGR) goto MRK;
        q = p->info.codep;
        if (q->tag != 0) goto MRK;
        q->tag = 0xFFFF;
        p->info.codep = h;
        q->prev = p;
        h = p = q;
        goto MRK;
     UP:
        if (h == root) return;
        q = h->prev;
        h->prev = p;
        r = h;
        h = q->info.codep;
        q->info.codep = r;
        q->tag = TAGR;
        p = q;
        goto MRK;
     }
     Пример 1.
     Можно дополнить программу main из п.14 так,  чтобы она собирала му-
сор в случае,  если процесс остановился в состоянии 3.  Для этого доста-
точно строчку
     rfrun(&st1);
заменить на последовательность операторов
     AGAIN:
        rfrun (&st1);
        if (st1.state == 3)
           if (lgcl()) goto AGAIN;

               3.16. Динамический захват списковой памяти

     Функция lincrm
НАЗНАЧЕНИЕ:
     Пытается увеличить размер списка свободной памяти с  помощью сборки
мусора и захвата дополнительной памяти.
ОБРАЩЕНИЕ:  lincrm();
ИСПОЛЬЗОВАНИЕ:
     Пытается увеличить размер списка свободной памяти с  помощью сборки
мусора и захвата дополнительной памяти.  Если это удается - вырабатывает
значение 1, в противном случае - 0.
ЗАМЕЧАНИЕ: если  первое  обращение  к lincrm происходит до инициализации
РЕФАЛ-системы,  и при этом удается создать начальную  списковую  память,
производится предварительная инициализация РЕФАЛ-системы.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
        linkcb *last_block = NULL;
        int curr_size = 0;
        extern REFAL refal;
        linkcb *malloc();
     lincrm()  {
      linkcb *first_free, *p;
      linkcb *new_block,*work_var;
      int was_coll, n;
        if (last_block != NULL) {
           first_free = refal.flhead->next;
           was_coll = lgcl();
           if (was_coll == 1) {
              p = refal.flhead->next;
              n = 0;
              while (( p != first_free) && ( n != 120)) {
                 n++;
                 p = p->next;
              }
              if (n == 120) return (1);
           }
        }
        new_block = malloc(101*sizeof(linkcb));
        work_var = malloc(250*sizeof(linkcb));
        if (new_block == NULL) return (0);
        if (work_var == NULL) return (0);
        free(work_var);
        new_block->prev = last_block;
        last_block = new_block;
        curr_size = curr_size + 100;
        rflist (new_block + 1, 100);
        return (1);
     }

     Подпрограмма rftermm.
НАЗНАЧЕНИЕ:
     Освобождает всю память,  захваченную в результате обращения к функ-
ции lincrm и терминирует РЕФАЛ-систему.
ОБРАЩЕНИЕ:  rftermm();
ИСПОЛЬЗОВАНИЕ:
      Освобождает всю память, захваченную в результате обращения к функ-
ции lincrm и терминирует РЕФАЛ-систему, обратившись к функции rfterm.
ИСХОДНЫЙ ТЕКСТ:
     #include "refal.def"
        extern linkcb *last_block;
     rftermm ()  {
      linkcb *new_block;
        while (last_block != NULL) {
           new_block = last_block;
           last_block = new_block->prev;
           free(new_block);
        }
        rfterm();
        return;
     }

             3.17. Вызов программы на Си из РЕФАЛ-программы

     РЕФАЛ-программа может вызвать процедуры, написанные на Си. Вызывае-
мая процедура с точки зрения Си должна быть либо программой без парамет-
ров, либо с одним параметром - адресом общего блока REFAL.
     Обращение к программе на Си делается следующим образом.
     Пусть нужно вызвать Си-программу cproc.  Тогда в РЕФАЛ-модуле метку
cproc следует описать как внешнюю следующим образом:
     extrn cproc
     После этого, как только станет ведущим функциональный терм вида
     <cproc ex>
вызовется Си-процедура cproc.  Если эта процедура ничего не  изменяет  в
поле зрения (например,  если она не знает, что ее вызвали из РЕФАЛ-прог-
раммы), то результатом замены будет "пусто".
     Если же эта процедура написана в расчете на то,  что ее будет вызы-
вать РЕФАЛ-программа, то результатом замены будет то, что она сформирует
между  звеньями,  на  которые  указывают  prevr  и nextr из общего блока
REFAL.

                3.18. Написание первичных функций на Си

     Всякая первичная функция,  написанная  на  Си,  представляет  собой
подпрограмму с одним параметром, адресом блока REFAL.
     В тот момент,  когда процедура на Си получает управление, вызвавший
ее процесс находится в состоянии 4, а его таблица состояния является те-
кущей, т.е. ее адрес находится в слове currst общего блока REFAL. В сло-
вах preva и nexta общего блока REFAL находятся адреса звеньев, между ко-
торыми   находится   аргумент   функции,   т.е.   содержимое    ведущего
функционального терма (исключая имя функции, стоящее сразу после "<").
     Если аргумент функции пуст, то выполнено
     (refal.preva->next == refal.nexta) &&
     (refal.nexta->prev == refal.preva)
     В словах prevr и nextr общего блока REFAL находятся адреса звеньев,
между которыми подпрограмма может сформировать результат замены.  В  мо-
мент вызова подпрограммы результат замены пуст, т.е. выполнено
     (refal.prevr->next == refal.nextr) &&
     (refal.nextr->prev == refal.prevr)
     Таким образом,  если программа на Си не изменяет поле  зрения,  ре-
зультатом замены будет автоматическое "пусто".
     ПРЕДУПРЕЖДЕНИЕ: Подпрограмма на Си не должна изменять preva, nexta,
prevr и nextr,  а также содержимое звеньев,  на которые указывают prevr,
nextr  и  nexta,  за   исключением   полей   preva->next,   nexta->prev,
prevr->next и nextr->prev.  Звенья, находящиеся между preva (включитель-
но) и nexta (исключительно), можно использовать для формирования резуль-
тата замены.
     Поле nextr->info.codep содержит адрес знака ">", который станет ве-
дущим после окончания данного шага. Первичная функция может использовать
эту информацию для порождения функциональных скобок в результате замены.
При   этом   нужно   будет  только  надлежащим  образом  скорректировать
nextr->info.codep.
     Слово upshot общего блока REFAL служит для того, чтобы
сообщить РЕФАЛ-системе, чем завершилась работа первичной
функции:
   - если при выходе из процедуры upshot=1, это означает, что шаг выпол-
     нен.
   - если при выходе upshot=2, это означает, что аргумент не принадлежит
     области определения первичной функции.
   - если при выходе upshot=3, это означает, что список свободных звень-
     ев  содержит  недостаточное  количество  звеньев,  чтобы можно было
     сформировать результат замены.
     Перед вызовом  первичной функции устанавливается upshot=1,  поэтому
приходится устанавливать upshot только в тех  случаях,  когда  требуется
присвоить ей значение 2 или 3.
     Если в качестве аргумента первичной функции  допускаются  не  любые
выражения,  то, прежде чем что-либо изменять в поле зрения, следует про-
извести синтаксический и семантический контроль аргумента.  Если обнару-
жится,  что аргумент не годится,  следует установить upshot=2 и выйти из
процедуры оператором return (или передав управление на end).
     Если аргумент допустим,  первичная функция начинает формировать ре-
зультат замены,  используя звенья из списка свободной памяти и перестав-
ляя  в  результат  замены  куски  списка из аргумента (заключенные между
nextr и nexta).
     Может оказаться, что список свободной памяти содержит недостаточное
количество звеньев и их не хватает для формирования результата замены. В
этом  случае следует установить upshot=3 и выйти из процедуры оператором
return.  После этого все звенья, которые к этому моменту уже были встав-
лены  между  prevr  и  nextr будут возвращены в список свободной памяти,
процесс остановится в состоянии 3 и управление вернется в программу, за-
пустившую данный процесс с помощью rfrun. Эта программа должна либо дать
дополнительную память под список,  либо выполнить  сборку  мусора,  либо
уничтожить  какие-либо  выражения и освободившиеся звенья присоединить к
списку свободной памяти. После этого она может перезапустить процесс.
     ПРЕДУПРЕЖДЕНИЕ: При  формировании  результата  замены  можно  брать
звенья не только из списка свободной памяти,  но и из аргумента. Однако,
портить  аргумент  можно только тогда,  когда первичная функция заведомо
знает,  что она успешно сможет завершить шаг. Поэтому рекомендуется сна-
чала  взять все необходимые звенья из списка свободной памяти и переста-
вить их в результат замены,  либо убедиться, что свободных звеньев заве-
домо хватает и уже после этого что-то брать из аргумента. Если первичная
функция вставляет в результат замены знаки "<" и ">", она может изменять
nextr->info.codep  только после того,  как убедится,  что шаг может быть
успешно завершен.
     В данной  реализации описание первичной функции на Си выглядит сле-
дующим образом:
     #include "refal.def"
     static cproc_ (refpt)  REFAL *refpt;  {
           <тело функции>
     }
     static char cproc_0[] = {'c','p','r','o','c','\005'};
     char cproc = '\122';
     static int (*cproc_1)() = cproc_;
     Вызов Си-функции оформляется как стандартная РЕФАЛ-функция во внут-
реннем представлении (на языке сборки).  Поэтому и необходима описатель-
ная часть функции, расположенная в памяти в определенном порядке:
   - имя функции (для РЕФАЛ-функций печати и отладчика), за которым сле-
     дует длина имени - представляется массивом символов;
   - код  операции вызова Си-функции (восьмеричное 122).  Эта переменная
     должна описываться как глобальная и быть эквивалентна имени, указы-
     ваемому в РЕФАЛ-программе в директиве extrn;
   - указатель на Си-функцию (аргумент операции вызова Си-функции);
ПРЕДУПРЕЖДЕНИЯ:
     . Для обеспечения правильной работы интерпретатора  необходимо  ис-
пользовать  при компиляции Си-функций ключ выравнивания указателей и це-
лых на границу байта,  чтобы описательная часть Си-функции размещалась в
памяти непрерывно.
     . Глобальной желательно делать только переменную,  описывающую  код
операции,  чтобы  не плодить в объектных модулях лишних описаний и избе-
жать возможного дублирования имен.
     . При  написании  Си-функций  для  PDP-11 нужно учитывать,  что имя
функции вместе с длиной должно занимать четное число байтов памяти. Если
получается  нечетное число,  то можно добавить к имени слева один пробел
(не засчитывая его в длину имени),  например, для функции с именем "ab":
     static char ab_0[] = {' ','a','b','\002'};
     . При написании Си-функций для  VAX-11  нужно  учитывать,  что  имя
функции вместе с длиной должно занимать число байтов памяти, кратное че-
тырем.  Если не получается требуемое число,  то можно добавить  к  имени
слева необходимое число пробелов (не засчитывая их в длину имени),  нап-
ример, для функции с именем "сproc":
     static char cproc_0[] = {' ',' ','c','p','r','o','c','\005'};

                 3.19. Примеры первичных функций на Си

     Пример 1.
     Опишем функцию, которая просматривает аргумент и заменяет в нем все
вхождения  символа-литеры  '+' на символ-литеру '-' на всех уровнях ско-
бочной структуры.  Эта функция может иметь, например, следующее описание
на РЕФАЛе.
     cpfm '+'  ea = '-'         <cpfm ea>
          sx   ea = sx          <cpfm ea>
          (ex) ea = (<cpfm ex>) <cpfm ea>
     Описание на Си имеет вид:
     #include "refal.def"
     static cpfm_ (refpt)  REFAL *refpt;  {
      linkcb *r;
        rftpl (refpt->prevr, refpt->preva, refpt->nexta);
        r = refpt->prevr->next;
        while (r != refpt->nextr) {
           if (r->tag == TAGO &&  r->info.infoc == '+')
              r->info.infoc = '-';
           r = r->next;
        }
     }
     static char cpfm_0[] = {'c','p','f','m','\004'};
     char cpfm = '\122';
     static int (*cpfm_1)() = cpfm_;

     Пример 2.
     Опишем на Си первичную функцию crel,  обращение к которой имеет вид
     <crel sx sy>
где sx и sy - символы-литеры. Результатом замены является выражение
     sz sx sy,
где sz='<', если код sx меньше кода sy, sz='=', если sx=sy и sz='>', ес-
ли код sx больше кода sy.
     #include "refal.def"
     static crel_ (refpt)  REFAL *refpt;  {
      linkcb *px, *py, *pz;
        px = refpt->preva->next;
        if (px == refpt->nexta) goto FAIL;
        py = px->next;
        if (py == refpt->nexta) goto FAIL;
        if (py->next != refpt->nexta ||
           px->tag != TAGO ||
           py->tag != TAGO) goto FAIL;
        if (!lins(refpt->prevr, 1)) goto LACK;
        pz = refpt->prevr->next;
        rftpl (pz, refpt->preva, refpt->nexta);
        pz->info.codep = NULL;
        pz->tag = TAGO;
        if (px->info.infoc < py->info.infoc)     pz->info.infoc = '<';
        else if(px->info.infoc > py->info.infoc) pz->info.infoc = '>';
             else                                pz->info.infoc = '=';
        goto DONE;
     FAIL: refpt->upshot = 2; goto DONE;
     LACK: refpt->upshot = 3;
     DONE:
     }
     static char crel_0[] = {'c','r','e','l','\004'};
     char cproc = '\122';
     static int (*crel_1)() = crel_;

     Пример 3.
     Чтобы разобраться в том, как программа, написанная на Си, может по-
рождать знаки "<"и ">" в результате замены,  опишем на Си функцию, экви-
валентную следующей РЕФАЛ-функции.
     twokd ex '+' ey = <func1 ex> <func2 ey>
     Эта же функция описывается на Си.
     #include "refal.def"
        extern char func1, func2;
     static twokd_ (refpt)  REFAL *refpt; {
      linkcb *p, *pk1, *pf1, *pd1, *pk2, *pf2, *pd2;
        p = refpt->preva;
        while (p->tag != TAGO || p->info.infoc != '+') {
           p = p->next;
           if (p == refpt->nexta) {
              refpt->upshot = 2;
              return;
           }
        }
        if (!lins (prevr, 6)) {
           refpt->upshot = 3;
           return;
        }
        pk1 = refpt->prevr->next;
        pf1 = pk1->next;
        pd1 = pf1->next;
        pk2 = pd1->next;
        pf2 = pk2->next;
        pd2 = pf2->next;
        rftpl (pf1, refpt->preva, p);
        rftpl (pf2, p, refpt->nexta);
        pf1->info.codef = &func1;
        pf1->tag = TAGF;
        pf2->info.codef = &func2;
        pf2->tag = TAGF;
        pd1->info.codep = pk1;
        pd1->tag = TAGD;
        pk1->info.codep = pd2;
        pk1->tag = TAGK;
        pd2->info.codep = pk2;
        pd2->tag = TAGD;
        pk2->info.codep = refpt->nextr->info.codep
        refpt->nextr->info.codep = pd1;
        refpt->nextr->tag = TAGK;
     }
     static char twokd_0[] = {'t','w','o','k','d', '\005'};
     char twokd = '\122';
     static int (*twokd_1)() = twokd_;

     Пример 4.
     Опишем функцию apply,  обращение к которой из РЕФАЛ-программы имеет
вид:
     <apply Ex>
где Ex - произвольное выражение.
     Выполнение этого терма происхожит следующим образом:  создается но-
вое поле зрения и новая копилка. В поле зрения помещается функциональный
терм
     < Ex>
а в новую копилку переносится содержимое старой копилки.
     После этого  делается попытка вычислить функциональный терм в новом
поле зрения.
     Возможны три варианта завершения:  нормальный останов (N),  останов
"отождествление невозможно" (R) и останов "свободная  память  исчерпана"
(S).
     В случае N результатом замены будет выражение
     'N' Ey
где Ey - результат вычисления функционального терма
     < Ex>
     В случае R результатом замены будет выражение
     'R' Ez
где Ez - это содержимое того функционального терма, при вычислении кото-
рого произошел останов.
     В случае S результатом замены будет выражение
     'S'
     При любом варианте содержимое новой копилки  переносится  в  старую
копилку.
     Процедура описывается на Си следующим образом.
     #include "refal.def"
     static appl_() {
      extern REFAL refal;
      st s_st, *upst;
      linkcb *px,*pk,*pd;
        upst = refal.currst;
        if (!lins(refal.prevr,1)) goto LACK;
        px = refal.prevr->next;
        if (!lcre(&s_st)) goto LACK;
        if (!lins(s_st.view,2)) {
           rfcanc(&s_st);
           goto LACK;
        }
        pk = s_st.view->next;
        pd = pk->next;
        pk->info.codep = NULL;
        pk->tag = TAGK;
        pd->info.codep = pk;
        pd->tag = TAGD;
        s_st.dot = pd;
        rftpl(pk,refal.preva,refal.nexta);
        rftpl(s_st.store,upst->store,upst->store);
        s_st.stop = -1;
        do {
           rfrun(&s_st);
           if (s_st.state == 3)
              if (lincrm()) s_st.state = 1;
        } while ((s_st.state == 1) && (s_st.dot != NULL));
        rftpl(upst->store,s_st.store,s_st.store);
        switch (s_st.state) {
           case 1:
              px->info.infoc = 'N';
              rftpl (px,s_st.view,s_st.view);
              break;
           case 2:
              px->info.infoc = 'R';
              pd = s_st.dot;
              pk = pd->info.codep;
              rftpl(px,pk,pd);
              break;
           case 3:
              px->info.infoc = 'S';
              break;
        }
        rfcanc(&s_st);
        return;
     LACK: refal.upshot = 3;
     }
     static char appl_0[] = { 'a','p','p','l','y','\005'};
     char apply = '\122';
     static char (*appl_1)() = appl_;

     Пример 5.
     Опишем на Си первичные функции для работы со статическими и динами-
ческими ящиками.
     /* file xboxes: refal-functions: new,ptr,gtr,rdr,wtr.swr  */
     /* in current version name "ptr" replaced on "xptr"       */
     #include "refal.def"
     static new_(refpt)  REFAL *refpt;  {
      linkcb *p,*r;
        if (!lins(refpt->prevr,1)) {
           refpt->upshot = 3; return;
        }  /* LACK */
        r = refpt->prevr->next;
        r->info.codep = refpt->preva; r->tag = TAGR;
        p = refpt->nexta->prev;
        p->next = refpt->preva;
        refpt->preva->prev = p;
        refpt->nextr->next = refpt->nexta;
        refpt->nexta->prev = refpt->nextr;
        refpt->preva->info.codep = refpt->dvar;
        refpt->preva->tag = 0;
        refpt->dvar = refpt->preva;
     }
     static char new_0[] = {'n','e','w','\003'};
     char new = '\122';
     static char (*new_1)() = new_;

     static gtr_(refpt)  REFAL *refpt;  {
      linkcb *p,*r;
      int emp;
        emp = 1;
        if (!enter(refpt,emp,&p,&r)) {
           refpt->upshot = 2; return;
        }  /* FAIL */
        rftpl(refpt->prevr,p,p);
     }
     static char gtr_0[] = { 'g','t','r','\003'};
     char gtr ='\122';
     static (*gtr_1)() = gtr_;

     static rdr_(refpt)  REFAL *refpt;  {
      linkcb *p,*r;
      int emp;
        emp = 1;
        if (!enter(refpt,emp,&p,&r)) {
           refpt->upshot = 2; return;
        }  /* FAIL */
        if (!lcopy(refpt->prevr,p,p)) {
           refpt->upshot = 3; return;
        }  /* LACK */
     }
     static char rdr_0[] = {'r','d','r','\003'};
     char rdr = '\122';
     static (*rdr_1)() = rdr_;

     static ptr_(refpt)  REFAL *refpt; {
      linkcb *p,*r,*q;
      int emp;
        emp = 0;
        if (!enter(refpt,emp,&p,&r)) {
           refpt->upshot = 2; return;
        }  /* FAIL */
        q = p->prev;
      rftpl(q,r,refpt->nexta);
     }
    static char ptr_0[] = {'p','t','r','\003'};
    char xptr = '\122';
    static (*ptr_1)() = ptr_;

    static wtr_(refpt)  REFAL *refpt;  {
     linkcb *p,*r;
     int emp;
       emp = 0;
       if (!enter(refpt,emp,&p,&r)) { /* FAIL */
          refpt->upshot = 2; return; }
       rfdel(p,p);
       rftpl(p,r,refpt->nexta);
    }
    static char wtr_0[] = {'w','t','r','\003'};
    char wtr = '\122';
    static (*wtr_1)() = wtr_;

    static swr_(refpt)  REFAL *refpt;  {
     linkcb *p,*r;      int emp;
       emp = 0;
       if (!enter(refpt,emp,&p,&r)) { /* FAIL */
          refpt->upshot = 2; return; }
       rftpl(refpt->prevr,p,p);
       rftpl(p,r,refpt->nexta);
    }
    static char swr_0[] = {'s','w','r','\003'};
    char swr = '\122';
    static (*swr_1)() = swr_;

    #define N_SWAP 0116
    static enter(refpt,emp,pp,rp)
     REFAL *refpt;  int emp;  linkcb **pp,**rp;  {
     linkcb *p,*r;  char *q;
       r = refpt->preva->next;
       if(r == refpt->nexta) return(0);
       if(emp && (r->next != refpt->nexta)) return(0);
       if(r->tag == TAGR) p = r->info.codep;
       else if (r->tag == TAGF) {
          q = r->info.codef;
          if( *q != N_SWAP ) return(0);
          q++;   p=q;
          if((p->prev) == NULL) {
             p->prev = p->next = p;
             p->info.codep = refpt->svar;  p->tag = 0;
             refpt->svar = p;
          }
       }
       else return (0);
       *pp=p;   *rp=r;  return(1);
    }
