| /* |
| * Copyright © 2001 Novell, Inc. All Rights Reserved. |
| * |
| * You may distribute under the terms of either the GNU General Public |
| * License or the Artistic License, as specified in the README file. |
| * |
| */ |
| |
| /* |
| * FILENAME : nwperlsys.c |
| * DESCRIPTION : Contains calls to Perl APIs and |
| * utility functions calls |
| * |
| * Author : SGP |
| * Date Created : June 12th 2001. |
| * Date Modified: June 26th 2001. |
| */ |
| |
| #include "EXTERN.h" |
| #include "perl.h" |
| |
| |
| //CHKSGP |
| //Including this is giving premature end-of-file error during compilation |
| //#include "XSUB.h" |
| |
| #ifdef PERL_IMPLICIT_SYS |
| |
| //Includes iperlsys.h and function definitions |
| #include "nwperlsys.h" |
| |
| /*============================================================================================ |
| |
| Function : fnFreeMemEntry |
| |
| Description : Called for each outstanding memory allocation at the end of a script run. |
| Frees the outstanding allocations |
| |
| Parameters : ptr (IN). |
| context (IN) |
| |
| Returns : Nothing. |
| |
| ==============================================================================================*/ |
| |
| void fnFreeMemEntry(void* ptr, void* context) |
| { |
| if(ptr) |
| { |
| PerlMemFree(NULL, ptr); |
| } |
| } |
| /*============================================================================================ |
| |
| Function : fnAllocListHash |
| |
| Description : Hashing function for hash table of memory allocations. |
| |
| Parameters : invalue (IN). |
| |
| Returns : unsigned. |
| |
| ==============================================================================================*/ |
| |
| unsigned fnAllocListHash(void* const& invalue) |
| { |
| return (((unsigned) invalue & 0x0000ff00) >> 8); |
| } |
| |
| /*============================================================================================ |
| |
| Function : perl_alloc |
| |
| Description : creates a Perl interpreter variable and initializes |
| |
| Parameters : none |
| |
| Returns : Pointer to Perl interpreter |
| |
| ==============================================================================================*/ |
| |
| EXTERN_C PerlInterpreter* |
| perl_alloc(void) |
| { |
| PerlInterpreter* my_perl = NULL; |
| |
| WCValHashTable<void*>* m_allocList; |
| m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); |
| fnInsertHashListAddrs(m_allocList, FALSE); |
| my_perl = perl_alloc_using(&perlMem, |
| &perlMem, |
| NULL, |
| &perlEnv, |
| &perlStdIO, |
| &perlLIO, |
| &perlDir, |
| &perlSock, |
| &perlProc); |
| if (my_perl) { |
| //nw5_internal_host = m_allocList; |
| } |
| return my_perl; |
| } |
| |
| /*============================================================================================ |
| |
| Function : perl_alloc_override |
| |
| Description : creates a Perl interpreter variable and initializes |
| |
| Parameters : Pointer to structure containing function pointers |
| |
| Returns : Pointer to Perl interpreter |
| |
| ==============================================================================================*/ |
| EXTERN_C PerlInterpreter* |
| perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, |
| struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, |
| struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, |
| struct IPerlDir** ppDir, struct IPerlSock** ppSock, |
| struct IPerlProc** ppProc) |
| { |
| PerlInterpreter *my_perl = NULL; |
| |
| struct IPerlMem* lpMem; |
| struct IPerlEnv* lpEnv; |
| struct IPerlStdIO* lpStdio; |
| struct IPerlLIO* lpLIO; |
| struct IPerlDir* lpDir; |
| struct IPerlSock* lpSock; |
| struct IPerlProc* lpProc; |
| |
| WCValHashTable<void*>* m_allocList; |
| m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); |
| fnInsertHashListAddrs(m_allocList, FALSE); |
| |
| if (!ppMem) |
| lpMem=&perlMem; |
| else |
| lpMem=*ppMem; |
| |
| if (!ppEnv) |
| lpEnv=&perlEnv; |
| else |
| lpEnv=*ppEnv; |
| |
| if (!ppStdIO) |
| lpStdio=&perlStdIO; |
| else |
| lpStdio=*ppStdIO; |
| |
| if (!ppLIO) |
| lpLIO=&perlLIO; |
| else |
| lpLIO=*ppLIO; |
| |
| if (!ppDir) |
| lpDir=&perlDir; |
| else |
| lpDir=*ppDir; |
| |
| if (!ppSock) |
| lpSock=&perlSock; |
| else |
| lpSock=*ppSock; |
| |
| if (!ppProc) |
| lpProc=&perlProc; |
| else |
| lpProc=*ppProc; |
| my_perl = perl_alloc_using(lpMem, |
| lpMem, |
| NULL, |
| lpEnv, |
| lpStdio, |
| lpLIO, |
| lpDir, |
| lpSock, |
| lpProc); |
| |
| if (my_perl) { |
| //nw5_internal_host = pHost; |
| } |
| return my_perl; |
| } |
| /*============================================================================================ |
| |
| Function : nw5_delete_internal_host |
| |
| Description : Deletes the alloc_list pointer |
| |
| Parameters : alloc_list pointer |
| |
| Returns : none |
| |
| ==============================================================================================*/ |
| |
| EXTERN_C void |
| nw5_delete_internal_host(void *h) |
| { |
| WCValHashTable<void*>* m_allocList; |
| void **listptr; |
| BOOL m_dontTouchHashLists; |
| if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
| m_allocList = (WCValHashTable<void*>*)listptr; |
| fnInsertHashListAddrs(m_allocList, TRUE); |
| if (m_allocList) |
| { |
| m_allocList->forAll(fnFreeMemEntry, NULL); |
| fnInsertHashListAddrs(NULL, FALSE); |
| delete m_allocList; |
| } |
| } |
| } |
| |
| #endif /* PERL_IMPLICIT_SYS */ |