File contents

/* xlmath - xlisp builtin arithmetic functions */

#include "xlisp.h"

/* external variables */
extern struct node *xlstack;

/* external procedures */
extern struct node *xlarg();
extern struct node *xlevarg();
extern struct node *xlmatch();
extern struct node *xlevmatch();

/* local variables */
static struct node *true;

/* forward declarations (the extern hack is for decusc) */
extern struct node *arith();
extern struct node *compare();

/* add - builtin function for addition */
static struct node *xadd(val,arg)
  int val,arg;
{
    return (val + arg);
}
static struct node *add(args)
  struct node *args;
{
    return (arith(args,xadd));
}

/* sub - builtin function for subtraction */
static struct node *xsub(val,arg)
  int val,arg;
{
    return (val - arg);
}
static struct node *sub(args)
  struct node *args;
{
    return (arith(args,xsub));
}

/* mul - builtin function for multiplication */
static struct node *xmul(val,arg)
  int val,arg;
{
    return (val * arg);
}
static struct node *mul(args)
  struct node *args;
{
    return (arith(args,xmul));
}

/* div - builtin function for division */
static struct node *xdiv(val,arg)
  int val,arg;
{
    return (val / arg);
}
static struct node *div(args)
  struct node *args;
{
    return (arith(args,xdiv));
}

/* mod - builtin function for modulus */
static struct node *xmod(val,arg)
  int val,arg;
{
    return (val % arg);
}
static struct node *mod(args)
  struct node *args;
{
    return (arith(args,xmod));
}

/* and - builtin function for modulus */
static struct node *xand(val,arg)
  int val,arg;
{
    return (val & arg);
}
static struct node *and(args)
  struct node *args;
{
    return (arith(args,xand));
}

/* or - builtin function for modulus */
static struct node *xor(val,arg)
  int val,arg;
{
    return (val | arg);
}
static struct node *or(args)
  struct node *args;
{
    return (arith(args,xor));
}

/* not - bitwise not */
static struct node *not(args)
  struct node *args;
{
    struct node *oldstk,val,*rval;

    /* create a new stack frame */
    oldstk = xlsave(&val,NULL);

    /* evaluate the argument */
    val.n_ptr = xlevarg(&args);

    /* make sure there aren't any more arguments */
    if (args != NULL)
	xlfail("too many arguments");

    /* convert and check the value  */
    rval = newnode(INT);
    rval->n_int = ~cnvnum(val.n_ptr);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result value */
    return (rval);
}

/* min - builtin function for minimum */
static struct node *xmin(val,arg)
  int val,arg;
{
    return (val < arg ? val : arg);
}
static struct node *min(args)
  struct node *args;
{
    return (arith(args,xmin));
}

/* max - builtin function for maximum */
static struct node *xmax(val,arg)
  int val,arg;
{
    return (val > arg ? val : arg);
}
static struct node *max(args)
  struct node *args;
{
    return (arith(args,xmax));
}

/* arith - common arithmetic function */
static struct node *arith(args,funct)
  struct node *args; int (*funct)();
{
    struct node *oldstk,arg,*val;
    int first,ival,iarg;

    /* create a new stack frame */
    oldstk = xlsave(&arg,NULL);

    /* initialize */
    arg.n_ptr = args;
    first = TRUE;
    ival = 0;

    /* evaluate and sum each argument */
    while (arg.n_ptr != NULL) {

	/* get the next argument */
	iarg = cnvnum(xlevarg(&arg.n_ptr));

	/* accumulate the result value */
	if (first) {
	    ival = iarg;
	    first = FALSE;
	}
	else
	    ival = (*funct)(ival,iarg);
    }

    /* initialize value */
    val = newnode(INT);
    val->n_int = ival;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result value */
    return (val);
}

/* land - logical and */
static struct node *land(args)
  struct node *args;
{
    struct node *oldstk,arg,*val;

    /* create a new stack frame */
    oldstk = xlsave(&arg,NULL);

    /* initialize */
    arg.n_ptr = args;
    val = true;

    /* evaluate each argument */
    while (arg.n_ptr != NULL)

	/* get the next argument */
	if (cnvnum(xlevarg(&arg.n_ptr)) == 0) {
	    val = NULL;
	    break;
	}

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result value */
    return (val);
}

/* lor - logical or */
static struct node *lor(args)
  struct node *args;
{
    struct node *oldstk,arg,*val;

    /* create a new stack frame */
    oldstk = xlsave(&arg,NULL);

    /* initialize */
    arg.n_ptr = args;
    val = NULL;

    /* evaluate each argument */
    while (arg.n_ptr != NULL)
	if (cnvnum(xlevarg(&arg.n_ptr)) != 0) {
	    val = true;
	    break;
	}

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the result value */
    return (val);
}

/* lnot - logical not */
static struct node *lnot(args)
  struct node *args;
{
    struct node *val;

    /* evaluate the argument */
    val = xlevarg(&args);

    /* make sure there aren't any more arguments */
    if (args != NULL)
	xlfail("too many arguments");

    /* convert and check the value  */
    if (cnvnum(val) != 0)
	return (NULL);
    else
	return (true);
}

/* lss - builtin function for < */
static struct node *xlss(cmp)
  int cmp;
{
    return (cmp < 0);
}
static struct node *lss(args)
  struct node *args;
{
    return (compare(args,xlss));
}

/* leq - builtin function for <= */
static struct node *xleq(cmp)
  int cmp;
{
    return (cmp <= 0);
}
static struct node *leq(args)
  struct node *args;
{
    return (compare(args,xleq));
}

/* eql - builtin function for == */
static struct node *xeql(cmp)
  int cmp;
{
    return (cmp == 0);
}
static struct node *eql(args)
  struct node *args;
{
    return (compare(args,xeql));
}

/* neq - builtin function for != */
static struct node *xneq(cmp)
  int cmp;
{
    return (cmp != 0);
}
static struct node *neq(args)
  struct node *args;
{
    return (compare(args,xneq));
}

/* geq - builtin function for >= */
static struct node *xgeq(cmp)
  int cmp;
{
    return (cmp >= 0);
}
static struct node *geq(args)
  struct node *args;
{
    return (compare(args,xgeq));
}

/* gtr - builtin function for > */
static struct node *xgtr(cmp)
  int cmp;
{
    return (cmp > 0);
}
static struct node *gtr(args)
  struct node *args;
{
    return (compare(args,xgtr));
}

/* compare - common compare function */
static struct node *compare(args,funct)
  struct node *args; int (*funct)();
{
    struct node *oldstk,arg,arg1,arg2;
    int type1,type2,cmp;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&arg1,&arg2,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get argument 1 */
    arg1.n_ptr = xlevarg(&arg.n_ptr);
    type1 = gettype(arg1.n_ptr);

    /* get argument 2 */
    arg2.n_ptr = xlevarg(&arg.n_ptr);
    type2 = gettype(arg2.n_ptr);

    /* make sure there aren't any more arguments */
    if (arg.n_ptr != NULL)
	xlfail("too many arguments");

    /* do the compare */
    if (type1 == STR && type2 == STR)
	cmp = strcmp(arg1.n_ptr->n_str,arg2.n_ptr->n_str);
    else if (type1 == INT || type2 == INT)
	cmp = cnvnum(arg1.n_ptr) - cnvnum(arg2.n_ptr);
    else
	cmp = arg1.n_ptr - arg2.n_ptr;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return result of the compare */
    if ((*funct)(cmp))
	return (true);
    else
	return (NULL);
}

/* gettype - return the type of an argument */
static int gettype(arg)
  struct node *arg;
{
    if (arg == NULL)
	return (LIST);
    else
	return (arg->n_type);
}

/* cnvnum - convert a numeric value */
static int cnvnum(arg)
  struct node *arg;
{
    int ival;

    /* return false if node is null */
    if (arg == NULL)
	return (FALSE);

    /* convert the value if necessary */
    switch (arg->n_type) {
    case INT:
	    ival = arg->n_int;
	    break;
    case STR:
	    if (sscanf(arg->n_str,"%d",&ival) != 1)
		ival = 0;
	    break;
    default:
	    ival = TRUE;
	    break;
    }

    /* return the integer value */
    return (ival);
}

/* xlminit - xlisp math initialization routine */
xlminit()
{
    xlsubr("+",add);
    xlsubr("-",sub);
    xlsubr("*",mul);
    xlsubr("/",div);
    xlsubr("%",mod);
    xlsubr("&",and);
    xlsubr("|",or);
    xlsubr("~",not);
    xlsubr("<",lss);
    xlsubr("<=",leq);
    xlsubr("==",eql);
    xlsubr("!=",neq);
    xlsubr(">=",geq);
    xlsubr(">",gtr);
    xlsubr("&&",land);
    xlsubr("||",lor);
    xlsubr("!",lnot);
    xlsubr("min",min);
    xlsubr("max",max);
    true = xlenter("t");
    true->n_symvalue = true;
}