X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=embed.pl;h=028e21777124cca5a3b0d93ddf96bad4282e6ba2;hb=1e374101a32f2df640b9fad36d86b2ed88f6eaf8;hp=709acc60e05f246496e8f53fb6119df6efb91823;hpb=1ba53475584b568fe81ad70f22128f596dffa82f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/embed.pl b/embed.pl
index 709acc6..028e217 100755
--- a/embed.pl
+++ b/embed.pl
@@ -9,6 +9,7 @@ require 5.003;
 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
@@ -41,8 +42,8 @@ sub readsyms (\%$) {
 readsyms %global, 'global.sym';
 readsyms %global, 'pp.sym';
 
-sub readvars(\%$$) {
-    my ($syms, $file,$pre) = @_;
+sub readvars(\%$$@) {
+    my ($syms, $file,$pre,$keep_pre) = @_;
     local (*FILE, $_);
     open(FILE, "< $file")
 	or die "embed.pl: Can't open $file: $!\n";
@@ -50,6 +51,7 @@ sub readvars(\%$$) {
 	s/[ \t]*#.*//;		# Delete comments.
 	if (/PERLVARI?C?\($pre(\w+)/) {
 	    my $sym = $1;
+	    $sym = $pre . $sym if $keep_pre;
 	    warn "duplicate symbol $sym while processing $file\n"
 		if exists $$syms{$sym};
 	    $$syms{$sym} = 1;
@@ -64,6 +66,7 @@ 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)
  {
@@ -93,19 +96,39 @@ foreach my $sym (sort keys %thread)
    }
  }
 
+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");
@@ -128,7 +151,7 @@ open(EM, '> embed.h')
 print EM <<'END';
 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
    This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
-   and thrdvar.h.  Any changes made here will be lost!
+   perlvars.h and thrdvar.h.  Any changes made here will be lost!
 */
 
 /* (Doing namespace management portably in C is really gross.) */
@@ -152,7 +175,7 @@ print EM <<'END';
 END
 
 # XXX these should be in a *.sym file
-my @extras = qw(
+my @staticfuncs = qw(
     perl_init_i18nl10n
     perl_init_i18nl14n
     perl_new_collate
@@ -202,9 +225,7 @@ my @extras = qw(
     del_xnv
     del_xpv
     del_xrv
-    sv_mortalgrow
     sv_unglob
-    sv_check_thinkfirst
     avhv_index_sv
     do_report_used
     do_clean_objs
@@ -224,6 +245,12 @@ my @extras = qw(
     refto
     seed
     docatch
+    docatch_body
+    perl_parse_body
+    perl_run_body
+    perl_call_body
+    perl_call_xbody
+    call_list_body
     dofindlabel
     doparseform
     dopoptoeval
@@ -233,6 +260,11 @@ my @extras = qw(
     dopoptosub_at
     save_lines
     doeval
+    doopen_pmc
+    sv_ncmp
+    sv_i_ncmp
+    amagic_ncmp
+    amagic_i_ncmp
     amagic_cmp
     amagic_cmp_locale
     mul128
@@ -281,6 +313,7 @@ my @extras = qw(
     bad_type
     modkids
     no_fh_allowed
+    no_bareword_allowed
     scalarboolean
     too_few_arguments
     too_many_arguments
@@ -328,6 +361,8 @@ my @extras = qw(
     study_chunk
     add_data
     re_croak2
+    regpposixcc
+    clear_re
     regmatch
     regrepeat
     regrepeat_hard
@@ -338,13 +373,17 @@ my @extras = qw(
     regcppop
     regcp_set_to
     cache_re
+    restore_pos
     reghop
     reghopmaybe
     dump
     do_aspawn
     debprof
-    bset_obj_store
     new_logop
+    simplify_sort
+    is_handle_constructor
+    sv_add_backref
+    sv_del_backref
     do_trans_CC_simple
     do_trans_CC_count
     do_trans_CC_complex
@@ -365,17 +404,7 @@ my @extras = qw(
     fprintf
 );
 
-my %skip;
-
-for $sym (qw[
-    utf8skip
-	  ])
-{
-    $skip{$sym}++;
-}
-
-for $sym (sort(keys(%global),@extras)) {
-    next if exists $skip{$sym};
+for $sym (sort(keys(%global),@staticfuncs)) {
     print EM embedobj($sym);
 }
 
@@ -383,6 +412,11 @@ print EM <<'END';
 
 #endif	/* PERL_OBJECT */
 
+/* compatibility stubs */
+
+#define sv_setptrobj(rv,ptr,name)	sv_setref_iv(rv,name,(IV)ptr)
+#define sv_setptrref(rv,ptr)		sv_setref_iv(rv,Nullch,(IV)ptr)
+
 END
 
 close(EM);
@@ -394,7 +428,7 @@ open(EM, '> embedvar.h')
 print EM <<'END';
 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
    This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
-   and thrdvar.h.  Any changes made here will be lost!
+   perlvars.h and thrdvar.h.  Any changes made here will be lost!
 */
 
 /* (Doing namespace management portably in C is really gross.) */
@@ -519,7 +553,7 @@ END
 
 print EM <<'END';
 
-#ifdef PERL_POLLUTE		/* unsupported in 5.006 */
+#ifdef PERL_POLLUTE		/* disabled by default in 5.006 */
 
 END
 
@@ -529,8 +563,52 @@ for $sym (sort @extvars) {
 
 print EM <<'END';
 
-#endif /* MIN_PERL_DEFINE */
+#endif /* PERL_POLLUTE */
 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);