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 для 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_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 — обновить локальную копию указателя стека. Это необходимо, так как в процессе вызова call_pv память, выделенная для стека Perl, может быть перераспределена.

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

Лёгкие обратные вызовы

Иногда вам нужно многократно вызывать одну и ту же подпрограмму. Это обычно происходит с функцией, которая обрабатывает список значений, например, встроенная функция 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_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 multicall для более старых версий perl.

См. также

perlxs, perlguts, perlembed

АВТОР

Пол Маркесс

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

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

ДАТА

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