local time?

Lex Spoon lex at cc.gatech.edu
Wed Feb 16 05:53:24 UTC 2000


Not too long ago, there was discussion of local time support in Squeak. 
At that time, we pretty much nailed down how local time should be
addressed: at first, the VM should distinguish local versus remote time,
and then later, we should add full support for timezones.

An implementation of the first stage, done by David Lewis and myself, is
appended.  Specifically, after loading this changeset:

	1. New queries are added to class Time, so that local or UTC time can
be specifically requested.  To support all these queries, one new
primitive is added.  (For people who don't have an updated VM, the
fallback code will use Squeak's original time primitive)

	2. The necessary primitive is implemented, at least for Unix.  Other
platforms must either have a POSIX-y localtime() function, or they must
implement the new plugin anew.

	3. Celeste's Date: header finally includes a timezone offset.  (my main
impetus :))

	4. To support the plugin, the C code generator is tweaked so that "foo
negated" works.


What do people think?  IMHO this is simple and yet useful.  I've been
using an older version for a few weeks, and it all seems to work okay.


Lex




====
'From Squeak2.8alpha of 21 January 2000 [latest update: #1852] on 16 February 2000 at 12:18:26 am'!
"Change Set:		LocalTime
Date:			February 2000
Author:			Lex Spoon and David T. Lewis

Adds basic support for determining both local time from UTC time.  Updates Celeste's outgoing Date: header."!

InterpreterPlugin subclass: #LocalTimePlugin
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Time'!
Smalltalk renameClassNamed: #SimpleTimePlugin as: #LocalTimePlugin!

!LocalTimePlugin commentStamp: 'ls 2/15/2000 23:50' prior: 0!
support getting the local time and UTC time simultaneously.

		LocalTimePlugin translateDoInlining: true!

!LocalTimePlugin methodsFor: 'primitives' stamp: 'ls 2/16/2000 10:12'!
primitiveLocalSecondsClockWithOffset
	"Answer an array with the local time expressed in the Smalltalk frame 
	of reference, and with the current local offset. The two values are 
	obtained simultaneously. The result array is instantiated in this 
	primitive. "
	| result timezone t |
	self var: #t declareC: 'time_t t'.
	self var: #timezone declareC: 'extern long int timezone'.
	timezone := 0.   "stop the compiler complaining"
	t _ self cCode: 'time(NULL)'.
	self cCode: 'localtime(&t)'.

	"External variable timezone is set as side effect of localtime(3)"
	result _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4.
	interpreterProxy pop: 1; push: result.   "put the result on the stack"

	self topArrayAt: 1 put: (interpreterProxy positive32BitIntegerFor: (t - timezone + self posixOffset)).
	self topArrayAt: 2 put: (interpreterProxy integerObjectOf: 0).
	self topArrayAt: 3 put: (interpreterProxy integerObjectOf: (timezone negated)).
	self topArrayAt: 4 put: (interpreterProxy integerObjectOf: 0).
! !

!LocalTimePlugin methodsFor: 'local' stamp: 'ls 2/15/2000 23:34'!
posixOffset
	"Logic is lifted from Ian's Unix support code.
	Squeak epoc	h is Jan 1, 1901.  Unix epoch is Jan 1, 1970: 17 leap years
     and 52 non-leap years later than Squeak."

	self export: false.

	"52 * 365 + (17 * 366) * 24 * 60 * 60"

	^ 2177452800! !

!LocalTimePlugin methodsFor: 'local' stamp: 'ls 1/28/1932 20:55'!
topArrayAt: index  put: oop
	"assuming the top of the stack is an array, put oop into the index-th slot"
	self export: false.
	interpreterProxy stObject: (interpreterProxy stackValue: 0)
		at: index put: oop.! !


!LocalTimePlugin class methodsFor: 'translation' stamp: 'ls 2/15/2000 23:51'!
moduleName

	^ 'LocalTime'! !

!LocalTimePlugin class methodsFor: 'translation' stamp: 'ls 2/15/2000 23:41'!
translate: fileName doInlining: inlineFlag

	"This is a convenience method which simply documents that the C source code file
	may be generated as shown below."

	"LocalTimePlugin translate: SimpleTimePlugin moduleName,'.c' doInlining: true"

	^ super translate: fileName doInlining: inlineFlag! !

!LocalTimePlugin class methodsFor: 'translation' stamp: 'ls 2/15/2000 23:40'!
translateDoInlining: inlineFlag

	"Translate to C source code file."

	"LocalTimePlugin translateDoInlining: true"

	^ super translate: LocalTimePlugin moduleName,'.c' doInlining: inlineFlag! !


!MailMessage class methodsFor: 'utilities' stamp: 'ls 12/6/1999 23:38'!
dateStampNow
	| timeWithOffset seconds offset date time absOffset offsetHours offsetMinutes |
	"Return the current date and time formatted as a email Date: line"
	"The result conforms to RFC822 with a long year, e.g.  'Thu, 18 Feb 1999 20:38:51 -400'"

	^String streamContents: [ :str |
		"grab the time and date"
		timeWithOffset _ Time localSecondsClockWithOffset.
		seconds _ timeWithOffset first.
		offset _ timeWithOffset second // 60.   "offset in minuteus"
		date _ Date fromSeconds: seconds.
		time _ Time fromSeconds: seconds \\ 86400.

		"print the date"
		str nextPutAll: (date weekday copyFrom: 1 to: 3).
		str nextPutAll:  ', '.
		date printOn: str format: #(1 2 3 $  2 1 1).
		str space.

		"print the time"	
		time print24: true on: str.
		str space.

		"print the offset from UTC"
		offset < 0
			ifTrue: [ str nextPut: $- ]
			ifFalse: [ str nextPut: $+ ].
		absOffset _ offset abs.
		offsetHours _ absOffset // 60.
		offsetMinutes _ absOffset \\ 60.
		offsetHours < 10 ifTrue: [ str nextPut: $0 ].
		offsetHours printOn: str.
		offsetMinutes < 10 ifTrue: [ str nextPut: $0 ].
		offsetMinutes printOn: str
	].! !


!PluggableCodeGenerator methodsFor: 'C code generator' stamp: 'ls 2/15/2000 23:57'!
emitCHeaderOn: aStream
	"Write a C file header onto the given stream."

	aStream nextPutAll: '/* Automatically generated from Squeak on '.
	aStream nextPutAll: Time dateAndTimeNow printString.
	aStream nextPutAll: ' */';cr.

	aStream nextPutAll:'
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

/* Default EXPORT macro that does nothing (see comment in sq.h): */
#define EXPORT(returnType) returnType

/* Do not include the entire sq.h file but just those parts needed. */
/*  The virtual machine proxy definition */
#include "sqVirtualMachine.h"
/* Configuration options */
#include "sqConfig.h"
/* Platform specific definitions */
#include "sqPlatformSpecific.h"
/* squeak file record; see sqFilePrims.c for details */
#include "sqFile.h"

#define true 1
#define false 0
#define null 0  /* using ''null'' because nil is predefined in Think C */
'.

	"Additional header files"
	headerFiles do:[:hdr|
		aStream nextPutAll:'#include '; nextPutAll: hdr; cr].


	aStream nextPutAll: '
/* memory access macros */
#define byteAt(i) (*((unsigned char *) (i)))
#define byteAtput(i, val) (*((unsigned char *) (i)) = val)
#define longAt(i) (*((int *) (i)))
#define longAtput(i, val) (*((int *) (i)) = val)

/* basic arithmetic operator */
#define negated(x) -(x)

'.
	aStream cr.! !


!Time commentStamp: '<historical>' prior: 0!
I represent the time of day.

Two primitives, localSecondsClock and utcSecondsClock, return a time encoded as:

	days*86400 + hours*3600 + minutes*60 + seconds

For UTC time, this is close to the number of seconds since the beginning of Jan 1, 1901, as of December 1999, although it is off by <60 leap seconds.!

!Time class methodsFor: 'general inquiries' stamp: 'ls 12/1/1999 22:39'!
dateAndTimeNow
	"Answer a two-element Array of (Date today, Time now) in local time"
	^self localDateAndTimeNow! !

!Time class methodsFor: 'general inquiries' stamp: 'ls 12/8/1999 21:14'!
dateAndTimeNowWithOffset
	"Answer a three-element Array of (Date today, Time now, offset from UTC)"
	| secondsCount offset secondsWithOffset |
	secondsWithOffset _ self localSecondsClockWithOffset.
	secondsCount _ secondsWithOffset first.
	offset _ secondsWithOffset third.

	^(self dateAndTimeFromSeconds: secondsCount) copyWith: offset! !

!Time class methodsFor: 'general inquiries' stamp: 'ls 12/1/1999 22:37'!
localDateAndTimeNow
	"Answer a two-element Array of (Date today, Time now) in local time"

	| secondCount |
	secondCount _ self localSecondsClock.
	^self dateAndTimeFromSeconds: secondCount! !

!Time class methodsFor: 'general inquiries' stamp: 'ls 12/6/1999 22:54'!
localSecondsClock
	"return the local time, encoded into a single integer (see class comment)"
	^self localSecondsClockWithOffset at: 1! !

!Time class methodsFor: 'general inquiries' stamp: 'ls 2/15/2000 23:59'!
localSecondsClockWithOffset
	"return the local time along with its offset from UTC.  See class comment for the encoding"
	| details |
	details _ self primLocalSecondsClockWithOffset.

	^Array
		with: (details first + (details second / 1000000))
		with: (details third + (details fourth / 1000000))! !

!Time class methodsFor: 'general inquiries' stamp: 'ls 12/1/1999 22:39'!
utcDateAndTimeNow
	"Answer a two-element Array of (Date today, Time now) in UTC time"
	| secondCount |
	secondCount _ self utcSecondsClock.
	^self dateAndTimeFromSeconds: secondCount! !

!Time class methodsFor: 'general inquiries' stamp: 'ls 12/6/1999 23:31'!
utcSecondsClock
	"return the date and time in UTC, encoded as an integer (see class comment)"

	| clockWithOffset |
	clockWithOffset _ self localSecondsClockWithOffset.
	^clockWithOffset first - clockWithOffset second! !

!Time class methodsFor: 'private' stamp: 'ls 2/15/2000 23:37'!
primLocalSecondsClockWithOffset
	"calculate the local time, and its ofset from UTC"
	<primitive: 'primitiveLocalSecondsClockWithOffset' module:'time'>
	"if failed, assume UTC time  (modify this if you want it to assume some  
	other time zone by default"
	^{
		self primSecondsClock.	"local seconds"
		0.						"local microseconds"
		0.						"offset from UTC in seconds"
		0						"additional offset from UTC in microseconds"
	}! !

!Time class methodsFor: 'private' stamp: 'ls 2/15/2000 23:37'!
primLocalSecondsClockWithOffset: array 
	"calculate the local time, and its ofset from UTC"

	"if failed, assume UTC time  (modify this if you want it to assume some  
	other time zone by default"
	array at: 1 put: self primSecondsClock.	"local seconds"
	array at: 2 put: 0.						"local microseconds"
	array at: 3 put: 0.						"offset from UTC in seconds"
	array at: 4 put: 0.						"additional offset from UTC in microseconds"! !





More information about the Squeak-dev mailing list