| 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 | |
| 2986a63f |
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 |
29 | //Includes iperlsys.h and function definitions |
| 30 | #include "nwperlsys.h" |
| 2986a63f |
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) { |
| 8dbfbba0 |
101 | //nw5_internal_host = m_allocList; |
| 2986a63f |
102 | } |
| 103 | return my_perl; |
| 104 | } |
| 105 | |
| 106 | /*============================================================================================ |
| 107 | |
| 8dbfbba0 |
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* |
| 32ce01bc |
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) |
| 8dbfbba0 |
123 | { |
| 124 | PerlInterpreter *my_perl = NULL; |
| 125 | |
| 32ce01bc |
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 | |
| 8dbfbba0 |
134 | WCValHashTable<void*>* m_allocList; |
| 135 | m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); |
| 136 | fnInsertHashListAddrs(m_allocList, FALSE); |
| 137 | |
| 138 | if (!ppMem) |
| 32ce01bc |
139 | lpMem=&perlMem; |
| 140 | else |
| 141 | lpMem=*ppMem; |
| 142 | |
| 8dbfbba0 |
143 | if (!ppEnv) |
| 32ce01bc |
144 | lpEnv=&perlEnv; |
| 145 | else |
| 146 | lpEnv=*ppEnv; |
| 147 | |
| 8dbfbba0 |
148 | if (!ppStdIO) |
| 32ce01bc |
149 | lpStdio=&perlStdIO; |
| 150 | else |
| 151 | lpStdio=*ppStdIO; |
| 152 | |
| 8dbfbba0 |
153 | if (!ppLIO) |
| 32ce01bc |
154 | lpLIO=&perlLIO; |
| 155 | else |
| 156 | lpLIO=*ppLIO; |
| 157 | |
| 8dbfbba0 |
158 | if (!ppDir) |
| 32ce01bc |
159 | lpDir=&perlDir; |
| 160 | else |
| 161 | lpDir=*ppDir; |
| 162 | |
| 8dbfbba0 |
163 | if (!ppSock) |
| 32ce01bc |
164 | lpSock=&perlSock; |
| 165 | else |
| 166 | lpSock=*ppSock; |
| 167 | |
| 8dbfbba0 |
168 | if (!ppProc) |
| 32ce01bc |
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 | |
| 8dbfbba0 |
183 | if (my_perl) { |
| 8dbfbba0 |
184 | //nw5_internal_host = pHost; |
| 185 | } |
| 186 | return my_perl; |
| 187 | } |
| 188 | /*============================================================================================ |
| 189 | |
| 2986a63f |
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 */ |
projects / p5sagit/p5-mst-13.2.git / blame