Previous Up Next

Module Translate

module Frame = Pentiumframe.Frame

type level = int 
type access = level × Frame.access (∗ cf. page 142 ∗)

List of open frames. In principle it’s a stack, but the stack is not ideal, since I need to access not only at the top.
let dummy_frame = Frame.new_frame (Temp.getnamedlabel("DUMMYFRAME"), [ ])
let openframes: (Frame.frame listref = ref [ ]
let current_frameFrame.frame ref = ref dummy_frame

The following is a list of program fragments, collected during the semantical phase. The value can be extracted at the end by get_result. Cf. page 170.
let frags : Frame.frag list ref = ref [ ]

let outermost = 0

exception Translation_error of string

type exp = 
     Ex of Tree.exp
   ∣ Nx of Tree.stm
   ∣ Cx of (Temp.label → Temp.label → Tree.stm)

let rec unEx e =
   match e with
     Nx s → Tree.Eseq(s,Tree.Const(0))
   ∣ Ex te → te
   ∣ Cx cs → (∗ the cond. statement cs is a function ∗)
       let r = Temp.getnewtemp() 
       and t = Temp.getnewlabel()
       and f = Temp.getnewlabel()
       in 
     Tree.Eseq(Tree.Seq(Tree.Move(Tree.Temp(r),Tree.Const(1)),
                         Tree.Seq((unCx e t f),
                                 Tree.Seq(Tree.Label(f),
                                           Tree.Seq(Tree.Move(Tree.Temp(r), Tree.Const(0)),
                                                   Tree.Label(t))))),
               Tree.Temp(r))

and unNx e = 
   match e with
   Nx s → s (∗ the trivial case ∗)
∣ Ex te → Tree.Exp te (∗ Exp-constructor gives a Tree.stm! ∗)
∣ Cx s → (∗ Just jump unconditionally after it ∗)
     let tf = Temp.getnewlabel() 
     in 
     Tree.Seq(unCx e tf tf,
               Tree.Label(tf))

and unCx e l1 l2 = 
   match e with 
   Nx _ → raise (Translation_error("impossible: unCx??")) (∗ cannot happen, if well-typed ∗)
∣ Ex te → (Tree.CJump(Tree.NETree.Const(0), tel1l2)) (∗ te should be 0 or 1, if well-typed ∗)
∣ Cx s → s l1 l2 (∗ simply apply s ∗)

for debugging. perhaps move elsewhere
let string_of_exp e = match e with (∗ the first string must have a newline, otherwise the indentation of the pretty printer does not start correct. ∗)
   Nx st → "Nx\n" ^ Pptrees.to_string st
∣ Ex te → "Ex\n" ^ Pptrees.exp_to_string te
∣ Cx s → "Cx \n function L_true -> function L_false\n" ^
     Pptrees.to_string (s (Temp.getnamedlabel("L_true"))
                           (Temp.getnamedlabel("L_false")))

let string_of_access a = match a with
   (l,fa) →
     ("level " ^ (string_of_int l) ^
       "; access " ^ (Frame.string_of_access fa))

The following function is called during function declaration (cf. page 141). It creates a new frame, counts up accordingly the level. The freshly created frame is added to the list of open frames as the current one. Variable declarations inside the according function body will be added to the current frame. The static link is added as additional zeroth formal parameter, which escapes.


let new_level (lev:level) (nameSymbol.symbol) (blbool list) = (∗ cf. page 141 ∗)
   let lab = Temp.getnewlabel()
   in let f = (Frame.new_frame (labtrue :: bl)) (∗ additional true-value = static link, which escapes ∗)
   in 
   openframes := !current_frame :: !openframes;
   current_frame := f; (∗ put the new frame on top ∗)
   (lev+1,lab)

Cf. page 170. The function is called by the Semant-module at the end of a function declaration, i.e., when the body is processed. As a side effect, it moves the current frame as procedure fragment to the fragment list.
let proc_entry_exit((levlevel), (bodyexp)) : unit = 
   print_endline ("\nproc_entry_exit at level " ^ (string_of_int lev)
                   ^ " with body :" ^ (string_of_exp body));
   let (bodyTree.stm) = Frame.proc_entry_exit1 (dummy_frameunNx body)
   in 
   frags := Frame.Proc(body, !current_frame) :: !frags;
   match !openframes with
     f :: fl → 
       (current_frame := f;
         openframes := fl)
   ∣ _ → raise (Failure "can not happen, there is always an outside frame")

The formals given back here remove the static link, since it is invisible to the semantics module.
let formals (llevel) = 
   let formals_with_sl =
     (List.map 
         (function a → 
           ((l,a))) (Frame.formals !current_frame))
   in match formals_with_sl with
     sl :: fl → fl (∗ static link is not given to the Semant-module ∗)
   ∣ [ ] → raise (Failure "can not happen, a static link must be there.")

The allocation of a local variable is done always in the current frame.
let alloc_local (llevel) (bbool) : access = (∗ cf. page 141 ∗)
   if b then (∗ we always escape ∗)
     ((l , (Frame.alloc_local !current_frame true)))
   else raise (Failure "This cannot happen; we currently only allow escaping variables ")

let get_result () = !frags (∗ return the fragment list ∗)

let int_exp (iint) = Ex(Tree.Const(i))
let nil_exp () = Nx(Tree.Exp(Tree.Const(0)))

let string_exp(sstring) = 
   print_endline ("Translate.string (" ^ s ^ ")");
   let lab = Temp.getnewlabel() (∗ pointer to the string ∗)
   in frags := Frame.String(lab,s) :: !frags;
   Ex(Tree.Name(lab))

let op_exp (e1oe2) = (∗ all operations, except string comparisons ∗)
   match o with 
     Absynt.PLUS → Ex (Tree.Binop(Tree.PLUSunEx e1unEx e2))
   ∣ Absynt.MINUS → Ex (Tree.Binop(Tree.MINUSunEx e1unEx e2))
   ∣ Absynt.MUL → Ex (Tree.Binop(Tree.MULunEx e1unEx e2))
   ∣ Absynt.DIV → Ex (Tree.Binop(Tree.DIVunEx e1unEx e2))
   ∣ Absynt.LT → Cx (function t → (function f → (Tree.CJump(Tree.LTunEx e1,unEx e2,t,f))))
   ∣ Absynt.LE → Cx (function t → (function f → (Tree.CJump(Tree.LEunEx e1,unEx e2,t,f))))
   ∣ Absynt.GT → Cx (function t → (function f → (Tree.CJump(Tree.GTunEx e1,unEx e2,t,f))))
   ∣ Absynt.GE → Cx (function t → (function f → (Tree.CJump(Tree.GEunEx e1,unEx e2,t,f))))
   ∣ Absynt.EQ → Cx (function t → (function f → (Tree.CJump(Tree.EQunEx e1,unEx e2,t,f))))
   ∣ Absynt.NE → Cx (function t → (function f → (Tree.CJump(Tree.NEunEx e1,unEx e2,t,f))))

let assign_expr (e1,e2) = (∗ x := e ∗)
   Nx(Tree.Move(unEx(e1) , unEx(e2)))

The following processes a list of expressions into a single expression. This corresponds to the translation of Absynt.SeqExpr. The participating expressions are already transformed to intermediate code, which was done while the sequences was type checked in the Semant-module. Therefore, here, the particles have to be glued together, only. The function will also be used to glue together the sequence of initialization assignments in front of the translation of the body of a let-expression.

The function distinguishes according to the result type, i.e., the type of the last element, which is handed over. In case the type is Type.UNIT, no value is given back, which simplifies the list iteration.


let seqlist ((elexp list), (tTypes.ty)) : exp = 
   assert (el ≠ [ ]); (∗ the sequence must not be empty, this is guaranteed by the parser ∗)
   match t with
     Types.UNIT → (∗ no return type ∗)
       (let rec seq (elexp list) : Tree.stm =
         assert (el ≠ [ ]); (∗ the sequence must not be empty, this is guaranteed by the parser ∗)
         match el with 
           [ ] → raise (Failure "this is impossible")
         ∣ [e] → ((unNx e) : Tree.stm)
         ∣ e:: el → (Tree.Seq(unNx eseq (el)))
       in Nx(seq(el)))
   ∣ _ → (∗ value of the last element must be returned ∗)
       (let rec seqlist_to_eseqseq (elexp list) : (Tree.stmoption × Tree.exp =
         match el with 
           [ ] → raise (Failure "this is impossible")
         ∣ [e_0] → (NoneunEx e_0
         ∣ [ee_n] → (Some (unNx e), unEx e_n)
         ∣ e:: el → 
             let (soe_n) = seqlist_to_eseqseq el
             in match so with
               None → raise (Failure "this is impossible")
             ∣ Some s → (Some (Tree.Seq(unNx e,s)), e_n)
       in let (so1,e2) = seqlist_to_eseqseq el
       in match so1 with 
         None → Ex e2
       ∣ Some s1 → Ex(Tree.Eseq(s1e2)))

Translation of the if-then-else expression. It is made more efficient by detecting certain special cases.
let if_expr(c,e2,eo3) : exp = 
   match eo3 with
     Some(e3) → (∗ 2-sided if-then-else-fi ∗)
       (match (e2,e3with
       ∣ (Cx e2′Cx e3′) → (∗ In this case, we give back a conditional expression. ∗)
           print_endline "double Cx/Cx";
           let c = unCx c (∗ get the corresponding function. ∗)
           in
           Cx
             (function t → (function f →
               (let lc1 = Temp.getnewlabel()
               in let lc2 = Temp.getnewlabel()
               in Tree.Seq(c lc1 lc2
                             Tree.Seq(Tree.Label lc1,
                                     Tree.Seq (e2′ t f,
                                               Tree.Seq(Tree.Label lc2,
                                                         e3′ t f)))))))
       ∣ (Nx s2′Nx s3′) → (∗ both branches without return value. ∗)
           print_endline ("double Nx/Nx");
           let c = unCx c (∗ get the corresponding function. ∗)
           in let t = Temp.getnewlabel()
           in let f = Temp.getnewlabel()
           in let l_join = Temp.getnewlabel()
           in 
           Nx (Tree.Seq(c t f
                         Tree.Seq(Tree.Label t,
                                 Tree.Seq (s2′
                                           Tree.Seq(Tree.Jump(Tree.Name(l_join),[l_join]),
                                                     Tree.Seq(Tree.Label f,
                                                             Tree.Seq(s3′
                                                                       Tree.Seq(Tree.Jump(Tree.Name(l_join),[l_join]),
                                                                               Tree.Label l_join)))))))) 
       ∣ _ → (∗ In the default case, a value is given back ∗)
           print_endline "\ntranslation if-then-else (default): ";
           (let t = Temp.getnewlabel() (∗ Three new labels ∗)
           and f = Temp.getnewlabel()
           and join = Temp.getnewlabel()
           and r = Temp.getnewtemp() (∗ and a temporary ∗)
           in 
           let t_1 = unCx(c)
           and t_2 = unEx(e2)
           and t_3 = unEx(e3)
           in 
           Ex(Tree.Eseq
               Tree.Seq(t_1 t f
                       Tree.Seq(Tree.Label t
                                 Tree.Seq(Tree.Move(Tree.Temp(r),t_2),
                                         Tree.Seq(Tree.Jump(Tree.Name(join),[join]), 
                                                   Tree.Seq(Tree.Label f,
                                                           Tree.Seq(Tree.Move(Tree.Temp(r), t_3),
                                                                     Tree.Seq(Tree.Jump(Tree.Name(join),[join]),
                                                                             Tree.Label join))))))),
               Tree.Temp(r))))) (∗ the result ∗)
   ∣ None → (∗ one-armed if-then-fi. The branch cannot give back a value by the type system ∗)
       print_endline ("double Nx/Nx");
       let c = unCx c (∗ get the corresponding function. ∗)
       in let s2 = unNx e2 
       in let t = Temp.getnewlabel() (∗ we use 2 labels, such that we can use the c-operator ∗)
       in let f = Temp.getnewlabel() 
       in 
       Nx (Tree.Seq(c t f
                     Tree.Seq(Tree.Label t,
                             Tree.Seq (s2
                                       Tree.Seq(Tree.Jump(Tree.Name(f),[f]),
                                                 Tree.Label f)))))

let while_exp ((condbodyl_done) : exp × exp × Temp.label) =
   print_endline ("\ntranslation of while.");
   let cond = unCx cond
   in let body = unNx body
   in let l_test = Temp.getnewlabel()
   in let l_body = Temp.getnewlabel()
   in Nx (Tree.Seq(Tree.Label l_test,
                   Tree.Seq(cond l_body l_done,
                             Tree.Seq(Tree.Label l_body,
                                     Tree.Seq (body
                                               Tree.Seq (Tree.Jump (Tree.Name l_test, [l_test]),
                                                         Tree.Label l_done))))))

let break_exp l_done = Nx (Tree.Jump (Tree.Name l_done, [l_done]))

let static_link (fFrame.frame) : Tree.exp = 
   let al = Frame.formals f
   in match al with
     sl::_ → Frame.direct_exp sl
   ∣ _ → raise (Failure "cannot happen, each frame has a static link")

The function calculates an expression following the static links in climbing up a list of list of frames, in effect the list of open frames from inside out, as given by the difference the the inner level where the variable is used, with the level embodied in the access, i.e., the outer level where the variable has been defined, so it is called lev_uselev_dec +1 times.


let rec deref_static_link ((lev_declev_use): (level × level)) (flFrame.frame list) : Tree.exp = 
     assert (lev_dec ≤ lev_use);
   assert ((List.length fl) ≥ (lev_use − lev_dec) + 1);
   if (lev_dec = lev_use)
   then Tree.Temp(Frame.fp)
   else 
     (match fl with 
       [ ] → raise (Failure "this cannot happen, there must be enough open frames")
     ∣ f::fl → (∗ Now we need access to the static link ∗)
         Tree.Mem(Tree.Binop(Tree.PLUS,
                             static_link(f),
                             deref_static_link (lev_declev_use−1) fl)))

let simple_var ((aaccess), (l_uselevel)) = (∗ cf. p. 156 ∗)
   match a with ((l_declevel) , (faFrame.access)) →
     let tree_to_frame = (deref_static_link (l_decl_use) (!current_frame :: !openframes))
     in let tree_absolute : Tree.exp = (Frame.exp fa tree_to_frame)
     in
         Ex(tree_absolute)

let array_exp ((e_sizeexp), (e_initexp)) : exp = 
   print_endline("Translate array expression:------------------------->");
   let r_size = Tree.Temp(Temp.getnewtemp())
   and r_index = Tree.Temp(Temp.getnewtemp())
   and r_result = Tree.Temp(Temp.getnewtemp())
   and l_start = Temp.getnewlabel()
   and l_t = Temp.getnewlabel()
   and l_f = Temp.getnewlabel()
   in let (sl : exp list) =
     [ Nx(Tree.Move (r_sizeunEx(e_size)));
       Nx(Tree.Move (r_indexTree.Const(0)));
       Nx(Tree.Move (r_result
                     Frame.external_call("array_alloc", [r_size])));
       Ex(Tree.Name(l_start));
       Nx(Tree.CJump(Tree.LTr_indexr_sizel_tl_f)); 
       Nx(Tree.Label(l_t));
       Nx(Tree.Move(Tree.Binop(Tree.PLUS,
                               Tree.Mem(r_result),
                               r_index),
                     (unEx e_init)));
       Nx(Tree.Move(r_indexTree.Binop(Tree.PLUSr_indexTree.Const(1))));
       Nx(Tree.Jump(Tree.Name(l_start), [l_start]));
       Nx(Tree.Label(l_f));
       Ex(r_result)
     ]
   in
   seqlist(slTypes.UNIT)

let record_exp(elexp list) : exp = 
   print_endline("Translate record expression (= creation) ------------------------->");
   let r_result = Tree.Temp(Temp.getnewtemp())
   in let n = List.length el
   in let init_fields : (exp list → (int × exp list)) = 
     List.fold_left 
       (function (n,tl) →
         (function (e:exp) → 
           (n+1,
             tl @ [Nx(Tree.Move(Tree.Mem(Tree.Binop(Tree.PLUS,r_result,
                                                 Tree.Const(Frame.wordsize × n))),
                               unEx e))])))
       (0,[ ])
   in let (slexp list) =
     [Nx(Tree.Move(r_result,
                   Frame.external_call("malloc"
                                       [Tree.Const(Frame.wordsize ×n)])))
     ] @ (snd (init_fields el)) @ [Ex r_result]
   in
   seqlist(slTypes.INT) (∗ that’s a bit of a hack: we need to have a value back ∗)

let subscript_var (e1e2) = (∗ ve ∗) 
     print_endline("Translate subscript var v[e] ------------------------->");
   Ex(Tree.Mem(Tree.Binop(Tree.PLUS,
                           unEx e1,
                           Tree.Binop(Tree.MUL,
                                     unEx e2,
                                     Tree.Const(Frame.wordsize)))))

let field_var (e,i) = (∗ i is the offset ∗)
   print_endline("record selection:------------------------->");
   Ex(Tree.Mem(Tree.Binop(Tree.PLUS,
                           unEx e,
                           Tree.Binop(Tree.MUL,
                                     Tree.Const(i),
                                     Tree.Const(Frame.wordsize)))))

let call_exp ((l_fTemp.label), (el : exp list), (lev_flevel), (lev_callerlevel) ) =
   print_endline("print function call:------------------------->");
   print_endline("function label =       " ^ (Temp.string_of_label l_f));
   print_endline("caller level =         " ^ (string_of_int lev_caller));
   print_endline("function body  level = " ^ (string_of_int lev_f));
   let elt = List.map unEx el
   in Ex(Tree.Call(Tree.Name l_felt)) (∗ static link is missing ∗)

 ,
Previous Up Next