The Trunk: Kernel-eem.971.mcz

Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.971.mcz

==================== Summary ====================

Name: Kernel-eem.971
Author: eem
Time: 5 January 2016, 4:08:44.090307 pm
UUID: c93c23ad-9714-49c1-a2fd-a44b74e0bb63
Ancestors: Kernel-eem.970

Move time from a basis of mixed second clock/millisecond clock primitives to a single microsecond clock basis (albeit with two primitives, one for local and one for UTC microseconds).

Derive millisecond and second clocks from local microsecond clock.  Hence eliminate tests for millisecond clock overflow and use of the millisecond clock mask.

Change Delay's resumptionTime from a millisecond clock value to a utc microsecond clock value.

Eliminate unused offsets in DateAndTime and hence avoid spin loop at start-up waiting for the second clock to roll over.

=============== Diff against Kernel-eem.970 ===============

Item was added:
+ (PackageInfo named: 'Kernel') preamble: '"below, add code to be run before the loading of this package"
+ Delay stopTimerEventLoop; saveResumptionTimes'!

Item was changed:
  Magnitude subclass: #DateAndTime
  instanceVariableNames: 'seconds offset jdn nanos'
+ classVariableNames: 'ClockProvider DaysSinceEpoch LocalTimeZone'
- classVariableNames: 'ClockProvider DaysSinceEpoch LastMilliSeconds LastTick LastTickSemaphore LocalTimeZone MilliSecondOffset OffsetsAreValid'
  poolDictionaries: 'ChronologyConstants'
  category: 'Kernel-Chronology'!
 
  !DateAndTime commentStamp: 'brp 5/13/2003 08:07' prior: 0!
  I represent a point in UTC time as defined by ISO 8601. I have zero duration.
 
 
  My implementation uses three SmallIntegers
   and a Duration:
  jdn - julian day number.
  seconds - number of seconds since midnight.
  nanos - the number of nanoseconds since the second.
 
  offset - duration from UTC.
 
  The nanosecond attribute is almost always zero but it defined for full ISO compliance and is suitable for timestamping.
  !

Item was changed:
  ----- Method: DateAndTime class>>initialize (in category 'initialize-release') -----
  initialize
 
  super initialize.
 
  ClockProvider := Time.
- LastTickSemaphore := Semaphore forMutualExclusion.
- LastMilliSeconds := 0.
- LastTick := 0.
  Smalltalk addToStartUpList: self.
+ self startUp: true!
- self startUp: true
- !

Item was removed:
- ----- Method: DateAndTime class>>initializeOffsets (in category 'initialize-release') -----
- initializeOffsets
- | durationSinceEpoch secondsSinceMidnight nowSecs |
- LastTick := 0.
- nowSecs := self clock secondsWhenClockTicks.
- LastMilliSeconds := self millisecondClockValue.
- durationSinceEpoch := Duration
- days: SqueakEpoch
- hours: 0
- minutes: 0
- seconds: nowSecs.
- DaysSinceEpoch := durationSinceEpoch days.
- secondsSinceMidnight := (durationSinceEpoch -
- (Duration
- days: DaysSinceEpoch
- hours: 0
- minutes: 0
- seconds: 0)) asSeconds.
- MilliSecondOffset := secondsSinceMidnight * 1000 - LastMilliSeconds!

Item was changed:
  ----- Method: DateAndTime class>>milliSecondsSinceMidnight (in category 'squeak protocol') -----
  milliSecondsSinceMidnight
+ ^Time milliSecondsSinceMidnight!
- | msm msClock |
-
- "This is usually only during system startup..."
- self waitForOffsets.
-
- msClock := self millisecondClockValue.
- msClock < LastMilliSeconds ifTrue: [ "rolled over"
- MilliSecondOffset := MilliSecondOffset + (SmallInteger maxVal // 2) + 1 ].
- LastMilliSeconds := msClock.
- [
- msm := msClock + MilliSecondOffset.
- msm >= 86400000 ] whileTrue: [
- "next day"
- LastTick := -1.
- DaysSinceEpoch := DaysSinceEpoch + 1.
- MilliSecondOffset := MilliSecondOffset - 86400000 ].
- "day rolled over sanity check"
- (LastTick = -1 and: [
- (Duration
- days: SqueakEpoch
- hours: 0
- minutes: 0
- seconds: self clock totalSeconds) days ~= DaysSinceEpoch ]) ifTrue: [
- self initializeOffsets.
- ^ self milliSecondsSinceMidnight ].
- ^ msm.!

Item was changed:
  ----- Method: DateAndTime class>>startUp: (in category 'initialize-release') -----
  startUp: resuming
+ | durationSinceEpoch |
+ resuming ifFalse: [^self].
+ durationSinceEpoch := Duration
+ days: SqueakEpoch
+ hours: 0
+ minutes: 0
+ seconds: self clock totalSeconds.
+ DaysSinceEpoch := durationSinceEpoch days!
- resuming ifFalse: [ ^ self ].
- Time initializeMillisecondClockMask.
- OffsetsAreValid := false.
- [
- self initializeOffsets.
- OffsetsAreValid := true
- ] forkAt: Processor userInterruptPriority.!

Item was removed:
- ----- Method: DateAndTime class>>waitForOffsets (in category 'initialize-release') -----
- waitForOffsets
- OffsetsAreValid ifFalse: [
- [
- (Delay forSeconds: 1) wait.
- OffsetsAreValid
- ] whileFalse
- ]!

Item was changed:
  Object subclass: #Delay
  instanceVariableNames: 'delayDuration resumptionTime delaySemaphore beingWaitedOn'
+ classVariableNames: 'AccessProtect ActiveDelay DelaySuspended FinishedDelay RunTimerEventLoop ScheduledDelay SuspendedDelays TimerEventLoop TimingSemaphore'
- classVariableNames: 'AccessProtect ActiveDelay ActiveDelayStartTime DelaySuspended FinishedDelay RunTimerEventLoop ScheduledDelay SuspendedDelays TimerEventLoop TimingSemaphore'
  poolDictionaries: ''
  category: 'Kernel-Processes'!
 
+ !Delay commentStamp: 'eem 1/5/2016 11:58' prior: 0!
- !Delay commentStamp: 'laza 9/5/2009 08:45' prior: 0!
  I am the main way that a process may pause for some amount of time.  The simplest usage is like this:
 
  (Delay forSeconds: 5) wait.
 
  An instance of Delay responds to the message 'wait' by suspending the caller's process for a certain amount of time. The duration of the pause is specified when the Delay is created with the message forMilliseconds: or forSeconds:. A Delay can be used again when the current wait has finished. For example, a clock process might repeatedly wait on a one-second Delay.
 
+ A delay in progress when an image snapshot is saved is resumed when the snapshot is re-started.
- A delay in progress when an image snapshot is saved is resumed when the snapshot is re-started. Delays work across millisecond clock roll-overs.
-
-
  For a more complex example, see  #testDelayOf:for:rect: .
 
  A word of advice:
  This is THE highest priority code which is run in Squeak, in other words it is time-critical. The speed of this code is critical for accurate responses, it is critical for network services, it affects every last part of the system.
 
+ In short: Don't fix it if it ain't broken!! This code isn't supposed to be beautiful, it's supposed to be fast!! The reason for duplicating code is to make it fast. The reason for not using ifNil:[]ifNotNil:[] is that the compiler may not inline those. Since the effect of changes are VERY hard to predict it is best to leave things as they are for now unless there is an actual need to change anything
+
+
+ Instance Variables
+ beingWaitedOn: <UndefinedObject|Boolean>
+ delayDuration: <Integer>
+ delaySemaphore: <Semaphore>
+ resumptionTime: <Integer>
+
+ beingWaitedOn
+ - this is set when the delay is being waited on or is unscheduled.
+
+ delayDuration
+ - the duration of the delay in milliseconds
+
+ delaySemaphore
+ - the semaphore used to suspend process(es) waiting on this delay
+
+ resumptionTime
+ - the value of the UTC miscrosecond clock at which the delay should resume processes waiting on it'!
- In short: Don't fix it if it ain't broken!! This code isn't supposed to be beautiful, it's supposed to be fast!! The reason for duplicating code is to make it fast. The reason for not using ifNil:[]ifNotNil:[] is that the compiler may not inline those. Since the effect of changes are VERY hard to predict it is best to leave things as they are for now unless there is an actual need to change anything!

Item was changed:
  ----- Method: Delay class>>handleTimerEvent (in category 'timer process') -----
  handleTimerEvent
  "Handle a timer event; which can be either:
  - a schedule request (ScheduledDelay notNil)
  - an unschedule request (FinishedDelay notNil)
  - a timer signal (not explicitly specified)
  We check for timer expiry every time we get a signal."
  | nowTick nextTick |
  "Wait until there is work to do."
  TimingSemaphore wait.
+ nowTick := Time utcMicrosecondClock.
 
  "Process any schedule requests"
+ ScheduledDelay ifNotNil:
+ [self scheduleDelay: ScheduledDelay from: nowTick.
+ ScheduledDelay := nil].
- ScheduledDelay ifNotNil:[
- "Schedule the given delay"
- self scheduleDelay: ScheduledDelay.
- ScheduledDelay := nil.
- ].
 
  "Process any unschedule requests"
+ FinishedDelay ifNotNil:
+ [self unscheduleDelay: FinishedDelay.
+ FinishedDelay := nil].
- FinishedDelay ifNotNil:[
- self unscheduleDelay: FinishedDelay.
- FinishedDelay := nil.
- ].
 
- "Check for clock wrap-around."
- nowTick := Time millisecondClockValue.
- nowTick < ActiveDelayStartTime ifTrue: [
- "clock wrapped"
- self saveResumptionTimes.
- self restoreResumptionTimes.
- ].
- ActiveDelayStartTime := nowTick.
-
  "Signal any expired delays"
+ [ActiveDelay notNil
+ and: [nowTick >= ActiveDelay resumptionTime]] whileTrue:
+ [ActiveDelay signalWaitingProcess.
+ ActiveDelay := SuspendedDelays isEmpty ifFalse:
+ [SuspendedDelays removeFirst]].
- [ActiveDelay notNil and:[nowTick >= ActiveDelay resumptionTime]] whileTrue:[
- ActiveDelay signalWaitingProcess.
- SuspendedDelays isEmpty
- ifTrue: [ActiveDelay := nil]
- ifFalse:[ActiveDelay := SuspendedDelays removeFirst].
- ].
 
  "And signal when the next request is due. We sleep at most 1sec here
+ as a soft busy-loop so that we don't accidentally miss signals."
+ nextTick := nowTick + 1000000.
+ ActiveDelay ifNotNil:
+ [nextTick := nextTick min: ActiveDelay resumptionTime].
- as a soft busy-loop so that we don't accidentally miss signals."
- nextTick := nowTick + 1000.
- ActiveDelay ifNotNil:[nextTick := nextTick min: ActiveDelay resumptionTime].
- nextTick := nextTick min: SmallInteger maxVal.
 
  "Since we have processed all outstanding requests, reset the timing semaphore so
+ that only new work will wake us up again. Do this RIGHT BEFORE setting the next
+ wakeup call from the VM because it is only signaled once so we mustn't miss it."
- that only new work will wake us up again. Do this RIGHT BEFORE setting the next
- wakeup call from the VM because it is only signaled once so we mustn't miss it."
  TimingSemaphore initSignals.
+ Delay primSignal: TimingSemaphore atUTCMicroseconds: nextTick!
- Delay primSignal: TimingSemaphore atMilliseconds: nextTick.
-
- "This last test is necessary for the obscure case that the msecs clock rolls over
- after nowTick has been computed (unlikely but not impossible). In this case we'd
- wait for MillisecondClockMask msecs (roughly six days) or until another delay gets
- scheduled (which may not be any time soon). In any case, since handling the
- condition is easy, let's just deal with it"
- Time millisecondClockValue < nowTick ifTrue:[TimingSemaphore signal]. "retry"
- !

Item was changed:
+ ----- Method: Delay class>>restoreResumptionTimes (in category 'timer process') -----
- ----- Method: Delay class>>restoreResumptionTimes (in category 'snapshotting') -----
  restoreResumptionTimes
+ "Private!! Restore the resumption times of all scheduled Delays after a snapshot.
+ This method should be called only while the AccessProtect semaphore is held."
- "Private!! Restore the resumption times of all scheduled Delays after a snapshot or clock roll-over. This method should be called only while the AccessProtect semaphore is held."
 
  | newBaseTime |
+ newBaseTime := Time utcMicrosecondClock.
+ SuspendedDelays do:
+ [:d | d adjustResumptionTimeOldBase: 0 newBase: newBaseTime].
+ ActiveDelay ifNotNil:
+ [ActiveDelay adjustResumptionTimeOldBase: 0 newBase: newBaseTime]!
- newBaseTime := Time millisecondClockValue.
- SuspendedDelays do: [:d | d adjustResumptionTimeOldBase: 0 newBase: newBaseTime].
- ActiveDelay == nil ifFalse: [
- ActiveDelay adjustResumptionTimeOldBase: 0 newBase: newBaseTime.
- ].
- ActiveDelayStartTime := newBaseTime.
- !

Item was changed:
+ ----- Method: Delay class>>saveResumptionTimes (in category 'timer process') -----
- ----- Method: Delay class>>saveResumptionTimes (in category 'snapshotting') -----
  saveResumptionTimes
+ "Private!! Record the resumption times of all Delays relative to a base time of zero.
+ This is done prior to snapshotting. This method should be called only while the
+ AccessProtect semaphore is held."
- "Private!! Record the resumption times of all Delays relative to a base time of zero. This is done prior to snapshotting or adjusting the resumption times after a clock roll-over. This method should be called only while the AccessProtect semaphore is held."
 
  | oldBaseTime |
+ oldBaseTime := Time utcMicrosecondClock.
+ ActiveDelay ifNotNil:
+ [ActiveDelay adjustResumptionTimeOldBase: oldBaseTime newBase: 0].
- oldBaseTime := Time millisecondClockValue.
- ActiveDelay == nil
- ifFalse: [
- oldBaseTime < ActiveDelayStartTime
- ifTrue: [oldBaseTime := ActiveDelayStartTime].  "clock rolled over"
- ActiveDelay adjustResumptionTimeOldBase: oldBaseTime newBase: 0].
  SuspendedDelays do:
+ [:d | d adjustResumptionTimeOldBase: oldBaseTime newBase: 0]!
- [:d | d adjustResumptionTimeOldBase: oldBaseTime newBase: 0].
- !

Item was changed:
  ----- Method: Delay class>>startTimerEventLoop (in category 'timer process') -----
  startTimerEventLoop
  "Start the timer event loop"
  "Delay startTimerEventLoop"
  self stopTimerEventLoop.
  AccessProtect := Semaphore forMutualExclusion.
- ActiveDelayStartTime := Time millisecondClockValue.
  SuspendedDelays :=
  Heap withAll: (SuspendedDelays ifNil:[#()])
  sortBlock: [:d1 :d2 | d1 resumptionTime <= d2 resumptionTime].
  TimingSemaphore := Semaphore new.
  RunTimerEventLoop := true.
  TimerEventLoop := [self runTimerEventLoop] newProcess.
  TimerEventLoop priority: Processor timingPriority.
  TimerEventLoop resume.
+ TimingSemaphore signal "get going"!
- TimingSemaphore signal. "get going"
- !

Item was changed:
  ----- Method: Random>>seed: (in category 'initialization') -----
  seed: anIntegerOrNil
+ "Use the given integer as the seed, or generate one if it's nil."
- " Use the given integer as seed, or generate one if it's nil. "
 
  | newSeed |
+ newSeed := anIntegerOrNil ifNil:
+ [(Time utcMicrosecondClock bitShift: 28) bitXor: self hash hashMultiply].
+ (newSeed between: 0 and: 16rFFFFFFFF) ifFalse:
+ [newSeed := self hashSeed: newSeed].
- newSeed := anIntegerOrNil ifNil: [
- | now |
- now := Time primUTCMicrosecondClock.
- now = 0 ifTrue: [ now := Time millisecondClockValue ].
- (now bitShift: 28) bitXor: self hash hashMultiply ].
- (newSeed between: 0 and: 16rFFFFFFFF) ifFalse: [
- newSeed := self hashSeed: newSeed ].
  self
  initializeStatesWith: newSeed;
  generateStates!

Item was changed:
  Magnitude subclass: #Time
  instanceVariableNames: 'seconds nanos'
+ classVariableNames: ''
- classVariableNames: 'MillisecondClockMask'
  poolDictionaries: 'ChronologyConstants'
  category: 'Kernel-Chronology'!
 
  !Time commentStamp: 'dew 10/23/2004 17:58' prior: 0!
  This represents a particular point in time during any given day.  For example, '5:19:45 pm'.
 
  If you need a point in time on a particular day, use DateAndTime.  If you need a duration of time, use Duration.
  !

Item was removed:
- ----- Method: Time class>>initializeMillisecondClockMask (in category 'clock') -----
- initializeMillisecondClockMask
- "Initialize cached value from the VM, or set to nil if VM cannot support the request"
-
- MillisecondClockMask := self primMillisecondClockMask
- !

Item was changed:
  ----- Method: Time class>>localMicrosecondClock (in category 'clock') -----
  localMicrosecondClock
+ "Answer the local microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century).
+ The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds
+ between the two epochs according to RFC 868, and with an offset duration corresponding to the current
+ offset of local time from UTC."
- "Answer the number of microseconds since the start of the 20th century in local time."
  <primitive: 241>
  ^0!

Item was changed:
  ----- Method: Time class>>milliSecondsSinceMidnight (in category 'ansi protocol') -----
  milliSecondsSinceMidnight
+ ^self localMicrosecondClock // 1000 \\ 86400000 "24 * 60 * 60 * 1000"!
-
- ^ DateAndTime milliSecondsSinceMidnight!

Item was removed:
- ----- Method: Time class>>millisecondClockMask (in category 'general inquiries') -----
- millisecondClockMask
- "Answer the mask used for millisecond clock rollover in the virtual machine.
- Answer a default if the VM cannot supply the value."
-
- ^MillisecondClockMask ifNil: [16r1FFFFFFF]
- !

Item was changed:
  ----- Method: Time class>>millisecondClockValue (in category 'general inquiries') -----
  millisecondClockValue
+ "Answer the value of the millisecond clock."
- "Answer the number of milliseconds since the millisecond clock was last reset or rolled over.
- Answer 0 if the primitive fails."
 
+ ^self localMicrosecondClock // 1000!
- <primitive: 135>
- ^ 0!

Item was changed:
  ----- Method: Time class>>milliseconds:since: (in category 'squeak protocol') -----
  milliseconds: currentTime since: lastTime
+ "Answer the elapsed time since last recorded in milliseconds (i.e. of millisecondClockValue).
+ Since the time basis is now a 61-bit or greater UTC microsecond clock, rollover is no longer an issue."
- "Answer the elapsed time since last recorded in milliseconds.
- Compensate for rollover."
 
+ ^currentTime - lastTime!
- | delta |
- delta := currentTime - lastTime.
- ^ delta < 0
- ifTrue: [self millisecondClockMask + delta]
- ifFalse: [delta]!

Item was changed:
  ----- Method: Time class>>millisecondsToRun: (in category 'general inquiries') -----
  millisecondsToRun: timedBlock
  "Answer the number of milliseconds timedBlock takes to return its value."
 
+ | startUsecs |
+ startUsecs := self utcMicrosecondClock.
- | initialMilliseconds |
- initialMilliseconds := self millisecondClockValue.
  timedBlock value.
+ ^self utcMicrosecondClock - startUsecs + 500 // 1000!
- ^self millisecondsSince: initialMilliseconds!

Item was removed:
- ----- Method: Time class>>primLocalMicrosecondClock (in category 'clock') -----
- primLocalMicrosecondClock
- "Answer the local microseconds since the Smalltalk epoch. The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds between the two epochs according to RFC 868, and with an offset duration corresponding to the current offset of local time from UTC."
-
- <primitive: 241>
- ^0!

Item was removed:
- ----- Method: Time class>>primMicrosecondClock (in category 'clock') -----
- primMicrosecondClock
- "Answer the number of microseconds since the microsecond clock
- was last reset or rolled over. Answer zero if the primitive fails."
-
- <primitive: 'primitiveMicrosecondClock'>
- ^ 0!

Item was removed:
- ----- Method: Time class>>primMillisecondClock (in category 'smalltalk-80') -----
- primMillisecondClock
- "Primitive. Answer the number of milliseconds since the millisecond clock
- was last reset or rolled over. Answer zero if the primitive fails.
- Optional. See Object documentation whatIsAPrimitive."
-
- <primitive: 135>
- ^ 0!

Item was removed:
- ----- Method: Time class>>primMillisecondClockMask (in category 'clock') -----
- primMillisecondClockMask
- "Answer the mask value used for millisecond clock rollover in the
- virtual machine, or nil if the VM cannot support the request."
-
- <primitive: 'primitiveMillisecondClockMask'>
- ^nil!

Item was removed:
- ----- Method: Time class>>primSecondsClock (in category 'smalltalk-80') -----
- primSecondsClock
- "Answer the number of seconds since 00:00 on the morning of
- January 1, 1901 (a 32-bit unsigned number).
- Essential. See Object documentation whatIsAPrimitive. "
-
- <primitive: 137>
- self primitiveFailed!

Item was removed:
- ----- Method: Time class>>primUTCMicrosecondClock (in category 'clock') -----
- primUTCMicrosecondClock
- "Answer the UTC microseconds since the Smalltalk epoch. The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds between the two epochs according to RFC 868."
-
- <primitive: 240>
- ^0!

Item was removed:
- ----- Method: Time class>>secondsWhenClockTicks (in category 'clock') -----
- secondsWhenClockTicks
-
- "waits for the moment when a new second begins"
-
- | lastSecond delay |
-
- delay :=  Delay forMilliseconds: 1.
- lastSecond := self primSecondsClock.
- [ lastSecond = self primSecondsClock ] whileTrue: [ delay wait ].
-  
- ^ lastSecond + 1!

Item was changed:
  ----- Method: Time class>>totalSeconds (in category 'smalltalk-80') -----
  totalSeconds
+ "Answer the total seconds since the Squeak epoch: 1 January 1901, in local time."
- "Answer the total seconds since the Squeak epoch: 1 January 1901."
 
+ ^self localMicrosecondClock // 1000000!
- ^ self primSecondsClock!

Item was changed:
  ----- Method: Time class>>utcMicrosecondClock (in category 'clock') -----
  utcMicrosecondClock
+ "Answer the UTC microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century).
+ The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds
+ between the two epochs according to RFC 868."
- "Answer the number of microseconds since the start of the 20th century in UTC."
  <primitive: 240>
  ^0!

Item was changed:
+ (PackageInfo named: 'Kernel') postscript: '"below, add code to be run after the loading of this package"
+ Delay restoreResumptionTimes; startTimerEventLoop'!
- (PackageInfo named: 'Kernel') postscript: '"Fix accidental non-weak arrays in ObsoleteSubclasses values"
- Behavior classPool at: #ObsoleteSubclasses ifPresent: [:os |
- os keysAndValuesDo: [:superclass :obsoletes |
- obsoletes class isWeak ifFalse: [
- os at: superclass put: (obsoletes as: WeakArray)]]].
- "Remove spurious -- all -- category that crept into Object"
- [Object organization removeCategory: #''-- all --''.
- ] on: Error do: [:e|
- "Category not empty, silently leave it there"
- e return].'!