/*
 * OpenComal -- a free Comal implementation
 *
 * This file is part of the OpenComal package.
 * (c) Copyright 1992-2024 Jos Visser <josvisser66@gmail.com>
 *
 * The OpenComal package is covered by the GNU General Public
 * License. See doc/LICENSE for more information.
 */

/* Routines to compile expressions OpenComal expressions */

#include "pdcglob.h"
#include "pdcmisc.h"
#include "pdccomp.h"
#include "pdccexp.h"

extern int short_circuit;

PRIVATE void morph(long *regis, enum VAL_TYPE *type, enum VAL_TYPE target_type) {
    long r;

    if (*type == target_type)
        return;

    r = get_register();
    emit2("%s=%s", regname1(r, target_type), regname2(*regis, *type));
    *regis = r;
    *type = target_type;
}


PUBLIC void compile_exp_lval(struct expression *exp, long *regis, enum VAL_TYPE *type, int autodef) {
    struct id_rec *id;
    struct exp_list *exproot;
    long r = get_register();
    long r2 = get_register();
    long eh = get_register();
    long label = get_label();
    char *parrot_type;

    /*
    int nr;
    char *err = NULL;
    long index = 0;
    long l;
    struct exp_list *walke;
    struct arr_dim *walkd;
    */

    if (exp->optype == T_EXP_IS_NUM || exp->optype == T_EXP_IS_STRING)
        exp = exp->e.exp;

    if (exp->optype != T_ID && exp->optype != T_SID && exp->optype != T_ARRAY && exp->optype != T_SARRAY)
        fatal("compile_exp_lval() internal error #1");

    id = exp->e.expid.id;
    exproot = exp->e.expid.exproot;

    if (autodef) {
        /*
         * emit2("find_global %s,\"_undef_lex_handler\"",regname1(eh,V_PMC));
        emit2("newsub %s, .Exception_Handler, _undef_lex_handler",regname1(eh,V_PMC));
        emit2("set_eh %s",regname1(eh,V_PMC));
         */
        emit2("search_lex %s,\"%s\"", regname1(r, V_PMC), id->id_name);
        emit2("defined %s,%s", regname1(r2, V_INT), regname2(r, V_PMC));
        emit2("if %s,%s", regname1(r2, V_INT), labelname(label));

        switch (id->type) {
            case V_INT:
                parrot_type = "PerlInt";
                break;
            case V_FLOAT:
                parrot_type = "PerlNum";
                break;
            case V_STRING:
                parrot_type = "PerlString";
                break;
            default:
                compiler_error(0, "Unexpected id->type");
        }

        emit2("%s=new %s", regname1(r, V_PMC), parrot_type);
        emit2("store_lex 0,\"%s\",%s", id->id_name, regname1(r, V_PMC));
        emit(labelname(label), 0, 0);
    } else
        emit2("find_lex %s,\"%s\"", regname1(r, V_PMC), id->id_name);

    *regis = r;
    *type = id->type;

    /*
    *varp = sym->data.var;
    *type = (*varp)->type;

    if (strlen)
        *strlen = (*varp)->strlen;

    if (!(*varp)->array && exproot)
        err = "Unexpected array indices";
    else if (!exproot) {
        lval=var_data(*varp);

        if ((*varp)->array)
            *type=V_ARRAY;
    } else {
        nr = nr_items((struct my_list *) exproot);

        if (nr > (*varp)->array->nrdims)
            err = "Too many indices provided";
        else if (nr < (*varp)->array->nrdims)
            err = "Too few indices provided";
        else {
            walke = exproot;
            walkd = (*varp)->array->dimroot;

            while (walke && !curenv->error && !err) {
                l = compile_intexp(walke->exp);

                if (l < walkd->bottom)
                    err =
                        "Index below DIMensioned bottom";
                else if (l > walkd->top)
                    err =
                        "Index above DIMensioned top";
                else
                    index =
                        index * (walkd->top -
                             walkd->bottom + 1) +
                        l - walkd->bottom;

                walke = walke->next;
                walkd = walkd->next;
            }

            if (err)
                run_error(ARRAY_ERR, err);

            if (comal_debug)
                my_printf(MSG_DEBUG, 1, "Array index=%ld",
                      index);

            vdata=var_data(*varp);
            lval =
                (char HUGE_POINTER *) vdata +
                index * type_size(*type);
        }
    }

    if (err)
        run_error(ARRAY_ERR, err);

    if (comal_debug)
        my_printf(MSG_DEBUG, 1, "compile_exp_lval returns %p for %s", lval,
              id->id_name);

    return lval;
*/
}

PRIVATE void compile_exp_const(struct expression *exp, long *regis,
                               enum VAL_TYPE *type) {
    compiler_error(0, "Not supported yet exp_const ");

    /*
    switch (exp->op) {
    case _ERR:
        *result = val_int(curenv->lasterr, NULL, type);
        break;


    case _ERRLINE:
        *result = val_int(curenv->lasterrline, NULL, type);
        break;

    case _ERRTEXT:
        *result = str_make(RUN_POOL, curenv->lasterrmsg);
        *type = V_STRING;
        break;

    case _DIR:
        *result = str_make(RUN_POOL, sys_dir_string());
        *type = V_STRING;
        break;

    case _UNIT:
        *result = str_make(RUN_POOL, sys_unit_string());
        *type = V_STRING;
        break;

    case _KEY:
        *result=str_make(RUN_POOL, sys_key(0));
        *type = V_STRING;
        break;

    case _EOD:
        *result = val_int(!curenv->dataeptr, NULL, type);
        break;

    case _PI:
        *result = val_float(SYS_PI, NULL, type);
        break;

    case _FALSE:
        *result = val_int(0 == 1, NULL, type);
        break;

    case _TRUE:
        *result = val_int(0 == 0, NULL, type);
        break;

    default:
        fatal("compile_exp_const default action");
    }
    */
}

/*
PRIVATE void *my_not(long *regis, enum VAL_TYPE *type)
{
	long *l;

	if (*type == V_INT) {
		**(long **) result = !(**(long **) result);

		return *result;
	}

	l = cell_alloc(INT_CPOOL);

	*l = ((**(double **) result) == 0);
	*type = V_INT;
	cell_free(*result);

	return l;
}


PRIVATE long my_eof2(long fno)
{
	struct file_rec *f = fsearch(fno);
	long result;
	extern int eof(int file);

	if (!f)
		run_error(EOF_ERR, "File not open");

	result = eof(f->hfno);

	if (result == -1)
		run_error(EOF_ERR, "Error when checking for EOF: %s",
			  sys_errlist[errno]);

	return result;
}


PRIVATE void *my_eof(long *regis, enum VAL_TYPE *type)
{
	long *l;

	if (*type == V_INT) {
		**(long **) result = my_eof2(**(long **) result);

		return *result;
	}

	l = cell_alloc(INT_CPOOL);

	*l = d2int(**(double **) result, 1);
	*l = my_eof2(*l);
	*type = V_INT;
	cell_free(*result);

	return l;
}


PRIVATE void *my_sgn(long *regis, enum VAL_TYPE *type)
{
	long *l;

	if (*type == V_INT) {
		if (**(long **) result < 0)
			**(long **) result = -1;
		else if (**(long **) result > 0)
			**(long **) result = 1;
		else
			**(long **) result = 0;

		return *result;
	}

	l = cell_alloc(INT_CPOOL);

	if (**(double **) result < 0)
		*l = -1;
	else if (**(double **) result > 0)
		*l = 1;
	else
		*l = 0;

	*type = V_INT;
	cell_free(*result);

	return l;
}


PRIVATE double my_rad(double x)
{
	return (x * SYS_PI) / 180;
}


PRIVATE double my_deg(double x)
{
	return (x * 180) / SYS_PI;
}

PRIVATE double my_int(double x)
{
	if (x >= 0)
		return floor(x);

	return -floor(fabs(x));
}


PRIVATE double *my_val(struct string **result, enum VAL_TYPE *type)
{
	double *d = cell_alloc(FLOAT_CPOOL);
	char *endptr;

	*d = strtod((*result)->s, &endptr);

	if (*endptr)
		run_error(VAL_ERR,
			  "Conversion error when taking string VALue");

	mem_free(*result);
	*type = V_FLOAT;

	return d;
}


PRIVATE struct string *my_chr(long *regis, enum VAL_TYPE *type)
{
	struct string *s = STR_ALLOC(RUN_POOL, 1);
	long num;

	if (*type == V_INT)
		num = **(long **) result;
	else
		num = d2int(**(double **) result, 1);

	if (num <= 0 || num > 255)
		run_error(CHR_ERR, "Illegal value for CHR$ (0<x<=255)");

	s->s[0] = (char) num;
	s->s[1] = '\0';
	s->len = 1;
	*type = V_STRING;
	cell_free(*result);

	return s;
}

PRIVATE struct string *my_spc(long *regis, enum VAL_TYPE *type)
{
	struct string *s;
	long num;

	if (*type == V_INT)
		num = **(long **) result;
	else
		num = d2int(**(double **) result, 1);

	if (num < 0 )
		run_error(SPC_ERR, "Illegal parameter for SPC$ (<0)");

	s = STR_ALLOC(RUN_POOL, num);
	s->len=num;
	memset(s->s,' ',num);
	s->s[num]=0;
	*type = V_STRING;
	cell_free(*result);

	return s;
}


PRIVATE struct string *my_str(long *regis, enum VAL_TYPE *type)
{
	char buf[30];

	if (*type == V_INT)
		sprintf(buf, "%ld", **(long **) result);
	else
		sprintf(buf, "%G", **(double **) result);

	*type = V_STRING;
	cell_free(*result);

	return str_make(RUN_POOL, buf);
}
*/

PRIVATE void compile_exp_unary(struct expression *expr, long *regis,
                               enum VAL_TYPE *type) {

    compiler_error(0, "Not supported yet unary ops");

    /*
    double (*dfunc) () = NULL;
    void *(*mfunc) () = NULL;
    char *s;
    long delay;

     * This selection is necessary because INKEY has an optional
     * argument...
    if (expr->e.exp)
        compile_exp(expr->e.exp, result, type);
    else {
        *result=NULL;
        *type=V_ERROR;
    }

    switch (expr->op) {
    case lparenSYM:
    case plusSYM:
        break;

    case minusSYM:
        val_neg(*result, *type);
        break;

    case _VAL:
        *result = my_val((struct string **)result, type);
        break;

    case _INKEY:
        if (!*result)
            s=sys_key(-1);
        else {
            if (*type==V_FLOAT)
                delay=(long)**(double **)result;
            else
                delay=(long)**(long **)result;

            cell_free(*result);
            s=sys_key(delay);
        }

        if (*s) my_printf(MSG_DIALOG,0,s);

        *result=str_make(RUN_POOL,s);
        *type=V_STRING;

        break;

    case _ORD:
        *result =
            val_int((unsigned char)((*(struct string **) result)->s[0]), *result,
                type);
        break;

    case _COMAL_LOWER:
        strlwr((*(struct string **)result)->s);
        break;

    case _COMAL_UPPER:
        strupr((*(struct string **)result)->s);
        break;

    case _LEN:
        *result =
            val_int((*(struct string **) result)->len, *result,
                type);
        break;

    case _CHR:
        *result = my_chr(result, type);
        break;

    case _SPC:
        *result=my_spc(result,type);
        break;

    case _STR:
        *result = my_str(result, type);
        break;

    case _SGN:
        mfunc = my_sgn;
        break;
    case _NOT:
        mfunc = my_not;
        break;
    case _EOF:
        mfunc = my_eof;
        break;

    case _RAD:
        dfunc = my_rad;
        break;
    case _DEG:
        dfunc = my_deg;
        break;
    case _FRAC:
        dfunc = my_frac;
        break;
    case _ROUND:
        dfunc = ROUND;
        break;
    case _ABS:
        dfunc = fabs;
        break;
    case _ACS:
        dfunc = acos;
        break;
    case _ASN:
        dfunc = asin;
        break;
    case _ATN:
        dfunc = atan;
        break;
    case _COS:
        dfunc = cos;
        break;
    case _EXP:
        dfunc = exp;
        break;
    case _INT:
        dfunc = my_int;
        break;
    case _LN:
        dfunc = log;
        break;
    case _LOG:
        dfunc = log10;
        break;
    case _SIN:
        dfunc = sin;
        break;
    case _SQR:
        dfunc = sqrt;
        break;
    case _TAN:
        dfunc = tan;
        break;

    default:
        fatal("compile_exp unary default action");
    }

    if (dfunc) {
        if (*type == V_INT) {
            double *d = cell_alloc(FLOAT_CPOOL);

            *d = **(long **) result;
            cell_free(*result);
            *result = d;
            *type = V_FLOAT;
        }

        **(double **) result = (*dfunc) (**(double **) result);
    } else if (mfunc)
        *result = (*mfunc) (result, type);
    */
}


PRIVATE int relop(int op) {
    return (op == eqlSYM || op == neqSYM || op == lssSYM
            || op == gtrSYM || op == leqSYM || op == geqSYM);
}


PRIVATE int logop(int op) {
    return (op == andSYM || op == orSYM || op == eorSYM ||
            op == andthenSYM || op == orthenSYM);
}


PRIVATE void compile_exp_binary_s(int op, long *regis, enum VAL_TYPE *type,
                                  long r1, long r2, enum VAL_TYPE type2) {
    long r = get_register();

    if (op == plusSYM) {
        emit2("concat %s,%s,%s", regname1(r, V_STRING), regname2(r1, V_STRING), regname3(r2, type2));
        *regis = r;
        *type = V_STRING;
    } else if (op == inSYM) {
        compiler_error(0, "Not supported yet inSym");
    } else if (op == timesSYM) {
        compiler_error(0, "Not supported yet * of string");
    } else
        fatal("compile_exp_binary_s illegal non-relop");
}


PRIVATE void compile_exp_binary_i(int op, long *regis, enum VAL_TYPE *type,
                                  long i1, long i2) {
    char *parrot_op;
    long r;

    r = get_register();

    switch (op) {
        case powerSYM:
            parrot_op = "pow";
            break;
        case divideSYM:
            parrot_op = "div";
            break;
        case plusSYM:
            parrot_op = "add";
            break;
        case minusSYM:
            parrot_op = "sub";
            break;
        case timesSYM:
            parrot_op = "mul";
            break;
        case divSYM:
            parrot_op = "div";
            break;
        case modSYM:
            parrot_op = "cmod";
            break;

        default:
            fatal("compile_exp_binary_i non-relop switch default action");
    }

    emit2("%s %s,%s,%s", parrot_op, regname1(r, V_INT), regname2(i1, V_INT), regname3(i2, V_INT));
    *type = V_INT;
    *regis = r;
}


PRIVATE void compile_exp_binary_f(int op, long *regis, enum VAL_TYPE *type, long f1, long f2) {
    long r = get_register();
    char *parrot_op;

    switch (op) {
        case powerSYM:
            parrot_op = "pow";
            break;
        case plusSYM:
            parrot_op = "add";
            break;
        case minusSYM:
            parrot_op = "sub";
            break;
        case timesSYM:
            parrot_op = "mul";
            break;
        case divideSYM:
            parrot_op = "div";
            break;
        case modSYM:
            parrot_op = "cmod";
            break;
        case divSYM:
            compiler_error(0, "Not supported yet div of float");
            break;

        default:
            fatal("compile_exp_binary_f non-relop switch default action");
    }

    emit2("%s %s,%s,%s", parrot_op, regname1(r, V_FLOAT), regname2(f1, V_FLOAT), regname3(f2, V_FLOAT));
    *type = V_FLOAT;
    *regis = r;
}


PRIVATE long compile_exp_binary_l(int op, struct expression *exp1,
                                  struct expression *exp2) {
    long result1, result2;
    long r;
    long label;
    enum VAL_TYPE type1, type2;

    label = get_label();
    r = get_register();

    compile_exp(exp1, &result1, &type1);

    /*
    if (op == andthenSYM || (op == andSYM && short_circuit)) {
        if (!i1)
            return 0;
        else
            op = andSYM;
    } else {
        if (op == orthenSYM || (op == orSYM && short_circuit)) {
            if (i1)
                return 1;
            else
                op = orSYM;
        }
    }
    */
    if (op == andthenSYM || op == orthenSYM || short_circuit)
        compiler_error(0, "Not supported yet compare andthen/orthen/short_circuit");

    compile_exp(exp2, &result2, &type2);

    morph(&result1, &type1, V_INT);
    morph(&result2, &type2, V_INT);

    switch (op) {
        case andSYM:
            emit2("%s=0", regname1(r, V_INT));
            emit2("eq %s,0,%s", regname1(result1, type1), labelname(label));
            emit2("eq %s,0,%s", regname1(result2, type2), labelname(label));
            emit2("%s=1", regname1(r, V_INT));
            emit(labelname(label), 0, 0);
            break;
        case orSYM:
            emit2("%s=1", regname1(r, V_INT));
            emit2("ne %s,0,%s", regname1(result1, type1), labelname(label));
            emit2("ne %s,0,%s", regname1(result2, type2), labelname(label));
            emit2("%s=0", regname1(r, V_INT));
            emit(labelname(label), 0, 0);
            break;
        case eorSYM:
            compiler_error(0, "Not supported yet eor");
            break;

        default:
            fatal("compile_exp_binary_l relop switch default action");
    }

    return r;
}

/*
 * Calculate a new RND value. sys_rand is called to determine a new 
 * random number from the system and the scale in which this random
 * number has been generated (typically RAND_MAX). The exact working
 * of this function then depends on the presence of exp1 and exp2 in
 * this T_BINARY node of the expression tree:
 *
 * RND -> exp1==exp2==NULL -> gives random number in [0,1]
 * RND(x) -> exp1==NULL, exp2==x -> gives whole random number in [0,x]
 * RND(x,y) -> exp1==x, exp2==y -> gives whole random number in [x,y]
 */
PRIVATE void compile_exp_rnd(struct expression *exp, long *regis,
                             enum VAL_TYPE *type) {
    compiler_error(0, "Not supported yet compare RND");

    /*
    long n,max;
    double d,d1,d2;
    struct expression *exp1=exp->e.twoexp.exp1;
    struct expression *exp2=exp->e.twoexp.exp2;

    sys_rand(&n,&max);
    d=(double)n/(double)max;

    if (exp1==NULL && exp2==NULL)
        ; //  Do nothing, d has the right value
    else if (exp1==NULL && exp2!=NULL) {
        d2=floor(val_double(exp2));
        d=ROUND(d*d2);
    } else if (exp1!=NULL && exp2!=NULL) {
        d1=floor(val_double(exp1));
        d2=floor(val_double(exp2));

        if (d1>=d2) run_error(RND_ERR,"RND(x,y) argument error (x>=y)");

        d=ROUND((d2-d1)*d+d1);
    } else
        fatal("compile_exp_rnd internal error #1");

    *result = cell_alloc(FLOAT_CPOOL);
    **result = d;
    *type = V_FLOAT;
    */
}

PRIVATE void
compile_cmp(int op, long *regis, enum VAL_TYPE *type, long r1, enum VAL_TYPE type1, long r2, enum VAL_TYPE type2) {
    char *parrot_op;
    long r = get_register();
    long l = get_label();

    switch (op) {
        case eqlSYM:
            parrot_op = "eq";
            break;
        case neqSYM:
            parrot_op = "ne";
            break;
        case lssSYM:
            parrot_op = "lt";
            break;
        case gtrSYM:
            parrot_op = "gt";
            break;
        case leqSYM:
            parrot_op = "le";
            break;
        case geqSYM:
            parrot_op = "ge";
            break;
    }

    if (type1 != type2) {
        if (type1 == V_STRING || type2 == V_STRING)
            compiler_error(0, "Internal typing problem in compile_cmp()");

        if (type1 == V_INT)
            morph(&r1, &type1, V_FLOAT);
        else
            morph(&r2, &type2, V_FLOAT);
    }

    emit2("%s=1", regname1(r, V_INT));
    emit2("%s %s,%s,%s", parrot_op, regname1(r1, type1), regname2(r2, type2), labelname(l));
    emit2("%s=0", regname1(r, V_INT));
    emit(labelname(l), 0, 0);

    *regis = r;
    *type = V_INT;
}

PRIVATE void compile_exp_binary(struct expression *exp, long *regis,
                                enum VAL_TYPE *type) {
    long result1, result2;
    long r;
    enum VAL_TYPE type1, type2;

    if (logop(exp->op)) {
        *regis = compile_exp_binary_l(exp->op, exp->e.twoexp.exp1, exp->e.twoexp.exp2);
        *type = V_INT;
    } else if (exp->op == _RND)
        compile_exp_rnd(exp, regis, type);
    else {
        compile_exp(exp->e.twoexp.exp1, &result1, &type1);
        compile_exp(exp->e.twoexp.exp2, &result2, &type2);

        if (relop(exp->op)) {
            compile_cmp(exp->op, regis, type, result1, type1, result2, type2);
        } else if (type1 == V_STRING)
            compile_exp_binary_s(exp->op, regis, type, result1, result2, type2);
        else {
            if (type1 != type2) {
                r = get_register();

                if (type1 == V_INT)
                    morph(&result1, &type1, V_FLOAT);
                else
                    morph(&result2, &type2, V_FLOAT);
            }

            switch (type1) {
                case V_INT:
                    compile_exp_binary_i(exp->op, regis, type, result1, result2);
                    break;
                case V_FLOAT:
                    compile_exp_binary_f(exp->op, regis, type, result1, result2);
                    break;

                default:
                    fatal
                            ("compile_exp_binary subexp type default action");
            }
        }
    }
}


PRIVATE void compile_exp_intnum(struct expression *exp, long *regis,
                                enum VAL_TYPE *type) {
    long r = get_register();

    emit2("%s=%ld", regname1(r, V_INT), exp->e.num);
    *type = V_INT;
    *regis = r;
}


PRIVATE void compile_exp_float(struct expression *exp, long *regis,
                               enum VAL_TYPE *type) {
    long r = get_register();

    emit2("%s=%s", regname1(r, V_FLOAT), exp->e.fnum.text);
    *type = V_FLOAT;
    *regis = r;
}


PRIVATE void compile_exp_string(struct expression *exp, long *regis,
                                enum VAL_TYPE *type) {
    long r = get_register();

    emit2("%s=\"%s\"", regname1(r, V_STRING), exp->e.str->s);
    *type = V_STRING;
    *regis = r;
}


/*
PRIVATE int compile_exp_name(struct id_rec *id, struct compile_exp_list *exproot,
		     long *regis, enum VAL_TYPE *type)
{
	struct sym_item *sym = sym_search(curenv->curenv, id, S_NAME);
	struct sym_env *save_env;
	enum VAL_TYPE ntype;

	if (!sym)
		return 0;

	if (exproot)
		run_error(NAME_ERR,
			  "NAMEs can't take parameters or dimensions");

	save_env = curenv->curenv;
	curenv->curenv = sym->data.name->env;
	compile_exp(sym->data.name->exp, result, type);
	curenv->curenv = save_env;

	ntype = id->type;

	if (ntype != *type) {
		if (ntype == V_INT)
			*result =
			    val_int(d2int(**(double **) result, 0),
				    *result, type);
		else
			*result =
			    val_float((double) **(long **) result, *result,
				      type);
	}

	return 1;
}
*/


PRIVATE void compile_exp_id(struct expression *exp, long *regis,
                            enum VAL_TYPE *type) {
    long pmc;
    long r = get_register();

    compile_exp_lval(exp, &pmc, type, 0);
    emit2("%s=%s", regname1(r, *type), regname2(pmc, V_PMC));
    *regis = r;

    /*
    if (!lval) {
        if (!compile_exp_name
            (exp->e.expid.id, exp->e.expid.exproot, result, type))
            exec_call(exp, funcSYM, result, type);

        return;
    }

    if (*type==V_ARRAY)
        run_error(ARRAY_ERR, "Missing array indices for %s",exp->e.expid.id->id_name);
    else if (*type == V_INT) {
        *result = cell_alloc(INT_CPOOL);
        **(long **) result = *(long *) lval;
    } else {
        *result = cell_alloc(FLOAT_CPOOL);
        **(double **) result = *(double *) lval;
    }
    */
}

PRIVATE void compile_exp_array(struct expression *exp, long *regis,
                               enum VAL_TYPE *type) {
    compiler_error(0, "Not supported yet array");

    /*
    struct var_item *var;
    void *lval = compile_exp_lval(exp, type, &var, NULL);

     * The expression is not an lvalue (array). Maybe it's wrong
     * syntax for a function call? Let's try to run it as a function
     * instead...
    if (!lval) {
        exec_call(exp,funcSYM,result,type);
        return;
    }

     * If we got here, the lval should be an array. This can also be
     * checked by if (var->array) ...
    if (*type!=V_ARRAY)
        run_error(ARRAY_ERR, "%s is not an array",exp->e.expid.id->id_name);

     * For arrays, the result pointer points to the var item. Since the parse
     * tree of an expression containing an array() can not contain anything
     * else, we're fine...
    *result=var;
    */
}

/*
PRIVATE void do_substr(struct string *tresult, struct string **result,
		       struct two_exp *twoexp)
{
	long from, to;
	char *err = NULL;

	if (twoexp->exp1)
		from = compile_intexp(twoexp->exp1);
	else
		from = 1;

	if (twoexp->exp2)
		to = compile_intexp(twoexp->exp2);
	else
		to = tresult->len;

	if (from > to)
		err = "Substring specifier incorrect (from>to)";
	else if (from < 1)
		err = "Substring specifier start < 1";
	else if (to > tresult->len)
		err = "Substring specifier end > string length";

	if (err)
		run_error(SUBSTR_ERR, err);

	*result = STR_ALLOC(RUN_POOL, to - from + 1);
	str_partcpy(*result, tresult, from, to);
}
*/


PRIVATE void compile_exp_sid(struct expression *exp, long *regis,
                             enum VAL_TYPE *type) {
    compiler_error(0, "Not supported yet sid");
    /*
    struct var_item *var;
    long strl;
    struct string *tresult = NULL;
    struct string **lval = compile_exp_lval(exp, type, &var, &strl);

    if (!lval) {
        if (!compile_exp_name
            (exp->e.expsid.id, exp->e.expsid.exproot, (void **)&tresult,
             type))
            exec_call(exp, funcSYM, (void **) &tresult, type);

        lval = &tresult;
    } else if (*type==V_ARRAY)
        run_error(ARRAY_ERR, "Missing string array indices on %s",exp->e.expsid.id->id_name);

    if (!*lval)
        lval = &empty_string;

    if (exp->e.expsid.twoexp)
        do_substr(*lval, result, exp->e.expsid.twoexp);
    else if (tresult) {
        *result = tresult;
        tresult = NULL;
    } else
        *result = str_dup(RUN_POOL, *lval);

    if (tresult)
        mem_free(tresult);
    */
}


PRIVATE void compile_exp_substr(struct expression *exp, long *regis, enum
        VAL_TYPE *type) {
    long tresult;

    compile_exp(exp->e.expsubstr.exp, &tresult, type);
    //do_substr(tresult, (struct string **)result, &exp->e.expsubstr.twoexp);
    compiler_error(0, "Not supported yet substring(a:b)");
}


PRIVATE void compile_exp_sys(struct expression *exp, long *regis, enum
        VAL_TYPE *type) {
    //sys_sys_exp(exp->e.exproot, result, type);
    compiler_error(0, "Not supported yet SYS");
}


PRIVATE void compile_exp_syss(struct expression *exp, struct string **result,
                              enum VAL_TYPE *type) {
    //sys_syss_exp(exp->e.exproot, result, type);
    compiler_error(0, "Not supported yet SYS$");
}


PRIVATE void compile_exp_reexp(struct expression *exp, long *regis, enum
        VAL_TYPE *type) {
    compile_exp(exp->e.exp, regis, type);
}


PRIVATE struct {
    enum optype type;

    void (*func)(struct expression *, long *, enum VAL_TYPE *);
} exptab[] = {
        {
                T_EXP_IS_NUM,    (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_reexp},
        {
                T_EXP_IS_STRING, (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_reexp},
        {
                T_ID,            (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_id},
        {
                T_ARRAY,         (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_array},
        {
                T_SID,           (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_sid},
        {
                T_SARRAY,        (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_array},
        {
                T_INTNUM,        (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_intnum},
        {
                T_FLOAT,         (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_float},
        {
                T_STRING,        (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_string},
        {
                T_CONST,         (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_const},
        {
                T_BINARY,        (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_binary},
        {
                T_UNARY,         (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_unary},
        {
                T_SUBSTR,        (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_substr},
        {
                T_SYS,           (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_sys},
        {
                T_SYSS,          (void (*)(struct expression *, long *, enum VAL_TYPE *)) compile_exp_syss},
        {
                (enum optype) 0, 0}
};


PUBLIC void compile_exp(struct expression *exp, long *regis,
                        enum VAL_TYPE *type) {
    int i;

    if (!exp)
        fatal("compile_exp finds (null) expression");

    for (i = 0; exptab[i].type && exptab[i].type != exp->optype; i++);

    if (exptab[i].type)
        exptab[i].func(exp, regis, type);
    else
        fatal("compile_exp, optype does not occur in table");
}

/*
PUBLIC long compile_intexp(struct expression *exp)
{
	long num;
	void *result;
	enum VAL_TYPE type;

	compile_exp(exp, &result, &type);

	if (type == V_INT)
		num = *(long *) result;
	else if (type == V_FLOAT)
		num = d2int(*(double *) result, 1);
	else
		fatal("compile_intexp wrong type");

	cell_free(result);

	return num;
}

*/

PUBLIC void compile_logexp(struct expression *exp, long *regis) {
    enum VAL_TYPE type;

    compile_exp(exp, regis, &type);
    morph(regis, &type, V_INT);
}
