44 lines
1.2 KiB
Plaintext
Executable File
44 lines
1.2 KiB
Plaintext
Executable File
#!/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)
|
|
|