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 #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
  33 //Includes iperlsys.h and function definitions
  34 #include "nwperlsys.h"
  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
 108                 //nw5_internal_host = m_allocList;
 109         }
 110     return my_perl;
 111 }
 112
 113 /*============================================================================================
 114
 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
 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 */