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