This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
set PERL_EXIT_DESTRUCT_END in all embeddings
[perl5.git] / NetWare / interface.cpp
CommitLineData
12232b79
JH
1
2/*
cdad3b53 3 * Copyright © 2001 Novell, Inc. All Rights Reserved.
12232b79
JH
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);
8e920bd3 56 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
12232b79
JH
57
58 return 1;
59}
60
61int
62ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)
63{
64 return(perl_parse(my_perl, xs_init, argc, argv, env)); // Parse the command line.
65}
66
67int
68ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
69{
70 return(perl_run(my_perl)); // Run Perl.
71}
72
fe2024f9 73int
12232b79
JH
74ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
75{
fe2024f9 76 int ret = perl_destruct(my_perl); // Destructor for Perl.
12232b79 77//// perl_free(my_perl); // Free the memory allocated for Perl.
fe2024f9 78 return(ret);
12232b79
JH
79}
80
81void
82ClsPerlHost::PerlFree(PerlInterpreter *my_perl)
83{
84 perl_free(my_perl); // Free the memory allocated for Perl.
85
86 // Remove the thread context set during Perl_set_context
87 // This is added here since for web script there is no other place this gets executed
88 // and it cannot be included into cgi2perl.xs unless this symbol is exported.
89 Remove_Thread_Ctx();
90}
91
92/*============================================================================================
93
94 Function : xs_init
95
96 Description :
97
98 Parameters : pTHX (IN) -
99
100 Returns : Nothing.
101
102==============================================================================================*/
103
104static void xs_init(pTHX)
105//static void xs_init(pTHXo) //J
106{
107 char *file = __FILE__;
108
109 dXSUB_SYS;
110 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
111}
112
113
114EXTERN_C
115int RunPerl(int argc, char **argv, char **env)
116{
117 int exitstatus = 0;
118 ClsPerlHost nlm;
119
120 PerlInterpreter *my_perl = NULL; // defined in Perl.h
121 PerlInterpreter *new_perl = NULL; // defined in Perl.h
122
123 //__asm{int 3};
124 #ifdef PERL_GLOBAL_STRUCT
115ff745
NC
125 #define PERLVAR(prefix,var,type)
126 #define PERLVARA(prefix,var,type)
127 #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
128 #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;
12232b79
JH
129
130 #include "perlvars.h"
131
132 #undef PERLVAR
133 #undef PERLVARA
134 #undef PERLVARI
135 #undef PERLVARIC
136 #endif
137
138 PERL_SYS_INIT(&argc, &argv);
139
140 if (!(my_perl = perl_alloc())) // Allocate memory for Perl.
141 return (1);
142
143 if(nlm.PerlCreate(my_perl))
144 {
145 PL_perl_destruct_level = 0;
146
fe2024f9 147 if(!nlm.PerlParse(my_perl, argc, argv, env))
12232b79
JH
148 {
149 #if defined(TOP_CLONE) && defined(USE_ITHREADS) // XXXXXX testing
150 # ifdef PERL_OBJECT
151 CPerlHost *h = new CPerlHost();
152 new_perl = perl_clone_using(my_perl, 1,
153 h->m_pHostperlMem,
154 h->m_pHostperlMemShared,
155 h->m_pHostperlMemParse,
156 h->m_pHostperlEnv,
157 h->m_pHostperlStdIO,
158 h->m_pHostperlLIO,
159 h->m_pHostperlDir,
160 h->m_pHostperlSock,
161 h->m_pHostperlProc
162 );
163 CPerlObj *pPerl = (CPerlObj*)new_perl;
164 # else
165 new_perl = perl_clone(my_perl, 1);
166 # endif
167
fe2024f9 168 (void) perl_run(new_perl); // Run Perl.
12232b79
JH
169 PERL_SET_THX(my_perl);
170 #else
fe2024f9 171 (void) nlm.PerlRun(my_perl);
12232b79
JH
172 #endif
173 }
fe2024f9 174 exitstatus = nlm.PerlDestroy(my_perl);
12232b79
JH
175 }
176 if(my_perl)
177 nlm.PerlFree(my_perl);
178
179 #ifdef USE_ITHREADS
180 if (new_perl)
181 {
182 PERL_SET_THX(new_perl);
fe2024f9 183 exitstatus = nlm.PerlDestroy(new_perl);
12232b79
JH
184 nlm.PerlFree(my_perl);
185 }
186 #endif
187
188 PERL_SYS_TERM();
189 return exitstatus;
190}
191
192
193// FUNCTION: AllocStdPerl
194//
195// DESCRIPTION:
196// Allocates a standard perl handler that other perl handlers
197// may delegate to. You should call FreeStdPerl to free this
198// instance when you are done with it.
199//
200IPerlHost* AllocStdPerl()
201{
202 return (IPerlHost*) new ClsPerlHost();
203}
204
205
206// FUNCTION: FreeStdPerl
207//
208// DESCRIPTION:
209// Frees an instance of a standard perl handler allocated by
210// AllocStdPerl.
211//
212void FreeStdPerl(IPerlHost* pPerlHost)
213{
214 if (pPerlHost)
215 delete (ClsPerlHost*) pPerlHost;
216//// delete pPerlHost;
217}
218