This repository has been archived by the owner on Nov 9, 2020. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 8
/
domain.ml
190 lines (171 loc) · 5.83 KB
/
domain.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
(* **********************************************************
* Copyright 2010 VMware, Inc. All rights reserved.
* **********************************************************)
(*
* Handling of domains and reachability analysis. For scripts that
* span multiple domains, we traverse the AST and annotate functions
* with all domains in which they are used. A function is used in
* domain D if it is called directly or indirectly from a probe which
* fires in domain D.
*)
open Globals
open Defaults
open Ast
open Symtab
open Printf
open Scanf
(*
* domainParts -- Separate letters from optional digits in domains or
* environments.
*)
let domainParts(dom: string): (string * string) =
try sscanf dom "%[A-Z]%[0-9]" (fun dom' num -> (dom', num))
with _ -> (dom, "")
(*
* envToDomain --
* envFromDomain --
* domainMatchesEnv --
*
* Functions to match probe domains and vprobe environments.
* Domains VMM, VMX and GUEST are in the VM environment.
* For VMK and POSIX, domain = environment.
*)
let envToDomain(env: string) : string =
match domainParts env with
| ("VM", n) -> "VMM" ^ n
| ("VMK", "") -> "VMK"
| ("POSIX", "") -> "POSIX"
| _ -> failwith ("Invalid environment: '" ^ env ^ "'")
let envFromDomain(dom: string): string =
match domainParts dom with
| ("VMM", n)
| ("VMX", n)
| ("GUEST", n) -> "VM" ^ n
| ("VMK", "") -> "VMK"
| ("POSIX", "") -> "POSIX"
| _ -> failwith ("Invalid domain: '" ^ dom ^ "'")
let domainMatchesEnv(dom: string)(env: string) : bool =
env = (envFromDomain dom)
(*
* domainInitDefaultDom -- initialize the default domain. If the
* domain specifications consist of a single target, then that
* defines the default domain. Otherwise, the defaultDomain global
* defines it to "VMK" for the ESX compiler or "VMM" for the
* hosted compiler.
*)
let domainInitDefaultDom() : unit =
if List.length tab.targs = 1 then
tab.defdom <- envToDomain(fst(List.hd tab.targs))
else
tab.defdom <- !defaultDomain
(*
* Returns the probe name for the one herz periodic probe.
*)
let domainOneHzProbe(env: string): string =
match domainParts env with
| "VMK", "" -> "VMK:VMK1Hz"
| "VM", n -> "VMM" ^ n ^ ":VMM1Hz"
| _ -> failwith ("No default periodic probe defined for '" ^ env ^"'")
(*
* Returns the builtin variable for (V|P)CPU number.
*)
let domainCPUVar(env: string): string =
match domainParts env with
| "VMK", "" -> "PCPU"
| "VM", n -> "VCPUID"
| _ -> failwith ("No CPU id variable defined for '" ^ env ^"'")
let domainTagVar(id: ident) (dom: string): unit =
let (sc, t) = symtabLookupVar id in
let env = envFromDomain(fst (domainParts dom)) in
let pfx = match t with
| TypeBag _ -> "Bag" | TypeAggr _ -> "Aggr" | _ -> "Variable"
in
match sc, env with
| ClassPerVM, "VMK"
| ClassPerVMK, "VM" ->
failwith (sprintf "%s %s cannot be used in domain %s"
pfx id dom)
| _ -> ()
let rec domainTagExpr(e: expr)(dom: string): unit =
match e with
| ExprIdent id ->
domainTagVar id dom
| ExprAddr(_, e)
| ExprUnary(_, e)
| ExprPointer(e)
| ExprBag(_, e)
| ExprField(_, e, _)
| ExprCast(_, e)
| ExprAssign(_, e)
-> domainTagExpr e dom
| ExprBinary(_, e1, e2)
| ExprArray(e1, e2)
-> domainTagExpr e1 dom;
domainTagExpr e2 dom
| ExprAssignBag(id, e1, e2)
-> domainTagVar id dom;
domainTagExpr e1 dom;
domainTagExpr e2 dom
| ExprCond(e1, e2, e3)
-> domainTagExprList [e1; e2; e3] dom
| ExprCall(id, l)
-> domainTagFunc id dom; domainTagExprList l dom
| ExprAggr(id, l1, l2)
-> domainTagVar id dom;
domainTagExprList l1 dom;
domainTagExprList l2 dom
| ExprAssignAggr(id, l1, l2, e)
-> domainTagVar id dom;
domainTagExprList (e :: l1) dom;
domainTagExprList l2 dom
| ExprComma(l) -> domainTagExprList l dom
| ExprSizeOf _
| ExprStrConst _
| ExprIntConst _ -> ()
and domainTagExprList(l: expr list)(dom: string): unit =
List.iter (fun e -> domainTagExpr e dom) l
and domainTagStat(s: stat) (dom: string) : unit =
match s with
| StatExpr(e)
| StatReturn(e) -> domainTagExpr e dom
| StatBlock(l) -> List.iter (fun s -> domainTagStat s dom) l
| StatIf(e, s) -> domainTagExpr e dom; domainTagStat s dom
| StatIfElse(e, s0, s1)
-> domainTagExpr e dom; domainTagStat s0 dom; domainTagStat s1 dom
| _ -> ()
and domainTagFunc(id: ident) (dom: string): unit =
let fe = symtabGetFunc id in
if not (List.mem dom fe.fdoms) then
(fe.fdoms <- dom :: fe.fdoms;
symtabPushCtx(CtxFunc id);
domainTagStat fe.fbody dom;
symtabPopCtx())
let domainIsValid(dom: string): bool =
(envFromDomain dom) = (envFromDomain tab.defdom) ||
List.exists (fun(env,targ) -> domainMatchesEnv dom env) tab.targs
let domainFromProbename(id: ident): string =
let str = try String.sub id 0 (String.index id ':')
with Not_found -> tab.defdom in
match fst(domainParts str) with
| "VMM" | "VMX" | "GUEST" | "VMK" | "POSIX" -> str
| _ -> tab.defdom (* Covers non-static probes without a domain prefix. *)
let domainTagProbe(id, pentry): unit =
let addEnvSeen env = if not (List.mem env tab.envsseen) then
tab.envsseen <- tab.envsseen @ [env] in
let dom = domainFromProbename (symtabProbeName id) in
pentry.pdom <- dom;
if not (domainIsValid dom) then
failwith ("no target specified for probe " ^
(symtabProbeName id) ^ " in domain " ^ dom);
addEnvSeen (envFromDomain dom);
domainTagStat pentry.pbody dom
(*
* Traverse the AST of each probe and tag all functions that are
* reachable from a probe with the domain of the probe.
*)
let domainPass(): unit =
let ignoreFuncs(id, fe) = () in
ignore(envFromDomain tab.defdom); (* check defdom's validity. *)
if !verbose then
printf "# Splitting (default domain %s)...\n" tab.defdom;
compilerPass ignoreFuncs domainTagProbe