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 int
  32 main(int argc, char **argv, char **env)
  33 {
  34     CPerlHost host;
  35     int exitstatus = 1;
  36 #ifndef __BORLANDC__
  37     /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
  38      * want to free() argv after main() returns.  As luck would have it,
  39      * Borland's CRT does the right thing to argv[0] already. */
  40     char szModuleName[MAX_PATH];
  41     char *ptr;
  42
  43     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
  44     (void)win32_longpath(szModuleName);
  45     argv[0] = szModuleName;
  46 #endif
  47
  48     PERL_SYS_INIT(&argc,&argv);
  49
  50     if (!host.PerlCreate())
  51         exit(exitstatus);
  52
  53     exitstatus = host.PerlParse(xs_init, argc, argv, NULL);
  54
  55     if (!exitstatus)
  56         exitstatus = host.PerlRun();
  57
  58     host.PerlDestroy();
  59
  60     return exitstatus;
  61 }
  62
  63 #else  /* PERL_OBJECT */
  64
  65 #ifdef __GNUC__
  66 /*
  67  * GNU C does not do __declspec()
  68  */
  69 #define __declspec(foo)
  70
  71 /* Mingw32 defaults to globing command line
  72  * This is inconsistent with other Win32 ports and
  73  * seems to cause trouble with passing -DXSVERSION=\"1.6\"
  74  * So we turn it off like this:
  75  */
  76 int _CRT_glob = 0;
  77
  78 #endif
  79
  80
  81 __declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
  82
  83 int
  84 main(int argc, char **argv, char **env)
  85 {
  86 #ifndef __BORLANDC__
  87     /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
  88      * want to free() argv after main() returns.  As luck would have it,
  89      * Borland's CRT does the right thing to argv[0] already. */
  90     char szModuleName[MAX_PATH];
  91     char *ptr;
  92
  93     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
  94     (void)win32_longpath(szModuleName);
  95     argv[0] = szModuleName;
  96 #endif
  97     return RunPerl(argc, argv, env, (void*)0);
  98 }
  99
 100 #endif  /* PERL_OBJECT */