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