embed.pl

   1 #!/usr/bin/perl -w
   2
   3 require 5.003;
   4
   5 sub readsyms (\%$) {
   6     my ($syms, $file) = @_;
   7     %$syms = ();
   8     local (*FILE, $_);
   9     open(FILE, "< $file")
  10         or die "embed.pl: Can't open $file: $!\n";
  11     while (<FILE>) {
  12         s/[ \t]*#.*//;          # Delete comments.
  13         if (/^\s*(\S+)\s*$/) {
  14             $$syms{$1} = 1;
  15         }
  16     }
  17     close(FILE);
  18 }
  19
  20 readsyms %global, 'global.sym';
  21 readsyms %interp, 'interp.sym';
  22
  23 sub hide ($$) {
  24     my ($from, $to) = @_;
  25     my $t = int(length($from) / 8);
  26     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
  27 }
  28 sub embed ($) {
  29     my ($sym) = @_;
  30     hide($sym, "Perl_$sym");
  31 }
  32 sub multon ($) {
  33     my ($sym) = @_;
  34     hide($sym, "(curinterp->I$sym)");
  35 }
  36 sub multoff ($) {
  37     my ($sym) = @_;
  38     hide("I$sym", $sym);
  39 }
  40
  41 unlink 'embed.h';
  42 open(EM, '> embed.h')
  43     or die "Can't create embed.h: $!\n";
  44
  45 print EM <<'END';
  46 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  47    This file is built by embed.pl from global.sym and interp.sym.
  48    Any changes made here will be lost!
  49 */
  50
  51 /* (Doing namespace management portably in C is really gross.) */
  52
  53 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
  54     from colliding with that used by other libraries pulled in
  55     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
  56     override, however, to keep binary compatability with previous
  57     versions of perl.
  58 */
  59 #ifndef NO_EMBED
  60 #  define EMBED 1
  61 #endif
  62
  63 /* Hide global symbols? */
  64
  65 #ifdef EMBED
  66
  67 END
  68
  69 for $sym (sort keys %global) {
  70     print EM embed($sym);
  71 }
  72
  73
  74 print EM <<'END';
  75
  76 #endif /* EMBED */
  77
  78 /* Put interpreter-specific symbols into a struct? */
  79
  80 #ifdef MULTIPLICITY
  81
  82 END
  83
  84 for $sym (sort keys %interp) {
  85     print EM multon($sym);
  86 }
  87
  88 print EM <<'END';
  89
  90 #else   /* !MULTIPLICITY */
  91
  92 END
  93
  94 for $sym (sort keys %interp) {
  95     print EM multoff($sym);
  96 }
  97
  98 print EM <<'END';
  99
 100 /* Hide interpreter-specific symbols? */
 101
 102 #ifdef EMBED
 103
 104 END
 105
 106 for $sym (sort keys %interp) {
 107     print EM embed($sym);
 108 }
 109
 110 print EM <<'END';
 111
 112 #endif /* EMBED */
 113 #endif /* MULTIPLICITY */
 114 END
 115