Commit | Line | Data |
---|---|---|
2986a63f | 1 | /* |
cdad3b53 | 2 | * Copyright © 2001 Novell, Inc. All Rights Reserved. |
2986a63f JH |
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 JH |
10 | * FILENAME : nwperlsys.c |
11 | * DESCRIPTION : Contains calls to Perl APIs and | |
12 | * utility functions calls | |
2986a63f | 13 | * |
8dbfbba0 JH |
14 | * Author : SGP |
15 | * Date Created : June 12th 2001. | |
16 | * Date Modified: June 26th 2001. | |
2986a63f JH |
17 | */ |
18 | ||
19 | #include "EXTERN.h" | |
20 | #include "perl.h" | |
21 | ||
22 | ||
2986a63f JH |
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 JH |
29 | //Includes iperlsys.h and function definitions |
30 | #include "nwperlsys.h" | |
2986a63f JH |
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); | |
2986a63f | 90 | my_perl = perl_alloc_using(&perlMem, |
083fcd59 | 91 | &perlMem, |
2986a63f JH |
92 | NULL, |
93 | &perlEnv, | |
94 | &perlStdIO, | |
95 | &perlLIO, | |
96 | &perlDir, | |
97 | &perlSock, | |
98 | &perlProc); | |
99 | if (my_perl) { | |
8dbfbba0 | 100 | //nw5_internal_host = m_allocList; |
2986a63f JH |
101 | } |
102 | return my_perl; | |
103 | } | |
104 | ||
105 | /*============================================================================================ | |
106 | ||
8dbfbba0 JH |
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* | |
32ce01bc JH |
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) | |
8dbfbba0 JH |
122 | { |
123 | PerlInterpreter *my_perl = NULL; | |
124 | ||
32ce01bc JH |
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 | ||
8dbfbba0 JH |
133 | WCValHashTable<void*>* m_allocList; |
134 | m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); | |
135 | fnInsertHashListAddrs(m_allocList, FALSE); | |
136 | ||
137 | if (!ppMem) | |
32ce01bc JH |
138 | lpMem=&perlMem; |
139 | else | |
140 | lpMem=*ppMem; | |
141 | ||
8dbfbba0 | 142 | if (!ppEnv) |
32ce01bc JH |
143 | lpEnv=&perlEnv; |
144 | else | |
145 | lpEnv=*ppEnv; | |
146 | ||
8dbfbba0 | 147 | if (!ppStdIO) |
32ce01bc JH |
148 | lpStdio=&perlStdIO; |
149 | else | |
150 | lpStdio=*ppStdIO; | |
151 | ||
8dbfbba0 | 152 | if (!ppLIO) |
32ce01bc JH |
153 | lpLIO=&perlLIO; |
154 | else | |
155 | lpLIO=*ppLIO; | |
156 | ||
8dbfbba0 | 157 | if (!ppDir) |
32ce01bc JH |
158 | lpDir=&perlDir; |
159 | else | |
160 | lpDir=*ppDir; | |
161 | ||
8dbfbba0 | 162 | if (!ppSock) |
32ce01bc JH |
163 | lpSock=&perlSock; |
164 | else | |
165 | lpSock=*ppSock; | |
166 | ||
8dbfbba0 | 167 | if (!ppProc) |
32ce01bc JH |
168 | lpProc=&perlProc; |
169 | else | |
170 | lpProc=*ppProc; | |
32ce01bc | 171 | my_perl = perl_alloc_using(lpMem, |
083fcd59 | 172 | lpMem, |
32ce01bc JH |
173 | NULL, |
174 | lpEnv, | |
175 | lpStdio, | |
176 | lpLIO, | |
177 | lpDir, | |
178 | lpSock, | |
179 | lpProc); | |
180 | ||
8dbfbba0 | 181 | if (my_perl) { |
8dbfbba0 JH |
182 | //nw5_internal_host = pHost; |
183 | } | |
184 | return my_perl; | |
185 | } | |
186 | /*============================================================================================ | |
187 | ||
2986a63f JH |
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 | |
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 */ |