projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
AIX threaded build, plus few more on the side.
[p5sagit/p5-mst-13.2.git] / embed.pl
diff --git a/embed.pl b/embed.pl
index 452a4de..d7c5a87 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -100,11 +100,14 @@ sub munge_c_files () {
 #munge_c_files();
 
 # generate proto.h
+my $wrote_protected = 0;
+
 sub write_protos {
     my $ret = "";
     if (@_ == 1) {
        my $arg = shift;
-       $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/;
+       $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/
+           or $arg =~ /^\s*(public|protected|private):/;
     }
     else {
        my ($flags,$retval,$func,@args) = @_;
@@ -112,8 +115,11 @@ sub write_protos {
            $retval = "STATIC $retval";
            $func = "S_$func";
        }
-       elsif ($flags =~ /p/) {
-           $func = "Perl_$func";
+       else {
+           $retval = "VIRTUAL $retval";
+           if ($flags =~ /p/) {
+               $func = "Perl_$func";
+           }
        }
        $ret .= "$retval\t$func(";
        unless ($flags =~ /n/) {
@@ -388,13 +394,16 @@ walk_table {
     }
     else {
        my ($flags,$retval,$func,@args) = @_;
-       unless ($flags =~ /o/) {
-           if ($flags =~ /s/) {
-               $ret .= hide("S_$func","CPerlObj::$func");
-           }
-           elsif ($flags =~ /p/) {
-               $ret .= hide("Perl_$func","CPerlObj::$func");
-           }
+       if ($flags =~ /s/) {
+           $ret .= hide("S_$func","CPerlObj::S_$func");
+           $ret .= hide($func,"S_$func");
+       }
+       elsif ($flags =~ /p/) {
+           $ret .= hide("Perl_$func","CPerlObj::Perl_$func");
+           $ret .= hide($func,"Perl_$func");
+       }
+       else {
+           $ret .= hide($func,"CPerlObj::$func");
        }
     }
     $ret;
@@ -402,7 +411,8 @@ walk_table {
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
-    print EM hide("Perl_$sym", "CPerlObj::$sym");
+    print EM hide("Perl_$sym", "CPerlObj::Perl_$sym");
+    print EM hide($sym, "Perl_$sym");
 }
 
 print EM <<'END';
@@ -684,8 +694,12 @@ walk_table {
     }
     else {
        my ($flags,$retval,$func,@args) = @_;
-       unless ($flags =~ /o/) {
+       unless ($flags =~ /s/) {
            if ($flags =~ /p/) {
+               $ret .= undefine("Perl_$func") . hide("Perl_$func","pPerl->Perl_$func");
+               $ret .= undefine($func) . hide($func,"Perl_$func");
+           }
+           else {
                $ret .= undefine($func) . hide($func,"pPerl->$func");
            }
        }
@@ -695,7 +709,8 @@ walk_table {
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
-    print OBX undefine($sym) . hide($sym, "pPerl->$sym");
+    print OBX undefine("Perl_$sym") . hide("Perl_$sym", "pPerl->Perl_$sym");
+    print OBX undefine($sym) . hide($sym, "Perl_$sym");
 }
 
 print OBX <<'EOT';
@@ -731,6 +746,9 @@ __END__
 #          may be autogenerated.
 #
 
+#if defined(PERL_OBJECT)
+public:
+#endif
 p      |SV*    |amagic_call    |SV* left|SV* right|int method|int dir
 p      |bool   |Gv_AMupdate    |HV* stash
 p      |OP*    |append_elem    |I32 optype|OP* head|OP* tail
@@ -799,6 +817,7 @@ p   |char** |get_op_descs
 p      |char** |get_op_names
 p      |char*  |get_no_modify
 p      |U32*   |get_opargs
+p      |PPADDR_t*|get_ppaddr
 p      |I32    |cxinc
 p      |void   |deb            |const char* pat|...
 p      |void   |deb_growlevel
@@ -1019,7 +1038,6 @@ p |int    |magic_set_all_env|SV* sv|MAGIC* mg
 p      |U32    |magic_sizepack |SV* sv|MAGIC* mg
 p      |int    |magic_wipepack |SV* sv|MAGIC* mg
 p      |void   |magicname      |char* sym|char* name|I32 namlen
-no     |int    |main           |int argc|char** argv|char** env
 #if defined(MYMALLOC)
 np     |MEM_SIZE|malloced_size |void *p
 #endif
@@ -1040,6 +1058,7 @@ p |I32    |mg_size        |SV* sv
 p      |OP*    |mod            |OP* o|I32 type
 p      |char*  |moreswitches   |char* s
 p      |OP*    |my             |OP* o
+p      |double |my_atof        |const char *s
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 p      |char*  |my_bcopy       |const char* from|char* to|I32 len
 #endif
@@ -1138,17 +1157,29 @@ p       |void   |pad_free       |PADOFFSET po
 p      |void   |pad_reset
 p      |void   |pad_swipe      |PADOFFSET po
 p      |void   |peep           |OP* o
+#if defined(PERL_OBJECT)
+no     |void   |perl_construct
+no     |void   |perl_destruct
+no     |void   |perl_free
+no     |int    |perl_run
+no     |int    |perl_parse     |XSINIT_t xsinit \
+                               |int argc|char** argv|char** env
+#else
 no     |PerlInterpreter*       |perl_alloc
+no     |void   |perl_construct |PerlInterpreter* sv_interp
+no     |void   |perl_destruct  |PerlInterpreter* sv_interp
+no     |void   |perl_free      |PerlInterpreter* sv_interp
+no     |int    |perl_run       |PerlInterpreter* sv_interp
+no     |int    |perl_parse     |PerlInterpreter* sv_interp|XSINIT_t xsinit \
+                               |int argc|char** argv|char** env
+#endif
 p      |void   |call_atexit    |ATEXIT_t fn|void *ptr
 p      |I32    |call_argv      |const char* sub_name|I32 flags|char** argv
 p      |I32    |call_method    |const char* methname|I32 flags
 p      |I32    |call_pv        |const char* sub_name|I32 flags
 p      |I32    |call_sv        |SV* sv|I32 flags
-no     |void   |perl_construct |PerlInterpreter* sv_interp
-no     |void   |perl_destruct  |PerlInterpreter* sv_interp
 p      |SV*    |eval_pv        |const char* p|I32 croak_on_error
 p      |I32    |eval_sv        |SV* sv|I32 flags
-no     |void   |perl_free      |PerlInterpreter* sv_interp
 p      |SV*    |get_sv         |const char* name|I32 create
 p      |AV*    |get_av         |const char* name|I32 create
 p      |HV*    |get_hv         |const char* name|I32 create
@@ -1159,11 +1190,9 @@ p        |void   |new_collate    |const char* newcoll
 p      |void   |new_ctype      |const char* newctype
 p      |void   |new_numeric    |const char* newcoll
 p      |void   |set_numeric_local
+p      |void   |set_numeric_radix
 p      |void   |set_numeric_standard
-no     |int    |perl_parse     |PerlInterpreter* sv_interp|XSINIT_t xsinit \
-                               |int argc|char** argv|char** env
 p      |void   |require_pv     |const char* pv
-no     |int    |perl_run       |PerlInterpreter* sv_interp
 p      |void   |pidgone        |int pid|int status
 p      |void   |pmflag         |U16* pmfl|int ch
 p      |OP*    |pmruntime      |OP* pm|OP* expr|OP* repl
@@ -1402,7 +1431,11 @@ p        |int    |runops_standard
 p      |int    |runops_debug
 
 #if defined(WIN32)
-p      |int&   |ErrorNo
+#if defined(PERL_OBJECT)
+p      |int&   |ErrorNo
+#else
+p      |int*   |ErrorNo
+#endif
 #endif
 p      |void   |sv_catpvf_mg   |SV *sv|const char* pat|...
 p      |void   |sv_catpv_mg    |SV *sv|const char *ptr
@@ -1440,11 +1473,14 @@ p       |void   |tmps_grow      |I32 n
 p      |SV*    |sv_rvweaken    |SV *sv
 p      |int    |magic_killbackrefs|SV *sv|MAGIC *mg
 
-#if defined(PERL_IN_AV_C)
+#if defined(PERL_OBJECT)
+protected:
+#endif
+#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 s      |I32    |avhv_index_sv  |SV* sv
 #endif
 
-#if defined(PERL_IN_DOOP_C)
+#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
 s      |I32    |do_trans_CC_simple     |SV *sv
 s      |I32    |do_trans_CC_count      |SV *sv
 s      |I32    |do_trans_CC_complex    |SV *sv
@@ -1457,11 +1493,11 @@ s       |I32    |do_trans_UC_trivial    |SV *sv
 s      |I32    |do_trans_CU_trivial    |SV *sv
 #endif
 
-#if defined(PERL_IN_GV_C)
+#if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
 s      |void   |gv_init_sv     |GV *gv|I32 sv_type
 #endif
 
-#if defined(PERL_IN_HV_C)
+#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
 s      |void   |hsplit         |HV *hv
 s      |void   |hfreeentries   |HV *hv
 s      |void   |more_he
@@ -1471,7 +1507,7 @@ s |HEK*   |save_hek       |const char *str|I32 len|U32 hash
 s      |void   |hv_magic_check |HV *hv|bool *needs_copy|bool *needs_store
 #endif
 
-#if defined(PERL_IN_MG_C)
+#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
 s      |void   |save_magic     |I32 mgs_ix|SV *sv
 s      |int    |magic_methpack |SV *sv|MAGIC *mg|char *meth
 s      |int    |magic_methcall |SV *sv|MAGIC *mg|char *meth|I32 f \
@@ -1480,7 +1516,7 @@ s |void   |unwind_handler_stack   |void *p
 s      |void   |restore_magic  |void *p
 #endif
 
-#if defined(PERL_IN_OP_C)
+#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
 s      |I32    |list_assignment|OP *o
 s      |void   |bad_type       |I32 n|char *t|char *name|OP *kid
 s      |OP*    |modkids        |OP *o|I32 type
@@ -1504,7 +1540,7 @@ s |void*  |Slab_Alloc     |int m|size_t sz
 #  endif
 #endif
 
-#if defined(PERL_IN_PERL_C)
+#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 s      |void   |find_beginning
 s      |void   |forbid_setid   |char *
 s      |void   |incpush        |char *|int
@@ -1521,7 +1557,6 @@ s |void   |nuke_stacks
 s      |void   |open_script    |char *|bool|SV *|int *fd
 s      |void   |usage          |char *
 s      |void   |validate_suid  |char *|char*|int
-s      |I32    |read_e_script  |int idx|SV *buf_sv|int maxlen
 #  if defined(IAMSUID)
 s      |int    |fd_on_nosuid_fs|int fd
 #  endif
@@ -1535,7 +1570,7 @@ s |struct perl_thread *   |init_main_thread
 #  endif
 #endif
 
-#if defined(PERL_IN_PP_C)
+#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 s      |void   |doencodes      |SV* sv|char* s|I32 len
 s      |SV*    |refto          |SV* sv
 s      |U32    |seed
@@ -1544,7 +1579,7 @@ s |SV*    |is_an_int      |char *s|STRLEN l
 s      |int    |div128         |SV *pnum|bool *done
 #endif
 
-#if defined(PERL_IN_PP_CTL_C)
+#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 s      |OP*    |docatch        |OP *o
 s      |void*  |docatch_body   |va_list args
 s      |OP*    |dofindlabel    |OP *o|char *label|OP **opstack|OP **oplimit
@@ -1568,14 +1603,14 @@ s       |I32    |amagic_cmp     |SV *str1|SV *str2
 s      |I32    |amagic_cmp_locale|SV *str1|SV *str2
 #endif
 
-#if defined(PERL_IN_PP_HOT_C)
+#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 s      |CV*    |get_db_sub     |SV **svp|CV *cv
 #  if defined(USE_THREADS)
 s      |void   |unset_cvowner  |void *cvarg
 #  endif
 #endif
 
-#if defined(PERL_IN_PP_SYS_C)
+#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
 s      |OP*    |doform         |CV *cv|GV *gv|OP *retop
 s      |int    |emulate_eaccess|const char* path|int mode
 #  if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
@@ -1583,7 +1618,7 @@ s |int    |dooneliner     |char *cmd|char *filename
 #  endif
 #endif
 
-#if defined(PERL_IN_REGCOMP_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
 s      |regnode*|reg           |I32|I32 *
 s      |regnode*|reganode      |U8|U32
 s      |regnode*|regatom       |I32 *
@@ -1611,7 +1646,7 @@ s |char*|regpposixcc      |I32 value
 s      |void   |clear_re       |void *r
 #endif
 
-#if defined(PERL_IN_REGEXEC_C)
+#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
 s      |I32    |regmatch       |regnode *prog
 s      |I32    |regrepeat      |regnode *p|I32 max
 s      |I32    |regrepeat_hard |regnode *p|I32 max|I32 *lp
@@ -1627,15 +1662,15 @@ s       |U8*    |reghop         |U8 *pos|I32 off
 s      |U8*    |reghopmaybe    |U8 *pos|I32 off
 #endif
 
-#if defined(PERL_IN_RUN_C)
+#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
 s      |void   |debprof        |OP *o
 #endif
 
-#if defined(PERL_IN_SCOPE_C)
+#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 s      |SV*    |save_scalar_at |SV **sptr
 #endif
 
-#if defined(PERL_IN_SV_C)
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 s      |IV     |asIV           |SV* sv
 s      |UV     |asUV           |SV* sv
 s      |SV*    |more_sv
@@ -1671,7 +1706,7 @@ s |void   |del_sv |SV *p
 #  endif
 #endif
 
-#if defined(PERL_IN_TOKE_C)
+#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
 s      |void   |check_uni
 s      |void   |force_next     |I32 type
 s      |char*  |force_version  |char *start
@@ -1722,14 +1757,15 @@ s       |I32    |win32_textfilter       |int idx|SV *sv|int maxlen
 #  endif
 #endif
 
-#if defined(PERL_IN_UNIVERSAL_C)
+#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
 s      |SV*|isa_lookup |HV *stash|const char *name|int len|int level
 #endif
 
-#if defined(PERL_IN_UTIL_C)
+#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 s      |SV*    |mess_alloc
 rs     |void   |do_croak       |const char *pat|va_list *args
 s      |void   |do_warn        |const char *pat|va_list *args
+s      |OP*    |do_die         |const char *pat|va_list *args
 #  if defined(LEAKTEST)
 s      |void   |xstat          |int
 #  endif
Unnamed repository; edit this file to name it for gitweb.