Cwd::fastcwd in File::Find
[perl.git] / pod / perlcall.pod
1 =head1 NAME
2
3 perlcall - Perl calling conventions from C
4
5 =head1 DESCRIPTION
6
7 The purpose of this document is to show you how to call Perl subroutines
8 directly from C, i.e. how to write I<callbacks>.
9
10 Apart from discussing the C interface provided by Perl for writing
11 callbacks the document uses a series of examples to show how the
12 interface actually works in practice.  In addition some techniques for
13 coding callbacks are covered.
14
15 Examples where callbacks are necessary include
16
17 =over 5
18
19 =item * An Error Handler
20
21 You have created an XSUB interface to an application's C API.
22
23 A fairly common feature in applications is to allow you to define a C
24 function that will be called whenever something nasty occurs. What we
25 would like is to be able to specify a Perl subroutine that will be
26 called instead.
27
28 =item * An Event Driven Program
29
30 The classic example of where callbacks are used is when writing an
31 event driven program like for an X windows application.  In this case
32 your register functions to be called whenever specific events occur,
33 e.g. a mouse button is pressed, the cursor moves into a window or a
34 menu item is selected.
35
36 =back
37
38 Although the techniques described here are applicable when embedding
39 Perl in a C program, this is not the primary goal of this document.
40 There are other details that must be considered and are specific to
41 embedding Perl. For details on embedding Perl in C refer to
42 L<perlembed>.
43
44 Before you launch yourself head first into the rest of this document,
45 it would be a good idea to have read the following two documents -
46 L<perlxs> and L<perlguts>.
47
48 =head1 THE PERL_CALL FUNCTIONS
49
50 Although this stuff is easier to explain using examples, you first need
51 be aware of a few important definitions.
52
53 Perl has a number of C functions that allow you to call Perl
54 subroutines.  They are
55
56     I32 perl_call_sv(SV* sv, I32 flags) ;
57     I32 perl_call_pv(char *subname, I32 flags) ;
58     I32 perl_call_method(char *methname, I32 flags) ;
59     I32 perl_call_argv(char *subname, I32 flags, register char **argv) ;
60
61 The key function is I<perl_call_sv>.  All the other functions are
62 fairly simple wrappers which make it easier to call Perl subroutines in
63 special cases. At the end of the day they will all call I<perl_call_sv>
64 to actually invoke the Perl subroutine.
65
66 All the I<perl_call_*> functions have a C<flags> parameter which is
67 used to pass a bit mask of options to Perl.  This bit mask operates
68 identically for each of the functions.  The settings available in the
69 bit mask are discussed in L<FLAG VALUES>.
70
71 Each of the functions will now be discussed in turn.
72
73 =over 5
74
75 =item B<perl_call_sv>
76
77 I<perl_call_sv> takes two parameters, the first, C<sv>, is an SV*.
78 This allows you to specify the Perl subroutine to be called either as a
79 C string (which has first been converted to an SV) or a reference to a
80 subroutine. The section, I<Using perl_call_sv>, shows how you can make
81 use of I<perl_call_sv>.
82
83 =item B<perl_call_pv>
84
85 The function, I<perl_call_pv>, is similar to I<perl_call_sv> except it
86 expects its first parameter to be a C char* which identifies the Perl
87 subroutine you want to call, e.g. C<perl_call_pv("fred", 0)>.  If the
88 subroutine you want to call is in another package, just include the
89 package name in the string, e.g. C<"pkg::fred">.
90
91 =item B<perl_call_method>
92
93 The function I<perl_call_method> is used to call a method from a Perl
94 class.  The parameter C<methname> corresponds to the name of the method
95 to be called.  Note that the class that the method belongs to is passed
96 on the Perl stack rather than in the parameter list. This class can be
97 either the name of the class (for a static method) or a reference to an
98 object (for a virtual method).  See L<perlobj> for more information on
99 static and virtual methods and L<Using perl_call_method> for an example
100 of using I<perl_call_method>.
101
102 =item B<perl_call_argv>
103
104 I<perl_call_argv> calls the Perl subroutine specified by the C string
105 stored in the C<subname> parameter. It also takes the usual C<flags>
106 parameter.  The final parameter, C<argv>, consists of a NULL terminated
107 list of C strings to be passed as parameters to the Perl subroutine.
108 See I<Using perl_call_argv>.
109
110 =back
111
112 All the functions return an integer. This is a count of the number of
113 items returned by the Perl subroutine. The actual items returned by the
114 subroutine are stored on the Perl stack.
115
116 As a general rule you should I<always> check the return value from
117 these functions.  Even if you are expecting only a particular number of
118 values to be returned from the Perl subroutine, there is nothing to
119 stop someone from doing something unexpected - don't say you haven't
120 been warned.
121
122 =head1 FLAG VALUES
123
124 The C<flags> parameter in all the I<perl_call_*> functions is a bit mask
125 which can consist of any combination of the symbols defined below,
126 OR'ed together.
127
128
129 =head2  G_SCALAR
130
131 Calls the Perl subroutine in a scalar context.  This is the default
132 context flag setting for all the I<perl_call_*> functions.
133
134 This flag has 2 effects
135
136 =over 5
137
138 =item 1.
139
140 it indicates to the subroutine being called that it is executing in a
141 scalar context (if it executes I<wantarray> the result will be false).
142
143
144 =item 2.
145
146 it ensures that only a scalar is actually returned from the subroutine.
147 The subroutine can, of course,  ignore the I<wantarray> and return a
148 list anyway. If so, then only the last element of the list will be
149 returned.
150
151 =back
152
153 The value returned by the I<perl_call_*> function indicates how may
154 items have been returned by the Perl subroutine - in this case it will
155 be either 0 or 1.
156
157 If 0, then you have specified the G_DISCARD flag.
158
159 If 1, then the item actually returned by the Perl subroutine will be
160 stored on the Perl stack - the section I<Returning a Scalar> shows how
161 to access this value on the stack.  Remember that regardless of how
162 many items the Perl subroutine returns, only the last one will be
163 accessible from the stack - think of the case where only one value is
164 returned as being a list with only one element.  Any other items that
165 were returned will not exist by the time control returns from the
166 I<perl_call_*> function.  The section I<Returning a list in a scalar
167 context> shows an example of this behaviour.
168
169
170 =head2 G_ARRAY
171
172 Calls the Perl subroutine in a list context.
173
174 As with G_SCALAR, this flag has 2 effects
175
176 =over 5
177
178 =item 1.
179
180 it indicates to the subroutine being called that it is executing in an
181 array context (if it executes I<wantarray> the result will be true).
182
183
184 =item 2.
185
186 it ensures that all items returned from the subroutine will be
187 accessible when control returns from the I<perl_call_*> function.
188
189 =back
190
191 The value returned by the I<perl_call_*> function indicates how may
192 items have been returned by the Perl subroutine.
193
194 If 0, the you have specified the G_DISCARD flag.
195
196 If not 0, then it will be a count of the number of items returned by
197 the subroutine. These items will be stored on the Perl stack.  The
198 section I<Returning a list of values> gives an example of using the
199 G_ARRAY flag and the mechanics of accessing the returned items from the
200 Perl stack.
201
202 =head2 G_DISCARD
203
204 By default, the I<perl_call_*> functions place the items returned from
205 by the Perl subroutine on the stack.  If you are not interested in
206 these items, then setting this flag will make Perl get rid of them
207 automatically for you.  Note that it is still possible to indicate a
208 context to the Perl subroutine by using either G_SCALAR or G_ARRAY.
209
210 If you do not set this flag then it is I<very> important that you make
211 sure that any temporaries (i.e. parameters passed to the Perl
212 subroutine and values returned from the subroutine) are disposed of
213 yourself.  The section I<Returning a Scalar> gives details of how to
214 explicitly dispose of these temporaries and the section I<Using Perl to
215 dispose of temporaries> discusses the specific circumstances where you
216 can ignore the problem and let Perl deal with it for you.
217
218 =head2 G_NOARGS
219
220 Whenever a Perl subroutine is called using one of the I<perl_call_*>
221 functions, it is assumed by default that parameters are to be passed to
222 the subroutine.  If you are not passing any parameters to the Perl
223 subroutine, you can save a bit of time by setting this flag.  It has
224 the effect of not creating the C<@_> array for the Perl subroutine.
225
226 Although the functionality provided by this flag may seem
227 straightforward, it should be used only if there is a good reason to do
228 so.  The reason for being cautious is that even if you have specified
229 the G_NOARGS flag, it is still possible for the Perl subroutine that
230 has been called to think that you have passed it parameters.
231
232 In fact, what can happen is that the Perl subroutine you have called
233 can access the C<@_> array from a previous Perl subroutine.  This will
234 occur when the code that is executing the I<perl_call_*> function has
235 itself been called from another Perl subroutine. The code below
236 illustrates this
237
238     sub fred
239       { print "@_\n"  }
240
241     sub joe
242       { &fred }
243
244     &joe(1,2,3) ;
245
246 This will print
247
248     1 2 3
249
250 What has happened is that C<fred> accesses the C<@_> array which
251 belongs to C<joe>.
252
253
254 =head2 G_EVAL   
255
256 It is possible for the Perl subroutine you are calling to terminate
257 abnormally, e.g. by calling I<die> explicitly or by not actually
258 existing.  By default, when either of these of events occurs, the
259 process will terminate immediately.  If though, you want to trap this
260 type of event, specify the G_EVAL flag.  It will put an I<eval { }>
261 around the subroutine call.
262
263 Whenever control returns from the I<perl_call_*> function you need to
264 check the C<$@> variable as you would in a normal Perl script.
265
266 The value returned from the I<perl_call_*> function is dependent on
267 what other flags have been specified and whether an error has
268 occurred.  Here are all the different cases that can occur
269
270 =over 5
271
272 =item *
273
274 If the I<perl_call_*> function returns normally, then the value
275 returned is as specified in the previous sections.
276
277 =item *
278
279 If G_DISCARD is specified, the return value will always be 0.
280
281 =item *
282
283 If G_ARRAY is specified I<and> an error has occurred, the return value
284 will always be 0.
285
286 =item *
287
288 If G_SCALAR is specified I<and> an error has occurred, the return value
289 will be 1 and the value on the top of the stack will be I<undef>. This
290 means that if you have already detected the error by checking C<$@> and
291 you want the program to continue, you must remember to pop the I<undef>
292 from the stack.
293
294 =back
295
296 See I<Using G_EVAL> for details of using G_EVAL.
297
298 =head2 G_KEEPERR
299
300 You may have noticed that using the G_EVAL flag described above will
301 B<always> clear the C<$@> variable and set it to a string describing
302 the error iff there was an error in the called code.  This unqualified
303 resetting of C<$@> can be problematic in the reliable identification of
304 errors using the C<eval {}> mechanism, because the possibility exists
305 that perl will call other code (end of block processing code, for
306 example) between the time the error causes C<$@> to be set within
307 C<eval {}>, and the subsequent statement which checks for the value of
308 C<$@> gets executed in the user's script.
309
310 This scenario will mostly be applicable to code that is meant to be
311 called from within destructors, asynchronous callbacks, signal
312 handlers, C<__DIE__> or C<__WARN__> hooks, and C<tie> functions.  In
313 such situations, you will not want to clear C<$@> at all, but simply to
314 append any new errors to any existing value of C<$@>.
315
316 The G_KEEPERR flag is meant to be used in conjunction with G_EVAL in
317 I<perl_call_*> functions that are used to implement such code.  This flag
318 has no effect when G_EVAL is not used.
319
320 When G_KEEPERR is used, any errors in the called code will be prefixed
321 with the string "\t(in cleanup)", and appended to the current value
322 of C<$@>.
323
324 The G_KEEPERR flag was introduced in Perl version 5.002.
325
326 See I<Using G_KEEPERR> for an example of a situation that warrants the
327 use of this flag.
328
329 =head2 Determining the Context 
330
331 As mentioned above, you can determine the context of the currently
332 executing subroutine in Perl with I<wantarray>. The equivalent test can
333 be made in C by using the C<GIMME> macro. This will return C<G_SCALAR>
334 if you have been called in a scalar context and C<G_ARRAY> if in an
335 array context. An example of using the C<GIMME> macro is shown in
336 section I<Using GIMME>.
337
338 =head1 KNOWN PROBLEMS
339
340 This section outlines all known problems that exist in the
341 I<perl_call_*> functions.
342
343 =over 5
344
345 =item 1.
346
347 If you are intending to make use of both the G_EVAL and G_SCALAR flags
348 in your code, use a version of Perl greater than 5.000.  There is a bug
349 in version 5.000 of Perl which means that the combination of these two
350 flags will not work as described in the section I<FLAG VALUES>.
351
352 Specifically, if the two flags are used when calling a subroutine and
353 that subroutine does not call I<die>, the value returned by
354 I<perl_call_*> will be wrong.
355
356
357 =item 2.
358
359 In Perl 5.000 and 5.001 there is a problem with using I<perl_call_*> if
360 the Perl sub you are calling attempts to trap a I<die>.
361
362 The symptom of this problem is that the called Perl sub will continue
363 to completion, but whenever it attempts to pass control back to the
364 XSUB, the program will immediately terminate.
365
366 For example, say you want to call this Perl sub
367
368     sub fred
369     {
370         eval { die "Fatal Error" ; }
371         print "Trapped error: $@\n" 
372             if $@ ;
373     }
374
375 via this XSUB
376
377     void
378     Call_fred()
379         CODE:
380         PUSHMARK(sp) ;
381         perl_call_pv("fred", G_DISCARD|G_NOARGS) ;
382         fprintf(stderr, "back in Call_fred\n") ;
383
384 When C<Call_fred> is executed it will print
385
386     Trapped error: Fatal Error
387
388 As control never returns to C<Call_fred>, the C<"back in Call_fred">
389 string will not get printed.
390
391 To work around this problem, you can either upgrade to Perl 5.002 (or
392 later), or use the G_EVAL flag with I<perl_call_*> as shown below
393
394     void
395     Call_fred()
396         CODE:
397         PUSHMARK(sp) ;
398         perl_call_pv("fred", G_EVAL|G_DISCARD|G_NOARGS) ;
399         fprintf(stderr, "back in Call_fred\n") ;
400
401 =back
402
403
404
405 =head1 EXAMPLES
406
407 Enough of the definition talk, let's have a few examples.
408
409 Perl provides many macros to assist in accessing the Perl stack.
410 Wherever possible, these macros should always be used when interfacing
411 to Perl internals.  Hopefully this should make the code less vulnerable
412 to any changes made to Perl in the future.
413
414 Another point worth noting is that in the first series of examples I
415 have made use of only the I<perl_call_pv> function.  This has been done
416 to keep the code simpler and ease you into the topic.  Wherever
417 possible, if the choice is between using I<perl_call_pv> and
418 I<perl_call_sv>, you should always try to use I<perl_call_sv>.  See
419 I<Using perl_call_sv> for details.
420
421 =head2 No Parameters, Nothing returned
422
423 This first trivial example will call a Perl subroutine, I<PrintUID>, to
424 print out the UID of the process.
425
426     sub PrintUID
427     {
428         print "UID is $<\n" ;
429     }
430
431 and here is a C function to call it
432
433     static void
434     call_PrintUID()
435     {
436         dSP ;
437
438         PUSHMARK(sp) ;
439         perl_call_pv("PrintUID", G_DISCARD|G_NOARGS) ;
440     }
441
442 Simple, eh.
443
444 A few points to note about this example.
445
446 =over 5
447
448 =item 1.
449
450 Ignore C<dSP> and C<PUSHMARK(sp)> for now. They will be discussed in
451 the next example.
452
453 =item 2.
454
455 We aren't passing any parameters to I<PrintUID> so G_NOARGS can be
456 specified.
457
458 =item 3.
459
460 We aren't interested in anything returned from I<PrintUID>, so
461 G_DISCARD is specified. Even if I<PrintUID> was changed to actually
462 return some value(s), having specified G_DISCARD will mean that they
463 will be wiped by the time control returns from I<perl_call_pv>.
464
465 =item 4.
466
467 As I<perl_call_pv> is being used, the Perl subroutine is specified as a
468 C string. In this case the subroutine name has been 'hard-wired' into the
469 code.
470
471 =item 5.
472
473 Because we specified G_DISCARD, it is not necessary to check the value
474 returned from I<perl_call_pv>. It will always be 0.
475
476 =back
477
478 =head2 Passing Parameters
479
480 Now let's make a slightly more complex example. This time we want to
481 call a Perl subroutine, C<LeftString>, which will take 2 parameters - a
482 string (C<$s>) and an integer (C<$n>).  The subroutine will simply
483 print the first C<$n> characters of the string.
484
485 So the Perl subroutine would look like this
486
487     sub LeftString
488     {
489         my($s, $n) = @_ ;
490         print substr($s, 0, $n), "\n" ;
491     }
492
493 The C function required to call I<LeftString> would look like this.
494
495     static void
496     call_LeftString(a, b)
497     char * a ;
498     int b ;
499     {
500         dSP ;
501
502         PUSHMARK(sp) ;
503         XPUSHs(sv_2mortal(newSVpv(a, 0)));
504         XPUSHs(sv_2mortal(newSViv(b)));
505         PUTBACK ;
506
507         perl_call_pv("LeftString", G_DISCARD);
508     }
509
510 Here are a few notes on the C function I<call_LeftString>.
511
512 =over 5
513
514 =item 1.
515
516 Parameters are passed to the Perl subroutine using the Perl stack.
517 This is the purpose of the code beginning with the line C<dSP> and
518 ending with the line C<PUTBACK>.
519
520
521 =item 2.
522
523 If you are going to put something onto the Perl stack, you need to know
524 where to put it. This is the purpose of the macro C<dSP> - it declares
525 and initializes a I<local> copy of the Perl stack pointer.
526
527 All the other macros which will be used in this example require you to
528 have used this macro.
529
530 The exception to this rule is if you are calling a Perl subroutine
531 directly from an XSUB function. In this case it is not necessary to
532 explicitly use the C<dSP> macro - it will be declared for you
533 automatically.
534
535 =item 3.
536
537 Any parameters to be pushed onto the stack should be bracketed by the
538 C<PUSHMARK> and C<PUTBACK> macros.  The purpose of these two macros, in
539 this context, is to automatically count the number of parameters you
540 are pushing. Then whenever Perl is creating the C<@_> array for the
541 subroutine, it knows how big to make it.
542
543 The C<PUSHMARK> macro tells Perl to make a mental note of the current
544 stack pointer. Even if you aren't passing any parameters (like the
545 example shown in the section I<No Parameters, Nothing returned>) you
546 must still call the C<PUSHMARK> macro before you can call any of the
547 I<perl_call_*> functions - Perl still needs to know that there are no
548 parameters.
549
550 The C<PUTBACK> macro sets the global copy of the stack pointer to be
551 the same as our local copy. If we didn't do this I<perl_call_pv>
552 wouldn't know where the two parameters we pushed were - remember that
553 up to now all the stack pointer manipulation we have done is with our
554 local copy, I<not> the global copy.
555
556 =item 4.
557
558 The only flag specified this time is G_DISCARD. Since we are passing 2
559 parameters to the Perl subroutine this time, we have not specified
560 G_NOARGS.
561
562 =item 5.
563
564 Next, we come to XPUSHs. This is where the parameters actually get
565 pushed onto the stack. In this case we are pushing a string and an
566 integer.
567
568 See the section L<perlguts/"XSUB'S and the Argument Stack"> for details
569 on how the XPUSH macros work.
570
571 =item 6.
572
573 Finally, I<LeftString> can now be called via the I<perl_call_pv>
574 function.
575
576 =back
577
578 =head2 Returning a Scalar
579
580 Now for an example of dealing with the items returned from a Perl
581 subroutine.
582
583 Here is a Perl subroutine, I<Adder>,  which takes 2 integer parameters
584 and simply returns their sum.
585
586     sub Adder
587     {
588         my($a, $b) = @_ ;
589         $a + $b ;
590     }
591
592 Since we are now concerned with the return value from I<Adder>, the C
593 function required to call it is now a bit more complex.
594
595     static void
596     call_Adder(a, b)
597     int a ;
598     int b ;
599     {
600         dSP ;
601         int count ;
602
603         ENTER ;
604         SAVETMPS;
605
606         PUSHMARK(sp) ;
607         XPUSHs(sv_2mortal(newSViv(a)));
608         XPUSHs(sv_2mortal(newSViv(b)));
609         PUTBACK ;
610
611         count = perl_call_pv("Adder", G_SCALAR);
612
613         SPAGAIN ;
614
615         if (count != 1)
616             croak("Big trouble\n") ;
617
618         printf ("The sum of %d and %d is %d\n", a, b, POPi) ;
619
620         PUTBACK ;
621         FREETMPS ;
622         LEAVE ;
623     }
624
625 Points to note this time are
626
627 =over 5
628
629 =item 1. 
630
631 The only flag specified this time was G_SCALAR. That means the C<@_>
632 array will be created and that the value returned by I<Adder> will
633 still exist after the call to I<perl_call_pv>.
634
635
636
637 =item 2.
638
639 Because we are interested in what is returned from I<Adder> we cannot
640 specify G_DISCARD. This means that we will have to tidy up the Perl
641 stack and dispose of any temporary values ourselves. This is the
642 purpose of
643
644     ENTER ;
645     SAVETMPS ;
646
647 at the start of the function, and
648
649     FREETMPS ;
650     LEAVE ;
651
652 at the end. The C<ENTER>/C<SAVETMPS> pair creates a boundary for any
653 temporaries we create.  This means that the temporaries we get rid of
654 will be limited to those which were created after these calls.
655
656 The C<FREETMPS>/C<LEAVE> pair will get rid of any values returned by
657 the Perl subroutine, plus it will also dump the mortal SV's we have
658 created.  Having C<ENTER>/C<SAVETMPS> at the beginning of the code
659 makes sure that no other mortals are destroyed.
660
661 Think of these macros as working a bit like using C<{> and C<}> in Perl
662 to limit the scope of local variables.
663
664 See the section I<Using Perl to dispose of temporaries> for details of
665 an alternative to using these macros.
666
667 =item 3.
668
669 The purpose of the macro C<SPAGAIN> is to refresh the local copy of the
670 stack pointer. This is necessary because it is possible that the memory
671 allocated to the Perl stack has been re-allocated whilst in the
672 I<perl_call_pv> call.
673
674 If you are making use of the Perl stack pointer in your code you must
675 always refresh the your local copy using SPAGAIN whenever you make use
676 of the I<perl_call_*> functions or any other Perl internal function.
677
678 =item 4.
679
680 Although only a single value was expected to be returned from I<Adder>,
681 it is still good practice to check the return code from I<perl_call_pv>
682 anyway.
683
684 Expecting a single value is not quite the same as knowing that there
685 will be one. If someone modified I<Adder> to return a list and we
686 didn't check for that possibility and take appropriate action the Perl
687 stack would end up in an inconsistent state. That is something you
688 I<really> don't want to ever happen.
689
690 =item 5.
691
692 The C<POPi> macro is used here to pop the return value from the stack.
693 In this case we wanted an integer, so C<POPi> was used.
694
695
696 Here is the complete list of POP macros available, along with the types
697 they return.
698
699     POPs        SV
700     POPp        pointer
701     POPn        double
702     POPi        integer
703     POPl        long
704
705 =item 6.
706
707 The final C<PUTBACK> is used to leave the Perl stack in a consistent
708 state before exiting the function.  This is necessary because when we
709 popped the return value from the stack with C<POPi> it updated only our
710 local copy of the stack pointer.  Remember, C<PUTBACK> sets the global
711 stack pointer to be the same as our local copy.
712
713 =back
714
715
716 =head2 Returning a list of values
717
718 Now, let's extend the previous example to return both the sum of the
719 parameters and the difference.
720
721 Here is the Perl subroutine
722
723     sub AddSubtract
724     {
725        my($a, $b) = @_ ;
726        ($a+$b, $a-$b) ;
727     }
728
729 and this is the C function
730
731     static void
732     call_AddSubtract(a, b)
733     int a ;
734     int b ;
735     {
736         dSP ;
737         int count ;
738
739         ENTER ;
740         SAVETMPS;
741
742         PUSHMARK(sp) ;
743         XPUSHs(sv_2mortal(newSViv(a)));
744         XPUSHs(sv_2mortal(newSViv(b)));
745         PUTBACK ;
746
747         count = perl_call_pv("AddSubtract", G_ARRAY);
748
749         SPAGAIN ;
750
751         if (count != 2)
752             croak("Big trouble\n") ;
753
754         printf ("%d - %d = %d\n", a, b, POPi) ;
755         printf ("%d + %d = %d\n", a, b, POPi) ;
756
757         PUTBACK ;
758         FREETMPS ;
759         LEAVE ;
760     }
761
762 If I<call_AddSubtract> is called like this
763
764     call_AddSubtract(7, 4) ;
765
766 then here is the output
767
768     7 - 4 = 3
769     7 + 4 = 11
770
771 Notes
772
773 =over 5
774
775 =item 1.
776
777 We wanted array context, so G_ARRAY was used.
778
779 =item 2.
780
781 Not surprisingly C<POPi> is used twice this time because we were
782 retrieving 2 values from the stack. The important thing to note is that
783 when using the C<POP*> macros they come off the stack in I<reverse>
784 order.
785
786 =back
787
788 =head2 Returning a list in a scalar context
789
790 Say the Perl subroutine in the previous section was called in a scalar
791 context, like this
792
793     static void
794     call_AddSubScalar(a, b)
795     int a ;
796     int b ;
797     {
798         dSP ;
799         int count ;
800         int i ;
801
802         ENTER ;
803         SAVETMPS;
804
805         PUSHMARK(sp) ;
806         XPUSHs(sv_2mortal(newSViv(a)));
807         XPUSHs(sv_2mortal(newSViv(b)));
808         PUTBACK ;
809
810         count = perl_call_pv("AddSubtract", G_SCALAR);
811
812         SPAGAIN ;
813
814         printf ("Items Returned = %d\n", count) ;
815
816         for (i = 1 ; i <= count ; ++i)
817             printf ("Value %d = %d\n", i, POPi) ;
818
819         PUTBACK ;
820         FREETMPS ;
821         LEAVE ;
822     }
823
824 The other modification made is that I<call_AddSubScalar> will print the
825 number of items returned from the Perl subroutine and their value (for
826 simplicity it assumes that they are integer).  So if
827 I<call_AddSubScalar> is called
828
829     call_AddSubScalar(7, 4) ;
830
831 then the output will be
832
833     Items Returned = 1
834     Value 1 = 3
835
836 In this case the main point to note is that only the last item in the
837 list returned from the subroutine, I<Adder> actually made it back to
838 I<call_AddSubScalar>.
839
840
841 =head2 Returning Data from Perl via the parameter list
842
843 It is also possible to return values directly via the parameter list -
844 whether it is actually desirable to do it is another matter entirely.
845
846 The Perl subroutine, I<Inc>, below takes 2 parameters and increments
847 each directly.
848
849     sub Inc
850     {
851         ++ $_[0] ;
852         ++ $_[1] ;
853     }
854
855 and here is a C function to call it.
856
857     static void
858     call_Inc(a, b)
859     int a ;
860     int b ;
861     {
862         dSP ;
863         int count ;
864         SV * sva ;
865         SV * svb ;
866
867         ENTER ;
868         SAVETMPS;
869
870         sva = sv_2mortal(newSViv(a)) ;
871         svb = sv_2mortal(newSViv(b)) ;
872
873         PUSHMARK(sp) ;
874         XPUSHs(sva);
875         XPUSHs(svb);
876         PUTBACK ;
877
878         count = perl_call_pv("Inc", G_DISCARD);
879
880         if (count != 0)
881             croak ("call_Inc: expected 0 values from 'Inc', got %d\n",
882                    count) ;
883
884         printf ("%d + 1 = %d\n", a, SvIV(sva)) ;
885         printf ("%d + 1 = %d\n", b, SvIV(svb)) ;
886
887         FREETMPS ;
888         LEAVE ;
889     }
890
891 To be able to access the two parameters that were pushed onto the stack
892 after they return from I<perl_call_pv> it is necessary to make a note
893 of their addresses - thus the two variables C<sva> and C<svb>.
894
895 The reason this is necessary is that the area of the Perl stack which
896 held them will very likely have been overwritten by something else by
897 the time control returns from I<perl_call_pv>.
898
899
900
901
902 =head2 Using G_EVAL
903
904 Now an example using G_EVAL. Below is a Perl subroutine which computes
905 the difference of its 2 parameters. If this would result in a negative
906 result, the subroutine calls I<die>.
907
908     sub Subtract
909     {
910         my ($a, $b) = @_ ;
911
912         die "death can be fatal\n" if $a < $b ;
913
914         $a - $b ;
915     }
916
917 and some C to call it
918
919     static void
920     call_Subtract(a, b)
921     int a ;
922     int b ;
923     {
924         dSP ;
925         int count ;
926
927         ENTER ;
928         SAVETMPS;
929
930         PUSHMARK(sp) ;
931         XPUSHs(sv_2mortal(newSViv(a)));
932         XPUSHs(sv_2mortal(newSViv(b)));
933         PUTBACK ;
934
935         count = perl_call_pv("Subtract", G_EVAL|G_SCALAR);
936
937         SPAGAIN ;
938
939         /* Check the eval first */
940         if (SvTRUE(GvSV(errgv)))
941         {
942             printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ;
943             POPs ;
944         }
945         else
946         {
947             if (count != 1)
948                croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n",
949                         count) ;
950
951             printf ("%d - %d = %d\n", a, b, POPi) ;
952         }
953
954         PUTBACK ;
955         FREETMPS ;
956         LEAVE ;
957     }
958
959 If I<call_Subtract> is called thus
960
961     call_Subtract(4, 5)
962
963 the following will be printed
964
965     Uh oh - death can be fatal
966
967 Notes
968
969 =over 5
970
971 =item 1.
972
973 We want to be able to catch the I<die> so we have used the G_EVAL
974 flag.  Not specifying this flag would mean that the program would
975 terminate immediately at the I<die> statement in the subroutine
976 I<Subtract>.
977
978 =item 2.
979
980 The code 
981
982     if (SvTRUE(GvSV(errgv)))
983     {
984         printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ;
985         POPs ;
986     }
987
988 is the direct equivalent of this bit of Perl
989
990     print "Uh oh - $@\n" if $@ ;
991
992 C<errgv> is a perl global of type C<GV *> that points to the
993 symbol table entry containing the error.  C<GvSV(errgv)> therefore
994 refers to the C equivalent of C<$@>.
995
996 =item 3.
997
998 Note that the stack is popped using C<POPs> in the block where
999 C<SvTRUE(GvSV(errgv))> is true.  This is necessary because whenever a
1000 I<perl_call_*> function invoked with G_EVAL|G_SCALAR returns an error,
1001 the top of the stack holds the value I<undef>. Since we want the
1002 program to continue after detecting this error, it is essential that
1003 the stack is tidied up by removing the I<undef>.
1004
1005 =back
1006
1007
1008 =head2 Using G_KEEPERR
1009
1010 Consider this rather facetious example, where we have used an XS
1011 version of the call_Subtract example above inside a destructor:
1012
1013     package Foo;
1014     sub new { bless {}, $_[0] }
1015     sub Subtract { 
1016         my($a,$b) = @_;
1017         die "death can be fatal" if $a < $b ;
1018         $a - $b;
1019     }
1020     sub DESTROY { call_Subtract(5, 4); }
1021     sub foo { die "foo dies"; }
1022
1023     package main;
1024     eval { Foo->new->foo };
1025     print "Saw: $@" if $@;             # should be, but isn't
1026
1027 This example will fail to recognize that an error occurred inside the
1028 C<eval {}>.  Here's why: the call_Subtract code got executed while perl
1029 was cleaning up temporaries when exiting the eval block, and since
1030 call_Subtract is implemented with I<perl_call_pv> using the G_EVAL
1031 flag, it promptly reset C<$@>.  This results in the failure of the
1032 outermost test for C<$@>, and thereby the failure of the error trap.
1033
1034 Appending the G_KEEPERR flag, so that the I<perl_call_pv> call in
1035 call_Subtract reads:
1036
1037         count = perl_call_pv("Subtract", G_EVAL|G_SCALAR|G_KEEPERR);
1038
1039 will preserve the error and restore reliable error handling.
1040
1041 =head2 Using perl_call_sv
1042
1043 In all the previous examples I have 'hard-wired' the name of the Perl
1044 subroutine to be called from C.  Most of the time though, it is more
1045 convenient to be able to specify the name of the Perl subroutine from
1046 within the Perl script.
1047
1048 Consider the Perl code below
1049
1050     sub fred
1051     {
1052         print "Hello there\n" ;
1053     }
1054
1055     CallSubPV("fred") ;
1056
1057 Here is a snippet of XSUB which defines I<CallSubPV>.
1058
1059     void
1060     CallSubPV(name)
1061         char *  name
1062         CODE:
1063         PUSHMARK(sp) ;
1064         perl_call_pv(name, G_DISCARD|G_NOARGS) ;
1065
1066 That is fine as far as it goes. The thing is, the Perl subroutine 
1067 can be specified only as a string.  For Perl 4 this was adequate,
1068 but Perl 5 allows references to subroutines and anonymous subroutines.
1069 This is where I<perl_call_sv> is useful.
1070
1071 The code below for I<CallSubSV> is identical to I<CallSubPV> except
1072 that the C<name> parameter is now defined as an SV* and we use
1073 I<perl_call_sv> instead of I<perl_call_pv>.
1074
1075     void
1076     CallSubSV(name)
1077         SV *    name
1078         CODE:
1079         PUSHMARK(sp) ;
1080         perl_call_sv(name, G_DISCARD|G_NOARGS) ;
1081
1082 Since we are using an SV to call I<fred> the following can all be used
1083
1084     CallSubSV("fred") ;
1085     CallSubSV(\&fred) ;
1086     $ref = \&fred ;
1087     CallSubSV($ref) ;
1088     CallSubSV( sub { print "Hello there\n" } ) ;
1089
1090 As you can see, I<perl_call_sv> gives you much greater flexibility in
1091 how you can specify the Perl subroutine.
1092
1093 You should note that if it is necessary to store the SV (C<name> in the
1094 example above) which corresponds to the Perl subroutine so that it can
1095 be used later in the program, it not enough to just store a copy of the
1096 pointer to the SV. Say the code above had been like this
1097
1098     static SV * rememberSub ;
1099
1100     void
1101     SaveSub1(name)
1102         SV *    name
1103         CODE:
1104         rememberSub = name ;
1105
1106     void
1107     CallSavedSub1()
1108         CODE:
1109         PUSHMARK(sp) ;
1110         perl_call_sv(rememberSub, G_DISCARD|G_NOARGS) ;
1111
1112 The reason this is wrong is that by the time you come to use the
1113 pointer C<rememberSub> in C<CallSavedSub1>, it may or may not still refer
1114 to the Perl subroutine that was recorded in C<SaveSub1>.  This is
1115 particularly true for these cases
1116
1117     SaveSub1(\&fred) ;
1118     CallSavedSub1() ;
1119
1120     SaveSub1( sub { print "Hello there\n" } ) ;
1121     CallSavedSub1() ;
1122
1123 By the time each of the C<SaveSub1> statements above have been executed,
1124 the SV*'s which corresponded to the parameters will no longer exist.
1125 Expect an error message from Perl of the form
1126
1127     Can't use an undefined value as a subroutine reference at ...
1128
1129 for each of the C<CallSavedSub1> lines.
1130
1131 Similarly, with this code 
1132
1133     $ref = \&fred ;
1134     SaveSub1($ref) ;
1135     $ref = 47 ;
1136     CallSavedSub1() ;
1137
1138 you can expect one of these messages (which you actually get is dependant on 
1139 the version of Perl you are using) 
1140
1141     Not a CODE reference at ...
1142     Undefined subroutine &main::47 called ...
1143
1144 The variable C<$ref> may have referred to the subroutine C<fred>
1145 whenever the call to C<SaveSub1> was made but by the time
1146 C<CallSavedSub1> gets called it now holds the number C<47>. Since we
1147 saved only a pointer to the original SV in C<SaveSub1>, any changes to
1148 C<$ref> will be tracked by the pointer C<rememberSub>. This means that
1149 whenever C<CallSavedSub1> gets called, it will attempt to execute the
1150 code which is referenced by the SV* C<rememberSub>.  In this case
1151 though, it now refers to the integer C<47>, so expect Perl to complain
1152 loudly.
1153
1154 A similar but more subtle problem is illustrated with this code
1155
1156     $ref = \&fred ;
1157     SaveSub1($ref) ;
1158     $ref = \&joe ;
1159     CallSavedSub1() ;
1160
1161 This time whenever C<CallSavedSub1> get called it will execute the Perl
1162 subroutine C<joe> (assuming it exists) rather than C<fred> as was 
1163 originally requested in the call to C<SaveSub1>.
1164
1165 To get around these problems it is necessary to take a full copy of the
1166 SV.  The code below shows C<SaveSub2> modified to do that
1167
1168     static SV * keepSub = (SV*)NULL ;
1169
1170     void
1171     SaveSub2(name)
1172         SV *    name
1173         CODE:
1174         /* Take a copy of the callback */
1175         if (keepSub == (SV*)NULL)
1176             /* First time, so create a new SV */
1177             keepSub = newSVsv(name) ;
1178         else
1179             /* Been here before, so overwrite */
1180             SvSetSV(keepSub, name) ;
1181
1182     void
1183     CallSavedSub2()
1184         CODE:
1185         PUSHMARK(sp) ;
1186         perl_call_sv(keepSub, G_DISCARD|G_NOARGS) ;
1187
1188 In order to avoid creating a new SV every time C<SaveSub2> is called,
1189 the function first checks to see if it has been called before.  If not,
1190 then space for a new SV is allocated and the reference to the Perl
1191 subroutine, C<name> is copied to the variable C<keepSub> in one
1192 operation using C<newSVsv>.  Thereafter, whenever C<SaveSub2> is called
1193 the existing SV, C<keepSub>, is overwritten with the new value using
1194 C<SvSetSV>.
1195
1196 =head2 Using perl_call_argv
1197
1198 Here is a Perl subroutine which prints whatever parameters are passed
1199 to it.
1200
1201     sub PrintList
1202     {
1203         my(@list) = @_ ;
1204
1205         foreach (@list) { print "$_\n" }
1206     }
1207
1208 and here is an example of I<perl_call_argv> which will call
1209 I<PrintList>.
1210
1211     static char * words[] = {"alpha", "beta", "gamma", "delta", NULL} ;
1212
1213     static void
1214     call_PrintList()
1215     {
1216         dSP ;
1217
1218         perl_call_argv("PrintList", G_DISCARD, words) ;
1219     }
1220
1221 Note that it is not necessary to call C<PUSHMARK> in this instance.
1222 This is because I<perl_call_argv> will do it for you.
1223
1224 =head2 Using perl_call_method
1225
1226 Consider the following Perl code
1227
1228     {
1229         package Mine ;
1230
1231         sub new
1232         {
1233             my($type) = shift ;
1234             bless [@_]
1235         }
1236
1237         sub Display
1238         {
1239             my ($self, $index) = @_ ;
1240             print "$index: $$self[$index]\n" ;
1241         }
1242
1243         sub PrintID
1244         {
1245             my($class) = @_ ;
1246             print "This is Class $class version 1.0\n" ;
1247         }
1248     }
1249
1250 It just implements a very simple class to manage an array.  Apart from
1251 the constructor, C<new>, it declares methods, one static and one
1252 virtual. The static method, C<PrintID>, simply prints out the class
1253 name and a version number. The virtual method, C<Display>, prints out a
1254 single element of the array.  Here is an all Perl example of using it.
1255
1256     $a = new Mine ('red', 'green', 'blue') ;
1257     $a->Display(1) ;
1258     PrintID Mine;
1259
1260 will print
1261
1262     1: green
1263     This is Class Mine version 1.0 
1264
1265 Calling a Perl method from C is fairly straightforward. The following
1266 things are required
1267
1268 =over 5
1269
1270 =item *
1271
1272 a reference to the object for a virtual method or the name of the class
1273 for a static method.
1274
1275 =item *
1276
1277 the name of the method.
1278
1279 =item *
1280
1281 any other parameters specific to the method.
1282
1283 =back
1284
1285 Here is a simple XSUB which illustrates the mechanics of calling both
1286 the C<PrintID> and C<Display> methods from C.
1287
1288     void
1289     call_Method(ref, method, index)
1290         SV *    ref
1291         char *  method
1292         int             index
1293         CODE:
1294         PUSHMARK(sp);
1295         XPUSHs(ref);
1296         XPUSHs(sv_2mortal(newSViv(index))) ;
1297         PUTBACK;
1298
1299         perl_call_method(method, G_DISCARD) ;
1300
1301     void
1302     call_PrintID(class, method)
1303         char *  class
1304         char *  method
1305         CODE:
1306         PUSHMARK(sp);
1307         XPUSHs(sv_2mortal(newSVpv(class, 0))) ;
1308         PUTBACK;
1309
1310         perl_call_method(method, G_DISCARD) ;
1311
1312
1313 So the methods C<PrintID> and C<Display> can be invoked like this
1314
1315     $a = new Mine ('red', 'green', 'blue') ;
1316     call_Method($a, 'Display', 1) ;
1317     call_PrintID('Mine', 'PrintID') ;
1318
1319 The only thing to note is that in both the static and virtual methods,
1320 the method name is not passed via the stack - it is used as the first
1321 parameter to I<perl_call_method>.
1322
1323 =head2 Using GIMME
1324
1325 Here is a trivial XSUB which prints the context in which it is 
1326 currently executing.
1327
1328     void
1329     PrintContext()
1330         CODE:
1331         if (GIMME == G_SCALAR)
1332             printf ("Context is Scalar\n") ;
1333         else
1334             printf ("Context is Array\n") ;
1335
1336 and here is some Perl to test it
1337
1338     $a = PrintContext ;
1339     @a = PrintContext ;
1340
1341 The output from that will be
1342
1343     Context is Scalar
1344     Context is Array
1345
1346 =head2 Using Perl to dispose of temporaries
1347
1348 In the examples given to date, any temporaries created in the callback
1349 (i.e. parameters passed on the stack to the I<perl_call_*> function or
1350 values returned via the stack) have been freed by one of these methods
1351
1352 =over 5
1353
1354 =item *
1355
1356 specifying the G_DISCARD flag with I<perl_call_*>.
1357
1358 =item *
1359
1360 explicitly disposed of using the C<ENTER>/C<SAVETMPS> -
1361 C<FREETMPS>/C<LEAVE> pairing.
1362
1363 =back
1364
1365 There is another method which can be used, namely letting Perl do it
1366 for you automatically whenever it regains control after the callback
1367 has terminated.  This is done by simply not using the
1368
1369     ENTER ;
1370     SAVETMPS ;
1371     ...
1372     FREETMPS ;
1373     LEAVE ;
1374
1375 sequence in the callback (and not, of course, specifying the G_DISCARD
1376 flag).
1377
1378 If you are going to use this method you have to be aware of a possible
1379 memory leak which can arise under very specific circumstances.  To
1380 explain these circumstances you need to know a bit about the flow of
1381 control between Perl and the callback routine.
1382
1383 The examples given at the start of the document (an error handler and
1384 an event driven program) are typical of the two main sorts of flow
1385 control that you are likely to encounter with callbacks.  There is a
1386 very important distinction between them, so pay attention.
1387
1388 In the first example, an error handler, the flow of control could be as
1389 follows.  You have created an interface to an external library.
1390 Control can reach the external library like this
1391
1392     perl --> XSUB --> external library
1393
1394 Whilst control is in the library, an error condition occurs. You have
1395 previously set up a Perl callback to handle this situation, so it will
1396 get executed. Once the callback has finished, control will drop back to
1397 Perl again.  Here is what the flow of control will be like in that
1398 situation
1399
1400     perl --> XSUB --> external library
1401                       ...
1402                       error occurs
1403                       ...
1404                       external library --> perl_call --> perl
1405                                                           |
1406     perl <-- XSUB <-- external library <-- perl_call <----+
1407
1408 After processing of the error using I<perl_call_*> is completed,
1409 control reverts back to Perl more or less immediately.
1410
1411 In the diagram, the further right you go the more deeply nested the
1412 scope is.  It is only when control is back with perl on the extreme
1413 left of the diagram that you will have dropped back to the enclosing
1414 scope and any temporaries you have left hanging around will be freed.
1415
1416 In the second example, an event driven program, the flow of control
1417 will be more like this
1418
1419     perl --> XSUB --> event handler
1420                       ...
1421                       event handler --> perl_call --> perl 
1422                                                        |
1423                       event handler <-- perl_call --<--+
1424                       ...
1425                       event handler --> perl_call --> perl 
1426                                                        |
1427                       event handler <-- perl_call --<--+
1428                       ...
1429                       event handler --> perl_call --> perl 
1430                                                        |
1431                       event handler <-- perl_call --<--+
1432
1433 In this case the flow of control can consist of only the repeated
1434 sequence
1435
1436     event handler --> perl_call --> perl
1437
1438 for the practically the complete duration of the program.  This means
1439 that control may I<never> drop back to the surrounding scope in Perl at
1440 the extreme left.
1441
1442 So what is the big problem? Well, if you are expecting Perl to tidy up
1443 those temporaries for you, you might be in for a long wait.  For Perl
1444 to actually dispose of your temporaries, control must drop back to the
1445 enclosing scope at some stage.  In the event driven scenario that may
1446 never happen.  This means that as time goes on, your program will
1447 create more and more temporaries, none of which will ever be freed. As
1448 each of these temporaries consumes some memory your program will
1449 eventually consume all the available memory in your system - kapow!
1450
1451 So here is the bottom line - if you are sure that control will revert
1452 back to the enclosing Perl scope fairly quickly after the end of your
1453 callback, then it isn't absolutely necessary to explicitly dispose of
1454 any temporaries you may have created. Mind you, if you are at all
1455 uncertain about what to do, it doesn't do any harm to tidy up anyway.
1456
1457
1458 =head2 Strategies for storing Callback Context Information
1459
1460
1461 Potentially one of the trickiest problems to overcome when designing a
1462 callback interface can be figuring out how to store the mapping between
1463 the C callback function and the Perl equivalent.
1464
1465 To help understand why this can be a real problem first consider how a
1466 callback is set up in an all C environment.  Typically a C API will
1467 provide a function to register a callback.  This will expect a pointer
1468 to a function as one of its parameters.  Below is a call to a
1469 hypothetical function C<register_fatal> which registers the C function
1470 to get called when a fatal error occurs.
1471
1472     register_fatal(cb1) ;
1473
1474 The single parameter C<cb1> is a pointer to a function, so you must
1475 have defined C<cb1> in your code, say something like this
1476
1477     static void
1478     cb1()
1479     {
1480         printf ("Fatal Error\n") ;
1481         exit(1) ;
1482     }
1483
1484 Now change that to call a Perl subroutine instead
1485
1486     static SV * callback = (SV*)NULL;
1487
1488     static void
1489     cb1()
1490     {
1491         dSP ;
1492
1493         PUSHMARK(sp) ;
1494
1495         /* Call the Perl sub to process the callback */
1496         perl_call_sv(callback, G_DISCARD) ;
1497     }
1498
1499
1500     void
1501     register_fatal(fn)
1502         SV *    fn
1503         CODE:
1504         /* Remember the Perl sub */
1505         if (callback == (SV*)NULL)
1506             callback = newSVsv(fn) ;
1507         else
1508             SvSetSV(callback, fn) ;
1509
1510         /* register the callback with the external library */
1511         register_fatal(cb1) ;
1512
1513 where the Perl equivalent of C<register_fatal> and the callback it
1514 registers, C<pcb1>, might look like this
1515
1516     # Register the sub pcb1
1517     register_fatal(\&pcb1) ;
1518
1519     sub pcb1
1520     {
1521         die "I'm dying...\n" ;
1522     }
1523
1524 The mapping between the C callback and the Perl equivalent is stored in
1525 the global variable C<callback>.
1526
1527 This will be adequate if you ever need to have only 1 callback
1528 registered at any time. An example could be an error handler like the
1529 code sketched out above. Remember though, repeated calls to
1530 C<register_fatal> will replace the previously registered callback
1531 function with the new one.
1532
1533 Say for example you want to interface to a library which allows asynchronous
1534 file i/o.  In this case you may be able to register a callback whenever
1535 a read operation has completed. To be of any use we want to be able to
1536 call separate Perl subroutines for each file that is opened.  As it
1537 stands, the error handler example above would not be adequate as it
1538 allows only a single callback to be defined at any time. What we
1539 require is a means of storing the mapping between the opened file and
1540 the Perl subroutine we want to be called for that file.
1541
1542 Say the i/o library has a function C<asynch_read> which associates a C
1543 function C<ProcessRead> with a file handle C<fh> - this assumes that it
1544 has also provided some routine to open the file and so obtain the file
1545 handle.
1546
1547     asynch_read(fh, ProcessRead)
1548
1549 This may expect the C I<ProcessRead> function of this form
1550
1551     void
1552     ProcessRead(fh, buffer)
1553     int fh ;
1554     char *      buffer ;
1555     {
1556          ... 
1557     }
1558
1559 To provide a Perl interface to this library we need to be able to map
1560 between the C<fh> parameter and the Perl subroutine we want called.  A
1561 hash is a convenient mechanism for storing this mapping.  The code
1562 below shows a possible implementation
1563
1564     static HV * Mapping = (HV*)NULL ;
1565
1566     void
1567     asynch_read(fh, callback)
1568         int     fh
1569         SV *    callback
1570         CODE:
1571         /* If the hash doesn't already exist, create it */
1572         if (Mapping == (HV*)NULL)
1573             Mapping = newHV() ;
1574
1575         /* Save the fh -> callback mapping */
1576         hv_store(Mapping, (char*)&fh, sizeof(fh), newSVsv(callback), 0) ;
1577
1578         /* Register with the C Library */
1579         asynch_read(fh, asynch_read_if) ;
1580
1581 and C<asynch_read_if> could look like this
1582
1583     static void
1584     asynch_read_if(fh, buffer)
1585     int fh ;
1586     char *      buffer ;
1587     {
1588         dSP ;
1589         SV ** sv ;
1590
1591         /* Get the callback associated with fh */
1592         sv =  hv_fetch(Mapping, (char*)&fh , sizeof(fh), FALSE) ;
1593         if (sv == (SV**)NULL)
1594             croak("Internal error...\n") ;
1595
1596         PUSHMARK(sp) ;
1597         XPUSHs(sv_2mortal(newSViv(fh))) ;
1598         XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ;
1599         PUTBACK ;
1600
1601         /* Call the Perl sub */
1602         perl_call_sv(*sv, G_DISCARD) ;
1603     }
1604
1605 For completeness, here is C<asynch_close>.  This shows how to remove
1606 the entry from the hash C<Mapping>.
1607
1608     void
1609     asynch_close(fh)
1610         int     fh
1611         CODE:
1612         /* Remove the entry from the hash */
1613         (void) hv_delete(Mapping, (char*)&fh, sizeof(fh), G_DISCARD) ;
1614
1615         /* Now call the real asynch_close */
1616         asynch_close(fh) ;
1617
1618 So the Perl interface would look like this
1619
1620     sub callback1
1621     {
1622         my($handle, $buffer) = @_ ;
1623     }
1624
1625     # Register the Perl callback
1626     asynch_read($fh, \&callback1) ;
1627
1628     asynch_close($fh) ;
1629
1630 The mapping between the C callback and Perl is stored in the global
1631 hash C<Mapping> this time. Using a hash has the distinct advantage that
1632 it allows an unlimited number of callbacks to be registered.
1633
1634 What if the interface provided by the C callback doesn't contain a
1635 parameter which allows the file handle to Perl subroutine mapping?  Say
1636 in the asynchronous i/o package, the callback function gets passed only
1637 the C<buffer> parameter like this
1638
1639     void
1640     ProcessRead(buffer)
1641     char *      buffer ;
1642     {
1643         ...
1644     }
1645
1646 Without the file handle there is no straightforward way to map from the
1647 C callback to the Perl subroutine.
1648
1649 In this case a possible way around this problem is to pre-define a
1650 series of C functions to act as the interface to Perl, thus
1651
1652     #define MAX_CB              3
1653     #define NULL_HANDLE -1
1654     typedef void (*FnMap)() ;
1655
1656     struct MapStruct {
1657         FnMap    Function ;
1658         SV *     PerlSub ;
1659         int      Handle ;
1660       } ;
1661
1662     static void  fn1() ;
1663     static void  fn2() ;
1664     static void  fn3() ;
1665
1666     static struct MapStruct Map [MAX_CB] =
1667         {
1668             { fn1, NULL, NULL_HANDLE },
1669             { fn2, NULL, NULL_HANDLE },
1670             { fn3, NULL, NULL_HANDLE }
1671         } ;
1672
1673     static void
1674     Pcb(index, buffer)
1675     int index ;
1676     char * buffer ;
1677     {
1678         dSP ;
1679
1680         PUSHMARK(sp) ;
1681         XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ;
1682         PUTBACK ;
1683
1684         /* Call the Perl sub */
1685         perl_call_sv(Map[index].PerlSub, G_DISCARD) ;
1686     }
1687
1688     static void
1689     fn1(buffer)
1690     char * buffer ;
1691     {
1692         Pcb(0, buffer) ;
1693     }
1694
1695     static void
1696     fn2(buffer)
1697     char * buffer ;
1698     {
1699         Pcb(1, buffer) ;
1700     }
1701
1702     static void
1703     fn3(buffer)
1704     char * buffer ;
1705     {
1706         Pcb(2, buffer) ;
1707     }
1708
1709     void
1710     array_asynch_read(fh, callback)
1711         int             fh
1712         SV *    callback
1713         CODE:
1714         int index ;
1715         int null_index = MAX_CB ;
1716
1717         /* Find the same handle or an empty entry */
1718         for (index = 0 ; index < MAX_CB ; ++index)
1719         {
1720             if (Map[index].Handle == fh)
1721                 break ;
1722
1723             if (Map[index].Handle == NULL_HANDLE)
1724                 null_index = index ;
1725         }
1726
1727         if (index == MAX_CB && null_index == MAX_CB)
1728             croak ("Too many callback functions registered\n") ;
1729
1730         if (index == MAX_CB)
1731             index = null_index ;
1732
1733         /* Save the file handle */
1734         Map[index].Handle = fh ;
1735
1736         /* Remember the Perl sub */
1737         if (Map[index].PerlSub == (SV*)NULL)
1738             Map[index].PerlSub = newSVsv(callback) ;
1739         else
1740             SvSetSV(Map[index].PerlSub, callback) ;
1741
1742         asynch_read(fh, Map[index].Function) ;
1743
1744     void
1745     array_asynch_close(fh)
1746         int     fh
1747         CODE:
1748         int index ;
1749
1750         /* Find the file handle */
1751         for (index = 0; index < MAX_CB ; ++ index)
1752             if (Map[index].Handle == fh)
1753                 break ;
1754
1755         if (index == MAX_CB)
1756             croak ("could not close fh %d\n", fh) ;
1757
1758         Map[index].Handle = NULL_HANDLE ;
1759         SvREFCNT_dec(Map[index].PerlSub) ;
1760         Map[index].PerlSub = (SV*)NULL ;
1761
1762         asynch_close(fh) ;
1763
1764 In this case the functions C<fn1>, C<fn2> and C<fn3> are used to
1765 remember the Perl subroutine to be called. Each of the functions holds
1766 a separate hard-wired index which is used in the function C<Pcb> to
1767 access the C<Map> array and actually call the Perl subroutine.
1768
1769 There are some obvious disadvantages with this technique.
1770
1771 Firstly, the code is considerably more complex than with the previous
1772 example.
1773
1774 Secondly, there is a hard-wired limit (in this case 3) to the number of
1775 callbacks that can exist simultaneously. The only way to increase the
1776 limit is by modifying the code to add more functions and then
1777 re-compiling.  None the less, as long as the number of functions is
1778 chosen with some care, it is still a workable solution and in some
1779 cases is the only one available.
1780
1781 To summarize, here are a number of possible methods for you to consider
1782 for storing the mapping between C and the Perl callback
1783
1784 =over 5
1785
1786 =item 1. Ignore the problem - Allow only 1 callback
1787
1788 For a lot of situations, like interfacing to an error handler, this may
1789 be a perfectly adequate solution.
1790
1791 =item 2. Create a sequence of callbacks - hard wired limit
1792
1793 If it is impossible to tell from the parameters passed back from the C
1794 callback what the context is, then you may need to create a sequence of C
1795 callback interface functions, and store pointers to each in an array.
1796
1797 =item 3. Use a parameter to map to the Perl callback
1798
1799 A hash is an ideal mechanism to store the mapping between C and Perl.
1800
1801 =back
1802
1803
1804 =head2 Alternate Stack Manipulation
1805
1806
1807 Although I have made use of only the C<POP*> macros to access values
1808 returned from Perl subroutines, it is also possible to bypass these
1809 macros and read the stack using the C<ST> macro (See L<perlxs> for a
1810 full description of the C<ST> macro).
1811
1812 Most of the time the C<POP*> macros should be adequate, the main
1813 problem with them is that they force you to process the returned values
1814 in sequence. This may not be the most suitable way to process the
1815 values in some cases. What we want is to be able to access the stack in
1816 a random order. The C<ST> macro as used when coding an XSUB is ideal
1817 for this purpose.
1818
1819 The code below is the example given in the section I<Returning a list
1820 of values> recoded to use C<ST> instead of C<POP*>.
1821
1822     static void
1823     call_AddSubtract2(a, b)
1824     int a ;
1825     int b ;
1826     {
1827         dSP ;
1828         I32 ax ;
1829         int count ;
1830
1831         ENTER ;
1832         SAVETMPS;
1833
1834         PUSHMARK(sp) ;
1835         XPUSHs(sv_2mortal(newSViv(a)));
1836         XPUSHs(sv_2mortal(newSViv(b)));
1837         PUTBACK ;
1838
1839         count = perl_call_pv("AddSubtract", G_ARRAY);
1840
1841         SPAGAIN ;
1842         sp -= count ;
1843         ax = (sp - stack_base) + 1 ;
1844
1845         if (count != 2)
1846             croak("Big trouble\n") ;
1847
1848         printf ("%d + %d = %d\n", a, b, SvIV(ST(0))) ;
1849         printf ("%d - %d = %d\n", a, b, SvIV(ST(1))) ;
1850
1851         PUTBACK ;
1852         FREETMPS ;
1853         LEAVE ;
1854     }
1855
1856 Notes
1857
1858 =over 5
1859
1860 =item 1.
1861
1862 Notice that it was necessary to define the variable C<ax>.  This is
1863 because the C<ST> macro expects it to exist.  If we were in an XSUB it
1864 would not be necessary to define C<ax> as it is already defined for
1865 you.
1866
1867 =item 2.
1868
1869 The code
1870
1871         SPAGAIN ;
1872         sp -= count ;
1873         ax = (sp - stack_base) + 1 ;
1874
1875 sets the stack up so that we can use the C<ST> macro.
1876
1877 =item 3.
1878
1879 Unlike the original coding of this example, the returned
1880 values are not accessed in reverse order.  So C<ST(0)> refers to the
1881 first value returned by the Perl subroutine and C<ST(count-1)> 
1882 refers to the last.
1883
1884 =back
1885
1886 =head1 SEE ALSO
1887
1888 L<perlxs>, L<perlguts>, L<perlembed>
1889
1890 =head1 AUTHOR
1891
1892 Paul Marquess <pmarquess@bfsec.bt.co.uk>
1893
1894 Special thanks to the following people who assisted in the creation of
1895 the document.
1896
1897 Jeff Okamoto, Tim Bunce, Nick Gianniotis, Steve Kelem, Gurusamy Sarathy
1898 and Larry Wall.
1899
1900 =head1 DATE
1901
1902 Version 1.2, 16th Jan 1996