From cc540a7e2dfcee4411953075210a64de874b91e5 Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Tue, 25 Sep 2018 20:51:33 -0400 Subject: [PATCH] Rough frame allocations --- README.md | 4 +- compiler/src/lib/tiger/tiger_env.ml | 9 ++++ compiler/src/lib/tiger/tiger_env.mli | 3 ++ compiler/src/lib/tiger/tiger_env_value.ml | 16 ++++-- compiler/src/lib/tiger/tiger_env_value.mli | 6 ++- compiler/src/lib/tiger/tiger_frame.ml | 1 + compiler/src/lib/tiger/tiger_frame.mli | 1 + compiler/src/lib/tiger/tiger_frame_sig.ml | 17 +++++++ compiler/src/lib/tiger/tiger_mips_frame.ml | 55 +++++++++++++++++++++ compiler/src/lib/tiger/tiger_mips_frame.mli | 1 + compiler/src/lib/tiger/tiger_semant.ml | 42 +++++++++++++--- compiler/src/lib/tiger/tiger_temp.ml | 47 ++++++++++++++++++ compiler/src/lib/tiger/tiger_temp.mli | 27 ++++++++++ compiler/src/lib/tiger/tiger_translate.ml | 55 +++++++++++++++++++++ compiler/src/lib/tiger/tiger_translate.mli | 16 ++++++ 15 files changed, 285 insertions(+), 15 deletions(-) create mode 100644 compiler/src/lib/tiger/tiger_frame.ml create mode 100644 compiler/src/lib/tiger/tiger_frame.mli create mode 100644 compiler/src/lib/tiger/tiger_frame_sig.ml create mode 100644 compiler/src/lib/tiger/tiger_mips_frame.ml create mode 100644 compiler/src/lib/tiger/tiger_mips_frame.mli create mode 100644 compiler/src/lib/tiger/tiger_temp.ml create mode 100644 compiler/src/lib/tiger/tiger_temp.mli diff --git a/README.md b/README.md index d1d1997..6127cf9 100644 --- a/README.md +++ b/README.md @@ -16,10 +16,10 @@ Status - [x] ch 3: Parser - [x] ch 4: AST - [x] ch 5: Semantic Analysis (type checking) +- [x] ch 6: Activation Records #### In-progress -- [ ] ch 6: Activation Records -#### TODO (short-term) - [ ] ch 7: Translation to Intermediate Code +#### TODO (short-term) - [ ] ch 08: Basic Blocks and Traces - [ ] ch 09: Instruction Selection - [ ] ch 10: Liveness Analysis diff --git a/compiler/src/lib/tiger/tiger_env.ml b/compiler/src/lib/tiger/tiger_env.ml index 504e9bd..9f6417f 100644 --- a/compiler/src/lib/tiger/tiger_env.ml +++ b/compiler/src/lib/tiger/tiger_env.ml @@ -1,5 +1,6 @@ module Map = Tiger_map module Sym = Tiger_symbol +module Translate = Tiger_translate module Type = Tiger_env_type module Value = Tiger_env_value @@ -7,12 +8,14 @@ type t = { typs : Type.env ; vals : Value.env ; loop : Sym.t option + ; level : Translate.Level.t } let base = { typs = Type.built_in ; vals = Value.built_in ; loop = None + ; level = Translate.Level.init } let get_typ {typs; _} k = @@ -43,3 +46,9 @@ let loop_end t given = let loop_current {loop; _} = loop + +let level_set t level = + {t with level} + +let level_get {level; _} = + level diff --git a/compiler/src/lib/tiger/tiger_env.mli b/compiler/src/lib/tiger/tiger_env.mli index 3338949..46ddba2 100644 --- a/compiler/src/lib/tiger/tiger_env.mli +++ b/compiler/src/lib/tiger/tiger_env.mli @@ -11,3 +11,6 @@ val set_val : t -> Tiger_symbol.t -> Tiger_env_value.t -> t val loop_begin : t -> (Tiger_symbol.t * t) val loop_end : t -> Tiger_symbol.t -> t val loop_current : t -> Tiger_symbol.t option + +val level_set : t -> Tiger_translate.Level.t -> t +val level_get : t -> Tiger_translate.Level.t diff --git a/compiler/src/lib/tiger/tiger_env_value.ml b/compiler/src/lib/tiger/tiger_env_value.ml index 80f145e..ad27463 100644 --- a/compiler/src/lib/tiger/tiger_env_value.ml +++ b/compiler/src/lib/tiger/tiger_env_value.ml @@ -2,14 +2,20 @@ module List = ListLabels module Map = Tiger_map module Symbol = Tiger_symbol +module Temp = Tiger_temp +module Translate = Tiger_translate module Type = Tiger_env_type type t = | Var of - {ty : Type.t} + { access : Tiger_translate.access + ; ty : Tiger_env_type.t + } | Fun of - { formals : Type.t list - ; result : Type.t + { formals : Tiger_env_type.t list + ; result : Tiger_env_type.t + ; level : Tiger_translate.Level.t + ; label : Tiger_temp.Label.t } type env = @@ -29,7 +35,9 @@ let built_in = ] |> List.map ~f:(fun (name, formals, result) -> let key = Symbol.of_string name in - let value = Fun {formals; result} in + let level = Translate.Level.init in + let label = Temp.Label.gen () in + let value = Fun {formals; result; level; label} in (key, value) ) |> Map.of_list diff --git a/compiler/src/lib/tiger/tiger_env_value.mli b/compiler/src/lib/tiger/tiger_env_value.mli index 71209eb..96d07ad 100644 --- a/compiler/src/lib/tiger/tiger_env_value.mli +++ b/compiler/src/lib/tiger/tiger_env_value.mli @@ -1,9 +1,13 @@ type t = | Var of - {ty : Tiger_env_type.t} + { access : Tiger_translate.access + ; ty : Tiger_env_type.t + } | Fun of { formals : Tiger_env_type.t list ; result : Tiger_env_type.t + ; level : Tiger_translate.Level.t + ; label : Tiger_temp.Label.t } type env = diff --git a/compiler/src/lib/tiger/tiger_frame.ml b/compiler/src/lib/tiger/tiger_frame.ml new file mode 100644 index 0000000..f87f8ea --- /dev/null +++ b/compiler/src/lib/tiger/tiger_frame.ml @@ -0,0 +1 @@ +include Tiger_mips_frame diff --git a/compiler/src/lib/tiger/tiger_frame.mli b/compiler/src/lib/tiger/tiger_frame.mli new file mode 100644 index 0000000..2b2c5ed --- /dev/null +++ b/compiler/src/lib/tiger/tiger_frame.mli @@ -0,0 +1 @@ +include Tiger_frame_sig.S diff --git a/compiler/src/lib/tiger/tiger_frame_sig.ml b/compiler/src/lib/tiger/tiger_frame_sig.ml new file mode 100644 index 0000000..b9b3c77 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_frame_sig.ml @@ -0,0 +1,17 @@ +module type S = sig + type t + + type access + + val make : + name:Tiger_temp.Label.t -> formals:bool list -> t + + val name : + t -> Tiger_temp.Label.t + + val formals : + t -> access list + + val alloc_local : + t -> escapes:bool -> access +end diff --git a/compiler/src/lib/tiger/tiger_mips_frame.ml b/compiler/src/lib/tiger/tiger_mips_frame.ml new file mode 100644 index 0000000..99918d5 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_mips_frame.ml @@ -0,0 +1,55 @@ +module List = ListLabels + +module Temp = Tiger_temp + +type access = + | InFrame of {offset_from_frame_pointer : int} + | InReg of {register : Temp.Temp.t} + +type t = +(* p.136 Frame.t is a data structure holding: + * - the locations of all the formals + * - instructions required to implement the "view shift" + * - the number of locals allocated so far + * - the `label` at which the function's machine code is to begin (see p.140) + * *) + { name : Temp.Label.t + ; formals : access list + ; locals_count : int + ; instructions : unit (* TODO: instructions for view shift *) + } + +let name {name; _} = + name + +let formals {formals; _} = + formals + +let alloc offset_from_frame_pointer ~escapes = + if escapes then + InFrame {offset_from_frame_pointer} + else + InReg {register = Temp.Temp.gen ()} + +let alloc_local _ ~escapes = + (* FIXME: offset_from_frame_pointer. With neither mutation nor new frame? *) + let offset_from_frame_pointer = 0 in + alloc offset_from_frame_pointer ~escapes + +let make ~name ~formals = + (* p.136: For each formal parameter, "newFrame" must calculate two things: + * - How the parameter will be seen from inside the function + * (in a register, or in a frame location); + * - What instructions must be produced to implement the "view shift" + * *) + let formals, locals_count = + (* TODO: What should offset increment be? Word? *) + List.fold_left formals ~init:([], 0) ~f:(fun (formals, offset) escapes -> + ((alloc offset ~escapes) :: formals, succ offset) + ) + in + { name + ; formals + ; locals_count + ; instructions = () (* TODO: instructions for view shift *) + } diff --git a/compiler/src/lib/tiger/tiger_mips_frame.mli b/compiler/src/lib/tiger/tiger_mips_frame.mli new file mode 100644 index 0000000..2b2c5ed --- /dev/null +++ b/compiler/src/lib/tiger/tiger_mips_frame.mli @@ -0,0 +1 @@ +include Tiger_frame_sig.S diff --git a/compiler/src/lib/tiger/tiger_semant.ml b/compiler/src/lib/tiger/tiger_semant.ml index 25eb2ce..f809509 100644 --- a/compiler/src/lib/tiger/tiger_semant.ml +++ b/compiler/src/lib/tiger/tiger_semant.ml @@ -7,6 +7,7 @@ module E = Tiger_error module Escape = Tiger_semant_escape module Pos = Tiger_position module Sym = Tiger_symbol +module Temp = Tiger_temp module Translate = Tiger_translate module Type = Tiger_env_type module Value = Tiger_env_value @@ -123,7 +124,7 @@ end = struct return_string | A.CallExp {func; args; pos} -> (match env_get_val ~sym:func ~env ~pos with - | Value.Fun {formals; result} -> + | Value.Fun {formals; result; level=_; label=_} -> let expected = List.length formals in let given = List.length args in if given = expected then @@ -202,7 +203,10 @@ end = struct check_int (trexp lo) ~pos; check_int (trexp hi) ~pos; let (loop, env) = Env.loop_begin env in - let env = Env.set_val env var (Value.Var {ty = Type.Int}) in + let level = Env.level_get env in + (* Assuming all escape, for now *) + let access = Translate.alloc_local ~level ~escapes:true in + let env = Env.set_val env var (Value.Var {ty = Type.Int; access}) in (* Only care if an error is raised *) ignore (transExp ~env body); ignore (Env.loop_end env loop); @@ -239,8 +243,10 @@ end = struct (function | A.SimpleVar {symbol=sym; pos} -> (match env_get_val ~sym ~env ~pos with - | Value.Fun _ -> E.raise (E.Id_is_a_function {id=sym; pos}) - | Value.Var {ty} -> return (actual_ty ~pos ty) + | Value.Fun _ -> + E.raise (E.Id_is_a_function {id=sym; pos}) + | Value.Var {ty; access=_} -> + return (actual_ty ~pos ty) ) | A.FieldVar {var; symbol; pos} -> let {exp=_; ty} = trvar var in @@ -327,7 +333,12 @@ end = struct ty ) in - Env.set_val env name (Value.Var {ty}) + let access = + Translate.alloc_local + ~level:(Env.level_get env) + ~escapes:true (* Assuming all escape, for now... *) + in + Env.set_val env name (Value.Var {ty; access}) | A.TypeDecs typedecs -> check_cycles typedecs; let env = @@ -366,7 +377,16 @@ end = struct | Some (s, p) -> env_get_typ_actual ~sym:s ~env ~pos:p | None -> Type.Unit in - Env.set_val env name (Value.Fun {formals; result}) + let label = Temp.Label.gen () in + let level = + Translate.Level.next + (Env.level_get env) + ~name:label + (* Assuming all escape (for now) *) + ~formals:(List.map formals ~f:(fun _ -> true)) + in + let env = Env.level_set env level in + Env.set_val env name (Value.Fun {formals; result; level; label}) ) in List.iter fundecs ~f:( @@ -375,7 +395,13 @@ end = struct List.fold_left params ~init:env_with_fun_heads_only ~f:( fun env (A.Field {name=var_name; escape=_; typ; pos}) -> let var_ty = env_get_typ_actual ~env ~sym:typ ~pos in - Env.set_val env var_name (Value.Var {ty = var_ty}) + let level = Env.level_get env in + (* Assuming all escape, for now *) + let access = Translate.alloc_local ~level ~escapes:true in + Env.set_val + env + var_name + (Value.Var {ty = var_ty; access}) ) in (* we only care if an exception is raised *) @@ -404,6 +430,6 @@ end open Semant let transProg absyn = - Escape.find absyn; + Escape.find ~prog:absyn; let {exp = _; ty = _} = transExp absyn ~env:Env.base in () diff --git a/compiler/src/lib/tiger/tiger_temp.ml b/compiler/src/lib/tiger/tiger_temp.ml new file mode 100644 index 0000000..439b0c0 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_temp.ml @@ -0,0 +1,47 @@ +open Printf + +module Sym = Tiger_symbol + +module Counter : sig + type t + + val create : unit -> t + + val next : t -> int +end = struct + type t = int ref + + let create () = + ref 0 + + let next t = + incr t; + !t +end + +module Temp = struct + type t = int + + let t = Counter.create () + + let gen () = + Counter.next t + + let to_string t = + sprintf "t%d" t +end + +module Label = struct + type t = Sym.t + + let counter = Counter.create () + + let of_string = + Sym.of_string + + let gen () = + of_string (sprintf "L%d" (Counter.next counter)) + + let to_string = + Sym.to_string +end diff --git a/compiler/src/lib/tiger/tiger_temp.mli b/compiler/src/lib/tiger/tiger_temp.mli new file mode 100644 index 0000000..5535a2a --- /dev/null +++ b/compiler/src/lib/tiger/tiger_temp.mli @@ -0,0 +1,27 @@ +(* "We use the word _temporary_ to mean a value that is temporarily held in a + * register, and the word _label_ to mean some machine-language location whose + * exact address is yet to be determined - just like a label in assembly + * language." ch. 6.2, p. 139 *) + +(* "temp" is an abstract name of "local variable" *) +module Temp : sig + type t + + val gen : unit -> t + (** "newtemp" - new temporary from an infinite set of temps. *) + + val to_string : t -> string +end + +(* "label" is an abstract name for "static memory address" *) +module Label : sig + type t + + val gen : unit -> t + (** "newlabel" - new label from an infinite set of labels. *) + + val of_string : string -> t + (** "namedlabel" - new label whose assembly-language name is string. *) + + val to_string : t -> string +end diff --git a/compiler/src/lib/tiger/tiger_translate.ml b/compiler/src/lib/tiger/tiger_translate.ml index 7f71711..f07ec68 100644 --- a/compiler/src/lib/tiger/tiger_translate.ml +++ b/compiler/src/lib/tiger/tiger_translate.ml @@ -1 +1,56 @@ +module List = ListLabels + +module Frame = Tiger_frame +module Temp = Tiger_temp + +module Level = struct + type t = + { parent : t option + ; name : Temp.Label.t + ; formals : bool list + ; frame : Frame.t + } + + let init = + let name = Temp.Label.gen () in + let formals = [] in + { parent = None + ; name + ; formals + ; frame = Frame.make ~name ~formals + } + + let next t ~name ~formals = + (* Adding the extra parameter for the static link. See p. 142 *) + let formals = true :: formals in + { parent = Some t + ; name + ; formals + ; frame = Frame.make ~name ~formals + } + + let formals = function {formals; _} -> + formals + + let frame = function {frame; _} -> + frame +end + type exp = unit + +type access = + (* must know about static links *) + { level : Level.t + ; frame_access : Frame.access + } + +let alloc_local ~level ~escapes = + { level + ; frame_access = Frame.alloc_local (Level.frame level) ~escapes + } + +let formals ~level = + (* FIXME: This seems wrong. Should we call Frame.formals? *) + List.map (Level.formals level) ~f:(fun escapes -> + alloc_local ~level ~escapes + ) diff --git a/compiler/src/lib/tiger/tiger_translate.mli b/compiler/src/lib/tiger/tiger_translate.mli index 7f71711..9fd1146 100644 --- a/compiler/src/lib/tiger/tiger_translate.mli +++ b/compiler/src/lib/tiger/tiger_translate.mli @@ -1 +1,17 @@ +module Level : sig + type t + + val init : t + (** "outermost" in Applel's code *) + + val next : t -> name:Tiger_temp.Label.t -> formals:bool list -> t + (** "newLevel" in Appel's code *) +end + type exp = unit + +type access + +val alloc_local : level:Level.t -> escapes:bool -> access + +val formals : level:Level.t -> access list -- 2.20.1