basis/tools/ps/macosx/macosx.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors alien.c-types alien.data alien.syntax arrays
   5 assocs byte-arrays classes.struct continuations fry grouping
   6 kernel libc literals math sequences splitting strings system
   7 system-info.macosx tools.ps unix unix.time unix.types ;
   8
   9 QUALIFIED-WITH: alien.c-types c
  10
  11 IN: tools.ps.macosx
  12
  13 <PRIVATE
  14
  15 : system-type ( -- str ) { 1 1 } sysctl-query-string ;
  16 : system-release ( -- str ) { 1 2 } sysctl-query-string ;
  17 : system-revision ( -- str ) { 1 3 } sysctl-query-string ;
  18 : system-version ( -- str ) { 1 4 } sysctl-query-string ;
  19 : max-vnodes ( -- n ) { 1 5 } sysctl-query-uint ;
  20 : max-processes ( -- n ) { 1 6 } sysctl-query-uint ;
  21 : max-open-files ( -- n ) { 1 7 } sysctl-query-uint ;
  22 : max-arguments ( -- args ) { 1 8 } sysctl-query-uint ;
  23 : system-security-level ( -- n ) { 1 9 } sysctl-query-uint ;
  24 : hostname ( -- str ) { 1 10 } sysctl-query-string ;
  25
  26 : sysctl-query-bytes ( seq -- n )
  27     [ int >c-array ] [ length ] bi f 0 uint <ref>
  28     [ f 0 sysctl io-error ] keep uint deref ;
  29
  30 STRUCT: _pcred
  31     { pc_lock char[72] }
  32     { pc_ucred void* }
  33     { p_ruid uid_t }
  34     { p_svuid uid_t }
  35     { p_rgid gid_t }
  36     { p_svgid gid_t }
  37     { p_refcnt int } ;
  38
  39 STRUCT: _ucred
  40     { cr_ref int32_t }
  41     { cr_uid uid_t }
  42     { cr_ngroups c:short }
  43     { cr_groups gid_t[16] } ;
  44
  45 STRUCT: vmspace
  46     { dummy int32_t }
  47     { dummy2 caddr_t }
  48     { dummy3 int32_t[5] }
  49     { dummy4 caddr_t[3] } ;
  50
  51 TYPEDEF: int32_t segsz_t
  52 TYPEDEF: uint32_t fixpt_t
  53 TYPEDEF: uint64_t u_quad_t
  54 TYPEDEF: uint32_t sigset_t
  55
  56 STRUCT: itimerval
  57     { it_interval timeval }
  58     { it_value timeval } ;
  59
  60 STRUCT: extern_proc
  61     { __p_starttime timeval }
  62     { p_vmspace void* }
  63     { p_sigacts void* }
  64     { p_flag int }
  65     { p_stat char }
  66     { p_pid pid_t }
  67     { p_oppid pid_t }
  68     { p_dupfd int }
  69     { user_stack caddr_t }
  70     { exit_thread void* }
  71     { p_debugger int }
  72     { sigwait boolean_t }
  73     { p_estcpu uint }
  74     { p_cpticks int }
  75     { p_pctcpu fixpt_t }
  76     { p_wchan void* }
  77     { p_wmesg void* }
  78     { p_swtime uint }
  79     { p_slptime uint }
  80     { p_realtimer itimerval }
  81     { p_rtime timeval }
  82     { p_uticks u_quad_t }
  83     { p_sticks u_quad_t }
  84     { p_iticks u_quad_t }
  85     { p_traceflag int }
  86     { p_tracep void* }
  87     { p_siglist int }
  88     { p_textvp void* }
  89     { p_holdcnt int }
  90     { p_sigmask sigset_t }
  91     { p_sigignore sigset_t }
  92     { p_sigcatch sigset_t }
  93     { p_priority uchar }
  94     { p_usrpri uchar }
  95     { p_nice char }
  96     { p_comm char[16] }
  97     { p_pgrp void* }
  98     { p_addr void* }
  99     { p_xstat ushort }
 100     { p_acflag ushort }
 101     { p_ru void* } ;
 102
 103 STRUCT: kinfo_proc
 104     { kp_proc extern_proc }
 105     { e_paddr void* }
 106     { e_sess void* }
 107     { e_pcred _pcred }
 108     { e_ucred _ucred }
 109     { e_vm vmspace }
 110     { e_ppid pid_t }
 111     { e_pgid pid_t }
 112     { e_joc c:short }
 113     { e_tdev dev_t }
 114     { e_tpgid pid_t }
 115     { e_tsess void* }
 116     { e_mesg char[8] }
 117     { e_xsize segsz_t }
 118     { e_xrssize c:short }
 119     { e_xccount c:short }
 120     { e_xswrss c:short }
 121     { e_flag int32_t }
 122     { e_login char[12] }
 123     { e_spare int32_t[4] } ;
 124
 125 : head-split-skip ( seq n quot: ( elt -- ? ) -- pieces )
 126     [ dup 0 >= ] swap '[
 127         [ _ [ trim-head-slice ] [ split1-when-slice ] bi ]
 128         [ 1 - rot ] bi*
 129     ] produce 2nip ; inline
 130
 131 : args ( pid -- args )
 132     [ 1 49 ] dip 0 4array max-arguments sysctl-query
 133     4 cut-slice swap >byte-array uint deref
 134     [ zero? ] head-split-skip [ >string ] map ;
 135
 136 : procs ( -- seq )
 137     { 1 14 0 0 } dup sysctl-query-bytes sysctl-query
 138     kinfo_proc struct-size group
 139     [ kinfo_proc memory>struct ] map ;
 140
 141 : ps-arg ( kp_proc -- arg )
 142     [ p_pid>> args rest " " join ] [
 143         drop p_comm>> 0 over index [ head ] when* >string
 144     ] recover ;
 145
 146 PRIVATE>
 147
 148 M: macosx ps
 149     procs [ kp_proc>> p_pid>> 0 > ] filter
 150     [ kp_proc>> [ p_pid>> ] [ ps-arg ] bi ] { } map>assoc ;