#!/usr/bin/newlisp ; now updated for reworked message API in v.10.3.5: ; must specify 'true' in 'spawn' when using 'send/'receive' ; --------------------------------- roundtrip test (println "\n10 round trips to 10 child processes with 80,000 bytes in each package") (define (child-process , pid pppid msg) (setq ppid (sys-info -4)) ; parent pid (setq pid (sys-info -3)) ; this child pid (while true (until (receive ppid msg) ) (until (send ppid msg ) )) ) (dotimes (i 10) (spawn 'r (child-process)i true)) (println "\nPIDs of spawned childs:\n" (sync)) (println) (set 'start (time-of-day)) (dotimes (i 2) (dolist (ch (sync)) /* cannot be binary */ (set 'pkg (base64-enc (dup (pack "lf" (random 0 1)) 20000))) (until (send ch pkg) ) ; send out message (until (receive ch msg)) ; get response (unless (= msg pkg) ; check (setq error-msg (string " >>>> ERROR in round trip test: " ch))) (print ch " ") ) (println) ) (println "time per round trip: " (div (- (time-of-day) start) 100) " ms") (if error-msg (println ">>>>> PROBLEM " error-msg) (println ">>>>> Message API with big content tested SUCCESSFUL")) (abort) (sleep 100) (println) (exit)