This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[asperl] added AS patch#8
[perl5.git] / win32 / runperl.c
CommitLineData
76e3520e
GS
1
2#ifdef PERL_OBJECT
3#define USE_SOCKETS_AS_HANDLES
4#include "EXTERN.h"
5#include "perl.h"
6
565764a8 7#define NO_XSLOCKS
76e3520e 8#include "XSUB.H"
565764a8
DL
9#undef errno
10#if defined(_MT)
11_CRTIMP int * __cdecl _errno(void);
12#define errno (*_errno())
13#else
14_CRTIMP extern int errno;
15#endif
76e3520e
GS
16
17#include <ipdir.h>
18#include <ipenv.h>
19#include <ipsock.h>
20#include <iplio.h>
21#include <ipmem.h>
22#include <ipproc.h>
23
24#include "ipstdiowin.h"
25#include "ipdir.c"
26#include "ipenv.c"
27#include "ipsock.c"
28#include "iplio.c"
29#include "ipmem.c"
30#include "ipproc.c"
31#include "ipstdio.c"
32
33static void xs_init _((CPERLarg));
34#define stderr (&_iob[2])
35#undef fprintf
36#undef environ
37
38class CPerlHost
39{
40public:
41 CPerlHost() { pPerl = NULL; };
42 inline BOOL PerlCreate(void)
43 {
44 try
45 {
46 pPerl = perl_alloc(&perlMem,
47 &perlEnv,
48 &perlStdIO,
49 &perlLIO,
50 &perlDir,
51 &perlSock,
52 &perlProc);
53 if(pPerl != NULL)
54 {
55 perlDir.SetPerlObj(pPerl);
56 perlEnv.SetPerlObj(pPerl);
57 perlLIO.SetPerlObj(pPerl);
58 perlLIO.SetSockCtl(&perlSock);
59 perlLIO.SetStdObj(&perlStdIO);
60 perlMem.SetPerlObj(pPerl);
61 perlProc.SetPerlObj(pPerl);
62 perlSock.SetPerlObj(pPerl);
63 perlSock.SetStdObj(&perlStdIO);
64 perlStdIO.SetPerlObj(pPerl);
65 perlStdIO.SetSockCtl(&perlSock);
66 try
67 {
68 pPerl->perl_construct();
69 }
70 catch(...)
71 {
72 fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
73 pPerl->perl_free();
74 pPerl = NULL;
75 }
76 }
77 }
78 catch(...)
79 {
80 fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
81 pPerl = NULL;
82 }
83 return (pPerl != NULL);
84 };
85 inline int PerlParse(int argc, char** argv, char** env)
86 {
87 char* environ = NULL;
88 int retVal;
89 try
90 {
91 retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env));
92 }
93 catch(int x)
94 {
95 // this is where exit() should arrive
96 retVal = x;
97 }
98 catch(...)
99 {
100 fprintf(stderr, "Error: Parse exception\n");
101 retVal = -1;
102 }
103 return retVal;
104 };
105 inline int PerlRun(void)
106 {
107 int retVal;
108 try
109 {
110 retVal = pPerl->perl_run();
111 }
112 catch(int x)
113 {
114 // this is where exit() should arrive
115 retVal = x;
116 }
117 catch(...)
118 {
119 fprintf(stderr, "Error: Runtime exception\n");
120 retVal = -1;
121 }
122 return retVal;
123 };
124 inline void PerlDestroy(void)
125 {
126 try
127 {
128 pPerl->perl_destruct();
129 pPerl->perl_free();
130 }
131 catch(...)
132 {
133 }
134 };
135
136protected:
137 CPerlObj *pPerl;
138 CPerlDir perlDir;
139 CPerlEnv perlEnv;
140 CPerlLIO perlLIO;
141 CPerlMem perlMem;
142 CPerlProc perlProc;
143 CPerlSock perlSock;
144 CPerlStdIO perlStdIO;
145};
146
147#undef PERL_SYS_INIT
148#define PERL_SYS_INIT(a, c)
149
150int
151main(int argc, char **argv, char **env)
152{
153 CPerlHost host;
154 int exitstatus = 1;
155
156 if(!host.PerlCreate())
157 exit(exitstatus);
158
159
160 exitstatus = host.PerlParse(argc, argv, env);
161
162 if (!exitstatus)
163 {
164 exitstatus = host.PerlRun();
165 }
166
167 host.PerlDestroy();
168
169 return exitstatus;
170}
171
172
173static void xs_init(CPERLarg)
174{
175}
176
9d8a25dc
DL
177EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv))
178{
179}
180
76e3520e
GS
181#else /* PERL_OBJECT */
182
390b85e7 183/* Say NO to CPP! Hallelujah! */
a835ef8a 184#ifdef __GNUC__
5b0d9cbe
NIS
185/*
186 * GNU C does not do __declspec()
187 */
a835ef8a 188#define __declspec(foo)
5b0d9cbe
NIS
189
190/* Mingw32 defaults to globing command line
191 * This is inconsistent with other Win32 ports and
192 * seems to cause trouble with passing -DXSVERSION=\"1.6\"
193 * So we turn it off like this:
194 */
195int _CRT_glob = 0;
196
a835ef8a 197#endif
0a753a76 198
5b0d9cbe 199
390b85e7 200__declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
0a753a76 201
137443ea 202int
0a753a76
PP
203main(int argc, char **argv, char **env)
204{
390b85e7 205 return RunPerl(argc, argv, env, (void*)0);
0a753a76 206}
76e3520e
GS
207
208#endif /* PERL_OBJECT */