Merge branch 'debugscopes' into debug_locations

Conflicts:
	cparser/Unblock.ml

1 files changed, 37 insertions, 33 deletions

diff --git a/cparser/Unblock.ml b/cparser/Unblock.ml
index 4f5056bb..ad4b5497 100644
--- a/cparser/Unblock.ml
+++ b/cparser/Unblock.ml
@@ -199,35 +199,39 @@ let integer_const n =
   intconst (Int64.of_int n) IInt
 
 (* Line number annotation:
-      __builtin_debug(1, "#line:filename:lineno", scope1, ..., scopeN) *)
+      __builtin_debug(1, "#line:filename:lineno") *)
 (* TODO: consider
-      __builtin_debug(1, "filename", lineno, scope1, ..., scopeN)
+      __builtin_debug(1, "filename", lineno)
    instead. *)
 
-let debug_lineno ctx (filename, lineno) =
+let debug_lineno (filename, lineno) =
   debug_annot 1L
-    (string_const (Printf.sprintf "#line:%s:%d" filename lineno) ::
-     List.rev_map integer_const ctx)
+    [string_const (Printf.sprintf "#line:%s:%d" filename lineno)]
 
-let add_lineno ctx prev_loc this_loc s =
-  if !Clflags.option_g && this_loc <> prev_loc && this_loc <> no_loc
-  then sseq no_loc (debug_lineno ctx this_loc) s
-  else s
+(* Scope annotation:
+      __builtin_debug(6, "", scope1, scope2, ..., scopeN)
+*)
 
-(* Variable declaration annotation:
-      __builtin_debug(6, var, scope)  *)
+let empty_string = string_const ""
 
 let curr_fun_id = ref 0
 
-let debug_var_decl ctx id ty =
-  let scope = match ctx with [] -> 0 | sc :: _ -> sc in
-  Debug.add_lvar_scope !curr_fun_id id scope;
-  debug_annot 6L
-    [ {edesc = EVar id; etyp = ty}; integer_const scope ]
+let debug_var_decl ctx id =
+  Debug.add_lvar_scope !curr_fun_id id (List.hd ctx)
+
+let debug_scope ctx =
+  debug_annot 6L (empty_string :: List.rev_map integer_const ctx)
+
+(* Add line number debug annotation if the line number changes.
+   Add scope debug annotation regardless. *)
 
-let add_var_decl ctx id ty s =
-  if !Clflags.option_g
-  then sseq no_loc (debug_var_decl ctx id ty) s
+
+let add_lineno ctx prev_loc this_loc s =
+  if !Clflags.option_g then
+    sseq no_loc (debug_scope ctx)
+      (if this_loc <> prev_loc && this_loc <> no_loc
+       then sseq no_loc (debug_lineno this_loc) s
+       else s)
   else s
 
 (* Generate fresh scope identifiers, for blocks that contain at least
@@ -251,14 +255,14 @@ let new_scope_id () =
 let process_decl loc env ctx (sto, id, ty, optinit) k =
   let ty' = remove_const env ty in
   local_variables := (sto, id, ty', None) :: !local_variables;
-  add_var_decl ctx id ty
-   (match optinit with
-    | None ->
-        k
-    | Some init ->
-        let init' = expand_init true env init in
-        let l = local_initializer env { edesc = EVar id; etyp = ty' } init' [] in
-        add_inits_stmt loc l k)
+  (* TODO: register the fact that id is declared in scope ctx *)
+  match optinit with
+  | None ->
+      k
+  | Some init ->
+      let init' = expand_init true env init in
+      let l = local_initializer env { edesc = EVar id; etyp = ty' } init' [] in
+      add_inits_stmt loc l k
 
 (* Simplification of blocks within a statement *)
 
@@ -311,7 +315,9 @@ let rec unblock_stmt env ctx ploc s =
         if block_contains_decl sl
         then
           let id = new_scope_id () in
-          Debug.enter_scope !curr_fun_id (List.hd ctx) id;
+          (match ctx with
+          | [] -> Debug.enter_function_scope !curr_fun_id id
+          | a::_ -> Debug.enter_scope !curr_fun_id a id);
           id:: ctx
         else ctx in
       unblock_block env ctx' ploc sl
@@ -341,11 +347,9 @@ and unblock_block env ctx ploc = function
 let unblock_fundef env f =
   local_variables := [];
   next_scope_id := 0;
-  curr_fun_id := f.fd_name.stamp;
-  let id = new_scope_id () in
-  Debug.enter_function_scope f.fd_name id;
-  let body =
-    (unblock_stmt env [id] no_loc f.fd_body) in
+  curr_fun_id:= f.fd_name.stamp;
+  (* TODO: register the parameters as being declared in function scope *)
+  let body = unblock_stmt env [] no_loc f.fd_body in
   let decls = !local_variables in
   local_variables := [];
   { f with fd_locals = f.fd_locals @ decls; fd_body = body }