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 );