source: trunk/essentials/dev-lang/perl/NetWare/perllib.cpp@ 3187

/*
 * 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 */