#include <stddef.h>
#include <stdlib.h>
#include <stdio.h>
#include "node.h"
/* #include "newmacros.h"  -- already included in node.h */
/* #include "runtime.h"    -- already included in node.h */
/* #include "bytecode.h"   -- need value for GA1EVAL */
/*                         -- already included in node.h via newmacros.h */
#include "mark.h"
#include "mutlib.h"
#include "profile.h"

GcConst oldCaf = GcEnd;
GcConst newCaf = GcEnd;

void addCaf2(UInt cons)
{
  GcConst cptr = (GcConst)cons;
  if(!cptr->next) {
    cptr->next = newCaf;
    newCaf = cptr;
  }
}

void addCaf(Finfo finfo)
{
  addCaf2((UInt)FINFO_CONST(finfo));
}


UInt marked(NodePtr node)   /* True if marked, false otherwise,  mark the node */
{
  UInt off = node - hpLowLimit;
  UInt mask = 1l << (off & WORDMASK);

  off >>= WORDSHIFT;
  if(bitTable[off] & mask)
    return 1;
  bitTable[off] |= mask;
  return 0;
}


UInt ifmarked(NodePtr node)   /* True if marked, false otherwise */
{
  UInt off = node - hpLowLimit;
  UInt mask = 1l << (off & WORDMASK);
  off >>= WORDSHIFT;
  if(bitTable[off] & mask)
    return 1;
  return 0;
}

void unmarked(NodePtr node)   /* Clear mark for node */
{
  UInt off = node - hpLowLimit;
  UInt mask = 1l << (off & WORDMASK);
  off >>= WORDSHIFT;
  bitTable[off] &= ~mask;
}

void markClear(void)
{
  NodePtr p;
  for(p = bitTable; p < hpEnd; *p++ = 0)
    ;
  hpEnd[-1] = ~0;
  marked(hpLowLimit);
}

#ifdef PROFILE
static Retainer *profileRetainer;
static int maxRetainerStack;
static int posRetainerStack;
static Retainer **RetainerStack;

#define STARTRETAINERSTACK 256

void pushRetainerStack(Retainer *retainer,NodePtr node)
{
  if(posRetainerStack >= maxRetainerStack) {
    if(RetainerStack) {
      maxRetainerStack *=2;
      RetainerStack = realloc(RetainerStack,sizeof(Retainer *) * maxRetainerStack);
    } else {
      maxRetainerStack = STARTRETAINERSTACK;
      RetainerStack = malloc(sizeof(Retainer *) * maxRetainerStack);
    }
    if(!RetainerStack) {
      fprintf(stderr,"pushRetainerStack run out of memory!\n");
      exit(-1);
    }
  }
  RetainerStack[posRetainerStack++] = retainer;
}

Retainer *popRetainerStack(NodePtr node)
{
  Retainer *retainer = profileRetainer;
  if(posRetainerStack) {
    retainer = RetainerStack[--posRetainerStack];
  } else
    fprintf(stderr,"popRetainerStack on empty stack ignored!\n");

  return retainer;
}

#endif

NodePtr ind_remove(NodePtr np)
{
    NodePtr op;
    int n = 0;

    while ((*np & 0x2) == 0) {
	n++;
	op = np;
	np = (NodePtr)*np;
	if (np == NULL) {
	    fprintf(stderr, "Hmm np = NULL, op = %p after %d loops\n",
		    op, n);
	    return np;
	    /* **np;*/
	}
    }
    return np;
}




extern NodePtr prevLow,prevHigh;
Int debug = 0;

NodePtr mark(NodePtr *inode)
{
  NodePtr node = *inode;
  NodePtr pptr = &hpLowLimit[1];
  NodePtr newpptr;

  hpLowLimit[1] = 0;

  EDB(if(debug) {fprintf(stderr,"\nmark %lx:",(UInt)node); fflush(stderr);})
  Q(node,"mark")
  SQ("mark")

  WHEN_DYNAMIC(posRetainerStack = 0;)

 InspectNode:
  EDB(if(debug) {fprintf(stderr,"Inspect %lx:",(UInt)node); fflush(stderr);})
  if(node > hpEnd) {
    fprintf(stderr,"InspectNode %lx > hpEnd %lx\n",(UInt)node,(UInt)hpEnd);
    exit(-1);
  }
  { UInt tag;
    IND_REMOVE(node);
    tag = EXT_LARGETAG(*node);
    if(OUTSIDE(node)) {
      if(tag & VAP_TAG) {
	Cinfo cinfo;
	EDB(if(debug) {fprintf(stderr,"VAP(0):"); fflush(stderr);})
	  cinfo = GET_CINFO(node);
	addCaf(CINFO_FINFO(cinfo));
      }
      goto NextNode;
    }


#ifdef DYNAMIC
    if (pactive && useUnique && GET_INFO(node)->unique == 0) {
      GET_INFO(node)->unique = ++unique;
    }
#endif

    if(marked(node)) {
#ifdef DYNAMIC
      if(pactive && ((profile | filter) & PROFILE_RETAINER)
         && !memberAdr(profileRetainer->keep,profileRetainer->member[0],(Retainer *)GET_INFO(node)->rinfo)) {
        pushRemarkStack(profileRetainer->keep,profileRetainer->member[0],node,0);
      }
#endif
      goto NextNode;
    }
    WHEN_DYNAMIC(GET_INFO(node)->rinfo = profileRetainer;)
    Q(node,"inspect")
    switch(tag) {
    case CON_DATA|VAP_TAG0: case CON_PTRS|VAP_TAG0: case CON_CDATA|VAP_TAG0: case CON_WORDS|VAP_TAG0:
    case CON_DATA|VAP_TAG1: case CON_PTRS|VAP_TAG1: case CON_CDATA|VAP_TAG1: case CON_WORDS|VAP_TAG1:
      EDB(if(debug) {fprintf(stderr,"VAP/CAP:"); fflush(stderr);})
      { Cinfo cinfo = GET_CINFO(node);
	Int size = (Int)CINFO_SIZE(cinfo);
        Finfo finfo = CINFO_FINFO(cinfo);

/* !!! SPACE FOR WADLER HERE !!! */

#if 1
/*
 * Check if it is a selector with an evaluated argument.
 * Note : The constructor might have its pointer reversed already.
 *           Don't fix selector, no space savings are possible in any case.
 *        Selector on Selecor on Constructor should be optimised.
 *           Do Pointer reversing down the list as long as all applicatins are selectors
 *           and no application is marked. If we find a constructor then fix all applications
 *           otherwise just restore everything.
 *        All marked applications on the way down must be unmarked on the way up otherwise garbage
 *        might survive.
 *
 * 0: NEEDSTACK_I16
 * 1: SELECTOR_EVAL
 * 2: SELECT pos
 * 4: RETURN_EVAL
 *
 */

#define SELECTOR_INS  1
#define SELECTOR_ARG  3

#if 1
#define WHEN_WADLER(x)
#else
#define WHEN_WADLER(x) x
#endif

	if(!ZAPPED(node) &&                                       /* Don't do wadler on things under evaluation */
	   !CINFO_NEED(cinfo) &&                                  /* All arguments must be available, ie one */
	   (FINFO_CODE(finfo))[SELECTOR_INS] == SELECTOR_EVAL) {  /* and it must be a selector */
	  NodePtr app = node;
	  NodePtr arg = GET_POINTER_ARG1(node,1);
	  IND_REMOVE(arg);
	  WHEN_WADLER(fprintf(stderr,"START  node  %08lx:%08lx %08lx\n",node,node[0],node[EXTRA+1]);)
	  WHEN_WADLER(fprintf(stderr,"WADLER 1     %08lx %08lx\n",app,arg);)
	  while((GET_TAG(arg) & VAP_TAG) &&     /* An application ... */
		!ZAPPED(arg) &&                 /* not under evaluation ... */
		((VAP_CODE(arg))[SELECTOR_INS] == SELECTOR_EVAL)) {  /* ... that is a selector */
	    if(INSIDE(arg) && !ifmarked(arg)) { /* ... and it wasn't marked */
	      NodePtr tmp = (NodePtr)arg[EXTRA+1];      /* Pointer reversal and one step down */
	      WHEN_WADLER(fprintf(stderr,"WADLER   2    %08lx %08lx\n",app,arg);)
	      marked(arg);
	      arg[EXTRA+1]=(Node)app;
	      app = arg;
	      arg = tmp;
	      IND_REMOVE(arg);
	    } else
	      goto restore;	      
	  }
	  WHEN_WADLER(fprintf(stderr,"WADLER 3     %08lx %08lx\n",app,arg);)
	  /*
	   *  arg is either an unmarked constructor or something else
	   */

	  while(GET_TAG(arg) == CON_TAG && (INSIDE(arg) && !ifmarked(arg))) {
	    Int pos;
	    WHEN_WADLER(fprintf(stderr,"WADLER   4   %08lx %08lx(%08lx)\n",app,arg,*arg);)
	    WHEN_WADLER(fprintf(stderr,"WADLER   4b [%08lx %08lx]\n",hpLowLimit,bitTable);)
	    pos = FINFO_CODE(GET_FINFO(app))[SELECTOR_ARG];
	    WHEN_WADLER(fprintf(stderr,"WADLER   4c  pos = %08lx\n",pos);)
#if PARANOID
	    switch(GET_LARGETAG(arg)) {
	    case CON_DATA  | CON_TAG :
	    case CON_CDATA | CON_TAG :
	      WHEN_WADLER(fprintf(stderr,"WADLER   4d size = %08lx\n",CONINFO_SIZE(*arg));)
	      WHEN_WADLER({Int i; for(i=1; i<= CONINFO_SIZE(*arg);i++) { fprintf(stderr,"%08lx:%08lx\n",&(arg[EXTRA+i]),arg[EXTRA+i]);}});
	      if(CONINFO_SIZE(*arg)<pos) {
		fprintf(stderr,"pos (%d) > size (%d)  %08lx:%08lx\n",pos,CONINFO_SIZE(*arg),arg,*arg);
		exit(-1);
	      } break;
	    case CON_PTRS  | CON_TAG :
	    case CON_WORDS | CON_TAG :
	      WHEN_WADLER(fprintf(stderr,"WADLER   4e size = %08lx\n",CONINFO_LARGESIZEU(*arg));)
	      WHEN_WADLER({Int i; for(i=1; i<= CONINFO_LARGESIZEU(*arg);i++) { fprintf(stderr,"%08lx:%08lx\n",&(arg[EXTRA+i]),arg[EXTRA+i]);}});
	      if(CONINFO_LARGESIZEU(*arg)<pos) {
		fprintf(stderr,"pos (%d) > size (%d)  %08lx:%08lx\n",pos,CONINFO_LARGESIZEU(*arg),arg,*arg);
		exit(-1);
	      } break;
            default: fprintf(stderr,"Shit happend! app = %08lx arg = %08lx\n",app,arg);
	             exit(-1);
	    }
	      
#endif
	    WHEN_WADLER(fprintf(stderr,"WADLER   4f arg = %08lx\n",arg);)
	    arg = GET_POINTER_ARG1(arg,pos);  /* Get part .. */
	    WHEN_WADLER(fprintf(stderr,"WADLER   4g arg = %08lx\n",arg);)
	    IND_REMOVE(arg);
	    WHEN_WADLER(fprintf(stderr,"WADLER   4h arg = %08lx\n",arg);)

	    WHEN_WADLER(fprintf(stderr,"WADLER   4i app = %08lx:%08lx\n",app,*app);)
#ifdef PROFILE
	    SAVE_PROFINFO(app);
	    app[1] = (Node)-(Int)(app+SIZE_VAP1);            /* .. insert padding cell */ 
            WHEN_WADLER(fprintf(stderr,"WADLER   4j app[1] = %08lx\n",(Node)-(Int)(app+SIZE_VAP1));)
#endif
	    app[0] = (Node)arg;                                 /* .. overwrite Selector */
    	    unmarked(app);              /* .. and unmark, no marked indirection nodes. */
	    if(app == node) {            /* All done ..  */
	      WHEN_WADLER(fprintf(stderr,"END(1) node  %08lx:%08lx %08lx\n",node,node[0],node[EXTRA+1]);)
	      goto InspectNode;
	    }
	    app = (NodePtr)app[EXTRA+1];      /* .. otherwise back up one step */
	  }
	  WHEN_WADLER(fprintf(stderr,"WADLER 5     %08lx %08lx\n",app,arg);)
	  /*
           * arg is not a constructor or it is already marked
	   */
	restore:
	  node[EXTRA+1] = (Node)0;                    /* End conition */
	  do {
	    NodePtr tmp = (NodePtr)app[EXTRA+1];  /* Get back pointer */
	    WHEN_WADLER(fprintf(stderr,"WADLER   6   %08lx %08lx\n",app,arg);)
	    app[EXTRA+1] = (Node)arg;
	    arg = app;
	    unmarked(arg);
	    app = tmp;
	  } while (app);
	  marked(arg);  /* Not as efficient as it should be */
	  WHEN_WADLER(fprintf(stderr,"WADLER 7     %08lx %08lx\n",app,arg);)
	  WHEN_WADLER(fprintf(stderr,"END(2) node  %08lx:%08lx %08lx\n",node,node[0],node[EXTRA+1]);)
	}
#endif

/*********************************/

        addCaf(finfo);
        WHEN_DYNAMIC(if(pactive) GET_INFO(node)->rinfo = profileRetainer;)
        if(size) {
	  WHEN_PROFILE(marked(node+EXTRA);) /* Mark last word in info */
          newpptr = node+size+EXTRA;
	  EDB(if(debug) {fprintf(stderr,"node = %lx newpptr = %lx:",(UInt)node,(UInt)newpptr); fflush(stderr);})
#ifdef DYNAMIC
          if(pactive && ((profile | filter) & PROFILE_RETAINER)) {
            extern int countAp;
            NodePtr *consttable = FINFO_CONST(finfo);
            char *string = ((char **)consttable)[-1];
            pushRetainerStack(profileRetainer,node);
            if(countAp || *string != '@')
              profileRetainer = findRetainer(0,keepFunction(string),string);
          }
#endif
          goto PushNode;
        }
      } goto NextNode;
    case CON_CDATA|CON_TAG:
      EDB(if(debug) {fprintf(stderr,"CON CDATA:"); fflush(stderr);})
      { Coninfo coninfo = GET_CONINFO(node);
        Int psize  = (Int)CONINFO_PSIZE(coninfo);
        WHEN_DYNAMIC(if(pactive) GET_INFO(node)->rinfo = profileRetainer;)
        EDB(if(debug) {fprintf(stderr,"psize = %d:",psize); fflush(stderr);})
        markForeignObj((ForeignObj *)*(node+psize+1+EXTRA));
	WHEN_PROFILE(marked(node+EXTRA);) /* Mark last word in info */
        if(psize) {
          newpptr = node+psize+EXTRA;
          EDB(if(debug) {fprintf(stderr,"node = %lx newpptr = %lx:",(UInt)node,(UInt)newpptr); fflush(stderr);})
          goto PushNode;
        }
      } goto NextNode;
    case CON_DATA|CON_TAG:
      EDB(if(debug) {fprintf(stderr,"CON DATA:"); fflush(stderr);})
      { Coninfo coninfo = GET_CONINFO(node);
        Int psize  = (Int)CONINFO_PSIZE(coninfo);

        WHEN_DYNAMIC(if(pactive) GET_INFO(node)->rinfo = profileRetainer;)
        if(psize) {
	  WHEN_PROFILE(marked(node+EXTRA);) /* Mark last word in info */
          newpptr = node+psize+EXTRA;
          EDB(if(debug) {fprintf(stderr,"node = %lx newpptr = %lx:",(UInt)node,(UInt)newpptr); fflush(stderr);})
          goto PushNode;
        }
      } goto NextNode;
    case CON_PTRS|CON_TAG:
      EDB(if(debug) {fprintf(stderr,"CON PTRS:"); fflush(stderr);})
      { Coninfo coninfo = GET_CONINFO(node);
        Int psize  = (Int)CONINFO_LARGESIZEU(coninfo);
        WHEN_DYNAMIC(if(pactive) GET_INFO(node)->rinfo = profileRetainer;)
        EDB(if(debug) {fprintf(stderr,"psize = %d:",psize); fflush(stderr);})
        if(psize) {
	  WHEN_PROFILE(marked(node+EXTRA);) /* Mark last word in info */
          newpptr = node+psize+EXTRA;
          EDB(if(debug) {fprintf(stderr,"node = %lx newpptr = %lx:",(UInt)node,(UInt)newpptr); fflush(stderr);})
          goto PushNode;
        }
      } goto NextNode;
    case CON_WORDS|CON_TAG:
      EDB(if(debug) {fprintf(stderr,"CON WORDS:"); fflush(stderr);})

/* Check if it is a known integer */
      { Int i;
        if(*node == CONSTRW(1,0) && (i=node[EXTRA+1]) >= -10 && i <= 255) { /* Table int (includes all characters) */
          unmarked(node);
          node = GET_INT(i);
          goto NextNode;
        }
      }

#ifdef DYNAMIC
      { EDB(Coninfo coninfo = GET_CONINFO(node);)
        EDB(Int size  = (Int)CONINFO_LARGESIZEU(coninfo);)
        if(pactive) GET_INFO(node)->rinfo = profileRetainer;
        EDB(if(debug) {fprintf(stderr,"size = %d:",size); fflush(stderr);})
      } goto NextNode;
#endif
      break;
    default:
      fprintf(stderr,"IND_TAG in mark! (1)\n");
      exit(-1);
    }
  }

 NextNode:
  EDB(if(debug) {fprintf(stderr,"Nextnode %lx:",(UInt)node); fflush(stderr);})
  { Node tmp = *pptr;
    *pptr-- = (Node)node;

    if(ifmarked(pptr)) {         /* PopNode: */
      EDB(if(debug) {fprintf(stderr,"PopNode %lx:",(UInt)node); fflush(stderr);})
      if(tmp) {
        node = -EXTRA+(NodePtr)pptr; /* skip over info */
        pptr = (NodePtr)tmp;
#ifdef DYNAMIC
	if(pactive && ((profile | filter) & PROFILE_RETAINER)  && (GET_TAG(node) & VAP_TAG)) {
	  profileRetainer = popRetainerStack(node);
	}
#endif
        goto NextNode;
      } else {
        *inode = node;
        EDB(if(debug) {fprintf(stderr,"return1 %lx\n",(UInt)node); fflush(stderr);})
        return node;
      }
    } else {
      node = (NodePtr)*pptr;
      *pptr = tmp;
      goto InspectNode;
    }
  }

 PushNode:
  EDB(if(debug) {fprintf(stderr,"PushNode %lx:",(UInt)node); fflush(stderr);})
  node = (NodePtr)*newpptr;
  *newpptr = (Node)pptr;
  pptr = newpptr;
  goto InspectNode;
}

void markCaf(void)
{
  while(newCaf != GcEnd) {
    GcConst cptr = newCaf;
    Int size = cptr->sizeArity;
    Int i;
    size = FSTHW(size);

#ifdef DYNAMIC
    if((profile | filter) & PROFILE_RETAINER) {
      char *function = (char *)(newCaf[-1].ptr[0]);   /* ((char **)newCaf)[-1]; didn't work */
      profileRetainer = findRetainer(0,keepFunction(function),function);
    }
#endif
    newCaf = cptr->next;
    cptr->next = oldCaf;
    oldCaf = cptr;

    {
      NodePtr *nptr = &cptr->ptr[0];
      if(GET_TAG(nptr) == IND_TAG)
	mark(nptr);
      i = EXTRA+1;
      size += EXTRA+1;
    }

    for(; i<size; i++) {
      NodePtr nptr = cptr->ptr[i];
      switch(EXT_TAG(nptr)) {
      case VAP_TAG0: case VAP_TAG1:
	{ Cinfo cinfo = EXT_CINFO(nptr);
	  addCaf(CINFO_FINFO(cinfo));
	} break;
      case CON_TAG:
	fprintf(stderr,"CON_TAG in markCaf(1) cptr = %p sizeArity = %08x i = %2ld %p:%p\n",cptr,cptr->sizeArity,i,&cptr->ptr[i],nptr);
	exit(-1);
      case IND_TAG:
	mark(&cptr->ptr[i]);
	break;
      }
    }
  }
}

/*

         |         |                   /-----------\
         |     ----+-------------->--->|VAP Node   |
if scc   :sccptr'  :             /     \-----------/
         |fp'      |            /
fp,sp -> |ip'      |  vapptr --/
         -----------

 */

void markStack(NodePtr *sp)
{
  NodePtr *sptr;
  for(sptr = sp; sptr < spStart; ) {
    NodePtr *fp;
    sptr++;                /* skip ip */
    fp = (NodePtr *)*sptr++; /* Fetch fp */

#ifdef DYNAMIC
      if(pactive && ((profile|filter)&PROFILE_RETAINER)) {
	NodePtr *cp = VAP_CONST(fp[2]);  /* fp[0] == ip, fp[1] == fp' */
	char *function = ((char **)cp)[-1];
	profileRetainer = findRetainer(0,keepFunction(function),function);
      }
#endif

    EDB(if(bellGc>1) { fprintf(stderr,"."); fflush(stderr); })

    while(sptr != fp) {
      EDB(if(debug) {fprintf(stderr,"\n  %4x: ",(UInt)sptr); printGraf(*sptr,3,10);fprintf(stderr,"\n"); })
      mark(sptr);
      sptr++;
    }
  }
}