[squeak-dev] The Trunk: Chronology-Core-dtl.18.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jan 1 22:15:07 UTC 2019


David T. Lewis uploaded a new version of Chronology-Core to project The Trunk:
http://source.squeak.org/trunk/Chronology-Core-dtl.18.mcz

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

Name: Chronology-Core-dtl.18
Author: dtl
Time: 1 January 2019, 2:40:33.441753 am
UUID: 0cdf2ac5-c63b-40df-9942-80916d4c7648
Ancestors: Chronology-Core-dtl.17

Bootstrap UTCDateAndTime, step 3 of 5

DateAndTime and TimeStamp are now inactive, having been replaced by LXDateAndTime and LXTimeStamp. Load copies of the reimplemented LXDateAndTime and LXTimeStamp, renamed as DateAndTime and TimeStamp, to replace the original implementations of DateAndTime now.

At this point, DateAndTime is an inactive copy of LXDateAndTime. The next update will activate the new DateAndTime implementation.

=============== Diff against Chronology-Core-dtl.17 ===============

Item was changed:
  Magnitude subclass: #DateAndTime
+ 	instanceVariableNames: 'utcMicroseconds localOffsetSeconds'
+ 	classVariableNames: 'AutomaticTimezone ClockProvider InitializeFromPrimitive LocalTimeZone PosixEpochJulianDays'
- 	instanceVariableNames: 'seconds offset jdn nanos'
- 	classVariableNames: 'AutomaticTimezone ClockProvider LastClockValue LocalTimeZone NanoOffset'
  	poolDictionaries: 'ChronologyConstants'
  	category: 'Chronology-Core'!
  
+ !DateAndTime commentStamp: 'dtl 3/12/2016 10:32' prior: 0!
- !DateAndTime commentStamp: 'bf 2/18/2016 16:20' prior: 0!
  I represent a point in UTC time as defined by ISO 8601. I have zero duration.
  
+ My implementation uses variables utcMicroseconds and localOffsetSeconds. This represents time magnitude as elapsed microseconds since the Posix epoch, with localOffsetSeconds representing local offset from UTC. The magnitude is used for comparison and duration calculations, and the local offset is used for displaying this magnitude in the context of a local time zone.
  
+ The implementation ignores leap seconds, which are adjustments made to maintain earth rotational clock time in synchronization with elapsed seconds.
- 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.
  
+ DateAndTime class>>now will use #primitiveUtcWithOffset to obtain current time in UTC microseconds with current local offset in seconds. The primitive provides an atomic query for UTC time and local offset as measured by the OS platform.  If primitiveUtcWithOffset is not available, the traditional implementation is used, which relies on a primitive for microseconds in the local time zone and derives UTC based on the TimeZone setting.
- offset	- duration from UTC (possibly nil if no timezone information)
- 
- The nanosecond attribute is almost always zero but it defined for full ISO compliance and is suitable for timestamping.
  !

Item was added:
+ ----- Method: DateAndTime class>>canInitializeFromPrimitive (in category 'system startup') -----
+ canInitializeFromPrimitive
+ 	"Some implementations of primitiveUtcWithOffset do not support passing the
+ 	DateAndTime instance as a parameter to the primitive."
+ 
+ 	^self  basicNew initializeFromPrimitive utcMicroseconds notNil!

Item was changed:
  ----- Method: DateAndTime class>>date:time: (in category 'squeak protocol') -----
  date: aDate time: aTime
  
  	^ self 
+ 		year: aDate year
+ 		month: aDate monthIndex
+ 		day: aDate dayOfMonth 
- 		year: aDate year 
- 		day: aDate dayOfYear 
  		hour: aTime hour 
+ 		minute: aTime minute
- 		minute: aTime minute 
  		second: aTime second
+ 		nanoSecond: aTime nanoSecond
  		offset: aDate start offset!

Item was added:
+ ----- Method: DateAndTime class>>daysFromSmalltalkEpochToPosixEpoch (in category 'private') -----
+ daysFromSmalltalkEpochToPosixEpoch
+ 
+ 	^52 * 365 + (17 * 366)!

Item was changed:
  ----- Method: DateAndTime class>>epoch (in category 'squeak protocol') -----
  epoch
  	"Answer a DateAndTime representing the Squeak epoch: 1 January 1901"
  
+ 	^ self utcMicroseconds: self epochOffsetMicros negated offset: 0
+ !
- 	^ self julianDayNumber: SqueakEpoch!

Item was added:
+ ----- Method: DateAndTime class>>epochOffset (in category 'private') -----
+ epochOffset
+ 	"Elaspsed seconds from the Smalltalk epoch to the Posix epoch"
+ 	^self daysFromSmalltalkEpochToPosixEpoch * SecondsInDay!

Item was added:
+ ----- Method: DateAndTime class>>epochOffsetMicros (in category 'private') -----
+ epochOffsetMicros
+ 	"Elaspsed microseconds from the Smalltalk epoch to the Posix epoch"
+ 	^self epochOffset * 1000000!

Item was changed:
  ----- Method: DateAndTime class>>fromSeconds: (in category 'smalltalk-80') -----
  fromSeconds: seconds 
+ 	"Answer a DateAndTime since the Squeak epoch: 1 January 1901
- 	"Answer a DateAndTime since the Squeak epoch: 1 January 1901"
  
+ 	Squeak traditionally used seconds since the Smalltalk epoch in local time,
+ 	which is undefinable. The error was probably caused by some early VM design
+ 	choices that have since been corrected. Assume now that the Smalltalk epoch
+ 	is defined relative to GMT, and that it may be treated similarly to the Posix
+ 	epoch except for a constant offset value.
+ 
+ 	This implementation differs from earlier Squeak in that it uses seconds relative
+ 	to the Smalltalk epoch (not local time), and represents seconds as an arbitrary
+ 	precision number rather than an integer."
+ 
  	^ LXDateAndTime fromSeconds: seconds
  
+ 	"| s uSec offset |
+ 	offset := self localOffsetSeconds.
+ 	s := seconds - self epochOffset.
+ 	uSec := s * 1000000.
+ 	^ self utcMicroseconds: uSec offset: offset"
+ !
- 	"| integerSeconds nanos |
- 	integerSeconds := seconds truncated.
- 	integerSeconds = seconds
- 		ifTrue: [nanos := 0]
- 		ifFalse: [nanos := (seconds - integerSeconds * NanosInSecond) asInteger].
- 	^ self basicNew
- 		ticks: (Array
- 				with: SqueakEpoch
- 				with: integerSeconds
- 				with: nanos)
- 		offset: self localOffset"!

Item was changed:
  ----- Method: DateAndTime class>>fromUnixTime: (in category 'squeak protocol') -----
+ fromUnixTime: utcSeconds
- fromUnixTime: aNumber
  
+ 	^self utcSeconds: utcSeconds offset: 0
+ !
- 
- 	^ self fromSeconds: aNumber + self unixEpoch asSeconds!

Item was changed:
  ----- Method: DateAndTime class>>initialize (in category 'initialize-release') -----
  initialize
+ 
+ 	super initialize.
+ 
+ 	ClockProvider := Time.
+ 	PosixEpochJulianDays := 2440588.
+ 	InitializeFromPrimitive := self canInitializeFromPrimitive.
+ 	Smalltalk addToStartUpList: self.
+ 	self startUp: true
- 	ClockProvider ifNil: [ClockProvider := Time].
- 	Smalltalk addToStartUpList: self after: Delay.
- 	self startUp: true.
  !

Item was changed:
  ----- Method: DateAndTime class>>julianDayNumber:offset: (in category 'squeak protocol') -----
  julianDayNumber: anInteger offset: aDuration 
  
  	^ LXDateAndTime julianDayNumber: anInteger offset: aDuration
  
  	"^self basicNew
  		setJdn: anInteger
  		seconds: 0
  		nano: 0
  		offset: aDuration"!

Item was changed:
  ----- Method: DateAndTime class>>localOffset (in category 'squeak protocol') -----
  localOffset
  	"Answer the duration we are offset from UTC"
  
+ 	^ Duration seconds: self localOffsetSeconds
- 	^ self localTimeZone offset
  !

Item was added:
+ ----- Method: DateAndTime class>>localOffsetSeconds (in category 'private') -----
+ localOffsetSeconds
+ 
+ 	self automaticTimezone
+ 		ifTrue: [ ^Time posixMicrosecondClockWithOffset second ]
+ 		ifFalse: [ ^self localTimeZone offset asSeconds ]!

Item was changed:
  ----- Method: DateAndTime class>>new (in category 'squeak protocol') -----
  new
  	"Answer a DateAndTime representing the Squeak epoch: 1 January 1901"
  
+ 	^ self utcMicroseconds: self epochOffsetMicros negated offset: 0
+ 
+ !
- 	^ self epoch!

Item was changed:
  ----- Method: DateAndTime class>>now (in category 'ansi protocol') -----
  now
+ 	"Answer time now as reported by #primitiveUtcWithOffset. If the primitive is not
+ 	available, answer the Posix epoch GMT."
  
  	^LXDateAndTime now.
  
+ 	"self automaticTimezone
+ 		ifTrue: [ InitializeFromPrimitive
+ 			ifTrue: [ ^ self basicNew initializeFromPrimitive ]
+ 			ifFalse: [ | timeArray |
+ 				timeArray := Time posixMicrosecondClockWithOffset.
+ 				^ self utcMicroseconds: timeArray first offset: timeArray second ] ]
+ 		ifFalse: [ | timeArray |
+ 			timeArray := Time posixMicrosecondClockWithOffset.
+ 			^ self utcMicroseconds: timeArray first offset: self localOffsetSeconds ]"
+ !
- 	"| clockAndOffset localSeconds |
- 	clockAndOffset := self clock utcMicrosecondClockWithOffset.
- 	localSeconds := self localOffset asSeconds.
- 	(self automaticTimezone and: [localSeconds ~= clockAndOffset second])
- 		ifTrue: [self setLocalOffsetAutomatically: (Duration seconds: (localSeconds := clockAndOffset second))].
- 	^self now: clockAndOffset first + (localSeconds * 1000000) offset: self localOffset"!

Item was changed:
  ----- Method: DateAndTime class>>nowAtOffset: (in category 'squeak protocol') -----
  nowAtOffset: offsetDuration
  	"Answers the local time at places with the specified offsetDuration timezone."
  	"local time Chicago (CST)"
  	"DateAndTime nowAtOffset: -6 hours"
+ 
+ 	^ self utcMicroseconds: Time posixMicrosecondClockWithOffset first offset: offsetDuration asSeconds
+ !
- 	^ self now + (offsetDuration - self localOffset) offset: offsetDuration!

Item was added:
+ ----- Method: DateAndTime class>>nowWithOffset: (in category 'squeak protocol') -----
+ nowWithOffset: aDuration
+ 	"Answer time now as reported by #primitiveUtcWithOffset. If the primitive is not
+ 	available, answer the Posix epoch with time zone offset aDuration."
+ 
+ 	| timeArray |
+ 	timeArray := Time posixMicrosecondClockWithOffset.
+ 	^ self utcMicroseconds: timeArray first offset: aDuration asSeconds
+ !

Item was changed:
  ----- Method: DateAndTime class>>readFrom: (in category 'squeak protocol') -----
  readFrom: aStream
  
+ 	| offsetSeconds ch yearMonthDay hourMinuteSecondNano offset |
- 	| offset date time ch |
  
+ 	yearMonthDay := Date readYearMonthDayFrom: aStream.
- 	date := Date readFrom: aStream.
  	[aStream peek isDigit]
  		whileFalse: [aStream next].
+ 	hourMinuteSecondNano := Time readHourMinuteSecondNanoFrom: aStream.
- 	time := Time readFrom: aStream.
  	(aStream atEnd or: [('+-Z' includes: aStream peek) not])
+ 		ifTrue: [ self flag: #FIXME.
+ 				"Different unit tests have conflicting opinions as to whether the
+ 				current local offset should be used as a default. However, the current
+ 				local offset cannot be correct due to DST (offset is itself a function
+ 				of the point in time). Nevertheless, this is a reasonable default considering
+ 				that the offset would have been explicitly part of the date string if it
+ 				was a matter of concern. Unit tests will require updates to match this
+ 				assumption."
+ 				"offsetSeconds := 0"
+ 				offsetSeconds := self localOffsetSeconds]
- 		ifTrue: [offset := self localOffset]
  		ifFalse: [(aStream peekFor: $Z)
+ 			ifTrue: [offsetSeconds := 0]
- 			ifTrue: [offset := Duration zero]
  			ifFalse: [
  				ch := aStream next.
  				ch = $+ ifTrue: [ch := Character space].
+ 				offset := Duration fromString: ch asString, '0:', aStream upToEnd, ':0'.
+ 				offsetSeconds := offset asSeconds]].
- 				offset := Duration fromString: ch asString, '0:', aStream upToEnd, ':0']].
  	^ self
+ 		year: yearMonthDay first
+ 		month: yearMonthDay second
+ 		day: yearMonthDay third
+ 		hour: hourMinuteSecondNano first
+ 		minute: hourMinuteSecondNano second
+ 		second: hourMinuteSecondNano third
+ 		nanoSecond: hourMinuteSecondNano fourth
+ 		offsetSeconds: offsetSeconds
- 		year: date year
- 		month: date monthIndex
- 		day: date dayOfMonth
- 		hour: time hour
- 		minute: time minute
- 		second: time second
- 		nanoSecond: time nanoSecond
- 		offset: offset
  
  
  	"	'-1199-01-05T20:33:14.321-05:00' asDateAndTime
  		' 2002-05-16T17:20:45.1+01:01' asDateAndTime
  
  		' 2002-05-16T17:20:45.02+01:01' asDateAndTime
  
  		' 2002-05-16T17:20:45.003+01:01' asDateAndTime
  
  		' 2002-05-16T17:20:45.0004+01:01' asDateAndTime
    		' 2002-05-16T17:20:45.00005' asDateAndTime
  		' 2002-05-16T17:20:45.000006+01:01' asDateAndTime
  
  		' 2002-05-16T17:20:45.0000007+01:01' asDateAndTime
  		' 2002-05-16T17:20:45.00000008-01:01' asDateAndTime   
  		' 2002-05-16T17:20:45.000000009+01:01' asDateAndTime  
  		' 2002-05-16T17:20:45.0000000001+01:01' asDateAndTime  
  
   		' 2002-05-16T17:20' asDateAndTime
  		' 2002-05-16T17:20:45' asDateAndTime
  		' 2002-05-16T17:20:45+01:57' asDateAndTime
   		' 2002-05-16T17:20:45-02:34' asDateAndTime
   		' 2002-05-16T17:20:45+00:00' asDateAndTime
  		' 1997-04-26T01:02:03+01:02:3' asDateAndTime 
   	"!

Item was changed:
  ----- Method: DateAndTime class>>startUp: (in category 'system startup') -----
  startUp: startingAfresh
  	"Set local timezone"
+ 	startingAfresh
+ 		ifTrue: [InitializeFromPrimitive := self canInitializeFromPrimitive.
+ 			Time initialize. "set LastClockTick to 0".
+ 			self now.
+ 			self automaticTimezone]!
- 	startingAfresh & self automaticTimezone ifTrue: [self now].
- !

Item was added:
+ ----- Method: DateAndTime class>>utcMicroseconds:offset: (in category 'instance creation') -----
+ utcMicroseconds: microsecondsSincePosixEpoch offset: secondsFromGMT
+ 
+ 	^super new
+ 		utcMicroseconds: microsecondsSincePosixEpoch
+ 		offset: secondsFromGMT!

Item was added:
+ ----- Method: DateAndTime class>>utcMicrosecondsForYear:month:day:hour:minute:second:nanoSecond:offsetSeconds: (in category 'private') -----
+ utcMicrosecondsForYear: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount  offsetSeconds: offsetSeconds
+ 
+ 	| monthIndex daysInMonth p q r s julianDayNumber posixDays seconds utcSeconds |
+ 
+ 	monthIndex := month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month].
+ 	daysInMonth := Month
+ 		daysInMonth: monthIndex
+ 		forYear: year.
+ 	day < 1 ifTrue: [self error: 'day may not be zero or negative'].
+ 	day > daysInMonth ifTrue: [self error: 'day is after month ends']. 	
+ 	
+ 	p := (monthIndex - 14) quo: 12.
+ 	q := year + 4800 + p.
+ 	r := monthIndex - 2 - (12 * p).
+ 	s := (year + 4900 + p) quo: 100.
+ 
+ 	julianDayNumber :=
+  		( (1461 * q) quo: 4 ) +
+ 			( (367 * r) quo: 12 ) -
+  				( (3 * s) quo: 4 ) +
+  					( day - 32075 ).
+ 
+ 	posixDays := julianDayNumber - PosixEpochJulianDays.
+ 	seconds := hour * 60 + minute * 60 + second - offsetSeconds.
+ 	utcSeconds := seconds + (posixDays * 24 * 3600).
+ 	^ utcSeconds * 1000000 + (nanoCount / 1000)
+ !

Item was added:
+ ----- Method: DateAndTime class>>utcSeconds:offset: (in category 'instance creation') -----
+ utcSeconds: secondsSincePosixEpoch offset: secondsFromGMT
+ 
+ 	^self
+ 		utcMicroseconds: secondsSincePosixEpoch * 1000000
+ 		offset: secondsFromGMT!

Item was changed:
  ----- Method: DateAndTime class>>year:month:day:hour:minute:second:nanoSecond:offset: (in category 'squeak protocol') -----
  year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset
  	"Return a DateAndTime"
  
+ 	^ LXDateAndTime year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset
- 	| monthIndex daysInMonth p q r s julianDayNumber |
  
+ 	"| offsetSeconds utcMicros |
+ 	offsetSeconds := offset asSeconds.
+ 	utcMicros := self
+ 				utcMicrosecondsForYear: year
+ 				month: month
+ 				day: day
+ 				hour: hour
+ 				minute: minute
+ 				second: second
+ 				nanoSecond: nanoCount
+ 				offsetSeconds: offsetSeconds.
+ 	^ self utcMicroseconds: utcMicros offset: offsetSeconds"!
- 	monthIndex := month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month].
- 	daysInMonth := Month
- 		daysInMonth: monthIndex
- 		forYear: year.
- 	day < 1 ifTrue: [self error: 'day may not be zero or negative'].
- 	day > daysInMonth ifTrue: [self error: 'day is after month ends']. 	
- 	
- 	p := (monthIndex - 14) quo: 12.
- 	q := year + 4800 + p.
- 	r := monthIndex - 2 - (12 * p).
- 	s := (year + 4900 + p) quo: 100.
- 
- 	julianDayNumber :=
-  		( (1461 * q) quo: 4 ) +
- 			( (367 * r) quo: 12 ) -
-  				( (3 * s) quo: 4 ) +
-  					( day - 32075 ).
- 
- 	^self basicNew
- 		setJdn: julianDayNumber 
- 		seconds: hour * 60 + minute * 60 + second
- 		nano: nanoCount
- 		offset: offset;
- 		yourself!

Item was added:
+ ----- Method: DateAndTime class>>year:month:day:hour:minute:second:nanoSecond:offsetSeconds: (in category 'squeak protocol') -----
+ year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offsetSeconds: offsetSeconds
+ 	"Return a DateAndTime"
+ 
+ 	| utcMicros |
+ 	utcMicros := self
+ 				utcMicrosecondsForYear: year
+ 				month: month
+ 				day: day
+ 				hour: hour
+ 				minute: minute
+ 				second: second
+ 				nanoSecond: nanoCount
+ 				offsetSeconds: offsetSeconds.
+ 	^ self utcMicroseconds: utcMicros offset: offsetSeconds!

Item was changed:
  ----- Method: DateAndTime>>+ (in category 'ansi protocol') -----
  + operand
  	"operand conforms to protocol Duration"
  
+ 	^ self class
+ 		utcMicroseconds: operand asDuration asNanoSeconds / 1000 + utcMicroseconds
+ 		offset: localOffsetSeconds
- 	| ticks |
-  	ticks := self ticks + (operand asDuration ticks) .
- 
- 	^ self class basicNew
- 		ticks: ticks
- 		offset: self offset; 
- 		yourself
  !

Item was changed:
  ----- Method: DateAndTime>>- (in category 'ansi protocol') -----
  - operand
  	"operand conforms to protocol DateAndTime or protocol Duration"
  
  	^ (operand respondsTo: #asDateAndTime)
  		ifTrue: 
+ 			[ | micros |
+ 			micros := utcMicroseconds - operand asDateAndTime utcMicroseconds.
+ 			Duration seconds: micros // 1000000 nanoSeconds: micros \\ 1000000 * 1000]
+ 		ifFalse:
+ 			[ self + (operand negated) ]
- 			[ | lticks rticks |
- 			lticks := self asLocal ticks.
- 	
- 		rticks := operand asDateAndTime asLocal ticks.
- 			Duration
-  				seconds: (SecondsInDay *(lticks first - rticks first)) + 
- 							(lticks second - rticks second)
-  				nanoSeconds: (lticks third - rticks third) ]
- 	
- 	ifFalse:
- 		
-  	[ self + (operand negated) ]
  !

Item was changed:
  ----- Method: DateAndTime>>< (in category 'ansi protocol') -----
+ < comparand
- < comparand 
  	"comparand conforms to protocol DateAndTime,
  	or can be converted into something that conforms."
+ 
+ 	^utcMicroseconds < comparand asDateAndTime utcMicroseconds
+ !
- 	| lvalue rvalue comparandAsDateAndTime |
- 	comparandAsDateAndTime := comparand asDateAndTime.
- 	self offset = comparandAsDateAndTime offset
- 		ifTrue:
- 			[ lvalue := self.
- 			rvalue := comparandAsDateAndTime ]
- 		ifFalse:
- 			[ lvalue := self asUTC.
- 			rvalue := comparandAsDateAndTime asUTC ].
- 	^ lvalue julianDayNumber < rvalue julianDayNumber or:
- 		[ lvalue julianDayNumber > rvalue julianDayNumber
- 			ifTrue: [ false ]
- 			ifFalse:
- 				[ lvalue secondsSinceMidnight < rvalue secondsSinceMidnight or:
- 					[ lvalue secondsSinceMidnight > rvalue secondsSinceMidnight
- 						ifTrue: [ false ]
- 						ifFalse: [ lvalue nanoSecond < rvalue nanoSecond ] ] ] ]!

Item was changed:
  ----- Method: DateAndTime>>= (in category 'ansi protocol') -----
+ = aDateAndTimeOrTimeStamp
+ 	"Equal if the absolute time values match, regardless of local time transform"
- = aDateAndTimeOrTimeStamp 
  	self == aDateAndTimeOrTimeStamp ifTrue: [ ^ true ].
+ 	^aDateAndTimeOrTimeStamp species == DateAndTime
+ 		and: [ utcMicroseconds = aDateAndTimeOrTimeStamp utcMicroseconds ]!
- 	((aDateAndTimeOrTimeStamp isKindOf: self class)
- 		or: [aDateAndTimeOrTimeStamp isKindOf: DateAndTime orOf: TimeStamp])
- 			ifFalse: [ ^ false ].
- 	^ self offset = aDateAndTimeOrTimeStamp offset
- 		ifTrue: [ self hasEqualTicks: aDateAndTimeOrTimeStamp ]
- 		ifFalse: [ self asUTC hasEqualTicks: aDateAndTimeOrTimeStamp asUTC ]!

Item was added:
+ ----- Method: DateAndTime>>asChronologySeconds (in category 'converting') -----
+ asChronologySeconds
+ 	"What #asSeconds answers in prior Chronology-format images."
+ 	^ self asSeconds + self offset asSeconds!

Item was changed:
  ----- Method: DateAndTime>>asDuration (in category 'squeak protocol') -----
  asDuration
  	"Answer the duration since midnight."
  
+ 	^ Duration seconds: self getSeconds nanoSeconds: self nanoSecond
- 	^ Duration seconds: seconds nanoSeconds: nanos
  !

Item was added:
+ ----- Method: DateAndTime>>asExactSeconds (in category 'smalltalk-80') -----
+ asExactSeconds
+ 	"Return the duration in seconds since the Squeak epoch"
+ 
+ 	"Squeak traditionally used seconds since the Smalltalk epoch in local time,
+ 	which is undefinable. The error was probably caused by some early VM design
+ 	choices that have since been corrected. Assume now that the Smalltalk epoch
+ 	is defined relative to GMT, and that it may be treated similarly to the Posix
+ 	epoch except for a constant offset value.
+ 
+ 	This implementation differs from earlier Squeak in that it uses seconds relative
+ 	to the Smalltalk epoch (not local time), and represents seconds as an arbitrary
+ 	precision number rather than an integer."
+ 
+ 	^ utcMicroseconds / 1000000 + self class epochOffset
+ !

Item was added:
+ ----- Method: DateAndTime>>asPosixSeconds (in category 'converting') -----
+ asPosixSeconds
+ 
+ 	^utcMicroseconds / 1000000
+ !

Item was changed:
  ----- Method: DateAndTime>>asSeconds (in category 'smalltalk-80') -----
  asSeconds
+ 	"Return the number of seconds since the Squeak epoch. See asExactSeconds
+ 	to retain full precision of the duration in seconds."
+ 
+ 	"Squeak traditionally used seconds since the Smalltalk epoch in local time,
+ 	which is undefinable. The error was probably caused by some early VM design
+ 	choices that have since been corrected. Assume now that the Smalltalk epoch
+ 	is defined relative to GMT, and that it may be treated similarly to the Posix
+ 	epoch except for a constant offset value.
+ 
+ 	This implementation differs from earlier Squeak in that it uses seconds relative
+ 	to the Smalltalk epoch (not local time), and represents seconds as an arbitrary
+ 	precision number rather than an integer."
+ 
+ 	^ utcMicroseconds // 1000000 + self class epochOffset
+ !
- 	"Return the number of seconds since the Squeak epoch"
- 	^ (self - (self class epoch offset: offset)) asSeconds!

Item was changed:
  ----- Method: DateAndTime>>asTime (in category 'squeak protocol') -----
  asTime
  
  
+ 	^ Time seconds: self getSeconds nanoSeconds: self nanoSecond
- 	^ Time seconds: seconds nanoSeconds: nanos
  !

Item was changed:
  ----- Method: DateAndTime>>asTimeStamp (in category 'squeak protocol') -----
  asTimeStamp
  
+ 	^ self
+ 		asDateAndTime "FIXME LX hack for test support"
+ 		as: TimeStamp!
- 	^ self as: TimeStamp!

Item was changed:
  ----- Method: DateAndTime>>asUTC (in category 'ansi protocol') -----
  asUTC
  
+ 	localOffsetSeconds = 0 ifTrue: [ ^self ].
+ 	^self copy
+ 		utcMicroseconds: utcMicroseconds
+ 		offset: 0
- 	^ self offset isZero
- 		ifTrue: [self]
- 		ifFalse: [self utcOffset: 0]
  !

Item was changed:
  ----- Method: DateAndTime>>dayMonthYearDo: (in category 'squeak protocol') -----
  dayMonthYearDo: aBlock
  	"Evaluation the block with three arguments: day month, year."
  
  	| l n i j dd mm yyyy |
+ 	l := self julianDayNumber + 68569.
- 	l := jdn + 68569.
  	n := 4 * l // 146097.
  	l := l - (146097 * n + 3 // 4).
  	i := 4000 * (l + 1) // 1461001.
  	l := l - (1461 * i // 4) + 31.
  	j := 80 * l // 2447.
  	dd := l - (2447 * j // 80).
  	l := j // 11.
  	mm := j + 2 - (12 * l).
  	yyyy := 100 * (n - 49) + i + l.
  
  	^ aBlock
  		value: dd
  		value: mm
  		value: yyyy!

Item was changed:
  ----- Method: DateAndTime>>dayOfWeek (in category 'ansi protocol') -----
  dayOfWeek
  
  	"Sunday=1, ... , Saturday=7"
  
+ 	^ (self julianDayNumber + 1 rem: 7) + 1
- 	^ (jdn + 1 rem: 7) + 1
  !

Item was changed:
  ----- Method: DateAndTime>>floor (in category 'squeak protocol') -----
  floor
  	"Answer a copy with magnitude rounded down to the nearest whole second"
+ 	^self class
+ 		utcMicroseconds: utcMicroseconds - (utcMicroseconds \\ 1000000)
+ 		offset: localOffsetSeconds!
- 	^self class basicNew
- 		ticks: (self ticks at: 3 put: 0; yourself)
- 		offset: offset.
- !

Item was added:
+ ----- Method: DateAndTime>>getSeconds (in category 'accessing') -----
+ getSeconds
+ 
+ 	| posixDays posixSeconds localSeconds |
+ 	posixSeconds := utcMicroseconds // 1000000.
+ 	localSeconds := posixSeconds + localOffsetSeconds.
+ 	localSeconds < 0 ifTrue: [localSeconds := localSeconds \\ SecondsInDay]. "normalize"
+ 	posixDays := localSeconds // SecondsInDay.
+ 	^localSeconds - (posixDays * SecondsInDay).
+ !

Item was changed:
  ----- Method: DateAndTime>>hash (in category 'ansi protocol') -----
  hash
+ 	^utcMicroseconds hash!
- 	| totalSeconds |
- 	totalSeconds := seconds - self offset asSeconds.
- 	^ ((totalSeconds // 86400 + jdn) hashMultiply bitXor: totalSeconds \\
- 86400) bitXor: nanos!

Item was changed:
  ----- Method: DateAndTime>>hour24 (in category 'ansi protocol') -----
  hour24
  
+ 	^self getSeconds // 3600!
- 
- 	^ (Duration seconds: seconds) hours!

Item was added:
+ ----- Method: DateAndTime>>initializeFromPrimitive (in category 'initialize-release') -----
+ initializeFromPrimitive
+ 
+ 	Time posixMicrosecondClockWithOffset: self!

Item was changed:
  ----- Method: DateAndTime>>julianDayNumber (in category 'squeak protocol') -----
  julianDayNumber
  
+ 	| posixDays posixSeconds localSeconds negativeDays |
+ 	posixSeconds := utcMicroseconds // 1000000.
+ 	localSeconds := posixSeconds + localOffsetSeconds.
+ 	negativeDays := 0.
+ 	localSeconds < 0 ifTrue: [ "normalize"
+ 			negativeDays := localSeconds // SecondsInDay.
+ 			localSeconds := negativeDays * SecondsInDay + localSeconds].
+ 	posixDays := localSeconds // SecondsInDay.
+ 	^posixDays + PosixEpochJulianDays - negativeDays.
+ !
- 
- 	^ jdn!

Item was added:
+ ----- Method: DateAndTime>>localOffsetSeconds: (in category 'initialize-release') -----
+ localOffsetSeconds: seconds
+ 	"Private. Allow value to be modified during initialization in order to support local
+ 	timezone preference."
+ 
+ 	localOffsetSeconds := seconds
+ !

Item was changed:
  ----- Method: DateAndTime>>makeUTC (in category 'squeak protocol') -----
  makeUTC
  	"Make the receiver's timezone UTC."
+ 	localOffsetSeconds := 0!
- 	self primOffset: Duration zero!

Item was added:
+ ----- Method: DateAndTime>>microsecondsFromDay:seconds:nanos:offset: (in category 'private') -----
+ microsecondsFromDay: jdn seconds: s nanos: n offset: localOffsetSeconds
+ 
+ 	| days totalSeconds micros |
+ 	days := jdn - PosixEpochJulianDays.
+ 	totalSeconds := days * 86400 + s - localOffsetSeconds. "n.g. const 86400 is faster than SecondsInDay"
+ 	micros := totalSeconds * 1000000.
+ 	^micros + (n / 1000)
+ !

Item was changed:
  ----- Method: DateAndTime>>midnight (in category 'squeak protocol') -----
  midnight
  	"Answer a DateAndTime starting at midnight of the same timezone offset as the receiver."
  	^ self class basicNew
+ 		setJdn: self julianDayNumber
+ 		seconds: localOffsetSeconds
- 		setJdn: jdn
- 		seconds: 0
  		nano: 0
+ 		localOffsetSeconds: localOffsetSeconds.!
- 		offset: offset!

Item was changed:
  ----- Method: DateAndTime>>minute (in category 'ansi protocol') -----
  minute
  
+ 	^self getSeconds // 60 \\ 60!
- 
- 	^ (Duration seconds: seconds) minutes!

Item was changed:
  ----- Method: DateAndTime>>nanoSecond (in category 'squeak protocol') -----
  nanoSecond
  
+ 	^utcMicroseconds \\ 1000000 * 1000
+ !
- 
- 	^ nanos!

Item was changed:
  ----- Method: DateAndTime>>normalize:ticks:base: (in category 'private') -----
  normalize: i ticks: ticks base: base
  
  	| tick div quo rem |
  	tick := ticks at: i.
+ 	div := tick asInteger digitDiv: base neg: tick negative.
- 	div := tick digitDiv: base neg: tick negative.
  	quo := (div at: 1) normalize.
  	rem := (div at: 2) normalize.
  	rem < 0 ifTrue: [ quo := quo - 1. rem := base + rem ].
  	ticks at: (i-1) put: ((ticks at: i-1) + quo).
  	ticks at: i put: rem
  !

Item was changed:
  ----- Method: DateAndTime>>offset (in category 'ansi protocol') -----
  offset
  
+ 	^ Duration seconds: localOffsetSeconds!
- 	^ offset ifNil: [Duration zero]!

Item was changed:
  ----- Method: DateAndTime>>offset: (in category 'ansi protocol') -----
  offset: anOffset
  
  	"Answer a <DateAndTime> equivalent to the receiver but with its local time 
  	being offset from UTC by offset."
  
+ 	| newOffset newMicros |
+ 	self flag: #FIXME. "check the definition of this and of #utcOffset:"
+ 	newOffset := anOffset asDuration asSeconds.
+ 	newMicros := localOffsetSeconds - newOffset * 1000000 + utcMicroseconds.
+ 	^ self class utcMicroseconds: newMicros offset: newOffset
+ !
- 	^ self class basicNew 
- 		ticks: self ticks offset: (anOffset ifNotNil: [anOffset asDuration]);
- 		yourself!

Item was added:
+ ----- Method: DateAndTime>>offsetSeconds (in category 'accessing') -----
+ offsetSeconds
+ 
+ 	^localOffsetSeconds!

Item was added:
+ ----- Method: DateAndTime>>posixEpochJulianDays (in category 'initialize-release') -----
+ posixEpochJulianDays
+ 
+ 	^self class daysFromSmalltalkEpochToPosixEpoch + SqueakEpoch!

Item was changed:
  ----- Method: DateAndTime>>printHMSOn: (in category 'squeak protocol') -----
  printHMSOn: aStream
  	"Print just hh:mm:ss"
+ 	
+ 	| seconds |
+ 	seconds := self getSeconds.
+ 	seconds // 3600 printOn: aStream base: 10 length: 2 padded: true.
+ 	aStream nextPut: $:.
+ 	seconds \\ 3600 // 60 printOn: aStream base: 10 length: 2 padded: true.
+ 	aStream nextPut: $:.
+ 	seconds \\ 60 printOn: aStream base: 10 length: 2 padded: true!
- 	aStream
- 		nextPutAll: (self hour asString padded: #left to: 2 with: $0);
- 		nextPut: $:;
- 		nextPutAll: (self minute asString padded: #left to: 2 with: $0);
- 		nextPut: $:;
- 		nextPutAll: (self second asString padded: #left to: 2 with: $0).
- !

Item was changed:
  ----- Method: DateAndTime>>printOn:withLeadingSpace: (in category 'squeak protocol') -----
  printOn: aStream withLeadingSpace: printLeadingSpaceToo
  	"Print as per ISO 8601 sections 5.3.3 and 5.4.1.
  	If printLeadingSpaceToo is false, prints either:
  		'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)
  	If printLeadingSpaceToo is true, prints either:
  		' YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)
  	"
  
+ 	| nanos offsetSeconds |
  	self printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo.
  	aStream nextPut: $T.
  	self printHMSOn: aStream.
+ 	(nanos := utcMicroseconds \\ 1000000 * 1000) = 0 ifFalse: [
+ 		| length |
+ 		aStream nextPut: $..
+ 		length := 9.
+ 		[ nanos \\ 10 = 0 ] whileTrue: [
+ 			nanos := nanos // 10.
+ 			length := length - 1 ].
+ 		nanos printOn: aStream base: 10 length: length padded: true ].
+ 	"Print offset"
+ 	aStream nextPut: (localOffsetSeconds >= 0 ifTrue: [ $+ ] ifFalse: [ $- ]).
+ 	offsetSeconds := localOffsetSeconds abs.
+ 	offsetSeconds // 3600 printOn: aStream base: 10 length: 2 padded: true.
+ 	aStream nextPut: $:.
+ 	offsetSeconds \\ 3600 // 60 printOn: aStream base: 10 length: 2 padded: true.
+ 	(offsetSeconds := offsetSeconds \\ 60) = 0 ifFalse: [
+ 		aStream
- 	self nanoSecond ~= 0 ifTrue:
- 		[ | z ps |
- 		ps := self nanoSecond printString padded: #left to: 9 with: $0.
- 		z := ps findLast: [ :c | c asciiValue > $0 asciiValue ].
- 		(z > 0) ifTrue: [aStream nextPut: $.].
- 		ps from: 1 to: z do: [ :c | aStream nextPut: c ] ].
- 	aStream
- 		nextPut: (self offset positive ifTrue: [$+] ifFalse: [$-]);
- 		nextPutAll: (self offset hours abs asString padded: #left to: 2 with: $0);
- 		nextPut: $:;
- 		nextPutAll: (self offset minutes abs asString padded: #left to: 2 with: $0).
- 	self offset seconds = 0 ifFalse:
- 		[ aStream
  			nextPut: $:;
+ 			print: offsetSeconds ]!
- 			nextPutAll: (self offset seconds abs truncated asString) ].
- !

Item was changed:
  ----- Method: DateAndTime>>printYMDOn:withLeadingSpace: (in category 'squeak protocol') -----
  printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo
  	"Print just the year, month, and day on aStream.
  
  	If printLeadingSpaceToo is true, then print as:
  		' YYYY-MM-DD' (if the year is positive) or '-YYYY-MM-DD' (if the year is negative)
  	otherwise print as:
  		'YYYY-MM-DD' or '-YYYY-MM-DD' "
  
+ 	self dayMonthYearDo: [ :day :month :year |
+ 		year negative
+ 			ifTrue: [ aStream nextPut: $- ]
+ 			ifFalse: [ printLeadingSpaceToo ifTrue: [ aStream space ] ].
+ 		year abs printOn: aStream base: 10 length: 4 padded: true.
+ 		aStream nextPut: $-.
+ 		month printOn: aStream base: 10 length: 2 padded: true.
+ 		aStream nextPut: $-.
+ 		day printOn: aStream base: 10 length: 2 padded: true ]!
- 	| year month day |
- 	self dayMonthYearDo: [ :d :m :y | year := y. month := m. day := d ].
- 	year negative
- 		ifTrue: [ aStream nextPut: $- ]
- 		ifFalse: [ printLeadingSpaceToo ifTrue: [ aStream space ]].
- 	aStream
- 		nextPutAll: (year abs asString padded: #left to: 4 with: $0);
- 		nextPut: $-;
- 		nextPutAll: (month asString padded: #left to: 2 with: $0);
- 		nextPut: $-;
- 		nextPutAll: (day asString padded: #left to: 2 with: $0)
- !

Item was added:
+ ----- Method: DateAndTime>>readDataFrom:size: (in category 'objects from disk') -----
+ readDataFrom: aDataStream size: varsOnDisk
+ 	"Fill in the fields of self based on the contents of aDataStream. The serialized
+ 	data will have four instance variables, because all instances are serialized in a
+ 	cononical format as if having originating from an instance with the traditional
+ 	seconds/offset/jdn/nanos instance variables."
+  
+ 	| seconds offset jdn nanos |
+ 	seconds := aDataStream next.
+ 	offset := aDataStream next.
+ 	jdn := aDataStream next.
+ 	nanos := aDataStream next.
+ 	localOffsetSeconds := offset ifNil: [ 0 ] ifNotNil: [ :off | off asSeconds ].
+ 	utcMicroseconds := self
+ 				microsecondsFromDay: jdn
+ 				seconds: seconds
+ 				nanos: nanos
+ 				offset: localOffsetSeconds.!

Item was changed:
  ----- Method: DateAndTime>>second (in category 'ansi protocol') -----
  second
  
+ 	^self getSeconds \\ 60!
- 
- 	^ (Duration seconds: seconds) seconds!

Item was changed:
  ----- Method: DateAndTime>>secondsSinceMidnight (in category 'private') -----
  secondsSinceMidnight
  
+ 	^ self getSeconds!
- 	^ seconds!

Item was added:
+ ----- Method: DateAndTime>>setJdn:seconds:nano:localOffsetSeconds: (in category 'private') -----
+ setJdn: jdn seconds: s nano: n localOffsetSeconds: offset
+ 
+ 	localOffsetSeconds := offset.
+ 	utcMicroseconds := self
+ 				microsecondsFromDay: jdn
+ 				seconds: s - offset
+ 				nanos: n
+ 				offset: offset!

Item was changed:
  ----- Method: DateAndTime>>setJdn:seconds:nano:offset: (in category 'squeak protocol') -----
+ setJdn: jdn seconds: s nano: n offset: o
- setJdn: j seconds: s nano: n offset: o
  
+ 	self setJdn: jdn seconds: s nano: n localOffsetSeconds: o asSeconds.
- 	jdn := j.
- 	seconds := s.
- 	nanos :=  n.
- 	offset :=  o
  !

Item was added:
+ ----- Method: DateAndTime>>species (in category 'accessing') -----
+ species
+ 	^DateAndTime!

Item was added:
+ ----- Method: DateAndTime>>storeDataOn: (in category 'objects from disk') -----
+ storeDataOn: aDataStream
+ 	"Store myself on a DataStream.  Answer self. 
+ 	Store 4 variables worth of data, corresponding to the 4 instance variables of the old
+ 	DateAndTime implementation, which is to be used as common format for externally
+ 	stored instances."
+ 
+ 	" | dt dt2 |
+ 	dt := DateAndTime now.
+ 	dt2 := DataStream testWith: dt.
+ 	{ dt . dt2 }."
+ 
+ 	| cntInstVars cntIndexedVars ticks jdn offset seconds nanos |
+ 	"Set the instance variable count to 4 to match that of a cononical instance." 
+ 	cntInstVars := 4.
+ 	cntIndexedVars := self basicSize.
+ 	aDataStream
+ 		beginInstance: self xxxClass
+ 		size: cntInstVars + cntIndexedVars.
+ 
+ 	"Create the 4 values of the old format DateAndTime"
+ 	ticks := self ticks. 	"{days. seconds. nanoSeconds}."
+ 	offset := self offset.
+ 	jdn := ticks at: 1.
+ 	seconds := ticks at: 2.
+ 	nanos := ticks at: 3.
+ 	aDataStream
+ 		nextPut: seconds;
+ 		nextPut: offset;
+ 		nextPut: jdn;
+ 		nextPut: nanos.
+ !

Item was changed:
  ----- Method: DateAndTime>>ticks (in category 'private') -----
  ticks
  	"Private - answer an array with our instance variables. Assumed to be UTC "
  
+ 	^ Array with: self julianDayNumber with: self getSeconds with: self nanoSecond
- 	^ Array with: jdn with: seconds with: nanos
  !

Item was changed:
  ----- Method: DateAndTime>>ticks:offset: (in category 'private') -----
  ticks: ticks offset: utcOffset
  	"ticks is {julianDayNumber. secondCount. nanoSeconds}"
  
+ 	| jdn s nanos |
  	self normalize: 3 ticks: ticks base: NanosInSecond.
  	self normalize: 2 ticks: ticks base: SecondsInDay.
  
  	jdn	:= ticks at: 1.
+ 	s := ticks at: 2.
- 	seconds	:= ticks at: 2.
  	nanos := ticks at: 3.
+ 	localOffsetSeconds := utcOffset ifNil: [0] ifNotNil: [utcOffset asSeconds].
+ 	utcMicroseconds := self microsecondsFromDay: jdn seconds: s nanos: nanos offset: localOffsetSeconds.
- 	offset := utcOffset
  !

Item was added:
+ ----- Method: DateAndTime>>utcMicroseconds (in category 'accessing') -----
+ utcMicroseconds
+ 	^utcMicroseconds!

Item was added:
+ ----- Method: DateAndTime>>utcMicroseconds: (in category 'initialize-release') -----
+ utcMicroseconds: utcValue
+ 	"Allow value to be modified during initialization from a primitive in order to support
+ 	monotonically increasing clock behavior."
+ 	utcMicroseconds := utcValue!

Item was added:
+ ----- Method: DateAndTime>>utcMicroseconds:offset: (in category 'initialize-release') -----
+ utcMicroseconds: microsecondsSincePosixEpoch offset: tzOffset
+ 
+ 	utcMicroseconds := microsecondsSincePosixEpoch.
+ 	localOffsetSeconds := tzOffset.
+ !

Item was changed:
  ----- Method: DateAndTime>>utcOffset: (in category 'squeak protocol') -----
  utcOffset: anOffset
  
  	"Answer a <DateAndTime> equivalent to the receiver but offset from UTC by anOffset"
  
+ 	self flag: #FIXME. "check the definition of this and of #offset:"
+ 	^self utcMicroseconds: utcMicroseconds offset: anOffset asDuration asSeconds
+ !
- 	| equiv |
- 	equiv := self + (anOffset asDuration - self offset).
- 	^ equiv ticks: (equiv ticks) offset: anOffset asDuration; yourself!

Item was changed:
  ----- Method: LXDateAndTime>>asTimeStamp (in category 'squeak protocol') -----
  asTimeStamp
  
+ 	^ self asLXTimeStamp
- 	^ self asDateAndTime asTimeStamp
  !




More information about the Squeak-dev mailing list