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;