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         struct IPerlMem*        lpMem;
 134         struct IPerlEnv*        lpEnv;
 135         struct IPerlStdIO*      lpStdio;
 136         struct IPerlLIO*        lpLIO;
 137         struct IPerlDir*        lpDir;
 138         struct IPerlSock*       lpSock;
 139         struct IPerlProc*       lpProc;
 140
 141         WCValHashTable<void*>*  m_allocList;
 142         m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
 143         fnInsertHashListAddrs(m_allocList, FALSE);
 144
 145         if (!ppMem)
 146                 lpMem=&perlMem;
 147         else
 148                 lpMem=*ppMem;
 149
 150         if (!ppEnv)
 151                 lpEnv=&perlEnv;
 152         else
 153                 lpEnv=*ppEnv;
 154
 155         if (!ppStdIO)
 156                 lpStdio=&perlStdIO;
 157         else
 158                 lpStdio=*ppStdIO;
 159
 160         if (!ppLIO)
 161                 lpLIO=&perlLIO;
 162         else
 163                 lpLIO=*ppLIO;
 164
 165         if (!ppDir)
 166                 lpDir=&perlDir;
 167         else
 168                 lpDir=*ppDir;
 169
 170         if (!ppSock)
 171                 lpSock=&perlSock;
 172         else
 173                 lpSock=*ppSock;
 174
 175         if (!ppProc)
 176                 lpProc=&perlProc;
 177         else
 178                 lpProc=*ppProc;
 179
 180         my_perl = perl_alloc_using(lpMem,
 181                                    NULL,
 182                                    NULL,
 183                                    lpEnv,
 184                                    lpStdio,
 185                                    lpLIO,
 186                                    lpDir,
 187                                    lpSock,
 188                                    lpProc);
 189
 190         if (my_perl) {
 191 #ifdef PERL_OBJECT
 192             CPerlObj* pPerl = (CPerlObj*)my_perl;
 193 #endif
 194             //nw5_internal_host = pHost;
 195         }
 196     return my_perl;
 197 }
 198 /*============================================================================================
 199
 200  Function               :       nw5_delete_internal_host
 201
 202  Description    :       Deletes the alloc_list pointer
 203
 204  Parameters     :       alloc_list pointer
 205
 206  Returns                :       none
 207
 208 ==============================================================================================*/
 209
 210 EXTERN_C void
 211 nw5_delete_internal_host(void *h)
 212 {
 213         WCValHashTable<void*>*  m_allocList;
 214         void **listptr;
 215         BOOL m_dontTouchHashLists;
 216         if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
 217                 m_allocList = (WCValHashTable<void*>*)listptr;
 218                 fnInsertHashListAddrs(m_allocList, TRUE);
 219                 if (m_allocList)
 220                 {
 221                         m_allocList->forAll(fnFreeMemEntry, NULL);
 222                         fnInsertHashListAddrs(NULL, FALSE);
 223                         delete m_allocList;
 224                 }
 225         }
 226 }
 227
 228 #endif /* PERL_IMPLICIT_SYS */