OS/2 update
[p5sagit/p5-mst-13.2.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
5f05dabc 3require 5.003;
4
5sub 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
20readsyms %global, 'global.sym';
21readsyms %interp, 'interp.sym';
5f05dabc 22
d4cce5f1 23sub 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.
3fe35a81 31 if (/PERLVARI?C?\($pre(\w+)/) {
22239a37 32 $$syms{$1} = 1;
d4cce5f1 33 }
34 }
35 close(FILE);
36}
37
38my %intrp;
39my %thread;
40
41readvars %intrp, 'intrpvar.h','I';
42readvars %thread, 'thrdvar.h','T';
22239a37 43readvars %globvar, 'perlvars.h','G';
d4cce5f1 44
45foreach 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
22239a37 55foreach 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
d4cce5f1 64foreach my $sym (keys %interp)
65 {
66 warn "extra $sym in interp.sym\n"
67 unless exists $intrp{$sym} || exists $thread{$sym};
68 }
69
70foreach 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
5f05dabc 80sub 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}
85sub embed ($) {
86 my ($sym) = @_;
87 hide($sym, "Perl_$sym");
88}
d4cce5f1 89sub multon ($$$) {
90 my ($sym,$pre,$ptr) = @_;
22239a37 91 hide($sym, "($ptr$pre$sym)");
5f05dabc 92}
d4cce5f1 93sub multoff ($$) {
94 my ($sym,$pre) = @_;
95 hide("$pre$sym", $sym);
5f05dabc 96}
97
98unlink 'embed.h';
99open(EM, '> embed.h')
100 or die "Can't create embed.h: $!\n";
e50aee73 101
102print EM <<'END';
76b72cf1 103/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
d4cce5f1 104 This file is built by embed.pl from global.sym, intrpvar.h,
105 and thrdvar.h. Any changes made here will be lost!
76b72cf1 106*/
e50aee73 107
108/* (Doing namespace management portably in C is really gross.) */
109
820c3be9 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
5f05dabc 120/* Hide global symbols? */
121
e50aee73 122#ifdef EMBED
123
e50aee73 124END
125
5f05dabc 126for $sym (sort keys %global) {
dc86dda3 127 print EM embed($sym);
e50aee73 128}
129
e50aee73 130print EM <<'END';
131
132#endif /* EMBED */
133
d4cce5f1 134END
135
136close(EM);
137
138unlink 'embedvar.h';
139open(EM, '> embedvar.h')
140 or die "Can't create embedvar.h: $!\n";
141
142print 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
5f05dabc 158/* Put interpreter-specific symbols into a struct? */
e50aee73 159
160#ifdef MULTIPLICITY
161
d4cce5f1 162#ifndef USE_THREADS
163/* If we do not have threads then per-thread vars are per-interpreter */
164
e50aee73 165END
166
d4cce5f1 167for $sym (sort keys %thread) {
22239a37 168 print EM multon($sym,'T','curinterp->');
d4cce5f1 169}
170
171print EM <<'END';
172
173#endif /* !USE_THREADS */
174
175/* These are always per-interpreter if there is more than one */
176
177END
178
179for $sym (sort keys %intrp) {
22239a37 180 print EM multon($sym,'I','curinterp->');
760ac839 181}
760ac839 182
55497cff 183print EM <<'END';
184
5f05dabc 185#else /* !MULTIPLICITY */
55497cff 186
187END
760ac839 188
d4cce5f1 189for $sym (sort keys %intrp) {
190 print EM multoff($sym,'I');
e50aee73 191}
e50aee73 192
56d28764 193print EM <<'END';
194
d4cce5f1 195#ifndef USE_THREADS
196
197END
198
199for $sym (sort keys %thread) {
200 print EM multoff($sym,'T');
201}
202
203print EM <<'END';
204
205#endif /* USE_THREADS */
206
207/* Hide what would have been interpreter-specific symbols? */
5f05dabc 208
56d28764 209#ifdef EMBED
210
211END
e50aee73 212
d4cce5f1 213for $sym (sort keys %intrp) {
214 print EM embed($sym);
215}
216
217print EM <<'END';
218
219#ifndef USE_THREADS
220
221END
222
223for $sym (sort keys %thread) {
dc86dda3 224 print EM embed($sym);
5f05dabc 225}
226
227print EM <<'END';
228
d4cce5f1 229#endif /* USE_THREADS */
56d28764 230#endif /* EMBED */
e50aee73 231#endif /* MULTIPLICITY */
d4cce5f1 232
233/* Now same trickey for per-thread variables */
234
235#ifdef USE_THREADS
236
237END
238
239for $sym (sort keys %thread) {
22239a37 240 print EM multon($sym,'T','thr->');
d4cce5f1 241}
242
243print EM <<'END';
244
245#endif /* USE_THREADS */
246
22239a37 247#ifdef PERL_GLOBAL_STRUCT
248
249END
250
251for $sym (sort keys %globvar) {
252 print EM multon($sym,'G','Perl_Vars.');
253}
254
255print EM <<'END';
256
257#else /* !PERL_GLOBAL_STRUCT */
258
259END
260
261for $sym (sort keys %globvar) {
262 print EM multoff($sym,'G');
263}
264
265print EM <<'END';
266
267#ifdef EMBED
268
269END
270
271for $sym (sort keys %globvar) {
272 print EM embed($sym);
273}
274
275print EM <<'END';
276
277#endif /* EMBED */
278#endif /* PERL_GLOBAL_STRUCT */
279
e50aee73 280END
281
3fe35a81 282close(EM);