X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=embed.pl;h=bc4ccfa0bb88706f2df93b05dbb0c430308fdc62;hb=37a581db7e8c594db4c6ef42b6fe4d8a81fc4ca3;hp=0b61bf00c572b8c129c5bbc9bbad6f911b63073c;hpb=3fcd5a54ee9a769b0df77dcf2827b3be2e6ddbd1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/embed.pl b/embed.pl index 0b61bf0..bc4ccfa 100755 --- a/embed.pl +++ b/embed.pl @@ -1,9 +1,5 @@ #!/usr/bin/perl -w -BEGIN { - unshift @INC, "./lib"; -} - require 5.003; # keep this compatible, an old perl is all we may have before # we build the new one @@ -270,7 +266,7 @@ sub hide ($$) { sub bincompat_var ($$) { my ($pfx, $sym) = @_; - my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHXo'); + my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX'); undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))"); } @@ -335,7 +331,6 @@ print EM <<'END'; /* Hide global symbols */ -#if !defined(PERL_OBJECT) #if !defined(PERL_IMPLICIT_CONTEXT) END @@ -349,12 +344,14 @@ walk_table { else { my ($flags,$retval,$func,@args) = @_; unless ($flags =~ /o/) { + $ret .= "#ifdef CRIPPLED_CC\n" if $flags =~ /C/; if ($flags =~ /s/) { $ret .= hide($func,"S_$func"); } elsif ($flags =~ /p/) { $ret .= hide($func,"Perl_$func"); } + $ret .= "#endif\n" if $flags =~ /C/; } } $ret; @@ -429,43 +426,11 @@ for $sym (sort keys %ppsym) { print EM <<'END'; #endif /* PERL_IMPLICIT_CONTEXT */ -#else /* PERL_OBJECT */ END -walk_table { - my $ret = ""; - if (@_ == 1) { - my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; - } - else { - my ($flags,$retval,$func,@args) = @_; - if ($flags =~ /s/) { - $ret .= hide("S_$func","CPerlObj::S_$func") if $flags !~ /j/; - $ret .= hide($func,"S_$func"); - } - elsif ($flags =~ /p/) { - $ret .= hide("Perl_$func","CPerlObj::Perl_$func") if $flags !~ /j/; - $ret .= hide($func,"Perl_$func"); - } - else { - $ret .= hide($func,"CPerlObj::$func") if $flags !~ /j/; - } - } - $ret; -} \*EM; - -for $sym (sort keys %ppsym) { - $sym =~ s/^Perl_//; - print EM hide("Perl_$sym", "CPerlObj::Perl_$sym"); - print EM hide($sym, "Perl_$sym"); -} - print EM <<'END'; -#endif /* PERL_OBJECT */ - /* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to disable them. */ @@ -506,7 +471,7 @@ print EM <<'END'; an extra argument but grab the context pointer using the macro dTHX. */ -#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_OBJECT) +#if defined(PERL_IMPLICIT_CONTEXT) # define croak Perl_croak_nocontext # define deb Perl_deb_nocontext # define die Perl_die_nocontext @@ -558,14 +523,13 @@ print EM <<'END'; /* (Doing namespace management portably in C is really gross.) */ /* - The following combinations of MULTIPLICITY, USE_THREADS, PERL_OBJECT + The following combinations of MULTIPLICITY, USE_5005THREADS and PERL_IMPLICIT_CONTEXT are supported: 1) none 2) MULTIPLICITY # supported for compatibility 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT - 4) USE_THREADS && PERL_IMPLICIT_CONTEXT - 5) MULTIPLICITY && USE_THREADS && PERL_IMPLICIT_CONTEXT - 6) PERL_OBJECT && PERL_IMPLICIT_CONTEXT + 4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT + 5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT All other combinations of these flags are errors. @@ -590,11 +554,7 @@ for $sym (sort keys %thread) { print EM <<'END'; -# if defined(PERL_OBJECT) -# include "error: PERL_OBJECT + MULTIPLICITY don't go together" -# endif - -# if defined(USE_THREADS) +# if defined(USE_5005THREADS) /* case 5 above */ END @@ -605,7 +565,7 @@ for $sym (sort keys %intrp) { print EM <<'END'; -# else /* !USE_THREADS */ +# else /* !USE_5005THREADS */ /* cases 2 and 3 above */ END @@ -616,28 +576,10 @@ for $sym (sort keys %intrp) { print EM <<'END'; -# endif /* USE_THREADS */ +# endif /* USE_5005THREADS */ #else /* !MULTIPLICITY */ -# if defined(PERL_OBJECT) -/* case 6 above */ - -END - -for $sym (sort keys %thread) { - print EM multon($sym,'T','aTHXo->interp.'); -} - - -for $sym (sort keys %intrp) { - print EM multon($sym,'I','aTHXo->interp.'); -} - -print EM <<'END'; - -# else /* !PERL_OBJECT */ - /* cases 1 and 4 above */ END @@ -648,7 +590,7 @@ for $sym (sort keys %intrp) { print EM <<'END'; -# if defined(USE_THREADS) +# if defined(USE_5005THREADS) /* case 4 above */ END @@ -659,7 +601,7 @@ for $sym (sort keys %thread) { print EM <<'END'; -# else /* !USE_THREADS */ +# else /* !USE_5005THREADS */ /* case 1 above */ END @@ -670,8 +612,7 @@ for $sym (sort keys %thread) { print EM <<'END'; -# endif /* USE_THREADS */ -# endif /* PERL_OBJECT */ +# endif /* USE_5005THREADS */ #endif /* MULTIPLICITY */ #if defined(PERL_GLOBAL_STRUCT) @@ -711,63 +652,6 @@ 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 data in embed.pl, pp.sym, intrpvar.h, - perlvars.h and thrdvar.h. Any changes made here will be lost! -*/ - -#ifndef __objXSUB_h__ -#define __objXSUB_h__ - -/* method calls via pPerl (static functions without a "this" pointer need these) */ - -#if defined(PERL_CORE) && defined(PERL_OBJECT) - -/* XXX soon to be eliminated, only a few things in PERLCORE need these now */ - -EOT - -walk_table { - my $ret = ""; - if (@_ == 1) { - my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; - } - else { - my ($flags,$retval,$func,@args) = @_; - if ($flags =~ /A/ && $flags !~ /j/) { # API function needing macros - 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"); - } - } - } - $ret; -} \*OBX; - -# NOTE: not part of API -#for $sym (sort keys %ppsym) { -# $sym =~ s/^Perl_//; -# print OBX undefine("Perl_$sym") . hide("Perl_$sym", "pPerl->Perl_$sym"); -# print OBX undefine($sym) . hide($sym, "Perl_$sym"); -#} - -print OBX <<'EOT'; - -#endif /* PERL_CORE && PERL_OBJECT */ -#endif /* __objXSUB_h__ */ -EOT - -close(OBX); - unlink 'perlapi.h'; unlink 'perlapi.c'; open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n"; @@ -783,14 +667,7 @@ print CAPIH <<'EOT'; #ifndef __perlapi_h__ #define __perlapi_h__ -#if defined(PERL_OBJECT) || defined (MULTIPLICITY) - -#if defined(PERL_OBJECT) -# undef aTHXo -# define aTHXo pPerl -# undef aTHXo_ -# define aTHXo_ aTHXo, -#endif /* PERL_OBJECT */ +#if defined (MULTIPLICITY) START_EXTERN_C @@ -798,9 +675,9 @@ START_EXTERN_C #undef PERLVARA #undef PERLVARI #undef PERLVARIC -#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHXo); +#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX); #define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \ - EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHXo); + EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX); #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v, const t) @@ -850,7 +727,7 @@ EXT void *PL_force_link_funcs[] = { }; #endif /* DOINIT */ -START_EXTERN_C +END_EXTERN_C #endif /* PERL_NO_FORCE_LINK */ @@ -873,7 +750,7 @@ foreach $sym (sort keys %globvar) { print CAPIH <<'EOT'; #endif /* !PERL_CORE */ -#endif /* PERL_OBJECT || MULTIPLICITY */ +#endif /* MULTIPLICITY */ #endif /* __perlapi_h__ */ @@ -890,7 +767,7 @@ print CAPI <<'EOT'; #include "perl.h" #include "perlapi.h" -#if defined(PERL_OBJECT) || defined (MULTIPLICITY) +#if defined (MULTIPLICITY) /* accessor functions for Perl variables (provides binary compatibility) */ START_EXTERN_C @@ -900,17 +777,10 @@ START_EXTERN_C #undef PERLVARI #undef PERLVARIC -#if defined(PERL_OBJECT) -#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->interp.v); } -#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->interp.v); } -#else /* MULTIPLICITY */ #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \ { return &(aTHX->v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \ { return &(aTHX->v); } -#endif #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v, const t) @@ -920,12 +790,12 @@ START_EXTERN_C #undef PERLVAR #undef PERLVARA -#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \ +#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \ { return &(PL_##v); } -#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ +#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \ { return &(PL_##v); } #undef PERLVARIC -#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHXo) \ +#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \ { return (const t *)&(PL_##v); } #include "perlvars.h" @@ -934,14 +804,16 @@ START_EXTERN_C #undef PERLVARI #undef PERLVARIC -#if defined(PERL_OBJECT) - -/* C-API layer for PERL_OBJECT */ +END_EXTERN_C +#endif /* MULTIPLICITY */ EOT +close(CAPI); + # functions that take va_list* for implementing vararg functions # NOTE: makedef.pl must be updated if you add symbols to %vfuncs +# XXX %vfuncs currently unused my %vfuncs = qw( Perl_croak Perl_vcroak Perl_warn Perl_vwarn @@ -960,138 +832,6 @@ my %vfuncs = qw( Perl_default_protect Perl_vdefault_protect ); -sub emit_func { - my ($addcontext, $rettype,$func,@args) = @_; - my @aargs = @args; - my $a; - for $a (@aargs) { $a =~ s/^.*\b(\w+)$/$1/ } - my $ctxarg = ''; - if (not $addcontext) { - $ctxarg = 'pTHXo'; - $ctxarg .= '_ ' if @args; - } - my $decl = ''; - if ($addcontext) { - $decl .= " dTHXo;\n"; - } - local $" = ', '; - my $return = ($rettype =~ /^\s*(void|Free_t|Signal_t)\s*$/ - ? '' : 'return '); - my $emitval = ''; - if (@args and $args[$#args] =~ /\.\.\./) { - pop @aargs; - my $retarg = ''; - my $ctxfunc = $func; - $ctxfunc =~ s/_nocontext$//; - return $emitval unless exists $vfuncs{$ctxfunc}; - if (length $return) { - $decl .= " $rettype retval;\n"; - $retarg .= "retval = "; - $return = "\n " . $return . "retval;\n"; - } - $emitval .= <$vfuncs{$ctxfunc}(@aargs, &args); - va_end(args);$return -} -EOT - } - else { - $emitval .= <$func(@aargs); -} -EOT - } - $emitval; -} - -# XXXX temporary hack -for $sym (qw( - perl_construct - perl_destruct - perl_free - perl_run - perl_parse - )) -{ - $skipapi_funcs{$sym}++; -} - -walk_table { - my $ret = ""; - if (@_ == 1) { - my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; - } - else { - my ($flags,$retval,$func,@args) = @_; - return $ret if exists $skipapi_funcs{$func}; - if ($flags =~ /A/ && $flags !~ /j/) { # in public API, needed for XSUBS - $ret .= "\n"; - my $addctx = 1 if $flags =~ /n/; - if ($flags =~ /p/) { - $ret .= undefine("Perl_$func"); - $ret .= emit_func($addctx,$retval,"Perl_$func",@args); - } - else { - $ret .= undefine($func); - $ret .= emit_func($addctx,$retval,$func,@args); - } - } - } - $ret; -} \*CAPI; - -# NOTE: not part of the API -#for $sym (sort keys %ppsym) { -# $sym =~ s/^Perl_//; -# print CAPI "\n"; -# print CAPI undefine("Perl_$sym"); -# if ($sym =~ /^ck_/) { -# print CAPI emit_func(0, 'OP *',"Perl_$sym",'OP *o'); -# } -# else { # pp_foo -# print CAPI emit_func(0, 'OP *',"Perl_$sym"); -# } -#} - -print CAPI <<'EOT'; - -#undef Perl_fprintf_nocontext -int -Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) -{ - dTHXo; - va_list(arglist); - va_start(arglist, format); - return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist); -} - -#undef Perl_printf_nocontext -int -Perl_printf_nocontext(const char *format, ...) -{ - dTHXo; - va_list(arglist); - va_start(arglist, format); - return (*PL_StdIO->pVprintf)(PL_StdIO, PerlIO_stdout(), format, arglist); -} - -END_EXTERN_C - -#endif /* PERL_OBJECT */ -#endif /* PERL_OBJECT || MULTIPLICITY */ -EOT - -close(CAPI); - # autogenerate documentation from comments in source files my %apidocs; @@ -1314,6 +1054,7 @@ __END__ : : flags are single letters with following meanings: : A member of public API +: C wrap compatibility macro in #ifdef DCRIPPLED_CC : d function has documentation with its source : s static function, should have an S_ prefix in source : file @@ -1322,7 +1063,6 @@ __END__ : f function takes printf style format string, varargs : r function never returns : o has no compatibility macro (#define foo Perl_foo) -: j not a member of CPerlObj : x not exported : M may change : @@ -1334,24 +1074,24 @@ __END__ START_EXTERN_C #if defined(PERL_IMPLICIT_SYS) -Ajno |PerlInterpreter* |perl_alloc_using \ +Ano |PerlInterpreter* |perl_alloc_using \ |struct IPerlMem* m|struct IPerlMem* ms \ |struct IPerlMem* mp|struct IPerlEnv* e \ |struct IPerlStdIO* io|struct IPerlLIO* lio \ |struct IPerlDir* d|struct IPerlSock* s \ |struct IPerlProc* p #endif -Ajnod |PerlInterpreter* |perl_alloc -Ajnod |void |perl_construct |PerlInterpreter* interp -Ajnod |void |perl_destruct |PerlInterpreter* interp -Ajnod |void |perl_free |PerlInterpreter* interp -Ajnod |int |perl_run |PerlInterpreter* interp -Ajnod |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \ +Anod |PerlInterpreter* |perl_alloc +Anod |void |perl_construct |PerlInterpreter* interp +Anod |int |perl_destruct |PerlInterpreter* interp +Anod |void |perl_free |PerlInterpreter* interp +Anod |int |perl_run |PerlInterpreter* interp +Anod |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \ |int argc|char** argv|char** env #if defined(USE_ITHREADS) -Ajnod |PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags +Anod |PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags # if defined(PERL_IMPLICIT_SYS) -Ajno |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \ +Ano |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \ |struct IPerlMem* m|struct IPerlMem* ms \ |struct IPerlMem* mp|struct IPerlEnv* e \ |struct IPerlStdIO* io|struct IPerlLIO* lio \ @@ -1360,37 +1100,21 @@ Ajno |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \ # endif #endif -Ajnop |Malloc_t|malloc |MEM_SIZE nbytes -Ajnop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size -Ajnop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes -Ajnop |Free_t |mfree |Malloc_t where +Anop |Malloc_t|malloc |MEM_SIZE nbytes +Anop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size +Anop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes +Anop |Free_t |mfree |Malloc_t where #if defined(MYMALLOC) -jnp |MEM_SIZE|malloced_size |void *p +np |MEM_SIZE|malloced_size |void *p #endif -Ajnp |void* |get_context -Ajnp |void |set_context |void *thx +Anp |void* |get_context +Anp |void |set_context |void *thx END_EXTERN_C /* functions with flag 'n' should come before here */ -#if defined(PERL_OBJECT) -class CPerlObj { -public: - struct interpreter interp; - CPerlObj(IPerlMem*, IPerlMem*, IPerlMem*, IPerlEnv*, IPerlStdIO*, - IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); - void* operator new(size_t nSize, IPerlMem *pvtbl); -#ifndef __BORLANDC__ - static void operator delete(void* pPerl, IPerlMem *pvtbl); -#endif - int do_aspawn (void *vreally, void **vmark, void **vsp); -#endif -#if defined(PERL_OBJECT) -public: -#else START_EXTERN_C -#endif # include "pp_proto.h" Ap |SV* |amagic_call |SV* left|SV* right|int method|int dir Ap |bool |Gv_AMupdate |HV* stash @@ -1399,8 +1123,6 @@ p |OP* |append_elem |I32 optype|OP* head|OP* tail p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp Ap |void |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len -p |void |atfork_lock -p |void |atfork_unlock Ap |SV* |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash Ap |bool |avhv_exists_ent|AV *ar|SV* keysv|U32 hash Ap |SV** |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash @@ -1439,7 +1161,7 @@ Ap |UV |cast_uv |NV f #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) Ap |I32 |my_chsize |int fd|Off_t length #endif -#if defined(USE_THREADS) +#if defined(USE_5005THREADS) Ap |MAGIC* |condpair_magic |SV *sv #endif p |OP* |convert |I32 optype|I32 flags|OP* o @@ -1549,7 +1271,7 @@ Apd |char* |fbm_instr |unsigned char* big|unsigned char* bigend \ |SV* littlesv|U32 flags p |char* |find_script |char *scriptname|bool dosearch \ |char **search_ext|I32 flags -#if defined(USE_THREADS) +#if defined(USE_5005THREADS) p |PADOFFSET|find_threadsv|const char *name #endif p |OP* |force_list |OP* arg @@ -1685,8 +1407,11 @@ Apd |void |load_module|U32 flags|SV* name|SV* ver|... Ap |void |vload_module|U32 flags|SV* name|SV* ver|va_list* args p |OP* |localize |OP* arg|I32 lexical Apd |I32 |looks_like_number|SV* sv +Apd |UV |grok_bin |char* start|STRLEN* len|I32* flags|NV *result +Apd |UV |grok_hex |char* start|STRLEN* len|I32* flags|NV *result Apd |int |grok_number |const char *pv|STRLEN len|UV *valuep Apd |bool |grok_numeric_radix|const char **sp|const char *send +Apd |UV |grok_oct |char* start|STRLEN* len|I32* flags|NV *result p |int |magic_clearenv |SV* sv|MAGIC* mg p |int |magic_clear_all_env|SV* sv|MAGIC* mg p |int |magic_clearpack|SV* sv|MAGIC* mg @@ -1707,7 +1432,7 @@ p |int |magic_gettaint |SV* sv|MAGIC* mg p |int |magic_getuvar |SV* sv|MAGIC* mg p |int |magic_getvec |SV* sv|MAGIC* mg p |U32 |magic_len |SV* sv|MAGIC* mg -#if defined(USE_THREADS) +#if defined(USE_5005THREADS) p |int |magic_mutexfree|SV* sv|MAGIC* mg #endif p |int |magic_nextpack |SV* sv|MAGIC* mg|SV* key @@ -1747,6 +1472,7 @@ p |char* |mem_collxfrm |const char* s|STRLEN len|STRLEN* xlen Afp |SV* |mess |const char* pat|... Ap |SV* |vmess |const char* pat|va_list* args p |void |qerror |SV* err +Apd |void |sortsv |SV ** array|size_t num_elts|SVCOMPARE_t f Apd |int |mg_clear |SV* sv Apd |int |mg_copy |SV* sv|SV* nsv|const char* key|I32 klen Apd |MAGIC* |mg_find |SV* sv|int type @@ -1771,6 +1497,9 @@ Anp |char* |my_bzero |char* loc|I32 len Apr |void |my_exit |U32 status Apr |void |my_failure_exit Ap |I32 |my_fflush_all +Anp |Pid_t |my_fork +Anp |void |atfork_lock +Anp |void |atfork_unlock Ap |I32 |my_lstat #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) Anp |I32 |my_memcmp |const char* s1|const char* s2|I32 len @@ -1778,11 +1507,9 @@ Anp |I32 |my_memcmp |const char* s1|const char* s2|I32 len #if !defined(HAS_MEMSET) Anp |void* |my_memset |char* loc|I32 ch|I32 len #endif -#if !defined(PERL_OBJECT) Ap |I32 |my_pclose |PerlIO* ptr Ap |PerlIO*|my_popen |char* cmd|char* mode Ap |PerlIO*|my_popen_list |char* mode|int n|SV ** args -#endif Ap |void |my_setenv |char* nam|char* val Ap |I32 |my_stat Ap |char * |my_strftime |char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst @@ -1865,15 +1592,7 @@ p |void |pad_reset p |void |pad_swipe |PADOFFSET po p |void |peep |OP* o dopM |PerlIO*|start_glob |SV* pattern|IO *io -#if defined(PERL_OBJECT) -Aox |void |Perl_construct -Aox |void |Perl_destruct -Aox |void |Perl_free -Aox |int |Perl_run -Aox |int |Perl_parse |XSINIT_t xsinit \ - |int argc|char** argv|char** env -#endif -#if defined(USE_THREADS) +#if defined(USE_5005THREADS) Ap |struct perl_thread* |new_struct_thread|struct perl_thread *t #endif Ap |void |call_atexit |ATEXIT_t fn|void *ptr @@ -1982,10 +1701,10 @@ p |OP* |scalar |OP* o p |OP* |scalarkids |OP* o p |OP* |scalarseq |OP* o p |OP* |scalarvoid |OP* o -Ap |NV |scan_bin |char* start|STRLEN len|STRLEN* retlen -Ap |NV |scan_hex |char* start|STRLEN len|STRLEN* retlen +Apd |NV |scan_bin |char* start|STRLEN len|STRLEN* retlen +Apd |NV |scan_hex |char* start|STRLEN len|STRLEN* retlen Ap |char* |scan_num |char* s|YYSTYPE *lvalp -Ap |NV |scan_oct |char* start|STRLEN len|STRLEN* retlen +Apd |NV |scan_oct |char* start|STRLEN len|STRLEN* retlen p |OP* |scope |OP* o Ap |char* |screaminstr |SV* bigsv|SV* littlesv|I32 start_shift \ |I32 end_shift|I32 *state|I32 last @@ -2005,9 +1724,10 @@ Apd |IO* |sv_2io |SV* sv Apd |IV |sv_2iv |SV* sv Apd |SV* |sv_2mortal |SV* sv Apd |NV |sv_2nv |SV* sv -Aop |char* |sv_2pv |SV* sv|STRLEN* lp +ACp |char* |sv_2pv |SV* sv|STRLEN* lp Apd |char* |sv_2pvutf8 |SV* sv|STRLEN* lp Apd |char* |sv_2pvbyte |SV* sv|STRLEN* lp +ACp |char* |sv_pvn_nomg |SV* sv|STRLEN* lp Apd |UV |sv_2uv |SV* sv Apd |IV |sv_iv |SV* sv Apd |UV |sv_uv |SV* sv @@ -2022,8 +1742,8 @@ Apd |SV* |sv_bless |SV* sv|HV* stash Afpd |void |sv_catpvf |SV* sv|const char* pat|... Ap |void |sv_vcatpvf |SV* sv|const char* pat|va_list* args Apd |void |sv_catpv |SV* sv|const char* ptr -Aopd |void |sv_catpvn |SV* sv|const char* ptr|STRLEN len -Aopd |void |sv_catsv |SV* dsv|SV* ssv +ACpd |void |sv_catpvn |SV* sv|const char* ptr|STRLEN len +ACpd |void |sv_catsv |SV* dsv|SV* ssv Apd |void |sv_chop |SV* sv|char* ptr pd |I32 |sv_clean_all pd |void |sv_clean_objs @@ -2058,7 +1778,7 @@ Apd |SV* |sv_newref |SV* sv Ap |char* |sv_peek |SV* sv Apd |void |sv_pos_u2b |SV* sv|I32* offsetp|I32* lenp Apd |void |sv_pos_b2u |SV* sv|I32* offsetp -Aopd |char* |sv_pvn_force |SV* sv|STRLEN* lp +ACpd |char* |sv_pvn_force |SV* sv|STRLEN* lp Apd |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp Apd |char* |sv_pvbyten_force|SV* sv|STRLEN* lp Apd |char* |sv_reftype |SV* sv|int ob @@ -2079,7 +1799,7 @@ Apd |SV* |sv_setref_pvn |SV* rv|const char* classname|char* pv \ |STRLEN n Apd |void |sv_setpv |SV* sv|const char* ptr Apd |void |sv_setpvn |SV* sv|const char* ptr|STRLEN len -Aopd |void |sv_setsv |SV* dsv|SV* ssv +ACpd |void |sv_setsv |SV* dsv|SV* ssv Apd |void |sv_taint |SV* sv Apd |bool |sv_tainted |SV* sv Apd |int |sv_unmagic |SV* sv|int type @@ -2106,7 +1826,7 @@ Ap |UV |to_utf8_title |U8 *p #if defined(UNLINK_ALL_VERSIONS) Ap |I32 |unlnk |char* f #endif -#if defined(USE_THREADS) +#if defined(USE_5005THREADS) Ap |void |unlock_condpair|void* svv #endif Ap |void |unsharepvn |const char* sv|I32 len|U32 hash @@ -2163,7 +1883,7 @@ Ap |struct perl_vars *|GetVars #endif Ap |int |runops_standard Ap |int |runops_debug -#if defined(USE_THREADS) +#if defined(USE_5005THREADS) Ap |SV* |sv_lock |SV *sv #endif Afpd |void |sv_catpvf_mg |SV *sv|const char* pat|... @@ -2182,8 +1902,9 @@ Apd |void |sv_setpvn_mg |SV *sv|const char *ptr|STRLEN len Apd |void |sv_setsv_mg |SV *dstr|SV *sstr Apd |void |sv_usepvn_mg |SV *sv|char *ptr|STRLEN len Ap |MGVTBL*|get_vtbl |int vtbl_id -p |char* |pv_display |SV *sv|char *pv|STRLEN cur|STRLEN len \ +p |char* |pv_display |SV *dsv|char *pv|STRLEN cur|STRLEN len \ |STRLEN pvlim +p |char* |sv_uni_display |SV *dsv|SV *ssv|STRLEN pvlim Afp |void |dump_indent |I32 level|PerlIO *file|const char* pat|... Ap |void |dump_vindent |I32 level|PerlIO *file|const char* pat \ |va_list *args @@ -2210,7 +1931,7 @@ Apd |char* |sv_2pvbyte_nolen|SV* sv Apd |char* |sv_pv |SV *sv Apd |char* |sv_pvutf8 |SV *sv Apd |char* |sv_pvbyte |SV *sv -Aopd |STRLEN |sv_utf8_upgrade|SV *sv +ACpd |STRLEN |sv_utf8_upgrade|SV *sv ApdM |bool |sv_utf8_downgrade|SV *sv|bool fail_ok Apd |void |sv_utf8_encode |SV *sv ApdM |bool |sv_utf8_decode |SV *sv @@ -2230,7 +1951,7 @@ Ap |PERL_SI*|si_dup |PERL_SI* si|clone_params* param Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|clone_params* param Ap |void* |any_dup |void* v|PerlInterpreter* proto_perl Ap |HE* |he_dup |HE* e|bool shared|clone_params* param -Ap |REGEXP*|re_dup |REGEXP* r +Ap |REGEXP*|re_dup |REGEXP* r|clone_params* param Ap |PerlIO*|fp_dup |PerlIO* fp|char type Ap |DIR* |dirp_dup |DIR* dp Ap |GP* |gp_dup |GP* gp|clone_params* param @@ -2252,11 +1973,11 @@ Ap |void |sys_intern_clear Ap |void |sys_intern_init #endif -#if defined(PERL_OBJECT) -protected: -#else +Ap |char * |custom_op_name|OP* op +Ap |char * |custom_op_desc|OP* op + + END_EXTERN_C -#endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) s |I32 |avhv_index_sv |SV* sv @@ -2354,7 +2075,7 @@ s |void* |vrun_body |va_list args s |void* |vcall_body |va_list args s |void* |vcall_list_body|va_list args #endif -# if defined(USE_THREADS) +# if defined(USE_5005THREADS) s |struct perl_thread * |init_main_thread # endif #endif @@ -2387,7 +2108,6 @@ s |I32 |dopoptosub_at |PERL_CONTEXT* cxstk|I32 startingblock s |void |save_lines |AV *array|SV *sv s |OP* |doeval |int gimme|OP** startop s |PerlIO *|doopen_pmc |const char *name|const char *mode -s |void |qsortsv |SV ** array|size_t num_elts|SVCOMPARE_t f #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) @@ -2472,6 +2192,17 @@ s |void |debprof |OP *o s |SV* |save_scalar_at |SV **sptr #endif +#if defined(USE_ITHREADS) +Adp |void |sharedsv_init +Adp |shared_sv* |sharedsv_new +Adp |shared_sv* |sharedsv_find |SV* sv +Adp |void |sharedsv_lock |shared_sv* ssv +Adp |void |sharedsv_unlock |shared_sv* ssv +p |void |sharedsv_unlock_scope |shared_sv* ssv +Adp |void |sharedsv_thrcnt_inc |shared_sv* ssv +Adp |void |sharedsv_thrcnt_dec |shared_sv* ssv +#endif + #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) s |IV |asIV |SV* sv s |UV |asUV |SV* sv @@ -2533,7 +2264,7 @@ s |SV* |gv_share |SV *sv #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 +s |char* |force_version |char *start|int guessing s |char* |force_word |char *start|int token|int check_keyword \ |int allow_pack|int allow_tick s |SV* |tokeq |SV *sv @@ -2595,16 +2326,13 @@ s |char* |stdize_locale |char* locs #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |COP* |closest_cop |COP *cop|OP *o s |SV* |mess_alloc # if defined(LEAKTEST) s |void |xstat |int # endif #endif -#if defined(PERL_OBJECT) -}; -#endif - START_EXTERN_C Apd |void |sv_setsv_flags |SV* dsv|SV* ssv|I32 flags