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
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
25 static void xs_init(pTHX);
26 //static void xs_init(pTHXo); //(J)
27
28 EXTERN_C int RunPerl(int argc, char **argv, char **env);
29 EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);
30 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);   // (J) pTHXo_
31
32 EXTERN_C BOOL Remove_Thread_Ctx(void);
33
34
35 ClsPerlHost::ClsPerlHost()
36 {
37
38 }
39
40 ClsPerlHost::~ClsPerlHost()
41 {
42
43 }
44
45 ClsPerlHost::VersionNumber()
46 {
47         return 0;
48 }
49
50 int
51 ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
52 {
53 /*      if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
54                 return (1);*/
55     perl_construct(my_perl);
56     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
57
58         return 1;
59 }
60
61 int
62 ClsPerlHost::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
67 int
68 ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
69 {
70         return(perl_run(my_perl));      // Run Perl.
71 }
72
73 int
74 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
75 {
76         int ret = perl_destruct(my_perl);               // Destructor for Perl.
77 ////    perl_free(my_perl);                     // Free the memory allocated for Perl.
78         return(ret);
79 }
80
81 void
82 ClsPerlHost::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
104 static 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
114 EXTERN_C
115 int 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
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;
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
147                 if(!nlm.PerlParse(my_perl, argc, argv, env))
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
168                                 (void) perl_run(new_perl);      // Run Perl.
169                                 PERL_SET_THX(my_perl);
170                         #else
171                                 (void) nlm.PerlRun(my_perl);
172                         #endif
173                 }
174                 exitstatus = nlm.PerlDestroy(my_perl);
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);
183                         exitstatus = nlm.PerlDestroy(new_perl);
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 //
200 IPerlHost* 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 //
212 void FreeStdPerl(IPerlHost* pPerlHost)
213 {
214         if (pPerlHost)
215                 delete (ClsPerlHost*) pPerlHost;
216 ////            delete pPerlHost;
217 }
218