projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
COW regexps:
[p5sagit/p5-mst-13.2.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
954c1994 3require 5.003; # keep this compatible, an old perl is all we may have before
4 # we build the new one
5f05dabc 5
36bb303b 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 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 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 40 $warning =~ s:^: * :gm;
41 $warning =~ s: +$::gm;
42 $warning =~ s: :/:;
43 $warning =~ s:$:/:;
7f1be197 44 }
45 else {
0ea9712b 46 $warning =~ s:^:# :gm;
47 $warning =~ s: +$::gm;
7f1be197 48 }
49 $warning;
50} # do_not_edit
51
94bdecf9 52open IN, "embed.fnc" or die $!;
cea2e8a9 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 59 my $leader = shift;
60 defined $leader or $leader = do_not_edit ($filename);
cea2e8a9 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 69 open F, ">$filename" or die "Can't open $filename: $!";
70 $F = \*F;
71 }
72 print $F $leader if $leader;
94bdecf9 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 79 chomp;
80 }
81 my @args;
82 if (/^\s*(#|$)/) {
83 @args = $_;
84 }
85 else {
86 @args = split /\s*\|\s*/, $_;
87 }
4543f4c0 88 my @outs = &{$function}(@args);
89 print $F @outs; # $function->(@args) is not 5.003
cea2e8a9 90 }
91 print $F $trailer if $trailer;
36bb303b 92 unless (ref $filename) {
93 close $F or die "Error closing $filename: $!";
94 }
cea2e8a9 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 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 149my $wrote_protected = 0;
150
cea2e8a9 151sub write_protos {
152 my $ret = "";
153 if (@_ == 1) {
154 my $arg = shift;
1d7c1841 155 $ret .= "$arg\n";
cea2e8a9 156 }
157 else {
158 my ($flags,$retval,$func,@args) = @_;
af3c7592 159 $ret .= '/* ' if $flags =~ /m/;
cea2e8a9 160 if ($flags =~ /s/) {
161 $retval = "STATIC $retval";
162 $func = "S_$func";
163 }
0cb96387 164 else {
1d7c1841 165 $retval = "PERL_CALLCONV $retval";
0cb96387 166 if ($flags =~ /p/) {
167 $func = "Perl_$func";
168 }
cea2e8a9 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 189 $ret .= "\n#endif\n";
190 }
af3c7592 191 $ret .= ";";
192 $ret .= ' */' if $flags =~ /m/;
193 $ret .= "\n";
cea2e8a9 194 }
195 $ret;
196}
197
954c1994 198# generates global.sym (API export list), and populates %global with global symbols
cea2e8a9 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 204 $func = "Perl_$func" if $flags =~ /p/;
205 $ret = "$func\n";
206 }
207 }
208 $ret;
209}
210
b445a7d9 211walk_table(\&write_protos, "proto.h", undef);
212walk_table(\&write_global_sym, "global.sym", undef);
cea2e8a9 213
709f4e38 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 225 defgv
226 errgv
3070f6ec 227 rsfp_filters
228 perldb
709f4e38 229 diehook
230 dirty
231 perl_destruct_level
ac634a9a 232 ppaddr
84fee439 233 );
234
5f05dabc 235sub readsyms (\%$) {
236 my ($syms, $file) = @_;
5f05dabc 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 243 my $sym = $1;
244 warn "duplicate symbol $sym while processing $file\n"
245 if exists $$syms{$sym};
246 $$syms{$sym} = 1;
5f05dabc 247 }
248 }
249 close(FILE);
250}
251
cea2e8a9 252# Perl_pp_* and Perl_ck_* are in pp.sym
253readsyms my %ppsym, 'pp.sym';
5f05dabc 254
c6af7a1a 255sub readvars(\%$$@) {
256 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1 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 265 warn "duplicate symbol $sym while processing $file\n"
266 if exists $$syms{$sym};
51371543 267 $$syms{$sym} = $pre || 1;
d4cce5f1 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 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 285sub undefine ($) {
286 my ($sym) = @_;
287 "#undef $sym\n";
288}
289
5f05dabc 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 300}
301
d4cce5f1 302sub multon ($$$) {
303 my ($sym,$pre,$ptr) = @_;
3280af22 304 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 305}
54aff467 306
d4cce5f1 307sub multoff ($$) {
308 my ($sym,$pre) = @_;
533c011a 309 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc 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 316
317/* (Doing namespace management portably in C is really gross.) */
318
35209cc8 319/* NO_EMBED is no longer supported. i.e. EMBED is always active--
320 * but you can define PERL_HIDE_SHORT_NAMES to achieve the same. */
321
322#ifndef PERL_HIDE_SHORT_NAMES
820c3be9 323
22c35a8c 324/* Hide global symbols */
5f05dabc 325
cea2e8a9 326#if !defined(PERL_IMPLICIT_CONTEXT)
e50aee73 327
e50aee73 328END
329
cea2e8a9 330walk_table {
331 my $ret = "";
332 if (@_ == 1) {
333 my $arg = shift;
12a98ad5 334 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9 335 }
336 else {
337 my ($flags,$retval,$func,@args) = @_;
af3c7592 338 unless ($flags =~ /[om]/) {
cea2e8a9 339 if ($flags =~ /s/) {
340 $ret .= hide($func,"S_$func");
341 }
342 elsif ($flags =~ /p/) {
343 $ret .= hide($func,"Perl_$func");
344 }
345 }
de37762f 346 unless ($flags =~ /A/) {
347 if ($flags =~ /E/) {
348 $ret = "#if defined(PERL_CORE) || defined(PERL_EXT)\n$ret#endif\n";
349 } else {
350 $ret = "#ifdef PERL_CORE\n$ret#endif\n";
351 }
352 }
cea2e8a9 353 }
354 $ret;
0ea9712b 355} \*EM, "";
cea2e8a9 356
357for $sym (sort keys %ppsym) {
358 $sym =~ s/^Perl_//;
359 print EM hide($sym, "Perl_$sym");
360}
361
362print EM <<'END';
363
364#else /* PERL_IMPLICIT_CONTEXT */
365
366END
367
368my @az = ('a'..'z');
369
370walk_table {
371 my $ret = "";
372 if (@_ == 1) {
373 my $arg = shift;
12a98ad5 374 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9 375 }
376 else {
377 my ($flags,$retval,$func,@args) = @_;
af3c7592 378 unless ($flags =~ /[om]/) {
cea2e8a9 379 my $args = scalar @args;
380 if ($args and $args[$args-1] =~ /\.\.\./) {
381 # we're out of luck for varargs functions under CPP
382 }
383 elsif ($flags =~ /n/) {
384 if ($flags =~ /s/) {
385 $ret .= hide($func,"S_$func");
386 }
387 elsif ($flags =~ /p/) {
388 $ret .= hide($func,"Perl_$func");
389 }
390 }
391 else {
392 my $alist = join(",", @az[0..$args-1]);
393 $ret = "#define $func($alist)";
394 my $t = int(length($ret) / 8);
395 $ret .= "\t" x ($t < 4 ? 4 - $t : 1);
396 if ($flags =~ /s/) {
397 $ret .= "S_$func(aTHX";
398 }
399 elsif ($flags =~ /p/) {
400 $ret .= "Perl_$func(aTHX";
401 }
402 $ret .= "_ " if $alist;
403 $ret .= $alist . ")\n";
404 }
405 }
de37762f 406 unless ($flags =~ /A/) {
407 if ($flags =~ /E/) {
408 $ret = "#if defined(PERL_CORE) || defined(PERL_EXT)\n$ret#endif\n";
409 } else {
410 $ret = "#ifdef PERL_CORE\n$ret#endif\n";
411 }
412 }
cea2e8a9 413 }
414 $ret;
0ea9712b 415} \*EM, "";
cea2e8a9 416
417for $sym (sort keys %ppsym) {
418 $sym =~ s/^Perl_//;
419 if ($sym =~ /^ck_/) {
420 print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
421 }
422 elsif ($sym =~ /^pp_/) {
423 print EM hide("$sym()", "Perl_$sym(aTHX)");
424 }
425 else {
426 warn "Illegal symbol '$sym' in pp.sym";
427 }
e50aee73 428}
429
e50aee73 430print EM <<'END';
431
cea2e8a9 432#endif /* PERL_IMPLICIT_CONTEXT */
22c35a8c 433
35209cc8 434#endif /* #ifndef PERL_HIDE_SHORT_NAMES */
435
22c35a8c 436END
437
22c35a8c 438print EM <<'END';
439
cea2e8a9 440/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
441 disable them.
442 */
443
538feb02 444#if !defined(PERL_CORE)
5bc28da9 445# define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,PTR2IV(ptr))
446# define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,PTR2IV(ptr))
538feb02 447#endif
cea2e8a9 448
08e5223a 449#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
cea2e8a9 450
451/* Compatibility for various misnamed functions. All functions
452 in the API that begin with "perl_" (not "Perl_") take an explicit
453 interpreter context pointer.
454 The following are not like that, but since they had a "perl_"
455 prefix in previous versions, we provide compatibility macros.
456 */
65cec589 457# define perl_atexit(a,b) call_atexit(a,b)
458# define perl_call_argv(a,b,c) call_argv(a,b,c)
459# define perl_call_pv(a,b) call_pv(a,b)
460# define perl_call_method(a,b) call_method(a,b)
461# define perl_call_sv(a,b) call_sv(a,b)
462# define perl_eval_sv(a,b) eval_sv(a,b)
463# define perl_eval_pv(a,b) eval_pv(a,b)
464# define perl_require_pv(a) require_pv(a)
465# define perl_get_sv(a,b) get_sv(a,b)
466# define perl_get_av(a,b) get_av(a,b)
467# define perl_get_hv(a,b) get_hv(a,b)
468# define perl_get_cv(a,b) get_cv(a,b)
469# define perl_init_i18nl10n(a) init_i18nl10n(a)
470# define perl_init_i18nl14n(a) init_i18nl14n(a)
471# define perl_new_ctype(a) new_ctype(a)
472# define perl_new_collate(a) new_collate(a)
473# define perl_new_numeric(a) new_numeric(a)
cea2e8a9 474
475/* varargs functions can't be handled with CPP macros. :-(
476 This provides a set of compatibility functions that don't take
477 an extra argument but grab the context pointer using the macro
478 dTHX.
479 */
35209cc8 480#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_HIDE_SHORT_NAMES)
cea2e8a9 481# define croak Perl_croak_nocontext
c5be433b 482# define deb Perl_deb_nocontext
cea2e8a9 483# define die Perl_die_nocontext
484# define form Perl_form_nocontext
e4783991 485# define load_module Perl_load_module_nocontext
5a844595 486# define mess Perl_mess_nocontext
cea2e8a9 487# define newSVpvf Perl_newSVpvf_nocontext
488# define sv_catpvf Perl_sv_catpvf_nocontext
489# define sv_setpvf Perl_sv_setpvf_nocontext
490# define warn Perl_warn_nocontext
c5be433b 491# define warner Perl_warner_nocontext
cea2e8a9 492# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
493# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
494#endif
495
496#endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
497
498#if !defined(PERL_IMPLICIT_CONTEXT)
499/* undefined symbols, point them back at the usual ones */
500# define Perl_croak_nocontext Perl_croak
501# define Perl_die_nocontext Perl_die
c5be433b 502# define Perl_deb_nocontext Perl_deb
cea2e8a9 503# define Perl_form_nocontext Perl_form
e4783991 504# define Perl_load_module_nocontext Perl_load_module
5a844595 505# define Perl_mess_nocontext Perl_mess
c5be433b 506# define Perl_newSVpvf_nocontext Perl_newSVpvf
507# define Perl_sv_catpvf_nocontext Perl_sv_catpvf
508# define Perl_sv_setpvf_nocontext Perl_sv_setpvf
cea2e8a9 509# define Perl_warn_nocontext Perl_warn
c5be433b 510# define Perl_warner_nocontext Perl_warner
cea2e8a9 511# define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
512# define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
513#endif
db5cf5a9 514
d4cce5f1 515END
516
36bb303b 517close(EM) or die "Error closing EM: $!";
d4cce5f1 518
36bb303b 519safer_unlink 'embedvar.h';
d4cce5f1 520open(EM, '> embedvar.h')
521 or die "Can't create embedvar.h: $!\n";
522
7f1be197 523print EM do_not_edit ("embedvar.h"), <<'END';
d4cce5f1 524
525/* (Doing namespace management portably in C is really gross.) */
526
54aff467 527/*
3db8f154 528 The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
529 are supported:
54aff467 530 1) none
531 2) MULTIPLICITY # supported for compatibility
532 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
54aff467 533
534 All other combinations of these flags are errors.
535
3db8f154 536 only #3 is supported directly, while #2 is a special
54aff467 537 case of #3 (supported by redefining vTHX appropriately).
538*/
cea2e8a9 539
54aff467 540#if defined(MULTIPLICITY)
3db8f154 541/* cases 2 and 3 above */
cea2e8a9 542
54aff467 543# if defined(PERL_IMPLICIT_CONTEXT)
544# define vTHX aTHX
545# else
546# define vTHX PERL_GET_INTERP
547# endif
cea2e8a9 548
e50aee73 549END
550
d4cce5f1 551for $sym (sort keys %thread) {
54aff467 552 print EM multon($sym,'T','vTHX->');
d4cce5f1 553}
554
555print EM <<'END';
556
54aff467 557/* cases 2 and 3 above */
55497cff 558
559END
760ac839 560
d4cce5f1 561for $sym (sort keys %intrp) {
54aff467 562 print EM multon($sym,'I','vTHX->');
d4cce5f1 563}
564
565print EM <<'END';
566
54aff467 567#else /* !MULTIPLICITY */
1d7c1841 568
3db8f154 569/* case 1 above */
5f05dabc 570
56d28764 571END
e50aee73 572
d4cce5f1 573for $sym (sort keys %intrp) {
54aff467 574 print EM multoff($sym,'I');
d4cce5f1 575}
576
577print EM <<'END';
578
d4cce5f1 579END
580
581for $sym (sort keys %thread) {
54aff467 582 print EM multoff($sym,'T');
d4cce5f1 583}
584
585print EM <<'END';
586
54aff467 587#endif /* MULTIPLICITY */
d4cce5f1 588
54aff467 589#if defined(PERL_GLOBAL_STRUCT)
22239a37 590
591END
592
593for $sym (sort keys %globvar) {
533c011a 594 print EM multon($sym,'G','PL_Vars.');
22239a37 595}
596
597print EM <<'END';
598
599#else /* !PERL_GLOBAL_STRUCT */
600
601END
602
603for $sym (sort keys %globvar) {
604 print EM multoff($sym,'G');
605}
606
607print EM <<'END';
608
22239a37 609#endif /* PERL_GLOBAL_STRUCT */
610
85add8c2 611#ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
84fee439 612
613END
614
615for $sym (sort @extvars) {
616 print EM hide($sym,"PL_$sym");
617}
618
619print EM <<'END';
620
db5cf5a9 621#endif /* PERL_POLLUTE */
84fee439 622END
623
36bb303b 624close(EM) or die "Error closing EM: $!";
c6af7a1a 625
36bb303b 626safer_unlink 'perlapi.h';
627safer_unlink 'perlapi.c';
51371543 628open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
629open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
630
7f1be197 631print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
51371543 632
51371543 633/* declare accessor functions for Perl variables */
6f4183fe 634#ifndef __perlapi_h__
635#define __perlapi_h__
51371543 636
acfe0abc 637#if defined (MULTIPLICITY)
c5be433b 638
51371543 639START_EXTERN_C
640
641#undef PERLVAR
642#undef PERLVARA
643#undef PERLVARI
644#undef PERLVARIC
acfe0abc 645#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
51371543 646#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
acfe0abc 647 EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
51371543 648#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 649#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543 650
651#include "thrdvar.h"
652#include "intrpvar.h"
653#include "perlvars.h"
654
655#undef PERLVAR
656#undef PERLVARA
657#undef PERLVARI
658#undef PERLVARIC
659
660END_EXTERN_C
661
682fc664 662#if defined(PERL_CORE)
6f4183fe 663
682fc664 664/* accessor functions for Perl variables (provide binary compatibility) */
665
666/* these need to be mentioned here, or most linkers won't put them in
667 the perl executable */
668
669#ifndef PERL_NO_FORCE_LINK
670
671START_EXTERN_C
672
673#ifndef DOINIT
674EXT void *PL_force_link_funcs[];
675#else
676EXT void *PL_force_link_funcs[] = {
677#undef PERLVAR
678#undef PERLVARA
679#undef PERLVARI
680#undef PERLVARIC
ea1f607c 681#define PERLVAR(v,t) (void*)Perl_##v##_ptr,
682fc664 682#define PERLVARA(v,n,t) PERLVAR(v,t)
683#define PERLVARI(v,t,i) PERLVAR(v,t)
684#define PERLVARIC(v,t,i) PERLVAR(v,t)
685
686#include "thrdvar.h"
687#include "intrpvar.h"
688#include "perlvars.h"
689
690#undef PERLVAR
691#undef PERLVARA
692#undef PERLVARI
693#undef PERLVARIC
694};
695#endif /* DOINIT */
696
acfe0abc 697END_EXTERN_C
682fc664 698
699#endif /* PERL_NO_FORCE_LINK */
700
701#else /* !PERL_CORE */
51371543 702
703EOT
704
4543f4c0 705foreach $sym (sort keys %intrp) {
6f4183fe 706 print CAPIH bincompat_var('I',$sym);
707}
708
4543f4c0 709foreach $sym (sort keys %thread) {
6f4183fe 710 print CAPIH bincompat_var('T',$sym);
711}
712
4543f4c0 713foreach $sym (sort keys %globvar) {
6f4183fe 714 print CAPIH bincompat_var('G',$sym);
715}
716
717print CAPIH <<'EOT';
718
719#endif /* !PERL_CORE */
acfe0abc 720#endif /* MULTIPLICITY */
6f4183fe 721
722#endif /* __perlapi_h__ */
723
724EOT
36bb303b 725close CAPIH or die "Error closing CAPIH: $!";
51371543 726
7f1be197 727print CAPI do_not_edit ("perlapi.c"), <<'EOT';
51371543 728
729#include "EXTERN.h"
730#include "perl.h"
731#include "perlapi.h"
732
acfe0abc 733#if defined (MULTIPLICITY)
51371543 734
735/* accessor functions for Perl variables (provides binary compatibility) */
736START_EXTERN_C
737
738#undef PERLVAR
739#undef PERLVARA
740#undef PERLVARI
741#undef PERLVARIC
6f4183fe 742
6f4183fe 743#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
744 { return &(aTHX->v); }
745#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
746 { return &(aTHX->v); }
6f4183fe 747
51371543 748#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 749#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543 750
751#include "thrdvar.h"
752#include "intrpvar.h"
c5be433b 753
754#undef PERLVAR
755#undef PERLVARA
acfe0abc 756#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
c5be433b 757 { return &(PL_##v); }
acfe0abc 758#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
c5be433b 759 { return &(PL_##v); }
34f7a5fe 760#undef PERLVARIC
acfe0abc 761#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
34f7a5fe 762 { return (const t *)&(PL_##v); }
51371543 763#include "perlvars.h"
764
765#undef PERLVAR
766#undef PERLVARA
767#undef PERLVARI
768#undef PERLVARIC
769
acfe0abc 770END_EXTERN_C
6f4183fe 771
acfe0abc 772#endif /* MULTIPLICITY */
51371543 773EOT
774
36bb303b 775close(CAPI) or die "Error closing CAPI: $!";
acfe0abc 776
c5be433b 777# functions that take va_list* for implementing vararg functions
08cd8952 778# NOTE: makedef.pl must be updated if you add symbols to %vfuncs
acfe0abc 779# XXX %vfuncs currently unused
c5be433b 780my %vfuncs = qw(
781 Perl_croak Perl_vcroak
782 Perl_warn Perl_vwarn
783 Perl_warner Perl_vwarner
784 Perl_die Perl_vdie
785 Perl_form Perl_vform
e4783991 786 Perl_load_module Perl_vload_module
5a844595 787 Perl_mess Perl_vmess
c5be433b 788 Perl_deb Perl_vdeb
789 Perl_newSVpvf Perl_vnewSVpvf
790 Perl_sv_setpvf Perl_sv_vsetpvf
791 Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
792 Perl_sv_catpvf Perl_sv_vcatpvf
793 Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
794 Perl_dump_indent Perl_dump_vindent
795 Perl_default_protect Perl_vdefault_protect
796);
Unnamed repository; edit this file to name it for gitweb.