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