Commit | Line | Data |
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 | |
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 |
33 | //Includes iperlsys.h and function definitions |
34 | #include "nwperlsys.h" |
2986a63f |
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 |
109 | } |
110 | return my_perl; |
111 | } |
112 | |
113 | /*============================================================================================ |
114 | |
8dbfbba0 |
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* |
32ce01bc |
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) |
8dbfbba0 |
130 | { |
131 | PerlInterpreter *my_perl = NULL; |
132 | |
32ce01bc |
133 | struct IPerlMem* lpMem; |
134 | struct IPerlEnv* lpEnv; |
135 | struct IPerlStdIO* lpStdio; |
136 | struct IPerlLIO* lpLIO; |
137 | struct IPerlDir* lpDir; |
138 | struct IPerlSock* lpSock; |
139 | struct IPerlProc* lpProc; |
140 | |
8dbfbba0 |
141 | WCValHashTable<void*>* m_allocList; |
142 | m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); |
143 | fnInsertHashListAddrs(m_allocList, FALSE); |
144 | |
145 | if (!ppMem) |
32ce01bc |
146 | lpMem=&perlMem; |
147 | else |
148 | lpMem=*ppMem; |
149 | |
8dbfbba0 |
150 | if (!ppEnv) |
32ce01bc |
151 | lpEnv=&perlEnv; |
152 | else |
153 | lpEnv=*ppEnv; |
154 | |
8dbfbba0 |
155 | if (!ppStdIO) |
32ce01bc |
156 | lpStdio=&perlStdIO; |
157 | else |
158 | lpStdio=*ppStdIO; |
159 | |
8dbfbba0 |
160 | if (!ppLIO) |
32ce01bc |
161 | lpLIO=&perlLIO; |
162 | else |
163 | lpLIO=*ppLIO; |
164 | |
8dbfbba0 |
165 | if (!ppDir) |
32ce01bc |
166 | lpDir=&perlDir; |
167 | else |
168 | lpDir=*ppDir; |
169 | |
8dbfbba0 |
170 | if (!ppSock) |
32ce01bc |
171 | lpSock=&perlSock; |
172 | else |
173 | lpSock=*ppSock; |
174 | |
8dbfbba0 |
175 | if (!ppProc) |
32ce01bc |
176 | lpProc=&perlProc; |
177 | else |
178 | lpProc=*ppProc; |
179 | |
180 | my_perl = perl_alloc_using(lpMem, |
181 | NULL, |
182 | NULL, |
183 | lpEnv, |
184 | lpStdio, |
185 | lpLIO, |
186 | lpDir, |
187 | lpSock, |
188 | lpProc); |
189 | |
8dbfbba0 |
190 | if (my_perl) { |
191 | #ifdef PERL_OBJECT |
192 | CPerlObj* pPerl = (CPerlObj*)my_perl; |
193 | #endif |
194 | //nw5_internal_host = pHost; |
195 | } |
196 | return my_perl; |
197 | } |
198 | /*============================================================================================ |
199 | |
2986a63f |
200 | Function : nw5_delete_internal_host |
201 | |
202 | Description : Deletes the alloc_list pointer |
203 | |
204 | Parameters : alloc_list pointer |
205 | |
206 | Returns : none |
207 | |
208 | ==============================================================================================*/ |
209 | |
210 | EXTERN_C void |
211 | nw5_delete_internal_host(void *h) |
212 | { |
213 | WCValHashTable<void*>* m_allocList; |
214 | void **listptr; |
215 | BOOL m_dontTouchHashLists; |
216 | if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
217 | m_allocList = (WCValHashTable<void*>*)listptr; |
218 | fnInsertHashListAddrs(m_allocList, TRUE); |
219 | if (m_allocList) |
220 | { |
221 | m_allocList->forAll(fnFreeMemEntry, NULL); |
222 | fnInsertHashListAddrs(NULL, FALSE); |
223 | delete m_allocList; |
224 | } |
225 | } |
226 | } |
227 | |
228 | #endif /* PERL_IMPLICIT_SYS */ |