import "io" manifest { htsize = 100 } let htable = nil; let hash(s) be { let h = 93291, i = 0; while true do { let c = byte i of s; if c = 0 then break; h := h * 69 + c; i +:= 1 } resultis (h bitand 0x7FFFFFFF) rem htsize } let streql(s, t) be { let i = 0; while true do { let a = byte i of s, b = byte i of t; if a /= b then resultis false; if a = 0 then resultis true; i +:= 1; } } let pind(n) be { for i = 1 to n do outch(' ') } manifest { he_string = 0, he_decl = 1, he_next = 2, sizeof_he = 3; decl_type = 0, decl_value = 1, decl_next = 3, sizeof_decl = 3 } let id(s) be { let h = hash(s); let p = htable ! h; while p <> nil do { if streql(s, p ! he_string) then resultis p; p := p ! he_next } p := newvec(sizeof_he); p ! he_string := s; p ! he_decl := nil; p ! he_next := htable ! h; htable ! h := p; resultis p } let printhe(he) be { let d = he ! he_decl; out("%s", he ! he_string); while d <> nil do { out(" %c%d", d ! decl_type, d ! decl_value); d := d ! decl_next } outch('\n') } let print_all_vars() be { for i = 0 to htsize - 1 do { let he = htable ! i; while he <> nil do { outs("all "); printhe(he); he := he ! he_next } } } manifest { nd_size = 0, nd_type = 1 } let n(a) be { let len = numbargs(); let p = newvec(len + 1); let arg = @a; p!nd_size := len; for i = 0 to len-1 do p!(i+1) := arg!i; resultis p } manifest { NT_ADD = 1, NT_SUB = 2, NT_MUL = 3, NT_DIV = 4, NT_EQUAL = 5, NT_LESS = 6, NT_LESSEQ = 7, NT_NUMBER = 8, NT_VAR = 9, NT_LET = 10, NT_ASSIGN = 11, NT_SEQ = 12 } let print_expr(n) be { outs("( "); print(n ! 2, 0); switchon n ! nd_type into { case NT_ADD: outs(" + "); endcase; case NT_SUB: outs(" - "); endcase; case NT_MUL: outs(" * "); endcase; case NT_DIV: outs(" / "); endcase; case NT_EQUAL: outs(" = "); endcase; case NT_LESS: outs(" < "); endcase; case NT_LESSEQ: outs(" <= "); endcase; default: out("Error with operator %d\n", n ! nd_type) } print(n ! 3, 0); outs(" )") } and print(n, ind) be { switchon n ! nd_type into { case NT_NUMBER: { outno(n ! 2); endcase } case NT_VAR: { outs(n ! 2 ! he_string); endcase } case NT_ADD: case NT_SUB: case NT_MUL: case NT_DIV: case NT_EQUAL: case NT_LESS: case NT_LESSEQ: { print_expr(n); endcase } case NT_LET: { pind(ind); outs("LET "); print(n ! 2, 0); for i = 3 to n ! nd_size do { outs(", "); print(n ! i, 0); } outch('\n'); endcase } case NT_ASSIGN: { pind(ind); print(n ! 2, 0); out(" := "); print(n ! 3, 0); outch('\n'); endcase } case NT_SEQ: { pind(ind); outs("{\n"); for i = 2 to n ! nd_size do print(n ! i, ind + 3); pind(ind); outs("}\n"); endcase } default: { out("Error printing node type %d\n", n ! nd_type) } } } let print_op(op, r1, r2) be { switchon op into { case NT_ADD: out(" ADD R%d, R%d\n", r1, r2); endcase; case NT_SUB: out(" SUB R%d, R%d\n", r1, r2); endcase; case NT_MUL: out(" MUL R%d, R%d\n", r1, r2); endcase; case NT_DIV: out(" DIV R%d, R%d\n", r1, r2); endcase; default: out("Error with print_op %d\n", n ! nd_type) } } let codegen_expr(n, reg) be { switchon n ! nd_type into { case NT_NUMBER: out(" LOAD R%d, %d\n", reg, n ! 2); endcase; case NT_VAR: { let he = n ! 2; let decl = he ! he_decl; if decl = nil then { out("undeclared variable %s\n", he ! he_string); return; } test decl ! decl_type = 'L' then test decl ! decl_value < 0 then out(" LOAD R%d, [FP%d]\n", reg, decl ! decl_value) else out(" LOAD R%d, [FP+%d]\n", reg, decl ! decl_value) else out("wrong decl_type %c for %s\n", decl ! decl_type, he ! he_string); endcase } case NT_ADD: case NT_SUB: case NT_MUL: case NT_DIV: case NT_EQUAL: case NT_LESS: case NT_LESSEQ: codegen_expr(n ! 2, reg); codegen_expr(n ! 3, reg+1); print_op(n ! nd_type, reg, reg+1); endcase; default: { out("Error codegen_expr node type %d\n", n ! nd_type); print(n, 0) } } } let codegen_store(r, n) be { test n ! nd_type = NT_VAR then { let he = n ! 2; let decl = he ! he_decl; if decl = nil then { out("use of undeclared variable %s\n", he ! he_string); return; } test decl ! decl_type = 'L' then test decl ! decl_value < 0 then out(" STORE R%d, [FP%d]\n", r, decl ! decl_value) else out(" STORE R%d, [FP+%d]\n", r, decl ! decl_value) else out("wrong decl_type %c for %s\n", decl ! decl_type, he ! he_string) } else outs("Don't know how to translate this kind of destination\n") } let num_locals = 0; let un_codegen(n) be { switchon n ! nd_type into { case NT_LET: { for i = 2 to n ! nd_size do { let varnode = n ! i; let he = varnode ! 2; let decl = he ! he_decl; he ! he_decl := he ! he_decl ! decl_next } endcase } } } let codegen(n) be { switchon n ! nd_type into { case NT_SEQ: { for i = 2 to n ! nd_size do codegen(n ! i); for i = 2 to n ! nd_size do un_codegen(n ! i); endcase } case NT_ASSIGN: { codegen_expr(n ! 3, 1); codegen_store(1, n ! 2); endcase } case NT_LET: { for i = 2 to n ! nd_size do { let he = n ! i ! 2; let newdecl = newvec(sizeof_decl); num_locals +:= 1; newdecl ! decl_type := 'L'; newdecl ! decl_value := - num_locals; newdecl ! decl_next := he ! he_decl; he ! he_decl := newdecl } endcase } } } let run() be { let t1 = n(NT_LET, n(NT_VAR, id("x")), n(NT_VAR, id("y"))); let t2 = n(NT_ASSIGN, n(NT_VAR, id("x")), n(NT_VAR, id("y"))); let t3 = n(NT_LET, n(NT_VAR, id("x")), n(NT_VAR, id("y"))); let t4 = n(NT_ASSIGN, n(NT_VAR, id("x")), n(NT_VAR, id("y"))); let t5 = n(NT_SEQ, t3, t4); let t6 = n(NT_ASSIGN, n(NT_VAR, id("x")), n(NT_VAR, id("y"))); let t7 = n(NT_SEQ, t1, t2, t5, t6); print(t7, 0); outch('\n'); codegen(t7) } let start() be { init(!0x101, !0x100 - !0x101); htable := newvec(htsize); for i = 0 to htsize - 1 do htable ! i := nil; run(); }