Artifact
5a4e2fa6b348ef121907bc0fe4e3fd9e9f3d897f:
0000: 28 75 73 65 20 70 6f 73 69 78 20 73 72 66 69 2d (use posix srfi-
0010: 36 39 29 0a 0a 28 64 65 66 69 6e 65 20 2a 6e 75 69)..(define *nu
0020: 6d 73 61 6d 70 6c 65 73 2a 20 28 6f 72 20 28 61 msamples* (or (a
0030: 6e 64 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 61 nd (> (length (a
0040: 72 67 76 29 29 20 31 29 0a 20 20 20 20 20 20 20 rgv)) 1).
0050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0060: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e (string->
0070: 6e 75 6d 62 65 72 20 28 63 61 64 72 20 28 61 72 number (cadr (ar
0080: 67 76 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 gv)))).
0090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
00a0: 32 30 29 29 0a 0a 28 70 72 69 6e 74 20 22 55 73 20))..(print "Us
00b0: 69 6e 67 20 22 20 2a 6e 75 6d 73 61 6d 70 6c 65 ing " *numsample
00c0: 73 2a 20 22 20 61 73 20 6e 75 6d 62 65 72 20 6f s* " as number o
00d0: 66 20 73 61 6d 70 6c 65 73 2e 22 29 0a 0a 28 64 f samples.")..(d
00e0: 65 66 69 6e 65 20 28 74 6f 70 64 61 74 61 29 0a efine (topdata).
00f0: 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 (with-input-fr
0100: 6f 6d 2d 70 69 70 65 0a 20 20 20 28 63 6f 6e 63 om-pipe. (conc
0110: 20 22 74 6f 70 20 2d 62 20 2d 6e 20 22 20 2a 6e "top -b -n " *n
0120: 75 6d 73 61 6d 70 6c 65 73 2a 20 22 20 2d 64 20 umsamples* " -d
0130: 30 2e 32 22 29 0a 20 20 20 72 65 61 64 2d 6c 69 0.2"). read-li
0140: 6e 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 nes))..(define (
0150: 63 6c 65 61 6e 75 70 2d 64 61 74 61 20 74 6f 70 cleanup-data top
0160: 64 61 74 29 6c 69 73 74 0a 20 20 28 6c 65 74 20 dat)list. (let
0170: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
0180: 74 6f 70 64 61 74 29 29 0a 20 20 20 20 20 20 20 topdat)).
0190: 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 72 (tal (cdr
01a0: 20 74 6f 70 64 61 74 29 29 0a 20 20 20 20 20 20 topdat)).
01b0: 20 20 20 20 20 20 20 20 28 72 65 73 20 27 28 29 (res '()
01c0: 29 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 6c )). (let* ((l
01d0: 69 6e 65 2d 6c 69 73 74 20 28 73 74 72 69 6e 67 ine-list (string
01e0: 2d 73 70 6c 69 74 20 68 65 64 29 29 0a 20 20 20 -split hed)).
01f0: 20 20 20 20 20 20 20 20 28 6e 75 6d 73 20 20 20 (nums
0200: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
0210: 28 69 6e 64 61 74 29 28 6f 72 20 28 73 74 72 69 (indat)(or (stri
0220: 6e 67 2d 3e 6e 75 6d 62 65 72 20 69 6e 64 61 74 ng->number indat
0230: 29 20 69 6e 64 61 74 29 29 20 6c 69 6e 65 2d 6c ) indat)) line-l
0240: 69 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 ist)).
0250: 20 28 6e 6f 74 2d 64 61 74 61 20 20 28 6f 72 20 (not-data (or
0260: 28 6e 75 6c 6c 3f 20 6e 75 6d 73 29 0a 20 20 20 (null? nums).
0270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0280: 20 20 20 20 20 20 20 28 6e 6f 74 20 28 6e 75 6d (not (num
0290: 62 65 72 3f 20 28 63 61 72 20 6e 75 6d 73 29 29 ber? (car nums))
02a0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
02b0: 6e 65 77 2d 72 65 73 20 20 20 28 69 66 20 6e 6f new-res (if no
02c0: 74 2d 64 61 74 61 20 72 65 73 20 28 63 6f 6e 73 t-data res (cons
02d0: 20 6e 75 6d 73 20 72 65 73 29 29 29 29 0a 20 20 nums res)))).
02e0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
02f0: 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 6e 65 al). ne
0300: 77 2d 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 w-res.
0310: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
0320: 63 64 72 20 74 61 6c 29 20 6e 65 77 2d 72 65 73 cdr tal) new-res
0330: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 )))))..(define d
0340: 61 74 61 20 28 63 6c 65 61 6e 75 70 2d 64 61 74 ata (cleanup-dat
0350: 61 20 28 74 6f 70 64 61 74 61 29 29 29 0a 28 64 a (topdata))).(d
0360: 65 66 69 6e 65 20 70 69 64 68 61 73 68 20 20 28 efine pidhash (
0370: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0380: 29 0a 28 64 65 66 69 6e 65 20 75 73 65 72 68 61 ).(define userha
0390: 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 sh (make-hash-ta
03a0: 62 6c 65 29 29 0a 0a 3b 3b 20 73 75 6d 20 75 70 ble))..;; sum up
03b0: 20 61 6e 64 20 6e 6f 72 6d 61 6c 69 7a 65 20 74 and normalize t
03c0: 68 65 20 0a 28 66 6f 72 2d 65 61 63 68 0a 20 28 he .(for-each. (
03d0: 6c 61 6d 62 64 61 20 28 69 6e 64 61 74 29 0a 20 lambda (indat).
03e0: 20 20 28 6c 65 74 20 28 28 70 69 64 20 28 63 61 (let ((pid (ca
03f0: 72 20 69 6e 64 61 74 29 29 0a 20 20 20 20 20 20 r indat)).
0400: 20 20 20 28 75 73 72 20 28 63 61 64 72 20 69 6e (usr (cadr in
0410: 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 dat)). (
0420: 63 70 75 20 28 6c 69 73 74 2d 72 65 66 20 69 6e cpu (list-ref in
0430: 64 61 74 20 38 29 29 29 0a 20 20 20 20 20 28 68 dat 8))). (h
0440: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 75 ash-table-set! u
0450: 73 65 72 68 61 73 68 20 75 73 72 20 28 2b 20 63 serhash usr (+ c
0460: 70 75 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 pu (hash-table-r
0470: 65 66 2f 64 65 66 61 75 6c 74 20 75 73 65 72 68 ef/default userh
0480: 61 73 68 20 75 73 72 20 30 29 29 29 29 29 0a 20 ash usr 0))))).
0490: 64 61 74 61 29 0a 0a 28 66 6f 72 2d 65 61 63 68 data)..(for-each
04a0: 0a 20 28 6c 61 6d 62 64 61 20 28 75 73 72 29 0a . (lambda (usr).
04b0: 20 20 20 28 70 72 69 6e 74 20 75 73 72 0a 20 20 (print usr.
04c0: 20 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 28 (if (< (
04d0: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 75 73 string-length us
04e0: 72 29 20 38 29 20 22 5c 74 5c 74 22 20 22 5c 74 r) 8) "\t\t" "\t
04f0: 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 6e "). (in
0500: 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f exact->exact (ro
0510: 75 6e 64 20 28 2f 20 28 68 61 73 68 2d 74 61 62 und (/ (hash-tab
0520: 6c 65 2d 72 65 66 20 75 73 65 72 68 61 73 68 20 le-ref userhash
0530: 75 73 72 29 20 2a 6e 75 6d 73 61 6d 70 6c 65 73 usr) *numsamples
0540: 2a 29 29 29 29 29 0a 20 28 73 6f 72 74 20 28 68 *))))). (sort (h
0550: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 75 ash-table-keys u
0560: 73 65 72 68 61 73 68 29 0a 20 20 20 20 20 20 20 serhash).
0570: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 20 20 (lambda (a b).
0580: 20 20 20 20 20 20 20 28 3e 20 28 68 61 73 68 2d (> (hash-
0590: 74 61 62 6c 65 2d 72 65 66 20 75 73 65 72 68 61 table-ref userha
05a0: 73 68 20 61 29 0a 20 20 20 20 20 20 20 20 20 20 sh a).
05b0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
05c0: 66 20 75 73 65 72 68 61 73 68 20 62 29 29 29 29 f userhash b))))
05d0: 29 0a 0a )..