basis/tools/ps/macosx/macosx.factor

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