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