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 ;
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> ;
23 { cpu-family integer }
29 { cache-size integer }
34 { physical-id integer }
39 { initial-apicid integer }
41 { fpu-exception? boolean }
42 { cpuid-level integer }
46 { clflush-size integer }
47 { cache-alignment integer }
48 { address-sizes array }
49 { power-management string }
52 { vmx-flags string } ;
55 ERROR: unknown-cpuinfo-line string ;
57 : line>processor-info ( processor-info string -- processor-info )
59 [ CHAR: \t = ] trim-tail [ [ CHAR: \s = ] trim ] bi@
62 "," split [ [ CHAR: \s = ] trim " " split first string>number ] map
65 { "apicid" [ string>number >>apicid ] }
66 { "bogomips" [ string>number >>bogomips ] }
68 " " split first [ CHAR: \s = ] trim
69 string>number 1024 * >>cache-size
71 { "cache_alignment" [ string>number >>cache-alignment ] }
72 { "clflush size" [ string>number >>clflush-size ] }
73 { "coma_bug" [ "yes" = >>coma-bug? ] }
74 { "core id" [ string>number >>core-id ] }
75 { "cpu MHz" [ string>number >>cpu-mhz ] }
76 { "cpu cores" [ string>number >>cpu-cores ] }
77 { "cpu family" [ string>number >>cpu-family ] }
78 { "cpuid level" [ string>number >>cpuid-level ] }
79 { "f00f_bug" [ "yes" = >>f00f-bug? ] }
80 { "fdiv_bug" [ "yes" = >>fdiv-bug? ] }
81 { "flags" [ " " split harvest >>flags ] }
82 { "fpu" [ "yes" = >>fpu? ] }
83 { "fpu_exception" [ "yes" = >>fpu-exception? ] }
84 { "hlt_bug" [ "yes" = >>hlt-bug? ] }
85 { "initial apicid" [ string>number >>initial-apicid ] }
86 { "microcode" [ string>number >>microcode ] }
87 { "model" [ string>number >>model ] }
88 { "model name" [ >>model-name ] }
89 { "physical id" [ string>number >>physical-id ] }
90 { "power management" [ >>power-management ] }
91 { "processor" [ string>number >>processor ] }
92 { "siblings" [ string>number >>siblings ] }
93 { "stepping" [ string>number >>stepping ] }
94 { "vendor_id" [ >>vendor-id ] }
95 { "wp" [ "yes" = >>wp? ] }
96 { "TLB size" [ >>tlb-size ] }
98 { "vmx flags" [ >>vmx-flags ] }
99 [ unknown-cpuinfo-line ]
103 ! Linux 2.6 has fewer values than new kernels
104 : lines>processor-info ( strings -- processor-info )
105 [ processor-info new ] dip
106 [ line>processor-info ] each ;
108 : parse-proc-cpuinfo ( -- seq )
109 "/proc/cpuinfo" utf8 file-lines
110 { "" } split harvest [ lines>processor-info ] map ;
112 : sort-cpus ( seq -- seq )
113 { { physical-id>> <=> } { core-id>> <=> } } sort-by
114 [ [ physical-id>> ] bi@ = ] monotonic-split
115 [ [ [ core-id>> ] bi@ = ] monotonic-split ] map ;
117 : cpu-counts ( seq -- #cpus #cores #hyperthread )
119 [ [ length ] map-sum ]
120 [ [ [ length ] map-sum ] map-sum ] tri ;
131 : parse-proc-loadavg ( -- obj )
132 "/proc/loadavg" utf8 file-lines first
138 [ "/" split1 [ string>number ] bi@ ]
141 ] input<sequence proc-loadavg boa ;
144 ! In the file as kb, convert to bytes
189 ! Different kernels have fewer fields. Make sure we have enough.
190 : parse-proc-meminfo ( -- meminfo )
191 "/proc/meminfo" utf8 file-lines
192 [ " " split harvest second string>number 1024 * ] map
193 proc-meminfo "slots" word-prop length f pad-tail
194 [ proc-meminfo boa ] input<sequence ;
196 ! All cpu-stat fields are measured in jiffies.
208 TUPLE: proc-cpu-stat name user nice system idle iowait irq softirq steal guest guest-nice ;
210 : line>cpu ( string -- cpu )
213 [ [ [ CHAR: \s = ] trim string>number ] map ] dip prefix
214 [ proc-cpu-stat boa ] input<sequence ;
216 : parse-proc-stat ( -- obj )
217 "/proc/stat" utf8 file-lines
218 [ first ] [ 7 head* rest ] [ 7 tail* ] tri 3array {
220 [ second [ line>cpu ] map ]
223 [ " " split1 nip " " split [ string>number ] map ] map
236 } cleave proc-stat boa ;
238 : active-cpus ( -- n )
239 parse-proc-stat procs-running>> ;
241 TUPLE: proc-partition major minor #blocks name ;
243 : parse-proc-partitions ( -- partitions )
244 "/proc/partitions" utf8 file-lines 2 tail
254 ] input<sequence proc-partition boa
257 TUPLE: proc-swap filename type size used priority ;
259 : parse-proc-swaps ( -- sequence )
260 "/proc/swaps" utf8 file-lines rest
271 ] input<sequence proc-swap boa
274 TUPLE: proc-uptime up idle ;
276 : parse-proc-uptime ( -- uptime )
277 "/proc/uptime" utf8 file-lines first
278 " " split first2 [ string>number seconds ] bi@
283 GENERIC#: proc-pid-path 1 ( object string -- path )
285 M: integer proc-pid-path
287 [ number>string "/" append ] dip
290 M: string proc-pid-path
291 [ "/proc/" ] 2dip [ append-path ] dip append-path ;
293 : proc-file-lines ( path -- strings ) utf8 file-lines ;
294 : proc-first-line ( path -- string/f ) proc-file-lines ?first ;
296 : proc-pid-first-line ( pid string -- string )
297 proc-pid-path proc-first-line ;
299 : parse-proc-pid-cmdline ( pid -- string/f )
300 "cmdline" proc-pid-path proc-first-line ;
302 TUPLE: pid-stat pid filename state parent-pid group-id session-id terminal#
303 terminal-group-id task-flags
304 #minor-page-faults #minor-page-faults-child
305 #major-page-faults #major-page-faults-child
307 cpu-user-children cpu-kernel-children
314 resident-set-size resident-set-limit
315 start-address end-address stack-start-address
316 current-stack-pointer current-instruction-pointer
317 pending-signals blocked-signals ignored-signals
327 guest-time children-guest-time
334 : parse-proc-pid-stat ( pid -- stat )
338 pid-stat "slots" word-prop length "0" pad-tail
339 [ dup string>number [ nip ] when* ] map
340 [ pid-stat boa ] input<sequence ;