This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate (by hand) #18353 and #18359 from maint-5.8:
[perl5.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
954c1994
GS
3require 5.003; # keep this compatible, an old perl is all we may have before
4 # we build the new one
5f05dabc 5
36bb303b
NC
6BEGIN {
7 # Get function prototypes
8 require 'regen.pl';
9}
10
cea2e8a9 11#
346f75ff 12# See database of global and static function prototypes in embed.fnc
cea2e8a9
GS
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
7f1be197
MB
18sub do_not_edit ($)
19{
20 my $file = shift;
21 my $warning = <<EOW;
22
23 $file
24
25 Copyright (c) 1997-2002, Larry Wall
26
27 You may distribute under the terms of either the GNU General Public
28 License or the Artistic License, as specified in the README file.
29
30!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
31This file is built by embed.pl from data in embed.fnc, embed.pl,
32pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
33Any changes made here will be lost!
34
35Edit those files and run 'make regen_headers' to effect changes.
36
37EOW
38
39 if ($file =~ m:\.[ch]$:) {
0ea9712b
MB
40 $warning =~ s:^: * :gm;
41 $warning =~ s: +$::gm;
42 $warning =~ s: :/:;
43 $warning =~ s:$:/:;
7f1be197
MB
44 }
45 else {
0ea9712b
MB
46 $warning =~ s:^:# :gm;
47 $warning =~ s: +$::gm;
7f1be197
MB
48 }
49 $warning;
50} # do_not_edit
51
94bdecf9 52open IN, "embed.fnc" or die $!;
cea2e8a9
GS
53
54# walk table providing an array of components in each line to
55# subroutine, printing the result
56sub walk_table (&@) {
57 my $function = shift;
58 my $filename = shift || '-';
0ea9712b
MB
59 my $leader = shift;
60 defined $leader or $leader = do_not_edit ($filename);
cea2e8a9
GS
61 my $trailer = shift;
62 my $F;
63 local *F;
64 if (ref $filename) { # filehandle
65 $F = $filename;
66 }
67 else {
36bb303b 68 safer_unlink $filename;
cea2e8a9
GS
69 open F, ">$filename" or die "Can't open $filename: $!";
70 $F = \*F;
71 }
72 print $F $leader if $leader;
94bdecf9
JH
73 seek IN, 0, 0; # so we may restart
74 while (<IN>) {
cea2e8a9 75 chomp;
1d7c1841 76 next if /^:/;
cea2e8a9 77 while (s|\\$||) {
94bdecf9 78 $_ .= <IN>;
cea2e8a9
GS
79 chomp;
80 }
81 my @args;
82 if (/^\s*(#|$)/) {
83 @args = $_;
84 }
85 else {
86 @args = split /\s*\|\s*/, $_;
87 }
4543f4c0
PP
88 my @outs = &{$function}(@args);
89 print $F @outs; # $function->(@args) is not 5.003
cea2e8a9
GS
90 }
91 print $F $trailer if $trailer;
36bb303b
NC
92 unless (ref $filename) {
93 close $F or die "Error closing $filename: $!";
94 }
cea2e8a9
GS
95}
96
97sub munge_c_files () {
98 my $functions = {};
99 unless (@ARGV) {
100 warn "\@ARGV empty, nothing to do\n";
101 return;
102 }
103 walk_table {
104 if (@_ > 1) {
105 $functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
106 }
0ea9712b 107 } '/dev/null', '';
cea2e8a9
GS
108 local $^I = '.bak';
109 while (<>) {
110# if (/^#\s*include\s+"perl.h"/) {
111# my $file = uc $ARGV;
112# $file =~ s/\./_/g;
113# print "#define PERL_IN_$file\n";
114# }
115# s{^(\w+)\s*\(}
116# {
117# my $f = $1;
118# my $repl = "$f(";
119# if (exists $functions->{$f}) {
120# my $flags = $functions->{$f}[0];
121# $repl = "Perl_$repl" if $flags =~ /p/;
122# unless ($flags =~ /n/) {
123# $repl .= "pTHX";
124# $repl .= "_ " if @{$functions->{$f}} > 3;
125# }
126# warn("$ARGV:$.:$repl\n");
127# }
128# $repl;
129# }e;
130 s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))}
131 {
132 my $repl = $1;
133 my $f = $2;
134 if (exists $functions->{$f}) {
135 $repl .= "aTHX_ ";
136 warn("$ARGV:$.:$`#$repl#$'");
137 }
138 $repl;
139 }eg;
140 print;
141 close ARGV if eof; # restart $.
142 }
143 exit;
144}
145
146#munge_c_files();
147
148# generate proto.h
0cb96387
GS
149my $wrote_protected = 0;
150
cea2e8a9
GS
151sub write_protos {
152 my $ret = "";
153 if (@_ == 1) {
154 my $arg = shift;
1d7c1841 155 $ret .= "$arg\n";
cea2e8a9
GS
156 }
157 else {
158 my ($flags,$retval,$func,@args) = @_;
af3c7592 159 $ret .= '/* ' if $flags =~ /m/;
cea2e8a9
GS
160 if ($flags =~ /s/) {
161 $retval = "STATIC $retval";
162 $func = "S_$func";
163 }
0cb96387 164 else {
1d7c1841 165 $retval = "PERL_CALLCONV $retval";
0cb96387
GS
166 if ($flags =~ /p/) {
167 $func = "Perl_$func";
168 }
cea2e8a9
GS
169 }
170 $ret .= "$retval\t$func(";
171 unless ($flags =~ /n/) {
172 $ret .= "pTHX";
173 $ret .= "_ " if @args;
174 }
175 if (@args) {
176 $ret .= join ", ", @args;
177 }
178 else {
179 $ret .= "void" if $flags =~ /n/;
180 }
181 $ret .= ")";
182 $ret .= " __attribute__((noreturn))" if $flags =~ /r/;
1c846c1f 183 if( $flags =~ /f/ ) {
894356b3 184 my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
1c846c1f 185 my $args = scalar @args;
d5b3b440 186 $ret .= "\n#ifdef CHECK_FORMAT\n";
894356b3 187 $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
1c846c1f 188 $prefix, $args - 1, $prefix, $args;
894356b3
GS
189 $ret .= "\n#endif\n";
190 }
af3c7592
NIS
191 $ret .= ";";
192 $ret .= ' */' if $flags =~ /m/;
193 $ret .= "\n";
cea2e8a9
GS
194 }
195 $ret;
196}
197
954c1994 198# generates global.sym (API export list), and populates %global with global symbols
cea2e8a9
GS
199sub write_global_sym {
200 my $ret = "";
201 if (@_ > 1) {
202 my ($flags,$retval,$func,@args) = @_;
af3c7592 203 if ($flags =~ /A/ && $flags !~ /[xm]/) { # public API, so export
cea2e8a9
GS
204 $func = "Perl_$func" if $flags =~ /p/;
205 $ret = "$func\n";
206 }
207 }
208 $ret;
209}
210
b445a7d9
SR
211walk_table(\&write_protos, "proto.h", undef);
212walk_table(\&write_global_sym, "global.sym", undef);
cea2e8a9 213
709f4e38
GS
214# XXX others that may need adding
215# warnhook
216# hints
217# copline
84fee439 218my @extvars = qw(sv_undef sv_yes sv_no na dowarn
1c846c1f 219 curcop compiling
84fee439 220 tainting tainted stack_base stack_sp sv_arenaroot
256a4781 221 no_modify
84fee439 222 curstash DBsub DBsingle debstash
1c846c1f 223 rsfp
84fee439 224 stdingv
6b88bc9c
GS
225 defgv
226 errgv
3070f6ec
GS
227 rsfp_filters
228 perldb
709f4e38
GS
229 diehook
230 dirty
231 perl_destruct_level
ac634a9a 232 ppaddr
84fee439
NIS
233 );
234
5f05dabc
PP
235sub readsyms (\%$) {
236 my ($syms, $file) = @_;
5f05dabc
PP
237 local (*FILE, $_);
238 open(FILE, "< $file")
239 or die "embed.pl: Can't open $file: $!\n";
240 while (<FILE>) {
241 s/[ \t]*#.*//; # Delete comments.
242 if (/^\s*(\S+)\s*$/) {
22c35a8c
GS
243 my $sym = $1;
244 warn "duplicate symbol $sym while processing $file\n"
245 if exists $$syms{$sym};
246 $$syms{$sym} = 1;
5f05dabc
PP
247 }
248 }
249 close(FILE);
250}
251
cea2e8a9
GS
252# Perl_pp_* and Perl_ck_* are in pp.sym
253readsyms my %ppsym, 'pp.sym';
5f05dabc 254
c6af7a1a
GS
255sub readvars(\%$$@) {
256 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1
NIS
257 local (*FILE, $_);
258 open(FILE, "< $file")
259 or die "embed.pl: Can't open $file: $!\n";
260 while (<FILE>) {
261 s/[ \t]*#.*//; # Delete comments.
51371543 262 if (/PERLVARA?I?C?\($pre(\w+)/) {
22c35a8c 263 my $sym = $1;
c6af7a1a 264 $sym = $pre . $sym if $keep_pre;
22c35a8c
GS
265 warn "duplicate symbol $sym while processing $file\n"
266 if exists $$syms{$sym};
51371543 267 $$syms{$sym} = $pre || 1;
d4cce5f1
NIS
268 }
269 }
270 close(FILE);
271}
272
273my %intrp;
274my %thread;
275
276readvars %intrp, 'intrpvar.h','I';
277readvars %thread, 'thrdvar.h','T';
22239a37 278readvars %globvar, 'perlvars.h','G';
d4cce5f1 279
4543f4c0
PP
280my $sym;
281foreach $sym (sort keys %thread) {
34b58025 282 warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
51371543 283}
d4cce5f1 284
c6af7a1a
GS
285sub undefine ($) {
286 my ($sym) = @_;
287 "#undef $sym\n";
288}
289
5f05dabc
PP
290sub hide ($$) {
291 my ($from, $to) = @_;
292 my $t = int(length($from) / 8);
293 "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
294}
c6af7a1a 295
6f4183fe 296sub bincompat_var ($$) {
51371543 297 my ($pfx, $sym) = @_;
acfe0abc 298 my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX');
c5be433b 299 undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
c6af7a1a
GS
300}
301
d4cce5f1
NIS
302sub multon ($$$) {
303 my ($sym,$pre,$ptr) = @_;
3280af22 304 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 305}
54aff467 306
d4cce5f1
NIS
307sub multoff ($$) {
308 my ($sym,$pre) = @_;
533c011a 309 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc
PP
310}
311
36bb303b 312safer_unlink 'embed.h';
cea2e8a9 313open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
e50aee73 314
7f1be197 315print EM do_not_edit ("embed.h"), <<'END';
e50aee73
AD
316
317/* (Doing namespace management portably in C is really gross.) */
318
22c35a8c 319/* NO_EMBED is no longer supported. i.e. EMBED is always active. */
820c3be9 320
22c35a8c 321/* Hide global symbols */
5f05dabc 322
cea2e8a9 323#if !defined(PERL_IMPLICIT_CONTEXT)
e50aee73 324
e50aee73
AD
325END
326
cea2e8a9
GS
327walk_table {
328 my $ret = "";
329 if (@_ == 1) {
330 my $arg = shift;
12a98ad5 331 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9
GS
332 }
333 else {
334 my ($flags,$retval,$func,@args) = @_;
af3c7592 335 unless ($flags =~ /[om]/) {
cea2e8a9
GS
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;
0ea9712b 345} \*EM, "";
cea2e8a9
GS
346
347for $sym (sort keys %ppsym) {
348 $sym =~ s/^Perl_//;
349 print EM hide($sym, "Perl_$sym");
350}
351
352print EM <<'END';
353
354#else /* PERL_IMPLICIT_CONTEXT */
355
356END
357
358my @az = ('a'..'z');
359
360walk_table {
361 my $ret = "";
362 if (@_ == 1) {
363 my $arg = shift;
12a98ad5 364 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9
GS
365 }
366 else {
367 my ($flags,$retval,$func,@args) = @_;
af3c7592 368 unless ($flags =~ /[om]/) {
cea2e8a9
GS
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;
0ea9712b 398} \*EM, "";
cea2e8a9
GS
399
400for $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 }
e50aee73
AD
411}
412
e50aee73
AD
413print EM <<'END';
414
cea2e8a9 415#endif /* PERL_IMPLICIT_CONTEXT */
22c35a8c
GS
416
417END
418
22c35a8c
GS
419print EM <<'END';
420
cea2e8a9
GS
421/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
422 disable them.
423 */
424
538feb02 425#if !defined(PERL_CORE)
5bc28da9
NIS
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))
538feb02 428#endif
cea2e8a9 429
08e5223a 430#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
cea2e8a9
GS
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 */
65cec589
GS
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)
cea2e8a9
GS
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 */
acfe0abc 461#if defined(PERL_IMPLICIT_CONTEXT)
cea2e8a9 462# define croak Perl_croak_nocontext
c5be433b 463# define deb Perl_deb_nocontext
cea2e8a9
GS
464# define die Perl_die_nocontext
465# define form Perl_form_nocontext
e4783991 466# define load_module Perl_load_module_nocontext
5a844595 467# define mess Perl_mess_nocontext
cea2e8a9
GS
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
c5be433b 472# define warner Perl_warner_nocontext
cea2e8a9
GS
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
c5be433b 483# define Perl_deb_nocontext Perl_deb
cea2e8a9 484# define Perl_form_nocontext Perl_form
e4783991 485# define Perl_load_module_nocontext Perl_load_module
5a844595 486# define Perl_mess_nocontext Perl_mess
c5be433b
GS
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
cea2e8a9 490# define Perl_warn_nocontext Perl_warn
c5be433b 491# define Perl_warner_nocontext Perl_warner
cea2e8a9
GS
492# define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
493# define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
494#endif
db5cf5a9 495
d4cce5f1
NIS
496END
497
36bb303b 498close(EM) or die "Error closing EM: $!";
d4cce5f1 499
36bb303b 500safer_unlink 'embedvar.h';
d4cce5f1
NIS
501open(EM, '> embedvar.h')
502 or die "Can't create embedvar.h: $!\n";
503
7f1be197 504print EM do_not_edit ("embedvar.h"), <<'END';
d4cce5f1
NIS
505
506/* (Doing namespace management portably in C is really gross.) */
507
54aff467 508/*
3db8f154
MB
509 The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
510 are supported:
54aff467
GS
511 1) none
512 2) MULTIPLICITY # supported for compatibility
513 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
54aff467
GS
514
515 All other combinations of these flags are errors.
516
3db8f154 517 only #3 is supported directly, while #2 is a special
54aff467
GS
518 case of #3 (supported by redefining vTHX appropriately).
519*/
cea2e8a9 520
54aff467 521#if defined(MULTIPLICITY)
3db8f154 522/* cases 2 and 3 above */
cea2e8a9 523
54aff467
GS
524# if defined(PERL_IMPLICIT_CONTEXT)
525# define vTHX aTHX
526# else
527# define vTHX PERL_GET_INTERP
528# endif
cea2e8a9 529
e50aee73
AD
530END
531
d4cce5f1 532for $sym (sort keys %thread) {
54aff467 533 print EM multon($sym,'T','vTHX->');
d4cce5f1
NIS
534}
535
536print EM <<'END';
537
54aff467 538/* cases 2 and 3 above */
55497cff
PP
539
540END
760ac839 541
d4cce5f1 542for $sym (sort keys %intrp) {
54aff467 543 print EM multon($sym,'I','vTHX->');
d4cce5f1
NIS
544}
545
546print EM <<'END';
547
54aff467 548#else /* !MULTIPLICITY */
1d7c1841 549
3db8f154 550/* case 1 above */
5f05dabc 551
56d28764 552END
e50aee73 553
d4cce5f1 554for $sym (sort keys %intrp) {
54aff467 555 print EM multoff($sym,'I');
d4cce5f1
NIS
556}
557
558print EM <<'END';
559
d4cce5f1
NIS
560END
561
562for $sym (sort keys %thread) {
54aff467 563 print EM multoff($sym,'T');
d4cce5f1
NIS
564}
565
566print EM <<'END';
567
54aff467 568#endif /* MULTIPLICITY */
d4cce5f1 569
54aff467 570#if defined(PERL_GLOBAL_STRUCT)
22239a37
NIS
571
572END
573
574for $sym (sort keys %globvar) {
533c011a 575 print EM multon($sym,'G','PL_Vars.');
22239a37
NIS
576}
577
578print EM <<'END';
579
580#else /* !PERL_GLOBAL_STRUCT */
581
582END
583
584for $sym (sort keys %globvar) {
585 print EM multoff($sym,'G');
586}
587
588print EM <<'END';
589
22239a37
NIS
590#endif /* PERL_GLOBAL_STRUCT */
591
85add8c2 592#ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
84fee439
NIS
593
594END
595
596for $sym (sort @extvars) {
597 print EM hide($sym,"PL_$sym");
598}
599
600print EM <<'END';
601
db5cf5a9 602#endif /* PERL_POLLUTE */
84fee439
NIS
603END
604
36bb303b 605close(EM) or die "Error closing EM: $!";
c6af7a1a 606
36bb303b
NC
607safer_unlink 'perlapi.h';
608safer_unlink 'perlapi.c';
51371543
GS
609open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
610open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
611
7f1be197 612print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
51371543 613
51371543 614/* declare accessor functions for Perl variables */
6f4183fe
GS
615#ifndef __perlapi_h__
616#define __perlapi_h__
51371543 617
acfe0abc 618#if defined (MULTIPLICITY)
c5be433b 619
51371543
GS
620START_EXTERN_C
621
622#undef PERLVAR
623#undef PERLVARA
624#undef PERLVARI
625#undef PERLVARIC
acfe0abc 626#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
51371543 627#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
acfe0abc 628 EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
51371543 629#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 630#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543
GS
631
632#include "thrdvar.h"
633#include "intrpvar.h"
634#include "perlvars.h"
635
636#undef PERLVAR
637#undef PERLVARA
638#undef PERLVARI
639#undef PERLVARIC
640
641END_EXTERN_C
642
682fc664 643#if defined(PERL_CORE)
6f4183fe 644
682fc664
GS
645/* accessor functions for Perl variables (provide binary compatibility) */
646
647/* these need to be mentioned here, or most linkers won't put them in
648 the perl executable */
649
650#ifndef PERL_NO_FORCE_LINK
651
652START_EXTERN_C
653
654#ifndef DOINIT
655EXT void *PL_force_link_funcs[];
656#else
657EXT void *PL_force_link_funcs[] = {
658#undef PERLVAR
659#undef PERLVARA
660#undef PERLVARI
661#undef PERLVARIC
ea1f607c 662#define PERLVAR(v,t) (void*)Perl_##v##_ptr,
682fc664
GS
663#define PERLVARA(v,n,t) PERLVAR(v,t)
664#define PERLVARI(v,t,i) PERLVAR(v,t)
665#define PERLVARIC(v,t,i) PERLVAR(v,t)
666
667#include "thrdvar.h"
668#include "intrpvar.h"
669#include "perlvars.h"
670
671#undef PERLVAR
672#undef PERLVARA
673#undef PERLVARI
674#undef PERLVARIC
675};
676#endif /* DOINIT */
677
acfe0abc 678END_EXTERN_C
682fc664
GS
679
680#endif /* PERL_NO_FORCE_LINK */
681
682#else /* !PERL_CORE */
51371543
GS
683
684EOT
685
4543f4c0 686foreach $sym (sort keys %intrp) {
6f4183fe
GS
687 print CAPIH bincompat_var('I',$sym);
688}
689
4543f4c0 690foreach $sym (sort keys %thread) {
6f4183fe
GS
691 print CAPIH bincompat_var('T',$sym);
692}
693
4543f4c0 694foreach $sym (sort keys %globvar) {
6f4183fe
GS
695 print CAPIH bincompat_var('G',$sym);
696}
697
698print CAPIH <<'EOT';
699
700#endif /* !PERL_CORE */
acfe0abc 701#endif /* MULTIPLICITY */
6f4183fe
GS
702
703#endif /* __perlapi_h__ */
704
705EOT
36bb303b 706close CAPIH or die "Error closing CAPIH: $!";
51371543 707
7f1be197 708print CAPI do_not_edit ("perlapi.c"), <<'EOT';
51371543
GS
709
710#include "EXTERN.h"
711#include "perl.h"
712#include "perlapi.h"
713
acfe0abc 714#if defined (MULTIPLICITY)
51371543
GS
715
716/* accessor functions for Perl variables (provides binary compatibility) */
717START_EXTERN_C
718
719#undef PERLVAR
720#undef PERLVARA
721#undef PERLVARI
722#undef PERLVARIC
6f4183fe 723
6f4183fe
GS
724#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
725 { return &(aTHX->v); }
726#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
727 { return &(aTHX->v); }
6f4183fe 728
51371543 729#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 730#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543
GS
731
732#include "thrdvar.h"
733#include "intrpvar.h"
c5be433b
GS
734
735#undef PERLVAR
736#undef PERLVARA
acfe0abc 737#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
c5be433b 738 { return &(PL_##v); }
acfe0abc 739#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
c5be433b 740 { return &(PL_##v); }
34f7a5fe 741#undef PERLVARIC
acfe0abc 742#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
34f7a5fe 743 { return (const t *)&(PL_##v); }
51371543
GS
744#include "perlvars.h"
745
746#undef PERLVAR
747#undef PERLVARA
748#undef PERLVARI
749#undef PERLVARIC
750
acfe0abc 751END_EXTERN_C
6f4183fe 752
acfe0abc 753#endif /* MULTIPLICITY */
51371543
GS
754EOT
755
36bb303b 756close(CAPI) or die "Error closing CAPI: $!";
acfe0abc 757
c5be433b 758# functions that take va_list* for implementing vararg functions
08cd8952 759# NOTE: makedef.pl must be updated if you add symbols to %vfuncs
acfe0abc 760# XXX %vfuncs currently unused
c5be433b
GS
761my %vfuncs = qw(
762 Perl_croak Perl_vcroak
763 Perl_warn Perl_vwarn
764 Perl_warner Perl_vwarner
765 Perl_die Perl_vdie
766 Perl_form Perl_vform
e4783991 767 Perl_load_module Perl_vload_module
5a844595 768 Perl_mess Perl_vmess
c5be433b
GS
769 Perl_deb Perl_vdeb
770 Perl_newSVpvf Perl_vnewSVpvf
771 Perl_sv_setpvf Perl_sv_vsetpvf
772 Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
773 Perl_sv_catpvf Perl_sv_vcatpvf
774 Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
775 Perl_dump_indent Perl_dump_vindent
776 Perl_default_protect Perl_vdefault_protect
777);