Index: ulex-trials/server-one.scm ================================================================== --- ulex-trials/server-one.scm +++ ulex-trials/server-one.scm @@ -1,33 +1,61 @@ -(require-extension tcp-server format (chicken tcp) (chicken io) (chicken string) sql-de-lite srfi-18 simple-exceptions) -(let* ((th1 (make-thread (lambda () +(import tcp-server format (chicken tcp) (chicken io) (chicken string) (prefix sqlite3 sqlite3:) sql-de-lite srfi-18 simple-exceptions mailbox s11n) +(let* ((work-mailbox (make-mailbox)) + (notify-mailbox (make-mailbox)) +(th1 (make-thread (lambda () ((make-tcp-server (tcp-listen 6505) (lambda () - (let* ((db (open-database "test.db")) - (rec-data (read-line))) - (exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") rec-data (conc "Server One Response: " rec-data)) - (format (current-error-port) rec-data) - (write-line (conc "Response to: " rec-data)) - (close-database db) + (let* ((db (sqlite3:open-database "test.db")) + (rec-data (deserialize))) + (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) + ;;(exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") "something" (conc "Server One Response: " "something else")) + (sqlite3:execute db "INSERT INTO entries (received,send) VALUES (?,?);" "something" (conc "Server One Response: " "something else")) + (mailbox-send! work-mailbox rec-data) + (format (current-error-port) (conc rec-data)) + (write-line (conc "Response to: " (conc rec-data))) + ;;(close-database db) ))) #t)) -"Ulex command loop")) +"receive")) (th2 (make-thread (lambda () (print "Jeff is here") (let loop ((entries 0)) - (thread-sleep! 0.05) + (thread-sleep! 0.01) (print "Preparding to send entries" entries) (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) (define-values (i o) (tcp-connect "localhost" 6504)) - (write-line (conc "entries" entries) o) + (serialize (list "localhost:6505" "from-server-one") o) (print (read-line i)) (close-input-port i) (close-output-port o)) - (loop (+ entries 1)))) "jeff"))) + (loop (+ entries 1)))) "send")) +(th3 (make-thread (lambda () + (print "In mailbox thread") + (let loop2 ((entries2 0)) + (print "Processing: " (mailbox-receive! work-mailbox)) + (mailbox-send! notify-mailbox (list 'ack)) + (thread-sleep! 0.01) + (loop2 1))) "processing")) +(th4 (make-thread (lambda () + (print "In notify-mailbox thread") + (let loop3 ((entries3 0)) + (print "Notifying: " (mailbox-receive! notify-mailbox)) + (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) + (define-values (i o) (tcp-connect "localhost" 6504)) + (serialize (list 'ack "from-server-one") o) + (print (read-line i)) + (close-input-port i) + (close-output-port o)) + ;;(thread-sleep! 1) + (loop3 1))) "notify")) + +) (thread-start! th1) (thread-start! th2) +(thread-start! th3) +(thread-start! th4) (thread-join! th2) ) (print "Done here") Index: ulex-trials/server-two.scm ================================================================== --- ulex-trials/server-two.scm +++ ulex-trials/server-two.scm @@ -1,34 +1,61 @@ -(require-extension tcp-server format (chicken tcp) (chicken io) (chicken string) sql-de-lite srfi-18 simple-exceptions) - -(let* ((th1 (make-thread (lambda () +(import tcp-server format (chicken tcp) (chicken io) (chicken string) (prefix sqlite3 sqlite3:) sql-de-lite srfi-18 simple-exceptions mailbox s11n) +(let* ((work-mailbox (make-mailbox)) + (notify-mailbox (make-mailbox)) +(th1 (make-thread (lambda () ((make-tcp-server (tcp-listen 6504) (lambda () - (let* ((db (open-database "test.db")) - (rec-data (read-line))) - (exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") rec-data (conc "Server Two Response: " rec-data)) - (format (current-error-port) rec-data) - (write-line (conc "Response to: " rec-data)) - (close-database db) + (let* ((db (sqlite3:open-database "test.db")) + (rec-data (deserialize))) + (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) + ;;(exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") "something" (conc "Server One Response: " "something else")) + (sqlite3:execute db "INSERT INTO entries (received,send) VALUES (?,?);" "something" (conc "Server One Response: " "something else")) + (mailbox-send! work-mailbox rec-data) + (format (current-error-port) (conc rec-data)) + (write-line (conc "Response to: " (conc rec-data))) + ;;(close-database db) ))) #t)) -"Ulex command loop")) +"receive")) (th2 (make-thread (lambda () (print "Jeff is here") - (let loop ((entries 500)) + (let loop ((entries 0)) (thread-sleep! 0.01) - (print "Preparing to send entries" entries) + (print "Preparding to send entries" entries) (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) (define-values (i o) (tcp-connect "localhost" 6505)) - (write-line (conc "entries" entries) o) + (serialize (list "localhost:6505" "from-server-two") o) (print (read-line i)) (close-input-port i) (close-output-port o)) - (loop (+ entries 1)))) "jeff"))) + (loop (+ entries 1)))) "send")) +(th3 (make-thread (lambda () + (print "In mailbox thread") + (let loop2 ((entries2 0)) + (print "Processing: " (mailbox-receive! work-mailbox)) + (mailbox-send! notify-mailbox (list 'ack)) + (thread-sleep! 0.01) + (loop2 1))) "processing")) +(th4 (make-thread (lambda () + (print "In notify-mailbox thread") + (let loop3 ((entries3 0)) + (print "Notifying: " (mailbox-receive! notify-mailbox)) + (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) + (define-values (i o) (tcp-connect "localhost" 6505)) + (serialize (list 'ack "from-server-two") o) + (print (read-line i)) + (close-input-port i) + (close-output-port o)) + ;;(thread-sleep! 1) + (loop3 1))) "notify")) + +) (thread-start! th1) (thread-start! th2) +(thread-start! th3) +(thread-start! th4) (thread-join! th2) ) (print "Done here")