regcomp.c: Use simpler variable name as long as possible
[perl.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
57         return 1;
58 }
59
60 int
61 ClsPerlHost::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
66 int
67 ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
68 {
69         return(perl_run(my_perl));      // Run Perl.
70 }
71
72 int
73 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
74 {
75         int ret = perl_destruct(my_perl);               // Destructor for Perl.
76 ////    perl_free(my_perl);                     // Free the memory allocated for Perl.
77         return(ret);
78 }
79
80 void
81 ClsPerlHost::PerlFree(PerlInterpreter *my_perl)
82 {
83         perl_free(my_perl);                     // Free the memory allocated for Perl.
84
85         // Remove the thread context set during Perl_set_context
86         // This is added here since for web script there is no other place this gets executed
87         // and it cannot be included into cgi2perl.xs unless this symbol is exported.
88         Remove_Thread_Ctx();
89 }
90
91 /*============================================================================================
92
93  Function               :       xs_init
94
95  Description    :       
96
97  Parameters     :       pTHX    (IN)    -       
98
99  Returns                :       Nothing.
100
101 ==============================================================================================*/
102
103 static void xs_init(pTHX)
104 //static void xs_init(pTHXo) //J
105 {
106         char *file = __FILE__;
107
108         dXSUB_SYS;
109         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
110 }
111
112
113 EXTERN_C
114 int RunPerl(int argc, char **argv, char **env)
115 {
116         int exitstatus = 0;
117         ClsPerlHost nlm;
118
119         PerlInterpreter *my_perl = NULL;                // defined in Perl.h
120         PerlInterpreter *new_perl = NULL;               // defined in Perl.h
121
122         //__asm{int 3};
123         #ifdef PERL_GLOBAL_STRUCT
124                 #define PERLVAR(prefix,var,type)
125                 #define PERLVARA(prefix,var,type)
126                 #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
127                 #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;
128
129                 #include "perlvars.h"
130
131                 #undef PERLVAR
132                 #undef PERLVARA
133                 #undef PERLVARI
134                 #undef PERLVARIC
135         #endif
136
137         PERL_SYS_INIT(&argc, &argv);
138
139         if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
140                 return (1);
141
142         if(nlm.PerlCreate(my_perl))
143         {
144                 PL_perl_destruct_level = 0;
145
146                 if(!nlm.PerlParse(my_perl, argc, argv, env))
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                                 (void) perl_run(new_perl);      // Run Perl.
168                                 PERL_SET_THX(my_perl);
169                         #else
170                                 (void) nlm.PerlRun(my_perl);
171                         #endif
172                 }
173                 exitstatus = 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                         exitstatus = 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 //
199 IPerlHost* 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 //
211 void FreeStdPerl(IPerlHost* pPerlHost)
212 {
213         if (pPerlHost)
214                 delete (ClsPerlHost*) pPerlHost;
215 ////            delete pPerlHost;
216 }
217