win32/runperl.c

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3
   4 #ifdef PERL_OBJECT
   5
   6 #define NO_XSLOCKS
   7 #include "XSUB.H"
   8 #include "win32iop.h"
   9
  10 #include <fcntl.h>
  11 #include "perlhost.h"
  12
  13
  14 char *staticlinkmodules[] = {
  15     "DynaLoader",
  16     NULL,
  17 };
  18
  19 EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
  20
  21 static void
  22 xs_init(CPERLarg)
  23 {
  24     char *file = __FILE__;
  25     dXSUB_SYS;
  26     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  27 }
  28
  29 CPerlObj *pPerl;
  30
  31 #undef PERL_SYS_INIT
  32 #define PERL_SYS_INIT(a, c)
  33
  34 int
  35 main(int argc, char **argv, char **env)
  36 {
  37     CPerlHost host;
  38     int exitstatus = 1;
  39 #ifndef __BORLANDC__
  40     /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
  41      * want to free() argv after main() returns.  As luck would have it,
  42      * Borland's CRT does the right thing to argv[0] already. */
  43     char szModuleName[MAX_PATH];
  44     char *ptr;
  45
  46     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
  47     (void)GetFullPathName(szModuleName, sizeof(szModuleName),
  48                           szModuleName, &ptr);
  49     argv[0] = szModuleName;
  50 #endif
  51
  52     if (!host.PerlCreate())
  53         exit(exitstatus);
  54
  55     exitstatus = host.PerlParse(xs_init, argc, argv, NULL);
  56
  57     if (!exitstatus)
  58         exitstatus = host.PerlRun();
  59
  60     host.PerlDestroy();
  61
  62     return exitstatus;
  63 }
  64
  65 #else  /* PERL_OBJECT */
  66
  67 #ifdef __GNUC__
  68 /*
  69  * GNU C does not do __declspec()
  70  */
  71 #define __declspec(foo)
  72
  73 /* Mingw32 defaults to globing command line
  74  * This is inconsistent with other Win32 ports and
  75  * seems to cause trouble with passing -DXSVERSION=\"1.6\"
  76  * So we turn it off like this:
  77  */
  78 int _CRT_glob = 0;
  79
  80 #endif
  81
  82
  83 __declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
  84
  85 int
  86 main(int argc, char **argv, char **env)
  87 {
  88 #ifndef __BORLANDC__
  89     /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
  90      * want to free() argv after main() returns.  As luck would have it,
  91      * Borland's CRT does the right thing to argv[0] already. */
  92     char szModuleName[MAX_PATH];
  93     char *ptr;
  94
  95     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
  96     (void)GetFullPathName(szModuleName, sizeof(szModuleName),
  97                           szModuleName, &ptr);
  98     argv[0] = szModuleName;
  99 #endif
 100     return RunPerl(argc, argv, env, (void*)0);
 101 }
 102
 103 #endif  /* PERL_OBJECT */