Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
d888cbcb
Commit
d888cbcb
authored
Jul 24, 2001
by
ken
Browse files
[project @ 2001-07-24 06:31:35 by ken]
Innocent changes to resurrect/add 64-bit support.
parent
f6709386
Changes
13
Hide whitespace changes
Inline
Side-by-side
ghc/includes/PrimOps.h
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.7
8
2001/07/
1
4 0
0:06:14 sof
Exp $
* $Id: PrimOps.h,v 1.7
9
2001/07/
2
4 0
6:31:35 ken
Exp $
*
* (c) The GHC Team, 1998-2000
*
...
...
@@ -99,8 +99,8 @@
* 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); \
}
...
...
@@ -171,13 +171,13 @@ typedef union {
#else
#define HALF_INT (1 << (BITS_IN (I_) / 2))
#define HALF_INT (1
LL
<< (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 { \
...
...
ghc/includes/StgMacros.h
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: StgMacros.h,v 1.3
7
200
0/12/04 12:31:20 simonmar
Exp $
* $Id: StgMacros.h,v 1.3
8
200
1/07/24 06:31:35 ken
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -611,6 +611,29 @@ static inline StgInt64 PK_Int64(W_ p_src[])
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
/* -----------------------------------------------------------------------------
...
...
ghc/lib/std/PrelEnum.lhs
View file @
d888cbcb
% -----------------------------------------------------------------------------
% $Id: PrelEnum.lhs,v 1.1
3
2001/0
2/18 14:45:15 qrczak
Exp $
% $Id: PrelEnum.lhs,v 1.1
4
2001/0
7/24 06:31:35 ken
Exp $
%
% (c) The University of Glasgow, 1992-2000
%
...
...
@@ -314,7 +314,7 @@ instance Enum Int where
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 #-}
...
...
@@ -374,14 +374,14 @@ efdtIntList x1 x2 y
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
...
...
ghc/lib/std/PrelInt.lhs
View file @
d888cbcb
...
...
@@ -573,7 +573,7 @@ instance Bits Int64 where
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#)
#-}
...
...
ghc/lib/std/PrelNum.lhs
View file @
d888cbcb
% ------------------------------------------------------------------------------
% $Id: PrelNum.lhs,v 1.
39
2001/0
4/14 22:28:22 qrczak
Exp $
% $Id: PrelNum.lhs,v 1.
40
2001/0
7/24 06:31:35 ken
Exp $
%
% (c) The University of Glasgow, 1994-2000
%
...
...
@@ -18,6 +18,15 @@ and the type
\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
...
...
@@ -130,7 +139,7 @@ toBig i@(J# _ _) = i
\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)
...
...
@@ -140,7 +149,7 @@ quotRemInteger (J# s1 d1) (J# s2 d2)
(# 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)
...
...
@@ -153,7 +162,7 @@ divModInteger (J# s1 d1) (J# s2 d2)
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)
...
...
@@ -174,7 +183,7 @@ remInteger (J# sa a) (J# sb b)
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)
...
...
@@ -195,8 +204,8 @@ quotInteger (J# sa 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)
...
...
@@ -221,7 +230,7 @@ lcmInteger a 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))
...
...
@@ -310,7 +319,7 @@ instance Num Integer where
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
...
...
@@ -344,7 +353,7 @@ timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2
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}
...
...
ghc/lib/std/PrelStorable.lhs
View file @
d888cbcb
% -----------------------------------------------------------------------------
% $Id: PrelStorable.lhs,v 1.
7
2001/0
5/18 16:54:05 simonmar
Exp $
% $Id: PrelStorable.lhs,v 1.
8
2001/0
7/24 06:31:35 ken
Exp $
%
% (c) The FFI task force, 2000
%
...
...
@@ -224,16 +224,26 @@ readInt16OffPtr (Ptr a) (I# i)
= 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 ()
...
...
@@ -274,16 +284,26 @@ writeInt16OffPtr (Ptr a) (I# i) (I16# x)
= 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}
ghc/rts/GC.c
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.10
5
2001/07/24 0
5:04:58
ken Exp $
* $Id: GC.c,v 1.10
6
2001/07/24 0
6:31:36
ken Exp $
*
* (c) The GHC Team 1998-1999
*
...
...
@@ -40,6 +40,7 @@
#if defined(RTS_GTK_FRONTPANEL)
#include
"FrontPanel.h"
#endif
#include
<stddef.h>
/* STATIC OBJECT LIST.
*
...
...
@@ -527,10 +528,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
// 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
;
}
...
...
@@ -791,7 +793,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
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
);
...
...
@@ -817,7 +819,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
*/
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.
...
...
@@ -841,10 +843,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
* 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
;
}
...
...
@@ -1548,7 +1550,7 @@ loop:
case
CONSTR_0_2
:
case
CONSTR_STATIC
:
{
StgWord
32
offset
=
info
->
layout
.
selector_offset
;
StgWord
offset
=
info
->
layout
.
selector_offset
;
// check that the size is in range
ASSERT
(
offset
<
...
...
@@ -1842,7 +1844,7 @@ loop:
void
move_TSO
(
StgTSO
*
src
,
StgTSO
*
dest
)
{
in
t
diff
;
ptrdiff_
t
diff
;
// relocate the stack pointers...
diff
=
(
StgPtr
)
dest
-
(
StgPtr
)
src
;
// In *words*
...
...
@@ -1859,7 +1861,7 @@ move_TSO(StgTSO *src, StgTSO *dest)
-------------------------------------------------------------------------- */
StgTSO
*
relocate_stack
(
StgTSO
*
dest
,
in
t
diff
)
relocate_stack
(
StgTSO
*
dest
,
ptrdiff_
t
diff
)
{
StgUpdateFrame
*
su
;
StgCatchFrame
*
cf
;
...
...
@@ -2736,7 +2738,7 @@ scavenge_mut_once_list(generation *gen)
} else {
size = gen->steps[0].scan - start;
}
fprintf(stderr,"evac IND_OLDGEN: %d bytes\n", size * sizeof(W_));
fprintf(stderr,"evac IND_OLDGEN: %
l
d bytes\n", size * sizeof(W_));
}
#endif
...
...
@@ -3438,7 +3440,7 @@ gcCAFs(void)
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%04
l
x\n", (
long
)p));
// black hole it
SET_INFO(p,&stg_BLACKHOLE_info);
p = STATIC_LINK2(info,p);
...
...
ghc/rts/MBlock.c
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: MBlock.c,v 1.2
1
2001/0
1/16 11:54:25 simonmar
Exp $
* $Id: MBlock.c,v 1.2
2
2001/0
7/24 06:31:36 ken
Exp $
*
* (c) The GHC Team 1998-1999
*
...
...
@@ -85,7 +85,7 @@ getMBlocks(nat n)
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
;
...
...
ghc/rts/Printer.c
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: Printer.c,v 1.4
1
2001/07/2
3 17:23:19 simonmar
Exp $
* $Id: Printer.c,v 1.4
2
2001/07/2
4 06:31:36 ken
Exp $
*
* (c) The GHC Team, 1994-2000.
*
...
...
@@ -287,7 +287,7 @@ void printClosure( StgClosure *obj )
putchar(arrWordsGetChar(obj,i));
} */
for
(
i
=
0
;
i
<
((
StgArrWords
*
)
obj
)
->
words
;
i
++
)
fprintf
(
stderr
,
"%d"
,
((
StgArrWords
*
)
obj
)
->
payload
[
i
]);
fprintf
(
stderr
,
"%
l
d"
,
((
StgArrWords
*
)
obj
)
->
payload
[
i
]);
fprintf
(
stderr
,
"
\"
)
\n
"
);
break
;
}
...
...
@@ -399,7 +399,7 @@ StgPtr printStackObj( StgPtr sp )
void
printStackChunk
(
StgPtr
sp
,
StgPtr
spBottom
)
{
StgWord
32
bitmap
;
StgWord
bitmap
;
const
StgInfoTable
*
info
;
ASSERT
(
sp
<=
spBottom
);
...
...
@@ -442,12 +442,12 @@ void printStackChunk( StgPtr sp, StgPtr spBottom )
sp
++
;
small_bitmap:
while
(
bitmap
!=
0
)
{
fprintf
(
stderr
,
" stk[%d] (%p) = "
,
spBottom
-
sp
,
sp
);
fprintf
(
stderr
,
" stk[%
l
d] (%p) = "
,
spBottom
-
sp
,
sp
);
if
((
bitmap
&
1
)
==
0
)
{
printPtr
((
P_
)
*
sp
);
fprintf
(
stderr
,
"
\n
"
);
}
else
{
fprintf
(
stderr
,
"Word# %d
\n
"
,
*
sp
++
);
fprintf
(
stderr
,
"Word# %
l
d
\n
"
,
*
sp
++
);
}
sp
++
;
bitmap
=
bitmap
>>
1
;
...
...
@@ -462,7 +462,7 @@ void printStackChunk( StgPtr sp, StgPtr spBottom )
break
;
}
}
fprintf
(
stderr
,
"Stack[%d] (%p) = "
,
spBottom
-
sp
,
sp
);
fprintf
(
stderr
,
"Stack[%
l
d] (%p) = "
,
spBottom
-
sp
,
sp
);
sp
=
printStackObj
(
sp
);
}
}
...
...
ghc/rts/RtsUtils.c
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: RtsUtils.c,v 1.1
8
2001/0
2/13 11:10:28 rrt
Exp $
* $Id: RtsUtils.c,v 1.1
9
2001/0
7/24 06:31:36 ken
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -113,7 +113,7 @@ stgReallocWords (void *p, int n, char *msg)
}
void
_stgAssert
(
char
*
filename
,
n
a
t
linenum
)
_stgAssert
(
char
*
filename
,
unsigned
i
nt
linenum
)
{
fflush
(
stdout
);
fprintf
(
stderr
,
"ASSERTION FAILED: file %s, line %u
\n
"
,
filename
,
linenum
);
...
...
ghc/rts/Schedule.c
View file @
d888cbcb
/* ---------------------------------------------------------------------------
* $Id: Schedule.c,v 1.9
7
2001/07/2
3 17:23:19 simonmar
Exp $
* $Id: Schedule.c,v 1.9
8
2001/07/2
4 06:31:36 ken
Exp $
*
* (c) The GHC Team, 1998-2000
*
...
...
@@ -2920,7 +2920,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
}
while
(
1
)
{
i
nt
words
=
((
P_
)
su
-
(
P_
)
sp
)
-
1
;
n
a
t
words
=
((
P_
)
su
-
(
P_
)
sp
)
-
1
;
nat
i
;
StgAP_UPD
*
ap
;
...
...
ghc/rts/Storage.h
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: Storage.h,v 1.3
4
2001/07/2
3 17:23:20 simonmar
Exp $
* $Id: Storage.h,v 1.3
5
2001/07/2
4 06:31:36 ken
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -497,16 +497,13 @@ extern int is_heap_alloced(const void* x);
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
i
nt
n_args
)
static
__inline__
StgOffset
PAP_sizeW
(
n
a
t
n_args
)
{
return
sizeofW
(
StgPAP
)
+
n_args
;
}
static
__inline__
StgOffset
CONSTR_sizeW
(
unsigned
int
p
,
unsigned
in
t
np
)
static
__inline__
StgOffset
CONSTR_sizeW
(
nat
p
,
na
t
np
)
{
return
sizeofW
(
StgHeader
)
+
p
+
np
;
}
static
__inline__
StgOffset
THUNK_SELECTOR_sizeW
(
void
)
...
...
ghc/rts/Updates.hc
View file @
d888cbcb
/* -----------------------------------------------------------------------------
* $Id: Updates.hc,v 1.3
3
2001/0
3
/2
3 16:36:21 simonmar
Exp $
* $Id: Updates.hc,v 1.3
4
2001/0
7
/2
4 06:31:36 ken
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -306,7 +306,7 @@ EXTFUN(stg_update_PAP)
/* Now fill in the closure fields */
p = Hp;
for (i = Words
-1
; i >= 0;
i--
) {
for (i = Words;
--
i >= 0; ) {
*p-- = (W_) Sp[i];
}
}
...
...
@@ -384,7 +384,7 @@ EXTFUN(stg_update_PAP)
/*
* 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);
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment