projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
binmode(FH); to act like binmode(FH,":bytes") as well as
[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
22c35a8c 321/* Hide global symbols */
5f05dabc 322
cea2e8a9 323#if !defined(PERL_IMPLICIT_CONTEXT)
e50aee73 324
e50aee73 325END
326
cea2e8a9 327walk_table {
328 my $ret = "";
329 if (@_ == 1) {
330 my $arg = shift;
12a98ad5 331 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
cea2e8a9 332 }
333 else {
334 my ($flags,$retval,$func,@args) = @_;
af3c7592 335 unless ($flags =~ /[om]/) {
cea2e8a9 336 if ($flags =~ /s/) {
337 $ret .= hide($func,"S_$func");
338 }
339 elsif ($flags =~ /p/) {
340 $ret .= hide($func,"Perl_$func");
341 }
342 }
343 }
344 $ret;
345} \*EM;
346
347for $sym (sort keys %ppsym) {
348 $sym =~ s/^Perl_//;
349 print EM hide($sym, "Perl_$sym");
350}
351
352print EM <<'END';
353
354#else /* PERL_IMPLICIT_CONTEXT */
355
356END
357
358my @az = ('a'..'z');
359
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 my $args = scalar @args;
370 if ($args and $args[$args-1] =~ /\.\.\./) {
371 # we're out of luck for varargs functions under CPP
372 }
373 elsif ($flags =~ /n/) {
374 if ($flags =~ /s/) {
375 $ret .= hide($func,"S_$func");
376 }
377 elsif ($flags =~ /p/) {
378 $ret .= hide($func,"Perl_$func");
379 }
380 }
381 else {
382 my $alist = join(",", @az[0..$args-1]);
383 $ret = "#define $func($alist)";
384 my $t = int(length($ret) / 8);
385 $ret .= "\t" x ($t < 4 ? 4 - $t : 1);
386 if ($flags =~ /s/) {
387 $ret .= "S_$func(aTHX";
388 }
389 elsif ($flags =~ /p/) {
390 $ret .= "Perl_$func(aTHX";
391 }
392 $ret .= "_ " if $alist;
393 $ret .= $alist . ")\n";
394 }
395 }
396 }
397 $ret;
398} \*EM;
399
400for $sym (sort keys %ppsym) {
401 $sym =~ s/^Perl_//;
402 if ($sym =~ /^ck_/) {
403 print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
404 }
405 elsif ($sym =~ /^pp_/) {
406 print EM hide("$sym()", "Perl_$sym(aTHX)");
407 }
408 else {
409 warn "Illegal symbol '$sym' in pp.sym";
410 }
e50aee73 411}
412
e50aee73 413print EM <<'END';
414
cea2e8a9 415#endif /* PERL_IMPLICIT_CONTEXT */
22c35a8c 416
417END
418
22c35a8c 419print EM <<'END';
420
cea2e8a9 421/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
422 disable them.
423 */
424
538feb02 425#if !defined(PERL_CORE)
5bc28da9 426# define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,PTR2IV(ptr))
427# define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,PTR2IV(ptr))
538feb02 428#endif
cea2e8a9 429
08e5223a 430#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
cea2e8a9 431
432/* Compatibility for various misnamed functions. All functions
433 in the API that begin with "perl_" (not "Perl_") take an explicit
434 interpreter context pointer.
435 The following are not like that, but since they had a "perl_"
436 prefix in previous versions, we provide compatibility macros.
437 */
65cec589 438# define perl_atexit(a,b) call_atexit(a,b)
439# define perl_call_argv(a,b,c) call_argv(a,b,c)
440# define perl_call_pv(a,b) call_pv(a,b)
441# define perl_call_method(a,b) call_method(a,b)
442# define perl_call_sv(a,b) call_sv(a,b)
443# define perl_eval_sv(a,b) eval_sv(a,b)
444# define perl_eval_pv(a,b) eval_pv(a,b)
445# define perl_require_pv(a) require_pv(a)
446# define perl_get_sv(a,b) get_sv(a,b)
447# define perl_get_av(a,b) get_av(a,b)
448# define perl_get_hv(a,b) get_hv(a,b)
449# define perl_get_cv(a,b) get_cv(a,b)
450# define perl_init_i18nl10n(a) init_i18nl10n(a)
451# define perl_init_i18nl14n(a) init_i18nl14n(a)
452# define perl_new_ctype(a) new_ctype(a)
453# define perl_new_collate(a) new_collate(a)
454# define perl_new_numeric(a) new_numeric(a)
cea2e8a9 455
456/* varargs functions can't be handled with CPP macros. :-(
457 This provides a set of compatibility functions that don't take
458 an extra argument but grab the context pointer using the macro
459 dTHX.
460 */
acfe0abc 461#if defined(PERL_IMPLICIT_CONTEXT)
cea2e8a9 462# define croak Perl_croak_nocontext
c5be433b 463# define deb Perl_deb_nocontext
cea2e8a9 464# define die Perl_die_nocontext
465# define form Perl_form_nocontext
e4783991 466# define load_module Perl_load_module_nocontext
5a844595 467# define mess Perl_mess_nocontext
cea2e8a9 468# define newSVpvf Perl_newSVpvf_nocontext
469# define sv_catpvf Perl_sv_catpvf_nocontext
470# define sv_setpvf Perl_sv_setpvf_nocontext
471# define warn Perl_warn_nocontext
c5be433b 472# define warner Perl_warner_nocontext
cea2e8a9 473# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
474# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
475#endif
476
477#endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
478
479#if !defined(PERL_IMPLICIT_CONTEXT)
480/* undefined symbols, point them back at the usual ones */
481# define Perl_croak_nocontext Perl_croak
482# define Perl_die_nocontext Perl_die
c5be433b 483# define Perl_deb_nocontext Perl_deb
cea2e8a9 484# define Perl_form_nocontext Perl_form
e4783991 485# define Perl_load_module_nocontext Perl_load_module
5a844595 486# define Perl_mess_nocontext Perl_mess
c5be433b 487# define Perl_newSVpvf_nocontext Perl_newSVpvf
488# define Perl_sv_catpvf_nocontext Perl_sv_catpvf
489# define Perl_sv_setpvf_nocontext Perl_sv_setpvf
cea2e8a9 490# define Perl_warn_nocontext Perl_warn
c5be433b 491# define Perl_warner_nocontext Perl_warner
cea2e8a9 492# define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
493# define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
494#endif
db5cf5a9 495
d4cce5f1 496END
497
498close(EM);
499
500unlink 'embedvar.h';
501open(EM, '> embedvar.h')
502 or die "Can't create embedvar.h: $!\n";
503
504print EM <<'END';
d6376244 505/*
506 * embedvar.h
507 *
508 * Copyright (c) 1997-2002, Larry Wall
509 *
510 * You may distribute under the terms of either the GNU General Public
511 * License or the Artistic License, as specified in the README file.
512 *
513 *
514 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
515 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
516 * perlvars.h and thrdvar.h. Any changes made here will be lost!
517 */
d4cce5f1 518
519/* (Doing namespace management portably in C is really gross.) */
520
54aff467 521/*
acfe0abc 522 The following combinations of MULTIPLICITY, USE_5005THREADS
54aff467 523 and PERL_IMPLICIT_CONTEXT are supported:
524 1) none
525 2) MULTIPLICITY # supported for compatibility
526 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
4d1ff10f 527 4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT
528 5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT
54aff467 529
530 All other combinations of these flags are errors.
531
532 #3, #4, #5, and #6 are supported directly, while #2 is a special
533 case of #3 (supported by redefining vTHX appropriately).
534*/
cea2e8a9 535
54aff467 536#if defined(MULTIPLICITY)
537/* cases 2, 3 and 5 above */
cea2e8a9 538
54aff467 539# if defined(PERL_IMPLICIT_CONTEXT)
540# define vTHX aTHX
541# else
542# define vTHX PERL_GET_INTERP
543# endif
cea2e8a9 544
e50aee73 545END
546
d4cce5f1 547for $sym (sort keys %thread) {
54aff467 548 print EM multon($sym,'T','vTHX->');
d4cce5f1 549}
550
551print EM <<'END';
552
4d1ff10f 553# if defined(USE_5005THREADS)
54aff467 554/* case 5 above */
d4cce5f1 555
556END
557
558for $sym (sort keys %intrp) {
c5be433b 559 print EM multon($sym,'I','PERL_GET_INTERP->');
760ac839 560}
760ac839 561
55497cff 562print EM <<'END';
563
4d1ff10f 564# else /* !USE_5005THREADS */
54aff467 565/* cases 2 and 3 above */
55497cff 566
567END
760ac839 568
d4cce5f1 569for $sym (sort keys %intrp) {
54aff467 570 print EM multon($sym,'I','vTHX->');
d4cce5f1 571}
572
573print EM <<'END';
574
4d1ff10f 575# endif /* USE_5005THREADS */
d4cce5f1 576
54aff467 577#else /* !MULTIPLICITY */
1d7c1841 578
1d7c1841 579/* cases 1 and 4 above */
5f05dabc 580
56d28764 581END
e50aee73 582
d4cce5f1 583for $sym (sort keys %intrp) {
54aff467 584 print EM multoff($sym,'I');
d4cce5f1 585}
586
587print EM <<'END';
588
acfe0abc 589# if defined(USE_5005THREADS)
54aff467 590/* case 4 above */
d4cce5f1 591
592END
593
594for $sym (sort keys %thread) {
54aff467 595 print EM multon($sym,'T','aTHX->');
5f05dabc 596}
597
598print EM <<'END';
599
acfe0abc 600# else /* !USE_5005THREADS */
1d7c1841 601/* case 1 above */
d4cce5f1 602
603END
604
605for $sym (sort keys %thread) {
54aff467 606 print EM multoff($sym,'T');
d4cce5f1 607}
608
609print EM <<'END';
610
acfe0abc 611# endif /* USE_5005THREADS */
54aff467 612#endif /* MULTIPLICITY */
d4cce5f1 613
54aff467 614#if defined(PERL_GLOBAL_STRUCT)
22239a37 615
616END
617
618for $sym (sort keys %globvar) {
533c011a 619 print EM multon($sym,'G','PL_Vars.');
22239a37 620}
621
622print EM <<'END';
623
624#else /* !PERL_GLOBAL_STRUCT */
625
626END
627
628for $sym (sort keys %globvar) {
629 print EM multoff($sym,'G');
630}
631
632print EM <<'END';
633
22239a37 634#endif /* PERL_GLOBAL_STRUCT */
635
85add8c2 636#ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
84fee439 637
638END
639
640for $sym (sort @extvars) {
641 print EM hide($sym,"PL_$sym");
642}
643
644print EM <<'END';
645
db5cf5a9 646#endif /* PERL_POLLUTE */
84fee439 647END
648
3fe35a81 649close(EM);
c6af7a1a 650
51371543 651unlink 'perlapi.h';
652unlink 'perlapi.c';
653open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
654open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
655
656print CAPIH <<'EOT';
d6376244 657/*
658 * perlapi.h
659 *
660 * Copyright (c) 1997-2002, Larry Wall
661 *
662 * You may distribute under the terms of either the GNU General Public
663 * License or the Artistic License, as specified in the README file.
664 *
665 *
666 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
667 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
668 * perlvars.h and thrdvar.h. Any changes made here will be lost!
669 */
51371543 670
51371543 671/* declare accessor functions for Perl variables */
6f4183fe 672#ifndef __perlapi_h__
673#define __perlapi_h__
51371543 674
acfe0abc 675#if defined (MULTIPLICITY)
c5be433b 676
51371543 677START_EXTERN_C
678
679#undef PERLVAR
680#undef PERLVARA
681#undef PERLVARI
682#undef PERLVARIC
acfe0abc 683#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
51371543 684#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
acfe0abc 685 EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
51371543 686#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 687#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543 688
689#include "thrdvar.h"
690#include "intrpvar.h"
691#include "perlvars.h"
692
693#undef PERLVAR
694#undef PERLVARA
695#undef PERLVARI
696#undef PERLVARIC
697
698END_EXTERN_C
699
682fc664 700#if defined(PERL_CORE)
6f4183fe 701
682fc664 702/* accessor functions for Perl variables (provide binary compatibility) */
703
704/* these need to be mentioned here, or most linkers won't put them in
705 the perl executable */
706
707#ifndef PERL_NO_FORCE_LINK
708
709START_EXTERN_C
710
711#ifndef DOINIT
712EXT void *PL_force_link_funcs[];
713#else
714EXT void *PL_force_link_funcs[] = {
715#undef PERLVAR
716#undef PERLVARA
717#undef PERLVARI
718#undef PERLVARIC
ea1f607c 719#define PERLVAR(v,t) (void*)Perl_##v##_ptr,
682fc664 720#define PERLVARA(v,n,t) PERLVAR(v,t)
721#define PERLVARI(v,t,i) PERLVAR(v,t)
722#define PERLVARIC(v,t,i) PERLVAR(v,t)
723
724#include "thrdvar.h"
725#include "intrpvar.h"
726#include "perlvars.h"
727
728#undef PERLVAR
729#undef PERLVARA
730#undef PERLVARI
731#undef PERLVARIC
732};
733#endif /* DOINIT */
734
acfe0abc 735END_EXTERN_C
682fc664 736
737#endif /* PERL_NO_FORCE_LINK */
738
739#else /* !PERL_CORE */
51371543 740
741EOT
742
4543f4c0 743foreach $sym (sort keys %intrp) {
6f4183fe 744 print CAPIH bincompat_var('I',$sym);
745}
746
4543f4c0 747foreach $sym (sort keys %thread) {
6f4183fe 748 print CAPIH bincompat_var('T',$sym);
749}
750
4543f4c0 751foreach $sym (sort keys %globvar) {
6f4183fe 752 print CAPIH bincompat_var('G',$sym);
753}
754
755print CAPIH <<'EOT';
756
757#endif /* !PERL_CORE */
acfe0abc 758#endif /* MULTIPLICITY */
6f4183fe 759
760#endif /* __perlapi_h__ */
761
762EOT
d98f61e7 763close CAPIH;
51371543 764
765print CAPI <<'EOT';
d6376244 766/*
767 * perlapi.c
768 *
769 * Copyright (c) 1997-2002, Larry Wall
770 *
771 * You may distribute under the terms of either the GNU General Public
772 * License or the Artistic License, as specified in the README file.
773 *
774 *
775 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
776 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
777 * perlvars.h and thrdvar.h. Any changes made here will be lost!
778 */
51371543 779
780#include "EXTERN.h"
781#include "perl.h"
782#include "perlapi.h"
783
acfe0abc 784#if defined (MULTIPLICITY)
51371543 785
786/* accessor functions for Perl variables (provides binary compatibility) */
787START_EXTERN_C
788
789#undef PERLVAR
790#undef PERLVARA
791#undef PERLVARI
792#undef PERLVARIC
6f4183fe 793
6f4183fe 794#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
795 { return &(aTHX->v); }
796#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
797 { return &(aTHX->v); }
6f4183fe 798
51371543 799#define PERLVARI(v,t,i) PERLVAR(v,t)
c5be433b 800#define PERLVARIC(v,t,i) PERLVAR(v, const t)
51371543 801
802#include "thrdvar.h"
803#include "intrpvar.h"
c5be433b 804
805#undef PERLVAR
806#undef PERLVARA
acfe0abc 807#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
c5be433b 808 { return &(PL_##v); }
acfe0abc 809#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
c5be433b 810 { return &(PL_##v); }
34f7a5fe 811#undef PERLVARIC
acfe0abc 812#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
34f7a5fe 813 { return (const t *)&(PL_##v); }
51371543 814#include "perlvars.h"
815
816#undef PERLVAR
817#undef PERLVARA
818#undef PERLVARI
819#undef PERLVARIC
820
acfe0abc 821END_EXTERN_C
6f4183fe 822
acfe0abc 823#endif /* MULTIPLICITY */
51371543 824EOT
825
acfe0abc 826close(CAPI);
827
c5be433b 828# functions that take va_list* for implementing vararg functions
08cd8952 829# NOTE: makedef.pl must be updated if you add symbols to %vfuncs
acfe0abc 830# XXX %vfuncs currently unused
c5be433b 831my %vfuncs = qw(
832 Perl_croak Perl_vcroak
833 Perl_warn Perl_vwarn
834 Perl_warner Perl_vwarner
835 Perl_die Perl_vdie
836 Perl_form Perl_vform
e4783991 837 Perl_load_module Perl_vload_module
5a844595 838 Perl_mess Perl_vmess
c5be433b 839 Perl_deb Perl_vdeb
840 Perl_newSVpvf Perl_vnewSVpvf
841 Perl_sv_setpvf Perl_sv_vsetpvf
842 Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
843 Perl_sv_catpvf Perl_sv_vcatpvf
844 Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
845 Perl_dump_indent Perl_dump_vindent
846 Perl_default_protect Perl_vdefault_protect
847);
Unnamed repository; edit this file to name it for gitweb.