/* Copyright (c) 1997-2010
   Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
   http://www.polymake.de

   This program is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by the
   Free Software Foundation; either version 2, or (at your option) any
   later version: http://www.gnu.org/licenses/gpl.txt.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
--------------------------------------------------------------------------------
   $Project: polymake $$Id: Main.cc 10007 2011-01-05 16:39:38Z gawrilow $
*/

#include "polymake/perl/glue.h"
#include "polymake/Main.h"
#include "polymake/internal/lib_init.h"
#include "Bootstrap.h"

#include <memory>
#include <gmp.h>

#ifdef __APPLE__
# include <crt_externs.h>
# define PmGetEnvironPtr _NSGetEnviron()
#else
# define PmGetEnvironPtr &environ
#endif

namespace pm { namespace perl {
namespace {

const char globalScope[]="Polymake::Scope";

GV *globalScope_gv=NULL;

void destroy_perl(pTHXx)
{
   PL_perl_destruct_level = 1;
   perl_destruct(aTHXx);
   perl_free(aTHXx);
   PERL_SYS_TERM();
}

#ifndef PERL_IMPLICIT_CONTEXT
PerlInterpreter *static_perl = NULL;
#endif

void emergency_cleanup() __attribute__((destructor));
void emergency_cleanup()
{
   if (PL_curinterp) {
#ifdef PERL_IMPLICIT_CONTEXT
      dTHX;
      destroy_perl(aTHX);
#else
      destroy_perl(static_perl);
#endif
   }
}

#ifdef POLYMAKE_CONF_FinkBase
#  define addlibs ", \"" POLYMAKE_CONF_FinkBase "/lib/perl5\""
#else
#  define addlibs ""
#endif
#if POLYMAKE_DEBUG
#  define debuglevel "$DB::single=1; $DebugLevel=1;"
#else
#  define debuglevel ""
#endif

const char scr1[]=
"#line " FirstArgAsString(__LINE__) " \"" __FILE__ "\"\n" "package Polymake;\n"
"BEGIN { " debuglevel "\n"
"   $InstallTop='",   scr2[]="';\n"
"   $InstallArch='",  scr3[]="';\n"
"   $Arch='" POLYMAKE_CONF_Arch "';\n"
"}\n"
"use lib \"$InstallTop/perllib\", \"$InstallArch/perlx\"" addlibs ";\n"
"use Polymake::Main q{", scr4[]="};\n"
"1\n";

#undef addlibs
#undef debuglevel
}

Main::Main(const std::string& user_opts, const std::string& install_top, const std::string& install_arch)
{
   if (PL_curinterp != NULL) return;
   std::string script_arg(scr1);
   if (install_top.empty())
      script_arg+=POLYMAKE_CONF_InstallTop;
   else
      script_arg+=install_top;
   script_arg+=scr2;
   if (install_arch.empty())
      script_arg+=POLYMAKE_CONF_InstallArch;
   else
      script_arg+=install_arch;
   script_arg+=scr3;
   script_arg+=user_opts;
   script_arg+=scr4;
   const char* perl_start_args[]={ "perl", "-e", script_arg.c_str(), 0 };
   int argc=sizeof(perl_start_args)/sizeof(perl_start_args[0])-1;
   const char **argv=perl_start_args;
   char *** const env=PmGetEnvironPtr;
   /* the casts looking evil here, but fortunately, nothing harmful happens within this macro */
   PERL_SYS_INIT3(&argc, (char***)&argv, env);
   pTHXx = perl_alloc();
   PL_perl_destruct_level = 1;
   perl_construct(aTHXx);
   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
   if (perl_parse(aTHXx, xs_init, argc, (char**)argv, *env)) {
      destroy_perl(aTHXx);
      throw std::runtime_error("could not initialize the perl interpreter");
   }
#ifndef PERL_IMPLICIT_CONTEXT
   static_perl=aTHXx;
#endif
   perl_run(aTHXx);
   globalScope_gv=gv_fetchpvn_flags(globalScope, sizeof(globalScope)-1, false, SVt_RV);

   // switch to custom GMP allocators only if no other component did it before
   void* (*was_alloc)(size_t);
#if __GNU_MP_VERSION>4 || __GNU_MP_VERSION==4 && __GNU_MP_VERSION_MINOR>=2
   mp_get_memory_functions(&was_alloc, NULL, NULL);
#else
   was_alloc=__gmp_allocate_func;
#endif
   if (was_alloc==&malloc) init_gmp_memory_management();
}

unsigned int Scope::depth=0;

Scope::~Scope()
{
   if (saved != NULL) {
      dTHX;
      if (depth-- != id) {
         // can't throw an exception from a constructor
         std::cerr << "polymake::perl::Scope nesting violation" << std::endl;
         std::terminate();
      }
      sv_unref_flags(GvSV(globalScope_gv), SV_IMMEDIATE_UNREF);
      sv_setsv(GvSV(globalScope_gv), saved);
      SvREFCNT_dec(saved);
   }
}

} }

// Local Variables:
// mode:C++
// c-basic-offset:3
// indent-tabs-mode:nil
// End:
