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