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

/* OpenComal -> Parrot PIR Compiler */

#include "pdcglob.h"
#include "pdcmisc.h"
#include "pdcprog.h"
#include "pdclist.h"
#include "pdccexp.h"
#include "pdcexec.h"
#include "pdccomp.h"

#include <string.h>
#include <errno.h>
#include <stdarg.h>

PRIVATE FILE *parrot_out;
PRIVATE jmp_buf exit_compiler;
PRIVATE struct comal_line *current_line;

PRIVATE long reg_count;
PRIVATE long label_count;

PRIVATE void compile_seq(struct comal_line *line, int untilSym1, int untilSym2, int untilSym3);

PRIVATE void compile_line(struct comal_line *line);

PRIVATE long deepest_loop_exit;

PRIVATE long inc(long *l) {
    (*l)++;

    return (*l);
}

PUBLIC long get_register() {
    return inc(&reg_count);
}


PUBLIC long get_label() {
    return inc(&label_count);
}


PUBLIC void compiler_error(struct comal_line *line, char *s, ...) {
    char *buf;
    char buf2[MAX_LINELEN];
    va_list ap;

    if (!line)
        line = current_line;

    if (line) {
        buf = buf2;
        line_list(&buf, line);
        my_printf(MSG_ERROR, 1, buf2);
    }

    va_start(ap, s);
    vsprintf(buf2, s, ap);
    va_end(ap);
    my_printf(MSG_ERROR, 1, buf2);
    longjmp(exit_compiler, 666);
}

PRIVATE char *regname0(char *buf, long num, enum VAL_TYPE type) {
    char *fmt = 0;

    switch (type) {
        case V_INT:
            fmt = "$I%ld";
            break;
        case V_FLOAT:
            fmt = "$N%ld";
            break;
        case V_STRING:
            fmt = "$S%ld";
            break;
        case V_PMC:
            fmt = "$P%ld";
            break;
        default:
            fatal("regname for wrong v_type");
    }

    sprintf(buf, fmt, num);

    return buf;
}

PUBLIC char *regname1(long num, enum VAL_TYPE type) {
    static char buf[10];
    return regname0(buf, num, type);
}

PUBLIC char *regname2(long num, enum VAL_TYPE type) {
    static char buf[10];
    return regname0(buf, num, type);
}

PUBLIC char *regname3(long num, enum VAL_TYPE type) {
    static char buf[10];
    return regname0(buf, num, type);
}

PUBLIC char *labelname(long num) {
    static char buf[20];

    sprintf(buf, "_LABEL_%ld", num);
    return buf;
}

PUBLIC void emit(char *label, char *code, char *comment) {
    if (label != 0)
        fprintf(parrot_out, "%s:\n", label);

    if (code != 0)
        fprintf(parrot_out, "\t%s\n", code);

    if (comment != 0)
        fprintf(parrot_out, "\t# %s\n", comment);
}

PUBLIC void emit2(char *s, ...) {
    char buf[MAX_LINELEN];
    va_list ap;

    va_start(ap, s);
    vsprintf(buf, s, ap);
    va_end(ap);
    emit(0, buf, 0);
}

PUBLIC void emit_label(long label) {
    emit(labelname(label), 0, 0);
}

PRIVATE void compile_print_con(struct print_list *printroot, int pr_sep) {
    long reg;
    enum VAL_TYPE type;
    struct print_list *work = printroot;

    while (work) {
        compile_exp(work->exp, &reg, &type);
        emit2("print %s", regname1(reg, type));
        work = work->next;
    }

    if (!pr_sep)
        emit(0, "print \"\\n\"", 0);
}

PRIVATE void compile_print(struct comal_line *line) {
    struct print_rec *p = &line->lc.printrec;

    /*if (p->modifier)
        if (p->modifier->type == usingSYM)
            print_using(p->modifier->data.str, p->printroot,
                    p->pr_sep);
        else
            print_file(&p->modifier->data.twoexp,
                   p->printroot);
    else */
    compile_print_con(p->printroot, p->pr_sep);
}

PRIVATE void compile_while(struct comal_line *line) {
    long start = get_label();
    long finish = get_label();
    struct ifwhile_rec *w = &line->lc.ifwhilerec;
    long regis;

    emit_label(start);
    compile_logexp(w->exp, &regis);
    emit2("unless %s,%s", regname1(regis, V_INT), labelname(finish));

    if (w->stat)
        compile_line(w->stat);
    else
        compile_seq(line->ld->next, endwhileSYM, -1, -1);

    emit2("branch %s", labelname(start));
    emit_label(finish);
}

PRIVATE void compile_if(struct comal_line *line) {
    long else_label = get_label();
    long endif_label = get_label();
    struct ifwhile_rec *w = &line->lc.ifwhilerec;
    long regis;

    compile_logexp(w->exp, &regis);
    emit2("unless %s,%s", regname1(regis, V_INT), labelname(else_label));

    if (w->stat) {
        compile_line(w->stat);
        emit_label(else_label);
    } else {
        while (1) {
            compile_seq(line->ld->next, endifSYM, elseSYM, elifSYM);
            line = current_line;

            if (current_line->cmd == endifSYM) {
                emit_label(else_label);
                break;
            } else if (current_line->cmd == elseSYM) {
                emit2("branch %s", labelname(endif_label));
                emit_label(else_label);
                compile_seq(line->ld->next, endifSYM, -1, -1);
                break;
            } else if (current_line->cmd == elifSYM) {
                emit2("branch %s", labelname(endif_label));
                emit_label(else_label);
                else_label = get_label();
                compile_logexp(line->lc.exp, &regis);
                emit2("unless %s,%s", regname1(regis, V_INT), labelname(else_label));
            } else
                compiler_error(current_line, "Internal if error");
        }
    }

    emit_label(endif_label);
}

PRIVATE void compile_repeat(struct comal_line *line) {
    long start = get_label();
    struct ifwhile_rec *w = &line->lc.ifwhilerec;
    long regis;
    struct expression *exp;

    emit_label(start);

    if (w->stat) {
        compile_line(w->stat);
        exp = w->exp;
    } else {
        compile_seq(line->ld->next, untilSYM, -1, -1);
        exp = current_line->lc.exp;
    }

    compile_logexp(exp, &regis);
    emit2("eq %s,0,%s", regname1(regis, V_INT), labelname(start));
}

PRIVATE void compile_loop(struct comal_line *line) {
    long start = get_label();
    long finish = get_label();
    long save = deepest_loop_exit;

    emit_label(start);

    deepest_loop_exit = finish;
    compile_seq(line->ld->next, endloopSYM, -1, -1);
    deepest_loop_exit = save;

    emit2("branch %s", labelname(start));
    emit_label(finish);
}

PRIVATE void compile_exit(struct comal_line *line) {
    long regis;

    if (line->lc.exp) {
        compile_logexp(line->lc.exp, &regis);
        emit2("ne %s,0,%s", regname1(regis, V_INT), labelname(deepest_loop_exit));
    } else
        emit2("branch %s", labelname(deepest_loop_exit));
}

PRIVATE void compile_lval(struct expression *lval, long *regis, enum VAL_TYPE *type) {
    compile_exp_lval(lval, regis, type, 1);
}

PRIVATE void do_assign2(struct expression *lval, long regis, enum VAL_TYPE type) {
    long target;
    enum VAL_TYPE ttype;

    compile_lval(lval, &target, &ttype);
    emit2("%s=%s", regname1(target, V_PMC), regname2(regis, type));
}

PRIVATE void do_assign1(struct expression *lval, int op, struct expression *rval) {
    long regis = get_register();
    enum VAL_TYPE type;
    struct expression exp;

    if (op == becomesSYM)
        compile_exp(rval, &regis, &type);
    else {
        exp.optype = T_BINARY;

        switch (op) {
            case becplusSYM:
                exp.op = plusSYM;
                break;
            case becminusSYM:
                exp.op = minusSYM;
                break;

            default:
                fatal("Assign2 complex assignop switch default action");
        }

        exp.e.twoexp.exp1 = lval;
        exp.e.twoexp.exp2 = rval;

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

    do_assign2(lval, regis, type);
}

PRIVATE void compile_assign(struct comal_line *line) {
    struct assign_list *work = line->lc.assignroot;

    while (work) {
        do_assign1(work->lval, work->op, work->exp);
        work = work->next;
    }
}

PRIVATE void compile_line(struct comal_line *line) {
    char *buf;
    char buf2[MAX_LINELEN];
    char buf3[20];

    /*
     * Emit a comment for this Comal line including a label
     */
    buf = buf2;
    line_list(&buf, line);

    if (line->ld) {
        sprintf(buf3, "line_%ld", line->ld->lineno);
        emit(buf3, 0, buf2);
        emit2("setline %ld", line->ld->lineno);
    }

    switch (line->cmd) {
        case 0:
            break;

        case becomesSYM:
            compile_assign(line);
            break;

        case printSYM:
            compile_print(line);
            break;

        case whileSYM:
            compile_while(line);
            break;

        case repeatSYM:
            compile_repeat(line);
            break;

        case loopSYM:
            compile_loop(line);
            break;

        case exitSYM:
            compile_exit(line);
            break;

        case endSYM:
            emit2("end");
            break;

        case ifSYM:
            compile_if(line);
            break;

            /*
            case idSYM:
            case dataSYM:
            case endcaseSYM:
            case endifSYM:
            case nullSYM:
            case useSYM:
            case exportSYM:
                break;

            case osSYM:
                calc_exp(line->lc.exp, (void **) &result, &type);

                if (sys_system(result->s) == -1)
                    run_error(OS_ERR, "OS command failed");

                mem_free(result);
                sys_screen_readjust();
                break;

            case delSYM:
                calc_exp(line->lc.exp, (void **) &result, &type);

                if (unlink(result->s) == -1)
                    run_error(DEL_ERR,
                          "DELete of %s failed (Read Only?)",
                          result->s);

                mem_free(result);
                break;

            case chdirSYM:
                calc_exp(line->lc.exp, (void **) &result, &type);
                sys_chdir(result->s);
                mem_free(result);
                break;

            case mkdirSYM:
                calc_exp(line->lc.exp, (void **) &result, &type);
                sys_mkdir(result->s);
                mem_free(result);
                break;

            case rmdirSYM:
                calc_exp(line->lc.exp, (void **) &result, &type);
                sys_rmdir(result->s);
                mem_free(result);
                break;

            case unitSYM:
                calc_exp(line->lc.exp, (void **) &result, &type);
                sys_unit(result->s);
                mem_free(result);
                break;

            case dirSYM:
                if (line->lc.exp) {
                    calc_exp(line->lc.exp, (void **) &result, &type);
                    sys_dir(result->s);
                    mem_free(result);
                } else
                    sys_dir("");

                break;

            case staticSYM:
            case localSYM:
            case dimSYM:
                exec_dim(line);
                break;


            case pageSYM:
                sys_page(sel_outfile);
                break;

            case cursorSYM:
                sys_cursor(sel_outfile, calc_intexp(line->lc.twoexp.exp1),
                       calc_intexp(line->lc.twoexp.exp2));
                break;

            case elseSYM:
            case otherwiseSYM:
                curenv->curline = line->lineptr;
                break;


            case elifSYM:
                run_chain(line, endifSYM);
                break;

            case whenSYM:
                run_chain(line, endcaseSYM);
                break;

            case restoreSYM:
                exec_restore(line);
                break;


            case sysSYM:
                return sys_sys_stat(line->lc.exproot);

            case runSYM:
                exec_run(line);
                break;

            case trapSYM:
                return exec_trap(line);

            case forSYM:
                return exec_for(line);

            case execSYM:
                do_call(line->lc.exp, procSYM);
                break;

            case returnSYM:
                return exec_return(line);

            case caseSYM:
                exec_case(line);
                break;

            case openSYM:
                exec_open(line);
                break;

            case closeSYM:
                exec_close(line);
                break;

            case importSYM:
                exec_import(line);
                break;

            case select_outputSYM:
                exec_selfile(&sel_outfile, line->lc.exp, "at");
                break;

            case select_inputSYM:
                exec_selfile(&sel_infile, line->lc.exp, "rt");
                break;

            case inputSYM:
                exec_input(line);
                break;

            case writeSYM:
                exec_write(line);
                break;

            case readSYM:
                exec_read(line);
                break;

            case stopSYM:
                exec_stop(line);
                break;

            case endforSYM:
            case endtrapSYM:
            case handlerSYM:
                return line->cmd;

            case endmoduleSYM:
            case endprocSYM:
                return returnSYM;

            case endfuncSYM:
                run_error(NORETURN_ERR, "Should have RETURNed by now");

            case moduleSYM:
            case funcSYM:
            case procSYM:
                if (!line->lc.pfrec.external)
                    curenv->curline = line->lineptr->ld->next;

                break;

            case traceSYM:
                curenv->trace = (strcmp(exp_cmd(line->lc.exp), "on") == 0);
                break;

            case retrySYM:
                return retrySYM;

            */
        default:
            compiler_error(line, "Not yet implemented!");
    }
}

PRIVATE void compile_seq(struct comal_line *line, int untilSym1, int untilSym2, int untilSym3) {
    current_line = line;

    while (current_line != 0 && current_line->cmd != untilSym1 && current_line->cmd != untilSym2 &&
           current_line->cmd != untilSym3) {
        /*
         * Compile this line and get the next line to look at
         */
        compile_line(current_line);
        current_line = current_line->ld->next;
    }
}

PUBLIC void compiler(char *filename) {
    prog_total_scan();

    if (!curenv->scan_ok)
        return;

    parrot_out = fopen(filename, "wt");

    if (parrot_out == 0)
        run_error(COMPILE_ERR, "Output file open error %s", strerror(errno));

    reg_count = 100;
    label_count = 100;

    if (setjmp(exit_compiler) == 0) {
        emit2(".include \"opencomal_rt.imc\"");
        emit2(".sub _opencomal_main");
        compile_seq(curenv->progroot, -1, -1, -1);
        emit2("ret");
        emit2(".end");
    }

    fclose(parrot_out);
}
