projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Bleadperl on Cygwin today
[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
cea2e8a9 6#
7# See database of global and static function prototypes at the __END__.
8# This is used to generate prototype headers under various configurations,
9# export symbols lists for different platforms, and macros to provide an
10# implicit interpreter context argument.
11#
12
94bdecf9 13open IN, "embed.fnc" or die $!;
cea2e8a9 14
15# walk table providing an array of components in each line to
16# subroutine, printing the result
17sub walk_table (&@) {
18 my $function = shift;
19 my $filename = shift || '-';
20 my $leader = shift;
21 my $trailer = shift;
22 my $F;
23 local *F;
24 if (ref $filename) { # filehandle
25 $F = $filename;
26 }
27 else {
918426be 28 unlink $filename;
cea2e8a9 29 open F, ">$filename" or die "Can't open $filename: $!";
30 $F = \*F;
31 }
32 print $F $leader if $leader;
94bdecf9 33 seek IN, 0, 0; # so we may restart
34 while (<IN>) {
cea2e8a9 35 chomp;
1d7c1841 36 next if /^:/;
cea2e8a9 37 while (s|\\$||) {
94bdecf9 38 $_ .= <IN>;
cea2e8a9 39 chomp;
40 }
41 my @args;
42 if (/^\s*(#|$)/) {
43 @args = $_;
44 }
45 else {
46 @args = split /\s*\|\s*/, $_;
47 }
4543f4c0 48 my @outs = &{$function}(@args);
49 print $F @outs; # $function->(@args) is not 5.003
cea2e8a9 50 }
51 print $F $trailer if $trailer;
52 close $F unless ref $filename;
53}
54
55sub munge_c_files () {
56 my $functions = {};
57 unless (@ARGV) {
58 warn "\@ARGV empty, nothing to do\n";
59 return;
60 }
61 walk_table {
62 if (@_ > 1) {
63 $functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
64 }
65 } '/dev/null';
66 local $^I = '.bak';
67 while (<>) {
68# if (/^#\s*include\s+"perl.h"/) {
69# my $file = uc $ARGV;
70# $file =~ s/\./_/g;
71# print "#define PERL_IN_$file\n";
72# }
73# s{^(\w+)\s*\(}
74# {
75# my $f = $1;
76# my $repl = "$f(";
77# if (exists $functions->{$f}) {
78# my $flags = $functions->{$f}[0];
79# $repl = "Perl_$repl" if $flags =~ /p/;
80# unless ($flags =~ /n/) {
81# $repl .= "pTHX";
82# $repl .= "_ " if @{$functions->{$f}} > 3;
83# }
84# warn("$ARGV:$.:$repl\n");
85# }
86# $repl;
87# }e;
88 s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))}
89 {
90 my $repl = $1;
91 my $f = $2;
92 if (exists $functions->{$f}) {
93 $repl .= "aTHX_ ";
94 warn("$ARGV:$.:$`#$repl#$'");
95 }
96 $repl;
97 }eg;
98 print;
99 close ARGV if eof; # restart $.
100 }
101 exit;
102}
103
104#munge_c_files();
105
106# generate proto.h
0cb96387 107my $wrote_protected = 0;
108
cea2e8a9 109sub write_protos {
110 my $ret = "";
111 if (@_ == 1) {
112 my $arg = shift;
1d7c1841 113 $ret .= "$arg\n";
cea2e8a9 114 }
115 else {
116 my ($flags,$retval,$func,@args) = @_;
af3c7592 117 $ret .= '/* ' if $flags =~ /m/;
cea2e8a9 118 if ($flags =~ /s/) {
119 $retval = "STATIC $retval";
120 $func = "S_$func";
121 }
0cb96387 122 else {
1d7c1841 123 $retval = "PERL_CALLCONV $retval";
0cb96387 124 if ($flags =~ /p/) {
125 $func = "Perl_$func";
126 }
cea2e8a9 127 }
128 $ret .= "$retval\t$func(";
129 unless ($flags =~ /n/) {
130 $ret .= "pTHX";
131 $ret .= "_ " if @args;
132 }
133 if (@args) {
134 $ret .= join ", ", @args;
135 }
136 else {
137 $ret .= "void" if $flags =~ /n/;
138 }
139 $ret .= ")";
140 $ret .= " __attribute__((noreturn))" if $flags =~ /r/;
1c846c1f 141 if( $flags =~ /f/ ) {
894356b3 142 my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
1c846c1f 143 my $args = scalar @args;
d5b3b440 144 $ret .= "\n#ifdef CHECK_FORMAT\n";
894356b3 145 $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
1c846c1f 146 $prefix, $args - 1, $prefix, $args;
894356b3 147 $ret .= "\n#endif\n";
148 }
af3c7592 149 $ret .= ";";
150 $ret .= ' */' if $flags =~ /m/;
151 $ret .= "\n";
cea2e8a9 152 }
153 $ret;
154}
155
954c1994 156# generates global.sym (API export list), and populates %global with global symbols
cea2e8a9 157sub write_global_sym {
158 my $ret = "";
159 if (@_ > 1) {
160 my ($flags,$retval,$func,@args) = @_;
af3c7592 161 if ($flags =~ /A/ && $flags !~ /[xm]/) { # public API, so export
cea2e8a9 162 $func = "Perl_$func" if $flags =~ /p/;
163 $ret = "$func\n";
164 }
165 }
166 $ret;
167}
168
169
170walk_table(\&write_protos, 'proto.h', <<'EOT');
171/*
d6376244 172 * proto.h
173 *
174 * Copyright (c) 1997-2002, Larry Wall
175 *
176 * You may distribute under the terms of either the GNU General Public
177 * License or the Artistic License, as specified in the README file.
178 *
cea2e8a9 179 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
180 * This file is autogenerated from data in embed.pl. Edit that file
181 * and run 'make regen_headers' to effect changes.
182 */
183
184EOT
185
186walk_table(\&write_global_sym, 'global.sym', <<'EOT');
187#
d6376244 188# global.sym
189#
190# Copyright (c) 1997-2002, Larry Wall
191#
192# You may distribute under the terms of either the GNU General Public
193# License or the Artistic License, as specified in the README file.
194#
cea2e8a9 195# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
196# This file is autogenerated from data in embed.pl. Edit that file
197# and run 'make regen_headers' to effect changes.
198#
199
200EOT
201
709f4e38 202# XXX others that may need adding
203# warnhook
204# hints
205# copline
84fee439 206my @extvars = qw(sv_undef sv_yes sv_no na dowarn
1c846c1f 207 curcop compiling
84fee439 208 tainting tainted stack_base stack_sp sv_arenaroot
256a4781 209 no_modify
84fee439 210 curstash DBsub DBsingle debstash
1c846c1f 211 rsfp
84fee439 212 stdingv
6b88bc9c 213 defgv
214 errgv
3070f6ec 215 rsfp_filters
216 perldb
709f4e38 217 diehook
218 dirty
219 perl_destruct_level
ac634a9a 220 ppaddr
84fee439 221 );
222
5f05dabc 223sub readsyms (\%$) {
224 my ($syms, $file) = @_;
5f05dabc 225 local (*FILE, $_);
226 open(FILE, "< $file")
227 or die "embed.pl: Can't open $file: $!\n";
228 while (<FILE>) {
229 s/[ \t]*#.*//; # Delete comments.
230 if (/^\s*(\S+)\s*$/) {
22c35a8c 231 my $sym = $1;
232 warn "duplicate symbol $sym while processing $file\n"
233 if exists $$syms{$sym};
234 $$syms{$sym} = 1;
5f05dabc 235 }
236 }
237 close(FILE);
238}
239
cea2e8a9 240# Perl_pp_* and Perl_ck_* are in pp.sym
241readsyms my %ppsym, 'pp.sym';
5f05dabc 242
c6af7a1a 243sub readvars(\%$$@) {
244 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1 245 local (*FILE, $_);
246 open(FILE, "< $file")
247 or die "embed.pl: Can't open $file: $!\n";
248 while (<FILE>) {
249 s/[ \t]*#.*//; # Delete comments.
51371543 250 if (/PERLVARA?I?C?\($pre(\w+)/) {
22c35a8c 251 my $sym = $1;
c6af7a1a 252 $sym = $pre . $sym if $keep_pre;
22c35a8c 253 warn "duplicate symbol $sym while processing $file\n"
254 if exists $$syms{$sym};
51371543 255 $$syms{$sym} = $pre || 1;
d4cce5f1 256 }
257 }
258 close(FILE);
259}
260
261my %intrp;
262my %thread;
263
264readvars %intrp, 'intrpvar.h','I';
265readvars %thread, 'thrdvar.h','T';
22239a37 266readvars %globvar, 'perlvars.h','G';
d4cce5f1 267
4543f4c0 268my $sym;
269foreach $sym (sort keys %thread) {
34b58025 270 warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
51371543 271}
d4cce5f1 272
c6af7a1a 273sub undefine ($) {
274 my ($sym) = @_;
275 "#undef $sym\n";
276}
277
5f05dabc 278sub hide ($$) {
279 my ($from, $to) = @_;
280 my $t = int(length($from) / 8);
281 "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
282}
c6af7a1a 283
6f4183fe 284sub bincompat_var ($$) {
51371543 285 my ($pfx, $sym) = @_;
acfe0abc 286 my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX');
c5be433b 287 undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
c6af7a1a 288}
289
d4cce5f1 290sub multon ($$$) {
291 my ($sym,$pre,$ptr) = @_;
3280af22 292 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 293}
54aff467 294
d4cce5f1 295sub multoff ($$) {
296 my ($sym,$pre) = @_;
533c011a 297 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc 298}
299
300unlink 'embed.h';
cea2e8a9 301open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
e50aee73 302
303print EM <<'END';
d6376244 304/*
305 * embed.h
306 *
307 * Copyright (c) 1997-2002, Larry Wall
308 *
309 * You may distribute under the terms of either the GNU General Public
310 * License or the Artistic License, as specified in the README file.
311 *
312 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
313 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
314 * perlvars.h and thrdvar.h. Any changes made here will be lost!
315 */
e50aee73 316
317/* (Doing namespace management portably in C is really gross.) */
318
22c35a8c 319/* NO_EMBED is no longer supported. i.e. EMBED is always active. */
820c3be9 320
538feb02 321/* provide binary compatible (but inconsistent) names */
322#if defined(PERL_BINCOMPAT_5005)
c0e79ee6 323# define Perl_call_atexit perl_atexit
324# define Perl_eval_sv perl_eval_sv
325# define Perl_eval_pv perl_eval_pv
538feb02 326# define Perl_call_argv perl_call_argv
327# define Perl_call_method perl_call_method
328# define Perl_call_pv perl_call_pv
329# define Perl_call_sv perl_call_sv
330# define Perl_get_av perl_get_av
331# define Perl_get_cv perl_get_cv
332# define Perl_get_hv perl_get_hv
333# define Perl_get_sv perl_get_sv
334# define Perl_init_i18nl10n perl_init_i18nl10n
335# define Perl_init_i18nl14n perl_init_i18nl14n
336# define Perl_new_collate perl_new_collate
337# define Perl_new_ctype perl_new_ctype
338# define Perl_new_numeric perl_new_numeric
339# define Perl_require_pv perl_require_pv
340# define Perl_safesyscalloc Perl_safecalloc
341# define Perl_safesysfree Perl_safefree
342# define Perl_safesysmalloc Perl_safemalloc
343# define Perl_safesysrealloc Perl_saferealloc
344# define Perl_set_numeric_local perl_set_numeric_local
345# define Perl_set_numeric_standard perl_set_numeric_standard
37bd1396 346/* malloc() pollution was the default in earlier versions, so enable
347 * it for bincompat; but not for systems that used to do prevent that,
348 * or when they ask for {HIDE,EMBED}MYMALLOC */
349# if !defined(EMBEDMYMALLOC) && !defined(HIDEMYMALLOC)
350# if !defined(NeXT) && !defined(__NeXT) && !defined(__MACHTEN__) && \
351 !defined(__QNX__)
352# define PERL_POLLUTE_MALLOC
353# endif
3d3b6b6a 354# endif
538feb02 355#endif
356
22c35a8c 357/* Hide global symbols */
5f05dabc 358
cea2e8a9 359#if !defined(PERL_IMPLICIT_CONTEXT)
e50aee73 360
e50aee73 361END
362
cea2e8a9 363walk_table {
364 my $ret = "";
365 if (@_ == 1) {
366 my $arg = shift;
12a98ad5 367 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9 368 }
369 else {
370 my ($flags,$retval,$func,@args) = @_;
af3c7592 371 unless ($flags =~ /[om]/) {
cea2e8a9 372 if ($flags =~ /s/) {
373 $ret .= hide($func,"S_$func");
374 }
375 elsif ($flags =~ /p/) {
376 $ret .= hide($func,"Perl_$func");
377 }
378 }
379 }
380 $ret;
381} \*EM;
382
383for $sym (sort keys %ppsym) {
384 $sym =~ s/^Perl_//;
385 print EM hide($sym, "Perl_$sym");
386}
387
388print EM <<'END';
389
390#else /* PERL_IMPLICIT_CONTEXT */
391
392END
393
394my @az = ('a'..'z');
395
396walk_table {
397 my $ret = "";
398 if (@_ == 1) {
399 my $arg = shift;
12a98ad5 400 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9 401 }
402 else {
403 my ($flags,$retval,$func,@args) = @_;
af3c7592 404 unless ($flags =~ /[om]/) {
cea2e8a9 405 my $args = scalar @args;
406 if ($args and $args[$args-1] =~ /\.\.\./) {
407 # we're out of luck for varargs functions under CPP
408 }
409 elsif ($flags =~ /n/) {
410 if ($flags =~ /s/) {
411 $ret .= hide($func,"S_$func");
412 }
413 elsif ($flags =~ /p/) {
414 $ret .= hide($func,"Perl_$func");
415 }
416 }
417 else {
418 my $alist = join(",", @az[0..$args-1]);
419 $ret = "#define $func($alist)";
420 my $t = int(length($ret) / 8);
421 $ret .= "\t" x ($t < 4 ? 4 - $t : 1);
422 if ($flags =~ /s/) {
423 $ret .= "S_$func(aTHX";
424 }
425 elsif ($flags =~ /p/) {
426 $ret .= "Perl_$func(aTHX";
427 }
428 $ret .= "_ " if $alist;
429 $ret .= $alist . ")\n";
430 }
431 }
432 }
433 $ret;
434} \*EM;
435
436for $sym (sort keys %ppsym) {
437 $sym =~ s/^Perl_//;
438 if ($sym =~ /^ck_/) {
439 print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
440 }
441 elsif ($sym =~ /^pp_/) {
442 print EM hide("$sym()", "Perl_$sym(aTHX)");
443 }
444 else {
445 warn "Illegal symbol '$sym' in pp.sym";
446 }
e50aee73 447}
448
e50aee73 449print EM <<'END';
450
cea2e8a9 451#endif /* PERL_IMPLICIT_CONTEXT */
22c35a8c 452
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
538feb02 466#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) && !defined(PERL_BINCOMPAT_5005)
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 */
acfe0abc 497#if defined(PERL_IMPLICIT_CONTEXT)
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
534close(EM);
535
536unlink 'embedvar.h';
537open(EM, '> embedvar.h')
538 or die "Can't create embedvar.h: $!\n";
539
540print EM <<'END';
d6376244 541/*
542 * embedvar.h
543 *
544 * Copyright (c) 1997-2002, Larry Wall
545 *
546 * You may distribute under the terms of either the GNU General Public
547 * License or the Artistic License, as specified in the README file.
548 *
549 *
550 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
551 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
552 * perlvars.h and thrdvar.h. Any changes made here will be lost!
553 */
d4cce5f1 554
555/* (Doing namespace management portably in C is really gross.) */
556
54aff467 557/*
acfe0abc 558 The following combinations of MULTIPLICITY, USE_5005THREADS
54aff467 559 and PERL_IMPLICIT_CONTEXT are supported:
560 1) none
561 2) MULTIPLICITY # supported for compatibility
562 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
4d1ff10f 563 4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT
564 5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT
54aff467 565
566 All other combinations of these flags are errors.
567
568 #3, #4, #5, and #6 are supported directly, while #2 is a special
569 case of #3 (supported by redefining vTHX appropriately).
570*/
cea2e8a9 571
54aff467 572#if defined(MULTIPLICITY)
573/* cases 2, 3 and 5 above */
cea2e8a9 574
54aff467 575# if defined(PERL_IMPLICIT_CONTEXT)
576# define vTHX aTHX
577# else
578# define vTHX PERL_GET_INTERP
579# endif
cea2e8a9 580
e50aee73 581END
582
d4cce5f1 583for $sym (sort keys %thread) {
54aff467 584 print EM multon($sym,'T','vTHX->');
d4cce5f1 585}
586
587print EM <<'END';
588
4d1ff10f 589# if defined(USE_5005THREADS)
54aff467 590/* case 5 above */
d4cce5f1 591
592END
593
594for $sym (sort keys %intrp) {
c5be433b 595 print EM multon($sym,'I','PERL_GET_INTERP->');
760ac839 596}
760ac839 597
55497cff 598print EM <<'END';
599
4d1ff10f 600# else /* !USE_5005THREADS */
54aff467 601/* cases 2 and 3 above */
55497cff 602
603END
760ac839 604
d4cce5f1 605for $sym (sort keys %intrp) {
54aff467 606 print EM multon($sym,'I','vTHX->');
d4cce5f1 607}
608
609print EM <<'END';
610
4d1ff10f 611# endif /* USE_5005THREADS */
d4cce5f1 612
54aff467 613#else /* !MULTIPLICITY */
1d7c1841 614
1d7c1841 615/* cases 1 and 4 above */
5f05dabc 616
56d28764 617END
e50aee73 618
d4cce5f1 619for $sym (sort keys %intrp) {
54aff467 620 print EM multoff($sym,'I');
d4cce5f1 621}
622
623print EM <<'END';
624
acfe0abc 625# if defined(USE_5005THREADS)
54aff467 626/* case 4 above */
d4cce5f1 627
628END
629
630for $sym (sort keys %thread) {
54aff467 631 print EM multon($sym,'T','aTHX->');
5f05dabc 632}
633
634print EM <<'END';
635
acfe0abc 636# else /* !USE_5005THREADS */
1d7c1841 637/* case 1 above */
d4cce5f1 638
639END
640
641for $sym (sort keys %thread) {
54aff467 642 print EM multoff($sym,'T');
d4cce5f1 643}
644
645print EM <<'END';
646
acfe0abc 647# endif /* USE_5005THREADS */
54aff467 648#endif /* MULTIPLICITY */
d4cce5f1 649
54aff467 650#if defined(PERL_GLOBAL_STRUCT)
22239a37 651
652END
653
654for $sym (sort keys %globvar) {
533c011a 655 print EM multon($sym,'G','PL_Vars.');
22239a37 656}
657
658print EM <<'END';
659
660#else /* !PERL_GLOBAL_STRUCT */
661
662END
663
664for $sym (sort keys %globvar) {
665 print EM multoff($sym,'G');
666}
667
668print EM <<'END';
669
22239a37 670#endif /* PERL_GLOBAL_STRUCT */
671
85add8c2 672#ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
84fee439 673
674END
675
676for $sym (sort @extvars) {
677 print EM hide($sym,"PL_$sym");
678}
679
680print EM <<'END';
681
db5cf5a9 682#endif /* PERL_POLLUTE */
84fee439 683END
684
3fe35a81 685close(EM);
c6af7a1a 686
51371543 687unlink 'perlapi.h';
688unlink 'perlapi.c';
689open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
690open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
691
692print CAPIH <<'EOT';
d6376244 693/*
694 * perlapi.h
695 *
696 * Copyright (c) 1997-2002, Larry Wall
697 *
698 * You may distribute under the terms of either the GNU General Public
699 * License or the Artistic License, as specified in the README file.
700 *
701 *
702 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
703 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
704 * perlvars.h and thrdvar.h. Any changes made here will be lost!
705 */
51371543 706
51371543 707/* declare accessor functions for Perl variables */
6f4183fe 708#ifndef __perlapi_h__
709#define __perlapi_h__
51371543 710
acfe0abc 711#if defined (MULTIPLICITY)
c5be433b 712
51371543 713START_EXTERN_C
714
715#undef PERLVAR
716#undef PERLVARA
717#undef PERLVARI
718#undef PERLVARIC
acfe0abc 719#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
51371543 720#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
acfe0abc 721 EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
51371543 722#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 723#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543 724
725#include "thrdvar.h"
726#include "intrpvar.h"
727#include "perlvars.h"
728
729#undef PERLVAR
730#undef PERLVARA
731#undef PERLVARI
732#undef PERLVARIC
733
734END_EXTERN_C
735
682fc664 736#if defined(PERL_CORE)
6f4183fe 737
682fc664 738/* accessor functions for Perl variables (provide binary compatibility) */
739
740/* these need to be mentioned here, or most linkers won't put them in
741 the perl executable */
742
743#ifndef PERL_NO_FORCE_LINK
744
745START_EXTERN_C
746
747#ifndef DOINIT
748EXT void *PL_force_link_funcs[];
749#else
750EXT void *PL_force_link_funcs[] = {
751#undef PERLVAR
752#undef PERLVARA
753#undef PERLVARI
754#undef PERLVARIC
ea1f607c 755#define PERLVAR(v,t) (void*)Perl_##v##_ptr,
682fc664 756#define PERLVARA(v,n,t) PERLVAR(v,t)
757#define PERLVARI(v,t,i) PERLVAR(v,t)
758#define PERLVARIC(v,t,i) PERLVAR(v,t)
759
760#include "thrdvar.h"
761#include "intrpvar.h"
762#include "perlvars.h"
763
764#undef PERLVAR
765#undef PERLVARA
766#undef PERLVARI
767#undef PERLVARIC
768};
769#endif /* DOINIT */
770
acfe0abc 771END_EXTERN_C
682fc664 772
773#endif /* PERL_NO_FORCE_LINK */
774
775#else /* !PERL_CORE */
51371543 776
777EOT
778
4543f4c0 779foreach $sym (sort keys %intrp) {
6f4183fe 780 print CAPIH bincompat_var('I',$sym);
781}
782
4543f4c0 783foreach $sym (sort keys %thread) {
6f4183fe 784 print CAPIH bincompat_var('T',$sym);
785}
786
4543f4c0 787foreach $sym (sort keys %globvar) {
6f4183fe 788 print CAPIH bincompat_var('G',$sym);
789}
790
791print CAPIH <<'EOT';
792
793#endif /* !PERL_CORE */
acfe0abc 794#endif /* MULTIPLICITY */
6f4183fe 795
796#endif /* __perlapi_h__ */
797
798EOT
d98f61e7 799close CAPIH;
51371543 800
801print CAPI <<'EOT';
d6376244 802/*
803 * perlapi.c
804 *
805 * Copyright (c) 1997-2002, Larry Wall
806 *
807 * You may distribute under the terms of either the GNU General Public
808 * License or the Artistic License, as specified in the README file.
809 *
810 *
811 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
812 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
813 * perlvars.h and thrdvar.h. Any changes made here will be lost!
814 */
51371543 815
816#include "EXTERN.h"
817#include "perl.h"
818#include "perlapi.h"
819
acfe0abc 820#if defined (MULTIPLICITY)
51371543 821
822/* accessor functions for Perl variables (provides binary compatibility) */
823START_EXTERN_C
824
825#undef PERLVAR
826#undef PERLVARA
827#undef PERLVARI
828#undef PERLVARIC
6f4183fe 829
6f4183fe 830#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
831 { return &(aTHX->v); }
832#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
833 { return &(aTHX->v); }
6f4183fe 834
51371543 835#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 836#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543 837
838#include "thrdvar.h"
839#include "intrpvar.h"
c5be433b 840
841#undef PERLVAR
842#undef PERLVARA
acfe0abc 843#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
c5be433b 844 { return &(PL_##v); }
acfe0abc 845#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
c5be433b 846 { return &(PL_##v); }
34f7a5fe 847#undef PERLVARIC
acfe0abc 848#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
34f7a5fe 849 { return (const t *)&(PL_##v); }
51371543 850#include "perlvars.h"
851
852#undef PERLVAR
853#undef PERLVARA
854#undef PERLVARI
855#undef PERLVARIC
856
acfe0abc 857END_EXTERN_C
6f4183fe 858
acfe0abc 859#endif /* MULTIPLICITY */
51371543 860EOT
861
acfe0abc 862close(CAPI);
863
c5be433b 864# functions that take va_list* for implementing vararg functions
08cd8952 865# NOTE: makedef.pl must be updated if you add symbols to %vfuncs
acfe0abc 866# XXX %vfuncs currently unused
c5be433b 867my %vfuncs = qw(
868 Perl_croak Perl_vcroak
869 Perl_warn Perl_vwarn
870 Perl_warner Perl_vwarner
871 Perl_die Perl_vdie
872 Perl_form Perl_vform
e4783991 873 Perl_load_module Perl_vload_module
5a844595 874 Perl_mess Perl_vmess
c5be433b 875 Perl_deb Perl_vdeb
876 Perl_newSVpvf Perl_vnewSVpvf
877 Perl_sv_setpvf Perl_sv_vsetpvf
878 Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
879 Perl_sv_catpvf Perl_sv_vcatpvf
880 Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
881 Perl_dump_indent Perl_dump_vindent
882 Perl_default_protect Perl_vdefault_protect
883);
Unnamed repository; edit this file to name it for gitweb.