X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pod%2Fperlcall.pod;h=06f3aa33c74755d7b5d0a955d0b15779805ea8f5;hb=4ff31b786b9f6148fc8ea695db081861576d06a2;hp=d072f00967d13e4b190a22768cf8b7134341c7c4;hpb=769c28980682c9f2c20f6c60950b1b28469d23fa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pod/perlcall.pod b/pod/perlcall.pod index d072f00..06f3aa3 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -53,10 +53,10 @@ be aware of a few important definitions. Perl has a number of C functions that allow you to call Perl subroutines. They are - 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, register char **argv) ; + 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, register char **argv); The key function is I. All the other functions are fairly simple wrappers which make it easier to call Perl subroutines in @@ -259,13 +259,11 @@ occur when the code that is executing the I function has itself been called from another Perl subroutine. The code below illustrates this - sub fred { - print "@_\n"; - } + sub fred + { print "@_\n" } - sub joe { - &fred; - } + sub joe + { &fred } &joe(1,2,3); @@ -345,7 +343,11 @@ has no effect when G_EVAL is not used. When G_KEEPERR is used, any errors in the called code will be prefixed with the string "\t(in cleanup)", and appended to the current value -of C<$@>. +of C<$@>. an error will not be appended if that same error string is +already at the end of C<$@>. + +In addition, a warning is generated using the appended string. This can be +disabled using C. The G_KEEPERR flag was introduced in Perl version 5.002. @@ -364,71 +366,6 @@ called C; in a void context it returns C instead of C. An example of using the C macro is shown in section I. -=head1 KNOWN PROBLEMS - -This section outlines all known problems that exist in the -I functions. - -=over 5 - -=item 1. - -If you are intending to make use of both the G_EVAL and G_SCALAR flags -in your code, use a version of Perl greater than 5.000. There is a bug -in version 5.000 of Perl which means that the combination of these two -flags will not work as described in the section I. - -Specifically, if the two flags are used when calling a subroutine and -that subroutine does not call I, the value returned by -I will be wrong. - - -=item 2. - -In Perl 5.000 and 5.001 there is a problem with using I if -the Perl sub you are calling attempts to trap a I. - -The symptom of this problem is that the called Perl sub will continue -to completion, but whenever it attempts to pass control back to the -XSUB, the program will immediately terminate. - -For example, say you want to call this Perl sub - - sub fred { - eval { die "Fatal Error" } - print "Trapped error: $@\n" if $@; - } - -via this XSUB - - void - Call_fred() - CODE: - PUSHMARK(SP) ; - call_pv("fred", G_DISCARD|G_NOARGS) ; - fprintf(stderr, "back in Call_fred\n") ; - -When C is executed it will print - - Trapped error: Fatal Error - -As control never returns to C, the C<"back in Call_fred"> -string will not get printed. - -To work around this problem, you can either upgrade to Perl 5.002 or -higher, or use the G_EVAL flag with I as shown below - - void - Call_fred() - CODE: - PUSHMARK(SP) ; - call_pv("fred", G_EVAL|G_DISCARD|G_NOARGS) ; - fprintf(stderr, "back in Call_fred\n") ; - -=back - - - =head1 EXAMPLES Enough of the definition talk, let's have a few examples. @@ -450,8 +387,9 @@ I for details. This first trivial example will call a Perl subroutine, I, to print out the UID of the process. - sub PrintUID { - print "UID is $<\n"; + sub PrintUID + { + print "UID is $<\n"; } and here is a C function to call it @@ -459,10 +397,10 @@ and here is a C function to call it static void call_PrintUID() { - dSP ; + dSP; - PUSHMARK(SP) ; - call_pv("PrintUID", G_DISCARD|G_NOARGS) ; + PUSHMARK(SP); + call_pv("PrintUID", G_DISCARD|G_NOARGS); } Simple, eh. @@ -510,32 +448,33 @@ print the first $n characters of the string. So the Perl subroutine would look like this - sub LeftString { - my($s, $n) = @_ ; - print substr($s, 0, $n), "\n"; + sub LeftString + { + my($s, $n) = @_; + print substr($s, 0, $n), "\n"; } The C function required to call I would look like this. static void call_LeftString(a, b) - char * a ; - int b ; + char * a; + int b; { - dSP ; + dSP; - ENTER ; - SAVETMPS ; + ENTER; + SAVETMPS; - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(a, 0))); XPUSHs(sv_2mortal(newSViv(b))); - PUTBACK ; + PUTBACK; call_pv("LeftString", G_DISCARD); - FREETMPS ; - LEAVE ; + FREETMPS; + LEAVE; } Here are a few notes on the C function I. @@ -601,13 +540,13 @@ we will have to tidy up the Perl stack and dispose of mortal SVs. This is the purpose of - ENTER ; - SAVETMPS ; + ENTER; + SAVETMPS; at the start of the function, and - FREETMPS ; - LEAVE ; + FREETMPS; + LEAVE; at the end. The C/C pair creates a boundary for any temporaries we create. This means that the temporaries we get rid of @@ -641,7 +580,8 @@ subroutine. Here is a Perl subroutine, I, that takes 2 integer parameters and simply returns their sum. - sub Adder { + sub Adder + { my($a, $b) = @_; $a + $b; } @@ -651,32 +591,32 @@ function required to call it is now a bit more complex. static void call_Adder(a, b) - int a ; - int b ; + int a; + int b; { - dSP ; - int count ; + dSP; + int count; - ENTER ; + ENTER; SAVETMPS; - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); - PUTBACK ; + PUTBACK; count = call_pv("Adder", G_SCALAR); - SPAGAIN ; + SPAGAIN; if (count != 1) - croak("Big trouble\n") ; + croak("Big trouble\n"); - printf ("The sum of %d and %d is %d\n", a, b, POPi) ; + printf ("The sum of %d and %d is %d\n", a, b, POPi); - PUTBACK ; - FREETMPS ; - LEAVE ; + PUTBACK; + FREETMPS; + LEAVE; } Points to note this time are @@ -745,47 +685,48 @@ parameters and the difference. Here is the Perl subroutine - sub AddSubtract { - my($a, $b) = @_; - ($a+$b, $a-$b); + sub AddSubtract + { + my($a, $b) = @_; + ($a+$b, $a-$b); } and this is the C function static void call_AddSubtract(a, b) - int a ; - int b ; + int a; + int b; { - dSP ; - int count ; + dSP; + int count; - ENTER ; + ENTER; SAVETMPS; - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); - PUTBACK ; + PUTBACK; count = call_pv("AddSubtract", G_ARRAY); - SPAGAIN ; + SPAGAIN; if (count != 2) - croak("Big trouble\n") ; + croak("Big trouble\n"); - printf ("%d - %d = %d\n", a, b, POPi) ; - printf ("%d + %d = %d\n", a, b, POPi) ; + printf ("%d - %d = %d\n", a, b, POPi); + printf ("%d + %d = %d\n", a, b, POPi); - PUTBACK ; - FREETMPS ; - LEAVE ; + PUTBACK; + FREETMPS; + LEAVE; } If I is called like this - call_AddSubtract(7, 4) ; + call_AddSubtract(7, 4); then here is the output @@ -816,33 +757,33 @@ context, like this static void call_AddSubScalar(a, b) - int a ; - int b ; + int a; + int b; { - dSP ; - int count ; - int i ; + dSP; + int count; + int i; - ENTER ; + ENTER; SAVETMPS; - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); - PUTBACK ; + PUTBACK; count = call_pv("AddSubtract", G_SCALAR); - SPAGAIN ; + SPAGAIN; - printf ("Items Returned = %d\n", count) ; + printf ("Items Returned = %d\n", count); - for (i = 1 ; i <= count ; ++i) - printf ("Value %d = %d\n", i, POPi) ; + for (i = 1; i <= count; ++i) + printf ("Value %d = %d\n", i, POPi); - PUTBACK ; - FREETMPS ; - LEAVE ; + PUTBACK; + FREETMPS; + LEAVE; } The other modification made is that I will print the @@ -850,7 +791,7 @@ number of items returned from the Perl subroutine and their value (for simplicity it assumes that they are integer). So if I is called - call_AddSubScalar(7, 4) ; + call_AddSubScalar(7, 4); then the output will be @@ -870,45 +811,46 @@ whether it is actually desirable to do it is another matter entirely. The Perl subroutine, I, below takes 2 parameters and increments each directly. - sub Inc { - ++$_[0]; - ++$_[1]; + sub Inc + { + ++ $_[0]; + ++ $_[1]; } and here is a C function to call it. static void call_Inc(a, b) - int a ; - int b ; + int a; + int b; { - dSP ; - int count ; - SV * sva ; - SV * svb ; + dSP; + int count; + SV * sva; + SV * svb; - ENTER ; + ENTER; SAVETMPS; - sva = sv_2mortal(newSViv(a)) ; - svb = sv_2mortal(newSViv(b)) ; + sva = sv_2mortal(newSViv(a)); + svb = sv_2mortal(newSViv(b)); - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sva); XPUSHs(svb); - PUTBACK ; + PUTBACK; count = call_pv("Inc", G_DISCARD); if (count != 0) croak ("call_Inc: expected 0 values from 'Inc', got %d\n", - count) ; + count); - printf ("%d + 1 = %d\n", a, SvIV(sva)) ; - printf ("%d + 1 = %d\n", b, SvIV(svb)) ; + printf ("%d + 1 = %d\n", a, SvIV(sva)); + printf ("%d + 1 = %d\n", b, SvIV(svb)); - FREETMPS ; - LEAVE ; + FREETMPS; + LEAVE; } To be able to access the two parameters that were pushed onto the stack @@ -928,55 +870,55 @@ Now an example using G_EVAL. Below is a Perl subroutine which computes the difference of its 2 parameters. If this would result in a negative result, the subroutine calls I. - sub Subtract { - my ($a, $b) = @_; + sub Subtract + { + my ($a, $b) = @_; - die "death can be fatal\n" if $a < $b; + die "death can be fatal\n" if $a < $b; - $a - $b; + $a - $b; } and some C to call it static void call_Subtract(a, b) - int a ; - int b ; + int a; + int b; { - dSP ; - int count ; + dSP; + int count; - ENTER ; + ENTER; SAVETMPS; - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); - PUTBACK ; + PUTBACK; count = call_pv("Subtract", G_EVAL|G_SCALAR); - SPAGAIN ; + SPAGAIN; /* Check the eval first */ if (SvTRUE(ERRSV)) { - STRLEN n_a; - printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ; - POPs ; + printf ("Uh oh - %s\n", SvPV_nolen(ERRSV)); + POPs; } else { if (count != 1) croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n", - count) ; + count); - printf ("%d - %d = %d\n", a, b, POPi) ; + printf ("%d - %d = %d\n", a, b, POPi); } - PUTBACK ; - FREETMPS ; - LEAVE ; + PUTBACK; + FREETMPS; + LEAVE; } If I is called thus @@ -1004,14 +946,13 @@ The code if (SvTRUE(ERRSV)) { - STRLEN n_a; - printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ; - POPs ; + printf ("Uh oh - %s\n", SvPV_nolen(ERRSV)); + POPs; } is the direct equivalent of this bit of Perl - print "Uh oh - $@\n" if $@ ; + print "Uh oh - $@\n" if $@; C is a perl global of type C that points to the symbol table entry containing the error. C therefore @@ -1035,21 +976,16 @@ Consider this rather facetious example, where we have used an XS version of the call_Subtract example above inside a destructor: package Foo; - - sub new { bless {}, shift } - + sub new { bless {}, $_[0] } sub Subtract { - my($a,$b) = @_; - die "death can be fatal" if $a < $b; - $a - $b; + my($a,$b) = @_; + die "death can be fatal" if $a < $b; + $a - $b; } - - sub DESTROY { call_Subtract(5, 4) } - sub foo { die "foo dies" } - + sub DESTROY { call_Subtract(5, 4); } + sub foo { die "foo dies"; } package main; - eval { Foo->new->foo }; print "Saw: $@" if $@; # should be, but isn't @@ -1076,8 +1012,9 @@ within the Perl script. Consider the Perl code below - sub fred { - print "Hello there\n"; + sub fred + { + print "Hello there\n"; } CallSubPV("fred"); @@ -1088,8 +1025,8 @@ Here is a snippet of XSUB which defines I. CallSubPV(name) char * name CODE: - PUSHMARK(SP) ; - call_pv(name, G_DISCARD|G_NOARGS) ; + PUSHMARK(SP); + call_pv(name, G_DISCARD|G_NOARGS); That is fine as far as it goes. The thing is, the Perl subroutine can be specified as only a string. For Perl 4 this was adequate, @@ -1104,15 +1041,14 @@ I instead of I. CallSubSV(name) SV * name CODE: - PUSHMARK(SP) ; - call_sv(name, G_DISCARD|G_NOARGS) ; + PUSHMARK(SP); + call_sv(name, G_DISCARD|G_NOARGS); Because we are using an SV to call I the following can all be used CallSubSV("fred"); CallSubSV(\&fred); - - my $ref = \&fred; + $ref = \&fred; CallSubSV($ref); CallSubSV( sub { print "Hello there\n" } ); @@ -1124,19 +1060,19 @@ example above) which corresponds to the Perl subroutine so that it can be used later in the program, it not enough just to store a copy of the pointer to the SV. Say the code above had been like this - static SV * rememberSub ; + static SV * rememberSub; void SaveSub1(name) SV * name CODE: - rememberSub = name ; + rememberSub = name; void CallSavedSub1() CODE: - PUSHMARK(SP) ; - call_sv(rememberSub, G_DISCARD|G_NOARGS) ; + PUSHMARK(SP); + call_sv(rememberSub, G_DISCARD|G_NOARGS); The reason this is wrong is that by the time you come to use the pointer C in C, it may or may not still refer @@ -1159,9 +1095,8 @@ for each of the C lines. Similarly, with this code - my $ref = \&fred; + $ref = \&fred; SaveSub1($ref); - $ref = 47; CallSavedSub1(); @@ -1183,9 +1118,8 @@ loudly. A similar but more subtle problem is illustrated with this code - my $ref = \&fred; + $ref = \&fred; SaveSub1($ref); - $ref = \&joe; CallSavedSub1(); @@ -1196,7 +1130,7 @@ originally requested in the call to C. To get around these problems it is necessary to take a full copy of the SV. The code below shows C modified to do that - static SV * keepSub = (SV*)NULL ; + static SV * keepSub = (SV*)NULL; void SaveSub2(name) @@ -1205,16 +1139,16 @@ SV. The code below shows C modified to do that /* Take a copy of the callback */ if (keepSub == (SV*)NULL) /* First time, so create a new SV */ - keepSub = newSVsv(name) ; + keepSub = newSVsv(name); else /* Been here before, so overwrite */ - SvSetSV(keepSub, name) ; + SvSetSV(keepSub, name); void CallSavedSub2() CODE: - PUSHMARK(SP) ; - call_sv(keepSub, G_DISCARD|G_NOARGS) ; + PUSHMARK(SP); + call_sv(keepSub, G_DISCARD|G_NOARGS); To avoid creating a new SV every time C is called, the function first checks to see if it has been called before. If not, @@ -1229,25 +1163,24 @@ C. Here is a Perl subroutine which prints whatever parameters are passed to it. - sub PrintList { - my @list = @_; + sub PrintList + { + my(@list) = @_; - foreach (@list) { - print "$_\n"; - } + foreach (@list) { print "$_\n" } } and here is an example of I which will call I. - static char * words[] = {"alpha", "beta", "gamma", "delta", NULL} ; + static char * words[] = {"alpha", "beta", "gamma", "delta", NULL}; static void call_PrintList() { - dSP ; + dSP; - call_argv("PrintList", G_DISCARD, words) ; + call_argv("PrintList", G_DISCARD, words); } Note that it is not necessary to call C in this instance. @@ -1258,22 +1191,25 @@ This is because I will do it for you. Consider the following Perl code { - package Mine ; - - sub new { - my $type = shift; - bless [@_], $type; - } - - sub Display { - my ($self, $index) = @_; - print "$index: $self->[$index]\n"; - } - - sub PrintID { - my $class = shift; - print "This is Class $class version 1.0\n"; - } + 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"; + } } It implements just a very simple class to manage an array. Apart from @@ -1282,9 +1218,8 @@ virtual. The static method, C, prints out simply the class name and a version number. The virtual method, C, prints out a single element of the array. Here is an all Perl example of using it. - my $a = Mine->new('red', 'green', 'blue'); + $a = Mine->new('red', 'green', 'blue'); $a->Display(1); - Mine->PrintID; will print @@ -1323,10 +1258,10 @@ the C and C methods from C. CODE: PUSHMARK(SP); XPUSHs(ref); - XPUSHs(sv_2mortal(newSViv(index))) ; + XPUSHs(sv_2mortal(newSViv(index))); PUTBACK; - call_method(method, G_DISCARD) ; + call_method(method, G_DISCARD); void call_PrintID(class, method) @@ -1334,15 +1269,15 @@ the C and C methods from C. char * method CODE: PUSHMARK(SP); - XPUSHs(sv_2mortal(newSVpv(class, 0))) ; + XPUSHs(sv_2mortal(newSVpv(class, 0))); PUTBACK; - call_method(method, G_DISCARD) ; + call_method(method, G_DISCARD); So the methods C and C can be invoked like this - my $a = Mine->new('red', 'green', 'blue'); + $a = Mine->new('red', 'green', 'blue'); call_Method($a, 'Display', 1); call_PrintID('Mine', 'PrintID'); @@ -1360,17 +1295,17 @@ currently executing. CODE: I32 gimme = GIMME_V; if (gimme == G_VOID) - printf ("Context is Void\n") ; + printf ("Context is Void\n"); else if (gimme == G_SCALAR) - printf ("Context is Scalar\n") ; + printf ("Context is Scalar\n"); else - printf ("Context is Array\n") ; + printf ("Context is Array\n"); and here is some Perl to test it - PrintContext ; - my $a = PrintContext; - my @a = PrintContext; + PrintContext; + $a = PrintContext; + @a = PrintContext; The output from that will be @@ -1401,11 +1336,11 @@ There is another method which can be used, namely letting Perl do it for you automatically whenever it regains control after the callback has terminated. This is done by simply not using the - ENTER ; - SAVETMPS ; + ENTER; + SAVETMPS; ... - FREETMPS ; - LEAVE ; + FREETMPS; + LEAVE; sequence in the callback (and not, of course, specifying the G_DISCARD flag). @@ -1504,7 +1439,7 @@ to a function as one of its parameters. Below is a call to a hypothetical function C which registers the C function to get called when a fatal error occurs. - register_fatal(cb1) ; + register_fatal(cb1); The single parameter C is a pointer to a function, so you must have defined C in your code, say something like this @@ -1512,8 +1447,8 @@ have defined C in your code, say something like this static void cb1() { - printf ("Fatal Error\n") ; - exit(1) ; + printf ("Fatal Error\n"); + exit(1); } Now change that to call a Perl subroutine instead @@ -1523,12 +1458,12 @@ Now change that to call a Perl subroutine instead static void cb1() { - dSP ; + dSP; - PUSHMARK(SP) ; + PUSHMARK(SP); /* Call the Perl sub to process the callback */ - call_sv(callback, G_DISCARD) ; + call_sv(callback, G_DISCARD); } @@ -1538,21 +1473,22 @@ Now change that to call a Perl subroutine instead CODE: /* Remember the Perl sub */ if (callback == (SV*)NULL) - callback = newSVsv(fn) ; + callback = newSVsv(fn); else - SvSetSV(callback, fn) ; + SvSetSV(callback, fn); /* register the callback with the external library */ - register_fatal(cb1) ; + register_fatal(cb1); where the Perl equivalent of C and the callback it registers, C, might look like this # Register the sub pcb1 - register_fatal(\&pcb1) ; + register_fatal(\&pcb1); - sub pcb1 { - die "I'm dying...\n"; + sub pcb1 + { + die "I'm dying...\n"; } The mapping between the C callback and the Perl equivalent is stored in @@ -1584,8 +1520,8 @@ This may expect the C I function of this form void ProcessRead(fh, buffer) - int fh ; - char * buffer ; + int fh; + char * buffer; { ... } @@ -1595,7 +1531,7 @@ between the C parameter and the Perl subroutine we want called. A hash is a convenient mechanism for storing this mapping. The code below shows a possible implementation - static HV * Mapping = (HV*)NULL ; + static HV * Mapping = (HV*)NULL; void asynch_read(fh, callback) @@ -1604,36 +1540,36 @@ below shows a possible implementation CODE: /* If the hash doesn't already exist, create it */ if (Mapping == (HV*)NULL) - Mapping = newHV() ; + Mapping = newHV(); /* Save the fh -> callback mapping */ - hv_store(Mapping, (char*)&fh, sizeof(fh), newSVsv(callback), 0) ; + hv_store(Mapping, (char*)&fh, sizeof(fh), newSVsv(callback), 0); /* Register with the C Library */ - asynch_read(fh, asynch_read_if) ; + asynch_read(fh, asynch_read_if); and C could look like this static void asynch_read_if(fh, buffer) - int fh ; - char * buffer ; + int fh; + char * buffer; { - dSP ; - SV ** sv ; + dSP; + SV ** sv; /* Get the callback associated with fh */ - sv = hv_fetch(Mapping, (char*)&fh , sizeof(fh), FALSE) ; + sv = hv_fetch(Mapping, (char*)&fh , sizeof(fh), FALSE); if (sv == (SV**)NULL) - croak("Internal error...\n") ; + croak("Internal error...\n"); - PUSHMARK(SP) ; - XPUSHs(sv_2mortal(newSViv(fh))) ; - XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ; - PUTBACK ; + PUSHMARK(SP); + XPUSHs(sv_2mortal(newSViv(fh))); + XPUSHs(sv_2mortal(newSVpv(buffer, 0))); + PUTBACK; /* Call the Perl sub */ - call_sv(*sv, G_DISCARD) ; + call_sv(*sv, G_DISCARD); } For completeness, here is C. This shows how to remove @@ -1644,15 +1580,16 @@ the entry from the hash C. int fh CODE: /* Remove the entry from the hash */ - (void) hv_delete(Mapping, (char*)&fh, sizeof(fh), G_DISCARD) ; + (void) hv_delete(Mapping, (char*)&fh, sizeof(fh), G_DISCARD); /* Now call the real asynch_close */ - asynch_close(fh) ; + asynch_close(fh); So the Perl interface would look like this - sub callback1 { - my($handle, $buffer) = @_; + sub callback1 + { + my($handle, $buffer) = @_; } # Register the Perl callback @@ -1671,7 +1608,7 @@ the C parameter like this void ProcessRead(buffer) - char * buffer ; + char * buffer; { ... } @@ -1684,59 +1621,59 @@ series of C functions to act as the interface to Perl, thus #define MAX_CB 3 #define NULL_HANDLE -1 - typedef void (*FnMap)() ; + typedef void (*FnMap)(); struct MapStruct { - FnMap Function ; - SV * PerlSub ; - int Handle ; - } ; + FnMap Function; + SV * PerlSub; + int Handle; + }; - static void fn1() ; - static void fn2() ; - static void fn3() ; + 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 ; + int index; + char * buffer; { - dSP ; + dSP; - PUSHMARK(SP) ; - XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ; - PUTBACK ; + PUSHMARK(SP); + XPUSHs(sv_2mortal(newSVpv(buffer, 0))); + PUTBACK; /* Call the Perl sub */ - call_sv(Map[index].PerlSub, G_DISCARD) ; + call_sv(Map[index].PerlSub, G_DISCARD); } static void fn1(buffer) - char * buffer ; + char * buffer; { - Pcb(0, buffer) ; + Pcb(0, buffer); } static void fn2(buffer) - char * buffer ; + char * buffer; { - Pcb(1, buffer) ; + Pcb(1, buffer); } static void fn3(buffer) - char * buffer ; + char * buffer; { - Pcb(2, buffer) ; + Pcb(2, buffer); } void @@ -1744,55 +1681,55 @@ series of C functions to act as the interface to Perl, thus int fh SV * callback CODE: - int index ; - int null_index = MAX_CB ; + int index; + int null_index = MAX_CB; /* Find the same handle or an empty entry */ - for (index = 0 ; index < MAX_CB ; ++index) + for (index = 0; index < MAX_CB; ++index) { if (Map[index].Handle == fh) - break ; + break; if (Map[index].Handle == NULL_HANDLE) - null_index = index ; + null_index = index; } if (index == MAX_CB && null_index == MAX_CB) - croak ("Too many callback functions registered\n") ; + croak ("Too many callback functions registered\n"); if (index == MAX_CB) - index = null_index ; + index = null_index; /* Save the file handle */ - Map[index].Handle = fh ; + Map[index].Handle = fh; /* Remember the Perl sub */ if (Map[index].PerlSub == (SV*)NULL) - Map[index].PerlSub = newSVsv(callback) ; + Map[index].PerlSub = newSVsv(callback); else - SvSetSV(Map[index].PerlSub, callback) ; + SvSetSV(Map[index].PerlSub, callback); - asynch_read(fh, Map[index].Function) ; + asynch_read(fh, Map[index].Function); void array_asynch_close(fh) int fh CODE: - int index ; + int index; /* Find the file handle */ - for (index = 0; index < MAX_CB ; ++ index) + for (index = 0; index < MAX_CB; ++ index) if (Map[index].Handle == fh) - break ; + break; if (index == MAX_CB) - croak ("could not close fh %d\n", fh) ; + croak ("could not close fh %d\n", fh); - Map[index].Handle = NULL_HANDLE ; - SvREFCNT_dec(Map[index].PerlSub) ; - Map[index].PerlSub = (SV*)NULL ; + Map[index].Handle = NULL_HANDLE; + SvREFCNT_dec(Map[index].PerlSub); + Map[index].PerlSub = (SV*)NULL; - asynch_close(fh) ; + asynch_close(fh); In this case the functions C, C, and C are used to remember the Perl subroutine to be called. Each of the functions holds @@ -1854,36 +1791,36 @@ of values> recoded to use C instead of C. static void call_AddSubtract2(a, b) - int a ; - int b ; + int a; + int b; { - dSP ; - I32 ax ; - int count ; + dSP; + I32 ax; + int count; - ENTER ; + ENTER; SAVETMPS; - PUSHMARK(SP) ; + PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); - PUTBACK ; + PUTBACK; count = call_pv("AddSubtract", G_ARRAY); - SPAGAIN ; - SP -= count ; - ax = (SP - PL_stack_base) + 1 ; + SPAGAIN; + SP -= count; + ax = (SP - PL_stack_base) + 1; if (count != 2) - croak("Big trouble\n") ; + croak("Big trouble\n"); - printf ("%d + %d = %d\n", a, b, SvIV(ST(0))) ; - printf ("%d - %d = %d\n", a, b, SvIV(ST(1))) ; + printf ("%d + %d = %d\n", a, b, SvIV(ST(0))); + printf ("%d - %d = %d\n", a, b, SvIV(ST(1))); - PUTBACK ; - FREETMPS ; - LEAVE ; + PUTBACK; + FREETMPS; + LEAVE; } Notes @@ -1901,9 +1838,9 @@ you. The code - SPAGAIN ; - SP -= count ; - ax = (SP - PL_stack_base) + 1 ; + SPAGAIN; + SP -= count; + ax = (SP - PL_stack_base) + 1; sets the stack up so that we can use the C macro. @@ -1936,6 +1873,49 @@ will be the return value as well (read more about C in L). Once this code reference is in hand, it can be mixed in with all the previous examples we've shown. +=head1 LIGHTWEIGHT CALLBACKS + +Sometimes you need to invoke the same subroutine repeatedly. +This usually happens with a function that acts on a list of +values, such as Perl's built-in sort(). You can pass a +comparison function to sort(), which will then be invoked +for every pair of values that needs to be compared. The first() +and reduce() functions from L follow a similar +pattern. + +In this case it is possible to speed up the routine (often +quite substantially) by using the lightweight callback API. +The idea is that the calling context only needs to be +created and destroyed once, and the sub can be called +arbitrarily many times in between. + +It is usual to pass parameters using global variables -- typically +$_ for one parameter, or $a and $b for two parameters -- rather +than via @_. (It is possible to use the @_ mechanism if you know +what you're doing, though there is as yet no supported API for +it. It's also inherently slower.) + +The pattern of macro calls is like this: + + dMULTICALL; /* Declare local variables */ + I32 gimme = G_SCALAR; /* context of the call: G_SCALAR, + * G_LIST, or G_VOID */ + + PUSH_MULTICALL(cv); /* Set up the context for calling cv, + and set local vars appropriately */ + + /* loop */ { + /* set the value(s) af your parameter variables */ + MULTICALL; /* Make the actual call */ + } /* end of loop */ + + POP_MULTICALL; /* Tear down the calling context */ + +For some concrete examples, see the implementation of the +first() and reduce() functions of List::Util 1.18. There you +will also find a header file that emulates the multicall API +on older versions of perl. + =head1 SEE ALSO L, L, L