Commit | Line | Data |
---|---|---|
011f1a1a JH |
1 | |
2 | /* | |
3 | * Copyright © 2001 Novell, Inc. All Rights Reserved. | |
4 | * | |
5 | * You may distribute under the terms of either the GNU General Public | |
6 | * License or the Artistic License, as specified in the README file. | |
7 | * | |
8 | */ | |
9 | ||
10 | /* | |
11 | * FILENAME : perllib.c | |
12 | * DESCRIPTION : Library functions for parsing and running Perl. | |
13 | * This is based on the perllib.c file of Win32 port. | |
14 | * Author : SGP | |
15 | * Date : January 2001. | |
16 | * | |
17 | */ | |
18 | ||
19 | /* | |
20 | * "The Road goes ever on and on, down from the door where it began." | |
21 | */ | |
22 | ||
23 | ||
24 | ||
25 | #include "EXTERN.h" | |
26 | #include "perl.h" | |
27 | ||
28 | ||
29 | #ifdef PERL_OBJECT | |
30 | #define NO_XSLOCKS | |
31 | #endif | |
32 | ||
33 | //CHKSGP | |
34 | //Including this is giving premature end-of-file error during compilation | |
35 | //#include "XSUB.h" | |
36 | ||
37 | #ifdef PERL_IMPLICIT_SYS | |
38 | ||
39 | #include "nw5iop.h" | |
40 | #include <fcntl.h> | |
41 | ||
42 | #endif //PERL_IMPLICIT_SYS | |
43 | ||
44 | ||
45 | #ifdef PERL_IMPLICIT_SYS | |
46 | ||
47 | #include "nwperlhost.h" | |
48 | #define w32_internal_host (PL_sys_intern.internal_host) // (J) | |
49 | ||
50 | ||
51 | EXTERN_C void | |
52 | perl_get_host_info(struct IPerlMemInfo* perlMemInfo, | |
53 | struct IPerlMemInfo* perlMemSharedInfo, | |
54 | struct IPerlMemInfo* perlMemParseInfo, | |
55 | struct IPerlEnvInfo* perlEnvInfo, | |
56 | struct IPerlStdIOInfo* perlStdIOInfo, | |
57 | struct IPerlLIOInfo* perlLIOInfo, | |
58 | struct IPerlDirInfo* perlDirInfo, | |
59 | struct IPerlSockInfo* perlSockInfo, | |
60 | struct IPerlProcInfo* perlProcInfo) | |
61 | { | |
62 | if (perlMemInfo) { | |
63 | Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*); | |
64 | perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); | |
65 | } | |
66 | if (perlMemSharedInfo) { | |
67 | Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*); | |
68 | perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); | |
69 | } | |
70 | if (perlMemParseInfo) { | |
71 | Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*); | |
72 | perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); | |
73 | } | |
74 | if (perlEnvInfo) { | |
75 | Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*); | |
76 | perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*)); | |
77 | } | |
78 | if (perlStdIOInfo) { | |
79 | Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*); | |
80 | perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*)); | |
81 | } | |
82 | if (perlLIOInfo) { | |
83 | Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*); | |
84 | perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*)); | |
85 | } | |
86 | if (perlDirInfo) { | |
87 | Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*); | |
88 | perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*)); | |
89 | } | |
90 | if (perlSockInfo) { | |
91 | Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*); | |
92 | perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*)); | |
93 | } | |
94 | if (perlProcInfo) { | |
95 | Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*); | |
96 | perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*)); | |
97 | } | |
98 | } | |
99 | ||
100 | EXTERN_C PerlInterpreter* | |
101 | perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, | |
102 | struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, | |
103 | struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, | |
104 | struct IPerlDir** ppDir, struct IPerlSock** ppSock, | |
105 | struct IPerlProc** ppProc) | |
106 | { | |
107 | PerlInterpreter *my_perl = NULL; | |
108 | CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv, | |
109 | ppStdIO, ppLIO, ppDir, ppSock, ppProc); | |
110 | ||
111 | if (pHost) { | |
112 | my_perl = perl_alloc_using(pHost->m_pHostperlMem, | |
113 | pHost->m_pHostperlMemShared, | |
114 | pHost->m_pHostperlMemParse, | |
115 | pHost->m_pHostperlEnv, | |
116 | pHost->m_pHostperlStdIO, | |
117 | pHost->m_pHostperlLIO, | |
118 | pHost->m_pHostperlDir, | |
119 | pHost->m_pHostperlSock, | |
120 | pHost->m_pHostperlProc); | |
121 | if (my_perl) { | |
122 | #ifdef PERL_OBJECT | |
123 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
124 | #endif | |
125 | w32_internal_host = pHost; | |
126 | } | |
127 | } | |
128 | return my_perl; | |
129 | } | |
130 | ||
131 | EXTERN_C PerlInterpreter* | |
132 | perl_alloc(void) | |
133 | { | |
134 | PerlInterpreter* my_perl = NULL; | |
135 | CPerlHost* pHost = new CPerlHost(); | |
136 | if (pHost) { | |
137 | my_perl = perl_alloc_using(pHost->m_pHostperlMem, | |
138 | pHost->m_pHostperlMemShared, | |
139 | pHost->m_pHostperlMemParse, | |
140 | pHost->m_pHostperlEnv, | |
141 | pHost->m_pHostperlStdIO, | |
142 | pHost->m_pHostperlLIO, | |
143 | pHost->m_pHostperlDir, | |
144 | pHost->m_pHostperlSock, | |
145 | pHost->m_pHostperlProc); | |
146 | if (my_perl) { | |
147 | #ifdef PERL_OBJECT | |
148 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
149 | #endif | |
150 | //The following Should be uncommented - CHKSGP | |
151 | w32_internal_host = pHost; | |
152 | } | |
153 | } | |
154 | return my_perl; | |
155 | } | |
156 | ||
157 | EXTERN_C void | |
158 | nw_delete_internal_host(void *h) | |
159 | { | |
160 | CPerlHost *host = (CPerlHost*)h; | |
161 | if(host && h) | |
162 | { | |
163 | delete host; | |
164 | host=NULL; | |
165 | h=NULL; | |
166 | } | |
167 | } | |
168 | ||
169 | #ifdef PERL_OBJECT | |
170 | ||
171 | EXTERN_C void | |
172 | perl_construct(PerlInterpreter* my_perl) | |
173 | { | |
174 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
175 | try | |
176 | { | |
177 | Perl_construct(); | |
178 | } | |
179 | catch(...) | |
180 | { | |
181 | win32_fprintf(stderr, "%s\n", | |
182 | "Error: Unable to construct data structures"); | |
183 | perl_free(my_perl); | |
184 | } | |
185 | } | |
186 | ||
187 | EXTERN_C void | |
188 | perl_destruct(PerlInterpreter* my_perl) | |
189 | { | |
190 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
191 | #ifdef DEBUGGING | |
192 | Perl_destruct(); | |
193 | #else | |
194 | try | |
195 | { | |
196 | Perl_destruct(); | |
197 | } | |
198 | catch(...) | |
199 | { | |
200 | } | |
201 | #endif | |
202 | } | |
203 | ||
204 | EXTERN_C void | |
205 | perl_free(PerlInterpreter* my_perl) | |
206 | { | |
207 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
208 | void *host = w32_internal_host; | |
209 | #ifdef DEBUGGING | |
210 | Perl_free(); | |
211 | #else | |
212 | try | |
213 | { | |
214 | Perl_free(); | |
215 | } | |
216 | catch(...) | |
217 | { | |
218 | } | |
219 | #endif | |
220 | win32_delete_internal_host(host); | |
221 | PERL_SET_THX(NULL); | |
222 | } | |
223 | ||
224 | EXTERN_C int | |
225 | perl_run(PerlInterpreter* my_perl) | |
226 | { | |
227 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
228 | int retVal; | |
229 | #ifdef DEBUGGING | |
230 | retVal = Perl_run(); | |
231 | #else | |
232 | try | |
233 | { | |
234 | retVal = Perl_run(); | |
235 | } | |
236 | catch(...) | |
237 | { | |
238 | win32_fprintf(stderr, "Error: Runtime exception\n"); | |
239 | retVal = -1; | |
240 | } | |
241 | #endif | |
242 | return retVal; | |
243 | } | |
244 | ||
245 | EXTERN_C int | |
246 | perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) | |
247 | { | |
248 | int retVal; | |
249 | CPerlObj* pPerl = (CPerlObj*)my_perl; | |
250 | #ifdef DEBUGGING | |
251 | retVal = Perl_parse(xsinit, argc, argv, env); | |
252 | #else | |
253 | try | |
254 | { | |
255 | retVal = Perl_parse(xsinit, argc, argv, env); | |
256 | } | |
257 | catch(...) | |
258 | { | |
259 | win32_fprintf(stderr, "Error: Parse exception\n"); | |
260 | retVal = -1; | |
261 | } | |
262 | #endif | |
263 | *win32_errno() = 0; | |
264 | return retVal; | |
265 | } | |
266 | ||
267 | #undef PL_perl_destruct_level | |
268 | #define PL_perl_destruct_level int dummy | |
269 | ||
270 | #endif /* PERL_OBJECT */ | |
271 | #endif /* PERL_IMPLICIT_SYS */ | |
272 | ||
273 |