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 readvars(\%$$) {
  24     my ($syms, $file,$pre) = @_;
  25     %$syms = ();
  26     local (*FILE, $_);
  27     open(FILE, "< $file")
  28         or die "embed.pl: Can't open $file: $!\n";
  29     while (<FILE>) {
  30         s/[ \t]*#.*//;          # Delete comments.
  31         if (/PERLVARI?\($pre(\w+)/) {
  32             $$syms{$1} = $pre;
  33         }
  34     }
  35     close(FILE);
  36 }
  37
  38 my %intrp;
  39 my %thread;
  40
  41 readvars %intrp,  'intrpvar.h','I';
  42 readvars %thread, 'thrdvar.h','T';
  43 #readvars %global, 'perlvars.h','';
  44
  45 foreach my $sym (sort keys %intrp)
  46  {
  47   warn "$sym not in interp.sym\n" unless exists $interp{$sym};
  48   if (exists $global{$sym})
  49    {
  50     delete $global{$sym};
  51     warn "$sym in global.sym as well as interp\n";
  52    }
  53  }
  54
  55 foreach my $sym (keys %interp)
  56  {
  57   warn "extra $sym in interp.sym\n"
  58    unless exists $intrp{$sym} || exists $thread{$sym};
  59  }
  60
  61 foreach my $sym (sort keys %thread)
  62  {
  63   warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
  64   if (exists $global{$sym})
  65    {
  66     delete $global{$sym};
  67     warn "$sym in global.sym as well as thread\n";
  68    }
  69  }
  70
  71 sub hide ($$) {
  72     my ($from, $to) = @_;
  73     my $t = int(length($from) / 8);
  74     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
  75 }
  76 sub embed ($) {
  77     my ($sym) = @_;
  78     hide($sym, "Perl_$sym");
  79 }
  80 sub multon ($$$) {
  81     my ($sym,$pre,$ptr) = @_;
  82     hide($sym, "($ptr->$pre$sym)");
  83 }
  84 sub multoff ($$) {
  85     my ($sym,$pre) = @_;
  86     hide("$pre$sym", $sym);
  87 }
  88
  89 unlink 'embed.h';
  90 open(EM, '> embed.h')
  91     or die "Can't create embed.h: $!\n";
  92
  93 print EM <<'END';
  94 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  95    This file is built by embed.pl from global.sym, intrpvar.h,
  96    and thrdvar.h.  Any changes made here will be lost!
  97 */
  98
  99 /* (Doing namespace management portably in C is really gross.) */
 100
 101 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
 102     from colliding with that used by other libraries pulled in
 103     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
 104     override, however, to keep binary compatability with previous
 105     versions of perl.
 106 */
 107 #ifndef NO_EMBED
 108 #  define EMBED 1
 109 #endif
 110
 111 /* Hide global symbols? */
 112
 113 #ifdef EMBED
 114
 115 END
 116
 117 for $sym (sort keys %global) {
 118     print EM embed($sym);
 119 }
 120
 121 print EM <<'END';
 122
 123 #endif /* EMBED */
 124
 125 END
 126
 127 close(EM);
 128
 129 unlink 'embedvar.h';
 130 open(EM, '> embedvar.h')
 131     or die "Can't create embedvar.h: $!\n";
 132
 133 print EM <<'END';
 134 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 135    This file is built by embed.pl from global.sym, intrpvar.h,
 136    and thrdvar.h.  Any changes made here will be lost!
 137 */
 138
 139 /* (Doing namespace management portably in C is really gross.) */
 140
 141 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
 142     from colliding with that used by other libraries pulled in
 143     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
 144     override, however, to keep binary compatability with previous
 145     versions of perl.
 146 */
 147
 148
 149 /* Put interpreter-specific symbols into a struct? */
 150
 151 #ifdef MULTIPLICITY
 152
 153 #ifndef USE_THREADS
 154 /* If we do not have threads then per-thread vars are per-interpreter */
 155
 156 END
 157
 158 for $sym (sort keys %thread) {
 159     print EM multon($sym,'T','curinterp');
 160 }
 161
 162 print EM <<'END';
 163
 164 #endif /* !USE_THREADS */
 165
 166 /* These are always per-interpreter if there is more than one */
 167
 168 END
 169
 170 for $sym (sort keys %intrp) {
 171     print EM multon($sym,'I','curinterp');
 172 }
 173
 174 print EM <<'END';
 175
 176 #else   /* !MULTIPLICITY */
 177
 178 END
 179
 180 for $sym (sort keys %intrp) {
 181     print EM multoff($sym,'I');
 182 }
 183
 184 print EM <<'END';
 185
 186 #ifndef USE_THREADS
 187
 188 END
 189
 190 for $sym (sort keys %thread) {
 191     print EM multoff($sym,'T');
 192 }
 193
 194 print EM <<'END';
 195
 196 #endif /* USE_THREADS */
 197
 198 /* Hide what would have been interpreter-specific symbols? */
 199
 200 #ifdef EMBED
 201
 202 END
 203
 204 for $sym (sort keys %intrp) {
 205     print EM embed($sym);
 206 }
 207
 208 print EM <<'END';
 209
 210 #ifndef USE_THREADS
 211
 212 END
 213
 214 for $sym (sort keys %thread) {
 215     print EM embed($sym);
 216 }
 217
 218 print EM <<'END';
 219
 220 #endif /* USE_THREADS */
 221 #endif /* EMBED */
 222 #endif /* MULTIPLICITY */
 223
 224 /* Now same trickey for per-thread variables */
 225
 226 #ifdef USE_THREADS
 227
 228 END
 229
 230 for $sym (sort keys %thread) {
 231     print EM multon($sym,'T','thr');
 232 }
 233
 234 print EM <<'END';
 235
 236 #endif /* USE_THREADS */
 237
 238 END
 239
 240 close(EM);