perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

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