Chip noticed that the intended optionality of the 'IV' was
[p5sagit/p5-mst-13.2.git] / NetWare / interface.cpp
CommitLineData
12232b79 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 : interface.c
12 * DESCRIPTION : Perl parsing and running functions.
13 * Author : SGP
14 * Date : January 2001.
15 *
16 */
17
18
19
20#include "interface.h"
21
22#include "win32ish.h" // For "BOOL", "TRUE" and "FALSE"
23
24
25static void xs_init(pTHX);
26//static void xs_init(pTHXo); //(J)
27
28EXTERN_C int RunPerl(int argc, char **argv, char **env);
29EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);
30EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); // (J) pTHXo_
31
32EXTERN_C BOOL Remove_Thread_Ctx(void);
33
34
35ClsPerlHost::ClsPerlHost()
36{
37
38}
39
40ClsPerlHost::~ClsPerlHost()
41{
42
43}
44
45ClsPerlHost::VersionNumber()
46{
47 return 0;
48}
49
50int
51ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
52{
53/* if (!(my_perl = perl_alloc())) // Allocate memory for Perl.
54 return (1);*/
55 perl_construct(my_perl);
56
57 return 1;
58}
59
60int
61ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)
62{
63 return(perl_parse(my_perl, xs_init, argc, argv, env)); // Parse the command line.
64}
65
66int
67ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
68{
69 return(perl_run(my_perl)); // Run Perl.
70}
71
72void
73ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
74{
75 perl_destruct(my_perl); // Destructor for Perl.
76//// perl_free(my_perl); // Free the memory allocated for Perl.
77}
78
79void
80ClsPerlHost::PerlFree(PerlInterpreter *my_perl)
81{
82 perl_free(my_perl); // Free the memory allocated for Perl.
83
84 // Remove the thread context set during Perl_set_context
85 // This is added here since for web script there is no other place this gets executed
86 // and it cannot be included into cgi2perl.xs unless this symbol is exported.
87 Remove_Thread_Ctx();
88}
89
90/*============================================================================================
91
92 Function : xs_init
93
94 Description :
95
96 Parameters : pTHX (IN) -
97
98 Returns : Nothing.
99
100==============================================================================================*/
101
102static void xs_init(pTHX)
103//static void xs_init(pTHXo) //J
104{
105 char *file = __FILE__;
106
107 dXSUB_SYS;
108 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
109}
110
111
112EXTERN_C
113int RunPerl(int argc, char **argv, char **env)
114{
115 int exitstatus = 0;
116 ClsPerlHost nlm;
117
118 PerlInterpreter *my_perl = NULL; // defined in Perl.h
119 PerlInterpreter *new_perl = NULL; // defined in Perl.h
120
121 //__asm{int 3};
122 #ifdef PERL_GLOBAL_STRUCT
123 #define PERLVAR(var,type)
124 #define PERLVARA(var,type)
125 #define PERLVARI(var,type,init) PL_Vars.var = init;
126 #define PERLVARIC(var,type,init) PL_Vars.var = init;
127
128 #include "perlvars.h"
129
130 #undef PERLVAR
131 #undef PERLVARA
132 #undef PERLVARI
133 #undef PERLVARIC
134 #endif
135
136 PERL_SYS_INIT(&argc, &argv);
137
138 if (!(my_perl = perl_alloc())) // Allocate memory for Perl.
139 return (1);
140
141 if(nlm.PerlCreate(my_perl))
142 {
143 PL_perl_destruct_level = 0;
144
145 exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
146 if(exitstatus == 0)
147 {
148 #if defined(TOP_CLONE) && defined(USE_ITHREADS) // XXXXXX testing
149 # ifdef PERL_OBJECT
150 CPerlHost *h = new CPerlHost();
151 new_perl = perl_clone_using(my_perl, 1,
152 h->m_pHostperlMem,
153 h->m_pHostperlMemShared,
154 h->m_pHostperlMemParse,
155 h->m_pHostperlEnv,
156 h->m_pHostperlStdIO,
157 h->m_pHostperlLIO,
158 h->m_pHostperlDir,
159 h->m_pHostperlSock,
160 h->m_pHostperlProc
161 );
162 CPerlObj *pPerl = (CPerlObj*)new_perl;
163 # else
164 new_perl = perl_clone(my_perl, 1);
165 # endif
166
167 exitstatus = perl_run(new_perl); // Run Perl.
168 PERL_SET_THX(my_perl);
169 #else
170 exitstatus = nlm.PerlRun(my_perl);
171 #endif
172 }
173 nlm.PerlDestroy(my_perl);
174 }
175 if(my_perl)
176 nlm.PerlFree(my_perl);
177
178 #ifdef USE_ITHREADS
179 if (new_perl)
180 {
181 PERL_SET_THX(new_perl);
182 nlm.PerlDestroy(new_perl);
183 nlm.PerlFree(my_perl);
184 }
185 #endif
186
187 PERL_SYS_TERM();
188 return exitstatus;
189}
190
191
192// FUNCTION: AllocStdPerl
193//
194// DESCRIPTION:
195// Allocates a standard perl handler that other perl handlers
196// may delegate to. You should call FreeStdPerl to free this
197// instance when you are done with it.
198//
199IPerlHost* AllocStdPerl()
200{
201 return (IPerlHost*) new ClsPerlHost();
202}
203
204
205// FUNCTION: FreeStdPerl
206//
207// DESCRIPTION:
208// Frees an instance of a standard perl handler allocated by
209// AllocStdPerl.
210//
211void FreeStdPerl(IPerlHost* pPerlHost)
212{
213 if (pPerlHost)
214 delete (ClsPerlHost*) pPerlHost;
215//// delete pPerlHost;
216}
217