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