#include <ctype.h>
#include <string.h>

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

#define FOO(name,call) \
PRIM(name) { struct inst *vs1; struct inst *vs2; int rv;		\
	NARGS(2); vs2 = TOS(0); vs1 = TOS(1);				\
	if ((vs1->type != PROG_STRING) || (vs2->type != PROG_STRING))	\
	{ ABORT_INTERP("Non-string argument."); }			\
	if (vs1->data.string == vs2->data.string) rv = 0;		\
	else if (! (vs2->data.string && vs1->data.string))		\
	{ rv = vs1->data.string ? 1 : -1; } else			\
	{ rv = call(vs1->data.string,vs2->data.string); }		\
	POP(2); MPUSH(PROG_INTEGER,rv); }

FOO(stringcmp,string_compare)
FOO(strcmp,strcmp)

#undef FOO

#define FOO(name,call) \
PRIM(name) { struct inst *vs1; struct inst *vs2; struct inst *vsn;	\
	int rv; NARGS(3); vsn = TOS(0); vs2 = TOS(1); vs1 = TOS(2);	\
	if ((vs1->type != PROG_STRING) || (vs2->type != PROG_STRING))	\
	{ ABORT_INTERP("Non-string argument."); }			\
	if (vs1->data.string == vs2->data.string) rv = 0;		\
	else if (! (vs2->data.string && vs1->data.string))		\
	{ rv = vs1->data.string ? 1 : -1; } else			\
	rv = call(vs1->data.string,vs2->data.string,vsn->data.number);	\
	POP(3); MPUSH(PROG_INTEGER,rv); }

FOO(stringncmp,string_n_compare)
FOO(strncmp,strncmp)

#undef FOO

PRIM(strcut)
{
 struct inst *vs;
 struct inst *vn;
 char *s;
 int n;

 NARGS(2);
 vn = TOS(0);
 vs = TOS(1);
 if (vn->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument (2).");
 if (vs->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 s = vs->data.string;
 n = vn->data.number;
 vs->data.string = 0;
 POP(2);
 if (! s)
  { MPUSH(PROG_STRING,0);
    MPUSH(PROG_STRING,0);
  }
 else
  { int len;
    len = strlen(s);
    if (n < 0)
     { n += len;
       if (n < 0) n = 0;
     }
    if (n >= len)
     { MPUSH(PROG_STRING,s);
       MPUSH(PROG_STRING,0);
     }
    else if (n == 0)
     { MPUSH(PROG_STRING,0);
       MPUSH(PROG_STRING,s);
     }
    else
     { char *t;
       t = dup_string(s+n);
       s[n] = '\0';
       MPUSH(PROG_STRING,s);
       MPUSH(PROG_STRING,t);
     }
  }
}

PRIM(substr)
{
 struct inst *vs;
 struct inst *vbeg;
 struct inst *vlen;
 char *s;
 int beg;
 int len;
 int slen;

 NARGS(3);
 vs = TOS(2);
 vbeg = TOS(1);
 vlen = TOS(0);
 if (vs->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 if (vbeg->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument (2).");
 if (vlen->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument (3).");
 s = vs->data.string;
 beg = vbeg->data.number;
 len = vlen->data.number;
 vs->data.string = 0;
 POP(3);
 if (s == 0)
  { MPUSH(PROG_STRING,0);
    return;
  }
 slen = strlen(s);
 if (beg < 0) beg += slen;
 if (len < 0) len += slen;
 if (beg < 0)
  { len += beg;
    beg = 0;
  }
 if (len < 0) len = 0;
 if (beg >= slen)
  { len = 0;
    beg = 0;
  }
 if (beg+len > slen) len = slen - beg;
 if (len <= 0)
  { MPUSH(PROG_STRING,0);
  }
 else
  { char *t;
    t = malloc(len+1);
    bcopy(s+beg,t,len);
    t[len] = '\0';
    free(s);
    MPUSH(PROG_STRING,t);
  }
}

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

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_STRING) ABORT_INTERP("Non-string argument.");
 n = v->data.string ? strlen(v->data.string) : 0;
 POP(1);
 MPUSH(PROG_INTEGER,n);
}

PRIM(strcat)
{
 struct inst *vs1;
 struct inst *vs2;
 char *s1;
 char *s2;
 int l;
 char *t;

 NARGS(2);
 vs2 = TOS(0);
 vs1 = TOS(1);
 if ((vs1->type != PROG_STRING) || (vs2->type != PROG_STRING)) ABORT_INTERP("Non-string argument.");
 s1 = vs1->data.string;
 s2 = vs2->data.string;
 if (! s2)
  { POP(1);
    return;
  }
 if (! s1)
  { vs1->data.string = s2;
    vs2->data.string = 0;
    POP(1);
    return;
  }
 l = strlen(s1);
 t = malloc(l+strlen(s2)+1);
 bcopy(s1,t,l);
 strcpy(t+l,s2);
 POP(2);
 MPUSH(PROG_STRING,t);
}

PRIM(explode)
{
 struct inst *vstr;
 struct inst *vdelim;
 char *str;
 char *delim;
 int i;
 int j;
 int n;
 int slen;
 int dlen;
 int beg;
 int t;

 NARGS(2);
 vdelim = TOS(0);
 vstr = TOS(1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 str = vstr->data.string;
 switch (vdelim->type)
  { case PROG_STRING:
       if (vdelim->data.string) break;
       CLEAR(vdelim);
       vdelim->type = PROG_INTEGER;
       vdelim->data.number = 1;
       /* fall through */
    case PROG_INTEGER:
       dlen = vdelim->data.number;
       if (dlen < 1) ABORT_INTERP("Part length <= 0.");
       if (! str)
	{ POP(2);
	  MPUSH(PROG_INTEGER,0);
	  return;
	}
       slen = strlen(str);
       if (dlen >= slen)
	{ POP(1);
	  MPUSH(PROG_INTEGER,1);
	  return;
	}
       vstr->data.string = 0;
       POP(2);
       n = 0;
       for (i=slen-1-((slen-1)%dlen);i>=0;i-=dlen)
	{ STACKROOM(1);
	  MPUSH(PROG_STRING,dup_string(str+i));
	  n ++;
	  str[i] = '\0';
	}
       free(str);
       STACKROOM(1);
       MPUSH(PROG_INTEGER,n);
       return;
       break;
    default:
       ABORT_INTERP("Invalid delimiter type (2).");
       break;
  }
 delim = vdelim->data.string;
 vdelim->data.string = 0;
 vstr->data.string = 0;
 POP(2);
 if (! str)
  { MPUSH(PROG_STRING,0);
    MPUSH(PROG_INTEGER,1);
    free(delim);
    return;
  }
 slen = strlen(str);
 dlen = strlen(delim);
 beg = 0;
 i = 0;
 n = 0;
 while (1)
  { if (i+dlen > slen)
     { STACKROOM(1);
       MPUSH(PROG_STRING,dup_string(str+beg));
       n ++;
       break;
     }
    if (!bcmp(str+i,delim,dlen))
     { str[i] = '\0';
       STACKROOM(1);
       MPUSH(PROG_STRING,dup_string(str+beg));
       n ++;
       i += dlen;
       beg = i;
     }
    else
     { i ++;
     }
  }
 t = *top;
 for (i=n/2,j=n+1-i;i>0;i--,j++)
  { struct inst tmp;
    tmp = arg[t-i];
    arg[t-i] = arg[t-j];
    arg[t-j] = tmp;
  }
 free(delim);
 free(str);
 STACKROOM(1);
 MPUSH(PROG_INTEGER,n);
}

PRIM(implode)
{
 struct inst *vdelim;
 struct inst *vn;
 struct inst *varg;
 char *delim;
 int dlen;
 int n;
 int i;
 int totlen;
 char *rbuf;
 char *rbp;

 NARGS(2);
 vdelim = TOS(0);
 vn = TOS(1);
 if (vdelim->type != PROG_STRING) ABORT_INTERP("Non-string argument (delim).");
 if (vn->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument (count).");
 delim = vdelim->data.string;
 n = vn->data.number;
 if (n < 0) ABORT_INTERP("Negative count.");
 if (n == 0)
  { POP(2);
    MPUSH(PROG_STRING,0);
    return;
  }
 NARGS(n+2);
 dlen = delim ? strlen(delim) : 0;
 totlen = (n-1) * dlen;
 for (i=0;i<n;i++)
  { varg = TOS(i+2);
    if (varg->type != PROG_STRING) ABORT_INTERP("Non-string argument (piece).");
    if (varg->data.string) totlen += strlen(varg->data.string);
  }
 rbuf = malloc(totlen+1);
 rbp = rbuf;
 for (i=0;i<n;i++)
  { if (i && delim)
     { bcopy(delim,rbp,dlen);
       rbp += dlen;
     }
    varg = TOS(i+2);
    if (varg->data.string)
     { int l;
       l = strlen(varg->data.string);
       bcopy(varg->data.string,rbp,l);
       rbp += l;
     }
  }
 *rbp = '\0';
 if (rbp != rbuf+totlen) panic("implode: buffer length botch");
 POP(n+2);
 MPUSH(PROG_STRING,rbuf);
}

PRIM(rexplode)
{
 struct inst *vstr;
 struct inst *vdelim;
 char *str;
 char *delim;
 int i;
 int j;
 int n;
 int slen;
 int dlen;
 int beg;
 int t;

 NARGS(2);
 vdelim = TOS(0);
 vstr = TOS(1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 str = vstr->data.string;
 switch (vdelim->type)
  { case PROG_STRING:
       if (vdelim->data.string) break;
       CLEAR(vdelim);
       vdelim->type = PROG_INTEGER;
       vdelim->data.number = 1;
       /* fall through */
    case PROG_INTEGER:
       dlen = vdelim->data.number;
       if (dlen < 1) ABORT_INTERP("Part length <= 0.");
       if (! str)
	{ POP(2);
	  MPUSH(PROG_INTEGER,0);
	  return;
	}
       slen = strlen(str);
       if (dlen >= slen)
	{ POP(1);
	  MPUSH(PROG_INTEGER,1);
	  return;
	}
       vstr->data.string = 0;
       POP(2);
       n = 0;
       for (i=slen-1-((slen-1)%dlen);i>=0;i-=dlen)
	{ STACKROOM(1);
	  MPUSH(PROG_STRING,dup_string(str+i));
	  n ++;
	  str[i] = '\0';
	}
       if (n > 1)
	{ t = *top;
	  for (i=n/2,j=n+1-i;i>0;i--,j++)
	   { struct inst tmp;
	     tmp = arg[t-i];
	     arg[t-i] = arg[t-j];
	     arg[t-j] = tmp;
	   }
	}
       free(str);
       STACKROOM(1);
       MPUSH(PROG_INTEGER,n);
       return;
       break;
    default:
       ABORT_INTERP("Invalid delimiter type (2).");
       break;
  }
 delim = vdelim->data.string;
 vdelim->data.string = 0;
 vstr->data.string = 0;
 POP(2);
 if (! str)
  { MPUSH(PROG_STRING,0);
    MPUSH(PROG_INTEGER,1);
    free(delim);
    return;
  }
 slen = strlen(str);
 dlen = strlen(delim);
 beg = 0;
 i = 0;
 n = 0;
 while (1)
  { if (i+dlen > slen)
     { STACKROOM(1);
       MPUSH(PROG_STRING,dup_string(str+beg));
       n ++;
       break;
     }
    if (!bcmp(str+i,delim,dlen))
     { str[i] = '\0';
       STACKROOM(1);
       MPUSH(PROG_STRING,dup_string(str+beg));
       n ++;
       i += dlen;
       beg = i;
     }
    else
     { i ++;
     }
  }
 free(delim);
 free(str);
 STACKROOM(1);
 MPUSH(PROG_INTEGER,n);
}

PRIM(rimplode)
{
 struct inst *vdelim;
 struct inst *vn;
 struct inst *varg;
 char *delim;
 int dlen;
 int n;
 int i;
 int totlen;
 char *rbuf;
 char *rbp;

 NARGS(2);
 vdelim = TOS(0);
 vn = TOS(1);
 if (vdelim->type != PROG_STRING) ABORT_INTERP("Non-string argument (delim).");
 if (vn->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument (count).");
 delim = vdelim->data.string;
 n = vn->data.number;
 if (n < 0) ABORT_INTERP("Negative count.");
 if (n == 0)
  { POP(2);
    MPUSH(PROG_STRING,0);
    return;
  }
 NARGS(n+2);
 dlen = delim ? strlen(delim) : 0;
 totlen = (n-1) * dlen;
 for (i=0;i<n;i++)
  { varg = TOS(i+2);
    if (varg->type != PROG_STRING) ABORT_INTERP("Non-string argument (piece).");
    if (varg->data.string) totlen += strlen(varg->data.string);
  }
 rbuf = malloc(totlen+1);
 rbp = rbuf;
 for (i=0;i<n;i++)
  { if (i && delim)
     { bcopy(delim,rbp,dlen);
       rbp += dlen;
     }
    varg = TOS(n+1-i);
    if (varg->data.string)
     { int l;
       l = strlen(varg->data.string);
       bcopy(varg->data.string,rbp,l);
       rbp += l;
     }
  }
 *rbp = '\0';
 if (rbp != rbuf+totlen) panic("rimplode: buffer length botch");
 POP(n+2);
 MPUSH(PROG_STRING,rbuf);
}

PRIM(explode1)
{
 struct inst *vstr;
 struct inst *vdelim;
 char *str;
 char *delim;
 char *found;
 int slen;
 int dlen;

 NARGS(2);
 vdelim = TOS(0);
 vstr = TOS(1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 if (vdelim->type != PROG_STRING) ABORT_INTERP("Non-string argument (2).");
 delim = vdelim->data.string;
 str = vstr->data.string;
 if (delim == 0)
  { STACKROOM(1);
    MPUSH(PROG_INTEGER,1);
    return;
  }
 if (str == 0)
  { POP(1);
    MPUSH(PROG_INTEGER,0);
    return;
  }
 vdelim->data.string = 0;
 vstr->data.string = 0;
 POP(2);
 slen = strlen(str);
 dlen = strlen(delim);
 found = strstr(str,delim);
 if (found)
  { STACKROOM(3);
    MPUSH(PROG_STRING,dup_string(found+dlen));
    *found = '\0';
    MPUSH(PROG_STRING,str);
    MPUSH(PROG_INTEGER,1);
    free(delim);
  }
 else
  { MPUSH(PROG_STRING,str);
    MPUSH(PROG_INTEGER,0);
    free(delim);
  }
}

PRIM(rexplode1)
{
 struct inst *vstr;
 struct inst *vdelim;
 char *str;
 char *delim;
 char *found;
 int slen;
 int dlen;
 char *t;

 NARGS(2);
 vdelim = TOS(0);
 vstr = TOS(1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 if (vdelim->type != PROG_STRING) ABORT_INTERP("Non-string argument (2).");
 delim = vdelim->data.string;
 str = vstr->data.string;
 if (delim == 0)
  { STACKROOM(1);
    MPUSH(PROG_INTEGER,1);
    return;
  }
 if (str == 0)
  { POP(1);
    MPUSH(PROG_INTEGER,0);
    return;
  }
 vdelim->data.string = 0;
 vstr->data.string = 0;
 POP(2);
 slen = strlen(str);
 dlen = strlen(delim);
 /* growl.  no strrstr. */ /* found = strrstr(str,delim); */
 /* BEGIN strrstr emulation */
 found = 0;
 t = str;
 while ((t=strstr(t,delim)))
  { found = t;
    t += dlen;
  }
 /* END strrstr emulation */
 if (found)
  { STACKROOM(3);
    *found = '\0';
    MPUSH(PROG_STRING,str);
    MPUSH(PROG_STRING,dup_string(found+dlen));
    MPUSH(PROG_INTEGER,1);
    free(delim);
  }
 else
  { MPUSH(PROG_STRING,str);
    MPUSH(PROG_INTEGER,0);
    free(delim);
  }
}

PRIM(subst)
{
 struct inst *vstr;
 struct inst *vmatch;
 struct inst *vrepl;
 char *str;
 char *match;
 const char *repl;
 int slen;
 int mlen;
 int rlen;
 char *t;
 int tlen;
 int i;
 int j;

 NARGS(3);
 vmatch = TOS(0);
 vrepl = TOS(1);
 vstr = TOS(2);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument. (1)");
 if (vrepl->type != PROG_STRING) ABORT_INTERP("Non-string argument. (2)");
 if (vmatch->type != PROG_STRING) ABORT_INTERP("Non-string argument. (3)");
 match = vmatch->data.string;
 if (! match) ABORT_INTERP("Empty string argument. (3)");
 str = vstr->data.string;
 if (! str)
  { POP(2);
    return;
  }
 repl = DoNullInd(vrepl->data.string);
 slen = strlen(str);
 mlen = strlen(match);
 rlen = strlen(repl);
 tlen = 0;
 i = 0;
 while (i+mlen <= slen)
  { if (!bcmp(str+i,match,mlen))
     { tlen += rlen;
       i += mlen;
     }
    else
     { tlen ++;
       i ++;
     }
  }
 tlen += slen - i;
 t = malloc(tlen+1);
 i = 0;
 j = 0;
 while (i+mlen <= slen)
  { if (!bcmp(str+i,match,mlen))
     { bcopy(repl,t+j,rlen);
       j += rlen;
       i += mlen;
     }
    else
     { t[j++] = str[i++];
     }
  }
 if (i < slen) bcopy(str+i,t+j,slen-i);
 if (j+slen-i != tlen) panic("length mismatch in prims_subst");
 t[tlen] = '\0';
 POP(3);
 MPUSH(PROG_STRING,t);
}

PRIM(multisubst)
{
 struct inst *vstr;
 struct inst *vmatch;
 struct inst *vrepl;
 struct inst *vn;
 char *str;
 char **match;
 const char **repl;
 int n;
 int slen;
 int *mlen;
 int *rlen;
 char *mfc;
 char *t;
 int tlen;
 int i;
 int j;
 int k;

 NARGS(2);
 vn = TOS(0);
 if (vn->type != PROG_INTEGER) ABORT_INTERP("Non-integer count argument.");
 n = vn->data.number;
 if (n < 0) ABORT_INTERP("Negative count.");
 if (n == 0)
  { POP(1);
    return;
  }
 NARGS((2*n)+2);
 vstr = TOS((2*n)+1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string princpal argument.");
 for (i=0;i<n;i++)
  { vmatch = TOS((2*i)+1);
    vrepl = TOS((2*i)+2);
    if (vrepl->type != PROG_STRING) ABORT_INTERP("Non-string replacement argument.");
    if (vmatch->type != PROG_STRING) ABORT_INTERP("Non-string match argument.");
    if (! vmatch->data.string) ABORT_INTERP("Empty match argument.");
  }
 str = vstr->data.string;
 if (! str)
  { POP((2*n)+1);
    return;
  }
 slen = strlen(str);
 match = malloc(n*sizeof(*match));
 repl = malloc(n*sizeof(*repl));
 mlen = malloc(n*sizeof(*mlen));
 rlen = malloc(n*sizeof(*rlen));
 mfc = malloc(n*sizeof(*mfc));
 for (i=0;i<n;i++)
  { vmatch = TOS((2*i)+1);
    vrepl = TOS((2*i)+2);
    repl[i] = DoNullInd(vrepl->data.string);
    match[i] = vmatch->data.string;
    mlen[i] = strlen(match[i]);
    rlen[i] = strlen(repl[i]);
    mfc[i] = match[i][0];
  }
 tlen = slen;
 for (i=0;i<slen;i++)
  { for (j=0;j<n;j++)
     { if ( (str[i] == mfc[j]) &&
	    ( (mlen[j] == 1) ||
	      !bcmp(str+i+1,match[j]+1,mlen[j]-1) ) )
	{ tlen += rlen[j] - mlen[j];
	  i += mlen[j] - 1;
	  break;
	}
     }
  }
 if (tlen == 0)
  { t = 0;
  }
 else
  { t = malloc(tlen+1);
    k = 0;
    for (i=0;i<slen;i++)
     { for (j=0;j<n;j++)
	{ if ( (str[i] == mfc[j]) &&
	       ( (mlen[j] == 1) ||
		 !bcmp(str+i+1,match[j]+1,mlen[j]-1) ) )
	   { bcopy(repl[j],t+k,rlen[j]);
	     k += rlen[j];
	     i += mlen[j] - 1;
	     break;
	   }
	}
       if (j >= n) t[k++] = str[i];
     }
    if (k != tlen) panic("length mismatch in prims_multisubst");
    t[tlen] = '\0';
  }
 free(match);
 free(repl);
 free(mlen);
 free(rlen);
 free(mfc);
 POP((2*n)+2);
 MPUSH(PROG_STRING,t);
}

#define FOO(name,forloop,cmpfn) \
PRIM(name) { struct inst *vstr; struct inst *vfind; char *str; char	\
 *find; int flen; int imax; int i; int rv; NARGS(2); vfind = TOS(0);	\
 vstr = TOS(1); if (vfind->type != PROG_STRING) ABORT_INTERP(		\
 "Invalid argument type (2)."); if (vstr->type != PROG_STRING)		\
 ABORT_INTERP("Non-string argument (1)."); str = vstr->data.string;	\
 find = vfind->data.string; if (! find) { rv = 1; } else if (! str) {	\
 rv = 0; } else { flen = strlen(find); imax = strlen(str) - flen; rv =	\
 0; if (imax >= 0) { for forloop { if (!cmpfn(str+i,find,flen)) { rv =	\
 i + 1; break; } } } } POP(2); MPUSH(PROG_INTEGER,rv); }

FOO(instr,(i=0;i<=imax;i++),bcmp)
FOO(instring,(i=0;i<=imax;i++),cibcmp)
FOO(rinstr,(i=imax;i>=0;i--),bcmp)
FOO(rinstring,(i=imax;i>=0;i--),cibcmp)

#undef FOO

PRIM(pronoun_sub)
{
 struct inst *vstr;
 struct inst *vdbr;
 char *s;

 NARGS(2);
 vstr = TOS(0);
 vdbr = TOS(1);
 if (!valid_object(vdbr)) ABORT_INTERP("Non-object argument. (1)");
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument. (2)");
 s = vstr->data.string
     ? dup_string(pronoun_substitute(vdbr->data.objref,vstr->data.string))
     : 0;
 POP(2);
 MPUSH(PROG_STRING,s);
}

PRIM(toupper)
{
 struct inst *v;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_STRING) ABORT_INTERP("Non-string argument.");
 if (v->data.string) upperstring(v->data.string);
}

PRIM(tolower)
{
 struct inst *v;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_STRING) ABORT_INTERP("Non-string argument.");
 if (v->data.string) lowerstring(v->data.string);
}

PRIM(flagstr)
{
 struct inst *v;
 dbref obj;

 NARGS(1);
 v = TOS(0);
 if (! valid_object(v)) ABORT_INTERP("Non-object argument.");
 obj = v->data.objref;
 POP(1);
 MPUSH(PROG_STRING,dup_string(unparse_flags(obj)));
}

PRIM(caps)
{
 struct inst *v;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_STRING) ABORT_INTERP("Non-string argument.");
 if (v->data.string)
  { char tmp[2];
    lowerstring(v->data.string);
    tmp[0] = v->data.string[0];
    tmp[1] = '\0';
    upperstring(&tmp[0]);
    v->data.string[0] = tmp[0];
  }
}

PRIM(lockstr)
{
 struct inst *v;
 dbref obj;

 NARGS(1);
 v = TOS(0);
 if (! valid_object(v)) ABORT_INTERP("Non-object argument.");
 obj = v->data.objref;
 POP(1);
 MPUSH(PROG_STRING,dup_string(unparse_boolexp_lock(DBFETCH(obj)->key)));
}

PRIM(unparse_lock)
{
 struct inst *v;
 dbref obj;

 NARGS(1);
 v = TOS(0);
 if (! valid_object(v)) ABORT_INTERP("Non-object argument.");
 obj = v->data.objref;
 POP(1);
 MPUSH(PROG_STRING,dup_string(unparse_boolexp(UID,DBFETCH(obj)->key)));
}

PRIM(unparse_flags)
{
 struct inst *v;
 dbref obj;

 NARGS(1);
 v = TOS(0);
 if (! valid_object(v)) ABORT_INTERP("Non-object argument.");
 obj = v->data.objref;
 POP(1);
 MPUSH(PROG_STRING,dup_string(flag_description(obj)));
}

PRIM(unparse_object)
{
 struct inst *vobj;
 struct inst *vas;
 dbref obj;
 dbref as;

 NARGS(2);
 vas = TOS(0);
 vobj = TOS(1);
 if (! valid_object(vobj)) ABORT_INTERP("Non-object argument. (1)");
 if (! valid_object(vas)) ABORT_INTERP("Non-object argument. (2)");
 obj = vobj->data.objref;
 as = vas->data.objref;
 if (Typeof(as) != TYPE_PLAYER) ABORT_INTERP("Non-player argument. (2)");
 POP(2);
 MPUSH(PROG_STRING,dup_string(unparse_object(as,obj)));
}

PRIM(re_compile)
{
 struct inst *vstr;
 regexp *re;
 struct cre *cre;
 const char *err;
 static char *errmsg = 0;

 NARGS(1);
 vstr = TOS(0);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument.");
 re = m_regcomp(DoNullInd(vstr->data.string));
 if (re == 0)
  { err = m_regerror();
    free(errmsg);
    errmsg = malloc(19+strlen(err)+1);
    sprintf(errmsg,"RE compile failed: %s",err);
    ABORT_INTERP(errmsg);
  }
 cre = malloc(sizeof(struct cre));
 cre->refcnt = 1;
 cre->re = re;
 POP(1);
 MPUSH(PROG_RE,cre);
}

PRIM(re_match)
{
 struct inst *vre;
 struct inst *vstr;
 regexp *re;
 const char *err;
 static char *errmsg = 0;
 char *str;
 int i;

 NARGS(2);
 vstr = TOS(0);
 vre = TOS(1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument (1).");
 if (vre->type != PROG_RE) ABORT_INTERP("Non-regexp argument (2).");
 regerror(0);
 re = vre->data.re->re;
 str = vstr->data.string;
 if (regexec(re,DoNullInd(str)))
  { struct inst rehold;
    vstr->data.string = 0;
    copyinst(vre,&rehold);
    STACKROOM(re->nsubexp-2);
    POP(2);
    for (i=re->nsubexp-1;i>=0;i--)
     { if (re->startp[i])
	{ int l;
	  l = re->endp[i] - re->startp[i];
	  if (l == 0)
	   { MPUSH(PROG_STRING,0);
	   }
	  else
	   { char *t;
	     t = malloc(l+1);
	     bcopy(re->startp[i],t,l);
	     t[l] = '\0';
	     MPUSH(PROG_STRING,t);
	   }
	}
       else
	{ MPUSH(PROG_INTEGER,0);
	}
     }
    MPUSH(PROG_INTEGER,re->nsubexp);
    interp_clear(&rehold);
    free(str);
  }
 else
  { err = m_regerror();
    if (err)
     { free(errmsg);
       errmsg = malloc(16+strlen(err)+1);
       sprintf(errmsg,"RE match error: %s",err);
       ABORT_INTERP(errmsg);
     }
    POP(2);
    MPUSH(PROG_INTEGER,0);
  }
}

PRIM(re_subst)
{
 int n;
 struct inst *vstr;
 struct inst *v;
 int l;
 const unsigned char *cp;
 int pass;
 int state;
#define S_PLAIN 1
#define S_QUOTE 2
#define S_PAREN 3
 int sx;
 int sxn;
 unsigned char *rv;
 unsigned char *rvp;

 NARGS(2);
 vstr = TOS(0);
 v = TOS(1);
 if (vstr->type != PROG_STRING) ABORT_INTERP("Non-string argument.");
 if (v->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument.");
 n = v->data.number;
 if (n < 0) ABORT_INTERP("Invalid string count.");
 if (vstr->data.string == 0) return;
 for (pass=0;pass<2;pass++)
  { switch (pass)
     { case 0:
	  l = 0;
	  rvp = 0;
	  break;
       case 1:
	  if (l == 0)
	   { POP(1);
	     MPUSH(PROG_STRING,0);
	     return;
	   }
	  rv = malloc(l+1);
	  rvp = rv;
	  break;
     }
#define CHAR(c) do { switch (pass) { case 0: l ++; break; case 1: *rvp++ = (c); break; } } while (0)
#define DIGITS '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9'
    sx = -1;
    state = S_PLAIN;
    for (cp=(const void *)vstr->data.string;*cp;cp++)
     { switch (state)
	{ case S_PLAIN:
	     switch (*cp)
	      { case '\\': state = S_QUOTE; break;
		default: CHAR(*cp); break;
	      }
	     break;
	  case S_QUOTE:
	     switch (*cp)
	      { case DIGITS: sx = *cp - '0'; state = S_PLAIN; break;
		case '\\': case '&': CHAR(*cp); state = S_PLAIN; break;
		case '(': sxn = 0; state = S_PAREN; break;
		default: CHAR('\\'); CHAR(*cp); state = S_PLAIN; break;
	      }
	     break;
	  case S_PAREN:
	     switch (*cp)
	      { case DIGITS: sxn = (sxn * 10) + (*cp - '0'); break;
		case ')': sx = sxn; state = S_PLAIN; break;
		default: ABORT_INTERP("Non-digit inside \\(...).");
	      }
	     break;
	}
       if (sx >= 0)
	{ if (sx >= n) ABORT_INTERP("Substitution number out of range.");
	  switch (pass)
	   { case 0:
		v = TOS(sx+2);
		if (v->type != PROG_STRING) ABORT_INTERP("Substituting non-string.");
		if (v->data.string) l += strlen(v->data.string);
		break;
	     case 1:
		v = TOS(sx+2);
		if (v->data.string)
		 { /* void * casts shouldn't be necessary, razz'n frazz'n
		      blink'n twink'n old busted compilers... */
		   strcpy((void *)rvp,v->data.string);
		   rvp += strlen((void *)rvp);
		 }
		break;
	   }
	  sx = -1;
	}
     }
    switch (state)
     { case S_PLAIN:
	  break;
       case S_QUOTE:
	  ABORT_INTERP("Unexpected end-of-string after \\");
	  break;
       case S_PAREN:
	  ABORT_INTERP("\\( without a closing )");
	  break;
     }
#undef CHAR
#undef DIGITS
  }
#undef S_PLAIN
#undef S_QUOTE
#undef S_PAREN
 *rvp = '\0';
 POP(1);
 MPUSH(PROG_STRING,rv);
}

#define FOO(name,nils2val) \
PRIM(name) { struct inst *vs1; struct inst *vs2; char *s1; char *s2;	\
	int n; NARGS(2); vs2 = TOS(0); vs1 = TOS(1);			\
	if ((vs1->type != PROG_STRING) || (vs2->type != PROG_STRING))	\
	{ ABORT_INTERP("Non-string argument."); }			\
	s1 = vs1->data.string; s2 = vs2->data.string; if (! s1) n = 0;	\
	else if (! s2) n = nils2val; else n = name(s1,s2);		\
	vs1->data.string = 0; POP(2); if (n == 0) {			\
	MPUSH(PROG_STRING,0); MPUSH(PROG_STRING,s1); } else if (s1[n])	\
	{ s2 = dup_string(s1+n); s1[n] = '\0'; MPUSH(PROG_STRING,s1);	\
	MPUSH(PROG_STRING,s2); } else { MPUSH(PROG_STRING,s1);		\
	MPUSH(PROG_STRING,0); } }

FOO(strspn,0)
FOO(strcspn,strlen(s1))

#undef FOO