extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / NetWare / perllib.cpp
CommitLineData
011f1a1a 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
51EXTERN_C void
52perl_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
100EXTERN_C PerlInterpreter*
101perl_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
131EXTERN_C PerlInterpreter*
132perl_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
157EXTERN_C void
158nw_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
171EXTERN_C void
172perl_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
187EXTERN_C void
188perl_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
204EXTERN_C void
205perl_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
224EXTERN_C int
225perl_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
245EXTERN_C int
246perl_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