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
  41 sub readvars(\%$$) {
  42     my ($syms, $file,$pre) = @_;
  43     %$syms = ();
  44     local (*FILE, $_);
  45     open(FILE, "< $file")
  46         or die "embed.pl: Can't open $file: $!\n";
  47     while (<FILE>) {
  48         s/[ \t]*#.*//;          # Delete comments.
  49         if (/PERLVARI?C?\($pre(\w+)/) {
  50             $$syms{$1} = 1;
  51         }
  52     }
  53     close(FILE);
  54 }
  55
  56 my %intrp;
  57 my %thread;
  58
  59 readvars %intrp,  'intrpvar.h','I';
  60 readvars %thread, 'thrdvar.h','T';
  61 readvars %globvar, 'perlvars.h','G';
  62
  63 foreach my $sym (sort keys %intrp)
  64  {
  65   warn "$sym not in interp.sym\n" unless exists $interp{$sym};
  66   if (exists $global{$sym})
  67    {
  68     delete $global{$sym};
  69     warn "$sym in global.sym as well as interp\n";
  70    }
  71  }
  72
  73 foreach my $sym (sort keys %globvar)
  74  {
  75   if (exists $global{$sym})
  76    {
  77     delete $global{$sym};
  78     warn "$sym in global.sym as well as perlvars.h\n";
  79    }
  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);