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
fnFreeMemEntry(void * ptr,void * context)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
fnAllocListHash(void * const & invalue)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*
perl_alloc(void)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 my_perl = perl_alloc_using(&perlMem,
91 &perlMem,
92 NULL,
93 &perlEnv,
94 &perlStdIO,
95 &perlLIO,
96 &perlDir,
97 &perlSock,
98 &perlProc);
99 if (my_perl) {
100 //nw5_internal_host = m_allocList;
101 }
102 return my_perl;
103 }
104
105 /*============================================================================================
106
107 Function : perl_alloc_override
108
109 Description : creates a Perl interpreter variable and initializes
110
111 Parameters : Pointer to structure containing function pointers
112
113 Returns : Pointer to Perl interpreter
114
115 ==============================================================================================*/
116 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)117 perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
118 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
119 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
120 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
121 struct IPerlProc** ppProc)
122 {
123 PerlInterpreter *my_perl = NULL;
124
125 struct IPerlMem* lpMem;
126 struct IPerlEnv* lpEnv;
127 struct IPerlStdIO* lpStdio;
128 struct IPerlLIO* lpLIO;
129 struct IPerlDir* lpDir;
130 struct IPerlSock* lpSock;
131 struct IPerlProc* lpProc;
132
133 WCValHashTable<void*>* m_allocList;
134 m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
135 fnInsertHashListAddrs(m_allocList, FALSE);
136
137 if (!ppMem)
138 lpMem=&perlMem;
139 else
140 lpMem=*ppMem;
141
142 if (!ppEnv)
143 lpEnv=&perlEnv;
144 else
145 lpEnv=*ppEnv;
146
147 if (!ppStdIO)
148 lpStdio=&perlStdIO;
149 else
150 lpStdio=*ppStdIO;
151
152 if (!ppLIO)
153 lpLIO=&perlLIO;
154 else
155 lpLIO=*ppLIO;
156
157 if (!ppDir)
158 lpDir=&perlDir;
159 else
160 lpDir=*ppDir;
161
162 if (!ppSock)
163 lpSock=&perlSock;
164 else
165 lpSock=*ppSock;
166
167 if (!ppProc)
168 lpProc=&perlProc;
169 else
170 lpProc=*ppProc;
171 my_perl = perl_alloc_using(lpMem,
172 lpMem,
173 NULL,
174 lpEnv,
175 lpStdio,
176 lpLIO,
177 lpDir,
178 lpSock,
179 lpProc);
180
181 if (my_perl) {
182 //nw5_internal_host = pHost;
183 }
184 return my_perl;
185 }
186 /*============================================================================================
187
188 Function : nw5_delete_internal_host
189
190 Description : Deletes the alloc_list pointer
191
192 Parameters : alloc_list pointer
193
194 Returns : none
195
196 ==============================================================================================*/
197
198 EXTERN_C void
nw5_delete_internal_host(void * h)199 nw5_delete_internal_host(void *h)
200 {
201 WCValHashTable<void*>* m_allocList;
202 void **listptr;
203 BOOL m_dontTouchHashLists;
204 if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
205 m_allocList = (WCValHashTable<void*>*)listptr;
206 fnInsertHashListAddrs(m_allocList, TRUE);
207 if (m_allocList)
208 {
209 m_allocList->forAll(fnFreeMemEntry, NULL);
210 fnInsertHashListAddrs(NULL, FALSE);
211 delete m_allocList;
212 }
213 }
214 }
215
216 #endif /* PERL_IMPLICIT_SYS */
217