NetWare/perllib.cpp

   1
   2 /*
   3  * Copyright © 2001 Novell, Inc. All Rights Reserved.
   4  *
   5  * You may distribute under the terms of either the GNU General Public
   6  * License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * FILENAME             :       perllib.c
  12  * DESCRIPTION  :       Library functions for parsing and running Perl.
  13  *                  This is based on the perllib.c file of Win32 port.
  14  * Author               :       SGP
  15  * Date                 :       January 2001.
  16  *
  17  */
  18
  19 /*
  20  * "The Road goes ever on and on, down from the door where it began."
  21  */
  22
  23
  24
  25 #include "EXTERN.h"
  26 #include "perl.h"
  27
  28
  29 #ifdef PERL_OBJECT
  30 #define NO_XSLOCKS
  31 #endif
  32
  33 //CHKSGP
  34 //Including this is giving premature end-of-file error during compilation
  35 //#include "XSUB.h"
  36
  37 #ifdef PERL_IMPLICIT_SYS
  38
  39 #include "nw5iop.h"
  40 #include <fcntl.h>
  41
  42 #endif  //PERL_IMPLICIT_SYS
  43
  44
  45 #ifdef PERL_IMPLICIT_SYS
  46
  47 #include "nwperlhost.h"
  48 #define w32_internal_host               (PL_sys_intern.internal_host)   // (J)
  49
  50
  51 EXTERN_C void
  52 perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
  53                    struct IPerlMemInfo* perlMemSharedInfo,
  54                    struct IPerlMemInfo* perlMemParseInfo,
  55                    struct IPerlEnvInfo* perlEnvInfo,
  56                    struct IPerlStdIOInfo* perlStdIOInfo,
  57                    struct IPerlLIOInfo* perlLIOInfo,
  58                    struct IPerlDirInfo* perlDirInfo,
  59                    struct IPerlSockInfo* perlSockInfo,
  60                    struct IPerlProcInfo* perlProcInfo)
  61 {
  62     if (perlMemInfo) {
  63         Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
  64         perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
  65     }
  66     if (perlMemSharedInfo) {
  67         Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*);
  68         perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
  69     }
  70     if (perlMemParseInfo) {
  71         Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*);
  72         perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
  73     }
  74     if (perlEnvInfo) {
  75         Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
  76         perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
  77     }
  78     if (perlStdIOInfo) {
  79         Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
  80         perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
  81     }
  82     if (perlLIOInfo) {
  83         Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
  84         perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
  85     }
  86     if (perlDirInfo) {
  87         Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
  88         perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
  89     }
  90     if (perlSockInfo) {
  91         Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
  92         perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
  93     }
  94     if (perlProcInfo) {
  95         Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
  96         perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
  97     }
  98 }
  99
 100 EXTERN_C PerlInterpreter*
 101 perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
 102                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
 103                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
 104                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
 105                  struct IPerlProc** ppProc)
 106 {
 107     PerlInterpreter *my_perl = NULL;
 108     CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv,
 109                                      ppStdIO, ppLIO, ppDir, ppSock, ppProc);
 110
 111     if (pHost) {
 112         my_perl = perl_alloc_using(pHost->m_pHostperlMem,
 113                                    pHost->m_pHostperlMemShared,
 114                                    pHost->m_pHostperlMemParse,
 115                                    pHost->m_pHostperlEnv,
 116                                    pHost->m_pHostperlStdIO,
 117                                    pHost->m_pHostperlLIO,
 118                                    pHost->m_pHostperlDir,
 119                                    pHost->m_pHostperlSock,
 120                                    pHost->m_pHostperlProc);
 121         if (my_perl) {
 122 #ifdef PERL_OBJECT
 123             CPerlObj* pPerl = (CPerlObj*)my_perl;
 124 #endif
 125             w32_internal_host = pHost;
 126         }
 127     }
 128     return my_perl;
 129 }
 130
 131 EXTERN_C PerlInterpreter*
 132 perl_alloc(void)
 133 {
 134     PerlInterpreter* my_perl = NULL;
 135     CPerlHost* pHost = new CPerlHost();
 136     if (pHost) {
 137         my_perl = perl_alloc_using(pHost->m_pHostperlMem,
 138                                    pHost->m_pHostperlMemShared,
 139                                    pHost->m_pHostperlMemParse,
 140                                    pHost->m_pHostperlEnv,
 141                                    pHost->m_pHostperlStdIO,
 142                                    pHost->m_pHostperlLIO,
 143                                    pHost->m_pHostperlDir,
 144                                    pHost->m_pHostperlSock,
 145                                    pHost->m_pHostperlProc);
 146         if (my_perl) {
 147 #ifdef PERL_OBJECT
 148             CPerlObj* pPerl = (CPerlObj*)my_perl;
 149 #endif
 150                 //The following Should be uncommented - CHKSGP
 151             w32_internal_host = pHost;
 152         }
 153     }
 154     return my_perl;
 155 }
 156
 157 EXTERN_C void
 158 nw_delete_internal_host(void *h)
 159 {
 160     CPerlHost *host = (CPerlHost*)h;
 161     if(host && h)
 162     {
 163         delete host;
 164         host=NULL;
 165         h=NULL;
 166     }
 167 }
 168
 169 #ifdef PERL_OBJECT
 170
 171 EXTERN_C void
 172 perl_construct(PerlInterpreter* my_perl)
 173 {
 174     CPerlObj* pPerl = (CPerlObj*)my_perl;
 175     try
 176     {
 177         Perl_construct();
 178     }
 179     catch(...)
 180     {
 181         win32_fprintf(stderr, "%s\n",
 182                       "Error: Unable to construct data structures");
 183         perl_free(my_perl);
 184     }
 185 }
 186
 187 EXTERN_C void
 188 perl_destruct(PerlInterpreter* my_perl)
 189 {
 190     CPerlObj* pPerl = (CPerlObj*)my_perl;
 191 #ifdef DEBUGGING
 192     Perl_destruct();
 193 #else
 194     try
 195     {
 196         Perl_destruct();
 197     }
 198     catch(...)
 199     {
 200     }
 201 #endif
 202 }
 203
 204 EXTERN_C void
 205 perl_free(PerlInterpreter* my_perl)
 206 {
 207     CPerlObj* pPerl = (CPerlObj*)my_perl;
 208     void *host = w32_internal_host;
 209 #ifdef DEBUGGING
 210     Perl_free();
 211 #else
 212     try
 213     {
 214         Perl_free();
 215     }
 216     catch(...)
 217     {
 218     }
 219 #endif
 220     win32_delete_internal_host(host);
 221     PERL_SET_THX(NULL);
 222 }
 223
 224 EXTERN_C int
 225 perl_run(PerlInterpreter* my_perl)
 226 {
 227     CPerlObj* pPerl = (CPerlObj*)my_perl;
 228     int retVal;
 229 #ifdef DEBUGGING
 230     retVal = Perl_run();
 231 #else
 232     try
 233     {
 234         retVal = Perl_run();
 235     }
 236     catch(...)
 237     {
 238         win32_fprintf(stderr, "Error: Runtime exception\n");
 239         retVal = -1;
 240     }
 241 #endif
 242     return retVal;
 243 }
 244
 245 EXTERN_C int
 246 perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
 247 {
 248     int retVal;
 249     CPerlObj* pPerl = (CPerlObj*)my_perl;
 250 #ifdef DEBUGGING
 251     retVal = Perl_parse(xsinit, argc, argv, env);
 252 #else
 253     try
 254     {
 255         retVal = Perl_parse(xsinit, argc, argv, env);
 256     }
 257     catch(...)
 258     {
 259         win32_fprintf(stderr, "Error: Parse exception\n");
 260         retVal = -1;
 261     }
 262 #endif
 263     *win32_errno() = 0;
 264     return retVal;
 265 }
 266
 267 #undef PL_perl_destruct_level
 268 #define PL_perl_destruct_level int dummy
 269
 270 #endif /* PERL_OBJECT */
 271 #endif /* PERL_IMPLICIT_SYS */
 272
 273