Innocent changes to resurrect/add 64-bit support.
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.78 2001/07/14 00:06:14 sof Exp $
+ * $Id: PrimOps.h,v 1.79 2001/07/24 06:31:35 ken Exp $
*
* (c) The GHC Team, 1998-2000
*
* plugging into a new J#.
*/
#define addIntCzh(r,c,a,b) \
-{ r = a + b; \
- c = ((StgWord)(~(a^b) & (a^r))) \
+{ r = (I_)a + (I_)b; \
+ c = ((StgWord)(~((I_)a^(I_)b) & ((I_)a^r))) \
>> (BITS_IN (I_) - 1); \
}
#else
-#define HALF_INT (1 << (BITS_IN (I_) / 2))
+#define HALF_INT (1LL << (BITS_IN (I_) / 2))
#define stg_abs(a) ((a) < 0 ? -(a) : (a))
#define mulIntCzh(r,c,a,b) \
{ \
- if (stg_abs(a) >= HALF_INT \
+ if (stg_abs(a) >= HALF_INT || \
stg_abs(b) >= HALF_INT) { \
c = 1; \
} else { \
/* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.37 2000/12/04 12:31:20 simonmar Exp $
+ * $Id: StgMacros.h,v 1.38 2001/07/24 06:31:35 ken Exp $
*
* (c) The GHC Team, 1998-1999
*
y.iu.dlo = p_src[1];
return(y.i);
}
+
+#elif SIZEOF_VOID_P == 8
+
+static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
+{
+ p_dest[0] = src;
+}
+
+static inline StgWord64 PK_Word64(W_ p_src[])
+{
+ return p_src[0];
+}
+
+static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
+{
+ p_dest[0] = src;
+}
+
+static inline StgInt64 PK_Int64(W_ p_src[])
+{
+ return p_src[0];
+}
+
#endif
/* -----------------------------------------------------------------------------
% -----------------------------------------------------------------------------
-% $Id: PrelEnum.lhs,v 1.13 2001/02/18 14:45:15 qrczak Exp $
+% $Id: PrelEnum.lhs,v 1.14 2001/07/24 06:31:35 ken Exp $
%
% (c) The University of Glasgow, 1992-2000
%
fromEnum x = x
{-# INLINE enumFrom #-}
- enumFrom (I# x) = eftInt x 2147483647#
+ enumFrom (I# x) = case maxInt of I# y -> eftInt x y
-- Blarg: technically I guess enumFrom isn't strict!
{-# INLINE enumFromTo #-}
lim = y -# delta
efdIntFB c n x1 x2
- | delta >=# 0# = go_up_int_fb c n x1 delta ( 2147483647# -# delta)
- | otherwise = go_dn_int_fb c n x1 delta ((-2147483648#) -# delta)
+ | delta >=# 0# = case maxInt of I# y -> go_up_int_fb c n x1 delta (y -# delta)
+ | otherwise = case minInt of I# y -> go_dn_int_fb c n x1 delta (y -# delta)
where
delta = x2 -# x1
efdIntList x1 x2
- | delta >=# 0# = go_up_int_list x1 delta ( 2147483647# -# delta)
- | otherwise = go_dn_int_list x1 delta ((-2147483648#) -# delta)
+ | delta >=# 0# = case maxInt of I# y -> go_up_int_list x1 delta (y -# delta)
+ | otherwise = case minInt of I# y -> go_dn_int_list x1 delta (y -# delta)
where
delta = x2 -# x1
isSigned _ = True
{-# RULES
-"fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# (intToInt64# x#)
+"fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x#
"fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
#-}
% ------------------------------------------------------------------------------
-% $Id: PrelNum.lhs,v 1.39 2001/04/14 22:28:22 qrczak Exp $
+% $Id: PrelNum.lhs,v 1.40 2001/07/24 06:31:35 ken Exp $
%
% (c) The University of Glasgow, 1994-2000
%
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
+#include "MachDeps.h"
+#if WORD_SIZE_IN_BYTES == 4
+#define LEFTMOST_BIT 2147483648
+#elif WORD_SIZE_IN_BYTES == 8
+#define LEFTMOST_BIT 9223372036854775808
+#else
+#error Please define LEFTMOST_BIT to be 2^(WORD_SIZE_IN_BYTES*8-1)
+#endif
+
module PrelNum where
import {-# SOURCE #-} PrelErr
\begin{code}
quotRemInteger :: Integer -> Integer -> (Integer, Integer)
-quotRemInteger a@(S# (-2147483648#)) b = quotRemInteger (toBig a) b
+quotRemInteger a@(S# (-LEFTMOST_BIT#)) b = quotRemInteger (toBig a) b
quotRemInteger (S# i) (S# j)
= case quotRemInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j )
quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
(# s3, d3, s4, d4 #)
-> (J# s3 d3, J# s4 d4)
-divModInteger a@(S# (-2147483648#)) b = divModInteger (toBig a) b
+divModInteger a@(S# (-LEFTMOST_BIT#)) b = divModInteger (toBig a) b
divModInteger (S# i) (S# j)
= case divModInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
remInteger :: Integer -> Integer -> Integer
remInteger ia 0
= error "Prelude.Integral.rem{Integer}: divide by 0"
-remInteger a@(S# (-2147483648#)) b = remInteger (toBig a) b
+remInteger a@(S# (-LEFTMOST_BIT#)) b = remInteger (toBig a) b
remInteger (S# a) (S# b) = S# (remInt# a b)
{- Special case doesn't work, because a 1-element J# has the range
-(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
quotInteger :: Integer -> Integer -> Integer
quotInteger ia 0
= error "Prelude.Integral.quot{Integer}: divide by 0"
-quotInteger a@(S# (-2147483648#)) b = quotInteger (toBig a) b
+quotInteger a@(S# (-LEFTMOST_BIT#)) b = quotInteger (toBig a) b
quotInteger (S# a) (S# b) = S# (quotInt# a b)
{- Special case disabled, see remInteger above
quotInteger (S# a) (J# sb b)
\begin{code}
gcdInteger :: Integer -> Integer -> Integer
-- SUP: Do we really need the first two cases?
-gcdInteger a@(S# (-2147483648#)) b = gcdInteger (toBig a) b
-gcdInteger a b@(S# (-2147483648#)) = gcdInteger a (toBig b)
+gcdInteger a@(S# (-LEFTMOST_BIT#)) b = gcdInteger (toBig a) b
+gcdInteger a b@(S# (-LEFTMOST_BIT#)) = gcdInteger a (toBig b)
gcdInteger (S# a) (S# b) = case gcdInt (I# a) (I# b) of { I# c -> S# c }
gcdInteger ia@(S# 0#) ib@(J# 0# _) = error "PrelNum.gcdInteger: gcd 0 0 is undefined"
gcdInteger ia@(S# a) ib@(J# sb b)
ab = abs b
divExact :: Integer -> Integer -> Integer
-divExact a@(S# (-2147483648#)) b = divExact (toBig a) b
+divExact a@(S# (-LEFTMOST_BIT#)) b = divExact (toBig a) b
divExact (S# a) (S# b) = S# (quotInt# a b)
divExact (S# a) (J# sb b)
= S# (quotInt# a (integer2Int# sb b))
fromInteger x = x
-- ORIG: abs n = if n >= 0 then n else -n
- abs (S# (-2147483648#)) = 2147483648
+ abs (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT
abs (S# i) = case abs (I# i) of I# j -> S# j
abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2
timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-negateInteger (S# (-2147483648#)) = 2147483648
+negateInteger (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT
negateInteger (S# i) = S# (negateInt# i)
negateInteger (J# s d) = J# (negateInt# s) d
\end{code}
% -----------------------------------------------------------------------------
-% $Id: PrelStorable.lhs,v 1.7 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelStorable.lhs,v 1.8 2001/07/24 06:31:35 ken Exp $
%
% (c) The FFI task force, 2000
%
= IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #)
readInt32OffPtr (Ptr a) (I# i)
= IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #)
+#if WORD_SIZE_IN_BYTES == 4
readInt64OffPtr (Ptr a) (I# i)
= IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
+#else
+readInt64OffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
+#endif
readWord8OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #)
readWord16OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #)
readWord32OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #)
+#if WORD_SIZE_IN_BYTES == 4
readWord64OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #)
+#else
+readWord64OffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W64# x #)
+#endif
writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO ()
writeIntOffPtr :: Ptr Int -> Int -> Int -> IO ()
= IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #)
writeInt32OffPtr (Ptr a) (I# i) (I32# x)
= IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #)
+#if WORD_SIZE_IN_BYTES == 4
writeInt64OffPtr (Ptr a) (I# i) (I64# x)
= IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #)
+#else
+writeInt64OffPtr (Ptr a) (I# i) (I64# x)
+ = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #)
+#endif
writeWord8OffPtr (Ptr a) (I# i) (W8# x)
= IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
writeWord16OffPtr (Ptr a) (I# i) (W16# x)
= IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #)
writeWord32OffPtr (Ptr a) (I# i) (W32# x)
= IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #)
+#if WORD_SIZE_IN_BYTES == 4
writeWord64OffPtr (Ptr a) (I# i) (W64# x)
= IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #)
+#else
+writeWord64OffPtr (Ptr a) (I# i) (W64# x)
+ = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #)
+#endif
#endif /* __GLASGOW_HASKELL__ */
\end{code}
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.105 2001/07/24 05:04:58 ken Exp $
+ * $Id: GC.c,v 1.106 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team 1998-1999
*
#if defined(RTS_GTK_FRONTPANEL)
#include "FrontPanel.h"
#endif
+#include <stddef.h>
/* STATIC OBJECT LIST.
*
// scavenge each step in generations 0..maxgen
{
- int gen, st;
+ long gen;
+ int st;
loop2:
- for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) {
- for (st = generations[gen].n_steps-1; st >= 0 ; st--) {
+ for (gen = RtsFlags.GcFlags.generations; --gen >= 0; ) {
+ for (st = generations[gen].n_steps; --st >= 0; ) {
if (gen == 0 && st == 0 && RtsFlags.GcFlags.generations > 1) {
continue;
}
if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
RtsFlags.GcFlags.maxHeapSize ) {
- int adjusted_blocks; // signed on purpose
+ long adjusted_blocks; // signed on purpose
int pc_free;
adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
*/
if (RtsFlags.GcFlags.heapSizeSuggestion) {
- int blocks;
+ long blocks;
nat needed = calcNeeded(); // approx blocks needed at next GC
/* Guess how much will be live in generation 0 step 0 next time.
* collection for collecting all steps except g0s0.
*/
blocks =
- (((int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed) * 100) /
- (100 + (int)g0s0_pcnt_kept);
+ (((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
+ (100 + (long)g0s0_pcnt_kept);
- if (blocks < (int)RtsFlags.GcFlags.minAllocAreaSize) {
+ if (blocks < (long)RtsFlags.GcFlags.minAllocAreaSize) {
blocks = RtsFlags.GcFlags.minAllocAreaSize;
}
case CONSTR_0_2:
case CONSTR_STATIC:
{
- StgWord32 offset = info->layout.selector_offset;
+ StgWord offset = info->layout.selector_offset;
// check that the size is in range
ASSERT(offset <
void
move_TSO(StgTSO *src, StgTSO *dest)
{
- int diff;
+ ptrdiff_t diff;
// relocate the stack pointers...
diff = (StgPtr)dest - (StgPtr)src; // In *words*
-------------------------------------------------------------------------- */
StgTSO *
-relocate_stack(StgTSO *dest, int diff)
+relocate_stack(StgTSO *dest, ptrdiff_t diff)
{
StgUpdateFrame *su;
StgCatchFrame *cf;
} else {
size = gen->steps[0].scan - start;
}
- fprintf(stderr,"evac IND_OLDGEN: %d bytes\n", size * sizeof(W_));
+ fprintf(stderr,"evac IND_OLDGEN: %ld bytes\n", size * sizeof(W_));
}
#endif
ASSERT(info->type == IND_STATIC);
if (STATIC_LINK(info,p) == NULL) {
- IF_DEBUG(gccafs, fprintf(stderr, "CAF gc'd at 0x%04x\n", (int)p));
+ IF_DEBUG(gccafs, fprintf(stderr, "CAF gc'd at 0x%04lx\n", (long)p));
// black hole it
SET_INFO(p,&stg_BLACKHOLE_info);
p = STATIC_LINK2(info,p);
/* -----------------------------------------------------------------------------
- * $Id: MBlock.c,v 1.21 2001/01/16 11:54:25 simonmar Exp $
+ * $Id: MBlock.c,v 1.22 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team 1998-1999
*
barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
}
- IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
+ IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
next_request += size;
/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.41 2001/07/23 17:23:19 simonmar Exp $
+ * $Id: Printer.c,v 1.42 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team, 1994-2000.
*
putchar(arrWordsGetChar(obj,i));
} */
for (i=0; i<((StgArrWords *)obj)->words; i++)
- fprintf(stderr, "%d", ((StgArrWords *)obj)->payload[i]);
+ fprintf(stderr, "%ld", ((StgArrWords *)obj)->payload[i]);
fprintf(stderr,"\")\n");
break;
}
void printStackChunk( StgPtr sp, StgPtr spBottom )
{
- StgWord32 bitmap;
+ StgWord bitmap;
const StgInfoTable *info;
ASSERT(sp <= spBottom);
sp++;
small_bitmap:
while (bitmap != 0) {
- fprintf(stderr," stk[%d] (%p) = ", spBottom-sp, sp);
+ fprintf(stderr," stk[%ld] (%p) = ", spBottom-sp, sp);
if ((bitmap & 1) == 0) {
printPtr((P_)*sp);
fprintf(stderr,"\n");
} else {
- fprintf(stderr,"Word# %d\n", *sp++);
+ fprintf(stderr,"Word# %ld\n", *sp++);
}
sp++;
bitmap = bitmap >> 1;
break;
}
}
- fprintf(stderr,"Stack[%d] (%p) = ", spBottom-sp, sp);
+ fprintf(stderr,"Stack[%ld] (%p) = ", spBottom-sp, sp);
sp = printStackObj(sp);
}
}
/* -----------------------------------------------------------------------------
- * $Id: RtsUtils.c,v 1.18 2001/02/13 11:10:28 rrt Exp $
+ * $Id: RtsUtils.c,v 1.19 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team, 1998-1999
*
}
void
-_stgAssert (char *filename, nat linenum)
+_stgAssert (char *filename, unsigned int linenum)
{
fflush(stdout);
fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.97 2001/07/23 17:23:19 simonmar Exp $
+ * $Id: Schedule.c,v 1.98 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team, 1998-2000
*
}
while (1) {
- int words = ((P_)su - (P_)sp) - 1;
+ nat words = ((P_)su - (P_)sp) - 1;
nat i;
StgAP_UPD * ap;
/* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.34 2001/07/23 17:23:20 simonmar Exp $
+ * $Id: Storage.h,v 1.35 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team, 1998-1999
*
Macros for calculating how big a closure will be (used during allocation)
-------------------------------------------------------------------------- */
-/* ToDo: replace unsigned int by nat. The only fly in the ointment is that
- * nat comes from Rts.h which many folk dont include. Sigh!
- */
-static __inline__ StgOffset AP_sizeW ( unsigned int n_args )
+static __inline__ StgOffset AP_sizeW ( nat n_args )
{ return sizeofW(StgAP_UPD) + n_args; }
-static __inline__ StgOffset PAP_sizeW ( unsigned int n_args )
+static __inline__ StgOffset PAP_sizeW ( nat n_args )
{ return sizeofW(StgPAP) + n_args; }
-static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )
+static __inline__ StgOffset CONSTR_sizeW( nat p, nat np )
{ return sizeofW(StgHeader) + p + np; }
static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
/* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.33 2001/03/23 16:36:21 simonmar Exp $
+ * $Id: Updates.hc,v 1.34 2001/07/24 06:31:36 ken Exp $
*
* (c) The GHC Team, 1998-1999
*
/* Now fill in the closure fields */
p = Hp;
- for (i = Words-1; i >= 0; i--) {
+ for (i = Words; --i >= 0; ) {
*p-- = (W_) Sp[i];
}
}
/*
* Squeeze out update frame from stack.
*/
- for (i = Words-1; i >= 0; i--) {
+ for (i = Words; --i >= 0; ) {
Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
}
Sp += sizeofW(StgUpdateFrame);
projects / ghc-hetmet.git / commitdiff