embed.pl

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