This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
548294a38e67aef7232210de7c9ce443f76651e9
[perl5.git] / embed.pl
1 #!/usr/bin/perl -w
2
3 require 5.003;  # keep this compatible, an old perl is all we may have before
4                 # we build the new one
5
6 #
7 # See database of global and static function prototypes in embed.fnc
8 # This is used to generate prototype headers under various configurations,
9 # export symbols lists for different platforms, and macros to provide an
10 # implicit interpreter context argument.
11 #
12
13 sub do_not_edit ($)
14 {
15     my $file = shift;
16     my $warning = <<EOW;
17
18    $file
19
20    Copyright (c) 1997-2002, Larry Wall
21
22    You may distribute under the terms of either the GNU General Public
23    License or the Artistic License, as specified in the README file.
24
25 !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
26 This file is built by embed.pl from data in embed.fnc, embed.pl,
27 pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
28 Any changes made here will be lost!
29
30 Edit those files and run 'make regen_headers' to effect changes.
31
32 EOW
33
34     if ($file =~ m:\.[ch]$:) {
35 $warning =~ s:^: * :gm;
36 $warning =~ s: +$::gm;
37 $warning =~ s: :/:;
38 $warning =~ s:$:/:;
39     }
40     else {
41 $warning =~ s:^:# :gm;
42 $warning =~ s: +$::gm;
43     }
44     $warning;
45 } # do_not_edit
46
47 open IN, "embed.fnc" or die $!;
48
49 # walk table providing an array of components in each line to
50 # subroutine, printing the result
51 sub walk_table (&@) {
52     my $function = shift;
53     my $filename = shift || '-';
54     my $leader = shift || do_not_edit ($filename);
55     my $trailer = shift;
56     my $F;
57     local *F;
58     if (ref $filename) {        # filehandle
59         $F = $filename;
60     }
61     else {
62         unlink $filename;
63         open F, ">$filename" or die "Can't open $filename: $!";
64         $F = \*F;
65     }
66     print $F $leader if $leader;
67     seek IN, 0, 0;              # so we may restart
68     while (<IN>) {
69         chomp;
70         next if /^:/;
71         while (s|\\$||) {
72             $_ .= <IN>;
73             chomp;
74         }
75         my @args;
76         if (/^\s*(#|$)/) {
77             @args = $_;
78         }
79         else {
80             @args = split /\s*\|\s*/, $_;
81         }
82         my @outs = &{$function}(@args);
83         print $F @outs; # $function->(@args) is not 5.003
84     }
85     print $F $trailer if $trailer;
86     close $F unless ref $filename;
87 }
88
89 sub munge_c_files () {
90     my $functions = {};
91     unless (@ARGV) {
92         warn "\@ARGV empty, nothing to do\n";
93         return;
94     }
95     walk_table {
96         if (@_ > 1) {
97             $functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
98         }
99     } '/dev/null';
100     local $^I = '.bak';
101     while (<>) {
102 #       if (/^#\s*include\s+"perl.h"/) {
103 #           my $file = uc $ARGV;
104 #           $file =~ s/\./_/g;
105 #           print "#define PERL_IN_$file\n";
106 #       }
107 #       s{^(\w+)\s*\(}
108 #        {
109 #           my $f = $1;
110 #           my $repl = "$f(";
111 #           if (exists $functions->{$f}) {
112 #               my $flags = $functions->{$f}[0];
113 #               $repl = "Perl_$repl" if $flags =~ /p/;
114 #               unless ($flags =~ /n/) {
115 #                   $repl .= "pTHX";
116 #                   $repl .= "_ " if @{$functions->{$f}} > 3;
117 #               }
118 #               warn("$ARGV:$.:$repl\n");
119 #           }
120 #           $repl;
121 #        }e;
122         s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))}
123          {
124             my $repl = $1;
125             my $f = $2;
126             if (exists $functions->{$f}) {
127                 $repl .= "aTHX_ ";
128                 warn("$ARGV:$.:$`#$repl#$'");
129             }
130             $repl;
131          }eg;
132         print;
133         close ARGV if eof;      # restart $.
134     }
135     exit;
136 }
137
138 #munge_c_files();
139
140 # generate proto.h
141 my $wrote_protected = 0;
142
143 sub write_protos {
144     my $ret = "";
145     if (@_ == 1) {
146         my $arg = shift;
147         $ret .= "$arg\n";
148     }
149     else {
150         my ($flags,$retval,$func,@args) = @_;
151         $ret .= '/* ' if $flags =~ /m/;
152         if ($flags =~ /s/) {
153             $retval = "STATIC $retval";
154             $func = "S_$func";
155         }
156         else {
157             $retval = "PERL_CALLCONV $retval";
158             if ($flags =~ /p/) {
159                 $func = "Perl_$func";
160             }
161         }
162         $ret .= "$retval\t$func(";
163         unless ($flags =~ /n/) {
164             $ret .= "pTHX";
165             $ret .= "_ " if @args;
166         }
167         if (@args) {
168             $ret .= join ", ", @args;
169         }
170         else {
171             $ret .= "void" if $flags =~ /n/;
172         }
173         $ret .= ")";
174         $ret .= " __attribute__((noreturn))" if $flags =~ /r/;
175         if( $flags =~ /f/ ) {
176             my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
177             my $args = scalar @args;
178             $ret .= "\n#ifdef CHECK_FORMAT\n";
179             $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
180                                     $prefix, $args - 1, $prefix, $args;
181             $ret .= "\n#endif\n";
182         }
183         $ret .= ";";
184         $ret .= ' */' if $flags =~ /m/;
185         $ret .= "\n";
186     }
187     $ret;
188 }
189
190 # generates global.sym (API export list), and populates %global with global symbols
191 sub write_global_sym {
192     my $ret = "";
193     if (@_ > 1) {
194         my ($flags,$retval,$func,@args) = @_;
195         if ($flags =~ /A/ && $flags !~ /[xm]/) { # public API, so export
196             $func = "Perl_$func" if $flags =~ /p/;
197             $ret = "$func\n";
198         }
199     }
200     $ret;
201 }
202
203 walk_table(\&write_protos,     "proto.h");
204 walk_table(\&write_global_sym, "global.sym");
205
206 # XXX others that may need adding
207 #       warnhook
208 #       hints
209 #       copline
210 my @extvars = qw(sv_undef sv_yes sv_no na dowarn
211                  curcop compiling
212                  tainting tainted stack_base stack_sp sv_arenaroot
213                  no_modify
214                  curstash DBsub DBsingle debstash
215                  rsfp
216                  stdingv
217                  defgv
218                  errgv
219                  rsfp_filters
220                  perldb
221                  diehook
222                  dirty
223                  perl_destruct_level
224                  ppaddr
225                 );
226
227 sub readsyms (\%$) {
228     my ($syms, $file) = @_;
229     local (*FILE, $_);
230     open(FILE, "< $file")
231         or die "embed.pl: Can't open $file: $!\n";
232     while (<FILE>) {
233         s/[ \t]*#.*//;          # Delete comments.
234         if (/^\s*(\S+)\s*$/) {
235             my $sym = $1;
236             warn "duplicate symbol $sym while processing $file\n"
237                 if exists $$syms{$sym};
238             $$syms{$sym} = 1;
239         }
240     }
241     close(FILE);
242 }
243
244 # Perl_pp_* and Perl_ck_* are in pp.sym
245 readsyms my %ppsym, 'pp.sym';
246
247 sub readvars(\%$$@) {
248     my ($syms, $file,$pre,$keep_pre) = @_;
249     local (*FILE, $_);
250     open(FILE, "< $file")
251         or die "embed.pl: Can't open $file: $!\n";
252     while (<FILE>) {
253         s/[ \t]*#.*//;          # Delete comments.
254         if (/PERLVARA?I?C?\($pre(\w+)/) {
255             my $sym = $1;
256             $sym = $pre . $sym if $keep_pre;
257             warn "duplicate symbol $sym while processing $file\n"
258                 if exists $$syms{$sym};
259             $$syms{$sym} = $pre || 1;
260         }
261     }
262     close(FILE);
263 }
264
265 my %intrp;
266 my %thread;
267
268 readvars %intrp,  'intrpvar.h','I';
269 readvars %thread, 'thrdvar.h','T';
270 readvars %globvar, 'perlvars.h','G';
271
272 my $sym;
273 foreach $sym (sort keys %thread) {
274   warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
275 }
276
277 sub undefine ($) {
278     my ($sym) = @_;
279     "#undef  $sym\n";
280 }
281
282 sub hide ($$) {
283     my ($from, $to) = @_;
284     my $t = int(length($from) / 8);
285     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
286 }
287
288 sub bincompat_var ($$) {
289     my ($pfx, $sym) = @_;
290     my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX');
291     undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
292 }
293
294 sub multon ($$$) {
295     my ($sym,$pre,$ptr) = @_;
296     hide("PL_$sym", "($ptr$pre$sym)");
297 }
298
299 sub multoff ($$) {
300     my ($sym,$pre) = @_;
301     return hide("PL_$pre$sym", "PL_$sym");
302 }
303
304 unlink 'embed.h';
305 open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
306
307 print EM do_not_edit ("embed.h"), <<'END';
308
309 /* (Doing namespace management portably in C is really gross.) */
310
311 /* NO_EMBED is no longer supported. i.e. EMBED is always active. */
312
313 /* Hide global symbols */
314
315 #if !defined(PERL_IMPLICIT_CONTEXT)
316
317 END
318
319 walk_table {
320     my $ret = "";
321     if (@_ == 1) {
322         my $arg = shift;
323         $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
324     }
325     else {
326         my ($flags,$retval,$func,@args) = @_;
327         unless ($flags =~ /[om]/) {
328             if ($flags =~ /s/) {
329                 $ret .= hide($func,"S_$func");
330             }
331             elsif ($flags =~ /p/) {
332                 $ret .= hide($func,"Perl_$func");
333             }
334         }
335     }
336     $ret;
337 } \*EM;
338
339 for $sym (sort keys %ppsym) {
340     $sym =~ s/^Perl_//;
341     print EM hide($sym, "Perl_$sym");
342 }
343
344 print EM <<'END';
345
346 #else   /* PERL_IMPLICIT_CONTEXT */
347
348 END
349
350 my @az = ('a'..'z');
351
352 walk_table {
353     my $ret = "";
354     if (@_ == 1) {
355         my $arg = shift;
356         $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
357     }
358     else {
359         my ($flags,$retval,$func,@args) = @_;
360         unless ($flags =~ /[om]/) {
361             my $args = scalar @args;
362             if ($args and $args[$args-1] =~ /\.\.\./) {
363                 # we're out of luck for varargs functions under CPP
364             }
365             elsif ($flags =~ /n/) {
366                 if ($flags =~ /s/) {
367                     $ret .= hide($func,"S_$func");
368                 }
369                 elsif ($flags =~ /p/) {
370                     $ret .= hide($func,"Perl_$func");
371                 }
372             }
373             else {
374                 my $alist = join(",", @az[0..$args-1]);
375                 $ret = "#define $func($alist)";
376                 my $t = int(length($ret) / 8);
377                 $ret .=  "\t" x ($t < 4 ? 4 - $t : 1);
378                 if ($flags =~ /s/) {
379                     $ret .= "S_$func(aTHX";
380                 }
381                 elsif ($flags =~ /p/) {
382                     $ret .= "Perl_$func(aTHX";
383                 }
384                 $ret .= "_ " if $alist;
385                 $ret .= $alist . ")\n";
386             }
387         }
388     }
389     $ret;
390 } \*EM;
391
392 for $sym (sort keys %ppsym) {
393     $sym =~ s/^Perl_//;
394     if ($sym =~ /^ck_/) {
395         print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
396     }
397     elsif ($sym =~ /^pp_/) {
398         print EM hide("$sym()", "Perl_$sym(aTHX)");
399     }
400     else {
401         warn "Illegal symbol '$sym' in pp.sym";
402     }
403 }
404
405 print EM <<'END';
406
407 #endif  /* PERL_IMPLICIT_CONTEXT */
408
409 END
410
411 print EM <<'END';
412
413 /* Compatibility stubs.  Compile extensions with -DPERL_NOCOMPAT to
414    disable them.
415  */
416
417 #if !defined(PERL_CORE)
418 #  define sv_setptrobj(rv,ptr,name)     sv_setref_iv(rv,name,PTR2IV(ptr))
419 #  define sv_setptrref(rv,ptr)          sv_setref_iv(rv,Nullch,PTR2IV(ptr))
420 #endif
421
422 #if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
423
424 /* Compatibility for various misnamed functions.  All functions
425    in the API that begin with "perl_" (not "Perl_") take an explicit
426    interpreter context pointer.
427    The following are not like that, but since they had a "perl_"
428    prefix in previous versions, we provide compatibility macros.
429  */
430 #  define perl_atexit(a,b)              call_atexit(a,b)
431 #  define perl_call_argv(a,b,c)         call_argv(a,b,c)
432 #  define perl_call_pv(a,b)             call_pv(a,b)
433 #  define perl_call_method(a,b)         call_method(a,b)
434 #  define perl_call_sv(a,b)             call_sv(a,b)
435 #  define perl_eval_sv(a,b)             eval_sv(a,b)
436 #  define perl_eval_pv(a,b)             eval_pv(a,b)
437 #  define perl_require_pv(a)            require_pv(a)
438 #  define perl_get_sv(a,b)              get_sv(a,b)
439 #  define perl_get_av(a,b)              get_av(a,b)
440 #  define perl_get_hv(a,b)              get_hv(a,b)
441 #  define perl_get_cv(a,b)              get_cv(a,b)
442 #  define perl_init_i18nl10n(a)         init_i18nl10n(a)
443 #  define perl_init_i18nl14n(a)         init_i18nl14n(a)
444 #  define perl_new_ctype(a)             new_ctype(a)
445 #  define perl_new_collate(a)           new_collate(a)
446 #  define perl_new_numeric(a)           new_numeric(a)
447
448 /* varargs functions can't be handled with CPP macros. :-(
449    This provides a set of compatibility functions that don't take
450    an extra argument but grab the context pointer using the macro
451    dTHX.
452  */
453 #if defined(PERL_IMPLICIT_CONTEXT)
454 #  define croak                         Perl_croak_nocontext
455 #  define deb                           Perl_deb_nocontext
456 #  define die                           Perl_die_nocontext
457 #  define form                          Perl_form_nocontext
458 #  define load_module                   Perl_load_module_nocontext
459 #  define mess                          Perl_mess_nocontext
460 #  define newSVpvf                      Perl_newSVpvf_nocontext
461 #  define sv_catpvf                     Perl_sv_catpvf_nocontext
462 #  define sv_setpvf                     Perl_sv_setpvf_nocontext
463 #  define warn                          Perl_warn_nocontext
464 #  define warner                        Perl_warner_nocontext
465 #  define sv_catpvf_mg                  Perl_sv_catpvf_mg_nocontext
466 #  define sv_setpvf_mg                  Perl_sv_setpvf_mg_nocontext
467 #endif
468
469 #endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
470
471 #if !defined(PERL_IMPLICIT_CONTEXT)
472 /* undefined symbols, point them back at the usual ones */
473 #  define Perl_croak_nocontext          Perl_croak
474 #  define Perl_die_nocontext            Perl_die
475 #  define Perl_deb_nocontext            Perl_deb
476 #  define Perl_form_nocontext           Perl_form
477 #  define Perl_load_module_nocontext    Perl_load_module
478 #  define Perl_mess_nocontext           Perl_mess
479 #  define Perl_newSVpvf_nocontext       Perl_newSVpvf
480 #  define Perl_sv_catpvf_nocontext      Perl_sv_catpvf
481 #  define Perl_sv_setpvf_nocontext      Perl_sv_setpvf
482 #  define Perl_warn_nocontext           Perl_warn
483 #  define Perl_warner_nocontext         Perl_warner
484 #  define Perl_sv_catpvf_mg_nocontext   Perl_sv_catpvf_mg
485 #  define Perl_sv_setpvf_mg_nocontext   Perl_sv_setpvf_mg
486 #endif
487
488 END
489
490 close(EM);
491
492 unlink 'embedvar.h';
493 open(EM, '> embedvar.h')
494     or die "Can't create embedvar.h: $!\n";
495
496 print EM do_not_edit ("embedvar.h"), <<'END';
497
498 /* (Doing namespace management portably in C is really gross.) */
499
500 /*
501    The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
502    are supported:
503      1) none
504      2) MULTIPLICITY    # supported for compatibility
505      3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
506
507    All other combinations of these flags are errors.
508
509    only #3 is supported directly, while #2 is a special
510    case of #3 (supported by redefining vTHX appropriately).
511 */
512
513 #if defined(MULTIPLICITY)
514 /* cases 2 and 3 above */
515
516 #  if defined(PERL_IMPLICIT_CONTEXT)
517 #    define vTHX        aTHX
518 #  else
519 #    define vTHX        PERL_GET_INTERP
520 #  endif
521
522 END
523
524 for $sym (sort keys %thread) {
525     print EM multon($sym,'T','vTHX->');
526 }
527
528 print EM <<'END';
529
530 /* cases 2 and 3 above */
531
532 END
533
534 for $sym (sort keys %intrp) {
535     print EM multon($sym,'I','vTHX->');
536 }
537
538 print EM <<'END';
539
540 #else   /* !MULTIPLICITY */
541
542 /* case 1 above */
543
544 END
545
546 for $sym (sort keys %intrp) {
547     print EM multoff($sym,'I');
548 }
549
550 print EM <<'END';
551
552 END
553
554 for $sym (sort keys %thread) {
555     print EM multoff($sym,'T');
556 }
557
558 print EM <<'END';
559
560 #endif  /* MULTIPLICITY */
561
562 #if defined(PERL_GLOBAL_STRUCT)
563
564 END
565
566 for $sym (sort keys %globvar) {
567     print EM multon($sym,'G','PL_Vars.');
568 }
569
570 print EM <<'END';
571
572 #else /* !PERL_GLOBAL_STRUCT */
573
574 END
575
576 for $sym (sort keys %globvar) {
577     print EM multoff($sym,'G');
578 }
579
580 print EM <<'END';
581
582 #endif /* PERL_GLOBAL_STRUCT */
583
584 #ifdef PERL_POLLUTE             /* disabled by default in 5.6.0 */
585
586 END
587
588 for $sym (sort @extvars) {
589     print EM hide($sym,"PL_$sym");
590 }
591
592 print EM <<'END';
593
594 #endif /* PERL_POLLUTE */
595 END
596
597 close(EM);
598
599 unlink 'perlapi.h';
600 unlink 'perlapi.c';
601 open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
602 open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
603
604 print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
605
606 /* declare accessor functions for Perl variables */
607 #ifndef __perlapi_h__
608 #define __perlapi_h__
609
610 #if defined (MULTIPLICITY)
611
612 START_EXTERN_C
613
614 #undef PERLVAR
615 #undef PERLVARA
616 #undef PERLVARI
617 #undef PERLVARIC
618 #define PERLVAR(v,t)    EXTERN_C t* Perl_##v##_ptr(pTHX);
619 #define PERLVARA(v,n,t) typedef t PL_##v##_t[n];                        \
620                         EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
621 #define PERLVARI(v,t,i) PERLVAR(v,t)
622 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
623
624 #include "thrdvar.h"
625 #include "intrpvar.h"
626 #include "perlvars.h"
627
628 #undef PERLVAR
629 #undef PERLVARA
630 #undef PERLVARI
631 #undef PERLVARIC
632
633 END_EXTERN_C
634
635 #if defined(PERL_CORE)
636
637 /* accessor functions for Perl variables (provide binary compatibility) */
638
639 /* these need to be mentioned here, or most linkers won't put them in
640    the perl executable */
641
642 #ifndef PERL_NO_FORCE_LINK
643
644 START_EXTERN_C
645
646 #ifndef DOINIT
647 EXT void *PL_force_link_funcs[];
648 #else
649 EXT void *PL_force_link_funcs[] = {
650 #undef PERLVAR
651 #undef PERLVARA
652 #undef PERLVARI
653 #undef PERLVARIC
654 #define PERLVAR(v,t)    (void*)Perl_##v##_ptr,
655 #define PERLVARA(v,n,t) PERLVAR(v,t)
656 #define PERLVARI(v,t,i) PERLVAR(v,t)
657 #define PERLVARIC(v,t,i) PERLVAR(v,t)
658
659 #include "thrdvar.h"
660 #include "intrpvar.h"
661 #include "perlvars.h"
662
663 #undef PERLVAR
664 #undef PERLVARA
665 #undef PERLVARI
666 #undef PERLVARIC
667 };
668 #endif  /* DOINIT */
669
670 END_EXTERN_C
671
672 #endif  /* PERL_NO_FORCE_LINK */
673
674 #else   /* !PERL_CORE */
675
676 EOT
677
678 foreach $sym (sort keys %intrp) {
679     print CAPIH bincompat_var('I',$sym);
680 }
681
682 foreach $sym (sort keys %thread) {
683     print CAPIH bincompat_var('T',$sym);
684 }
685
686 foreach $sym (sort keys %globvar) {
687     print CAPIH bincompat_var('G',$sym);
688 }
689
690 print CAPIH <<'EOT';
691
692 #endif /* !PERL_CORE */
693 #endif /* MULTIPLICITY */
694
695 #endif /* __perlapi_h__ */
696
697 EOT
698 close CAPIH;
699
700 print CAPI do_not_edit ("perlapi.c"), <<'EOT';
701
702 #include "EXTERN.h"
703 #include "perl.h"
704 #include "perlapi.h"
705
706 #if defined (MULTIPLICITY)
707
708 /* accessor functions for Perl variables (provides binary compatibility) */
709 START_EXTERN_C
710
711 #undef PERLVAR
712 #undef PERLVARA
713 #undef PERLVARI
714 #undef PERLVARIC
715
716 #define PERLVAR(v,t)    t* Perl_##v##_ptr(pTHX)                         \
717                         { return &(aTHX->v); }
718 #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX)                \
719                         { return &(aTHX->v); }
720
721 #define PERLVARI(v,t,i) PERLVAR(v,t)
722 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
723
724 #include "thrdvar.h"
725 #include "intrpvar.h"
726
727 #undef PERLVAR
728 #undef PERLVARA
729 #define PERLVAR(v,t)    t* Perl_##v##_ptr(pTHX)                         \
730                         { return &(PL_##v); }
731 #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX)                \
732                         { return &(PL_##v); }
733 #undef PERLVARIC
734 #define PERLVARIC(v,t,i)        const t* Perl_##v##_ptr(pTHX)           \
735                         { return (const t *)&(PL_##v); }
736 #include "perlvars.h"
737
738 #undef PERLVAR
739 #undef PERLVARA
740 #undef PERLVARI
741 #undef PERLVARIC
742
743 END_EXTERN_C
744
745 #endif /* MULTIPLICITY */
746 EOT
747
748 close(CAPI);
749
750 # functions that take va_list* for implementing vararg functions
751 # NOTE: makedef.pl must be updated if you add symbols to %vfuncs
752 # XXX %vfuncs currently unused
753 my %vfuncs = qw(
754     Perl_croak                  Perl_vcroak
755     Perl_warn                   Perl_vwarn
756     Perl_warner                 Perl_vwarner
757     Perl_die                    Perl_vdie
758     Perl_form                   Perl_vform
759     Perl_load_module            Perl_vload_module
760     Perl_mess                   Perl_vmess
761     Perl_deb                    Perl_vdeb
762     Perl_newSVpvf               Perl_vnewSVpvf
763     Perl_sv_setpvf              Perl_sv_vsetpvf
764     Perl_sv_setpvf_mg           Perl_sv_vsetpvf_mg
765     Perl_sv_catpvf              Perl_sv_vcatpvf
766     Perl_sv_catpvf_mg           Perl_sv_vcatpvf_mg
767     Perl_dump_indent            Perl_dump_vindent
768     Perl_default_protect        Perl_vdefault_protect
769 );