basis/unix/linux/proc/proc.factor

   1 ! Copyright (C) 2013 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators combinators.smart
   4 io.encodings.utf8 io.files kernel math math.order math.parser
   5 memoize sequences sorting.slots splitting splitting.monotonic
   6 strings io.pathnames calendar words ;
   7 IN: unix.linux.proc
   8
   9 ! /proc/*
  10
  11 ! /proc/buddyinfo
  12 ! /proc/cgroups
  13
  14 TUPLE: proc-cmdline string ;
  15 C: <proc-cmdline> proc-cmdline
  16 : parse-proc-cmdline ( -- obj )
  17     "/proc/cmdline" utf8 file-lines first <proc-cmdline> ;
  18
  19
  20 TUPLE: processor-info
  21     { processor integer }
  22     { vendor-id string }
  23     { cpu-family integer }
  24     { model integer }
  25     { model-name string }
  26     { stepping integer }
  27     { microcode integer }
  28     { cpu-mhz number }
  29     { cache-size integer }
  30     { fdiv-bug? boolean }
  31     { hlt-bug? boolean }
  32     { f00f-bug? boolean }
  33     { coma-bug? boolean }
  34     { physical-id integer }
  35     { siblings integer }
  36     { core-id integer }
  37     { cpu-cores integer }
  38     { apicid integer }
  39     { initial-apicid integer }
  40     { fpu? boolean }
  41     { fpu-exception? boolean }
  42     { cpuid-level integer }
  43     { wp? boolean }
  44     { flags array }
  45     { bogomips number }
  46     { clflush-size integer }
  47     { cache-alignment integer }
  48     { address-sizes array }
  49     { power-management string }
  50     { tlb-size string } ;
  51
  52
  53 ERROR: unknown-cpuinfo-line string ;
  54
  55 : line>processor-info ( processor-info string -- processor-info )
  56     ":" split first2 swap
  57     [ CHAR: \t = ] trim-tail [ [ CHAR: \s = ] trim ] bi@
  58     {
  59         { "address sizes" [
  60             "," split [ [ CHAR: \s = ] trim " " split first string>number ] map
  61             >>address-sizes
  62         ] }
  63         { "apicid" [ string>number >>apicid ] }
  64         { "bogomips" [ string>number >>bogomips ] }
  65         { "cache size" [
  66             " " split first [ CHAR: \s = ] trim
  67             string>number 1024 * >>cache-size
  68         ] }
  69         { "cache_alignment" [ string>number >>cache-alignment ] }
  70         { "clflush size" [ string>number >>clflush-size ] }
  71         { "coma_bug" [ "yes" = >>coma-bug? ] }
  72         { "core id" [ string>number >>core-id ] }
  73         { "cpu MHz" [ string>number >>cpu-mhz ] }
  74         { "cpu cores" [ string>number >>cpu-cores ] }
  75         { "cpu family" [ string>number >>cpu-family ] }
  76         { "cpuid level" [ string>number >>cpuid-level ] }
  77         { "f00f_bug" [ "yes" = >>f00f-bug? ] }
  78         { "fdiv_bug" [ "yes" = >>fdiv-bug? ] }
  79         { "flags" [ " " split harvest >>flags ] }
  80         { "fpu" [ "yes" = >>fpu? ] }
  81         { "fpu_exception" [ "yes" = >>fpu-exception? ] }
  82         { "hlt_bug" [ "yes" = >>hlt-bug? ] }
  83         { "initial apicid" [ string>number >>initial-apicid ] }
  84         { "microcode" [ string>number >>microcode ] }
  85         { "model" [ string>number >>model ] }
  86         { "model name" [ >>model-name ] }
  87         { "physical id" [ string>number >>physical-id ] }
  88         { "power management" [ >>power-management ] }
  89         { "processor" [ string>number >>processor ] }
  90         { "siblings" [ string>number >>siblings ] }
  91         { "stepping" [ string>number >>stepping ] }
  92         { "vendor_id" [ >>vendor-id ] }
  93         { "wp" [ "yes" = >>wp? ] }
  94         { "TLB size" [ >>tlb-size ] }
  95         [ unknown-cpuinfo-line ]
  96     } case ;
  97
  98
  99 ! Linux 2.6 has fewer values than new kernels
 100 : lines>processor-info ( strings -- processor-info )
 101     [ processor-info new ] dip
 102     [ line>processor-info ] each ;
 103
 104 : parse-proc-cpuinfo ( -- seq )
 105     "/proc/cpuinfo" utf8 file-lines
 106     { "" } split harvest [ lines>processor-info ] map ;
 107
 108 : sort-cpus ( seq -- seq )
 109     { { physical-id>> <=> } { core-id>> <=> } } sort-by
 110     [ [ physical-id>> ] bi@ = ] monotonic-split
 111     [ [ [ core-id>> ] bi@ = ] monotonic-split ] map ;
 112
 113 : cpu-counts ( seq -- #cpus #cores #hyperthread )
 114     [ length ]
 115     [ [ length ] map-sum ]
 116     [ [ [ length ] map-sum ] map-sum ] tri ;
 117
 118
 119 TUPLE: proc-loadavg
 120     load-average-1
 121     load-average-5
 122     load-average-15
 123     #processes-executing
 124     #processes-total
 125     last-pid ;
 126
 127 : parse-proc-loadavg ( -- obj )
 128     "/proc/loadavg" utf8 file-lines first
 129     " " split [
 130         {
 131             [ string>number ]
 132             [ string>number ]
 133             [ string>number ]
 134             [ "/" split1 [ string>number ] bi@ ]
 135             [ string>number ]
 136         } spread
 137     ] input<sequence proc-loadavg boa ;
 138
 139
 140 ! In the file as kb, convert to bytes
 141 TUPLE: proc-meminfo
 142     mem-total
 143     mem-free
 144     buffers
 145     cached
 146     swap-cached
 147     active
 148     inactive
 149     active-anon
 150     inactive-anon
 151     active-file
 152     inactive-file
 153     unevictable
 154     mlocked
 155     swap-total
 156     swap-free
 157     dirty
 158     writeback
 159     anon-pages
 160     mapped
 161     shmem
 162     slab
 163     s-reclaimable
 164     s-unreclaimable
 165     kernel-stack
 166     page-tables
 167     nfs-unstable
 168     bounce
 169     writeback-tmp
 170     commit-limit
 171     committed-as
 172     vmalloc-total
 173     vmalloc-used
 174     vmalloc-chunk
 175     hardware-corrupted
 176     anon-huge-pages
 177     huge-pages-total
 178     huge-pages-free
 179     huge-pages-rsvd
 180     huge-pages-surp
 181     huge-page-size
 182     direct-map-4k
 183     direct-map-2m ;
 184
 185 ! Different kernels have fewer fields. Make sure we have enough.
 186 : parse-proc-meminfo ( -- meminfo )
 187     "/proc/meminfo" utf8 file-lines
 188     [ " " split harvest second string>number 1024 * ] map
 189     proc-meminfo "slots" word-prop length f pad-tail
 190     [ proc-meminfo boa ] input<sequence ;
 191
 192 ! All cpu-stat fields are measured in jiffies.
 193 TUPLE: proc-stat
 194     cpu
 195     cpus
 196     intr
 197     ctxt
 198     btime
 199     processes
 200     procs-running
 201     procs-blocked
 202     softirq ;
 203
 204 TUPLE: proc-cpu-stat name user nice system idle iowait irq softirq steal guest guest-nice ;
 205
 206 : line>cpu ( string -- cpu )
 207     " " split
 208     unclip-slice
 209     [ [ [ CHAR: \s = ] trim string>number ] map ] dip prefix
 210     [ proc-cpu-stat boa ] input<sequence ;
 211
 212 : parse-proc-stat ( -- obj )
 213     "/proc/stat" utf8 file-lines
 214     [ first ] [ 7 head* rest ] [ 7 tail* ] tri 3array {
 215         [ first line>cpu ]
 216         [ second [ line>cpu ] map ]
 217         [
 218             third
 219             [ " " split1 nip " " split [ string>number ] map ] map
 220             [
 221                 {
 222                     [ ]
 223                     [ first ]
 224                     [ first ]
 225                     [ first ]
 226                     [ first ]
 227                     [ first ]
 228                     [ ]
 229                 } spread
 230             ] input<sequence
 231         ]
 232     } cleave proc-stat boa ;
 233
 234 : active-cpus ( -- n )
 235     parse-proc-stat procs-running>> ;
 236
 237 TUPLE: proc-partition major minor #blocks name ;
 238
 239 : parse-proc-partitions ( -- partitions )
 240     "/proc/partitions" utf8 file-lines 2 tail
 241     [
 242         " \t" split harvest
 243         [
 244             {
 245                 [ string>number ]
 246                 [ string>number ]
 247                 [ string>number ]
 248                 [ ]
 249             } spread
 250         ] input<sequence proc-partition boa
 251     ] map ;
 252
 253 TUPLE: proc-swap filename type size used priority ;
 254
 255 : parse-proc-swaps ( -- sequence )
 256     "/proc/swaps" utf8 file-lines rest
 257     [
 258         " \t" split harvest
 259         [
 260             {
 261                 [ ]
 262                 [ ]
 263                 [ string>number ]
 264                 [ string>number ]
 265                 [ string>number ]
 266             } spread
 267         ] input<sequence proc-swap boa
 268     ] map ;
 269
 270 TUPLE: proc-uptime up idle ;
 271
 272 : parse-proc-uptime ( -- uptime )
 273     "/proc/uptime" utf8 file-lines first
 274     " " split first2 [ string>number seconds ] bi@
 275     proc-uptime boa ;
 276
 277 ! /proc/pid/*
 278
 279 GENERIC# proc-pid-path 1 ( object string -- path )
 280
 281 M: integer proc-pid-path ( pid string -- path )
 282     [ "/proc/" ] 2dip
 283     [ number>string "/" append ] dip
 284     3append ;
 285
 286 M: string proc-pid-path ( pid-string string -- path )
 287     [ "/proc/" ] 2dip [ append-path ] dip append-path ;
 288
 289 : proc-file-lines ( path -- strings ) utf8 file-lines ;
 290 : proc-first-line ( path -- string/f ) proc-file-lines ?first ;
 291
 292 : proc-pid-first-line ( pid string -- string )
 293     proc-pid-path proc-first-line ;
 294
 295 : parse-proc-pid-cmdline ( pid -- string/f )
 296     "cmdline" proc-pid-path proc-first-line ;
 297
 298 TUPLE: pid-stat pid filename state parent-pid group-id session-id terminal#
 299     terminal-group-id task-flags
 300     #minor-page-faults #minor-page-faults-child
 301     #major-page-faults #major-page-faults-child
 302     cpu-user cpu-kernel
 303     cpu-user-children cpu-kernel-children
 304     priority
 305     niceness
 306     #threads
 307     zero0
 308     nanos-since-boot
 309     virtual-memory
 310     resident-set-size resident-set-limit
 311     start-address end-address stack-start-address
 312     current-stack-pointer current-instruction-pointer
 313     pending-signals blocked-signals ignored-signals
 314     handled-signals
 315     wait-address
 316     zero1
 317     zero2
 318     exit-signal
 319     task-cpu
 320     realtime-policy
 321     policy
 322     blkio-ticks
 323     guest-time children-guest-time
 324     start-data end-data
 325     start-brk
 326     arg-start arg-end
 327     env-start env-end
 328     exit-code ;
 329
 330 : parse-proc-pid-stat ( pid -- stat )
 331     "stat" proc-pid-path
 332     proc-first-line
 333     " " split harvest
 334     pid-stat "slots" word-prop length "0" pad-tail
 335     [ dup string>number [ nip ] when* ] map
 336     [ pid-stat boa ] input<sequence ;