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