/* Copyright (c) 1997-2011
   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: Ext.h 10118 2011-03-31 20:29:10Z gawrilow $
*/

#ifndef POLYMAKE_PERL_EXT_H
#define POLYMAKE_PERL_EXT_H

#include <EXTERN.h>
#include <perl.h>
#ifdef PERL_IMPLICIT_CONTEXT
/* pass the interpreter via my_perl variable as far as possible, avoid expensive pthread_getspecific */
#  define PERL_NO_GET_CONTEXT
#  define getTHX aTHX
#else
#  ifdef dTHX
#    undef dTHX
#    define dTHX
#  endif
#  ifdef dTHXa
#    undef dTHXa
#    define dTHXa(a)
#  endif
#  define getTHX NULL
#endif
/* avoid annoying compiler warnings about unused variables */
#ifndef PERL_GLOBAL_STRUCT
#  ifdef dVAR
#    undef dVAR
#  endif
#endif
#include <XSUB.h>

#include "polymake/perl/constants.h"

extern I32 pm_perl_skip_debug_cx;
#define SkipDebugSub(cv) (pm_perl_skip_debug_cx && CvSTASH(cv)==PL_debstash)
#define SkipDebugFrame(cx,plus_level) (pm_perl_skip_debug_cx && ((plus_level && CvSTASH(cx->blk_sub.cv)==PL_debstash) || CopSTASH_eq(cx->blk_oldcop,PL_debstash)))

#if PerlVersion >= 5120
#  define ForLoopArray(cx)      (cx)->blk_loop.state_u.ary.ary
EXTERN_C AV* Perl_av_fake(pTHX_ I32 size, SV **strp);
#  define SAVEt_PADSV SAVEt_PADSV_AND_MORTALIZE
#  define PM_svt_copy_klen_arg  I32
#else
#  define ForLoopArray(cx)      (cx)->blk_loop.iterary
#  define PM_svt_copy_klen_arg  int
#endif

#if PerlVersion >= 5100
#  define ReturnsToOp(cx)       (cx)->blk_sub.retop
#  define PL_lex_brackets       (PL_parser->lex_brackets)
#  define PL_lex_state          (PL_parser->lex_state)
#  define PL_lex_inwhat         (PL_parser->lex_inwhat)
#  define PL_expect             (PL_parser->expect)
#  define PL_lex_expect         (PL_parser->lex_expect)
#  define PL_lex_defer          (PL_parser->lex_defer)
#  define PL_bufptr             (PL_parser->bufptr)
#  define PL_oldbufptr          (PL_parser->oldbufptr)
#  define PL_oldoldbufptr       (PL_parser->oldoldbufptr)
#  define PL_nexttoke           (PL_parser->nexttoke)
#  define PL_nexttype           (PL_parser->nexttype)
#  define PL_nextval            (PL_parser->nextval)
#else
#  define ReturnsToOp(cx)       PL_retstack[(cx)->blk_oldretsp-1]
#  ifndef SvRV_set
#    define SvRV_set(ref,what) SvRV(ref)=(what)
#  endif
#  ifndef GvSVn
#    define GvSVn(x) GvSV(x)
#  endif
#  ifndef CvISXSUB
#    define CvISXSUB(x) (CvXSUB(x)!=0)
#  endif
#  ifndef SvSHARED_HASH
#    define SvSHARED_HASH(x) (SvUVX(x))
#  endif
#  ifndef gv_fetchpvn_flags
#    define gv_fetchpvn_flags(name,nl,flags,type) gv_fetchpv(name,flags,type)
#  endif
#endif

#ifndef CxHASARGS
#  define CxHASARGS(cx)         (cx)->blk_sub.hasargs
#endif

#ifndef AvARRAY_set
#  if PerlVersion >= 5100
#    define AvARRAY_set(av,ptr) AvARRAY(av)=(ptr)
#  else
#    define AvARRAY_set(av,ptr) SvPV_set(av, (char*)(ptr))
#  endif
#endif

#ifndef croak_xs_usage
#  define croak_xs_usage(cv, text) Perl_croak(aTHX_ "usage: %*.s(" text ")", (int)GvNAMELEN(CvGV(cv)), GvNAME(CvGV(cv)))
#endif

/* these values have to be checked in toke.c for each new perl release */
#define LEX_KNOWNEXT 0
#define LEX_NORMAL 10

/* check whether this private flag is free for each new perl release */
#define OPpENTERSUB_AASSIGN_LHS 1

START_EXTERN_C

CV* pm_perl_get_cur_cv(pTHX);
SV **pm_perl_get_cx_curpad(pTHX_ PERL_CONTEXT *cx, PERL_CONTEXT *cx_bottom);

typedef OP* (*ck_fun_ptr)(pTHX_ OP*);
typedef OP* (*op_fun_ptr)(pTHX);

/* public export from Poly */
OP* pm_perl_select_method_helper_op(pTHX);
extern MGVTBL pm_perl_array_flags_vtbl;
SV* pm_perl_name_of_ret_var(pTHX);
int pm_perl_canned_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param);

/* public export from namespaces */
SV* pm_perl_namespace_try_lookup(pTHX_ HV *stash, SV *name, I32 type);
HV* pm_perl_namespace_lookup_class(pTHX_ HV *stash, const char *class_name, STRLEN class_namelen, int lex_lookup_ix);
CV* pm_perl_namespace_lookup_sub(pTHX_ HV *stash, const char *name, STRLEN namelen, CV* lex_context_cv);
typedef void (*namespace_plugin_fun_ptr)(pTHX_ SV*);
void pm_perl_namespace_register_plugin(pTHX_ namespace_plugin_fun_ptr enabler, namespace_plugin_fun_ptr disabler, SV *data);

/* public export from Scope */
void pm_perl_localize_scalar(pTHX_ SV *var);

/* public export from CPlusPlus */
OP* pm_perl_cpp_helem(pTHX_ HV *hv, const MAGIC *mg);
OP* pm_perl_cpp_hslice(pTHX_ HV *hv, const MAGIC *mg);
OP* pm_perl_cpp_exists(pTHX_ HV *hv, const MAGIC *mg);
OP* pm_perl_cpp_delete_hslice(pTHX_ HV* hv, const MAGIC *mg);
OP* pm_perl_cpp_delete_helem(pTHX_ HV* hv, const MAGIC *mg);
OP* pm_perl_cpp_keycnt(pTHX_ HV* hv, const MAGIC *mg);
int pm_perl_cpp_hassign(pTHX_ HV* hv, MAGIC *mg, I32 *firstRp, I32 lastR, int return_size);
int pm_perl_cpp_has_assoc_methods(const MAGIC* mg);

END_EXTERN_C

#ifndef __cplusplus
static inline
I32 min (I32 a, I32 b) { return a<b ? a : b; }

static inline
I32 max (I32 a, I32 b) { return a>b ? a : b; }

static inline
void write_protect_on(pTHX_ SV *x)
{
   if (x != &PL_sv_undef) SvREADONLY_on(x);
}

static inline
void write_protect_off(pTHX_ SV *x)
{
   if (x != &PL_sv_undef) SvREADONLY_off(x);
}
#endif

static inline
MAGIC* pm_perl_get_cpp_magic(SV *sv)
{
   MAGIC *mg;
   for (mg=SvMAGIC(sv); mg && mg->mg_virtual->svt_dup != &pm_perl_canned_dup; mg=mg->mg_moremagic) ;
   return mg;
}

#endif /* POLYMAKE_PERL_EXT_H */

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