/*
 * This file is part of DGD, http://dgd-osr.sourceforge.net/
 * Copyright (C) 1993-2010 Dworkin B.V.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Affero General Public License as
 * published by the Free Software Foundation, either version 3 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Affero General Public License for more details.
 *
 * You should have received a copy of the GNU Affero General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 */

# ifndef FUNCDEF
# define INCLUDE_CTYPE
# include "kfun.h"
# include "table.h"

/*
 * NAME:	kfun->argerror()
 * DESCRIPTION:	handle an argument error in a builtin kfun
 */
static void kf_argerror(kfun, n)
int kfun, n;
{
    error("Bad argument %d for kfun %s", n, kftab[kfun].name);
}

/*
 * NAME:	kfun->itoa()
 * DESCRIPTION:	convert an Int to a string
 */
static char *kf_itoa(i, buffer)
Int i;
char *buffer;
{
    register Uint u;
    register char *p;

    u = (i >= 0) ? i : -i;

    p = buffer + 11;
    *p = '\0';
    do {
	*--p = '0' + u % 10;
	u /= 10;
    } while (u != 0);
    if (i < 0) {
	*--p = '-';
    }

    return p;
}
# endif


# ifdef FUNCDEF
FUNCDEF("+", kf_add, pt_add, 0)
# else
char pt_add[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->add()
 * DESCRIPTION:	value + value
 */
int kf_add(f)
register frame *f;
{
    register string *str;
    register array *a;
    char *num, buffer[18];
    xfloat f1, f2;
    long l;

    switch (f->sp[1].type) {
    case T_INT:
	switch (f->sp->type) {
	case T_INT:
	    PUT_INT(&f->sp[1], f->sp[1].u.number + f->sp->u.number);
	    f->sp++;
	    return 0;

	case T_STRING:
	    i_add_ticks(f, 2);
	    num = kf_itoa(f->sp[1].u.number, buffer);
	    str = str_new((char *) NULL,
			  (l=(long) strlen(num)) + f->sp->u.string->len);
	    strcpy(str->text, num);
	    memcpy(str->text + l, f->sp->u.string->text, f->sp->u.string->len);
	    str_del(f->sp->u.string);
	    f->sp++;
	    PUT_STRVAL(f->sp, str);
	    return 0;
	}
	break;

    case T_FLOAT:
	i_add_ticks(f, 1);
	switch (f->sp->type) {
	case T_FLOAT:
	    GET_FLT(f->sp, f2);
	    f->sp++;
	    GET_FLT(f->sp, f1);
	    flt_add(&f1, &f2);
	    PUT_FLT(f->sp, f1);
	    return 0;

	case T_STRING:
	    i_add_ticks(f, 2);
	    GET_FLT(&f->sp[1], f1);
	    flt_ftoa(&f1, buffer);
	    str = str_new((char *) NULL,
			  (l=(long) strlen(buffer)) + f->sp->u.string->len);
	    strcpy(str->text, buffer);
	    memcpy(str->text + l, f->sp->u.string->text, f->sp->u.string->len);
	    str_del(f->sp->u.string);
	    f->sp++;
	    PUT_STRVAL(f->sp, str);
	    return 0;
	}
	break;

    case T_STRING:
	i_add_ticks(f, 2);
	switch (f->sp->type) {
	case T_INT:
	    num = kf_itoa(f->sp->u.number, buffer);
	    f->sp++;
	    str = str_new((char *) NULL,
			  f->sp->u.string->len + (long) strlen(num));
	    memcpy(str->text, f->sp->u.string->text, f->sp->u.string->len);
	    strcpy(str->text + f->sp->u.string->len, num);
	    str_del(f->sp->u.string);
	    PUT_STR(f->sp, str);
	    return 0;

	case T_FLOAT:
	    i_add_ticks(f, 1);
	    GET_FLT(f->sp, f2);
	    flt_ftoa(&f2, buffer);
	    f->sp++;
	    str = str_new((char *) NULL,
			  f->sp->u.string->len + (long) strlen(buffer));
	    memcpy(str->text, f->sp->u.string->text, f->sp->u.string->len);
	    strcpy(str->text + f->sp->u.string->len, buffer);
	    str_del(f->sp->u.string);
	    PUT_STR(f->sp, str);
	    return 0;

	case T_STRING:
	    str = str_add(f->sp[1].u.string, f->sp->u.string);
	    str_del(f->sp->u.string);
	    f->sp++;
	    str_del(f->sp->u.string);
	    PUT_STR(f->sp, str);
	    return 0;
	}
	break;

    case T_ARRAY:
	if (f->sp->type == T_ARRAY) {
	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = arr_add(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_ARR(f->sp, a);
	    return 0;
	}
	break;

    case T_MAPPING:
	if (f->sp->type == T_MAPPING) {
	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = map_add(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_MAP(f->sp, a);
	    return 0;
	}
	break;

    default:
	kf_argerror(KF_ADD, 1);
    }

    kf_argerror(KF_ADD, 2);
}
# endif


# ifdef FUNCDEF
FUNCDEF("+", kf_add_int, pt_add_int, 0)
# else
char pt_add_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->add_int()
 * DESCRIPTION:	int + int
 */
int kf_add_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], f->sp[1].u.number + f->sp->u.number);
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("++", kf_add1, pt_add1, 0)
# else
char pt_add1[] = { C_STATIC, 1, 0, 0, 7, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->add1()
 * DESCRIPTION:	value++
 */
int kf_add1(f)
register frame *f;
{
    xfloat f1, f2;

    if (f->sp->type == T_INT) {
	PUT_INT(f->sp, f->sp->u.number + 1);
    } else if (f->sp->type == T_FLOAT) {
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f1);
	FLT_ONE(f2.high, f2.low);
	flt_add(&f1, &f2);
	PUT_FLT(f->sp, f1);
    } else {
	kf_argerror(KF_ADD1, 1);
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("++", kf_add1_int, pt_add1_int, 0)
# else
char pt_add1_int[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_INT };

/*
 * NAME:	kfun->add1_int()
 * DESCRIPTION:	int++
 */
int kf_add1_int(f)
frame *f;
{
    PUT_INT(f->sp, f->sp->u.number + 1);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("&", kf_and, pt_and, 0)
# else
char pt_and[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->and()
 * DESCRIPTION:	value & value
 */
int kf_and(f)
register frame *f;
{
    array *a;

    switch (f->sp[1].type) {
    case T_INT:
	if (f->sp->type == T_INT) {
	    PUT_INT(&f->sp[1], f->sp[1].u.number & f->sp->u.number);
	    f->sp++;
	    return 0;
	}
	break;

    case T_ARRAY:
	if (f->sp->type == T_ARRAY) {
	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = arr_intersect(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_ARR(f->sp, a);
	    return 0;
	}
	break;

    case T_MAPPING:
	if (f->sp->type == T_ARRAY) {
	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = map_intersect(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    PUT_MAP(f->sp, a);
	    return 0;
	}
	break;

    default:
	kf_argerror(KF_AND, 1);
    }

    kf_argerror(KF_AND, 2);
}
# endif


# ifdef FUNCDEF
FUNCDEF("&", kf_and_int, pt_and_int, 0)
# else
char pt_and_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->and_int()
 * DESCRIPTION:	int & int
 */
int kf_and_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], f->sp[1].u.number & f->sp->u.number);
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("/", kf_div, pt_div, 0)
# else
char pt_div[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->div()
 * DESCRIPTION:	mixed / mixed
 */
int kf_div(f)
register frame *f;
{
    register Int i, d;
    xfloat f1, f2;

    if (f->sp[1].type != f->sp->type) {
	kf_argerror(KF_DIV, 2);
    }
    switch (f->sp->type) {
    case T_INT:
	i = f->sp[1].u.number;
	d = f->sp->u.number;
	if (d == 0) {
	    error("Division by zero");
	}
	if ((i | d) < 0) {
	    Int r;

	    r = ((Uint) ((i < 0) ? -i : i)) / ((Uint) ((d < 0) ? -d : d));
	    PUT_INT(&f->sp[1], ((i ^ d) < 0) ? -r : r);
	} else {
	    PUT_INT(&f->sp[1], ((Uint) i) / ((Uint) d));
	}
	f->sp++;
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	flt_div(&f1, &f2);
	PUT_FLT(f->sp, f1);
	return 0;

    default:
	kf_argerror(KF_DIV, 1);
    }
}
# endif


# ifdef FUNCDEF
FUNCDEF("/", kf_div_int, pt_div_int, 0)
# else
char pt_div_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->div()
 * DESCRIPTION:	int / int
 */
int kf_div_int(f)
register frame *f;
{
    register Int i, d;

    i = f->sp[1].u.number;
    d = f->sp->u.number;
    if (d == 0) {
	error("Division by zero");
    }
    if ((i | d) < 0) {
	Int r;

	r = ((Uint) ((i < 0) ? -i : i)) / ((Uint) ((d < 0) ? -d : d));
	PUT_INT(&f->sp[1], ((i ^ d) < 0) ? -r : r);
    } else {
	PUT_INT(&f->sp[1], ((Uint) i) / ((Uint) d));
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("==", kf_eq, pt_eq, 0)
# else
char pt_eq[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->eq()
 * DESCRIPTION:	value == value
 */
int kf_eq(f)
register frame *f;
{
    register bool flag;
    xfloat f1, f2;

    if (f->sp[1].type != f->sp->type) {
	i_pop(f, 2);
	PUSH_INTVAL(f, FALSE);
	return 0;
    }

    switch (f->sp->type) {
    case T_NIL:
	f->sp++;
	PUT_INTVAL(f->sp, TRUE);
	break;

    case T_INT:
	PUT_INT(&f->sp[1], (f->sp[1].u.number == f->sp->u.number));
	f->sp++;
	break;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) == 0));
	break;

    case T_STRING:
	i_add_ticks(f, 2);
	flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) == 0);
	str_del(f->sp->u.string);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, flag);
	break;

    case T_OBJECT:
	PUT_INTVAL(&f->sp[1], (f->sp[1].oindex == f->sp->oindex));
	f->sp++;
	break;

    case T_ARRAY:
    case T_MAPPING:
    case T_LWOBJECT:
	flag = (f->sp[1].u.array == f->sp->u.array);
	arr_del(f->sp->u.array);
	f->sp++;
	arr_del(f->sp->u.array);
	PUT_INTVAL(f->sp, flag);
	break;
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("==", kf_eq_int, pt_eq_int, 0)
# else
char pt_eq_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->eq_int()
 * DESCRIPTION:	int == int
 */
int kf_eq_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], (f->sp[1].u.number == f->sp->u.number));
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF(">=", kf_ge, pt_ge, 0)
# else
char pt_ge[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->ge()
 * DESCRIPTION:	value >= value
 */
int kf_ge(f)
register frame *f;
{
    xfloat f1, f2;
    bool flag;

    if (f->sp[1].type != f->sp->type) {
	kf_argerror(KF_GE, 2);
    }
    switch (f->sp->type) {
    case T_INT:
	PUT_INT(&f->sp[1], (f->sp[1].u.number >= f->sp->u.number));
	f->sp++;
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) >= 0));
	return 0;

    case T_STRING:
	i_add_ticks(f, 2);
	flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) >= 0);
	str_del(f->sp->u.string);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, flag);
	return 0;

    default:
	kf_argerror(KF_GE, 1);
    }
}
# endif


# ifdef FUNCDEF
FUNCDEF(">=", kf_ge_int, pt_ge_int, 0)
# else
char pt_ge_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->ge_int()
 * DESCRIPTION:	int >= int
 */
int kf_ge_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], (f->sp[1].u.number >= f->sp->u.number));
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF(">", kf_gt, pt_gt, 0)
# else
char pt_gt[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->gt()
 * DESCRIPTION:	value > value
 */
int kf_gt(f)
register frame *f;
{
    xfloat f1, f2;
    bool flag;

    if (f->sp[1].type != f->sp->type) {
	kf_argerror(KF_GT, 2);
    }
    switch (f->sp->type) {
    case T_INT:
	PUT_INT(&f->sp[1], (f->sp[1].u.number > f->sp->u.number));
	f->sp++;
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) > 0));
	return 0;

    case T_STRING:
	i_add_ticks(f, 2);
	flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) > 0);
	str_del(f->sp->u.string);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, flag);
	return 0;

    default:
	kf_argerror(KF_GT, 1);
    }
}
# endif


# ifdef FUNCDEF
FUNCDEF(">", kf_gt_int, pt_gt_int, 0)
# else
char pt_gt_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->gt_int()
 * DESCRIPTION:	int > int
 */
int kf_gt_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], (f->sp[1].u.number > f->sp->u.number));
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("<=", kf_le, pt_le, 0)
# else
char pt_le[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->le()
 * DESCRIPTION:	value <= value
 */
int kf_le(f)
register frame *f;
{
    xfloat f1, f2;
    bool flag;

    if (f->sp[1].type != f->sp->type) {
	kf_argerror(KF_LE, 2);
    }
    switch (f->sp->type) {
    case T_INT:
	PUT_INT(&f->sp[1], (f->sp[1].u.number <= f->sp->u.number));
	f->sp++;
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) <= 0));
	return 0;

    case T_STRING:
	i_add_ticks(f, 2);
	flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) <= 0);
	str_del(f->sp->u.string);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, flag);
	return 0;

    default:
	kf_argerror(KF_LE, 1);
    }
}
# endif


# ifdef FUNCDEF
FUNCDEF("<=", kf_le_int, pt_le_int, 0)
# else
char pt_le_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->le_int()
 * DESCRIPTION:	int <= int
 */
int kf_le_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], (f->sp[1].u.number <= f->sp->u.number));
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("<<", kf_lshift, pt_lshift, 0)
# else
char pt_lshift[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->lshift()
 * DESCRIPTION:	int << int
 */
int kf_lshift(f)
register frame *f;
{
    if (f->sp[1].type != T_INT) {
	kf_argerror(KF_LSHIFT, 1);
    }
    if (f->sp->type != T_INT) {
	kf_argerror(KF_LSHIFT, 2);
    }
    if ((f->sp->u.number & ~31) != 0) {
	if (f->sp->u.number < 0) {
	    error("Negative left shift");
	}
	PUT_INT(&f->sp[1], 0);
    } else {
	PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number << f->sp->u.number);
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("<<", kf_lshift_int, pt_lshift_int, 0)
# else
char pt_lshift_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->lshift_int()
 * DESCRIPTION:	int << int
 */
int kf_lshift_int(f)
register frame *f;
{
    if ((f->sp->u.number & ~31) != 0) {
	if (f->sp->u.number < 0) {
	    error("Negative left shift");
	}
	PUT_INT(&f->sp[1], 0);
    } else {
	PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number << f->sp->u.number);
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("<", kf_lt, pt_lt, 0)
# else
char pt_lt[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->lt()
 * DESCRIPTION:	value < value
 */
int kf_lt(f)
register frame *f;
{
    xfloat f1, f2;
    bool flag;

    if (f->sp[1].type != f->sp->type) {
	kf_argerror(KF_LT, 2);
    }
    switch (f->sp->type) {
    case T_INT:
	PUT_INT(&f->sp[1], (f->sp[1].u.number < f->sp->u.number));
	f->sp++;
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) < 0));
	return 0;

    case T_STRING:
	i_add_ticks(f, 2);
	flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) < 0);
	str_del(f->sp->u.string);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, flag);
	return 0;

    default:
	kf_argerror(KF_LT, 1);
    }
}
# endif


# ifdef FUNCDEF
FUNCDEF("<", kf_lt_int, pt_lt_int, 0)
# else
char pt_lt_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->lt_int()
 * DESCRIPTION:	int < int
 */
int kf_lt_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], (f->sp[1].u.number < f->sp->u.number));
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("%", kf_mod, pt_mod, 0)
# else
char pt_mod[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->mod()
 * DESCRIPTION:	int % int
 */
int kf_mod(f)
register frame *f;
{
    register Int i, d;

    if (f->sp[1].type != T_INT) {
	kf_argerror(KF_MOD, 1);
    }
    if (f->sp->type != T_INT) {
	kf_argerror(KF_MOD, 2);
    }
    i = f->sp[1].u.number;
    d = f->sp->u.number;
    if (d == 0) {
	error("Modulus by zero");
    }
    if (d < 0) {
	d = -d;
    }
    if (i < 0) {
	PUT_INT(&f->sp[1], - (Int) (((Uint) -i) % ((Uint) d)));
    } else {
	PUT_INT(&f->sp[1], ((Uint) i) % ((Uint) d));
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("%", kf_mod_int, pt_mod_int, 0)
# else
char pt_mod_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->mod_int()
 * DESCRIPTION:	int % int
 */
int kf_mod_int(f)
register frame *f;
{
    register Int i, d;

    i = f->sp[1].u.number;
    d = f->sp->u.number;
    if (d == 0) {
	error("Modulus by zero");
    }
    if (d < 0) {
	d = -d;
    }
    if (i < 0) {
	PUT_INT(&f->sp[1], - (Int) (((Uint) -i) % ((Uint) d)));
    } else {
	PUT_INT(&f->sp[1], ((Uint) i) % ((Uint) d));
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("*", kf_mult, pt_mult, 0)
# else
char pt_mult[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->mult()
 * DESCRIPTION:	mixed * mixed
 */
int kf_mult(f)
register frame *f;
{
    xfloat f1, f2;

    if (f->sp[1].type != f->sp->type) {
	kf_argerror(KF_MULT, 2);
    }
    switch (f->sp->type) {
    case T_INT:
	PUT_INT(&f->sp[1], f->sp[1].u.number * f->sp->u.number);
	f->sp++;
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	flt_mult(&f1, &f2);
	PUT_FLT(f->sp, f1);
	return 0;

    default:
	kf_argerror(KF_MULT, 1);
    }
}
# endif


# ifdef FUNCDEF
FUNCDEF("*", kf_mult_int, pt_mult_int, 0)
# else
char pt_mult_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->mult_int()
 * DESCRIPTION:	int * int
 */
int kf_mult_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], f->sp[1].u.number * f->sp->u.number);
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("!=", kf_ne, pt_ne, 0)
# else
char pt_ne[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->ne()
 * DESCRIPTION:	value != value
 */
int kf_ne(f)
register frame *f;
{
    register bool flag;
    xfloat f1, f2;

    if (f->sp[1].type != f->sp->type) {
	i_pop(f, 2);
	PUSH_INTVAL(f, TRUE);
	return 0;
    }

    switch (f->sp->type) {
    case T_NIL:
	f->sp++;
	PUT_INTVAL(f->sp, FALSE);
	break;

    case T_INT:
	PUT_INT(&f->sp[1], (f->sp[1].u.number != f->sp->u.number));
	f->sp++;
	break;

    case T_FLOAT:
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f2);
	f->sp++;
	GET_FLT(f->sp, f1);
	PUT_INTVAL(f->sp, (flt_cmp(&f1, &f2) != 0));
	break;

    case T_STRING:
	i_add_ticks(f, 2);
	flag = (str_cmp(f->sp[1].u.string, f->sp->u.string) != 0);
	str_del(f->sp->u.string);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, flag);
	break;

    case T_OBJECT:
	PUT_INTVAL(&f->sp[1], (f->sp[1].oindex != f->sp->oindex));
	f->sp++;
	break;

    case T_ARRAY:
    case T_MAPPING:
    case T_LWOBJECT:
	flag = (f->sp[1].u.array != f->sp->u.array);
	arr_del(f->sp->u.array);
	f->sp++;
	arr_del(f->sp->u.array);
	PUT_INTVAL(f->sp, flag);
	break;
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("!=", kf_ne_int, pt_ne_int, 0)
# else
char pt_ne_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->ne_int()
 * DESCRIPTION:	int != int
 */
int kf_ne_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], (f->sp[1].u.number != f->sp->u.number));
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("~", kf_neg, pt_neg, 0)
# else
char pt_neg[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_INT };

/*
 * NAME:	kfun->neg()
 * DESCRIPTION:	~ int
 */
int kf_neg(f)
register frame *f;
{
    if (f->sp->type != T_INT) {
	kf_argerror(KF_NEG, 1);
    }
    PUT_INT(f->sp, ~f->sp->u.number);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("~", kf_neg_int, pt_neg_int, 0)
# else
char pt_neg_int[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_INT };

/*
 * NAME:	kfun->neg_int()
 * DESCRIPTION:	~ int
 */
int kf_neg_int(f)
frame *f;
{
    PUT_INT(f->sp, ~f->sp->u.number);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("!", kf_not, pt_not, 0)
# else
char pt_not[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_MIXED };

/*
 * NAME:	kfun->not()
 * DESCRIPTION:	! value
 */
int kf_not(f)
register frame *f;
{
    switch (f->sp->type) {
    case T_NIL:
	PUT_INTVAL(f->sp, TRUE);
	return 0;

    case T_INT:
	PUT_INT(f->sp, !f->sp->u.number);
	return 0;

    case T_FLOAT:
	PUT_INTVAL(f->sp, VFLT_ISZERO(f->sp));
	return 0;

    case T_STRING:
	str_del(f->sp->u.string);
	break;

    case T_ARRAY:
    case T_MAPPING:
    case T_LWOBJECT:
	arr_del(f->sp->u.array);
	break;
    }

    PUT_INTVAL(f->sp, FALSE);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("!", kf_not_int, pt_not, 0)
# else
/*
 * NAME:	kfun->not_int()
 * DESCRIPTION:	! int
 */
int kf_not_int(f)
frame *f;
{
    PUT_INT(f->sp, !f->sp->u.number);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("|", kf_or, pt_or, 0)
# else
char pt_or[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->or()
 * DESCRIPTION:	value | value
 */
int kf_or(f)
register frame *f;
{
    array *a;

    switch (f->sp[1].type) {
    case T_INT:
	if (f->sp->type == T_INT) {
	    PUT_INT(&f->sp[1], f->sp[1].u.number | f->sp->u.number);
	    f->sp++;
	    return 0;
	}
	break;

    case T_ARRAY:
	if (f->sp->type == T_ARRAY) {
	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = arr_setadd(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_ARR(f->sp, a);
	    return 0;
	}
	break;

    default:
	kf_argerror(KF_OR, 1);
    }

    kf_argerror(KF_OR, 2);
}
# endif


# ifdef FUNCDEF
FUNCDEF("|", kf_or_int, pt_or_int, 0)
# else
char pt_or_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->or_int()
 * DESCRIPTION:	int | int
 */
int kf_or_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], f->sp[1].u.number | f->sp->u.number);
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_rangeft, pt_rangeft, 0)
# else
char pt_rangeft[] = { C_STATIC, 3, 0, 0, 9, T_MIXED, T_MIXED, T_MIXED,
		      T_MIXED };
/*
 * NAME:	kfun->rangeft()
 * DESCRIPTION:	value [ int .. int ]
 */
int kf_rangeft(f)
register frame *f;
{
    string *str;
    array *a;

    if (f->sp[2].type == T_MAPPING) {
	a = map_range(f->data, f->sp[2].u.array, &f->sp[1], f->sp);
	i_del_value(f->sp++);
	i_del_value(f->sp++);
	i_add_ticks(f, f->sp->u.array->size);
	arr_del(f->sp->u.array);
	PUT_ARR(f->sp, a);

	return 0;
    }

    if (f->sp[1].type != T_INT) {
	kf_argerror(KF_RANGEFT, 2);
    }
    if (f->sp->type != T_INT) {
	kf_argerror(KF_RANGEFT, 3);
    }
    switch (f->sp[2].type) {
    case T_STRING:
	i_add_ticks(f, 2);
	str = str_range(f->sp[2].u.string, (long) f->sp[1].u.number,
			(long) f->sp->u.number);
	f->sp += 2;
	str_del(f->sp->u.string);
	PUT_STR(f->sp, str);
	break;

    case T_ARRAY:
	a = arr_range(f->data, f->sp[2].u.array, (long) f->sp[1].u.number,
		      (long) f->sp->u.number);
	i_add_ticks(f, a->size);
	f->sp += 2;
	arr_del(f->sp->u.array);
	PUT_ARR(f->sp, a);
	break;

    default:
	kf_argerror(KF_RANGEFT, 1);
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_rangef, pt_rangef, 0)
# else
char pt_rangef[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->rangef()
 * DESCRIPTION:	value [ int .. ]
 */
int kf_rangef(f)
register frame *f;
{
    string *str;
    array *a;

    if (f->sp[1].type == T_MAPPING) {
	a = map_range(f->data, f->sp[1].u.array, f->sp, (value *) NULL);
	i_del_value(f->sp++);
	i_add_ticks(f, f->sp->u.array->size);
	arr_del(f->sp->u.array);
	PUT_MAP(f->sp, a);

	return 0;
    }

    if (f->sp->type != T_INT) {
	kf_argerror(KF_RANGEF, 2);
    }
    switch (f->sp[1].type) {
    case T_STRING:
	i_add_ticks(f, 2);
	str = str_range(f->sp[1].u.string, (long) f->sp->u.number,
			f->sp[1].u.string->len - 1L);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_STR(f->sp, str);
	break;

    case T_ARRAY:
	a = arr_range(f->data, f->sp[1].u.array, (long) f->sp->u.number,
		      f->sp[1].u.array->size - 1L);
	i_add_ticks(f, a->size);
	f->sp++;
	arr_del(f->sp->u.array);
	PUT_ARR(f->sp, a);
	break;

    default:
	kf_argerror(KF_RANGEF, 1);
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_ranget, pt_ranget, 0)
# else
char pt_ranget[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->ranget()
 * DESCRIPTION:	value [ .. int ]
 */
int kf_ranget(f)
register frame *f;
{
    string *str;
    array *a;

    if (f->sp[1].type == T_MAPPING) {
	a = map_range(f->data, f->sp[1].u.array, (value *) NULL, f->sp);
	i_del_value(f->sp++);
	i_add_ticks(f, f->sp->u.array->size);
	arr_del(f->sp->u.array);
	PUT_MAP(f->sp, a);

	return 0;
    }

    if (f->sp->type != T_INT) {
	kf_argerror(KF_RANGET, 2);
    }
    switch (f->sp[1].type) {
    case T_STRING:
	i_add_ticks(f, 2);
	str = str_range(f->sp[1].u.string, 0L, (long) f->sp->u.number);
	f->sp++;
	str_del(f->sp->u.string);
	PUT_STR(f->sp, str);
	break;

    case T_ARRAY:
	a = arr_range(f->data, f->sp[1].u.array, 0L, (long) f->sp->u.number);
	i_add_ticks(f, a->size);
	f->sp++;
	arr_del(f->sp->u.array);
	PUT_ARR(f->sp, a);
	break;

    default:
	kf_argerror(KF_RANGET, 1);
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_range, pt_range, 0)
# else
char pt_range[] = { C_STATIC, 1, 0, 0, 7, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->range()
 * DESCRIPTION:	value [ .. ]
 */
int kf_range(f)
register frame *f;
{
    string *str;
    array *a;

    if (f->sp->type == T_MAPPING) {
	a = map_range(f->data, f->sp->u.array, (value *) NULL, (value *) NULL);
	i_add_ticks(f, f->sp->u.array->size);
	arr_del(f->sp->u.array);
	PUT_MAP(f->sp, a);

	return 0;
    }

    switch (f->sp->type) {
    case T_STRING:
	i_add_ticks(f, 2);
	str = str_range(f->sp->u.string, 0L, f->sp->u.string->len - 1L);
	str_del(f->sp->u.string);
	PUT_STR(f->sp, str);
	break;

    case T_ARRAY:
	a = arr_range(f->data, f->sp->u.array, 0L, f->sp->u.array->size - 1L);
	i_add_ticks(f, a->size);
	arr_del(f->sp->u.array);
	PUT_ARR(f->sp, a);
	break;

    default:
	kf_argerror(KF_RANGE, 1);
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF(">>", kf_rshift, pt_rshift, 0)
# else
char pt_rshift[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->rshift()
 * DESCRIPTION:	int >> int
 */
int kf_rshift(f)
register frame *f;
{
    if (f->sp[1].type != T_INT) {
	kf_argerror(KF_RSHIFT, 1);
    }
    if (f->sp->type != T_INT) {
	kf_argerror(KF_RSHIFT, 2);
    }
    if ((f->sp->u.number & ~31) != 0) {
	if (f->sp->u.number < 0) {
	    error("Negative right shift");
	}
	PUT_INT(&f->sp[1], 0);
    } else {
	PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number >> f->sp->u.number);
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF(">>", kf_rshift_int, pt_rshift_int, 0)
# else
char pt_rshift_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->rshift_int()
 * DESCRIPTION:	int >> int
 */
int kf_rshift_int(f)
register frame *f;
{
    if ((f->sp->u.number & ~31) != 0) {
	if (f->sp->u.number < 0) {
	    error("Negative right shift");
	}
	PUT_INT(&f->sp[1], 0);
    } else {
	PUT_INT(&f->sp[1], (Uint) f->sp[1].u.number >> f->sp->u.number);
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("-", kf_sub, pt_sub, 0)
# else
char pt_sub[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->sub()
 * DESCRIPTION:	value - value
 */
int kf_sub(f)
register frame *f;
{
    xfloat f1, f2;

    switch (f->sp[1].type) {
    case T_INT:
	if (f->sp->type == T_INT) {
	    PUT_INT(&f->sp[1], f->sp[1].u.number - f->sp->u.number);
	    f->sp++;
	    return 0;
	}
	break;

    case T_FLOAT:
	if (f->sp->type == T_FLOAT) {
	    i_add_ticks(f, 1);
	    GET_FLT(f->sp, f2);
	    f->sp++;
	    GET_FLT(f->sp, f1);
	    flt_sub(&f1, &f2);
	    PUT_FLT(f->sp, f1);
	    return 0;
	}
	break;

    case T_ARRAY:
	if (f->sp->type == T_ARRAY) {
	    array *a;

	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = arr_sub(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_ARR(f->sp, a);
	    return 0;
	}
	break;

    case T_MAPPING:
	if (f->sp->type == T_ARRAY) {
	    array *a;

	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = map_sub(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_MAP(f->sp, a);
	    return 0;
	}
	break;

    default:
	kf_argerror(KF_SUB, 1);
    }

    kf_argerror(KF_SUB, 2);
}
# endif


# ifdef FUNCDEF
FUNCDEF("-", kf_sub_int, pt_sub_int, 0)
# else
char pt_sub_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->sub_int()
 * DESCRIPTION:	int - int
 */
int kf_sub_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], f->sp[1].u.number - f->sp->u.number);
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("--", kf_sub1, pt_sub1, 0)
# else
char pt_sub1[] = { C_STATIC, 1, 0, 0, 7, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->sub1()
 * DESCRIPTION:	value--
 */
int kf_sub1(f)
register frame *f;
{
    xfloat f1, f2;

    if (f->sp->type == T_INT) {
	PUT_INT(f->sp, f->sp->u.number - 1);
    } else if (f->sp->type == T_FLOAT) {
	i_add_ticks(f, 1);
	GET_FLT(f->sp, f1);
	FLT_ONE(f2.high, f2.low);
	flt_sub(&f1, &f2);
	PUT_FLT(f->sp, f1);
    } else {
	kf_argerror(KF_SUB1, 1);
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("--", kf_sub1_int, pt_sub1_int, 0)
# else
char pt_sub1_int[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_INT };

/*
 * NAME:	kfun->sub1_int()
 * DESCRIPTION:	int--
 */
int kf_sub1_int(f)
frame *f;
{
    PUT_INT(f->sp, f->sp->u.number - 1);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("(float)", kf_tofloat, pt_tofloat, 0)
# else
char pt_tofloat[] = { C_STATIC, 1, 0, 0, 7, T_FLOAT, T_MIXED };

/*
 * NAME:	kfun->tofloat()
 * DESCRIPTION:	convert to float
 */
int kf_tofloat(f)
register frame *f;
{
    xfloat flt;

    i_add_ticks(f, 1);
    if (f->sp->type == T_INT) {
	/* from int */
	flt_itof(f->sp->u.number, &flt);
	PUT_FLTVAL(f->sp, flt);
	return 0;
    } else if (f->sp->type == T_STRING) {
	char *p;

	/* from string */
	p = f->sp->u.string->text;
	if (!flt_atof(&p, &flt) ||
	    p != f->sp->u.string->text + f->sp->u.string->len) {
	    error("String cannot be converted to float");
	}
	str_del(f->sp->u.string);
	PUT_FLTVAL(f->sp, flt);
	return 0;
    }

    if (f->sp->type != T_FLOAT) {
	error("Value is not a float");
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("(int)", kf_toint, pt_toint, 0)
# else
char pt_toint[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_MIXED };

/*
 * NAME:	kfun->toint()
 * DESCRIPTION:	convert to integer
 */
int kf_toint(f)
register frame *f;
{
    xfloat flt;

    if (f->sp->type == T_FLOAT) {
	/* from float */
	i_add_ticks(f, 1);
	GET_FLT(f->sp, flt);
	PUT_INTVAL(f->sp, flt_ftoi(&flt));
	return 0;
    } else if (f->sp->type == T_STRING) {
	char *p;
	Int i;

	/* from string */
	p = f->sp->u.string->text;
	i = strtoint(&p);
	if (p != f->sp->u.string->text + f->sp->u.string->len) {
	    error("String cannot be converted to int");
	}
	str_del(f->sp->u.string);
	PUT_INTVAL(f->sp, i);
	return 0;
    }

    if (f->sp->type != T_INT) {
	error("Value is not an int");
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("!!", kf_tst, pt_tst, 0)
# else
char pt_tst[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_MIXED };

/*
 * NAME:	kfun->tst()
 * DESCRIPTION:	!! value
 */
int kf_tst(f)
register frame *f;
{
    switch (f->sp->type) {
    case T_NIL:
	PUT_INTVAL(f->sp, FALSE);
	return 0;

    case T_INT:
	PUT_INT(f->sp, (f->sp->u.number != 0));
	return 0;

    case T_FLOAT:
	PUT_INTVAL(f->sp, !VFLT_ISZERO(f->sp));
	return 0;

    case T_STRING:
	str_del(f->sp->u.string);
	break;

    case T_ARRAY:
    case T_MAPPING:
    case T_LWOBJECT:
	arr_del(f->sp->u.array);
	break;
    }

    PUT_INTVAL(f->sp, TRUE);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("!!", kf_tst_int, pt_tst, 0)
# else
/*
 * NAME:	kfun->tst_int()
 * DESCRIPTION:	!! int
 */
int kf_tst_int(f)
frame *f;
{
    PUT_INT(f->sp, (f->sp->u.number != 0));
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("unary -", kf_umin, pt_umin, 0)
# else
char pt_umin[] = { C_STATIC, 1, 0, 0, 7, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->umin()
 * DESCRIPTION:	- mixed
 */
int kf_umin(f)
register frame *f;
{
    xfloat flt;

    switch (f->sp->type) {
    case T_INT:
	PUT_INT(f->sp, -f->sp->u.number);
	return 0;

    case T_FLOAT:
	i_add_ticks(f, 1);
	if (!VFLT_ISZERO(f->sp)) {
	    GET_FLT(f->sp, flt);
	    FLT_NEG(flt.high, flt.low);
	    PUT_FLT(f->sp, flt);
	}
	return 0;
    }

    kf_argerror(KF_UMIN, 1);
}
# endif


# ifdef FUNCDEF
FUNCDEF("unary -", kf_umin_int, pt_umin_int, 0)
# else
char pt_umin_int[] = { C_STATIC, 1, 0, 0, 7, T_INT, T_INT };

/*
 * NAME:	kfun->umin_int()
 * DESCRIPTION:	- int
 */
int kf_umin_int(f)
frame *f;
{
    PUT_INT(f->sp, -f->sp->u.number);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("^", kf_xor, pt_xor, 0)
# else
char pt_xor[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->xor()
 * DESCRIPTION:	value ^ value
 */
int kf_xor(f)
register frame *f;
{
    array *a;

    switch (f->sp[1].type) {
    case T_INT:
	if (f->sp->type == T_INT) {
	    PUT_INT(&f->sp[1], f->sp[1].u.number ^ f->sp->u.number);
	    f->sp++;
	    return 0;
	}
	break;

    case T_ARRAY:
	if (f->sp->type == T_ARRAY) {
	    i_add_ticks(f, (Int) f->sp[1].u.array->size + f->sp->u.array->size);
	    a = arr_setxadd(f->data, f->sp[1].u.array, f->sp->u.array);
	    arr_del(f->sp->u.array);
	    f->sp++;
	    arr_del(f->sp->u.array);
	    PUT_ARR(f->sp, a);
	    return 0;
	}
	break;

    default:
	kf_argerror(KF_XOR, 1);
    }

    kf_argerror(KF_XOR, 2);
}
# endif


# ifdef FUNCDEF
FUNCDEF("^", kf_xor_int, pt_xor_int, 0)
# else
char pt_xor_int[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_INT, T_INT };

/*
 * NAME:	kfun->xor_int()
 * DESCRIPTION:	int ^ int
 */
int kf_xor_int(f)
register frame *f;
{
    PUT_INT(&f->sp[1], f->sp[1].u.number ^ f->sp->u.number);
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("(string)", kf_tostring, pt_tostring, 0)
# else
char pt_tostring[] = { C_STATIC, 1, 0, 0, 7, T_STRING, T_MIXED };

/*
 * NAME:	kfun->tostring()
 * DESCRIPTION:	cast an int or float to a string
 */
int kf_tostring(f)
register frame *f;
{
    char *num, buffer[18];
    xfloat flt;

    i_add_ticks(f, 2);
    if (f->sp->type == T_INT) {
	/* from int */
	num = kf_itoa(f->sp->u.number, buffer);
    } else if (f->sp->type == T_FLOAT) {
	/* from float */
	i_add_ticks(f, 1);
	GET_FLT(f->sp, flt);
	flt_ftoa(&flt, num = buffer);
    } else if (f->sp->type == T_STRING) {
	return 0;
    } else {
	error("Value is not a string");
    }

    PUT_STRVAL(f->sp, str_new(num, (long) strlen(num)));
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_ckrangeft, pt_ckrangeft, 0)
# else
char pt_ckrangeft[] = { C_STATIC, 3, 0, 0, 9, T_INT, T_MIXED, T_INT, T_INT };

/*
 * NAME:	kfun->ckrangeft()
 * DESCRIPTION:	Check a [ from .. to ] subrange.
 *		This function doesn't pop its arguments and returns nothing.
 */
int kf_ckrangeft(f)
register frame *f;
{
    if (f->sp[1].type != T_INT) {
	kf_argerror(KF_CKRANGEFT, 2);
    }
    if (f->sp->type != T_INT) {
	kf_argerror(KF_CKRANGEFT, 3);
    }
    if (f->sp[2].type == T_STRING) {
	str_ckrange(f->sp[2].u.string, (long) f->sp[1].u.number,
		    (long) f->sp->u.number);
    } else if (f->sp[2].type == T_ARRAY) {
	arr_ckrange(f->sp[2].u.array, (long) f->sp[1].u.number,
		    (long) f->sp->u.number);
    } else {
	kf_argerror(KF_CKRANGEFT, 1);
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_ckrangef, pt_ckrangef, 0)
# else
char pt_ckrangef[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_INT };

/*
 * NAME:	kfun->ckrangef()
 * DESCRIPTION:	Check a [ from .. ] subrange, add missing index.
 *		This function doesn't pop its arguments.
 */
int kf_ckrangef(f)
register frame *f;
{
    if (f->sp->type != T_INT) {
	kf_argerror(KF_CKRANGEF, 2);
    }
    if (f->sp[1].type == T_STRING) {
	(--f->sp)->type = T_INT;
	f->sp->u.number = (Int) f->sp[2].u.string->len - 1;
	str_ckrange(f->sp[2].u.string, (long) f->sp[1].u.number,
		    (long) f->sp->u.number);
    } else if (f->sp[1].type == T_ARRAY) {
	(--f->sp)->type = T_INT;
	f->sp->u.number = (Int) f->sp[2].u.array->size - 1;
	arr_ckrange(f->sp[2].u.array, (long) f->sp[1].u.number,
		    (long) f->sp->u.number);
    } else {
	kf_argerror(KF_CKRANGEF, 1);
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("[]", kf_ckranget, pt_ckranget, 0)
# else
char pt_ckranget[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_MIXED, T_INT };

/*
 * NAME:	kfun->ckranget()
 * DESCRIPTION:	Check a [ .. to ] subrange, add missing index.
 *		This function doesn't pop its arguments.
 */
int kf_ckranget(f)
register frame *f;
{
    if (f->sp->type != T_INT) {
	kf_argerror(KF_CKRANGET, 2);
    }
    if (f->sp[1].type == T_STRING) {
	str_ckrange(f->sp[1].u.string, 0L, (long) f->sp->u.number);
    } else if (f->sp[1].type == T_ARRAY) {
	arr_ckrange(f->sp[1].u.array, 0L, (long) f->sp->u.number);
    } else {
	kf_argerror(KF_CKRANGET, 1);
    }

    --f->sp;
    f->sp[0] = f->sp[1];
    PUT_INT(&f->sp[1], 0);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("sum", kf_sum, pt_sum, 0)
# else
char pt_sum[] = { C_STATIC | C_ELLIPSIS, 0, 1, 0, 7, T_MIXED, T_MIXED };

/*
 * NAME:	kfun->sum()
 * DESCRIPTION:	perform a summand operation
 */
int kf_sum(f, nargs)
register frame *f;
int nargs;
{
    char buffer[12], *num;
    string *s;
    array *a;
    register value *v, *e1, *e2;
    register int i, type, vtype, nonint;
    register long size;
    register ssizet len;
    register Int result;
    register long isize;

    /*
     * pass 1: check the types of everything and calculate the size
     */
    i_add_ticks(f, nargs);
    type = T_NIL;
    isize = size = 0;
    nonint = nargs;
    result = 0;
    for (v = f->sp, i = nargs; --i >= 0; v++) {
	if (v->u.number == -2) {
	    /* simple term */
	    v++;
	    vtype = v->type;
	    if (vtype == T_STRING) {
		size += v->u.string->len;
	    } else if (vtype == T_ARRAY) {
		size += v->u.array->size;
	    } else {
		size += strlen(kf_itoa(v->u.number, buffer));
	    }
	} else if (v->u.number < -2) {
	    /* aggregate */
	    size += -3 - v->u.number;
	    v += -3 - v->u.number;
	    vtype = T_ARRAY;
	} else {
	    /* subrange term */
	    size += v->u.number - v[1].u.number + 1;
	    v += 2;
	    vtype = v->type;
	}

	if (vtype == T_STRING || vtype == T_ARRAY) {
	    nonint = i;
	    isize = size;
	    if (type == T_NIL && (vtype != T_ARRAY || i == nargs - 1)) {
		type = vtype;
	    } else if (type != vtype) {
		error("Bad argument 2 for kfun +");
	    }
	} else if (vtype != T_INT || type == T_ARRAY) {
	    error("Bad argument %d for kfun +", (i == 0) ? 1 : 2);
	} else {
	    result += v->u.number;
	}
    }
    if (nonint > 1) {
	size = isize + strlen(kf_itoa(result, buffer));
    }

    /*
     * pass 2: build the string or array
     */
    result = 0;
    if (type == T_STRING) {
	s = str_new((char *) NULL, size);
	s->text[size] = '\0';
	for (v = f->sp, i = nargs; --i >= 0; v++) {
	    if (v->u.number == -2) {
		/* simple term */
		v++;
		if (v->type == T_STRING) {
		    size -= v->u.string->len;
		    memcpy(s->text + size, v->u.string->text, v->u.string->len);
		    str_del(v->u.string);
		    result = 0;
		} else if (nonint < i) {
		    num = kf_itoa(v->u.number, buffer);
		    len = strlen(num);
		    size -= len;
		    memcpy(s->text + size, num, len);
		    result = 0;
		} else {
		    result += v->u.number;
		}
	    } else {
		/* subrange */
		len = v->u.number - v[1].u.number + 1;
		size -= len;
		memcpy(s->text + size, v[2].u.string->text + v[1].u.number,
		       len);
		v += 2;
		str_del(v->u.string);
		result = 0;
	    }
	}
	if (nonint > 0) {
	    num = kf_itoa(result, buffer);
	    memcpy(s->text, num, strlen(num));
	}

	f->sp = v - 1;
	PUT_STRVAL(f->sp, s);
    } else if (type == T_ARRAY) {
	a = arr_new(f->data, size);
	e1 = a->elts + size;
	for (v = f->sp, i = nargs; --i >= 0; v++) {
	    if (v->u.number == -2) {
		/* simple term */
		v++;
		len = v->u.array->size;
		e2 = d_get_elts(v->u.array) + len;
	    } else if (v->u.number < -2) {
		/* aggregate */
		for (len = -3 - v->u.number; len > 0; --len) {
		    *--e1 = *++v;
		}
		continue;
	    } else {
		/* subrange */
		len = v->u.number - v[1].u.number + 1;
		e2 = d_get_elts(v[2].u.array) + v->u.number + 1;
		v += 2;
	    }

	    e1 -= len;
	    i_copy(e1, e2 - len, len);
	    arr_del(v->u.array);
	    size -= len;
	}

	f->sp = v - 1;
	d_ref_imports(a);
	PUT_ARRVAL(f->sp, a);
    } else {
	/* integers only */
	for (v = f->sp, i = nargs; --i > 0; v += 2) {
	    result += v[1].u.number;
	}

	f->sp = v + 1;
	f->sp->u.number += result;
    }

    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("status", kf_status_idx, pt_status_idx, 0)
# else
char pt_status_idx[] = { C_STATIC, 1, 0, 0, 7, T_MIXED, T_INT };

/*
 * NAME:	kfun->status_idx()
 * DESCRIPTION:	return status()[idx]
 */
int kf_status_idx(f)
register frame *f;
{
    if (f->sp->type != T_INT) {
	error("Non-numeric array index");
    }
    i_add_ticks(f, 6);
    if (!conf_statusi(f, f->sp->u.number, f->sp)) {
	error("Index out of range");
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("status", kf_statuso_idx, pt_statuso_idx, 0)
# else
char pt_statuso_idx[] = { C_STATIC, 2, 0, 0, 8, T_MIXED, T_OBJECT, T_INT };

/*
 * NAME:	kfun->statuso_idx()
 * DESCRIPTION:	return status(obj)[idx]
 */
int kf_statuso_idx(f)
register frame *f;
{
    uindex n;

    switch (f->sp[1].type) {
    case T_OBJECT:
	n = f->sp[1].oindex;
	break;

    case T_LWOBJECT:
	n = f->sp[1].u.array->elts[0].oindex;
	arr_del(f->sp[1].u.array);
	f->sp[1] = nil_value;
	break;

    default:
	kf_argerror(KF_STATUSO_IDX, 1);
    }
    if (f->sp->type != T_INT) {
	error("Non-numeric array index");
    }
    i_add_ticks(f, 6);
    if (!conf_objecti(f->data, OBJR(n), f->sp->u.number, &f->sp[1])) {
	error("Index out of range");
    }
    f->sp++;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("call_trace", kf_calltr_idx, pt_calltr_idx, 0)
# else
char pt_calltr_idx[] = { C_STATIC, 1, 0, 0, 7, T_MIXED | (1 << REFSHIFT),
			 T_INT };

/*
 * NAME:	kfun->calltr_idx()
 * DESCRIPTION:	return call_trace()[idx]
 */
int kf_calltr_idx(f)
register frame *f;
{
    if (f->sp->type != T_INT) {
	error("Non-numeric array index");
    }
    i_add_ticks(f, 10);
    if (!i_call_tracei(f, f->sp->u.number, f->sp)) {
	error("Index out of range");
    }
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("nil", kf_nil, pt_nil, 0)
# else
char pt_nil[] = { C_STATIC, 0, 0, 0, 6, T_NIL };

/*
 * NAME:	kfun->nil()
 * DESCRIPTION:	return nil
 */
int kf_nil(f)
register frame *f;
{
    *--f->sp = nil_value;
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("<-", kf_instanceof, pt_instanceof, 0)
# else
char pt_instanceof[] = { C_STATIC, 2, 0, 0, 8, T_INT, T_OBJECT, T_INT };

/*
 * NAME:	kfun->instanceof()
 * DESCRIPTION:	instanceof
 */
int kf_instanceof(f)
register frame *f;
{
    uindex oindex;
    int instance;

    switch (f->sp[1].type) {
    case T_OBJECT:
	oindex = f->sp[1].oindex;
	break;

    case T_LWOBJECT:
	oindex = d_get_elts(f->sp[1].u.array)->oindex;
	arr_del(f->sp[1].u.array);
	break;

    default:
	kf_argerror(KF_INSTANCEOF, 1);
    }
    instance = i_instanceof(f, oindex, f->sp->u.number);
    f->sp++;
    PUT_INTVAL(f->sp, instance);
    return 0;
}
# endif


# ifdef FUNCDEF
FUNCDEF("=", kf_store_aggr, pt_store_aggr, 0)
# else
unsigned char pt_store_aggr[] = { C_STATIC, 2, 0, 0, 8, T_MIXED,
				  T_MIXED | (1 << REFSHIFT), T_INT };

/*
 * NAME:	kfun->store_aggr()
 * DESCRIPTION:	store array elements in lvalues on the stack, which will also
 *		be popped
 */
int kf_store_aggr(f)
register frame *f;
{
    register int n, i;
    register value *v;
    value val;
 
    n = f->sp[0].u.number;
    if (f->sp[1].type != T_ARRAY || f->sp[1].u.array->size != n) {
	kf_argerror(KF_STORE_AGGR, 2);
    }
    val = *++(f->sp);
    for (i = 0; i < n; i++) {
	f->sp[i] = f->sp[i + 1];
    }
    f->sp[n] = val;

    for (v = d_get_elts(val.u.array) + n; n > 0; --n) {
	*--(f->sp) = *--v;
	i_ref_value(v);
	i_store(f);
	i_del_value(v);
	f->sp += 2;
    }

    return 0;
}
# endif