[perl5.git] / NetWare / nwperlsys.c

/*
 * 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     :   nwperlsys.c
 * DESCRIPTION  :   Contains calls to Perl APIs and
 *                  utility functions calls
 *                  
 * Author       :   SGP
 * Date Created :   June 12th 2001.
 * Date Modified:   June 26th 2001.
 */

#include "EXTERN.h"
#include "perl.h"


#ifdef PERL_OBJECT
#define NO_XSLOCKS
#endif

//CHKSGP
//Including this is giving premature end-of-file error during compilation
//#include "XSUB.h"

#ifdef PERL_IMPLICIT_SYS

//Includes iperlsys.h and function definitions
#include "nwperlsys.h"

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

 Function		:	fnFreeMemEntry

 Description	:	Called for each outstanding memory allocation at the end of a script run.
					Frees the outstanding allocations

 Parameters 	:	ptr	(IN).
					context (IN)

 Returns		:	Nothing.

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

void fnFreeMemEntry(void* ptr, void* context)
{
	if(ptr)
	{
		PerlMemFree(NULL, ptr);
	}
}
/*============================================================================================

 Function		:	fnAllocListHash

 Description	:	Hashing function for hash table of memory allocations.

 Parameters 	:	invalue	(IN).

 Returns		:	unsigned.

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

unsigned fnAllocListHash(void* const& invalue)
{
    return (((unsigned) invalue & 0x0000ff00) >> 8);
}

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

 Function		:	perl_alloc

 Description	:	creates a Perl interpreter variable and initializes

 Parameters 	:	none

 Returns		:	Pointer to Perl interpreter

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

EXTERN_C PerlInterpreter*
perl_alloc(void)
{
    PerlInterpreter* my_perl = NULL;

	WCValHashTable<void*>*	m_allocList;
	m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
	fnInsertHashListAddrs(m_allocList, FALSE);

 	my_perl = perl_alloc_using(&perlMem,
				   NULL,
				   NULL,
				   &perlEnv,
				   &perlStdIO,
				   &perlLIO,
				   &perlDir,
				   &perlSock,
				   &perlProc);
	if (my_perl) {
#ifdef PERL_OBJECT
	    CPerlObj* pPerl = (CPerlObj*)my_perl;
#endif
		//nw5_internal_host = m_allocList;
	}
    return my_perl;
}

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

 Function		:	perl_alloc_override

 Description	:	creates a Perl interpreter variable and initializes

 Parameters 	:	Pointer to structure containing function pointers

 Returns		:	Pointer to Perl interpreter

==============================================================================================*/
EXTERN_C PerlInterpreter*
perl_alloc_override(struct IPerlMem* ppMem, struct IPerlMem* ppMemShared,
		 struct IPerlMem* ppMemParse, struct IPerlEnv* ppEnv,
		 struct IPerlStdIO* ppStdIO, struct IPerlLIO* ppLIO,
		 struct IPerlDir* ppDir, struct IPerlSock* ppSock,
		 struct IPerlProc* ppProc)
{
    PerlInterpreter *my_perl = NULL;

	WCValHashTable<void*>*	m_allocList;
	m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
	fnInsertHashListAddrs(m_allocList, FALSE);

	if (!ppMem)
		ppMem=&perlMem;
	if (!ppEnv)
		ppEnv=&perlEnv;
	if (!ppStdIO)
		ppStdIO=&perlStdIO;
	if (!ppLIO)
		ppLIO=&perlLIO;
	if (!ppDir)
		ppDir=&perlDir;
	if (!ppSock)
		ppSock=&perlSock;
	if (!ppProc)
		ppProc=&perlProc;

	my_perl = perl_alloc_using(ppMem,
				   ppMemShared,
				   ppMemParse,
				   ppEnv,
				   ppStdIO,
				   ppLIO,
				   ppDir,
				   ppSock,
				   ppProc);
	if (my_perl) {
#ifdef PERL_OBJECT
	    CPerlObj* pPerl = (CPerlObj*)my_perl;
#endif
	    //nw5_internal_host = pHost;
	}
    return my_perl;
}
/*============================================================================================

 Function		:	nw5_delete_internal_host

 Description	:	Deletes the alloc_list pointer

 Parameters 	:	alloc_list pointer

 Returns		:	none

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

EXTERN_C void
nw5_delete_internal_host(void *h)
{
	WCValHashTable<void*>*	m_allocList;
	void **listptr;
	BOOL m_dontTouchHashLists;
	if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
		m_allocList = (WCValHashTable<void*>*)listptr;
		fnInsertHashListAddrs(m_allocList, TRUE);
		if (m_allocList)
		{
			m_allocList->forAll(fnFreeMemEntry, NULL);
			fnInsertHashListAddrs(NULL, FALSE);
			delete m_allocList;
		}
	}
}

#endif /* PERL_IMPLICIT_SYS */
Commit	Line	Data
2986a63f JH	1	/*
	2	* Copyright © 2001 Novell, Inc. All Rights Reserved.
	3	*
	4	* You may distribute under the terms of either the GNU General Public
	5	* License or the Artistic License, as specified in the README file.
	6	*
	7	*/
	8
	9	/*
8dbfbba0 JH	10	* FILENAME : nwperlsys.c
	11	* DESCRIPTION : Contains calls to Perl APIs and
	12	* utility functions calls
2986a63f	13	*
8dbfbba0 JH	14	* Author : SGP
	15	* Date Created : June 12th 2001.
	16	* Date Modified: June 26th 2001.
2986a63f JH	17	*/
	18
	19	#include "EXTERN.h"
	20	#include "perl.h"
	21
	22
	23	#ifdef PERL_OBJECT
	24	#define NO_XSLOCKS
	25	#endif
	26
	27	//CHKSGP
	28	//Including this is giving premature end-of-file error during compilation
	29	//#include "XSUB.h"
	30
	31	#ifdef PERL_IMPLICIT_SYS
	32
8dbfbba0 JH	33	//Includes iperlsys.h and function definitions
8dbfbba0 JH	34	#include "nwperlsys.h"
2986a63f JH	35
	36	/*============================================================================================
	37
	38	Function : fnFreeMemEntry
	39
	40	Description : Called for each outstanding memory allocation at the end of a script run.
	41	Frees the outstanding allocations
	42
	43	Parameters : ptr (IN).
	44	context (IN)
	45
	46	Returns : Nothing.
	47
	48	==============================================================================================*/
	49
	50	void fnFreeMemEntry(void* ptr, void* context)
	51	{
	52	if(ptr)
	53	{
	54	PerlMemFree(NULL, ptr);
	55	}
	56	}
	57	/*============================================================================================
	58
	59	Function : fnAllocListHash
	60
	61	Description : Hashing function for hash table of memory allocations.
	62
	63	Parameters : invalue (IN).
	64
	65	Returns : unsigned.
	66
	67	==============================================================================================*/
	68
	69	unsigned fnAllocListHash(void* const& invalue)
	70	{
	71	return (((unsigned) invalue & 0x0000ff00) >> 8);
	72	}
	73
	74	/*============================================================================================
	75
	76	Function : perl_alloc
	77
	78	Description : creates a Perl interpreter variable and initializes
	79
	80	Parameters : none
	81
	82	Returns : Pointer to Perl interpreter
	83
	84	==============================================================================================*/
	85
	86	EXTERN_C PerlInterpreter*
	87	perl_alloc(void)
	88	{
	89	PerlInterpreter* my_perl = NULL;
	90
	91	WCValHashTable<void> m_allocList;
	92	m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
	93	fnInsertHashListAddrs(m_allocList, FALSE);
	94
	95	my_perl = perl_alloc_using(&perlMem,
	96	NULL,
	97	NULL,
	98	&perlEnv,
99	&perlStdIO,
100	&perlLIO,
101	&perlDir,
102	&perlSock,
103	&perlProc);
104	if (my_perl) {
105	#ifdef PERL_OBJECT
106	CPerlObj* pPerl = (CPerlObj*)my_perl;
107	#endif
8dbfbba0	108	//nw5_internal_host = m_allocList;
2986a63f JH	109	}
	110	return my_perl;
	111	}
	112
	113	/*============================================================================================
	114
8dbfbba0 JH	115	Function : perl_alloc_override
	116
	117	Description : creates a Perl interpreter variable and initializes
	118
	119	Parameters : Pointer to structure containing function pointers
	120
	121	Returns : Pointer to Perl interpreter
	122
	123	==============================================================================================*/
	124	EXTERN_C PerlInterpreter*
	125	perl_alloc_override(struct IPerlMem* ppMem, struct IPerlMem* ppMemShared,
	126	struct IPerlMem* ppMemParse, struct IPerlEnv* ppEnv,
	127	struct IPerlStdIO* ppStdIO, struct IPerlLIO* ppLIO,
	128	struct IPerlDir* ppDir, struct IPerlSock* ppSock,
	129	struct IPerlProc* ppProc)
	130	{
	131	PerlInterpreter *my_perl = NULL;
	132
	133	WCValHashTable<void> m_allocList;
	134	m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
	135	fnInsertHashListAddrs(m_allocList, FALSE);
	136
	137	if (!ppMem)
	138	ppMem=&perlMem;
	139	if (!ppEnv)
	140	ppEnv=&perlEnv;
	141	if (!ppStdIO)
	142	ppStdIO=&perlStdIO;
	143	if (!ppLIO)
	144	ppLIO=&perlLIO;
	145	if (!ppDir)
	146	ppDir=&perlDir;
	147	if (!ppSock)
	148	ppSock=&perlSock;
	149	if (!ppProc)
	150	ppProc=&perlProc;
	151
	152	my_perl = perl_alloc_using(ppMem,
	153	ppMemShared,
	154	ppMemParse,
	155	ppEnv,
	156	ppStdIO,
	157	ppLIO,
	158	ppDir,
	159	ppSock,
	160	ppProc);
	161	if (my_perl) {
	162	#ifdef PERL_OBJECT
	163	CPerlObj* pPerl = (CPerlObj*)my_perl;
	164	#endif
	165	//nw5_internal_host = pHost;
	166	}
	167	return my_perl;
	168	}
	169	/*============================================================================================
	170
2986a63f JH	171	Function : nw5_delete_internal_host
	172
	173	Description : Deletes the alloc_list pointer
	174
	175	Parameters : alloc_list pointer
	176
	177	Returns : none
	178
	179	==============================================================================================*/
	180
	181	EXTERN_C void
	182	nw5_delete_internal_host(void *h)
	183	{
	184	WCValHashTable<void> m_allocList;
	185	void **listptr;
	186	BOOL m_dontTouchHashLists;
	187	if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
	188	m_allocList = (WCValHashTable<void>)listptr;
	189	fnInsertHashListAddrs(m_allocList, TRUE);
	190	if (m_allocList)
	191	{
	192	m_allocList->forAll(fnFreeMemEntry, NULL);
	193	fnInsertHashListAddrs(NULL, FALSE);
	194	delete m_allocList;
	195	}
	196	}
	197	}
	198
	199	#endif /* PERL_IMPLICIT_SYS */