maj Sujet et quelques fichiers pour funcall

src/cfg_run.ml

@@ -53,7 +53,7 @@ let eval_cfgfun oc st cfgfunname { cfgfunargs;
   let st' = { st with env = Hashtbl.create 17 } in
   match List.iter2 (fun a v -> Hashtbl.replace st'.env a v) cfgfunargs vargs with
   | () -> eval_cfginstr oc st' cfgfunbody cfgentry >>= fun (v, st') ->
-    OK (Some v, st')
+    OK (Some v, {st' with env = st.env})
   | exception Invalid_argument _ ->
     Error (Format.sprintf "CFG: Called function %s with %d arguments, expected %d.\n"
              cfgfunname (List.length vargs) (List.length cfgfunargs)

src/ltl_gen.ml

@@ -66,22 +66,22 @@ let store_loc tmp allocation r =
   | Some (Stk o) -> OK ([LStore(reg_fp, !Archi.wordsize * o, tmp, !Archi.wordsize)], tmp)
   | Some (Reg r) -> OK ([], r)
 
-(* saves registers in [to_save] on the stack at offsets [fp + o, fp + o - 8, fp
-   + o - 16...]. Returns:
+(* saves registers in [to_save] on the stack at offsets [fp + 8 * o, fp + 8 * (o
+   - 1), fp + 8 * (o - 2)...]. Returns:
 
    - an association list [(reg,ofs)] (meaning register reg is saved at [fp+ofs])
-   - the list of store instructions
-   - the next offset to be written.
-*)
+   - the list of store instructions - the next offset to be written. *)
 let save_caller_save to_save ofs =
   List.fold_left (fun (instrs, arg_saved, ofs) reg ->
-      (instrs @ [LStore(reg_fp, ofs, reg, !Archi.wordsize)],
-       (reg,ofs)::arg_saved, ofs - !Archi.wordsize)
+      (instrs @ [LStore(reg_fp, !Archi.wordsize * ofs, reg, !Archi.wordsize)],
+       (reg,ofs)::arg_saved, ofs - 1)
     ) ([], [], ofs) to_save
 
 (* Given a list [(reg,ofs)], loads [fp+ofs] into [reg]. *)
-let restore_caller_save =
-  List.map (fun (reg, ofs) -> LLoad(reg, reg_fp, ofs, !Archi.wordsize))
+let restore_caller_save arg_saved =
+  List.map
+    (fun (reg, ofs) -> LLoad(reg, reg_fp, !Archi.wordsize * ofs, !Archi.wordsize))
+    arg_saved
 
 let num_parameters_passed_on_stack regs =
   let r = List.length regs - number_of_arguments_passed_in_registers in
@@ -110,7 +110,7 @@ let overwritten_args rargs allocation =
   (* [ltl_args] contains the locations of RTL args after allocation. *)
     list_map_res (fun r -> match Hashtbl.find_option allocation r with
         | None -> Error (Format.sprintf
-                              "pass_parameters: Couldn't allocate register r%d."
+                              "overwritten_args: Couldn't allocate register r%d."
                               r)
         | Some loc -> OK loc
       ) rargs >>= fun ltl_args ->
@@ -253,42 +253,15 @@ let rtl_to_ltl_registers allocation l =
    them. This gives a list of machine registers used by the LTL function. We
    need to add also the registers that will be used for argument passing. *)
 
-let read_ltl_regs_clever fname l allocation =
-  read_rtl_regs l |> rtl_to_ltl_registers allocation
-let written_ltl_regs_clever fname l allocation =
+let written_ltl_regs fname l allocation =
   written_rtl_regs l |> rtl_to_ltl_registers allocation
 
-let read_ltl_regs fname l allocation =
-  read_ltl_regs_clever fname l allocation
-
-let written_ltl_regs fname l allocation =
-  written_ltl_regs_clever fname l allocation
-
-(* We propose three different strategies for caller-save registers:
-   - [CSS_all] : save all registers before calling a function
-   - [CSS_read] : save all registers that are read in the calling function,
-     we might need them later in the function
-   - [CSS_live] : save all registers that are live after the call to the
-     function, this is more precise than [CSS_read].
-*)
-type caller_save_strategy =
-  | CSS_all
-  | CSS_read
-  | CSS_live
-
-let caller_save live_out allocation read_regs rargs
-    (strategy: caller_save_strategy) =
-  let l =
-    match strategy with
-    | CSS_all -> OK (range 32 |> Set.of_list)
-    | CSS_read -> OK read_regs
-    | CSS_live ->
-      let live_after = live_out in
-      let live_after_ltl = live_after |> rtl_to_ltl_registers allocation in
-      overwritten_args rargs allocation >>= fun overwritten_args_tosave ->
-      OK (Set.union live_after_ltl overwritten_args_tosave)
-  in
-  l >>= fun l -> OK (Set.intersect l (Set.of_list (arg_registers @ reg_tmp)))
+let caller_save live_out allocation rargs =
+  let live_after = live_out in
+  let live_after_ltl = live_after |> rtl_to_ltl_registers allocation in
+  overwritten_args rargs allocation >>= fun overwritten_args_tosave ->
+  let l = Set.union live_after_ltl overwritten_args_tosave in
+  OK (Set.intersect l (Set.of_list (arg_registers @ reg_tmp)))
 
 (* This generates LTL instructions for a given Linear/RTL instruction. In most
    cases, the transformation amounts to 'loading' RTL registers in LTL locations
@@ -301,7 +274,7 @@ let caller_save live_out allocation read_regs rargs
    code of the caller. (The rationale being, if we don't read this variable,
    then we don't need its value to be preserved across function calls.) These
    registers are saved at [fp - 8 * (curstackslot + 1)] *)
-let ltl_instrs_of_linear_instr fname live_out allocation read_regs
+let ltl_instrs_of_linear_instr fname live_out allocation
     numspilled epilogue_label ins =
   match ins with
   | Rbinop (b, rd, rs1, rs2) ->
@@ -399,10 +372,9 @@ let ltl_fun_of_linear_fun linprog
                  List.concat (List.map make_pop
                                 (List.rev (Set.to_list callee_saved_regs))) @
                  [LJmpr reg_ra] in
-  let read_regs_f = read_ltl_regs fname linearfunbody allocation in
   list_map_resi (fun i ->
       ltl_instrs_of_linear_instr fname (Hashtbl.find_default live_out i Set.empty)
-        allocation read_regs_f numspilled epilogue_label) linearfunbody
+        allocation numspilled epilogue_label) linearfunbody
   >>= fun l ->
   let instrs = List.concat l 
   in

tests/test.py

@@ -89,7 +89,7 @@ class Displayer(Thread):
         print()
 
 # The number of columns in the HTML table
-numcols = len(args.passes)
+numcols = len(args.passes) + 1 # 1 colonne pour le lexer
 
 def display_verbatim(body):
     return '\n'.join(['\n'.join(textwrap.wrap(line, 90,
@@ -211,16 +211,14 @@ class CommandExecutor(Thread):
                                                         tofile=out_lex_file_name)
                             diff = list(diff)
                             if diff == []:
-                                compsted_td = ""
+                                compstep_td = "<td class=\"good\">OK</td>"
                             else:
-                                compstep_td = "<td class=\"bad\" style=\"text-align: left;\" colspan=\"{}\">{} not-what-expected:<br><pre>".format( numcols - curcol, r['compstep'])
+                                compstep_td = "<td class=\"warn\" style=\"text-align: left;\" >{} not-what-expected:<br><pre>".format(r['compstep'])
                                 for line in diff:
                                     compstep_td += line
                                 compstep_td += "{}</pre></td>"
-                                self.s += compstep_td
-                                break
                     except:
-                        compstep_td = ""
+                        compstep_td = "<td>No .expect_lexer file</td>"
 
 
                 self.s += compstep_td
@@ -284,6 +282,9 @@ td {
 .good{
     background-color: #c7f0d2;
 }
+.warn{
+    background-color: orange;
+}
 fieldset {
     display: inline;
     margin: 1em;
@@ -292,7 +293,7 @@ fieldset {
 </style>
 <table>
 <tr>
-<th>File</th>""")
+<th>File</th><th>Lexer</th>""")
 for p in args.passes:
     res_html.write("<th>{}</th>\n".format(p))
 res_html.write("""
@@ -309,8 +310,8 @@ for t in threads:
 res_html.close()
 
 numtotal = len(threads)
-ok = [t for t in threads if t.lastcorrectstep == numcols-1]
-ko = [t for t in threads if t.lastcorrectstep != numcols-1]
+ok = [t for t in threads if t.lastcorrectstep == numcols-2]
+ko = [t for t in threads if t.lastcorrectstep != numcols-2]
 
 print("{}/{} OK.".format(len(ok), numtotal))
 print("{}/{} KO : {}".format(len(ko), numtotal,list(map((lambda t: (t.f, t.lastcorrectstep)), ko))))