5.18.1/NetWare/interface.cpp


/*
 * Copyright © 2001 Novell, Inc. All Rights Reserved.
 *
 * You may distribute under the terms of either the GNU General Public
 * License or the Artistic License, as specified in the README file.
 *
 */

/*
 * FILENAME             :       interface.c
 * DESCRIPTION  :       Perl parsing and running functions.
 * Author               :       SGP
 * Date                 :       January 2001.
 *
 */


#include "interface.h"

#include "win32ish.h"           // For "BOOL", "TRUE" and "FALSE"


static void xs_init(pTHX);
//static void xs_init(pTHXo); //(J)

EXTERN_C int RunPerl(int argc, char **argv, char **env);
EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);   // (J) pTHXo_

EXTERN_C BOOL Remove_Thread_Ctx(void);


ClsPerlHost::ClsPerlHost()
{

}

ClsPerlHost::~ClsPerlHost()
{

}

ClsPerlHost::VersionNumber()
{
        return 0;
}

int
ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
{
/*      if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
                return (1);*/
    perl_construct(my_perl);

        return 1;
}

int
ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)
{
        return(perl_parse(my_perl, xs_init, argc, argv, env));          // Parse the command line.
}

int
ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
{
        return(perl_run(my_perl));      // Run Perl.
}

void
ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
{
        perl_destruct(my_perl);         // Destructor for Perl.
////    perl_free(my_perl);                     // Free the memory allocated for Perl.
}

void
ClsPerlHost::PerlFree(PerlInterpreter *my_perl)
{
        perl_free(my_perl);                     // Free the memory allocated for Perl.

        // Remove the thread context set during Perl_set_context
        // This is added here since for web script there is no other place this gets executed
        // and it cannot be included into cgi2perl.xs unless this symbol is exported.
        Remove_Thread_Ctx();
}

/*============================================================================================

 Function               :       xs_init

 Description    :       

 Parameters     :       pTHX    (IN)    -       

 Returns                :       Nothing.

==============================================================================================*/

static void xs_init(pTHX)
//static void xs_init(pTHXo) //J
{
        char *file = __FILE__;

        dXSUB_SYS;
        newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}


EXTERN_C
int RunPerl(int argc, char **argv, char **env)
{
        int exitstatus = 0;
        ClsPerlHost nlm;

        PerlInterpreter *my_perl = NULL;                // defined in Perl.h
        PerlInterpreter *new_perl = NULL;               // defined in Perl.h

        //__asm{int 3};
        #ifdef PERL_GLOBAL_STRUCT
                #define PERLVAR(prefix,var,type)
                #define PERLVARA(prefix,var,type)
                #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
                #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;

                #include "perlvars.h"

                #undef PERLVAR
                #undef PERLVARA
                #undef PERLVARI
                #undef PERLVARIC
        #endif

        PERL_SYS_INIT(&argc, &argv);

        if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
                return (1);

        if(nlm.PerlCreate(my_perl))
        {
                PL_perl_destruct_level = 0;

                exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
                if(exitstatus == 0)
                {
                        #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
                                #  ifdef PERL_OBJECT
                                        CPerlHost *h = new CPerlHost();
                                        new_perl = perl_clone_using(my_perl, 1,
                                                                                h->m_pHostperlMem,
                                                                                h->m_pHostperlMemShared,
                                                                                h->m_pHostperlMemParse,
                                                                                h->m_pHostperlEnv,
                                                                                h->m_pHostperlStdIO,
                                                                                h->m_pHostperlLIO,
                                                                                h->m_pHostperlDir,
                                                                                h->m_pHostperlSock,
                                                                                h->m_pHostperlProc
                                                                                );
                                        CPerlObj *pPerl = (CPerlObj*)new_perl;
                                #  else
                                        new_perl = perl_clone(my_perl, 1);
                                #  endif

                                exitstatus = perl_run(new_perl);        // Run Perl.
                                PERL_SET_THX(my_perl);
                        #else
                                exitstatus = nlm.PerlRun(my_perl);
                        #endif
                }
                nlm.PerlDestroy(my_perl);
        }
        if(my_perl)
                nlm.PerlFree(my_perl);

        #ifdef USE_ITHREADS
                if (new_perl)
                {
                        PERL_SET_THX(new_perl);
                        nlm.PerlDestroy(new_perl);
                        nlm.PerlFree(my_perl);
                }
        #endif

        PERL_SYS_TERM();
        return exitstatus;
}


// FUNCTION: AllocStdPerl
//
// DESCRIPTION:
//      Allocates a standard perl handler that other perl handlers
//      may delegate to. You should call FreeStdPerl to free this
//      instance when you are done with it.
//
IPerlHost* AllocStdPerl()
{
        return (IPerlHost*) new ClsPerlHost();
}


// FUNCTION: FreeStdPerl
//
// DESCRIPTION:
//      Frees an instance of a standard perl handler allocated by
//      AllocStdPerl.
//
void FreeStdPerl(IPerlHost* pPerlHost)
{
        if (pPerlHost)
                delete (ClsPerlHost*) pPerlHost;
////            delete pPerlHost;
}

Revision:	6435
Committed:	Mon Dec 2 04:40:05 2013 UTC (10 years, 5 months ago) by laffer1
File size:	4581 byte(s)
Log Message:	tag perl 5.18.1
#	Content
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	void
73	ClsPerlHost::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
79	void
80	ClsPerlHost::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
102	static 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
112	EXTERN_C
113	int 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(prefix,var,type)
124	#define PERLVARA(prefix,var,type)
125	#define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
126	#define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##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	//
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