perlcall

СОДЕРЖАНИЕ

• ИМЯ
• ОПИСАНИЕ
• ФУНКЦИИ CALL_
• ЗНАЧЕНИЯ ФЛАГОВ
  • G_VOID
  • G_SCALAR
  • G_LIST
  • G_DISCARD
  • G_NOARGS
  • G_EVAL
  • G_KEEPERR
  • Определение контекста
• ПРИМЕРЫ
  • Без параметров, ничего не возвращается
  • Передача параметров
  • Возврат скаляра
  • Возврат списка значений
  • Возврат списка в скалярном контексте
  • Возврат данных из Perl через список параметров
  • Использование G_EVAL
  • Использование G_KEEPERR
  • Использование call_sv
  • Использование call_argv
  • Использование call_method
  • Использование GIMME_V
  • Использование Perl для освобождения временных объектов
  • Стратегии хранения информации о контексте обратного вызова
  • Альтернативное управление стеком
  • Создание и вызов анонимной подпрограммы в C
• ЛЕГКОВЕСНЫЕ ОБРАТНЫЕ ВЫЗОВЫ
• СМОТРИТЕ ТАКЖЕ
• АВТОР
• ДАТА

ИМЯ

perlcall - Соглашения Perl для вызовов из C

ОПИСАНИЕ

Этот документ демонстрирует, как вызывать подпрограммы Perl напрямую из C, т.е. как писать обратные вызовы.

Помимо обсуждения интерфейса C, предоставляемого Perl для написания обратных вызовов, документ использует серию примеров, чтобы продемонстрировать, как этот интерфейс работает на практике. Кроме того, рассматриваются некоторые приемы программирования обратных вызовов.

Примеры, где необходимы обратные вызовы:

• Обработчик ошибок

  Вы создали интерфейс XSUB для C-API приложения.

  Довольно распространенной функцией в приложениях является возможность определить C-функцию, которая будет вызываться всякий раз, когда происходит что-то неприятное. Желательно указать подпрограмму Perl, которая будет вызвана вместо неё.

• Программа с обработкой событий

  Классический пример использования обратных вызовов — это программирование с обработкой событий, например, для приложения X11. В этом случае вы регистрируете функции, которые будут вызываться всякий раз, когда возникают определённые события, например, нажатие кнопки мыши, перемещение курсора в окно или выбор пункта меню.

Хотя описанные здесь методы применимы при встраивании Perl в программу C, это не основная цель данного документа. Существуют другие детали, которые необходимо учитывать, специфичные для встраивания Perl. Подробную информацию о встраивании Perl в C см. в perlembed.

Прежде чем погрузиться в остальную часть документа, рекомендуется ознакомиться со следующими двумя документами — perlxs и perlguts.

ФУНКЦИИ CALL_

Хотя всё это легче объяснить на примерах, сначала нужно ознакомиться с несколькими важными определениями.

Perl предоставляет ряд C-функций для вызова подпрограмм Perl. Это:

I32 call_sv(SV* sv, I32 flags);
I32 call_pv(char *subname, I32 flags);
I32 call_method(char *methname, I32 flags);
I32 call_argv(char *subname, I32 flags, char **argv);

Ключевой функцией является call_sv. Все остальные функции являются простыми обёртками, которые облегчают вызов подпрограмм Perl в особых случаях. В конечном счете, они все вызывают call_sv для вызова подпрограммы Perl.

Все функции call_* имеют параметр flags, который используется для передачи бита маски опций Perl. Эта маска работает одинаково для каждой функции. Доступные настройки маски обсуждаются в "ЗНАЧЕНИЯ ФЛАГОВ".

Теперь каждая функция будет рассмотрена по отдельности.

call_sv

call_sv принимает два параметра. Первый, sv, является SV*. Это позволяет вам указать подпрограмму Perl, либо как C-строку (которая предварительно преобразована в SV), либо как ссылку на подпрограмму. В разделе "Использование call_sv" показано, как использовать call_sv.

call_pv

Функция call_pv похожа на call_sv, за исключением того, что её первый параметр должен быть C char*, идентифицирующим подпрограмму Perl, которую вы хотите вызвать, например, call_pv("fred", 0). Если подпрограмма, которую вы хотите вызвать, находится в другом пакете, просто включите имя пакета в строку, например, "pkg::fred".

call_method

Функция call_method используется для вызова метода из класса Perl. Параметр methname соответствует имени вызываемого метода. Обратите внимание, что класс, к которому принадлежит метод, передаётся в стек Perl, а не в список параметров. Этот класс может быть либо именем класса (для статического метода), либо ссылкой на объект (для виртуального метода). Дополнительную информацию о статических и виртуальных методах см. в perlobj, а пример использования call_method см. в "Использование call_method".

call_argv

call_argv вызывает подпрограмму Perl, указанную C-строкой в параметре subname. Она также принимает обычный параметр flags. Последний параметр, argv, содержит нуль-терминированный список C-строк, которые будут переданы в качестве параметров подпрограмме Perl. См. "Использование call_argv".

Все функции возвращают целое число. Это количество элементов, возвращённых подпрограммой Perl. Фактические возвращаемые элементы хранятся в стеке Perl.

Как правило, вы всегда должны проверять возвращаемое значение этих функций. Даже если вы ожидаете определённое количество значений от подпрограммы Perl, ничего не мешает кому-то сделать что-то неожиданное — не говорите, что вас не предупреждали.

ЗНАЧЕНИЯ ФЛАГОВ

Параметр flags во всех функциях call_* — это одно из G_VOID, G_SCALAR, или G_LIST, указывающие контекст вызова, или битовая маска с любым сочетанием других символов G_*, определённых ниже.

G_VOID

Вызывает подпрограмму Perl в контексте void.

Этот флаг имеет 2 эффекта:

1. Он указывает подпрограмме, что она выполняется в контексте void (если она выполняет wantarray, результат будет неопределённым).

2. Он гарантирует, что из подпрограммы ничего не возвращается.

Возвращаемое значение функцией call_* указывает, сколько элементов вернула подпрограмма Perl — в данном случае это будет 0.

G_SCALAR

Вызывает подпрограмму Perl в скалярном контексте. Это контекст по умолчанию для всех функций call_*.

Этот флаг имеет 2 эффекта:

1. Он указывает подпрограмме, что она выполняется в скалярном контексте (если она выполняет wantarray, результат будет ложью).

2. Он гарантирует, что из подпрограммы возвращается только скаляр. Конечно, подпрограмма может игнорировать wantarray и вернуть список. В этом случае будет возвращён только последний элемент списка.

Возвращаемое значение функцией call_* указывает, сколько элементов вернула подпрограмма Perl — в этом случае это будет либо 0, либо 1.

Если 0, то вы указали флаг G_DISCARD.

Если 1, то возвращаемый элемент подпрограммы Perl будет сохранён в стеке Perl — раздел "Возврат скаляра" показывает, как получить это значение из стека. Помните, что независимо от того, сколько элементов возвращает подпрограмма Perl, доступен только последний — представьте случай, когда возвращается только одно значение, как список с одним элементом. Любые другие возвращаемые элементы не будут существовать к моменту возврата управления из функции call_*. Раздел "Возврат списка в скалярном контексте" показывает пример этого поведения.

G_LIST

Вызывает подпрограмму Perl в списочном контексте. До версии Perl 5.35.1 это называлось G_ARRAY.

Как и в случае с G_SCALAR, этот флаг имеет 2 эффекта:

1. Он указывает подпрограмме, что она выполняется в списочном контексте (если она выполняет wantarray, результат будет истинным).

2. Он гарантирует, что все элементы, возвращённые из подпрограммы, будут доступны при возврате управления из функции call_*.

Возвращаемое значение функцией call_* указывает, сколько элементов вернула подпрограмма Perl.

Если 0, то вы указали флаг G_DISCARD.

Если не 0, то это счётчик элементов, возвращённых подпрограммой. Эти элементы будут сохранены в стеке Perl. Раздел "Возврат списка значений" показывает пример использования флага G_LIST и механизма доступа к возвращаемым элементам из стека Perl.

G_DISCARD

По умолчанию функции call_* помещают возвращаемые элементы из подпрограммы Perl в стек. Если эти элементы не нужны, установка этого флага заставит Perl автоматически их удалить. Обратите внимание, что контекст подпрограммы Perl всё равно можно указать, используя либо G_SCALAR, либо G_LIST.

Если вы не устанавливаете этот флаг, то очень важно убедиться, что все временные переменные (т.е., параметры, передаваемые Perl-подпрограмме, и значения, возвращаемые из подпрограммы) удаляются вами. Раздел "Возврат скаляра" содержит подробности о том, как явно удалить эти временные переменные, а раздел "Использование Perl для удаления временных переменных" обсуждает конкретные ситуации, когда вы можете игнорировать эту проблему и позволить Perl справиться с ней за вас.

G_NOARGS

Всякий раз, когда Perl-подпрограмма вызывается с помощью одной из функций call_*, по умолчанию предполагается, что параметры будут переданы подпрограмме. Если вы не передаете параметры Perl-подпрограмме, вы можете немного сэкономить время, установив этот флаг. Он повлияет на то, что массив @_ для Perl-подпрограммы не будет создаваться.

Хотя функциональность, предоставляемая этим флагом, может показаться простой, его следует использовать только в том случае, если есть веская причина. Причина осторожности заключается в том, что даже если вы указали флаг G_NOARGS, Perl-подпрограмма, которая была вызвана, всё ещё может предположить, что вы передали ей параметры.

Фактически, может произойти так, что Perl-подпрограмма, которую вы вызвали, может получить доступ к массиву @_ из предыдущей Perl-подпрограммы. Это произойдёт, когда код, выполняющий функцию call_*, сам был вызван из другой Perl-подпрограммы. Приведенный ниже код иллюстрирует это

sub fred
  { print "@_\n"  }

sub joe
  { &fred }

&joe(1,2,3);

Это выведет

1 2 3

Что произошло, так это то, что fred обращается к массиву @_, который принадлежит joe.

G_EVAL

Возможна ситуация, когда вызываемая Perl-подпрограмма завершается аномально, например, явно вызвав die или не существуя вообще. По умолчанию при возникновении любого из этих событий процесс немедленно завершается. Если вы хотите перехватить этот тип события, укажите флаг G_EVAL. Он поместит eval { } вокруг вызова подпрограммы.

Всякий раз, когда управление возвращается из функции call_*, вам нужно проверить переменную $@, как вы это делали бы в обычном Perl-скрипте.

Возвращаемое значение от функции call_* зависит от того, какие другие флаги были установлены, и от того, произошла ли ошибка. Вот все возможные случаи:

• Если функция call_* возвращается нормально, то возвращаемое значение будет таким, как указано в предыдущих разделах.

• Если указан G_DISCARD, возвращаемое значение всегда будет 0.

• Если указан G_LIST и произошла ошибка, возвращаемое значение всегда будет 0.

• Если указан G_SCALAR и произошла ошибка, возвращаемое значение будет 1, а значение на вершине стека будет undef. Это означает, что если вы уже обнаружили ошибку, проверив $@, и хотите, чтобы программа продолжила выполнение, вы должны помнить, чтобы удалить undef со стека.

Подробности использования G_EVAL см. в "Использовании G_EVAL".

G_KEEPERR

Использование флага G_EVAL, описанного выше, всегда устанавливает $@: очищая его, если ошибки не было, и устанавливая его, чтобы описать ошибку, если в вызываемом коде была ошибка. Это то, что вам нужно, если вы намерены обрабатывать возможные ошибки, но иногда вы просто хотите перехватывать ошибки и предотвращать их вмешательство в остальную часть программы.

Эта ситуация будет в основном применима к коду, который предназначен для вызова изнутри деструкторов, асинхронных обратных вызовов и обработчиков сигналов. В таких ситуациях, когда вызываемый код слабо связан с окружающим динамическим контекстом, основной программе необходимо изолировать себя от ошибок в вызываемом коде, даже если они не могут быть обработаны разумно. Это также может быть полезно для кода для __DIE__ или __WARN__ хуков и tie функций.

Флаг G_KEEPERR предназначен для совместного использования с G_EVAL в функциях call_*, которые используются для реализации такого кода, или с eval_sv. Этот флаг не оказывает никакого влияния на функции call_* при отсутствии G_EVAL.

Когда используется G_KEEPERR, любая ошибка в вызываемом коде завершит вызов как обычно, и ошибка не будет распространяться за пределы вызова (как обычно для G_EVAL), но она не будет помещена в $@. Вместо этого ошибка будет преобразована в предупреждение, дополненное строкой "\t(в очистке)". Это можно отключить, используя no warnings 'misc'. Если ошибки не было, $@ не будет очищен.

Обратите внимание, что флаг G_KEEPERR не распространяется во внутренние eval; они по-прежнему могут устанавливать $@.

Флаг G_KEEPERR был добавлен в Perl версии 5.002.

Пример ситуации, требующей использования этого флага, см. в "Использовании G_KEEPERR".

Определение контекста

Как упоминалось выше, вы можете определить контекст текущей подпрограммы в Perl с помощью wantarray. Эквивалентная проверка может быть выполнена в C с помощью макроса GIMME_V, который возвращает G_LIST, если вы были вызваны в списочном контексте, G_SCALAR, если в скалярном контексте, или G_VOID, если в пустом контексте (т.е. возвращаемое значение не будет использоваться). Более старая версия этого макроса называется GIMME; в пустом контексте она возвращает G_SCALAR вместо G_VOID. Пример использования макроса GIMME_V показан в разделе "Использовании GIMME_V".

ПРИМЕРЫ

Достаточно определений! Давайте рассмотрим несколько примеров.

Perl предоставляет множество макросов для работы со стеком Perl. По возможности, эти макросы всегда следует использовать при взаимодействии с внутренностями Perl. Мы надеемся, что это сделает код менее уязвимым к изменениям в Perl в будущем.

Ещё один важный момент заключается в том, что в первом наборе примеров я использовал только функцию call_pv. Это было сделано для упрощения кода и более плавного вхождения в тему. По возможности, если выбор стоит между call_pv и call_sv, вы всегда должны пытаться использовать call_sv. Подробнее об использовании call_sv см. в "Использовании call_sv".

Без параметров, ничего не возвращается

В этом первом тривиальном примере будет вызвана Perl-подпрограмма PrintUID, чтобы вывести UID процесса.

sub PrintUID
{
    print "UID is $<\n";
}

и вот функция C для её вызова

static void
call_PrintUID()
{
    dSP;

    PUSHMARK(SP);
    call_pv("PrintUID", G_DISCARD|G_NOARGS);
}

Просто, не так ли?

Несколько замечаний по этому примеру:

1. Проигнорируйте dSP и PUSHMARK(SP) пока. Они будут рассмотрены в следующем примере.

2. Мы не передаем никаких параметров в PrintUID, поэтому можно использовать G_NOARGS.

3. Мы не заинтересованы ни в чем, возвращаемом PrintUID, поэтому используется G_DISCARD. Даже если PrintUID была изменена для возврата некоторых значений, использование G_DISCARD означает, что они будут удалены к моменту возврата управления из call_pv.

4. Так как используется call_pv, Perl-подпрограмма задаётся как строка C. В этом случае имя подпрограммы жёстко запрограммировано в коде.

5. Поскольку мы указали G_DISCARD, нет необходимости проверять возвращаемое значение call_pv. Оно всегда будет 0.

Передача параметров

Теперь давайте рассмотрим немного более сложный пример. На этот раз мы хотим вызвать Perl-подпрограмму, LeftString, которая будет принимать 2 параметра — строку ($s) и целое число ($n). Подпрограмма просто выведет первые $n символов строки.

Итак, Perl-подпрограмма будет выглядеть так:

sub LeftString
{
    my($s, $n) = @_;
    print substr($s, 0, $n), "\n";
}

Функция C, необходимая для вызова LeftString, будет выглядеть так:

static void
call_LeftString(a, b)
char * a;
int b;
{
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSVpv(a, 0)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    call_pv("LeftString", G_DISCARD);

    FREETMPS;
    LEAVE;
}

Вот несколько замечаний о функции C call_LeftString.

1. Параметры передаются подпрограмме Perl с помощью стека Perl. Это цель кода, начиная с строки dSP и заканчивая строкой PUTBACK. dSP объявляет локальную копию указателя стека. К этой локальной копии следует всегда обращаться как к SP.

2. Если вы собираетесь поместить что-то в стек Perl, вам нужно знать, куда его поместить. Для этого предназначен макрос dSP — он объявляет и инициализирует локальную копию указателя стека Perl.

   Все остальные макросы, которые будут использованы в этом примере, требуют предварительного использования этого макроса.

   Исключением из этого правила является вызов подпрограммы Perl непосредственно из функции XSUB. В этом случае не обязательно использовать макрос dSP явно — он будет объявлен автоматически.

3. Любые параметры, которые необходимо поместить в стек, должны быть заключены в макросы PUSHMARK и PUTBACK. В данном контексте эти два макроса предназначены для автоматического подсчёта количества параметров, которые вы помещаете. Тогда, когда Perl создаёт массив @_ для подпрограммы, он знает, какой размер ему присвоить.

   Макрос PUSHMARK сообщает Perl запомнить текущий указатель стека. Даже если вы не передаёте никаких параметров (как в примере, показанном в разделе "Без параметров, ничего не возвращается"), вы по-прежнему должны вызвать макрос PUSHMARK перед вызовом любых функций call_* — Perl всё равно должен знать, что параметров нет.

   Макрос PUTBACK устанавливает глобальную копию указателя стека в соответствии с нашей локальной копией. Если мы этого не сделаем, call_pv не узнает, где находятся два параметра, которые мы поместили в стек — помните, что до сих пор все манипуляции с указателем стека проводились с нашей локальной копией, а не с глобальной.

4. Далее мы переходим к EXTEND и PUSH. Здесь параметры фактически помещаются в стек. В данном случае мы помещаем строку и целое число.

   В качестве альтернативы можно использовать макрос XPUSHs(), который объединяет EXTEND(SP, 1) и PUSHs(). Это менее эффективно, если вы помещаете несколько значений.

   Подробности о работе макросов PUSH см. в разделе "XSUBs и стек аргументов" в perlguts.

5. Поскольку мы создали временные значения (с помощью вызовов sv_2mortal()), нам необходимо привести в порядок стек Perl и удалить смертельные SVs.

   Это цель

   ENTER;
   SAVETMPS;

   в начале функции и

   FREETMPS;
   LEAVE;

   в конце. Пара ENTER/SAVETMPS создаёт границу для всех временных значений, которые мы создаём. Это означает, что временные значения, которые мы удаляем, будут ограничены теми, которые были созданы после этих вызовов.

   Пара FREETMPS/LEAVE удалит любые значения, возвращённые подпрограммой Perl (см. следующий пример), а также удалит смертельные SVs, которые мы создали. Использование ENTER/SAVETMPS в начале кода гарантирует, что другие смертельные значения не будут уничтожены.

   Представьте себе, что эти макросы работают как { и } в Perl, чтобы ограничить область действия локальных переменных.

   Подробности об альтернативах использованию этих макросов см. в разделе "Использование Perl для удаления временных значений".

6. Наконец, к LeftString можно теперь обратиться через функцию call_pv. Единственный указанный флаг — G_DISCARD. Поскольку мы передаём 2 параметра подпрограмме Perl, мы не указали G_NOARGS.

Возвращение скалярного значения

Теперь пример работы со значениями, возвращаемыми подпрограммой Perl.

Вот подпрограмма Perl, Adder, которая принимает 2 целых параметра и просто возвращает их сумму.

sub Adder
{
    my($a, $b) = @_;
    $a + $b;
}

Поскольку мы теперь работаем со значением, возвращаемым Adder, функция C, необходимая для её вызова, стала немного сложнее.

static void
call_Adder(a, b)
int a;
int b;
{
    dSP;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("Adder", G_SCALAR);

    SPAGAIN;

    if (count != 1)
        croak("Big trouble\n");

    printf ("The sum of %d and %d is %d\n", a, b, POPi);

    PUTBACK;
    FREETMPS;
    LEAVE;
}

Следует обратить внимание на следующие моменты:

1. Единственный указанный флаг — G_SCALAR. Это означает, что массив @_ будет создан, и значение, возвращённое Adder, сохранится после вызова call_pv.

2. Цель макроса SPAGAIN — обновить локальную копию указателя стека. Это необходимо, так как возможно, что память, выделенная для стека Perl, была перераспределена во время вызова call_pv.

   Если вы используете указатель стека Perl в своём коде, вы всегда должны обновлять локальную копию с помощью SPAGAIN всякий раз, когда используете функции call_* или любые другие внутренние функции Perl.

3. Хотя ожидалось, что Adder вернёт только одно значение, всё равно рекомендуется проверять код возврата call_pv.

   Ожидание единственного значения не равнозначно уверенности, что его будет ровно одно. Если кто-то изменил Adder так, чтобы она возвращала список, и мы не проверили эту возможность и не предприняли соответствующих действий, стек Perl окажется в несогласованном состоянии. Этого категорически следует избегать.

4. Здесь используется макрос POPi для извлечения значения возврата из стека. В данном случае нам нужно было целое число, поэтому использовался POPi.

   Вот полный список доступных макросов POP и типы значений, которые они возвращают.

   POPs        SV
   POPp        pointer (PV)
   POPpbytex   pointer to bytes (PV)
   POPn        double (NV)
   POPi        integer (IV)
   POPu        unsigned integer (UV)
   POPl        long
   POPul       unsigned long

   Поскольку эти макросы имеют побочные эффекты, не используйте их в качестве аргументов макросам, которые могут несколько раз оценивать свой аргумент, например:

   /* Bad idea, don't do this */
   STRLEN len;
   const char *s = SvPV(POPs, len);

   Вместо этого используйте временную переменную:

   STRLEN len;
   SV *sv = POPs;
   const char *s = SvPV(sv, len);

   или макрос, гарантирующий, что аргументы будут оценены только один раз:

   STRLEN len;
   const char *s = SvPVx(POPs, len);

5. Окончательный PUTBACK используется для сохранения стека Perl в согласованном состоянии перед выходом из функции. Это необходимо, потому что при извлечении значения возврата из стека с помощью POPi обновляется только наша локальная копия указателя стека. Помните, что PUTBACK устанавливает глобальный указатель стека в соответствии с нашей локальной копией.

Возвращение списка значений

Теперь давайте расширим предыдущий пример, чтобы возвращать как сумму параметров, так и разность.

Вот подпрограмма Perl

sub AddSubtract
{
   my($a, $b) = @_;
   ($a+$b, $a-$b);
}

и функция C

static void
call_AddSubtract(a, b)
int a;
int b;
{
    dSP;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("AddSubtract", G_LIST);

    SPAGAIN;

    if (count != 2)
        croak("Big trouble\n");

    printf ("%d - %d = %d\n", a, b, POPi);
    printf ("%d + %d = %d\n", a, b, POPi);

    PUTBACK;
    FREETMPS;
    LEAVE;
}

Если call_AddSubtract вызывается так

call_AddSubtract(7, 4);

то вот результат

7 - 4 = 3
7 + 4 = 11

Примечания

1. Нам нужен контекст списка, поэтому использовался G_LIST.

2. Неудивительно, что POPi используется дважды в этот раз, так как мы получаем 2 значения из стека. Важно отметить, что при использовании макросов POP* они извлекаются из стека в обратном порядке.

Возвращение списка в скалярном контексте

Предположим, подпрограмма Perl из предыдущего раздела вызывалась в скалярном контексте, как показано ниже

static void
call_AddSubScalar(a, b)
int a;
int b;
{
    dSP;
    int count;
    int i;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("AddSubtract", G_SCALAR);

    SPAGAIN;

    printf ("Items Returned = %d\n", count);

    for (i = 1; i <= count; ++i)
        printf ("Value %d = %d\n", i, POPi);

    PUTBACK;
    FREETMPS;
    LEAVE;
}

Другое изменение заключается в том, что call_AddSubScalar выведет количество элементов, возвращённых из подпрограммы Perl, и их значения (для простоты предполагается, что это целые числа). Таким образом, если call_AddSubScalar вызывается так

call_AddSubScalar(7, 4);

то вывод будет

Items Returned = 1
Value 1 = 3

В этом случае основное, на что нужно обратить внимание, состоит в том, что из подпрограммы возвращается только последний элемент списка. AddSubtract фактически вернулась к call_AddSubScalar.

Возвращение данных из Perl через список параметров

Возвращать значения непосредственно через список параметров также возможно, хотя это не всегда желательно.

Подпрограмма Perl Inc ниже принимает 2 параметра и увеличивает каждый из них напрямую.

sub Inc
{
    ++ $_[0];
    ++ $_[1];
}

и вот функция C для её вызова:

static void
call_Inc(a, b)
int a;
int b;
{
    dSP;
    int count;
    SV * sva;
    SV * svb;

    ENTER;
    SAVETMPS;

    sva = sv_2mortal(newSViv(a));
    svb = sv_2mortal(newSViv(b));

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sva);
    PUSHs(svb);
    PUTBACK;

    count = call_pv("Inc", G_DISCARD);

    if (count != 0)
        croak ("call_Inc: expected 0 values from 'Inc', got %d\n",
               count);

    printf ("%d + 1 = %d\n", a, SvIV(sva));
    printf ("%d + 1 = %d\n", b, SvIV(svb));

    FREETMPS;
    LEAVE;
}

Чтобы получить доступ к двум параметрам, которые были помещены в стек после возврата из call_pv, необходимо запомнить их адреса — таким образом используются две переменные sva и svb.

Причина, по которой это необходимо, заключается в том, что область стека Perl, которая содержала эти переменные, скорее всего, будет перезаписана чем-то другим к тому моменту, когда управление вернётся из call_pv.

Использование G_EVAL

Теперь пример использования G_EVAL. Ниже приведена подпрограмма Perl, которая вычисляет разницу между её двумя параметрами. Если результат будет отрицательным, подпрограмма вызывает die.

sub Subtract
{
    my ($a, $b) = @_;

    die "death can be fatal\n" if $a < $b;

    $a - $b;
}

и код C для её вызова

static void
call_Subtract(a, b)
int a;
int b;
{
    dSP;
    int count;
    SV *err_tmp;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("Subtract", G_EVAL|G_SCALAR);

    SPAGAIN;

    /* Check the eval first */
    err_tmp = ERRSV;
    if (SvTRUE(err_tmp))
    {
        printf ("Uh oh - %s\n", SvPV_nolen(err_tmp));
        POPs;
    }
    else
    {
      if (count != 1)
       croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n",
             count);

        printf ("%d - %d = %d\n", a, b, POPi);
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
}

Если call_Subtract вызывается таким образом

call_Subtract(4, 5)

будет напечатано следующее

Uh oh - death can be fatal

Примечания

1. Мы хотим быть в состоянии перехватить die, поэтому мы использовали флаг G_EVAL. Если этот флаг не указать, программа завершится сразу же при выполнении оператора die в подпрограмме Subtract.

2. Код

   err_tmp = ERRSV;
   if (SvTRUE(err_tmp))
   {
       printf ("Uh oh - %s\n", SvPV_nolen(err_tmp));
       POPs;
   }

   является прямым эквивалентом этой части Perl

   print "Uh oh - $@\n" if $@;

   PL_errgv — это глобальная переменная Perl типа GV *, которая указывает на запись в таблице символов, содержащую ошибку. ERRSV , следовательно, относится к C-эквиваленту $@ . Мы используем локальную временную переменную err_tmp, так как ERRSV — это макрос, который вызывает функцию, и SvTRUE(ERRSV) приведет к многократному вызову этой функции.

3. Обратите внимание, что стек очищается с помощью POPs в блоке, где SvTRUE(err_tmp) истинно. Это необходимо, так как всякий раз, когда функция call_* вызывается с флагами G_EVAL|G_SCALAR и возвращает ошибку, в верхней части стека находится значение undef. Поскольку мы хотим, чтобы программа продолжала выполняться после обнаружения этой ошибки, необходимо привести стек в согласованное состояние, удалив undef.

Использование G_KEEPERR

Рассмотрим этот довольно шуточный пример, где мы использовали XS-версию примера call_Subtract выше внутри деструктора:

package Foo;
sub new { bless {}, $_[0] }
sub Subtract {
    my($a,$b) = @_;
    die "death can be fatal" if $a < $b;
    $a - $b;
}
sub DESTROY { call_Subtract(5, 4); }
sub foo { die "foo dies"; }

package main;
{
    my $foo = Foo->new;
    eval { $foo->foo };
}
print "Saw: $@" if $@;             # should be, but isn't

Этот пример не сможет распознать, что произошла ошибка внутри eval {}. Вот почему: код call_Subtract был выполнен, в то время как perl очищал временные переменные при выходе из внешнего блока фигурных скобок, и поскольку call_Subtract реализован с помощью call_pv с флагом G_EVAL, он сразу же сбросил $@. Это привело к ошибке внешнего теста на $@, и, как следствие, к ошибке обработки ошибок.

Добавление флага G_KEEPERR, так что вызов call_pv в call_Subtract выглядит как:

count = call_pv("Subtract", G_EVAL|G_SCALAR|G_KEEPERR);

сохранит ошибку и восстановит надёжную обработку ошибок.

Использование call_sv

Во всех предыдущих примерах я «жестко» привязывал имя подпрограммы Perl, которую необходимо вызвать из C. Чаще всего удобнее указывать имя подпрограммы Perl из скрипта Perl, и для этого вам понадобится call_sv.

Рассмотрим приведенный ниже код Perl

sub fred
{
    print "Hello there\n";
}

CallSubPV("fred");

Вот фрагмент XSUB, который определяет CallSubPV.

void
CallSubPV(name)
    char *  name
    CODE:
    PUSHMARK(SP);
    call_pv(name, G_DISCARD|G_NOARGS);

Это нормально, насколько это возможно. Дело в том, что подпрограмму Perl можно указать только как строку, однако Perl позволяет использовать ссылки на подпрограммы и анонимные подпрограммы. Именно здесь пригодится call_sv.

Код ниже для CallSubSV идентичен CallSubPV, за исключением того, что параметр name теперь определен как SV* и мы используем call_sv вместо call_pv.

void
CallSubSV(name)
    SV *    name
    CODE:
    PUSHMARK(SP);
    call_sv(name, G_DISCARD|G_NOARGS);

Поскольку мы используем SV для вызова fred, всё нижеперечисленное можно использовать:

CallSubSV("fred");
CallSubSV(\&fred);
$ref = \&fred;
CallSubSV($ref);
CallSubSV( sub { print "Hello there\n" } );

Как видите, call_sv предоставляет гораздо большую гибкость в том, как вы можете указать подпрограмму Perl.

Следует отметить, что если необходимо сохранить SV (name в примере выше), который соответствует подпрограмме Perl, чтобы использовать его позже в программе, то недостаточно просто сохранить копию указателя на SV. Предположим, код выше был таким:

static SV * rememberSub;

void
SaveSub1(name)
    SV *    name
    CODE:
    rememberSub = name;

void
CallSavedSub1()
    CODE:
    PUSHMARK(SP);
    call_sv(rememberSub, G_DISCARD|G_NOARGS);

Причина, по которой это неправильно, заключается в том, что к моменту использования указателя rememberSub в CallSavedSub1, он может или не может всё ещё ссылаться на подпрограмму Perl, которая была записана в SaveSub1. Это особенно верно для следующих случаев:

SaveSub1(\&fred);
CallSavedSub1();

SaveSub1( sub { print "Hello there\n" } );
CallSavedSub1();

К моменту выполнения каждого из SaveSub1 операторов выше, SV*ы, которые соответствовали параметрам, больше не будут существовать. Ожидайте сообщение об ошибке от Perl следующего вида

Can't use an undefined value as a subroutine reference at ...

для каждой из CallSavedSub1 строк.

Аналогично, с этим кодом

$ref = \&fred;
SaveSub1($ref);
$ref = 47;
CallSavedSub1();

можно ожидать одно из этих сообщений (которое вы фактически получите, зависит от используемой версии Perl)

Not a CODE reference at ...
Undefined subroutine &main::47 called ...

Переменная $ref могла ссылаться на подпрограмму fred всякий раз, когда выполнялся вызов SaveSub1, но к моменту вызова CallSavedSub1 она теперь содержит число 47. Поскольку мы сохранили только указатель на исходный SV в SaveSub1, любые изменения в $ref будут отслеживаться указателем rememberSub. Это означает, что всякий раз, когда CallSavedSub1 вызывается, он попытается выполнить код, на который ссылается SV* rememberSub. В этом случае он теперь ссылается на целое число 47, поэтому ожидайте, что Perl громко пожалуется.

Аналогичная, но более тонкая проблема проиллюстрирована этим кодом:

$ref = \&fred;
SaveSub1($ref);
$ref = \&joe;
CallSavedSub1();

На этот раз всякий раз, когда CallSavedSub1 вызывается, он будет выполнять подпрограмму Perl joe (если она существует), а не fred, как первоначально запрошено в вызове SaveSub1.

Чтобы обойти эти проблемы, необходимо выполнить полную копию SV. Приведенный ниже код демонстрирует SaveSub2 с модификацией для этого.

/* this isn't thread-safe */
static SV * keepSub = (SV*)NULL;

void
SaveSub2(name)
    SV *    name
    CODE:
    /* Take a copy of the callback */
    if (keepSub == (SV*)NULL)
        /* First time, so create a new SV */
        keepSub = newSVsv(name);
    else
        /* Been here before, so overwrite */
        SvSetSV(keepSub, name);

void
CallSavedSub2()
    CODE:
    PUSHMARK(SP);
    call_sv(keepSub, G_DISCARD|G_NOARGS);

Чтобы избежать создания нового SV каждый раз, когда SaveSub2 вызывается, функция сначала проверяет, вызывалась ли она ранее. Если нет, то выделяется место для нового SV и ссылка на подпрограмму Perl name копируется в переменную keepSub в одной операции с помощью newSVsv. После этого, всякий раз когда SaveSub2 вызывается, существующий SV, keepSub, перезаписывается новым значением с использованием SvSetSV.

Примечание: использование статической или глобальной переменной для хранения SV небезопасно в многопоточных средах. Вы можете использовать механизм MY_CXT, документированный в "Безопасное хранение статических данных в XS" в perlxs, что быстро, или хранить значения в глобальных переменных Perl, используя get_sv(), что намного медленнее.

Использование call_argv

Вот подпрограмма Perl, которая выводит все параметры, переданные ей.

sub PrintList
{
    my(@list) = @_;

    foreach (@list) { print "$_\n" }
}

И вот пример call_argv, который вызовет PrintList.

static char * words[] = {"alpha", "beta", "gamma", "delta", NULL};

static void
call_PrintList()
{
    call_argv("PrintList", G_DISCARD, words);
}

Обратите внимание, что в этом случае вызывать PUSHMARK не обязательно. Это потому, что call_argv сделает это за вас.

Использование call_method

Рассмотрим следующий код Perl:

{
    package Mine;

    sub new
    {
        my($type) = shift;
        bless [@_]
    }

    sub Display
    {
        my ($self, $index) = @_;
        print "$index: $$self[$index]\n";
    }

    sub PrintID
    {
        my($class) = @_;
        print "This is Class $class version 1.0\n";
    }
}

Он реализует очень простой класс для управления массивом. Помимо конструктора, new, он объявляет методы, один статический и один виртуальный. Статический метод, PrintID, выводит просто имя класса и номер версии. Виртуальный метод, Display, выводит один элемент массива. Вот пример на чистом Perl, использующий его.

$a = Mine->new('red', 'green', 'blue');
$a->Display(1);
Mine->PrintID;

выведет

1: green
This is Class Mine version 1.0

Вызов метода Perl из C довольно прост. Требуются следующие вещи:

• Ссылка на объект для виртуального метода или имя класса для статического метода

• Имя метода

• Любые другие параметры, специфичные для метода

Вот простой XSUB, который иллюстрирует механику вызова методов PrintID и Display из C.

void
call_Method(ref, method, index)
    SV *    ref
    char *  method
    int             index
    CODE:
    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(ref);
    PUSHs(sv_2mortal(newSViv(index)));
    PUTBACK;

    call_method(method, G_DISCARD);

void
call_PrintID(class, method)
    char *  class
    char *  method
    CODE:
    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(class, 0)));
    PUTBACK;

    call_method(method, G_DISCARD);

Таким образом, методы PrintID и Display можно вызвать следующим образом:

$a = Mine->new('red', 'green', 'blue');
call_Method($a, 'Display', 1);
call_PrintID('Mine', 'PrintID');

Единственное, что нужно отметить, это то, что как в статических, так и в виртуальных методах имя метода не передаётся через стек — оно используется в качестве первого параметра для call_method.

Использование GIMME_V

Вот тривиальный XSUB, который выводит контекст, в котором он выполняется в настоящее время.

void
PrintContext()
    CODE:
    U8 gimme = GIMME_V;
    if (gimme == G_VOID)
        printf ("Context is Void\n");
    else if (gimme == G_SCALAR)
        printf ("Context is Scalar\n");
    else
        printf ("Context is Array\n");

И вот Perl-код для его тестирования.

PrintContext;
$a = PrintContext;
@a = PrintContext;

Вывод от этого будет

Context is Void
Context is Scalar
Context is Array

Использование Perl для освобождения временных объектов

В примерах, приведенных до сих пор, все временные объекты, созданные в обратном вызове (т. е. параметры, передаваемые по стеку в функцию call_* или значения, возвращаемые по стеку), были освобождены одним из этих методов:

• Указание флага G_DISCARD с call_*

• Явное использование пары ENTER/SAVETMPS--FREETMPS/LEAVE

Существует другой метод, который можно использовать, а именно, позволить Perl сделать это автоматически всякий раз, когда он восстанавливает управление после завершения обратного вызова. Это делается путем простого неиспользования

ENTER;
SAVETMPS;
...
FREETMPS;
LEAVE;

последовательности в обратном вызове (и, конечно же, не указания флага G_DISCARD).

Если вы собираетесь использовать этот метод, вы должны быть осведомлены о возможной утечке памяти, которая может возникнуть при очень специфических обстоятельствах. Чтобы объяснить эти обстоятельства, вам нужно немного знать о потоке управления между Perl и процедурой обратного вызова.

Примеры, приведенные в начале документа (обработчик ошибок и программа на основе событий), типичны для двух основных типов потока управления, с которыми вы, вероятно, столкнётесь с обратными вызовами. Существует очень важное различие между ними, так что обратите на это внимание.

В первом примере, обработчик ошибок, поток управления может быть следующим. Вы создали интерфейс к внешней библиотеке. Управление может достичь внешней библиотеки так:

perl --> XSUB --> external library

В то время как управление находится в библиотеке, возникает условие ошибки. Вы предварительно настроили обратный вызов Perl для обработки этой ситуации, поэтому он будет выполнен. После завершения обратного вызова управление вернется обратно в Perl. Вот как будет выглядеть поток управления в этой ситуации

perl --> XSUB --> external library
                  ...
                  error occurs
                  ...
                  external library --> call_* --> perl
                                                      |
perl <-- XSUB <-- external library <-- call_* <----+

После завершения обработки ошибки с помощью call_* управление возвращается обратно в Perl практически немедленно.

На диаграмме чем дальше вы идёте вправо, тем глубже вложенность. Только когда управление возвращается в Perl в крайнем левом положении диаграммы, вы вернётесь к внешней области, и все временные объекты, которые вы оставили, будут освобождены.

Во втором примере, программе на основе событий, поток управления будет выглядеть примерно так

perl --> XSUB --> event handler
                  ...
                  event handler --> call_* --> perl
                                                   |
                  event handler <-- call_* <----+
                  ...
                  event handler --> call_* --> perl
                                                   |
                  event handler <-- call_* <----+
                  ...
                  event handler --> call_* --> perl
                                                   |
                  event handler <-- call_* <----+

В этом случае поток управления может состоять только из повторяющейся последовательности

event handler --> call_* --> perl

практически на протяжении всего времени работы программы. Это означает, что управление может никогда не вернуться в окружающую область Perl в крайнем левом положении.

Так в чём же проблема? Ну, если вы ожидаете, что Perl сам уберёт эти временные объекты, вы можете долго ждать. Чтобы Perl освободил ваши временные объекты, управление должно вернуться в окружающую область Perl на каком-то этапе. В случае на основе событий это может никогда не произойти. Это означает, что с течением времени ваша программа будет создавать всё больше и больше временных объектов, ни один из которых никогда не будет освобождён. Поскольку каждый из этих временных объектов потребляет некоторое количество памяти, ваша программа в конечном итоге израсходует всю доступную память в вашей системе — бабах!

И вот вывод — если вы уверены, что управление вернётся в окружающую область Perl довольно быстро после завершения вашего обратного вызова, то совершенно необязательно явно освобождать все временные объекты, которые вы могли создать. Конечно, если вы сомневаетесь, что нужно сделать, то не помешает всё равно привести порядок.

Стратегии хранения информации о контексте обратного вызова

Возможно, одна из самых сложных проблем, которые нужно преодолеть при проектировании интерфейса обратного вызова, заключается в том, чтобы понять, как сохранить сопоставление между функцией C обратного вызова и эквивалентом Perl.

Чтобы понять, почему это может быть реальной проблемой, сначала рассмотрим, как обратный вызов настраивается в среде только на C. Как правило, API C предоставляет функцию для регистрации обратного вызова. Это ожидает указатель на функцию в качестве одного из своих параметров. Ниже приведен вызов гипотетической функции register_fatal, которая регистрирует функцию C, которая будет вызвана при возникновении фатальной ошибки.

register_fatal(cb1);

Единственный параметр cb1 — указатель на функцию, поэтому вам необходимо определить cb1 в вашем коде, например, так

static void
cb1()
{
    printf ("Fatal Error\n");
    exit(1);
}

Теперь измените это, чтобы вызвать подпрограмму Perl вместо этого

static SV * callback = (SV*)NULL;

static void
cb1()
{
    dSP;

    PUSHMARK(SP);

    /* Call the Perl sub to process the callback */
    call_sv(callback, G_DISCARD);
}


void
register_fatal(fn)
    SV *    fn
    CODE:
    /* Remember the Perl sub */
    if (callback == (SV*)NULL)
        callback = newSVsv(fn);
    else
        SvSetSV(callback, fn);

    /* register the callback with the external library */
    register_fatal(cb1);

где Perl-эквивалент register_fatal и обратный вызов, который он регистрирует, pcb1, могут выглядеть так

# Register the sub pcb1
register_fatal(\&pcb1);

sub pcb1
{
    die "I'm dying...\n";
}

Сопоставление между обратным вызовом C и эквивалентом Perl хранится в глобальной переменной callback.

Это будет достаточно, если вам когда-либо понадобится регистрировать только один обратный вызов за раз. Примером может служить обработчик ошибок, как показано в коде выше. Однако помните, что повторные вызовы register_fatal будут заменять ранее зарегистрированную функцию обратного вызова новой.

Предположим, например, что вы хотите взаимодействовать с библиотекой, которая позволяет выполнять асинхронное ввод/вывод файлов. В этом случае вы можете зарегистрировать обратный вызов всякий раз, когда операция чтения завершена. Чтобы это было полезно, мы хотим иметь возможность вызывать отдельные подпрограммы Perl для каждого открытого файла. Так как есть, пример обработчика ошибок выше не был бы достаточным, так как он позволяет определить только один обратный вызов за раз. Нам нужен способ сохранить сопоставление между открытым файлом и подпрограммой Perl, которую мы хотим вызвать для этого файла.

Скажем, библиотека ввода/вывода имеет функцию asynch_read, которая связывает функцию C ProcessRead с дескриптором файла fh — это предполагает, что она также предоставила некоторую процедуру открытия файла и получения дескриптора файла.

asynch_read(fh, ProcessRead)

Это может ожидать функцию C ProcessRead такого вида

void
ProcessRead(fh, buffer)
int fh;
char *      buffer;
{
     ...
}

Для предоставления Perl-интерфейса к этой библиотеке нам необходимо уметь сопоставлять параметр fh и Perl-подпрограмму, которую мы хотим вызвать. Хэш-таблица является удобным механизмом для хранения этого сопоставления. Ниже приведен пример реализации

static HV * Mapping = (HV*)NULL;

void
asynch_read(fh, callback)
    int     fh
    SV *    callback
    CODE:
    /* If the hash doesn't already exist, create it */
    if (Mapping == (HV*)NULL)
        Mapping = newHV();

    /* Save the fh -> callback mapping */
    hv_store(Mapping, (char*)&fh, sizeof(fh), newSVsv(callback), 0);

    /* Register with the C Library */
    asynch_read(fh, asynch_read_if);

и asynch_read_if может выглядеть так

static void
asynch_read_if(fh, buffer)
int fh;
char *      buffer;
{
    dSP;
    SV ** sv;

    /* Get the callback associated with fh */
    sv =  hv_fetch(Mapping, (char*)&fh , sizeof(fh), FALSE);
    if (sv == (SV**)NULL)
        croak("Internal error...\n");

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(fh)));
    PUSHs(sv_2mortal(newSVpv(buffer, 0)));
    PUTBACK;

    /* Call the Perl sub */
    call_sv(*sv, G_DISCARD);
}

Для полноты, вот asynch_close. Это демонстрирует, как удалить запись из хэш-таблицы Mapping.

void
asynch_close(fh)
    int     fh
    CODE:
    /* Remove the entry from the hash */
    (void) hv_delete(Mapping, (char*)&fh, sizeof(fh), G_DISCARD);

    /* Now call the real asynch_close */
    asynch_close(fh);

Итак, Perl-интерфейс будет выглядеть следующим образом

sub callback1
{
    my($handle, $buffer) = @_;
}

# Register the Perl callback
asynch_read($fh, \&callback1);

asynch_close($fh);

Сопоставление между C-обработчиком и Perl хранится в глобальной хэш-таблице Mapping в этот раз. Использование хэш-таблицы имеет явное преимущество, позволяющее регистрировать неограниченное количество обратных вызовов.

Что делать, если интерфейс, предоставленный C-обработчиком, не содержит параметра, позволяющего сопоставить дескриптор файла и Perl-подпрограмму? Например, в пакете асинхронного ввода-вывода функция обратного вызова получает только параметр buffer так

void
ProcessRead(buffer)
char *      buffer;
{
    ...
}

Без дескриптора файла нет простого способа сопоставить C-обработчик с Perl-подпрограммой.

В этом случае возможный способ решения этой проблемы заключается в предварительной определении ряда C-функций для работы с Perl-интерфейсом, таким образом

#define MAX_CB              3
#define NULL_HANDLE -1
typedef void (*FnMap)();

struct MapStruct {
    FnMap    Function;
    SV *     PerlSub;
    int      Handle;
  };

static void  fn1();
static void  fn2();
static void  fn3();

static struct MapStruct Map [MAX_CB] =
    {
        { fn1, NULL, NULL_HANDLE },
        { fn2, NULL, NULL_HANDLE },
        { fn3, NULL, NULL_HANDLE }
    };

static void
Pcb(index, buffer)
int index;
char * buffer;
{
    dSP;

    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(buffer, 0)));
    PUTBACK;

    /* Call the Perl sub */
    call_sv(Map[index].PerlSub, G_DISCARD);
}

static void
fn1(buffer)
char * buffer;
{
    Pcb(0, buffer);
}

static void
fn2(buffer)
char * buffer;
{
    Pcb(1, buffer);
}

static void
fn3(buffer)
char * buffer;
{
    Pcb(2, buffer);
}

void
array_asynch_read(fh, callback)
    int             fh
    SV *    callback
    CODE:
    int index;
    int null_index = MAX_CB;

    /* Find the same handle or an empty entry */
    for (index = 0; index < MAX_CB; ++index)
    {
        if (Map[index].Handle == fh)
            break;

        if (Map[index].Handle == NULL_HANDLE)
            null_index = index;
    }

    if (index == MAX_CB && null_index == MAX_CB)
        croak ("Too many callback functions registered\n");

    if (index == MAX_CB)
        index = null_index;

    /* Save the file handle */
    Map[index].Handle = fh;

    /* Remember the Perl sub */
    if (Map[index].PerlSub == (SV*)NULL)
        Map[index].PerlSub = newSVsv(callback);
    else
        SvSetSV(Map[index].PerlSub, callback);

    asynch_read(fh, Map[index].Function);

void
array_asynch_close(fh)
    int     fh
    CODE:
    int index;

    /* Find the file handle */
    for (index = 0; index < MAX_CB; ++ index)
        if (Map[index].Handle == fh)
            break;

    if (index == MAX_CB)
        croak ("could not close fh %d\n", fh);

    Map[index].Handle = NULL_HANDLE;
    SvREFCNT_dec(Map[index].PerlSub);
    Map[index].PerlSub = (SV*)NULL;

    asynch_close(fh);

В этом случае функции fn1, fn2, и fn3 используются для запоминания вызываемой Perl-подпрограммы. Каждая из функций содержит отдельный жёстко заданный индекс, который используется в функции Pcb для доступа к массиву Map и фактического вызова Perl-подпрограммы.

Есть некоторые очевидные недостатки этого метода.

Во-первых, код значительно сложнее, чем в предыдущем примере.

Во-вторых, существует жёстко заданный предел (в данном случае 3) для количества обратных вызовов, которые могут существовать одновременно. Единственный способ увеличить этот предел — изменить код, добавив больше функций, и затем перекомпилировать. Тем не менее, при правильном выборе количества функций, это всё ещё работоспособное решение, и в некоторых случаях единственное доступное.

В заключение, вот несколько возможных методов для хранения сопоставления между C и Perl-обработчиком

1. Проигнорировать проблему — Разрешить только 1 обратный вызов

В многих ситуациях, таких как взаимодействие с обработчиком ошибок, это может быть вполне приемлемым решением.

2. Создать последовательность обратных вызовов — жёстко заданный предел

Если невозможно определить контекст из параметров, возвращаемых C-обработчиком, то может потребоваться создать последовательность C-функций обратного вызова и сохранить указатели на каждую из них в массиве.

3. Использовать параметр для сопоставления с Perl-обработчиком

Хэш-таблица является идеальным механизмом для хранения сопоставления между C и Perl.

Альтернативная обработка стека

Хотя я использовал только макросы POP* для доступа к значениям, возвращаемым из Perl-подпрограмм, также можно обойти эти макросы и прочитать стек с помощью макроса ST (см. perlxs для полного описания макроса ST).

В большинстве случаев макросы POP* должны быть достаточными; основная проблема с ними заключается в том, что они заставляют вас обрабатывать возвращаемые значения последовательно. В некоторых случаях это может быть не самым подходящим способом обработки значений. Нам нужно уметь получать доступ к стеку в произвольном порядке. Макрос ST при разработке XSUB является идеальным для этой цели.

Код ниже — это пример, приведенный в разделе "Возвращение списка значений", переписанный с использованием ST вместо POP*.

static void
call_AddSubtract2(a, b)
int a;
int b;
{
    dSP;
    I32 ax;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("AddSubtract", G_LIST);

    SPAGAIN;
    SP -= count;
    ax = (SP - PL_stack_base) + 1;

    if (count != 2)
        croak("Big trouble\n");

    printf ("%d + %d = %d\n", a, b, SvIV(ST(0)));
    printf ("%d - %d = %d\n", a, b, SvIV(ST(1)));

    PUTBACK;
    FREETMPS;
    LEAVE;
}

Примечания

1. Обратите внимание, что необходимо определить переменную ax. Это связано с тем, что макрос ST ожидает, что она существует. Если бы мы находились в XSUB, не было бы необходимости определять ax, так как она уже определена для нас.

2. Код

   SPAGAIN;
   SP -= count;
   ax = (SP - PL_stack_base) + 1;

   настраивает стек таким образом, что мы можем использовать макрос ST.

3. В отличие от исходного кодирования этого примера, возвращаемые значения не считываются в обратном порядке. Поэтому ST(0) относится к первому значению, возвращённому Perl-подпрограммой, а ST(count-1) — к последнему.

Создание и вызов анонимной подпрограммы в C

Как мы уже показали, call_sv можно использовать для вызова анонимной подпрограммы. Однако наш пример показал, как Perl-скрипт вызывает XSUB для выполнения этой операции. Давайте посмотрим, как это можно сделать внутри нашего C-кода:

...

SV *cvrv
   = eval_pv("sub {
               print 'You will not find me cluttering any namespace!'
              }", TRUE);

...

call_sv(cvrv, G_VOID|G_NOARGS);

eval_pv используется для компиляции анонимной подпрограммы, которая также будет возвращаемым значением (подробнее о eval_pv см. "eval_pv" в perlapi). После получения ссылки на этот код, она может быть использована во всех предыдущих примерах.

ЛЕГКОВЕСНЫЕ ОБРАТНЫЕ ВЫЗОВЫ

Иногда требуется многократно вызывать одну и ту же подпрограмму. Это обычно происходит с функцией, которая обрабатывает список значений, такой как встроенная функция Perl sort(). Вы можете передать функцию сравнения в sort(), которая затем будет вызываться для каждой пары значений, которые нужно сравнить. Функции first() и reduce() из List::Util следуют аналогичному шаблону.

В этом случае можно ускорить работу программы (часто довольно существенно) с помощью лёгкого API для обратных вызовов. Идея состоит в том, что контекст вызова должен быть создан и уничтожен только один раз, а подпрограмма может вызываться произвольное количество раз между этими моментами.

Обычно параметры передаются с помощью глобальных переменных (обычно $_ для одного параметра или $a и $b для двух параметров), а не через @_. (Можно использовать механизм @_ если вы знаете, что делаете, но API для этого пока не поддерживается. Он также, по своей природе, медленнее.)

Шаблон вызовов макросов выглядит так:

dMULTICALL;                 /* Declare local variables */
U8 gimme = G_SCALAR;        /* context of the call: G_SCALAR,
                             * G_LIST, or G_VOID */

PUSH_MULTICALL(cv);         /* Set up the context for calling cv,
                               and set local vars appropriately */

/* loop */ {
    /* set the value(s) af your parameter variables */
    MULTICALL;              /* Make the actual call */
} /* end of loop */

POP_MULTICALL;              /* Tear down the calling context */

Для конкретных примеров см. реализацию функций first() и reduce() функций List::Util 1.18. Там вы также найдёте заголовочный файл, который эмулирует API multicall в более старых версиях perl.

См. также

perlxs, perlguts, perlembed

АВТОР

Пол Маркесс

Особая благодарность следующим людям, которые помогли в создании документа.

Джефф Окамото, Тим Банс, Ник Джанниотис, Стив Келем, Гурусами Сарати и Ларри Уолл.

ДАТА

Последнее обновление для perl 5.23.1.