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