diff options
Diffstat (limited to 'NetWare/perllib.cpp')
| -rw-r--r-- | NetWare/perllib.cpp | 273 |
1 files changed, 273 insertions, 0 deletions
diff --git a/NetWare/perllib.cpp b/NetWare/perllib.cpp new file mode 100644 index 0000000000..a9eb824860 --- /dev/null +++ b/NetWare/perllib.cpp @@ -0,0 +1,273 @@ + +/* + * Copyright © 2001 Novell, Inc. All Rights Reserved. + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * FILENAME : perllib.c + * DESCRIPTION : Library functions for parsing and running Perl. + * This is based on the perllib.c file of Win32 port. + * Author : SGP + * Date : January 2001. + * + */ + +/* + * "The Road goes ever on and on, down from the door where it began." + */ + + + +#include "EXTERN.h" +#include "perl.h" + + +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#endif + +//CHKSGP +//Including this is giving premature end-of-file error during compilation +//#include "XSUB.h" + +#ifdef PERL_IMPLICIT_SYS + +#include "nw5iop.h" +#include <fcntl.h> + +#endif //PERL_IMPLICIT_SYS + + +#ifdef PERL_IMPLICIT_SYS + +#include "nwperlhost.h" +#define w32_internal_host (PL_sys_intern.internal_host) // (J) + + +EXTERN_C void +perl_get_host_info(struct IPerlMemInfo* perlMemInfo, + struct IPerlMemInfo* perlMemSharedInfo, + struct IPerlMemInfo* perlMemParseInfo, + struct IPerlEnvInfo* perlEnvInfo, + struct IPerlStdIOInfo* perlStdIOInfo, + struct IPerlLIOInfo* perlLIOInfo, + struct IPerlDirInfo* perlDirInfo, + struct IPerlSockInfo* perlSockInfo, + struct IPerlProcInfo* perlProcInfo) +{ + if (perlMemInfo) { + Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*); + perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + } + if (perlMemSharedInfo) { + Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*); + perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + } + if (perlMemParseInfo) { + Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*); + perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + } + if (perlEnvInfo) { + Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*); + perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*)); + } + if (perlStdIOInfo) { + Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*); + perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*)); + } + if (perlLIOInfo) { + Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*); + perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*)); + } + if (perlDirInfo) { + Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*); + perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*)); + } + if (perlSockInfo) { + Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*); + perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*)); + } + if (perlProcInfo) { + Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*); + perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*)); + } +} + +EXTERN_C PerlInterpreter* +perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) +{ + PerlInterpreter *my_perl = NULL; + CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv, + ppStdIO, ppLIO, ppDir, ppSock, ppProc); + + if (pHost) { + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { +#ifdef PERL_OBJECT + CPerlObj* pPerl = (CPerlObj*)my_perl; +#endif + w32_internal_host = pHost; + } + } + return my_perl; +} + +EXTERN_C PerlInterpreter* +perl_alloc(void) +{ + PerlInterpreter* my_perl = NULL; + CPerlHost* pHost = new CPerlHost(); + if (pHost) { + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { +#ifdef PERL_OBJECT + CPerlObj* pPerl = (CPerlObj*)my_perl; +#endif + //The following Should be uncommented - CHKSGP + w32_internal_host = pHost; + } + } + return my_perl; +} + +EXTERN_C void +nw_delete_internal_host(void *h) +{ + CPerlHost *host = (CPerlHost*)h; + if(host && h) + { + delete host; + host=NULL; + h=NULL; + } +} + +#ifdef PERL_OBJECT + +EXTERN_C void +perl_construct(PerlInterpreter* my_perl) +{ + CPerlObj* pPerl = (CPerlObj*)my_perl; + try + { + Perl_construct(); + } + catch(...) + { + win32_fprintf(stderr, "%s\n", + "Error: Unable to construct data structures"); + perl_free(my_perl); + } +} + +EXTERN_C void +perl_destruct(PerlInterpreter* my_perl) +{ + CPerlObj* pPerl = (CPerlObj*)my_perl; +#ifdef DEBUGGING + Perl_destruct(); +#else + try + { + Perl_destruct(); + } + catch(...) + { + } +#endif +} + +EXTERN_C void +perl_free(PerlInterpreter* my_perl) +{ + CPerlObj* pPerl = (CPerlObj*)my_perl; + void *host = w32_internal_host; +#ifdef DEBUGGING + Perl_free(); +#else + try + { + Perl_free(); + } + catch(...) + { + } +#endif + win32_delete_internal_host(host); + PERL_SET_THX(NULL); +} + +EXTERN_C int +perl_run(PerlInterpreter* my_perl) +{ + CPerlObj* pPerl = (CPerlObj*)my_perl; + int retVal; +#ifdef DEBUGGING + retVal = Perl_run(); +#else + try + { + retVal = Perl_run(); + } + catch(...) + { + win32_fprintf(stderr, "Error: Runtime exception\n"); + retVal = -1; + } +#endif + return retVal; +} + +EXTERN_C int +perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) +{ + int retVal; + CPerlObj* pPerl = (CPerlObj*)my_perl; +#ifdef DEBUGGING + retVal = Perl_parse(xsinit, argc, argv, env); +#else + try + { + retVal = Perl_parse(xsinit, argc, argv, env); + } + catch(...) + { + win32_fprintf(stderr, "Error: Parse exception\n"); + retVal = -1; + } +#endif + *win32_errno() = 0; + return retVal; +} + +#undef PL_perl_destruct_level +#define PL_perl_destruct_level int dummy + +#endif /* PERL_OBJECT */ +#endif /* PERL_IMPLICIT_SYS */ + + |