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?C?\($pre(\w+)/) {
  32             $$syms{$1} = 1;
  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 %globvar, 'perlvars.h','G';
  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 (sort keys %globvar)
  56  {
  57   if (exists $global{$sym})
  58    {
  59     delete $global{$sym};
  60     warn "$sym in global.sym as well as perlvars.h\n";
  61    }
  62  }
  63
  64 foreach my $sym (keys %interp)
  65  {
  66   warn "extra $sym in interp.sym\n"
  67    unless exists $intrp{$sym} || exists $thread{$sym};
  68  }
  69
  70 foreach my $sym (sort keys %thread)
  71  {
  72   warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
  73   if (exists $global{$sym})
  74    {
  75     delete $global{$sym};
  76     warn "$sym in global.sym as well as thread\n";
  77    }
  78  }
  79
  80 sub hide ($$) {
  81     my ($from, $to) = @_;
  82     my $t = int(length($from) / 8);
  83     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
  84 }
  85 sub embed ($) {
  86     my ($sym) = @_;
  87     hide($sym, "Perl_$sym");
  88 }
  89 sub embedvar ($) {
  90     my ($sym) = @_;
  91 #   hide($sym, "Perl_$sym");
  92     return '';
  93 }
  94
  95 sub multon ($$$) {
  96     my ($sym,$pre,$ptr) = @_;
  97     hide("PL_$sym", "($ptr$pre$sym)");
  98 }
  99 sub multoff ($$) {
 100     my ($sym,$pre) = @_;
 101     return hide("PL_$pre$sym", "PL_$sym");
 102 }
 103
 104 unlink 'embed.h';
 105 open(EM, '> embed.h')
 106     or die "Can't create embed.h: $!\n";
 107
 108 print EM <<'END';
 109 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 110    This file is built by embed.pl from global.sym, intrpvar.h,
 111    and thrdvar.h.  Any changes made here will be lost!
 112 */
 113
 114 /* (Doing namespace management portably in C is really gross.) */
 115
 116 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
 117     from colliding with that used by other libraries pulled in
 118     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
 119     override, however, to keep binary compatability with previous
 120     versions of perl.
 121 */
 122 #ifndef NO_EMBED
 123 #  define EMBED 1
 124 #endif
 125
 126 /* Hide global symbols? */
 127
 128 #ifdef EMBED
 129
 130 END
 131
 132 for $sym (sort keys %global) {
 133     print EM embed($sym);
 134 }
 135
 136 print EM <<'END';
 137
 138 #endif /* EMBED */
 139
 140 END
 141
 142 close(EM);
 143
 144 unlink 'embedvar.h';
 145 open(EM, '> embedvar.h')
 146     or die "Can't create embedvar.h: $!\n";
 147
 148 print EM <<'END';
 149 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 150    This file is built by embed.pl from global.sym, intrpvar.h,
 151    and thrdvar.h.  Any changes made here will be lost!
 152 */
 153
 154 /* (Doing namespace management portably in C is really gross.) */
 155
 156 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
 157     from colliding with that used by other libraries pulled in
 158     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
 159     override, however, to keep binary compatability with previous
 160     versions of perl.
 161 */
 162
 163
 164 /* Put interpreter-specific symbols into a struct? */
 165
 166 #ifdef MULTIPLICITY
 167
 168 #ifndef USE_THREADS
 169 /* If we do not have threads then per-thread vars are per-interpreter */
 170
 171 END
 172
 173 for $sym (sort keys %thread) {
 174     print EM multon($sym,'T','PL_curinterp->');
 175 }
 176
 177 print EM <<'END';
 178
 179 #endif /* !USE_THREADS */
 180
 181 /* These are always per-interpreter if there is more than one */
 182
 183 END
 184
 185 for $sym (sort keys %intrp) {
 186     print EM multon($sym,'I','PL_curinterp->');
 187 }
 188
 189 print EM <<'END';
 190
 191 #else   /* !MULTIPLICITY */
 192
 193 END
 194
 195 for $sym (sort keys %intrp) {
 196     print EM multoff($sym,'I');
 197 }
 198
 199 print EM <<'END';
 200
 201 #ifndef USE_THREADS
 202
 203 END
 204
 205 for $sym (sort keys %thread) {
 206     print EM multoff($sym,'T');
 207 }
 208
 209 print EM <<'END';
 210
 211 #endif /* USE_THREADS */
 212
 213 /* Hide what would have been interpreter-specific symbols? */
 214
 215 #ifdef EMBED
 216
 217 END
 218
 219 for $sym (sort keys %intrp) {
 220     print EM embedvar($sym);
 221 }
 222
 223 print EM <<'END';
 224
 225 #ifndef USE_THREADS
 226
 227 END
 228
 229 for $sym (sort keys %thread) {
 230     print EM embedvar($sym);
 231 }
 232
 233 print EM <<'END';
 234
 235 #endif /* USE_THREADS */
 236 #endif /* EMBED */
 237 #endif /* MULTIPLICITY */
 238
 239 /* Now same trickey for per-thread variables */
 240
 241 #ifdef USE_THREADS
 242
 243 END
 244
 245 for $sym (sort keys %thread) {
 246     print EM multon($sym,'T','thr->');
 247 }
 248
 249 print EM <<'END';
 250
 251 #endif /* USE_THREADS */
 252
 253 #ifdef PERL_GLOBAL_STRUCT
 254
 255 END
 256
 257 for $sym (sort keys %globvar) {
 258     print EM multon($sym,'G','PL_Vars.');
 259 }
 260
 261 print EM <<'END';
 262
 263 #else /* !PERL_GLOBAL_STRUCT */
 264
 265 END
 266
 267 for $sym (sort keys %globvar) {
 268     print EM multoff($sym,'G');
 269 }
 270
 271 print EM <<'END';
 272
 273 #ifdef EMBED
 274
 275 END
 276
 277 for $sym (sort keys %globvar) {
 278     print EM embedvar($sym);
 279 }
 280
 281 print EM <<'END';
 282
 283 #endif /* EMBED */
 284 #endif /* PERL_GLOBAL_STRUCT */
 285
 286 END
 287
 288 close(EM);