Commit | Line | Data |
5f05dabc |
1 | #!/usr/bin/perl -w |
e50aee73 |
2 | |
5f05dabc |
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'; |
5f05dabc |
22 | |
d4cce5f1 |
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 | |
5f05dabc |
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 | } |
d4cce5f1 |
80 | sub multon ($$$) { |
81 | my ($sym,$pre,$ptr) = @_; |
82 | hide($sym, "($ptr->$pre$sym)"); |
5f05dabc |
83 | } |
d4cce5f1 |
84 | sub multoff ($$) { |
85 | my ($sym,$pre) = @_; |
86 | hide("$pre$sym", $sym); |
5f05dabc |
87 | } |
88 | |
89 | unlink 'embed.h'; |
90 | open(EM, '> embed.h') |
91 | or die "Can't create embed.h: $!\n"; |
e50aee73 |
92 | |
93 | print EM <<'END'; |
76b72cf1 |
94 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
d4cce5f1 |
95 | This file is built by embed.pl from global.sym, intrpvar.h, |
96 | and thrdvar.h. Any changes made here will be lost! |
76b72cf1 |
97 | */ |
e50aee73 |
98 | |
99 | /* (Doing namespace management portably in C is really gross.) */ |
100 | |
820c3be9 |
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 | |
5f05dabc |
111 | /* Hide global symbols? */ |
112 | |
e50aee73 |
113 | #ifdef EMBED |
114 | |
e50aee73 |
115 | END |
116 | |
5f05dabc |
117 | for $sym (sort keys %global) { |
dc86dda3 |
118 | print EM embed($sym); |
e50aee73 |
119 | } |
120 | |
e50aee73 |
121 | print EM <<'END'; |
122 | |
123 | #endif /* EMBED */ |
124 | |
d4cce5f1 |
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 | |
5f05dabc |
149 | /* Put interpreter-specific symbols into a struct? */ |
e50aee73 |
150 | |
151 | #ifdef MULTIPLICITY |
152 | |
d4cce5f1 |
153 | #ifndef USE_THREADS |
154 | /* If we do not have threads then per-thread vars are per-interpreter */ |
155 | |
e50aee73 |
156 | END |
157 | |
d4cce5f1 |
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'); |
760ac839 |
172 | } |
760ac839 |
173 | |
55497cff |
174 | print EM <<'END'; |
175 | |
5f05dabc |
176 | #else /* !MULTIPLICITY */ |
55497cff |
177 | |
178 | END |
760ac839 |
179 | |
d4cce5f1 |
180 | for $sym (sort keys %intrp) { |
181 | print EM multoff($sym,'I'); |
e50aee73 |
182 | } |
e50aee73 |
183 | |
56d28764 |
184 | print EM <<'END'; |
185 | |
d4cce5f1 |
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? */ |
5f05dabc |
199 | |
56d28764 |
200 | #ifdef EMBED |
201 | |
202 | END |
e50aee73 |
203 | |
d4cce5f1 |
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) { |
dc86dda3 |
215 | print EM embed($sym); |
5f05dabc |
216 | } |
217 | |
218 | print EM <<'END'; |
219 | |
d4cce5f1 |
220 | #endif /* USE_THREADS */ |
56d28764 |
221 | #endif /* EMBED */ |
e50aee73 |
222 | #endif /* MULTIPLICITY */ |
d4cce5f1 |
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 | |
e50aee73 |
238 | END |
239 | |
d4cce5f1 |
240 | close(EM); |