Regenerate META.yml
[p5sagit/p5-mst-13.2.git] / NetWare / perllib.cpp
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