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         my_perl = perl_alloc_using(&perlMem,
  91                                    &perlMem,
  92                                    NULL,
  93                                    &perlEnv,
  94                                    &perlStdIO,
  95                                    &perlLIO,
  96                                    &perlDir,
  97                                    &perlSock,
  98                                    &perlProc);
  99         if (my_perl) {
 100                 //nw5_internal_host = m_allocList;
 101         }
 102     return my_perl;
 103 }
 104
 105 /*============================================================================================
 106
 107  Function               :       perl_alloc_override
 108
 109  Description    :       creates a Perl interpreter variable and initializes
 110
 111  Parameters     :       Pointer to structure containing function pointers
 112
 113  Returns                :       Pointer to Perl interpreter
 114
 115 ==============================================================================================*/
 116 EXTERN_C PerlInterpreter*
 117 perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
 118                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
 119                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
 120                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
 121                  struct IPerlProc** ppProc)
 122 {
 123     PerlInterpreter *my_perl = NULL;
 124
 125         struct IPerlMem*        lpMem;
 126         struct IPerlEnv*        lpEnv;
 127         struct IPerlStdIO*      lpStdio;
 128         struct IPerlLIO*        lpLIO;
 129         struct IPerlDir*        lpDir;
 130         struct IPerlSock*       lpSock;
 131         struct IPerlProc*       lpProc;
 132
 133         WCValHashTable<void*>*  m_allocList;
 134         m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
 135         fnInsertHashListAddrs(m_allocList, FALSE);
 136
 137         if (!ppMem)
 138                 lpMem=&perlMem;
 139         else
 140                 lpMem=*ppMem;
 141
 142         if (!ppEnv)
 143                 lpEnv=&perlEnv;
 144         else
 145                 lpEnv=*ppEnv;
 146
 147         if (!ppStdIO)
 148                 lpStdio=&perlStdIO;
 149         else
 150                 lpStdio=*ppStdIO;
 151
 152         if (!ppLIO)
 153                 lpLIO=&perlLIO;
 154         else
 155                 lpLIO=*ppLIO;
 156
 157         if (!ppDir)
 158                 lpDir=&perlDir;
 159         else
 160                 lpDir=*ppDir;
 161
 162         if (!ppSock)
 163                 lpSock=&perlSock;
 164         else
 165                 lpSock=*ppSock;
 166
 167         if (!ppProc)
 168                 lpProc=&perlProc;
 169         else
 170                 lpProc=*ppProc;
 171         my_perl = perl_alloc_using(lpMem,
 172                                    lpMem,
 173                                    NULL,
 174                                    lpEnv,
 175                                    lpStdio,
 176                                    lpLIO,
 177                                    lpDir,
 178                                    lpSock,
 179                                    lpProc);
 180
 181         if (my_perl) {
 182             //nw5_internal_host = pHost;
 183         }
 184     return my_perl;
 185 }
 186 /*============================================================================================
 187
 188  Function               :       nw5_delete_internal_host
 189
 190  Description    :       Deletes the alloc_list pointer
 191
 192  Parameters     :       alloc_list pointer
 193
 194  Returns                :       none
 195
 196 ==============================================================================================*/
 197
 198 EXTERN_C void
 199 nw5_delete_internal_host(void *h)
 200 {
 201         WCValHashTable<void*>*  m_allocList;
 202         void **listptr;
 203         BOOL m_dontTouchHashLists;
 204         if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
 205                 m_allocList = (WCValHashTable<void*>*)listptr;
 206                 fnInsertHashListAddrs(m_allocList, TRUE);
 207                 if (m_allocList)
 208                 {
 209                         m_allocList->forAll(fnFreeMemEntry, NULL);
 210                         fnInsertHashListAddrs(NULL, FALSE);
 211                         delete m_allocList;
 212                 }
 213         }
 214 }
 215
 216 #endif /* PERL_IMPLICIT_SYS */