Control statement (interpreter, SM, x86)

regression/Makefile

@@ -1,4 +1,4 @@
-TESTS=test001 test002 test003 test004 test005 test006 test007 test008
+TESTS=test001 test002 test003 test004 test005 test006 test007 test008 test009 test010 test011
 
 RC=../src/rc.opt
 

regression/orig/test009.log

@@ -1 +1 @@
-2
+1024

regression/orig/test010.log

@@ -1 +1 @@
-1024
+499950

regression/orig/test011.log

@@ -1,3 +1 @@
-5
+2
-5
-3

regression/orig/test014.log

@@ -1 +0,0 @@
-499950

regression/test009.expr

@@ -0,0 +1,8 @@
+n := 2;
+k := 10;
+res := 1;
+while k > 0 do
+  res := res * n;
+  k := k - 1
+od;
+write(res)

regression/test010.expr

@@ -0,0 +1,18 @@
+i := 0;
+s := 0; 
+
+while i < 100
+do
+    j := 0;
+
+    while j < 100
+    do   
+      s := s + j;
+      j := j + 1
+    od;
+
+    s := s + i;
+    i := i + 1
+od;
+
+write (s)

regression/test011.expr

@@ -0,0 +1,5 @@
+x:=0;
+if x
+then write(1)
+else write(2)
+fi

src/Driver.ml

@@ -6,7 +6,7 @@ let parse infile =
     (object
        inherit Matcher.t s
        inherit Util.Lexers.decimal s
-       inherit Util.Lexers.ident ["read"; "write"] s
+       inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "fi"; "while"; "do"; "od"] s
        inherit Util.Lexers.skip [
 	 Matcher.Skip.whitespaces " \t\n";
 	 Matcher.Skip.lineComment "--";

src/Language.ml

@@ -110,8 +110,11 @@ module Stmt =
     (* read into the variable           *) | Read   of string
     (* write the value of an expression *) | Write  of Expr.t
     (* assignment                       *) | Assign of string * Expr.t
-    (* composition                      *) | Seq    of t * t with show
+    (* composition                      *) | Seq    of t * t 
-
+    (* empty statement                  *) | Skip
+    (* conditional                      *) | If     of Expr.t * t * t
+    (* loop                             *) | While  of Expr.t * t with show
+                                                                    
     (* The type of configuration: a state, an input stream, an output stream *)
     type config = Expr.state * int list * int list 
 
@@ -123,10 +126,13 @@ module Stmt =
     *)
     let rec eval ((st, i, o) as conf) stmt =
       match stmt with
-      | Read    x       -> (match i with z::i' -> (Expr.update x z st, i', o) | _ -> failwith "Unexpected end of input")
+      | Read    x          -> (match i with z::i' -> (Expr.update x z st, i', o) | _ -> failwith "Unexpected end of input")
-      | Write   e       -> (st, i, o @ [Expr.eval st e])
+      | Write   e          -> (st, i, o @ [Expr.eval st e])
-      | Assign (x, e)   -> (Expr.update x (Expr.eval st e) st, i, o)
+      | Assign (x, e)      -> (Expr.update x (Expr.eval st e) st, i, o)
-      | Seq    (s1, s2) -> eval (eval conf s1) s2
+      | Seq    (s1, s2)    -> eval (eval conf s1) s2
+      | Skip               -> conf
+      | If     (e, s1, s2) -> eval conf (if Expr.eval st e <> 0 then s1 else s2)
+      | While  (e, s)      -> if Expr.eval st e = 0 then conf else eval (eval conf s) stmt
                                 
     (* Statement parser *)
     ostap (
@@ -134,9 +140,12 @@ module Stmt =
         s:stmt ";" ss:parse {Seq (s, ss)}
       | stmt;
       stmt:
-        "read" "(" x:IDENT ")"          {Read x}
+        %"read"  "(" x:IDENT ")"                                      {Read x}
-      | "write" "(" e:!(Expr.parse) ")" {Write e}
+      | %"write" "(" e:!(Expr.parse) ")"                              {Write e}
-      | x:IDENT ":=" e:!(Expr.parse)    {Assign (x, e)}            
+      | %"skip"                                                       {Skip}
+      | %"if" e:!(Expr.parse) %"then" s1:parse %"else" s2:parse %"fi" {If (e, s1, s2)}
+      | %"while" e:!(Expr.parse) %"do" s:parse %"od"                  {While (e, s)}
+      | x:IDENT ":=" e:!(Expr.parse)                                  {Assign (x, e)}            
     )
       
   end

src/SM.ml

@@ -8,8 +8,11 @@ open Language
 (* read to stack                   *) | READ
 (* write from stack                *) | WRITE
 (* load a variable to the stack    *) | LD    of string
-(* store a variable from the stack *) | ST    of string with show
+(* store a variable from the stack *) | ST    of string
-
+(* a label                         *) | LABEL of string
+(* unconditional jump              *) | JMP   of string                                                                                                                
+(* conditional jump                *) | CJMP  of string * string with show
+                                                   
 (* The type for the stack machine program *)                                                               
 type prg = insn list
 
@@ -20,22 +23,25 @@ type config = int list * Stmt.config
 
 (* Stack machine interpreter
 
-     val eval : config -> prg -> config
+     val eval : env -> config -> prg -> config
 
-   Takes a configuration and a program, and returns a configuration as a result
+   Takes an environment, a configuration and a program, and returns a configuration as a result. The
- *)                         
+   environment is used to locate a label to jump to (via method env#labeled <label_name>)
-let rec eval ((stack, ((st, i, o) as c)) as conf) = function
+*)                         
+let rec eval env ((stack, ((st, i, o) as c)) as conf) = function
 | [] -> conf
 | insn :: prg' ->
-   eval 
+   (match insn with
-     (match insn with
+    | BINOP op    -> let y::x::stack' = stack in eval env (Expr.to_func op x y :: stack', c) prg'
-      | BINOP op -> let y::x::stack' = stack in (Expr.to_func op x y :: stack', c)
+    | READ        -> let z::i' = i     in eval env (z::stack, (st, i', o)) prg'
-      | READ     -> let z::i'        = i     in (z::stack, (st, i', o))
+    | WRITE       -> let z::stack' = stack in eval env (stack', (st, i, o @ [z])) prg'
-      | WRITE    -> let z::stack'    = stack in (stack', (st, i, o @ [z]))
+    | CONST i     -> eval env (i::stack, c) prg'
-      | CONST i  -> (i::stack, c)
+    | LD x        -> eval env (st x :: stack, c) prg'
-      | LD x     -> (st x :: stack, c)
+    | ST x        -> let z::stack' = stack in eval env (stack', (Expr.update x z st, i, o)) prg'
-      | ST x     -> let z::stack'    = stack in (stack', (Expr.update x z st, i, o))
+    | LABEL _     -> eval env conf prg'
-     ) prg'
+    | JMP   l     -> eval env conf (env#labeled l)
+    | CJMP (c, l) -> let x::stack' = stack in eval env conf (if (c = "z" && x = 0) || (c = "nz" && x <> 0) then env#labeled l else prg')
+   ) 
 
 (* Top-level evaluation
 
@@ -43,7 +49,15 @@ let rec eval ((stack, ((st, i, o) as c)) as conf) = function
 
    Takes a program, an input stream, and returns an output stream this program calculates
 *)
-let run p i = let (_, (_, _, o)) = eval ([], (Expr.empty, i, [])) p in o
+let run p i =
+  let module M = Map.Make (String) in
+  let rec make_map m = function
+  | []              -> m
+  | (LABEL l) :: tl -> make_map (M.add l tl m) tl
+  | _ :: tl         -> make_map m tl
+  in
+  let m = make_map M.empty p in
+  let (_, (_, _, o)) = eval (object method labeled l = M.find l m end) ([], (Expr.empty, i, [])) p in o
 
 (* Stack machine compiler
 
@@ -52,14 +66,39 @@ let run p i = let (_, (_, _, o)) = eval ([], (Expr.empty, i, [])) p in o
    Takes a program in the source language and returns an equivalent program for the
    stack machine
 *)
-let rec compile =
+let compile p =
   let rec expr = function
   | Expr.Var   x          -> [LD x]
   | Expr.Const n          -> [CONST n]
   | Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
   in
-  function
+  let rec compile' l env = function  
-  | Stmt.Seq (s1, s2)  -> compile s1 @ compile s2
+  | Stmt.Read    x          -> env, false, [READ; ST x]
-  | Stmt.Read x        -> [READ; ST x]
+  | Stmt.Write   e          -> env, false, expr e @ [WRITE]
-  | Stmt.Write e       -> expr e @ [WRITE]
+  | Stmt.Assign (x, e)      -> env, false, expr e @ [ST x]
-  | Stmt.Assign (x, e) -> expr e @ [ST x]
+  | Stmt.Skip               -> env, false, []
+
+  | Stmt.Seq    (s1, s2)    -> let l2, env = env#get_label in
+                               let env, flag1, s1 = compile' l2 env s1 in
+                               let env, flag2, s2 = compile' l  env s2 in
+                               env, flag2, s1 @ (if flag1 then [LABEL l2] else []) @ s2                                      
+
+  | Stmt.If     (c, s1, s2) -> let l2, env = env#get_label in
+                               let env, flag1, s1 = compile' l env s1 in
+                               let env, flag2, s2 = compile' l env s2 in
+                               env, true, expr c @ [CJMP ("z", l2)] @ s1 @ (if flag1 then [] else [JMP l]) @ [LABEL l2] @ s2 @ (if flag2 then [] else [JMP l])
+                               
+  | Stmt.While  (c, s)      -> let loop, env = env#get_label in
+                               let cond, env = env#get_label in
+                               let env, _, s = compile' cond env s in
+                               env, false, [JMP cond; LABEL loop] @ s @ [LABEL cond] @ expr c @ [CJMP ("nz", loop)]
+  in
+  let env =
+    object
+      val label = 0
+      method get_label = "L_" ^ string_of_int label, {< label = label + 1 >}
+    end
+  in
+  let lend, env = env#get_label in
+  let _, flag, code = compile' lend env p in
+  if flag then code @ [LABEL lend] else code

src/X86.ml

@@ -40,7 +40,10 @@ type instr =
 (* pops from the hardware stack to the operand          *) | Pop   of opnd
 (* call a function by a name                            *) | Call  of string
 (* returns from a function                              *) | Ret
-
+(* a label in the code                                  *) | Label of string
+(* a conditional jump                                   *) | CJmp  of string * string
+(* a non-conditional jump                               *) | Jmp   of string
+                                                               
 (* Instruction printer *)
 let show instr =
   let binop = function
@@ -69,6 +72,9 @@ let show instr =
   | Pop    s           -> Printf.sprintf "\tpopl\t%s"      (opnd s)
   | Ret                -> "\tret"
   | Call   p           -> Printf.sprintf "\tcall\t%s" p
+  | Label  l           -> Printf.sprintf "%s:\n" l
+  | Jmp    l           -> Printf.sprintf "\tjmp\t%s" l
+  | CJmp  (s , l)      -> Printf.sprintf "\tj%s\t%s" s l
 
 (* Opening stack machine to use instructions without fully qualified names *)
 open SM
@@ -104,20 +110,15 @@ let compile env code =
              let s, env' = env#pop in
              (env', [Push s; Call "Lwrite"; Pop eax])
   	  | CONST n ->
-             (*env#push (L n), []*)             
+             let s, env' = env#allocate in
-	     let s, env' = env#allocate in
+	     (env', [Mov (L n, s)])               
-	     (env', [Mov (L n, s)])  
-             
 	  | LD x ->
-          (* (env#global x)#push (M x), []*)
+             let s, env' = (env#global x)#allocate in
-
-	     let s, env' = (env#global x)#allocate in
              env',
 	     (match s with
 	      | S _ | M _ -> [Mov (M (env'#loc x), eax); Mov (eax, s)]
 	      | _         -> [Mov (M (env'#loc x), s)]
 	     )	        
-
 	  | ST x ->
 	     let s, env' = (env#global x)#pop in
              env',
@@ -128,12 +129,7 @@ let compile env code =
           | BINOP op ->
 	     let x, y, env' = env#pop2 in
              env'#push y,
-             (*
+             (match op with
-             let y, env', c = match y with L _ -> let z, env' = env'#allocate in z, env', [Mov (y, z)] | _ -> y, env'#push y, [] in
-             env',
-             c @
-              *)
-	     (match op with
 	      | "/" | "%" ->
                  [Mov (y, eax);
                   Cltd;
@@ -188,6 +184,11 @@ let compile env code =
                  then [Mov   (x, eax); Binop (op, eax, y)]
                  else [Binop (op, x, y)]
              )
+          | LABEL s     -> env, [Label s]
+	  | JMP   l     -> env, [Jmp l]
+          | CJMP (s, l) ->
+              let x, env = env#pop in
+              env, [Binop ("cmp", L 0, x); CJmp  (s, l)]
         in
         let env'', code'' = compile' env' scode' in
 	env'', code' @ code''
@@ -240,7 +241,7 @@ class env =
     method globals = S.elements globals
   end
 
-(* compiles a unit: generates x86 machine code for the stack program and surrounds it
+(* Compiles a unit: generates x86 machine code for the stack program and surrounds it
    with function prologue/epilogue
 *)
 let compile_unit env scode =