From acb976fa578b2a8bb8d2ba60fdd857f7d5f63e85 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Fri, 7 Jun 2024 09:35:48 +0200
Subject: [PATCH] [region] Ivette memory diagram
---
.../src/frama-c/plugins/region/api/index.ts | 38 ++--
ivette/src/frama-c/plugins/region/memory.tsx | 37 +++-
src/plugins/region/analysis.ml | 4 +-
src/plugins/region/code.ml | 6 +-
src/plugins/region/memory.ml | 190 +++++++++++-------
src/plugins/region/memory.mli | 39 ++--
src/plugins/region/services.ml | 28 +--
src/plugins/region/services.mli | 2 +-
8 files changed, 224 insertions(+), 120 deletions(-)
diff --git a/ivette/src/frama-c/plugins/region/api/index.ts b/ivette/src/frama-c/plugins/region/api/index.ts
index f2264c6eb57..2e05e72283f 100644
--- a/ivette/src/frama-c/plugins/region/api/index.ts
+++ b/ivette/src/frama-c/plugins/region/api/index.ts
@@ -65,38 +65,46 @@ export const byNode: Compare.Order<node> = Compare.number;
/** Default value for `node` */
export const nodeDefault: node = Json.jIndex<'#node'>('#node')(-1);
-export type range = { offset: number, length: number, data: node };
+export type range =
+ { offset: number, length: number, cells: number, data: node };
/** Decoder for `range` */
export const jRange: Json.Decoder<range> =
- Json.jObject({ offset: Json.jNumber, length: Json.jNumber, data: jNode,});
+ Json.jObject({
+ offset: Json.jNumber,
+ length: Json.jNumber,
+ cells: Json.jNumber,
+ data: jNode,
+ });
/** Natural order for `range` */
export const byRange: Compare.Order<range> =
Compare.byFields
- <{ offset: number, length: number, data: node }>({
+ <{ offset: number, length: number, cells: number, data: node }>({
offset: Compare.number,
length: Compare.number,
+ cells: Compare.number,
data: byNode,
});
/** Default value for `range` */
export const rangeDefault: range =
- { offset: 0, length: 0, data: nodeDefault };
+ { offset: 0, length: 0, cells: 0, data: nodeDefault };
export type region =
- { roots: string[], parents: node[], sizeof: number, ranges: range[],
- pointsTo?: node, reads: boolean, writes: boolean, shifts: boolean,
- types: marker[] };
+ { node: node, roots: string[], parents: node[], sizeof: number,
+ ranges: range[], pointed?: node, reads: boolean, writes: boolean,
+ shifts: boolean, types: marker[] };
/** Decoder for `region` */
export const jRegion: Json.Decoder<region> =
Json.jObject({
+ node: jNode,
roots: Json.jArray(Json.jString),
parents: Json.jArray(jNode),
sizeof: Json.jNumber,
ranges: Json.jArray(jRange),
- pointsTo: Json.jOption(jNode),
+ pointed: Json.jOption(jNode),
reads: Json.jBoolean,
writes: Json.jBoolean,
shifts: Json.jBoolean,
@@ -106,14 +114,15 @@ export const jRegion: Json.Decoder<region> =
/** Natural order for `region` */
export const byRegion: Compare.Order<region> =
Compare.byFields
- <{ roots: string[], parents: node[], sizeof: number, ranges: range[],
- pointsTo?: node, reads: boolean, writes: boolean, shifts: boolean,
- types: marker[] }>({
+ <{ node: node, roots: string[], parents: node[], sizeof: number,
+ ranges: range[], pointed?: node, reads: boolean, writes: boolean,
+ shifts: boolean, types: marker[] }>({
+ node: byNode,
roots: Compare.array(Compare.alpha),
parents: Compare.array(byNode),
sizeof: Compare.number,
ranges: Compare.array(byRange),
- pointsTo: Compare.defined(byNode),
+ pointed: Compare.defined(byNode),
reads: Compare.boolean,
writes: Compare.boolean,
shifts: Compare.boolean,
@@ -122,8 +131,9 @@ export const byRegion: Compare.Order<region> =
/** Default value for `region` */
export const regionDefault: region =
- { roots: [], parents: [], sizeof: 0, ranges: [], pointsTo: undefined,
- reads: false, writes: false, shifts: false, types: [] };
+ { node: nodeDefault, roots: [], parents: [], sizeof: 0, ranges: [],
+ pointed: undefined, reads: false, writes: false, shifts: false, types: []
+ };
const compute_internal: Server.ExecRequest<decl,null> = {
kind: Server.RqKind.EXEC,
diff --git a/ivette/src/frama-c/plugins/region/memory.tsx b/ivette/src/frama-c/plugins/region/memory.tsx
index 2a7b1f3fa98..30373baf677 100644
--- a/ivette/src/frama-c/plugins/region/memory.tsx
+++ b/ivette/src/frama-c/plugins/region/memory.tsx
@@ -29,14 +29,49 @@ import * as Dot from 'dome/graph/diagram';
import * as States from 'frama-c/states';
import * as Region from './api';
-function makeDiagram(_regions: Region.region[]) : Dot.DiagramProps {
+function makeDiagram(regions: Region.region[]): Dot.DiagramProps {
const nodes: Dot.Node[] = [];
const edges: Dot.Edge[] = [];
+ regions.forEach(r => {
+ const id = `n${r.node}`;
+ const ht = r.types.length;
+ const color =
+ ht > 1 ? 'red' :
+ r.pointed !== undefined
+ ? (r.writes ? 'orange' : 'yellow')
+ : (r.writes && r.reads) ? 'green' :
+ r.writes ? 'pink' : r.reads ? 'grey' : 'white';
+ const label =
+ (r.reads ? 'R' : '') + (r.writes ? 'W' : '') +
+ (r.pointed !== undefined ? '*' : '');
+ const cells =
+ r.ranges.map((rg, i): Dot.Cell => {
+ const port = `r${i}`;
+ const target = `n${rg.data}`;
+ edges.push({ source: id, sourcePort: port, target });
+ return ({
+ label: `${rg.offset}..${rg.offset + rg.length - 1} [${rg.cells}]`,
+ port,
+ });
+ });
+ const shape = cells.length > 0 ? cells : undefined;
+ nodes.push({ id: id, color, label, shape });
+ r.roots.forEach(x => {
+ const xid = `X${x}`;
+ nodes.push({ id: xid, label: x, shape: 'folder', color: 'blue' });
+ edges.push({ source: xid, target: id });
+ });
+ if (r.pointed !== undefined) {
+ const pid = `n${r.pointed}`;
+ edges.push({ source: id, target: pid, head: 'dot', color: 'orange' });
+ }
+ });
return { nodes, edges };
}
export function MemoryView(): JSX.Element {
const scope = States.useCurrentScope();
+ // eslint-disable-next-line react-hooks/exhaustive-deps
const regions = States.useRequest(Region.regions, scope) ?? [];
const diagram = React.useMemo(() => makeDiagram(regions), [regions]);
return <Dot.Diagram display={regions.length > 0} {...diagram} />;
diff --git a/src/plugins/region/analysis.ml b/src/plugins/region/analysis.ml
index 58d131f5b4f..ae65c3fdca9 100644
--- a/src/plugins/region/analysis.ml
+++ b/src/plugins/region/analysis.ml
@@ -60,9 +60,9 @@ let get kf =
Kernel_function.pretty kf
begin fun fmt ->
Memory.iter domain.map
- begin fun r m ->
+ begin fun r ->
Format.pp_print_newline fmt () ;
- Memory.pp_region fmt r m ;
+ Memory.pp_region fmt r ;
end
end ;
domain
diff --git a/src/plugins/region/code.ml b/src/plugins/region/code.ml
index b2fd6328fb5..c7f3e43ccf4 100644
--- a/src/plugins/region/code.ml
+++ b/src/plugins/region/code.ml
@@ -72,7 +72,7 @@ and exp (m: map) (s:stmt) (e:exp) : node option =
Memory.read m rv (Lval(s,lv)) ;
if Cil.isPointerType @@ Cil.typeOfLval lv then
let rp = cell m () in
- Memory.pointer m rv rp ;
+ Memory.points_to m rv rp ;
Some rp
else
None
@@ -113,7 +113,7 @@ let rec init (m:map) (s:stmt) (acs:Access.acs) (lv:lval) (iv:init) =
| SingleInit e ->
let r = lval m s lv in
Memory.write m r acs ;
- Option.iter (Memory.pointer m r) (exp m s e)
+ Option.iter (Memory.points_to m r) (exp m s e)
| CompoundInit(_,fvs) ->
List.iter
@@ -134,7 +134,7 @@ let instr (m:map) (s:stmt) (instr:instr) =
let r = lval m s lv in
let v = exp m s e in
Memory.write m r (Lval(s,lv)) ;
- Option.iter (Memory.pointer m r) v
+ Option.iter (Memory.points_to m r) v
| Local_init(x,AssignInit iv,_) ->
let acs = Access.Init(s,x) in
diff --git a/src/plugins/region/memory.ml b/src/plugins/region/memory.ml
index ae480509a44..2ac7d0d25ef 100644
--- a/src/plugins/region/memory.ml
+++ b/src/plugins/region/memory.ml
@@ -31,26 +31,26 @@ module Vmap = Varinfo.Map
(* All offsets in bits *)
-type node = region Ufind.rref
+type node = chunk Ufind.rref
and layout =
| Blob
| Cell of int * node option
| Compound of int * node Ranges.t
-and region = {
- parents: node list ;
- roots: varinfo list ;
- reads: Access.Set.t ;
- writes: Access.Set.t ;
- shifts: Access.Set.t ;
- layout: layout ;
+and chunk = {
+ cparents: node list ;
+ croots: varinfo list ;
+ creads: Access.Set.t ;
+ cwrites: Access.Set.t ;
+ cshifts: Access.Set.t ;
+ clayout: layout ;
}
-type range = node Ranges.range
+type rg = node Ranges.range
type map = {
- store: region Ufind.store ;
+ store: chunk Ufind.store ;
mutable index: node Vmap.t ;
}
@@ -59,15 +59,15 @@ type map = {
(* -------------------------------------------------------------------------- *)
let sizeof = function Blob -> 0 | Cell(s,_) | Compound(s,_) -> s
-let points_to = function Blob | Compound _ -> None | Cell(_,p) -> p
let ranges = function Blob | Cell _ -> [] | Compound(_,R rs) -> rs
+let pointed = function Blob | Compound _ -> None | Cell(_,p) -> p
-let types (m : region) : typ list =
+let types (m : chunk) : typ list =
let pool = ref Typ.Set.empty in
let add acs =
pool := Typ.Set.add (Cil.unrollType @@ Access.typeof acs) !pool in
- Access.Set.iter add m.reads ;
- Access.Set.iter add m.writes ;
+ Access.Set.iter add m.creads ;
+ Access.Set.iter add m.cwrites ;
Typ.Set.elements !pool
(* -------------------------------------------------------------------------- *)
@@ -83,29 +83,30 @@ let pp_layout fmt = function
| Compound(s,rg) ->
Format.fprintf fmt "@[<hv 0>{%04d" s ;
Ranges.iteri
- (fun (rg : range) ->
+ (fun (rg : rg) ->
Format.fprintf fmt "@ | %a: %a" Ranges.pp_range rg pp_node rg.data
) rg ;
Format.fprintf fmt "@ }@]"
-let pp_region fmt (n: node) (m: region) =
+let pp_chunk fmt (n: node) (m: chunk) =
begin
let acs r s = if Access.Set.is_empty s then '-' else r in
Format.fprintf fmt "@[<hov 2>%a: %c%c%c" pp_node n
- (acs 'R' m.reads) (acs 'W' m.writes) (acs 'A' m.shifts) ;
+ (acs 'R' m.creads) (acs 'W' m.cwrites) (acs 'A' m.cshifts) ;
List.iter (Format.fprintf fmt "@ (%a)" Typ.pretty) (types m) ;
- List.iter (Format.fprintf fmt "@ %a" Varinfo.pretty) m.roots ;
+ List.iter (Format.fprintf fmt "@ %a" Varinfo.pretty) m.croots ;
if Options.debug_atleast 1 then
begin
- Access.Set.iter (Format.fprintf fmt "@ R:%a" Access.pretty) m.reads ;
- Access.Set.iter (Format.fprintf fmt "@ W:%a" Access.pretty) m.writes ;
- Access.Set.iter (Format.fprintf fmt "@ A:%a" Access.pretty) m.shifts ;
+ Access.Set.iter (Format.fprintf fmt "@ R:%a" Access.pretty) m.creads ;
+ Access.Set.iter (Format.fprintf fmt "@ W:%a" Access.pretty) m.cwrites ;
+ Access.Set.iter (Format.fprintf fmt "@ A:%a" Access.pretty) m.cshifts ;
end ;
- Format.fprintf fmt "@ %a ;@]" pp_layout m.layout ;
+ Format.fprintf fmt "@ %a ;@]" pp_layout m.clayout ;
end
+[@@ warning "-32"]
(* -------------------------------------------------------------------------- *)
-(* --- Constructors --- *)
+(* --- Map Constructors --- *)
(* -------------------------------------------------------------------------- *)
let create () = {
@@ -119,12 +120,12 @@ let copy m = {
}
let empty = {
- parents = [] ;
- roots = [] ;
- reads = Access.Set.empty ;
- writes = Access.Set.empty ;
- shifts = Access.Set.empty ;
- layout = Blob ;
+ cparents = [] ;
+ croots = [] ;
+ creads = Access.Set.empty ;
+ cwrites = Access.Set.empty ;
+ cshifts = Access.Set.empty ;
+ clayout = Blob ;
}
(* -------------------------------------------------------------------------- *)
@@ -145,18 +146,18 @@ let get map node =
with Not_found -> empty
(* -------------------------------------------------------------------------- *)
-(* --- Constructors --- *)
+(* --- Chunk Constructors --- *)
(* -------------------------------------------------------------------------- *)
let cell (m: map) ?size ?ptr ?root () =
- let layout = match size, ptr with
+ let clayout = match size, ptr with
| None, None -> Blob
| None, Some _ -> Cell(Cil.bitsSizeOf Cil.voidPtrType,ptr)
| Some s, _ -> Cell(s,ptr) in
- let roots = match root with None -> [] | Some v -> [v] in
- Ufind.make m.store { empty with layout ; roots }
+ let croots = match root with None -> [] | Some v -> [v] in
+ Ufind.make m.store { empty with clayout ; croots }
-let update (m: map) (n: node) (f: region -> region) =
+let update (m: map) (n: node) (f: chunk -> chunk) =
let r = get m n in
Ufind.set m.store n (f r)
@@ -164,9 +165,9 @@ let range (m: map) ~size ~offset ~length ~data : node =
let last = offset + length in
if not (0 <= offset && offset < last && last <= size) then
raise (Invalid_argument "Region.Memory.range") ;
- let layout = Compound(size, Ranges.singleton { offset ; length ; data }) in
- let n = Ufind.make m.store { empty with layout } in
- update m data (fun r -> { r with parents = nodes m @@ n :: r.parents }) ; n
+ let clayout = Compound(size, Ranges.singleton { offset ; length ; data }) in
+ let n = Ufind.make m.store { empty with clayout } in
+ update m data (fun r -> { r with cparents = nodes m @@ n :: r.cparents }) ; n
let root (m: map) v =
try Vmap.find v m.index with Not_found ->
@@ -177,20 +178,73 @@ let root (m: map) v =
(* --- Iterator --- *)
(* -------------------------------------------------------------------------- *)
-let normalize map r = {
- parents = nodes map r.parents ;
- roots = r.roots ;
- reads = r.reads ;
- writes = r.writes ;
- shifts = r.shifts ;
- layout =
- match r.layout with
- | Blob -> Blob
- | Cell(s,p) -> Cell(s,Option.map (node map) p)
- | Compound(s,rg) -> Compound(s,Ranges.map (node map) rg)
+type range = {
+ offset: int ;
+ length: int ;
+ cells: int ;
+ data: node ;
+}
+
+type region = {
+ node: node ;
+ parents: node list ;
+ roots: varinfo list ;
+ types: typ list ;
+ reads: Access.acs list ;
+ writes: Access.acs list ;
+ shifts: Access.acs list ;
+ sizeof: int ;
+ ranges: range list ;
+ pointed: node option ;
+}
+
+let pp_range fmt (r: range) =
+ Format.fprintf fmt "%d..%d [%d]: %a"
+ r.offset (r.offset + r.length) r.cells pp_node r.data
+
+let pp_region fmt (m: region) =
+ begin
+ let acs r s = if s = [] then '-' else r in
+ Format.fprintf fmt "@[<hov 2>%a: %c%c%c"
+ pp_node m.node
+ (acs 'R' m.reads) (acs 'W' m.writes) (acs 'A' m.shifts) ;
+ List.iter (Format.fprintf fmt "@ (%a)" Typ.pretty) m.types ;
+ List.iter (Format.fprintf fmt "@ %a" Varinfo.pretty) m.roots ;
+ Format.fprintf fmt "@ %db" m.sizeof ;
+ Option.iter (Format.fprintf fmt "@ (*%a)" pp_node) m.pointed ;
+ Format.fprintf fmt "@[<hv 0>]" ;
+ List.iter (Format.fprintf fmt "@ %a" pp_range) m.ranges ;
+ Format.fprintf fmt "@]" ;
+ if Options.debug_atleast 1 then
+ begin
+ List.iter (Format.fprintf fmt "@ R:%a" Access.pretty) m.reads ;
+ List.iter (Format.fprintf fmt "@ W:%a" Access.pretty) m.writes ;
+ List.iter (Format.fprintf fmt "@ A:%a" Access.pretty) m.shifts ;
+ end ;
+ Format.fprintf fmt " ;@]" ;
+ end
+
+let make_range (m: map) (rg: rg) : range = {
+ offset = rg.offset ;
+ length = rg.length ;
+ cells = rg.length / sizeof (get m rg.data).clayout ;
+ data = node m rg.data ;
+}
+
+let make_region (m: map) (n: node) (r: chunk) : region = {
+ node = n ;
+ parents = nodes m r.cparents ;
+ roots = r.croots ;
+ reads = Access.Set.elements r.creads ;
+ writes = Access.Set.elements r.cwrites ;
+ shifts = Access.Set.elements r.cshifts ;
+ types = types r ;
+ sizeof = sizeof r.clayout ;
+ ranges = List.map (make_range m) @@ ranges r.clayout ;
+ pointed = Option.map (node m) (pointed r.clayout) ;
}
-let region map n = normalize map (get map n)
+let region map n = make_region map n (get map n)
let rec walk h m f n =
let n = Ufind.find m.store n in
@@ -198,15 +252,15 @@ let rec walk h m f n =
try Hashtbl.find h id with Not_found ->
Hashtbl.add h id () ;
let r = Ufind.get m.store n in
- f n (normalize m r) ;
- match r.layout with
+ f (make_region m n r) ;
+ match r.clayout with
| Blob -> ()
| Cell(_,p) -> Option.iter (walk h m f) p
| Compound(_,rg) -> Ranges.iter (walk h m f) rg
-let iter (m:map) (f: node -> region -> unit) =
+let iter (m:map) (f: region -> unit) =
let h = Hashtbl.create 0 in
- Vmap.iter (fun _ n -> walk h m f n) m.index
+ Vmap.iter (fun _x n -> walk h m f n) m.index
(* -------------------------------------------------------------------------- *)
(* --- Merge --- *)
@@ -228,15 +282,15 @@ let merge_opt (m: map) (q: queue)
| None, p | p, None -> p
| Some pa, Some pb -> Some (merge_node m q pa pb)
-let merge_range (m: map) (q: queue) (ra : range) (rb : range) : node =
+let merge_range (m: map) (q: queue) (ra : rg) (rb : rg) : node =
let na = ra.data in
let nb = rb.data in
let ma = ra.offset + ra.length in
let mb = rb.offset + rb.length in
let dp = ra.offset - rb.offset in
let dq = ma - mb in
- let sa = sizeof (get m na).layout in
- let sb = sizeof (get m nb).layout in
+ let sa = sizeof (get m na).clayout in
+ let sb = sizeof (get m nb).clayout in
let size = Ranges.(sa %. sb %. dp %. dq) in
let data = merge_node m q na nb in
if size = sa && size = sb then data else
@@ -271,13 +325,13 @@ let merge_layout (m: map) (q: queue) (a : layout) (b : layout) : layout =
let wx = Ranges.range ~length:sx rp in
merge_ranges m q sx wx sr wr
-let merge_region (m: map) (q: queue) (a : region) (b : region) : region = {
- parents = nodes m @@ Store.bag a.parents b.parents ;
- roots = List.sort_uniq Varinfo.compare @@ Store.bag a.roots b.roots ;
- reads = Access.Set.union a.reads b.reads ;
- writes = Access.Set.union a.writes b.writes ;
- shifts = Access.Set.union a.shifts b.shifts ;
- layout = merge_layout m q a.layout b.layout ;
+let merge_region (m: map) (q: queue) (a : chunk) (b : chunk) : chunk = {
+ cparents = nodes m @@ Store.bag a.cparents b.cparents ;
+ croots = List.sort_uniq Varinfo.compare @@ Store.bag a.croots b.croots ;
+ creads = Access.Set.union a.creads b.creads ;
+ cwrites = Access.Set.union a.cwrites b.cwrites ;
+ cshifts = Access.Set.union a.cshifts b.cshifts ;
+ clayout = merge_layout m q a.clayout b.clayout ;
}
let do_merge (m: map) (q: queue) (a: node) (b: node): unit =
@@ -304,26 +358,26 @@ let merge (m: map) (a: node) (b: node) : node =
(* -------------------------------------------------------------------------- *)
let access (m:map) (a:node) (ty: typ) =
- let sr = sizeof (get m a).layout in
+ let sr = sizeof (get m a).clayout in
let size = Ranges.gcd sr (Cil.bitsSizeOf ty) in
if sr <> size then ignore (merge m a (cell m ~size ()))
-let pointer (m: map) (a: node) (b : node) =
+let points_to (m: map) (a: node) (b : node) =
ignore @@ merge m a @@ cell m ~ptr:b ()
let read (m: map) (a: node) from =
let r = get m a in
- Ufind.set m.store a { r with reads = Access.Set.add from r.reads } ;
+ Ufind.set m.store a { r with creads = Access.Set.add from r.creads } ;
access m a (Access.typeof from)
let write (m: map) (a: node) from =
let r = get m a in
- Ufind.set m.store a { r with writes = Access.Set.add from r.writes } ;
+ Ufind.set m.store a { r with cwrites = Access.Set.add from r.cwrites } ;
access m a (Access.typeof from)
let shift (m: map) (a: node) from =
let r = get m a in
- Ufind.set m.store a { r with shifts = Access.Set.add from r.shifts }
+ Ufind.set m.store a { r with cshifts = Access.Set.add from r.cshifts }
(* no access *)
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/region/memory.mli b/src/plugins/region/memory.mli
index f3a03a5417c..f1a3bc95e8c 100644
--- a/src/plugins/region/memory.mli
+++ b/src/plugins/region/memory.mli
@@ -24,30 +24,31 @@ open Cil_types
type node
-and layout =
- | Blob
- | Cell of int * node option
- | Compound of int * node Ranges.t
+type range = {
+ offset: int ;
+ length: int ;
+ cells: int ;
+ data: node ;
+}
-type region = private {
+type region = {
+ node: node ;
parents: node list ;
roots: varinfo list ;
- reads: Access.Set.t ;
- writes: Access.Set.t ;
- shifts: Access.Set.t ;
- layout: layout ;
+ types: typ list ;
+ reads: Access.acs list ;
+ writes: Access.acs list ;
+ shifts: Access.acs list ;
+ sizeof: int ;
+ ranges: range list ;
+ pointed: node option ;
}
-val sizeof : layout -> int
-val points_to : layout -> node option
-val ranges : layout -> node Ranges.range list
-val types : region -> typ list
+type map
val pp_node : Format.formatter -> node -> unit
-val pp_layout : Format.formatter -> layout -> unit
-val pp_region : Format.formatter -> node -> region -> unit
-
-type map
+val pp_range : Format.formatter -> range -> unit
+val pp_region : Format.formatter -> region -> unit
val create : unit -> map
val copy : map -> map
@@ -61,10 +62,10 @@ val forge : int -> node
val node : map -> node -> node
val nodes : map -> node list -> node list
val region : map -> node -> region
-val iter : map -> (node -> region -> unit) -> unit
+val iter : map -> (region -> unit) -> unit
val merge : map -> node -> node -> node
val read : map -> node -> Access.acs -> unit
val write : map -> node -> Access.acs -> unit
val shift : map -> node -> Access.acs -> unit
-val pointer : map -> node -> node -> unit
+val points_to : map -> node -> node -> unit
diff --git a/src/plugins/region/services.ml b/src/plugins/region/services.ml
index b14918e442d..afc4a530676 100644
--- a/src/plugins/region/services.ml
+++ b/src/plugins/region/services.ml
@@ -41,19 +41,21 @@ end
module NodeOpt = Data.Joption(Node)
module NodeList = Data.Jlist(Node)
-module Range : Data.S with type t = Memory.node Ranges.range =
+module Range : Data.S with type t = Memory.range =
struct
- type t = Memory.node Ranges.range
+ type t = Memory.range
let jtype = Data.declare ~package ~name:"range" @@
Jrecord [
"offset", Jnumber ;
"length", Jnumber ;
+ "cells", Jnumber ;
"data", Node.jtype ;
]
- let to_json (rg : Memory.node Ranges.range) =
+ let to_json (rg : Memory.range) =
Json.of_fields [
"offset", Json.of_int rg.offset ;
"length", Json.of_int rg.length ;
+ "cells", Json.of_int rg.cells ;
"data", Node.to_json rg.data ;
]
let of_json _ = failwith "Region.Range.of_json"
@@ -66,11 +68,12 @@ struct
type t = Memory.region
let jtype = Data.declare ~package ~name:"region" @@
Jrecord [
+ "node", Node.jtype ;
"roots", Jarray Jalpha ;
"parents", NodeList.jtype ;
"sizeof", Jnumber ;
"ranges", Ranges.jtype ;
- "pointsTo", NodeOpt.jtype ;
+ "pointed", NodeOpt.jtype ;
"reads", Jboolean ;
"writes", Jboolean ;
"shifts", Jboolean ;
@@ -86,15 +89,16 @@ struct
let to_json (m: Memory.region) =
Json.of_fields [
+ "node", Node.to_json m.node ;
"roots", roots_to_json m.roots ;
"parents", NodeList.to_json m.parents ;
- "sizeof", Json.of_int @@ Memory.sizeof m.layout ;
- "ranges", Ranges.to_json @@ Memory.ranges m.layout ;
- "pointsTo", NodeOpt.to_json @@ Memory.points_to m.layout ;
- "reads", Json.of_bool @@ not @@ Access.Set.is_empty m.reads ;
- "writes", Json.of_bool @@ not @@ Access.Set.is_empty m.writes ;
- "shifts", Json.of_bool @@ not @@ Access.Set.is_empty m.shifts ;
- "types", Json.of_list @@ List.map typ_to_json @@ Memory.types m ;
+ "sizeof", Json.of_int @@ m.sizeof ;
+ "ranges", Ranges.to_json @@ m.ranges ;
+ "pointed", NodeOpt.to_json @@ m.pointed ;
+ "reads", Json.of_bool (m.reads <> []) ;
+ "writes", Json.of_bool (m.writes <> []) ;
+ "shifts", Json.of_bool (m.shifts <> []) ;
+ "types", Json.of_list @@ List.map typ_to_json @@ m.types ;
]
let of_json _ = failwith "Region.Layout.of_json"
end
@@ -107,7 +111,7 @@ module Regions = Data.Jlist(Region)
let regions map =
let pool = ref [] in
- Memory.iter map (fun _ r -> pool := r :: !pool) ;
+ Memory.iter map (fun r -> pool := r :: !pool) ;
List.rev !pool
let map_of_localizable (loc : Printer_tag.localizable) =
diff --git a/src/plugins/region/services.mli b/src/plugins/region/services.mli
index 1e8c1893803..d694a69647e 100644
--- a/src/plugins/region/services.mli
+++ b/src/plugins/region/services.mli
@@ -26,7 +26,7 @@ open Request
val package : Package.package
module Node : Data.S with type t = Memory.node
-module Range : Output with type t = Memory.node Ranges.range
+module Range : Output with type t = Memory.range
module Region : Output with type t = Memory.region
(** @raises Not_found *)
--
GitLab