module M = Map.Make(Char)

type register = char                (* processor registers = variables *)
type flag_t = Neg | Z | Pos        (* processor flags after CMP instruction *)
type rightpart = R of register | I of int        (* second arg of binary op *)
type binop = LD | ADD | SUB | MUL | DIV | MOD        (* =, +=, -=, *=, /=, %= *)
type jmpcond = T | E | NE | L | LE | G | GE
type instruction = HLT | BOP of binop * register * rightpart
                   | CMP of register * rightpart | JMP of jmpcond * int

let eval dict = function        (* get value from right-hand side *)
  | I i -> i
  | R r -> M.find r dict

let sgn n = if n = 0 then Z else if n > 0 then Pos else Neg

let run prog =
  let rec exec d fl pc =        (* dict, flag, prog counter *)
    print_int pc; M.iter (Printf.printf " %c=%d") d; print_newline();
    let nxt = pc + 1 in match Array.get prog pc with
      | HLT -> d                (* return dict of values *)
      | CMP (r, rhs) ->                (* just updates flag *)
         let nfl = sgn (M.find r d - eval d rhs) in exec d nfl nxt
      | BOP (op, r, rhs) ->
         let v2 = eval d rhs in
         let nv = if op = LD then v2 else
             let fct = match op with
               | ADD -> (+)
               | SUB -> (-)
               | MUL -> ( *)
               | DIV -> (/)
               | MOD -> (mod)
               | _ -> fun _ y -> y        (* LD will not get here *)
             in fct (M.find r d) v2
         in exec (M.add r nv d) fl nxt
      | JMP (jcond, off) ->
         let cond = match jcond with
           | T -> true
           | E -> fl = Z
           | NE -> fl <> Z
           | L -> fl = Neg
           | LE -> fl <> Pos
           | G -> fl = Pos
           | GE -> fl <> Neg
         in exec d fl (if cond then nxt + off else nxt)
  in exec M.empty Z 0        (* keep dict, ignore flag *)

let factbin =
  [|BOP (LD, 'n', I 5); BOP (LD, 'r', I 1); CMP ('n', I 0); JMP (LE, +3);
    BOP (MUL, 'r', R 'n'); BOP (SUB, 'n', I 1); JMP (T, -5); HLT|]
let collbin =
  [|BOP (LD, 'n', I 10); BOP (LD, 's', I 0); CMP ('n', I 1); JMP (LE, +10);
    BOP (ADD, 's', I 1); BOP (LD, 'p', R 'n'); BOP (MOD, 'p', I 2);
    CMP ('p', I 0); JMP (NE, +2); BOP (DIV, 'n', I 2); JMP (T, +2);
    BOP (MUL, 'n', I 3); BOP (ADD, 'n', I 1); JMP (T, -12); HLT|]
 
let n = M.find 'r' (run factbin)

let s = M.find 's' (run collbin)

(* de continuat: traducere din statement list in instruction array *)
  
type cmpop = Eq | Ne | Lt | Le | Gt | Ge        (* ==, !=, <, <=, >, >= *)
type boolexp = register * cmpop * rightpart
type statement = Asgn of binop * register * rightpart
                 | If of boolexp * statement list * statement list
                 | While of boolexp * statement list
                     
let factprog =
  [ Asgn (LD, 'n', I 5) ; Asgn (LD, 'r', I 1) ;        (* n = 5; r = 1; *)
    While (('n', Gt, I 0), [Asgn (MUL, 'r', R 'n'); Asgn (SUB, 'n', I 1)]) ]        (* while (n > 0) { r *= n; n -= 1; } *)

let collprog =
  [ Asgn (LD, 'n', I 10); Asgn (LD, 's', I 0);        (* n = 10; s = 0; *)
    While (('n', Gt, I 1),                            (* while (n > 1) { *)
           [ Asgn (ADD, 's', I 1); Asgn (LD, 'p', R 'n'); Asgn (MOD, 'p', I 2);        (* s += 1; p = n; p %= 2; *)
             If (('p', Eq, I 0), [ Asgn (DIV, 'n', I 2) ],                   (* if (p == 0) n /= 2; *)
                 [ Asgn (MUL, 'n', I 3); Asgn (ADD, 'n', I 1) ]) ]) ]        (* else { n *= 3; n += 1; } } *) 
    

This document was generated using caml2html