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