Artifact
5b100bed9376cccc5d9bf4c5da6ca8b45c91c219:
0000: 28 75 73 65 20 65 7a 78 64 69 73 70 20 73 72 66 (use ezxdisp srf
0010: 69 2d 31 38 29 0a 0a 28 64 65 66 69 6e 65 20 2a i-18)..(define *
0020: 65 7a 78 2a 20 28 65 7a 78 2d 69 6e 69 74 20 36 ezx* (ezx-init 6
0030: 35 30 20 36 35 30 20 22 42 61 74 63 68 20 73 69 50 650 "Batch si
0040: 6d 75 6c 61 74 6f 72 22 29 29 0a 28 72 65 71 75 mulator")).(requ
0050: 69 72 65 2d 6c 69 62 72 61 72 79 20 65 7a 78 67 ire-library ezxg
0060: 75 69 29 0a 28 64 65 66 69 6e 65 20 2a 67 72 65 ui).(define *gre
0070: 65 6e 2a 20 20 28 6d 61 6b 65 2d 65 7a 78 2d 63 en* (make-ezx-c
0080: 6f 6c 6f 72 20 30 20 31 20 30 29 29 20 0a 28 64 olor 0 1 0)) .(d
0090: 65 66 69 6e 65 20 2a 62 6c 61 63 6b 2a 20 20 28 efine *black* (
00a0: 6d 61 6b 65 2d 65 7a 78 2d 63 6f 6c 6f 72 20 30 make-ezx-color 0
00b0: 20 30 20 30 29 29 0a 28 64 65 66 69 6e 65 20 2a 0 0)).(define *
00c0: 67 72 65 79 2a 20 20 20 28 6d 61 6b 65 2d 65 7a grey* (make-ez
00d0: 78 2d 63 6f 6c 6f 72 20 30 2e 31 20 30 2e 31 20 x-color 0.1 0.1
00e0: 30 2e 31 29 29 0a 28 64 65 66 69 6e 65 20 2a 62 0.1)).(define *b
00f0: 6c 75 65 2a 20 20 20 28 6d 61 6b 65 2d 65 7a 78 lue* (make-ezx
0100: 2d 63 6f 6c 6f 72 20 30 20 30 20 31 29 29 20 0a -color 0 0 1)) .
0110: 28 64 65 66 69 6e 65 20 2a 63 79 61 6e 2a 20 20 (define *cyan*
0120: 20 28 6d 61 6b 65 2d 65 7a 78 2d 63 6f 6c 6f 72 (make-ezx-color
0130: 20 30 20 31 20 31 29 29 0a 28 64 65 66 69 6e 65 0 1 1)).(define
0140: 20 2a 67 72 65 65 6e 2a 20 20 28 6d 61 6b 65 2d *green* (make-
0150: 65 7a 78 2d 63 6f 6c 6f 72 20 30 20 31 20 30 29 ezx-color 0 1 0)
0160: 29 0a 28 64 65 66 69 6e 65 20 2a 70 75 72 70 6c ).(define *purpl
0170: 65 2a 20 28 6d 61 6b 65 2d 65 7a 78 2d 63 6f 6c e* (make-ezx-col
0180: 6f 72 20 31 20 30 20 31 29 29 0a 28 64 65 66 69 or 1 0 1)).(defi
0190: 6e 65 20 2a 72 65 64 2a 20 20 20 20 28 6d 61 6b ne *red* (mak
01a0: 65 2d 65 7a 78 2d 63 6f 6c 6f 72 20 31 20 30 20 e-ezx-color 1 0
01b0: 30 29 29 0a 28 64 65 66 69 6e 65 20 2a 77 68 69 0)).(define *whi
01c0: 74 65 2a 20 20 28 6d 61 6b 65 2d 65 7a 78 2d 63 te* (make-ezx-c
01d0: 6f 6c 6f 72 20 31 20 31 20 31 29 29 0a 28 64 65 olor 1 1 1)).(de
01e0: 66 69 6e 65 20 2a 79 65 6c 6c 6f 77 2a 20 28 6d fine *yellow* (m
01f0: 61 6b 65 2d 65 7a 78 2d 63 6f 6c 6f 72 20 31 20 ake-ezx-color 1
0200: 31 20 30 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 1 0))..(define *
0210: 75 73 65 72 2d 63 6f 6c 6f 72 73 2d 70 61 6c 65 user-colors-pale
0220: 74 74 65 2a 0a 20 20 28 6c 69 73 74 20 0a 20 20 tte*. (list .
0230: 20 2a 67 72 65 65 6e 2a 0a 20 20 20 2a 62 6c 75 *green*. *blu
0240: 65 2a 0a 20 20 20 2a 63 79 61 6e 2a 0a 20 20 20 e*. *cyan*.
0250: 2a 70 75 72 70 6c 65 2a 0a 20 20 20 2a 72 65 64 *purple*. *red
0260: 2a 0a 20 20 20 2a 79 65 6c 6c 6f 77 2a 0a 20 20 *. *yellow*.
0270: 20 2a 62 6c 61 63 6b 2a 29 29 0a 0a 28 64 65 66 *black*))..(def
0280: 69 6e 65 20 2a 64 61 72 6b 2d 67 72 65 65 6e 2a ine *dark-green*
0290: 20 28 67 65 74 2d 63 6f 6c 6f 72 20 22 64 61 72 (get-color "dar
02a0: 6b 2d 67 72 65 65 6e 22 29 29 0a 28 64 65 66 69 k-green")).(defi
02b0: 6e 65 20 2a 62 72 6f 77 6e 2a 20 20 20 20 20 20 ne *brown*
02c0: 28 67 65 74 2d 63 6f 6c 6f 72 20 22 62 72 6f 77 (get-color "brow
02d0: 6e 22 29 29 0a 0a 28 65 7a 78 2d 73 65 6c 65 63 n"))..(ezx-selec
02e0: 74 2d 6c 61 79 65 72 20 2a 65 7a 78 2a 20 31 29 t-layer *ezx* 1)
02f0: 0a 28 65 7a 78 2d 77 69 70 65 2d 6c 61 79 65 72 .(ezx-wipe-layer
0300: 20 2a 65 7a 78 2a 20 31 29 0a 0a 3b 3b 20 28 65 *ezx* 1)..;; (e
0310: 7a 78 2d 73 74 72 2d 32 64 20 2a 65 7a 78 2a 20 zx-str-2d *ezx*
0320: 33 30 20 33 30 20 22 48 65 6c 6c 6f 22 20 2a 77 30 30 "Hello" *w
0330: 68 69 74 65 2a 29 0a 3b 3b 20 28 65 7a 78 2d 66 hite*).;; (ezx-f
0340: 69 6c 6c 72 65 63 74 2d 32 64 20 2a 65 7a 78 2a illrect-2d *ezx*
0350: 20 31 30 30 20 31 30 30 20 31 32 30 20 31 32 30 100 100 120 120
0360: 20 2a 62 72 6f 77 6e 2a 29 0a 28 65 7a 78 2d 72 *brown*).(ezx-r
0370: 65 64 72 61 77 20 2a 65 7a 78 2a 29 0a 0a 28 64 edraw *ezx*)..(d
0380: 65 66 69 6e 65 20 2a 6c 61 73 74 2d 64 72 61 77 efine *last-draw
0390: 2a 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 * (current-milli
03a0: 73 65 63 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e seconds)).(defin
03b0: 65 20 2a 64 72 61 77 2d 64 65 6c 74 61 2a 20 34 e *draw-delta* 4
03c0: 30 29 20 3b 3b 20 6d 69 6c 6c 69 73 65 63 6f 6e 0) ;; millisecon
03d0: 64 73 20 62 65 74 77 65 65 6e 20 64 72 61 77 69 ds between drawi
03e0: 6e 67 0a 0a 28 64 65 66 69 6e 65 20 28 77 61 69 ng..(define (wai
03f0: 74 2d 66 6f 72 2d 6e 65 78 74 2d 64 72 61 77 2d t-for-next-draw-
0400: 74 69 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 time). (let* ((
0410: 63 6d 20 20 20 20 28 63 75 72 72 65 6e 74 2d 6d cm (current-m
0420: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 20 illiseconds))..
0430: 28 64 65 6c 74 61 20 28 2d 20 2a 64 72 61 77 2d (delta (- *draw-
0440: 64 65 6c 74 61 2a 20 28 2d 20 63 6d 20 2a 6c 61 delta* (- cm *la
0450: 73 74 2d 64 72 61 77 2a 29 29 29 29 0a 20 20 20 st-draw*)))).
0460: 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 30 29 (if (> delta 0)
0470: 0a 09 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ..(thread-sleep!
0480: 20 28 2f 20 64 65 6c 74 61 20 31 30 30 30 29 29 (/ delta 1000))
0490: 29 0a 20 20 20 20 28 73 65 74 21 20 2a 6c 61 73 ). (set! *las
04a0: 74 2d 64 72 61 77 2a 20 28 63 75 72 72 65 6e 74 t-draw* (current
04b0: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 29 -milliseconds)))
04c0: 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 65 76 65 )..(include "eve
04d0: 6e 74 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 53 79 nts.scm")..;; Sy
04e0: 73 74 65 6d 20 73 70 65 63 20 28 74 6f 20 62 65 stem spec (to be
04f0: 20 6d 6f 76 65 64 20 69 6e 74 6f 20 6c 6f 61 64 moved into load
0500: 65 64 20 66 69 6c 65 29 0a 3b 3b 0a 3b 3b 20 20 ed file).;;.;;
0510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0520: 20 20 20 20 20 20 20 20 20 78 20 20 79 20 20 77 x y w
0530: 20 67 61 70 20 20 78 2d 6d 69 6e 20 78 2d 6d 61 gap x-min x-ma
0540: 78 0a 28 64 65 66 69 6e 65 20 2a 63 70 75 2d 67 x.(define *cpu-g
0550: 72 69 64 2a 20 28 76 65 63 74 6f 72 20 20 35 30 rid* (vector 50
0560: 30 20 35 30 20 31 35 20 20 32 20 20 35 30 30 20 0 50 15 2 500
0570: 20 20 36 30 30 29 29 0a 28 64 65 66 69 6e 65 20 600)).(define
0580: 28 6d 61 6b 65 2d 63 70 75 3a 67 72 69 64 29 28 (make-cpu:grid)(
0590: 6d 61 6b 65 2d 76 65 63 74 6f 72 20 36 29 29 0a make-vector 6)).
05a0: 28 64 65 66 69 6e 65 20 2a 71 75 65 75 65 73 2a (define *queues*
05b0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
05c0: 65 29 29 20 3b 3b 20 6e 61 6d 65 20 2d 3e 20 28 e)) ;; name -> (
05d0: 6c 69 73 74 20 28 6c 69 73 74 20 75 73 65 72 20 list (list user
05e0: 64 75 72 61 74 69 6f 6e 20 6e 75 6d 2d 63 70 75 duration num-cpu
05f0: 73 20 6e 75 6d 2d 67 69 67 73 29 20 2e 2e 2e 20 s num-gigs) ...
0600: 29 0a 28 64 65 66 69 6e 65 20 2a 63 70 75 73 2a ).(define *cpus*
0610: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0620: 65 29 29 20 3b 3b 20 63 70 75 2d 6e 61 6d 65 20 e)) ;; cpu-name
0630: 3d 3e 20 28 76 65 63 74 6f 72 20 75 73 65 72 20 => (vector user
0640: 6a 6f 62 2d 6c 65 6e 20 6e 75 6d 2d 63 70 75 20 job-len num-cpu
0650: 6d 65 6d 20 78 2d 6c 6f 63 20 79 2d 6c 6f 63 29 mem x-loc y-loc)
0660: 0a 28 64 65 66 69 6e 65 20 2a 6f 62 6a 2d 6c 6f .(define *obj-lo
0670: 63 61 74 69 6f 6e 73 2a 20 28 6d 61 6b 65 2d 68 cations* (make-h
0680: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 6e ash-table)) ;; n
0690: 61 6d 65 20 2d 3e 20 28 78 20 79 20 6c 61 79 65 ame -> (x y laye
06a0: 72 29 0a 28 64 65 66 69 6e 65 20 2a 71 75 65 75 r).(define *queu
06b0: 65 2d 73 70 65 63 2a 0a 20 20 28 76 65 63 74 6f e-spec*. (vecto
06c0: 72 0a 20 20 20 38 30 20 20 3b 3b 20 73 74 61 72 r. 80 ;; star
06d0: 74 2d 78 0a 20 20 20 33 30 30 20 3b 3b 20 73 74 t-x. 300 ;; st
06e0: 61 72 74 2d 79 0a 20 20 20 33 30 30 20 3b 3b 20 art-y. 300 ;;
06f0: 64 65 6c 74 61 2d 79 20 68 6f 77 20 66 61 72 20 delta-y how far
0700: 74 6f 20 6e 65 78 74 20 71 75 65 75 65 0a 20 20 to next queue.
0710: 20 31 35 20 20 3b 3b 20 68 65 69 67 68 74 0a 20 15 ;; height.
0720: 20 20 34 30 30 20 3b 3b 20 6c 65 6e 67 74 68 0a 400 ;; length.
0730: 20 20 20 29 29 0a 28 64 65 66 69 6e 65 20 2a 75 )).(define *u
0740: 73 65 2d 6c 6f 67 2a 20 23 66 29 0a 28 64 65 66 se-log* #f).(def
0750: 69 6e 65 20 2a 6a 6f 62 2d 6c 6f 67 2d 73 63 61 ine *job-log-sca
0760: 6c 65 2a 20 31 30 29 0a 0a 3b 3b 3d 3d 3d 3d 3d le* 10)..;;=====
0770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07b0: 3d 0a 3b 3b 20 55 73 65 72 73 0a 3b 3b 3d 3d 3d =.;; Users.;;===
07c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0800: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 2a 75 73 ===..(define *us
0810: 65 72 2d 63 6f 6c 6f 72 73 2a 20 28 6d 61 6b 65 er-colors* (make
0820: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a 28 -hash-table))..(
0830: 64 65 66 69 6e 65 20 28 67 65 74 2d 75 73 65 72 define (get-user
0840: 2d 63 6f 6c 6f 72 20 75 73 65 72 29 0a 20 20 28 -color user). (
0850: 6c 65 74 20 28 28 63 6f 6c 6f 72 20 28 68 61 73 let ((color (has
0860: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
0870: 75 6c 74 20 2a 75 73 65 72 2d 63 6f 6c 6f 72 73 ult *user-colors
0880: 2a 20 75 73 65 72 20 23 66 29 29 29 0a 20 20 20 * user #f))).
0890: 20 28 69 66 20 63 6f 6c 6f 72 0a 09 63 6f 6c 6f (if color..colo
08a0: 72 0a 09 28 6c 65 74 2a 20 28 28 63 6f 6c 6f 72 r..(let* ((color
08b0: 2d 6e 75 6d 20 28 2b 20 28 6c 65 6e 67 74 68 20 -num (+ (length
08c0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
08d0: 20 2a 75 73 65 72 2d 63 6f 6c 6f 72 73 2a 29 29 *user-colors*))
08e0: 20 31 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 1)).. (co
08f0: 6c 6f 72 20 20 20 20 20 28 6c 69 73 74 2d 72 65 lor (list-re
0900: 66 20 2a 75 73 65 72 2d 63 6f 6c 6f 72 73 2d 70 f *user-colors-p
0910: 61 6c 65 74 74 65 2a 20 63 6f 6c 6f 72 2d 6e 75 alette* color-nu
0920: 6d 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 m))).. (hash-ta
0930: 62 6c 65 2d 73 65 74 21 20 2a 75 73 65 72 2d 63 ble-set! *user-c
0940: 6f 6c 6f 72 73 2a 20 75 73 65 72 20 63 6f 6c 6f olors* user colo
0950: 72 29 0a 09 20 20 63 6f 6c 6f 72 29 29 29 29 0a r).. color)))).
0960: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4a 6f 62 =========.;; Job
09b0: 20 51 75 65 75 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d Queues.;;======
09c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a00: 0a 0a 3b 3b 20 6a 6f 62 73 0a 0a 28 64 65 66 69 ..;; jobs..(defi
0a10: 6e 65 20 28 6d 61 6b 65 2d 71 75 65 75 65 3a 6a ne (make-queue:j
0a20: 6f 62 29 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ob)(make-vector
0a30: 34 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 4)).(define-inli
0a40: 6e 65 20 28 71 75 65 75 65 3a 6a 6f 62 2d 67 65 ne (queue:job-ge
0a50: 74 2d 75 73 65 72 20 20 20 20 20 20 20 76 65 63 t-user vec
0a60: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
0a70: 20 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e vec 0)).(defin
0a80: 65 2d 69 6e 6c 69 6e 65 20 28 71 75 65 75 65 3a e-inline (queue:
0a90: 6a 6f 62 2d 67 65 74 2d 64 75 72 61 74 69 6f 6e job-get-duration
0aa0: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
0ab0: 6f 72 2d 72 65 66 20 20 76 65 63 20 31 29 29 0a or-ref vec 1)).
0ac0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
0ad0: 71 75 65 75 65 3a 6a 6f 62 2d 67 65 74 2d 6e 75 queue:job-get-nu
0ae0: 6d 2d 63 70 75 20 20 20 20 76 65 63 29 20 20 20 m-cpu vec)
0af0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
0b00: 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 2)).(define-in
0b10: 6c 69 6e 65 20 28 71 75 65 75 65 3a 6a 6f 62 2d line (queue:job-
0b20: 67 65 74 2d 6e 75 6d 2d 67 69 67 73 20 20 20 76 get-num-gigs v
0b30: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
0b40: 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 ef vec 3)).(def
0b50: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 71 75 65 75 ine-inline (queu
0b60: 65 3a 6a 6f 62 2d 73 65 74 2d 75 73 65 72 21 20 e:job-set-user!
0b70: 20 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 vec val)(ve
0b80: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 20 ctor-set! vec 0
0b90: 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e val)).(define-in
0ba0: 6c 69 6e 65 20 28 71 75 65 75 65 3a 6a 6f 62 2d line (queue:job-
0bb0: 73 65 74 2d 64 75 72 61 74 69 6f 6e 21 20 20 76 set-duration! v
0bc0: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
0bd0: 65 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 0a et! vec 1 val)).
0be0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
0bf0: 71 75 65 75 65 3a 6a 6f 62 2d 73 65 74 2d 6e 75 queue:job-set-nu
0c00: 6d 2d 63 70 75 21 20 20 20 76 65 63 20 76 61 6c m-cpu! vec val
0c10: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 )(vector-set! ve
0c20: 63 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69 6e c 2 val)).(defin
0c30: 65 2d 69 6e 6c 69 6e 65 20 28 71 75 65 75 65 3a e-inline (queue:
0c40: 6a 6f 62 2d 73 65 74 2d 6e 75 6d 2d 67 69 67 73 job-set-num-gigs
0c50: 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 ! vec val)(vect
0c60: 6f 72 2d 73 65 74 21 20 76 65 63 20 33 20 76 61 or-set! vec 3 va
0c70: 6c 29 29 0a 0a 3b 3b 20 61 64 64 20 61 20 6a 6f l))..;; add a jo
0c80: 62 20 74 6f 20 74 68 65 20 71 75 65 75 65 0a 3b b to the queue.;
0c90: 3b 0a 28 64 65 66 69 6e 65 20 28 61 64 64 2d 6a ;.(define (add-j
0ca0: 6f 62 20 71 75 65 75 65 2d 6e 61 6d 65 20 75 73 ob queue-name us
0cb0: 65 72 20 64 75 72 61 74 69 6f 6e 20 6e 75 6d 2d er duration num-
0cc0: 63 70 75 20 6e 75 6d 2d 67 69 67 73 29 0a 20 20 cpu num-gigs).
0cd0: 28 6c 65 74 2a 20 28 28 71 75 65 75 65 2d 64 61 (let* ((queue-da
0ce0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
0cf0: 66 2f 64 65 66 61 75 6c 74 20 2a 71 75 65 75 65 f/default *queue
0d00: 73 2a 20 71 75 65 75 65 2d 6e 61 6d 65 20 27 28 s* queue-name '(
0d10: 29 29 29 0a 09 20 28 6e 65 77 2d 71 75 65 75 65 ))).. (new-queue
0d20: 20 28 61 70 70 65 6e 64 20 0a 09 09 20 20 20 20 (append ...
0d30: 20 71 75 65 75 65 2d 64 61 74 0a 09 09 20 20 20 queue-dat...
0d40: 20 20 28 6c 69 73 74 20 28 76 65 63 74 6f 72 20 (list (vector
0d50: 75 73 65 72 20 64 75 72 61 74 69 6f 6e 20 6e 75 user duration nu
0d60: 6d 2d 63 70 75 20 6e 75 6d 2d 67 69 67 73 29 29 m-cpu num-gigs))
0d70: 29 29 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c ))). (hash-tabl
0d80: 65 2d 73 65 74 21 20 2a 71 75 65 75 65 73 2a 20 e-set! *queues*
0d90: 71 75 65 75 65 2d 6e 61 6d 65 20 6e 65 77 2d 71 queue-name new-q
0da0: 75 65 75 65 29 0a 20 20 28 64 72 61 77 2d 71 75 ueue). (draw-qu
0db0: 65 75 65 2d 6a 6f 62 73 20 71 75 65 75 65 2d 6e eue-jobs queue-n
0dc0: 61 6d 65 29 29 29 0a 0a 3b 3b 20 70 65 65 6b 20 ame)))..;; peek
0dd0: 66 6f 72 20 6a 6f 62 73 20 74 6f 20 64 6f 20 69 for jobs to do i
0de0: 6e 20 71 75 65 75 65 0a 3b 3b 0a 28 64 65 66 69 n queue.;;.(defi
0df0: 6e 65 20 28 70 65 65 6b 2d 6a 6f 62 20 71 75 65 ne (peek-job que
0e00: 75 65 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 ue-name). (let
0e10: 28 28 71 75 65 75 65 20 28 68 61 73 68 2d 74 61 ((queue (hash-ta
0e20: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
0e30: 2a 71 75 65 75 65 73 2a 20 71 75 65 75 65 2d 6e *queues* queue-n
0e40: 61 6d 65 20 27 28 29 29 29 29 0a 20 20 20 20 28 ame '()))). (
0e50: 69 66 20 28 6e 75 6c 6c 3f 20 71 75 65 75 65 29 if (null? queue)
0e60: 0a 09 23 66 0a 09 28 63 61 72 20 71 75 65 75 65 ..#f..(car queue
0e70: 29 29 29 29 0a 0a 3b 3b 20 74 61 6b 65 20 6a 6f ))))..;; take jo
0e80: 62 20 66 72 6f 6d 20 71 75 65 75 65 0a 3b 3b 0a b from queue.;;.
0e90: 28 64 65 66 69 6e 65 20 28 74 61 6b 65 2d 6a 6f (define (take-jo
0ea0: 62 20 71 75 65 75 65 2d 6e 61 6d 65 29 0a 20 20 b queue-name).
0eb0: 28 6c 65 74 20 28 28 71 75 65 75 65 20 28 68 61 (let ((queue (ha
0ec0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
0ed0: 61 75 6c 74 20 2a 71 75 65 75 65 73 2a 20 71 75 ault *queues* qu
0ee0: 65 75 65 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a eue-name '()))).
0ef0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 71 (if (null? q
0f00: 75 65 75 65 29 0a 09 23 66 0a 09 28 62 65 67 69 ueue)..#f..(begi
0f10: 6e 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 n.. (hash-table
0f20: 2d 73 65 74 21 20 2a 71 75 65 75 65 73 2a 20 71 -set! *queues* q
0f30: 75 65 75 65 2d 6e 61 6d 65 20 28 63 64 72 20 71 ueue-name (cdr q
0f40: 75 65 75 65 29 29 0a 09 20 20 28 64 72 61 77 2d ueue)).. (draw-
0f50: 71 75 65 75 65 2d 6a 6f 62 73 20 71 75 65 75 65 queue-jobs queue
0f60: 2d 6e 61 6d 65 29 0a 09 20 20 28 63 61 72 20 71 -name).. (car q
0f70: 75 65 75 65 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d ueue)))))..;;===
0f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fc0: 3d 3d 3d 0a 3b 3b 20 43 50 55 73 0a 3b 3b 3d 3d ===.;; CPUs.;;==
0fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1010: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d ====..(define (m
1020: 61 6b 65 2d 63 70 75 3a 64 61 74 29 28 6d 61 6b ake-cpu:dat)(mak
1030: 65 2d 76 65 63 74 6f 72 20 36 20 23 66 29 29 0a e-vector 6 #f)).
1040: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
1050: 63 70 75 3a 64 61 74 2d 67 65 74 2d 75 73 65 72 cpu:dat-get-user
1060: 20 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 vec) (v
1070: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 30 ector-ref vec 0
1080: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
1090: 65 20 28 63 70 75 3a 64 61 74 2d 67 65 74 2d 6a e (cpu:dat-get-j
10a0: 6f 62 2d 6c 65 6e 20 20 20 76 65 63 29 20 20 20 ob-len vec)
10b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
10c0: 63 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 1)).(define-in
10d0: 6c 69 6e 65 20 28 63 70 75 3a 64 61 74 2d 67 65 line (cpu:dat-ge
10e0: 74 2d 6e 75 6d 2d 63 70 75 20 20 20 76 65 63 29 t-num-cpu vec)
10f0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
1100: 20 76 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 vec 2)).(define
1110: 2d 69 6e 6c 69 6e 65 20 28 63 70 75 3a 64 61 74 -inline (cpu:dat
1120: 2d 67 65 74 2d 6d 65 6d 20 20 20 20 20 20 20 76 -get-mem v
1130: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
1140: 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 ef vec 3)).(def
1150: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 70 75 3a ine-inline (cpu:
1160: 64 61 74 2d 67 65 74 2d 78 20 20 20 20 20 20 20 dat-get-x
1170: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
1180: 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 0a 28 r-ref vec 4)).(
1190: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 define-inline (c
11a0: 70 75 3a 64 61 74 2d 67 65 74 2d 79 20 20 20 20 pu:dat-get-y
11b0: 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 vec) (ve
11c0: 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 35 29 ctor-ref vec 5)
11d0: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
11e0: 20 28 63 70 75 3a 64 61 74 2d 73 65 74 2d 75 73 (cpu:dat-set-us
11f0: 65 72 21 20 20 20 20 20 76 65 63 20 76 61 6c 29 er! vec val)
1200: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
1210: 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 0 val)).(define
1220: 2d 69 6e 6c 69 6e 65 20 28 63 70 75 3a 64 61 74 -inline (cpu:dat
1230: 2d 73 65 74 2d 6a 6f 62 2d 6c 65 6e 21 20 20 76 -set-job-len! v
1240: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
1250: 65 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 0a et! vec 1 val)).
1260: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
1270: 63 70 75 3a 64 61 74 2d 73 65 74 2d 6e 75 6d 2d cpu:dat-set-num-
1280: 63 70 75 21 20 20 76 65 63 20 76 61 6c 29 28 76 cpu! vec val)(v
1290: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 32 ector-set! vec 2
12a0: 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 val)).(define-i
12b0: 6e 6c 69 6e 65 20 28 63 70 75 3a 64 61 74 2d 73 nline (cpu:dat-s
12c0: 65 74 2d 6d 65 6d 21 20 20 20 20 20 20 76 65 63 et-mem! vec
12d0: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
12e0: 21 20 76 65 63 20 33 20 76 61 6c 29 29 0a 28 64 ! vec 3 val)).(d
12f0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 70 efine-inline (cp
1300: 75 3a 64 61 74 2d 73 65 74 2d 78 21 20 20 20 20 u:dat-set-x!
1310: 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 vec val)(vec
1320: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 34 20 76 tor-set! vec 4 v
1330: 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c al)).(define-inl
1340: 69 6e 65 20 28 63 70 75 3a 64 61 74 2d 73 65 74 ine (cpu:dat-set
1350: 2d 79 21 20 20 20 20 20 20 20 20 76 65 63 20 76 -y! vec v
1360: 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 al)(vector-set!
1370: 76 65 63 20 35 20 76 61 6c 29 29 0a 0a 28 64 65 vec 5 val))..(de
1380: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 70 75 fine-inline (cpu
1390: 3a 67 72 69 64 2d 67 65 74 2d 78 20 20 20 20 20 :grid-get-x
13a0: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
13b0: 6f 72 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a or-ref vec 0)).
13c0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
13d0: 63 70 75 3a 67 72 69 64 2d 67 65 74 2d 79 20 20 cpu:grid-get-y
13e0: 20 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 vec) (v
13f0: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 31 ector-ref vec 1
1400: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
1410: 65 20 28 63 70 75 3a 67 72 69 64 2d 67 65 74 2d e (cpu:grid-get-
1420: 77 20 20 20 20 20 20 20 20 76 65 63 29 20 20 20 w vec)
1430: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
1440: 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 2)).(define-in
1450: 6c 69 6e 65 20 28 63 70 75 3a 67 72 69 64 2d 67 line (cpu:grid-g
1460: 65 74 2d 67 61 70 20 20 20 20 20 20 76 65 63 29 et-gap vec)
1470: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
1480: 20 76 65 63 20 33 29 29 0a 28 64 65 66 69 6e 65 vec 3)).(define
1490: 2d 69 6e 6c 69 6e 65 20 28 63 70 75 3a 67 72 69 -inline (cpu:gri
14a0: 64 2d 67 65 74 2d 78 2d 6d 69 6e 20 20 20 20 76 d-get-x-min v
14b0: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
14c0: 65 66 20 20 76 65 63 20 34 29 29 0a 28 64 65 66 ef vec 4)).(def
14d0: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 70 75 3a ine-inline (cpu:
14e0: 67 72 69 64 2d 67 65 74 2d 78 2d 6d 61 78 20 20 grid-get-x-max
14f0: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
1500: 72 2d 72 65 66 20 20 76 65 63 20 35 29 29 0a 28 r-ref vec 5)).(
1510: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 define-inline (c
1520: 70 75 3a 67 72 69 64 2d 73 65 74 2d 78 21 20 20 pu:grid-set-x!
1530: 20 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 vec val)(ve
1540: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 20 ctor-set! vec 0
1550: 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e val)).(define-in
1560: 6c 69 6e 65 20 28 63 70 75 3a 67 72 69 64 2d 73 line (cpu:grid-s
1570: 65 74 2d 79 21 20 20 20 20 20 20 20 76 65 63 20 et-y! vec
1580: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
1590: 20 76 65 63 20 31 20 76 61 6c 29 29 0a 28 64 65 vec 1 val)).(de
15a0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 70 75 fine-inline (cpu
15b0: 3a 67 72 69 64 2d 73 65 74 2d 77 21 20 20 20 20 :grid-set-w!
15c0: 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 vec val)(vect
15d0: 6f 72 2d 73 65 74 21 20 76 65 63 20 32 20 76 61 or-set! vec 2 va
15e0: 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 l)).(define-inli
15f0: 6e 65 20 28 63 70 75 3a 67 72 69 64 2d 73 65 74 ne (cpu:grid-set
1600: 2d 67 61 70 21 20 20 20 20 20 76 65 63 20 76 61 -gap! vec va
1610: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
1620: 65 63 20 33 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 3 val)).(defi
1630: 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 70 75 3a 67 ne-inline (cpu:g
1640: 72 69 64 2d 73 65 74 2d 78 2d 6d 69 6e 21 20 20 rid-set-x-min!
1650: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
1660: 2d 73 65 74 21 20 76 65 63 20 34 20 76 61 6c 29 -set! vec 4 val)
1670: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
1680: 20 28 63 70 75 3a 67 72 69 64 2d 73 65 74 2d 78 (cpu:grid-set-x
1690: 2d 6d 61 78 21 20 20 20 76 65 63 20 76 61 6c 29 -max! vec val)
16a0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
16b0: 20 35 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 5 val))..(defin
16c0: 65 20 28 61 64 64 2d 63 70 75 20 6e 61 6d 65 20 e (add-cpu name
16d0: 6e 75 6d 2d 63 6f 72 65 73 20 6d 65 6d 29 0a 20 num-cores mem).
16e0: 20 28 6c 65 74 20 28 28 78 20 20 20 20 20 28 63 (let ((x (c
16f0: 70 75 3a 67 72 69 64 2d 67 65 74 2d 78 20 20 20 pu:grid-get-x
1700: 20 20 2a 63 70 75 2d 67 72 69 64 2a 29 29 0a 09 *cpu-grid*))..
1710: 28 79 20 20 20 20 20 28 63 70 75 3a 67 72 69 64 (y (cpu:grid
1720: 2d 67 65 74 2d 79 20 20 20 20 20 2a 63 70 75 2d -get-y *cpu-
1730: 67 72 69 64 2a 29 29 0a 09 28 64 65 6c 74 61 20 grid*))..(delta
1740: 28 2b 20 28 63 70 75 3a 67 72 69 64 2d 67 65 74 (+ (cpu:grid-get
1750: 2d 77 20 20 2a 63 70 75 2d 67 72 69 64 2a 29 28 -w *cpu-grid*)(
1760: 63 70 75 3a 67 72 69 64 2d 67 65 74 2d 67 61 70 cpu:grid-get-gap
1770: 20 2a 63 70 75 2d 67 72 69 64 2a 29 29 29 0a 09 *cpu-grid*)))..
1780: 28 78 2d 6d 61 78 20 28 63 70 75 3a 67 72 69 64 (x-max (cpu:grid
1790: 2d 67 65 74 2d 78 2d 6d 61 78 20 2a 63 70 75 2d -get-x-max *cpu-
17a0: 67 72 69 64 2a 29 29 29 0a 20 20 20 20 28 68 61 grid*))). (ha
17b0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 sh-table-set! *c
17c0: 70 75 73 2a 20 6e 61 6d 65 20 28 76 65 63 74 6f pus* name (vecto
17d0: 72 20 23 66 20 23 66 20 6e 75 6d 2d 63 6f 72 65 r #f #f num-core
17e0: 73 20 6d 65 6d 20 78 20 79 29 29 0a 20 20 20 20 s mem x y)).
17f0: 28 69 66 20 28 3e 20 78 20 78 2d 6d 61 78 29 0a (if (> x x-max).
1800: 09 28 62 65 67 69 6e 0a 09 20 20 28 63 70 75 3a .(begin.. (cpu:
1810: 67 72 69 64 2d 73 65 74 2d 78 21 20 2a 63 70 75 grid-set-x! *cpu
1820: 2d 67 72 69 64 2a 20 28 63 70 75 3a 67 72 69 64 -grid* (cpu:grid
1830: 2d 67 65 74 2d 78 2d 6d 69 6e 20 2a 63 70 75 2d -get-x-min *cpu-
1840: 67 72 69 64 2a 29 29 0a 09 20 20 28 63 70 75 3a grid*)).. (cpu:
1850: 67 72 69 64 2d 73 65 74 2d 79 21 20 2a 63 70 75 grid-set-y! *cpu
1860: 2d 67 72 69 64 2a 20 28 2b 20 79 20 64 65 6c 74 -grid* (+ y delt
1870: 61 29 29 29 0a 09 28 63 70 75 3a 67 72 69 64 2d a)))..(cpu:grid-
1880: 73 65 74 2d 78 21 20 2a 63 70 75 2d 67 72 69 64 set-x! *cpu-grid
1890: 2a 20 28 2b 20 78 20 64 65 6c 74 61 29 29 29 29 * (+ x delta))))
18a0: 29 0a 0a 3b 3b 20 64 72 61 77 20 67 72 65 79 20 )..;; draw grey
18b0: 62 6f 78 20 66 6f 72 20 65 61 63 68 20 63 70 75 box for each cpu
18c0: 20 6f 6e 20 6c 61 79 65 72 20 32 0a 3b 3b 20 6a on layer 2.;; j
18d0: 6f 62 73 20 61 72 65 20 64 72 61 77 6e 20 6f 6e obs are drawn on
18e0: 20 6c 61 79 65 72 20 31 0a 3b 3b 0a 28 64 65 66 layer 1.;;.(def
18f0: 69 6e 65 20 28 64 72 61 77 2d 63 70 75 73 29 20 ine (draw-cpus)
1900: 3b 3b 20 63 61 6c 6c 20 6f 6e 63 65 20 61 66 74 ;; call once aft
1910: 65 72 20 69 6e 69 74 27 69 6e 67 20 61 6c 6c 20 er init'ing all
1920: 63 70 75 73 0a 20 20 28 65 7a 78 2d 73 65 6c 65 cpus. (ezx-sele
1930: 63 74 2d 6c 61 79 65 72 20 2a 65 7a 78 2a 20 31 ct-layer *ezx* 1
1940: 29 0a 20 20 28 65 7a 78 2d 77 69 70 65 2d 6c 61 ). (ezx-wipe-la
1950: 79 65 72 20 20 20 2a 65 7a 78 2a 20 31 29 0a 20 yer *ezx* 1).
1960: 20 3b 3b 20 64 72 61 77 20 74 69 6d 65 20 61 74 ;; draw time at
1970: 20 75 70 70 65 72 20 72 69 67 68 74 0a 20 20 28 upper right. (
1980: 65 7a 78 2d 73 74 72 2d 32 64 20 2a 65 7a 78 2a ezx-str-2d *ezx*
1990: 20 32 30 20 32 30 20 28 73 65 63 6f 6e 64 73 2d 20 20 (seconds-
19a0: 3e 68 3a 6d 3a 73 20 2a 6e 6f 77 2a 29 20 2a 62 >h:m:s *now*) *b
19b0: 6c 61 63 6b 2a 29 0a 20 20 28 66 6f 72 2d 65 61 lack*). (for-ea
19c0: 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 63 ch. (lambda (c
19d0: 70 75 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28 pu). (let ((
19e0: 78 20 28 63 70 75 3a 64 61 74 2d 67 65 74 2d 78 x (cpu:dat-get-x
19f0: 20 63 70 75 29 29 0a 09 20 20 20 28 79 20 28 63 cpu)).. (y (c
1a00: 70 75 3a 64 61 74 2d 67 65 74 2d 79 20 63 70 75 pu:dat-get-y cpu
1a10: 29 29 0a 09 20 20 20 28 77 20 28 63 70 75 3a 67 )).. (w (cpu:g
1a20: 72 69 64 2d 67 65 74 2d 77 20 2a 63 70 75 2d 67 rid-get-w *cpu-g
1a30: 72 69 64 2a 29 29 29 0a 20 20 20 20 20 20 20 28 rid*))). (
1a40: 65 7a 78 2d 72 65 63 74 2d 32 64 20 2a 65 7a 78 ezx-rect-2d *ezx
1a50: 2a 20 78 20 79 20 28 2b 20 78 20 77 29 20 28 2b * x y (+ x w) (+
1a60: 20 79 20 77 29 20 2a 67 72 65 79 2a 20 31 29 29 y w) *grey* 1))
1a70: 29 0a 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ). (hash-table
1a80: 2d 76 61 6c 75 65 73 20 2a 63 70 75 73 2a 29 29 -values *cpus*))
1a90: 0a 20 20 28 65 7a 78 2d 72 65 64 72 61 77 20 2a . (ezx-redraw *
1aa0: 65 7a 78 2a 29 29 0a 0a 28 64 65 66 69 6e 65 20 ezx*))..(define
1ab0: 28 64 72 61 77 2d 6a 6f 62 73 29 0a 20 20 3b 3b (draw-jobs). ;;
1ac0: 20 28 64 72 61 77 2d 63 70 75 73 29 0a 20 20 28 (draw-cpus). (
1ad0: 65 7a 78 2d 73 65 6c 65 63 74 2d 6c 61 79 65 72 ezx-select-layer
1ae0: 20 2a 65 7a 78 2a 20 32 29 0a 20 20 28 65 7a 78 *ezx* 2). (ezx
1af0: 2d 77 69 70 65 2d 6c 61 79 65 72 20 20 20 2a 65 -wipe-layer *e
1b00: 7a 78 2a 20 32 29 0a 20 20 28 66 6f 72 2d 65 61 zx* 2). (for-ea
1b10: 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 63 ch. (lambda (c
1b20: 70 75 29 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 pu). (let* (
1b30: 28 78 20 28 63 70 75 3a 64 61 74 2d 67 65 74 2d (x (cpu:dat-get-
1b40: 78 20 63 70 75 29 29 0a 09 20 20 20 20 28 79 20 x cpu)).. (y
1b50: 28 63 70 75 3a 64 61 74 2d 67 65 74 2d 79 20 63 (cpu:dat-get-y c
1b60: 70 75 29 29 0a 09 20 20 20 20 28 77 20 28 63 70 pu)).. (w (cp
1b70: 75 3a 67 72 69 64 2d 67 65 74 2d 77 20 2a 63 70 u:grid-get-w *cp
1b80: 75 2d 67 72 69 64 2a 29 29 0a 09 20 20 20 20 28 u-grid*)).. (
1b90: 75 20 28 63 70 75 3a 64 61 74 2d 67 65 74 2d 75 u (cpu:dat-get-u
1ba0: 73 65 72 20 63 70 75 29 29 29 0a 20 20 20 20 20 ser cpu))).
1bb0: 20 20 28 69 66 20 75 20 3b 3b 20 6a 6f 62 20 72 (if u ;; job r
1bc0: 75 6e 6e 69 6e 67 20 69 66 20 6e 6f 74 20 23 66 unning if not #f
1bd0: 0a 09 20 20 20 28 6c 65 74 20 28 28 63 6f 6c 6f .. (let ((colo
1be0: 72 20 28 67 65 74 2d 75 73 65 72 2d 63 6f 6c 6f r (get-user-colo
1bf0: 72 20 75 29 29 29 0a 09 20 20 20 20 20 28 65 7a r u))).. (ez
1c00: 78 2d 66 69 6c 6c 72 65 63 74 2d 32 64 20 2a 65 x-fillrect-2d *e
1c10: 7a 78 2a 20 28 2b 20 78 20 32 29 28 2b 20 32 20 zx* (+ x 2)(+ 2
1c20: 79 29 28 2b 20 78 20 39 29 20 28 2b 20 79 20 39 y)(+ x 9) (+ y 9
1c30: 29 20 63 6f 6c 6f 72 29 29 29 29 29 0a 20 20 20 ) color))))).
1c40: 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c 75 (hash-table-valu
1c50: 65 73 20 2a 63 70 75 73 2a 29 29 0a 20 20 28 65 es *cpus*)). (e
1c60: 7a 78 2d 72 65 64 72 61 77 20 2a 65 7a 78 2a 29 zx-redraw *ezx*)
1c70: 29 0a 0a 28 64 65 66 69 6e 65 20 28 65 6e 64 2d )..(define (end-
1c80: 6a 6f 62 20 63 70 75 2d 6e 61 6d 65 20 75 73 65 job cpu-name use
1c90: 72 29 0a 20 20 28 6c 65 74 20 28 28 63 70 75 20 r). (let ((cpu
1ca0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1cb0: 64 65 66 61 75 6c 74 20 2a 63 70 75 73 2a 20 63 default *cpus* c
1cc0: 70 75 2d 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 pu-name #f))).
1cd0: 20 20 28 69 66 20 63 70 75 0a 09 28 6c 65 74 20 (if cpu..(let
1ce0: 28 28 63 75 72 72 2d 75 73 65 72 20 28 63 70 75 ((curr-user (cpu
1cf0: 3a 64 61 74 2d 67 65 74 2d 75 73 65 72 20 63 70 :dat-get-user cp
1d00: 75 29 29 29 20 3b 3b 20 69 66 20 69 74 20 69 73 u))) ;; if it is
1d10: 20 61 20 75 73 65 72 20 6e 61 6d 65 20 74 68 65 a user name the
1d20: 6e 20 6a 6f 62 20 69 73 20 6e 6f 74 20 64 6f 6e n job is not don
1d30: 65 20 2d 20 65 72 72 6f 72 0a 09 20 20 28 69 66 e - error.. (if
1d40: 20 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 2d 75 (or (not curr-u
1d50: 73 65 72 29 0a 09 09 20 20 28 6e 6f 74 20 28 65 ser)... (not (e
1d60: 71 75 61 6c 3f 20 63 75 72 72 2d 75 73 65 72 20 qual? curr-user
1d70: 75 73 65 72 29 29 29 0a 09 20 20 20 20 20 20 28 user))).. (
1d80: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 63 70 print "ERROR: cp
1d90: 75 20 22 20 63 70 75 2d 6e 61 6d 65 20 22 20 6e u " cpu-name " n
1da0: 6f 74 20 72 75 6e 6e 69 6e 67 20 6a 6f 62 20 66 ot running job f
1db0: 6f 72 20 22 20 75 73 65 72 20 22 21 22 29 0a 09 or " user "!")..
1dc0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
1dd0: 63 70 75 3a 64 61 74 2d 73 65 74 2d 75 73 65 72 cpu:dat-set-user
1de0: 21 20 20 20 20 63 70 75 20 23 66 29 0a 09 09 28 ! cpu #f)...(
1df0: 63 70 75 3a 64 61 74 2d 73 65 74 2d 6a 6f 62 2d cpu:dat-set-job-
1e00: 6c 65 6e 21 20 63 70 75 20 23 66 29 0a 09 09 28 len! cpu #f)...(
1e10: 64 72 61 77 2d 6a 6f 62 73 29 29 29 29 20 3b 3b draw-jobs)))) ;;
1e20: 20 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 hash-table-set!
1e30: 20 2a 63 70 75 73 2a 20 63 70 75 2d 6e 61 6d 65 *cpus* cpu-name
1e40: 20 28 6d 61 6b 65 2d 63 70 75 3a 64 61 74 29 29 (make-cpu:dat))
1e50: 29 29 0a 09 28 70 72 69 6e 74 20 22 45 52 52 4f ))..(print "ERRO
1e60: 52 3a 20 6e 6f 20 63 70 75 20 22 20 63 70 75 2d R: no cpu " cpu-
1e70: 6e 61 6d 65 20 22 20 66 6f 75 6e 64 2e 20 45 6e name " found. En
1e80: 73 75 72 65 20 69 74 20 69 73 20 72 65 67 69 73 sure it is regis
1e90: 74 65 72 65 64 20 62 65 66 6f 72 65 20 61 64 64 tered before add
1ea0: 72 65 73 73 69 6e 67 20 69 74 2e 22 29 29 29 29 ressing it."))))
1eb0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 6a ..(define (run-j
1ec0: 6f 62 20 63 70 75 2d 6e 61 6d 65 20 6a 6f 62 29 ob cpu-name job)
1ed0: 0a 20 20 28 6c 65 74 2a 20 28 28 75 73 65 72 20 . (let* ((user
1ee0: 20 20 20 28 71 75 65 75 65 3a 6a 6f 62 2d 67 65 (queue:job-ge
1ef0: 74 2d 75 73 65 72 20 20 20 20 20 6a 6f 62 29 29 t-user job))
1f00: 0a 09 20 28 6a 6f 62 2d 6c 65 6e 20 28 71 75 65 .. (job-len (que
1f10: 75 65 3a 6a 6f 62 2d 67 65 74 2d 64 75 72 61 74 ue:job-get-durat
1f20: 69 6f 6e 20 6a 6f 62 29 29 0a 09 20 28 63 70 75 ion job)).. (cpu
1f30: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
1f40: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 70 -ref/default *cp
1f50: 75 73 2a 20 63 70 75 2d 6e 61 6d 65 20 23 66 29 us* cpu-name #f)
1f60: 29 29 0a 20 20 20 20 28 69 66 20 63 70 75 0a 09 )). (if cpu..
1f70: 28 6c 65 74 20 28 28 63 75 72 72 2d 75 73 65 72 (let ((curr-user
1f80: 20 28 63 70 75 3a 64 61 74 2d 67 65 74 2d 75 73 (cpu:dat-get-us
1f90: 65 72 20 63 70 75 29 29 29 20 3b 3b 20 69 66 20 er cpu))) ;; if
1fa0: 69 74 20 69 73 20 61 20 75 73 65 72 20 6e 61 6d it is a user nam
1fb0: 65 20 74 68 65 6e 20 6a 6f 62 20 69 73 20 6e 6f e then job is no
1fc0: 74 20 64 6f 6e 65 20 2d 20 65 72 72 6f 72 0a 09 t done - error..
1fd0: 20 20 28 69 66 20 63 75 72 72 2d 75 73 65 72 0a (if curr-user.
1fe0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
1ff0: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 63 (print "ERROR: c
2000: 70 75 20 61 6c 72 65 61 64 79 20 62 75 73 79 21 pu already busy!
2010: 20 41 64 64 69 6e 67 20 6d 6f 72 65 20 6a 6f 62 Adding more job
2020: 73 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 20 s not supported
2030: 79 65 74 2e 20 22 20 63 70 75 2d 6e 61 6d 65 29 yet. " cpu-name)
2040: 0a 09 09 23 66 29 0a 09 20 20 20 20 20 20 28 62 ...#f).. (b
2050: 65 67 69 6e 0a 09 09 28 63 70 75 3a 64 61 74 2d egin...(cpu:dat-
2060: 73 65 74 2d 75 73 65 72 21 20 20 20 20 63 70 75 set-user! cpu
2070: 20 75 73 65 72 29 0a 09 09 28 63 70 75 3a 64 61 user)...(cpu:da
2080: 74 2d 73 65 74 2d 6a 6f 62 2d 6c 65 6e 21 20 63 t-set-job-len! c
2090: 70 75 20 6a 6f 62 2d 6c 65 6e 29 0a 09 09 28 64 pu job-len)...(d
20a0: 72 61 77 2d 6a 6f 62 73 29 0a 09 09 28 68 61 73 raw-jobs)...(has
20b0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 70 h-table-set! *cp
20c0: 75 73 2a 20 63 70 75 2d 6e 61 6d 65 20 63 70 75 us* cpu-name cpu
20d0: 29 0a 09 09 28 65 76 65 6e 74 20 28 2b 20 2a 6e )...(event (+ *n
20e0: 6f 77 2a 20 6a 6f 62 2d 6c 65 6e 29 20 28 6c 61 ow* job-len) (la
20f0: 6d 62 64 61 20 28 29 28 65 6e 64 2d 6a 6f 62 20 mbda ()(end-job
2100: 63 70 75 2d 6e 61 6d 65 20 75 73 65 72 29 29 29 cpu-name user)))
2110: 0a 09 09 23 74 29 29 29 0a 09 23 66 29 29 29 0a ...#t)))..#f))).
2120: 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 67 65 .(define (ge
2130: 74 2d 63 70 75 29 0a 20 20 28 6c 65 74 20 28 28 t-cpu). (let ((
2140: 61 6c 6c 2d 63 70 75 73 20 28 68 61 73 68 2d 74 all-cpus (hash-t
2150: 61 62 6c 65 2d 6b 65 79 73 20 2a 63 70 75 73 2a able-keys *cpus*
2160: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c ))). (if (nul
2170: 6c 3f 20 61 6c 6c 2d 63 70 75 73 29 20 0a 09 23 l? all-cpus) ..#
2180: 66 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 f..(let loop ((h
2190: 65 64 20 28 63 61 72 20 61 6c 6c 2d 63 70 75 73 ed (car all-cpus
21a0: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 ))... (tal (cd
21b0: 72 20 61 6c 6c 2d 63 70 75 73 29 29 29 0a 09 20 r all-cpus)))..
21c0: 20 28 69 66 20 28 63 70 75 3a 64 61 74 2d 67 65 (if (cpu:dat-ge
21d0: 74 2d 75 73 65 72 20 28 68 61 73 68 2d 74 61 62 t-user (hash-tab
21e0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
21f0: 63 70 75 73 2a 20 68 65 64 20 27 28 23 66 20 23 cpus* hed '(#f #
2200: 66 29 29 29 20 3b 3b 20 69 66 20 75 73 65 72 20 f))) ;; if user
2210: 69 73 20 23 66 20 74 68 65 6e 20 63 70 75 20 69 is #f then cpu i
2220: 73 20 61 76 61 69 6c 61 62 6c 65 0a 09 20 20 20 s available..
2230: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
2240: 6c 29 0a 09 09 20 20 23 66 0a 09 09 20 20 28 6c l)... #f... (l
2250: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
2260: 72 20 74 61 6c 29 29 29 0a 09 20 20 20 20 20 20 r tal)))..
2270: 68 65 64 29 29 29 29 29 0a 20 20 0a 3b 3b 3d 3d hed))))). .;;==
2280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22c0: 3d 3d 3d 3d 0a 3b 3b 20 41 6e 69 6d 61 74 69 6f ====.;; Animatio
22d0: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
22e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 6d ==========..;; m
2320: 61 6b 65 2d 76 65 63 74 6f 72 2d 72 65 63 6f 72 ake-vector-recor
2330: 64 20 20 71 75 65 75 65 20 73 70 65 63 20 78 20 d queue spec x
2340: 79 20 64 65 6c 74 61 2d 79 20 68 65 69 67 68 74 y delta-y height
2350: 20 6c 65 6e 67 74 68 0a 28 64 65 66 69 6e 65 20 length.(define
2360: 28 6d 61 6b 65 2d 71 75 65 75 65 3a 73 70 65 63 (make-queue:spec
2370: 29 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 35 29 )(make-vector 5)
2380: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
2390: 20 28 71 75 65 75 65 3a 73 70 65 63 2d 67 65 74 (queue:spec-get
23a0: 2d 78 20 20 20 20 20 20 20 20 20 76 65 63 29 20 -x vec)
23b0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 (vector-ref
23c0: 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e 65 2d vec 0)).(define-
23d0: 69 6e 6c 69 6e 65 20 28 71 75 65 75 65 3a 73 70 inline (queue:sp
23e0: 65 63 2d 67 65 74 2d 79 20 20 20 20 20 20 20 20 ec-get-y
23f0: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 vec) (vector
2400: 2d 72 65 66 20 20 76 65 63 20 31 29 29 0a 28 64 -ref vec 1)).(d
2410: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 71 75 efine-inline (qu
2420: 65 75 65 3a 73 70 65 63 2d 67 65 74 2d 64 65 6c eue:spec-get-del
2430: 74 61 2d 79 20 20 20 76 65 63 29 20 20 20 20 28 ta-y vec) (
2440: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
2450: 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 2)).(define-inli
2460: 6e 65 20 28 71 75 65 75 65 3a 73 70 65 63 2d 67 ne (queue:spec-g
2470: 65 74 2d 68 65 69 67 68 74 20 20 20 20 76 65 63 et-height vec
2480: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
2490: 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 69 6e vec 3)).(defin
24a0: 65 2d 69 6e 6c 69 6e 65 20 28 71 75 65 75 65 3a e-inline (queue:
24b0: 73 70 65 63 2d 67 65 74 2d 6c 65 6e 67 74 68 20 spec-get-length
24c0: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
24d0: 6f 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 0a or-ref vec 4)).
24e0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
24f0: 71 75 65 75 65 3a 73 70 65 63 2d 73 65 74 2d 78 queue:spec-set-x
2500: 21 20 20 20 20 20 20 20 20 76 65 63 20 76 61 6c ! vec val
2510: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 )(vector-set! ve
2520: 63 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 6e c 0 val)).(defin
2530: 65 2d 69 6e 6c 69 6e 65 20 28 71 75 65 75 65 3a e-inline (queue:
2540: 73 70 65 63 2d 73 65 74 2d 79 21 20 20 20 20 20 spec-set-y!
2550: 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 vec val)(vect
2560: 6f 72 2d 73 65 74 21 20 76 65 63 20 31 20 76 61 or-set! vec 1 va
2570: 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 l)).(define-inli
2580: 6e 65 20 28 71 75 65 75 65 3a 73 70 65 63 2d 73 ne (queue:spec-s
2590: 65 74 2d 64 65 6c 74 61 2d 79 21 20 20 76 65 63 et-delta-y! vec
25a0: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
25b0: 21 20 76 65 63 20 32 20 76 61 6c 29 29 0a 28 64 ! vec 2 val)).(d
25c0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 71 75 efine-inline (qu
25d0: 65 75 65 3a 73 70 65 63 2d 73 65 74 2d 68 65 69 eue:spec-set-hei
25e0: 67 68 74 21 20 20 20 76 65 63 20 76 61 6c 29 28 ght! vec val)(
25f0: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
2600: 33 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 3 val)).(define-
2610: 69 6e 6c 69 6e 65 20 28 71 75 65 75 65 3a 73 70 inline (queue:sp
2620: 65 63 2d 73 65 74 2d 6c 65 6e 67 74 68 21 20 20 ec-set-length!
2630: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
2640: 2d 73 65 74 21 20 76 65 63 20 34 20 76 61 6c 29 -set! vec 4 val)
2650: 29 0a 0a 3b 3b 20 71 75 65 75 65 73 20 61 72 65 )..;; queues are
2660: 20 64 72 61 77 6e 20 6f 6e 20 6c 61 79 65 72 20 drawn on layer
2670: 33 20 62 75 74 20 62 6f 78 65 73 20 28 6a 6f 62 3 but boxes (job
2680: 73 29 20 61 72 65 20 64 72 61 77 6e 20 6f 6e 20 s) are drawn on
2690: 74 68 65 20 6e 75 6d 62 65 72 65 64 20 6c 61 79 the numbered lay
26a0: 65 72 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 er.;;.(define (d
26b0: 72 61 77 2d 71 75 65 75 65 73 29 0a 20 20 28 6c raw-queues). (l
26c0: 65 74 2a 20 28 28 74 65 78 74 2d 6f 66 66 73 65 et* ((text-offse
26d0: 74 20 33 29 0a 09 20 28 71 75 65 75 65 2d 6e 61 t 3).. (queue-na
26e0: 6d 65 73 20 28 73 6f 72 74 20 28 68 61 73 68 2d mes (sort (hash-
26f0: 74 61 62 6c 65 2d 6b 65 79 73 20 2a 71 75 65 75 table-keys *queu
2700: 65 73 2a 29 20 73 74 72 69 6e 67 3e 3d 3f 29 29 es*) string>=?))
2710: 0a 09 20 28 73 74 61 72 74 2d 78 20 28 76 65 63 .. (start-x (vec
2720: 74 6f 72 2d 72 65 66 20 2a 71 75 65 75 65 2d 73 tor-ref *queue-s
2730: 70 65 63 2a 20 30 29 29 0a 09 20 28 74 65 78 74 pec* 0)).. (text
2740: 2d 78 20 20 28 2b 20 73 74 61 72 74 2d 78 20 74 -x (+ start-x t
2750: 65 78 74 2d 6f 66 66 73 65 74 29 29 0a 09 20 28 ext-offset)).. (
2760: 64 65 6c 74 61 2d 79 20 28 76 65 63 74 6f 72 2d delta-y (vector-
2770: 72 65 66 20 2a 71 75 65 75 65 2d 73 70 65 63 2a ref *queue-spec*
2780: 20 31 29 29 0a 09 20 28 64 65 6c 74 61 2d 78 20 1)).. (delta-x
2790: 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 71 75 65 (vector-ref *que
27a0: 75 65 2d 73 70 65 63 2a 20 32 29 29 0a 09 20 28 ue-spec* 2)).. (
27b0: 68 65 69 67 68 74 20 20 28 76 65 63 74 6f 72 2d height (vector-
27c0: 72 65 66 20 2a 71 75 65 75 65 2d 73 70 65 63 2a ref *queue-spec*
27d0: 20 33 29 29 0a 09 20 28 6c 65 6e 67 74 68 20 20 3)).. (length
27e0: 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 71 75 65 (vector-ref *que
27f0: 75 65 2d 73 70 65 63 2a 20 34 29 29 0a 09 20 28 ue-spec* 4)).. (
2800: 65 6e 64 2d 78 20 20 20 28 2b 20 73 74 61 72 74 end-x (+ start
2810: 2d 78 20 6c 65 6e 67 74 68 29 29 29 0a 20 20 20 -x length))).
2820: 20 28 65 7a 78 2d 73 65 6c 65 63 74 2d 6c 61 79 (ezx-select-lay
2830: 65 72 20 2a 65 7a 78 2a 20 33 29 0a 20 20 20 20 er *ezx* 3).
2840: 28 65 7a 78 2d 77 69 70 65 2d 6c 61 79 65 72 20 (ezx-wipe-layer
2850: 20 20 2a 65 7a 78 2a 20 33 29 0a 20 20 20 20 28 *ezx* 3). (
2860: 6c 65 74 20 6c 6f 6f 70 20 28 28 79 20 20 20 20 let loop ((y
2870: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a (vector-ref *
2880: 71 75 65 75 65 2d 73 70 65 63 2a 20 31 29 29 0a queue-spec* 1)).
2890: 09 20 20 20 20 20 20 20 28 71 6e 61 6d 65 20 20 . (qname
28a0: 20 28 63 61 72 20 71 75 65 75 65 2d 6e 61 6d 65 (car queue-name
28b0: 73 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 69 s)).. (tai
28c0: 6c 20 20 20 20 28 63 64 72 20 71 75 65 75 65 2d l (cdr queue-
28d0: 6e 61 6d 65 73 29 29 0a 09 20 20 20 20 20 20 20 names))..
28e0: 28 6c 61 79 65 72 20 20 20 34 29 29 0a 20 20 20 (layer 4)).
28f0: 20 20 20 28 70 72 69 6e 74 20 22 44 72 61 77 69 (print "Drawi
2900: 6e 67 20 71 75 65 75 65 20 61 74 20 78 3d 22 20 ng queue at x="
2910: 73 74 61 72 74 2d 78 20 22 2c 20 79 3d 22 20 79 start-x ", y=" y
2920: 29 0a 20 20 20 20 20 20 28 65 7a 78 2d 66 69 6c ). (ezx-fil
2930: 6c 72 65 63 74 2d 32 64 20 20 2a 65 7a 78 2a 20 lrect-2d *ezx*
2940: 73 74 61 72 74 2d 78 20 79 20 65 6e 64 2d 78 20 start-x y end-x
2950: 28 2b 20 79 20 68 65 69 67 68 74 29 20 2a 62 72 (+ y height) *br
2960: 6f 77 6e 2a 29 0a 20 20 20 20 20 20 28 65 7a 78 own*). (ezx
2970: 2d 73 74 72 2d 32 64 20 20 20 20 20 20 20 2a 65 -str-2d *e
2980: 7a 78 2a 20 74 65 78 74 2d 78 20 28 2d 20 28 2b zx* text-x (- (+
2990: 20 79 20 68 65 69 67 68 74 29 20 74 65 78 74 2d y height) text-
29a0: 6f 66 66 73 65 74 29 20 71 6e 61 6d 65 20 2a 77 offset) qname *w
29b0: 68 69 74 65 2a 29 0a 20 20 20 20 20 20 28 68 61 hite*). (ha
29c0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 6f sh-table-set! *o
29d0: 62 6a 2d 6c 6f 63 61 74 69 6f 6e 73 2a 20 71 6e bj-locations* qn
29e0: 61 6d 65 20 28 6c 69 73 74 20 73 74 61 72 74 2d ame (list start-
29f0: 78 20 79 20 6c 61 79 65 72 29 29 0a 20 20 20 20 x y layer)).
2a00: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
2a10: 3f 20 74 61 69 6c 29 29 0a 09 20 20 28 6c 6f 6f ? tail)).. (loo
2a20: 70 20 28 2b 20 79 20 68 65 69 67 68 74 20 64 65 p (+ y height de
2a30: 6c 74 61 2d 79 29 0a 09 09 28 63 61 72 20 74 61 lta-y)...(car ta
2a40: 69 6c 29 0a 09 09 28 63 64 72 20 74 61 69 6c 29 il)...(cdr tail)
2a50: 0a 09 09 28 2b 20 20 6c 61 79 65 72 20 31 29 29 ...(+ layer 1))
2a60: 29 29 0a 20 20 20 20 28 65 7a 78 2d 72 65 64 72 )). (ezx-redr
2a70: 61 77 20 2a 65 7a 78 2a 29 29 29 0a 0a 3b 3b 20 aw *ezx*)))..;;
2a80: 63 6f 6d 70 72 65 73 73 20 71 75 65 75 65 20 64 compress queue d
2a90: 61 74 61 20 74 6f 20 28 76 65 63 74 6f 72 20 75 ata to (vector u
2aa0: 73 65 72 20 63 6f 75 6e 74 29 20 6c 69 73 74 0a ser count) list.
2ab0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 72 61 77 ;;.(define (draw
2ac0: 2d 71 75 65 75 65 2d 63 6f 6d 70 72 65 73 73 2d -queue-compress-
2ad0: 71 75 65 75 65 2d 64 61 74 61 20 71 75 65 75 65 queue-data queue
2ae0: 2d 64 61 74 29 0a 20 20 28 6c 65 74 20 6c 6f 6f -dat). (let loo
2af0: 70 20 28 28 68 65 64 20 20 28 63 61 72 20 71 75 p ((hed (car qu
2b00: 65 75 65 2d 64 61 74 29 29 0a 09 20 20 20 20 20 eue-dat))..
2b10: 28 74 61 6c 20 20 28 63 64 72 20 71 75 65 75 65 (tal (cdr queue
2b20: 2d 64 61 74 29 29 0a 09 20 20 20 20 20 28 63 75 -dat)).. (cu
2b30: 72 72 20 23 66 29 20 3b 3b 20 28 76 65 63 74 6f rr #f) ;; (vecto
2b40: 72 20 6e 61 6d 65 20 63 6f 75 6e 74 29 0a 09 20 r name count)..
2b50: 20 20 20 20 28 72 65 73 20 20 27 28 29 29 29 0a (res '())).
2b60: 20 20 20 20 28 6c 65 74 20 28 28 75 73 65 72 20 (let ((user
2b70: 28 71 75 65 75 65 3a 6a 6f 62 2d 67 65 74 2d 75 (queue:job-get-u
2b80: 73 65 72 20 68 65 64 29 29 29 0a 20 20 20 20 20 ser hed))).
2b90: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 (cond. ((
2ba0: 6e 6f 74 20 63 75 72 72 29 20 3b 3b 20 66 69 72 not curr) ;; fir
2bb0: 73 74 20 74 69 6d 65 20 74 68 72 6f 75 67 68 20 st time through
2bc0: 6f 6e 6c 79 3f 0a 09 28 69 66 20 28 6e 75 6c 6c only?..(if (null
2bd0: 3f 20 74 61 6c 29 0a 09 20 20 20 20 28 61 70 70 ? tal).. (app
2be0: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 28 76 end res (list (v
2bf0: 65 63 74 6f 72 20 75 73 65 72 20 31 29 29 29 0a ector user 1))).
2c00: 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 . (loop (car
2c10: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 76 65 tal)(cdr tal)(ve
2c20: 63 74 6f 72 20 75 73 65 72 20 31 29 20 72 65 73 ctor user 1) res
2c30: 29 29 29 0a 20 20 20 20 20 20 20 28 28 65 71 75 ))). ((equ
2c40: 61 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 al? (vector-ref
2c50: 63 75 72 72 20 30 29 20 75 73 65 72 29 20 0a 09 curr 0) user) ..
2c60: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 63 75 72 (vector-set! cur
2c70: 72 20 31 20 28 2b 20 28 76 65 63 74 6f 72 2d 72 r 1 (+ (vector-r
2c80: 65 66 20 63 75 72 72 20 31 29 20 31 29 29 0a 09 ef curr 1) 1))..
2c90: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal).
2ca0: 09 20 20 20 20 28 61 70 70 65 6e 64 20 72 65 73 . (append res
2cb0: 20 28 6c 69 73 74 20 63 75 72 72 29 29 0a 09 20 (list curr))..
2cc0: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
2cd0: 6c 29 28 63 64 72 20 74 61 6c 29 20 63 75 72 72 l)(cdr tal) curr
2ce0: 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 28 res))). (
2cf0: 65 6c 73 65 20 3b 3b 20 6e 61 6d 65 73 20 61 72 else ;; names ar
2d00: 65 20 64 69 66 66 65 72 65 6e 74 2c 20 61 64 64 e different, add
2d10: 20 63 75 72 72 20 74 6f 20 71 75 65 75 65 20 61 curr to queue a
2d20: 6e 64 20 63 72 65 61 74 65 20 6e 65 77 20 63 75 nd create new cu
2d30: 72 72 0a 09 28 6c 65 74 20 28 28 6e 65 77 63 75 rr..(let ((newcu
2d40: 72 72 20 28 76 65 63 74 6f 72 20 75 73 65 72 20 rr (vector user
2d50: 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 1))).. (if (nul
2d60: 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 28 l? tal).. (
2d70: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
2d80: 20 6e 65 77 63 75 72 72 29 29 0a 09 20 20 20 20 newcurr))..
2d90: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
2da0: 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 63 75 )(cdr tal) newcu
2db0: 72 72 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 rr (append res (
2dc0: 6c 69 73 74 20 63 75 72 72 29 29 29 29 29 29 29 list curr)))))))
2dd0: 29 29 29 0a 0a 3b 3b 20 64 72 61 77 20 6a 6f 62 )))..;; draw job
2de0: 73 20 66 6f 72 20 61 20 67 69 76 65 6e 20 71 75 s for a given qu
2df0: 65 75 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 eue.;;.(define (
2e00: 64 72 61 77 2d 71 75 65 75 65 2d 6a 6f 62 73 20 draw-queue-jobs
2e10: 71 75 65 75 65 2d 6e 61 6d 65 29 0a 20 20 28 6c queue-name). (l
2e20: 65 74 2a 20 28 28 71 75 65 75 65 2d 64 61 74 20 et* ((queue-dat
2e30: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
2e40: 64 65 66 61 75 6c 74 20 2a 71 75 65 75 65 73 2a default *queues*
2e50: 20 20 20 20 20 20 20 20 71 75 65 75 65 2d 6e 61 queue-na
2e60: 6d 65 20 23 66 29 29 20 20 3b 3b 20 6c 69 73 74 me #f)) ;; list
2e70: 20 6f 66 20 6a 6f 62 73 20 69 6e 20 74 68 65 20 of jobs in the
2e80: 71 75 65 75 65 0a 09 20 28 6f 62 6a 2d 73 70 65 queue.. (obj-spe
2e90: 63 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 c (hash-table-r
2ea0: 65 66 2f 64 65 66 61 75 6c 74 20 2a 6f 62 6a 2d ef/default *obj-
2eb0: 6c 6f 63 61 74 69 6f 6e 73 2a 20 71 75 65 75 65 locations* queue
2ec0: 2d 6e 61 6d 65 20 23 66 29 29 29 20 20 3b 3b 20 -name #f))) ;;
2ed0: 78 2c 20 79 20 65 74 63 2e 20 6f 66 20 74 68 65 x, y etc. of the
2ee0: 20 64 72 61 77 6e 20 71 75 65 75 65 0a 20 20 20 drawn queue.
2ef0: 20 28 69 66 20 6f 62 6a 2d 73 70 65 63 0a 09 28 (if obj-spec..(
2f00: 6c 65 74 20 28 28 6f 72 69 67 69 6e 2d 78 20 20 let ((origin-x
2f10: 28 6c 69 73 74 2d 72 65 66 20 6f 62 6a 2d 73 70 (list-ref obj-sp
2f20: 65 63 20 30 29 29 0a 09 20 20 20 20 20 20 28 6f ec 0)).. (o
2f30: 72 69 67 69 6e 2d 79 20 20 28 6c 69 73 74 2d 72 rigin-y (list-r
2f40: 65 66 20 6f 62 6a 2d 73 70 65 63 20 31 29 29 0a ef obj-spec 1)).
2f50: 09 20 20 20 20 20 20 28 62 61 72 2d 77 69 64 74 . (bar-widt
2f60: 68 20 31 30 29 0a 09 20 20 20 20 20 20 28 71 75 h 10).. (qu
2f70: 65 75 65 2d 6c 65 6e 20 28 71 75 65 75 65 3a 73 eue-len (queue:s
2f80: 70 65 63 2d 67 65 74 2d 6c 65 6e 67 74 68 20 2a pec-get-length *
2f90: 71 75 65 75 65 2d 73 70 65 63 2a 29 29 0a 09 20 queue-spec*))..
2fa0: 20 20 20 20 20 28 6c 61 79 65 72 20 20 20 20 20 (layer
2fb0: 28 6c 69 73 74 2d 72 65 66 20 6f 62 6a 2d 73 70 (list-ref obj-sp
2fc0: 65 63 20 32 29 29 29 0a 09 20 20 28 65 7a 78 2d ec 2))).. (ezx-
2fd0: 73 65 6c 65 63 74 2d 6c 61 79 65 72 20 2a 65 7a select-layer *ez
2fe0: 78 2a 20 6c 61 79 65 72 29 0a 09 20 20 28 65 7a x* layer).. (ez
2ff0: 78 2d 77 69 70 65 2d 6c 61 79 65 72 20 20 20 2a x-wipe-layer *
3000: 65 7a 78 2a 20 6c 61 79 65 72 29 0a 09 20 20 28 ezx* layer).. (
3010: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 71 if (not (null? q
3020: 75 65 75 65 2d 64 61 74 29 29 0a 09 20 20 20 20 ueue-dat))..
3030: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 64 72 (let ((res (dr
3040: 61 77 2d 71 75 65 75 65 2d 63 6f 6d 70 72 65 73 aw-queue-compres
3050: 73 2d 71 75 65 75 65 2d 64 61 74 61 20 71 75 65 s-queue-data que
3060: 75 65 2d 64 61 74 29 29 29 0a 09 09 28 69 66 20 ue-dat)))...(if
3070: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 73 29 (not (null? res)
3080: 29 0a 09 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f )... (let loo
3090: 70 20 28 28 68 65 64 20 28 63 61 72 20 72 65 73 p ((hed (car res
30a0: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 )).... (ta
30b0: 6c 20 28 63 64 72 20 72 65 73 29 29 0a 09 09 09 l (cdr res))....
30c0: 20 20 20 20 20 20 20 28 78 32 20 20 20 28 2b 20 (x2 (+
30d0: 6f 72 69 67 69 6e 2d 78 20 71 75 65 75 65 2d 6c origin-x queue-l
30e0: 65 6e 29 29 29 0a 09 09 20 20 20 20 20 20 28 6c en)))... (l
30f0: 65 74 2a 20 28 28 75 73 65 72 20 28 76 65 63 74 et* ((user (vect
3100: 6f 72 2d 72 65 66 20 68 65 64 20 30 29 29 0a 09 or-ref hed 0))..
3110: 09 09 20 20 20 20 20 28 68 20 20 20 20 28 6c 65 .. (h (le
3120: 74 20 28 28 6e 75 6d 6a 6f 62 73 20 28 76 65 63 t ((numjobs (vec
3130: 74 6f 72 2d 72 65 66 20 68 65 64 20 31 29 29 29 tor-ref hed 1)))
3140: 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 2a 75 ..... (if *u
3150: 73 65 2d 6c 6f 67 2a 0a 09 09 09 09 09 20 28 69 se-log*...... (i
3160: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 nexact->exact (r
3170: 6f 75 6e 64 20 28 6c 6f 67 20 28 2b 20 31 20 28 ound (log (+ 1 (
3180: 2a 20 2a 6a 6f 62 2d 6c 6f 67 2d 73 63 61 6c 65 * *job-log-scale
3190: 2a 20 6e 75 6d 6a 6f 62 73 29 29 29 29 29 0a 09 * numjobs)))))..
31a0: 09 09 09 09 20 6e 75 6d 6a 6f 62 73 29 29 29 0a .... numjobs))).
31b0: 09 09 09 20 20 20 20 20 28 78 31 20 20 20 28 2d ... (x1 (-
31c0: 20 78 32 20 20 62 61 72 2d 77 69 64 74 68 29 29 x2 bar-width))
31d0: 0a 09 09 09 20 20 20 20 20 28 79 32 20 20 20 28 .... (y2 (
31e0: 2d 20 6f 72 69 67 69 6e 2d 79 20 68 29 29 29 0a - origin-y h))).
31f0: 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 78 31 ...;; (print "x1
3200: 20 22 20 78 31 20 22 2c 20 6f 72 69 67 69 6e 2d " x1 ", origin-
3210: 79 20 22 20 6f 72 69 67 69 6e 2d 79 20 22 2c 20 y " origin-y ",
3220: 78 32 20 22 20 78 32 20 22 2c 20 79 32 20 22 20 x2 " x2 ", y2 "
3230: 79 32 29 0a 09 09 09 28 65 7a 78 2d 66 69 6c 6c y2)....(ezx-fill
3240: 72 65 63 74 2d 32 64 20 2a 65 7a 78 2a 20 78 31 rect-2d *ezx* x1
3250: 20 79 32 20 78 32 20 6f 72 69 67 69 6e 2d 79 20 y2 x2 origin-y
3260: 28 67 65 74 2d 75 73 65 72 2d 63 6f 6c 6f 72 20 (get-user-color
3270: 75 73 65 72 29 29 0a 09 09 09 28 69 66 20 28 6e user))....(if (n
3280: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a ot (null? tal)).
3290: 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 ... (loop (ca
32a0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
32b0: 78 31 29 29 29 29 29 0a 09 09 28 65 7a 78 2d 72 x1)))))...(ezx-r
32c0: 65 64 72 61 77 20 2a 65 7a 78 2a 29 29 29 29 29 edraw *ezx*)))))
32d0: 29 29 0a 09 20 20 0a 28 6c 65 74 2a 20 28 28 61 )).. .(let* ((a
32e0: 72 67 73 20 20 28 61 72 67 76 29 29 0a 20 20 20 rgs (argv)).
32f0: 20 20 20 20 28 66 6e 61 6d 65 20 28 69 66 20 28 (fname (if (
3300: 3e 20 28 6c 65 6e 67 74 68 20 61 72 67 73 29 20 > (length args)
3310: 31 29 0a 09 09 20 20 28 63 61 64 72 20 61 72 67 1)... (cadr arg
3320: 73 29 0a 20 09 09 20 20 22 64 65 66 61 75 6c 74 s). .. "default
3330: 2e 73 63 6d 22 29 29 29 0a 20 20 28 6c 6f 61 64 .scm"))). (load
3340: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
3350: 73 3f 20 66 6e 61 6d 65 29 20 66 6e 61 6d 65 20 s? fname) fname
3360: 22 64 65 66 61 75 6c 74 2e 73 63 6d 22 29 29 29 "default.scm")))
3370: 0a .