X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9d8a25dc64d23dcd5730db9be0dbe94a107e1f8b..9dec788bd5a908311909e9ba11d34ff71be22e88:/win32/runperl.c diff --git a/win32/runperl.c b/win32/runperl.c index b7f61a2..b76f8ba 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -1,208 +1,26 @@ - -#ifdef PERL_OBJECT -#define USE_SOCKETS_AS_HANDLES #include "EXTERN.h" #include "perl.h" -#define NO_XSLOCKS -#include "XSUB.H" -#undef errno -#if defined(_MT) -_CRTIMP int * __cdecl _errno(void); -#define errno (*_errno()) -#else -_CRTIMP extern int errno; -#endif - -#include -#include -#include -#include -#include -#include - -#include "ipstdiowin.h" -#include "ipdir.c" -#include "ipenv.c" -#include "ipsock.c" -#include "iplio.c" -#include "ipmem.c" -#include "ipproc.c" -#include "ipstdio.c" - -static void xs_init _((CPERLarg)); -#define stderr (&_iob[2]) -#undef fprintf -#undef environ - -class CPerlHost -{ -public: - CPerlHost() { pPerl = NULL; }; - inline BOOL PerlCreate(void) - { - try - { - pPerl = perl_alloc(&perlMem, - &perlEnv, - &perlStdIO, - &perlLIO, - &perlDir, - &perlSock, - &perlProc); - if(pPerl != NULL) - { - perlDir.SetPerlObj(pPerl); - perlEnv.SetPerlObj(pPerl); - perlLIO.SetPerlObj(pPerl); - perlLIO.SetSockCtl(&perlSock); - perlLIO.SetStdObj(&perlStdIO); - perlMem.SetPerlObj(pPerl); - perlProc.SetPerlObj(pPerl); - perlSock.SetPerlObj(pPerl); - perlSock.SetStdObj(&perlStdIO); - perlStdIO.SetPerlObj(pPerl); - perlStdIO.SetSockCtl(&perlSock); - try - { - pPerl->perl_construct(); - } - catch(...) - { - fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); - pPerl->perl_free(); - pPerl = NULL; - } - } - } - catch(...) - { - fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); - pPerl = NULL; - } - return (pPerl != NULL); - }; - inline int PerlParse(int argc, char** argv, char** env) - { - char* environ = NULL; - int retVal; - try - { - retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env)); - } - catch(int x) - { - // this is where exit() should arrive - retVal = x; - } - catch(...) - { - fprintf(stderr, "Error: Parse exception\n"); - retVal = -1; - } - return retVal; - }; - inline int PerlRun(void) - { - int retVal; - try - { - retVal = pPerl->perl_run(); - } - catch(int x) - { - // this is where exit() should arrive - retVal = x; - } - catch(...) - { - fprintf(stderr, "Error: Runtime exception\n"); - retVal = -1; - } - return retVal; - }; - inline void PerlDestroy(void) - { - try - { - pPerl->perl_destruct(); - pPerl->perl_free(); - } - catch(...) - { - } - }; - -protected: - CPerlObj *pPerl; - CPerlDir perlDir; - CPerlEnv perlEnv; - CPerlLIO perlLIO; - CPerlMem perlMem; - CPerlProc perlProc; - CPerlSock perlSock; - CPerlStdIO perlStdIO; -}; - -#undef PERL_SYS_INIT -#define PERL_SYS_INIT(a, c) - -int -main(int argc, char **argv, char **env) -{ - CPerlHost host; - int exitstatus = 1; - - if(!host.PerlCreate()) - exit(exitstatus); - - - exitstatus = host.PerlParse(argc, argv, env); - - if (!exitstatus) - { - exitstatus = host.PerlRun(); - } - - host.PerlDestroy(); - - return exitstatus; -} - - -static void xs_init(CPERLarg) -{ -} - -EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv)) -{ -} - -#else /* PERL_OBJECT */ - -/* Say NO to CPP! Hallelujah! */ #ifdef __GNUC__ -/* - * GNU C does not do __declspec() - */ -#define __declspec(foo) /* Mingw32 defaults to globing command line * This is inconsistent with other Win32 ports and * seems to cause trouble with passing -DXSVERSION=\"1.6\" - * So we turn it off like this: + * So we turn it off like this, but only when compiling + * perlmain.c: perlmainst.c is linked into the same executable + * as win32.c, which also does this, so we mustn't do it twice + * otherwise we get a multiple definition error. */ +#ifndef PERLDLL int _CRT_glob = 0; - #endif - -__declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios); +#endif int main(int argc, char **argv, char **env) { - return RunPerl(argc, argv, env, (void*)0); + return RunPerl(argc, argv, env); } -#endif /* PERL_OBJECT */ +