From b3a552c6201eb694b83d768f6b017048073c7ac9 Mon Sep 17 00:00:00 2001 From: Alla Date: Wed, 31 May 2017 16:41:25 +0300 Subject: [PATCH] New logic --- Makefile | 2 +- regression/Makefile | 16 ++-- src/Driver.ml | 56 ++++++------- src/Interpret.ml | 61 ++++++++++---- src/Language.ml | 90 +++++++++++++++------ src/StackMachine.ml | 179 +++++++++++++++++++++++++++-------------- src/X86.ml | 192 ++++++++++++++++++++++++++++++-------------- 7 files changed, 398 insertions(+), 198 deletions(-) diff --git a/Makefile b/Makefile index d39a3d3e..964ff792 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ MKDIR ?= mkdir -vp CP ?= cp -OB=ocamlbuild -cflag -g -no-hygiene -use-ocamlfind -plugin-tag "package(str)" -classic-display +OB=ocamlbuild -cflags -g,-w,-8 -no-hygiene -use-ocamlfind -plugin-tag "package(str)" ifdef OBV OB += -verbose 6 endif diff --git a/regression/Makefile b/regression/Makefile index bbecbbd4..9b5b05ef 100644 --- a/regression/Makefile +++ b/regression/Makefile @@ -1,16 +1,16 @@ -TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 test009 test010 test011 test014 test015 test016 test017 test018 +TESTS=test001 test002 test003 test004 test005 test006 test007 test008 test012 test013 test009 test010 test014 test015 test016 test017 test018 test019 test020 test021 test022 test023 -# test019 test020 test021 test022 test023 test024 test025 test026 -# test027 test028 test029 test030 +# Funcs: +# test011 test024 test025 test026 test027 test028 test029 test030 test 031 -.PHONY: check $(TESTS) +.PHONY: check $(TESTS) -check: $(TESTS) +check: $(TESTS) $(TESTS): %: %.expr - ../rc.native $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log - cat $@.input | ../rc.native -i $< > $@.log && diff $@.log orig/$@.log - cat $@.input | ../rc.native -s $< > $@.log && diff $@.log orig/$@.log + ../rc.native $< ; cat $@.input | ./$@ > $@.log ; diff $@.log orig/$@.log + cat $@.input | ../rc.native -i $< > $@.log ; diff $@.log orig/$@.log + cat $@.input | ../rc.native -s $< > $@.log ; diff $@.log orig/$@.log clean: rm -f test*.log *.s *~ $(TESTS) diff --git a/src/Driver.ml b/src/Driver.ml index 5c8e0b34..291aa0d0 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -3,20 +3,20 @@ open Expr open Stmt open Ostap -let parse filename = +let parse filename = let s = Util.read filename in - Util.parse - (object - inherit Matcher.t s - inherit Util.Lexers.ident ["read"; "write"; "skip"] s + Util.parse + (object + inherit Matcher.t s + inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "fi"; "while"; "do"; "od"; "for"; "elif"; "repeat"; "until"] s inherit Util.Lexers.decimal s inherit Util.Lexers.skip [ Matcher.Skip.whitespaces " \t\n"; - Matcher.Skip.lineComment "--"; - Matcher.Skip.nestedComment "(*" "*)" + Matcher.Skip.lineComment "--"; + Matcher.Skip.nestedComment "(*" "*)" ] s end) - (ostap (!(Stmt.parse) -EOF)) + (ostap (!(Stmt.sequence) -EOF)) let main = try @@ -25,27 +25,29 @@ let main = let to_compile = not (interpret || stack) in let infile = Sys.argv.(if not to_compile then 2 else 1) in match parse infile with + | `Ok prog -> if to_compile - then + then let basename = Filename.chop_suffix infile ".expr" in ignore @@ X86.build prog basename - else - let rec read acc = - try - let r = read_int () in - Printf.printf "> "; - read (acc @ [r]) - with End_of_file -> acc - in - let input = read [] in - let output = - if interpret - then Interpret.Program.eval prog input - else StackMachine.Interpret.run (StackMachine.Compile.Program.compile prog) input - in - List.iter (fun i -> Printf.printf "%d\n" i) output - | `Fail er -> Printf.eprintf "Syntax error: %s\n" er - with Invalid_argument _ -> - Printf.printf "Usage: rc [-i] \n" + else + let rec read acc = + try + let r = read_int () in + Printf.printf "> "; + read (acc @ [r]) + with End_of_file -> acc + in + let input = read [] in + let output = + if interpret + then Interpret.Program.eval prog input + else StackMachine.Interpret.run (StackMachine.Compile.Program.compile prog) input + in + List.iter (fun i -> Printf.printf "%d\n" i) output + | `Fail er -> Printf.eprintf "Syntax error: %s\n" er + with Invalid_argument _ -> + Printf.printf "Usage: rc [-i | -s] \n"; + Printf.printf "Example: cat test001.input | .././rc.native -s test001.expr\n" diff --git a/src/Interpret.ml b/src/Interpret.ml index 9f863d55..a7d72d6b 100644 --- a/src/Interpret.ml +++ b/src/Interpret.ml @@ -6,34 +6,67 @@ module Expr = open Expr + + let match_operation op = match op with + | "+" -> fun x y -> x + y + | "-" -> fun x y -> x - y + | "*" -> fun x y -> x * y + | "/" -> fun x y -> x / y + | "%" -> fun x y -> x mod y + | "==" -> fun x y -> if x = y then 1 else 0 + | "!=" -> fun x y -> if x != y then 1 else 0 + | ">" -> fun x y -> if x > y then 1 else 0 + | "<" -> fun x y -> if x < y then 1 else 0 + | ">=" -> fun x y -> if x >= y then 1 else 0 + | "<=" -> fun x y -> if x <= y then 1 else 0 + | "&&" -> fun x y -> if (x = 0 || y = 0) then 0 else 1 + | "!!" -> fun x y -> if (x = 0 && y = 0) then 0 else 1 + let rec eval expr st = let eval' e = eval e st in match expr with - | Var x -> st x - | Const z -> z - | Add (x, y) -> eval' x + eval' y - | Mul (x, y) -> eval' x * eval' y + | Var x -> st x + | Const z -> z + | BinOp (op, x, y) -> (match_operation op)(eval' x)(eval' y) end + (* Interpreter for statements *) module Stmt = struct open Stmt - (* State update primitive *) - let update st x v = fun y -> if y = x then v else st y - + (* State update primitive *) + let update st x v = fun y -> if y = x then v else st y + let rec eval stmt ((st, input, output) as conf) = match stmt with - | Skip -> conf - | Assign (x, e) -> (update st x (Expr.eval e st), input, output) - | Read x -> - let z :: input' = input in + | Skip -> conf + + | Assign (x, e) -> (update st x (Expr.eval e st), input, output) + + | Read x -> + let z :: input' = input in (* :: берет верхний элемента списка входных данных *) (update st x z, input', output) - | Write e -> (st, input, output @ [Expr.eval e st]) - | Seq (s1, s2) -> eval s1 conf |> eval s2 + + | Write e -> (st, input, output @ [Expr.eval e st]) + + | Seq (s1, s2) -> eval s1 conf |> eval s2 (*вычисляется s1 и conf передается в s2 *) + + | If (exp, seq1, seq2) -> + if (Expr.eval exp st) != 0 + then eval seq1 conf + else eval seq2 conf + + | While (exp, seq) -> + if (Expr.eval exp st) != 0 then eval seq conf |> eval stmt else conf + + | Repeat (seq, exp) -> + let (st', _, _) as conf' = eval seq conf in + if (Expr.eval exp st') == 0 then eval stmt conf' else conf' + end @@ -42,7 +75,7 @@ module Program = let eval p input = let (_, _, output) = - Stmt.eval p ((fun _ -> failwith "undefined variable"), input, []) + Stmt.eval p ((fun _ -> failwith "undefined variable"), input, []) in output diff --git a/src/Language.ml b/src/Language.ml index 96ac3e01..593b6a49 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -1,23 +1,44 @@ +open Ostap.Util + (* AST for expressions *) module Expr = struct type t = - | Var of string - | Const of int - | Add of t * t - | Mul of t * t + | Var of string + | Const of int + | BinOp of string * t * t - ostap ( - parse: x:mull "+" y:parse {Add (x,y)} | mull; - mull : x:prim "*" y:mull {Mul (x,y)} | prim; - prim : - n:DECIMAL {Const n} - | e:IDENT {Var e} - | -"(" parse -")" - ) + let rec expr_parser s = + expr id + [| + `Nona , [ostap ("!!"), (fun x y -> BinOp ("!!", x, y))]; - end + `Nona , [ostap ("&&"), (fun x y -> BinOp ("&&", x, y))]; + + `Nona , [ostap ("=="), (fun x y -> BinOp ("==", x, y)); + ostap ("!="), (fun x y -> BinOp ("!=", x, y)); + ostap ("<="), (fun x y -> BinOp ("<=", x, y)); + ostap (">="), (fun x y -> BinOp (">=", x, y)); + ostap ("<"), (fun x y -> BinOp ("<", x, y)); + ostap (">"), (fun x y -> BinOp (">", x, y))]; + + `Lefta , [ostap ("+"), (fun x y -> BinOp ("+", x, y)); + ostap ("-"), (fun x y -> BinOp ("-", x, y))]; + + `Lefta , [ostap ("*"), (fun x y -> BinOp ("*", x, y)); + ostap ("/"), (fun x y -> BinOp ("/", x, y)); + ostap ("%"), (fun x y -> BinOp ("%", x, y))] + |] + expr' s + and + ostap ( + expr': + n:DECIMAL {Const n} + | e:IDENT {Var e} + | -"(" expr_parser -")") + +end (* AST statements/commands *) module Stmt = @@ -25,20 +46,39 @@ module Stmt = type t = | Skip - | Assign of string * Expr.t - | Read of string - | Write of Expr.t - | Seq of t * t + | Assign of string * Expr.t + | Read of string + | Write of Expr.t + | Seq of t * t + | If of Expr.t * t * t + | While of Expr.t * t + | Repeat of t * Expr.t - let expr = Expr.parse + let expr = Expr.expr_parser ostap ( - simp: x:IDENT ":=" e:expr {Assign (x, e)} - | %"read" "(" x:IDENT ")" {Read x} - | %"write" "(" e:expr ")" {Write e} - | %"skip" {Skip}; - - parse: s:simp ";" d:parse {Seq (s,d)} | simp + statement: + x:IDENT ":=" e:expr {Assign (x, e)} + | %"read" "(" x:IDENT ")" {Read x} + | %"write" "(" e:expr ")" {Write e} + | %"skip" {Skip} + | %"if" e:expr %"then" seq:sequence seq':else_stmt? + %"fi" {If(e, seq, match seq' with None -> Skip | Some seq' -> seq')} + | %"while" e:expr + "do" seq:sequence %"od" {While(e, seq)} + | %"for" seq:sequence "," e:expr "," seq':sequence + %"do" s:sequence %"od" {Seq (seq, While (e, Seq (s, seq')))} + | %"repeat" seq:sequence + "until" e:expr {Repeat (seq, e)}; + + else_stmt: + %"else" sequence + | %"elif" e:expr %"then" seq:sequence seq':else_stmt? + {If(e,seq, match seq' with None -> Skip | Some seq' -> seq')}; + + sequence: + s:statement ";" d:sequence {Seq (s,d)} + | statement ) end @@ -48,7 +88,7 @@ module Program = type t = Stmt.t - let parse = Stmt.parse + let parse = Stmt.sequence end diff --git a/src/StackMachine.ml b/src/StackMachine.ml index 870537a4..31b34ef5 100644 --- a/src/StackMachine.ml +++ b/src/StackMachine.ml @@ -5,14 +5,18 @@ module Instr = type t = | READ | WRITE - | PUSH of int - | LD of string - | ST of string - | ADD - | MUL + | PUSH of int + | LD of string (* загружает значение переменной в регистр *) + | ST of string (* помещает значение в переменную *) + | BINOP of string + | LBL of int + | CJMP of int * string (* переход с условием *) + | JMP of int (* переход к метке, int - номер метки*) end + + module Program = struct @@ -20,83 +24,136 @@ module Program = end + + module Interpret = struct open Instr open Interpret.Stmt + open Language.Expr + open Interpret.Expr + + (*найти лейбл и вернуть всю программу после лейбла*) + let rec findlbl prg lbl = + let h :: prg' = prg in + if h = lbl then prg' + else findlbl prg' lbl + + + let run prg input = + let prg_full = prg in + let rec run' ((prg, stack, st, input, output) as conf) = + match prg with + | [] -> conf + | i :: prg' -> + run' ( + match i with + | READ -> let z :: input' = input in + (prg', z :: stack, st, input', output) + | WRITE -> let h :: stack' = stack in + (prg', stack', st, input, output @ [h]) + | PUSH n -> (prg', n :: stack, st, input, output) + | LD x -> (prg', st x :: stack, st, input, output) + | ST x -> let h :: stack' = stack in + (prg', stack', update st x h, input, output) + | BINOP op -> let y :: x :: stack' = stack in + (prg', (match_operation op) x y :: stack', st, input, output) + | LBL m -> (prg', stack, st, input, output) + | JMP m -> (findlbl prg_full (LBL m), stack, st, input, output) + | CJMP (m,c) -> let h :: stack' = stack in + if (match c with + | "z" -> (h = 0) + | "nz" -> (h != 0)) + then (findlbl prg_full (LBL m), stack', st, input, output) + else (prg', stack', st, input, output) + ) + in + + let (_, _, _, _, output) = + run' (prg, [], (fun _ -> failwith "undefined variable"), input, []) in + + output - let run prg input = - let rec run' prg ((stack, st, input, output) as conf) = - match prg with - | [] -> conf - | i :: prg' -> - run' prg' ( - match i with - | READ -> let z :: input' = input in - (z :: stack, st, input', output) - | WRITE -> let z :: stack' = stack in - (stack', st, input, output @ [z]) - | PUSH n -> (n :: stack, st, input, output) - | LD x -> (st x :: stack, st, input, output) - | ST x -> let z :: stack' = stack in - (stack', update st x z, input, output) - | _ -> let y :: x :: stack' = stack in - ((match i with ADD -> (+) | _ -> ( * )) x y :: stack', - st, - input, - output - ) - ) - in - let (_, _, _, output) = - run' prg ([], - (fun _ -> failwith "undefined variable"), - input, - [] - ) - in - output end + + module Compile = struct - open Instr + open Instr - module Expr = - struct - open Language.Expr + module Expr = + struct - let rec compile = function - | Var x -> [LD x] - | Const n -> [PUSH n] - | Add (x, y) -> (compile x) @ (compile y) @ [ADD] - | Mul (x, y) -> (compile x) @ (compile y) @ [MUL] + open Language.Expr - end - module Stmt = - struct + let rec compile = function + | Var x -> [LD x] + | Const n -> [PUSH n] + | BinOp (op, x, y) -> (compile x) @ (compile y) @ [BINOP op] - open Language.Stmt + end - let rec compile = function - | Skip -> [] - | Assign (x, e) -> Expr.compile e @ [ST x] - | Read x -> [READ; ST x] - | Write e -> Expr.compile e @ [WRITE] - | Seq (l, r) -> compile l @ compile r + class lblcounter = + object (this) + val mutable count = 0 + method add_lbls n = count <- (count + n) + method get_count = count + end - end - module Program = - struct - let compile = Stmt.compile + module Stmt = + struct - end + open Language.Stmt - end + let rec compile lblc = function + | Skip -> [] + | Assign (x, e) -> Expr.compile e @ [ST x] + | Read x -> [READ; ST x] + | Write e -> Expr.compile e @ [WRITE] + | Seq (l, r) -> compile lblc l @ compile lblc r + | op -> + lblc#add_lbls 2; + let lbl1 = lblc#get_count-1 in + let lbl2 = lblc#get_count in + match op with + | If (exp, seq1, seq2) -> + Expr.compile exp @ + [CJMP (lbl1,"z")] @ + compile lblc seq1 @ + [JMP lbl2] @ + [LBL lbl1] @ + compile lblc seq2 @ + [LBL lbl2] + + | While (exp, seq) -> + [JMP lbl1] @ + [LBL lbl2] @ + compile lblc seq @ + [LBL lbl1] @ + Expr.compile exp @ + [CJMP (lbl2, "nz")] + + | Repeat (seq, exp) -> + [LBL lbl1] @ + compile lblc seq @ + Expr.compile exp @ + [CJMP (lbl1, "z")] + end + + + module Program = + struct + + let compile = Stmt.compile (new lblcounter) + + end + +end diff --git a/src/X86.ml b/src/X86.ml index 9f0544af..cecfdb77 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -3,98 +3,166 @@ open Instr type opnd = R of int | S of int | L of int | M of string -let regs = [|"%eax"; "%ebx"; "%ecx"; "%esi"; "%edi"; "%edx"; "%esp"; "%ebp"|] -let nregs = Array.length regs - 3 +let regs = [|"%ebx"; "%ecx"; "%esi"; "%edi"; "%eax"; "%edx"; "%esp"; "%ebp"|] -let [|eax; ebx; ecx; esi; edi; edx; esp; ebp|] = Array.mapi (fun i _ -> R i) regs +let [|al; dl|] = [|"%al"; "%dl"|] + +let nregs = Array.length regs - 4 + +let [|ebx; ecx; esi; edi; eax; edx; esp; ebp|] = Array.mapi (fun i _ -> R i) regs type instr = -| Add of opnd * opnd -| Mul of opnd * opnd -| Mov of opnd * opnd -| Push of opnd -| Pop of opnd -| Call of string -| Ret - -let to_string buf code = + | Add of opnd * opnd + | Sub of opnd * opnd + | Mul of opnd * opnd + | Div of opnd + + | Or of opnd * opnd + | And of opnd * opnd + + | Mov of opnd * opnd + | Push of opnd + | Pop of opnd + | Call of string + | Ret + + | Cmp of opnd * opnd + | Set of string * string + | Lbl of int + | Jz of int + | Jnz of int + | Jmp of int + | Test of opnd * opnd + | Cltd + +let to_string buf code = let instr = let opnd = function | R i -> regs.(i) | S i -> Printf.sprintf "%d(%%ebp)" (-i * 4) | L i -> Printf.sprintf "$%d" i - | M s -> s + | M s -> s in function - | Add (x, y) -> Printf.sprintf "addl\t%s,%s" (opnd x) (opnd y) - | Mul (x, y) -> Printf.sprintf "imull\t%s,%s" (opnd x) (opnd y) - | Mov (x, y) -> Printf.sprintf "movl\t%s,%s" (opnd x) (opnd y) - | Push x -> Printf.sprintf "pushl\t%s" (opnd x) - | Pop x -> Printf.sprintf "popl\t%s" (opnd x) - | Call x -> Printf.sprintf "call\t%s" x - | Ret -> "ret" + | Add (x, y) -> Printf.sprintf "addl\t%s,%s" (opnd x) (opnd y) + | Sub (x, y) -> Printf.sprintf "subl\t%s,%s" (opnd x) (opnd y) + | Mul (x, y) -> Printf.sprintf "imull\t%s,%s" (opnd x) (opnd y) + | Div x -> Printf.sprintf "idiv\t%s" (opnd x) + | Cltd -> "cltd" + | Mov (x, y) -> Printf.sprintf "movl\t%s,%s" (opnd x) (opnd y) + | Push x -> Printf.sprintf "pushl\t%s" (opnd x) + | Pop x -> Printf.sprintf "popl\t%s" (opnd x) + | Call x -> Printf.sprintf "call\t%s" x + | Ret -> "ret" + | Or (x, y) -> Printf.sprintf "orl\t%s,%s" (opnd x) (opnd y) + | And (x, y) -> Printf.sprintf "andl\t%s,%s" (opnd x) (opnd y) + | Cmp (x, y) -> Printf.sprintf "cmpl\t%s,%s" (opnd x) (opnd y) + | Set (s, x) -> Printf.sprintf "set%s\t%s" s x + | Lbl x -> Printf.sprintf "lbl%d:" x + | Jz x -> Printf.sprintf "jz\t\tlbl%d" x + | Jnz x -> Printf.sprintf "jnz\t\tlbl%d" x + | Jmp x -> Printf.sprintf "jmp\t\tlbl%d" x + | Test (x, y) -> Printf.sprintf "testl\t%s,%s" (opnd x) (opnd y) in - let out s = - Buffer.add_string buf "\t"; - Buffer.add_string buf s; - Buffer.add_string buf "\n" + let out s = + Buffer.add_string buf "\t"; + Buffer.add_string buf s; + Buffer.add_string buf "\n" in List.iter (fun i -> out @@ instr i) code - + module S = Set.Make (String) - + + class env = object (this) val locals = S.empty val depth = 0 - + method allocate = function | [] -> this, R 0 | R i :: _ when i < nregs - 1 -> this, R (i+1) | S i :: _ -> {< depth = max depth (i+1) >}, S (i+1) | _ -> {< depth = max depth 1 >}, S 1 - + method local x = {< locals = S.add x locals >} method get_locals = S.elements locals method get_depth = depth end + let rec sint env prg sstack = match prg with | [] -> env, [], [] | i :: prg' -> - let env, code, sstack' = - match i with - | PUSH n -> - let env', s = env#allocate sstack in - env', [Mov (L n, s)], s :: sstack - | LD x -> - let env' = env#local x in - let env'', s = env'#allocate sstack in - env'', [Mov (M x, s)], s :: sstack - | ST x -> - let env' = env#local x in - let s :: sstack' = sstack in - env', [Mov (s, M x)], sstack' - | READ -> - env, [Call "lread"], [eax] - | WRITE -> - env, [Push eax; Call "lwrite"; Pop edx], [] - | _ -> - let x::(y::_ as sstack') = sstack in - (fun op -> - match x, y with - | S _, S _ -> env, [Mov (y, edx); op x edx; Mov (edx, y)], sstack' - | _ -> env, [op x y], sstack' - ) - (match i with - | MUL -> fun x y -> Mul (x, y) - | ADD -> fun x y -> Add (x, y) - ) - in - let env, code', sstack'' = sint env prg' sstack' in - env, code @ code', sstack'' - + let env, code, sstack' = + match i with + + | PUSH n -> + let env', s = env#allocate sstack in + env', [Mov (L n, s)], s :: sstack + + | LD x -> + let env' = env#local x in + let env'', s = env'#allocate sstack in + (match s with + | S _ -> env'', [Mov (M x, edx); Mov (edx, s)], s :: sstack + | _ -> env'', [Mov (M x, s)], s :: sstack) + + | ST x -> + let env' = env#local x in + let s :: sstack' = sstack in + (match s with + | S _ -> env', [Mov (s, edx); Mov (edx, M x)], sstack' + | _ -> env', [Mov (s, M x)], sstack') + + | READ -> env, [Call "lread"], [eax] + | WRITE -> env, [Push ebx; Call "lwrite"; Pop edx], [] + | LBL x -> env, [Lbl x], [] + | JMP x -> env, [Jmp x], [] + + | CJMP (x,c) -> + let s :: sstack' = sstack in + let jmpop = (match c with "z" -> Jz x | "nz" -> Jnz x) in + (match s with + | S _ -> env, [Mov (s, edx); Test (edx, edx); jmpop], [] + | _ -> env, [Test (s, s); jmpop], []) + + | BINOP op -> + let x::(y::_ as sstack') = sstack in + let and_opr = [Mov (y, edx); And (y, edx); + Mov (L 0, edx); Set("ne", dl); + Mov (x, eax); And (x, eax); + Mov (L 0, eax); Set("ne", al); + And (eax, edx); Mov (L 0, edx); Set("ne", dl); + Mov (edx, y)] in + + let apply_operation x y = + (match op with + | "+" -> [Add (x, y)] + | "-" -> [Sub (x, y)] + | "*" -> [Mul (x, y)] + | "/" -> [Mov (y, eax); Cltd; Div x; Mov (eax, y)] + | "%" -> [Mov (y, eax); Cltd; Div x; Mov (edx, y)] + | "&&" -> and_opr + | "!!" -> [Mov (y, edx); Or(x, y); Mov (L 0, edx); Set("ne", dl); Mov (edx, y)] + | "==" -> [Cmp(x, y); Mov (L 0, edx); Set("e", dl); Mov (edx, y)] + | "!=" -> [Cmp(x, y); Mov (L 0, edx); Set("ne", dl); Mov (edx, y)] + | "<=" -> [Cmp(x, y); Mov (L 0, edx); Set("le", dl); Mov (edx, y)] + | ">=" -> [Cmp(x, y); Mov (L 0, edx); Set("ge", dl); Mov (edx, y)] + | ">" -> [Cmp(x, y); Mov (L 0, edx); Set("g", dl); Mov (edx, y)] + | "<" -> [Cmp(x, y); Mov (L 0, edx); Set("l", dl); Mov (edx, y)] + ) in + + match x, y with + | S _, S _ -> env, [Mov (y, edx)] @ apply_operation x edx @[Mov (edx, y)], sstack' + | _ -> env, apply_operation x y, sstack' + + in + let env, code', sstack'' = sint env prg' sstack' in + env, code @ code', sstack'' + + let compile p = let env, code, [] = sint (new env) (Compile.Program.compile p) [] in let buf = Buffer.create 1024 in @@ -113,8 +181,8 @@ let compile p = out "\tpopl\t%ebp\n"; out "\tret\n"; Buffer.contents buf - -let build stmt name = + + let build stmt name = let outf = open_out (Printf.sprintf "%s.s" name) in Printf.fprintf outf "%s" (compile stmt); close_out outf;