Monitor.st
author Claus Gittinger <cg@exept.de>
Thu, 25 Jul 2013 11:40:25 +0200
changeset 3061 3fb64baa8409
parent 2961 93ab3ea39189
child 3062 fdc6ffd96189
permissions -rw-r--r--
class: Monitor comment/format in: #documentation
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1996 by Claus Gittinger
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
     3
	      All Rights Reserved
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
1021
da84f1e9cadf #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
    12
"{ Package: 'stx:libbasic2' }"
da84f1e9cadf #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
    13
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
Object subclass:#Monitor
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	instanceVariableNames:'owningProcess sema count'
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	classVariableNames:''
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	poolDictionaries:''
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	category:'Kernel-Processes'
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
560
feae8d3ae643 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 485
diff changeset
    21
!Monitor class methodsFor:'documentation'!
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
copyright
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
 COPYRIGHT (c) 1996 by Claus Gittinger
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    26
	      All Rights Reserved
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
 This software is furnished under a license and may be used
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
 only in accordance with the terms of that license and with the
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 be provided or otherwise made available to, or used by, any
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 other person.  No title to or ownership of the software is
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 hereby transferred.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
!
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
documentation
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
"
3061
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    40
    Monitors (as used in Java) provide a functionality much like RecursionLocks, 
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    41
    but are not block based.
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    42
    Therefore, monitors are not unwind-save (i.e. a return or unwind while a
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    monitor is locked, will lead to a deadlock situation).
3061
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    44
    You have to care for unwind protection yourself.
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    Notice:
3061
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    47
        This is an experimental demo class - there is no WARRANTY.
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    48
        Smalltalkers should use Semaphores and RecursionLocks, which
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    49
        are unwind-save.
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    [see also:]
3061
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    52
        RecursionLock Semaphore Delay SharedQueue
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    53
        Block
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    [author:]
3061
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
    56
        Claus Gittinger
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
!
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
examples
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
"
642
53c27655489b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 599
diff changeset
    62
						[exBegin]
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    63
	|mon p1 p2 p3|
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    65
	mon := Monitor new.
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    67
	p1 := [
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    68
	     10 timesRepeat:[
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    69
		 Delay waitForSeconds:0.3.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    70
		 mon enter.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    71
		 'p1 got it' printNL.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    72
		 Delay waitForSeconds:0.3.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    73
		 'p1 leaves' printNL.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    74
		 mon exit
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    75
	     ]
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    76
	] fork.
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    78
	p2 := [
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    79
	     20 timesRepeat:[
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    80
		 Delay waitForSeconds:0.2.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    81
		 mon enter.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    82
		 'p2 got it' printNL.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    83
		 Delay waitForSeconds:0.2.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    84
		 'p2 leaves' printNL.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    85
		 mon exit
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    86
	     ]
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    87
	] fork.
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    89
	p3 := [
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    90
	     30 timesRepeat:[
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    91
		 Delay waitForSeconds:0.1.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    92
		 mon enter.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    93
		 'p3 got it' printNL.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    94
		 Delay waitForSeconds:0.1.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    95
		 'p3 leaves' printNL.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    96
		 mon exit
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    97
	     ]
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
    98
	] fork.
642
53c27655489b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 599
diff changeset
    99
						[exEnd]
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
! !
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
560
feae8d3ae643 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 485
diff changeset
   103
!Monitor class methodsFor:'instance creation'!
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
new
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    ^ self basicNew initialize
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
! !
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
!Monitor methodsFor:'enter & leave'!
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
2961
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   111
critical: aBlock
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   112
    "a critical section. Executes a block as a critical section, secured by the receiver."
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   113
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   114
    ^ [
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   115
        self enter.
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   116
        aBlock value
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   117
    ] ensure:[
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   118
        self exit
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   119
    ]
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   120
!
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   121
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
enter
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
    "enter the monitor"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    |thisProcess wasBlocked|
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
    thisProcess := Processor activeProcess.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    "
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
     this works only since interrupts are only serviced at 
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
     message send and method-return time ....
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
     If you add a message send into the ifTrue:-block, things will
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
     go mad ... (especially be careful when adding a debugPrint-here)
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
    "
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
    owningProcess isNil ifTrue:[
699
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   136
        count := 1.
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   137
        owningProcess := thisProcess.
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   138
        ^ self
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
    ].
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
    owningProcess == thisProcess ifTrue:[
699
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   142
        count := count + 1.
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   143
        ^ self
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
   144
    ].
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
   145
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
    wasBlocked := OperatingSystem blockInterrupts.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    [
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   148
        owningProcess isDead ifTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   149
            'Monitor [warning]: entering monitor owned by dead process' errorPrintCR.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   150
            "/ self halt.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   151
        ] ifFalse:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   152
            [owningProcess notNil] whileTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   153
                thisProcess state:#monWait.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   154
                (sema waitWithTimeout:10) isNil ifTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   155
                    (owningProcess notNil and:[owningProcess isDead]) ifTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   156
                        'Monitor [warning]: aquire monitor from dead process' errorPrintCR.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   157
                        owningProcess := nil.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   158
                    ]
709
5a8ddf63e001 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 699
diff changeset
   159
                ]
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   160
            ].
699
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   161
        ].
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   162
        count := 1.
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   163
        owningProcess := thisProcess.
1021
da84f1e9cadf #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
   164
    ] ensure:[
699
01af80ac55c5 dont halt when entering a monitor owned by a dead process
Claus Gittinger <cg@exept.de>
parents: 642
diff changeset
   165
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
    ]
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   168
    "Modified: / 8.1.1999 / 13:56:28 / cg"
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
!
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
exit
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
    "exit the monitor"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
    |thisProcess|
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
405
1541a9ccda16 allow exit if already free
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   176
    count == 0 ifTrue:[
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
   177
	'MONITOR [info]: already left' errorPrintCR.
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
   178
	^ self
405
1541a9ccda16 allow exit if already free
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   179
    ].
1541a9ccda16 allow exit if already free
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   180
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
    thisProcess := Processor activeProcess.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
    "
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
     this works only since interrupts are only serviced at 
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
     message send and method-return time ....
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
     If you add a message send into the ifTrue:-block, things will
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
     go mad ... (especially be careful when adding a debugPrint-here)
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
    "
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
    owningProcess ~~ thisProcess ifTrue:[
599
83af18019cc9 care for dead process holding a monitor
Claus Gittinger <cg@exept.de>
parents: 560
diff changeset
   190
	self halt:'invalid exit'
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
    ].
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
    count := count - 1.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
    count ~~ 0 ifTrue:[ ^ self].
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
    owningProcess := nil.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
    sema signal.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
560
feae8d3ae643 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 485
diff changeset
   199
    "Modified: 21.8.1997 / 16:44:17 / cg"
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   200
!
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   201
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   202
fakeEnter:aProcess count:additionalCount
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   203
    "(fake-)enter the monitor, without blocking.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   204
     Raises an error, if the monitor is not free and owned by another process"
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   205
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   206
    |wasBlocked|
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   207
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   208
    "
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   209
     this works only since interrupts are only serviced at 
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   210
     message send and method-return time ....
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   211
     If you add a message send into the ifTrue:-block, things will
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   212
     go mad ... (especially be careful when adding a debugPrint-here)
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   213
    "
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   214
    owningProcess isNil ifTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   215
        count := additionalCount.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   216
        owningProcess := aProcess.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   217
        ^ self
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   218
    ].
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   219
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   220
    wasBlocked := OperatingSystem blockInterrupts.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   221
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   222
    owningProcess == aProcess ifTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   223
        count := count + additionalCount.
768
671ad758b7da oops - did leave interrupts blocked sometimes
Claus Gittinger <cg@exept.de>
parents: 718
diff changeset
   224
        wasBlocked ifFalse:[ OperatingSystem unblockInterrupts].
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   225
        ^ self
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   226
    ].
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   227
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   228
    owningProcess isDead ifTrue:[
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   229
        'Monitor [warning]: (fake)entering monitor owned by dead process' errorPrintCR.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   230
        "/ self halt.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   231
        owningProcess := aProcess.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   232
        count := additionalCount.
768
671ad758b7da oops - did leave interrupts blocked sometimes
Claus Gittinger <cg@exept.de>
parents: 718
diff changeset
   233
        wasBlocked ifFalse:[ OperatingSystem unblockInterrupts].
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   234
        ^ self
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   235
    ].
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   236
768
671ad758b7da oops - did leave interrupts blocked sometimes
Claus Gittinger <cg@exept.de>
parents: 718
diff changeset
   237
    wasBlocked ifFalse:[ OperatingSystem unblockInterrupts].
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   238
    self error:'Cannot fakeEnter monitor owned by another process'.
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   239
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   240
    "Created: / 8.1.1999 / 13:54:44 / cg"
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   241
    "Modified: / 8.1.1999 / 13:57:42 / cg"
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
! !
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
!Monitor methodsFor:'initialization'!
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
initialize
485
fe9c2ff10461 added friendly semaphore names
Claus Gittinger <cg@exept.de>
parents: 405
diff changeset
   247
    sema := Semaphore new name:'monitorSema'.
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
    count := 0.
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
    "Created: 3.5.1996 / 17:24:59 / cg"
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
! !
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   253
!Monitor methodsFor:'queries'!
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   254
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   255
count
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   256
    owningProcess isNil ifTrue:[^ 0].
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   257
    ^ count
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   258
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   259
    "Created: / 8.1.1999 / 13:59:30 / cg"
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   260
    "Modified: / 8.1.1999 / 14:00:01 / cg"
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   261
!
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   262
273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   263
isFree
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   264
    "return true, if the monitor is free
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   265
     (i.e. noone waits and count is zero)"
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   266
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   267
    |wasBlocked ret|
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   268
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   269
    owningProcess isNil ifTrue:[^ true].
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   270
    count == 0 ifTrue:[^ true].
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   271
273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   272
    ret := true.
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   274
    wasBlocked := OperatingSystem blockInterrupts.
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   275
    owningProcess notNil ifTrue:[
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   276
        ret := false
273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   277
    ] ifFalse:[
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   278
        sema numberOfWaitingProcesses ~~ 0 ifTrue:[ret := false].
273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   279
    ].
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   280
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   281
    ^ ret.
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   282
718
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   283
    "Created: / 3.5.1996 / 18:08:38 / cg"
ba2260d7863f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 716
diff changeset
   284
    "Modified: / 8.1.1999 / 13:59:53 / cg"
710
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   285
!
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   286
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   287
owningProcess
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   288
    "return the monitors owner; or nil, if its free"
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   289
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   290
    ^ owningProcess
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   291
b17b877ac7b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
   292
    "Created: / 11.12.1998 / 13:43:39 / cg"
273
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   293
! !
c66a8556b40f added isFree-query
Claus Gittinger <cg@exept.de>
parents: 272
diff changeset
   294
560
feae8d3ae643 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 485
diff changeset
   295
!Monitor class methodsFor:'documentation'!
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
version
3061
3fb64baa8409 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 2961
diff changeset
   298
    ^ '$Header: /cvs/stx/stx/libbasic2/Monitor.st,v 1.18 2013-07-25 09:40:25 cg Exp $'
272
32ebd03ddb58 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
! !
2961
93ab3ea39189 class: Monitor
Claus Gittinger <cg@exept.de>
parents: 1021
diff changeset
   300