projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add support for the IO manager thread on Windows
[ghc-hetmet.git]
/
rts
/
PrimOps.cmm
diff --git
a/rts/PrimOps.cmm
b/rts/PrimOps.cmm
index
075da41
..
bfb0b86
100644
(file)
--- a/
rts/PrimOps.cmm
+++ b/
rts/PrimOps.cmm
@@
-418,12
+418,15
@@
int64ToIntegerzh_fast
/* arguments: L1 = Int64# */
L_ val;
/* arguments: L1 = Int64# */
L_ val;
- W_ hi, s, neg, words_needed, p;
+ W_ hi, lo, s, neg, words_needed, p;
val = L1;
neg = 0;
val = L1;
neg = 0;
- if ( %ge(val,0x100000000::L_) || %le(val,-0x100000000::L_) ) {
+ hi = TO_W_(val >> 32);
+ lo = TO_W_(val);
+
+ if ( hi != 0 && hi != 0xFFFFFFFF ) {
words_needed = 2;
} else {
// minimum is one word
words_needed = 2;
} else {
// minimum is one word
@@
-437,21
+440,24
@@
int64ToIntegerzh_fast
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = words_needed;
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = words_needed;
- if ( %lt(val,0::L_) ) {
+ if ( %lt(hi,0) ) {
neg = 1;
neg = 1;
- val = -val;
+ lo = -lo;
+ if(lo == 0) {
+ hi = -hi;
+ } else {
+ hi = -hi - 1;
+ }
}
}
- hi = TO_W_(val >> 32);
-
if ( words_needed == 2 ) {
s = 2;
if ( words_needed == 2 ) {
s = 2;
- Hp(-1) = TO_W_(val);
+ Hp(-1) = lo;
Hp(0) = hi;
} else {
Hp(0) = hi;
} else {
- if ( val != 0::L_ ) {
+ if ( lo != 0 ) {
s = 1;
s = 1;
- Hp(0) = TO_W_(val);
+ Hp(0) = lo;
} else /* val==0 */ {
s = 0;
}
} else /* val==0 */ {
s = 0;
}
@@
-465,16
+471,18
@@
int64ToIntegerzh_fast
*/
RET_NP(s,p);
}
*/
RET_NP(s,p);
}
-
word64ToIntegerzh_fast
{
/* arguments: L1 = Word64# */
L_ val;
word64ToIntegerzh_fast
{
/* arguments: L1 = Word64# */
L_ val;
- W_ hi, s, words_needed, p;
+ W_ hi, lo, s, words_needed, p;
val = L1;
val = L1;
- if ( val >= 0x100000000::L_ ) {
+ hi = TO_W_(val >> 32);
+ lo = TO_W_(val);
+
+ if ( hi != 0 ) {
words_needed = 2;
} else {
words_needed = 1;
words_needed = 2;
} else {
words_needed = 1;
@@
-487,15
+495,14
@@
word64ToIntegerzh_fast
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = words_needed;
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = words_needed;
- hi = TO_W_(val >> 32);
- if ( val >= 0x100000000::L_ ) {
+ if ( hi != 0 ) {
s = 2;
s = 2;
- Hp(-1) = TO_W_(val);
+ Hp(-1) = lo;
Hp(0) = hi;
} else {
Hp(0) = hi;
} else {
- if ( val != 0::L_ ) {
+ if ( lo != 0 ) {
s = 1;
s = 1;
- Hp(0) = TO_W_(val);
+ Hp(0) = lo;
} else /* val==0 */ {
s = 0;
}
} else /* val==0 */ {
s = 0;
}
@@
-508,6
+515,7
@@
word64ToIntegerzh_fast
}
}
+
#endif /* SUPPORT_LONG_LONGS */
/* ToDo: this is shockingly inefficient */
#endif /* SUPPORT_LONG_LONGS */
/* ToDo: this is shockingly inefficient */
@@
-2044,8
+2052,11
@@
delayzh_fast
#else
W_ time;
#else
W_ time;
+ W_ divisor;
time = foreign "C" getourtimeofday() [R1];
time = foreign "C" getourtimeofday() [R1];
- target = (R1 / (TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000)) + time;
+ divisor = TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000;
+ target = ((R1 + divisor - 1) / divisor) /* divide rounding up */
+ + time + 1; /* Add 1 as getourtimeofday rounds down */
StgTSO_block_info(CurrentTSO) = target;
/* Insert the new thread in the sleeping queue. */
StgTSO_block_info(CurrentTSO) = target;
/* Insert the new thread in the sleeping queue. */