Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
585 lines (513 sloc) 11.7 KB
#include <stdio.h>
#include <ir/ir.h>
#include <target/util.h>
#include <target/unlcore.h>
static const char S2[] = "``s";
static const char K1[] = "`k";
static const char CONS[] = "``s``s`ks``s`kk``s`ks``s`k`sik`kk";
static const char CAR[] = "``si`kk";
static const char CDR[] = "``si`k`ki";
static const char DOTCAR[] = "k"; // (x DOTCAR) = (CAR x)
// (CONS_KI x) = (cons (K I) x)
static const char CONS_KI[] = "``s`k`s``si`k`kik";
// (CONS_K x) = (cons K x)
static const char CONS_K[] = "``s`k`s``si`kkk";
// (APPLY_CDR f lst) = (cons (car lst) (f (cdr lst)))
static const char APPLY_CDR[] = "``s`k`si``s`kk``s`k`s``s`ks``s`kk``s`ks``s`k`sik``s`kk`s`kk";
// (REPLACE_CAR x lst) = (cons x (cdr lst))
static const char REPLACE_CAR[] = "``s`k`si``s`kk``s`kk``s`k`s``s`k`s``s`ks``s`k`sik``s`kkkk";
// ([REPLACE_CAR1 + <expr>] lst) = (cons <expr> (cdr lst))
static const char REPLACE_CAR1[] = "``si`k`k``s``s`k`s``s`ks``s`k`sik``s`kkk`k";
// (COMPOSE f g x) = (f (g x))
static const char COMPOSE[] = "``s`ksk";
// (n POST_INC) = n+1
static const char POST_INC[] = "```sii``s``s`ks``s`k`si``s`kk``s`k`s`k``s`k`s``si`k`kik``s`k`si``s``s`kskk`k`k``s`k`s``si`kkk";
// (n POST_DEC) = n-1
static const char POST_DEC[] = "```sii``s`k`s``si`k``s`k`s``si`k`kik``s`kk``s`k`s`k``s`k`s``si`kkk``s`k`si``s``s`kskk";
// Church numers up to 24
static const char* CHURCHNUM[] = {
"`ki",
"i",
"``s``s`kski",
"```ss``ss`ki``s`ksk",
"``ci``s``s`kski",
"``s``s`ksk``ci``s``s`kski",
"```ss``ss`k``ci``s``s`kski``s`ksk",
"```ss``ss``ss`k``ci``s``s`kski``s`ksk",
"```s``s`ksk`ci``s``s`kski",
"````ss`ss``ss`ki``s`ksk",
"```ss```ss`ss``ss`ki``s`ksk", // 10
"```ss``ss```ss`ss``ss`ki``s`ksk",
"```ss``ss``ss```ss`ss``ss`ki``s`ksk",
"```ss``ss``ss``ss```ss`ss``ss`ki``s`ksk",
"```ss``ss``ss``ss``ss```ss`ss``ss`ki``s`ksk",
"```ss``ss``ss``ss``ss``ss```ss`ss``ss`ki``s`ksk",
"```s`cii``s``s`kski",
"``s``s`ksk```s`cii``s``s`kski",
"```ss``ss`k```s`cii``s``s`kski``s`ksk",
"```ss``ss``ss`k```s`cii``s``s`kski``s`ksk",
"````sss``s`ksk``ci``s``s`kski", // 20
"```ss``s``sss`k``ci``s``s`kski``s`ksk",
"```ss``ss``s``sss`k``ci``s``s`kski``s`ksk",
"```ss``ss``ss``s``sss`k``ci``s``s`kski``s`ksk",
"```s``si``s`ci`k`s``s`ksk``s`cii``s``s`kski",
};
typedef enum {
UNL_PC = 0, UNL_A, UNL_B, UNL_C, UNL_D, UNL_BP, UNL_SP
} UnlReg;
static UnlReg unl_regpos(Reg r) {
switch (r) {
case A: return UNL_A;
case B: return UNL_B;
case C: return UNL_C;
case D: return UNL_D;
case BP: return UNL_BP;
case SP: return UNL_SP;
default:
error("unknown reg: %d", r);
}
}
static void unl_emit(const char* s) {
fputs(s, stdout);
}
static void unl_emit_tick(int n) {
for (int i = 0; i < n; i++) {
putchar('`');
}
}
static void unl_list_begin(int is_first) {
if (!is_first)
unl_emit(K1);
unl_emit("``s``si`k");
}
static void unl_list_end(void) {
putchar('v');
}
static void unl_emit_churchnum(int n) {
if (n > 24)
error("churchnum table out of range: %d", n);
unl_emit(CHURCHNUM[n]);
}
static void unl_emit_number(int n) {
for (int i = 0; i < 24; i++) {
unl_list_begin(i == 0);
unl_emit(n % 2 ? "k" : "`ki");
n /= 2;
}
unl_list_end();
}
// Compact, but less efficient
static void unl_emit_number2(int n) {
int all_one = UINT_MAX;
for (int i = 0; i < 24; i++) {
if (i < 23 && n == 0) {
if (i > 0) {
unl_emit(K1);
}
unl_emit_tick(2);
unl_emit_churchnum(24 - i);
unl_emit(CONS_KI);
break;
} else if (i < 23 && n == all_one) {
if (i > 0) {
unl_emit(K1);
}
unl_emit_tick(2);
unl_emit_churchnum(24 - i);
unl_emit(CONS_K);
break;
} else {
unl_list_begin(i == 0);
unl_emit(n % 2 ? "k" : "`ki");
n /= 2;
all_one /= 2;
}
}
unl_list_end();
}
static void unl_nth_begin(int n) {
unl_emit(S2);
unl_emit(S2);
unl_emit(K1);
unl_emit("`");
unl_emit_churchnum(n);
unl_emit(CDR);
}
static void unl_nth_end(void) {
unl_emit(K1);
unl_emit(DOTCAR);
}
typedef enum {
LIB_ADD = 2,
LIB_SUB,
LIB_EQ,
LIB_LT,
LIB_LOAD,
LIB_STORE,
LIB_PUTC,
LIB_GETC
} LibNo;
static void unl_emit_lib(LibNo n) {
unl_emit(S2);
unl_emit("`");
unl_emit_churchnum(n);
unl_emit(CDR);
unl_emit(K1);
unl_emit(DOTCAR);
}
static void unl_lib_add() {
unl_emit(S2);
unl_emit(S2);
unl_emit_lib(LIB_ADD);
}
static void unl_lib_sub() {
unl_emit(S2);
unl_emit(S2);
unl_emit_lib(LIB_SUB);
}
static void unl_lib_eq() {
unl_emit(S2);
unl_emit(S2);
unl_emit_lib(LIB_EQ);
}
static void unl_lib_lt() {
unl_emit(S2);
unl_emit(S2);
unl_emit_lib(LIB_LT);
}
static void unl_lib_load() {
unl_emit(S2);
unl_emit(S2);
unl_emit_lib(LIB_LOAD);
putchar('i');
}
static void unl_lib_store() {
unl_emit(S2);
unl_emit(S2);
unl_emit(S2);
unl_emit_lib(LIB_STORE);
putchar('i');
}
static void unl_lib_putc() {
unl_emit(S2);
unl_emit_lib(LIB_PUTC);
}
static void unl_lib_getc() {
unl_emit(S2);
unl_emit("`kc");
unl_emit_lib(LIB_GETC);
}
static void unl_getreg(Reg reg) {
unl_nth_begin(unl_regpos(reg));
unl_emit(CAR); // regs = car(vm)
unl_nth_end();
}
static void unl_emit_value(Value* val) {
if (val->type == REG) {
unl_getreg(val->reg);
} else {
unl_emit(K1);
unl_emit_number(val->imm);
}
}
static void unl_setreg_begin(UnlReg reg) {
unl_emit(S2);
unl_emit(S2);
unl_emit(K1);
unl_emit(CONS);
unl_emit(S2);
unl_emit(S2);
unl_emit(K1);
unl_emit_tick(1);
unl_emit_churchnum(reg);
unl_emit(APPLY_CDR);
unl_emit(S2);
unl_emit(K1);
unl_emit(REPLACE_CAR);
}
static void unl_setreg_end(void) {
unl_emit(CAR);
unl_emit(CDR);
}
static void unl_setreg_imm(UnlReg reg, int n) {
unl_emit(S2);
unl_emit(S2);
unl_emit(K1);
unl_emit(CONS);
unl_emit(S2);
unl_emit(K1);
unl_emit_tick(2);
unl_emit_churchnum(reg);
unl_emit(APPLY_CDR);
unl_emit(REPLACE_CAR1);
unl_emit_number(n);
unl_emit(CAR);
unl_emit(CDR);
}
static void unl_emit_jmp(Value* jmp) {
if (jmp->type == REG) {
unl_setreg_begin(UNL_PC);
unl_getreg(jmp->reg);
unl_setreg_end();
} else {
unl_setreg_imm(UNL_PC, jmp->imm);
}
}
static void unl_bool_to_number_begin(void) {
unl_emit(S2);
unl_emit(S2);
unl_emit(K1);
unl_emit(CONS);
}
static void unl_bool_to_number_end(void) {
unl_emit(K1);
unl_emit_tick(2);
unl_emit_churchnum(23);
unl_emit(CONS_KI);
putchar('v');
}
static void unl_emit_op(Inst* inst) {
switch (inst->op) {
case MOV:
if (inst->src.type == REG) {
unl_setreg_begin(unl_regpos(inst->dst.reg));
unl_getreg(inst->src.reg);
unl_setreg_end();
} else {
unl_setreg_imm(unl_regpos(inst->dst.reg), inst->src.imm);
}
break;
case ADD:
unl_setreg_begin(unl_regpos(inst->dst.reg));
if (inst->src.type == IMM && inst->src.imm == 1) {
unl_emit(S2);
unl_getreg(inst->dst.reg);
unl_emit(K1);
unl_emit(POST_INC);
} else if (inst->src.type == IMM && inst->src.imm == UINT_MAX) {
unl_emit(S2);
unl_getreg(inst->dst.reg);
unl_emit(K1);
unl_emit(POST_DEC);
} else {
unl_lib_add();
unl_getreg(inst->dst.reg);
unl_emit_value(&inst->src);
}
unl_setreg_end();
break;
case SUB:
unl_setreg_begin(unl_regpos(inst->dst.reg));
if (inst->src.type == IMM && inst->src.imm == 1) {
unl_emit(S2);
unl_getreg(inst->dst.reg);
unl_emit(K1);
unl_emit(POST_DEC);
} else {
unl_lib_sub();
unl_getreg(inst->dst.reg);
unl_emit_value(&inst->src);
}
unl_setreg_end();
break;
case JMP:
unl_emit_jmp(&inst->jmp);
break;
case JEQ:
case JNE:
case JLT:
case JGT:
case JLE:
case JGE:
unl_emit(S2);
unl_emit(S2);
if (inst->op == JEQ || inst->op == JNE) {
unl_lib_eq();
} else {
unl_lib_lt();
}
if (inst->op == JGT || inst->op == JLE) {
unl_emit_value(&inst->src);
unl_emit_value(&inst->dst);
} else {
unl_emit_value(&inst->dst);
unl_emit_value(&inst->src);
}
if (inst->op == JNE || inst->op == JLE || inst->op == JGE) {
putchar('i');
unl_emit_jmp(&inst->jmp);
} else {
unl_emit_jmp(&inst->jmp);
putchar('i');
}
break;
case EQ:
case NE:
case LT:
case GT:
case LE:
case GE:
unl_setreg_begin(unl_regpos(inst->dst.reg));
unl_bool_to_number_begin();
if (inst->op == NE || inst->op == LE || inst->op == GE) {
unl_emit(S2);
unl_emit(S2);
}
if (inst->op == EQ || inst->op == NE) {
unl_lib_eq();
} else {
unl_lib_lt();
}
if (inst->op == GT || inst->op == LE) {
unl_emit_value(&inst->src);
unl_emit_value(&inst->dst);
} else {
unl_emit_value(&inst->dst);
unl_emit_value(&inst->src);
}
if (inst->op == NE || inst->op == LE || inst->op == GE) {
unl_emit("`k`ki");
unl_emit("`kk");
}
unl_bool_to_number_end();
unl_setreg_end();
break;
case LOAD:
unl_setreg_begin(unl_regpos(inst->dst.reg));
unl_lib_load();
unl_emit_value(&inst->src);
unl_setreg_end();
break;
case STORE:
unl_lib_store();
unl_emit_value(&inst->src);
unl_emit_value(&inst->dst);
break;
case PUTC:
unl_emit(S2);
unl_emit("k");
unl_lib_putc();
unl_emit_value(&inst->src);
break;
case GETC:
unl_setreg_begin(unl_regpos(inst->dst.reg));
unl_lib_getc();
unl_setreg_end();
break;
case EXIT:
unl_emit("``s`ke`ki");
break;
case DUMP:
putchar('i');
break;
default:
error("not implemented %d", inst->op);
}
}
static Inst* unl_emit_chunk(Inst* inst) {
int pc = inst->pc;
printf("\n# pc=%d\n", pc);
Inst* reversed = NULL;
while (inst && inst->pc == pc) {
Inst* next = inst->next;
inst->next = reversed;
reversed = inst;
inst = next;
}
for (; reversed; reversed = reversed->next) {
printf("# ");
dump_inst_fp(reversed, stdout);
if (reversed->next) {
unl_emit_tick(2);
unl_emit(COMPOSE);
}
unl_emit_op(reversed);
putchar('\n');
}
return inst;
}
static void unl_emit_text(Inst* inst) {
int first = 1;
while (inst) {
unl_list_begin(first);
first = 0;
inst = unl_emit_chunk(inst);
}
unl_list_end();
}
static void unl_emit_data(Data* data) {
for (Data* d = data; d; d = d->next) {
unl_list_begin(d == data);
unl_emit_number2(d->v);
}
unl_list_end();
}
static void unl_emit_print(int n) {
if (n == 10) {
putchar('r');
} else {
putchar('.');
putchar(n);
}
}
static void unl_emit_putc_rec(int n, int b) {
if (b == 128) {
unl_emit("``s``s`ks``s``s`ksk`k`k");
unl_emit_print(n + b);
unl_emit("`k`k");
unl_emit_print(n);
} else {
unl_emit("``s`k`si``s``s`ks``s``s`ksk");
unl_emit("`k`k");
unl_emit_putc_rec(n + b, b + b);
unl_emit("`k`k");
unl_emit_putc_rec(n, b + b);
}
}
static void unl_emit_libputc(void) {
unl_emit(S2);
unl_emit(S2);
putchar('i');
unl_emit(K1);
unl_emit_putc_rec(0, 1);
unl_emit("`ki");
}
static void unl_emit_libgetc(void) {
unl_emit("``s`d`@k");
for (int c = 1; c < 256; c++) {
unl_emit(S2);
unl_emit(S2);
unl_emit("`d");
unl_emit("`?");
putchar(c);
putchar('i');
unl_emit(K1);
unl_emit_number2(c);
}
unl_emit(S2);
putchar('i');
unl_emit(K1);
unl_emit_number2(0);
}
static void unl_emit_libs(void) {
unl_list_begin(1);
unl_emit_libputc();
unl_list_begin(0);
unl_emit_libgetc();
unl_list_end();
}
static void unl_emit_core(void) {
unl_emit(unl_core);
unl_emit_libs();
putchar('\n');
}
void target_unl(Module* module) {
unl_emit_tick(2);
printf("# VM core\n");
unl_emit_core();
printf("# instructions\n");
unl_emit_text(module->text);
printf("# data\n");
unl_emit_data(module->data);
putchar('\n');
}