From 02dee4026204120d9fc4c1d070d793107628c309 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Sat, 28 Dec 2019 01:59:04 +0300 Subject: [PATCH] Rolled back --- src/SM.ml | 45 +++++++++++++-------------------------------- src/X86.ml | 6 +++--- 2 files changed, 16 insertions(+), 35 deletions(-) diff --git a/src/SM.ml b/src/SM.ml index 529f5f0a0..4ba40887e 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -18,7 +18,7 @@ open Language (* a label *) | LABEL of string (* unconditional jump *) | JMP of string (* conditional jump *) | CJMP of string * string -(* begins procedure definition *) | BEGIN of string * int * int * Value.designation list * int +(* begins procedure definition *) | BEGIN of string * int * int * Value.designation list (* end procedure definition *) | END (* create a closure *) | CLOSURE of string (* calls a closure *) | CALLC of int @@ -99,17 +99,6 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio Printf.eprintf " stack=%s\n" (show(list) (show(value)) stack); Printf.eprintf "end\n"; *) - let closure_at_level clo n = - let rec inner = function - | [] -> [], 0 - | h :: tl -> - let tl', m = inner tl in - if m = n - then tl', n - else h :: tl, m + 1 - in - fst (inner clo) - in (match insn with | PUBLIC _ | EXTERN _ -> eval env conf prg' | BINOP op -> let y::x::stack' = stack in eval env (cstack, (Value.of_int @@ Expr.to_func op (Value.to_int x) (Value.to_int y)) :: stack', glob, loc, i, o) prg' @@ -140,7 +129,7 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio | CJMP (c, l) -> let x::stack' = stack in eval env (cstack, stack', glob, loc, i, o) (if (c = "z" && Value.to_int x = 0) || (c = "nz" && Value.to_int x <> 0) then env#labeled l else prg') - | CLOSURE name -> let BEGIN (_, _, _, dgs, level) :: _ = env#labeled name in + | CLOSURE name -> let BEGIN (_, _, _, dgs) :: _ = env#labeled name in let closure = Array.of_list @@ List.map ( @@ -156,7 +145,7 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio | CALL (f, n) -> let args, stack' = split n stack in if env#is_label f then ( - let BEGIN (_, _, _, dgs, level) :: _ = env#labeled f in + let BEGIN (_, _, _, dgs) :: _ = env#labeled f in match dgs with | [] -> eval env ((prg', loc)::cstack, stack', glob, {args = Array.of_list (List.rev args); locals = [||]; @@ -186,7 +175,7 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio | _ -> invalid_arg "not a closure (or a builtin) in CALL: %s\n" @@ show(value) f ) - | BEGIN (_, _, locals, _, level) -> eval (env#set_level level) (cstack, stack, glob, {loc with locals = Array.init locals (fun _ -> Value.Empty)}, i, o) prg' + | BEGIN (_, _, locals, _) -> eval env (cstack, stack, glob, {loc with locals = Array.init locals (fun _ -> Value.Empty)}, i, o) prg' | END -> (match cstack with | (prg', loc')::cstack' -> eval env (cstack', Value.Empty :: stack, glob, loc', i, o) prg' @@ -241,11 +230,8 @@ class indexer prg = in let m = make_env M.empty prg in object - val level = 0 method is_label l = M.mem l m method labeled l = M.find l m - method set_level l = {< level = l >} - method get_level = level end let run p i = @@ -295,7 +281,6 @@ let check_name_and_add names name mut = args : string list; body : Expr.t; scope : funscope; - level : int } with show @type context = @@ -312,15 +297,14 @@ let init_scope st = { closure = [] } -let to_fundef name args body st level = { +let to_fundef name args body st = { name = name; args = args; body = body; scope = init_scope st; - level = level; } -let from_fundef fd = (fd.name, fd.args, fd.body, fd.scope.st, fd.level) +let from_fundef fd = (fd.name, fd.args, fd.body, fd.scope.st) let open_scope c fd = match c with @@ -365,7 +349,6 @@ object (self : 'self) val scope = init_scope State.I val fundefs = Top [] val decls = [] - val level = 0 method private import_imports = let paths = cmd#get_include_paths in @@ -437,15 +420,13 @@ object (self : 'self) } >} - method open_fun_scope (name, args, body, st', level) = + method open_fun_scope (name, args, body, st') = {< - level = level + 1; fundefs = open_scope fundefs { name = name; args = args; body = body; - scope = {scope with st = st'}; - level = level + 1 + scope = {scope with st = st'}; }; scope = init_scope ( let rec readdress_to_closure = function @@ -522,7 +503,7 @@ object (self : 'self) method add_lambda (args : string list) (body : Expr.t) = let name' = self#fun_internal_name (Printf.sprintf "lambda_%d" lam_index) in - {< fundefs = add_fun fundefs (to_fundef name' args body scope.st level); lam_index = lam_index + 1 >}, name' + {< fundefs = add_fun fundefs (to_fundef name' args body scope.st); lam_index = lam_index + 1 >}, name' method add_fun (name : string) (args : string list) (m : [`Local | `Extern | `Public | `PublicExtern]) (body : Expr.t) = let name' = self#fun_internal_name name in @@ -530,7 +511,7 @@ object (self : 'self) | `Extern -> self | _ -> {< - fundefs = add_fun fundefs (to_fundef name' args body scope.st level) + fundefs = add_fun fundefs (to_fundef name' args body scope.st) >} method lookup name = @@ -763,7 +744,7 @@ let compile cmd ((imports, infixes), p) = in env, true, se @ (if fe then [LABEL lexp] else []) @ [DUP] @ (List.flatten @@ List.rev code) @ [JMP l] @ if fail then [LABEL lfail; FAIL (loc, atr != Expr.Void); JMP l] else [] in - let rec compile_fundef env ((name, args, stmt, st, level) as fd) = + let rec compile_fundef env ((name, args, stmt, st) as fd) = (* Printf.eprintf "Compile fundef: %s, state=%s\n" name (show(State.t) (show(Value.designation)) st); *) (* Printf.eprintf "st (inner) = %s\n" (try show(Value.designation) @@ State.eval st "inner" with _ -> " not found"); *) let env = env#open_fun_scope fd in @@ -775,7 +756,7 @@ let compile cmd ((imports, infixes), p) = let env, flag, code = compile_expr lend env stmt in let env, funcode = compile_fundefs [] env in env#close_fun_scope, - ([LABEL name; BEGIN (name, env#nargs, env#nlocals, env#closure, level)] @ + ([LABEL name; BEGIN (name, env#nargs, env#nlocals, env#closure)] @ code @ (if flag then [LABEL lend] else []) @ [END]) :: funcode @@ -791,7 +772,7 @@ let compile cmd ((imports, infixes), p) = let env, flag, code = compile_expr lend env p in let code = if flag then code @ [LABEL lend] else code in let has_main = List.length code > 0 in - let env, prg = compile_fundefs [if has_main then [LABEL "main"; BEGIN ("main", 0, env#nlocals, [], 0)] @ code @ [END] else []] env in + let env, prg = compile_fundefs [if has_main then [LABEL "main"; BEGIN ("main", 0, env#nlocals, [])] @ code @ [END] else []] env in let prg = (if has_main then [PUBLIC "main"] else []) @ env#get_decls @ List.flatten prg in cmd#dump_SM prg; prg diff --git a/src/X86.ml b/src/X86.ml index ebbc42c86..859d596b6 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -151,7 +151,7 @@ let compile cmd env code = let call env f n = let closure = try - let BEGIN (_, _, _, closure, level) :: _ = env#labeled f in closure + let BEGIN (_, _, _, closure) :: _ = env#labeled f in closure with Not_found -> [] in match closure with @@ -224,7 +224,7 @@ let compile cmd env code = let pushr, popr = List.split @@ List.map (fun r -> (Push r, Pop r)) (env#live_registers 0) in - let BEGIN (_, _, _, closure, level) :: _ = env#labeled name in + let BEGIN (_, _, _, closure) :: _ = env#labeled name in let closure_len = List.length closure in let push_closure = List.map (fun d -> Push (env#loc d)) @@ List.rev closure @@ -383,7 +383,7 @@ let compile cmd env code = let x, env = env#pop in env#set_stack l, [Sar1 x; (*!!!*) Binop ("cmp", L 0, x); CJmp (s, l)] - | BEGIN (f, nargs, nlocals, closure, level) -> + | BEGIN (f, nargs, nlocals, closure) -> env#assert_empty_stack; let has_closure = closure <> [] in let env = env#enter f nlocals has_closure in