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