Skip the RV printing test under threads until fixed.
[p5sagit/p5-mst-13.2.git] / NetWare / nwperlsys.c
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
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);
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) {
101                 //nw5_internal_host = m_allocList;
102         }
103     return my_perl;
104 }
105
106 /*============================================================================================
107
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 ==============================================================================================*/
117 EXTERN_C PerlInterpreter*
118 perl_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)
123 {
124     PerlInterpreter *my_perl = NULL;
125
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
134         WCValHashTable<void*>*  m_allocList;
135         m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
136         fnInsertHashListAddrs(m_allocList, FALSE);
137
138         if (!ppMem)
139                 lpMem=&perlMem;
140         else
141                 lpMem=*ppMem;
142
143         if (!ppEnv)
144                 lpEnv=&perlEnv;
145         else
146                 lpEnv=*ppEnv;
147         
148         if (!ppStdIO)
149                 lpStdio=&perlStdIO;
150         else
151                 lpStdio=*ppStdIO;
152
153         if (!ppLIO)
154                 lpLIO=&perlLIO;
155         else
156                 lpLIO=*ppLIO;
157         
158         if (!ppDir)
159                 lpDir=&perlDir;
160         else
161                 lpDir=*ppDir;
162
163         if (!ppSock)
164                 lpSock=&perlSock;
165         else
166                 lpSock=*ppSock;
167
168         if (!ppProc)
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         
183         if (my_perl) {
184             //nw5_internal_host = pHost;
185         }
186     return my_perl;
187 }
188 /*============================================================================================
189
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
200 EXTERN_C void
201 nw5_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 */