Changeset 37944 in project


Ignore:
Timestamp:
10/02/19 20:39:33 (2 weeks ago)
Author:
felix winkelmann
Message:

tcp-server 1.5: another improvement contributed by Henry Hu

Location:
release/5/tcp-server
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/tcp-server/tags/1.5/tcp-server.scm

    r37907 r37944  
    4343;;; Constants:
    4444
    45 (define-constant default-request-count-limit 10000)
     45(define-constant default-request-count-limit 500)
    4646
    4747;;; Parameters:
     
    5757
    5858(define (make-tcp-server listener thunk . maxc)
    59   (let ([max-requests (optional maxc default-request-count-limit)]
    60         [current-number-of-threads 0]
    61         [verbose #f] )
     59  (let ((max-requests (optional maxc default-request-count-limit))
     60        (current-number-of-threads 0)
     61        (cnt-mutex (make-mutex))
     62        (verbose #f) )
    6263    (define (dribble fstr . args)
    6364      (when verbose
     
    7273      (close-input-port in)
    7374      (close-output-port out) )
     75    (define (dropcount)
     76      (mutex-lock! cnt-mutex)
     77      (set! current-number-of-threads
     78        (sub1 current-number-of-threads))
     79      (mutex-unlock! cnt-mutex))
    7480    (define (thread-fork thunk)
    75       (set! current-number-of-threads (add1 current-number-of-threads))
    7681      (thread-start!
    7782        (make-thread
    7883          (lambda ()
    79             (thunk)
    80             (set! current-number-of-threads
    81               (sub1 current-number-of-threads)) ))))
     84            (handle-exceptions ex
     85              (begin
     86                (dropcount)
     87                (signal ex))
     88              (thunk)
     89              (dropcount))))))
    8290    (define (dispatch-request in out)
    8391      (handle-exceptions ex
     
    107115                   (dribble "~A finished." id) ) ) ) ) ) )
    108116        (let loop ()
    109           (if (< current-number-of-threads max-requests)
    110               (serve)
    111               (thread-yield!) )
     117          (let ([locked (mutex-lock! cnt-mutex)]
     118                [reached-max-requests? (>= current-number-of-threads max-requests)])
     119            (cond
     120             (reached-max-requests?
     121              (mutex-unlock! cnt-mutex)
     122              (thread-yield!))
     123             (else
     124              (set! current-number-of-threads
     125                    (add1 current-number-of-threads))
     126              (mutex-unlock! cnt-mutex)
     127              (serve))))
    112128          (loop) ) ) ) ) )
    113129
  • release/5/tcp-server/tags/1.5/tcpservertest.scm

    r37611 r37944  
    1 (use tcp-server extras posix)
     1(import tcp-server (chicken tcp) (chicken format) (chicken io) (chicken port))
    22
    33((make-tcp-server
  • release/5/tcp-server/trunk/tcp-server.scm

    r37907 r37944  
    4343;;; Constants:
    4444
    45 (define-constant default-request-count-limit 10000)
     45(define-constant default-request-count-limit 500)
    4646
    4747;;; Parameters:
     
    5757
    5858(define (make-tcp-server listener thunk . maxc)
    59   (let ([max-requests (optional maxc default-request-count-limit)]
    60         [current-number-of-threads 0]
    61         [verbose #f] )
     59  (let ((max-requests (optional maxc default-request-count-limit))
     60        (current-number-of-threads 0)
     61        (cnt-mutex (make-mutex))
     62        (verbose #f) )
    6263    (define (dribble fstr . args)
    6364      (when verbose
     
    7273      (close-input-port in)
    7374      (close-output-port out) )
     75    (define (dropcount)
     76      (mutex-lock! cnt-mutex)
     77      (set! current-number-of-threads
     78        (sub1 current-number-of-threads))
     79      (mutex-unlock! cnt-mutex))
    7480    (define (thread-fork thunk)
    75       (set! current-number-of-threads (add1 current-number-of-threads))
    7681      (thread-start!
    7782        (make-thread
    7883          (lambda ()
    79             (thunk)
    80             (set! current-number-of-threads
    81               (sub1 current-number-of-threads)) ))))
     84            (handle-exceptions ex
     85              (begin
     86                (dropcount)
     87                (signal ex))
     88              (thunk)
     89              (dropcount))))))
    8290    (define (dispatch-request in out)
    8391      (handle-exceptions ex
     
    107115                   (dribble "~A finished." id) ) ) ) ) ) )
    108116        (let loop ()
    109           (if (< current-number-of-threads max-requests)
    110               (serve)
    111               (thread-yield!) )
     117          (let ([locked (mutex-lock! cnt-mutex)]
     118                [reached-max-requests? (>= current-number-of-threads max-requests)])
     119            (cond
     120             (reached-max-requests?
     121              (mutex-unlock! cnt-mutex)
     122              (thread-yield!))
     123             (else
     124              (set! current-number-of-threads
     125                    (add1 current-number-of-threads))
     126              (mutex-unlock! cnt-mutex)
     127              (serve))))
    112128          (loop) ) ) ) ) )
    113129
  • release/5/tcp-server/trunk/tcpservertest.scm

    r37611 r37944  
    1 (use tcp-server extras posix)
     1(import tcp-server (chicken tcp) (chicken format) (chicken io) (chicken port))
    22
    33((make-tcp-server
Note: See TracChangeset for help on using the changeset viewer.