// Code ----------------------------------------------------------------------------------------------------------------------------------
test {
(:i,:c.g,:m.o) :- #irl.source(:i,:c),
#irl.compile(:c,:c.g,{},:m.o),
#asm.print(:c.g,0),
frm.length(:m.o,:n),
#asm.exec(:c.g,:n);
}
irl.source { // IRL source code to be compiled
(1,[
poke(name(value),cons(10)),
poke(name(count),cons(1)),
poke(name(result),cons(1)),
test(expr(gte,peek(name(value)),peek(name(count))),noop("then"),noop("else")),
loop(expr(lt,peek(name(count)),peek(name(value))),blok( [
noop("block"),
poke(name(count),expr(add,peek(name(value)),cons(1))),
poke(name(result),expr(mul,peek(name(result)),peek(name(count))))
])),
call(print,peek(name(result)))
]);
(2,[
noop("start of program"),
poke(name(value),cons(10)),
poke(name(count),cons(1)),
poke(name(result),expr(mul,peek(name(value)),peek(name(count)))),
test(expr(gte,peek(name(value)),peek(name(count))),call(print,cons(42)),call(print,cons(666))),
poke(name(i),cons(10)),
loop(expr(gt,peek(name(i)),cons(0)),poke(name(i),expr(sub,peek(name(i)),cons(1)))),
blok([
call(print,cons(101)),
call(print,cons(102))
]),
noop("end of program")
]);
(3,[
// loop 10 times
noop("start of program"),
poke(name(i),cons(0)),
poke(name(j),cons(0)),
loop(expr(lt,peek(name(i)),cons(10)),
blok([
call(print,peek(name(i))),
test(expr(neq,peek(name(i)),cons(5)),call(print,peek(name(j))),noop("i is 5")),
poke(name(i),expr(add,peek(name(i)),cons(1))),
poke(name(j),expr(sub,peek(name(j)),cons(1)))
])),
noop("end of program")
]);
(4,[
noop("start of program"),
poke(name(i),cons(10)),
poke(name(j),cons(1)),
test(expr(lt,peek(name(i)),peek(name(j))),blok([call(print,cons(42))]),blok([call(print,cons(666))])),
call(print,cons(101)),
noop("end of program")
]);
}
irl.match.expr { // match a statement to an instruction
(add,ADD)^ :- true;
(sub,SUB)^ :- true;
(mul,MUL)^ :- true;
(div,DIV)^ :- true;
(gt,GT)^ :- true;
(lt,LT)^ :- true;
(gte,GTE)^ :- true;
(lte,LTE)^ :- true;
(eq,EQ)^ :- true;
(neq,NEQ)^ :- true;
}
irl.compile.instr { // compile a single IRL instruction into ASM
(cons(:n),[instr(LOAD,l(:n))],:m,:m)^ :- true;
(poke(name(:v),:e),:ins,:m.i,:m.o) :- frm.fetch(:m.i,:v,:a)^,
#irl.compile.instr(:e,:e.g,:m.i,:m.o),
lst.cat(:e.g,instr(STORE,m(:a)),:ins);
(poke(name(:v),:e),:ins,:m.i,:m.o)^ :- frm.length(:m.i,:a), frm.store(:m.i,:v,:a,:m.i.o),
#irl.compile.instr(:e,:e.g,:m.i.o,:m.o),
lst.cat(:e.g,instr(STORE,m(:a)),:ins);
(peek(name(:v)),:ins,:m.i,:m.i) :- frm.fetch(:m.i,:v,:a)^,
lst.cat(instr(LOAD,m(:a)),:ins);
(peek(name(:v)),[],:m.i,m.i)^ :- console.puts("peeking unknown variable: ",:v);
(expr(:s,:l,cons(:n)),:ins,:m.i,:m.o)^ :- #irl.compile.instr(:l,:l.g,:m.i,:m.o),
#irl.match.expr(:s,:i),
lst.cat(:l.g,instr(:i,l(:n)),:ins);
(expr(:s,:l,:r),:ins,:m.i,:m.o)^ :- #irl.compile.instr(:l,:l.g,:m.i,:m.l),
#irl.compile.instr(:r,:r.g,:m.l,:m.o),
#irl.match.expr(:s,:i),
lst.cat(:r.g,instr(STORE,r(0)),:l.g,instr(:i,r(0)),:ins);
(test(:c,:t,:e),:ins,:m.i,:m.o)^ :- #irl.compile.instr(:c,:c.g,:m.i,:m.c), lst.length(:c.g,:l.c.g),
#irl.compile.instr(:t,:t.g,:m.c,:m.t), lst.length(:t.g,:l.t.g),
#irl.compile.instr(:e,:e.g,:m.t,:m.o), lst.length(:e.g,:l.e.g),
sum(1,:l.t.g,1,:l1),
add(1,:l.e.g,:l2),
lst.cat(:c.g,instr(JUMP0,:l1),:t.g,instr(JUMP,:l2),:e.g,:ins);
(call(:l,:e),:ins,:m.i,:m.o)^ :- #irl.compile.instr(:e,:e.g,:m.i,:m.o),
lst.cat(:e.g,instr(CALL,:l),:ins);
(noop,[instr(NOOP,nil)],:m,:m)^ :- true;
(noop(:a),[instr(NOOP,:a)],:m,:m)^ :- true;
(loop(:c,:d),:ins,:m.i,:m.o)^ :- #irl.compile.instr(:c,:c.g,:m.i,:m.c), lst.length(:c.g,:l.c.g),
#irl.compile.instr(:d,:d.g,:m.c,:m.o), lst.length(:d.g,:l.d.g),
sum(:l.c.g,1,:l.d.g,:l1),
sum(1,:l.d.g,1,:l2),
sub(0,:l1,:l1.n),
lst.cat(:c.g,instr(JUMP0,:l2),:d.g,instr(JUMP,:l1.n),:ins);
(blok(:l?[is.list]),:ins,:m.i,:m.o)^ :- #irl.compile(:l,:l.c,:m.i,:m.o),
lst.cat(:l.c,:ins);
(:f?[is.func],_,_,_)^ :- fun.label(:f,:l), console.puts("statement labeled ",:l," unknown.");
}
irl.compile { // compile IRL source code into ASM
([],[],:m.i,:m.i)^ :- true;
([:i],:i.c,:m.i,:m.o)^ :- #irl.compile.instr(:i,:i.c,:m.i,:m.o);
([:i|:r],:r.o,:m.i,:m.o) :- #irl.compile.instr(:i,:i.c,:m.i,:m.i.o), #irl.compile(:r,:r.c,:m.i.o,:m.o), lst.cat(:i.c,:r.c,:r.o);
}
asm.print { // print ASM code on the console
([],_)^ :- true;
([:e],:n)^ :- console.puts(:n," ",:e);
([:h|:r],:n) :- console.puts(:n," ",:h), add(:n,1,:n.1), #asm.print(:r,:n.1);
}
asm.exec.call { // execute 'CALL' ASM instruction
(print,:a,:v,:r) :- console.puts(:a);
}
asm.exec.noop { // execute 'NOOP' ASM instruction
(:p,_,_,_) :- console.puts("noop(",:p,")");
}
asm.exec.gt { // execute 'GT' ASM instruction
(:l,:l,0)^ :- true;
(:l,:r,1) :- gt(:l,:r)^;
(_,_,0)^ :- true;
}
asm.exec.gte { // execute 'GTE' ASM instruction
(:l,:l,1)^ :- true;
(:l,:r,1) :- gt(:l,:r)^;
(_,_,0)^ :- true;
}
asm.exec.lt { // execute 'LT' ASM instruction
(:l,:r,1) :- lt(:l,:r)^;
(_,_,0)^ :- true;
}
asm.exec.lte { // execute 'LTE' ASM instruction
(:l,:l,1)^ :- true;
(:l,:r,1) :- lt(:l,:r)^;
(_,_,0)^ :- true;
}
asm.exec.eq { // execute 'EQ' ASM instruction
(:l,:l,1)^ :- true;
(_,_,0)^ :- true;
}
asm.exec.neq { // execute 'NEQ' ASM instruction
(:l,:l,0)^ :- true;
(_,_,1)^ :- true;
}
asm.exec.instr { // execute an ASM instruction
(instr(NOOP,:f),:a,:v,:r,:a,:v,:r,1)^ :- #asm.exec.noop(:f,:a,:v,:r);
(instr(CALL,:f),:a,:v,:r,:a,:v,:r,1)^ :- #asm.exec.call(:f,:a,:v,:r);
(instr(LOAD,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:a.o);
(instr(LOAD,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:a.o);
(instr(LOAD,l(:n)),:a,:v,:r,:n,:v,:r,1)^ :- true;
(instr(STORE,m(:n)),:a,:v,:r,:a,:v.o,:r,1)^ :- lst.swap(:v,:n,:a,:v.o);
(instr(STORE,r(:n)),:a,:v,:r,:a,:v,:r.o,1)^ :- lst.swap(:r,:n,:a,:r.o);
(instr(ADD,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), add(:a,:value,:a.o);
(instr(ADD,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), add(:a,:value,:a.o);
(instr(ADD,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- add(:a,:n,:a.o);
(instr(SUB,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), sub(:a,:value,:a.o);
(instr(SUB,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), sub(:a,:value,:a.o);
(instr(SUB,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- sub(:a,:n,:a.o);
(instr(MUL,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), mul(:a,:value,:a.o);
(instr(MUL,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), mul(:a,:value,:a.o);
(instr(MUL,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- mul(:a,:n,:a.o);
(instr(DIV,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), div(:a,:value,:a.o);
(instr(DIV,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), div(:a,:value,:a.o);
(instr(DIV,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- div(:a,:n,:a.o);
(instr(GT,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), #asm.exec.gt(:a,:value,:a.o);
(instr(GT,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), #asm.exec.gt(:a,:value,:a.o);
(instr(GT,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- #asm.exec.gt(:a,:n,:a.o);
(instr(GTE,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), #asm.exec.gte(:a,:value,:a.o);
(instr(GTE,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), #asm.exec.gte(:a,:value,:a.o);
(instr(GTE,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- #asm.exec.gte(:a,:l,:a.o);
(instr(LT,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), #asm.exec.lt(:a,:value,:a.o);
(instr(LT,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), #asm.exec.lt(:a,:value,:a.o);
(instr(LT,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- #asm.exec.lt(:a,:n,:a.o);
(instr(LTE,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), #asm.exec.lte(:a,:value,:a.o);
(instr(LTE,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), #asm.exec.lte(:a,:value,:a.o);
(instr(LTE,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- #asm.exec.lte(:a,:n,:a.o);
(instr(EQ,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), #asm.exec.eq(:a,:value,:a.o);
(instr(EQ,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), #asm.exec.eq(:a,:value,:a.o);
(instr(EQ,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- #asm.exec.eq(:a,:n,:a.o);
(instr(NEQ,m(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:v,:n,:value), #asm.exec.neq(:a,:value,:a.o);
(instr(NEQ,r(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- lst.item(:r,:n,:value), #asm.exec.neq(:a,:value,:a.o);
(instr(NEQ,l(:n)),:a,:v,:r,:a.o,:v,:r,1)^ :- #asm.exec.neq(:a,:n,:a.o);
(instr(JUMP0,:n?[is.number]),0,:v,:r,0,:v,:r,:n)^ :- true;
(instr(JUMP0,:n?[is.number]),:a,:v,:r,:a,:v,:r,1)^ :- true;
(instr(JUMP1,:n?[is.number]),0,:v,:r,0,:v,:r,1)^ :- true;
(instr(JUMP1,:n?[is.number]),:a,:v,:r,:a,:v,:r,:n)^ :- true;
(instr(JUMP,:n?[is.number]),:a,:v,:r,:a,:v,:r,:n)^ :- true;
(instr(:c,_),:a,:v,:r,:a,:v,:r,1)^ :- console.puts("opcode ",:c," is unknown.");
}
asm.exec { // execute ASM code
(:code,:n)^ :- lst.length(:vars,:n,0), lst.length(:regs,1,0), #asm.exec(:code,0,0,:vars,:regs);
(:code,:pc,_,_,_) :- lst.length(:code,:len), gte(:pc,:len)^;
(:code,:pc,:accu,:vars,:regs) :- lst.item(:code,:pc,:instr),
#asm.exec.instr(:instr,:accu,:vars,:regs,:accu.o,:vars.o,:regs.o,:pc.off),
add(:pc,:pc.off,:pc.next),
#asm.exec(:code,:pc.next,:accu.o,:vars.o,:regs.o);
}