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