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