/* 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: Ext.h 9432 2010-02-01 23:30:24Z gawrilow $
*/

#ifndef _POLYMAKE_XS_EXT_H
#define _POLYMAKE_XS_EXT_H

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <perl/glue.h>

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(SV *x)
{
   if (x != &PL_sv_undef) SvREADONLY_on(x);
}

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

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>=5010
#  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
#endif

#ifndef AvARRAY_set
#  if PerlVersion>=5010
#    define AvARRAY_set(av,ptr) AvARRAY(av)=(ptr)
#  else
#    define AvARRAY_set(av,ptr) SvPV_set(av, (char*)(ptr))
#  endif
#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

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* select_method_helper_op(pTHX);
I32 get_sparse_dim(pTHX_ SV *avref);

/* public export from namespaces */
SV* try_namespace_lookup(pTHX_ HV *stash, SV *name, I32 type);
HV* namespace_lookup_class(pTHX_ HV *stash, const char *class_name, STRLEN class_namelen, int lex_lookup_ix);
typedef void (*namespace_plugin_fun_ptr)(pTHX_ SV*);
void 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);

#define CppVtblBase		\
   MGVTBL std;			\
   const typeinfo *type;	\
   SV *typeid_name_sv;          \
   SV *const_typeid_name_sv;    \
   size_t obj_size;		\
   int is_declared;		\
   int obj_dimension;		\
   SV* (*sv_maker)(pTHX_ SV* dst_ref, SV* descr_ref, int flags); \
   SV* (*sv_cloner)(pTHX_ SV* src);				 \
   copy_constructor_type copy_constructor;			 \
   assignment_type assignment;					 \
   destructor_type destructor

#define CppVtblCommon	\
   CppVtblBase;		\
   conv_to_SV_type to_string

#define CppVtblOpaque   \
   CppVtblCommon;	\
   conv_to_SV_type to_serialized

typedef struct cpp_basic_vtbl {
   CppVtblBase;
} cpp_basic_vtbl;

typedef struct cpp_scalar_vtbl {
   CppVtblOpaque;
   conv_to_int_type to_int;
   conv_to_double_type to_double;
} cpp_scalar_vtbl;

typedef struct cpp_opaque_vtbl {
   CppVtblOpaque;
   provide_type provide_serialized_type;
} cpp_opaque_vtbl;

typedef struct cpp_container_access_vtbl {
   size_t obj_size;
   destructor_type destructor;
   container_begin_type begin;
   container_access_type deref;
   container_access_type random;
} cpp_container_access_vtbl;

typedef struct cpp_container_vtbl {
   CppVtblCommon;
   conv_to_int_type size;
   conv_to_int_type empty;
   container_resize_type resize;
   container_store_type store_at_ref;
   provide_type provide_key_type;
   provide_type provide_value_type;
   cpp_container_access_vtbl acc[4];
   AV *assoc_methods;
} cpp_container_vtbl;

typedef struct cpp_iterator_vtbl {
   CppVtblBase;
   iterator_deref_type deref;
   iterator_incr_type incr;
   conv_to_int_type at_end;
} cpp_iterator_vtbl;

typedef struct cpp_composite_access_vtbl {
   composite_access_type get[2];
   SV* (*store)(char*, SV*);
} cpp_composite_access_vtbl;

typedef struct cpp_composite_vtbl {
   CppVtblCommon;
   int n_elems;
   provide_type provide_elem_types;
   cpp_composite_access_vtbl acc[1];
} cpp_composite_vtbl;

#ifdef PERL_IMPLICIT_CONTEXT
# ifdef USE_5005THREADS
#  define aTHXtype struct perl_thread*
# else
#  define aTHXtype PerlInterpreter*
# endif
 extern aTHXtype pm_perl_aTHXvar;
#endif

extern HV *pm_perl_FuncDescr_stash,
          *pm_perl_TypeDescr_stash;
extern int pm_perl_FuncDescr_fill,
           pm_perl_TypeDescr_fill;
extern SV *pm_perl_cur_wrapper_cv;
extern cpp_basic_vtbl *pm_perl_cur_class_vtbl;
extern GV *pm_perl_cpp_root,
          *pm_perl_nesting_level_gv;
extern SV *pm_perl_neg_ind_key;

extern int pm_perl_TypeDescr_pkg_index, pm_perl_TypeDescr_vtbl_index,
           pm_perl_FuncDescr_wrapper_index,
           pm_perl_CPPOptions_builtin_index, pm_perl_CPPOptions_descr_index,
           pm_perl_PropertyType_pkg_index, pm_perl_PropertyType_application_index, pm_perl_PropertyType_cppoptions_index,
           pm_perl_CPP_functions_index, pm_perl_CPP_regular_functions_index,
           pm_perl_CPP_embedded_rules_index, pm_perl_CPP_embedded_property_types_index,
           pm_perl_CPP_classes_index, pm_perl_CPP_templates_index, pm_perl_CPP_typeids_index,
           pm_perl_CPP_auto_convert_constructor_index, pm_perl_CPP_auto_assignment_index, pm_perl_CPP_auto_conversion_index,
           pm_perl_CPP_auto_assoc_methods_index, pm_perl_CPP_auto_set_methods_index,
           pm_perl_CPP_assoc_helem_index, pm_perl_CPP_assoc_find_index, pm_perl_CPP_assoc_exists_index,
           pm_perl_CPP_assoc_delete_void_index, pm_perl_CPP_assoc_delete_ret_index,
           pm_perl_Application_cpp_index;

int pm_perl_cpp_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param);
int pm_perl_cpp_free(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_container_free(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_assoc_container_free(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_container_clear(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_assoc_clear(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_assigned(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_primitive_assigned(pTHX_ SV *sv, MAGIC* mg);
U32 pm_perl_cpp_container_size(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_container_access(pTHX_ SV *sv, MAGIC* mg, SV *nsv, const char *dummy, int index);
int pm_perl_cpp_assoc_value_access(pTHX_ SV *sv, MAGIC* mg, SV *val_sv, const char *key, int klen);
U32 pm_perl_cpp_composite_size(pTHX_ SV *sv, MAGIC* mg);
int pm_perl_cpp_composite_access(pTHX_ SV *sv, MAGIC* mg, SV *nsv, const char *dummy, int index);
SV* pm_perl_new_builtin_magic_sv(pTHX_ SV* dst_ref, SV* descr_ref, int flags);
SV* pm_perl_new_scalar_magic_sv(pTHX_ SV* dst_ref, SV* descr_ref, int flags);
SV* pm_perl_new_container_magic_sv(pTHX_ SV* dst_ref, SV* descr_ref, int flags);
SV* pm_perl_new_assoc_container_magic_sv(pTHX_ SV* dst_ref, SV* descr_ref, int flags);
SV* pm_perl_new_composite_magic_sv(pTHX_ SV* dst_ref, SV* descr_ref, int flags);
SV* pm_perl_clone_builtin_magic_sv(pTHX_ SV *src);
SV* pm_perl_clone_scalar_magic_sv(pTHX_ SV *src);
SV* pm_perl_clone_container_magic_sv(pTHX_ SV *src);
SV* pm_perl_clone_assoc_container_magic_sv(pTHX_ SV *src);
SV* pm_perl_clone_composite_magic_sv(pTHX_ SV *src);
SV* pm_perl_get_name_of_ret_var(pTHX);

/* the container types get sometimes other magic appendices, e.g. array length in perl 5.10 */
static inline
MAGIC* get_cpp_magic(SV *sv)
{
   MAGIC *mg;
   for (mg=SvMAGIC(sv); mg && mg->mg_virtual->svt_dup != &pm_perl_cpp_dup; mg=mg->mg_moremagic) ;
   return mg;
}

#endif /* _POLYMAKE_XS_EXT_H */
