Changeset 34417 in project


Ignore:
Timestamp:
08/27/17 05:16:06 (4 weeks ago)
Author:
kon
Message:

bump ver, re-flow, use miscmacros let/cc, don't add '-' to gensym name

Location:
release/4/timed-resource/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/timed-resource/trunk/tests/run.scm

    r21009 r34417  
    1010    (define +opened+ 0) ;For Testing Only
    1111    (define +closed+ 0) ;For Testing Only
    12    
     12
    1313    (define random-blob
    1414      (let ((tr-random-dev
     
    3636      (test "Resource Closed" +closed+ +opened+) ) ) )
    3737
    38 (unless (zero? (test-failure-count)) (exit 1))
     38(test-exit)
  • release/4/timed-resource/trunk/timed-resource.meta

    r26885 r34417  
    1212        (check-errors "1.9.0")
    1313        (thread-utils "1.0.1")
    14         (synch "2.1.0"))
     14        (synch "2.1.0")
     15        (miscmacros "2.96"))
    1516 (test-depends test)
    1617 (files "timed-resource.setup" "timed-resource.scm" "timed-resource.meta" "timed-resource.release-info" "tests/run.scm") )
  • release/4/timed-resource/trunk/timed-resource.scm

    r21256 r34417  
    11;;;; timed-resource.scm
    22;;;; Kon Lovett, Oct '09
     3;;;; Kon Lovett, Jun '17
    34
    45;; Issues
    56;;
    6 ;; - Uses thread-terminate!
     7;; (- Uses thread-terminate!) - not anymore
    78
    89; Chicken Generic Arithmetic!
     
    1011(module timed-resource
    1112
    12   (;export
    13     timed-resource-timeout
    14     make-timed-resource
    15     timed-resource?
    16     timed-resource-name
    17     with-timed-resource)
    18 
    19   (import
    20     scheme
    21     chicken
    22     (only data-structures ->string)
    23     (only srfi-1
    24       delete!)
    25     (only srfi-18
    26       make-thread
    27       thread-start! thread-join!
    28       thread-sleep! thread-terminate! thread-signal!
    29       make-mutex mutex-name
    30       terminated-thread-exception? uncaught-exception?)
    31     (only synch
    32       make-object/synch object?/synch
    33       synch-with set!/synch record/synch
    34       %synch-with %set!/synch %record/synch)
    35     (only type-checks
    36       check-procedure check-number check-positive-number
    37       define-check+error-type)
    38     (only thread-utils
    39       print-exception-error
    40       thread-unblock!)
    41     (only thread-reaper
    42       thread-reaper-shutdown? thread-reap!)
    43     (only record-variants
    44       define-record-type-variant))
    45 
    46   (require-library
    47     data-structures
    48     srfi-1 srfi-18
    49     record-variants
    50     synch
    51     thread-utils thread-reaper
    52     type-checks)
     13(;export
     14  timed-resource-timeout
     15  make-timed-resource
     16  timed-resource?
     17  timed-resource-name
     18  with-timed-resource )
     19
     20(import scheme)
     21
     22(import chicken)
     23
     24(import
     25 (only data-structures ->string)
     26  (only srfi-1 delete!)
     27  (only srfi-18
     28    make-thread
     29    thread-start! thread-join!
     30    thread-sleep! thread-terminate! thread-signal!
     31    make-mutex mutex-name
     32    terminated-thread-exception? uncaught-exception?) )
     33(require-library
     34  data-structures srfi-1 srfi-18 )
     35
     36(import
     37  (only synch
     38    make-object/synch object?/synch
     39    synch-with set!/synch record/synch
     40    %synch-with %set!/synch %record/synch)
     41  (only type-checks
     42    check-procedure check-number check-positive-number
     43    define-check+error-type)
     44  (only thread-utils
     45    print-exception-error
     46    thread-unblock!)
     47  (only thread-reaper
     48    thread-reaper-shutdown? thread-reap!)
     49  (only record-variants
     50    define-record-type-variant) )
     51(require-library
     52  synch
     53  type-checks
     54  thread-utils thread-reaper
     55  record-variants )
     56
     57(require-extension miscmacros)
    5358
    5459;;
    5560
    56 (define-record-type-variant timed-resource
    57   (unsafe unchecked inline)
     61(define-record-type-variant timed-resource (unsafe unchecked inline)
    5862  (%make-timed-resource op cl to mtx th it)
    5963  %timed-resource?
     
    6771(define-check+error-type timed-resource %timed-resource?)
    6872
    69 (define (timed-resource? obj) (%timed-resource? obj))
     73(define (timed-resource? obj)
     74  (%timed-resource? obj) )
    7075
    7176(define (timed-resource-name tr)
    72   ;Not completely happy with this
     77  ;not completely happy with this
    7378  (mutex-name (timed-resource-mutex tr)) )
    7479
     
    8691;catchs & returns exception conditions
    8792(define (checked-timed-resource-close tr succflag)
    88   (call-with-current-continuation
    89     (lambda (return)
    90       (with-exception-handler
    91         (lambda (exn) (return exn))
    92         (lambda () (timed-resource-close tr) succflag)))) )
     93  (let/cc return
     94    (with-exception-handler
     95      (lambda (exn) (return exn))
     96      (lambda () (timed-resource-close tr) succflag))) )
    9397
    9498;; Set of timed resources
     
    106110(define CLOSED-TAG '#(timed-resource-closed))
    107111
    108 ;Note that the set of timed resource objects is kept only for shutdown
     112;note that the set of timed resource objects is kept only for shutdown
    109113;processing.
    110114(define (shutdown-timed-resources!)
     
    112116  (when +timed-resources+
    113117    (%synch-with +timed-resources+ trs
    114       ;Release every blocked timed-resource and "manually" reap. Note that if
     118      ;release every blocked timed-resource and "manually" reap. Note that if
    115119      ;the tr is still in the list then it is not queued by the reaper!
    116120      (for-each
     
    162166          ;When teminating anyway no exceptions but make a note of any problem
    163167          ((or +shutdown?+ (thread-reaper-shutdown?))
    164             (unless (eq? CLOSED-TAG res) (print-exception-error res th))
     168            (unless (eq? CLOSED-TAG res)
     169              (print-exception-error res th) )
    165170            CLOSED-TAG )
    166171          (else
     
    174179    (add-timed-resource! tr)
    175180    ;Allow "timeout" seconds of access
    176     (handle-exceptions exn
    177         ;Early unblock only "handled exception"
    178         (unless (eq? UNBLOCKED-TAG exn) (abort exn))
     181    (handle-exceptions
     182      ;as
     183      exn
     184      ;with
     185      (unless (eq? UNBLOCKED-TAG exn) ;early unblock only "handled exception"
     186        (abort exn) )
     187      ;in
    179188      (thread-sleep! (timed-resource-timeout tr)) )
    180     ;Release the resource but propagate any exceptions
     189    ;release the resource but propagate any exceptions
    181190    (let ((res (release-timed-resource! tr)))
    182       (unless (eq? CLOSED-TAG res) (abort res)) ) ) )
     191      (unless (eq? CLOSED-TAG res)
     192        (abort res) ) ) ) )
    183193
    184194(define (start-timed-resource-timer! tr)
    185   (let ((th (make-thread
    186               (make-timed-resource-timer-thunk tr)
    187               (timed-resource-name tr))))
     195  (let ((th
     196          (make-thread
     197            (make-timed-resource-timer-thunk tr)
     198            (timed-resource-name tr))))
    188199    (timed-resource-thread-set! tr th)
    189200    (thread-start! th) ) )
     
    192203
    193204(define (timed-resource-start! tr)
    194   ;Open resource before starting the timer thread so the overhead doesn't count
     205  ;open resource before starting the timer thread so the overhead doesn't count
    195206  ;(and any exceptions can propagate in caller's thread)
    196207  (timed-resource-open! tr)
     
    201212
    202213(define (timed-resource-aquire tr)
    203   ;Just return resource if already open, otherwise begin a timed open of the
    204   ;resource
    205   (or (timed-resource-item tr)
    206       (timed-resource-start! tr) ) )
     214  (or
     215    ;just return resource if already open
     216    (timed-resource-item tr)
     217    ;otherwise begin a timed open of the resource
     218    (timed-resource-start! tr) ) )
    207219
    208220(define (make-timed-resource-name name)
    209   (gensym (string-append (->string name) "-")) )
     221  (gensym name #;(string-append (->string name) "-")) )
    210222
    211223;;;
    212224
    213225(define (timed-resource-timeout . args)
    214   (if (null? args) +timeout+
     226  (if (null? args)
     227    +timeout+
    215228    (let ((to (car args)))
    216229      (set! +timeout+
  • release/4/timed-resource/trunk/timed-resource.setup

    r26885 r34417  
    55(verify-extension-name "timed-resource")
    66
    7 (setup-shared-extension-module 'timed-resource (extension-version "1.0.2")
     7(setup-shared-extension-module 'timed-resource (extension-version "1.0.3")
    88  #:inline? #t
    99  #:types? #t
Note: See TracChangeset for help on using the changeset viewer.