3 require 5.003; # keep this compatible, an old perl is all we may have before
7 # See database of global and static function prototypes in embed.fnc
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.
13 open IN, "embed.fnc" or die $!;
15 # walk table providing an array of components in each line to
16 # subroutine, printing the result
19 my $filename = shift || '-';
24 if (ref $filename) { # filehandle
29 open F, ">$filename" or die "Can't open $filename: $!";
32 print $F $leader if $leader;
33 seek IN, 0, 0; # so we may restart
46 @args = split /\s*\|\s*/, $_;
48 my @outs = &{$function}(@args);
49 print $F @outs; # $function->(@args) is not 5.003
51 print $F $trailer if $trailer;
52 close $F unless ref $filename;
55 sub munge_c_files () {
58 warn "\@ARGV empty, nothing to do\n";
63 $functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
68 # if (/^#\s*include\s+"perl.h"/) {
69 # my $file = uc $ARGV;
71 # print "#define PERL_IN_$file\n";
77 # if (exists $functions->{$f}) {
78 # my $flags = $functions->{$f}[0];
79 # $repl = "Perl_$repl" if $flags =~ /p/;
80 # unless ($flags =~ /n/) {
82 # $repl .= "_ " if @{$functions->{$f}} > 3;
84 # warn("$ARGV:$.:$repl\n");
88 s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))}
92 if (exists $functions->{$f}) {
94 warn("$ARGV:$.:$`#$repl#$'");
99 close ARGV if eof; # restart $.
107 my $wrote_protected = 0;
116 my ($flags,$retval,$func,@args) = @_;
117 $ret .= '/* ' if $flags =~ /m/;
119 $retval = "STATIC $retval";
123 $retval = "PERL_CALLCONV $retval";
125 $func = "Perl_$func";
128 $ret .= "$retval\t$func(";
129 unless ($flags =~ /n/) {
131 $ret .= "_ " if @args;
134 $ret .= join ", ", @args;
137 $ret .= "void" if $flags =~ /n/;
140 $ret .= " __attribute__((noreturn))" if $flags =~ /r/;
141 if( $flags =~ /f/ ) {
142 my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
143 my $args = scalar @args;
144 $ret .= "\n#ifdef CHECK_FORMAT\n";
145 $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
146 $prefix, $args - 1, $prefix, $args;
147 $ret .= "\n#endif\n";
150 $ret .= ' */' if $flags =~ /m/;
156 # generates global.sym (API export list), and populates %global with global symbols
157 sub write_global_sym {
160 my ($flags,$retval,$func,@args) = @_;
161 if ($flags =~ /A/ && $flags !~ /[xm]/) { # public API, so export
162 $func = "Perl_$func" if $flags =~ /p/;
170 walk_table(\&write_protos, 'proto.h', <<'EOT');
174 * Copyright (c) 1997-2002, Larry Wall
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.
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.
186 walk_table(\&write_global_sym, 'global.sym', <<'EOT');
190 # Copyright (c) 1997-2002, Larry Wall
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.
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.
202 # XXX others that may need adding
206 my @extvars = qw(sv_undef sv_yes sv_no na dowarn
208 tainting tainted stack_base stack_sp sv_arenaroot
210 curstash DBsub DBsingle debstash
224 my ($syms, $file) = @_;
226 open(FILE, "< $file")
227 or die "embed.pl: Can't open $file: $!\n";
229 s/[ \t]*#.*//; # Delete comments.
230 if (/^\s*(\S+)\s*$/) {
232 warn "duplicate symbol $sym while processing $file\n"
233 if exists $$syms{$sym};
240 # Perl_pp_* and Perl_ck_* are in pp.sym
241 readsyms my %ppsym, 'pp.sym';
243 sub readvars(\%$$@) {
244 my ($syms, $file,$pre,$keep_pre) = @_;
246 open(FILE, "< $file")
247 or die "embed.pl: Can't open $file: $!\n";
249 s/[ \t]*#.*//; # Delete comments.
250 if (/PERLVARA?I?C?\($pre(\w+)/) {
252 $sym = $pre . $sym if $keep_pre;
253 warn "duplicate symbol $sym while processing $file\n"
254 if exists $$syms{$sym};
255 $$syms{$sym} = $pre || 1;
264 readvars %intrp, 'intrpvar.h','I';
265 readvars %thread, 'thrdvar.h','T';
266 readvars %globvar, 'perlvars.h','G';
269 foreach $sym (sort keys %thread) {
270 warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
279 my ($from, $to) = @_;
280 my $t = int(length($from) / 8);
281 "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
284 sub bincompat_var ($$) {
285 my ($pfx, $sym) = @_;
286 my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX');
287 undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
291 my ($sym,$pre,$ptr) = @_;
292 hide("PL_$sym", "($ptr$pre$sym)");
297 return hide("PL_$pre$sym", "PL_$sym");
301 open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
307 * Copyright (c) 1997-2002, Larry Wall
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.
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!
317 /* (Doing namespace management portably in C is really gross.) */
319 /* NO_EMBED is no longer supported. i.e. EMBED is always active. */
321 /* Hide global symbols */
323 #if !defined(PERL_IMPLICIT_CONTEXT)
331 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
334 my ($flags,$retval,$func,@args) = @_;
335 unless ($flags =~ /[om]/) {
337 $ret .= hide($func,"S_$func");
339 elsif ($flags =~ /p/) {
340 $ret .= hide($func,"Perl_$func");
347 for $sym (sort keys %ppsym) {
349 print EM hide($sym, "Perl_$sym");
354 #else /* PERL_IMPLICIT_CONTEXT */
364 $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
367 my ($flags,$retval,$func,@args) = @_;
368 unless ($flags =~ /[om]/) {
369 my $args = scalar @args;
370 if ($args and $args[$args-1] =~ /\.\.\./) {
371 # we're out of luck for varargs functions under CPP
373 elsif ($flags =~ /n/) {
375 $ret .= hide($func,"S_$func");
377 elsif ($flags =~ /p/) {
378 $ret .= hide($func,"Perl_$func");
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);
387 $ret .= "S_$func(aTHX";
389 elsif ($flags =~ /p/) {
390 $ret .= "Perl_$func(aTHX";
392 $ret .= "_ " if $alist;
393 $ret .= $alist . ")\n";
400 for $sym (sort keys %ppsym) {
402 if ($sym =~ /^ck_/) {
403 print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
405 elsif ($sym =~ /^pp_/) {
406 print EM hide("$sym()", "Perl_$sym(aTHX)");
409 warn "Illegal symbol '$sym' in pp.sym";
415 #endif /* PERL_IMPLICIT_CONTEXT */
421 /* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
425 #if !defined(PERL_CORE)
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))
430 #if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
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.
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)
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
461 #if defined(PERL_IMPLICIT_CONTEXT)
462 # define croak Perl_croak_nocontext
463 # define deb Perl_deb_nocontext
464 # define die Perl_die_nocontext
465 # define form Perl_form_nocontext
466 # define load_module Perl_load_module_nocontext
467 # define mess Perl_mess_nocontext
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
472 # define warner Perl_warner_nocontext
473 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
474 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
477 #endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
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
483 # define Perl_deb_nocontext Perl_deb
484 # define Perl_form_nocontext Perl_form
485 # define Perl_load_module_nocontext Perl_load_module
486 # define Perl_mess_nocontext Perl_mess
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
490 # define Perl_warn_nocontext Perl_warn
491 # define Perl_warner_nocontext Perl_warner
492 # define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
493 # define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
501 open(EM, '> embedvar.h')
502 or die "Can't create embedvar.h: $!\n";
508 * Copyright (c) 1997-2002, Larry Wall
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.
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!
519 /* (Doing namespace management portably in C is really gross.) */
522 The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
525 2) MULTIPLICITY # supported for compatibility
526 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
528 All other combinations of these flags are errors.
530 only #3 is supported directly, while #2 is a special
531 case of #3 (supported by redefining vTHX appropriately).
534 #if defined(MULTIPLICITY)
535 /* cases 2 and 3 above */
537 # if defined(PERL_IMPLICIT_CONTEXT)
540 # define vTHX PERL_GET_INTERP
545 for $sym (sort keys %thread) {
546 print EM multon($sym,'T','vTHX->');
551 /* cases 2 and 3 above */
555 for $sym (sort keys %intrp) {
556 print EM multon($sym,'I','vTHX->');
561 #else /* !MULTIPLICITY */
567 for $sym (sort keys %intrp) {
568 print EM multoff($sym,'I');
575 for $sym (sort keys %thread) {
576 print EM multoff($sym,'T');
581 #endif /* MULTIPLICITY */
583 #if defined(PERL_GLOBAL_STRUCT)
587 for $sym (sort keys %globvar) {
588 print EM multon($sym,'G','PL_Vars.');
593 #else /* !PERL_GLOBAL_STRUCT */
597 for $sym (sort keys %globvar) {
598 print EM multoff($sym,'G');
603 #endif /* PERL_GLOBAL_STRUCT */
605 #ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
609 for $sym (sort @extvars) {
610 print EM hide($sym,"PL_$sym");
615 #endif /* PERL_POLLUTE */
622 open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
623 open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
629 * Copyright (c) 1997-2002, Larry Wall
631 * You may distribute under the terms of either the GNU General Public
632 * License or the Artistic License, as specified in the README file.
635 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
636 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
637 * perlvars.h and thrdvar.h. Any changes made here will be lost!
640 /* declare accessor functions for Perl variables */
641 #ifndef __perlapi_h__
642 #define __perlapi_h__
644 #if defined (MULTIPLICITY)
652 #define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
653 #define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
654 EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
655 #define PERLVARI(v,t,i) PERLVAR(v,t)
656 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
659 #include "intrpvar.h"
660 #include "perlvars.h"
669 #if defined(PERL_CORE)
671 /* accessor functions for Perl variables (provide binary compatibility) */
673 /* these need to be mentioned here, or most linkers won't put them in
674 the perl executable */
676 #ifndef PERL_NO_FORCE_LINK
681 EXT void *PL_force_link_funcs[];
683 EXT void *PL_force_link_funcs[] = {
688 #define PERLVAR(v,t) (void*)Perl_##v##_ptr,
689 #define PERLVARA(v,n,t) PERLVAR(v,t)
690 #define PERLVARI(v,t,i) PERLVAR(v,t)
691 #define PERLVARIC(v,t,i) PERLVAR(v,t)
694 #include "intrpvar.h"
695 #include "perlvars.h"
706 #endif /* PERL_NO_FORCE_LINK */
708 #else /* !PERL_CORE */
712 foreach $sym (sort keys %intrp) {
713 print CAPIH bincompat_var('I',$sym);
716 foreach $sym (sort keys %thread) {
717 print CAPIH bincompat_var('T',$sym);
720 foreach $sym (sort keys %globvar) {
721 print CAPIH bincompat_var('G',$sym);
726 #endif /* !PERL_CORE */
727 #endif /* MULTIPLICITY */
729 #endif /* __perlapi_h__ */
738 * Copyright (c) 1997-2002, Larry Wall
740 * You may distribute under the terms of either the GNU General Public
741 * License or the Artistic License, as specified in the README file.
744 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
745 * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
746 * perlvars.h and thrdvar.h. Any changes made here will be lost!
753 #if defined (MULTIPLICITY)
755 /* accessor functions for Perl variables (provides binary compatibility) */
763 #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
764 { return &(aTHX->v); }
765 #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
766 { return &(aTHX->v); }
768 #define PERLVARI(v,t,i) PERLVAR(v,t)
769 #define PERLVARIC(v,t,i) PERLVAR(v, const t)
772 #include "intrpvar.h"
776 #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
777 { return &(PL_##v); }
778 #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
779 { return &(PL_##v); }
781 #define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
782 { return (const t *)&(PL_##v); }
783 #include "perlvars.h"
792 #endif /* MULTIPLICITY */
797 # functions that take va_list* for implementing vararg functions
798 # NOTE: makedef.pl must be updated if you add symbols to %vfuncs
799 # XXX %vfuncs currently unused
801 Perl_croak Perl_vcroak
803 Perl_warner Perl_vwarner
806 Perl_load_module Perl_vload_module
809 Perl_newSVpvf Perl_vnewSVpvf
810 Perl_sv_setpvf Perl_sv_vsetpvf
811 Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
812 Perl_sv_catpvf Perl_sv_vcatpvf
813 Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
814 Perl_dump_indent Perl_dump_vindent
815 Perl_default_protect Perl_vdefault_protect