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

expectvalue %String
run
^ Object _newKernelSubclass: #Delay
  instVarNames: #(#interval #signalTime #target)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[
	#[#interval, Integer],
	#[#signalTime, Integer],
	#[#target, Object]
	]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 907

%

! Remove existing behavior from Delay
removeallmethods Delay
removeallclassmethods Delay

! ------------------- Class methods for Delay
category: 'For Documentation Installation only'
classmethod
installDocumentation
| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'Delay is used in conjunction with GsProcess and ProcessorScheduler
 to suspend processes for specified amounts of time, and to resume 
 processes. '.

doc documentClassWith: txt.

self description: doc.
%

category: 'Instance Creation'
classmethod: Delay
new

"Disallowed."

self shouldNotImplement: #new
%

category: 'Instance Creation'
classmethod: Delay
forMilliseconds: millisecondCount
  "Answer a new instance that will suspend the active process
   for millisecondCount milliseconds when sent the message wait."
   
  ^super new interval: millisecondCount
%
category: 'Instance Creation'
classmethod: Delay
forSeconds: secondCount
  "Answer a new instance that will suspend the active process
   for secondCount seconds when sent the message wait."
  
  ^self forMilliseconds: secondCount * 1000
%
category: 'Instance Creation'
classmethod: Delay
untilMilliseconds: millisecondValue
  "Answer a new instance that will suspend the active process
   until the millisecond clock reaches the value millisecondValue."
  
  millisecondValue _validateClass: Integer.
  millisecondValue < 0 ifTrue:[
    ^ millisecondValue _error: #rtErrArgNotPositive 
  ].
  ^super new _signalTime: millisecondValue
%
category: 'Process Delay'
classmethod: Delay
waitForMilliseconds: millisecondCount
  "Suspends the active process for millisecondCount milliseconds.
   Note that this method does not create or use an instance of Delay.
   Returns the receiver."

  | ps |
  millisecondCount < 0 ifTrue:[
    ^ millisecondCount _error: #rtErrArgNotPositive 
  ].
  ps := ProcessorScheduler scheduler.   
  ps _waitUntilMilliseconds: ((ps _now) + millisecondCount).
  ^self
%
category: 'GBS Access'
classmethod: Delay
_highPriorityWaitForMilliseconds: millisecondCount
  "Set the active process's priority high and then
   suspends the active process for millisecondCount milliseconds.
   Note that this method does not create or use an instance of Delay.
   Returns the receiver."

  | ps |
  ps := ProcessorScheduler scheduler.
  ps activeProcess priority: (ps highestPriority).
  ps _waitUntilMilliseconds: ((ps _now) + millisecondCount).
  ^self
%
category: 'Process Delay'
classmethod: Delay
waitForSeconds: secondCount
  "Suspends the active process for secondCount seconds.
   Note that this method does not create or use an instance of Delay.
   Returns the receiver."
  
  | ps |
  secondCount < 0 ifTrue:[
    ^ secondCount _error: #rtErrArgNotPositive 
  ].
  ps := ProcessorScheduler scheduler.   
  ps _waitUntilMilliseconds: ((ps _now) + (secondCount * 1000)).
  ^self
%
category: 'Process Delay'
classmethod: Delay
waitUntilMilliseconds: millisecondValue
  "Suspends the active process until the millisecond clock
   reaches the value millisecondValue.
   Note that this method does not create or use an instance of Delay.
   Returns the receiver."

  ProcessorScheduler scheduler _waitUntilMilliseconds: millisecondValue.
  ^self
%
category:  'General Inquiries'
classmethod: Delay
millisecondClockValue
  "Returns the current value of the millisecond clock.

   Gs64 v2.2, changed to no longer rollover to zero after 524287999 "

<primitive: 651>
^ self _primitiveFailed: #millisecondClockValue
%
! ------------------- Instance methods for Delay
category: 'Private'
method: Delay
_activate
  "Causes the receiver to signal any processes that have sent wait to it."

  target _signalAll.
  target := nil.
  ^self
%
category: 'Private'
method: Delay
_targetProcess
  "Returns the GsProcess that is waiting for the receiver."

  ^(target isKindOf: Semaphore)
     ifTrue: [nil]
     ifFalse: [target] 
%
category: 'Process Delay'
method: Delay
signal
  "Causes the receiver to signal any processes that have sent wait to it."

  ProcessorScheduler scheduler _delayUnschedule: self.
  ^self _activate.
%
category: 'Private'
method: Delay
_cancel: aGsProcess
  "Cancels a delay that is in progress.
   The receiver will not signal any processes that have sent wait to it.
   Only use if you know that the processes that are waiting on the receiver
   will be signalled in some other way."

  (aGsProcess == target) ifTrue: [
    ProcessorScheduler scheduler _delayUnschedule: self.
    target := nil.
  ].
%
category: 'Private'
method: Delay
interval: millisecondCount
  "initialize the receiver to delay on an interval"
  
  millisecondCount _validateClass: Integer.
  millisecondCount < 0 ifTrue:[
    ^ millisecondCount _error: #rtErrArgNotPositive 
  ].
  interval := millisecondCount.
  signalTime := nil.
  target := nil.
%
category: 'Formatting'
method: Delay
printOn: aStream
  aStream
    nextPutAll: self class name;
    nextPut: $(.
  self asOop printOn: aStream.
  aStream nextPutAll: ',i='.
  interval printOn: aStream.
  aStream nextPutAll: ',t='.
  signalTime printOn: aStream.
  aStream nextPutAll: ',s='.
  target printOn: aStream.
  aStream nextPut: $).
%
category: 'Accessing'
method: Delay
resumptionTime
  "Answer the value of the millisecond clock at which
   the delayed process will be resumed.  This will be nil
   if the receiver was created with an interval and no
   wait has been issued."

  (interval == nil) ifTrue: [
    ^signalTime
  ] ifFalse: [
    self inProgress ifTrue: [
      ^signalTime
    ] ifFalse: [
      ^nil
    ]. 
  ].
%
category: 'Private'
method: Delay
_signalTime
  ^signalTime
%
category: 'Private'
method: Delay
_signalTime: millisecondValue
  "initialize the receiver to delay until an absolute clock time"
  
  signalTime := millisecondValue.
  interval := nil.
  target := nil.
%
category: 'Testing'
method: Delay
inProgress
  "Returns true if a GsProcess is currently waiting on the receiver."

  ^(target ~~ nil)
%
category: 'Process Delay'
method: Delay
wait
  "Suspend the active process until the millisecond clock
   reaches the appropriate value."

  (interval ~~ nil) ifTrue: [
    "If another process is already using this interval delay raise an error"
    self inProgress ifTrue: [
      System signal: (ErrorSymbols at: #rtErrDelayInProgress)
             args: #[ self ] signalDictionary: GemStoneError.
      ^self
    ].
    signalTime := interval + (ProcessorScheduler scheduler _now).
    target := ProcessorScheduler scheduler activeProcess.
    target _location: self.
    ProcessorScheduler scheduler _delaySchedule: self.
  ] ifFalse: [
    (target == nil) ifTrue: [
      target := Semaphore new.
      ProcessorScheduler scheduler _delaySchedule: self.
    ].
  ].

  target _wait.
  ^self
%
category: 'Private'
method: Delay
_signalTime: millisecondClockValue
  "sets the receiver's signal time w/o regard to the current time
   or delay interval"
  
  signalTime := millisecondClockValue
%

category: 'Private'
method: Delay
_unscheduleProcess: aGsProcess
  "Used by ProcessorScheduler"
  self _cancel: aGsProcess.
%

category: 'Private'
method: Delay
_changePriority: aGsProcess from: oldPriority
  "Used by GsProcess to change the priority of a GsProcess in the receiver."
  "nothing needs to be done"
%
