Здесь описаны средства, позволяющие вызывать из программ, написанных на Си, программы, написанные на РефалАБ и наоборот.
Интерфейс между РефалАБ и Си основан на понятии процесса. Процессом называется совокупность поля зрения и копилки.
В каждый момент времени работает либо Си-программа, либо РефалАБ-программа. Когда управление принадлежит Си-программе, все процессы приостановлены. Когда работает РефалАБ-программа, работает ровно один из процессов.
Си-программа может создавать и уничтожать процессы, запускать их и исследовать причины их остановки. При обращении из Си к РефалАБ вызывается не рефал-функция, а процесс, т.е. поле зрения, в котором уже находятся обращения к рефал-функциям. Таким образом, содержимое поля зрения определяет, какие именно функции будут вызваны.
Си-программа обязана сформировать начальное поле зрения перед обращением к РефалАБ, а затем, когда РефалАБ вернет ей управление, извлечь нужную информацию из поля зрения.
Если же РефалАБ-программа обращается к Си-программе, то Си-программа должна сама извлечь нужную информацию из ведущего функционального терма и перед возвратом управления РефалАБ-программе сформировать результат замены.
Во многих случаях РефалАБ-машина обнаруживает фатальные ошибки, которые делают бессмысленным продолжение ее работы. В этих случаях печатается диагностическое сообщение и работа программы на этом завершается. Для выполнения вышеописанных действий используется следующая функция.
НАЗНАЧЕНИЕ:
Печатает сообщение и завершает работу программы.
ОБЪЯВЛЕНИЕ: extern void rfabe(const char *amsg);
ОБРАЩЕНИЕ: rfabe(amsg);
ПАРАМЕТР: amsg - текст сообщения.
ИСПОЛЬЗОВАНИЕ:
Вначале печатается текст “** refal-abend **”, а вслед за ним - текст сообщения.
ИСХОДНЫЙ ТЕКСТ:
void rfabe(const char *amsg)
{
printf(" *** refal-abend *** %s\n", amsg);
exit(1);
return;
}
Во время работы РефалАБ-программы поле зрения, копилка и ящики представлены в виде списков. Минимальной нерасчленимой единицей данных является звено. Размер памяти, занимаемой звеном, зависит от типа компьютера.
Звено состоит из следующих полей:
----------------------------
| prev | next | code |
----------------------------
Поля prev и next используются для связывания звеньев в линейную последовательность. Поле next всегда содержит адрес следующего звена, а поле prev - адрес предыдущего звена. Поля prev и next занимают по четыре байта (x32) или восемь байт (x64).
Поле code состоит из двух подполей: tag и info.
----------------------------
| tag | info |
----------------------------
Значения этих полей зависят от того, какому объекту РефалАБ соответствует данное звено.
Если звено принадлежит полю зрения, копилке или содержимому ящика, оно может изображать один из следующих объектов: символ, структурную скобку или функциональную скобку.
Поле tag содержит признак типа звена. Если его тринадцать старших разрядов нулевые, звено называется стандартным, если же хотя бы один из тринадцати старших разрядов поля tag отличен от нуля, звено именуется нестандартным.
Если звено стандартное, то поле tag имеет следующие значения для объектов различных типов:
Нуль в младшем разряде поля tag означает, что звено содержит символ, а единица - что звено содержит скобку.
С помощью первичных функций, написанных на Си, можно создавать нестандартные звенья, у которых старшие тринадцать разрядов поля tag имеют ненулевое значение. Если при этом младший бит поля tag равен нулю, РефалАБ-машина рассматривает такие звенья как некоторые составные символы, отличные от символов-меток, символов-чисел и символов-ссылок. Поле info таких звеньев может содержать произвольную комбинацию из тридцати двух битов (x32) или шестидесяти четырех битов (x64). При выводе выражений на печать эти символы изображаются в виде
/tt,hhhhhhhh/
где tt - значение поля tag, а hhhhhhhh - значение поля info, выраженные в шестнадцатеричной системе счисления.
Таким образом, помимо четырех стандартных типов символов, существует еще множество “нестандартных” типов символов. Нестандартные символы невозможно изобразить в виде констант в РефалАБ-программах.
Значение поля info зависит от типа звена:
О функциональных скобках будет сказано ниже.
Для того, чтобы извлекать или изменять содержимое звеньев в программах, написанных на Си, следует воспользоваться указателями и базовыми структурами.
Структура звена описывается следующим образом:
typedef struct linkcb_
{
struct linkcb_ *prev;
struct linkcb_ *next;
uint16_t tag;
union
{
char infoc;
uint32_t coden;
struct linkcb_ *codep;
uint8_t *codef;
} info;
} T_LINKCB;
Это описание следует включить в программу с помощью директивы
#include "refalab.h"
Все последующие объявления структур, макросов, переменных и функций также находятся в файле “refalab.h”.
Значение поля info обрабатывается разными элементами объединения в зависимости от типа звена:
Для чтения значения элемента coden рекомендуется использовать макрос gcoden(p):
#define gcoden(p) p->info.coden
Для записи значения элемента coden рекомендуется использовать макрос pcoden(p, W):
#define pcoden(p, W) p->info.coden = W
Для повышения наглядности программ рекомендуется использовать символические имена для признаков типов, например, вместо 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 - указатель на звено, следующее за выражением.
Функция может быть описана следующим образом:
void chpm(const T_LINKCB *p, const T_LINKCB *q)
{
T_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, и все символы-литеры ‘(‘ и ‘)’ заменяет на структурные скобки ( и ). Предполагается, что в исходном выражении символы-литеры ‘(‘ и ‘)’ образуют правильную скобочную структуру.
void bmatch(const T_LINKCB *p, const T_LINKCB *q)
{
T_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.
НАЗНАЧЕНИЕ:
Переставляет указанную часть списка (трансплантат) в другое место.
ОБЪЯВЛЕНИЕ: extern void rftpl(T_LINKCB *r, T_LINKCB *p, T_LINKCB *q);
ОБРАЩЕНИЕ: rftpl(r, p, q);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Участок списка, заключенный между p и q, исключается из списка, звенья p и q сшиваются. Далее вынутый участок списка вставляется после звена r.
ИСХОДНЫЙ ТЕКСТ:
void rftpl(T_LINKCB *r, T_LINKCB *p, T_LINKCB *q)
{
T_LINKCB *p1 = p->next;
if (p1 == q)
return;
T_LINKCB *r1 = r->next;
T_LINKCB *q1 = q->prev;
p->next = q;
q->prev = p;
q1->next = r1;
r1->prev = q1;
r->next = p1;
p1->prev = r;
return;
}
НАЗНАЧЕНИЕ:
Позволяет отделить от указанного выражения с левого конца часть, совпадающую с другим указанным выражением.
ОБЪЯВЛЕНИЕ: extern T_LINKCB *lldupl(const T_LINKCB *p, const T_LINKCB *q, const T_LINKCB *u);
ОБРАЩЕНИЕ: lldupl(p,q,u);
ПАРАМЕТРЫ:
Возвращаемое значение - указатель на звено, следующее за выражением-дубликатом.
ИСПОЛЬЗОВАНИЕ:
Пусть между p и q заключено выражение E.x (именуемое оригиналом), а после u начинается некоторое выражение E.y. Если E.y начинается с E.x, т.е. его можно представить в виде E.x E.z, то lldupl вырабатывает ненулевое значение указателя на звено, следущее за E.x, т.е. на звено, с которого начинается E.z. Если же E.y невозможно представить в виде E.x E.z, то lldupl вырабатывает значение NULL.
ИСХОДНЫЙ ТЕКСТ:
T_LINKCB *lldupl(const T_LINKCB *p, const T_LINKCB *q, const T_LINKCB *u)
{
const T_LINKCB *x = p->next;
T_LINKCB *y = u->next;
while (x != q)
{
if (x->tag != y->tag)
return NULL;
if (x->info.codep != y->info.codep)
if (x->tag != TAGLB && x->tag != TAGRB)
return NULL;
x = x->next;
y = y->next;
}
return y;
}
Функциональные скобки занимают по одному звену каждая. Имя функции хранится в виде символа-метки, сразу же вслед за знаком “<”, и занимает отдельное звено.
Звено, соответствующее знаку “<”, содержит в поле tag признак TAGK. Звено, соответствующее знаку “>”,содержит в поле tag признак TAGD.
Знак “>” в поле info содержит адрес первого к нему знака “<”. Знак “<” в поле info содержит адрес “>”, который станет ведущим, после полного вычисления данного функционального терма. Если же такого “>” не существует, знак “<” в поле info содержит нуль.
Таким образом, знаки “<” и “>” связаны в список в том порядке, в котором они будут становиться ведущими.
Каждому ящику (как статическому, так и динамическому) соответствует звено, именуемое головой ящика. Это звено, как и всякое другое, обязательно выравнено по границе слова.
Если ящик динамический, то его именем является символ-ссылка. Символ-ссылка в поле tag всегда содержит признак TAGR, а в поле info - адрес головы соответствующего ящика.
Если ящик статический, то его именем является символ-метка, который в поле tag содержит признак TAGF, а в поле info - адрес байта, предшествующего голове соответствующего ящика.
Байт, предшествующий голове статического ящика, обязательно содержит константу 0x8E, что дает возможность проверить, является ли символ-метка именем статического ящика.
Если к статическому ящику не было ни одного обращения, его голова содержит нуль. При первой же попытке что-либо прочитать из статического ящика или записать в него, голова инициализируется: в поля prev и next заносится адрес самой головы, что равносильно записи в ящик пустого выражения. Только после этого выполняется операция над ящиком.
Содержимым ящика является некоторое выражение. Начало и конец этого выражения присоединены к голове ящика, т.е. поле next головы ящика содержит адрес первого звена, а поле prev - адрес последнего звена содержимого ящика. В то же время, первое звено содержимого ящика в поле prev и последнее звено содержимого ящика в поле next содержит адрес головы ящика. Таким образом, голова ящика вместе с его содержимым представляют собой двухсвязный циклический список.
Если содержимое ящика пустое, то голова ящика в полях prev и next содержит свой собственный адрес.
В поле tag головы ящика содержится 0x0000. Это поле используется во время сборки мусора (см. п.15), чтобы помечать ящики, которые нельзя выбрасывать.
Для сборки мусора необходимо иметь возможность просмотреть головы всех ящиков. Поэтому поля info в головах ящиков используются для того, чтобы связать все головы в односвязный список в порядке, обратном порядке их порождения. Каждая голова в поле info содержит адрес следующей головы. Если голова - последняя в списке, то в поле info она содержит нуль.
Головы статических и головы динамических ящиков связаны в два отдельных односвязных списка. Ссылки на эти списки содержатся в общем блоке refal (см. п.8). Динамические ящики заносятся в список в момент создания, статические - в момент инициализации их головы.
НАЗНАЧЕНИЕ:
Печатает выражение в метакоде-Б.
ОБЪЯВЛЕНИЕ: extern void rfpexm(const char *pt, const T_LINKCB *pr, const T_LINKCB *pn, const bool nl);
ОБРАЩЕНИЕ: rfpexm(pt, pr, pn, nl);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Пусть L - длина текста pt. Тогда сначала в L позициях печатается текст pt, а вслед за ним участок списка, заключенный между pr и pn, в метакоде-Б. Если выражение не поместилось на одной строке, оно переносится на следующие строки. Если nl = true, то в конце происходит переход на новую строку.
НАЗНАЧЕНИЕ:
Печатает выражение.
ОБЪЯВЛЕНИЕ: extern void rfpex(const char *pt, const T_LINKCB *pr, const T_LINKCB *pn, const bool nl);
ОБРАЩЕНИЕ: rfpex(pt, pr, pn, nl);
ПАРАМЕТРЫ:
Те же, что и для функции rfpexm.
ИСПОЛЬЗОВАНИЕ:
Аналогично функции rfpexm. Разница состоит только в форме, в которой печатаются выражения. В отличие от rfpexm, rfpex не обрамляет цепочки символов-литер апострофами, а символы-ссылки и нестандартные символы обрамляет апострофами вместо знаков “/”. Символы-числа обрамляются апострофами. Символы-метки выводятся в виде имени символа-метки, обрамленного апострофами.
НАЗНАЧЕНИЕ:
Печатает выражение в виде строки.
ОБЪЯВЛЕНИЕ: extern void rfpexs(const char *pt, const T_LINKCB *pr, const T_LINKCB *pn, const bool nl);
ОБРАЩЕНИЕ: rfpexs(pt, pr, pn, nl);
ПАРАМЕТРЫ:
Те же, что и для функции rfpexm.
ИСПОЛЬЗОВАНИЕ:
Аналогично функции rfpex. Разница состоит только в форме, в которой печатаются выражения. В отличие от rfpex, rfpexs не обрамляет символы апострофами.
РефалАБ позволяет создавать программы, различные части которых написаны на РефалАБ и Си, и которые тесно взаимодействуют друг с другом.
Программа на Си может вызывать программы на РефалАБ, которые, в свою очередь, могут вызывать программы на Си и т.д.
В каждый момент времени могут существовать несколько полей зрения и копилок. При этом каждому полю зрения соответствует одна копилка и наоборот.
Совокупность из поля зрения и связанной с ним копилки в дальнейшем именуется процессом.
Программы на Си могут создавать и уничтожать процессы, запускать их и исследовать причины их остановки. Программы,написанные на РефалАБ, не могут управлять процессами непосредственно, но могут делать это вызывая программы на Си.
Существует возможность запускать процесс на заданное число шагов. Запуская процесс каждый раз только на один шаг вперед, программа на Си может полностью контролировать его работу.
Для управления РефалАБ-процессами предоставляется набор функций, вызываемых из программ на Си. Эти функции хранят глобальную информацию в общем блоке refal. Для каждого процесса имеется таблица состояния процесса, в которой содержится вся необходимая информация о процессе.
Программы на Си, взаимодействующие с РефалАБ-программами, используют общий блок refal, который должен быть описан следующим образом:
typedef struct refal_
{
T_ST *crprev;
T_ST *crnext;
uint32_t upshot;
T_LINKCB *preva;
T_LINKCB *nexta;
T_LINKCB *prevr;
T_LINKCB *nextr;
T_ST *currst;
T_LINKCB *flhead;
T_LINKCB *svar;
T_LINKCB *dvar;
struct
{
size_t argc;
char **argv;
} arg;
struct
{
bool mode;
T_TIMESPEC start;
T_TIMESPEC ;
} tm;
} T_REFAL;
extern T_REFAL refal;
Это описание должно быть включено в программу на Си с помощью директивы
#include "refalab.h"
Первоначальное заполнение общего блока refal происходит при вызове функции rfinit, либо в момент создания первого процесса, либо в момент первого выделения пространства под списковую память.
Отдельные поля общего блока refal имеют следующее содержимое:
Назначение и использование различных полей общего блока refal более подробно объясняется в следующих разделах.
В начале работы РефалАБ-машины ее необходимо инициализировать, т.е. привести в рабочее состояние. Для выполнения этого действия предназначена функция rfint.
НАЗНАЧЕНИЕ:
Инициализирует РефалАБ-машину.
ОБЪЯВЛЕНИЕ: extern void rfinit(void);
ОБРАЩЕНИЕ: rfinit();
ИСПОЛЬЗОВАНИЕ:
Заносятся начальные значения в общий блок refal и создается пустой список свободной памяти.
ИСХОДНЫЙ ТЕКСТ:
void rfinit(void)
{
rf_init = false;
T_REFAL *p = &refal;
p->crprev = (T_ST *)&refal;
p->crnext = (T_ST *)&refal;
p->upshot = 1;
p->currst = NULL;
p->svar = NULL;
p->dvar = NULL;
p->flhead = &hd;
T_LINKCB *phd = &hd;
phd->prev = phd;
phd->next = phd;
phd->tag = TAGO;
phd->info.codep = NULL;
p->arg.argc = gargc;
p->arg.argv = gargv;
p->tm.mode = options.tmon;
if (p->tm.mode)
timespec_get(&p->tm.start, TIME_UTC);
return;
}
Под список выделяются один или несколько связных участков памяти.
При этом все неиспользованные звенья связаны с помощью полей prev и next в двусвязный циклический список (список свободной памяти). В общем блоке refal в поле flhead содержится ссылка на звено - голову этого списка.
При отведении под список нового участка памяти, новые звенья связываются в список и вставляются в конец списка свободной памяти.
Если при этом общий блок refal еще не инициализирован, производится его инициализация.
НАЗНАЧЕНИЕ:
Проверяет, содержит ли список свободных звеньев указанное количество звеньев.
ОБЪЯВЛЕНИЕ: extern bool lrqlk(size_t l);
ОБРАЩЕНИЕ: lrqlk(l);
ПАРАМЕТР: l - количество запрашиваемых звеньев.
ИСПОЛЬЗОВАНИЕ:
Если список свободных звеньев содержит не меньше, чем l звеньев (не считая головы), функция вырабатывает значение true, в противном случае - значение false.
ИСХОДНЫЙ ТЕКСТ:
bool lrqlk(size_t l)
{
const T_LINKCB *p = refal.flhead;
for (size_t n = 0; n < l; n++)
{
p = p->next;
if (p == refal.flhead)
return false;
}
return true;
}
НАЗНАЧЕНИЕ:
Удаляет указанную часть списка и заносит ее в список свободных звеньев.
ОБЪЯВЛЕНИЕ: extern void rfdel(T_LINKCB *p, T_LINKCB *q);
ОБРАЩЕНИЕ: rfdel(p, q);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Участок списка, заключенный между звеньями p и q, исключается из списка, звенья p и q сшиваются, после чего вынутый участок списка вставляется в конец списка свободной памяти.
ИСХОДНЫЙ ТЕКСТ:
void rfdel(T_LINKCB *p, T_LINKCB *q)
{
T_LINKCB *p1 = p->next;
if (p1 == q)
return;
T_LINKCB *q1 = q->prev;
T_LINKCB *r = refal.flhead->prev;
p->next = q;
q->prev = p;
q1->next = refal.flhead;
refal.flhead->prev = q1;
r->next = p1;
p1->prev = r;
return;
}
НАЗНАЧЕНИЕ:
Копирует указанное выражение и вставляет копию в указанное место.
ОБЪЯВЛЕНИЕ: extern bool lcopy(T_LINKCB *r, const T_LINKCB *p, const T_LINKCB *q);
ОБРАЩЕНИЕ: lcopy(r, p, q);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Если список свободной памяти содержит достаточное количество звеньев, выражение, заключенное между p и q, копируется и вставляется после r. При этом функция вырабатывает значение true. В противном случае функция ничего не делает и вырабатывает значение false.
ИСХОДНЫЙ ТЕКСТ:
bool lcopy(T_LINKCB *r, const T_LINKCB *p, const T_LINKCB *q)
{
T_LINKCB *f = refal.flhead;
T_LINKCB *f0 = p->next;
T_LINKCB *f1, *lastb = NULL;
while (f0 != q)
{
f = f->next;
if (f == refal.flhead)
return false;
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 true;
f0 = refal.flhead->next;
f1 = f->next;
refal.flhead->next = f1;
f1->prev = refal.flhead;
T_LINKCB *r1 = r->next;
f->next = r1;
r1->prev = f;
r->next = f0;
f0->prev = r;
return true;
}
НАЗНАЧЕНИЕ:
Вставляет указанное число звеньев из списка свободной памяти после указанного звена.
ОБЪЯВЛЕНИЕ: extern bool lins(T_LINKCB *p, size_t l);
ОБРАЩЕНИЕ: lins(p, l);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Если в списке свободных звеньев имеется не менее чем l звеньев (не считая головы списка), функция вставляет l звеньев после звена, на которое указывает p. В этом случае значением lins является true, а все вставленные звенья содержат NULL. Если в списке свободных звеньев не набирается l звеньев, функция ничего не делает и вырабатывает значение false.
ЗАМЕЧАНИЯ: 1) в результате работы lins ни p, ни l не меняются; 2) если l = 0, lins ничего не делает и вырабатывает значение true; 3) поле codep во всех вставленных звеньях содержат значение NULL.
ИСХОДНЫЙ ТЕКСТ:
bool lins(T_LINKCB *p, size_t l)
{
if (l == 0)
return true;
T_LINKCB *q1 = refal.flhead;
for (size_t n = 0; n < l; n++)
{
q1 = q1->next;
if (q1 == refal.flhead)
return false;
q1->tag = TAGO;
q1->info.codep = NULL;
}
T_LINKCB *r = q1->next;
T_LINKCB *q = refal.flhead->next;
refal.flhead->next = r;
r->prev = refal.flhead;
T_LINKCB *p1 = p->next;
q1->next = p1;
p1->prev = q1;
p->next = q;
q->prev = p;
return true;
}
Каждому процессу соответствует таблица состояния процесса (STATUS TABLE), структура которой должна быть описана следующим образом (находится также в файле “refalab.h”).
typedef struct st_
{
struct st_ *stprev;
struct st_ *stnext;
uint32_t state;
T_LINKCB *dot;
uint32_t step;
uint32_t stop;
T_LINKCB *view;
T_LINKCB *store;
} T_ST;
Отдельные поля таблицы состояния имеют следущее содержимое:
Имеется макрос MAX_STOP, описанный в “refalab.h”, указывающый максимальный предельный номер шага:
#define MAX_STOP 0x7FFFFFFF
ЗАМЕЧАНИЕ: интерпретатор языка сборки при достижении счетчика числа шагов предельного номера шага обнуляет счетчик.
Все таблицы состояния связаны в двусвязный циклический список, головой которого является общий блок refal. Для этого используются поля crprev и crnext общего блока refal и поля strev и stnext l таблиц состояния процессов.
Поле зрения представляет собой двусвязный циклический список. Головой этого списка является звено, которое в поле next содержит адрес первого звена поля зрения, а в поле prev - адрес последнего звена поля зрения. Точно так же устроена и копилка.
НАЗНАЧЕНИЕ:
Позволяет узнать, является ли ее параметр таблицей состояния какого-нибудь из процессов.
ОБЪЯВЛЕНИЕ: extern bool lexist(const T_ST *ast);
ОБРАЩЕНИЕ: lexist(&ast);
ПАРАМЕТР: ast - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
Функция просматривает список таблиц состояния, головой которого является общий блок refal, и вырабатывает значение true, если найдет ast в этом списке. В противном случае вырабатывается значение false.
ИСХОДНЫЙ ТЕКСТ:
bool lexist(const T_ST *ast)
{
const T_REFAL *p = &refal;
do
{
p = (T_REFAL *)(p->crnext);
if (p == (T_REFAL *)ast)
return true;
} while (p != &refal);
return false;
}
НАЗНАЧЕНИЕ:
Создает процесс.
ОБЪЯВЛЕНИЕ: extern bool lcre(T_ST *ast);
ОБРАЩЕНИЕ: lcre(&ast);
ПАРАМЕТР: ast - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
Если список свободных звеньев содержит достаточное количество звеньев, lcre создает новый процесс и вырабатывает значение true, в противном случае - ничего не делает и вырабатывает значение false.
ЗАМЕЧАНИЯ: 1) если до обращения к lcre общий блок refal не был инициализирован, lcre предварительно инициализирует его; 2) у только что созданного процесса поле зрения и копилка - пустые.
ИСХОДНЫЙ ТЕКСТ:
bool lcre(T_ST *ast)
{
if (rf_init)
rfinit();
if (lexist(ast))
rfabe("lcre: process already exists");
ast->view = refal.flhead->next;
if (ast->view == refal.flhead)
return false;
ast->store = ast->view->next;
if (ast->store == refal.flhead)
return false;
T_LINKCB *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;
T_ST *q = refal.crprev;
ast->stnext = (T_ST *)&refal;
refal.crprev = ast;
q->stnext = ast;
ast->stprev = q;
ast->state = 1;
ast->dot = NULL;
ast->step = 0;
ast->stop = MAX_STOP;
return true;
}
НАЗНАЧЕНИЕ:
Уничтожает процесс.
ОБЪЯВЛЕНИЕ: extern void rfcanc(const T_ST *ast);
ОБРАЩЕНИЕ: rfcanc(&ast);
ПАРАМЕТР: ast - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
В результате обращения к rfcanc, процесс, имеющий таблицу состояния ast, уничтожается. При этом память, которая была занята под поле зрения и копилку, освобождается. Освободившиеся звенья присоединяются в конец списка свободных звеньев.
ЗАМЕЧАНИЯ: 1) Можно уничтожать процесс, только если он находится в состоянии 1, 2 или 3. Процесс, находящийся в состоянии 4 уничтожать нельзя. 2) Если при обращении к rfcanc, общий блок refal еще не инициализирован, производится его инициализация.
ИСХОДНЫЙ ТЕКСТ:
void rfcanc(const T_ST *ast)
{
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;
T_LINKCB *flhead1 = refal.flhead->prev;
T_LINKCB *view1 = ast->view->prev;
T_LINKCB *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;
return;
}
НАЗНАЧЕНИЕ:
Запускает процесс и ждет пока он остановится.
ОБЪЯВЛЕНИЕ: extern void rfrun(T_ST *ast);
ОБРАЩЕНИЕ: rfrun(&ast);
ПАРАМЕТР: ast - таблица состояния процесса.
ИСПОЛЬЗОВАНИЕ:
Функция служит для того, чтобы запустить процесс, имеющий таблицу состояния ast. После обращения к rfrun процесс начинает работать, пока либо в поле зрения не останется знаков “<”, либо будет невозможно выполнить синтаксическое отождествление, либо окажется, что ast.step = ast.stop, либо в списке свободной памяти окажется недостаточное количество звеньев для формирования результата замены.
ЗАМЕЧАНИЯ: 1) после останова процесса выполняется оператор, следующий за вызовом функции rfrun; 2) если при обращении к rfrun ast.dot = NULL, т.е. в поле зрения нет ни одного знака “<”, то после обращения к rfrun все остается без изменения, за исключением того, что процесс переходит в состояние 1; 3) к rfrun можно обращаться рекурсивно; 4) если при обращении к rfrun, ast.state = 4, то rfrun ничего не делает и после возврата из rfrun процесс остается в состоянии 4.
НАЗНАЧЕНИЕ:
Вставляет в поле зрения “<”, “>” и имя функции.
ОБЪЯВЛЕНИЕ: extern bool linskd(T_ST *ast, uint8_t *f);
ОБРАЩЕНИЕ: linskd(&ast, &f);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Функция проверяет, что ast.dot = NULL, т.е. что в поле зрения нет ни одного знака “>”. Затем, если в списке свободной памяти содержится достаточное количество звеньев, она вставляет перед содержимым поля зрения “<f “, а после содержимого поля зрения - “>”. Таким образом, если поле зрения содержало выражение E.x, оно приобретает вид “<f E.x>”. После этого linskd завершает работу, причем ее значением является true. Если же звеньев в списке свободных звеньев недостаточно, linskd ничего не делает и вырабатывает значение false.
ИСХОДНЫЙ ТЕКСТ:
bool linskd(T_ST *ast, uint8_t *f)
{
if (!lexist(ast))
rfabe("linskd: process doesn't exist still");
if (ast->dot != NULL)
rfabe("linskd: there are '<'-signes in view field");
if (!slins(ast->view, 3))
return false;
T_LINKCB *p = ast->view->next;
T_LINKCB *r = p->next;
T_LINKCB *q = ast->view->prev;
p->tag = TAGK;
q->tag = TAGD;
q->info.codep = p;
r->tag = TAGF;
r->info.codef = f;
ast->dot = q;
return true;
}
Следующая программа создает процесс, запускает его, а затем печатает причину его остановки. Затем печатаются поле зрения и копилка в метакоде-Б и процесс уничтожается.
Перед началом каждого шага печатается номер шага и ведущий функциональный терм. В конце каждого шага печатается результат замены ведущего функционального терма. Все это достигается тем, что программа на Си запускает РефалАБ-процесс каждый раз только на один шаг.
#include "refalab.h"
extern uint8_t refalab_go;
int main(void)
{
T_ST st1;
const T_LINKCB *prevk, *nextd, *pk;
T_LINKCB arr[1000];
rfinit();
T_LINKCB *q = arr;
T_LINKCB *p = refal.flhead->prev;
for (size_t k = 0; k < 1000; k++)
{
p->next = q;
q->prev = p;
q->tag = TAGO;
q->info.codep = NULL;
p = q;
q++;
}
p->next = refal.flhead;
refal.flhead->prev = p;
do
{
if (!lcre(&st1))
break;
if (!linskd(&st1, &refalab_go))
break;
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(" Step: %d\n", st1.stop);
rfpexm(" Term: ", prevk, nextd, true);
rfrun(&st1);
if (st1.state == 1)
rfpexm(" Result: ", prevk, nextd, true);
}
switch (st1.state)
{
case 1:
printf("Concretization is executed\n");
break;
case 2:
printf("Recognition impossible\n");
break;
case 3:
printf("Free memory exhausted\n");
}
printf("View field:\n");
rfpexm(" ", st1.view, st1.view, true);
printf("Burried:\n");
rfpexm(" ", st1.store, st1.store, true);
rfcanc(&st1);
exit(0);
} while (false);
printf("\nNo enough memory for initialization\n");
exit(1);
}
Предполагается, что существует РефалАБ-модуль, в котором определена как входная точка метка go. Сборка мусора не предусмотрена. Память под список выделяется в массиве arr.
Теперь рассмотрим программу, которая создает два одновременно существующих процесса и заставляет их работать одновременно, т.е. делая шаги поочередно. Таким образом, первый процесс делает шаг и останавливается, затем второй процесс делает шаг и останавливается и т.д.
Если один из процессов заканчивается раньше другого, он дожидается окончания второго процесса. Это достигается за счет того, что rfrun ничего не делает, если st.dot = NULL.
#include "refalab.h"
extern uint8_t refalab_func1, refalab_func2;
int main(void)
{
T_ST st1, st2;
T_LINKCB arr[1000];
rfinit();
T_LINKCB *q = arr;
T_LINKCB *p = refal.flhead->prev;
for (size_t k = 0; k < 1000; k++)
{
p->next = q;
q->prev = p;
q->tag = TAGO;
q->info.codep = NULL;
p = q;
q++;
}
p->next = refal.flhead;
refal.flhead->prev = p;
lcre(&st1);
lcre(&st2);
linskd(&st1, &refalab_func1);
linskd(&st2, &refalab_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);
}
В этой программе предполагается, что список свободной памяти достаточно велик, и что ни один из процессов не может остановиться в состоянии 2 или 3. При желании в программу нетрудно добавить соответствующие проверки.
В тех случаях, когда РефалАБ-программа использует динамические ящики и символы-ссылки, причем некоторые ящики могут становиться ненужными, следует предусмотреть сборку мусора в те моменты, когда исчерпывается список свободных звеньев.
Сборка мусора производится следующим образом. Сначала помечаются головы всех динамических ящиков, до которых можно добраться из какого-нибудь поля зрения, копилки или статического ящика. Затем все ящики, оставшиеся непомеченными, уничтожаются, а освободившиеся звенья присоединяются к началу списка свободных звеньев.
Если в результате сборки мусора высвободилось хоть одно звено, процесс считается успешным. В противном случае - нет.
НАЗНАЧЕНИЕ:
Пытается увеличить размер списка свободной памяти с помощью сборки мусора и захвата дополнительной памяти.
ОБЪЯВЛЕНИЕ: extern bool lincrm(void);
ОБРАЩЕНИЕ: lincrm();
ИСПОЛЬЗОВАНИЕ:
Пытается увеличить размер списка свободной памяти с помощью сборки мусора и захвата дополнительной памяти. Если это удается - вырабатывает значение true, в противном случае - false.
ЗАМЕЧАНИЕ: если первое обращение к lincrm происходит до инициализации РефалАБ-машины, и при этом удается создать начальную списковую память, производится предварительная инициализация РефалАБ-машины.
ИСХОДНЫЙ ТЕКСТ:
bool lincrm(void)
{
size_t n = 0;
if (last_block != NULL)
{
const T_LINKCB *first_free = refal.flhead->next;
const bool was_coll = lgcl();
if (was_coll)
{
const T_LINKCB *p = refal.flhead->next;
n = 0;
while (p != first_free && n != 1000)
{
n++;
p = p->next;
}
if (n == 1000)
return true;
}
}
T_LINKCB *new_block = malloc(1001 * sizeof(T_LINKCB));
if (new_block == NULL)
return false;
new_block->prev = last_block;
last_block = new_block;
rflist(new_block + 1, 1000);
return true;
}
static bool lgcl(void)
{
T_LINKCB hdvar;
T_LINKCB *hdp = &hdvar;
if (refal.dvar == NULL)
return false;
// mark boxes achieved from view field & burriage
bool was_coll = false;
const T_LINKCB *pzero = NULL;
const T_ST *p = refal.crnext;
while (p != (T_ST *)&refal)
{
mark(p->view);
mark(p->store);
p = p->stnext;
}
// mark boxes achieved from static boxes
if (refal.svar != NULL)
{
T_LINKCB *r = refal.svar;
do
{
mark(r);
r = r->info.codep;
} while (r != pzero);
// remove garbage
hdp->info.codep = refal.dvar;
T_LINKCB *p1 = hdp;
T_LINKCB *q = refal.dvar;
do
{
if (q->tag != TAGO)
{ // box isn't removed
q->tag = TAGO;
p1 = q;
}
else
{ // remove box
was_coll = true;
p1->info.codep = q->info.codep;
p1->tag = q->tag;
r = q->prev;
T_LINKCB *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 (hdp->info.codep == pzero)
refal.dvar = NULL;
else
refal.dvar = hdp->info.codep;
}
return was_coll;
}
static void mark(T_LINKCB *root)
{
T_LINKCB *p = root;
T_LINKCB *h = p;
while (true)
{
T_LINKCB *q;
if (p->next != h)
{
p = p->next;
if (p->tag != TAGR)
continue;
q = p->info.codep;
if (q->tag != TAGO)
continue;
q->tag = 0xFFFF;
p->info.codep = h;
q->prev = p;
p = q;
h = p;
continue;
}
if (h == root)
return;
q = h->prev;
h->prev = p;
T_LINKCB *r = h;
h = q->info.codep;
q->info.codep = r;
q->tag = TAGR;
p = q;
}
}
static void rflist(T_LINKCB *par, size_t n)
{
if (rf_init)
rfinit();
T_LINKCB *q = par;
T_LINKCB *p = refal.flhead->prev;
for (size_t k = 0; k < n; k++)
{
p->next = q;
q->prev = p;
q->tag = TAGO;
q->info.codep = NULL;
p = q;
q++;
}
p->next = refal.flhead;
refal.flhead->prev = p;
return;
}
Пример 1
Можно дополнить программу main из п.14 так, чтобы она собирала мусор и пыталась захватить дополнительную память в случае, если процесс остановился в состоянии 3. Для этого достаточно строчку
rfrun(&st1);
заменить на строчки
while (true)
{
rfrun(&st1);
if (st1.state == 3)
if (lincrm())
continue;
break;
}
НАЗНАЧЕНИЕ:
Освобождает всю память, захваченную в результате обращения к функции lincrm.
ОБЪЯВЛЕНИЕ: extern void rftermm(void);
ОБРАЩЕНИЕ: rftermm();
ИСПОЛЬЗОВАНИЕ:
Освобождает всю память, захваченную в результате обращения к функции lincrm.
ИСХОДНЫЙ ТЕКСТ:
void rftermm(void)
{
while (last_block != NULL)
{
T_LINKCB *new_block = last_block;
last_block = new_block->prev;
free(new_block);
}
}
НАЗНАЧЕНИЕ:
Вставляет указанное число звеньев из списка свободной памяти после указанного звена в результате увеличения размера списка свободной памяти.
ОБЪЯВЛЕНИЕ: extern bool slins(T_LINKCB *p, size_t k);
ОБРАЩЕНИЕ: slins(p, k);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Если в списке свободных звеньев имеется менее чем k звеньев (не считая головы списка), пытается увеличить размер списка свободной памяти в результате обращения к функции lincrm, пока не будет в списке не менее k звеньев. Если это не удается - вырабатывает значение false и refal.upshot = 3. Если это удается или в списке было изначально не менее k звеньев, то вставляет k звеньев после звена, на которое указывает p в результате обращения к функции lins и возвращает результат этого обращения.
ИСХОДНЫЙ ТЕКСТ:
bool slins(T_LINKCB *p, size_t k)
{
while (!lrqlk(k))
if (!lincrm())
{
refal.upshot = 3;
return false;
}
return lins(p, k);
}
РефалАБ-программа может вызвать функции, написанные на Си. Вызываемая функция с точки зрения Си должна быть функцией без параметров.
Обращение к функции на Си делается следующим образом.
Пусть нужно вызвать Си-функцию cfunc. Тогда в РефалАБ-модуле метку cfunc следует описать как внешнюю следующим образом:
EXTRN cfunc
После этого, как только станет ведущим функциональный терм вида
<cfunc e.x>
вызовется Си-функция cfunc. Если эта функция ничего не изменяет в поле зрения (например, если она не знает, что ее вызвали из РефалАБ-программы), то результатом замены будет “пусто”.
Если же эта функция написана в расчете на то, что ее будет вызывать РефалАБ-программа, то результатом замены будет то, что она сформирует между звеньями, на которые указывают prevr и nextr из общего блока 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 или 3.
Если в качестве аргумента первичной функции допускаются не любые выражения, то, прежде чем что-либо изменять в поле зрения, следует произвести синтаксический и семантический контроль аргумента. Если обнаружится, что аргумент не годится, следует установить upshot = 2 и выйти из функции оператором return.
Если аргумент допустим, первичная функция начинает формировать результат замены, используя звенья из списка свободной памяти и переставляя в результат замены куски списка из аргумента (заключенные между nextr и nexta).
Может оказаться, что список свободной памяти содержит недостаточное количество звеньев и их не хватает для формирования результата замены. В этом случае следует установить upshot = 3 и выйти из функции оператором return. После этого все звенья, которые к этому моменту уже были вставлены между prevr и nextr будут возвращены в список свободной памяти, процесс остановится в состоянии 3 и управление вернется в программу, запустившую данный процесс с помощью rfrun. Эта программа должна либо дать дополнительную память под список, либо выполнить сборку мусора, либо уничтожить какие-либо выражения и освободившиеся звенья присоединить к списку свободной памяти. После этого она может перезапустить процесс.
ПРЕДУПРЕЖДЕНИЕ: При формировании результата замены можно брать звенья не только из списка свободной памяти, но и из аргумента. Однако, портить аргумент можно только тогда, когда первичная функция заведомо знает, что она успешно сможет завершить шаг. Поэтому рекомендуется сначала взять все необходимые звенья из списка свободной памяти и переставить их в результат замены, либо убедиться, что свободных звеньев заведомо хватает и уже после этого что-то брать из аргумента. Если первичная функция вставляет в результат замены знаки “<” и “>”, она может изменять nextr->info.codep только после того, как убедится, что шаг может быть успешно завершен.
Описание первичной функции cfunc на Си выглядит следующим образом:
#include "refalab.h"
static void cfunc_(void)
{
<тело функции>
}
char cfunc_0[] = {Z5 'C', 'F', 'U', 'N', 'C', (char)5};
G_L_B uint8_t refalab_cfunc = '\122';
void (*cfunc_1)(void) = cfunc_;
Вызов Си-функции оформляется как стандартная рефал-функция во внутреннем представлении (на языке сборки). Поэтому и необходима описательная часть функции, расположенная в памяти в определенном порядке:
Также на Си можно писать первичные пустые функции.
Описание первичной пустой функции cemp на Си выглядит следующим образом:
#include "refalab.h"
char cemp_0[] = {Z4 'C', 'E', 'M', 'P', (char)4};
G_L_B uint8_t refalab_cemp = '\002';
Описание первичной пустой функции отличается от описания первичной функции следующим:
ПРЕДУПРЕЖДЕНИЯ:
Имя функции вместе с длиной должно занимать кратное восьми без одного байтов памяти, то есть семь, пятнадцать и т. д. Если не получается требуемое число, то нужно добавить к имени слева необходимое число символов (не засчитывая их в длину имени). Для этого можно использовать макросы, описанные в “refalab.h”:
#define Z1 '0', '0', '0', '0', '0',
#define Z2 '0', '0', '0', '0',
#define Z3 '0', '0', '0',
#define Z4 '0', '0',
#define Z5 '0',
#define Z6
#define Z7 '0', '0', '0', '0', '0', '0', '0',
#define Z0 '0', '0', '0', '0', '0', '0',
Если остаток от деления длины имени функции на восемь есть i, то надо использовать макропеременную Zi.
ДОПОЛНЕНИЕ:
В первичных функциях можно использовать макросы, описанные в “refalab.h”:
MAX_PATHFILENAME - максимальная длина имени файла (возможно, с указанием пути).
#define MAX_NUMBER 0xFFFFFFFFLL
#if defined POSIX
#define MAX_PATHFILENAME 4096
#else
#define MAX_PATHFILENAME 260
#endif
Макрос POSIX вместе с директивой #if defined используются для различения кода, используюмего в среде Windows и POSIX.
#if defined POSIX
<код в среде POSIX>
#else
<код в среде Windows>
#endif
НАЗНАЧЕНИЕ:
Формирует строку из выражения символов-литер аргумента первичной функции.
ОБЪЯВЛЕНИЕ: extern T_LINKCB *rfgstr(char *str, size_t l, T_LINKCB *p);
ОБРАЩЕНИЕ: rfgstr(str, l, p);
ПАРАМЕТРЫ:
Возвращаемое значение - указатель на звено - символ после последнего символа-литера строки str.
ИСПОЛЬЗОВАНИЕ:
Используется, когда необходимо в функции на Си сформировать строку str с нуль-символом ‘\0’ в конце из выражения символов-литер аргумента функции, начиная со звена p. Длина строки str ограничена l. Вырабатывает значение указателя на звено - символ после последнего символа-литеры строки str.
ИСХОДНЫЙ ТЕКСТ:
T_LINKCB *rfgstr(char *str, size_t l, T_LINKCB *p)
{
size_t i;
for (i = 0; p != refal.nexta; i++)
{
if (p->tag != TAGO || i == l)
break;
*(str + i) = p->info.infoc;
p = p->next;
}
*(str + i) = '\0';
return p;
}
НАЗНАЧЕНИЕ:
Формирует в части результата замены первичной функции строку в виде выражения символов-литер.
ОБЪЯВЛЕНИЕ: extern T_LINKCB *rfrstr(const char *str, T_LINKCB *p);
ОБРАЩЕНИЕ: rfrstr(str, p);
ПАРАМЕТРЫ:
Возвращаемое значение - указатель на звено - последняя символ-литера строки str.
ИСПОЛЬЗОВАНИЕ:
Используется, когда необходимо, чтобы функция на Си вернула в части выражения строку str в виде выражения символов-литер после звена p. Вырабатывает значение указателя на звено - последнюю символ-литеру строки str. Если строка str пустая, вырабатывает значение NULL.
ИСХОДНЫЙ ТЕКСТ:
T_LINKCB *rfrstr(const char *str, T_LINKCB *p)
{
if (*str == '\0')
return NULL;
for (size_t i = 0; *(str + i) != '\0'; i++)
{
p = p->next;
p->tag = TAGO;
p->info.codep = NULL;
p->info.infoc = *(str + i);
}
return p;
}
НАЗНАЧЕНИЕ:
Формирует в части результата замены первичной функции символ-метку &FEOF или &FERROR или ничего.
ОБЪЯВЛЕНИЕ: extern bool rfreof(int c, FILE *f, T_LINKCB *p);
ОБРАЩЕНИЕ: rfreof(c, f, p);
ПАРАМЕТРЫ:
ИСПОЛЬЗОВАНИЕ:
Используется, когда необходимо, чтобы функция на Си вернула в части выражения символ-метку &FEOF или &FERROR или ничего. Если результат операции с файлом f c = EOF, то проверяется достигнут ли конец файла или есть ошибки в файле. Далее в звене, на которое указывает p, формируется симол-метка &FEOF, если обнаружен конец файла, или &FERROR, если обнаружены ошибки в файле, или ничего, если ничего не обнаружено. Если что-то обнаружено, то функция вырабатывает значение true. Если ничего не обнаружено, то функция вырабатывает значение false.
ИСХОДНЫЙ ТЕКСТ:
bool rfreof(int c, FILE *f, T_LINKCB *p)
{
enum
{
OK,
FEOF,
FERROR
} err = OK;
if (c == EOF)
{
if (feof(f) != 0)
err = FEOF;
else if (ferror(f) != 0)
err = FERROR;
}
if (err != OK)
{
p->tag = TAGF;
if (err == FEOF)
p->info.codef = &refalab_feof;
else
p->info.codef = &refalab_ferror;
return true;
}
return false;
}
Опишем функцию, которая просматривает аргумент и заменяет в нем все вхождения символа-литеры ‘+’ на символ-литеру ‘-‘ на всех уровнях скобочной структуры. Эта функция может иметь, например, следующее описание на РефалАБ:
cpfm '+' e.a = '-' <cpfm e.a>
s.x e.a = s.x <cpfm e.a>
(e.x) e.a = (<cpfm e.x>) <cpfm e.a>
Описание на Си имеет вид:
#include "refalab.h"
static void cpfm_(void)
{
rftpl(refal.prevr, refal.preva, refal.nexta);
T_LINKCB *r = refal.prevr->next;
while (r != refal.nextr)
{
if (r->tag == TAGO && r->info.infoc == '+')
r->info.infoc = '-';
r = r->next;
}
}
char cpfm_0[] = {Z4 'C', 'P', 'F', 'M', (char)4};
G_L_B uint8_t refalab_cpfm = '\122';
void (*cpfm_1)(void) = cpfm_;
Опишем на Си первичную функцию crel, обращение к которой имеет вид
<crel o.x o.y>
где o.x и o.y - символы-литеры. Результатом замены является выражение
s.z o.x o.y
где s.z=’<’, если код o.x меньше кода o.y, s.z=’=’, если o.x=o.y и s.z=’>’, если код o.x больше кода o.y.
#include "refalab.h"
static void crel_(void)
{
const T_LINKCB *p = refal.preva->next;
do
{
if (p->tag != TAGO)
break;
const T_LINKCB *q = p->next;
if (q->next != refal.nexta || q->tag != TAGO)
break;
char c = '=';
if ((uint8_t)p->info.infoc > (uint8_t)q->info.infoc)
c = '>';
else if ((uint8_t)p->info.infoc < (uint8_t)q->info.infoc)
c = '<';
refal.preva->tag = TAGO;
refal.preva->info.codep = NULL;
refal.preva->info.infoc = c;
rftpl(refal.prevr, refal.preva->prev, refal.nexta);
return;
} while (false);
refal.upshot = 2;
return;
}
char crel_0[] = {Z4 'C', 'R', 'E', 'L', (char)4};
G_L_B uint8_t refalab_crel = '\122';
void (*crel_1)(void) = crel_;
Чтобы разобраться в том, как программа, написанная на Си, может порождать знаки “<”и “>” в результате замены, опишем на Си функцию, эквивалентную следующей рефал-функции:
twokd e.x '+' e.y = <func1 e.x> <func2 e.y>
Эта же функция описывается на Си:
#include "refalab.h"
extern uint8_t refalab_func1, refalab_func2;
static void twokd_(void)
{
T_LINKCB *p = refal.preva;
while (p->tag != TAGO || p->info.infoc != '+')
{
p = p->next;
if (p == refal.nexta)
{
refal.upshot = 2;
return;
}
}
if (!slins(refal.prevr, 6))
return;
T_LINKCB *pk1 = refal.prevr->next;
T_LINKCB *pf1 = pk1->next;
T_LINKCB *pd1 = pf1->next;
T_LINKCB *pk2 = pd1->next;
T_LINKCB *pf2 = pk2->next;
T_LINKCB *pd2 = pf2->next;
rftpl(pf1, refal.preva, p);
rftpl(pf2, p, refal.nexta);
pf1->tag = TAGF;
pf1->info.codef = &refalab_func1;
pf2->tag = TAGF;
pf2->info.codef = &refalab_func2;
pd1->tag = TAGD;
pd1->info.codep = pk1;
pk1->tag = TAGK;
pk1->info.codep = pd2;
pd2->tag = TAGD;
pd2->info.codep = pk2;
pk2->info.codep = refal.nextr->info.codep;
refal.nextr->info.codep = pd1;
}
char twokd_0[] = {Z5 'T', 'W', 'O', 'K', 'D', (char)5};
G_L_B uint8_t refalab_twokd = '\122';
void (*twokd_1)(void) = twokd_;
Опишем библиотечную функцию try, обращение к которой из РефалАБ-программы имеет вид:
<try E.x>
где E.x - произвольное объектное выражение.
Выполнение этого терма упрощенно происходит следующим образом: создается новое поле зрения и новая копилка. В поле зрения помещается функциональный терм
< E.x>
а в новую копилку переносится содержимое старой копилки.
После этого делается попытка вычислить функциональный терм в новом поле зрения.
Возможны три варианта завершения: нормальный останов (N), останов “Отождествление невозможно” (R) и останов “Свободная память исчерпана” (S).
В случае N результатом замены будет выражение
'N' E.y
где E.y - результат вычисления функционального терма
< E.x>
В случае R результатом замены будет выражение
'R' E.z
где E.z - это содержимое того функционального терма, при вычислении которого произошел останов.
В случае S результатом замены будет выражение
'S'
При любом варианте содержимое новой копилки переносится в старую копилку.
Функция описывается на Си следующим образом:
#include "refalab.h"
static void try_(void)
{
T_ST *s_st;
size_t l = (size_t)&s_st;
T_ST *upst;
T_LINKCB *px;
bool lack = false;
if ((l & 0xffff) < 200)
lack = true;
else
{
upst = refal.currst;
if (!slins(refal.prevr, 1))
return;
px = refal.prevr->next;
s_st = malloc(sizeof(T_ST));
if (s_st == NULL)
lack = true;
else if (!lcre(s_st))
lack = true;
else if (!lins(s_st->view, 2))
{
rfcanc(s_st);
lack = true;
}
}
if (lack)
{
refal.upshot = 3;
return;
}
T_LINKCB *pk = s_st->view->next;
T_LINKCB *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->step = ++upst->step;
s_st->stop = MAX_STOP;
do
{
if (dbt == NULL)
{
rfrun(s_st); // net prokrutki
if (s_st->state == 1 && s_st->dot != NULL)
{
s_st->step = 0;
continue;
}
}
else
(*dbt)(s_st); // prokrutka vkluchena
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);
upst->step = --s_st->step;
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);
free(s_st);
return;
}
char try_0[] = {Z3 'T', 'R', 'Y', (char)3};
G_L_B uint8_t refalab_try = '\122';
void (*try_1)(void) = try_;
Опишем на Си первичные функции для работы со статическими и динамическими ящиками.
// new, gtr, rdr, ptr, wtr, swr
#include "refalab.h"
#define N_SWAP 0116
static bool enter(bool emp, T_LINKCB **pp, T_LINKCB **rp)
{
T_LINKCB *r = refal.preva->next;
if (r == refal.nexta)
return false;
if (emp && r->next != refal.nexta)
return true;
T_LINKCB *p;
if (r->tag == TAGR)
p = r->info.codep;
else if (r->tag == TAGF)
{
const uint8_t *q = r->info.codef;
if (*q != N_SWAP)
return false;
q++;
p = (T_LINKCB *)q;
if (p->prev == NULL)
{
p->next = p;
p->prev = p->next;
p->info.codep = refal.svar;
p->tag = TAGO;
refal.svar = p;
}
}
else
return false;
*pp = p;
*rp = r;
return true;
}
static void new_(void)
{
if (!lins(refal.prevr, 1))
{
refal.upshot = 3;
return;
}; // LACK
T_LINKCB *r = refal.prevr->next;
r->info.codep = refal.preva;
r->tag = TAGR;
T_LINKCB *p = refal.nexta->prev;
p->next = refal.preva;
refal.preva->prev = p;
refal.nextr->next = refal.nexta;
refal.nexta->prev = refal.nextr;
refal.preva->info.codep = refal.dvar;
refal.preva->tag = TAGO;
refal.dvar = refal.preva;
return;
}
char new_0[] = {Z3 'N', 'E', 'W', (char)3};
G_L_B uint8_t refalab_new = '\122';
void (*new_1)(void) = new_;
static void gtr_(void)
{
const bool emp = true;
T_LINKCB *p = NULL, *r;
if (!enter(emp, &p, &r))
{
refal.upshot = 2;
return;
}; // FAIL
rftpl(refal.prevr, p, p);
return;
}
char gtr_0[] = {Z3 'G', 'T', 'R', (char)3};
G_L_B uint8_t refalab_gtr = '\122';
void (*gtr_1)(void) = gtr_;
static void rdr_(void)
{
const bool emp = true;
T_LINKCB *p = NULL, *r;
if (!enter(emp, &p, &r))
{
refal.upshot = 2;
return;
}; // FAIL
if (!lcopy(refal.prevr, p, p))
{
refal.upshot = 3;
return;
}; // LACK
return;
}
char rdr_0[] = {Z3 'R', 'D', 'R', (char)3};
G_L_B uint8_t refalab_rdr = '\122';
void (*rdr_1)(void) = rdr_;
static void ptr_(void)
{
const bool emp = false;
T_LINKCB *p, *r;
if (!enter(emp, &p, &r))
{
refal.upshot = 2;
return;
}; // FAIL
T_LINKCB *q = p->prev;
rftpl(q, r, refal.nexta);
return;
}
char ptr_0[] = {Z3 'P', 'T', 'R', (char)3};
G_L_B uint8_t refalab_ptr = '\122';
void (*ptr_1)(void) = ptr_;
static void wtr_(void)
{
const bool emp = false;
T_LINKCB *p, *r;
if (!enter(emp, &p, &r))
{
refal.upshot = 2;
return;
}; // FAIL
rfdel(p, p);
rftpl(p, r, refal.nexta);
return;
}
char wtr_0[] = {Z3 'W', 'T', 'R', (char)3};
G_L_B uint8_t refalab_wtr = '\122';
void (*wtr_1)(void) = wtr_;
static void swr_(void)
{
const bool emp = false;
T_LINKCB *p, *r;
if (!enter(emp, &p, &r))
{
refal.upshot = 2;
return;
}; // FAIL
rftpl(refal.prevr, p, p);
rftpl(p, r, refal.nexta);
return;
}
char swr_0[] = {Z3 'S', 'W', 'R', (char)3};
G_L_B uint8_t refalab_swr = '\122';
void (*swr_1)(void) = swr_;
Опции интерпретатора служат для установки режимов работы интерпретатора языка сборки. При запуске программы данные опции устанавливаются в значения по умолчанию.
Список опций:
Опции можно переопределить с помощью аргумента командной строки “–rfinteropt”, за которым без пробелов следуют значения опций.
Допускаются следующие значения опций:
НАЗНАЧЕНИЕ:
Сохранение аргументов командной строки при запуске программы.
ОБЪЯВЛЕНИЕ: extern void rfgetargs(int argc, char *argv[]);
ОБРАЩЕНИЕ: rfgetargs(argc, argv);
ИСПОЛЬЗОВАНИЕ:
Аргументы командной строки сохраняются при запуске программы для дальнейшей работы. Также ищет аргумент командной строки для переопределения опций интерпретатора и переопределяет их. Запускается до инициализации общего блока refal. Если не запускается, то аргументы командной строки в общем блоке refal отсутствуют и опции интерпретатора остаются по умолчанию.
ИСХОДНЫЙ ТЕКСТ:
void rfgetargs(int argc, char *argv[])
{
gargc = (size_t)argc;
gargv = argv;
for (size_t i = 1; i < gargc; i++)
if (strncmp(gargv[i], "--rfinteropt", 12) == 0)
{
if (strstr(&gargv[i][12], "-tmoff") != NULL)
options.tmon = false;
break;
}
return;
}