Patch title: Release 85 bulk changes
Abstract:
File: /pliant/linux/kernel/statistics.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/schedule/daemon.pli"


constant device "eth0"
constant resolution 5 # in reconds
constant debug true


type NetStatRecord
  field DateTime timestamp
  field Intn in out
  field (Dictionary Str Intn) in out
  field Intn cpu


gvar Sem sem
gvar DateTime last_timestamp
gvar uInt in_mark out_mark
gvar Intn in_total out_total cpu_total
gvar (Dictionary Str uInt) in_mark out_mark
gvar (Dictionary Str Intn) in_total out_total ; gvar Intn cpu_total
gvar List:NetStatRecord stat


function pick_net_marks in_mark out_mark
  arg_w uInt in_mark out_mark
  arg_w (Dictionary Str uInt) in_mark out_mark
  in_mark := var (Dictionary Str uInt) empty_dictionary ; out_mark := var (Dictionary Str uInt) empty_dictionary
  (var Stream proc) open "file:/proc/net/dev" in+safe
  while not proc:atend
    if (proc:readline parse pattern:device ":" (var uInt r_bytes) (var uInt r_packets) (var uInt r_err) (var uInt r_drop) (var uInt r_fifo) (var uInt r_frame) (var uInt r_compressed) (var uInt r_multicast) (var uInt t_bytes) (var uInt t_packets) (var uInt t_err) (var uInt t_drop) (var uInt t_fifo) (var uInt t_colls) (var uInt t_carrier) (var uInt t_compressed))
      in_mark := r_bytes ; out_mark := t_bytes
      return
  in_mark := 0 ; out_mark := 0
    if (proc:readline parse any:(var Str device) ":" (var uInt r_bytes) (var uInt r_packets) (var uInt r_err) (var uInt r_drop) (var uInt r_fifo) (var uInt r_frame) (var uInt r_compressed) (var uInt r_multicast) (var uInt t_bytes) (var uInt t_packets) (var uInt t_err) (var uInt t_drop) (var uInt t_fifo) (var uInt t_colls) (var uInt t_carrier) (var uInt t_compressed))
      in_mark insert device r_bytes ; out_mark insert device t_bytes

function pick_cpu_load load
  arg_w Float load
  (var Stream proc) open "file:/proc/loadavg" in+safe
  if (proc:readline parse (var Float l1) (var Float l2) (var Float l3) any)
    load := l1
  else
    load := 0

function add_stat_record
  pick_net_marks (var uInt in) (var uInt out)
  in_total += in .-. in_mark ; in_mark := in
  out_total += out .-. out_mark ; out_mark := out
  pick_net_marks (var (Dictionary Str uInt) in) (var (Dictionary Str uInt) out)
  each m in
    var Str d := in key m
    in_total d 0 += m .-. (in_mark d 0)
    in_mark d := m
  each m out
    var Str d := out key m
    out_total d 0 += m .-. (out_mark d 0)
    out_mark d := m
  pick_cpu_load (var Float load)
  var DateTime now := datetime
  var Int sec := cast now:seconds-last_timestamp:seconds Int
  cpu_total += cast sec*load*1000 Int
  last_timestamp := now
  var Link:NetStatRecord r :> new NetStatRecord
  r timestamp := now
  r in := in_total ; r out := out_total ; r cpu := cpu_total
  sem request
  stat += r
  sem release


function filter_stat_records
  var DateTime now := datetime  
  sem request
  var Float mini := resolution
  var Pointer:NetStatRecord r :> stat last
  while { var Pointer:NetStatRecord r2 :> stat previous r ; exists:r2 }
    if now:seconds-r2:timestamp:seconds<mini
      stat remove r
    else
      mini := 1.25*mini
    r :> r2
  sem release
 

function gather_statistics
  daemon "gather Linux kernel statistics"
    pick_net_marks in_mark out_mark
    in_total := 0 ; out_total := 0 ; cpu_total := 0
    in_total := var (Dictionary Str Intn) empty_dict ; out_total := var (Dictionary Str Intn) empty_dict ; cpu_total := 0
    last_timestamp := datetime
    stat := var List:NetStatRecord empty_list
    add_stat_record
    var Int lap := 0
    while not daemon_emergency
      daemon_sleep resolution
      add_stat_record
      lap += 1
      if lap%6=0
        filter_stat_records
gather_statistics

function net_statistics seconds in_bps out_bps
  arg Float seconds ; arg_w Float in_bps out_bps

function net_devices -> devices
  arg List:Str devices
  devices := var List:Str empty_list
  each c in_total
    devices += in_total key c

function net_statistics device seconds in_bps out_bps
  arg Str device ; arg Float seconds ; arg_w Float in_bps out_bps
  sem rd_request
  var Pointer:NetStatRecord last :> stat last
  var Pointer:NetStatRecord r :> last
  while last:timestamp:seconds-r:timestamp:seconds<seconds and exists:(stat previous r)
    r :> stat previous r
  var Float sec := last:timestamp:seconds-r:timestamp:seconds
  if sec<1
    sec := 1
  in_bps := (cast last:in-r:in Float)*8/sec
  out_bps := (cast last:out-r:out Float)*8/sec
  if device<>""
    in_bps := (cast (last:in first device 0)-(r:in first device 0) Float)*8/sec
    out_bps := (cast (last:out first device 0)-(r:out first device 0) Float)*8/sec
  else
    in_bps := 0
    each c last:in
      var Str d := last:in key c
      in_bps += (cast (last:in first d 0)-(r:in first d 0) Float)*8/sec
    out_bps := 0
    each c last:out
      var Str d := last:out key c
      out_bps += (cast (last:out first d 0)-(r:out first d 0) Float)*8/sec
  sem rd_release


function cpu_statistics seconds -> load
  arg Float seconds ; arg Float load
  sem rd_request
  var Pointer:NetStatRecord last :> stat last
  var Pointer:NetStatRecord r :> last
  while last:timestamp:seconds-r:timestamp:seconds<seconds and exists:(stat previous r)
    r :> stat previous r
  var Float sec := last:timestamp:seconds-r:timestamp:seconds
  if sec<1
    sec := 1
  load := (cast last:cpu-r:cpu Float)/1000/sec
  sem rd_release
  

export net_statistics cpu_statistics


if debug
  
  function debug_statistics
    var Pointer:NetStatRecord r :> stat last
    while exists:r
      console r:timestamp " " r:in " " r:out " " r:cpu eol
      r :> stat previous r
  
  export debug_statistics
export net_devices net_statistics cpu_statistics