diff options
Diffstat (limited to 'embed.pl')
-rwxr-xr-x | embed.pl | 155 |
1 files changed, 140 insertions, 15 deletions
@@ -20,6 +20,54 @@ sub readsyms (\%$) { readsyms %global, 'global.sym'; readsyms %interp, 'interp.sym'; +sub readvars(\%$$) { + my ($syms, $file,$pre) = @_; + %$syms = (); + local (*FILE, $_); + open(FILE, "< $file") + or die "embed.pl: Can't open $file: $!\n"; + while (<FILE>) { + s/[ \t]*#.*//; # Delete comments. + if (/PERLVARI?\($pre(\w+)/) { + $$syms{$1} = $pre; + } + } + close(FILE); +} + +my %intrp; +my %thread; + +readvars %intrp, 'intrpvar.h','I'; +readvars %thread, 'thrdvar.h','T'; +#readvars %global, 'perlvars.h',''; + +foreach my $sym (sort keys %intrp) + { + warn "$sym not in interp.sym\n" unless exists $interp{$sym}; + if (exists $global{$sym}) + { + delete $global{$sym}; + warn "$sym in global.sym as well as interp\n"; + } + } + +foreach my $sym (keys %interp) + { + warn "extra $sym in interp.sym\n" + unless exists $intrp{$sym} || exists $thread{$sym}; + } + +foreach my $sym (sort keys %thread) + { + warn "$sym in intrpvar.h\n" if exists $intrp{$sym}; + if (exists $global{$sym}) + { + delete $global{$sym}; + warn "$sym in global.sym as well as thread\n"; + } + } + sub hide ($$) { my ($from, $to) = @_; my $t = int(length($from) / 8); @@ -29,13 +77,13 @@ sub embed ($) { my ($sym) = @_; hide($sym, "Perl_$sym"); } -sub multon ($) { - my ($sym) = @_; - hide($sym, "(curinterp->I$sym)"); +sub multon ($$$) { + my ($sym,$pre,$ptr) = @_; + hide($sym, "($ptr->$pre$sym)"); } -sub multoff ($) { - my ($sym) = @_; - hide("I$sym", $sym); +sub multoff ($$) { + my ($sym,$pre) = @_; + hide("$pre$sym", $sym); } unlink 'embed.h'; @@ -44,8 +92,8 @@ open(EM, '> embed.h') print EM <<'END'; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by embed.pl from global.sym and interp.sym. - Any changes made here will be lost! + This file is built by embed.pl from global.sym, intrpvar.h, + and thrdvar.h. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ @@ -70,19 +118,57 @@ for $sym (sort keys %global) { print EM embed($sym); } - print EM <<'END'; #endif /* EMBED */ +END + +close(EM); + +unlink 'embedvar.h'; +open(EM, '> embedvar.h') + or die "Can't create embedvar.h: $!\n"; + +print EM <<'END'; +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + This file is built by embed.pl from global.sym, intrpvar.h, + and thrdvar.h. Any changes made here will be lost! +*/ + +/* (Doing namespace management portably in C is really gross.) */ + +/* EMBED has no run-time penalty, but helps keep the Perl namespace + from colliding with that used by other libraries pulled in + by extensions or by embedding perl. Allow a cc -DNO_EMBED + override, however, to keep binary compatability with previous + versions of perl. +*/ + + /* Put interpreter-specific symbols into a struct? */ #ifdef MULTIPLICITY +#ifndef USE_THREADS +/* If we do not have threads then per-thread vars are per-interpreter */ + END -for $sym (sort keys %interp) { - print EM multon($sym); +for $sym (sort keys %thread) { + print EM multon($sym,'T','curinterp'); +} + +print EM <<'END'; + +#endif /* !USE_THREADS */ + +/* These are always per-interpreter if there is more than one */ + +END + +for $sym (sort keys %intrp) { + print EM multon($sym,'I','curinterp'); } print EM <<'END'; @@ -91,25 +177,64 @@ print EM <<'END'; END -for $sym (sort keys %interp) { - print EM multoff($sym); +for $sym (sort keys %intrp) { + print EM multoff($sym,'I'); } print EM <<'END'; -/* Hide interpreter-specific symbols? */ +#ifndef USE_THREADS + +END + +for $sym (sort keys %thread) { + print EM multoff($sym,'T'); +} + +print EM <<'END'; + +#endif /* USE_THREADS */ + +/* Hide what would have been interpreter-specific symbols? */ #ifdef EMBED END -for $sym (sort keys %interp) { +for $sym (sort keys %intrp) { + print EM embed($sym); +} + +print EM <<'END'; + +#ifndef USE_THREADS + +END + +for $sym (sort keys %thread) { print EM embed($sym); } print EM <<'END'; +#endif /* USE_THREADS */ #endif /* EMBED */ #endif /* MULTIPLICITY */ + +/* Now same trickey for per-thread variables */ + +#ifdef USE_THREADS + +END + +for $sym (sort keys %thread) { + print EM multon($sym,'T','thr'); +} + +print EM <<'END'; + +#endif /* USE_THREADS */ + END +close(EM);
\ No newline at end of file |