Affichage correct de la trace de calcul (#229)

.github/workflows/binary-releases.yml

@@ -94,7 +94,7 @@ jobs:
         uses: ocaml/setup-ocaml@v2
         with:
           # Version of the OCaml compiler to initialise
-          ocaml-compiler: ocaml-variants.4.12.0+options,ocaml-option-flambda,ocaml-option-musl,ocaml-option-static
+          ocaml-compiler: 4.11.2
 
       - name: Install dependencies
         run: |

compare_traces.sh

@@ -0,0 +1,8 @@
+#! /bin/bash
+DGFIP_TARGET_FLAGS=-g,-O,-k4,-t YEAR=2022 make compile_dgfip_c_backend -B
+~/fuzzing-calculette/calculette/trunk/2022/AIT \
+    -f tests/2022/fuzzing/fuzzer_3469.m_test |& \
+    sed -e 's/\x1b\[[0-9;]*m//g' &> aif_trace.txt
+NO_BINARY_COMPARE=1 ./examples/dgfip_c/ml_primitif/cal \
+    tests/2022/fuzzing/fuzzer_3469.m_test &> mlang_trace.txt
+diff aif_trace.txt mlang_trace.txt -u > diff_trace.txt

examples/dgfip_c/ml_primitif/c_driver_inline_4/var.c

@@ -16,9 +16,6 @@ int nb_penalite = NB_PENALITE;
 int nb_restituee = NB_RESTITUEE;
 int nb_enchaine = NB_ENCH;
 
-int color = 37;
-int typo = 0;
-
 #ifdef FLG_DEBUG
 int nb_err = NB_ERR;
 #if NB_DEBUG_C <= 0
@@ -54,15 +51,6 @@ T_discord * une_verif(T_irdata *irdata, struct S_discord *(*proc)(T_irdata *irda
 #endif /* FLG_MULTITHREAD */
 }
 
-int change_couleur(int couleur, int typographie) {
-  color = couleur;
-  typo = typographie;
-  return 0;
-}
-
-int get_couleur(void) {
-  return color;
-}
 
 struct S_discord * verif_saisie_cohe_primitive_isf(T_irdata *irdata, int appel) {
 #ifdef FLG_MULTITHREAD

examples/dgfip_c/ml_primitif/c_driver_inline_4/var.h

@@ -44,9 +44,5 @@ extern int nb_verif;
 #endif /* FLG_DEBUG || FLG_CONTROLE_IMMEDIAT */
 
 extern T_discord *une_verif _PROTS((T_irdata *irdata, struct S_discord *(*proc)(T_irdata *irdata)));
-
-extern int change_couleur(int couleur, int typographie);
-extern int get_couleur(void);
-
 #endif
 

examples/dgfip_c/ml_primitif/c_driver_with_macro/var.c

@@ -16,9 +16,6 @@ int nb_penalite = NB_PENALITE;
 int nb_restituee = NB_RESTITUEE;
 int nb_enchaine = NB_ENCH;
 
-int color = 37;
-int typo = 0;
-
 #ifdef FLG_DEBUG
 int nb_err = NB_ERR;
 #if NB_DEBUG_C <= 0
@@ -54,16 +51,6 @@ T_discord * une_verif(T_irdata *irdata, struct S_discord *(*proc)(T_irdata *irda
 #endif /* FLG_MULTITHREAD */
 }
 
-int change_couleur(int couleur, int typographie) {
-  color = couleur;
-  typo = typographie;
-  return 0;
-}
-
-int get_couleur(void) {
-  return color;
-}
-
 struct S_discord * verif_saisie_cohe_primitive_isf(T_irdata *irdata, int appel) {
 #ifdef FLG_MULTITHREAD
   init_erreur(irdata);

examples/dgfip_c/ml_primitif/c_driver_with_macro/var.h

@@ -45,8 +45,5 @@ extern int nb_verif;
 
 extern T_discord *une_verif _PROTS((T_irdata *irdata, struct S_discord *(*proc)(T_irdata *irdata)));
 
-extern int change_couleur(int couleur, int typographie);
-extern int get_couleur(void);
-
 #endif
 

makefiles/mlang.mk

@@ -48,13 +48,12 @@ dune: FORCE
 ifeq ($(call is_in,),)
 	$(call make_in,,$@)
 else
-	dune build $(DUNE_OPTIONS)
+	LINKING_MODE=$(LINKING_MODE) dune build $(DUNE_OPTIONS)
 endif
 
 build: FORCE | format dune
 
-# Run only in an opam switch with musl and static options activated
-build-static: DUNE_OPTIONS+=--profile=static 
+build-static: LINKING_MODE=static
 build-static: FORCE build
 
 ##################################################

src/dune

@@ -1,13 +1,18 @@
 (env
- (static
-  (ocamlopt_flags
-   (-ccopt -static -O3)))
  (dev
   (flags
    (:standard -warn-error -A))))
 
+(rule
+ (with-stdout-to
+  linking-flags-mlang.sexp
+  (run ./gen-linking-flags.sh %{env:LINKING_MODE=} %{ocaml-config:system})))
+
 (executable
  (name main)
  (package mlang)
  (public_name mlang)
+ (flags
+  (:standard
+   (:include linking-flags-mlang.sexp)))
  (libraries mlang))

src/gen-linking-flags.sh

@@ -0,0 +1,41 @@
+#!/bin/sh
+set -ue
+
+# Copied on https://ocamlpro.com/fr/blog/2021_09_02_generating_static_and_portable_executables_with_ocaml/
+
+LINKING_MODE="$1"
+OS="$2"
+FLAGS=
+CCLIB=
+
+case "$LINKING_MODE" in
+    '')
+        ;; # No extra flags needed
+    static)
+        case "$OS" in
+            linux)
+                FLAGS="-noautolink"
+                CCLIB="-Wl,-Bstatic -lgmp_caml -lmpfr -lgmp -lnums \
+                       -lthreadsnat -lparmap_stubs -lANSITerminal_stubs \
+                       -Wl,-Bdynamic -lpthread -lunix"
+                LIBS=""
+                OCAML_LIBS="camlidl"
+                for lib in $LIBS; do
+                    CCLIB="$CCLIB $(pkg-config $lib --variable libdir)/$lib.a"
+                done
+                for lib in $OCAML_LIBS; do
+                    CCLIB="$CCLIB $(ocamlfind query $lib)/lib$lib.a"
+                done;;
+            *)
+                echo "No known static compilation flags for '$OS'" >&2
+                exit 1
+        esac;;
+    *)
+        echo "Invalid linking mode '$LINKING_MODE'" >&2
+        exit 2
+esac
+
+echo '('
+for f in $FLAGS; do echo "  $f"; done
+for f in $CCLIB; do echo "  -cclib $f"; done
+echo ')'

src/mlang/backend_compilers/bir_to_dgfip_c.ml

@@ -288,8 +288,9 @@ let generate_m_assign (dgfip_flags : Dgfip_options.flags)
       def def_var
       (D.format_assign dgfip_flags var_indexes val_var)
       value val_var;
-  if dgfip_flags.flg_trace then
-    let var = Bir.var_to_mir var in
+  (* If the trace flag is set, we print the value of all non-temp variables *)
+  let var = Bir.var_to_mir var in
+  if dgfip_flags.flg_trace && not var.Mir.Variable.is_temp then
     Format.fprintf oc "@;aff2(\"%s\", irdata, %s);"
       (Pos.unmark var.Mir.Variable.name)
       (Dgfip_varid.gen_access_pos_from_start var_indexes var)
@@ -631,11 +632,13 @@ let generate_target (dgfip_flags : Dgfip_options.flags) (program : Bir.program)
     (var_indexes : Dgfip_varid.var_id_map) (oc : Format.formatter)
     ((f, ret_type) : Bir.function_name * bool) =
   let { tmp_vars; stmts; is_verif; _ } = Mir.TargetMap.find f program.targets in
-  Format.fprintf oc "@[<v 2>%a{@,%a%a%s@]@,}@,"
+  Format.fprintf oc "@[<v 2>%a{@,%a%s@\n%a%s@\n%s@]@,}@,"
     (generate_target_prototype false is_verif)
     f generate_var_tmp_decls tmp_vars
+    (if dgfip_flags.flg_trace then "aff1(\"debut " ^ f ^ "\\n\") ;" else "")
     (generate_stmts dgfip_flags program var_indexes)
     stmts
+    (if dgfip_flags.flg_trace then "aff1(\"fin " ^ f ^ "\\n\") ;" else "")
     (if ret_type then
      {|
 #ifdef FLG_MULTITHREAD

src/mlang/backend_compilers/decoupledExpr.ml

@@ -6,7 +6,7 @@ type offset =
   | None
 
 let rec generate_variable (vm : Dgfip_varid.var_id_map) (offset : offset)
-    ?(def_flag = false) ?(debug_flag = false) (var : Bir.variable) : string =
+    ?(def_flag = false) ?(trace_flag = false) (var : Bir.variable) : string =
   let mvar = Bir.var_to_mir var in
   try
     match offset with
@@ -25,7 +25,9 @@ let rec generate_variable (vm : Dgfip_varid.var_id_map) (offset : offset)
         if def_flag then Dgfip_varid.gen_access_def vm mvar offset
         else
           let access_val = Dgfip_varid.gen_access_val vm mvar offset in
-          if debug_flag then
+          (* When the trace flag is present, we print the value of the
+             non-temporary variable being used *)
+          if trace_flag && not mvar.Mir.Variable.is_temp then
             let vn = Pos.unmark mvar.Mir.Variable.name in
             let pos_tgv = Dgfip_varid.gen_access_pos_from_start vm mvar in
             Format.asprintf "(aff3(\"%s\",irdata, %s), %s)" vn pos_tgv
@@ -429,7 +431,7 @@ let format_expr_var (dgfip_flags : Dgfip_options.flags)
   | M (var, offset, df) ->
       let def_flag = df = Def in
       Format.fprintf fmt "%s"
-        (generate_variable ~debug_flag:dgfip_flags.flg_trace vm offset ~def_flag
+        (generate_variable ~trace_flag:dgfip_flags.flg_trace vm offset ~def_flag
            var)
 
 let rec format_dexpr (dgfip_flags : Dgfip_options.flags)
@@ -488,7 +490,7 @@ let rec format_dexpr (dgfip_flags : Dgfip_options.flags)
   | Daccess (var, dflag, de) ->
       Format.fprintf fmt "(%s[(int)%a])"
         (generate_variable ~def_flag:(dflag = Def)
-           ~debug_flag:dgfip_flags.flg_trace vm PassPointer var)
+           ~trace_flag:dgfip_flags.flg_trace vm PassPointer var)
         format_dexpr de
   | Dite (dec, det, dee) ->
       Format.fprintf fmt "@[<hov 2>(%a ?@ %a@ : %a@])" format_dexpr dec

src/mlang/backend_compilers/decoupledExpr.mli

@@ -9,7 +9,7 @@ val generate_variable :
   Dgfip_varid.var_id_map ->
   offset ->
   ?def_flag:bool ->
-  ?debug_flag:bool ->
+  ?trace_flag:bool ->
   Bir.variable ->
   string