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

! Forward references needed
run
Globals at: #Semaphore ifAbsent: [Globals at: #Semaphore put: nil].
true
%

expectvalue %String
run
^ Object _newKernelSubclass: #SharedQueue
  instVarNames: #(#valueAvailable #contents)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[
	#[#valueAvailable, Semaphore],
	#[#contents, Array]
	]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 915

%

! Remove existing behavior from SharedQueue
removeallmethods SharedQueue
removeallclassmethods SharedQueue

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

category: 'Instance Creation'
classmethod: SharedQueue
new: size
  "Answer a new SharedQueue.  The argument is ignored "
  ^self new
%

! ------------------- Instance methods for SharedQueue

category: 'Private'
method: SharedQueue
initialize
  
  valueAvailable := Semaphore new.
  contents := Array new.
%

category: 'Removing'
method: SharedQueue
next
  "Returns with the first object added to the receiver that has not
   yet been removed. If the receiver is empty, the active
   GsProcess waits until an object is added to it.
   If more than one GsProcess is waiting then the one with the
   highest priority that has been waiting the longest will get the
   next item added."

  |value|

  valueAvailable wait.
  value := contents removeFirst.
  ^value
%

category: 'Accessing'
method: SharedQueue
peek
  "Returns the result of next without removing the object. If the
   receiver is empty return nil."

  |value actualSize |

  actualSize := self size.
  (actualSize == 0) ifTrue: [
    value := nil.
  ] ifFalse: [
    | nextIdx |
    "Some of the first elements may belong to guys waiting on the semaphore
     that have already been signalled but have not yet had a chance to run."
    nextIdx := (contents size) - (actualSize - 1).
    value := contents at: nextIdx.
  ].
  ^value
%

category: 'Adding'
method: SharedQueue
nextPut: value
  "Add value to the contents of the receiver. If a GsProcess has been
   waiting for an object, allow it to proceed.
   Returns the added value."

  contents addLast: value.
  valueAvailable signal.
  ^value.
%

category: 'Accessing'
method: SharedQueue
size
  "Return the number of object that are still in the queue."

  ^valueAvailable excessSignals
%

category: 'Testing'
method: SharedQueue
isEmpty
  "Return true if the receiver does not contains any objects."

  ^(self size == 0)
%

category: 'Formatting'
method: SharedQueue
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

| startIdx sz |
super printOn: aStream .
aStream nextPutAll: '( ' .
sz := contents size.
(self isEmpty) ifFalse: [
  startIdx := sz - (self size - 1).
  contents from: startIdx to: sz doWithIndex: [ :anElement :count |
    aStream position > 700 ifTrue:[
      "prevent infinite recursion when printing cyclic structures, and 
       limit the size of result when printing large collections."
      aStream nextPutAll: '...)' .
      ^ self 
      ] .
    anElement printOn: aStream .
    count < sz ifTrue:[ aStream nextPutAll: ', ' ].
  ].
].
aStream nextPut: $) .
%

category: 'Private'
method: SharedQueue
_reapSignal: signalSource
  "Put signalSource on the receiver."

  self nextPut: signalSource
%
category: 'Private'
method: SharedQueue
_setupReapSignalLocation: anObject
  "Make the receiver ready to be sent _reapSignal:."
  "Nothing is needed"
%
