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 = 2, 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, NT_WHILE = 13 }

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 }
    case NT_WHILE:
    { pind(ind);
      outs("WHILE ");
      print(n ! 2, 0);
      outs(" DO\n");
      print(n ! 3, ind + 3);
      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, num_labels = 0;

let codegen_jump_if_false(n, dest, reg) be
{ switchon n ! nd_type into
  { case NT_LESSEQ:
    { codegen_expr(n ! 2, reg);
      codegen_expr(n ! 3, reg + 1);
      out("   COMP  R%d, R%d\n", reg, reg + 1);
      out("   JCOND GTR, L%d\n", dest);
      endcase }
    default:
      out("error codegen_jump_if_false node type %d\n", n ! nd_type) } }

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 := 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 varnode = n ! i;
        let he = varnode ! 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 }
    case NT_WHILE:
    { let l_loop = num_labels + 1,
          l_end = num_labels + 2;
      num_labels +:= 2;
      out("L%d:\n", l_loop);
      codegen_jump_if_false(n ! 2, l_end, 1);
      codegen(n ! 3);
      out("   JUMP  L%d\n", l_loop);
      out("L%d:\n", l_end);
      endcase }
    default:
      out("error codegen node type %d\n", n ! nd_type) } }

/*
  the following tree represents
    { let n, fac, i;
      n := 7;
      fac := 1;
      i := 1;
      while i <= n do
      { fac := fac * i;
        i := i - 1 } }
*/

let run() be
{ let s1 = n(NT_LET, n(NT_VAR, id("n")),
                     n(NT_VAR, id("fac")), 
                     n(NT_VAR, id("i")));
  let s2 = n(NT_ASSIGN, n(NT_VAR, id("n")),
                        n(NT_NUMBER, 7));
  let s3 = n(NT_ASSIGN, n(NT_VAR, id("fac")),
                        n(NT_NUMBER, 1));
  let s4 = n(NT_ASSIGN, n(NT_VAR, id("i")),
                        n(NT_NUMBER, 1));
  let s5 = n(NT_ASSIGN, n(NT_VAR, id("fac")),
                        n(NT_MUL, n(NT_VAR, id("fac")),
                                  n(NT_VAR, id("i"))));
  let s6 = n(NT_ASSIGN, n(NT_VAR, id("i")),
                        n(NT_ADD, n(NT_VAR, id("i")),
                                  n(NT_NUMBER, 1)));
  let s7 = n(NT_WHILE, n(NT_LESSEQ, n(NT_VAR, id("i")),
                                    n(NT_VAR, id("n"))),
                       n(NT_SEQ, s5, s6));
  let s = n(NT_SEQ, s1, s2, s3, s4, s7);
  print(s, 0);
  outch('\n');
  codegen(s) }

let start() be
{ init(!0x101, !0x100 - !0x101);
  htable := newvec(htsize);
  for i = 0 to htsize - 1 do
    htable ! i := nil;
  run(); }