/* arguments: L1 = Int64# */
L_ val;
- W_ hi, s, neg, words_needed, p;
+ W_ hi, lo, s, neg, words_needed, p;
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
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;
- val = -val;
+ lo = -lo;
+ if(lo == 0) {
+ hi = -hi;
+ } else {
+ hi = -hi - 1;
+ }
}
- hi = TO_W_(val >> 32);
-
if ( words_needed == 2 ) {
s = 2;
- Hp(-1) = TO_W_(val);
+ Hp(-1) = lo;
Hp(0) = hi;
} else {
- if ( val != 0::L_ ) {
+ if ( lo != 0 ) {
s = 1;
- Hp(0) = TO_W_(val);
+ Hp(0) = lo;
} else /* val==0 */ {
s = 0;
}
*/
RET_NP(s,p);
}
-
word64ToIntegerzh_fast
{
/* arguments: L1 = Word64# */
L_ val;
- W_ hi, s, words_needed, p;
+ W_ hi, lo, s, words_needed, p;
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;
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;
- Hp(-1) = TO_W_(val);
+ Hp(-1) = lo;
Hp(0) = hi;
} else {
- if ( val != 0::L_ ) {
+ if ( lo != 0 ) {
s = 1;
- Hp(0) = TO_W_(val);
+ Hp(0) = lo;
} else /* val==0 */ {
s = 0;
}
}
+
#endif /* SUPPORT_LONG_LONGS */
/* ToDo: this is shockingly inefficient */
RET_P(ap);
}
+infoPtrzh_fast
+{
+/* args: R1 = closure to analyze */
+
+ MAYBE_GC(R1_PTR, infoPtrzh_fast);
+
+ W_ info;
+ info = %GET_STD_INFO(R1);
+ RET_N(info);
+}
+
+closurePayloadzh_fast
+{
+/* args: R1 = closure to analyze */
+// TODO: Consider the absence of ptrs or nonptrs as a special case ?
+
+ MAYBE_GC(R1_PTR, closurePayloadzh_fast);
+
+ W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
+ info = %GET_STD_INFO(R1);
+ ptrs = TO_W_(%INFO_PTRS(info));
+ nptrs = TO_W_(%INFO_NPTRS(info));
+ p = 0;
+
+ ALLOC_PRIM (SIZEOF_StgMutArrPtrs + WDS(ptrs), R1_PTR, closurePayloadzh_fast);
+ ptrs_arr = Hp - SIZEOF_StgMutArrPtrs - WDS(ptrs) + WDS(1);
+ SET_HDR(ptrs_arr, stg_MUT_ARR_PTRS_FROZEN_info, W_[CCCS]);
+ StgMutArrPtrs_ptrs(ptrs_arr) = ptrs;
+for:
+ if(p < ptrs) {
+ W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(R1,p);
+ p = p + 1;
+ goto for;
+ }
+
+ ALLOC_PRIM (SIZEOF_StgArrWords + WDS(nptrs), R1_PTR, closurePayloadzh_fast);
+ nptrs_arr = Hp - SIZEOF_StgArrWords - WDS(nptrs) + WDS(1);
+ SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]);
+ StgArrWords_words(nptrs_arr) = nptrs;
+ p = 0;
+for2:
+ if(p < nptrs) {
+ W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(R1, p+ptrs);
+ p = p + 1;
+ goto for2;
+ }
+ RET_PP(ptrs_arr, nptrs_arr);
+}
+
/* -----------------------------------------------------------------------------
Thread I/O blocking primitives
-------------------------------------------------------------------------- */
#else
W_ time;
+ W_ divisor;
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. */