perlcall

СОДЕРЖАНИЕ

• ИМЯ
• ОПИСАНИЕ
• ФУНКЦИИ CALL
• ЗНАЧЕНИЯ ФЛАГОВ
  • G_VOID
  • G_SCALAR
  • G_ARRAY
  • 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 для API приложения C.

  Довольно распространённая функция в приложениях — это возможность определить функцию 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_ARRAY, указывающие контекст вызова, объединённых с маской любых комбинаций других символов 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_ARRAY

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

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

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

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

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

Если 0, то установлен флаг G_DISCARD.

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

G_DISCARD

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

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

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

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, описанный в "Safely Storing Static Data in 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_ARRAY);

    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). После получения этой ссылки на код ее можно использовать во всех предыдущих примерах.

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

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

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

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

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

dMULTICALL;                 /* Declare local variables */
U8 gimme = G_SCALAR;        /* context of the call: G_SCALAR,
                             * G_ARRAY, 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 для множественных вызовов в более старых версиях Perl.

СМОТРИТЕ ТАКЖЕ

perlxs, perlguts, perlembed

АВТОР

Пол Маркесс

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

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

ДАТА

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