debugger tweak (wasn't printing a newline after recalled commands)

[perl5.git] / embed.pl

diff --git a/embed.pl b/embed.pl
index e318df1..89e1506 100755 (executable)
--- 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
@@ -233,6 +256,10 @@ my @extras = qw(
     dopoptosub_at
     save_lines
     doeval
+    sv_ncmp
+    sv_i_ncmp
+    amagic_ncmp
+    amagic_i_ncmp
     amagic_cmp
     amagic_cmp_locale
     mul128
@@ -328,6 +355,8 @@ my @extras = qw(
     study_chunk
     add_data
     re_croak2
+    regpposixcc
+    clear_re
     regmatch
     regrepeat
     regrepeat_hard
@@ -338,6 +367,7 @@ my @extras = qw(
     regcppop
     regcp_set_to
     cache_re
+    restore_pos
     reghop
     reghopmaybe
     dump
@@ -345,6 +375,8 @@ my @extras = qw(
     debprof
     bset_obj_store
     new_logop
+    simplify_sort
+    is_handle_constructor
     do_trans_CC_simple
     do_trans_CC_count
     do_trans_CC_complex
@@ -365,7 +397,7 @@ my @extras = qw(
     fprintf
 );
 
-for $sym (sort(keys(%global),@extras)) {
+for $sym (sort(keys(%global),@staticfuncs)) {
     print EM embedobj($sym);
 }
 
@@ -373,6 +405,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);
@@ -384,7 +421,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.) */
@@ -509,7 +546,7 @@ END
 
 print EM <<'END';
 
-#ifdef PERL_POLLUTE            /* unsupported in 5.006 */
+#ifdef PERL_POLLUTE            /* disabled by default in 5.006 */
 
 END
 
@@ -519,8 +556,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);