source: trunk/essentials/dev-lang/perl/NetWare/nwperlsys.c

Last change on this file was 3181, checked in by bird, 18 years ago

perl 5.8.8
File size: 4.9 KB
Line 
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
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 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==============================================================================================*/
116EXTERN_C PerlInterpreter*
117perl_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
198EXTERN_C void
199nw5_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 */
Note: See TracBrowser for help on using the repository browser.