#include <stdlib.h>

#include "defs.h"
#include "prims.h"

#define t (*top)

PRIM(pop)
{
 NARGS(1);
 POP(1);
}

PRIM(dup)
{
 NARGS(1);
 STACKROOM(1);
 copyinst(&arg[t-1],&arg[t]);
 t ++;
}

PRIM(swap)
{
 struct inst tmp;

 NARGS(2);
 tmp = arg[t-1];
 arg[t-1] = arg[t-2];
 arg[t-2] = tmp;
}

PRIM(over)
{
 NARGS(2);
 copyinst(&arg[t-2],&arg[t]);
 t ++;
}

PRIM(pick)
{
 struct inst *v;
 int n;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument.");
 n = v->data.number;
 if (n <= 0) ABORT_INTERP("Invalid argument.");
 NARGS(n+1);
 POP(1);
 copyinst(&arg[t-n],&arg[t]);
 t ++;
}

PRIM(put)
{
 struct inst *vn;
 struct inst *vval;
 int n;

 NARGS(2);
 vn = TOS(0);
 vval = TOS(1);
 if (vn->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument.");
 n = vn->data.number;
 if (n <= 0) ABORT_INTERP("Invalid argument.");
 NARGS(n+2);
 CLEAR(&arg[t-n-2]);
 copyinst(vval,&arg[t-n-2]);
 POP(2);
}

PRIM(rot)
{
 struct inst tmp;

 NARGS(3);
 tmp = arg[t-3];
 arg[t-3] = arg[t-2];
 arg[t-2] = arg[t-1];
 arg[t-1] = tmp;
}

PRIM(_rot)
{
 struct inst tmp;

 NARGS(3);
 tmp = arg[t-1];
 arg[t-1] = arg[t-2];
 arg[t-2] = arg[t-3];
 arg[t-3] = tmp;
}

PRIM(rotate)
{
 struct inst *v;
 struct inst tmp;
 int n;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument.");
 n = v->data.number;
 NARGS(abs(n)+1);
 POP(1);
 if (n > 1)
  { tmp = arg[t-n];
    bcopy(&arg[t-n+1],&arg[t-n],(n-1)*sizeof(arg[0]));
    arg[t-1] = tmp;
  }
 else if (n < -1)
  { tmp = arg[t-1];
    bcopy(&arg[t+n],&arg[t+n+1],(-n-1)*sizeof(arg[0]));
    arg[t+n] = tmp;
  }
}

static int gcd(int a, int b)
{
 int r;

 while (b > 0)
  { r = a % b;
    a = b;
    b = r;
  }
 return(a);
}

PRIM(roll)
{
 struct inst *vm;
 struct inst *vn;
 int i;
 int jh;
 int jt;
 int n;
 int m;
 int tos;
 struct inst tmp;

 NARGS(2);
 vm = TOS(0);
 vn = TOS(1);
 if (vm->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument. (2)");
 if (vn->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument. (1)");
 m = vm->data.number;
 n = vn->data.number;
 if (n < 0) ABORT_INTERP("Negative argument (1)");
 NARGS(n+2);
 POP(2);
 if ((n == 0) || (n == 1)) return;
 m %= n;
 if (m < 0) m += n;
 if (m == 0) return;
 /* to avoid needing m temporaries, we roll the stack by moving one piece
    at a time.  We need gcd(m,n) pieces to get everything.  For example,
    15 6 roll (stack is a b c d e f g h i j k l m n o) is done with
    gcd(15,6)=3 chains of 15/3=5 copies each, with a stride of 6:
	m->temp; g->m; a->g; j->a; d->j; temp->d
	n->temp; h->n; b->h; k->b; e->k; temp->e
	o->temp; i->o; c->i; l->c; f->l; temp->f
 */
 tos = t - 1;
 for (i=gcd(m,n)-1;i>=0;i--)
  { tmp = arg[tos-i];
    jh = i;
    while (1)
     { jt = jh;
       jh = (jh + m) % n;
       if (jh == i) break;
       arg[tos-jt] = arg[tos-jh];
     }
    arg[tos-jt] = tmp;
  }
}

PRIM(depth)
{
 STACKROOM(1);
 MPUSH(PROG_INTEGER,t);
}

PRIM(pstack)
{
 struct inst *vstr;
 struct inst *vcount;
 int n;
 char buffer[520];
#define BUFEND (&buffer[510]) /* allow a little slop */
 char *bp;
#define ADV (bp+=strlen(bp))
 int sp;

 NARGS(1);
 vstr = 0;
 vcount = TOS(0);
 if (vcount->type == PROG_STRING)
  { NARGS(2);
    vstr = TOS(0);
    vcount = TOS(1);
  }
 if (vcount->type != PROG_INTEGER) ABORT_INTERP("Count value not an integer.");
 n = vcount->data.number;
 bp = &buffer[0];
 sprintf(bp,"%.*s> ( ",(int)(BUFEND-bp),vstr?DoNullInd(vstr->data.string):"Stack"); ADV;
 POP(vstr?2:1);
 sp = t - n;
 if (sp <= 0)
  { sp = 0;
  }
 else
  { sprintf(bp,"...[%d]",sp); ADV;
  }
 for (;sp<t;sp++)
  { char *el;
    if (sp)
     { strcpy(bp,", "); ADV;
     }
    el = insttotext(arg+sp);
    if (bp+strlen(el) >= BUFEND)
     { strcpy(bp,"..."); ADV;
       break;
     }
    strcpy(bp,el); ADV;
  }
 strcpy(bp," )");
 if (FLAGS(program) & MUCKER)
  { notify_listener(player,player,&buffer[0]);
  }
 else
  { notify(player,&buffer[0]);
  }
#undef ADV
#undef BUFEND
}

PRIM(mpop)
{
 struct inst *v;
 int n;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument.");
 n = v->data.number;
 if (n < 0) ABORT_INTERP("Negative argument.");
 NARGS(n+1);
 POP(n+1);
}

PRIM(copy)
{
 struct inst *v;
 int n;
 struct inst *fi;
 struct inst *ti;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument.");
 n = v->data.number;
 if (n < 0) ABORT_INTERP("Negative argument.");
 NARGS(n+1);
 STACKROOM(n-1);
 POP(1);
 if (n > 0)
  { fi = &arg[t-n];
    ti = &arg[t];
    t += n;
    for (;n>0;n--) copyinst(fi++,ti++);
  }
}

PRIM(critical)
{
 NARGS(1);
 if (critical_start(fr)) ABORT_INTERP("Nested critical sections");
}