Changeset 36958 in project


Ignore:
Timestamp:
12/03/18 03:48:05 (8 days ago)
Author:
kon
Message:

toy polish

Location:
release/5/synch/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/synch/trunk/critical-region.scm

    r36945 r36958  
    77
    88#|
    9 === Critical Regions
     9=== Remote Critical Region
    1010
    1111==== Usage
     
    1515</enscript>
    1616
    17 Evaluated under {{(disable-interrupts)}}.
     17==== critical-region-apply
     18
     19<procedure>(critical-region-apply PROC ARG0 ...) -> *</procedure>
     20
     21Evaluates {{(apply PROC ARG0 ...)}} w/o interrupts. {{PROC}} may exit via
     22continuation.
     23
     24==== critical-region-call
     25
     26<procedure>(critical-region-call PROC) -> *</procedure>
     27
     28Evaluates {{(PROC)}} w/o interrupts. {{PROC}} may exit via continuation.
     29
     30==== critical-region-apply*
     31
     32<procedure>(critical-region-apply PROC ARG0 ...) -> boolean *</procedure>
     33
     34Evaluates {{(apply PROC ARG0 ...)}} w/o interrupts. {{PROC}} may exit via
     35continuation.
     36
     37The first value} indicates whether the 2nd value is, {{#t}}, the
     38single-valued result, or, {{#f}}, the captured exception condition.
     39
     40==== critical-region-call*
     41
     42<procedure>(critical-region-call* PROC) -> boolean *</procedure>
     43
     44Evaluates {{(PROC)}} w/o interrupts. {{PROC}} may exit via continuation.
     45
     46The first value} indicates whether the 2nd value is, {{#t}}, the
     47single-valued result, or, {{#f}}, the captured exception condition.
     48
     49==== %critical-region-apply
     50
     51<procedure>(%critical-region-apply PROC ARG0 ...) -> *</procedure>
     52
     53Evaluates {{(apply PROC ARG0 ...)}} w/o interrupts. {{PROC}} may '''not'''
     54exit via continuation or raise an exception.
     55
     56==== %critical-region-call
     57
     58<procedure>(%critical-region-call PROC) -> *</procedure>
     59
     60Evaluates {{(PROC)}} w/o interrupts. {{PROC}} may '''not''' exit via
     61continuation or raise an exception.
     62
     63==== %critical-region-apply*
     64
     65<procedure>(%critical-region-apply* PROC ARG0 ...) -> boolean *</procedure>
     66
     67Evaluates {{(apply PROC ARG0 ...)}} w/o interrupts. {{PROC}} may '''not'''
     68exit via continuation.
     69
     70The first value} indicates whether the 2nd value is, {{#t}}, the
     71single-valued result, or, {{#f}}, the captured exception condition.
     72
     73==== %critical-region-call*
     74
     75<procedure>(%critical-region-call* PROC) -> boolean *</procedure>
     76
     77Evaluates {{(PROC)}} w/o interrupts. {{PROC}} may '''not''' exit via
     78continuation.
     79
     80The first value} indicates whether the 2nd value is, {{#t}}, the
     81single-valued result, or, {{#f}}, the captured exception condition.
     82
     83=== Local Critical Region
    1884
    1985==== critical-region
     
    2187<syntax>(critical-region EXPR ...) -> *</syntax>
    2288
    23 Evaluates {{EXPR ...}} w/o interrupts.
    24 
    25 ==== apply-critical-region
    26 
    27 <procedure>(apply-critical-region PROC ARG0 ...) -> *</procedure>
    28 
    29 Evaluates {{(apply PROC' ARG0' ...')}} w/o interrupts, where {{PROC' ARG0'
    30 ...'}} are the result of the evaluation of {{PROC ARG0 ...}} in the caller's
    31 context.
    32 
    33 ==== call-critical-region
    34 
    35 <syntax>(call-critical-region THUNK) -> *</syntax>
    36 
    37 Evaluates {{(THUNK')}} w/o interrupts, where {{THUNK'}} is the result of the
    38 evaluation of {{THUNK}} in the caller's context.
     89Evaluates {{EXPR ...}} w/o interrupts. {{EXPR ...}} may exit via continuation.
     90
     91==== %critical-region
     92
     93<syntax>(%critical-region EXPR ...) -> *</syntax>
     94
     95Evaluates {{EXPR ...}} w/o interrupts. {{EXPR ...}} may '''not''' exit via
     96continuation.
     97
     98==== critical-region*
     99
     100<syntax>(critical-region* EXPR ...) -> *</syntax>
     101
     102Evaluates {{EXPR ...}} w/o interrupts. {{EXPR ...}} may exit via continuation.
     103
     104The first value} indicates whether the 2nd value is, {{#t}}, the
     105single-valued result, or, {{#f}}, the captured exception condition.
     106
     107==== %critical-region*
     108
     109<syntax>(%critical-region* EXPR ...) -> *</syntax>
     110
     111Evaluates {{EXPR ...}} w/o interrupts. {{EXPR ...}} may '''not''' exit via
     112continuation or raise an exception.
     113
     114The first value} indicates whether the 2nd value is, {{#t}}, the
     115single-valued result, or, {{#f}}, the captured exception condition.
    39116|#
    40117
     
    44121
    45122(;export
     123  ;
    46124  interrupts-enabled?
     125  ;
     126  critical-region-call critical-region-apply
     127  %critical-region-call %critical-region-apply
     128  ;
     129  critical-region-call* critical-region-apply*
     130  %critical-region-call* %critical-region-apply*
     131  ;
    47132  (critical-region $disable-interrupts$ $enable-interrupts$)
    48   call-critical-region apply-critical-region)
     133  (%critical-region $disable-interrupts$ $enable-interrupts$)
     134  ;
     135  (critical-region* $disable-interrupts$ $enable-interrupts$)
     136  (%critical-region* $disable-interrupts$ $enable-interrupts$))
    49137
    50138(import scheme (chicken syntax) (chicken condition) (chicken foreign))
     
    57145(define $enable-interrupts$ (foreign-lambda* void () "C_enable_interrupts();"))
    58146
    59 ;;
    60 
    61 ;FIXME check if interrupts enabled
     147;;;
     148
    62149;body can invoke an exit continuation
    63150(define-syntax critical-region
     
    66153      (dynamic-wind
    67154        $disable-interrupts$
    68         (lambda () body ... )
    69         $enable-interrupts$ ) ) ) )
    70 
    71 (define (apply-critical-region proc . rest)
    72   (critical-region (apply proc rest)) )
    73 
    74 (define (call-critical-region thunk)
    75   (critical-region (thunk)) )
    76 
    77 ;;
     155        (lambda () body ...)
     156        $enable-interrupts$) ) ) )
     157
     158;body cannot invoke an exit continuation or raise an exception
     159;returns the single-valued result
     160(define-syntax %critical-region
     161  (syntax-rules ()
     162    ((%critical-region body ...)
     163      (begin
     164        ($disable-interrupts$)
     165        (let (
     166          (res (begin body ...)) )
     167          ($enable-interrupts$)
     168          res ) ) ) ) )
     169
     170;body can invoke an exit continuation
     171;returns <flag> <result> where
     172;flag is #t & result is the single-valued result
     173;flag is #f & result is the exception-condition
     174(define-syntax critical-region*
     175  (syntax-rules ()
     176    ((critical-region* body ...)
     177      (let* (
     178        (flag #t)
     179        (res
     180          (critical-region
     181            (handle-exceptions
     182              exn (begin (set! flag #f) exn)
     183              body ...))) )
     184        (values flag res) ) ) ) )
    78185
    79186;body cannot invoke an exit continuation
    80187;returns <flag> <result> where
    81 ;flag is #t for success & result is the single-valued result
    82 ;flag is #f for failure & result is the exception-condition
    83 (define-syntax %wrap-critical-region
    84   (syntax-rules ()
    85     ((_ body ...)
    86       (let (
    87         (caught-something #f)
     188;flag is #t & result is the single-valued result
     189;flag is #f & result is the exception-condition
     190(define-syntax %critical-region*
     191  (syntax-rules ()
     192    ((%critical-region* body ...)
     193      (let* (
     194        (flag #t)
    88195        (res
    89           (handle-exceptions exn
    90             ;with
    91             (begin
    92               (set! caught-something #t)
    93               exn)
    94             ;try
    95             ($disable-interrupts$)
    96             body ... )) )
    97         ($enable-interrupts$)
    98         (if caught-something
    99           (values #f res)
    100           (values #t res) ) ) ) ) )
     196          (%critical-region
     197            (handle-exceptions
     198              exn (begin (set! flag #f) exn)
     199              body ...))) )
     200        (values flag res) ) ) ) )
     201
     202;;;
     203
     204(define (critical-region-apply* proc . rest)
     205  (critical-region* (apply proc rest)) )
     206
     207(define (critical-region-call* thunk)
     208  (critical-region* (thunk)) )
     209
     210(define (critical-region-apply proc . rest)
     211  (critical-region (apply proc rest)) )
     212
     213(define (critical-region-call thunk)
     214  (critical-region (thunk)) )
     215
     216(define (%critical-region-apply* proc . rest)
     217  (%critical-region* (apply proc rest)) )
     218
     219(define (%critical-region-call* thunk)
     220  (%critical-region* (thunk)) )
     221
     222(define (%critical-region-apply proc . rest)
     223  (%critical-region (apply proc rest)) )
     224
     225(define (%critical-region-call thunk)
     226  (%critical-region (thunk)) )
    101227
    102228;;;
  • release/5/synch/trunk/tests/synch-test.scm

    r36945 r36958  
    109109
    110110(cond-expand
    111   (expose-critical-region
    112     (import critical-region)
    113     (test-assert "disabled" (critical-region (not (interrupts-enabled?))))
    114     (test-assert "enabled" (interrupts-enabled?))
    115     (handle-exceptions exn
     111  (expose-critical-region #;(or compiling csi)
     112    (test-group "Critical Region"
     113      (import critical-region)
     114      (test-assert "disabled" (critical-region (not (interrupts-enabled?))))
    116115      (test-assert "enabled" (interrupts-enabled?))
    117       (critical-region (abort 'foo)) ) )
     116      (test-assert (not (critical-region* (abort 'foo))))
     117      (test-assert "enabled" (interrupts-enabled?))
     118      (test 'expected (critical-region-apply (lambda (x) x) 'expected))
     119      (test-assert (not (critical-region-call* (lambda () (abort 'foo)))))
     120      ) )
    118121  (else))
    119122
Note: See TracChangeset for help on using the changeset viewer.