<?xml version="1.0" encoding="windows-1252"?>
<node id="995945" title="Re^12: Use perl type without perl" created="2012-09-27 04:09:05" updated="2012-09-27 04:09:05">
<type id="11">
note</type>
<author id="857302">
bulk88</author>
<data>
<field name="doctext">
&lt;blockquote&gt;&lt;p&gt;By any body's standards, a whole 5 billionths of a second difference is hardly "huge". (Which was your assertion).

&lt;/p&gt;&lt;p&gt;And if the body of the loop did anything useful -- like call one or two of the huge macros or long twisty functions that are the reason for having the context within the sub in the first place --then those 5 nanoseconds would just disappear into the noise.


&lt;/p&gt;
&lt;/blockquote&gt;
The 5 nanoseconds can not disappear into the noise. They are not free. If they ran, they cost time. Whether it is 1 ns vs 5 ns, or 1 ms vs 5 ms, or 1 minute vs 5 minutes, the smaller choice is better. Lets see how many times Perl_get_context is called for the simplest of Perl programs. PGC=Perl_get_context.
&lt;code&gt;
C:\p517\perl\win32&gt;perl -e "for(0..5) {print 'hello world'.\"\n\";};"
hello world
hello world
hello world
hello world
hello world
hello world
PGC count 1096

C:\p517\perl\win32&gt;perl -e "print 'hello world'";
hello worldPGC count 1069

C:\p517\perl\win32&gt;perl -e "system('pause');"
Press any key to continue . . .
PGC count 1133

C:\p517\perl\win32&gt;
&lt;/code&gt;
&lt;readmore&gt;
&lt;code&gt;
/*perllib.c*/
EXTERN_C HANDLE w32_perldll_handle;
EXTERN_C int PGC_Count;

EXTERN_C DllExport int
RunPerl(int argc, char **argv, char **env)
{
    int exitstatus;
    PerlInterpreter *my_perl, *new_perl = NULL;
    OSVERSIONINFO osver;
    char szModuleName[MAX_PATH];
    char *arg0 = argv[0];
    char *ansi = NULL;
    bool use_environ = (env == environ);

    osver.dwOSVersionInfoSize = sizeof(osver);
    GetVersionEx(&amp;osver);

    if (osver.dwMajorVersion &gt; 4) {
        WCHAR widename[MAX_PATH];
        GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR));
        argv[0] = ansi = win32_ansipath(widename);
    }
    else {
        Win_GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
        (void)win32_longpath(szModuleName);
        argv[0] = szModuleName;
    }

#ifdef PERL_GLOBAL_STRUCT
#define PERLVAR(prefix,var,type) /**/
#define PERLVARA(prefix,var,type) /**/
#define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
#define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#endif

    PERL_SYS_INIT(&amp;argc,&amp;argv);

    if (!(my_perl = perl_alloc()))
	return (1);
    perl_construct(my_perl);
    PL_perl_destruct_level = 0;

    /* PERL_SYS_INIT() may update the environment, e.g. via ansify_path().
     * This may reallocate the RTL environment block. Therefore we need
     * to make sure that `env` continues to have the same value as `environ`
     * if we have been called this way.  If we have been called with any
     * other value for `env` then all environment munging by PERL_SYS_INIT()
     * will be lost again.
     */
    if (use_environ)
        env = environ;

    exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
    if (!exitstatus) {
#if defined(TOP_CLONE) &amp;&amp; defined(USE_ITHREADS)		/* XXXXXX testing */
	new_perl = perl_clone(my_perl, 1);
	exitstatus = perl_run(new_perl);
	PERL_SET_THX(my_perl);
#else
	exitstatus = perl_run(my_perl);
#endif
    }

    perl_destruct(my_perl);
    perl_free(my_perl);
#ifdef USE_ITHREADS
    if (new_perl) {
	PERL_SET_THX(new_perl);
	perl_destruct(new_perl);
	perl_free(new_perl);
    }
#endif

    /* Some RTLs may want to free argv[] after main() returns. */
    argv[0] = arg0;
    if (ansi)
        win32_free(ansi);

    PERL_SYS_TERM();
    
	fprintf(stderr, "PGC count %u\n", PGC_Count);
    return (exitstatus);
}
&lt;/code&gt;
&lt;code&gt;
/*win32thread.c*/
int PGC_Count = 0;

void
Perl_set_context(void *t)
{
#if defined(USE_ITHREADS)
#  ifdef USE_DECLSPEC_THREAD
    Perl_current_context = t;
#  else
    DWORD err = GetLastError();
    TlsSetValue(PL_thr_key,t);
    SetLastError(err);
#  endif
#endif
}

void *
Perl_get_context(void)
{
#if defined(USE_ITHREADS)
#  ifdef USE_DECLSPEC_THREAD
    return Perl_current_context;
#  else
    DWORD err = GetLastError();
    void *result = TlsGetValue(PL_thr_key);
	PGC_Count++;
    SetLastError(err);
    return result;
#  endif
#else
    return NULL;
#endif
}
&lt;/code&gt;
&lt;/readmore&gt;
Now lets try to compile an XS module.
&lt;code&gt;

C:\Documents and Settings\Owner\Desktop\cpan libs\Win32API\g&gt;perl makefile.pl
Checking if your kit is complete...
Warning: the following files are missing in your kit:
        api-test/Release/API_test.dll
        api-test/Release/API_test.lib
Please inform the author.
Writing Makefile for Win32::API::Callback
Writing MYMETA.yml and MYMETA.json
Writing Makefile for Win32::API
Writing MYMETA.yml and MYMETA.json
PGC count 337157

C:\Documents and Settings\Owner\Desktop\cpan libs\Win32API\g&gt;nmake install

Microsoft (R) Program Maintenance Utility Version 7.10.3077
Copyright (C) Microsoft Corporation.  All rights reserved.

PGC count 29225
PGC count 29077
PGC count 29098
PGC count 29131
PGC count 29077
PGC count 29098
PGC count 29228
PGC count 29077
PGC count 29098
PGC count 29229
PGC count 29077
PGC count 29098
PGC count 29131
PGC count 29077
PGC count 29098
PGC count 29131
PGC count 29077
PGC count 29098
PGC count 29131
PGC count 29077
PGC count 29098
PGC count 29131
PGC count 29077
PGC count 29098
cp Type.pm blib\lib\Win32/API/Type.pm
cp Callback.pm blib\lib\Win32/API/Callback.pm
cp Test.pm blib\lib\Win32/API/Test.pm
cp Struct.pm blib\lib\Win32/API/Struct.pm
cp API.pm blib\lib\Win32/API.pm
cp IATPatch.pod blib\lib\Win32/API/Callback/IATPatch.pod
PGC count 135573
PGC count 29098
        nmake -f Makefile all -nologo
PGC count 29084
PGC count 29077
PGC count 29098
PGC count 29132
PGC count 29077
PGC count 29098
PGC count 29132
PGC count 29077
PGC count 29098
PGC count 29098
        C:\perl517\bin\perl.exe C:\perl517\lib\ExtUtils\xsubpp  -typemap C:\perl
517\lib\ExtUtils\typemap  Callback.xs &gt; Callback.xsc &amp;&amp; C:\perl517\bin\perl.exe
-MExtUtils::Command -e mv -- Callback.xsc Callback.c
PGC count 153957
PGC count 29098
        cl -c    -nologo -GF -W3 -MD -Zi -DNDEBUG -O1 -G7 -DWIN32 -D_CONSOLE -DN
O_STRICT -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DU
SE_PERLIO -D_USE_32BIT_TIME_T -MD -Zi -DNDEBUG -O1 -G7    -DVERSION=\"0.71\"  -D
XS_VERSION=\"0.71\"  "-IC:\perl517\lib\CORE"   Callback.c
Callback.c
Running Mkbootstrap for Win32::API::Callback ()
PGC count 1097
PGC count 11211
PGC count 29098
        C:\perl517\bin\perl.exe -MExtUtils::Command -e chmod -- 644 Callback.bs
PGC count 29077
        C:\perl517\bin\perl.exe -MExtUtils::Mksymlists  -e "Mksymlists('NAME'=&gt;\
"Win32::API::Callback\", 'DLBASE' =&gt; 'Callback', 'DL_FUNCS' =&gt; {  }, 'FUNCLIST'
=&gt; [], 'IMPORTS' =&gt; {  }, 'DL_VARS' =&gt; []);"
PGC count 13035
        link -out:..\blib\arch\auto\Win32\API\Callback\Callback.dll -dll -nologo
 -nodefaultlib -debug -opt:ref,icf  -libpath:"c:\perl517\lib\CORE"  -machine:x86
 Callback.obj   C:\perl517\lib\CORE\perl517.lib oldnames.lib kernel32.lib user32
.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib ole
aut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib odbc3
2.lib odbccp32.lib comctl32.lib msvcrt.lib -def:Callback.def
   Creating library ..\blib\arch\auto\Win32\API\Callback\Callback.lib and object
 ..\blib\arch\auto\Win32\API\Callback\Callback.exp
        if exist ..\blib\arch\auto\Win32\API\Callback\Callback.dll.manifest mt -
nologo -manifest ..\blib\arch\auto\Win32\API\Callback\Callback.dll.manifest -out
putresource:..\blib\arch\auto\Win32\API\Callback\Callback.dll;2
        if exist ..\blib\arch\auto\Win32\API\Callback\Callback.dll.manifest del
..\blib\arch\auto\Win32\API\Callback\Callback.dll.manifest
        C:\perl517\bin\perl.exe -MExtUtils::Command -e chmod -- 755 ..\blib\arch
\auto\Win32\API\Callback\Callback.dll
PGC count 29077
PGC count 35327
        C:\perl517\bin\perl.exe -MExtUtils::Command -e cp -- Callback.bs ..\blib
\arch\auto\Win32\API\Callback\Callback.bs
PGC count 37097
        C:\perl517\bin\perl.exe -MExtUtils::Command -e chmod -- 644 ..\blib\arch
\auto\Win32\API\Callback\Callback.bs
PGC count 29077
        cd ..
        C:\perl517\bin\perl.exe C:\perl517\lib\ExtUtils\xsubpp  -nolinenumbers
-typemap C:\perl517\lib\ExtUtils\typemap -typemap typemap  API.xs &gt; API.xsc &amp;&amp; C
:\perl517\bin\perl.exe -MExtUtils::Command -e mv -- API.xsc API.c
PGC count 156717
PGC count 29098
        cl -c    -nologo -GF -W3 -MD -Zi -DNDEBUG -O1 -G7 -DWIN32 -D_CONSOLE -DN
O_STRICT -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DU
SE_PERLIO -D_USE_32BIT_TIME_T -MD -Zi -DNDEBUG -O1 -G7    -DVERSION=\"0.71\"  -D
XS_VERSION=\"0.71\"  "-IC:\perl517\lib\CORE"   API.c
API.c
c:\Documents and Settings\Owner\Desktop\cpan libs\Win32API\g\call_i686.h(44) : w
arning C4101: 'pReturn' : unreferenced local variable
API.c(341) : warning C4047: '=' : 'SV *' differs in levels of indirection from '
SV ** '
Running Mkbootstrap for Win32::API ()
PGC count 1097
PGC count 11209
PGC count 29097
        C:\perl517\bin\perl.exe -MExtUtils::Command -e chmod -- 644 API.bs
PGC count 29077
        C:\perl517\bin\perl.exe -MExtUtils::Mksymlists  -e "Mksymlists('NAME'=&gt;\
"Win32::API\", 'DLBASE' =&gt; 'API', 'DL_FUNCS' =&gt; {  }, 'FUNCLIST' =&gt; [], 'IMPORTS
' =&gt; {  }, 'DL_VARS' =&gt; []);"
PGC count 13027
        link -out:blib\arch\auto\Win32\API\API.dll -dll -nologo -nodefaultlib -d
ebug -opt:ref,icf  -libpath:"c:\perl517\lib\CORE"  -machine:x86 API.obj   C:\per
l517\lib\CORE\perl517.lib oldnames.lib kernel32.lib user32.lib gdi32.lib winspoo
l.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.li
b uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib com
ctl32.lib msvcrt.lib -def:API.def
   Creating library blib\arch\auto\Win32\API\API.lib and object blib\arch\auto\W
in32\API\API.exp
        if exist blib\arch\auto\Win32\API\API.dll.manifest mt -nologo -manifest
blib\arch\auto\Win32\API\API.dll.manifest -outputresource:blib\arch\auto\Win32\A
PI\API.dll;2
        if exist blib\arch\auto\Win32\API\API.dll.manifest del blib\arch\auto\Wi
n32\API\API.dll.manifest
        C:\perl517\bin\perl.exe -MExtUtils::Command -e chmod -- 755 blib\arch\au
to\Win32\API\API.dll
PGC count 29077
PGC count 35325
        C:\perl517\bin\perl.exe -MExtUtils::Command -e cp -- API.bs blib\arch\au
to\Win32\API\API.bs
PGC count 37097
        C:\perl517\bin\perl.exe -MExtUtils::Command -e chmod -- 644 blib\arch\au
to\Win32\API\API.bs
PGC count 29077
Files found in blib\arch: installing files in blib\lib into architecture depende
nt library tree
Installing C:\perl517\site\lib\auto\Win32\API\API.dll
Installing C:\perl517\site\lib\auto\Win32\API\API.exp
Installing C:\perl517\site\lib\auto\Win32\API\API.lib
Installing C:\perl517\site\lib\auto\Win32\API\API.pdb
Installing C:\perl517\site\lib\auto\Win32\API\Callback\Callback.dll
Installing C:\perl517\site\lib\auto\Win32\API\Callback\Callback.exp
Installing C:\perl517\site\lib\auto\Win32\API\Callback\Callback.lib
Installing C:\perl517\site\lib\auto\Win32\API\Callback\Callback.pdb
PGC count 140759
PGC count 6563
Appending installation info to c:\perl517\lib/perllocal.pod
PGC count 1103
PGC count 29084
PGC count 6653

C:\Documents and Settings\Owner\Desktop\cpan libs\Win32API\g&gt;
&lt;/code&gt;
&lt;br&gt;&lt;br&gt;
Highest per process Perl_get_context count was 337157, assuming 4 ns wasted in PGC vs C stack my_perl, 1.34 ms of CPU was wasted in that process. nmake install took 11 seconds by the clock on the wall. Added all PGCs counts, comes to 2472747, * 4 ns is 9.8 ms. I am aware that 9.8ms is only %0.08 of the 11 seconds it took to run nmake install. I still say death by a 1000 cuts!
&lt;br&gt;&lt;br&gt;
Now about TLSGetValue directly.
&lt;code&gt;C:\Documents and Settings\Owner\Desktop\cpan libs\lxs&gt;perl -MLocal::XS -e "Local::
XS::CxtSpeed();"
no cxt 47237378
cxt 13202140
no cxt no last error 22624295

C:\Documents and Settings\Owner\Desktop\cpan libs\lxs&gt;
&lt;/code&gt;
&lt;readmore&gt;
&lt;code&gt;
void
CxtSpeed()
PREINIT:
    LARGE_INTEGER start;
    LARGE_INTEGER end;
    int i;
PPCODE:
    QueryPerformanceCounter(&amp;start);
    for(i=0; i &lt; 1000000000; i++){
        no_cxt();
    }
    QueryPerformanceCounter(&amp;end);
    printf("no cxt %I64u\n", end.QuadPart-start.QuadPart);
    QueryPerformanceCounter(&amp;start);
    for(i=0; i &lt; 1000000000; i++){
        cxt(aTHX);
    }
    QueryPerformanceCounter(&amp;end);
    printf("cxt %I64u\n", end.QuadPart-start.QuadPart);
    QueryPerformanceCounter(&amp;start);
    for(i=0; i &lt; 1000000000; i++){
        no_cxt_no_glr();
    }
    QueryPerformanceCounter(&amp;end);
    printf("no cxt no last error %I64u\n", end.QuadPart-start.QuadPart);
&lt;/code&gt;
&lt;code&gt;
//separate compiland
#define PERL_NO_GET_CONTEXT
#include &lt;EXTERN.h&gt;
#include &lt;perl.h&gt;
#include &lt;XSUB.h&gt;

__declspec(dllexport) int no_cxt(){
    dTHX;
    return ((int) my_perl) &gt;&gt; 1;
}
__declspec(dllexport) int cxt(pTHX){
    return ((int) my_perl) &gt;&gt; 1;
}

__declspec(dllexport) int no_cxt_no_glr(){
    void *my_perl = TlsGetValue(PL_thr_key);
    return ((int) my_perl) &gt;&gt; 1;
}
&lt;/code&gt;
&lt;/readmore&gt;
Remember to get PL_thr_key is 2 asm dereferences in XS DLL vs 1 inside the interp itself.
&lt;br&gt;&lt;br&gt;
My next reply will address your letter C.</field>
<field name="root_node">
995530</field>
<field name="parent_node">
995689</field>
</data>
</node>
