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
perl_get_host_info(struct IPerlMemInfo * perlMemInfo,struct IPerlMemInfo * perlMemSharedInfo,struct IPerlMemInfo * perlMemParseInfo,struct IPerlEnvInfo * perlEnvInfo,struct IPerlStdIOInfo * perlStdIOInfo,struct IPerlLIOInfo * perlLIOInfo,struct IPerlDirInfo * perlDirInfo,struct IPerlSockInfo * perlSockInfo,struct IPerlProcInfo * perlProcInfo)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*
perl_alloc_override(struct IPerlMem ** ppMem,struct IPerlMem ** ppMemShared,struct IPerlMem ** ppMemParse,struct IPerlEnv ** ppEnv,struct IPerlStdIO ** ppStdIO,struct IPerlLIO ** ppLIO,struct IPerlDir ** ppDir,struct IPerlSock ** ppSock,struct IPerlProc ** ppProc)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*
perl_alloc(void)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
nw_delete_internal_host(void * h)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
perl_construct(PerlInterpreter * my_perl)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
perl_destruct(PerlInterpreter * my_perl)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
perl_free(PerlInterpreter * my_perl)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
perl_run(PerlInterpreter * my_perl)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
perl_parse(PerlInterpreter * my_perl,void (* xsinit)(CPerlObj *),int argc,char ** argv,char ** env)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
274