clarify what a "line" is
[p5sagit/p5-mst-13.2.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
5f05dabc 3require 5.003;
4
709f4e38 5# XXX others that may need adding
6# warnhook
7# hints
8# copline
84fee439 9my @extvars = qw(sv_undef sv_yes sv_no na dowarn
10 curcop compiling
11 tainting tainted stack_base stack_sp sv_arenaroot
256a4781 12 no_modify
84fee439 13 curstash DBsub DBsingle debstash
14 rsfp
15 stdingv
6b88bc9c 16 defgv
17 errgv
3070f6ec 18 rsfp_filters
19 perldb
709f4e38 20 diehook
21 dirty
22 perl_destruct_level
84fee439 23 );
24
5f05dabc 25sub readsyms (\%$) {
26 my ($syms, $file) = @_;
5f05dabc 27 local (*FILE, $_);
28 open(FILE, "< $file")
29 or die "embed.pl: Can't open $file: $!\n";
30 while (<FILE>) {
31 s/[ \t]*#.*//; # Delete comments.
32 if (/^\s*(\S+)\s*$/) {
22c35a8c 33 my $sym = $1;
34 warn "duplicate symbol $sym while processing $file\n"
35 if exists $$syms{$sym};
36 $$syms{$sym} = 1;
5f05dabc 37 }
38 }
39 close(FILE);
40}
41
42readsyms %global, 'global.sym';
22c35a8c 43readsyms %global, 'pp.sym';
5f05dabc 44
c6af7a1a 45sub readvars(\%$$@) {
46 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1 47 local (*FILE, $_);
48 open(FILE, "< $file")
49 or die "embed.pl: Can't open $file: $!\n";
50 while (<FILE>) {
51 s/[ \t]*#.*//; # Delete comments.
3fe35a81 52 if (/PERLVARI?C?\($pre(\w+)/) {
22c35a8c 53 my $sym = $1;
c6af7a1a 54 $sym = $pre . $sym if $keep_pre;
22c35a8c 55 warn "duplicate symbol $sym while processing $file\n"
56 if exists $$syms{$sym};
57 $$syms{$sym} = 1;
d4cce5f1 58 }
59 }
60 close(FILE);
61}
62
63my %intrp;
64my %thread;
65
66readvars %intrp, 'intrpvar.h','I';
67readvars %thread, 'thrdvar.h','T';
22239a37 68readvars %globvar, 'perlvars.h','G';
c6af7a1a 69readvars %objvar, 'intrpvar.h','pi', 1;
d4cce5f1 70
71foreach my $sym (sort keys %intrp)
72 {
d4cce5f1 73 if (exists $global{$sym})
74 {
75 delete $global{$sym};
22c35a8c 76 warn "$sym in {global,pp}.sym as well as intrpvar.h\n";
d4cce5f1 77 }
78 }
79
22239a37 80foreach my $sym (sort keys %globvar)
81 {
82 if (exists $global{$sym})
83 {
84 delete $global{$sym};
22c35a8c 85 warn "$sym in {global,pp}.sym as well as perlvars.h\n";
22239a37 86 }
87 }
88
d4cce5f1 89foreach my $sym (sort keys %thread)
90 {
34b58025 91 warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
d4cce5f1 92 if (exists $global{$sym})
93 {
94 delete $global{$sym};
22c35a8c 95 warn "$sym in {global,pp}.sym as well as thrdvar.h\n";
d4cce5f1 96 }
97 }
98
c6af7a1a 99sub undefine ($) {
100 my ($sym) = @_;
101 "#undef $sym\n";
102}
103
5f05dabc 104sub hide ($$) {
105 my ($from, $to) = @_;
106 my $t = int(length($from) / 8);
107 "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
108}
c6af7a1a 109
5f05dabc 110sub embed ($) {
111 my ($sym) = @_;
112 hide($sym, "Perl_$sym");
113}
c6af7a1a 114
22c35a8c 115sub embedobj ($) {
116 my ($sym) = @_;
117 hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
118}
c6af7a1a 119
120sub objxsub_func ($) {
121 my ($sym) = @_;
122 undefine($sym) . hide($sym, $sym =~ /^perl_/i
123 ? "pPerl->$sym"
124 : "pPerl->Perl_$sym");
125}
126
127sub objxsub_var ($) {
128 my ($sym) = @_;
129 undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym");
130}
131
3280af22 132sub embedvar ($) {
133 my ($sym) = @_;
134# hide($sym, "Perl_$sym");
135 return '';
136}
137
d4cce5f1 138sub multon ($$$) {
139 my ($sym,$pre,$ptr) = @_;
3280af22 140 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 141}
d4cce5f1 142sub multoff ($$) {
143 my ($sym,$pre) = @_;
533c011a 144 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc 145}
146
147unlink 'embed.h';
148open(EM, '> embed.h')
149 or die "Can't create embed.h: $!\n";
e50aee73 150
151print EM <<'END';
76b72cf1 152/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 153 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
c6af7a1a 154 perlvars.h and thrdvar.h. Any changes made here will be lost!
76b72cf1 155*/
e50aee73 156
157/* (Doing namespace management portably in C is really gross.) */
158
22c35a8c 159/* NO_EMBED is no longer supported. i.e. EMBED is always active. */
820c3be9 160
22c35a8c 161/* Hide global symbols */
5f05dabc 162
22c35a8c 163#if !defined(PERL_OBJECT)
e50aee73 164
e50aee73 165END
166
5f05dabc 167for $sym (sort keys %global) {
dc86dda3 168 print EM embed($sym);
e50aee73 169}
170
e50aee73 171print EM <<'END';
172
22c35a8c 173#else /* PERL_OBJECT */
174
175END
176
177# XXX these should be in a *.sym file
c6af7a1a 178my @staticfuncs = qw(
22c35a8c 179 perl_init_i18nl10n
180 perl_init_i18nl14n
181 perl_new_collate
182 perl_new_ctype
183 perl_new_numeric
184 perl_set_numeric_local
185 perl_set_numeric_standard
186 perl_construct
187 perl_destruct
188 perl_atexit
189 perl_free
190 perl_parse
191 perl_run
192 perl_get_sv
193 perl_get_av
194 perl_get_hv
195 perl_get_cv
196 perl_call_argv
197 perl_call_pv
198 perl_call_method
199 perl_call_sv
200 perl_eval_pv
201 perl_eval_sv
202 perl_require_pv
203
204 hsplit
205 hfreeentries
206 more_he
207 new_he
208 del_he
209 save_hek
210 mess_alloc
211 gv_init_sv
212 save_scalar_at
213 asIV
214 asUV
215 more_sv
216 more_xiv
217 more_xnv
218 more_xpv
219 more_xrv
220 new_xiv
221 new_xnv
222 new_xpv
223 new_xrv
224 del_xiv
225 del_xnv
226 del_xpv
227 del_xrv
228 sv_mortalgrow
229 sv_unglob
230 sv_check_thinkfirst
231 avhv_index_sv
232 do_report_used
233 do_clean_objs
234 do_clean_named_objs
235 do_clean_all
236 not_a_number
237 my_safemalloc
238 visit
239 qsortsv
240 sortcv
241 save_magic
242 magic_methpack
243 magic_methcall
244 magic_methcall
245 doform
246 doencodes
247 refto
248 seed
249 docatch
250 dofindlabel
251 doparseform
252 dopoptoeval
253 dopoptolabel
254 dopoptoloop
255 dopoptosub
256 dopoptosub_at
257 save_lines
258 doeval
bda4119b 259 sv_ncmp
260 sv_i_ncmp
261 amagic_ncmp
262 amagic_i_ncmp
22c35a8c 263 amagic_cmp
264 amagic_cmp_locale
265 mul128
266 is_an_int
267 div128
268 runops_standard
269 runops_debug
270 check_uni
271 force_next
272 force_version
273 force_word
274 tokeq
275 scan_const
276 scan_formline
277 scan_heredoc
278 scan_ident
279 scan_inputsymbol
280 scan_pat
281 scan_str
282 scan_subst
283 scan_trans
284 scan_word
285 skipspace
286 checkcomma
287 force_ident
288 incline
289 intuit_method
290 intuit_more
291 lop
292 missingterm
293 no_op
294 set_csh
295 sublex_done
296 sublex_push
297 sublex_start
298 uni
299 filter_gets
300 new_constant
301 ao
302 depcom
303 win32_textfilter
304 incl_perldb
305 isa_lookup
306 get_db_sub
307 list_assignment
308 bad_type
309 modkids
310 no_fh_allowed
311 scalarboolean
312 too_few_arguments
313 too_many_arguments
314 null
315 pad_findlex
316 newDEFSVOP
317 gv_ename
318 cv_clone2
319 find_beginning
320 forbid_setid
321 incpush
322 init_interp
323 init_ids
324 init_debugger
325 init_lexer
326 init_main_stash
327 init_perllib
328 init_postdump_symbols
329 init_predump_symbols
330 my_exit_jump
331 nuke_stacks
332 open_script
333 usage
334 validate_suid
335 emulate_eaccess
336 reg
337 reganode
338 regatom
339 regbranch
340 regc
341 reguni
342 regclass
343 regclassutf8
344 regcurly
345 reg_node
346 regpiece
347 reginsert
348 regoptail
349 regset
350 regtail
351 regwhite
352 nextchar
353 dumpuntil
354 scan_commit
355 study_chunk
356 add_data
357 re_croak2
eb1ab10a 358 regpposixcc
4327152a 359 clear_re
22c35a8c 360 regmatch
361 regrepeat
362 regrepeat_hard
363 regtry
364 reginclass
365 reginclassutf8
366 regcppush
367 regcppop
368 regcp_set_to
369 cache_re
9661b544 370 restore_pos
22c35a8c 371 reghop
372 reghopmaybe
373 dump
374 do_aspawn
375 debprof
376 bset_obj_store
377 new_logop
bda4119b 378 simplify_sort
35cd451c 379 is_handle_constructor
22c35a8c 380 do_trans_CC_simple
381 do_trans_CC_count
382 do_trans_CC_complex
383 do_trans_UU_simple
384 do_trans_UU_count
385 do_trans_UU_complex
386 do_trans_UC_simple
387 do_trans_CU_simple
388 do_trans_UC_trivial
389 do_trans_CU_trivial
390 unwind_handler_stack
391 restore_magic
392 restore_rsfp
393 restore_expect
394 restore_lex_expect
395 yydestruct
396 del_sv
397 fprintf
398);
399
c6af7a1a 400for $sym (sort(keys(%global),@staticfuncs)) {
22c35a8c 401 print EM embedobj($sym);
402}
403
404print EM <<'END';
405
406#endif /* PERL_OBJECT */
e50aee73 407
d4cce5f1 408END
409
410close(EM);
411
412unlink 'embedvar.h';
413open(EM, '> embedvar.h')
414 or die "Can't create embedvar.h: $!\n";
415
416print EM <<'END';
417/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 418 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
c6af7a1a 419 perlvars.h and thrdvar.h. Any changes made here will be lost!
d4cce5f1 420*/
421
422/* (Doing namespace management portably in C is really gross.) */
423
5f05dabc 424/* Put interpreter-specific symbols into a struct? */
e50aee73 425
426#ifdef MULTIPLICITY
427
d4cce5f1 428#ifndef USE_THREADS
429/* If we do not have threads then per-thread vars are per-interpreter */
430
e50aee73 431END
432
d4cce5f1 433for $sym (sort keys %thread) {
8f872242 434 print EM multon($sym,'T','PL_curinterp->');
d4cce5f1 435}
436
437print EM <<'END';
438
439#endif /* !USE_THREADS */
440
441/* These are always per-interpreter if there is more than one */
442
443END
444
445for $sym (sort keys %intrp) {
8f872242 446 print EM multon($sym,'I','PL_curinterp->');
760ac839 447}
760ac839 448
55497cff 449print EM <<'END';
450
5f05dabc 451#else /* !MULTIPLICITY */
55497cff 452
453END
760ac839 454
d4cce5f1 455for $sym (sort keys %intrp) {
456 print EM multoff($sym,'I');
e50aee73 457}
e50aee73 458
56d28764 459print EM <<'END';
460
d4cce5f1 461#ifndef USE_THREADS
462
463END
464
465for $sym (sort keys %thread) {
466 print EM multoff($sym,'T');
467}
468
469print EM <<'END';
470
471#endif /* USE_THREADS */
472
473/* Hide what would have been interpreter-specific symbols? */
5f05dabc 474
56d28764 475END
e50aee73 476
d4cce5f1 477for $sym (sort keys %intrp) {
3280af22 478 print EM embedvar($sym);
d4cce5f1 479}
480
481print EM <<'END';
482
483#ifndef USE_THREADS
484
485END
486
487for $sym (sort keys %thread) {
3280af22 488 print EM embedvar($sym);
5f05dabc 489}
490
491print EM <<'END';
492
d4cce5f1 493#endif /* USE_THREADS */
e50aee73 494#endif /* MULTIPLICITY */
d4cce5f1 495
496/* Now same trickey for per-thread variables */
497
498#ifdef USE_THREADS
499
500END
501
502for $sym (sort keys %thread) {
22239a37 503 print EM multon($sym,'T','thr->');
d4cce5f1 504}
505
506print EM <<'END';
507
508#endif /* USE_THREADS */
509
22239a37 510#ifdef PERL_GLOBAL_STRUCT
511
512END
513
514for $sym (sort keys %globvar) {
533c011a 515 print EM multon($sym,'G','PL_Vars.');
22239a37 516}
517
518print EM <<'END';
519
520#else /* !PERL_GLOBAL_STRUCT */
521
522END
523
524for $sym (sort keys %globvar) {
525 print EM multoff($sym,'G');
526}
527
528print EM <<'END';
529
22239a37 530END
531
532for $sym (sort keys %globvar) {
3280af22 533 print EM embedvar($sym);
22239a37 534}
535
536print EM <<'END';
537
22239a37 538#endif /* PERL_GLOBAL_STRUCT */
539
e50aee73 540END
541
84fee439 542print EM <<'END';
543
1ba53475 544#ifdef PERL_POLLUTE /* unsupported in 5.006 */
84fee439 545
546END
547
548for $sym (sort @extvars) {
549 print EM hide($sym,"PL_$sym");
550}
551
552print EM <<'END';
553
554#endif /* MIN_PERL_DEFINE */
555END
556
557
3fe35a81 558close(EM);
c6af7a1a 559
560unlink 'objXSUB.h';
561open(OBX, '> objXSUB.h')
562 or die "Can't create objXSUB.h: $!\n";
563
564print OBX <<'EOT';
565/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
566 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
567 perlvars.h and thrdvar.h. Any changes made here will be lost!
568*/
569
570#ifndef __objXSUB_h__
571#define __objXSUB_h__
572
573/* Variables */
574
575EOT
576
577foreach my $sym (sort(keys(%intrp),
578 keys(%thread),
579 keys(%globvar),
580 keys(%objvar)))
581{
582 print OBX objxsub_var($sym);
583}
584
585print OBX <<'EOT';
586
587/* Functions */
588
589EOT
590
591
592for $sym (sort(keys(%global),@staticfuncs)) {
593 print OBX objxsub_func($sym);
594}
595
596
597print OBX <<'EOT';
598
599#endif /* __objXSUB_h__ */
600EOT
601
602close(OBX);