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, результат будет false).

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, результат будет true).

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".

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

Этот первый тривиальный пример вызовет подпрограмму 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(). Это менее эффективно, если вы помещаете несколько значений.

   См. "XSUBs и стек аргументов" в perlguts для получения подробной информации о том, как работают макросы PUSH.

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, которая вычисляет разность своих 2 параметров. Если результат будет отрицательным, подпрограмма вызывает 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 довольно быстро после завершения обратного вызова, то совершенно необязательно явным образом освобождать любые временные объекты, которые вы могли создать. Тем не менее, если у вас есть какие-либо сомнения относительно того, что делать, не помешает выполнить очистку.

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

Возможная одна из самых сложных проблем при проектировании интерфейса обратного вызова — это определение способа хранения соответствия между функцией обратного вызова 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.