/* 
 * vcomp.c : compile vars and the like
 */
 
/* Copyright 1990, 1991, 1992 Craig Durland
 *   Distributed under the terms of the GNU General Public License.
 *   Distributed "as is", without warranties of any kind, but comments,
 *     suggestions and bug reports are welcome.
 */

#include <stdio.h>
#include <os.h>
#include "mc.h"
#include "opcode.h"
#include "mm.h"

extern char ebuf[], token[], temp[], *spoof(), *typename();
extern int btv, xtn, msize, omsize;
extern unsigned int class, vtype(), vctype(), mmtype();
extern int32 atoN();
extern MuttCmd muttcmds[];
extern VBlob *get_blob(), *proto_name();
extern MMDatum *getconst();

	/* process a function pointer: foo (foo) (foo args) */
static void fcnptr(eval)
{
  if (eval)	/* (foo) or (foo args) */
	{ genop(PUSHRV); vargs(); genop(DOOP); class = UNKNOWN; }
  else class = FCNPTR;
}

	/* process a var pointer: (ptr) (ptr val) */
void evalvp(arg,offset,scope,type)
{
  int t = (type & ~POINTER), mt = mmtype(type);

  gonumx((int32)0); genop(SHOVERV);
  if (arg) { gonumx((int32)offset); genop(ARG); }
  else
  {
    genop(SHOVERV);
    gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
    gonum8(GETRVAR,BLOB);
  }
  lookahead(); 
  if (class == DELIMITER && *token == ')') gonum8(GETRVAR,t);	/* (ptr) */
  else	/* (ptr val) */
  {
    genop(SHOVERV); compile(); type_check(mt,0);
    gonum8(SETRVAR,t);
  }
  class = mt;
}

	/* gen code for getting a local or global var */
void genvar(name,eval) char *name;
{
  int t, scope, offset;
  unsigned int type;
  VBlob *blob;
  MMDatum *rv;

  if ((blob = proto_name(name)))		/* its a proto */
  {
    type = blob->type;
    if (eval && (type & POINTER)) evalvp(TRUE,blob->offset,0,type);
    else
    {
      gonumx((int32)blob->offset); genop(ARG);
      if (type == FCNPTR) fcnptr(eval);
      else
	if (blob->dims) class = BLOB; else class = type;
    }
    return;
  }

  if ((t = getvar(name)) != -1)		/* its a var */
  {
    type = vtype(t); offset = voffset(t); scope = vscope(t);
    if (eval && (type & POINTER)) evalvp(FALSE,offset,scope,type);
    else
    {
      if (type == ARRAY || type == BLOB)
	gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
      else
	go2num((scope == LOCAL ? GETLVAR : GETGVAR),
		(type & POINTER) ? BLOB : type, offset);
      if (type == FCNPTR) fcnptr(eval);
      else class = type;
    }
    return;
  }

  if (!eval && (rv = getconst(name)))	/* (const) is illegal */
  {
    switch (class = rv->type)
    {
      case STRING:  gostr(RVSTR,rv->val.str);	break;
      case NUMBER:  gonumx(rv->val.num);	break;
      case BOOLEAN: gonum8(RVBOOL,rv->val.num); break;
    }
    return;
  }

  bitch(spoof(ebuf,"%s is not a var.",name));
}

varcompile(eval)	/* handle (var [value]) */
{
  int j,t,m,n,x,z, arg = FALSE, compiled = FALSE, tsize, scope, offset, *dim;
  unsigned int type;
  VBlob *blob;
  MMDatum *rv;

  z = UNKNOWN;
  if (blob = proto_name(token))		/* a prototype */
  {
    arg = TRUE; offset = blob->offset;
    type = blob->type; if (blob->dims) z = ARRAY;
  }
  else
    if ((t = getvar(token)) != -1)	/* a local or global var */
    {
      scope = vscope(t); offset = voffset(t); type = z = vtype(t);
      if (type == ARRAY) { blob = get_blob(t); }
    }
    else		/* maybe a const */
      if (!eval && getconst(token)) { genvar(token,eval); return TRUE; }
      else return FALSE;

  if (type == FCNPTR) { genvar(token,eval); return TRUE; }
  if (z == ARRAY)
  {
    z = 0; type = blob->type; tsize = typesize(type);
    dim = blob->dim; n = blob->dims; m = n -1; if (type == STRING) n--;
    for (j = 0; j < n; j++)	/* suck up subscripts */
    {
      lookahead();
	/* check to see if next thing is a constant */
      if (class == TOKEN && (rv = getconst(token)) && rv->type == NUMBER &&
	  proto_name(token) == NULL && getvar(token) == -1)
	{ x = rv->val.num; goto num; }

      if (class == DELIMITER || class == TOKEN)
      {
	if (class == DELIMITER && *token == ')')
	  if (j == 0)			/* (var) */
	  {
	    class = BLOB;
	    if (arg) { gonumx((int32)offset); genop(ARG); }
	    else gonum16((scope == LOCAL ? RVLBASE : RVGBASE),offset);
	    return TRUE;
	  }
	  else { moan(spoof(ebuf,"Need %d subscript(s).",n)); break; }
	if (compiled) genop(SHOVERV);
	compile(); type_check(NUMBER,0);
	if (j < m) { genop(SHOVERV); gonumx((int32)dim[j+1]); genop(MUL); }
	if (compiled) genop(ADD);
	compiled = TRUE;
      }
      else
        if (class == NUMBER)
	{
	  x = atoi(token);
	num:
	  get_token();
	  if (x < 0 || x >= dim[j])
		{ x = 0; moan(spoof(ebuf,"Subscript out of bounds.")); }
	  if (j < m) x *= dim[j+1];
	  z += x;
	}
	else bitch(spoof(ebuf,"%s is not an array subscript.",token));
    }
    z = z*tsize + (arg ? 0 : offset);	/* offset from base address */

	/* now check to see if it is assignment or eval */
    lookahead(); 
		/* TRUE => eval */
    x = (class == DELIMITER && *token == ')') ? TRUE : FALSE;

    if (arg)
    {
      if (!compiled) gonumx((int32)z);
      else
      {
        genop(SHOVERV); gonumx((int32)tsize); genop(MUL);
	if (z) { genop(SHOVERV); gonumx((int32)z); genop(ADD); }
      }
      genop(SHOVERV);
      gonumx((int32)offset); genop(ARG);
      if (x) gonum8(GETRVAR,type);
      else
      {
        genop(SHOVERV); compile(); type_check(type,0);
	gonum8(SETRVAR,type);
      }
    }
    else
    {
      if (!compiled)
      {
	if (x) go2num((scope == LOCAL ? GETLVAR : GETGVAR),type,z);
	else
	{
	  compile(); type_check(type,0);
	  go2num((scope == LOCAL ? SETLVAR : SETGVAR), type,z);
	}
      }
      else
      {
	genop(SHOVERV); gonumx((int32)tsize); genop(MUL);
	genop(SHOVERV); gonum16((scope == LOCAL ? RVLBASE : RVGBASE),z);
	if (x) gonum8(GETRVAR,type);
	else
	{
	  genop(SHOVERV);
	  compile(); type_check(type,0);
	  gonum8(SETRVAR,type);
	}
      }
    }
    class = type;
    return TRUE;	/* done with arrays */
  }
	/* its a var */
  strcpy(temp,token); lookahead();
  if (class == DELIMITER && *token == ')') genvar(temp,eval);
  else			/* var assignment */
  {
    if (arg)		/* (foo "hoho") where foo is (arg n) */
      if (type == STRING || type == LIST)
      {
/* !!!??? this may not be right */
		/* get the arg (an object) (I hope) */
	gonumx((int32)offset); genop(ARG); genop(SHOVERV);
	compile(); type_check(type,0);
	gonum8(SETRVAR,type);
      }
      else
      {
	compile();
/* !!! tell what the type is */
	moan(spoof(ebuf,"Can't change stack vars of that type (%s).",temp));
      }
    else
    {
      compile(); type_check(type,0);
      go2num((scope == LOCAL ? SETLVAR : SETGVAR),
	(type & POINTER) ? BLOB : type, offset);
    }
  }
  return TRUE;
}

isvarok(clevel,class)
{
  if (!(clevel == 0 || class == VAROK))
	{ moan("Can't create vars here."); return FALSE; }
  return TRUE;
}

void vdeclare(type,local)
{
  int x, total_bytes;

  x = typesize(type);
  total_bytes = 0;
  do
  {
    get_token();
    if (class != TOKEN) bitch(spoof(ebuf,"%s is not a var name.",token));
    addvar(token, type, x, (local ? LOCAL : GLOBAL));
    total_bytes += x;
    lookahead();
  } while (class == TOKEN);
  if (local) gonum16(LALLOC, total_bytes);
}

void pointer(local)		/* (pointer type name ...) */
{
  int t = -1;

  get_token();
  if (class == TOKEN) t = lookup(token,muttcmds,msize);
  switch (t)
  {
    case 62: vdeclare(POINTER | BOOLEAN,local); break;
    case 61: vdeclare(POINTER | INT16,	local); break;
    case 75: vdeclare(POINTER | INT8,	local); break;
    case 31: vdeclare(POINTER | INT32,	local); break;
    case 60: vdeclare(POINTER | STRING,	local); break;
    default:
      moan(spoof(ebuf,"%s is not a pointer type.",token));
      vdeclare(POINTER | BOOLEAN,local);
  }
}

static getnum(n) int *n;
{
  char *errmsg = "Array dimensions are positive numeric constants.";
  int x;
  MMDatum *rv;

  lookahead();
  if (class==DELIMITER || (class==TOKEN && (rv = getconst(token))==NULL))
	return FALSE;
  get_token();
  if (class==TOKEN) { if (rv->type!=NUMBER) bitch(errmsg); x = rv->val.num; }
  else { if (class!=NUMBER) bitch(errmsg); x = atoN(token); }
  if (x<=0) { moan(errmsg); x = 1; }
  *n = x;
  return TRUE;
}

int ntharg;	/* arg & proto count for defun */

void array(scope,arg)			/* (array type name subs) */
{
  int t,size,x, n, dim[MAXDIM],z, tsize;
  unsigned int type;

  size = 0;
  get_token();
  if (class == TOKEN) t = lookup(token,muttcmds,msize);
  else bitch(spoof(ebuf,"%s is not an array type.",token));
  switch(t)
  {
    default:
      moan(spoof(ebuf,"%s is not an array type.",token));
      type = BOOLEAN; goto defvar;
    case 62:		/* (array bool name d1 ...) */
      type = BOOLEAN;
defvar:
      tsize = typesize(type);
      do
      {
	z = 1; n = 0;
	get_token(); strcpy(temp,token);	/* get and save name */
	if (class != TOKEN) bitch(spoof(ebuf,"%s is not a var name.",token));
	while (TRUE)
	{
	  if (!getnum(&x)) break;
	  if (n >= MAXDIM)
	    bitch(spoof(ebuf,"Too many dimensions (max is %d).",MAXDIM)); 
	  z *= (dim[n++] = x);
	}
	if (n == 0) moan("An array needs dimensions.");
	z *= tsize; size += z;
	if (arg) moreproto(temp,ntharg++,type,n,dim);
	else add_array(temp,type,z,scope,n,dim);
	lookahead();
      } while (class == TOKEN);
      if (!arg && scope == LOCAL) gonum16(LALLOC,size);
      break;
    case 75: type = INT8;  goto defvar;		/* (byte var [var ...]) */
    case 61: type = INT16; goto defvar;		/* (int var [var ...]) */
    case 31: type = INT32; goto defvar;		/* (INT var [var ...]) */
    case 60:		/* (array string n) */
      moan("I don't support string arrays (anymore)!");		/* ??? */
#if 0
      size = 0;
      do
      {
	get_token(); strcpy(temp,token);	/* get and save name */
	if (class != TOKEN) bitch(spoof(ebuf,"%s is not a var name.",token));

	t = getnum(&n) && getnum(&x);
	if (!t || x > MAXSTRLEN)
	  bitch(spoof(ebuf,
	    "String length is a postive numeric constant <= %d.",MAXSTRLEN));
	dim[0] = n; dim[1] = x+1;
	z = dim[0]*dim[1]*sizeof(char);
	size += z;
	if (arg) moreproto(temp,ntharg++,STRING,2,dim);
	else add_array(temp,STRING,z,scope,2,dim);
	lookahead();
      } while (class == TOKEN);
/*      if (!arg && scope == LOCAL) gonum16(LALLOC,size);*/
#endif
      break;
  }
}