/*
 * value - generic value manipulation routines
 *
 * Copyright (C) 1999-2007,2014,2017,2021-2023,2025-2026  David I. Bell
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc 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 Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *
 * Under source code control:   1990/02/15 01:48:25
 * File existed as early as:    before 1990
 *
 * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
 */

/*
 * important <system> header includes
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <stdint.h>
#include <stdbool.h>

/*
 * calc local src includes
 */
#include "value.h"
#include "calc.h"
#include "opcodes.h"
#include "label.h"
#include "func.h"
#include "symbol.h"
#include "file.h"
#include "attribute.h"
#include "errtbl.h"

#include "banned.h" /* include after all other includes */

#define LINELEN 80 /* length of a typical tty line */

/*
 * Free a value and set its type to undefined.
 *
 * given:
 *      vp              value to be freed
 */
void
freevalue(VALUE *vp)
{
    int type; /* type of value being freed */

    type = vp->v_type;
    vp->v_type = V_NULL;
    vp->v_subtype = V_NOSUBTYPE;
    if (type <= 0) {
        return;
    }
    switch (type) {
    case V_ADDR:
    case V_OCTET:
    case V_NBLOCK:
    case V_FILE:
    case V_VPTR:
    case V_OPTR:
    case V_SPTR:
    case V_NPTR:
        /* nothing to free */
        break;
    case V_STR:
        sfree(vp->v_str);
        break;
    case V_NUM:
        qfree(vp->v_num);
        break;
    case V_COM:
        comfree(vp->v_com);
        break;
    case V_MAT:
        matfree(vp->v_mat);
        break;
    case V_LIST:
        listfree(vp->v_list);
        break;
    case V_ASSOC:
        assocfree(vp->v_assoc);
        break;
    case V_OBJ:
        objfree(vp->v_obj);
        break;
    case V_RAND:
        randfree(vp->v_rand);
        break;
    case V_RANDOM:
        randomfree(vp->v_random);
        break;
    case V_CONFIG:
        config_free(vp->v_config);
        break;
    case V_HASH:
        hash_free(vp->v_hash);
        break;
    case V_BLOCK:
        blk_free(vp->v_block);
        break;
    default:
        math_error("Freeing unknown value type");
        not_reached();
    }
}

/*
 * Set protection status for a value and all of its components
 */
void
protecttodepth(VALUE *vp, int sts, int depth)
{
    VALUE *vq;
    int i;
    LISTELEM *ep;
    ASSOC *ap;

    if (vp->v_type == V_NBLOCK) {
        if (sts > 0) {
            vp->v_nblock->subtype |= sts;
        } else if (sts < 0) {
            vp->v_nblock->subtype &= ~(-sts);
        } else {
            vp->v_nblock->subtype = 0;
        }
        return;
    }
    if (sts > 0) {
        vp->v_subtype |= sts;
    } else if (sts < 0) {
        vp->v_subtype &= ~(-sts);
    } else {
        vp->v_subtype = 0;
    }

    if (depth > 0) {
        switch (vp->v_type) {
        case V_MAT:
            vq = vp->v_mat->m_table;
            i = vp->v_mat->m_size;
            while (i-- > 0) {
                protecttodepth(vq++, sts, depth - 1);
            }
            break;
        case V_LIST:
            for (ep = vp->v_list->l_first; ep; ep = ep->e_next) {
                protecttodepth(&ep->e_value, sts, depth - 1);
            }
            break;
        case V_OBJ:
            vq = vp->v_obj->o_table;
            i = vp->v_obj->o_actions->oa_count;
            while (i-- > 0) {
                protecttodepth(vq++, sts, depth - 1);
            }
            break;
        case V_ASSOC:
            ap = vp->v_assoc;
            for (i = 0; i < ap->a_count; i++) {
                protecttodepth(assocfindex(ap, i), sts, depth - 1);
            }
        }
    }
}

/*
 * Copy a value from one location to another.
 * This overwrites the specified new value without checking it.
 *
 * given:
 *      oldvp           value to be copied from
 *      newvp           value to be copied into
 */
void
copyvalue(VALUE *oldvp, VALUE *newvp)
{
    /* firewall */
    if (oldvp == NULL) {
        return;
    }

    newvp->v_type = oldvp->v_type;
    if (oldvp->v_type >= 0) {
        switch (oldvp->v_type) {
        case V_NULL:
        case V_ADDR:
        case V_VPTR:
        case V_OPTR:
        case V_SPTR:
        case V_NPTR:
            *newvp = *oldvp;
            break;
        case V_FILE:
            newvp->v_file = oldvp->v_file;
            break;
        case V_NUM:
            newvp->v_num = qlink(oldvp->v_num);
            break;
        case V_COM:
            newvp->v_com = clink(oldvp->v_com);
            break;
        case V_STR:
            newvp->v_str = slink(oldvp->v_str);
            break;
        case V_MAT:
            newvp->v_mat = matcopy(oldvp->v_mat);
            break;
        case V_LIST:
            newvp->v_list = listcopy(oldvp->v_list);
            break;
        case V_ASSOC:
            newvp->v_assoc = assoccopy(oldvp->v_assoc);
            break;
        case V_OBJ:
            newvp->v_obj = objcopy(oldvp->v_obj);
            break;
        case V_RAND:
            newvp->v_rand = randcopy(oldvp->v_rand);
            break;
        case V_RANDOM:
            newvp->v_random = randomcopy(oldvp->v_random);
            break;
        case V_CONFIG:
            newvp->v_config = config_copy(oldvp->v_config);
            break;
        case V_HASH:
            newvp->v_hash = hash_copy(oldvp->v_hash);
            break;
        case V_BLOCK:
            newvp->v_block = blk_copy(oldvp->v_block);
            break;
        case V_OCTET:
            newvp->v_type = V_NUM;
            newvp->v_num = itoq((long)*oldvp->v_octet);
            break;
        case V_NBLOCK:
            newvp->v_nblock = oldvp->v_nblock;
            break;
        default:
            math_error("Copying unknown value type");
            not_reached();
        }
    }
    newvp->v_subtype = oldvp->v_subtype;
}

/*
 * copy the low order 8 bits of a value to an octet
 */
void
copy2octet(VALUE *vp, OCTET *op)
{
    uint8_t oval; /* low order 8 bits to store into OCTET */
    NUMBER *q;
    HALF h;

    if (vp->v_type == V_ADDR) {
        vp = vp->v_addr;
    }

    oval = 0;

    /*
     * we can (at the moment) only store certain types
     * values into an OCTET, so get the low order 8 bits
     * of these particular value types
     */
    h = 0;
    switch (vp->v_type) {
    case V_NULL:
        /* nothing to store ... so do nothing */
        return;
    case V_INT:
        oval = (uint8_t)(vp->v_int & 0xff);
        break;
    case V_NUM:
        if (qisint(vp->v_num)) {
            /* use low order 8 bits of integer value */
            h = vp->v_num->num.v[0];
        } else {
            /* use low order 8 bits of int(value) */
            q = qint(vp->v_num);
            h = q->num.v[0];
            qfree(q);
        }
        if (qisneg(vp->v_num)) {
            h = -h;
        }
        oval = (uint8_t)h;
        break;
    case V_COM:
        if (cisint(vp->v_com)) {
            /* use low order 8 bits of integer value */
            h = vp->v_com->real->num.v[0];
        } else {
            /* use low order 8 bits of int(value) */
            q = qint(vp->v_com->real);
            h = q->num.v[0];
            qfree(q);
        }
        if (qisneg(vp->v_com->real)) {
            h = -h;
        }
        oval = (uint8_t)h;
        break;
    case V_STR:
        oval = (uint8_t)vp->v_str->s_str[0];
        break;
    case V_BLOCK:
        oval = (uint8_t)vp->v_block->data[0];
        break;
    case V_OCTET:
        oval = *vp->v_octet;
        break;
    case V_NBLOCK:
        if (vp->v_nblock->blk->data == NULL) {
            return;
        }
        oval = (uint8_t)vp->v_nblock->blk->data[0];
        break;
    default:
        math_error("invalid assignment into an OCTET");
        break;
    }
    *op = oval;
}

/*
 * Negate an arbitrary value.
 * Result is placed in the indicated location.
 */
void
negvalue(VALUE *vp, VALUE *vres)
{
    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qneg(vp->v_num);
        return;
    case V_COM:
        vres->v_com = c_neg(vp->v_com);
        return;
    case V_MAT:
        vres->v_mat = matneg(vp->v_mat);
        return;
    case V_STR:
        vres->v_str = stringneg(vp->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRNEG);
        }
        return;
    case V_OCTET:
        vres->v_type = V_NUM;
        vres->v_subtype = V_NOSUBTYPE;
        vres->v_num = itoq(-(long)*vp->v_octet);
        return;

    case V_OBJ:
        *vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type <= 0) {
            return;
        }
        *vres = error_value(E_NEG);
        return;
    }
}

/*
 * Add two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
addvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */
    COMPLEX *c;
    VALUE tmp;
    NUMBER *q;
    long i;

    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type == V_LIST) {
        tmp.v_type = V_NULL;
        addlistitems(v1->v_list, &tmp);
        addvalue(&tmp, v2, vres);
        return;
    }
    if (v2->v_type == V_LIST) {
        copyvalue(v1, vres);
        addlistitems(v2->v_list, vres);
        return;
    }
    if (v1->v_type == V_NULL) {
        copyvalue(v2, vres);
        return;
    }
    if (v2->v_type == V_NULL) {
        copyvalue(v1, vres);
        return;
    }
    vres->v_type = v1->v_type;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qqadd(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_COM, V_NUM):
        vres->v_com = c_addq(v1->v_com, v2->v_num);
        return;
    case TWOVAL(V_NUM, V_COM):
        vres->v_com = c_addq(v2->v_com, v1->v_num);
        vres->v_type = V_COM;
        return;
    case TWOVAL(V_COM, V_COM):
        vres->v_com = c_add(v1->v_com, v2->v_com);
        c = vres->v_com;
        if (!cisreal(c)) {
            return;
        }
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
        return;
    case TWOVAL(V_MAT, V_MAT):
        vres->v_mat = matadd(v1->v_mat, v2->v_mat);
        return;
    case TWOVAL(V_STR, V_STR):
        vres->v_str = stringadd(v1->v_str, v2->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRADD);
        }
        return;
    case TWOVAL(V_VPTR, V_NUM):
#if defined(PERMIT_DANGEROUS_ADDRESS_ARITHMETIC)

        /* NOTE: Defining PERMIT_DANGEROUS_ADDRESS_ARITHMETIC is NOT supported! */
        q = v2->v_num;
        if (qisfrac(q)) {
            math_error("Adding non-integer to address");
            not_reached();
        }
        i = qtoi(q);
        vres->v_addr = v1->v_addr + i;
        vres->v_type = V_VPTR;

#else

        *vres = error_value(E_INVALID_ADDR_OP);

#endif
        return;
    case TWOVAL(V_VPTR, V_VPTR):
        *vres = error_value(E_INVALID_ADDR_OP);
        return;
    case TWOVAL(V_OPTR, V_NUM):
        q = v2->v_num;
        if (qisfrac(q)) {
            math_error("Adding non-integer to address");
            not_reached();
        }
        i = qtoi(q);
        vres->v_octet = v1->v_octet + i;
        vres->v_type = V_OPTR;
        return;
    default:
        if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
            if (v1->v_type < 0) {
                return;
            }
            if (v2->v_type > 0) {
                *vres = error_value(E_ADD);
            } else {
                vres->v_type = v2->v_type;
            }
            return;
        }
        *vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE);
        return;
    }
}

/*
 * Subtract one arbitrary value from another one.
 * Result is placed in the indicated location.
 */
void
subvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */
    COMPLEX *c;
    NUMBER *q;
    int i;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qsub(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_COM, V_NUM):
        vres->v_com = c_subq(v1->v_com, v2->v_num);
        return;
    case TWOVAL(V_NUM, V_COM):
        c = c_subq(v2->v_com, v1->v_num);
        vres->v_type = V_COM;
        vres->v_com = c_neg(c);
        comfree(c);
        return;
    case TWOVAL(V_COM, V_COM):
        vres->v_com = c_sub(v1->v_com, v2->v_com);
        c = vres->v_com;
        if (!cisreal(c)) {
            return;
        }
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
        return;
    case TWOVAL(V_MAT, V_MAT):
        vres->v_mat = matsub(v1->v_mat, v2->v_mat);
        return;
    case TWOVAL(V_STR, V_STR):
        vres->v_str = stringsub(v1->v_str, v2->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRSUB);
        }
        return;
    case TWOVAL(V_VPTR, V_NUM):
#if defined(PERMIT_DANGEROUS_ADDRESS_ARITHMETIC)

        /* NOTE: Defining PERMIT_DANGEROUS_ADDRESS_ARITHMETIC is NOT supported! */
        q = v2->v_num;
        if (qisfrac(q)) {
            math_error("Subtracting non-integer from address");
            not_reached();
        }
        i = qtoi(q);
        vres->v_addr = v1->v_addr - i;
        vres->v_type = V_VPTR;
#else

        *vres = error_value(E_INVALID_ADDR_OP);

#endif
        return;
    case TWOVAL(V_OPTR, V_NUM):
        q = v2->v_num;
        if (qisfrac(q)) {
            math_error("Adding non-integer to address");
            not_reached();
        }
        i = qtoi(q);
        vres->v_octet = v1->v_octet - i;
        vres->v_type = V_OPTR;
        return;
    case TWOVAL(V_VPTR, V_VPTR):
        vres->v_type = V_NUM;
        vres->v_num = itoq(v1->v_addr - v2->v_addr);
        return;
    case TWOVAL(V_OPTR, V_OPTR):
        vres->v_type = V_NUM;
        vres->v_num = itoq(v1->v_octet - v2->v_octet);
        return;
    default:
        if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
            if (v1->v_type <= 0) {
                return;
            }
            if (v2->v_type <= 0) {
                vres->v_type = v2->v_type;
                return;
            }
            *vres = error_value(E_SUB);
            return;
        }
        *vres = objcall(OBJ_SUB, v1, v2, NULL_VALUE);
        return;
    }
}

/*
 * Multiply two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
mulvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */
    COMPLEX *c;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qmul(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_COM, V_NUM):
        vres->v_com = c_mulq(v1->v_com, v2->v_num);
        break;
    case TWOVAL(V_NUM, V_COM):
        vres->v_com = c_mulq(v2->v_com, v1->v_num);
        vres->v_type = V_COM;
        break;
    case TWOVAL(V_COM, V_COM):
        vres->v_com = c_mul(v1->v_com, v2->v_com);
        break;
    case TWOVAL(V_MAT, V_MAT):
        vres->v_mat = matmul(v1->v_mat, v2->v_mat);
        return;
    case TWOVAL(V_MAT, V_NUM):
    case TWOVAL(V_MAT, V_COM):
        vres->v_mat = matmulval(v1->v_mat, v2);
        return;
    case TWOVAL(V_NUM, V_MAT):
    case TWOVAL(V_COM, V_MAT):
        vres->v_mat = matmulval(v2->v_mat, v1);
        vres->v_type = V_MAT;
        return;
    case TWOVAL(V_NUM, V_STR):
        vres->v_type = V_STR;
        vres->v_str = stringmul(v1->v_num, v2->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRMUL);
        }
        return;
    case TWOVAL(V_STR, V_NUM):
        vres->v_str = stringmul(v2->v_num, v1->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRMUL);
        }
        return;
    default:
        if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
            if (v1->v_type <= 0) {
                return;
            }
            if (v2->v_type <= 0) {
                vres->v_type = v2->v_type;
                return;
            }
            *vres = error_value(E_MUL);
            return;
        }
        *vres = objcall(OBJ_MUL, v1, v2, NULL_VALUE);
        return;
    }
    c = vres->v_com;
    if (cisreal(c)) {
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
    }
}

/*
 * Square an arbitrary value.
 * Result is placed in the indicated location.
 */
void
squarevalue(VALUE *vp, VALUE *vres)
{
    COMPLEX *c;

    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qsquare(vp->v_num);
        return;
    case V_COM:
        vres->v_com = c_square(vp->v_com);
        c = vres->v_com;
        if (!cisreal(c)) {
            return;
        }
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
        return;
    case V_MAT:
        vres->v_mat = matsquare(vp->v_mat);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type <= 0) {
            vres->v_type = vp->v_type;
            return;
        }
        *vres = error_value(E_SQUARE);
        return;
    }
}

/*
 * Invert an arbitrary value.
 * Result is placed in the indicated location.
 */
void
invertvalue(VALUE *vp, VALUE *vres)
{
    NUMBER *q1, *q2;

    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        if (qiszero(vp->v_num)) {
            *vres = error_value(E_DIVBYZERO);
        } else {
            vres->v_num = qinv(vp->v_num);
        }
        return;
    case V_COM:
        vres->v_com = c_inv(vp->v_com);
        return;
    case V_MAT:
        vres->v_mat = matinv(vp->v_mat);
        return;
    case V_OCTET:
        if (*vp->v_octet == 0) {
            *vres = error_value(E_DIVBYZERO);
            return;
        }
        q1 = itoq((long)*vp->v_octet);
        q2 = qinv(q1);
        qfree(q1);
        vres->v_num = q2;
        vres->v_type = V_NUM;
        return;
    case V_OBJ:
        *vres = objcall(OBJ_INV, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type == -E_DIVBYZERO) {
            vres->v_type = V_NUM;
            vres->v_num = qlink(&_qzero_);
            return;
        }
        if (vp->v_type <= 0) {
            return;
        }
        *vres = error_value(E_INV);
        return;
    }
}

/*
 * "AND" two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
andvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */

    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type == V_NULL) {
        copyvalue(v2, vres);
        return;
    }
    if (v2->v_type == V_NULL) {
        copyvalue(v1, vres);
        return;
    }
    vres->v_type = v1->v_type;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qand(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_STR, V_STR):
        vres->v_str = stringand(v1->v_str, v2->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRAND);
        }
        return;
    case TWOVAL(V_OCTET, V_OCTET):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet & *v2->v_octet);
        return;
    case TWOVAL(V_STR, V_OCTET):
        vres->v_str = charstring(*v1->v_str->s_str & *v2->v_octet);
        return;
    case TWOVAL(V_OCTET, V_STR):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet & *v2->v_str->s_str);
        return;
    default:
        if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
            if (v1->v_type < 0) {
                return;
            }
            if (v2->v_type < 0) {
                vres->v_type = v2->v_type;
                return;
            }
            *vres = error_value(E_AND);
            return;
        }
        *vres = objcall(OBJ_AND, v1, v2, NULL_VALUE);
        return;
    }
}

/*
 * "OR" two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
orvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */

    if (v1->v_type == V_NULL) {
        copyvalue(v2, vres);
        return;
    }
    if (v2->v_type == V_NULL) {
        copyvalue(v1, vres);
        return;
    }
    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qor(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_STR, V_STR):
        vres->v_str = stringor(v1->v_str, v2->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STROR);
        }
        return;
    case TWOVAL(V_OCTET, V_OCTET):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet | *v2->v_octet);
        return;
    case TWOVAL(V_STR, V_OCTET):
        vres->v_str = charstring(*v1->v_str->s_str | *v2->v_octet);
        return;
    case TWOVAL(V_OCTET, V_STR):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet | *v2->v_str->s_str);
        return;
    default:
        if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
            if (v1->v_type < 0) {
                return;
            }
            if (v2->v_type < 0) {
                vres->v_type = v2->v_type;
                return;
            }
            *vres = error_value(E_OR);
            return;
        }
        *vres = objcall(OBJ_OR, v1, v2, NULL_VALUE);
        return;
    }
}

/*
 * "~" two values, returns the "symmetric difference" bitwise xor(v1, v2) for
 * strings, octets and real numbers, and a user-defined function if at least
 * one of v1 and v2 is an object.
 */
void
xorvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case (TWOVAL(V_NUM, V_NUM)):
        vres->v_num = qxor(v1->v_num, v2->v_num);
        return;
    case (TWOVAL(V_STR, V_STR)):
        vres->v_str = stringxor(v1->v_str, v2->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRDIFF);
        }
        return;
    case (TWOVAL(V_STR, V_OCTET)):
        if (v1->v_str->s_len) {
            vres->v_str = stringcopy(v1->v_str);
            *vres->v_str->s_str ^= *v2->v_octet;
        } else {
            vres->v_str = charstring(*v2->v_octet);
        }
        return;
    case (TWOVAL(V_OCTET, V_STR)):
        if (v2->v_str->s_len) {
            vres->v_str = stringcopy(v2->v_str);
            *vres->v_str->s_str ^= *v1->v_octet;
        } else {
            vres->v_str = charstring(*v1->v_octet);
        }
        return;
    case (TWOVAL(V_OCTET, V_OCTET)):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet ^ *v2->v_octet);
        return;
    default:
        if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
            *vres = objcall(OBJ_XOR, v1, v2, NULL_VALUE);
        } else {
            *vres = error_value(E_XOR);
        }
    }
}

/*
 * "#" two values - abs(v1-v2) for numbers, user-defined for objects
 */
void
hashopvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */
    NUMBER *q;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        q = qsub(v1->v_num, v2->v_num);
        vres->v_num = qqabs(q);
        qfree(q);
        return;
    default:
        if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
            *vres = objcall(OBJ_HASHOP, v1, v2, NULL_VALUE);
        } else {
            *vres = error_value(E_HASHOP);
        }
    }
}

void
compvalue(VALUE *vp, VALUE *vres)
{

    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qcomp(vp->v_num);
        return;
    case V_STR:
        vres->v_str = stringcomp(vp->v_str);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRCOMP);
        }
        return;
    case V_OCTET:
        vres->v_type = V_STR;
        vres->v_str = charstring(~*vp->v_octet);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_COMP, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        *vres = error_value(E_COMP);
    }
}

/*
 * "\" a value, user-defined only
 */
void
backslashvalue(VALUE *vp, VALUE *vres)
{
    if (vp->v_type == V_OBJ) {
        *vres = objcall(OBJ_BACKSLASH, vp, NULL_VALUE, NULL_VALUE);
    } else {
        *vres = error_value(E_BACKSLASH);
    }
}

/*
 * "\" two values, for strings performs bitwise "AND-NOT" operation
 * User defined for objects
 */
void
setminusvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qandnot(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_STR, V_STR):
        vres->v_str = stringdiff(v1->v_str, v2->v_str);
        return;
    case TWOVAL(V_STR, V_OCTET):
        vres->v_str = charstring(*v1->v_str->s_str & ~*v2->v_octet);
        return;
    case TWOVAL(V_OCTET, V_STR):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet & ~*v2->v_str->s_str);
        return;
    case TWOVAL(V_OCTET, V_OCTET):
        vres->v_type = V_STR;
        vres->v_str = charstring(*v1->v_octet & ~*v2->v_octet);
        return;
    default:
        if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
            *vres = objcall(OBJ_SETMINUS, v1, v2, NULL_VALUE);
        } else {
            *vres = error_value(E_SETMINUS);
        }
    }
}

/*
 * "#" a value, for strings and octets returns the number of nonzero bits
 * in the value; user-defined for an object
 */
void
contentvalue(VALUE *vp, VALUE *vres)
{
    long count;
    unsigned char u;

    vres->v_type = V_NUM;
    vres->v_subtype = V_NOSUBTYPE;
    count = 0;
    switch (vp->v_type) {
    case V_STR:
        count = stringcontent(vp->v_str);
        break;
    case V_OCTET:
        for (u = *vp->v_octet; u; u >>= 1) {
            count += (u & 1);
        }
        break;
    case V_NUM:
        count = zpopcnt(vp->v_num->num, 1);
        break;
    case V_OBJ:
        *vres = objcall(OBJ_CONTENT, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        *vres = error_value(E_CONTENT);
        return;
    }
    vres->v_num = itoq(count);
}

/*
 * Approximate numbers by multiples of v2 using rounding criterion v3.
 * Result is placed in the indicated location.
 */
void
apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    NUMBER *e;
    long R = 0;
    NUMBER *q1, *q2;
    COMPLEX *c;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        return;
    }

    e = NULL;
    switch (v2->v_type) {
    case V_NUM:
        e = v2->v_num;
        break;
    case V_NULL:
        e = conf->epsilon;
        break;
    default:
        *vres = error_value(E_APPR_2);
        return;
    }
    switch (v3->v_type) {
    case V_NUM:
        if (qisfrac(v3->v_num)) {
            *vres = error_value(E_APPR_3);
            return;
        }
        R = qtoi(v3->v_num);
        break;
    case V_NULL:
        R = conf->appr;
        break;
    default:
        *vres = error_value(E_APPR_3);
        return;
    }

    if (qiszero(e)) {
        copyvalue(v1, vres);
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        vres->v_num = qmappr(v1->v_num, e, R);
        return;
    case V_MAT:
        vres->v_mat = matappr(v1->v_mat, v2, v3);
        return;
    case V_LIST:
        vres->v_list = listappr(v1->v_list, v2, v3);
        return;
    case V_COM:
        q1 = qmappr(v1->v_com->real, e, R);
        q2 = qmappr(v1->v_com->imag, e, R);
        if (qiszero(q2)) {
            vres->v_type = V_NUM;
            vres->v_num = q1;
            qfree(q2);
            return;
        }
        c = comalloc();
        qfree(c->real);
        qfree(c->imag);
        c->real = q1;
        c->imag = q2;
        vres->v_com = c;
        return;
    default:
        *vres = error_value(E_APPR_1);
        return;
    }
}

/*
 * Round numbers to number of decimals specified by v2, type of rounding
 * specified by v3.  Result placed in location vres.
 */
void
roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    NUMBER *q1, *q2;
    COMPLEX *c;
    long places, rnd;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type == V_MAT) {
        vres->v_mat = matround(v1->v_mat, v2, v3);
        return;
    }
    if (v1->v_type == V_LIST) {
        vres->v_list = listround(v1->v_list, v2, v3);
        return;
    }
    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_ROUND, v1, v2, v3);
        return;
    }
    places = 0;
    switch (v2->v_type) {
    case V_NUM:
        if (qisfrac(v2->v_num)) {
            *vres = error_value(E_ROUND_2);
            return;
        }
        places = qtoi(v2->v_num);
        break;
    case V_NULL:
        break;
    default:
        *vres = error_value(E_ROUND_2);
        return;
    }
    rnd = 0;
    switch (v3->v_type) {
    case V_NUM:
        if (qisfrac(v3->v_num)) {
            *vres = error_value(E_ROUND_3);
            return;
        }
        rnd = qtoi(v3->v_num);
        break;
    case V_NULL:
        rnd = conf->round;
        break;
    default:
        *vres = error_value(E_ROUND_3);
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        vres->v_num = qround(v1->v_num, places, rnd);
        return;
    case V_COM:
        q1 = qround(v1->v_com->real, places, rnd);
        q2 = qround(v1->v_com->imag, places, rnd);
        if (qiszero(q2)) {
            vres->v_type = V_NUM;
            vres->v_num = q1;
            qfree(q2);
            return;
        }
        c = comalloc();
        qfree(c->real);
        qfree(c->imag);
        c->real = q1;
        c->imag = q2;
        vres->v_com = c;
        return;
    default:
        if (v1->v_type <= 0) {
            return;
        }
        *vres = error_value(E_ROUND_1);
        return;
    }
}

/*
 * Round numbers to number of binary digits specified by v2, type of rounding
 * specified by v3.  Result placed in location vres.
 */
void
broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    NUMBER *q1, *q2;
    COMPLEX *c;
    long places, rnd;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type == V_MAT) {
        vres->v_mat = matbround(v1->v_mat, v2, v3);
        return;
    }
    if (v1->v_type == V_LIST) {
        vres->v_list = listbround(v1->v_list, v2, v3);
        return;
    }
    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_BROUND, v1, v2, v3);
        return;
    }
    places = 0;
    switch (v2->v_type) {
    case V_NUM:
        if (qisfrac(v2->v_num)) {
            *vres = error_value(E_BROUND_2);
            return;
        }
        places = qtoi(v2->v_num);
        break;
    case V_NULL:
        break;
    default:
        *vres = error_value(E_BROUND_2);
        return;
    }
    rnd = 0;
    switch (v3->v_type) {
    case V_NUM:
        if (qisfrac(v3->v_num)) {
            *vres = error_value(E_BROUND_3);
            return;
        }
        rnd = qtoi(v3->v_num);
        break;
    case V_NULL:
        rnd = conf->round;
        break;
    default:
        *vres = error_value(E_BROUND_3);
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        vres->v_num = qbround(v1->v_num, places, rnd);
        return;
    case V_COM:
        q1 = qbround(v1->v_com->real, places, rnd);
        q2 = qbround(v1->v_com->imag, places, rnd);
        if (qiszero(q2)) {
            vres->v_type = V_NUM;
            vres->v_num = q1;
            qfree(q2);
            return;
        }
        c = comalloc();
        qfree(c->real);
        qfree(c->imag);
        c->real = q1;
        c->imag = q2;
        vres->v_com = c;
        return;
    default:
        if (v1->v_type <= 0) {
            return;
        }
        *vres = error_value(E_BROUND_1);
        return;
    }
}

/*
 * Take the integer part of an arbitrary value.
 * Result is placed in the indicated location.
 */
void
intvalue(VALUE *vp, VALUE *vres)
{
    COMPLEX *c;

    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        if (qisint(vp->v_num)) {
            vres->v_num = qlink(vp->v_num);
        } else {
            vres->v_num = qint(vp->v_num);
        }
        return;
    case V_COM:
        if (cisint(vp->v_com)) {
            vres->v_com = clink(vp->v_com);
            return;
        }
        vres->v_com = c_int(vp->v_com);
        c = vres->v_com;
        if (cisreal(c)) {
            vres->v_num = qlink(c->real);
            vres->v_type = V_NUM;
            comfree(c);
        }
        return;
    case V_MAT:
        vres->v_mat = matint(vp->v_mat);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type <= 0) {
            return;
        }
        *vres = error_value(E_INT);
        return;
    }
}

/*
 * Take the fractional part of an arbitrary value.
 * Result is placed in the indicated location.
 */
void
fracvalue(VALUE *vp, VALUE *vres)
{
    COMPLEX *c;

    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        if (qisint(vp->v_num)) {
            vres->v_num = qlink(&_qzero_);
        } else {
            vres->v_num = qfrac(vp->v_num);
        }
        return;
    case V_COM:
        if (cisint(vp->v_com)) {
            vres->v_num = clink(&_qzero_);
            vres->v_type = V_NUM;
            return;
        }
        vres->v_com = c_frac(vp->v_com);
        c = vres->v_com;
        if (cisreal(c)) {
            vres->v_num = qlink(c->real);
            vres->v_type = V_NUM;
            comfree(c);
        }
        return;
    case V_MAT:
        vres->v_mat = matfrac(vp->v_mat);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type < 0) {
            return;
        }
        *vres = error_value(E_FRAC);
        return;
    }
}

/*
 * Increment an arbitrary value by one.
 * Result is placed in the indicated location.
 */
void
incvalue(VALUE *vp, VALUE *vres)
{
    vres->v_type = vp->v_type;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qinc(vp->v_num);
        break;
    case V_COM:
        vres->v_com = c_addq(vp->v_com, &_qone_);
        break;
    case V_OBJ:
        *vres = objcall(OBJ_INC, vp, NULL_VALUE, NULL_VALUE);
        break;
    case V_OCTET:
        *vres->v_octet = *vp->v_octet + 1;
        break;
    case V_OPTR:
        vres->v_octet = vp->v_octet + 1;
        break;
    case V_VPTR:
#if defined(PERMIT_DANGEROUS_ADDRESS_ARITHMETIC)

        /* NOTE: Defining PERMIT_DANGEROUS_ADDRESS_ARITHMETIC is NOT supported! */
        vres->v_addr = vp->v_addr + 1;

#else
        *vres = error_value(E_INVALID_ADDR_OP);

#endif
        break;
    default:
        if (vp->v_type > 0) {
            *vres = error_value(E_INCV);
        }
        break;
    }
    vres->v_subtype = vp->v_subtype;
}

/*
 * Decrement an arbitrary value by one.
 * Result is placed in the indicated location.
 */
void
decvalue(VALUE *vp, VALUE *vres)
{
    vres->v_type = vp->v_type;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qdec(vp->v_num);
        break;
    case V_COM:
        vres->v_com = c_addq(vp->v_com, &_qnegone_);
        break;
    case V_OBJ:
        *vres = objcall(OBJ_DEC, vp, NULL_VALUE, NULL_VALUE);
        break;
    case V_OCTET:
        *vres->v_octet = *vp->v_octet - 1;
        break;
    case V_OPTR:
        vres->v_octet = vp->v_octet - 1;
        break;
    case V_VPTR:
#if defined(PERMIT_DANGEROUS_ADDRESS_ARITHMETIC)

        /* NOTE: Defining PERMIT_DANGEROUS_ADDRESS_ARITHMETIC is NOT supported! */
        vres->v_addr = vp->v_addr - 1;

#else

        *vres = error_value(E_INVALID_ADDR_OP);

#endif
        break;
    default:
        if (vp->v_type >= 0) {
            *vres = error_value(E_DECV);
        }
        break;
    }
    vres->v_subtype = vp->v_subtype;
}

/*
 * Produce the 'conjugate' of an arbitrary value.
 * Result is placed in the indicated location.
 * (Example: complex conjugate.)
 */
void
conjvalue(VALUE *vp, VALUE *vres)
{
    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qlink(vp->v_num);
        return;
    case V_COM:
        vres->v_com = comalloc();
        qfree(vres->v_com->real);
        qfree(vres->v_com->imag) vres->v_com->real = qlink(vp->v_com->real);
        vres->v_com->imag = qneg(vp->v_com->imag);
        return;
    case V_MAT:
        vres->v_mat = matconj(vp->v_mat);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type <= 0) {
            vres->v_type = vp->v_type;
            return;
        }
        *vres = error_value(E_CONJ);
        return;
    }
}

/*
 * Take the square root of an arbitrary value within the specified error.
 * Result is placed in the indicated location.
 */
void
sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    NUMBER *q, *tmp;
    COMPLEX *c;
    long R;

    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_SQRT, v1, v2, v3);
        return;
    }
    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        vres->v_type = v1->v_type;
        return;
    }
    if (v2->v_type == V_NULL) {
        q = conf->epsilon;
    } else {
        if (v2->v_type != V_NUM || qiszero(v2->v_num)) {
            *vres = error_value(E_SQRT_2);
            return;
        }
        q = v2->v_num;
    }
    if (v3->v_type == V_NULL) {
        R = conf->sqrt;
    } else {
        if (v3->v_type != V_NUM || qisfrac(v3->v_num)) {
            *vres = error_value(E_SQRT_3);
            return;
        }
        R = qtoi(v3->v_num);
    }
    switch (v1->v_type) {
    case V_NUM:
        if (!qisneg(v1->v_num)) {
            vres->v_num = qsqrt(v1->v_num, q, R);
            return;
        }
        tmp = qneg(v1->v_num);
        c = comalloc();
        qfree(c->imag);
        c->imag = qsqrt(tmp, q, R);
        qfree(tmp);
        vres->v_com = c;
        vres->v_type = V_COM;
        break;
    case V_COM:
        vres->v_com = c_sqrt(v1->v_com, q, R);
        break;
    default:
        *vres = error_value(E_SQRT_1);
        return;
    }
    c = vres->v_com;
    if (cisreal(c)) {
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
    }
}

/*
 * Take the Nth root of an arbitrary value within the specified error.
 * Result is placed in the indicated location.
 *
 * given:
 *      v1              value to take root of
 *      v2              value specifying root to take
 *      v3              value specifying error
 *      vres            result
 */
void
rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    NUMBER *q2, *q3;
    COMPLEX ctmp;
    COMPLEX *c;

    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        vres->v_type = v1->v_type;
        return;
    }
    if (v2->v_type != V_NUM) {
        *vres = error_value(E_ROOT_2);
        return;
    }
    q2 = v2->v_num;
    if (qisneg(q2) || qiszero(q2) || qisfrac(q2)) {
        *vres = error_value(E_ROOT_2);
        return;
    }
    if (v3->v_type != V_NUM || qiszero(v3->v_num)) {
        *vres = error_value(E_ROOT_3);
        return;
    }
    q3 = v3->v_num;
    switch (v1->v_type) {
    case V_NUM:
        if (!qisneg(v1->v_num)) {
            vres->v_num = qroot(v1->v_num, q2, q3);
            if (vres->v_num == NULL) {
                *vres = error_value(E_ROOT_4);
            }
            vres->v_type = V_NUM;
            return;
        }
        ctmp.real = v1->v_num;
        ctmp.imag = &_qzero_;
        ctmp.links = 1;
        c = c_root(&ctmp, q2, q3);
        break;
    case V_COM:
        c = c_root(v1->v_com, q2, q3);
        break;
    case V_OBJ:
        *vres = objcall(OBJ_ROOT, v1, v2, v3);
        return;
    default:
        *vres = error_value(E_ROOT_1);
        return;
    }
    if (c == NULL) {
        *vres = error_value(E_ROOT_4);
        return;
    }
    vres->v_com = c;
    vres->v_type = V_COM;
    if (cisreal(c)) {
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
    }
}

/*
 * Take the absolute value of an arbitrary value within the specified error.
 * Result is placed in the indicated location.
 */
void
absvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    static NUMBER *q;

    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_ABS, v1, v2, NULL_VALUE);
        return;
    }
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        vres->v_type = v1->v_type;
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        if (qisneg(v1->v_num)) {
            q = qneg(v1->v_num);
        } else {
            q = qlink(v1->v_num);
        }
        break;
    case V_COM:
        if (v2->v_type != V_NUM || qiszero(v2->v_num)) {
            *vres = error_value(E_ABS_2);
            return;
        }
        q = qhypot(v1->v_com->real, v1->v_com->imag, v2->v_num);
        break;
    default:
        *vres = error_value(E_ABS_1);
        return;
    }
    vres->v_num = q;
    vres->v_type = V_NUM;
}

/*
 * Calculate the norm of an arbitrary value.
 * Result is placed in the indicated location.
 * The norm is the square of the absolute value.
 */
void
normvalue(VALUE *vp, VALUE *vres)
{
    NUMBER *q1, *q2;

    vres->v_type = vp->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (vp->v_type <= 0) {
        vres->v_type = vp->v_type;
        return;
    }
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qsquare(vp->v_num);
        return;
    case V_COM:
        q1 = qsquare(vp->v_com->real);
        q2 = qsquare(vp->v_com->imag);
        vres->v_num = qqadd(q1, q2);
        vres->v_type = V_NUM;
        qfree(q1);
        qfree(q2);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_NORM, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        *vres = error_value(E_NORM);
        return;
    }
}

/*
 * Shift a value left or right by the specified number of bits.
 * Negative shift value means shift the direction opposite the selected dir.
 * Right shifts are defined to lose bits off the low end of the number.
 * Result is placed in the indicated location.
 *
 * given:
 *      v1              value to shift
 *      v2              shift amount
 *      rightshift      true if shift right instead of left
 *      vres            result
 */
void
shiftvalue(VALUE *v1, VALUE *v2, bool rightshift, VALUE *vres)
{
    COMPLEX *c;
    long n = 0;
    unsigned int ch;
    VALUE tmp;

    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        vres->v_type = v1->v_type;
        return;
    }
    if ((v2->v_type != V_NUM) || (qisfrac(v2->v_num))) {
        *vres = error_value(E_SHIFT_2);
        return;
    }
    if (v1->v_type != V_OBJ) {
        if (zge31b(v2->v_num->num)) {
            *vres = error_value(E_SHIFT_2);
            return;
        }
        n = qtoi(v2->v_num);
    }
    if (rightshift) {
        n = -n;
    }
    vres->v_type = v1->v_type;
    switch (v1->v_type) {
    case V_NUM:
        if (qisfrac(v1->v_num)) {
            *vres = error_value(E_SHIFT_1);
            return;
        }
        vres->v_num = qshift(v1->v_num, n);
        return;
    case V_COM:
        if (qisfrac(v1->v_com->real) || qisfrac(v1->v_com->imag)) {
            *vres = error_value(E_SHIFT_1);
            return;
        }
        c = c_shift(v1->v_com, n);
        if (!cisreal(c)) {
            vres->v_com = c;
            return;
        }
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
        return;
    case V_MAT:
        vres->v_mat = matshift(v1->v_mat, n);
        return;
    case V_STR:
        vres->v_str = stringshift(v1->v_str, n);
        if (vres->v_str == NULL) {
            *vres = error_value(E_STRSHIFT);
        }
        return;
    case V_OCTET:
        vres->v_type = V_STR;
        if (n >= 8 || n <= -8) {
            ch = 0;
        } else if (n >= 0) {
            ch = (unsigned int)*v1->v_octet << n;
        } else {
            ch = (unsigned int)*v1->v_octet >> -n;
        }
        vres->v_str = charstring(ch);
        return;
    case V_OBJ:
        if (!rightshift) {
            *vres = objcall(OBJ_SHIFT, v1, v2, NULL_VALUE);
            return;
        }
        tmp.v_num = qneg(v2->v_num);
        tmp.v_type = V_NUM;
        *vres = objcall(OBJ_SHIFT, v1, &tmp, NULL_VALUE);
        qfree(tmp.v_num);
        return;
    default:
        *vres = error_value(E_SHIFT_1);
        return;
    }
}

/*
 * Scale a value by a power of two.
 * Result is placed in the indicated location.
 */
void
scalevalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    long n = 0;

    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        vres->v_type = v1->v_type;
        return;
    }
    if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) {
        *vres = error_value(E_SCALE_2);
        return;
    }
    if (v1->v_type != V_OBJ) {
        if (zge31b(v2->v_num->num)) {
            *vres = error_value(E_SCALE_2);
            return;
        }
        n = qtoi(v2->v_num);
    }
    vres->v_type = v1->v_type;
    switch (v1->v_type) {
    case V_NUM:
        vres->v_num = qscale(v1->v_num, n);
        return;
    case V_COM:
        vres->v_com = c_scale(v1->v_com, n);
        return;
    case V_MAT:
        vres->v_mat = matscale(v1->v_mat, n);
        return;
    case V_OBJ:
        *vres = objcall(OBJ_SCALE, v1, v2, NULL_VALUE);
        return;
    default:
        *vres = error_value(E_SCALE_1);
        return;
    }
}

/*
 * Raise a value to an power.
 * Result is placed in the indicated location.
 */
void
powvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    NUMBER *real_v2; /* real part of v2 */
    COMPLEX *c;

    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_POW, v1, v2, NULL_VALUE);
        return;
    }
    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0 && v1->v_type != -E_DIVBYZERO) {
        return;
    }
    if (v2->v_type <= 0) {
        vres->v_type = v2->v_type;
        return;
    }
    real_v2 = v2->v_num;

    /* case: raising to a real power */
    switch (v2->v_type) {
    case V_NUM:

        /* deal with the division by 0 value */
        if (v1->v_type == -E_DIVBYZERO) {
            if (qisneg(real_v2)) {
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
            } else {
                vres->v_type = -E_DIVBYZERO;
            }
            break;
        }

        /* raise something with a real exponent */
        switch (v1->v_type) {
        case V_NUM:
            if (qiszero(v1->v_num)) {
                if (qisneg(real_v2)) {
                    *vres = error_value(E_DIVBYZERO);
                    break;
                }
                vres->v_type = V_NUM;
                if (qiszero(v2->v_num)) {
                    /* 0 ^ 0 is 1 */
                    vres->v_num = qlink(&_qone_);
                } else {
                    /* 0 ^ (exp>0) is 0 */
                    vres->v_num = qlink(&_qzero_);
                }
            } else if (qisint(real_v2)) {
                vres->v_num = qpowi(v1->v_num, real_v2);
            } else {
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
                powervalue(v1, v2, NULL, vres);
            }
            break;
        case V_COM:
            if (qisint(real_v2)) {
                vres->v_com = c_powi(v1->v_com, real_v2);
            } else {
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
                powervalue(v1, v2, NULL, vres);
            }
            if (vres->v_type == V_COM) {
                c = vres->v_com;
                if (!cisreal(c)) {
                    break;
                }
                vres->v_num = qlink(c->real);
                vres->v_type = V_NUM;
                comfree(c);
            }
            break;
        case V_MAT:
            vres->v_mat = matpowi(v1->v_mat, real_v2);
            break;
        default:
            *vres = error_value(E_POWI_1);
            break;
        }
        break;

    case V_COM:

        /* deal with the division by 0 value */
        if (v1->v_type == -E_DIVBYZERO) {
            if (cisreal(v2->v_com) && qisneg(real_v2)) {
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
            } else {
                vres->v_type = -E_DIVBYZERO;
            }
            break;
        }

        /* raise something with a real exponent */
        switch (v1->v_type) {
        case V_NUM:
            if (qiszero(v1->v_num)) {
                if (cisreal(v2->v_com) && qisneg(real_v2)) {
                    *vres = error_value(E_DIVBYZERO);
                    break;
                }
                /*
                 * 0 ^ real non-neg is zero
                 * 0 ^ complex is zero
                 */
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
            }
            if (cisreal(v2->v_com) && qisint(real_v2)) {
                vres->v_num = qpowi(v1->v_num, real_v2);
            } else {
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
                powervalue(v1, v2, NULL, vres);
            }
            if (vres->v_type == V_COM) {
                c = vres->v_com;
                if (!cisreal(c)) {
                    break;
                }
                vres->v_num = qlink(c->real);
                vres->v_type = V_NUM;
                comfree(c);
            }
            break;
        case V_COM:
            if (cisreal(v2->v_com) && qisint(real_v2)) {
                vres->v_com = c_powi(v1->v_com, real_v2);
            } else {
                vres->v_type = V_NUM;
                vres->v_num = qlink(&_qzero_);
                powervalue(v1, v2, NULL, vres);
            }
            if (vres->v_type == V_COM) {
                c = vres->v_com;
                if (!cisreal(c)) {
                    break;
                }
                vres->v_num = qlink(c->real);
                vres->v_type = V_NUM;
                comfree(c);
            }
            break;
        default:
            *vres = error_value(E_POWI_1);
            break;
        }
        break;

    /* unsupported exponent type */
    default:
        *vres = error_value(E_POWI_2);
        break;
    }
    return;
}

/*
 * Raise one value to another value's power, within the specified error.
 * Result is placed in the indicated location.  If v3 is NULL, the
 * value conf->epsilon is used.
 */
void
powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */
    NUMBER *epsilon;
    COMPLEX *c = NULL, ctmp1, ctmp2;

    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        vres->v_type = v1->v_type;
        return;
    }
    if (v1->v_type != V_NUM && v1->v_type != V_COM) {
        *vres = error_value(E_POWER_1);
        return;
    }
    if (v2->v_type != V_NUM && v2->v_type != V_COM) {
        *vres = error_value(E_POWER_2);
        return;
    }

    /* NULL epsilon means use built-in epsilon value */
    if (v3 == NULL) {
        epsilon = conf->epsilon;
    } else {
        if (v3->v_type != V_NUM || qiszero(v3->v_num)) {
            *vres = error_value(E_POWER_3);
            return;
        }
        epsilon = v3->v_num;
    }
    if (qiszero(epsilon)) {
        *vres = error_value(E_POWER_3);
        return;
    }

    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        if (qisneg(v1->v_num)) {
            ctmp1.real = v1->v_num;
            ctmp1.imag = &_qzero_;
            ctmp1.links = 1;
            ctmp2.real = v2->v_num;
            ctmp2.imag = &_qzero_;
            ctmp2.links = 1;
            c = c_power(&ctmp1, &ctmp2, epsilon);
            break;
        }
        vres->v_num = qpower(v1->v_num, v2->v_num, epsilon);
        vres->v_type = V_NUM;
        if (vres->v_num == NULL) {
            *vres = error_value(E_POWER_4);
        }
        return;
    case TWOVAL(V_NUM, V_COM):
        ctmp1.real = v1->v_num;
        ctmp1.imag = &_qzero_;
        ctmp1.links = 1;
        c = c_power(&ctmp1, v2->v_com, epsilon);
        break;
    case TWOVAL(V_COM, V_NUM):
        ctmp2.real = v2->v_num;
        ctmp2.imag = &_qzero_;
        ctmp2.links = 1;
        c = c_power(v1->v_com, &ctmp2, epsilon);
        break;
    case TWOVAL(V_COM, V_COM):
        c = c_power(v1->v_com, v2->v_com, epsilon);
        break;
    default:
        *vres = error_value(E_POWER_1);
        return;
    }
    /*
     * Here for any complex result.
     */
    if (c == NULL) {
        *vres = error_value(E_POWER_4);
        return;
    }
    vres->v_type = V_COM;
    vres->v_com = c;
    if (cisreal(c)) {
        vres->v_num = qlink(c->real);
        vres->v_type = V_NUM;
        comfree(c);
    }
}

/*
 * Divide one arbitrary value by another one.
 * Result is placed in the indicated location.
 */
void
divvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    unsigned int twoval_as_uint; /* TWOVAL(a,b) or TWOVAL_INVALID */
    COMPLEX *c;
    COMPLEX ctmp;
    NUMBER *q;
    VALUE tmpval;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        return;
    }
    if (v2->v_type <= 0) {
        if (testvalue(v1) && v2->v_type == -E_DIVBYZERO) {
            vres->v_type = V_NUM;
            vres->v_num = qlink(&_qzero_);
        } else {
            vres->v_type = v2->v_type;
        }
        return;
    }
    if (!testvalue(v2)) {
        if (testvalue(v1)) {
            *vres = error_value(E_DIVBYZERO);
        } else {
            *vres = error_value(E_ZERODIVZERO);
        }
        return;
    }
    vres->v_type = v1->v_type;
    twoval_as_uint = TWOVAL_AS_UINT(v1->v_type, v2->v_type);
    switch (twoval_as_uint) {
    case TWOVAL(V_NUM, V_NUM):
        vres->v_num = qqdiv(v1->v_num, v2->v_num);
        return;
    case TWOVAL(V_COM, V_NUM):
        vres->v_com = c_divq(v1->v_com, v2->v_num);
        return;
    case TWOVAL(V_NUM, V_COM):
        if (qiszero(v1->v_num)) {
            vres->v_num = qlink(&_qzero_);
            return;
        }
        ctmp.real = v1->v_num;
        ctmp.imag = &_qzero_;
        ctmp.links = 1;
        vres->v_com = c_div(&ctmp, v2->v_com);
        vres->v_type = V_COM;
        return;
    case TWOVAL(V_COM, V_COM):
        vres->v_com = c_div(v1->v_com, v2->v_com);
        c = vres->v_com;
        if (cisreal(c)) {
            vres->v_num = qlink(c->real);
            vres->v_type = V_NUM;
            comfree(c);
        }
        return;
    case TWOVAL(V_MAT, V_NUM):
    case TWOVAL(V_MAT, V_COM):
        invertvalue(v2, &tmpval);
        vres->v_mat = matmulval(v1->v_mat, &tmpval);
        freevalue(&tmpval);
        return;
    case TWOVAL(V_STR, V_NUM):
        q = qinv(v2->v_num);
        vres->v_str = stringmul(q, v1->v_str);
        qfree(q);
        if (vres->v_str == NULL) {
            *vres = error_value(E_DIV);
        }
        return;
    default:
        if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
            *vres = error_value(E_DIV);
            return;
        }
        *vres = objcall(OBJ_DIV, v1, v2, NULL_VALUE);
        return;
    }
}

/*
 * Divide one arbitrary value by another one keeping only the integer part.
 * Result is placed in the indicated location.
 */
void
quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    COMPLEX *c;
    NUMBER *q1, *q2;
    long rnd;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        return;
    }

    if (v1->v_type == V_MAT) {
        vres->v_mat = matquoval(v1->v_mat, v2, v3);
        return;
    }
    if (v1->v_type == V_LIST) {
        vres->v_list = listquo(v1->v_list, v2, v3);
        return;
    }
    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_QUO, v1, v2, v3);
        return;
    }
    if (v2->v_type <= 0) {
        vres->v_type = v2->v_type;
        return;
    }
    if (v2->v_type != V_NUM) {
        *vres = error_value(E_QUO_2);
        return;
    }
    rnd = 0;
    switch (v3->v_type) {
    case V_NUM:
        if (qisfrac(v3->v_num)) {
            *vres = error_value(E_QUO_3);
            return;
        }
        rnd = qtoi(v3->v_num);
        break;
    case V_NULL:
        rnd = conf->quo;
        break;
    default:
        *vres = error_value(E_QUO_3);
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        vres->v_num = qquo(v1->v_num, v2->v_num, rnd);
        return;
    case V_COM:
        q1 = qquo(v1->v_com->real, v2->v_num, rnd);
        q2 = qquo(v1->v_com->imag, v2->v_num, rnd);
        if (qiszero(q2)) {
            qfree(q2);
            vres->v_type = V_NUM;
            vres->v_num = q1;
            return;
        }
        c = comalloc();
        qfree(c->real);
        qfree(c->imag);
        c->real = q1;
        c->imag = q2;
        vres->v_com = c;
        return;
    default:
        *vres = error_value(E_QUO_1);
        return;
    }
}

/*
 * Divide one arbitrary value by another one keeping only the remainder.
 * Result is placed in the indicated location.
 */
void
modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
    COMPLEX *c;
    NUMBER *q1, *q2;
    long rnd;

    vres->v_type = v1->v_type;
    vres->v_subtype = V_NOSUBTYPE;
    if (v1->v_type <= 0) {
        return;
    }

    if (v1->v_type == V_MAT) {
        vres->v_mat = matmodval(v1->v_mat, v2, v3);
        return;
    }
    if (v1->v_type == V_LIST) {
        vres->v_list = listmod(v1->v_list, v2, v3);
        return;
    }
    if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
        *vres = objcall(OBJ_MOD, v1, v2, v3);
        return;
    }
    if (v2->v_type <= 0) {
        vres->v_type = v2->v_type;
        return;
    }
    if (v2->v_type != V_NUM) {
        *vres = error_value(E_MOD_2);
        return;
    }
    rnd = 0;
    switch (v3->v_type) {
    case V_NUM:
        if (qisfrac(v3->v_num)) {
            *vres = error_value(E_MOD_3);
            return;
        }
        rnd = qtoi(v3->v_num);
        break;
    case V_NULL:
        rnd = conf->mod;
        break;
    default:
        *vres = error_value(E_MOD_3);
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        vres->v_num = qmod(v1->v_num, v2->v_num, rnd);
        return;
    case V_COM:
        q1 = qmod(v1->v_com->real, v2->v_num, rnd);
        q2 = qmod(v1->v_com->imag, v2->v_num, rnd);
        if (qiszero(q2)) {
            qfree(q2);
            vres->v_type = V_NUM;
            vres->v_num = q1;
            return;
        }
        c = comalloc();
        qfree(c->real);
        qfree(c->imag);
        c->real = q1;
        c->imag = q2;
        vres->v_com = c;
        return;
    default:
        *vres = error_value(E_MOD_1);
        return;
    }
}

/*
 * Test an arbitrary value to see if it is equal to "zero".
 * The definition of zero varies depending on the value type.  For example,
 * the null string is "zero", and a matrix with zero values is "zero".
 * Returns true if value is not equal to zero.
 */
bool
testvalue(VALUE *vp)
{
    VALUE val;
    LISTELEM *ep;
    int i;

    switch (vp->v_type) {
    case V_NUM:
        return !qiszero(vp->v_num);
    case V_COM:
        return !ciszero(vp->v_com);
    case V_STR:
        return stringtest(vp->v_str);
    case V_MAT:
        return mattest(vp->v_mat);
    case V_LIST:
        for (ep = vp->v_list->l_first; ep; ep = ep->e_next) {
            if (testvalue(&ep->e_value)) {
                return true;
            }
        }
        return false;
    case V_ASSOC:
        return (vp->v_assoc->a_count != 0);
    case V_FILE:
        return validid(vp->v_file);
    case V_NULL:
        break;
    case V_OBJ:
        val = objcall(OBJ_TEST, vp, NULL_VALUE, NULL_VALUE);
        return (val.v_int != 0);
    case V_BLOCK:
        for (i = 0; i < vp->v_block->datalen; ++i) {
            if (vp->v_block->data[i]) {
                return true;
            }
        }
        return false;
    case V_OCTET:
        return (*vp->v_octet != 0);
    case V_NBLOCK:
        if (vp->v_nblock->blk->data == NULL) {
            return false;
        }
        for (i = 0; i < vp->v_nblock->blk->datalen; ++i) {
            if (vp->v_nblock->blk->data[i]) {
                return true;
            }
        }
        return false;
    default:
        return true;
    }
    return false;
}

/*
 * Compare two values for equality.
 * Returns true if the two values differ.
 */
bool
comparevalue(VALUE *v1, VALUE *v2)
{
    int r = false;
    VALUE val;

    if ((v1->v_type == V_OBJ) || (v2->v_type == V_OBJ)) {
        val = objcall(OBJ_CMP, v1, v2, NULL_VALUE);
        return (val.v_int != 0);
    }
    if (v1 == v2) {
        return false;
    }
    if (v1->v_type == V_OCTET) {
        if (v2->v_type == V_OCTET) {
            return (*v1->v_octet != *v2->v_octet);
        }
        if (v2->v_type == V_STR) {
            return (*v1->v_octet != (OCTET)*v2->v_str->s_str) || (v2->v_str->s_len != 1);
        }
        if (v2->v_type != V_NUM || qisfrac(v2->v_num) || qisneg(v2->v_num) || v2->v_num->num.len > 1) {
            return true;
        }
        return (*v2->v_num->num.v != *v1->v_octet);
    }
    if (v2->v_type == V_OCTET) {
        return comparevalue(v2, v1);
    }
    if (v1->v_type != v2->v_type) {
        return true;
    }
    if (v1->v_type <= 0) {
        return false;
    }
    switch (v1->v_type) {
    case V_NUM:
        r = qcmp(v1->v_num, v2->v_num);
        break;
    case V_COM:
        r = c_cmp(v1->v_com, v2->v_com);
        break;
    case V_STR:
        r = stringcmp(v1->v_str, v2->v_str);
        break;
    case V_MAT:
        r = matcmp(v1->v_mat, v2->v_mat);
        break;
    case V_LIST:
        r = listcmp(v1->v_list, v2->v_list);
        break;
    case V_ASSOC:
        r = assoccmp(v1->v_assoc, v2->v_assoc);
        break;
    case V_FILE:
        r = (v1->v_file != v2->v_file);
        break;
    case V_RAND:
        r = randcmp(v1->v_rand, v2->v_rand);
        break;
    case V_RANDOM:
        r = randomcmp(v1->v_random, v2->v_random);
        break;
    case V_CONFIG:
        r = config_cmp(v1->v_config, v2->v_config);
        break;
    case V_HASH:
        r = hash_cmp(v1->v_hash, v2->v_hash);
        break;
    case V_BLOCK:
        r = blk_cmp(v1->v_block, v2->v_block);
        break;
    case V_OCTET:
        r = (v1->v_octet != v2->v_octet);
        break;
    case V_NBLOCK:
        return (v1->v_nblock != v2->v_nblock);
    case V_VPTR:
        return (v1->v_addr != v2->v_addr);
    case V_OPTR:
        return (v1->v_octet != v2->v_octet);
    case V_SPTR:
        return (v1->v_str != v2->v_str);
    case V_NPTR:
        return (v1->v_num != v2->v_num);
    default:
        math_error("Illegal values for comparevalue");
        not_reached();
    }
    return (r != 0);
}

bool
acceptvalue(VALUE *v1, VALUE *v2)
{
    long index;
    FUNC *fp;
    bool ret;

    index = adduserfunc("accept");
    fp = findfunc(index);
    if (fp) {
        ++stack;
        stack->v_type = V_ADDR;
        stack->v_subtype = V_NOSUBTYPE;
        stack->v_addr = v1;
        ++stack;
        stack->v_type = V_ADDR;
        stack->v_subtype = V_NOSUBTYPE;
        stack->v_addr = v2;
        calculate(fp, 2);
        ret = testvalue(stack);
        freevalue(stack--);
        return ret;
    }
    return (!comparevalue(v1, v2));
}

bool
precvalue(VALUE *v1, VALUE *v2)
{
    VALUE val;
    long index;
    int r = 0;
    FUNC *fp;
    bool ret;

    index = adduserfunc("precedes");
    fp = findfunc(index);
    if (fp) {
        ++stack;
        stack->v_type = V_ADDR;
        stack->v_subtype = V_NOSUBTYPE;
        stack->v_addr = v1;
        ++stack;
        stack->v_type = V_ADDR;
        stack->v_subtype = V_NOSUBTYPE;
        stack->v_addr = v2;
        calculate(fp, 2);
        ret = testvalue(stack);
        freevalue(stack--);
        return ret;
    }
    relvalue(v1, v2, &val);
    if ((val.v_type == V_NUM && qisneg(val.v_num)) || (val.v_type == V_COM && qisneg(val.v_com->imag))) {
        r = 1;
    }
    if (val.v_type == V_NULL) {
        r = (v1->v_type < v2->v_type);
    }
    freevalue(&val);
    return r;
}

VALUE
signval(int r)
{
    VALUE val;

    val.v_type = V_NUM;
    val.v_subtype = V_NOSUBTYPE;
    if (r > 0) {
        val.v_num = qlink(&_qone_);
    } else if (r < 0) {
        val.v_num = qlink(&_qnegone_);
    } else {
        val.v_num = qlink(&_qzero_);
    }
    return val;
}

/*
 * Compare two values for their relative values.
 * Result is placed in the indicated location.
 */
void
relvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
    int r = 0;
    int i = 0;
    NUMBER *q;
    COMPLEX *c;

    vres->v_subtype = V_NOSUBTYPE;
    vres->v_type = V_NULL;
    if ((v1->v_type == V_OBJ) || (v2->v_type == V_OBJ)) {
        *vres = objcall(OBJ_REL, v1, v2, NULL_VALUE);
        return;
    }
    switch (v1->v_type) {
    case V_NUM:
        switch (v2->v_type) {
        case V_NUM:
            r = qrel(v1->v_num, v2->v_num);
            break;
        case V_OCTET:
            q = itoq((long)*v2->v_octet);
            r = qrel(v1->v_num, q);
            qfree(q);
            break;
        case V_COM:
            r = qrel(v1->v_num, v2->v_com->real);
            i = qrel(&_qzero_, v2->v_com->imag);
            break;
        default:
            return;
        }
        break;
    case V_COM:
        switch (v2->v_type) {
        case V_NUM:
            r = qrel(v1->v_com->real, v2->v_num);
            i = qrel(v1->v_com->imag, &_qzero_);
            break;
        case V_COM:
            r = qrel(v1->v_com->real, v2->v_com->real);
            i = qrel(v1->v_com->imag, v2->v_com->imag);
            break;
        case V_OCTET:
            q = itoq((long)*v2->v_octet);
            r = qrel(v1->v_com->real, q);
            qfree(q);
            i = qrel(v1->v_com->imag, &_qzero_);
            break;
        default:
            return;
        }
        break;
    case V_STR:
        switch (v2->v_type) {
        case V_STR:
            r = stringrel(v1->v_str, v2->v_str);
            break;
        case V_OCTET:
            r = (unsigned char)*v1->v_str->s_str - *v2->v_octet;
            if (r == 0) {
                if (v1->v_str->s_len == 0) {
                    r = -1;
                } else {
                    r = (v1->v_str->s_len > 1);
                }
            }
            break;
        default:
            return;
        }
        break;
    case V_OCTET:
        switch (v2->v_type) {
        case V_NUM:
            q = itoq((long)*v1->v_octet);
            r = qrel(q, v2->v_num);
            qfree(q);
            break;
        case V_COM:
            q = itoq((long)*v1->v_octet);
            r = qrel(q, v2->v_com->real);
            qfree(q);
            i = qrel(&_qzero_, v2->v_com->imag);
            break;
        case V_OCTET:
            r = *v1->v_octet - *v2->v_octet;
            break;
        case V_STR:
            r = *v1->v_octet - (unsigned char)*v2->v_str->s_str;
            if (r == 0) {
                if (v2->v_str->s_len == 0) {
                    r = 1;
                } else {
                    r = -(v2->v_str->s_len > 1);
                }
            }
            break;
        default:
            return;
        }
        break;
    case V_VPTR:
        if (v2->v_type != V_VPTR) {
            return;
        }
        r = (v1->v_addr - v2->v_addr);
        break;
    case V_OPTR:
        if (v2->v_type != V_OPTR) {
            return;
        }
        r = (v1->v_octet - v2->v_octet);
        break;
    default:
        return;
    }
    vres->v_type = V_NUM;
    *vres = signval(r);
    if (i == 0) {
        return;
    }
    c = comalloc();
    qfree(c->real);
    c->real = vres->v_num;
    *vres = signval(i);
    qfree(c->imag);
    c->imag = vres->v_num;
    vres->v_type = V_COM;
    vres->v_com = c;
    return;
}

/*
 * Find a value representing sign or signs in a value
 * Result is placed in the indicated location.
 */
void
sgnvalue(VALUE *vp, VALUE *vres)
{
    COMPLEX *c;

    vres->v_type = vp->v_type;
    switch (vp->v_type) {
    case V_NUM:
        vres->v_num = qsign(vp->v_num);
        vres->v_subtype = vp->v_subtype;
        return;
    case V_COM:
        c = comalloc();
        qfree(c->real);
        qfree(c->imag);
        c->real = qsign(vp->v_com->real);
        c->imag = qsign(vp->v_com->imag);
        vres->v_com = c;
        vres->v_type = V_COM;
        vres->v_subtype = V_NOSUBTYPE;
        return;
    case V_OCTET:
        vres->v_type = V_NUM;
        vres->v_subtype = V_NOSUBTYPE;
        vres->v_num = itoq((long)(*vp->v_octet != 0));
        return;
    case V_OBJ:
        *vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE);
        return;
    default:
        if (vp->v_type > 0) {
            *vres = error_value(E_SGN);
        }
        return;
    }
}

int
userfunc(char *fname, VALUE *vp)
{
    FUNC *fp;

    fp = findfunc(adduserfunc(fname));
    if (fp == NULL) {
        return 0;
    }
    ++stack;
    stack->v_addr = vp;
    stack->v_type = V_ADDR;
    stack->v_subtype = V_NOSUBTYPE;
    calculate(fp, 1);
    freevalue(stack--);
    return 1;
}

/*
 * Print the value of a descriptor in one of several formats.
 * If flags contains PRINT_SHORT, then elements of arrays and lists
 * will not be printed.  If flags contains PRINT_UNAMBIG, then quotes
 * are placed around strings and the null value is explicitly printed.
 */
void
printvalue(VALUE *vp, int flags)
{
    NUMBER *qtemp;
    int type;
    char *errsym;
    bool alloced;

    type = vp->v_type;
    if (type < 0) {
        if (userfunc("error_print", vp)) {
            return;
        }
        errsym = errnum_2_errsym(-type, &alloced);
        if (errsym == NULL) {
            if (-type >= E__BASE) {
                math_fmt("Error %d", -type);
            } else {
                math_fmt("System error %d", -type);
            }
        } else {
            if (-type >= E__BASE) {
                math_fmt("Error %s", errsym);
            } else {
                math_fmt("System error %s", errsym);
            }
            if (alloced == true) {
                free(errsym);
            }
        }
        return;
    }
    switch (type) {
    case V_NUM:
        qprintnum(vp->v_num, MODE_DEFAULT, conf->outdigits);
        if (conf->traceflags & TRACE_LINKS) {
            math_fmt("#%ld", vp->v_num->links);
        }
        break;
    case V_COM:
        comprint(vp->v_com);
        if (conf->traceflags & TRACE_LINKS) {
            math_fmt("##%ld", vp->v_com->links);
        }
        break;
    case V_STR:
        if (flags & PRINT_UNAMBIG) {
            math_chr('\"');
        }
        math_str(vp->v_str->s_str);
        if (flags & PRINT_UNAMBIG) {
            math_chr('\"');
        }
        break;
    case V_NULL:
        if (flags & PRINT_UNAMBIG) {
            math_str("NULL");
        }
        break;
    case V_OBJ:
        (void)objcall(OBJ_PRINT, vp, NULL_VALUE, NULL_VALUE);
        break;
    case V_LIST:
        if (!userfunc("list_print", vp)) {
            listprint(vp->v_list, ((flags & PRINT_SHORT) ? 0L : conf->maxprint));
        }
        break;
    case V_ASSOC:
        assocprint(vp->v_assoc, ((flags & PRINT_SHORT) ? 0L : conf->maxprint));
        break;
    case V_MAT:
        if (!userfunc("mat_print", vp)) {
            matprint(vp->v_mat, ((flags & PRINT_SHORT) ? 0L : conf->maxprint));
        }
        break;
    case V_FILE:
        if (!userfunc("file_print", vp)) {
            printid(vp->v_file, flags);
        }
        break;
    case V_RAND:
        randprint(vp->v_rand, flags);
        break;
    case V_RANDOM:
        randomprint(vp->v_random, flags);
        break;
    case V_CONFIG:
        config_print(vp->v_config);
        break;
    case V_HASH:
        hash_print(vp->v_hash);
        break;
    case V_BLOCK:
        if (!userfunc("blk_print", vp)) {
            blk_print(vp->v_block);
        }
        break;
    case V_OCTET:
        if (userfunc("octet_print", vp)) {
            break;
        }
        qtemp = itoq((long)*vp->v_octet);
        qprintnum(qtemp, MODE_DEFAULT, conf->outdigits);
        qfree(qtemp);
        break;
    case V_OPTR:
        math_fmt("o-ptr: %p", (void *)vp->v_octet);
        break;
    case V_VPTR:
        math_fmt("v-ptr: %p", (void *)vp->v_addr);
        break;
    case V_SPTR:
        math_fmt("s_ptr: %p", (void *)vp->v_str);
        break;
    case V_NPTR:
        math_fmt("n_ptr: %p", (void *)vp->v_num);
        break;
    case V_NBLOCK:
        if (!userfunc("nblk_print", vp)) {
            nblock_print(vp->v_nblock);
        }
        break;
    default:
        math_error("Printing unrecognized type of value");
        not_reached();
    }
}

/*
 * Print an exact text representation of a value
 */
void
printestr(VALUE *vp)
{
    LISTELEM *ep;
    MATRIX *mp;
    OBJECT *op;
    BLOCK *bp;
    int mode;
    long i, min, max;
    uint8_t *cp;

    if (vp->v_type < 0) {
        math_fmt("error(%d)", -vp->v_type);
        return;
    }
    switch (vp->v_type) {
    case V_NULL:
        math_str("\"\"");
        return;
    case V_STR:
        math_chr('"');
        strprint(vp->v_str);
        math_chr('"');
        return;
    case V_NUM:
        qprintnum(vp->v_num, MODE_FRAC, conf->outdigits);
        return;
    case V_COM:
        mode = math_setmode(MODE_FRAC);
        comprint(vp->v_com);
        math_setmode(mode);
        return;
    case V_LIST:
        math_str("list(");
        ep = vp->v_list->l_first;
        if (ep) {
            printestr(&ep->e_value);
            while ((ep = ep->e_next)) {
                math_chr(',');
                printestr(&ep->e_value);
            }
        }
        math_chr(')');
        return;
    case V_MAT:
        mp = vp->v_mat;
        if (mp->m_dim == 0) {
            math_str("(mat[])");
        } else {
            math_str("mat[");
            for (i = 0; i < mp->m_dim; i++) {
                min = mp->m_min[i];
                max = mp->m_max[i];
                if (i > 0) {
                    math_chr(',');
                }
                if (min) {
                    math_fmt("%ld:%ld", min, max);
                } else {
                    math_fmt("%ld", max + 1);
                }
            }
            math_chr(']');
        }
        i = mp->m_size;
        vp = mp->m_table;
        break;
    case V_OBJ:
        op = vp->v_obj;
        math_fmt("obj %s", objtypename(op->o_actions->oa_index));
        i = op->o_actions->oa_count;
        vp = op->o_table;
        break;
    case V_BLOCK:
    case V_NBLOCK:
        math_str("blk(");
        if (vp->v_type == V_BLOCK) {
            bp = vp->v_block;
        } else {
            math_fmt("\"%s\",", vp->v_nblock->name);
            bp = vp->v_nblock->blk;
        }
        i = bp->datalen;
        math_fmt("%ld,%d)", i, (int)bp->blkchunk);
        cp = bp->data;
        if (i > 0) {
            math_str("={");
            math_fmt("%d", *cp);
            while (--i > 0) {
                math_chr(',');
                math_fmt("%d", *++cp);
            }
            math_chr('}');
        }
        return;

    default:
        math_str("\"???\"");
        return;
    }
    if (i > 0) {
        math_str("={");
        printestr(vp);
        while (--i > 0) {
            math_chr(',');
            printestr(++vp);
        }
        math_chr('}');
    }
}

/*
 * config_print - print a configuration value
 *
 * given:
 *      cfg             what to print
 */
void
config_print(CONFIG *cfg)
{
    NAMETYPE *cp;
    VALUE tmp;
    int tab_over; /* true => OK move over one tab stop */
    size_t len;

    /*
     * firewall
     */
    if (cfg == NULL || cfg->epsilon == NULL || cfg->prompt1 == NULL || cfg->prompt2 == NULL) {
        math_error("CONFIG value is invalid");
        not_reached();
    }

    /*
     * print each element
     */
    tab_over = false;
    for (cp = configs; cp->name; cp++) {

        /* skip if special all or duplicate maxerr value */
        if (cp->type == CONFIG_ALL || strcmp(cp->name, "maxerr") == 0 || strcmp(cp->name, "ctrl-d") == 0) {
            continue;
        }

        /* print tab if allowed */
        if (tab_over) {
            math_str("\t");
        } else if (conf->tab_ok) {
            tab_over = true; /* tab next time */
        }

        /* print name and spaces */
        math_fmt("%s", cp->name);
        len = 16 - strlen(cp->name);
        while (len-- > 0) {
            math_str(" ");
        }

        /* print value */
        config_value(cfg, cp->type, &tmp);
        printvalue(&tmp, PRINT_SHORT | PRINT_UNAMBIG);
        freevalue(&tmp);
        if ((cp + 1)->name) {
            math_str("\n");
        }
    }
}
