| 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* |
| 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) |
| 130 | { |
| 131 | PerlInterpreter *my_perl = NULL; |
| 132 | |
| 133 | WCValHashTable<void*>* m_allocList; |
| 134 | m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); |
| 135 | fnInsertHashListAddrs(m_allocList, FALSE); |
| 136 | |
| 137 | if (!ppMem) |
| 138 | ppMem=&perlMem; |
| 139 | if (!ppEnv) |
| 140 | ppEnv=&perlEnv; |
| 141 | if (!ppStdIO) |
| 142 | ppStdIO=&perlStdIO; |
| 143 | if (!ppLIO) |
| 144 | ppLIO=&perlLIO; |
| 145 | if (!ppDir) |
| 146 | ppDir=&perlDir; |
| 147 | if (!ppSock) |
| 148 | ppSock=&perlSock; |
| 149 | if (!ppProc) |
| 150 | ppProc=&perlProc; |
| 151 | |
| 152 | my_perl = perl_alloc_using(ppMem, |
| 153 | ppMemShared, |
| 154 | ppMemParse, |
| 155 | ppEnv, |
| 156 | ppStdIO, |
| 157 | ppLIO, |
| 158 | ppDir, |
| 159 | ppSock, |
| 160 | ppProc); |
| 161 | if (my_perl) { |
| 162 | #ifdef PERL_OBJECT |
| 163 | CPerlObj* pPerl = (CPerlObj*)my_perl; |
| 164 | #endif |
| 165 | //nw5_internal_host = pHost; |
| 166 | } |
| 167 | return my_perl; |
| 168 | } |
| 169 | /*============================================================================================ |
| 170 | |
| 2986a63f |
171 | Function : nw5_delete_internal_host |
| 172 | |
| 173 | Description : Deletes the alloc_list pointer |
| 174 | |
| 175 | Parameters : alloc_list pointer |
| 176 | |
| 177 | Returns : none |
| 178 | |
| 179 | ==============================================================================================*/ |
| 180 | |
| 181 | EXTERN_C void |
| 182 | nw5_delete_internal_host(void *h) |
| 183 | { |
| 184 | WCValHashTable<void*>* m_allocList; |
| 185 | void **listptr; |
| 186 | BOOL m_dontTouchHashLists; |
| 187 | if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
| 188 | m_allocList = (WCValHashTable<void*>*)listptr; |
| 189 | fnInsertHashListAddrs(m_allocList, TRUE); |
| 190 | if (m_allocList) |
| 191 | { |
| 192 | m_allocList->forAll(fnFreeMemEntry, NULL); |
| 193 | fnInsertHashListAddrs(NULL, FALSE); |
| 194 | delete m_allocList; |
| 195 | } |
| 196 | } |
| 197 | } |
| 198 | |
| 199 | #endif /* PERL_IMPLICIT_SYS */ |
projects / p5sagit/p5-mst-13.2.git / blame