--- /dev/null
+! Copyright (C) 2012 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs io.directories io.pathnames kernel
+math.parser prettyprint sequences splitting unix.linux.proc ;
+IN: tools.ps.linux
+
+! If cmdline is empty, read the filename from /proc/pid/stat
+: ps-cmdline ( path -- path string )
+ dup parse-proc-pid-cmdline [
+ dup parse-proc-pid-stat filename>>
+ [ "()" member? ] trim
+ "[" "]" surround
+ ] [
+ "\0" split " " join
+ ] if-empty ;
+
+M: linux ps ( -- assoc )
+ "/proc" [
+ "." directory-files
+ [ file-name string>number ] filter
+ [ ps-cmdline ] { } map>assoc
+ ] with-directory ;
--- /dev/null
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors alien.c-types alien.data alien.syntax arrays
+assocs byte-arrays classes.struct continuations fry grouping
+kernel literals math sequences sorting splitting strings system
+system-info.macosx tools.ps unix unix.time unix.types ;
+
+QUALIFIED-WITH: alien.c-types c
+
+IN: tools.ps.macosx
+
+<PRIVATE
+
+: system-type ( -- str ) { 1 1 } sysctl-query-string ;
+: system-release ( -- str ) { 1 2 } sysctl-query-string ;
+: system-revision ( -- str ) { 1 3 } sysctl-query-string ;
+: system-version ( -- str ) { 1 4 } sysctl-query-string ;
+: max-vnodes ( -- n ) { 1 5 } sysctl-query-uint ;
+: max-processes ( -- n ) { 1 6 } sysctl-query-uint ;
+: max-open-files ( -- n ) { 1 7 } sysctl-query-uint ;
+: max-arguments ( -- args ) { 1 8 } sysctl-query-uint ;
+: system-security-level ( -- n ) { 1 9 } sysctl-query-uint ;
+: hostname ( -- str ) { 1 10 } sysctl-query-string ;
+
+: sysctl-query-bytes ( seq -- n )
+ [ make-int-array ] [ length ] bi f 0 uint <ref>
+ [ f 0 sysctl io-error ] keep uint deref ;
+
+STRUCT: _pcred
+ { pc_lock char[72] }
+ { pc_ucred void* }
+ { p_ruid uid_t }
+ { p_svuid uid_t }
+ { p_rgid gid_t }
+ { p_svgid gid_t }
+ { p_refcnt int } ;
+
+STRUCT: _ucred
+ { cr_ref int32_t }
+ { cr_uid uid_t }
+ { cr_ngroups c:short }
+ { cr_groups gid_t[16] } ;
+
+STRUCT: vmspace
+ { dummy int32_t }
+ { dummy2 caddr_t }
+ { dummy3 int32_t[5] }
+ { dummy4 caddr_t[3] } ;
+
+TYPEDEF: int32_t segsz_t
+TYPEDEF: uint32_t fixpt_t
+TYPEDEF: uint64_t u_quad_t
+TYPEDEF: uint32_t sigset_t
+
+STRUCT: itimerval
+ { it_interval timeval }
+ { it_value timeval } ;
+
+STRUCT: extern_proc
+ { __p_starttime timeval }
+ { p_vmspace void* }
+ { p_sigacts void* }
+ { p_flag int }
+ { p_stat char }
+ { p_pid pid_t }
+ { p_oppid pid_t }
+ { p_dupfd int }
+ { user_stack caddr_t }
+ { exit_thread void* }
+ { p_debugger int }
+ { sigwait boolean_t }
+ { p_estcpu uint }
+ { p_cpticks int }
+ { p_pctcpu fixpt_t }
+ { p_wchan void* }
+ { p_wmesg void* }
+ { p_swtime uint }
+ { p_slptime uint }
+ { p_realtimer itimerval }
+ { p_rtime timeval }
+ { p_uticks u_quad_t }
+ { p_sticks u_quad_t }
+ { p_iticks u_quad_t }
+ { p_traceflag int }
+ { p_tracep void* }
+ { p_siglist int }
+ { p_textvp void* }
+ { p_holdcnt int }
+ { p_sigmask sigset_t }
+ { p_sigignore sigset_t }
+ { p_sigcatch sigset_t }
+ { p_priority uchar }
+ { p_usrpri uchar }
+ { p_nice char }
+ { p_comm char[16] }
+ { p_pgrp void* }
+ { p_addr void* }
+ { p_xstat ushort }
+ { p_acflag ushort }
+ { p_ru void* } ;
+
+STRUCT: kinfo_proc
+ { kp_proc extern_proc }
+ { e_paddr void* }
+ { e_sess void* }
+ { e_pcred _pcred }
+ { e_ucred _ucred }
+ { e_vm vmspace }
+ { e_ppid pid_t }
+ { e_pgid pid_t }
+ { e_joc c:short }
+ { e_tdev dev_t }
+ { e_tpgid pid_t }
+ { e_tsess void* }
+ { e_mesg char[8] }
+ { e_xsize segsz_t }
+ { e_xrssize c:short }
+ { e_xccount c:short }
+ { e_xswrss c:short }
+ { e_flag int32_t }
+ { e_login char[12] }
+ { e_spare int32_t[4] } ;
+
+: split1-skip-slice ( seq quot: ( elt -- ? ) -- before-slice after-slice )
+ [ find drop dup ]
+ [ [ not ] compose find-from drop over or ]
+ [ drop snip-slice ] 2tri ; inline
+
+: head-split-skip ( seq n quot: ( elt -- ? ) -- pieces )
+ [ dup 0 >= ] swap '[
+ [ _ split1-skip-slice ] [ 1 - rot ] bi*
+ ] produce 2nip ; inline
+
+: args ( pid -- args )
+ [ 1 49 ] dip 0 4array max-arguments sysctl-query
+ 4 cut-slice swap >byte-array uint deref
+ [ zero? ] head-split-skip [ >string ] map ;
+
+: procs ( -- seq )
+ { 1 14 0 0 } dup sysctl-query-bytes sysctl-query
+ kinfo_proc struct-size group
+ [ kinfo_proc memory>struct ] map ;
+
+: ps-arg ( kp_proc -- arg )
+ [ p_pid>> args rest " " join ] [
+ drop p_comm>> 0 over index [ head ] when* >string
+ ] recover ;
+
+PRIVATE>
+
+M: macosx ps ( -- assoc )
+ procs [ kp_proc>> p_pid>> 0 > ] filter
+ [ kp_proc>> [ p_pid>> ] [ ps-arg ] bi ] { } map>assoc
+ sort-keys ;
-! Copyright (C) 2012 Doug Coleman.
+! Copyright (C) 2012-2013 Doug Coleman, John Benediktsson.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs io.directories io.pathnames kernel
-math.parser prettyprint sequences splitting unix.linux.proc ;
+USING: combinators prettyprint system vocabs ;
IN: tools.ps
-! If cmdline is empty, read the filename from /proc/pid/stat
-: ps-cmdline ( path -- path string )
- dup parse-proc-pid-cmdline [
- dup parse-proc-pid-stat filename>>
- [ "()" member? ] trim
- "[" "]" surround
- ] [
- "\0" split " " join
- ] if-empty ;
+HOOK: ps os ( -- assoc )
-: ps ( -- assoc )
- "/proc" [
- "." directory-files
- [ file-name string>number ] filter
- [ ps-cmdline ] { } map>assoc
- ] with-directory ;
+{
+ { [ os macosx? ] [ "tools.ps.macosx" ] }
+ { [ os linux? ] [ "tools.ps.linux" ] }
+ { [ os windows? ] [ "tools.ps.windows" ] }
+} cond require
: ps. ( -- )
ps simple-table. ;
projects / factor.git / commitdiff