Time.icl 5.54 KB
Newer Older
1
implementation module System.Time
2

3
import StdEnv
4
import System._Pointer
5 6 7
import System._WinBase
import Data.Integer
import Data.List
8
import Data.GenEq
9
from Data.Func import $
Camil Staps's avatar
oops  
Camil Staps committed
10
import Text
11

12 13
import code from library "msvcrt.txt"

14 15 16
//String buffer size
MAXBUF :== 256

17 18
derive gEq Timestamp

19 20 21 22 23 24 25 26
instance == Timestamp
where
	(==) (Timestamp t1) (Timestamp t2) = t1 == t2
	
instance < Timestamp
where
	(<) (Timestamp t1) (Timestamp t2) = t1 < t2 

27 28
instance toString Tm
where
29
	toString tm = trim (derefString (toStringTmC (packTm tm)))
30 31 32
	where
		toStringTmC :: !{#Int} -> Pointer
		toStringTmC a0 = code {
Steffen Michels's avatar
Steffen Michels committed
33
			ccall asctime "A:I"
34
		}
35
instance toString Timestamp
36
where
37 38
	toString (Timestamp t) 
	| t < 0 = abort "System.Time: Timestamp cannot be negative" 
39
	= trim (derefString (toStringTimeC (packInt t)))
40 41 42
	where	
		toStringTimeC :: !{#Int} -> Pointer
		toStringTimeC a0 = code {
Steffen Michels's avatar
Steffen Michels committed
43
			ccall ctime "A:I"
44 45 46 47
		}
instance toString Clock
where
	toString (Clock c) = toString c
48 49 50
instance toInt Timestamp
where
	toInt (Timestamp i) = i
51 52 53 54 55 56 57 58

clock :: !*World -> (!Clock, !*World)
clock world
	# (c, world) = clockC world
	= (Clock c, world)
	where
	clockC :: !*World -> (!Int, !*World)
	clockC world = code {
Steffen Michels's avatar
Steffen Michels committed
59
		ccall clock ":I:I"
60 61
	}

62
time :: !*World -> (!Timestamp, !*World)
63 64
time world
	# (t, world)	= timeC 0 world
65
	= (Timestamp t, world)
66 67 68
	where
	timeC :: !Int !*World -> (!Int,!*World)
	timeC a0 world = code {
Steffen Michels's avatar
Steffen Michels committed
69
		ccall time "I:I:I"
70 71 72 73
	}

gmTime :: !*World -> (!Tm, !*World)
gmTime world
74
	# ((Timestamp t),world)	= time world
75
	# tm					= gmTimeC (packInt t)
76 77 78 79
	= (derefTm tm, world)

localTime :: !*World -> (!Tm, !*World)
localTime world
80
	# ((Timestamp t),world)	= time world
81
	# (tm,world)			= localTimeC (packInt t) world
82 83
	= (derefTm tm, world)

84 85 86 87 88 89 90 91
mkTime :: !Tm !*World-> (!Timestamp, !*World)
mkTime tm world
	# (t, world) = mkTimeC (packTm tm) world
	= (Timestamp t, world)
where
	mkTimeC :: !{#Int} !*World -> (!Int, !*World)
	mkTimeC tm world = code {
		ccall mktime "A:I:I"
92 93
	}

Steffen Michels's avatar
Steffen Michels committed
94 95 96 97 98 99 100 101
timeGm :: !Tm -> Timestamp
timeGm tm = Timestamp (timegmC (packTm tm))
where
	timegmC :: !{#Int} -> Int
	timegmC tm = code {
		ccall _mkgmtime "A:I"
	}

102 103
diffTime :: !Timestamp !Timestamp -> Int
diffTime (Timestamp t1) (Timestamp t2) = t1 - t2
104 105 106 107 108 109 110 111 112

strfTime :: !String !Tm -> String
strfTime format tm 
	# buf		= createArray MAXBUF 'X'
	# (len,buf)	= strfTimeC buf MAXBUF (packString format) (packTm tm) buf
	= buf % (0, len - 1)
	where
		strfTimeC :: !{#Char} !Int !{#Char} !{#Int} !{#Char} -> (!Int,!{#Char})
		strfTimeC a0 a1 a2 a3 a4 = code {
Steffen Michels's avatar
Steffen Michels committed
113
			ccall strftime "sIsA:I:A"
114
		}
115 116 117 118 119 120 121 122 123
		
toLocalTime :: !Timestamp !*World -> (!Tm,!*World)
toLocalTime (Timestamp t) world
	# (tm,world) = localTimeC (packInt t) world
	= (derefTm tm, world)

toGmTime :: !Timestamp -> Tm
toGmTime (Timestamp t) = derefTm (gmTimeC (packInt t))

124
gmTimeC :: !{#Int} -> Int
125
gmTimeC tm = code {
Steffen Michels's avatar
Steffen Michels committed
126
	ccall gmtime "A:I"
127 128 129 130
}

localTimeC :: !{#Int} !*World -> (!Int, !*World)
localTimeC tm world = code {
Steffen Michels's avatar
Steffen Michels committed
131
	ccall localtime "A:I:I"
132
}
133 134 135

//Custom deref and pack for the Tm structure
derefTm :: !Int -> Tm
136 137 138 139 140 141 142 143
derefTm tm =	{ sec	= readInt4S tm 0
				, min	= readInt4S tm 4
				, hour	= readInt4S tm 8 
				, mday	= readInt4S tm 12 
				, mon	= readInt4S tm 16
				, year	= readInt4S tm 20
				, wday	= readInt4S tm 24
				, yday	= readInt4S tm 28 
144
				, isdst	= readInt4S tm 32
145
				}
146

147
packTm :: !Tm -> {#Int}
148 149 150 151 152 153 154
packTm tm = (IF_INT_64_OR_32 packTm64 packTm32) tm

packTm64 :: !Tm -> {#Int}
packTm64 tm = 	{ tm.sec  + tm.min  << 32
				, tm.hour + tm.mday << 32
				, tm.mon  + tm.year << 32
				, tm.wday + tm.yday << 32
155
				, tm.isdst
156 157 158 159
				}
				
packTm32 :: !Tm -> {#Int}
packTm32 tm = 	{ tm.sec
160 161 162 163 164 165 166
				, tm.min
				, tm.hour
				, tm.mday
				, tm.mon
				, tm.year
				, tm.wday
				, tm.yday
167
				, tm.isdst
168
				}
169 170 171 172 173 174 175 176 177 178 179 180


//Number of 100ns ticks difference between the windows and linux epoch 
TICKSDIFF32   =: toInteger "11644473600" * TICKSPERSEC32
TICKSDIFF64   =: 11644473600 * TICKSPERSEC64

//Number of ticks per second (100 ns ticks)
TICKSPERSEC32 =: toInteger 10000000
TICKSPERSEC64 =: 10000000
/*
 * On windows GetSystemTimeAsFileTime returns a struct containing 2 32bit unsigned integers.
 * On 64 bit we therefore use an array of length 1, on 32 bit of length two.
181
 * On 64 bit we can use native integers, on 32 bit we use bigints.
182
 */
183
nsTime :: !*World -> (!Timespec, !*World)
184 185 186 187 188 189 190
nsTime w = IF_INT_64_OR_32 nsTime64 nsTime32 w
where
	nsTime64 w
		# (is, w) = GetSystemTimeAsFileTime {0} w
		= ({tv_sec=(is.[0] - TICKSDIFF64) / TICKSPERSEC64, tv_nsec=(is.[0] rem TICKSPERSEC64) * 100}, w)
	nsTime32 w
		# (is, w) = GetSystemTimeAsFileTime {0,0} w
191
		# ticks = uintToInt is.[0] + uintToInt is.[1] ^ toInteger 32 - TICKSDIFF32
192
		= ({tv_sec=toInt (ticks / TICKSPERSEC32), tv_nsec=toInt (ticks rem TICKSPERSEC32) * 100}, w)
193 194 195 196 197

uintToInt :: Int -> Integer
uintToInt i
| i < 0 = toInteger i + {integer_s=0,integer_a={0,1}}
= toInteger i
198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222

timespecToStamp :: !Timespec -> Timestamp
timespecToStamp t = Timestamp t.tv_sec

timestampToSpec :: !Timestamp -> Timespec
timestampToSpec (Timestamp t) = {tv_sec=t,tv_nsec=0}

instance < Timespec
where
	(<) t1 t2
		| t1.tv_sec == t2.tv_sec = t1.tv_nsec < t2.tv_nsec
		= t1.tv_sec < t2.tv_sec

instance + Timespec
where
	(+) t1 t2 = let tv_nsec = t1.tv_nsec + t2.tv_nsec in
		{ tv_sec  = t1.tv_sec + t2.tv_sec + tv_nsec / 1000000000
		, tv_nsec = tv_nsec rem 1000000000
		}

instance - Timespec
where
	(-) t1 t2
		# tv_nsec = t1.tv_nsec - t2.tv_nsec
		| tv_nsec < 0
Steffen Michels's avatar
Steffen Michels committed
223
			= {tv_sec = t1.tv_sec - t2.tv_sec - 1, tv_nsec = 1000000000 + tv_nsec}
Steffen Michels's avatar
Steffen Michels committed
224
			= {tv_sec = t1.tv_sec - t2.tv_sec,     tv_nsec = tv_nsec}
225 226 227

instance zero Timespec
where zero = {tv_sec=0, tv_nsec=0}
Mart Lubbers's avatar
Mart Lubbers committed
228 229 230 231

instance == Timespec
where
	(==) t1 t2 = t1.tv_sec == t2.tv_sec && t1.tv_nsec == t2.tv_nsec