/* Copyright (c) 1997-2006			 -*- C -*-
   Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
   http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.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.
*/

#ident "$Project: polymake $$Id: namespaces.xs 7533 2006-12-20 23:55:58Z gawrilow $"

#include "Ext.h"

#ifdef DEBUGGING
#define DebugNamespaces 1
#endif

struct ToRestore;

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

static ck_fun_ptr def_ck_CONST, def_ck_ENTERSUB, def_ck_LEAVESUB, def_ck_LEAVEEVAL, def_ck_GLOB;
static op_fun_ptr def_pp_GV, def_pp_GVSV, def_pp_RV2GV, def_pp_AELEMFAST, def_pp_ENTEREVAL, def_pp_REGCOMP;

/* TRUE if namespace mode active */
int current_mode() { return PL_ppaddr[OP_GV] != def_pp_GV; }

#ifdef USE_ITHREADS
#define n_saved_words 3
#else
#define n_saved_words 6
#endif

typedef struct ToRestore {
   ANY saved[n_saved_words];
   I32 inserted, old_state, hints, import_from_level;
} ToRestore;

static AV* restores;
static I32 restores_ix=-1;
static HV *last_stash;
static AV *last_dotLOOKUP, *import_from_av;
static CV *declare_cv;
static GV *alt_lookup_gv;
static const char dot_lookup[]=".LOOKUP";
static const char dot_import[]=".IMPORT";
static const char declare[]="declare";
static const char instanceof[]="instanceof";
static I32 skip_debug_cx=FALSE;

static
void catch_ptrs(pTHX_ void *to_restore);

static
void reset_ptrs(pTHX_ void *to_restore);

#ifdef DebugNamespaces
static int debug=0;
#endif

static inline
ToRestore* newToRestore(pTHX_ I32 old_state)
{
   ToRestore *to_restore;
   New(0, to_restore, 1, ToRestore);
   to_restore->old_state=old_state;
   to_restore->hints=PL_hints;
   to_restore->import_from_level=AvFILLp(import_from_av);
   to_restore->inserted=FALSE;
#if DebugNamespaces
   if (debug) fprintf(stderr, "newToRestore(%d) ptr=%p\n", old_state, to_restore), fflush(stderr);
#endif
   return to_restore;
}

static
void finish_undo(pTHX_ ToRestore *to_restore)
{
   I32 where=PL_savestack_ix;
#ifdef USE_ITHREADS
   if (to_restore->inserted) {
      ANY *saved=PL_savestack+where;
      *saved++=to_restore->saved[0];
      *saved++=to_restore->saved[1];
      *saved  =to_restore->saved[2];
      PL_savestack_ix+=3;
   }
#endif
   if (to_restore->old_state)
      PL_hints &= ~HINT_STRICT_VARS;
   else
      PL_hints |= to_restore->hints & HINT_STRICT_VARS;
   av_fill(import_from_av, to_restore->import_from_level);
#ifdef USE_ITHREADS
   Safefree(to_restore);
#endif
   while (restores_ix>0 && SvIVX(*av_fetch(restores, restores_ix, FALSE)) >= where)
      restores_ix-=2;
}

#ifndef USE_ITHREADS
static
void unpack_saved(pTHX_ void *x)
{
   ToRestore *to_restore=(ToRestore*)x;
   I32 where=PL_savestack_ix;
   ANY *saved=PL_savestack+where;
   *saved++=to_restore->saved[0];
   *saved++=to_restore->saved[1];
   *saved++=to_restore->saved[2];
   *saved++=to_restore->saved[3];
   *saved++=to_restore->saved[4];
   *saved  =to_restore->saved[5];
   PL_savestack_ix+=6;
   Safefree(to_restore);
}
#endif

static
ANY* find_bottom_slot(pTHX)
{
   ANY *bottom=PL_savestack, *s=bottom+PL_scopestack[1]-1;
   for (;;) {
      int dist=s-bottom;
      if (dist<=10) {
	 if (dist>=3)
	    return s-2;
	 croak("can't find bottom slot in the save stack");
      }
      switch (s->any_i32) {
      case SAVEt_NSTAB:
      case SAVEt_FREESV:
      case SAVEt_MORTALIZESV:
      case SAVEt_FREEOP:
      case SAVEt_FREEPV:
      case SAVEt_CLEARSV:
      case SAVEt_OP:
      case SAVEt_STACK_POS:
      case SAVEt_COMPPAD:
      case SAVEt_HINTS:
	 s-=2; break;
      case SAVEt_ITEM:
      case SAVEt_INT:
      case SAVEt_LONG:
      case SAVEt_BOOL:
      case SAVEt_I32:
      case SAVEt_I16:
      case SAVEt_I8:
      case SAVEt_IV:
      case SAVEt_PPTR:
      case SAVEt_VPTR:
      case SAVEt_SPTR:
      case SAVEt_HPTR:
      case SAVEt_APTR:
      case SAVEt_DESTRUCTOR:
      case SAVEt_DESTRUCTOR_X:
      case SAVEt_SV:
      case SAVEt_SVREF:
      case SAVEt_GENERIC_SVREF:
      case SAVEt_GENERIC_PVREF:
      case SAVEt_SHARED_PVREF:
      case SAVEt_AV:
      case SAVEt_HV:
	 s-=3; break;
      case SAVEt_PADSV:
      case SAVEt_DELETE:
      case SAVEt_AELEM:
      case SAVEt_HELEM:
	 s-=4; break;
      case SAVEt_GP:
	 s-=6; break;
      case SAVEt_ALLOC:
      case SAVEt_REGCONTEXT:
	 s-=s[-1].any_i32+2; break;
      default:
	 croak("unknown code in the save stack");
      }
   }
}

static
ANY* find_undo(pTHX_ ANY **saves_p)
{
   I32 cix=cxstack_ix;
   if (CxTYPE(cxstack+cix) == CXt_SUB && CvSPECIAL(cxstack[cix].blk_sub.cv)) {
      for (;;) {
	 --cix;
	 switch (CxTYPE(cxstack+cix)) {
	 case CXt_BLOCK:
	    if (skip_debug_cx) {
	       COP *cop=cxstack[cix].blk_oldcop;
	       if (CopSTASH_eq(cop,PL_debstash))
		  continue;
	    }
	    break;
	 case CXt_SUB:
	    if (skip_debug_cx && CvSTASH(cxstack[cix].blk_sub.cv)==PL_debstash)
	       continue;
	    break;
	 case CXt_EVAL:
	    --cix;
	    if (restores_ix>0 && SvIVX(*av_fetch(restores, restores_ix-1, FALSE))==cix) {
	       ANY *saves=PL_savestack+SvIVX(*av_fetch(restores, restores_ix, FALSE))-3;
	       if (saves_p) *saves_p=saves;
	       return saves;
	    } else {
	       if (saves_p) {
		  if (cix>=0) {
#ifdef USE_ITHREADS
		     /* there is a useful ENTER at the beginning of yyparse() which marks the suitable position on the save stack */
		     *saves_p=PL_savestack+PL_scopestack[cxstack[cix].blk_oldscopesp]-3;
#else
		     /* here our destructor block is inserted beneath the stored scope mark; the latter is pushed down in the context stack */
		     *saves_p=PL_savestack+(PL_scopestack[cxstack[cix].blk_oldscopesp-1]-=3);
#endif
		  } else {
		     *saves_p=find_bottom_slot(aTHX);
		  }
	       }
	       return 0;
	    }
	 }
	 break;
      }
   }
   croak("namespaces::{un,}import may not be used directly; write 'use namespaces' or 'no namespaces' instead");
   /* UNREACHABLE */
   return 0;
}

static
ToRestore* insert_undo(pTHX_ I32 old_state)
{
   ToRestore *to_restore;
   ANY *saves, *rest;
   if (find_undo(aTHX_ &saves)) {
      to_restore=(ToRestore*)saves[1].any_ptr;
      to_restore->old_state=old_state;
      saves[0].any_dxptr=old_state ? &catch_ptrs : &reset_ptrs;
      return to_restore;
   }
   to_restore=newToRestore(aTHX_ old_state);
   to_restore->inserted=TRUE;
   rest=to_restore->saved;
#ifndef USE_ITHREADS
   saves-=3;
   *rest=*saves;
   saves->any_dxptr=&unpack_saved;
   *++rest=*++saves;
   saves->any_ptr=to_restore;
   *++rest=*++saves;
   saves->any_i32=SAVEt_DESTRUCTOR_X;
   ++rest; ++saves;
#endif
   *rest=*saves;
   saves->any_dxptr=old_state ? &catch_ptrs : &reset_ptrs;
   *++rest=*++saves;
   saves->any_ptr=to_restore;
   *++rest=*++saves;
   saves->any_i32=SAVEt_DESTRUCTOR_X;
   return 0;
}

static
OP* switch_off_namespaces(pTHX)
{
   reset_ptrs(aTHX_ 0);
   PL_op->op_ppaddr=&Perl_pp_null;
#if DebugNamespaces
   if (debug) {
      if (PL_op->op_next->op_type != OP_STUB) {
	 COP* o=(COP*)PL_op->op_next;
	 fprintf(stderr, "reset before executing %s, line %d cx=%d scope=%d\n", CopFILE(o), CopLINE(o), cxstack_ix, PL_scopestack_ix), fflush(stderr);
      } else {
	 fprintf(stderr, "reset before executing stub cx=%d scope=%d\n", cxstack_ix, PL_scopestack_ix), fflush(stderr);
      }
   }
#endif
   return NORMAL;
}

#if DebugNamespaces
static
void dump_array(AV *av, const char* name)
{
   SV **impp=AvARRAY(av), **end;
   fprintf(stderr, ".%s(%d)=[", name, SvREFCNT(av));
   if (impp)
      for (end=impp+AvFILLp(av); impp<=end; ++impp)
	 fprintf(stderr, " %s", HvNAME((HV*)SvRV(*impp)));
   fprintf(stderr, " ]\n");
}
#endif

static
I32 append_imp_stash(AV *dotLOOKUP, HV *imp_stash)
{
   SV **lookp, **endp;
   if ((lookp=AvARRAY(dotLOOKUP)))
      for (endp=lookp+AvFILLp(dotLOOKUP); lookp<=endp; ++lookp)
	 if ((HV*)SvRV(*lookp)==imp_stash) return FALSE;
   av_push(dotLOOKUP, newRV((SV*)imp_stash));
   return TRUE;
}

static
void append_lookup(HV *stash, AV *dotLOOKUP, AV *imp_dotLOOKUP)
{
   SV **lookp=AvARRAY(imp_dotLOOKUP), **endp;
   if (lookp) {
      for (endp=lookp+AvFILLp(imp_dotLOOKUP); lookp<=endp; ++lookp) {
	 HV *imp_stash=(HV*)SvRV(*lookp);
	 if (imp_stash != stash)
	    append_imp_stash(dotLOOKUP, imp_stash);
      }
   }
}

static
AV* get_dotLOOKUP(HV *stash)
{
   AV *dotLOOKUP=0;
   int i;
   GV *lookup_gv=*(GV**)hv_fetch(stash, dot_lookup, sizeof(dot_lookup)-1, TRUE);
   if (SvTYPE(lookup_gv)!=SVt_PVGV)
      gv_init(lookup_gv, stash, dot_lookup, sizeof(dot_lookup)-1, GV_ADDMULTI);
   else
      dotLOOKUP=GvAV(lookup_gv);

   if (!dotLOOKUP) {
      char *st_name=HvNAME(stash);
      I32 st_name_len=strlen(st_name);
      AV *dotIMPORT;
      GV **imp_gvp;
      dotLOOKUP=newAV();

      if ( (imp_gvp=(GV**)hv_fetch(stash, dot_import, sizeof(dot_import)-1, FALSE)) &&
	   (dotIMPORT=GvAV(*imp_gvp)) ) {
	 SV **impp=AvARRAY(dotIMPORT), **end;
	 if (impp)
	    for (end=impp+AvFILLp(dotIMPORT); impp<=end; ++impp) {
	       HV *imp_stash=(HV*)SvRV(*impp);
	       if (imp_stash != stash && append_imp_stash(dotLOOKUP, imp_stash)) {
		  AV *imp_dotLOOKUP=get_dotLOOKUP(imp_stash);
		  if (imp_dotLOOKUP) append_lookup(stash, dotLOOKUP, imp_dotLOOKUP);
	       }
	    }

      } else {
	 return 0;
      }

      for (i=st_name_len-2; i>0; --i) {
	 if (st_name[i]==':' && st_name[i-1]==':') {
	    HV *encl_stash=gv_stashpvn(st_name, --i, FALSE);
	    if (encl_stash) {
	       if (append_imp_stash(dotLOOKUP, encl_stash)) {
		  if (hv_exists(encl_stash, dot_import, sizeof(dot_import)-1)) {
		     AV *encl_lookup=get_dotLOOKUP(encl_stash);
		     if (encl_lookup) {
			append_lookup(stash, dotLOOKUP, encl_lookup);
			break;	/* encl_stash::.LOOKUP certainly contains all enclosing packages */
		     }
		  }
	       } else {
		  break;
	       }
	    }
	 }
      }

      GvAV(lookup_gv)=dotLOOKUP;
#if DebugNamespaces
      if (debug)
	 fprintf(stderr, "created %s::", HvNAME(stash)), dump_array(dotLOOKUP, "LOOKUP"), fflush(stderr);
#endif
      if (AvFILLp(dotLOOKUP)<0) dotLOOKUP=0;
   }

   last_stash=stash;
   last_dotLOOKUP=dotLOOKUP;
   return dotLOOKUP;
}

static
OP *pp_popmark(pTHX)
{
   (void)POPMARK;
   return NORMAL;
}

static
void lookup(pTHX_ GV *var_gv, I32 type, OP **pnext_op, OP *access_op)
{
   HV *stash=GvSTASH(var_gv);
   if (stash != PL_defstash && stash != PL_debstash) {
      const char *varname=GvNAME(var_gv);
      STRLEN varnamelen=GvNAMELEN(var_gv);
      OP *assign_op=0, *declare_op=0;
#if DebugNamespaces
      if (debug) {
	 fprintf(stderr, "lookup %c", type==SVt_PV ? '$' : type==SVt_PVAV ? '@' : type==SVt_PVHV ? '%' : '&');
	 if (CopSTASH_eq(PL_curcop, stash))
	    fprintf(stderr, "%.*s in %s", varnamelen, varname, HvNAME(stash));
	 else
	    fprintf(stderr, "%s::%.*s in %s", HvNAME(stash), varnamelen, varname, CopSTASHPV(PL_curcop));
	 fprintf(stderr, " at %s, line %d:", CopFILE(PL_curcop), CopLINE(PL_curcop));
      }
#endif
      if (access_op) {
	 switch (type) {
	 case SVt_PV:
	    declare_op= access_op->op_next->op_type == OP_SASSIGN ? (assign_op=access_op->op_next)->op_next : access_op->op_next;
	    break;
	 case SVt_PVAV:
	 case SVt_PVHV:
	    declare_op= access_op->op_next->op_type == OP_AASSIGN ? (assign_op=access_op->op_next)->op_next : access_op->op_next;
	    break;
	 }
	 if (declare_op->op_type != OP_GV || GvCV(cGVOPx_gv(declare_op)) != declare_cv)
	    declare_op=0;
      }
      if (!pnext_op || CopSTASH_eq(PL_curcop, stash)) {
	 /* unqualified */
	 if (declare_op) {
#if DebugNamespaces
	    if (debug) fprintf(stderr, " - declared here\n"), fflush(stderr);
#endif
	    if (assign_op) /* change to void context */
	       assign_op->op_flags ^= OPf_WANT_LIST ^ OPf_WANT_VOID;
	    declare_op->op_ppaddr=&pp_popmark;
	    declare_op->op_next=declare_op->op_next->op_next;	/* skip entersub */
	    switch (type) {
	    case SVt_PV:
	       GvIMPORTED_SV_on(var_gv);
	       break;
	    case SVt_PVAV:
	       GvIMPORTED_AV_on(var_gv);
	       break;
	    case SVt_PVHV:
	       GvIMPORTED_HV_on(var_gv);
	       break;
	    }
	    return;
	 }

	 if (type != SVt_PVCV ||
	     (GvFLAGS(var_gv) & (GVf_ASSUMECV | GVf_IMPORTED_CV)) != GVf_IMPORTED_CV) {
	    AV *dotLOOKUP= stash==last_stash ? last_dotLOOKUP : get_dotLOOKUP(stash);
	    if (dotLOOKUP) {
	       GV **imp_gvp;
	       SV **lookp, **endp;
	       for (lookp=AvARRAY(dotLOOKUP), endp=lookp+AvFILLp(dotLOOKUP); lookp<=endp; ++lookp) {
		  HV *imp_stash=(HV*)SvRV(*lookp);
#if DebugNamespaces
		  if (debug) fprintf(stderr, " [%s]", HvNAME(imp_stash));
#endif
		  if ((imp_gvp=(GV**)hv_fetch(imp_stash, varname, varnamelen, FALSE))) {
		     GV *imp_gv=*imp_gvp;
		     CV *imp_cv;
		     switch (type) {
		     case SVt_PV:
			if (GvIMPORTED_SV(imp_gv)) {
			   SV *imp_sv=GvSV(imp_gv);
			   SvREFCNT_dec(GvSV(var_gv));
			   SvREFCNT_inc(imp_sv);
			   GvSV(var_gv)=imp_sv;
			   GvIMPORTED_SV_on(var_gv);
#if DebugNamespaces
			   if (debug) fprintf(stderr, " - found\n"), fflush(stderr);
#endif
			   return;
			}
			break;
		     case SVt_PVAV:
			if (GvIMPORTED_AV(imp_gv)) {
			   AV *imp_av=GvAV(imp_gv);
			   SvREFCNT_dec(GvAV(var_gv));
			   SvREFCNT_inc(imp_av);
			   GvAV(var_gv)=imp_av;
			   GvIMPORTED_AV_on(var_gv);
#if DebugNamespaces
			   if (debug) fprintf(stderr, " - found\n"), fflush(stderr);
#endif
			   return;
			}
			break;
		     case SVt_PVHV:
			if (GvIMPORTED_HV(imp_gv)) {
			   HV *imp_hv=GvHV(imp_gv);
			   SvREFCNT_dec(GvHV(var_gv));
			   SvREFCNT_inc(imp_hv);
			   GvHV(var_gv)=imp_hv;
			   GvIMPORTED_HV_on(var_gv);
#if DebugNamespaces
			   if (debug) fprintf(stderr, " - found\n"), fflush(stderr);
#endif
			   return;
			}
			break;
		     case SVt_PVCV:
			if ((imp_cv=GvCV(imp_gv))) {
			   if (CvMETHOD(imp_cv) && pnext_op && (*pnext_op)->op_type == OP_ENTERSUB) {
#if DebugNamespaces
			      if (debug) fprintf(stderr, " method found (skipping)"), fflush(stderr);
#endif
			      /* may not discover methods in object-less call */
			      break;
			   }
			   if (!CvROOT(imp_cv) && !CvXSUB(imp_cv) && GvASSUMECV(imp_gv)) {
			      /* only promised - let's try later, or die if the next op is ENTERSUB */
			      if (pnext_op) pnext_op=0;
			      return;
			   }
			   SvREFCNT_inc(imp_cv);
			   GvCV(var_gv)=imp_cv;
			   GvIMPORTED_CV_on(var_gv);  GvASSUMECV_on(var_gv);
#if DebugNamespaces
			   if (debug) fprintf(stderr, " - found(%s)\n", CvROOT(imp_cv) || CvXSUB(imp_cv) ? "defined" : "undef"), fflush(stderr);
#endif
			   return;
			}
		     }
		  }
	       }
	    }
	 }

	 if (pnext_op) {
	    /* Nothing found: time to croak... But let's check for exceptions first */
	    OP *next_gv;
	    switch (type) {
	    case SVt_PVCV:
	       /* new UnqualPackage(arg,...) is often misinterpreted as new(UnqualPackage(arg,...)) */
	       next_gv=*pnext_op;
	       if (next_gv->op_type == OP_ENTERSUB  &&
		   (next_gv=next_gv->op_next)->op_type == OP_GV  &&
		   next_gv->op_next->op_type == OP_ENTERSUB) {
		  OP *pushmark2_op=cUNOPx(next_gv->op_next)->op_first, *pushmark1_op;
		  if (!pushmark2_op->op_sibling)
		     pushmark2_op=cUNOPx(pushmark2_op)->op_first;
		  if ((pushmark1_op=pushmark2_op->op_next)->op_type == OP_PUSHMARK) {
		     HV *pkg_stash;
#if DebugNamespaces
		     if (debug) fprintf(stderr, " - trying as class method ");
#endif
		     if ((pkg_stash=namespace_lookup_class(aTHX_ stash, varname, varnamelen))) {
			GV *next_sub=cGVOPx_gv(next_gv);
			GV *method_gv=gv_fetchmethod(pkg_stash, GvNAME(next_sub));
			if (method_gv) {
			   CV *method_cv=GvCV(method_gv);
			   OP *this_gv_op=PL_op,
			      *class_const_op=newSVOP(OP_CONST, 0, &PL_sv_undef),
			      *method_const_op=newSVOP(OP_CONST, 0, &PL_sv_undef);
			   dSP;
			   EXTEND(SP,2);
			   /* push the package name under the args, and the method GV on the top */
			   SV **bottom=PL_stack_base+POPMARK;
			   while (--SP>bottom) SP[1]=*SP;
			   varname=HvNAME(pkg_stash);
			   SP[1]=cSVOPx(class_const_op)->op_sv=newSVpvn_share(varname, strlen(varname), 0);
			   cSVOPx(method_const_op)->op_sv=SvREFCNT_inc((SV*)method_cv);
			   *++PL_stack_sp=(SV*)method_cv;
			   GvIMPORTED_CV_on(var_gv);		/* but without ASSUME_CV! */

			   /* what follows is a fierce reorganization of the op tree */
			   if (pushmark1_op->op_next == this_gv_op) {
			      class_const_op->op_next=method_const_op;
			      class_const_op->op_sibling=method_const_op;
			   } else {
			      OP *arg_op=pushmark1_op->op_sibling, *s;
			      class_const_op->op_next=pushmark1_op->op_next;
			      class_const_op->op_sibling=arg_op;
			      while ((s=arg_op->op_sibling)->op_sibling)
				 arg_op=s;
			      pushmark1_op->op_sibling=s;
			      arg_op->op_sibling=method_const_op;
			      while (!arg_op->op_seq) {
				 arg_op=cUNOPx(arg_op)->op_first;
				 while ((s=arg_op->op_sibling))
				    arg_op=s;
			      }
			      while (arg_op->op_next != this_gv_op)
				 arg_op=arg_op->op_next;
			      arg_op->op_next=method_const_op;
			   }
			   pushmark2_op->op_next=class_const_op;
			   pushmark2_op->op_sibling=class_const_op;
			   method_const_op->op_next=next_gv->op_next;
			   op_free(this_gv_op->op_next);
			   PL_op=method_const_op;
			}
#if DebugNamespaces
			else { if (debug) fprintf(stderr, " - but method %.*s not found\n", GvNAMELEN(next_sub), GvNAME(next_sub)); }
#endif
		     }
#if DebugNamespaces
		     else { if (debug) fprintf(stderr, " - nowhere\n"); }
#endif
		  }
	       }
	       /* pp_entersub will produce a suitable message when it gets stuck on the undefined sub */
	       return;

	    case SVt_PV:
	       if (varnamelen==8 && *varname=='A' && !memcmp(varname, "AUTOLOAD", 8)
		   && GvCV(var_gv)) {
		  /* allow to use $AUTOLOAD if there is a sub AUTOLOAD */
		  GvIMPORTED_SV_on(var_gv);
		  return;
	       }
	       if (PL_curstackinfo->si_type == PERLSI_SORT  &&
		   varnamelen==1 && (*varname=='a' || *varname=='b'))
		  /* allow to use sort placeholders: sort { $a <=> $b } */
		  return;

	       break;
	    case SVt_PVAV:
	       if (varnamelen==3 && varname[0]=='I' && varname[1]=='S' && varname[2]=='A') {
		  /* allow to use @ISA */
		  GvIMPORTED_AV_on(var_gv);
		  return;
	       }
	    }
	    *pnext_op=die("reference to an undeclared variable %c%.*s",
			  type==SVt_PV ? '$' : type==SVt_PVAV ? '@' : '%',
			  varnamelen, varname);
	 }
#if DebugNamespaces
	 else
	    if (debug) fprintf(stderr, " - nowhere\n"), fflush(stderr);
#endif
      } else {
	 /* full qualified, but undeclared */
	 HV *other_stash;

	 if (declare_op) {
	    *pnext_op=die("can't declare variables from other packages");
	    return;
	 }

	 /* check for exceptions */
	 if (type==SVt_PVHV && varnamelen>=3 && varname[varnamelen-2]==':' && varname[varnamelen-1]==':'
	     && GvHV(var_gv) && HvNAME(GvHV(var_gv)))
	    /* allow to refer to the symbol table of a defined package */
	    return;

	 other_stash=namespace_lookup_class(aTHX_ CopSTASH(PL_curcop), HvNAME(stash), strlen(HvNAME(stash)));
	 if (other_stash && other_stash!=stash) {
	    GV *imp_gv=*(GV**)hv_fetch(other_stash, varname, varnamelen, TRUE);
	    I32 other_found=FALSE;
	    if (SvTYPE(imp_gv) != SVt_PVGV)
	       gv_init(imp_gv, other_stash, varname, varnamelen, GV_ADDMULTI);

	    switch (type) {
	    case SVt_PV:
	       if (!GvIMPORTED_SV(imp_gv))
		  lookup(aTHX_ imp_gv, type, 0, 0);
	       other_found=GvIMPORTED_SV(imp_gv);
	       break;
	    case SVt_PVAV:
	       if (!GvIMPORTED_AV(imp_gv))
		  lookup(aTHX_ imp_gv, type, 0, 0);
	       other_found=GvIMPORTED_AV(imp_gv);
	       break;
	    case SVt_PVHV:
	       if (!GvIMPORTED_HV(imp_gv))
		  lookup(aTHX_ imp_gv, type, 0, 0);
	       other_found=GvIMPORTED_HV(imp_gv);
	       break;
	    case SVt_PVCV:
	       if (!GvCV(imp_gv))
		  lookup(aTHX_ imp_gv, type, 0, 0);
	       other_found=GvCV(imp_gv) != 0;
	       break;
	    }

	    if (other_found) {
	       dSP;
#if DebugNamespaces
	       if (debug) fprintf(stderr, " - found in %s\n", HvNAME(GvSTASH(imp_gv))), fflush(stderr);
#endif
	       SvREFCNT_dec(var_gv);
	       SvREFCNT_inc(imp_gv);
#ifdef USE_ITHREADS
	       PAD_SVl(cPADOP->op_padix)=(SV*)imp_gv;
#else
	       cSVOP->op_sv=(SV*)imp_gv;
#endif
	       SETs((SV*)imp_gv);
	       return;
	    }
	 }

	 if (type != SVt_PVCV && hv_exists(stash, dot_import, sizeof(dot_import)-1))
	    /* complain now if the addressed package is compiled with namespace mode
	       and we are not looking for a subroutine (otherwise OP_ENTERSUB makes a better message) */
	    *pnext_op=die("reference to an undeclared variable %c%s::%.*s",
			  type==SVt_PV ? '$' : type==SVt_PVAV ? '@' : '%',
			  HvNAME(stash), varnamelen, varname);
      }
   }
}

SV* try_namespace_lookup(pTHX_ HV *stash, SV *name, I32 type)
{
   if (get_dotLOOKUP(stash)) {
      STRLEN l;
      const char *n=SvPV(name,l);
      GV* gv=*(GV**)hv_fetch(stash, n, l, TRUE);
      if (SvTYPE(gv) != SVt_PVGV)
	 gv_init(gv, stash, n, l, GV_ADDMULTI);
      lookup(aTHX_ gv, type, 0, 0);
      switch (type) {
      case SVt_PV:
	 return GvSV(gv);
      case SVt_PVAV:
	 return (SV*)GvAV(gv);
      case SVt_PVHV:
	 return (SV*)GvHV(gv);
      case SVt_PVCV:
	 return (SV*)GvCV(gv);
      case SVt_PVGV:
	 return (SV*)gv;
      }
   }
   return 0;
}

static
OP* intercept_pp_gv(pTHX)
{
   OP *next_op=def_pp_GV(aTHX);
   dSP;
   GV *var_gv=(GV*)TOPs;
   CV *cv;
#ifdef not_PERL_5_8
   while (next_op->op_type == OP_NULL)
      next_op=next_op->op_next;
#endif
   switch (next_op->op_type) {
   case OP_RV2SV:
      if (!GvIMPORTED_SV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PV, &next_op, next_op);
      break;
   case OP_RV2AV:
      if (!GvIMPORTED_AV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVAV, &next_op, next_op);
      break;
   case OP_RV2HV:
      if (!GvIMPORTED_HV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVHV, &next_op, next_op);
      break;
   case OP_RV2CV:
      if ((cv=GvCV(var_gv)) && (next_op->op_next->op_type != OP_REFGEN || CvROOT(cv) || CvXSUB(cv)))
	 break;
      lookup(aTHX_ var_gv, SVt_PVCV, &next_op, 0);
      break;
   case OP_ENTERSUB:
      if (GvCV(var_gv)) {
	 OP *pushmark=cUNOPx(next_op)->op_first, *meth_op;
	 if (!pushmark->op_sibling) pushmark=cUNOPx(pushmark)->op_first;
	 OP *first_arg=pushmark->op_sibling;
#ifdef not_PERL_5_8
	 FIXME="descend all NULLs";
#endif
	 if (first_arg->op_next==PL_op && first_arg->op_type==OP_CONST && (first_arg->op_private & OPpCONST_BARE)) {
	    /* a very special case: `method XXX;' where (another) sub `method' is defined in the current package too */
	    SV *pkg_name_sv=cSVOPx_sv(first_arg);
	    HV *pkg_stash=namespace_lookup_class(aTHX_ GvSTASH(var_gv), SvPVX(pkg_name_sv), SvCUR(pkg_name_sv));
	    if (pkg_stash) {
	       GV *method_gv=gv_fetchmethod(pkg_stash, GvNAME(var_gv));
	       if (method_gv) {
		  CV *method_cv=GvCV(method_gv);
		  const char *pkg_name=HvNAME(pkg_stash);
		  SvREFCNT_dec(pkg_name_sv);
		  cSVOPx(first_arg)->op_sv=TOPm1s=newSVpvn_share(pkg_name, strlen(pkg_name), 0);
		  SvREFCNT_dec(var_gv);
		  SvREFCNT_inc((SV*)method_cv);
#ifdef USE_ITHREADS
		  PAD_SVl(cPADOP->op_padix)=(SV*)method_cv;
#else
		  cSVOP->op_sv=(SV*)method_cv;
#endif
		  SETs((SV*)method_cv);
	       }
	    }
	 } else if (pushmark->op_next==PL_op && (meth_op=PL_op->op_next->op_next)->op_type==OP_METHOD_NAMED && CvMETHOD(GvCV(var_gv))) {
	    /* another suspicious case: `name->method' where sub name is defined as method: look for a namespace `name' first */
	    HV *pkg_stash=namespace_lookup_class(aTHX_ GvSTASH(var_gv), GvNAME(var_gv), GvNAMELEN(var_gv));
	    if (pkg_stash) {
	       SV *pkg_name=newSVpvn_share(HvNAME(pkg_stash), strlen(HvNAME(pkg_stash)), 0);
	       SvREFCNT_dec(var_gv);
#ifdef USE_ITHREADS
	       PAD_SVl(cPADOP->op_padix)=pkg_name;
#else
	       cSVOP->op_sv=pkg_name;
#endif
	       SETs(pkg_name);
	       POPMARK;
	       pushmark->op_ppaddr=&Perl_pp_null;	/* skip pushmark and entersub */
	       PL_op->op_next=meth_op;
	       PL_op->op_ppaddr=def_pp_GV;
	    }
	 }
      } else {
	 lookup(aTHX_ var_gv, SVt_PVCV, &next_op, 0);
      }
      if (next_op == PL_op->op_next) {	/* not changed */
	 SV *alt_lookup_sv=GvSV(alt_lookup_gv);
	 if (SvPOK(alt_lookup_sv)) {
	    HE *alt_stash_ent;
	    U32 alt_hash;
	    HV *alt_stash;
	    SvUPGRADE(alt_lookup_sv, SVt_PVIV);
	    alt_hash= SvIOKp(alt_lookup_sv) ? SvIV(alt_lookup_sv) : 0;
	    alt_stash_ent=hv_fetch_ent(GvSTASH(CvGV(GvCV(var_gv))), alt_lookup_sv, FALSE, alt_hash);
	    if (alt_stash_ent && (alt_stash=GvHV(HeVAL(alt_stash_ent)))) {
	       GV *alt_gv;
	       SV **alt_gvp;
	       if (!alt_hash) {
		  SvIVX(alt_lookup_sv)=HeHASH(alt_stash_ent);
		  SvIOK_on(alt_lookup_sv);
	       }
	       if ((alt_gvp=hv_fetch(alt_stash, GvNAME(var_gv), GvNAMELEN(var_gv), FALSE)) &&
		   (alt_gv=(GV*)*alt_gvp, GvCV(alt_gv))) {
		  SvREFCNT_dec(var_gv);
		  SvREFCNT_inc(alt_gv);
#ifdef USE_ITHREADS
		  PAD_SVl(cPADOP->op_padix)=(SV*)alt_gv;
#else
		  cSVOP->op_sv=(SV*)alt_gv;
#endif
		  SETs((SV*)alt_gv);
	       }
	    }
	 }
	 PL_op->op_ppaddr=def_pp_GV;
      }
      return PL_op->op_next;
   }
   if (next_op == PL_op->op_next)	/* not died */
      PL_op->op_ppaddr=def_pp_GV;
   return next_op;
}

static
OP* intercept_pp_rv2gv(pTHX)
{
   OP *next_op=def_pp_RV2GV(aTHX), *declare_op=0;
   I32 defuse=FALSE;
   if (next_op->op_type==OP_SASSIGN) {
      declare_op=next_op->op_next;
      if (declare_op->op_type == OP_GV && GvCV(cGVOPx_gv(declare_op)) == declare_cv) {
	 dSP;
	 GV *dst_gv=(GV*)TOPs;
	 SV *src_sv=TOPm1s;
	 if (SvROK(src_sv)) {
	    I32 src_type=SvTYPE(SvRV(src_sv));
	    switch (src_type) {
	    case SVt_PVAV:
	       GvIMPORTED_AV_on(dst_gv);
	       defuse=TRUE;
	       break;
	    case SVt_PVHV:
	       GvIMPORTED_HV_on(dst_gv);
	       defuse=TRUE;
	       break;
	    default:
	       if (src_type >= SVt_IV && src_type <= SVt_PVMG) {
		  GvIMPORTED_SV_on(dst_gv);
		  defuse=TRUE;
	       }
	       break;
	    }
	 } else if (SvTYPE(src_sv)==SVt_PVGV) {
	    defuse=TRUE;
	 }
      }
   }
   if (defuse) {
      if (declare_op->op_ppaddr != &pp_popmark) {
	 /* change to void context */
	 next_op->op_flags ^= OPf_WANT_LIST ^ OPf_WANT_VOID;
	 /* skip entersub */
	 declare_op->op_ppaddr=&pp_popmark;
	 declare_op->op_next=declare_op->op_next->op_next;
      }
   } else {
      PL_op->op_ppaddr=def_pp_RV2GV;
   }
   return next_op;
}

static
OP* intercept_pp_gvsv(pTHX)
{
   GV *var_gv=cGVOP_gv;
   OP *next_op=0;
   if (!GvIMPORTED_SV(var_gv))
      lookup(aTHX_ var_gv, SVt_PV, &next_op, PL_op);
   if (next_op) return next_op;	/* died */
   PL_op->op_ppaddr=def_pp_GVSV;
   return def_pp_GVSV(aTHX);
}

static
OP* intercept_pp_aelemfast(pTHX)
{
   if (!(PL_op->op_flags & OPf_SPECIAL)) {
      GV *var_gv=cGVOP_gv;
      OP *next_op=0;
      if (!GvIMPORTED_AV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVAV, &next_op, 0);
      if (next_op) return next_op;	/* died */
   }
   PL_op->op_ppaddr=def_pp_AELEMFAST;
   return def_pp_AELEMFAST(aTHX);
}

static
AV* get_dotIMPORT(HV *stash, I32 unique)
{
   GV *imp_gv=*(GV**)hv_fetch(stash, dot_import, sizeof(dot_import)-1, TRUE);
   AV *dotIMPORT=0;
   if (SvTYPE(imp_gv)!=SVt_PVGV)
      gv_init(imp_gv, stash, dot_import, sizeof(dot_import)-1, GV_ADDMULTI);
   else
      dotIMPORT=GvAV(imp_gv);

   if (!dotIMPORT) {
      GV *declare_gv=*(GV**)hv_fetch(stash, declare, sizeof(declare)-1, TRUE);
      if (SvTYPE(declare_gv)!=SVt_PVGV)
	 gv_init(declare_gv, stash, declare, sizeof(declare)-1, GV_ADDMULTI);
      sv_setsv((SV*)declare_gv, sv_2mortal(newRV((SV*)declare_cv)));
      if (AvFILLp(import_from_av)>=0) {
	 GvAV(imp_gv)=dotIMPORT=(AV*)SvRV(AvARRAY(import_from_av)[AvFILLp(import_from_av)]);
	 SvREFCNT_inc(dotIMPORT);
      } else {
	 GvAV(imp_gv)=dotIMPORT=newAV();
      }
#if DebugNamespaces
      if (debug) fprintf(stderr, "created %s::", HvNAME(stash)), dump_array(dotIMPORT, "IMPORT"), fflush(stderr);
#endif
   }
   if (unique && SvREFCNT(dotIMPORT)>1) {
      SvREFCNT_dec(dotIMPORT);
      return (GvAV(imp_gv)=av_make(AvFILLp(dotIMPORT)+1, AvARRAY(dotIMPORT)));
   }
   return dotIMPORT;
}

static
OP* ck_const(pTHX_ OP *o)
{
   if (PL_curcop == &PL_compiling) {
      SV *sv=cSVOPo->op_sv;
      const char *buf=PL_bufptr;
      if (buf && SvPOKp(sv) && buf[0] == 'p' && !strncmp(buf, "package ", 8)) {
	 HV *stash=gv_stashpvn(SvPVX(sv), SvCUR(sv), TRUE);
	 if (stash != PL_defstash && stash != PL_debstash)
	    get_dotIMPORT(stash, FALSE);
      }
   }
   return def_ck_CONST(aTHX_ o);
}

static
void inject_switch_op(pTHX_ OP *o)
{
   OP *sw_op=newOP(OP_CUSTOM, 0);
   sw_op->op_ppaddr=&switch_off_namespaces;
   cUNOPo->op_first=Perl_prepend_elem(aTHX_ OP_LINESEQ, sw_op, cUNOPo->op_first);
}

static
OP* ck_leaveeval(pTHX_ OP *o)
{
   inject_switch_op(aTHX_ o);
   return def_ck_LEAVEEVAL(aTHX_ o);
}

static
OP* ck_leavesub(pTHX_ OP *o)
{
   CV *cv=PL_compcv;
   if (CvSPECIAL(cv)) {
      GV *gv=CvGV(cv);
      if (GvNAMELEN(gv)==5 && !strncmp(GvNAME(gv), "BEGIN", 5)) {
	 ToRestore *to_restore=newToRestore(aTHX_ TRUE);
#if DebugNamespaces
	 if (debug) fprintf(stderr, "reset before BEGIN(%s, line %d) cx=%d savesp=%d\n", CopFILE(PL_curcop), CopLINE(PL_curcop), cxstack_ix, PL_savestack_ix), fflush(stderr);
#endif
	 SAVEDESTRUCTOR_X(&catch_ptrs,to_restore);
	 sv_setiv(*av_fetch(restores, ++restores_ix, TRUE), cxstack_ix);
	 sv_setiv(*av_fetch(restores, ++restores_ix, TRUE), PL_savestack_ix);
	 inject_switch_op(aTHX_ o);
      }
   }
   return def_ck_LEAVESUB(aTHX_ o);
}

static
OP* intercept_ck_glob(pTHX_ OP *o)
{
   reset_ptrs(aTHX_ 0);
   o=def_ck_GLOB(aTHX_ o);
   catch_ptrs(aTHX_ 0);
   return o;
}

static
OP* intercept_eval(pTHX)
{
   AV *my_imports=get_dotIMPORT(CopSTASH(PL_curcop), FALSE);
   ToRestore *to_restore;
   OPCODE my_type=PL_op->op_type;
   op_fun_ptr my_func=PL_ppaddr[my_type];
   OP *next;
#if DebugNamespaces
   if (debug) fprintf(stderr, "%s at %s, line %d: enabling namespaces inherited from %s cx=%d\n",
		      my_type==OP_ENTEREVAL ? "eval" : "regcomp",
		      CopFILE(PL_curcop), CopLINE(PL_curcop), HvNAME(CopSTASH(PL_curcop)), cxstack_ix),
              dump_array(my_imports,"IMPORT"), fflush(stderr);
#endif
   if (current_mode())
      croak("something wrong here!");

   to_restore=newToRestore(aTHX_ FALSE);
   av_push(import_from_av, newRV((SV*)my_imports));
   catch_ptrs(aTHX_ 0);
   next=my_func(aTHX);
   reset_ptrs(aTHX_ to_restore);
   if (next->op_ppaddr==&switch_off_namespaces) {
      next->op_ppaddr=&Perl_pp_null;
      next=next->op_next;
   }
   return next;
}

HV* namespace_lookup_class(pTHX_ HV *stash, const char *class_name, STRLEN class_namelen)
{
   HV *imp_class=0;
   GV *class_gv, **imp_class_gvp;
   size_t l=class_namelen+2;
   char smallbuf[64];
   char *buf;
   if (l<sizeof(smallbuf))
      buf=smallbuf;
   else
      New(0, buf, class_namelen+3, char);
   Copy(class_name, buf, l-2, char);
   buf[l-2]=':';  buf[l-1]=':';

   class_gv=*(GV**)hv_fetch(stash, buf, l, TRUE);
   if (SvTYPE(class_gv)==SVt_PVGV) {
      imp_class=GvHV(class_gv);

   } else {
      AV *dotLOOKUP= stash==last_stash ? last_dotLOOKUP : get_dotLOOKUP(stash);
      if (dotLOOKUP) {
	 const char *first_colon=strchr(class_name, ':'), *colon, *last_name=buf;
	 SV **lookp=AvARRAY(dotLOOKUP), **endp;
	 if (lookp) {
#if DebugNamespaces
	    if (debug) fprintf(stderr, "lookup package %.*s in %s at %s, line %d:",
			       class_namelen, class_name, HvNAME(stash), CopFILE(PL_curcop), CopLINE(PL_curcop));
#endif
	    for (endp=lookp+AvFILLp(dotLOOKUP); lookp<=endp; ++lookp) {
	       HV *imp_stash=(HV*)SvRV(*lookp);
#if DebugNamespaces
	       if (debug) fprintf(stderr, " [%s]", HvNAME(imp_stash));
#endif
	       if ((colon=first_colon)) {
		  const char *class_name_part=class_name, *next_colon=colon;
		  do {
		     l=(colon=next_colon+2)-class_name_part;
		     imp_class_gvp=(GV**)hv_fetch(imp_stash, class_name_part, l, FALSE);
		     if (!imp_class_gvp || !(imp_stash=GvHV(*imp_class_gvp)))
			goto NEXT;
		  } while ((next_colon=strchr((class_name_part=colon), ':')));
		  last_name=buf+(class_name_part-class_name);
		  l=class_namelen-(class_name_part-class_name)+2;
	       }
	       if ((imp_class_gvp=(GV**)hv_fetch(imp_stash, last_name, l, FALSE)) &&
		   (imp_class=GvHV(*imp_class_gvp)))
		  break;
	    NEXT:;
	    }
	 }
      }
      if (!imp_class) imp_class=gv_stashpvn(class_name, class_namelen, FALSE);

      gv_init(class_gv, stash, buf, l+2, GV_ADDMULTI);
      if (imp_class)
	 GvHV(class_gv)=(HV*)SvREFCNT_inc(imp_class);
#if DebugNamespaces
      if (debug) {
	 if (imp_class)
	    fprintf(stderr, " - found(%s)\n", HvNAME(imp_class));
	 else
	    fprintf(stderr, " - nowhere\n");
	 fflush(stderr);
      }
#endif
   }
   if (buf != smallbuf) Safefree(buf);
   return imp_class;
}

static
OP* pp_instance_of(pTHX)
{
   dSP; dTOPss;
   HV *class=(HV*)cSVOP_sv;
   if (SvRV(sv) && SvOBJECT(sv) && SvSTASH(sv)==class) {
      SETs(&PL_sv_yes);
   } else {
      I32 answer=sv_derived_from(sv, HvNAME(class));
      SPAGAIN;
      SETs(answer ? &PL_sv_yes : &PL_sv_no);
   }
   return NORMAL;
}

static
OP* pp_class_method(pTHX)
{
   dSP;
   SV *method_name=cSVOP_sv;
   SV *first_arg=PL_stack_base[TOPMARK+1];
   const char *class_name=SvPVX(first_arg);
   STRLEN l=SvCUR(first_arg), prefix=0;
   HV *class;
   GV *method_gv;
   if (class_name[0]==':' && class_name[1]==':') {
      prefix=2;
   } else if (l>6 && class_name[4]==':' && class_name[0]=='m' && !memcmp(class_name, "main::", 6)) {
      prefix=6;
   }
   if (prefix) {
      class=gv_stashpvn(class_name+prefix, l-prefix, FALSE);
   } else {
      class=namespace_lookup_class(aTHX_ CopSTASH(PL_curcop), class_name, l);
   }
   if (!class)
      croak("Package \"%.*s\" does not exist", SvCUR(first_arg), SvPVX(first_arg));

   if ((method_gv=gv_fetchmethod(class, SvPVX(method_name)))) {
      CV *method_cv=GvCV(method_gv);
      OP *o=PL_op;
      Perl_op_clear(aTHX_ o);
      o->op_ppaddr=PL_ppaddr[OP_CONST];
      o->op_type=OP_CONST;
      o->op_flags=OPf_WANT_SCALAR;
      cSVOPo->op_sv=SvREFCNT_inc((SV*)method_cv);
      SPAGAIN;
      XPUSHs((SV*)method_cv);
      if (!prefix && (l=strlen(class_name=HvNAME(class)))!=SvCUR(first_arg)) {
	 o=cUNOPx(PL_op->op_next)->op_first->op_sibling;
	 Perl_op_clear(aTHX_ o);
	 cSVOPo->op_sv=PL_stack_base[TOPMARK+1]=newSVpvn_share(class_name, l, 0);
      }
   } else if (SvCUR(method_name)==sizeof(instanceof)-1 && !memcmp(SvPVX(method_name),instanceof,sizeof(instanceof)-1)) {
      SPAGAIN;
      if (PL_stack_base+TOPMARK+2==SP) {
	 OP *o=PL_op, *sub_op=o->op_next;
	 Perl_op_clear(aTHX_ o);
	 o->op_ppaddr=&pp_instance_of;
	 cSVOPo->op_sv=SvREFCNT_inc((SV*)class);
	 o->op_next=sub_op->op_next;		/* skip ENTERSUB */
	 o=cUNOPx(sub_op)->op_first;
	 if (!o->op_sibling) o=cUNOPo->op_first;
	 o->op_ppaddr=&Perl_pp_null;		/* suppress PUSHMARK, skip CONST(package_name) */
	 o->op_next=o->op_next->op_next;
	 SP[-1]=SP[0]; --SP;
	 POPMARK; PUTBACK;
	 return pp_instance_of(aTHX);
      } else {
	 croak("usage: instanceof CLASS $object");
      }
   } else {
      croak("Can't locate object method \"%.*s\" via package \"%s\"",
	    SvCUR(method_name), SvPVX(method_name), HvNAME(class));
   }
   RETURN;
}

static
OP* ck_sub(pTHX_ OP* o)
{
   if (PL_curstash!=PL_defstash &&
       (o->op_flags & (OPf_STACKED | OPf_KIDS)) == (OPf_STACKED | OPf_KIDS)) {
      OP *arg=cUNOPo->op_first->op_sibling;
      if (arg && arg->op_type == OP_CONST && (arg->op_private & OPpCONST_BARE)) {
	 while ((arg=arg->op_sibling)) {
	    if (arg->op_type == OP_METHOD_NAMED) {
	       arg->op_ppaddr=&pp_class_method;
	       break;
	    }
	 }
      }
   }
   return def_ck_ENTERSUB(aTHX_ o);
}

static
void catch_ptrs(pTHX_ void *to_restore)
{
   if (!to_restore || !current_mode()) {
      PL_ppaddr[OP_GV]       =&intercept_pp_gv;
      PL_ppaddr[OP_GVSV]     =&intercept_pp_gvsv;
      PL_ppaddr[OP_RV2GV]    =&intercept_pp_rv2gv;
      PL_ppaddr[OP_AELEMFAST]=&intercept_pp_aelemfast;
      PL_ppaddr[OP_ENTEREVAL]=&intercept_eval;
      PL_ppaddr[OP_REGCOMP]  =&intercept_eval;
      PL_check[OP_CONST]     =&ck_const;
      PL_check[OP_ENTERSUB]  =&ck_sub;
      PL_check[OP_LEAVESUB]  =&ck_leavesub;
      PL_check[OP_LEAVEEVAL] =&ck_leaveeval;
      PL_check[OP_GLOB]      =&intercept_ck_glob;
   }
   if (to_restore) {
#if DebugNamespaces
      if (debug) fprintf(stderr, "catch executed in cx=%d scope=%d savesp=%d ptr=%p\n", cxstack_ix, PL_scopestack_ix, PL_savestack_ix, to_restore), fflush(stderr);
#endif
      finish_undo(aTHX_ (ToRestore*)to_restore);
   } else {
      PL_hints &= ~HINT_STRICT_VARS;
   }
}

static
void reset_ptrs(pTHX_ void *to_restore)
{
   if (!to_restore || current_mode()) {
      PL_ppaddr[OP_GV]       =def_pp_GV;
      PL_ppaddr[OP_GVSV]     =def_pp_GVSV;
      PL_ppaddr[OP_RV2GV]    =def_pp_RV2GV;
      PL_ppaddr[OP_AELEMFAST]=def_pp_AELEMFAST;
      PL_ppaddr[OP_ENTEREVAL]=def_pp_ENTEREVAL;
      PL_ppaddr[OP_REGCOMP]  =def_pp_REGCOMP;
      PL_check[OP_CONST]     =def_ck_CONST;
      PL_check[OP_ENTERSUB]  =def_ck_ENTERSUB;
      PL_check[OP_LEAVESUB]  =def_ck_LEAVESUB;
      PL_check[OP_LEAVEEVAL] =def_ck_LEAVEEVAL;
      PL_check[OP_GLOB]      =def_ck_GLOB;
   }
   if (to_restore) {
#if DebugNamespaces
      if (debug) fprintf(stderr, "restore executed in cx=%d scope=%d savesp=%d ptr=%p\n", cxstack_ix, PL_scopestack_ix, PL_savestack_ix, to_restore), fflush(stderr);
#endif
      finish_undo(aTHX_ (ToRestore*)to_restore);
   } else {
      PL_hints |= HINT_STRICT_VARS;
   }
}

MODULE = namespaces		PACKAGE = namespaces

PROTOTYPES: DISABLE

void
import(...)
CODE:
{
   ToRestore *to_restore=insert_undo(aTHX_ FALSE);
   AV *new_imports=newAV();
   I32 i;
   for (i=1; i<items; ++i) {
      STRLEN l;
      const char *n=SvPV(ST(i),l);
      HV *imp_stash=gv_stashpvn(n, l, FALSE);
      if (imp_stash)
	 av_push(new_imports, newRV((SV*)imp_stash));
   }
   if (to_restore) {
      if (items>1) {
      }
   } else {
      catch_ptrs(aTHX_ 0);
      av_push(import_from_av, newRV_noinc((SV*)new_imports));
   }
}

void
unimport(...)
CODE:
{
   if (items>1) {
      /* just remove some packages from the global import list */
      if (AvFILLp(import_from_av)>=0) {
	 AV *cur_imports=(AV*)SvRV(AvARRAY(import_from_av)[AvFILLp(import_from_av)]);
	 SV **impp=AvARRAY(cur_imports), **end;
	 if (impp) {
	    AV *new_imports=newAV();
	    I32 i, last_found=0;
	    ANY *saves;
	    for (i=1; i<items; ++i) {
	       STRLEN l;
	       const char *n=SvPV(ST(i),l);
	       HV *imp_stash=gv_stashpvn(n, l, FALSE);
	       if (imp_stash) {
		  ST(last_found)=(SV*)imp_stash; ++last_found;
	       }
	    }
	    for (end=impp+AvFILLp(cur_imports); impp<=end; ++impp) {
	       HV *imp=(HV*)SvRV(*impp);
	       for (i=0; i<last_found && imp!=(HV*)ST(i); ++i) ;
	       if (i==last_found)
		  av_push(new_imports, newRV((SV*)imp));
	    }
	    av_push(import_from_av, newRV_noinc((SV*)new_imports));
	    if ((saves=find_undo(aTHX_ 0)))
	       ((ToRestore*)saves[1].any_ptr)->import_from_level++;
	 }
      }
   } else {
      /* switch off the namespace compilation mode for the rest of the lex. scope */
      insert_undo(aTHX_ FALSE);
   }
   XSRETURN_EMPTY;
}

void
temp_disable()
CODE:
{
   if (current_mode()) {
      reset_ptrs(aTHX_ 0);
      LEAVE;
      SAVEDESTRUCTOR_X(&catch_ptrs,0);
      ENTER;
   }
}

void
using(dst, ...)
   SV *dst;
CODE:
{
   HV *caller_stash=
      (SvCUR(dst)==10 && !memcmp(SvPVX(dst),"namespaces",10))
      ? (last_stash=0, CopSTASH(PL_curcop))
      : gv_stashpvn(SvPVX(dst), SvCUR(dst), TRUE);
   I32 i;
   AV *dotLOOKUP, *dotIMPORT;
   GV **av_gvp=(GV**)hv_fetch(caller_stash, dot_lookup, sizeof(dot_lookup)-1, FALSE);

   if (av_gvp && SvTYPE(*av_gvp) == SVt_PVGV && (dotLOOKUP=GvAV(*av_gvp))) {
      for (i=1; i<items; ++i) {
	 STRLEN l;
	 const char *n=SvPV(ST(i),l);
	 HV *imp_stash=gv_stashpvn(n, l, FALSE);
	 if (!imp_stash)
	    croak("package not found: %.*s", l, n);
	 if (imp_stash != caller_stash && append_imp_stash(dotLOOKUP, imp_stash)) {
	    AV *imp_dotLOOKUP=get_dotLOOKUP(imp_stash);
	    if (imp_dotLOOKUP) append_lookup(caller_stash, dotLOOKUP, imp_dotLOOKUP);
	 }
      }
#if DebugNamespaces
      if (debug) fprintf(stderr, "added to %s::", HvNAME(caller_stash)), dump_array(dotLOOKUP, "LOOKUP"), fflush(stderr);
#endif
      
   } else {
      dotIMPORT=get_dotIMPORT(caller_stash, TRUE);
      for (i=1; i<items; ++i) {
	 STRLEN l;
	 const char *n=SvPV(ST(i),l);
	 HV *imp_stash=gv_stashpvn(n, l, FALSE);
	 if (!imp_stash)
	    croak("package not found: %.*s", l, n);
	 if (imp_stash != caller_stash)
	    av_push(dotIMPORT, newRV((SV*)imp_stash));
      }
#if DebugNamespaces
      if (debug) fprintf(stderr, "added to %s::", HvNAME(caller_stash)), dump_array(dotIMPORT, "IMPORT"), fflush(stderr);
#endif
   }
}

void lookup_sub(pkg, subname)
   SV *pkg;
   SV *subname;
PPCODE:
{
   STRLEN l;
   const char *n;
   HV *stash;
   int wantarray=GIMME==G_ARRAY;
   int owner_status=0;
   if (SvROK(pkg)) {
      stash=SvSTASH(SvRV(pkg));
   } else {
      n=SvPV(pkg,l);
      stash=gv_stashpvn(n, l, FALSE);
   }
   if (stash) {
      GV *gv;
      CV *cv;
      n=SvPV(subname,l);
      gv=*(GV**)hv_fetch(stash, n, l, TRUE);
      if (SvTYPE(gv) != SVt_PVGV)
	 gv_init(gv, stash, n, l, GV_ADDMULTI);
      else if (wantarray && GvCV(gv))
	 owner_status= GvIMPORTED_CV(gv) ? 2 : 1;

      lookup(aTHX_ gv, SVt_PVCV, 0, 0);
      cv=GvCV(gv);
      if (cv && (CvROOT(cv) || CvXSUB(cv))) {
	 PUSHs(sv_2mortal(newRV((SV*)cv)));
	 if (wantarray) {
	    PUSHs(sv_2mortal(newSViv(owner_status)));
	    XSRETURN(2);
	 } else {
	    XSRETURN(1);
	 }
      }
   }
   XSRETURN_EMPTY;
}

void
lookup_class(pkg, class_name, ...)
   SV *pkg;
   SV *class_name;
PPCODE:
{
   STRLEN l;
   const char *n;
   HV *class_stash, *stash;
   if (SvROK(pkg)) {
      stash=SvSTASH(SvRV(pkg));
   } else {
      n=SvPV(pkg,l);
      stash=gv_stashpvn(n, l, FALSE);
   }
   n=SvPV(class_name,l);
   if (stash && (class_stash=namespace_lookup_class(aTHX_ stash, n, l))) {
      if (items==3 && SvTRUE(ST(2)))
	 PUSHs(sv_2mortal(newRV((SV*)class_stash)));
      else
	 PUSHs(sv_2mortal(newSVpv(HvNAME(class_stash), 0)));
      XSRETURN(1);
   }
   class_stash=gv_stashpvn(n, l, FALSE);
   if (class_stash) {
      ST(0)=ST(1);
      XSRETURN(1);
   }
   XSRETURN_UNDEF;
}

void
declare(...)
CODE:
{
   croak("multiple declaration of a variable");
}
items=0;

BOOT:
{
   last_stash=0;
   import_from_av=get_av("namespaces::IMPORT_FROM", TRUE);
   declare_cv=get_cv("namespaces::declare", FALSE);
   alt_lookup_gv=gv_fetchpv("namespaces::alt_lookup", TRUE, SVt_PV);
   restores=newAV();
   if (PL_DBgv) {
      CvFLAGS(get_cv("namespaces::import", FALSE)) |= CVf_NODEBUG;
      CvFLAGS(get_cv("namespaces::unimport", FALSE)) |= CVf_NODEBUG;
      CvFLAGS(get_cv("namespaces::temp_disable", FALSE)) |= CVf_NODEBUG;
      skip_debug_cx=TRUE;
   }
#if DebugNamespaces
   debug=getenv("POLYMAKE_DEBUG_NAMESPACES")!=0;
#endif

   def_pp_GV       =PL_ppaddr[OP_GV];
   def_pp_GVSV     =PL_ppaddr[OP_GVSV];
   def_pp_RV2GV    =PL_ppaddr[OP_RV2GV];
   def_pp_AELEMFAST=PL_ppaddr[OP_AELEMFAST];
   def_pp_ENTEREVAL=PL_ppaddr[OP_ENTEREVAL];
   def_pp_REGCOMP  =PL_ppaddr[OP_REGCOMP];
   def_ck_CONST    =PL_check[OP_CONST];
   def_ck_ENTERSUB =PL_check[OP_ENTERSUB];
   def_ck_LEAVESUB =PL_check[OP_LEAVESUB];
   def_ck_LEAVEEVAL=PL_check[OP_LEAVEEVAL];
   def_ck_GLOB     =PL_check[OP_GLOB];
}