extra code in pp_concat, Take 2
[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         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*
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
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 */