!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: criticalsection.gs,v 1.7 2008-01-09 22:50:10 stever Exp $
!
! Superclass Hierarchy:
!   CriticalSection, Object
!
!=========================================================================

    

expectvalue %String
run
^ Object _newKernelSubclass: #CriticalSection
  instVarNames: #(#owner #semaphore)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[
	#[#owner, GsProcess],
	#[#semaphore, Semaphore]
	]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 917

%

! Remove existing behavior from CriticalSection
removeallmethods CriticalSection
removeallclassmethods CriticalSection

! ------------------- Class methods for CriticalSection
category: 'Instance Creation'
classmethod: CriticalSection
new
  "Answer a new CriticalSection"
  ^self basicNew _initialize
%

! ------------------- Instance methods for CriticalSection
category: 'Blue Book Protocol'
method: CriticalSection
critical: aBlock
  "Wait until no other processes are sending critical to the receiver
   and then execute aBlock and return its value."

  | value activeProcess |

  activeProcess := ProcessorScheduler scheduler activeProcess.
  (owner == activeProcess) ifFalse: [
    semaphore wait.
    owner := activeProcess.
    value := aBlock ensure: [
      owner := nil.
      semaphore signal.
    ].
  ] ifTrue: [
    value := aBlock value.
  ].
  ^value
%

category: 'Private'
method: CriticalSection
_initialize

  owner := nil.
  semaphore := Semaphore forMutualExclusion.
%
