15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))
(print "Operation: " operation ", param: " param)
;; have a pool of db's to pick from
(define *dbpool* '())
(define *pool-mutex* (make-mutex))
(define (get-db)
(mutex-lock! *pool-mutex*)
(if (null? *dbpool*)
(begin
(mutex-unlock! *pool-mutex*)
(let ((db (open-database param)))
(set-busy-handler! db (busy-timeout 10000))
|
|
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))
(print "Operation: " operation ", param: " param)
;; have a pool of db's to pick from
(define *dbpool* '())
(define *pool-mutex* (make-mutex))
1
(define (get-db)
(mutex-lock! *pool-mutex*)
(if (null? *dbpool*)
(begin
(mutex-unlock! *pool-mutex*)
(let ((db (open-database param)))
(set-busy-handler! db (busy-timeout 10000))
|
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
(if (eq? operation 'server)
(tcp-listen (rpc:default-server-port))
(tcp-listen 0)))
;; Start server thread
(define rpc:server
(make-thread
(cute (rpc:make-server rpc:listener) "rpc:server")
'rpc:server))
(thread-start! rpc:server)
;;; Server side
(define (server)
(rpc:publish-procedure!
|
|
>
>
>
>
>
>
>
|
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
(if (eq? operation 'server)
(tcp-listen (rpc:default-server-port))
(tcp-listen 0)))
;; Start server thread
(define rpc:server
(make-thread
(cute (rpc:make-server rpc:listener) "rpc:server") ;; NOTE: see equivalent code below
'rpc:server))
;; This is what the code would look like without cute
;; (define rpc:server
;; (make-thread
;; (lambda ()
;; ((rpc:make-server rpc:listener) "rpc:server"))
;; 'rpc:server))
(thread-start! rpc:server)
;;; Server side
(define (server)
(rpc:publish-procedure!
|