Changeset 37945 in project


Ignore:
Timestamp:
10/03/19 00:00:46 (2 weeks ago)
Author:
felix winkelmann
Message:

tcp-server 1.4: updated C4 version with changes from Henry Hu

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

Legend:

Unmodified
Added
Removed
  • release/4/tcp-server/tags/1.4/tcp-server.scm

    r37908 r37945  
    3838;;; Constants:
    3939
    40 (define-constant default-request-count-limit 10000)
     40(define-constant default-request-count-limit 500)
    4141
    4242;;; Parameters:
     
    5252
    5353(define (make-tcp-server listener thunk . maxc)
    54   (let ([max-requests (optional maxc default-request-count-limit)]
    55         [current-number-of-threads 0]
    56         [verbose #f] )
     54  (let ((max-requests (optional maxc default-request-count-limit))
     55        (current-number-of-threads 0)
     56        (cnt-mutex (make-mutex))
     57        (verbose #f) )
    5758    (define (dribble fstr . args)
    5859      (when verbose
     
    6768      (close-input-port in)
    6869      (close-output-port out) )
     70    (define (dropcount)
     71      (mutex-lock! cnt-mutex)
     72      (set! current-number-of-threads
     73        (sub1 current-number-of-threads))
     74      (mutex-unlock! cnt-mutex))
    6975    (define (thread-fork thunk)
    70       (set! current-number-of-threads (add1 current-number-of-threads))
    7176      (thread-start!
    7277        (make-thread
    7378          (lambda ()
    74             (thunk)
    75             (set! current-number-of-threads
    76               (sub1 current-number-of-threads)) ))))
     79            (handle-exceptions ex
     80              (begin
     81                (dropcount)
     82                (signal ex))
     83              (thunk)
     84              (dropcount))))))
    7785    (define (dispatch-request in out)
    7886      (handle-exceptions ex
     
    102110                   (dribble "~A finished." id) ) ) ) ) ) )
    103111        (let loop ()
    104           (if (< current-number-of-threads max-requests)
    105               (serve)
    106               (thread-yield!) )
     112          (let ([locked (mutex-lock! cnt-mutex)]
     113                [reached-max-requests? (>= current-number-of-threads max-requests)])
     114            (cond
     115             (reached-max-requests?
     116              (mutex-unlock! cnt-mutex)
     117              (thread-yield!))
     118             (else
     119              (set! current-number-of-threads
     120                    (add1 current-number-of-threads))
     121              (mutex-unlock! cnt-mutex)
     122              (serve))))
    107123          (loop) ) ) ) ) )
    108124
  • release/4/tcp-server/trunk/tcp-server.scm

    r37908 r37945  
    3838;;; Constants:
    3939
    40 (define-constant default-request-count-limit 10000)
     40(define-constant default-request-count-limit 500)
    4141
    4242;;; Parameters:
     
    5252
    5353(define (make-tcp-server listener thunk . maxc)
    54   (let ([max-requests (optional maxc default-request-count-limit)]
    55         [current-number-of-threads 0]
    56         [verbose #f] )
     54  (let ((max-requests (optional maxc default-request-count-limit))
     55        (current-number-of-threads 0)
     56        (cnt-mutex (make-mutex))
     57        (verbose #f) )
    5758    (define (dribble fstr . args)
    5859      (when verbose
     
    6768      (close-input-port in)
    6869      (close-output-port out) )
     70    (define (dropcount)
     71      (mutex-lock! cnt-mutex)
     72      (set! current-number-of-threads
     73        (sub1 current-number-of-threads))
     74      (mutex-unlock! cnt-mutex))
    6975    (define (thread-fork thunk)
    70       (set! current-number-of-threads (add1 current-number-of-threads))
    7176      (thread-start!
    7277        (make-thread
    7378          (lambda ()
    74             (thunk)
    75             (set! current-number-of-threads
    76               (sub1 current-number-of-threads)) ))))
     79            (handle-exceptions ex
     80              (begin
     81                (dropcount)
     82                (signal ex))
     83              (thunk)
     84              (dropcount))))))
    7785    (define (dispatch-request in out)
    7886      (handle-exceptions ex
     
    102110                   (dribble "~A finished." id) ) ) ) ) ) )
    103111        (let loop ()
    104           (if (< current-number-of-threads max-requests)
    105               (serve)
    106               (thread-yield!) )
     112          (let ([locked (mutex-lock! cnt-mutex)]
     113                [reached-max-requests? (>= current-number-of-threads max-requests)])
     114            (cond
     115             (reached-max-requests?
     116              (mutex-unlock! cnt-mutex)
     117              (thread-yield!))
     118             (else
     119              (set! current-number-of-threads
     120                    (add1 current-number-of-threads))
     121              (mutex-unlock! cnt-mutex)
     122              (serve))))
    107123          (loop) ) ) ) ) )
    108124
Note: See TracChangeset for help on using the changeset viewer.