Setup simulator

dsl/frontend/ast.ml

@@ -7,7 +7,7 @@ type policy =
   | Fifo of policy list
   | RoundRobin of policy list
   | Strict of policy list
-  | WeightedFair of (policy * int) list
+  | WeightedFair of (policy * float) list
   | EarliestDeadline of policy list
   | ShortestJobNext of policy list
   | ShortestRemaining of policy list

dsl/frontend/lexer.mll

@@ -3,8 +3,8 @@
 }
 
 let whitespace = [' ' '\t']+
-let digit = ['0'-'9']
-let int = '-'? digit+
+let int = '-'? ['0'-'9']+
+let float = '-'? (['0'-'9']* '.')? ['0'-'9']+
 let id = ['a'-'z'] ['a'-'z' '0'-'9' '_']*
 let bigid = ['A'-'Z']*
 let comment = ['/' '/'] ['\x00' - '\x09']* ['\x0b' - '\x80']*
@@ -40,6 +40,7 @@ rule token = parse
 | id as v               { VAR(v) }
 | bigid as i            { CLSS(i) }
 | int                   { INT (int_of_string (Lexing.lexeme lexbuf)) }
+| float                 { FLOAT (float_of_string (Lexing.lexeme lexbuf)) }
 | eof                   { EOF }
 
 

dsl/frontend/parser.mly

@@ -34,6 +34,7 @@
 
 %token <string> VAR
 %token <string> CLSS
+%token <float> FLOAT
 %token <int> INT
 %token EQUALS
 %token LBRACKET
@@ -98,7 +99,7 @@ arglist:
 weighted_arglist:
     | pl = separated_list(COMMA, weighted_arg)      { pl }
 weighted_arg:
-    | LPAREN; arg = separated_pair(policy, COMMA, INT); RPAREN      { arg }
+    | LPAREN; arg = separated_pair(policy, COMMA, FLOAT); RPAREN      { arg }
 
 /* Declarations, assignments and returns */
 internalcomp :

dsl/frontend/policy.ml

@@ -4,7 +4,7 @@ type t =
   | Fifo of t list
   | RoundRobin of t list
   | Strict of t list
-  | WeightedFair of (t * int) list
+  | WeightedFair of (t * float) list
 (*
    | EarliestDeadline of t list
    | ShortestJobNext of t list
@@ -63,7 +63,7 @@ let rec to_string p =
   let join_weighted lst =
     sprintf "[%s]"
       (lst
-      |> List.map (fun (x, y) -> sprintf "(%s, %d)" (to_string x) y)
+      |> List.map (fun (x, y) -> sprintf "(%s, %.2f)" (to_string x) y)
       |> String.concat ", ")
   in
 
@@ -72,7 +72,7 @@ let rec to_string p =
   | Fifo lst -> sprintf "fifo%s" (join lst)
   | RoundRobin lst -> sprintf "rr%s" (join lst)
   | Strict lst -> sprintf "strict%s" (join lst)
-  | WeightedFair lst -> sprintf "strict%s" (join_weighted lst)
+  | WeightedFair lst -> sprintf "wfq%s" (join_weighted lst)
 (*
   | EarliestDeadline lst -> sprintf "edf%s" (join lst)
   | ShortestJobNext lst -> sprintf "sjn%s" (join lst)

dsl/frontend/policy.mli

@@ -4,7 +4,7 @@ type t =
   | Fifo of t list
   | RoundRobin of t list
   | Strict of t list
-  | WeightedFair of (t * int) list
+  | WeightedFair of (t * float) list
 (*
   | EarliestDeadline of t list
   | ShortestJobNext of t list

dsl/simulate/control.ml → dsl/simulation/control.ml

@@ -37,9 +37,7 @@ let init_state p =
         |> State.rebind_all ranks |> join plst addr
     | WeightedFair wplst ->
         let weights =
-          List.mapi
-            (fun i (_, w) -> (sprintf "%s_w_%d" prefix i, float_of_int w))
-            wplst
+          List.mapi (fun i (_, w) -> (sprintf "%s_w_%d" prefix i, w)) wplst
         in
         s |> State.rebind_all weights |> join (List.map fst wplst) addr
     | Fifo plst | Strict plst -> join plst addr s
@@ -122,7 +120,11 @@ let z_out p s pkt =
           who_skip_aux turn []
         in
         let turn = State.lookup (sprintf "%s_turn" prefix) s in
-        let s' = State.rebind "turn" ((h + 1) mod n |> float_of_int) s in
+        let s' =
+          State.rebind (sprintf "%s_turn" prefix)
+            ((h + 1) mod n |> float_of_int)
+            s
+        in
         let skipped = who_skip h (int_of_float turn) in
         let f s i =
           let r_i = sprintf "%s_r_%d" prefix i in

dsl/simulation/dune

@@ -0,0 +1,6 @@
+(library
+ (name Simulation)
+ (public_name dsl.simulation)
+ (libraries dsl.frontend core_kernel.fheap pcap-format hex csv mmap)
+ (preprocess
+  (pps ppx_cstruct)))

dsl/simulation/ethernet.ml

@@ -0,0 +1,9 @@
+(* Ethernet Cstruct for preprocessor to work on. *)
+
+[%%cstruct
+type ethernet = {
+  dst : uint8_t; [@len 6]
+  src : uint8_t; [@len 6]
+  ethertype : uint16_t;
+}
+[@@big_endian]]

dsl/simulation/packet.ml

@@ -0,0 +1,140 @@
+open Pcap
+open Ethernet
+
+type packet_header_t = { time : Time.t; size_incl : int32 }
+type ethernet_t = { dst : int; src : int }
+
+type packet_complete = {
+  (* This is the type for all the information we get'll get
+     about an individual packet from the PCAP. *)
+  header : packet_header_t;
+  payload : ethernet_t;
+}
+
+type t = {
+  (* We will mostly pass around this lighter-weight metadata. *)
+  len : int;
+  dst : int;
+  time : Time.t;
+  flow : string;
+  pushed : Time.t option;
+  popped : Time.t option;
+}
+
+(* It is occasionally useful to read/write fields in the metadata. *)
+let time t = t.time
+let flow t = t.flow
+
+let len t =
+  (* The only user of this immediately converts it into a float, so we just do it here. *)
+  float_of_int t.len
+
+(* It will become useful to modify these timing fields as the packet enters and leaves
+   the scheduler. This is just for the purposes of our visualization. *)
+let punch_in t time = { t with pushed = Some time }
+let punch_out t time = { t with popped = Some time }
+
+let mac_addr_to_flow s : Frontend.Ast.clss =
+  match s with
+  | "10:10:10:10:10:10" -> "A"
+  | "20:20:20:20:20:20" -> "B"
+  | "30:30:30:30:30:30" -> "C"
+  | "40:40:40:40:40:40" -> "D"
+  | "50:50:50:50:50:50" -> "E"
+  | "60:60:60:60:60:60" -> "F"
+  | "70:70:70:70:70:70" -> "G"
+  | n -> failwith Printf.(sprintf "Unknown MAC address: %s." n)
+
+let find_flow x =
+  let hex = Printf.sprintf "%x" x in
+  let n = String.length hex in
+  let buf = Buffer.create ((3 * (n / 2)) - 1) in
+  let f i c =
+    Buffer.add_char buf c;
+    if i mod 2 = 1 && i < n - 1 then Buffer.add_char buf ':' else ()
+  in
+  String.iteri f hex;
+  Buffer.contents buf |> mac_addr_to_flow
+
+let complete_to_meta (p : packet_complete) =
+  (* This is how we'll discard unnecessary packet information and keep just the metadata. *)
+  {
+    time = p.header.time;
+    len = Int32.to_int p.header.size_incl;
+    flow = p.payload.src |> find_flow;
+    dst = p.payload.dst;
+    pushed = None;
+    popped = None;
+  }
+
+let create_pkt h (ph, pb) =
+  (* ph is the packet header; pb is the packet body. *)
+  let module H = (val h : HDR) in
+  let hex_to_int = function `Hex s -> int_of_string ("0x" ^ s) in
+  let header =
+    {
+      time =
+        Time.of_ints
+          (H.get_pcap_packet_ts_sec ph)
+          (H.get_pcap_packet_ts_usec ph);
+      size_incl = H.get_pcap_packet_incl_len ph;
+    }
+  in
+  let payload =
+    {
+      src = hex_to_int (Hex.of_string (copy_ethernet_src pb));
+      dst = hex_to_int (Hex.of_string (copy_ethernet_dst pb));
+    }
+  in
+  (* For debugging etc, it is useful to compute the "complete" version and
+     then discard some information to get the metadata we are interested in.
+  *)
+  complete_to_meta { header; payload }
+
+let create_pcap_packets h body : t list =
+  List.rev (Cstruct.fold (fun l p -> create_pkt h p :: l) (packets h body) [])
+
+let pkts_from_file filename =
+  let open_file filename =
+    let fd = Unix.(openfile filename [ O_RDONLY ] 0) in
+    let ba =
+      Bigarray.(
+        array1_of_genarray
+          (Mmap.V1.map_file fd Bigarray.char c_layout false [| -1 |]))
+    in
+    Unix.close fd;
+    Cstruct.of_bigarray ba
+  in
+  let read_header filename =
+    let buf = open_file filename in
+    match Pcap.detect buf with
+    | Some h -> (h, buf)
+    | None ->
+        failwith (Printf.sprintf "can't parse pcap header from %s" filename)
+  in
+  let h, buf = read_header filename in
+  let _, body = Cstruct.split buf sizeof_pcap_header in
+  create_pcap_packets h body
+
+let write_to_csv ts filename =
+  (* This is the CSV format that out plot.py method expects downstream. *)
+  let format_to_csv metas =
+    let headers =
+      "\"flow\", \"dst\", \"arrived\", \"length\", \"pushed\", \"popped\""
+    in
+    let format_one_to_csv meta =
+      let pushed, popped =
+        match (meta.pushed, meta.popped) with
+        | Some pushed', Some popped' ->
+            (Time.to_float pushed', Time.to_float popped')
+        | _, _ -> (0.0, 0.0)
+      in
+      Printf.sprintf "\"%s\",\"%d\",\"%f\",\"%d\",\"%f\",\"%f\"" meta.flow
+        meta.dst (Time.to_float meta.time) meta.len pushed popped
+    in
+    Printf.sprintf "%s\n%s" headers
+      (String.concat "\n" (List.map format_one_to_csv metas))
+  in
+  let payload = format_to_csv ts in
+  let ecsv = Csv.input_all (Csv.of_string payload) in
+  Csv.save filename ecsv

dsl/simulation/packet.mli

@@ -0,0 +1,9 @@
+type t
+
+val len : t -> float
+val time : t -> Time.t
+val flow : t -> Frontend.Ast.clss
+val punch_in : t -> Time.t -> t
+val punch_out : t -> Time.t -> t
+val pkts_from_file : string -> t list
+val write_to_csv : t list -> string -> unit

dsl/simulate/path.ml → dsl/simulation/path.ml

@@ -9,11 +9,3 @@ type t = (int * Rank.t) list
 *)
 
 let foot = -1
-
-let rec to_string = function
-  | [] -> "\n"
-  | [ (_, r) ] ->
-      (* The integer at the foot of the path is bogus, so we drop it. *)
-      Printf.sprintf "_ @ %s" (Rank.to_string false r)
-  | (i, r) :: t ->
-      Printf.sprintf "%d @ %s\t %s" i (Rank.to_string false r) (to_string t)

dsl/simulate/path.mli → dsl/simulation/path.mli

@@ -1,4 +1,3 @@
 type t = (int * Rank.t) list
 
 val foot : int
-val to_string : t -> string

dsl/simulation/rank.ml

@@ -0,0 +1,7 @@
+type t = float * Time.t
+
+let cmp (r1, t1) (r2, t2) =
+  if r1 == r2 then Time.cmp t1 t2 else if r1 -. r2 < 0. then -1 else 1
+
+let create f t = (f, t)
+let create_for_pkt f pkt = (f, Packet.time pkt)

dsl/simulate/rank.mli → dsl/simulation/rank.mli

@@ -3,5 +3,3 @@ type t
 val cmp : t -> t -> int
 val create : float -> Time.t -> t
 val create_for_pkt : float -> Packet.t -> t
-val time : t -> Time.t
-val to_string : bool -> t -> string