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