NetWare tweaks from Ananth Kesari.
[p5sagit/p5-mst-13.2.git] / NetWare / nwperlsys.c
CommitLineData
2986a63f 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 10 * FILENAME : nwperlsys.c
11 * DESCRIPTION : Contains calls to Perl APIs and
12 * utility functions calls
2986a63f 13 *
8dbfbba0 14 * Author : SGP
15 * Date Created : June 12th 2001.
16 * Date Modified: June 26th 2001.
2986a63f 17 */
18
19#include "EXTERN.h"
20#include "perl.h"
21
22
2986a63f 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
8dbfbba0 29//Includes iperlsys.h and function definitions
30#include "nwperlsys.h"
2986a63f 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
46void 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
65unsigned 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
82EXTERN_C PerlInterpreter*
83perl_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) {
8dbfbba0 101 //nw5_internal_host = m_allocList;
2986a63f 102 }
103 return my_perl;
104}
105
106/*============================================================================================
107
8dbfbba0 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==============================================================================================*/
117EXTERN_C PerlInterpreter*
32ce01bc 118perl_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)
8dbfbba0 123{
124 PerlInterpreter *my_perl = NULL;
125
32ce01bc 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
8dbfbba0 134 WCValHashTable<void*>* m_allocList;
135 m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
136 fnInsertHashListAddrs(m_allocList, FALSE);
137
138 if (!ppMem)
32ce01bc 139 lpMem=&perlMem;
140 else
141 lpMem=*ppMem;
142
8dbfbba0 143 if (!ppEnv)
32ce01bc 144 lpEnv=&perlEnv;
145 else
146 lpEnv=*ppEnv;
147
8dbfbba0 148 if (!ppStdIO)
32ce01bc 149 lpStdio=&perlStdIO;
150 else
151 lpStdio=*ppStdIO;
152
8dbfbba0 153 if (!ppLIO)
32ce01bc 154 lpLIO=&perlLIO;
155 else
156 lpLIO=*ppLIO;
157
8dbfbba0 158 if (!ppDir)
32ce01bc 159 lpDir=&perlDir;
160 else
161 lpDir=*ppDir;
162
8dbfbba0 163 if (!ppSock)
32ce01bc 164 lpSock=&perlSock;
165 else
166 lpSock=*ppSock;
167
8dbfbba0 168 if (!ppProc)
32ce01bc 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
8dbfbba0 183 if (my_perl) {
8dbfbba0 184 //nw5_internal_host = pHost;
185 }
186 return my_perl;
187}
188/*============================================================================================
189
2986a63f 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
200EXTERN_C void
201nw5_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 */