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