This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixup exports in non -DDEBUGGING case
[perl5.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
5f05dabc
PP
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
NIS
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.
31 if (/PERLVARI?\($pre(\w+)/) {
32 $$syms{$1} = $pre;
33 }
34 }
35 close(FILE);
36}
37
38my %intrp;
39my %thread;
40
41readvars %intrp, 'intrpvar.h','I';
42readvars %thread, 'thrdvar.h','T';
43#readvars %global, 'perlvars.h','';
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
55foreach my $sym (keys %interp)
56 {
57 warn "extra $sym in interp.sym\n"
58 unless exists $intrp{$sym} || exists $thread{$sym};
59 }
60
61foreach 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
PP
71sub 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}
76sub embed ($) {
77 my ($sym) = @_;
78 hide($sym, "Perl_$sym");
79}
d4cce5f1
NIS
80sub multon ($$$) {
81 my ($sym,$pre,$ptr) = @_;
82 hide($sym, "($ptr->$pre$sym)");
5f05dabc 83}
d4cce5f1
NIS
84sub multoff ($$) {
85 my ($sym,$pre) = @_;
86 hide("$pre$sym", $sym);
5f05dabc
PP
87}
88
89unlink 'embed.h';
90open(EM, '> embed.h')
91 or die "Can't create embed.h: $!\n";
e50aee73
AD
92
93print EM <<'END';
76b72cf1 94/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
d4cce5f1
NIS
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
AD
98
99/* (Doing namespace management portably in C is really gross.) */
100
820c3be9
PP
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
PP
111/* Hide global symbols? */
112
e50aee73
AD
113#ifdef EMBED
114
e50aee73
AD
115END
116
5f05dabc 117for $sym (sort keys %global) {
dc86dda3 118 print EM embed($sym);
e50aee73
AD
119}
120
e50aee73
AD
121print EM <<'END';
122
123#endif /* EMBED */
124
d4cce5f1
NIS
125END
126
127close(EM);
128
129unlink 'embedvar.h';
130open(EM, '> embedvar.h')
131 or die "Can't create embedvar.h: $!\n";
132
133print 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
AD
150
151#ifdef MULTIPLICITY
152
d4cce5f1
NIS
153#ifndef USE_THREADS
154/* If we do not have threads then per-thread vars are per-interpreter */
155
e50aee73
AD
156END
157
d4cce5f1
NIS
158for $sym (sort keys %thread) {
159 print EM multon($sym,'T','curinterp');
160}
161
162print EM <<'END';
163
164#endif /* !USE_THREADS */
165
166/* These are always per-interpreter if there is more than one */
167
168END
169
170for $sym (sort keys %intrp) {
171 print EM multon($sym,'I','curinterp');
760ac839 172}
760ac839 173
55497cff
PP
174print EM <<'END';
175
5f05dabc 176#else /* !MULTIPLICITY */
55497cff
PP
177
178END
760ac839 179
d4cce5f1
NIS
180for $sym (sort keys %intrp) {
181 print EM multoff($sym,'I');
e50aee73 182}
e50aee73 183
56d28764
CS
184print EM <<'END';
185
d4cce5f1
NIS
186#ifndef USE_THREADS
187
188END
189
190for $sym (sort keys %thread) {
191 print EM multoff($sym,'T');
192}
193
194print EM <<'END';
195
196#endif /* USE_THREADS */
197
198/* Hide what would have been interpreter-specific symbols? */
5f05dabc 199
56d28764
CS
200#ifdef EMBED
201
202END
e50aee73 203
d4cce5f1
NIS
204for $sym (sort keys %intrp) {
205 print EM embed($sym);
206}
207
208print EM <<'END';
209
210#ifndef USE_THREADS
211
212END
213
214for $sym (sort keys %thread) {
dc86dda3 215 print EM embed($sym);
5f05dabc
PP
216}
217
218print EM <<'END';
219
d4cce5f1 220#endif /* USE_THREADS */
56d28764 221#endif /* EMBED */
e50aee73 222#endif /* MULTIPLICITY */
d4cce5f1
NIS
223
224/* Now same trickey for per-thread variables */
225
226#ifdef USE_THREADS
227
228END
229
230for $sym (sort keys %thread) {
231 print EM multon($sym,'T','thr');
232}
233
234print EM <<'END';
235
236#endif /* USE_THREADS */
237
e50aee73
AD
238END
239
d4cce5f1 240close(EM);