This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #18113] UNIVERSAL::AUTOLOAD doesn't work if the stash doesn't exist yet
[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
cea2e8a9 6#
346f75ff 7# See database of global and static function prototypes in embed.fnc
cea2e8a9
GS
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
7f1be197
MB
13sub 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 !!!!!!!
26This file is built by embed.pl from data in embed.fnc, embed.pl,
27pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
28Any changes made here will be lost!
29
30Edit those files and run 'make regen_headers' to effect changes.
31
32EOW
33
34 if ($file =~ m:\.[ch]$:) {
0ea9712b
MB
35 $warning =~ s:^: * :gm;
36 $warning =~ s: +$::gm;
37 $warning =~ s: :/:;
38 $warning =~ s:$:/:;
7f1be197
MB
39 }
40 else {
0ea9712b
MB
41 $warning =~ s:^:# :gm;
42 $warning =~ s: +$::gm;
7f1be197
MB
43 }
44 $warning;
45} # do_not_edit
46
94bdecf9 47open IN, "embed.fnc" or die $!;
cea2e8a9
GS
48
49# walk table providing an array of components in each line to
50# subroutine, printing the result
51sub walk_table (&@) {
52 my $function = shift;
53 my $filename = shift || '-';
0ea9712b
MB
54 my $leader = shift;
55 defined $leader or $leader = do_not_edit ($filename);
cea2e8a9
GS
56 my $trailer = shift;
57 my $F;
58 local *F;
59 if (ref $filename) { # filehandle
60 $F = $filename;
61 }
62 else {
918426be 63 unlink $filename;
cea2e8a9
GS
64 open F, ">$filename" or die "Can't open $filename: $!";
65 $F = \*F;
66 }
67 print $F $leader if $leader;
94bdecf9
JH
68 seek IN, 0, 0; # so we may restart
69 while (<IN>) {
cea2e8a9 70 chomp;
1d7c1841 71 next if /^:/;
cea2e8a9 72 while (s|\\$||) {
94bdecf9 73 $_ .= <IN>;
cea2e8a9
GS
74 chomp;
75 }
76 my @args;
77 if (/^\s*(#|$)/) {
78 @args = $_;
79 }
80 else {
81 @args = split /\s*\|\s*/, $_;
82 }
4543f4c0
PP
83 my @outs = &{$function}(@args);
84 print $F @outs; # $function->(@args) is not 5.003
cea2e8a9
GS
85 }
86 print $F $trailer if $trailer;
87 close $F unless ref $filename;
88}
89
90sub 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 }
0ea9712b 100 } '/dev/null', '';
cea2e8a9
GS
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
0cb96387
GS
142my $wrote_protected = 0;
143
cea2e8a9
GS
144sub write_protos {
145 my $ret = "";
146 if (@_ == 1) {
147 my $arg = shift;
1d7c1841 148 $ret .= "$arg\n";
cea2e8a9
GS
149 }
150 else {
151 my ($flags,$retval,$func,@args) = @_;
af3c7592 152 $ret .= '/* ' if $flags =~ /m/;
cea2e8a9
GS
153 if ($flags =~ /s/) {
154 $retval = "STATIC $retval";
155 $func = "S_$func";
156 }
0cb96387 157 else {
1d7c1841 158 $retval = "PERL_CALLCONV $retval";
0cb96387
GS
159 if ($flags =~ /p/) {
160 $func = "Perl_$func";
161 }
cea2e8a9
GS
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/;
1c846c1f 176 if( $flags =~ /f/ ) {
894356b3 177 my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
1c846c1f 178 my $args = scalar @args;
d5b3b440 179 $ret .= "\n#ifdef CHECK_FORMAT\n";
894356b3 180 $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
1c846c1f 181 $prefix, $args - 1, $prefix, $args;
894356b3
GS
182 $ret .= "\n#endif\n";
183 }
af3c7592
NIS
184 $ret .= ";";
185 $ret .= ' */' if $flags =~ /m/;
186 $ret .= "\n";
cea2e8a9
GS
187 }
188 $ret;
189}
190
954c1994 191# generates global.sym (API export list), and populates %global with global symbols
cea2e8a9
GS
192sub write_global_sym {
193 my $ret = "";
194 if (@_ > 1) {
195 my ($flags,$retval,$func,@args) = @_;
af3c7592 196 if ($flags =~ /A/ && $flags !~ /[xm]/) { # public API, so export
cea2e8a9
GS
197 $func = "Perl_$func" if $flags =~ /p/;
198 $ret = "$func\n";
199 }
200 }
201 $ret;
202}
203
b445a7d9
SR
204walk_table(\&write_protos, "proto.h", undef);
205walk_table(\&write_global_sym, "global.sym", undef);
cea2e8a9 206
709f4e38
GS
207# XXX others that may need adding
208# warnhook
209# hints
210# copline
84fee439 211my @extvars = qw(sv_undef sv_yes sv_no na dowarn
1c846c1f 212 curcop compiling
84fee439 213 tainting tainted stack_base stack_sp sv_arenaroot
256a4781 214 no_modify
84fee439 215 curstash DBsub DBsingle debstash
1c846c1f 216 rsfp
84fee439 217 stdingv
6b88bc9c
GS
218 defgv
219 errgv
3070f6ec
GS
220 rsfp_filters
221 perldb
709f4e38
GS
222 diehook
223 dirty
224 perl_destruct_level
ac634a9a 225 ppaddr
84fee439
NIS
226 );
227
5f05dabc
PP
228sub readsyms (\%$) {
229 my ($syms, $file) = @_;
5f05dabc
PP
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*$/) {
22c35a8c
GS
236 my $sym = $1;
237 warn "duplicate symbol $sym while processing $file\n"
238 if exists $$syms{$sym};
239 $$syms{$sym} = 1;
5f05dabc
PP
240 }
241 }
242 close(FILE);
243}
244
cea2e8a9
GS
245# Perl_pp_* and Perl_ck_* are in pp.sym
246readsyms my %ppsym, 'pp.sym';
5f05dabc 247
c6af7a1a
GS
248sub readvars(\%$$@) {
249 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1
NIS
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.
51371543 255 if (/PERLVARA?I?C?\($pre(\w+)/) {
22c35a8c 256 my $sym = $1;
c6af7a1a 257 $sym = $pre . $sym if $keep_pre;
22c35a8c
GS
258 warn "duplicate symbol $sym while processing $file\n"
259 if exists $$syms{$sym};
51371543 260 $$syms{$sym} = $pre || 1;
d4cce5f1
NIS
261 }
262 }
263 close(FILE);
264}
265
266my %intrp;
267my %thread;
268
269readvars %intrp, 'intrpvar.h','I';
270readvars %thread, 'thrdvar.h','T';
22239a37 271readvars %globvar, 'perlvars.h','G';
d4cce5f1 272
4543f4c0
PP
273my $sym;
274foreach $sym (sort keys %thread) {
34b58025 275 warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
51371543 276}
d4cce5f1 277
c6af7a1a
GS
278sub undefine ($) {
279 my ($sym) = @_;
280 "#undef $sym\n";
281}
282
5f05dabc
PP
283sub 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}
c6af7a1a 288
6f4183fe 289sub bincompat_var ($$) {
51371543 290 my ($pfx, $sym) = @_;
acfe0abc 291 my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX');
c5be433b 292 undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
c6af7a1a
GS
293}
294
d4cce5f1
NIS
295sub multon ($$$) {
296 my ($sym,$pre,$ptr) = @_;
3280af22 297 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 298}
54aff467 299
d4cce5f1
NIS
300sub multoff ($$) {
301 my ($sym,$pre) = @_;
533c011a 302 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc
PP
303}
304
305unlink 'embed.h';
cea2e8a9 306open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
e50aee73 307
7f1be197 308print EM do_not_edit ("embed.h"), <<'END';
e50aee73
AD
309
310/* (Doing namespace management portably in C is really gross.) */
311
22c35a8c 312/* NO_EMBED is no longer supported. i.e. EMBED is always active. */
820c3be9 313
22c35a8c 314/* Hide global symbols */
5f05dabc 315
cea2e8a9 316#if !defined(PERL_IMPLICIT_CONTEXT)
e50aee73 317
e50aee73
AD
318END
319
cea2e8a9
GS
320walk_table {
321 my $ret = "";
322 if (@_ == 1) {
323 my $arg = shift;
12a98ad5 324 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9
GS
325 }
326 else {
327 my ($flags,$retval,$func,@args) = @_;
af3c7592 328 unless ($flags =~ /[om]/) {
cea2e8a9
GS
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;
0ea9712b 338} \*EM, "";
cea2e8a9
GS
339
340for $sym (sort keys %ppsym) {
341 $sym =~ s/^Perl_//;
342 print EM hide($sym, "Perl_$sym");
343}
344
345print EM <<'END';
346
347#else /* PERL_IMPLICIT_CONTEXT */
348
349END
350
351my @az = ('a'..'z');
352
353walk_table {
354 my $ret = "";
355 if (@_ == 1) {
356 my $arg = shift;
12a98ad5 357 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9
GS
358 }
359 else {
360 my ($flags,$retval,$func,@args) = @_;
af3c7592 361 unless ($flags =~ /[om]/) {
cea2e8a9
GS
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;
0ea9712b 391} \*EM, "";
cea2e8a9
GS
392
393for $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 }
e50aee73
AD
404}
405
e50aee73
AD
406print EM <<'END';
407
cea2e8a9 408#endif /* PERL_IMPLICIT_CONTEXT */
22c35a8c
GS
409
410END
411
22c35a8c
GS
412print EM <<'END';
413
cea2e8a9
GS
414/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
415 disable them.
416 */
417
538feb02 418#if !defined(PERL_CORE)
5bc28da9
NIS
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))
538feb02 421#endif
cea2e8a9 422
08e5223a 423#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
cea2e8a9
GS
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 */
65cec589
GS
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)
cea2e8a9
GS
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 */
acfe0abc 454#if defined(PERL_IMPLICIT_CONTEXT)
cea2e8a9 455# define croak Perl_croak_nocontext
c5be433b 456# define deb Perl_deb_nocontext
cea2e8a9
GS
457# define die Perl_die_nocontext
458# define form Perl_form_nocontext
e4783991 459# define load_module Perl_load_module_nocontext
5a844595 460# define mess Perl_mess_nocontext
cea2e8a9
GS
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
c5be433b 465# define warner Perl_warner_nocontext
cea2e8a9
GS
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
c5be433b 476# define Perl_deb_nocontext Perl_deb
cea2e8a9 477# define Perl_form_nocontext Perl_form
e4783991 478# define Perl_load_module_nocontext Perl_load_module
5a844595 479# define Perl_mess_nocontext Perl_mess
c5be433b
GS
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
cea2e8a9 483# define Perl_warn_nocontext Perl_warn
c5be433b 484# define Perl_warner_nocontext Perl_warner
cea2e8a9
GS
485# define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
486# define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
487#endif
db5cf5a9 488
d4cce5f1
NIS
489END
490
491close(EM);
492
493unlink 'embedvar.h';
494open(EM, '> embedvar.h')
495 or die "Can't create embedvar.h: $!\n";
496
7f1be197 497print EM do_not_edit ("embedvar.h"), <<'END';
d4cce5f1
NIS
498
499/* (Doing namespace management portably in C is really gross.) */
500
54aff467 501/*
3db8f154
MB
502 The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
503 are supported:
54aff467
GS
504 1) none
505 2) MULTIPLICITY # supported for compatibility
506 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
54aff467
GS
507
508 All other combinations of these flags are errors.
509
3db8f154 510 only #3 is supported directly, while #2 is a special
54aff467
GS
511 case of #3 (supported by redefining vTHX appropriately).
512*/
cea2e8a9 513
54aff467 514#if defined(MULTIPLICITY)
3db8f154 515/* cases 2 and 3 above */
cea2e8a9 516
54aff467
GS
517# if defined(PERL_IMPLICIT_CONTEXT)
518# define vTHX aTHX
519# else
520# define vTHX PERL_GET_INTERP
521# endif
cea2e8a9 522
e50aee73
AD
523END
524
d4cce5f1 525for $sym (sort keys %thread) {
54aff467 526 print EM multon($sym,'T','vTHX->');
d4cce5f1
NIS
527}
528
529print EM <<'END';
530
54aff467 531/* cases 2 and 3 above */
55497cff
PP
532
533END
760ac839 534
d4cce5f1 535for $sym (sort keys %intrp) {
54aff467 536 print EM multon($sym,'I','vTHX->');
d4cce5f1
NIS
537}
538
539print EM <<'END';
540
54aff467 541#else /* !MULTIPLICITY */
1d7c1841 542
3db8f154 543/* case 1 above */
5f05dabc 544
56d28764 545END
e50aee73 546
d4cce5f1 547for $sym (sort keys %intrp) {
54aff467 548 print EM multoff($sym,'I');
d4cce5f1
NIS
549}
550
551print EM <<'END';
552
d4cce5f1
NIS
553END
554
555for $sym (sort keys %thread) {
54aff467 556 print EM multoff($sym,'T');
d4cce5f1
NIS
557}
558
559print EM <<'END';
560
54aff467 561#endif /* MULTIPLICITY */
d4cce5f1 562
54aff467 563#if defined(PERL_GLOBAL_STRUCT)
22239a37
NIS
564
565END
566
567for $sym (sort keys %globvar) {
533c011a 568 print EM multon($sym,'G','PL_Vars.');
22239a37
NIS
569}
570
571print EM <<'END';
572
573#else /* !PERL_GLOBAL_STRUCT */
574
575END
576
577for $sym (sort keys %globvar) {
578 print EM multoff($sym,'G');
579}
580
581print EM <<'END';
582
22239a37
NIS
583#endif /* PERL_GLOBAL_STRUCT */
584
85add8c2 585#ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
84fee439
NIS
586
587END
588
589for $sym (sort @extvars) {
590 print EM hide($sym,"PL_$sym");
591}
592
593print EM <<'END';
594
db5cf5a9 595#endif /* PERL_POLLUTE */
84fee439
NIS
596END
597
3fe35a81 598close(EM);
c6af7a1a 599
51371543
GS
600unlink 'perlapi.h';
601unlink 'perlapi.c';
602open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
603open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
604
7f1be197 605print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
51371543 606
51371543 607/* declare accessor functions for Perl variables */
6f4183fe
GS
608#ifndef __perlapi_h__
609#define __perlapi_h__
51371543 610
acfe0abc 611#if defined (MULTIPLICITY)
c5be433b 612
51371543
GS
613START_EXTERN_C
614
615#undef PERLVAR
616#undef PERLVARA
617#undef PERLVARI
618#undef PERLVARIC
acfe0abc 619#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
51371543 620#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
acfe0abc 621 EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
51371543 622#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 623#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543
GS
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
634END_EXTERN_C
635
682fc664 636#if defined(PERL_CORE)
6f4183fe 637
682fc664
GS
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
645START_EXTERN_C
646
647#ifndef DOINIT
648EXT void *PL_force_link_funcs[];
649#else
650EXT void *PL_force_link_funcs[] = {
651#undef PERLVAR
652#undef PERLVARA
653#undef PERLVARI
654#undef PERLVARIC
ea1f607c 655#define PERLVAR(v,t) (void*)Perl_##v##_ptr,
682fc664
GS
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
acfe0abc 671END_EXTERN_C
682fc664
GS
672
673#endif /* PERL_NO_FORCE_LINK */
674
675#else /* !PERL_CORE */
51371543
GS
676
677EOT
678
4543f4c0 679foreach $sym (sort keys %intrp) {
6f4183fe
GS
680 print CAPIH bincompat_var('I',$sym);
681}
682
4543f4c0 683foreach $sym (sort keys %thread) {
6f4183fe
GS
684 print CAPIH bincompat_var('T',$sym);
685}
686
4543f4c0 687foreach $sym (sort keys %globvar) {
6f4183fe
GS
688 print CAPIH bincompat_var('G',$sym);
689}
690
691print CAPIH <<'EOT';
692
693#endif /* !PERL_CORE */
acfe0abc 694#endif /* MULTIPLICITY */
6f4183fe
GS
695
696#endif /* __perlapi_h__ */
697
698EOT
d98f61e7 699close CAPIH;
51371543 700
7f1be197 701print CAPI do_not_edit ("perlapi.c"), <<'EOT';
51371543
GS
702
703#include "EXTERN.h"
704#include "perl.h"
705#include "perlapi.h"
706
acfe0abc 707#if defined (MULTIPLICITY)
51371543
GS
708
709/* accessor functions for Perl variables (provides binary compatibility) */
710START_EXTERN_C
711
712#undef PERLVAR
713#undef PERLVARA
714#undef PERLVARI
715#undef PERLVARIC
6f4183fe 716
6f4183fe
GS
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); }
6f4183fe 721
51371543 722#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 723#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543
GS
724
725#include "thrdvar.h"
726#include "intrpvar.h"
c5be433b
GS
727
728#undef PERLVAR
729#undef PERLVARA
acfe0abc 730#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
c5be433b 731 { return &(PL_##v); }
acfe0abc 732#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
c5be433b 733 { return &(PL_##v); }
34f7a5fe 734#undef PERLVARIC
acfe0abc 735#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
34f7a5fe 736 { return (const t *)&(PL_##v); }
51371543
GS
737#include "perlvars.h"
738
739#undef PERLVAR
740#undef PERLVARA
741#undef PERLVARI
742#undef PERLVARIC
743
acfe0abc 744END_EXTERN_C
6f4183fe 745
acfe0abc 746#endif /* MULTIPLICITY */
51371543
GS
747EOT
748
acfe0abc
GS
749close(CAPI);
750
c5be433b 751# functions that take va_list* for implementing vararg functions
08cd8952 752# NOTE: makedef.pl must be updated if you add symbols to %vfuncs
acfe0abc 753# XXX %vfuncs currently unused
c5be433b
GS
754my %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
e4783991 760 Perl_load_module Perl_vload_module
5a844595 761 Perl_mess Perl_vmess
c5be433b
GS
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);