Channels compared to dd

collects/tests/racket/benchmarks/places/place-channel.rktl

@@ -1,7 +1,9 @@
 #lang racket/base
 ;; stress tests for place-channels
 (require (prefix-in pp: "place-processes.rkt"))
-(require racket/place)
+(require racket/place
+         racket/path
+         racket/system)
 
 (define (splat txt fn)
   (call-with-output-file fn #:exists 'replace
@@ -10,8 +12,19 @@
 
 (define (print-out msg B/sE)
   (displayln (list msg 
-    (exact->inexact B/sE)
+    (exact->inexact B/sE) 'bytes-per-second
-    (exact->inexact (/ B/sE (* 1024 1024))))))
+    (exact->inexact (/ B/sE (* 1024 1024))) 'MB-per-second)))
+
+(define (current-executable-path) 
+ (parameterize ([current-directory (find-system-path 'orig-dir)])
+  (find-executable-path (find-system-path 'exec-file) #f)))
+
+(define (current-collects-path)
+ (let ([p (find-system-path 'collects-dir)])
+  (if (complete-path? p)
+      p
+      (path->complete-path p (or (path-only (current-executable-path))
+                                 (find-system-path 'orig-dir))))))
 
 (define (processes-byte-message-test)
   (let ([pl
@@ -33,7 +46,7 @@
         (pp:place-channel-receive pl))) null))
 
 
-    (print-out "processes" (/ (* 2 count message-size) (/ t2 1000)))
+    (print-out "processes-emulated-places" (/ (* 2 count message-size) (/ t2 1000)))
     (pp:place-wait pl)))
 
 
@@ -46,7 +59,7 @@
 
     (define (place-main ch)
       (define message-size (* 4024 1024))
-      (define count 50)
+      (define count 150)
       (define fourk-b-message (make-bytes message-size 66))
       (for ([i (in-range count)])
        (place-channel-receive ch)
@@ -58,7 +71,7 @@ END
   (let ([pl (place "pct1.ss" 'place-main)])
     (define message-size (* 4024 1024))
     (define four-k-message (make-bytes message-size 65))
-    (define count 50)
+    (define count 150)
     (define-values (r t1 t2 t3)
       (time-apply (lambda ()
       (for ([i (in-range count)])
@@ -96,11 +109,47 @@ END
         (place-channel-send pl tree)
         (place-channel-receive pl))) null))
 
+    (define s (* (- (expt 2 9) 1) 4 8 count))
+    (printf "cons-tree ~a ~a ~a ~a\n" t1 t2 t3  (exact->inexact (/ t2 1000)))
+    (print-out "cons-tree" (/ s (/ t2 1000)))
 
-    (printf "~a ~a ~a ~a\n" r t1 t2 t3)
     (place-wait pl)))
 
+(define (process-pipe-test)
+  (define worker-cmdline-list (list (current-executable-path) "-X" (path->string (current-collects-path)) "-e" "(eval(read))"))
+  ;(define worker-cmdline-list (list "/bin/cat" "/etc/passwd"))
+  ;(let-values ([(_process-handle _out _in _err) (apply subprocess (current-output-port) #f (current-error-port) worker-cmdline-list)])
+  (let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)])
+    (define message-size (* 4024 1024))
+    (define four-k-message (make-bytes message-size 65))
+    (define count 10)
+    (define-values (r t1 t2 t3)
+      (time-apply (lambda ()
+        (write
+          `(for ([x (in-range ,count)])
+            (define k (read))
+            (write k)
+            (flush-output)) _in)
+        (flush-output _in)
+        (for ([i (in-range count)])
+             (write four-k-message _in)
+             (flush-output _in)
+             (read _out))) 
+                  null))
+    (subprocess-wait _process-handle)
+    (printf "~a ~a ~a ~a\n" r t1 t2 t3)
+
+    (print-out "process-pipe" (/ (* 2 count message-size) (/ (+ t2 1)  1000)))))
+
+(define (say-system cmd)
+  (displayln cmd)
+  (system cmd))
+
 (byte-message-test)
 (processes-byte-message-test)
+(process-pipe-test)
+(say-system "dd if=/dev/zero of=/dev/null count=10000000")
+(say-system "dd if=/dev/zero count=10000000 |dd of=/dev/null")
+
 (cons-tree-test)