embed.pl

   1 #!/usr/bin/perl -w
   2
   3 require 5.003;
   4
   5 my @extvars = qw(sv_undef sv_yes sv_no na dowarn
   6                  curcop compiling
   7                  tainting tainted stack_base stack_sp sv_arenaroot
   8                  curstash DBsub DBsingle debstash
   9                  rsfp
  10                  stdingv
  11                  defgv
  12                  errgv
  13                  rsfp_filters
  14                  perldb
  15                 );
  16
  17 sub readsyms (\%$) {
  18     my ($syms, $file) = @_;
  19     %$syms = ();
  20     local (*FILE, $_);
  21     open(FILE, "< $file")
  22         or die "embed.pl: Can't open $file: $!\n";
  23     while (<FILE>) {
  24         s/[ \t]*#.*//;          # Delete comments.
  25         if (/^\s*(\S+)\s*$/) {
  26             $$syms{$1} = 1;
  27         }
  28     }
  29     close(FILE);
  30 }
  31
  32 readsyms %global, 'global.sym';
  33 readsyms %interp, 'interp.sym';
  34
  35 sub readvars(\%$$) {
  36     my ($syms, $file,$pre) = @_;
  37     %$syms = ();
  38     local (*FILE, $_);
  39     open(FILE, "< $file")
  40         or die "embed.pl: Can't open $file: $!\n";
  41     while (<FILE>) {
  42         s/[ \t]*#.*//;          # Delete comments.
  43         if (/PERLVARI?C?\($pre(\w+)/) {
  44             $$syms{$1} = 1;
  45         }
  46     }
  47     close(FILE);
  48 }
  49
  50 my %intrp;
  51 my %thread;
  52
  53 readvars %intrp,  'intrpvar.h','I';
  54 readvars %thread, 'thrdvar.h','T';
  55 readvars %globvar, 'perlvars.h','G';
  56
  57 foreach my $sym (sort keys %intrp)
  58  {
  59   warn "$sym not in interp.sym\n" unless exists $interp{$sym};
  60   if (exists $global{$sym})
  61    {
  62     delete $global{$sym};
  63     warn "$sym in global.sym as well as interp\n";
  64    }
  65  }
  66
  67 foreach my $sym (sort keys %globvar)
  68  {
  69   if (exists $global{$sym})
  70    {
  71     delete $global{$sym};
  72     warn "$sym in global.sym as well as perlvars.h\n";
  73    }
  74  }
  75
  76 foreach my $sym (keys %interp)
  77  {
  78   warn "extra $sym in interp.sym\n"
  79    unless exists $intrp{$sym} || exists $thread{$sym};
  80  }
  81
  82 foreach my $sym (sort keys %thread)
  83  {
  84   warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
  85   if (exists $global{$sym})
  86    {
  87     delete $global{$sym};
  88     warn "$sym in global.sym as well as thread\n";
  89    }
  90  }
  91
  92 sub hide ($$) {
  93     my ($from, $to) = @_;
  94     my $t = int(length($from) / 8);
  95     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
  96 }
  97 sub embed ($) {
  98     my ($sym) = @_;
  99     hide($sym, "Perl_$sym");
 100 }
 101 sub embedvar ($) {
 102     my ($sym) = @_;
 103 #   hide($sym, "Perl_$sym");
 104     return '';
 105 }
 106
 107 sub multon ($$$) {
 108     my ($sym,$pre,$ptr) = @_;
 109     hide("PL_$sym", "($ptr$pre$sym)");
 110 }
 111 sub multoff ($$) {
 112     my ($sym,$pre) = @_;
 113     return hide("PL_$pre$sym", "PL_$sym");
 114 }
 115
 116 unlink 'embed.h';
 117 open(EM, '> embed.h')
 118     or die "Can't create embed.h: $!\n";
 119
 120 print EM <<'END';
 121 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 122    This file is built by embed.pl from global.sym, intrpvar.h,
 123    and thrdvar.h.  Any changes made here will be lost!
 124 */
 125
 126 /* (Doing namespace management portably in C is really gross.) */
 127
 128 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
 129     from colliding with that used by other libraries pulled in
 130     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
 131     override, however, to keep binary compatability with previous
 132     versions of perl.
 133 */
 134 #ifndef NO_EMBED
 135 #  define EMBED 1
 136 #endif
 137
 138 /* Hide global symbols? */
 139
 140 #ifdef EMBED
 141
 142 END
 143
 144 for $sym (sort keys %global) {
 145     print EM embed($sym);
 146 }
 147
 148 print EM <<'END';
 149
 150 #endif /* EMBED */
 151
 152 END
 153
 154 close(EM);
 155
 156 unlink 'embedvar.h';
 157 open(EM, '> embedvar.h')
 158     or die "Can't create embedvar.h: $!\n";
 159
 160 print EM <<'END';
 161 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 162    This file is built by embed.pl from global.sym, intrpvar.h,
 163    and thrdvar.h.  Any changes made here will be lost!
 164 */
 165
 166 /* (Doing namespace management portably in C is really gross.) */
 167
 168 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
 169     from colliding with that used by other libraries pulled in
 170     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
 171     override, however, to keep binary compatability with previous
 172     versions of perl.
 173 */
 174
 175
 176 /* Put interpreter-specific symbols into a struct? */
 177
 178 #ifdef MULTIPLICITY
 179
 180 #ifndef USE_THREADS
 181 /* If we do not have threads then per-thread vars are per-interpreter */
 182
 183 END
 184
 185 for $sym (sort keys %thread) {
 186     print EM multon($sym,'T','PL_curinterp->');
 187 }
 188
 189 print EM <<'END';
 190
 191 #endif /* !USE_THREADS */
 192
 193 /* These are always per-interpreter if there is more than one */
 194
 195 END
 196
 197 for $sym (sort keys %intrp) {
 198     print EM multon($sym,'I','PL_curinterp->');
 199 }
 200
 201 print EM <<'END';
 202
 203 #else   /* !MULTIPLICITY */
 204
 205 END
 206
 207 for $sym (sort keys %intrp) {
 208     print EM multoff($sym,'I');
 209 }
 210
 211 print EM <<'END';
 212
 213 #ifndef USE_THREADS
 214
 215 END
 216
 217 for $sym (sort keys %thread) {
 218     print EM multoff($sym,'T');
 219 }
 220
 221 print EM <<'END';
 222
 223 #endif /* USE_THREADS */
 224
 225 /* Hide what would have been interpreter-specific symbols? */
 226
 227 #ifdef EMBED
 228
 229 END
 230
 231 for $sym (sort keys %intrp) {
 232     print EM embedvar($sym);
 233 }
 234
 235 print EM <<'END';
 236
 237 #ifndef USE_THREADS
 238
 239 END
 240
 241 for $sym (sort keys %thread) {
 242     print EM embedvar($sym);
 243 }
 244
 245 print EM <<'END';
 246
 247 #endif /* USE_THREADS */
 248 #endif /* EMBED */
 249 #endif /* MULTIPLICITY */
 250
 251 /* Now same trickey for per-thread variables */
 252
 253 #ifdef USE_THREADS
 254
 255 END
 256
 257 for $sym (sort keys %thread) {
 258     print EM multon($sym,'T','thr->');
 259 }
 260
 261 print EM <<'END';
 262
 263 #endif /* USE_THREADS */
 264
 265 #ifdef PERL_GLOBAL_STRUCT
 266
 267 END
 268
 269 for $sym (sort keys %globvar) {
 270     print EM multon($sym,'G','PL_Vars.');
 271 }
 272
 273 print EM <<'END';
 274
 275 #else /* !PERL_GLOBAL_STRUCT */
 276
 277 END
 278
 279 for $sym (sort keys %globvar) {
 280     print EM multoff($sym,'G');
 281 }
 282
 283 print EM <<'END';
 284
 285 #ifdef EMBED
 286
 287 END
 288
 289 for $sym (sort keys %globvar) {
 290     print EM embedvar($sym);
 291 }
 292
 293 print EM <<'END';
 294
 295 #endif /* EMBED */
 296 #endif /* PERL_GLOBAL_STRUCT */
 297
 298 END
 299
 300 print EM <<'END';
 301
 302 #ifndef MIN_PERL_DEFINE
 303
 304 END
 305
 306 for $sym (sort @extvars) {
 307     print EM hide($sym,"PL_$sym");
 308 }
 309
 310 print EM <<'END';
 311
 312 #endif /* MIN_PERL_DEFINE */
 313 END
 314
 315
 316 close(EM);