Functions in X86

regression/Makefile

@@ -7,7 +7,7 @@ RC=../src/rc.opt
 check: $(TESTS)
 
 $(TESTS): %: %.expr
-#	@$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
+	@$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
 

regression/deep-expressions/Makefile

@@ -7,7 +7,7 @@ RC = ../../src/rc.opt
 check: $(TESTS)
 
 $(TESTS): %: %.expr
-#	@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
+	@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
 

regression/expressions/Makefile

@@ -7,7 +7,7 @@ RC = ../../src/rc.opt
 check: $(TESTS)
 
 $(TESTS): %: %.expr
-#	@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
+	@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
 	@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
 

regression/test024.expr

@@ -6,6 +6,8 @@ fun test2 (b) {
   a := b
 }
 
+read (x);
+
 test1 ();
 write (a);
 

regression/test025.expr

@@ -16,6 +16,8 @@ fun print () {
   write (c)
 }
 
+read (x);
+
 a := 100;
 b := 200;
 c := 300;

regression/test026.expr

@@ -19,6 +19,8 @@ fun print () {
   write (c)
 }
 
+read (x);
+
 a := 100;
 b := 200;
 c := 300;

regression/test026.input

@@ -1 +1 @@
-0
+0

regression/test027.expr

@@ -21,6 +21,8 @@ fun test2 (b) {
   print ()
 }
 
+read (x);
+
 a := 100;
 b := 200;
 c := 300;

regression/test032.expr

@@ -5,6 +5,8 @@ fun ack (m, n) {
   fi
 }
 
+read (x);
+
 for m := 0, m <= 3, m := m+1 do
   for n := 0, n <= 8, n := n+1 do
     write (ack (m, n))

regression/test033.expr

@@ -8,5 +8,7 @@ fun test (n, m) local i, s {
   return s
 }
 
+read (x);
+
 write (test (10, 100));
 write (test (100, 10))

src/Driver.ml

@@ -25,11 +25,9 @@ let main =
     match parse infile with
     | `Ok prog ->
       if to_compile
-      then failwith "Not implemented yet"
+      then            
-        (*            
         let basename = Filename.chop_suffix infile ".expr" in
-        ignore @@ X86.build prog basename
+        ignore @@ X86.build prog basename        
-        *)
       else 
 	let rec read acc =
 	  try

src/SM.ml

@@ -10,11 +10,12 @@ open Language
 (* load a variable to the stack    *) | LD    of string
 (* store a variable from the stack *) | ST    of string
 (* a label                         *) | LABEL of string
-(* unconditional jump              *) | JMP   of string                                                                                                                
+(* unconditional jump              *) | JMP   of string
 (* conditional jump                *) | CJMP  of string * string
-(* begins procedure definition     *) | BEGIN of string list * string list
+(* begins procedure definition     *) | BEGIN of string * string list * string list
 (* end procedure definition        *) | END
-(* calls a procedure               *) | CALL  of string with show
+(* calls a function/procedure      *) | CALL  of string * int * bool
+(* returns from a function         *) | RET   of bool with show
                                                    
 (* The type for the stack machine program *)                                                               
 type prg = insn list
@@ -46,18 +47,18 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
     | LABEL  _             -> eval env conf prg'
     | JMP    l             -> eval env conf (env#labeled l)
     | CJMP  (c, l)         -> let x::stack' = stack in eval env (cstack, stack', (st, i, o)) (if (c = "z" && x = 0) || (c = "nz" && x <> 0) then env#labeled l else prg')
-    | CALL   f             -> eval env ((prg', st)::cstack, stack, c) (env#labeled f)
+    | CALL  (f, _, _)      -> eval env ((prg', st)::cstack, stack, c) (env#labeled f)
-    | BEGIN (args, locals) -> let rec combine acc args stack =
+    | BEGIN (_, args, locals) -> let rec combine acc args stack =
 		                match args, stack with
 		                | [], _               -> List.rev acc, stack
 		                | a::args', s::stack' -> combine ((a, s)::acc) args' stack'
 		              in
 		              let state', stack' = combine [] args stack in
                               eval env (cstack, stack', (List.fold_left (fun s (x, v) -> State.update x v s) (State.enter st (args @ locals)) state', i, o)) prg'
-    | END                  -> (match cstack with
+    | END | RET _ -> (match cstack with
-                               | (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
+                      | (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
-                               | []                   -> conf
+                      | []                   -> conf
-                              )
+                     )
    ) 
 
 (* Top-level evaluation
@@ -86,14 +87,14 @@ let run p i =
 *)
 let compile (defs, p) =
   let label s = "L" ^ s in
-  let rec call f args =
+  let rec call f args p =
     let args_code = List.concat @@ List.map expr (List.rev args) in
-    args_code @ [CALL (label f)]
+    args_code @ [CALL (label f, List.length args, p)]
   and expr = function
   | Expr.Var   x          -> [LD x]
   | Expr.Const n          -> [CONST n]
   | Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
-  | Expr.Call  (f, args)  -> call f args
+  | Expr.Call  (f, args)  -> call f args false
   in
   let rec compile_stmt l env = function  
   | Stmt.Read    x          -> env, false, [READ; ST x]
@@ -121,15 +122,15 @@ let compile (defs, p) =
                                let env  , flag, body = compile_stmt check env s in
                                env, false, [LABEL loop] @ body @ (if flag then [LABEL check] else []) @ (expr c) @ [CJMP ("z", loop)]
                                                                                                                      
-  | Stmt.Call   (f, args)   -> env, false, call f args
+  | Stmt.Call   (f, args)   -> env, false, call f args true
                                                          
-  | Stmt.Return e           -> env, false, (match e with Some e -> expr e | None -> []) @ [END]
+  | Stmt.Return e           -> env, false, (match e with Some e -> expr e | None -> []) @ [RET (e <> None)]
   in
   let compile_def env (name, (args, locals, stmt)) =
     let lend, env       = env#get_label in
     let env, flag, code = compile_stmt lend env stmt in
     env,
-    [LABEL name; BEGIN (args, locals)] @
+    [LABEL name; BEGIN (name, args, locals)] @
     code @
     (if flag then [LABEL lend] else []) @
     [END]
@@ -148,5 +149,5 @@ let compile (defs, p) =
   in
   let lend, env = env#get_label in
   let _, flag, code = compile_stmt lend env p in
-  (LABEL "main" :: if flag then code @ [LABEL lend] else code) @ [END] @ (List.concat def_code) 
+  (if flag then code @ [LABEL lend] else code) @ [END] @ (List.concat def_code) 
 

src/X86.ml

@@ -43,7 +43,8 @@ type instr =
 (* a label in the code                                  *) | Label of string
 (* a conditional jump                                   *) | CJmp  of string * string
 (* a non-conditional jump                               *) | Jmp   of string
-                                                               
+(* directive                                            *) | Meta  of string
+                                                                            
 (* Instruction printer *)
 let show instr =
   let binop = function
@@ -58,7 +59,9 @@ let show instr =
   in
   let opnd = function
   | R i -> regs.(i)
-  | S i -> Printf.sprintf "-%d(%%ebp)" ((i+1) * word_size)
+  | S i -> if i >= 0
+           then Printf.sprintf "-%d(%%ebp)" ((i+1) * word_size)
+           else Printf.sprintf "%d(%%ebp)"  (8+(-i-1) * word_size)
   | M x -> x
   | L i -> Printf.sprintf "$%d" i
   in
@@ -75,6 +78,7 @@ let show instr =
   | 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
+  | Meta   s           -> Printf.sprintf "%s\n" s
 
 (* Opening stack machine to use instructions without fully qualified names *)
 open SM
@@ -96,7 +100,7 @@ let compile env code =
   | ">"  -> "g"
   | _    -> failwith "unknown operator"	
   in
-  let rec compile' env scode =
+  let rec compile' env scode =    
     let on_stack = function S _ -> true | _ -> false in
     match scode with
     | [] -> env, []
@@ -116,15 +120,15 @@ let compile env code =
              let s, env' = (env#global x)#allocate in
              env',
 	     (match s with
-	      | S _ | M _ -> [Mov (M (env'#loc x), eax); Mov (eax, s)]
+	      | S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
-	      | _         -> [Mov (M (env'#loc x), s)]
+	      | _         -> [Mov (env'#loc x, s)]
 	     )	        
 	  | ST x ->
 	     let s, env' = (env#global x)#pop in
              env',
              (match s with
-              | S _ | M _ -> [Mov (s, eax); Mov (eax, M (env'#loc x))]
+              | S _ | M _ -> [Mov (s, eax); Mov (eax, env'#loc x)]
-              | _         -> [Mov (s, M (env'#loc x))]
+              | _         -> [Mov (s, env'#loc x)]
 	     )
           | BINOP op ->
 	     let x, y, env' = env#pop2 in
@@ -189,6 +193,41 @@ let compile env code =
           | CJMP (s, l) ->
               let x, env = env#pop in
               env, [Binop ("cmp", L 0, x); CJmp  (s, l)]
+                     
+          | BEGIN (f, a, l) ->
+             let env = env#enter f a l in
+             env, [Push ebp; Mov (esp, ebp); Binop ("-", M ("$" ^ env#lsize), esp)]
+                            
+          | END ->             
+             env, [Label env#epilogue;
+                   Mov (ebp, esp);
+                   Pop ebp;
+                   Ret;
+                   Meta (Printf.sprintf "\t.set\t%s,\t%d" env#lsize (env#allocated * word_size))
+                  ]
+                    
+          | RET b ->
+             if b
+             then let x, env = env#pop in env, [Mov (x, eax); Jmp env#epilogue]
+             else env, [Jmp env#epilogue]
+             
+          | CALL (f, n, p) ->
+             let pushr, popr =
+               List.split @@ List.map (fun r -> (Push r, Pop r)) env#live_registers
+             in
+             let env, code =
+               if n = 0
+               then env, pushr @ [Call f] @ (List.rev popr)
+               else
+                 let rec push_args env acc = function
+                 | 0 -> env, acc
+                 | n -> let x, env = env#pop in
+                        push_args env ((Push x)::acc) (n-1)
+                 in
+                 let env, pushs = push_args env [] n in
+                 env, pushr @ pushs @ [Call f; Binop ("+", L (n*4), esp)] @ (List.rev popr)
+             in
+             (if p then env, code else let y, env = env#allocate in env, code @ [Mov (eax, y)])
         in
         let env'', code'' = compile' env' scode' in
 	env'', code' @ code''
@@ -199,15 +238,23 @@ let compile env code =
 module S = Set.Make (String)
 
 (* Environment implementation *)
+let make_assoc l = List.combine l (List.init (List.length l) (fun x -> x))
+                     
 class env =
   object (self)
-    val stack_slots = 0        (* maximal number of stack positions *)
+    val globals     = S.empty (* a set of global variables         *)
-    val globals     = S.empty  (* a set of global variables         *)
+    val stack_slots = 0       (* maximal number of stack positions *)
-    val stack       = []       (* symbolic stack                    *)
+    val stack       = []      (* symbolic stack                    *)
-
+    val args        = []      (* function arguments                *)
+    val locals      = []      (* function local variables          *)
+    val fname       = ""      (* function name                     *)
+                        
     (* gets a name for a global variable *)
-    method loc x = "global_" ^ x                                 
+    method loc x =
-
+      try S (- (List.assoc x args)  -  1)
+      with Not_found ->  
+        try S (List.assoc x locals) with Not_found -> M ("global_" ^ x)
+        
     (* allocates a fresh position on a symbolic stack *)
     method allocate =    
       let x, n =
@@ -226,7 +273,7 @@ class env =
     method push y = {< stack = y::stack >}
 
     (* pops one operand from the symbolic stack *)
-    method pop  = let x::stack' = stack in x, {< stack = stack' >}
+    method pop = let x::stack' = stack in x, {< stack = stack' >}
 
     (* pops two operands from the symbolic stack *)
     method pop2 = let x::y::stack' = stack in x, y, {< stack = stack' >}
@@ -234,48 +281,49 @@ class env =
     (* registers a global variable in the environment *)
     method global x  = {< globals = S.add ("global_" ^ x) globals >}
 
-    (* gets the number of allocated stack slots *)
-    method allocated = stack_slots
-
     (* gets all global variables *)      
     method globals = S.elements globals
+
+    (* gets a number of stack positions allocated *)
+    method allocated = stack_slots                                
+                                
+    (* enters a function *)
+    method enter f a l =
+      {< stack_slots = List.length l; stack = []; locals = make_assoc l; args = make_assoc a; fname = f >}
+
+    (* returns a label for the epilogue *)
+    method epilogue = Printf.sprintf "L%s_epilogue" fname
+                                     
+    (* returns a name for local size meta-symbol *)
+    method lsize = Printf.sprintf "L%s_SIZE" fname
+
+    (* returns a list of live registers *)
+    method live_registers =
+      List.filter (function R _ -> true | _ -> false) stack
+      
   end
-
+  
-(* Compiles a unit: generates x86 machine code for the stack program and surrounds it
-   with function prologue/epilogue
-*)
-let compile_unit env scode =  
-  let env, code = compile env scode in
-  env, 
-  ([Push ebp; Mov (esp, ebp); Binop ("-", L (word_size*env#allocated), esp)] @ 
-   code @
-   [Mov (ebp, esp); Pop ebp; Binop ("^", eax, eax); Ret]
-  )
-
 (* Generates an assembler text for a program: first compiles the program into
    the stack code, then generates x86 assember code, then prints the assembler file
 *)
-let genasm prog =
+let genasm (ds, stmt) =
-  let env, code = compile_unit (new env) (SM.compile prog) in
+  let stmt = Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Const 0))) in
+  let env, code =
+    compile
+      (new env)
+      ((LABEL "main") :: (BEGIN ("main", [], [])) :: SM.compile (ds, stmt))
+  in
+  let data = Meta "\t.data" :: (List.map (fun s -> Meta (s ^ ":\t.int\t0")) env#globals) in 
   let asm = Buffer.create 1024 in
-  Buffer.add_string asm "\t.data\n";
-  List.iter
-    (fun s ->
-       Buffer.add_string asm (Printf.sprintf "%s:\t.int\t0\n" s)
-    )
-    env#globals;
-  Buffer.add_string asm "\t.text\n";
-  Buffer.add_string asm "\t.globl\tmain\n";
-  Buffer.add_string asm "main:\n";
   List.iter
     (fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
-    code;
+    (data @ [Meta "\t.text"; Meta "\t.globl\tmain"] @ code);
   Buffer.contents asm
 
 (* Builds a program: generates the assembler file and compiles it with the gcc toolchain *)
-let build stmt name =
+let build prog name =
   let outf = open_out (Printf.sprintf "%s.s" name) in
-  Printf.fprintf outf "%s" (genasm stmt);
+  Printf.fprintf outf "%s" (genasm prog);
   close_out outf;
   let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in
   Sys.command (Printf.sprintf "gcc -m32 -o %s %s/runtime.o %s.s" name inc name)