diff options
author | Daniel Dragan <bulk88@hotmail.com> | 2014-11-15 23:45:19 -0500 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2014-11-15 22:23:19 -0800 |
commit | bb6a367ad5d39a6d163bda06f6788f8e7833b713 (patch) | |
tree | a9e1341f0d27938b5e8a1f4184e3b24aaed65ad0 | |
parent | f8d5a52263698f3448751c5ac18d2b5edac28b36 (diff) | |
download | perl-bb6a367ad5d39a6d163bda06f6788f8e7833b713.tar.gz |
misc optimizing in DynaLoader
dl_last_error is "#define dl_last_error (SvPVX(MY_CXT.x_dl_last_error))"
since the data is already in a SV *, use newSVsv instead of turning it into
a strlen-ed (eventually) char *.
-win32 dl_load_file never uses flags, so don't do a SvIV in void context
- dl_load_file cant use "flags=NULL" because of test
"calling DynaLoader::dl_load_file() with no argument" in DynaLoader.t
-OS_Error_String stop repeatedly computing address into MY_CXT and
derefing after PerlProc_GetOSError
function sizes in machine code bytes on VC 2003
b4 0x69 OS_Error_String af 0x67
b4 0x9D _XS_DynaLoader_dl_error af 0x6B
b4 0x108 _XS_DynaLoader_dl_load_file af 0xD6
-rw-r--r-- | ext/DynaLoader/DynaLoader_pm.PL | 2 | ||||
-rw-r--r-- | ext/DynaLoader/dl_aix.xs | 4 | ||||
-rw-r--r-- | ext/DynaLoader/dl_dllload.xs | 4 | ||||
-rw-r--r-- | ext/DynaLoader/dl_dlopen.xs | 4 | ||||
-rw-r--r-- | ext/DynaLoader/dl_dyld.xs | 4 | ||||
-rw-r--r-- | ext/DynaLoader/dl_freemint.xs | 7 | ||||
-rw-r--r-- | ext/DynaLoader/dl_hpux.xs | 4 | ||||
-rw-r--r-- | ext/DynaLoader/dl_symbian.xs | 4 | ||||
-rw-r--r-- | ext/DynaLoader/dl_vms.xs | 6 | ||||
-rw-r--r-- | ext/DynaLoader/dl_win32.xs | 29 | ||||
-rw-r--r-- | ext/DynaLoader/dlutils.c | 3 | ||||
-rw-r--r-- | pod/perldelta.pod | 4 |
12 files changed, 44 insertions, 31 deletions
diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index e3df1cd1d8..2809e46892 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -85,7 +85,7 @@ package DynaLoader; # Tim.Bunce@ig.co.uk, August 1994 BEGIN { - $VERSION = '1.27'; + $VERSION = '1.28'; } use Config; diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 548e4ed973..dc20b74256 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -759,11 +759,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") XS_DYNAMIC_FILENAME))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error ; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dllload.xs b/ext/DynaLoader/dl_dllload.xs index ff0c7a9572..1f99b61247 100644 --- a/ext/DynaLoader/dl_dllload.xs +++ b/ext/DynaLoader/dl_dllload.xs @@ -184,11 +184,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") XSRETURN(1); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error ; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 2759709d2e..c3df9eacf9 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -259,11 +259,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") XS_DYNAMIC_FILENAME))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error ; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dyld.xs b/ext/DynaLoader/dl_dyld.xs index 2ed10bb6bc..3027ddae9a 100644 --- a/ext/DynaLoader/dl_dyld.xs +++ b/ext/DynaLoader/dl_dyld.xs @@ -213,11 +213,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") XS_DYNAMIC_FILENAME))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error ; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_freemint.xs b/ext/DynaLoader/dl_freemint.xs index f154dcbec6..0bf620ed5d 100644 --- a/ext/DynaLoader/dl_freemint.xs +++ b/ext/DynaLoader/dl_freemint.xs @@ -191,12 +191,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") XS_DYNAMIC_FILENAME))); XSRETURN(1); -char * +SV * dl_error() - PREINIT: - dMY_CXT; CODE: - RETVAL = dl_last_error ; + dMY_CXT; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index 6c7b3e4d8a..2844d2a05f 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -171,11 +171,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") filename, NULL, XS_DYNAMIC_FILENAME))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error ; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_symbian.xs b/ext/DynaLoader/dl_symbian.xs index b509a6a19f..c17f397487 100644 --- a/ext/DynaLoader/dl_symbian.xs +++ b/ext/DynaLoader/dl_symbian.xs @@ -213,11 +213,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") XS_DYNAMIC_FILENAME))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index 23cf11b97d..bc9782cced 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -347,13 +347,13 @@ dl_install_xsub(perl_name, symref, filename="$Package") XS_DYNAMIC_FILENAME))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error ; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: - RETVAL + RETVAL #if defined(USE_ITHREADS) diff --git a/ext/DynaLoader/dl_win32.xs b/ext/DynaLoader/dl_win32.xs index ac59e11f53..178ca7c142 100644 --- a/ext/DynaLoader/dl_win32.xs +++ b/ext/DynaLoader/dl_win32.xs @@ -47,10 +47,13 @@ OS_Error_String(pTHX) dMY_CXT; DWORD err = GetLastError(); STRLEN len; - if (!dl_error_sv) - dl_error_sv = newSVpvs(""); - PerlProc_GetOSError(dl_error_sv,err); - return SvPV(dl_error_sv,len); + SV ** l_dl_error_svp = &dl_error_sv; + SV * l_dl_error_sv; + if (!*l_dl_error_svp) + *l_dl_error_svp = newSVpvs(""); + l_dl_error_sv = *l_dl_error_svp; + PerlProc_GetOSError(l_dl_error_sv,err); + return SvPV(l_dl_error_sv,len); } static void @@ -114,11 +117,14 @@ BOOT: void dl_load_file(filename,flags=0) char * filename - int flags +#flags is unused + SV * flags = NO_INIT PREINIT: void *retv; + SV * retsv; CODE: { + PERL_UNUSED_VAR(flags); DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename)); if (dl_static_linked(filename) == 0) { retv = PerlProc_DynaLoad(filename); @@ -126,12 +132,15 @@ dl_load_file(filename,flags=0) else retv = (void*) Win_GetModuleHandle(NULL); DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", retv)); - ST(0) = sv_newmortal() ; - if (retv == NULL) + + if (retv == NULL) { SaveError(aTHX_ "load_file:%s", OS_Error_String(aTHX)) ; + retsv = &PL_sv_undef; + } else - sv_setiv( ST(0), (IV)retv); + retsv = sv_2mortal(newSViv((IV)retv)); + ST(0) = retsv; } int @@ -186,11 +195,11 @@ dl_install_xsub(perl_name, symref, filename="$Package") filename))); -char * +SV * dl_error() CODE: dMY_CXT; - RETVAL = dl_last_error; + RETVAL = newSVsv(MY_CXT.x_dl_last_error); OUTPUT: RETVAL diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index f8b23ccf0e..96ea8befa5 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -79,12 +79,13 @@ dl_unload_all_files(pTHX_ void *unused) if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) { dl_librefs = get_av("DynaLoader::dl_librefs", 0); + EXTEND(SP,1); while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) { dSP; ENTER; SAVETMPS; PUSHMARK(SP); - XPUSHs(sv_2mortal(dl_libref)); + PUSHs(sv_2mortal(dl_libref)); PUTBACK; call_sv((SV*)sub, G_DISCARD | G_NODEBUG); FREETMPS; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 1e4e7b2c7f..793cc839b8 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -144,6 +144,10 @@ L<IO::Socket> has been upgraded from version 1.37 to 1.38. Document the limitations of the isconnected() method. [perl #123096] +=item * + +L<DynaLoader> has been upgraded from version 1.27 to 1.28. + =back =head2 Removed Modules and Pragmata |