This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
c981b4298d89dd3fadac85f140e660dfa0a36eb7
[perl5.git] / 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?\($pre(\w+)/) {
32             $$syms{$1} = $pre;
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 %global, 'perlvars.h','';
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 (keys %interp)
56  {
57   warn "extra $sym in interp.sym\n" 
58    unless exists $intrp{$sym} || exists $thread{$sym};
59  }
60
61 foreach my $sym (sort keys %thread)
62  {
63   warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
64   if (exists $global{$sym})
65    {
66     delete $global{$sym};
67     warn "$sym in global.sym as well as thread\n";
68    }
69  }
70
71 sub hide ($$) {
72     my ($from, $to) = @_;
73     my $t = int(length($from) / 8);
74     "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
75 }
76 sub embed ($) {
77     my ($sym) = @_;
78     hide($sym, "Perl_$sym");
79 }
80 sub multon ($$$) {
81     my ($sym,$pre,$ptr) = @_;
82     hide($sym, "($ptr->$pre$sym)");
83 }
84 sub multoff ($$) {
85     my ($sym,$pre) = @_;
86     hide("$pre$sym", $sym);
87 }
88
89 unlink 'embed.h';
90 open(EM, '> embed.h')
91     or die "Can't create embed.h: $!\n";
92
93 print EM <<'END';
94 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
95    This file is built by embed.pl from global.sym, intrpvar.h,
96    and thrdvar.h.  Any changes made here will be lost!
97 */
98
99 /* (Doing namespace management portably in C is really gross.) */
100
101 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
102     from colliding with that used by other libraries pulled in
103     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
104     override, however, to keep binary compatability with previous
105     versions of perl.
106 */
107 #ifndef NO_EMBED
108 #  define EMBED 1 
109 #endif
110
111 /* Hide global symbols? */
112
113 #ifdef EMBED
114
115 END
116
117 for $sym (sort keys %global) {
118     print EM embed($sym);
119 }
120
121 print EM <<'END';
122
123 #endif /* EMBED */
124
125 END
126
127 close(EM);
128
129 unlink 'embedvar.h';
130 open(EM, '> embedvar.h')
131     or die "Can't create embedvar.h: $!\n";
132
133 print EM <<'END';
134 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
135    This file is built by embed.pl from global.sym, intrpvar.h,
136    and thrdvar.h.  Any changes made here will be lost!
137 */
138
139 /* (Doing namespace management portably in C is really gross.) */
140
141 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
142     from colliding with that used by other libraries pulled in
143     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
144     override, however, to keep binary compatability with previous
145     versions of perl.
146 */
147
148
149 /* Put interpreter-specific symbols into a struct? */
150
151 #ifdef MULTIPLICITY
152
153 #ifndef USE_THREADS
154 /* If we do not have threads then per-thread vars are per-interpreter */
155
156 END
157
158 for $sym (sort keys %thread) {
159     print EM multon($sym,'T','curinterp');
160 }
161
162 print EM <<'END';
163
164 #endif /* !USE_THREADS */
165
166 /* These are always per-interpreter if there is more than one */
167
168 END
169
170 for $sym (sort keys %intrp) {
171     print EM multon($sym,'I','curinterp');
172 }
173
174 print EM <<'END';
175
176 #else   /* !MULTIPLICITY */
177
178 END
179
180 for $sym (sort keys %intrp) {
181     print EM multoff($sym,'I');
182 }
183
184 print EM <<'END';
185
186 #ifndef USE_THREADS
187
188 END
189
190 for $sym (sort keys %thread) {
191     print EM multoff($sym,'T');
192 }
193
194 print EM <<'END';
195
196 #endif /* USE_THREADS */
197
198 /* Hide what would have been interpreter-specific symbols? */
199
200 #ifdef EMBED
201
202 END
203
204 for $sym (sort keys %intrp) {
205     print EM embed($sym);
206 }
207
208 print EM <<'END';
209
210 #ifndef USE_THREADS
211
212 END
213
214 for $sym (sort keys %thread) {
215     print EM embed($sym);
216 }
217
218 print EM <<'END';
219
220 #endif /* USE_THREADS */
221 #endif /* EMBED */
222 #endif /* MULTIPLICITY */
223
224 /* Now same trickey for per-thread variables */
225
226 #ifdef USE_THREADS
227
228 END
229
230 for $sym (sort keys %thread) {
231     print EM multon($sym,'T','thr');
232 }
233
234 print EM <<'END';
235
236 #endif /* USE_THREADS */
237
238 END
239
240 close(EM);