X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=embed.pl;h=c00c260eb1caa62d07bff361ecb43fac4a2d2e22;hb=be425529213e9b149dcb8e489b8c142dbfdda50e;hp=f685f66288781b81f61fdd61937ebbe4c986c009;hpb=533c011aecf9bca2c9ad025efccd7b74ad222cda;p=p5sagit%2Fp5-mst-13.2.git diff --git a/embed.pl b/embed.pl index f685f66..c00c260 100755 --- a/embed.pl +++ b/embed.pl @@ -2,34 +2,59 @@ require 5.003; +# XXX others that may need adding +# warnhook +# hints +# copline +my @extvars = qw(sv_undef sv_yes sv_no na dowarn + curcop compiling + tainting tainted stack_base stack_sp sv_arenaroot + no_modify + curstash DBsub DBsingle debstash + rsfp + stdingv + defgv + errgv + rsfp_filters + perldb + diehook + dirty + perl_destruct_level + ); + sub readsyms (\%$) { my ($syms, $file) = @_; - %$syms = (); local (*FILE, $_); open(FILE, "< $file") or die "embed.pl: Can't open $file: $!\n"; while () { s/[ \t]*#.*//; # Delete comments. if (/^\s*(\S+)\s*$/) { - $$syms{$1} = 1; + my $sym = $1; + warn "duplicate symbol $sym while processing $file\n" + if exists $$syms{$sym}; + $$syms{$sym} = 1; } } close(FILE); } readsyms %global, 'global.sym'; -readsyms %interp, 'interp.sym'; +readsyms %global, 'pp.sym'; -sub readvars(\%$$) { - my ($syms, $file,$pre) = @_; - %$syms = (); +sub readvars(\%$$@) { + my ($syms, $file,$pre,$keep_pre) = @_; local (*FILE, $_); open(FILE, "< $file") or die "embed.pl: Can't open $file: $!\n"; while () { s/[ \t]*#.*//; # Delete comments. if (/PERLVARI?C?\($pre(\w+)/) { - $$syms{$1} = 1; + my $sym = $1; + $sym = $pre . $sym if $keep_pre; + warn "duplicate symbol $sym while processing $file\n" + if exists $$syms{$sym}; + $$syms{$sym} = 1; } } close(FILE); @@ -41,14 +66,14 @@ my %thread; readvars %intrp, 'intrpvar.h','I'; readvars %thread, 'thrdvar.h','T'; readvars %globvar, 'perlvars.h','G'; +readvars %objvar, 'intrpvar.h','pi', 1; foreach my $sym (sort keys %intrp) { - warn "$sym not in interp.sym\n" unless exists $interp{$sym}; if (exists $global{$sym}) { delete $global{$sym}; - warn "$sym in global.sym as well as interp\n"; + warn "$sym in {global,pp}.sym as well as intrpvar.h\n"; } } @@ -57,35 +82,53 @@ foreach my $sym (sort keys %globvar) if (exists $global{$sym}) { delete $global{$sym}; - warn "$sym in global.sym as well as perlvars.h\n"; + warn "$sym in {global,pp}.sym as well as perlvars.h\n"; } } -foreach my $sym (keys %interp) - { - warn "extra $sym in interp.sym\n" - unless exists $intrp{$sym} || exists $thread{$sym}; - } - foreach my $sym (sort keys %thread) { - warn "$sym in intrpvar.h\n" if exists $intrp{$sym}; + warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym}; if (exists $global{$sym}) { delete $global{$sym}; - warn "$sym in global.sym as well as thread\n"; + warn "$sym in {global,pp}.sym as well as thrdvar.h\n"; } } +sub undefine ($) { + my ($sym) = @_; + "#undef $sym\n"; +} + sub hide ($$) { my ($from, $to) = @_; my $t = int(length($from) / 8); "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n"; } + sub embed ($) { my ($sym) = @_; hide($sym, "Perl_$sym"); } + +sub embedobj ($) { + my ($sym) = @_; + hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym"); +} + +sub objxsub_func ($) { + my ($sym) = @_; + undefine($sym) . hide($sym, $sym =~ /^perl_/i + ? "pPerl->$sym" + : "pPerl->Perl_$sym"); +} + +sub objxsub_var ($) { + my ($sym) = @_; + undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym"); +} + sub embedvar ($) { my ($sym) = @_; # hide($sym, "Perl_$sym"); @@ -107,25 +150,17 @@ open(EM, '> embed.h') print EM <<'END'; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by embed.pl from global.sym, intrpvar.h, - and thrdvar.h. Any changes made here will be lost! + This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, + perlvars.h and thrdvar.h. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ -/* EMBED has no run-time penalty, but helps keep the Perl namespace - from colliding with that used by other libraries pulled in - by extensions or by embedding perl. Allow a cc -DNO_EMBED - override, however, to keep binary compatability with previous - versions of perl. -*/ -#ifndef NO_EMBED -# define EMBED 1 -#endif +/* NO_EMBED is no longer supported. i.e. EMBED is always active. */ -/* Hide global symbols? */ +/* Hide global symbols */ -#ifdef EMBED +#if !defined(PERL_OBJECT) END @@ -135,7 +170,232 @@ for $sym (sort keys %global) { print EM <<'END'; -#endif /* EMBED */ +#else /* PERL_OBJECT */ + +END + +# XXX these should be in a *.sym file +my @staticfuncs = qw( + perl_init_i18nl10n + perl_init_i18nl14n + perl_new_collate + perl_new_ctype + perl_new_numeric + perl_set_numeric_local + perl_set_numeric_standard + perl_construct + perl_destruct + perl_atexit + perl_free + perl_parse + perl_run + perl_get_sv + perl_get_av + perl_get_hv + perl_get_cv + perl_call_argv + perl_call_pv + perl_call_method + perl_call_sv + perl_eval_pv + perl_eval_sv + perl_require_pv + + hsplit + hfreeentries + more_he + new_he + del_he + save_hek + mess_alloc + gv_init_sv + save_scalar_at + asIV + asUV + more_sv + more_xiv + more_xnv + more_xpv + more_xrv + new_xiv + new_xnv + new_xpv + new_xrv + del_xiv + del_xnv + del_xpv + del_xrv + sv_mortalgrow + sv_unglob + sv_check_thinkfirst + avhv_index_sv + do_report_used + do_clean_objs + do_clean_named_objs + do_clean_all + not_a_number + my_safemalloc + visit + qsortsv + sortcv + save_magic + magic_methpack + magic_methcall + magic_methcall + doform + doencodes + refto + seed + docatch + dofindlabel + doparseform + dopoptoeval + dopoptolabel + dopoptoloop + dopoptosub + dopoptosub_at + save_lines + doeval + amagic_cmp + amagic_cmp_locale + mul128 + is_an_int + div128 + runops_standard + runops_debug + check_uni + force_next + force_version + force_word + tokeq + scan_const + scan_formline + scan_heredoc + scan_ident + scan_inputsymbol + scan_pat + scan_str + scan_subst + scan_trans + scan_word + skipspace + checkcomma + force_ident + incline + intuit_method + intuit_more + lop + missingterm + no_op + set_csh + sublex_done + sublex_push + sublex_start + uni + filter_gets + new_constant + ao + depcom + win32_textfilter + incl_perldb + isa_lookup + get_db_sub + list_assignment + bad_type + modkids + no_fh_allowed + scalarboolean + too_few_arguments + too_many_arguments + null + pad_findlex + newDEFSVOP + gv_ename + cv_clone2 + find_beginning + forbid_setid + incpush + init_interp + init_ids + init_debugger + init_lexer + init_main_stash + init_perllib + init_postdump_symbols + init_predump_symbols + my_exit_jump + nuke_stacks + open_script + usage + validate_suid + emulate_eaccess + reg + reganode + regatom + regbranch + regc + reguni + regclass + regclassutf8 + regcurly + reg_node + regpiece + reginsert + regoptail + regset + regtail + regwhite + nextchar + dumpuntil + scan_commit + study_chunk + add_data + re_croak2 + regmatch + regrepeat + regrepeat_hard + regtry + reginclass + reginclassutf8 + regcppush + regcppop + regcp_set_to + cache_re + restore_pos + reghop + reghopmaybe + dump + do_aspawn + debprof + bset_obj_store + new_logop + do_trans_CC_simple + do_trans_CC_count + do_trans_CC_complex + do_trans_UU_simple + do_trans_UU_count + do_trans_UU_complex + do_trans_UC_simple + do_trans_CU_simple + do_trans_UC_trivial + do_trans_CU_trivial + unwind_handler_stack + restore_magic + restore_rsfp + restore_expect + restore_lex_expect + yydestruct + del_sv + fprintf +); + +for $sym (sort(keys(%global),@staticfuncs)) { + print EM embedobj($sym); +} + +print EM <<'END'; + +#endif /* PERL_OBJECT */ END @@ -147,20 +407,12 @@ open(EM, '> embedvar.h') print EM <<'END'; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by embed.pl from global.sym, intrpvar.h, - and thrdvar.h. Any changes made here will be lost! + This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, + perlvars.h and thrdvar.h. Any changes made here will be lost! */ /* (Doing namespace management portably in C is really gross.) */ -/* EMBED has no run-time penalty, but helps keep the Perl namespace - from colliding with that used by other libraries pulled in - by extensions or by embedding perl. Allow a cc -DNO_EMBED - override, however, to keep binary compatability with previous - versions of perl. -*/ - - /* Put interpreter-specific symbols into a struct? */ #ifdef MULTIPLICITY @@ -212,8 +464,6 @@ print EM <<'END'; /* Hide what would have been interpreter-specific symbols? */ -#ifdef EMBED - END for $sym (sort keys %intrp) { @@ -233,7 +483,6 @@ for $sym (sort keys %thread) { print EM <<'END'; #endif /* USE_THREADS */ -#endif /* EMBED */ #endif /* MULTIPLICITY */ /* Now same trickey for per-thread variables */ @@ -270,8 +519,6 @@ for $sym (sort keys %globvar) { print EM <<'END'; -#ifdef EMBED - END for $sym (sort keys %globvar) { @@ -280,9 +527,68 @@ for $sym (sort keys %globvar) { print EM <<'END'; -#endif /* EMBED */ #endif /* PERL_GLOBAL_STRUCT */ END +print EM <<'END'; + +#ifdef PERL_POLLUTE /* unsupported in 5.006 */ + +END + +for $sym (sort @extvars) { + print EM hide($sym,"PL_$sym"); +} + +print EM <<'END'; + +#endif /* MIN_PERL_DEFINE */ +END + + close(EM); + +unlink 'objXSUB.h'; +open(OBX, '> objXSUB.h') + or die "Can't create objXSUB.h: $!\n"; + +print OBX <<'EOT'; +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, + perlvars.h and thrdvar.h. Any changes made here will be lost! +*/ + +#ifndef __objXSUB_h__ +#define __objXSUB_h__ + +/* Variables */ + +EOT + +foreach my $sym (sort(keys(%intrp), + keys(%thread), + keys(%globvar), + keys(%objvar))) +{ + print OBX objxsub_var($sym); +} + +print OBX <<'EOT'; + +/* Functions */ + +EOT + + +for $sym (sort(keys(%global),@staticfuncs)) { + print OBX objxsub_func($sym); +} + + +print OBX <<'EOT'; + +#endif /* __objXSUB_h__ */ +EOT + +close(OBX);