Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
My idea of stress testing the algorithm is removing the sleep from while not done loop in the sample script, and replacing the sleep with usleep(1);.

I've added mutexes guarding the getting of the callback status from the global PM hash, and the calling of the Perl method that sets the status into the global PM hash from XS.

I consider stability, FOR NOW, to be 10 runs without crashes or perl panics or strange errors on the console.
void WINAPI CALLBACK PerlCallback(HINTERNET h, DWORD context, DWORD mystatus, LPVOID mystatusinfo, DWORD mystatuslength) { DWORD myret; HINTERNET myhandle; // Let's try with perl_call_method // ...to clarify: // a C routine // called from Perl // callbacks this C routine // that callbacks a Perl routine. // ;) // if(mystatus!=status) { SV **sp; HANDLE hMutex; char mutexname [sizeof("Win32InternetPerlMutex") + sizeof(DW +ORD)*8]; DWORD waitres; //char [23 + sizeof(DWORD)*8] mutexname; //void * myptr; //printf("PerlCallback: entering\n"); printf("PerlCallback: got handle=%d context=%d mystatus=%d\n", +h,context,mystatus); //printf("PerlCallback: myWin32InternetPerlInterpreterPtr=%p\n +",myWin32InternetPerlInterpreterPtr); //comment below out to trigger original crash/bug in Win32::In +ternet and recompile PERL_SET_CONTEXT(myWin32InternetPerlInterpreterPtr); //printf("PerlCallback: ThreadId=%d\n",GetCurrentThreadId()); //printf("PerlCallback: GetLastError() =%d\n",GetLastError()); //myptr = PERL_GET_CONTEXT; //printf("PerlCallback: GetLastError() =%d\n",GetLastError()); //printf("PerlCallback: pointer from Perl_get_context() =%p\n" +,myptr); //can't use dSP because we are after variable declarations sp = PL_stack_sp; ENTER; SAVETMPS; PUSHMARK(sp); // XPUSHs(sv_2mortal(newSVpv("Win32::Internet\0",0))); XPUSHs(sv_2mortal(newSViv(context))); XPUSHs(sv_2mortal(newSViv(mystatus))); switch(mystatus) { case INTERNET_STATUS_HANDLE_CREATED: myhandle=(HINTERNET) *(LPHINTERNET)mystatusinfo; XPUSHs(sv_2mortal(newSViv((DWORD) myhandle))); break; case INTERNET_STATUS_RESPONSE_RECEIVED: case INTERNET_STATUS_REQUEST_SENT: myret=(DWORD) *(LPDWORD)mystatusinfo; // printf("PerlCallback: received/sent(%d) %d bytes\n",mys +tatus,myret); XPUSHs(sv_2mortal(newSViv(myret))); break; default: XPUSHs(sv_2mortal(newSViv(0))); break; } PUTBACK; // printf("PerlCallback: calling callback with context=%d, sta +tus=%d\n",context,mystatus); sprintf(mutexname ,"Win32InternetPerlMutex%u", GetCurrentPro +cessId()); //printf("PerlCallback: mutexname=%s\n",mutexname); hMutex = OpenMutex(MUTEX_ALL_ACCESS, FALSE, mutexname); if (hMutex == NULL) printf("PerlCallback: OpenMutex error: % +d\n", GetLastError() ); else printf("PerlCallback: OpenMutex successfully opened the + mutex.\n"); waitres = WaitForSingleObject(hMutex,500000); printf("PerlCallback: wait result =%d\n",waitres); perl_call_pv("Win32::Internet::callback", G_DISCARD); printf("PerlCallback: release mutex res=%d\n",ReleaseMutex(h +Mutex)); CloseHandle(hMutex); FREETMPS; LEAVE; // } // status=mystatus; // return; }
was never stable until usleep(100000);
void WINAPI CALLBACK PerlCallback(HINTERNET h, DWORD context, DWORD mystatus, LPVOID mystatusinfo, DWORD mystatuslength) { DWORD myret; HINTERNET myhandle; // Let's try with perl_call_method // ...to clarify: // a C routine // called from Perl // callbacks this C routine // that callbacks a Perl routine. // ;) // if(mystatus!=status) { SV **sp; HANDLE hMutex; char mutexname [sizeof("Win32InternetPerlMutex") + sizeof(DW +ORD)*8]; DWORD waitres; //char [23 + sizeof(DWORD)*8] mutexname; //void * myptr; //printf("PerlCallback: entering\n"); sprintf(mutexname ,"Win32InternetPerlMutex%u", GetCurrentPro +cessId()); //printf("PerlCallback: mutexname=%s\n",mutexname); hMutex = OpenMutex(MUTEX_ALL_ACCESS, FALSE, mutexname); if (hMutex == NULL) printf("PerlCallback: OpenMutex error: % +d\n", GetLastError() ); else printf("PerlCallback: OpenMutex successfully opened the + mutex.\n"); waitres = WaitForSingleObject(hMutex,500000); printf("PerlCallback: wait result =%d\n",waitres); printf("PerlCallback: got handle=%d context=%d mystatus=%d\n", +h,context,mystatus); //printf("PerlCallback: myWin32InternetPerlInterpreterPtr=%p\n +",myWin32InternetPerlInterpreterPtr); //comment below out to trigger original crash/bug in Win32::In +ternet and recompile PERL_SET_CONTEXT(myWin32InternetPerlInterpreterPtr); //printf("PerlCallback: ThreadId=%d\n",GetCurrentThreadId()); //printf("PerlCallback: GetLastError() =%d\n",GetLastError()); //myptr = PERL_GET_CONTEXT; //printf("PerlCallback: GetLastError() =%d\n",GetLastError()); //printf("PerlCallback: pointer from Perl_get_context() =%p\n" +,myptr); //can't use dSP because we are after variable declarations sp = PL_stack_sp; ENTER; SAVETMPS; PUSHMARK(sp); // XPUSHs(sv_2mortal(newSVpv("Win32::Internet\0",0))); XPUSHs(sv_2mortal(newSViv(context))); XPUSHs(sv_2mortal(newSViv(mystatus))); switch(mystatus) { case INTERNET_STATUS_HANDLE_CREATED: myhandle=(HINTERNET) *(LPHINTERNET)mystatusinfo; XPUSHs(sv_2mortal(newSViv((DWORD) myhandle))); break; case INTERNET_STATUS_RESPONSE_RECEIVED: case INTERNET_STATUS_REQUEST_SENT: myret=(DWORD) *(LPDWORD)mystatusinfo; // printf("PerlCallback: received/sent(%d) %d bytes\n",mys +tatus,myret); XPUSHs(sv_2mortal(newSViv(myret))); break; default: XPUSHs(sv_2mortal(newSViv(0))); break; } PUTBACK; // printf("PerlCallback: calling callback with context=%d, sta +tus=%d\n",context,mystatus); perl_call_pv("Win32::Internet::callback", G_DISCARD); FREETMPS; LEAVE; printf("PerlCallback: release mutex res=%d\n",ReleaseMutex(h +Mutex)); CloseHandle(hMutex); // } // status=mystatus; // return; }
Only 1 out of 5 runs weren't stable at usleep(10000); in the getstatus loop in the test script.

I'm guessing that some of what BrowserUk said in Win32::Internet crash, XS, callbacks, perl stack & context, windows api, interpreter thread safety, 1 perl, many C threads by windows, in suggesting starting a new perl instance every time the C callback was fired by Windows, rather than using the main perl instance, is the "safe" way to do it.

I'm guessing a single perl instance isn't thread safe. From my amateur looking at the XS of [threads-shared], the "shared" variables have their own perl instance that lives with them, and the "context" is switched around before using perl functions. Neither the parent/main thread or child thread perl interpreters ever get to operate on the shared variables, I think. Mutexes guard the shared interpreter from being commanded by 2 or more threads at the same time I think.

Saving a copy of the perl instance pointer to use from another thread would only work if I can put the other, main thread to sleep, without question. I wonder if http://msdn.microsoft.com/en-us/library/ms686345%28VS.85%29.aspx would work? or is it completely unacceptable to use that in anything remotely approaching production code?


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (3)
    As of 2017-12-11 23:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      What programming language do you hate the most?




















      Results (319 votes). Check out past polls.

      Notices?